.TITLE YEARLY FINANCE
;**********************************************************"*************
;
;
; ZX81 YEARLY FINANCE
;
;
;************************************************************************
;************************************************************************
;
; THESE ARE ADDRESSES IN THE ZX81 ROM AND RAM
;
;************************************************************************
PTOKEN: .EQU 094BH
PNTA: .EQU 0010H
SCANNER: .EQU 02BBH
DECODE: .EQU 07BDH
DFCC: .EQU 16398
SLOW: .EQU 0F2BH
FAST: .EQU 0F23H
COPY: .EQU 0869H
CSAVE: .EQU 02FCH
DFILE: .EQU 16396
SPOSNL: .EQU 16441
SPOSNH: .EQU 16442
.ORG 16514 ;START OF REM STATEMENT
;************************************************************************
;
; THIS IS THE COPUWRITE DISPLAY I WAS ASKED
; TO REMOVE BY THE PUBLISHER.
;
;************************************************************************
;CALL CLS ;CLEAR SCREEN
;LD HL,MSG30 ;DISPLAY COPYRIGHT TEXT
;LD DE,0A07H ;...LINE 10, CHAR 08
;CALL PNTAT
;CALL DELAY
;LD HL,FLAGA ;ClEAR FLAG
;LD (HL),00
; END OF COPYWRITE DISPLAY CODE
;
;************************************************************************
FINANCE:
CALL CLS ;CLEAR SCREEN
LD DE,0104H ;POSITION DISPLY
LD HL,MSG1 ;'YEARLY FINANCE' ECT.
CALL PNTAT ;PRINT SDRING
LD DE,1204H ;POSITION DISPLAY
LD HL,MSG2 ;'SELECTION ?
CALL PNTAT
LD B,1 ;GET ONE CHAR
CALL GETSTG ;GET A SELECTION
LD HL,(DFCC) ;GET ADDRESS POINTER OF CHAR
DEC HL ;POINTAT ONE ENTERED
LD A,(HL) ;GET CHAR
CP 1DH ;IS IT < 1 ?
JR C,FINANCE ;YES ERROR
CP 24H ;IS IT > 7 ?
JR NC,FINANCE
LD HL,VTAB ;BUILD A OFFSET IN TO THE VECTOR TABLE
LD B,0
SUB 1DH ;MAKE IT BINARY- 1
ADD A,A ;* 2
LD C,A ;BC --> OFFSET * 2
ADD HL,BC ;HL --> ADDRESS OF VECTOR
LD C,(HL) ;GET ADDRESS OF ROUTINE
INC HL
LD B,(HL) ;BC = ADDRESS OF ROUTINE
PUSH BC ;PUT IT ON THE STACK
RET ;AND GO TO IT
VTAB:
.WORD STATEMENT
.WORD UPDATE
.WORD YEARLY
.WORD CLMNTH
.WORD CLYEAR
.WORD SAVE
.WORD CHCAT
.EJECT
;************************************************************************
;
; GETKEY: GET A KEY INTO THE ACCUM TEST FOR N/L (76H)
; IAND CHANGE IT TO 122 DECIMAL. THIS ROUTINE
; BLINKS THE CHAR AT (DFCC) FOR A CURSOR.
;
;************************************************************************
GETKEY:
PUSH HL
PUSH BC
PUSH DE
GET1:
CALL SCANNER ;IN ZX81 ROM
INC L ;A KEY PRESSED ?
JR NZ,GET1 ;NO WAIT
GET2:
LD HL,(DFCC) ;FIIP VIDEO ON CURSOR
LD A,(HL)
ADD A,80H
LD (HL),A
CALL SCANNER ;SCAN KEYBOARD
LD B,H ;SAVE ADDRESS OF KEY
LD C,L
INC L ;A KEY PRESSED ?
JR Z,GET2 ;NO WAIT
LD HL,(DFCC) ;PUT CURSOR BCK TO ORIGINAL
LD A,(HL)
RES 7,(HL)
CALL DECODE ;YES DECODE IT
LD A,(HL) ;GET CHAR CODE
LD L,A ;CAN'T PUT A 76H IN A REM
DEC HL
LD A,117 ;TEST FOR N/L
CP L
JR NZ,GET3 ;NO SKIP
LD L,122-1 ;YES SET UP THE CODE CHANGE
GET3:
INC HL
LD A,L
POP DE
POP BC
POP HL
RET
.EJECT
;***********************************************************************
;
; GET STRANG: INPUT A STRING INTO THE DISTLAY BUFFER
; STARTING AT (DFCC) FOR A LENGTH ORDERED
; BY THE 'B' REG.
;
;************************************************************************
GETSTG:
PUSH HL
PUSH DE
PUSH AF
PUSH BC
LD C,B ;SAVE LENGTH
STG1:
CALL GETKEY ;FETCH A KEY
JR Z,STG3 ;EXIT N/L
CP 119 ;BS ?
JR Z,STG2 ;YES HANDEL IT
DEC B ;SEE IF LAST
INC B
JR Z,STG1 ;YES DON'T DO IT
CALL PNTCHR ;DO PRINT IT
DEC B ;LOG IT
JR STG1 ;AND GET ANOTHER
STG2:
LD A,C ;GET ORIGINAL COUNT
CP B ;AT THE FIRST ?
JR Z,STG1 ;YES FORGET IT
LD A,119 ;BS CHAR
CALL PNTCHR ;PRINT IT
INC B ;ADJUST COUNT
JR STG1 ;AND GET ANOTHER
STG3:
LD A,C ;GET ORIGINAL COUNT
SUB B ;MAKE # DONE
POP BC ;RESTORE REG C
LD B,A ;PUT COUNT IN B
POP AF
POP DE
POP HL
RET ;AND EXIT
.EJECT
;***********************************************************************
;
; CLEAR SCREEN: WILL CLEIR THE SCREEN AND RESET THE CURSOR TO HOME.
;
;***********************************************************************
CLS:
PUSH HL
PUSH DE
PUSH BC
LD HL,(DFILE) ;POINT TO START OF D_FILE
INC HL
LD (DFCC),HL ;SET DF_CC
LD (HL),00 ;PUT IN A SPACE
PUSH HL
POP DE ;PUT DE AT D_FILE+1
INC DE
LD BC,31 ;FILL FIRST LINE
LDIR
INC DE ;BUMP PAST EOL
LD HL,(DFCC) ;BACK TO THE START
LD BC,33*23 ;REST OF D_FILE
LDIR ;FILL THEM
LD HL,1821H ;INIT S_POS
LD (SPOSNL),HL
POP BC
POP DE
POP HL
RET
;***********************************************************************
;
; DELAY ROUTINE USED IN THE COPYWRITE DISPLAY CODE
; REMOVED WHEN THE PUBLISHER REQUESTED THE;
; COPYWRITE DISPLAY BE REMOVED;
;************************************************************************
;DELAY:
; LD BC,00
;DEL1:
; DJNZ DEL1
; DEC C
; JR NZ,DEL1
; RET
; END OF DELAY ROUTINE
.EJECT
;************************************************************************
;; PRINT AT: ENTER HL --> STRING OF ZASC TERMINATED BY 60H
; DE --> LINE CHAR ADDRESS ON SCREEN
; 1203H = LINE 12 CHAR 03
;
;************************************************************************
PNTAT:
EX DE,HL ;PUT LINE & CHAR IN HL
CALL POSNER ;MOVE CURSOR
EX DE,HL
PNTSTG:
PUSH HL
PUSH DE
PUSH BC
PUSH AF
PNT1:
LD A,(HL) ;GET CHAR TO PRINT
CP 60H ;IS TERMINATOR ?
JR NZ,PNT2 ;NO PRINT IT
POP AF
POP BC ;ELSE EXIT
POP DE
POP HL
RET
PNT2:
CP 122 ;N/L ?
JR Z,NL ;YES DO IT
CP 119 ;BS ?
JR Z,BS ;YES DO IT
CP 40H ;SINGLE CHAR ?
JR C,SINGLE ;YES
CP 43H ;TOKEN =
JR C,TOKEN ;YES
CP 7FH ;ILLEGAL ?
JR C,NEXT ;YES SKIP IT
CP 0C0H ;SINGLE CHAR ?
JR C,SINGLE ;YES
.EJECT
TOKEN:
CALL PTOKEN ;PRINT TOKEN (IN ZX83 ROM)
NEXT:
INC HL ;POINT TO NEXT CHAR
JR PNT1 ;AND LOOP
SINGLE:
RST 10H ;PRINT A REG (IN ZX81 ROM) PNTA: AT RESTART 10H
JR NEXT ;AND DO NEXT ONE
NL:
LD A,(SPOSNH) ;GET LINE #
CP 2 ;IS IT THE LAST LINE
JR Z,NEXT ;YES DON'T DO IT
LD A,75H
INC A ;CANNOT PUT A 76H IN A REM STATEMENT
PUSH HL ;SAVE TEXT ADDRESS
LD HL,(DFCC) ;CHAR ADDRESS OF NEXT
LD BC,33 ;FULL LINE
CPIR ;FIND IT
LD (DFCC),HL ;UPDATE POINTER
POP HL
JR NEXT ;GET NEXT ONE
.EJECT
BS:
PUSH HL ;SAVE TEXT ADDRESS
LD HL,(SPOSNL) ;LINE AND CHAR
PUSH BC
LD BC,2233H ;FIRST LINE AND CHAR
OR A
SBC HL,BC ;SEE IF THE SAME
POP BC
JR NZ,BS1 ;NO CONTINUE
POP HL
JR NEXT ;YES CONTINUE
BS1:
LD HL,(DFCC) ;ADDRESS OF NEXT CHAR
DEC HL ;POINT TO LAST
LD (DFCC),HL ;UPDATE ADDRESS
LD A,75H ;IF IT'S A N/L
INC A ;CANNOT PUT A 76H IN A REM STATEMENT
CP (HL) ;THEN
JR NZ,BS2
DEC HL ;BACK ONE MORE
LD (DFCC),HL
LD A,(SPOSNH) ;INC LINE #
INC A
LD (SPOSNH),A
LD A,-1 ;AND UPDATE CHAR #
LD (SPOSNL),A
BS2:
LD A,(SPOSNL) ;BUMP CHAR COUNT
INC A
LD (SPOSNL),A
LD (HL),00 ;INSERT A SPACE IN THE DISPLAY BUFFER
POP HL
JR NEXT
.EJECT
;************************************************************************
;
; PRINT CHAR IN THE 'A' REG AT THE POSITION IN (DFCC)
;
;************************************************************************
PNTCHR:
PUSH HL
PUSH DE
PUSH BC
PUSH AF
LD HL,CHBUF+1 ;DUMMY UP A STRING
LD (HL),60H ;WITH A TERMINATOR
DEC HL
LD (HL),A ;PUT IN THE CHAR
CALL PNTSTG ;AND PRINT IT
POP AF
POP BC
POP DE
POP HL
RET
;************************************************************************
;
; POSITIONER: POSITION CURSOR AT HL 120;H --> LINE 12 CHAR 03
;
;******(*****************************************************************
POSNER:
PUSH AF
PUSH DE
PUSH BC
PUSH HL
LD A,24 ;UPDATE S_POSN
SUB H
LD (SPOSNH),A
LD A,33
SUB L
LD (SPOSNL),A
LD B,H ;GET LINE #
LD HL,(DFILE) ;GET ADDRESS OF DFILE
INC HL ;SKIP 1'ST EOL
LD DE,33 ;# OF CHARS IN A LINE
LD A,B ;IF ZERO SKIP
OR A
JR Z,POS2
POS1:
ADD HL,DE ;PUT IN CHARS IN
DJNZ POS1 ;FOR B TIMES
POS2:
POP DE ;GET CHAR POINTER
PUSH DE
LD D,0
ADD HL,DE ;AND ADD THEM IN
LD (DFCC),HL ;UPDATE ADDRESS OF NEXT
POP HL
POP BC
POP DE
POP AF
RET
.EJECT
;************************************************************************
;
; BLANK LINE: FROM HL 1203H --> BLANK LILE 12 FROM CHAR 03
;
;*********+**************************************************************
BLNKLN: ;BLANK A LINE FROM HL
PUSH HL
PUSH BC
PUSH DE
PUSH AF
LD A,32 ;MAX CHAR TO BLANK
SUB L ;NUMBER TO DO
JR C,BLEXIT ;TOO MANY EXIT
LD C,A ;COUNT IN BC
LD B,0
CALL POSNER ;POSITMON DISPLAY
LD HL,(DFCC) ;GET ADDRESS
LD (HL),00 ;INSERT FIRT BLANK
PUSH HL ;ADDRESS + 1 IN DE
POP DE
INC DE
DEC BC ;ADJUST COUNT
LDIR ;BLANK IT
BLEXIT:
POP AF
POP DE
POP BC
POP HL
RET
.EJECT
;************************************************************************
;
; GET MONTH 1 TO 12
; RESULT IS STORED IN (MONTH) BINARY 0 --> 11
;
;************************************************************************
GTMNTH:
PUSH BC
PUSH HL
PUSH DE
LD HL,FLAGA ;RESET QUIT FLAG
RES 0,(HL)
GMN1:
LD HL,1203H ;PRE BLANK LINE INCASE OF ERROR
CALL BLNKLN
LD DE,1203H ;PUT UP MESSAGE
LD HL,MSG3 ;'INPUT MONTH 1 TO 12 '
CALL PNTAT
LD B,2 ;FETCH 2 CHARS
CALL GETSTG
LD HL,1218H ;POINT TO RESPONSE
CALL POSNER
LD HL,(DFCC) ;GET ADDRESS OF RESPONSE
INC B ;ZERO IS ILLEGAL
DEC B
JR Z,GMN1
LD A,(HL) ;GET CHAR
CP 54 ;IS IT 'Q' ?
JR NZ,GMN2 ;NO CONTINE
LD HL,FLAGA ;ELSE SET QUIT FLAG
SET 0,(HL)
JR GMN4 ;AND EXIT
GMN2:
DEC B ;ONE CHAR
JR Z,GMN3 ;YES
DEC B ;MAKE B ZERO
LD A,(HL) ;NO GET TEN'S DIGIT
INC HL ;POINT TO UNITS
SUB 1BH ;MAKE IT BINARY +1
DEC A ;IF ZERO
JR Z,GMN3 ;GO DO UNITS
DEC A ;IF NOT 1 THEN ERROR
JR NZ,GMN1
LD B,10 ;SET TENS DIGIT
GMN3:
LD A,(HL) ;GET UNITS
SUB 29 ;MAKE BINARY - 1 TO COUNT FROM ZERO
ADD A,B ;ADD IN TENS DIGIT
CP 12 ;MUST BE 0 --> 11
JR NC,GMN1 ;ILLEGAL
LD (MONTH),A ;PUT NEW MONTH AWAY
.EJECT
GMN4:
LD HL,1203H ;BLANK LINE TO QUIT
CALL BLNKLN
POP DE
POP HL
POP BC
RET
;***********************************************************************
;
; COMPARE: ENTER HL
; DE
;
; EXIT WITH ZERO FLAG SET IF EQUAL
;
;************************************************************************
COMP:
PUSH BC
PUSH HL
PUSH DE
EX DE,HL ;SWAP POINTERS
COM1:
LD A,(DE) ;GET FIRST CHAR
CP (HL) ;BOMPARE THEM
JR NZ,COM2 ;DIFFERANT EXIT
INC HL
INC DE
DJNZ COM1 ;LOOP
COM2:
POP DE
POP HL
POP BC
RET
.EJECT
;*****************+******************************************************
;
; BCD PRINTER $NNNNNNNNN
; ENTER HL --> 5 BYTE BCD FIELD 1'ST BYTE = '$' OR '-'
; DE --> DEST OF ZASCII
;
;*************************************"**********************************
BCPNT6: ;PRINT SIX DIGIS
LD A,(HL) ;GET '$' OR '-'
LD (DE),A ;PUT IT AWAY
INC DE ;BUMP TO NEXT
INC HL ;PASS ONE BYTE UP FOR 6 DIGITS
INC HL
PUSH BC ;SAVE BC
LD B,4 ;4 DIGITS BEFORE '.'
JR BC1 ;GO DO IT
BCPNT8: ;PRINT EIGHT DIGITS
LD A,(HL) ;GET '$' OP '-'
LD (DE),A ;PRINT IT
INC DE ;BUMP POiNTER
INC HL ;BUMP PAST IT
PUSH BC ;SAVE BC
LD B,6 ;6 DIGITS BEFORE '.'
BC1:
LD C,1 ;SURPRESS LEADING ZEROS
CALL PNTBBT ;PRINT BEFORE '.'
LD A,1BH ;ZASCII FOR '.'
LD (DE),A ;INSERT DECIMAL POINT
INC DE
LD C,0 ;PRINT LEADING ZEROS
LD B,2 ;PRINT TWO DIGITS
CALL PNTBBT
POP BC
RET ;EXIT
PNTBBT:
BIT 0,B ;ARE WE DOING A ODD #
JR Z,BBT1 ;NO CONDINE
RLD ;YES START WITH LOW NIBBLE
BBT1:
RLD ;GET BCD DATA
AND 0FH ;JUST THE LSN
JR NZ,BBT2 ;SKIP IF NOT ZERO
BIT 0,C ;SURPRESSING LEADING ZEROS ?
JR NZ,BBT3 ;NO SKIP
BBT2:
ADD A,1CH ;MAKE IT ZASCII
RES 0,C ;STOP SURPRESSION OF ZEROS
BBT3:
LD (DE),A ;PUT IN CHAR
OR A ;WAS IT A SPACE ?
JR Z,BBT4 ;YES NO NEED TO RESET
SUB 1CH ;RESET TO BINARY
.EJECT
BBT4:
BIT 0,B ;ODD BYTE
JR Z,BBT5 ;YES SKIP
RLD ;RESTORE MEMORY
INC HL ;BUMP ADDRESS
BBT5:
INC DE ;BUMP DESTINATION
DJNZ BBT1 ;AND LOOP
RET ;DONE EXIT
;************************************************************************
;
; BCD ADDER 4 BYTES 8 DIGITS
;
; ENTER HL
; $ +DE
; --
;
;
;************************************************************************
BCDADD:
PUSH BC
LD BC,3 ;OFFSET TO LSB
ADD HL,BC
EX DE,HL ;SWAP POINTERS
ADD HL,BC
LD B,4 ;ADD FOUR BYTES
OR A ;RESET CARRY FGR FIRST PASS
BCDA1:
LD C,(HL) ;GET TWO DIGITS
LD A,(DE) ;FETCH OTHER TWO
ADC A,C ;ADD THEM TOGETHER
DAA ;ADJUST FOR BCD
LD (DE),A ;UPDATE
DEC DE ;MOVE POINTERS
DEC HL
DJNZ BCDA1 ;LOOP
INC HL ;RESTORE POINTERS
INC DE
EX DE,HL ;TO ORIGINAL
POP BC
RET
.EJECT
;************************************************************************
;
; BCD SUBTRACT 4 BYTES 8 DIGITS
;
; ENTER HL
; -DE
;
;
;
;************************************************************************
BCDSUB:
PUSH BC
LD BC,3 ;OFFSET TO LSB
ADD HL,BC
EX DE,HL
ADD HL,BC
LD B,4 ;DO FOUR BYTES 8 DIGITS
OR A ;RESET CARRY FOR FIRST PASS
BCDS1:
LD C,(HL) ;GET FIRST TWO DIGITS
LD A,(DE) ;GET ORTER TWO
SBC A,C ;DO THE SUBTRACT
DAA ;ADJUST FOR DECIMAL
LD (DE),A ;PUT ANSWER AWAY
DEC HL ;MOVE POINTERS
DEC DE
DJNZ BCDS1 ;LOOP
INC HL ;RESTORE REG'S
INC DE
EX DE,HL
POP BC
RET
.EJECT
;************************************************************************
;
; SUMER SUMS 2 FIVE BYTE BCD FIELDS
; FIRST BYTE IS SIGN BYTE I.E. '$' = PULS
; '-' = MINUS.
;
; ENTER HL --> ONE 5 BYTE FIELD
; + OR - DE --> SECOND FIELD
;
; HL --> RESULT
;
;************************************************************************
SUMR:
PUSH HL
PUSH DE
PUSH BC
PUSH AF
LD A,(DE) ;IF SIGNS AZE THE SAME
CP (HL)
INC HL ;POINT TO BCD
INC DE
JR NZ,SUMDIF
CALL BCDADD ;AND ADD THEM
JR SUMR2 ;EXIT
SUMDIF:
LD B,4 ;IF SOURCE < DEST THEN
CALL COMP
JR NC,SUMSUB ;JUST SUBTRACT
DEC DE ;ELSE SWAP THEM USING A TMMP BUFFER
DEC HL ;SO AS NOT TO DESTROY THE SOURCE
PUSH DE ;SAVE SOURCE ADDRESS
PUSH HL ;AND DEST ADDRESS
LD DE,BCTEMP ;MOVE DEST TO TEMP BUFF
LD BC,05
LDIR
POP DE ;AND SOURCE TO DEST
POP HL
PUSH DE ;SAVE DEST ADDRESS
LD C,05
LDIR
POP HL ;GET DEST ADDRESS
INC HL ;BACK TO BCD
LD DE,BCTEMP+1 ;SOURCE ALSO
SUMSUB:
CALL BCDSUB ;NOW SUBTRACT THEM
SUMR2: ;CAT3 IS OUT OF RANGE FOR SUMDIF - 1
JR CAT3
.EJECT
;***********************************************************************
;
; CATEGORY PRINTER & FORMATTER ROUTINE
; JUST CALL IT AND WATCH IT'S SMOKE.
;
;************************************************************************
CATPNT:
PUSH HL
PUSH DE
PUSH BC
PUSH AF
LD HL,CATTXT ;INIT LEFT SOURCE TEXT
LD (SW00),HL ;LOOK AT FORMAT TO SEE LEFT & RIGHT
LD HL,CATTXT+(7*5) ;RIGHT STARTS AT CATEGORY #?
LD (CHBUF),HL ;INIT RIGHT SIDE START
LD HL,0502H ;POSITION DISPLAY
CALL POSNER
LD C,29 ;ZASCII '1'
LD B,7 ;14 CATEGORIES 2 PER LINE
LD HL,(DFCC) ;GET A DISPLAY ADDRESS
CAT1:
LD (HL),C ;STUFF LEFT # NEVER > 7
INC HL
LD (HL),20 ;NOW A '='
INC HL
EX DE,HL ;DISPLAY POINTER IN DE
LD HL,(SW00) ;GET LEFT SORCE
PUSH BC ;SAVE COUNT & #
LD BC,5 ;NUMBER TO MOVE
LDIR ;PUT EM iN
LD (SW00),HL ;UPDATE LEFT SIDE ADDRESS
EX DE,HL ;HL --> FISPLAY BUFFER
LD BC,06 ;MOVE TO RHGHT SIDE
ADD HL,BC ;HL --> TO RIGHT SIDE
POP BC ;GET COUNT & # BACK
LD A,7 ;NUMBER ON TIIS SIDE IS C + 7
ADD A,C
CP 38 ;OVER 9?
JR C,CAT2 ;NO SKIP
DEC HL ;YES INSERT 10'S DIGIT
LD (HL),29 ;'1'
INC HL
SUB 10 ;REG A IS UNITS
CAT2:
LD (HL),A ;PUT IN UNITS
INC HL ;TEXT GOES HERE
LD (HL),20 ;AFTER THE '='
INC HL
EX DE,HL ;DE --> DISPLAY BUFFER
LD HL,(CHBUF) ;GET RIGHT SIDE SOURCE
PUSH BC ;SAVE COUNT & #
LD BC,5 ;MOVE 5 OF THEM
LDIR
LD (CHBUF),HL ;UPDATE RIGHT SIDE POINTER
EX DE,HL ;HL BACK TO DISPLAY BUFFER
LD C,13 ;WILL GO PAST EOL TO NEXT LEFT POSITION
ADD HL,BC
POP BC ;GET COUNT & #
INC C
DJNZ CAT1 ;DO 7 SETS
CAT3:
POP AF
POP BC
POP DE
POP HL
RET ;AND EXIT
.EJECT
;***********************************************************************
;
; GETDOL: GET A DOLLAR AMOUNT INTO DBUFFER
; FROM 1 TO 8 DIGITS FREE FORM
; MOVE TO BCBUF IN BCD FORMAT (CHAR 1 = $ OR =)
;
;*************************************+**********************************
GETDOL:
PUSH HL
PUSH DE
PUSH BC
PUSH AF
LD HL,FLAGA ;RESET 'Q' FLAG
RES 0,(HL)
JR DOL2 ;SKIP ERROR MESSAGE
DOL1:
LD HL,1705H ;POSITION IN LOWER TWO LINE
CALL POSNER
LD DE,(DFCC) ;GET ADDRESS
LD HL,MSG5 ;POINT TO MESSAGE
LD BC,21
LDIR
DOL2:
LD HL,MSG4 ;'INPUT AMOUNT: '
LD DE,1203H
CALL PNTAT
LD HL,(DFCC) ;GET ADDRESS
LD BC,10 ;BACK TO START
OR A ;RESET CARRY
SBC HL,BC
LD (SW00),HL ;SAVE START ADDRESS
LD (DFCC),HL ;REPOSITION
LD B,10 ;GET UP TO 10 CHAR'S INCLUDES '+','-';'.7
CALL GETSTG
LD HL,1700H
CALL BLNKLN ;CLEAR LINE
LD HL,(SW00) ;TEST FOR 'Q'
LD A,(HL)
CP 54 ;IS 'Q'
JR NZ,DOL3 ;NO CONTINUE
LD HL,FLAGA ;YES SET FLAG
SET 0,(HL)
JR DOL4 ;AND EXIT
DOL3:
INC B
DEC B ;ZERO ILLEGAL
JR Z,DOL1 ;ERROR
CALL FORMAT ;TEST FORMAT OF INPUT
JR NZ,DOL1 ;ERROR
CALL DOLMOV ;TRY TO MOVE IT
JR NZ,DOL1 ;ERROR IN LENGTH
LD HL,00 ;POSITION CURSOR OUT OF BOTTOM
CALL POSNER
LD H,0012H ;INPUT LINE ALSO
CALL BLNKLN
LD HL,BCBUF ;INSERT '$' GR '-'
LD A,(FLAGA)
LD (HL),13 ;INSERT '$'
BIT 1,A ;MINUS SDT ?
JR Z,DOL4 ;NO SKIP
LD (HL),22 ;YES OVER WRITE WITH '-'
DOL4:
POP AF
POP BC
POP DE
POP HL
RET
.EJECT
;************************************************************************
;
; TEST INPUT FOR CORRECT # OF '+','-',&'.'
;
;************************************************************************
FORMAT:
LD (CHBUF),BC ;SAVE COUNT
LD HL,FLAGA ;RESET MINUS FLAG
RES 1,(HL)
LD HL,(SW00) ;GET START ADDRESS
LD DE,00
LD C,00 ;RESET COUNTERS
MAT1:
PUSH BC ;SAVE COUNT
LD A,(HL) ;GET CHAR
CP 27 ;'.' ?
JR NZ,MAT2 ;NO
INC D ;YES COUNT '.'
INC C ;COUNT # UNDER '0'
MAT2:
CP 22 ;'-' ?
JR NZ,MAT3 ;NO
INC E ;YES COUNT IT
INC C ;COUNT # UNDER '0'
MAT3:
CP 21 ;'+'
JR NZ,MAT4 ;NO
LD A,E ;COUNT IN HIGH NIBBLE OF E
ADD A,10H
LD E,A
LD A,(HL) ;GET CHAR BACK
INC C ;COUNT IT
MAT4:
CP 28 ;< 0 ?
JR NC,MAT5 ;NO TEST HIGHER
DEC C ;ONE OF THE OK'S ?
JP M,MAT6 ;NO ERROR
MAT5:
CP 38 ; > '9' ?
JR C,MAT7 ;NO CONTINUE
MAT6:
POP BC ;CLEAR STACK RESTORE COUNT
OR 1 ;RESET ZERO
RET ;EXIT
.EJECT
MAT7:
INC HL ;POINT TO NEXT
POP BC ;GET COUNT
DJNZ MAT1
LD BC,(CHBUF) ;GET ORIGINAL COUNT BACK
PUSH BC ;SAVE IT
LD A,D ;MORE THAN 1 '.' ?
CP 2
JR NC,MAT6 ;YES ERROR
LD A,E ;MORE THAN 1 '-' ?
AND 0FH
CP 2
JR NC,MAT6 ;YES ERROR
LD A,E ;MORE THAN 1 '+' ?
AND 0F0H
CP 20H
JR NC,MAT6 ;YES ERROR
BIT 0,E ;IS THERE A '-' ?
JR Z,MAT8 ;NO SKIP
BIT 4,E ;A '+' ALSO
JR NZ,MAT6 ;YES ERROR
LD Hl,(SW00) ;THE '-' MUST BE FIRST CHAR
LD A,(HL) ;GET FIRST
INC HL ;POINT TO DATA
LD (SW00),HL
POP BC ;REDUCE COUNT
DEC B
PUSH BC
JR Z,MAT6 ;ERROR CAN'T BE THE ONLY CHAR
CP 22 ;IS FIRST A '-'
JR NZ,MAT6 ;NO ERROR
LD HL,FLAGA ;FLAG IT
SET 1,(HL)
JR MAT9 ;CONTINUE
MAT8:
BIT 4,E ;WAS THERE A '+'
JR Z,MAT9 ;NO SKIP
LD HL,(SW00) ;IT MUST BE FIRST
LD A,(HL) ;GET FIRST
INC HL ;MOVE POINTER PAST IT
LD (SW00),HL
POP BC ;TAKE IT OUT OF COUNT
DEC B
PUSH BC
JR Z,MAT6 ;CAN'T BE THE ONLY CHAR
CP 21 ;IS FIRST A '+'
JR NZ,MAT6 ;NO ERROR
MAT9:
POP BC ;CLEAR STACK
RET ;EXIT
.EJECT
;************************************************************************
;
; DOLMOV: MOVES DOLLAR AMOUNT TO BCBUF AND TEST LENGTH
;
;************************************************************************
DOLMOV:
PUSH BC ;SAVE COUNT
BIT 0,D ;WAS THERE A '.'
JR NZ,MOV1 ;YES SKIP
LD C,B
LD B,0 ;NO INSERT ONE
LD HL,(SW00) ;GET START
ADD HL,BC
LD (Hl),27 ;PUT IT IN
JR MOV2
MOV1:
POP BC ;REDUCE TO CHAR COUNT
DEC B
PUSH BC
MOV2:
LD HL,BCBUF ;CLEAR BUFFER
LD DE,BCBUF+1
LD BC,4 ;LENGTH IS 5
LD (HL),00
LDIR
LD HL,(SW00) ;GET START
LD A,27 ;FIND THE '.'
LD BC,12
CPIR
POP BC ;GET COUNT
LD A,(HL) ;IF SPACE
OR A ;CHANGE TO A '0'
JR NZ,MOV3
LD (HL),28 ;'0'
INC B ;BUMP COUNT
MOV3:
INC HL ;POINT TO NEXT
LD A,(HL) ;IF SPACE
OR A ;CHANGE TO '0'
JR NZ,MOV4
LD (HL),28 ;'0'
INC B ;PUT IN(COUNT
MOV4:
LD A,B ;COUNT > 8 ?
CP 9
JR C,MOV5 ;NO CONTINUE
OR 1 ;ERROR
RET
.EJECT
MOV5:
INC HL ;THE NEXT ONE MUST BE A SPACE
LD A,(HL) ;OR ERROR
OR A
RET NZ
DEC HL ;POINT TO LSD
LD DE,BCBUF+4 ;AND RIGHT SIDE OF BUFFER
CALL DSTOBC ;CONVERT TO BCD
DEC HL ;OVER '.'
RET Z ;DONE EXIT
MOV6:
CALL DSTOBC ;MOVE REST TO BCD BUFFER
JR NZ,MOV6
RET
DSTOBC:
LD A,(HL) ;GET ZASCII
SUB 28 ;MAKE BINARY
LD C,A ;SAVE IT
DEC HL ;POINT TO NEXT
DEC B ;DONE ?
JR NZ,DSBC1 ;NO
LD (DE),A ;YES INSERT IT
RET
DSBC1:
LD A,(HL) ;GET NEXT
SUB 28 ;MAKE BINARY
RLA
RLA
RLA
RLA ;IN LEFT NIBBLE
AND 0F0H
ADD A,C ;COMBINE THEM
LD (DE),A
DEC HL ;TO NEXT SOURCE
DEC DE ;AND DEST
DEC B ;DEC COUNT
RET ;Z SET IF DONE
.EJECT
PNTSTATE:
LD HL,0100H ;GO TO START OF NEXT
LD A,11
LD DE,CATTXT ;POINT TO CATEGORY'S
CALL ETXTPNT ;PRINT A'S WORTH
CALL POSNER
INC H
PUSH HL ;POINT TO NEXT
CALL TOTLIN ;PRINT TOTAL LINE
POP HL ;NEXT LINE
CALL POSNER
INC H
INC H
PUSh HL ;SET FOR NEXT
LD HL,MSG13 ;'EXP.'
CALL PNTSTG
LD A,3 ;DO 3 MORE CATEGORIES
POP HL ;GET POINTER
CALL ETXTPNT
CALL POSNER
INC H
PUSH HL
CALL TOTLIN
POP HL
CALL POSNER ;TO NEXT LINE
INC H
INC H
PUSH HL
LD HL,MSG14 ;'INC.'
CALL PNTSTG
POP HL
CALL POSNER ;TO LAST LINE
LD HL,MSG15 ;'BAL.'
CALL PNTSTG
LD A,(MONTH) ;GET START MONTH
LD (SW00),A ;SAVE A COPY
LD HL,0106H ;START PUTTING IN MONEY
CALL PNTMONTH ;PRINT A MONTH
LD A,(SW00) ;GET MONTH
INC A ;MOVE TO NEXT
CP 12 ;DON'T PRINT PAST DEC
RET NC
LD (SW00),A ;PUT IT BACK
LD HL,010FH ;POSITION FOR MONTH 2
CALL PNTMONTH
LD A,(SW00) ;GET 2ND MONTH
INC A ;BUMP IT
CP 12 ;STILL NOT PAST DEC
RET NC ;EXIT IF SO
LD (SW00),A
LD HL,0118H ;POSITION FOR 3RD MONTH
CALL PNTMONTH
RET
.EJECT
TOTLIN:
LD HL,MSG11 ;'TOTAL -------'
CALL PNTSTG
LD A,(FLAGA) ;ARE WE DOING YEARLY
BIT 2,A
JR Z,TLN0 ;NO
LD HL,(DFCC) ;YES NEED TWO MORE '-'
LD (HL),22
INC HL ;AN EXTRA '-' FOR YEARLY
LD (HL),22
RET ;DONE EXIT
TLN0:
LD A,(MONTH) ;SEE HOW MANY
CP 11 ;IS DEC EXIT
RET Z
CP 10 ;IF NOV SKIP ONE
JR Z,TLN1
LD HL,MSG12 ;' -------'
CALL PNTSTG
TLN1:
LD HL,MSG12 ;' -------'
CALL PNTSTG
RET
ETXTPNT:
PUSH HL ;SAVE PIONTER
ETXT1:
POP HL ;GED NEXT TO DE
CALL POSNER
INC H ;POINT TO NEXT
PUSH HL
LD HL,(DFCC) ;GET ADDRESS
EX DE,HL ;DE --> CATEGORY TEXT
LD BC,05
LDIR ;MOVE TEXT
EX DE,HL
DEC A ;DONE ?
JR NZ,ETXT1 ;NO
POP HL
RET ;ELSE EXIT
.EJECT
PNTMONTH:
PUSH HL ;SAVE POSITION
LD B,11 ;DO 11 OF THEM
LD A,(SW00) ;GO INTO DBUFF
LD HL,DBUFF
LD DE,85 ;85 BYTES PER MONTH
OR A
JR Z,PM01 ;SKIP IF JAN
PM00:
ADD HL,DE ;OFFSET INTO BUFFER
DEC A ;MONTH'S TIMES
JR NZ,PM00
PM01:
EX DE,HL ;DE IS AT BUFFER NOW
POP HL ;GET CURSOR
CALL POSNER
INC H ;POINT TO NEXT
PUSH HL
LD HL,(DFCC) ;GET ADDRESS
EX DE,HL ;RIGHT FOR PRINT
CALL BCPNT ;PRINT THEM
DJNZ PM01 ;DO ALL 12
EX DE,HL
POP HL ;GET LINE #
INC H ;PAST TOTAL LINE
CALL POSNER ;POSITION IT
INC H
INC H ;PAST BLANK LINE
PUSH HL
LD HL,(DFCC) ;GET ADDRESS
EX DE,HL ;GET POINTERS CORRECT
CALL BCPNT ;PRINT THIS FIELD
LD B,3 ;THREE THIS TIME
PM02:
EX DE,HL
POP HL
CALL POSNER
INC H
PUSH HL
LD HL,(DFCC) ;GET ADDRESS
EX DE,HL ;RIGHT FOR PRINT
CALL BCPNT ;PRINT DIGITS
DJNZ PM02
EX DE,HL
POP HL
INC H ;OVER TOTAL LINE
CALL POSNER
INC H
INC H ;TO BAL LINE
PUSH HL
LD HL,(DFCC) ;GET ADDRESS
EX DE,HL
CALL BCPNT ;PRINT THEM
EX DE,HL
POP HL ;POSITION TO LAST
CALL POSNER
LD HL,(DFCC) ;GET ADDRESS
EX DE,HL
CALL BCPNT
RET
BCPNT:
LD A,(FLAGA) ;6 OR 8 ?
BIT 2,A
JP Z,BCPNT6 ;DO SIX
JP BCPNT8
.EJECT
;***********************************************************************
;
; PRINT STATEMENT ROUTINE
;
;**(*******************************+*************************************
STATEMENT:
CALL CLS
LD HL,MSG10 ;'MONTHLY STATEMENT'
LD DE,0C04H
CALL PNTAT
CALL GTMNTH ;GET START MONTH
LD A,(FLAGA) ;QUIT FLAG SET
BIT 0,A
JP NZ,FINANCE ;YES
STAT1:
CALL CLS
LD HL,0005H
CALL POSNER ;POSITION FOR MONTH TEXT
LD A,(MONTH)
LD C,A ;MONTH IN 'C'
ADD A,A ;* 2
ADD A,C ;* 3
LD C,A
LD B,0 ;OFFSET IN BC
LD HL,MTEXT ;POINT TO TEXT
ADD HL,BC ;HL --> CORRECT MONTH TEXT
LD A,3 ;DO 3 MONTHS
LD DE,(DFCC) ;GET ADDRESS
STAT2:
PUSH HL ;SAVE SOURCE
LD HL,06 ;OFFSET TO NEXT
ADD HL,DE
EX DE,HL ;DE --> DEST
POP HL ;GET SOURCE
LD BC,03 ;MOVE 3 OF THEM
LDIR
DEC A ;DONE
JR NZ,STAT2
LD HL,FLAGA ;RESET PRINT 8 FLAG
RES 2,(HL)
CALL PNTSTATE ;PRINT"STATEMENT
STAT3:
LD HL,1600H
CALL POSNER ;GET A ADDRESS
LD DE,(DFCC) ;GOT IT
LD HL,MSG17 ;'PRESS L FOR LAST OR N FOR NEXT'
LD BC,30
LDIR ;CANNOT PRINT IN LOWER TWO LINES
LD HL,1700H ;MOVE OTHER MESSAGE TO BOTTOM
CALL POSNER
LD DE,(DFCC)
LD HL,MSG16 ;'PRESS P FOR PRINT OR Q FGR QUIT
LD BC,31
LDIR
LD (DFCC),DE
CALL GETKEY ;GET A ANSWER
CP 54 ;IS 'Q'
JP Z,FINANCE ;YES EXIT
CP 51 ;IS 'N'
JR NZ,STAT5 ;NO
LD A,(MONTH) ;EHSE
INC A ;BUMP MONTH
CP 12 ;IS TOO BIG
JR NZ,STAT4 ;YES RESET
XOR A ;SET TO START
STAT4:
LD (MONTH),A ;UPDATE
JP STAT1 ;AND START OVER
STAT5:
CP 49 ;IS 'L'
JR Z,STAT6 ;YES DO LAST
CP 35H ;IS 'P'
JR NZ,STAT3 ;NO GET IT RIGHT
LD HL,1700H ;BLANK LOWER LINES
CALL BLNKLN
INC H
CALL BLNKLN
LD HL,00 ;POSITION TO HOME
CALL POSNER
CALL COPY ;PUT IT TO THE PRINTER
CALL SLOW ;COPY IS IN FAST
JR STAT3
STAT6:
LD A,(MONTH) ;BACK HIM UP ONE
DEC A
JP P,STAT7 ;CAN'T GO PAST 0
LD A,11 ;SET FOR DEC
STAT7:
LD (MONTH),A ;PUT IT BACK ONE
JP STAT1
.EJECT
;************************************************************************
;
; UPDATE ROUTINE
;
;************************************************************************
UPDATE:
CALL CLS
LD HL,MSG24 ;'UPDATE '
LD DE,010CH
CALL PNTAT
CALL CATPNT
UPD01:
CALL GTMNTH ;WHICH MOFTH TO UPDATE
LD A,(FLAGA) ;DID THEY 'Q' ?
BIT 0,A
JP NZ,FINANCE ;YES BACK TO MENUE
LD HL,MSG23 ;_____________4C3FH
LD DE,020BH
CALL PNTAT
LD A,(MONTH) ;GET THE MONTH REQUESTED
LD C,A ;SAVE * 1
ADD A,A ;MAKE * 2
ADD A,C ;FINALY * 3
LD B,0 ;BC IS A OFFSET PER THE MONTH
LD C,A ;NOW
LD HL,MTEXT ;POINT TO START OF MONTH'S THREE LETTER TEXT
ADD HL,BC ;HL POINTS TO PROPER MONTH ZASCII
LD DE,(DFCC) ;WHERE TO PUT IT ?
LD BC,03 ;DFCC KNOWS AND 3 IS THE LENGTH
LDIR
JR UPD03
UPD02:
LD HL,4CA2H ;CLEAR OTHER LINES
LD DE,0E04H
CALL PNTAT
UPD03:
LD HL,1500H
CALL BLNKLN
DEC H
CALL BLNKLN
LD HL,MSG25 ;'CATEGORY '
LD DE,1203H
CALL PNTAT
LD B,02 ;GET UP TO 2
CALL GETSTG ;INPUT A STRING
LD HL,(DFCC) ;UH! WHICH WAY DID DA GO
LD C,B ;BACK TO START
LD B,0
OR A ;RESET CARRY
SBC HL,BC
LD A,(HL) ;GET FIRST CHAR
CP 54 ;DID THEY 'Q'
JR Z,UPD01 ;YEP
OR A
JR Z,UPD01
DEC C ;HOW MANY
JR Z,UPD04 ;ONLY ONE SKIP
CP 29 ;TENS DIGIT MUST BE A ONE
JR NZ,UPD03 ;OR ERROR
LD C,10 ;ONE HERE IS WORTH 10
INC HL ;POINT TO UNIS
UPD04:
LD A,(HL) ;GET UNITS DIGIT
SUB 29 ;MAKE BINARY - 1
ADD A,C ;PUT IN TEN'S
CP 14 ;0 --> 13 ONLY
JR NC,UPD03 ;OR ERROR
LD (TEMP1),A ;SAVE CATEGORY #
UPD05:
LD HL,0E00H ;CLEAR LAST TEXT
CALL BLNKLN
LD HL,4C45H
LD DE,0E09H
CALL PNTAT
LD HL,CATTXT ;GONNA PUT UP THE CATEGORY TEXT
LD DE,05
LD A,(TEMP1) ;GET #
OR A ;IF ZERO THEN
JR Z,UPD07 ;HL IS CORRECT
UPD06:
ADD HL,DE ;ELSE ADD IN CORRECT OFFSET
DEC A
JR NZ,UPD06
UPD07:
LD DE,(DFCC) ;GT DISPLAY ADDRESS
LD BC,05 ;#TO MOVE
LDIR ;MOVE THEM FOR ALL TO SEE
CALL GETDOL ;GET SOME MONEY
LD A,(FLAGA) ;IF 'Q' THEN POP
BIT 0,A ;A LEVEL IN THE ROUTINE
JR NZ,UPD02
LD HL,DBUFF ;POINT TO DOLLARS
LD A,(MONTH) ;PER THE MONDH
LD DE,85 ;85 BYTES PER MONTH
OR A ;IF JAN
JR Z,UPD09 ;HL IS CORRECT
UPD08:
ADD HL,DE ;HL POINT TO PROPER MONTH'S DATA
DEC A
JR NZ,UPD08
UPD09:
LD (SW00),HL ;SAVE START OF MONTH
LD A,(TEMP1) ;GET CATEGORY
LD DE,05) ;BYTES PER CATEGORY
OR A ;IF FIRST
JR Z,UPD11 ;HL IS CORRECT
CP 11 ;ADJUST FOR BUFFER
JR C,UPD10
INC A
UPD10:
ADD HL,DE ;ELSE POINT TO CORRECT CATEGORY
DEC A
JR NZ,UPD10
UPD11:
LD DE,BCBUF ;POINT TO NEW DOLLARS
CALL SUMR ;SUM INTO CATEGORY
LD HL,(SW00) ;GET START OF MONTH'S DOLLARS
LD DE,5*11 ;POINT TO EXP. TOTALS
LD A,(TEMP1) ;IF THE CATEGORY IS < 12
CP 11 ;THEN IT'S AN EXPENSE
JR C,UPD12 ;AND DE IS CORRECT
LD DE,5*15 ;ELSE CHANGE TO INC. TOTAL
UPD12:
ADD HL,DE
LD DE,BCBUF
CALL SUMR ;SUM INTO PROPER TOTAL
LD HL,(SW00) ;GET START OF MONTH'S DOLLARS
LD DE,5*11 ;MOVE EXPENSE TOTAL
ADD HL,DE
LD DE,BCBUF ;TO THE BCD BUFFER
LD BC,05 ;SIGN AND ALL
LDIR
LD A,(BCBUF) ;FLIP THE SIGN BYTE
XOR 1BH ;0DH TO 16H OR 16H TO 0DH
LD (BCBUF),A
LD HL,(SW00) ;NOW POINT TO INC. TOTAL
LD DE,5*15
ADD HL,DE
LD DE,BCBUF1 ;MOVE IT TO TEMP STORAGE
LD BC,05
LDIR
LD DE,BCBUF1 ;POINT TO THEM
LD HL,BCBUF ;POINT TG EXP. TOTAL
CALL SUMR ;GET A BAL. TOTAL
LD HL,(SW00) ;POINT TO BAL. TOTAL
LD DE,5*16
ADD HL,DE
LD DE,BCBUF ;AND NEW BAL. TOTAL
EX DE,HL
LD BC,05 ;AND SOVE IN NEW TOTAL
LDIR
JP UPD05 ;BACK FOR MORE DOLLARS THIS CATEGORY
.EJECT
;************************************************************************
; YEARLY PRINT ROUTINE
;************************************************************************
YEARLY:
CALL CLS
LD HL,DBUFF+(17*12*5) ;POINT TO YEARLY BUFFER
LD B,17 ;IT'S THE SAME AS ONE MONTH
CALL CLYR1 ;CLEAR IT
LD DE,DBUFF ;POINT TO MONTHS
LD C,12 ;TWELVE OF COURSE
YEAR1:
LD B,17 ;17 CTEGORYS AND TOTALS
LD HL,DBUFF+(17*12*5) ;THE YEAR BUFFER
YEAR2:
CALL SUMR ;ADD IN A CATEGORY
PUSH BC ;SAVE COUNTS
LD BC,05 ;ON TO NEXT
ADD HL,BC
EX DE,HL ;DO BOTH SOURCES
ADD HL,BC
EX DE,HL ;BUMPED ONE CATEGORY'S WORTH BOTH
POP BC ;GET COUNTS BACK
DJNZ YEAR2 ;17 IN A MONTH
DEC C ;12 MONTHS
JR NZ,YEAR1
LD A,12 ;SET FOR YEAR BUFFER
LD (MONTH),A ;FOR THE PRINTER
LD HL,FLAGA ;SET PNT 8 FLAG
SET 2,(HL)
CALL PNTSTATE ;AND PRINT IT
LD HL,MSG18 ;'YEARLY TOTALS'
LD DE,0512H
CALL PNTAT
LD HL,YEAR ;LET THEM KNOW WHAT YEAR
LD DE,0616H
CALL PNTAT
YEAR3:
LD HL,1700H
CALL POSNER ;LDIR INTO BOTTOM TWO LINES
LD DE,(DFCC) ;GET THE ADDRESS
LD HL,MSG16 ;'PRESS P FOR PRINT OR Q FOR QUIT'
LD BC,31
LDIR
LD (DFCC),DE ;MOVE CURSOR
CALL GETKEY ;NEED AN ANWWER
CP 54 ;'Q' ?
JP Z,FINANCE ;YES DONE
CP 53 ;'P'
JR NZ,YEAR3 ;NO ERROR
LD HL,1700H ;BLANK BOTTOM LINES
CALL BLNKLN ;INCASE THEY BREAK IN BASIC
LD HL,00 ;RESET CURSER TO HOME
CALL POSNER
CALL COPY ;PUT IT TO THE PRINTER
NOP
NOP
NOP
JR YEAR3
.EJECT
;************************************************************************
;
; CLEAR MONTH
;
;************************************************************************
CLMNTH:
CALL CLS
LD HL,MSG9 ;'CLEAR MONTH'
LD DE,0A08H
CALL PNTAT
LD HL,MSG7 ;'AR YOU SURE'
LD DE,0E08H
CALL PNTAT
LD B,3 ;GET UP TO 3
CALL GETSTG ;GET RESPONSE
LD HL,(DFCC) ;POINT TO RESPONSE
LD BC,3 ;-3
OR A
SBC HL,BC
LD DE,MSG8 ;'YES'
LD B,3 ;LENGTH
CALL COMP
JP NZ,FINANCE ;NOT 'YES'
CALL GTMNTH ;GET A MONTH
LD A,(FLAGA) ;'Q'
BIT 0,A
JR NZ,CLMNTH ;YES TRY AGAMN
LD A,(MONTH) ;GET MONTH
LD B,A
LD HL,DBUFF
LD DE,85 ;# BYTES IN A MONTH
OR A ;IS JAN ?
JR Z,CLMT2 ;YES SKIP
CLMT1:
ADD HL,DE ;OFFSET INTO DBUFF
DJNZ CLMT1
CLMT2:
LD B,17 ;# OF FIELDS IN A MONTH
CALL CLYR1 ;FINISH HERE
JP FINANCE
CLYR1:
LD C,4
LD (HL),13 ;PUT IN A '$'
CLYR2:
INC HL ;ZERO 4 OF THEM
LD (HL),00
DEC C
JR NZ,CLYR2
INC HL
DJNZ CLYR1 ;DO ALL BUFFERS
RET
.EJECT
;************************************************************************
;
; CLYEAR: CLEAR YEAR ROUTINE
;
;************************************************************************
CLYEAR:
CALL CLS
LD HL,MSG6 ;'CLEAR YEAR'
LD DE,0A05H
CALL PNTAT
LD HL,MSG7 ;'ARE YOU SURE'
LD DE,0E04H
CALL PNTAT
LD B,3 ;GET UP TO 3
CALL GETSTG
LD HL,(DFCC) ;POINT TO RESPONSE
LD BC,3 ;-3
OR A
SBC HL,BC
LD DE,MSG8 ;'YES'
LD B,3 ;LENGTH
CALL COMP
JP NZ,FINANCE ;NOT 'YES'
CALL CLS
LD HL,MSG19 ;'INPUT YEAR'
LD DE,1504H
CALL PNTAT
LD B,4 ;GET A MAX OF FOUR
CALL GETSTG
LD HL,(DFCC) ;GET ENDING ADDRESS
LD C,B ;IN BC
LD B,0
OR A
SBC HL,BC ;GO TO START
LD DE,YEAR ;MOVE IT
LD BC,4
LDIR
LD A,60H ;PUT IN A EOL
LD (DE),A
LD HL,DBUFF ;CLEAR ENTIRE BUFFER
LD B,12*17 ;DO ALL
CALL CLYR1 ;CLEAR THEM
JP FINANCE
.EJECT
;************************************************************************
;
; SAVE ROUTINE
; SAVES PROGRAM TWICE UNDER THE NAME 'FINANCE'
;
;************************************************************************
SAVE:
CALL CLS
LD HL,MSG27 ;'TAPE SAVE'
LD DE,0509H
CALL PNTAT
LD HL,MSG28 ;'START RECORDER PRESS ENTER'
LD DE,0A00H
CALL PNTAT
CALL GETKEY ;WAIT FOR ENTER
CP 122 ;WAS IT ENTER ?
JP NZ,FINANCE ;NO LEAVE
CALL FAST ;MUST BE IN FAST MODE
LD HL,MSG29 ;'FINANCE' ** NOTE THE 'E'IS INVERTED VIDEO
CALL CSAVE ;IN ZX81 ROM
CALL FAST ;INSURE FAST MODE
LD HL,MSG29 ;DO SECOND COPY
CALL CSAVE
CALL SLOW ;SO WE CAN SEE
JP FINANCE ;AND DO MORE
.EJECT
;****************************************************************"*******
;
; CHANGE CATEGORY ROUTINE
;
;************************************************************************
CHCAT
CALL CLS
CALL CATPNT ;SHOW THEM THE CATEGORIES
LD HL,MSG20 ;'CATEGORY CHANGE'
LD DE,0102H
CALL PNTAT
CHC1:
LD HL,1000H ;CLEAN UP DISPLAY BOR LOOPING
CALL BLNKLN
LD H,12H
CALL BLNKLN
LD H,14H
CALL BLNKLN
LD HL,MSG21 ;'INPUT STARTING CATEGORY'
LD DE,1102H
CALL PNTAT
LD B,2 ;GET UP TO TWO
CALL GETSTG
LD HL,(DFCC) ;GET ADDRESS OF INPUT
LD C,B ;# ENTERED TO BC
LD B,0
OR A
SBC HL,BC
LD A,(HL) ;GET FIRST ENTRY
CP 54 ;'Q' ?
JP Z,FINANCE ;YES BAG IT
OR A ;IF NONE
JR Z,CHC1 ;IT WON'T WORK
DEC C ;IF THE COUNT IS ONE
JR Z,CHC2 ;SKIP TENS DIGIT
CP 29 ;IF TWO THEN TEN'S DIGIT
JR NZ,CHC1 ;MUST BE A ONE
LD C,10 ;INIT 10'S COUNT
INC HL ;MOVE POINTER TO UNITS
CHC2:
LD A,(HL) ;GET UNITS DIGIT
SUB 29 ;BINARY -1
ADD A,C ;PUT IN TEN'S VALUE
CP 14 ;> 13 IS ERROR
JR NC,CHC1 ;SO TRY AGAIN
CHC3:
LD HL,1100H ;BLANK INPUT LINE
CALL BLNKLN
LD HL,MSG22 ;'CATEGORY '
LD DE,1002H
CALL PNTAT
LD HL,(DFCC)
LD C,00 ;SET C FOR UNDER 10
CP 09 ;IF OVER 9 SET C
JR C,CHC4
LD C,10
BIT 3,C ;WAS THERE A 10'S DIGIT ?
JR Z,CHC4 ;NO JUST DO UNITS
LD (HL),29 ;PUT IN THE '1'
INC HL
SUB C ;AND MAKE REG A UNITS
CHC4:
ADD A,29 ;MAKE UNITS ZASCII
LD (HL),A ;PUT IN DISPLAY
SUB 29 ;BACK TO BINARY
ADD A,C ;TEN'S ALSO
INC HL ;INSERT
LD (HL),20 ;A '='
INC HL
EX DE,HL ;DISPLAY FILE TO DE
LD BC,5 ;# CHAR PER CATEGORY
LD HL,CATTXT
OR A ;IF FIRST
JR Z,CHC6 ;HL IS CGRRECT
PUSH AF ;SAVE CATEGORY
CHC5:
ADD HL,BC ;MOVE INTO CTTXT TO PROPER CATEGORY
DEC A
JR NZ,CHC5
POP AF ;GET CATEGORY BACK
CHC6:
LD (SW00),HL ;SAVE CATTXT ADDRESS
LDIR ;BC = 05 DE --> DISPLAY FILE
EX DE,HL ;CLEAR FOR TWO DiGIT #'S
LD (HL),00
LD HL,MSG26 ;'INPUT NEW CATEGORY OR Q'
LD DE,1402H
CALL PNTAT
LD HL,120FH ;POSATION INPUT TO OLD CATEGORY
CP 9 ;COUNTING 0 --< 13
JR C,CHC7
INC L ;MOVE OVER IF OVER 9
CHC7:
CALL POSNER
LD B,5 ;GET UP TO 5 FOR NEW NAME
CALL GETSTG
INC B ;IF ENTER ONLY
DEC B
JR Z,CHC8 ;MOVE ON TO NEXT
LD HL,(DFCC) ;GET ADDRESS OF NEW
LD C,B
LD B,0
OR A
SBC HL,BC
LD E,A ;SAVE CATEGORY
LD A,(HL) ;GET FIRST CHAR
CP 54 ;IS IT A 'Q'
LD A,E ;REPLACE CATEGORY
JP Z,CHC1 ;'Q' POP UP A HEVEL
LD BC,05
LD DE,(SW00) ;GET STARTINC ADDRESS
LDIR ;AND MOVE NEW CATEGORY IN
CHC8:
INC A ;MOVE TO NEXT
CP 14 ;WAS THAT THE LAST ?
JR C,CHC9 ;NO
XOR A ;YES START OVER
CHC9:
CALL CATPNT ;PRINT THE CHANGE
LD HL,1200H ;BLANK INPUT LINE
CALL BLNKLN
JP CHC3 ;AND GET NEXT
.EJECT
;************************************************************************
;
; MESSEGES
;
; SUBSTITUTE CHAR FOR N/L, = 122
; BECAUSE A 76H CANNOT GO INTO A REM STATEMENT
; AND 122 IS NOT USED BY THE ZX81
;
;************************************************************************
MSG1: ;'YEARLY FINANCE'
.BYTE 62,42,38,55,49,62,00,43,46,51,38,51,40,42,122,122
;'MODES'
.BYTE 00,00,00,00,00,00,00,00,50,52,41,42,56,122,122
;'1=STATEMENT'
.BYTE 00,00,00,00,29,20,56,57,38,57,42,50,42,51,57,122
;'2=UPDATE'
.BYTE 00,00,00,00,30,20,58,53,41,38,57,42,122
;'3=YEARLY TOTALS'
.BYTE 00,00,00,00,31,20,62,42,38,55,49,62,00,
.BYTE 57,52,57,38,49,56,122
;'4=CLEAR MONTH'
.BYTE 00,00,00,00,32,20,40,49,42,38,55,00,50,52,51,57,45,122
;'5=CLEAR YEAR'
.BYTE 00,00,00,00,33,20,40,49,42,38,55,00,62,42,38,55,122
;'6=SAVE'
.BYTE 00,00,00,00,34,20,56,38,59,42,122
;'7=CHANGE CATEGORIES'
.BYTE 00,00,00,00,35,20,40,45,38,51,44,42,00,40,38,57,42,44,52,55,46,42,56,60H
MSG2: ;'SELECTION: '
.BYTE 56,42,49,42,40,57,46,52,51,14,00,60H
MSG3: ;'INPUT MONTH 1 T0 12: '
.BYTE 46,51,53,58,57,00,50,52,51,57,45,00,29,00,57,52,00,29,30,14,00,60H
MSG4: ;'INPUT AMOUNT:$ '
.BYTE 46,51,53,58,57,00,38,50,52,58,51,57,14,
.BYTE 13,00,00,00,00,00,00,00,00,00,00,60H
.EJECT
MSG5: ;REENTER AMOUNT'
.BYTE 55,42,42,51,57,42,55,00,41,52,49,49,38,55,00,38,50,52,58,51,57,60H
MSG6: ;'CLEAR YEAR'
.BYTE 40,49,42,38,55,00,62,42,38,55,60H
MSG7: ;'ARE YOU SURE? '
.BYTE 38,55,42,00,62,52,58,00,56,58,55,42,15,00,60H
MSG8: ;'YES'
.BYTE 62,42,56,60H
MSG9: ;'CLEAR MONTH'
.BYTE 40,49,42,38,55,00,50,52,51,57,45,60H
MSG10: ;'MONTHLY STATEMENT'
.BYTE 50,52,51,57,45,49,62,00,56,57,38,57,42,50,42,51,57,60H
MSG11: ;'TOTAL -------'
.BYTE 57,52,57,38,49
MSG12: ;' -------'
.BYTE 00,00,22,22,22,22,22,22,22,60H
MSG13: ;'EXP.'
.BYTE 42,61,53,27,60H
MSG14: ;'INC.'
.BYTE 46,51,40,27,60H
MSG15: ;'BAL.'
.BYTE 39,38,49,27,60H
MSG16: ;'PRESS P FOR PRINT OR Q TO QUIT '
.BYTE 53,55,42,56,56,00,53,00,43,52,55,00,53,55,46,51,57,00,52,
.BYTE 55,00,54,00,57,52,00,54,58,46,57,00,60H
MSG17: ;PRESS L FOR LAST OR N FOR NEXT'
.BYTE 53,55,42,56,56,00,49,00,43,52,55,00,49,38,56,57,00,52,55,00,
.BYTE 51,00,43,52,55,00,51,42,61,57,60H
MSG18: ;'YEARLY TOTALS'
.BYTE 62,42,38,55,49,62,00,57,52,57,38,49,56,60H
MSG19: ;'INPUT YEAR'
.BYTE 46,51,53,58,57,00,62,42,38,55,00,60H
MSG20: ;'CATEGORY CHANGE'
.BYTE 40,38,57,42,44,52,55,62,00,40,45,38,51,44,42,60H
MSG21: ;'INPUT STARTING
.BYTE 46,51,53,58,57,00,56,57,38,55,57,46,51,44,00,
MSG22: ;CATEGORY'
.BYTE 40,38,57,42,44,52,55,62,00,00,00,60H
.EJECT
MSG23: ;'FOR "
.BYTE 43,52,55,00,00,60H
MSG24: ;'UPDATE '
.BYTE 58,53,41,38,57,42,00,60H
MSG25: ;'WHICH CATEGORY? '
.BYTE 60,45,46,40,45,00
.BYTE 40,38,57,42,44,52,55,62,15,00,60H
.EJECT
MSG26: ;'INPUT NEW CATEGORY OR Q'
.BYTE 46,51,53,58,57,00,51,42,60,00,40,38,57,42,44,52
.BYTE 55,62,00,52,55,00,54,60H
.EJECT
MSG27: ;'TAPE SAVE'
.BYTE 57,38,53,42,00,56,38,59,42,60H
MSG28: ;'START RECORDER PRESS ENTER'
.BYTE 56,57,38,55,57,00,55,42,40,52,55,41,42,55,00,53
.BYTE 55,42,56,56,00,42,51,57,42,55,60H
MSG29: ;'FINANCE' ** NOTE 'E' IS INVARTED
.BYTE 43,46,51,38,51,40,170,49,38,56,57,60H
.EJECT
MTEXT: ;'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC '
.BYTE 47,38,51,43,42,39,50,38,55,38,53,55,50,38,62,47
.BYTE 58,51,47,58,49,38,58,44,56,42,53,52,40,57,51,52
.BYTE 59,41,42,40,00,00,00,00,00,00
.EJECT
FLAGA: .block 01
;************************************************************************
; ** FLAGA *
; BIT USE
; 0 QUIT FLAG -- SET IF 'Q' PRESSED IN GETMNTH & GETDOL
; 1 MINUS FLAG IN GETDOL SET IF INPUT IS MINUS
; 2 PRINT 6 0R 8 FLAG (SET = PRINT 8 RESET = PRINT 6 BCD DIGITS)
; 3 PRINT ONE ONLY FOR UPDATE
; 4 ** UNUSED **
; 5 ** UNUSED **
; 6 ** UNUSED **
; 7 ** UNUSED **
;************************************************************************
TEMP1: .block 01 ;CATEGORY STORAGE TEMPORY
MONTH: .block 01 ;MONTH STORAGE
BCBUF: .block 05 ;BCD BUFFER GOR GETDOL
BCBUF1: .block 05 ;BCD BUFFER FOR UPDATE
SW00: .block 02 ;TEMP STORAGE
CHBUF: .block 02 ;DUMMY STRING FOR PNTCHR
DBUFF: .block 17*13*5 ;DOLLAR BUFFER (CAT,MONTH,LENGTH)
CATTXT: .block 14*5 ;CATEGORY TEXT 14X5 LONG
YEAR: .block 05 ;ZASCII YEAR
BCTEMP: .block 05 ;TEMP BUFFER FOR SUMSWAP
CATNO: .block 02 ;CATEGORY # FOR UPDATE IN ZASCII
;************************************************************************
; THIS MESSAGE REMOVED AT THE REQUEST OF THE PUBLISHER
;************************************************************************
;MSG31: ;'(C) 1983, D. J. BERRY'
; .BYTE 16,40,17,00,29,37,36,31,00,41,27,47,27,39,42,55,55,62,60H
FIN: .END
\n