home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 555a.lha / FontList / source / HardCopy.mod < prev    next >
Encoding:
Modula Implementation  |  1991-09-19  |  3.7 KB  |  99 lines
  1. (*------------------------------------------------------------------------------
  2.     Project    : HardCopy
  3.     Module    : HardCopy.mod
  4.     Author    : Robert Brandner (rb)
  5.     Address    : Schillerstr. 3 / A-8280 Fürstenfeld / AUSTRIA / EUROPE
  6.     Copyright    : Public Domain
  7.     Language    : Modula-II (M2Amiga V4.0d)
  8.     History    : V0.99, 25-Mar 91, rb
  9.     History    :      , 22-Aug 91, rb adaptiert und optimiert für V4.0d
  10.     Contents    : Hardcopy eines Rastports erzeugen.
  11. ------------------------------------------------------------------------------*)
  12.  
  13. (*$ StackChk    := FALSE *)
  14. (*$ RangeChk    := FALSE *)
  15. (*$ OverflowChk := FALSE *)
  16. (*$ ReturnChk   := FALSE *)
  17. (*$ LongAlign   := FALSE *) (* make this TRUE for MC680x0, x>1 *)
  18. (*$ Volatile    := FALSE *)
  19. (*$ LargeVars   := FALSE *)
  20. (*$ StackParms  := FALSE *)
  21.  
  22. IMPLEMENTATION MODULE HardCopy;
  23.  
  24. FROM Printer     IMPORT IODRPReqPtr,IODRPReq,Special,SpecialSet,
  25.                         dumpRPort,Error;
  26. FROM ExecSupport IMPORT CreatePort,CreateExtIO,DeletePort,DeleteExtIO;
  27. FROM ExecD       IMPORT MsgPortPtr;
  28. FROM ExecL       IMPORT DoIO,OpenDevice,CloseDevice;
  29. FROM SYSTEM      IMPORT ADR,LONGSET;
  30. FROM GraphicsD   IMPORT RastPortPtr,ViewModeSet,ColorMapPtr;
  31.  
  32. (*--- Öffnen des Printer Devices ---------------------------------------------*)
  33.  
  34. PROCEDURE OpenPrinter(request:IODRPReqPtr):BOOLEAN;
  35. BEGIN
  36.   OpenDevice(ADR("printer.device"),0,request,LONGSET{});
  37.   RETURN (request^.error=noErr);
  38. END OpenPrinter;
  39.  
  40. (*--- Erzeugen eines IO-Requests ---------------------------------------------*)
  41.  
  42. PROCEDURE CreateIOReq():IODRPReqPtr;
  43. VAR printport:MsgPortPtr;
  44.     req:IODRPReqPtr;
  45. BEGIN
  46.   printport:=CreatePort(NIL,0);                     (* MessagePort erzeugen *)
  47.   IF printport=NIL THEN RETURN NIL END;               (* nicht geklappt->NIL  *)
  48.   req:=CreateExtIO(printport,SIZE(IODRPReq));         (* IORequest erzeugen   *)
  49.   IF req=NIL THEN                          (* wenn nicht geklappt  *)
  50.     DeletePort(printport)                       (* Port wieder schließen*)
  51.   END;
  52.   RETURN req;                              (* Request als Ergebnis *)
  53. END CreateIOReq;
  54.  
  55. (*--- Port und IORequest wieder schließen ------------------------------------*)
  56.  
  57. PROCEDURE CleanUp(VAR req:IODRPReqPtr);
  58. VAR port:MsgPortPtr;
  59. BEGIN
  60.   IF req#NIL THEN
  61.     port:=(req^.message.replyPort);
  62.     DeleteExtIO(req); req:=NIL;
  63.     DeletePort(port);
  64.   END;
  65. END CleanUp;
  66.  
  67. (*--- Hardcopy ausgeben, mittels Printer Device ------------------------------*)
  68.  
  69. PROCEDURE DumpRPort(rp:RastPortPtr;cm:ColorMapPtr;vm:ViewModeSet;
  70.                     x0,y0,w,h:CARDINAL;prtw,prth:LONGINT;
  71.                     s:SpecialSet;VAR err:Error):BOOLEAN;
  72. VAR request:IODRPReqPtr;
  73. BEGIN
  74.   request:=CreateIOReq();            (* Request erzeugen           *)
  75.   IF request=NIL THEN RETURN FALSE END;     (* Fehler melden.             *)
  76.   IF NOT OpenPrinter(request) THEN          (* Versuche Printer zu öffnen *)
  77.     CleanUp(request);                     (* nicht ok: Request entfernen*)
  78.     RETURN FALSE                 (* Fehler melden.          *)
  79.   END;
  80.   WITH request^ DO                (* Request-Struktur beschreib.*)
  81.     command:=dumpRPort;                (* Ich will eine Hardcopy     *)
  82.     rastPort:=rp;                 (* von diesem Rastport, und   *)
  83.     colorMap:=cm;                 (* mit diesen Farben.         *)
  84.     modes:=vm;                    (* Hires oder Lace Screen ?   *)
  85.     srcX:=x0; srcY:=y0;                (* Ausschnitt des Rastport    *)
  86.     srcWidth:=w; srcHeight:=h;            (* der gedruckt werden soll.  *)
  87.     destCols:=prtw; destRows:=prth;        (* Größe des Ausdrucks.       *)
  88.     special:=s;                    (* SpecialFlags siehe [RKM]   *)
  89.   END;
  90.   DoIO(request);                (* Request an Printer schicken*)
  91.   err:=request^.error;                (* event. Fehler merken       *)
  92.   CloseDevice(request);                (* Device schließen.          *)
  93.   CleanUp(request);                (* Request entfernen.         *)
  94.   RETURN (err=noErr);                (* Ergebnis zurückgeben.      *)
  95. END DumpRPort;
  96.  
  97. END HardCopy.mod
  98.  
  99.