rem Julia Sets (Assembly Version) ...... Rev 10.3
      rem A J Tooth / 1st February 2003 Revised 28th January 2005
      rem Main calculations now converted to Floating Point Assembler
      rem Converted to BMP graphics and generalised July 2006
      rem Improved adaption to screen resolution May 2007
      
      on error if (err=17) then quit
      himem=lomem + 10000000
      *FLOAT 64
      
      rem Setup
      proc_setup
      
      rem Set parameters by displaying initial Mandelbrot Set
      proc_param
      
      *REFRESH OFF
      rem MAIN: Iteration Section
      proc_MAIN(sp$)
      
      if sp$=" " then run
      quit
      end
      rem End of Programme ---------------------------------------------------------------
      rem ================================================================================
      
      rem Setup
      def proc_setup
      
      rem Set up use of Full Screen
      proc_fullscreen(xscreen%,yscreen%)
      
      xlim%=2*xscreen% : ylim%=2*yscreen%
      dim Col%(9,6)
      
      rem BMP Header
      proc_bmpheader(xscreen%,yscreen%,pic%,Wlim%,lgth%)
      
      *FONT Arial,12,B
      
      dim stp% 3, xt% 0, r% 7, i% 7, zmod% 7, rnex% 7, inex% 7, Kr% 7, Ki% 7
      dim lmt% 3, cm% 7, res% 7, ah% 0, a% 3, b% 3, colls% 500
      dim zcalc% 1000, drw% 300, Re% 0, Gr% 0, Bl% 0
      dim xpo% 500, itmp% 3, kk% 3, lam% 7
      
      rem Dual-pass assembly, in case of labels
      for pass&=0 to 2 step 2
        proc_zcalc(pass&)
        proc_drw(pass&)
        proc_colls(pass&)
        proc_xpo(pass&)
      next pass&
      
      a$=inkey$(10)
      colour 132,0,0,50 : colour 132 : cls
      rem Display my Icon in compiled version
      proc_AJTicon(10,7*yscreen%/8)
      
      rem Parameter Setup
      proc_back(50,fn_adapt(1,700),1900,fn_adapt(1,800),120,20,140)
      vdu 5
      gcol 3: move 150,fn_adapt(1,1400) : print;"Choose a parameter to control the type of MANDELBROT set."
      
      move 150,fn_adapt(1,1350) : print;"The chosen parameter controls the equation for generating the Mandelbrot/Julia set."
      move 150,fn_adapt(1,1300) : print;"The normal Mandelbrot iterative equation is: ";
      
      gcol 1 : print;"Znew = Z^2 + C ";
      move 150,fn_adapt(1,1200) : gcol 3 : print tab(5,8);"I have generalised this to: ";
      gcol 1 : print;"Znew = Z^p + C";
      gcol 3 : print;", where p is any number greater than 1."
      
      move 150,fn_adapt(1,1100) : gcol 2:print;"AFTER having chosen a point on the initial Mandelbrot image, use the following for MINOR parameter changes;"
      move 150,fn_adapt(1,1000) : gcol 9:print;"* ";:gcol 3:print;"Rotate mouse-wheel one click to change the input parameter by +/- 0.01"
      move 150,fn_adapt(1,950) : gcol 9:print;"* ";:gcol 3:print"Press left/right arrow keys to move horizontal co-ordinate of C by +/- 0.01"
      move 150,fn_adapt(1,900) : gcol 9:print;"* ";:gcol 3:print;"Press up/down arrow keys to move vertical co-ordinate of C by +/- 0.01"
      move 150,fn_adapt(1,800) : gcol 2:print;"Press - ";
      gcol 9:print;"m";
      gcol 2:print;" - to enable zooming-in. Left-click the mouse for the first corner. Right click for the opposite corner."
      
      vdu 4
      colour 3 : print tab(5,30);"Enter a positive number greater than 1:  ";
      colour 1 : input;ni
      ni*=1.0 : rem Ensure FP
      if ni<=1.0 then ni=2.0
      
      rem Sets up eight levels of random colour
      proc_tencols
      
      colour 3 : print tab(5,32);" Press -";
      colour 2 : print;"m";
      colour 3 : print;"- for the Mandelbrot set."
      
      repeat
        a$=get$
      until a$="m"
      
      endproc
      rem ================================================================================
      
      rem Adapt screen parameters
      def fn_adapt(XY&,Num%)
      local res%
      
      case XY& of
        when 0: res%=int(Num%*xscreen%/1024)
        when 1: res%=int(Num%*yscreen%/768)
      endcase
      
      =res%
      rem ================================================================================
      
      rem MAIN: Iteration Section
      def proc_MAIN(return sp$)
      
      repeat
        rem Speed options
        proc_spopt
        
        if spd$="q" then st&=4 else st&=2
        cnt&=0
        rem Set Priority Here
        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
            rem Main Procedure for Julia/Mandelbrot calculations
            call zcalc%
            rem Go and get the colours
            proc_cols
            rem Plots a SINGLE PIXEL
            call drw%
          next
          
          cnt&+=1
          if (cnt&=10 or !a%=xlim%) then
            cnt&=0
            a$=inkey$(0)
            rem Display BMP
            sys "SetStretchBltMode", @memhdc%, 3
            command$="MDISPLAY "+str$~pic%+" 0,0,"+str$(2*xscreen%)+","+str$(2*yscreen%)
            oscli command$
            
            *REFRESH
          else
            a$=""
          endif
          if a$<>"" then
            sys "GetCurrentProcess" to hprocess%
            sys "SetPriorityClass", hprocess%, &20
            run
          endif
        next
        sys "GetCurrentProcess" to hprocess%
        sys "SetPriorityClass", hprocess%, &20
        
        rem Repeat & zoom
        repeat
          sp$=get$
        until sp$<>"q" and sp$<>"s"
        
        if sp$="m" then proc_zoom
        
        case asc(sp$) of
          when 136: cr-=0.001
          when 137: cr+=0.001
          when 138: ci-=0.001
          when 139: ci+=0.001
          when 140: ni+=0.01
          when 141: ni-=0.01 : if ni<1.1 then ni=1.1
            
          otherwise
            rem Do nothing
        endcase
        
      until (sp$<>"m" and sp$<>"q" and sp$<>"s" and asc(sp$)<136)
      endproc
      rem ================================================================================
      
      rem Enter own parameters
      def proc_param
      
      rem Preset parameters
      !lmt%=320 : rl=-2.0 : ru=2.0 : il=-1.3 : iu=1.3 : |cm%=10000.0
      rem Initial Mandelbrot picture
      hs$="s" : hilo$="l"
      proc_mandinit
      cls
      rem Colour scheme options
      proc_colopt
      endproc
      rem ================================================================================
      
      rem Colour scheme options
      def proc_colopt
      
      print " Leave colours as random, or choose a range. Enter -d- or -r-. "
      repeat
        ch$=get$
      until (ch$="d" or ch$="r")
      c$=ch$
      if c$="r" then
        proc_colran
      else
        rem Random colours already set above
        print:print" Hard or Soft colour changes? Press -h- or -s-. "
        repeat
          hs$=get$
        until (hs$="" or hs$="h" or hs$="s")
        if hs$="" then hs$="s"
      endif
      endproc
      rem ================================================================================
      
      rem Speed options
      def proc_spopt
      
      *REFRESH ON
      cls
      print " Enter q for quick and s for slow output "
      repeat
        spd$=get$
      until (spd$="q" or spd$="s")
      
      print:print
      if spd$="s" then
        print " Press -h- for 32 gradations of colour or -l- for just 16. "
        repeat
          hilo$=get$
        until (hilo$="h" or hilo$="l")
      endif
      cls
      *REFRESH
      *REFRESH OFF
      
      endproc
      rem ================================================================================
      
      rem PROC 1
      rem Sets Colour Range
      def proc_colran
      
      input " 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" : ?Re%=63*in% : ?Gr%=0      : ?Bl%=0
        when "g" : ?Re%=0      : ?Gr%=63*in% : ?Bl%=0
        when "b" : ?Re%=0      : ?Gr%=0      : ?Bl%=63*in%
      endcase
      endproc
      rem ================================================================================
      
      rem PROC 2
      rem Set initial values
      def proc_init
      local x,y
      
      x=rl+(!a%/xlim%)*(ru-rl)
      y=il+(!b%/ylim%)*(iu-il)
      |r%=x*x-y*y-cr : |i%=2*x*y-ci
      |zmod%=sqr(|r%*|r%+|i%*|i%)
      endproc
      rem ================================================================================
      
      rem PROC 3
      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 PROC 4
      rem Enables user to zoom into a particular area
      def proc_zoom
      local x%,y%,b&,ax%,bx%,ay%,bi%,rnl,inl
      
      mouse on : gcol 7
      rem Select first corner of rectangular zoom area
      repeat
        mouse x%,y%,b&
        ax%=x% : ay%=y%
        sys "Sleep",10
        *REFRESH
      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
      *REFRESH
      
      rem Select opposite corner of zoom area
      xo%=ax% : yo%=ay%
      repeat
        mouse x%,y%,b&
        bx%=x% : bi%=y%
        sys "Sleep",10
        rem Draw a temporary box
        if bx%<>xo% or bi%<>yo% then
          rem Display BMP
          sys "SetStretchBltMode", @memhdc%, 3
          command$="MDISPLAY "+str$~pic%+" 0,0,"+str$(2*xscreen%)+","+str$(2*yscreen%)
          oscli command$
          
          move ax%-10,ay% : draw ax%+10,ay%
          move ax%,ay%-10 : draw ax%,ay%+10
          
          move ax%,ay% : draw bx%,ay% : draw bx%,bi%
          draw ax%,bi% : draw ax%,ay%
          xo%=bx% : yo%=bi%
          *REFRESH
        endif
      until b&=1
      
      rem Draw a box and wait 1 second before moving on
      move ax%,ay% : draw bx%,ay% : draw bx%,bi%
      draw ax%,bi% : draw ax%,ay%
      *REFRESH
      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%<bi% then
        ly%=ay% : uy%=bi%
      else
        ly%=bi% : uy%=ay%
      endif
      rem Re-assign viewing window limits
      rnl=rl+(ru-rl)*(lx%/(2*xscreen%))
      rnu=rl+(ru-rl)*(ux%/(2*xscreen%))
      
      inl=il+(iu-il)*(ly%/(2*yscreen%))
      inu=il+(iu-il)*(uy%/(2*yscreen%))
      rl=rnl : il=inl
      ru=rnu : iu=inu
      mouse off
      endproc
      rem ================================================================================
      
      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
            if hilo$="h" then
              ma%=8 : mb%=32
            else
              ma%=16 : mb%=16
            endif
            nten%=ma%*(!stp% mod mb%) : lev2%=!stp% div mb%
            lev%=int(lev2%/2)
            if lev%>16 then lev%=lev%-8
            if lev%>8 then lev%=lev%-8
            fct=nten%/256
            
            if (lev2% mod 2)=0 then
              ?Re%=fn_cols(fct,1,4,0)
              ?Gr%=fn_cols(fct,2,5,0)
              ?Bl%=fn_cols(fct,3,6,0)
            else
              ?Re%=fn_cols(fct,4,1,1)
              ?Gr%=fn_cols(fct,5,2,1)
              ?Bl%=fn_cols(fct,6,3,1)
            endif
          else
            ntn%=16*(!stp% mod 16) : lev%=!stp% div 16
            lev%=lev% mod 10
            fct=ntn%/256
            ?Re%=fn_cols(fct,4,1,0)
            ?Gr%=fn_cols(fct,5,2,0)
            ?Bl%=fn_cols(fct,6,3,0)
          endif
        when "r" : rem Uses custom colours
          rem Always only uses 16 colours in Quick mode (64 not easy to see!)
          ntn%=(255/gr&)*(!stp% mod gr&)
          lev%=!stp% div gr& : if lev%>8 then lev%=8
          rem Colours alternate between increasing and decreasing in intensity
          if (lev% mod 2>0) then ntn%=255-ntn%
          
          case rn$ of
            when "r" : ?Re%=ntn%
            when "g" : ?Gr%=ntn%
            when "b" : ?Bl%=ntn%
          endcase
          case ot$ of
            when "r" : ?Re%=32*lev%
            when "g" : ?Gr%=32*lev%
            when "b" : ?Bl%=32*lev%
            otherwise
              rem Do nothing
          endcase
      endcase
      endproc
      rem ================================================================================
      
      rem Common function for colour setting
      def fn_cols(Fct,fr%,se%,sp%)
      call colls%
      =op%
      rem ================================================================================
      
      rem PROC 7
      rem Draws initial Mandelbrot Set to select Julia parameters from
      def proc_mandinit
      local x,y,p%,q%
      
      rem Set priority here
      *REFRESH OFF
      sys "GetCurrentProcess" to hprocess%
      sys "SetPriorityClass", hprocess%, &100
      
      for p%=0 to xlim% step 4
        for q%=0 to ylim%/2 step 4
          !a%=p% : !b%=q%
          
          rem Set initial values
          x=rl+(p%/xlim%)*(ru-rl)
          y=il+(q%/ylim%)*(iu-il)
          |r%=x*x-y*y-x : |i%=2*x*y-y
          |zmod%=sqr(|r%*|r%+|i%*|i%)
          
          cr=1.0*x : ci=1.0*y
          rem Calculate Mandelbrot Set
          call zcalc%
          rem Go and get the colours
          proc_cols
          rem Plots a SINGLE PIXEL
          call drw%
          !b%=ylim%-q%
          call drw%
        next q%
        
        if p%mod5=0 or p%=xlim% then
          rem Display BMP
          sys "SetStretchBltMode", @memhdc%, 3
          command$="MDISPLAY "+str$~pic%+" 0,0,"+str$(2*xscreen%)+","+str$(2*yscreen%)
          oscli command$
          *REFRESH
        endif
      next p%
      rem Reset Priority Here
      sys "GetCurrentProcess" to hprocess%
      sys "SetPriorityClass", hprocess%, &20
      
      rem Display my Icon in compiled version
      proc_AJTicon(10,7*yscreen%/8)
      *REFRESH ON
      
      rem Enables selection of Julia parameter using the mouse.
      mouse on 3 : gcol 7
      
      print tab(5,2);"Click on the left mouse button at an interesting point."
      repeat
        mouse real%,imag%,m&
        X=rl+(real%/(2*xscreen%))*(ru-rl)
        Y=il+(imag%/(2*yscreen%))*(iu-il)
        print tab(5,5);"Present Point is; ";X;",";Y;"      ";
      until m&=4
      
      rem Set Julia parameters
      cr=1.0*X : ci=1.0*Y
      print tab(5,7);"Julia Parameters selected."
      
      b$=inkey$(100)
      mouse off
      endproc
      rem ================================================================================
      
      rem PROC 8
      rem Sets up eight levels of random colours
      def proc_tencols
      local s&
      
      for s&=0 to 9
        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%/3)
        Col%(s&,5)=int(Binit%/3)
        Col%(s&,6)=int(Rinit%/3)
      next s&
      endproc
      rem ================================================================================
      
      rem Assembly Language Routine 1
      rem for Julman / Zmod Calculation
      def proc_zcalc(opt&)
      P%=zcalc%
      [opt opt&
      
      mov al,0
      mov [xt%],al
      mov eax,1
      mov [stp%],eax
      
      .rep
      inc dword [stp%]
      
      finit
      fld qword [r%]
      fmul st0,st0
      fld qword [i%]
      fmul st0,st0
      faddp st1,st0
      fsqrt
      fld1
      fxch st1
      fyl2x
      fld qword [^ni]
      fmulp st1,st0
      fstp qword [^nlg2z]
      
      call xpo%
      
      fld qword [^z2n]
      fld qword [i%]
      fld qword [r%]
      fpatan
      fld qword [^ni]
      fmulp st1,st0
      fsincos
      fmul st0,st2
      fstp qword [r%]
      fmulp st1,st0
      fld qword [^ci]
      fsubp st1,st0
      fstp qword [i%]          ;Calc f0r i%
      
      fld qword [r%]
      fld qword [^cr]
      fsubp st1,st0
      fst qword [r%]           ;Calc f0r r%
      
      fmul st0,st0             ;Calculates zmod%
      fld qword [i%]
      fmul st0,st0
      faddp st1,st0
      fsqrt
      fstp qword [zmod%]       ;Calculates zmod%
      
      fld qword [cm%]
      fld qword [zmod%]
      fsubp st1,st0
      ftst
      mov eax,0
      fstsw ax
      fstp qword [res%]
      and ah,1
      
      mov ebx,[stp%]
      cmp ebx,[lmt%]
      sete [xt%]
      add [xt%],ah
      
      mov al,[xt%]
      cmp al,0
      jz near rep
      ret
      ]
      endproc
      rem ================================================================================
      
      rem Assembly Language Routine 2
      rem for Plotting
      def proc_drw(opt&)
      P%=drw%
      [opt opt&
      
      mov eax,[stp%]
      cmp eax,[lmt%]
      jne ok
      mov al,0
      mov [Re%],al
      mov [Gr%],al
      mov [Bl%],al
      
      .ok
      mov ebx,[a%]
      shr ebx,1
      cmp ebx,0
      jl miss
      cmp ebx,[^xscreen%]
      jge miss
      mov eax,[b%]
      shr eax,1
      cmp eax,0
      jl miss
      cmp eax,[^yscreen%]
      jge miss
      
      imul eax,[^Wlim%]
      add eax,ebx
      add eax,ebx
      add eax,ebx
      add eax,54
      
      mov cl,[Bl%]
      mov pic%[eax],cl
      mov cl,[Gr%]
      mov pic%[eax+1],cl
      mov cl,[Re%]
      mov pic%[eax+2],cl
      
      .miss
      ret
      ]
      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 ===============================================================
      
      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 50
        Rf&=Rr&*h&/50 : Gf&=100+Gg&*h&/50 : Bf&=Bb&*h&/50
        colour 15,Rf&,Gf&,Bf& : gcol 15
        rectangle fill Xs%+h&,Ys%+h&,Ws%-2*h&,Hs%-2*h&
      next h&
      endproc
      rem ========================================================================
      
      rem Standard BMPHeader setup
      def proc_bmpheader(Ww%,Hh%,return pc%,return Wlim%,return lgth%)
      
      Wlim%=((Ww%*3+3)and-4)
      
      lgth%=54 + Wlim%*Hh%
      
      dim pc% lgth%
      
      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 ASM routine for Colour function
      def proc_colls(opt&)
      P%=colls%
      [opt opt&
      
      finit
      fld qword [^Fct]
      fld1
      fsubrp st1,st0
      mov eax,[^lev%]
      imul eax,7
      add eax,[^fr%]
      shl eax,2
      fild dword (^Col%(0,0))[eax]
      fmulp st1,st0
      
      fld qword [^Fct]
      mov eax,[^lev%]
      add eax,[^sp%]
      imul eax,7
      add eax,[^se%]
      shl eax,2
      fild dword (^Col%(0,0))[eax]
      fmulp st1,st0
      
      faddp st1,st0
      fistp dword [^op%]
      
      ret
      ]
      endproc
      rem ================================================================================
      
      rem Assembly Language Routine for the Exponential function
      def proc_xpo(opt&)
      P%=xpo%
      
      [opt opt&
      
      finit
      fld qword [^nlg2z]
      
      fist dword [kk%]          ;Int(st0) which = k
      fild dword [kk%]
      fsubp st1,st0
      fstp qword [lam%]         ;st0 - Int(st0)
      
      mov ecx,[kk%]             ;Is k<0, k=0, k>0 ??
      cmp ecx,0
      jl blow
      je zero
      
      mov ebx,[kk%]             ;Limit k t0 +31
      cmp bl,31
      jae nocomp
      
      mov eax,2                ;When k>0
      dec cl
      shl eax,cl               ;2^k
      mov [itmp%],eax
      fild dword [itmp%]
      jmp over                 ;When k>0
      
      .blow                    ;When k<0
      neg ecx
      mov eax,2
      dec cl
      shl eax,cl
      mov [itmp%],eax
      fild dword [itmp%]
      fld1
      fdivrp st1,st0           ;2^(-|k|)
      jmp over                 ;When k<0
      
      .zero
      fld1                     ;When k=0
      
      .over
      fld qword [lam%]
      f2xm1                    ;2^st0 - 1
      fld1
      faddp st1,st0
      fmulp st1,st0
      jmp fin
      
      .nocomp
      fild dword [limt%]        ;Limits function t0 2^31
      
      .fin
      fstp qword [^z2n]
      
      jmp last
      .limt% DD 2147483647
      .last ret
      ]
      endproc
      rem ============================================================