rem PanoMaker ........ Rev 2.2
      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_revert(xscreen%,yscreen%)
      
      mouse on
      colour 132,0,0,50 : colour 4,0,0,50 : colour 128 : cls : colour 3
      mode 22 : off
      rem Change the Windows Title
      title$ = " Panorama"
      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;"Panorama"
      
      *FONT Georgia Italic,12,B
      proc_back(100,1250,1100,200,150,150,150)
      move 200,1400 : gcol 6: print;"Choose to view either a jpeg, gif or bitmap image."
      gcol 3 : move 200,1350 : print;"PRESS ANY KEY OR CLICK THE MOUSE TO CONTINUE."
      
      proc_back(100,500,1000,250,150,150,150)
      gcol 2 : move 175,700 : print;"Choose two pictures to merge."
      move 175,600 : print;"Left-click to re-run, right-click to ";
      gcol 1: print;"QUIT"
      vdu 4
      
      proc_event(a$,b&) : rem Wait for a mouse-click or a key-press.
      
      endproc
      rem =======================================================================
      
      rem Setup 2
      def proc_setup2
      
      rem Set up mirror bitmaps
      proc_BMP_Set(2*wdth%,hght%,piccom%,Wlim%,lgth2%)
      proc_BMP_Set(2*wdth%,hght%,picfin%,Wlim%,lgth2%)
      wdth2%=2*wdth%
      
      dim combi% 1500, ref% 3, refL% 3, refR% 3, rgb% 3, j% 3, k% 3, 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&
      cls
      endproc
      rem =======================================================================
      
      rem Get two adjacent pictures
      def proc_getpics
      
      rem Choose a picture
      proc_pichoose24(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_pichoose24(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,3072               ;picture ref
      add eax,[j%]
      add eax,[j%]
      add eax,[j%]
      add eax,54
      mov [refL%],eax
      
      mov eax,[^Wlim%]
      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,3072
      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,3072                  ;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,2047
      jg near cont
      
      mov eax,[k%]
      add eax,[^yo%]
      mov [ktmp%],eax
      cmp eax,0
      jl near cont
      cmp eax,767
      jg near cont                   ;Escape 1f n0t within bitmap range
      
      mov eax,[^Wlim%]               ;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,1023
      jg near sng
      
      mov ecx,1024                   ;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 ======================================================================