;;; Set up the input array:
(defparameter *nrows* 10)
(defparameter *ncols* 10)

(defparameter *test-image*
  (make-array (list *nrows* *ncols*) :initial-contents
  '((1 1 0 0 1 1 0 0 0 0)
    (1 0 1 0 1 0 1 0 0 0)
    (1 1 0 0 1 0 1 0 0 0)
    (1 0 1 0 1 0 1 0 0 0)
    (1 1 0 0 1 1 0 0 0 0)
    (0 0 0 0 0 0 0 0 0 0)
    (0 1 0 0 0 1 0 0 0 0)
    (1 0 1 0 1 0 1 0 0 0)
    (1 0 1 0 1 0 1 0 0 0)
    (0 1 0 0 0 1 1 0 0 0) ) ) )

(defun negate (a)
  "Creates and returns a new 2-D image array in which
   each element is the negation of its corresponding
   element in the array A.
   b diye bos bi array yapiyor a diye aldigi parametredeki 
   arraye esitliyor yanliz 0 lardan kurtariyor"
  (let ((b (make-array (list *nrows* *ncols*))))
    (dotimes (i *nrows*)
      (dotimes (j *ncols*)
        (setf (aref b i j) (- 0 (aref a i j)))
         ) )
    b) )

;;; CONNECTED-COMPONENTS is the top-level function for
;;; the finding connected components of the input IMAGE.
(defun connected-components (image)
  "Calls SCAN on the negation of IMAGE."
  (scan (negate image)) )

(defun scan (image)
  "Performs a raster-scan of the image looking for
   successive connected components."
  (let ((count 0))
    (dotimes (i *nrows*)
      (dotimes (j *ncols*)
        (format t "Scanning ~s, ~s.~%" i j) ; Show progress.
        (cond ((= (aref image i j) -1)      ; unmarked figure cell?
               (incf count)                 ; Yes, up the count, and
               (dfs image count i j) ))     ; label the component.
                ) ) 
    image) )

(defparameter *directions*   ; 8-adjacency definition.
      '((-1 0)(0 -1)(0 1)(1 0)) )

(defun dfs (image count i j)
  "Conducts a depth-first search from position I, J for
   more cells in the current component."
  (cond ((= (aref image i j) -1)        ; Be sure cell is figure.
         (setf (aref image i j) 1)  ; then mark the pixel and
(dolist (which-way *directions*) ; search in all directions.
                 (branch which-way image count i j) )	   
 
          )
        (t nil) ) )    ; Don't continue if cell is
                       ; already labelled or background.

(defun branch (which-way image count i j)
  "Attempts to continue the search in
   direction WHICH-WAY."
  (let ((ii (+ i (first which-way)))    ; Determine row and col
        (jj (+ j (second which-way))) ) ; of new cell.
    (and (< -1 ii)                      ; Check array bounds...
         (< -1 jj)
         (< ii *nrows*)
         (< jj *ncols*)
	   (dolist (which-way *directions*)
         	(onceki which-way image count i j ii jj)) ) ) )  ; OK, continue search.

(defun onceki (which-way image count i j ii jj)
  "Attempts to continue the search in
   direction WHICH-WAY."
  (let ((jjj jj)
	  (iii ii)
	  (ii (+ ii (first which-way)))    ; Determine row and col
        (jj (+ jj (second which-way))) ) ; of new cell.
    (and (< -1 ii)                      ; Check array bounds...
         (< -1 jj)
         (< ii *nrows*)
         (< jj *ncols*)
	   (cond ((and (= (aref image ii jj) -1)
			  (or (and (= (1+ ii) i)
				     (= (1- jj) j))
				(and (= (1+ jj) j)
				     (= (1- ii) i))
				(and (= (1- ii) i)
				     (= (1- jj) j))
				(and (= (1+ jj) j)
				     (= (1+ ii) ii)) ) )
		; (format t "OOOOOOOOOO ~s,~s,~s, ~s.~%" ii jj iii jjj) 	

		(setf (aref image iii jjj) 0)
         (dfs image count iii jjj)  ) ) ) ) )   ; OK, continue search.



(defun print-row (image row)
  "Prints one row of an image."
  (dotimes (i *nrows*)
    (format t "~5D" (aref image row i)) ) )

(defun print-image (image)
  "Prints out IMAGE nicely formatted."
  (dotimes (i *nrows*)
    (print-row image i)
    (format t "~%") ) )

(defun test ()
  "Performs a demonstration."
  (print-image
    (connected-components
      *test-image*) ) )

(test)