rem LOMO Effects (ASM version) ............. Rev 3.0
      rem A J Tooth // August 2008
      
      rem ====================================================================
      rem Emulates idiosyncratic effects of Russian Lomo cameras.
      rem ====================================================================
      
      rem Preamble==================================
      on error if (err=17) then quit
      *FLOAT 64
      himem=lomem + 200000000
      install @lib$+"MyUtils.bbc"
      install @lib$+"BMP_Utils.bbc"
      rem Preamble==================================
      
      rem Set up initial screen
      proc_setup
      
      repeat
        
        rem Select a menu item
        Ch&=fn_select
        
        case Ch& of
          when 1: cls : proc_initial : if Z%=0 then proc_setup2 : Z%=1
          when 2: NoCh&=0 : Rev&=1 : proc_action(1)
          when 3: NoCh&=0 : Rev&=1 : proc_action(2)
          when 4: NoCh&=0 : Rev&=1 : proc_action(3)
          when 5: NoCh&=0 : Rev&=1 : proc_action(4)
          when 6: NoCh&=0 : Rev&=1 : proc_action(5)
          when 7: proc_revert
          when 8: proc_original
          when 9: proc_save(Name$,"LO",picworkold%,lgth%,Newpic$)
          when 10: rem Exit loop and QUIT
        endcase
        
      until Ch&=Buts&
      
      quit
      rem End of Program =============================================
      rem ============================================================
      
      rem Set up initial screen
      def proc_setup
      local a&,b&
      
      rem Maximise screen
      proc_maxim(xscreen%,yscreen%) : colour 132,50,0,50 : colour 132: cls
      
      rem Change the Windows Title
      title$ = " LOMO Effects"
      sys "SetWindowText", @hwnd%, title$
      
      Flg&=1  : rem 1=use original 2=work on revised
      Buts&=10 : rem Number of buttons
      Frst&=1 : rem Frst&=1 indicates no base picture yet selected
      NoCh&=1 : rem NoCh&=1 indicates no processing yet taken place
      Rev&=0  : rem No Revert
      
      rem Standard grey-scale weightings
      wr=0.299 : wg=0.587 : wb=0.114
      
      dim conv(2,2), cinv(2,2), rgb(2), yuv(2), cum(2)
      
      rem Read in RGB/YUV conversion data
      restore
      for a&=0 to 2
        for b&=0 to 2
          read conv(a&,b&)
        next b&
      next a&
      conv()*=1.0
      
      for a&=0 to 2
        for b&=0 to 2
          read cinv(a&,b&)
        next b&
      next a&
      cinv()*=1.0
      
      rem Set up TWO OVERSIZED mirror bitmaps according
      rem Avoids need to re-DIM
      proc_BMP_Set(4000,3000,picworkold%,ntused%,ntused%)
      proc_BMP_Set(4000,3000,picworknew%,ntused%,ntused%)
      
      endproc
      rem ============================================================
      
      rem RGB / YUV Conversion factors
      data 0.299,0.587,0.114,-0.14713,-0.28886,0.436,0.615,-0.51499,-0.10001
      data 1.0,0.0,1.13983,1.0,-0.39465,-0.58060,1.0,2.03211,0.0
      
      rem ============================================================
      
      rem ASM setup
      def proc_setup2
      local pass&
      
      dim vignette% 1000, desaturate% 1000, saturate% 1000, contrast% 2000, blur% 1500, itmp% 3
      
      rem Various constants
      i2%=2
      i3%=3
      i255%=255
      f2=1.75
      f05=0.5
      f14=1.4
      i24%=24
      i8%=8
      i9%=9
      
      rem Dual-pass assembly, in case of labels
      for pass&=0 to 2 step 2
        proc_Vign(pass&)
        proc_Desat(pass&)
        proc_Satur(pass&)
        proc_Contra(pass&)
        proc_Blur(pass&)
      next pass&
      
      endproc
      rem ============================================================
      
      rem Select an action
      def fn_select
      local a&
      
      msg$="\3MENU OF LOMO EFFECTS"
      proc_msg("Georgia",12,"B",50,fn_adapt(1,1500),msg$)
      msg$="\2======================================"
      proc_msg("Georgia",12,"",50,fn_adapt(1,1450),msg$)
      
      if Flg&=1 then
        dim butt{ch$(Buts&),state&(Buts&)}
        
        rem Button messages
        butt.ch$(1)="\3Select \2NEW \3picture"
        butt.ch$(2)="\3Vignette"
        butt.ch$(3)="\3Contrast"
        butt.ch$(4)="\3Desaturate"
        butt.ch$(5)="\3Saturate"
        butt.ch$(6)="\3Blur"
        butt.ch$(7)="\3Undo"
        butt.ch$(8)="\3Original"
        butt.ch$(9)="\2SAVE \3current picture"
        butt.ch$(10)="\1EXIT"
        
        rem Disallow functions before picture selected
        if Frst&=1 then
          butt.state&(1)=1
          butt.state&(2)=0
          butt.state&(3)=0
          butt.state&(4)=0
          butt.state&(5)=0
          butt.state&(6)=0
          butt.state&(7)=0
          butt.state&(8)=0
          butt.state&(9)=0
          butt.state&(10)=1
        else
          for a&=1 to Buts&
            butt.state&(a&)=1
          next a&
          if NoCh&=1 then butt.state&(7)=0 : butt.state&(8)=0 : butt.state&(9)=0
          butt.state&(7)=Rev&
        endif
      else
        rem Reset all other functions to be allowed
        for a&=1 to Buts&
          butt.state&(a&)=1
        next a&
        butt.state(7)=Rev&
      endif
      
      cc&=0
      repeat
        rem Get reference for a pressed button
        cc&=fn_getbut("Georgia",12,"",butt{},50,fn_adapt(1,1300),100,Buts&)
        sys "Sleep",10
      until cc&<>0
      =cc&
      rem ==================================================================
      
      rem Select the initial picture
      def proc_initial
      
      rem Choose a picture to work with, and convert to .bmp
      proc_pichoose(Name$,FulName$,Pre$,wdth%,hght%,lgth%,picorig%)
      
      Wlim%=(wdth%*3+3)and-4
      
      rem Display it "as is"
      proc_scale(3*xscreen%/4,3*yscreen%/4,wdth%,hght%,xb%,yb%,xc%,yc%)
      proc_BMP_Disp(xc%,yc%,picorig%,xscreen%/4+xb%,yscreen%/8+yb%)
      
      rem Copy a fixed number of bytes to another location
      proc_recopy(picorig%,picworkold%,lgth%)
      proc_recopy(picorig%,picworknew%,lgth%)
      
      Temp$=Pre$+"Temp.bmp"
      
      Frst&=0
      
      endproc
      rem ==================================================================
      
      rem Original picture
      def proc_original
      
      rem Copy a fixed number of bytes to another location
      proc_recopy(picorig%+54,picworkold%+54,lgth%-54)
      
      rem Display original picture
      proc_BMP_Disp(xc%,yc%,picworkold%,xscreen%/4+xb%,yscreen%/8+yb%)
      
      Rev&=0
      endproc
      rem ==================================================================
      
      rem Original picture
      def proc_revert
      
      Newpic$="temp.bmp"
      command$=" LOAD "+chr$(34) + Newpic$ +chr$(34) +str$~picworkold%+" +"+str$~(lgth%)
      oscli command$
      
      rem Display previous picture
      proc_BMP_Disp(xc%,yc%,picworkold%,xscreen%/4+xb%,yscreen%/8+yb%)
      
      Rev&=0
      endproc
      rem ==================================================================
      
      rem Actions
      def proc_action(Ctr&)
      local x%,y%,a&,v,v&,ref%,xm,ym,fac
      
      rem Save old picture to temporarily disc
      proc_tempsave(picworkold%,lgth%)
      
      rem Perform chosen action
      case Ctr& of
        when 1 : call vignette%
        when 2 : call contrast%
        when 3 : call desaturate%
        when 4 : call saturate%
        when 5 : call blur%
      endcase
      
      rem Show new picture
      proc_show
      
      endproc
      rem ==================================================================
      
      rem Save picture to temporarily disc
      def proc_tempsave(pic%,lgth%)
      
      Newpic$="temp.bmp"
      command$=" SAVE "+chr$(34) + Newpic$ +chr$(34) +str$~pic%+" +"+str$~(lgth%)
      oscli command$
      endproc
      rem ========================================================================
      
      rem Show new picture
      def proc_show
      
      rem Copy a fixed number of bytes to another location
      proc_recopy(picworknew%+54,picworkold%+54,lgth%-54)
      
      rem Display result
      proc_BMP_Disp(xc%,yc%,picworkold%,xscreen%/4+xb%,yscreen%/8+yb%)
      endproc
      rem ========================================================================
      
      rem Vignette Routine
      def proc_Vign(opt&)
      
      P%=vignette%
      [opt opt&
      
      mov edx,0
      mov [^y%],edx
      
      .vyloop
      mov eax,[^y%]
      imul eax,[^Wlim%]
      add eax,54
      
      mov edx,0
      mov [^x%],edx
      
      .vxloop
      mov [^ref%],eax
      
      finit
      fild dword [^x%]
      fild dword [^wdth%]
      fild dword [^i2%]
      fdivp st1,st0
      fsubp st1,st0
      fild dword [^wdth%]
      fdivp st1,st0
      fild dword [^i2%]
      fmulp st1,st0
      fabs
      fstp qword [^xm]
      
      fild dword [^y%]
      fild dword [^hght%]
      fild dword [^i2%]
      fdivp st1,st0
      fsubp st1,st0
      fild dword [^hght%]
      fdivp st1,st0
      fld qword [^f2]
      fmulp st1,st0
      fabs
      fstp qword [^ym]
      
      fld qword [^xm]
      fld qword [^ym]
      fmulp st1,st0
      fmul st0,st0
      fld1
      fsubrp st1,st0
      fstp qword [^fac]
      
      mov ebx,0
      mov eax,[^ref%]
      mov bl,picworkold%[eax]
      mov [itmp%],ebx
      fild dword [itmp%]
      fld qword [^fac]
      fmulp st1,st0
      fistp dword [itmp%]
      mov ebx,[itmp%]
      mov picworknew%[eax],bl
      
      mov bl,picworkold%[eax+1]
      mov [itmp%],ebx
      fild dword [itmp%]
      fld qword [^fac]
      fmulp st1,st0
      fistp dword [itmp%]
      mov ebx,[itmp%]
      mov picworknew%[eax+1],bl
      
      mov bl,picworkold%[eax+2]
      mov [itmp%],ebx
      fild dword [itmp%]
      fld qword [^fac]
      fmulp st1,st0
      fistp dword [itmp%]
      mov ebx,[itmp%]
      mov picworknew%[eax+2],bl
      
      add eax,3
      
      inc dword [^x%]
      mov edx,[^x%]
      cmp edx,[^wdth%]
      jb near vxloop
      
      inc dword [^y%]
      mov edx,[^y%]
      cmp edx,[^hght%]
      jb near vyloop
      
      ret
      ]
      endproc
      rem ======================================================================
      
      rem Coded into ASM
      def proc_dump_Vign
      
      for y%=0 to hght%-1
        for x%=0 to wdth%-1
          
          ref%=y%*Wlim% + 3*x% + 54
          
          xm=abs(2*(x%-wdth%/2)/wdth%) : ym=abs(2*(y%-hght%/2)/hght%)
          
          fac=1-(xm*ym)^2
          
          for a&=0 to 2
            v=1.0*?(picworkold% + ref% + a&)
            v&=int(v*fac)
            ?(picworknew% + ref% + a&)=v&
          next a&
        next x%
      next y%
      endproc
      rem ======================================================================
      
      rem Desaturate Routine
      def proc_Desat(opt&)
      
      P%=desaturate%
      [opt opt&
      
      mov edx,0
      mov [^y%],edx
      
      .dyloop
      mov eax,[^y%]
      imul eax,[^Wlim%]
      add eax,54
      mov edx,0
      mov [^x%],edx
      
      .dxloop
      mov [^ref%],eax
      
      mov ebx,0
      mov bl,picworkold%[eax]
      mov [^b&],bl
      mov [itmp%],ebx
      fild dword [itmp%]
      fld qword [^wb]
      fmulp st1,st0
      
      mov bl,picworkold%[eax+1]
      mov [^g&],bl
      mov [itmp%],ebx
      fild dword [itmp%]
      fld qword [^wg]
      fmulp st1,st0
      
      mov bl,picworkold%[eax+2]
      mov [^r&],bl
      mov [itmp%],ebx
      fild dword [itmp%]
      fld qword [^wr]
      fmulp st1,st0
      
      faddp st1,st0
      faddp st1,st0
      fstp qword [^v]
      
      mov bl,[^b&]
      mov [itmp%],ebx
      fild dword [itmp%]
      fild dword [^i2%]
      fmulp st1,st0
      fld qword [^v]
      faddp st1,st0
      fild dword [^i3%]
      fdivp st1,st0
      fistp dword [itmp%]
      mov ebx,[itmp%]
      mov picworknew%[eax],bl
      
      mov bl,[^g&]
      mov [itmp%],ebx
      fild dword [itmp%]
      fild dword [^i2%]
      fmulp st1,st0
      fld qword [^v]
      faddp st1,st0
      fild dword [^i3%]
      fdivp st1,st0
      fistp dword [itmp%]
      mov ebx,[itmp%]
      mov picworknew%[eax+1],bl
      
      mov bl,[^r&]
      mov [itmp%],ebx
      fild dword [itmp%]
      fild dword [^i2%]
      fmulp st1,st0
      fld qword [^v]
      faddp st1,st0
      fild dword [^i3%]
      fdivp st1,st0
      fistp dword [itmp%]
      mov ebx,[itmp%]
      mov picworknew%[eax+2],bl
      
      add eax,3
      
      inc dword [^x%]
      mov edx,[^x%]
      cmp edx,[^wdth%]
      jb near dxloop
      
      inc dword [^y%]
      mov edx,[^y%]
      cmp edx,[^hght%]
      jb near dyloop
      
      ret
      ]
      endproc
      rem ======================================================================
      
      rem Coded into ASM
      def proc_dump_Desat
      
      for y%=0 to hght%-1
        for x%=0 to wdth%-1
          
          ref%=y%*Wlim% + 3*x% + 54
          
          b&=?(picworkold% + ref%)
          g&=?(picworkold% + ref% + 1)
          r&=?(picworkold% + ref% + 2)
          
          v=wr*r& + wg*g& + wb*b&
          
          b&=int((2*b&+v)/3)
          g&=int((2*g&+v)/3)
          r&=int((2*r&+v)/3)
          
          ?(picworknew% + ref%) = b&
          ?(picworknew% + ref% + 1) = g&
          ?(picworknew% + ref% + 2) = r&
          
        next x%
      next y%
      
      endproc
      rem ======================================================================
      
      rem Desaturate Routine
      def proc_Satur(opt&)
      
      P%=saturate%
      [opt opt&
      
      mov edx,0
      mov [^y%],edx
      
      .syloop
      mov eax,[^y%]
      imul eax,[^Wlim%]
      add eax,54
      
      mov edx,0
      mov [^x%],edx
      
      .sxloop
      mov [^ref%],eax
      
      mov ebx,0
      mov bl,picworkold%[eax]
      mov [itmp%],ebx
      fild dword [itmp%]
      fld qword [^wb]
      fmulp st1,st0
      
      mov bl,picworkold%[eax+1]
      mov [itmp%],ebx
      fild dword [itmp%]
      fld qword [^wg]
      fmulp st1,st0
      
      mov bl,picworkold%[eax+2]
      mov [itmp%],ebx
      fild dword [itmp%]
      fld qword [^wr]
      fmulp st1,st0
      
      faddp st1,st0
      faddp st1,st0
      fstp qword [^v]
      
      mov ebx,0
      mov bl,picworkold%[eax]
      mov [itmp%],ebx
      fild dword [itmp%]
      fild dword [^i3%]
      fmulp st1,st0
      fld qword [^v]
      fsubp st1,st0
      fild dword [^i2%]
      fdivp st1,st0
      fistp dword [itmp%]
      mov ebx,[itmp%]
      cmp ebx,255
      jle bhok
      mov ebx,255
      jmp blok
      .bhok
      cmp ebx,0
      jge blok
      mov ebx,0
      .blok
      mov picworknew%[eax],bl
      
      mov ebx,0
      mov bl,picworkold%[eax+1]
      mov [itmp%],ebx
      fild dword [itmp%]
      fild dword [^i3%]
      fmulp st1,st0
      fld qword [^v]
      fsubp st1,st0
      fild dword [^i2%]
      fdivp st1,st0
      fistp dword [itmp%]
      mov ebx,[itmp%]
      cmp ebx,255
      jle ghok
      mov ebx,255
      jmp glok
      .ghok
      cmp ebx,0
      jge glok
      mov ebx,0
      .glok
      mov picworknew%[eax+1],bl
      
      mov ebx,0
      mov bl,picworkold%[eax+2]
      mov [itmp%],ebx
      fild dword [itmp%]
      fild dword [^i3%]
      fmulp st1,st0
      fld qword [^v]
      fsubp st1,st0
      fild dword [^i2%]
      fdivp st1,st0
      fistp dword [itmp%]
      mov ebx,[itmp%]
      cmp ebx,255
      jle rhok
      mov ebx,255
      jmp rlok
      .rhok
      cmp ebx,0
      jge rlok
      mov ebx,0
      .rlok
      mov picworknew%[eax+2],bl
      
      add eax,3
      
      inc dword [^x%]
      mov edx,[^x%]
      cmp edx,[^wdth%]
      jb near sxloop
      
      inc dword [^y%]
      mov edx,[^y%]
      cmp edx,[^hght%]
      jb near syloop
      
      ret
      ]
      endproc
      rem ======================================================================
      
      rem Coded into ASM
      def proc_dump_Satur
      
      for y%=0 to hght%-1
        for x%=0 to wdth%-1
          
          ref%=y%*Wlim% + 3*x% + 54
          
          b&=?(picworkold% + ref%)
          g&=?(picworkold% + ref% + 1)
          r&=?(picworkold% + ref% + 2)
          
          v=wr*r& + wg*g& + wb*b&
          
          b%=int((3*b&-v)/2)
          g%=int((3*g&-v)/2)
          r%=int((3*r&-v)/2)
          
          if b%>255 then b%=255
          if g%>255 then g%=255
          if r%>255 then r%=255
          
          if b%<0 then b%=0
          if g%<0 then g%=0
          if r%<0 then r%=0
          
          b&=b% : g&=g% : r&=r%
          
          ?(picworknew% + ref%) = b&
          ?(picworknew% + ref% + 1) = g&
          ?(picworknew% + ref% + 2) = r&
          
        next x%
      next y%
      
      endproc
      rem ======================================================================
      
      rem Contrast Routine
      def proc_Contra(opt&)
      
      P%=contrast%
      [opt opt&
      
      mov edx,0
      mov [^y%],edx
      
      .cyloop
      mov eax,[^y%]
      imul eax,[^Wlim%]
      add eax,54
      mov edx,0
      mov [^x%],edx
      
      .cxloop
      mov [^ref%],eax
      
      finit
      mov ebx,0
      mov bl,picworkold%[eax]
      mov [itmp%],ebx
      fild dword [itmp%]
      fild dword [^i255%]
      fdivp st1,st0
      fstp qword [^rgb(2)]
      
      mov bl,picworkold%[eax+1]
      mov [itmp%],ebx
      fild dword [itmp%]
      fild dword [^i255%]
      fdivp st1,st0
      fstp qword [^rgb(1)]
      
      mov bl,picworkold%[eax+2]
      mov [itmp%],ebx
      fild dword [itmp%]
      fild dword [^i255%]
      fdivp st1,st0
      fstp qword [^rgb(0)]
      
      fldz
      fst qword [^yuv(0)]
      fst qword [^yuv(1)]
      fstp qword [^yuv(2)]
      
      mov dl,0
      mov [^aa&],dl
      
      .aaloop
      mov dl,0
      mov [^bb&],dl
      
      .bbloop
      mov eax,0
      mov al,[^aa&]
      imul eax,24
      mov ebx,0
      mov bl,[^bb&]
      shl ebx,3
      add eax,ebx
      
      fld qword (^conv(0,0))[eax]
      mov ebx,0
      mov bl,[^bb&]
      shl bl,3
      fld qword (^rgb(0))[ebx]
      fmulp st1,st0
      mov eax,0
      mov al,[^aa&]
      shl al,3
      fld qword (^yuv(0))[eax]
      faddp st1,st0
      fstp qword (^yuv(0))[eax]
      
      inc byte [^bb&]
      mov dl,[^bb&]
      cmp dl,2
      jbe near bbloop
      
      inc byte [^aa&]
      mov dl,[^aa&]
      cmp dl,2
      jbe near aaloop
      
      fld qword [^yuv(0)]
      fld qword [^f05]
      fsubp st1,st0
      fld qword [^f14]
      fmulp st1,st0
      fld qword [^f05]
      faddp st1,st0
      fstp qword [^yuv(0)]
      
      fldz
      fst qword [^rgb(0)]
      fst qword [^rgb(1)]
      fstp qword [^rgb(2)]
      
      mov dl,0
      mov [^a&],dl
      
      .aloop
      mov dl,0
      mov [^b&],dl
      
      .bloop
      mov eax,0
      mov al,[^a&]
      imul eax,24
      mov ebx,0
      mov bl,[^b&]
      shl ebx,3
      add eax,ebx
      
      fld qword (^cinv(0,0))[eax]
      mov ebx,0
      mov bl,[^b&]
      shl bl,3
      fld qword (^yuv(0))[ebx]
      fmulp st1,st0
      mov eax,0
      mov al,[^a&]
      shl al,3
      fld qword (^rgb(0))[eax]
      faddp st1,st0
      fstp qword (^rgb(0))[eax]
      
      inc byte [^b&]
      mov dl,[^b&]
      cmp dl,2
      jbe near bloop
      
      inc byte [^a&]
      mov dl,[^a&]
      cmp dl,2
      jbe near aloop
      
      mov eax,[^ref%]
      
      fld qword [^rgb(2)]
      fild dword [^i255%]
      fmulp st1,st0
      fistp dword [itmp%]
      mov ebx,[itmp%]
      cmp ebx,255
      jle bbhok
      mov ebx,255
      jmp bblok
      .bbhok
      cmp ebx,0
      jge bblok
      mov ebx,0
      .bblok
      mov picworknew%[eax],bl
      
      fld qword [^rgb(1)]
      fild dword [^i255%]
      fmulp st1,st0
      fistp dword [itmp%]
      mov ebx,[itmp%]
      cmp ebx,255
      jle gghok
      mov ebx,255
      jmp gglok
      .gghok
      cmp ebx,0
      jge gglok
      mov ebx,0
      .gglok
      mov picworknew%[eax+1],bl
      
      fld qword [^rgb(0)]
      fild dword [^i255%]
      fmulp st1,st0
      fistp dword [itmp%]
      mov ebx,[itmp%]
      cmp ebx,255
      jle rrhok
      mov ebx,255
      jmp rrlok
      .rrhok
      cmp ebx,0
      jge rrlok
      mov ebx,0
      .rrlok
      mov picworknew%[eax+2],bl
      
      add eax,3
      
      inc dword [^x%]
      mov edx,[^x%]
      cmp edx,[^wdth%]
      jb near cxloop
      
      inc dword [^y%]
      mov edx,[^y%]
      cmp edx,[^hght%]
      jb near cyloop
      
      ret
      ]
      endproc
      rem ======================================================================
      
      rem Coded into ASM
      def proc_dump_Contra
      
      for y%=0 to hght%-1
        for x%=0 to wdth%-1
          
          ref%=y%*Wlim% + 3*x% + 54
          
          rgb(2)=(?(picworkold% + ref%))/255
          rgb(1)=(?(picworkold% + ref% + 1))/255
          rgb(0)=(?(picworkold% + ref% + 2))/255
          
          yuv()=0.0
          for a&=0 to 2
            for b&=0 to 2
              
              yuv(a&)+=conv(a&,b&)*rgb(b&)
              
            next b&
          next a&
          
          y=yuv(0)                         : rem DONE
          y=0.5 + (y-0.5)*1.4              : rem DONE
          
          if y>1.0 then y=1.0              : rem DONE
          if y<0.0 then y=0.0              : rem DONE
          
          yuv(0)=y                         : rem DONE
          
          rgb()=0.0                        : rem DONE
          for a&=0 to 2                    : rem DONE
            for b&=0 to 2                  : rem DONE
              
              rgb(a&)+=cinv(a&,b&)*yuv(b&) : rem DONE
              
            next b&
          next a&
          
          b%=int(rgb(2)*255)         : rem DONE
          g%=int(rgb(1)*255)         : rem DONE
          r%=int(rgb(0)*255)         : rem DONE
          
          if b%>255 then b%=255      : rem DONE
          if g%>255 then g%=255      : rem DONE
          if r%>255 then r%=255      : rem DONE
          
          if b%<0 then b%=0          : rem DONE
          if g%<0 then g%=0          : rem DONE
          if r%<0 then r%=0          : rem DONE
          
          b&=b% : g&=g% : r&=r%      : rem DONE
          
          ?(picworknew% + ref%) = b&        : rem DONE
          ?(picworknew% + ref% + 1) = g&    : rem DONE
          ?(picworknew% + ref% + 2) = r&    : rem DONE
          
        next x%
      next y%
      
      endproc
      rem ======================================================================
      
      rem Blur Routine
      def proc_Blur(opt&)
      
      P%=blur%
      [opt opt&
      
      mov edx,1
      mov [^y%],edx
      
      .blyloop
      mov eax,[^y%]
      imul eax,[^Wlim%]
      add eax,54
      mov edx,1
      mov [^x%],edx
      
      .blxloop
      mov [^ref%],eax
      
      finit
      fild dword [^wdth%]
      fild dword [^i2%]
      fdivp st1,st0
      fild dword [^x%]
      fsubp st1,st0
      fild dword [^wdth%]
      fdivp st1,st0
      fild dword [^i2%]
      fmulp st1,st0
      fmul st0,st0
      
      fild dword [^hght%]
      fild dword [^i2%]
      fdivp st1,st0
      fild dword [^y%]
      fsubp st1,st0
      fild dword [^hght%]
      fdivp st1,st0
      fild dword [^i2%]
      fmulp st1,st0
      fmul st0,st0
      faddp st1,st0
      fild dword [^i2%]
      fdivp st1,st0
      fsqrt
      fild dword [^i3%]
      fmulp st1,st0
      fld1
      fcomp st1
      fstsw ax
      and ah,1
      cmp ah,1
      jne nthi
      fistp dword [itmp%]
      fld1
      .nthi
      fst qword [^rd]
      fild dword [^i8%]
      fmulp st1,st0
      fild dword [^i9%]
      fsubrp st1,st0
      fstp qword [^nrd]
      
      fldz
      fst qword [^cum(0)]
      fst qword [^cum(1)]
      fstp qword [^cum(2)]
      
      mov edx,-1
      mov [^a%],edx
      
      .laloop
      mov edx,-1
      mov [^b%],edx
      
      .lbloop
      mov eax,[^b%]
      imul eax,[^Wlim%]
      add eax,[^a%]
      add eax,[^a%]
      add eax,[^a%]
      add eax,[^ref%]
      
      mov ebx,[^a%]
      cmp ebx,0
      jne nnzero
      mov ebx,[^b%]
      cmp ebx,0
      jne nnzero
      fld qword [^nrd]
      jmp pastit
      .nnzero
      fld qword [^rd]
      
      .pastit
      mov ecx,0
      mov cl,picworkold%[eax]
      mov [itmp%],ecx
      fild dword [itmp%]
      fmul st0,st1
      fld qword [^cum(0)]
      faddp st1,st0
      fstp qword [^cum(0)]
      
      mov cl,picworkold%[eax+1]
      mov [itmp%],ecx
      fild dword [itmp%]
      fmul st0,st1
      fld qword [^cum(1)]
      faddp st1,st0
      fstp qword [^cum(1)]
      
      mov cl,picworkold%[eax+2]
      mov [itmp%],ecx
      fild dword [itmp%]
      fmulp st1,st0
      fld qword [^cum(2)]
      faddp st1,st0
      fstp qword [^cum(2)]
      
      inc dword [^b%]
      mov edx,[^b%]
      cmp edx,1
      jle near lbloop
      
      inc dword [^a%]
      mov edx,[^a%]
      cmp edx,1
      jle near laloop
      
      fild dword [^i9%]
      fld qword [^cum(0)]
      fdiv st0,st1
      fistp dword [^bb%]
      fld qword [^cum(1)]
      fdiv st0,st1
      fistp dword [^gg%]
      fld qword [^cum(2)]
      fdivrp st1,st0
      fistp dword [^rr%]
      
      mov ebx,[^bb%]
      cmp ebx,255
      jle pphok
      mov ebx,255
      jmp pplok
      .pphok
      cmp ebx,0
      jge pplok
      mov ebx,0
      .pplok
      mov [^bb&],bl
      
      mov ebx,[^gg%]
      cmp ebx,255
      jle qqhok
      mov ebx,255
      jmp qqlok
      .qqhok
      cmp ebx,0
      jge qqlok
      mov ebx,0
      .qqlok
      mov [^gg&],bl
      
      mov ebx,[^rr%]
      cmp ebx,255
      jle sshok
      mov ebx,255
      jmp sslok
      .sshok
      cmp ebx,0
      jge sslok
      mov ebx,0
      .sslok
      mov [^rr&],bl
      
      mov eax,[^ref%]
      mov cl,[^bb&]
      mov picworknew%[eax],cl
      mov cl,[^gg&]
      mov picworknew%[eax+1],cl
      mov cl,[^rr&]
      mov picworknew%[eax+2],cl
      
      add eax,3
      
      inc dword [^x%]
      mov edx,[^x%]
      mov ecx,[^wdth%]
      dec ecx
      cmp edx,ecx
      jb near blxloop
      
      inc dword [^y%]
      mov edx,[^y%]
      mov ecx,[^hght%]
      dec ecx
      cmp edx,ecx
      jb near blyloop
      
      ret
      ]
      endproc
      rem ======================================================================
      
      rem Coded into ASM
      def proc_dump_Blur
      
      for y%=1 to hght%-2        : rem DONE
        for x%=1 to wdth%-2      : rem DONE
          
          xm=abs(2*(x%-wdth%/2)/wdth%) : ym=abs(2*(y%-hght%/2)/hght%)       : rem DONE
          
          rd=sqr((xm*xm + ym*ym)/2) : nrd=(9-8*rd)                          : rem DONE
          
          cum()=0.0                                                         : rem DONE
          for a%=-1 to 1                                                    : rem DONE
            for b%=-1 to 1                                                  : rem DONE
              dref%=ref% + b%*Wlim% + 3*a%                                  : rem DONE
              bb&=?(picworkold%+dref%)                                      : rem DONE
              if a%<>0 or b%<>0 then cum(0)+=rd*bb& else cum(0)+=nrd*bb&    : rem DONE
              gg&=?(picworkold%+dref%+1)                                    : rem DONE
              if a%<>0 or b%<>0 then cum(1)+=rd*gg& else cum(1)+=nrd*gg&    : rem DONE
              rr&=?(picworkold%+dref%+2)                                    : rem DONE
              if a%<>0 or b%<>0 then cum(2)+=rd*rr& else cum(2)+=nrd*rr&    : rem DONE
            next b%
          next a%
          cum()/=9                           : rem DONE
          
          bb%=int(cum(0))                    : rem DONE
          gg%=int(cum(1))                    : rem DONE
          rr%=int(cum(2))                    : rem DONE
          
          if bb%>255 then bb%=255            : rem DONE
          if gg%>255 then gg%=255            : rem DONE
          if gg%>255 then gg%=255            : rem DONE
          
          if bb%<0 then bb%=0                : rem DONE
          if gg%<0 then gg%=0                : rem DONE
          if rr%<0 then rr%=0                : rem DONE
          
          bb&=bb% : gg&=gg% : rr&=rr%        : rem DONE
          
          ref%=y%*Wlim% + 3*x% + 54          : rem DONE
          
          ?(picworknew% + ref%) = bb&        : rem DONE
          ?(picworknew% + ref% + 1) = gg&    : rem DONE
          ?(picworknew% + ref% + 2) = rr&    : rem DONE
          
        next x%
      next y%
      
      endproc
      rem ======================================================================