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



