From 98cab31fc3659e33aef260efca55bf9f1753164c Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 11 Feb 2019 11:49:19 +0100 Subject: Add source files from Michael --- system/std.zusatz/1.7.3/src/eumel printer | 369 ++++++++++++++++++++++++++++++ 1 file changed, 369 insertions(+) create mode 100644 system/std.zusatz/1.7.3/src/eumel printer (limited to 'system/std.zusatz/1.7.3/src/eumel printer') diff --git a/system/std.zusatz/1.7.3/src/eumel printer b/system/std.zusatz/1.7.3/src/eumel printer new file mode 100644 index 0000000..79a4b2c --- /dev/null +++ b/system/std.zusatz/1.7.3/src/eumel printer @@ -0,0 +1,369 @@ +PACKET eumel printer DEFINES +(*************************************************************************** +***** EUMEL - DRUCKER ** Author: A. Reichpietch ** +***** ** R. Nolting ** +***** ** Date: 30.09.81 Vers. 0 ** +***** ** 15.03.82 Vers. 1.0 ** +***** ** 22.07.82 Vers. 1.1 ** +***** ** 01.10.82 Vers. 1.2 ** +***** reelle Werte fuer limit etc. ** 15.01.83 Vers. 2.0 ** +***** direkte Druckerkommandos (Hardware) ** 15.08.83 Vers. 2.1 ** +***** ** 15.12.83 Vers. 2.2 ** +***** alle Zeilen-/Spaltenprocs entfernt ** 9.1.84 Vers. 2.3 ** +***** neue 'print text' prozedur ** 04.03.84 Vers. 2.4 ** +***************************************************************************) + + print, + reset print, + print line, + pages printed, + + is elan source , (* dummy Prozeduren , koennen von *) + elan list : (* 'elan lister' ueberdeckt werden *) + + +LET blank = " " , + backspace = ""8"" , + begin mark underline = ""15"" , + end mark underline = ""14"" ; +LET paragraph end = " "; +TEXT VAR inline := blank, + outline := blank, + type := blank, + command char, + help := blank; +TEXT VAR command, + par 1, par 2, + skip end text; +REAL VAR y position, y step, y max, y factor; +INT VAR pagenr, from, to; +INT VAR printed pages; +BOOL VAR not skipped, lines to be skipped, + first text line, end of paragraph, + linefeed needed; +LET std pagelength = 25.4; + +INT VAR print mode set := left adj, collumn print possible; +LET left adj= 0; +LET right adj= 1; +LET centre adj= 2; +LET block line= 3; +LET left col= 4; +LET right col= 5; +LET centre col= 6; +LET block col= 7; +LET collumn print = 4; + + +PROC print (FILE VAR f): + enable stop; + reset printer; + reset print; + print (f, from, to); +END PROC print; + +PROC print (FILE VAR f, INT CONST first page, last page): + enable stop; + from := first page; + to := last page; + IF from > 1 THEN not skipped := FALSE FI; + WHILE (NOT eof(f)) AND (pagenr <= to) REP + getline (f, inline); + print input line; + ENDREP; + start(0.0, 0.0); make page; +ENDPROC print; + +PROC reset print: + first text line := TRUE; + not skipped := TRUE; + lines to be skipped := FALSE; + command char := "#"; + print mode set := left adj; + end of paragraph := TRUE; + inline := ""; + y max := stdpagelength ; + y position := 10000.0; + y step := lf height of current font; + y factor := 1.0; + pagenr := 0; + from := 1; to := maxint; + printed pages := -1; (* move to top of first page will set to 0 *) +ENDPROC reset print; + +INT PROC pages printed: + printed pages +END PROC pages printed; + +PROC print line (TEXT CONST in): + inline := in; + print input line; +END PROC print line; + +PROC print input line: +(* debug out ("print line:"); out (in); out (""10""13""); debug *) +INT VAR compos; +INT VAR endpos := 0, tpos := 1; +IF lines to be skipped + THEN IF pos (inline, skip end text) > 1 AND (inline SUB 1) = command char + THEN lines to be skipped := FALSE + FI; + LEAVE print input line + FI; + linefeed needed := FALSE; +IF end of paragraph + THEN collumn print possible := collumn print + ELSE collumn print possible := 0 + FI; +compos := LENGTH inline; +IF (inline SUB compos) = paragraph end + THEN end of paragraph := TRUE; + inline := subtext (inline, 1, compos -1) + ELSE end of paragraph := FALSE; + FI; + compos := pos (inline, command char); + IF compos <= 0 + THEN print the line (inline); + new line; + LEAVE print input line + FI; + outline := ""; + extract commands from input; + IF outline <> "" + THEN print the line (outline); new line + ELIF linefeed needed + THEN new line FI; +. +extract commands from input: +WHILE compos > 0 REP + outline CAT subtext (inline, tpos, compos-1); + endpos := pos ( inline, command char, compos +1); + IF endpos <= compos + THEN endpos := compos - 1; + compos := 0 + ELSE command := subtext ( inline, compos +1, endpos -1); + analyze command ( command); + tpos := endpos +1; + compos := pos(inline, command char, tpos); + FI; + PER; +outline CAT subtext (inline, endpos + 1); + +ENDPROC print input line; + + +TEXT VAR comlist:="ub:1.0ue:2.0type:4.1linefeed:5.1limit:6.1free:7.1page:8.01 +pagenr:9.2pagelength:10.1start:11.2foot:12.0end:13.0head:15.0headeven:16.0 +headodd:17.0bottom:19.0bottomeven:20.0bottomodd:21.0" +LET com list 2 = +"on:22.1off:23.1block:24.0left:25.0right:26.0centre:27.0center:28.0material:31.1papersize:32.2print:33.2"; +comlist CAT comlist 2; + +PROC analyze command (TEXT CONST command): +(* debug out ("analyze command:"); out (command); out (""10""13""); debug *) +IF pos (command, "-") = 1 + THEN LEAVE analyze command + ELIF pos (command, "/") = 1 + THEN help := subtext (command, 2); + print line so far; + printer cmd (help); + LEAVE analyze command + FI; +INT VAR comindex := -1, number := 0; + par 1 := ""; par 2 := ""; + disable stop; + analyze command ( com list, command, 3, comindex, number, par 1, par 2); + IF is error + THEN clear error + ELSE select command + FI; + enable stop; +. +select command : + SELECT comindex OF + CASE 1 : print line so far; on ("u"); + CASE 2 : print line so far; off ("u"); + CASE 4 : print line so far; set type (par 1) + CASE 5 : set linefeed ( par 1) + CASE 6 : set limit (par 1) + CASE 7 : print line so far; free (par 1) + CASE 8 : print line so far; make page + CASE 9 : + CASE 10 : set pagelength (par 1) + CASE 11 : set start (par 1, par 2) + CASE 12 : (* skip text ("end") *) + CASE 15,16,17 : (* skip text ("end") *) + CASE 19,20,21 : (* skip text ("end") *) + CASE 22 : print line so far; on (par1) + CASE 23 : print line so far; off (par1) + CASE 24 : print line so far; print mode set := block line; + CASE 25 : print line so far; print mode set := left adj; + CASE 26 : print line so far; print mode set := right adj + CASE 27 : print line so far; print mode set := centre adj + CASE 28 : comindex := print mode set MOD 4; + IF comindex = block line + THEN inline CAT "#block#" + ELIF comindex = left adj + THEN inline CAT "#left#" + ELIF comindex = right adj + THEN inline CAT "#right#" + FI; + print mode set := centre adj; +(* the following commands must appear before any text *) + CASE 31 : IF first text line THEN material (par1) FI + CASE 32 : IF first text line THEN do papersize (par1, par2) FI + CASE 33 : IF first text line THEN print from page till page (par1, par2) FI + OTHERWISE + END SELECT ; +. +print line so far: + IF outline <> "" + THEN print the line (outline); + outline := ""; + linefeed needed := TRUE + FI; + +ENDPROC analyze command; + +PROC do papersize (TEXT CONST s, t): +REAL VAR w, l; + IF ok (par1, w) AND ok (par2, l) + THEN papersize (w, l) + FI; +END PROC do papersize; + +PROC print from page till page(TEXT VAR s, t): +INT VAR i, j; + IF ok (par1, i) AND ok (par2, j) + THEN from := i; + to := j; + FI; +END PROC print from page till page; + +PROC set type (TEXT CONST new type): + change type (new type); + y step := lf height of current font; +ENDPROC set type; + +PROC make page : + IF y position > 0.0 CAND NOT first text line + THEN y position := y max + 1.0; new line + FI; + end of paragraph := TRUE; + inline := ""; (* this stops further processing of the input line *) +ENDPROC make page; + +PROC skip text (TEXT CONST endword): + lines to be skipped := TRUE; + skip end text := endword; + inline := ""; (* possible rest of the line is not examined *) +END PROC skip text; + +PROC set linefeed ( TEXT CONST lf): +REAL VAR l:= real (lf); + IF last conversion ok THEN y factor := l FI; +ENDPROC set linefeed; + +PROC set limit ( TEXT CONST l): + REAL VAR len; + IF ok (l, len) + THEN limit (len) + FI; +ENDPROC set limit; + +BOOL PROC ok ( TEXT CONST param, INT VAR number): + number := int (param) ; + last conversion ok +ENDPROC ok; + +BOOL PROC ok ( TEXT CONST param, REAL VAR number): + number := real (param) ; + last conversion ok +ENDPROC ok; + +PROC set pagelength (TEXT CONST y): +REAL VAR iy ; + IF ok (y, iy ) + THEN y max := iy; +FI; +ENDPROC set pagelength; + +PROC set start (TEXT CONST x, y): +REAL VAR rx, ry; + IF ok (x, rx) AND ok (y, ry) + THEN start (rx, ry) + FI; +ENDPROC set start; + +PROC free (TEXT CONST p): +REAL VAR x, y := y factor; + IF ok (p, x) + THEN advance + FI; +y factor := y; +end of paragraph := TRUE; + inline := ""; (* this stops further processing of the input line *) +. +advance: + y factor := x / y step; + IF outline <> "" + THEN print the line (outline); + outline := "" + FI; + IF first text line + THEN new line FI; +new line; +END PROC free; + +PROC print the line ( TEXT CONST in): +(* debug out ("print the line:"); out (in); out (print mode set); +out (""10""13""); debug *) +IF first text line + THEN first text line := FALSE; new line FI; +IF not skipped + THEN IF print mode set = blockline + THEN IF end of paragraph + THEN print text (in, left adj + collumn print possible) + ELSE print text (in, blockline + collumn print possible) + FI + ELSE print text (in, print mode set + collumn print possible) + FI + FI; +ENDPROC print the line; + +PROC new line: +(* debug out ("new line: lf="); out (text(yfactor)); out (""10""13""); debug *) +IF page is full + THEN pagenr INCR 1; + IF not skipped + THEN printed pages INCR 1; + new page + FI; + check printmodes; + y position := 0.0 + ELSE IF not skipped + THEN line (y factor) + FI; + y position INCR yfactor * y step + FI; +ENDPROC new line; + +PROC check printmodes: + not skipped := ( pagenr >= from) AND ( pagenr <= to); +ENDPROC check printmodes; + +BOOL PROC page is full: + y position + yfactor * y step > y max +ENDPROC page is full; + +(********** dummys ************) + +BOOL PROC is elan source (FILE VAR source) : + FALSE +ENDPROC is elan source ; + +PROC elan list (FILE VAR source) : + print (source) +ENDPROC elan list ; + +ENDPACKET eumel printer; -- cgit v1.2.3