Copy Link
Add to Bookmark
Report
Atari shading
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]<MinY THEN
BEGIN
StartPoint:=I;
MinY:=Point[I,1];
END;
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]<LX2 THEN
LX2:=Point[CurrLeftPoint,0];
YD:=(Point[NextLeftPoint,1]-Point[CurrLeftPoint,1]);
UNTIL YD<>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]<MinX THEN MinX:=P3X[J,1];
IF P3X[J,1]>MaxX THEN MaxX:=P3X[J,1];
IF P3X[J,2]<MinY THEN MinY:=P3X[J,2];
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]<MinX THEN MinX:=PX[J,1];
IF PX[J,1]>MaxX THEN MaxX:=PX[J,1];
IF PX[J,2]<MinY THEN MinY:=PX[J,2];
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 L<J THEN Sort(L,J);
IF L<R THEN Sort(I,R);
END;
END;
BEGIN
Sort(0,Count-1);
END;
PROCEDURE DrawObject(Nr:Integer);
VAR
I,J:Integer;
BEGIN
WITH Objects[Nr] DO
BEGIN
FOR I:=1 TO NrFaces DO
BEGIN
SortedFace[I-1]:=I;
WITH Face[I] DO
BEGIN
FarZ:=Dot[P[1],3];
FOR J:=2 TO FaceTyp DO
IF Dot[P[J],3]<FarZ THEN
FarZ:=Dot[P[J],3];
END;
END;
SortFaces(Nr,NrFaces);
FOR I:=1 TO NrFaces DO
DrawFace(Nr,SortedFace[I-1]);
END;
END;
PROCEDURE LightFace(ObjNr,Nr:Integer);
VAR
J:Byte;
BEGIN
WITH Objects[ObjNr].Face[Nr] DO
BEGIN
Light:=GetLight(ObjNr,Nr);
FOR J:=1 TO FaceTyp DO
BEGIN
Inc(EdgeLight[P[J]],Light);
Inc(EdgeLightCount[P[J]]);
END;
END;
END;
PROCEDURE LightObject(Nr:Integer);
VAR
I:Integer;
BEGIN
WITH Objects[Nr] DO
FOR I:=1 TO NrFaces DO LightFace(Nr,I);
END;
PROCEDURE PhongLightFace(ObjNr,Nr:Integer);
VAR
I:Word;
Vector:VecType;
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;
FOR I:=1 TO FaceTyp DO
BEGIN
P1:=P[I];
Inc(EdgeVec[P1,0],Integer(NX));
Inc(EdgeVec[P1,1],Integer(NY));
Inc(EdgeVec[P1,2],Integer(NZ));
END;
END;
END;
PROCEDURE PhongLightObject(Nr:Integer);
VAR
I:Integer;
BEGIN
WITH Objects[Nr] DO
FOR I:=1 TO NrFaces DO
PhongLightFace(Nr,I);
END;
PROCEDURE SetStart(S:Word);
BEGIN
ASM
mov bx,s
mov dx,$3d4
mov al,$c
mov ah,bh
out dx,ax
inc ax
mov ah,bl
out dx,ax
END;
END;
PROCEDURE VerticalRetrace;
BEGIN
ASM
mov dx,3dah
@1: in al,dx
test al,8
jz @1
@2: in al,dx
test al,8
jnz @2
END;
END;
PROCEDURE FlipPage;
BEGIN
IF NOT ModeX THEN
BEGIN
Segment:=Seg(VirtualScreen^);
SetStart(0);
END
ELSE
IF Flip THEN
BEGIN
Segment:=$A400;
SetStart($0000);
END
ELSE
BEGIN
Segment:=$A000;
SetStart($4000);
END;
IF NOT NoVert AND NOT Phong THEN VerticalRetrace;
Flip:=NOT Flip;
END;
PROCEDURE ClearScreen;
VAR
Count:Word;
BEGIN
IF ModeX THEN
BEGIN
SetWriteMap(15);
Count:=4000;
END
ELSE Count:=16000;
ASM
mov ax,segment
mov es,ax
xor di,di
{$IFDEF GLENZ}
mov cx,2000
mov dx,3ceh
mov ax,0003h
out dx,ax
{$ELSE}
mov cx,count
{$ENDIF}
cld
db $66
xor ax,ax
rep
db $66
stosw
{$IFDEF GLENZ}
mov dx,3ceh
mov ax,1003h
out dx,ax
{$ENDIF}
END;
END;
PROCEDURE TransferScreen; ASSEMBLER;
ASM
push ds
lds si,virtualscreen
mov ax,0a000h
mov es,ax
xor di,di
mov cx,16000
db 66h
rep movsw
pop ds
END;
PROCEDURE BuildDivTable;
VAR
I,Result:Word;
BEGIN
END;
PROCEDURE MCGAOn;
BEGIN
ASM
mov ax,$13
int $10
END;
END;
PROCEDURE SwitchOff; ASSEMBLER;
ASM
mov dx,$3c4
mov al,1
out dx,al
inc dx
in al,dx
or al,$20
out dx,al
END;
PROCEDURE SwitchOn; ASSEMBLER;
ASM
mov dx,$3c4
mov al,1
out dx,al
inc dx
in al,dx
and al,$df
out dx,al
END;
PROCEDURE Unchain;
BEGIN
PortW[$3C4]:=$0604;
PortW[$3D4]:=$0014;
PortW[$3D4]:=$E317;
PortW[$3C4]:=$0F02;
END;
PROCEDURE Init13X;
BEGIN
MCGAOn;
SwitchOff;
Unchain;
ClearScreen;
SwitchOn;
END;
PROCEDURE SetColor(Nr,R,G,B:Byte);
BEGIN
Port[$3C8]:=Nr;
Port[$3C9]:=R;
Port[$3C9]:=G;
Port[$3C9]:=B;
END;
PROCEDURE GetAdjMem(VAR P:Pointer; Size:Word);
BEGIN
IF Word(Size+15)>Size 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 
