Power-Programmierung/CD1.mdf/forth/rbsrc/rb-view.scr

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

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                \ Load Screen                                    09:18 04/12/88                                                                 : MARKER ;                                                      2 39 THRU 2 39 THRU                                             BSAVE OVERLAY RBVIEW                                            FORGET MARKER                                                   BYE                                                                                                                             2 39 THRU                                                       SCR-INIT                                                        SYSTEM-INIT                                                     0 RBVIEW                                                                                                                                                                                                                                                                                                                        \ Overlay Definition                             16:21 04/13/88                                                                 FORTH DEFINITIONS DECIMAL                                       BSTART OVERLAY                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  \ includes & dictionaries                        09:19 04/12/88 INCLUDE VIEW.DEF                                                INCLUDE FILES.DEF                                               INCLUDE FIELD.DEF                                                                                                               CREATE  W1.BUFF   MAX_REC_SZ ALLOT                              CREATE  W2.BUFF   MAX_REC_SZ ALLOT                              CREATE  W3.BUFF   MAX_REC_SZ ALLOT                              CREATE  ALT.BUFF  MAX_REC_SZ ALLOT                                                                                              DICTIONARY VIEW.DCT TEST.VW                                                                                                     DICTIONARY W1.DAT   NULL                                        DICTIONARY W2.DAT   NULL                                        DICTIONARY W3.DAT   NULL                                        DICTIONARY TITS.DCT NULL                                        \ windows                                        09:35 04/12/88                                                                 0 0 0 0 WINDOW WND1                                             0 0 0 0 WINDOW WND2                                             0 0 0 0 WINDOW WND3                                                                                                                                                                             0 EQU SEL.WND         0 EQU SEL.BUFF                            0 EQU CWINDOW         0 EQU CDETAIL                             0 EQU #SELECTOR       0 EQU #DETAIL                             0 EQU ?FILTER         0 EQU #FILTER                             0 EQU SEL.DAT         0 EQU ANCHOR                                                                                              DICTIONARY REL.DAT    NULL                                      DICTIONARY REL.DCT    NULL                                                                                                      \ constants                                      09:23 04/12/88                                                                 1 CONSTANT VERT                  \ vertical                     2 CONSTANT HORZ                  \ horizontal                   3 CONSTANT RGT                   \ right                        4 CONSTANT LFT                   \ left                         5 CONSTANT UPP                                                  6 CONSTANT DWN                                                  0 CONSTANT SELECTOR                                             1 CONSTANT DETAIL                                                                                                                                                                               CREATE FMT.PAD  200 ALLOT                                                                                                       CREATE  TYPES 0 C, 1 C, 1 C, 1 C, 2 C, 0 C, 3 C, 0 C, 0 C,                                                                      \ arrays                                         09:12 04/13/88                                                                 CREATE WNDS  WND1 , WND2 , WND3 ,                               CREATE BUFFS W1.BUFF , W2.BUFF , W3.BUFF ,                      CREATE DICTS W1.DAT , W2.DAT , W3.DAT ,                                                                                                                                                                                                                         : 'WNDS      ( # --- addr ) 2* WNDS + @  ;                                                                                      : 'BUFFS     ( # --- addr ) 2* BUFFS + @  ;                                                                                     : 'DICTS     ( # --- addr ) 2* DICTS + @  ;                                                                                                                                                                                                                     ( draw-horz                                    11:41 11/18/87 )                                                                 : DRAW-HORZ   VW.BUFF VW.1ST C@                                               HORZ = IF ?XY NIP                                                         79 1 ?DO I OVER FULLW NOR 196 WND-CHAR!                              LOOP DROP EXIT                                          THEN                                                   VW.BUFF VW.2ND C@  ?DUP IF                                      CASE                                                              RGT OF ?XY FULLW NOR 195 ?XY SWAP 78 SWAP    ENDOF              LFT OF ?XY FULLW NOR 180 ?XY SWAP 1          ENDOF            ENDCASE                                                         ?DO I OVER FULLW NOR 196 WND-CHAR! LOOP DROP                    WND-CHAR!                                                       THEN ;                                                                                                              \ draw-verts                                     14:07 04/06/88                                                                 : DRAW-VERTS VW.BUFF VW.1ST C@ VERT =                                        IF ?XY DROP 23 1 ?DO DUP I FULLW NOR 179 WND-CHAR!                               LOOP DROP EXIT                                 THEN                                                            VW.BUFF VW.2ND C@ ?DUP IF                                        CASE                                                              DWN OF ?XY FULLW NOR 194 ?XY 1+ 23 SWAP ENDOF                   UPP OF ?XY FULLW NOR 193 ?XY    1       ENDOF                 ENDCASE                                                           ?DO DUP I FULLW NOR 179 WND-CHAR! LOOP DROP                     WND-CHAR!                                                    THEN ;                                                                                                                                                                             \ draw-lines                                     14:08 04/06/88                                                                 : DRAW-LINES  VW.BUFF VW.CCOL C@ VW.BUFF VW.CROW C@ GOTOXY                    VW.BUFF VW.1ST C@                                               CASE                                                              VERT OF DRAW-VERTS DRAW-HORZ ENDOF                              HORZ OF DRAW-HORZ DRAW-VERTS ENDOF                            ENDCASE ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         \ vbox                                           11:27 04/13/88                                                                                                                                 : VBOX     OBOX DRAW-LINES ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    \ adj-len                                        12:53 04/13/88                                                                                                                                 : ADJ-LEN   ( length --- length )                                           #DETAIL 'WNDB W.#COLS C@                                        CDETAIL #DETAIL 'DETAILS DT.CL C@ - MIN ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           \ .date                                          10:38 04/13/88                                                                                                                                 : .DATE   ( cl rw --- )                                                   #DETAIL 'WNDS HIL CDETAIL #DETAIL 'DETAILS                      #DETAIL 'BUFFS SWAP DT.OFFSET @ + 2@                            SWAP 100 /MOD DROP SWAP 256 /MOD 100 * + 100 UM*                ROT 0 D+ <# # # 47 HOLD # # 47 HOLD # # #>                      ADJ-LEN SWAP WND-STR! ;                                                                                               : .YN     ( cl rw --- )                                                   #DETAIL 'WNDS HIL 3 ADJ-LEN CDETAIL #DETAIL 'DETAILS            #DETAIL 'BUFFS SWAP DT.OFFSET @ + C@ 3 *                        " No Yes" 1+ + WND-STR! ;                                                                                                                                                             \ .text                                          09:24 04/13/88                                                                                                                                 : .TEXT    ( cl rw --- )                                                   #DETAIL 'WNDS HIL CDETAIL #DETAIL 'DETAILS                      DUP DT.LEN C@ ADJ-LEN SWAP #DETAIL 'BUFFS SWAP                  DT.OFFSET @ + WND-STR! ;                                                                                                                                                             : .NUM     ( cl rw --- ) PAD 10 BLANK                                      #DETAIL 'WNDS HIL 2OVER 2OVER 10 ADJ-LEN PAD WND-STR!           CDETAIL #DETAIL 'DETAILS                                        #DETAIL 'BUFFS SWAP DT.OFFSET @ + 2@                            CDETAIL #DETAIL 'DETAILS DT.MS/LS @ 256 MOD                     <#NUM#> ADJ-LEN SWAP WND-STR! ;                                                                                      \ .details                                       09:15 04/13/88                                                                                                                                 : .details 15 0 ?DO                                                            I #DETAIL 'DETAILS DT.OFFSET @ IF                               I EQU CDETAIL                                                   CDETAIL #DETAIL 'DETAILS DUP DT.CL C@ SWAP DUP                  DT.RW C@ SWAP DT.TYPE C@ TYPES + C@                             CASE                                                              0 OF .TEXT ENDOF                                                1 OF .NUM  ENDOF                                                2 OF .DATE ENDOF                                                3 OF .YN   ENDOF                                              ENDCASE THEN                                                    LOOP ;                                                                                                           \ .details                                       09:13 04/13/88                                                                                                                                 : .DETAILS  VW.BUFF VW.#WNDS C@ 0                                           ?DO                                                               I 'WNDB W.VTYPE? C@ DETAIL =                                    IF I EQU #DETAIL ANCHOR #DETAIL 'WNDB W.FILE @                      = IF #SELECTOR 'BUFFS #DETAIL 'BUFFS                                 MAX_REC_SZ CMOVE ELSE                                     #DETAIL 'BUFFS SEL.BUFF #DETAIL 'WNDB W.ROFF                    @ + @ #DETAIL 'DICTS DICT-READ THEN                             .details THEN                                              LOOP ;                                                                                                                                                                                                                                              \ .actives                                       16:44 04/25/88                                                                 : .ACTIVES  ( --- ) #SELECTOR 'DICTS DUP D.NA @ SWAP                                D.LST-READ @ 1+ >R                          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! ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         \ mov-text                                       10:02 04/12/88                                                                                                                                 : MOV-TEXT  ( #off #sel --- len )                                           SWAP FMT.PAD + SWAP DUP SEL.OFF @                               SEL.BUFF + ROT ROT SEL.LEN C@ DUP >R CMOVE                      R> ;                                                                                                                : MOV-NUM ( #off #sel --- len ) DUP SEL.MS/LS @ 256 /MOD SWAP             DUP IF 1+ THEN OVER 3 /MOD SWAP 0= + 0 MAX + + 1+ >R            SWAP R@ + SWAP DUP SEL.OFF @                                    SEL.BUFF + 2@ ROT SEL.MS/LS @ 256 MOD                           <#NUM#> ROT OVER 1- - FMT.PAD + SWAP CMOVE R> ;                                                                                                                                                                                                       \ mov-date                                       12:59 04/12/88                                                                 : MOV-DATE  ( #off 'sel --- len )                                           SWAP FMT.PAD + SWAP SEL.OFF @ SEL.BUFF + 2@                     SWAP 100 /MOD DROP SWAP 256 /MOD 100 * + 100 UM*                ROT 0 D+ <# # # 47 HOLD # # 47 HOLD # # #> ROT                  SWAP DUP >R CMOVE R> ;                                                                                                                                                              : MOV-YN    ( #off 'sel --- len )                                           SWAP FMT.PAD + SWAP SEL.OFF @ SEL.BUFF + C@ 3 *                 " No Yes" 1+ + SWAP 3 CMOVE 3 ;                                                                                                                                                                                                                                                                                     \ fmt-sline                                      10:09 04/12/88                                                                                                                                 : FMT-SLINE  ( cb --- len saddr ) DROP FMT.PAD 200 BLANK                     0 4 0 ?DO I 'SEL SEL.OFF @ 0<>                                  IF DUP I 'SEL DUP SEL.TYPE C@ TYPES + C@                           CASE                                                              0 OF MOV-TEXT  ENDOF                                            1 OF MOV-NUM   ENDOF                                            2 OF MOV-DATE  ENDOF                                            3 OF MOV-YN    ENDOF                                           ENDCASE 2+ +                                                THEN LOOP ( .DETAILS )                                          SEL.WND WINDOW-#COL C@ 2- MIN FMT.PAD ;                                                                                                                                            \ filter support                                 13:19 03/23/88                                                                 INCLUDE FILTER.DEF                                                                                                              CREATE MY.BUFF  SIZEOF FILTER 15 * ALLOT                        MY.BUFF SIZEOF FILTER 15 * ERASE                                                                                                : 'FLT.BUFF     SIZEOF FILTER * MY.BUFF + ;                                                                                     : FLT.CMP-TEXT  #FILTER 'FLT.BUFF DUP >R FLT.HOLD                               R@ FLT.SIZE @ SEL.BUFF R> FLT.OFFSET @ + OVER                   2DUP MAKEUC 2SWAP STRCMP ;                                                                                      : FLT.CMP-DNUM  #FILTER 'FLT.BUFF DUP >R FLT.HOLD 2@                            SEL.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                           SEL.BUFF R> FLT.OFFSET @ + @ 0 2SWAP NUMCMP ;                                                                   : FLT.CMP-BYTE  #FILTER 'FLT.BUFF DUP >R FLT.HOLD C@ 0                          SEL.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                                            ALT.BUFF #FILTER 'FLT.BUFF FLT.RFLD# @                          REL.DCT DICT-READ                                            REL.DCT CLOSE-DICTIONARY                                        ALT.BUFF FLD.OFFSET @ ALT.BUFF FLD.LENGTH @                     38 MIN REL.DAT OPEN-DICTIONARY                                    ALT.BUFF SEL.BUFF #FILTER 'FLT.BUFF FLT.OFFSET                  @ + @ REL.DAT DICT-READ                                       REL.DAT CLOSE-DICTIONARY                                        #FILTER 'FLT.BUFF FLT.HOLD SWAP ROT                             ALT.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 ;                                                                                                                                                                                                                                                                                                            \ @filters                                       13:34 04/13/88                                                                 : @FILTERS  TITS.DCT #SELECTOR 'WNDB W.FILE @ NAME>DCT                      TITS.DCT OPEN-DICTIONARY                                        MY.BUFF TITS.DCT ?FILTER " RBEFILT" BRUN RBEFILT                FORGET OVERLAY EQU ?FILTER                                      TITS.DCT CLOSE-DICTIONARY ;                                                                                                                                                         : .FILT     51 24 FULLW REV                                                 ?FILTER                                                         IF " FILTER" ELSE "       " THEN WND-CSTR! ;                                                                                                                                                                                                                                                                        \ ordering stuff                                 09:33 05/05/88                                                                 07 07 08 25 WINDOW SORTW                                                                                                        DICTIONARY WRK.DCT NULL                                                                                                         ' NOOP ' NOOP 0 0 " NULL" INDEX SORT.IDX                                                                                                                                                        : ?INDEX  FLD.BUFF FLD.?IDX C@ ;                                                                                                ' ?INDEX WRK.DCT FLD.BUFF 0 FLD.NAME 20 DCT-CHOICE INDEXC                                                                       ' PCKEY ' FMT-SLINE                                             ' FILTER-CMP 0 0 0 0 DCT-CHOICE SELC                                                                                            \ sorted-order                                   17:07 05/04/88                                                                                                                                 : SORTED-ORDER ( --- )                                                         " Order by" NONE SINGLE SORTW OPEN-WINDOW                       WRK.DCT OPEN-DICTIONARY                                         SORTW INDEXC DCT-CHOOSE                                         WRK.DCT CLOSE-DICTIONARY                                        ?DUP IF 1- SORT.IDX ANCHOR ROT NAME>IDX                                 SORT.IDX 2 FOPEN DROP SORT.IDX                               ELSE SORT.IDX FCLOSE DROP SEL.DAT                               THEN SELC 5 + !                                            SORTW CLOSE-WINDOW ;                                                                                                                                                                                                                             \ do-select                                      10:14 04/12/88                                                                                                                                 : NKEY      .ACTIVES .DETAILS                                               PCKEY ?DUP DROP DUP 62 =                                        IF DROP @FILTERS                                                   ?FILTER 3DROP SEL.WND SELC DCT-SETUP                            .FILT 01 THEN                                                DUP 19 =                                                        IF DROP SORTED-ORDER                                               3DROP SEL.WND SELC DCT-SETUP 01 THEN ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           \ do-select                                      09:05 05/05/88                                                                                                                                 : DO-SELECT    ['] NKEY SELC 11 + !                                            SEL.DAT OPEN-DICTIONARY                                         SEL.WND SELC DCT-CHOOSE DROP                                    SEL.DAT CLOSE-DICTIONARY ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       \ tits                                           09:24 04/12/88                                                                                                                                                                                                 : TITS       PAD 80 BLANK                                                    0 24 FULLW REV 80 PAD WND-STR!                                  2 24 FULLW REV 30 VW.BUFF VW.DESCR WND-STR!                    40 24 FULLW REV " View"  WND-CSTR!                              60 24 FULLW REV " Item"  WND-CSTR! ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                \ 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 ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          ( .titles                                      15:28 11/17/87 )                                                                 : .TITLES  TITS.DCT OPEN-DICTIONARY                                        15 0 ?DO                                                          I CDETAIL 'DETAILS DT.OFFSET @ IF                               FLD.BUFF I CDETAIL 'DETAILS DT.FLD# @ TITS.DCT                  DICT-READ                                                       I CDETAIL 'DETAILS DUP DT.CL C@ SWAP DT.RW C@                   CWINDOW NOR REDO: FLD.BUFF FLD.NAME WND-STR!                    FLD.BUFF FLD.NLEN C@ 2+ I CDETAIL 'DETAILS TUCK                 DT.CL C@ + SWAP DT.CL C! THEN                                 LOOP                                                            TITS.DCT CLOSE-DICTIONARY ;                                                                                                                                                                                                                          \ titles                                         14:29 04/18/88                                                                 : .FILES  VW.BUFF VW.#WNDS C@ 0 ?DO                                       FMT.PAD 10 BLANK                                                ASCII [ FMT.PAD C!                                              I 'DICTS HCB>N COUNT -PATH STRPCK -EXT                          COUNT TUCK FMT.PAD 1+ SWAP CMOVE                                DUP 1+ ASCII ] SWAP FMT.PAD + C! 2+                             I 'WNDS WINDOW-COL C@ 2+ SWAP                                   I 'WNDS WINDOW-ROW C@ SWAP                                      FULLW SWAP HIL SWAP FMT.PAD WND-STR! LOOP ;                                                                                                                                                                                                                                                                                                                                           \ details                                        13:46 04/12/88                                                                 : D.SETUP   VW.BUFF VW.#WNDS C@ 0 ?DO                                       I 'WNDB W.VTYPE? C@ DETAIL =                                    IF I 2* WNDS + @ EQU CWINDOW                                       I EQU CDETAIL                                                   TITS.DCT I 'WNDB W.FILE @ NAME>DCT                              I 'DICTS I 'WNDB W.FILE @ NAME>DAT                              .TITLES #SELECTOR 'WNDB W.FILE @ I 'WNDB W.FILE @               <> IF I 'DICTS OPEN-DICTIONARY THEN                          THEN LOOP ;                                                                                                         : VCLOSE   VW.BUFF VW.#WNDS C@ 0 ?DO                                       I 'DICTS HCB>H IF I 'DICTS CLOSE-DICTIONARY                                    THEN LOOP ;                                                                                           \ vw-setup                                       09:48 04/12/88                                                                                                                                 : VW-SETUP  0 'WNDB W.#COLS WND1 WINDOW-#COL 4 CMOVE                        1 'WNDB W.#COLS WND2 WINDOW-#COL 4 CMOVE                        2 'WNDB W.#COLS WND3 WINDOW-#COL 4 CMOVE                      0 3 0 ?DO I 'WNDB W.VTYPE? C@ SELECTOR =                                  IF DROP I LEAVE THEN LOOP DUP                           EQU #SELECTOR DUP 'DICTS EQU SEL.DAT DUP                        SEL.DAT OVER 'WNDB W.FILE @ NAME>DAT                            WRK.DCT OVER 'WNDB W.FILE @ NAME>DCT                            'WNDS EQU SEL.WND                                               'BUFFS EQU SEL.BUFF                                             SEL.BUFF SELC 3 + !                                             SEL.DAT SELC 5 + !                                              SEL.DAT SORT.IDX IDX.'DCB ! ;                       \ @view                                          14:49 04/13/88                                                                 3 3 10 35 WINDOW VIEWW                                                                                                          ' NO.COND VIEW.DCT VW.BUFF 0 VW.DESCR 30 DCT-CHOICE VIEWC                                                                       : @VIEW   ( --- 0/none,view+1 )                                           VIEW.DCT OPEN-DICTIONARY                                        " Actives Views" LISTL SINGLE VIEWW OPEN-WINDOW                 VIEWW VIEWC DCT-CHOOSE DUP                                      IF DUP VW.BUFF SWAP 1- VIEW.DCT DICT-READ THEN                  VIEW.DCT CLOSE-DICTIONARY                                       VIEWW CLOSE-WINDOW ;                                                                                                                                                                                                                                  \ rbview                                         09:25 04/12/88                                                                 : RBVIEW   ( #file --- ) DUP EQU ANCHOR                                    VIEW.DCT SWAP NAME>VIEW                                         @VIEW IF                                                               VW-SETUP                                                        CLS TITS VBOX -CUR D.SETUP .FILES                               DO-SELECT +CUR                                                  VCLOSE CLS                                                     THEN ;                                                                                                                                                                                                                                                                                                                                                                                                                                         \ Excises                                        16:54 04/13/88                                                                 EXCISE SEL.WND   SEL.BUFF                                       EXCISE CWINDOW   CDETAIL                                        EXCISE #SELECTOR #DETAIL                                        EXCISE ?FILTER   #FILTER                                        EXCISE SEL.DAT   ANCHOR