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

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

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

(in-package :mu)

(proclaim '(special sigma *left-256*))

(*defunc INTEGER-DOG-CONV!! (image central-width &optional (scale-factor 200))
  (declare (type field-pvar image))
  (let ((sf (get-scale-factor-to-make-two-different-sigmas-have-same-area
	      sigma (* 1.7 sigma) scale-factor)))
    (-!!
      (unsigned-g-conv!! image central-width scale-factor)
      (unsigned-g-conv!! image (* 1.7 central-width) (* sf scale-factor)))))

(*defunc DOG-CONV!! (image central-width)
  (-!! (g-conv!! image central-width)
       (g-conv!! image (* 1.7 central-width))))

;;; Changed the sign of the result so that positive-going edges are labelled 1 and
;;; negative-going edges are labelled zero (WEG 10/27/87).  Thus the sign of the edge
;;; matches the sign of the x component of the gradient.
(*defunc ZERO-CROSSINGS!! (image )
  (*let* ((right-neighbors-are-leq-zero
	     (or!! (<=!! (news-border!! image (!! 0) 1 0) (!! 0))
			   (<=!! (news-border!! image (!! 0) 0 -1) (!! 0))))
	  (left-neighbors-are-leq-zero
	     (or!! (<=!! (news-border!! image (!! 0) 0 1) (!! 0))
			   (<=!! (news-border!! image (!! 0) -1 0) (!! 0))))
	  (result (cond!! ((and!! (>!! image (!! 0))
				  right-neighbors-are-leq-zero)
			   (!! -1))
			  ((and!! (>!! image (!! 0))
				  left-neighbors-are-leq-zero)
			   (!! 1))
			  (t!! (!! 0)))))
    (declare (type (signed-pvar 2) result))
    (*let ((number-of-neg-neighbors (!! 0)))
      (loop for x from -1 to 1 do
	(loop for y from -1 to 1 do
	  (if (not (and (zerop x) (zerop y)))
	      (*if (minusp!! (news-border!! result (!! 0) x y))
		   (*incf number-of-neg-neighbors)))))
      (*if (and!! (plusp!! result)
		  (=!! number-of-neg-neighbors (!! 2)))
	   (*set result (!! -1))))
    (*let ((number-of-pos-neighbors (!! 0)))
      (loop for x from -1 to 1 do
	(loop for y from -1 to 1 do
	  (if (not (and (zerop x) (zerop y)))
	      (*if (plusp!!  (news-border!! result (!! 0) x y))
		   (*incf number-of-pos-neighbors)))))
      (*if (and!! (minusp!! result)
		  (=!! number-of-pos-neighbors (!! 2)))
	   (*set result (!! 1))))
    result))

(*defunc GRADIENT-MAGNITUDE!! (image &optional g-conv-sigma)
  (*let* ((i (if g-conv-sigma
		 (g-conv!! image g-conv-sigma)
		 image))
	  (dx (dfdx!! i))
	  (dy (dfdy!! i)))
    (sqrt!! (+!! (*!! dx dx) (*!! dy dy)))))

(*defunc ZCS!!
	(image central-width
	       &optional gradient-threshold (use-integer-arithmetic? nil) (scale-factor 200))
  (*let ((dog (if use-integer-arithmetic?
		  (integer-dog-conv!! image central-width scale-factor)
		  (dog-conv!! image central-width))))
    (if gradient-threshold
	(*let* ((grad (gradient-magnitude!! dog))
		(above-threshold (>!! grad (!! gradient-threshold)))
		(zcs (zero-crossings!! dog))
		(result (!! 0)))
	  (declare (type (signed-pvar 2) result))
	  (*when above-threshold (*set result zcs))
	  result)
	(zero-crossings!! dog))))

; commented out until array-pvar!! is redefined. -- pao 4/14/89 16:44:55
;#+*lisp-hardware
;(defun TIME-BOTH ()
;  (*let ((p (array-pvar!! *left-256*))
;	 (r1 (!! 0))
;	 (r2 (!! 0)))
;    (declare (type (signed-pvar 2) r1 r2))
;    (cm:time (*set r1 (zcs!! p 3 nil nil 1000)))
;    (cm:time (*set r2 (zcs!! p 3 nil t 1000)))
;    (*show-pvar r1)
;    (*show-pvar r2 256)))

(*defunc DOG-LEVEL-CROSSINGS!! (image central-width level)
  (*let* ((dog (dog-conv!! image central-width))
	  (result (if!! (>!! (abs!! dog) (!! level)) (!! 1) (!! 0))))
    (declare (type (field-pvar 1) result))
    result))

; commented out until array-pvar!! is redefined -- pao 4/14/89 16:44:55
;(*defunc ARRAY-ZCS!! (8-bit-array sigma)
;  (nzerop!! (zcs!! (array-pvar!! 8-bit-array) sigma)))