1
0
mirror of https://github.com/dschmenk/PLASMA.git synced 2025-08-05 04:25:43 +00:00
Files
PLASMA/src/toolsrc/ed.pla
2018-01-13 11:53:21 -08:00

1093 lines
26 KiB
Plaintext
Executable File

//=====================================
//
// Text Editor
//
//=====================================
include "inc/cmdsys.plh"
include "inc/args.plh"
include "inc/fileio.plh"
//
// Hardware constants
//
const csw = $0036
const pushbttn1 = $C061
const pushbttn2 = $C062
const pushbttn3 = $C063
const keyboard = $C000
const keystrobe = $C010
const cmdline = $01FF
//
// ASCII key values
//
const keyenter = $8D
const keyspace = $A0
const keyarrowup = $8B
const keyarrowdown = $8A
const keyarrowleft = $88
const keyarrowright = $95
const keyescape = $9B
const keyctrla = $81
const keyctrlb = $82
const keyctrlc = $83
const keyctrld = $84
const keyctrle = $85
const keyctrlf = $86
const keyctrli = $89
const keyctrlk = $8B
const keyctrll = $8C
const keyctrln = $8E
const keyctrlo = $8F
const keyctrlp = $90
const keyctrlq = $91
const keyctrlr = $92
const keyctrls = $93
const keyctrlt = $94
const keyctrlu = $95
const keyctrlv = $96
const keyctrlw = $97
const keyctrlx = $98
const keyctrlz = $9A
const keydelete = $FF
//
// Data and text buffer constants
//
const MAXLINES = 1500
const MAXLINESSIZE = MAXLINES+24
const MAXLNLEN = 79
const MAXSTRPLSIZE = $8000
//const STRPLMAPSIZE = 224 // $E0 = 28K is memory@16 bytes per bit map, 128 bytes per 8 bit map, 1K bytes per 8 byte map
const pgjmp = 16
const changed = 1
const insmode = 2
const showcurs = 4
const uppercase = 8
const shiftlock = 128
//
// Text screen row address array
//
word txtscrn = $0400,$0480,$0500,$0580,$0600,$0680,$0700,$0780
word = $0428,$04A8,$0528,$05A8,$0628,$06A8,$0728,$07A8
word = $0450,$04D0,$0550,$05D0,$0650,$06D0,$0750,$07D0
//
// Editor variables
//
byte nullstr = ""
byte[64] filename = "UNTITLED"
byte exit = FALSE
byte flags = 0
byte flash = 0
word numlines = 0
word cutbuf = 0
word arg
word strplsize = MAXSTRPLSIZE
word strpool, strplmapsize, strlinbuf, strpoolmap
byte cursx, cursy, scrnleft, curscol, underchr, curschr
word keyin, cursrow, scrntop, cursptr
//
// Predeclared functions
//
predef cmdmode#0
//
// Utility functions
//
// Defines for ASM routines
//
asm equates
!SOURCE "vmsrc/plvmzp.inc"
end
asm sethibit(strptr)#0
LDA ESTKL,X
STA SRCL
LDA ESTKH,X
STA SRCH
INX
LDY #$00
LDA (SRC),Y
BEQ +
TAY
STHILP LDA (SRC),Y
ORA #$80
STA (SRC),Y
DEY
BNE STHILP
+ RTS
end
asm cpyln(srcstr, dststr)#0
LDA ESTKL,X
STA DSTL
LDA ESTKH,X
STA DSTH
INX
LDA ESTKL,X
STA SRCL
LDA ESTKH,X
STA SRCH
INX
LDY #$00
LDA (SRC),Y
TAY
LDA #$00
INY
STA (DST),Y
DEY
BEQ ++
CPLNLP LDA (SRC),Y
CMP #$20
BCS +
ADC #$60
+ AND #$7F
STA (DST),Y
DEY
BNE CPLNLP
LDA (SRC),Y
++ STA (DST),Y
RTS
end
def bell#0
putc($07)
end
//
// Memory management routines
//
def sizemask(size)
if size <= 16
return $01
elsif size <= 32
return $03
elsif size <= 48
return $07
elsif size <= 64
return $0F
elsif size <= 80
return $1F
fin
return 0
end
def strpoolalloc(size)
byte szmask, i
word mapmask, addr
szmask = sizemask(size)
for i = strplmapsize - 1 downto 0
if ^(strpoolmap + i) <> $FF
mapmask = szmask
repeat
if ^(strpoolmap + i) & mapmask
mapmask = mapmask << 1
else
^(strpoolmap + i) = ^(strpoolmap + i) | mapmask
addr = (i << 7) + strpool
while !(mapmask & 1)
addr = addr + 16
mapmask = mapmask >> 1
loop
return addr
fin
until mapmask & $100
fin
next
bell()
puts("OUT OF MEMORY!")
return 0
end
def strstripcpy(dststr, srcstr)#0
byte strlen
strlen = ^srcstr
while ^(srcstr + strlen) == $8D or ^(srcstr + strlen) == $A0
strlen--
loop
^dststr = strlen
memcpy(dststr + 1, srcstr + 1, strlen)
end
def delstr(strptr)#0
byte mask, ofst
if strptr and strptr <> @nullstr
mask = sizemask(^strptr + 1)
ofst = (strptr - strpool) >> 4
mask = mask << (ofst & $07)
ofst = ofst >> 3
^(strpoolmap + ofst) = ^(strpoolmap + ofst) & ~mask
fin
end
def newstr(strptr)
byte strlen
word newptr
strlen = ^strptr
while ^(strptr + strlen) == $8D or ^(strptr + strlen) == $A0
strlen--
loop
if strlen == 0
return @nullstr
fin
newptr = strpoolalloc(strlen + 1)
if newptr
memcpy(newptr, strptr, strlen + 1)
^newptr = strlen
return newptr
fin
return @nullstr
end
def inittxtbuf#0
word i
if not strpool
strlinbuf = heapalloc(MAXLINESSIZE*2)
while isult(heapavail, strplsize)
strplsize = strplsize - 4096
loop
if isult(heapavail - strplsize, 4096) // Keep at least 4096 free
strplsize = strplsize - 4096
fin
strplmapsize = strplsize / 128
strpoolmap = heapalloc(strplmapsize)
strpool = heapalloc(strplsize)
fin
memset(strlinbuf, @nullstr, MAXLINESSIZE*2)
memset(strpoolmap, 0, strplmapsize)
numlines = 1
cursrow = 0
curscol = 0
cursx = 0
cursy = 0
scrnleft = 0
scrntop = 0
cutbuf = 0
end
//
// Case conversion/printing routines
//
def caseconv(chr)
if flags & uppercase
if chr & $E0 == $E0
chr = chr - $E0
fin
fin
return chr
end
def strupper(strptr)#0
byte i, chr
for i = ^strptr downto 1
chr = (strptr).[i]
if chr & $E0 == $E0
(strptr).[i] = chr - $E0
fin
next
end
def strlower(strptr)#0
byte i, chr
for i = ^strptr downto 1
chr = (strptr).[i]
if chr & $E0 == $00
(strptr).[i] = chr + $E0
fin
next
end
def txtupper#0
word i, strptr
flags = flags | uppercase
for i = numlines - 1 downto 0
strupper(strlinbuf=>[i])
next
end
def txtlower#0
word i, strptr
flags = flags & ~uppercase
for i = numlines - 1 downto 0
strlower(strlinbuf=>[i])
next
end
def nametostr(namestr, len, strptr)#0
^strptr = len
memcpy(strptr + 1, namestr, len)
end
//
// File routines
//
def readtxt(filename)#0
byte txtbuf[81], refnum, i, j
if refnum
refnum = fileio:open(filename)
fileio:newline(refnum, $7F, $0D)
repeat
txtbuf = fileio:read(refnum, @txtbuf + 1, MAXLNLEN)
if txtbuf
sethibit(@txtbuf)
if flags & uppercase; strupper(@txtbuf); fin
strlinbuf=>[numlines] = newstr(@txtbuf)
numlines++
fin
if !(numlines & $0F); putc('.'); fin
until txtbuf == 0 or numlines == MAXLINES
fileio:close(refnum)
//
// Make sure there is a blank line at the end of the buffer
//
if numlines < MAXLINES and strlinbuf=>[numlines - 1] <> @nullstr
strlinbuf=>[numlines] = @nullstr
numlines++
fin
fin
end
def writetxt(filename)#0
byte txtbuf[81], refnum
byte j, chr
word i, strptr
fileio:destroy(filename)
fileio:create(filename, $04, $00) // full access, TXT file
refnum = fileio:open(filename)
if refnum == 0
return
fin
//
// Remove blank lines at end of text.
//
while numlines > 1 and strlinbuf=>[numlines - 1] == @nullstr; numlines = numlines - 1; loop
//
// Write all the text line to the file.
//
for i = 0 to numlines - 1
cpyln(strlinbuf=>[i], @txtbuf)
txtbuf = txtbuf + 1
txtbuf[txtbuf] = $0D
fileio:write(refnum, @txtbuf + 1, txtbuf)
if !(i & $0F); putc('.'); fin
next
fileio:close(refnum)
end
//
// Screen routines
//
def clrscrn#0
call($FC58, 0, 0, 0, 0)
end
def drawrow(row, ofst, strptr)#0
byte numchars
word scrnptr
scrnptr = txtscrn[row]
if ofst >= ^strptr
numchars = 0
else
numchars = ^strptr - ofst
fin
if numchars >= 40
numchars = 40
else
memset(scrnptr + numchars, $A0A0, 40 - numchars)
fin
memcpy(scrnptr, strptr + ofst + 1, numchars)
end
def drawscrn(toprow, ofst)#0
byte row, numchars
word strptr, scrnptr
if ofst
for row = 0 to 23
strptr = strlinbuf=>[toprow + row]
scrnptr = txtscrn[row]
if ofst >= ^strptr
numchars = 0
else
numchars = ^strptr - ofst
fin
if numchars >= 40
numchars = 40
else
memset(scrnptr + numchars, $A0A0, 40 - numchars)
fin
memcpy(scrnptr, strptr + ofst + 1, numchars)
next
else
for row = 0 to 23
strptr = strlinbuf=>[toprow + row]
scrnptr = txtscrn[row]
numchars = ^strptr
if numchars >= 40
numchars = 40
else
memset(scrnptr + numchars, $A0A0, 40 - numchars)
fin
memcpy(scrnptr, strptr + 1, numchars)
next
fin
end
def cursoff#0
if flags & showcurs
^cursptr = underchr
flags = flags & ~showcurs
fin
end
def curson#0
if !(flags & showcurs)
cursptr = txtscrn[cursy] + cursx
underchr = ^cursptr
^cursptr = curschr
flags = flags | showcurs
fin
end
def cursflash#0
if flags & showcurs
if flash == 0
^cursptr = curschr
elsif flash == 128
^cursptr = underchr
fin
flash++
fin
end
def redraw#0
cursoff
drawscrn(scrntop, scrnleft)
curson
end
def curshome#0
cursoff
cursrow = 0
curscol = 0
cursx = 0
cursy = 0
scrnleft = 0
scrntop = 0
drawscrn(scrntop, scrnleft)
curson
end
def cursend#0
cursoff
if numlines > 23
cursrow = numlines - 1
cursy = 23
scrntop = cursrow - 23
else
cursrow = numlines - 1
cursy = numlines - 1
scrntop = 0
fin
curscol = 0
cursx = 0
scrnleft = 0
drawscrn(scrntop, scrnleft)
curson
end
def cursup#0
if cursrow > 0
cursoff
cursrow--
if cursy > 0
cursy--
else
scrntop = cursrow
drawscrn(scrntop, scrnleft)
fin
curson
fin
end
def pgup#0
byte i
for i = pgjmp downto 0
cursup
next
end
def cursdown#0
if cursrow < numlines - 1
cursoff
cursrow++
if cursy < 23
cursy++
else
scrntop = cursrow - 23
drawscrn(scrntop, scrnleft)
fin
curson
fin
end
def pgdown#0
byte i
for i = pgjmp downto 0
cursdown
next
end
def cursleft#0
if curscol > 0
cursoff
curscol--
if cursx > 0
cursx--
else
scrnleft = curscol
drawscrn(scrntop, scrnleft)
fin
curson
fin
end
def pgleft#0
byte i
for i = 7 downto 0
cursleft
next
end
def cursright#0
if curscol < 80
cursoff
curscol++
if cursx < 39
cursx++
else
scrnleft = curscol - 39
drawscrn(scrntop, scrnleft)
fin
curson
fin
end
def pgright#0
byte i
for i = 7 downto 0
cursright
next
end
//
// Keyboard routines
//
def keyin2e
byte key
repeat
cursflash
key = ^keyboard
until key >= 128
^keystrobe
if ^pushbttn2 & 128 // Closed Apple pressed
when key
is keyarrowleft
key = keyctrla; break
is keyarrowright
key = keyctrls; break
is keyarrowup
key = keyctrlw; break
is keyarrowdown
key = keyctrlz; break
is keyenter
key = keyctrlf; break
wend
fin
return key
end
def keyin2
byte key
repeat
cursflash
key = ^keyboard
if key == keyctrll
^keystrobe
flags = flags ^ shiftlock
key = 0
fin
until key >= 128
^keystrobe
if key == keyctrln
key = $DB // [
elsif key == keyctrlp
key = $DF // _
elsif key == keyctrlb
key = $DC // \
elsif key == keyarrowleft
if ^pushbttn3 < 128
key = $FF
fin
elsif key >= $C0 and flags < shiftlock
if ^pushbttn3 < 128
if key == $C0
key = $D0 // P
elsif key == $DD
key = $CD // M
elsif key == $DE
key = $CE // N
fin
else
key = key | $E0
fin
fin
return key
end
def tabkeyin
return curscol < MAXLNLEN and curscol & $01 ?? keyspace :: 0
end
//
// Printer routines
//
def printtxt(slot)#0
byte txtbuf[80]
word i, scrncsw
scrncsw = *csw
*csw = $C000 | (slot << 8)
for i = 0 to numlines - 1
cpyln(strlinbuf=>[i], @txtbuf)
puts(@txtbuf)
putln
next
*csw = scrncsw
end
def openline(row)
if numlines < MAXLINES
memcpy(@strlinbuf=>[row + 1], @strlinbuf=>[row], (numlines - row) * 2)
strlinbuf=>[row] = @nullstr
numlines++
flags = flags | changed
return TRUE
fin
bell
return FALSE
end
def cutline#0
delstr(cutbuf)
cutbuf = strlinbuf=>[cursrow]
memcpy(@strlinbuf=>[cursrow], @strlinbuf=>[cursrow + 1], (numlines - cursrow) * 2)
if numlines > 1
numlines--
fin
flags = flags | changed
if cursrow == numlines
cursup
fin
redraw
end
def pasteline#0
if cutbuf and numlines < MAXLINES
memcpy(@strlinbuf=>[cursrow + 1], @strlinbuf=>[cursrow], (numlines - cursrow) * 2)
strlinbuf=>[cursrow] = newstr(cutbuf)
numlines++
flags = flags | changed
redraw
else
bell
fin
end
def joinline#0
byte joinstr[80], joinlen
if cursrow < numlines - 1
strstripcpy(@joinstr, strlinbuf=>[cursrow])
joinlen = joinstr + ^(strlinbuf=>[cursrow + 1])
if joinlen < 80
memcpy(@joinstr + joinstr + 1, strlinbuf=>[cursrow + 1] + 1, ^(strlinbuf=>[cursrow + 1]))
joinstr = joinlen
delstr(strlinbuf=>[cursrow])
strlinbuf=>[cursrow] = newstr(@joinstr)
delstr(strlinbuf=>[cursrow + 1])
numlines--
memcpy(@strlinbuf=>[cursrow + 1], @strlinbuf=>[cursrow + 2], (numlines - cursrow) * 2)
flags = flags | changed
redraw
else
bell
fin
fin
end
def splitline#0
byte splitstr[80], splitlen
if openline(cursrow + 1)
if curscol
splitlen = ^(strlinbuf=>[cursrow])
if curscol < splitlen - 1
memcpy(@splitstr + 1, strlinbuf=>[cursrow] + curscol + 1, splitlen - curscol)
splitstr = splitlen - curscol
strlinbuf=>[cursrow + 1] = newstr(@splitstr)
memcpy(@splitstr + 1, strlinbuf=>[cursrow] + 1, curscol)
splitstr = curscol
delstr(strlinbuf=>[cursrow])
strlinbuf=>[cursrow] = newstr(@splitstr)
fin
else
strlinbuf=>[cursrow + 1] = strlinbuf=>[cursrow]
strlinbuf=>[cursrow] = @nullstr
fin
curscol = 0
cursx = 0
scrnleft = 0
redraw
cursdown
fin
end
def editkey(key)
if key >= keyspace
return TRUE
elsif key == keydelete
return TRUE
elsif key == keyctrld
return TRUE
elsif key == keyctrlr
return TRUE
fin
return FALSE
end
def editline(key)
byte editstr[80]
word undoline
if (editkey(key))
flags = flags | changed
memset(@editstr, $A0A0, 80)
strstripcpy(@editstr, strlinbuf=>[cursrow])
undoline = strlinbuf=>[cursrow]
strlinbuf=>[cursrow] = @editstr
repeat
if key >= keyspace
if key == keydelete
if curscol > 0
if curscol <= editstr
memcpy(@editstr[curscol], @editstr[curscol + 1], editstr - curscol)
editstr--
fin
curscol--
cursoff
if cursx > 0
cursx--
drawrow(cursy, scrnleft, @editstr)
else
scrnleft--
drawscrn(scrntop, scrnleft)
fin
curson
fin
elsif curscol < MAXLNLEN
curscol++
cursx++
if flags & insmode
if editstr < MAXLNLEN or editstr.MAXLNLEN == $A0
editstr++
if curscol >= editstr
editstr = curscol
else
memcpy(@editstr[curscol + 1], @editstr[curscol], editstr - curscol)
fin
else
curscol--
cursx--
key = editstr[curscol]
bell
fin
else
if curscol > editstr
editstr = curscol
fin
fin
editstr[curscol] = caseconv(key)
cursoff
if cursx <= 39
drawrow(cursy, scrnleft, @editstr)
else
scrnleft++
cursx = 39
drawscrn(scrntop, scrnleft)
fin
curson
else
bell
fin
elsif key == keyctrld
if curscol < editstr
strstripcpy(undoline, @editstr)
memcpy(@editstr[curscol + 1], @editstr[curscol + 2], editstr - curscol)
editstr--
cursoff
drawrow(cursy, scrnleft, @editstr)
curson
fin
elsif key == keyctrlr
strstripcpy(@editstr, undoline)
cursoff
drawrow(cursy, scrnleft, @editstr)
curson
fin
key = keyin()
until not editkey(key)
if editstr
strlinbuf=>[cursrow] = newstr(@editstr)
else
strlinbuf=>[cursrow] = @nullstr
fin
delstr(undoline)
fin
return key
end
def editmode#0
repeat
when editline(keyin())
is keyarrowup
cursup; break
is keyarrowdown
cursdown; break
is keyarrowleft
cursleft; break
is keyarrowright
cursright; break
is keyctrlw
pgup; break
is keyctrlz
pgdown; break
is keyctrla
pgleft; break
is keyctrls
pgright; break
is keyctrlq
curshome; break
is keyctrle
cursend; break
is keyctrlx
cutline; break
is keyctrlv
pasteline; break
is keyctrlf
if numlines < MAXLINES and cursrow == numlines - 1
strlinbuf=>[numlines] = @nullstr
numlines++
fin
cursdown
is keyctrlo
openline(cursrow)
redraw
break
is keyenter
if flags & insmode
splitline
else
openline(cursrow + 1)
cursdown
redraw
fin
break
is keyctrlt
joinline; break
is keyctrli
keyin = @tabkeyin
editline(keyspace)
keyin = !(MACHID & $80) ?? @keyin2 :: @keyin2e
break
is keyctrlb
if flags & insmode
flags = flags & ~insmode
curschr = ' '
else
flags = flags | insmode
curschr = '+'
fin
break
is keyctrlc
if flags & uppercase
txtlower
else
txtupper
fin
redraw
break
is keyescape
cursoff
cmdmode
if not exit
redraw
fin
break
wend
until exit
end
//
// Command mode
//
def prfiles(optpath)
byte path[64]
byte refnum
byte firstblk
byte entrylen, entriesblk
byte i, type, len
word databuff, entry, filecnt
if ^optpath
strstripcpy(@path, optpath)
else
fileio:getpfx(@path)
puts(@path)
putln
fin
databuff = heapalloc(512)
refnum = fileio:open(@path)
if perr
return perr
fin
firstblk = 1
repeat
if fileio:read(refnum, databuff, 512) == 512
entry = databuff + 4
if firstblk
entrylen = databuff->$23
entriesblk = databuff->$24
filecnt = databuff=>$25
entry = entry + entrylen
fin
for i = firstblk to entriesblk
type = ^entry
if type <> 0
len = type & $0F
^entry = len
puts(entry)
if type & $F0 == $D0 // Is it a directory?
putc('/')
len++
fin
for len = 20 - len downto 1
putc(' ')
next
filecnt--
fin
entry = entry + entrylen
next
firstblk = 0
else
filecnt = 0
fin
until filecnt == 0
fileio:close(refnum)
heaprelease(databuff)
putln
return 0
end
def striplead(strptr, chr)#0
while ^strptr and ^(strptr + 1) == chr
memcpy(strptr + 1, strptr + 2, ^strptr)
^strptr--
loop
end
def parsecmd(strptr)
byte cmd
cmd = 0
striplead(strptr, ' ')
if ^strptr
cmd = ^(strptr + 1)
memcpy(strptr + 1, strptr + 2, ^strptr)
^strptr--
fin
if ^strptr
striplead(strptr, ' ')
fin
return cmd
end
def chkchng
if flags & changed
puts("LOSE CHANGES TO FILE (Y/N)?")
if toupper(keyin()) == 'N'
putln
return FALSE
fin
putln
fin
return TRUE
end
def cmdmode#0
byte slot
word cmdptr
clrscrn
puts("PLASMA Editor, Version 1.0\n")
while not exit
puts(@filename)
cmdptr = gets($BA)
when toupper(parsecmd(cmdptr))
is 'A'
readtxt(cmdptr)
flags = flags | changed
break
is 'R'
if chkchng
inittxtbuf
numlines = 0
strstripcpy(@filename, cmdptr)
readtxt(@filename)
if numlines == 0; numlines = 1; fin
flags = flags & ~changed
fin
break
is 'W'
if ^cmdptr
strstripcpy(@filename, cmdptr)
fin
writetxt(@filename)
//if flags & changed; fin
flags = flags & ~changed
break
is 'C'
prfiles(cmdptr); break
is 'P'
fileio:setpfx(cmdptr); break
is 'H'
if ^cmdptr
slot = cmdptr.1 - '0'
else
slot = 1
fin
printtxt(slot)
break
is 'Q'
exit = chkchng
is 'E'
is 0
return
is 'N'
if chkchng
inittxtbuf
strstripcpy(@filename, "UNTITLED")
fin
break
otherwise
bell
putc('?')
putln
wend
if perr
puts("ERROR: $")
call($FDDA, perr, 0, 0, 0)
else
puts("OK")
fin
putln
loop
end
//
// Init editor
//
if !(MACHID & $80)
flags = uppercase | shiftlock
keyin = @keyin2
else
keyin = @keyin2e
fin
inittxtbuf
arg = argNext(argFirst)
if ^arg
strcpy(@filename, arg)
puts(@filename)
numlines = 0
readtxt(@filename)
fin
curschr = '+'
flags = flags | insmode
drawscrn(scrntop, scrnleft)
curson
editmode
done