home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
forth
/
rbsrc
/
rb-@form.scr
< prev
next >
Wrap
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