%include "level1:graphinc.imp"
%include "inc:random.imp"
%include "inc:util.imp"
%include "demo:iff:iffinc.imp"
%begin ;! ------------------------------ outer block ------------------------
!Solid body modeller - original version by P. Reid.
!Looks a hack - no clipping and crashes out frequently.
!Modded JHB Oct 86
!All comments inserted by JHB from examination of program.

   !Input file Formats:
   !1) Peter Reid's format...
   !All text ignored up to and including a '#' character.
   !Then up to 58 point sets may follow. Each of form..

   !First printable character taken as point set name. 'A'<=char<='z'
   !then lines may be..
   !Point description:
   !   Point number (ignored), ':' then X,Y,Z
   !End of list: '$'
   !Set name of '$' terminates list of sets

   !Polygon list.
   !All text ignored up to '#', then lines may be..
   !Colour indication:
   !   '>' followed by colour no. or INVISIBLE (255) then colour no.
   !Polygon description:
   !   (ignored) ':' followed by number of vertices then vertex list.
   !   Vertices specified as SETm, SETn,.... where SET is the set name ('A'-'z')
   !End of list: '$'

   !?Viewpoint description:
   !Text ignored up to '#', then
   !number (ignored), sp_cx, sp_cy, sp_dist, xa, ya, za

   !2) Iff' (JHB)

%const %short One  = 16_4000, Zero = 0, f128 = One>>7
%record %format Pt  (%short X, Y, Z)
%record %format Matrix (%record (Pt) A,B,C)
@16_E30000 %short %integer %array Colour Map (0:511)

%record %format RPt  (%real X, Y, Z)
%const %short Ambient = 8
%record (RPt) Light

%routine Mix Colour (%short Col, Red, Green, Blue)
   Colour Map(Col<<1+1)=Red+Green<<5+Blue<<10
%end

%routine VClear
   Print Symbol (27); Print Symbol (118)
%end

%routine Clear All
   VClear
   Clear
%end

%owninteger marker=0

%routine cpu(%string (255) s)
   %if s="" %then marker=cputime %elsestart
      write(cputime-marker, 6); space; printstring(s); newline
   %finish
%end

%routine Set Up
%integer i
%integer z = 0
  Offset (0,0)
  Colour (White)
  %for i = 0, 32, 480 %cycle
     Colour Map (1+i)  = z
     Colour Map (3+i)  = 31
     Colour Map (5+i)  = 31<<5
     Colour Map (7+i)  = 31<<5+31
     Colour Map (9+i)  = 31<<10
     Colour Map (11+i) = 31<<10+31
     Colour Map (13+i) = 31<<10+31<<5
     Colour Map (15+i) = 31<<10+31<<5+31
     Colour Map (17+i) = 31<<10+31<<5+31
     Colour Map (19+i) = 31<<10+31<<5
     Colour Map (21+i) = 31<<10+31
     Colour Map (23+i) = 31<<10
     Colour Map (25+i) = 31<<5+31
     Colour Map (27+i) = 31<<5
     Colour Map (29+i) = 31
     Colour Map (31+i) = z
  %repeat
%end

%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)
!!   %short temp
!!   Temp = A; A = B; B = Temp
    *MOVE.W  (A0),A2
    *MOVE.W  (A1),(A0)
    *MOVE.W  A2,(A1)
%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)
!!   %return
    *MOVE.W 6(a0),A1
    *MOVE.W 2(a0),6(a0)
    *MOVE.W A1,2(a0)

    *MOVE.W 14(a0),A1
    *MOVE.W 10(a0),14(a0)
    *MOVE.W A1,10(a0)

    *MOVE.W 12(a0),A1
    *MOVE.W 4(a0),12(a0)
    *MOVE.W A1,4(a0)
%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
!!   %return

    *MOVE.L  M,A1
    *MOVE.L  O,A0

    *MOVE.w  0(A0),D1
    *muls    0(A1),D1
    *asl.l   #2,D1
    *swap    D1

    *MOVE.W  2(A0),D0
    *muls    2(A1),d0
    *asl.l   #2,d0
    *swap    d0
    *ADD.L   D0,D1

    *MOVE.W  4(A0),D0
    *muls    4(A1),d0
    *asl.l   #2,d0
    *swap    d0
    *ADD.L   D0,D1

    *MOVE.w  0(A0),D2
    *muls    6(A1),D2
    *asl.l   #2,D2
    *swap    D2

    *MOVE.W  2(A0),D0
    *muls    8(A1),d0
    *asl.l   #2,d0
    *swap    d0
    *ADD.L   D0,D2

    *MOVE.W  4(A0),D0
    *muls    10(A1),d0
    *asl.l   #2,d0
    *swap    d0
    *ADD.L   D0,D2

    *MOVE.w  0(A0),D3
    *muls    12(A1),D3
    *asl.l   #2,D3
    *swap    D3

    *MOVE.W  2(A0),D0
    *muls    14(A1),d0
    *asl.l   #2,d0
    *swap    d0
    *ADD.L   D0,D3

    *MOVE.W  4(A0),D0
    *muls    16(A1),d0
    *asl.l   #2,d0
    *swap    d0
    *ADD.L   D0,D3

    *MOVEA.L O2,A0
    *move.w  D1,0(A0)
    *move.w  D2,2(A0)
    *move.w  D3,4(A0)

%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

%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

%short OX, OY, MX = -1, MY = -1

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

%integer StB,StT
%const %integer Max Stars = 100
%short %array Stars (1:Max Stars,1:2)

%routine Set up Stars
   %integer i
   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 Up
   PrintSymbol(27);PrintSymbol('A')
   PrintSymbol(13);PrintSymbol(27);PrintSymbol('t')
%end
 
%owninteger iff file = 0

%predicate test iff file(%string (255) file)
   %integer a,b,out
   out=outstream
   openinput(3, file); selectinput(3)
   set input(46)
   readsymbol(a); readsymbol(b)
   close input; selectinput(out)
   %true %if a=16_85 %and b=16_16
   %false
%end

%external %real %fn %spec Sin (%real x)
%external %real %fn %spec Cos (%real x)

%const %real PI = 3.141592653589793238462643,  Rad = Pi/180
%short %array Sine, Cosine (0:359)

%routine Load Trig Tables
   !Load scaled integer sine and cosine tables. Scaling factor is "one" (16384)
   %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 make unit vector(%record (rpt) %name vec)
    %real len
    Len=Sqrt(vec_X*vec_X+vec_Y*vec_Y+vec_Z*vec_Z)
    %if Len # 0 %start
       vec_X=vec_X/Len; vec_Y=vec_Y/Len; vec_Z=vec_Z/Len
    %finish
%end

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

   %integerfn Sign (%name N)
      !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. 
    Make unit vector(N)
    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

%constinteger vl=0, vr=687 ;!should be 688
%short DS

%routine clipped line(%integer x1,y1,x2,y2)
%integer c1,c2
%integer dx,dy, vb, vt

  %integerfn clipcode(%integer x,y)
  %integer c=0
    c = 1 %if x<vl
    c = c+2 %if x>vr
    c = c+4 %if y<vb
    c = c+8 %if y>vt
    %result=c
  %end
  
  %routine into range(%integername x,y)
    y = intpt((vl-x)*dy/dx)+y %and x = vl %if x<vl
    y = intpt((vr-x)*dy/dx)+y %and x = vr %if x>vr
    x = intpt((vb-y)*dx/dy)+x %and y = vb %if y<vb
    x = intpt((vt-y)*dx/dy)+x %and y = vt %if y>vt
  %end

  vb=DS; vt=ds+512
  c1 = clipcode(x1,y1)
  c2 = clipcode(x2,y2)
  %returnunless c1&c2=0
  %unless c1!c2=0 %start
    dx = x2-x1; dy = y2-y1
    into range(x1,y1)
    into range(x2,y2)
  %finish
  line(x1,y1,x2,y2)
%end

%integerfn next command
   !Forces 'e' command if run off end of a comand file.
   %integer c
   %on 3,9 %start; %result='e'; %finish
   %cycle
!!   c = Test Symbol
     readsymbol(c)
   %repeatuntil c<0 %or ' '<=c<='z'
   %result=c
%end

%owninteger Di = 10
%owninteger PMax = 3000; ! max points & polygons
%owninteger Vmax = 32 ;!Max vertices per polygon
%string (30) File
%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

!R#0 means that the edge from this point to the next is redundant

%short xp,yp,Ang = 30, Max
%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
%record %format SF (%short CX, CY, Dist)
%record (SF) Sp
%short Lx = 10, Ly = -10, Lz = -10
%integer ii,i,j,k,NumPoly
%byte MB

Setup
VClear
Set Terminal Mode (No Page)
Initialise Random
Set up Stars
File = CliParam
Load Trig Tables
newline; Printline ("General (Depth Sorting) Polygons Program"); newline
Stahrt:
   PrintSymbol(13)
   Prompt("File: ")
   %cycle
     %cycle
        Read Line(File)
     %repeatuntil file#""
     %exit %if exists(file)
     printline("Can't access ".file)
   %repeat

%if test iff file(file) %start
  iff file=1; Vmax=4; Pmax=32768
%else
  iff file=0; Vmax=32; Pmax=3000
%finish

Clear All
newline
Printline("General (Depth Sorting) Polygons Program"); newline
Printline("MsR,L,M = Rotate X,Y,Z, or any combination of buttons")
Printline("Move Mouse to move shape, if Moving option selected")
Printline("a = Enter Increment Angle     ' '  = Negate Current Angle")
Printline("v = Move Towards Shape          b  = Move Away from Shape")
Printline("c = Enter X,Y Coordinates       r  = Enter angles X,Y,Z")
Printline("h = Hidden Line On/Off          s  = Shading On/Off")
Printline("z = Shade Line On/Off           l  = Enter Light Vector")
Printline("d = Change Distance             i  = Change Distance Inc")
Printline("m = Moving On/Off               f  = Enter File Name")
Printline("q = Drawing Visibility On/Off   g  = Toggle Stars or Blue"); newline


%begin ;! -------------------------------- inner block ----------------------
!V are the original coords, TV are the transformed coords
%record %format Polt (%short Depth, %byte Num,Col,Col2,
                      %record (Pt) %array V(1:32), TV(1:32),
                      %bytearray omit(0:32))

%record (Pt) %array %name PV (1:32)
%record (Polt) %array P(0:PMax)
%record (Polt) %name %array PL (0:Pmax)
%switch TD (32:122)

%routine Rotate (%short xa, ya, za)
   %record (Polt) %name Pp
   %record (Pt) %name PpV, QpV
   %record (Matrix) R,T
   %integer i,j

{}cpu("")
   T_A_X = One;  T_A_Y =   0; T_A_Z = 0
   T_B_X =   0;  T_B_Y = One; T_B_Z = 0
   T_C_X =   0;  T_C_Y =   0; T_C_Z = One

   %if za # 0 %start
      R_A_X = Cosine (za);  R_A_Y =   Sine (za);  R_A_Z = 0
      R_B_X =  -Sine (za);  R_B_Y = Cosine (za);  R_B_Z = 0
      R_C_X =           0;  R_C_Y =           0;  R_C_Z = One
      MMult (R,T)
   %finish

   %if ya # 0 %start
      R_A_X = Cosine (ya);  R_A_Y =           0;  R_A_Z = Sine (ya)
      R_B_X =           0;  R_B_Y =         One;  R_B_Z = 0
      R_C_X =  -Sine (ya);  R_C_Y =           0;  R_C_Z = Cosine (ya)
      MMult (R,T)
   %finish

   %if xa # 0 %start
      R_A_X =         One;  R_A_Y =           0;  R_A_Z = 0
      R_B_X =           0;  R_B_Y = Cosine (xa);  R_B_Z = Sine (xa)
      R_C_X =           0;  R_C_Y =  -Sine (xa);  R_C_Z = Cosine (xa)
      MMult (R,T)
   %finish

   Pp == P(0)
   %for i = 0,1,Num Poly %cycle
      PL(i) == P(i)
      PpV == Pp_V(1); QpV == Pp_TV(1)
      %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]
   %repeat
{}cpu("rotate")
%end

%routine Quick Sort (%short A, B)
   !Sort array PL from A to B inclusive on PL_DEPTH.
   %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

%routine Load data
   %byte Col = White << 5, Col2
   %real A,LastX,lastY,lastZ
   %integerarray this,last(0:32)
   %integer aa,i,j,c,j1,k1,x,y
   %integer hlen, type, wid, ht
   %integer PtNum
   %record (Pt) %array Pn (1:PMax)
   %record (Pt) %name Pp
   %record (Polt) %name Pt
   %short %array Ad ('A':'z')
   %integer dummy, omitted
   %record (iffhdr fm) iffin

   !Load file.

   omitted=0
   %for i=0,1,Vmax-1 %cycle; last(i)=-1; %repeat
   NumPoly = -1
   PtNum = 1
   %if iff file=1 %start ;!IFF format magic number at position 46
     printline("IFF format")
     !We overlay the image onto array P.
     aa=addr(p(0)); i = iff readin(file, iffin, aa)
     %if i#0 %start
        printline("Problem with ".file)
        %stop
     %elseif iffin_ht * iffin_wid > PMax
        printline("Can't cope. ".itos(iffin_wid,-1)." * ".itos(iffin_ht,-1)." > ".itos(pmax,-1)." points")
        %stop
     %else
        ad('A') = ptnum-1
        x = (1-iffin_ht) * 100
        pp == Pn(PtNum)
        %for i=1,1,iffin_ht %cycle
           y = (1-iffin_wid) * 100
           %for j=1,1,iffin_wid %cycle
              c = byteinteger(aa+ptnum-1)
              Pp_x = x; Pp_y = y; Pp_z = c+c+c
!t! write(PtNum, 4); writevert(Pn(PtNum)); newline
              pp == pp[1]
              PtNum = PtNum + 1
              y = y + 100
           %repeat
           x = x + 100
        %repeat
     %finish
     write(PtNum-1,0); printstring(" points, and ")

     k=1
     pt == P(0)
     %for i=0,1,iffin_ht-2 %cycle
        %for j=0,1,iffin_wid-2 %cycle
           numpoly=numpoly+1
           pt_col = col
           pt_num = 4
           pt_v(1) = Pn(k)
!t!write(k, 4); writevert(Pn(k)); ; space; writevert(pt_v(1)); newline
           %if i=0 %then pt_omit(1)=0 %else pt_omit(1)=1
           pt_v(2) = Pn(k+1)
           pt_omit(2)=0
           pt_v(3) = Pn(k+iffin_wid+1)
           pt_omit(3)=0
           pt_v(4) = Pn(k+iffin_wid)
           %if j=0 %then pt_omit(4)=0 %else pt_omit(4)=1
!t! Write(NumPoly, 4); write(k, 4); space; phex2(pt_col); space
!t! writevert(pt_v(0)); writevert(pt_v(1)); writevert(pt_v(2)); writevert(pt_v(3))
!t! newline
           k = k + 1
           pt == pt[1]
        %repeat
        k = k + 1
     %repeat
     write(numpoly+1, -1); printline(" polygons read in"); newline
     prompt("Screen_X:"); read(sp_cx)
     prompt("Screen_Y:"); read(sp_cy)
     prompt("Distance:"); read(sp_dist)
     prompt("Viewpoint_X:"); read(xa)
     prompt("Viewpoint_Y:"); read(ya)
     prompt("Viewpoint_Z:"); read(za)

   %else ;!P. Read format
      PrintString ("Opening ".File."... ")
      Open Input (3,File); Select Input (3)
      Read Symbol (j) %until j = '#' ;!Skip introduction
      %cycle
         Read Symbol (j) %until j # ' ' %and j # NL ;!point set name
         %exit %if j = '$'
         Ad (j) = PtNum - 1  ;!point set offset
         %cycle
            Read Symbol (j) %until j = ':' %or j = '$'
            %exit %if j = '$'
            Pp == Pn(PtNum)

            {skipsymbol %while nextsymbol<=' '; readsymbol(c)}
            {%if c='"' %then A=lastX %else} Read (A)
            Pp_X = Int (f128*A)

            {skipsymbol %while nextsymbol<=' '; readsymbol(c)}
            {%if c='"' %then A=lastY %else} Read (A)
            Pp_Y = Int (f128*A)

            {skipsymbol %while nextsymbol<=' '; readsymbol(c)}
            {%if c='"' %then a=lastZ %else} Read (A)
            Pp_Z = Int (f128*A)

            PtNum = PtNum + 1
         %repeat
      %repeat
      Write(PtNum,0);PrintString (" Points, and ")
      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)
         Pt_Col = Col
         Pt_Col2 = Col2 %if Col = Invisible
         Read (Pt_Num) ;!No of points in polygon
         %for j = 1,1,Pt_Num %cycle
            ReadSymbol (i) %until i # ' ' %and i # NL
            Read (k)         ;!point number in point set
            k = k + Ad (i)   ;!add in point set offset
            Pt_V(j) = Pn(k) ; pt_omit(j)=0
            this(j) = k
         %repeat
         %if numpoly#0 %start ;!check last poly to see if there are common edges
            %for j=1,1,Pt_Num %cycle
               %for k=1,1,last(0) %cycle
                  j1 = j+1; j1=1 %if j1>Pt_num
                  k1 = k+1; k1=1 %if k1>last(0)
                  %if (last(k) = this(j) %and last(k1) = this(j1)) %or %c
                      (last(k) = this(j1) %and last(k1) = this(j)) %start
                        Pt_omit(j) = 1; omitted=omitted+1

!!{t} printstring(" remove "); write(numpoly, 3); printsymbol('.'); write(j,-1)
!!{t} newline
                  %finish
               %repeat
            %repeat
         %finish
         %for i=1,1,Pt_Num %cycle; last(i) = this(i); %repeat
         last(0) = Pt_Num
      %repeat
      Write(NumPoly+1,0);Printstring (" Polygons read in")
      write(omitted, 4); printstring(" lines omitted")
      newline
   
      Read Symbol (j) %until j = '#'
      Read (dummy)
      Read (Sp_CX); Read (Sp_CY); Read (Sp_Dist)
      Read (XA); Read (YA); Read (ZA)
      Close Input
   %finish
   Select Input (0)
   %if xa >= 360 %then xa = xa - 360 %elseif xa < 0 %then xa = xa + 360
   %if Ya >= 360 %then Ya = Ya - 360 %elseif Ya < 0 %then Ya = Ya + 360
   %if Za >= 360 %then Za = Za - 360 %elseif Za < 0 %then Za = Za + 360
%end

%routine Draw Body
   %integer i,j,CX,CY
   %record (polt) %name Qp

   %routine plot polys(%integer col)
      %integer j
!!{t}   printstring("Polys   "); write(col, -1); newline
      colour(col)
      Poly (PV(j)_X//SC+CX, PV(j)_Y//SC+CY) %for j = 1,1,Qp_Num
      Close Poly
   %end

   %routine plot outlines(%integer col)
     %integer j,x0,x1,y0,y1,x00,y00
     colour(col)

     x0 = PV(1)_X//SC+CX; y0 = PV(1)_Y//SC+CY; x00=x0; y00=y0
     %for j=1,1,Qp_Num-1 %cycle
        x1 = PV(j+1)_X//SC+CX; y1 = PV(j+1)_Y//SC+CY
        clipped Line(x0,y0,x1,y1)
        x0=x1; y0=y1
     %repeat
     clipped Line(x00,y00,x0,y0)
   %end

   %routine plot wires(%integer col)
     !Same as above but misses out redundant wires
     %integer j,x0,x1,y0,y1,x00,y00
!t!  printstring("Outlines"); write(col, 3); newline
     colour(col)

     x0 = PV(1)_X//SC+CX; y0 = PV(1)_Y//SC+CY; x00=x0; y00=y0
     %for j=1,1,Qp_Num-1 %cycle
        x1 = PV(j+1)_X//SC+CX; y1 = PV(j+1)_Y//SC+CY
        clipped line(x0,y0,x1,y1) %if Qp_omit(j)=0
!t!     printline("Line omitted") %if qp_omit(j)#0
        x0=x1; y0=y1
     %repeat
     clipped Line(x00,y00,x0,y0) %if qp_omit(qp_num)=0
!t!  printline("Line omitted") %if qp_omit(qp_num)#0
   %end

%const %integer Frame Addr = 16_E00000
@Frame Addr %integerarray Frame(0:32767)

{} cpu("")
   %if Show Stars = True %start
      Half Clear (DS>>9)
      colour(white)
      *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
      Colour (Background)
      Fill (0,DS,687,511+DS)
   %finish

   OffSet (0,DS) %if Show = True
   CX = Sp_CX
   CY = Sp_CY + DS
{}   cpu("background")
   %if Hidden = True %start
      %if ReCalc = True %start
         Qp == P(0)
         %for i = 0,1,NumPoly %cycle
            PV == Qp_TV
            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_TV
         %if Shading = True %start
            %if Qp_Num >= 3 %and Qp_Col # Invisible %start
               %if Qp_Col = Black %then Plot Polys(Black) %elsec
                  Plot Polys(Qp_Col+Shade(PV(1), PV(2), PV(3)))
            %finish

            %if Qp_Col = Invisible %start
               Plot Outlines(Qp_Col2+Shade(PV(1), PV(2), PV(3)))
            %elseif Shade Line = True
               Plot Outlines(Shade Line Col)
            %finish

         %else
            %if Qp_Num >= 3 %and Qp_Col # Invisible %start
               Plot Polys(Hidden Poly Col)
            %finish

            %if Qp_Col = Invisible %then Plot Outlines(Qp_Col2>>5) %elsec
            Plot Outlines(Hidden Line Col)
         %finish
      %repeat
   %else
      Qp == P(0)
      %for i = 0,1,Num Poly %cycle
         PV == Qp_TV
         Plot Wires(Wire Col)
         Qp == Qp[1]
      %repeat
{}cpu("Outlines")
   %finish
   OffSet (0,DS) %unless Show = True
   DS = 512 - DS
%end

load data
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)
prompt("?")

mousex = 0; mousey = 0
convert
DS = 512
Sc = Sp_Dist { >> 1
Rotate (xa,ya,za)
Draw Body
%cycle
   Changing = False
   ReCalc = False
   %cycle
      MB = Get Mouse
      ii = next command
      %if MB # 0 %start
         %if MB & 1 = 1 %start
            xa = xa + Ang
            %if xa >= 360 %then xa = xa - 360 %elseif xa < 0 %then xa = xa + 360
         %finish
         %if MB & 2 = 2 %start
            ya = ya + Ang
            %if ya >= 360 %then ya = ya - 360 %elseif ya < 0 %then ya = ya + 360
         %finish
         %if MB & 4 = 4 %start
            za = za + Ang
            %if za >= 360 %then za = za - 360 %elseif 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'):
         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
         Changing = True
         ReCalc = True
         Rotate (xa,ya,za)
         -> Nex

      TD(' '):
         Ang = -Ang
         -> Nex

      TD('f'):
         File = ""
!!         -> Stahrt
%stop

      TD('m'):
         Moving = 1 - Moving; Changing = Moving
         -> Nex

      TD ('q'):
         Show = 1 - Show
         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'):
         Prompt ("Light_X: ");read(light_x);Up
         Prompt ("Light_Y: ");read(light_Y);Up
         Prompt ("Light_Z: ");read(light_Z);Up
         make unit vector(light)
         Changing = True
         -> Nex

      TD('a'):
         Prompt ("Increment Angle (Currently ".Itos(Ang,0).") : ");read (ang);Up
         -> Nex

      TD('i'):
         Prompt ("Distance Increment (Currently ".Itos(Di,0).") : ")
         read (Di);Up
         -> Nex

      TD('d'):
         Prompt ("Distance (Currently ".Itos(Sc,0).") : ");read (Sc);Up
         Changing = True
         -> Nex

      TD('c'):
         Prompt ("CentreX (Currently ".Itos(Sp_Cx,0).") : ");read (sp_cx);Up
         Prompt ("CentreY (Currently ".Itos(Sp_CY,0).") : ");read (sp_cY);Up
         Changing = True
         -> Nex

      TD('v'):
         Sc = Sc - Di %unless Sc <= Di
         Changing = True
         -> Nex

      TD('b'):
         Sc = Sc + Di
         Changing = True
         -> Nex

      TD('e'):
         %stop

      TD('p'):
         !Input a complete parameter set (angles and distance)
         read(xa); read(ya); read(za); read(sc)
         changing=true
         recalc=true
         rotate(xa, ya, za)
         -> Nex

      TD('w'):
         !Do nothing for a while. For demonstration purposes
         prompt("Interval (ms):"); read(ii)
         ii=cputime+ii; %cycle; %repeatuntil cputime>=ii
         ii=-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 # 0 %or ii # -1

   Draw Body %if Changing = True

%repeat
%end ;! ------------------------------------ inner block -------------------
%endofprogram ;! --------------------------- outer block -------------------