no title added by deliciovs pie on Thu Oct 26 04:42:06 2017

(use srfi-25)
(use loops)
(use srfi-4)

(require "misc.s")

;;;;;;;;;;;;;;;;;;;;;;
;; basic

(define (dim-size arr k)
  (- (array-end arr k) (array-start arr k)) )

(define (to-linear-idx w iter-state)
  (match-let ([(i . j) iter-state])
    (+ (* j w) i) ))

(define (from-linear-idx w idx)
  (cons (remainder idx w) (quotient idx w)) )
  
(define (array-iter arr expr) ; iteration direction is such that array-print works, i.e. topleft-boright
  (define w (dim-size arr 0))
  (define h (dim-size arr 1))

  (let ((startj (- h 1)) (stop 0))
    (let loop ((j startj))
      (unless (< j 0)
        (do-for i (0 w)
                (expr arr i j w h)
                )
        (loop (dec j)) )))
  )

(define (array->row-reversed-u8vector arr)
  (define w (dim-size arr 0))
  (define h (dim-size arr 1))

  (define flat (make-u8vector (* w h) 0))
  (do-for j (0 h)
          (do-for i (0 w)
                  (u8vector-set! flat (to-linear-idx w (cons i j)) (* 100 (array-ref arr i j)))
                  ))
  flat)

(define (array-pad arr)
  (define w (dim-size arr 0))
  (define h (dim-size arr 1))
    
  (define new (make-array (shape 0 (+ w 2) 0 (+ h 2)) 0))
  
  (array-iter new (lambda(newarr i j w h)
                    (define edge (or (= i 0) (= j 0) (= i (- w 1)) (= j (- h 1))))
                    (cond
                      (edge void)
                      (else (array-set! newarr i j (array-ref arr (- i 1) (- j 1)))) )))
  new)
  
(define (array-print arr)
  (array-iter arr
              (lambda (arr i j w h)
                (cond
                  ((= i (- w 1)) (print  (array-ref arr i j)    ))
                  (else          (print* (array-ref arr i j) " ")) ))))


(define (array-copy arr)
  (define w (dim-size arr 0))
  (define h (dim-size arr 1))
  (define new (make-array (shape 0 w 0 h)))
  (array-iter new
              (lambda(new i j w h)(
                                   (array-set! new i j (array-ref arr i j) )
                                   )))
  new
  )
  
(define (array-find arr value #!optional (pred #f))
  (define pred
    (if (equal? pred #f)
        (lambda(arr i j w h value)(= (array-ref arr i j) value))
        pred
        ))
  
  (define w (dim-size arr 0))
  (define h (dim-size arr 1))

  (define (find-next arr iter-state value)
    (define (toidx iter-state)
      (to-linear-idx w iter-state))

    (define (fromidx idx)
      (from-linear-idx w idx))
    
    (define (next-state pos)
      (define nextpos (inc (toidx pos)))
      (fromidx nextpos))
    
    (define stop (* w h) )
    (define startidx (toidx iter-state))
    (define result
      (let loop ((idx startidx)) ; this is a mess, i tried indexing with two loops but that didnt work because the outer loop couldnt access the inner index
        (match-let ([(i . j) (fromidx idx)])
          (cond ;order matters
            ((= idx stop) (cons #f '()))
            ((pred arr i j w h value) (cons #t (cons i j)))
            (else (loop (inc idx)))
            )
          )
        )
      )
    
    (match-let ([(status . result) result])
      (if status
          (cons (next-state result) result); (nextstate . result)
          (cons '() '()) ) ) )
  
  (define searchf
    (lambda(iter-state)
      (find-next arr iter-state value)))

  (find searchf)
  )