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

;;; Copyright (c) 1987, Massachusetts Institute of Technology
;;; Author: Guy Blelloch.  Modified by Carl Feynmann.

;;;*****************************************************************************
;;; CHANGE HISTORY
;;;
;;; 9/25/87  Changed the package to mu.  Recompiled for Release 7.  (W. Gillett)
;;; 92MAR09  PAO Ported to Lucid.
;;;*****************************************************************************

(in-package :mu)

(defun DOWNLOAD-LINE-LIST (x1-pvar y1-pvar x2-pvar y2-pvar line-list)
  (let ((count 0))
    (dolist (line line-list)
      (let ((point-1 (first line))
	    (point-2 (second line)))
	(*let ()
	  (*setf (pref x1-pvar count) (first point-1))
	  (*setf (pref y1-pvar count) (second point-1))
	  (*setf (pref x2-pvar count) (first point-2))
	  (*setf (pref y2-pvar count) (second point-2))))
      (incf count))
    count))

(compiler-let ((*lisp-i::*warn-aboutnon-place-in-*pset* nil))

(*defunc *RELOCATE-PVARS (combiner new-position received-flag &rest pvars)
   (*pset combiner (first pvars) (first pvars) new-position  :notify received-flag)
   (dolist (pvar (cdr pvars))
     (*pset combiner pvar pvar new-position)))

)

(*defunc *COPY-PVARS (segment-flag &rest pvars)
   (dolist (pvar pvars)
     (*set pvar (scan!! pvar 'copy!! :segment-pvar segment-flag))))

;;; This routine takes a set of pairs of points in processors where the
;;; pvar line-p is T.  The points are marked by the 4 pvars (x1-pvar,
;;; y1-pvar) for the first point and (x2-pvar, y2-pvar) for the second.
;;; The routine returns a boolean pvar which represents a grid.  The
;;; processors on a line between any pair of points will be to the value
;;; of line-value in the processor which contained the points.  Points
;;; not on any line will be set to 0.  Where two lines overlap, the line
;;; with the larger line-value overwrites.
(*defunc DRAW-LINES (x1-pvar y1-pvar x2-pvar y2-pvar line-p line-value
			     &aux number-of-pixels) 
  (*all
    (*let* ((x-length) (y-length) (max-length)
	    (segment-flag nil!!)
	    (start-location) (segment-position)
	    (x-position) (y-position)
	    (grid-pvar (!! 0))
	    ;; We have to rebind the endpoint pvars because they get smashed.
	    (x1-pvar x1-pvar)
	    (y1-pvar y1-pvar)
	    (x2-pvar x2-pvar)
	    (y2-pvar y2-pvar))
      (declare (type (signed-pvar 11) x-length y-length max-length
		     x-position y-position
		     grid-pvar)
	       (type boolean-pvar segment-flag))
      (*when line-p
	;; determine lengths of lines
	(*set x-length (-!! x2-pvar x1-pvar) y-length (-!! y2-pvar y1-pvar))
	(*set max-length (+!! (max!! (abs!! x-length) (abs!! y-length)) (!! 1))))
      (if (> (*when line-p (*sum max-length)) *number-of-processors-limit*)
	  ;; Too many points to handle in one whack.
	  (progn (if (> (*when line-p (*max max-length))
			 *number-of-processors-limit*)
		     (error "In my nation, it is impossible to draw a line whose length is
                               greater than the number of processors in the machine."))
		 ;; Draw the lines in two passes
		 (let ((middle-processor
			 (*when line-p
			   (floor (+ (*max (self-address!!)) (*min (self-address!!)))
				  2))))
		   (*all (max!! (draw-lines
				  x1-pvar y1-pvar x2-pvar y2-pvar
				  (and!! line-p
					 (>!! (self-address!!) (!! middle-processor))
					 )
				  line-value)
				(draw-lines
				  x1-pvar y1-pvar x2-pvar y2-pvar
				  (and!! line-p
					 (<=!! (self-address!!) (!! middle-processor)))
				  line-value)))))
	  (progn
	    ;; Do all the lines at once.  Isn't recursion wonderful?
	    (*when line-p
		   ;; Allocate space for each line.
		   (*set start-location (scan!! max-length '+!! :include-self nil))
		   (setq number-of-pixels (*sum max-length))
		   ;; Send line information to the begining of segment for the line.
		   (*relocate-pvars
		    :logior
		    start-location segment-flag x1-pvar y1-pvar x-length y-length line-value))
	    (*when (<!! (self-address!!) (!! number-of-pixels))
		   ;; Spread the information over the segment and number the elements in segment.
		   (*set segment-position (self-address!!))
		   (*copy-pvars
		    segment-flag x1-pvar y1-pvar x-length y-length segment-position line-value)
		   (warn "Arithmetic on (self-address!!). This may not work in 5.0.")
		   (*set segment-position (-!! (self-address!!) segment-position))
		   ;; From the line information and the position in the segment, calculate the x
		   ;; and y positions.
		   (*let* ((major-length) (minor-length) (major-position) (minor-position)
			   (x-major-flag (>!! (abs!! x-length) (abs!! y-length))))
			  (*if x-major-flag
			       (*set major-length x-length minor-length y-length)
			       (*set major-length y-length minor-length x-length))
			  (*set minor-position
				(round!! (*!! segment-position minor-length) (abs!! major-length)))
			  (*set major-position
				(if!! (plusp!! major-length) segment-position (-!! segment-position)))
			  (*if x-major-flag
			       (*set x-position major-position y-position minor-position)
			       (*set x-position minor-position y-position major-position))
			  (*set x-position (+!! x-position x1-pvar))
			  (*set y-position (+!! y-position y1-pvar)))
		   ;; Sent a flag to the destination array to mark the bits which lie on lines.
		   (*when (not!! (off-grid-border-p!! x-position y-position))
			  (*pset
			   :max
			   line-value grid-pvar (cube-from-grid-address!! x-position y-position))))
	    ;; return the destination array
	    grid-pvar)))))

(defun TEST-DRAW-LINE (number-of-lines)
  (*warm-boot)
  (*let () ;;x1 y1 x2 y2)
    (let ((lines-per-radian (/ number-of-lines 6.3)))
      (*show-pvar (draw-lines
		   (round!! (+!! (!! 64) (*!! (sin!! (/!! (self-address!!)
							  (!! lines-per-radian)))
					      (!! 10))))
		   (round!! (+!! (!! 64) (*!! (cos!! (/!! (self-address!!)
							  (!! lines-per-radian)))
					      (!! 15))))
		   (round!! (+!! (!! 64) (*!! (sin!! (/!! (self-address!!)
							  (!! lines-per-radian)))
					      (!! 40))))
		   (round!! (+!! (!! 64) (*!! (cos!! (/!! (self-address!!)
							  (!! lines-per-radian)))
					      (!! 60))))
		   (<!! (self-address!!) (!! number-of-lines))
		   (self-address!!))))))

;(defun BUSTED-DRAW-LINES (x1-pvar y1-pvar x2-pvar y2-pvar number-of-points)
;  (let ((number-of-pixels))
;    (*all
;      (*let* ((x-length) (y-length) (max-length)
;	      (segment-flag nil!!)
;	      (start-location) (segment-position)
;	      (x-position) (y-position)
;	      (grid-pvar (!! nil)))
;	
;	(*when (<!! (self-address!!) (!! number-of-points))
;
;	  ;; determine lengths of lines
;	  (*set x-length (-!! x2-pvar x1-pvar) y-length (-!! y2-pvar y1-pvar))
;	  (*set max-length (+!! (max!! (abs!! x-length) (abs!! y-length)) (!! 1)))
;
;	  ;; Allocate space for each line.
;	  (*set start-location (scan!! max-length '+!! :include-self nil))
;	  (setq number-of-pixels (*sum max-length))
;
;	  ;; Send line information to the begining of segment for the line.
;	  (*relocate-pvars
;	    :logior start-location segment-flag x1-pvar y1-pvar x-length y-length))
;
;	(*when (<!! (self-address!!) (!! number-of-pixels))
;	  
;	  ;; Spread the information over the segment and number the elements in segment.
;	  (*set segment-position (self-address!!))
;	  (*copy-pvars segment-flag x1-pvar y1-pvar x-length y-length segment-position)
;	  (*set segment-position (-!! (self-address!!) segment-position))
;	  
;	  ;; From the line information and the position in the segment, calculate the x
;	  ;; and y positions.
;	  (*let* ((major-length) (minor-length) (major-position) (minor-position)
;		  (x-major-flag (>!! (abs!! x-length) (abs!! y-length))))
;	    (*if x-major-flag
;		 (*set major-length x-length minor-length y-length)
;		 (*set major-length y-length minor-length x-length))
;	    (*set minor-position
;		  (truncate!! (*!! segment-position minor-length) (abs!! major-length)))
;	    (*set major-position
;		  (if!! (plusp!! major-length) segment-position (-!! segment-position)))
;	    (*if x-major-flag
;		 (*set x-position major-position y-position minor-position)
;		 (*set x-position minor-position y-position major-position))
;	    (*set x-position (+!! x-position x1-pvar))
;	    (*set y-position (+!! y-position y1-pvar)))
;	  (ppp-css x-position)
;	  (ppp-css y-position)
;	  (ppp-css (cube-from-grid-address!! x-position y-position))
;	  ;; Sent a flag to the destination array to mark the bits which lie on lines.
;	  (*pset-grid :or t!! grid-pvar x-position y-position))
;	
;	;; return the destination array
;	grid-pvar))))

;(defun SHOW-CLIFF-THE-BUG ()
;  (*warm-boot)
;  (*let (x1 y1 x2 y2)
;    (let ((lines '(((0 0)(10 10)))))
;      (download-line-list x1 y1 x2 y2 lines)
;      (busted-draw-lines x1 y1 x2 y2 (length lines)))))


(*defunc DRAW-VECTOR-FIELD-IN-PARALLEL!! (x-component!! y-component!! vector-valid-p!!)
  (*let* ((tail-x!! (self-address-grid!! (!! 0)))
	  (tail-y!! (self-address-grid!! (!! 1)))
	  (head-x!!
	    (clamp!! (+!! tail-x!! x-component!!) (!! 0) (!! (1- (dimension-size 0)))))
	  (head-y!!
	    (clamp!! (+!! tail-y!! y-component!!) (!! 0) (!! (1- (dimension-size 1))))))
    (draw-lines tail-x!! tail-y!! head-x!! head-y!! vector-valid-p!! (!! 1))))