diff options
Diffstat (limited to 'system/printer-laser/4/src')
15 files changed, 3433 insertions, 0 deletions
diff --git a/system/printer-laser/4/src/fonttab.apple.laserwriter b/system/printer-laser/4/src/fonttab.apple.laserwriter Binary files differnew file mode 100644 index 0000000..bee2d6a --- /dev/null +++ b/system/printer-laser/4/src/fonttab.apple.laserwriter diff --git a/system/printer-laser/4/src/fonttab.canon.lbp-8 b/system/printer-laser/4/src/fonttab.canon.lbp-8 Binary files differnew file mode 100644 index 0000000..45314ac --- /dev/null +++ b/system/printer-laser/4/src/fonttab.canon.lbp-8 diff --git a/system/printer-laser/4/src/fonttab.epson.sq b/system/printer-laser/4/src/fonttab.epson.sq Binary files differnew file mode 100644 index 0000000..a3f7af3 --- /dev/null +++ b/system/printer-laser/4/src/fonttab.epson.sq diff --git a/system/printer-laser/4/src/fonttab.hp.laserjet b/system/printer-laser/4/src/fonttab.hp.laserjet Binary files differnew file mode 100644 index 0000000..4082e46 --- /dev/null +++ b/system/printer-laser/4/src/fonttab.hp.laserjet diff --git a/system/printer-laser/4/src/fonttab.kyocera.f-1010 b/system/printer-laser/4/src/fonttab.kyocera.f-1010 Binary files differnew file mode 100644 index 0000000..9c3fbda --- /dev/null +++ b/system/printer-laser/4/src/fonttab.kyocera.f-1010 diff --git a/system/printer-laser/4/src/fonttab.nec.lc-08 b/system/printer-laser/4/src/fonttab.nec.lc-08 Binary files differnew file mode 100644 index 0000000..f032953 --- /dev/null +++ b/system/printer-laser/4/src/fonttab.nec.lc-08 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;"; + |