rem Enhance II ........ Rev 3.0 rem A J Tooth // December 2006 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 proc_pichoose(Name$,FulName$,Pre$,wdth%,hght%,lgth%,pic%) rem Set up mirror bitmap proc_BMP_Set(wdth%,hght%,picmir%,Wlim%,lgth%) rem Go to full screen proc_fullscreen(xscreen%,yscreen%) rem Display the picture initially proc_BMP_Disp(xscreen%,yscreen%,pic%,0,0) mouse off : mouse rectangle siz&,siz&,2048-2*siz&,1536-2*siz& rem 2nd Setup proc_setup2 rem Enhance limited regions proc_enhance rem Normaliser call norm% rem Normalise picture to grey-world standard call grey% rem Display the original picture proc_BMP_Disp(xscreen%,yscreen%,picmir%,0,0) rem Save the amended picture proc_save(Name$,xt$,picmir%,lgth%,Newpic$) mouse rectangle off : mouse on 0 proc_event(a$,b&) : rem Wait for a mouse-click or a key-press. if b&=4 then run else quit quit rem End of Program ========================================== rem ========================================================= rem Setup def proc_setup dim recopy% 200 pic%=0 : picmir%=0 : lgth%=0 : rem Dummy initial values siz&=50 : rem Initial view rectangle parameter xt$="WB" : rem White Balance file extension fac=1.0 : rem Std Dev sensitivity rem Dual-pass assembly, in case of labels for pass&=0 to 2 step 2 proc_recopy(pass&) next pass& rem Revert to normal screen proc_revert(xscreen%,yscreen%) mouse on mode 22 : off : colour 132,0,0,50 : colour 4,0,0,50 : colour 128 : cls : colour 3 rem Change the Windows Title title$ = " Enhance" sys "SetWindowText", @hwnd%, title$ rem Display a background picture proc_BackPic("BPic.jpg",xscreen%,yscreen%) rem Displays my icon proc_AJTicon(10,650) *FONT Blackadder ITC,30,B vdu 5 colour 8,160,90,20 gcol 8 : move 1400,350 : print;"ENHANCE" *FONT Georgia Italic,12,B proc_back(100,1250,1100,200,150,150,150) move 175,1400 : gcol 6: print;"Choose to view either a jpeg, gif or bitmap image." gcol 3 : move 175,1350 : print;"PRESS ANY KEY OR CLICK THE MOUSE TO CONTINUE." proc_back(100,500,1000,250,150,150,150) move 175,700 : gcol 2: print;"Roll the mouse-wheel to change the viewing-window." move 175,650 : print;"Click either mouse button to exit." move 175,600 : print;"Press the + or - keys to alter the contrast."; vdu 4 proc_event(a$,b&) : rem Wait for a mouse-click or a key-press. endproc rem ======================================================================= rem Enhance limited regions def proc_enhance local xo%,yo%,x%,y%,in& xo%=-10 : yo%=-10 *REFRESH OFF repeat mouse x%,y%,b& in&=0 : in&=inkey(1) sys "Sleep",10 *REFRESH rem Resize window if mouse-wheel rotated if in&=141 then siz&-=10 : if siz&<10 then siz&=10 if in&=140 then siz&+=10 : if siz&>200 then siz&=200 rem Increase/Decrease sensitivity if +/- keys pressed if in&=61 then fac+=0.1 : if fac>6.0 then fac=6.0 if in&=45 then fac-=0.1 : if fac<0.3 then fac=0.3 rem Adjust the size of the mouse rectangle if (in&=141 or in&=140) then mouse rectangle siz&,siz&,2048-2*siz&,1536-2*siz& if (abs(x%-xo%)>5 or abs(y%-yo%)>5) or (in&=141 or in&=140) or (in&=61 or in&=45) then call recopy% : rem Copy pic% to picmir% xl%=int((x%-siz&)*wdth%/2048) : xu%=int((x%+siz&)*wdth%/2048) yl%=int((y%-siz&)*hght%/1536) : yu%=int((y%+siz&)*hght%/1536) rem Identify the mu/sig colour values within a limited rectangular region proc_ident(Rmu,Rsig,Gmu,Gsig,Bmu,Bsig) rem Commonly used factors Bneg=Bmu-fac*Bsig : Bpos=Bmu+fac*Bsig Gneg=Gmu-fac*Gsig : Gpos=Gmu+fac*Gsig Rneg=Rmu-fac*Rsig : Rpos=Rmu+fac*Rsig if Bsig>0.0 then Bmul=255/(2*fac*Bsig) if Gsig>0.0 then Gmul=255/(2*fac*Gsig) if Rsig>0.0 then Rmul=255/(2*fac*Rsig) rem Enhance a restricted rectangular region call enhans% rem Display the enhanced picture proc_BMP_Disp(xscreen%,yscreen%,picmir%,0,0) *REFRESH endif xo%=x% : yo%=y% until b&=1 *REFRESH ON endproc rem ======================================================================= rem Identify the mu/sigma for colour values within a limited rectangular region def proc_ident(return Rmu,return Rsig,return Gmu,return Gsig,return Bmu,return Bsig) rem Initialise the mu/sig values Rmu=0.0 : Rsig=0.0 Gmu=0.0 : Gsig=0.0 Bmu=0.0 : Bsig=0.0 Cnt%=0 : rem Count actual number of pixels rem Identify the mean/std dev colour values within a limited rectangular region. rem Also counts the pixels. call iden% rem The Mean Bmu/=Cnt% Gmu/=Cnt% Rmu/=Cnt% rem The Std Dev Bsig/=Cnt% : Bsig=sqr(Bsig-Bmu*Bmu) Gsig/=Cnt% : Gsig=sqr(Gsig-Gmu*Gmu) Rsig/=Cnt% : Rsig=sqr(Rsig-Rmu*Rmu) endproc rem ======================================================================= rem Setup 2 def proc_setup2 dim grey% 1000, norm% 1000, enhans% 1000, iden% 1000, itmp% 3, ftmp% 7 rem Initialise the avg colour values Rav=0.0 : Gav=0.0 : Bav=0.0 rem Dual-pass assembly, in case of labels for pass&=0 to 2 step 2 proc_grey(pass&) proc_norm(pass&) proc_enhans(pass&) proc_iden(pass&) next pass& endproc rem ======================================================================= rem Identifier def proc_iden(opt&) P%=iden% [opt opt& mov edx,[^yl%] mov [^yr%],edx .yrloop mov edx,[^xl%] mov [^xr%],edx .xrloop mov eax,[^yr%] ;BMP ref imul eax,[^Wlim%] add eax,[^xr%] add eax,[^xr%] add eax,[^xr%] add eax,54 ;BMP ref inc dword [^Cnt%] ;Count another pixel mov ecx,0 finit mov cl,pic%[eax] ;Blue mu/sig mov [itmp%],ecx fild dword [itmp%] fld qword [^Bmu] fadd st0,st1 fstp qword [^Bmu] fld st0 fmulp st1,st0 fld qword [^Bsig] faddp st1,st0 fstp qword [^Bsig] ;Blue mu/sig mov cl,pic%[eax+1] ;Green mu/sig mov [itmp%],ecx fild dword [itmp%] fld qword [^Gmu] fadd st0,st1 fstp qword [^Gmu] fld st0 fmulp st1,st0 fld qword [^Gsig] faddp st1,st0 fstp qword [^Gsig] ;Green mu/sig mov cl,pic%[eax+2] ;Red mu/sig mov [itmp%],ecx fild dword [itmp%] fld qword [^Rmu] fadd st0,st1 fstp qword [^Rmu] fld st0 fmulp st1,st0 fld qword [^Rsig] faddp st1,st0 fstp qword [^Rsig] ;Red mu/sig inc dword [^xr%] mov edx,[^xr%] cmp edx,[^xu%] jb near xrloop inc dword [^yr%] mov edx,[^yr%] cmp edx,[^yu%] jb near yrloop ret ] endproc rem ====================================================================== rem Enhancer def proc_enhans(opt&) P%=enhans% [opt opt& mov edx,[^yl%] mov [^yr%],edx .yeloop mov edx,[^xl%] mov [^xr%],edx .xeloop mov eax,[^yr%] ;BMP ref imul eax,[^Wlim%] add eax,[^xr%] add eax,[^xr%] add eax,[^xr%] add eax,54 mov [^ref%],eax ;BMP ref finit fld qword [^Bsig] ;Blue Value ftst fstsw ax fstp qword [ftmp%] and ah,64 cmp ah,64 je near Bzero mov ecx,0 mov eax,[^ref%] mov cl,pic%[eax] mov [itmp%],ecx fild dword [itmp%] fld qword [^Bneg] fcomp st1 fstsw ax and ah,1 cmp ah,0 je near Bvzero fld qword [^Bpos] fcomp st1 fstsw ax and ah,1 cmp ah,1 je near Bvmax fld qword [^Bneg] fsubp st1,st0 fld qword [^Bmul] fmulp st1,st0 fistp dword [itmp%] mov ecx,[itmp%] mov [^Bb&],cl jmp Gstrt .Bvmax mov ecx,255 mov [^Bb&],cl jmp Gstrt .Bvzero mov ecx,0 mov [^Bb&],cl jmp Gstrt .Bzero mov ecx,127 mov [^Bb&],cl ;Blue Value .Gstrt ;Green Value fld qword [^Gsig] ftst fstsw ax fstp qword [ftmp%] and ah,64 cmp ah,64 je near Gzero mov ecx,0 mov eax,[^ref%] mov cl,pic%[eax+1] mov [itmp%],ecx fild dword [itmp%] fld qword [^Gneg] fcomp st1 fstsw ax and ah,1 cmp ah,0 je near Gvzero fld qword [^Gpos] fcomp st1 fstsw ax and ah,1 cmp ah,1 je near Gvmax fld qword [^Gneg] fsubp st1,st0 fld qword [^Gmul] fmulp st1,st0 fistp dword [itmp%] mov ecx,[itmp%] mov [^Gg&],cl jmp Rstrt .Gvmax mov ecx,255 mov [^Gg&],cl jmp Rstrt .Gvzero mov ecx,0 mov [^Gg&],cl jmp Rstrt .Gzero mov ecx,127 mov [^Gg&],cl ;Green Value .Rstrt ;Red Value fld qword [^Rsig] ftst fstsw ax fstp qword [ftmp%] and ah,64 cmp ah,64 je near Rzero mov ecx,0 mov eax,[^ref%] mov cl,pic%[eax+2] mov [itmp%],ecx fild dword [itmp%] fld qword [^Rneg] fcomp st1 fstsw ax and ah,1 cmp ah,0 je near Rvzero fld qword [^Rpos] fcomp st1 fstsw ax and ah,1 cmp ah,1 je near Rvmax fld qword [^Rneg] fsubp st1,st0 fld qword [^Rmul] fmulp st1,st0 fistp dword [itmp%] mov ecx,[itmp%] mov [^Rr&],cl jmp Cover .Rvmax mov ecx,255 mov [^Rr&],cl jmp Cover .Rvzero mov ecx,0 mov [^Rr&],cl jmp Cover .Rzero mov ecx,127 mov [^Rr&],cl ;Red Value .Cover 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 inc dword [^xr%] mov edx,[^xr%] cmp edx,[^xu%] jb near xeloop inc dword [^yr%] mov edx,[^yr%] cmp edx,[^yu%] jb near yeloop jmp over .i127% DD 127 .i255% DD 255 .over ret ] endproc rem ====================================================================== rem Normaliser def proc_norm(opt&) P%=norm% [opt opt& finit mov edx,0 mov [^y%],edx .yyloop mov edx,0 mov [^x%],edx .xxloop mov eax,[^y%] ;BMP ref imul eax,[^Wlim%] add eax,[^x%] add eax,[^x%] add eax,[^x%] add eax,54 ;BMP ref mov ebx,0 ;Total R/G/B Values mov bl,pic%[eax] mov [itmp%],ebx fild dword [itmp%] fld qword [^Bav] faddp st1,st0 fstp qword [^Bav] mov bl,pic%[eax+1] mov [itmp%],ebx fild dword [itmp%] fld qword [^Gav] faddp st1,st0 fstp qword [^Gav] mov bl,pic%[eax+2] mov [itmp%],ebx fild dword [itmp%] fld qword [^Rav] faddp st1,st0 fstp qword [^Rav] ;Total R/G/B Values inc dword [^x%] mov edx,[^x%] cmp edx,[^wdth%] jb near xxloop inc dword [^y%] mov edx,[^y%] cmp edx,[^hght%] jb near yyloop fild dword [^wdth%] ;Number 0f pixels fild dword [^hght%] fmulp st1,st0 fld qword [^Bav] ;R/G/B adjust factors fdiv st0,st1 fstp qword [^Bav] fld qword [^Gav] fdiv st0,st1 fstp qword [^Gav] fld qword [^Rav] fdivrp st1,st0 fstp qword [^Rav] fld qword [^Bav] fld qword [^Gav] fld qword [^Rav] faddp st1,st0 faddp st1,st0 fld1 fld st0 fadd st1,st0 faddp st1,st0 fdivp st1,st0 fld qword [^Bav] fdiv st0,st1 fstp qword [^Bf] fld qword [^Gav] fdiv st0,st1 fstp qword [^Gf] fld qword [^Rav] fdivrp st1,st0 fstp qword [^Rf] ;R/G/B adjust factors ret ] endproc rem ====================================================================== rem BMP Update Routine def proc_grey(opt&) P%=grey% [opt opt& mov edx,0 mov [^y%],edx .yloop mov edx,0 mov [^x%],edx .xloop mov eax,[^y%] imul eax,[^Wlim%] add eax,[^x%] add eax,[^x%] add eax,[^x%] add eax,54 finit mov ebx,0 ;Calculation f0r Blue mov [itmp%],ebx mov bl,pic%[eax] mov [itmp%],bl fild dword [itmp%] fld qword [^Bf] fdivp st1,st0 fistp dword [itmp%] mov ecx,[itmp%] cmp ecx,0 jge bnl mov cl,0 mov [^Bb&],cl jmp bend .bnl cmp ecx,255 jle bnh mov cl,255 mov [^Bb&],cl jmp bend .bnh mov [^Bb&],cl .bend ;Calculation f0r Blue mov ebx,0 ;Calculation f0r Green mov [itmp%],ebx mov bl,pic%[eax+1] mov [itmp%],bl fild dword [itmp%] fld qword [^Gf] fdivp st1,st0 fistp dword [itmp%] mov ecx,[itmp%] cmp ecx,0 jge gnl mov cl,0 mov [^Gg&],cl jmp gend .gnl cmp ecx,255 jle gnh mov cl,255 mov [^Gg&],cl jmp gend .gnh mov [^Gg&],cl .gend ;Calculation f0r Green mov ebx,0 ;Calculation f0r Red mov [itmp%],ebx mov bl,pic%[eax+2] mov [itmp%],bl fild dword [itmp%] fld qword [^Rf] fdivp st1,st0 fistp dword [itmp%] mov ecx,[itmp%] cmp ecx,0 jge rnl mov cl,0 mov [^Rr&],cl jmp rend .rnl cmp ecx,255 jle rnh mov cl,255 mov [^Rr&],cl jmp rend .rnh mov [^Rr&],cl .rend ;Calculation f0r Red mov cl,[^Bb&] mov picmir%[eax],cl mov cl,[^Gg&] mov picmir%[eax+1],cl mov cl,[^Rr&] mov picmir%[eax+2],cl inc dword [^x%] mov edx,[^x%] cmp edx,[^wdth%] jb near xloop inc dword [^y%] mov edx,[^y%] cmp edx,[^hght%] jb near yloop ret ] endproc rem ====================================================================== rem Assembly Routine for Recopy def proc_recopy(opt&) P%=recopy% [opt opt& mov esi,[^pic%] mov edi,[^picmir%] mov ecx,[^lgth%] cld rep movsb ret ] endproc rem ====================================================================== def proc_dump1 rem All DONE for y%=0 to hght%-1 for x%=0 to wdth%-1 ref%=y%*Wlim% + 3*x% + 54 : rem DONE Bb%=int((?(pic%+ref%))/Bf) : rem DONE Gg%=int((?(pic%+ref%+1))/Gf) : rem DONE Rr%=int((?(pic%+ref%+2))/Rf) : rem DONE rem All DONE if Bb%<0 then Bb&=0 if Bb%>255 then Bb&=255 if Bb%>=0 and Bb%<=255 then Bb&=Bb% if Gg%<0 then Gg&=0 if Gg%>255 then Gg&=255 if Gg%>=0 and Gg%<=255 then Gg&=Gg% if Rr%<0 then Rr&=0 if Rr%>255 then Rr&=255 if Rr%>=0 and Rr%<=255 then Rr&=Rr% ?(picmir%+ref%)=Bb& : rem DONE ?(picmir%+ref%+1)=Gg& : rem DONE ?(picmir%+ref%+2)=Rr& : rem DONE next x% next y% endproc rem ====================================================================== def proc_dump2 rem Initialise the min/max/avg colour values Rav=0.0 : Gav=0.0 : Bav=0.0 pix=1.0*wdth%*hght% : rem Number of pixels : rem DONE rem All DONE for y%=0 to hght%-1 for x%=0 to wdth%-1 ref%=y%*Wlim% + 3*x% + 54 : rem DONE Bav+=1.0*(?(pic%+ref%)) : rem DONE Gav+=1.0*(?(pic%+ref%+1)) : rem DONE Rav+=1.0*(?(pic%+ref%+2)) : rem DONE next x% next y% Bav/=pix : rem DONE Gav/=pix : rem DONE Rav/=pix : rem DONE Gs=(Bav+Gav+Rav)/3.0 : rem DONE Bf=Bav/Gs : rem DONE Gf=Gav/Gs : rem DONE Rf=Rav/Gs : rem DONE endproc rem ======================================================================= rem Identify the mean/std dev colour values within a limited rectangular region def proc_dump3 rem All DONE for yr%=yl% to yu%-1 for xr%=xl% to xu%-1 ref%=Wlim%*yr% + 3*xr% + 54 : rem DONE Cnt%+=1 : rem DONE Bv=1.0*(?(pic%+ref%)) : rem DONE Gv=1.0*(?(pic%+ref%+1)) : rem DONE Rv=1.0*(?(pic%+ref%+2)) : rem DONE Bmu+=Bv : rem DONE Gmu+=Gv : rem DONE Rmu+=Rv : rem DONE Bsig+=Bv*Bv : rem DONE Gsig+=Gv*Gv : rem DONE Rsig+=Rv*Rv : rem DONE next xr% next yr% endproc rem ======================================================================= rem Enhance a restricted rectangular region def proc_dump4 rem ALL DONE BELOW for yr%=yl% to yu%-1 for xr%=xl% to xu%-1 ref%=Wlim%*yr% + 3*xr% + 54 : rem DONE Bv=1.0*(?(pic%+ref%)) if Bsig>0.0 then if Bv<=Bneg then Bb&=0 if Bv>=Bpos then Bb&=255 if Bv>Bneg and Bv0.0 then if Gv<=Gneg then Gg&=0 if Gv>=Gpos then Gg&=255 if Gv>Gneg and Gv0.0 then if Rv<=Rneg then Rr&=0 if Rv>=Rpos then Rr&=255 if Rv>Rneg and Rv