PROC newpi:
GLOBAL signal%
LOCAL p%, d&
p% = ALLOC( 46 )
IF p% = 0
ALERT( "Not enough memory" )
STOP
ENDIF
dINIT
dLONG d&, "How many digits", 1, 32747
IF DIALOG = 0
STOP
ENDIF
pokel uadd(p%,22), d&
pokew p%, 1
pokew uadd(p%,2), 1
pokew uadd(p%,4), 1
signal% = 1
WHILE signal%
signal% = 0
bgpi%:( p% )
ENDWH
PRINT :PRINT "Done"
GET
ENDP
PROC BGPI%:( p% )
LOCAL dvdnd&, quot&, n$( 12 )
VECTOR peekw(p%)
s1, s2, s3, s4, s5, s6, s7, s8, s9
ENDV
ALERT( "bgpi vector error" )
GOTO done
s1::
pokew uadd(p%,10), peekl(uadd(p%,22)) / 4 + 3
pokew uadd(p%,6), ALLOC( 4 * ( peekw(uadd(p%,10)) + 2 ) )
IF peekw(uadd(p%,6)) = 0
ALERT( "Not enough memory" )
FREEALLOC p%
GOTO done
ENDIF
pokew uadd(p%,8), ALLOC( 2 * ( peekw(uadd(p%,10)) + 2 ) )
IF peekw(uadd(p%,8)) = 0
ALERT( "Not enough memory" )
FREEALLOC peekw(uadd(p%,6))
FREEALLOC p%
GOTO done
ENDIF
pokew uadd(p%,20), 1
WHILE peekw(uadd(p%,20)) <= peekw(uadd(p%,10)) + 1
POKEL UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) -1)*4), 0
POKEW UADD(peekw(uadd(p%,8)),(peekw(uadd(p%,20)) -1)*2), 0
pokew uadd(p%,20), peekw(uadd(p%,20)) + 1
ENDWH
pokel uadd(p%,16), 3
pokew uadd(p%,12), 1
pokew uadd(p%,14), 2
POKEL UADD(peekw(uadd(p%,6)),(1 -1)*4), 3
POKEW UADD(peekw(uadd(p%,8)),(1 -1)*2), 3
POKEL UADD(peekw(uadd(p%,6)),(2 -1)*4), 2000
POKEW UADD(peekw(uadd(p%,8)),(2 -1)*2), 2000
pokew p%, peekw(p%) + 1
BUSY "Calculating"
GOTO exit
s2::
IF peekw(uadd(p%,12)) < peekw(uadd(p%,10))
IF atan5%:( p% )
pokel uadd(p%,16), peekl(uadd(p%,16)) + 2
ENDIF
ELSE
pokew p%, peekw(p%) + 1
ENDIF
GOTO exit
s3::
pokel uadd(p%,16), 3
pokew uadd(p%,12), 2
pokel uadd(p%,26), 4
pokew uadd(p%,20), 2
pokew p%, peekw(p%) + 1
GOTO exit
s4::
IF peekw(uadd(p%,20)) <= peekw(uadd(p%,10))
dvdnd& = peekl(uadd(p%,26)) * 10000
POKEW UADD(peekw(uadd(p%,8)),(peekw(uadd(p%,20)) -1)*2), dvdnd& / 239
pokel uadd(p%,26), dvdnd& - INT(PEEKW(UADD(peekw(uadd(p%,8)),(peekw(uadd(p%,20)) -1)*2))) * 239
POKEL UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) -1)*4), PEEKL(UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) -1)*4)) - INT(PEEKW(UADD(peekw(uadd(p%,8)),(peekw(uadd(p%,20)) -1)*2)))
pokew uadd(p%,20), peekw(uadd(p%,20)) + 1
ELSE
pokew p%, peekw(p%) + 1
ENDIF
GOTO exit
s5::
IF peekw(uadd(p%,12)) < peekw(uadd(p%,10))
IF atan239%:( p% )
pokel uadd(p%,16), peekl(uadd(p%,16)) + 4
ENDIF
ELSE
pokew p%, peekw(p%) + 1
ENDIF
GOTO exit
s6::
pokew uadd(p%,20), peekw(uadd(p%,10))
pokew p%, peekw(p%) + 1
GOTO exit
s7::
IF peekw(uadd(p%,20)) >= 2
IF PEEKL(UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) -1)*4)) < 0
quot& = PEEKL(UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) -1)*4)) / 10000
POKEL UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) -1)*4), PEEKL(UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) -1)*4)) - ( quot& - 1 ) * 10000
POKEL UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) - 1 -1)*4), PEEKL(UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) - 1 -1)*4)) + quot& - 1
ENDIF
IF PEEKL(UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) -1)*4)) >= 10000
quot& = PEEKL(UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) -1)*4)) / 10000
POKEL UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) -1)*4), PEEKL(UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) -1)*4)) - quot& * 10000
POKEL UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) - 1 -1)*4), PEEKL(UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) - 1 -1)*4)) + quot&
ENDIF
pokew uadd(p%,20), peekw(uadd(p%,20)) - 1
ELSE
pokew p%, peekw(p%) + 1
ENDIF
GOTO exit
s8::
BUSY OFF
PRINT
PRINT "pi = 3+."
pokew uadd(p%,20), 1
pokew p%, peekw(p%) + 1
GOTO exit
s9::
IF peekw(uadd(p%,20)) <= peekw(uadd(p%,10)) / 3
n$ = RIGHT$( "0000" + GEN$( PEEKL(UADD(peekw(uadd(p%,6)),(3 * ( peekw(uadd(p%,20)) - 1 ) + 2 -1)*4)), 9 ), 4 )
n$ = n$ + RIGHT$( "0000" + GEN$( PEEKL(UADD(peekw(uadd(p%,6)),(3 * ( peekw(uadd(p%,20)) - 1 ) + 3 -1)*4)), 9 ), 4 )
n$ = n$ + RIGHT$( "0000" + GEN$( PEEKL(UADD(peekw(uadd(p%,6)),(3 * ( peekw(uadd(p%,20)) - 1 ) + 4 -1)*4)), 9 ), 4 )
n$ = LEFT$( n$, MIN( 12, peekl(uadd(p%,22)) - 12 * ( peekw(uadd(p%,20)) - 1 ) ) )
n$ = LEFT$( n$ + REPT$( " ", 12 ), 12 )
PRINT " ";n$;
IF peekw(uadd(p%,20)) - 4 * ( peekw(uadd(p%,20)) / 4 ) = 0
PRINT "  :";MIN( 12 * peekw(uadd(p%,20)), peekl(uadd(p%,22)) )
ENDIF
pokew uadd(p%,20), peekw(uadd(p%,20)) + 1
ELSE
pokew p%, 1
FREEALLOC peekw(uadd(p%,6))
FREEALLOC peekw(uadd(p%,8))
FREEALLOC p%
GOTO done
ENDIF
GOTO exit
exit::
signal% = 1
done::
ENDP
PROC ATAN5%:( p% )
LOCAL dvdnd&, temp&
VECTOR peekw(uadd(p%,2))
s1, s2, s3, s4, s5, s6, s7, s8, s9
ENDV
ALERT( "atan5 vector error" )
GOTO done
s1::
pokew uadd(p%,20), peekw(uadd(p%,12))
pokel uadd(p%,26), 0
pokel uadd(p%,30), 0
pokew uadd(p%,2), peekw(uadd(p%,2)) + 1
GOTO done
s2::
IF peekw(uadd(p%,20)) <= peekw(uadd(p%,14)) + 1
temp& = INT(PEEKW(UADD(peekw(uadd(p%,8)),(peekw(uadd(p%,20)) -1)*2)))
dvdnd& = peekl(uadd(p%,26)) * 10000 + temp&
temp& = dvdnd& / 25
pokel uadd(p%,26), dvdnd& - temp& * 25
POKEW UADD(peekw(uadd(p%,8)),(peekw(uadd(p%,20)) -1)*2), temp&
dvdnd& = peekl(uadd(p%,30)) * 10000 + temp&
temp& = dvdnd& / peekl(uadd(p%,16))
pokel uadd(p%,30), dvdnd& - temp& * peekl(uadd(p%,16))
POKEL UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) -1)*4), PEEKL(UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) -1)*4)) - temp&
pokew uadd(p%,20), peekw(uadd(p%,20)) + 1
ELSE
pokew uadd(p%,2), peekw(uadd(p%,2)) + 1
ENDIF
GOTO done
s3::
pokew uadd(p%,20), peekw(uadd(p%,14)) + 2
pokew uadd(p%,2), peekw(uadd(p%,2)) + 1
GOTO done
s4::
IF peekw(uadd(p%,20)) <= peekw(uadd(p%,10))
dvdnd& = peekl(uadd(p%,30)) * 10000
temp& = dvdnd& / peekl(uadd(p%,16))
pokel uadd(p%,30), dvdnd& - temp& * peekl(uadd(p%,16))
POKEL UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) -1)*4), PEEKL(UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) -1)*4)) - temp&
pokew uadd(p%,20), peekw(uadd(p%,20)) + 1
ELSE
pokew uadd(p%,2), peekw(uadd(p%,2)) + 1
ENDIF
GOTO done
s5::
IF INT(PEEKW(UADD(peekw(uadd(p%,8)),(peekw(uadd(p%,14)) + 1 -1)*2))) > 0 AND peekw(uadd(p%,14)) < peekw(uadd(p%,10))
pokew uadd(p%,14), peekw(uadd(p%,14)) + 1
ENDIF
IF INT(PEEKW(UADD(peekw(uadd(p%,8)),(peekw(uadd(p%,12)) -1)*2))) = 0
pokew uadd(p%,12), peekw(uadd(p%,12)) + 1
ENDIF
pokel uadd(p%,16), peekl(uadd(p%,16)) + 2
pokel uadd(p%,26), 0
pokel uadd(p%,30), 0
pokew uadd(p%,20), peekw(uadd(p%,12))
pokew uadd(p%,2), peekw(uadd(p%,2)) + 1
GOTO done
s6::
IF peekw(uadd(p%,20)) <= peekw(uadd(p%,14)) + 1
temp& = INT(PEEKW(UADD(peekw(uadd(p%,8)),(peekw(uadd(p%,20)) -1)*2)))
dvdnd& = peekl(uadd(p%,26)) * 10000 + temp&
temp& = dvdnd& / 25
pokel uadd(p%,26), dvdnd& - temp& * 25
POKEW UADD(peekw(uadd(p%,8)),(peekw(uadd(p%,20)) -1)*2), temp&
dvdnd& = peekl(uadd(p%,30)) * 10000 + temp&
temp& = dvdnd& / peekl(uadd(p%,16))
pokel uadd(p%,30), dvdnd& - temp& * peekl(uadd(p%,16))
POKEL UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) -1)*4), PEEKL(UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) -1)*4)) + temp&
pokew uadd(p%,20), peekw(uadd(p%,20)) + 1
ELSE
pokew uadd(p%,2), peekw(uadd(p%,2)) + 1
ENDIF
GOTO done
s7::
pokew uadd(p%,20), peekw(uadd(p%,14)) + 2
pokew uadd(p%,2), peekw(uadd(p%,2)) + 1
GOTO done
s8::
IF peekw(uadd(p%,20)) <= peekw(uadd(p%,10))
dvdnd& = peekl(uadd(p%,30)) * 10000
temp& = dvdnd& / peekl(uadd(p%,16))
pokel uadd(p%,30), dvdnd& - temp& * peekl(uadd(p%,16))
POKEL UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) -1)*4), PEEKL(UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) -1)*4)) + temp&
pokew uadd(p%,20), peekw(uadd(p%,20)) + 1
ELSE
pokew uadd(p%,2), peekw(uadd(p%,2)) + 1
ENDIF
GOTO done
s9::
IF INT(PEEKW(UADD(peekw(uadd(p%,8)),(peekw(uadd(p%,14)) + 1 -1)*2))) > 0 AND peekw(uadd(p%,14)) < peekw(uadd(p%,10))
pokew uadd(p%,14), peekw(uadd(p%,14)) + 1
ENDIF
IF INT(PEEKW(UADD(peekw(uadd(p%,8)),(peekw(uadd(p%,12)) -1)*2))) = 0
pokew uadd(p%,12), peekw(uadd(p%,12)) + 1
ENDIF
pokew uadd(p%,2), 1
RETURN 1 :
done::
ENDP
PROC ATAN239%:( p% )
LOCAL dvdnd&, temp&, temp2&
VECTOR peekw(uadd(p%,4))
s1, s2, s3
ENDV
ALERT( "atan239 vector error" )
GOTO done
s1::
pokel uadd(p%,26), INT(PEEKW(UADD(peekw(uadd(p%,8)),(peekw(uadd(p%,12)) -1)*2)))
pokel uadd(p%,30), 0
pokel uadd(p%,34), 0
pokel uadd(p%,38), 0
pokel uadd(p%,42), peekl(uadd(p%,16)) + 2
pokew uadd(p%,12), peekw(uadd(p%,12)) + 1
pokew uadd(p%,20), peekw(uadd(p%,12))
pokew uadd(p%,4), peekw(uadd(p%,4)) + 1
GOTO done
s2::
IF peekw(uadd(p%,20)) <= peekw(uadd(p%,10))
temp& = INT(PEEKW(UADD(peekw(uadd(p%,8)),(peekw(uadd(p%,20)) -1)*2)))
dvdnd& = peekl(uadd(p%,26)) * 10000 + temp&
temp& = dvdnd& / 57121
pokel uadd(p%,26), dvdnd& - temp& * 57121
dvdnd& = peekl(uadd(p%,30)) * 10000 + temp&
temp2& = dvdnd& / peekl(uadd(p%,16))
pokel uadd(p%,30), dvdnd& - temp2& * peekl(uadd(p%,16))
POKEL UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) -1)*4), PEEKL(UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) -1)*4)) + temp2&
dvdnd& = peekl(uadd(p%,34)) * 10000 + temp&
temp& = dvdnd& / 57121
pokel uadd(p%,34), dvdnd& - temp& * 57121
dvdnd& = peekl(uadd(p%,38)) * 10000 + temp&
temp2& = dvdnd& / peekl(uadd(p%,42))
pokel uadd(p%,38), dvdnd& - temp2& * peekl(uadd(p%,42))
POKEL UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) -1)*4), PEEKL(UADD(peekw(uadd(p%,6)),(peekw(uadd(p%,20)) -1)*4)) - temp2&
POKEW UADD(peekw(uadd(p%,8)),(peekw(uadd(p%,20)) -1)*2), temp&
pokew uadd(p%,20), peekw(uadd(p%,20)) + 1
ELSE
pokew uadd(p%,4), peekw(uadd(p%,4)) + 1
ENDIF
GOTO done
s3::
pokew uadd(p%,12), peekw(uadd(p%,12)) + 1
IF INT(PEEKW(UADD(peekw(uadd(p%,8)),(peekw(uadd(p%,12)) -1)*2))) = 0
pokew uadd(p%,12), peekw(uadd(p%,12)) + 1
ENDIF
pokew uadd(p%,4), 1
RETURN 1 :
done::
ENDP