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

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

;;;*****************************************************************************
;;; CHANGE HISTORY
;;;
;;; 9/25/87  WEG  Changed the package to mu.  Recompiled for Release 7.
;;;*****************************************************************************

(in-package :mu)

;;; Bashes pixels that have more than N neighbors greater or less than themselves.
;;; Eight-connected.
(*defunc BASH-PIXELS-WITH-MORE-THAN-N-BRIGHTER-OR-DIMMER-NEIGHBORS!!
	(image!! &optional (N 3) (function :brighter))
  (let ((function (if (equal function :brighter) #'>!! #'<!!)))
    (*let ((count!! (!! 0)))
      (*if (funcall function (nearest-neighbor!! image!! 0) image!!)
	   (*incf count!!))
      (*if (funcall function (nearest-neighbor!! image!! 1) image!!)
	   (*incf count!!))
      (*if (funcall function (nearest-neighbor!! image!! 2) image!!)
	   (*incf count!!))
      (*if (funcall function (nearest-neighbor!! image!! 3) image!!)
	   (*incf count!!))
      (*if (funcall function (nearest-neighbor!! image!! 4) image!!)
	   (*incf count!!))
      (*if (funcall function (nearest-neighbor!! image!! 5) image!!)
	   (*incf count!!))
      (*if (funcall function (nearest-neighbor!! image!! 6) image!!)
	   (*incf count!!))
      (*if (funcall function (nearest-neighbor!! image!! 7) image!!)
	   (*incf count!!))
      (if!! (>!! count!! (!! N))
	    (get-grid!! image!! 1 0)
	    image!!))))

;;; *lisp version by gregory wilcox 10/28/86
;;; this is probably wrong but it was fun to write.
;;;
;;; Bashes the boolean!!.  Neighbors are numbered as follows:
;;;     (-1, 1) ( 0, 1) ( 1, 1)
;;;     (-1, 0) ( 0, 0) ( 1, 0)
;;;     (-1,-1) ( 0,-1) ( 1,-1)
;;; I think pref-grid-relative!! was probably really meant.  In either case,
;;; pref-grid*!! is obsolete in 5.0, but given that I'm not sure what this is meant
;;; to do, I'll just comment it out.  PAO 89JAN06
;
;(*defunc CLEAR-NEIGHBORS!! (boolean!! &rest neighbor-xy-lists)
;  (*let ((bashed-boolean!! boolean!!))
;    (dolist (xy-list neighbor-xy-lists)
;      (*set bashed-boolean!!
;	    (pref-grid!! boolean!! (!! (car xy-list)) (!! (cadr xy-list)))))))

;;; *lisp version by gregory wilcox 10/28/86
;;; See comment for above. PAO 89JAN06
;(*defunc FILL-IN-SOLITARY-HOLES!! (image!! &optional orthog?)
;  "Makes a pixel ONE if all its neighbors are on."
;  (let ((neighbors (list -1 0 1)))
;    (*let ((count!! (!! 0)))
;      (*when (=!! image!! (!! 0))
;	(if orthog?
;	    (progn				;for 4 nearest neighbors
;	      (dolist (n neighbors)
;		(*if (=!! (!! 1) (pref-grid!! image!! (!! n) (!! 0)))
;		     (*set count!! (1+!! count!!)))
;		(*if (=!! (!! 1) (pref-grid!! image!! (!! 0) (!! n)))
;		     (*set count!! (1+!! count!!))))
;	      (*if (=!! (!! 4) count!!) (*set image!! (!! 1))))
;	    (progn				;for 8 nearest neighbors
;	      (dolist (x neighbors)
;		(dolist (y neighbors)
;		  (*if (=!! (!! 1) (pref-grid!! image!! (!! x) (!! y)))
;		       (*set count!! (1+!! count!!)))))
;	      (*if (=!! (!! 8) count!!) (*set image!! (!! 1)))))))))

;;; Does four-connect expand on grey level images.
;;; If a pixel has neighbors whose value is greater, it takes on the greater value.
(*defunc 4-EXPAND-GREY-LEVEL!! (image!! &optional (times 1))
  (*let ((result!! image!!)
	 (temp!! image!!))
    (dotimes (i times)
      (loop for neighbor-label in '(0 2 4 6) do
	(*let ((neighbor!! (nearest-neighbor!! result!! neighbor-label)))
	  (*if (>!! neighbor!! result!!)
	       (*set temp!! neighbor!!))))
      (*set result!! temp!!))
    result!!))

;;; Does four-connect expand on grey level images.
;;; If a pixel has neighbors whose value is greater, it takes on the greater value.
(*defunc 8-EXPAND-GREY-LEVEL!! (image!! &optional (times 1))
  (*let ((result!! image!!)
	 (temp!! image!!))
    (dotimes (i times)
      (loop for neighbor-label in '(0 1 2 3 4 5 6 7) do
	(*let ((neighbor!! (nearest-neighbor!! result!! neighbor-label)))
	  (*if (>!! neighbor!! result!!)
	       (*set temp!! neighbor!!))))
      (*set result!! temp!!))
    result!!))

(*defunc 4-SHRINK!! (boolean!! &optional (iterations 1))
  (*let ((answer!! boolean!!))
    (dotimes (i iterations)
      (*set
	answer!!
	(if!! (and!! answer!!
		     (not!!
		       (and!!
			 (news-border!! answer!! nil!! 1 0)
			 (news-border!! answer!! nil!! 0 1)
			 (news-border!! answer!! nil!! -1 0)
			 (news-border!! answer!! nil!! 0 -1))))
	      nil!!
	      answer!!)))
    answer!!))

(*defunc 8-SHRINK!! (boolean!! &optional (iterations 1))
  (*let ((answer!! boolean!!))
    (dotimes (i iterations)
      (*set
	answer!!
	(if!! (and!!
		answer!!
		(not!!
		  (and!! (news-border!! answer!! nil!! 1 0)
			 (news-border!! answer!! nil!! 0 1)
			 (news-border!! answer!! nil!! -1 0)
			 (news-border!! answer!! nil!! 0 -1)
			 (news-border!! answer!! nil!! 1 1)
			 (news-border!! answer!! nil!! 1 -1)
			 (news-border!! answer!! nil!! -1 1)
			 (news-border!! answer!! nil!! -1 -1)
			 )))
	      nil!!
	      answer!!)))
    answer!!))

(*defunc KILL-NONISOLATED-PIXELS!! (boolean!!)
  (and!! boolean!!
	 (not!! (or!! (news-border!! boolean!! nil!! 1 0)
		      (news-border!! boolean!! nil!! 0 1)
		      (news-border!! boolean!! nil!! -1 0)
		      (news-border!! boolean!! nil!! 0 -1)
		      (news-border!! boolean!! nil!! 1 1)
		      (news-border!! boolean!! nil!! 1 -1)
		      (news-border!! boolean!! nil!! -1 1)
		      (news-border!! boolean!! nil!! -1 -1)))))

(*defunc BOOLEAN-CONTAINS-ONLY-ISOLATED-PIXELS?!! (boolean!!)
  (*let* ((sum (!! 0)))
    (*when boolean!!
      (*if (news-border!! boolean!! nil!! 1 0) (*incf sum))
      (*if (news-border!! boolean!! nil!! 1 1) (*incf sum))
      (*if (news-border!! boolean!! nil!! 0 1) (*incf sum))
      (*if (news-border!! boolean!! nil!! -1 1) (*incf sum))
      (*if (news-border!! boolean!! nil!! -1 0) (*incf sum))
      (*if (news-border!! boolean!! nil!! -1 -1) (*incf sum))
      (*if (news-border!! boolean!! nil!! 0 -1) (*incf sum))
      (*if (news-border!! boolean!! nil!! 1 -1) (*incf sum)))
    (= 0 (*max sum))))

;;; Doesn't work very well.
(*defunc SHRINK-UNTIL-ONLY-ISOLATED-PIXELS-REMAIN!! (boolean!! &optional (4-shrink? t))
  (*let ((temp!! boolean!!))
    (loop until (boolean-contains-only-isolated-pixels?!! temp!!) do
      (*set temp!! (if 4-shrink? (4-shrink!! temp!!) (8-shrink!! temp!!)))
      (*show-bit temp!!))
    temp!!))

(*defunc CENTERS-OF-BLOBS!! (boolean!! &optional (sigma 2.5) (8-neighbors? t))
  (*let ((conv!! (g-conv!! (if!! boolean!! (!! 10.0) (!! 0)) sigma)))
    (*show-pvar conv!!)
    (kill-nonisolated-pixels!! (local-maxima!! conv!! 8-neighbors?))))

;;; Construct a binary random dot stereogram with a floating central square.  (WEG 12/21/87)
(*defun *RANDOM-DOT-STEREOGRAM
	(&key left!! right!!
	      (left *left-256*)			;arrays to receive stereogram
	      (right *right-256*)
	      (upload t)			;whether to fill in arrays
	      (random-limit 2)			;large random-limit => sparse features
	      ;; if noise is non-nil, flip (1/noise) of the pixels in the left image
	      noise
	      (width (/ (dimension-size 0) 2))	;width of floating rectangle
	      (height (/ (dimension-size 1) 2))	;height of square
	      (x-disp 10)			;horizontal disparity of rectangle
	      (y-disp 0)			;vertical disparity
	      debug)
  (declare (special *left-256* *right-256*))
  (cmv::with-temp-pvars
    (if (not left!!) (setq left!! (*lx::allocate-field-pvar 1)))
    (if (not right!!) (setq right!! (*lx::allocate-field-pvar 1)))
    ;; set the background and rectangle for the left image
    (*set left!! (if!! (nzerop!! (random!! (!! random-limit))) (!! 0) (!! 1)))
    ;; copy to the entire right image
    (*set right!! left!!)
    ;; The left eye sees a rectangle in the center, and the right eye sees the same rectangle
    ;; displaced x-disp pixels to the left and y-disp pixels down.  Set up the rectangle for the
    ;; right eye.  In left view coordinates, the rectangle covers x0  x < x1, y0  y < y1.
    (let* ((x0 (/ (- (dimension-size 0) width) 2))
	   (x1 (+ x0 width))
	   (y0 (/ (- (dimension-size 1) height) 2))
	   (y1 (+ y0 height)))
      ;; send from the rectangle seen by the left eye
      (*when (and!! (>=!! (self-address-grid!! (!! 0)) (!! x0))
		    (<!! (self-address-grid!! (!! 0)) (!! x1))
		    (>=!! (self-address-grid!! (!! 1)) (!! y0))
		    (<!! (self-address-grid!! (!! 1)) (!! y1)))
	(if debug (*set left!! (!! 0)))
	;; note that we could just as easily send from right!!
	(*news right!! left!! (- x-disp) (- y-disp))
	;; Fill in the non-matching part of right!! with random stuff to avoid
	;; replication.  Note that we are selecting a subcontext of the above *when.
	(*when (or!! (>=!! (self-address-grid!! (!! 0)) (!! (- x1 x-disp)))
		     (>=!! (self-address-grid!! (!! 1)) (!! (- y1 y-disp))))
	  (*set right!! (if!! (nzerop!! (random!! (!! random-limit))) (!! 0) (!! 1)))
	  (if debug (*set right!! (!! 1)))
	  )))
    (if noise (*when (zerop!! (random!! (!! noise))) (*set left!! (lognot-field!! left!!))))
    (cond (upload				;if user wants to upload stereogram
	   (cmv::*read-raster-from-cm-grid left (if!! (nzerop!! left!!) (!! 255) (!! 0)))
	   (cmv::*read-raster-from-cm-grid right (if!! (nzerop!! right!!) (!! 255) (!! 0)))))))

;(*defunc DEPTH-FOR-RIGHT-VIEW!! (map loc &key right)
;  "Create the depth map for the right view.  Depth values are offset so that the minimum is 1.
;A zero value indicates that depth is unknown."
;  (with-temp-pvars
;    (if (not right)
;	(setq right (*lx::allocate-field-pvar cmv::*pixel-bits*)))
;    (*set right (!! 0))
;    (*when loc (*pset-grid-relative-clipped :overwrite (-!! map (!! (1- (*min map)))) right (-!! map) (!! 0)))
;    right
;    ))

;(*defunc RECONSTRUCT-RIGHT-VIEW!! (map loc &key (left *left-256*) right)
;  "Reconstruct the right view, given the left view and the depth map.  The result is set
;to zero at locations where no image data is available."
;  (with-temp-pvars
;    (cond ((pvarp left))
;	  (t (setq left (write-raster-to-cm-grid!! left))))
;    (if (not right)
;	(setq right (*lx::allocate-field-pvar cmv::*pixel-bits*)))
;    (*set right (!! 0))
;    (*when loc (*pset-grid-relative-clipped :overwrite left right (-!! map) (!! 0)))
;    right
;    ))