rem BMP Grey (Assembly Version) ... Rev 7.3
      rem A J Tooth // July 2004
      
      rem====================================================================
      rem This program generates a grey-scale version as a standard .bmp file
      rem====================================================================
      
      rem ===================================================================
      on error if (err=17) then quit
      himem=lomem + 100000000
      *FLOAT 64
      install @lib$+"MyUtils.bbc"
      install @lib$+"BMP_Utils.bbc"
      rem ===================================================================
      
      rem Setup
      proc_setup
      
      rem Choose a picture
      proc_pichoose(Name$, FulName$, Pre$, wdth%, hght%, lgth%, pic%)
      
      rem Set up a blank mirror bitmap
      proc_BMP_Set(wdth%,hght%,pfmir%,Wlim%,ntused%)
      
      rem Set scaling for displaying pictures centrally
      proc_scale(xend%,yend%,wdth%,hght%,xb%,yb%,xc%,yc%)
      
      rem Display the picture initially
      proc_BMP_Disp(xc%,yc%,pic%,xst%+xb%,yst%+yb%)
      
      rem Compile ASM
      proc_setup2
      
      repeat
        rem Options.
        proc_options(op&,Pr&)
        
        if op&<7 then
          rem Grey version.
          proc_Grey
          
          rem Display the grey picture
          proc_BMP_Disp(xc%,yc%,pfmir%,xst%+xb%,yst%+yb%)
          
        else
          b&=1
        endif
      until b&=1
      
      if op&=7 then
        rem Save pictures to disc
        proc_psave(Name$)
        
        mouse on : proc_mclick(b&) : rem Wait for a mouse-click
        if b&=4 then run else quit
      endif
      quit
      rem End of Program ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      rem =========================================================================================================
      
      rem Setup
      def proc_setup
      local a&,b&
      
      rem Change the Windows Title
      title$ = " GREY Conversion by Tony Tooth"
      sys "SetWindowText", @hwnd%, title$
      
      rem Maximise screen
      proc_maxim(xscreen%,yscreen%)
      colour 3 : colour 132,0,0,50 : colour 4,0,0,50 : colour 132 : cls : off : mouse on
      
      rem Standard grey-scale weightings
      wr=0.30 : wg=0.59 : wb=0.11
      
      rem Display parameters
      xst%=xscreen%/4
      yst%=yscreen%/8
      xend%=3*xscreen%/4
      yend%=3*yscreen%/4
      
      Pr&=0  : rem Previous filter choice
      
      dim chs$(7)
      chs$()="No Filter","Red","Green","Blue","Yellow","New Standard","SAVE Picture","QUIT"
      
      rem Display a backdrop picture
      proc_BackPic("Grey.jpg",xscreen%,yscreen%)
      
      rem Displays my icon
      proc_AJTicon(50,fn_adapt(1,650))
      
      rem Front Message
      font$="Georgia Italic"
      proc_back(100,fn_adapt(1,1250),1200,fn_adapt(1,200),150,150,150)
      msg$="\14Choose to view either a \10JPG\14, \10GIF \14or \10BMP \14image"
      proc_msg(Font$,12,"B",200,fn_adapt(1,1400),msg$)
      
      msg$="\11CLICK THE MOUSE TO \10CONTINUE"
      proc_msg(Font$,12,"B",200,fn_adapt(1,1350),msg$)
      
      proc_mclick(b&) : rem Wait for a mouse click
      
      cls
      endproc
      rem =========================================================================================================
      
      rem Compile ASM
      def proc_setup2
      local pass&
      
      dim bsave% 100, grey% 1000, tmp% 3
      
      rem Dual-pass assembly, in case of labels
      for pass&=0 to 2 step 2
        proc_bsave(pass&)
        proc_grey(pass&)
      next pass&
      
      endproc
      rem =========================================================================================================
      
      rem Analyse the .bmp at byte level, including header data.
      def proc_options(return cc&,return Prv&)
      local a&,d&,x%,y%,b&,s&
      
      *FONT Georgia Italic,10,B
      colour 132 : colour 3 : print tab(5,5);"Click on a button for filter choice."
      
      vdu 5
      if Prv&=0 then Flg&=0 else Flg&=2
      for a&=0 to (5+Flg&)
        for d&=25 to 1 step-1
          rd&=int(255*(1-d&/25)) : gd&=rd& : bd&=50+int(205*(1-d&/25))
          colour 7,rd&,gd&,bd& : gcol 7
          circle fill 150,1200-100*a&,d&
        next d&
        gcol 3 : move 250,1210-100*a& : print;chs$(a&)
      next a&
      vdu 4
      
      if Prv&>0 then
        rem Previously chosen filter shows RED
        for d&=25 to 1 step-1
          rd&=int(255*(1-d&/25)) : gd&=0 : bd&=50-int(50*(1-d&/25))
          colour 7,rd&,gd&,bd& : gcol 7
          circle fill 150,1200-100*(Prv&-1),d&
        next d&
      endif
      
      cc&=0 : mouse on
      repeat
        mouse x%,y%,b&
        sys "Sleep",10
        if x%>125 and x%<175 and b&=4 then
          case true of
            when (y%>475 and y%<525)  :cc&=8
            when (y%>575 and y%<625)  :cc&=7
            when (y%>675 and y%<725)  :cc&=6: flt$="A"
            when (y%>775 and y%<825)  :cc&=5: flt$="Y"
            when (y%>875 and y%<925)  :cc&=4: flt$="B"
            when (y%>975 and y%<1025) :cc&=3: flt$="G"
            when (y%>1075 and y%<1125):cc&=2: flt$="R"
            when (y%>1175 and y%<1225):cc&=1: flt$=""
          endcase
        endif
      until cc&>0
      
      rem Chosen button turns GREEN
      for d&=25 to 1 step-1
        rd&=0 : gd&=int(255*(1-d&/25)) : bd&=50-int(50*(1-d&/25))
        colour 7,rd&,gd&,bd& : gcol 7
        circle fill 150,1200-100*(cc&-1),d&
      next d&
      
      rem Previously chosen filter reverts
      if Prv&>0 then
        for d&=25 to 1 step-1
          rd&=int(255*(1-d&/25)) : gd&=rd& : bd&=50+int(205*(1-d&/25))
          colour 7,rd&,gd&,bd& : gcol 7
          circle fill 150,1200-100*(Prv&-1),d&
        next d&
      endif
      a$=inkey$(50)
      
      rem Adjust filter values
      case cc& of
        when 1 : wr=0.30 : wg=0.59 : wb=0.11
        when 2 : wr=1.0 : wg=0.0 : wb=0.0
        when 3 : wr=0.0 : wg=1.0 : wb=0.0
        when 4 : wr=0.0 : wg=0.0 : wb=1.0
        when 5 : wr=0.34 : wg=0.66 : wb=0.0
        when 6 : wr=0.2125 : wg=0.7154 : wb=0.0721 : rem Alternative Rec 709 HDTV values
        otherwise
          rem No change
      endcase
      Prv&=cc&
      endproc
      rem =========================================================================================================
      
      rem Grey version.
      def proc_Grey
      
      sys "GetCurrentProcess" to hprocess%
      sys "SetPriorityClass", hprocess%, &100
      
      call grey%
      
      sys "GetCurrentProcess" to hprocess%
      sys "SetPriorityClass", hprocess%, &20
      
      endproc
      rem =========================================================================================================
      
      rem Save pictures to disc
      def proc_psave(Name$)
      
      ps%=instr(Name$,".")
      Newpic$=left$(Name$,(ps%-1))+"GS"+flt$+".bmp"
      Dpath$=Pre$+Newpic$
      g&=openout Dpath$
      call bsave% : rem Byte Save Routine
      close#(g&)
      
      proc_back(100,fn_adapt(1,150),1200,fn_adapt(1,200),150,150,150)
      msg$="\6 Picture is saved as: \2" + Newpic$
      proc_msg(Font$,12,"B",200,fn_adapt(1,300),msg$)
      msg$="\11 Left-click \2to choose another picture, \11right click \2to \1EXIT"
      proc_msg(Font$,12,"B",200,fn_adapt(1,250),msg$)
      
      endproc
      rem =========================================================================================================
      
      rem Byte Save - Assembly Routine
      def proc_bsave(opt&)
      P%=bsave%
      [opt opt&
      
      mov ebx,0
      mov bl,[^g&]           ;Puts channel ref t0 ebx
      mov edx,0
      mov [^w%],edx          ;Initialise loop counter
      
      .loop
      mov al,pfmir%[edx]
      call "osbput"         ;Puts al t0 channel ebx
      inc dword [^w%]
      mov edx,[^w%]
      cmp edx,[^lgth%]
      jle loop
      
      ret
      ]
      endproc
      rem =========================================================================================================
      
      rem Greyscale Conversion - Assembly Routine
      def proc_grey(opt&)
      P%=grey%
      [opt opt&
      
      mov edx,0
      mov [^j%],edx
      
      .jloop
      mov edx,0
      mov [^k%],edx
      
      .kloop
      mov eax,[^j%]
      imul eax,[^Wlim%]
      add eax,[^k%]
      add eax,[^k%]
      add eax,[^k%]
      add eax,54
      
      finit                     ;Use standard rgb weights f0r greyscale conversion
      mov ecx,0
      mov cl,pic%[eax]
      mov [tmp%],ecx
      fild dword [tmp%]
      fld qword [^wb]
      fmulp st1,st0
      mov cl,pic%[eax+1]
      mov [tmp%],ecx
      fild dword [tmp%]
      fld qword [^wg]
      fmulp st1,st0
      faddp st1,st0
      mov cl,pic%[eax+2]
      mov [tmp%],ecx
      fild dword [tmp%]
      fld qword [^wr]
      fmulp st1,st0
      faddp st1,st0
      fistp dword [^avg%]       ;Use standard rgb weights f0r greyscale conversion
      
      mov ebx,[^avg%]
      cmp ebx,255
      jle vok
      mov ebx,255
      mov [^avg%],ebx
      
      .vok
      mov cl,[^avg%]
      mov pfmir%[eax],cl
      mov pfmir%[eax+1],cl
      mov pfmir%[eax+2],cl
      
      inc dword [^k%]
      mov edx,[^k%]
      cmp edx,[^wdth%]
      jl near kloop
      
      inc dword [^j%]
      mov edx,[^j%]
      cmp edx,[^hght%]
      jl near jloop
      
      ret
      ]
      endproc
      rem =========================================================================================================