Hello Dudes ... I was away for a longer weekend and when I came back I saw there was quite some discussion about certain aspects of my person and my code. I remember posting some controversial statements which I thought would lead to some discussion and widen the horizon of some people who only believe the things what the computer magazines and the so-called gurus say. Well, there was some reaction I didn't quite like - some guys reacted quite childish in the way of this-is-not-the-way-it's-done-therefore-you-are-an- idiot-and-we-laugh-at-you. Way under there age (or?). Which made me quite angry so I replied hard at them. Most of it was crap anyway - lamers who thought they could prove me wrong and made themselves laughed at by others, when they tried to improve the 16bit code in 32bit mode. NONE of it works, as I was claiming before and was flamed with crap from the people who have to boost their ego. Another thing was the statement about the Gouraud code with 0.25 instructions per pixel. I wrote that only 'coz I was surprised that people still thought it was so expensive ... while I replaced it with Phong shading already. According to the replies I got, where people actually thought I meant 1/4 of a frame and stuff like that, they act like when-I-cannot-do-that-how-can-HE-do- that-MUST-be-some-sort-of-error-or-else-I'd-be-lame. Some people really think that their code is optimized or so, and nothing can get faster - well it's not impossible to optimize even more, you'd be surprised. NEVER EVER say your code is optimized, somebody can come and make it faster - and if it is with the new Pentium execution unit, or with some new undocumented feature. Therefore below's the code for it. You may want to get my released sources/ intros and look at them. Then let's argue again ... Something else about giving code out. It's definitely *NOT* in use for demo groups to give code out. While it may be 'in' for some American demo groups to do that, we Europeans started out without all those tutorials - most of us don't have Internet access or a modem anyway. Enough about this. But I find today's attitude of 'HAVING to give code out, if you mention you have a good method' lame - there's a increasing majority of newbies who actually DEMAND that, 'coz they're used to it. Like the 'if he holds his code back we'll flame him till he gives us!' approach. I fucking hate those LAMERS. Try to see it as a GIFT, and not as your right! Nevertheless I released some, and I'll probably still do ... However, would you give your code/technique/ tricks gratefully to guys who flame you? Most of those lamers don't have anything to prove they can code, actually. Everybody can snap up a few bits of 'on how to do this and that', and no matter if it's wrong or right, flame all who are of a different opinion. I think that's what is called being fascist. Let's take for example DOOM: Lot's of people 'claim' they've coded/are coding it - I don't know who turned up with the argument that DOOM be ray casting, but I bet the ID guys were laughing their ass off when that thread about it was taking place ;) It may lie in their interest to disinform the public as they want to sell their routine's technology, or? (This is only an assumption and no accusation, dudes). You probably could make it ray casting, but I'd strongly doubt you'd reach the speed of the original. Well, how do I come to that conclusion? Me, and some of the leading demo coders agree on that. (There's an example with ray casting, called ACK3D, but it doesn't reach the speed of Wolf3D by far, as you can see, and for floor/ceiling the ratio is worse ...) Laugh at me, but as a demo coder I'm testing algorithms due to their usability and performance. And I don't select the most sophisticated one, but the one who fulfills the needs of the routine. For example, I've never bothered with BSP- trees - I know about the algorithm - but I see no use for it. What I'm trying to say, you shouldn't blindly follow those who call themselves Gurus, but try to look what's behind it. I know that some guys will flame me, either for this attitude, or for some little bugs they find in my routine, or some unoptimized ASM instructions. Those fuckers should really get a life. I thank all those who know me, have seen my routines and support me in this group - You know who you are! -----------------------RIP this code here, lamers------------------------------ Signed, The Faker (S!P Internet PR) _____________________________________________________________ \ \ \ | "No one told you when to run, | in fake life: | | you missed the starting gun." | Stefan Ohrhallinger | | | St. Laurenz 54 | | SURPRISE! PRODUCTIONS, AUSTRIA | A-4950 ALTHEIM | | | | | "lightyears ahead!" | +43-732-2457-1025 | | __________________________________\_______________________\__ \_/____________________________________________________________/ I really don't care what you're doing with it, 'coz for me it's obsolete ... Why? It's been coded a year before, I never optimized anything except the inner loop, so my Phong stuff is faster now. And it's an example of provement, not a full-documented well-structured nice- ascii-pictured anal-retentive code - I've got better things to do. compile: tp -G+ gourex.pas run: gourex sphere 2 x g {Gourex.PAS----------------------------------------------------------} {$R-,S-} {{$DEFINE TIMER} {{$DEFINE MEASURE} {{$DEFINE GLENZ} {{$DEFINE FILLING} PROGRAM ObjectsIn3D; USES Crt,Dos; CONST MaxPoints=700; MaxFaces=1200; MaxObjects=1; MaxFaceCount=4; LightSpot=0.2; TYPE ByteArray=ARRAY[0..65534] OF Byte; WordArray=ARRAY[0..32766] OF Word; L=RECORD Lo:Word; Hi:Integer; END; FaceTyp=RECORD P:ARRAY[1..MaxFaceCount] OF Word; FaceTyp:Byte; Light,FarZ:Integer; END; ObjectTyp=RECORD NrFaces:Word; Face:ARRAY[1..MaxFaces] OF FaceTyp; END; DrawModeTyp=(Delete,Plain,Goraud); BigArray=ARRAY[0..254,0..255] OF Byte; VecType=ARRAY[0..2] OF Integer; LongVecType=ARRAY[0..2] OF LongInt; VAR XOfs,YOfs,ZOfs:LongInt; Point:ARRAY[1..MaxPoints,1..3] OF LongInt; Dot:ARRAY[1..MaxPoints,1..3] OF Integer; EdgeLight:ARRAY[1..MaxPoints] OF Integer; EdgeVec:ARRAY[1..MaxPoints,0..2] OF Integer; EdgeNorm:ARRAY[1..MaxPoints] OF LongInt; EdgeVecCount,EdgeLightCount:ARRAY[1..MaxPoints] OF Byte; Objects:ARRAY[1..MaxObjects] OF ObjectTyp; NrPoints,ObjectCount:Integer; Sinus:ARRAY[0..900] OF LongInt; I,J,Segment,Phase:Word; U,V,W,XX,YY,XRes,YRes,ZRes,Error:Integer; SinU,CosU,SinV,CosV,SinW,CosW,M1,M2,M3,M4,M5,M6,M7,M8,M9,X,Y,Z,Temp, ScalX,ScalY,ScalZ,Quotient:LongInt; BallSpr:Pointer; NoVert,Flip,Lighted,Texture,TinyTexture,Gouraud,Phong,ModeX, PhongTexture,PerspectiveTexture:Boolean; R,G,B:Byte; LineTable1:ARRAY[0..319] OF Byte; LineTable2:ARRAY[0..319] OF Byte; GTable:ARRAY[0..127] OF Word; Timer:Byte ABSOLUTE $40:$6C; LastTimer:Byte; Dummy,SqrtTable:ARRAY[0..4095] OF Byte; LX,LY,LZ:Integer; LNorm:LongInt; Light3:ARRAY[1..3] OF Integer; SortedFace:ARRAY[0..MaxFaces] OF Integer; SaveInt09:Pointer; Key:ARRAY[0..127] OF Boolean; VirtualScreen,TinyTextureSpr:Pointer; PhongTable,PalTable,TextureData:^ByteArray; Palette:ARRAY[0..255,0..2] OF Byte; DivWTable:^WordArray; Zeit:LongInt; Ticker:LongInt ABSOLUTE $40:$6C; FUNCTION IntSqrt(L:LongInt):LongInt; BEGIN END; PROCEDURE NewInt09; INTERRUPT; VAR KeyCode:Byte; BEGIN ASM in al,60h mov keycode,al in al,61h mov ah,al or al,80h out 61h,al mov al,ah out 61h,al mov al,20h out 20h,al END; IF KeyCode<128 THEN Key[KeyCode]:=TRUE ELSE Key[KeyCode AND 127]:=FALSE; END; FUNCTION NormSin(W:Integer):LongInt; BEGIN IF W>1800 THEN IF W>2700 THEN NormSin:=-Sinus[3600-W] ELSE NormSin:=-Sinus[W-1800] ELSE IF W>900 THEN NormSin:=Sinus[1800-W] ELSE NormSin:=Sinus[W]; END; FUNCTION NormCos(W:Integer):LongInt; BEGIN IF W>1800 THEN IF W>2700 THEN NormCos:=Sinus[W-2700] ELSE NormCos:=-Sinus[2700-W] ELSE IF W>900 THEN NormCos:=-Sinus[W-900] ELSE NormCos:=Sinus[900-W]; END; PROCEDURE ReadObject(FileName:String); VAR ObjectFile:Text; I,ObjectNr,CoordOfs:Integer; Command,DummyStr:String; R:Real; ObjScalX,ObjScalY,ObjScalZ,ObjMoveX,ObjMoveY,ObjMoveZ:Real; PROCEDURE ReadNextLine; BEGIN WHILE NOT Eof(ObjectFile) AND EOLn(ObjectFile) DO ReadLn(ObjectFile); END; PROCEDURE Upper(VAR S:String); VAR I:Byte; BEGIN FOR I:=1 TO Length(S) DO S[I]:=UpCase(S[I]); END; PROCEDURE ExecCommand; PROCEDURE ExecObjectCommand; PROCEDURE ReadCoords; BEGIN WHILE NOT EOLn(Objectfile) DO BEGIN IF NrPoints>MaxPoints THEN BEGIN WriteLn('Too many points, max. is currently ',maxpoints); Halt(1); END; Inc(NrPoints); Read(ObjectFile,R); Point[NrPoints,1]:=Round((R*ObjScalX+ObjMoveX)*65536); Read(ObjectFile,R); Point[NrPoints,2]:=Round((R*ObjScalY+ObjMoveY)*65536); Read(ObjectFile,R); Point[NrPoints,3]:=Round((R*ObjScalZ+ObjMoveZ)*65536); ReadLn(ObjectFile); END; END; PROCEDURE ReadFaces; BEGIN WITH Objects[ObjectCount] DO BEGIN NrFaces:=0; WHILE NOT EOLn(ObjectFile) DO BEGIN IF NrFaces>MaxFaces THEN BEGIN WriteLn('Too many faces, max. is currently ',maxfaces); Halt(1); END; Inc(NrFaces); WITH Face[NrFaces] DO BEGIN FaceTyp:=0; WHILE NOT EOLn(ObjectFile) DO BEGIN Inc(FaceTyp); Read(ObjectFile,P[FaceTyp]); Inc(P[FaceTyp],CoordOfs); END; ReadLn(ObjectFile); END; END; END; END; BEGIN IF Command='SCAL' THEN BEGIN ReadLn(ObjectFile,ObjScalX); ObjScalY:=ObjScalX; ObjScalZ:=ObjScalX; END ELSE IF Command='SCALX' THEN ReadLn(ObjectFile,ObjScalX) ELSE IF Command='SCALY' THEN ReadLn(ObjectFile,ObjScalY) ELSE IF Command='SCALZ' THEN ReadLn(ObjectFile,ObjScalZ) ELSE IF Command='MOVE' THEN BEGIN ReadLn(ObjectFile,ObjMoveX); ObjMoveY:=ObjMoveX; ObjMoveZ:=ObjMoveX; END ELSE IF Command='MOVEX' THEN ReadLn(ObjectFile,ObjMoveX) ELSE IF Command='MOVEY' THEN ReadLn(ObjectFile,ObjMoveY) ELSE IF Command='MOVEZ' THEN ReadLn(ObjectFile,ObjMoveZ) ELSE IF Command='COORDS' THEN BEGIN ReadNextLine; ReadCoords; END ELSE IF Command='FACES' THEN BEGIN ReadNextLine; ReadFaces; END; END; BEGIN IF Command='SCAL' THEN BEGIN ReadLn(ObjectFile,R); ScalX:=Round(R*65536); ScalY:=ScalX; ScalZ:=ScalX; END ELSE IF Command='SCALX' THEN BEGIN ReadLn(ObjectFile,R); ScalX:=Round(R*65536); END ELSE IF Command='SCALY' THEN BEGIN ReadLn(ObjectFile,R); ScalY:=Round(R*65536); END ELSE IF Command='SCALZ' THEN BEGIN ReadLn(ObjectFile,R); ScalZ:=Round(R*65536); END ELSE IF Command='OBJECT' THEN BEGIN Inc(ObjectCount); ObjScalX:=1.0; ObjScalY:=1.0; ObjScalZ:=1.0; ObjMoveX:=0.0; ObjMoveY:=0.0; ObjMoveZ:=0.0; CoordOfs:=NrPoints; ReadLn(ObjectFile,DummyStr); REPEAT ReadNextLine; Read(ObjectFile,Command); Upper(Command); ExecObjectCommand; UNTIL Command='OBJEND'; END; END; BEGIN ObjectCount:=0; ScalX:=65536; ScalY:=65536; ScalZ:=65536; Assign(ObjectFile,FileName+'.XYZ'); Reset(ObjectFile); WHILE NOT Eof(ObjectFile) DO BEGIN ReadNextLine; ReadLn(ObjectFile,Command); Upper(Command); ExecCommand; END; Close(ObjectFile); END; PROCEDURE XForm(X,Y,Z:LongInt); BEGIN ASM db $66 mov bx,word ptr x db $66 add bx,word ptr xofs db $66 mov cx,word ptr y db $66 add cx,word ptr yofs db $66 mov di,word ptr z db $66 add di,word ptr zofs { X } db $66 mov ax,word ptr m1 db $66 imul bx db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 mov si,ax db $66 mov ax,word ptr m2 db $66 imul cx db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 add si,ax db $66 mov ax,word ptr m3 db $66 imul di db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 add si,ax db $66 mov ax,word ptr scalx db $66 imul si db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 shr ax,10h mov word ptr xres,ax { Y } db $66 mov ax,word ptr m4 db $66 imul bx db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 mov si,ax db $66 mov ax,word ptr m5 db $66 imul cx db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 add si,ax db $66 mov ax,word ptr m6 db $66 imul di db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 add si,ax db $66 mov ax,word ptr scaly db $66 imul si db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 shr ax,10h mov word ptr yres,ax { Z } db $66 mov ax,word ptr m7 db $66 imul bx db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 mov si,ax db $66 mov ax,word ptr m8 db $66 imul cx db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 add si,ax db $66 mov ax,word ptr m9 db $66 imul di db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 add si,ax db $66 mov ax,word ptr scalz db $66 imul si db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 shr ax,10h mov word ptr zres,ax END; IF Texture OR PhongTexture THEN Exit; IF ZRes=-225 THEN Inc(ZRes); XRes:=-(LongInt(XRes) SHL 8) DIV (ZRes+225); YRes:=-(LongInt(YRes) SHL 8) DIV (ZRes+225); Inc(ZRes,100); END; PROCEDURE TransformPoints; VAR I:Word; J,K:Byte; BEGIN SinU:=NormSin(U); CosU:=NormCos(U); SinV:=NormSin(V); CosV:=NormCos(V); SinW:=NormSin(W); CosW:=NormCos(W); ASM { M (1,1) } db $66 mov ax,word ptr cosv db $66 imul word ptr cosw db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 mov word ptr m1,ax { M (2,1) } db $66 mov ax,word ptr cosv db $66 imul word ptr sinw db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 mov word ptr m2,ax { M (3,1) } db $66 mov ax,word ptr sinv db $66 neg ax db $66 mov word ptr m3,ax { Temp 1 } db $66 mov ax,word ptr sinu db $66 imul word ptr sinv db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 mov bx,ax { Temp 2 } db $66 mov ax,word ptr cosu db $66 imul word ptr sinv db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 mov cx,ax { M (2,1) } db $66 mov ax,word ptr cosw db $66 imul bx db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 mov si,ax db $66 mov ax,word ptr cosu db $66 imul word ptr sinw db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 sub si,ax db $66 mov word ptr m4,si { M (2,2) } db $66 mov ax,word ptr sinw db $66 imul bx db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 mov si,ax db $66 mov ax,word ptr cosu db $66 imul word ptr cosw db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 add si,ax db $66 mov word ptr m5,si { M (2,3) } db $66 mov ax,word ptr sinu db $66 imul word ptr cosv db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 mov word ptr m6,ax { M (3,1) } db $66 mov ax,word ptr cosw db $66 imul cx db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 mov si,ax db $66 mov ax,word ptr sinu db $66 imul word ptr sinw db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 add si,ax db $66 mov word ptr m7,si { M (3,2) } db $66 mov ax,word ptr sinw db $66 imul cx db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 mov si,ax db $66 mov ax,word ptr sinu db $66 imul word ptr cosw db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 sub si,ax db $66 mov word ptr m8,si { M (3,3) } db $66 mov ax,word ptr cosu db $66 imul word ptr cosv db $66,$0f,$ac,$d0,$10 { SHRD EAX,EDX,10h } db $66 mov word ptr m9,ax END; FOR I:=1 TO NrPoints DO BEGIN XForm(Point[I,1],Point[I,2],Point[I,3]); Dot[I,1]:=XRes+160; Dot[I,2]:=YRes+100; Dot[I,3]:=ZRes; END; END; PROCEDURE FillPoly(Count:Word; VAR A; Color:Byte); BEGIN END; PROCEDURE SetWriteMap(Map:Byte); BEGIN Port[$3C4]:=2; Port[$3C5]:=Map; END; PROCEDURE SetupTable; VAR I,J,K:Byte; BEGIN FOR K:=0 TO 3 DO FOR J:=1 TO 124 DO FOR I:=0 TO J SHL 1-1 DO BEGIN SetWriteMap(1 SHL ((I+K) AND 3)); Mem[$A800:K*$1000+((J+3) SHR 1)*((J+4) SHR 1)+(I+K) SHR 2]:=(I SHL 5) DIV J; Mem[$AC00:K*$1000+((J+3) SHR 1)*((J+4) SHR 1)+(I+K) SHR 2]:=63-((I SHL 5) DIV J); END; END; PROCEDURE XColorLine2(X1,X2,Y:Word; C1,C2:Byte); BEGIN ASM mov ax,segment mov es,ax mov ax,y xchg al,ah mov di,ax shr ax,2 add di,ax shr di,2 mov dx,3c4h mov al,2 out dx,al inc dx cld mov bx,x1 mov al,byte ptr [bx+offset linetable1] mov si,x2 mov ah,byte ptr [si+offset linetable2] shr bx,2 shr si,2 mov cx,si sub cx,bx jcxz @1 dec cx add di,bx mov bh,ah out dx,al mov al,c1 shr al,1 stosb jcxz @4 mov al,0fh out dx,al push bx xor dx,dx mov al,0 mov ah,c2 sub ah,c1 sbb dx,0 idiv cx mov si,ax mov dh,c1 mov dl,0 shr cx,1 jnc @2 add dx,si mov ax,dx shr ax,9 stosb jcxz @5 @2: add dx,si mov bx,dx shr bx,1 add dx,si mov ax,dx shr ax,1 mov al,bh stosw loop @2 @5: pop bx @4: mov al,bh mov dx,3c5h out dx,al mov al,c2 shr al,1 stosb jmp @3 @1: add di,bx and al,ah out dx,al mov al,c1 add al,c2 rcr al,1 shr al,1 stosb @3: END; END; PROCEDURE SetWriteMode(M:Byte); BEGIN Port[$3CE]:=$05; Port[$3CF]:=(Port[$3CF] AND $FC) OR (M AND 3); END; PROCEDURE XColorLine(X1,X2,Y:Integer; C1,C2:Byte); VAR XD,CD,AdrSI,AdrDI:Word; I,D,LineStart,StartByte,WhichMap,Map1,Map2,X1Ofs,XCount:Byte; BEGIN XD:=X2-X1; CD:=Abs(C2-C1) SHL 1; IF XD>=CD THEN BEGIN XColorLine2(X1,X2,Y,C1,C2); Exit; END; IF XD=0 THEN Exit; ASM mov ax,xd inc ax xchg al,ah xor dx,dx div cd inc ax shr ax,1 mov d,al END; IF D>=125 THEN BEGIN XColorLine2(X1,X2,Y,C1,C2); Exit; END; IF C1>C2 THEN BEGIN AdrSI:=$4000; LineStart:=(D*(127-C1)) SHR 6; END ELSE BEGIN AdrSI:=0; LineStart:=(D*C1) SHR 6; END; X1Ofs:=X1 AND 3; WhichMap:=(X1Ofs-(LineStart AND 3)) AND 3; XCount:=(XD+X1Ofs) SHR 2-1; StartByte:=(LineStart+WhichMap) SHR 2; AdrDI:=Y*80+X1 SHR 2; Inc(AdrSI,WhichMap SHL 12+GTable[D]+StartByte); Map1:=(15 SHL X1Ofs) AND 15; Map2:=2 SHL (X2 AND 3)-1; SetWriteMode(1); IF XCount=255 THEN BEGIN ASM push ds cld mov si,adrsi mov di,adrdi mov al,2 mov ah,map1 and ah,map2 mov dx,3c4h out dx,ax mov ax,segment mov es,ax mov ax,$a800 mov ds,ax movsb pop ds END; SetWriteMode(0); Exit; END; ASM push ds cld mov dx,3c4h mov al,2 out dx,al inc dx mov al,map1 out dx,al mov si,adrsi mov di,adrdi mov cl,xcount mov ch,0 mov bx,segment mov es,bx mov bx,$a800 mov ds,bx movsb jcxz @1 mov al,15 out dx,al rep movsb { <- 0.25 instructions/pixel } @1: mov al,map2 out dx,al movsb pop ds END; SetWriteMode(0); END; PROCEDURE FillColorPoly(Count:Word; VAR A,C); VAR Point:ARRAY[0..9,0..1] OF Integer ABSOLUTE A; Color:ARRAY[0..9] OF Byte ABSOLUTE C; StartPoint,EndPoint,I,Y,DiffY:Word; CurrLeftPoint,CurrRightPoint,NextLeftPoint,NextRightPoint,MinY,MaxY, XD,YD,LX,RX,LX2,RX2,NextLeftY,NextRightY,YC,IncLeftColor, IncRightColor:Integer; LeftColor,RightColor:Integer; IncLeftX,IncRightX,LeftX,RightX:LongInt; LC,RC:Byte; BEGIN MinY:=Point[0,1]; MaxY:=Point[0,1]; StartPoint:=0; EndPoint:=0; FOR I:=1 TO Count-1 DO BEGIN IF Point[I,1]MaxY THEN BEGIN EndPoint:=I; MaxY:=Point[I,1]; END; END; DiffY:=MaxY-MinY; NextLeftPoint:=StartPoint; NextRightPoint:=StartPoint; NextLeftY:=Point[NextLeftPoint,1]; NextRightY:=Point[NextRightPoint,1]; FOR Y:=0 TO DiffY DO BEGIN IF Y<>DiffY THEN BEGIN IF MinY+Y=NextLeftY THEN BEGIN LX2:=32767; REPEAT CurrLeftPoint:=NextLeftPoint; NextLeftPoint:=(CurrLeftPoint+Count-1) MOD Count; XD:=(Point[NextLeftPoint,0]-Point[CurrLeftPoint,0]); IF Point[CurrLeftPoint,0]0; LeftColor:=Color[CurrLeftPoint]; YC:=Color[NextLeftPoint]-LeftColor; LeftColor:=LeftColor SHL 8; ASM mov ax,yc xchg al,ah cwd idiv yd mov incleftcolor,ax END; ASM db $66 xor ax,ax mov ax,xd db $66 shl ax,16 db $66 cwd db $66 xor bx,bx mov bx,yd db $66 idiv bx db $66 mov word ptr incleftx,ax END; LeftX:=LongInt(Point[CurrLeftPoint,0]) SHL 16; ASM db $66 mov ax,word ptr incleftx db $66 sub ax,0000h dw 0001h db $66 sar ax,1 db $66 sub word ptr leftx,ax END; NextLeftY:=Point[NextLeftPoint,1]; END; IF MinY+Y=NextRightY THEN BEGIN RX2:=-32768; REPEAT CurrRightPoint:=NextRightPoint; NextRightPoint:=(CurrRightPoint+1) MOD Count; XD:=(Point[NextRightPoint,0]-Point[CurrRightPoint,0]); IF Point[CurrRightPoint,0]>RX2 THEN RX2:=Point[CurrRightPoint,0]; YD:=(Point[NextRightPoint,1]-Point[CurrRightPoint,1]); UNTIL YD<>0; RightColor:=Color[CurrRightPoint]; YC:=Color[NextRightPoint]-RightColor; RightColor:=RightColor SHL 8; ASM mov ax,yc xchg al,ah cwd idiv yd mov incrightcolor,ax END; ASM db $66 xor ax,ax mov ax,xd db $66 shl ax,16 db $66 cwd db $66 xor bx,bx mov bx,yd db $66 idiv bx db $66 mov word ptr incrightx,ax END; RightX:=LongInt(Point[CurrRightPoint,0]) SHL 16; ASM db $66 mov ax,word ptr incrightx db $66 sub ax,0000h dw 0001h db $66 sar ax,1 db $66 sub word ptr rightx,ax END; NextRightY:=Point[NextRightPoint,1]; END; END ELSE ASM db $66 sar word ptr incleftx,1 db $66 sar word ptr incrightx,1 END; Inc(LeftColor,IncLeftColor); IF LeftColor<0 THEN LC:=0 ELSE IF LeftColor>30000 THEN LC:=127 ELSE LC:=LeftColor SHR 7; Inc(RightColor,IncRightColor); IF RightColor<0 THEN RC:=0 ELSE IF RightColor>30000 THEN RC:=127 ELSE RC:=RightColor SHR 7; ASM db $66 mov ax,word ptr leftx db $66 add ax,word ptr incleftx db $66 mov word ptr leftx,ax db $66 sar ax,16 db $66 mov bx,word ptr rightx db $66 add bx,word ptr incrightx db $66 mov word ptr rightx,bx db $66 sar bx,16 cmp ax,bx jng @1 xchg ax,bx mov dl,lc xchg dl,rc xchg lc,dl @1: mov cx,319 or ax,ax jnl @2 xor ax,ax or bx,bx jng @4 @2: cmp bx,cx jng @3 mov bx,cx cmp ax,cx jnl @4 @3: mov lx,ax mov rx,bx mov dx,miny add dx,y or dx,dx jl @4 cmp dx,199 jg @4 push ax push bx push dx mov al,lc push ax mov al,rc push ax call xcolorline @4: END; END; END; PROCEDURE FillPolygon(Count:Word; VAR A; Color:Byte); VAR Coord:ARRAY[0..3,0..1] OF Integer ABSOLUTE A; X1,X2,Y,Y1,Y2,MinY,MaxY,Divisor:Integer; I,Start,Left,Right:Word; LeftX,RightX,LeftInc,RightInc:LongInt; BEGIN END; PROCEDURE FillPhongPolygon(Count:Word; VAR A; VAR B); BEGIN END; PROCEDURE FillPhongTexturePoly(Count:Word; VAR A; VAR B); BEGIN END; PROCEDURE FillTexturePoly(Count:Word; VAR A); BEGIN END; PROCEDURE PerspectiveTexturePoly(Count:Word; VAR A); BEGIN END; PROCEDURE FillTinyTexturePoly(Count:Word; VAR A); BEGIN END; FUNCTION GetLight(ObjNr,Nr:Integer):Integer; VAR VAX,VAY,VAZ,VBX,VBY,VBZ:Integer; NX,NY,NZ:LongInt; P1,P2,P3,P11,P12,P13:Integer; Quadrat:Integer; BEGIN WITH Objects[ObjNr].Face[Nr] DO BEGIN P1:=P[1]; P2:=P[2]; P3:=P[3]; P11:=Dot[P1,1]; P12:=Dot[P1,2]; P13:=Dot[P1,3]; VAX:=Dot[P2,1]-P11; VAY:=Dot[P2,2]-P12; VAZ:=Dot[P2,3]-P13; VBX:=Dot[P3,1]-P11; VBY:=Dot[P3,2]-P12; VBZ:=Dot[P3,3]-P13; NX:=LongInt(VAY)*VBZ-LongInt(VAZ)*VBY; NY:=LongInt(VAZ)*VBX-LongInt(VAX)*VBZ; NZ:=LongInt(VAX)*VBY-LongInt(VAY)*VBX; ASM db $66 mov ax,word ptr nx db $66 cbw db $66 mov cx,ax db $66 imul cx db $66 mov bx,ax db $66 mov ax,word ptr ny db $66 cbw db $66 mov cx,ax db $66 imul cx db $66 add bx,ax db $66 mov ax,word ptr nz db $66 cbw db $66 mov cx,ax db $66 imul cx db $66 add bx,ax db $66 shr bx,12 inc bx db $66 div bx cmp ax,63*63 jl @1 mov ax,63*63 @1: mov word ptr quadrat,ax END; IF NZ<0 THEN GetLight:=-SqrtTable[Quadrat] ELSE GetLight:=SqrtTable[Quadrat]; END; END; FUNCTION Visible(ObjNr,Nr:Integer):Integer; VAR VAX,VAY,VAZ,VBX,VBY,VBZ:Integer; NX,NY,NZ:LongInt; P1,P2,P3,P11,P12,P13:Integer; Quadrat:Integer; BEGIN WITH Objects[ObjNr].Face[Nr] DO BEGIN P1:=P[1]; P2:=P[2]; P3:=P[3]; P11:=Dot[P1,1]; P12:=Dot[P1,2]; P13:=Dot[P1,3]; VAX:=Dot[P2,1]-P11; VAY:=Dot[P2,2]-P12; VBX:=Dot[P3,1]-P11; VBY:=Dot[P3,2]-P12; NZ:=LongInt(VAX)*VBY-LongInt(VAY)*VBX; IF NZ<0 THEN BEGIN Visible:=-1; Exit; END; VAZ:=Dot[P2,3]-P13; VBZ:=Dot[P3,3]-P13; NX:=LongInt(VAY)*VBZ-LongInt(VAZ)*VBY; NY:=LongInt(VAZ)*VBX-LongInt(VAX)*VBZ; ASM db $66 mov ax,word ptr nx db $66 cbw db $66 mov cx,ax db $66 imul cx db $66 mov bx,ax db $66 mov ax,word ptr ny db $66 cbw db $66 mov cx,ax db $66 imul cx db $66 add bx,ax db $66 mov ax,word ptr nz db $66 cbw db $66 mov cx,ax db $66 imul cx db $66 add bx,ax db $66 shr bx,12 inc bx db $66 div bx cmp ax,63*63 jl @1 mov ax,63*63 @1: mov word ptr quadrat,ax END; Visible:=SqrtTable[Quadrat]; END; END; PROCEDURE GetVec(VAR Vec:VecType; ObjNr,Nr:Integer); VAR VAX,VAY,VAZ,VBX,VBY,VBZ:Integer; NX,NY,NZ:LongInt; P1,P2,P3,P11,P12,P13:Integer; BEGIN WITH Objects[ObjNr].Face[Nr] DO BEGIN P1:=P[1]; P2:=P[2]; P3:=P[3]; P11:=Dot[P1,1]; P12:=Dot[P1,2]; P13:=Dot[P1,3]; VAX:=Dot[P2,1]-P11; VAY:=Dot[P2,2]-P12; VAZ:=Dot[P2,3]-P13; VBX:=Dot[P3,1]-P11; VBY:=Dot[P3,2]-P12; VBZ:=Dot[P3,3]-P13; NX:=LongInt(VAY)*VBZ-LongInt(VAZ)*VBY; NY:=LongInt(VAZ)*VBX-LongInt(VAX)*VBZ; NZ:=LongInt(VAX)*VBY-LongInt(VAY)*VBX; Vec[0]:=Integer(NX); Vec[1]:=Integer(NY); Vec[2]:=Integer(NZ); END; END; PROCEDURE DrawFace(ObjNr,Nr:Integer); VAR I,J,K,Color:Byte; PhongVec:ARRAY[1..6] OF VecType; PhongZ:ARRAY[1..6] OF Integer; PX:ARRAY[1..6,1..2] OF Integer; P3X:ARRAY[1..6,1..3] OF Integer; CX:ARRAY[1..6] OF Byte; L,MinX,MaxX,MinY,MaxY:Integer; Quotient:LongInt; BEGIN WITH Objects[ObjNr].Face[Nr] DO BEGIN IF NOT Gouraud THEN Light:=Visible(ObjNr,Nr); IF Light<0 THEN Exit; IF Lighted THEN Color:=Light ELSE Color:=Byte(Nr); IF FaceTyp>=3 THEN BEGIN MinX:=32767; MinY:=32767; MaxX:=-32767; MaxY:=-32767; IF PerspectiveTexture THEN BEGIN FOR J:=1 TO FaceTyp DO BEGIN P3X[J,1]:=Dot[P[J],1]; P3X[J,2]:=Dot[P[J],2]; P3X[J,3]:=Dot[P[J],3]; IF P3X[J,1]MaxX THEN MaxX:=P3X[J,1]; IF P3X[J,2]MaxY THEN MaxY:=P3X[J,2]; END; IF (MinX>319) OR (MinY>199) OR (MaxX<0) OR (MaxY<0) THEN Exit; PerspectiveTexturePoly(FaceTyp,P3X); END ELSE BEGIN FOR J:=1 TO FaceTyp DO BEGIN PX[J,1]:=Dot[P[J],1]; PX[J,2]:=Dot[P[J],2]; IF PX[J,1]MaxX THEN MaxX:=PX[J,1]; IF PX[J,2]MaxY THEN MaxY:=PX[J,2]; IF Phong OR PhongTexture THEN PhongZ[J]:=EdgeNorm[P[J]] ELSE IF Gouraud THEN BEGIN L:=EdgeLight[P[J]]; IF L<0 THEN L:=0 ELSE IF L>63 THEN L:=63; CX[J]:=L; END; END; IF (MinX>319) OR (MinY>199) OR (MaxX<0) OR (MaxY<0) THEN Exit; IF Phong THEN FillPhongPolygon(FaceTyp,PX,PhongZ) ELSE IF Gouraud THEN FillColorPoly(FaceTyp,PX,CX) ELSE IF Texture THEN FillTexturePoly(FaceTyp,PX) ELSE IF TinyTexture THEN FillTinyTexturePoly(FaceTyp,PX) ELSE IF PhongTexture THEN FillPhongTexturePoly(FaceTyp,PX,PhongZ) ELSE FillPolygon(FaceTyp,PX,Color); END; END; END; END; PROCEDURE SortFaces(ObjNr,Count:Integer); VAR I:Word; PROCEDURE Sort(L,R:Integer); VAR I,J,X,Y,XR:Integer; BEGIN WITH Objects[ObjNr] DO BEGIN I:=L; J:=R; XR:=Face[SortedFace[(L+R) SHR 1]].FarZ; REPEAT WHILE Face[SortedFace[I]].FarZ>XR DO Inc(I); WHILE XR>Face[SortedFace[J]].FarZ DO Dec(J); IF I<=J THEN BEGIN Y:=SortedFace[I]; SortedFace[I]:=SortedFace[J]; SortedFace[J]:=Y; Inc(I); Dec(J); END; UNTIL I>J; IF LSize THEN Inc(Size,15) ELSE Size:=65535; GetMem(P,Size); IF Ofs(P^)<>0 THEN P:=Ptr(Seg(P^)+1,0); END; PROCEDURE Init3D; VAR F:File; Rl:Real; Header:RECORD Dummy:ARRAY[0..8] OF Byte; XSize,YSize:Word; Dummy2:ARRAY[13..31] OF Byte; END; SpotStart:Byte; I,J:Word; BEGIN FOR I:=0 TO 319 DO BEGIN LineTable1[I]:=(15 SHL (I AND 3)) AND 15; LineTable2[I]:=(2 SHL (I AND 3))-1; END; FOR I:=0 TO 127 DO GTable[I]:=((I+3) SHR 1)*((I+4) SHR 1); NrPoints:=0; ReadObject(ParamStr(1)); IF ParamCount>1 THEN Val(ParamStr(2),Rl,Error); NoVert:=ParamStr(3)='n'; Lighted:=ParamStr(4)='l'; Gouraud:=ParamStr(4)='g'; Phong:=ParamStr(4)='p'; Texture:=ParamStr(4)='t'; TinyTexture:=ParamStr(4)='tt'; PhongTexture:=ParamStr(4)='pt'; PerspectiveTexture:=ParamStr(4)='ps'; ModeX:=NOT (Phong OR Texture OR TinyTexture OR PhongTexture OR PerspectiveTexture); IF Error=0 THEN BEGIN ScalX:=Round(ScalX*Rl); ScalY:=Round(ScalY*Rl); ScalZ:=Round(ScalZ*Rl); END ELSE BEGIN ScalX:=65536; ScalY:=65536; ScalZ:=65536; END; FOR I:=0 TO 900 DO Sinus[I]:=Round(Sin(I/1800*Pi)*65535); Segment:=$A000; {$IFDEF GLENZ} ASM mov ax,$d int $10 END; ASM mov dx,3ceh mov ax,1003h out dx,ax END; SetColor(0,0,0,0); SetColor(1,63,0,0); SetColor(2,0,63,0); SetColor(3,63,63,0); SetColor(4,0,0,63); SetColor(5,63,0,63); SetColor(6,0,63,63); SetColor(7,63,63,63); {$ELSE} IF ModeX THEN Init13X ELSE BEGIN MCGAOn; GetAdjMem(VirtualScreen,64000); END; {$ENDIF} IF Gouraud THEN SetupTable; IF Lighted OR Gouraud THEN FOR I:=0 TO 63 DO SetColor(I,0,I,0) ELSE IF Phong OR PhongTexture THEN BEGIN END; J:=0; FillChar(Dummy,4096,0); FOR I:=0 TO 4095 DO BEGIN IF (J+1)*(J+1)=I THEN Inc(J); SqrtTable[I]:=J; END; U:=0; V:=0; W:=0; XOfs:=0; YOfs:=0; ZOfs:=0; J:=0; FlipPage; {$IFDEF TIMER} Port[$43]:=$34; Port[$40]:=0; Port[$40]:=66; {$ENDIF} LX:=1; LY:=1; LZ:=1; LNorm:=LongInt(LX)*LX+LongInt(LY)*LY+LongInt(LZ)*LZ; END; PROCEDURE TextMode; ASSEMBLER; ASM mov ax,3 int 10h END; PROCEDURE StartTimer; BEGIN Zeit:=Ticker; END; PROCEDURE StopTimer; BEGIN Zeit:=Ticker-Zeit; END; BEGIN IF ParamCount=0 THEN BEGIN WriteLn('Syntax: 3DOBJ2 model size retrace lightshading-type'); WriteLn(' where model.xyz is a coordinate file, size a real number,'); WriteLn(' i.e. 1 around, retrace either ''n'' for no Vertical'); WriteLn(' Retrace Checking, or any other char for doing it, light'); WriteLn(' can be either n (normal), l (lightshaded), g (gouraud),'); WriteLn(' p (phong), t (texture), tt (tiny texture), pt (phongtexture)'); WriteLn(' or ps (perspective texture).'); Halt; END; Init3D; FOR I:=0 TO 127 DO Key[I]:=FALSE; GetIntVec($09,SaveInt09); SetIntVec($09,@NewInt09); StartTimer; Phase:=0; U:=410; V:=758; W:=0; REPEAT LastTimer:=Timer; FlipPage; {$IFDEF MEASURE} SetColor(0,63,63,63); {$ENDIF} Inc(J); TransformPoints; ClearScreen; IF Phong OR PhongTexture THEN BEGIN FillChar(EdgeVec,SizeOf(EdgeVec),0); FOR I:=1 TO ObjectCount DO PhongLightObject(I); FOR I:=1 TO NrPoints DO BEGIN Quotient:=IntSqrt(Sqr(LongInt(EdgeVec[I,0]))+ Sqr(LongInt(EdgeVec[I,1]))+Sqr(LongInt(EdgeVec[I,2]))); IF Quotient=0 THEN Inc(Quotient); EdgeNorm[I]:=(LongInt(EdgeVec[I,2]) SHL 14) DIV Quotient; END; END ELSE IF Gouraud THEN BEGIN FOR I:=1 TO NrPoints DO BEGIN EdgeLight[I]:=0; EdgeLightCount[I]:=0; END; FOR I:=1 TO ObjectCount DO LightObject(I); FOR I:=1 TO NrPoints DO EdgeLight[I]:=EdgeLight[I] DIV EdgeLightCount[I]; END; FOR I:=1 TO ObjectCount DO DrawObject(I); IF NOT ModeX THEN TransferScreen; FOR I:=1 TO Byte(Timer-LastTimer) DO BEGIN IF Key[75] THEN Dec(XOfs,4096); IF Key[77] THEN Inc(XOfs,4096); IF Key[72] THEN Dec(YOfs,4096); IF Key[80] THEN Inc(YOfs,4096); IF Key[74] THEN Dec(ZOfs,4096); IF Key[78] THEN Inc(ZOfs,4096); IF Key[16] THEN Inc(U,8); IF Key[17] THEN Inc(V,8); IF Key[18] THEN Inc(W,8); IF Key[30] THEN Dec(U,8); IF Key[31] THEN Dec(V,8); IF Key[32] THEN Dec(W,8); END; U:=(U+3620) MOD 3600; V:=(V+3620) MOD 3600; W:=(W+3600) MOD 3600; {$IFDEF MEASURE} SetColor(0,0,0,0); {$ENDIF} Inc(Phase); UNTIL {(Phase=64) OR} Key[1]; StopTimer; TextMode; Port[$43]:=$34; Port[$40]:=0; Port[$40]:=0; WriteLn(J/(Zeit/70.5):7:2,' fps'); WriteLn(Zeit); SetIntVec($09,SaveInt09); END. {SPHERES.XYZ--------Diese Zeile bitte loeschen!------------------------------} scal 70 object sphere scal 0.02 coords 0 0 40 0 0 40 0 0 40 0 0 40 0 0 40 0 0 40 0 0 40 0 0 40 0 12 32 9 9 32 12 0 32 9 -9 32 0 -12 32 -9 -9 32 -12 0 32 -9 9 32 0 25 12 18 18 12 25 0 12 18 -18 12 0 -25 12 -18 -18 12 -25 0 12 -18 18 12 0 25 -12 18 18 -12 25 0 -12 18 -18 -12 0 -25 -12 -18 -18 -12 -25 0 -12 -18 18 -12 0 12 -32 9 9 -32 12 0 -32 9 -9 -32 0 -12 -32 -9 -9 -32 -12 0 -32 -9 9 -32 0 0 -40 0 0 -40 0 0 -40 0 0 -40 0 0 -40 0 0 -40 0 0 -40 0 0 -40 faces 1 9 10 2 10 11 3 11 12 4 12 13 5 13 14 6 14 15 7 15 16 8 16 9 9 17 18 10 10 18 19 11 11 19 20 12 12 20 21 13 13 21 22 14 14 22 23 15 15 23 24 16 16 24 17 9 17 25 26 18 18 26 27 19 19 27 28 20 20 28 29 21 21 29 30 22 22 30 31 23 23 31 32 24 24 32 25 17 25 33 34 26 26 34 35 27 27 35 36 28 28 36 37 29 29 37 38 30 30 38 39 31 31 39 40 32 32 40 33 25 33 42 34 34 43 35 35 44 36 36 45 37 37 46 38 38 47 39 39 48 40 40 41 33 objend