(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "21-May-87 09:32:08" {DANTE}<RCLARKE>LYRIC>MICROTEKPRINT.;1 10463  

      changes to%:  (FNS MT.PRINT.MENU MT.GETXPOS MT.GETYPOS MT.CREATEPRINT MT.CREATEPRINTMASTER 
                         MT.SELECT.SCALEFACTOR)

      previous date%: "20-Oct-86 11:27:09" {DANTE}<RCLARKE>MICROTEKPRINT.;1)


(* "
Copyright (c) 1986, 1987 by XEROX Corporation.  All rights reserved.
")

(PRETTYCOMPRINT MICROTEKPRINTCOMS)

(RPAQQ MICROTEKPRINTCOMS [(P (FILESLOAD MICROTEK))
                          (FNS MT.PRINT.MENU MT.GETXPOS MT.GETYPOS MT.CREATEPRINT 
                               MT.CREATEPRINTMASTER MT.SELECT.SCALEFACTOR)
                          (P (IF (AND (BOUNDP 'MT.DISPLAY.MENUWINDOW)
                                      (OPENWP MT.DISPLAY.MENUWINDOW))
                                 THEN
                                 (MT.PRINT.MENU])
(FILESLOAD MICROTEK)
(DEFINEQ

(MT.PRINT.MENU
  [LAMBDA NIL                                     (* ; 
                                                 "Edited 21-May-87 09:23 by ronald clarke:xsis:xerox")

    (PROG (MENU.DESCRIPTION)
          [SETQ MENU.DESCRIPTION
           `(((PROPS ID MPRINT)
              (GROUP (PROPS FORMAT EXPLICIT COORDINATES GROUP BACKGROUND 23130)
                     (TYPE MOMENTARY LABEL "PRINT" BOX 3 LEFT 0 BOTTOM 2 FONT (MODERN 12 BOLD)
                           SELECTEDFN MT.CREATEPRINT)
                     (TYPE STATE LABEL "Printer!: " ID PRINTERTYPE MENUITEMS (8044 4045)
                           INITSTATE 8044 LINKS (DISPLAY (GROUP PRINTER))
                           FONT
                           (MODERN 10 BOLD)
                           BOX 1 LEFT 60 BOTTOM 3)
                     (TYPE DISPLAY ID PRINTER LABEL "" LEFT 115 BOTTOM 3 BOX 1 MAXWIDTH 30)
                     (TYPE MOMENTARY LABEL "XPOS!: " SELECTEDFN MT.GETXPOS FONT (MODERN 10 BOLD)
                           LEFT 175 BOTTOM 3 BOX 1)
                     (TYPE EDIT ID XPOS LABEL 0 MAXWIDTH 45 LEFT 220 BOTTOM 3 BOX 1)
                     (TYPE MOMENTARY LABEL "YPOS!: " SELECTEDFN MT.GETYPOS FONT (MODERN 10 BOLD)
                           LEFT 280 BOTTOM 3 BOX 1)
                     (TYPE EDIT ID YPOS LABEL 0 MAXWIDTH 45 LEFT 325 BOTTOM 3 BOX 1)
                     (TYPE MOMENTARY LABEL "SCALE!: " FONT (MODERN 10 BOLD)
                           LEFT 385 BOTTOM 3 BOX 1 SELECTEDFN MT.SELECT.SCALEFACTOR)
                     (TYPE EDIT LABEL "1:1" ID SCALEFACTOR LEFT 435 BOTTOM 3 BOX 1]
          (SETQ MT.PRINT.MENUWINDOW (FREEMENU MENU.DESCRIPTION "Microtek Print Menu" 23130 5))
          (OPENW MT.PRINT.MENUWINDOW)
          (ATTACHWINDOW MT.PRINT.MENUWINDOW MT.DISPLAY.MENUWINDOW 'BOTTOM 'JUSTIFY])

(MT.GETXPOS
  [LAMBDA NIL                                     (* ; 
                                                 "Edited 21-May-87 09:15 by ronald clarke:xsis:xerox")

    (FM.EDITITEM (FM.GETITEM 'XPOS NIL MT.PRINT.MENUWINDOW)
           MT.PRINT.MENUWINDOW])

(MT.GETYPOS
  [LAMBDA NIL                                     (* ; 
                                                 "Edited 21-May-87 09:17 by ronald clarke:xsis:xerox")

    (FM.EDITITEM (FM.GETITEM 'YPOS NIL MT.PRINT.MENUWINDOW)
           MT.PRINT.MENUWINDOW])

(MT.CREATEPRINT
  [LAMBDA NIL                                     (* ; 
                                                 "Edited 21-May-87 09:29 by ronald clarke:xsis:xerox")

    (PROG NIL
          (if (AND [BOUNDP (SETQ BITMAP (MKATOM (LISTGET (FM.GETSTATE MT.DISPLAY.MENUWINDOW)
                                                       'BITMAPNAME]
                   (BITMAPP (SETQ BITMAP (EVAL BITMAP)))
                   (if (OR [AND (EQ (MKATOM (LISTGET (FM.GETSTATE MT.PRINT.MENUWINDOW)
                                                   'PRINTERTYPE))
                                    4045)
                                (FMEMB (MKATOM (LISTGET (FM.GETSTATE MT.PRINT.MENUWINDOW)
                                                      'SCALEFACTOR))
                                       '(4%:1 2%:1 1%:1 1%:2 1%:4]
                           (EQ (MKATOM (LISTGET (FM.GETSTATE MT.PRINT.MENUWINDOW)
                                              'PRINTERTYPE))
                               8044))
                       then T
                     else (FLASHWINDOW MT.STATUSWINDOW 3)
                          (MT.PRINT.STATUS "Not a valid scale for 4045 printer")
                          (RETURN NIL)))
              then (MT.PRINT.STATUS "")
                   [MT.CREATEPRINTMASTER BITMAP (MKATOM (LISTGET (FM.GETSTATE MT.PRINT.MENUWINDOW)
                                                               'XPOS))
                          (MKATOM (LISTGET (FM.GETSTATE MT.PRINT.MENUWINDOW)
                                         'YPOS))
                          (MKATOM (LISTGET (FM.GETSTATE MT.PRINT.MENUWINDOW)
                                         'SCALEFACTOR]
            else (FLASHWINDOW MT.STATUSWINDOW 3)
                 (MT.PRINT.STATUS "This atom is not a bitmap")
                 (RETURN NIL])

(MT.CREATEPRINTMASTER
  [LAMBDA (BITMAP X Y SCALEFACTOR)                (* ; 
                                                 "Edited 21-May-87 09:31 by ronald clarke:xsis:xerox")

    (PROG (IPS SCANFACTOR SCALE)
          [if (EQP (LISTGET (FM.GETSTATE MT.PRINT.MENUWINDOW)
                          'PRINTERTYPE)
                   8044)
              then (if [NOT (SETQ SCANFACTOR
                             (LISTGET '(0 0.24 5 0.252 10 0.266 15 0.282 20 0.3 25 0.32 33 0.36 35 
                                          0.369 40 0.4 45 0.439 50 0.48 55 0.533 60 0.6 67 0.7200001 
                                          70 0.8 75 0.96) (GETPROP (MKATOM (LISTGET (FM.GETSTATE
                                                                                     
                                                                                MT.DISPLAY.MENUWINDOW
                                                                                     )
                                                                                  'BITMAPNAME))
                                                                 'RESOLUTION]
                       then (MT.PRINT.STATUS "")
                            (FLASHWINDOW MT.STATUSWINDOW 3)
                            (if [NOT (NUMBERP (SETQ SCANFACTOR (MKATOM (PROMPTFORWORD 
                                                        "Resolution not on Bitmap proplist. Enter #:" 
                                                                              "1" NIL MT.STATUSWINDOW
                                                                              ]
                                then (FLASHWINDOW MT.STATUSWINDOW 2)
                                     (MT.PRINT.STATUS "This is not a number")
                                     (RETURN NIL))
                            (MT.PRINT.STATUS ""))
                   [SETQ SCALE (FQUOTIENT (CAR (UNPACK SCALEFACTOR))
                                      (CADDR (UNPACK SCALEFACTOR]
                   (SETQ IPS (OPENIMAGESTREAM '{LPT}.IP))
                   (SCALEDBITBLT BITMAP 0 0 IPS X Y 21590 27940 'INPUT 'REPLACE NIL
                          '(0 0 21590 27940)
                          (FTIMES SCALE SCANFACTOR))
            else (if [NOT (SETQ SCANFACTOR
                           (LISTGET '(0 1 5 1 10 1 15 1 20 1 25 1 33 1 35 1 40 2 45 2 50 2 55 2 60 2 
                                        67 4 70 4 75 4) (GETPROP (MKATOM (LISTGET (FMGETSTATE 
                                                                                MT.DISPLAY.MENUWINDOW
                                                                                         )
                                                                                'BITMAPNAME))
                                                               'RESOLUTION]
                     then (MT.PRINT.STATUS "")
                          (FLASHWINDOW MT.STATUSWINDOW 3)
                          (if [NOT (NUMBERP (SETQ SCANFACTOR (MKATOM (PROMPTFORWORD 
                                                        "Resolution not on Bitmap proplist. Enter #:" 
                                                                            "1" NIL MT.STATUSWINDOW]
                              then (FLASHWINDOW MT.STATUSWINDOW 2)
                                   (MT.PRINT.STATUS "This is not a number")
                                   (RETURN NIL))
                          (MT.PRINT.STATUS ""))
                 [SETQ SCALE (FQUOTIENT (CAR (UNPACK SCALEFACTOR))
                                    (CADDR (UNPACK SCALEFACTOR]
                 (SETQ IPS (OPENIMAGESTREAM '{LPT}.4045XLP))
                 (if (GREATERP (FTIMES SCALE SCANFACTOR)
                            4)
                     then (FLASHWINDOW MT.STATUSWINDOW 2)
                          (MT.PRINT.STATUS "Not a valid scale for reduction used on this bitmap")
                          (RETURN NIL))
                 (SCALEDBITBLT BITMAP 0 0 IPS X Y 2550 3300 'INPUT 'REPLACE NIL
                        '(0 0 2550 3300)
                        (FIXR (FTIMES SCALE SCANFACTOR]
          (CLOSEF IPS)
          (MT.PRINT.STATUS "Bitmap sent to printer"])

(MT.SELECT.SCALEFACTOR
  [LAMBDA NIL                                     (* ; 
                                                 "Edited 21-May-87 09:26 by ronald clarke:xsis:xerox")

    (PROG [(PRINTERTYPE (LISTGET (FM.GETSTATE MT.PRINT.MENUWINDOW)
                               'PRINTERTYPE]
          [if (EQP PRINTERTYPE 8044)
              then (SETQ FACTORS
                    '(8%:1 7%:1 6%:1 5%:1 4%:1 3%:1 2%:1 1%:1 1%:2 1%:3 1%:4 1%:5 1%:6 1%:7 1%:8))
            else (SETQ FACTORS '(4%:1 2%:1 1%:1 1%:2 1%:4]
          (FM.CHANGESTATE (FM.GETITEM 'SCALEFACTOR NIL MT.PRINT.MENUWINDOW)
                 (MENU (create MENU
                              ITEMS ← FACTORS))
                 MT.PRINT.MENUWINDOW])
)
(IF (AND (BOUNDP 'MT.DISPLAY.MENUWINDOW)
         (OPENWP MT.DISPLAY.MENUWINDOW))
    THEN
    (MT.PRINT.MENU))
(PUTPROPS MICROTEKPRINT COPYRIGHT ("XEROX Corporation" 1986 1987))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (953 10261 (MT.PRINT.MENU 963 . 2789) (MT.GETXPOS 2791 . 3071) (MT.GETYPOS 3073 . 3353) 
(MT.CREATEPRINT 3355 . 5229) (MT.CREATEPRINTMASTER 5231 . 9504) (MT.SELECT.SCALEFACTOR 9506 . 10259)))
))
STOP