rem Julia Sets (Assembly Version) ...... Rev 13.1
      rem A J Tooth / 1st February 2003
      rem Heavily revised Janury 2018

      rem ===================================================================
      on error if (err=17) then quit
      himem=lomem + 150000000
      install @lib$+"MyUtils.bbc"
      install @lib$+"BMPUtils.bbc"
      rem ===================================================================

      rem Setup
      proc_setup

      rem Display initial Mandelbrot Set
      proc_mandinit
      cls

      rem MAIN: Iteration Section
      proc_MAIN(sp$)

      if sp$=" " then run
      quit
      rem End of Programme ----------------------------------------------------------------------------------
      rem ===================================================================================================

      rem Setup
      def proc_setup

      rem Set up use of Full Screen
      proc_fullscreen(xscreen%,yscreen%)
      xs2% = xscreen%/4 : ys2% = yscreen%/4

      dim Col%(9,6)

      rem Set up a bitmap according to parameters provided
      proc_BMP_Set(xscreen%, yscreen%, pic%, Wlim%, lgth%)

      rem Set up a bitmap according to parameters provided
      proc_BMP_Set(xs2%, ys2%, picpre%, Plim%, pgth%)

      *FONT Arial,12,B

      dim colls% 500, zcalc% 1500, drw% 300, clrs% 700, Master% 500, preview% 1500

      i256% = 256

      rem Dual-pass assembly, in case of labels
      for pass& = 0 to 2 step 2
        proc_preview(pass&)
        proc_zcalc(pass&)
        proc_drw(pass&)
        proc_colls(pass&)
        proc_clrs(pass&)
        proc_Master(pass&)
      next pass&

      a$ = inkey$(10)
      colour 132,0,0,50 : colour 132 : cls

      rem Preset parameters
      lmt% = 256 : ma% = 8 : mb% = 32 : rl = -2.0 : ru = 2.0 : il =- 1.3 : iu = 1.3 : cm = 100.0

      rem Parameter Setup
      vdu 5
      gcol 3: move 150,1400 : print;"Choose a parameter to control the type of MANDELBROT set."

      move 150,1350 : print;"The chosen parameter controls the equation for generating the Mandelbrot/Julia set."
      move 150,1300 : print;"The normal Mandelbrot iterative equation is: ";

      gcol 1 : print;"Znew = Z^2 + C ";
      move 150,1200 : gcol 3 : print;"It has been generalised to: ";
      gcol 1 : print;"Znew = Z^p + C";
      gcol 3 : print;", where p is any number greater than 1."

      move 150, 1000 : gcol 9 : print;"Press -Esc- at any time to exit the application."

      move 150,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(10,25);"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 MAIN: Iteration Section
      def proc_MAIN(return sp$)
      local cnt&

      lmt% = 256 : ind& = 1

      repeat
        cnt& = 0
  
        rem Set colour levels
        proc_levels(ind&)
  
        for a% = 0 to xscreen% - 1
    
          rem Call master ASM routine
          call Master%
    
          cnt& += 1
          if (cnt& = 10 or a% = xscreen% - 1) then
            cnt& = 0
            rem Display BMP
            proc_BMP_Disp(xscreen%, yscreen%, pic%, 0, 0)
          endif
        next a%
  
        rem Repeat & zoom
        sp$ = "" : sp& = 0
        repeat
          sp$ = get$ : sp& = asc(sp$)
        until (sp$ = "m" or sp$ = " " or sp& = 9)
  
        rem Enable zooming in
        if sp$ = "m" then proc_zoom
  
        if sp& = 9 then
          ind& += 1 : if ind& = 6 then ind& = 1
        endif
  
      until (sp$ <> "m" and sp& <> 9)

      endproc
      rem ===================================================================================================

      rem Set colour levels
      def proc_levels(ind&)

      case ind& of
        when 1 : ma% = 4  : mb% = 64
        when 2 : ma% = 8  : mb% = 32
        when 3 : ma% = 16 : mb% = 16
        when 4 : ma% = 32 : mb% = 8
        when 5 : ma% = 64 : mb% = 4
      endcase

      endproc
      rem ===================================================================================================

      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
  
      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
      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
          proc_BMP_Disp(xscreen%, yscreen%, pic%, 0, 0)
    
          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%
        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%
      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 Draws initial Mandelbrot Set to select Julia parameters from
      def proc_mandinit

      rem Set priority here
      lmt% = 64 : ma% = 32 : mb% = 8
      for p% = 0 to xscreen% - 1 step 2
        for q% = 0 to yscreen% - 1 step 2
          a% = p% : b% = q%
    
          rem Set initial values
          x = rl + (a%/(xscreen% - 1))*(ru - rl)
          y = il + (b%/(yscreen% - 1))*(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
          call clrs%
    
          rem Plots a SINGLE PIXEL
          call drw%
    
        next q%
  
        if p% mod 10 = 0 or p% = xscreen% - 1 then
          rem Display BMP
          proc_BMP_Disp(xscreen%, yscreen%, pic%, 0, 0)
        endif
      next p%

      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."
      realold% = -1 : imagold% = -1
      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;"      ";
  
        if real% <> realold% or imag% <> imagold% then
          rem Julia set preview
          lmt% = 64 : call preview%
    
          rem Display BMP
          proc_BMP_Disp(xs2%, ys2%, picpre%, 0, 0)
          *REFRESH
        endif
        realold% = real% : imagold% = imag%
      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 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 Master ASM
      def proc_Master(opt&)

      P% = Master%
      [opt opt&

      mov edx,0
      mov [^b%],edx
      .bloopb

      finit
      fild dword [^a%]
      fild dword [^xscreen%]
      fld1
      fsubp st1,st0
      fdivp st1,st0
      fld tbyte [^ru]
      fld tbyte [^rl]
      fsubp st1,st0
      fmulp st1,st0
      fld tbyte [^rl]
      faddp st1,st0
      fstp tbyte [^xx]

      fild dword [^b%]
      fild dword [^yscreen%]
      fld1
      fsubp st1,st0
      fdivp st1,st0
      fld tbyte [^iu]
      fld tbyte [^il]
      fsubp st1,st0
      fmulp st1,st0
      fld tbyte [^il]
      faddp st1,st0
      fstp tbyte [^yy]

      fld tbyte [^xx]
      fmul st0,st0
      fld tbyte [^yy]
      fmul st0,st0
      fsubp st1,st0
      fld tbyte [^cr]
      fsubp st1,st0
      fstp tbyte [^r]

      fld tbyte [^xx]
      fld tbyte [^yy]
      fmulp st1,st0
      fadd st0,st0
      fld tbyte [^ci]
      fsubp st1,st0
      fstp tbyte [^i]

      fld tbyte [^r]
      fmul st0,st0
      fld tbyte [^i]
      fmul st0,st0
      faddp st1,st0
      fsqrt
      fstp tbyte [^zmod]

      call zcalc%

      call clrs%

      call drw%

      inc dword [^b%]
      mov edx,[^b%]
      cmp edx,[^yscreen%]
      jl near bloopb

      ret
      ]

      endproc
      rem ===================================================================================================

      rem Coded into ASM above
      def proc_MasterDUMP

      for b% = 0 to yscreen% - 1
  
        rem Set initial values
        proc_init
  
        rem Main Procedure for Julia/Mandelbrot calculations
        call zcalc%
  
        rem Go and get the colours
        call clrs%
  
        rem Plots a SINGLE PIXEL
        call drw%
  
      next b%

      endproc
      rem ===================================================================================================

      rem Set initial values
      def proc_initDUMP
      local x,y

      x = rl + (a%/(xscreen% - 1))*(ru - rl)
      y = il + (b%/(yscreen%- 1))*(iu - il)
      r = x*x - y*y - cr : i = 2*x*y - ci
      zmod = sqr(r*r + i*i)

      endproc
      rem ===================================================================================================

      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 tbyte [^r]
      fmul st0,st0
      fld tbyte [^i]
      fmul st0,st0
      faddp st1,st0
      fsqrt
      fld1
      fxch st1
      fyl2x
      fld tbyte [^ni]
      fmulp st1,st0
      fstp tbyte [^nlg2z]

      fld1
      fld1
      fld1
      faddp st1,st0
      fyl2x
      fld tbyte [^nlg2z]
      fmulp st1,st0
      fld st0
      frndint
      fsub st1,st0
      fxch st1
      f2xm1
      fld1
      faddp st1,st0
      fscale
      fstp st1
      fstp tbyte [^z2n]

      fld tbyte [^z2n]
      fld tbyte [^i]
      fld tbyte [^r]
      fpatan
      fld tbyte [^ni]
      fmulp st1,st0
      fsincos
      fmul st0,st2
      fstp tbyte [^r]
      fmulp st1,st0
      fld tbyte [^ci]
      fsubp st1,st0
      fstp tbyte [^i]

      fld tbyte [^r]
      fld tbyte [^cr]
      fsubp st1,st0
      fstp tbyte [^r]
      fld tbyte [^r]

      fmul st0,st0
      fld tbyte [^i]
      fmul st0,st0
      faddp st1,st0
      fsqrt
      fstp tbyte [^zmod]

      fld tbyte [^cm]
      fld tbyte [^zmod]
      fsubp st1,st0
      ftst
      mov eax,0
      fstsw ax
      fstp tbyte [^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 Routine 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 eax,[^b%]
      imul eax,[^Wlim%]
      add eax,[^a%]
      add eax,[^a%]
      add eax,[^a%]
      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

      ret
      ]

      endproc
      rem ===================================================================================================

      rem ASM routine for Colour function
      def proc_colls(opt&)

      P% = colls%
      [opt opt&

      finit
      fld1
      fld tbyte [^Fct]
      fsubp st1,st0
      mov eax,[^lev%]
      imul eax,7
      add eax,[^fr%]
      shl eax,2
      fild dword (^Col%(0,0))[eax]
      fmulp st1,st0

      fld tbyte [^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 ASM routine for Colour function
      def proc_clrs(opt&)

      P% = clrs%
      [opt opt&

      mov eax,[^stp%]
      mov cl,[^mb%]
      div cl
      mov [^rmm&],ah
      mov [^dvv&],al
      mov eax,0
      mov al,[^rmm&]
      imul eax,[^ma%]
      mov [^nten%],eax
      mov eax,0
      mov al,[^dvv&]
      mov [^lev2%],eax
      shr eax,1
      mov [^lev%],eax

      finit
      fild dword [^nten%]
      fild dword [^i256%]
      fdivp st1,st0
      fstp tbyte [^Fct]

      mov eax,[^lev2%]
      mov cl,2
      div cl
      cmp ah,0
      jne near balt

      mov ecx,1
      mov [^fr%],ecx
      mov ecx,4
      mov [^se%],ecx
      mov ecx,0
      mov [^sp%],ecx

      call colls%

      mov ecx,[^op%]
      mov [^Re&],cl

      mov ecx,2
      mov [^fr%],ecx
      mov ecx,5
      mov [^se%],ecx
      mov ecx,0
      mov [^sp%],ecx

      call colls%

      mov ecx,[^op%]
      mov [^Gr&],cl

      mov ecx,3
      mov [^fr%],ecx
      mov ecx,6
      mov [^se%],ecx
      mov ecx,0
      mov [^sp%],ecx

      call colls%

      mov ecx,[^op%]
      mov [^Bl&],cl

      jmp rround

      .balt
      mov ecx,4
      mov [^fr%],ecx
      mov ecx,1
      mov [^se%],ecx
      mov ecx,1
      mov [^sp%],ecx

      call colls%

      mov ecx,[^op%]
      mov [^Re&],cl

      mov ecx,5
      mov [^fr%],ecx
      mov ecx,2
      mov [^se%],ecx
      mov ecx,1
      mov [^sp%],ecx

      call colls%

      mov ecx,[^op%]
      mov [^Gr&],cl

      mov ecx,6
      mov [^fr%],ecx
      mov ecx,3
      mov [^se%],ecx
      mov ecx,1
      mov [^sp%],ecx

      call colls%

      mov ecx,[^op%]
      mov [^Bl&],cl

      .rround
      ret
      ]

      endproc
      rem ===================================================================================================

      rem Calculates colour to use, depending on how fast function exceeds limit
      def proc_colsDUMP

      ma% = 16 : mb% = 16 : rem Done

      nten% = ma%*(stp% mod mb%) : lev2% = stp% div mb%) : rem Done
      lev% = lev2%/2       : rem Done
      Fct = 1.0*nten%/256  : rem Done

      if (lev2% mod 2) = 0 then : rem Done
      Re& = fn_cols(1,4,0) : rem Done
      Gr& = fn_cols(2,5,0) : rem Done
      Bl& = fn_cols(3,6,0) : rem Done
      else
      Re& = fn_cols(4,1,1) : rem Done
      Gr& = fn_cols(5,2,1) : rem Done
      Bl& = fn_cols(6,3,1) : rem Done
      endif

      endproc
      rem ===================================================================================================

      rem ASM routine Julia set preview
      def proc_preview(opt&)

      P% = preview%
      [opt opt&

      finit
      fld tbyte [^X]
      fstp tbyte [^cr]
      fld tbyte [^Y]
      fstp tbyte [^ci]

      mov edx,0
      mov [^g%],edx
      .loopg

      mov edx,0
      mov [^f%],edx
      .loopf

      fild dword [^f%]
      fild dword [^xs2%]
      fld1
      fsubp st1,st0
      fdivp st1,st0
      fld tbyte [^ru]
      fld tbyte [^rl]
      fsubp st1,st0
      fmulp st1,st0
      fld tbyte [^rl]
      faddp st1,st0
      fstp tbyte [^xx]

      fild dword [^g%]
      fild dword [^ys2%]
      fld1
      fsubp st1,st0
      fdivp st1,st0
      fld tbyte [^iu]
      fld tbyte [^il]
      fsubp st1,st0
      fmulp st1,st0
      fld tbyte [^il]
      faddp st1,st0
      fstp tbyte [^yy]

      fld tbyte [^xx]
      fmul st0,st0
      fld tbyte [^yy]
      fmul st0,st0
      fsubp st1,st0
      fld tbyte [^cr]
      fsubp st1,st0
      fstp tbyte [^r]

      fld tbyte [^xx]
      fld tbyte [^yy]
      fmulp st1,st0
      fadd st0,st0
      fld tbyte [^ci]
      fsubp st1,st0
      fstp tbyte [^i]

      fld tbyte [^r]
      fmul st0,st0
      fld tbyte [^i]
      fmul st0,st0
      faddp st1,st0
      fsqrt
      fstp tbyte [^zmod]

      call zcalc%

      mov eax,[^g%]
      imul eax,[^Plim%]
      add eax,[^f%]
      add eax,[^f%]
      add eax,[^f%]
      add eax,54

      mov ecx,[^stp%]
      shl ecx,2
      mov picpre%[eax+1],cl

      inc dword [^f%]
      mov edx,[^f%]
      cmp edx,[^xs2%]
      jl near loopf

      inc dword [^g%]
      mov edx,[^g%]
      cmp edx,[^ys2%]
      jl near loopg

      ret
      ]

      endproc
      rem ===================================================================================================

      rem Julia set preview
      def proc_PrevDUMP(X,Y)

      cr = 1.0*X : ci = 1.0*Y : rem Done

      for f% = 0 to xs2% - 1 : rem Done
      for g% = 0 to ys2% - 1 : rem Done
  
        x = rl + (f%/(xs2% - 1))*(ru - rl) : rem Done
        y = il + (g%/(ys2%- 1))*(iu - il)  : rem Done
        r = x*x - y*y - cr : i = 2*x*y - ci: rem Done
        zmod = sqr(r*r + i*i)              : rem Done
  
        rem Calculate Mandelbrot Set
        call zcalc%
  
        ref% = g%*Plim% + 3*f% + 54  : rem Done
        gry& = 16*stp%               : rem Done
  
        ?(picpre% + ref%) = gry&     : rem Done
        ?(picpre% + ref% + 1) = gry& : rem Done
        ?(picpre% + ref% + 2) = gry& : rem Done
  
      next g%
      print tab(5,15);f%
      next f%

      rem Display BMP
      proc_BMP_Disp(xs2%, ys2%, picpre%, 0, 0)

      endproc
      rem ===================================================================================================