| 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 |
| |
|
| : 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 ; |
| 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 ! |
