Power-Programmierung

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

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

Wrap

Text File | 1988-04-28 | 30KB | 1 lines

\ Load Screen 08:54 03/29/88 : MARKER ; 2 28 THRU 2 28 THRU BSAVE OVERLAY RBEREPT FORGET MARKER BYE \ Variables 09:08 03/29/88 FORTH DEFINITIONS DECIMAL BSTART OVERLAY INCLUDE REPORT.DEF INCLUDE FILES.DEF INCLUDE FIELD.DEF SIZEOF REPORT ITEM-ALLOT R.BUFF 0 EQU MODE 0 EQU CFILE 0 EQU S.BUFF 0 EQU DUMMY CREATE TBUFF 80 ALLOT TBUFF 80 BLANK \ Variables 09:09 03/29/88 1 0 21 0 WINDOW CURRENTW 3 2 4 14 WINDOW MODEW \ mode window VARIABLE CLINE VARIABLE CCOL : MSTR " Create Modify Delete " ; MSTR 3 10 10 CHOICE MODEC DICTIONARY WRK.DCT NULL DICTIONARY WRK.RPT NULL HCB WRK.LAY DICTIONARY REL.DCT NULL \ !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! ; \ @report 09:18 03/29/88 5 5 10 35 WINDOW REPORTW ' NO.COND WRK.RPT R.BUFF 0 RPT.DESCR 30 DCT-CHOICE REPORTC : @REPORT " Reports" LISTL DOUBLE REPORTW OPEN-WINDOW REPORTW REPORTC DCT-CHOOSE REPORTW CLOSE-WINDOW ; \ edt-rpt & del-rpt 15:01 04/01/88 : EDT-RPT @REPORT DUP IF 1- R.BUFF OVER WRK.RPT DICT-READ WRK.LAY 8712 ROT UM* 0 FSEEK 2DROP WRK.LAY S.BUFF 0 8712 FREADL DROP CLINE OFF 1 THEN ; : DEL-RPT @REPORT DUP IF 1- WRK.RPT DEL-ITEM 0 THEN ; \ new-rpt 09:49 03/29/88 5 5 3 35 WINDOW ADDW : NEW-RPT " Report Description" NONE DOUBLE ADDW OPEN-WINDOW R.BUFF SIZEOF REPORT ERASE 2 2 ADDW R.BUFF RPT.DESCR 30 @STRING DROP ADDW CLOSE-WINDOW 79 R.BUFF RPT.#COLS C! 66 R.BUFF RPT.#LINES C! 00 R.BUFF RPT.LM C! 00 R.BUFF RPT.RM C! R.BUFF WRK.RPT ADD-ITEM DUP WRK.LAY 8712 ROT UM* 0 FSEEK 2DROP WRK.LAY S.BUFF 0 8172 FWRITEL DROP R.BUFF SWAP WRK.RPT DICT-READ -1 ; \ @mode 09:33 03/29/88 CREATE DVECS ] NOOP NEW-RPT EDT-RPT DEL-RPT [ : @MODE ( --- t/f ) " Active DataBases" @ACTIVES DUP IF 1- EQU CFILE WRK.DCT CFILE NAME>DCT WRK.RPT CFILE NAME>RPT WRK.DCT HCB>N -EXT " .LAY" +EXT WRK.LAY NAME>HCB WRK.DCT OPEN-DICTIONARY WRK.RPT OPEN-DICTIONARY WRK.LAY 2 FOPEN DROP " Reports" NONE SINGLE MODEW OPEN-WINDOW MODEW MODEC CHOOSE MODEW CLOSE-WINDOW DUP IF 2* DVECS + PERFORM THEN THEN ; \ rhelp 09:43 04/22/88 : RHELP 3 HELP 00 00 ; \ rhlines 14:10 03/25/88 : RHLINES R.BUFF RPT.#COLS C@ 1 ?DO I 1 FULLW NOR 196 WND-CHAR! I 22 FULLW NOR I 10 MOD IF 193 ELSE 197 THEN WND-CHAR! LOOP ; : RVLINES 22 2 ?DO 0 I FULLW NOR 179 WND-CHAR! R.BUFF RPT.#COLS C@ I FULLW NOR 179 WND-CHAR! LOOP ; \ rbox 14:50 03/25/88 : RBOX 0 1 FULLW NOR 218 WND-CHAR! 0 R.BUFF RPT.#COLS C@ + DUP >R 1 FULLW NOR 191 WND-CHAR! 0 22 DUP >R FULLW NOR 192 WND-CHAR! R> R> SWAP FULLW NOR 217 WND-CHAR! RHLINES RVLINES ; : MARGINS R.BUFF RPT.RM C@ R.BUFF RPT.LM C@ <> IF R.BUFF RPT.RM C@ 22 DUP >R FULLW HIL 17 WND-CHAR! R.BUFF RPT.LM C@ R> FULLW HIL 16 WND-CHAR! THEN ; \ down & up 09:52 03/28/88 : DOWN ( --- cl_off rw_off ) @LINE !LINE CLINE @ 65 < IF 1 CLINE +! @LINE ?XY NIP 21 = IF CURRENTW WND-UP 00 00 ELSE 00 01 THEN ELSE ERRTONE 00 00 THEN ; : UP ?XY NIP 2 = CLINE @ 0 = AND IF ERRTONE 00 00 ELSE ?XY NIP 2 = CLINE @ 0 >= AND IF CURRENTW WND-DOWN 00 0 ELSE 00 -1 THEN !LINE -1 CLINE +! @LINE THEN ; \ right & left 10:35 03/28/88 : RIGHT ( --- cl_off rw_off ) ?XY DROP 1 = IF ERRTONE 00 00 ELSE -1 00 -1 CCOL +! THEN ; : LEFT ( --- cl_off rw_off ) ?XY DROP R.BUFF RPT.#COLS C@ 1- = IF ERRTONE 00 00 ELSE 01 00 1 CCOL +! THEN ; ( -- cl-off rw-off ) : LF/CR DOWN NIP ?XY DROP 1- NEGATE SWAP CCOL OFF ; \ pg-dw 17:47 03/28/88 : HOME CCOL @ NEGATE 0 CCOL OFF ; : END 0 R.BUFF RPT.#COLS C@ 0 ?DO TBUFF R.BUFF RPT.#COLS C@ + I - C@ 32 <> IF DROP R.BUFF RPT.#COLS C@ I - LEAVE THEN LOOP 1+ DUP CCOL @ SWAP - NEGATE SWAP CCOL ! 0 ; : PG-DW 66 CLINE @ - 15 MIN 0 ?DO DOWN ?XY ROT + >R + R> GOTOXY .LINE LOOP HOME ; : PG-UP CLINE @ 15 MIN 0 ?DO UP ?XY ROT + >R + R> GOTOXY .LINE LOOP HOME ; \ bck_sp & sp 10:53 03/28/88 : CLR-LINE TBUFF 80 BLANK HOME ; : BCK_SP ( --- ) ?XY FULLW NOR 32 WND-CHAR! 32 CCOL @ TBUFF + C! RIGHT ; : DELETE TBUFF CCOL @ + 1+ TBUFF CCOL @ + R.BUFF RPT.#COLS C@ CCOL @ - CMOVE 0 0 ; \ char-process hs 10:18 01/20/88 ( char -- cl-off rw-off flag ) : CHAR-PROCESS MODE IF TBUFF CCOL @ + DUP 1+ R.BUFF RPT.#COLS C@ CCOL @ - CMOVE> THEN DUP CCOL @ TBUFF + C! DROP \ >R ?XY FULLW NOR R> WND-CHAR! 0 LEFT 0 ; : SPACE 32 CHAR-PROCESS DROP ROT DROP ; \ toggle-mode 07:21 03/29/88 : TMODE MODE 1 XOR EQU MODE ; : COORDS 63 24 FULLW REV MODE IF " Ins" ELSE " " THEN WND-CSTR! 70 24 FULLW REV CLINE @ 0 <# 44 HOLD # # #> SWAP WND-STR! 73 24 FULLW REV CCOL @ 0 <# # # #> SWAP WND-STR! ; \ @field 10:48 03/29/88 ' NO.COND WRK.DCT FLD.BUFF 0 FLD.NAME 20 DCT-CHOICE FLDC : @FIELD " Fields" LISTL DOUBLE REPORTW OPEN-WINDOW -CUR REPORTW FLDC DCT-CHOOSE REPORTW CLOSE-WINDOW +CUR IF FLD.BUFF FLD.NLEN C@ 0 ?DO FLD.BUFF FLD.NAME I + C@ CHAR-PROCESS DROP ROT DROP ?XY ROT + >R + R> GOTOXY LOOP THEN 0 0 ; \ ins-line 15:41 03/31/88 : INS-LINE S.BUFF CLINE @ R.BUFF RPT.#COLS @ * 2DUP R.BUFF RPT.#COLS @ + 66 CLINE @ - R.BUFF RPT.#COLS @ * CMOVEL> TBUFF 80 BLANK !LINE .LINE ?XY CLINE @ 21 ?XY NIP ?DO @LINE .LINE 1 CLINE +! ?XY 1+ GOTOXY LOOP CLINE ! GOTOXY @LINE .LINE 0 0 ; \ ins-line 15:41 03/31/88 : DEL-LINE S.BUFF CLINE @ R.BUFF RPT.#COLS @ * 2DUP R.BUFF RPT.#COLS @ + 2SWAP 66 CLINE @ - R.BUFF RPT.#COLS @ * CMOVEL .LINE ?XY CLINE @ 21 ?XY NIP ?DO @LINE .LINE 1 CLINE +! ?XY 1+ GOTOXY LOOP CLINE ! GOTOXY @LINE .LINE 0 0 ; \ disp-page 18:19 03/29/88 : DISP-PAGE 1 2 FULLW WND-GOTOXY CLINE OFF 20 0 ?DO @LINE .LINE 1 CLINE +! ?XY 1+ GOTOXY LOOP CLINE OFF ; : .TITLE-LNE PAD 80 BLANK 0 24 FULLW REV 80 PAD WND-STR! 35 24 FULLW REV " Design a Report" WND-CSTR! 2 24 FULLW REV 30 R.BUFF RPT.DESCR WND-STR! ; \ rpt-setup & @mem 10:06 03/29/88 : RPT-SETUP ( --- ) R.BUFF RPT.#COLS C@ CURRENTW WINDOW-#COL C! DISP-PAGE CLINE OFF CCOL OFF @LINE 1 EQU MODE ; : @MEM 545 MALLOC EQU S.BUFF TBUFF 80 BLANK 66 0 DO DS0 TBUFF S.BUFF I 80 * 80 CMOVEL LOOP ; \ draw-window 14:24 04/04/88 5 15 8 50 WINDOW SIZEW : DRAW-WINDOW " Report Specs." EDITL DOUBLE SIZEW OPEN-WINDOW 2 2 SIZEW NOR " Description:" WND-CSTR! 2 3 SIZEW NOR " #Lines/Page:" WND-CSTR! 2 4 SIZEW NOR " #Cols/Line :" WND-CSTR! 2 5 SIZEW NOR " Right Marg.:" WND-CSTR! 2 6 SIZEW NOR " Left Marg. :" WND-CSTR! 15 2 SIZEW HIL 30 R.BUFF RPT.DESCR WND-STR! 15 3 SIZEW HIL R.BUFF RPT.#LINES C@ 0 <# #S #> SWAP WND-STR! 15 4 SIZEW HIL R.BUFF RPT.#COLS C@ 0 <# #S #> SWAP WND-STR! 15 5 SIZEW HIL R.BUFF RPT.RM C@ 0 <# #S #> SWAP WND-STR! 15 6 SIZEW HIL R.BUFF RPT.LM C@ 0 <# #S #> SWAP WND-STR! ; \ fetches 14:33 04/04/88 : @DESCR 15 2 SIZEW R.BUFF RPT.DESCR 30 @STRING ; : @LINES 15 3 SIZEW R.BUFF RPT.#LINES C@ 0 0 2 @NUM >R DROP 66 MIN R.BUFF RPT.#LINES C! R> ; : @COLS 15 4 SIZEW R.BUFF RPT.#COLS C@ 0 0 2 @NUM >R DROP 79 MIN R.BUFF RPT.#COLS C! R> ; : @RM 15 5 SIZEW R.BUFF RPT.RM C@ 0 0 2 @NUM >R DROP 79 MIN R.BUFF RPT.RM C! R> ; : @LM 15 6 SIZEW R.BUFF RPT.LM C@ 0 0 2 @NUM >R DROP 79 MIN R.BUFF RPT.LM C! R> ; \ @size 15:03 04/04/88 CREATE vINP ] @DESCR @LINES @COLS @RM @LM [ 5 ' NOOP vINP INP-DEF ISIZE : @SIZE DRAW-WINDOW ISIZE 0 @SCREEN DROP SIZEW CLOSE-WINDOW CLS RBOX RPT-SETUP .TITLE-LNE 1 2 FULLW WND-GOTOXY 0 0 ; \ process h hs 10:18 01/20/88 : PROCESS PCKEY ?DUP 0= IF 100 + THEN CASE 168 OF -1 -1 0 0 ENDOF ( f10 f1 ) 159 OF 0 RHELP ENDOF 27 OF 0 -1 0 0 ENDOF ( esc f3 ) 161 OF 0 @SIZE ENDOF 014 OF 0 INS-LINE ENDOF ( ^N f6 ) 179 OF 0 END ENDOF 172 OF 0 UP ENDOF ( up dw ) 180 OF 0 DOWN ENDOF 177 OF 0 LEFT ENDOF ( lft rg ) 175 OF 0 RIGHT ENDOF 32 OF 0 SPACE ENDOF ( sp cr ) 13 OF 0 LF/CR ENDOF 160 OF 0 @FIELD ENDOF ( f2 ) 08 OF 0 BCK_SP ENDOF 183 OF 0 DELETE ENDOF ( del pgdw ) 181 OF 0 PG-DW ENDOF 173 OF 0 PG-UP ENDOF 171 OF 0 HOME ENDOF 021 OF 0 CLR-LINE ENDOF 182 OF 0 TMODE 0 0 ENDOF 025 OF 0 DEL-LINE ENDOF CHAR-PROCESS ENDCASE !LINE ?XY ROT + >R + R> GOTOXY .LINE COORDS ; \ rberept 14:50 03/25/88 : RBEREPT ( --- ) @MEM @MODE IF CLS RBOX MARGINS RPT-SETUP .TITLE-LNE 1 2 FULLW WND-GOTOXY BEGIN PROCESS UNTIL IF R.BUFF WRK.RPT DUP D.LST-READ @ DUP >R SWAP DICT-WRITE WRK.LAY 8712 R> UM* 0 FSEEK 2DROP WRK.LAY S.BUFF 0 8712 FWRITEL DROP THEN WRK.DCT CLOSE-DICTIONARY WRK.RPT CLOSE-DICTIONARY WRK.LAY FCLOSE DROP THEN S.BUFF FREE ; \ Excises 16:56 04/13/88 EXCISE MODE CFILE EXCISE S.BUFF DUMMY