; Filename: CAL.M68 Date: 8/7/90

;*************************** 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