home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
BEEHIVE
/
UTILITYS
/
GPATCH.ARC
/
GNEW.Z80
< prev
next >
Wrap
Text File
|
1990-07-21
|
22KB
|
1,109 lines
;Replacement routines for GBASIC to work on the Starcard. K.C.M. Lau Jan 87.
;Assem with ZASM (Cromemco). Overlay HEX file with offset 5500h from DDT.
;Also overlay GVEC.HEX
org 1000h
newlen equ 0800h ;maximum space allocated to these routines
;should match newlen in GVEC
error equ 34D0h
evalbyt equ 4097h
hevalxy equ 4B20h
printa equ 6613h
;Interpretor vectors
newst jp ihgr ;+00h hires
jp ihcolr ;+03h set hcolor
jp ihplot ;+06h hplot dots and lines
jp fhcolr ;+09h function hcolor
jp fhscrn ;+0Ch function hscrn
jp itext ;+0Fh shows text page
jp igr ;+12h lores
jp icolor ;+15h set color
jp iplot ;+18h plot dot
jp fcolor ;+1Bh function color
jp fscrn ;+1Eh function status of point
jp ihlin ;+21h plot horiz line
jp ivlin ;+24h plot vert line
jp fpdl ;+27h function pdl (n)
jp fbutton ;+2Ah function button (n)
jp ibeep ;+2Dh beep pitch,duration
jp icall ;+30h call% ()
jp edit ;+33h edit n
;-------- PEEKPOKE --------
;Starcard/Apple interface. Jan 86. K.C.M. Lau.
;Main routines : AINP, AOUT, AOUTHL, APEEK, APOKE, APOKEBL, ACALLFN, ACALL
PREG DB 0
AREG DB 0
XREG DB 0
YREG DB 0
;Input byte from Apple/Starcard port --> [A]
AINP IN A,(40h)
RLCA
JR NC,AINP
IN A,(20h)
RET
;Output [A] --> Apple/Starcard port
AOUT PUSH AF
AOUT1 IN A,(40h)
RRCA
JR C,AOUT1
POP AF
OUT (0),A
RET
;Output HL --> Apple/Starcard port
AOUTHL PUSH AF
LD A,L
CALL AOUT
LD A,H
CALL AOUT
POP AF
RET
;Returns contents of 6502 location HL --> A
APEEK LD A,6
CALL AOUT
CALL AOUTHL
JR AINP
;Write A --> 6502 location HL.
APOKE PUSH AF
LD A,7
CALL AOUT
CALL AOUTHL
POP AF
JR AOUT
;{ Peek a double byte }
;function peekword (a : integer) : integer;
; begin
; peekword := peek (a) or (peek (a + 1) shl 8)
; end;
;{ Poke a double byte }
;procedure pokeword (a : integer; w : integer);
; begin
; poke (a, lo (w)); poke (a + 1, hi (w))
; end;
;Transfer a block to 6502 memory. HL=src. DE=dest. BC=len.
APOKEBL LD A,2 ;Command code
CALL AOUT
LD A,E ;Dest start
CALL AOUT
LD A,D
CALL AOUT
LD A,C ;Length
CALL AOUT
LD A,B
CALL AOUT
POKEBL1 LD A,(HL)
CALL AOUT
INC HL
DEC BC
LD A,B
OR C
JR NZ,POKEBL1
RET
;ACALLFN:Call 6502 subroutine at HL.
;Pass values in areg, xreg, etc. (to and from)
CALFST EQU 8C00h
CALFFT DB 1
CALFCD DB 8,32,9,176,141,32,140,32,9,176,141,33,140,32,9,176,72,32,9,176
DB 72,32,9,176,168,32,9,176,170,104,40,32,255,255,8,142,62,140,140,63
DB 140,32,12,176,104,32,12,176,173,62,140,32,12,176,173,63,140,32,12,176
DB 40,96,0,0
CALFCDE EQU $
POKECLF PUSH HL
LD HL,CALFCD
LD DE,CALFST
LD BC,CALFCDE-CALFCD
CALL APOKEBL
LD A,0
LD (CALFFT),A
POP HL
RET
ACALLFN LD A,(CALFFT) ;If first time then pokecall
OR A
CALL NZ,POKECLF
LD A,3 ;Activate receiving routine
CALL AOUT
LD A,CALFST % 100h
CALL AOUT
LD A,CALFST / 100h
CALL AOUT
CALL AOUTHL ;Call addr
LD A,(PREG) ;Pass regs to routine
CALL AOUT
LD A,(AREG)
CALL AOUT
LD A,(YREG)
CALL AOUT
LD A,(XREG)
CALL AOUT
CALL AINP ;Receive results in regs
LD (AREG),A
CALL AINP
LD (PREG),A
CALL AINP
LD (XREG),A
CALL AINP
LD (YREG),A
RET
;ACALL:Call 6502 subroutine. Pass values in areg, xreg, etc. (to only)
CALLST EQU 8C80h
CALLFT DB 1
CALLCD DB 8,32,9,176,141,160,140,32,9,176,141,161,140,32,9,176,72,32,9,176
DB 72,32,9,176,168,32,9,176,170,104,40,32,255,255,40,96
CALLCDE EQU $
POKECL PUSH HL
LD HL,CALLCD
LD DE,CALLST
LD BC,CALLCDE-CALLCD
CALL APOKEBL
LD A,0
LD (CALLFT),A
POP HL
RET
ACALL LD A,(CALLFT) ;If first time then pokecall
OR A
CALL NZ,POKECL
LD A,3 ;Activate receiving routine
CALL AOUT
LD A,CALLST % 100h
CALL AOUT
LD A,CALLST / 100h
CALL AOUT
CALL AOUTHL ;Call addr
LD A,(PREG) ;Pass regs to routine
CALL AOUT
LD A,(AREG)
CALL AOUT
LD A,(YREG)
CALL AOUT
LD A,(XREG)
JP AOUT
;-------- HIRES --------
;Hires graphics module for STARCARD. Jan 87. K.C.M. Lau
;Use with PEEKPOKE
;Main routines : HGR, TEXT, HCOLOR, HPLOT, HPLOTTO, HLINE
;Prepare for mixed screen page 1 hires graphics
HGR LD A,60h ;Disconnect Applesoft
LD HL,00B7h
CALL APOKE
LD HL,0C05Fh ;Double res off
CALL APEEK
LD HL,0F3E2h
JP ACALL
;Exit hires graphics mode
TEXT LD HL,0C054h
CALL APEEK
LD HL,0C051h
CALL APEEK
LD HL,0C056h
CALL APEEK
LD HL,0C00Dh ;80 columns
CALL APOKE
LD HL,0C001h ;80 store on
CALL APOKE
LD A,0CFh ;Turn on dev video
CALL AOUT
LD A,2
CALL AOUT
JP AINP
;Set hires color to [A] (0..7)
HCOLOR LD (XREG),A
LD HL,0F6F0h
JP ACALL
;Plot single point. HL=x. DE=y.
HPLOT LD A,E
LD (AREG),A
LD A,L
LD (XREG),A
LD A,H
LD (YREG),A
LD HL,0F457h
JP ACALL
;Plot line from last point to HL,DE
HPLOTTO LD A,L
LD (AREG),A
LD A,H
LD (XREG),A
LD A,E
LD (YREG),A
LD HL,0F53Ah
JP ACALL
;Plot line from HL,DE to IX,IY
HLINE CALL HPLOT
PUSH IX
POP HL
PUSH IY
POP HL
JP HPLOTTO
;-------- NEW CODE --------
;Vars
ihcolrt db 0 ;0..13 hcolor temp
gflag db 0 ;0=text or hires, NZ=lores
beepft db 0FFh ;nz=first time
chkft db 0FFh ;nz=first time
;Prints string at after CALL until 0. All regs preserved
prmsg ex (sp),hl ;hl --> stack
push af ;af --> stack
prmsg1 ld a,(hl) ;fetch next char
inc hl
or a ;check for end of string marker
jr z,prmsg2
call printa ;print char
jr prmsg1
prmsg2 pop af ;stack --> af
ex (sp),hl ;stack --> hl
ret
;Check if FREEHGR.DVR is installed. If not error routine. All regs preserved.
chkdvr push af
ld a,(chkft) ;skip if check OK before
or a
jr z,chkdvr2
push bc ;save regs
push de
push hl
ld hl,0010h ;peek (10/11), NEXTFREE --> HL
call apeek
ld c,a
inc hl
call apeek
ld h,a
ld l,c
ld de,6000h ;cmp NEXTFREE - 6000h
and a
sbc hl,de
jr c,chkerr ;if NEXTFREE < 6000h then not installed err
ld hl,6017h ;check for correct driver name
ld de,dvrname
ld b,4
chkdvr1 call apeek
ex de,hl
cp (hl)
jr nz,chkerr
ex de,hl
inc hl
inc de
djnz chkdvr1
xor a ;clear first time flag
ld (chkft),a
pop hl ;restore regs
pop de
pop bc
chkdvr2 pop af
ret
chkerr call prmsg
db 'Starcard driver FREEHGR.DVR not installed on boot disk,'
db 0
pop hl ;dispose regs
pop de
pop bc
pop af
pop af ;dispose return addr
jp error ;error
dvrname db 'FREE' ;correct driver name (leftstr only)
;Interprets HGR <screen no>,<color no>
ihgr call chkdvr ;check for driver installed
ld a,0 ;default screen 0
call nz,evalbyt ;eval screen no --> A
cp 4
jp nc,error ;error if screen no >= 4
push af
ld a,(hl) ;check for comma
cp ','
ld a,0 ;default color
jr nz,ihgr1 ;branch if no color specfied
inc hl ;skip comma
call evalbyt ;eval color no
ihgr1 call ihcolr1 ;set color
pop af
push hl
push af
ld hl,0C053h ;flick mixed/full
rra
jr nc,ihgr2
dec l
ihgr2 call apeek
ld hl,0C057h ;flick hires
call apeek
ld hl,0C050h ;flick graphics
call apeek
ld hl,0C05Fh ;flick dbl hires off
call apeek
ld hl,00B7h ;disconnect Applesoft
ld a,60h
call apoke
ld hl,00E6h ;set hpag
ld a,20h
call apoke
pop af
and 2 ;fill screen for 2 and 3
call z,gclr
pop hl
ret
;Clear screen to current color. Resets internal cursor to 0,0
gclr ld hl,0 ;plot point (0,0)
ld de,0
call hplot
ld hl,0F3F6h ;fill background
jp acall
;Interprets HCOLOR n
ihcolr call 6925h ;skip '='
db 0F0h
call evalbyt ;eval color
ihcolr1 cp 13 ;error if color >= 13
jp nc,error
ld (ihcolrt),a ;save color
push hl
cp 8 ;color < 8 preserved. Translate the rest
jr c,ihcolr2
sub 8
ld b,a
ld a,0 ;8 --> 0
jr z,ihcolr2
ld a,3 ;9 --> 3
dec b
jr z,ihcolr2
ld a,4 ;10 --> 4
dec b
jr z,ihcolr2
ld a,7 ;11 --> 7
dec b
jr z,ihcolr2
ld a,3 ;12 --> 3
ihcolr2 call hcolor ;set color 0..7
pop hl
ret
;Interprets HPLOT, HPLOTTO
ihplot cp 0DDh ;TO token
jr z,ihploto
call hevalxy ;eval x,y --> DE,C
push hl
ex de,hl
ld e,c
call hplot ;plot point
pop hl
call 33CAh ;fetch next char
ret z ;exit if end of statement
ihploto call 33C9h ;skip TO
call hevalxy ;eval x,y --> DE,C
push hl
ex de,hl
ld e,c
call hplotto ;plot line
pop hl
ld a,(hl) ;loop back if TO continuation
cp 0DDh
jr z,ihploto
ret
;Interprets function HCOLOR
fhcolr call 33C9h ;skip token and spaces
ld a,(ihcolrt)
push hl
call 3E32h ;store result
pop hl
ret
;Interprets HSCRN (x,y)
fhscrn call 33C9h ;skip token and spaces
call 6925h ;skip open bracket
db '('
call hevalxy ;x,y --> DE,C
call 6925h ;skip close bracket
db ')'
push hl
ld a,c ;HPOSN (x,y)
ld (areg),a
ld a,e
ld (xreg),a
ld a,d
ld (yreg),a
ld hl,0F411h
call acall
ld hl,0026h ;GBASE --> DE
call apeek
ld e,a
inc hl
call apeek
ld d,a
ld hl,00E5h ;column --> HL
call apeek
ld l,a
ld h,0
add hl,de ;screen addr --> HL
call apeek ;screen contents --> B
ld b,a
ld hl,0030h ;bit mask --> A
call apeek
and a,b ;select bit
add a,a ;remove color bit
jr z,fhscrn1 ;make NZ = 0FFh
ld a,0FFh
fhscrn1 call 46E7h ;store result
pop hl
ret
;Interprets TEXT
itext push hl
ld a,(083Ch) ;set gotoxy coords
dec a
ld h,a
ld l,0
ld (0B11h),hl
call text ;flick to text page
ld a,(gflag)
or a
jr z,itext1 ;skip next instr if not lores
call 45A8h ;clear screen (HOME)
itext1 xor a ;reset gflag to indicate text
ld (gflag),a
call 4554h ;gotoxy
pop hl
ret
;Intepret GR <screen no>, <color>
igr ld a,0 ;default screen no = 0
call nz,evalbyt ;eval screen no if present
cp 2
jp nc,error ;error if screen no >= 2
push hl
push af
ld a,20 ;set top of window to line 20
ld hl,0022h
call apoke
ld hl,1700h ;gotoxy (0,23)
ld (0B11h),hl
call 4554h
ld hl,0C056h ;flick LORES on
call apeek
ld hl,0C050h ;flick GRAPHICS on
call apeek
ld hl,0C053h
pop af ;screen no --> A
rra ;calc no. of lines to clear --> stack
ld d,40
jr nc,igr1
dec l
ld d,48
igr1 call apeek ;flick page 1/2
pop hl
ld a,(hl) ;fetch next char
cp ','
push de
ld e,0 ;assume color = 0
jr nz,igr2 ;branch if no color specified
inc hl ;skip comma
call evalbyt
igr2 call icolor1 ;copy to hi nibble and store in ZP color
pop bc ;no. of lines to clear --> D
push hl
ld a,39 ;right most column to clear for HLIN
ld hl,002Ch
call apoke
igr3 xor a
ld (yreg),a ;leftmost y=0 --> YREG
ld a,b
dec a
ld (areg),a ;line to clear --> AREG
ld hl,0F819h ;call HLIN rom routine
push bc
call acall
pop bc
djnz igr3 ;repeat for line count
ld a,0FFh ;indicate GR on
ld (gflag),a
pop hl
ret
;Interpret COLOR = 0..15
icolor call 6925h ;skip '='
db 0F0h
call evalbyt ;eval color --> A
icolor1 ld a,e
cp 16
jp nc,error ;error if color >= 16
add a,a ;copy to hi nibble also
add a,a
add a,a
add a,a
or e
push hl
ld hl,0030h ;store in color ZP location
call apoke
pop hl
ret
;Eval lores x,y --> YREG,AREG
prepxy call 46A6h ;eval x,y --> E,A
cp 48 ;check for y in range
jp nc,error
ld (areg),a ;y --> AREG
ld a,e
cp 40 ;check for x in range
jp nc,error
ld (yreg),a
ret
;Interpret PLOT x,y
iplot call prepxy ;eval x,y --> YREG, AREG
push hl
ld hl,0F800h ;call PLOT rom routine
call acall
pop hl
ret
;Function COLOR
fcolor call 33C9h ;skip spaces
push hl
ld hl,0030h ;peek COLOR zp loc
call apeek
pop hl
jp 46F0h ;store result and return
;Function SCRN
fscrn call 33C9h ;skip spaces
call 6925h ;skip opening bracket
db '('
call prepxy ;eval x,y --> YREG, AREG
call 6925h ;skip closing bracket
db ')'
push hl
ld hl,0F871h ;call SCRN rom routine
call acallfn
ld a,(areg) ;color of point --> A
jp 46F1h ;store result, pop hl, return
;Evaluate: x1,x2 AT y --> D,E,A. If x1>x2 then swap x1,x2.
;Entry: C=xmax+1, B=ymax+1. Replaces routine at 4657h
evalxxy push bc
call 46A6h ;eval x1,x2 --> E,A
pop bc
cp e ;if x1>x2 then swap x1,x2
call c,swapae
cp b ;check for x in range
jp nc,error
ld d,a
push de
push bc
call 6925h ;skip AT
db 'A'
call 6925h
db 'T'
call evalbyt ;eval y --> A
pop bc
cp c ;check for y in range
jp nc,error
pop de
ret
;Swap regs A <--> E
swapae ld (swapaet),de
ld e,a
ld a,(swapaet)
ret
swapaet dw 0FFFFh ;temp
;Interpret HLIN x1,x2 AT y
ihlin ld bc,2830h ;limits of x,y = 40,48
call evalxxy ;eval x1,x2 at y --> D,E,A
ld (areg),A ;y --> AREG
ld a,e
ld (yreg),a ;x1 --> YREG
ld a,d
push hl
ld hl,002Ch ;x2 --> (002Ch)
call apoke
ld hl,0F819h ;call HLIN rom routine
call acall
pop hl
ret
;Interpret VLIN y1, y2 AT x
ivlin ld bc,3028h ;limits of y,x = 48,40
call evalxxy ;eval y1,y2 at x --> D,E,A
ld (yreg),a ;x --> YREG
ld a,e
ld (areg),a ;y1 --> AREG
ld a,d
push hl
ld hl,002Dh ;y2 --> (002Dh)
call apoke
ld hl,0F828h ;call VLIN rom routine
call acall
pop hl
ret
;Function PDL (0..3)
fpdl call 409Ah ;eval paddle no --> DE
ld a,e
cp 4 ;check in range
jp nc,error
ld (xreg),a ;paddle no --> XREG
push hl
ld hl,0FB1Eh ;call PREAD rom routine
call acallfn
pop hl
ld a,(YREG) ;paddle reading --> A
jp 3E32h ;store result and return
;Function BUTTON (0..2)
fbutton call 409Ah ;eval paddle no --> DE
ld a,e
cp 3 ;check in range
jp nc,error
ld a,d
or a
jp nz,error
push hl
ld hl,0C061h ;base addr of button softswitches
add hl,de ;add button no
call apeek
pop hl
rla ;if bit 7 = 0 then HL = 0 else HL = 0FFFFh
sbc a,a
ld l,a
ld h,a
jp 4FD7h ;store fn result and return
;Interprets BEEP <pitch>,<duration>
ibeep call 46A6h ;eval pitch,duration --> E,A
inc a
ld (areg),a ;duration + 1 --> AREG
ld a,e
inc a
ld (xreg),a ;pitch + 1 --> XREG
push hl
ld a,(beepft) ;if first time poke 6502 routine to Apple ram
or a
call nz,pkbeep
ld hl,beepst ;call 6502 routine
call acall
pop hl
ret
pkbeep ld hl,beep65 ;poke 6502 beep routine --> Apple ram
ld de,beepst
ld bc,beeplen
call apokebl
xor a ;first time = false
ld (beepft),a
ret
beepst equ 08B00h ;6502 addr of beep65 routine
beep65 db 085h,045h ;STA $45
db 086h,046h ;STX $46
db 0A0h,000h ;LDY #0
beep65a db 0ADh,030h,0C0h ;LDA $C030
beep65b db 088h ;DEY
db 0D0h,004h ;BNE beep65c
db 0C6h,045h ;DEC $45
db 0F0h,00Ch ;BNE beep65q
beep65c db 020h,057h,0FFh ;JSR $FF57
db 0CAh ;DEX
db 0D0h,0F3h ;BNE beep65b
db 0A6h,046h ;LDX $46
db 0D0h,0ECh ;BNE beep65a
db 0F0h,0EAh ;BEQ beep65a
beep65q db 060h ;RTS
beeplen equ $-beep65
;Patch for CALL% var (parm1, parm2, parm3)
icall call prmsg
db 'CALL% not implemented on Starcard version,',0
jp error
;Replacement line editor
;Entry: HL=buf start, B=buf index, C=buf index of terminating 0
prchar equ 6704h ;print a, no regs affected
edit ld a,0 ;display rest of line from HL, ie. whole line
call showrst
edit1 call 675Ch ;wait for key --> A (BIOS CONIN)
call editbr ;branch to subr
jr edit1 ;keep looping
editbr cp 7Fh ;del (delete char to right)
jp z,dellt
cp ' ' ;non-ctrl chars (insert chars)
jp nc,ins
cp 'S'-40h ;ctrl-S (cursor left 1)
jp z,curslt
cp 8 ;left arrow (alt)
jp z,curslt
cp 'D'-40h ;ctrl-D (cursor right 1)
jp z,cursrt
cp 15h ;right arrow (alt)
jp z,cursrt
cp 'A'-40h ;ctrl-A (cursor word left)
jp z,wordlt
cp 'F'-40h ;ctrl-F (cursor word right)
jp z,wordrt
cp 09h ;tab (alt)
jp z,wordrt
cp 'R'-40h ;ctrl-R (move to start of line)
jp z,cursst
cp 0Bh ;up arrow (alt)
jp z,cursst
cp 'B'-40h ;ctrl-B (alt)
jp z,cursst
cp 'C'-40h ;ctrl-C (move to end of line)
jp z,cursend
cp 0Ah ;down arrow (alt)
jp z,cursend
cp 'N'-40h ;ctrl-N (alt)
jp z,cursend
cp 'P'-40h ;ctrl-P (insert ctrl char)
jp z,insctrl
cp 'G'-40h ;ctrl-G (delete char under cursor)
jp z,delrt
cp 'T'-40h ;ctrl-T (delete word right)
jp z,delword
cp 'Y'-40h ;ctrl-Y (delete rest of line)
jp z,delrst
cp 'Q'-40h ;ctrl-Q (leave line unchanged)
jp z,abort
cp 0Dh ;cr (accept line)
jp z,editcr
ret ;ignore other control chars
;Print screen code from screen table
;Entry A=fn#. Exit=af corrupted
prscrn push hl
push de
ld e,a
call 4575h
pop de
pop hl
ret
;Print any char in A. Ctrl chars inversed
prany cp ' '
jp nc,prchar ;not fall thru for ctrl chars
;Print ctrl-char in A inversed;
prctrl push af
ld a,5 ;inverse
call prscrn
pop af
push af
add a,'A'-1 ;print ctrl chars in inverse
call prchar
ld a,4 ;normal
call prscrn
pop af
ret
;Reshow rest of line from hl inclusive. Leave cursor where it was.
;Entry: hl points to first char, a = no of trailing blanks
;Exit : af corrupted
showrst push hl
push bc
push af ;no of trailing spaces --> spaces
ld b,1 ;cursor count + 1
ld a,(hl)
or a
jp z,showrs3
ld c,' ' ;asc space constant kept in reg for speed
showrs1 inc hl ;print rest of line until 0
inc b
cp c ;space in c
call c,prctrl ;if ctrl char then print it in inverse
call nc,prchar
ld a,(hl)
or a
jp nz,showrs1
showrs3 pop af ;print trailing spaces (a org has been saved on stack)
or a
jp z,showrs5
ld c,a
ld a,' '
showrs4 call prchar
inc b
dec c
jp nz,showrs4
showrs5 ld a,8 ;move cursor back to before
dec b
jr z,showrs7
showrs6 call prchar
djnz showrs6
showrs7 pop bc
pop hl
ret
;Move cursor left. Exit: flag Z set if at start of line
curslt inc b
dec b
ret z ;ignore if at start of line
ld a,8 ;move cursor left
call prchar
dec hl
dec b ;dec buf index
ret
;Move cursor right
cursrt ld a,(hl)
or a
ret z ;ignore if at end of line
call prany ;move cursor by reprinting char
inc hl ;inc buf ptr
inc b ;inc buf index
ret
;Check A is letter or number. Exit: Z set if so. Other regs preserved
cmpalp call cmplet
ret z ;note fall thru to cmpnum if not letter
;Check A is a number. Exit: Z set if so. Other regs preserved
cmpnum cp '0'
ret c
cp '9'+1
jr c,cmplet1 ;branch if 0..9 to set Z flag and ret
or a ;set NZ
ret
;Check A is a letter. Exit: Z set if so. Other regs preserved
cmplet cp 'A'
ret c
cp 'Z'+1
jr c,cmplet1 ;branch if A..Z
cp 'a'
ret c
cp 'z'+1
jr c,cmplet1 ;branch if a..z
or a ;set NZ
ret
cmplet1 cp a ;set Z
ret
;Move cursor left to start of left word
wordlt call curslt ;move cursor to non-letter|letter boundary
ret z
ld a,(hl)
call cmpalp
jr nz,wordlt
dec hl
ld a,(hl)
inc hl
call cmpalp
jr z,wordlt
ret
;Move cursor right to start of next word
wordrt call cursrt ;move cursor to non-letter|letter boundary
ld a,(hl)
or a
ret z
call cmpalp
jr nz,wordrt
dec hl
ld a,(hl)
inc hl
call cmpalp
jr z,wordrt
ret
;Move cursor to end of line
cursend call cursrt
ld a,(hl)
or a
jp nz,cursend
ret
;Move cursor to start of line
cursst call curslt
jp nz,cursst
ret
;Insert char in A
ins push af ;save char to be inserted
ld a,c
cp 255
jr c,ins1 ;branch if line len < 255 chars (ok)
ld a,7 ;bell
call prchar
pop af
ret
ins1 sub b ;chars left to right --> B
inc c ;inc buf len
inc b ;inc buf index
push bc
ex de,hl ;calculate various blk move pointers --> BC,HL,DE
ld l,a
ld h,0
add hl,de
ld b,h
ld c,l
inc hl
call 6814h ;block move 1 char right
pop bc
pop af ;char to be inserted --> A
ld (hl),a ;store it
ld a,0
call showrst ;reprint rest of line
ld a,(hl) ;advance cursor
call prany
inc hl ;bump buf ptr
ret
;Insert ctrl char
insctrl call 675Ch
cp 0Ah
jp z,ins
cp 07h
jp z,ins
cp 09h
jp z,ins
ret
;Delete char to left of cursor
dellt ld a,b
or a
ret z ;ignore it at first char of line
call curslt ;move cursor left
;Delete char under cursor
delrt ld a,(hl)
or a
ret z ;ignore if at end of line
call 63EAh ;blk move 1 char left
ld a,1
call showrst ;reprint line
ret
;If char in A is a letter then let A = 'A'
;else if char in A is a number then let A = '0'
normalp call cmplet
jr z,normal1 ;branch if 'A'..'Z'
call cmpnum
ret nz ;exit if not letter nor number
ld a,'9'
ret
normal1 ld a,'A'
ret
;Delete word to right
delword push hl
push bc
ld d,h ;buf ptr --> de (dest of blk move)
ld e,l
ld a,(hl) ;fetch first char
or a
jr z,delw2
call normalp ; make all letters become 'A' and number become '0'
ld b,a
delw1 inc hl ;scan for boundaries (ie changes)
ex (sp),hl ; inc buf ptr (src of blk move)
dec l ; dec buf len
ex (sp),hl
ld a,(hl)
call normalp
cp b ; compare this char with first char
jr z,delw1 ; repeat until this char <> first char
pop bc ;buf len - buf index + 1 --> bc (byte count)
push bc
ld a,c
sub b
inc a
ld c,a
ld b,0
push hl ;bytes to blank --> a
and a
sbc hl,de
ld a,l
pop hl
ldir ;block move chars to left
delw2 pop bc
pop hl
jp showrst ;display rest of line with tailing blanks
;Delete rest of line
delrst ld a,c ;no of chars to blank from screen --> A
sub b
ld (hl),0 ;store terminator
ret z ;if at end of line already then exit
ld c,b ;buf index --> buf len
jp showrst ;print A spaces (blank rest of line)
;Abort edit (leave line unchanged)
abort call cursend ;print rest of line
ld a,'\' ;print reverse slash
call prchar
jp 644Dh ;old 'Q' routine
;Finish editing
editcr call cursend
editcr1 ld a,b
or a
jr z,editcr2
dec hl
ld a,(hl)
inc hl
cp ' '
jr nz,editcr2
call dellt
jr editcr1
editcr2 jp 643Bh
;Check that routines fit space allocated
if ($-newst) > newlen
conmsg WARNING:Code exceeds space allocated; adjust newlen.
end
at routines fit space allocated
if ($-newst) > newlen
conmsg WARNING:Code exceeds s