\ DieRollerMain150.7 2000.09.30 TLC

\ -----------------------------------
\ DieRoller 1.5
\ Copyright (c) 2000, Tammy Cravit
\ tammy@warmfuzzy.com
\ All rights reserved.
\ -----------------------------------

\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ Event handling words
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\

\ Helper function to make the 
\ if blocks a little cleaner

: curitemid ( -- itemid ) curitem @ ;

\ Handler for ctlSelectEvent 
\ events, generated by the 
\ buttons and checkboxes.

: handle-ctl-select 
	(  -- )
	cond
		curitemid 
		MainForm.RollButton 
		= if
			do-roll
	else 
		curitemid 
		AboutForm.OKButton 
		= if
			DRMainForm 
			ShowForm
			true 
			DieNumBase ndice @ +
			SetControlValue
			true 
			DieTypeBase nsides @ +
			SetControlValue
	else 
		curitemid 
		HelpForm.OKButton = if
			DRMainForm 
			ShowForm
			true 
			DieNumBase ndice @ +
			SetControlValue
			true 
			DieTypeBase nsides @ +
			SetControlValue
	else 
		curitemid 
		SumCheckboxBase >
		curitemid
		SumCheckboxTop < and 
		if
			handle-checkbox
	else
		noop
	thens
	;

\ Handler for menu item 
\ selections (menuEvent)

: handle-menu ( -- )
	cond
		curitemid 
		MenuAbout = if
			DRAboutForm 
			ShowForm
	else 
		curitemid 
		MenuInstructions = if
			DRHelpForm 
			ShowForm
	thens
	;

\ The main event handler - 
\ dispatches events to the 
\ appropriate handler word
: do-event ( ekey -- )
	event >abs itemid 
	curitem !
	cond
	dup ctlSelectEvent = if 
		drop handle-ctl-select
	else menuEvent = if
		 handle-menu
	thens
	;

\ \\\\\\\\\\\\\\\\\\\\\\\\\\\
\ Main function
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\

: app-main ( -- )
	\ Seed the RNG
	TimGetTicks seed

	\ Load the main form
	DRMainForm ShowForm

	\ Zero the roll data				
	8 0 do
		0 rolls i cells + !
	loop
	0 sum !

	\ Get app preferences
	app-init	

	\ Make initial control
	\ selections
	true 
	DieNumBase ndice @ +
	SetControlValue

	true 
	DieTypeBase nsides @ +
	SetControlValue

	\ Event look
	begin					
		100. (ekey)
		do-event
	again
	;

\ \\\\\\\\\\\\\\\\\\\\\\\\\\\
\ Application entrypoint
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\

: go ( -- )
	['] app-main catch
	dup byeThrow = if
		>prefs
	then
	throw
	;

