mirror of
https://github.com/dschmenk/PLASMA.git
synced 2025-04-09 01:37:17 +00:00
Curate some built-in FORTH words and HGRLIB scripts
This commit is contained in:
David Schmenk
parent
68cc31993f
commit
2d4417c698
@ -171,4 +171,5 @@ params:4 = 0
|
||||
params.6 = 0
|
||||
syscall($C8, @params)
|
||||
gfxref = params.3
|
||||
return modkeep
|
||||
done
|
||||
|
||||
@ -1,3 +1,4 @@
|
||||
include "inc/cmdsys.plh"
|
||||
include "inc/hgrtile.plh"
|
||||
//
|
||||
// Apple //e hires character font
|
||||
@ -137,4 +138,6 @@ byte = $00,$2C,$1A,$00,$00,$00,$00,$00,$00,$2A,$14,$2A,$14,$2A,$00,$00
|
||||
export def hgrPutStr(x, y, strptr)#0
|
||||
tileDrawStr(x, y, strptr + 1, ^strptr, @hgrFont + 1024) // Offset into regular char
|
||||
end
|
||||
|
||||
return modkeep
|
||||
done
|
||||
|
||||
@ -121,7 +121,7 @@ export asm divmod7(x)#2
|
||||
BCC +
|
||||
LDY #40 ; > 512 SO CLIP AT MAX
|
||||
LDA #00
|
||||
BEQ +++
|
||||
BEQ +++
|
||||
+ CMP #140
|
||||
BCC +
|
||||
++ SEC
|
||||
@ -332,7 +332,7 @@ export asm hgrCopySrc(ofst, y, w, h, srcptr)#0
|
||||
; LDA ESTKL+0,X ; SRC PTR
|
||||
; STA SRCL
|
||||
; LDA ESTKH+0,X
|
||||
; STA SRCH
|
||||
; STA SRCH
|
||||
-- LDY ESTKL+3,X ; Y COORD
|
||||
LDA ESTKL+4,X ; HORIZ OFFSET
|
||||
CLC
|
||||
@ -383,7 +383,7 @@ export asm hgrAndSrc(ofst, y, w, h, srcptr)#0
|
||||
; LDA ESTKL+0,X ; SRC PTR
|
||||
; STA SRCL
|
||||
; LDA ESTKH+0,X
|
||||
; STA SRCH
|
||||
; STA SRCH
|
||||
-- LDY ESTKL+3,X ; Y COORD
|
||||
LDA ESTKL+4,X ; HORIZ OFFSET
|
||||
CLC
|
||||
@ -435,7 +435,7 @@ export asm hgrXorSrc(ofst, y, w, h, srcptr)#0
|
||||
; LDA ESTKL+0,X ; SRC PTR
|
||||
; STA SRCL
|
||||
; LDA ESTKH+0,X
|
||||
; STA SRCH
|
||||
; STA SRCH
|
||||
-- LDY ESTKL+3,X ; Y COORD
|
||||
LDA ESTKL+4,X ; HORIZ OFFSET
|
||||
CLC
|
||||
@ -487,7 +487,7 @@ export asm hgrOrSrc(ofst, y, w, h, srcptr)#0
|
||||
; LDA ESTKL+0,X ; SRC PTR
|
||||
; STA SRCL
|
||||
; LDA ESTKH+0,X
|
||||
; STA SRCH
|
||||
; STA SRCH
|
||||
-- LDY ESTKL+3,X ; Y COORD
|
||||
LDA ESTKL+4,X ; HORIZ OFFSET
|
||||
CLC
|
||||
@ -524,7 +524,7 @@ end
|
||||
//export def hgrPlot(x, y)#0
|
||||
// word pixptr
|
||||
// byte ofst, pixofst, pmask
|
||||
//
|
||||
//
|
||||
// ofst, pixofst = divmod7(x)
|
||||
// pixptr = hgrscan[y] + drawbuff + ofst
|
||||
// pmask = hbmask[pixofst]
|
||||
@ -570,7 +570,7 @@ end
|
||||
//export def hgrXorPlot(x, y)#0
|
||||
// word pixptr
|
||||
// byte ofst, pixofst, pmask
|
||||
//
|
||||
//
|
||||
// ofst, pixofst = divmod7(x)
|
||||
// pixptr = hgrscan[y] + drawbuff + ofst
|
||||
// pmask = hbmask[pixofst]
|
||||
@ -615,7 +615,7 @@ end
|
||||
//export def hgrOrPlot(x, y)#0
|
||||
// word pixptr
|
||||
// byte ofst, pixofst, pmask
|
||||
//
|
||||
//
|
||||
// ofst, pixofst = divmod7(x)
|
||||
// pixptr = hgrscan[y] + drawbuff + ofst
|
||||
// pmask = hbmask[pixofst]
|
||||
@ -661,7 +661,7 @@ end
|
||||
// word pixptr, x
|
||||
// byte lofst, lpixofst, lpmask
|
||||
// byte rofst, rpixofst, rpmask
|
||||
//
|
||||
//
|
||||
// if x1 == x2
|
||||
// hgrPlot(x1, y)
|
||||
// else
|
||||
@ -779,7 +779,7 @@ end
|
||||
// word pixptr, x
|
||||
// byte lofst, lpixofst, lpmask
|
||||
// byte rofst, rpixofst, rpmask
|
||||
//
|
||||
//
|
||||
// if x1 == x2
|
||||
// hgrPlot(x1, y)
|
||||
// else
|
||||
@ -894,7 +894,7 @@ end
|
||||
//export def hgrVlin(y1, y2, x)#0
|
||||
// word pixptr, y, ofst
|
||||
// byte pixofst, pmask, cmask
|
||||
//
|
||||
//
|
||||
// if y1 == y2
|
||||
// hgrPlot(x, y1)
|
||||
// else
|
||||
@ -925,7 +925,7 @@ end
|
||||
asm _hgrVLinB
|
||||
LDA $2000,Y ; CURHCLR
|
||||
AND TMPL
|
||||
STA TMPL
|
||||
STA TMPL
|
||||
LDY ESTKL+3,X ; Y1 COORD
|
||||
end
|
||||
asm _hgrVLinC
|
||||
@ -954,7 +954,7 @@ end
|
||||
//export def hgrXVlin(y1, y2, x)#0
|
||||
// word pixptr, y, ofst
|
||||
// byte pixofst, pmask, cmask
|
||||
//
|
||||
//
|
||||
// if y1 == y2
|
||||
// hgrXorPlot(x, y1)
|
||||
// else
|
||||
@ -985,7 +985,7 @@ end
|
||||
asm _hgrXVLinB
|
||||
LDA $2000,Y ; CURHCLR
|
||||
AND TMPL
|
||||
STA TMPL
|
||||
STA TMPL
|
||||
LDY ESTKL+3,X ; Y1 COORD
|
||||
end
|
||||
asm _hgrXVLinC
|
||||
@ -1036,13 +1036,13 @@ asm _scanBLTA
|
||||
DEX
|
||||
DEX
|
||||
LDA ESTKL+5,X ; X COORDL
|
||||
STA ESTKL+1,X
|
||||
STA ESTKL+1,X
|
||||
LDA ESTKH+5,X ; X COORDH
|
||||
STA ESTKH+1,X
|
||||
STA ESTKH+1,X
|
||||
LDA ESTKL+4,X ; Y COORDL
|
||||
STA ESTKL+0,X
|
||||
STA ESTKL+0,X
|
||||
LDA ESTKH+4,X ; Y COORDH
|
||||
STA ESTKH+0,X
|
||||
STA ESTKH+0,X
|
||||
PLA
|
||||
AND #$08
|
||||
BEQ +
|
||||
@ -1073,13 +1073,13 @@ asm _scanBLTC
|
||||
DEX
|
||||
DEX
|
||||
LDA ESTKL+5,X ; X COORDL
|
||||
STA ESTKL+1,X
|
||||
STA ESTKL+1,X
|
||||
LDA ESTKH+5,X ; X COORDH
|
||||
STA ESTKH+1,X
|
||||
STA ESTKH+1,X
|
||||
LDA ESTKL+4,X ; Y COORDL
|
||||
STA ESTKL+0,X
|
||||
STA ESTKL+0,X
|
||||
LDA ESTKH+4,X ; Y COORDH
|
||||
STA ESTKH+0,X
|
||||
STA ESTKH+0,X
|
||||
PLA
|
||||
AND #$08
|
||||
BEQ +
|
||||
@ -1105,7 +1105,7 @@ BLTDONE INX
|
||||
end
|
||||
export def hgrRect(x1, y1, x2, y2)#0
|
||||
word y
|
||||
|
||||
|
||||
if x1 == x2
|
||||
hgrVLin(y1, y2, x1)
|
||||
else
|
||||
@ -1116,7 +1116,7 @@ export def hgrRect(x1, y1, x2, y2)#0
|
||||
end
|
||||
export def hgrXorRect(x1, y1, x2, y2)#0
|
||||
word y
|
||||
|
||||
|
||||
if x1 == x2
|
||||
hgrXorVLin(y1, y2, x1)
|
||||
else
|
||||
@ -1129,7 +1129,7 @@ export def hgrBLT(x, y, w, h, srcptr)#0
|
||||
word i, j
|
||||
word saveclr
|
||||
byte c
|
||||
|
||||
|
||||
saveclr = curhclr
|
||||
for j = y to y + h - 1
|
||||
scanBLT(x, j, w, srcptr)
|
||||
@ -1156,25 +1156,40 @@ export def hgrBLT(x, y, w, h, srcptr)#0
|
||||
curhclr = saveclr
|
||||
end
|
||||
export def hgrMode(mode)#1
|
||||
if mode
|
||||
//
|
||||
// Set HGR mode
|
||||
//
|
||||
memset(hgr1, 0, $2000) // Clear HGR page 1
|
||||
^showpage1
|
||||
^showfull
|
||||
^showhires
|
||||
^showgraphics
|
||||
drawpage = 1
|
||||
drawbuff = hgrbuff[1]
|
||||
return 1
|
||||
fin
|
||||
//
|
||||
// Show text mode
|
||||
//
|
||||
^showpage1
|
||||
^showtext
|
||||
return 0
|
||||
when mode
|
||||
is 0
|
||||
//
|
||||
// Show text mode
|
||||
//
|
||||
^showpage1
|
||||
^showtext
|
||||
break
|
||||
is 1
|
||||
//
|
||||
// Set HGR1 mode
|
||||
//
|
||||
memset(hgr1, 0, $2000) // Clear HGR1
|
||||
^showpage1
|
||||
^showfull
|
||||
^showhires
|
||||
^showgraphics
|
||||
drawpage = 1
|
||||
drawbuff = hgrbuff[1]
|
||||
break
|
||||
is 2
|
||||
//
|
||||
// Set HGR2 mode
|
||||
//
|
||||
memset(hgr2, 0, $2000) // Clear HGR2
|
||||
^showpage1
|
||||
^showfull
|
||||
^showhires
|
||||
^showgraphics
|
||||
drawpage = 1
|
||||
drawbuff = hgrbuff[1]
|
||||
break
|
||||
wend
|
||||
return mode
|
||||
end
|
||||
export def hgrClear#0
|
||||
memset(drawbuff, curhclr, drawbuff) // Clear current HGR page
|
||||
@ -1292,4 +1307,5 @@ _scanBLTB:8 = @hgrOrPlot
|
||||
_scanBLTC:1 = @hgrColor
|
||||
_scanBLTD:1 = @hgrPlot
|
||||
_scanBLTD:8 = @hgrOrPlot
|
||||
return modkeep
|
||||
done
|
||||
|
||||
@ -48,13 +48,13 @@ asm _scanMaskA
|
||||
DEX
|
||||
DEX
|
||||
LDA ESTKL+5,X ; X COORDL
|
||||
STA ESTKL+1,X
|
||||
STA ESTKL+1,X
|
||||
LDA ESTKH+5,X ; X COORDH
|
||||
STA ESTKH+1,X
|
||||
STA ESTKH+1,X
|
||||
LDA ESTKL+4,X ; Y COORDL
|
||||
STA ESTKL+0,X
|
||||
STA ESTKL+0,X
|
||||
LDA ESTKH+4,X ; Y COORDH
|
||||
STA ESTKH+0,X
|
||||
STA ESTKH+0,X
|
||||
end
|
||||
asm _scanMaskB
|
||||
JSR $D000 ; HPLOT
|
||||
@ -81,13 +81,13 @@ asm _scanMaskC
|
||||
DEX
|
||||
DEX
|
||||
LDA ESTKL+5,X ; X COORDL
|
||||
STA ESTKL+1,X
|
||||
STA ESTKL+1,X
|
||||
LDA ESTKH+5,X ; X COORDH
|
||||
STA ESTKH+1,X
|
||||
STA ESTKH+1,X
|
||||
LDA ESTKL+4,X ; Y COORDL
|
||||
STA ESTKL+0,X
|
||||
STA ESTKL+0,X
|
||||
LDA ESTKH+4,X ; Y COORDH
|
||||
STA ESTKH+0,X
|
||||
STA ESTKH+0,X
|
||||
end
|
||||
asm _scanMaskD
|
||||
JSR $D000 ; HPLOT
|
||||
@ -109,7 +109,7 @@ def spriteBLTMask(x, y, w, h, srcptr)#0
|
||||
word i, j
|
||||
byte pitch
|
||||
byte c
|
||||
|
||||
|
||||
pitch = (w + 1) / 2
|
||||
for j = y to y + h - 1
|
||||
scanMask(x, j, w, srcptr)
|
||||
@ -127,7 +127,7 @@ def spriteBLTMask(x, y, w, h, srcptr)#0
|
||||
end
|
||||
export def spriteCompile(w, h, xcenter, ycenter, srcptr)#1
|
||||
var sprtptr, bytewidth, spritesize, i
|
||||
|
||||
|
||||
sprtptr = heapalloc(t_sprite)
|
||||
if not sprtptr; return 0; fin
|
||||
bytewidth = (w + 13) / 7
|
||||
@ -160,7 +160,7 @@ end
|
||||
export def spriteDup(sprtsrc)#1
|
||||
var sprtdup
|
||||
byte i
|
||||
|
||||
|
||||
sprtdup = heapalloc(t_sprite)
|
||||
if not sprtdup; return 0; fin
|
||||
memcpy(sprtdup, sprtsrc, t_sprite)
|
||||
@ -171,7 +171,7 @@ end
|
||||
export def spriteRead(filestr)#1
|
||||
var sprtptr, spritesize
|
||||
byte refnum, i
|
||||
|
||||
|
||||
sprtptr = heapalloc(t_sprite)
|
||||
if not sprtptr; return 0; fin
|
||||
refnum = fileio:open(filestr)
|
||||
@ -226,7 +226,7 @@ end
|
||||
export def spriteDraw(sprtptr)#0
|
||||
byte map, pitch, height
|
||||
var ofst, y
|
||||
|
||||
|
||||
y = sprtptr=>s_ypos
|
||||
ofst, map = divmod7(sprtptr=>s_xpos)
|
||||
if ofst & 1
|
||||
@ -252,7 +252,7 @@ end
|
||||
export def spriteDrawXor(sprtptr)#0
|
||||
byte map, pitch, height
|
||||
var ofst, y
|
||||
|
||||
|
||||
y = sprtptr=>s_ypos
|
||||
ofst, map = divmod7(sprtptr=>s_xpos)
|
||||
if ofst & 1
|
||||
@ -282,7 +282,7 @@ end
|
||||
export def spriteUnDrawList#0
|
||||
byte i
|
||||
var undrawptr
|
||||
|
||||
|
||||
undrawptr = undrawList[drawpage]
|
||||
for i = 15 downto 0
|
||||
if undrawptr=>[i]
|
||||
@ -294,7 +294,7 @@ end
|
||||
export def spriteDrawList#0
|
||||
byte i
|
||||
var undrawptr
|
||||
|
||||
|
||||
undrawptr = undrawList[drawpage]
|
||||
for i = 15 downto 0
|
||||
if undrawptr=>[i]
|
||||
@ -311,7 +311,7 @@ end
|
||||
export def spriteUnDrawXorList#0
|
||||
byte i
|
||||
var undrawptr
|
||||
|
||||
|
||||
undrawptr = undrawList[drawpage]
|
||||
for i = 0 to 15
|
||||
if undrawptr=>[i]
|
||||
@ -323,7 +323,7 @@ end
|
||||
export def spriteDrawXorList#0
|
||||
byte i
|
||||
var undrawptr
|
||||
|
||||
|
||||
undrawptr = undrawList[drawpage]
|
||||
for i = 0 to 15
|
||||
if undrawptr=>[i]
|
||||
@ -337,7 +337,7 @@ export def spriteDrawXorList#0
|
||||
end
|
||||
export def spriteAdd(i, sprtptr)#1
|
||||
var sprtprev
|
||||
|
||||
|
||||
i = i & 15
|
||||
sprtprev = drawList[i]
|
||||
drawList[i] = sprtptr
|
||||
@ -345,7 +345,7 @@ export def spriteAdd(i, sprtptr)#1
|
||||
end
|
||||
export def spriteDel(i)#1
|
||||
var sprtprev
|
||||
|
||||
|
||||
i = i & 15
|
||||
sprtprev = drawList[i]
|
||||
drawList[i] = 0
|
||||
@ -362,4 +362,5 @@ _scanMaskA:1 = @hgrColor
|
||||
_scanMaskB:1 = @hgrPlot
|
||||
_scanMaskC:1 = @hgrColor
|
||||
_scanMaskD:1 = @hgrPlot
|
||||
return modkeep
|
||||
done
|
||||
|
||||
@ -55,7 +55,7 @@ TBAS2E = TBAS2L
|
||||
end
|
||||
//export def tileDraw(x, y, tileptr)#0
|
||||
// var scrnptr
|
||||
//
|
||||
//
|
||||
// scrnptr = (scanaddr[y] | drawbuff) + x
|
||||
// scrnptr->[$1C00] = tileptr->[7]
|
||||
// scrnptr->[$1800] = tileptr->[6]
|
||||
@ -99,7 +99,7 @@ asm _tileDraw
|
||||
end
|
||||
//export def tileXorDraw(x, y, tileptr)#0
|
||||
// var scrnptr
|
||||
//
|
||||
//
|
||||
// scrnptr = (scanaddr[y] | drawbuff) + x
|
||||
// scrnptr->[$1C00] = tileptr->[7]
|
||||
// scrnptr->[$1800] = tileptr->[6]
|
||||
@ -145,7 +145,7 @@ asm _tileXDraw
|
||||
end
|
||||
//export def tileOrDraw(x, y, tileptr)#0
|
||||
// var scrnptr
|
||||
//
|
||||
//
|
||||
// scrnptr = (scanaddr[y] | drawbuff) + x
|
||||
// scrnptr->[$1C00] = tileptr->[7]
|
||||
// scrnptr->[$1800] = tileptr->[6]
|
||||
@ -191,7 +191,7 @@ asm _tileODraw
|
||||
end
|
||||
//export def tileAndDraw(x, y, tileptr)#0
|
||||
// var scrnptr
|
||||
//
|
||||
//
|
||||
// scrnptr = (scanaddr[y] | drawbuff) + x
|
||||
// scrnptr->[$1C00] = tileptr->[7]
|
||||
// scrnptr->[$1800] = tileptr->[6]
|
||||
@ -347,11 +347,11 @@ end
|
||||
export def tileFromText(txtpage, tileset)#0
|
||||
byte y
|
||||
word txtptr
|
||||
|
||||
|
||||
txtptr = txtbuff[txtpage & 1]
|
||||
for y = 0 to 23
|
||||
tileDrawStr(0, y, rowaddr[y] | txtptr, 40, tileset)
|
||||
next
|
||||
next
|
||||
end
|
||||
export def tileMode(mode)#1
|
||||
if mode
|
||||
@ -431,5 +431,6 @@ _tileDSb:28 = @_tileDSc.28
|
||||
_tileDSb:33 = @_tileDSc.34
|
||||
_tileDSb:38 = @_tileDSc.40
|
||||
_tileDSb:43 = @_tileDSc.46
|
||||
return modkeep
|
||||
done
|
||||
|
||||
|
||||
@ -1,3 +1,4 @@
|
||||
include "inc/cmdsys.plh"
|
||||
asm asmdefs
|
||||
!SOURCE "vmsrc/plvmzp.inc"
|
||||
SPEAKER = $C030
|
||||
@ -57,4 +58,6 @@ GC1DLY NOP ; TIMING
|
||||
BUZZDLY BNE + ; TIMING
|
||||
+ BNE GC0READ
|
||||
end
|
||||
|
||||
return modkeep
|
||||
done
|
||||
|
||||
@ -44,4 +44,5 @@ export def delay(time)#0
|
||||
call(WAIT,time,0,0,0)
|
||||
end
|
||||
|
||||
return modkeep
|
||||
done
|
||||
|
||||
@ -270,3 +270,6 @@ export def ext2str(ext, str, intdigits, fracdigits, format)
|
||||
^str = istr - str
|
||||
return str
|
||||
end
|
||||
|
||||
return modkeep
|
||||
done
|
||||
|
||||
@ -369,4 +369,6 @@ def reset
|
||||
next
|
||||
return sane:restoreZP(0)
|
||||
end
|
||||
|
||||
return modkeep
|
||||
done
|
||||
|
||||
@ -360,7 +360,7 @@ _DIV STY DVSIGN ; LSB = SIGN OF DVSR
|
||||
ORA ACCUM32+1
|
||||
ORA ACCUM32+2
|
||||
ORA ACCUM32+3
|
||||
BEQ -
|
||||
BEQ -
|
||||
LDA ACCUM32+3 ; DVDND = ACCUM32
|
||||
BPL +
|
||||
LDA #$81 ; DVDND IS NEG
|
||||
@ -654,7 +654,7 @@ export def i32tos(i32ptr, strptr)#1
|
||||
res[t_i32] save
|
||||
word iptr, rem
|
||||
char[12] istr
|
||||
|
||||
|
||||
iptr = @istr.11
|
||||
store32(@save)
|
||||
load32(i32ptr)
|
||||
@ -674,9 +674,10 @@ export def i32tos(i32ptr, strptr)#1
|
||||
end
|
||||
export def puti32(i32ptr)#0
|
||||
char[12] i32str
|
||||
|
||||
|
||||
puts(i32tos(i32ptr, @i32str))
|
||||
end
|
||||
|
||||
return modkeep
|
||||
done
|
||||
|
||||
|
||||
@ -209,7 +209,9 @@ rm -rf prodos/scripts
|
||||
mkdir prodos/scripts
|
||||
cp scripts/plasma.4th prodos/scripts/PLASMA.4TH.TXT
|
||||
cp scripts/grlib.4th prodos/scripts/GRLIB.4TH.TXT
|
||||
cp scripts/hgrlib.4th prodos/scripts/HGRLIB.4TH.TXT
|
||||
cp scripts/bounce.4th prodos/scripts/BOUNCE.4TH.TXT
|
||||
cp scripts/hrbounce.4th prodos/scripts/HRBOUNCE.4TH.TXT
|
||||
|
||||
#mkdir prodos/bld/examples
|
||||
#cp samplesrc/examples/ex.1.pla prodos/bld/examples/EX.1.PLA.TXT
|
||||
|
||||
@ -24,11 +24,15 @@
|
||||
1 VARIABLE INCX
|
||||
1 VARIABLE INCY
|
||||
|
||||
: BEEP 30 10 TONE DROP ;
|
||||
|
||||
: BOOP 10 30 TONE DROP ;
|
||||
|
||||
: MOVEBALL
|
||||
BALLX @ 0= IF INCX @ NEG INCX ! THEN
|
||||
BALLX @ 39 = IF INCX @ NEG INCX ! THEN
|
||||
BALLY @ 0= IF INCY @ NEG INCY ! THEN
|
||||
BALLY @ 47 = IF INCY @ NEG INCY ! THEN
|
||||
BALLX @ 0= IF INCX @ NEGATE INCX ! BEEP THEN
|
||||
BALLX @ 39 = IF INCX @ NEGATE INCX ! BEEP THEN
|
||||
BALLY @ 0= IF INCY @ NEGATE INCY ! BOOP THEN
|
||||
BALLY @ 47 = IF INCY @ NEGATE INCY ! BOOP THEN
|
||||
INCX @ BALLX +!
|
||||
INCY @ BALLY +!
|
||||
BALLCLR @ GRCOLOR
|
||||
|
||||
23
src/scripts/hgrlib.4th
Normal file
23
src/scripts/hgrlib.4th
Normal file
@ -0,0 +1,23 @@
|
||||
LOADMOD" HGRLIB"
|
||||
|
||||
LOOKUP HGRPLOT PLASMA HGRPLOT
|
||||
LOOKUP HGRORPLOT PLASMA HGRORPLOT
|
||||
LOOKUP HGRXORPLOT PLASMA HGRXORPLOT
|
||||
LOOKUP HGRHLIN PLASMA HGRHLIN
|
||||
LOOKUP HGRXORHLIN PLASMA HGRXORHLIN
|
||||
LOOKUP HGRVLIN PLASMA HGRVLIN
|
||||
LOOKUP HGRXORVLIN PLASMA HGRXORVLIN
|
||||
LOOKUP HGRBLT PLASMA HGRBLT
|
||||
LOOKUP HGRRECT PLASMA HGRRECT
|
||||
LOOKUP HGRXORRECT PLASMA HGRXORRECT
|
||||
LOOKUP HGRCOPYSRC PLASMA HGRCOPYSRC
|
||||
LOOKUP HGRANDSRC PLASMA HGRANDSRC
|
||||
LOOKUP HGRXORSRC PLASMA HGRXORSRC
|
||||
LOOKUP HGRORSRC PLASMA HGRORSRC
|
||||
LOOKUP HGRCOPYDST PLASMA HGRCOPYDST
|
||||
LOOKUP HGRCLEAR PLASMA HGRCLEAR
|
||||
LOOKUP HGRMODE PLASMA HGRMODE
|
||||
LOOKUP HGRSHOW PLASMA HGRSHOW
|
||||
LOOKUP HGRSWAP PLASMA HGRSWAP
|
||||
LOOKUP HGRDRAWBUF PLASMA HGRDRAWBUF
|
||||
LOOKUP HGRCOLOR PLASMA HGRCOLOR
|
||||
60
src/scripts/hrbounce.4th
Normal file
60
src/scripts/hrbounce.4th
Normal file
@ -0,0 +1,60 @@
|
||||
: ?PLASMA
|
||||
" IFACE" FIND
|
||||
0= IF
|
||||
" PLASMA.4TH" SRC
|
||||
THEN
|
||||
;
|
||||
|
||||
?PLASMA ( Load PLASMA if not already )
|
||||
|
||||
$6000 HERE - ALLOT ( Reserve HGR2 screen )
|
||||
|
||||
: ?HGRLIB
|
||||
" HGRLIB" FIND
|
||||
0= IF
|
||||
" HGRLIB.4TH" SRC
|
||||
THEN
|
||||
;
|
||||
|
||||
?HGRLIB ( Load HGRLIB if not already )
|
||||
|
||||
5 VARIABLE BALLCLR
|
||||
10 VARIABLE BALLX
|
||||
20 VARIABLE BALLY
|
||||
10 VARIABLE OLDX
|
||||
20 VARIABLE OLDY
|
||||
1 VARIABLE INCX
|
||||
1 VARIABLE INCY
|
||||
|
||||
: BEEP 30 10 TONE DROP ;
|
||||
|
||||
: BOOP 10 30 TONE DROP ;
|
||||
|
||||
: MOVEBALL
|
||||
BALLX @ 0= IF INCX @ NEGATE INCX ! BEEP THEN
|
||||
BALLX @ 279 = IF INCX @ NEGATE INCX ! BEEP THEN
|
||||
BALLY @ 0= IF INCY @ NEGATE INCY ! BOOP THEN
|
||||
BALLY @ 191 = IF INCY @ NEGATE INCY ! BOOP THEN
|
||||
INCX @ BALLX +!
|
||||
INCY @ BALLY +!
|
||||
BALLCLR @ HGRCOLOR
|
||||
BALLX @ BALLY @ HGRPLOT
|
||||
0 HGRCOLOR
|
||||
OLDX @ OLDY @ HGRPLOT
|
||||
BALLX @ OLDX !
|
||||
BALLY @ OLDY !
|
||||
;
|
||||
|
||||
: BOUNCE
|
||||
2 HGRMODE DROP
|
||||
1 HGRDRAWBUF DROP
|
||||
1 HGRSHOW DROP
|
||||
BEGIN
|
||||
MOVEBALL
|
||||
?TERMINAL
|
||||
UNTIL
|
||||
KEY
|
||||
0 HGRMODE DROP
|
||||
;
|
||||
|
||||
( BOUNCE)
|
||||
@ -1,10 +1,11 @@
|
||||
: IFACE 2 * + @ ;
|
||||
|
||||
LOOKUP CMDSYS 0 IFACE CONSTANT PLASMA_VER
|
||||
LOOKUP CMDSYS 2 IFACE CONSTANT CMDLINE
|
||||
LOOKUP CMDSYS 3 IFACE PLASMA EXECMOD
|
||||
LOOKUP STRCPY PLASMA STRCPY
|
||||
LOOKUP STRCAT PLASMA STRCAT
|
||||
LOOKUP CMDSYS 0 IFACE CONSTANT PLASMA_VER
|
||||
LOOKUP CMDSYS 2 IFACE CONSTANT CMDLINE
|
||||
LOOKUP CMDSYS 3 IFACE PLASMA EXECMOD
|
||||
LOOKUP STRCPY PLASMA STRCPY
|
||||
LOOKUP STRCAT PLASMA STRCAT
|
||||
LOOKUP HEAPAVAIL PLASMA FREEMEM
|
||||
|
||||
: .PLASMAVER
|
||||
PLASMA_VER 12 RSHIFT $0F AND 48 + EMIT
|
||||
@ -65,7 +66,7 @@ LOOKUP FILEIO CONSTANT FILEIOAPI
|
||||
FILEIOAPI 0 IFACE PLASMA GETPFX
|
||||
FILEIOAPI 1 IFACE PLASMA SETPFX
|
||||
|
||||
: .PFX
|
||||
: PFX.
|
||||
HERE GETPFX DROP HERE (.")
|
||||
;
|
||||
|
||||
|
||||
@ -8,7 +8,7 @@ include "inc/longjmp.plh"
|
||||
//
|
||||
word vlist
|
||||
word startheap, arg, infunc, inptr, IIP, W
|
||||
const keyinbuf = $1FF
|
||||
word keyinbuf = $1FF
|
||||
const SRCREFS = 2
|
||||
const INBUF_SIZE = 81
|
||||
byte srclevel = 0
|
||||
@ -93,7 +93,8 @@ const hidden_flag = $80
|
||||
// Predefine instrinsics
|
||||
//
|
||||
predef _drop_(a)#0, _swap_(a,b)#2, _dup_(a)#2, _dashdup_(a)#1, _over_(a,b,c)#4, _rot_(a,b,c)#3
|
||||
predef _add_(a,b)#1, _inc_(a)#1, _inc2_(a)#1, _sub_(a,b)#1, _mul_(a,b)#1, _div_(a,b)#1
|
||||
predef _add_(a,b)#1, _inc_(a)#1, _inc2_(a)#1, _dec_(a)#1, _dec2_(a)#1
|
||||
predef _sub_(a,b)#1, _mul_(a,b)#1, _div_(a,b)#1
|
||||
predef _neg_(a)#1, _and_(a,b)#1, _or_(a,b)#1, _xor_(a,b)#1, _not_(a)#1
|
||||
predef _mod_(a,b)#1, _abs_(a)#1, _max_(a,b)#1, _min_(a,b)#1
|
||||
predef _lshift_(a,b)#1, _rshift_(a,b)#1
|
||||
@ -102,19 +103,20 @@ predef _ffa_(a)#1, _lfa_(a)#1, _hfa_(a)#1, _cfa_(a)#1, _pfa_(a)#1, _allot_(a)#0
|
||||
predef _eq_(a,b)#1, _gt_(a,b)#1, _lt_(a,b)#1, _0lt_(a)#1, _0eq_(a)#1
|
||||
predef _branch_#0, _0branch_(a)#0, _if_#0, _else_#0, _then_#0
|
||||
predef _begin_#0, _again_#0, _until_#0, _while_#0, _repeat_#0
|
||||
predef _case_#0, _of_#0, _endof_#0, _endcase_#0, _literal_(a)#0, _iscomp_#1
|
||||
predef _case_#0, _of_#0, _endof_#0, _endcase_#0, _literal_(a)#0
|
||||
predef _dodo_(a,b)#0, _do_#0, _doloop_#0, _doplusloop_(a)#0, _plusloop_#0, _loop_#0, _leave_#0, _j_#1
|
||||
predef _create_#0, _itcdoes_(a)#0, _does_#0, _compoff_#0, _compon_#0
|
||||
predef _forcecomp_#0, pfillw(a)#0, pfillb(a)#0, _colon_#0, _semi_#0
|
||||
predef _immediate_#0, _exit_#0, _pad_#1
|
||||
predef _immediate_#0, _exit_#0, _pad_#1, _trailing_(a,b)#2
|
||||
predef _tors_(a)#0, _fromrs_#1, _toprs_#1, _execute_(a)#0, _lookup_#1
|
||||
predef _cmove_(a,b,c)#0, _move_(a,b,c)#0, _fill_(a,b,c)#0, _plasma_(a)#0
|
||||
predef _move_(a,b,c)#0, _fill_(a,b,c)#0, _plasma_(a)#0
|
||||
predef _var_(a)#0, _const_(a)#0, _lit_#1, _slit_#1, _find_(a)#2, _tick_#1
|
||||
predef _forget_#0, _terminal_#1, _prat_(a)#0, _str_#0, _prstr_#0
|
||||
predef _forget_#0, _terminal_#1, _prat_(a)#0, _str_#0, _prstr_#0, _prpstr_#0
|
||||
predef _prval_(a)#0, _prbyte_(a)#0, _prhex_(a)#0, _accept_(a,b)#1
|
||||
predef _src_(a)#0, _srcstr_#0, _query_#0, _expect_(a,b)#0, _type_(a,b)#0
|
||||
predef _vlist_#0, _tron_#0, _troff_#0, _stepon_#0, _stepoff_#0
|
||||
predef _itc_#0, _pbc_#0, _comment_#0
|
||||
predef _brkout_#0, _brkon_#0, _brkoff_#0, _word_(a)#1, _count_(a)#2
|
||||
predef _brk_#0, _brkon_#0, _brkoff_#0, _word_(a)#1, _count_(a)#2
|
||||
predef _space_#0, _spaces_(a)#0, _show_#0, _showstack_#0, _showrstack_#0
|
||||
predef _showhash_#0, _cont_#0, _restart_#0, _bye_#0, _quit_#0
|
||||
predef _abort_(a)#0, _doabortstr_(a,b)#0, _abortstr_#0
|
||||
@ -154,10 +156,18 @@ word = @d_add, 0, @_inc_, $8C
|
||||
char d_inc2 = "2+"
|
||||
byte = inlinew_flag
|
||||
word = @d_inc, 0, @_inc2_, $8C8C
|
||||
// ONE MINUS
|
||||
char d_dec = "1-"
|
||||
byte = inline_flag
|
||||
word = @d_inc2, 0, @_dec_, $8E
|
||||
// TWO MINUS
|
||||
char d_dec2 = "2-"
|
||||
byte = inlinew_flag
|
||||
word = @d_dec, 0, @_dec2_, $8E8E
|
||||
// SUB
|
||||
char d_sub = "-"
|
||||
byte = inline_flag
|
||||
word = @d_inc2, 0, @_sub_, $84
|
||||
word = @d_dec2, 0, @_sub_, $84
|
||||
// MUL
|
||||
char d_mul = "*"
|
||||
byte = inline_flag
|
||||
@ -175,7 +185,7 @@ char d_mod = "MOD"
|
||||
byte = inline_flag
|
||||
word = @d_divmod, 0, @_mod_, $8A
|
||||
// NEG
|
||||
char d_neg = "NEG"
|
||||
char d_neg = "NEGATE"
|
||||
byte = inline_flag
|
||||
word = @d_mod, 0, @_neg_, $90
|
||||
// AND
|
||||
@ -214,10 +224,18 @@ word = @d_eq, 0, @_gt_, $44
|
||||
char d_lt = "<"
|
||||
byte = inline_flag
|
||||
word = @d_gt, 0, @_lt_, $46
|
||||
// UNSIGNED GREATER THAN
|
||||
char d_ugt = "U>"
|
||||
byte = 0
|
||||
word = @d_lt, 0, @isugt
|
||||
// UNSIGNED LESS THAN
|
||||
char d_ult = "U<"
|
||||
byte = 0
|
||||
word = @d_ugt, 0, @isult
|
||||
// LESS THAN ZERO
|
||||
char d_0lt = "0<"
|
||||
byte = inlinew_flag
|
||||
word = @d_lt, 0, @_0lt_, $4600 // ZERO ISLT
|
||||
word = @d_ult, 0, @_0lt_, $4600 // ZERO ISLT
|
||||
// EQUALS ZERO
|
||||
char d_0eq = "0="
|
||||
byte = inlinew_flag
|
||||
@ -286,18 +304,10 @@ word = @d_plasma, 0, @_var_
|
||||
char d_const = "CONSTANT"
|
||||
byte = 0
|
||||
word = @d_var, 0, @_const_
|
||||
// COMPILING?
|
||||
char d_iscomp = "?COMP"
|
||||
byte = 0
|
||||
word = @d_const, 0, @_iscomp_
|
||||
// CMOVE
|
||||
char d_cmove = "CMOVE"
|
||||
byte = 0
|
||||
word = @d_iscomp, 0, @_cmove_
|
||||
// MOVE
|
||||
char d_move = "MOVE"
|
||||
byte = 0
|
||||
word = @d_cmove, 0, @_move_
|
||||
word = @d_const, 0, @_move_
|
||||
// FILL
|
||||
char d_fill = "FILL"
|
||||
byte = 0
|
||||
@ -414,7 +424,7 @@ word = @d_repeat, 0, @_forget_
|
||||
char d_create = "CREATE"
|
||||
byte = 0
|
||||
word = @d_forget, 0, @_create_
|
||||
// BUILDS
|
||||
// BUILDS ( same as CREATE )
|
||||
char d_builds = "<BUILDS"
|
||||
byte = 0
|
||||
word = @d_create, 0, @_create_
|
||||
@ -478,14 +488,14 @@ word = @d_find, 0, @_tick_
|
||||
char d_cfa = "CFA"
|
||||
byte = 0
|
||||
word = @d_tick, 0, @_cfa_
|
||||
// INLINE LITERAL NUMBER
|
||||
// INLINE LITERAL NUMBER ( not in vocabulary )
|
||||
char d_lit = "LIT"
|
||||
byte = param_flag
|
||||
word = @d_cfa, 0, @_lit_
|
||||
word = 0, 0, @_lit_
|
||||
// COMPILED LITERAL VALUE FROM STACK
|
||||
char d_literal = "LITERAL"
|
||||
byte = imm_flag
|
||||
word = @d_lit, 0, @_literal_
|
||||
word = @d_cfa, 0, @_literal_
|
||||
// ?TERMINAL
|
||||
char d_terminal = "?TERMINAL"
|
||||
byte = 0
|
||||
@ -502,26 +512,34 @@ word = @d_key, 0, @_query_
|
||||
char d_expect = "EXPECT"
|
||||
byte = 0
|
||||
word = @d_query, 0, @_expect_
|
||||
// ACCEPT
|
||||
char d_accept = "ACCEPT"
|
||||
byte = 0
|
||||
word = @d_expect, 0, @_accept_
|
||||
// WORD
|
||||
char d_word = "WORD"
|
||||
byte = 0
|
||||
word = @d_expect, 0, @_word_
|
||||
word = @d_accept, 0, @_word_
|
||||
// -TRAILING
|
||||
char d_trailing = "-TRAILING"
|
||||
byte = 0
|
||||
word = @d_word, 0, @_trailing_
|
||||
// PRINT @TOS
|
||||
char d_prat = "?"
|
||||
byte = 0
|
||||
word = @d_word, 0, @_prat_
|
||||
word = @d_trailing, 0, @_prat_
|
||||
// PRINT TOS
|
||||
char d_prtos = "."
|
||||
byte = 0
|
||||
word = @d_prat, 0, @puti
|
||||
word = @d_prat, 0, @_prval_
|
||||
// PRINT TOS HEX
|
||||
char d_prtoshex = ".$"
|
||||
char d_prtoshex = "$."
|
||||
byte = 0
|
||||
word = @d_prtos, 0, @puth
|
||||
// PRINT TOS HEX
|
||||
char d_prtosbyte = ".C$"
|
||||
word = @d_prtos, 0, @_prhex_
|
||||
// PRINT TOS HEX BYTE
|
||||
char d_prtosbyte = "C$."
|
||||
byte = 0
|
||||
word = @d_prtoshex, 0, @putb
|
||||
word = @d_prtoshex, 0, @_prbyte_
|
||||
// EMIT
|
||||
char d_emit = "EMIT"
|
||||
byte = 0
|
||||
@ -546,27 +564,31 @@ word = @d_spaces, 0, @_type_
|
||||
char d_str = "\""
|
||||
byte = imm_flag
|
||||
word = @d_type, 0, @_str_
|
||||
// LITERAL STRING
|
||||
// LITERAL STRING ( not in vocabulary )
|
||||
char d_slit = "SLIT"
|
||||
byte = param_flag | inline_flag
|
||||
word = @d_str, 0, @_slit_, $2E
|
||||
// COMPILED PRINT STRING
|
||||
word = 0, 0, @_slit_, $2E
|
||||
// PRINT STRING FROM STACK
|
||||
char d_doprstr = "(.\")"
|
||||
byte = 0
|
||||
word = @d_slit, 0, @puts
|
||||
word = @d_str, 0, @puts
|
||||
// PRINT STRING
|
||||
char d_prstr = ".\""
|
||||
byte = imm_flag
|
||||
word = @d_doprstr, 0, @_prstr_
|
||||
// PRINT PAREN STRING
|
||||
char d_prpstr = ".("
|
||||
byte = imm_flag
|
||||
word = @d_prstr, 0, @_prpstr_
|
||||
// READ SOURCE FILE FROM STACK
|
||||
char d_src = "SRC"
|
||||
byte = 0
|
||||
word = @d_prstr, 0, @_src_
|
||||
word = @d_prpstr, 0, @_src_
|
||||
// READ SOURCE FILE FROM INPUT
|
||||
char d_srcstr = "SRC\""
|
||||
byte = 0
|
||||
word = @d_src, 0, @_srcstr_
|
||||
// CONT
|
||||
// CONTINUE AFTER BRK
|
||||
char d_cont = "CONT"
|
||||
byte = 0
|
||||
word = @d_srcstr, 0, @_cont_
|
||||
@ -574,7 +596,7 @@ word = @d_srcstr, 0, @_cont_
|
||||
char d_quit = "QUIT"
|
||||
byte = 0
|
||||
word = @d_cont, 0, @_quit_
|
||||
// ABORT
|
||||
// ABORT IF <> 0
|
||||
char d_abort = "ABORT"
|
||||
byte = 0
|
||||
word = @d_quit, 0, @_abort_
|
||||
@ -586,14 +608,22 @@ word = @d_abort, 0, @_doabortstr_
|
||||
char d_abortstr = "ABORT\""
|
||||
byte = imm_flag
|
||||
word = @d_doabortstr, 0, @_abortstr_
|
||||
// RESTART
|
||||
char d_restart = "RESTART"
|
||||
// COLD RESTART
|
||||
char d_restart = "COLD"
|
||||
byte = 0
|
||||
word = @d_abortstr, 0, @_restart_
|
||||
// COMMENT
|
||||
char d_comment = "("
|
||||
byte = imm_flag
|
||||
word = @d_restart, 0, @_comment_
|
||||
|
||||
//
|
||||
// PLFORTH custom words
|
||||
//
|
||||
// BYE
|
||||
char d_bye = "BYE"
|
||||
byte = 0
|
||||
word = @d_restart, 0, @_bye_
|
||||
word = @d_comment, 0, @_bye_
|
||||
// SHOW DEFINITION
|
||||
char d_show = "SHOW"
|
||||
byte = 0
|
||||
@ -627,13 +657,13 @@ char d_stepoff = "STEPOFF"
|
||||
byte = 0
|
||||
word = @d_stepon, 0, @_stepoff_
|
||||
// BREAK OUT
|
||||
char d_brkout = "BRKOUT"
|
||||
char d_brk = "BRK"
|
||||
byte = 0
|
||||
word = @d_stepoff, 0, @_brkout_
|
||||
word = @d_stepoff, 0, @_brk_
|
||||
// BREAK ON
|
||||
char d_brkon = "BRKON"
|
||||
byte = 0
|
||||
word = @d_brkout, 0, @_brkon_
|
||||
word = @d_brk, 0, @_brkon_
|
||||
// BREAK OFF
|
||||
char d_brkoff = "BRKOFF"
|
||||
byte = 0
|
||||
@ -646,14 +676,13 @@ word = @d_brkoff, 0, @_itc_
|
||||
char d_pbc = "PBC"
|
||||
byte = 0
|
||||
word = @d_itc, 0, @_pbc_
|
||||
// COMMENT
|
||||
char d_comment = "("
|
||||
byte = imm_flag
|
||||
word = @d_pbc, 0, @_comment_
|
||||
//
|
||||
// Start of vocabulary
|
||||
//
|
||||
// LIST VOCAB
|
||||
char d_vlist = "VLIST"
|
||||
byte = 0
|
||||
word = @d_comment, 0, @_vlist_
|
||||
word = @d_pbc, 0, @_vlist_
|
||||
//
|
||||
// Helper routines
|
||||
//
|
||||
@ -666,7 +695,8 @@ def keyin#0
|
||||
|
||||
repeat
|
||||
puts(brk ?? " BRK\n" :: " OK\n")
|
||||
inptr = gets(state & comp_flag ?? ']'|$80 :: '>'|$80)
|
||||
inptr = gets(state & comp_flag ?? ']'|$80 :: '>'|$80)
|
||||
keyinbuf = inptr // Save if needed
|
||||
until ^inptr
|
||||
^(inptr + ^inptr + 1) = 0 // NULL terminate
|
||||
inptr++
|
||||
@ -762,8 +792,7 @@ def find(matchchars, matchlen)#1
|
||||
fin
|
||||
dentry = *(dentry + ^dentry + 4)
|
||||
loop
|
||||
// Not found
|
||||
return 0
|
||||
return 0 // Not found
|
||||
end
|
||||
//
|
||||
// Convert input into number
|
||||
@ -1038,6 +1067,12 @@ end
|
||||
def _inc2_(a)
|
||||
return a + 2
|
||||
end
|
||||
def _dec_(a)
|
||||
return a - 1
|
||||
end
|
||||
def _dec2_(a)
|
||||
return a - 2
|
||||
end
|
||||
def _sub_(a,b)#1
|
||||
return a-b
|
||||
end
|
||||
@ -1176,32 +1211,11 @@ end
|
||||
def _pad_#1
|
||||
return heapmark + 128
|
||||
end
|
||||
def stodci(str, dci)
|
||||
byte len, c
|
||||
|
||||
len = ^str
|
||||
if len == 0
|
||||
^dci = 0
|
||||
return dci
|
||||
fin
|
||||
c = toupper(^(str + len)) & $7F
|
||||
len--
|
||||
^(dci + len) = c
|
||||
while len
|
||||
c = toupper(^(str + len)) | $80
|
||||
len--
|
||||
^(dci + len) = c
|
||||
def _trailing_(a,b)#2
|
||||
while b and ^(a + b) == ' '
|
||||
b--
|
||||
loop
|
||||
return dci
|
||||
end
|
||||
def _lookup_#1
|
||||
word symname
|
||||
char symlen, dci[31]
|
||||
|
||||
symname, symlen = nextword(' ')
|
||||
symname--
|
||||
^symname = symlen
|
||||
return cmdsys:lookupsym(stodci(symname, @dci))
|
||||
return a, b
|
||||
end
|
||||
def newdict#0
|
||||
word bldptr, plist, namechars, namelen
|
||||
@ -1557,28 +1571,41 @@ def _forget_#0
|
||||
buildhashtbl
|
||||
fin
|
||||
end
|
||||
def _cont_#0
|
||||
if brk
|
||||
state = state | exit_flag
|
||||
else
|
||||
putc('?')
|
||||
fin
|
||||
end
|
||||
def _iscomp_#1
|
||||
return state & comp_flag
|
||||
end
|
||||
def _query_#0
|
||||
inptr = gets('>'|$80)
|
||||
inptr = gets('?'|$80)
|
||||
^(inptr + ^inptr + 1) = 0
|
||||
inptr++
|
||||
end
|
||||
def _expect_(a,b)#0
|
||||
inptr = gets('>'|$80)
|
||||
word saveinptr
|
||||
|
||||
saveinptr = inptr
|
||||
memcpy(heapmark + 256, keyinbuf, 80)
|
||||
inptr = gets('?'|$80)
|
||||
if ^inptr > b
|
||||
^inptr = b
|
||||
fin
|
||||
^(inptr + ^inptr + 1) = 0
|
||||
memcpy(a, inptr + 1, ^inptr)
|
||||
memcpy(keyinbuf, heapmark + 256, 80)
|
||||
inptr = saveinptr
|
||||
end
|
||||
def _accept_(a,b)#1
|
||||
word saveinptr
|
||||
byte len
|
||||
|
||||
saveinptr = inptr
|
||||
memcpy(heapmark + 256, keyinbuf, 80)
|
||||
inptr = gets('?'|$80)
|
||||
len = ^inptr
|
||||
if len > b
|
||||
len = b
|
||||
fin
|
||||
^(inptr + len + 1) = 0
|
||||
memcpy(a, inptr + 1, len)
|
||||
memcpy(keyinbuf, heapmark + 256, 80)
|
||||
inptr = saveinptr
|
||||
return len
|
||||
end
|
||||
def _terminal_#1
|
||||
return ^$C000 > 127
|
||||
@ -1592,9 +1619,6 @@ def _word_(a)#1
|
||||
^wordptr = len
|
||||
return wordptr
|
||||
end
|
||||
def _prat_(a)#0
|
||||
puti(*a)
|
||||
end
|
||||
def _space_#0
|
||||
putc(' ')
|
||||
end
|
||||
@ -1604,6 +1628,18 @@ def _spaces_(a)#0
|
||||
a--
|
||||
loop
|
||||
end
|
||||
def _prval_(a)#0
|
||||
puti(a); putc(' ')
|
||||
end
|
||||
def _prbyte_(a)#0
|
||||
putb(a); putc(' ')
|
||||
end
|
||||
def _prhex_(a)#0
|
||||
puth(a); putc(' ')
|
||||
end
|
||||
def _prat_(a)#0
|
||||
puti(*a); putc(' ')
|
||||
end
|
||||
def _str_#0
|
||||
word str
|
||||
byte len
|
||||
@ -1621,7 +1657,7 @@ def _str_#0
|
||||
fin
|
||||
end
|
||||
def _type_(a,b)#0
|
||||
while b
|
||||
while b and ^a
|
||||
putc(^a)
|
||||
a++
|
||||
b--
|
||||
@ -1641,6 +1677,47 @@ def _prstr_#0
|
||||
puts(str)
|
||||
fin
|
||||
end
|
||||
def _prpstr_#0
|
||||
word str
|
||||
byte len
|
||||
|
||||
if state & comp_flag
|
||||
_str_
|
||||
compword(@d_doprstr)
|
||||
else
|
||||
str, len = nextword(')')
|
||||
str--
|
||||
^str = len
|
||||
puts(str)
|
||||
fin
|
||||
end
|
||||
def stodci(str, dci)
|
||||
byte len, c
|
||||
|
||||
len = ^str
|
||||
if len == 0
|
||||
^dci = 0
|
||||
return dci
|
||||
fin
|
||||
c = toupper(^(str + len)) & $7F
|
||||
len--
|
||||
^(dci + len) = c
|
||||
while len
|
||||
c = toupper(^(str + len)) | $80
|
||||
len--
|
||||
^(dci + len) = c
|
||||
loop
|
||||
return dci
|
||||
end
|
||||
def _lookup_#1
|
||||
word symname
|
||||
char symlen, dci[31]
|
||||
|
||||
symname, symlen = nextword(' ')
|
||||
symname--
|
||||
^symname = symlen
|
||||
return cmdsys:lookupsym(stodci(symname, @dci))
|
||||
end
|
||||
def _src_(a)#0
|
||||
if srclevel >= SRCREFS
|
||||
puts("Too many nested SRC")
|
||||
@ -1760,8 +1837,8 @@ def brkpoint#0
|
||||
(*_cfa_(brkentry))()#0
|
||||
fin
|
||||
end
|
||||
def _brkout_#0
|
||||
brkhandle(@d_brkout)
|
||||
def _brk_#0
|
||||
brkhandle(@d_brk)
|
||||
end
|
||||
def _brkon_#0
|
||||
word dentry
|
||||
@ -1783,6 +1860,13 @@ def _brkoff_#0
|
||||
*_cfa_(brkentry) = brkcfa
|
||||
brkcfa = 0
|
||||
end
|
||||
def _cont_#0
|
||||
if brk
|
||||
state = state | exit_flag
|
||||
else
|
||||
putc('?')
|
||||
fin
|
||||
end
|
||||
def _itc_#0
|
||||
comp_mode = comp_itc_flag
|
||||
end
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user