TTL "S:ICAL"
; S:ICAL1
         NOG 
ORG      =   $7B00
;
; 09/13/85
; 12/05/85 last mod, full
;  credit line
;
;-----------
BFZ      EPZ $C0
;
ILINE    EPZ BFZ
ICURFLAG EPZ BFZ+1
IEDYOFF  EPZ BFZ+2
;-----------
;
; Common buffer routines.
;
; Print Shop Companion Calendar
;
; by Roland Gustafsson
;    Copyright 1985
;
;-----------
         ORG ORG
         OBJ $800
;-----------
         JMP CLRCOBUF
         JMP GETTEXT
         JMP PUTTEXT
         JMP GETEDIT
         JMP PUTEDIT
;
         JMP MAKEDTXT
         JMP MAKEWTXT
;
         JMP TOPTEXT
         JMP GTMTEXT
         JMP GTWTEXT
         JMP CREDIT
;
         JMP DRAWBOX
;-----------
;
; Turn on the main bank of
; the $D000 area
; Clear the common buffer
;
CLRCOBUF LDY #0
         TYA 
^0       STA COBUFF,Y
         INY 
         BNE <0
;
         DEY 
         STY COLORFLG
;
         LDY #DBUFFER
         LDA /DBUFFER
         STY DBUFENDL
         STA DBUFENDH
         RTS 
;-----------
;
; Get pointer into DBUFFER
; BEQ if no data for this date
;
GETDPNT  LDA DBUFPNTL,Y
         STA TMP0
         STA TMP2
         LDA DBUFPNTH,Y
         STA TMP1
         STA TMP3
         ORA TMP2
         RTS 
;-----------
;
; GETTEXT from DBUFFER into TEXTBUFF
; If empty, return CLC
;
GETTEXT  JSR GETDPNT
         BNE >0
         STA TEXTBUFF
         CLC 
         RTS 
;
^0       LDY #0
^1       LDA (TMP2),Y
         STA TEXTBUFF,Y
         BEQ >2
         INY 
         BNE <1
;
^2       SEC 
         RTS 
;-----------
;
; PUTTEXT from TEXTBUFF to DBUFFER
;
PUTTEXT  TYA 
         PHA 
         JSR REMTEXT
         PLA 
         TAY 
         LDA TEXTBUFF
         BNE >0
         STA DBUFPNTL,Y
         STA DBUFPNTH,Y
         RTS 
;
^0       LDA DBUFENDL
         STA DBUFPNTL,Y
         STA TMP0
         LDA DBUFENDH
         STA DBUFPNTH,Y
         STA TMP1
;
         LDY #0
^1       LDA TEXTBUFF,Y
         STA (TMP0),Y
         INC DBUFENDL
         BNE >2
         INC DBUFENDH
^2       INY 
         TAX 
         BNE <1
         RTS 
;-----------
;
; Remove data form DBUFFER, if any.
;
REMTEXT  JSR GETDPNT
         BEQ >9
;
; There is data, so calculate its
; length and then remove it.
;
; TMP0.1:start of text to be removed
; TMP2.3:next byte after text
; TMP4  :length (TMP2.3-TMP0.1)
;
         LDA #0
         STA TMP4
^0       LDY #0
         LDA (TMP2),Y
         INC TMP2
         BNE *+4
         INC TMP3
         INC TMP4
         TAY 
         BNE <0
;
; First fix pointers pointing above
; text just removed
;
         LDX #DBUFCONT-1
^0       LDA DBUFPNTH,X
         CMP TMP3
         BNE >1
         LDA DBUFPNTL,X
         CMP TMP2
^1       BCC >2
         LDA DBUFPNTL,X
         SBC TMP4
         STA DBUFPNTL,X
         BCS >2
         DEC DBUFPNTH,X
^2       DEX 
         BPL <0
;
; Now close up the space
;
^0       LDA TMP3
         CMP DBUFENDH
         BNE >1
         LDA TMP2
         CMP DBUFENDL
^1       BEQ >2
         LDA (TMP2),Y
         STA (TMP0),Y
         INC TMP0
         BNE *+4
         INC TMP1
         INC TMP2
         BNE *+4
         INC TMP3
         BNE <0
;
; Update DBUFEND pointer
;
^2       SBC TMP4
         STA DBUFENDL
         BCS >9
         DEC DBUFENDH
^9       RTS 
;-----------
;
; Get EDITBUFF from DBUFFER.
;
; First get data into TEXTBUFF
;
GETEDIT  JSR GETTEXT
;
; Clear EDITBUFF
;
         LDY #0
^0       TYA 
         LDX #0
         AND #%00011111
         BNE *+4
         LDX #$80
         TXA 
         STA EDITBUFF,Y
         INY 
         BNE <0
;
; Now unpack it into EDITBUFF
;
         LDX #0-32
;
^1       LDA TEXTBUFF,Y
         BEQ >4
         BMI >3
^2       STA EDITBUFF,X
         INX 
         INY 
         BNE <1
;
^3       PHA 
         TXA 
         CLC 
         ADC #32
         AND #%11100000
         TAX 
         PLA 
         BMI <2
;
^4       RTS 
;-----------
;
; Move EDITBUFF into DBUFFER
;
PUTEDIT  TYA 
         PHA 
;
; First pack data into TEXTBUFF
;
         LDX #0
         LDY #0
^0       LDA EDITBUFF,X
         STA TEXTBUFF,Y
         BEQ >1
         INX 
         INY 
         BNE <0
;
; Do next string
;
^1       TXA 
         CLC 
         ADC #32
         AND #%11100000
         TAX 
         BNE <0
;
; Now strip off trailing nulls.
;
^2       DEY 
         BMI >3
         LDA TEXTBUFF,Y
         BMI <2
;
; Store zero at end.
;
^3       INY 
         LDA #0
         STA TEXTBUFF,Y
;
; Now do the actual move
;
         PLA 
         TAY 
         JMP PUTTEXT
;-----------
;
; Convert date to decimal ASCII
;
MAKEDTXT LDY #0
         STY DATETEXT+2
         LDA DATE
         CMP #10
         BLT >1
         LDX #$FF
;
^0       INX 
         SBC #10
         BCS <0
         ADC #10
         ORA #'0'
         TAY 
         TXA 
^1       ORA #'0'
;
         STA DATETEXT
         STY DATETEXT+1
         RTS 
;-----------
;
; Given Y=0-6, make WEEKTEXT
;
MAKEWTXT LDX #$FF
^0       DEY 
         BMI >2
^1       INX 
         LDA MAKEWTX2,X
         BNE <1
         BEQ <0
;
^2       LDY #$FF
^3       INX 
         INY 
         LDA MAKEWTX2,X
         STA WEEKTEXT,Y
         BNE <3
         RTS 
;
MAKEWTX2 BYT 'SUNDAY',0
         BYT 'MONDAY',0
         BYT 'TUESDAY',0
         BYT 'WEDNESDAY',0
         BYT 'THURSDAY',0
         BYT 'FRIDAY',0
         BYT 'SATURDAY',0
;-----------
;
; Draw a box on the screen
; given X,Y: location (X is byte)
;         A: height
;
; Automatically generates width based
; on X-coordinate.
;
DRAWBOX  PHA 
;
; W = 2*(20-X)
;
         STX TMP0
         LDA #20
         SEC 
         SBC TMP0
         ASL 
         STA TMP0
         PLA 
;---
;
; Enter here with TMP0=width
;
; H
DRAWBOX2 STA >0+5
         STA >1+5
; X
         STX >0+2
         STX >2+1
         STX >3+1
; X+W
         DEX 
         TXA 
         CLC 
         ADC TMP0
         STA >1+2
; Y
         STY >0+3
         STY >1+3
; Y-2
         DEY 
         DEY 
         STY >2+2
; Y+H
         TYA 
         ADC #2
         ADC >0+5
         STA >3+2
; W
         LDA TMP0
         STA >2+3
         STA >3+3
;
         JSR PRINT
^0       BYT RTOSANY,$07,0,0,1,0
^1       BYT RTOSANY,$70,0,0,1,0
^2       BYT RTOSWITE,0,0,0,2
^3       BYT RTOSWITE,0,0,0,2
         BRK 
         RTS 
;-----------
;
;
;
         ICL "S:ICAL2"