rem 3D Polygons .............. Rem 6.1
      rem A J Tooth // 22nd January 2006
      on error if (err=17) then quit
      
      *FLOAT64
      
      rem Set up various parameters
      proc_setup
      
      rem Define a structure for a CUBE
      proc_df_cube
      
      rem Define a structure for a PYRAMID
      proc_df_pyr
      
      rem Define a structure for a DODECAHEDRON
      proc_df_dodec
      
      rem Sets light directions
      proc_lightset(1,1,1,-1,-1,-1)
      
      rem Rotation Section
      repeat
        rem Increment Parameters
        proc_increment(theta,phi,psi,Dis)
        
        cA=cos(rad(Ang)) : sA=sin(rad(Ang))
        colour 132 : cls
        
        rem Place a cube
        proc_place_cube(0,-2*cA,Dis+100*cA,-2*sA,theta,phi,psi)
        
        rem Place another cube
        proc_place_cube(1,4*cA,Dis-100*cA,3*sA,2*theta,phi,psi)
        
        rem Place a pyramid
        proc_place_pyr(cA,Dis+150*sA,3*sA,theta,2*phi,psi)
        
        rem Place a dodecahedron
        proc_place_dodec(-4*sA,Dis-150*sA,5*cA,-theta,phi,2*psi)
        
        proc_pars
        
        rem Display my icon in compiled version
        proc_AJTicon(40,600)
        
        *REFRESH
        Ang+=1 : if Ang>360 then Ang=0.0
      until (sp$="x")
      
      *REFRESH ON
      quit
      end
      rem End of Program ===================================================
      rem ==================================================================
      
      rem Set up various parameters
      def proc_setup
      local x,y,b&
      mode 22 : colour 132,0,0,20 : colour 132 : off : cls
      
      rem Change the Windows Title
      title$ = " 3D Polygons by Tony Tooth"
      sys "SetWindowText", @hwnd%, title$
      
      *FONT Blackadder ITC,30,B
      vdu 5
      colour 8,160,90,20
      gcol 8 : move 450,750 : print;"Three D Polygons"
      vdu 4
      
      proc_back(350,1200,1500,250,150,150,150)
      
      *FONT Georgia Italic,12,B
      vdu 5
      move 450,1400 : gcol 6: print;"Use ";:gcol 2:print;"ARROW ";:gcol 6: print;"keys and ";\
      \:gcol 2:print;"<..> ";:gcol 6: print;"keys to change angles.."
      move 450,1350 :gcol 6:print;"Press ";:gcol 2:print;"-f-";:gcol 6:print;" to move objects forward, ";\
      \:gcol 2:print;"-b- ";:gcol 6:print;"to move back, ";:gcol 2:print;"-space- ";:gcol 6:print;"to stop movement."
      
      move 450,1300 :gcol 6:print;"Press ";:gcol 2:print;"-t-";:gcol 6:print;" to toggle the parameter display."
      
      proc_back(350,950,800,200,150,150,150)
      
      move 450,1100 : gcol 2: print;"Press ";:gcol 1:print;"-X-";\
      \:gcol 2:print;" or ";:gcol 1:print;"-Esc-";:gcol 2:print;" at any time to "; :gcol 1:print;"EXIT."
      move 450,1050 : gcol 3: print;"Click the mouse to continue."
      vdu 4
      
      rem Display my icon in compiled version
      proc_AJTicon(40,600)
      
      b&=0
      repeat
        mouse x,y,b&
        sys "Sleep",10
      until b&<>0
      
      rem Go to full screen mode
      proc_fullscreen
      
      xmax%=1023 : ymax%=767
      origin xmax%,ymax%
      A=-30 : rem Sets "camera" position
      colour 132,0,0,20
      
      rem Initialise parameters
      theta=0.0 : phi=0.0 : psi=0.0
      dth=0.0 : dph=0.0 : dps=0.0 : dZ=0.0 : Dis=500
      sp$=""
      sw&=1 : rem Controls whether parameter values are displayed
      Ang=0.0
      *FONT Verdana,12,B
      colour 8,160,90,20 : colour 8
      *REFRESH OFF
      endproc
      rem ==================================================================
      
      rem Set up use of Full Screen
      def proc_fullscreen
      
      sys "GetSystemMetrics", 0 to xscreen%
      sys "GetSystemMetrics", 1 to yscreen%
      sys "SetWindowLong",@hwnd%,-16,&16000000
      sys "SetWindowPos",@hwnd%,-1,0,0,xscreen%,yscreen%,0
      vdu 23,22,xscreen%;yscreen%;8,16,16,1 : rem Set fullscreen mode
      mouse off : off : rem Turns off the Mouse Pointer and the Cursor
      endproc
      rem -------------------------------------------------------------
      
      rem Sets light directions
      def proc_lightset(s11,s12,s13,s21,s22,s23)
      local N1,N2
      
      dim light(2,3)
      
      N1=sqr(s11*s11 + s12*s12 + s13*s13)
      N2=sqr(s21*s21 + s22*s22 + s23*s23)
      
      light(1,1)=s11/N1 : light(1,2)=s12/N1 : light(1,3)=s13/N1
      light(2,1)=s21/N2 : light(2,2)=s22/N2 : light(2,3)=s23/N2
      
      endproc
      rem ==================================================================
      
      rem Define a structure for a CUBE
      def proc_df_cube
      local i&,nm,num%
      
      rem Data for vertex placing (including centroid) and winding order
      local data
      restore +1
      data 0,0,0,-1,-1,-1,-1,-1,1,1,-1,1,1,-1,-1,-1,1,-1,-1,1,1,1,1,1,1,1,-1
      data 1,2,3,3,4,1,4,3,7,7,8,4,8,7,6,6,5,8,5,6,2,2,1,5,2,6,7,7,3,2,5,1,4,4,8,5
      
      dim cube{(1)vert(16,3),wind&(12,3),ang{th,ph,ps},norm(12,3),mat(3,3)}
      
      rem Set vertices
      for i&=0 to 8
        read num% : nm=1.0*num%
        cube{(0)}.vert(i&,1)=nm
        cube{(1)}.vert(i&,1)=cube{(0)}.vert(i&,1)
        read num% : nm=1.0*num%
        cube{(0)}.vert(i&,2)=nm
        cube{(1)}.vert(i&,2)=cube{(0)}.vert(i&,2)
        read num% : nm=1.0*num%
        cube{(0)}.vert(i&,3)=nm
        cube{(1)}.vert(i&,3)=cube{(0)}.vert(i&,3)
      next i&
      
      rem Set winding order
      for i&=1 to 12
        read cube{(0)}.wind&(i&,1)
        cube{(1)}.wind&(i&,1)=cube{(0)}.wind&(i&,1)
        read cube{(0)}.wind&(i&,2)
        cube{(1)}.wind&(i&,2)=cube{(0)}.wind&(i&,2)
        read cube{(0)}.wind&(i&,3)
        cube{(1)}.wind&(i&,3)=cube{(0)}.wind&(i&,3)
      next i&
      
      restore data
      endproc
      rem ===================================================================
      
      rem Define a structure for a PYRAMID
      def proc_df_pyr
      local i&,nm,num%
      
      rem Data for vertex placing (including centroid) and winding order
      local data
      restore +1
      data 0,0,0,-1,-1,-27/36,-1,1,-27/36,1,1,-27/36,1,-1,-27/36,0,0,81/36
      data 2,1,4,4,3,2,1,5,4,4,5,3,3,5,2,2,5,1
      
      dim pyr{vert(10,3),wind&(6,3),ang{th,ph,ps},norm(6,3),mat(3,3)}
      
      rem Set vertices
      for i&=0 to 5
        read num% : nm=1.0*num%
        pyr.vert(i&,1)=nm
        read num% : nm=1.0*num%
        pyr.vert(i&,2)=nm
        read num% : nm=1.0*num%
        pyr.vert(i&,3)=nm
      next i&
      
      rem Set winding order
      for i&=1 to 6
        read pyr.wind&(i&,1)
        read pyr.wind&(i&,2)
        read pyr.wind&(i&,3)
      next i&
      
      restore data
      endproc
      rem ===================================================================
      
      rem Define a structure for a DODECAHEDRON
      def proc_df_dodec
      local i&,nm,num
      
      rem Data for vertex placing (including centroid) and winding order
      local data
      restore +1
      data 0,0,0,-1,-1,-1,-0.61804,-1.61804,0,-1,-1,1,1,-1,1,0.61804,-1.61804,0,1,-1,-1
      data -1,1,-1,-0.61804,1.61804,0,-1,1,1,1,1,1,0.61804,1.61804,0,1,1,-1
      data 0,-0.61804,1.61804,0,0.61804,1.61804,0,-0.61804,-1.61804,0,0.61804,-1.61804
      data -1.61804,0,-0.61804,-1.61804,0,0.61804,1.61804,0,-0.61804,1.61804,0,0.61804
      
      data 1,2,5,5,6,1,6,15,1,6,5,4,4,20,6,20,19,6,15,6,19,19,12,15,12,16,15
      data 16,12,11,11,8,16,8,7,16,12,19,20,20,10,12,10,11,12,7,8,9,9,18,7,18,17,7
      data 16,7,17,17,1,16,1,15,16,1,17,18,18,3,1,3,2,1
      data 2,3,13,13,4,2,4,5,2,4,13,14,14,10,4,10,20,4,11,10,14,14,9,11,9,8,11
      data 18,9,14,14,13,18,13,3,18
      
      dim dodec{vert(40,3),wind&(36,3),ang{th,ph,ps},norm(36,3),mat(3,3)}
      
      rem Set vertices
      for i&=0 to 20
        read num : nm=1.0*num
        dodec.vert(i&,1)=nm
        read num : nm=1.0*num
        dodec.vert(i&,2)=nm
        read num : nm=1.0*num
        dodec.vert(i&,3)=nm
      next i&
      
      rem Set winding order
      for i&=1 to 36
        read dodec.wind&(i&,1)
        read dodec.wind&(i&,2)
        read dodec.wind&(i&,3)
      next i&
      
      restore data
      endproc
      rem ===================================================================
      
      rem Place the object
      def proc_place_cube(Id&,X,Z,Y,Th,Ph,Ps)
      local xv,yv,zv,i&
      
      rem Update rotation matrix
      proc_rotmat(Th,Ph,Ps,cube{(Id&)})
      
      rem Translate and rotate vertices
      for i&=1 to 8
        
        xv=cube{(Id&)}.vert(i&,1)
        zv=cube{(Id&)}.vert(i&,2)
        yv=cube{(Id&)}.vert(i&,3)
        
        cube{(Id&)}.vert(i&+8,1)=1.0*X+fn_rot(1,xv,zv,yv,cube{(Id&)})
        cube{(Id&)}.vert(i&+8,2)=1.0*Z+fn_rot(2,xv,zv,yv,cube{(Id&)})
        cube{(Id&)}.vert(i&+8,3)=1.0*Y+fn_rot(3,xv,zv,yv,cube{(Id&)})
        
      next i&
      
      rem Vertex display sequence
      for i&=1 to 12
        
        f&=cube{(Id&)}.wind&(i&,1)
        s&=cube{(Id&)}.wind&(i&,2)
        t&=cube{(Id&)}.wind&(i&,3)
        
        rem Calculate the normal to the triangle
        s1X=cube{(Id&)}.vert(s&+8,1) - cube{(Id&)}.vert(f&+8,1)
        s1Z=cube{(Id&)}.vert(s&+8,2) - cube{(Id&)}.vert(f&+8,2)
        s1Y=cube{(Id&)}.vert(s&+8,3) - cube{(Id&)}.vert(f&+8,3)
        
        s2X=cube{(Id&)}.vert(t&+8,1) - cube{(Id&)}.vert(f&+8,1)
        s2Z=cube{(Id&)}.vert(t&+8,2) - cube{(Id&)}.vert(f&+8,2)
        s2Y=cube{(Id&)}.vert(t&+8,3) - cube{(Id&)}.vert(f&+8,3)
        
        rem Calculates the normal to the current triangle
        proc_norm(i&,s1X,s1Z,s1Y,s2X,s2Z,s2Y,cube{(Id&)})
        
        if cube{(Id&)}.norm(i&,2)<0 then
          rem Decide on the colour shade for the triangle
          proc_shade(i&,Id&,cube{(Id&)})
          
          rem Display the next triangle of vertices
          rem so long as it faces the "camera"
          X=cube{(Id&)}.vert(f&+8,1)
          Z=cube{(Id&)}.vert(f&+8,2)
          Y=cube{(Id&)}.vert(f&+8,3)
          proc_disp(i&,X,Z,Y,1)
          
          X=cube{(Id&)}.vert(s&+8,1)
          Z=cube{(Id&)}.vert(s&+8,2)
          Y=cube{(Id&)}.vert(s&+8,3)
          proc_disp(i&,X,Z,Y,2)
          
          X=cube{(Id&)}.vert(t&+8,1)
          Z=cube{(Id&)}.vert(t&+8,2)
          Y=cube{(Id&)}.vert(t&+8,3)
          proc_disp(i&,X,Z,Y,3)
          
        endif
      next i&
      
      endproc
      rem ===================================================================
      
      rem Place the object
      def proc_place_pyr(X,Z,Y,Th,Ph,Ps)
      local xv,yv,zv,i&
      
      rem Update rotation matrix
      proc_rotmat(Th,Ph,Ps,pyr{})
      
      rem Translate and rotate vertices
      for i&=1 to 5
        
        xv=pyr.vert(i&,1)
        zv=pyr.vert(i&,2)
        yv=pyr.vert(i&,3)
        
        pyr.vert(i&+5,1)=1.0*X+fn_rot(1,xv,zv,yv,pyr{})
        pyr.vert(i&+5,2)=1.0*Z+fn_rot(2,xv,zv,yv,pyr{})
        pyr.vert(i&+5,3)=1.0*Y+fn_rot(3,xv,zv,yv,pyr{})
        
      next i&
      
      rem Vertex display sequence
      for i&=1 to 6
        
        f&=pyr.wind&(i&,1)
        s&=pyr.wind&(i&,2)
        t&=pyr.wind&(i&,3)
        
        rem Calculate Z-value of the normal to the triangle, for "backface culling"
        s1X=pyr.vert(s&+5,1) - pyr.vert(f&+5,1)
        s1Z=pyr.vert(s&+5,2) - pyr.vert(f&+5,2)
        s1Y=pyr.vert(s&+5,3) - pyr.vert(f&+5,3)
        
        s2X=pyr.vert(t&+5,1) - pyr.vert(f&+5,1)
        s2Z=pyr.vert(t&+5,2) - pyr.vert(f&+5,2)
        s2Y=pyr.vert(t&+5,3) - pyr.vert(f&+5,3)
        
        rem Calculates the normal to the current triangle
        proc_norm(i&,s1X,s1Z,s1Y,s2X,s2Z,s2Y,pyr{})
        
        if pyr.norm(i&,2)<0 then
          rem Decide on the colour shade for the triangle
          proc_shade(i&,2,pyr{})
          
          rem Display the next triangle of vertices
          rem so long as it faces the "camera"
          X=pyr.vert(f&+5,1)
          Z=pyr.vert(f&+5,2)
          Y=pyr.vert(f&+5,3)
          proc_disp(i&,X,Z,Y,1)
          
          X=pyr.vert(s&+5,1)
          Z=pyr.vert(s&+5,2)
          Y=pyr.vert(s&+5,3)
          proc_disp(i&,X,Z,Y,2)
          
          X=pyr.vert(t&+5,1)
          Z=pyr.vert(t&+5,2)
          Y=pyr.vert(t&+5,3)
          proc_disp(i&,X,Z,Y,3)
          
        endif
        
      next i&
      
      endproc
      rem ===================================================================
      
      rem Place the object
      def proc_place_dodec(X,Z,Y,Th,Ph,Ps)
      local xv,yv,zv,i&
      
      rem Update rotation matrix
      proc_rotmat(Th,Ph,Ps,dodec{})
      
      rem Translate and rotate vertices
      for i&=1 to 20
        
        xv=dodec.vert(i&,1)
        zv=dodec.vert(i&,2)
        yv=dodec.vert(i&,3)
        
        dodec.vert(i&+20,1)=1.0*X+fn_rot(1,xv,zv,yv,dodec{})
        dodec.vert(i&+20,2)=1.0*Z+fn_rot(2,xv,zv,yv,dodec{})
        dodec.vert(i&+20,3)=1.0*Y+fn_rot(3,xv,zv,yv,dodec{})
        
      next i&
      
      rem Vertex display sequence
      for i&=1 to 36
        
        f&=dodec.wind&(i&,1)
        s&=dodec.wind&(i&,2)
        t&=dodec.wind&(i&,3)
        
        rem Calculate Z-value of the normal to the triangle, for "backface culling"
        s1X=dodec.vert(s&+20,1) - dodec.vert(f&+20,1)
        s1Z=dodec.vert(s&+20,2) - dodec.vert(f&+20,2)
        s1Y=dodec.vert(s&+20,3) - dodec.vert(f&+20,3)
        
        s2X=dodec.vert(t&+20,1) - dodec.vert(f&+20,1)
        s2Z=dodec.vert(t&+20,2) - dodec.vert(f&+20,2)
        s2Y=dodec.vert(t&+20,3) - dodec.vert(f&+20,3)
        
        rem Calculates the normal to the current triangle
        proc_norm(i&,s1X,s1Z,s1Y,s2X,s2Z,s2Y,dodec{})
        
        if dodec.norm(i&,2)<0 then
          rem Decide on the colour shade for the triangle
          proc_shade(i&,3,dodec{})
          
          rem Display the next triangle of vertices
          rem so long as it faces the "camera"
          X=dodec.vert(f&+20,1)
          Z=dodec.vert(f&+20,2)
          Y=dodec.vert(f&+20,3)
          proc_disp(i&,X,Z,Y,1)
          
          X=dodec.vert(s&+20,1)
          Z=dodec.vert(s&+20,2)
          Y=dodec.vert(s&+20,3)
          proc_disp(i&,X,Z,Y,2)
          
          X=dodec.vert(t&+20,1)
          Z=dodec.vert(t&+20,2)
          Y=dodec.vert(t&+20,3)
          proc_disp(i&,X,Z,Y,3)
          
        endif
        
      next i&
      
      endproc
      rem ===================================================================
      
      rem Rotation calculation
      def fn_rot(j&,Xv,Zv,Yv,obj{})
      =obj.mat(j&,1)*Xv + obj.mat(j&,2)*Zv + obj.mat(j&,3)*Yv
      rem ===================================================================
      
      rem Calculate normals, for "backface culling" and shading purposes
      def proc_norm(I&,T1X,T1Z,T1Y,T2X,T2Z,T2Y,obj{})
      local n1,n2,n3,M
      
      n1=T2Z*T1Y - T2Y*T1Z
      n2=T2Y*T1X - T2X*T1Y
      n3=T2X*T1Z - T2Z*T1X
      
      M=sqr(n1*n1 + n2*n2 + n3*n3)
      
      obj.norm(I&,1)=n1/M
      obj.norm(I&,2)=n2/M
      obj.norm(I&,3)=n3/M
      
      endproc
      rem ===================================================================
      
      rem Decide on the colour shade for the triangle
      def proc_shade(I&,Ctr&,obj{})
      local nX,nZ,nY,re&,gr&,bl&,rs&,gs&,bs&,csA
      
      re&=100+10*Ctr& : gr&=50+30*Ctr& : bl&=100-30*Ctr&
      
      nX=obj.norm(I&,1)
      nZ=obj.norm(I&,2)
      nY=obj.norm(I&,3)
      
      csA=light(1,1)*nX + light(1,2)*nZ + light(1,3)*nY
      csB=light(2,1)*nX + light(2,2)*nZ + light(2,3)*nY
      
      ddr&=-int(100*csA*(csA>0) + 100*csB*(csB>0))
      ddg&=-int(100*csA*(csA>0) + 0*csB*(csB>0))
      ddb&=-int(100*csA*(csA>0) + 0*csB*(csB>0))
      
      rs%=re& + ddr& : if rs%>255 then rs%=255
      rf&=rs%
      gs%=gr& + ddg& : if gs%>255 then gs%=255
      gf&=gs%
      bs%=bl& + ddb& : if bs%>255 then bs%=255
      bf&=bs%
      
      colour 10,rf&,gf&,bf& : gcol 10
      
      endproc
      rem ===================================================================
      
      rem Display the triangle
      def proc_disp(c&,X,Z,Y,In&)
      
      if W%=0 then dim pxy%(2,3) : W%=1
      
      rem Calculate the screen plot points
      proc_poynt(X,Z,Y,pxy%(1,In&),pxy%(2,In&))
      
      if In&=3 then
        move pxy%(1,1),pxy%(2,1) : move pxy%(1,2),pxy%(2,2) : plot 85,pxy%(1,3),pxy%(2,3)
      endif
      
      endproc
      rem ===================================================================
      
      def proc_poynt(Xx,Zz,Yy,return Px%,return Py%)
      local Fac,s,x,y
      
      Fac=(1-A)/(Zz-A) : rem Reduction or scale factor
      x=Xx*Fac : y=Yy*Fac
      
      rem Scale to screen size
      Px%=int(xmax%*x) : Py%=int(ymax%*y)
      endproc
      rem ===================================================================
      
      rem Rotation Matrix Update
      def proc_rotmat(Thet,Phii,Psii,obj{})
      local Th,Ph,Ps
      
      Th=rad(Thet) : Ph=rad(Phii) : Ps=rad(Psii)
      
      obj.mat(1,1)= cos(Ps)*cos(Ph)*cos(Th) - sin(Ps)*sin(Th)
      obj.mat(1,2)=-sin(Ps)*cos(Ph)*cos(Th) - cos(Ps)*sin(Th)
      obj.mat(1,3)=-sin(Ph)*cos(Th)
      obj.mat(2,1)= cos(Ps)*cos(Ph)*sin(Th) + sin(Ps)*cos(Th)
      obj.mat(2,2)=-sin(Ps)*cos(Ph)*sin(Th) + cos(Ps)*cos(Th)
      obj.mat(2,3)=-sin(Ph)*sin(Th)
      obj.mat(3,1)= cos(Ps)*sin(Ph)
      obj.mat(3,2)=-sin(Ph)*sin(Ps)
      obj.mat(3,3)= cos(Ph)
      
      endproc
      rem ===================================================================
      
      rem Increment Parameters - with Truncation Control
      def proc_increment(return theta,return phi,return psi,return Dis)
      
      rem Update the increment values
      proc_change(dth,dph,dps,dZ)
      
      theta+=dth : phi+=dph : psi+=dps : Dis+=dZ
      if theta>360 then theta=theta-360
      if theta<-360 then theta=theta+360
      if phi>360 then phi=phi-360
      if phi<-360 then phi=phi+360
      if psi>360 then psi=psi-360
      if psi<-360 then psi=psi+360
      if abs(theta)<0.01 then theta=0.0
      if abs(phi)<0.01 then phi=0.0
      if abs(psi)<0.01 then psi=0.0
      
      endproc
      rem ===================================================================
      
      rem Increment Parameters - with Truncation Control
      def proc_change(return dth,return dph,return dps,return dZ)
      local sp%
      
      sp$=inkey$(0)
      sp%=asc(sp$)
      case sp% of
        when 44  : dps-=0.1 : if abs(dps)<0.1 then dps=0.0
        when 46  : dps+=0.1 : if abs(dps)<0.1 then dps=0.0
        when 98  : dZ+=0.01 : if abs(dZ)<0.01 then dZ=0.0
        when 102 : dZ-=0.01 : if abs(dZ)<0.01 then dZ=0.0
        when 136 : dth-=0.1 : if abs(dth)<0.1 then dth=0.0
        when 137 : dth+=0.1 : if abs(dth)<0.1 then dth=0.0
        when 138 : dph-=0.1 : if abs(dph)<0.1 then dph=0.0
        when 139 : dph+=0.1 : if abs(dph)<0.1 then dph=0.0
        when 32  : dZ=0.0
        otherwise
      endcase
      if sp$="t" then sw&=1-sw&
      endproc
      rem ===================================================================
      
      rem Display current value of parameters
      def proc_pars
      local Lst&
      
      if sw&=1 then
        Lst&=sw&
        print tab(5,1);"THETA =";theta;"        "
        print tab(5,2);"PHI = ";phi;"         "
        print tab(5,3);"PSI =";psi;"           "
        
        print tab(5,5);"Delta Theta = ";dth;"            "
        print tab(5,6);"Delta Phi = ";dph;"          "
        print tab(5,7);"Delta Psi = ";dps;"           "
        print tab(5,10);"Mean Dist. = ";Dis;"           "
      else
        if Lst&=1 then cls : Lst&=0
      endif
      endproc
      rem ===================================================================
      
      rem Prints the backdrop for the screen message
      def proc_back(Xs%,Ys%,Ws%,Hs%,Rr&,Gg&,Bb&)
      local h&,Rf&,Gf&,Bf&
      
      for h&=0 to 30
        Rf&=Rr&*h&/30 : Gf&=Gg&*h&/30 : Bf&=Bb&*h&/30
        colour 9,Rf&,Rf&,Rf& : gcol 9
        rectangle fill Xs%+h&,Ys%+h&,Ws%-2*h&,Hs%-2*h&
      next h&
      endproc
      rem ===================================================================
      
      rem Displays my Icon in .exe version
      def proc_AJTicon(i%,j%)
      sys "GetModuleHandle", 0 to hm%
      sys "LoadImage", hm%, "BBCWin", 1, 32, 32, 0 to hicon%
      w% = 32
      h% = 32
      sys "DrawIconEx", @memhdc%, i%, j%, hicon%, w%, h%, 0, 0, 3
      sys "InvalidateRect", @hwnd%, 0, 0
      endproc
      rem ===============================================================