maryandleo

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

A Forth program on tumblr

\ jason.f LW 21 Mar 2011, rev. 11 May 2011 +

\ input: xml

\ output: exam.txt, cand.txt

\ ANS Forth

include from.txt

from jenx.txt

0 value out1

0 value out2

: @move

  CREATE ( a n - a’ ) OVER , CHARS + 

  DOES> @ cbuff @+ ROT SWAP MOVE ;

CREATE outpad 258 CHARS ALLOT

outpad 9 @move /ssn

      20 @move /last-name

      15 @move /first-name

       1 @move /mi

      35 @move /street

      15 @move /city

       2 @move /state

       5 @move /zip

      10 @move /hphone

      10 @move /wphone

       1 @move /vets       \ will get from db

       2 @move /scredits   \ will get from db

       4 @move /prom-unit  \ will get from db

       5 @move /banded-te-score

       5 @move /raw-te-score

outpad - CONSTANT outlen

: opens 

   S” exam.txt” R/W CREATE-FILE THROW TO out1

   S” cand.txt” R/W CREATE-FILE THROW TO out2 ;

: closes

   out1 CLOSE-FILE THROW

   out2 CLOSE-FILE THROW ;

’ -cBuff many: aliases lert-number exam-numbers

               agency agency-name

               agency-contact-name agency-contact-phone

               promotion-unit

               pref-area pref-appt-type pref-appt-duration

               bfoq1 bfoq2 ; DROP

’ -cBuff many: aliases ssn first-name last-name mi street city

     state zip hphone wphone prom-unit

     banded-te-score raw-te-score ; DROP

: lout1

   cBuff @+ out1 WRITE-LINE THROW ;

’ lout1 many: aliases /lert-number /exam-numbers

                      /agency /agency-name

                      /agency-contact-name /agency-contact-phone

                      /promotion-unit

                      /pref-area /pref-appt-type /pref-appt-duration

                      /bfoq1 /bfoq2 ; DROP

: lout2 ( outpad )

    outlen out2 WRITE-LINE THROW ;

: /ssn

    outpad outlen -TRAILING

    IF

       lout2 

    ELSE

       DROP

    THEN

    outpad outlen BLANK

    /ssn ;

: cls 25 0 DO CR LOOP  0 0 AT-XY ;

CREATE lertfile 128 CHARS ALLOT

: get-lert-file

    CR .” LERT: “

    PAD DUP 84 ACCEPT lertfile place

    S” .xml” lertfile append ;

opens

outpad outlen BLANK

cls

get-lert-file 

lertfile COUNT INCLUDED 

outpad lout2

closes

BYE