diff --git a/blk/100 b/blk/100 index 4377d6b..d234f82 100644 --- a/blk/100 +++ b/blk/100 @@ -1,7 +1,7 @@ Block editor This is an application to conveniently browse the contents of -the disk blocks and edit them. You can load it with "102 LOAD". +the disk blocks and edit them. You can load it with "105 LOAD". Browse mode: If you execute BROWSE, the Forth interpreter is replaced by browser's loop. Typing "Q" quits the browser. diff --git a/blk/102 b/blk/102 deleted file mode 100644 index faa13c5..0000000 --- a/blk/102 +++ /dev/null @@ -1,14 +0,0 @@ -'? CASE NOT [IF] 51 52 LOADR+ [THEN] DROP ( B152-153 ) -'? FILL NOT [IF] 53 LOAD+ [THEN] DROP ( B155 ) -1 7 LOADR+ -: BROWSE - 0 ACC ! L - BEGIN - KEY CASE - 'Q' OF EXIT ENDOF - 'B' OF B ENDOF - 'N' OF N ENDOF - _NUM - ENDCASE - AGAIN -; diff --git a/blk/103 b/blk/103 deleted file mode 100644 index 7ec00d8..0000000 --- a/blk/103 +++ /dev/null @@ -1,16 +0,0 @@ -CREATE ACC 0 , -: _LIST ." Block " DUP . NL LIST ; -: _NUM - ACC @ SWAP _pdacc - IF _LIST 0 THEN - ACC ! -; -: L BLK> @ _LIST ; -: B BLK> @ 1- BLK@ L ; -: N BLK> @ 1+ BLK@ L ; - - - - - - diff --git a/blk/104 b/blk/104 deleted file mode 100644 index a64046c..0000000 --- a/blk/104 +++ /dev/null @@ -1,13 +0,0 @@ -( Cursor position in buffer. EDPOS/64 is line number ) -CREATE EDPOS 0 , -CREATE IBUF 64 ALLOT0 -CREATE FBUF 64 ALLOT0 -: _cpos BLK( + ; -: _lpos 64 * _cpos ; -: _pln ( lineno -- ) - DUP _lpos DUP 64 + SWAP DO ( lno ) - I EDPOS @ _cpos = IF '^' EMIT THEN - I C@ DUP 0x20 < IF DROP 0x20 THEN - EMIT - LOOP ( lno ) 1+ . ; -: _zbuf 64 0 FILL ; ( buf -- ) diff --git a/blk/105 b/blk/105 index 176a01b..66a36ac 100644 --- a/blk/105 +++ b/blk/105 @@ -1,12 +1,14 @@ -: _type ( buf -- ) - C< DUP 0xd = IF 2DROP EXIT THEN SWAP DUP _zbuf ( c a ) - BEGIN ( c a ) C!+ C< TUCK 0x0d = UNTIL ( c a ) C! ; -( user-facing lines are 1-based ) -: T 1- DUP 64 * EDPOS ! _pln ; -: P IBUF _type IBUF EDPOS @ _cpos 64 MOVE BLK!! ; -: _mvln+ ( ln -- move ln 1 line down ) - DUP 14 > IF DROP EXIT THEN - _lpos DUP 64 + 64 MOVE ; -: _mvln- ( ln -- move ln 1 line up ) - DUP 14 > IF DROP 15 _lpos _zbuf - ELSE 1+ _lpos DUP 64 - 64 MOVE THEN ; +'? CASE NOT [IF] 48 49 LOADR+ [THEN] DROP ( B153-154 ) +'? FILL NOT [IF] 50 LOAD+ [THEN] DROP ( B155 ) +1 7 LOADR+ +: BROWSE + 0 ACC ! L + BEGIN + KEY CASE + 'Q' OF EXIT ENDOF + 'B' OF B ENDOF + 'N' OF N ENDOF + _NUM + ENDCASE + AGAIN +; diff --git a/blk/106 b/blk/106 index 9b2d09e..7ec00d8 100644 --- a/blk/106 +++ b/blk/106 @@ -1,5 +1,16 @@ -: _U ( U without P, used in VE ) - 15 EDPOS @ 64 / - 0 DO - 14 I - _mvln+ - LOOP ; -: U _U P ; +CREATE ACC 0 , +: _LIST ." Block " DUP . NL LIST ; +: _NUM + ACC @ SWAP _pdacc + IF _LIST 0 THEN + ACC ! +; +: L BLK> @ _LIST ; +: B BLK> @ 1- BLK@ L ; +: N BLK> @ 1+ BLK@ L ; + + + + + + diff --git a/blk/107 b/blk/107 index cb7aade..a64046c 100644 --- a/blk/107 +++ b/blk/107 @@ -1,10 +1,13 @@ -: _F ( F without _type and _pln. used in VE ) - FBUF EDPOS @ _cpos 1+ ( a1 a2 ) - BEGIN - C@+ ROT ( a2+1 c2 a1 ) C@+ ROT ( a2+1 a1+1 c1 c2 ) - = NOT IF DROP FBUF THEN ( a2 a1 ) - TUCK C@ 0xd = ( a1 a2 f1 ) - OVER BLK) = OR ( a1 a2 f1|f2 ) - UNTIL ( a1 a2 ) - DUP BLK) < IF BLK( - FBUF + -^ EDPOS ! ELSE DROP THEN ; -: F FBUF _type _F EDPOS @ 64 / _pln ; +( Cursor position in buffer. EDPOS/64 is line number ) +CREATE EDPOS 0 , +CREATE IBUF 64 ALLOT0 +CREATE FBUF 64 ALLOT0 +: _cpos BLK( + ; +: _lpos 64 * _cpos ; +: _pln ( lineno -- ) + DUP _lpos DUP 64 + SWAP DO ( lno ) + I EDPOS @ _cpos = IF '^' EMIT THEN + I C@ DUP 0x20 < IF DROP 0x20 THEN + EMIT + LOOP ( lno ) 1+ . ; +: _zbuf 64 0 FILL ; ( buf -- ) diff --git a/blk/108 b/blk/108 index 851f3be..176a01b 100644 --- a/blk/108 +++ b/blk/108 @@ -1,15 +1,12 @@ -: _blen ( buf -- length of str in buf ) - DUP BEGIN C@+ EOL? UNTIL -^ 1- ; -: _rbufsz ( size of linebuf to the right of curpos ) - EDPOS @ 64 MOD 63 -^ ; -: i COMPILE I ; IMMEDIATE ( save overshadowed ) -: _I ( I without _pln and _type. used in VE ) - _rbufsz IBUF _blen 2DUP > IF - TUCK - ( ilen chars-to-move ) - SWAP EDPOS @ _cpos 2DUP + ( ctm ilen a a+ilen ) - 3 PICK MOVE- ( ctm ilen ) - NIP ( ilen ) - ELSE DROP ( ilen becomes rbuffsize ) - THEN - DUP IBUF EDPOS @ _cpos ROT MOVE ( ilen ) EDPOS +! BLK!! ; -: I IBUF _type _I EDPOS @ 64 / _pln ; +: _type ( buf -- ) + C< DUP 0xd = IF 2DROP EXIT THEN SWAP DUP _zbuf ( c a ) + BEGIN ( c a ) C!+ C< TUCK 0x0d = UNTIL ( c a ) C! ; +( user-facing lines are 1-based ) +: T 1- DUP 64 * EDPOS ! _pln ; +: P IBUF _type IBUF EDPOS @ _cpos 64 MOVE BLK!! ; +: _mvln+ ( ln -- move ln 1 line down ) + DUP 14 > IF DROP EXIT THEN + _lpos DUP 64 + 64 MOVE ; +: _mvln- ( ln -- move ln 1 line up ) + DUP 14 > IF DROP 15 _lpos _zbuf + ELSE 1+ _lpos DUP 64 - 64 MOVE THEN ; diff --git a/blk/109 b/blk/109 index c3380ac..9b2d09e 100644 --- a/blk/109 +++ b/blk/109 @@ -1,9 +1,5 @@ -: X ( len -- , delete len chars after curpos ) - EDPOS @ _cpos 2DUP + ( l a1 a1+l ) - SWAP _rbufsz MOVE ( l ) - ( get to next line - l ) - DUP EDPOS @ 0xffc0 AND 0x40 + -^ _cpos ( l a ) - SWAP 0 FILL - EDPOS @ 64 / _pln ; -: E FBUF _blen X ; - +: _U ( U without P, used in VE ) + 15 EDPOS @ 64 / - 0 DO + 14 I - _mvln+ + LOOP ; +: U _U P ; diff --git a/blk/110 b/blk/110 new file mode 100644 index 0000000..cb7aade --- /dev/null +++ b/blk/110 @@ -0,0 +1,10 @@ +: _F ( F without _type and _pln. used in VE ) + FBUF EDPOS @ _cpos 1+ ( a1 a2 ) + BEGIN + C@+ ROT ( a2+1 c2 a1 ) C@+ ROT ( a2+1 a1+1 c1 c2 ) + = NOT IF DROP FBUF THEN ( a2 a1 ) + TUCK C@ 0xd = ( a1 a2 f1 ) + OVER BLK) = OR ( a1 a2 f1|f2 ) + UNTIL ( a1 a2 ) + DUP BLK) < IF BLK( - FBUF + -^ EDPOS ! ELSE DROP THEN ; +: F FBUF _type _F EDPOS @ 64 / _pln ; diff --git a/blk/111 b/blk/111 new file mode 100644 index 0000000..851f3be --- /dev/null +++ b/blk/111 @@ -0,0 +1,15 @@ +: _blen ( buf -- length of str in buf ) + DUP BEGIN C@+ EOL? UNTIL -^ 1- ; +: _rbufsz ( size of linebuf to the right of curpos ) + EDPOS @ 64 MOD 63 -^ ; +: i COMPILE I ; IMMEDIATE ( save overshadowed ) +: _I ( I without _pln and _type. used in VE ) + _rbufsz IBUF _blen 2DUP > IF + TUCK - ( ilen chars-to-move ) + SWAP EDPOS @ _cpos 2DUP + ( ctm ilen a a+ilen ) + 3 PICK MOVE- ( ctm ilen ) + NIP ( ilen ) + ELSE DROP ( ilen becomes rbuffsize ) + THEN + DUP IBUF EDPOS @ _cpos ROT MOVE ( ilen ) EDPOS +! BLK!! ; +: I IBUF _type _I EDPOS @ 64 / _pln ; diff --git a/blk/112 b/blk/112 new file mode 100644 index 0000000..c3380ac --- /dev/null +++ b/blk/112 @@ -0,0 +1,9 @@ +: X ( len -- , delete len chars after curpos ) + EDPOS @ _cpos 2DUP + ( l a1 a1+l ) + SWAP _rbufsz MOVE ( l ) + ( get to next line - l ) + DUP EDPOS @ 0xffc0 AND 0x40 + -^ _cpos ( l a ) + SWAP 0 FILL + EDPOS @ 64 / _pln ; +: E FBUF _blen X ; + diff --git a/blk/125 b/blk/125 index 19e4dcb..fdddc02 100644 --- a/blk/125 +++ b/blk/125 @@ -1,3 +1,3 @@ '? UPPER NOT [IF] 33 LOAD+ [THEN] DROP ( B158 ) --23 LOAD+ ( B102, block editor ) +-20 LOAD+ ( B105, block editor ) 1 6 LOADR+