forth programming language

My Final Program in Forth

\ missy.f  LW 20110915 +
\ Shows changes in a candidate’s database record over time.

INCLUDE string.txt

0 VALUE outfile
: out ( ca u ) outfile WRITE-FILE THROW ;
: lout ( ca u ) outfile WRITE-LINE THROW ;
: ?lout ( ca u ) -TRAILING ?DUP IF lout ELSE DROP THEN ;
: blout  PAD 0 lout ;

: 4dup  2OVER 2OVER ;
: 4drop  2DROP 2DROP ;
: under+ ( a b c - a+c b ) ROT + SWAP ;

0 VALUE dlist
: open-dlist
   S" dlist" R/O OPEN-FILE THROW TO dlist ;
: close-dlist
   dlist CLOSE-FILE THROW ;

: field ( a u – a’ )
   2DUP SWAP , , CHARS + ;
: ,field ( i n1 n2 ca u – i+1 n1+n2 )
   string, field 1 under+ ;

CREATE fields 0 0
 15  S" ID" ,field
 35  S" Name" ,field
 35  S" Street" ,field
 22  S" City State Zip" ,field
  2  S" County" ,field
  1  S" Vets" ,field
  1  S" Fee" ,field
 10  S" Home Phone" ,field
 10  S" Work Phone" ,field
  1  S" Status" ,field
 24  S" Course Work Line 1" ,field
 24  S" Course Work Line 2" ,field
 24  S" Course Work Line 3" ,field
 28  S" Legal Experience Line 1" ,field
 28  S" Legal Experience Line 2" ,field
 28  S" Legal Experience Line 3" ,field
 28  S" General Experience Line 1" ,field
 28  S" General Experience Line 2" ,field
 28  S" General Experience Line 3" ,field
 22  S" Other Education" ,field
 25  S" Legal Tasks" ,field
 50  S" Licences / Certifications" ,field
  1  S" Temp" ,field
  3  S" Appt Type" ,field
 14  S" Geo Areas" ,field
  8  S" Start Date" ,field
  8  S" End Date" ,field
 15  S" unused" ,field

CONSTANT rlen
CONSTANT nfields

: get-name ( i – ca u )
   fields SWAP
   0 ?DO COUNT CHARS + 2 CELLS + LOOP COUNT ;

: get-field ( ca1 i - ca2 u )
   get-name CHARS + 2@ under+ ;

22 CONSTANT fnlen
CREATE filename fnlen CHARS ALLOT
CREATE inpad rlen CHARS ALLOT
CREATE hand rlen CHARS ALLOT

CREATE ssn 9 CHARS ALLOT
: get-ssn
   CR .“ Enter SSN:”
   SSN 9 ACCEPT 9 <>
   IF CR .“ Bad SSN. The previous report will open.”
      5000 MS BYE
   THEN ;

: show-differences
   filename fnlen
   blout blout S" ><> ><> ><> ><> ><> ><> ><> ><> “ out
   2DUP supper out
   S"  <>< <>< <>< <>< <>< <>< <>< <><” lout
   nfields 1 DO
      inpad I get-field
      hand I get-field 4dup COMPARE
      IF
        I get-name blout out blout ?lout ?lout
      ELSE
        4drop
      THEN
   LOOP ;

: READS
   S" missy.txt" R/W CREATE-FILE THROW TO outfile
   S" SSN: “ out ssn 9 lout blout
   hand rlen BLANK
   CR .” Reading “
   BEGIN PAD DUP 84 DLIST READ-LINE THROW
   WHILE
     [CHAR] . EMIT
     S” candrec.2" SEARCH
     IF
       DROP fnlen 2DUP filename SWAP CMOVE
       R/O OPEN-FILE THROW >R
       4001 0 R@ REPOSITION-FILE THROW
       BEGIN inpad rlen R@ READ-FILE THROW
       WHILE
         inpad char+ 9 SSN 9 COMPARE 0=
           IF
             inpad rlen hand rlen COMPARE IF
               show-differences
               inpad hand rlen CMOVE
              THEN
           THEN    
       REPEAT
       R> CLOSE-FILE THROW
     ELSE
       2DROP
     THEN
   REPEAT 2DROP
   blout
   inpad rlen BLANK
   show-differences
   blout
   outfile CLOSE-FILE THROW ;

: fyj  get-ssn open-dlist reads close-dlist ;

fyj BYE