rem The Mandelbrot Set (Assembly Version) ...... Rev 10.0
      rem A J Tooth / 1st February 2003 Revised 14th December 2004
      rem Simplified January 2008 to use a DIBSection bitmap
      
      rem ====================================================================
      on error if (err=17) then quit
      *FLOAT64
      himem=lomem + 2000000
      install @lib$+"MyUtils.bbc"
      install @lib$+"BMP_Utils.bbc"
      rem ====================================================================
      
      rem Setup
      proc_setup
      
      rem Initial Mandelbrot set
      proc_mandinit : cls
      
      rem Repeats from here after PROC_zoom
      repeat
        rem Decide on options
        cls : proc_decision : cls
        
        *REFRESH OFF
        rem MAIN: Iteration Section
        sys "GetCurrentProcess" to hprocess%
        sys "SetPriorityClass", hprocess%, &80
        
        rem Main Procedure for Mandelbrot calculations
        call mandmain%
        
        sys "GetCurrentProcess" to hprocess%
        sys "SetPriorityClass", hprocess%, &20
        *REFRESH ON
        
        rem Primary Exit & Repeat Options
        proc_event(sp$,b&)
        if (sp$="m" or b&=4) then proc_zoom else run
      until false
      quit
      rem End of Programme --------------------------------------------------------------
      rem ===============================================================================
      
      rem Setup
      def proc_setup
      
      rem Go to full screen
      proc_fullscreen(xscreen%,yscreen%)
      
      rem Create a DIBSection
      proc_DIBCreate(xscreen%,yscreen%,bmp%,DIBlim%)
      
      dim rc{l%, t%, r%, b%}
      rc.t%=yscreen%
      rc.b%=0
      
      hscreen%=yscreen%/2
      
      dim Col%(9,5)
      
      dim zcalc% 1000, drw% 500
      dim colls% 1000, itmp% 3, ftmp% 7
      dim mandin% 500, mandmain% 500
      
      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_mandin(pass&)
        proc_mandmain(pass&)
      next pass&
      
      rem Parameter Setup
      proc_params
      
      rem Sets up eight levels of random colour
      proc_tencols
      
      rem Wait for a key-press or mouse click
      proc_event(a$,b&)
      if b&=1 then quit else cls
      
      rem Preset parameters
      lmt%=640 : rl=-1.0 : ru=2.0 : il=-1.3 : iu=1.3 : cm=1000000.0
      hi%=16 : lo&=4
      endproc
      rem ===============================================================================
      
      rem Parameter Entry
      def proc_params
      
      rem Title page background
      proc_BackPic("MBack.jpg",xscreen%,yscreen%)
      
      rem Parameter Setup
      proc_AJTicon(50,fn_adapt(1,600))
      
      msg$="\14Pressing -\11Enter\14- twice will use default settings: \9The Standard Mandelbrot Set"
      proc_msg("Verdana",12,"B",100,fn_adapt(1,1500),msg$)
      
      msg$="\10Enter an x-factor (\110.0 default\10) "
      proc_msg("Verdana",12,"B",100,fn_adapt(1,1400),msg$)
      vdu 5
      gcol 9: input fx
      vdu 4
      fx+=1.0
      
      msg$="\10Enter a y-factor (\110.0 default\10) "
      proc_msg("Verdana",12,"B",100,fn_adapt(1,1300),msg$)
      vdu 5
      gcol 1: input fy
      vdu 4
      fy+=1.0
      
      msg$="\9Press -\10m\9- for the Mandelbrot set"
      proc_msg("Castellar",24,"",100,fn_adapt(1,1200),msg$)
      
      endproc
      rem ===========================================================================
      
      rem Decide on options
      def proc_decision
      
      msg$="\10Press -\11q\10- for \11quick \10and -\11s\10- for \11slow \10output "
      proc_msg("Verdana",12,"B",50,fn_adapt(1,1400),msg$)
      
      spd$=get$
      if spd$<>"q" then spd$="s"
      if spd$="s" then
        repeat
          msg$="\10Press -\11u\10- for \1164 \10gradations of colour, -\11h\10- for \1132 \10gradations or -\11l\10- for \1116 \10and -\11v\10 for just 8"
          proc_msg("Verdana",12,"B",50,fn_adapt(1,1300),msg$)
          hilo$=get$
        until (hilo$="u" or hilo$="h" or hilo$="l" or hilo$="v")
        case hilo$ of
          when "v": hi%=8  : lo&=5
          when "l": hi%=16 : lo&=4
          when "h": hi%=32 : lo&=3
          when "u": hi%=64 : lo&=2
        endcase
      endif
      if spd$="q" then st%=2 else st%=1
      wd%=st%*20
      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 Mouse debounce
      repeat
        mouse x%,y%,b&
        sys "Sleep",5
      until b&=0
      
      rem Select first corner of rectangular zoom area
      repeat
        mouse x%,y%,b&
        sys "Sleep",5
        ax%=x% : ay%=y%
      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 x%,y%,b&
        sys "Sleep",5
        bx%=x% : bi%=y%
      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
      local x,y,p%,q%
      
      *REFRESH OFF
      sys "GetCurrentProcess" to hprocess%
      sys "SetPriorityClass", hprocess%, &80
      
      rem Calculate Mandelbrot Set
      call mandin%
      
      sys "GetCurrentProcess" to hprocess%
      sys "SetPriorityClass", hprocess%, &20
      * REFRESH ON
      
      rem Instructions
      msg$="\9* \10Press -\11m\10- or \11left-click \10to get the mouse cursor to reappear, or \11right-click \10to start again."
      proc_msg("Verdana",12,"B",50,fn_adapt(1,1530),msg$)
      
      msg$="\9* \10Click the \11LEFT \10mouse button to get the first corner of the area you want to zoom into."
      proc_msg("Verdana",12,"B",50,fn_adapt(1,1500),msg$)
      
      msg$="\9* \10Then click the \11RIGHT \10mouse button to select the opposite corner."
      proc_msg("Verdana",12,"B",50,fn_adapt(1,1470),msg$)
      
      msg$="\9* \10Use the same procedure for subsequent screens."
      proc_msg("Verdana",12,"B",50,fn_adapt(1,1440),msg$)
      
      msg$="\9* \10Press -\11Esc\10- at any time to \9QUIT"
      proc_msg("Verdana",12,"B",50,fn_adapt(1,1300),msg$)
      
      msg$="\10The MANDELBROT Set"
      proc_msg("Blackadder ITC",24,"B",fn_adapt(0,550),fn_adapt(1,800),msg$)
      
      proc_AJTicon(50,fn_adapt(1,700))
      proc_event(a$,b&)
      if b&=1 then quit else proc_zoom
      endproc
      rem ===============================================================================
      
      rem Sets up eight levels of random colours
      def proc_tencols
      local s&
      
      for s&=0 to 9
        cs&=rnd(3)
        rem Singles out one of the primary colours as prevalent
        Rinit&=-63*(cs&<>1)+rnd(192)
        Ginit&=-63*(cs&<>2)+rnd(192)
        Binit&=-63*(cs&<>3)+rnd(192)
        Col%(s&,0)=Rinit& : Col%(s&,1)=Ginit& : Col%(s&,2)=Binit&
        rem Ensures these colours are darker than those above
        Col%(s&,3)=int(Ginit&/3)
        Col%(s&,4)=int(Binit&/3)
        Col%(s&,5)=int(Rinit&/3)
      next s&
      endproc
      rem ===============================================================================
      
      rem Assembly Language Routine 5
      rem for main Mandelbrot picture
      def proc_mandmain(Opt&)
      
      P%=mandmain%
      [opt Opt&
      
      mov cl,0
      
      mov edx,0
      mov [^c%],edx
      
      .cloop
      mov edx,0
      mov [^d%],edx
      
      .dloop
      mov eax,[^c%]
      imul eax,[^DIBlim%]
      add eax,[^d%]
      add eax,[^d%]
      add eax,[^d%]
      
      mov bmp%[eax],cl
      mov bmp%[eax+1],cl
      mov bmp%[eax+2],cl
      
      inc dword [^d%]
      mov edx,[^d%]
      cmp edx,[^xscreen%]
      jl near dloop
      
      inc dword [^c%]
      mov edx,[^c%]
      cmp edx,[^yscreen%]
      jl near cloop
      
      mov edx,0
      mov [^cnt%],edx
      
      mov edx,0
      mov [^a%],edx
      
      .aloop
      mov edx,0
      mov [^b%],edx
      
      .bloop
      mov dl,0
      mov [^xt&],dl
      mov edx,1
      mov [^stp%],edx
      
      call zcalc%
      call colls%
      call drw%
      
      mov edx,[^b%]
      mov ebx,[^st%]
      add edx,ebx
      mov [^b%],edx
      cmp edx,[^yscreen%]
      jl near bloop
      
      mov al,0                 ;REFRESH routine
      mov [^Flg&],al
      inc dword [^cnt%]
      mov edx,[^cnt%]
      cmp edx,20
      jne nt5
      
      mov al,1
      mov [^Flg&],al
      .nt5
      mov edx,[^a%]
      mov ecx,[^xscreen%]
      dec ecx
      cmp edx,ecx
      jne ntx
      mov al,1
      mov [^Flg&],al
      .ntx
      mov al,[^Flg&]
      cmp al,1
      jne nt1
      
      mov eax,[^a%]
      mov [^rc.r%],eax
      sub eax,[^wd%]
      mov [^rc.l%],eax
      
      push 0
      push rc{}
      push @hwnd%
      call "InvalidateRect"
      
      mov edx,command2%
      call "oscli"
      
      mov edx,0
      mov [^cnt%],edx          ;REFRESH routine
      
      .nt1
      mov edx,[^a%]
      mov ebx,[^st%]
      add edx,ebx
      mov [^a%],edx
      cmp edx,[^xscreen%]
      jl near aloop
      
      jmp mend
      .command2% DB " REFRESH"
      DB &0D
      .mend
      ret
      ]
      endproc
      rem ===============================================================================
      
      rem Assembly Language Routine 4
      rem for initial Mandelbrot picture
      def proc_mandin(Opt&)
      
      P%=mandin%
      [opt Opt&
      
      mov edx,0
      mov [^cnt%],edx
      
      mov edx,0
      mov [^p%],edx
      
      .ploop
      mov edx,0
      mov [^q%],edx
      mov eax,[^p%]
      mov [^a%],eax
      
      .qloop
      mov eax,[^q%]
      mov [^b%],eax
      
      mov edx,1
      mov [^stp%],edx
      mov dl,0
      mov [^xt&],dl
      
      call zcalc%
      call colls%
      
      call drw%
      mov eax,[^yscreen%]
      dec eax
      sub eax,[^q%]
      mov [^b%],eax
      call drw%
      
      inc dword [^q%]
      mov edx,[^q%]
      mov ecx,[^hscreen%]
      cmp edx,ecx
      jl near qloop
      
      mov al,0                 ;REFRESH routine
      mov [^Flg&],al
      inc dword [^cnt%]
      mov edx,[^cnt%]
      cmp edx,20
      jne nt55
      
      mov al,1
      mov [^Flg&],al
      .nt55
      mov edx,[^a%]
      mov ecx,[^xscreen%]
      dec ecx
      cmp edx,ecx
      jne ntxx
      mov al,1
      mov [^Flg&],al
      .ntxx
      mov al,[^Flg&]
      cmp al,1
      jne nt11
      
      mov eax,[^a%]
      mov [^rc.r%],eax
      sub eax,20
      mov [^rc.l%],eax
      
      push 0
      push rc{}
      push @hwnd%
      call "InvalidateRect"
      
      mov edx,command%
      call "oscli"
      
      mov edx,0
      mov [^cnt%],edx
      .nt11                     ;REFRESH routine
      
      inc dword [^p%]
      mov edx,[^p%]
      cmp edx,[^xscreen%]
      jl near ploop
      
      jmp fend
      .command%
      DB " REFRESH"
      DB &0D
      .fend
      ret
      ]
      endproc
      rem sys "InvalidateRect", @hwnd%, 0, 0 : *REFRESH
      rem ===============================================================================
      
      rem Assembly Language Routine 3
      rem for Colour choice
      def proc_colls(Opt&)
      
      P%=colls%
      [opt Opt&
      
      mov edx,0
      mov eax,[^stp%]
      mov ebx,[^hi%]
      idiv ebx
      mov [^lev2%],eax
      mov cl,[^lo&]
      shl edx,cl
      mov [^nten%],edx
      mov eax,[^lev2%]
      shr eax,1
      cmp eax,16
      jbe nt16
      sub eax,8
      .nt16
      cmp eax,8
      jbe nt8
      sub eax,8
      .nt8
      mov [^lev%],eax
      
      finit
      fild dword [^nten%]
      fild dword [i256%]
      fdivp st1,st0
      fst qword [^fct]
      fld1
      fsubrp st1,st0
      fstp qword [^afct]
      
      mov eax,[^lev2%]
      shr eax,1
      setc bl
      cmp bl,1
      je near other
      
      mov eax,[^lev%]                    ;Red&
      imul eax,24
      fild dword ^Col%(0,0)[eax]
      fld qword [^afct]
      fmulp st1,st0
      
      mov eax,[^lev%]
      imul eax,24
      add eax,12
      fild dword ^Col%(0,0)[eax]
      fld qword [^fct]
      fmulp st1,st0
      faddp st1,st0
      fistp dword [itmp%]
      mov ecx,[itmp%]
      mov [^Re&],cl                      ;Red&
      
      mov eax,[^lev%]                    ;Green&
      imul eax,24
      add eax,4
      fild dword ^Col%(0,0)[eax]
      fld qword [^afct]
      fmulp st1,st0
      
      mov eax,[^lev%]
      imul eax,24
      add eax,16
      fild dword ^Col%(0,0)[eax]
      fld qword [^fct]
      fmulp st1,st0
      faddp st1,st0
      fistp dword [itmp%]
      mov ecx,[itmp%]
      mov [^Gr&],cl                      ;Green&
      
      mov eax,[^lev%]                    ;Blue&
      imul eax,24
      add eax,8
      fild dword ^Col%(0,0)[eax]
      fld qword [^afct]
      fmulp st1,st0
      
      mov eax,[^lev%]
      imul eax,24
      add eax,20
      fild dword ^Col%(0,0)[eax]
      fld qword [^fct]
      fmulp st1,st0
      faddp st1,st0
      fistp dword [itmp%]
      mov ecx,[itmp%]
      mov [^Bl&],cl                      ;Blue&
      jmp round
      
      .other
      mov eax,[^lev%]                    ;Red&
      imul eax,24
      add eax,12
      fild dword ^Col%(0,0)[eax]
      fld qword [^afct]
      fmulp st1,st0
      
      mov eax,[^lev%]
      inc eax
      imul eax,24
      fild dword ^Col%(0,0)[eax]
      fld qword [^fct]
      fmulp st1,st0
      faddp st1,st0
      fistp dword [itmp%]
      mov ecx,[itmp%]
      mov [^Re&],cl                      ;Red&
      
      mov eax,[^lev%]                    ;Green&
      imul eax,24
      add eax,16
      fild dword ^Col%(0,0)[eax]
      fld qword [^afct]
      fmulp st1,st0
      
      mov eax,[^lev%]
      inc eax
      imul eax,24
      add eax,4
      fild dword ^Col%(0,0)[eax]
      fld qword [^fct]
      fmulp st1,st0
      faddp st1,st0
      fistp dword [itmp%]
      mov ecx,[itmp%]
      mov [^Gr&],cl                      ;Green&
      
      mov eax,[^lev%]                    ;Blue&
      imul eax,24
      add eax,20
      fild dword ^Col%(0,0)[eax]
      fld qword [^afct]
      fmulp st1,st0
      
      mov eax,[^lev%]
      inc eax
      imul eax,24
      add eax,8
      fild dword ^Col%(0,0)[eax]
      fld qword [^fct]
      fmulp st1,st0
      faddp st1,st0
      fistp dword [itmp%]
      mov ecx,[itmp%]
      mov [^Bl&],cl                      ;Blue&
      
      .round
      jmp tend
      .i256% DD 256
      .tend
      ret
      ]
      endproc
      rem ===============================================================================
      
      rem Assembly Language Routine 1
      rem for Julman / Zmod Calculation
      def proc_zcalc(opt%)
      
      P%=zcalc%
      [opt opt%
      
      finit
      
      fild dword [^a%]          ;Calc f0r x%
      fild dword [^xscreen%]
      fld1
      fsubp st1,st0
      fdivp st1,st0
      fld qword [^ru]
      fld qword [^rl]
      fsubp st1,st0
      fmulp st1,st0
      fld qword [^rl]
      faddp st1,st0
      fstp qword [^x]           ;Calc f0r x%
      
      fild dword [^b%]          ;Calc f0r y%
      fild dword [^yscreen%]
      fld1
      fsubp st1,st0
      fdivp st1,st0
      fld qword [^iu]
      fld qword [^il]
      fsubp st1,st0
      fmulp st1,st0
      fld qword [^il]
      faddp st1,st0
      fstp qword [^y]          ;Calc f0r y%
      
      fld qword [^x]           ;Calc f0r r%
      fmul st0,st0
      fld qword [^y]
      fmul st0,st0
      fsubp st1,st0
      fld qword [^x]
      fld qword [^fx]
      fmulp st1,st0
      fsubp st1,st0
      fstp qword [^r]         ;Calc f0r r%
      
      fld qword [^x]          ;Calc f0r i%
      fld qword [^y]
      fmulp st1,st0
      fadd st0,st0
      fld qword [^y]
      fld qword [^fy]
      fmulp st1,st0
      fsubp st1,st0
      fstp qword [^i]         ;Calc f0r i%
      
      .rep
      inc dword [^stp%]
      
      fld qword [^r]          ;Calculates rnex%
      fmul st0,st0
      fld qword [^i]
      fmul st0,st0
      fsubp st1,st0           ;st1-st0 > st1. pop st0
      fld qword [^x]
      fsubp st1,st0
      fstp qword [^rnex]      ;Calculates rnex%
      
      fld qword [^r]          ;Calculates inex%
      fadd st0,st0
      fld qword [^i]
      fmulp st1,st0
      fld qword [^y]
      fsubp st1,st0
      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%
      fmul st0,st0
      fld qword [^i]
      fmul st0,st0
      faddp st1,st0
      fsqrt                   ;Calculates zmod%
      
      fld qword [^cm]
      fsubrp st1,st0
      ftst
      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 eax,[^b%]
      imul eax,[^DIBlim%]
      add eax,[^a%]
      add eax,[^a%]
      add eax,[^a%]
      
      mov cl,[^Bl&]
      mov bmp%[eax],cl
      mov cl,[^Gr&]
      mov bmp%[eax+1],cl
      mov cl,[^Re&]
      mov bmp%[eax+2],cl
      
      ret
      ]
      endproc
      rem ===============================================================================