%begin
%include "ram_1:graph.inc"
%include "ram_1:random.inc"
%system%string(255)%fn%spec ITOS(%integer v,p)
@16_10D4 %integer %fn Test Symbol
%const %real PI = 3.141592653589793238462643
%system %routine %spec Read Line (%string (*) %name s)
%const %integer No Page = 8
@16_1140 %routine Set Terminal Mode (%integer Mode)
%external %real %fn %spec Sin (%real x)
%external %real %fn %spec Cos (%real x)
%const %byte XY = 0, XZ = 1, YZ = 2
%const %integer PMax = 800; ! max points & polygons
%const %integer Max Stars = 100
%short %array Stars (1:Max Stars,1:2)
%short OX, OY, MX = -1, MY = -1,Temp, Di = 10
%integer StB,StT
%string (30) File,fa,fb
%const %short One  = 16_4000,
              Zero = 0,
              f128 = One>>7
%const %byte Background = 9, Shade Line Col = Black, Hidden Poly Col = Black,
             Hidden Line Col = White, Wire Col = White, Invisible = 255
%const %integer Big = 256 << 6 - One
%record %format Pt  (%short X, Y, Z)
%record %format RPt  (%real X, Y, Z)
%record %format Matrix (%record (Pt) A,B,C)
%record (Matrix) R,T
%short %array Sine, Cosine (0:359)
%record %format Polt (%short Depth, %byte Num,Col,Col2,
                      %record (Pt) %array V(1:32))
%record (Pt) %array %name PV (1:32)
%record (Pt) %name PpV, QpV
%record (Polt) %array P,Q (0:PMax)
%record (Polt) %name Pp,Qp
%record (Polt) %name %array PL (0:Pmax)
%switch TD (32:122)
%const %short Ambient = 8
%short xp,yp,Ang = 30, Max
%const %real Rad = Pi/180
%const %byte True = 1, False = 0
%byte Shading = False, Shade Line = False, Hidden = False, Show = True
%byte Moving = False, Changing = False, Show Stars = False, ReCalc
%real A,Len
%short Sc, xa, ya, za
%integer Num Ships
%record %format SF (%short CX, CY, Dist)
%record (SF) Sp
%record (RPt) Light
%integer CX,CY
%short DS
%short Lx = 10, Ly = -10, Lz = -10
%integer ships,ii,i,j,k,NumPoly
%byte MB

%short %fn Product (%short A,B)
%short Res
   *Move.w A,d0
   *Muls   B,d0
   *Asl.l   #2,d0
   *Swap   d0
   *Move.w d0,Res
   %result = Res
%end

%routine Rite (%short n)
   Print (Float(n)/One,2,4)
%end

%routine Swap (%short %name A, B)
   Temp = A; A = B; B = Temp
%end

%routine Transpose (%record (Matrix) %name M)
   Swap (M_A_Y, M_B_X)
   Swap (M_B_Z, M_C_Y)
   Swap (M_A_Z, M_C_X)
%end

%routine Transform (%record (Matrix) %name M, %record (Pt) %name O,O2)
%record (Pt) N
   N_X =Product(O_X,M_A_X)+Product(O_Y,M_A_Y)+Product(O_Z,M_A_Z)
   N_Y =Product(O_X,M_B_X)+Product(O_Y,M_B_Y)+Product(O_Z,M_B_Z)
   N_Z =Product(O_X,M_C_X)+Product(O_Y,M_C_Y)+Product(O_Z,M_C_Z)
   O2 = N
%end

%routine MMult (%record (Matrix) %name P,Q)
   Transpose (Q)
   Transform (P, Q_A, Q_A)
   Transform (P, Q_B, Q_B)
   Transform (P, Q_C, Q_C)
   Transpose (Q)
%end

%routine Load Trig Tables
%real Rads
%integer Th
   %for Th = 0,1,359 %cycle
         Rads = Float (Th) * Rad
         Sine (Th) = Int (One * Sin (Rads))
         Cosine (Th) = Int (One * Cos (Rads))
   %repeat
%end

%routine Quick Sort (%short A, B)
%short l,u
%record (Polt) %name Pp
   %while a < b %cycle
      l = a; u = b
      Pp == PL(u)
      -> Get
Up:   l = l + 1
      -> Got %if l = u
Get:  -> Up %unless Pp_Depth > PL(l)_Depth
      PL(u) == PL(l)
Down: u = u - 1
      -> Got %if l = u
      -> Down %unless Pp_Depth < PL(u)_Depth
      PL(l) == PL(u)
      -> Up
Got:  PL(u) == Pp
      l = l - 1
      u = u + 1
      %if l - a > b - l %then Quick Sort (u,b) %and b = l %c
                        %else Quick Sort (a,l) %and a = u
   %repeat
%end

%byte %fn Get Mouse
%byte M,N
%integer i
   %cycle
      M = Mouse Buttons
      N = Mouse Buttons %for i = 1,1,2000
   %repeat %until M = N
   %result = M
%end

%routine Convert
   OX = MX; OY = MY
   MX = (MouseX//3) & 1023
   MY = (MouseY//3) & 1023
%end

%routine Rotate (%short xa, ya, za)
%integer i,j
   T = 0
   T_A_X = One; T_B_Y = One; T_C_Z = One
   %if za # 0 %start
      R = 0
      R_A_X = Cosine (za)
      R_B_Y = Cosine (za)
      R_A_Y = Sine (za)
      R_B_X = -Sine (za)
      R_C_Z = One
      MMult (R,T)
   %finish
   %if ya # 0 %start
      R = 0
      R_A_X = Cosine (ya)
      R_C_Z = Cosine (ya)
      R_A_Z = Sine (ya)
      R_C_X = -Sine (ya)
      R_B_Y = One
      MMult (R,T)
   %finish
   %if xa # 0 %start
      R = 0
      R_B_Y = Cosine (xa)
      R_C_Z = Cosine (xa)
      R_B_Z = Sine (xa)
      R_C_Y = -Sine (xa)
      R_A_X = One
      MMult (R,T)
   %finish
   Pp == P(0); Qp == Q(0)
   %for i = 0,1,Num Poly %cycle
      PL(i) == Q(i)
      PpV == Pp_V(1); QpV == Qp_V(1)
      Qp_Num = Pp_Num
      %for j = 1,1,Pp_Num %cycle
         Transform (T,PpV,QpV)
         QpV_X = QpV_X-Big; QpV_Y = QpV_Y-Big; QpV_Z = QpV_Z-Big
         PpV == PpV[1]; QpV == QpV[1]
      %repeat
      Pp == Pp[1]; Qp == Qp[1]
   %repeat
%end

%byte %fn Shade (%record (Pt) %name P1, P2, P3)
%byte dp, %real Len
%record (RPt) N, T1, T2
%real Dot

%integerfn Sign (%name N)
{** SIGN returns the sign (-1 or 1) of a real by inspecting its top bit
{** 
   %result=-1 %if 16_80000000 & Integer(Addr(N)) # 0; %result=1
%end

    T1_x=P1_x-P2_x; T1_y=P1_y-P2_y; T1_z=P1_z-P2_z            {** T1 = P1-P2 **}
    T2_x=P1_x-P3_x; T2_y=P1_y-P3_y; T2_z=P1_z-P3_z            {** T2 = P1-P3 **}
    N_X=T1_Y*T2_Z-T1_Z*T2_Y                         {** N = Cross product of **}
    N_Y=T1_Z*T2_X-T1_X*T2_Z                         {** T1 and T2, ie is the **}
    N_Z=T1_X*T2_Y-T1_Y*T2_X                         {** normal of the poly.  **}
    Len=Sqrt(N_X*N_X+N_Y*N_Y+N_Z*N_Z)               {** Make N a unit vector **}
    %if Len # 0 %start
       N_X=N_X/Len; N_Y=N_Y/Len; N_Z=N_Z/Len
    %finish
    Dot = N_X*Light_X+N_Y*Light_Y+N_Z*Light_Z
    %if Sign (Dot) = - Sign (N_Z) %c
      %then %result = Ambient + IntPt ( (31-Ambient) * |Dot|)
    %result = Ambient
%end

%routine Init
%byte Col = White << 5, Col2
%real A
%integer PtNum
%record (Pt) %array Pn (1:PMax)
%record (Pt) %name Pp
%record (Polt) %name Pt
%short %array Ad ('A':'z')
   PrintString ("Opening ".File."... ")
   Open Input (3,File)
   Select Input (3)
   PtNum = 1
   Read Symbol (j) %until j = '#'
   %cycle
      Read Symbol (j) %until j # ' ' %and j # NL
      %exit %if j = '$'
      Ad (j) = PtNum - 1
      %cycle
         Read Symbol (j) %until j = ':' %or j = '$'
         %exit %if j = '$'
         Pp == Pn(PtNum)
         Read (A); Pp_X = Int (f128*A)
         Read (A); Pp_Y = Int (f128*A)
         Read (A); Pp_Z = Int (f128*A)
         PtNum = PtNum + 1
      %repeat
   %repeat
   Write(PtNum,0);PrintString (" Points, and ")
   Num Poly = -1
   Read Symbol (j) %until j = '#'
   %cycle
      Read Symbol (j) %until j = ':' %or j = '$' %or j = '>'
      %exit %if j = '$'
      %if j = '>' %start
         Read (Col); %if Col = Invisible %thenc
                     Read (Col2) %and Col2 = Col2 << 5 %else Col = Col << 5
         %continue
      %finish
      NumPoly = NumPoly + 1
      Pt == P(NumPoly)
      Q(NumPoly)_Col = Col
      Q(NumPoly)_Col2 = Col2 %if Col = Invisible
      Read (Pt_Num)
      %for j = 1,1,Pt_Num %cycle
         ReadSymbol (i) %until i # ' ' %and i # NL
         Read (k)
         k = k + Ad (i)
         Pt_V(j) = Pn(k)
      %repeat
   %repeat
   Read Symbol (j) %until j = '#'
   Read (Num Ships)
   Num Ships = 1
   Read (Sp_CX); Read (Sp_CY); Read (Sp_Dist)
   Read (XA); %if xa >= 360 %then xa = xa - 360 %elsec
              %if xa < 0 %then xa = xa + 360
   Read (YA); %if Ya >= 360 %then Ya = Ya - 360 %elsec
              %if Ya < 0 %then Ya = Ya + 360
   Read (ZA); %if Za >= 360 %then Za = Za - 360 %elsec
              %if Za < 0 %then Za = Za + 360
   Close Input
   Select Input (0)
   Write(NumPoly,0);PrintString (" Polygons read in".nls.nls)
%end

%routine Up
   PrintSymbol(27);PrintSymbol('A')
   PrintSymbol(13);PrintSymbol(27);PrintSymbol('t')
%end
 
%routine Set up Stars
%short j
   StB = Addr(Stars(1,1))
   StT = Addr(Stars(MaxStars,2))
   %for i = 1,1,Max Stars %cycle
      Stars (i,1) = Random Int (1,686)
      Stars (i,2) = Random Int (1,510)
   %repeat     
%end

%routine Draw Ship
   %if Show Stars = True %start
      Half Clear (DS>>9)
      *Move.b #White, Colour Reg
      *Movea.l StB,a1
      StLp:
      *Move.w (a1)+,xp
      *move.w (a1)+,d0
      *add.w DS,d0
      *Move.w d0,yp
      Frame (yp<<5+xp>>5)=1<<(31-xp&31)
      *cmpa.l StT,a1
      *ble StLp
   %else
      Set Colour (Background)
      Fill (0,DS,687,511+DS)
   %finish
   OffSet (0,DS) %if Show = True
   CX = Sp_CX
   CY = Sp_CY + DS
   %if Hidden = True %start
      %if ReCalc = True %start
         Qp == Q(0)
         %for i = 0,1,NumPoly %cycle
            PV == Qp_V
            Max = PV(1)_Z
            %for j = 1,1,Qp_Num %cycle
               Max = PV(j)_Z %if PV(j)_Z > Max
            %repeat
            Qp_Depth = Max
            Qp == Qp[1]
         %repeat
         Quick Sort (0, Num Poly)
      %finish
      %for i = 0,1,NumPoly %cycle
         Qp == PL(i)
         PV == Qp_V
         %if Shading = True %start
            %if Qp_Num >= 3 %and Qp_Col # Invisible %start
               %if Qp_Col = Black %then Set Colour (Black) %elsec
                  Set Colour (Qp_Col+Shade(PV(1), PV(2), PV(3)))
               Poly (PV(j)_X//SC+CX, 
                     PV(j)_Y//SC+CY) %for j = 1,1,Qp_Num
               Close Poly
            %finish
            %if Qp_Col = Invisible %start
               Set Colour (Qp_Col2+Shade(PV(1), PV(2), PV(3)))
               Line(PV(j)_X//SC+CX,PV(j)_Y//SC+CY,
                    PV(j+1)_X//SC+CX,PV(j+1)_Y//SC+CY) %for j=1,1,Qp_Num-1
               Line(PV(1)_X//SC+CX,PV(1)_Y//SC+CY,
                    PV(Qp_Num)_X//SC+CX,PV(Qp_Num)_Y//SC+CY)
            %finishelsec
            %if Shade Line = True %start
               Set Colour (Shade Line Col)
               Line(PV(j)_X//SC+CX,PV(j)_Y//SC+CY,
                    PV(j+1)_X//SC+CX,PV(j+1)_Y//SC+CY) %for j=1,1,Qp_Num-1
               Line(PV(1)_X//SC+CX,PV(1)_Y//SC+CY,
                    PV(Qp_Num)_X//SC+CX,PV(Qp_Num)_Y//SC+CY)
            %finish
         %else
            %if Qp_Num >= 3 %and Qp_Col # Invisible %start
               Set Colour (Hidden Poly Col)
               Poly (PV(j)_X//SC+CX, 
                     PV(j)_Y//SC+CY) %for j = 1,1,Qp_Num
               Close Poly
            %finish
            %if Qp_Col = Invisible %then Set Colour (Qp_Col2>>5) %elsec
            Set Colour (Hidden Line Col)
            Line(PV(j)_X//SC+CX,PV(j)_Y//SC+CY,
                 PV(j+1)_X//SC+CX,PV(j+1)_Y//SC+CY) %for j=1,1,Qp_Num-1
            Line(PV(1)_X//SC+CX,PV(1)_Y//SC+CY,
                 PV(Qp_Num)_X//SC+CX,PV(Qp_Num)_Y//SC+CY)
         %finish
      %repeat
   %else
      Qp == Q(0)
      %for i = 0,1,Num Poly %cycle
         PV == Qp_V
         Set Colour (Wire Col)
         Line(PV(j)_X//SC+CX,PV(j)_Y//SC+CY,
              PV(j+1)_X//SC+CX,PV(j+1)_Y//SC+CY) %for j=1,1,Qp_Num-1
         Line(PV(1)_X//SC+CX,PV(1)_Y//SC+CY,
              PV(Qp_Num)_X//SC+CX,PV(Qp_Num)_Y//SC+CY)
         Qp == Qp[1]
      %repeat
   %finish
   OffSet (0,DS) %unless Show = True
   DS = 512 - DS
%end

Setup
VClear
Frame Message %if APM Level # 1.5
Set Terminal Mode (No Page)
Initialise Random
Set up Stars
File = CliParam
Load Trig Tables
PrintString (nls."General (Depth Sorting) Polygons Program".nls.nls)
Stahrt:
%if File = "" %start
   PrintSymbol(13)
   Prompt("File (ED, TORUS, 2001, CHESS2, CUP2) : ")
   %cycle; %repeat %until Test Symbol = -1
   Read Line(File); File = "ram_1:Ed" %if File = ""
%if File -> fA.(":").fB %start
   File = fA.":".fB
%finishelse File = "ram_1:".File
%finish
Clear All
PrintString (nls."General (Depth Sorting) Polygons Program".nls.nls)
PrintString("MsR,L,M = Rotate X,Y,Z, or any combination of buttons".nls)
PrintString("Move Mouse to move shape, if Moving option selected".nls)
PrintString("a = Enter Increment Angle     ' '  = Negate Current Angle".nls)
PrintString("v = Move Towards Shape          b  = Move Away from Shape".nls)
PrintString("c = Enter X,Y Coordinates       r  = Enter angles X,Y,Z".nls)
PrintString("h = Hidden Line On/Off          s  = Shading On/Off".nls)
PrintString("z = Shade Line On/Off           l  = Enter Light Vector".nls)
PrintString("d = Change Distance             i  = Change Distance Inc".nls)
PrintString("m = Moving On/Off               f  = Enter File Name".nls)
PrintString("q = Drawing Visiblity On/Off    g  = Toggle Stars or Blue".nls.nls)
Init
ReCalc = Hidden
Len = Sqrt(Lx*Lx + Ly*Ly + Lz*Lz)
Light_X = Lx/Len; Light_Y = Ly/Len; Light_Z = Lz/Len
%for i = 1,1,7 %cycle
   k = 32*i
   Mix Colour (k+j, (i&1)*j, (i&2)>>1*j, (i&4)>>2*j) %for j = 0,1,31
%repeat
mix colour (9,6,5,11)

mousex = 0; mousey = 0
convert
DS = 512
Sc = Sp_Dist { >> 1
Rotate (xa,ya,za)
Draw Ship
%cycle; %repeat %until TestSymbol = -1
%cycle
   Changing = False
   ReCalc = False
   %cycle
      PrintSymbol(13);PrintSymbol(27);PrintSymbol('t')
      MB = Get Mouse
      ii = Test Symbol
      %if MB # MsNone %start
         %if MB & 1 = 1 %start
            xa = xa + Ang; %if xa >= 360 %then xa = xa - 360 %elsec
                           %if xa < 0 %then xa = xa + 360
         %finish
         %if MB & 2 = 2 %start
            ya = ya + Ang; %if ya >= 360 %then ya = ya - 360 %elsec
                           %if ya < 0 %then ya = ya + 360
         %finish
         %if MB & 4 = 4 %start
            za = za + Ang; %if za >= 360 %then za = za - 360 %elsec
                           %if za < 0 %then za = za + 360
         %finish
         Changing = True; ReCalc = True
         Rotate (xa,ya,za)
      %finish
      -> Nex %if ii = -1
      PrintSymbol(ii); PrintString ("...")
      -> TD(ii)
      TD('r'):
         PrintSymbol(13);PrintSymbol(27);PrintSymbol('t')
         %cycle; %repeat %until Test Symbol = -1
         Prompt ("X Angle (Currently ".Itos(Xa,0).") : ")
         read(Xa) %and Up %until -359 <= Xa <= 359
         Xa = Xa + 360 %if Xa < 0
         Prompt ("Y Angle (Currently ".Itos(Ya,0).") : ")
         read(Ya) %and Up %until -359 <= Ya <= 359
         Ya = Ya + 360 %if Ya < 0
         Prompt ("Z Angle (Currently ".Itos(Za,0).") : ")
         read(Za) %and Up %until -359 <= Za <= 359
         Za = Za + 360 %if Za < 0
         %cycle; %repeat %until Test Symbol = -1
         Changing = True
         ReCalc = True
         Rotate (xa,ya,za)
         -> Nex
      TD(' '):
         Ang = -Ang
      -> Nex
      TD('f'): File = ""; -> Stahrt
      TD('m'): Moving = 1 - Moving; Changing = Moving; -> Nex
      TD ('q'):
      Show = 1 - Show
      %cycle; %repeat %until Test Symbol = -1
      Changing = Show           {** ie: only Change if we are rebuilding
      -> Nex
      TD('s'):
      Shading = 1-Shading
      ReCalc = True %if Hidden = False %and Shading = True
      Hidden = True %if Shading = True
      Changing = True
      -> Nex
      TD('g'):
      Show Stars = 1 - Show Stars
      %if Show Stars = True %then Half Clear ((Ds-1)>>9)
      Changing = True
      -> Nex
      TD('z'):
      Shade Line = 1-Shade Line
      Changing = Shading         {** ie: only Change if we are shading
      -> Nex
      TD('h'):
      Hidden = 1-Hidden; ReCalc = Hidden
      Shading = False %if Hidden = False
      Changing = True
      -> Nex
      TD('l'):
      PrintSymbol(13);PrintSymbol(27);PrintSymbol('t')
      %cycle; %repeat %until Test Symbol = -1
      Prompt ("Light_X (Currently ".Itos(Lx,0).") : ");read(Lx);Up
      Prompt ("Light_Y (Currently ".Itos(LY,0).") : ");read(LY);Up
      Prompt ("Light_Z (Currently ".Itos(LZ,0).") : ");read(LZ);Up
      Len = Sqrt(Lx*Lx + Ly*Ly + Lz*Lz)
      %if Len # 0 %start
         Light_X=Lx/Len; Light_Y=Ly/Len; Light_Z=Lz/Len
      %finish
      Changing = True
      %cycle; %repeat %until Test Symbol = -1
      -> Nex
      TD('a'):
         PrintSymbol(13);PrintSymbol(27);PrintSymbol('t')
         %cycle; %repeat %until Test Symbol = -1
         Prompt ("Increment Angle (Currently ".Itos(Ang,0).") : ");read (ang);Up
         %cycle; %repeat %until Test Symbol = -1
         -> Nex
      TD('i'):
         PrintSymbol(13);PrintSymbol(27);PrintSymbol('t')
         %cycle; %repeat %until Test Symbol = -1
         Prompt ("Distance Increment (Currently ".Itos(Di,0).") : ")
         read (Di);Up
         %cycle; %repeat %until Test Symbol = -1
         -> Nex
      TD('d'):
         PrintSymbol(13);PrintSymbol(27);PrintSymbol('t')
         %cycle; %repeat %until Test Symbol = -1
         Prompt ("Distance (Currently ".Itos(Sc,0).") : ");read (Sc);Up
         Changing = True
         %cycle; %repeat %until Test Symbol = -1
         -> Nex
      TD('c'):
         PrintSymbol(13);PrintSymbol(27);PrintSymbol('t')
         %cycle; %repeat %until Test Symbol = -1
         Prompt ("CentreX (Currently ".Itos(Sp_Cx,0).") : ");read (sp_cx);Up
         Prompt ("CentreY (Currently ".Itos(Sp_CY,0).") : ");read (sp_cY);Up
         Changing = True
         %cycle; %repeat %until Test Symbol = -1
         -> Nex
      TD('v'):
         Sc = Sc - Di %unless Sc <= Di
         Changing = True
         %cycle; %repeat %until Test Symbol = -1
         -> Nex
      TD('b'):
         Sc = Sc + Di
         Changing = True
         %cycle; %repeat %until Test Symbol = -1
         -> Nex
      TD(*): ii = -1
      Nex: 
      %if Moving = True %start
         Convert
         i = mx - ox; j = my - oy
         sp_cx = (sp_cx + i) & 1023
         sp_cy = (sp_cy + j) & 1023
         ii = 1 %if i # 0 %or j # 0
         Changing = True
       %finish
   %repeat %until MB # MsNone %or ii # -1

   Draw Ship %if Changing = True

%repeat
%endofprogram