(FILECREATED "20-Oct-86 11:27:09" {ROSEBOWL}<RCLARKE>MICROTEKPRINT.;4 7434   

      changes to:  (FNS MT.CREATEPRINTMASTER MT.PRINT.MENU MT.CREATEPRINT MT.SELECT.SCALEFACTOR)
		   (VARS MICROTEKPRINTCOMS)

      previous date: " 9-Oct-86 14:23:21" {ROSEBOWL}<RCLARKE>MICROTEKPRINT.;1)


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

(PRETTYCOMPRINT MICROTEKPRINTCOMS)

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

(MT.PRINT.MENU
  [LAMBDA NIL                                                (* rdc "14-Oct-86 14:42")
    (PROG (MENU.DESCRIPTION)
	    [SETQ MENU.DESCRIPTION
	      (BQUOTE ((TYPE MOMENTARY LABEL "PRINT" LEFT 0 BOTTOM 5 FONT (MODERN 10 BOLD)
			       SELECTEDFN MT.CREATEPRINT)
			 (TYPE NCHOOSE LABEL "" LEFT 40 BOTTOM 5 ID PRINTERTYPE ITEMS (8044 4045))
			 (TYPE TITLE LABEL XPOS FONT (MODERN 10 BOLD)
			       LEFT 100 BOTTOM 5)
			 (TYPE EDIT ID XPOS LABEL 0 MAXWIDTH 45 EDITSTOPFLG T LEFT 130 BOTTOM 5)
			 (TYPE TITLE LABEL YPOS FONT (MODERN 10 BOLD)
			       LEFT 180 BOTTOM 5)
			 (TYPE EDIT ID YPOS LABEL 0 MAXWIDTH 45 EDITSTOPFLG T LEFT 210 BOTTOM 5)
			 (TYPE MOMENTARY LABEL SCALE FONT (MODERN 10 BOLD)
			       LEFT 265 BOTTOM 5 SELECTEDFN MT.SELECT.SCALEFACTOR)
			 (TYPE EDIT LABEL "1:1" ID SCALEFACTOR LEFT 300 BOTTOM 5)
			 (WINDOWPROPS TITLE "Microtek Print Menu" BORDER 5]
	    (SETQ MT.PRINT.MENUWINDOW (FM.MAKEMENU MENU.DESCRIPTION))
	    (FM.CHANGESTATE (FM.ITEMFROMID MT.PRINT.MENUWINDOW (QUOTE PRINTERTYPE))
			      MT.PRINT.MENUWINDOW
			      (QUOTE 8044))
	    (OPENW MT.PRINT.MENUWINDOW)
	    (ATTACHWINDOW MT.PRINT.MENUWINDOW MT.DISPLAY.MENUWINDOW (QUOTE BOTTOM)
			    (QUOTE JUSTIFY])

(MT.CREATEPRINT
  [LAMBDA NIL                                                (* rdc "14-Oct-86 15:22")
    (PROG NIL
	    (if (AND [BOUNDP (SETQ BITMAP (MKATOM (LISTGET (FM.READSTATE 
									    MT.DISPLAY.MENUWINDOW)
								       (QUOTE BITMAPNAME]
			 (BITMAPP (SETQ BITMAP (EVAL BITMAP)))
			 (if (OR [AND (EQ (MKATOM (LISTGET (FM.READSTATE 
									      MT.PRINT.MENUWINDOW)
								       (QUOTE PRINTERTYPE)))
						  4045)
					    (FMEMB (MKATOM (LISTGET (FM.READSTATE 
									      MT.PRINT.MENUWINDOW)
									  (QUOTE SCALEFACTOR)))
						     (QUOTE (4:1 2:1 1:1 1:2 1:4]
				     (EQ (MKATOM (LISTGET (FM.READSTATE MT.PRINT.MENUWINDOW)
								(QUOTE 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.READSTATE 
									      MT.PRINT.MENUWINDOW)
									   (QUOTE XPOS)))
					       (MKATOM (LISTGET (FM.READSTATE 
									      MT.PRINT.MENUWINDOW)
								    (QUOTE YPOS)))
					       (MKATOM (LISTGET (FM.READSTATE 
									      MT.PRINT.MENUWINDOW)
								    (QUOTE SCALEFACTOR]
	      else (FLASHWINDOW MT.STATUSWINDOW 3)
		     (MT.PRINT.STATUS "This atom is not a bitmap")
		     (RETURN NIL])

(MT.CREATEPRINTMASTER
  [LAMBDA (BITMAP X Y SCALEFACTOR)                           (* rdc "17-Oct-86 15:45")
    (PROG (IPS SCANFACTOR SCALE)
	    [if (EQP (LISTGET (FM.READSTATE MT.PRINT.MENUWINDOW)
				    (QUOTE PRINTERTYPE))
			 8044)
		then (if [NOT (SETQ SCANFACTOR
				      (LISTGET (QUOTE (0 .24 5 .252 10 .266 15 .282 20 .3 25 .32 
							     33 .36 35 .369 40 .4 45 .439 50 .48 55 
							     .533 60 .6 67 .7200001 70 .8 75 .96))
						 (GETPROP (MKATOM (LISTGET (FM.READSTATE
										   
									    MT.DISPLAY.MENUWINDOW)
										 (QUOTE BITMAPNAME))
								      )
							    (QUOTE 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 (QUOTE {LPT}.IP)))
		       (SCALEDBITBLT BITMAP 0 0 IPS X Y 21590 27940 (QUOTE INPUT)
				       (QUOTE REPLACE)
				       NIL
				       (QUOTE (0 0 21590 27940))
				       (FTIMES SCALE SCANFACTOR))
	      else (if [NOT (SETQ SCANFACTOR
				    (LISTGET (QUOTE (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 (FM.READSTATE 
									    MT.DISPLAY.MENUWINDOW)
									       (QUOTE BITMAPNAME)))
							  (QUOTE 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 (QUOTE {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 (QUOTE INPUT)
				     (QUOTE REPLACE)
				     NIL
				     (QUOTE (0 0 2550 3300))
				     (FIXR (FTIMES SCALE SCANFACTOR]
	    (CLOSEF IPS)
	    (MT.PRINT.STATUS "Bitmap sent to printer"])

(MT.SELECT.SCALEFACTOR
  [LAMBDA NIL                                                (* rdc "14-Oct-86 15:24")
    (PROG [(PRINTERTYPE (LISTGET (FM.READSTATE MT.PRINT.MENUWINDOW)
				       (QUOTE PRINTERTYPE]
	    [if (EQP PRINTERTYPE 8044)
		then (SETQ FACTORS
			 (QUOTE (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 (QUOTE (4:1 2:1 1:1 1:2 1:4]
	    (FM.CHANGESTATE (FM.ITEMFROMID MT.PRINT.MENUWINDOW (QUOTE SCALEFACTOR))
			      MT.PRINT.MENUWINDOW
			      (MENU (create MENU
						ITEMS ← FACTORS])
)
(IF (AND (BOUNDP (QUOTE MT.DISPLAY.MENUWINDOW))
	 (OPENWP MT.DISPLAY.MENUWINDOW))
    THEN
    (MT.PRINT.MENU))
(PUTPROPS MICROTEKPRINT COPYRIGHT ("XEROX Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (695 7238 (MT.PRINT.MENU 705 . 1987) (MT.CREATEPRINT 1989 . 3557) (MT.CREATEPRINTMASTER 
3559 . 6605) (MT.SELECT.SCALEFACTOR 6607 . 7236)))))
STOP