rem Julia Cosine (Assembly Version)...... Rev 8.1
      rem A J Tooth / 1st February 2003 Revised 5th December 2003
      
      on error if (err=17) then quit
      *FLOAT64
      rem Set up use of Full Screen
      proc_fullscreen(22)
      xlim%=2048 : ylim%=1536
      *FONT Arial,10,B
      colour 3
      dim Col%(9,6)
      
      dim stp% 3,Kr% 7,Ki% 7,com% 7,arg% 7,cm% 7,sg% 0,res% 7,low% 7,max% 7
      dim r% 7,i% 7,inex% 7,rnex% 7,zmod% 7,xt% 0,lmt% 3,x% 7,y% 7,two% 7
      dim xpr% 7,Pwr% 3,Nfl% 0,f% 7,lp% 0,lplm% 0,Main% 7
      dim exarg% 7,nxarg% 7,CR% 3,Cos% 7,Sin% 7
      
      dim zcalc% 5000
      
      |low%=0.01 : |max%=10.00001 : |two%=2.0
      
      rem Dual-pass assembly, in case of labels
      for pass%=0 to 2 step 2
        proc_zcalc(pass%)
        
      next pass%
      
      cls : clg
      
      rem Parameter Setup
      print tab(10,10);" This program is the COSINE(Z/C) version of the Mandelbrot/Julia Sets."
      print tab(10,12);" Either enter your own parameters, or choose a point on the MANDELBROT set."
      print tab(10,14);" Press -m- for the Mandelbrot option, or spacebar to enter your own."
      
      rem Sets up eight levels of random colour
      proc_tencols
      
      a$=get$ : clg
      if a$="m" then
        rem Preset parameters
        !lmt%=320 : rl=-2.5 : ru=2.5 : il=-2.5 : iu=2.5 : |cm%=100.001
        rem Initial Mandelbrot picture
        hs$="s"
        proc_mandinit
      else
        cls : print " Enter personally chosen parameters. " : print
        input " Iteration limit (65)",!lmt%
        input " Lower real limit (-2)",rl
        input " Upper real limit (2)",ru
        input " Lower imag. limit (-2)",il
        input " Upper imag. limit (2)",iu
        input " Julia Parameter value 1 (0.45)",cr
        input " Julia Parameter value 2 (0.7)",ci
        input " Complex Modulus limit (1,000,000)",|cm%
      endif
      cls : clg
      
      rem Colour scheme options
      repeat
        input tab(10,10);" Leave colours as random, or choose a range. Enter -d- or -r-. ",ch$
      until (ch$="d" or ch$="r")
      c$=ch$
      if c$="r" then
        proc_colran
      else
        rem Random colours already set above
        print:input" Hard or Soft colour changes? Press -h- or -s-. ",hs$
        if hs$="" then hs$="s"
      endif
      
      rem Repeats from here after PROC_zoom
  660 cls : clg
      repeat
        input tab(10,10);" Enter q for quick and s for slow output ",spd$
      until (spd$="q" or spd$="s")
      cls : clg
      
      rem MAIN: Iteration Section
      if spd$="q" then st%=8 else st%=2
      sys "GetCurrentProcess" to hprocess%
      sys "SetPriorityClass", hprocess%, &100
      
      for a%= 0 to xlim% step st%
        for b%= 0 to ylim% step st%
          rem Set initial values
          proc_init(cr,ci)
          rem Main Procedure for Julia/Mandelbrot calculations
          proc_julman(cr,ci)
          rem Go and get the colours
          proc_cols
          rem Plots a SINGLE PIXEL
          move a%,b% : draw a%,b%
        next b%
        a$=inkey$(1)
        if a$<>"" then
          sys "GetCurrentProcess" to hprocess%
          sys "SetPriorityClass", hprocess%, &20
          run
        endif
      next a%
      sys "GetCurrentProcess" to hprocess%
      sys "SetPriorityClass", hprocess%, &20
      
      rem End of Main Body
      rem Primary Exit & Repeat Options
      sp$=get$
      if sp$="s" then goto 1080
      if sp$="m" then
        proc_zoom
      else run
      endif
      goto 660
 1080 quit
      end
      rem End of Programme ---------------------------------------
      :
      rem PROC 1
      rem Sets Colour Range
      def proc_colran
      input tab(10,12);" Select base colour. Enter r,g or b. ",bs$
      input " Select low(1), medium(2) or high(3) or max(4) intensity. Enter 1,2,3 or 4. ",in%
      print " Using the same colour for base and range is OK."
      input " Enter ranging colour (r,g or b). ",rn$
      input" Enter third colour (r,g or b) if required or enter (x) if not required. ",ot$
      input " Use 64 colour gradations in Slow mode or only 16. Enter -h- or -l-. ",gr$
      case gr$ of
        when "h" : gr%=64
        when "l" : gr%=16
      endcase
      case bs$ of
        when "r" : Red%=63*in% : Green%=0      : Blue%=0
        when "g" : Red%=0      : Green%=63*in% : Blue%=0
        when "b" : Red%=0      : Green%=0      : Blue%=63*in%
      endcase
      endproc
      :
      rem PROC 2
      rem Set initial values
      def proc_init(Cr,Ci)
      
      |Kr%=Cr : |Ki%=Ci
      |x%=rl+(a%/xlim%)*(ru-rl)
      |y%=il+(b%/ylim%)*(iu-il)
      |com%=|Kr%*|Kr%-|Ki%*|Ki% : if abs(|com%)<|low% then |com%=|low%
      |arg%=(|Kr%*|y%-|Ki%*|x%)/|com%
      if abs(|arg%)>|max% then
        if |arg%>0 then |arg%=|max% else |arg%=-|max%
      endif
      |r%=(cos((|Kr%*|x%+|Ki%*|y%)/|com%))*fn_cosh(|arg%)
      |i%=-(sin((|Kr%*|x%+|Ki%*|y%)/|com%))*fn_sinh(|arg%)
      
      |zmod%=sqr(|r%*|r%+|i%*|i%)
      endproc
      :
      rem PROC 3
      rem Set up use of Full Screen
      def proc_fullscreen(N%)
      sys "GetSystemMetrics", 0 to xscreen%
      sys "GetSystemMetrics", 1 to yscreen%
      sys "SetWindowLong",@hwnd%,-16,&16000000
      sys "SetWindowPos",@hwnd%,-1,0,0,xscreen%,yscreen%,0
      mode N%
      mouse off : off : rem Turns off the Mouse Pointer and the Cursor
      endproc
      :
      rem PROC 4
      rem Enables user to zoom into a particular area
      def proc_zoom
      local xx%,yy%,b%,ax%,bx%,ay%,by%,rnl,inl
      mouse on : gcol 7
      rem Select first corner of rectangular zoom area
      repeat
        mouse xx%,yy%,b%
        ax%=xx% : ay%=yy%
      until b%=4
      rem Print a "+" at the first corner
      move ax%-10,ay% : draw ax%+10,ay%
      move ax%,ay%-10 : draw ax%,ay%+10
      rem Select opposite corner of zoom area
      repeat
        mouse xx%,yy%,b%
        bx%=xx% : by%=yy%
      until b%=1
      rem Draw a box and wait 1 second before moving on
      move ax%,ay% : draw bx%,ay% : draw bx%,by%
      draw ax%,by% : draw ax%,ay%
      a$=inkey$(100)
      
      rem Re-assign corner points in ascending order
      if ax%<bx% then
        lx%=ax% : ux%=bx%
      else
        lx%=bx% : ux%=ax%
      endif
      if ay%<by% then
        ly%=ay% : uy%=by%
      else
        ly%=by% : uy%=ay%
      endif
      rem Re-assign viewing window limits
      rnl=rl+((ru-rl)*(lx%/xlim%))
      rnu=rl+((ru-rl)*(ux%/xlim%))
      
      inl=il+((iu-il)*(ly%/ylim%))
      inu=il+((iu-il)*(uy%/ylim%))
      rl=rnl : il=inl
      ru=rnu : iu=inu
      mouse off
      endproc
      :
      rem PROC 5
      rem Calculates colour to use, depending on how fast function exceeds limit
      def proc_cols
      case c$ of
          
        when "d" :  rem Uses random palette
          if hs$="s" then
            nten%=16*(!stp% mod 16) : lev2%=!stp% div 16
            lev%=int(lev2%/2)
            if lev%>8 then lev%=8
            fct=nten%/256
            if (lev2% mod 2)=0 then
              Red%=  int((1-fct)*Col%(lev%,1)+fct*Col%(lev%,4))
              Green%=int((1-fct)*Col%(lev%,2)+fct*Col%(lev%,5))
              Blue%= int((1-fct)*Col%(lev%,3)+fct*Col%(lev%,6))
            else
              Red%=  int((1-fct)*Col%(lev%,4)+fct*Col%(lev%+1,1))
              Green%=int((1-fct)*Col%(lev%,5)+fct*Col%(lev%+1,2))
              Blue%= int((1-fct)*Col%(lev%,6)+fct*Col%(lev%+1,3))
            endif
          else
            ntn%=16*(!stp% mod 16) : lev%=!stp% div 16
            lev%=lev% mod 10
            fct=ntn%/256
            Red%=  int(fct*Col%(lev%,1)+(1-fct)*Col%(lev%,4))
            Green%=int(fct*Col%(lev%,2)+(1-fct)*Col%(lev%,5))
            Blue%= int(fct*Col%(lev%,3)+(1-fct)*Col%(lev%,6))
          endif
          
        when "r" : rem Uses custom colours
          rem Always only uses 16 colours in Quick mode (64 not easy to see!)
          nten%=(255/gr%)*(!stp% mod gr%)
          lev%=!stp% div gr% : lev%=lev% mod 8
          if (lev% mod 2>0) then nten%=255-nten%
          case rn$ of
            when "r" : Red%=nten%
            when "g" : Green%=nten%
            when "b" : Blue%=nten%
          endcase
          case ot$ of
            when "r" : Red%=32*lev%
            when "g" : Green%=32*lev%
            when "b" : Blue%=32*lev%
            otherwise
              rem Do nothing
          endcase
      endcase
      
      rem Set colour to Black if Zmod remains finite
      if !stp%=!lmt% then ff%=0 else ff%=1
      rem Continually reassigns Colour 10 to be the new hue
      vdu 19,10,16,(ff%*Red%),(ff%*Green%),(ff%*Blue%)
      gcol 0,10
      endproc
      :
      rem PROC 6
      rem Main Julia / Mandelbrot Routine
      def proc_julman(Cr,Ci)
      
      |Kr%=Cr : |Ki%=Ci
      !stp%=1 : ?xt%=0
      
      call zcalc%
      
      endproc
      :
      rem PROC 7
      rem Draws initial Mandelbrot Set to select Julia parameters from
      def proc_mandinit
      local p%,q%
      sys "GetCurrentProcess" to hprocess%
      sys "SetPriorityClass", hprocess%, &100
      
      for p%= 0 to xlim% step 8
        for q%= 0 to ylim%/2 step 8
          rem Set initial values
          |x%=rl+(p%/xlim%)*(ru-rl)
          |y%=il+(q%/ylim%)*(iu-il)
          |com%=|x%*|x%-|y%*|y% : if abs(|com%)<|low% then |com%=|low%
          |r%=(cos((|x%*|x%+|y%*|y%)/|com%)) : |i%=0.0
          |zmod%=sqr(|r%*|r%+|i%*|i%)
          crt=|x% : cit=|y%
          rem Calculate Mandelbrot Set
          proc_julman(crt,cit)
          
          rem Go and get the colours
          proc_cols
          rem Plots a SINGLE PIXEL
          move p%,q% : draw p%,q%
          move p%,1536-q% : draw p%,1536-q%
        next q%
      next p%
      sys "GetCurrentProcess" to hprocess%
      sys "SetPriorityClass", hprocess%, &20
      
      rem Enables selection of Julia parameter using the mouse.
      mouse on 3 : gcol 7
      repeat
        mouse real%,imag%,m%
        X=rl+(real%/xlim%)*(ru-rl)
        Y=il+(imag%/ylim%)*(iu-il)
        print tab(5,2);"Click on the left mouse button at an interesting point."
        print tab(5,5);"Present Point is; ";X;",";Y;"      ";
      until m%=4
      cr=X : ci=Y
      print tab(5,7);"Julia Parameters selected."
      b$=inkey$(100)
      mouse off
      endproc
      :
      rem PROC 8
      rem Sets up eight levels of random colours
      def proc_tencols
      for s%=0 to 7
        c$="d" : cs%=rnd(3)
        rem Singles out one of the primary colours as prevalent
        Rinit%=-63*(cs%<>1)+rnd(191)
        Ginit%=-63*(cs%<>2)+rnd(191)
        Binit%=-63*(cs%<>3)+rnd(191)
        Col%(s%,1)=Rinit% : Col%(s%,2)=Ginit% : Col%(s%,3)=Binit%
        Col%(s%,4)=int(Ginit%/2)
        Col%(s%,5)=int(Binit%/2)
        Col%(s%,6)=int(Rinit%/2)
      next s%
      endproc
      
      rem COSH Function
      def fn_cosh(X)
      cosh=(exp(X)+exp(-X))/2
      =cosh
      
      rem SINH Function
      def fn_sinh(X)
      sinh=(exp(X)-exp(-X))/2
      =sinh
      
      
      rem Assembly Language Routine 1
      rem for Julman / Zmod Calculation
      def proc_zcalc(opt%)
      P%=zcalc%
      [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
      
      .rep mov ax,[stp%]
      inc ax                    \Increments stp%
      mov [stp%],ax
      
      fld qword [Kr%]           \Calculates com%
      fld st0
      fmulp st1,st0
      fld qword [Ki%]
      fld st0
      fmulp st1,st0
      fsubp st1,st0
      fst qword [com%]
      fabs
      fld qword [low%]
      fcompp                    \Is low% < com% ?
      fstsw ax
      and ah,1
      cmp ah,0
      jnz ignore                \If yes leave as is
      fld qword [low%]
      fstp qword [com%]         \Calculates com%
      
      .ignore fld qword [i%]    \Calculates arg%
      fld qword [Kr%]
      fmulp st1,st0
      fld qword [r%]
      fld qword [Ki%]
      fmulp st1,st0
      fsubp st1,st0
      fld qword [com%]
      fdivp st1,st0
      fst qword [arg%]
      fabs
      fld qword [max%]
      fcompp                    \Is max%<arg% ?
      fstsw ax
      and ah,1
      cmp ah,0
      jz goon
      fld qword [arg%]          \If C0=1, do this
      ftst                      \Is arg%<0 ?
      fstsw ax
      fstp qword [res%]
      fld qword [max%]
      and ah,1
      cmp ah,0
      jz ps                     \If C0=1 do this
      fchs                      \Negate max%
      fstp qword [arg%]
      jmp goon
      .ps fstp qword [arg%]     \Calculates arg%
      
      .goon fld qword [r%]      \Calculates rnex%
      fld qword [Kr%]
      fmulp st1,st0
      fld qword [i%]
      fld qword [Ki%]
      fmulp st1,st0
      faddp st1,st0
      fld qword [com%]
      fdivp st1,st0
      fst qword [xpr%]
      fcos
      fstp qword [Cos%]
      
      fld qword [arg%]            \Eventually calculates e^arg%
      fldl2e
      fmulp st1,st0
      ftst
      fstsw ax
      and ah,1
      mov [Nfl%],ah               \Is it a negative exponent?
      cmp ah,1
      jne notneg
      fchs
      .notneg fist dword [Pwr%]   \Separate integer part
      fild dword [Pwr%]           \Load the integer part back as FP
      fsubp st1,st0               \Separate the fractional element,f
      fstp qword [f%]             \Calculate and save f%*lg(e). Base-2 log.
      
      mov al,0                   \Calculate 2.0^Pwr%
      mov [lp%],al               \Initialise loop control to zero
      mov bl,[Pwr%]              \Pwr% is the loop limit
      mov [lplm%],bl
      cmp bl,0
      jz small                    \If Pwr% = 0 then 2.0^0=1.0 Jump forward
      fld qword [two%]            \If Pwr%>0 then at least 2.0^1=2.0 is needed
      
      .loop inc al
      mov [lp%],al
      cmp al,[lplm%]
      je pwrdone
      fld qword [two%]
      fmulp st1,st0               \Repeat multiplying ST0 by 2.0
      jmp loop                    \Leave result top of stack each time
      .small fld1                 \This is 2.0^0=1.0
      .pwrdone fst qword [Main%]  \Correct power of 2 is on top of stack
      
      fld qword [f%]
      f2xm1
      fld1
      faddp st1,st0             \Calculates e^f%
      fmulp st1,st0             \Calculates 2.0^Pwr% x e^f% = e^arg%
      mov al,[Nfl%]
      cmp al,1
      jne posit
      fld1
      fdivrp st1,st0            \If exponent was negative, calculate reciprocal
      .posit fst qword [exarg%]  \e^arg% is now On Top Of the stack
      fld st0
      fld1
      fdivrp st1,st0
      faddp st1,st0
      fld qword [two%]
      fdivp st1,st0             \Cosh(arg%) is on top of stack
      
      fld qword [Cos%]
      fmulp st1,st0
      fstp qword [rnex%]        \Calculates rnex%
      
      fld qword [xpr%]          \Calculates inex%
      fsin
      fst qword [Sin%]
      fld qword [exarg%]
      fld st0
      fld1
      fdivrp st1,st0
      fsubp st1,st0
      fld qword [two%]
      fdivp st1,st0             \Calculates Sinh(arg%)
      fmulp st1,st0
      fchs
      fstp qword [inex%]        \Calculates inex%
      
      fld qword [rnex%]       \Updates r%
      fstp qword [r%]
      fld qword [inex%]       \Updates i%
      fstp qword [i%]
      
      fld qword [r%]          \Calculates zmod%
      fld st0
      fmulp st1,st0
      fld qword [i%]
      fld st0
      fmulp st1,st0
      faddp st1,st0
      fsqrt
      fstp qword [zmod%]      \Calculates zmod%
      
      fld qword [cm%]         \Does zmod% exceed the limit, cm% ?
      fld qword [zmod%]
      fsubp st1,st0
      ftst
      fstsw ax
      fstp qword [res%]
      and ah,1
      
      mov bx,[stp%]           \Update loop exit criteria
      cmp bx,[lmt%]
      sete [xt%]
      add [xt%],ah
      
      mov al,[xt%]
      cmp al,0
      jz near rep
      
      fstcw [CR%]               \Reset rounding control to Default
      mov ax,[CR%]
      and ax,&F3FF              \Clears bits 10-11 in FP Cntrl Register
      mov [CR%],ax
      fldcw [CR%]               \Reset rounding control to Default
      
      ret
      ]
      endproc