OPT	L+,O+

*************************************************************************
*				DATESET					*
* Date Setting Program							*				
* Sets both the system date/time AND the hardware clock.		*
*    by D.M.Balean	16-2-92						*
*************************************************************************
		
		INCDIR	Devpac:include/

		INCLUDE	exec/exec_lib.i
		INCLUDE	exec/libraries.i
		INCLUDE	exec/alerts.i
		INCLUDE	exec/nodes.i
		INCLUDE	exec/ports.i
		INCLUDE	exec/types.i
		INCLUDE	libraries/dos_lib.i
		INCLUDE libraries/dosextens.i
		INCLUDE	intuition/intuition_lib.i
		INCLUDE	intuition/intuition.i
		INCLUDE	devices/timer.i

		XREF	_systemX
		XDEF	_DOSBase
		XDEF	_SysBase

		SECTION CODE,CODE

StartUp:	move.l	sp,InitialSP		Save stack pointer.
		clr.l	WBenchMsg		No WB message yet.
		suba.l	a1,a1
		move.l	4.w,a6
		move.l	a6,_SysBase
		CALLSYS FindTask
		move.l	d0,a4
		lea	DOSName,a1
		move.l	#LIBRARY_VERSION,d0
		CALLSYS	OpenLibrary		Open DOS.
		move.l	d0,_DOSBase		Save library base.
		bne.s	DOS_Open		Branch if open OK.
	
		ALERT	AG_OpenLib,AO_DOSLib	If DOS will not open
		moveq	#100,d0			then alert with 100
		bra.s	Exit			as return code.

DOS_Open	tst.l	pr_CLI(a4)		Were we run from WB?
		bne.s	Run			If not, branch.
		
		lea	pr_MsgPort(a4),a0	Find the message port
		CALLSYS	WaitPort		and wait for WB message.
		lea	pr_MsgPort(a4),a0	Now get the message.
		CALLSYS GetMsg
		move.l	d0,WBenchMsg		Save the message.

Run:		jsr 	Main			Perform main routine.

Exit:		move.l	InitialSP,sp		Restore stack pointer.
		move.l	d0,-(sp)		Save return code.
		move.l	_DOSBase,a1
		CALLEXEC CloseLibrary		Close DOS.
		tst.l	WBenchMsg		Are we WB or CLI?
		beq.w 	ExitToDOS		If CLI then branch.

		CALLSYS Forbid			Forbid WB from unloading
		move.l	WBenchMsg,a1		us before we finish.
		CALLSYS	ReplyMsg		Reply to the message.
		
ExitToDOS:	move.l	(sp)+,d0		Retrieve return code.
		rts				Finished!

*---------- Main Routine ----------------------------------------------*

Main:		clr.l	ReturnCode		Clear return code.
		move.l	#IntuitionName,a1	Open Intuition.
		move.l	#LIBRARY_VERSION,d0
		CALLEXEC OpenLibrary
		move.l	d0,_IntuitionBase	Store the base.
		beq 	Abort1			Abort if it fails.
		
		lea	TimerName,a0		Open the timer device.
		lea	IORequest,a1
		move.l	#UNIT_MICROHZ,d0
		clr.l	d1
		CALLSYS	OpenDevice
		move.l	d0,TimerBase		Store timer base.
		bne 	Abort2			Abort if it fails.
		
		move.l	#NewWdw,a0		Get new window structure.
		CALLINT	OpenWindow		Open the window.
		move.l	d0,Wdw			Save it's address.
		beq	Abort3			Abort if it fails.
		
		move.w	#TR_GETSYSTIME,IOCommand
		lea 	IORequest,a1		to get system time.
		CALLEXEC DoIO

* Now convert to date/time
* We don't need to worry about MonthMax here... !!

		move.l	Seconds,d0		Divide system time by
		lsr.l	#7,d0			86400 to get # of
		divu	#675,d0			elapsed days.
		move.w	d0,ElapsedDays
		mulu	#675,d0
		lsl.l	#7,d0			Find the # of
		move.l	Seconds,d1		seconds which have 
		sub.l	d0,d1			elapsed today.
		divu	#3600,d1		How many hours is this?
		move.b	d1,hours
		swap	d1
		ext.l	d1
		divu	#60,d1			Plus how many minutes?
		move.b	d1,mins
		swap	d1
		move.b	d1,secs			Plus how many seconds?
		move.w	ElapsedDays,d0		# of days
		ext.l	d0
		addq.l	#1,d0			including today.
		divu	#1461,d0		How many 4 year cycles?
		move.w	d0,d1
		move.b	#29,MonthMax+2		Assume February has 28 days.
		lsl.w	#2,d1			Multiply by 4 to give years.
		add.w	#78,d1			Take relative to 1978.
		move.b	d1,year
		swap	d0
		lea	DayTable,a0		How many days into cycle?
		move.l	#2,d1
		
MonthSrch:	cmp.w	(a0,d1.w),d0		Index into table to find
		ble.s	MonthFnd		what month it is.
		
		addq.w	#2,d1
		bra.s	MonthSrch

MonthFnd:	sub.w	-2(a0,d1.w),d0		Subtract #of days to
		move.b	d0,day			end of last month --> date.
		lsr.w	#1,d1
		ext.l	d1			Months into cycle
		subq.l	#1,d1			up to last month.
		divu	#12,d1			Calculate years.
		cmpi.b	#2,d1			If it's 2 then leap year.
		bne.s	NotLeap

		addq.b	#1,MonthMax+2		So February has 29 days.

NotLeap:	add.b	d1,year			Gives correct year
		swap	d1
		addq.l	#1,d1
		move.b	d1,month		and month.

		jsr	WriteTime		Display time.
		jsr	WriteDate		Display date.
		
		movea.l	Wdw,a0			Find window
		move.l	wd_UserPort(a0),MPort	and save it's message port.

WaitLoop:	move.l	MPort,a0		Get the port.
		CALLEXEC WaitPort		Wait for message.
		
		move.l	MPort,a0
		CALLSYS GetMsg			Get the message.
		
		tst.l	d0			Probably not required!
		beq.s	WaitLoop

		move.l	d0,a1

		clr.l	GadPtr
		move.l	im_Class(a1),d1		Find it's type.
		cmpi.l	#GADGETUP,d1		Custom gadget?
		bne.s	.skip

		move.l	im_IAddress(a1),GadPtr

.skip		CALLSYS ReplyMsg		Message already in a1.

		tst.l	GadPtr			Was it WINDOWCLOSE?
		beq.s	CleanUp4

		move.l	GadPtr,a1		Address of gadget structure.
		move.l	gg_UserData(a1),a1	Address of routine.
		jsr	(a1)			Perform function.
		tst.l	d0
		beq.w	WaitLoop

		move.l	#44,ReturnCode		Set time failed.

*************************************************************************

CleanUp4:	move.l	Wdw,a0			Close window.
		CALLINT	CloseWindow
		
CleanUp3:	lea	IORequest,a1
		CALLEXEC CloseDevice		and timer device.
		
CleanUp2:	move.l	_IntuitionBase,a1
		CALLEXEC CloseLibrary		and Intuition.
		
CleanUp1:	move.l	ReturnCode,d0		Retrieve return code.
		bra	Exit

************************************************************************
		
Abort1:		move.l	#41,ReturnCode		Intuition wouldn't open.
		bra.s	CleanUp1
		

Abort2:		move.l	#42,ReturnCode		Timer wouldn't open.
		bra.s	CleanUp2

Abort3:		move.l	#43,ReturnCode		Window wouldn't open.
		bra.s	CleanUp3

************************************************************************
		
DoGad1:	lea	hours,a1			Increment hours.
		addi.b	#1,(a1)
		cmpi.b	#24,(a1)		If hours > 23 then
		bne.s	Exit1
		clr.b	(a1)			hours = 0

Exit1:		bra	WriteTime		Update display.

***********************************************************

DoGad4:		lea	hours,a1		Decrement hours.
		subi.b	#1,(a1)
		cmpi.b	#-1,(a1)
		bne.s	Exit4
		move.b	#23,(a1)

Exit4:		bra	WriteTime

***********************************************************

DoGad2:		lea	mins,a1			Increment minutes.
		addi.b	#1,(a1)
		cmpi.b	#60,(a1)
		bne.s	Exit2
		clr.b	(a1)

Exit2:		bra	WriteTime

***********************************************************

DoGad5:		lea	mins,a1			Decrement minutes.
		subi.b	#1,(a1)
		cmpi.b	#-1,(a1)
		bne.s	Exit5
		move.b	#59,(a1)

Exit5:		bra	WriteTime

***********************************************************

DoGad3:	lea	secs,a1				Increment seconds.
		addi.b	#1,(a1)
		cmpi.b	#60,(a1)
		bne.s	Exit3
		clr.b	(a1)

Exit3:		bra	WriteTime

***********************************************************

DoGad6:		lea	secs,a1			Decrement seconds.
		subi.b	#1,(a1)
		cmpi.b	#-1,(a1)
		bne.s	Exit6
		move.b	#59,(a1)

Exit6:		bra	WriteTime

***********************************************************

DoGad7:	lea	day,a1				Increment day.
		addi.b	#1,(a1)
		move.b	month,d0		Get current month
		ext.w	d0
		lea	MonthMax,a0
		move.b	(a0,d0.w),d0
		cmp.b	(a1),d0			and check date is valid.
		bne.s	Exit7
		move.b	#1,(a1)			Else it's 1st day of month.

Exit7:		bra	WriteDate

***********************************************************

DoGad10:	lea	day,a1			Decrement day.
		subi.b	#1,(a1)
		move.b	month,d0		Get month and find
		ext.w	d0
		lea	MonthMax,a0
		move.b	(a0,d0.w),d0
		subi.b	#1,d0			maximum date in month.
		tst.b	(a1)			If current date is zero
		bne.s	Exit10
		move.b	d0,(a1)			then use maximum date.

Exit10:		bra	WriteDate

**********************************************************

DoGad8:	lea	month,a1			Increment month.
		addi.b	#1,(a1)
		cmpi.b	#13,(a1)
		bne.s	Exit8
		move.b	#1,(a1)

Exit8:		bra	WriteDate

**********************************************************

DoGad11:	lea	month,a1		Decrement month.
		subi.b	#1,(a1)
		cmpi.b	#0,(a1)
		bne.s	Exit11
		move.b	#12,(a1)

Exit11:		bra	WriteDate

**********************************************************

DoGad9:	lea	year,a1				Increment year.
		addi.b	#1,(a1)
		cmpi.b	#100,(a1)
		bne.s	Exit9
		clr.b	(a1)

Exit9:		move.b	(a1),d0
		ext.w	d0
		ext.l	d0
		divs	#4,d0
		swap	d0			# of years into cycle.
		move.b	#29,MonthMax+2		Assume February has 28 days.
		tst.w	d0
		bne.s	Out9

		move.b	#30,MonthMax+2		else February has 29 days.

Out9:		bra	WriteDate

*********************************************************

DoGad12:	lea	year,a1			Decrement year.
		subi.b	#1,(a1)
		cmpi.b	#-1,(a1)
		bne.s	Exit12

		move.b	#99,(a1)

Exit12:		move.b	(a1),d0
		ext.w	d0
		ext.l	d0
		divs	#4,d0
		swap	d0
		move.b	#29,MonthMax+2		Assume 28 days,
		tst.w	d0
		bne.s	Out12

		move.b	#30,MonthMax+2		else 29 days.

Out12:		bra	WriteDate

*********************************
* SET COMPLETE SYSTEM TIME	*
*********************************

DoGad13:	move.b	year,d0			Set system time.
		ext.w	d0
		subi.w	#78,d0			Year relative to 1978.
		bpl.s	.skip			If year < 78, 21st century.

		addi.b	#100,d0			So add 100.

.skip:		ext.l	d0
		divu	#4,d0			# of cycles.
		move.w	d0,d1
		swap	d0
		mulu	#1461,d1		# of days elapsed
		move.w	d1,ElapsedDays		before the cycle.
		mulu	#12,d0
		add.b	month,d0		# of months into cycle.
		subq.w	#1,d0			As of last month.
		lea	DayTable,a0		How many days is this?
		lsl.w	#1,d0
		move.w	(a0,d0.w),d1
		move.b	day,d0
		ext.w	d0
		add.w	d0,d1			Add date
		subq.w	#1,d1			excluding today.
		add.w	ElapsedDays,d1
		ext.l	d1
		mulu	#675,d1
		lsl.l	#7,d1
		move.l	d1,Seconds		Convert this to seconds.
		move.b	hours,d1
		ext.w	d1
		mulu	#3600,d1		Add hous x 3600.
		add.l	d1,Seconds
		move.b	mins,d1
		ext.w	d1
		mulu	#60,d1			Add minutes x 60.
		move.b	secs,d0
		ext.w	d0
		ext.l	d0
		add.l	d0,d1
		add.l	d1,Seconds		Add seconds.
		
		lea	IORequest,a1		IO request to timer.
		move.w	#TR_SETSYSTIME,IOCommand
		CALLEXEC DoIO			Set system time.
		tst.l	d0			Check for error.
		bne.s	Exit13			Return if error.

* Now set hardware clock from system time

		clr.l	-(sp)			Use NIL: for output.
		move.l	#SetClockString,-(sp)	String to be executed.
		jsr	_systemX
		addq.l	#8,sp

Exit13:		rts

***********************************************************************

Format:		ext.w	d0			Add two digits to string.
		ext.l	d0			Input word in d0.
		divu	#10,d0			String pointer in a0.
		tst.b	d0			1 in d1 -> no leading zeros
		bne.s	NotSpace		Branch if value non-zero.

		tst.b	d1			Leading zero required?
		beq.s	Zero

		move.b	#" ",(a0)+		If no, then print a space
		bra.s	Digit			then second digit.

Zero:		move.b	#"0",(a0)+		Otherwise print a zero
		bra.s	Digit			then second digit.

NotSpace:	move.b	d0,(a0)			Output first digit.
		addi.b	#"0",(a0)+		Convert to ASCII.

Digit:		swap	d0
		move.b	d0,(a0)			Output second digit.
		addi.b	#"0",(a0)+		Convert to ASCII.
		rts

**************************************************************************

WriteTime:	lea	TxtOut,a0		Find text output buffer.
		move.b	hours,d0		Put hours into the buffer
		moveq	#1,d1			without leading zeros.
		jsr	Format
		move.b	#":",(a0)+		Add : to it.
		move.b	mins,d0			Output minutes to buffer
		clr.b	d1			with leading zeros.
		jsr	Format
		move.b	#":",(a0)+		Add another : to it.
		move.b	secs,d0			Output seconds
		clr.b	d1			with leading zeros.
		jsr	Format
		move.b	#0,(a0)			Null to terminate.
		move.l	Wdw,a0			Find the window.
		move.l	wd_RPort(a0),a0		Find it's rastport.
		lea	TimeIText,a1		IntuiText structure.
		moveq	#0,d0
		move.l	d0,d1
		CALLINT	PrintIText		Output time as IntuiText.
		moveq	#0,d0
		rts

**************************************************************************

WriteDate:	lea TxtOut,a0
		move.b	day,d0			Day into output buffer
		moveq	#1,d1			without leading zeros.
		jsr	Format
		move.b	#"/",(a0)+		Then a /.
		move.b	month,d0		Get month and
		ext.w	d0
		ext.l	d0
		subq.b	#1,d0
		asl.b	#2,d0
		lea	MonthBase,a1		Index into the table
		move.l	(a1,d0.w),(a0)+		of month names.
		move.b	year,d0
		clr.b	d1
		jsr	Format			Add month to output.
		move.b	#0,(a0)			Null to terminate.
		move.l	Wdw,a0
		move.l	wd_RPort(a0),a0
		lea	DateIText,a1
		moveq	#0,d0
		move.l	d0,d1
		CALLINT	PrintIText		Output IntuiText.
		moveq	#0,d0
		rts

*************************************************************************

		SECTION DATA0,DATA_C

Image1:		dc.w	0,0,16,8,1		Small up arrow gadget.
		dc.l	ImageData1
		dc.b	2,0
		dc.l	0

ImageData1:	dc.w	$180,$3c0,$7e0,$ff0
		dc.w	$1ff8,$3ffc,$7ffe,$ffff

Image2:		dc.w	0,0,16,8,1		Small down arrow gadget.
		dc.l	ImageData2
		dc.b	2,0
		dc.l	0

ImageData2:	dc.w	$ffff,$7ffe,$3ffc,$1ff8
		dc.w	$ff0,$7e0,$3c0,$180

Image3:		dc.w	0,0,32,8,1		Large up arrow gadget.
		dc.l	ImageData3
		dc.b	2,0
		dc.l	0

ImageData3:	dc.w	$18,0,$7e,0,$ff,0,$3ff,$c000
		dc.w	$7ff,$e000,$1fff,$f800
		dc.w	$3fff,$fc00,$ffff,$ff00

Image4:		dc.w	0,0,32,8,1		Large down arrow gadget.
		dc.l	ImageData4
		dc.b	2,0
		dc.l	0

ImageData4:	dc.w	$ffff,$ff00,$3fff,$fc00
		dc.w	$1fff,$f800,$7ff,$e000,$3ff,$c000
		dc.w	$ff,0,$7e,0,$18,0

Image5:		dc.w	0,0,54,12,1		Box gadget (SET & QUIT)
		dc.l	ImageData5
		dc.b	2,0
		dc.l	0

ImageData5:	dc.w	$ffff,$ffff,$ffff,$fc00
		dc.w	$8000,$0000,$0000,$0400
		dc.w	$8000,$0000,$0000,$0400
		dc.w	$8000,$0000,$0000,$0400
		dc.w	$8000,$0000,$0000,$0400
		dc.w	$8000,$0000,$0000,$0400
		dc.w	$8000,$0000,$0000,$0400
		dc.w	$8000,$0000,$0000,$0400
		dc.w	$8000,$0000,$0000,$0400
		dc.w	$8000,$0000,$0000,$0400
		dc.w	$8000,$0000,$0000,$0400
		dc.w	$ffff,$ffff,$ffff,$fc00

***************************************************************************

		SECTION DATA1,DATA

IntuitionName:	dc.b	"intuition.library",0
DOSName:	dc.b	"dos.library",0
TimerName:	dc.b	"timer.device",0
DSTitle:	dc.b	"Set Time & Clock",0	Window title.
SetString:	dc.b	"SET",0
QuitString:	dc.b	"QUIT",0

* First reset the clock just in case, then give it the time *
SetClockString:	dc.b	"SetClock reset",10,"SetClock save",0

		CNOP	0,4

GadgStruc:	MACRO		Gadget #, Next Gadget, Left, Top, Image #

Gad\1:		dc.l	Gad\2
		dc.w	\3,\4
		
		IFNE	(\5=1)!(\5=2)
		dc.w	16,8
		ENDC
		
		IFEQ	(\5=1)!(\5=2)
		dc.w	24,8
		ENDC
		
		dc.w	GADGHCOMP!GADGIMAGE
		dc.w	RELVERIFY
		dc.w	BOOLGADGET
		dc.l	Image\5,0,0,0,0
		dc.w	\1
		dc.l	DoGad\1
		
		ENDM


***	Arrow Gadget Structures		***

		GadgStruc	1,2,75,15,1
		GadgStruc	2,3,99,15,1
		GadgStruc	3,4,123,15,1
		GadgStruc	4,5,75,31,2
		GadgStruc	5,6,99,31,2
		GadgStruc	6,7,123,31,2
		GadgStruc	7,8,71,53,1
		GadgStruc	8,9,95,53,3
		GadgStruc	9,10,127,53,1
		GadgStruc	10,11,71,69,2
		GadgStruc	11,12,95,69,4
		GadgStruc	12,13,127,69,2

Gad13:		dc.l	Gad14			SET gadget structure.
		dc.w	42,84
		dc.w	54,12
		dc.w	GADGHCOMP!GADGIMAGE
		dc.w	RELVERIFY
		dc.w	BOOLGADGET
		dc.l	Image5,0,SetIText,0,0
		dc.w	13
		dc.l	DoGad13

Gad14:		dc.l	0			QUIT gadget structure.
		dc.w	117,84
		dc.w	54,12
		dc.w	GADGHCOMP!GADGIMAGE
		dc.w	RELVERIFY
		dc.w	BOOLGADGET
		dc.l	Image5,0,QuitIText,0,0
		dc.w	14
		dc.l	CleanUp4

NewWdw:		dc.w	0,0,211,110		New Window structure.
		dc.b	-1,-1
		dc.l	CLOSEWINDOW!GADGETUP
		dc.l	$2100e
		dc.l	Gad1,0,DSTitle,0,0
		dc.w	0,0,0,0
		dc.w	1

SetIText:	dc.b	1,0,RP_JAM1,0		IntuiText "SET".
		dc.w	15,3
		dc.l	0,SetString,0

QuitIText:	dc.b	1,0,RP_JAM1,0		IntuiText "QUIT".
		dc.w	10,3
		dc.l	0,QuitString,0

		CNOP	0,4

***	IO Request Structure	***

IORequest:	dc.l	0,0
		dc.b	5,0
		dc.l	0,0
		dc.w	40
		dc.l	0
		dc.l	0

IOCommand:	dc.w	0
		dc.b	0,0

Seconds:	dc.l	0
Micros:		dc.l	0

***	IntuiText Structure for date/time output    ***

		CNOP	0,4

TimeIText:	dc.b	0,1,RP_JAM2,0
		dc.w	75,23
		dc.l	0,TxtOut
		dc.l	0

		CNOP	0,4

DateIText:	dc.b	0,1,RP_JAM2,0
		dc.w	71,61
		dc.l	0,TxtOut
		dc.l	0

		CNOP	0,4
* TxtOut MUST start on an odd address because month must start even...
* day,month,year xx/mmm/yy
Pad:		dc.b	0
TxtOut:		dc.b	"          "		Ten blank spaces.

		CNOP	0,4

MonthBase:	dc.b	"Jan/"
		dc.b	"Feb/"
		dc.b	"Mar/"
		dc.b	"Apr/"
		dc.b	"May/"
		dc.b	"Jun/"
		dc.b	"Jul/"
		dc.b	"Aug/"
		dc.b	"Sep/"
		dc.b	"Oct/"
		dc.b	"Nov/"
		dc.b	"Dec/"

MonthMax:	dc.b	0,32,29,32,31,32,31,32,32,31,32,31,32

		EVEN

DayTable:	dc.w	0,31,59,90,120,151,181,212,243,273,304,334,365
		dc.w	396,425,455,485,516,546,577,608,638,669,699,730
		dc.w	761,790,821,851,882,912,943,974,1004,1035,1065
		dc.w	1096,1127,1155,1186,1216
		dc.w	1247,1277,1308,1339,1369,1400
		dc.w	1430,1461

		CNOP	0,4

hours:		dc.b	13
mins:		dc.b	13
secs:		dc.b	13

day:		dc.b	13
month:		dc.b	11
year:		dc.b	79

		EVEN

***************************************************************************

		SECTION	BSS,BSS

ReturnCode:	ds.l	1
_IntuitionBase:	ds.l	1
TimerBase:	ds.l	1
Wdw:		ds.l	1
GadPtr:		ds.l	1
MPort:		ds.l	1
_DOSBase:	ds.l	1
_SysBase:	ds.l	1
InitialSP:	ds.l	1
WBenchMsg:	ds.l	1

ElapsedDays:	ds.w	1


		END