Power-Programmierung/CD1.mdf/forth/rbsrc/[e-mail]

Text File | 1988-05-09 | 54KB | 1 lines

\ @Form                                      HS  22:20 04/24/88                                                                     This overlay fetches a record from the a defined data dictionary.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           \ Load Screen                                    19:46 04/13/88                                                                                                                                                                                                 : MARKER ;                                                      2 52 THRU 2 52 THRU                                             BSAVE OVERLAY RB@FORM                                           FORGET MARKER                                                   BYE                                                                                                                             2 51 THRU                                                       SYSTEM-INIT                                                     SCR-INIT                                                        0 RB@FORM                                                                                                                                                                                       \ Variables                                  hs  10:41 02/22/88 FORTH DEFINITIONS DECIMAL                                       BSTART OVERLAY                                                                                                                  INCLUDE FIELD.DEF                  \ the field definitions      INCLUDE FILES.DEF                  \ the master defintions      INCLUDE LCGLOBAL.DEF               \ the current record                                                                         DICTIONARY WRK.DCT NULL            \ the actual data dictionary DICTIONARY WRK.DAT NULL            \ the item definitions       DICTIONARY REL.DCT NULL            \ for a relation             DICTIONARY REL.DAT NULL            \ the data                                                                                   07 10 12 40 WINDOW RELW                                         01 01 21 77 WINDOW VIRTW       \ the work window                07 07 08 25 WINDOW SORTW                                        \ Variables -- Cont.                             13:05 03/15/88                                                                                                                                                                                                 CREATE REL.PAD  99  ALLOT                                       CREATE INDICES  100 ALLOT                                                                                                       94 CONSTANT TYPES                                                                                                               CREATE NEW-KEYS 20 C, 13 C, 80 C, 72 C, 27 C, 68 C, 60 C, 71 C,                       81 C, 73 C, 59 C, 82 C, 61 C, 62 C, 63 C,                       83 C, 64 C, 67 C, 46 C, 18 C, 19 C,                                                                                                                                                                                                                                                                       \ Equates                                        18:16 05/04/88                                                                 0 EQU CUR#              0 EQU SIZE                              0 EQU OFFSET            0 EQU MODE                              0 EQU ?FILTER           0 EQU #FILTER                           0 EQU ANCHOR            0 EQU OLD.BUFF                          0 EQU SHOLD             0 EQU DUMMY                                                                                                                                                                                                                             ' NOOP ' NOOP 0 WRK.DAT " NULL" INDEX SORT.IDX                                                                                                                                                                                                                                                                                                                                                  \ redo                                       HS  14:43 12/18/87                                                                 : REDO:    20 0 ?DO                                                               FLD.BUFF FLD.NAME 19 I - + C@                                   126 33 ISSET                                                    IF ASCII : FLD.BUFF FLD.NAME 19 I 1- - + C!                        21 I - LEAVE                                                 THEN                                                          LOOP ;                                                                                                                                                                          : >OFFSET      ( buff --- 'buff )                                              FLD.BUFF FLD.OFFSET @ + ;                                                                                                                                                                                                                        ( draw-db & form-xy?                           15:28 11/17/87 )                                                                 : DRAW-DB  WRK.DCT D.HU @ 0                                                ?DO                                                               FLD.BUFF I WRK.DCT DICT-READ                                    FLD.BUFF FLD.?IDX C@ IF 1 INDICES I + C! THEN                   FLD.BUFF FLD.COL C@                                             FLD.BUFF FLD.ROW C@                                             FULLW NOR REDO: FLD.BUFF FLD.NAME WND-STR!                    LOOP ;                                                                                                               ( -- cl rw window )                                             : FORM-XY? FLD.BUFF FLD.COL C@ FLD.BUFF FLD.NLEN C@ + 2+                   FLD.BUFF FLD.ROW C@ FULLW ;                                                                                                                                                          ( @text & @number                              15:28 11/17/87 )                                                                 ( -- return key )                                               : @TEXT    FORM-XY? WRK.BUFF >OFFSET                                       FLD.BUFF FLD.LENGTH @ @STRING ;                                                                                                                                                      : @NUMBER  FLD.BUFF FLD.MS/LS @ 256 /MOD >R >R                             FORM-XY? WRK.BUFF >OFFSET 2@                                    R> R> @NUM >R WRK.BUFF >OFFSET 2!                               R> ;                                                                                                                                                                                                                                                                                                                                                                                 ( @date & @zip                                 15:27 11/17/87 )                                                                 : @DATE1   FORM-XY? WRK.BUFF >OFFSET 2@                                    2DUP D0= IF 2DROP @DATE 2DUP WRK.BUFF >OFFSET 2! THEN           GET-DATE >R WRK.BUFF >OFFSET 2!                                 R> ;                                                                                                                                                                                 : @ZIP     FORM-XY? " nnnnn-nnnn"                                          WRK.BUFF >OFFSET 10 STRPCK DUP >R FMT-INPUT                     R> 1+ WRK.BUFF >OFFSET 10 CMOVE ;                                                                                    : @YES/NO  FORM-XY? WRK.BUFF >OFFSET C@                                    ?YES/NO ABS WRK.BUFF >OFFSET C! ;                                                                                                                                                    \ @state                                         14:30 02/25/88                                                                 : STATES    " ALAKAZARCACOCTDEDCFLGAGUHIIDILINIAKSKYLAMEMDMAMIMNMSMOMTNENVNHNJNMNYNCNDOHOKORPAPRRISCSDTNTXUTVTVAVIWAWVWIWY" ;                                                                                                                                   : @STATE   ( --- ret_code )                                              0 BEGIN                                                              DROP                                                            FORM-XY? WRK.BUFF >OFFSET DUP @                                 8224 = IF SYS.STATE @ OVER ! THEN                               2 @STRING STATES COUNT                                          WRK.BUFF >OFFSET 2 STRNDX -1 <>                              UNTIL ;                                                                                                                                                                              \ compares                                       14:27 03/14/88                                                                 ' NOOP ' NOOP MAX_REC_SZ REL.DAT " NULL" INDEX REL.IDX                                                                                                                                          : CMP-NUM   ( buffa buffb --- ret_code )                                    >R OFFSET + 2@                                                  R> OFFSET + 2@ NUMCMP ;                                                                                             : NUM>HASH  ( buffa --- ret_code )                                          OFFSET + 2@ DROP 149 MOD ;                                                                                                                                                                                                                                                                                                                                                          \ cmp-str                                        14:27 03/14/88                                                                 : CMP-STR   ( buffa buffb --- )                                             >R OFFSET + SIZE                                                   STRPCK MAKELC COUNT                                          R> OFFSET + SIZE                                                   STRPCK MAKELC COUNT STRCMP                                   ;                                                                                                                   : STR>HASH  ( buffer --- value )                                            OFFSET + SIZE                                                   HASH-STR ;                                                                                                                                                                                                                                                                                                          \ idx-set                                        14:32 03/14/88                                                                                                                                 : IDX-STR  ( 'idx --- )                                                    ['] CMP-STR OVER IDX.CMP !                                      ['] STR>HASH SWAP IDX.HASH ! ;                                                                                                                                                       : IDX-NUM  ( 'idx --- )                                                    ['] CMP-NUM OVER IDX.CMP !                                      ['] NUM>HASH SWAP IDX.HASH ! ;                                                                                                                                                                                                                                                                                                                                                       \ make-relation                              hs  10:40 02/22/88                                                                 ' NO.COND REL.DAT SEL.BUFF 0 0 DCT-CHOICE RELATC                                                                                : MAKE-RELATION  (  --- )                                              FLD.BUFF FLD.RELATION @ REL.DAT SWAP NAME>DAT                   REL.DAT HCB>N REL.IDX NAME>HCB                                  FLD.BUFF FLD.ROFF @ RELATC 1+ !         \ offset                FLD.BUFF FLD.RLEN @ 40 MIN DUP RELATC C!                        20 MAX 2+ RELW WINDOW-#COL C! ;                                                                                                                                                                                                                                                                                                                                                                                                                          \ idx-search                                     11:06 03/15/88                                                                                                                                 : IDX-SEARCH  ( --- -1 not found, item# )                                     SEL.BUFF MAX_REC_SZ ERASE                                       REL.PAD SEL.BUFF OFFSET + SIZE CMOVE                            REL.IDX 2 FOPEN DROP                                            REL.IDX SEL.BUFF IDX-FIND                                       REL.IDX FCLOSE DROP                                             ;                                                                                                                                                                                                                                                                                                                                                                                                                                                 \ dct-search                                     10:47 03/16/88                                                                                                                                 : <comp>      REL.PAD SIZE SEL.BUFF OFFSET + SIZE                             STRCMP 0= ;                                                                                                       : DCT-SEARCH  ( --- -1 not found, #item )                                     SEL.BUFF MAX_REC_SZ ERASE                                       ['] <comp> SEL.BUFF REL.DAT NXT-ITEM                            ?DUP NOT IF REL.DAT D.LST-READ @ THEN ;                                                                                                                                                                                                                                                                                                                                                                                                           \ rel-find                                       09:35 03/16/88                                                                 : REL-FIND     ( --- -1=not found, #item )                                     FLD.BUFF FLD.R?IDX C@ 1 =                                       IF IDX-SEARCH                                                   ELSE DCT-SEARCH                                                 THEN  ;                                                                                                                                                                                                                                          : SET-CH.TYPE  FLD.BUFF FLD.R?IDX C@ 1 =                                       IF REL.IDX                                                      ELSE REL.DAT THEN RELATC 5 + ! ;                                                                                                                                                                                                                 \ @rel-string                                    09:20 03/15/88                                                                 : @REL-STRING   ( --- flag or item#, ret_key )                                  REL.IDX TYPES FLD.BUFF FLD.RTYPE C@ @BIT                        IF IDX-NUM ELSE IDX-STR THEN                                    REL.IDX FLD.BUFF FLD.FIELD @ CHG-IDX                            FLD.BUFF FLD.ROFF @ EQU OFFSET                                  FLD.BUFF FLD.RLEN @ EQU SIZE                                    SEL.BUFF WRK.BUFF >OFFSET @ REL.DAT DICT-READ                   SEL.BUFF OFFSET + REL.PAD SIZE CMOVE                            FORM-XY? REL.PAD SIZE @STRING                                   DUP 60 = IF DROP -1 13 EXIT THEN                                SPAN C@ IF REL-FIND SWAP ELSE WRK.BUFF >OFFSET @                           SWAP THEN ;                                                                                                                                                          \ @relation                                      10:57 02/22/88                                                                 : @RELATION ( --- ret_key )                                                 MAKE-RELATION REL.DAT OPEN-DICTIONARY                           SET-CH.TYPE                                                     @REL-STRING SWAP DUP -1 = IF DROP                               LC.BUFF LC.DESCR 20 STRPCK NONE SINGLE RELW                     OPEN-WINDOW RELATC ch.daddr DI-OPEN                             RELW RELATC DCT-CHOOSE DUP IF 1- SEL.BUFF OVER                  REL.DAT DICT-READ RELATC ch.daddr DI-CLOSE                      SEL.BUFF OFFSET + REL.PAD SIZE CMOVE THEN                       RELW CLOSE-WINDOW THEN                                          WRK.BUFF >OFFSET !                                              FORM-XY? HIL SIZE REL.PAD WND-STR!                              REL.DAT CLOSE-DICTIONARY ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          \ @fmt-str                                       11:44 02/26/88                                                                                                                                 : @FMT-STR   ( --- ret_key )                                                  FORM-XY? FLD.BUFF FLD.CNTL_BUFF FLD.BUFF                        FLD.LENGTH @ STRPCK                                             WRK.BUFF >OFFSET FLD.BUFF                                       FLD.LENGTH @ STRPCK DUP >R FMT-INPUT                            R> COUNT WRK.BUFF >OFFSET                                       SWAP CMOVE ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      : DEBUG         PRINTER CR                                                      CR ." Definition: " WRK.DCT HCB>H .                             CR ." Data      : " WRK.DAT HCB>H .                             CR ." Name      : " WRK.DAT .FNAME                              CR ." Address   : " WRK.DAT .                                   CR ." FreeSpace : " FREESPACE 2DROP U.                          CONSOLE ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       ( @item                                        15:28 11/17/87 )                                                                 CREATE '@TYPES ] @TEXT @NUMBER NOOP @RELATION @DATE1 @ZIP                        @YES/NO @FMT-STR @STATE [                                                                                      : @FIELD  FLD.BUFF FLD.TYPE C@ 2* '@TYPES + PERFORM ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           ( Tits                                         10:06 11/18/87 )                                                                                                                                 : .MODE     35 24 FULLW REV MODE IF " Edit Form"  ELSE                            " Add Form "  THEN WND-CSTR!                              51 24 FULLW REV ?FILTER                                               IF " FILTER" ELSE "       " THEN WND-CSTR!                ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   \ .actives                                       22:06 04/24/88                                                                 : .ACTIVES  WRK.DAT D.NA @ MODE IF WRK.DAT D.LST-READ @ 1+                                      ELSE DUP THEN >R                65 24 FULLW REV "              " WND-CSTR!                      65 24 FULLW REV R> 0 <# 32 HOLD 102 HOLD 111 HOLD 32 HOLD #S #> DUP >R SWAP WND-STR! R> SWAP >R                                 65 + 24 FULLW REV R> 0 <# 32 HOLD #S #> SWAP WND-STR! ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         \ tits                                           13:00 03/23/88                                                                                                                                 : TITS       PAD 80 BLANK                                                    0 24 FULLW REV 80 PAD WND-STR!                                  2 24 FULLW REV 30 LC.BUFF LC.DESCR WND-STR!                    60 24 FULLW REV " Item"  WND-CSTR!                               .MODE ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            \ add-indexes                                    13:39 03/14/88                                                                 ' NOOP ' NOOP MAX_REC_SZ WRK.DAT " NULL" INDEX WRK.IDX                                                                          : ADD-INDEX    EQU CUR# WRK.DCT D.HU @ 0 ?DO                                   INDICES I + C@                                                  IF FLD.BUFF I WRK.DCT DICT-READ                                    WRK.IDX TYPES FLD.BUFF FLD.TYPE C@ @BIT                         IF IDX-NUM ELSE IDX-STR THEN                                       FLD.BUFF FLD.OFFSET @ EQU OFFSET                                FLD.BUFF FLD.LENGTH @ EQU SIZE                                  WRK.IDX I CHG-IDX WRK.IDX 2 FOPEN DROP                          WRK.IDX WRK.BUFF CUR#                                           MODE IF IDX-UPD ELSE IDX-ADD THEN                               WRK.IDX FCLOSE DROP                                       THEN LOOP ;                                      \ setup                                          15:07 03/14/88                                                                                                                                                                                                                                                                 : FORM-WRITE  33 0 FULLW HIL " [ Updating ]" WND-CSTR!                        WRK.BUFF WRK.DAT                                                MODE IF WRK.DAT D.LST-READ @ DUP >R SWAP                                DICT-WRITE R>                                           ELSE ADD-ITEM THEN ADD-INDEX                                    33 0 FULLW NOR " ════════════" WND-CSTR! ;                                                                                                                                                                                                                                                                                                                                        \ clr-wrk.pad                                    13:03 03/15/88                                                                                                                                 : CLR-WRK.PAD   ( --- )                                                         REL.PAD 99 BLANK                                                0 WRK.BUFF C!                                                   WRK.DCT D.HU @ 0                                                ?DO                                                               FLD.BUFF I WRK.DCT DICT-READ WRK.BUFF >OFFSET                   FLD.BUFF FLD.LENGTH @                                           TYPES FLD.BUFF FLD.TYPE C@ DUP >R @BIT                          IF ERASE ELSE BLANK THEN                                        R> 4 = IF @DATE WRK.BUFF >OFFSET 2! THEN                      LOOP ;                                                                                                                                                                          \ display works                                  15:32 03/16/88                                                                 : .TEXT    FORM-XY? HIL FLD.BUFF FLD.LENGTH @ WRK.BUFF >OFFSET             WND-STR! ;                                                                                                           : .NUM     PAD 11 BLANK                                                    FORM-XY? HIL 11 PAD WND-STR!                                    FORM-XY? HIL WRK.BUFF >OFFSET 2@ FLD.BUFF FLD.MS/LS             @ 256 MOD <#NUM#> SWAP WND-STR! ;                                                                                    : .REL     MAKE-RELATION                                                   REL.DAT OPEN-DICTIONARY                                         SEL.BUFF WRK.BUFF >OFFSET @ REL.DAT DICT-READ                   REL.DAT CLOSE-DICTIONARY                                        FORM-XY? HIL FLD.BUFF FLD.RLEN @ SEL.BUFF                       FLD.BUFF FLD.ROFF @ + WND-STR! ;                     \ display works                                  15:32 03/16/88                                                                 : .YES/NO  FORM-XY? HIL 3 WRK.BUFF >OFFSET C@ 3 * " No Yes" 1+ +           WND-STR! ;                                                                                                           : .DATE    FORM-XY? HIL WRK.BUFF >OFFSET 2@ SWAP 100 /MOD DROP             SWAP 256 /MOD 100 * + 100 UM* ROT 0 D+                          <# # # 47 HOLD # # 47 HOLD # # #> SWAP WND-STR! ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    \ .dct-item                                      17:51 03/16/88                                                                                                                                 CREATE '.TYPES ] .TEXT .NUM NOOP .REL .DATE .TEXT                                .YES/NO .TEXT .TEXT [                                                                                          : .DCT-ITEM   WRK.DCT D.HU @ 0                                                ?DO                                                               FLD.BUFF I WRK.DCT DICT-READ                                    FLD.BUFF FLD.TYPE C@ 2* '.TYPES + PERFORM                     LOOP ;                                                                                                                                                                                                                                                                                                                                                                            \ filter support                                 13:19 03/23/88                                                                 INCLUDE FILTER.DEF                                                                                                              CREATE MY.BUFF  SIZEOF FILTER 15 * ALLOT                                                                                        : 'FLT.BUFF     SIZEOF FILTER * MY.BUFF + ;                                                                                     : FLT.CMP-TEXT  #FILTER 'FLT.BUFF DUP >R FLT.HOLD                               R@ FLT.SIZE @ WRK.BUFF R> FLT.OFFSET @ + OVER                   2DUP MAKEUC 2SWAP STRCMP ;                                                                                      : FLT.CMP-DNUM  #FILTER 'FLT.BUFF DUP >R FLT.HOLD 2@                            WRK.BUFF R> FLT.OFFSET @ + 2@ 2SWAP NUMCMP ;                                                                                                                                    \ compares                                       13:51 03/23/88                                                                 : LT      ( value --- t/f )                                               -1 = ;                                                : GT      ( value --- t/f )                                               1 = ;                                                 : EQ      ( value --- t/f )                                               0= ;                                                                                                                  CREATE CVECS  ] LT EQ GT [                                                                                                      : FLT.CMP-SNUM  #FILTER 'FLT.BUFF DUP >R FLT.HOLD @ 0                           WRK.BUFF R> FLT.OFFSET @ + @ 0 2SWAP NUMCMP ;                                                                   : FLT.CMP-BYTE  #FILTER 'FLT.BUFF DUP >R FLT.HOLD C@ 0                          WRK.BUFF R> FLT.OFFSET @ + C@ 0 2SWAP NUMCMP ;  \ filter compares                                08:07 03/24/88                                                                 : FLT.CMP-RELAT REL.DAT #FILTER 'FLT.BUFF FLT.RFILE# @                          DUP >R NAME>DAT REL.DCT R> NAME>DCT                             REL.DCT OPEN-DICTIONARY                                            SEL.BUFF #FILTER 'FLT.BUFF FLT.RFLD# @                          REL.DCT DICT-READ                                            REL.DCT CLOSE-DICTIONARY                                        SEL.BUFF FLD.OFFSET @ SEL.BUFF FLD.LENGTH @                     38 MIN REL.DAT OPEN-DICTIONARY                                    SEL.BUFF WRK.BUFF #FILTER 'FLT.BUFF FLT.OFFSET                  @ + @ REL.DAT DICT-READ                                       REL.DAT CLOSE-DICTIONARY                                        #FILTER 'FLT.BUFF FLT.HOLD SWAP ROT                             SEL.BUFF SWAP + OVER 2DUP MAKEUC STRCMP ;                                                                       \ <flt-cmp>                                      09:09 03/24/88                                                                 : <flt-cmp>   #FILTER 'FLT.BUFF FLT.TYPE C@                                   CASE                                                              0 OF FLT.CMP-TEXT    ENDOF                                      1 OF FLT.CMP-DNUM    ENDOF                                      3 OF FLT.CMP-RELAT   ENDOF                                      4 OF FLT.CMP-DNUM    ENDOF                                      6 OF FLT.CMP-BYTE    ENDOF                                    ENDCASE                                                         #FILTER 'FLT.BUFF FLT.OPER C@ 2* CVECS + PERFORM ;                                                                                                                                                                                                                                                                                                                                \ filter-cmp                                     13:54 03/23/88                                                                                                                                                                                                 : FILTER-CMP  ?FILTER                                                         IF -1                                                           15 0 DO                                                               I 'FLT.BUFF FLT.OFFSET @                                        IF I EQU #FILTER <flt-cmp> AND THEN                            LOOP                                                       ELSE                                                               NO.COND                                                      THEN ;                                                                                                                                                                                                                                            \ ?changed                                       13:13 04/14/88                                                                 \ CREATE OLD.BUFF MAX_REC_SZ ALLOT                                                                                              : ?CH-SETUP   DS0 WRK.BUFF OLD.BUFF 0 MAX_REC_SZ CMOVEL ;                                                                       : ?CHANGED    DS0 WRK.BUFF MAX_REC_SZ OLD.BUFF 0 MAX_REC_SZ                   STRCMPL 0<> ;                                                                                                     : RESTORE-OLD OLD.BUFF 0 DS0 WRK.BUFF MAX_REC_SZ CMOVEL ;                                                                       : UPD-ITEM    ?CHANGED IF                                                     WRK.DAT D.LST-READ @                                            FORM-WRITE                                                      WRK.DAT D.LST-READ ! THEN ;                                                                                       \ pg-down & pg-upper                             09:03 03/21/88                                                                                                                                 : PG-DOWN    ( --- ) UPD-ITEM                                                ['] FILTER-CMP WRK.BUFF SHOLD NXT-ITEM 0=                       IF VIRTW POP-WINDOW VIRTW PUSH-WINDOW .DCT-ITEM                 ELSE 33 00 FULLW HIL " [ Last Form ]" WND-CSTR!                 ERRTONE THEN ?CH-SETUP ;                                                                                           : PG-UPPER  ( --- ) UPD-ITEM                                                ['] FILTER-CMP WRK.BUFF SHOLD LST-ITEM 0=                       IF VIRTW POP-WINDOW VIRTW PUSH-WINDOW .DCT-ITEM                 ELSE 32 00 FULLW HIL " [ First Form ]" WND-CSTR!                ERRTONE THEN ?CH-SETUP ;                                                                                                                                                            \ toggle-mode                                    09:33 03/21/88                                                                                                                                 : TOGGLE-MODE  ( --- ) WRK.DAT D.NA @ IF                                       MODE 1 XOR EQU MODE                                             MODE IF WRK.BUFF WRK.DAT D.LST-READ @ WRK.DAT                           DICT-READ ?CH-SETUP                                          ELSE CLR-WRK.PAD THEN                                      .MODE .ACTIVES .DCT-ITEM THEN ;                                                                                  : .CUR        0 0 FULLW REV WRK.DAT D.LST-READ @ 0                            <# 32 HOLD #S 32 HOLD #> SWAP WND-STR! ;                                                                                                                                                                                                                                                                          \ nested-@form                                   10:34 03/21/88                                                                                                                                 : NESTED-@FORM ( --- )                                                         FLD.BUFF FLD.TYPE C@ 3 =                                        IF WRK.DCT D.LST-READ @                                          FULLW PUSH-WINDOW ?XY                                           FLD.BUFF FLD.RELATION @ @FORM                                   GOTOXY                                                          FLD.BUFF SWAP WRK.DCT DICT-READ                                 FULLW POP-WINDOW                                               THEN ;                                                                                                                                                                                                                                                                                                           \ @filters                                       14:10 03/23/88                                                                                                                                 : @FILTERS  MY.BUFF WRK.DCT ?FILTER " RBEFILT" BRUN RBEFILT                 FORGET OVERLAY                                                  DUP EQU ?FILTER                                                 IF                                                                 0 WRK.DAT D.LST-READ !                                          MODE IF                                                         ['] FILTER-CMP WRK.BUFF SHOLD NXT-ITEM 0=                       IF ?CH-SETUP                                                       VIRTW POP-WINDOW .DCT-ITEM VIRTW PUSH-WINDOW                 ELSE ERRTONE ?CH-SETUP                                          32 00 FULLW HIL " [ No Matches ]" WND-CSTR! THEN                THEN                                                         THEN ;                                              \ rem-idx                                        12:54 04/14/88                                                                                                                                 : REM-IDX  ( --- )                                                         WRK.DAT D.LST-READ @                                            WRK.DCT D.HU @ 0 ?DO                                            INDICES I + C@ IF                                                 WRK.IDX I CHG-IDX                                               WRK.IDX 2 FOPEN DROP                                            WRK.IDX OVER IDX-DEL                                            WRK.IDX FCLOSE DROP THEN                                      LOOP DROP ;                                                                                                                                                                                                                                                                                                          \ delete                                         09:16 04/14/88                                                                 10 10 3 25 WINDOW DELW                                                                                                          : DELETE   MODE IF                                                               " Delete Form?" NONE SINGLE DELW OPEN-WINDOW                    2 2 DELW NOR " Delete this Form?" WND-CSTR!                    21 2 DELW 0 ?YES/NO NIP                                         DELW CLOSE-WINDOW                                               IF WRK.DAT D.LST-READ @ WRK.DAT DEL-ITEM                           REM-IDX                                                         ['] FILTER-CMP WRK.BUFF SHOLD NXT-ITEM                          IF ['] FILTER-CMP WRK.BUFF SHOLD LST-ITEM                       IF CLR-WRK.PAD THEN THEN .DCT-ITEM                              THEN                                                         THEN ;                                          \ clr-fld                                        11:24 05/02/88                                                                                                                                 : CLR-FLD    WRK.BUFF FLD.BUFF FLD.OFFSET @ +                                FLD.BUFF FLD.LENGTH @                                           TYPES FLD.BUFF FLD.TYPE C@ @BIT                                 IF ERASE ELSE BLANK THEN ;                                                                                                                                                         : RES-FLD    OLD.BUFF 0 FLD.BUFF FLD.OFFSET @ +                              DS0 WRK.BUFF FLD.BUFF FLD.OFFSET @ +                            FLD.BUFF FLD.LENGTH @ CMOVEL ;                                                                                                                                                                                                                                                                                     \ do-views                                       09:04 04/14/88                                                                                                                                 : DO-VIEWS     WRK.DAT CLOSE-DICTIONARY                                        FULLW PUSH-WINDOW                                               ANCHOR .VIEW                                                    FULLW POP-WINDOW                                                WRK.DAT OPEN-DICTIONARY                                         MODE IF WRK.BUFF WRK.DAT D.LST-READ @                                   WRK.DAT DICT-READ .DCT-ITEM                                     ?CH-SETUP                                                       .ACTIVES                                                        DROP 0                                                          THEN ;                                                                                                                                                                   \ sorted-order                                   17:07 05/04/88                                                                 : ?INDEX  FLD.BUFF FLD.?IDX C@ ;                                ' ?INDEX WRK.DCT FLD.BUFF 0 FLD.NAME 20 DCT-CHOICE INDEXC                                                                       : SORTED-ORDER ( --- ) MODE IF                                                 " Order by" NONE SINGLE SORTW OPEN-WINDOW                       SORTW INDEXC DCT-CHOOSE                                         ?DUP IF 1- SORT.IDX ANCHOR ROT NAME>IDX                                 SORT.IDX 2 FOPEN DROP SORT.IDX EQU SHOLD                        -1 SORT.IDX IDX.ME !                                         ELSE SORT.IDX FCLOSE DROP WRK.DAT EQU SHOLD                     THEN                                                       ['] FILTER-CMP WRK.BUFF SHOLD NXT-ITEM DROP                     .DCT-ITEM ?CH-SETUP                                             SORTW CLOSE-WINDOW THEN ;                        \ lreset                                         09:02 04/14/88                                                                                                                                                                                                 : LRESET  ( #fld --- ret ) .MODE FLD.BUFF OVER WRK.DCT DICT-READ          @FIELD 31 00 FULLW NOR " ═════════════════" WND-CSTR!           .ACTIVES ;                                                                                                                                                                                                                                                                                                            : PRT-RPTS   ANCHOR REPORTS ;                                                                                                                                                                                                                                                                                                   ( @scr                                         15:28 11/17/87 ) : @SCR     BEGIN LRESET CASE                                                 72 OF DUP 0= IF DROP WRK.DCT D.HU @ THEN 1-   ENDOF             80 OF 1+ WRK.DCT D.HU @ OVER = IF DROP 0 THEN ENDOF             13 OF 1+ WRK.DCT D.HU @ OVER = IF DROP 0 THEN ENDOF  59 OF 0 HELP       ENDOF    27 OF DROP 0 EXIT        ENDOF      61 OF NESTED-@FORM ENDOF    62 OF @FILTERS           ENDOF      63 OF DO-VIEWS     ENDOF    83 OF DELETE             ENDOF      64 OF PRT-RPTS     ENDOF    82 OF DROP TOGGLE-MODE 0 ENDOF      67 OF MODE 0= IF DROP RESTORE-OLD .DCT-ITEM 0 THEN   ENDOF      46 OF CLR-FLD      ENDOF    18 OF RES-FLD            ENDOF      19 OF SORTED-ORDER ENDOF                                                   68 OF DROP MODE IF UPD-ITEM ELSE -1 EXIT THEN ENDOF             81 OF MODE IF DROP PG-DOWN 0 THEN             ENDOF             73 OF MODE IF DROP PG-UPPER 0 THEN            ENDOF            ENDCASE AGAIN ;                                     \ form-setup                                     14:34 04/14/88                                                                                                                                 : FORM-SETUP   INDICES 100 ERASE ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              \ <@form>                                        14:37 04/14/88                                                                                                                                 : <@form>   ( --- ) FORM-SETUP                                              OK-KEYS @ NEW-KEYS OK-KEYS !                                    VIRTW BOX-CLR OBOX DRAW-DB                                      CLR-WRK.PAD ?CH-SETUP                                           BEGIN  VIRTW PUSH-WINDOW                                            CLR-WRK.PAD .DCT-ITEM                                           0 @SCR DUP IF FORM-WRITE .ACTIVES THEN                          ?CH-SETUP                                                       VIRTW POP-WINDOW 0=                                         UNTIL                                                           OK-KEYS ! ;                                                                                                                                                                         ( rb@form                                      10:02 11/18/87 )                                                                 : RB@FORM   ( #dct --- ) DUP EQU ANCHOR                                     WRK.DAT OVER NAME>DAT                                           WRK.DCT OVER NAME>DCT WRK.IDX SWAP 0 NAME>IDX                   WRK.DAT OPEN-DICTIONARY TITS .ACTIVES                           WRK.DCT OPEN-DICTIONARY                                         WRK.DAT EQU SHOLD                                               MY.BUFF SIZEOF FILTER 15 * ERASE                                32 MALLOC DUP EQU OLD.BUFF                                      -1 <> IF <@form> OLD.BUFF FREE THEN                             WRK.DCT CLOSE-DICTIONARY                                        WRK.DAT CLOSE-DICTIONARY ;                                                                                                                                                                                                                          \ Excises                                        10:44 03/21/88                                                                 EXCISE CUR# SIZE                                                EXCISE OFFSET MODE                                              EXCISE ?FILTER #FILTER                                          EXCISE ANCHOR OLD.BUFF                                          EXCISE SHOLD DUMMY