| (define-module (array3d)
|
| #:use-module (srfi srfi-9))
|
|
|
| (define-record-type <array3d>
|
| (make-array3d packed max-voltage changed changed-recently image set)
|
| array3d?
|
| (packed array3d-packed)
|
| (max-voltage array3d-max-voltage set-array3d-max-voltage!)
|
| (changed array3d-changed set-array3d-changed!)
|
| (changed-recently array3d-changed-recently set-array3d-recently-changed!)
|
| (image array3d-image)
|
| (set array3d-set))
|
|
|
| (define (array-set arr x y z p)
|
| (let ((img (array3d-image arr)))
|
| (if (array3d-packed arr)
|
| (let ((max-v (array3d-max-voltage arr)))
|
| (when (> p max-v)
|
| (set-array3d-max-voltage! arr (* 2.0 p)))
|
| (if (> (array-ref img x y z) max-v)
|
| (array-set! img (+ p (* 2.0 max-v)) x y z)))
|
| (array-set! img p x y z))
|
| (set-array3d-changed! arr #t)
|
| (set-array3d-recently-changed! arr #t)))
|
|
|
| (define (array-new nx ny nz packed)
|
| (make-array3d packed 0.0 #f #f (make-typed-array 'f64 0 nx ny nz) array-set))
|
|
|
| (define (array-ref-by-pos array pos)
|
| (let* ((dimensions (array-dimensions array))
|
| (nx (car dimensions))
|
| (ny (cadr dimensions))
|
| (z (quotient pos
|
| (* nx ny)))
|
| (y (quotient (- pos (* z nx ny))
|
| ny))
|
| (x (- pos (* z nx ny) (* y nx))))
|
| (array-ref array x y z)))
|
|
|
| (let* ((dim 300)
|
| (packed #f)
|
| (arr (array-new dim dim dim packed)))
|
| (do ((x 0 (1+ x)))
|
| ((>= x dim))
|
| (do ((y 0 (1+ y)))
|
| ((>= y dim))
|
| (do ((z 0 (1+ z)))
|
| ((>= z dim))
|
| (array-set arr x y z (* x x)))))
|
| (format #t "~a ~a~%" (array-ref-by-pos (array3d-image arr) (- (expt dim 3) 1)) (expt (- dim 1) 2))
|
| (newline))
|