rem PanoMaker ........ Rev 2.3
      rem A J Tooth // April 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 Go to full screen
      proc_fullscreen(xscreen%,yscreen%)
      
      rem Get two adjacent pictures
      proc_getpics
      
      rem 2nd Setup
      proc_setup2
      
      *REFRESH OFF
      mouse to 3*xscreen%/2,3*yscreen%/2-200 : b&=0 : xo%=xscreen% : yo%=0
      
      repeat
        mouse x%,y%,b& : sys "Sleep",5
        xo%=x% - xscreen%/2 : yo%=y% - 3*yscreen%/2 + 200 : cls
        
        rem Combine the two pictures side by side
        call combi%
        
        rem Display two images
        proc_duodisp
        *REFRESH
        
      endif
      until b&<>0
      
      rem Save combined picture
      proc_save(NameL$,"Pan",picfin%,lgth2%,Newpic$)
      *REFRESH ON
      colour 3 : print tab(5,5);" Saved as: ";Newpic$
      
      proc_event(a$,b&) : rem Wait for a mouse-click or a key-press.
      
      if (b&=4 or a$=" ") then run else quit
      quit
      rem End of Program ==========================================
      rem =========================================================
      
      rem Setup
      def proc_setup
      
      rem Revert to normal windowed screen
      proc_maxim(xscreen%,yscreen%)
      
      mouse on
      colour 132,0,0,50 : colour 4,0,0,50 : colour 128 : cls : colour 3
      
      rem Change the Windows Title
      title$ = " PanoMaker"
      sys "SetWindowText", @hwnd%, title$
      
      rem Display a background picture
      proc_BackPic("BPic.jpg",xscreen%,yscreen%)
      
      rem Displays my icon
      proc_AJTicon(10,fn_adapt(1,650))
      
      colour 8,160,90,20
      msg$="\8Panorama"
      proc_msg("Blackadder ITC",60,"B",fn_adapt(0,1400),fn_adapt(1,350),msg$)
      
      proc_back(100,fn_adapt(1,1250),1100,fn_adapt(1,200),150,150,150)
      
      msg$="\14Choose to view either a \10jpeg\14, \10gif \14or \10bitmap \14image."
      proc_msg("Georgia Italic",12,"B",200,fn_adapt(1,1400),msg$)
      
      msg$="\11PRESS ANY KEY OR CLICK THE MOUSE TO CONTINUE."
      proc_msg("Georgia Italic",12,"B",200,fn_adapt(1,1350),msg$)
      
      proc_back(100,fn_adapt(1,500),1000,fn_adapt(1,250),150,150,150)
      
      msg$="\10Choose two pictures to merge."
      proc_msg("Georgia Italic",12,"B",200,fn_adapt(1,700),msg$)
      
      msg$="\10Left-click to re-run, right-click to \9QUIT"
      proc_msg("Georgia Italic",12,"B",200,fn_adapt(1,600),msg$)
      
      proc_event(a$,b&) : rem Wait for a mouse-click or a key-press.
      if b&=1 then quit
      
      endproc
      rem =======================================================================
      
      rem Setup 2
      def proc_setup2
      local pass&
      
      rem Set up mirror bitmaps
      proc_BMP_Set(2*wdth%,hght%,piccom%,Dlim%,lgth2%)
      proc_BMP_Set(2*wdth%,hght%,picfin%,Dlim%,lgth2%)
      wdth2%=2*wdth%
      
      Wlim%=((wdth%*3+3)and-4)
      
      dim combi% 1500, ktmp% 3, jtmp% 3
      dim itmp% 3, ftmp% 7
      
      rem Dual-pass assembly, in case of labels
      for pass&=0 to 2 step 2
      proc_combi(pass&)
      next pass&
      
      endproc
      rem =======================================================================
      
      rem Get two adjacent pictures
      def proc_getpics
      
      rem Choose a picture
      proc_pichooseSZ(NameL$,FulNameL$,Pre$,wdth%,hght%,lgth%)
      
      rem Display the picture initially
      proc_gendisp(1,FulNameL$,0,0,xscreen%,yscreen%,piclft%,ntused%)
      
      proc_event(a$,b&) : rem Wait for a mouse-click or a key-press.
      
      rem Choose a picture
      proc_pichooseSZ(NameR$,FulNameR$,Pre$,wdth%,hght%,lgth%)
      
      rem Display the picture initially
      proc_gendisp(1,FulNameR$,0,0,xscreen%,yscreen%,picrgt%,ntused%)
      
      proc_event(a$,b&) : cls : rem Wait for a mouse-click or a key-press, then clear the screen.
      
      rem Display the picture initially
      proc_gendisp(0,FulNameL$,0,100,xscreen%/2,yscreen%/2,ntused%,ntused%)
      
      rem Display the picture initially
      proc_gendisp(0,FulNameR$,xscreen%/2,100,xscreen%/2,yscreen%/2,ntused%,ntused%)
      endproc
      rem =======================================================================
      
      rem Display two images
      def proc_duodisp
      
      sys "SetStretchBltMode", @memhdc%, 3
      command$="MDISPLAY "+str$~piccom%+" 0,"+str$(yscreen%-200)+","+str$(2*xscreen%)+","+str$(yscreen%)
      oscli command$
      
      sys "SetStretchBltMode", @memhdc%, 3
      command$="MDISPLAY "+str$~picfin%+" "+str$(xscreen%/2)+",50,"+str$(xscreen%)+","+str$(yscreen%/2)
      oscli command$
      endproc
      rem =======================================================================
      
      rem BMP Update Routine
      def proc_combi(opt&)
      P%=combi%
      [opt opt&
      
      mov edx,0
      mov [^k%],edx
      
      .yloop1
      mov edx,0
      mov [^j%],edx
      
      .xloop1
      mov eax,[^k%]
      imul eax,[^Wlim%]            ;picture ref
      add eax,[^j%]
      add eax,[^j%]
      add eax,[^j%]
      add eax,54
      mov [^refL%],eax
      
      mov eax,[^Dlim%]
      imul eax,[^k%]               ;picture ref
      add eax,[^j%]
      add eax,[^j%]
      add eax,[^j%]
      add eax,54
      mov [^ref%],eax
      
      mov eax,[^refL%]             ;Copy Left picture as is
      mov ebx,[^ref%]
      mov cl,piclft%[eax]
      mov piccom%[ebx],cl
      mov picfin%[ebx],cl
      mov cl,piclft%[eax+1]
      mov piccom%[ebx+1],cl
      mov picfin%[ebx+1],cl
      mov cl,piclft%[eax+2]
      mov piccom%[ebx+2],cl        ;Piccom is the working version
      mov picfin%[ebx+2],cl        ;Picfin is the final version
      
      add ebx,[^Wlim%]
      mov cl,0
      mov piccom%[ebx],cl
      mov picfin%[ebx],cl
      mov piccom%[ebx+1],cl
      mov picfin%[ebx+1],cl
      mov piccom%[ebx+2],cl
      mov picfin%[ebx+2],cl        ;Copy Left picture as is
      
      inc dword [^j%]              ;x loop control
      mov edx,[^j%]
      cmp edx,[^wdth%]
      jl near xloop1
      
      inc dword [^k%]
      mov edx,[^k%]                ;y loop control
      cmp edx,[^hght%]
      jl near yloop1
      
      ;===================================
      
      mov edx,0
      mov [^k%],edx
      
      .yloop2
      mov edx,0
      mov [^j%],edx
      
      .xloop2
      mov eax,[^k%]
      imul eax,[^Wlim%]               ;picture ref - Right
      add eax,[^j%]
      add eax,[^j%]
      add eax,[^j%]
      add eax,54
      mov [^refR%],eax
      
      mov eax,[^j%]                   ;Escape 1f n0t within bitmap range
      add eax,[^xo%]
      mov [jtmp%],eax
      cmp eax,0
      jl near cont
      cmp eax,[^wdth2%]
      jge near cont
      
      mov eax,[^k%]
      add eax,[^yo%]
      mov [ktmp%],eax
      cmp eax,0
      jl near cont
      cmp eax,[^hght%]
      jge near cont                   ;Escape 1f n0t within bitmap range
      
      mov eax,[^Dlim%]                ;picture ref - Main
      imul eax,[ktmp%]
      add eax,[jtmp%]
      add eax,[jtmp%]
      add eax,[jtmp%]
      add eax,54
      mov [^ref%],eax
      
      mov eax,[jtmp%]
      cmp eax,[^wdth%]
      jge near sng
      
      mov ecx,[^wdth%]                ;Overlap
      sub ecx,[^xo%]
      mov [^gap%],ecx
      
      finit
      fild dword [jtmp%]              ;Calculate smoothing factor
      fild dword [^xo%]
      fsubp st1,st0
      fild dword [^gap%]
      fdivp st1,st0
      fstp qword [^lam]               ;Calculate smoothing factor
      
      mov eax,[^refR%]
      mov ebx,[^ref%]
      
      mov ecx,0                       ;Merge blue in final version
      mov cl,picrgt%[eax]
      mov [itmp%],ecx
      fild dword [itmp%]
      fld qword [^lam]
      fmulp st1,st0
      mov cl,piccom%[ebx]
      mov [itmp%],ecx
      fild dword [itmp%]
      fld qword [^lam]
      fld1
      fsubrp st1,st0
      fmulp st1,st0
      faddp st1,st0
      fistp dword [itmp%]
      mov ecx,[itmp%]
      mov picfin%[ebx],cl            ;Merge blue in final version
      
      mov cl,picrgt%[eax]            ;Merge blue in working version
      shr cl,1
      mov dl,piccom%[ebx]
      shr dl,1
      add cl,dl
      mov piccom%[ebx],cl            ;Merge blue in working version
      
      mov ecx,0                      ;Merge green in final version
      mov cl,picrgt%[eax+1]
      mov [itmp%],ecx
      fild dword [itmp%]
      fld qword [^lam]
      fmulp st1,st0
      mov cl,piccom%[ebx+1]
      mov [itmp%],ecx
      fild dword [itmp%]
      fld qword [^lam]
      fld1
      fsubrp st1,st0
      fmulp st1,st0
      faddp st1,st0
      fistp dword [itmp%]
      mov ecx,[itmp%]
      mov picfin%[ebx+1],cl          ;Merge green in final version
      
      mov cl,picrgt%[eax+1]          ;Merge green in working version
      shr cl,1
      mov dl,piccom%[ebx+1]
      shr dl,1
      add cl,dl
      mov piccom%[ebx+1],cl          ;Merge green in working version
      
      mov ecx,0                      ;Merge red in final version
      mov cl,picrgt%[eax+2]
      mov [itmp%],ecx
      fild dword [itmp%]
      fld qword [^lam]
      fmulp st1,st0
      mov cl,piccom%[ebx+2]
      mov [itmp%],ecx
      fild dword [itmp%]
      fld qword [^lam]
      fld1
      fsubrp st1,st0
      fmulp st1,st0
      faddp st1,st0
      fistp dword [itmp%]
      mov ecx,[itmp%]
      mov picfin%[ebx+2],cl          ;Merge red in final version
      
      mov cl,picrgt%[eax+2]          ;Merge red in working version
      shr cl,1
      mov dl,piccom%[ebx+2]
      shr dl,1
      add cl,dl
      mov piccom%[ebx+2],cl          ;Merge red in working version
      
      jmp cont
      .sng                           ;Single copy outside overlap area
      mov eax,[^refR%]
      mov ebx,[^ref%]
      mov cl,picrgt%[eax]
      mov piccom%[ebx],cl
      mov picfin%[ebx],cl
      mov cl,picrgt%[eax+1]
      mov piccom%[ebx+1],cl
      mov picfin%[ebx+1],cl
      mov cl,picrgt%[eax+2]
      mov piccom%[ebx+2],cl
      mov picfin%[ebx+2],cl          ;Single copy outside overlap area
      
      .cont
      inc dword [^j%]                ;x loop control
      mov edx,[^j%]
      cmp edx,[^wdth%]
      jl near xloop2
      
      inc dword [^k%]                ;y loop control
      mov edx,[^k%]
      cmp edx,[^hght%]
      jl near yloop2
      
      ret
      ]
      endproc
      rem ======================================================================