(*------------------------------------------------------------------------------
    Project	: HardCopy
    Module	: HardCopy.mod
    Author	: Robert Brandner (rb)
    Address	: Schillerstr. 3 / A-8280 Fürstenfeld / AUSTRIA / EUROPE
    Copyright	: Public Domain
    Language	: Modula-II (M2Amiga V4.0d)
    History	: V0.99, 25-Mar 91, rb
    History	:      , 22-Aug 91, rb adaptiert und optimiert für V4.0d
    Contents	: Hardcopy eines Rastports erzeugen.
------------------------------------------------------------------------------*)

(*$ StackChk    := FALSE *)
(*$ RangeChk    := FALSE *)
(*$ OverflowChk := FALSE *)
(*$ ReturnChk   := FALSE *)
(*$ LongAlign   := FALSE *) (* make this TRUE for MC680x0, x>1 *)
(*$ Volatile	:= FALSE *)
(*$ LargeVars   := FALSE *)
(*$ StackParms  := FALSE *)

IMPLEMENTATION MODULE HardCopy;

FROM Printer     IMPORT IODRPReqPtr,IODRPReq,Special,SpecialSet,
                        dumpRPort,Error;
FROM ExecSupport IMPORT CreatePort,CreateExtIO,DeletePort,DeleteExtIO;
FROM ExecD       IMPORT MsgPortPtr;
FROM ExecL       IMPORT DoIO,OpenDevice,CloseDevice;
FROM SYSTEM      IMPORT ADR,LONGSET;
FROM GraphicsD   IMPORT RastPortPtr,ViewModeSet,ColorMapPtr;

(*--- Öffnen des Printer Devices ---------------------------------------------*)

PROCEDURE OpenPrinter(request:IODRPReqPtr):BOOLEAN;
BEGIN
  OpenDevice(ADR("printer.device"),0,request,LONGSET{});
  RETURN (request^.error=noErr);
END OpenPrinter;

(*--- Erzeugen eines IO-Requests ---------------------------------------------*)

PROCEDURE CreateIOReq():IODRPReqPtr;
VAR printport:MsgPortPtr;
    req:IODRPReqPtr;
BEGIN
  printport:=CreatePort(NIL,0); 	      	      (* MessagePort erzeugen *)
  IF printport=NIL THEN RETURN NIL END;               (* nicht geklappt->NIL  *)
  req:=CreateExtIO(printport,SIZE(IODRPReq));         (* IORequest erzeugen   *)
  IF req=NIL THEN			              (* wenn nicht geklappt  *)
    DeletePort(printport) 		              (* Port wieder schließen*)
  END;
  RETURN req;				              (* Request als Ergebnis *)
END CreateIOReq;

(*--- Port und IORequest wieder schließen ------------------------------------*)

PROCEDURE CleanUp(VAR req:IODRPReqPtr);
VAR port:MsgPortPtr;
BEGIN
  IF req#NIL THEN
    port:=(req^.message.replyPort);
    DeleteExtIO(req); req:=NIL;
    DeletePort(port);
  END;
END CleanUp;

(*--- Hardcopy ausgeben, mittels Printer Device ------------------------------*)

PROCEDURE DumpRPort(rp:RastPortPtr;cm:ColorMapPtr;vm:ViewModeSet;
                    x0,y0,w,h:CARDINAL;prtw,prth:LONGINT;
                    s:SpecialSet;VAR err:Error):BOOLEAN;
VAR request:IODRPReqPtr;
BEGIN
  request:=CreateIOReq();			(* Request erzeugen           *)
  IF request=NIL THEN RETURN FALSE END; 	(* Fehler melden.             *)
  IF NOT OpenPrinter(request) THEN      	(* Versuche Printer zu öffnen *)
    CleanUp(request); 		        	(* nicht ok: Request entfernen*)
    RETURN FALSE 				(* Fehler melden.	      *)
  END;
  WITH request^ DO				(* Request-Struktur beschreib.*)
    command:=dumpRPort;				(* Ich will eine Hardcopy     *)
    rastPort:=rp; 				(* von diesem Rastport, und   *)
    colorMap:=cm; 				(* mit diesen Farben.         *)
    modes:=vm;					(* Hires oder Lace Screen ?   *)
    srcX:=x0; srcY:=y0;				(* Ausschnitt des Rastport    *)
    srcWidth:=w; srcHeight:=h;			(* der gedruckt werden soll.  *)
    destCols:=prtw; destRows:=prth;		(* Größe des Ausdrucks.       *)
    special:=s;					(* SpecialFlags siehe [RKM]   *)
  END;
  DoIO(request);				(* Request an Printer schicken*)
  err:=request^.error;				(* event. Fehler merken       *)
  CloseDevice(request);				(* Device schließen.	      *)
  CleanUp(request);				(* Request entfernen.         *)
  RETURN (err=noErr);				(* Ergebnis zurückgeben.      *)
END DumpRPort;

END HardCopy.mod