(FILECREATED "26-Jul-85 13:42:17" {DSK}<LISPFILES>UTILITIES>THERMOMETER.;5
 5205   

      changes to:  (FNS CREATE-THERMOMETER UPDATE-THERMOMETER)
		   (VARS THERMOMETERCOMS THERMOMETER-TEXTURE-BITMAP)

      previous date: "24-Jul-85 17:04:43" {DSK}<LISPFILES>UTILITIES>THERMOMETER.;3)


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

(PRETTYCOMPRINT THERMOMETERCOMS)

(RPAQQ THERMOMETERCOMS
 [(FNS CREATE-THERMOMETER RESET-THERMOMETER UPDATE-THERMOMETER)
			(BITMAPS THERMOMETER-TEXTURE-BITMAP)
			(P (SETQ THERMOMETER-TEXTURE (CREATETEXTUREFROMBITMAP 
								       THERMOMETER-TEXTURE-BITMAP])
(DEFINEQ

(CREATE-THERMOMETER

  [LAMBDA (
MAX
 MIN? REGION-OR-POSITION TITLE)                (* sm "26-Jul-85 13:41")

    (
PROG
 (THERMOMETER-LENGTH FILING-POSITION WINDOW N-DEVISIONS X-OFFSET)
          (
SETQ
 MIN? (
OR
 MIN? 0))
          (
SETQ
 MAX (
FIX
 MAX))
          (if
 (
GREATERP
 MIN? MAX)
	      then
 (swap
 MIN? MAX))
          (
SETQ
 X-OFFSET (
IPLUS
 5 (
STRINGWIDTH
 (
MKSTRING
 MAX)
					       BOLDFONT)))
          [if
 (
REGIONP
 REGION-OR-POSITION)
	      then
 (
SETQ
 THERMOMETER-LENGTH (
IDIFFERENCE
 (fetch
 HEIGHT of
 REGION-OR-POSITION)
							 40))
	    else
 (
SETQ
 THERMOMETER-LENGTH (
MAX
 200 (
MIN
 700 MAX]
          (
SETQ
 WINDOW-REGION (if
 (
REGIONP
 REGION-OR-POSITION)
				  then
 REGION-OR-POSITION
				elseif
 (
POSITIONP
 REGION-OR-POSITION)
				  then
 (
CREATEREGION
 (fetch
 XCOORD of
 REGION-OR-POSITION)
						     (fetch
 YCOORD of
 REGION-OR-POSITION)
						     (
MAX
 (
IPLUS
 X-OFFSET X-OFFSET 22)
							  100)
						     (
IPLUS
 THERMOMETER-LENGTH 40))
				else
 (
GETBOXREGION
 (
MAX
 (
IPLUS
 X-OFFSET X-OFFSET 22)
							100)
						   (
IPLUS
 THERMOMETER-LENGTH 40)
						   NIL NIL NIL "MARK LOCATION OF THERMOMETER WINDOW.")
				  ))
          (
SETQ
 WINDOW (
CREATEW
 WINDOW-REGION (
OR
 TITLE "THERMOMETER")))
          (
DSPFONT
 BOLDFONT WINDOW)
          (
SETQ
 FILING-POSITION (create
 POSITION
					XCOORD ←(
IDIFFERENCE
 (
IQUOTIENT
 (fetch
 WIDTH of
 WINDOW-REGION)
									2)
							     10)
					YCOORD ← 10))
          (
SETQ
 N-DEVISIONS (
MIN
 (
IQUOTIENT
 THERMOMETER-LENGTH 15)
				 (if
 (
LESSP
 (
IDIFFERENCE
 MAX MIN?)
					    10)
				     then
 (
IDIFFERENCE
 MAX MIN?)
				   else
 10)))
          (
MOVETO
 (
SUB1
 (fetch
 XCOORD of
 FILING-POSITION))
		  (
SUB1
 (fetch
 YCOORD of
 FILING-POSITION))
		  WINDOW)
          (
RELDRAWTO
 22 0 NIL NIL WINDOW)
          (
RELDRAWTO
 0 (
IPLUS
 THERMOMETER-LENGTH 2)
		     NIL NIL WINDOW)
          (
RELDRAWTO
 -22 0 NIL NIL WINDOW)
          (
RELDRAWTO
 0 (
MINUS
 (
IPLUS
 THERMOMETER-LENGTH 2))
		     NIL NIL WINDOW)
          (
WINDOWPROP
 WINDOW (
QUOTE
 TH.LENGTH)
		      THERMOMETER-LENGTH)
          (
WINDOWPROP
 WINDOW (
QUOTE
 TH.MAX)
		      MAX)
          (
WINDOWPROP
 WINDOW (
QUOTE
 TH.MIN)
		      MIN?)
          (
WINDOWPROP
 WINDOW (
QUOTE
 TH.POSITION)
		      FILING-POSITION)
          (for
 X from
 MIN? to
 MAX by
 (
IQUOTIENT
 (
IDIFFERENCE
 MAX MIN?)
						N-DEVISIONS)
	     do
 (
MOVETO
 (
IDIFFERENCE
 (fetch
 XCOORD of
 FILING-POSITION)
				     (
IPLUS
 5 (
STRINGWIDTH
 (
MKSTRING
 X)
							   BOLDFONT)))
			(
IPLUS
 10 (
FIX
 (
FTIMES
 (
FQUOTIENT
 (
IDIFFERENCE
 X MIN?)
							  (
IDIFFERENCE
 MAX MIN?))
					       THERMOMETER-LENGTH)))
			WINDOW)
		(
PRIN1
 X WINDOW))
          (RESET-THERMOMETER
 WINDOW)
          (
RETURN
 WINDOW])

(RESET-THERMOMETER

  [LAMBDA (TH-WINDOW)                                        (* sm "24-Jul-85 12:33")

    (
DSPFILL
 (
CREATEREGION
 (fetch
 XCOORD of
 (
WINDOWPROP
 TH-WINDOW (
QUOTE
 TH.POSITION)))
			   (fetch
 YCOORD of
 (
WINDOWPROP
 TH-WINDOW (
QUOTE
 TH.POSITION)))
			   20
			   (
WINDOWPROP
 TH-WINDOW (
QUOTE
 TH.LENGTH)))
	     WHITESHADE
	     (
QUOTE
 REPLACE)
	     TH-WINDOW])

(UPDATE-THERMOMETER

  [LAMBDA (VALUE TH-WINDOW SHADE)                            (* sm "25-Jul-85 11:13")

    (
AND
 TH-WINDOW (
WINDOWP
 TH-WINDOW)
	 (
SETQ
 SHADE (
OR
 SHADE THERMOMETER-TEXTURE))
	 (
DSPFILL
 [
CREATEREGION
 (fetch
 XCOORD of
 (
WINDOWPROP
 TH-WINDOW (
QUOTE
 TH.POSITION)))
				(fetch
 YCOORD of
 (
WINDOWPROP
 TH-WINDOW (
QUOTE
 TH.POSITION)))
				20
				(
FIX
 (
FTIMES
 [
FQUOTIENT
 (
IDIFFERENCE
 VALUE (
WINDOWPROP
 TH-WINDOW
										       (
QUOTE
 TH.MIN))
								     )
							(
IDIFFERENCE
 (
WINDOWPROP
 TH-WINDOW
										 (
QUOTE
 TH.MAX))
								     (
WINDOWPROP
 TH-WINDOW
										 (
QUOTE
 TH.MIN]
					     (
WINDOWPROP
 TH-WINDOW (
QUOTE
 TH.LENGTH]
		  SHADE
		  (
QUOTE
 REPLACE)
		  TH-WINDOW])
)

(RPAQ THERMOMETER-TEXTURE-BITMAP (READBITMAP))
(4 4
"K@@@"
"K@@@"
"K@@@"
"K@@@")
(SETQ THERMOMETER-TEXTURE (CREATETEXTUREFROMBITMAP THERMOMETER-TEXTURE-BITMAP))
(PUTPROPS THERMOMETER COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (628 4961 (CREATE-THERMOMETER 638 . 3711) (RESET-THERMOMETER 3713 . 4146) (
UPDATE-THERMOMETER 4148 . 4959)))))
STOP