diff options
Diffstat (limited to 'system/std.zusatz/1.7.3/src/eumel printer')
| -rw-r--r-- | system/std.zusatz/1.7.3/src/eumel printer | 369 |
1 files changed, 369 insertions, 0 deletions
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;
|