MODULE WinPrinters;
(**
	project	= "BlackBox"
	organization	= "www.oberon.ch"
	contributors	= "Oberon microsystems, Josef Templ"
	version	= "System/Rsrc/About"
	copyright	= "System/Rsrc/About"
	license	= "Docu/BB-License"
	changes	= "
	- 20060316, jt, support for nested pairs of OpenJob/CloseJob
	- 20070131, bh, Unicode support
	- 20070327, bh, SetOrientation added
	- 20150515, center #48, dialogCommand improved, OpenPage with global page numbering
	- 20200311, Temirgaleev IE, improve logic with respect to StdCmds.result state
	"
	issues	= "
	- ...
	"

**)

	IMPORT
		SYSTEM, WinApi, WinDlg, WinGui, 
		Kernel, Files, Dialog, Ports, Stores, Models, Views, Controllers,
		Properties, Printers, Printing, Documents, Windows, StdCmds, 
		(*HostWindows := WinWindows,*)
		HostPorts := WinPorts;
		
	
	CONST
		eduMsgH = 30 * Ports.point;

		dialogCommand = "StdCmds.OpenToolDialog('Win/Rsrc/Printing', '#Std: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(WinGui.mainWnd, 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;
				(*to hell with unmoveability! HostWindows.dir.unmoveable := TRUE;*)
				Dialog.Call(dialogCommand, " ", res);
				(*HostWindows.dir.unmoveable := FALSE;*)
				IF (res = 0) & (StdCmds.result = 0) THEN
					p.cancel := Windows.dir.First()
				ELSE
					p.cancel := NIL
				END;
				(* 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(WinGui.mainWnd, 0)	(* What is it for? disables mouse and kbd input *)
			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(WinGui.mainWnd, 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;
		INC(printing.pnum);
		Dialog.Update(printing);
		IF p.cancel # NIL THEN 
			res := WinApi.UpdateWindow(p.cancel(HostWindows.Window).wnd); Windows.dir.Update(p.cancel)
		END;
		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 WinPrinters.

