'תתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתת
' AutoClock v1.00b  ½ 1996 Cadenza Software - Written by Matthew Bacon
'תתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתת
' HiSoft BASIC GEM Toolkit - Written by Dave Nutkins and Ofir Gal
' Copyright HiSoft 1991-3
'תתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתת
' Include C:\AUTOCLOK\GEMTOOL.T

'$option q80,y
'$INCLUDE C:\AUTOCLOK\AUTOCLOK.BH

' ** The main program loop appears at the end of this file **

' Funtion gets the chosen text to place into the pop up
FUNCTION get_pop_text$(BYVAL poptree,BYVAL popobj)
STATIC oldtree&
oldtree&=tree&
selecttree poptree
get_pop_text$=RTRIM$(LTRIM$(getob_spec$(popobj)))
tree&=oldtree&
END FUNCTION


' Sub-routine that is used when the main window is accessed (i.e. button
' clicked or windown closed etc.)
SUB close_maindialog
SHARED commonclose,commonobj,main_handle,options_handle,wait_handle
STATIC x,y,res$,res

commonclose=0										
SELECT CASE commonobj
	' If the pop up box to choose the day of the month was clicked upon
	CASE=Day
		res=0
		junk=objc_offset(tree&,Day,x,y)
		res=popup(0,Form_Day,res,x,y)
		IF res THEN 					
			res$=get_pop_text$(Form_Day,res)
			sette_ptext Day,res$
		END IF
	' If the pop up box to choose the month of the year was clicked upon
	CASE=Month
		res=0
		junk=objc_offset(tree&,Month,x,y)
		res=popup(0,Form_Month,res,x,y)
		IF res THEN 					
			res$=get_pop_text$(Form_Month,res)
			sette_ptext Month,res$
			' Sub-routine to check leap year information
			CALL LeapYear
		END IF
	' If the pop up box to choose the year was clicked upon
	CASE=Year
		res=0
		junk=objc_offset(tree&,Year,x,y)
		res=popup(0,Form_Year,res,x,y)
		IF res THEN 					
			res$=get_pop_text$(Form_Year,res)
			sette_ptext Year,res$
			' Sub-routine to check leap year information
			CALL LeapYear
		END IF
	' If the 'OK' button, or Return was chosen
	CASE=OK
		' Sub-routine to check set the systems time & date
		CALL SetClock
		commonclose=-1
		main_handle=0
		IF wait_handle THEN
			TopAWindow wait_handle
		ELSE
			wait_handle=openformwindow(" AutoClock: "+CHR$(9)+LEFT$(TIME$,5)+"  "+MID$(DATE$,4,2)+"/"+LEFT$(DATE$,2)+"/19"+RIGHT$(DATE$,2)+" ",9,Form_Wait,0,QUIT4GOOD,VARPTRS(close_waitdialog))
		END IF
	' If the 'Cancel' button, or Undo was chosen
	CASE=Cancel
		commonclose=-1
		main_handle=0
		IF wait_handle THEN
			TopAWindow wait_handle
		ELSE
			wait_handle=openformwindow(" AutoClock: "+CHR$(9)+LEFT$(TIME$,5)+"  "+MID$(DATE$,4,2)+"/"+LEFT$(DATE$,2)+"/19"+RIGHT$(DATE$,2)+" ",9,Form_Wait,0,QUIT4GOOD,VARPTRS(close_waitdialog))
		END IF
	' If the 'Options' button was chosen
	CASE=Options
		Object_Redraw main_handle,commonobj
		' Sub-routine to used to display option information
		CALL Optionsdialog
END SELECT
IF NOT COMMONOBJ=OPTIONS THEN IF commonclose=0 THEN Object_Redraw main_handle,commonobj
END SUB

' Sub-routine to used to display option information
SUB Optionsdialog
SHARED alarm$,alarm,Mes$()
STATIC x,y,w,h,res$,res,x1,y1,w1,h1,but

' Draw a dialog
SelectTree Form_Options
form_center tree&,x1,y1,w1,h1
form_dial FMD_START,0,0,0,0,x1,y1,w1,h1
junk=objc_draw(tree&,0,10,x1,y1,w1,h1)
DO
but=form_do(tree&,BeAlarmed) AND &h7fff
Exclob_state but,mask_selected

' Work out which exit option has been chosen
SELECT CASE but
	' If the alarm status pop up box to turn the alarm on or off was clicked upon
	CASE ALARMSTATUS
		res=0
		junk=objc_offset(tree&,ALARMSTATUS,x,y)
		res=popup(0,Form_AStatus,res,x,y)
		IF res THEN 					
			res$=get_pop_text$(Form_AStatus,res)
			sette_ptext ALARMStatus,res$
			IF res$="On" THEN alarm=-1
			IF res$="Off" THEN alarm=0
		END IF
		junk=objc_draw(tree&,but,10,x,y,w,h)
	' If the 'OK' button was chosen
	CASE OPTIONS_OK
		' Read the alarm time set and message given
		alarm$=LEFT$(Gette_ptext$(BeAlarmed),2)+":"+RIGHT$(Gette_ptext$(BeAlarmed),2)
		Mes$(0)=Gette_ptext$(Mes1)
		Mes$(1)=Gette_ptext$(Mes2)
		Mes$(2)=Gette_ptext$(Mes3)
		Mes$(3)=Gette_ptext$(Mes4)
		Mes$(4)=Gette_ptext$(Mes5)
		Mes$(5)=Gette_ptext$(Mes6)
		form_dial FMD_FINISH,0,0,0,0,x1,y1,w1,h1
		SelectTree Form_Main
		EXIT LOOP
END SELECT
LOOP
END SUB

' Sub-routine to used to display option information
SUB close_waitdialog
SHARED commonclose,commonobj,main_handle,wait_handle,finished_flag

commonclose=0										
SELECT CASE commonobj
	' If the 'Set Again' button was chosen
	CASE SetAgain
		commonclose=-1
		wait_handle=0
		IF main_handle THEN
			TopAWindow main_handle
		ELSE
			main_handle=OpenFormWindow(" AutoClock v1 ",&h0B,Form_Main,time,Cancel,VARPTRS(close_maindialog))
		END IF
	' Definately quit AutoClock
	CASE Quit4Good
		commonclose=-1
		wait_handle=0
		Object_Redraw wait_handle,commonobj
		finished_flag=-1
END SELECT
IF commonclose=0 THEN Object_Redraw wait_handle,commonobj
END SUB

' Sub-routine to set the system time & date
SUB SetClock
STATIC month$

' If the time given does not exist
IF NOT Gette_ptext$(time)="" THEN 
	IF VAL(LEFT$(Gette_ptext$(time),2))>23 THEN Sette_ptext time,"00"+RIGHT$(Gette_ptext$(time),2)
	IF VAL(RIGHT$(Gette_ptext$(time),2))>59 THEN Sette_ptext time,"0000"
	' Set time
	TIME$=LEFT$(Gette_ptext$(time),2)+":"+RIGHT$(Gette_ptext$(time),2)+":"+"00"
END IF

' Read month given
month$=LEFT$(Gette_ptext$(month),3)
SELECT CASE month$
	CASE=="Jan":MONTH$="01"
	CASE=="Feb":MONTH$="02"
	CASE=="Mar":MONTH$="03"
	CASE=="Apr":MONTH$="04"
	CASE=="May":MONTH$="05"
	CASE=="Jun":MONTH$="06"
	CASE=="Jul":MONTH$="07"
	CASE=="Aug":MONTH$="08"
	CASE=="Sep":MONTH$="09"
	CASE=="Oct":MONTH$="10"
	CASE=="Nov":MONTH$="11"
	CASE=="Dec":MONTH$="12"
END SELECT
' Set date
DATE$=MONTH$+"/"+Gette_ptext$(day)+"/"+Gette_ptext$(year)
END SUB

' Sub-routine to initialse variables and all kinds of other stuff
SUB Initialise
SHARED main_handle
STATIC month$

' Open main window
main_handle=OpenFormWindow(" AutoClock v1 ",&h0B,Form_Main,time,Cancel,VARPTRS(close_maindialog))

' Change the time, date & year displayed to current time, date & year
Sette_ptext time,LEFT$(TIME$,2)+MID$(TIME$,4,2)
Sette_ptext Day,MID$(DATE$,4,2)
month$=LEFT$(DATE$,2)
SELECT CASE month$
	CASE=="01":Sette_ptext Month,"January"
	CASE=="02":Sette_ptext Month,"Febuary"
	CASE=="03":Sette_ptext Month,"March"
	CASE=="04":Sette_ptext Month,"April"
	CASE=="05":Sette_ptext Month,"May"
	CASE=="06":Sette_ptext Month,"June"
	CASE=="07":Sette_ptext Month,"July"
	CASE=="08":Sette_ptext Month,"August"
	CASE=="09":Sette_ptext Month,"September"
	CASE=="10":Sette_ptext Month,"October"
	CASE=="11":Sette_ptext Month,"November"
	CASE=="12":Sette_ptext Month,"December"
END SELECT
Sette_ptext Year,RIGHT$(DATE$,4)
END SUB

' Sub-routine to work out leap year
SUB LeapYear
STATIC i,month$,year$

' Read current month & year
month$=LEFT$(Gette_ptext$(month),3)
year$=Gette_ptext$(year)

' Clear all possible days
SelectTree Form_Day
FOR i=1 TO 31
	Setob_state i,0
NEXT

' Disable days that are unavailabe
SELECT CASE month$
	CASE=="Feb"
		Setob_state 30,8:Setob_state 31,8
		IF VAL(year$) MOD 4=0 THEN Setob_state 29,8
	CASE=="Apr":Setob_state 31,8
	CASE=="Jun":Setob_state 31,8
	CASE=="Sep":Setob_state 31,8
	CASE=="Nov":Setob_state 31,8
END SELECT
SelectTree Form_Main
' Back to main routine
END SUB

' AutoClock main routine (A modification of the HGTLOOP in the GEM TOOLKIT)
SUB MainLoop
SHARED finished_flag,Mess(1),clicks_enabled,keys_enabled,menus_enabled,forms_enabled
SHARED wait_handle,options_handle,commonclose,main_handle,alarm$,alarm,Mes$()
SHARED mouse_detect_both
STATIC ev,key_pressed,clicks,x,y,kstate,button
STATIC mclicks,mmask,mstate,a$,but

REDIM mess(7)
IF mouse_detect_both THEN
	mclicks=258
	mmask=3
	mstate=0
ELSE
	mclicks=2
	mmask=1
	mstate=1
END IF	

 finished_flag=0
 DO
	junk=wind_update(END_UPDATE)
	ev=evnt_multi(MU_MESAG+MU_KEYBD+MU_BUTTON+MU_TIMER,mclicks,mmask,mstate, _
			0,0,0,0,0,_
			0,0,0,0,0,_
			VARPTR(mess(0)),2500,_
			x,y, _
			button,kstate, _
			key_pressed,clicks)
	junk=wind_update(BEG_UPDATE)

' Start of AutoClock specific code

	' If the wait window (Set Again? or Quit), undate time & date displayed
	IF wait_handle THEN 
		a$=" AutoClock: "+CHR$(9)+LEFT$(TIME$,5)+"  "+MID$(DATE$,4,2)+"/"+LEFT$(DATE$,2)+"/19"+RIGHT$(DATE$,2)+" "
		CALL RenameWindow(Wait_handle,a$)
	END IF

	' If alarm is on
	IF alarm=-1 THEN 
		' Is the alarm set for the current time?
		IF alarm$=LEFT$(TIME$,5) THEN 
			' Display alarm message
			SelectTree Form_Alarm
			Sette_ptext AMes1,Mes$(0):Sette_ptext AMes2,Mes$(1)
			Sette_ptext AMes3,Mes$(2):Sette_ptext AMes4,Mes$(3)
			Sette_ptext AMes5,Mes$(4):Sette_ptext AMes6,Mes$(5)
			but=HandleDialog(0)
			alarm=0
		END IF
	END IF

' End of AutoClock specific code

	IF ev AND MU_KEYBD THEN	KeyboardEvent key_pressed,kstate
	IF ev AND MU_MESAG THEN
		do_message
	END IF
	IF ev AND MU_BUTTON THEN
		IF forms_enabled THEN
			IF NOT ProcessFormClicks(button,clicks,kstate,x,y) THEN
				IF clicks_enabled THEN 	ProcessClicks clicks,kstate,x,y
			END IF
		ELSE
			IF clicks_enabled THEN 	ProcessClicks clicks,kstate,x,y
		END IF
	END IF
	IF finished_flag=-1 THEN EXIT LOOP
 LOOP
END SUB

'תתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתת
' Start of program

' If an error has occurred, if tolerated place back here
RETURN_HANDLER:
' If an error occurs, trap it and redirect message
ON ERROR GOTO ERROR_HANDLER

' See Technical Reference manual
Startprogram CURDIR$+"\AUTOCLOK.RSC",0,0
SelectTree Form_Options

' Set the default alarm message
Sette_ptext Mes1,"Welcome to AutoClock"
Sette_ptext Mes2,""
Sette_ptext Mes3,CHR$(189)+" 1996 Cadenza"
Sette_ptext Mes4,"Software"
Sette_ptext Mes5,"Written by"
Sette_ptext Mes6,"_______Matthew Bacon"

' Sub-routine to initialse variables and all kinds of other stuff
CALL Initialise
' Sub-routine to work out leap year
CALL LeapYear

' AutoClock main routine (A modification of the HGTLOOP in the GEM TOOLKIT)
CALL Mainloop
' See Technical Reference manual
StopProgram

'תתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתת

' If an error has occurred...
ERROR_HANDLER:
' Display alert and abort to main loop
button=form_alert(1,"[1][  An ERROR"+STR$(ERR)+" has occurred ! |  Try to tolerate or abort |  program? | ][ Tolerate | Abort ]")
SELECT CASE button
	CASE 2
		' user decides to abort
		SYSTEM
END SELECT
' If system has run out of available windows, then quit
IF ERR=68 THEN CALL NoMoreWindows:SYSTEM
' Go back to main loop
junk=rsrc_free
ON ERROR GOTO ERROR_HANDLER
GOTO RETURN_HANDLER

'תתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתת