rem Glass ......... Rev 5.2
      rem A J Tooth // May 2005
      
      rem ====================================================================
      rem Gives the effect of looking at a second bmp through
      rem a stained glass window bearing the first.
      rem ====================================================================
      
      rem ====================================================================
      on error if (err=17) then quit
      *FLOAT64
      himem=lomem + 100000000
      install @lib$+"MyUtils.bbc"
      install @lib$+"BMP_Utils.bbc"
      rem ====================================================================
      
      rem Setup parameters
      proc_setup
      
      rem Get two pictures
      proc_TwoPics
      
      rem Second pass setup
      proc_setup2
      
      rem Combine the pictures into one new one
      sys "GetCurrentProcess"to hprocess%
      sys "SetPriorityClass",hprocess%,&100
      
      call master%
      
      sys "GetCurrentProcess" to hprocess%
      sys "SetPriorityClass",hprocess%,&20
      
      rem Display the combined picture in full screen
      proc_BMP_DispB(xscreen%,yscreen%,pfn%)
      
      proc_save(pic1$,"Combi",pfn%,lgth%,Newpic$)
      colour 132 : colour 3:
      print tab(1,1);"File saved as: ";Newpic$
      
      proc_mclick(mc&) : rem Wait for a mouse click
      if mc&=4 then run else quit
      end
      rem End of Program +++++++++++++++++++++++++++++++++++++++++++++++++++++
      rem ====================================================================
      
      rem Setup parameters, reserve memory and compile assembly code
      def proc_setup
      
      rem Maximise screen
      proc_maxim(xscreen%,yscreen%)
      colour 3 : colour 132,50,0,0 : colour 132 : cls : off
      
      rem Change the Windows Title
      title$ = " GLASS by Tony Tooth"
      sys "SetWindowText", @hwnd%, title$
      
      rem Display a background picture
      proc_BackPic("Combi.jpg",xscreen%,yscreen%)
      
      colour 8,200,100,100
      msg$="\8Glass"
      proc_msg("Chiller",144,"B",fn_adapt(0,800),fn_adapt(1,1200),msg$)
      
      colour 9,200,100,0
      msg$="\10Do you prefer \12dark \10or \11light \10areas to be preferentially \9TRANSPARENT \10in the first picture?"
      proc_msg("Chiller",24,"B",100,fn_adapt(1,400),msg$)
      
      msg$="\10Press -\12d\10- (or left-click) or -\11l\10- (or right-click) now."
      proc_msg("Chiller",24,"B",100,fn_adapt(1,350),msg$)
      
      repeat
        in$=inkey$(1)
        mouse x,y,b%
      until (in$="d" or in$="l" or b%=4 or b%=1)
      if (in$="l" or b%=1) then in&=0 else in&=1
      endproc
      rem ====================================================================
      
      rem Second pass setup
      def proc_setup2
      
      rem Mirror bitmap
      proc_BMP_Set(wdth%,hght%,pfn%,Wlim%,lgth%)
      
      dim master% 1500, itmp% 3
      
      rem Grey scale weights
      wr=0.30 : wg=0.59 : wb=0.11
      
      rem Dual-pass Assembly
      for pass&=0 to 2 step 2
        
        proc_master(pass&)
      next pass&
      
      endproc
      rem ====================================================================
      
      rem Choose two pictures to combine
      def proc_TwoPics
      local ho%,ve%,bt%
      
      proc_fullscreen(xscreen%,yscreen%)
      colour 132,50,0,0 : colour 132 : cls
      
      rem First picture
      proc_pichooseSZ(Name$,FulName$,Pre$,wdth%,hght%,lgth%)
      
      pic1$=Name$
      fil1$=FulName$
      
      proc_gendisp(1,FulName$,0,0,wdth%,hght%,pf%,lgth%)
      
      proc_mclick(mc&) : rem Wait for a mouse click
      
      rem Second picture
      proc_pichooseSZ(Name$,FulName$,Pre$,wdth%,hght%,lgth%)
      
      pic2$=Name$
      fil2$=FulName$
      
      proc_gendisp(1,FulName$,0,0,wdth%,hght%,pf2%,lgth%)
      
      proc_mclick(mc&) : rem Wait for a mouse click
      
      endproc
      rem ====================================================================
      
      rem Master routine
      def proc_master(opt&)
      
      P%=master%
      [opt opt&
      
      mov edx,0
      mov [^j%],edx
      .jloop
      
      mov edx,0
      mov [^k%],edx
      .kloop
      
      mov eax,[^j%]          ;Calculate pr%
      imul eax,[^Wlim%]
      mov ebx,[^k%]
      add eax,ebx
      add eax,ebx
      add eax,ebx
      add eax,54
      
      finit
      mov ebx,0             ;Calculate percent split
      mov bl,pf%[eax]
      mov [itmp%],ebx
      fild dword [itmp%]
      fld qword [^wb]
      fmulp st1,st0         ;Blue result 0n stack
      
      mov bl,pf%[eax+1]
      mov [itmp%],ebx
      fild dword [itmp%]
      fld qword [^wg]
      fmulp st1,st0         ;Green result 0n stack
      
      mov bl,pf%[eax+2]
      mov [itmp%],ebx
      fild dword [itmp%]
      fld qword [^wr]
      fmulp st1,st0         ;Red result 0n stack
      faddp st1,st0
      faddp st1,st0         ;Combine 3 results. Left 0n stack
      
      fild dword [max%]
      fdivp st1,st0
      mov cl,[^in&]
      cmp cl,1
      jne dark
      fld1
      fsubrp st1,st0
      .dark
      fst qword [^spl]       ;Calculate percent split
      
      mov ebx,0
      mov bl,pf2%[eax]
      mov [^Res%],ebx
      fild dword [^Res%]
      fmulp st1,st0
      
      fld qword [^spl]
      fld1
      fsubrp st1,st0
      
      mov ebx,0
      mov bl,pf%[eax]
      mov [^Res%],ebx
      fild dword [^Res%]
      fmulp st1,st0
      faddp st1,st0
      fistp dword [^Res%]
      mov ebx,[^Res%]
      mov pfn%[eax],bl        ;pr% 0r Blue
      
      fld qword [^spl]
      mov ebx,0
      mov bl,pf2%[eax+1]
      mov [^Res%],ebx
      fild dword [^Res%]
      fmulp st1,st0
      
      fld qword [^spl]
      fld1
      fsubrp st1,st0
      
      mov ebx,0
      mov bl,pf%[eax+1]
      mov [^Res%],ebx
      fild dword [^Res%]
      fmulp st1,st0
      faddp st1,st0
      fistp dword [^Res%]
      mov ebx,[^Res%]
      mov pfn%[eax+1],bl      ;pr%+1 0r Green
      
      fld qword [^spl]
      mov ebx,0
      mov bl,pf2%[eax+2]
      mov [^Res%],ebx
      fild dword [^Res%]
      fmulp st1,st0
      
      fld qword [^spl]
      fld1
      fsubrp st1,st0
      
      mov ebx,0
      mov bl,pf%[eax+2]
      mov [^Res%],ebx
      fild dword [^Res%]
      fmulp st1,st0
      faddp st1,st0
      fistp dword [^Res%]
      mov ebx,[^Res%]
      mov pfn%[eax+2],bl        ;pr%+2 0r Red
      
      inc dword [^k%]
      mov edx,[^k%]
      cmp edx,[^wdth%]
      jl near kloop
      
      inc dword [^j%]
      mov edx,[^j%]
      cmp edx,[^hght%]
      jl near jloop
      
      jmp over
      .max% DD 255
      .over ret
      ]
      endproc
      rem ====================================================================