1
0
mirror of https://github.com/dschmenk/PLASMA.git synced 2024-06-10 02:29:30 +00:00
PLASMA/src/toolsrc/ed.pla

1761 lines
44 KiB
Plaintext
Executable File

//=====================================
//
// Text Editor
//
//=====================================
include "inc/cmdsys.plh"
include "inc/args.plh"
include "inc/fileio.plh"
sysflags nojitc // Keep JITC from compiling and pausing while editing
//
// Hardware constants
//
const csw = $0036
const pushbttn1 = $C061
const pushbttn2 = $C062
const pushbttn3 = $C063
const keyboard = $C000
const keystrobe = $C010
const inputln = $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 keyctrlg = $87
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 keyctrly = $99
const keyctrlz = $9A
const keytab = keyctrli
const keydetab = $9D
const keydelete = $FF
//
// Data and text buffer constants
//
const MAXLINES = 999
const MAXLINESSIZE = MAXLINES+24
const MAXCLIPLINES = 256
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 gutter = 4
const uppercase = 8
const selection = 16
const showcurs = 32
const shiftlock = 128
//
// Text screen row address array
//
const scrnheight = 24
const scrnbottom = 23
word scrnwidth = 36
word scrnright = 35
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[80] findstr = ""
byte[64] filename = "UNTITLED"
byte exit = FALSE
byte flags = 0
byte flash = 0
word numlines = 0
word numcliplines = 0
word arg
word strplsize = MAXSTRPLSIZE
word strpool, strplmapsize, txtlinbuf, cliplinbuf, strpoolmap
word cursx, cursy, scrnleft, curscol
byte underchr, curschr
word keyin, cursrow, selrow, scrntop, cursptr
byte a3echo = $80
byte a3noecho = $00
//
// 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 lncpy(dststr, srcstr)#0
LDA ESTKL,X
STA SRCL
LDA ESTKH,X
STA SRCH
INX
LDA ESTKL,X
STA DSTL
LDA ESTKH,X
STA DSTH
INX
LDY #$00
LDA (SRC),Y
CMP #80
BCC +
LDA #79
CLC
+ ADC #$01 ; APPEND CR TO END OF STRING
STA (DST),Y
TAY
LDA #$0D
STA (DST),Y
DEY
BEQ ++
CPLNLP LDA (SRC),Y
CMP #$20
BCS +
ADC #$60
+ AND #$7F
STA (DST),Y
DEY
BNE CPLNLP
++ RTS
end
asm lnupcpy(dststr, srcstr)#0
LDA ESTKL,X
STA SRCL
LDA ESTKH,X
STA SRCH
INX
LDA ESTKL,X
STA DSTL
LDA ESTKH,X
STA DSTH
INX
LDY #$00
LDA (SRC),Y
CMP #80
BCC +
LDA #79
+ STA (DST),Y
TAY
BEQ +++
CPUPLP LDA (SRC),Y
CMP #$20
BCS +
ADC #$60
+ AND #$7F
CMP #$7B
BCS ++
CMP #$61
BCC ++
SEC
SBC #$20
++ STA (DST),Y
DEY
BNE CPUPLP
+++ 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
word mapmask, addr, i
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 striplead(strptr, chr)#0
byte striplen
for striplen = 1 to ^strptr
if ^(strptr + striplen) <> chr
break
fin
next
if striplen > 1
^strptr = ^strptr - (striplen - 1)
memcpy(strptr + 1, strptr + striplen, ^strptr)
fin
end
def striptail(strptr, chr)#0
byte strlen
for strlen = ^strptr downto 1
if ^(strptr + strlen) <> $8D and ^(strptr + strlen) <> chr
break
fin
next
^strptr = strlen
end
def strstripcpy(dststr, srcstr)#0
memcpy(dststr, srcstr, ^srcstr + 1)
striptail(dststr, keyspace)
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) == keyenter or ^(strptr + strlen) == keyspace
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
txtlinbuf = heapalloc(MAXLINESSIZE*2)
cliplinbuf = heapalloc(MAXCLIPLINES*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)
memset(txtlinbuf, @nullstr, MAXLINESSIZE*2)
memset(cliplinbuf, @nullstr, MAXCLIPLINES*2)
memset(strpoolmap, 0, strplmapsize)
else
for i = 0 to MAXLINESSIZE-1
if txtlinbuf=>[i] <> @nullstr
delstr(txtlinbuf=>[i])
txtlinbuf=>[i] = @nullstr
fin
next
fin
numlines = 1
cursrow = 0
curscol = 0
cursx = 0
cursy = 0
scrnleft = 0
scrntop = 0
flags = flags & ~selection
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
if ^strptr
for i = ^strptr downto 1
chr = (strptr).[i]
if chr & $E0 == $E0
(strptr).[i] = chr - $E0
fin
next
fin
end
def strlower(strptr)#0
byte i, chr
if ^strptr
for i = ^strptr downto 1
chr = (strptr).[i]
if chr & $E0 == $00
(strptr).[i] = chr + $E0
fin
next
fin
end
def txtupper#0
word i, strptr
flags = flags | uppercase
for i = numlines - 1 downto 0
strupper(txtlinbuf=>[i])
next
end
def txtlower#0
word i, strptr
flags = flags & ~uppercase
for i = numlines - 1 downto 0
strlower(txtlinbuf=>[i])
next
end
def strtonum(strptr)
word num, i
byte c
num = 0
for i = 1 to ^strptr
c = ^(strptr + i) & $7F
if c < '0' and c > '9'
break
fin
num = num * 10 + c - '0'
next
return num
end
def nametostr(namestr, len, strptr)#0
^strptr = len
memcpy(strptr + 1, namestr, len)
end
//
// File routines
//
def readtxt(filename, startline)#0
byte refnum, i, j, txtbuf[MAXLNLEN+2]
refnum = fileio:open(filename)
if refnum
fileio:newline(refnum, $7F, $0D)
numlines = startline
repeat
txtbuf = fileio:read(refnum, @txtbuf + 1, MAXLNLEN)
if txtbuf
sethibit(@txtbuf)
if flags & uppercase; strupper(@txtbuf); fin
txtlinbuf=>[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 txtlinbuf=>[numlines - 1] <> @nullstr
txtlinbuf=>[numlines] = @nullstr
numlines++
fin
fin
putln
end
def writetxt(filename)#0
word i
byte refnum, txtbuf[MAXLNLEN+2]
//
// Remove blank lines at end of text.
//
while numlines > 1 and txtlinbuf=>[numlines - 1] == @nullstr; numlines--; loop
//
// Delete old file and re-create
//
fileio:destroy(filename)
fileio:create(filename, $04, $00) // full access, TXT file
refnum = fileio:open(filename)
if refnum == 0
puts("\nError $"); puth(perr); puts(" opening: "); puts(filename); putln
return
fin
//
// Write all the text lines to the file.
//
for i = 0 to numlines - 1
lncpy(@txtbuf, txtlinbuf=>[i])
if fileio:write(refnum, @txtbuf + 1, txtbuf) <> txtbuf
puts("\nError $"); puth(perr); puts(" writing: "); puts(filename); putln
fileio:close(refnum)
return
fin
if !(i & $0F); putc('.'); fin
next
if fileio:close(refnum) <> FILE_ERR_OK
puts("\nError $"); puth(perr); puts(" closing: "); puts(filename)
fin
putln
end
//
// Screen routines
//
def clrscrn#0
if MACHID == $F2 // Apple 3
putc(28)
else
call($FC58, 0, 0, 0, 0)
fin
end
def drawrow(row, ofst, strptr)#0
byte numchars
word scrnptr
scrnptr = txtscrn[row] + (flags & gutter)
if ofst >= ^strptr
numchars = 0
else
numchars = ^strptr - ofst
fin
if numchars >= scrnwidth
numchars = scrnwidth
else
memset(scrnptr + numchars, $A0A0, scrnwidth - numchars)
fin
memcpy(scrnptr, strptr + ofst + 1, numchars)
end
def drawgutter(scrnrow, ofst)#0
byte row, hilite, ofstch, huns, tens, ones
word scrnptr, scrnrow
//
// Draw line numbers and gutter hilites
//
//ofstch = ofst ?? $80 | '<' :: keyspace
ofstch = ofst ?? '<' :: ' '
huns, tens = divmod(scrnrow + 1, 100)
tens, ones = divmod(tens, 10)
for row = 0 to 23
scrnptr = txtscrn[row]
if scrnrow < numlines
if flags & selection and (scrnrow >= selrow and scrnrow <= cursrow) or (scrnrow >= cursrow and scrnrow <= selrow)
hilite = $00
elsif scrnrow == cursrow
hilite = $00
else
hilite = $80
fin
if huns
^scrnptr = hilite + '0' + huns
^(scrnptr+1) = hilite + '0' + tens
^(scrnptr+2) = hilite + '0' + ones
ones++
if ones > 9
ones = 0
tens++
if tens > 9
tens = 0
huns++
fin
fin
elsif tens
^scrnptr = hilite + ' '
^(scrnptr+1) = hilite + '0' + tens
^(scrnptr+2) = hilite + '0' + ones
ones++
if ones > 9
ones = 0
tens++
if tens > 9
tens = 0
huns = 1
fin
fin
elsif ones
^scrnptr = hilite + ' '
^(scrnptr+1) = hilite + ' '
^(scrnptr+2) = hilite + '0' + ones
ones++
if ones > 9
ones = 0
tens = 1
fin
fin
^(scrnptr+3) = ofstch
else
*scrnptr = $A0A0
*(scrnptr+2) = $A0A0
fin
scrnrow++
next
end
def drawscrn(toprow, ofst)#0
byte row, numchars, lofst
word strptr, scrnptr
lofst = flags & gutter
if lofst
drawgutter(toprow, ofst)
fin
//
// Draw text
//
if ofst
for row = 0 to 23
strptr = txtlinbuf=>[toprow + row]
scrnptr = txtscrn[row] + lofst
if ofst >= ^strptr
numchars = 0
else
numchars = ^strptr - ofst
fin
if numchars >= scrnwidth
numchars = scrnwidth
else
memset(scrnptr + numchars, $A0A0, scrnwidth - numchars)
fin
memcpy(scrnptr, strptr + ofst + 1, numchars)
next
else
for row = 0 to 23
strptr = txtlinbuf=>[toprow + row]
scrnptr = txtscrn[row] + lofst
numchars = ^strptr
if numchars >= scrnwidth
numchars = scrnwidth
else
memset(scrnptr + numchars, $A0A0, scrnwidth - numchars)
fin
memcpy(scrnptr, strptr + 1, numchars)
next
fin
end
def cursoff#0
word scrnptr
if flags & showcurs
^cursptr = underchr
if flags & gutter
scrnptr = txtscrn[cursy]
*scrnptr = *scrnptr | $8080
^(scrnptr+2) = ^(scrnptr+2) | $80
fin
flags = flags & ~showcurs
fin
end
def curson#0
byte lofst
word scrnptr
if !(flags & showcurs)
lofst = flags & gutter
if lofst
scrnptr = txtscrn[cursy]
*scrnptr = *scrnptr & $7F7F
^(scrnptr+2) = ^(scrnptr+2) & $7F
fin
cursptr = txtscrn[cursy] + lofst + 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 curshpos(hpos)#1
byte needredraw
needredraw = TRUE
if hpos < 0; hpos = 0; fin
if hpos > MAXLNLEN; hpos = MAXLNLEN; fin
curscol = hpos
cursx = curscol - scrnleft
if cursx > scrnright
cursx = scrnright
scrnleft = curscol - scrnright
elsif cursx < 0
cursx = 0
scrnleft = curscol
else
needredraw = FALSE
fin
return needredraw
end
def cursvpos(vpos)#1
byte needredraw
needredraw = TRUE
if vpos < 0; vpos = 0; fin
if vpos > numlines - 1; vpos = numlines - 1; fin
cursrow = vpos
cursy = cursrow - scrntop
if cursy > scrnbottom
cursy = scrnbottom
scrntop = cursrow - scrnbottom
elsif cursy < 0
cursy = 0
scrntop = cursrow
else
needredraw = FALSE
fin
return needredraw
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--
if flags & selection
drawgutter(scrntop, scrnleft)
fin
else
scrntop = cursrow
drawscrn(scrntop, scrnleft)
fin
curson
fin
end
def pgup#0
cursoff
if cursvpos(cursrow - pgjmp)
drawscrn(scrntop, scrnleft)
else
if flags & selection
drawgutter(scrntop, scrnleft)
fin
fin
curson
end
def cursdown#0
if cursrow < numlines - 1
cursoff
cursrow++
if cursy < 23
cursy++
if flags & selection
drawgutter(scrntop, scrnleft)
fin
else
scrntop = cursrow - 23
drawscrn(scrntop, scrnleft)
fin
curson
fin
end
def pgdown#0
cursoff
if cursvpos(cursrow + pgjmp)
drawscrn(scrntop, scrnleft)
else
if flags & selection
drawgutter(scrntop, scrnleft)
fin
fin
curson
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
word i, strptr
strptr = txtlinbuf=>[cursrow]
if curscol > ^strptr
i = ^strptr
else
for i = 1 to ^strptr
if ^(strptr + i) <> keyspace
break
fin
next
i--
if i >= curscol
i = 0
fin
fin
cursoff
if curshpos(i)
//if curshpos(curscol - 8)
drawscrn(scrntop, scrnleft)
else
if flags & selection
drawgutter(scrntop, scrnleft)
fin
fin
curson
end
def cursright#0
if curscol < MAXLNLEN
cursoff
curscol++
if cursx < scrnright
cursx++
else
scrnleft = curscol - scrnright
drawscrn(scrntop, scrnleft)
fin
curson
fin
end
def pgright#0
word i, strptr
strptr = txtlinbuf=>[cursrow]
if curscol >= ^strptr
i = curscol + 8
else
for i = 1 to ^strptr
if ^(strptr + i) <> keyspace
break
fin
next
i--
if curscol >= i
i = ^strptr
fin
fin
cursoff
if curshpos(i)
//if curshpos(curscol + 8)
drawscrn(scrntop, scrnleft)
else
if flags & selection
drawgutter(scrntop, scrnleft)
fin
fin
curson
end
//
// Find string in text
//
def findline(strptr, start)#1
byte scan, i, upstr[MAXLNLEN+1]
if ^strptr >= findstr
lnupcpy(@upstr, strptr)
for scan = start to upstr - findstr + 1
if upstr[scan] == findstr[1]
for i = 2 to findstr
if upstr[scan + i - 1] <> findstr[i]
break
fin
next
if i > findstr
curshpos(scan - 1)
return TRUE
fin
fin
next
fin
return FALSE
end
def findtxt#0
word f
//
// Search from current pos to end
//
if findline(txtlinbuf=>[cursrow], curscol + 2)
return
fin
for f = cursrow + 1 to numlines - 1
if findline(txtlinbuf=>[f], 1)
cursvpos(f)
return
fin
next
//
// Search from beginning to current pos
//
for f = 0 to cursrow
if findline(txtlinbuf=>[f], 1)
cursvpos(f)
return
fin
next
bell
end
//
// Keyboard routines
//
def dev_control(devnum, code, list)#1
byte params[5]
params.0 = 3
params.1 = devnum
params.2 = code
params:3 = list
perr = syscall($83, @params)
return perr
end
def cons_keyavail
byte params[5]
byte count
params.0 = 3
params.1 = cmdsys.devcons
params.2 = 5
params:3 = @count
return syscall($82, @params) ?? 0 :: count
end
def cons_keyread
byte params[8]
byte key
params.0 = 4
params.1 = cmdsys.refcons
params:2 = @key
params:4 = 1
params:6 = 0
syscall($CA, @params)
return params:6 ?? key :: 0
end
def keyin3
byte key
repeat
cursflash
until cons_keyavail
key = cons_keyread
if key & $80 // Open Apple modifier
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
is keytab
key = keydetab; break
is $80 | '\\'
key = keydelete; break // Delete
//
// Map OA+keypad
//
is $80 | '4'
key = keyarrowleft; break
is $80 | '6'
key = keyarrowright; break
is $80 | '8'
key = keyarrowup; break
is $80 | '2'
key = keyarrowdown; break
is $80 | '7'
key = keyctrlq; break // Top
is $80 | '1'
key = keyctrle; break // Bottom
is $80 | '9'
key = keyctrlw; break // Pg Up
is $80 | '3'
key = keyctrlz; break // Pg Dn
is $80 | '5'
key = keyctrld; break // Del
is $80 | '.'
key = keyctrlc; break // Copy
is $80 | '0'
key = keyctrlv; break // Paste
is $80 | '-'
key = keyctrlx; break // Cut
wend
fin
return key | $80
end
def keyin2e
byte key, vbl
^$C079 = 0 // IOU enable and clear VBL int on //c
^$C05B = 0 // Enable VBL Ints on //c
vbl = ^$C019
repeat
if flags & showcurs
if flash == 0
^cursptr = curschr
elsif flash == 128
^cursptr = underchr
fin
if vbl ^ ^$C019
flash = flash + 8
vbl = ^$C019
^$C079 = 0 // Clear VBL int on //c
fin
fin
key = ^keyboard
until key >= 128
^$C05A = 0 // Disable VBL Ints on //c
^$C078 = 0 // IOU disable on //c
^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
is keytab
key = keydetab; 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
when key
is keyctrln
key = $DB // '['
break
is $9E // SHIFT+CTRL+N
key = $FE // '~'
break
is keyctrlp
key = $DC // '\'
break
is $80 // SHIFT+CTRL+P -> CTRL+@
key = $FC // '|'
break
is keyctrlg
key = $DF // '_'
break
is keyarrowleft
if ^pushbttn3 < 128
key = keydelete
fin
break
is keyarrowright
if ^pushbttn3 < 128
key = keytab
fin
break
otherwise
if key >= $C0 and flags < shiftlock
if ^pushbttn3 < 128
when key
is $C0
key = $D0 // P
break
is $DD
key = $CD // M
break
is $DE
key = $CE // N
wend
else
key = key | $E0
fin
fin
wend
return key
end
def setkeyin#0
when MACHID & MACHID_MODEL
is MACHID_IIE
is MACHID_IIC
keyin = @keyin2e
break
is MACHID_III
keyin = @keyin3
break
otherwise // ][ or ][+
keyin = @keyin2
wend
end
//
// Printer routines
//
def printtxt(slot)#0
byte txtbuf[MAXLNLEN+1]
word i, scrncsw
scrncsw = *csw
*csw = $C000 | (slot << 8)
for i = 0 to numlines - 1
lncpy(@txtbuf, txtlinbuf=>[i])
puts(@txtbuf)
putln
next
*csw = scrncsw
end
def freesel#0
word i
for i = 0 to numcliplines - 1
if cliplinbuf=>[i] <> @nullstr
delstr(cliplinbuf=>[i])
cliplinbuf=>[i] = @nullstr
fin
next
numcliplines = 0
end
def selrange#2
word first, last
if flags & selection
if cursrow > selrow
first, last = selrow, cursrow
else
first, last = cursrow, selrow
fin
else
first = cursrow
last = first
fin
return first, last
end
def beginsel#0
flags = flags ^ selection
selrow = cursrow
drawgutter(scrntop, scrnleft)
end
def copysel#0
word firstsel, lastsel
freesel
firstsel, lastsel = selrange
for numcliplines = 0 to lastsel - firstsel
cliplinbuf=>[numcliplines] = newstr(txtlinbuf=>[firstsel + numcliplines])
next
flags = flags & ~selection
drawgutter(scrntop, scrnleft)
end
def cutsel#0
word firstsel, lastsel
freesel
firstsel, lastsel = selrange
if lastsel - firstsel < MAXCLIPLINES
for numcliplines = 0 to lastsel - firstsel
cliplinbuf=>[numcliplines] = txtlinbuf=>[firstsel + numcliplines]
next
memcpy(@txtlinbuf=>[firstsel], @txtlinbuf=>[lastsel + 1], (numlines - lastsel + 1) * 2)
numlines = numlines - numcliplines
for lastsel = numlines to numlines + numcliplines
txtlinbuf=>[lastsel] = @nullstr
next
cursrow = firstsel
if cursrow >= numlines
cursrow = numlines - 1
fin
if cursrow < scrntop
scrntop = cursrow
fin
cursy = cursrow - scrntop
flags = flags | changed
flags = flags & ~selection
redraw
else
bell
fin
end
def pastesel#0
word p
if numcliplines and numcliplines + numlines < MAXLINES
memcpy(@txtlinbuf=>[cursrow + numcliplines], @txtlinbuf=>[cursrow], (numlines - cursrow) * 2)
for p = 0 to numcliplines - 1
txtlinbuf=>[cursrow + p] = newstr(cliplinbuf=>[p])
next
numlines = numlines + numcliplines
flags = flags | changed
redraw
else
bell
fin
end
def indentsel#0
byte indentstr[MAXLNLEN+1], j, l
word firstsel, lastsel, i
freesel
firstsel, lastsel = selrange
for i = firstsel to lastsel
l = ^(txtlinbuf=>[i])
if l and l < MAXLNLEN - 2
memcpy(@indentstr + 3, txtlinbuf=>[i] + 1, l)
indentstr[0] = l + 2
indentstr[1] = keyspace
indentstr[2] = keyspace
//
// Align indent
//
for j = 3 to indentstr[0]
if indentstr[j] <> keyspace
if j & 1 == 0
indentstr[0]--
memcpy(@indentstr + 1, @indentstr + 2, indentstr[0])
fin
break
fin
next
delstr(txtlinbuf=>[i])
txtlinbuf=>[i] = newstr(@indentstr)
flags = flags | changed
fin
next
redraw
end
def undentsel#0
byte undentstr[MAXLNLEN+1], l
word firstsel, lastsel, i
freesel
firstsel, lastsel = selrange
for i = firstsel to lastsel
l = ^(txtlinbuf=>[i])
if l
memcpy(@undentstr + 1, txtlinbuf=>[i] + 1, l)
if undentstr[1] == keyspace
memcpy(@undentstr + 1, @undentstr + 2, l - 1)
l--
if l and undentstr[1] == keyspace
memcpy(@undentstr + 1, @undentstr + 2, l - 1)
l--
fin
undentstr[0] = l
delstr(txtlinbuf=>[i])
txtlinbuf=>[i] = newstr(@undentstr)
flags = flags | changed
fin
fin
next
redraw
end
def autoindent(strptr)#0
byte i
for i = 1 to ^strptr
if ^(strptr + i) <> keyspace
break
fin
next
curshpos(i - 1)
end
def openline(row)
if numlines < MAXLINES
memcpy(@txtlinbuf=>[row + 1], @txtlinbuf=>[row], (numlines - row) * 2)
txtlinbuf=>[row] = @nullstr
numlines++
flags = flags | changed
return TRUE
fin
bell
return FALSE
end
def joinline#0
byte joinstr[MAXLNLEN+1], joinlen, stripjoin[MAXLNLEN+1]
if cursrow < numlines - 1
strstripcpy(@joinstr, txtlinbuf=>[cursrow])
memcpy(@stripjoin, txtlinbuf=>[cursrow + 1], ^(txtlinbuf=>[cursrow + 1]) + 1)
striplead(@stripjoin, keyspace);
joinlen = joinstr + stripjoin
if joinlen <= MAXLNLEN
curshpos(joinstr)
memcpy(@joinstr + joinstr + 1, @stripjoin + 1, stripjoin)
joinstr = joinlen
delstr(txtlinbuf=>[cursrow])
txtlinbuf=>[cursrow] = newstr(@joinstr)
delstr(txtlinbuf=>[cursrow + 1])
numlines--
memcpy(@txtlinbuf=>[cursrow + 1], @txtlinbuf=>[cursrow + 2], (numlines - cursrow) * 2)
flags = flags | changed
return
fin
fin
bell
end
def splitline#0
byte splitstr[MAXLNLEN+1], splitlen, i
if openline(cursrow + 1)
if curscol
splitlen = ^(txtlinbuf=>[cursrow])
if curscol < splitlen - 1
splitstr = splitlen - curscol
memcpy(@splitstr + 1, txtlinbuf=>[cursrow] + curscol + 1, splitstr)
striplead(@splitstr, keyspace)
for i = 1 to curscol
if ^(txtlinbuf=>[cursrow] + i) <> keyspace
break
fin
memcpy(@splitstr + 2, @splitstr + 1, splitstr)
splitstr[1] = keyspace
splitstr++
next
txtlinbuf=>[cursrow + 1] = newstr(@splitstr)
splitstr = curscol
memcpy(@splitstr + 1, txtlinbuf=>[cursrow] + 1, splitstr)
delstr(txtlinbuf=>[cursrow])
txtlinbuf=>[cursrow] = newstr(@splitstr)
curshpos(i - 1)
else
if splitlen > 0
for curscol = 1 to splitlen - 1
if ^(txtlinbuf=>[cursrow] + curscol) <> keyspace
break
fin
next
curshpos(curscol - 1)
fin
fin
else
txtlinbuf=>[cursrow + 1] = txtlinbuf=>[cursrow]
txtlinbuf=>[cursrow] = @nullstr
fin
fin
end
def editkey(key)
if key >= keyspace or key == keydelete or key == keyctrld or key == keyctrlr
return TRUE
fin
return FALSE
end
def editline(key)
word undoline
byte undopos, localchange, editstr[], editlen, editchars[MAXLNLEN+1]
if (editkey(key))
undopos = curscol
undoline = txtlinbuf=>[cursrow]
editlen = MAXLNLEN
memset(@editchars, $A0A0, MAXLNLEN)
memcpy(@editchars, undoline + 1, ^undoline)
txtlinbuf=>[cursrow] = @editstr
localchange = FALSE
repeat
when key
is keyctrld
memcpy(@editchars[curscol], @editchars[curscol + 1], MAXLNLEN - 1 - curscol)
editchars[MAXLNLEN - 1] = keyspace
cursoff
drawrow(cursy, scrnleft, @editstr)
curson
localchange = TRUE
break
is keyctrlr
memset(@editchars, $A0A0, MAXLNLEN)
memcpy(@editchars, undoline + 1, ^undoline)
cursoff
if curshpos(undopos)
drawscrn(scrntop, scrnleft)
else
drawrow(cursy, scrnleft, @editstr)
fin
curson
localchange = FALSE
break
is keydelete
if curscol > 0
memcpy(@editchars[curscol - 1], @editchars[curscol], MAXLNLEN - curscol)
editchars[MAXLNLEN - 1] = keyspace
cursoff
if curshpos(curscol - 1)
drawscrn(scrntop, scrnleft)
else
drawrow(cursy, scrnleft, @editstr)
fin
curson
localchange = TRUE
fin
break
otherwise
if flags & insmode
if editchars[MAXLNLEN - 1] == keyspace
memcpy(@editchars[curscol+1], @editchars[curscol], MAXLNLEN - 1 - curscol)
else
bell
break
fin
fin
editchars[curscol] = caseconv(key)
cursoff
if curshpos(curscol + 1)
drawscrn(scrntop, scrnleft)
else
drawrow(cursy, scrnleft, @editstr)
fin
curson
localchange = TRUE
break
wend
key = keyin()
until not editkey(key)
if localchange
flags = flags | changed
delstr(undoline)
txtlinbuf=>[cursrow] = newstr(@editstr)
else
txtlinbuf=>[cursrow] = undoline
fin
fin
return key
end
def editmode#0
if MACHID == $F2 // Apple 3
dev_control(cmdsys.devcons, 11, @a3noecho)
fin
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 keyctrlb
beginsel; break
is keyctrlc
copysel; break
is keyctrlx
cutsel; break
is keyctrlv
pastesel; break
is keyctrlf
if cursrow == (numlines - 1)
if numlines < MAXLINES
numlines++
cursdown
flags = flags | changed
drawgutter(scrntop, scrnleft)
else
bell
fin
break
fin
cursdown
is keyctrlo
openline(cursrow)
if cursrow
autoindent(txtlinbuf=>[cursrow - 1])
else
curshpos(0)
fin
redraw
break
is keyenter
if flags & insmode
splitline
else
openline(cursrow + 1)
fin
autoindent(txtlinbuf=>[cursrow])
cursvpos(cursrow + 1)
redraw
break
is keyctrlt
joinline
redraw
break
is keytab
if flags & insmode
indentsel
cursoff
if not ^(txtlinbuf=>[cursrow])
curshpos((curscol + 2) & $FE)
else
autoindent(txtlinbuf=>[cursrow])
fin
curson
break
fin
is keydetab
undentsel
cursoff
if not ^(txtlinbuf=>[cursrow])
curshpos((curscol - 2) & $FFFE)
else
autoindent(txtlinbuf=>[cursrow])
fin
curson
break
is keyctrly
flags = flags ^ insmode
curschr = flags & insmode ?? '+' :: ' '
break
is keyescape
if MACHID == $F2 // Apple 3
dev_control(cmdsys.devcons, 11, @a3echo)
fin
cursoff
cmdmode
if not exit
if MACHID == $F2 // Apple 3
dev_control(cmdsys.devcons, 11, @a3noecho)
fin
redraw
fin
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
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
while fileio:read(refnum, databuff, 512) == 512
entry = databuff + 4
if firstblk
entrylen = databuff->$23
entriesblk = databuff->$24
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
fin
entry = entry + entrylen
next
firstblk = 0
loop
fileio:close(refnum)
heaprelease(databuff)
putln
return 0
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, line
clrscrn
puts("PLASMA Editor, Version 2.1\n")
while not exit
puts(@filename)
cmdptr = gets($BA)
when toupper(parsecmd(cmdptr))
is 'F' // Find string
if ^cmdptr
lnupcpy(@findstr, cmdptr)
fin
findtxt
return
is 'T' // Toggle upper/lower case display
if ^cmdptr
when toupper(^(cmdptr + 1))
is 'G' // Gutter view
flags = flags ^ gutter
if flags & gutter
scrnwidth = 36
scrnright = 35
else
scrnwidth = 40
scrnright = 39
fin
break
is 'C' // Lower case chip (Apple ][/][+ only)
if flags & uppercase
txtlower
else
txtupper
fin
break
wend
fin
return
is 'G' // Goto line #
line = strtonum(cmdptr)
if line
curshpos(0)
cursvpos(line - 1)
fin
is 'E' // Edit mode
is 0
return
is 'A' // Append file
readtxt(cmdptr, numlines)
flags = flags | changed
break
is 'R' // Read file
if chkchng
inittxtbuf
strstripcpy(@filename, cmdptr)
readtxt(@filename, 0)
flags = flags & ~changed
fin
break
is 'W' // Write file
if ^cmdptr
strstripcpy(@filename, cmdptr)
fin
writetxt(@filename)
//if flags & changed; fin
flags = flags & ~changed
break
is 'C' // Catalog
prfiles(cmdptr); break
is 'P' // Prefix
fileio:setpfx(cmdptr); break
is 'H' // Hardcopy
if ^cmdptr
slot = cmdptr.1 - '0'
else
slot = 1
fin
printtxt(slot)
break
is 'Q' // Quit
exit = chkchng
if not exit
return
fin
break
is 'N'
if chkchng
inittxtbuf
strstripcpy(@filename, "UNTITLED")
fin
break
otherwise
bell
putc('?')
putln
wend
if perr
puts("ERROR: $")
putb(perr)
putln
fin
loop
end
//
// Init editor
//
setkeyin
if not (MACHID & $80) // ][ or ][+
flags = uppercase | shiftlock
fin
inittxtbuf
arg = argNext(argFirst)
if ^arg
strcpy(@filename, arg)
puts(@filename)
readtxt(@filename, 0)
arg = argNext(arg)
if ^arg
cursrow = strtonum(arg)
if cursrow
curshpos(0)
cursvpos(cursrow - 1)
fin
fin
fin
curschr = '+'
flags = flags | insmode | gutter
drawscrn(scrntop, scrnleft)
curson
editmode
done