10 PRINT TAB(33);"BOUNCE"
20 PRINT TAB(15);"CREATIVE COMPUTING  MORRISTOWN, NEW JERSEY"
25 IF INFO("wordsize") < 64 THEN PRINT "This program requires a 64-bit uBasic" : END
30 PRINT:PRINT:PRINT
90 DIM @T(20)
100 PRINT "THIS SIMULATION LETS YOU SPECIFY THE INITIAL VELOCITY"
110 PRINT "OF A BALL THROWN STRAIGHT UP, AND THE COEFFICIENT OF"
120 PRINT "ELASTICITY OF THE BALL.  PLEASE USE A DECIMAL FRACTION"
130 PRINT "COEFFICIENCY (LESS THAN 10K)."
131 PRINT
132 PRINT "YOU ALSO SPECIFY THE TIME INCREMENT TO BE USED IN"
133 PRINT "'STROBING' THE BALL'S FLIGHT (TRY 100 MS INITIALLY)."
134 PRINT
135 INPUT "TIME INCREMENT (MSEC): ";A : A=FUNC(_Itof(A*10))
140 PRINT
150 INPUT "VELOCITY        (FPS): ";V : V=FUNC(_Itof(V*10000))
160 PRINT
170 INPUT "COEFFICIENT    (*10K): ";C : C=FUNC(_Itof(C))
180 PRINT
182 PRINT "FEET"
184 PRINT
186 B=FUNC(_Ftoi(FUNC(_Fdiv(FUNC(_Itof(700000)), (FUNC(_Fdiv(V, (FUNC(_Fmul(FUNC(_Itof(160000)), A))))))))))/10000
190 FOR I=1 TO B
200 @T(I)=FUNC(_Fdiv(FUNC(_Fmul(V, FUNC(_Fpow(C, FUNC(_Itof(10000*(I-1))))))), FUNC(_Itof(160000))))
210 NEXT I
215 Q=FUNC(_Fdiv(V, FUNC(_Itof(320000))))
217 Z=(FUNC(_Ftoi(FUNC(_Fmul(FUNC(_Itof(-160000)), FUNC(_Fmul(Q, Q))))+FUNC(_Fdiv(FUNC(_Fmul(V, V)), FUNC(_Itof(320000))))+FUNC(_Itof(5000)))))/10000
220 FOR H=Z*2 TO 0 STEP -1
221 IF AND(H,1)=0 THEN PRINT H/2;
225 L=FUNC(_Itof(0))
230 FOR I=1 TO B
240 FOR T=0 TO FUNC(_Ftoi(@T(I))) STEP FUNC(_Ftoi(A))
245 L=L+A : Q=FUNC(_Itof(T))
247 Z=FUNC(_Fmul(FUNC(_Itof(-160000)), FUNC(_Fmul(Q, Q)))) + FUNC(_Fmul(V, FUNC(_Fmul(FUNC(_Fpow(C, FUNC(_Itof(10000*(I-1))))), Q))))
250 IF ABS(FUNC(_Fdiv(H, 2)) - Z) > FUNC(_Fdiv(1, 4)) THEN CONTINUE
260 PRINT TAB(FUNC(_Ftoi(FUNC(_Fdiv(L, A))))/10000);"0";
270 NEXT T
274 T=FUNC(_Fdiv(@T(I+1), FUNC(_Itof(20000))))
275 Z=FUNC(_Fmul(FUNC(_Itof(-160000)), FUNC(_Fmul(T, T)))) + FUNC(_Fmul(V, FUNC(_Fmul(FUNC(_Fpow(C, FUNC(_Itof(10000*(I-1))))), T))))
276 UNTIL Z < FUNC(_Fdiv(H, 2))
280 NEXT I
290 PRINT
300 NEXT H
320 FOR I=1 TO (FUNC(_Ftoi(FUNC(_Fdiv(FUNC(_Fint(L+FUNC(_Itof(10000)))), A))))/10000)+1
330 PRINT ".";
340 NEXT I
350 PRINT
355 PRINT "0";
360 FOR I=1 TO FUNC(_Ftoi(L+FUNC(_Itof(9995))))/10000
380 PRINT TAB(FUNC(_Ftoi(FUNC(_Fdiv(FUNC(_Itof(I*10000)), A))))/10000);I;
390 NEXT I
400 PRINT
410 PRINT TAB(FUNC(_Ftoi(FUNC(_Fdiv(L+FUNC(_Itof(10000)), A+A))))/10000 - 2);"SECONDS"
420 REM ** For uBasic/4tH 64-bit ONLY **
430 REM Try values: 100, 30, 9000. It's not very fast, but it works ;-)
440 END

_Fmul Param (2) : Return ((a@*b@)/16384)
_Fdiv Param (2) : Return ((a@*16384)/b@)
_Ftoi Param (1) : Return ((10000*a@)/16384)
_Itof Param (1) : Return ((16384*a@)/10000)
_Fprint Param (1) : a@ = FUNC(_Ftoi(a@)) : Print Using "+?.####";a@; : Return
_Fint Param (1) : Return (FUNC(_Itof((FUNC(_Ftoi(a@))/10000)*10000)))
_Fln Param (1) : Return (FUNC(_Ln(a@*4))/4)
_Fpow Param (2) : Return (FUNC(_Fexp(FUNC(_Fmul(FUNC(_Fln(a@)), b@)))))

_Fexp
  Param (1)
  Local (1)

  b@ = FUNC(_Exp (abs(a@) * 4))
  If a@<0 Then Return (1073741824/b@)
Return (b@/4)

_Exp
  Param (1)
  Local (2)

  c@=65536
  b@=a@-363409 : If b@>-1 Then a@=b@ : c@=SHL(c@, 8)
  b@=a@-181704 : If b@>-1 Then a@=b@ : c@=SHL(c@, 4)
  b@=a@-90852  : If b@>-1 Then a@=b@ : c@=SHL(c@, 2)
  b@=a@-45426  : If b@>-1 Then a@=b@ : c@=SHL(c@, 1)
  b@=a@-26573  : If b@>-1 Then a@=b@ : c@=c@+SHL(c@, -1)
  b@=a@-14624  : If b@>-1 Then a@=b@ : c@=c@+SHL(c@, -2)
  b@=a@-7719   : If b@>-1 Then a@=b@ : c@=c@+SHL(c@, -3)
  b@=a@-3973   : If b@>-1 Then a@=b@ : c@=c@+SHL(c@, -4)
  b@=a@-2017   : If b@>-1 Then a@=b@ : c@=c@+SHL(c@, -5)
  b@=a@-1016   : If b@>-1 Then a@=b@ : c@=c@+SHL(c@, -6)
  b@=a@-510    : If b@>-1 Then a@=b@ : c@=c@+SHL(c@, -7)
  If (AND(a@, 256)) Then c@=c@+SHL(c@, -8)
  If (AND(a@, 128)) Then c@=c@+SHL(c@, -9)
  If (AND(a@, 64))  Then c@=c@+SHL(c@, -10)
  If (AND(a@, 32))  Then c@=c@+SHL(c@, -11)
  If (AND(a@, 16))  Then c@=c@+SHL(c@, -12)
  If (AND(a@, 8))   Then c@=c@+SHL(c@, -13)
  If (AND(a@, 4))   Then c@=c@+SHL(c@, -14)
  If (AND(a@, 2))   Then c@=c@+SHL(c@, -15)
  If (AND(a@, 1))   Then c@=c@+SHL(c@, -16)
Return (c@)

_Ln
  Param (1)
  Local (2)

  c@=681391
  If (a@<32768)      Then a@=SHL(a@, 16) : c@=c@-726817
  If (a@<8388608)    Then a@=SHL(a@, 8)  : c@=c@-363409
  If (a@<134217728)  Then a@=SHL(a@, 4)  : c@=c@-181704
  If (a@<536870912)  Then a@=SHL(a@, 2)  : c@=c@-90852
  If (a@<1073741824) Then a@=SHL(a@, 1)  : c@=c@-45426
  b@=a@+SHL(a@, -1) : If (AND(b@, 2147483648)) = 0 Then a@=b@ : c@=c@-26573
  b@=a@+SHL(a@, -2) : If (AND(b@, 2147483648)) = 0 Then a@=b@ : c@=c@-14624
  b@=a@+SHL(a@, -3) : If (AND(b@, 2147483648)) = 0 Then a@=b@ : c@=c@-7719
  b@=a@+SHL(a@, -4) : If (AND(b@, 2147483648)) = 0 Then a@=b@ : c@=c@-3973
  b@=a@+SHL(a@, -5) : If (AND(b@, 2147483648)) = 0 Then a@=b@ : c@=c@-2017
  b@=a@+SHL(a@, -6) : If (AND(b@, 2147483648)) = 0 Then a@=b@ : c@=c@-1016
  b@=a@+SHL(a@, -7) : If (AND(b@, 2147483648)) = 0 Then a@=b@ : c@=c@-510
  a@=2147483648-a@;
  c@=c@-SHL(a@, -15)
Return (c@)

