mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-11-26 02:49:17 +00:00
4736 lines
174 KiB
Plaintext
4736 lines
174 KiB
Plaintext
clv06jan88
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ Directory of uf-Ed-clv06jan clv02feb88
|
||
|
||
|
||
3 files
|
||
4 .page in Forth
|
||
5 >scr CBM-Screencode-Conversion
|
||
6 scrAdr curAdr cols rows
|
||
7- 9 screen Output-Vektor
|
||
10-13 .page in Assembler
|
||
16-19 .page 2.versuch
|
||
20 Edi-Test
|
||
40 "
|
||
60 "
|
||
85ff shadows
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ test clv12jan88
|
||
|
||
|
||
$100 $100 Task testtask
|
||
|
||
multitask
|
||
|
||
: tt testtask activate
|
||
BEGIN $80 $c00 ctoggle pause REPEAT ;
|
||
|
||
\ revers on/off at top left corner
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ files clv20jan88
|
||
|
||
| : skp bus@ drop bus@ drop ;
|
||
| : wrd bus@ bus@ $100 * + . ;
|
||
| : str
|
||
BEGIN bus@ ?dup WHILE emit REPEAT ;
|
||
|
||
: files \ Filename kann folgen
|
||
(drv @ 8 +
|
||
dup 0 busopen
|
||
" $0:" count bustype
|
||
bl parse bustype
|
||
" *" count bustype
|
||
busoff derror? ?exit
|
||
dup 0 busin
|
||
|
||
skp skp \ Sector,Zeilenlink
|
||
BEGIN cr wrd str skp $90 c@ UNTIL
|
||
|
||
0 busclose derror? ?exit ;
|
||
|
||
|
||
|
||
|
||
|
||
\ .line .page in Forth clv11jan88
|
||
|
||
: >count ( ad l ad+ l- --ad+ l- ad cnt)
|
||
2swap 2 pick - ;
|
||
|
||
: .line ( adr len col--adr+ len- col)
|
||
>r 2dup #cr scan >count
|
||
r@ - swap r@ + swap
|
||
0 max cols umin type
|
||
dup IF 1- swap 1+ swap THEN r> ;
|
||
|
||
: xpage 0 0 at $0c00 $400 $2e fill ;
|
||
|
||
: .page1 ( adr len col-- adr+ len- col)
|
||
xpage rows 1
|
||
DO .line cr LOOP .line ;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ >scr clv19jan88
|
||
|
||
: Char: Create ;code ( char--char')
|
||
sp x) lda tax .a lsr .a lsr .a lsr
|
||
.a lsr .a lsr .a asl tay iny iny
|
||
txa iny W )y and dey W )y ora
|
||
0 # ldx sp x) sta
|
||
1 # ldy next jmp end-code
|
||
|
||
Char: >scr ( +--or---+ +---and--+ )
|
||
( $0-1f) Ascii . c, 0 c,
|
||
( 20-3f) %00000000 c, %11111111 c,
|
||
( 40-5f) %00000000 c, %00011111 c,
|
||
( 60-7f) %00000000 c, %01011111 c,
|
||
( 80-9f) Ascii . c, 0 c,
|
||
( a0-bf) Ascii . c, 0 c,
|
||
( c0-df) %00000000 c, %01011111 c,
|
||
( e0-ff) Ascii . c, 0 c,
|
||
|
||
\needs scrAdr -->
|
||
|
||
\\ : C> Create does> ( char--char')
|
||
>r dup 2/ 2/ 2/ 2/ 2/ 2* r> +
|
||
dup c@ -rot 1+ c@ and or ;
|
||
|
||
\ scrAdr curAdr cols rows clv11jan88
|
||
|
||
$0c00 Constant scrAdr
|
||
Variable curAdr scrAdr curAdr !
|
||
&40 Constant cols
|
||
&25 Constant rows
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ screen Output-Vektor clv11jan88
|
||
|
||
|
||
|
||
|
||
\needs >scr 5 load \ CBM-Screencodes
|
||
\ & scrAdr ..
|
||
1 2 +thru
|
||
|
||
|
||
|
||
|
||
\\ curon/off muss gepatched werden, da
|
||
dummerweise nicht vektorisiert
|
||
|
||
' c64key >body Constant >curon
|
||
' c64key >body $a + Constant >curoff
|
||
|
||
: scrOn screen keyboard
|
||
['] scrcur dup >curon ! >curoff !
|
||
save ;
|
||
|
||
: scrOff display [ editor ] ediboard
|
||
['] curon >curon !
|
||
['] curoff >curoff ! save ;
|
||
\ ..screen.. clv11jan88
|
||
|
||
|
||
: scrpage scrAdr [ cols rows * ] Literal
|
||
bl fill scrAdr curAdr ! ;
|
||
|
||
: scroll
|
||
scrAdr dup cols + swap
|
||
[ cols rows 1- * ] Literal cmove
|
||
[ scrAdr cols rows 1- * + ] Literal
|
||
cols bl fill cols negate curAdr +! ;
|
||
|
||
: ?scroll
|
||
[ scrAdr cols rows * + ] Literal
|
||
curAdr @ - ?exit scroll ;
|
||
|
||
: scrcur
|
||
?scroll $80 curAdr @ ctoggle ;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ ..screen clv11jan88
|
||
|
||
: scrat? ( --row col)
|
||
curAdr @ scrAdr - cols u/mod swap ;
|
||
|
||
: scrat ( row col--)
|
||
swap cols * + scrAdr + curAdr !
|
||
?scroll ;
|
||
|
||
: scrcr scrat? drop 1+ 0 scrat ;
|
||
|
||
: scremit ( char--) >scr \ cbmScreenCode
|
||
?scroll curAdr @ c! 1 curAdr +! ;
|
||
|
||
: scrtype ( adr +n--)
|
||
bounds ?DO I c@ scremit LOOP ;
|
||
|
||
: scrdel
|
||
-1 curAdr +! bl scremit -1 curAdr +! ;
|
||
|
||
Output: screen
|
||
scremit scrcr scrtype scrdel scrpage
|
||
scrat scrat? ;
|
||
|
||
|
||
\ .page clv14jan88
|
||
|
||
Onlyforth
|
||
|
||
\needs >scr 5 load \ CBM-Screencodes
|
||
|
||
' >scr >body >Label scrtab
|
||
|
||
Label (>scr ( AR=char;char') \ XR<>
|
||
\ converts char to CBM-Screencode
|
||
pha .a lsr .a lsr .a lsr .a lsr .a lsr
|
||
.a asl
|
||
tax pla inx scrtab ,x and
|
||
dex scrtab ,x ora
|
||
rts end-code
|
||
|
||
\ N:curCol +2:len +4:adr +6:actLn
|
||
\ +8:tmpCol +a:exitSp YR=col
|
||
|
||
-->
|
||
|
||
|
||
|
||
|
||
|
||
\ (emit 3.vers clv14jan88
|
||
|
||
Label neg ( XR=adr;) \ 2erKompl von adr
|
||
sec 0 # lda 0 ,x sbc 0 ,x sta
|
||
0 # lda 1 ,x sbc 1 ,x sta rts
|
||
|
||
Label pClr ( N+6:curLn,YR=col)
|
||
\ clears end of Line, exit on screenEnd
|
||
bl # lda
|
||
[[ cols # cpy 0<>
|
||
?[[ N 6 + )y sta iny ]]?
|
||
clc cols # lda N 6 + adc N 6 + sta
|
||
CS ?[ N 7 + inc ]? 0 # ldy
|
||
scrAdr cols rows * + $100 u/mod N 6 +
|
||
dup 1+ lda swap # cmp CC ?[ rts ]?
|
||
lda # cmp CC ?[ rts ]?
|
||
N $a + ldx txs \ Screen:End reached
|
||
N 2+ # ldx neg jsr 0 # ldx
|
||
3 # lda \ setback to stack
|
||
.A asl tay [[ SP dec dey 0= ?] tay dey
|
||
[[ N ,y lda SP )y sta dey 0= ?] iny
|
||
next jmp end-code
|
||
-->
|
||
|
||
|
||
\ pPut pGet pCol clv11jan88
|
||
|
||
Label pPut ( AR=char;)
|
||
\ puts char on screen. Noop if beyond
|
||
cols # cpy CC
|
||
?[ (>scr jsr 0 # ldx N 6 + )y sta iny
|
||
]? rts end-code
|
||
|
||
Label pGet ( ;AR:char,Z:char==#cr)
|
||
\ char from RAM. Ends Page if exhausted
|
||
N 4 + winc N 2+ winc
|
||
0<> ?[ N 4 + x) lda #cr # cmp rts ]?
|
||
[[ pClr jsr ]] end-code \ stream:end
|
||
|
||
Label pCol \ skips cols left of screen
|
||
N 8 + N 2dup lda sta 1+ lda 1+ sta
|
||
N 8 + dup winc # ldx neg jsr 0 # ldx
|
||
[[ N 8 + winc 0= ?[ rts ]?
|
||
pGet jsr 0=
|
||
?[ pClr jsr pCol jmp ]? ]] end-code
|
||
|
||
|
||
-->
|
||
|
||
|
||
\ .page clv14jan88
|
||
|
||
Code .page ( adr len col--ad+ len- col)
|
||
|
||
\ displays text at adr/len
|
||
\ interprets #cr,skips col (left of scr)
|
||
|
||
\ setup of N... y
|
||
3 # lda setup jsr N 2+ # ldx neg jsr
|
||
\ setup of actLn
|
||
N 6 + ' scrAdr >body 2dup
|
||
lda sta
|
||
1+ lda 1+ sta
|
||
tsx N $a + stx \ Exit SP
|
||
0 # ldx 0 # ldy
|
||
N 4 + wdec N 2+ wdec
|
||
\ MainLoop
|
||
[[ pCol jsr
|
||
[[ pGet jsr 0<> ?[[ pPut jsr ]]?
|
||
pClr jsr ]] end-code
|
||
|
||
|
||
|
||
|
||
|
||
\ .page 2.Versuch mit fOut/In clv25jan88
|
||
|
||
Onlyforth
|
||
|
||
\needs >scr 5 load \ CBM-Screencodes
|
||
|
||
' >scr >body >Label scrtab
|
||
|
||
Label (>scr ( AR=char;char') \ XR<>
|
||
\ converts char to CBM-Screencode
|
||
pha .a lsr .a lsr .a lsr .a lsr .a lsr
|
||
.a asl
|
||
tax pla inx scrtab ,x and
|
||
dex scrtab ,x ora
|
||
rts end-code
|
||
|
||
\ N:scrCol +2:adr +4:none +6:actLn
|
||
\ +8:tmpCol +a:exitSp YR=col
|
||
|
||
-->
|
||
|
||
|
||
|
||
|
||
|
||
\ (emit 3.vers clv25jan88
|
||
|
||
Label neg ( XR=adr;) \ 2erKompl von adr
|
||
sec 0 # lda 0 ,x sbc 0 ,x sta
|
||
0 # lda 1 ,x sbc 1 ,x sta rts
|
||
|
||
Label pClr ( N+6:curLn,YR=col)
|
||
\ clears end of Line, exit on screenEnd
|
||
bl # lda
|
||
[[ cols # cpy 0<>
|
||
?[[ N 6 + )y sta iny ]]?
|
||
clc cols # lda N 6 + adc N 6 + sta
|
||
CS ?[ N 7 + inc ]? 0 # ldy
|
||
scrAdr cols rows * + $100 u/mod N 6 +
|
||
dup 1+ lda swap # cmp CC ?[ rts ]?
|
||
lda # cmp CC ?[ rts ]?
|
||
N $a + ldx txs \ Screen:End reached
|
||
SP 2dec 0 # ldx 1 # ldy
|
||
N 2+ lda SP x) sta
|
||
N 3+ lda SP )y sta
|
||
next jmp end-code
|
||
-->
|
||
|
||
|
||
|
||
\ pPut pGet pCol clv25jan88
|
||
|
||
Label pPut ( AR=char;)
|
||
\ puts char on screen. Noop if beyond
|
||
cols # cpy CC
|
||
?[ (>scr jsr 0 # ldx N 6 + )y sta iny
|
||
]? rts end-code
|
||
|
||
Label pGet ( ;AR:char,Z:char==#cr)
|
||
\ char from RAM. Ends Page if exhausted
|
||
N 2+ winc
|
||
|
||
N 2+ lda fOut cmp 0= \ fOut reached?
|
||
?[ N 3 + lda fOut 1+ cmp 0=
|
||
?[ N 2+ fIn 2dup \ ..use fIn
|
||
lda sta 1+ lda 1+ sta ]? ]?
|
||
N 2+ lda fEnd cmp 0= \ fEnd reached?
|
||
?[ N 3 + lda fEnd 1+ cmp 0=
|
||
?[ [[ pClr jsr ]] ]? ]? \ ..clrPg
|
||
N 2 + x) lda #cr # cmp
|
||
rts end-code
|
||
-->
|
||
|
||
|
||
|
||
\ .page clv29jan88
|
||
|
||
Label pCol \ skips cols left of screen
|
||
N 8 + N 2dup lda sta 1+ lda 1+ sta
|
||
N 8 + dup winc # ldx neg jsr 0 # ldx
|
||
[[ N 8 + winc 0= ?[ rts ]?
|
||
pGet jsr 0=
|
||
?[ pClr jsr pCol jmp ]? ]] end-code
|
||
|
||
Code .page2 ( adr col--ad+)
|
||
\ uses fOut,fIn,fEnd
|
||
\ displays text at adr/len
|
||
\ interprets #cr,skips col (left of scr)
|
||
\ setup of N...
|
||
2 # lda setup jsr
|
||
\ setup of actLn
|
||
N 6 + ' scrAdr >body 2dup
|
||
lda sta 1+ lda 1+ sta
|
||
tsx N $a + stx \ Exit SP
|
||
0 # ldx 0 # ldy
|
||
N 2 + wdec
|
||
\ MainLoop
|
||
[[ pCol jsr
|
||
[[ pGet jsr 0<> ?[[ pPut jsr ]]?
|
||
pClr jsr ]] end-code
|
||
clv11jan88
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
clv11jan88
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ Edi-Test-3 clv22feb88
|
||
|
||
\ mit Transfers-Luecke, .page in Forth,
|
||
\ ziemlich langsam
|
||
: tt limit $e800 -
|
||
IF $e800 ['] limit >body ! &20 buffers
|
||
THEN ;
|
||
tt forget tt
|
||
|
||
Onlyforth
|
||
: rl [ blk @ ] Literal l ;
|
||
|
||
\needs memtop $fd00 Constant memtop
|
||
|
||
1 +load \ Variables
|
||
\needs >scr 5 load
|
||
2 &19 +thru
|
||
|
||
|
||
\ forget initFile 2 &19 +thru
|
||
: .x over u. ." :" type ;
|
||
: .. fBeg @ fOut @ over - .x
|
||
fIn @ fEnd @ over - .x cr ;
|
||
|
||
|
||
\ Variables clv25jan88
|
||
|
||
Variable lastKey
|
||
Variable curPos
|
||
Variable scrBeg Variable scrCol
|
||
|
||
Variable exitRP
|
||
|
||
Variable tab \ key-Tab
|
||
|
||
|
||
Create fName $20 allot
|
||
Variable fBeg Variable fEnd
|
||
Variable fOut \ Beginn von room
|
||
Variable fIn \ Ende von room
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ edi-test info clv25jan88
|
||
|
||
: wait BEGIN key? UNTIL ;
|
||
|
||
|
||
: sat cols 1- min swap rows 1- min swap
|
||
at ;
|
||
: .at 0 10 at 2dup swap . . ." AT" sat ;
|
||
Defer 'at ' .at Is 'at
|
||
|
||
: wderror? derror? dup IF wait THEN ;
|
||
Defer 'derror? ' wderror? Is 'derror?
|
||
|
||
: .v ( adr--) base push hex cr dup
|
||
@ 5 u.r ." " 2- >name .name ." !" ;
|
||
: .i cr .s curPos .v scrCol .v fbeg .v
|
||
scrbeg .v fOut .v fIn .v fend .v
|
||
cr fbeg @ 1- c@ . fend @ @ . cr ;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ fileOut/In clv25jan88
|
||
|
||
: fType ( from u --)
|
||
fOut @ 2dup + ( fr u fOut@ fOut@+u )
|
||
dup fIn @ u> abort" no room" fOut !
|
||
( fr u fOut@) swap cmove ;
|
||
: fEmit ( char--) sp@ 1 fType drop ;
|
||
: fCr #cr fEmit ;
|
||
: fDel fOut @ 1- fBeg @ umax fOut ! ;
|
||
: fPage
|
||
fBeg @ fOut @ over - ( from count)
|
||
over fIn @ fOut @ - + swap cmove>
|
||
fBeg @ dup fOut !
|
||
fIn @ fOut @ - + fIn ! ;
|
||
: fAt 2drop ; : fAt? 0.0 ;
|
||
Output: fileOut
|
||
fEmit fCr fType fDel fPage fAt fAt? ;
|
||
|
||
: fKey? ( --flag) fIn @ fEnd @ u< ;
|
||
: fKey ( -- 8b)
|
||
fKey? IF fIn @ c@ 1 fIn +! exit THEN
|
||
$1a ;
|
||
Input: fileIn
|
||
fKey fKey? c64decode c64expect ;
|
||
|
||
\ tva cr? fe? clv30jan88
|
||
|
||
\needs Code .( ??! Code ??!) quit
|
||
Assembler
|
||
\needs wcmp .( ??! wcmp[debug] ??!) quit
|
||
|
||
Code cr? ( adr--adr flag)
|
||
SP x) lda N sta SP )y lda N 1+ sta
|
||
N x) lda #cr # cmp 0<> ?[
|
||
Label (fe?
|
||
N fEnd wcmp CC ?[
|
||
N fBeg wcmp CS ?[
|
||
0 # lda pushA jmp ]? ]? ]?
|
||
$ff # lda pushA jmp end-code
|
||
Code fe?
|
||
SP x) lda N sta SP )y lda N 1+ sta
|
||
(fe? jmp
|
||
Code c? ( adr--adr flag)
|
||
SP x) lda N sta SP )y lda N 1+ sta
|
||
N fIn wcmp CC ?[
|
||
N fOut wcmp CS ?[
|
||
0 # lda pushA jmp ]? ]?
|
||
$ff # lda pushA jmp end-code
|
||
|
||
|
||
\ c? bl? ..< ..> clv30jan88
|
||
|
||
\ fuer Laufzeitmessung:
|
||
: cr? cr? ; : fe? fe? ; : c? c? ;
|
||
|
||
( adr--adr flag)
|
||
: bl? cr? over c@ bl = or ; \ space
|
||
|
||
( adr--adr)
|
||
: c< 1- c? ?exit drop fOut @ 1- ;
|
||
: c> 1+ c? ?exit drop fIn @ ;
|
||
: bl> BEGIN c> bl? not UNTIL ;
|
||
: cr> c> ;
|
||
: w< BEGIN c< bl? UNTIL ; \ word
|
||
: w> BEGIN c> bl? UNTIL ;
|
||
: l< BEGIN c< cr? UNTIL ; \ line
|
||
: l> BEGIN c> cr? UNTIL ;
|
||
: p> rows 0 DO l> LOOP ;
|
||
: p< rows 0 DO l< LOOP ;
|
||
|
||
: l<? ( cur--cur col) dup dup l< 1+ - ;
|
||
\\
|
||
: fe? dup fBeg @ fEnd @ uwithin not ;
|
||
: cr? dup c@ #cr = swap fe? or ;
|
||
: c? dup fOut @ fIn @ uwithin not ;
|
||
\ initFile clv30jan88
|
||
|
||
: initFile $100 \ cursorRoom
|
||
fBeg @ 2dup + over fEnd @ swap -
|
||
cmove>
|
||
fBeg @ dup fOut ! over + fIn !
|
||
fEnd +! $0d0d fEnd @ !
|
||
fOut @ curPos ! ;
|
||
|
||
: moveroom ( curAdr --)
|
||
dup curPos ! c? not IF drop exit THEN
|
||
fOut @ u<
|
||
IF curPos @ fIn @ fOut @ - curPos @ +
|
||
fOut @ curPos @ -
|
||
dup negate dup fOut +! fIn +!
|
||
cmove>
|
||
ELSE fIn @ fOut @ curPos @ fIn @ -
|
||
dup dup fOut +! fIn +!
|
||
fOut @ curPos ! cmove THEN ;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ baseMovements clv25jan88
|
||
|
||
: << ( --curAdr) curPos @ ;
|
||
: >> ( curAdr--)
|
||
fBeg @ umax fEnd @ umin moveroom ;
|
||
|
||
|
||
\ : c+ ( col+ cur-)
|
||
\ 1- l> >> << l< 1+ + ;
|
||
|
||
: <<c ( --col lin)
|
||
<< dup l< under - swap ;
|
||
: c>> ( col lin--) l> >> << l< + >> ;
|
||
: c+ ( col lin col+--col lin)
|
||
rot + swap ;
|
||
: c= ( col lin col=--col lin)
|
||
swap rot drop ;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ executables clv28jan88
|
||
|
||
( --)
|
||
|
||
: begLn << l< cr> >> ;
|
||
: endLn << l> >> ;
|
||
: up <<c l< c>> ;
|
||
: down <<c l> c>> ;
|
||
: lastPg <<c p< c>> ;
|
||
: nextPg <<c p> c>> ;
|
||
: begPg <<c drop scrBeg @ c>> ;
|
||
: endPg <<c drop scrBeg @ p> l< c>> ;
|
||
: beg <<c drop fBeg @ c< c>> ;
|
||
: end <<c drop fEnd @ l< c>> ;
|
||
: right <<c 1 c+ c>> ;
|
||
: left <<c -1 c+ c>> ;
|
||
|
||
: begScr <<c scrCol @ c= c>> ;
|
||
: endScr <<c scrCol @ cols + 1- c= c>> ;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ ..exe clv28jan88
|
||
|
||
: doChar << dup fOut @ - 0 max 0
|
||
?DO bl fEmit LOOP
|
||
lastKey @ fEmit c> >> ;
|
||
: backDel curPos @ fOut @ =
|
||
IF fdel THEN left ;
|
||
: delChar right backDel ;
|
||
: exitEd exitRp @ rp! ;
|
||
: info at? 5 0 at
|
||
2dup swap cr . . ." at" .i
|
||
wait at ;
|
||
: help tab @ BEGIN count WHILE
|
||
dup @ >name .name 2+ REPEAT
|
||
drop wait ;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ leer clv28jan88
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ writeFile readFile clv25jan88
|
||
|
||
Onlyforth
|
||
|
||
: writeFile 0 (drv !
|
||
8 2 busopen fName count bustype
|
||
" ,p,w" count bustype busoff
|
||
'derror? ?exit
|
||
8 2 busout 0 0 bus! bus!
|
||
fEnd @ fBeg @
|
||
BEGIN 2dup - WHILE
|
||
dup c@ bus! c> REPEAT busoff
|
||
8 2 busclose 'derror? ?exit ;
|
||
|
||
: readFile 0 (drv !
|
||
8 2 busopen fName count bustype
|
||
" ,p,r" count bustype busoff
|
||
'derror? ?exit fBeg @
|
||
8 2 busin bus@ drop bus@ drop
|
||
BEGIN bus@ over c! 1+ $90 c@ UNTIL
|
||
fEnd ! busoff
|
||
8 2 busclose 'derror? ?exit initFile ;
|
||
|
||
|
||
|
||
\ files clv25jan88
|
||
|
||
| : skp bus@ drop bus@ drop ;
|
||
| : wrd bus@ bus@ $100 * + . ;
|
||
| : str
|
||
BEGIN bus@ ?dup WHILE emit REPEAT ;
|
||
|
||
: files \ Filename kann folgen
|
||
(drv @ 8 +
|
||
dup 0 busopen
|
||
" $0:" count bustype
|
||
bl parse bustype
|
||
" *" count bustype
|
||
busoff derror? ?exit
|
||
dup 0 busin
|
||
skp skp \ Sector,Zeilenlink
|
||
BEGIN cr wrd str skp $90 c@ UNTIL
|
||
0 busclose 'derror? ?exit wait ;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ loadFile clv28jan88
|
||
|
||
\\ noch alt
|
||
|
||
: fLine #tib @ >tib @ + 1+
|
||
dup fEnd @ u> IF drop rdrop exit THEN
|
||
dup 1- l> over - #tib ! >tib !
|
||
>in off ;
|
||
: .fLine
|
||
cr >tib @ dup 5 u.r space
|
||
#tib @ type space ;
|
||
|
||
: xx
|
||
>tib push #tib push >in push r0 push
|
||
['] 'quit >body push
|
||
['] unnest Is 'quit
|
||
['] .status >body push
|
||
rp@ r0 ! page
|
||
['] .fLine Is .status
|
||
curPos @ >tib ! -1 #tib !
|
||
BEGIN fLine .status interpret REPEAT ;
|
||
|
||
: loadFile
|
||
curPos ! >r xx r> curPos @ wait ;
|
||
|
||
\ fconvey clv28jan88
|
||
|
||
\ noch ungetestet
|
||
|
||
: fConvey ( [from to]--)
|
||
1+ swap \ curPos @ -rot
|
||
?DO rows 0
|
||
DO #cr fEmit
|
||
J block I c/l * + c/l fType
|
||
LOOP 1 fDel LOOP ( drop ) ;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ .page 4.Ver Forth clv30jan88
|
||
|
||
: pPut ( char--)
|
||
>scr curAdr @ c! 1 curAdr +! ;
|
||
|
||
: pSpc ( u--) \ puts u spaces
|
||
curAdr @ over bl fill curAdr +! ;
|
||
|
||
: leap rdrop rdrop rdrop rdrop ;
|
||
|
||
: .line ( col adr--col ad+)
|
||
over 0 ?DO c> cr?
|
||
IF cols pSpc leap THEN LOOP
|
||
cols 0 DO c> cr?
|
||
IF cols I - pSpc leap THEN
|
||
dup c@ pPut LOOP l> ;
|
||
|
||
: .page ( adr col--ad+)
|
||
\ interprets cr,skips cols left of scr
|
||
scrAdr curAdr !
|
||
swap rows 0 DO .line LOOP nip ;
|
||
|
||
\ -&21 #entries +! forget pPut 0 4 +thru
|
||
|
||
|
||
\ redraw show clv29jan88
|
||
|
||
: redraw curPos @
|
||
BEGIN scrBeg @ scrCol @ .page
|
||
over u< WHILE
|
||
dup p< scrBeg ! REPEAT drop ;
|
||
|
||
: cursor curPos @
|
||
scrBeg @ -1 -rot
|
||
BEGIN rot 1+ -rot
|
||
l> 2dup u< UNTIL
|
||
drop l<? scrCol @ -
|
||
rot swap ( col+ @ + ) 'at drop ;
|
||
: ?sR? curPos @
|
||
l<? ( col+ @ + ) dup cols - 1+
|
||
scrCol @ max min scrCol ! drop ;
|
||
: ?sB? curPos @ scrBeg @ u> ?exit
|
||
curPos @ l< scrBeg ! ;
|
||
: show ?sB? ?sr? key? ?exit
|
||
redraw key? ?exit cursor ;
|
||
|
||
\ 0 3 +thru
|
||
|
||
|
||
|
||
\ maintab clv25jan88
|
||
|
||
: A+ [compile] Ascii + ;
|
||
: Ctr -$40 A+ ; : Cbm $60 A+ ;
|
||
: Ct+ $40 A+ ;
|
||
: => c, ' , ;
|
||
|
||
Create maintab \ <key> c, ' word ,
|
||
Ctr ] => right Ct+ ] => left
|
||
Ctr q => down Ct+ q => up
|
||
Ctr u => begLn Ctr i => endLn
|
||
Ctr h => begPg Ctr j => endPg
|
||
Ctr g => lastPg Ctr k => nextPg
|
||
Ctr b => beg Ctr n => end
|
||
Ctr f => files \ Ctr l => loadFile
|
||
Ctr c => exitEd
|
||
Ctr t => backDel Ctr d => delChar
|
||
Ctr w => writeFile Ctr r => readFile
|
||
Ctr o => info
|
||
Ctr p => help
|
||
Ctr [ => redraw \ ESC
|
||
0 => doChar
|
||
\ 0 2 +thru
|
||
|
||
|
||
\ editop clv30jan88
|
||
|
||
: dokey
|
||
lastKey @ tab @ 3 -
|
||
BEGIN 3+ dup c@ WHILE 2dup c@ = UNTIL
|
||
nip 1+ @ execute ;
|
||
|
||
: editop
|
||
rp@ exitRP ! \ fuer exitEd
|
||
maintab tab !
|
||
BEGIN
|
||
key? 0= IF show THEN
|
||
key lastKey ! dokey REPEAT ;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ edi3 test clv22feb88
|
||
|
||
: init
|
||
limit 1+
|
||
dup fBeg ! dup fEnd !
|
||
dup curPos !
|
||
drop
|
||
$0d fBeg @ 1- c!
|
||
0 scrCol ! fBeg @ 1- scrBeg !
|
||
initFile ;
|
||
|
||
: red editop
|
||
page ." end of edit" ;
|
||
: edit bl parse $20 umin fName place
|
||
init ( readFile ) red ;
|
||
|
||
\needs new \\
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ Edi-Test-1 clv22feb88
|
||
\ ohne read/write
|
||
: tt limit $e000 -
|
||
IF $e000 ['] limit >body ! 20 buffers
|
||
THEN ;
|
||
|
||
tt forget tt
|
||
|
||
|
||
Onlyforth
|
||
|
||
\needs memtop $fd00 Constant memtop
|
||
|
||
\needs .page &10 load
|
||
1 +load \ Variables ..
|
||
&12 +load \ Test
|
||
2 &10 +thru
|
||
&11 +load \ Test
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ Variables clv14jan88
|
||
|
||
Variable curPos Variable scrCol
|
||
Variable scrBeg Variable scrEnd
|
||
Variable fBeg Variable fEnd
|
||
|
||
Variable xroom Variable xroomlen
|
||
Variable tab
|
||
|
||
Variable col+
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ room clv11jan88
|
||
|
||
|
||
: ?enough ( n--n)
|
||
dup xroomlen @ > abort" no room" ;
|
||
|
||
: ?range ( adr n -- adr n)
|
||
over xroom @ u> abort" beyond room" ;
|
||
\ kriegt spaeter die verschieberei
|
||
: decroom ( n--n)
|
||
dup fEnd +!
|
||
dup xroom +! dup negate xroomlen +! ;
|
||
|
||
: room ( adr n -- adr n)
|
||
?enough ?range 2dup over +
|
||
( ad n ad=fr ad'=to )
|
||
xroom @ 2 pick - move ( adr n)
|
||
decroom ; \\
|
||
: room ( adr n -- adr)
|
||
?enough ?range
|
||
2dup + -rot >r ( ad'=to ad)
|
||
xroom @ over - ( ad' ad=fr cnt)
|
||
2 pick swap move ( ad' )
|
||
r> decroom ;
|
||
|
||
\ insert back clv14jan88
|
||
|
||
: fType ( adr from u -- adr')
|
||
swap >r room
|
||
2dup r> -rot cmove + ;
|
||
|
||
: fEmit ( adr char--adr')
|
||
>r rp@ 1 fType rdrop ;
|
||
|
||
: fDel ( adr u -- adr')
|
||
2dup - fBeg @ u< ( a u a'<beg? )
|
||
IF drop dup fBeg @ - 0 min THEN
|
||
negate room + ;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ cursor-movement clv14jan88
|
||
|
||
( adr--adr')
|
||
\ setzt #cr vor und nach File voraus
|
||
|
||
: ?b fBeg @ umax ; : ?e fEnd @ umin ;
|
||
|
||
Code (cr>
|
||
sp x) lda N sta sp )y lda N 1+ sta
|
||
#cr # lda [[ N winc N x) cmp 0= ?]
|
||
N lda sp x) sta N 1+ lda sp )y sta
|
||
next jmp end-code
|
||
Code (cr<
|
||
sp x) lda N sta sp )y lda N 1+ sta
|
||
[[ N wdec #cr # lda N x) cmp 0= ?]
|
||
N lda sp x) sta N 1+ lda sp )y sta
|
||
next jmp end-code
|
||
|
||
: cr< ?b (cr< ; : cr> ?e (cr> ;
|
||
: pg< rows 0 DO cr< LOOP ;
|
||
: pg> 1- rows 1- 0 DO cr> LOOP ;
|
||
\\
|
||
: cr< ?b BEGIN 1- cr? UNTIL ;
|
||
: cr> ?e BEGIN 1+ cr? UNTIL ;
|
||
|
||
\ move-Base clv14jan88
|
||
|
||
: leftchars ( adr--adr u)
|
||
dup dup cr< 1+ - ;
|
||
: rightchars ( adr--adr u)
|
||
dup 1- cr> over - ;
|
||
|
||
: savCol dup dup cr< - col+ +! ;
|
||
: useCol dup cr> over - col+ @ over -
|
||
dup 0< IF + 0 THEN col+ ! + ;
|
||
: noCol col+ off ;
|
||
: cr? ( adr--adr flag) dup c@ #cr = ;
|
||
: ?eL ?e dup 1- cr> fEnd @ - ?exit cr< ;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\\
|
||
\ 0 6 +thru
|
||
|
||
|
||
|
||
|
||
\ executables clv14jan88
|
||
|
||
( rp char adr--rp char adr')
|
||
|
||
: begLn noCol cr< 1+ ;
|
||
: endLn noCol 1- cr> ;
|
||
: up savCol cr< cr< useCol ;
|
||
: down savCol 1- cr> ?eL useCol ;
|
||
|
||
: lastPg savCol pg< useCol ;
|
||
: nextPg savCol pg> ?eL useCol ;
|
||
: begPg savCol drop scrBeg @ 1- useCol ;
|
||
: endPg begPg nextPg ;
|
||
: beg savCol drop fBeg @ 1- useCol ;
|
||
: end savCol drop fEnd @ cr< useCol ;
|
||
: right cr? IF 1 col+ +! ELSE 1+ THEN ;
|
||
: left col+ @
|
||
IF -1 col+ +! ELSE 1- ?b THEN ;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ ..exe clv14jan88
|
||
|
||
: doChar col+ @ 0 ?DO bl fEmit LOOP
|
||
noCol over fEmit ;
|
||
: backDel col+ @
|
||
IF left ELSE 1 fDel THEN ;
|
||
: delChar right backDel ;
|
||
|
||
: wait key drop ;
|
||
|
||
: exitEd nip swap rp! ;
|
||
: info at? 5 0 at
|
||
2dup swap cr . . ." at" .i
|
||
wait at ;
|
||
: help tab @ BEGIN count WHILE
|
||
dup @ >name .name 2+ REPEAT
|
||
drop wait ;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ redraw show clv14jan88
|
||
|
||
: redraw BEGIN scrBeg @ fEnd @ over -
|
||
scrCol @ .page drop drop
|
||
over u< WHILE
|
||
dup pg< 1+ scrBeg ! REPEAT ;
|
||
( adr--adr')
|
||
: cursor \ dup curPos ! \ test
|
||
scrBeg @ 1- -1 -rot
|
||
BEGIN rot 1+ -rot
|
||
cr> 2dup u> not UNTIL
|
||
drop leftchars scrCol @ -
|
||
rot swap col+ @ + 'at ;
|
||
: ?sR? leftchars col+ @ + dup cols - 1+
|
||
scrCol @ max min scrCol ! ;
|
||
: ?sB? dup scrBeg @ u< not ?exit
|
||
dup begLn scrBeg ! ;
|
||
: show ?sB? ?sr? redraw cursor ;
|
||
|
||
\\
|
||
: ?sE? scrBeg @ pg> over u> ?exit
|
||
dup pg< 1+ scrBeg ! ;
|
||
: show ?sB? ?sr? ?se? redraw cursor ;
|
||
\ 0 3 +thru
|
||
|
||
\ maintab clv14jan88
|
||
|
||
: A+ [compile] Ascii + ;
|
||
: Ctr -$40 A+ ; : Cbm $60 A+ ;
|
||
: Ct+ $40 A+ ;
|
||
: => c, ' , ;
|
||
|
||
Create maintab \ <key> c, ' word ,
|
||
Ctr ] => right Ct+ ] => left
|
||
Ctr q => down Ct+ q => up
|
||
Ctr u => begLn Ctr i => endLn
|
||
\ Ctr y => lastLn Ctr o => nextLn
|
||
Ctr h => begPg Ctr j => endPg
|
||
Ctr g => lastPg Ctr k => nextPg
|
||
Ctr b => beg Ctr n => end
|
||
|
||
Ctr c => exitEd
|
||
Ctr t => backDel \ del-Taste
|
||
Ctr d => delChar
|
||
Ctr e => info
|
||
Ctr w => help
|
||
Ctr r => redraw
|
||
0 => doChar
|
||
\ 0 2 +thru
|
||
|
||
\ editop clv14jan88
|
||
|
||
: dokey ( adr char --adr)
|
||
tab @ 3 -
|
||
BEGIN 3+ dup c@ WHILE 2dup c@ = UNTIL
|
||
1+ @ ( adr char cfa )
|
||
>r swap r> execute nip ;
|
||
|
||
: editop ( adr--adr)
|
||
rp@ swap \ fuer exitEd
|
||
BEGIN
|
||
key? 0= IF show THEN
|
||
key maintab tab ! dokey REPEAT ;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ edi1 test clv14jan88
|
||
|
||
|
||
: init limit $e000 u> abort" limit!!"
|
||
|
||
0 dup scrCol ! col+ !
|
||
limit 1+
|
||
dup scrBeg ! dup scrEnd !
|
||
dup fBeg ! dup fEnd !
|
||
dup curPos !
|
||
|
||
$0d fBeg @ 1- c! $0d0d fEnd @ !
|
||
|
||
dup $2 + xroom !
|
||
memtop xroom @ - xroomlen !
|
||
drop
|
||
;
|
||
|
||
: red curPos @ editop curPos !
|
||
page ." end of edit" ;
|
||
: edit init red ;
|
||
|
||
|
||
|
||
|
||
\ edi1test info clv14jan88
|
||
|
||
Defer 'at
|
||
|
||
: sat cols 1- min swap rows 1- min swap
|
||
at ;
|
||
|
||
: .at 0 10 at 2dup swap . . ." AT" sat ;
|
||
' sat Is 'at
|
||
|
||
: nc curoff begin stop? until ;
|
||
|
||
: .v ( adr--) base push hex cr
|
||
dup @ 5 u.r ." " 2- >name .name ." !"
|
||
;
|
||
|
||
: .i cr .s
|
||
scrCol .v
|
||
fbeg .v scrbeg .v
|
||
scrend .v fend .v
|
||
xroom .v xroomlen .v col+ .v
|
||
cr fbeg @ 1- c@ . fend @ @ .
|
||
cr ;
|
||
|
||
|
||
clv20jan88
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
clv20jan88
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
clv20jan88
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
clv20jan88
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
clv20jan88
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
clv20jan88
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ edi1test info clv20jan88
|
||
|
||
Defer 'at
|
||
|
||
: sat cols 1- min swap rows 1- min swap
|
||
at ;
|
||
|
||
: .at 0 10 at 2dup swap . . ." AT" sat ;
|
||
' sat Is 'at
|
||
|
||
: nc curoff begin stop? until ;
|
||
|
||
: .v ( adr--) base push hex cr
|
||
dup @ 5 u.r ." " 2- >name .name ." !"
|
||
;
|
||
|
||
: .i cr .s
|
||
curPos .v
|
||
scrCol .v
|
||
fbeg .v scrbeg .v
|
||
fend .v
|
||
xroom .v xroomlen .v col+ .v
|
||
cr fbeg @ 1- c@ . fend @ @ .
|
||
cr ;
|
||
|
||
\ Edi-Test-3 clv22feb88
|
||
|
||
\ schnell, obwohl room am Ende
|
||
|
||
: tt limit $e000 -
|
||
IF $e000 ['] limit >body ! 20 buffers
|
||
THEN ;
|
||
|
||
tt forget tt
|
||
|
||
|
||
Onlyforth
|
||
|
||
\needs memtop $fd00 Constant memtop
|
||
|
||
\needs .page &10 load
|
||
1 &19 +thru
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ Variables clv20jan88
|
||
|
||
Variable curPos Variable scrCol
|
||
Variable scrBeg \ Variable scrEnd
|
||
Variable col+
|
||
|
||
Create fName $20 allot
|
||
Variable fBeg Variable fEnd
|
||
Variable fPos
|
||
|
||
Variable exitRP
|
||
|
||
Variable xroom Variable xroomlen
|
||
Variable tab
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ room clv11jan88
|
||
|
||
|
||
: ?enough ( n--n)
|
||
dup xroomlen @ > abort" no room" ;
|
||
|
||
: ?range ( adr n -- adr n)
|
||
over xroom @ u> abort" beyond room" ;
|
||
\ kriegt spaeter die verschieberei
|
||
: decroom ( n--n)
|
||
dup fEnd +!
|
||
dup xroom +! dup negate xroomlen +! ;
|
||
|
||
: room ( adr n -- adr n)
|
||
?enough ?range 2dup over +
|
||
( ad n ad=fr ad'=to )
|
||
xroom @ 2 pick - move ( adr n)
|
||
decroom ; \\
|
||
: room ( adr n -- adr)
|
||
?enough ?range
|
||
2dup + -rot >r ( ad'=to ad)
|
||
xroom @ over - ( ad' ad=fr cnt)
|
||
2 pick swap move ( ad' )
|
||
r> decroom ;
|
||
|
||
\ fType/Emit/Del clv20jan88
|
||
|
||
: initRoom fEnd @
|
||
$0d0d over ! $2 + xroom !
|
||
memtop xroom @ - xroomlen ! ;
|
||
|
||
|
||
|
||
: fType ( adr from u -- adr')
|
||
swap >r room
|
||
2dup r> -rot cmove + ;
|
||
|
||
: fEmit ( adr char--adr')
|
||
>r rp@ 1 fType rdrop ;
|
||
|
||
: fDel ( adr u -- adr')
|
||
2dup - fBeg @ u< ( a u a'<beg? )
|
||
IF drop dup fBeg @ - 0 min THEN
|
||
negate room + ;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ fKey/fExpect/fDecod clv20jan88
|
||
|
||
\\ noch unfertig:
|
||
|
||
: fPtr? ( --adr) fPos @ ;
|
||
: fKey? ( --flag) fPtr? fEnd @ u< ;
|
||
: fKey ( -- 8b)
|
||
fKey? IF fPtr? c@ ELSE oldIn THEN ;
|
||
: c64decode
|
||
( addr cnt1 key -- addr cnt2)
|
||
#bs case? IF dup IF del 1- THEN
|
||
exit THEN
|
||
#cr case? IF dup span ! exit THEN
|
||
>r 2dup + r@ swap c! r> emit 1+ ;
|
||
|
||
: c64expect ( addr len1 -- )
|
||
span ! 0
|
||
BEGIN dup span @ u<
|
||
WHILE key decode
|
||
REPEAT 2drop space ;
|
||
|
||
Input: fIn
|
||
c64key true c64decode c64expect ;
|
||
|
||
|
||
\ edi1test info clv20jan88
|
||
|
||
Defer 'at
|
||
|
||
: sat cols 1- min swap rows 1- min swap
|
||
at ;
|
||
|
||
: .at 0 10 at 2dup swap . . ." AT" sat ;
|
||
' sat Is 'at
|
||
|
||
: nc curoff begin stop? until ;
|
||
|
||
: .v ( adr--) base push hex cr
|
||
dup @ 5 u.r ." " 2- >name .name ." !"
|
||
;
|
||
|
||
: .i cr .s
|
||
curPos .v
|
||
scrCol .v
|
||
fbeg .v scrbeg .v
|
||
fend .v
|
||
xroom .v xroomlen .v col+ .v
|
||
cr fbeg @ 1- c@ . fend @ @ .
|
||
cr ;
|
||
|
||
\ cursor-movement clv14jan88
|
||
|
||
( adr--adr')
|
||
\ setzt #cr vor und nach File voraus
|
||
|
||
: ?b fBeg @ umax ; : ?e fEnd @ umin ;
|
||
|
||
Code (cr>
|
||
sp x) lda N sta sp )y lda N 1+ sta
|
||
#cr # lda [[ N winc N x) cmp 0= ?]
|
||
N lda sp x) sta N 1+ lda sp )y sta
|
||
next jmp end-code
|
||
Code (cr<
|
||
sp x) lda N sta sp )y lda N 1+ sta
|
||
[[ N wdec #cr # lda N x) cmp 0= ?]
|
||
N lda sp x) sta N 1+ lda sp )y sta
|
||
next jmp end-code
|
||
|
||
: cr< ?b (cr< ; : cr> ?e (cr> ;
|
||
: pg< rows 0 DO cr< LOOP ;
|
||
: pg> 1- rows 1- 0 DO cr> LOOP ;
|
||
\\
|
||
: cr< ?b BEGIN 1- cr? UNTIL ;
|
||
: cr> ?e BEGIN 1+ cr? UNTIL ;
|
||
|
||
\ move-Base clv20jan88
|
||
|
||
: leftchars ( adr--adr u)
|
||
dup dup cr< 1+ - ;
|
||
: rightchars ( adr--adr u)
|
||
dup 1- cr> over - ;
|
||
|
||
: savCol dup dup cr< - col+ +! ;
|
||
: useCol dup cr> over - col+ @ over -
|
||
dup 0< IF + 0 THEN col+ ! + ;
|
||
: noCol col+ off ;
|
||
: cr? ( adr--adr flag) dup c@ #cr = ;
|
||
: ?eL ?e dup 1- cr> fEnd @ - ?exit cr< ;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ executables clv20jan88
|
||
|
||
( char adr-- char adr')
|
||
|
||
: begLn noCol cr< 1+ ;
|
||
: endLn noCol 1- cr> ;
|
||
: up savCol cr< cr< useCol ;
|
||
: down savCol 1- cr> ?eL useCol ;
|
||
|
||
: lastPg savCol pg< useCol ;
|
||
: nextPg savCol pg> ?eL useCol ;
|
||
: begPg savCol drop scrBeg @ 1- useCol ;
|
||
: endPg begPg nextPg ;
|
||
: beg savCol drop fBeg @ 1- useCol ;
|
||
: end savCol drop fEnd @ cr< useCol ;
|
||
: right cr? IF 1 col+ +! ELSE 1+ THEN ;
|
||
: left col+ @
|
||
IF -1 col+ +! ELSE 1- ?b THEN ;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ ..exe clv21jan88
|
||
|
||
: doChar col+ @ 0 ?DO bl fEmit LOOP
|
||
noCol over fEmit ;
|
||
: backDel col+ @
|
||
IF left ELSE 1 fDel THEN ;
|
||
: delChar right backDel ;
|
||
|
||
: wait BEGIN key? UNTIL ;
|
||
|
||
: exitEd curPos ! drop exitRp @ rp! ;
|
||
: info at? 5 0 at
|
||
2dup swap cr . . ." at" .i
|
||
wait at ;
|
||
: help tab @ BEGIN count WHILE
|
||
dup @ >name .name 2+ REPEAT
|
||
drop wait ;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ leer clv20jan88
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ writeFile clv20jan88
|
||
|
||
Onlyforth
|
||
|
||
: writeFile
|
||
8 2 busopen fName count bustype
|
||
" ,p,w" count bustype busoff
|
||
derror? ?exit
|
||
8 2 busout 0 0 bus! bus!
|
||
fBeg @ fEnd @ over - bustype busoff
|
||
8 2 busclose
|
||
0 (drv ! derror? ?exit ;
|
||
|
||
: readFile
|
||
0 (drv !
|
||
8 2 busopen fName count bustype
|
||
" ,p,r" count bustype busoff
|
||
derror? ?exit fBeg @
|
||
8 2 busin bus@ drop bus@ drop
|
||
BEGIN bus@ over c! 1+ $90 c@ UNTIL
|
||
fEnd ! busoff
|
||
8 2 busclose derror? ?exit initroom ;
|
||
|
||
|
||
|
||
\ leer clv20jan88
|
||
|
||
|
||
| : skp bus@ drop bus@ drop ;
|
||
| : wrd bus@ bus@ $100 * + . ;
|
||
| : str
|
||
BEGIN bus@ ?dup WHILE emit REPEAT ;
|
||
|
||
: files \ Filename kann folgen
|
||
(drv @ 8 +
|
||
dup 0 busopen
|
||
" $0:" count bustype
|
||
bl parse bustype
|
||
" *" count bustype
|
||
busoff derror? ?exit
|
||
dup 0 busin
|
||
|
||
skp skp \ Sector,Zeilenlink
|
||
BEGIN cr wrd str skp $90 c@ UNTIL
|
||
0 busclose derror? ?exit ;
|
||
|
||
|
||
|
||
|
||
|
||
\ leer clv20jan88
|
||
|
||
: fLine #tib @ >tib @ + 1+
|
||
dup fEnd @ u> IF drop rdrop exit THEN
|
||
dup 1- cr> over - #tib ! >tib !
|
||
>in off ;
|
||
|
||
: .fLine
|
||
cr >tib @ dup 5 u.r space
|
||
#tib @ type space ;
|
||
|
||
: xx
|
||
>tib push #tib push >in push r0 push
|
||
['] 'quit >body push
|
||
['] unnest Is 'quit
|
||
['] .status >body push
|
||
rp@ r0 ! page
|
||
['] .fLine Is .status
|
||
curPos @ >tib ! -1 #tib !
|
||
BEGIN fLine .status interpret REPEAT ;
|
||
|
||
: loadFile
|
||
curPos ! >r xx r> curPos @ wait ;
|
||
|
||
|
||
\ leer clv20jan88
|
||
|
||
: fConvey ( [from to]--)
|
||
1+ swap curPos @ -rot
|
||
?DO rows 0
|
||
DO #cr fEmit
|
||
J block I c/l * + c/l fType
|
||
LOOP 1 fDel LOOP drop ;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ redraw show clv20jan88
|
||
|
||
: redraw BEGIN scrBeg @ fEnd @ over -
|
||
scrCol @ .page drop drop
|
||
over u< WHILE
|
||
dup pg< 1+ scrBeg ! REPEAT ;
|
||
|
||
( adr--adr')
|
||
|
||
: cursor \ dup curPos ! \ test
|
||
scrBeg @ 1- -1 -rot
|
||
BEGIN rot 1+ -rot
|
||
cr> 2dup u> not UNTIL
|
||
drop leftchars scrCol @ -
|
||
rot swap col+ @ + 'at ;
|
||
: ?sR? leftchars col+ @ + dup cols - 1+
|
||
scrCol @ max min scrCol ! ;
|
||
: ?sB? dup scrBeg @ u< not ?exit
|
||
dup begLn scrBeg ! ;
|
||
: show ?sB? ?sr? redraw cursor ;
|
||
|
||
|
||
|
||
|
||
|
||
\\ leer \\\\\\\\\\\\\\\\\\\\\ clv21jan88
|
||
\ \
|
||
\ \
|
||
\ \
|
||
\ \
|
||
\ \
|
||
\ \
|
||
\ \
|
||
\ \
|
||
\ \
|
||
\ \
|
||
\ \
|
||
\ \
|
||
\ \
|
||
\ \
|
||
\ \
|
||
\ \
|
||
\ \
|
||
\ \
|
||
\ \
|
||
\ \
|
||
\ \
|
||
\ \
|
||
\ \
|
||
\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
|
||
\ maintab clv21jan88
|
||
|
||
: A+ [compile] Ascii + ;
|
||
: Ctr -$40 A+ ; : Cbm $60 A+ ;
|
||
: Ct+ $40 A+ ;
|
||
: => c, ' , ;
|
||
|
||
Create maintab \ <key> c, ' word ,
|
||
Ctr ] => right Ct+ ] => left
|
||
Ctr q => down Ct+ q => up
|
||
Ctr u => begLn Ctr i => endLn
|
||
Ctr h => begPg Ctr j => endPg
|
||
Ctr g => lastPg Ctr k => nextPg
|
||
Ctr b => beg Ctr n => end
|
||
Ctr f => files Ctr l => loadFile
|
||
Ctr c => exitEd
|
||
Ctr t => backDel Ctr d => delChar
|
||
Ctr w => writeFile Ctr r => readFile
|
||
Ctr o => info
|
||
Ctr p => help
|
||
\ Ctr ? => redraw
|
||
0 => doChar
|
||
\ 0 2 +thru
|
||
|
||
|
||
\ editop clv20jan88
|
||
|
||
: dokey ( adr char --adr)
|
||
tab @ 3 -
|
||
BEGIN 3+ dup c@ WHILE 2dup c@ = UNTIL
|
||
1+ @ ( adr char cfa )
|
||
>r swap r> execute nip ;
|
||
|
||
: editop
|
||
rp@ exitRP ! \ fuer exitEd
|
||
curPos @
|
||
BEGIN
|
||
key? 0= IF show THEN
|
||
key maintab tab ! dokey REPEAT ;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ edi3 test clv21jan88
|
||
|
||
: init limit $e000 u> abort" limit!!"
|
||
|
||
0 dup scrCol ! col+ !
|
||
limit 1+
|
||
dup scrBeg !
|
||
dup fBeg ! dup fEnd !
|
||
dup curPos !
|
||
drop
|
||
$0d fBeg @ 1- c!
|
||
initroom ;
|
||
|
||
|
||
: red editop
|
||
page ." end of edit" ;
|
||
: edit bl parse $20 umin fName place
|
||
init readFile red ;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
clv20jan88
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ editop clv13jan88
|
||
|
||
: dokey ( char--)
|
||
tab @ 3 -
|
||
BEGIN 3+ dup c@ WHILE 2dup c@ = UNTIL
|
||
1+ @ ( char cfa ) execute drop ;
|
||
|
||
|
||
: (editop
|
||
rp@ exitRp ! \ fuer exitEd
|
||
BEGIN key dokey REPEAT ;
|
||
|
||
|
||
: editop
|
||
tab push maintab tab !
|
||
show \ Task initialisieren
|
||
(editop
|
||
noshow ;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
\ leer clv06jan88
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
0<><30>E$<24><07>%l<>' |