;;; -*- Mode:Common-Lisp; Package:X11; Base:10; Fonts:(CPTFONT 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.

;1; THIS FILE IMPLEMENTS POLY-ARC ROUTINES ....*

;;; Change history:
;;;
;;;  Date       Author      Description
;;; -------------------------------------------------------------------------------------
;;; 03/06/89    DAN     Patch 1.32; Fix a bug in DRAW-ELLIPTICAL-PIE-SLICE.
;;; 01/03/89	LGO	Fix clipping in DRAW-ARC-INTERNAL.
;;; 12/21/88	LGO	Re-write DRAW-ARC-INTERNAL, using an integer algorithm.
;;; 12/13/88	LGO	Use short-floats for arc calculations
;;; 12/01/88	PMH	Re-wrote DRAW-ARC-INTERNAL function.  The previous function was way off base.
;;; 11/29/88	LGO	Fix DRAW-ARC-INTERNAL to not barf on arcs with zero radius
;;;  3/23/88	KDB	Added color arg to Draw-arc-internal.
;;;  8/25/87	KDB	Created

(defconstant SCALE-FACTOR 64
  1"VALUE BY WHICH ANGLES IN X WINDOWS ARE SUBDIVIDED"*)

(defconstant radians-per-degree  (coerce (quotient pi 180) 'short-float)
   1"The conversion factor for translating degrees to radians."*)

(defconstant  SCALED-radians-per-degree (QUOTIENT RADIANS-PER-DEGREE SCALE-FACTOR)
  "2A MAGIC NUMBER NEEDED TO CONVERT TO X WINDOWS SCALED DEGREE REQUIREMENT*")

(defconstant DEGREES-PER-RADIAN (coerce (QUOTIENT 180 PI) 'short-float)
 1"The conversion factor for translating radians 2to*  degrees"*)

(defconstant SCALED-DEGREES-PER-RADIAN (QUOTIENT DEGREES-PER-RADIAN SCALE-FACTOR)
  "2A MAGIC NUMBER NEEDED TO CONVERT TO X WINDOWS SCALED DEGREE REQUIREMENT*")

(defconstant  radians-per-unscaled-degrees (QUOTIENT RADIANS-PER-DEGREE SCALE-FACTOR)
  "2A MAGIC NUMBER NEEDED TO CONVERT TO X WINDOWS SCALED DEGREE REQUIREMENT*")
(defconstant 2-PI (coerce (* 2 pi) 'short-float))

(defconstant PI-RADIANS (coerce (* PI RADIANS-PER-DEGREE) 'short-float))

(defconstant short-pi (coerce pi 'short-float))

(defconstant PI/2  (coerce (/ pi 2) 'short-float))

(defconstant 3-QTS-CIRCLE (coerce (+ pi pi/2) 'short-float))

(defconstant  FULL-CIRCLE (* 360 SCALE-FACTOR)
  "/* 360 degrees * 64 sub-degree positions */")

#+comment ;1; obsolete*
(defsubst DIST (x1 y1 x2 y2)
  "This calculates the distance between two points (x1,y1) and (x2,y2)."
  (declare (values distance))
  (let ((dx (- x2 x1))
	(dy (- (- y2 y1))))
    (sqrt (+ (* dx dx) (* dy dy)))))

(defsubst IDIST (x1 y1 x2 y2)
  "This calculates the distance between two points (x1,y1) and (x2,y2)."
  (declare (values distance))
  (let ((dx (- x2 x1))
	(dy (- y2 y1)))
    (isqrt (+ (* dx dx) (* dy dy)))))

		;
(DEFSUBST EQUAL-360 (ANGLE)
     "2TRUNCATE ANGLE TO 360 IF NEEDED. ANGLES MUST IN DEGREES, SCALED BY 64.*"
  (LET ((ARC-ANGLE 0))
    (UNLESS (ZEROP ANGLE)  ;1 IF EQL 0, PUNT*
      (SETQ ARC-ANGLE
	    (IF (PLUSP ANGLE) ;1; WHICH WAY?*
		(MIN ANGLE  FULL-CIRCLE) 
		;; COUNTERCLOCKWISE 
		(MAX ANGLE (- FULL-CIRCLE))))  ;1;TRUNCATE TO LARGER OF -ANGLE AND -360.*
       ARC-ANGLE)))
    
(DEFSUBST SAME-SIGN (ANGLE1 ANGLE2)
  "2RETURN T IF ANGLES ARE BOTH POSITIVE OR NEGATIVE OR ZERO*"
    (OR  (AND (PLUSP ANGLE1) (PLUSP ANGLE2))
	 (AND (MINUSP ANGLE1) (MINUSP ANGLE2))
	 (AND (ZEROP ANGLE1) (ZEROP ANGLE2))
	 NIL ) 
    )

(DEFUN RETURN-ANGLE-FROM-POINTS (START-X START-Y END-X END-Y
				 &OPTIONAL (COUNTER-CLOCKWISE-P T ) (SCALED-P T) (IN-DEGREES-P T))
  1"RETURN THE  ANGLE OF A LINE IN RADIANS OR DEGREES. BY DEFAULT, ANGLE IS2 POSITIVE, * RETURNED IN DEGREES 
   SCALED BY A FACTOR OF 64 PER DEGREE. IF SCALED-P NIL AND IN-DEGREES 2NIL*,  YOU GET 2UNSCALED *RADIANS."*
  (LET* (( DELTA-X (- END-X START-X)) 
	  ( DELTA-Y (- (- END-Y START-Y)))  ;1; FLIP IT. 0,0 IS AT TOP LEFT OF SCREEN.*
	  (THETA (ATAN DELTA-Y DELTA-X)))
    (COND ((ZEROP DELTA-X)  ;1; VERTICAL*
	   (SETQ THETA (IF (MINUSP DELTA-Y) ;1; POINTS DOWN*
				(IF COUNTER-CLOCKWISE-P
                                    3-QTS-CIRCLE
			            (- PI/2))
				 ;1; ELSE*
				 (IF COUNTER-CLOCKWISE-P
				     PI/2
				     (-  3-QTS-CIRCLE)))))
	  ((ZEROP DELTA-Y)
	   (SETQ THETA (IF (PLUSP  DELTA-X) 
			   2-PI   ;1; 360*
			  short-pi )) 
	   (WHEN (NOT COUNTER-CLOCKWISE-P)
	     (SETQ THETA (- THETA))))
	;1;ELSE*
	(T
	;1;;*(SETQ THETA  (ATAN DELTA-Y DELTA-X))
	(IF  (MINUSP THETA)  ;1; LOWER QUADRANTS*
	     (WHEN COUNTER-CLOCKWISE-P
                (SETQ THETA (+ THETA 2-PI)))
             ;1;ELSE TOP QUAD*
             
	     (WHEN (NOT COUNTER-CLOCKWISE-P) ;1; *
                   (INCF THETA (- 2-PI))))))
             
    (WHEN  IN-DEGREES-P      ;; CONVERT TO DEGREES 
      (SETQ THETA
	    (round (* THETA DEGREES-PER-RADIAN ))))
    (when scaled-p
      (setq theta (round (* theta scale-factor))))
		      THETA))

(DEFUN CHECK-ANGLES-AND-RETURN-EXTENT (ANGLE1 ANGLE2 counter-clockwise-p )
  "2DO SOME CHECKS ....RETURN EXTENT. ASSUMES ANGLE 1 AND 2 ARE IN SCALED DEGREES.*"
  (LET ((EXTENT 0))
        
    (IF (NOT (SAME-SIGN ANGLE1 ANGLE2)) ;1;; BOTH ANGLES MUST GO SAME WAY.. *
         (CERROR "RESUME" "ARC CAN'T BE SPECIFIED BY 2 ANGLES GOING DIFFERENT DIRECTIONS")
       ;1;ELSE*
	 (SETQ EXTENT
	    (if counter-clockwise-p
		(if (< angle1 angle2)    
		       (- (SETQ ANGLE2 (EQUAL-360 ANGLE2)) (SETQ ANGLE1 (EQUAL-360 ANGLE1)))  ;1; *;1; NORMAL CASE.angle1 then 2*
		     (+ (-  360 (SETQ ANGLE1 (EQUAL-360 ANGLE1))) (SETQ ANGLE2 (EQUAL-360 ANGLE2))) ;1;; swing all the way thru 0*
		     )
	         ;1; ELSE  clockwise positive*
		   (if (> angle1 angle2)
		       (- (SETQ ANGLE2 (EQUAL-360 ANGLE2)) (SETQ ANGLE1 (EQUAL-360 ANGLE1)))  ;1; NORMAL; angle1 then 2*
		       ;1;; ELSE CLOCKWISE ANGLE1 IS LESS THEN 2. NEED TO ADJUST*
		     (- (SETQ ANGLE2 (EQUAL-360 ANGLE2)) (+  360 (SETQ ANGLE1 (EQUAL-360 ANGLE1)))))))) 
	
    
       EXTENT))

#+comment ;1; obsolete*
(DEFUN DRAW-ARC-INTERNAL (center-X CENTER-Y start-X0 START-Y0 START-X1 START-Y1
                          counter-clockwise-p gc ALU color
                          DRAWING-ARRAY)
 "THIS CODE IS USED BY POLY-LINE TO DRAW ROUND JOINS AND ENDS.
	     DRAW-ELLIPSE IS USE FOR POLY-ARC REQUESTS."
    (declare (ignore gc))
    (unless counter-clockwise-p
      (psetf start-x0 start-x1 start-x1 start-x0
	     start-y0 start-y1 start-y1 start-y0))
    (let ((radius   (DIST CENTER-X CENTER-Y START-X0 START-Y0)))
      (when (plusp radius)
	(let* ((num-points 29)
	       (angle1 (atan (- center-y start-y0) (- start-x0 center-x)))
	       (angle2 (atan (- center-y start-y1) (- start-x1 center-x)))
	       (arc-angle (abs (- angle2 angle1)))
	       (x3          (floor CENTER-X))
	       (y3          (floor CENTER-Y))
	       (triangles-needed (* num-points (/ arc-angle 2-pi)))
	       (delta-angle (/ 2-pi num-points))
	       x2  y2)
	    (do ((i 1 (1+ i))
		 (angle (+ angle1 delta-angle) (+ angle delta-angle))
                 (x1    (floor START-X0) x2)
                 (y1    (floor START-Y0) y2))
                ((> i triangles-needed))
              (setq x2 (floor (+ CENTER-X (* radius (cos angle))))
                    y2 (floor (+ center-Y (* radius (sin angle)))))
              (sys:%draw-shaded-triangle x3  y3 x2 y2 x1 y1 alu t t nil color drawing-array))))))

#+comment ;1; test code*
(defun draw-arc-test (&key (num-points 8) (radius 50) (x-center 150) (y-center 150) wedge
		      (array (tv:sheet-screen-array *terminal-io*)))
  (DO* ((i	0. (1+ i))
	(delta-angle (/ (* pi 2) num-points))
	(angle 0. (- angle delta-angle))
	(dangle (or wedge delta-angle))
	x y px py)
       ((> i num-points))
    (SETQ x (+ x-center (round (* radius (COS angle))))
	  y (+ y-center (round (* radius (SIN angle)))))
    (setq px (+ x-center (round (* radius (COS (+ angle dangle)))))
	  py (+ y-center (round (* radius (SIN (+ angle dangle))))))
    (SETQ x (ROUND x) y (ROUND y))
    (draw-arc-internal x-center y-center px py x y nil nil tv:alu-xor nil array)
    (sleep 0.1)
    (draw-arc-internal x-center y-center px py x y nil nil tv:alu-xor nil array)))

;; Stolen from (:method tv:GRAPHICS-MIXIN :DRAW-FILLED-IN-SECTOR), author unknown1.*
#+comment ;1; Not used*
(DEFUN DRAW-ARC-INTERNAL (center-X CENTER-Y start-X0 START-Y0 START-X1 START-Y1
                          counter-clockwise-p gc ALU color
                          DRAWING-ARRAY)
  "THIS CODE IS USED BY POLY-LINE TO DRAW ROUND JOINS AND ENDS.
	     DRAW-ELLIPSE IS USE FOR POLY-ARC REQUESTS."
  (declare (ignore gc))
  (when counter-clockwise-p
    (rotatef start-x0 start-x1)
    (rotatef start-y0 start-y1))
  (let ((radius  (iDIST CENTER-X CENTER-Y START-X0 START-Y0)))
    (when (plusp radius)
      (DO ((Y (- RADIUS) (1+ Y))
	   (X 0)
	   (U0 0)
	   (U1 0)				;1Clipped plane 1*
	   (V0 0)
	   (V1 0)				;1Clipped plane 2*
	   (CO-y0 (floor (* -1000.0s0 (- start-x0 center-x)) radius))
	   (CO-x0 (floor (* -1000.0s0 (- start-y0 center-y)) radius))
	   (CO-y1 (floor (* -1000.0s0 (- start-x1 center-x)) radius))
	   (CO-x1 (floor (* -1000.0s0 (- start-y1 center-y)) radius))
	   ;1; *(FLAG (> (ABS (- THETA-1 THETA-2)) 3.14159))
	   ;1; Flag is T when the arc angle is greater than PI radians.*
	   ;1; Define a ray from start to end and find out which side of the ray the center is on.*
	   (flag (minusp (w:determinant center-x center-y start-x1 start-y1 start-x0 start-y0)))
	   (R2 (* RADIUS RADIUS)))
	  ((> Y RADIUS))
	(SETQ X (ISQRT (- R2 (* Y Y))))		;1Unclipped line*
	(SETQ U0 (- X) U1 X V0 (- X) V1 X)	;1Init clipped lines*
	
	(when (> (* CO-Y0 Y) (* CO-X0 U1))	;1Clip with first plane*
	  (SETQ U1 (IF (= 0 CO-X0) 0 (TRUNCATE (* CO-Y0 Y) CO-X0))))
	(when (> (* CO-Y0 Y) (* CO-X0 U0))
	  (SETQ U0 (IF (= 0 CO-X0) 0 (TRUNCATE (* CO-Y0 Y) CO-X0))))
	
	(when (< (* CO-Y1 Y) (* CO-X1 V1))	;1Clip with second plane*
	  (SETQ V1 (IF (= 0 CO-X1) 0 (TRUNCATE (* CO-Y1 Y) CO-X1))))
	(when (< (* CO-Y1 Y) (* CO-X1 V0))
	  (SETQ V0 (IF (= 0 CO-X1) 0 (TRUNCATE (* CO-Y1 Y) CO-X1))))
	
	;1; Ok, we have two lines, [U0 U1] and [V0 V1].*
	;1; If the angle was greater than pi, then draw both of them,*
	;1; otherwise draw their intersection*

	(COND ((not FLAG)
	       (LET ((LEFT (MAX U0 V0))		;1Compute intersection*
		     (RIGHT (MIN U1 V1)))
		 (AND (> RIGHT LEFT)
		      (sys:%draw-shaded-raster-line (+ CENTER-X LEFT) (+ CENTER-X right) (+ CENTER-Y Y)
						    alu t color drawing-array))))

	      ((and (> U1 U0) (> V1 V0))	;1 Ensure rasters don't overlap*
	       (cond ((<= u0 v0 u1)
		      (sys:%draw-shaded-raster-line (+ CENTER-X u0) (+ CENTER-X (max U1 V1)) (+ CENTER-Y Y)
						    alu t color drawing-array))
		     ((<= v0 u0 v1)
		      (sys:%draw-shaded-raster-line (+ CENTER-X v0) (+ CENTER-X (max U1 V1)) (+ CENTER-Y Y)
						    alu t color drawing-array))
		     (t
		      (sys:%draw-shaded-raster-line (+ CENTER-X U0) (+ CENTER-X U1) (+ CENTER-Y Y)
						    alu t color drawing-array)
		      (sys:%draw-shaded-raster-line (+ CENTER-X V0) (+ CENTER-X V1) (+ CENTER-Y Y)
						    alu t color drawing-array))))
	      ((> U1 U0)
	       (sys:%draw-shaded-raster-line (+ CENTER-X U0) (+ CENTER-X U1) (+ CENTER-Y Y)
					     alu t color drawing-array))
	      ((> V1 V0)
	       (sys:%draw-shaded-raster-line (+ CENTER-X V0) (+ CENTER-X V1) (+ CENTER-Y Y)
					     alu t color drawing-array)))

	#+comment ;1; old code, draws some pixels twice when flag is T*
	(COND (FLAG
	       (when (> U1 U0)
		 (sys:%draw-shaded-raster-line (+ CENTER-X U0) (+ CENTER-X U1) (+ CENTER-Y Y)
					       alu t color drawing-array))
	       (when (> V1 V0)
		 (sys:%draw-shaded-raster-line (+ CENTER-X V0) (+ CENTER-X V1) (+ CENTER-Y Y)
					       alu (<= U1 U0) color drawing-array)))
	      (T				;1Compute intersection*
	       (LET ((LEFT (MAX U0 V0))
		     (RIGHT (MIN U1 V1)))
		 (AND (> RIGHT LEFT)
		      (sys:%draw-shaded-raster-line (+ CENTER-X LEFT) (+ CENTER-X right) (+ CENTER-Y Y)
						    alu t color drawing-array)))))))))

;1; It turns out it looks better to always draw a complete circle for caps and joins*
(DEFUN draw-circle-internal (center-X CENTER-Y start-X0 START-Y0 ALU color DRAWING-ARRAY)
  "THIS CODE IS USED BY POLY-LINE TO DRAW ROUND JOINS AND ENDS.
	     DRAW-ELLIPSE IS USE FOR POLY-ARC REQUESTS."
  (let ((radius  (iDIST CENTER-X CENTER-Y START-X0 START-Y0)))
    (when (plusp radius)
      (DO ((Y (- RADIUS) (1+ Y))
	   (X 0)
	   (R2 (* RADIUS RADIUS)))
	  ((> Y RADIUS))
	(SETQ X (ISQRT (- R2 (* Y Y))))		;1Unclipped line*
	(sys:%draw-shaded-raster-line (- CENTER-X x) (+ CENTER-X x) (+ CENTER-Y Y)
				      alu t color drawing-array)))))

#+comment ;1; Not used. draw-elliptical-pie-slice is used instead.*
(DEFUN DRAW-ELLIPSE (CENT-X CENT-Y HALF-WIDTH HALF-HEIGHT DESTINATION ALU COLOR VALUE FILL-P)
 "1 Generate the points that define  the path of an ellipse. If fill-p is t, fill the ellipse.*"
  (DECLARE (TYPE INTEGER CENT-X CENT-Y  HALF-HEIGHT HALF-WIDTH ))
   (LET* ((W     HALF-WIDTH) 
	  (H     HALF-HEIGHT)
	 (X      (+ W CENT-X)) ;1IT WORKS. DON'T FIX IT*
   	 (Y   CENT-Y)       
	 (START-X X)   ;1SAVE*              
	 (START-REFLEX (- CENT-X W)) ;1GET REFLECTED X*

	1 ;; SET THE FOLLOWING TO AVOID MULTIPLICATION IN THE LOOPS*
	 (W^2 (* W W))          ; T1 1BREVITY AND NMEMONICITY CONFLICT. MAYBE T1 THRU T9 ARE BETTER.*
	 (2W^2 (* W^2 2))       ;T2 
	 (4W^2 (* 2W^2 2))      ;T3 
	 (H^2 (* H H))          ;T4 
	 (2H^2 (* H^2 2))       ;T5
	 (4H^2 (* 2H^2 2))      ;T6
	 (2WH^2 (* W 2H^2))     ;T7 
	 (4H^2-X (* 2WH^2 2))   ;T8
	 (4W^2-Y 0 )  ;T9 WID      
	 1;;(t2 - t7) + (t4 / 2)*
          (DECIDE-1  (+ (-  2W^2 2WH^2)  (/ H^2 2.0s0))) 
	1  ;;((t1 / 2) - t8) + t5*
	  (DECIDE-2  (+ (- (/ W^2 2.0s0) 4H^2-X) 2H^2)))
       ;1; FIRST XY*
    (IF FILL-P           
     (SYS:%DRAW-SHADED-RASTER-LINE  (1- CENT-X W*) X Y ALU T COLOR DESTINATION) 
     ;1ELSE CENTER Y POINT*
     (SETF (AREF DESTINATION  Y X )               (BOOLE ALU  VALUE (AREF DESTINATION Y X))	;
           (AREF DESTINATION  Y (1- CENT-X W*) )   (BOOLE ALU  VALUE (AREF DESTINATION Y (1- CENT-X W*)))))

  ;; 1REST OF ELLIPSE*
     (DO ((REFLEX-X   (- CENT-X W) (+ START-REFLEX (ABS (- START-X X))))
	    (REFLEX-Y (- CENT-Y (ABS (- CENT-Y Y))) (- CENT-Y (ABS (- CENT-Y Y)))))
                   	 
	 ((> DECIDE-2 0)) ;EXIT

       ;; REGION ONE OF ELLIPSE
	    (IF FILL-P

		  (PROGN  (SYS:%DRAW-SHADED-RASTER-LINE REFLEX-X X Y ALU T COLOR DESTINATION)
	        	  (SYS:%DRAW-SHADED-RASTER-LINE REFLEX-X X REFLEX-Y ALU T COLOR DESTINATION))
	    ;1ELSE HOLLOW *

	 (SETF (AREF DESTINATION  Y X )                (BOOLE ALU  VALUE (AREF DESTINATION Y X)) ; TURN  ON PIXEL
     	       (AREF DESTINATION  REFLEX-Y X )         (BOOLE ALU  VALUE (AREF DESTINATION REFLEX-Y X)) ;; QUAD 1
	       (AREF DESTINATION  REFLEX-Y  REFLEX-X)  (BOOLE ALU  VALUE (AREF DESTINATION  REFLEX-Y REFLEX-X)) ;1Q4*
	       (AREF DESTINATION  Y REFLEX-X)          (BOOLE ALU  VALUE (AREF DESTINATION Y REFLEX-X))))  ;1Q3*
        
        (INCF Y 1)  1;; REGION 1. ALWAYS INCREMENT Y.*
        (SETQ 4W^2-Y (+ 4W^2-Y 4W^2 )) ;T9 T3

       (IF (< DECIDE-1 0) 
	   (PROGN
	     (INCF DECIDE-1 (+  4W^2-Y 2W^2 ))  ;T9 T2
	     (INCF DECIDE-2 4W^2-Y))               
	    ;ELSE
	    (PROGN 
	    (DECF X 1)
	    (DECF   4H^2-X 4H^2 ) ;T8 T6
	    (SETQ  DECIDE-1 (+ (- DECIDE-1 4H^2-X) 4W^2-Y 2W^2)) 
	    (SETQ  DECIDE-2 (+ (- DECIDE-2  4H^2-X) 4W^2-Y 2H^2)))))

      ;1; REGION TWO*

     (DO  ((REFLEX-X  (- CENT-X  (ABS (- CENT-X  X))) (- CENT-X  (ABS (-  CENT-X  X))))
	     (REFLEX-Y (- CENT-Y (ABS (- CENT-Y Y))) (- CENT-Y (ABS (- CENT-Y Y))))
	   (NEW-Y-P T))
	    
        
	   ((<   X  CENT-X)) ;; exit
	    (IF FILL-P
		(WHEN NEW-Y-P   ;; 1IF NEW Y THEN DRAW LINE. AVOID DRAWING LINE TWICE*..
		  (PROGN (SYS:%DRAW-SHADED-RASTER-LINE REFLEX-X X Y ALU T NIL DESTINATION)
			 (SYS:%DRAW-SHADED-RASTER-LINE REFLEX-X X REFLEX-Y ALU T NIL DESTINATION)))
	    ;1ELSE HOLLOW*
	     (SETF (AREF DESTINATION  Y X )                (BOOLE ALU  VALUE (AREF DESTINATION Y X)) ; TURN  ON PIXEL
     	           (AREF DESTINATION  REFLEX-Y X )         (BOOLE ALU  VALUE (AREF DESTINATION REFLEX-Y X)) ;; QUAD 1
	           (AREF DESTINATION  REFLEX-Y  REFLEX-X)  (BOOLE ALU  VALUE (AREF DESTINATION  REFLEX-Y REFLEX-X)) ;1;Q4*
	           (AREF DESTINATION  Y REFLEX-X)          (BOOLE ALU  VALUE (AREF DESTINATION Y REFLEX-X)))) ;1; Q3*

       (DECF X 1)
       (DECF 4H^2-X 4H^2 ) ; T8 T6

       (IF (< DECIDE-2 0)  ;; GO TO PIXEL C?
	   (PROGN
	     
	     (INCF Y 1 ) ;; (DECF Y 1)
	     (SETQ NEW-Y-P T)
	     (SETQ 4W^2-Y (+ 4W^2-Y 4W^2 ))	;T9 T3    ;;( 4W^2-Y 4W^2 ) ;T9 T3   ;(d2 - t8) + t5
	     (SETQ  DECIDE-2  (+ (- DECIDE-2  4H^2-X) 4W^2-Y 2H^2)))	;T895
	   (PROGN
	     (SETQ DECIDE-2  (+ (- DECIDE-2  4H^2-X)  2H^2))
	   (SETQ NEW-Y-P NIL))))))

#+comment ;1; test code*
(defun draw-ellipse-test (&key (num-points 16) (hw 50) (hh 50) (x-center 150) (y-center 150) wedge
			  (delay 0.3)
		      (array (tv:sheet-screen-array *terminal-io*)))
  (DO* ((i	0. (1+ i))
	(delta-angle (/ (* pi 2) num-points))
	(angle 0. (- angle delta-angle))
	(dangle (or wedge delta-angle)))
       ((> i num-points))
    ;1; Line*
    (draw-elliptical-pie-slice x-center y-center hw hh angle dangle array tv:alu-xor nil 1 nil)
    (sleep delay)
    (draw-elliptical-pie-slice x-center y-center hw hh angle dangle array tv:alu-xor nil 1 nil)
    ;1; Chord*
    (draw-elliptical-pie-slice x-center y-center hw hh angle dangle array tv:alu-xor nil 1 t t)
    (sleep delay)
    (draw-elliptical-pie-slice x-center y-center hw hh angle dangle array tv:alu-xor nil 1 t t)
    ;1; Pie*
    (draw-elliptical-pie-slice x-center y-center hw hh angle dangle array tv:alu-xor nil 1 t)
    (sleep delay)
    (draw-elliptical-pie-slice x-center y-center hw hh angle dangle array tv:alu-xor nil 1 t)
    ))

(defun  draw-elliptical-pie-slice (cent-x cent-y half-width half-height theta-1 theta-2
				   destination alu color value fill-p &optional chordp)
  "1 Generate the points that define  the path of an ellipse. If fill-p is t, fill the ellipse.*
 2Theta-1 is the starting angle, and theta-2 is the ending angle relative to theta-1.*"
  (declare (type integer cent-x cent-y  half-height half-width ))
  (let* ((w     half-width) 
	 (h     half-height)
	 (x      (+ w cent-x))			;1IT WORKS. DON'T FIX IT*
   	 (y   cent-y)       
	 (start-x x)				;1SAVE*              
	 (start-reflex (- cent-x w))		;1GET REFLECTED X*
	 
	 1;; SET THE FOLLOWING TO AVOID MULTIPLICATION IN THE LOOPS*
	 (w^2 (* w w))				; T1 1BREVITY AND NMEMONICITY CONFLICT. MAYBE T1 THRU T9 ARE BETTER.*
	 (2w^2 (* w^2 2))			;T2 
	 (4w^2 (* 2w^2 2))			;T3 
	 (h^2 (* h h))				;T4 
	 (2h^2 (* h^2 2))			;T5
	 (4h^2 (* 2h^2 2))			;T6
	 (2wh^2 (* w 2h^2))			;T7 
	 (4h^2-x (* 2wh^2 2))			;T8
	 (4w^2-y 0 )				;T9 WID      
	 1;;(t2 - t7) + (t4 / 2)*
	 (decide-1  (+ (-  2w^2 2wh^2)  (/ h^2 2.0s0))) 
	 1;;((t1 / 2) - t8) + t5*
	 (decide-2  (+ (- (/ w^2 2.0s0) 4h^2-x) 2h^2))
	 co-x0
	 co-y0
	 co-x1
	 co-y1
	 slope
	 ;1; Flag is T when the arc angle is greater than PI radians.*
	 (flag (> (abs theta-2) short-pi))
	 draw-clipped-raster
	 )
    (flet ((draw-clipped-slice-raster (x0 x1 y0 &rest ignore)
	     (let* ((u0 (- x0 cent-x)) ;1; Translate values so center is at 0,0*
		    (u1 (- x1 cent-x))
		    (v0 u0)
		    (v1 u1)
		    (y (- y0 cent-y)))
	       (when (> (* co-y0 y) (* co-x0 u1))	;1Clip with first plane*
		 (setq u1 (if (= 0 co-x0) 0 (truncate (* co-y0 y) co-x0))))
	       (when (> (* co-y0 y) (* co-x0 u0))
		 (setq u0 (if (= 0 co-x0) 0 (truncate (* co-y0 y) co-x0))))
	       
	       (when (< (* co-y1 y) (* co-x1 v1))	;1Clip with second plane*
		 (setq v1 (if (= 0 co-x1) 0 (truncate (* co-y1 y) co-x1))))
	       (when (< (* co-y1 y) (* co-x1 v0))
		 (setq v0 (if (= 0 co-x1) 0 (truncate (* co-y1 y) co-x1))))
	       
	       (cond ((not flag)
		      (let ((left (max u0 v0))	;1Compute intersection*
			    (right (min u1 v1)))
			(and (> right left)
			     (sys:%draw-shaded-raster-line (+ cent-x left) (+ cent-x right) (+ cent-y y)
							   alu t color destination))))
		     
		     ((and (> u1 u0) (> v1 v0))	;1 Ensure rasters don't overlap*
		      (cond ((<= u0 v0 u1)
			     (sys:%draw-shaded-raster-line (+ cent-x u0) (+ cent-x (max u1 v1)) (+ cent-y y)
							   alu t color destination))
			    ((<= v0 u0 v1)
			     (sys:%draw-shaded-raster-line (+ cent-x v0) (+ cent-x (max u1 v1)) (+ cent-y y)
							   alu t color destination))
			    (t
			     (sys:%draw-shaded-raster-line (+ cent-x u0) (+ cent-x u1) (+ cent-y y)
							   alu t color destination)
			     (sys:%draw-shaded-raster-line (+ cent-x v0) (+ cent-x v1) (+ cent-y y)
							   alu t color destination))))
		     ((> u1 u0)
		      (sys:%draw-shaded-raster-line (+ cent-x u0) (+ cent-x u1) (+ cent-y y)
						    alu t color destination))
		     ((> v1 v0)
		      (sys:%draw-shaded-raster-line (+ cent-x v0) (+ cent-x v1) (+ cent-y y)
						    alu t color destination)))))

	   (draw-clipped-chord-raster (x0 x1 y0)
	      (macrolet ((xint (default)
			  ;1; Return the x-intercept*
			  `(cond ((null slope) co-x0)	  ;;1 Vertical*
				 ((zerop slope) ,default) ;;1 Horizontal*
				 (t (let ((res (floor (- y0 (- co-y0 (* slope co-x0))) slope)))
				      ,(if (eq default 'x0)
					   '(max res x0)
					 '(min res x1))))))
			 (draw-raster-line (xa xb y)
			   (once-only (xa xb)
			     `(when (< ,xa ,xb)
				(if fill-p
				    (sys:%draw-shaded-raster-line ,xa ,xb ,y alu t color destination)
				  (when (eq ,xa x0) ;1; use eq for better optimization*
				    (sys:%draw-shaded-raster-line ,xa ,xa ,y alu t color destination)
                                    #+comment
				    (setf (aref destination ,y ,xa) (boole alu value (aref destination ,y ,xa))))
				  (when (eq ,xb x1)
				    (sys:%draw-shaded-raster-line ,xb ,xb ,y alu t color destination)
                                    #+comment
				    (setf (aref destination ,y ,xb) (boole alu value (aref destination ,y ,xb)))))))))
	      (cond ((= co-y0 co-y1)
		     (if (> co-x0 co-x1)
			 (when (<= y0 co-y0) (draw-raster-line x0 x1 y0))
			 (when (>= y0 co-y0) (draw-raster-line x0 x1 y0))))
		    ((< co-y0 co-y1) (draw-raster-line x0 (xint x1) y0))
		    (t
		     (draw-raster-line (xint x0) x1 y0)))))

	   (draw-full-raster (x0 x1 y0)
	      (sys:%draw-shaded-raster-line x0 x1 y0 alu t color destination))

	   (draw-full-points (x0 x1 y0)
	      (setf (aref destination  y0 x0) (boole alu value (aref destination y0 x0)))
	      (setf (aref destination  y0 x1) (boole alu value (aref destination y0 x1))))

	   (ellipitical-translate (theta half-width half-height x y)
	     (let ((d (sqrt (+ (* (expt half-width 2) (expt (sin theta) 2))
			       (* (expt half-height 2) (expt (cos theta) 2))))))
	       (values (+ x (floor (/ (* half-width half-height (cos theta)) d)))
		       (+ y (floor (/ (* half-width half-height (- (sin theta))) d))))))

	   #+comment ;1; This works too, but it's ugly...*
	   (ellipitical-translate (theta half-width half-height x y)
	     ;1; tan(t1) = half-width / half-height * tan(theta)*
	     ;1; if a = arctan q then cos a = 1 / sqrt (1 + (q * q))*
	     ;1;                 and  sin a = q / sqrt (1 + (q * q))*
	     (let ((hw (/ half-width (short-float half-height)))
		   (sin (sin theta))
		   (cos (cos theta)))
	       (cond ((zerop cos)
		      (setq cos 0 sin (signum sin)))
		     ((zerop sin)
		      (setq cos (signum cos) sin 0))
		     (t (let* ((r (and (not (zerop cos)) (abs (* (/ sin cos) hw))))
			       (q (if (zerop r) 1.0 (sqrt (+ 1.0s0 (* r r))))))
			  (setq cos (* (/ 1.0s0 q) (signum cos))
				sin (* (/ r q) (signum sin))))))
	       (values (+ x (floor (* half-width cos)))
		       (+ y (floor (* half-height (- sin)))))))
	   )

      (cond ((>= theta-2 2-pi)			;1 Whole Ellipse*
	     (setq draw-clipped-raster
		   (if fill-p #'draw-full-raster #'draw-full-points)))	    
	    ((or chordp (not fill-p))		;1 Chord or Line only*
	     (setq draw-clipped-raster #'draw-clipped-chord-raster
		   theta-2 (+ theta-1 theta-2))
	     (when (> theta-1 theta-2) (rotatef theta-1 theta-2))
	     ;1; Calculate the X/Y coordinates of the points on the ellipse at angles THETA-1 and THETA-2*
	     (multiple-value-setq (co-x0 co-y0)
	       (ellipitical-translate theta-1 half-width half-height cent-x cent-y))
	     (multiple-value-setq (co-x1 co-y1)
	       (ellipitical-translate theta-2 half-width half-height cent-x cent-y))
	     (setq slope (and (not (= co-x0 co-x1))
			      (/ (- co-y0 co-y1) (short-float (- co-x0 co-x1)))))
;1; debug*
;1;*	     (send *terminal-io* :draw-line cent-x cent-y co-x0 co-y0)
;1;*	     (send *terminal-io* :draw-line cent-x cent-y co-x1 co-y1)
	     )
	    (t					;1 Filled elliptical slice*
	     (setq draw-clipped-raster #'draw-clipped-slice-raster
		   theta-2 (+ theta-1 theta-2))
	     (when (> theta-1 theta-2) (rotatef theta-1 theta-2))
	     (setq co-x0 (values (floor (* -1000.0s0 (sin theta-1))))
		   co-y0 (values (floor (*  1000.0s0 (cos theta-1))))
		   co-x1 (values (floor (* -1000.0s0 (sin theta-2))))
		   co-y1 (values (floor (*  1000.0s0 (cos theta-2)))))))

    ;1; FIRST XY*
      (funcall draw-clipped-raster  (- cent-x w) x y)
    
    ;; 1REST OF ELLIPSE*
    (do ((reflex-x   (- cent-x w) (+ start-reflex (abs (- start-x x))))
	 (reflex-y (- cent-y (abs (- cent-y y))) (- cent-y (abs (- cent-y y)))))
	
	((> decide-2 0))			;EXIT
      
      ;; REGION ONE OF ELLIPSE
      
      (funcall draw-clipped-raster reflex-x x y)
      (funcall draw-clipped-raster reflex-x x reflex-y)
      
      (incf y 1)  1;; REGION 1. ALWAYS INCREMENT Y.*
      (setq 4w^2-y (+ 4w^2-y 4w^2 ))		;T9 T3
      
      (if (< decide-1 0) 
	  (progn
	    (incf decide-1 (+  4w^2-y 2w^2 ))	;T9 T2
	    (incf decide-2 4w^2-y))               
						;ELSE
	(progn 
	  (decf x 1)
	  (decf   4h^2-x 4h^2 )			;T8 T6
	  (setq  decide-1 (+ (- decide-1 4h^2-x) 4w^2-y 2w^2)) 
	  (setq  decide-2 (+ (- decide-2  4h^2-x) 4w^2-y 2h^2)))))
    
    ;1; REGION TWO*
    
    (do  ((reflex-x  (- cent-x  (abs (- cent-x  x))) (- cent-x  (abs (-  cent-x  x))))
	  (reflex-y (- cent-y (abs (- cent-y y))) (- cent-y (abs (- cent-y y))))
	  (new-y-p t))
	 
	 
	 ((<   x  cent-x)) ;; exit

      (when new-y-p   ;; 1IF NEW Y THEN DRAW LINE. AVOID DRAWING LINE TWICE*..
	(funcall draw-clipped-raster reflex-x x y)
	(funcall draw-clipped-raster reflex-x x reflex-y))
      
      (decf x 1)
      (decf 4h^2-x 4h^2 )			; T8 T6
      
      (if (< decide-2 0)  ;; GO TO PIXEL C?
	  (progn
	    
	    (incf y 1 ) ;; (DECF Y 1)
	    (setq new-y-p t)
	    (setq 4w^2-y (+ 4w^2-y 4w^2 ))	;T9 T3    ;;( 4W^2-Y 4W^2 ) ;T9 T3   ;(d2 - t8) + t5
	    (setq  decide-2  (+ (- decide-2  4h^2-x) 4w^2-y 2h^2)))	;T895
	(progn
	  (setq decide-2  (+ (- decide-2  4h^2-x)  2h^2))
	  (setq new-y-p nil)))))))