rem Puddle III ..... Rev 7.0
      rem A J Tooth // 29th December 2005
      
      rem ===================================================================
      on error if (err=17) then quit
      himem=lomem + 100000000
      *FLOAT 64
      install @lib$+"MyUtils.bbc"
      install @lib$+"BMP_Utils.bbc"
      rem ===================================================================
      
      rem Set up parameters
      proc_setup
      
      rem Choose a picture
      proc_pichoose24(Name$,FulName$,Pre$,wdth%,hght%,lgth%)
      
      rem Go to full screen mode
      proc_fullscreen(xscreen%,yscreen%)
      *REFRESH OFF
      
      rem Display the picture initially
      proc_gendisp(0,FulName$,0,0,xscreen%,yscreen%,pic%,lgth%)
      *REFRESH
      rem Create a 1024x768 copy
      proc_gendisp(1,FulName$,0,0,wdth%,hght%,pic%,lgth%)
      
      rem Second setup
      proc_setup2
      
      repeat
        
        rem Draw the next waveform
        for t%=0 to 6*tlim%
          sys "GetCurrentProcess" to hprocess%
          sys "SetPriorityClass", hprocess%, &100
          rem Calculate waveform
          call drip%
          
          rem Display BMP
          sys "SetStretchBltMode", @memhdc%, 3
          command$="MDISPLAY "+str$~picmir%+" 0,0,"+str$(2*xscreen%)+","+str$(2*yscreen%)
          oscli command$
          sys "GetCurrentProcess" to hprocess%
          sys "SetPriorityClass", hprocess%, &20
          
          *REFRESH
        next t%
        
        cx%=rnd(1023) : cy%=rnd(767)
        a$=inkey$(5)
      until a$<>""
      *REFRESH ON
      quit
      end
      rem End of Program =============================================
      rem ============================================================
      
      rem Set up parameters
      def proc_setup
      
      rem Maximise window
      proc_maxim(xscreen%,yscreen%)
      
      sys "GetSystemMetrics", 0 to xscreen%
      sys "GetSystemMetrics", 1 to yscreen%
      rem Change the Windows Title
      title$ = "The PUDDLE by Tony Tooth"
      sys "SetWindowText", @hwnd%, title$
      
      dim pq% 75, ff% 30, fm% 255
      !pq%=76
      pq%!4=@hwnd%
      pq%!12=ff%
      pq%!28=fm%
      pq%!32=256
      pq%!52=6
      
      BPic$=@dir$ + "Puddle.jpg"
      rem Display a background picture
      proc_gendisp(0,BPic$,10,10,xscreen%-20,yscreen%-70,ntused%,ntused%)
      
      rem Displays my icon
      proc_AJTicon(10,fn_adapt(1,650))
      
      colour 8,160,190,120
      msg$="\8The PUDDLE"
      proc_msg("Blackadder ITC",40,"B",fn_adapt(1,350),fn_adapt(1,400),msg$)
      
      proc_back(850,fn_adapt(1,1250),1100,fn_adapt(1,200),150,150,150)
      msg$="\10Select either a \11jpeg\10, \11gif \10or \11bitmap \10image."
      proc_msg("Georgia Italic",12,"B",950,fn_adapt(1,1400),msg$)
      msg$="\10PRESS ANY KEY OR CLICK THE MOUSE TO CONTINUE."
      proc_msg("Georgia Italic",12,"B",950,fn_adapt(1,1350),msg$)
      
      proc_back(850,fn_adapt(1,950),800,fn_adapt(1,200),150,150,150)
      msg$="\10Press -\9ESC- \10at any time to \9EXIT"
      proc_msg("Georgia Italic",12,"B",950,fn_adapt(1,1080),msg$)
      
      rem Wait for a key press or a mouse button pressed
      proc_event(a$,b&)
      endproc
      rem =============================================================
      
      rem Setup 2
      def proc_setup2
      
      rem Set up a mirror bitmap
      proc_BMP_Set(wdth%,hght%,picmir%,Wlim%,lgth%)
      
      rem Various parameters
      xlim%=200 : ylim%=75 : tlim%=100 : thm%=1500
      xScl=50.0 : rScl=70.0 : u=1.0 : ep=0.00001
      tScl=10.0
      
      rem Initialise instances of BB4W variables referenced in Assembler
      xn%=0 : yn%=0 : xf=0.0 : yf=0.0 : th%=0 : yi&=0 : y=50.0
      t=0.0 : x=0.0 : A=0.0 : xm=100.0 : xt%=100
      
      dim drip% 2500, xpo% 1000, itmp% 3, f25% 7, f10% 7, k% 3, lam% 7, ftmp% 7
      dim f01% 7, msg% 7
      
      |f25%=2.50 : |f10%=10.0 : |f01%=0.01
      
      rem Dual-pass assembly, in case of labels
      for pass&=0 to 2 step 2
        proc_drip(pass&)
        proc_xpo(pass&)
      next pass&
      
      cx%=rnd(1023) : cy%=rnd(767)
      a$=""
      
      endproc
      rem =============================================================
      
      rem Assembly Routine Drip
      def proc_drip(opt&)
      
      P%=drip%
      [opt opt&
      
      mov esi,pic%
      mov edi,picmir%
      mov ecx,[^lgth%]
      cld
      rep movsb
      
      mov edx,0
      mov [^xi%],edx
      
      .xiloop
      finit
      fild dword [^xi%]            ;x=xi%/xlim%
      fild dword [^xlim%]
      fdivp st1,st0
      fstp qword [^x]
      
      fild dword [^t%]             ;t=tScl*t%/tlim%
      fld qword [^tScl]
      fmulp st1,st0
      fild dword [^tlim%]
      fdivp st1,st0
      fstp qword [^t]
      
      fld qword [^x]               ;xm=xScl*x - u*t
      fld qword [^xScl]
      fmulp st1,st0
      fld qword [^u]
      fld qword [^t]
      fmulp st1,st0
      fsubp st1,st0
      fstp qword [^xm]
      
      fld qword [^x]               ;Scale x
      fld qword [^xScl]
      fmulp st1,st0
      fstp qword [^x]
      
      fld qword [^x]               ;If Abs(x)<0.01 tHen x=0.01
      fabs
      fld qword [f01%]
      fsubp st1,st0
      ftst
      fistp dword [itmp%]
      fstsw ax
      sahf
      and ah,1
      cmp ah,1
      jne aok
      fld qword [f01%]
      fstp qword [^x]
      
      .aok
      fld qword [^xm]              ;A=rScl*Exp(-(xm*xm)/10)
      fld st0
      fmulp st1,st0
      fld qword [f10%]
      fdivp st1,st0
      fchs
      fstp qword [ftmp%]
      
      call xpo%                    ;Calculate Exp(ftmp)
      
      fld qword [ftmp%]
      fld qword [^rScl]
      fmulp st1,st0
      fstp qword [^A]
      
      fld qword [^t]               ;y=A*c0s((2.5*t*t/x)-ep)
      fld st0
      fmulp st1,st0
      fld qword [f25%]
      fmulp st1,st0
      fld qword [^x]
      fdivp st1,st0
      fld qword [^ep]
      fsubp st1,st0
      fcos
      fld qword [^A]
      fmulp st1,st0               ;=y 0n stack here
      
      fistp dword [itmp%]         ;yi&=ylim%+1nt(y)
      mov eax,[itmp%]
      add eax,[^ylim%]
      mov [^yi&],al
      
      mov edx,0
      mov [^th%],edx
      
      .thloop
      fldpi                       ;Calculate angle theta
      fldpi
      faddp st1,st0
      fild dword [^th%]
      fmulp st1,st0
      fild dword [^thm%]
      fdivp st1,st0               ;Theta 0n stack
      fsincos
      
      fild dword [^xi%]
      fmulp st1,st0
      fstp qword [^xf]
      
      fild dword [^xi%]
      fmulp st1,st0
      fstp qword [^yf]
      
      fld qword [^xf]
      fild dword [^cx%]
      faddp st1,st0
      fistp dword [^xn%]
      fld qword [^yf]
      fild dword [^cy%]
      faddp st1,st0
      fistp dword [^yn%]
      
      mov ebx,[^xn%]             ;Check point is within bmp boundary
      cmp ebx,0
      jb near missd
      cmp ebx,1023
      ja near missd
      mov eax,[^yn%]
      cmp eax,0
      jb near missd
      cmp eax,767
      ja near missd
      
      imul eax,3072              ;Bitmap reference
      add eax,[^xn%]
      add eax,[^xn%]
      add eax,[^xn%]
      add eax,54
      
      mov ebx,0
      mov bl,[^yi&]
      mov edx,[^ylim%]
      sub ebx,edx
      
      mov ecx,0
      mov cl,pic%[eax]
      sub ecx,ebx
      cmp ecx,255
      jle okb1
      mov ecx,255
      .okb1
      cmp ecx,0
      jge okb2
      mov ecx,0
      .okb2
      mov picmir%[eax],cl
      
      mov ecx,0
      mov cl,pic%[eax+1]
      sub ecx,ebx
      cmp ecx,255
      jle okg1
      mov ecx,255
      .okg1
      cmp ecx,0
      jge okg2
      mov ecx,0
      .okg2
      mov picmir%[eax+1],cl
      
      mov ecx,0
      mov cl,pic%[eax+2]
      sub ecx,ebx
      cmp ecx,255
      jle okr1
      mov ecx,255
      .okr1
      cmp ecx,0
      jge okr2
      mov ecx,0
      .okr2
      mov picmir%[eax+2],cl
      
      .missd
      inc dword [^th%]
      mov edx,[^th%]
      cmp edx,[^thm%]
      jle near thloop
      
      inc dword [^xi%]
      mov edx,[^xi%]
      cmp edx,[^xlim%]
      jbe near xiloop
      
      ret
      ]
      endproc
      rem =============================================================
      
      rem Never executed - reference only
      def proc_dump
      for xi%=0 to xlim% next xi%
      
      x=xi%/xlim% : t=tScl*t%/tlim%
      xm=xScl*x - u*t : x*=xScl : if abs(x)<0.01 then x=0.01
      A=rScl*exp(-(xm*xm)/10)
      
      |ftmp%=-(xm*xm)/10
      call xpo%
      
      A=rScl*|ftmp%
      
      x=xi%/xlim% : t=tScl*t%/tlim%
      xm=xScl*x - u*t : x*=xScl : if abs(x)<0.01 then x=0.01
      A=rScl*exp(-(xm*xm)/10)
      y=A*cos((2.5*t*t/x)-ep) : yi&=ylim%+int(y) : colour 10,0,0,yi& : gcol 10
      
      for th%=0 to thm%
        th=2*pi*th%/thm% : xf=xi%*cos(th) : yf=xi%*sin(th)
        xn%=cx% + int(xf) : yn%=cy% + int(yf)
        if th%=0 then move xn%,yn% else draw xn%,yn%
      next th%
      
      endproc
      rem =============================================================
      
      rem Assembly Language Routine for the Exponential function
      def proc_xpo(opt&)
      P%=xpo%
      
      [opt opt&
      
      fld qword [ftmp%]        ;X
      
      fistp dword [itmp%]      ;Check f0r size
      mov eax,[itmp%]
      cmp eax,21
      jge near nocomph
      cmp eax,-21
      jle near nocompl
      
      fld qword [ftmp%]        ;Reload X 1f Abs(X)<21
      fldl2e                   ;st0=Log2(e)
      fmulp st1,st0
      fist dword [k%]          ;Int(st0) which = k
      fild dword [k%]
      fsubp st1,st0
      fstp qword [lam%]        ;st0 - Int(st0)
      
      mov ecx,[k%]             ;Is k<0, k=0, k>0 ??
      cmp ecx,0
      jl blow
      je zero
      
      mov ebx,[k%]             ;Limit k t0 +31
      cmp ebx,31
      jb goon1
      mov ebx,30
      mov [k%],ebx
      .goon1
      neg ebx
      cmp ebx,31
      jb goon2
      mov ebx,-30
      mov [k%],ebx
      
      .goon2
      mov eax,2                ;When k>0
      dec cl
      shl eax,cl               ;2^k
      mov [itmp%],eax
      fild dword [itmp%]
      jmp rover                ;When k>0
      
      .blow                    ;When k<0
      neg ecx
      mov eax,2
      dec cl
      shl eax,cl
      mov [itmp%],eax
      fild dword [itmp%]
      fld1
      fdivrp st1,st0           ;2^(-|k|)
      jmp rover                ;When k<0
      
      .zero
      fld1                     ;When k=0
      
      .rover
      fld qword [lam%]
      f2xm1                    ;2^st0 - 1
      fld1
      faddp st1,st0
      fmulp st1,st0
      jmp fin
      
      .nocomph
      fild dword [lmt%]
      jmp fin
      
      .nocompl
      fldz
      
      jmp fin
      .lmt% DD 1318815734
      
      .fin
      fstp qword [ftmp%]
      ret
      ]
      endproc
      rem ============================================================