%begin
%include "inc:mouse.imp"
%include "ram_1:Graph.Inc"
%system %routine %spec Read Line (%string (*) %name s)
%const %real Pi  = 3.141592653589793238462643
%external %real %fn %spec Sin (%real x)
%external %real %fn %spec Cos (%real x)

%real Lx = 10, Ly = -10, Lz = -10, Len
%byte %name n,n2,nn2,nn
%string (255) File
%const %short CX = 343, CY = 256

%const %integer l=400,ll=l<<2{<<1}-1, Ambient = 6
%const %real inc = Pi/(l<<1), r = l/Pi
%real Ang = 15 * Pi / 180
%integer i,ii,j,k,xl,xr,ix = (688-l)>>1,iy = (512-l>>1)>>1
%byte MB, z
%real a, x, y,temp, Sa, Ca,Dot
%byte %array T (0:l-1,0:ll)
%record %format Pt (%real x,y,z)
%record (Pt) %array Ln (0:l-1)
%record (Pt) %name P
%record (Pt) Light, Norm

%integerfn Sign (%name N)
   %result=-1 %if 16_80000000 & Integer(Addr(N)) # 0; %result=1
%end

%routine Rotate (%byte Dir)
%switch R(MsL:MsLMR)
%integer i
%real t
   -> R(Dir)
   R (MsL): 
   %for i = 0,1,l-1 %cycle
      P == Ln(i)
      t = P_y
      P_y = ca * t - sa * P_z
      P_z = sa * t + ca * P_z
   %repeat
   %return
   R (MsM):
   %for i = 0,1,l-1 %cycle
      P == Ln(i)
      t = P_x
      P_x = ca * t - sa * P_z
      P_z = sa * t + ca * P_z
   %repeat
   %return
   R (MsR):
   %for i = 0,1,l-1 %cycle
      P == Ln(i)
      t = P_y
      P_y = ca * t - sa * P_x
      P_x = sa * t + ca * P_x
   %repeat
   R ( * ):
%end

Setup
Clear All
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
   j = i<<5
   Mix Colour (j+k,(i&1)*k,((i>>1)&1)*k,((i>>2)&1)*k) %for k = 0,1,31
%repeat
Mix Colour (30,6,5,11)
Newlines (3)
Prompt ("File (Default ram_1:Coke.Dat) : "); Read Line (File)
File = "ram_1:Coke.Dat" %if File = ""
Set Colour (White)
Line (ix,iy,ix,iy+l>>1+1)
Line (ix,iy+l>>1+1,ix+l+1,iy+l>>1+1)
Line (ix+l+1,iy+l>>1+1,ix+l+1,iy)
Line (ix+l+1,iy,ix,iy)
%if File # "" %start
   Newline
   PrintString ("Reading Texture Map from ".File."...")
   Open Input (3,File)
   Select Input (3)
   %for i = 0,1,l>>1-1 %cycle
      n == T(i<<1,0); nn == T(i<<1+1,0)
      n2 == T(i<<1,l<<1); nn2 == T(i<<1+1,l<<1)
      %for j = 0,1,l-1 %cycle
         ReadSymbol (n); n[1] = n
         Set Colour (n)
         Plot (ix+j+1,iy+i+1)
         nn = n;  nn [1] = n
         n2 = n;  n2[1] = n
         nn2 = n; nn2[1] = n
         n == n[2] 
         nn == nn[2]
         n2 == n2[2]
         nn2 == nn2[2]
      %repeat
   %repeat
   Close Input
   Select Input (0)
%else
   PrintString ("Filling with Red...")
   n == T(0,0)
   n = Red %and n == n[1] %for i = 1,1,l*l*4
   Set Colour (Red)
   Fill (ix+1,iy+1,ix+l<<1,iy+l)
%finish
PrintString ("Finished - Press Mouse Button");Newline
%cycle; %repeat %until Mouse Buttons # MsNone
Half Clear (0)
PrintString ("Generating Arc Points...")
a = pi
%for i = 0,1,l-1 %cycle
   P == Ln(i)
   P_x = Sin(a)
   P_z = 0
   P_y = Cos(a)
   a = a + 2*Inc
%repeat
sa = sin(Inc); ca = cos(Inc)
PrintString ("Finished"); Newline
Set Colour (30)
Fill (0,0,687,511)
PrintString ("Generating Sphere...")
%for i = 0,1,l<<1-1 %cycle
   P == Ln(0)
   %for ii = 0,1,l-1 %cycle
      temp = P_x
      P_x = ca * temp - sa * P_z
      P_z = sa * temp + ca * P_z
      P == P[1]
   %repeat
   %continue %if Ln(100)_Z > 0 
   P == Ln(0)
   %for j = 0,1,l-1 %cycle
      Dot = P_X*Light_X+P_Y*Light_Y+P_Z*Light_Z
      k = Ambient    
      k=k+IntPt((31-Ambient)*|Dot|) %if Sign(Dot) = -Sign(P_Z)
      Set Colour (T(j,i)<<5+k)
      Plot (CX+Int(r*P_X),CY+Int(r*P_Y))
      P == P[1]
   %repeat
%repeat
%end %of %program
