;
; S:ICAL4
;
; GTMTEXT
;
; Get text for monthly calendar
;
MCXOFF   =   71
MCYOFF   =   54
MCWIDTH  =   126
;
; Initialize everything!
;
GTMTEXT  STX DATE
         LDA #0
         STA ILINE
;
; Get text for this day
;
         LDY DATE
         DEY 
         JSR GETEDIT
;
; Configure TEDIT routine
;
         JSR TEINIT
         ADR GTMBLAK
         ADR RTS
         ADR GTMDRAW
         BYT 126,30,2,0
;
         LDX #MCXOFF
         LDY /MCXOFF
         STX XOFFLO
         STY XOFFHI
         LDY #MCYOFF
         STY YOFF
;-----------
;
; Draw the initial screen
;
GTMDATE2 JSR GTTOP
         JSR SHOWEIAM
         LDX #10
         LDY #MCYOFF
         LDA #90
         JSR DRAWBOX
         LDY #$FF
         JSR EDITDRAW
;
; Show all the attributes
;
         LDY #0
^0       JSR GTMSTUFF
         INY 
         BCC <0
;
         LDY ILINE
;
; Now edit one of the strings
;
GTMDNEXT STY ILINE
GTMDGET  JSR TEDIT
         PHA 
         LDY ILINE
         JSR EDITYOFF
         PLA 
         JSR PARSE
         .DA #1,GTMCR
         .DA #2,GTMESC
         .DA #3,GTMCTRLI
         .DA #4,GTMCTRLS
         .DA #5,GTMCTRLP
         .DA #6,GTMDGET
;---
GTMCR    INY 
         JSR EDITYOFF
         BCC GTMDNEXT
         BCS >0
;---
GTMESC   DEY 
         BPL GTMDNEXT
;---
;
; Room?
;
^0       JSR GTMBCHEK
         BCS >9
;
; Put it into buffer
;
         LDY DATE
         DEY 
         JSR PUTEDIT
;
; Fall into the check routine
;
;---
;
; Check to see if data goes to
; far into buffer.
; If it won't fit, then erase it
; and return with SEC
;
; COBUFFER+(4096-300)
; 58 for pointers
; 64*3 for three strings
; 50 for good luck
;
GTMOMAX  =   $D000+3796
;
GTMBCHEK LDA DBUFENDL
         CMP #GTMOMAX
         LDA DBUFENDH
         SBC /GTMOMAX
         BCC >9
         LDA #0
         STA TEXTBUFF
         LDY DATE
         DEY 
         JSR PUTTEXT
         SEC 
^9       RTS 
;---
GTMCTRLP LDA EDITBUFF,X
         PHA 
         AND #6
         CLC 
         ADC #2
         CMP #6
         BNE *+4
         LDA #0
         STA TMP0
         PLA 
         AND #%11111001
         ORA TMP0
         STA EDITBUFF,X
         JSR GTMSTUFF
         JMP GTMDGET
;-----------
;
; Show text position and
; box on left edge.
;
GTMSTUFF STY >9+1
         JSR GTMYCALC
         BCS >9
         LDA EDITBUFF,X
         LSR 
         AND #3
         TAY 
         LDA GTMPOSIT,Y
         STA >2+0
         LDY IEDYOFF
         STY >0+2
         STY >1+3
         JSR PRINT
^0       BYT RTOSBLAK,30,0,2,8
^1       .DA #PRLOC,216,#0
^2       BYT ' ',CR
         BRK 
         LDX #8
         LDY IEDYOFF
         JSR FSOLID
         CLC 
^9       LDY #00
         RTS 
;
GTMPOSIT BYT 'LCR'
;---
GTMCTRLI CLC 
         JSR SHOWEI
         JMP GTMDATE2
;---
GTMCTRLS LDA EDITBUFF,X
         EOR #1
         STA EDITBUFF,X
;---
;
; Redraw from Y down
;
         LDA ILINE
         PHA 
         SEC 
^0       STY ILINE
         PHP 
         JSR GTMBLAK
         PLP 
         BCS >1
         JSR GTMDRAW
^1       LDY IEDYOFF
         STY >2+2
         STY >3+2
         JSR PRINT
^2       BYT RTOSBLAK,8,0,2,16
^3       BYT RTOSBLAK,30,0,2,16
         BRK 
         LDY ILINE
         JSR GTMSTUFF
;
         LDY ILINE
         INY 
         JSR EDITYOFF
         BCC <0
         PLA 
         STA ILINE
         JMP GTMDGET
;-----------
;
; Routine to erase current line
;
GTMBLAK  LDY ILINE
         JSR GTMYCALC
         STA >0+2
         PHA 
         LDA TMP1
         STA >0+4
         JSR PRINT
^0       BYT RTOSBLAK,11,0,18,0
         BRK 
         PLA 
         RTS 
;-----------
;
; Calculate Yoffset and X index
;
GTMYCALC JSR EDITYOFF
         BCS >0
         LDA TMP0
         CLC 
         ADC #MCYOFF+DTCYMARG
         STA IEDYOFF
^0       RTS 
;-----------
GTMDRAW  LDY ILINE
         JMP EDITDRAW
;-----------
;
; Show top of events and reminders
; screen input.
;
GTTOP    JSR CLS1
         JSR PRINT
         BYT PRCNTR
         .DA #PRLOC,140,#26
         BYT 'NOW TYPE IN YOUR',CR
         BYT 'EVENTS AND REMINDERS:',CR
         BRK 
         RTS 
;-----------
;
;
;
         ICL "S:ICAL5"