rem BMP Edge Detector ... Rev 4.0
      rem Assembly Language version
      rem A J Tooth // Revised July 2007
      
      rem===========================================
      rem This program outlines edges in a .bmp file
      rem===========================================
      
      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 Switch to Full Screen
      proc_fullscreen(xscreen%,yscreen%)
      colour 132,0,0,50 : colour 4,0,0,50 : colour 132 : cls
      
      rem Select a picture
      proc_pichoose(Name$,FulName$,Pre$,wdth%,hght%,lgth%,pf%)
      Wlim%=((wdth%*3+3)and-4)
      
      rem Scale the picture
      proc_scale(xscreen%,yscreen%,wdth%,hght%,xb%,yb%,xc%,yc%)
      
      rem Display the .bmp as is
      proc_BMP_Disp(xc%,yc%,pf%,xb%,yb%)
      
      colour 3:print tab(5,5);"Press any key or click the mouse to continue."
      proc_event(a$,b&) : cls
      
      rem Set up ASM routines
      proc_setup
      
      rem Select level of colour preservation and of edge heaviness
      proc_split
      
      rem Colour swap versions.
      cls : colour 3 : print tab(15,15);"PLEASE WAIT for a few seconds."
      
      rem Find the Edges
      call mast%
      
      rem Scale the picture
      proc_scale(xscreen%,yscreen%,wdth%,hght%,xb%,yb%,xc%,yc%)
      
      rem Display the processed picture
      proc_BMP_Disp(xc%,yc%,pfmir%,xb%,yb%)
      
      rem Save pictures to disc, at path destination same as source picture
      colour 132:colour 3:print tab(3,3);"Saving Picture"
      
      proc_save(Name$,"E",pfmir%,lgth%,Newpic$)
      
      print tab(5,5);"DONE"
      
      proc_event(a$,b&)
      if b&=4 or a$=" " then run else quit
      quit
      rem End of Program +++++++++++++++++++++++++++++++++++++++++++++++
      rem ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Save picture to disc
      def proc_save(Name$,xt$,pic%,lgth%,return Newpic$)
      local ps&
      
      ps&=instr(Name$,".")
      Newpic$=left$(Name$,(ps&-1))+xt$+".bmp"
      command$=" SAVE "+chr$(34) + Newpic$ +chr$(34) +str$~pic%+" +"+str$~(lgth%)
      oscli command$
      endproc
      rem ========================================================================
      
      rem Set up ASM routines
      def proc_setup
      
      rem Mirror bitmap
      proc_BMP_Set(wdth%,hght%,pfmir%,Wlim%,lgth%)
      
      rem Various Variables
      dim x% 3, q% 3, s% 0, pr% 3, bl% 0, gr% 0, re% 0, h% 0, rs% 0, t% 0
      dim r% 0
      dim exab% 9, s1% 0, s2% 0, s3% 0, s4% 0, rm% 0, mn% 7, bas% 3
      dim max% 0, spl% 7, lev% 0, v% 0, jr% 3, d% 0, df% 3, rf% 3, wrk% 3
      dim assedge% 3000, mast% 2000
      
      |mn%=0.05 : rem Minimum value below which colour split defaults to white
      
      rem Dual-pass assembly, in case of labels
      for pass&=0 to 2 step 2
        proc_assedge(pass&)
        proc_mast(pass&)
      next pass&
      
      endproc
      rem ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Choose percentage split of colours, and heaviness of edging
      def proc_split
      local u%,v%,z&,tt&
      
      mouse on
      
      for tt&=0 to 1
        repeat
          mouse u%,v%,z&
        until z&=0
        
        case tt& of
          when 0:
            cls
            msg$="\10How much colour from the original do you want preserved?"
            proc_msg("Georgia",12,"B",100,fn_adapt(1,900),msg$)
            msg$="\110%"
            proc_msg("Georgia",12,"B",100,fn_adapt(1,750),msg$)
            msg$="\11100%"
            proc_msg("Georgia",12,"B",1300,fn_adapt(1,750),msg$)
            
          when 1:
            cls
            msg$="\10How heavy do you want the edging to be?"
            proc_msg("Georgia",12,"B",100,fn_adapt(1,900),msg$)
            msg$="\11Heavy"
            proc_msg("Georgia",12,"B",50,fn_adapt(1,750),msg$)
            msg$="\11Light"
            proc_msg("Georgia",12,"B",1300,fn_adapt(1,750),msg$)
        endcase
        
        print tab(10,8);pic$
        msg$="\11Move the slider \10below with the mouse. Press the \11left mouse button \10when ready."
        proc_msg("Georgia",12,"B",100,fn_adapt(1,1000),msg$)
        
        vl%=fn_adapt(1,700) : vu%=fn_adapt(1,750)
        mouse rectangle 200,vl%,1000,(vu%-vl%)
        
        rem Move slider control back and forth
        old%=0
        repeat
          mouse u%,v%,z&
          sys "Sleep",10
          if (v%>=vl% and v%<=vu%) then
            if (u%>=200 and u%<=1200) then
              gcol 2 : rectangle fill 200,vl%,(u%-200),(vu%-vl%)
              gcol 0 : rectangle fill (u%+1),vl%,(1200-u%),(vu%-vl%)
              *REFRESH
              
              case tt& of
                when 0:
                  |spl%=0.0+(u%-200)/1000
                  
                  vvl%=int(100*(|spl%))
                  msg$="\4"+str$(old%)+"%  "
                  proc_msg("Georgia",12,"B",300,fn_adapt(1,850),msg$)
                  
                  msg$="\9"+str$(vvl%)+"%  "
                  proc_msg("Georgia",12,"B",300,fn_adapt(1,850),msg$)
                  old%=vvl%
                  !bas%=int(250*(1-|spl%))
                when 1:
                  msg$="\4"+str$(old%)+"/55  "
                  proc_msg("Georgia",12,"B",300,fn_adapt(1,850),msg$)
                  
                  ?max%=5+int(0.5*(u%-200)/10)
                  msg$="\9"+str$(?max%)+"/55  "
                  proc_msg("Georgia",12,"B",300,fn_adapt(1,850),msg$)
                  old%=?max%
              endcase
              *REFRESH
            endif
          endif
        until z&=4
        
        msg$="\11Split FIXED."
        proc_msg("Georgia",12,"B",300,fn_adapt(1,650),msg$)
        
        a$=inkey$(100)
        vdu 26
      next tt&
      mouse rectangle off
      
      mouse off
      endproc
      rem ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Edge Identifier - Assembly Routine
      def proc_assedge(opt&)
      P%=assedge%
      [opt opt&
      
      mov al,0
      mov [d%],al
      .rep
      mov ebx,0
      mov eax,[pr%]           ;Calculate dfault reference, df%
      mov bl,[d%]
      add eax,ebx
      mov [df%],eax           ;df%= pr%+d%
      mov [rf%],eax           ;Dfault vlue 0f rf% also pr%+d%
      
      mov cl,pf%[eax]         ;eax=rf% at this point
      mov edx,0
      .again
      mov exab%[edx],cl       ;Load up exab%n, (n=0 t0 8) with vlue 0f current pixel
      inc edx
      cmp edx,8
      jle again
      
      mov [wrk%],cl           ;Calculate c0lour vlue
      finit
      fld qword [spl%]
      fld qword [mn%]
      fcomp st1
      fstsw ax
      and ah,1
      cmp ah,1
      je fix
      fstp st0
      mov ebx,250
      jmp misfix
      .fix
      fild dword [wrk%]
      fmulp st1,st0
      fistp dword [wrk%]
      mov ebx,[wrk%]
      add ebx,[bas%]
      .misfix
      mov [wrk%],ebx          ;Save c0lour vlue
      
      mov eax,[^k%]            ;If k%<wid% do flwng
      cmp eax,[^wdth%]
      jnl tbigk
      mov ebx,[rf%]
      add ebx,3
      mov cl,pf%[ebx]
      mov edx,5
      mov exab%[edx],cl       ;Update exab%5
      .tbigk
      mov eax,[^k%]           ;If k%>1 do flwng
      cmp eax,1
      jng nowj
      mov ebx,[rf%]
      sub ebx,3
      mov cl,pf%[ebx]
      mov edx,3
      mov exab%[edx],cl       ;Update exab%3
      
      .nowj
      mov eax,[^j%]            ;If j%>1, do following
      cmp eax,1
      jng conta
      mov ebx,[df%]
      sub ebx,[^Wlim%]
      mov [rf%],ebx
      mov cl,pf%[ebx]
      mov edx,1
      mov exab%[edx],cl       ;Update exab%1
      mov eax,[^k%]            ;If also k%<wid% do flwng
      cmp eax,[^wdth%]
      jnl tbig0
      mov ebx,[rf%]
      add ebx,3
      mov cl,pf%[ebx]
      mov edx,2
      mov exab%[edx],cl       ;Update exab%2
      .tbig0
      mov eax,[^k%]            ;If also k%>1 do flwng
      cmp eax,1
      jng conta
      mov ebx,[rf%]
      sub ebx,3
      mov cl,pf%[ebx]
      mov edx,0
      mov exab%[edx],cl       ;Update exab%0
      
      .conta
      mov eax,[^j%]            ;If j%<hei%, do following
      cmp eax,[^hght%]
      jnl contb
      mov ebx,[df%]
      add ebx,[^Wlim%]
      mov [rf%],ebx
      mov cl,pf%[ebx]
      mov edx,7
      mov exab%[edx],cl       ;Update exab%7
      mov eax,[^k%]            ;If also k%<wid% do flwng
      cmp eax,[^wdth%]
      jnl tbig1
      mov ebx,[rf%]
      add ebx,3
      mov cl,pf%[ebx]
      mov edx,8
      mov exab%[edx],cl       ;Update exab%8
      .tbig1 mov eax,[^k%]     ;If also k%>1 do flwng
      cmp eax,1
      jng contb
      mov ebx,[rf%]
      sub ebx,3
      mov cl,pf%[ebx]
      mov edx,6
      mov exab%[edx],cl       ;Update exab%6
      
      .contb
      mov eax,8                ;Calc s1%
      mov ebx,0
      mov cl,exab%[eax]
      sub cl,exab%[ebx]
      jns ntneg1
      neg cl
      .ntneg1
      mov [s1%],cl             ;Calc s1%
      
      mov eax,6                ;Calc s2%
      mov ebx,2
      mov cl,exab%[eax]
      sub cl,exab%[ebx]
      jns ntneg2
      neg cl
      .ntneg2
      mov [s2%],cl             ;Calc s2%
      
      mov eax,7                ;Calc s3%
      mov ebx,1
      mov cl,exab%[eax]
      sub cl,exab%[ebx]
      jns ntneg3
      neg cl
      .ntneg3
      mov [s3%],cl             ;Calc s3%
      
      mov eax,5                ;Calc s4%
      mov ebx,3
      mov cl,exab%[eax]
      sub cl,exab%[ebx]
      jns ntneg4
      neg cl
      .ntneg4
      mov [s4%],cl             ;Calc s4%
      
      mov bl,0                 ;Calc rm%.If rm%>0 there is an edge
      mov al,[s1%]
      cmp al,[max%]
      jng miss1
      inc bl
      .miss1
      mov al,[s2%]
      cmp al,[max%]
      jng miss2
      inc bl
      .miss2
      mov al,[s3%]
      cmp al,[max%]
      jng miss3
      inc bl
      .miss3
      mov al,[s4%]
      cmp al,[max%]
      jng miss4
      inc bl
      .miss4
      mov [rm%],bl            ;Calc rm%.If rm%>0 there is an edge
      
      cmp bl,0                ;Adjust Colours accordingly
      je noadd
      mov cl,0
      mov al,4
      sub al,bl
      cmp al,0
      je adds
      add cl,50
      dec al
      cmp al,0
      je adds
      add cl,50
      dec al
      cmp al,0
      je adds
      add cl,50
      jmp adds
      .noadd
      mov cl,[wrk%]           ;Retrieve the c0lour vlue calculated above.
      .adds
      mov eax,4
      mov exab%[eax],cl       ;Adjust Colours accordingly
      
      mov ebx,[pr%]
      mov ecx,0
      mov cl,[d%]
      add ebx,ecx
      mov cl,exab%[eax]
      mov pfmir%[ebx],cl      ;Adjust Colours accordingly
      
      inc byte [d%]
      mov al,[d%]
      cmp al,3
      jl near rep
      
      ret
      ]
      endproc
      
      rem Never called Procedure
      rem Just details what is coded in Assembly Language above
      def proc_dump
      
      exab%?4=pf%?(!pr%+?d%) : rem Done
      
      exab%?0=exab%?4        : rem Done
      exab%?1=exab%?4        : rem Done
      exab%?2=exab%?4        : rem Done
      exab%?3=exab%?4        : rem Done
      exab%?5=exab%?4        : rem Done
      exab%?6=exab%?4        : rem Done
      exab%?7=exab%?4        : rem Done
      exab%?8=exab%?4        : rem Done
      
      if !k%>1 then exab%?3=pf%?(!pr%+?d%-3)       : rem Done
      if !k%<(!wid%) then exab%?5=pf%?(!pr%+?d%+3) : rem Done
      
      if !j%>1 then
        exab%?1=pf%?(!pr%+?d%-!jr%) : rem Done
        if !k%>1 then exab%?0=pf%?(!pr%+?d%-!jr%-3)       : rem Done
        if !k%<(!wid%) then exab%?2=pf%?(!pr%+?d%-!jr%+3) : rem Done
      endif
      
      if !j%<(!hei%) then
        exab%?7=pf%?(!pr%+?d%+!jr%) : rem Done
        if !k%<(!wid%) then exab%?8=pf%?(!pr%+?d%+!jr%+3) : rem Done
        if !k%>1 then exab%?6=pf%?(!pr%+?d%+!jr%-3)       : rem Done
      endif
      
      ?s1%=abs(exab%?8-exab%?0) : ?s2%=abs(exab%?6-exab%?2) : rem Done
      ?s3%=abs(exab%?7-exab%?1) : ?s4%=abs(exab%?5-exab%?3) : rem Done
      
      ?rm%=-(?s1%>?max%)-(?s2%>?max%)-(?s3%>?max%)-(?s4%>?max%) : rem Done
      if ?rm%>0 then exab%?4=(4-?rm%)*50 else exab%?4=127+(exab%?4)/2 : rem Done
      
      pfmir%?(!pr%+?d%)=exab%?4 : rem Done
      endproc
      
      rem ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Master Loop - Assembly Routine
      def proc_mast(opt&)
      P%=mast%
      [opt opt&
      
      mov edx,0
      mov [^j%],edx
      
      .ocirc
      mov edx,0
      mov [^k%],edx             ;Initialise loop control
      
      .circ
      mov eax,[^j%]
      imul eax,[^Wlim%]
      add eax,[^k%]
      add eax,[^k%]
      add eax,[^k%]
      add eax,54
      mov [pr%],eax            ;Calc pr%
      
      call assedge%
      
      inc dword [^k%]
      mov edx,[^k%]
      cmp edx,[^wdth%]
      jb near circ
      
      inc dword [^j%]
      mov edx,[^j%]
      cmp edx,[^hght%]
      jb near ocirc
      
      ret
      ]
      endproc