STRUCT pi_state

	REM Old global variables, plus a state number
	state%     REM main state
	a5state%   REM state of atan5 calculation
	a239state% REM state of atan239 calculation
	ptrsum%
	ptrterm%
	words%
	first%
	last%
	denom&
	
	REM Selected old local variables - not all local variables need to be
	REM kept between calls
	x%
	digits&
	rem1&
	rem2&
	rem3&
	rem4&
	d2&
ENDS

REM NOTE: INT() around GTERM forces conversion to long integer arithmetic
#define PSUM(idx) POKEL UADD(p%->ptrsum%,(idx-1)*4)
#define GSUM(idx) PEEKL(UADD(p%->ptrsum%,(idx-1)*4))
#define PTERM(idx) POKEW UADD(p%->ptrterm%,(idx-1)*2)
#define GTERM(idx) INT(PEEKW(UADD(p%->ptrterm%,(idx-1)*2)))

PROC main:
	GLOBAL pislot%
	pislot% = 0
	mpStart%:( "init", "" )
ENDP

PROC init%:
	EvtFunc$( 1 ) = "hdlKey"
	PRINT "Press MENU..."
ENDP

#include "\opl\lib\amasync.opl"
#include "\opl\lib\iomngr.opl"

PROC hdlKey%:( key%, kmod%, krep% )
	LOCAL ret%
	REM if dialog open or menu open
	IF amTstUI%:( 3 ) <> 0
		RETURN
	ENDIF
	IF key% = 512+120 :RETURN 2 :ENDIF :REM quit program on Psion-X
	IF key% = 290
			REM menu key
			mINIT
			mCARD "Pi", "Calculate", %c, "About", %a, "Exit", %x
			ret% = wsMenu%:( 0 )
			IF ret% <> 0
				IF ret% >= %A AND ret% <= %Z
					RETURN hdlKey%:( ret% + $200 + $20, 10, 1 )
				ELSE
					RETURN hdlKey%:( ret% + $200      ,  8, 1 )
				ENDIF
			ENDIF
			RETURN 0
	ENDIF
	
	IF ( key% AND $200 ) <> 0 AND ( kmod% AND $8 ) <> 0
		IF ( kmod% AND $f ) = $8
			REM Psion keys
			IF key% = $200 + %x
				RETURN 2
			ENDIF
			IF key% = $200 + %c
				dopicalc:
			ENDIF
			IF key% = $200 + %a
				about:
			ENDIF
		ENDIF
	ENDIF
ENDP

PROC about:
	dINIT "Background PI Calculation 1.00"
	dTEXT "", "27-September-1999", 2
	dBUTTONS "by Andrew Gregory", -13
	wsDial%:
ENDP

PROC dopicalc:
	LOCAL <pi_state*>p%, d&
	
	IF pislot% <> 0
		BEEP -5, 300
		GIPRINT "Calculation in progress"
		RETURN
	ENDIF
	
	p% = ALLOC( SIZEOF( pi_state ) )
	IF p% = 0
		ALERT( "Not enough memory" )
		RETURN
	ENDIF
	
	REM Get how many digits we're calculating
	dINIT
	dLONG d&, "How many digits", 1, 32747
	IF wsDial%: = 0
		FREEALLOC p%
		RETURN
	ENDIF
	
	REM Initialise the state structure
	p%->digits& = d&
	p%->state% = 1
	p%->a5state% = 1
	p%->a239state% = 1
	p%->ptrsum% = 0
	p%->ptrterm% = 0
	
	REM Setup background calculation
	pislot% = ioAdd%:( "bgpi", 63 )
	POKEW ioGusr1%:( pislot% ), p%
	IOSIGNAL
ENDP

PROC bgpi%:( slot% )
	LOCAL <pi_state*>p%, dvdnd&, quot&, n$( 12 ), loop%
	p% = PEEKW( ioGusr1%:( slot% ) )
	loop% = 3
	
again::
	
	VECTOR p%->state%
		s1, s2, s3, s4, s5, s6, s7, s8, s9
	ENDV
	ALERT( "bgpi vector error" )
	GOTO done
	
s1::
	p%->words% = p%->digits& / 4 + 3
	p%->ptrsum% = ALLOC( 4 * ( p%->words% + 2 ) )
	IF p%->ptrsum% = 0
		ALERT( "Not enough memory" )
		GOTO cleanup
	ENDIF
	p%->ptrterm% = ALLOC( 2 * ( p%->words% + 2 ) )
	IF p%->ptrterm% = 0
		ALERT( "Not enough memory" )
		GOTO cleanup
	ENDIF
	p%->x% = 1
	WHILE p%->x% <= p%->words% + 1
		PSUM( p%->x% ), 0
		PTERM( p%->x% ), 0
		p%->x% = p%->x% + 1
	ENDWH
	p%->denom& = 3
	p%->first% = 1
	p%->last% = 2
	PSUM( 1 ), 3
	PTERM( 1 ), 3
	PSUM( 2 ), 2000
	PTERM( 2 ), 2000
	p%->state% = p%->state% + 1
	BUSY "Calculating"
	GOTO exit
	
s2::
	IF p%->first% < p%->words%
		IF atan5%:( p% )
			p%->denom& = p%->denom& + 2
		ENDIF
	ELSE
		p%->state% = p%->state% + 1
	ENDIF
	GOTO exit
	
s3::
	p%->denom& = 3
	p%->first% = 2
	p%->rem1& = 4
	p%->x% = 2
	p%->state% = p%->state% + 1
	GOTO exit
	
s4::
	IF p%->x% <= p%->words%
		dvdnd& = p%->rem1& * 10000
		PTERM( p%->x% ), dvdnd& / 239
		p%->rem1& = dvdnd& - GTERM( p%->x% ) * 239
		PSUM( p%->x% ), GSUM( p%->x% ) - GTERM( p%->x% )
		p%->x% = p%->x% + 1
	ELSE
		p%->state% = p%->state% + 1
	ENDIF
	GOTO exit
	
s5::
	IF p%->first% < p%->words%
		IF atan239%:( p% )
			p%->denom& = p%->denom& + 4
		ENDIF
	ELSE
		p%->state% = p%->state% + 1
	ENDIF
	GOTO exit
	
s6::
	p%->x% = p%->words%
	p%->state% = p%->state% + 1
	GOTO exit
	
s7::
	IF p%->x% >= 2
		IF GSUM( p%->x% ) < 0
			quot& = GSUM( p%->x% ) / 10000
			PSUM( p%->x% ), GSUM( p%->x% ) - ( quot& - 1 ) * 10000
			PSUM( p%->x% - 1 ), GSUM( p%->x% - 1 ) + quot& - 1
		ENDIF
		IF GSUM( p%->x% ) >= 10000
			quot& = GSUM( p%->x% ) / 10000
			PSUM( p%->x% ), GSUM( p%->x% ) - quot& * 10000
			PSUM( p%->x% - 1 ), GSUM( p%->x% - 1 ) + quot&
		ENDIF
		p%->x% = p%->x% - 1
	ELSE
		p%->state% = p%->state% + 1
	ENDIF
	GOTO exit
	
s8::
	BUSY OFF
	PRINT
	PRINT "pi = 3+."
	p%->x% = 1
	p%->state% = p%->state% + 1
	GOTO exit
	
s9::
	IF p%->x% <= p%->words% / 3
		n$ =      RIGHT$( "0000" + GEN$( GSUM( 3 * ( p%->x% - 1 ) + 2 ), 9 ), 4 )
		n$ = n$ + RIGHT$( "0000" + GEN$( GSUM( 3 * ( p%->x% - 1 ) + 3 ), 9 ), 4 )
		n$ = n$ + RIGHT$( "0000" + GEN$( GSUM( 3 * ( p%->x% - 1 ) + 4 ), 9 ), 4 )
		n$ = LEFT$( n$, MIN( 12, p%->digits& - 12 * ( p%->x% - 1 ) ) )
		n$ = LEFT$( n$ + REPT$( " ", 12 ), 12 )
		PRINT " ";n$;
		IF p%->x% - 4 * ( p%->x% / 4 ) = 0
			PRINT "  :";MIN( 12 * p%->x%, p%->digits& )
		ENDIF
		p%->x% = p%->x% + 1
	ELSE
		GOTO cleanup
	ENDIF
	GOTO exit
	
cleanup::
	IF p%->ptrsum% <> 0
		FREEALLOC p%->ptrsum%
	ENDIF
	IF p%->ptrterm% <> 0
		FREEALLOC p%->ptrterm%
	ENDIF
	IF p% <> 0
		FREEALLOC p%
	ENDIF
	ioRem%:( slot% )
	pislot% = 0
	GOTO done
exit::
	loop% = loop% - 1
	IF loop% > 0 :GOTO again :ENDIF
	IOSIGNAL
done::
ENDP

PROC atan5%:( <pi_state*>p% )
	LOCAL dvdnd&, temp&
	
	VECTOR p%->a5state%
		s1, s2, s3, s4, s5, s6, s7, s8, s9
	ENDV
	ALERT( "atan5 vector error" )
	GOTO done
	
s1::
	p%->x% = p%->first%
	p%->rem1& = 0
	p%->rem2& = 0
	p%->a5state% = p%->a5state% + 1
	GOTO done
	
s2::
	IF p%->x% <= p%->last% + 1
		temp& = GTERM( p%->x% )
		dvdnd& = p%->rem1& * 10000 + temp&
		temp& = dvdnd& / 25
		p%->rem1& = dvdnd& - temp& * 25
		PTERM( p%->x% ), temp&
		
		dvdnd& = p%->rem2& * 10000 + temp&
		temp& = dvdnd& / p%->denom&
		p%->rem2& = dvdnd& - temp& * p%->denom&
		PSUM( p%->x% ), GSUM( p%->x% ) - temp&
		
		p%->x% = p%->x% + 1
	ELSE
		p%->a5state% = p%->a5state% + 1
	ENDIF
	GOTO done
	
s3::
	p%->x% = p%->last% + 2
	p%->a5state% = p%->a5state% + 1
	GOTO done
	
s4::
	IF p%->x% <= p%->words%
		dvdnd& = p%->rem2& * 10000
		temp& = dvdnd& / p%->denom&
		p%->rem2& = dvdnd& - temp& * p%->denom&
		PSUM( p%->x% ), GSUM( p%->x% ) - temp&
		p%->x% = p%->x% + 1
	ELSE
		p%->a5state% = p%->a5state% + 1
	ENDIF
	GOTO done
	
s5::
	IF GTERM( p%->last% + 1 ) > 0 AND p%->last% < p%->words%
		p%->last% = p%->last% + 1
	ENDIF
	IF GTERM( p%->first% ) = 0
		p%->first% = p%->first% + 1
	ENDIF
	p%->denom& = p%->denom& + 2
	p%->rem1& = 0
	p%->rem2& = 0
	p%->x% = p%->first%
	p%->a5state% = p%->a5state% + 1
	GOTO done
	
s6::
	IF p%->x% <= p%->last% + 1
		temp& = GTERM( p%->x% )
		dvdnd& = p%->rem1& * 10000 + temp&
		temp& = dvdnd& / 25
		p%->rem1& = dvdnd& - temp& * 25
		PTERM( p%->x% ), temp&
		
		dvdnd& = p%->rem2& * 10000 + temp&
		temp& = dvdnd& / p%->denom&
		p%->rem2& = dvdnd& - temp& * p%->denom&
		PSUM( p%->x% ), GSUM( p%->x% ) + temp&
		
		p%->x% = p%->x% + 1
	ELSE
		p%->a5state% = p%->a5state% + 1
	ENDIF
	GOTO done
	
s7::
	p%->x% = p%->last% + 2
	p%->a5state% = p%->a5state% + 1
	GOTO done
	
s8::
	IF p%->x% <= p%->words%
		dvdnd& = p%->rem2& * 10000
		temp& = dvdnd& / p%->denom&
		p%->rem2& = dvdnd& - temp& * p%->denom&
		PSUM( p%->x% ), GSUM( p%->x% ) + temp&
		
		p%->x% = p%->x% + 1
	ELSE
		p%->a5state% = p%->a5state% + 1
	ENDIF
	GOTO done
	
s9::
	IF GTERM( p%->last% + 1 ) > 0 AND p%->last% < p%->words%
		p%->last% = p%->last% + 1
	ENDIF
	IF GTERM( p%->first% ) = 0
		p%->first% = p%->first% + 1
	ENDIF
	p%->a5state% = 1
	RETURN 1 :REM atan5 calc done
	
done::
ENDP

PROC atan239%:( <pi_state*>p% )
	LOCAL dvdnd&, temp&, temp2&
	
	VECTOR p%->a239state%
		s1, s2, s3
	ENDV
	ALERT( "atan239 vector error" )
	GOTO done
	
s1::
	p%->rem1& = GTERM( p%->first% )
	p%->rem2& = 0
	p%->rem3& = 0
	p%->rem4& = 0
	p%->d2& = p%->denom& + 2
	p%->first% = p%->first% + 1
	p%->x% = p%->first%
	p%->a239state% = p%->a239state% + 1
	GOTO done
	
s2::
	IF p%->x% <= p%->words%
		temp& = GTERM( p%->x% )
		dvdnd& = p%->rem1& * 10000 + temp&
		temp& = dvdnd& / 57121
		p%->rem1& = dvdnd& - temp& * 57121
		
		dvdnd& = p%->rem2& * 10000 + temp&
		temp2& = dvdnd& / p%->denom&
		p%->rem2& = dvdnd& - temp2& * p%->denom&
		PSUM( p%->x% ), GSUM( p%->x% ) + temp2&
		
		dvdnd& = p%->rem3& * 10000 + temp&
		temp& = dvdnd& / 57121
		p%->rem3& = dvdnd& - temp& * 57121
		
		dvdnd& = p%->rem4& * 10000 + temp&
		temp2& = dvdnd& / p%->d2&
		p%->rem4& = dvdnd& - temp2& * p%->d2&
		PSUM( p%->x% ), GSUM( p%->x% ) - temp2&
		PTERM( p%->x% ), temp&
		
		p%->x% = p%->x% + 1
	ELSE
		p%->a239state% = p%->a239state% + 1
	ENDIF
	GOTO done
	
s3::
	p%->first% = p%->first% + 1
	IF GTERM( p%->first% ) = 0
		p%->first% = p%->first% + 1
	ENDIF
	p%->a239state% = 1
	RETURN 1 :REM atan239 calc done
	
done::
ENDP