rem Slide Show ...... Rev 3.3
      rem A J Tooth // June 2005
      
      rem ===================================================================
      rem on error if (err=17) then quit
      himem=lomem + 100000000
      *FLOAT 64
      rem ===================================================================
      
      rem Set up parameters and compile assembly routines
      proc_setup
      
      rem Get the first picture, and set the path
      proc_picpath
      
      rem Clear screen and display my icon
      cls : proc_AJTicon(10,7*yscreen%/768)
      
      *REFRESH OFF
      rem Display the initial picture as is
      proc_gendisp(FulName$,xs%,ys%,xw%,yh%)
      *REFRESH
      
      rem Convert general picture to bitmap, and simultaneously resize
      proc_convert(pacb%)
      *REFRESH
      
      rem Count the number of files available
      proc_count
      
      rem Random Display of any Picture File in Folder
      c$="" : rem Initialise event buffer
      proc_loop
      
      *REFRESH ON
      
      a$=get$ : quit
      end
      rem End of Program=======================================================
      rem---------------------------------------------------------------------
      
      rem Setup Procedures
      def proc_setup
      
      rem Check the display size
      sys "GetSystemMetrics", 0 to xscreen%
      sys "GetSystemMetrics", 1 to yscreen%
      sys "ShowWindow", @hwnd%, 3 : rem. SW_MAXIMIZE
      
      vdu 23,22,xscreen%;yscreen%;8,16,16,1
      vdu 26
      cls
      
      rem Prevent the window from being resized
      sys "GetWindowLong", @hwnd%, -16 to ws%
      sys "SetWindowLong", @hwnd%, -16, ws% and not &50000
      
      rem Change the Windows Title
      title$ = "SLIDE SHOW by Tony Tooth"
      sys "SetWindowText", @hwnd%, title$
      
      colour 3 : colour 132,0,0,50 : colour 4,0,0,50 : colour 132 : cls
      dim NameFile$(1000)
      dim tt% 3, tmp% 3, rgb% 3
      
      dim dir% 317
      dim recopy% 200, tr% 0
      dim fac% 7, merge% 1000, x% 3, y% 3, tm% 0, ref% 3
      
      xs%=int(xscreen%/4)
      ys%=int(yscreen%/4)
      xw%=int(xscreen%/2)
      yh%=int(yscreen%/2)
      
      Trn&=1
      rem Set up standard header for 3 bmps needed
      proc_bmpheader(xw%,yh%,paca%,Wlim%,lgth%)
      proc_bmpheader(xw%,yh%,pacb%,Wlim%,lgth%)
      proc_bmpheader(xw%,yh%,pacwrk%,Wlim%,lgth%)
      
      rem Dual-pass assembly, in case of labels
      for pass&=0 to 2 step 2
        proc_recopy(pass&)
        proc_merge(pass&)
      next pass&
      off
      endproc
      rem---------------------------------------------------------------------
      
      rem Random Display of any Picture File in Folder
      def proc_loop
      
      repeat
        rem Pick a picture randomly and display it
        proc_PickRan
        
        b$=""
        if c$="" then b$=inkey$(100)
        c$=""
        
        if b$<>"" then
          rem Flush keyboard buffer
          *FX 21,0
          repeat
            c$=inkey$(10)
            *REFRESH
            mouse x,y,b&
            sys "Sleep",5
            if b&=1 then
              command$=" SCREENSAVE "+"temp.bmp"+" 0,0,"+str$(2*xscreen%)+","+str$(2*yscreen%)
              oscli command$
              proc_gendisp(FulName$,0,0,xscreen%,yscreen%)
              repeat
                mouse x,y,c&
                sys "Sleep",5
                *REFRESH
              until c&=1
              command$=" DISPLAY "+"temp.bmp"+" 0,0,"+str$(2*xscreen%)+","+str$(2*yscreen%)
              oscli command$
              *REFRESH
            endif
          until (c$<>"" or b&=4)
          *FX 21,0
        endif
        *FX 21,0
      until false
      endproc
      rem ========================================================================
      
      rem Prints the backdrop for the screen message
      def proc_back(Xs%,Ys%,Ws%,Hs%,Rr&,Gg&,Bb&)
      local h&,Rf&,Gf&,Bf&
      
      for h&=0 to 30
        Rf&=Rr&*h&/30 : Gf&=Gg&*h&/30 : Bf&=Bb&*h&/30
        colour 9,Rf&,Rf&,Rf& : gcol 9
        rectangle fill Xs%+h&,Ys%+h&,Ws%-2*h&,Hs%-2*h&
      next h&
      endproc
      rem ========================================================================
      
      rem Seect the first picture and set the path
      def proc_picpath
      local g%,rn%,n$,Flg&,pic$,fullname$,command$,m&
      
      BPic$=@dir$ + "BPic.jpg"
      rem Display a background picture
      proc_gendisp(BPic$,10,10,xscreen%-20,yscreen%-70 )
      
      rem Displays my icon
      proc_AJTicon(10,7*yscreen%/8)
      
      *FONT Blackadder ITC,24,B
      vdu 5
      colour 8,160,90,20
      gcol 8 : move 350,int(500*yscreen%/768) : print;"SLIDE SHOW"
      vdu 4
      
      dim pf% 75, ff% 30, fm% 255
      !pf%=76
      pf%!4=@hwnd%
      pf%!12=ff%
      pf%!28=fm%
      pf%!32=256
      pf%!52=6
      
      $ff% ="Picture files"+chr$0+"*.bmp;*.jpg"+chr$0+chr$0
      
      sys "GetOpenFileName", pf% to result%
      if result%<>0 then fullname$ = $$fm%
      
      rn%=len(fullname$)
      g%=0 : pic$=""
      repeat
        n$=mid$(fullname$,rn%-g%,1)
        if n$<>"\" then pic$=n$+pic$ : g%+=1
      until n$="\"
      
      PreW$=left$(fullname$,rn%-g%)
      rem Change the current Directory
      command$="CD "+chr$(34)+PreW$+chr$(34)
      oscli command$
      Name$=pic$ : FulName$=PreW$+Name$
      endproc
      rem---------------------------------------------------------------------
      
      rem Standard BMPHeader setup
      def proc_bmpheader(Ww%,Hh%,return pc%,return Wlim%,return lgth%)
      
      Wlim%=((Ww%*3+3)and-4)
      
      lgth%=54 + Wlim%*Hh%
      
      dim pc% lgth%
      
      P% = pc%
      [OPT 0
      DB "BM"          ; Signature
      DD lgth%         ; Total file bytes
      DD 0             ; Set t0 zero
      DD 54            ; Header bytes
      DD 40            ; Offset t0 Data
      DD Ww%           ; Image Width
      DD Hh%           ; Image Height
      DW 1             ; Bit planes
      DW 24            ; Colour depth in bits
      DD 0             ; Compression type=0=none
      DD lgth%-54      ; Image size net 0f header
      DD 0             ; Set t0 zero
      DD 0             ; Set t0 zero
      DD 0             ; Set t0 zero
      DD 0             ; Set t0 zero
      ]
      endproc
      rem =======================================================================
      
      rem Display a Picture
      def proc_gendisp(picture$,xpos%,ypos%,xsize%,ysize%)
      
      sys "LoadLibrary", "OLEAUT32.DLL"
      sys "GetModuleHandle", "OLEAUT32.DLL" to oleaut32%
      sys "GetProcAddress", oleaut32%, "OleLoadPicturePath" to olpp%
      if olpp%=0 error 0, "Could not get address of OleLoadPicturePath"
      
      dim iid% 15, gpp% 3, hmw% 3, hmh% 3, picture% 513
      sys "MultiByteToWideChar", 0, 0, picture$, len(picture$), picture%, 256 to lon%
      picture%!(2*lon%) = 0
      
      iid%!0  = &7BF80980
      iid%!4  = &101ABF32
      iid%!8  = &AA00BB8B
      iid%!12 = &AB0C3000
      
      sys olpp%, picture%, 0, 0, 0, iid%, gpp%
      if !gpp% = 0 error 0, "OleLoadPicturePath failed"
      
      sys !(!!gpp%+24), !gpp%, hmw% : rem. IPicture::get_Width
      sys !(!!gpp%+28), !gpp%, hmh% : rem. IPicture::get_Height
      sys !(!!gpp%+32), !gpp%, @memhdc%, xpos%, ypos%, xsize%, ysize%, 0, !hmh%, !hmw%, -!hmh%, 0 to res%
      if res% error 0, "IPicture::Render failed"
      
      sys !(!!gpp%+8), !gpp% : rem. IPicture::Release
      sys "InvalidateRect", @hwnd%, 0, 0
      sys "UpdateWindow", @hwnd%
      
      endproc
      rem----------------------------------------------------------------------
      
      rem Count the number of files available
      def proc_count
      local Flg&
      
      rem Count the bitmaps
      sys "FindFirstFile", "*.bmp", dir% to sh%
      
      Cnt%=0
      if sh%<>-1 then
        repeat
          sys "FindNextFile", sh%, dir% to Rs%
          Name$=$$(dir%+44)
          if Name$<>"temp.bmp" then
            Cnt%+=1
            NameFile$(Cnt%)=Name$
          endif
        until Rs%=0
        sys "FindClose", sh%
      endif
      
      rem Count the jpgs
      sys "FindFirstFile", "*.jpg", dir% to sh%
      
      if sh%<>-1 then
        repeat
          sys "FindNextFile", sh%, dir% to Rs%
          Name$=$$(dir%+44)
          if Name$<>"temp.bmp" then
            Cnt%+=1
            NameFile$(Cnt%)=Name$
          endif
        until Rs%=0
        sys "FindClose", sh%
      endif
      
      vdu 5
      *FONT Georgia Italic,24,B
      proc_back(int(550*xscreen%/1024),int(1200*yscreen%/768),int(1000*xscreen%/1024),int(200*yscreen%/768),150,150,150)
      gcol 4 : move int(650*xscreen%/1024),int(1350*yscreen%/768)
      print "There are ";
      gcol 2: print;Cnt%;
      gcol 4: print;" pictures "
      proc_back(int(250*xscreen%/1024),int(50*yscreen%/768),int(1600*xscreen%/1024),int(200*yscreen%/768),150,150,150)
      move int(350*xscreen%/1024),int(200*yscreen%/768) :
      *FONT Georgia Italic,12,B
      gcol 4 : print "* Press the spacebar or rotate the mouse-wheel to halt, and again to continue."
      move int(350*xscreen%/1024),int(150*yscreen%/768) : gcol 4 : print "* Right-click the paused picture to view full-screen, and a again to return."
      *REFRESH
      vdu 4
      a$=inkey$(100)
      endproc
      rem---------------------------------------------------------------------
      
      rem Pick a picture randomly and display it
      def proc_PickRan
      local Rn%
      
      Rn%=rnd(Cnt%)
      Name$=NameFile$(Rn%)
      FulName$=PreW$+Name$
      
      rem Display the picture "in camera"
      proc_gendisp(FulName$,xs%,ys%,xw%,yh%)
      
      rem Copy pacb to paca
      call recopy%,pacb%,paca%,lgth%
      
      rem Convert general picture to bitmap, and simultaneously resize
      proc_convert(paca%)
      
      for t%=1 to 40
        |fac%=1.0*(t%/40)
        rem Merge the two pictures
        call merge%
        rem Display the merged picture
        proc_disp
        *REFRESH
      next t%
      
      endproc
      rem---------------------------------------------------------------------
      
      rem Display the initial picture, as a bitmap
      def proc_disp
      
      sys "SetStretchBltMode", @memhdc%, 3
      command$="MDISPLAY "+str$~pacwrk%+" "+str$(2*xs%)+","+str$(2*ys%-125)+","+str$(2*xw%)+","+str$(2*yh%)
      oscli command$
      
      endproc
      rem---------------------------------------------------------------------
      
      rem Convert general picture to  bitmap, and simultaneously resize
      def proc_convert(pic%)
      
      command$=" SCREENSAVE "+"temp.bmp"+" "+str$(2*xs%)+","+str$(2*ys%-125)+","+str$(2*xw%)+","+str$(2*yh%)
      oscli command$
      command$=" LOAD "+"temp.bmp "+str$~pic%
      oscli command$
      sys "SetStretchBltMode", @memhdc%, 3
      command$="MDISPLAY "+str$~pic%+" "+str$(2*xs%)+","+str$(2*ys%-125)+","+str$(2*xw%)+","+str$(2*yh%)
      oscli command$
      
      endproc
      rem---------------------------------------------------------------------
      
      rem Assembly Routine for Merging
      def proc_merge(opt&)
      P%=merge%
      [opt opt&
      
      mov edx,54
      mov [tt%],edx          ;Initialise loop counter
      
      .loop
      finit
      mov eax,pacb%
      add eax,[tt%]
      mov bl,[eax]
      mov [tmp%],bl
      fild dword [tmp%]
      fld qword [fac%]
      fmulp st1,st0          ;Result 0n stack
      
      mov eax,paca%
      add eax,[tt%]
      mov bl,[eax]
      mov [tmp%],bl
      fild dword [tmp%]
      fld1
      fld qword [fac%]
      fsubp st1,st0
      fmulp st1,st0
      
      faddp st1,st0          ;Combine with result 0n stack
      fistp dword [tmp%]
      
      mov bl,[tmp%]          ;Get lowest byte 0f result
      mov eax,pacwrk%
      add eax,[tt%]
      mov [eax],bl           ;Save t0 Interim array
      
      inc dword [tt%]
      mov edx,[tt%]
      cmp edx,[^lgth%]
      jl loop
      
      ret
      ]
      endproc
      rem ======================================================================
      
      rem Assembly Routine for Recopy
      def proc_recopy(opt&)
      P%=recopy%
      [opt opt&
      
      mov esi,[ebp+2]
      mov edi,[ebp+7]
      mov eax,[ebp+12]
      mov ecx,[eax]
      cld
      rep movsb
      
      ret
      ]
      endproc
      rem ======================================================================
      
      rem Displays my Icon in .exe version
      def proc_AJTicon(i%,j%)
      
      sys "GetModuleHandle", 0 to hm%
      sys "LoadImage", hm%, "BBCWin", 1, 32, 32, 0 to hicon%
      w% = 32
      h% = 32
      sys "DrawIconEx", @memhdc%, i%, j%, hicon%, w%, h%, 0, 0, 3
      sys "InvalidateRect", @hwnd%, 0, 0
      endproc
      rem ===============================================================