\ 4tH library - BLOCK - Copyright 2006,2008 J.L. Bezemer
\ You can redistribute this file and/or modify it under
\ the terms of the GNU General Public License

\ Load definitions when needed
[UNDEFINED] e.ioerr [IF]
[NEEDS lib/throw.4th]
[THEN]

[UNDEFINED] BLOCK [IF]
      (error) constant empty           \ unassigned buffers
           64 constant c/l             \ characters per line
           16 constant l/scr           \ lines per editing screen
c/l l/scr [*] constant c/scr           \ size of an editing screen

        256 string block-file          \ name of block file
c/scr 1 [+] string block-buffer        \ block buffer and termination byte

variable scr                           \ 7.6.2.2190
variable vblk                          \ user readable blocknumber

0 dup value blk#                       \ holding current block nr.
  dup value ichan                      \ saving input device in use
  dup value ochan                      \ saving output device in use
      value dirty                      \ buffer dirty?

: chans> cin to ichan cout to ochan ;  ( --)
: >chans ichan use ochan use ;         ( --)
: ?throw if >chans e.ioerr throw then ;
                                       \ performs i/o and returns buffer 
: open-block                           ( n1 m -- n1 h2 a1 n2)
  chans> block-file count rot open dup error? ?throw use
  over c/scr * over seek ?throw block-buffer c/scr 
;
                                       \ leaves block number
: blk vblk blk# over ! ;               ( -- x)
: update true to dirty ;               ( --)
: clear block-buffer c/scr blank update to blk# ;
: empty-buffers false to dirty empty to blk# ;
: use-block block-file place empty-buffers ;
: close-block close >chans to blk# ;   ( n h --)
: read-block input open-block accept c/scr <> if over clear then close-block ;
: write-block output input [+] open-block type close-block ;
: save-buffers dirty if blk# write-block false to dirty then ;
: flush save-buffers empty-buffers ;   ( --)

: block                                ( n -- a)
  blk# over over <>                    \ if not current block, load it
  if 0< 0= if flush then read-block else 2drop then
  block-buffer 0 over c/scr + c!       \ terminate block and leave address
;

aka block buffer                       \ buffer is an alias
: list                                 ( n --)
  base @ swap dup dup scr ! cr ." Scr # " . block decimal
  l/scr 0 do cr i 3 .r space i c/l * over + c/l type loop cr drop base !
;

[DEFINED] 4TH# [IF]
hide write-block
hide read-block
hide close-block
hide open-block
hide ?throw
hide >chans
hide chans>
hide dirty
hide ochan
hide ichan
hide blk#
hide vblk
hide block-buffer
hide block-file
hide empty
[THEN]
[THEN]
