rem FishEye .... Rev 5.0
      rem Assembly Version
      rem A J Tooth // January 2006
      
      rem ===================================================================
      on error if (err=17) then quit
      himem=lomem + 50000000
      *FLOAT 64
      install @lib$+"MyUtils.bbc"
      install @lib$+"BMP_Utils.bbc"
      rem ===================================================================
      
      rem Setup
      proc_setup
      
      rem Choose a picture
      proc_pichoose24(Name$,FulName$,Pre$,wdth%,hght%,lgth%)
      
      rem Go to full screen
      proc_fullscreen(xscreen%,yscreen%)
      *REFRESH OFF
      
      rem Display the picture initially
      proc_gendisp(0,FulName$,0,0,xscreen%,yscreen%,ntused%,ntused%)
      *REFRESH
      rem Create a 1024x768 copy
      proc_gendisp(1,FulName$,0,0,wdth%,hght%,pic%,lgth%)
      
      rem Second setup
      proc_setup2
      
      h=500.0 : but&=0
      repeat
        rem Calculate the revised bitmap view from height h
        call calc%
        
        rem Display BMP
        sys "SetStretchBltMode", @memhdc%, 3
        command$="MDISPLAY "+str$~picmir%+" 0,0,"+str$(2*xscreen%)+","+str$(2*yscreen%)
        oscli command$
        colour 3 : print tab(5,1);"Rotate mouse wheel to zoom in/out."
        print tab(5,2);"Click mouse button to exit."
        *REFRESH
        
        rem Wait for a key to be pressed or the mousewheel rotated
        proc_keywait(but&,h)
      until but&<>0
      
      *REFRESH ON
      quit
      end
      rem End of Program =====================================================
      rem ====================================================================
      
      rem Setup
      def proc_setup
      
      rem Maximise the window
      proc_maxim(xscreen%,yscreen%)
      colour 132,0,0,50 : colour 4,0,0,50 : colour 132 : cls : colour 3 : off
      
      rem Change the Windows Title
      title$ = "FISHEYE by Tony Tooth"
      sys "SetWindowText", @hwnd%, title$
      
      BPic$=@dir$ + "BentGull.jpg"
      rem Display a background picture
      proc_gendisp(0,BPic$,10,10,xscreen%-20,yscreen%-70,ntused%,ntused%)
      
      rem Displays my icon
      proc_AJTicon(20,fn_adapt(1,650))
      
      colour 8,200,90,20
      msg$="\8FISHEYE"
      proc_msg("Blackadder ITC",60,"B",1350,fn_adapt(1,600),msg$)
      
      msg$="\11Click the mouse to continue"
      proc_msg("Georgia",12,"B",100,fn_adapt(1,1400),msg$)
      
      proc_event(a$,b&)
      endproc
      rem ====================================================================
      
      rem Second setup
      def proc_setup2
      
      rem Set up mirror bitmap
      proc_BMP_Set(wdth%,hght%,picmir%,Wlim%,lgth%)
      
      dim calc% 2000, ftmp% 7, recopy% 200
      
      rem Initialise BB4W variables used in assembly routines
      refd%=0 : refs%=0 : phi=0.0 : xx%=0 : yy%=0 : x%=0 : y%=0
      
      dim i1024% 3, i768% 3, i100% 3,xhlf% 3, yhlf% 3
      
      rem Various constants
      !i1024%=1024
      !i768%=768
      !i100%=100
      !xhlf%=512
      !yhlf%=384
      
      rem Dual-pass assembly, in case of labels
      for pass&=0 to 2 step 2
        proc_calc(pass&)
      next pass&
      
      endproc
      rem ====================================================================
      
      rem Check whether the mouse wheel is rotated
      rem or "s" is pressed to save the picture
      def proc_keywait(return but&,return H)
      local mx%,my%,w&
      
      but&=0
      repeat
        mouse mx%,my%,but&
        sys "Sleep",1
        w&=asc(inkey$(0))
        case w& of
            rem Zoom IN
          when 140: H+=20.0 : if H>600.0 then H=600.0
            rem Zoom OUT
          when 141: H-=20.0 : if H<20.0 then H=20.0
          otherwise
            rem Do nothing
        endcase
        
      until (w&=140 or w&=141 or but&=1 or but&=4)
      endproc
      rem ========================================================================
      
      rem Assembly Routine A
      def proc_calc(opt&)
      
      P%=calc%
      [opt opt&
      
      mov edx,0
      sub edx,[yhlf%]
      add edx,1
      mov [^y%],edx
      
      .yloop
      mov edx,0
      sub edx,[xhlf%]
      add edx,1
      mov [^x%],edx
      
      .xloop
      finit
      fldpi                       ;Calculate px And py
      fldpi
      fild dword [^x%]
      fmulp st1,st0
      fild dword [i1024%]
      fdivp st1,st0
      fstp qword [^px]
      
      fild dword [^y%]
      fmulp st1,st0
      fild dword [i768%]
      fdivp st1,st0
      fstp qword [^py]
      
      fld qword [^px]           ;Calculate phi
      fld st0
      fmulp st1,st0
      fld qword [^py]
      fld st0
      fmulp st1,st0
      faddp st1,st0
      fsqrt
      fstp qword [^phi]
      
      fild dword [i100%]
      fld1
      fdivrp st1,st0            ;Calculate 0.01
      fldpi
      fld1
      fld1
      faddp st1,st0
      fdivp st1,st0             ;Calculate Pi/2
      fsubrp st1,st0
      fld qword [^phi]
      fsubp st1,st0             ;(Pi/2 - 0.01) - phi
      ftst
      fstsw ax
      fstp qword [ftmp%]
      and ah,65
      cmp ah,0
      je aok
      
      fild dword [i100%]
      fld1
      fdivrp st1,st0            ;Calculate 0.01
      fldpi
      fld1
      fld1
      faddp st1,st0
      fdivp st1,st0             ;Calculate Pi/2
      fsubrp st1,st0
      fstp qword [^phi]         ;phi limitied t0 (Pi/2-0.01)
      
      .aok
      fld qword [^phi]
      fsincos
      fdivp st1,st0
      fld qword [^h]
      fmulp st1,st0
      fstp qword [^d]
      
      fld qword [^phi]         ;Is phi>0.0 ?
      ftst
      fstsw ax
      fstp qword [ftmp%]
      and ah,65
      cmp ah,0
      jne dflt
      
      fld qword [^d]
      fld qword [^phi]
      fdivp st1,st0
      fld st0
      
      fld qword [^px]          ;If phi>0.0 Then work out reference
      fmulp st1,st0
      fistp dword [^rx%]
      fld qword [^py]
      fmulp st1,st0
      fistp dword [^ry%]
      
      jmp cont
      
      .dflt
      mov eax,0
      mov [^rx%],eax
      mov [^ry%],eax
      
      .cont
      mov ebx,[^rx%]
      add ebx,[xhlf%]
      mov [^rx%],ebx
      mov ebx,[^ry%]
      add ebx,[yhlf%]
      mov [^ry%],ebx
      
      mov eax,[^y%]               ;Calculate destination bitmap reference
      add eax,[yhlf%]
      imul eax,[^Wlim%]
      mov ebx,[^x%]
      add ebx,[xhlf%]
      add eax,ebx
      add eax,ebx
      add eax,ebx
      add eax,54
      mov [^refd%],eax
      
      mov eax,[^rx%]
      cmp eax,0
      jl nogo
      cmp eax,[^wdth%]
      jge nogo
      mov eax,[^ry%]
      cmp eax,0
      jl nogo
      cmp eax,[^hght%]
      jge nogo
      
      mov eax,[^ry%]
      imul eax,[^Wlim%]
      mov ebx,[^rx%]
      add eax,ebx
      add eax,ebx
      add eax,ebx
      add eax,54
      
      mov ebx,[^refd%]
      
      mov cl,pic%[eax]
      mov picmir%[ebx],cl
      mov cl,pic%[eax+1]
      mov picmir%[ebx+1],cl
      mov cl,pic%[eax+2]
      mov picmir%[ebx+2],cl
      
      jmp fin
      
      .nogo
      mov ebx,[^refd%]
      mov cl,0
      mov picmir%[ebx],cl
      mov picmir%[ebx+1],cl
      mov picmir%[ebx+2],cl
      
      .fin
      
      inc dword [^x%]
      mov edx,[^x%]
      cmp edx,[xhlf%]
      jl near xloop
      
      inc dword [^y%]
      mov edx,[^y%]
      cmp edx,[yhlf%]
      jl near yloop
      
      ret
      ]
      endproc
      rem =======================================================================