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 newpi:
	GLOBAL signal%
	LOCAL <pi_state*>p%, d&
	
	p% = ALLOC( SIZEOF( pi_state ) )
	IF p% = 0
		ALERT( "Not enough memory" )
		STOP
	ENDIF
	
	REM Get how many digits we're calculating
	dINIT
	dLONG d&, "How many digits", 1, 32747
	IF DIALOG = 0
		STOP
	ENDIF
	
	REM Initialise the state structure
	p%->digits& = d&
	p%->state% = 1
	p%->a5state% = 1
	p%->a239state% = 1
	
	REM do the calculation
	signal% = 1
	WHILE signal%
		signal% = 0
		bgpi%:( p% )
	ENDWH
	
	PRINT :PRINT "Done"
	GET
ENDP

PROC bgpi%:( <pi_state*>p% )
	LOCAL dvdnd&, quot&, n$( 12 )
	
	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" )
		FREEALLOC p%
		GOTO done
	ENDIF
	p%->ptrterm% = ALLOC( 2 * ( p%->words% + 2 ) )
	IF p%->ptrterm% = 0
		ALERT( "Not enough memory" )
		FREEALLOC p%->ptrsum%
		FREEALLOC p%
		GOTO done
	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
		p%->state% = 1
		FREEALLOC p%->ptrsum%
		FREEALLOC p%->ptrterm%
		FREEALLOC p%
		GOTO done
	ENDIF
	GOTO exit
	
exit::
	signal% = 1
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