rem Spirographic D (Assembler Version) ...... Rev 5.5
      rem A J Tooth / Solid version 28th January 2005
      rem Revised to include BMP graphics 28th July 2005
      
      rem Set up use of Full Screen
      *FLOAT 64
      himem=lomem + 6000000
      
      rem Set parameters and compile Assembly Routines
      proc_param
      
      rem Auto Repeat
      repeat
        rem Reset Parameters
        proc_reset
        
        for !l%=0 to ((!cur%)-1)
          sys "GetCurrentProcess" to hprocess%
          sys "SetPriorityClass", hprocess%, &100
          
          |Radmod%=|Radst% - (|Radst%-|Raden%)*!l%/((!cur%)-1)
          |ffset%=!l%*ff*2*pi/360
          
          rem Slide linearly from one random colour to the other
          proc_colslide
          
          rem Assembly Routines
          call mast%
          
          sys "GetCurrentProcess" to hprocess%
          sys "SetPriorityClass", hprocess%, &20
          cum&+=1
          if cum&=15 then
            cum&=0
            rem Display BMP
            sys "SetStretchBltMode", @memhdc%, 3
            command$="MDISPLAY "+str$~pic%+" 0,0,"+str$(2*xscreen%)+","+str$(2*yscreen%)
            oscli command$
            
            *REFRESH
            
          endif
        next
        
        *REFRESH
        a$=inkey$(100)
      until a$<>""
      
      *REFRESH ON
      vdu 5
      move 100,1400 :gcol 4:print;" Press -c- to continue,"
      move 100,1350 : print;" or any other key to EXIT."
      vdu 4
      a$=get$
      if a$="c" then run
      quit
      end
      rem End of Program ++++++++++++++++++++++++++++++++++++++++++++++
      rem =============================================================
      
      rem Standard BMPHeader setup
      def proc_bmpheader(Ww%,Hh%,return pc%,return Wlim%,return lgth%)
      
      Wlim%=((Ww%*3+3)and-4)
      
      lgth%=54+Hh%*Wlim%
      dim pc% (lgth%+100)
      
      P% = pc%
      [OPT 0
      DB "BM"          ; Signature
      DD lgth%         ; Total file bytes
      DD 0             ; Set t0 zero
      DD 54            ; Header bytes
      DD 40            ; Offset t0 Data
      DD Ww%           ; Image Width
      DD Hh%           ; Image Height
      DW 1             ; Bit planes
      DW 24            ; Colour depth in bits
      DD 0             ; Compression type=0=none
      DD lgth%-54      ; Image size net 0f header
      DD 0             ; Set t0 zero
      DD 0             ; Set t0 zero
      DD 0             ; Set t0 zero
      DD 0             ; Set t0 zero
      ]
      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 =============================================================
      
      rem Set parameters and compile Assembly Routines
      def proc_param
      
      rem Go to full screen
      proc_fullscreen(xscreen%,yscreen%)
      
      dim thcalc% 500, xycalc% 700, mast% 500, Pts% 3
      dim RadBig% 3, RadLit% 3, Radst% 7, Raden% 7
      dim Radmod% 7, ffset% 7, ps% 3, th% 7, a% 3, s% 3, l% 3
      dim f% 0, cur% 3, Num% 3, MPts% 3, fac% 7, fac2% 7
      dim r1% 0,g1% 0,b1% 0,r2% 0,g2% 0,b2% 0
      dim CR% 3, t% 3, u% 3
      dim plt% 1000, x% 7, y% 7, sgx% 0, sgy% 0, px% 3, py% 3
      dim InWh%(10), prepbmp% 1000
      dim red% 0, gre% 0, blu% 0, rgb% 3, rgb1% 3, rgb2% 3
      dim i767% 3, ftmp% 7, itmp% 3
      
      !i767%=yscreen%-1
      
      if xscreen%<1280 then
        InWh%()=315,210,126,105,90,70,420,252,525,330
      else
        InWh%()=420,280,210,168,140,120,315,360,336,430
      endif
      proc_bmpheader(xscreen%,yscreen%,pic%,Wlim%,lgth%)
      
      rem Dual-pass assembly, in case of labels
      for pass&=0 to 2 step 2
        proc_thcalc(pass&)
        proc_xycalc(pass&)
        proc_plt(pass&)
        proc_mast(pass&)
        proc_prepbmp(pass&)
      next pass&
      endproc
      rem =============================================================
      
      rem Slide linearly from one random colour to the other
      def proc_colslide
      
      case cs& of
        when 1: |fac%=!l%/((!cur%)-1) : |fac2%=1.0
        when 2: |fac%=(1+sin(10*(!l%/((!cur%)-1))))/2 : |fac2%=1.0
        when 3: |fac%=!l%/((!cur%)-1) : |fac2%=(1+sin(|fac%*10*pi))/2
      endcase
      
      ?red%=int(|fac2%*(?r1%+(?r2%-?r1%)*|fac%))
      ?gre%=int(|fac2%*(?g1%+(?g2%-?g1%)*|fac%))
      ?blu%=int(|fac2%*(?b1%+(?b2%-?b1%)*|fac%))
      
      endproc
      rem =============================================================
      
      rem Reset Parameters
      def proc_reset
      
      !MPts%=1500  : !cur%=300
      if xscreen%<1280 then
        !RadBig%=630
      else
        !RadBig%=840
      endif
      ff=0.07*rnd(1) : rem Offset for each next inner figure
      rem Sets outermost point 30% BEYOND RadLit
      ch&=rnd(10)-1
      !RadLit%=InWh%(ch&) : rem 32-bit integer
      |Radst%=1.4*!RadLit% : |Raden%=0.3*!RadLit% : rem must be FP
      
      i%=1 : Flg&=1 : cs&=rnd(3)
      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.
      repeat
        Nu=!RadBig%*i%/!RadLit% : Nu%=int(Nu)
        if Nu%=Nu then
          !Num%=Nu%
          Flg&=2
        else
          i%+=1
        endif
      until Flg&=2
      
      rem Set Random Colours
      ?r1%=rnd(255) : ?g1%=rnd(255) : ?b1%=rnd(255)
      ?r2%=rnd(255) : ?g2%=rnd(255) : ?b2%=rnd(255)
      cum&=0
      ?rgb2%=rnd(100) : ?(rgb2%+1)=rnd(100) : ?(rgb2%+2)=rnd(100)
      ?rgb1%=155+rnd(100) : ?(rgb1%+1)=155+rnd(100) : ?(rgb1%+2)=155+rnd(100)
      call prepbmp%
      endproc
      rem =============================================================
      
      rem Master Assembly Routine
      def proc_mast(opt&)
      
      P%=mast%
      [opt opt&
      
      finit
      fstcw [CR%]          ;Set rounding control To TRUNCATE
      mov ax,[CR%]
      and ax,&F3FF         ;Clears bits 10-11 in FP Cntrl Register
      or ax,&C00           ;Resets bits 10-11 To 1's Causes Truncation
      mov [CR%],ax
      fldcw [CR%]          ;Set rounding control To TRUNCATE
      
      mov eax,1            ;Initialise a% loop control
      mov [a%],eax
      
      .loopa
      mov eax,0            ;Initialise s% loop control
      mov [s%],eax
      
      .loops
      call thcalc%
      mov al,0
      mov [f%],al
      call xycalc%
      inc byte [f%]
      call xycalc%
      call plt%
      
      inc dword [s%]       ;Rpeat ntil s%=MPts%
      mov eax,[s%]
      cmp eax,[MPts%]
      jle loops
      
      inc dword [a%]       ;Rpeat ntil a%=Num%
      mov eax,[a%]
      cmp eax,[Num%]
      jle loopa
      
      fstcw [CR%]          ;Reset rounding control t0 Default
      mov ax,[CR%]
      and ax,&F3FF         ;Clears bits 10-11 in FP Cntrl Register
      mov [CR%],ax
      fldcw [CR%]          ;Reset rounding control t0 Default
      
      ret
      ]
      endproc
      rem =============================================================
      
      rem Assembly Routine for Theta
      def proc_thcalc(opt&)
      
      P%=thcalc%
      [opt opt&
      
      mov eax,[a%]
      dec eax
      imul eax,[MPts%]
      add eax,[s%]
      mov [ps%],eax
      
      fldpi
      fild dword [MPts%]
      fdivp st1,st0
      fild dword [ps%]
      fmulp st1,st0
      fadd st0,st0
      fstp qword [th%]
      
      ret
      ]
      endproc
      rem =============================================================
      
      rem Assembly Routine for X or Y
      rem Control Variable f% alters calc for x or y
      def proc_xycalc(opt&)
      
      P%=xycalc%
      [opt opt&
      
      fild dword [RadLit%]
      fild dword [RadBig%]
      fdivp st1,st0
      fld1
      fsubrp st1,st0
      fld qword [th%]
      fmulp st1,st0
      mov al,[f%]
      cmp al,1
      je ycos1
      fsin
      jmp skip1
      .ycos1
      fcos
      .skip1
      fld qword [Radmod%]
      fmulp st1,st0
      fild dword [RadLit%]
      fild dword [RadBig%]
      fdivp st1,st0
      fld qword [th%]
      fmulp st1,st0
      fld qword [ffset%]
      faddp st1,st0
      cmp al,1
      je ycos2
      fsin
      jmp skip2
      .ycos2
      fcos
      .skip2
      fild dword [RadLit%]
      fild dword [RadBig%]
      cmp al,1
      je ysgn
      fsubrp st1,st0
      jmp xsgn
      .ysgn
      fsubp st1,st0
      .xsgn
      fmulp st1,st0
      fsubrp st1,st0
      cmp al,1
      je yval
      fstp qword [x%]
      jmp rond
      .yval
      fstp qword [y%]
      
      .rond ret
      ]
      endproc
      rem =============================================================
      
      rem Assembly Routine for Plotting to a blank BMP
      def proc_plt(opt&)
      
      P%=plt%
      [opt opt&
      
      finit
      
      fld1
      fadd st0,st0
      fld qword [x%]
      fdiv st0,st1
      fistp dword [px%]
      fld qword [y%]
      fdivrp st1,st0
      fistp dword [py%]
      
      mov ecx,[py%]
      mov eax,[^yscreen%]
      shr eax,1
      add ecx,eax
      mov [py%],ecx
      mov ecx,[px%]
      mov eax,[^xscreen%]
      shr eax,1
      add ecx,eax
      mov [px%],ecx
      
      mov ebx,[px%]
      cmp ebx,0
      jl miss
      cmp ebx,[^xscreen%]
      jge miss
      mov eax,[py%]
      cmp eax,0
      jl miss
      cmp eax,[^yscreen%]
      jge miss
      
      imul eax,[^Wlim%]
      add eax,[px%]
      add eax,[px%]
      add eax,[px%]
      add eax,54
      
      mov cl,[blu%]
      mov pic%[eax],cl
      mov cl,[gre%]
      mov pic%[eax+1],cl
      mov cl,[red%]
      mov pic%[eax+2],cl
      
      .miss
      ret
      ]
      endproc
      rem ===============================================================
      
      rem Assembly Routine for BMP prep
      def proc_prepbmp(opt&)
      
      P%=prepbmp%
      [opt opt&
      
      finit
      
      mov edx,0                    ;Initialise u-loop counter
      mov [u%],edx
      
      .uloop
      fild dword [u%]              ;Colour split
      fild dword [i767%]
      fdivp st1,st0
      fstp qword [ftmp%]
      
      mov ecx,0                    ;Blue
      mov cl,[rgb1%]
      mov [itmp%],ecx
      fild dword [itmp%]
      fld qword [ftmp%]
      fmulp st1,st0
      mov cl,[rgb2%]
      mov [itmp%],ecx
      fild dword [itmp%]
      fld qword [ftmp%]
      fld1
      fsubrp st1,st0
      fmulp st1,st0
      faddp st1,st0
      fistp dword [itmp%]
      mov cl,[itmp%]
      mov [rgb%],cl                ;Blue
      
      mov ecx,0                    ;Green
      mov cl,[rgb1%+1]
      mov [itmp%],ecx
      fild dword [itmp%]
      fld qword [ftmp%]
      fmulp st1,st0
      mov cl,[rgb2%+1]
      mov [itmp%],ecx
      fild dword [itmp%]
      fld qword [ftmp%]
      fld1
      fsubrp st1,st0
      fmulp st1,st0
      faddp st1,st0
      fistp dword [itmp%]
      mov cl,[itmp%]
      mov [rgb%+1],cl              ;Green
      
      mov ecx,0                    ;Red
      mov cl,[rgb1%+2]
      mov [itmp%],ecx
      fild dword [itmp%]
      fld qword [ftmp%]
      fmulp st1,st0
      mov cl,[rgb2%+2]
      mov [itmp%],ecx
      fild dword [itmp%]
      fld qword [ftmp%]
      fld1
      fsubrp st1,st0
      fmulp st1,st0
      faddp st1,st0
      fistp dword [itmp%]
      mov cl,[itmp%]
      mov [rgb%+2],cl              ;Red
      
      mov ebx,[rgb%]
      mov eax,[u%]
      imul eax,[^Wlim%]
      add eax,54
      
      mov edx,0                    ;Initialise t-loop counter
      mov [t%],edx
      
      .tloop
      add eax,3
      mov pic%[eax],ebx
      
      inc dword [t%]               ;t-loop control
      mov edx,[t%]
      cmp edx,[^xscreen%]
      jl tloop
      
      inc dword [u%]               ;u-loop control
      mov edx,[u%]
      cmp edx,[^yscreen%]
      jl near uloop
      
      ret
      ]
      endproc
      rem ===============================================================