home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CP/M
/
CPM_CDROM.iso
/
beehive
/
compress
/
ql40.arc
/
QL.002
< prev
next >
Wrap
Text File
|
1991-08-11
|
39KB
|
1,814 lines
;.....
;
; (...Cont. from QL.001)
;
; get a command from user & execute it. Default cmd is forward 1 page.
;
GETCMD: CALL CRLF ; Move down to the "status line"
CALL ONHALF
LD A,(LIBRARY) ; Working w/ library?
OR A ;
JR Z,NALIB ; If not..
LD HL,MEMBER ; Print the member's name
JR CPRFN ;
NALIB: LD HL,FCB1+1 ; The file's name
CPRFN: CALL PRNFN ;
CALL PUTPGNUM ; And the page number
CALL OFFHALF
GET1: CALL GETCHNUM ; Sets jumpto
; chk for jumpto
;
LD B,A ; Save cmd
LD A,(JUMPTO)
OR A ; Jumpto <> 0?
JR Z,JPTOIS0
GOTO: LD (PAGE),A ; Else new pg is jumpto
XOR A ; 0 out jumpto
LD (JUMPTO),A
JP PRPG ; Jumpto that page
JPTOIS0:
LD A,B
OR A ; A was 0 on ret?
JR NZ,GET3 ; No, see if letter cmd
LD A,(CORE)
INC A ; Pg 0 if core, pg 1 if other
JR GOTO ; Else, force tof
; chk letter cmds ;
GET3: LD A,B ; Get cmd back
CALL UCASE ;
LD BC,ENDCMDS-CMDS ; # of cmds
LD HL,CMDS
CPIR ; Try to match cmd
JR NZ,DEFAULT ; No matching cmd found
LD H,B
LD L,C ; Inverse cmd number
ADD HL,HL ; *2 for word adrs
LD DE,CMDADR
ADD HL,DE ; *cmd adr we want
LD E,(HL) ; Lo cmd adr
INC HL
LD D,(HL) ; Hi cmd adr
EX DE,HL ; Cmd adr in HL
JP (HL) ; Go exec it
;============================================================;
; The routines to handle commands when within a file follow. ;
;============================================================;
CMDS: DB ' ' ;
DB '-' ;
DB 'A' ;
DB 'B' ;
DB CTRLC ;
DB 'F' ;
DB 'C' ;
DB CTRLK ;
DB 'L' ;
DB 'Q' ;
DB 'R' ;
DB 'T' ;
DB 'X' ;
DB CTRLX ;
DB ESC ;
DB '/' ;
DB '?' ;
DB 'E' ;
DB 'H' ;
ENDCMDS:
; in reverse order
CMDADR: DW HOME ; H
DW ENDFIL ; E
DW HELP ; ?
DW HELP ; /
DW QUIT ; Esc
DW QUIT ; ^X
DW QUIT ; X
DW TOGGLETRUNC ; T
DW REPEAT ; R
DW QUIT ; Q
DW SINGLELINE ; L
DW SYSTEM ; ^K
DW CASETGL ; C
DW FIND ; F
DW SYSTEM ; ^C
DW BACKAPAGE ; B
DW ALTDISPLAY ; A
DW BACKAPAGE ; -
DW SINGLELINE ; <sp>
;.....
;
; Major abort, right back to CP/M, skipping intermediate levels
;
SYSTEM: LD A,0FFH
LD (PUTCABRT),A
JP QLEXIT ; Fix stack and ret to system
;.....
;
; default cmd is page forward, cancel any found marking
;
DEFAULT:
XOR A
LD (FOUND),A
LD HL,PAGE
INC (HL) ; Page++
DEF1: JP PRPG
;.....
;
; Go to end of file
;
ENDFIL: XOR A
LD (FOUND),A
LD A,(HIPG)
LD (PAGE),A ; Set page to highest page #
JP PRPG
;.....
;
; "Home", ie go to top of file
;
HOME: XOR A
LD (FOUND),A
LD A,1
LD (PAGE),A ; Set page "1"
JP PRPG
;......
;
; back 1 pg, cancel any found marking
;
BACKAPAGE:
XOR A
LD (FOUND),A
BACKPAGE:
CALL PGMINUS1
JR DEF1
;................................
;
PGMINUS1: ;
LD A,(PAGE) ;
DEC A ; Page--
JR NZ,NOTPG0 ; Chk for page #0
LD A,(CORE) ; If core dumping, pg 0 is ok
INC A ; Else, force pg 1
;
NOTPG0: LD (PAGE),A ;
RET ;
;...............................;
;.....
;
; Toggle case sensitivity (when using 'find' command)
;
CASETGL:
CALL MSG
DB 'Case sensitive search: ',0
CALL TOGLC ; Toggle the flag and associated 'text'
SAYN: JR Z,SAYNO
CALL MSG
DB 'YES',0
JR DBELOW
SAYNO: CALL MSG
DB 'NO',0
DBELOW: CALL DELAY4
JP PRPG
;.....
;
; Toggle long line truncation
;
TOGGLETRUNC: ;
CALL MSG ;
DB 'Truncation: ',0 ;
CALL TOGLT ;
JR SAYN ;
;.....
;
; Toggle display between ascii <==> hex
;
ALTDISPLAY:
LD A,(CORE)
OR A ; Dumping core?
JP NZ,HELP ; ?
;; JP NZ,PRPG ; If so, dont allow toggle to ascii
XOR A
LD (FOUND),A ; Kill display of found $
LD HL,(BUFPTR)
LD (RESUMESRCH),HL ; Resume srchs at tof
CALL MSG ;
DB 'Display mode: ',0
CALL TOGLA ;
JR NZ,SAYHEX ;
CALL MSG ;
DB 'ASCII',0 ;
JR DBELO3 ;
SAYHEX: CALL MSG ;
DB 'HEX',0 ;
DBELO3: CALL DELAY4 ;
LD A,(AFLAG) ;
OR A ;
JP Z,ISTEXT ; [re-] set up for a text file
JP ISNONTEXT ; Else likewise for a non-text file
;................................
;
TOGLC: LD HL,CFLAG ; Flag to be flipped
LD DE,CSTATE ; Where to put text
LD IX,PTNO ; For zero, point to "NO"
LD IY,PTYES ; For non-zero, point to "YES"
LD BC,PTYES-PTNO ; #of chars
CALL FLIPIT ; Generic toggle subr to do all that
RET ;
;...............................;
;................................
;
TOGLT: LD HL,TFLAG ; Flag to be flipped
LD DE,TSTATE ; Where to put text
LD IX,PTNO ; For zero, point to "NO"
LD IY,PTYES ; For non-zero, point to "YES"
LD BC,PTYES-PTNO ; #of chars
CALL FLIPIT ; Generic toggle subr to do all that
RET ;
;...............................;
;................................
;
TOGLA: LD HL,AFLAG ; Flag to be flipped
LD IX,PTASC ; For zero, point to "ASCII"
LD IY,PTHEX ; For non-zero, point to "HEX"
LD BC,PTASC-PTHEX ; #of chars
LD DE,ASTATE ; Where to put abv text
CALL FLIPIT ; Generic toggle subr to do all that
RET ;
;...............................;
;................................
;
FLIPIT: LD A,(HL) ;
CPL ;
LD (HL),A ;
OR A ; Nec?
PUSH AF ; Save stat for poss analysis on rtn, also
JR Z,NOW0 ; Br if now zero (use ix as pointer)
PUSH IY ; Else use iy as pointer
JR FL2 ;
NOW0: PUSH IX ; Else use ix as pointer
FL2: POP HL ; In any case, get it into hl
LDIR ; Xfer appropriate text
POP AF ; For poss analysis of result of toggle
RET ;
;...............................;
PTNO: DB ' NO'
PTYES: DB 'YES'
PTHEX: DB ' HEX' ;
PTASC: DB 'ASCII'
;.....
;
; Put up the menu screen and process appropriate commands
;
HELP:
;
HELPLP: CALL CLEARSCREEN
CALL SIGNON ; Commands and statuses
CALL SUMMARY ; File summary
CALL REQCMD ; Request command
GETAGN: CALL GETCHR ; Get command
CALL UCASE ; Upcase if necessary
CP 'A' ; Only 'A', 'C', or 'T' will be accepted
JR NZ,ISNTA ; - (or <ret>, obviously)
CALL TOGLA ; Perf appropriate toggle action
JR HELPLP ; And redisplay the new settings
ISNTA: CP 'C' ; As above
JR NZ,ISNTC ;
CALL TOGLC ;
JR HELPLP ;
ISNTC: CP 'T' ; Once more
JR NZ,ISNTT ;
CALL TOGLT ;
JR HELPLP ;
ISNTT: CALL CHEXIT ; ^C, ^X rtn back to CP/M direct
JP Z,QUIT ; Other 'exit type' chars go here
JP PRPG ; Other commands continue?
;.....
;
; Forward one line
;
SINGLELINE:
LD A,(LINEBYLINE)
INC A ; Turn on or incr linecount
LD B,A ; Save linebyline flag
LD A,(AFLAG)
OR A ; In non-text mode?
LD A,B ; Get linebyline flag back
JR NZ,NON1LINE ; We're in non-text
LD A,(NLINES)
LD C,A
DEC C
LD A,B ; Get linebyline flag back again
CP C ; 23 lines done 1 at a time?
JR C,SAMEPAGE ; No
JR NEWPAGE
NON1LINE:
CP 17 ; Next non-text pg is 17 line forwards
JR C,SAMEPAGE
NEWPAGE:
LD A,(PAGE) ; Else this is a new pg
INC A
LD (PAGE),A
LD A,1 ; Line 1 of that pg
SAMEPAGE:
LD (LINEBYLINE),A
CALL CRLF ; Leave pg number intact
LD B,1 ; 1 line to display
LD HL,(CURRLINE) ; *curr line
LD A,(AFLAG)
OR A
JP Z,PUTNEXT ; Display a text line
; else, dump a line in hex/ascii if not at eof
;
LD A,(PAGE) ; Current page
LD B,A
LD A,(HIPG) ; Hipg
XOR B
JP Z,SAYEOF
CALL DOHEXASCII
JP GET1 ; Don't show pg#
;.....
;
; Find occurrrence of a string
;
FIND: LD A,0FFH
LD (FRCMDMODE),A
CALL FINDASTRING ; B has pg+1 on ret fr find sub
FINDCHK:
LD A,(STRLEN)
OR A ; Find $ given
JP Z,PRPG ; No, redisplay same pg
LD A,(FOUND)
OR A ; Did we find it?
JR Z,NOFIND ; No
LD A,B ; B=pg+1 where found
LD (PAGE),A
JP BACKPAGE ; So back up a pg to print it
NOFIND: CALL MSG
DB CR,LF,' ** Not Found **',0
LD A,(INCOMPLETE)
OR A
CALL NZ,WARNING ; Couldn't search entire file
JP GETCMD
;.....
;
; Repeat find occurrence of a string
;
REPEAT: LD DE,(RESUMESRCH)
LD A,D
OR E ; Find in progress?
JR Z,NOFIND ; No, report it
LD A,0FFH
LD (FRCMDMODE),A
CALL FINDAGAIN ; BC has pg+1
JR FINDCHK
;................................
;
GETCHR: PUSH BC ;
PUSH DE ;
PUSH HL ;
GETCHL: LD C,DIRIO ; Simple character input subroutine
LD E,0FFH ; Read
CALL BDOSEV ;
OR A ; Anything typed?
JR Z,GETCHL ;
POP HL ;
POP DE ;
POP BC ;
RET ; Ret w/ char in A
;...............................;
;.....
;
; accumulate numeric jumpto
; return if non-numeric or jumpto > hipg
;
GETCHNUM:
IF ZCPR3
CALL GETSPEED
LD DE,DELAY/4
LD HL,00
DLYLP: ADD HL,DE
DEC A
JR NZ,DLYLP
ELSE
LD HL,DELAY
ENDIF
LD (TIMER),HL ; Reinit key delay timer
WAIT: LD C,DIRIO ; Direct cons io
LD E,0FFH ; Read
CALL BDOSEV
OR A ; Anything typed?
JR NZ,GOTKEY ; Something typed
LD A,(JUMPTO) ; Building a jumpto number?
OR A
JR Z,WAIT ; No, just waiting for godot
LD HL,(TIMER)
DEC HL ; Timer--
LD (TIMER),HL
LD A,H
OR L ; Timer at 0?
JR NZ,WAIT ; No, not timed out
RET ; Exec jumpto now
GOTKEY:
JR Z,WAIT ; Not yet, so wait
; chk for pg number digits to jump to
CP '0'
RET C ; Non-numeric
CP '9'+1
RET NC
; it's a digit: echo it
PUSH AF ; Save digit
CALL PUTC
POP AF
SUB '0' ; Remove ascii # bias
LD B,A ; Save n
; times 10 + add new digit
LD A,(JUMPTO) ; So far
ADD A,A ; *2
LD C,A
ADD A,A ; *4
ADD A,A ; *8
ADD A,C ; *10
ADD A,B ; Add in new digit
LD (JUMPTO),A ; So far
; 0 here jumps to tof
RET Z
; see if approx enuf digits to deduce jp pg: hipg / 8 < jpto
LD B,A
LD A,(HIPG)
SRL A
SRL A
SRL A ; Hipg / 8
CP B ; Cy if < jpto?
JR NC,GETCHNUM ; Might need 1 more digit
RET
;------------------------------------------------------------------------------
;
FINDAGAIN: ; Repeat last find if there ever was one
; Do find 1st if not
LD DE,(RESUMESRCH) ; Repeat fr here if call fr display
LD A,(FRCMDMODE) ;
OR A ; Fr a real repeat cmd?
JR Z,SET4MATCHSTART ; No, called fr display of matches
; So use resumesrch adr
LD DE,(CURRLINE) ; Default: start repeat at top of next pg
LD HL,(EOFADR) ;
XOR A ;
SBC HL,DE ; Start srch beyond eof?
JR NC,SET4MATCHSTART ; >no
LD DE,(BUFPTR) ; Repeat srch fr tof: circular
;
SET4MATCHSTART: ;
JP STARTSRCHHERE ;
; print find prompt, get $ to find, srch for it
;
FINDASTRING:
XOR A
LD (HEXSRCH),A ; Not hex srch yet
ld a,cr ;
call putc ; Output a cr, no lf
ld b,60 ; ? #of blanks needed to overwrite
blp: call space ;
djnz blp ;
CALL MSG
DB CR,'Find: ',0
LD DE,STRMAX
LD C,RDBUFF ; Read user $
CALL BDOSEV
LD A,(STRLEN)
OR A
JP Z,FINDFAILS ; Null $ aborts find
; chk if finding a string of hex bytes
; B = user input ctr--
; C = hi nbl flag if yes (0ffh), else C = hi nbl
; DE = *temp hex $
; HL = *user input chars
;
LD B,A ; Ch count
LD A,(STRING)
CP HEXSIGNAL ; Hex signal ch?
JR NZ,FINDTEXT ; No
DEC B ; Count-- for signal char
JR Z,FINDTEXT ; Find - only
LD A,1
CP B ; Find half nbl only?
JR Z,FINDTEXT
LD DE,HEXSTRING ; *temp hex out $
LD HL,STRING+1 ; Pt at 1st valid hex ch
LD C,0FFH ; Set hi/lo flag = hi nbl
NEXTHEX:
LD A,(HL) ; Next user char
INC HL
CALL MKHEXDIGIT ; Strip ascii
JR C,FINDTEXT ; Bad hex digit, do normal text srch
PUSH AF
LD A,C
CP 0FFH ; Doing hi nbl?
JR NZ,LONBL ; No, doing lo nbl
; hi nbl goes in C
;
POP AF
SLA A
SLA A
SLA A
SLA A ; After shift to 4 hi bits
LD C,A ; Save hi nbl in C
; this also sets hi/lo nbl flag to lo (not hi)
;
JR GOTHI
LONBL: POP AF
OR C ; Combine hi & lo nbls
LD (DE),A ; Store into temp hex $
INC DE ; *temp++
LD C,0FFH ; Set hi nbl flag again
GOTHI: DJNZ NEXTHEX
; ascii to hex transl done
;
LD H,D
LD L,E ; *last hex byte stored
LD DE,HEXSTRING ; Base adr of hex$
XOR A
SBC HL,DE ; # of bytes stored
LD A,L
LD (STRLEN),A ; Adj string len
LD C,A ; # of bytes to copy
LD B,0
LD HL,HEXSTRING ; Src
LD DE,STRING ; Lst
LDIR ; Copy hex$ to string buffer
LD A,0FFH
LD (HEXSRCH),A ; Call for a hex srch, no hi bit masking
FINDTEXT:
LD DE,(BUFPTR) ; Default srch start at tof
LD A,(CORE)
OR A ; Find in core dump?
JR Z,FFILE ; No, in a file
LD DE,0 ; Default find in core starts at adr 0
FFILE:
IF FINDFRTOP ; Start find on curr pg
ELSE ; Avoid assembler specific .NOT. syntax
LD A,(PAGE) ; Curr pg
LD B,A ; Save curr pg
LD A,(CORE)
OR A
JR NZ,FINCORE ; Pg 0 is 0'th ptr in core
DEC B ; 0'th ptr is pg 1 if not core
FINCORE: ;
LD L,B ;
LD H,0
ADD HL,HL ; *2 for word adr
LD DE,(@PTRTBL)
ADD HL,DE ; Idx into ptrtbl
LD E,(HL) ; Get pg adr
INC HL
LD D,(HL)
ENDIF ; NOT FINDFRTOP
; DE set for start of srch
STARTSRCHHERE:
LD HL,(EOFADR)
LD A,(AFLAG)
OR A ; In nontext display?
JR NZ,OK2FINDEOF ; Yes
DEC HL ; Dont allow srch for eof if in text display
OK2FINDEOF:
XOR A ; Clr cy
LD (FRCMDMODE),A ; Set not fr cmd mode
SBC HL,DE ; Len left to scan
JR C,FINDFAILS ; Borrow = start srch beyond eof
JR Z,FINDFAILS ; At eof: nothing to scan
LD B,H ; Len goes in
LD C,L ; BC for cpir
EX DE,HL ; HL=start srch adr
LD IX,MATCHES ; *matches so far
LD A,(HEXSRCH) ; Hex searching?
OR A
LD IY,GETHEX ; Use hex compare & get rtns
JR NZ,MATCH1ST
LD A,(CFLAG) ; Case sensitive search?
OR A ;
LD IY,GETUC ; Use upcase compare & get rtns
JR Z,MATCH1ST
LD IY,GETLC ; Else use lowercase compare & get rtns
; find the 1st char of $
MATCH1ST:
LD (IX),0 ; Count of chars matched so far
LD DE,STRING ; *$
CALL GSTRCHAR ; Get 1st char to find
; Diddle it according to cmp type
MATCHLP:
CALL DOCMP ; Use proper compare routine - cy set on match
CPI ; Buffer++, cnt--
JR C,MTCHD1 ; Matched 1st char
JP PE,MATCHLP ; Continue looping if cnt >0
FINDFAILS:
XOR A ; Failure to find
LD (FOUND),A
LD (MATCHADR),A
LD (MATCHADR+1),A
LD HL,(BUFPTR) ; Repeat finds start at tof
LD A,(CORE)
OR A
JR Z,FILEFAIL ; Failed file srch
LD HL,00FFH ; Failed core srch
; Can't repeat on pg 1 anyway
FILEFAIL:
LD (RESUMESRCH),HL
RET
GSTRCHAR:
JP (IY) ; Jump to get rtn
DOCMP: PUSH BC ; Need a register
DEC IY ; Dec ptr by 2
DEC IY ; To point to CMP vector
PUSH IY ; Save on stack
INC IY ; Inc ptr by 2
INC IY
RET ; Jump to vector
JR CMPHEX
GETHEX: LD A,(DE)
RET
JR CMPLC
GETLC: LD A,(DE)
AND 7FH
RET
JR CMPUC
GETUC: LD A,(DE)
AND 7FH
CALL UCASE
RET
; mask high bit before compare
CMPLC: LD B,(HL) ; *buffer
RES 7,B ; Mask high bit
CP B ; Compare
JR Z2C ; Convert Z flag to cy
; simple compare
CMPHEX: CP (HL) ; Simple compare
JR Z2C ; Convert Z flag to cy
; convert both to uppercase before compare
CMPUC: LD B,A ; Save
LD A,(HL) ; *buffer
AND 7FH ; Mask high bit
CALL UCASE ; Make uppercase if lower
CP B ; Compare (finally!)
LD A,B
Z2C: POP BC ; Restore
SCF ; Set carry
RET Z ; If Z flag set
OR A ; Clear carry
RET
; now try to match rest of $ sequentially
MTCHD1: PUSH HL ; Push start adr of match +1
MATCHSEQ:
INC (IX) ; Bump successes
LD A,(STRLEN) ; # to match
CP (IX) ; Matched whole $?
JR Z,FOUNDSTRING ; Yes
INC DE ; $++
CALL GSTRCHAR ; A = *$ (diddled)
CALL DOCMP ; Compare it
; chk for eof
;
CPI ; *buf++,cnt--
JR C,MATCHSEQ ; This ch matched: chk next ch in $
JP PO,FINDFAILS ; Fail if EOF
; 2nd ch or later failed to match: back to 1st ch matched + 1
;
POP HL ; Restore *file to 1st ch matched + 1
LD A,(IX) ; Count of successful matches
BACK2CH1P1:
INC BC ; Adj len remaining to srch
DEC A ; Successes--
JR NZ,BACK2CH1P1
JP MATCH1ST ; Start srch again for 1st ch
; find out what pg match is in
;
FOUNDSTRING:
POP DE ; *1st matching char + 1
DEC DE ; *1st matching char
LD (MATCHADR),DE ; Actual match adr of 1st found ch
LD L,A ; Strlen
LD H,0
ADD HL,DE
LD (RESUMESRCH),HL ; Resume after this match
LD IX,(@PTRTBL) ;
LD A,(CORE) ; Ff if in core
LD B,A ; 0 if file
NEXTPG: INC B ; Pg++
LD L,(IX) ; Lo pg adr
INC IX
LD H,(IX) ; Hi pg adr
INC IX ; To next ptr
XOR A ; Clr cy
SBC HL,DE
JR C,NEXTPG ; Not far enuf
; NC = HL > DE is 1 pg too far
JR Z,NEXTPG ; HL = DE = 1st byte on next pg
; B has page # + 1 so do backpage
;
LD A,0FFH
LD (FOUND),A
RET
;..............................................................................
;
; called fr find for hex digit input
; strip ascii stuff fr possible hex digit in a
; cy set if invalid
;
MKHEXDIGIT: ;
CP '0' ;
RET C ; '0'
CP '9'+1 ; Cy if '0' to '9'
JR NC,CHKATHRUF ;
AND 0FH ; Mask to hex nbl
JR OKHEX ;
;
CHKATHRUF: ;
SET 5,A ; Tolower
CP 'a' ;
RET C ; Invalid
CP 'f'+1 ; Cy if 'a' to 'f'
CCF ;
RET C ; No good
ADD A,0A9H ; Make hex nbl
;
OKHEX: SCF ;
CCF ; Set no cy for ok
RET ;
;...............................;
;==============================================================================
; General purpose (low level) subroutines
;==============================================================================
;------------------------------------------------------------------------------
; Screen management subroutines
;------------------------------------------------------------------------------
;..............................................................................
;
; Half Intensity on
;
ONHALF: CALL BYECHK ; Remote user?
RET NZ ; Yes, forget it and return
PUSH HL ; Save callers HL
LD A,(DIMSEQ) ; Is there a hardcoded sequence?
OR A ;
JR NZ,USEHC1 ; If so, use it no matter what
;................................
;
IF ZCPR3 ; If ZCPR3, check for TCAP
CALL GETVID ;
CALL NZ,STNDOUT ; We have one, use it
ENDIF ; NOT ZCPR3
;...............................;
VDRET1: POP HL ; Restore caller's reg & rtn
RET ;
USEHC1: CALL ESCMSG ; Output the hardcoded sequence below
DIMSEQ: DIMON ; Macro containing the sequence
DB 0 ; Terminating byte
JR VDRET1 ; Restore regs & rtn
;..............................................................................
;
; Half Intensity off
;
OFFHALF:
CALL BYECHK
RET NZ
PUSH HL
LD A,(DMOSEQ)
OR A
JR NZ,USEHC2
;................................
;
IF ZCPR3 ;
CALL GETVID ;
CALL NZ,STNDEND ;
ENDIF ;
;...............................;
VDRET2: POP HL
RET
USEHC2: CALL ESCMSG
DMOSEQ: DIMOFF
DB 0
JR VDRET2
;..............................................................................
;
; Reverse video on
;
ONHILITE:
CALL BYECHK
INC A ; (complement sense of zero status)
RET Z ; Return, indicating 'failure'
PUSH HL
LD A,(REVSEQ)
OR A
JR NZ,USEHC3 ; Go use hardcoded sequence if there is one
; (else process Z3 if appropriate rtn w/ 0)
;................................
;
IF ZCPR3 ;
CALL GETVID ;
JR Z,VDRET3 ; Rtn w/ zero cc, indicating failure
CALL STNDOUT ;
OR 0FFH ; Rtn w/ non-zero cc, indicating success
ENDIF ;
;...............................;
VDRET3: POP HL
RET
USEHC3: CALL ESCMSG
REVSEQ: REVON
DB 0
OR 0FFH ; Return, indicating success
JR VDRET3
;..............................................................................
;
; Reverse video off
;
OFFHILITE:
CALL BYECHK
INC A
RET Z
PUSH HL
LD A,(RVOSEQ)
OR A
JR NZ,USEHC4
;................................
;
IF ZCPR3 ;
CALL GETVID ;
JR Z,VDRET4 ;
CALL STNDEND ;
OR 0FFH ;
ENDIF ;
;...............................;
VDRET4: POP HL
RET
USEHC4: CALL ESCMSG
RVOSEQ: REVOFF
DB 0
OR 0FFH
JR VDRET4
;..............................................................................
;
; Clear the screen
;
CLEARSCREEN:
PUSH HL ; Save callers HL
PUSH BC ; And bc
CALL BYECHK ; Remote user?
JR NZ,USELFS ; Yes, use lf's to clear screen
LD A,(CLRSEQ) ; Is there a hardcoded sequence?
OR A ;
JR NZ,USEHC ; If so, use it no matter what
;................................
;
IF ZCPR3 ; If ZCPR, we have a possible alternative
CALL GETVID ; Check for TCAP
JR Z,USELFS ; If none, resort to using LF's (pretty poor)
CALL CLS ; We have one, use it
JR VDRET ; Clr some flags and return
ENDIF ; ZCPR3
;...............................;
;.....
;
USELFS: CALL CRLF ;
;; LD A,(ROWS) ; Screen height
LD A,24 ;
LD B,A ;
LFLOOP: LD A,LF ; ??
CALL PUTC ;
DJNZ LFLOOP ;
;.....
;
VDRET: XOR A ; Clear some flags and return
LD (COL),A ; Col ctr
LD (LINEBYLINE),A ; Line by line flag
POP BC ;
POP HL ; Restor caller's hl
RET ;
;................................
;
USEHC: CALL ESCMSG ; Output hardcoded clearscreen sequence below
;
CLRSEQ: CLRSCR ; Macro containing clearscreen byte sequence
DB 0 ; End of msg marker
JR VDRET ; Return is same as above
;..............................................................................
;
USEALT: PUSH HL ; Nec?
CALL MSG ; Alternate method to mark 'found' strings
MRKCHR ; Character (or sequence) to use
DB 0 ; Guarantee termination
POP HL ;
RET ;
;------------------------------------------------------------------------------
;
; Memory initialization routines
;................................
;
INI1MEM:LD HL,INIT1 ; Init all memory from "init1" - "end1init"
LD DE,INIT1+1 ;
LD BC,END1INIT-INIT1-1
LD (HL),0 ;
LDIR ;
RET ;
;...............................;
;................................
;
INI2MEM:LD HL,INIT2 ; Init all memory from "init2" - "end2init"
LD DE,INIT2+1 ;
LD BC,END2INIT-INIT2-1
LD (HL),0 ;
LDIR ;
;
LD HL,(@PTRTBL) ; Also clear the whole 1k 'ptrtbl'
LD D,H ;
LD E,L ;
INC DE ;
LD BC,1024-1 ;
LD (HL),0 ;
LDIR ;
RET ;
;...............................;
;------------------------------------------------------------------------------
;
; print a null terminated string at ret adr of this sub
; ctrl chars are ok in ql msgs
;
MSG: LD A,0FFH
LD (FROMQLMSG),A ; Flag this as a ql msg: ctrl chars are ok
;
MSG1: EX (SP),HL ; HL=*string
LD A,(HL) ; Get char
INC HL ; *ch++
EX (SP),HL ; Restore ret adr if done
OR A ; Ch = 0 msg term?
JR Z,MSGDONE ;
CALL PUTC ; Print ch
JR MSG1 ;
;
MSGDONE: ;
LD (FROMQLMSG),A ; Mark false
RET ;
;...............................;
;................................
;
UCASE: CP 'a' ; Upcase the character in A
RET C ; 'a'-1 and below should be left alone
CP 'z'+1 ; 'z'+1 and above should be left alone
RET NC ;
SUB 20H ; Else upcase it
RET ;
;...............................;
;................................
; Downcase the character in A
DCASE: CP 'A' ; 'A'-1 and below should be left alone
RET C ;
CP 'Z'+1 ; 'Z'+1 and above should be left alone
RET NC ;
ADD A,20H ; Else downcase it
RET ;
;...............................;
;................................
;
WHLCHK: ; Check wheel byte status, ret w. NZ of "on"
IF ZCPR3 ;
JP GETWHL ;
ELSE ;
;
LD A,(WHEEL) ;
OR A ;
RET ;
ENDIF ;
;...............................;
;................................
;
BYECHK: LD A,(BYE5FLAG+1) ; Actual existance of bye is chkd at prog init
OR A ; That byte will be non-zero if bye was found
RET Z ; This subr just returns that flag status
LD A,0FFH ; (if not 0, guarantee 0FF in A [useful])
RET ;
;...............................;
;................................
;
SPACE2: CALL SPACE ; Output 2 spaces
SPACE: LD A,' ' ; Output 1 space
CALL PUTC ;
RET ;
;...............................;
;................................
;
CRLF: LD A,CR ; Output a CR/LF sequence
CALL PUTC ;
LD A,LF ;
;
; fall thru to below ;
;................................
;
; 'Hi-level' character output routine, providing associated control functions.
;
; Character to be supplied in A. Regs B thru L are saved and restored
; IX and IY are not for speed
;
PUTC: PUSH BC ; Save registers
PUSH DE
PUSH HL
PUSH AF ; }
CALL BYECHK ; } Process and handle on the fly aborts, etc.
CALL NZ,CKABRT ; } (if running remote only). Only adds a few
POP AF ; } cycles during local operation.
AND 7FH ; Mask to ascii
CP CR
JR NZ,NOTCR
; cr zeroes col ctr
XOR A
LD (COL),A
LD A,CR
JR PUTCH
NOTCR: LD B,A ; Save ch
LD A,(TFLAG) ;
OR A ; Truncation on?
JR Z,NOTTOOLONG ; No, any line len ok
LD A,(COL) ;
CP COLUMNS-2 ; At max line len?
JR C,NOTTOOLONG ; No, line len still ok
JR NZ,BIOSRET ; Already marked '>': skip this char
; at truncation pt: mark with '>'
INC A ; To columns-1
LD (COL),A ; So next ch won't mark trunc again
LD A,TRUNKCHAR ; Truncation marker
JR PUTCH
NOTTOOLONG:
LD A,B ; Get ch back
CP ' '
JR NC,PRINTABLE ; Count all printables
; chk ctrl chs we can handle
CP LF ; Masked lf is ok
JR Z,PUTCH
CP TAB
JR NZ,NOTTAB
; adjust col count assuming tabs 0,8,16...
IF EXPANDTABS ; Expand tabs to equiv spaces
LD A,(COL)
CPL
AND 7 ; Mod 8
INC A
LD B,A ; Spaces to next tab stop
XTAB: CALL SPACE ; Send spaces to tab stop
DJNZ XTAB
JR BIOSRET ; Restore regs & ret
ELSE ; Term can handle actual tab ch
LD A,(COL)
AND 0F8H ; Mask off lo 3 bits
ADD A,8 ; To next tab stop
LD (COL),A ; Set new column
LD A,TAB
JR PUTCH
ENDIF ; Expand tabs
NOTTAB: CP BS
JR NZ,NOTBS
LD HL,COL
DEC (HL) ; Col--
JR PUTCH
; we must handle other ctrl chars specially, UNLESS they're coming from
; a ql message, like clear screen or an escape seq
; this should filter all remaining ws doc chars
;
NOTBS: LD B,A ; Save curr ch
LD A,(FROMQLMSG)
OR A
LD A,B ; Get curr ch back
JR NZ,PUTCH ; Ctrl ch from a ql msg, takes no line space
IF CTRLWORDSTAR
; Display using the combination ^ <char>
;
PUSH BC ; Save a copy of the char, still in B
LD A,'^' ; "control"
CALL CONO ; Output that
LD HL,COL ; Adjust for the "^" character
INC (HL) ; Col++
POP BC ; Get the control char back
LD A,B ; (char was in B)
OR 40H ; Make it the corresponding non-cntrl char
JP NOTCR ; Start this routine all over again
ENDIF ; CTRLWORDSTAR
IF CTRLDIMVID
PUSH BC ; Save the char, still in B
CALL ONHALF ; Dim intensity
POP BC ; Get the char back
LD A,'@' ; Convert to letter
OR B ;
CALL CONO ; Print the char
LD HL,COL ; Adjust for column
INC (HL)
CALL OFFHALF ; Back to full intensity
JR BIOSRET ; And return
ENDIF ; CTRLDIMVID
IF CTRLDUMMY
LD A,CTRLMARKER ; Defined char to use
ENDIF ; CTRLDUMMY
PRINTABLE:
OR A ; Filter out NULL's, and don't incr COL
JR Z,BIOSRET ;
LD HL,COL ;
INC (HL) ; Col++
PUTCH: CALL CONO ; Output the character
BIOSRET:
POP HL ; Restore regs
POP DE
POP BC
RET
;..............................................................................
;
; put a null terminated escape sequence string at ret adr of this sub
; avoid chg col ctr when init/term hiliting
; destroys HL
;
ESCMSG: EX (SP),HL ; HL=*string
LD A,(HL) ; Get char
INC HL ; *ch++
EX (SP),HL ; Restore ret adr if done
OR A ; Ch = \0 msg term?
RET Z ; Done
LD HL,ESCMSG ; Ret adr is start of this rtn
PUSH HL ; On stk
PUSH BC ; Save regs
PUSH DE ; In this order
PUSH HL ; Putch: will restore them
JR PUTCH ; Print char w/o chg to col ctr
; Returns to escmsg:
;................................
; Low-level single char output.
CONO: ; Use BIOS or BDOS, as requested;
IF USEBIOSCONOUT ;
LD C,A ; Goes in C for BIOS
LD HL,(BIOSCONOUT) ;
JP (HL) ; Do it; return directly from there
ELSE ;
LD E,A ; Goes in E for BDOS
LD C,CONOUT ; Console output function
JP BDOSEV ; Output the char and return from there
ENDIF ;
;...............................;
PUTPGNUM:
CALL MSG ; Start page title in lower left corner
DB ': Page ',0
; print current pg number
LD A,(PAGE)
LD L,A
LD H,0
CALL B2DEC ; Convert to printable # & print
CALL MSG
DB ' of ',0
; print max pg number
LD A,(HIPG)
LD L,A
LD H,0
CALL B2DEC
; add marker if read was incomplete
LD A,(INCOMPLETE)
OR A
JR Z,NOPLUS
LD A,'+'
CALL PUTC
NOPLUS: CALL MSG
DB ' Cmnd or ''?'' for Menu: ',0
RET
;..............................................................................
;
; print binary # in HL as decimal, lead 0's suppressed
;
IF DOSPLUS ; Under dos+
B2DEC: LD D,H
LD E,L
LD C,211 ; New BDOS call to print DE as decimal #
JP BDOSCALL ; &ret
ELSE ; The long way under cp/m 2.2
; convert 16 bit binary # in HL to up to 5 ascii decimal digits & print
; suppress leading 0's
; rtn fr Alan Miller, 8080/z80 assembly language
;
B2DEC: LD B,0 ; Leading 0 flag
LD DE,-10000 ; 2's cpl of 10k
CALL SUBP10
LD DE,-1000
CALL SUBP10
LD DE,-100
CALL SUBP10
LD DE,-10
CALL SUBP10
LD A,L
ADD A,'0' ; Ascii bias
JP PUTC ; &ret
; subtract power of 10 & count
SUBP10: LD C,'0'-1 ; Ascii count
SUB1: INC C
ADD HL,DE ; Add neg #
JR C,SUB1
; one subt too many, add 1 back
LD A,D ; Cpl DE
CPL
LD D,A
LD A,E
CPL
LD E,A
INC DE ; Add back
ADD HL,DE
LD A,C ; Get digit
; chk for '0'
CP '1' ; '0'?
JR NC,NONZERO ; No
LD A,B ; Chk leading 0 flag
OR A ; Set?
LD A,C ; Get digit
RET Z ; Skip leading 0
PRDIGIT:
JP PUTC ; Print interior 0
NONZERO:
LD B,0FFH ; Set leading 0 flag
JR PRDIGIT
ENDIF ; Not dosplus
;..............................................................................
;
; hex/ascii display code
; pg 0 is now really pg 0 if core dumping
; display 256 bytes from pg# in a
;
HEXASCII:
LD B,A ; Save pg to show
LD A,(CORE)
OR A
JR NZ,HEXOFCORE ; Core dump 0'th pg ptr is pg 0
DEC B ; 0'th pg ptr is page 1
HEXOFCORE:
LD H,B ;
LD L,0
LD DE,(BUFPTR) ; 1st pg of file dump is here
LD A,(CORE)
OR A ; Displaying memory?
JR Z,DUMPHERE ; No, showing file
LD DE,0 ; 1st pg is beg of mem
DUMPHERE:
ADD HL,DE ; HL pts to pg start adr
LD B,16 ; Show 16 lines
NXTLINEHEXASC:
PUSH BC ; Save ctr
CALL DOHEXASCII
POP BC ; Restore ctr
DJNZ NXTLINEHEXASC
RET
; display 1 line (16 chs) of hex/ascii
; on entry: HL pts into buffer at start of line
; on exit: HL pts into buffer after last byte printed
DOHEXASCII:
LD B,16 ; # of bytes per line
; put the adr of this line
PUSH HL ; Save ptr adr
LD A,(CORE)
OR A ; Displaying core?
JR NZ,SHOWCOREADR ; Yes, show real adr
LD DE,(BUFPTR)
XOR A ; Clr cy
SBC HL,DE
LD DE,100H ; Add 100h bias for cpm tpa
ADD HL,DE
SHOWCOREADR:
LD A,H
PUSH AF
CALL PUTHINIBBLE
POP AF
CALL PUTLONIBBLE
LD A,L
PUSH AF
CALL PUTHINIBBLE
POP AF
CALL PUTLONIBBLE
CALL SPACE2
POP HL ; Get ptr adr back
; chk if marking a found string
HEXLOOP:
LD A,(FOUND)
OR A
JR Z,HEXNOMARK ; Not marking
LD A,(HEXSRCH)
OR A
JR Z,HEXNOMARK ; Showing on ascii side only
CALL ATMATCHADR
JR NZ,HEXNOMARK
CALL ONHILITE
LD A,(HL)
INC HL
PUSH AF ; Save byte to display
CALL PUTHINIBBLE
POP AF
CALL PUTLONIBBLE
CALL OFFHILITE
PUSH BC
PUSH HL
CALL FINDAGAIN ; Find next match
POP HL
POP BC
JR HEXBYTEDONE
HEXNOMARK:
LD A,(HL)
INC HL
PUSH AF ; Save byte to display
CALL PUTHINIBBLE
POP AF
CALL PUTLONIBBLE
HEXBYTEDONE:
CALL SPACE
LD A,B ; Byte ctr
CP 9 ; Half way thru hex display?
CALL Z,SPACE ; If so, add an extra space
DJNZ HEXLOOP
; now do ascii transl of these chs
CALL SPACE
LD DE,-16
ADD HL,DE ; Back ptr up 16
LD B,16
; chk if marking a found ascii string, just like for hex
ASCIILOOP:
LD A,(FOUND)
OR A
JR Z,ASCNOMARK ; Not marking
LD A,(HEXSRCH)
OR A
JR NZ,ASCNOMARK ; Showing on hex side only
CALL ATMATCHADR
JR NZ,ASCNOMARK
CALL ONHILITE
LD A,(HL)
INC HL
CALL PUTCIFASCII
CALL OFFHILITE
PUSH BC
PUSH HL
CALL FINDAGAIN
POP HL
POP BC
JR ASCBYTEDONE
ASCNOMARK:
LD A,(HL)
INC HL
CALL PUTCIFASCII
ASCBYTEDONE:
DJNZ ASCIILOOP
LD (CURRLINE),HL ; Save ptr to curr 'line'
LD A,CR
CALL PUTC
LD A,(LINEBYLINE)
OR A
RET NZ
LD A,LF
JP PUTC ; &ret
PUTHINIBBLE:
SRL A
SRL A
SRL A
SRL A
PUTLONIBBLE:
AND 0FH
ADD A,'0' ; Ascii number bias (0-9)
CP '9'+1
JP C,PUTC
IF UCHEX
ADD A,07H ; If you like caps (A-F)
ELSE
ADD A,27H ; Ascii small letter bias (a-f)
ENDIF
JP PUTC
; print ch if from 20h to 7eh, else '.'
PUTCIFASCII:
CP ' '
JR C,NONASCII
CP 7EH+1
JR C,PUTASCII
NONASCII:
LD A,'.'
PUTASCII:
JP PUTC ; &ret
; set z if at found $ adr
; also set cy if matchadr is later in buffer than HL (matchadr > HL)
ATMATCHADR:
PUSH HL ; Save *buffer
LD DE,(MATCHADR)
XOR A
SBC HL,DE ; Z = at match adr; cy if matchadr > HL
POP HL
RET
;------------------------------------------------------------------------------
; Routine to check for and handle ^S (pause) and ^C, ^K, etc, (abort).
; This routine is called continuously (from PUTC) when running remote.
; Local users can wait till the next screen ends.
;
CKABRT: PUSH AF ; Save all regs
PUSH BC
PUSH DE
PUSH HL
LD C,DIRIO ; Normally, just check console status.
LD E,0FFH ;
CALL BDOSEV
OR A
JR NZ,GOT1 ; (if a character is available)
RETABT: POP HL
POP DE ; Always return from this subr from here
POP BC
POP AF
RET
; Analyze the character received
GOT1: CP 'S'-40H ; ^S pauses
JR Z,WA4CH ; Yes, go to pause loop
GOT1B: AND 1FH ; ^C, ^K, ^X, C, K, X, etc all abort
CP CTRLC
JR Z,ABRT
CP CTRLK
JR Z,ABRT
CP CTRLX
JR NZ,RETABT ; Ignore other keys
ABRT: LD (PUTCABRT),A ; Yes, aborting from PUTC
JP QLEXIT ; Fix stack and exit direct
WA4CH: LD C,DIRIO ; Loop till we get any character
LD E,0FFH
CALL BDOSEV
OR A
JR Z,WA4CH
JR GOT1B ; Continue. Process the char also, but not ^S.
;..............................................................................
;
; Sort all of the 11 byte filename entries in filptr. Sleazy bubble sort.
;
SORT: LD A,(FILCNT) ; #of entries to be sorted
LD C,A ; Init outer loop counter
LD HL,(FILPTR) ;
LD DE,11 ; Init "outer loop" pointer to [filptr]+11
ADD HL,DE ;
EX DE,HL ;
;................................
;
OUTRLP: LD H,D ; Reset inner loop pointer and counter
LD L,E ; Hl <-- DE
LD B,C ; C <-- b
;................................
;
INRLP: PUSH BC ; Save loop counters
CALL COMP ; Compare two entries
CALL NC,SWAP ; Swap if necessary
LD BC,11 ; Incr inner pointer by 11
ADD HL,BC ;
POP BC ; Restore loop counters
DJNZ INRLP ;
;...............................;
LD A,E ; Incr DE by 11
ADD A,11 ;
LD E,A ;
LD A,D ;
ADC A,0 ;
LD D,A ;
;
DEC C ;
JR NZ,OUTRLP ; Loop till done
RET ;
;..............................................................................
;
; Compare the 11 byte entries at (HL) and (DE) [ Used by SORT above]
;
COMP: PUSH DE ;
PUSH HL ;
LD B,11 ; Limit max #of comparisons
COMPLP: LD A,(DE) ;
CP (HL) ;
JR NZ,CMPRTN ; If not equal, rtn with appropriate carry stat
INC HL ;
INC DE ;
DJNZ COMPLP ; Loop up to eleven times
SCF ; Set for equal avoids unecessary equal swaps
CMPRTN: POP HL ;
POP DE ;
RET ;
;..............................................................................
;
; Exchange the 11 byte entries at (HL) and (DE). [ Used by SORT above]
;
SWAP: PUSH DE ;
PUSH HL ;
LD B,11 ; Loop counter
SWAPLP: LD A,(DE) ; Get a corresponding byte from each
LD C,(HL) ;
EX DE,HL ; Exchange the pointers
LD (DE),A ; And re-store the pair of bytes
LD (HL),C ;
INC HL ;
INC DE ;
DJNZ SWAPLP ; Loop; (note- another ex DE,HL not needed)
POP HL ;
POP DE ;
RET ;
;..............................................................................
;
;
; Check if a filename ext is in "badtbl" (routine basicly from LTxx)
;
CHKEXT: LD (DESAVE),DE ; Points to the extension to be checked
LD B,3 ; #of chars in ext
LD HL,BADTBL-3 ; Index bad file type table
TSTTY1: INC HL ; Next table address pointer
DEC B ; Bump loop counter
JR NZ,TSTTY1 ; Do until at next table entry
LD A,(HL) ; Get a byte
OR A ;
RET Z ; End of table, is 'typable', rtn w/ clr carry
LD B,3 ; 3 char extension
LD DE,(DESAVE) ; DE was supplied pointing to ext in question
TSTTY2: LD A,(DE) ; Get a byte from extension
AND 7FH ; Strip any file attribute bits
CP (HL)
JR Z,TSTTY3 ; Match, continue scan
LD A,(HL)
CP '?' ; '?' in table matches all
JR NZ,TSTTY1 ; No match, next entry
TSTTY3: INC HL ; Bump table address pointer
INC DE ; Bump extent pointer
DJNZ TSTTY2 ;
SCF ; Match, file not 'typable', rtn w/ carry set
RET ;
;..............................................................................
;
;
; Table of non-ascii filetypes (displayed in dim video).
; These selections (and the matching routine itself)
; were adapted from CB Falconer's LTxx series programs.
;
BADTBL: DEFB 'ABS' ; Intended to disable
DEFB 'ARC' ; ===================
DEFB 'ARK'
DEFB 'BAD'
DEFB 'CRL'
DEFB 'C?M' ; COM, CQM, CZM, CPM (v20 executes on PCs)
DEFB 'E?E' ; EXE, EQE, EZE (MSDOS executable)
DEFB 'IRL'
DEFB 'I?T' ; INT, IQT, IZT
DEFB 'O??' ; OBJ, OQJ, OZJ, OVL, OVR etc
DEFB 'P?D' ; PCD, PQD, PZD (executable by RUNPCD)
DEFB 'TX#'
DEFB 'RBM'
DEFB 'R?L' ; REL, RQL, RZL
DEFB 'S?R' ; SLR, SQR, SZR (SLR format rel files)
DEFB 'SYS'
DEFB 0,0,0
DEFB 0,0,0 ; Spares, for user configuration
DEFB 0,0,0
DEFB 0 ; Table end marker
;-----------------------------------------------------------------------------
; This is the end of QL proper. The UNC.LIB (uncruncher) code follows, and
; it in turn is followed by the DATA area, both of which are separate files.
; The main file uses INCLUDEs to put these all together. If you wish, you
; may eliminate all INCLUDEs and append everything end to end with your
; editor. You may also make more files and use more INCLUDEs. The current
; breakup is a compromise, and sections have rearranged so related code is
; somewhat more 'together' than in previous versions, but the program could
; probably use further improvement in this area.
;-----------------------------------------------------------------------------