From 04e68443040c7abad84d66477e98f93bed701760 Mon Sep 17 00:00:00 2001
From: Lars-Dominik Braun <lars@6xq.net>
Date: Mon, 4 Feb 2019 13:09:03 +0100
Subject: Initial import
---
.../printer-laser/4/src/fonttab.apple.laserwriter | Bin 0 -> 100864 bytes
system/printer-laser/4/src/fonttab.canon.lbp-8 | Bin 0 -> 58368 bytes
system/printer-laser/4/src/fonttab.epson.sq | Bin 0 -> 29696 bytes
system/printer-laser/4/src/fonttab.hp.laserjet | Bin 0 -> 24064 bytes
system/printer-laser/4/src/fonttab.kyocera.f-1010 | Bin 0 -> 71168 bytes
system/printer-laser/4/src/fonttab.nec.lc-08 | Bin 0 -> 38400 bytes
.../4/src/genfont.kyocera.f-1010.dynamic1 | 30 +
.../4/src/genfont.kyocera.f-1010.dynamic2 | 30 +
system/printer-laser/4/src/laser.inserter | 275 ++++++++
.../printer-laser/4/src/printer.apple.laserwriter | 770 +++++++++++++++++++++
system/printer-laser/4/src/printer.canon.lbp-8 | 327 +++++++++
system/printer-laser/4/src/printer.epson.sq | 585 ++++++++++++++++
system/printer-laser/4/src/printer.hp.laserjet | 417 +++++++++++
system/printer-laser/4/src/printer.kyocera.f-1010 | 373 ++++++++++
system/printer-laser/4/src/printer.nec.lc-08 | 626 +++++++++++++++++
15 files changed, 3433 insertions(+)
create mode 100644 system/printer-laser/4/src/fonttab.apple.laserwriter
create mode 100644 system/printer-laser/4/src/fonttab.canon.lbp-8
create mode 100644 system/printer-laser/4/src/fonttab.epson.sq
create mode 100644 system/printer-laser/4/src/fonttab.hp.laserjet
create mode 100644 system/printer-laser/4/src/fonttab.kyocera.f-1010
create mode 100644 system/printer-laser/4/src/fonttab.nec.lc-08
create mode 100644 system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic1
create mode 100644 system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic2
create mode 100644 system/printer-laser/4/src/laser.inserter
create mode 100644 system/printer-laser/4/src/printer.apple.laserwriter
create mode 100644 system/printer-laser/4/src/printer.canon.lbp-8
create mode 100644 system/printer-laser/4/src/printer.epson.sq
create mode 100644 system/printer-laser/4/src/printer.hp.laserjet
create mode 100644 system/printer-laser/4/src/printer.kyocera.f-1010
create mode 100644 system/printer-laser/4/src/printer.nec.lc-08
(limited to 'system/printer-laser/4/src')
diff --git a/system/printer-laser/4/src/fonttab.apple.laserwriter b/system/printer-laser/4/src/fonttab.apple.laserwriter
new file mode 100644
index 0000000..bee2d6a
Binary files /dev/null and b/system/printer-laser/4/src/fonttab.apple.laserwriter differ
diff --git a/system/printer-laser/4/src/fonttab.canon.lbp-8 b/system/printer-laser/4/src/fonttab.canon.lbp-8
new file mode 100644
index 0000000..45314ac
Binary files /dev/null and b/system/printer-laser/4/src/fonttab.canon.lbp-8 differ
diff --git a/system/printer-laser/4/src/fonttab.epson.sq b/system/printer-laser/4/src/fonttab.epson.sq
new file mode 100644
index 0000000..a3f7af3
Binary files /dev/null and b/system/printer-laser/4/src/fonttab.epson.sq differ
diff --git a/system/printer-laser/4/src/fonttab.hp.laserjet b/system/printer-laser/4/src/fonttab.hp.laserjet
new file mode 100644
index 0000000..4082e46
Binary files /dev/null and b/system/printer-laser/4/src/fonttab.hp.laserjet differ
diff --git a/system/printer-laser/4/src/fonttab.kyocera.f-1010 b/system/printer-laser/4/src/fonttab.kyocera.f-1010
new file mode 100644
index 0000000..9c3fbda
Binary files /dev/null and b/system/printer-laser/4/src/fonttab.kyocera.f-1010 differ
diff --git a/system/printer-laser/4/src/fonttab.nec.lc-08 b/system/printer-laser/4/src/fonttab.nec.lc-08
new file mode 100644
index 0000000..f032953
Binary files /dev/null and b/system/printer-laser/4/src/fonttab.nec.lc-08 differ
diff --git a/system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic1 b/system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic1
new file mode 100644
index 0000000..fae8c09
--- /dev/null
+++ b/system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic1
@@ -0,0 +1,30 @@
+#"!"82"! "#
+#"CMNT 'dyn1.6 '; GENF 10220, 'DYNAMIC1', 22, 32, 126, 32, 0.94, 0.0, 0, 0, 0.0, 0.0; "#
+#"CMNT 'dyn1.6.i '; GENF 10224, 'DYNAMIC1', 22, 32, 126, 32, 0.94, 0.3, 0, 0, 0.0, 0.0; "#
+#"CMNT 'dyn1.8 '; GENF 10280, 'DYNAMIC1', 28, 32, 126, 32, 0.94, 0.0, 0, 0, 0.0, 0.0; "#
+#"CMNT 'dyn1.8.i '; GENF 10284, 'DYNAMIC1', 28, 32, 126, 32, 0.94, 0.3, 0, 0, 0.0, 0.0; "#
+#"CMNT 'dyn1.10 '; GENF 10340, 'DYNAMIC1', 34, 32, 126, 32, 0.94, 0.0, 0, 0, 0.0, 0.0; "#
+#"CMNT 'dyn1.10.i'; GENF 10344, 'DYNAMIC1', 34, 32, 126, 32, 0.94, 0.3, 0, 0, 0.0, 0.0; "#
+#"CMNT 'dyn1.12 '; GENF 10420, 'DYNAMIC1', 42, 32, 126, 32, 0.94, 0.0, 0, 0, 0.0, 0.0; "#
+#"CMNT 'dyn1.12.i'; GENF 10424, 'DYNAMIC1', 42, 32, 126, 32, 0.94, 0.3, 0, 0, 0.0, 0.0; "#
+#"CMNT 'dyn1.14 '; GENF 10500, 'DYNAMIC1', 50, 32, 126, 32, 0.94, 0.0, 0, 0, 0.0, 0.0; "#
+#"CMNT 'dyn1.14.b'; GENF 10502, 'DYNAMIC1', 50, 32, 126, 32, 1.04, 0.0, 0, 0, 5.0, 3.0; "#
+#"CMNT 'dyn1.18.b'; GENF 10682, 'DYNAMIC1', 68, 32, 126, 32, 1.04, 0.0, 0, 0, 5.0, 3.0; "#
+#"CMNT 'dyn1.24.b'; GENF 10922, 'DYNAMIC1', 92, 32, 126, 32, 1.04, 0.0, 0, 0, 5.0, 3.0; "#
+#"CMNT 'dyn1.36.b'; GENF 11322, 'DYNAMIC1', 132, 32, 126, 32, 1.04, 0.0, 0, 0, 5.0, 3.0; "#
+#"MAP 0, 0; EXIT;"#
+
+#type ("dyn1.6") #\#type("dyn1.6")\#
+#type ("dyn1.6.i") #\#type("dyn1.6.i")\#
+#type ("dyn1.8") #\#type("dyn1.8")\#
+#type ("dyn1.8.i") #\#type("dyn1.8.i")\#
+#type ("dyn1.10") #\#type("dyn1.10")\#
+#type ("dyn1.10.i")#\#type("dyn1.10.i")\#
+#type ("dyn1.12") #\#type("dyn1.12")\#
+#type ("dyn1.12.i")#\#type("dyn1.12.i")\#
+#type ("dyn1.14") #\#type("dyn1.14")\#
+#type ("dyn1.14.b")#\#type("dyn1.14.b")\#
+#type ("dyn1.18.b")#\#type("dyn1.18.b")\#
+#type ("dyn1.24.b")#\#type("dyn1.24.b")\#
+#type ("dyn1.36.b")#\#type("dyn1.36.b")\#
+
diff --git a/system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic2 b/system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic2
new file mode 100644
index 0000000..f425a7f
--- /dev/null
+++ b/system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic2
@@ -0,0 +1,30 @@
+#"!"82"! "#
+#"CMNT 'dyn2.6 '; GENF 20200, 'DYNAMIC2', 20, 32, 126, 32, 0.94, 0.0, 0, 0, 2.0, 0.0; "#
+#"CMNT 'dyn2.6.i '; GENF 20204, 'DYNAMIC2', 20, 32, 126, 32, 0.94, 0.3, 0, 0, 2.0, 0.0; "#
+#"CMNT 'dyn2.8 '; GENF 20260, 'DYNAMIC2', 26, 32, 126, 32, 0.94, 0.0, 0, 0, 2.0, 0.0; "#
+#"CMNT 'dyn2.8.i '; GENF 20264, 'DYNAMIC2', 26, 32, 126, 32, 0.94, 0.3, 0, 0, 2.0, 0.0; "#
+#"CMNT 'dyn2.10 '; GENF 20320, 'DYNAMIC2', 32, 32, 126, 32, 0.94, 0.0, 0, 0, 2.0, 0.0; "#
+#"CMNT 'dyn2.10.i'; GENF 20324, 'DYNAMIC2', 32, 32, 126, 32, 0.94, 0.3, 0, 0, 2.0, 0.0; "#
+#"CMNT 'dyn2.12 '; GENF 20400, 'DYNAMIC2', 40, 32, 126, 32, 0.94, 0.0, 0, 0, 2.0, 0.0; "#
+#"CMNT 'dyn2.12.i'; GENF 20404, 'DYNAMIC2', 40, 32, 126, 32, 0.94, 0.3, 0, 0, 2.0, 0.0; "#
+#"CMNT 'dyn2.14 '; GENF 20480, 'DYNAMIC2', 48, 32, 126, 32, 0.94, 0.0, 0, 0, 2.0, 0.0; "#
+#"CMNT 'dyn2.14.b'; GENF 20482, 'DYNAMIC2', 48, 32, 126, 32, 0.99, 0.0, 0, 0, 5.0, 3.0; "#
+#"CMNT 'dyn2.18.b'; GENF 20662, 'DYNAMIC2', 66, 32, 126, 32, 0.99, 0.0, 0, 0, 5.0, 3.0; "#
+#"CMNT 'dyn2.24.b'; GENF 20902, 'DYNAMIC2', 90, 32, 126, 32, 0.99, 0.0, 0, 0, 5.0, 3.0; "#
+#"CMNT 'dyn2.36.b'; GENF 21302, 'DYNAMIC2', 130, 32, 126, 32, 0.99, 0.0, 0, 0, 5.0, 3.0; "#
+#"MAP 0, 0; EXIT;"#
+
+#type ("dyn2.6") #\#type("dyn2.6")\#
+#type ("dyn2.6.i") #\#type("dyn2.6.i")\#
+#type ("dyn2.8") #\#type("dyn2.8")\#
+#type ("dyn2.8.i") #\#type("dyn2.8.i")\#
+#type ("dyn2.10") #\#type("dyn2.10")\#
+#type ("dyn2.10.i")#\#type("dyn2.10.i")\#
+#type ("dyn2.12") #\#type("dyn2.12")\#
+#type ("dyn2.12.i")#\#type("dyn2.12.i")\#
+#type ("dyn2.14") #\#type("dyn2.14")\#
+#type ("dyn2.14.b")#\#type("dyn2.14.b")\#
+#type ("dyn2.18.b")#\#type("dyn2.18.b")\#
+#type ("dyn2.24.b")#\#type("dyn2.24.b")\#
+#type ("dyn2.36.b")#\#type("dyn2.36.b")\#
+
diff --git a/system/printer-laser/4/src/laser.inserter b/system/printer-laser/4/src/laser.inserter
new file mode 100644
index 0000000..c28766f
--- /dev/null
+++ b/system/printer-laser/4/src/laser.inserter
@@ -0,0 +1,275 @@
+PACKET laserdrucker inserter DEFINES treiber einrichten :
+
+(**************************************************************************)
+(* Installationsprogramm Stand : 12.12.88 *)
+(* für Tintenstrahl- Version : 0.9 *)
+(* und Laserdrucker Autor : hjh *)
+(**************************************************************************)
+
+LET anzahl firmen = 6 ;
+LET apple = "APPLE" ,
+ canon = "CANON" ,
+ epson = "EPSON" ,
+ hp = "HEWLETT PACKARD" ,
+ kyo = "KYOCERA" ,
+ nec = "NEC" ;
+
+THESAURUS VAR firmen := empty thesaurus ;
+
+INT VAR i ;
+ROW anzahl firmen THESAURUS VAR drucker ;
+FOR i FROM 1 UPTO anzahl firmen REP
+ drucker (i) := empty thesaurus
+PER ;
+ROW anzahl firmen THESAURUS VAR printer ;
+FOR i FROM 1 UPTO anzahl firmen REP
+ printer (i) := empty thesaurus
+PER ;
+ROW anzahl firmen THESAURUS VAR fonttables ;
+FOR i FROM 1 UPTO anzahl firmen REP
+ fonttables (i) := empty thesaurus
+PER ;
+
+liste (apple,"LASERWRITER","printer.apple.laserwriter","fonttab.apple.laserwriter");
+liste (canon , "LBP-8" ,"printer.canon.lbp-8" ,"fonttab.canon.lbp-8");
+liste (epson , "SQ 2500" ,"printer.epson.sq" ,"fonttab.epson.sq");
+liste (hp , "HP LASERJET" ,"printer.hp.laserjet" ,"fonttab.hp.laserjet");
+liste (hp , "HP LASERJET+" ,"printer.hp.laserjet" ,"fonttab.hp.laserjet");
+liste (kyo , "F-1010" ,"printer.kyocera.f-1010" ,"fonttab.kyocera.f-1010");
+liste (kyo , "F-2200" ,"printer.kyocera.f-1010" ,"fonttab.kyocera.f-1010");
+liste (nec , "SILENTWRITER LC-08" ,"printer.nec.lc-08"
+,"fonttab.nec.lc-08");
+
+treiber einrichten;
+
+PROC liste (TEXT CONST firmenname, druckername ,
+ printername, fonttabname ) :
+ INT VAR firmnum ;
+ IF firmen CONTAINS firmenname
+ THEN firmnum := link (firmen,firmenname)
+ ELSE insert (firmen,firmenname,firmnum)
+ FI;
+ insert (drucker(firmnum), druckername) ;
+ insert (printer(firmnum), printername) ;
+ insert (fonttables(firmnum), fonttabname) ;
+END PROC liste ;
+
+PROC treiber einrichten :
+ INT VAR menu phase := 1 ;
+ BOOL VAR installed := FALSE ;
+ BOOL VAR was esc ;
+ INT VAR firmnum, druckernum ;
+ TEXT VAR firmenname, druckername, printername, fonttabname ;
+
+ pre menu ;
+ REP
+ SELECT menu phase OF
+ CASE 1 : menu ("Hauptmenü Tintenstrahl und Laserdrucker", firmen,
+ "CR: Eingabe ESC : Installation abrechen",
+ firmnum, was esc ) ;
+ IF was esc
+ THEN menu phase := 0
+ ELSE menu phase := 2 ;
+ firmenname := name (firmen,firmnum) ;
+ FI ;
+
+ CASE 2 : menu (firmenname + " - Menü", drucker(firmnum),
+ "CR: Eingabe ESC : Zurück zum Hauptmenü",
+ druckernum, was esc) ;
+ IF was esc
+ THEN menu phase := 1
+ ELSE menu phase := 3 ;
+ druckername := name (drucker(firmnum),druckernum);
+ printername := name (printer(firmnum),druckernum);
+ fonttabname := name (fonttables(firmnum),druckernum);
+ FI;
+
+ CASE 3 : inst (druckername, printername, fonttabname, installed) ;
+ IF NOT installed THEN menu phase := 1 FI;
+ END SELECT
+ UNTIL installed OR abbruch PER ;
+ post menu.
+
+ abbruch:
+ menu phase < 1 .
+
+ pre menu:
+ line;
+ IF is single task system
+ THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL")
+ FI;
+ IF NOT is system task (myself)
+ THEN errorstop ("Die Druckertask muß im Systemzweig angelegt werden")
+ FI;
+ command dialogue (TRUE);
+ IF name (myself) <> "PRINTER"
+ THEN putline ("Diese Task heißt nicht ""PRINTER"", sondern """ +
+ name (myself) + """ !");
+ IF yes ("Soll die Task in ""PRINTER"" umbenannt werden ?")
+ THEN rename myself ("PRINTER")
+ FI
+ FI.
+
+ is single task system: (pcb (9) AND 255) = 1.
+
+ post menu:
+ IF NOT installed
+ THEN page;
+ putline ("Es ist kein Druckertreiber installiert worden!");
+ line;
+ putline ("Wenn dieses Installationsprogramm insertiert wurde,");
+ putline ("kann es in der Task """ + name (myself) + """ ");
+ putline ("mit 'treiber einrichten' erneut aufgerufen werden.");
+ line;
+ FI.
+
+END PROC treiber einrichten ;
+
+PROCEDURE menu (TEXT CONST header, THESAURUS CONST items, TEXT CONST bottom,
+ INT VAR choice, BOOL VAR was esc) :
+ INT VAR anzahl ;
+ page;
+ headline (header) ;
+ show list (items,anzahl) ;
+ bottomline (bottom) ;
+ ask user (anzahl,choice,was esc);
+END PROC menu ;
+
+PROC headline (TEXT CONST header):
+ cursor (13,1);
+ putline ("E U M E L - Druckertreiber - Installations - Programm");
+ cursor (40 - LENGTH header DIV 2, 2);
+ IF header <> "" THEN put (header) FI ;
+ line (2)
+END PROC headline;
+
+PROC bottomline (TEXT CONST bottom):
+ cursor (1,24);
+ IF bottom <> "" THEN put (""5"" + bottom) FI ;
+END PROC bottomline;
+
+PROC show list (THESAURUS CONST items , INT VAR anzahl ) :
+ INT VAR i ;
+ anzahl := highest entry (items);
+ FOR i FROM 1 UPTO anzahl REP
+ putline ( text(i) + ". " + name (items,i) ) ;
+ PER;
+END PROC show list ;
+
+PROC ask user (INT CONST max choice, INT VAR choice, BOOL VAR was esc):
+ TEXT VAR exit;
+ TEXT VAR inp := "";
+ REP
+ cursor (1,23);
+ IF inp = ""
+ THEN put ("Ihre Wahl (Nummer eingeben):")
+ ELSE put ("FEHLER! Eingabe korrigieren:")
+ FI;
+ editget (inp, ""27"", "", exit);
+ was esc := exit = ""27"";
+ UNTIL was esc OR ok PER.
+
+ ok:
+ choice := int (inp) ;
+ last conversion ok CAND ( choice > 0 AND choice <= max choice) .
+END PROC ask user;
+
+BOOL PROC is system task (TASK CONST task):
+ TASK VAR tsk := task ;
+ WHILE NOT (tsk = supervisor OR tsk = niltask) REP
+ tsk := father (tsk) ;
+ PER;
+ tsk = supervisor
+END PROC is system task ;
+
+PROC inst (TEXT CONST druckername, printername, fonttabname,
+ BOOL VAR success) :
+ page ;
+ headline (druckername) ;
+ fetch from archive if necessary ((empty thesaurus
+ + printer name + fonttab name) - all ,success);
+ IF success AND ok
+ THEN page ;
+ putline ("Der Drucker wird insertiert");
+ insert (printer name) ;
+ ELSE success := FALSE ;
+ FI.
+
+ok:
+ bottomline (" ");
+ yes ("Soll der ausgewählte Drucker insertiert werden").
+
+END PROC inst ;
+
+PROC fetch from archive if necessary (THESAURUS CONST files,
+ BOOL VAR success ):
+ BOOL VAR was esc ;
+ THESAURUS VAR thes :: files;
+
+ WHILE highest entry (thes) > 0 REP
+ ask for archive;
+ IF NOT was esc
+ THEN disable stop ;
+ bottomline ("Bitte warten ! ");
+ reserve archive;
+ IF NOT is error
+ THEN IF highest entry (thes / ALL archive) > 0
+ THEN fetch (thes / ALL archive, archive);
+ ELSE fehler ("Dateien nicht gefunden")
+ FI;
+ thes := thes - all;
+ FI;
+ IF is error
+ THEN fehler (errormessage);
+ clear error
+ FI;
+ command dialogue (FALSE);
+ release (archive);
+ command dialogue (TRUE);
+ enable stop ;
+ FI;
+ UNTIL was esc PER;
+ success := highest entry (thes) = 0.
+
+ask for archive:
+ headline ("") ;
+ putline ("Bitte Archiv mit den Dateien");
+ TEXT VAR buffer;
+ INT VAR index :: 0;
+ REP
+ get (thes, buffer, index);
+ putline (" " + buffer)
+ UNTIL index = 0 PER;
+ putline ("einlegen !");
+ bottomline ("CR: Wenn Archiv eingelegt ESC : Zurück zum Hauptmenü");
+ cursor (1,24);
+ REP
+ inchar (buffer) ;
+ UNTIL buffer = ""13"" OR buffer = ""27"" PER ;
+ was esc := buffer = ""27"".
+
+reserve archive :
+ INT VAR p1, p2;
+ archive (" "31" ");
+ list (archive);
+ IF is error
+ THEN buffer := errormessage;
+ p1 := pos (buffer, """", 1 ) + 1;
+ p2 := pos (buffer, """", p1) - 1;
+ IF p1 > 0 AND p2 > 0
+ THEN clear error;
+ buffer := subtext (buffer, p1, p2);
+ archive (buffer);
+ FI;
+ FI.
+
+END PROC fetch from archive if necessary ;
+
+PROC fehler (TEXT CONST fehlermeldung):
+ bottomline (""7"" + fehlermeldung + " Bitte eine Taste drücken") ;
+ pause ;
+ bottomline (" ") ;
+END PROC fehler;
+
+END PACKET laserdrucker inserter;
+
diff --git a/system/printer-laser/4/src/printer.apple.laserwriter b/system/printer-laser/4/src/printer.apple.laserwriter
new file mode 100644
index 0000000..d4c6adf
--- /dev/null
+++ b/system/printer-laser/4/src/printer.apple.laserwriter
@@ -0,0 +1,770 @@
+PACKET apple laser writer printer
+
+(**************************************************************************)
+(* Stand : 24.02.88 *)
+(* APPLE LaswerWriter (PostScript) Verison : 4 *)
+(* Autor : Rudolf Ruland *)
+(**************************************************************************)
+
+ DEFINES open,
+ close,
+ execute,
+
+ paper size,
+ paper x size,
+ paper y size,
+
+ load positioning procs,
+ load underline procs,
+ load italics procs,
+ load encoding,
+
+ read ps input,
+
+ box commands,
+ insert box command,
+ delete box command,
+
+ print error,
+ :
+
+LET
+(* underline = 1,
+ bold = 2,
+ italics = 4,
+ reverse = 8,
+*)
+ underline linetype = 1,
+
+ c document = 1,
+ c page = 2,
+
+ c write text = 1,
+ c write cmd = 2,
+ c carriage return = 3,
+ c move = 4,
+ c draw = 5,
+ c on = 6,
+ c off = 7,
+ c type = 8,
+
+ ps input name = "PostScript.input",
+ ps error = 999,
+
+ tag type = 1;
+
+INT VAR paper length, font no, underline no, symbol type;
+REAL VAR x size, y size;
+BOOL VAR is landscape;
+TEXT VAR record, char, command, symbol;
+FILE VAR ps input;
+THESAURUS VAR box cmds := empty thesaurus;
+
+(*********************************************************************)
+
+paper size (21.0, 29.7);
+
+PROC paper size (REAL CONST x, y) :
+
+ x size := x;
+ y size := y;
+
+END PROC paper size;
+
+PROC paper size :
+
+ line;
+ putline ("Papierbreite = " + text (x size, 5, 2) + " cm = " + text (x size / 2.54, 5, 2) + " Zoll");
+ putline ("Papierlaenge = " + text (y size, 5, 2) + " cm = " + text (y size / 2.54, 5, 2) + " Zoll");
+
+END PROC paper size;
+
+REAL PROC paper x size : x size END PROC paper x size;
+
+REAL PROC paper y size : y size END PROC paper y size;
+
+
+THESAURUS PROC box commands : box cmds END PROC box commands;
+
+PROC insert box command (TEXT CONST new command) :
+
+ command := new command;
+ change all (command, " ", "");
+ insert (box cmds, command)
+
+END PROC insert box command;
+
+PROC delete box command (TEXT CONST old command) :
+
+ INT VAR dummy;
+ command := old command;
+ change all (command, " ", "");
+ delete (box cmds, command, dummy)
+
+END PROC delete box command;
+
+(*********************************************************************)
+
+PROC open (INT CONST op code, INT VAR param1, param2) :
+
+SELECT op code OF
+ CASE c document : open document
+ CASE c page : open page
+END SELECT;
+
+
+. x steps : param1
+. y steps : param2
+.
+ open document :
+ IF pos (material, "landscape") > 0 OR pos (material, "quer") > 0
+ THEN is landscape := TRUE;
+ x steps := x step conversion ( y size );
+ y steps := y step conversion ( x size );
+ ELSE is landscape := FALSE;
+ x steps := x step conversion ( x size );
+ y steps := y step conversion ( y size );
+ FI;
+ forget (ps input name, quiet);
+ ps input := sequential file (output, ps input name);
+ paper length := y steps;
+ font no := 0;
+ underline no := 0;
+ disable stop;
+ out (""4"");
+ read ps input (ps input, 18000, ""4"");
+ clear error;
+ enable stop;
+ out ("initgraphics erasepage statusdict /waittimeout 3000 put ");
+ load positioning procs;
+ load underline procs;
+ load italics procs;
+ load encoding;
+ read ps input (ps input, 0, "");
+
+. x start : param1
+. y start : param2
+.
+ open page :
+ x start := 0;
+ y start := 0;
+ IF pos (material, "tray") > 0
+ THEN out ("statusdict /manualfeed false put ");
+ ELIF pos (material, "manual") > 0
+ THEN out ("statusdict /manualfeed true put statusdict /manualfeedtimeout 3600 put ");
+ FI;
+ IF material contains a number
+ THEN out ("/#copies "); out (number); out ("def ");
+ FI;
+ IF is landscape
+ THEN out (paper length);
+ out ("ys 0 translate 90 rotate ");
+ FI;
+ read ps input (ps input, 0, "");
+
+ . material contains a number :
+ INT VAR number := pos (material, "0", "9", 1);
+ IF number = 0
+ THEN FALSE
+ ELSE number := max (1, int (subtext (material, number, number + 1)));
+ TRUE
+ FI
+
+END PROC open;
+
+
+PROC close (INT CONST op code, INT CONST param1) :
+
+SELECT op code OF
+ CASE c document : close document
+ CASE c page : close page
+ OTHERWISE : put (param1)
+END SELECT;
+
+.
+ close document :
+ disable stop;
+ out (""4"");
+ read ps input (ps input, 18000, ""4"");
+
+
+(*. remaining y steps : param1*)
+.
+ close page :
+ outline ("showpage");
+ read ps input (ps input, 0, "");
+
+END PROC close;
+
+
+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :
+
+SELECT op code OF
+ CASE c write text : write text
+ CASE c write cmd : write cmd
+ CASE c carriage return : carriage return
+ CASE c move : move
+ CASE c draw : draw
+ CASE c on : on
+ CASE c off : off
+ CASE c type : type
+END SELECT
+
+
+. from : param1
+. to : param2
+.
+ write text :
+ out ("(");
+ out subtext (string, from, to);
+ out (") show ");
+.
+ write cmd :
+ command := subtext (string, from, to);
+ IF is box cmd
+ THEN disable stop;
+ do (command);
+ clear error;
+ ELSE out (command);
+ out (" ");
+ FI;
+
+ . is box cmd :
+ scan (command);
+ next symbol (symbol, symbol type);
+ (symbol type = tag type) CAND (box cmds CONTAINS symbol)
+
+
+(*. x steps to left margin : param1*)
+.
+ carriage return :
+ move to (0, y pos);
+ line;
+ read ps input (ps input, 0, "");
+
+
+. x steps : param1
+. y steps : param2
+
+.
+ move :
+ move to (x pos, y pos);
+
+.
+ draw :
+ IF y steps <> 0 COR x steps < 0 COR linetype <> underline linetype
+ THEN stop
+ ELSE IF underline no <> font no THEN out ("lu ") FI;
+ out (x steps);
+ out ("ul ");
+ FI;
+
+
+. modification : param1
+.
+ on :
+ IF on string (modification) <> ""
+ THEN out (on string (modification));
+ out (" ");
+ ELSE stop
+ FI
+
+.
+ off :
+ IF off string (modification) <> ""
+ THEN out (off string (modification));
+ out (" ");
+ ELSE stop
+ FI
+
+
+. font nr : param1
+.
+ type :
+ font no := font nr;
+ out (fontstring (font nr));
+ out (" /af exch def af setfont ");
+
+END PROC execute;
+
+
+PROC move to (INT CONST x, y) :
+
+ out (x); out ("xs ");
+ out (paper length - y); out ("ys moveto ");
+
+END PROC move to;
+
+
+PROC line : out (""13""10"") END PROC line;
+
+PROC outline (TEXT CONST string) : out (string); out (""13""10"") END PROC outline;
+
+PROC out (INT CONST value) : out (text (value)); out (" ") END PROC out;
+
+PROC out (REAL CONST value) : out (text (value)); out (" ") END PROC out;
+
+
+PROC load positioning procs :
+
+ out ("/xs {"); out (72.0 / 2.54 * x step conversion (1)); out ("mul} def ");
+ out ("/ys {"); out (72.0 / 2.54 * y step conversion (1)); out ("mul} def ");
+
+END PROC load positioning procs;
+
+
+PROC load underline procs :
+
+ out ("/ul {xs ut setlinewidth 0 up rmoveto dup gsave 0 rlineto stroke grestore up neg rmoveto} def ");
+ out ("/lu {af /FontMatrix get 3 get af /FontInfo get 2 copy /up 3 1 roll /UnderlinePosition get mul 3 mul def /ut 3 1 roll /UnderlineThickness get mul def} def ");
+
+END PROC load underline procs;
+
+
+PROC load italics procs :
+
+ out ("/iton {/m matrix def m 2 12 sin 12 cos div put af m makefont setfont} def ");
+ out ("/itoff {af setfont} def ");
+
+END PROC load italics procs;
+
+
+PROC load encoding :
+
+ out ("/reencsmalldict 12 dict def ");
+ out ("/ReEncodeSmall {reencsmalldict begin ");
+ out ("/newcodesandnames exch def /newfontname exch def /basefontname exch def ");
+ out ("/basefontdict basefontname findfont def /newfont basefontdict maxlength dict def ");
+ out ("basefontdict {exch dup /FID ne {dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch newfont 3 1 roll put} ifelse} {pop pop} ifelse} forall ");
+ out ("newfont /FontName newfontname put newcodesandnames aload pop newcodesandnames length 2 idiv {newfont /Encoding get 3 1 roll put} repeat ");
+ out ("newfontname newfont definefont pop ");
+ out ("end} def ");
+ out ("/eumelencoding[10#128 /Ccedilla 10#129 /udieresis 10#128 /Ccedilla 10#129 /udieresis ");
+ out ("10#130 /eacute 10#131 /acircumflex 10#132 /adieresis 10#133 /agrave 10#134 /aring 10#135 /ccedilla 10#136 /ecircumflex 10#137 /edieresis 10#138 /egrave 10#139 /idieresis ");
+ out ("10#140 /icircumflex 10#141 /igrave 10#142 /Adieresis 10#143 /Aring 10#144 /Eacute 10#145 /ae 10#146 /AE 10#147 /ocircumflex 10#148 /odieresis 10#149 /ograve ");
+ out ("10#150 /ucircumflex 10#151 /ugrave 10#152 /ydieresis 10#153 /Odieresis 10#154 /Udieresis 10#155 /cent 10#156 /sterling 10#157 /yen 10#158 /currency 10#159 /florin ");
+ out ("10#160 /aacute 10#161 /iacute 10#162 /oacute 10#163 /uacute 10#164 /ntilde 10#165 /Ntilde 10#166 /ordfeminine 10#167 /ordmasculine 10#168 /questiondown 10#169 /quotedblleft ");
+ out ("10#170 /quotedblright 10#171 /guilsinglleft 10#172 /guilsinglright 10#173 /exclamdown 10#174 /guillemotleft 10#175 /guillemotright 10#176 /atilde 10#177 /otilde 10#178 /Oslash 10#179 /oslash ");
+ out ("10#180 /oe 10#181 /OE 10#182 /Agrave 10#183 /Atilde 10#184 /Otilde 10#185 /section 10#186 /daggerdbl 10#187 /dagger 10#188 /paragraph 10#189 /space ");
+ out ("10#190 /space 10#191 /space 10#192 /quotedblbase 10#193 /ellipsis 10#194 /perthousand 10#195 /bullet 10#196 /endash 10#197 /emdash 10#198 /space 10#199 /Aacute ");
+ out ("10#200 /Acircumflex 10#201 /Egrave 10#202 /Ecircumflex 10#203 /Edieresis 10#204 /Igrave 10#205 /Iacute 10#206 /Icircumflex 10#207 /Idieresis 10#208 /Ograve 10#209 /Oacute ");
+ out ("10#210 /Ocircumflex 10#211 /Scaron 10#212 /scaron 10#213 /Ugrave 10#214 /Adieresis 10#215 /Odieresis 10#216 /Udieresis 10#217 /adieresis 10#218 /odieresis 10#219 /udieresis ");
+ out ("10#220 /k 10#221 /hyphen 10#222 /numbersign 10#223 /space 10#224 /grave 10#225 /acute 10#226 /circumflex 10#227 /tilde 10#228 /dieresis 10#229 /ring ");
+ out ("10#230 /cedilla 10#231 /caron 10#232 /Lslash 10#233 /Oslash 10#234 /OE 10#235 /ordmasculine 10#236 /Uacute 10#237 /Ucircumflex 10#238 /Ydieresis 10#239 /germandbls ");
+ out ("10#240 /Zcaron 10#241 /zcaron 10#242 /fraction 10#243 /ae ");
+ out ("10#251 /germandbls 10#252 /section] def ");
+ out ("/Helvetica /EHelvetica eumelencoding ReEncodeSmall ");
+ out ("/Helvetica-Bold /EHelvetica-Bold eumelencoding ReEncodeSmall ");
+ out ("/Helvetica-Oblique /EHelvetica-Oblique eumelencoding ReEncodeSmall ");
+ out ("/Helvetica-BoldOblique /EHelvetica-BoldOblique eumelencoding ReEncodeSmall ");
+ out ("/Times-Roman /ETimes-Roman eumelencoding ReEncodeSmall ");
+ out ("/Times-Bold /ETimes-Bold eumelencoding ReEncodeSmall ");
+ out ("/Times-Italic /ETimes-Italic eumelencoding ReEncodeSmall ");
+ out ("/Times-BoldItalic /ETimes-BoldItalic eumelencoding ReEncodeSmall ");
+ out ("/Courier /ECourier eumelencoding ReEncodeSmall ");
+ out ("/Courier-Oblique /ECourier-Oblique eumelencoding ReEncodeSmall ");
+ out ("/Courier-BoldOblique /ECourier-BoldOblique eumelencoding ReEncodeSmall ");
+ out ("/Courier-Bold /ECourier-Bold eumelencoding ReEncodeSmall ");
+ line;
+
+END PROC load encoding;
+
+
+PROC read ps input (FILE VAR input file, INT CONST timeout, TEXT CONST ok) :
+
+ BOOL VAR was cr;
+ record := "";
+ was cr := FALSE;
+ char := incharety (timeout);
+ REP IF char = ""10"" CAND was cr
+ THEN put record;
+ was cr := FALSE;
+ ELIF char = ""13"" CAND NOT was cr
+ THEN was cr := TRUE;
+ ELSE IF was cr
+ THEN record CAT """13""";
+ was cr := FALSE;
+ FI;
+ IF char = ""4""
+ THEN IF record <> "" THEN put record FI;
+ putline (input file, "-- EOF --");
+ line (input file);
+ ELIF char >= " "
+ THEN record CAT char
+ ELIF char >= ""0""
+ THEN record CAT """";
+ record CAT text (code (char));
+ record CAT """";
+ ELSE IF record <> "" THEN put record FI;
+ LEAVE read ps input;
+ FI;
+ FI;
+ IF pos (ok, char) > 0
+ THEN IF record <> "" THEN put record FI;
+ LEAVE read ps input;
+ FI;
+ cat input (record, char);
+ IF char = "" THEN char := incharety (min (5, time out)) FI;
+ PER;
+
+ . put record :
+ putline (input file, record);
+ IF NOT is error CAND pos (record, "%%[ Error:") > 0
+ THEN errorstop (ps error, record) FI;
+ record := "";
+
+END PROC read ps input;
+
+
+PROC print error (TEXT CONST error message, INT CONST error line) :
+
+ REAL CONST pl := y size * 72.0 / 2.54,
+ ys := 56.69291,
+ xs := 51.02362,
+ h := 12.0;
+ REAL VAR x := xs, y := ys + h;
+ outline ("/Courier findfont 10 scalefont setfont");
+ move to x and y;
+ out ("(FEHLER : ");
+ out (error message);
+ IF error line > 0
+ THEN out (" in Zeile ");
+ out (error line);
+ FI;
+ outline (") show");
+ IF exists (ps input name)
+ THEN ps input := sequential file (input, ps input name);
+ y INCR 3.0 * h;
+ move to x and y;
+ outline ("(PostScript - Input :) show");
+ y INCR h;
+ WHILE NOT eof (ps input)
+ REP getline (ps input, record);
+ y INCR h;
+ move to x and y;
+ out ("(");
+ out (record);
+ outline (") show");
+ PER;
+ output (ps input);
+ FI;
+ outline ("showpage");
+ out (""4"");
+ read ps input (ps input, 18000, ""4"");
+
+ . move to x and y :
+ out (x); out (pl - y); out ("moveto ");
+
+END PROC print error;
+
+
+END PACKET apple laser writer printer;
+
+
+PACKET apple laserwriter box commands
+
+(**************************************************************************)
+(* *)
+(* Kommandos zum Zeichen von Boxen, Linien und Schraffuren *)
+(* für den Apple LaserWriter *)
+(* *)
+(* Autor : Rudolf Ruland *)
+(* Stand : 24.02.88 *)
+(**************************************************************************)
+
+ DEFINES line,
+ x line,
+ y line,
+
+ box,
+ box frame,
+ box shade,
+
+ cake,
+ cake frame,
+ cake shade,
+ :
+
+INT VAR x, y, h, w;
+
+WHILE highest entry (box commands) > 0
+ REP delete box command (name (box commands, highest entry (box commands))) PER;
+insert box command ("line");
+insert box command ("xline");
+insert box command ("yline");
+insert box command ("box");
+insert box command ("boxshade");
+insert box command ("boxframe");
+insert box command ("cake");
+insert box command ("cakeshade");
+insert box command ("cakeframe");
+
+
+PROC line (REAL CONST x offset, y offset, width, height, line width) :
+
+ IF line width > 0.0
+ THEN graph on (x offset, y offset, width, height);
+ out (text (line width / 300.0 * 72.0));
+ out (" setlinewidth ");
+ out (text (w));
+ out (" xs ");
+ out (text (-h));
+ out (" ys rlineto stroke ");
+ graph off;
+ FI;
+
+END PROC line;
+
+PROC x line (REAL CONST x offset, y offset, width, line width) :
+
+ line (x offset, y offset, width, 0.0, line width);
+
+END PROC x line;
+
+PROC y line (REAL CONST x offset, y offset, height, line width) :
+
+ line (x offset, y offset, 0.0, height, line width);
+
+END PROC y line;
+
+
+PROC box (REAL CONST x offset, y offset, width, height, line width, pattern):
+
+ box shade (x offset, y offset, width, height, pattern);
+ box frame (x offset, y offset, width, height, line width);
+
+END PROC box;
+
+
+PROC box shade (REAL CONST x offset, y offset, width, height, pattern) :
+
+ graph on (x offset, y offset, width, height);
+ box path;
+ out (text (pattern));
+ out (" setgray fill ");
+ graph off;
+
+END PROC box shade;
+
+
+PROC box frame (REAL CONST x offset, y offset, width, height, line width) :
+
+ IF line width <> 0.0
+ THEN graph on (x offset, y offset, width, height);
+ box path;
+ out (text (line width / 300.0 * 72.0));
+ out (" setlinewidth stroke ");
+ graph off;
+ FI;
+
+END PROC box frame;
+
+
+PROC box path :
+
+ out (text (w));
+ out (" xs 0 rlineto 0 ");
+ out (text (-h));
+ out (" ys rlineto ");
+ out (text (-w));
+ out (" xs 0 rlineto closepath ");
+
+END PROC box path;
+
+
+
+PROC cake (REAL CONST x offset, y offset, radius, start angle, sweep angle, line width, pattern) :
+
+ cake shade (x offset, y offset, radius, start angle, sweep angle, pattern);
+ cake frame (x offset, y offset, radius, start angle, sweep angle, line width);
+
+END PROC cake;
+
+
+PROC cake shade (REAL CONST x offset, y offset, radius, start angle, sweep angle, pattern) :
+
+ graph on (x offset, y offset, radius, 0.0);
+ cake path (start angle, sweep angle);
+ out (text (pattern));
+ out (" setgray fill ");
+ graph off;
+
+END PROC cake shade;
+
+
+PROC cake frame (REAL CONST x offset, y offset, radius, start angle, sweep angle, line width) :
+
+
+ IF line width <> 0.0
+ THEN graph on (x offset, y offset, radius, 0.0);
+ cake path (start angle, sweep angle);
+ out (text (line width / 300.0 * 72.0));
+ out (" setlinewidth stroke ");
+ graph off;
+ FI;
+
+END PROC cake frame;
+
+
+PROC cake path (REAL CONST start angle, sweep angle) :
+
+ out (text (start angle));
+ out (" rotate ");
+ out ("currentpoint ");
+ out (text (w));
+ out (" xs 0 ");
+ out (text (sweep angle));
+ out (" ");
+ IF sweep angle < 360.0
+ THEN out ("2 setlinejoin arc closepath ");
+ ELSE out (text (w));
+ out (" xs 0 rmoveto arc ");
+ FI;
+
+END PROC cake path;
+
+
+PROC graph on (REAL CONST x offset, y offset, width, height) :
+
+ x := x step conversion (x offset);
+ y := y step conversion (y offset);
+ w := x step conversion (width);
+ h := y step conversion (height);
+ out ("gsave ");
+ out (text (x));
+ out (" xs ");
+ out (text (-y));
+ out (" ys rmoveto ");
+
+END PROC graph on;
+
+PROC graph off :
+
+ out ("grestore ");
+
+END PROC graph off;
+
+
+END PACKET apple laserwriter box commands;
+
+
+
+#page#
+(******************************************************************)
+(*** ***)
+(*** Generierung des Printers ***)
+(*** ***)
+(******************************************************************)
+(*
+LET up = ""3""13""5"";
+*)
+LET printer name = "printer.apple.laserwriter";
+TEXT VAR fonttab name := "fonttab.apple.laserwriter";
+
+BOOL CONST multi user := (pcb (9) AND 255) <> 1;
+
+INT VAR pr channel;
+TEXT VAR buffer;
+
+command dialogue (TRUE);
+IF NOT multi user
+ THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL")
+FI;
+ask for print channel;
+load font table;
+forget (printer name, quiet);
+IF multi user THEN generate printer spool FI;
+command dialogue (TRUE);
+check on;
+.
+ ask for print channel :
+ line;
+ put ("gib Druckerkanal:");
+ get (pr channel);
+ do ("serverchannel(" + text (pr channel) + ")" ) ;
+ line;
+.
+ load font table :
+ IF NOT exists (fonttab name)
+ THEN REP line (2);
+ putline ("Bitte Archiv mit der Fonttabelle """ +
+ fonttab name + """ einlegen!");
+ line;
+ UNTIL yes ("Archiv eingelegt") PER;
+ reserve archive;
+ fetch (fonttab name, archive);
+ release (archive);
+ FI;
+ font table (fonttab name);
+ IF multi user
+ THEN command dialogue (FALSE);
+ do ("save(""" + font tab name + """,task(""configurator""))")
+ FI;
+ forget (fonttab name, quiet);
+
+ . reserve archive :
+ INT VAR p1, p2;
+ archive (" "31" ");
+ disable stop;
+ list (archive);
+ IF is error
+ THEN buffer := errormessage;
+ p1 := pos (buffer, """", 1 ) + 1;
+ p2 := pos (buffer, """", p1) - 1;
+ IF p1 > 0 AND p2 > 0
+ THEN clear error;
+ buffer := subtext (buffer, p1, p2);
+ archive (buffer);
+ FI;
+ FI;
+ enable stop;
+
+. generate printer spool :
+ eumel must advertise;
+ cursor (1, 12);
+ putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");
+ putline ("die Fonttabelle mit dem Kommando");
+ line;
+ putline (" font table (""" + font tab name + """)");
+ line;
+ putline ("eingestellt werden!!!");
+ line (4);
+ putline ("Generierung beendet, weiter mit 'SV'");
+ generate printer server;
+ do (buffer);
+
+. generate printer server :
+ buffer := "break (quiet);";
+ buffer CAT "spool manager (PROC printer);";
+ buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;";
+ buffer CAT "PROC printer:";
+ buffer CAT " disable stop;";
+ buffer CAT " continue (server channel);";
+ buffer CAT " check error (error message);";
+ buffer CAT " ds := nilspace;";
+ buffer CAT " REP forget (ds);";
+ buffer CAT " execute print;";
+ buffer CAT " IF is error AND online THEN clear error; print error (error message, 0); clear error FI;";
+ buffer CAT " PER;";
+ buffer CAT "END PROC printer;";
+ buffer CAT "PROC execute print:";
+ buffer CAT " LET ack = 0, fetch code = 11, file type = 1003;";
+ buffer CAT " enable stop;";
+ buffer CAT " ds := nilspace;";
+ buffer CAT " call (father, fetch code, ds, reply);";
+ buffer CAT " IF reply = ack CAND type (ds) = file type";
+ buffer CAT " THEN file := sequential file (input, ds);";
+ buffer CAT " print (file,";
+ buffer CAT " PROC (INT CONST, INT VAR, INT VAR) open,";
+ buffer CAT " PROC (INT CONST, INT CONST) close,";
+ buffer CAT " PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);";
+ buffer CAT " FI;";
+ buffer CAT "END PROC execute print;";
+ buffer CAT "PROC check error(TEXT CONST message):";
+ buffer CAT " IF is error";
+ buffer CAT " THEN clear error; rename myself (message);";
+ buffer CAT " IF is error THEN end(myself) FI;";
+ buffer CAT " pause (9000); end(myself);";
+ buffer CAT " FI;";
+ buffer CAT "END PROC check error;";
+
diff --git a/system/printer-laser/4/src/printer.canon.lbp-8 b/system/printer-laser/4/src/printer.canon.lbp-8
new file mode 100644
index 0000000..4dfe9f8
--- /dev/null
+++ b/system/printer-laser/4/src/printer.canon.lbp-8
@@ -0,0 +1,327 @@
+PACKET canon lbp 8 printer
+
+(*************************************************************************)
+(* Stand : 29.07.86 *)
+(* CANON LBP-8 A1/A2 Version : 4 *)
+(* Autor : Rudolf Ruland *)
+(*************************************************************************)
+
+
+ DEFINES open,
+ close,
+ execute,
+
+ paper size :
+
+LET underline = 1,
+(* bold = 2,
+ italics = 4,
+ reverse = 8,
+
+ underline linetype = 1, *)
+
+ csi = ""155"",
+
+ c document = 1,
+ c page = 2,
+
+ c write text = 1,
+ c write cmd = 2,
+ c carriage return = 3,
+ c move = 4,
+ c draw = 5,
+ c on = 6,
+ c off = 7,
+ c type = 8;
+
+REAL VAR x size, y size;
+BOOL VAR is underline;
+
+(*********************************************************************)
+
+paper size (21.0, 29.7);
+
+PROC paper size (REAL CONST x, y) :
+
+ x size := x;
+ y size := y;
+
+END PROC paper size;
+
+PROC paper size :
+
+ line;
+ putline ("Papierbreite = " + text (x size, 5, 2) + " cm = " + text (x size / 2.54, 5, 2) + " Zoll");
+ putline ("Papierlaenge = " + text (y size, 5, 2) + " cm = " + text (y size / 2.54, 5, 2) + " Zoll");
+
+END PROC paper size;
+
+(*********************************************************************)
+
+PROC open (INT CONST op code, INT VAR param1, param2) :
+
+SELECT op code OF
+ CASE c document : open document
+ CASE c page : open page
+END SELECT;
+
+
+. x steps : param1
+. y steps : param2
+.
+ open document :
+ is underline := FALSE;
+ x steps := x step conversion ( x size - 0.8043333 );
+ y steps := y step conversion ( y size - 0.508);
+ out (""27":"27"P"13""); (* Enable - Prop.Type *)
+ out (""27";"27"<"155"11h"); (* Reset des Druckers *)
+ out (""27"(B"); (* ACSII-Zeichensatz *)
+ out (""155"1;4 D"); (* Char.Satz 1 = PICA *)
+
+. x start : param1
+. y start : param2
+.
+ open page :
+ x start := x step conversion (0.4064 );
+ y start := y step conversion (0.508 + 0.6345);
+ out (""13"");
+
+END PROC open;
+
+
+PROC close (INT CONST op code, INT CONST param1) :
+
+SELECT op code OF
+ CASE c document : close document
+ CASE c page : close page
+ OTHERWISE : put (param1)
+END SELECT;
+
+.
+ close document :
+ (* out(""155"0q") von Standard-Cassette Papier holen *)
+
+(*. remaining y steps : param1*)
+.
+ close page :
+ out (""13""12"");
+
+END PROC close;
+
+
+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :
+
+SELECT op code OF
+ CASE c write text : write text
+ CASE c write cmd : write cmd
+ CASE c carriage return : carriage return
+ CASE c move : move
+ CASE c draw : draw
+ CASE c on : on
+ CASE c off : off
+ CASE c type : type
+END SELECT
+
+
+. from : param1
+. to : param2
+.
+ write text :
+ INT VAR new from, new to;
+ IF is underline
+ THEN IF pos (string, " ", from, from) <> 0
+ THEN out ("_");
+ new from := from + 1;
+ ELSE new from := from;
+ FI;
+ IF from < to AND pos (string, " ", to, to) <> 0
+ THEN new to := to - 1;
+ ELSE new to := to;
+ FI;
+ out subtext (string, new from, new to);
+ IF to <> new to THEN out ("_") FI;
+ ELSE out subtext (string, from, to)
+ FI;
+
+.
+ write cmd :
+ out subtext (string, from, to)
+
+
+(*. x steps to left margin : param1*)
+.
+ carriage return :
+ out (""13"")
+
+
+. x steps : param1
+. y steps : param2
+.
+ move :
+ IF x steps > 0
+ THEN out (csi); out (text ( x steps)); out ("a")
+ ELIF x steps < 0
+ THEN out (csi); out (text (- x steps)); out ("j")
+ FI;
+ IF y steps > 0
+ THEN out (csi); out (text ( y steps)); out ("e")
+ ELIF y steps < 0
+ THEN out (csi); out (text (- y steps)); out ("k")
+ FI;
+
+.
+ draw :
+ stop
+
+
+. modification : param1
+.
+ on :
+ IF on string (modification) <> ""
+ THEN out (on string (modification));
+ IF modification = underline THEN is underline := TRUE FI;
+ ELSE stop
+ FI
+
+.
+ off :
+ IF off string (modification) <> ""
+ THEN out (off string (modification));
+ IF modification = underline THEN is underline := FALSE FI;
+ ELSE stop
+ FI
+
+
+. font nr : param1
+.
+ type :
+ out (font string (font nr));
+
+END PROC execute;
+
+
+END PACKET canon lbp 8 printer;
+
+
+
+#page#
+(******************************************************************)
+(*** ***)
+(*** Generierung des Printers ***)
+(*** ***)
+(******************************************************************)
+
+LET printer name = "printer.canon.lbp-8";
+
+TEXT VAR fonttab name := "fonttab.canon.lbp-8";
+
+BOOL CONST multi user := (pcb (9) AND 255) <> 1;
+
+INT VAR pr channel;
+TEXT VAR buffer;
+
+command dialogue (TRUE);
+IF NOT multi user
+ THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL")
+FI;
+ask for print channel;
+ask for font cartridge;
+load font table;
+forget (printer name, quiet);
+IF multi user THEN generate printer spool FI;
+check on;
+.
+ ask for print channel :
+ line;
+ put ("gib Druckerkanal:");
+ get (pr channel);
+ do ("serverchannel(" + text (pr channel) + ")" ) ;
+ line;
+.
+ ask for font cartridge :
+.
+ load font table :
+ IF NOT exists (fonttab name)
+ THEN command dialogue (TRUE);
+ REP line (2);
+ putline ("Bitte Archiv mit der Fonttabelle """ +
+ fonttab name + """ einlegen!");
+ line;
+ UNTIL yes ("Archiv eingelegt") PER;
+ reserve archive;
+ fetch (fonttab name, archive);
+ release (archive);
+ FI;
+ font table (fonttab name);
+ IF multi user
+ THEN command dialogue (FALSE);
+ do ("save(""" + font tab name + """,task(""configurator""))")
+ FI;
+ forget (fonttab name, quiet);
+
+ . reserve archive :
+ INT VAR p1, p2;
+ archive (" "31" ");
+ disable stop;
+ list (archive);
+ IF is error
+ THEN buffer := errormessage;
+ p1 := pos (buffer, """", 1 ) + 1;
+ p2 := pos (buffer, """", p1) - 1;
+ IF p1 > 0 AND p2 > 0
+ THEN clear error;
+ buffer := subtext (buffer, p1, p2);
+ archive (buffer);
+ FI;
+ FI;
+ enable stop;
+
+. generate printer spool :
+ eumel must advertise;
+ cursor (1, 12);
+ putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");
+ putline ("die Fonttabelle mit dem Kommando");
+ line;
+ putline (" font table (""" + font tab name + """)");
+ line;
+ putline ("eingestellt werden!!!");
+ line (4);
+ putline ("Generierung beendet, weiter mit 'SV'");
+ generate printer server;
+ do (buffer);
+
+. generate printer server :
+ buffer := "break (quiet);";
+ buffer CAT "spool manager (PROC printer);";
+ buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;";
+ buffer CAT "PROC printer:";
+ buffer CAT " disable stop;";
+ buffer CAT " continue (server channel);";
+ buffer CAT " check error (error message);";
+ buffer CAT " ds := nilspace;";
+ buffer CAT " REP forget (ds);";
+ buffer CAT " execute print;";
+ buffer CAT " IF is error AND online THEN put error; clear error; FI;";
+ buffer CAT " PER;";
+ buffer CAT "END PROC printer;";
+ buffer CAT "PROC execute print:";
+ buffer CAT " LET ack = 0, fetch code = 11, file type = 1003;";
+ buffer CAT " enable stop;";
+ buffer CAT " ds := nilspace;";
+ buffer CAT " call (father, fetch code, ds, reply);";
+ buffer CAT " IF reply = ack CAND type (ds) = file type";
+ buffer CAT " THEN file := sequential file (input, ds);";
+ buffer CAT " print (file,";
+ buffer CAT " PROC (INT CONST, INT VAR, INT VAR) open,";
+ buffer CAT " PROC (INT CONST, INT CONST) close,";
+ buffer CAT " PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);";
+ buffer CAT " FI;";
+ buffer CAT "END PROC execute print;";
+ buffer CAT "PROC check error(TEXT CONST message):";
+ buffer CAT " IF is error";
+ buffer CAT " THEN clear error; rename myself (message);";
+ buffer CAT " IF is error THEN end(myself) FI;";
+ buffer CAT " pause (9000); end(myself);";
+ buffer CAT " FI;";
+ buffer CAT "END PROC check error;";
+
diff --git a/system/printer-laser/4/src/printer.epson.sq b/system/printer-laser/4/src/printer.epson.sq
new file mode 100644
index 0000000..63e474f
--- /dev/null
+++ b/system/printer-laser/4/src/printer.epson.sq
@@ -0,0 +1,585 @@
+PACKET epson sq printer
+
+(**************************************************************************)
+(* Stand : 03.12.86 *)
+(* EPSON SQ-2500 Version : 4 *)
+(* Autor : Rudolf Ruland *)
+(**************************************************************************)
+
+ DEFINES open,
+ close,
+ execute,
+
+ paper size,
+ (* paper feed, *) (* <-- nicht getestet *)
+ std typeface,
+ std quality:
+
+LET
+(* underline = 1,
+ bold = 2,
+ italics = 4,
+ reverse = 8, *)
+
+ underline linetype = 1,
+
+ c document = 1,
+ c page = 2,
+
+ c write text = 1, cmd draft = 1,
+ c write cmd = 2, cmd nlq = 2,
+ c carriage return = 3, cmd roman = 3,
+ c move = 4, cmd sansserif = 4,
+ c draw = 5, cmd courier = 5,
+ c on = 6, cmd prestige = 6,
+ c off = 7, cmd script = 7,
+ c type = 8;
+
+INT VAR font nr, x rest, high, low, font bits, modification bits, blank pitch,
+ factor 1, factor 2, steps;
+BOOL VAR is nlq, sheet feed;
+REAL VAR x size, y size;
+TEXT VAR std quality name, std typeface name, buffer, symbol, font text;
+THESAURUS VAR commands := empty thesaurus;
+
+insert (commands, "draft");
+insert (commands, "nlq");
+insert (commands, "roman");
+insert (commands, "sansserif");
+insert (commands, "courier");
+insert (commands, "prestige");
+insert (commands, "script");
+
+. is prop : bit (font bits, 1)
+. is double : bit (font bits, 5)
+.;
+
+(*********************************************************************)
+
+paper size (13.6 * 2.54, 12.0 * 2.54);
+paper size ( 8.0 * 2.54, 12.0 * 2.54);
+paper feed ("tractor");
+std typeface ("roman");
+std quality ("draft");
+
+PROC paper size (REAL CONST x, y) :
+
+ x size := x;
+ y size := y;
+
+END PROC paper size;
+
+PROC paper size :
+
+ line;
+ putline ("Papierbreite = " + text (x size, 5, 2) + " cm = " + text (x size / 2.54, 5, 2) + " Zoll");
+ putline ("Papierlaenge = " + text (y size, 5, 2) + " cm = " + text (y size / 2.54, 5, 2) + " Zoll");
+
+END PROC paper size;
+
+
+PROC paper feed (TEXT CONST paper) :
+
+ IF pos (paper, "sheet") <> 0
+ THEN sheet feed := TRUE;
+ ELIF pos (paper, "tractor") <> 0
+ THEN sheet feed := FALSE;
+ ELSE errorstop ("unzulaessige Papiereinfuehrung")
+ FI;
+
+END PROC paper feed;
+
+TEXT PROC paper feed :
+
+ IF sheet feed
+ THEN "sheet"
+ ELSE "tractor"
+ FI
+
+END PROC paper feed;
+
+
+PROC std typeface (TEXT CONST typeface) :
+
+ buffer := typeface;
+ changeall (buffer, " ", "");
+ IF link (commands, buffer) >= cmd roman
+ THEN std typeface name := buffer
+ ELSE errorstop ("unzulaessige Schriftart")
+ FI;
+
+END PROC std typeface;
+
+TEXT PROC std typeface : std typeface name END PROC std typeface;
+
+
+PROC std quality (TEXT CONST quality) :
+
+ IF quality = "nlq" OR quality = "draft"
+ THEN std quality name := quality;
+ ELSE errorstop ("unzulaessige Betriebsart")
+ FI;
+
+END PROC std quality;
+
+TEXT PROC std quality : std quality name END PROC std quality;
+
+(*********************************************************************)
+
+PROC open (INT CONST op code, INT VAR param1, param2) :
+
+SELECT op code OF
+ CASE c document : open document
+ CASE c page : open page
+END SELECT;
+
+
+. x steps : param1
+. y steps : param2
+.
+ open document :
+ x steps := x step conversion ( x size );
+ y steps := y step conversion ( y size );
+ y steps := (y steps DIV 30) * 30;
+ modification bits := 0;
+ out (""24""27""64""); (* Reset des Druckers *)
+ out (""27"C" + code (y steps DIV 30)); (* Formularlaenge *)
+ out (""27"x"0""); (* Entwurfsqualität *)
+ out (""27"R"0""); (* Amerikanischer Zeichensatz *)
+ out (""27"t"1""27"6"); (* Erweiterung des Zeichensatzes *)
+ IF sheet feed THEN out (""27""25"4") FI; (* Sheetmode ein *)
+ IF pos (material, "roman") <> 0
+ THEN out (""27"k"0"")
+ ELIF pos (material, "sansserif") <> 0
+ THEN out (""27"k"1"")
+ ELIF pos (material, "courier") <> 0
+ THEN out (""27"k"2"")
+ ELIF pos (material, "prestige") <> 0
+ THEN out (""27"k"3"")
+ ELIF pos (material, "script") <> 0
+ THEN out (""27"k"4"")
+ ELSE out (""27"k" + code (link (commands, std typeface) - cmd roman));
+ FI;
+ IF pos (material, "nlq") <> 0
+ THEN is nlq := TRUE;
+ ELIF pos (material, "draft") <> 0
+ THEN is nlq := FALSE;
+ ELSE is nlq := std quality = "nlq"
+ FI;
+
+
+. x start : param1
+. y start : param2
+.
+ open page :
+ x start := 0;
+ IF sheet feed
+ THEN y start := y step conversion (8.466667e-1) (* 2/6 Inch *)
+ ELSE y start := 0;
+ FI;
+ x rest := 0;
+ out (""13"");
+
+END PROC open;
+
+
+PROC close (INT CONST op code, INT CONST param1) :
+
+SELECT op code OF
+ CASE c document : close document
+ CASE c page : close page
+END SELECT;
+
+.
+ close document :
+
+
+. remaining y steps : param1
+.
+ close page :
+ IF sheet feed
+ THEN out (""27""25"R")
+ ELIF remaining y steps > 0
+ THEN out (""12"")
+ FI;
+
+END PROC close;
+
+
+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :
+
+SELECT op code OF
+ CASE c write text : write text
+ CASE c write cmd : write cmd
+ CASE c carriage return : carriage return
+ CASE c move : move
+ CASE c draw : draw
+ CASE c on : on
+ CASE c off : off
+ CASE c type : type
+END SELECT
+
+
+. from : param1
+. to : param2
+.
+ write text :
+ out subtext (string, from, to)
+
+.
+ write cmd :
+ buffer := subtext (string, from, to);
+ scan (buffer);
+ next symbol (symbol);
+ SELECT link (commands, symbol) OF
+ CASE cmd draft : IF is nlq THEN switch to draft FI; is nlq := FALSE;
+ CASE cmd nlq : IF NOT is nlq THEN switch to nlq FI; is nlq := TRUE;
+ CASE cmd roman : out (""27"k"0"")
+ CASE cmd sansserif : out (""27"k"1"")
+ CASE cmd courier : out (""27"k"2"")
+ CASE cmd prestige : out (""27"k"3"")
+ CASE cmd script : out (""27"k"4"")
+ OTHERWISE : out (buffer);
+ END SELECT;
+
+
+(*. x steps to left margin : param1*)
+.
+ carriage return :
+ x rest := 0;
+ out (""13"");
+
+
+. x steps : param1
+. y steps : param2
+.
+ move :
+ IF x steps < 0 OR y steps < 0
+ THEN stop
+ ELSE IF x steps > 0 THEN x move FI;
+ IF y steps > 0 THEN y move FI;
+ FI;
+
+ . x move :
+ x rest INCR x steps;
+ IF not is underline
+ THEN simple x move
+ ELSE underline x move
+ FI;
+
+ . not is underline :
+ NOT bit (modification bits, 7)
+
+ . simple x move :
+ high := x rest DIV factor 1;
+ x rest := x rest MOD factor 1;
+ out (""27"\");
+ out (code (high MOD 256));
+ out (code (high DIV 256));
+
+ . underline x move :
+ high := x rest DIV factor 2;
+ x rest := x rest MOD factor 2;
+ IF high < blank pitch
+ THEN stop
+ ELSE low := high MOD 127;
+ high := high DIV 127;
+ IF low >= blank pitch
+ THEN low DECR blankpitch;
+ ELSE high DECR 1;
+ low DECR (blankpitch - 127);
+ FI;
+ IF high > 0
+ THEN out (""27" ");
+ out (code (127 - blankpitch));
+ high TIMESOUT " ";
+ FI;
+ out (""27" ");
+ out (code (low));
+ out (" "27" "0"");
+ FI;
+
+ . y move :
+ low := y steps MOD 255;
+ high := y steps DIV 255;
+ IF high > 0 THEN high TIMESOUT (""27"J"255"") FI;
+ IF low > 0 THEN out (""27"J"); out (code (low)) FI;
+.
+ draw :
+ IF x steps < 0 OR y steps <> 0 OR linetype <> underline linetype
+ THEN stop
+ ELIF x steps > 0
+ THEN x draw
+ FI;
+
+ . x draw :
+ x rest INCR x steps;
+ steps := x rest DIV 6;
+ x rest := x rest MOD 6;
+ IF steps > 0
+ THEN low := steps MOD 256;
+ high := steps DIV 256;
+ out (""27"L");
+ out (code (low));
+ out (code (high));
+ steps TIMESOUT ""1"";
+ FI;
+
+
+. modification : param1
+.
+ on :
+ buffer := on string (modification);
+ IF buffer <> ""
+ THEN modification bits := modification bits OR code (buffer);
+ switch to font;
+ ELSE stop
+ FI
+
+.
+ off :
+ buffer := off string (modification);
+ IF buffer <> ""
+ THEN modification bits := modification bits XOR code (buffer);
+ switch to font;
+ ELSE stop
+ FI
+
+.
+ type :
+ font nr := param1;
+ buffer := font string (font nr);
+ font bits := code (buffer SUB 1);
+ font text := subtext (buffer, 2);
+ IF is prop
+ THEN factor 1 := 4;
+ factor 2 := 4;
+ ELSE factor 1 := 6;
+ factor 2 := 6;
+ FI;
+ IF is double THEN factor 2 INCR factor 2 FI;
+ blank pitch := char pitch (font nr, " ") DIV factor 2;
+ switch to font;
+ IF is nlq THEN switch to nlq FI;
+
+END PROC execute;
+
+
+PROC switch to font :
+
+ out (""27"!");
+ out (code (font bits OR modification bits));
+ out (font text);
+
+END PROC switch to font;
+
+
+PROC switch to nlq :
+
+ IF NOT is prop
+ THEN factor 1 := 4;
+ factor 2 := (4 * factor 2) DIV 6;
+ blankpitch := (6 * blankpitch) DIV 4;
+ out (""27"x"1"");
+ ELSE out (""27"x"0"");
+ FI;
+
+END PROC switch to nlq;
+
+
+PROC switch to draft :
+
+ IF NOT is prop
+ THEN factor 1 := 6;
+ factor 2 := (6 * factor 2) DIV 4;
+ blankpitch := (4 * blankpitch) DIV 6;
+ out (""27"x"0"");
+ FI;
+
+END PROC switch to draft;
+
+
+END PACKET epson sq printer;
+
+
+
+#page#
+(******************************************************************)
+(*** ***)
+(*** Generierung des Printers ***)
+(*** ***)
+(******************************************************************)
+
+LET printer name = "printer.epson.sq",
+ up = ""3""13""5"";
+
+TEXT VAR fonttab name := "fonttab.epson.sq";
+
+BOOL CONST multi user := (pcb (9) AND 255) <> 1;
+
+INT VAR pr channel;
+TEXT VAR buffer;
+
+command dialogue (TRUE);
+IF NOT multi user
+ THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL")
+FI;
+ask for print channel;
+ask for paper format;
+ask for typeface;
+ask for print quality;
+load font table;
+forget (printer name, quiet);
+IF multi user THEN generate printer spool FI;
+check on;
+.
+ ask for print channel :
+ line;
+ put ("gib Druckerkanal:");
+ get (pr channel);
+ do ("serverchannel(" + text (pr channel) + ")" ) ;
+ line;
+.
+ ask for paper format :
+ SELECT paper format OF
+ CASE 1 : papersize ( 8.0 * 2.54, 12.0 * 2.54)
+ CASE 2 : papersize (13.6 * 2.54, 12.0 * 2.54)
+ CASE 3 : papersize (21.0, 29.7)
+ END SELECT
+
+ . paper format :
+ line;
+ REP out (up);
+ IF yes ("Papierformat : endlos, 8 Zoll breit")
+ THEN LEAVE paper format WITH 1 FI;
+ out (up);
+ IF yes ("Papierformat : endlos, 13.6 Zoll breit")
+ THEN LEAVE paper format WITH 2 FI;
+ out (up);
+ IF yes ("Papierformat : DINA 4")
+ THEN LEAVE paper format WITH 3 FI;
+ PER;
+ 0
+.
+ ask for typeface :
+ line;
+ std typeface (typeface)
+
+ . typeface :
+ REP out (up);
+ IF yes ("standardmäßige Schriftart : roman")
+ THEN LEAVE typeface WITH "roman" FI;
+ out (up);
+ IF yes ("standardmäßige Schriftart : sansserif")
+ THEN LEAVE typeface WITH "sansserif" FI;
+ out (up);
+ IF yes ("standardmäßige Schriftart : courier")
+ THEN LEAVE typeface WITH "courier" FI;
+ out (up);
+ IF yes ("standardmäßige Schriftart : prestige")
+ THEN LEAVE typeface WITH "prestige" FI;
+ out (up);
+ IF yes ("standardmäßige Schriftart : script")
+ THEN LEAVE typeface WITH "script" FI;
+ PER;
+ ""
+.
+ ask for print quality :
+ line;
+ std quality (quality);
+
+ . quality :
+ REP out (up);
+ IF yes ("standardmäßige Druckqualität : draft quality")
+ THEN LEAVE quality WITH "draft" FI;
+ out (up);
+ IF yes ("standardmäßige Druckqualität : near letter quality")
+ THEN LEAVE quality WITH "nlq" FI;
+ PER;
+ ""
+.
+ load font table :
+ IF NOT exists (fonttab name)
+ THEN command dialogue (TRUE);
+ REP line (2);
+ putline ("Bitte Archiv mit der Fonttabelle """ +
+ fonttab name + """ einlegen!");
+ line;
+ UNTIL yes ("Archiv eingelegt") PER;
+ reserve archive;
+ fetch (fonttab name, archive);
+ release (archive);
+ FI;
+ font table (fonttab name);
+ IF multi user
+ THEN command dialogue (FALSE);
+ do ("save(""" + font tab name + """,task(""configurator""))")
+ FI;
+ forget (fonttab name, quiet);
+
+ . reserve archive :
+ INT VAR p1, p2;
+ archive (" "31" ");
+ disable stop;
+ list (archive);
+ IF is error
+ THEN buffer := errormessage;
+ p1 := pos (buffer, """", 1 ) + 1;
+ p2 := pos (buffer, """", p1) - 1;
+ IF p1 > 0 AND p2 > 0
+ THEN clear error;
+ buffer := subtext (buffer, p1, p2);
+ archive (buffer);
+ FI;
+ FI;
+ enable stop;
+
+. generate printer spool :
+ eumel must advertise;
+ cursor (1, 12);
+ putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");
+ putline ("die Fonttabelle mit dem Kommando");
+ line;
+ putline (" font table (""" + font tab name + """)");
+ line;
+ putline ("eingestellt werden!!!");
+ line (4);
+ putline ("Generierung beendet, weiter mit 'SV'");
+ generate printer server;
+ do (buffer);
+
+. generate printer server :
+ buffer := "break (quiet);";
+ buffer CAT "spool manager (PROC printer);";
+ buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;";
+ buffer CAT "PROC printer:";
+ buffer CAT " disable stop;";
+ buffer CAT " continue (server channel);";
+ buffer CAT " check error (error message);";
+ buffer CAT " ds := nilspace;";
+ buffer CAT " REP forget (ds);";
+ buffer CAT " execute print;";
+ buffer CAT " IF is error AND online THEN put error; clear error; FI;";
+ buffer CAT " PER;";
+ buffer CAT "END PROC printer;";
+ buffer CAT "PROC execute print:";
+ buffer CAT " LET ack = 0, fetch code = 11, file type = 1003;";
+ buffer CAT " enable stop;";
+ buffer CAT " ds := nilspace;";
+ buffer CAT " call (father, fetch code, ds, reply);";
+ buffer CAT " IF reply = ack CAND type (ds) = file type";
+ buffer CAT " THEN file := sequential file (input, ds);";
+ buffer CAT " print (file,";
+ buffer CAT " PROC (INT CONST, INT VAR, INT VAR) open,";
+ buffer CAT " PROC (INT CONST, INT CONST) close,";
+ buffer CAT " PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);";
+ buffer CAT " FI;";
+ buffer CAT "END PROC execute print;";
+ buffer CAT "PROC check error(TEXT CONST message):";
+ buffer CAT " IF is error";
+ buffer CAT " THEN clear error; rename myself (message);";
+ buffer CAT " IF is error THEN end(myself) FI;";
+ buffer CAT " pause (9000); end(myself);";
+ buffer CAT " FI;";
+ buffer CAT "END PROC check error;";
+
diff --git a/system/printer-laser/4/src/printer.hp.laserjet b/system/printer-laser/4/src/printer.hp.laserjet
new file mode 100644
index 0000000..152ee8e
--- /dev/null
+++ b/system/printer-laser/4/src/printer.hp.laserjet
@@ -0,0 +1,417 @@
+PACKET hp laserjet printer
+
+(**************************************************************************)
+(* Stand : 03.02.88 *)
+(* HP 2686A LaserJet / LaserJet+ Verison : 4 *)
+(* Autor : Rudolf Ruland *)
+(**************************************************************************)
+
+ DEFINES open,
+ close,
+ execute,
+
+ paper size,
+ printer type :
+
+LET
+(* underline = 1,
+ bold = 2,
+ italics = 4,
+ reverse = 8,
+
+ underline linetype = 1, *)
+
+ c document = 1,
+ c page = 2,
+
+ c write text = 1,
+ c write cmd = 2,
+ c carriage return = 3,
+ c move = 4,
+ c draw = 5,
+ c on = 6,
+ c off = 7,
+ c type = 8;
+
+INT VAR abs x pos
+REAL VAR x size, y size;
+BOOL VAR is laser jet plus, is landscape;
+
+(*********************************************************************)
+
+paper size (21.0, 29.7);
+printer type ("LaserJet");
+
+PROC paper size (REAL CONST x, y) :
+
+ x size := x;
+ y size := y;
+
+END PROC paper size;
+
+PROC paper size :
+
+ line;
+ putline ("Papierbreite = " + text (x size, 5, 2) + " cm = " + text (x size / 2.54, 5, 2) + " Zoll");
+ putline ("Papierlaenge = " + text (y size, 5, 2) + " cm = " + text (y size / 2.54, 5, 2) + " Zoll");
+
+END PROC paper size;
+
+PROC printer type (TEXT CONST type) :
+
+ is laser jet plus := pos (type, "+") <> 0
+
+END PROC printer type;
+
+TEXT PROC printer type :
+
+ IF is laser jet plus
+ THEN "LaserJet+"
+ ELSE "LaserJet"
+ FI
+
+END PROC printer type;
+
+(*********************************************************************)
+
+PROC open (INT CONST op code, INT VAR param1, param2) :
+
+SELECT op code OF
+ CASE c document : open document
+ CASE c page : open page
+END SELECT;
+
+
+. x steps : param1
+. y steps : param2
+.
+ open document :
+ out (""27"E"); (* Reset des Druckers *)
+ out (""27"&s1C"); (* 'end of line wrap' aus *)
+ out (""27"&l0L"); (* 'perforation skip' aus *)
+ out (""27"&l1X"); (* eine Kopie *)
+ out (""27"&l1H"); (* upper tray *)
+ IF pos (material, "landscape") > 0 OR pos (material, "quer") > 0
+ THEN is landscape := TRUE;
+ x steps := x step conversion ( y size );
+ y steps := y step conversion ( x size );
+ out (""27"&l1O");
+ ELSE is landscape := FALSE;
+ x steps := x step conversion ( x size );
+ y steps := y step conversion ( y size );
+ FI;
+
+. x start : param1
+. y start : param2
+.
+ open page :
+ IF is landscape
+ THEN x start := x step conversion (0.508); (* 0.200*2.54 *)
+ y start := y step conversion (1.693333); (* 0.500*2.54 + 2.54/6.0 *)
+ ELSE x start := x step conversion (0.39878); (* 0.157*2.54 *)
+ y start := y step conversion (1.693333); (* 0.500*2.54 + 2.54/6.0 *)
+ FI;
+ IF pos (material, "lower tray") > 0 COR pos (material, "lowertray") > 0
+ THEN out (""27"&l4H");
+ ELIF pos (material, "tray") > 0 COR pos (material, "upper tray") > 0 COR pos (material, "uppertray") > 0
+ THEN out (""27"&l1H");
+ ELIF pos (material, "manual") > 0
+ THEN out (""27"&l2H");
+ ELIF pos (material, "envelope") > 0
+ THEN out (""27"&l3H");
+ FI;
+ IF material contains a number
+ THEN out (""27"&l" + text (number) + "X");
+ FI;
+ out (""13"");
+
+ . material contains a number :
+ INT VAR number := pos (material, "0", "9", 1);
+ IF number = 0
+ THEN FALSE
+ ELSE number := max (1, int (subtext (material, number, number + 1)));
+ TRUE
+ FI
+
+END PROC open;
+
+
+PROC close (INT CONST op code, INT CONST param1) :
+
+SELECT op code OF
+ CASE c document : close document
+ CASE c page : close page
+ OTHERWISE : put (param1)
+END SELECT;
+
+.
+ close document :
+
+
+(*. remaining y steps : param1*)
+.
+ close page :
+ out (""12"")
+
+END PROC close;
+
+
+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :
+
+SELECT op code OF
+ CASE c write text : write text
+ CASE c write cmd : write cmd
+ CASE c carriage return : carriage return
+ CASE c move : move
+ CASE c draw : draw
+ CASE c on : on
+ CASE c off : off
+ CASE c type : type
+END SELECT
+
+
+. from : param1
+. to : param2
+.
+ write text :
+ out subtext (string, from, to)
+
+.
+ write cmd :
+ out subtext (string, from, to)
+
+
+(*. x steps to left margin : param1*)
+.
+ carriage return :
+ out (""13"")
+
+
+. x steps : param1
+. y steps : param2
+.
+ move :
+ IF x steps <> 0
+ THEN x move
+ ELIF y steps > 0
+ THEN out (""27"&a+" + text (y steps) + "V");
+ ELIF y steps < 0
+ THEN out (""27"&a" + text (y steps) + "V");
+ FI;
+
+ . x move :
+ IF is laser jet plus
+ THEN laser jet plus x move
+ ELSE laser jet x move
+ FI;
+
+ . laser jet plus x move :
+ IF x steps >= 0
+ THEN out (""27"*p+" + text (x steps) + "X");
+ ELSE out (""27"*p" + text (x steps) + "X");
+ FI;
+
+ . laser jet x move :
+ abs x pos := x pos;
+ IF abs x pos >= 0
+ THEN out (""27"&a");
+ out (text ((abs x pos DIV 5) * 12 + ((abs x pos MOD 5) * 12 + 4) DIV 5));
+ out ("H");
+ ELSE stop
+ FI;
+
+.
+ draw :
+ stop
+
+
+. modification : param1
+.
+ on :
+ IF on string (modification) <> ""
+ THEN out (on string (modification))
+ ELSE stop
+ FI
+
+.
+ off :
+ IF off string (modification) <> ""
+ THEN out (off string (modification))
+ ELSE stop
+ FI
+
+
+. font nr : param1
+.
+ type :
+ out (font string (font nr));
+
+END PROC execute;
+
+
+END PACKET hp laserjet printer;
+
+
+#page#
+(******************************************************************)
+(*** ***)
+(*** Generierung des Printers ***)
+(*** ***)
+(******************************************************************)
+
+LET printer name = "printer.hp.laserjet",
+ up = ""3""13""5"";
+
+TEXT VAR fonttab name := "fonttab.hp.laserjet";
+
+BOOL CONST multi user := (pcb (9) AND 255) <> 1;
+
+INT VAR pr channel;
+TEXT VAR buffer;
+
+command dialogue (TRUE);
+IF NOT multi user
+ THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL")
+FI;
+ask for print channel;
+ask for printer type;
+load font table;
+forget (printer name, quiet);
+IF multi user THEN generate printer spool FI;
+check on;
+.
+ ask for print channel :
+ line;
+ put ("gib Druckerkanal:");
+ get (pr channel);
+ do ("serverchannel(" + text (pr channel) + ")" ) ;
+ line;
+.
+ ask for printer type :
+ printer type (laser jet);
+
+ . laser jet :
+ line;
+ REP out (up);
+ IF yes ("Druckertyp : HP LaserJet")
+ THEN LEAVE laser jet WITH "LaserJet" FI;
+ out (up);
+ IF yes ("Druckertyp : HP LaserJet+")
+ THEN LEAVE laser jet WITH "LaserJet+" FI;
+ PER;
+ ""
+.
+ load font table :
+ line (2);
+ write (""13""4"");
+ putline ("Die Fonttabelle """ + fonttab name +
+ """ enthält die Schrifttypen der");
+ putline ("Font Cartriges:");
+ putline (" 92286A Courier 1");
+ putline (" 92286C International 1");
+ putline (" 92286D Prestige Elite");
+ putline (" 92286E Letter Gothic");
+ putline (" 92286F TMS Proportional 2");
+ putline (" 92286L Courier P&L");
+ putline (" 92286M Prestige Elite P&L");
+ putline (" 92286N Letter Gothic P&L");
+ putline (" 92286P TMS RMN P&L");
+ putline (" 92286Q Memo 1");
+ line;
+ putline ("Für ein korrektes Druckbild dürfen immer nur die Schrifttypen angesprochen");
+ putline ("werden, deren Cartrige eingeschoben ist!");
+ IF printer type = "LaserJet"
+ THEN line;
+ putline ("ELAN-Listings können nur gedruckt werden, wenn ein Cartrige mit dem");
+ putline ("Schrifttyp 'LINE PRINTER' eingeschoben ist!");
+ FI;
+ line (2);
+ putline ("Weiter nach Eingabe einer Taste");
+ pause;
+ IF NOT exists (fonttab name)
+ THEN command dialogue (TRUE);
+ REP line (2);
+ putline ("Bitte Archiv mit der Fonttabelle """ +
+ fonttab name + """ einlegen!");
+ line;
+ UNTIL yes ("Archiv eingelegt") PER;
+ reserve archive;
+ fetch (fonttab name, archive);
+ release (archive);
+ FI;
+ font table (fonttab name);
+ IF multi user
+ THEN command dialogue (FALSE);
+ do ("save(""" + font tab name + """,task(""configurator""))")
+ FI;
+ forget (fonttab name, quiet);
+
+ . reserve archive :
+ INT VAR p1, p2;
+ archive (" "31" ");
+ disable stop;
+ list (archive);
+ IF is error
+ THEN buffer := errormessage;
+ p1 := pos (buffer, """", 1 ) + 1;
+ p2 := pos (buffer, """", p1) - 1;
+ IF p1 > 0 AND p2 > 0
+ THEN clear error;
+ buffer := subtext (buffer, p1, p2);
+ archive (buffer);
+ FI;
+ FI;
+ enable stop;
+
+. generate printer spool :
+ eumel must advertise;
+ cursor (1, 12);
+ putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");
+ putline ("die Fonttabelle mit dem Kommando");
+ line;
+ putline (" font table (""" + font tab name + """)");
+ line;
+ putline ("eingestellt werden!!!");
+ line (4);
+ putline ("Generierung beendet, weiter mit 'SV'");
+ generate printer server;
+ do (buffer);
+
+. generate printer server :
+ buffer := "break (quiet);";
+ buffer CAT "spool manager (PROC printer);";
+ buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;";
+ buffer CAT "PROC printer:";
+ buffer CAT " disable stop;";
+ buffer CAT " continue (server channel);";
+ buffer CAT " check error (error message);";
+ buffer CAT " ds := nilspace;";
+ buffer CAT " REP forget (ds);";
+ buffer CAT " execute print;";
+ buffer CAT " IF is error AND online";
+ buffer CAT " THEN out (""""27""(8U""27""(s0p10h12v0s0b3T"");";
+ buffer CAT " put error; clear error; out (""""12"""");";
+ buffer CAT " FI;";
+ buffer CAT " PER;";
+ buffer CAT "END PROC printer;";
+ buffer CAT "PROC execute print:";
+ buffer CAT " LET ack = 0, fetch code = 11, file type = 1003;";
+ buffer CAT " enable stop;";
+ buffer CAT " ds := nilspace;";
+ buffer CAT " call (father, fetch code, ds, reply);";
+ buffer CAT " IF reply = ack CAND type (ds) = file type";
+ buffer CAT " THEN file := sequential file (input, ds);";
+ buffer CAT " print (file,";
+ buffer CAT " PROC (INT CONST, INT VAR, INT VAR) open,";
+ buffer CAT " PROC (INT CONST, INT CONST) close,";
+ buffer CAT " PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);";
+ buffer CAT " FI;";
+ buffer CAT "END PROC execute print;";
+ buffer CAT "PROC check error(TEXT CONST message):";
+ buffer CAT " IF is error";
+ buffer CAT " THEN clear error; rename myself (message);";
+ buffer CAT " IF is error THEN end(myself) FI;";
+ buffer CAT " pause (9000); end(myself);";
+ buffer CAT " FI;";
+ buffer CAT "END PROC check error;";
+
diff --git a/system/printer-laser/4/src/printer.kyocera.f-1010 b/system/printer-laser/4/src/printer.kyocera.f-1010
new file mode 100644
index 0000000..a46f7b3
--- /dev/null
+++ b/system/printer-laser/4/src/printer.kyocera.f-1010
@@ -0,0 +1,373 @@
+PACKET kyocera f 1010 printer
+
+(**************************************************************************)
+(* Stand : 03.12.86 *)
+(* KYOCERA F - 1010 Verison : 4 *)
+(* Autor : Rudolf Ruland *)
+(**************************************************************************)
+
+(**************************************************************************)
+(* Hinweis : Die 'time-out' Zeit, nach der der Eingabepuffer ausgegeben *)
+(* wird, wenn keine Eingabe mehr erfolgt, sollte moeglichst *)
+(* gross gewaehlt werden, *)
+(* z.B. mit FRPO H9, 60; wird sie auf 5 Min. gesetzt *)
+(**************************************************************************)
+
+
+ DEFINES open,
+ close,
+ execute,
+
+ paper size :
+
+LET underline = 1,
+(* bold = 2,
+ italics = 4,
+ reverse = 8,
+
+ underline linetype = 1, *)
+
+ c document = 1,
+ c page = 2,
+
+ c write text = 1,
+ c write cmd = 2,
+ c carriage return = 3,
+ c move = 4,
+ c draw = 5,
+ c on = 6,
+ c off = 7,
+ c type = 8;
+
+INT VAR blankpitch, high, low;
+REAL VAR x size, y size;
+BOOL VAR is landscape, is underline;
+
+(*********************************************************************)
+
+paper size (21.0, 29.7);
+
+PROC paper size (REAL CONST x, y) :
+
+ x size := x;
+ y size := y;
+
+END PROC paper size;
+
+PROC paper size :
+
+ line;
+ putline ("Papierbreite = " + text (x size, 5, 2) + " cm = " + text (x size / 2.54, 5, 2) + " Zoll");
+ putline ("Papierlaenge = " + text (y size, 5, 2) + " cm = " + text (y size / 2.54, 5, 2) + " Zoll");
+
+END PROC paper size;
+
+(*********************************************************************)
+
+PROC open (INT CONST op code, INT VAR param1, param2) :
+
+SELECT op code OF
+ CASE c document : open document
+ CASE c page : open page
+END SELECT;
+
+
+. x steps : param1
+. y steps : param2
+.
+ open document :
+ out ("!"82"! RES; UNIT D; EXIT;"); (* Reset des Druckers *)
+ IF pos (material, "landscape") > 0 OR pos (material, "quer") > 0
+ THEN is landscape := TRUE;
+ x steps := x step conversion ( y size );
+ y steps := y step conversion ( x size );
+ out (""27"&l1O");
+ ELSE is landscape := FALSE;
+ x steps := x step conversion ( x size );
+ y steps := y step conversion ( y size );
+ FI;
+ is underline := FALSE;
+ IF y size < 29.7 OR x size < 21.0
+ THEN out ("!"82"! SLM ");
+ IF is landscape
+ THEN out (text (x step conversion (29.7 - y size)));
+ out ("; STM ");
+ out (text (y step conversion ((21.0 - x size) * 0.5)));
+ ELSE out (text (x step conversion ((21.0 - x size) * 0.5)));
+ FI;
+ out ("; EXIT;");
+ FI;
+
+. x start : param1
+. y start : param2
+.
+ open page :
+ out ("!"82"! MZP 0, 0; EXIT;"); (* Positionierung zum Nullpunkt *)
+ IF is landscape
+ THEN x start := x step conversion (0.19);
+ y start := y step conversion (0.70);
+ ELSE x start := x step conversion (0.56);
+ y start := y step conversion (0.60);
+ FI;
+ IF pos (material, "tray") > 0
+ THEN out (""27"&l1H");
+ ELIF pos (material, "manual") > 0
+ THEN out (""27"&l2H");
+ FI;
+ out (""13"");
+
+END PROC open;
+
+
+PROC close (INT CONST op code, INT CONST param1) :
+
+SELECT op code OF
+ CASE c document : close document
+ CASE c page : close page
+ OTHERWISE : put (param1)
+END SELECT;
+
+.
+ close document :
+
+
+(*. remaining y steps : param1*)
+.
+ close page :
+ out (""12"");
+
+END PROC close;
+
+
+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :
+
+SELECT op code OF
+ CASE c write text : write text
+ CASE c write cmd : write cmd
+ CASE c carriage return : carriage return
+ CASE c move : move
+ CASE c draw : draw
+ CASE c on : on
+ CASE c off : off
+ CASE c type : type
+END SELECT
+
+
+. from : param1
+. to : param2
+.
+ write text :
+ out subtext (string, from, to)
+
+.
+ write cmd :
+ out subtext (string, from, to)
+
+
+(*. x steps to left margin : param1*)
+.
+ carriage return :
+ out (""13"")
+
+
+. x steps : param1
+. y steps : param2
+.
+ move :
+ IF x steps > 0
+ THEN IF is underline
+ THEN underline x move
+ ELSE out (""27"*p+" + text (x steps) + "X");
+ FI;
+ ELIF x steps < 0
+ THEN out (""27"*p" + text (x steps) + "X");
+ ELIF y steps > 0
+ THEN out (""27"*p+" + text (y steps) + "Y");
+ ELIF y steps < 0
+ THEN out (""27"*p" + text (y steps) + "Y");
+ FI;
+
+ . underline x move :
+ high := x steps DIV blankpitch;
+ low := x steps MOD blankpitch;
+ IF high > 0 THEN high TIMESOUT " " FI;
+ IF low > 0 THEN out (" "27"*p" + text (low - blank pitch) + "X") FI;
+
+.
+ draw :
+ stop
+
+
+. modification : param1
+.
+ on :
+ IF on string (modification) <> ""
+ THEN out (on string (modification));
+ IF modification = underline THEN is underline := TRUE FI;
+ ELSE stop
+ FI
+
+.
+ off :
+ IF off string (modification) <> ""
+ THEN out (off string (modification));
+ IF modification = underline THEN is underline := FALSE FI;
+ ELSE stop
+ FI
+
+
+. font nr : param1
+.
+ type :
+ out (font string (font nr));
+ blankpitch := char pitch (font nr, " ");
+
+END PROC execute;
+
+
+END PACKET kyocera f 1010 printer;
+
+
+
+#page#
+(******************************************************************)
+(*** ***)
+(*** Generierung des Printers ***)
+(*** ***)
+(******************************************************************)
+
+LET printer name = "printer.kyocera.f-1010";
+
+TEXT VAR fonttab name := "fonttab.kyocera.f-1010";
+
+BOOL CONST multi user := (pcb (9) AND 255) <> 1;
+
+INT VAR pr channel;
+TEXT VAR buffer;
+
+command dialogue (TRUE);
+IF NOT multi user
+ THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL")
+FI;
+ask for print channel;
+dynamic font hint;
+load font table;
+forget (printer name, quiet);
+IF multi user THEN generate printer spool FI;
+check on;
+command dialogue (TRUE);
+.
+ ask for print channel :
+ line;
+ put ("gib Druckerkanal:");
+ get (pr channel);
+ do ("serverchannel(" + text (pr channel) + ")" ) ;
+ line;
+.
+ dynamic font hint :
+ line (3);
+ putline (""4"Hinweis zur Benutzung der dynamischen Schrifttypen:");
+ line;
+ putline (" In der Fonttabelle """ + fonttab name + """ sind einige dynamische");
+ putline (" Schrifttypen angepaßt. Diese müssen nach jedem Einschalten des");
+ putline (" Druckers neu generiert werden.");
+ putline (" Zur Generierung dieser Schrifttypen befinden sich auf dem Standard-");
+ putline (" archive die folgenden Dateien:");
+ line;
+ putline (" ""genfont.kyocera.f-1010.dynamic1""");
+ putline (" ""genfont.kyocera.f-1010.dynamic2""");
+ line;
+ putline (" Nach Einschalten des Druckers müssen diese Dateien zuerst ausgedruckt");
+ putline (" werden.");
+ putline (" Die Generierung benötigt pro Schriftart etwa 15 Minuten.");
+ line (2);
+ putline ("Weiter nach Eingabe einer Taste");
+ pause;
+.
+ load font table :
+ IF NOT exists (fonttab name)
+ THEN REP line (2);
+ putline ("Bitte Archiv mit der Fonttabelle """ +
+ fonttab name + """ einlegen!");
+ line;
+ UNTIL yes ("Archiv eingelegt") PER;
+ reserve archive;
+ fetch (fonttab name, archive);
+ release (archive);
+ FI;
+ font table (fonttab name);
+ IF multi user
+ THEN command dialogue (FALSE);
+ do ("save(""" + font tab name + """,task(""configurator""))")
+ FI;
+ forget (fonttab name, quiet);
+
+ . reserve archive :
+ INT VAR p1, p2;
+ archive (" "31" ");
+ disable stop;
+ list (archive);
+ IF is error
+ THEN buffer := errormessage;
+ p1 := pos (buffer, """", 1 ) + 1;
+ p2 := pos (buffer, """", p1) - 1;
+ IF p1 > 0 AND p2 > 0
+ THEN clear error;
+ buffer := subtext (buffer, p1, p2);
+ archive (buffer);
+ FI;
+ FI;
+ enable stop;
+
+. generate printer spool :
+ eumel must advertise;
+ cursor (1, 12);
+ putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");
+ putline ("die Fonttabelle mit dem Kommando");
+ line;
+ putline (" font table (""" + font tab name + """)");
+ line;
+ putline ("eingestellt werden!!!");
+ line (4);
+ putline ("Generierung beendet, weiter mit 'SV'");
+ generate printer server;
+ do (buffer);
+
+. generate printer server :
+ buffer := "break (quiet);";
+ buffer CAT "spool manager (PROC printer);";
+ buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;";
+ buffer CAT "PROC printer:";
+ buffer CAT " disable stop;";
+ buffer CAT " continue (server channel);";
+ buffer CAT " check error (error message);";
+ buffer CAT " ds := nilspace;";
+ buffer CAT " REP forget (ds);";
+ buffer CAT " execute print;";
+ buffer CAT " IF is error AND online";
+ buffer CAT " THEN out (""""27""(8U""27""(s0p10h12v0s0b3T"");";
+ buffer CAT " put error; clear error; out (""""12"""");";
+ buffer CAT " FI;";
+ buffer CAT " PER;";
+ buffer CAT "END PROC printer;";
+ buffer CAT "PROC execute print:";
+ buffer CAT " LET ack = 0, fetch code = 11, file type = 1003;";
+ buffer CAT " enable stop;";
+ buffer CAT " ds := nilspace;";
+ buffer CAT " call (father, fetch code, ds, reply);";
+ buffer CAT " IF reply = ack CAND type (ds) = file type";
+ buffer CAT " THEN file := sequential file (input, ds);";
+ buffer CAT " print (file,";
+ buffer CAT " PROC (INT CONST, INT VAR, INT VAR) open,";
+ buffer CAT " PROC (INT CONST, INT CONST) close,";
+ buffer CAT " PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);";
+ buffer CAT " FI;";
+ buffer CAT "END PROC execute print;";
+ buffer CAT "PROC check error(TEXT CONST message):";
+ buffer CAT " IF is error";
+ buffer CAT " THEN clear error; rename myself (message);";
+ buffer CAT " IF is error THEN end(myself) FI;";
+ buffer CAT " pause (9000); end(myself);";
+ buffer CAT " FI;";
+ buffer CAT "END PROC check error;";
+
diff --git a/system/printer-laser/4/src/printer.nec.lc-08 b/system/printer-laser/4/src/printer.nec.lc-08
new file mode 100644
index 0000000..9ee2837
--- /dev/null
+++ b/system/printer-laser/4/src/printer.nec.lc-08
@@ -0,0 +1,626 @@
+PACKET nec lc 08 printer
+
+(**************************************************************************)
+(* Stand : 29.01.88 *)
+(* NEC Silentwriter LC-08 Verison : 4 *)
+(* Autor : Rudolf Ruland *)
+(**************************************************************************)
+
+ DEFINES open,
+ close,
+ execute,
+
+ box commands,
+ insert box command,
+ delete box command,
+
+ paper size,
+ paper x size,
+ paper y size:
+
+LET
+(* underline = 1,
+ bold = 2,
+ italics = 4,
+ reverse = 8,
+
+ underline linetype = 1, *)
+
+ c document = 1,
+ c page = 2,
+
+ c write text = 1,
+ c write cmd = 2,
+ c carriage return = 3,
+ c move = 4,
+ c draw = 5,
+ c on = 6,
+ c off = 7,
+ c type = 8,
+
+ tag type = 1;
+
+INT VAR symbol type;
+REAL VAR x size, y size;
+BOOL VAR is landscape, was cr;
+TEXT VAR bold buffer, mod string, command, symbol;
+THESAURUS VAR box cmds := empty thesaurus;
+
+(*********************************************************************)
+
+paper size (21.0, 29.7);
+
+PROC paper size (REAL CONST x, y) :
+
+ x size := x;
+ y size := y;
+
+END PROC paper size;
+
+PROC paper size :
+
+ line;
+ putline ("Papierbreite = " + text (x size, 5, 2) + " cm = " + text (x size / 2.54, 5, 2) + " Zoll");
+ putline ("Papierlaenge = " + text (y size, 5, 2) + " cm = " + text (y size / 2.54, 5, 2) + " Zoll");
+
+END PROC paper size;
+
+REAL PROC paper x size : x size END PROC paper x size;
+REAL PROC paper y size : y size END PROC paper y size;
+
+
+THESAURUS PROC box commands : box cmds END PROC box commands;
+
+PROC insert box command (TEXT CONST new command) :
+
+ command := new command;
+ change all (command, " ", "");
+ insert (box cmds, command)
+
+END PROC insert box command;
+
+PROC delete box command (TEXT CONST old command) :
+
+ INT VAR dummy;
+ command := old command;
+ change all (command, " ", "");
+ delete (box cmds, command, dummy)
+
+END PROC delete box command;
+
+(*********************************************************************)
+
+PROC open (INT CONST op code, INT VAR param1, param2) :
+
+SELECT op code OF
+ CASE c document : open document
+ CASE c page : open page
+END SELECT;
+
+
+. x steps : param1
+. y steps : param2
+.
+ open document :
+ out (""28"Cz"); (* Diablo 630 Emulation *)
+ out (""27""13"P"); (* Reset *)
+ out (""28"$"); (* Formatlaenge loeschen *)
+ out (""28"Ca"27"6"28"Cz"); (* Zeichensatz 2 *)
+ out (""28"Ra"); (* USA-Zeichensatz *)
+ out (""27""25"1"); (* Sheet 1 *)
+ is landscape := pos (material, "landscape") > 0;
+ IF is landscape
+ THEN x steps := x step conversion ( y size );
+ y steps := y step conversion ( x size );
+ out (""28")"128""0""); (* Landscape-Mode *)
+ ELSE x steps := x step conversion ( x size );
+ y steps := y step conversion ( y size );
+ out (""28")"001""0""); (* Portait -Mode *)
+ FI;
+ was cr := FALSE;
+ bold buffer := "";
+
+. x start : param1
+. y start : param2
+.
+ open page :
+ IF is landscape
+ THEN x start := x step conversion (0.45);
+ y start := y step conversion (0.9);
+ ELSE x start := x step conversion (0.7);
+ y start := y step conversion (0.9);
+ FI;
+ IF pos (material, "sheet1") > 0
+ THEN out (""27""25"1")
+ ELIF pos (material, "sheet2") > 0
+ THEN out (""27""25"2")
+ ELIF pos (material, "manual") > 0
+ THEN out (""27""25"E")
+ FI;
+ out (""28"'a"0""0""28"&a"0""0""); (* Positionierung auf den Nullpunkt *)
+
+END PROC open;
+
+
+PROC close (INT CONST op code, INT CONST param1) :
+
+SELECT op code OF
+ CASE c document : close document
+ CASE c page : close page
+ OTHERWISE : put (param1)
+END SELECT;
+
+.
+ close document :
+
+
+(*. remaining y steps : param1*)
+.
+ close page :
+ out (""12"")
+
+END PROC close;
+
+
+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :
+
+SELECT op code OF
+ CASE c write text : write text
+ CASE c write cmd : write cmd
+ CASE c carriage return : carriage return
+ CASE c move : move
+ CASE c draw : draw
+ CASE c on : on
+ CASE c off : off
+ CASE c type : type
+END SELECT
+
+
+. from : param1
+. to : param2
+.
+ write text :
+ IF was cr
+ THEN was cr := FALSE;
+ out (bold buffer);
+ FI;
+ out subtext (string, from, to)
+
+.
+ write cmd :
+ IF was cr
+ THEN was cr := FALSE;
+ out (bold buffer);
+ FI;
+ command := subtext (string, from, to);
+ IF is box cmd
+ THEN disable stop;
+ do (command);
+ clear error;
+ ELSE out (command);
+ FI;
+
+ . is box cmd :
+ scan (command);
+ next symbol (symbol, symbol type);
+ (symbol type = tag type) CAND (box cmds CONTAINS symbol)
+
+
+(*. x steps to left margin : param1*)
+.
+ carriage return :
+ out (""13"");
+ was cr := TRUE;
+
+
+. x steps : param1
+. y steps : param2
+.
+ move :
+ IF x steps <> 0 THEN x move FI;
+ IF y steps <> 0 THEN y move FI;
+
+ . x move :
+ IF x steps > 0 THEN out (""28"&c") ELSE out (""28"&d") FI;
+ out (x steps low);
+ out (x steps high);
+
+ . x steps low : code (abs (x steps) MOD 256)
+ . x steps high : code (abs (x steps) DIV 256)
+
+ . y move :
+ IF y steps > 0 THEN out (""28"'c") ELSE out (""28"'d") FI;
+ out (y steps low);
+ out (y steps high);
+
+ . y steps low : code (abs (y steps) MOD 256)
+ . y steps high : code (abs (y steps) DIV 256)
+.
+ draw :
+ stop
+
+
+. modification : param1
+.
+ on :
+ mod string := on string (modification);
+ IF mod string <> ""
+ THEN out (mod string);
+ IF pos (""27"W"27"O", mod string) > 0
+ THEN bold buffer CAT mod string;
+ FI;
+ ELSE stop
+ FI
+
+.
+ off :
+ mod string := off string (modification);
+ IF mod string <> ""
+ THEN out (mod string);
+ IF pos (""27"&", mod string) > 0
+ THEN bold buffer := subtext (bold buffer, 1, LENGTH bold buffer - 2);
+ out (bold buffer);
+ FI;
+ ELSE stop
+ FI
+
+
+. font nr : param1
+.
+ type :
+ out (""28")"); (* Font Identifikation *)
+ command := font string (font nr);
+ IF is landscape
+ THEN out subtext (command, 3, 4);
+ ELSE out subtext (command, 1, 2);
+ FI;
+ out (""28"E"); (* Zeilenvorschub (VMI) *)
+ out (code (font height (font nr) + font depth (font nr) + font lead (font nr)));
+ out (""28"F"); (* Zeichenabstand (HMI) *)
+ out (code (char pitch (font nr, " ")));
+ out (""27"P"); (* proportional ein *)
+ out subtext (command, 5);
+
+END PROC execute;
+
+END PACKET nec lc 08 printer;
+
+
+PACKET nec lc 08 box commands
+
+(**************************************************************************)
+(* *)
+(* Kommandos zum Zeichen von Boxen, Linien und Schraffuren *)
+(* für den NEC Laserdrucker LC-08 *)
+(* *)
+(* Autor : Rudolf Ruland *)
+(* Stand : 29.01.88 *)
+(**************************************************************************)
+
+ DEFINES line,
+ x line,
+ y line,
+
+ box,
+ box frame,
+ box shade,
+
+ cake,
+ cake frame,
+ cake shade,
+ :
+
+INT VAR x, y, h, w;
+
+WHILE highest entry (box commands) > 0
+ REP delete box command (name (box commands, highest entry (box commands))) PER;
+insert box command ("line");
+insert box command ("xline");
+insert box command ("yline");
+insert box command ("box");
+insert box command ("boxshade");
+insert box command ("boxframe");
+insert box command ("cake");
+insert box command ("cakeshade");
+insert box command ("cakeframe");
+
+
+PROC line (REAL CONST x offset, y offset, width, height, INT CONST line width) :
+
+ IF line width > 0
+ THEN graph on (x offset, y offset, width, height);
+ out ("LW" + text (line width) + ";");
+ out ("PR;");
+ out ("PD" + text (+w) + "," + text (-h) + ";");
+ graph off;
+ FI;
+
+END PROC line;
+
+PROC x line (REAL CONST x offset, y offset, width, INT CONST line width) :
+
+ IF line width > 0
+ THEN graph on (x offset, y offset, width, 0.0);
+ out ("LW" + text (line width) + ";");
+ out ("PR;");
+ out ("PD" + text (+w) + "," + "0;");
+ graph off;
+ FI;
+
+END PROC x line;
+
+PROC y line (REAL CONST x offset, y offset, height, INT CONST line width) :
+
+ IF line width > 0
+ THEN graph on (x offset, y offset, 0.0, height);
+ out ("LW" + text (line width) + ";");
+ out ("PR;");
+ out ("PD0," + text (-h) + ";");
+ graph off;
+ FI;
+
+END PROC y line;
+
+
+PROC box (REAL CONST x offset, y offset, width, height,
+ INT CONST pattern type, line width) :
+
+ IF pattern type = 0
+ THEN box frame (x offset, y offset, width, height, line width)
+ ELIF line width = 0
+ THEN box shade (x offset, y offset, width, height, pattern type)
+ ELSE graph on (x offset, y offset, width, height);
+ out ("LW" + text (line width) + ";");
+ set pattern (pattern type);
+ out ("ER" + text (+w) + "," + text (-h) + ";");
+ graph off;
+ FI;
+
+END PROC box;
+
+
+PROC box shade (REAL CONST x offset, y offset, width, height,
+ INT CONST pattern type) :
+
+ IF pattern type <> 0
+ THEN graph on (x offset, y offset, width, height);
+ set pattern (pattern type);
+ out ("RR" + text (+w) + "," + text (-h) + ";");
+ graph off;
+ FI;
+
+END PROC box shade;
+
+
+PROC box frame (REAL CONST x offset, y offset, width, height,
+ INT CONST line width) :
+
+ IF line width <> 0
+ THEN graph on (x offset, y offset, width, height);
+ out ("LW" + text (line width) + ";");
+ out ("PR;");
+ out ("PD");
+ out (text (+w) + "," + "0,");
+ out ( "0," + text (-h) + ",");
+ out (text (-w) + "," + "0,");
+ out ( "0," + text (+h) + ";");
+ graph off;
+ FI;
+
+END PROC box frame;
+
+
+PROC cake (REAL CONST x offset, y offset, radius, start angle, sweep angle,
+ INT CONST pattern type, line width) :
+
+ IF pattern type = 0
+ THEN cake frame (x offset, y offset, radius, start angle, sweep angle, line width)
+ ELIF line width = 0
+ THEN cake shade (x offset, y offset, radius, start angle, sweep angle, pattern type)
+ ELSE graph on (x offset, y offset, radius, 0.0);
+ out ("LW" + text (line width) + ";");
+ set pattern (pattern type);
+ out ("EW" + text (+w) + "," + text (start angle) + "," + text (sweep angle) + ";");
+ graph off;
+ FI;
+
+END PROC cake;
+
+
+PROC cake shade (REAL CONST x offset, y offset, radius, start angle, sweep angle,
+ INT CONST pattern type) :
+
+ IF pattern type > 0 CAND w > 0
+ THEN graph on (x offset, y offset, radius, 0.0);
+ set pattern (pattern type);
+ out ("WG" + text (+w) + "," + text (start angle) + "," + text (sweep angle) + ";");
+ graph off;
+ FI;
+
+END PROC cake shade;
+
+
+PROC cake frame (REAL CONST x offset, y offset, radius, start angle, sweep angle,
+ INT CONST line width) :
+
+
+ IF line width <> 0
+ THEN REAL CONST xs := real (x) + cos (start angle*pi/180.0) * real (w),
+ ys := real (y) + sin (start angle*pi/180.0) * real (w);
+ graph on (x offset, y offset, radius, 0.0);
+ out ("LW" + text (line width) + ";");
+ out ("MA"+ text (xs) + "," + text (ys) + ";");
+ out ("FA"+ text ( x) + "," + text ( y) + "," + text (sweep angle) + ";");
+ out ("MA"+ text ( x) + "," + text ( y) + ";");
+ graph off;
+ FI;
+
+END PROC cake frame;
+
+
+PROC graph on (REAL CONST x offset, y offset, width, height) :
+
+ x := x pos + x step conversion (x offset);
+ y := plot y size - (y pos + y step conversion (y offset));
+ w := x step conversion (width);
+ h := y step conversion (height);
+ out (""28"Aa");
+ out ("DF;");
+ out ("MA"+ text (x) + "," + text (y) + ";");
+
+ . plot y size : 3389 - y step conversion (1.0)
+
+END PROC graph on;
+
+PROC graph off :
+
+ out (""28"Az");
+
+END PROC graph off;
+
+
+PROC set pattern (INT CONST pattern type) :
+
+ out ("XX1;");
+ out (pattern);
+
+ . pattern :
+ SELECT pattern type OF
+ CASE 1 : "FT2,1,0;"
+ CASE 2 : "FT2,1,90;"
+ CASE 3 : "FT2,1,45;"
+ CASE 4 : "FT3,1,0;"
+ CASE 5 : "FT3,1,45;"
+ CASE 6 : "FT2,100,0;"
+ CASE 7 : "FT2,100,90;"
+ CASE 8 : "FT2,100,45;"
+ CASE 9 : "FT3,100,0;"
+ CASE 10 : "FT3,100,45;"
+ OTHERWISE : "FT1;"
+ END SELECT
+
+END PROC set pattern;
+
+
+END PACKET nec lc 08 box commands;
+
+
+
+#page#
+(******************************************************************)
+(*** ***)
+(*** Generierung des Printers ***)
+(*** ***)
+(******************************************************************)
+
+LET printer name = "printer.nec.lc-08";
+
+TEXT VAR fonttab name := "fonttab.nec.lc-08";
+
+BOOL CONST multi user := (pcb (9) AND 255) <> 1;
+
+INT VAR pr channel;
+TEXT VAR buffer;
+
+command dialogue (TRUE);
+IF NOT multi user
+ THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL")
+FI;
+ask for print channel;
+load font table;
+forget (printer name, quiet);
+IF multi user THEN generate printer spool FI;
+command dialogue (TRUE);
+check on;
+.
+ ask for print channel :
+ line;
+ put ("gib Druckerkanal:");
+ get (pr channel);
+ do ("serverchannel(" + text (pr channel) + ")" ) ;
+ line;
+.
+ load font table :
+ IF NOT exists (fonttab name)
+ THEN REP line (2);
+ putline ("Bitte Archiv mit der Fonttabelle """ +
+ fonttab name + """ einlegen!");
+ line;
+ UNTIL yes ("Archiv eingelegt") PER;
+ reserve archive;
+ fetch (fonttab name, archive);
+ release (archive);
+ FI;
+ font table (fonttab name);
+ IF multi user
+ THEN command dialogue (FALSE);
+ do ("save(""" + font tab name + """,task(""configurator""))")
+ FI;
+ forget (fonttab name, quiet);
+
+ . reserve archive :
+ INT VAR p1, p2;
+ archive (" "31" ");
+ disable stop;
+ list (archive);
+ IF is error
+ THEN buffer := errormessage;
+ p1 := pos (buffer, """", 1 ) + 1;
+ p2 := pos (buffer, """", p1) - 1;
+ IF p1 > 0 AND p2 > 0
+ THEN clear error;
+ buffer := subtext (buffer, p1, p2);
+ archive (buffer);
+ FI;
+ FI;
+ enable stop;
+
+. generate printer spool :
+ eumel must advertise;
+ cursor (1, 12);
+ putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");
+ putline ("die Fonttabelle mit dem Kommando");
+ line;
+ putline (" font table (""" + font tab name + """)");
+ line;
+ putline ("eingestellt werden!!!");
+ line (4);
+ putline ("Generierung beendet, weiter mit 'SV'");
+ generate printer server;
+ do (buffer);
+
+. generate printer server :
+ buffer := "break (quiet);";
+ buffer CAT "spool manager (PROC printer);";
+ buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;";
+ buffer CAT "PROC printer:";
+ buffer CAT " disable stop;";
+ buffer CAT " continue (server channel);";
+ buffer CAT " check error (error message);";
+ buffer CAT " ds := nilspace;";
+ buffer CAT " REP forget (ds);";
+ buffer CAT " execute print;";
+ buffer CAT " IF is error AND online THEN put error; clear error; FI;";
+ buffer CAT " PER;";
+ buffer CAT "END PROC printer;";
+ buffer CAT "PROC execute print:";
+ buffer CAT " LET ack = 0, fetch code = 11, file type = 1003;";
+ buffer CAT " enable stop;";
+ buffer CAT " ds := nilspace;";
+ buffer CAT " call (father, fetch code, ds, reply);";
+ buffer CAT " IF reply = ack CAND type (ds) = file type";
+ buffer CAT " THEN file := sequential file (input, ds);";
+ buffer CAT " print (file,";
+ buffer CAT " PROC (INT CONST, INT VAR, INT VAR) open,";
+ buffer CAT " PROC (INT CONST, INT CONST) close,";
+ buffer CAT " PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);";
+ buffer CAT " FI;";
+ buffer CAT "END PROC execute print;";
+ buffer CAT "PROC check error(TEXT CONST message):";
+ buffer CAT " IF is error";
+ buffer CAT " THEN clear error; rename myself (message);";
+ buffer CAT " IF is error THEN end(myself) FI;";
+ buffer CAT " pause (9000); end(myself);";
+ buffer CAT " FI;";
+ buffer CAT "END PROC check error;";
+
--
cgit v1.2.3