home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / FORTHCMP.ZIP / ENSCREEN.4TH < prev    next >
Encoding:
Text File  |  1992-03-30  |  4.8 KB  |  165 lines
  1. ( ENSCREEN  PROGRAM, BY TOM ALMY.              21:33 08/14/85 )
  2. \ THIS PROGRAM IS COPYRIGHT (C) 1985 BY TOM ALMY,
  3. \ ALL RIGHTS RESERVED.
  4. \  Users of ForthCMP are given permission to use or distribute this
  5. \  program, as long as no charge is made and the credit message is maintained.
  6.  
  7.  
  8.  
  9. \ ALIGNDATA  I80186    \ For PC/AT, etc
  10. 100 MSDOS
  11. 8192 CONSTANT BUFSIZ    \ Use big buffers
  12. SCONSTANT SDEFSTR 4TH"    \ Source Defaults to .4TH 
  13. SCONSTANT DDEFSTR SCR"    \ Destination Defaults to .SCR 
  14. INCLUDE VARS
  15. INCLUDE FILTER
  16.  
  17. -1 CONSTANT TRUE  
  18. 0 CONSTANT FALSE
  19. 64 CONSTANT C/L
  20. 16 CONSTANT L/SCR
  21.  
  22. VARIABLE LINE#          \ line number on screen
  23. VARIABLE NBLANKS        \ desirable number of blank lines
  24. VARIABLE NEXTSCR?       \ Use --> at end of screens
  25. VARIABLE TITLE?         \ Use first line to title all screens
  26. VARIABLE TITLE  C/L ALLOT \ title for line
  27. VARIABLE SKIPPER?       \ Skip first one or two screens
  28. VARIABLE SMART?         \ Smart(?) packing of screens
  29. VARIABLE ZERO-LINE?     \ set if last line was zero bytes
  30.  
  31. 2 2 IN/OUT
  32. : PAD-LINE ( addr len -- addr len' )
  33.   \ pad a line to a multiple of 64 characters
  34.   DUP 0= ZERO-LINE? !
  35.   DUP C/L /  1+  C/L *  >R ( newlength )
  36.   2DUP + R@ ROT - BL FILL ( padding )
  37.   R> ( return new length ) ;
  38.  
  39.  
  40. \ PROCESS INPUT LINE
  41.  
  42. VARIABLE LINEBUF  1024 ALLOT
  43. VARIABLE LB2       128 ALLOT ( second line )
  44. VARIABLE SPAN2
  45.     VARIABLE WAS-SMART?
  46.  
  47. 0 0 IN/OUT
  48. : BE-SMART???  WAS-SMART? ON
  49.   BEGIN
  50.     SPAN @  ( current line length )
  51.     LB2 128 EXPECT  ( get auxline )
  52.     SPAN @ SPAN2 !  SPAN ! ( fix lengths )
  53.     SPAN2 @ 0>  LB2 C@ BL = AND  ( continuing conditions )
  54.      SPAN @ C/L / SPAN2 @ C/L / + 13 < AND  WHILE
  55.     LINEBUF SPAN @ PAD-LINE  2DUP + LB2 SWAP SPAN2 @ CMOVE
  56.     SPAN2 @ + SPAN ! DROP
  57.   REPEAT  ;
  58.  
  59. 0 2 IN/OUT
  60. : GET-LINE ( -- addr length )
  61.   WAS-SMART? @ IF SPAN2 @ 0> IF  LB2 LINEBUF SPAN2 @ CMOVE THEN
  62.                   SPAN2 @ SPAN ! WAS-SMART? OFF
  63.           ELSE  LINEBUF 256 EXPECT  THEN
  64.   SPAN @ 0> IF
  65.      SMART? @  LINEBUF C@ ASCII : = AND IF BE-SMART??? THEN
  66.      LINEBUF SPAN @ 0
  67.       DO COUNT CONTROL I = IF  DUP 1- BL C<- THEN LOOP  
  68.      DROP THEN
  69.      SPAN @ 0< NOT IF  LINEBUF SPAN @ PAD-LINE
  70.                    ELSE  LINEBUF -1 THEN  ;
  71.  
  72. \ MESSAGES
  73. 0 0 IN/OUT 
  74. : NOTICE  
  75.     ." FORTH ENSCREEN CONVERSION PROGRAM" CR
  76.     ." Copyright (C) 1985 by Thomas Almy" CR ;
  77.  
  78. 0 0 IN/OUT 
  79. : USAGE  
  80.     CONSOLE CR
  81.     ." USAGE:  ENSCREEN  [-options] [FORFILE] [SCRFILE] " CR
  82.     ." where FORFILE is an ascii text file (default .4TH)" CR
  83.     ."   or standard input if absent or `-' specified" CR
  84.     ." SCRFILE is the new screen file (default .SCR)." CR
  85.     ." options include:" CR
  86.     ." <digit> -- optimal # blank lines at screen end," CR
  87.     ." N -- use `-->'," CR
  88.     ." T -- title from \ lines," CR
  89.     ." S -- Skip first screens," CR
  90.     ." I -- Smart(?) handling of colon defs." CR
  91.     ABORT ;
  92.  
  93. 0 0 IN/OUT
  94. : GET-OPTIONS  \ read options from command line
  95.  \  LINE# OFF   NEXTSCR? OFF
  96.  \  SKIPPER? OFF  TITLE? OFF
  97.  \  SMART? OFF  WAS-SMART? OFF    
  98.    5 NBLANKS !
  99.    OPTIONSTRING 2@ 0 ?DO
  100.      COUNT DUP ASCII a >= OVER ASCII z <= AND IF BL - THEN  CASE
  101.         ASCII - OF  ( ignore ) ENDOF
  102.         ASCII N OF  NEXTSCR? ON ENDOF
  103.         ASCII T OF  TITLE? ON  TITLE C/L BL FILL ENDOF
  104.         ASCII S OF  SKIPPER? ON ENDOF
  105.         ASCII I OF  SMART? ON ENDOF
  106.         DUP ASCII 9 <= OVER ASCII 1 >= AND IF
  107.            DUP ASCII 0 - NBLANKS !
  108.            ELSE CONSOLE ." bad option--" DUP EMIT USAGE  THEN
  109.       ENDCASE LOOP DROP ;     
  110.  
  111. 0 0 IN/OUT
  112. : ?SKIP-SCREENS
  113.    SKIPPER? @ IF  NEXTSCR? @ IF C/L L/SCR * ELSE
  114.                                C/L L/SCR * 2* THEN ( skip bytes)
  115.                  SPACES  THEN  ;
  116.  
  117. 0 0 IN/OUT
  118. : FILL-SCREEN  ( fill screen to end with blanks )
  119.    L/SCR LINE# @ -  C/L *
  120.    NEXTSCR? @ IF ." -->"  3 ( len of "-->" ) - THEN
  121.    SPACES
  122.    LINE# OFF ;
  123.  
  124. 2 2 IN/OUT
  125. : ?SET-TITLE   ( addr len -- addr len )
  126.       DUP 0> IF TITLE? @ IF  OVER C@ ASCII \ = IF
  127.          DROP TITLE C/L CMOVE
  128.          LINE# @ IF FILL-SCREEN ( force form-feed ) THEN
  129.         GET-LINE THEN THEN THEN ;
  130.  
  131. 0 0 IN/OUT
  132. : ?PUT-TITLE    TITLE? @ IF  TITLE C/L TYPE  ELSE
  133.                              C/L SPACES THEN
  134.       1 LINE# ! ;
  135.  
  136. 0 0 IN/OUT
  137. : PROCESS-LINES
  138.   BEGIN  GET-LINE  ?SET-TITLE
  139.      DUP 0< NOT WHILE \ Leave if no line
  140.      LINE#  @ 0= IF  ?PUT-TITLE  THEN
  141.      L/SCR LINE# @ - NBLANKS @ = ZERO-LINE? @ AND NOT
  142.      IF  ( not deleting blank line )
  143.       DUP C/L /  DUP  L/SCR LINE# @ -  SWAP -
  144.       NBLANKS @  < IF FILL-SCREEN ?PUT-TITLE THEN
  145.      ( #lines ) LINE# +!
  146.      TYPE     ELSE  2DROP THEN
  147.   REPEAT  2DROP
  148. ;
  149.  
  150. : MAIN   
  151.     SETBUFS ( allow I/O )
  152.     NOTICE
  153.     SETFILES IF USAGE THEN ( bad news? )
  154.     GET-OPTIONS
  155.     ?SKIP-SCREENS
  156.     PROCESS-LINES
  157.     NEXTSCR? OFF  FILL-SCREEN
  158.     BYE ;
  159.  
  160. INCLUDE DOS2
  161. INCLUDE FORTHLIB
  162.  
  163. END
  164.  
  165.