(FILECREATED "25-Feb-86 17:26:50" {ERIS}<LISPCORE>LIBRARY>IMAGEOBJ.;9 26496  

      changes to:  (FNS BITMAPOBJ.SNAPW COERCETOBITMAP BMOBJ.DISPLAYFN)

      previous date: " 9-Feb-86 15:43:18" {ERIS}<LISPCORE>LIBRARY>IMAGEOBJ.;8)


(* Copyright (c) 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT IMAGEOBJCOMS)

(RPAQQ IMAGEOBJCOMS ((COMS (* Bit-map image objects)
                               (FNS BITMAPTEDITOBJ COERCETOBITMAP WINDOWTITLEFONT \PRINTBINARYBITMAP 
                                    \READBINARYBITMAP)
                               (* fns for the bitmap tedit object.)
                               (FNS BMOBJ.BUTTONEVENTINFN BMOBJ.COPYFN BMOBJ.DISPLAYFN 
                                    BMOBJ.IMAGEBOXFN BMOBJ.PUTFN BMOBJ.INIT BMOBJ.GETFN3 
                                    BMOBJ.CREATE.MENU)
                               (FNS SCALED.BITMAP.GETFN BMOBJ.GETFN BMOBJ.GETFN2)
                               (* GETFNs for backward compatibility with older objects.)
                               (RECORDS BITMAPOBJ)
                               (* make ↑O be a character that inserts an object read from the user.)
                               (GLOBALVARS (BITMAP.OBJ.MENU))
                               (ADDVARS (BackgroundCopyMenuCommands (SNAP (FUNCTION (BITMAPOBJ.SNAPW)
                                                                                 )
                                                                          
                                                       "prompts for an area of the screen to insert."
                                                                          ))
                                      (IMAGEOBJGETFNS (BMOBJ.GETFN))
                                      (IMAGEOBJGETFNS (BMOBJ.GETFN2))
                                      (IMAGEOBJGETFNS (SCALED.BITMAP.GETFN)))
                               (VARS (BackgroundCopyMenu))
                               (FNS GET.OBJ.FROM.USER BITMAPOBJ.SNAPW PROMPTFOREVALED)
                               (DECLARE: DONTEVAL@LOAD DOCOPY (P (BMOBJ.INIT)
                                                                 (TEDIT.SETFUNCTION
                                                                  (CHARCODE ↑O)
                                                                  (FUNCTION GET.OBJ.FROM.USER)
                                                                  TEDIT.READTABLE)))
                               (FILES EDITBITMAP))))



(* Bit-map image objects)

(DEFINEQ

(BITMAPTEDITOBJ
  [LAMBDA (BITMAP SCALEFACTOR ROTATION)                      (* jds "20-Feb-85 14:10")
                                                             (* returns the tedit obj which gives the functional 
							     information for a bitmap object in a tedit file.)
    (IMAGEOBJCREATE (create BITMAPOBJ
			    BITMAP ← BITMAP
			    BMOBJSCALEFACTOR ←(OR SCALEFACTOR 1)
			    BMOBJROTATION ←(OR ROTATION 0))
		    BITMAPIMAGEFNS])

(COERCETOBITMAP
  (LAMBDA (BMSPEC)                                                    (* kbr: 
                                                                          "25-Feb-86 17:09")
                                                                          (* tries to interpret 
                                                                          X as a spec for a 
                                                                          bitmap.)
    (PROG (BM CR)
          (RETURN (COND
                     ((BITMAPP BMSPEC)
                      BMSPEC)
                     ((LITATOM BMSPEC)                                    (* use value.)
                      (COND
                         ((BITMAPP (EVALV BMSPEC (QUOTE COERCETOBITMAP))))))
                     ((REGIONP BMSPEC)                                    (* if BMSPEC is a 
                                                                          region, treat it as a 
                                                                          region of the screen.)
                      (SETQ BM (BITMAPCREATE (fetch (REGION WIDTH) of BMSPEC)
                                      (fetch (REGION HEIGHT) of BMSPEC)
                                      (BITSPERPIXEL (SCREENBITMAP))))
                      (BITBLT (SCREENBITMAP)
                             (fetch (REGION LEFT) of BMSPEC)
                             (fetch (REGION BOTTOM) of BMSPEC)
                             BM 0 0 NIL NIL (QUOTE INPUT)
                             (QUOTE REPLACE))
                      BM)
                     ((type? SCREENREGION BMSPEC)                     (* if BMSPEC is a 
                                                                          screenregion)
                      (SETQ BM (BITMAPCREATE (fetch (SCREENREGION WIDTH) of BMSPEC)
                                      (fetch (SCREENREGION HEIGHT) of BMSPEC)
                                      (BITSPERPIXEL (SCREENBITMAP (fetch (SCREENREGION SCREEN)
                                                                     of BMSPEC)))))
                      (BITBLT (SCREENBITMAP (fetch (SCREENREGION SCREEN) of BMSPEC))
                             (fetch (SCREENREGION LEFT) of BMSPEC)
                             (fetch (SCREENREGION BOTTOM) of BMSPEC)
                             BM 0 0 NIL NIL (QUOTE INPUT)
                             (QUOTE REPLACE))
                      BM)
                     ((WINDOWP BMSPEC)
                      (SETQ BM (BITMAPCREATE (WINDOWPROP BMSPEC (QUOTE WIDTH))
                                      (WINDOWPROP BMSPEC (QUOTE HEIGHT))
                                      (BITSPERPIXEL BMSPEC)))             (* open the window and 
                                                                          bring it to the top.)
                      (TOTOPW BMSPEC)
                      (SETQ CR (DSPCLIPPINGREGION NIL BMSPEC))
                      (BITBLT BMSPEC (fetch LEFT of CR)
                             (fetch BOTTOM of CR)
                             BM 0 0 (fetch WIDTH of CR)
                             (fetch HEIGHT of CR))
                      BM))))))

(WINDOWTITLEFONT
  [LAMBDA (FONT)                                             (* rrb " 1-Feb-84 15:26")
                                                             (* reset type of function that changes the title font)
    (DSPFONT FONT WindowTitleDisplayStream])

(\PRINTBINARYBITMAP
  [LAMBDA (BITMAP STREAM)                                    (* rrb "23-Jul-84 15:16")

          (* * prints the representation of a bitmap onto STREAM in a form that can be read back by \READBINARYBITMAP.)


    (PROG ((STREAM (GETSTREAM STREAM (QUOTE OUTPUT)))
	   BMH)
          (OR (BITMAPP BITMAP)
	      (\ILLEGAL.ARG BITMAP))
          (\WOUT STREAM (BITMAPWIDTH BITMAP))
          (\WOUT STREAM (SETQ BMH (BITMAPHEIGHT BITMAP)))
          (\WOUT STREAM (BITSPERPIXEL BITMAP))
          (\BOUTS STREAM (fetch (BITMAP BITMAPBASE) of BITMAP)
		  0
		  (ITIMES (fetch (BITMAP BITMAPRASTERWIDTH) of BITMAP)
			  BMH BYTESPERWORD))
          (RETURN BITMAP])

(\READBINARYBITMAP
  [LAMBDA (STREAM)                                           (* rrb "23-Jul-84 15:17")

          (* * reads a bitmap printed on STREAM by \PRINTBINARYBITMAP.)


    (SETQ STREAM (GETSTREAM STREAM (QUOTE INPUT)))
    (PROG ((BMW (\WIN STREAM))
	   (BMH (\WIN STREAM))
	   (BPP (\WIN STREAM))
	   BITMAP)
          (SETQ BITMAP (BITMAPCREATE BMW BMH BPP))
          (\BINS STREAM (fetch (BITMAP BITMAPBASE) of BITMAP)
		 0
		 (ITIMES (fetch (BITMAP BITMAPRASTERWIDTH) of BITMAP)
			 BMH BYTESPERWORD))
          (RETURN BITMAP])
)



(* fns for the bitmap tedit object.)

(DEFINEQ

(BMOBJ.BUTTONEVENTINFN
  [LAMBDA (IMAGEOBJ WINDOW)                                  (* jds "30-Oct-85 14:46")

          (* * the user has pressed a button inside the bitmap object IMAGEOBJ. Bring up a menu of bitmap edit operations.)


    (PROG* ((OBJ (IMAGEOBJPROP IMAGEOBJ (QUOTE OBJECTDATUM)))
	    (OLDSCALE (fetch (BITMAPOBJ BMOBJSCALEFACTOR) of OBJ))
	    NEW.BITMAP COMMAND.MENU COMMAND PREVIOUS.BITMAP NAME TEMP X Y)
           (SETQ PREVIOUS.BITMAP (BITMAPCOPY (fetch (BITMAPOBJ BITMAP) of OBJ)))
           (SETQ NEW.BITMAP (SELECTQ [MENU (COND
						   ((type? MENU BITMAP.OBJ.MENU)
						     BITMAP.OBJ.MENU)
						   (T (SETQ BITMAP.OBJ.MENU (BMOBJ.CREATE.MENU]
					 (CHANGE.SCALE       (* Change the scale on the bitmap.)
					   (replace (BITMAPOBJ BMOBJSCALEFACTOR) of OBJ
					      with (OR (NUMBERP (MKATOM (TEDIT.GETINPUT
										  (TEXTOBJ WINDOW)
										  "Scale Factor:  " 
										  OLDSCALE)))
							   OLDSCALE))
                                                             (* Return the prevous bitmap, so we don't change the 
							     bits.)
					   PREVIOUS.BITMAP)
					 (HAND.EDIT (EDITBM PREVIOUS.BITMAP))
					 (TRIM (TRIM.BITMAP PREVIOUS.BITMAP))
					 (INVERT.HORIZONTALLY (INVERT.BITMAP.HORIZONTALLY 
										  PREVIOUS.BITMAP))
					 (INVERT.VERTICALLY (INVERT.BITMAP.VERTICALLY 
										  PREVIOUS.BITMAP))
					 (INVERT.DIAGONALLY (INVERT.BITMAP.DIAGONALLY 
										  PREVIOUS.BITMAP))
					 (ROTATE.BITMAP.LEFT (ROTATE.BITMAP.LEFT PREVIOUS.BITMAP))
					 (ROTATE.BITMAP.RIGHT (ROTATE.BITMAP.RIGHT 
										  PREVIOUS.BITMAP))
					 (SHIFT.LEFT (INTERACT&SHIFT.BITMAP.LEFT PREVIOUS.BITMAP))
					 (SHIFT.RIGHT (INTERACT&SHIFT.BITMAP.RIGHT PREVIOUS.BITMAP))
					 (SHIFT.DOWN (INTERACT&SHIFT.BITMAP.DOWN PREVIOUS.BITMAP))
					 (SHIFT.UP (INTERACT&SHIFT.BITMAP.UP PREVIOUS.BITMAP))
					 (INTERCHANGE.BLACK/WHITE (INVERT.BITMAP.B/W 
										  PREVIOUS.BITMAP))
					 (ADD.BORDER (INTERACT&ADD.BORDER.TO.BITMAP PREVIOUS.BITMAP)
						     )
					 (RETURN NIL)))
           (replace (BITMAPOBJ BITMAP) of OBJ with NEW.BITMAP)
           (IMAGEOBJPROP IMAGEOBJ (QUOTE CACHED.BITMAP)
			   NIL)                              (* And clear any cached shrunk bitmaps so the display 
							     looks reasonable.)
           (RETURN (QUOTE CHANGED])

(BMOBJ.COPYFN
  [LAMBDA (IMAGEOBJ)                                         (* rrb " 1-Feb-84 16:00")
                                                             (* makes a copy of a bitmap image object.)
    (PROG [(BMOBJ (IMAGEOBJPROP IMAGEOBJ (QUOTE OBJECTDATUM]
          (RETURN (BITMAPTEDITOBJ (BITMAPCOPY (fetch (BITMAPOBJ BITMAP) of BMOBJ))
				  (fetch (BITMAPOBJ BMOBJSCALEFACTOR) of BMOBJ)
				  (fetch (BITMAPOBJ BMOBJROTATION) of BMOBJ])

(BMOBJ.DISPLAYFN
  (LAMBDA (IMAGEOBJ IMAGE.STREAM)                                      (* jds 
                                                                           "20-Dec-85 10:48")
                                                                           (* function which 
                                                                           displays a scaled 
                                                                           bitmap on only an 
                                                                           interpress stream for 
                                                                           now)
    (PROG (FACTOR BITMAP CACHE SHRUNK.BITMAP)
          (SETQ FACTOR (fetch (BITMAPOBJ BMOBJSCALEFACTOR) of (IMAGEOBJPROP IMAGEOBJ
                                                                             (QUOTE OBJECTDATUM))))
          (SETQ BITMAP (fetch (BITMAPOBJ BITMAP) of (IMAGEOBJPROP IMAGEOBJ (QUOTE OBJECTDATUM
                                                                                          ))))
          (SETQ CACHE (IMAGEOBJPROP IMAGEOBJ (QUOTE CACHED.BITMAP)))       (* (IMAGESTREAMTYPE 
                                                                           IMAGE.STREAM))
          (SELECTQ (IMAGESTREAMTYPE IMAGE.STREAM)
              (INTERPRESS 
            
            (* (SETQ Y (TIMES (QUOTIENT (BITMAPHEIGHT BITMAP) FACTOR) 35))
            (RELMOVETO 0 Y IMAGE.STREAM) (SHOWBITMAP.IP IMAGE.STREAM BITMAP NIL
            (QUOTIENT 1.0 FACTOR) 0) (RELMOVETO 0 (MINUS Y) IMAGE.STREAM))

                          (SHOWBITMAP.IP IMAGE.STREAM BITMAP NIL FACTOR 0))
              (PROGN                                                       (* This is the 
                                                                           default case, press 
                                                                           display and everyone 
                                                                           else prints the junky 
                                                                           shrunk bitmap)
                     (COND
                        ((NOT (SETQ SHRUNK.BITMAP CACHE))
                         (COND
                            ((LEQ FACTOR 1.0)                              (* We're shrinking 
                                                                           the bitmap. Create a 
                                                                           shrunk image for 
                                                                           display)
                             (SETQ SHRUNK.BITMAP (SHRINKBITMAP BITMAP (FQUOTIENT 1.0 FACTOR)
                                                        (FQUOTIENT 1.0 FACTOR))))
                            (T                                             (* We're expanding 
                                                                           it. Create a bigger 
                                                                           one.)
                               (SETQ SHRUNK.BITMAP (EXPANDBITMAP BITMAP FACTOR FACTOR))))
                         (IMAGEOBJPROP IMAGEOBJ (QUOTE CACHED.BITMAP)
                                SHRUNK.BITMAP)))
                     (BITBLT SHRUNK.BITMAP NIL NIL IMAGE.STREAM (DSPXPOSITION NIL IMAGE.STREAM)
                            (DSPYPOSITION NIL IMAGE.STREAM)
                            (FIXR (FTIMES FACTOR (BITMAPWIDTH BITMAP)))
                            (FIXR (FTIMES FACTOR (BITMAPHEIGHT BITMAP)))))))))

(BMOBJ.IMAGEBOXFN
  [LAMBDA (IMAGEOBJ IMAGE.STREAM CURRENT.X RIGHT.MARGIN)     (* jds "30-Oct-85 11:23")
                                                             (* returns an imagebox describing the size of the 
							     scaled bitmap)
    (PROG ([FACTOR (fetch (BITMAPOBJ BMOBJSCALEFACTOR) of (IMAGEOBJPROP IMAGEOBJ
										(QUOTE OBJECTDATUM]
	     [BITMAP (fetch (BITMAPOBJ BITMAP) of (IMAGEOBJPROP IMAGEOBJ (QUOTE OBJECTDATUM]
	     (SCALE (DSPSCALE NIL IMAGE.STREAM))
	     WIDTH HEIGHT)
	    [COND
	      ((EQ BITMAP (QUOTE NoneCached))
		(SETQ WIDTH (SETQ HEIGHT 5)))
	      (T [SETQ WIDTH (FIXR (FTIMES SCALE (TIMES (BITMAPWIDTH BITMAP)
								FACTOR]
		 (SETQ HEIGHT (FIXR (FTIMES SCALE (TIMES (BITMAPHEIGHT BITMAP)
								 FACTOR]
	    (RETURN (create IMAGEBOX
				XSIZE ← WIDTH
				YSIZE ← HEIGHT
				YDESC ← 0
				XKERN ← 0])

(BMOBJ.PUTFN
  [LAMBDA (BMOBJ STREAM)                                     (* jds "30-Oct-85 11:01")
                                                             (* Put a description of a bitmap object into the 
							     file.)
    (PROG* ([SCALE (fetch (BITMAPOBJ BMOBJSCALEFACTOR) of (IMAGEOBJPROP BMOBJ (QUOTE 
										      OBJECTDATUM]
	    (INTSCALE (FIX SCALE))
	    (FRACTSCALE (FDIFFERENCE SCALE INTSCALE)))
           (\WOUT STREAM INTSCALE)                           (* First word is integer part of the bitmap scale)
           [\WOUT STREAM (LOGAND 65535 (FIX (FTIMES FRACTSCALE 32768]
                                                             (* Second word is 16 bits of fraction)
           [\WOUT STREAM (fetch (BITMAPOBJ BMOBJROTATION) of (IMAGEOBJPROP BMOBJ (QUOTE
										   OBJECTDATUM]
           (\PRINTBINARYBITMAP (fetch (BITMAPOBJ BITMAP) of (IMAGEOBJPROP BMOBJ (QUOTE
										    OBJECTDATUM)))
				 STREAM])

(BMOBJ.INIT
  [LAMBDA NIL                                                (* jds "30-Oct-85 11:08")
                                                             (* returns the tedit obj which gives the functional 
							     information for a bitmap object in a tedit file.)
    (SETQ BITMAPIMAGEFNS (IMAGEFNSCREATE (FUNCTION BMOBJ.DISPLAYFN)
					     (FUNCTION BMOBJ.IMAGEBOXFN)
					     (FUNCTION BMOBJ.PUTFN)
					     (FUNCTION BMOBJ.GETFN3)
					     (FUNCTION BMOBJ.COPYFN)
					     (FUNCTION BMOBJ.BUTTONEVENTINFN)
					     (FUNCTION NILL)
					     (FUNCTION NILL)
					     (FUNCTION NILL)
					     (FUNCTION NILL)
					     (FUNCTION NILL)
					     (FUNCTION NILL)
					     (FUNCTION NILL])

(BMOBJ.GETFN3
  [LAMBDA (STREAM)                                           (* jds "30-Oct-85 10:55")

          (* * reads a bitmap image object from a file. This version stores the binary data rather than the character 
	  representation used by READBITMAP.)


    (PROG ((SCALE (FPLUS (\WIN STREAM)
			     (FQUOTIENT (\WIN STREAM)
					  32768)))
	     (ROT (\WIN STREAM)))
	    (RETURN (BITMAPTEDITOBJ (\READBINARYBITMAP STREAM)
					SCALE ROT])

(BMOBJ.CREATE.MENU
  [LAMBDA NIL                                                (* jds " 6-Nov-85 06:32")
    (create MENU
	      TITLE ← "Operations on bitmaps"
	      ITEMS ←(QUOTE ((Change% Scale (QUOTE CHANGE.SCALE)
					      "Changes the scale factor used at output time.")
				(Hand% Edit (QUOTE HAND.EDIT)
					    "Starts the bitmap editor on this bitmap.")
				(Trim (QUOTE TRIM)
				      "removes the white space from the edges of the bitmap.")
				(Reflect% Left-to-right (QUOTE INVERT.HORIZONTALLY)
							
						 "inverts the bitmap about the vertical midline.")
				(Reflect% Top-to-bottom (QUOTE INVERT.VERTICALLY)
							
					       "inverts the bitmap about the horizontal midline.")
				(Reflect% Diagonally (QUOTE INVERT.DIAGONALLY)
						     
			       "inverts the bitmap about the lower left to upper right diagonal.")
				(Rotate% Left (QUOTE ROTATE.BITMAP.LEFT)
					      "rotates the bitmap 90 degrees counter-clockwise.")
				(Rotate% Right (QUOTE ROTATE.BITMAP.RIGHT)
					       "rotates the bitmap 90 degrees clockwise.")
				(Expand% on% Right (QUOTE SHIFT.LEFT)
						   
					      "prompts for a number of bits to add on the right.")
				(Expand% on% Left (QUOTE SHIFT.RIGHT)
						  "prompts for a number of bits to add on the left.")
				(Expand% on% Bottom (QUOTE SHIFT.DOWN)
						    "prompts for a number of bits to add on the top.")
				(Expand% on% Top (QUOTE SHIFT.UP)
						 "prompts for a number of bits to add on the bottom.")
				(Switch% Black% &% White (QUOTE INTERCHANGE.BLACK/WHITE)
							 
				   "changes all black bits to white and all white bits to black.")
				(Add% Border (QUOTE ADD.BORDER)
					     "adds an arbitrary border in an arbitrary shade.")))
	      CENTERFLG ← T
	      CHANGEOFFSETFLG ←(QUOTE Y)
	      MENUOFFSET ←(create POSITION
				    XCOORD ← -1
				    YCOORD ← 0])
)
(DEFINEQ

(SCALED.BITMAP.GETFN
  [LAMBDA (INPUT.STREAM TEXTSTREAM)                          (* jds "30-Oct-85 11:29")
                                                             (* reads in a scaled bitmap object with readbitmap and
							     read)
    (PROG (FACTOR BITMAP)
	    (SETQ BITMAP (READBITMAP INPUT.STREAM))
	    (SETQ FACTOR (READ INPUT.STREAM))
	    (RETURN (BITMAPTEDITOBJ BITMAP (FQUOTIENT 1.0 FACTOR)
					0])

(BMOBJ.GETFN
  [LAMBDA (STREAM)                                           (* rrb "17-Jul-84 11:46")

          (* this is an old version of the get function for bitmap image objects. It is left around so old tedit documents 
	  will still work. 17/7/84)


    (RESETFORM (INPUT STREAM)
	       (PROG ((FIELDS (READ STREAM))
		      (BITMAP (READBITMAP)))
		     (RETURN (BITMAPTEDITOBJ BITMAP (CAR FIELDS)
					     (CADR FIELDS])

(BMOBJ.GETFN2
  [LAMBDA (STREAM)                                           (* rrb "17-Jul-84 11:29")

          (* * reads a bitmap image object from a file. This version stores the binary data rather than the character 
	  representation used by READBITMAP.)


    (PROG ((SCALE (\WIN STREAM))
	   (ROT (\WIN STREAM)))
          (RETURN (BITMAPTEDITOBJ (\READBINARYBITMAP STREAM)
				  SCALE ROT])
)



(* GETFNs for backward compatibility with older objects.)

[DECLARE: EVAL@COMPILE 

(RECORD BITMAPOBJ (BITMAP BMOBJSCALEFACTOR BMOBJROTATION))
]



(* make ↑O be a character that inserts an object read from the user.)

(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS (BITMAP.OBJ.MENU))
)

(ADDTOVAR BackgroundCopyMenuCommands (SNAP (FUNCTION (BITMAPOBJ.SNAPW))
                                               "prompts for an area of the screen to insert."))

(ADDTOVAR IMAGEOBJGETFNS (BMOBJ.GETFN))

(ADDTOVAR IMAGEOBJGETFNS (BMOBJ.GETFN2))

(ADDTOVAR IMAGEOBJGETFNS (SCALED.BITMAP.GETFN))

(RPAQQ BackgroundCopyMenu NIL)
(DEFINEQ

(GET.OBJ.FROM.USER
  [LAMBDA (TEXTSTREAM TEXTOBJ)                               (* jds " 6-Mar-85 22:02")
                                                             (* reads an expression from the user and puts the 
							     result into the textstream.)
    (ERSETQ (PROG ((VAL (PROMPTFOREVALED "Form to eval:"))
		   (SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
		   BM)
	          (SELECTQ (TYPENAME VAL)
			   ((LITATOM STRINGP)                (* Atoms and strings get inserted as text.)
			     (AND VAL (TEDIT.INSERT TEXTSTREAM VAL SEL)))
			   (IMAGEOBJ                         (* IMAGEOBJs get inserted as is)
				     (TEDIT.INSERT.OBJECT VAL TEXTSTREAM
							  (SELECTQ (fetch POINT of SEL)
								   (LEFT (fetch (SELECTION CH#)
									    of SEL))
								   (RIGHT (fetch (SELECTION CHLIM)
									     of SEL))
								   NIL)))
			   (COND
			     ((SETQ BM (COERCETOBITMAP VAL))
                                                             (* If it can be coerced to a bitmap, do so, then wrap 
							     the bitmap up as a nobject)
			       (TEDIT.INSERT.OBJECT (BITMAPTEDITOBJ BM 1 0)
						    TEXTSTREAM
						    (SELECTQ (fetch POINT of SEL)
							     (LEFT (fetch (SELECTION CH#)
								      of SEL))
							     (RIGHT (fetch (SELECTION CHLIM)
								       of SEL))
							     NIL)))
			     (T                              (* Not a bitmap, nor one of the special cases above;
							     complain)
				(AND VAL (TEDIT.INSERT TEXTSTREAM (MKSTRING VAL)
						       SEL))
                                                             (* (TEDIT.PROMPTPRINT TEXTOBJ 
							     (CONCAT "Not implemented to have " VAL 
							     " in documents yet.") T))
				])

(BITMAPOBJ.SNAPW
  (LAMBDA NIL                                                         (* kbr: 
                                                                          "25-Feb-86 17:06")
            
            (* * makes an image object of a prompted for region of the screen.)

    (PROG (SCREENREGION SCREEN REGION BM)
          (SETQ SCREENREGION (GETSCREENREGION))
          (SETQ SCREEN (fetch (SCREENREGION SCREEN) of SCREENREGION))
          (SETQ REGION (fetch (SCREENREGION REGION) of SCREENREGION))
          (SETQ BM (BITMAPCREATE (fetch (REGION WIDTH) of REGION)
                          (fetch (REGION HEIGHT) of REGION)
                          (BITSPERPIXEL (SCREENBITMAP SCREEN))))
          (BITBLT (SCREENBITMAP SCREEN)
                 (fetch (REGION LEFT) of REGION)
                 (fetch (REGION BOTTOM) of REGION)
                 BM 0 0 NIL NIL (QUOTE INPUT)
                 (QUOTE REPLACE))
          (COPYINSERT (BITMAPTEDITOBJ BM 1 0)))))

(PROMPTFOREVALED
  [LAMBDA (MSG WHERE FONT MINWIDTH MINHEIGHT)                (* jds "26-Sep-85 16:46")

          (* opens a window with MSG in the title and returns the result of evaluating a READ from that window.
	  (PROMPTFOREVALED "HOW'S THIS?" (QUOTE (600 . 600)) NIL 100))


    (PROG [NEWVALUE WIN (FONT (OR FONT (FONTCREATE (QUOTE HELVETICA)
						   12
						   (QUOTE BOLD]
          (RESETFORM (WINDOWTITLEFONT FONT)
		     (SETQ WIN
		       (CREATEW [COND
				  ((REGIONP WHERE)
				    WHERE)
				  (T (CREATEREGION (COND
						     (WHERE (fetch (POSITION XCOORD) of WHERE))
						     (T LASTMOUSEX))
						   (COND
						     (WHERE (fetch (POSITION YCOORD) of WHERE))
						     (T LASTMOUSEY))
						   (WIDTHIFWINDOW (MAX (STRINGWIDTH MSG FONT)
								       (OR MINWIDTH 0)
								       125)
								  8)
						   (HEIGHTIFWINDOW
						     (MAX (ITIMES (FONTPROP (DEFAULTFONT
									      (QUOTE DISPLAY))
									    (QUOTE HEIGHT))
								  3)
							  (OR MINHEIGHT 0)
							  100)
						     T 8]
				MSG 4))
		     (CLEARW WIN))
          [RESETFORM (TTYDISPLAYSTREAM WIN)
		     (SETQ NEWVALUE (CAR (ERSETQ (LISPX (LISPXREAD T T)
							(QUOTE >]
          (CLOSEW WIN)
          (RETURN NEWVALUE])
)
(DECLARE: DONTEVAL@LOAD DOCOPY 
(BMOBJ.INIT)
(TEDIT.SETFUNCTION (CHARCODE ↑O)
       (FUNCTION GET.OBJ.FROM.USER)
       TEDIT.READTABLE)
)
(FILESLOAD EDITBITMAP)
(PUTPROPS IMAGEOBJ COPYRIGHT ("Xerox Corporation" 1984 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (2560 7934 (BITMAPTEDITOBJ 2570 . 3047) (COERCETOBITMAP 3049 . 6367) (WINDOWTITLEFONT 
6369 . 6645) (\PRINTBINARYBITMAP 6647 . 7356) (\READBINARYBITMAP 7358 . 7932)) (7980 19863 (
BMOBJ.BUTTONEVENTINFN 7990 . 10510) (BMOBJ.COPYFN 10512 . 11006) (BMOBJ.DISPLAYFN 11008 . 14632) (
BMOBJ.IMAGEBOXFN 14634 . 15607) (BMOBJ.PUTFN 15609 . 16651) (BMOBJ.INIT 16653 . 17436) (BMOBJ.GETFN3 
17438 . 17931) (BMOBJ.CREATE.MENU 17933 . 19861)) (19864 21219 (SCALED.BITMAP.GETFN 19874 . 20341) (
BMOBJ.GETFN 20343 . 20793) (BMOBJ.GETFN2 20795 . 21217)) (21875 26244 (GET.OBJ.FROM.USER 21885 . 23773
) (BITMAPOBJ.SNAPW 23775 . 24816) (PROMPTFOREVALED 24818 . 26242)))))
STOP