rem Spirographic ...... Rev 2.3
      rem A J Tooth / Revised June 2006
      on error if (err=17) then quit
      
      rem Set up use of Full Screen
      proc_setup
      
      rem Main routine
      proc_main
      
      *REFRESH ON
      quit
      rem End of Program ++++++++++++++++++++++++++++++++++++++++++++++
      rem =============================================================
      
      rem Set up use of Full Screen
      def proc_setup
      
      *FLOAT 64
      proc_fullscreen(Xscreen%,Yscreen%)
      xlim%=2*Xscreen% : ylim%=2*Yscreen%
      
      origin Xscreen%,Yscreen%
      a$=""
      Flp&=0 : Frst&=1
      
      dim XYcalc% 1000, f075% 7
      |f075%=0.75 : rem Preset value
      
      fscl=1.0*Xscreen%/1024 : rem Scaling factor
      rem Dual-pass assembly, in case of labels
      for pass&=0 to 2 step 2
        proc_XYcalc(pass&)
      next pass&
      *REFRESH OFF
      endproc
      rem =============================================================
      
      rem Main routine
      def proc_main
      
      repeat
        gcol 128 : cls
        Flp&=rnd(2)-1
        MPts%=500 + 500*(1-Flp&) : cur&=14 - 7*(1-Flp&)
        RadBig=1.0*(210+(450*Flp&))
        
        ff&=rnd(11)-1 : rem Offset for each next inner figure
        rem Sets outermost point 30% BEYOND RadLit
        RadLit=10.0*(5+rnd(25+(Flp&*35))) : Radst=1.3*RadLit : Raden=0.2*RadLit
        
        rem Finds lowest common multiple for RadBig and RadLit.
        num%=fn_lowcom
        
        rem Set Random Colours
        if num%>30 then cur&=9
        r1&=rnd(255) : g1&=rnd(255) b1&=rnd(255)
        r2&=rnd(255) : g2&=rnd(255) b2&=rnd(255)
        
        rem Draw the curve
        proc_drwcurv
        
        a$=inkey$(50)
      until a$<>""
      endproc
      rem =============================================================
      
      rem Set up use of Full Screen
      def proc_fullscreen(return xscreen%, return yscreen%)
      
      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 MAIN FUNCTIONS
      rem =============================================================
      
      rem  X/Y co-ordinates
      def fn_xypos(Ex&,Flg&,Ss%,RadMod,Offset)
      local th,res
      
      rem Calculation for x,y points entirely in ASM
      call XYcalc%
      
      =int(res)
      rem =============================================================
      
      rem Slide linearly from one random colour to the other
      def proc_cols
      
      fac=l&/(cur&-1)
      
      Red&=r1&+int((r2&-r1&)*fac)
      Gre&=g1&+int((g2&-g1&)*fac)
      Blu&=b1&+int((b2&-b1&)*fac)
      colour 10,Red&,Gre&,Blu& : gcol 10
      endproc
      rem =============================================================
      
      rem Finds lowest common multiple for RadBig and RadLit.
      rem Then finds how many times RadLit divides this LCM.
      rem This is then the loop variable needed, Num%.
      rem Num% is then also the number of vertices drawn.
      def fn_lowcom : local i%, Flg&, Nu, Nu%
      
      i%=1 : Flg&=1
      repeat
        Nu=RadBig*i%/RadLit : Nu%=int(Nu)
        if Nu%=Nu then
          Num%=Nu%
          Flg&=2
        else
          i%+=1
        endif
      until Flg&=2
      =Num%
      rem =============================================================
      
      rem Draw the curve
      def proc_drwcurv
      local l&, a%, Pts%, x, y, s%, ps%, px%, py%
      
      for l&=0 to (cur&-1)
        Radmod=Radst - (Radst-Raden)*l&/(cur&-1)
        ffset=l&*ff&*2*pi/360
        
        sys "GetCurrentProcess" to hprocess%
        sys "SetPriorityClass", hprocess%, &100
        rem Slide linearly from one random colour to the other
        proc_cols
        
        for a%=1 to num%
          Pts%=MPts%-5*l&
          for s%=0 to Pts%
            ps%=((a%-1)*Pts%) + s%
            
            x%=fn_xypos(Flp&,0,ps%,Radmod,ffset)
            y%=fn_xypos(Flp&,1,ps%,Radmod,ffset)
            
            rem Draws a line between adjacent points
            if s%=0 then
              move x%,y%
            else
              draw x%,y%
            endif
          next s%
          *REFRESH
        next a%
        sys "GetCurrentProcess" to hprocess%
        sys "SetPriorityClass", hprocess%, &20
        
        a$=inkey$(1) : if a$<>"" then quit
      next l&
      endproc
      rem =============================================================
      
      rem XY calculation Routine
      def proc_XYcalc(opt&)
      P%=XYcalc%
      [opt opt&
      
      finit
      fldpi                        ;Calc f0r th(eta)
      fadd st0,st0
      fild dword [^Ss%]
      fmulp st1,st0
      fild dword [^Pts%]
      fdivp st1,st0
      fstp qword [^th]             ;Calc f0r th(eta)
      
      fld qword [^RadBig]          ;Calc f0r fac1
      fld qword [^RadLit]
      mov al,[^Ex&]
      cmp al,0
      jne take
      faddp st1,st0
      jmp cont
      .take
      fsubp st1,st0
      .cont
      fstp qword [^fac1]           ;Calc f0r fac1
      
      fld qword [^RadLit]          ;Calc f0r fac2
      fld qword [^RadBig]
      fdivp st1,st0
      fld qword [^th]
      fmulp st1,st0
      fstp qword [^fac2]           ;Calc f0r fac2
      
      mov al,[^Flg&]
      cmp al,0
      jne cse1
      
      fld qword [^fac2]           ;X calc
      fld qword [^Offset]
      faddp st1,st0
      fsin
      fld qword [^fac1]
      fmulp st1,st0
      
      fld qword [^th]
      fld qword [^fac2]
      fsubp st1,st0
      fsin
      fld qword [^RadMod]
      fmulp st1,st0
      fsubp st1,st0               ;X calc
      jmp fin
      
      .cse1
      fld qword [^fac2]           ;Y calc
      fld qword [^Offset]
      faddp st1,st0
      fcos
      fld qword [^fac1]
      fmulp st1,st0
      fchs
      
      fld qword [^th]
      fld qword [^fac2]
      fsubp st1,st0
      fcos
      fld qword [^RadMod]
      fmulp st1,st0
      fsubp st1,st0
      fld qword [f075%]
      fmulp st1,st0               ;Y calc
      
      .fin
      fld qword [^fscl]
      fmulp st1,st0
      fstp qword [^res]
      ret
      ]
      endproc
      rem =======================================================================