;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*-
;;; Written 12/15/88 14:13:35 by GRENINGER,
;;; Reason: Added end-point correction to :draw-polyline segments.
;;; while running on MX23 from band TEST
;;; With SYSTEM 5.23, GC 5.4, VIRTUAL-MEMORY 5.5, MICRONET 5.5, MICRONET-COMM 5.13,
;;;  DISK-IO 5.9, BASIC-PATHNAME 5.3, MAC-PATHNAME 5.0, NETWORK-SUPPORT-COLD 5.1,
;;;  BASIC-NAMESPACE 5.8, BASIC-FILE 5.4, RPC 5.5, NFS 5.12, EH 5.3, MAKE-SYSTEM 5.3,
;;;  MEMORY-AUX 5.1, MACTOOLBOX 1.26, COMPILER 5.2, TV 5.22, NVRAM 5.1, UCL 5.0, INPUT-EDITOR 5.0,
;;;  METER 5.0, ZWEI 5.11, DEBUG-TOOLS 5.1, WINDOW-MX 5.31, PRINTER 5.12, MAC-PRINTER-TYPES 5.4,
;;;  NETWORK-PATHNAME 5.0, NETWORK-NAMESPACE 5.0, DATALINK 5.7, CHAOSNET 5.6, Experimental NETWORK-SUPPORT 5.1,
;;;  Experimental NETWORK-SERVICE 5.1, DATALINK-DISPLAYS 5.0, NAMESPACE-EDITOR 5.1,
;;;  IP 3.33, NFS-SERVER 5.3, PRINTER-TYPES 5.5, IMAGEN 5.1, MAIL-DAEMON 5.4, MAIL-READER 5.5,
;;;  TELNET 5.1, VT100 5.1, STREAMER-TAPE 5.7, DECNET 1.47, VISIDOC 5.4, PROFILE 5.1,
;;;  DISK-LABEL 5.1,  microcode 96, Band Name: microExplorer Network (11/22)

#!C
; From file GRAPHICS.LISP#> WINDOW; SYS:
#10R W#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "W"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: WINDOW; GRAPHICS.#"


(DEFMETHOD (graphics-mixin :draw-polyline)
	   (x-points y-points &optional (thickness  1)
	    (color      (if (color-system-p self) (tv:sheet-foreground-color self) black))
	    (num-points (MIN (LENGTH x-points)
			     (LENGTH y-points)))
	    (alu        normal)
	    (draw-end-point t)                               ;;  pc
	    (texture *default-texture*)
	    &aux (closed                                        ;; pc
		   (AND (> num-points 0)
			(= (AREF x-points 0) (AREF x-points (1- num-points)))
			(= (AREF y-points 0) (AREF y-points (1- num-points))))))
  "this method draws a polyline with a thickness.
this is actually a sequence of lines which are connected together."
  
  (UNLESS (NULL color)
    
    (MULTIPLE-VALUE-BIND (dx dy)
	(SEND self :transform-deltas thickness thickness)
      (IF (AND (>= 1.3 dx)
	       (>= 1.3 dy))
;;; killed reverse video stuff here
	  
	  (prepare-sheet (self)
			 (DO ((i 0 (1+ i))
			      (n (  1- num-points))
			      (line-alu (IF (color-system-p self) alu
					  ;;;else
					  (IF (SEND self :reverse-video-p)
					      (reverse-alu alu)
					    alu)))
			      x1
			      y1
			      x2
			      y2)
			     ((>= i num-points))
			   (SETQ x2 (AREF x-points i)
				 y2 (AREF y-points i))
			   (MULTIPLE-VALUE-SETQ (x2 y2)
			     (SEND self :transform-point x2 y2))
			   (UNLESS (NULL x1)
			     (IF (mac-window-p self)
				 (PROGN
				   (send-draw-line
				     (ROUND x1) (ROUND y1)
				     (ROUND x2) (ROUND y2)
				     line-alu draw-end-point self t 1 color)
				   (UNLESS (AND (= i n) draw-end-point)  ; Always turn off end point.
				     (send-draw-point (ROUND x2) (ROUND y2) w:alu-xor color self)))
			       ;; else...
			       (draw-clipped-line x1 y1 x2 y2 line-alu (IF (AND (NOT closed)                   ;; pc
										(= i (1-  num-points)))
									   draw-end-point
									 nil)
						  self color texture)))
			   (SETQ x1 x2
				 y1 y2))
			 )
	(PROGN
	  (SETQ thickness (/ (MAX 0 thickness) 2.0))
	  (prepare-sheet (self)
			 (DO ((i    1 (1+ i))
			      (i-1  0 (1+ i-1))
			      (n (  1- num-points))
			      (n-1  (- num-points 2))
			      (dx)  (dy)
			      (x1)  (y1)  (x2)  (y2)  (x3)  (y3)
			      (px1) (py1) (px2) (py2) (px3) (py3) (px4) (py4))
			     ((>= i num-points))	     (SETQ x1 (AREF x-points i-1)
								   y1 (AREF y-points i-1)
								   x2 (AREF x-points i)
								   y2 (AREF y-points i))
			     (OR x1 y1 x2 y2 (RETURN ()))
			     (IF (AND (mac-window-p self) (> (ABS (- x1 x2)) 1500))
			       (CERROR "continue"
				       "cannot draw a ~d pixel thick line from (~d,~d) to (~d,~d) -- too long."
				       (FLOOR (* 2 thickness))
				       x1 y1 x2 y2)
			       ;; else...
			     (COND
			       ((= i 1)
				(COND (closed (SETQ x3 (AREF x-points n-1)
						    y3 (AREF y-points n-1)))
				      (t          (SETQ x3 x1
							y3 y1)))
				(MULTIPLE-VALUE-SETQ (dx dy)
				  (line-deltas x3 y3 x1 y1 x2 y2 thickness))
				(SETQ px1 (- x1 dx)
				      py1 (- y1 dy)
				      px2 (+ x1 dx)
				      py2 (+ y1 dy))
				(UNLESS (mac-window-p self)
				  (UNLESS (ZEROP (ROUND dx))
				    (IF (< px1 px2) (INCF px1) (INCF px2)))	;; may 8-30-88
				  (UNLESS (ZEROP (ROUND dy))
				    (IF (< py1 py2) (INCF py1) (INCF py2))))	;; may 8-30-88
				)
			       (t (SETQ px1 px3
					py1 py3
					px2 px4
					py2 py4)))
			     (COND ((= i n) (COND (closed (SETQ x3 (AREF x-points 1)
								y3 (AREF y-points 1)))
						  (t      (SETQ x3 x2
								y3 y2))))
				   (t           (SETQ x3 (AREF x-points (1+ i))
						      y3 (AREF y-points (1+ i)))))
			     (OR x3 y3 (RETURN ()))
			     (MULTIPLE-VALUE-SETQ (dx dy)
			       (line-deltas x1 y1 x2 y2 x3 y3 thickness))
			     (SETQ px3 (- x2 dx)
				   py3 (- y2 dy)
				   px4 (+ x2 dx)
				   py4 (+ y2 dy))
			     (UNLESS (mac-window-p self)
			       (UNLESS (ZEROP (ROUND dx)) (IF (< px3 px4) (INCF px3) (INCF px4)))	;; may 8-30-88
			       (UNLESS (ZEROP (ROUND dy)) (IF (< py3 py4) (INCF py3) (INCF py4))))	;; may 8-30-88
			     
			     (IF (mac-window-p self)
				 (WITH-STACK-LIST (x-coords px1 px2 px4 px3)
				   (WITH-STACK-LIST (y-coords py1 py2 py4 py3)
				     (send-draw-filled-polygon x-coords y-coords
							       (IF (SEND self :reverse-video-p)
								   (reverse-alu alu) alu) color self t)))
			       ;; else...
			       (IF (AND  (NOT draw-end-point) (= i n))
				   (draw-clipped-solid-triangle px1 py1 px3 py3 px4 py4 self color alu nil nil t texture)
				 (draw-clipped-solid-triangle px1 py1 px3 py3 px4 py4 self color alu nil t t texture))
			       (IF (AND (NOT closed) (ZEROP i-1))
				   (draw-clipped-solid-triangle px1 py1 px4 py4 px2 py2 self color
								alu t t t texture)	    
				 (draw-clipped-solid-triangle px1 py1 px4 py4 px2 py2 self color
							      alu nil t t texture))))))
	  
	  )))))

))