ANEW --showup-- \ Wil Baden 2002-04-14 \ ******************************************************************* \ * * \ * Wil Baden 2003-01-28 * \ * * \ * Show up * \ * * \ * UP ( n -- ) * \ * Display clipboard in _n_ columns. * \ * * \ * UPS ( n -- ) * \ * Sort codes and re-tabulate codes and keys in _n_ columns. * \ * * \ * UPT ( n -- ) * \ * Sort keys and re-tabulate codes and keys in _n_ columns. * \ * * \ * * \ ******************************************************************* \ Clear-Image-Block ( -- ) \ Clear the Image-Block to blanks, and set `#EOL-CHAR` at the \ end of each row. Zero `OUT`. \ Init-Image-Block ( chars/entry entries/row rows/block -- ) \ Setup parameters for the Image-Block. \ Move-to-Image-Block ( str len -- ) \ Move line to Image-Block. \ .Image-Block ( -- ) \ Display and clear Image-Block. \ Term-Image-Block \ Terminate block image display. \ UP ( n -- ) \ Display clipboard in _n_ columns. 20 VALUE #Chars/Entry \ The number of chars for each entry. 4 VALUE #Entries/Row \ The number of entriess for each row. 25 VALUE #Rows/Block \ The number of rows for each block. 25 VALUE Max#Chars/Entry \ Maximum number of chars for each entry. 64 VALUE Max#Chars/Row \ Maximum number of chars for each row. #Chars/Entry #Entries/Row 1+ * \ The computed number of chars VALUE #Chars/Row \ for each row. #Chars/Row #Rows/Block * \ The computed number of chars VALUE #Chars/Block \ for each block. #Entries/Row #Rows/Block * \ The computed number of entries VALUE #Entries/Block \ for each block. \ S" /PAD" ENVIRONMENT? NOT [IF] 84 [THEN] CONSTANT /PAD 0 VALUE Image-Block \ Address of image block. \ *********************** Clear-Image-Block *********************** : Clear-Image-Block ( -- ) Image-Block #Chars/Block ( str len) 2dup BL FILL BOUNDS DO ( ) #EOL-CHAR I #Chars/Row 1- chars + C! #Chars/Row +LOOP 0 OUT ! ; \ *********************** Init-Image-Block ************************ : Init-Image-Block ( chars/entry entries/row rows/block -- ) PAD /PAD + to Image-Block to #Rows/Block to #Entries/Row to #Chars/Entry #Chars/Entry #Entries/Row 1+ * to #Chars/Row #Chars/Row #Rows/Block * to #Chars/Block #Entries/Row #Rows/Block * to #Entries/Block Clear-Image-Block ; \ ************************* .Image-Block ************************** : .Image-Block ( -- ) Image-Block #chars/block CLIP bounds ?do i #chars/row CLIP type cr #chars/row +loop Clear-Image-Block ; \ ********************** Move-to-Image-Block ********************** \ Sequence>Entry ( seq -- offset ) \ Translate sequence# to position in block. : Sequence>Entry ( seq -- offset ) #Rows/Block /MOD ( row entry) SWAP #Entries/Row 1+ * + #Chars/Entry * ; \ Advance-to-Next-Entry ( -- ) \ Advance to next entry, displaying Image-Block when fuil. : Advance-to-Next-Entry ( -- ) OUT 1 over +! @ #Entries/Block = IF .Image-Block THEN ; : Move-to-Image-Block ( str len -- ) dup 0= IF 2DROP EXIT THEN BEGIN OUT @ #Rows/Block < NOT ANDIF OUT @ Sequence>Entry 2 - Image-Block + #Chars/Entry CLIP NIP THEN WHILE Advance-to-Next-Entry REPEAT OUT @ 1+ #Entries/Row MOD 0= IF #Chars/Entry 2* 1- MIN THEN OUT @ Sequence>Entry Image-Block + SWAP MOVE ( ) Advance-to-Next-Entry ; \ *********************** Term-Image-Block ************************ : Term-Image-Block Image-Block #Chars/Block CLIP NIP to #Chars/Block OUT @ IF .Image-Block THEN PAD /PAD + Image-Block over - TYPE ; \ UP ( n -- ) \ List _n_ up. 2variable UPHOLD variable len 4 len ! variable wid 76 wid ! : So-Many-Up ( -- ) TEMP @ IF #Chars/Entry #Entries/Row TEMP @ 1- over + over / ( chars/entry entries/row rows/block) Init-Image-Block UPHOLD 2@ BEGIN Split-Next-Line CLIP dup WHILE dup >R PAD PLACE LEN @ R> - 0 MAX ( &key /fill) 1+ 0 DO S" " PAD APPEND LOOP ( &key) PAD COUNT Move-to-Image-Block REPEAT 2DROP 2DROP Term-Image-Block CR THEN ; : UP ( n -- ) dup (.) NIP 3 + WIPED WID @ over / to #Chars/Entry to #Entries/Row ( ) CLIPBOARD UPHOLD 2! 0 TEMP ! FOR-EACH-LINE EMPTY? IF So-Many-Up 2dup UPHOLD 2! 0 TEMP ! ELSE 1 TEMP +! dup LEN @ MAX 2 + #Chars/Entry < NOT IF 1 TEMP +! THEN 2DROP THEN REPEAT So-Many-Up ; \ UPT ( n -- ) \ Sort and re-tabulate codes and keys in _n_ up. : Tabulate-on-Tab TEMP @ IF #Chars/Entry #Entries/Row TEMP @ 1- over + over / ( chars/entry entries/row rows/block) Init-Image-Block Temp-List FOR-EACH-ITEM ( &key) dup >INFO ( &key &info) COUNT dup >R PAD PLACE len @ R> - 0 MAX ( &key /fill) 1+ 0 DO S" " PAD APPEND LOOP ( &key) COUNT PAD APPEND ( ) PAD COUNT Move-to-Image-Block REPEAT Term-Image-Block CR THEN ; : UPT ( n -- ) dup (.) NIP 4 + WIPED wid @ over / to #Chars/Entry to #Entries/Row ( ) HERE >R align Temp-List Init-List 0 TEMP ! FOR-EACH-LINE bl skip EMPTY? IF Tabulate-on-Tab R@ HERE - ALLOT align Temp-List Init-List 0 TEMP ! ELSE BEGIN BL SKIP dup WHILE 2dup BL SCAN CHOP ( rest . str .) 2>R ( rest .) BL SKIP 2dup S" " HUNT CHOP ( rest . key .) 1 TEMP +! r@ len @ max over + 2 + #chars/entry < not if 1 temp +! then Temp-List Add-New ( rest .) 2R> ( rest . str .) STRING, ( rest .) REPEAT 2DROP THEN REPEAT Tabulate-on-Tab R> HERE - ALLOT ; \ ****************************** UPS ****************************** : Tabulate-on-SORT TEMP @ IF #Chars/Entry #Entries/Row TEMP @ 1- over + over / ( chars/entry entries/row rows/block) Init-Image-Block Temp-List FOR-EACH-ITEM ( &key) dup COUNT dup >R PAD PLACE len @ R> - 0 MAX ( &key /fill) 1+ 0 DO S" " PAD APPEND LOOP ( &key) >INFO COUNT PAD APPEND ( ) PAD COUNT Move-to-Image-Block REPEAT Term-Image-Block CR THEN ; : UPS dup (.) NIP 4 + Wipe-Chars wid @ over / to #Chars/Entry to #Entries/Row HERE >R align Temp-List Init-List 0 TEMP ! FOR-EACH-LINE bl skip EMPTY? IF Tabulate-on-SORT R@ HERE - ALLOT align Temp-List Init-List 0 TEMP ! ELSE BEGIN BL SKIP dup WHILE 2dup BL SCAN CHOP ( rest . key .) 2>R ( rest .) BL SKIP 2dup S" " HUNT CHOP ( rest . str .) 1 TEMP +! r@ len @ max over + 2 + #chars/entry < not if 1 temp +! then 2R> ( rest . str . key .) Temp-List Add-New ( rest . str .) STRING, ( rest .) REPEAT 2DROP THEN REPEAT Tabulate-on-SORT R> HERE - ALLOT ; : Drop-Commentary Wipe-Line \ 15 Wipe-Chars ( Line Filter ) OUT OFF FOR-EACH-LINE EMPTY? IF OUT @ IF OUT OFF CR THEN ELSE COMMENTARY? IF 2DROP ELSE TYPE CR OUT ON THEN THEN REPEAT ; \\ End of Image-Block