#ans forth

[otesunki]

i am going to Shamelessly advertise my article on my blog because this is My house

additionally where is forthblr i am so disappointed in y'all

[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

[maryandleo]

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