rem Hue Changer ........ Rev 3.1
      rem A J Tooth // April 2008
      
      rem Preamble==================================
      on error if (err=17) then quit
      *FLOAT 64
      himem=lomem + 100000000
      install @lib$+"MyUtils.bbc"
      install @lib$+"BMP_Utils.bbc"
      rem Preamble==================================
      
      rem Setup
      proc_setup
      
      rem Choose a picture and display it
      proc_GetPic
      
      rem ASM Setup
      proc_ASMSetup
      
      rem Convert to HSI
      call Convert%
      
      rem Select a rectangular area
      proc_zoom(ye%,ys%,xe%,xs%,xL%,yL%,xH%,yH%)
      
      rem Change Hue
      proc_HueChange
      
      rem_Convert back to RGB
      proc_HSI_Invert
      
      rem Display altered picture
      proc_BMP_Disp(xe%,ye%,picmir%,xs%,ys%)
      
      proc_event(a$,b&) : rem Wait for a mouse-click or a key-press.
      
      case true of
        when a$="s": proc_SavePic
        when b&=4 or a$=" ": Z%=1 : run
        otherwise
          rem QUIT
      endcase
      
      quit
      rem End of Program ==========================================
      rem =========================================================
      
      rem Setup
      def proc_setup
      
      rem Change the Windows Title
      title$ = " Hue Changer"
      sys "SetWindowText", @hwnd%, title$
      
      rem Go to full screen
      proc_maxim(xscreen%,yscreen%)
      
      colour 3 : colour 132,50,0,0 : colour 4,50,0,0 : colour 132 : cls : mouse on
      Font$="Georgia" : Sz&=12
      
      rem Instructions; Only displayed on first run
      if Z%=0 then
        
        rem Display a backdrop picture
        proc_BackPic("Vyrn.jpg",xscreen%,yscreen%)
        
        colour 6,150,150,250
        Msg$="\6H U E  C H A N G E R "
        proc_msg("Blackadder ITC",30,"B",fn_adapt(0,1000),fn_adapt(1,1500),Msg$)
        
        rem Displays my icon
        proc_AJTicon(50,fn_adapt(1,50))
        
        rem Prints the backdrop for a screen message
        proc_back(fn_adapt(0,400),fn_adapt(1,500),1800,1000,120,100,100)
        
        msg$="\11INSTRUCTIONS"
        proc_msg(Font$,Sz&,"B",fn_adapt(0,600),fn_adapt(1,1200),msg$)
        msg$="\10============"
        proc_msg(Font$,Sz&,"B",fn_adapt(0,600),fn_adapt(1,1170),msg$)
        
        msg$="\91 \10First, select any \11jpg \10or \11bmp \10picture to modify"
        proc_msg(Font$,Sz&,"B",fn_adapt(0,450),fn_adapt(1,1100),msg$)
        
        msg$="\92 \10Next, use the mouse to place a 'box' around the object/area to be modified"
        proc_msg(Font$,Sz&,"B",fn_adapt(0,450),fn_adapt(1,1040),msg$)
        
        msg$="\10   First, \11left-click \10to fix the \11top-left \10corner"
        proc_msg(Font$,Sz&,"B",fn_adapt(0,450),fn_adapt(1,1010),msg$)
        
        msg$="\10   Then, \11right-click \10to fix the \11bottom-right \10corner"
        proc_msg(Font$,Sz&,"B",fn_adapt(0,450),fn_adapt(1,980),msg$)
        
        msg$="\93 \10Next, pass the mouse over the area to be modified"
        proc_msg(Font$,Sz&,"B",fn_adapt(0,450),fn_adapt(1,920),msg$)
        
        msg$="\9   IMPORTANT: \10Keep the \11left \10mouse button pressed while passing over \9critical \10areas!"
        proc_msg(Font$,Sz&,"B",fn_adapt(0,450),fn_adapt(1,890),msg$)
        
        msg$="\10   Then, \11right-click \10when sufficient area has been covered"
        proc_msg(Font$,Sz&,"B",fn_adapt(0,450),fn_adapt(1,860),msg$)
        
        msg$="\94 \10Now, \11enter \10the \11shift \10in hue required within the boxed area. Can be \11+ \10or \11-"
        proc_msg(Font$,Sz&,"B",fn_adapt(0,450),fn_adapt(1,800),msg$)
        
        msg$="\10   Hue is expressed in \11degrees\10: \9RED\15=0 \11YELLOW\15=60 \10GREEN\15=120 \14CYAN\15=180 \12BLUE\15=240 \13MAGENTA\15=300"
        proc_msg(Font$,Sz&,"B",fn_adapt(0,450),fn_adapt(1,770),msg$)
        
        msg$="\95 \10Finally, \11enter \10the \11saturation \10and \11intensity \10factors required"
        proc_msg(Font$,Sz&,"B",fn_adapt(0,450),fn_adapt(1,710),msg$)
        
        msg$="\11   <1 \10is a decrease, \11=1 \10is no change, \11>1 \10is an increase"
        proc_msg(Font$,Sz&,"B",fn_adapt(0,450),fn_adapt(1,680),msg$)
        
        msg$="\96 \10Once the picture has changed, press -\11S\10- to \11SAVE \10it, \11left\10-click to re-\11RUN\10, any other key to \9QUIT"
        proc_msg(Font$,Sz&,"B",fn_adapt(0,450),fn_adapt(1,620),msg$)
        
        msg$="\11Press \10any key or mouse-click to \11CONTINUE"
        proc_msg(Font$,Sz&,"B",fn_adapt(0,600),fn_adapt(1,560),msg$)
        
        proc_event(a$,b&) : rem Wait for a mouse-click or a key-press.
        cls
      endif
      
      endproc
      rem =======================================================================
      
      rem Choose a picture and display it
      def proc_GetPic
      local xb%,yb%,xc%,yc%,pass&
      
      rem All other variables treated as GLOBAL
      
      rem Choose a picture
      proc_pichoose(Name$,FulName$,Pre$,wdth%,hght%,lgth%,pic%)
      Wlim%=((wdth%*3+3)and-4)
      
      rem Set scaling for displaying pictures centrally
      proc_scale(xscreen%/2,yscreen%/2,wdth%,hght%,xb%,yb%,xc%,yc%)
      
      rem Re-adjust scaling
      xs%=3*xscreen%/8 + xb% : ys%=yscreen%/4 + yb%
      xe%=9*xc%/8 : ye%=9*yc%/8
      
      rem Display picture initially
      proc_BMP_Disp(xe%,ye%,pic%,xs%,ys%)
      
      rem Create mirror bitmap
      proc_BMP_Set(wdth%,hght%,picmir%,ntused%,ntused%)
      
      dim recopy% 200
      
      rem Dual-pass assembly, in case of labels
      for pass&=0 to 2 step 2
        proc_Recopy(pass&)
      next pass&
      
      rem Copy pacb to paca
      call recopy%,pic%,picmir%,lgth%
      
      dim hsi% 3*wdth%*hght%
      
      endproc
      rem =======================================================================
      
      rem_Convert back to RGB
      def proc_HSI_Invert
      local x%,y%
      
      for y%=yL%+1 to yH%-1
        bref%=y%*Wlim% + 54
        bf%=3*y%*wdth%
        
        for x%=xL%+1 to xH%-1
          ref%=bref% + 3*x%
          href%=bf% + 3*x%
          
          H=2*pi*?(hsi%+href%)/255
          
          satfac=1.0
          tenfac=1.0
          
          if min%<max% then
            if (H>2*pi*min%/360 and H<2*pi*max%/360) then
              H+=2*pi*shft%/360
              satfac=satu
              tenfac=tens
            endif
          else
            if (H>2*pi*min%/360 or H<2*pi*max%/360) then
              H+=2*pi*shft%/360
              satfac=satu
              tenfac=tens
            endif
          endif
          
          rem Carry out inversion
          call Invert%
          
        next x%
        if y%mod10=0 then print tab(5,5);y%
      next y%
      colour 2 : print tab(5,5);"DONE!"
      endproc
      rem =======================================================================
      
      rem Change Hue
      def proc_HueChange
      local x%,y%,b&
      
      rem Mouse debounce
      repeat
        mouse x%,y%,b&
        sys "Sleep",10
      until b&=0
      
      vlo%=0 : rvlo%=0
      min%=360 : max%=0
      rmin%=360 : rmax%=0
      *font "Georgia",12
      print tab(5,8) ;"Hue: "
      print tab(5,10);"Min Hue: "
      print tab(5,12);"Max Hue: "
      print tab(5,14);"RMin Hue: "
      print tab(5,16);"RMax Hue: "
      
      repeat
        mouse x%,y%,b&
        sys "Sleep",5
        
        if (x%>=2*xs% and x%<2*(xs%+xe%) and y%>=2*ys% and y%<2*(ys%+ye%)) then
          mouse on 3
          
          px%=int(0.5 + wdth%*(x%-2*xs%)/(2*xe%))
          py%=int(0.5 + hght%*(y%-2*ys%)/(2*ye%))
          
          href%=3*py%*wdth% + 3*px%
          
          vl%=int(0.5 + 360*?(hsi%+href%)/255)
          rvl%=0
          
          if vl%<90 then rvl%=vl%+360
          if vl%>270 then rvl%=vl%-360
          
          if vl%<>vlo% then
            
            if b&=4 then
              if vl%<min% then min%=vl%
              if vl%>max% then max%=vl%
            endif
            print tab(20,8);"             "
            print tab(20,8);vl%
            vlo%=vl%
            print tab(20,10);"             "
            print tab(20,10);min%
            print tab(20,12);"             "
            print tab(20,12);max%
          endif
          
          if rvl%<>0 then
            
            if b&=4 then
              if rvl%<rmin% then rmin%=rvl%
              if rvl%>rmax% then rmax%=rvl%
            endif
            rvlo%=rvl%
            print tab(20,14);"             "
            print tab(20,14);rmin%
            print tab(20,16);"             "
            print tab(20,16);rmax%
          endif
          
        else
          mouse on 136
        endif
        
      until b&=1
      mouse on
      if rmin%<min% and rmax%>max% then min%=rmin%+360 : max%=rmax%-360
      min%-=5 : if min%<0 then min%=0
      max%+=5 : if max%>360 then max%=360
      
      input tab(5,20);"Enter hue-angle shift";shft%
      print tab(5,20);"Hue-angle shift is: ";shft%;" degrees"
      
      input tab(5,24);"Enter saturation factor";satu
      if satu<=0 then satu=1
      satu=1.0*satu
      print tab(5,24);"Saturation factor is: ";satu;"          "
      
      input tab(5,26);"Enter intensity factor";tens
      if tens<=0 then tens=1
      tens=1.0*tens
      print tab(5,26);"Intensity factor is: ";tens;"          "
      
      endproc
      rem =======================================================================
      
      rem Enables user to zoom into a particular area
      def proc_zoom(Ysc%,Ysb%,Xsc%,Xsb%, return xl%, return yl%, return xh%, return yh%)
      local w%,h%,b&,ax%,cx%,ay%,cy%
      
      *REFRESH OFF
      
      mouse on : gcol 3
      mouse rectangle 2*Xsb%,2*Ysb%,2*Xsc%,2*Ysc%
      
      rem Select first corner of rectangular zoom area
      repeat
        mouse w%,h%,b&
        sys "Sleep",10
      until b&=4
      
      ax%=w% : ay%=h%
      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
      cx%=-1 : cy%=-1 : rem Initialise opposite corner points
      repeat
        mouse w%,h%,b&
        sys "Sleep",10
        if (cx%<>w% or cy%<>h%) then
          cx%=w% : cy%=h%
          cls : proc_BMP_Disp(Xsc%,Ysc%,pic%,Xsb%,Ysb%)
          
          move ax%,ay% : draw cx%,ay% : draw cx%,cy%
          draw ax%,cy% : draw ax%,ay%
          *REFRESH
        endif
      until b&=1
      *REFRESH
      
      rem Re-assign corner points in ascending order
      if ax%<cx% then
        lx%=ax% : ux%=cx%
      else
        lx%=cx% : ux%=ax%
      endif
      if ay%<cy% then
        ly%=ay% : uy%=cy%
      else
        ly%=cy% : uy%=ay%
      endif
      a$=inkey$(10) : mouse rectangle off : mouse off
      
      xl%=int(0.5 + wdth%*(lx%-2*Xsb%)/(2*Xsc%))
      yl%=int(0.5 + hght%*(ly%-2*Ysb%)/(2*Ysc%))
      xh%=int(0.5 + wdth%*(ux%-2*Xsb%)/(2*Xsc%))
      yh%=int(0.5 + hght%*(uy%-2*Ysb%)/(2*Ysc%))
      
      *REFRESH ON
      
      endproc
      rem =======================================================================
      
      rem Save picture
      def proc_SavePic
      
      rem Save the altered picture
      proc_save(Name$,"P",picmir%,lgth%,Newpic$)
      
      msg$="\3Picture saved as: \1"+Newpic$
      proc_msg(Font$,Sz&,"",50,fn_adapt(1,500),msg$)
      a$=inkey$(200)
      msg$="\4Picture saved as: "+Newpic$
      proc_msg(Font$,Sz&,"",50,fn_adapt(1,500),msg$)
      
      endproc
      rem =======================================================================
      
      rem ASM Setup
      def proc_ASMSetup
      local pass&
      
      dim Invert% 3000, itmp% 3, ftmp% 7
      dim Convert% 3000
      
      two=2.0
      three=3.0
      i255%=255
      
      rem Dual-pass assembly, in case of labels
      for pass&=0 to 2 step 2
        proc_InVert(pass&)
        rem a$=get$ : print
      next pass&
      rem cls
      
      rem Dual-pass assembly, in case of labels
      for pass&=0 to 2 step 2
        proc_ConVert(pass&)
      next pass&
      
      endproc
      rem =======================================================================
      
      rem ASM routine
      def proc_InVert(Opt&)
      
      P%=Invert%
      [opt Opt&
      
      finit
      fldpi
      fadd st0,st0
      fld qword [^H]
      fcompp
      fstsw ax
      and ah,1
      cmp ah,1
      je Hhiok
      fld qword [^H]
      fldpi
      fadd st0,st0
      fsubp st1,st0
      fstp qword [^H]
      .Hhiok
      fldz
      fld qword [^H]
      fcompp
      fstsw ax
      and ah,1
      cmp ah,0
      je Hlook
      fld qword [^H]
      fldpi
      fadd st0,st0
      faddp st1,st0
      fstp qword [^H]
      
      .Hlook
      mov eax,[^href%]
      mov ecx,0
      mov cl,hsi%[eax+1]
      mov [itmp%],ecx
      fild dword [itmp%]
      fld qword [^satfac]
      fmulp st1,st0
      fild dword [^i255%]
      fdivp st1,st0
      fstp qword [^S]
      
      mov cl,hsi%[eax+2]
      mov [itmp%],ecx
      fild dword [itmp%]
      fld qword [^tenfac]
      fmulp st1,st0
      fild dword [^i255%]
      fdivp st1,st0
      fstp qword [^I]
      
      fldz
      fld qword [^H]
      fcompp                    ;Is H<0.0?
      fstsw ax
      and ah,1
      cmp ah,0
      jne ntrng1
      fldpi
      fadd st0,st0
      fld qword [^three]
      fdivp st1,st0
      fld qword [^H]
      fcompp                   ;Is H<2*Pi/3?
      fstsw ax
      and ah,1
      cmp ah,1
      jne ntrng1
      mov al,1
      mov [^Cas&],al
      jmp tward
      
      .ntrng1
      fldpi
      fadd st0,st0
      fld qword [^three]
      fdivp st1,st0
      fld qword [^H]
      fcompp                   ;Is H<2*Pi/3?
      fstsw ax
      and ah,1
      cmp ah,0
      jne ntrng2
      fldpi
      fadd st0,st0
      fadd st0,st0
      fld qword [^three]
      fdivp st1,st0
      fld qword [^H]
      fcompp                   ;Is H<4*Pi/3?
      fstsw ax
      and ah,1
      cmp ah,1
      jne ntrng2
      mov al,2
      mov [^Cas&],al
      fld qword [^H]
      fldpi
      fadd st0,st0
      fld qword [^three]
      fdivp st1,st0
      fsubp st1,st0
      fstp qword [^H]
      jmp tward
      
      .ntrng2
      fld qword [^H]
      fldpi                   ;H must be >4*Pi/3
      fadd st0,st0
      fadd st0,st0
      fld qword [^three]
      fdivp st1,st0
      fsubp st1,st0
      fstp qword [^H]
      mov al,3
      mov [^Cas&],al
      
      .tward
      fld1
      fld qword [^S]
      fsubp st1,st0
      fld qword [^I]
      fmulp st1,st0
      fstp qword [^B]
      
      fldpi
      fld qword [^three]
      fdivp st1,st0
      fld qword [^H]
      fsubp st1,st0
      fcos                     ;Cos(Pi/3-H) left 0n stack
      
      fld qword [^H]
      fcos
      fld qword [^S]
      fmulp st1,st0
      fdivrp st1,st0
      fld1
      faddp st1,st0
      fld qword [^I]
      fmulp st1,st0
      fstp qword [^R]
      
      fld qword [^I]
      fld qword [^three]
      fmulp st1,st0
      fld qword [^R]
      fsubp st1,st0
      fld qword [^B]
      fsubp st1,st0
      fstp qword [^G]
      
      fld qword [^R]
      fild dword [^i255%]
      fmulp st1,st0
      fistp dword [^Xx%]
      
      fld qword [^G]
      fild dword [^i255%]
      fmulp st1,st0
      fistp dword [^Yy%]
      
      fld qword [^B]
      fild dword [^i255%]
      fmulp st1,st0
      fistp dword [^Zz%]
      
      mov ebx,[^Xx%]
      cmp ebx,255
      jle Xhok
      mov ebx,255
      .Xhok
      cmp ebx,0
      jge Xlok
      mov ebx,0
      .Xlok
      mov [^X&],bl
      
      mov ebx,[^Yy%]
      cmp ebx,255
      jle Yhok
      mov ebx,255
      .Yhok
      cmp ebx,0
      jge Ylok
      mov ebx,0
      .Ylok
      mov [^Y&],bl
      
      mov ebx,[^Zz%]
      cmp ebx,255
      jle Zhok
      mov ebx,255
      .Zhok
      cmp ebx,0
      jge Zlok
      mov ebx,0
      .Zlok
      mov [^Z&],bl
      
      mov al,[^Cas&]
      cmp al,1
      jne nt1
      mov bl,[^X&]
      mov [^Rr&],bl
      mov bl,[^Y&]
      mov [^Gg&],bl
      mov bl,[^Z&]
      mov [^Bb&],bl
      jmp frward
      .nt1
      cmp al,2
      jne nt2
      mov bl,[^X&]
      mov [^Gg&],bl
      mov bl,[^Y&]
      mov [^Bb&],bl
      mov bl,[^Z&]
      mov [^Rr&],bl
      jmp frward
      .nt2
      mov bl,[^X&]
      mov [^Bb&],bl
      mov bl,[^Y&]
      mov [^Rr&],bl
      mov bl,[^Z&]
      mov [^Gg&],bl
      
      .frward
      mov eax,[^ref%]
      mov cl,[^Bb&]
      mov picmir%[eax],cl
      mov cl,[^Gg&]
      mov picmir%[eax+1],cl
      mov cl,[^Rr&]
      mov picmir%[eax+2],cl
      
      ret
      ]
      endproc
      rem =======================================================================
      
      rem HSI to RGB conversion in ASM
      def proc_dump(h,s,i,return X&,return Y&,return Z&)
      
      if H>2*pi then H=H-2*pi
      if H<0.0 then H=H+2*pi
      
      S=?(hsi%+href%+1)/255
      
      I=?(hsi%+href%+2)/255
      
      case true of
        when H>=0.0 and H<2*pi/3 : Cas&=1 : rem Means order R/G/B
        when H>=2*pi/3 and H<4*pi/3 : H=H-2*pi/3 : Cas&=2 : rem Means order G/B/R
        when H>=4*pi/3 and H<2*pi : H=H-4*pi/3 : Cas&=3 : rem Means order B/R/G
      endcase
      
      B=i*(1-s)  : rem DONE
      
      R=i*(1+s*cos(h)/cos(pi/3-h)) : rem DONE
      
      G=(3*i-R-B) : rem DONE
      
      Xx%=int(255*R) : rem DONE
      Yy%=int(255*G) : rem DONE
      Zz%=int(255*B) : rem DONE
      
      X&=fn_curt(Xx%) : rem DONE
      Y&=fn_curt(Yy%) : rem DONE
      Z&=fn_curt(Zz%) : rem DONE
      
      ?(picmir%+ref%)=Bb&      : rem DONE
      ?(picmir%+ref%+1)=Gg&    : rem DONE
      ?(picmir%+ref%+2)=Rr&    : rem DONE
      
      endproc
      rem =======================================================================
      
      rem ASM routine
      def proc_ConVert(Opt&)
      
      P%=Convert%
      [opt Opt&
      
      mov edx,0
      mov [^y%],edx
      
      .ytloop
      mov eax,[^y%]
      imul eax,[^Wlim%]
      add eax,54
      mov [^bref%],eax
      
      mov eax,[^y%]
      imul eax,[^wdth%]
      mov ebx,eax
      add eax,ebx
      add eax,ebx
      mov [^bf%],eax
      
      mov edx,0
      mov [^x%],edx
      
      .xtloop
      mov eax,[^bref%]
      add eax,[^x%]
      add eax,[^x%]
      add eax,[^x%]
      mov [^ref%],eax
      
      mov eax,[^bf%]
      add eax,[^x%]
      add eax,[^x%]
      add eax,[^x%]
      mov [^href%], eax
      
      mov eax,[^ref%]
      mov cl,pic%[eax]
      mov [^b&],cl
      mov cl,pic%[eax+1]
      mov [^g&],cl
      mov cl,pic%[eax+2]
      mov [^r&],cl
      
      finit
      mov ebx,0
      mov bl,[^b&]
      mov [itmp%],ebx
      fild dword [itmp%]
      fild dword [^i255%]
      fdivp st1,st0
      fstp qword [^B]
      mov bl,[^g&]
      mov [itmp%],ebx
      fild dword [itmp%]
      fild dword [^i255%]
      fdivp st1,st0
      fstp qword [^G]
      mov bl,[^r&]
      mov [itmp%],ebx
      fild dword [itmp%]
      fild dword [^i255%]
      fdivp st1,st0
      fstp qword [^R]
      
      mov bl,[^r&]
      cmp bl,[^g&]
      jne wereon
      cmp bl,[^b&]
      jne wereon
      fldz
      fstp qword [^Theta]
      jmp wards
      .wereon
      fld qword [^R]
      fld qword [^G]
      fsubp st1,st0
      fmul st0,st0
      fld qword [^R]
      fld qword [^B]
      fsubp st1,st0
      fld qword [^G]
      fld qword [^B]
      fsubp st1,st0
      fmulp st1,st0
      faddp st1,st0
      fst qword [^Calc]         ;Calc left 0n stack here
      
      ftst
      fstsw ax
      and ah,1
      cmp ah,1
      jne allok
      fldz
      fstp qword [^Theta]
      jmp wards
      .allok
      fld qword [^R]
      fadd st0,st0
      fld qword [^G]
      fsubp st1,st0
      fld qword [^B]
      fsubp st1,st0
      fld qword [^Calc]
      fsqrt
      fadd st0,st0
      fdivp st1,st0
      fst qword [^Arg]           ;Arg left 0n stack here
      
      fld1
      fchs
      fcompp                     ;Test whether -1>Arg
      fstsw ax
      and ah,1
      cmp ah,0
      jne other
      fld1
      fchs
      fstp qword [^Arg]
      jmp wards
      .other
      fld qword [^Arg]
      fld1
      fcompp                    ;Test whether +1<Arg
      fstsw ax
      and ah,1
      cmp ah,1
      jne rangeok
      fld1
      fstp qword [^Arg]
      jmp wards
      
      .rangeok
      fld1                      ;ArcCos routine
      fld qword [^Arg]
      fmul st0,st0
      fsubp st1,st0
      fsqrt
      fld qword [^Arg]
      fpatan
      fstp qword [^Theta]       ;Theta between 0 And +Pi
      
      .wards
      mov al,0
      mov [^Ct&],al
      mov bl,[^r&]
      cmp bl,0
      jne roon
      inc byte [^Ct&]
      .roon
      mov bl,[^g&]
      cmp bl,0
      jne goon
      inc byte [^Ct&]
      .goon
      mov bl,[^b&]
      cmp bl,0
      jne boon
      inc byte [^Ct&]
      .boon
      mov bl,[^Ct&]
      cmp bl,3
      jb high
      fldz
      fstp qword [^S]
      jmp round
      
      .high
      mov ebx,0
      mov bl,[^b&]
      mov [^Mn%],ebx
      cmp bl,[^g&]
      jbe Gok
      mov bl,[^g&]
      mov [^Mn%],ebx
      .Gok
      cmp bl,[^r&]
      jbe Rok
      mov bl,[^r&]
      mov [^Mn%],ebx
      
      .Rok
      fild dword [^Mn%]
      fild dword [^i255%]
      fdivp st1,st0
      fld qword [^R]
      fld qword [^G]
      faddp st1,st0
      fld qword [^B]
      faddp st1,st0
      fdivp st1,st0
      fld qword [^three]
      fmulp st1,st0
      fld1
      fsubrp st1,st0
      fstp qword [^S]
      
      .round
      fld qword [^R]
      fld qword [^G]
      faddp st1,st0
      fld qword [^B]
      faddp st1,st0
      fld qword [^three]
      fdivp st1,st0
      fstp qword [^I]
      
      fld qword [^Theta]
      mov al,[^b&]
      cmp al,[^g&]
      jbe nchng
      fldpi
      fadd st0,st0
      fsubrp st1,st0
      .nchng
      fst qword [^H]
      
      fldpi
      fadd st0,st0
      fdivp st1,st0
      fild dword [^i255%]
      fmulp st1,st0
      fistp dword [^Hh%]
      
      fld qword [^S]
      fild dword [^i255%]
      fmulp st1,st0
      fistp dword [^Ss%]
      
      fld qword [^I]
      fild dword [^i255%]
      fmulp st1,st0
      fistp dword [^Ii%]
      
      mov ebx,[^Hh%]
      cmp ebx,255
      jle Hhok
      mov ebx,255
      mov [^Hh%],ebx
      .Hhok
      cmp ebx,0
      jge Hlok
      mov ebx,0
      mov [^Hh%],ebx
      .Hlok
      
      mov ebx,[^Ss%]
      cmp ebx,255
      jle Shok
      mov ebx,255
      mov [^Ss%],ebx
      .Shok
      cmp ebx,0
      jge Slok
      mov ebx,0
      mov [^Ss%],ebx
      .Slok
      
      mov ebx,[^Ii%]
      cmp ebx,255
      jle Ihok
      mov ebx,255
      mov [^Ii%],ebx
      .Ihok
      cmp ebx,0
      jge Ilok
      mov ebx,0
      mov [^Ii%],ebx
      .Ilok
      
      mov eax,[^href%]
      mov ebx,[^Hh%]
      mov hsi%[eax],bl
      mov ebx,[^Ss%]
      mov hsi%[eax+1],bl
      mov ebx,[^Ii%]
      mov hsi%[eax+2],bl
      
      inc dword [^x%]
      mov edx,[^x%]
      cmp edx,[^wdth%]
      jl near xtloop
      
      inc dword [^y%]
      mov edx,[^y%]
      cmp edx,[^hght%]
      jl near ytloop
      
      ret
      ]
      endproc
      rem =======================================================================
      
      rem Convert to HSI
      def proc_dump3
      local x%,y%
      
      rem All DONE
      for y%=0 to hght%-1
        bref%=y%*Wlim% + 54     : rem DONE
        bf%=3*y%*wdth%          : rem DONE
        rem All DONE
        for x%=0 to wdth%-1
          ref%=bref% + 3*x%     : rem DONE
          href%=bf% + 3*x%      : rem DONE
          
          rem Get normalised RGB values
          b&=?(pic%+ref%)       : rem DONE
          g&=?(pic%+ref%+1)     : rem DONE
          r&=?(pic%+ref%+2)     : rem DONE
          
          B=1.0*b&/255          : rem DONE
          G=1.0*g&/255          : rem DONE
          R=1.0*r&/255          : rem DONE
          
          rem All DONE
          if (r&=g& and g&=b&) then
            Theta=0.0                         : rem DONE
          else
            Calc=(R-G)^2 + (R-B)*(G-B)        : rem DONE
            if Calc<=0.0 then
              Theta=0.0                         : rem DONE
            else
              Arg=(2*R-G-B)/(2*sqr(Calc))       : rem DONE
              if Arg<-1.0 then Arg=-1.0         : rem DONE
              if Arg>1.0 then Arg=1.0           : rem DONE
              Theta=acs(Arg)                    : rem DONE
            endif
          endif
          
          rem All DONE
          if (r&=0 and g&=0 and b&=0) then
            S=0.0                                : rem DONE
          else                                   : rem DONE
            S=1.0 - 3.0*fn_min(R,G,B)/(R+G+B)    : rem DONE
          endif
          
          I=(R+G+B)/3  : rem DONE
          
          case true of                   : rem DONE
            when b&<=g& : H=Theta        : rem DONE
            when b&>g&  : H=2*pi-Theta   : rem DONE
          endcase
          
          Hh%=fn_curt(int(255*H/(2*pi)))  : rem DONE
          
          Ss%=fn_curt(int(255*S))  : rem DONE
          
          Ii%=fn_curt(255*I) : rem DONE
          
          ?(hsi%+href%)=Hh%     : rem DONE
          ?(hsi%+href%+1)=Ss%   : rem DONE
          ?(hsi%+href%+2)=Ii%   : rem DONE
          
        next x%
      next y%
      
      endproc
      rem =======================================================================
      
      rem Assembly Routine for Recopy
      def proc_Recopy(opt&)
      P%=recopy%
      [opt opt&
      
      mov esi,[ebp+2]
      mov edi,[ebp+7]
      mov eax,[ebp+12]
      mov ecx,[eax]
      cld
      rep movsb
      
      ret
      ]
      endproc
      rem ======================================================================