/*****************************************************************/ /* */ /* PRINT IST EIN AUSGABEPROGRAMM FUER DEN DRUCKER. */ /* PRINT ERMOEGLICHT EINEN BELIEBIGEN LINKEN RAND, */ /* DAS ZEILENORIENTIERTE DRUCKEN VON ED-FILES SOWIE DIE */ /* GESTALTUNG MIT KOPF- UND FUSSZEILEN. */ /* DRUCKEN ERFOLGT MIT 12 CPI (80 ZEICHEN + LINKER RAND). */ /* */ /* Walter Botscher */ /* Malvenweg 3 */ /* 5204 Lohmar 21 */ /* */ /* */ /* LETZTE AENDERUNG 30.09.87 */ /* */ /*****************************************************************/ S=1000; MODULE PR; SYSTEM; A1; PP; FILE:ED.DUMMYNAME(NE); PROBLEM; SPC A1 DATION INOUT ALPHIC CONTROL(ALL); SPC PP DATION OUT ALPHIC CONTROL(ALL); SPC FILE DATION IN ALPHIC CONTROL(ALL); SPC CURPOS ENTRY(CHAR(1) IDENT,CHAR(1) IDENT)GLOBAL; SPC CLEAR ENTRY GLOBAL; DCL NAME CHAR(8); /* FILE NAME */ DCL BZEILE CHAR(72); /* BILDSCHIRMZEILE */ DCL DATE CHAR(8); DCL (HEAD,FOOT) CHAR(40); DCL LRAND FIXED; /* LINKER RAND */ DCL (ANFANG,SCHL,ZEILNR) FIXED INIT (1,2000,1); DCL BLANCS INV CHAR(8) INIT (' '); DCL (OPTION,R,ESC,ZWEI) CHAR(1); DCL (ACTLIN,SEITNR,K) FIXED; DCL MAXLINE FIXED INIT(48); /**************************************************************/ /* POSITIONIEREN DES CURSORS */ CURSET:PROC((LINE,COL) FIXED); DCL (XPOS,YPOS) CHAR(1); XPOS = TOCHAR(32+LINE); YPOS = TOCHAR(32+COL); PUT TOCHAR(27),'=',XPOS,YPOS TO A1 BY (4)A; END; /**************************************************************/ /* FORMATIERTE BILDSCHIRMAUSGABE */ FORMAT:PROC (NR FIXED); DCL (LINE,COL) CHAR(1); DCL WIDTH (8) FIXED ; DCL (X,Y) FIXED; DCL SPACES CHAR(39) INIT(' '); WIDTH(1) = 8; /* LAENGE DER INVERS DARGESTELLTEN FELDER */ WIDTH(2) = 1; WIDTH(3) = 4; WIDTH(4) = 4; WIDTH(5) = 1; WIDTH(6) = 8; WIDTH(7) = 39; WIDTH(8) = 39; CALL CURSET (2+NR,40); CALL CURPOS (LINE,COL); PUT TOCHAR(27),'G','4' TO A1 BY (3)A; PUT SPACES TO A1 BY A(WIDTH(NR-1)); PUT TOCHAR(27),'=',LINE,COL TO A1 BY (4)A; END; /******************************************************************/ MENUE:PROC; DCL TEXT(9) CHAR(40); DCL (ANF,STP) FIXED; DCL READY BIT(1); TEXT(1) = '********* DRUCKER - AUSGABE ********* '; TEXT(2) = 'Name des Ausgabe - Files (ED.xxx).....: '; TEXT(3) = 'Breite des linken Randes ( max. 8 Z.) : '; TEXT(4) = 'Start Druckausgabe bei Zeilen-Nr.(1)..: '; TEXT(5) = 'Ende Druckausgabe bei Zeilen-Nr.(9999): '; TEXT(6) = 'Option "Kopf- und Fußzeile" J/N.......: '; TEXT(7) = 'Datum (TT.MM.JJ)......................: '; TEXT(8) = 'Kopftext..............................: '; TEXT(9) = 'Fußtext...............................: '; CALL CURSET(2,19); PUT TEXT(1) TO A1 BY A,SKIP; /* UEBERSCHRIFT */ CALL CURSET(3,0); ANF = 2; STP = 6; OPTION = 'N'; READY = '0'B; DIALOG: FOR I FROM ANF TO STP REPEAT PUT TEXT(I) TO A1 BY SKIP,A; CALL FORMAT(I); CASE (I-1) ALT GET NAME FROM A1 BY SKIP,A; /* DIALOGTEXTE */ ALT GET LRAND FROM A1 BY SKIP,F(1); ALT GET ANFANG FROM A1 BY SKIP,F(4); IF ANFANG EQ 0 THEN ANFANG=1;FIN; ALT GET SCHL FROM A1 BY SKIP,F(4); IF SCHL EQ 0 THEN SCHL=9999;FIN; ALT GET OPTION FROM A1 BY SKIP,A(1); ALT GET DATE FROM A1 BY SKIP,A(8); ALT GET HEAD FROM A1 BY SKIP,A; ALT GET FOOT FROM A1 BY SKIP,A; FIN; PUT TOCHAR(27),'G','0' TO A1 BY (3)A; END; IF OPTION EQ 'J' AND NOT READY /* MIT KOPF UND FUSS ?*/ THEN ANF=7; STP = 9; READY = '1'B; GOTO DIALOG; ELSE IF OPTION EQ 'N' THEN GOTO MENEND; FIN; FIN; MENEND: END; /******************************************************************/ STAR:PROC((MODE,ANZ) FIXED); DCL STARS CHAR(1) INIT('*'); FOR I TO ANZ REPEAT CASE MODE ALT PUT STARS TO PP BY A; FIN; END; END; /*************************************************************/ BLANC:PROC((MODE,ANZ) FIXED); DCL SPACES CHAR(1) INIT(' '); FOR I TO ANZ REPEAT CASE MODE ALT PUT SPACES TO PP BY A; ALT PUT ' ' TO PP BY A,SKIP; ALT PUT ' ' TO PP BY A,SKIP,SKIP; ALT PUT ' ' TO PP BY A,PAGE; FIN; END; END; /*************************************************************/ KOPF:PROC; CALL BLANC(2,1); CALL BLANC(1,LRAND); CALL STAR(1,80); CALL BLANC(3,1); CALL BLANC(1,(LRAND+20)); PUT HEAD TO PP BY A(40); CALL BLANC(1,10); PUT DATE TO PP BY A(8); CALL BLANC(3,1); CALL BLANC(1,LRAND); CALL STAR(1,80); CALL BLANC(2,1); END; /*****************************************************************/ FUSS: PROC; CALL BLANC(2,1); CALL BLANC(1,LRAND); CALL STAR(1,80); CALL BLANC(3,1); CALL BLANC(1,(LRAND+20)); PUT FOOT TO PP BY A(40); CALL BLANC(1,10); PUT 'SEITE ',SEITNR TO PP BY A,F(4); CALL BLANC(3,1); CALL BLANC(1,LRAND); CALL STAR(1,80); CALL BLANC(4,1); ACTLIN = 0; SEITNR = SEITNR + 1; END; /*****************************************************************/ PRINT: TASK; CALL CLEAR; CALL MENUE; OPEN FILE BY IDF(NAME); CALL REWIND(FILE); /* DEUTSCHEN ZEICHENSATZ FUER DEN DRUCKER EINSCHALTEN */ ESC = TOCHAR(27); R = TOCHAR(82); ZWEI = TOCHAR(2); PUT ESC,R,ZWEI TO PP BY A; PUT ESC,TOCHAR(120),TOCHAR(48) TO PP BY A; PUT ESC,TOCHAR(33),TOCHAR(1) TO PP BY A; PUT TOCHAR(28),TOCHAR(83),TOCHAR(49) TO PP BY A; /* ERSTE ZEILE AUS FILE HOLEN,DAMIT WIRD ST(FILE) = 0 */ GET BZEILE FROM FILE BY SKIP,A; ZEILNR = 1; ACTLIN = 0; SEITNR = 1; IF ST(FILE) NE 0 THEN K = ST(FILE); GOTO FEHL; FIN; WHILE ST(FILE) EQ 0 REPEAT IF ZEILNR EQ ANFANG THEN GOTO DRUCKEN; ELSE GET BZEILE FROM FILE BY SKIP,A; ZEILNR = ZEILNR + 1; GOTO NEXT; FIN; DRUCKEN: FOR I FROM ANFANG TO SCHL WHILE ST(FILE) EQ 0 REPEAT IF OPTION EQ 'J' AND ACTLIN EQ 0 THEN CALL KOPF;FIN; PUT BLANCS,BZEILE TO PP BY SKIP,A(LRAND),A; GET BZEILE FROM FILE BY A,SKIP; ACTLIN = ACTLIN + 1; IF ACTLIN EQ MAXLINE THEN CALL FUSS; FIN; END; GOTO SCHLUSS; NEXT: END; CLOSE FILE; GOTO SCHLUSS; FEHL: PUT 'FEHLER BEI GET:',K TO A1 BY SKIP,A,F(5); SCHLUSS: PUT 'PROGRAMM PRINT IST BEENDET' TO A1 BY SKIP,A,SKIP; END; MODEND;