Date: Wednesday, July 20, 1994
From: jp9786@u.cc.utah.edu
  Re: ML Calender Drawer

--> S/SX/G/GX

[Wow!  This is *fast*!!!  Try this!  -jkh-]

Here is the Calender Drawer routine that I will be implimenting in
the new scheduler I'm writing.  Its core is ML so its very fast (20 times
as fast as my calender drawing routine in Schedule '48).  I thought I'd
post it because it could be used in other programs as well.

Just put a date on line 1 (yr = 1580 - 9999) and run the program.

Have fun, Jerry

[Note: European-format dates (flag -42 set) mess up if the day is
above 12, so only use this with flag -42 clear.  Also, "October" was
misspelled in the posted listing below, but I fixed it in the binary
version on this disk, and added SetDA12Temp at the end.  -jkh-]

****************************************************************************
****************************************************************************
* NAME: CALENDER DRAWER
* CATEGORY: PERSONAL ORGANIZING
* ENTRY: 
* STACK: DATE (FLOATING POINT) 
*
*
* R4=YMD
* R3=
* R2=
* R1=|DAYS.IN.MONTH|DOW|
* R0=
*
*
*
****************************************************************************
****************************************************************************
ASSEMBLE
	NIBASC \HPHP48-D\
=DaysInMonth  EQU   #D4DA
=YMD>dow      EQU   #D77E
=LEAPYR?      EQU   #D485
=FEBUARY      EQU   2
=ONEROW.NUM   EQU   94
=ONEROW.ABF   EQU   34 
=ONEROW.TEM   EQU   24
=TEMPLATE_OFFSET EQU #CC
=ABUFF_ROWS   EQU   55
RPL
::
 CK1
 DUP
 CODE
	GOSBVL =POPDATE%	* A:000000000000YYYY
*				* B:00000000000000MM
*				* C:00000000YYYYMMDD
*				* D:00000000000000DD
*				* DEC MODE
*				    *
	R4=C			* STORE YMD IN R4	R4=C*
	GOSBVL	  =DaysInMonth	* D0->DAYS.IN.MONTH
	GOSBVL	=LEAPYR?	* CS IF LEAP YEAR
	GONC	GET_DAYS	* NO CARRY FORGET IT
	C=0 W			* INITIALIZE C(A) LATER STORAGE
	LC(2)	=FEBUARY	* --- MONTH NOT FEBUARY? --- *
	?B#C	B
	GOYES	GET_DAYS	* IF NOT JUST GET DAYS IN MONTH
	LC(2)	#29		* OTHERWISE THERE ARE 29 DAYS
	GOTO	GOT_DAYS	* SKIP READING # OF DAYS IN MONTH
GET_DAYS
	C=0	W		* INITIALIZE C(W) FOR LATER STORAGE
	C=DAT0	B		* C(B) = DAYS IN MONTH (DEC)
GOT_DAYS
	R1=A			* STORE YEAR IN R1 TEMPORARILY
	ABEX	A		*
	R0=A			* STORE " IN RO "
	GOSBVL	=DCHXW		* DaysInMonth(DEC)--->DaysInMonth(HEX)
	GOSBVL	=ASLW5		* SHIFT LEFT FOR STORAGE
	AR1EX			* A(A) GETS YEAR R1=D.I.M00000
	C=R0.F	B		* C(B) GETS MONTH
	B=C	B		* B(B) GETS MONTH
	LC(2)	1		* FIRST DAY IN MONTH
	D=C	B		* D(B)=FIRST DAY IN MONTH
	SETDEC			* NECESSARY FOR NEXT CALL
	GOSBVL	=YMD>dow	* A(B)=(DOW) (1=MON)
	SETHEX			* RETURN TO HEX MODE
	P=	0		* RESTORE P
	LC(2)	7		* --- (MON-SUN) --> (SUN-SAT) --- *
	?C#A	B
	GOYES	INCR_DOW
	A=0	B
INCR_DOW
	A=A+1	B
	R1=A.F	B		* R1=|DAYS IN MONTH|DOW|
	GOSBVL	=DisableIntr	* DISABLE INTERUPTS
	GOSBVL	=D0->Row1	* D0->TOP LINE CURRENT DISPLAY
	LC(2)	=ABUFF_ROWS	* LOOP COUNTER FOR CLEARING SCREEN
	B=C	B		* B(B) GETS LOOP COUNTER
	CD0EX			* STORE D0 IN C(A)
	D0=C
	A=0	W		* CLEARING DATA
CLEAR_NEXT_ROW
	DAT0=A	W		* CLEAR 16 NIBS
	D0=D0+	16		* MOVE TO NEXT 16 NIBBS
	DAT0=A	W		* CLEAR 16 NIBS
	D0=D0+	16		* MOVE TO NEXT 2 NIBBS
	DAT0=A	B		* CLEAR 2 NIBS
	D0=D0+	2		* MOVE TO NEXT LINE
	B=B-1	B		* DECREMENT COUNTER
	GONC	CLEAR_NEXT_ROW
	D0=C			* RESTORE D0
	AD0EX			* -- ADD OFFSET TO TEMPLATE DESTINATION -- *
	LC(5)	=TEMPLATE_OFFSET
	A=A+C	A
	D0=A
	GOSUB	SKIP1
	NIBHEX	FFFFFFFFFFFF	* TEMPLATE DATA
	NIBHEX	FFFFFFFFFF10
	NIBHEX	F9AFE2E15FE2
	NIBHEX	E15F19F3BF10
	NIBHEX	FEAF4AEB5FEA
	NIBHEX	FB5FD5FD5F10
	NIBHEX	FDAFAAEB5FA2
	NIBHEX	EB1F19FB1F10
	NIBHEX	FBAFEAEB5F4A
	NIBHEX	FB5FD5F75F10
	NIBHEX	FC8FE2EB1FE2
	NIBHEX	EB5FD5F95F10
	NIBHEX	FFFFFFFFFFFF
	NIBHEX	FFFFFFFFFF10
SKIP1
	C=RSTK
	D1=C			* D1 = TEMPLATE DATA ADDR.
	LC(2)	6		* (ROWS TO WRITE) - 1
NXT_ROW 
	A=DAT1	W		* -- DRAW TEMPLATE -- *
	DAT0=A	W
	D1=D1+	16
	D0=D0+	16
	A=DAT1	8
	DAT0=A	8
	D0=D0+	16
	D0=D0+	2
	D1=D1+	8
	C=C-1	B
	GONC	NXT_ROW
	D0=D0+	16		* -- D0->NUMBER DESTINATION -- *
	D0=D0+	16
	D0=D0+	3
	C=R1.F	B		* -- B(B)=DOW-1 -- *
	C=C-1	B
	B=C	B
	GOTO	DECR.B		* -- D0->NUMBER DESTINATION FIRST WEEK -- *
NXT_BOX 
	D0=D0+	3
DECR.B B=B-1   B
	GONC	NXT_BOX
	GOSUB	SKIP2
	NIBHEX	0800C00C00210E10C00E10	 * -- NUMBERS FONT DATA -- *
	NIBHEX	C00C04C04804C04C04214E14C
	NIBHEX	04E14C04C06C06806C06C0
	NIBHEX	6216E16C06E16C06C06C06800
	NIBHEX	0C00210210210200200010
	NIBHEX	210216216C062162162162062
	NIBHEX	06016216219219C0921921
	NIBHEX	9219209209019219219219C00
	NIBHEX	0800010800210E00E00800
	NIBHEX	C00214214804014804214E04E
	NIBHEX	04804C0421821880801880
	NIBHEX	8218E08E08808C08214214800
	NIBHEX	0800800010E10210210400
	NIBHEX	210C14214804804014E142142
	NIBHEX	14404214C1421480480401
	NIBHEX	4E14214214404214C18218800
	NIBHEX	0800400210010010210400
	NIBHEX	2100142148044042140140142
	NIBHEX	1440421401221280240221
	NIBHEX	2012012212402212019219800
	NIBHEX	0C10E10C00010E00C00400
	NIBHEX	C0001EC0EC1EE1EC0E01EE0EC
	NIBHEX	0E40EC0E01FC0FC1FE1FC0
	NIBHEX	F01FE0FC0F40FC0F016C06C10
SKIP2
	C=RSTK
	D1=C			* D1->NUMBERS.DAT
	LC(2)	8		* -- C(B)=DAYS.TO.WRITE -- *
	A=R1.F	B
	C=C-A	B
	GOSUB	DRAW_WEEK	* -- DRAW WEEK WITH C(B) DAYS AT D0
*				    WITH D1 NUMBERS -- *
	C=R1.F	B		* -- MOVE DAY TO SUNDAY -- *
	C=C-1	B
	B=C	B
	GOTO	DECR.B2
MOVE_BACK_1BOX
	D0=D0-	3
DECR.B2
	B=B-1	B
	GONC	MOVE_BACK_1BOX
	LC(2)	7		* -- DRAW NEXT 3 WEEKS -- *
	GOSUB	DRAW_WEEK
	LC(2)	7
	GOSUB	DRAW_WEEK
	LC(2)	7
	GOSUB	DRAW_WEEK
	A=R1			* -- CALCULATE DAYS LEFT IN MONTH -- *
	A=A-1	B
	LC(5)	#1C
	A=A-C	B
	C=A B
	GOSBVL	=ASRW5
	C=C+A	B
	?C=0	B
	GOYES	THE_END
	LA(2)	8
	?C>=A	 B		 * ARE DAYS.LEFT > SEVEN
	GOYES	ONE_MORE_WEEK
	GOSUB	DRAW_WEEK
	GOTO	THE_END
ONE_MORE_WEEK
	LC(2)	7
	GOSUB	DRAW_WEEK
	A=R1.F	B		* -- CALCULATE # OF DAYS TO WRITE -- *
	LC(2)	5
	A=A-C	B
	C=A	B
	GOSUB	DRAW_WEEK
THE_END 
	GOSBVL	=AllowIntr	* ENABLE INTERUPTS
	GOSBVL	=GETPTRLOOP	* SEE YA!
*****************************************************************************
** NAME: WEEK DRAWER							
** ENTRY: D0->DESTINATION OF WEEK IN ABUFF
**	  D1->NUMBER TO START WITH IN NUMBERS GROB
**	  C(B)=NUMBER OF DAYS TO WRITE
**
** EXITS: D0->DESTINATION OF NEXT WEEK
**	  D1->NEXT SEVEN NUMBERS IN NUMBERS GROB
**	  SREEN SHOWS NEXT WEEK
**
*****************************************************************************
DRAW_WEEK
	C=C-1	B		* -- B(B)=DAYS TO WRITE LOOP COUNTER -- *
	B=C	B
	LC(2)	5		* -- D(B)=ROWS TO WRITE LOOP COUNTER -- *
	D=C	B
	C=B	B		* PUT B(B) BACK FOR STORAGE
NXT_ROW_WEEK
	CD0EX			* -- STORE D0, D1, DAYS TO WRITE LOOP COUNTER
	RSTK=C
	CD0EX
	CD1EX
	RSTK=C
	CD1EX
	RSTK=C			* RSTK ALSO REMEMBERS LOOP COUNTER
NEXT_BOX2			* <----------------------------------|
	A=DAT1	X		* READ TOP LINE BOX 1		     |
	DAT0=A	X		* WRITE TO SCREEN		     |
	D1=D1+	3		* MOVE TO NEXT BOX		     |
	D0=D0+	3		* MOVE TO NEXT BOX DESTINATION	     |
	B=B-1	B		* DECREMENT COUNTER		     |
	GONC	NEXT_BOX2	* DRAWN ENOUGH CALENDER BOXES? NO ---|
	C=RSTK			* -- RESTORE LOOP COUNTER -- *
	B=C	B
	LC(5)	=ONEROW.NUM	* -- D1->NEXT.WEEK.OF.NUMBERS
	A=C	A
	C=RSTK
	C=C+A	A
	D1=C
	LC(5)	=ONEROW.ABF	* -- D0->NEXT.WEEK.OF.NUMBERS.DESTINATION
	A=C	A
	C=RSTK
	C=C+A	A
	D0=C
	C=B	B		* RESTORE LOOP COUNTER IN C(B) FOR ABOVE STORE
	D=D-1	B		* DECR ROWS TO WRITE LOOP COUNTER
	GOC	DONE_WEEK
	GOTO	NXT_ROW_WEEK
DONE_WEEK
	D0=D0+	16		* SKIP NEXT ROW (BLANK SPACE)
	D0=D0+	16
	D0=D0+	2
	LC(5)	#234		* -- MOVE D1 TO NEXT 7 DAYS -- *
	AD1EX
	A=A-C	A
NEXT_DAY_OVER
	A=A+CON A,3
	B=B-1	B
	GONC	NEXT_DAY_OVER
	D1=A
	RTN
ENDCODE
 ABUFF
 FORTYFIVE
 ZERO
 4PICK
 %IP>#
ASSEMBLE
	CON(5)	=DOARRY
	REL(5)	endarry
	NIBHEX C2A2010000C000031000A4
	NIBHEX 14E4551425953100064542
	NIBHEX 455142595F0000D4142534
	NIBHEX 84F000014052594C4B0000
	NIBHEX D41495D0000A455E454D00
	NIBHEX 00A455C495110001455745
	NIBHEX 53545710003554054554D4
	NIBHEX 24542531000F43445F4245
	NIBHEX 43551000E4F46554D42454
	NIBHEX 255100044543454D4245425
endarry
RPL
 GETATELN
 DROP
 APPEND_SPACE
 CHR '
 >T$
 5ROLL
 Date>d$
 DUPLEN$
 #1-
 LAST$
 &$
 BINT_131d
 CENTER$3x5
 DROP
;