;*************************** AMUS Program Label ******************************
; Filename: CAL.M68                                         Date: 8/7/90
; Category: CAL          Hash Code: 367-424-345-632      Version: 1.0(101)
; Initials: ROBB/AM      Name: Erik Petrich
; Company: Microlink Computing Systems, Inc.       Telephone #: 4053218333
; Related Files: 
; Min. Op. Sys.: NONE                          Expertise Level: BEG
; Special: You need M68 version 2.0 or above.
; Description: Displays a month calendar for any date in the current century.
; By default, it displays the current month.
; 
;*****************************************************************************
;
; Copyright 1990 Microlink Computing Systems, Inc.
;
;Edit History:
;[100] 02 May 1990 00:22	Edited by Erik Petrich
;[101] 07 August 1990 03:00	Edited by Erik Petrich
;	Rewrote the CheckGraphics subroutine to work correctly in a more
;	diverse operating environment.
;

	SEARCH	SYS
	SEARCH	SYSSYM
	SEARCH	TRM

	ASMMSG	"**** After assembly, type LNKLIT CAL"


	VMAJOR = 1.
	VMINOR = 0.
	VEDIT  = 101.

	radix	^D8

	.ofini
	.ofdef	WorkingDay,2
	.ofdef	MaxDays,2
	.ofdef	Month,2
	.ofdef	Year,2
	.ofdef	Day,2
	.ofdef	TextOnly,2
	.ofdef	StrBuffer,50.
	.ofdef	TermFeatures,tc.szb
	.ofsiz	impsiz


define	crt	code
	movw	#^D<code>,d7
	call	crtsub
	endm

define	grafon
	crt	23
	endm
define	grafoff
	crt	24
	endm

	extern	$dstoi
	extern	$idtim

	phdr	-1,0,ph$ree!ph$reu
	br	Start
	ascii	/Copyright 1990 Microlink Computing Systems, Inc./
	even

Start:
	getimp	impsiz,a5
	call	CheckGraphics

Parse:	byp
	lin
	bne	10$
	gdates	d3
	br	20$

10$:	mov	#2,d5
	call	$idtim
	beq	20$
	typecr	<You must enter a complete date>
	exit

20$:	mov	d3,d1
	movb	d1,year(a5)
	swap	d1
	movb	d1,month(a5)
	rolw	d1,#8.
	movb	d1,day(a5)
	mov	d3,d7
	and	#^h<0ffffff>,d7
	add	#^h<1000000>,d7
	call	$dstoi
	sub	#2415021.,d7	; d7 =the number of days since Jan 1,1900
	div	d7,#7.
	clrw	d7
	swap	d7
	cmpw	d7,#6
	bne	30$
	movw	#-1,d7
30$:	negw	d7
	movw	d7,WorkingDay(a5)

	movw	Month(a5),d1	; find the total days this month
	lea	a6,DaysInMonth
	clr	d7
	movb	0(a6)[~d1],d7
	movw	d7,MaxDays(a5)
	cmpw	d1,#2
	bne	40$
	movw	Year(a5),d1
	andw	#3,d1
	bne	40$
	movw	#29.,MaxDays(a5)
40$:

DrawIt:
	crlf
	Call	DisplayHeader
	grafon
	call	TopLine
	ctrlc	done
	call	NumberLine
	ctrlc	done
10$:	call	MiddleLine
	ctrlc	done
	call	NumberLine
	ctrlc	done
	movw	WorkingDay(a5),d1
	cmpw	d1,MaxDays(a5)
	blos	10$
	call	BottomLine
	ctrlc	done
done:
	crlf
	grafoff
	exit

; Draw the top part of the boxes on the calendar
TopLine:
	save	d1
	movw	#177400+12.,d1
	tcrt
	rest	d1
	crt	38
	movw	#5.,d2
10$:	crt	46
	crt	46
	crt	42
	dbf	d2,10$
	crt	46
	crt	46
	crt	39
	crlf
	rtn

; Draw the bottom part of the boxes on the calendar
BottomLine:
	crt	40
	movw	#5.,d2
10$:	crt	46
	crt	46
	crt	45
	dbf	d2,10$
	crt	46
	crt	46
	crt	41
	crlf
	rtn

; Draw the intersection of boxes in between weeks
MiddleLine:
	crt	44
	movw	#5.,d2
10$:	crt	46
	crt	46
	crt	48
	dbf	d2,10$
	crt	46
	crt	46
	crt	43
	crlf
	rtn

; Draw the numbers on the calendar
NumberLine:
	crt	47
	movw	#6.,d2
	clr	d1
10$:	movw	WorkingDay(a5),d1
	cmpw	d1,#1.
	blo	20$
	cmpw	d1,MaxDays(a5)
	bhi	20$
	grafoff
	cmpw	d1,Day(a5)
	bne	15$
	save	d1
	movw	#177400+11.,d1	; make today's date stand out from the rest
	tcrt
	rest	d1
15$:	dcvt	2,ot$trm!ot$zer
	cmpw	d1,Day(a5)
	bne	17$
	save	d1
	movw	#177400+12.,d1
	tcrt
	rest	d1
17$:	grafon
	br	30$
20$:	type	<  >
30$:	crt	47
	incw	WorkingDay(a5)
	dbf	d2,10$
	crlf
	rtn

; do a TCRT code, translating graphic calls to ascii characters if
; CheckGraphics had determined that our terminal can't do graphics.
CRTsub:	save	d1
	tstw	TextOnly(a5)
	beq	50$
	cmpw	d7,#24.
	blos	90$
	cmpw	d7,#47.
	bne	10$
	type	< >	; really |, but a space looks better
	br	90$
10$:	cmpw	d7,#46.
	bne	20$
	type	<->
	br	90$
20$:	type	<+>
	br	90$
50$:	movw	#177400,d1
	orw	d7,d1
	tcrt
90$:	rest	d1
	rtn



; Display the month & year, centered at the top of the calendar
DisplayHeader:
	lea	a2,StrBuffer(a5)
	lea	a1,MonthNames
	movw	Month(a5),d2
10$:	decw	d2
	beq	30$
20$:	tstb	(a1)+
	bne	20$
	br	10$
30$:	movb	(a1)+,(a2)+
	bne	30$
	dec	a2
	clr	d1
	movw	Year(a5),d1
	add	#1900.,d1
	dcvt	0,ot$mem!ot$lsp
	clrb	@a2
	lea	a2,StrBuffer(a5)
	call	StrLen
	subw	#22.,d2
	negw	d2
	lsrw	d2,#1
40$:	beq	50$
	typesp
	decb	d2
	br	40$
50$:	ttyl	StrBuffer(a5)
	crlf
	rtn


DaysInMonth:
	byte	0,31.,28.,31.,30.,31.,30.,31.,31.,30.,31.,30.,31.
MonthNames:
	asciz	/January/
	asciz	/February/
	asciz	/March/
	asciz	/April/
	asciz	/May/
	asciz	/June/
	asciz	/July/
	asciz	/August/
	asciz	/September/
	asciz	/October/
	asciz	/Novermber/
	asciz	/December/
	byte	0
	even

StrLen:	save	a2
	clr	d2
10$:	tstb	(a2)+
	beq	20$
	inc	d2
	br	10$
20$:	rest	a2
	rtn

; This entire subroutine was rewritten in edit [101]
;
; Check to see if the current terminal supports graphics characters
CheckGraphics:
	mov	ph.ver,d7
	and	#^H0FF0FF000,d7		; mask out edit & patch levels
	cmp	d7,#<1_24.>+<3_16.>+<3_12.> ; pre 1.3C ???
	blo	10$			; assume the worst if so
	jobidx
	mov	jobtrm(a6),a6
	mov	t.tdv(a6),a6
	movw	@a6,d7
	andw	#td$tch,d7		; TRMCHR is not supported
	beq	10$			; on the current terminal driver
	trmchr	TermFeatures(a5),tc$bmp
	movw	<32./8.>+tc.bmp+TermFeatures(a5),d7
	andw	#^B1111111111100000,d7
	cmpw	d7,#^B1111111111100000	; check from TCRT codes 38 -> 48
	beq	20$
10$:	setw	TextOnly(a5)
20$:	rtn

	end


.