REM Surface Waves II .... Rev 2.0
      REM A J Tooth / May 2003 Updated 21st June 2003
      :
      HIMEM=LOMEM + 5000000
      REM Set up use of Full Screen
      PROC_fullscreen(22)
      Xlim%=2048 : Ylim%=1536
      :
      REM Enter Parameters
      PROC_input
      :
      DIM pnts%(Xlim%/2,stp%)
      :
      REM Read in Weights
      DIM Wght%(qt%)
      IF in$="f" THEN
        RESTORE
        PROC_read
      ELSE
        PROC_wghtcalc
      ENDIF
      :
      REM Further Setup
      COLOUR 0 : COLOUR 143 : CLS : GCOL 143 : CLG
      ORIGIN 0,(Ylim%/2)
      dk=(K-1)/qt%
      :
      REM Title
      PROC_title(1024,0)
      :
      REM Time Loops
      FOR tim%=0 TO stp%
        Tm=tim%*Scl%/stp%
        
        REM Calculate Waveforms
        PROC_trac(tim%)
        PROC_calc
        
      NEXT tim%
      :
      REM Display Resultant Surface Wave
      CLS : CLG
  460 PROC_disp
      :
      a$=GET$ : IF a$="r" THEN a%=1 ELSE a%=2
      ON a% GOTO 460,510
      REM
  510 QUIT
      END
      :
      REM End of Program .....................................
      
      REM Functions and Procedures
      REM ========================
      
      REM Traps Computational Range Errors ONLY
  600 IF ERR=21 OR ERR=23 OR ERR=18 OR ERR=20 OR ERR=22 OR ERR=24 THEN
        GOTO 1040
      ELSE ERROR
      ENDIF
      GOTO 1100
      
      REM Wave Number Weights ( Fibonacci Numbers )
      DATA 1,10,45,120,210,252,210,120,45,10,1
      
      REM Read in Weights Data
      DEF PROC_read
      LOCAL p%
      Tot%=0
      FOR p%=0 TO qt%
        READ Wght%(p%)
        Tot%=Tot%+Wght%(p%)
      NEXT p%
      ENDPROC
      
      REM Display Waves
      DEF PROC_disp
      LOCAL t%,q%,y%
      PROC_title(1024,500)
      
      GCOL 3 : MOVE 0,-Ylim% : PLOT 101,2048,-150
      FOR t%=0 TO stp%
        FOR q%=0 TO (Xlim%/2)
          y%=pnts%(q%,t%)
          r%=2*q%
          GCOL 4 : MOVE r%,-150 : DRAW r%,y% : GCOL 15 : MOVE r%,150 : DRAW r%,y%
          SYS "UpdateWindow",@hwnd%
        NEXT q%
        
      NEXT t%
      ENDPROC
      
      REM Calculate Wave Points
      DEF PROC_calc
      LOCAL x%,xac,pnts,j%
      FOR x%=0 TO (Xlim%/2)
        xac=x%*Xmax*2/Xlim%
        pnts=0
        REM Combine Fourier Integral Elements
        FOR j%=0 TO qt%
          ON ERROR LOCAL GOTO 600
 1040     k=(1+(j%*dk))/2
          w=SQR(10*k)
          pnts=pnts + dk*(Wght%(j%)/Tot%)*COS(k*xac-w*Tm)
        NEXT j%
        sg%=SGN(pnts)
        pnts%(x%,tim%)=sg%*INT(ABS((Ylim%/4)*pnts))
 1100 NEXT x%
      ENDPROC
      
      REM Enter Parameters
      DEF PROC_input
 1150 INPUT " Read in fixed weights or calculate ( f or c. c is best. )",in$
      IF (in$<>"f" AND in$<>"c") THEN GOTO 1150
      
      IF in$="c" THEN
        INPUT " How many calculated weights (24)",qt%
        INPUT " Enter calculated weight factor (.01)",c
      ELSE qt%=10
      ENDIF
      INPUT " Timescale (100) ",Scl%
      INPUT " Number of time-steps (360) ",stp%
      INPUT " Enter largest x-value (200) ";Xmax
      INPUT " Enter max spread of wave-number,K (3.0) [Must be >1] ";K
      ENDPROC
      
      REM Calculated Weights Procedure. Uses exp(-x²) function.
      DEF PROC_wghtcalc
      LOCAL p%,v
      Tot%=0
      FOR p%=0 TO qt%
        v=p%-(qt%/2)
        Wght%(p%)=INT(1000*(EXP(-c*(v*v))))
        Tot%=Tot% + Wght%(p%)
      NEXT p%
      ENDPROC
      
      REM Title
      DEF PROC_title(f%,g%)
      GCOL 4 : MOVE f%,g% : MOVE f%+300,g% : PLOT 205,f%,g%+100
      GCOL 6
      FOR a%=50 TO 550 STEP 2
        v%=INT(5*(1+SIN(a%/4)))
        PLOT 69,(f%-300+a%),(g%+v%-10)
      NEXT a%
      VDU5 : GCOL 15 : MOVE f%-200,g%+50 : PRINT "SURFACE WAVES on WATER"
      VDU4
      ENDPROC
      
      REM Tracks stage of calculation
      DEF PROC_trac(Tim%)
      
      PRINT TAB(5,5);" Calculating Wave for time-slot ";Tim%
      ENDPROC
      
      REM Set up use of Full Screen
      DEF PROC_fullscreen(N%)
      SYS "GetSystemMetrics", 0 TO xscreen%
      SYS "GetSystemMetrics", 1 TO yscreen%
      SYS "SetWindowLong",@hwnd%,-16,&16000000
      SYS "SetWindowPos",@hwnd%,-1,0,0,xscreen%,yscreen%,0
      MODE N%
      MOUSE OFF : OFF : REM Turns off the Mouse Pointer and the Cursor
      ENDPROC