(FILECREATED "16-NOV-82 12:29:49" {PHYLUM}<LISPCORE>COLOR>HLCOLOR.;5
 7234   

      changes to:  (FNS GETCOLORREGION)

      previous date: "27-OCT-82 18:42:40" {PHYLUM}<LISPCORE>COLOR>HLCOLOR.;4)


(* Copyright (c) 1982 by Xerox Corporation)

(PRETTYCOMPRINT HLCOLORCOMS)

(RPAQQ HLCOLORCOMS
 ((FNS COLORMOVEBOX COLORVLINE COLORHLINE DRAWCOLORREGIONOUTLINE GETCOLORREGION)))
(DEFINEQ

(COLORMOVEBOX

  [LAMBDA (X1 Y1 X2 Y2 X3 Y3)                                (* rrb "26-OCT-82 15:54")

                                                             (* moves the opposite corner of a box from {X2,Y2} to 

							     {X3,Y3}.)

    (COLORHLINE
 Y1 X2 X3)
    (COLORVLINE
 X1 Y2 Y3)
    (COLORHLINE
 Y2 X1 X2)
    (COLORHLINE
 Y3 X1 X3)
    (COLORVLINE
 X2 Y1 Y2)
    (COLORVLINE
 X3 Y1 Y3])

(COLORVLINE

  [LAMBDA (X YA YB W)                                        (* rrb "26-OCT-82 15:52")

    (BITBLT NIL NIL NIL (OR W (COLORSCREENBITMAP))
	    X
	    (IMIN YA YB)
	    2
	    (IABS (IDIFFERENCE YB YA))
	    (QUOTE TEXTURE)
	    (QUOTE INVERT)
	    (MAXIMUMCOLOR])

(COLORHLINE

  [LAMBDA (Y XA XB W)                                        (* rrb "26-OCT-82 15:49")

    (BITBLT NIL NIL NIL (OR W (COLORSCREENBITMAP))
	    (IMIN XA XB)
	    Y
	    (IABS (IDIFFERENCE XB XA))
	    2
	    (QUOTE TEXTURE)
	    (QUOTE INVERT)
	    (MAXIMUMCOLOR])

(DRAWCOLORREGIONOUTLINE

  [LAMBDA (X1 Y1 X2 Y2 W)                                    (* rrb "26-OCT-82 15:52")

                                                             (* Put a gray box in window W 

							     (or on screen, if W←NIL))

    (COLORHLINE
 Y1 X1 X2 W)
    (COLORVLINE
 X1 Y1 Y2 W)
    (COLORHLINE
 Y2 X1 X2 W)
    (COLORVLINE
 X2 Y1 Y2 W])

(GETCOLORREGION

  [LAMBDA (MINWIDTH MINHEIGHT INITREGION NEWREGIONFN NEWREGIONFNARG)
                                                             (* rrb "16-NOV-82 10:32")

    (RESETFORM (CHANGECURSORSCREEN (COLORSCREENBITMAP))
	       (RESETFORM (CURSOR EXPANDINGBOX)
			  (PROG (BASEX BASEY OPPX OPPY BASEPT OPPT NEWMOUSEX NEWMOUSEY)
			        (COND
				  ((AND INITREGION (PROGN    (* A region to use if user bugs yellow)

							  (until
 (MOUSESTATE (NOT UP)))
							  (LASTMOUSESTATE MIDDLE)))
                                                             (* Pull from closest corner, ie.

							     set BASEX,Y to be opposite corner)

				    (SETQ BASEX (fetch
 (REGION LEFT) of
 INITREGION))
				    (SETQ OPPX (IPLUS BASEX (fetch
 (REGION WIDTH) of
 INITREGION)))
				    (COND
				      ((ILESSP LASTMOUSEX (IPLUS BASEX (IQUOTIENT
								   (fetch
 (REGION WIDTH)
								      of
 INITREGION)
								   2)))
                                                             (* pointing at left half of box, so make origin be in 

							     right)

					(swap
 BASEX OPPX)))
				    (SETQ BASEY (fetch
 (REGION BOTTOM) of
 INITREGION))
				    (SETQ OPPY (IPLUS BASEY (fetch
 (REGION HEIGHT) of
 INITREGION)))
				    (COND
				      ((ILESSP LASTMOUSEY (IPLUS BASEY (IQUOTIENT
								   (fetch
 (REGION HEIGHT)
								      of
 INITREGION)
								   2)))
					(swap
 BASEY OPPY)))
                                                             (* Now draw the initial box)

				    )
				  (T (until
 (MOUSESTATE (NOT UP)))
				     (SETQ BASEX LASTMOUSEX)
				     (SETQ BASEY LASTMOUSEY)
				     (SETQ OPPX BASEX)
				     (SETQ OPPY BASEY)))
			        [COND
				  (NEWREGIONFN               (* call user fn on base pt)

					       (SETQ BASEPT
						 (APPLY* NEWREGIONFN
							 (create
 POSITION
								 XCOORD ← BASEX
								 YCOORD ← BASEY)
							 NIL NEWREGIONFNARG))
					       (SETQ BASEX (fetch
 XCOORD of
 BASEPT))
					       (SETQ BASEY (fetch
 YCOORD of
 BASEPT]
			        [COND
				  (NEWREGIONFN (SETQ OPPT
						 (APPLY* NEWREGIONFN BASEPT
							 (create
 POSITION
								 XCOORD ← OPPX
								 YCOORD ← OPPY)
							 NEWREGIONFNARG))
					       (SETQ OPPX (fetch
 XCOORD of
 OPPT))
					       (SETQ OPPY (fetch
 YCOORD of
 OPPT]
			        (DRAWCOLORREGIONOUTLINE
 BASEX BASEY OPPX OPPY (COLORSCREENBITMAP))
			        (COND
				  [[ERSETQ (until
 (MOUSESTATE UP) unless
 (AND (IEQP OPPX LASTMOUSEX)
									      (IEQP OPPY LASTMOUSEY))
					      do
 (COND
						   ((MOUSESTATE (AND RIGHT (OR LEFT MIDDLE)))
						     (until
 (MOUSESTATE (NOT RIGHT)))
                                                             (* Switch to nearest corner)

						     [COND
						       ((IGEQ (IABS (IDIFFERENCE LASTMOUSEX OPPX))
							      (IABS (IDIFFERENCE LASTMOUSEX BASEX)))
							 (SETQ BASEX (PROG1 OPPX (SETQ OPPX BASEX]
						     [COND
						       ((IGEQ (IABS (IDIFFERENCE LASTMOUSEY OPPY))
							      (IABS (IDIFFERENCE LASTMOUSEY BASEY)))
							 (SETQ BASEY (PROG1 OPPY (SETQ OPPY BASEY]
						     (\SETCURSORPOSITION OPPX OPPY)
						     [COND
						       (NEWREGIONFN (SETQ BASEPT
								      (create
 POSITION
									      XCOORD ← BASEX
									      YCOORD ← BASEY
									 smashing
 BASEPT]
						     (SETCORNER BASEX BASEY OPPX OPPY))
						   (T (COND
							[NEWREGIONFN (SETQ OPPT
								       (APPLY* NEWREGIONFN BASEPT
									       (create
 POSITION
										       XCOORD ← 
										       LASTMOUSEX
										       YCOORD ← 
										       LASTMOUSEY
										  smashing
 OPPT)
									       NEWREGIONFNARG))
								     (COND
								       ((NOT (POSITIONP OPPT))
									 (ERROR 
							"non-POSITION returned from NEWREGIONFN."
										OPPT))
								       (T (SETQ NEWMOUSEX
									    (fetch
 XCOORD
									       of
 OPPT))
									  (SETQ NEWMOUSEY
									    (fetch
 YCOORD
									       of
 OPPT]
							(T (SETQ NEWMOUSEX LASTMOUSEX)
							   (SETQ NEWMOUSEY LASTMOUSEY)))
						      (COND
							((OR (NEQ NEWMOUSEX OPPX)
							     (NEQ NEWMOUSEY OPPY))
                                                             (* refresh if position changes.)

							  (COLORMOVEBOX
 BASEX BASEY OPPX OPPY 
									NEWMOUSEX NEWMOUSEY)
							  (SETQ OPPX NEWMOUSEX)
                                                             (* save for next pass)

							  (SETQ OPPY NEWMOUSEY)
							  (SETCORNER BASEX BASEY OPPX OPPY]
                                                             (* erase box image.)

				    (DRAWCOLORREGIONOUTLINE
 BASEX BASEY OPPX OPPY (COLORSCREENBITMAP))
				    (RETURN (create
 REGION
						    LEFT ←(IMIN BASEX OPPX)
						    BOTTOM ←(IMIN BASEY OPPY)
						    WIDTH ←[COND
						      [MINWIDTH (IMAX MINWIDTH
								      (IABS (IDIFFERENCE OPPX BASEX]
						      (T (IABS (IDIFFERENCE OPPX BASEX]
						    HEIGHT ←(COND
						      [MINHEIGHT (IMAX MINHEIGHT
								       (IABS (IDIFFERENCE BASEY OPPY]
						      (T (IABS (IDIFFERENCE BASEY OPPY]
				  (T                         (* ↑E take down box.)

				     (DRAWCOLORREGIONOUTLINE
 BASEX BASEY OPPX OPPY (COLORSCREENBITMAP)
							     )
				     (ERROR!])
)
(DECLARE: DONTCOPY (PUTPROPS HLCOLOR COPYRIGHT ("Xerox Corporation" 1982)))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (383 7136 (COLORMOVEBOX 393 . 828) (COLORVLINE 830 . 1113) (COLORHLINE 1115 . 1398) (
DRAWCOLORREGIONOUTLINE 1400 . 1785) (GETCOLORREGION 1787 . 7134)))))
STOP