(FILECREATED " 9-MAR-83 11:18:07" {PHYLUM}<BURTON>ORB>PHOTODEMO.;6
 4433   

      changes to:  (FNS DISPLAY.IMAGE IMAGE.MENU)

      previous date: "18-FEB-83 13:57:27" {PHYLUM}<BURTON>ORB>PHOTODEMO.;4)


(* Copyright (c) 1983 by Xerox Corporation)

(PRETTYCOMPRINT PHOTODEMOCOMS)

(RPAQQ PHOTODEMOCOMS
 ((VARS (GRAYLEVELCOLORMAP)
			    (HILITECOLORMAP)
			    (R3G3B2COLORMAP)
			    (RAINBOWMAP))
		      (FNS DISPLAY.IMAGE HILITECOLORMAP IMAGE.MENU)))

(RPAQQ GRAYLEVELCOLORMAP
 NIL)

(RPAQQ HILITECOLORMAP
 NIL)

(RPAQQ R3G3B2COLORMAP
 NIL)

(RPAQQ RAINBOWMAP
 NIL)
(DEFINEQ

(DISPLAY.IMAGE

  [LAMBDA (ITEM)                                             (* rrb " 9-MAR-83 11:16")

                                                             (* when selected function for the image menu.

							     Knows about the possible photos and their color maps.)

    (PROG (FILE)
          (RETURN (SELECTQ [SETQ ITEM (COND
			       ((NLISTP ITEM)
				 ITEM)
			       (T                            (* assumes the second item is a QUOTE ed name.)

				  (CADADR ITEM]
			   ((LA Pasadena Newport)
			     (COLORDISPLAY T 8)
			     [SCREENCOLORMAP (COND
					       ((COLORMAPP GRAYLEVELCOLORMAP))
					       (T (SETQ GRAYLEVELCOLORMAP
						    (MAPOFACOLOR (QUOTE (RED GREEN BLUE]
			     (AISBLT (PACKFILENAME (LIST (QUOTE HOST)
							 (QUOTE DSK)
							 (QUOTE NAME)
							 ITEM
							 (QUOTE EXTENSION)
							 (QUOTE AIS)))
				     NIL NIL (COLORSCREENBITMAP)
				     NIL NIL NIL NIL (QUOTE FSA)))
			   (Agent% 22 (COLORDISPLAY T 8)
				      (BITBLT NIL NIL NIL (COLORSCREENBITMAP)
					      0 0 640 480 (QUOTE TEXTURE)
					      (QUOTE REPLACE)
					      0)
				      (SHOWCOLORAIS (QUOTE {DSK}GIRL22)
						    (QUOTE (3 3 2))
						    (QUOTE FSA)
						    (COLORSCREENBITMAP)))
			   (Neighbor (COLORDISPLAY T 8)
				     (BITBLT NIL NIL NIL (COLORSCREENBITMAP)
					     0 0 640 480 (QUOTE TEXTURE)
					     (QUOTE REPLACE)
					     0)
				     (COND
				       ((SETQ FILE (INFILEP (QUOTE {DSK}BABOON-R3G3B2.AIS)))
					 (SCREENCOLORMAP R3G3B2COLORMAP)
					 (AISBLT FILE 0 0 (COLORSCREENBITMAP)))
				       (T DISPLAY.IMAGE)))
			   NIL])

(HILITECOLORMAP

  [LAMBDA NIL                                                (* rrb "14-FEB-83 23:01")

                                                             (* returns a colormap that high lights a gray scale 

							     image with colors. For now this cycles through the 

							     colors as the intensity increases.)

    (COLORMAPCREATE (bind
 (INT ← .1)
			  (INTINCR ←(FQUOTIENT .8 (MAXIMUMCOLOR)))
			  (HUE ← 360.0)
			  (HUEINCR ←(FQUOTIENT 240.0 (MAXIMUMCOLOR))) for
 CNT from
 0 to
 (MAXIMUMCOLOR)
		       collect
 (PROG1 (LIST (FIX HUE)
					    INT .5)
				      (SETQ INT (FPLUS INT INTINCR))
				      (SETQ HUE (FDIFFERENCE HUE HUEINCR])

(IMAGE.MENU

  [LAMBDA NIL                                                (* rrb " 8-MAR-83 13:04")

    [COND
      ((COLORMAPP GRAYLEVELCOLORMAP))
      (T (SETQ GRAYLEVELCOLORMAP (MAPOFACOLOR (QUOTE (RED GREEN BLUE]
    [COND
      ((COLORMAPP HILITECOLORMAP))
      (T (SETQ HILITECOLORMAP (HILITECOLORMAP
]
    [COND
      ((COLORMAPP R3G3B2COLORMAP))
      (T (SETQ R3G3B2COLORMAP (THREECOLORMAP 3 3 2 8]
    [COND
      ((COLORMAPP RAINBOWMAP))
      (T (SETQ RAINBOWMAP (RAINBOWMAP]
    [COND
      ((COLORMAPP DEFAULTMAP))
      (T (SETQ DEFAULTMAP (COLORMAPCREATE NIL 8]
    (ADDMENU (create
 MENU
		     ITEMS ←[QUOTE ((GRAY (SCREENCOLORMAP GRAYLEVELCOLORMAP))
				     (Hi% Lite (SCREENCOLORMAP HILITECOLORMAP))
				     (r3g3b2 (SCREENCOLORMAP R3G3B2COLORMAP))
				     (Rainbow (SCREENCOLORMAP RAINBOWMAP))
				     (Default (SCREENCOLORMAP DEFAULTMAP]
		     MENUOUTLINESIZE ← 2
		     CENTERFLG ← T
		     MENUFONT ←(QUOTE (GACHA 12))
		     ITEMWIDTH ←(IPLUS (STRINGWIDTH (QUOTE Hi% Lite)
						    (QUOTE (GACHA 12)))
				       4)))
    (ADDMENU (create
 MENU
		     ITEMS ←(QUOTE ((Los% Angeles (QUOTE LA))
				     Pasadena Newport Agent% 22 Neighbor))
		     WHENSELECTEDFN ←(FUNCTION DISPLAY.IMAGE)
		     MENUOUTLINESIZE ← 2
		     MENUBORDERSIZE ← 1
		     CENTERFLG ← T
		     MENUFONT ←(QUOTE (GACHA 12))
		     ITEMWIDTH ←(IPLUS (STRINGWIDTH (QUOTE Los% Angeles)
						    (QUOTE (GACHA 12)))
				       4])
)
(PUTPROPS PHOTODEMO COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (590 4353 (DISPLAY.IMAGE 600 . 2200) (HILITECOLORMAP 2202 . 2899) (IMAGE.MENU 2901 . 
4351)))))
STOP