.Z80 ;Calendar application for Write-Hand-Man ; ;** Written by D.W.Clements for Hisoft 1986 ** ; ;Amstrad PCW8256 version August 1986 ; Tided by Dave Nutkins Feb 87 org 0 base equ $ bdos equ base+5 cal equ base+080h ;used as workspace for our calendar string equ 9 conio equ 6 settime equ 104 gettime equ 105 epar equ 255 esc equ 27 cr equ 13 lf equ 10 .z80 xbios macro adr call 0fc5ah dw adr endm KM_KT_GET equ 0dah KM_KT_PUT equ 0ddh TE_ASK equ 0bfh org 0100h start: ld de,sysdays ;get the time from CPM ld c,gettime call bdos xbios TE_ASK ld (viewtop),bc ld (viewsize),de ld de,curoff call pstring call dispage call setwindow ld hl,(sysdays) ld (days),hl call setvals call setvals1 call pcalendar xor a ld (bar),a ;set initial value of bar cursor keyloop: key1: call dobar kshift equ 21 kalt equ 80 kextra equ 84 kshlock equ 70 kright equ 6 kleft equ 15 kup equ 14 kdown equ 79 kplus equ 23 kminus equ 76 kexit equ 8 repeat equ 3 shift equ 5 ; bit in the shift status byte LD DE,5000 key2: xbios KM_KT_GET jr C,key3 DEC DE LD a,e or d jr nz,key2 jr keyloop ; key number in bc key3: ld a,c cp kshift jr z,key1 cp kalt jr z,key1 cp kextra jr z,key1 cp kshlock jr Z,key1 cp kexit jp z,exit cp kup jp z,nextyear cp kdown jp z,lastyear cp kleft jp z,goleft cp kright jp z,goright cp kplus jp z,incval cp kminus jp z,decval jp keyloop exit: ; ld de,sysdays ; ld c,settime ; call bdos call restwindow jp base dispage: ld de,home call pstring ld de,topline call pstring ld b,27 meloop: ld a,8ah call writechar djnz meloop ld de,topline1 call pstring ld b,27 meloop1: call writespace djnz meloop1 ld de,topline2 call pstring ld b,23 meloop2: ld a,08ah call writechar djnz meloop2 ld de,topline3 call pstring ld b,7 ld c,9 ld de,line ld hl,daynames ploop: push de push bc ld bc,3 inc de ldir pop bc pop de inc hl push hl push de push bc call bdos pop bc pop de pop hl djnz ploop ld de,botline call bdos ld b,23 meloop5: ld a,8ah call writechar djnz meloop5 ld de,botline1 call pstring ld de,barline call pstring ld b,27 meloop6: call writespace djnz meloop6 ld de,barline1 call pstring ld b,27 meloop7: ld a,8ah call writechar djnz meloop7 ld de,barline2 jp pstring topline: defb esc,"p",086h,24h topline1: defb 08ch,cr,lf defb 085h,24h topline2: defb 085h,cr,lf,087h defb 08ah,08ah,08ah,084h,24h topline3: defb 08dh,cr,lf,024h line: defb 085h defs 3,32 defb 095h defs 23,32 defb 085h,cr,lf,024h botline: defb 87h,8ah,8ah,8ah,81h,24h botline1: defb 8dh,13,10,024h barline: defb 85h,24h barline1: defb 85h,13,10 db 83h,24h barline2: db 89h,24h curon: db 27,"e$" curoff: db 27,"f$" daynames: sun: defb "Sun$" mon: defb "Mon$" tue: defb "Tue$" Wed: defb "Wed$" thu: defb "Thu$" fri: defb "Fri$" sat: defb "Sat$" restwindow: ld de,curon call pstring ld a,27 call writechar ld a,'X' call writechar ld a,(viewtop+1) call writeascii ld a,(viewtop) call writeascii ld a,(viewsize+1) call writeascii ld a,(viewsize) writeascii: add a,32 writechar: push de push bc push af ld e,a ld c,6 call bdos pop af pop bc pop de ret writespace: xor a jr writeascii setwindow: ld a,27 call writechar ld a,'X' call writechar ld a,(viewtop+1) inc a ; 1 down call writeascii ld a,(viewtop) ; 1 across inc a call writeascii ld a,(viewsize+1) call writeascii ;leave the length alone? ld a,49 ;width why? jr writeascii viewtop: dw 0 viewsize: dw 0 nextyear: ld hl,yy ld a,(hl) or a jr nz,not2001y ld a,77 not2001y: inc a cp 100 jr nz,not100a ld a,0 not100a: ld (hl),a call dodays call pcalendar jp keyloop lastyear: ld hl,yy ld a,(hl) cp 78 jr nz,notyy77 ld a,1 notyy77: or a jr nz,notffyy ld a,100 notffyy: dec a ld (yy),a call dodays call pcalendar jp keyloop goleft: bit shift,b jr nz,leftsel lastmonth: ld hl,mm ld a,(hl) dec a and a jr nz,not0m ld a,12 not0m: ld (hl),a call dodays call pcalendar jp keyloop goright: bit shift,b jr nz,rightsel nextmonth: ld hl,mm ld a,(hl) inc a cp 13 jr nz,not13m ld a,1 not13m: ld (hl),a call dodays call pcalendar jp keyloop leftsel: ld hl,bar ld a,(hl) and a jp z,keyloop dec (hl) jp keyloop rightsel: ld hl,bar ld a,(hl) cp 4 jp z,keyloop inc (hl) jp keyloop incval: ld hl,(sysdays) ld a,(bar) or a jr z,inchour dec a jr z,incmin dec a jp z,incdate dec a jp z,incmonth jp incyear inchour: ld hl,hours ld a,(hl) inc a daa cp 24h jr nz,not24h xor a not24h: ld (hl),a jp setkeyloop incmin: ld hl,minutes ld a,(hl) inc a daa cp 060h jr nz,not60m xor a not60m: ld (hl),a jp setkeyloop incdate: ld hl,(sysdays) inc hl ld (sysdays),hl call setvals1 jp setkeyloop setvals: ld hl,(days) call getyear push bc call setfeb call getmonth push bc call getday ld h,b ld l,c ld (dd),hl pop hl ld (mm),hl pop hl ld a,l cp 100 jr nz,fred1 ld l,0 fred1: ld (yy),hl ret incmonth: ld a,(mm1) inc a cp 13 jr nz,not13mo ld a,1 not13mo: ld (mm1),a call dodays1 jp setkeyloop incyear: ld a,(yy1) and a jr nz,not2001 ld a,77 not2001: inc a cp 100 jr nz,not19100 xor a not19100: ld (yy1),a call dodays1 jp setkeyloop decval: call dobar ld a,(bar) or a jr z,dechour dec a jr z,decmin dec a jp z,decdate dec a jp z,decmonth jp decyear dechour: ld hl,hours ld a,(hl) or a jr nz,notffh ld a,24h notffh: dec a daa ld (hl),a jp setkeyloop decmin: ld hl,minutes ld a,(hl) or a jr nz,notffh ld a,60h jr notffh decmonth: ld a,(mm1) dec a jr nz,notmff ld a,12 notmff: ld (mm1),a call dodays1 jp setkeyloop decyear: ld a,(yy1) cp 78 jr nz,noty77 ld a,1 noty77: or a jr nz,not255y ld a,100 not255y: dec a ld (yy1),a call dodays1 jp setkeyloop decdate: ld hl,(sysdays) dec hl ld a,h or l jp z,setkeyloop ld (sysdays),hl call setvals1 jp setkeyloop setfeb: ld a,28 bit 0,c jr nz,notaleap bit 1,c jr nz,notaleap inc a notaleap: ld (feb),a ret phours: ld a,(hours) ld c,a srl a srl a srl a srl a ld b,a ld a,c and 0fh ld c,b ld b,10 addloop: add a,c djnz addloop jp pnum pmins: ld a,(minutes) ld c,a srl a srl a srl a srl a ld b,a ld a,c and 0fh ld c,b ld b,10 addloop2: add a,c djnz addloop2 jp pnum pcalendar: ;the biggy call dodays ld bc,(yy) call setfeb ld hl,(mm) dec hl add hl,hl ex de,hl ld hl,months add hl,de dec hl dec hl ld a,(hl) ;a=no of days in previous month push af ;save it inc hl inc hl ld a,(hl) push af ;save no of days in current month ld de,(dd) dec de ld hl,(days) and a sbc hl,de call getdow ex de,hl ld hl,cal add hl,de ;hl points to position in workspace of first of month pop bc ;get no of days in current month push de ;save day no. ld e,b inc e fillloop: ld a,e sub b nottoday: ld (hl),a inc hl djnz fillloop ld de,42 ;no of elements in calendar ex de,hl ;hl = no of elements de = position in cal and a sbc hl,de ;hl = no left to fill calendar ld a,l ex de,hl ld b,129 ;first day of next month + 128 looprem: or a jr z,donetail ld (hl),b inc hl inc b dec a jr looprem donetail: ld hl,cal pop de ;day number of first of month in e pop bc ;b = no of days in last month ld a,e or a jr z,nonetodo ld c,a ld a,b dec c sub c add a,128 ;flag inverse ld b,a ld a,c inc a nonetodo: loophead: or a jr z,donehead ld (hl),b inc b inc hl dec a jr loophead donehead: ld de,calpos call pstring call invoff ld hl,cal ld de,7 ld b,7 doloop1: push bc push hl push de ld a,(hl) call lefspace call pnum call rightspace pop de push de add hl,de ld a,(hl) call lefspace call pnum call rightspace pop de push de add hl,de ld a,(hl) call lefspace call pnum call rightspace pop de push de add hl,de ld a,(hl) call lefspace call pnum call rightspace pop de push de add hl,de ld a,(hl) call lefspace call pnum call rightspace pop de push de add hl,de ld a,(hl) call lefspace call pnum ld de,crlf call pstring ld de,right4 call pstring pop de pop hl pop bc inc hl djnz doloop1 ld de,home call pstring call invon ld de,space4 call pstring ld a,(mm) dec a ld hl,monthnames ld de,14 mnameloop: or a jr z,foundname add hl,de dec a jr mnameloop foundname: ex de,hl call pstring ld e,19 ld a,(yy) or a jr nz,notyet inc e notyet: ld a,e call pnum ld a,(yy) jp pnum lefspace: push af push hl bit 7,a jp nz,notfirst call invon jr nottoday2 notfirst: call invoff nottoday2: ld de,space printit: call pstring pop hl pop af ret rightspace: push af push hl call invon jr nottoday2 indleft: db 27,12,024h indright: db 27,11,024h space5: db 32 space4: db 32 space3: db 32 space2: db 32 space: db " $" calpos: db 27,"H",10,10 right4: db 27,"C",27,"C",27,"C",27,"C",024h posbar: db 27,"H" ds 10,10 db 024h dobar: ld de,sysdays ;get the time from CPM ld c,gettime call bdos ld de,posbar call pstring ld a,(bar) push af or a call z,invoff call phours call invon ld a,":" call writechar pop af dec a push af call z,invoff call pmins call invon ld de,space2 call pstring pop af dec a push af call z,invoff call writespace call pdate call writespace call invon pop af dec a push af call z,invoff call pmonth call invon pop af dec a call z,invoff ld a," " call writechar call pyear ld a," " call writechar invon: ld de,inverse jp pstring inverse: db 27,"p$" pdate: ld a,(dd1) jp pnum pmonth: ld a,(mm1) dec a ld hl,monthnames ld de,14 mnamloop: or a jr z,foundnam add hl,de dec a jr mnamloop foundnam: ex de,hl jp pstring pyear: ld a,(yy1) push af or a ld b,19 jr nz,not2000 inc b not2000: ld a,b call pnum pop af jp pnum invoff: ld de,normal jp pstring normal: db 27,"q$" dodays: ld hl,(yy) ld a,l or a jr nz,not00years ld l,100 not00years: ld de,78 and a sbc hl,de ;hl=No of whole years ld a,l ;a=count ex de,hl ld hl,0 ld bc,365 loop15: and a jr z,doneit2 add hl,bc dec a jr loop15 doneit2: inc de ;numyears=numyears+1 srl d rr e srl d rr e add hl,de ;hl=days from years ld a,28 ld bc,(yy) call setfeb ld a,(mm) ld b,a ld d,0 ld ix,months loopit: dec b jr z,doneits ld a,(ix+0) ld e,a add hl,de inc ix inc ix jr loopit doneits: ex de,hl ld hl,(dd) ; dec hl add hl,de ld (days),hl ret getyear: ld bc,78 gyloop: ld de,365 bit 0,c jr nz,noleap bit 1,c jr nz,noleap inc de noleap: and a sbc hl,de ret c inc bc jr gyloop getmonth: add hl,de ld ix,jan ld bc,1 ld d,0 loopix: ld a,(ix+0) ld e,a and a sbc hl,de ret c ret z inc ix inc ix inc c jr loopix getday: add hl,de ld b,h ld c,l ; inc bc ret getdow: ;find day of week ;on entry hl=no of days since 1/1/78 dec hl ;new addition. ld de,2401 and a loop1: sbc hl,de jr nc,loop1 add hl,de ld de,343 loop2: and a sbc hl,de jr nc,loop2 add hl,de ld de,49 loop3: and a sbc hl,de jr nc,loop3 add hl,de ld de,7 loop4: and a sbc hl,de jr nc,loop4 add hl,de ret pnum: ;print a decimal value push hl push af ld b,10 ld c,0 res 7,a loop10: sub b jr c,done10 inc c jr loop10 done10: add a,b ld b,c ld c,a push bc ld c,2 ld a,"0" add a,b ld e,a call bdos pop bc ld a,"0" add a,c ld e,a ld c,2 call bdos pop af pop hl ret dodays1: ld hl,(yy1) ld a,l or a jr nz,not00years1 ld l,100 not00years1: ld de,78 and a sbc hl,de ;hl=No of whole years ld a,l ;a=count ex de,hl ld hl,0 ld bc,365 loop150: and a jr z,doneit3 add hl,bc dec a jr loop150 doneit3: inc de ;numyears=numyears+1 srl d rr e srl d rr e add hl,de ;hl=days from years ld a,28 ld bc,(yy1) call setfeb ld a,(mm1) ld b,a ld d,0 ld ix,months loopit1: dec b jr z,doneits1 ld a,(ix+0) ld e,a add hl,de inc ix inc ix jr loopit1 doneits1: ex de,hl ld hl,(dd1) ; dec hl add hl,de ld (sysdays),hl ret setvals1: ld hl,(sysdays) call getyear push bc call setfeb call getmonth push bc call getday ld h,b ld l,c ld (dd1),hl pop hl ld (mm1),hl pop hl ld a,l or a jr nz,fred7 ld l,0 fred7: ld (yy1),hl ret setkeyloop: ld de,sysdays ld c,settime call bdos jp keyloop pstring: ld a,(de) cp "$" ret z push de ld e,a ld c,6 call bdos pop de inc de jr pstring sysdays: dw 0 hours: db 0 minutes: db 0 home: db 27,"H$" days: dw 0 bar: dw 0 yy: dw 0 mm: dw 0 dd: dw 0 yy1: dw 0 mm1: dw 0 dd1: dw 0 lastdec: dw 31 months: jan: dw 31 feb: dw 28 ;can change mar: dw 31 apr: dw 30 may: dw 31 jun: dw 30 jul: dw 31 aug: dw 31 sep: dw 30 oct: dw 31 nov: dw 30 dec: dw 31 nextjan: dw 31 monthnames: db " January $$$$" db " February $$$$" db " March $$$$" db " April $$$$" db " May $$$$" db " June $$$$" db " July $$$$" db " August $$$$" db "September $$$$" db " October $$$$" db " November $$$$" db " December $$$$" crlf: db 13,10,24h ind: db 0 end