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

Text File | 1988-04-18 | 11KB | 1 lines

\ Locus/DB Help System                           22:39 03/24/88                                                                                                                                     This is the source code for the oneline help system.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        \ Load Screen                                    14:15 02/24/88                                                                 : MARKER ;                                                      2 10 THRU 2 10 THRU BSAVE OVERLAY RBHELP                        FORGET MARKER                                                   BYE                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             \ Miscellaneous Stuff                            09:26 02/23/88                                                                 FORTH DEFINITIONS DECIMAL                                       BSTART OVERLAY                                                                                                                  2 10 18 60 WINDOW HELPW                   \ window for help                                                                     BEGIN-ITEM H.HEADER                      \ header for help                 2 H.HEADER H.ME                                                 2 H.HEADER H.#PAGES                                            30 H.HEADER H.TITLE                                   END-ITEM                                                                                                                        SIZEOF H.HEADER ITEM-ALLOT H.BUFF                                                                                                                                                               \ Miscellaneous Stuff                            09:26 02/23/88                                                                 CREATE PRS.PAGE      1020  ALLOT      \ current screen          VARIABLE PRS.PAGE#                    \ current page number                                                                     CREATE COLORS  ] NOR REV HIL BLN [    \ color vectors                                                                           0 EQU PRS.COLOR                                                 0 EQU FUN                                                                                                                       VARIABLE PRS.COL                                                                                                                HCB HELP.FLE                          \ hcb for help file                                                                       " RBACK.HLP" HELP.FLE NAME>HCB     \ help file name                                                                             \ disp-lne                                       14:38 02/23/88                                                                 : DISP-LNE     ( line# --- )                                                   2 PRS.COL !                                                     DUP 68 * PRS.PAGE +                                             BEGIN DUP C@ 13 <> PRS.COL @ 59 < AND                           WHILE                                                             DUP C@ 7 @BIT                                                   IF DUP C@ 7 -BIT ATTRIB + C@ EQU PRS.COLOR                    ELSE                                                               DUP C@ >R OVER 2+ PRS.COL @ SWAP HELPW                          PRS.COLOR R> WND-CHAR! 1 PRS.COL +!                            THEN 1+                                                       REPEAT 2DROP ;                                                                                                                                                                   \ disp-help                                      15:52 02/23/88                                                                                                                                 : DISP-HELP   ( --- )                                                         HELPW WND-CLR                                                   15 0 DO                                                               NOR EQU PRS.COLOR                                               I DISP-LNE                                                     LOOP ;                                                                                                                                                                       : NEXT-HELP   ( --- )                                                         HELP.FLE H.BUFF H.#PAGES @ 1020 UM* 1 FSEEK 2DROP               HELP.FLE H.BUFF SIZEOF H.HEADER FREAD DROP ;                                                                                                                                      \ next-page & last-page                                                                                                         : LAST-PAGE   ( --- )                                                         PRS.PAGE# @ 1 <> IF                                             HELP.FLE 1020 2 UM* DNEGATE 1 FSEEK 2DROP                       HELP.FLE PRS.PAGE 1020 FREAD DROP -1 PRS.PAGE# +!               DISP-HELP                                                       THEN ;                                                                                                                                                                            : NEXT-PAGE   ( --- )                                                         PRS.PAGE# @ H.BUFF H.#PAGES @ <> IF                             HELP.FLE PRS.PAGE 1020 FREAD DROP 1 PRS.PAGE# +!                DISP-HELP                                                       THEN ;                                                                                                            \ .bottom                                        12:01 02/24/88                                                                 : .BOTTOM   ( --- )                                                         45 17 HELPW NOR " Page    of   " WND-CSTR!                      50 17 HELPW NOR PRS.PAGE# @ 0 <# #S #> SWAP WND-STR!            56 17 HELPW NOR H.BUFF H.#PAGES @ DUP >R 0 <# #S #>             SWAP WND-STR!                                                   5 17 HELPW HIL " Esc = Exit Help" COUNT               R> 1 > IF PRS.PAGE# @ 1 = IF                                              "        PageDn" THEN                                           PRS.PAGE# @ H.BUFF H.#PAGES @ = IF                              "        PageUp" THEN                                           PRS.PAGE# @ DUP 1 <> SWAP H.BUFF H.#PAGES @ < AND IF            "        PageDn/PageUp" THEN ELSE "   " THEN                    COUNT STRCAT SWAP                                               WND-STR! ;                                          \ key-process                                    12:55 02/24/88                                                                                                                                 : KEY-PROCESS   ( --- )                                                         BEGIN                                                             PCKEY ?DUP 0= IF 7 +BIT THEN                                    CASE                                                             209 OF NEXT-PAGE ENDOF                                          201 OF LAST-PAGE ENDOF                                           27 OF EXIT      ENDOF                                         ENDCASE .BOTTOM                                                AGAIN ;                                                                                                                                                                                                                                                                                                        \ help                                           11:11 02/24/88                                                                 : RBHELP     ( #help --- )                                                   HELP.FLE 2 FOPEN DROP HELP.FLE 0. 0 FSEEK 2DROP                 HELP.FLE H.BUFF 34 FREAD DROP                                   BEGIN                                                              DUP H.BUFF H.ME @ <> WHILE NEXT-HELP REPEAT                  DROP -CUR                                                       H.BUFF H.TITLE 30 STRPCK HELPL SINGLE HELPW                     OPEN-WINDOW 1 PRS.PAGE# !                                       HELP.FLE PRS.PAGE 1020 FREAD DROP                               DISP-HELP .BOTTOM KEY-PROCESS                                   HELP.FLE FCLOSE DROP                                            +CUR                                                            HELPW CLOSE-WINDOW ;                                                                                               \ Excises                                        17:01 02/24/88                                                                 EXCISE FUN PRS.COLOR