(FILECREATED " 1-NOV-83 15:20:54" {PHYLUM}<SYBALSKY>ICONW.;16
 10358  

      changes to:  (FNS ICONTITLE ICONW.FORMATLINE TITLEDICONW)

      previous date: " 8-SEP-83 10:43:53" {PHYLUM}<SYBALSKY>ICONW.;15)


(PRETTYCOMPRINT ICONWCOMS)

(RPAQQ ICONWCOMS
 ((FNS ICONTITLE ICONW ICONW.FORMATLINE ICONW.MOVEFN ICONW.REPAINTFN TITLEDICONW)
		  (RECORDS TITLEDICON)))
(DEFINEQ

(ICONTITLE

  [LAMBDA (MSG REG FONT ICONW JUST)                          (* jds " 1-NOV-83 15:12")

                                                             (* Put the text MSG into the ICONW within the bounds of 

							     REG)

    (PROG ((BITS (WINDOWPROP ICONW (QUOTE ICONIMAGE)))
	   (MASK (WINDOWPROP ICONW (QUOTE ICONMASK)))
	   DS MAXHEIGHT TITLETOP WIDTH NLINES TMSG FONTHEIGHT LEFTMAR TITLEHEIGHT)
          (SETQ DS (DSPCREATE BITS))
          (DSPCLIPPINGREGION (create
 REGION
				     LEFT ← 0
				     BOTTOM ← 0
				     WIDTH ←(fetch
 BITMAPWIDTH of
 BITS)
				     HEIGHT ←(fetch
 BITMAPHEIGHT of
 BITS))
			     DS)
          (DSPXOFFSET 0 DS)
          (DSPYOFFSET 0 DS)
          (SETQ FONT (OR FONT (FONTCREATE (QUOTE HELVETICA)
					  10)))              (* The font to put the msg in)

          (SETQ FONTHEIGHT (FONTPROP FONT (QUOTE HEIGHT)))   (* Single line's height)

          [SETQ NLINES (bind
 (NCH ← 1)
			     TCH repeatuntil
 (IGEQ NCH (NCHARS MSG))
			  collect
                            (* Gather the icon title, broken into lines which fit.)

				  (PROG1 (SETQ TCH (ICONW.FORMATLINE
 (SUBSTRING MSG NCH)
								     (fetch
 WIDTH of
 REG)
								     FONT))
					 (add
 NCH (IABS (CAR TCH]
          (SETQ MAXHEIGHT (fetch
 HEIGHT of
 REG))             (* Max height of the title)

          (SETQ TITLEHEIGHT (ITIMES FONTHEIGHT (FLENGTH NLINES)))
                                                             (* Height of the message)

          [SETQ TITLETOP (IMIN MAXHEIGHT (COND
				 ((OR (EQ JUST (QUOTE TOP))
				      (MEMB (QUOTE TOP)
					    JUST))           (* Top-flush title)

				   (fetch
 TOP of
 REG))
				 ((OR (EQ JUST (QUOTE BOTTOM))
				      (MEMB (QUOTE BOTTOM)
					    JUST))           (* Bottom-flush title)

				   (IPLUS (fetch
 BOTTOM of
 REG)
					  TITLEHEIGHT))
				 ((IGREATERP TITLEHEIGHT MAXHEIGHT)
				   MAXHEIGHT)
				 (T                          (* Centered vertically title)

				    (IDIFFERENCE (fetch
 TOP of
 REG)
						 (LRSH (IDIFFERENCE MAXHEIGHT TITLEHEIGHT)
						       1]
          (DSPFONT FONT DS)                                  (* Set the right font)

          (DSPOPERATION (QUOTE PAINT)
			DS)                                  (* Don't erase any bits from the icon image--paint the 

							     msg)

          (LINELENGTH 1000 DS)                               (* Avoid trouble with PRIN1)

          (DSPLEFTMARGIN (fetch
 LEFT of
 REG)
			 DS)                                 (* Left margin for the message)

          (DSPRIGHTMARGIN 32700 DS)
          (MOVETO (fetch
 LEFT of
 REG)
		  (IDIFFERENCE TITLETOP (FONTPROP FONT (QUOTE ASCENT)))
		  DS)                                        (* Move to the left end of the first message line)

          (bind
 (MESS ←(OPENSTRINGSTREAM (MKSTRING MSG))) for
 N in
 NLINES as
 HT from
 0 to
 MAXHEIGHT
	     by
 FONTHEIGHT
	     do
 [SETQ LEFTMAR (COND
		    ((OR (EQ JUST (QUOTE LEFT))
			 (MEMB (QUOTE LEFT)
			       JUST))
		      0)
		    ((OR (EQ JUST (QUOTE RIGHT))
			 (MEMB (QUOTE RIGHT)
			       JUST))
		      (IABS (CDR N)))
		    (T (LRSH (IABS (CDR N))
			     1]                              (* Decide where this line should start)

		(RELMOVETO LEFTMAR 0 DS)                     (* Move to this line's left end)

		(bind
 CH for
 I from
 1 to
 (IABS (CAR N))
		   do
                                        (* Print the characters -- except the final SPACE on a 

							     line, or a CR)

		      (SETQ CH (CHARACTER (BIN MESS)))
		      (OR (AND (IEQP I (IABS (CAR N)))
			       (EQ CH (QUOTE % )))
			  (PRIN1 CH DS)))
		(COND
		  ((ILESSP 0 (CAR N))                        (* This line ended in CR--go to a new line NOW)

		    (TERPRI DS)))
	     finally
 (CLOSEF? MESS))
          (BITBLT MASK 0 0 BITS 0 0 (fetch
 BITMAPWIDTH of
 BITS)
		  (fetch
 BITMAPHEIGHT of
 BITS)
		  (QUOTE INVERT)
		  (QUOTE ERASE))
          (RETURN ICONW])

(ICONW

  [LAMBDA (ICON MASK POSITION NOOPENFLG)                     (* edited: "14-MAR-83 14:00")


          (* creates a window that merges with its background. This is done by putting the background in the original bits, 

	  erasing the bits that are on in MASK and then painting the bits from IMAGEBM.)



    (PROG (ICONW
)
          [SETQ POSITION (COND
	      ((type?
 POSITION POSITION)
		POSITION)
	      ((REGIONP POSITION))
	      (T (GETBOXPOSITION (fetch
 (BITMAP BITMAPWIDTH) of
 ICON)
				 (fetch
 (BITMAP BITMAPHEIGHT) of
 ICON]
          (SETQ ICONW (CREATEW (create
 REGION
				       LEFT ←(fetch
 (POSITION XCOORD) of
 POSITION)
				       BOTTOM ←(fetch
 (POSITION YCOORD) of
 POSITION)
				       WIDTH ←(fetch
 (BITMAP BITMAPWIDTH) of
 ICON)
				       HEIGHT ←(fetch
 (BITMAP BITMAPHEIGHT) of
 ICON))
			       NIL 0 T))
          (WINDOWPROP ICONW (QUOTE RESHAPEFN)
		      (QUOTE DON'T
))
          (WINDOWPROP ICONW (QUOTE ICONIMAGE)
		      ICON)
          (WINDOWPROP ICONW (QUOTE ICONMASK)
		      MASK)
          (WINDOWPROP ICONW (QUOTE MOVEFN)
		      (QUOTE ICONW.MOVEFN))
          (WINDOWPROP ICONW (QUOTE OPENFN)
		      (QUOTE ICONW.REPAINTFN))
          (OR NOOPENFLG (OPENW ICONW))
          (RETURN ICONW])

(ICONW.FORMATLINE

  [LAMBDA (MSG WIDTH FONT)                                   (* jds " 1-NOV-83 15:04")

                                                             (* Returns the char# relative to char 1 of where to 

							     break next line.)

    (bind
 (TX ← 0)
	  (LASTB ← 0)
	  (CH ← 0)
	  (TMSG ←(OPENSTRINGSTREAM MSG))
	  (MSGLEN ←(NCHARS MSG)) for
 I from
 1 by
 1
       do
 (COND
	    [(EOFP TMSG)
	      (CLOSEF? TMSG)
	      (RETURN (CONS (SUB1 I)
			    (IDIFFERENCE WIDTH TX]
	    [(IGREATERP TX WIDTH)
	      (CLOSEF? TMSG)
	      (RETURN (COND
			((LISTP LASTB))
			(T (CONS (IDIFFERENCE I 2)
				 (IDIFFERENCE WIDTH (IDIFFERENCE TX (CHARWIDTH CH FONT]
	    (T (SETQ CH (BIN TMSG))
	       (SELCHARQ CH
			 [SPACE (SETQ LASTB (CONS I (IDIFFERENCE WIDTH TX]
			 [CR (RETURN (CONS (IMINUS I)
					   (IDIFFERENCE WIDTH TX]
			 NIL)
	       (SETQ TX (IPLUS TX (CHARWIDTH CH FONT])

(ICONW.MOVEFN

  [LAMBDA (WINDOW NEW.POSITION)                              (* jds "17-MAR-83 15:18")

                                                             (* moves an overpaint window)

    (PROG (IMAGEBM ERASEBM REGION SAVEBM NOWOPEN?)
          (SETQ IMAGEBM (WINDOWPROP WINDOW (QUOTE ICONIMAGE)))
          (SETQ ERASEBM (WINDOWPROP WINDOW (QUOTE ICONMASK)))
          (SETQ REGION (WINDOWPROP WINDOW (QUOTE REGION)))
          (SETQ SAVEBM (WINDOWPROP WINDOW (QUOTE IMAGECOVERED)))
                                                             (* close the window in case its new position intersects 

							     its old position. \CLOSEW1 closes the window without 

							     calling the closefn.)

          (COND
	    ((ACTIVEWP WINDOW)
	      (SETQ NOWOPEN? T)                              (* copy the bits from the new screen position into the 

							     image.)

	      (\CLOSEW1 WINDOW)))
          (BITBLT (SCREENBITMAP)
		  (fetch
 (POSITION XCOORD) of
 NEW.POSITION)
		  (fetch
 (POSITION YCOORD) of
 NEW.POSITION)
		  SAVEBM 0 0 (fetch
 (REGION WIDTH) of
 REGION)
		  (fetch
 (REGION HEIGHT) of
 REGION)
		  (QUOTE INPUT)
		  (QUOTE REPLACE))
          (BITBLT ERASEBM 0 0 SAVEBM 0 0 (fetch
 (BITMAP BITMAPWIDTH) of
 ERASEBM)
		  (fetch
 (BITMAP BITMAPHEIGHT) of
 ERASEBM)
		  (QUOTE INPUT)
		  (QUOTE ERASE))
          (BITBLT IMAGEBM 0 0 SAVEBM 0 0 (fetch
 (BITMAP BITMAPWIDTH) of
 IMAGEBM)
		  (fetch
 (BITMAP BITMAPHEIGHT) of
 IMAGEBM)
		  (QUOTE INPUT)
		  (QUOTE PAINT))                             (* open the window without calling the openfn.)

          (AND NOWOPEN? (\OPENW1 WINDOW))
          (RETURN])

(ICONW.REPAINTFN

  [LAMBDA (WINDOW)                                           (* edited: "14-MAR-83 13:47")

    (PROG (IMAGEBM ERASEBM REGION)
          (SETQ IMAGEBM (WINDOWPROP WINDOW (QUOTE ICONIMAGE)))
          (SETQ ERASEBM (WINDOWPROP WINDOW (QUOTE ICONMASK)))
          (SETQ REGION (WINDOWPROP WINDOW (QUOTE REGION)))
          (BITBLT (WINDOWPROP WINDOW (QUOTE IMAGECOVERED))
		  0 0 WINDOW 0 0 (fetch
 (REGION WIDTH) of
 REGION)
		  (fetch
 (REGION HEIGHT) of
 REGION)
		  (QUOTE SOURCE)
		  (QUOTE REPLACE))
          (BITBLT ERASEBM 0 0 WINDOW 0 0 (fetch
 (BITMAP BITMAPWIDTH) of
 ERASEBM)
		  (fetch
 (BITMAP BITMAPHEIGHT) of
 ERASEBM)
		  (QUOTE SOURCE)
		  (QUOTE ERASE))
          (BITBLT IMAGEBM 0 0 WINDOW 0 0 (fetch
 (BITMAP BITMAPWIDTH) of
 IMAGEBM)
		  (fetch
 (BITMAP BITMAPHEIGHT) of
 IMAGEBM)
		  (QUOTE SOURCE)
		  (QUOTE PAINT))
          (RETURN])

(TITLEDICONW

  [LAMBDA (ICON MSG FONT POS NOOPENFLG JUST)                 (* jds " 1-NOV-83 15:17")

                                                             (* Given a TITLEDICON, create an instance of it with 

							     specific text.)

    (PROG ((BITS (BITMAPCOPY (fetch
 (TITLEDICON ICON) of
 ICON)))
	   ICONW)
          (SETQ ICONW (ICONTITLE
 MSG (fetch
 TITLEREG of
 ICON)
				 FONT
				 (ICONW
 BITS (fetch
 (TITLEDICON MASK) of
 ICON)
					POS T)
				 JUST))                      (* Create a copy of the icon image, with the text 

							     imposed on it.)

                                                             (* Save it for restoration on open, repaint, &c)

          (OR NOOPENFLG (OPENW ICONW))                       (* Open the window, unless he wants it kept closed.)

          (RETURN ICONW])
)
[DECLARE: EVAL@COMPILE 

(RECORD TITLEDICON
 (ICON MASK TITLEREG))
]
(DECLARE: DONTCOPY
  (FILEMAP (NIL (372 10264 (ICONTITLE 382 . 4497) (ICONW 4499 . 5808) (ICONW.FORMATLINE 5810 . 6738) (
ICONW.MOVEFN 6740 . 8460) (ICONW.REPAINTFN 8462 . 9381) (TITLEDICONW 9383 . 10262)))))
STOP