home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / forth040.zip / BLOCKS.4TH < prev    next >
Text File  |  1993-05-21  |  4KB  |  108 lines
  1. \ BLOCKS.4TH  -  Preliminary BLOCK File Support for Forth/2   2/13/93 bbm
  2. \ Copyright (c) 1993  BLUE STAR SYSTEMS
  3. \
  4. \ This is NOT a complete BLOCK file support system, it's just something
  5. \  to help people to view and load BLOCK files.  Updating blocks is not
  6. \  implemented, although it would be fairly easy to add.
  7.  
  8. ECHO ON
  9. \ Usage:  0" BLKFILE.BLK" OpenBlock
  10. \
  11. \ Then:   1 L        Shows screen 1
  12. \         LN         Shows next screen
  13. \         LB         Shows previous screen
  14. \         LL         Shows current screen
  15. \         10 FH L    Shows screen 10 screens From Here
  16. \         MaxBlk @   Highest block number
  17. \         2 Load     Loads (compiles) screen 2
  18. \         LO         Load current screen
  19. \         2 6 THRU   Loads screens 2 through 6
  20. \         10 Block   Loads block 10, returns address of block
  21. \         2 8 Index  Shows top lines of screens 2 through 8
  22. \
  23. \         2 6 ConvertTo" NewFile.4TH"  Converts block file to DOS text file
  24. \
  25. \         CloseBlock  Closes current block file
  26. ECHO OFF
  27.  
  28. DECIMAL
  29. FORTH Only DEFINITIONS
  30. SYSTEM
  31.  
  32. : BLOCKS.4TH ;
  33.  
  34. 1024 Constant 1K          \ Length of one block or screen
  35.   64 Constant C/L         \ Characters per Line of blocks
  36.   16 Constant #BlkLines   \ Number of lines per block
  37.  
  38. Variable BlkHandle    0 BlkHandle !
  39. Variable BlkFileSize
  40. Variable MaxBlk       0 MaxBlk !
  41. Variable SCR
  42.  
  43. : FSize ( handle -- size )    >R  BlkFileSize  2  0  R> SYS$SEEK SYSCALL
  44.                               5 Drops   BlkFileSize @ ;
  45.  
  46. : OpenBlock ( 0name -- )  BlkHandle @ ?DUP IF  Close  THEN
  47.                           Open  BlkHandle !  1 SCR !
  48.                           BlkHandle @ FSize  1K /  1- MaxBlk ! ;
  49.  
  50. : CloseBlock ( -- )       BlkHandle @ Close  0 BlkHandle !  0 MaxBlk ! ;
  51.  
  52. : BLOCK ( n -- addr )     1K *  BlkHandle @ FSeek  ABORT" Load error"
  53.                           BlkHandle @  FBuffer  1K  FRead  FBuffer ;
  54.  
  55. : LOAD  ( n -- )
  56.         TIB @  #TIB @
  57.           ROT BLOCK TIB !  1K #TIB !
  58.           INTERPRET
  59.         #TIB !  TIB ! ;
  60.  
  61.  
  62. : <LINE> ( line# scr# -- addr len ) Block  swap C/L *  +  C/L ;
  63.  
  64.  
  65. Variable ?CLS  1 ?CLS !  \ Determine if you want to CLS or scroll new screen
  66.  
  67. : LIST ( n -- ) DUP SCR !  
  68.                 ?CLS @ IF  CLS  ELSE  CR  THEN   DUP ." SCR " .  BLOCK
  69.                 #BlkLines 0 DO  
  70.                     CR  3 SPACES  DUP C/L -TRAILING Type  
  71.                 C/L +  LOOP  DROP ;
  72.  
  73. : L     ( n -- ) LIST ;
  74. : LL    ( -- ) SCR @ LIST ;
  75. : LN    ( -- ) SCR @  MaxBlk @ MIN  1+ LIST ;
  76. : LB    ( -- ) SCR @         0 MAX  1- LIST ;
  77. : LO    ( -- ) SCR @ LOAD ;
  78. : S     ( -- scr )  SCR @ ;
  79.  
  80. : FH    ( n -- SCR+n ) SCR @ + ;
  81. : INDEX ( n1 n2 -- )  SWAP DO  CR  ." SCR " I .
  82.                       I BLOCK C/L -TRAILING TYPE  LOOP ;
  83.  
  84. : -->  ( -- ) 1 SCR +!  SCR @ LOAD ;  IMMEDIATE
  85.  
  86.  
  87. Create CrLfStr    2 ,  13 C, 10 C,
  88. Create CntrlZStr  1 ,  26 C,
  89.  
  90. \ ConvertTo" converts a range of screens from a block file
  91. \            into a DOS text (sequential) file.
  92.  
  93. : ConvertTo" ( first_scr last_scr ConvertTo" Filename.4TH" -- )
  94.              POSTPONE 0"  Open  -ROT
  95.              1+ swap DO
  96.                #BlkLines 0 DO
  97.                    dup  I J <LINE> -Trailing FWrite
  98.                    dup  CrLfStr   @+         FWrite
  99.                LOOP
  100.                    dup  CrLfStr   @+         FWrite
  101.              LOOP  dup  CntrlZStr @+         FWrite  close ;
  102.  
  103. \ Example:   0" OldStuff.BLK" OpenBlock
  104. \
  105. \            0 30  ConvertTo" NewStuff.4TH"
  106.  
  107.  
  108.