*       Day2Day
*
*	Calculates the difference between two dates (in days).
*
*
*	NOTE:	There's no need to 'RUN' or 'RUNBACK' this program from the
*		CLI. It is auto-detaching.
*
*HISTORY
*         Made with Hisoft V2.12
*  V1.0   27-Jul-91: Made the calculation and parsing routines. Works fine.
*                    Added intuition interface.
*         28-Jul-91: Rewrote calculation routine - now much faster (but still
*                    not optimal).
*                    Added date validity-check.

	OPT O+
	OPT O1+			; Tells when a branch could be optimised to short
	OPT i+			; Tells when '#' is probably missing

		incdir		"AsmInc:"
		include		"P.i"
		include		"Intui.i"
		include		"Detach.i"
		include		"relMacros.i"
		include		"intuition/intuition.i"
		include		"intuition/intuition_lib.i"
		include		"libraries/dosextens.i"

DB		EQUR		A4

 dcDeclare	A4
 dcAPtr		WBenchMsg
 dcAPtr		IntuiBase
 dcAPtr		DWindow
 dcAPtr		Up
 dcAPtr		Rp
 dcLong		Class
 dcAPtr		IAddress
 dcArea		FromInfo,si_SIZEOF
 dcArea		ToInfo,si_SIZEOF
 dcArea		FromBuf,11
 dcArea		ToBuf,11
 dcEnd

Start		DetachSingle	<'Day2Day'>,4000,0
		dcAlloc					; Allocate memory for variables
		dcReset					; Clear the memory
		lea		FromGad(PC),A1
		lea		FromInfo(DB),A2
		move.l		A2,gg_SpecialInfo(A1)
		lea		FromBuf(DB),A1
		move.l		A1,si_Buffer(A2)
		move.w		#11,si_MaxChars(A2)

		lea		ToGad(PC),A1
		lea		ToInfo(DB),A2
		move.l		A2,gg_SpecialInfo(A1)
		lea		ToBuf(DB),A1
		move.l		A1,si_Buffer(A2)
		move.w		#11,si_MaxChars(A2)

		Prepare		Exec_Call
		suba.l		A1,A1
		CallLib		FindTask		; Find us
		movea.l		D0,A2
		tst.l		pr_CLI(A2)
		bne.S		GetLibs
		lea		pr_MsgPort(A2),A0
		CallLib		WaitPort		; wait for a message
		lea		pr_MsgPort(A2),A0
		CallLib		GetMsg			; then get it
		move.l		D0,WBenchMsg(DB)	; save it for later reply
GetLibs		lea		IntuiName(PC),A1
		CallLib		OldOpenLibrary
		move.l		D0,IntuiBase(DB)
		beq.S		Error

		Prepare		Intuition_Call
		lea		NW(PC),A0
		CallLib		OpenWindow
		move.l		D0,DWindow(DB)
		movea.l		D0,A0
		beq.S		Error
		move.l		wd_RPort(A0),Rp(DB)
		move.l		wd_UserPort(A0),Up(DB)
		lea		WinTitle(PC),A1
		lea		ScrTitle(PC),A2
		CallLib		SetWindowTitles
		bra.S		Main

Error
Exit
FreeWindow	Prepare		Intuition_Call
		move.l		DWindow(DB),D0
		beq.S		FreeIntui
		move.l		D0,A0
		CallLib		CloseWindow
FreeIntui	Prepare		Exec_Call
		move.l		IntuiBase(DB),D0
		beq.S		ReplyWB
		movea.l		D0,A1
		CallLib		CloseLibrary
ReplyWB		move.l		WBenchMsg(DB),D2
		beq.S		AllDone
		CallLib		Forbid
		movea.l		D2,A1
		CallLib		ReplyMsg		; Reply WBenchMessage if we are started from WB
AllDone		dcFree
		moveq		#0,D0
DoNothing	rts


Main
EventLoop	movea.l		Up(DB),A0
		Prepare		Exec_Call
		CallLib		WaitPort
GetNextMsg	Call		GetAMessage
		beq.S		EventLoop
		move.l		Class(DB),D0
		cmp.l		#CLOSEWINDOW,D0
		beq.S		Exit
		andi.w		#GADGETDOWN+GADGETUP,D0
		bne.S		GJ
		cmp.l		#ACTIVEWINDOW,D0
		bne.S		GetNextMsg
		Call		ActivateFrom
		bra.S		GetNextMsg
GJ		movea.l		IAddress(DB),A1
		move.w		gg_GadgetID(A1),D0	; GadgetID is offset from GJ
		jsr		GJ(PC,D0.W)
		bra.S		GetNextMsg

*»»» User pressed RETURN in the 'To' string-gadget,
*»»» or activated the window, or an error was found
*»»» in the 'From' string-gadget.
ActivateFrom	lea		FromGad(PC),A0
		bra.S		ActivateStr
*»»» User pressed RETURN in the 'From' string-gadget,
*»»» or an error was found in the 'To' string-gadget.
ActivateTo	lea		ToGad(PC),A0
ActivateStr	Prepare		Intuition_Call
		move.l		DWindow(DB),A1
		suba.l		A2,A2
		CallLib		ActivateGadget
		rts

*»»» User clicked the 'Solve' button
DoSolve		lea		FromBuf(DB),A0
		Call		ParseDate
		bmi.S		1$
		move.l		D1,D4
		move.l		D2,D5
		move.l		D3,D6
		lea		ToBuf(DB),A0
		Call		ParseDate
		bmi.S		2$
		exg		D1,D4
		exg		D2,D5
		exg		D3,D6
		move.l		D3,D0
		swap		D0
		move.w		D2,D0
		lsl.w		#8,D0
		move.b		D1,D0
		move.l		D6,D7
		swap		D7
		move.w		D5,D7
		lsl.w		#8,D7
		move.b		D4,D7
		cmp.l		D0,D7		; Compare date order
		blt.S		1$
		Call		CalcDays
		lea		TxtAre+6(PC),A0
		Call		MakeDecStr
		Call		PrintSolution
		Call		ActivateFrom
		rts
1$		Call		ActivateFrom
		bra.S		3$
2$		Call		ActivateTo
3$		Prepare		Intuition_Call
		move.l		DWindow(DB),A0
		move.l		wd_WScreen(A0),A0
		CallLib		DisplayBeep
		lea		TxtAre+6(PC),A0
		moveq		#8,D0
4$		move.b		#'?',(A0)+
		dbf		D0,4$
		Call		PrintSolution
		rts

PrintSolution	Prepare		Intuition_Call
		move.l		Rp(DB),A0
		lea		ITxtAre(PC),A1
		move.w		#Sx,D0
		moveq		#Sy,D1
		CallLib		PrintIText
		rts

*»»» Call:	D1 = Day	(from)
*»»»		D2 = Month	(from)
*»»»		D3 = Year	(from)
*»»»		D4 = Day	(to)
*»»»		D5 = Month	(to)
*»»»		D6 = Year	(to)
CalcDays	Push		D1-D7/A0
		moveq		#0,D7
		move.w		D3,D0
		Call		AdjustYear		
		lea		Days-1(PC),A0
		add.w		D2,A0
		move.b		(A0)+,D7
		sub.w		D1,D7
		add.w		D4,D7
		sub.w		D3,D6
		subq.w		#1,D6
		bge.S		1$
		sub.w		D2,D5
		bgt.S		6$
		move.w		D4,D7
		sub.w		D1,D7
		bra.S		9$
1$		neg.w		D2
		add.w		#12,D2
		bra.S		3$
2$		moveq		#0,D0
		move.b		(A0)+,D0
		add.l		D0,D7
3$		dbf		D2,2$
		bra.S		5$
4$		add.l		#365-28,D7
		moveq		#0,D0
		move.b		Days+1(PC),D0
		add.l		D0,D7
5$		addq.w		#1,D3
		move.w		D3,D0
		Call		AdjustYear		
		dbf		D6,4$
		lea		Days(PC),A0
6$		subq.w		#1,D5
		bra.S		8$
7$		moveq		#0,D0
		move.b		(A0)+,D0
		add.l		D0,D7
8$		dbf		D5,7$
9$		move.l		D7,D0
		Pop		D1-D7/A0
		rts

*»»» Call:	D0 = year to adjust
*»»» Changes the number of days in the month of February
*»»» according to the rules for leapyear.
AdjustYear	Push		D0-D1/A0
		ext.l		D0
		move.l		D0,D1
		andi.w		#%11,D1			;Year%4
		bne.S		1$
		move.l		D0,D1
		divu		#400,D1			;Year%400
		swap		D1
		tst.w		D1
		beq.S		2$
		move.l		D0,D1
		divu		#100,D1
		swap		D1			;Year%100
		tst.w		D1
		bne.S		2$
1$		moveq		#28,D0
		bra.S		3$
2$		moveq		#29,D0			;If ((Year%400==0)||((Year%100!=0)&&(Year%4==0)))
3$		lea		Days+1(PC),A0
		move.b		D0,(A0)			;Days[1]=28 or Days[1]=28
		Pop		D0-D1/A0
		rts

*»»» Call:	A0 = String
ParseDate	Call		DoNumber
		bne.S		1$
		move.l		D0,D1		; Day
		Call		DoNumber
		bne.S		1$
		move.l		D0,D2		; Month
		Call		DoNumber
		bmi.S		1$
		beq.S		1$
		move.l		D0,D3		; Year
		Call		AdjustYear	; Check for valid date
		tst.l		D2
		ble.S		1$
		cmp.w		#12,D2
		bgt.S		1$
		tst.l		D1		; Month was valid
		ble.S		1$
		lea		Days(PC),A0
		cmp.b		-1(A0,D2),D1
		bgt.S		1$
		moveq		#0,D0		; And day was valid too
		rts
1$		moveq		#-1,D0
		rts

*»»» Call:	A0 = String
DoNumber	Push		D1
		moveq		#0,D0
1$		move.b		(A0)+,D1
		beq.S		6$
		cmp.b		#'-',D1
		beq.S		5$
		sub.b		#'0',D1
		blt.S		4$
		cmp.b		#9,D1
		bgt.S		4$
		mulu		#10,D0
		ext.w		D1
		add.w		D1,D0
		bra.S		1$
4$		moveq		#-1,D1
		bra.S		3$
6$		moveq		#1,D1
		bra.S		3$
5$		moveq		#0,D1
3$		Pop		D1
		rts

*»»» Call:	D0 = Number to convert to ascii
*»»»		A0 = Where to put string
MakeDecStr	Push		D1-D5/A0
		moveq		#9,D1
		tst.l		D0
		beq.S		6$
		subq.l		#1,D1
		asl.l		#2,D1
		moveq		#' ',D4
		moveq		#'0',D2
1$		move.w		D2,D3
		move.l		9$(PC,D1.l),D5
2$		cmp.l		D5,D0
		blt.S		3$
		addq.w		#1,D3
		sub.l		D5,D0
		bra.S		2$
3$		cmp.b		D2,D3
		bne.S		4$
		move.w		D4,D3
		bra.S		5$
4$		move.w		D2,D4
5$		move.b		D3,(A0)+
		subq.w		#4,D1
		bge.S		1$
		bra.S		8$
6$		subq.l		#2,D1
7$		move.b		#' ',(A0)+
		dbf		D1,7$
		move.b		#'0',(A0)+
8$		Pop		D1-D5/A0
		rts
9$		dc.l		1,10,100,1000,10000,100000,1000000,10000000

GetAMessage	Push		D0-D1/A0-A1/A6
		movea.l		Up(DB),A0
		Prepare		Exec_Call
		CallLib		GetMsg
		tst.l		D0
		beq.S		1$
		movea.l		D0,A1
		move.l		20(A1),Class(DB)
		move.l		28(A1),IAddress(DB)
		CallLib		ReplyMsg
		moveq		#1,D0
1$		Pop		D0-D1/A0-A1/A6
		rts

Days		dc.b		31,28,31,30,31,30,31,31,30,31,30,31

IntuiName	dc.b		'intuition.library',0
		EVEN

IDCMPFlags	=GADGETUP+GADGETDOWN+CLOSEWINDOW+ACTIVEWINDOW
OtherFlags	=WINDOWCLOSE+WINDOWDRAG+WINDOWDEPTH+NOCAREREFRESH+ACTIVATE
NW		dc.w		320-WW/2,128-WH/2,WW,WH
		dc.b		0,1
		dc.l		IDCMPFlags,OtherFlags
		dc.l		GadgetList,0,0,0,0
		dc.w		0,0,0,0,WBENCHSCREEN

WW		=222		; window width
WH		=78		; window height
SW		=53		; gadget width
SH		=21		; gadget height
Sx		=157		; gadget xpos
Sy		=34		; gadget ypos
FW		=88		; gadget width
FH		=10		; gadget height

GadgetList
FromGad		Gadget		ToGad,52,33,FW,FH,GADGHCOMP,RELVERIFY,STRGADGET
		Gadget2		FBorder,0,ITxtFrom,0,0,ActivateTo-GJ,0
ToGad		Gadget		SolveGad,52,48,FW,FH,GADGHCOMP,RELVERIFY,STRGADGET
		Gadget2		FBorder,0,ITxtTo,0,0,ActivateFrom-GJ,0
SolveGad	Gadget		0,Sx,Sy,SW,SH,GADGHCOMP,RELVERIFY,BOOLGADGET
		Gadget2		ButBorder,0,ITxtSolve,0,0,DoSolve-GJ,0

ButBorder	Border		-2,-1,1,0,1,9,ButVectors,But2Border
ButVectors	dc.w		2,0,SW+1,0,SW+3,2,SW+3,SH-1,SW+1,SH+1,2,SH+1,0,SH-1,0,2,2,0
But2Border	Border		-107,37,1,0,1,2,FVectors,0
FBorder		Border		0,8,1,0,1,2,FVectors,0
FVectors	dc.w		0,0,FW-1,0

ITxtSolve	IntuiText	3,0,1,6,7,TxtSolve,ITxtAre
ITxtAre		IntuiText	1,0,1,-147,29,TxtAre,ITxtFormat
ITxtFormat	IntuiText	1,0,1,-148,-16,TxtFormat,0
ITxtFrom	IntuiText	1,0,1,-43,0,TxtFrom,0
ITxtTo		IntuiText	1,0,1,-43,0,TxtTo,0

TxtSolve	dc.b		'Solve',0
TxtAre		dc.b		'are   ?????????   days',0
TxtFormat	dc.b		'Date-format is DD-MM-YYYY',0
TxtFrom		dc.b		'From',0
TxtTo		dc.b		'to',0
WinTitle	dc.b		'Day2Day V1.0',0
ScrTitle	dc.b		'Day2Day V1.0 © 1991 by Preben Nielsen',0
		EVEN

TxtAttr		dc.l		FontName
		dc.w		TOPAZ_EIGHTY
		dc.b		FS_NORMAL,FPB_ROMFONT
FontName	dc.b		'topaz.font',0
		END