;;; -*- Mode:Common-Lisp; Package:X11; Base:10; Fonts:(MEDFNB HL12B HL12BI) -*-

;;;                           RESTRICTED RIGHTS LEGEND

;;;Use, duplication, or disclosure by the Government is subject to
;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
;;;Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;                     TEXAS INSTRUMENTS INCORPORATED.
;;;                              P.O. BOX 2909
;;;                           AUSTIN, TEXAS 78769
;;;                                 MS 2151
;;;
;;; Copyright (C) 1987, Texas Instruments Incorporated. All rights reserved.

;;; Change history:
;;;
;;;  Date      Author	Description
;;; -------------------------------------------------------------------------------------
;;; 01/05/88	LGO	Use complete circles for rounded caps and joins in poly-line.
;;; 01/05/88	LGO	Clean up missed pixels in BEVEL-LINE-SEGS1 and *MITRE-LINE-SEGS1.*
;;; 01/05/88	LGO	Ensure polyline doesn't set pixels more than once when alu is xor.
;;; 01/04/88	LGO	Pass correct arc direction to ROUND-LINE-SEGS in POLY-LINE.
;;; 01/04/88	LGO	Re-write CALCULATE-BOUNDING-BOX.
;;; 01/03/88	LGO	Fix CALCULATE-BOUNDING-BOX for horizontal and vertical lines.
;;; 12/21/88	LGO	1Don't draw lines less than one pixel long in draw-wide-lines*
;;; 12/21/88	LGO	1Get half-width right in poly-line when doing dashed thin lines.*
;;; 12/21/88	LGO	Always call project-cap with an integer half-width.
;;; 12/07/88	LGO	In POLY-LINE, handle on-off-dash like double-dash instead of solid.
;;; 12/07/88	LGO	Make POLY-SEGMENT handle dashed lines.
;;; 12/01/88	PMH	1Switched the order in which ARC-1 and ARC-2 points were passed in round-line-segs*
;;; 11/08/88	LGO	Use WITH-DRAWABLE in poly-line and poly-segment
;;; 10/11/88	LGO	Ensure wide lines are correct width
;;; 10/11/88	LGO	Fix POLY-LINE so the first point is correct when using temporary arrays.
;;;  9/30/88	LGO	Fix POLY-SEGMENT and POLY-LINE to work on temporary arrays.
;;;  9/27/88	LGO	When drawing on temporary, use correct ALU in poly-line and poly-segment
;;;  9/21/88    LGO	Fixed poly-line to work with previous coordinate mode
;;;  5/31/88    TWE	Fixed the loop termination in POLY-SEGMENT so that it now draws
;;;			the right number of segments, instead of one too many.  Fixed a Y
;;;			value adjustment to use a Y parameter instead of the X parameter
;;;			it was using (poly-line).
;;;  5/27/88    TWE	Made poly-line work when there are strange background/foreground
;;;			pixel values.  Also fixed it so it would draw the last line
;;;			segment for the thin-line case.
;;;  3/23/88    KDB	Added routines to grab signed integers of the byte stream. Added
;;;			new aref-int16 to poly-segment.
;;;  3/04/88    TWE	Moved Poly-Point from here to GRAPHICS-REQUESTS.LISP
;;;  3/03/88    KDB	Fixed a coordinate-mode bug in Poly-Point. Now correctly does mode
;;;			previous.
;;;  3/03/88    KDB	Completed coordinate-mode handling in Poly-Line.
;;;  3/01/88    KDB	Moved Poly-point code to here.
;;;  2/25/88    KDB	Fixed bug in EXTEND-LINE-SEGMENTS. Caps were projected on wrong
;;;			ends when lines vertical.
;;;  2/25/88    KDB	Fixed several bugs in poly-line when just one line is drawn.  A
;;;			know bug is when a vertical wideline in drawn with
;;;			cap-style-round.  A center point is still drawn.
;;;  2/19/88    KDB	Re-implemented poly-line and poly-segment to handle clipping.
;;; 10/05/87    KDB/TWE	Fixed Poly-line for case where only one line is specified.	
;;; 10/05/87    KDB	Moved Poly-segment request and code here
;;;  8/10/87    KDB	Original version


(DEFUN RETURN-SLOPE (X0 Y0 X1 Y1)
  "Return the slope of the line defined by two (X,Y) pairs. The slope
  is relative to an origin of (0,0) at the top left of the screen."
  ;; example slopes:
  ;;  (RETURN-SLOPE 100 500 500 500)	; HORIZONTAL LEFT TO RIGHT
  ;;  (RETURN-SLOPE 500 500 100 500)	; HORIZONTAL RIGHT TO LEFT
  ;;  (RETURN-SLOPE 100 500 100 200)	; VERTICAL BOTTOM TO TOP
  ;;  (RETURN-SLOPE 100 200 100 500)	; VERTICAL TOP TO BOTTOM
  ;;  (RETURN-SLOPE 200 700 500 200)	; POSITIVE SLOPE
  ;;  (RETURN-SLOPE 100 200 500 700)	; NEGATIVE SLOPE "
  
  (LET ((RISE (- Y0 Y1))             ; TO ACCOUNT FOR 0,0 BEING AT TOP LEFT OF SCREEN......
	(RUN  (- X0 X1))
	SLOPE)
    (COND  ((= 0 RUN)                  ; Y POINTS ON SAME X
	    (IF (PLUSP RISE)
		(SETQ SLOPE :DOWN)
		(SETQ SLOPE :UP)))
	   ((= 0 RISE)
	    (IF (< X0 X1)              ; LEFT TO RIGHT?
		(SETQ SLOPE :RIGHT)
		(SETQ SLOPE :LEFT))) 
	   (T                          ; Now set slope value
	    (SETQ SLOPE (QUOTIENT (FLOAT RISE) RUN))))))

(DEFUN INTERSECT-LINES (X0 Y0 X1 Y1 C0 D0 C1 D1 M1 M2 &AUX B1 B2 INT-X INT-Y)
  "FIND THE (X,Y) POINTS FOR THE INTERSECTION OF THE TWO OUTSIDE
  LINES OF A WIDE LINE BOUNDING BOX."
  (COND ((AND (NOT (NUMBERP M1))
	      (NOT (NUMBERP M2)))
	 (COND ((OR (EQUAL M1 :LEFT)
		    (EQUAL M1 :RIGHT))
		(COND ((OR (EQUAL M2 :LEFT)
			   (EQUAL M2 :RIGHT)) T)       ; CONTINUOUS, COLINEAR LINE
		      ((OR (EQUAL M2 :UP)
			   (EQUAL M2 :DOWN))
		       (SETQ INT-X C0 INT-Y Y0))
		      (T (CERROR "To continue"
				 "Unknown slope ~A for second line segment." M2))))
	       ((OR (EQUAL M1 :UP)
		    (EQUAL M1 :DOWN))
		(COND ((OR (EQUAL M2 :UP)(EQUAL M2 :DOWN)) T); CONTINUOUS, COLINEAR LINE
		      ((OR (EQUAL M2 :LEFT)
			   (EQUAL M2 :RIGHT))
		       (SETQ INT-X X0 INT-Y D0))
		      (T (CERROR "To continue"
				 "Unknown slope ~A for second line segment." M2))))
	       (T (CERROR "To continue" "Unknown slope ~A for first line segment." M2))))
	((OR (NOT (NUMBERP M1))
	     (NOT (NUMBERP M2)))
	 (COND ((NUMBERP M1)						; SEG. #2 IS EITHER:
		(IF (OR (EQUAL M2 :LEFT)				; HORIZONTAL OR VERTICAL
			(EQUAL M2 :RIGHT))
		    (SETQ  B1 (- Y1 (* M1 X1))				; GIVEN Y, SOLVE FOR X
			   INT-Y D1					; X = (Y-B)/M
			   INT-X (ROUND (QUOTIENT (- INT-Y B1) M1)))
		    (SETQ  B1 (- Y1 (* M1 X1))				; GIVEN X, SOLVE FOR Y
			   INT-X C1					; Y=MX+B
			   INT-Y (ROUND (+ (* M1 INT-X) B1)))))
	       ((NUMBERP M2)						; SEG. #1 IS EITHER:
		(IF (OR (EQUAL M1 :LEFT)				; HORIZONTAL OR VERTICAL
			(EQUAL M1 :RIGHT))
		    (SETQ  B2 (- D1 (* M2 C1))				; GIVEN Y, SOLVE FOR X
			   INT-Y Y1					; X = (Y-B)/M
			   INT-X (ROUND (QUOTIENT (- INT-Y B2) M2)))
		    (SETQ  B2 (- D1 (* M2 C1))				; GIVEN X, SOLVE FOR Y
			   INT-X X1 					; Y=MX+B
			   INT-Y (ROUND (+ (* M2 INT-X) B2)))))))
	(T
	 (SETQ  B1 (- Y1 (* M1 X1))
		B2 (- D1 (* M2 C1))
		INT-X (ROUND (QUOTIENT (- B2 B1) (- M1 M2)))
		INT-Y (ROUND (+ (* M2 INT-X) B2)))))
  (VALUES  INT-X INT-Y))

(DEFUN GET-DELTA-X (X0 Y0 X1 Y1 HALF-WIDTH)
  "Get the change in X direction based on cosine of angle"
  (ROUND (* HALF-WIDTH                 ; LINE-WIDTH/2
	    (QUOTIENT  (- Y1 Y0)
		       (SQRT (+ (EXPT (- X1 X0) 2) (EXPT (- (- Y1 Y0)) 2)))))))

(DEFUN GET-DELTA-Y (X0 Y0 X1 Y1 HALF-WIDTH)
  "Get the change in Y direction based on sine of angle"
  (ROUND (* HALF-WIDTH
	    (QUOTIENT  (- X1 X0)
		       (SQRT (+ (EXPT (- X1 X0) 2) (EXPT (- (- Y1 Y0)) 2)))))))

(DEFUN WHICH-SIDE-TO-JOIN (X0 Y0 X1 Y1 X2 Y2)
  "Figure out whether the angle turns clockwise or not by taking
    the total cross product of the three vectors formed by drawing
     vectors between the start of the previous segment and the start
      and end of this one."
  ;;2  *IF JOIN-SIDE IS:2 *
  ;;	< 0, JOIN  POINTS OF THE BOUNDING BOXES A2,B2 C4,D4
  ;;	> 1, JOIN  POINTS A1,B1 C0 D0
  ;;	= 0, LINES ARE COINCIDENT."
  (- (* (- X1 X0) (- Y2 Y1))
     (* (- X2 X1) (- Y1 Y0))))

(DEFUN MITRE-LINE-SEGS (X-INT Y-INT X1 Y1 ONE-X ONE-Y NOTHER-X NOTHER-Y EXPLORER-ALU COLOR DRAWABLE)
  "Join two line segments having a common endpoint" 
  (SYS:%DRAW-SHADED-TRIANGLE X-INT Y-INT X1 Y1 ONE-X ONE-Y EXPLORER-ALU T t T COLOR DRAWABLE)
  (SYS:%DRAW-SHADED-TRIANGLE X-INT Y-INT X1 Y1 NOTHER-X NOTHER-Y EXPLORER-ALU t t T COLOR DRAWABLE))

(DEFUN EXTEND-LINE-SEGMENTS (A0 B0 A1 B1 A2 B2 A3 B3 HALF-WIDTH SLOPE &OPTIONAL (NORM-SIDE-P T))
  "Given two endpoints and a slope for the bounding box, return new
endpoints for each line, extended by the (quotient line-width 2).  The
points (X0,Y0) and (X1,Y1) extend the correct ends of the line segment."
  
  ;;                     <------- DIRECTION OF LINE
  ;;   
  ;; (X1,Y1)    (A2,B2)                          (A3,B3)  ;; EXAMPLE SHOWS THE CAP WITH 
  ;;    + ======== + ------------------------------ +     ;; NORM-SIDE-P SET TO T.
  ;;    |          | A2,B2                          |     ;; THE CAP WOULD NON-NORMALLY APPEAR
  ;;    |          |                                |     ;; ON THE END OF THE LINE DEFINED
  ;;    |          |                                |     ;; BY (A0,B0) & (A3,B3)
  ;;    |          + ------------------------------ + <-- ORIGINAL LINE USED TO CALC B-BOX.
  ;;    |          |                                |
  ;;    |          |                                |
  ;;    |          |                                |
  ;;    + ======== + ------------------------------ + 
  ;; (X0,Y0)    (A1,B1)                          (A0,B0)  
  
  (LET (X0 Y0 X1 Y1 OLD-X0 OLD-Y0 OLD-X1 OLD-Y1)
    (COND ((OR (EQUAL SLOPE :RIGHT)
	       (EQUAL SLOPE :LEFT))
	   (COND ((AND NORM-SIDE-P
		       (EQUAL SLOPE :RIGHT))
		  (SETQ X1 (+ A2 HALF-WIDTH)		; HORIZONTAL LEFT TO RIGHT
			Y1 B2				; CAP RIGHT SIDE
			X0 (+ A1 HALF-WIDTH)		; A0,B0
			Y0 B1				;   o ------- o 
			OLD-X0 A2	 		;           A1,B1 <-- CAP IS NORMALLY HERE
			OLD-Y0 B2
			OLD-X1 A1
			OLD-Y1 B1))
		 ((EQUAL SLOPE :RIGHT)			; HORIZONTAL LEFT TO RIGHT
		  (SETQ X1 (- A0 HALF-WIDTH)		; CAP LEFT SIDE
			Y1 B1				; A0,B0  <-- CAP IS NON-NORMALLY HERE
			X0 (- A3 HALF-WIDTH)		;   o ------- o
			Y0 B3	 			;           A1,B1
			OLD-X0 A0
			OLD-Y0 B0
			OLD-X1 A3
			OLD-Y1 B3))
		 ((AND NORM-SIDE-P
		       (EQUAL SLOPE :LEFT))
		  (SETQ X1 (- A2 HALF-WIDTH)		; HORIZONTAL RIGHT TO LEFT
			Y1 B2				; CAP LEFT SIDE
			X0 (- A1 HALF-WIDTH)		; A1,B1 <-- CAP IS NORMALLY HERE
			Y0 B1				;   o ------- o
			OLD-X0 A2	 		;           A0,B0
			OLD-Y0 B2
			OLD-X1 A1
			OLD-Y1 B1))
		 ((EQUAL SLOPE :LEFT)
		  (SETQ X1 (+ A0 HALF-WIDTH)		; HORIZONTAL RIGHT TO LEFT
			Y1 B0				; CAP RIGHT SIDE
			X0 (+ A3 HALF-WIDTH)		; A1,B1 
			Y0 B3				;   o ------- o
			OLD-X0 A0	 		;           A0,B0 <-- CAP IS NON-NORMALLY HERE
			OLD-Y0 B0
			OLD-X1 A3
			OLD-Y1 B3))))	  
	  ((OR (EQUAL SLOPE :DOWN)
	       (EQUAL SLOPE :UP))
	   (COND ((AND NORM-SIDE-P
		       (EQUAL SLOPE :DOWN))
		  (SETQ X1 A2				; VERTICAL BOTTOM TO TOP  
			Y1 (- B2 HALF-WIDTH)		; CAP TOP SIDE
			X0 A1				; A1,B1  O  <-- CAP IS NORMALLY HERE
			Y0 (- B1 HALF-WIDTH)		;        |
			OLD-X0 A2			;        |
			OLD-Y0 B2			;        |
			OLD-X1 A1			; A0,B0  O 
			OLD-Y1 B1))
		 ((EQUAL SLOPE :DOWN)
		  (SETQ X1 A0				; VERTICAL BOTTOM TO TOP  
			Y1  (+ B0 HALF-WIDTH)		; CAP BOTTOM SIDE
			X0 A3				; A1,B1  O 
			Y0  (+ B3 HALF-WIDTH)		;        |
			OLD-X0 A0			;        |
			OLD-Y0 B0			;        |
			OLD-X1 A3			; A0,B0  O   <-- CAP IS NON-NORMALLY HERE
			OLD-Y1 B3))
		 ((AND NORM-SIDE-P
		       (EQUAL SLOPE :UP))	
		  (SETQ X1 A2				; VERTICAL TOP TO BOTTOM  
			Y1 (+ B2 HALF-WIDTH)		; CAP BOTTOM SIDE
			X0 A1				; A0,B0  O 
			Y0 (+ B1 HALF-WIDTH)		;        |
			OLD-X0 A2			;        |
			OLD-Y0 B2			;        |
			OLD-X1 A1			; A1,B1  O <-- CAP IS NORMALLY HERE
			OLD-Y1 B1))
		 ((EQUAL SLOPE :UP)	
		  (SETQ X1 A0				; VERTICAL TOP TO BOTTOM  
			Y1 (- B0 HALF-WIDTH)		; CAP TOP SIDE
			X0 A3				; A0,B0  O <-- CAP IS NON-NORMALLY HERE
			Y0 (- B3 HALF-WIDTH)		;        |
			OLD-X0 A0			;        |
			OLD-Y0 B0			;        |
			OLD-X1 A3			; A1,B1  O 
			OLD-Y1 B3))))

          (T
           (LET* ((DELTA-EX  (ABS (GET-DELTA-X A0 B0 A3 B3 HALF-WIDTH)))  ;Use cosine theta perpendicular
                  (DELTA-WHY (ABS (GET-DELTA-Y A0 B0 A3 B3 HALF-WIDTH)))   ; Line A0,B0 A1,B1
                  (RISE     (- B0 B1))   ;1 Do this again here. It is cheap and beats passing back multiple values from *
                  (DIRECTION            ;1 the return-slope function. we only hit this code if lines are not perpendicular.* 
                    (IF (PLUSP RISE)
                        ;;1 UP OR DOWN?*
                        :BOTTOM-TO-TOP
                        :TOP-TO-BOTTOM
                        )))            ; LINE A0,B0 A1,B1
             (IF (EQL  DIRECTION :BOTTOM-TO-TOP) ;1 test all four possibilities*	        
                 (COND ((AND NORM-SIDE-P
                             (PLUSP SLOPE)) 
                        (SETQ X1 (+ A0 DELTA-EX)	; BOTTOM1 TO*  TOP; NON-NORMAL CAP
                              Y1 (+ B0 DELTA-WHY)	; A0,B0  o  <-- CAP IS NON-NORMALLY HERE
                              X0 (+ A3 DELTA-EX)	;         \   
                              Y0 (+ B3 DELTA-WHY)	;          \   
                              OLD-X0 A0			;           \
                              OLD-Y0 B0			;      A1,B1 o
                              OLD-X1 A3
                              OLD-Y1 B3))
                       ((PLUSP SLOPE)
                        (SETQ X1 (- A2 DELTA-EX)	;1  *BOTTOM1 TO*  TOP; NORMAL CAP
                              Y1 (- B2 DELTA-WHY)	; A0,B0  o 
                              X0 (- A1 DELTA-EX)        ;         \   
                              Y0 (- B1 DELTA-WHY)       ;          \
                              OLD-X0 A2			;           \
                              OLD-Y0 B2			;      A1,B1 o <-- CAP IS NORMALLY HERE
                              OLD-X1 A1
                              OLD-Y1 B1))
                       (NORM-SIDE-P
                        (SETQ X1 (+ A2 DELTA-EX)        ; BOTTOM TO TOP; NORMAL CAP
                              Y1 (- B2 DELTA-WHY)       ;    A1,B1  o <-- CAP IS NORMALLY HERE
                              X0 (+ A1 DELTA-EX)        ;          /
                              Y0 (- B1 DELTA-WHY)       ;         /
                              OLD-X0 A2			;        /
                              OLD-Y0 B2			; A0,B0 o
                              OLD-X1 A1
                              OLD-Y1 B1))
                       (T
                        (SETQ X1 (- A0 DELTA-EX)        ; BOTTOM TO TOP; NON-NORMAL CAP
                              Y1 (+ B0 DELTA-WHY)       ;    A1,B1  o 
                              X0 (- A3 DELTA-EX)        ;          /
                              Y0 (+ B3 DELTA-WHY)       ;         /
                              OLD-X0 A0			;        /
                              OLD-Y0 B0			; A0,B0 o  <-- CAP IS NON-NORMALLY HERE
                              OLD-X1 A3
                              OLD-Y1 B3)))
                 ;;ELSE1 TOP-TO-BOTTOM. CHANGE THE SIDE  LINE ON WHICH CAP IS PROJECTED*
                 (COND ((AND NORM-SIDE-P
                             (PLUSP SLOPE)) 
                        (SETQ X1 (- A0 DELTA-EX)	; TOP TO BOTTOM; NORMAL CAP
                              Y1 (- B0 DELTA-WHY)	; A0,B0  o 
                              X0 (- A3 DELTA-EX)	;         \   
                              Y0 (- B3 DELTA-WHY)	;          \   
                              OLD-X0 A0			;           \
                              OLD-Y0 B0			;      A1,B1 o1 * <-- CAP IS NORMALLY HERE
                              OLD-X1 A3
                              OLD-Y1 B3))
                       ((PLUSP SLOPE)
                        (SETQ X1 (+ A2 DELTA-EX)	; TOP TO BOTTOM; 1NON-*NORMAL CAP
                              Y1 (+ B2 DELTA-WHY)	; A0,B0  o  <-- CAP IS NON-NORMALLY HERE
                              X0 (+ A1 DELTA-EX)	;         \
                              Y0 (+ B1 DELTA-WHY)	;          \
                              OLD-X0 A2			;           \
                              OLD-Y0 B2			;      A1,B1 o <-- CAP IS NORMALLY HERE
                              OLD-X1 A1
                              OLD-Y1 B1))
                       (NORM-SIDE-P
                        (SETQ X1 (- A2 DELTA-EX)	;  TOP TO BOTTOM;  NORMAL CAP
                              Y1 (+ B2 DELTA-WHY)	;    A10*,B10*  o 
                              X0 (- A1 DELTA-EX)	;          /
                              Y0 (+ B1 DELTA-WHY)	;         /
                              OLD-X0 A2			;        /
                              OLD-Y0 B2			; A11*,B11* o  <-- CAP IS NORMALLY HERE
                              OLD-X1 A1
                              OLD-Y1 B1))
                       (T
                        (SETQ X1 (+ A0 DELTA-EX)	; TOP TO BOTTOM; 1NON-*NORMAL CAP
                              Y1 (- B0 DELTA-WHY)	;    A1,B1  o <-- CAP IS 1NON-*NORMALLY HERE
                              X0 (+ A3 DELTA-EX)	;          /
                              Y0 (- B3 DELTA-WHY)	;         /
                              OLD-X0 A0			;        /
                              OLD-Y0 B0			; A0,B0 o
                              OLD-X1 A3
                              OLD-Y1 B3)))))))
    (VALUES X0 Y0 X1 Y1 OLD-X0 OLD-Y0 OLD-X1 OLD-Y1)))

(DEFUN CALCULATE-BOUNDING-BOX (X0 Y0 X1 Y1 HALF-WIDTH)
  "2Return the corners of the polygon formed for a line with endpoints xy/y0, xy/y1 and half-width*"
  ;; If width is >1, then the bounding box, defined
  ;; as (A0,B0) (A1,B1) (A2,B2) & (A3,B3) is returned.
  ;;
  ;;                     (X1,Y1)
  ;;            A1,B1 +-----X-----+ A2,B2
  ;;                  |    /|\    |
  ;;                  |  /  |  \  |
  ;;                  |     |     |
  ;;                  |     |     |
  ;;                  |     |     |
  ;;                  |     |     |
  ;;                  |     |     |
  ;;                  |     |     |
  ;;	              |     |     |
  ;;     	      |     |     |
  ;;	        A0,B0 +-----X-----+ A3,B3
  ;;                     (X0,Y0)
  (let* ((dx (- x0 x1))
	 (dy (- y0 y1))
	 (hypot (short-float (sqrt (+ (expt dx 2) (expt dy 2)))))
	 (ff 0.5s0))
    (if (zerop hypot) ;1; zero length line*
	(values
	  (floor (+ x0 half-width)) y1
	  (floor (+ x0 half-width)) y1
	  (floor (- x0 half-width)) y1
	  (floor (- x0 half-width)) y1)
      (let ((dx (+ ff (quotient (* dy half-width) hypot)))
	    (dy (+ ff (quotient (* dx half-width) hypot))))
	(values (floor (- x0 dx)) (floor (+ y0 dy))
		(floor (- x1 dx)) (floor (+ y1 dy))
		(floor (+ x1 dx)) (floor (- y1 dy))
		(floor (+ x0 dx)) (floor (- y0 dy)))))))

(DEFUN ROUND-LINE-SEGS (CENTER-X CENTER-Y ARC-1-X ARC-1-Y ARC-2-X ARC-2-Y
                        COUNTER-CLOCKWISE-P GCONTEXT EXPLORER-ALU COLOR DESTINATION)
  "Round the join between two line segments.  Swing arc counterclockwise clockwise
  from arc 1 to arc 2 depending on order lines and join-side."
  (declare (ignore  ARC-1-X ARC-1-Y COUNTER-CLOCKWISE-P GCONTEXT))
  (draw-circle-internal CENTER-X CENTER-Y  ARC-2-X ARC-2-Y EXPLORER-ALU COLOR DESTINATION)
  #+comment
  (DRAW-ARC-INTERNAL CENTER-X CENTER-Y  ARC-2-X ARC-2-Y ARC-1-X ARC-1-Y
                     COUNTER-CLOCKWISE-P GCONTEXT EXPLORER-ALU COLOR DESTINATION))

(DEFUN PROJECT-CAP (A0 B0 A1 B1 A2 B2 A3 B3 HALF-WIDTH SLOPE DRAWABLE EXPLORER-ALU COLOR
                    &OPTIONAL (NORM-END-P T))
  "Calculate new (X,Y) values for the endpoints of bounding box.
2   *Extend the bounding box by drawing two triangles which the original and
2   *extended points.  The points (A0,B0) and (C3,D3) can be on either side
2   *of the line segment"
  (MULTIPLE-VALUE-BIND (X0 Y0 X1 Y1 OLD-X0 OLD-Y0 OLD-X1 OLD-Y1)
      (EXTEND-LINE-SEGMENTS A0 B0 A1 B1 A2 B2 A3 B3 HALF-WIDTH SLOPE NORM-END-P)
    (SYS:%DRAW-SHADED-TRIANGLE  X1 Y1 OLD-X0 OLD-Y0 OLD-X1 OLD-Y1 EXPLORER-ALU T   NIL T COLOR DRAWABLE)
    (SYS:%DRAW-SHADED-TRIANGLE  X1 Y1 OLD-X1 OLD-Y1 X0     Y0     EXPLORER-ALU NIL T   T COLOR DRAWABLE)))


(DEFUN BEVEL-LINE-SEGS (X0 Y0 X1 Y1 X2 Y2 EXPLORER-ALU COLOR DRAWABLE)
  "Fill the crack of two line segments."
  ;; Draw the lines in the order shown. The NIL sides are not drawn.
  ;;
  ;;                                   T             
  ;;      THIRD   X2,Y2 -------------------------------- X1,Y1  SECOND
  ;;                    \                              /
  ;;                     \                            /
  ;;                      \                          /
  ;;                       \                        /
  ;;                        \                      /
  ;;                         \                    /
  ;;                          \                  /
  ;;                           \                /
  ;;                        NIL \              /  NIL
  ;;                             \            /
  ;;                              \          /
  ;;                               \        /
  ;;                                \      /
  ;;                                 \    /
  ;;                                  \  /
  ;;                                   \/
  ;;                                  X0,Y0   FIRST    
  (SYS:%DRAW-SHADED-TRIANGLE X0 Y0 X1 Y1 X2 Y2 EXPLORER-ALU t T t COLOR DRAWABLE))

(DEFUN DRAW-LINE (X0 Y0 X1 Y1 EXPLORER-ALU END-POINT-P DRAWABLE)
 "Draw a line. Clipping is done in calling routine."
  (SYS:%DRAW-LINE X0 Y0 X1 Y1 EXPLORER-ALU END-POINT-P DRAWABLE))

(DEFUN DRAW-WIDE-LINE (A0 B0 A1 B1 A2 B2 A3 B3 EXPLORER-ALU COLOR DRAWABLE)
  "Draw a wide line. Clipping is done in calling routine"
  (SYS:%DRAW-SHADED-TRIANGLE A0 B0 A1 B1 A3 B3 EXPLORER-ALU T NIL T COLOR DRAWABLE)
  (SYS:%DRAW-SHADED-TRIANGLE A1 B1 A2 B2 A3 B3 EXPLORER-ALU T T   T COLOR DRAWABLE))

(DEFUN DRAW-DASHED-LINES
       (X0 Y0 X1 Y1 EXPLORER-ALU HALF-WIDTH COLOR DRAWABLE-ARRAY
        &OPTIONAL &KEY (DASH-SPACING 4) (OFFSET 0)
        (DASH-LENGTH DASH-SPACING))
  "Use poly-line internals to make wide dashes. Draw them out."
  (LET (N-DASHES
	DISTANCE 
	REAL-DASH-SPACING
	(REAL-DASH-LENGTH DASH-LENGTH)
	A0 B0 A1 B1 A2 B2 A3 B3)
    (SETQ DISTANCE (SQRT (SMALL-FLOAT (+ (EXPT (- X1 X0) 2) (EXPT (- Y1 Y0) 2)))))
    (when (> distance 1.0s0) ;1; Skip lines less than a pixel*
      ;; Take care of the case where the two (x,y) points specify the same point.
      ;; Get approximate number of dashes that will fit,
      ;; then change spacing to make them fit exactly.
      (PROGN             
	(SETQ N-DASHES (ROUND (+ DISTANCE DASH-SPACING) (+ DASH-SPACING DASH-LENGTH)))
	(IF (= N-DASHES 1)
	    (SETQ REAL-DASH-SPACING DISTANCE
		  REAL-DASH-LENGTH (- DISTANCE OFFSET OFFSET))
	  (SETQ REAL-DASH-SPACING
		(QUOTIENT (- DISTANCE OFFSET OFFSET DASH-LENGTH) (1- N-DASHES)))))
      (LET ((X (+ X0 (* OFFSET (QUOTIENT (- X1 X0) DISTANCE))))
	    (Y (+ Y0 (* OFFSET (QUOTIENT (- Y1 Y0) DISTANCE))))
	    (DX (* REAL-DASH-LENGTH (QUOTIENT (- X1 X0) DISTANCE)))
	    (DY (* REAL-DASH-LENGTH (QUOTIENT (- Y1 Y0) DISTANCE)))
	    (DX2 (* REAL-DASH-SPACING (QUOTIENT (- X1 X0) DISTANCE)))
	    (DY2 (* REAL-DASH-SPACING (QUOTIENT (- Y1 Y0) DISTANCE))))
	
	(DOTIMES (I N-DASHES)
	  (IF (> HALF-WIDTH 1)
	      (PROGN  (MULTIPLE-VALUE-SETQ (A0 B0 A1 B1 A2 B2 A3 B3)
			(CALCULATE-BOUNDING-BOX X Y (+ X DX) (+ Y DY) HALF-WIDTH))
		      (DRAW-WIDE-LINE (ROUND A0) (ROUND B0) (ROUND A1) (ROUND B1) (ROUND A2)
				      (ROUND B2) (ROUND A3) (ROUND B3)  EXPLORER-ALU COLOR DRAWABLE-ARRAY))
            ;;ELSE
            (PROGN 
              (DRAW-LINE (ROUND X) (ROUND Y) (ROUND (+ X DX)) (ROUND (+ Y DY)) EXPLORER-ALU T
                         DRAWABLE-ARRAY)))
	  (INCF X DX2)
	  (INCF Y DY2))))))

(DEFUN POLY-LINE (GCONTEXT DRAWABLE COORD-MODE NUM-POINTS POINT-ARRAY STARTING-OFFSET)
  "Poly-lines are drawn here."
  (IF  (< NUM-POINTS 2)
       (BAD-LENGTH)
    ;;ELSE
    (with-drawable (drawable gcontext :clipping-rectangle t
			     ;1; Wide lines overlap.  Force drawing to a temporary when alu is xor.*
			     :overlap (> (gcontext.line-width gcontext) 1))
		   (destination-array window-x window-y explorer-alu drawable-boundaries)
      (setq explorer-alu (AREF X-ALU-TO-EXPLORER-ALU explorer-alu))
      (LET* ((JOIN-STYLE     (GCONTEXT.JOIN-STYLE GCONTEXT))
	     (CAP-STYLE      (GCONTEXT.CAP-STYLE  GCONTEXT))
	     ;;  HACK ALERT. If line style ON-OFF-DASH, then fake a dash. Dash
	     ;;  width is based on linewidth.
	     (LINE-STYLE     (GCONTEXT.LINE-STYLE  GCONTEXT)) 
	     ;; NEED TO MORE FULLY MPLEMENT DASHES AT SOME POINT.
	     ;1;       *(DASH-OFFSET    (GCONTEXT.DASH-OFFSET   GCONTEXT)) ;1WHERE DASHES START*
	     (DASH           (GCONTEXT.DASH   GCONTEXT)) 1; dash pattern*
	     ;1;*	(DASH-LENGTH    (GCONTEXT.NUM-IN-DASH-LIST GCONTEXT)) 1; num elements in dash list*
	     (width (GCONTEXT.LINE-WIDTH  GCONTEXT))
	     ;; Thin lines of zero are just like width of one, except they are faster.
	     (WIDE-LINES     (> width 1))	;1 GET HALF-WIDTH, IF WIDE.*
	     (HALF-WIDTH    (and wide-lines
				 (if (oddp width) (/ width 2.0s0) (truncate width 2))))
	     (JOIN-SIDE     0)			; ASSUME COLINEAR LINES...
	     ;; Make predicate to save many EQL tests later.
	     (ORIGIN-REL-P   (EQL COORD-MODE COORD-MODE-ORIGIN))
	     (1ST-X-POS        STARTING-OFFSET)	; First element of array
	     (1ST-Y-POS        (+ STARTING-OFFSET 1))	; Second element.
	     ;; 1st (X,Y) point relative to the origin,
	     (FIRST-X0         (+ WINDOW-X (AREF-int16 POINT-ARRAY 1ST-X-POS)))
	     (FIRST-Y0         (+ WINDOW-Y (AREF-int16 POINT-ARRAY 1ST-Y-POS)))
	     FIRST-X1
	     FIRST-Y1
	     FIRST-SLOPE1
	     SLOPE2
	     X-INT
	     Y-INT
	     1ST-A0				; FIRST POINT OF BOUNDING BOX
	     1ST-B0
	     1ST-A1
	     1ST-B1
	     1ST-A2
	     1ST-B2
	     1ST-A3
	     1ST-B3
	     C0					; DEFINES SECOND BOUNDING BOX
	     D0
	     C1
	     D1
	     C2
	     D2
	     C3
	     D3)
	;; Loop through the points.
	(LOOP
	  FOR COUNT FROM 1 TO (IF (EQL NUM-POINTS 2)	; Special case of only one line?
				  1
				;;ELSE usual case with two or more lines...
				(- NUM-POINTS 2))
	  
	  ;; Next even element of ARRAY, XPOS
	  FOR NEXT-X-POS upfrom (+ 1ST-X-POS 2) by 2
	  ;; Next odd element of ARRAY, YPOS
	  FOR NEXT-Y-POS upfrom (+ 1ST-Y-POS 2) by 2
	  ;;
	  ;;DOCUMENTATION ALERT. The next few X Y bindings need to account for the
	  ;; coord-mode arg.  If coord-mode is relative to origin, origin-rel-p
	  ;; flag is T.  We then have to offset the X Y positions relative to the
	  ;; window origin, which will generally be the absolute outside X,Y
	  ;; coordinates if a pixmap, they will be zero.  If coord-mode is
	  ;; coord-mode-previous (1), we need to offset the first X,Y pair by the
	  ;; origin, and then offset the next pair relative to the previous X,Y
	  ;; positions.
	  ;;
	  
	  FOR X0 = FIRST-X0  THEN x1
	  FOR Y0 = FIRST-Y0  THEN y1
	  ;; This binding happens on the first iteration of the LOOP
	  FOR X1 = (IF ORIGIN-REL-P
		       (+ WINDOW-X (AREF-INT16 POINT-ARRAY NEXT-X-POS))
		     ;;ELSE
		     (+ X0 (AREF-INT16 POINT-ARRAY NEXT-X-POS)))
	  THEN x2
	  FOR Y1 = (IF ORIGIN-REL-P
		       (+ WINDOW-Y (AREF-INT16 POINT-ARRAY NEXT-Y-POS))
		     ;;ELSE Relative to previous Y.
		     (+ Y0 (AREF-INT16 POINT-ARRAY NEXT-Y-POS)))
	  THEN y2
	  ;; Special case of only one line. Get end-point of single line.
	  FOR X2 = (IF (EQL NUM-POINTS 2)
		       X1			; X1 Already offset
		     ;;ELSE Usual case of two or more lines.
		     (IF ORIGIN-REL-P
			 (+ WINDOW-X (AREF-INT16 POINT-ARRAY (+ 2 NEXT-X-POS)))
		       ;;ELSE
		       (+ X1 (AREF-INT16 POINT-ARRAY (+ 2 NEXT-X-POS)))))
	  
	  FOR Y2 = (IF (EQL NUM-POINTS 2)
		       Y1
		     ;;ELSE
		     (IF ORIGIN-REL-P
			 (+ WINDOW-Y (AREF-INT16 POINT-ARRAY (+ 2 NEXT-Y-POS)))
		       (+ Y1 (AREF-INT16 POINT-ARRAY (+ 2 NEXT-Y-POS)))))
	  FOR SLOPE1 = NIL  THEN SLOPE2	
	  FOR A0     = NIL  THEN C0		; Defines first bounding box
	  FOR B0     = NIL  THEN D0		;
	  FOR A1     = NIL  THEN C1		;     X1,Y1                        X0,Y0      X2,Y2
	  FOR B1     = NIL  THEN D1		;     /  \  First time:             / \        /
	  FOR A2     = NIL  THEN C2		;    /    \  then "advance" saving /   \      /
	  FOR B2     = NIL  THEN D2		;   /      \    first points      /     \    /
	  FOR A3     = NIL  THEN C3		;  /        \                    /       \  /
	  FOR B3     = NIL  THEN D3		; X0,Y0     X2,Y2         FIRST-X0,Y0    X1,Y1
	  DO
	  (IF WIDE-LINES
	      (PROGN  
		(WHEN (NULL A0)
		  (MULTIPLE-VALUE-SETQ (A0 B0 A1 B1 A2 B2 A3 B3)
		    (CALCULATE-BOUNDING-BOX X0 Y0 X1 Y1 HALF-WIDTH))
		  (SETQ SLOPE1 (RETURN-SLOPE X0 Y0 X1 Y1)
			FIRST-SLOPE1 SLOPE1)
		  (SETQ 1ST-A0 A0 1ST-B0 B0 1ST-A1 A1 1ST-B1 B1
			1ST-A2 A2 1ST-B2 B2 1ST-A3 A3 1ST-B3 B3 FIRST-X1 X1 FIRST-Y1 Y1)
		  ;; HACK ALERT!  Not really drawing X's dashed lines.
		  (IF (EQL LINE-STYLE  LINE-STYLE-solid)
		      ;; Draw First B-BOX.
		      (DRAW-WIDE-LINE A0 B0 A1 B1 A2 B2 A3 B3 EXPLORER-ALU
				      COLOR DESTINATION-ARRAY)
		    ;;ELSE
		    (DRAW-DASHED-LINES X0 Y0 X1 Y1 EXPLORER-ALU HALF-WIDTH
				       COLOR DESTINATION-ARRAY
				       :dash-spacing (aref dash 0) ;1; width*
				       :dash-length (aref dash 1))))
		
		(MULTIPLE-VALUE-SETQ (C0 D0 C1 D1 C2 D2 C3 D3)
		  (CALCULATE-BOUNDING-BOX X1 Y1 X2 Y2 HALF-WIDTH))
		(SETQ SLOPE2 (RETURN-SLOPE X1 Y1 X2 Y2))
		;; Don't draw second box  or join, etc. If only one line.
		(WHEN (NOT (EQL  NUM-POINTS 2))
		  ;; HACK ALERT!  Not really drawing X's dashed lines.
		  (IF (EQL LINE-STYLE  LINE-STYLE-solid)
		      ;; Draw Second B-BOX.
		      (DRAW-WIDE-LINE C0 D0 C1 D1 C2 D2 C3 D3 EXPLORER-ALU
				      COLOR DESTINATION-ARRAY)
		    (DRAW-DASHED-LINES X1 Y1 X2 Y2  EXPLORER-ALU HALF-WIDTH
				       COLOR DESTINATION-ARRAY
				       :dash-spacing (aref dash 0) ;1; width*
				       :dash-length (aref dash 1)))
		  
		  (SETQ JOIN-SIDE (WHICH-SIDE-TO-JOIN X0 Y0 X1 Y1 X2 Y2))
		  (WHEN (NOT (ZEROP JOIN-SIDE))
		    (WHEN (PLUSP JOIN-SIDE)  
		      (COND
			((EQL JOIN-STYLE JOIN-STYLE-BEVEL)
			 (BEVEL-LINE-SEGS X1 Y1 C0 D0 A1 B1 EXPLORER-ALU COLOR DESTINATION-ARRAY))
			((EQL JOIN-STYLE JOIN-STYLE-MITER)
			 (MULTIPLE-VALUE-SETQ  (X-INT Y-INT)
			   (INTERSECT-LINES A0 B0 A1 B1 C0 D0 C1 D1 SLOPE1 SLOPE2))
			 (MITRE-LINE-SEGS X-INT Y-INT X1 Y1 A1 B1 C0 D0 EXPLORER-ALU
					  COLOR DESTINATION-ARRAY))
			(T (ROUND-LINE-SEGS X1 Y1 A1 B1 C0 D0 t GCONTEXT EXPLORER-ALU
					    COLOR DESTINATION-ARRAY))))
		    ;;ELSE... JOIN-OTHER side
		    (WHEN  (MINUSP JOIN-SIDE)	; JOIN-HERE
		      (COND ((EQUAL JOIN-STYLE JOIN-STYLE-BEVEL)
			     (BEVEL-LINE-SEGS  X1 Y1 A2 B2 C3 D3 EXPLORER-ALU  COLOR DESTINATION-ARRAY))
			    ((EQUAL JOIN-STYLE JOIN-STYLE-MITER)
			     (MULTIPLE-VALUE-SETQ (X-INT Y-INT)
			       (INTERSECT-LINES A2 B2 A3 B3 C2 D2 C3 D3 SLOPE1 SLOPE2))
			     (MITRE-LINE-SEGS X-INT Y-INT X1 Y1 A2 B2 C3 D3 EXPLORER-ALU
                                              COLOR DESTINATION-ARRAY))
			    (T (ROUND-LINE-SEGS X1 Y1 A2 B2 C3 D3 nil GCONTEXT EXPLORER-ALU
						COLOR DESTINATION-ARRAY)))))))	; Clockwise 
	    ;; ELSE Draw thin-line (width of one).
	    (IF (EQL CAP-STYLE CAP-STYLE-NOT-LAST)
		(DRAW-LINE X0 Y0 X1 Y1 EXPLORER-ALU NIL DESTINATION-ARRAY)
	      ;;ELSE draw last point of line.
	      (IF (EQL LINE-STYLE LINE-STYLE-solid)
		  (DRAW-LINE X0 Y0 X1 Y1 EXPLORER-ALU T DESTINATION-ARRAY)
		;; HACK ALERT!  Not really drawing X's dashed lines.
		(DRAW-DASHED-LINES X0 Y0 X1 Y1 EXPLORER-ALU 0.5s0
				   COLOR DESTINATION-ARRAY
				       :dash-spacing (aref dash 0) ;1; width*
				       :dash-length (aref dash 1)))))
	  
	  FINALLY				; !!! DO THE LAST LINE
	  (IF WIDE-LINES
	      (IF  (AND (EQL FIRST-X0 X2) (EQL FIRST-Y0 Y2))     
		   ;; Join us. Don't worry about caps.
		   (PROGN
		     (UNLESS (ZEROP (SETQ JOIN-SIDE (WHICH-SIDE-TO-JOIN
						      X0 Y0 FIRST-X0 FIRST-Y0
						      FIRST-X1 FIRST-Y1)))
		       ;; Think of this angle as resulting from
		       ;; drawing a square in clockwise direction.
		       (IF (PLUSP JOIN-SIDE)
			   (COND ((EQL JOIN-STYLE JOIN-STYLE-BEVEL)
				  (BEVEL-LINE-SEGS FIRST-X0 FIRST-Y0 1ST-A0 1ST-B0 C1 D1
						   EXPLORER-ALU  COLOR  DESTINATION-ARRAY))
				 ((EQL JOIN-STYLE JOIN-STYLE-MITER)
				  ;; JOIN-SIDE value determines angle and
				  ;; which lines must be intersected when
				  (MULTIPLE-VALUE-SETQ (X-INT Y-INT)     
				    (INTERSECT-LINES  1ST-A0 1ST-B0 1ST-A1 1ST-B1
						      C0 D0 C1 D1
						      FIRST-SLOPE1 SLOPE2)) 
				  (MITRE-LINE-SEGS X-INT Y-INT FIRST-X0 FIRST-Y0
						   1ST-A0 1ST-B0 C1 D1 
						   EXPLORER-ALU COLOR DESTINATION-ARRAY))
				 (T
				  ;;; Swing it clockwise
				  (ROUND-LINE-SEGS FIRST-X0 FIRST-Y0 1ST-A0 1ST-B0 C1 D1 nil
						   GCONTEXT EXPLORER-ALU COLOR DESTINATION-ARRAY)))
			 ;;ELSE
			 (COND ((EQL JOIN-STYLE JOIN-STYLE-BEVEL)
				;; Think about drawing in counter-clockwise direction
				;; starting at 3 o'clock to get "outside" lines.
				(BEVEL-LINE-SEGS FIRST-X0 FIRST-Y0  1ST-A3 1ST-B3 C2 D2
						 EXPLORER-ALU  COLOR DESTINATION-ARRAY))
			       ((EQL JOIN-STYLE JOIN-STYLE-MITER)
				(MULTIPLE-VALUE-SETQ (X-INT Y-INT)
				  (INTERSECT-LINES 1ST-A2 1ST-B2 1ST-A3 1ST-B3 C2 D2 C3 D3
						   FIRST-SLOPE1 SLOPE2))        
				(MITRE-LINE-SEGS X-INT Y-INT  FIRST-X0 FIRST-Y0
						 1ST-A3 1ST-B3 C2 D2 
						 EXPLORER-ALU COLOR  DESTINATION-ARRAY))
			       (T		;ELSE ROUND JOINSTYLE
				(ROUND-LINE-SEGS FIRST-X0 FIRST-Y0 1ST-A3 1ST-B3 C2 D2 t
						 GCONTEXT EXPLORER-ALU
						 COLOR DESTINATION-ARRAY))))))
		;;ELSE Not joined. Donn our caps.
		(PROGN 
		  (COND ((EQL CAP-STYLE CAP-STYLE-ROUND)
			 (draw-circle-internal FIRST-X0 FIRST-Y0 1ST-A0 1ST-B0
					       EXPLORER-ALU COLOR DESTINATION-ARRAY)
			 #+comment ;1; use circle instead*
			 (DRAW-ARC-INTERNAL FIRST-X0 FIRST-Y0 1ST-A0 1ST-B0
					    1ST-A3 1ST-B3 T GCONTEXT EXPLORER-ALU
					    COLOR DESTINATION-ARRAY)
			 ;;If just one line, cap it, instead of the end of last line..
			 (IF (EQL NUM-POINTS 2)
			     (draw-circle-internal FIRST-X1 FIRST-Y1 1ST-A1 1ST-B1
						   EXPLORER-ALU COLOR DESTINATION-ARRAY)
			   ;;ELSE
			   (draw-circle-internal X2 Y2 C2 D2
						 EXPLORER-ALU COLOR DESTINATION-ARRAY))
			 #+comment ;1; use circle instead*
			 (IF (EQL NUM-POINTS 2)
			     (DRAW-ARC-INTERNAL FIRST-X1 FIRST-Y1 1ST-A1 1ST-B1
						1ST-A2 1ST-B2
						NIL GCONTEXT EXPLORER-ALU COLOR DESTINATION-ARRAY)
			   ;;ELSE
			   (DRAW-ARC-INTERNAL X2 Y2 C2 D2 C1 D1 T GCONTEXT EXPLORER-ALU
					      COLOR DESTINATION-ARRAY)))
			((EQL CAP-STYLE CAP-STYLE-PROJECTING)
			 ;; Extend cap of start of 1st line.
			 (PROJECT-CAP 1ST-A0 1ST-B0 1ST-A1 1ST-B1 1ST-A2 1ST-B2
				      1ST-A3 1ST-B3
				      (round HALF-WIDTH 2)
				      FIRST-SLOPE1 DESTINATION-ARRAY EXPLORER-ALU COLOR NIL)
			 
			 (IF (EQL NUM-POINTS 2)
			     ;; If just one line, extend end of it, instead of the
			     ;; end of last line..
			     (PROJECT-CAP 1ST-A0 1ST-B0 1ST-A1 1ST-B1 1ST-A2 1ST-B2
					  1ST-A3 1ST-B3
					  (round HALF-WIDTH 2)
					  FIRST-SLOPE1 DESTINATION-ARRAY EXPLORER-ALU COLOR T)
			   
			   ;;ELSE
			   (PROJECT-CAP C0 D0 C1 D1 C2 D2 C3 D3 
					(round HALF-WIDTH 2) SLOPE2
					DESTINATION-ARRAY EXPLORER-ALU COLOR T)))
			
			(T			; Just a butt. Won't have cap-style-not-last
			 ))))
	    ;;ELSE Draw the last thin line
	    (IF (EQL CAP-STYLE CAP-STYLE-NOT-LAST)
		(DRAW-LINE X1 Y1 X2 Y2 EXPLORER-ALU NIL DESTINATION-ARRAY)
	      ;;ELSE draw last point of line.
	      (IF (EQL LINE-STYLE LINE-STYLE-solid)
		  (DRAW-LINE X1 Y1 X2 Y2 EXPLORER-ALU T DESTINATION-ARRAY)
		;; HACK ALERT!  Not really drawing X's dashed lines.
		(DRAW-DASHED-LINES X1 Y1 X2 Y2 EXPLORER-ALU 0.5s0
				   COLOR DESTINATION-ARRAY)))))))))
	 
(DEFREQ POLY-LINE ((:GRAPHICS)
		   (COORD-MODE (CARD8 COORD-MODE-ORIGIN COORD-MODE-PREVIOUS))
		   (DRAWABLE DRAWABLE)
		   (GC GCONTEXT)
		   (:WORD 2))
  (POLY-LINE GC DRAWABLE COORD-MODE LENGTH WORDS WORD-OFFSET))


(DEFREQ POLY-SEGMENT ((:GRAPHICS)
		      (DRAWABLE DRAWABLE)
		      (GC GCONTEXT)
		      (:WORD 4))
  (POLY-SEGMENT GC DRAWABLE LENGTH WORDS WORD-OFFSET))


(DEFUN POLY-SEGMENT (GCONTEXT DRAWABLE NUM-SEGS SEG-ARRAY SEG-ARRAY-OFFSET)
  "Draws wide or thin line segments."
    (LET* (;; Thin lines of zero are just like width of one.
	   (WIDE-LINES     (> (GCONTEXT.LINE-WIDTH GCONTEXT) 1))
	   (CAP-STYLE      (GCONTEXT.CAP-STYLE  GCONTEXT))
           ;; Don't draw last point of line if T.
	   (END-POINT-P    (IF (EQL CAP-STYLE CAP-STYLE-NOT-LAST) NIL T))
           (LINE-STYLE     (GCONTEXT.LINE-STYLE  GCONTEXT)) 
	   )
	(IF  (or WIDE-LINES (not (eql line-style line-style-solid)))
	     (DO ((INDEX 0 (+ INDEX 4))
		  ;; Stop when array-pos + number of points is passed.  
		  (STOP  (+ SEG-ARRAY-OFFSET  (* NUM-SEGS 4))))
		 ((>= (+ SEG-ARRAY-OFFSET INDEX) STOP))
	       ;; Just draw one line..1.*
	       (POLY-LINE GCONTEXT DRAWABLE 0 2 SEG-ARRAY (+ INDEX SEG-ARRAY-OFFSET)))
	  ;1; Else the fast case*
	  (with-drawable (drawable gcontext :clipping-rectangle t)
			 (destination-array inside-x inside-y explorer-alu drawable-boundaries)
	    (setq explorer-alu (AREF X-ALU-TO-EXPLORER-ALU explorer-alu))
	    (DO ((INDEX 0 (+ INDEX 4))
		 ;; Stop when array-pos + number of points is passed.  
		 (STOP  (+ SEG-ARRAY-OFFSET  (* NUM-SEGS 4))))
		((>= (+ SEG-ARRAY-OFFSET INDEX) STOP))
	      (SYS:%DRAW-LINE
		(+ inside-x (AREF-INT16 SEG-ARRAY  (+ SEG-ARRAY-OFFSET INDEX)))
		(+ inside-y (AREF-INT16 SEG-ARRAY  (+ SEG-ARRAY-OFFSET INDEX 1)))
		(+ INSIDE-X (AREF-INT16 SEG-ARRAY  (+ SEG-ARRAY-OFFSET INDEX 2)))
		(+ INSIDE-Y (AREF-INT16 SEG-ARRAY  (+ SEG-ARRAY-OFFSET INDEX 3)))
		EXPLORER-ALU END-POINT-P   DESTINATION-ARRAY))))))