MODULE HostPrinters;
(**
project = "BlackBox"
organization = "www.oberon.ch"
contributors = "Oberon microsystems, Josef Templ"
version = "System/Rsrc/About"
copyright = "System/Rsrc/About"
license = "Docu/BB-License"
changes = ""
issues = ""
**)
IMPORT
SYSTEM, WinApi, WinDlg,
Kernel, Files, Dialog, Ports, HostPorts, Stores, Models, Views, Controllers,
Properties, Printers, Printing, Documents, Windows, HostWindows;
CONST
eduMsgH = 30 * Ports.point;
dialogCommand = "StdCmds.OpenToolDialog('HostPrinters.printing', '#Host:Print')";
TYPE
Printer = POINTER TO RECORD (Printers.Printer)
w, h: INTEGER;
(* port: HostPorts.Port; (* port to which forwarding occurs *) *)
devNames, devMode: WinApi.HANDLE; (* printer description *)
clean: TrapCleaner;
cancel: Windows.Window (* cancel dialog *)
END;
(*
Rider = POINTER TO RECORD (HostPorts.Rider)
p: Printer
END;
*)
Directory = POINTER TO RECORD (Printers.Directory) END;
TrapCleaner = POINTER TO RECORD (Kernel.TrapCleaner)
p: Printer
END;
VAR
printing*: RECORD
pnum-: INTEGER;
Cancel*: PROCEDURE
END;
dir: Directory;
current: Printers.Printer;
aborted: BOOLEAN;
sa, sb, sc: ARRAY 64 OF CHAR;
err: INTEGER;
jobLevel: INTEGER;
PROCEDURE PrinterDC (devNames, devMode: WinApi.HANDLE): WinApi.HANDLE;
VAR adr: INTEGER; i: SHORTINT; a, b, c: WinApi.PtrWSTR; dc: WinApi.HANDLE; dm: WinApi.PtrDEVMODEW;
BEGIN
adr := WinApi.GlobalLock(devNames);
dm := SYSTEM.VAL(WinApi.PtrDEVMODEW, WinApi.GlobalLock(devMode));
SYSTEM.GET(adr + 0, i); a := SYSTEM.VAL(WinApi.PtrWSTR, adr + i * SIZE(CHAR));
SYSTEM.GET(adr + 2, i); b := SYSTEM.VAL(WinApi.PtrWSTR, adr + i * SIZE(CHAR));
SYSTEM.GET(adr + 4, i); c := SYSTEM.VAL(WinApi.PtrWSTR, adr + i * SIZE(CHAR));
dc := WinApi.CreateDCW(a, b, c, dm^);
IF dc = 0 THEN dc := WinApi.CreateDCW(a, b, c, NIL) END;
adr := WinApi.GlobalUnlock(devMode);
adr := WinApi.GlobalUnlock(devNames);
RETURN dc
END PrinterDC;
PROCEDURE SetupPrinter (p: Printer; dc: WinApi.HANDLE);
VAR res, w, h, pw, ph, nx, ny, unit, ux, uy: INTEGER;
pt: WinApi.POINT; port: Ports.Port; hport: HostPorts.Port;
BEGIN
w := WinApi.GetDeviceCaps(dc, WinApi.HORZRES);
h := WinApi.GetDeviceCaps(dc, WinApi.VERTRES);
nx := WinApi.GetDeviceCaps(dc, WinApi.LOGPIXELSX);
ny := WinApi.GetDeviceCaps(dc, WinApi.LOGPIXELSY);
ux := (Ports.inch + nx DIV 2) DIV nx;
uy := (Ports.inch + ny DIV 2) DIV ny;
unit := ux;
IF nx < ny THEN
h := h * nx DIV ny
ELSIF nx > ny THEN
w := w * ny DIV nx; unit := uy
END;
pw := WinApi.GetDeviceCaps(dc, WinApi.PHYSICALWIDTH);
ph := WinApi.GetDeviceCaps(dc, WinApi.PHYSICALHEIGHT);
IF (pw = 0) OR (ph = 0) THEN
res := WinApi.Escape(dc, 12, 0, NIL, SYSTEM.ADR(pt));
ASSERT(res > 0, 100);
pw := pt.x; ph := pt.y
END;
pw := pw * ux; ph := ph * uy;
nx := WinApi.GetDeviceCaps(dc, WinApi.PHYSICALOFFSETX);
ny := WinApi.GetDeviceCaps(dc, WinApi.PHYSICALOFFSETY);
IF (nx = 0) OR (ny = 0) THEN
res := WinApi.Escape(dc, 13, 0, NIL, SYSTEM.ADR(pt));
ASSERT(res > 0, 100);
nx := pt.x; ny := pt.y
END;
nx := nx * ux; ny := ny * uy;
p.InitPrinter(-nx, -ny, pw - nx, ph - ny);
port := p.ThisPort();
IF port = NIL THEN
NEW(hport); p.InitPort(hport); port := hport;
port.Init(unit, Ports.printer)
END;
port.SetSize(w, h)
END SetupPrinter;
PROCEDURE NewPrinter* (devNames, devMode: WinApi.HANDLE): Printers.Printer;
VAR p: Printer; dc: WinApi.HANDLE; res: INTEGER;
BEGIN
ASSERT(devNames # 0, 20);
dc := PrinterDC(devNames, devMode);
IF dc # 0 THEN
NEW(p);
p.devNames := devNames; p.devMode := devMode;
SetupPrinter(p, dc);
res := WinApi.DeleteDC(dc)
ELSE p := NIL
END;
RETURN p
END NewPrinter;
PROCEDURE SetCurrent* (devNames, devMode: WinApi.HANDLE); (* used in HostDialog *)
BEGIN
IF devNames # 0 THEN
current := NewPrinter(devNames, devMode)
END;
END SetCurrent;
PROCEDURE GetCurrent* (OUT devNames, devMode: WinApi.HANDLE); (* used in HostDialog *)
BEGIN
IF current # NIL THEN
WITH current: Printer DO
devNames := current.devNames;
devMode := current.devMode
END
END
END GetCurrent;
PROCEDURE GetPage* (p: Printers.Printer; VAR w, h: INTEGER);
VAR l, t, r, b: INTEGER;
BEGIN
WITH p: Printer DO
p.GetRect(l, t, r, b);
w := r - l;
h := b - t
END
END GetPage;
PROCEDURE Error (res: INTEGER): INTEGER;
BEGIN
IF res = -1 THEN res := WinApi.GetLastError()
ELSIF aborted THEN res := 1
ELSE res := 0
END;
RETURN res
END Error;
PROCEDURE Cancel;
BEGIN
aborted := TRUE
END Cancel;
PROCEDURE [2] AbortHandler (dc: WinApi.HANDLE; error: INTEGER): INTEGER;
VAR res: INTEGER; msg: WinApi.MSG; s: ARRAY 32 OF CHAR;
BEGIN
WHILE WinApi.PeekMessageW(msg, 0, 0, 0, 1) # 0 DO
res := WinApi.TranslateMessage(msg);
(*
IF msg.message = WinApi.WMPaint THEN
res := WinApi.GetClassNameW(msg.wnd, s, LEN(s));
IF (s # "Oberon Doc") & (s # "Oberon Aux") THEN
res := WinApi.DispatchMessageW(msg)
END
ELSE
res := WinApi.DispatchMessageW(msg)
END
*)
res := WinApi.DispatchMessageW(msg)
END;
IF aborted THEN RETURN 0 ELSE RETURN 1 END
END AbortHandler;
PROCEDURE (c: TrapCleaner) Cleanup;
VAR res: INTEGER; p: Printer;
BEGIN
jobLevel := 0;
p := c.p;
res := WinApi.AbortDoc(p.ThisPort()(HostPorts.Port).dc);
res := WinApi.DeleteDC(p.ThisPort()(HostPorts.Port).dc);
res := WinApi.EnableWindow(HostWindows.main, 1);
HostPorts.ResetColors;
IF p.cancel # NIL THEN Windows.dir.Close(p.cancel); p.cancel := NIL END
END Cleanup;
(* Printer *)
(*
PROCEDURE (p: Printer) NewRider (): Rider;
VAR r: Rider;
BEGIN
ASSERT(p.port # NIL, 20); ASSERT(p.port.dc # 0, 21);
NEW(r); r.p := p; r.InitPort(p.port);
RETURN r
END NewRider;
*)
PROCEDURE (p: Printer) OpenJob (VAR copies: INTEGER; name: ARRAY OF CHAR);
VAR res: INTEGER; info: WinApi.DOCINFOW; s: Stores.Store; port: HostPorts.Port;
BEGIN
IF jobLevel = 0 THEN
aborted := FALSE; copies := 1;
port := p.ThisPort()(HostPorts.Port);
port.SetDC(PrinterDC(p.devNames, p.devMode), 0);
p.res := Error(WinApi.SetAbortProc(port.dc, AbortHandler));
IF p.res = 0 THEN
(* open cancel dialog *)
printing.pnum := 0;
HostWindows.dir.unmoveable := TRUE;
Dialog.Call(dialogCommand, " ", res);
HostWindows.dir.unmoveable := FALSE;
p.cancel := Windows.dir.First();
(* install trap cleaner *)
NEW(p.clean); p.clean.p := p;
Kernel.PushTrapCleaner(p.clean);
(* start printing *)
info.cbSize := SIZE(WinApi.DOCINFOW);
info.lpszDocName := name;
info.lpszOutput := NIL;
p.res := Error(WinApi.StartDocW(port.dc, info));
HostPorts.SetPrinterColors;
res := WinApi.EnableWindow(HostWindows.main, 0)
END;
port.SetDC(port.dc, 0) (* reinitialize dc *)
END;
INC(jobLevel)
END OpenJob;
PROCEDURE (p: Printer) CloseJob;
VAR res: INTEGER; port: HostPorts.Port;
BEGIN
IF jobLevel = 1 THEN
port := p.ThisPort()(HostPorts.Port);
IF aborted THEN p.res := Error(WinApi.AbortDoc(port.dc))
ELSE p.res := Error(WinApi.EndDoc(port.dc))
END;
res := WinApi.DeleteDC(port.dc);
res := WinApi.EnableWindow(HostWindows.main, 1);
HostPorts.ResetColors;
IF p.cancel # NIL THEN Windows.dir.Close(p.cancel); p.cancel := NIL END;
Kernel.PopTrapCleaner(p.clean)
END;
DEC(jobLevel)
END CloseJob;
PROCEDURE (p: Printer) OpenPage;
VAR res: INTEGER; port: HostPorts.Port;
BEGIN
port := p.ThisPort()(HostPorts.Port);
IF ~aborted THEN p.res := Error(WinApi.StartPage(port.dc)) END;
printing.pnum := Printing.Current() (* Printing.par.page.current *) + 1;
Dialog.Update(printing);
res := WinApi.UpdateWindow(p.cancel(HostWindows.Window).wnd);
port.SetDC(port.dc, 0) (* reinitialize dc *)
END OpenPage;
PROCEDURE (p: Printer) ClosePage;
BEGIN
IF ~aborted THEN p.res := Error(WinApi.EndPage(p.ThisPort()(HostPorts.Port).dc)) END
END ClosePage;
PROCEDURE (p: Printer) SetOrientation (landscape: BOOLEAN);
VAR res, w, h: INTEGER; dc: WinApi.HANDLE; dm: WinApi.PtrDEVMODEW;
BEGIN
GetPage(p, w, h);
IF (w > h) # landscape THEN
dm := SYSTEM.VAL(WinApi.PtrDEVMODEW, WinApi.GlobalLock(p.devMode));
IF landscape THEN dm.dmOrientation := WinApi.DMORIENT_LANDSCAPE
ELSE dm.dmOrientation := WinApi.DMORIENT_PORTRAIT
END;
dm.dmFields := dm.dmFields + WinApi.DM_ORIENTATION;
res := WinApi.GlobalUnlock(p.devMode);
dc := PrinterDC(p.devNames, p.devMode);
SetupPrinter(p, dc);
res := WinApi.DeleteDC(dc)
END
END SetOrientation;
(*
PROCEDURE (p: Printer) SetSize (w, h: INTEGER);
BEGIN
p.w := w; p.h := h
END SetSize;
PROCEDURE (p: Printer) OpenBuffer (l, t, r, b: INTEGER);
END OpenBuffer;
PROCEDURE (p: Printer) CloseBuffer;
END CloseBuffer;
PROCEDURE (p: Printer) GetSize (OUT w, h: INTEGER);
BEGIN
w := p.w; h := p.h
END GetSize;
*)
(* Rider *)
(*
PROCEDURE (rd: Rider) Base (): Ports.Port;
BEGIN
RETURN rd.p
END Base;
*)
(* Directory *)
PROCEDURE (d: Directory) Default (): Printers.Printer;
VAR res: INTEGER; prt: WinDlg.PRINTDLGW;
BEGIN
prt.lStructSize := SIZE(WinDlg.PRINTDLGW);
prt.hDevMode := 0; prt.hDevNames := 0; prt.hwndOwner := 0;
prt.Flags := {7, 10}; (* no warning, return default *)
res := WinDlg.PrintDlgW(prt);
IF res # 0 THEN
RETURN NewPrinter(prt.hDevNames, prt.hDevMode)
ELSE
(*
res := WinApi.CommDlgExtendedError();
ASSERT(res = 1008H, 100); (* no default printer *)
*)
RETURN NIL
END
END Default;
PROCEDURE (d: Directory) Current (): Printers.Printer;
BEGIN
RETURN current
END Current;
PROCEDURE (d: Directory) Available (): BOOLEAN;
BEGIN
RETURN current # NIL
END Available;
PROCEDURE Init;
BEGIN
printing.Cancel := Cancel;
NEW(dir); Printers.SetDir(dir);
current := dir.Default()
END Init;
BEGIN
Init
END HostPrinters.