(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) )