;;; -*- Mode: Lisp; Syntax: Common-lisp; Package: MU; Base: 10.; -*-

;;; Copyright (c) 1987, Massachusetts Institute of Technology
;;; Author: Mike Drumheller

;;;*****************************************************************************
;;; CHANGE HISTORY
;;;
;;; 10/12/87  Changed the package to mu.  Recompiled for Release 7.  (W. Gillett)
;;;*****************************************************************************

(in-package :mu)

;;;  To the curious reader:  The reason I implemented this as a function which writes line
;;;  coordinates into 1d-arrays, with another function that draws the line using the
;;;  1d-arrays.  I did it that way because what I was really after was a function that writes
;;;  line coordinates into 1d-arrays, and I just made a drawing routine out of it for fun.
;;;  --Mike

(defun draw-line-coordinates-into-1d-arrays (x-array y-array x1 y1 x2 y2)
  "Returns the largest array index that got set."
  (loop for i from 0 below (array-dimension x-array 0) do
    (setf (aref x-array i) 0)
    (setf (aref y-array i) 0))
  (let* ((zero-length (and (= x1 x2) (= y1 y2)))
	 (inf-slope (= x1 x2))
	 (zero-slope (= y1 y2))
	 (small-x (min x1 x2))
	 (big-x (max x1 x2))
	 (y-of-small-x (if inf-slope
			   (min y1 y2)
			   (if (= small-x x1)
			       y1
			       y2)))
	 (y-of-big-x (if inf-slope
			 (max y1 y2)
			 (if (= y-of-small-x y1)
			     y2
			     y1)))
	 (slope (if (not (or zero-length inf-slope zero-slope))
		    (/ (float (- y-of-big-x y-of-small-x)) (- big-x small-x))))
	 (top-index 0))
    (cond (zero-length top-index)
	  (inf-slope
	   (loop for y from (min y-of-small-x y-of-big-x) to (max y-of-small-x y-of-big-x)
		 for i from 0 do
	     (setf (aref x-array i) x1 (aref y-array i) y top-index i))
	   top-index)
	  (zero-slope
	   (loop for x from small-x to big-x
		 for i from 0 do
	     (setf (aref x-array i) x (aref y-array i) y1 top-index i))
	   top-index)
	  ((< (abs slope) 1.0)
	   (loop for x from small-x to big-x
		 for i from 0 do
	     (let ((y (round (+ y-of-small-x (* (- x small-x) slope)))))
	       (setf (aref x-array i) x (aref y-array i) y top-index i)))
	   top-index)
	  (( (abs slope) 1.0)
	   (setq slope (/ 1.0 slope))
	   (cond ((> y-of-big-x y-of-small-x)
		  (loop for y from y-of-small-x to y-of-big-x
			for i from 0 do
		    (let ((x (round (+ small-x (* (- y y-of-small-x) slope)))))
		      (setf (aref x-array i) x (aref y-array i) y top-index i)))
		  top-index)
		 (t
		  (loop for y from y-of-big-x to y-of-small-x 
			for i from 0 do
		    (let ((x (round (+ big-x (* (- y y-of-big-x) slope)))))
		      (setf (aref x-array i) x (aref y-array i) y top-index i)))
		  top-index)))
	  (t (error "Don't know how to generate line coordinates from (~d, ~d) to (~d, ~d)!!" x1 y1 x2 y2)))))

(defvar *x-array-for-drawing-lines* (make-array 1500.))
(defvar *y-array-for-drawing-lines* (make-array 1500.))
(defvar *top-index* 0)
(defun draw-thick-line (x1 y1 x2 y2 &optional (radius 2) (window *standard-output*))
  (setq *top-index* (draw-line-coordinates-into-1d-arrays
		      *x-array-for-drawing-lines*
		      *y-array-for-drawing-lines*
		      x1 y1 x2 y2))
  (loop for i from 0 to *top-index* do
    #+symbolics
    (send window :draw-filled-in-circle
	  (aref *x-array-for-drawing-lines* i)
	  (aref *y-array-for-drawing-lines* i)
	  radius)
    #-symbolics
    (error "Unimplemented, complain to PAO")
    ))

(defun my-draw-line (x1 y1 x2 y2 &optional (window *standard-output*))
  (setq *top-index* (draw-line-coordinates-into-1d-arrays
		      *x-array-for-drawing-lines*
		      *y-array-for-drawing-lines*
		      x1 y1 x2 y2))
  (loop for i from 0 to *top-index* do
    #+symbolics
    (send window :draw-point
	  (aref *x-array-for-drawing-lines* i)
	  (aref *y-array-for-drawing-lines* i))
    #-symbolics
    (error "Unimplemented, complain to PAO")))