version 1.2, 1994/08/31 19:42:43
|
version 1.4, 1995/04/20 09:42:45
|
Line 15 variable block-fid 0 block-fid ! \ the f
|
Line 15 variable block-fid 0 block-fid ! \ the f
|
variable buffer-dirty buffer-dirty off |
variable buffer-dirty buffer-dirty off |
|
|
|
|
|
\ the file is opened as binary file, since it either will contain text |
|
\ without newlines or binary data |
: get-block-fid ( -- fid ) |
: get-block-fid ( -- fid ) |
block-fid @ 0= |
block-fid @ 0= |
if |
if |
s" blocks.fb" r/w open-file 0<> |
s" blocks.fb" r/w bin open-file 0<> |
if |
if |
s" blocks.fb" r/w create-file .s throw |
s" blocks.fb" r/w bin create-file throw |
then |
then |
block-fid ! |
block-fid ! |
then |
then |
Line 28 variable buffer-dirty buffer-dirty off
|
Line 30 variable buffer-dirty buffer-dirty off
|
|
|
: block-position ( u -- ) |
: block-position ( u -- ) |
\ positions the block file to the start of block u |
\ positions the block file to the start of block u |
1- chars/block chars um* get-block-fid reposition-file .s throw ; |
1- chars/block chars um* get-block-fid reposition-file throw ; |
|
|
: update ( -- ) |
: update ( -- ) |
buffer-dirty on ; |
buffer-dirty on ; |
|
|
: save-buffers ( -- ) |
: save-buffers ( -- ) |
buffer-dirty @ |
buffer-dirty @ buffer-block @ 0<> and |
if |
if |
buffer-block @ block-position |
buffer-block @ block-position |
block-buffer chars/block get-block-fid write-file throw |
block-buffer chars/block get-block-fid write-file throw |
Line 54 variable buffer-dirty buffer-dirty off
|
Line 56 variable buffer-dirty buffer-dirty off
|
if |
if |
save-buffers |
save-buffers |
dup block-position |
dup block-position |
block-buffer chars/block get-block-fid read-file .s throw |
block-buffer chars/block get-block-fid read-file throw |
\ clear the rest of the buffer if the file is too short |
\ clear the rest of the buffer if the file is too short |
block-buffer over chars + chars/block rot - blank |
block-buffer over chars + chars/block rot - blank |
buffer-block ! |
buffer-block ! |
Line 76 User scr 0 scr !
|
Line 78 User scr 0 scr !
|
." Screen " u. cr |
." Screen " u. cr |
16 0 |
16 0 |
?do |
?do |
scr @ block i 64 * chars + 64 type cr |
i 2 .r space scr @ block i 64 * chars + 64 type cr |
loop ; |
loop ; |
|
|
: (source) ( -- addr len ) |
: (source) ( -- addr len ) |
Line 99 User scr 0 scr !
|
Line 101 User scr 0 scr !
|
|
|
: +thru ( i*x n1 n2 -- j*x ) |
: +thru ( i*x n1 n2 -- j*x ) |
1+ swap 0 ?DO I +load LOOP ; |
1+ swap 0 ?DO I +load LOOP ; |
|
|
|
get-current environment-wordlist set-current |
|
true constant block |
|
true constant block-ext |
|
set-current |