Power-Programmierung

home *** CD-ROM | disk | FTP | other *** search

/ Power-Programmierung / CD1.mdf / forth / rbsrc / rb-rept.scr < prev next >

Wrap

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

\ Load Screen 18:13 04/28/88 : MARKER ; 2 51 THRU 2 51 THRU BSAVE OVERLAY RBREPT FORGET MARKER BYE 2 49 THRU SYSTEM-INIT SCR-INIT 0 RBREPT \S \ Overlays 16:26 04/13/88 FORTH DEFINITIONS DECIMAL BSTART OVERLAY \ Variables 11:35 03/29/88 INCLUDE FILES.DEF INCLUDE FIELD.DEF INCLUDE REPORT.DEF INCLUDE LCGLOBAL.DEF SIZEOF REPORT ITEM-ALLOT R.BUFF CREATE TBUFF 132 ALLOT CREATE FMT.PAD 132 ALLOT VARIABLE CLINE VARIABLE CCOL VARIABLE ACNT VARIABLE CCHAR VARIABLE CPOS VARIABLE PLINE \ Dictionarys & Etc. 12:55 03/29/88 DICTIONARY WRK.DCT NULL DICTIONARY WRK.RPT NULL DICTIONARY WRK.DAT NULL HCB WRK.LAY DICTIONARY REL.DCT NULL DICTIONARY REL.DAT NULL DICTIONARY ALT.DCT NULL DICTIONARY ALT.DAT NULL CREATE TOT.BUFF 40 ALLOT CREATE ALT.BUFF 512 ALLOT \ Equates 11:13 05/03/88 0 EQU SIZE 0 EQU OFFSET 0 EQU HBUFF 0 EQU ?DETAIL 1 EQU ANCHOR 0 EQU S.BUFF 0 EQU cREL 0 EQU ?pause 2VARIABLE SUMHOLD 2VARIABLE MINHOLD 2VARIABLE MAXHOLD \ ?pause 11:24 05/03/88 08 20 4 40 WINDOW PAUSEW : ?PAUSE ?pause IF " New Page" NONE DOUBLE PAUSEW OPEN-WINDOW 5 2 PAUSEW NOR " Insert New page in Printer ..." WND-CSTR! 10 3 PAUSEW BLN " Hit any key to PRINT" WND-CSTR! KEY DROP PAUSEW CLOSE-WINDOW THEN ; \ selectors 13:05 04/01/88 3 3 10 35 WINDOW REPORTW ' NO.COND WRK.RPT R.BUFF 0 RPT.DESCR 30 DCT-CHOICE REPORTC 0 EQU ?FILTER \ is a filter on 0 EQU #FILTER : D+! ( d1 addr --- ) DUP >R 2@ D+ R> 2! ; : D/ ( d u --- d ) SWAP OVER /MOD >R SWAP UM/MOD SWAP DROP R> ; \ Column Definition 13:53 04/01/88 BEGIN-ITEM COLUMN 2 COLUMN COL.FOFFSET 1 COLUMN COL.FTYPE 1 COLUMN COL.FFMT 1 COLUMN COL.FSIZE 2 COLUMN COL.RFILE 2 COLUMN COL.RFLD 2 COLUMN COL.ROFFSET 1 COLUMN COL.RTYPE 1 COLUMN COL.RSIZE 1 COLUMN COL.LS 1 COLUMN COL.SIZE 1 COLUMN COL.JUST 1 COLUMN COL.?TOT END-ITEM \ column maintenance 16:46 03/29/88 CREATE COL.BUFF SIZEOF COLUMN 20 * ALLOT VARIABLE #COLS : 'COL ( #col --- offset ) SIZEOF COLUMN * COL.BUFF + ; : 'CCOL ( --- ) #COLS @ 'COL ; VARIABLE CSPACES VARIABLE #LINES \ !line & @line 14:43 03/28/88 : !LINE ( --- ) DS0 TBUFF S.BUFF CLINE @ R.BUFF RPT.#COLS C@ DUP >R * R> CMOVEL ; : @LINE ( --- ) S.BUFF CLINE @ R.BUFF RPT.#COLS C@ DUP >R * DS0 TBUFF R> CMOVEL ; : .LINE ( --- ) 1 ?XY NIP FULLW NOR R.BUFF RPT.#COLS C@ 1- TBUFF WND-STR! ; : ADD-LS FLD.BUFF FLD.MS/LS @ 256 MOD 'CCOL COL.LS C! ; \ Display 14:28 05/02/88 VARIABLE page# 06 07 07 45 WINDOW STATW : .STAT 2 4 STATW NOR " Printing Line ## of Page" WND-CSTR! 16 4 STATW HIL PLINE @ 0 <# # # #> SWAP WND-STR! 27 4 STATW HIL page# @ 0 <# #S #> SWAP WND-STR! ; \ pointer maintenance 10:41 03/31/88 : formf R.BUFF RPT.#LINES C@ PLINE @ - 0 ?DO CR LOOP 1 page# +! ?PAUSE ; : PLINE++ 1 PLINE +! .STAT PLINE @ R.BUFF RPT.#LINES C@ = IF formf PLINE OFF THEN ; : PRT-CHAR ( char --- ) EMIT CCHAR @ R.BUFF RPT.#COLS C@ = IF CR CCHAR OFF CPOS ON 1 CLINE +! @LINE PLINE++ ELSE 1 CCHAR +! THEN ; \ match-record 09:09 04/01/88 : <rec-cmp> WRK.BUFF cREL + @ ALT.DAT D.LST-READ @ = ; : REC-CMP ?DETAIL IF <rec-cmp> ELSE NO.COND THEN ; : new-cmp ALT.BUFF cREL + @ WRK.DAT D.LST-READ @ = ; : SUM-CMP ?DETAIL IF new-cmp ELSE NO.COND THEN ; \ find-field 14:41 03/29/88 : CMP-FLD TBUFF OFFSET + HBUFF FLD.NLEN C@ DUP >R 2DUP MAKEUC HBUFF FLD.NAME R> 2DUP MAKEUC STRCMP 0= ; : FIND-FIELD WRK.DCT OPEN-DICTIONARY -1 WRK.DCT D.LST-READ ! FLD.BUFF EQU HBUFF ['] CMP-FLD FLD.BUFF WRK.DCT NXT-ITEM WRK.DCT CLOSE-DICTIONARY ; \ rel-field 14:29 03/30/88 : REL-FIELD REL.DCT OPEN-DICTIONARY -1 REL.DCT D.LST-READ ! TBUFF CPOS @ + 80 ASCII [ SCAN DROP TBUFF - EQU OFFSET FLD.BUFF EQU HBUFF OFFSET 1+ EQU OFFSET ['] CMP-FLD FLD.BUFF REL.DCT NXT-ITEM REL.DCT CLOSE-DICTIONARY ; \ res-flds 13:23 03/30/8 CREATE FTYPES 0 C, 1 C, 1 C, 4 C, 2 C, 0 C, 3 C, 0 C, 0 C, : RES-FLD 0= IF FLD.BUFF FLD.OFFSET @ 'CCOL COL.FOFFSET ! FLD.BUFF FLD.TYPE C@ FTYPES + C@ DUP 'CCOL COL.FTYPE C! 1 = IF ADD-LS THEN FLD.BUFF FLD.LENGTH C@ 'CCOL COL.FSIZE C! FLD.BUFF FLD.TYPE C@ 3 = IF REL.DCT FLD.BUFF FLD.RELATION @ DUP 'CCOL COL.RFILE ! NAME>DCT REL-FIELD 0= IF REL.DCT D.LST-READ @ 'CCOL COL.RFLD ! FLD.BUFF FLD.TYPE C@ 'CCOL COL.RTYPE C! ADD-LS FLD.BUFF FLD.OFFSET @ 'CCOL COL.ROFFSET ! FLD.BUFF FLD.LENGTH C@ 'CCOL COL.RSIZE C! -1 ELSE 0 THEN ELSE -1 THEN ELSE 0 THEN ; \ parse-line 13:36 03/29/88 : PARSE-LINE 'CCOL SIZEOF COLUMN ERASE TBUFF 80 ASCII , SCAN OVER TBUFF - TBUFF SWAP STRPCK NUMBER? 2DROP 'CCOL COL.SIZE C! DROP 1+ DUP C@ TOUPPER ASCII R = ABS 'CCOL COL.JUST C! 2+ DUP C@ TOUPPER 'CCOL COL.?TOT C! 2+ TBUFF - EQU OFFSET FIND-FIELD RES-FLD IF 1 #COLS +! THEN ; \ columns 16:27 04/22/88 : @COLUMNS #COLS OFF @LINE COL.BUFF SIZEOF COLUMN 20 * ERASE BEGIN TBUFF 80 MAKEUC TBUFF 80 " @ENDLINE" COUNT STRNDX -1 = WHILE PARSE-LINE 1 CLINE +! @LINE REPEAT ; \ fmt-text 10:24 03/30/88 : fmt-text ( csize fsize offset buff --- ) + FMT.PAD CSPACES @ + 2SWAP OVER CSPACES +! MIN CMOVE ; : FMT-TEXT ( #col --- ) DUP 'COL COL.SIZE C@ SWAP DUP 'COL COL.FSIZE C@ SWAP 'COL COL.FOFFSET @ WRK.BUFF fmt-text ; \ fmt-num 16:39 03/30/88 : fmt-num ( csize t/f #decs offset buff --- ) + 2@ ROT <#NUM#> ROT CSPACES @ SWAP IF 3 PICK + OVER 1- - THEN FMT.PAD + SWAP 3 ROLL DUP CSPACES +! MAX CMOVE ; : FMT-NUMM DUP 'COL COL.SIZE C@ SWAP DUP 'COL COL.JUST C@ SWAP DUP 'COL COL.LS C@ SWAP DUP 'COL COL.FOFFSET @ SWAP DUP 'COL COL.?TOT C@ ASCII N <> IF 4 * TOT.BUFF + >R DUP WRK.BUFF + 2@ R> D+! ELSE DROP THEN WRK.BUFF fmt-num ; \ fmt-date 11:23 03/30/88 : FMT-DAT ( col --- ) >R WRK.BUFF R@ 'COL COL.FOFFSET @ + 2@ SWAP 100 /MOD DROP SWAP 256 /MOD 100 * + 100 UM* ROT 0 D+ <# # # 47 HOLD # # 47 HOLD # # #> CSPACES @ R@ 'COL COL.JUST C@ IF R@ 'COL COL.SIZE C@ + OVER - THEN FMT.PAD + SWAP R> 'COL COL.SIZE C@ DUP CSPACES +! MIN CMOVE ; : FMT-YN ( col --- ) >R WRK.BUFF R@ 'COL COL.FOFFSET @ + C@ 3 * " No Yes" 1+ + 3 CSPACES @ R@ 'COL COL.JUST C@ IF R@ 'COL COL.SIZE C@ + OVER - THEN FMT.PAD + SWAP R> 'COL COL.SIZE C@ DUP CSPACES +! MIN CMOVE ; \ relationship formats 08:43 03/31/88 : RFMT-TEXT ( col --- ) >R R@ 'COL COL.SIZE C@ R@ 'COL COL.RSIZE C@ R> 'COL COL.ROFFSET @ SEL.BUFF fmt-text ; : RFMT-NUM ( col --- ) DUP 'COL COL.SIZE C@ SWAP DUP 'COL COL.JUST C@ SWAP DUP 'COL COL.LS C@ SWAP DUP 'COL COL.ROFFSET @ SWAP DUP 'COL COL.?TOT C@ ASCII N <> IF 4 * TOT.BUFF + >R DUP SEL.BUFF + 2@ R> D+! ELSE DROP THEN SEL.BUFF fmt-num ; \ fmt-rel 13:38 03/30/88 : FMT-REL ( col --- ) DUP >R 'COL COL.RFILE @ REL.DAT SWAP NAME>DAT REL.DAT OPEN-DICTIONARY SEL.BUFF WRK.BUFF R@ 'COL COL.FOFFSET @ + @ REL.DAT DICT-READ REL.DAT CLOSE-DICTIONARY R> DUP 'COL COL.RTYPE C@ CASE 0 OF RFMT-TEXT ENDOF 1 OF RFMT-NUM ENDOF 7 OF RFMT-TEXT ENDOF ENDCASE ; \ fmt-line : fmt-line FMT.PAD 132 BLANK CSPACES OFF #COLS @ 0 ?DO I 'COL COL.FTYPE C@ CASE 0 OF I FMT-TEXT ENDOF 1 OF I FMT-NUMM ENDOF 2 OF I FMT-DAT ENDOF 3 OF I FMT-YN ENDOF 4 OF I FMT-REL ENDOF ENDCASE 32 FMT.PAD CSPACES @ + C! 1 CSPACES +! LOOP ; : FMT-LINE fmt-line CR FMT.PAD CSPACES @ TYPE PLINE++ ; \ totals 12:15 04/04/88 : TOTALS ( --- ) FMT.PAD 132 BLANK 0 #COLS @ 0 ?DO I 'COL COL.?TOT C@ ASCII N <> IF DROP -1 LEAVE THEN LOOP IF CSPACES OFF CR #COLS @ 0 ?DO I 'COL COL.?TOT C@ DUP ASCII N <> IF ASCII A = IF I 4 * TOT.BUFF + 2@ #LINES @ D/ I 4 * TOT.BUFF + 2! THEN I 'COL DUP COL.SIZE C@ SWAP DUP COL.JUST C@ SWAP COL.LS C@ I 4 * TOT.BUFF fmt-num ELSE DUP I 'COL COL.SIZE C@ CSPACES +! THEN 1 CSPACES +! LOOP CR FMT.PAD R.BUFF RPT.#COLS C@ TYPE PLINE++ THEN ; \ @do-line 14:15 03/31/88 : @DO-LINE 1 CLINE +! @COLUMNS TOT.BUFF 40 ERASE #LINES OFF -1 WRK.DAT D.LST-READ ! BEGIN ['] REC-CMP WRK.BUFF WRK.DAT NXT-ITEM 0= WHILE WRK.BUFF ?ACTIVE IF FMT-LINE 1 #LINES +! THEN REPEAT TOTALS #COLS OFF CCHAR OFF 1 CLINE +! @LINE CPOS ON ?DETAIL IF 0 EQU ?DETAIL WRK.DAT CLOSE-DICTIONARY ALT.BUFF WRK.BUFF MAX_REC_SZ CMOVE ALT.DCT WRK.DCT 98 CMOVE ALT.DAT WRK.DAT 98 CMOVE WRK.DAT OPEN-DICTIONARY THEN ; \ 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 ; \ @repeat 15:12 03/31/88 : @FORMFEED formf PLINE OFF #COLS OFF CCHAR OFF CPOS ON 1 CLINE +! @LINE ; : @REPEAT ['] FILTER-CMP WRK.BUFF WRK.DAT NXT-ITEM DUP 0= IF @FORMFEED CLINE OFF @LINE CPOS ON ELSE @FORMFEED THEN ; \ find-dict 08:52 04/01/88 : cmp-dct TBUFF OFFSET + SIZE 2DUP MAKEUC LC.BUFF LC.FNAME SIZE 2DUP MAKEUC STRCMP 0= ; : FIND-DCT -1 LCMAIN.DCT D.LST-READ ! ['] cmp-dct LC.BUFF LCMAIN.DCT NXT-ITEM ; : FIND-OFF ( dcb --- ) DUP OPEN-DICTIONARY 0 OVER D.HU @ 0 ?DO FLD.BUFF I 3 PICK DICT-READ FLD.BUFF FLD.TYPE C@ 3 = IF FLD.BUFF FLD.RELATION @ ANCHOR = IF DROP FLD.BUFF FLD.OFFSET @ EQU cREL -1 LEAVE THEN THEN LOOP SWAP CLOSE-DICTIONARY ; \ @detail 17:03 03/31/88 : @DETAIL TBUFF 80 ASCII [ SCAN DROP 1+ TBUFF - EQU OFFSET TBUFF 80 ASCII ] SCAN DROP TBUFF OFFSET + - EQU SIZE FIND-DCT 0= IF WRK.DCT ALT.DCT 98 CMOVE WRK.DAT CLOSE-DICTIONARY WRK.DAT ALT.DAT 98 CMOVE WRK.BUFF ALT.BUFF MAX_REC_SZ CMOVE WRK.DCT LCMAIN.DCT D.LST-READ @ DUP >R NAME>DCT WRK.DAT R> NAME>DAT WRK.DAT OPEN-DICTIONARY WRK.DCT FIND-OFF IF 1 EQU ?DETAIL @DO-LINE THEN THEN ; \ >num 14:48 04/28/88 : >NUM ( --- ) 0 BEGIN DUP TBUFF + CPOS @ + C@ ISDIGIT WHILE 1+ REPEAT ?DUP IF TBUFF CPOS @ + OVER STRPCK NUMBER? 2DROP EMIT CPOS +! ELSE 1 CPOS +! THEN ; \ pcodes 08:53 04/28/88 : @PCODES 7 CPOS +! BEGIN TBUFF CPOS @ + C@ ASCII ] <> WHILE >NUM REPEAT ; \ parse-link 14:04 05/03/88 : PARSE-LINK ( --- #file #fld t/f ) TBUFF CPOS @ + 10 ASCII . SCAN IF TBUFF CPOS @ DUP 1+ EQU OFFSET + - 1- EQU SIZE FIND-DCT 0= IF SIZE 2+ CPOS +! LCMAIN.DCT D.LST-READ @ ELSE -1 THEN ELSE DROP 1 CPOS +! ANCHOR THEN DUP -1 = IF 0 0 EXIT THEN ALT.DCT OVER NAME>DCT CPOS @ EQU OFFSET FLD.BUFF EQU HBUFF ALT.DCT OPEN-DICTIONARY -1 ALT.DCT D.LST-READ ! ['] CMP-FLD FLD.BUFF ALT.DCT NXT-ITEM ALT.DCT CLOSE-DICTIONARY IF DROP 0 0 0 ELSE ALT.DCT D.LST-READ @ -1 THEN ; \ calc-value 11:07 05/08/88 : CALC-VAL ALT.BUFF ?ACTIVE IF ALT.BUFF FLD.BUFF FLD.OFFSET @ + 2@ 1 ACNT +! 2DUP SUMHOLD D+! 2DUP MINHOLD 2@ DMIN MINHOLD 2! MAXHOLD 2@ DMAX MAXHOLD 2! THEN ; \ @sum 10:25 05/03/88 : @sum ( --- value ) 4 CPOS +! PARSE-LINK 0. SUMHOLD 2! 0. MAXHOLD 2! 1000000. MINHOLD 2! TBUFF CPOS @ + 20 ASCII ) SCAN DROP ACNT OFF TBUFF CPOS @ + - 1+ CPOS +! FLD.BUFF ALT.BUFF 200 CMOVE FLD.BUFF FLD.TYPE C@ DUP 1 = SWAP 2 = OR NOT IF 2DROP DROP 0. 0 THEN IF OVER ANCHOR <> IF ALT.DCT FIND-OFF IF 1 EQU ?DETAIL ELSE 2DROP 0. EXIT THEN THEN ALT.BUFF FLD.BUFF 200 CMOVE ALT.DCT HCB>N -EXT " .DAT" +EXT ALT.DAT NAME>HCB ALT.DAT OPEN-DICTIONARY -1 ALT.DAT D.LST-READ ! BEGIN ['] SUM-CMP ALT.BUFF ALT.DAT NXT-ITEM 0= WHILE CALC-VAL REPEAT 2DROP SUMHOLD 2@ ALT.DAT CLOSE-DICTIONARY 0 EQU ?DETAIL THEN ; \ @sum 10:41 05/04/88 : @SUM @sum FLD.BUFF FLD.MS/LS @ 256 MOD <#NUM#> 0 ?DO DUP I + C@ PRT-CHAR LOOP DROP ; : @AVG @sum ACNT @ ?DUP IF D/ THEN FLD.BUFF FLD.MS/LS @ 256 MOD <#NUM#> 0 ?DO DUP I + C@ PRT-CHAR LOOP DROP ; : @MIN @sum 2DROP MINHOLD 2@ FLD.BUFF FLD.MS/LS @ 256 MOD <#NUM#> 0 ?DO DUP I + C@ PRT-CHAR LOOP DROP ; : @MAX @sum 2DROP MAXHOLD 2@ FLD.BUFF FLD.MS/LS @ 256 MOD <#NUM#> 0 ?DO DUP I + C@ PRT-CHAR LOOP DROP ; \ @sysdate 16:45 04/28/88 : @SYSDATE 7 CPOS +! @DATE SWAP 100 /MOD DROP SWAP 256 /MOD 100 * + 100 UM* ROT 0 D+ <# # # 47 HOLD # # 47 HOLD # # #> 0 ?DO DUP I + C@ PRT-CHAR LOOP DROP ; : @SYSTIME 7 CPOS +! @TIME DROP 256 /MOD TUCK DUP 12 > IF 12 MOD THEN 100 * + 0 ROT <# 12 >= IF ASCII p ELSE ASCII a THEN HOLD # # 58 HOLD # # #> 0 ?DO DUP I + C@ PRT-CHAR LOOP DROP ; \ @page 16:55 04/28/88 : @PAGE# 5 CPOS +! page# @ 0 <# #S #> 0 ?DO DUP I + C@ PRT-CHAR LOOP DROP ; \ *funcs 10:40 03/31/88 : *FUNCS CSPACES OFF 1 CPOS +! CPOS @ EQU OFFSET #COLS OFF FIND-FIELD RES-FLD IF FLD.BUFF FLD.LENGTH @ 3 + 0 'COL COL.SIZE C! 1 #COLS ! fmt-line 0 80 0 DO FMT.PAD 80 I - + C@ ISALNUM IF DROP 81 I - LEAVE THEN LOOP 0 ?DO FMT.PAD I + C@ PRT-CHAR LOOP FMT.PAD 132 BLANK TBUFF CPOS @ + R.BUFF RPT.#COLS C@ CPOS @ - ASCII * SCAN NIP R.BUFF RPT.#COLS @ SWAP - CPOS ! #COLS OFF THEN ; \ find-it 14:16 03/31/88 : VSTR " LINE ENDREPORT FORMFEED REPEAT DETAIL PCODE SYSDATE SYSTIME PAGE# SUM AVG MIN MAX " ; : FIND-IT ( str --- # ) 0 OVER BEGIN DUP C@ ISALNUM WHILE 1+ SWAP 1+ SWAP REPEAT DROP VSTR COUNT 2SWAP 2DUP MAKEUC STRNDX 10 / ; : ?ABORT ( --- t/f ) CONSOLE ?TERMINAL IF KEY 27 = ELSE 0 THEN PRINTER ; \ @funcs 17:34 03/29/88 : @FUNCS TBUFF CPOS @ 1+ + FIND-IT CASE 0 OF CCHAR OFF @DO-LINE 0 ENDOF 1 OF CCHAR OFF @FORMFEED -1 ENDOF 2 OF CCHAR OFF @FORMFEED 0 ENDOF 3 OF CCHAR OFF @REPEAT ENDOF 4 OF CCHAR OFF @DETAIL 0 ENDOF 5 OF @PCODES 0 ENDOF 6 OF @SYSDATE 0 ENDOF 7 OF @SYSTIME 0 ENDOF 8 OF @PAGE# 0 ENDOF 9 OF @SUM 0 ENDOF 10 OF @AVG 0 ENDOF 11 OF @MIN 0 ENDOF 12 OF @MAX 0 ENDOF 0 SWAP ENDCASE ; \ ?parms 11:29 05/03/88 : ?PARMS 2 2 STATW NOR " Do you wish to Pause after each Page?" WND-CSTR! 40 2 STATW 0 ?YES/NO NIP EQU ?pause ; \ scan_DOC 13:20 03/29/88 : SCAN_DOC R.BUFF RPT.DESCR 30 STRPCK NONE SINGLE STATW OPEN-WINDOW ?PARMS 2 6 STATW HIL -CUR " Hit ESC to abort printing ..." WND-CSTR! CLINE OFF CCHAR OFF CPOS ON @LINE ?PAUSE TBUFF 132 BLANK BEGIN 1 CPOS +! TBUFF CPOS @ + C@ DUP CASE ASCII @ OF DROP @FUNCS ENDOF ASCII * OF DROP *FUNCS 0 ENDOF PRT-CHAR 0 SWAP ENDCASE CLINE @ 66 = OR ?ABORT OR UNTIL +CUR STATW CLOSE-WINDOW ; \ @filters 14:39 04/01/88 : @FILTERS WRK.DCT OPEN-DICTIONARY MY.BUFF WRK.DCT ?FILTER " RBEFILT" BRUN RBEFILT FORGET OVERLAY EQU ?FILTER WRK.DCT CLOSE-DICTIONARY ; \ prt-report 13:07 04/01/88 : PRT-REPORT ( #rpt --- ) 1 page# ! 545 MALLOC EQU S.BUFF WRK.LAY 2 FOPEN DROP WRK.LAY 8712 ROT UM* 0 FSEEK 2DROP WRK.LAY S.BUFF 0 8712 FREADL DROP CLINE OFF WRK.LAY FCLOSE DROP MY.BUFF SIZEOF FILTER 15 * ERASE WRK.DAT OPEN-DICTIONARY @FILTERS COL.BUFF SIZEOF COLUMN 20 * ERASE #COLS OFF TBUFF 80 BLANK -1 WRK.DAT D.LST-READ ! ['] FILTER-CMP WRK.BUFF WRK.DAT NXT-ITEM 0= IF PRINTER SCAN_DOC CONSOLE THEN WRK.DAT CLOSE-DICTIONARY S.BUFF FREE ; \ reports 09:18 03/29/88 : RBREPT ( #file --- ) EQU ANCHOR WRK.DCT ANCHOR NAME>DCT WRK.RPT ANCHOR NAME>RPT WRK.DAT ANCHOR NAME>DAT WRK.DCT HCB>N -EXT " .LAY" +EXT WRK.LAY NAME>HCB " Print Report" LISTL DOUBLE REPORTW OPEN-WINDOW WRK.RPT OPEN-DICTIONARY REPORTW REPORTC DCT-CHOOSE REPORTW CLOSE-WINDOW ?DUP IF 1- R.BUFF OVER WRK.RPT DICT-READ PRT-REPORT THEN WRK.RPT CLOSE-DICTIONARY ; \ Excises 14:58 04/01/88 EXCISE SIZE OFFSET EXCISE HBUFF ?DETAIL EXCISE ANCHOR S.BUFF EXCISE ?FILTER #FILTER EXCISE cREL ?pause