\ dpans.txt  Leo Wong 31 March 02003 fyj +
\ Look up words in DPANS Forth glossary 
\ Uses unzipped files from:
\ http://www.complang.tuwien.ac.at/forth/dpans.zip
\ Path to these files hardcoded
\ See usage examples at the end of this file

CREATE filename 256 CHARS ALLOT

S" C:/Documents and Settings/Leo/Forth/DPANS/dpans/" filename place
\ S" C:\txt\DPANS\"  filename place

include from.txt

from tools.txt
from string.txt
from sdollar.txt
from linked.txt
from hash.txt
from files.txt

: ListArray
   CREATE  ( u -- )  0 ?DO node LOOP
   DOES> ( n -- a )  SWAP 2* CELLS + ;

hashsize ListArray Table

\ Enter ANS Forth words and glossary references into a table
: Parse-Link  ( ca1 u1 -- ca2 u2 )
   S" href=" NIP /STRING 2DUP 2>R [CHAR] > scan NIP 2R> ROT - ;

:NONAME CELL+ CHAR+ ; IS >comp  \ for inlist?
: Enter  ( 'name u1 'reference u -- ) 
   2>R 2DUP hash Table >R R@ inlist?
   IF 2DROP 1 R> CELL+ @ CELL+ +!
   ELSE R> link 1 C, string, THEN 2R> string, ;

: Entry  ( ca1 u1 -- )  word> Parse-Link 2>R word> 2R> Enter 2DROP ;

: -&; ( a1 u1 -- a2 u2)
   S" &lt;"    S" <" s/r
   S" &gt;"    S" >" s/r
   S" &apos;"  S" '" s/r
   S" &quot;"  S$ '"' s/r
   S" &amp;"   S" &" s/r ;

: -<B>  ( a1 u1 -- a2 u2 )  \ because of ENVIRONMENT?<B>...
   S" <B>"     S"  " s/r ;

: ?Reference  ( ca u -- )
   -&; -<B>
   S" href=" SEARCH >R  2DUP [CHAR] # scan DROP CHAR+ C@ digit? R> AND
   IF Entry ELSE 2DROP THEN ;

: Get-ANSwords
   S" dpansf.htm" filename DUP C@ >R append  filename COUNT open-in
   BEGIN readl WHILE ?Reference REPEAT 2DROP close-in  R> filename C! ;

Get-ANSwords

\ Type html as plain text: not pretty
FALSE VALUE first
: -html  ( a u -- )
   TRUE TO first
   BEGIN DUP 0>
     WHILE 2DUP [CHAR] < scan 2>R R@ - 
         DUP IF first IF CR FALSE TO first THEN
         -&; TYPE ELSE 2DROP THEN
         2R> DUP
     WHILE [CHAR] > scan 1 /STRING
   REPEAT THEN 2DROP ;

CREATE Target 256 CHARS ALLOT
: .Entry  ( a -- a' )
   COUNT CHARS + DUP >R COUNT
   s" <A name=" Target place
   filename C@ >R filename append filename count 
   2DUP [CHAR] # SCAN DUP >R
   1 /STRING Target append [CHAR] > Target cappend R> - 
   open-in  FALSE >R
   BEGIN readl WHILE
     R> IF OVER S" <hr>" TUCK COMPARE >R 
     else OVER Target COUNT TUCK COMPARE 0= >R THEN
     R@ IF -html ELSE 2DROP THEN
   REPEAT CR 2DROP R> DROP
   close-in  R> filename C! R> ;

: .Entries  ( node -- )  CELL+ COUNT 0 ?DO .Entry LOOP DROP ;

: ?Entries  ( a u -- )
   2DUP hash Table Inlist? NIP NIP
   ?DUP IF .Entries ELSE ." Not a Standard word." KEY DROP THEN ;

: Whats  ( -- )  \ Whats <answord>
   0 PARSE 2DUP supper ?Entries ;

: Lookup  ( -- )  Whats ;  \ Lookup <answord>

\ Usage examples:
\ Lookup forth
\ Whats ahead