(use traversal) (use int-limits) (use srfi-1) (use qt-light) (use utils) (use byte-blob) (use (prefix opengl-glew gl:) gl-utils) ;;;;;;;;;;;;;;;;;;;;;;;;; ;misc (define (normalize val max) (/ val max) ) (define (scanl f init ls);foldl intermediate state variant (cons init (if (null? ls) '() (scanl f (f init (first ls)) (rest ls))))) (define (vec-sum v1 v2) (list (+ (first v1) (first v2)) (+ (second v1) (second v2))) ) (define (norm-Aramp x) (/ (abs (- (modulo x 256) 128)) 128) ) ;;;;;;;;;;;;;;;;;;;;;;;;; ;rng stuff (define rng_inited #f) (define rng_seed 1) (define (init-rng) (randomize rng_seed) (set! rng_inited #t)) (define (norm-rng) (unless rng_inited (init-rng)) (normalize (random most-positive-integer32) most-positive-integer32)) (define (genrn cnt) (list-tabulate cnt (lambda (i) (norm-rng)))) ;;;;;;;;;;;;;;;;;;;;;;;;; ;random sampling processing ;distribution -> choice index (define (p-action-idx rand interval-sizes interval-count) (define (p-action-index_ interval-sizes idx acc) (if (negative? (- acc (first interval-sizes))) idx (p-action-index_ (rest interval-sizes) (+ 1 idx) (- acc (first interval-sizes))) )) (assert (= (length interval-sizes) interval-count) ) (assert (= (sum interval-sizes) 1) ) (p-action-index_ interval-sizes 0 rand)) ;;;;;;;;;;;;;;;;;;;;;;;;; ;simulation procs (define (simu-1d rands) (define (choose-step choice) (assert (<= 0 choice 1) ) (case choice ((0) -1) ((1) 1) )) (let* ((init-pos 0) (p-interval-sizes '(0.5 0.5)) (direction (lambda (rand) (choose-step (p-action-idx rand p-interval-sizes 2)))) (steps (map direction rands)) ) (scanl + init-pos steps))) (define (simu-2d rands) (define (choose-step choice) (assert (<= 0 choice 3) ) (case choice ((0) '(-1 0));left ((1) '( 0 1));up ((2) '( 1 0));right ((3) '( 0 -1)) ));down (let* ((init-pos '(0 0)) (p-interval-sizes '(1/4 1/4 1/4 1/4)) (direction (lambda (rand) (choose-step (p-action-idx rand p-interval-sizes 4)))) (steps (map direction rands)) ) (scanl vec-sum init-pos steps))) ;;;;;;;;;;;;;;;;;;;;;;;;; ;opengl (define simuwidth -1) ;TODO find a better way to scope (define simuheight -1) (define a 0) (define b 0) (define c 0) (define d 0) (define xr 0) (define yr 0) (define zr 0) (define vert-source (read-all "s.vert")) (define frag-source (read-all "s.frag")) (define rect (make-mesh vertices: `(attributes: ((position #:float 2)) initial-elements: ((position . (-1 -1 1 -1 1 1 -1 1)))) indices: '(type: #:ushort initial-elements: (0 1 2 0 2 3)))) (define program (make-parameter #f)) (define tex (gen-texture)) (define (render) (gl:use-program (program)) (check-error) (gl:bind-vertex-array (mesh-vao rect)) (check-error) (gl:draw-elements-base-vertex (mode->gl (mesh-mode rect)) (mesh-n-indices rect) (type->gl (mesh-index-type rect)) #f 0) (check-error) (gl:bind-texture gl:+texture-2d+ tex) (check-error) (define data (->pointer (byte-blob->blob (byte-blob-replicate (* 3 (* simuwidth simuheight)) random)))) (gl:tex-image-2d gl:+texture-2d+ 0 gl:+rgb+ simuwidth simuheight 0 gl:+rgb-integer+ gl:+unsigned-byte+ data) (check-error) (gl:tex-parameteri gl:+texture-2d+ gl:+texture-wrap-s+ gl:+clamp-to-edge+) (gl:tex-parameteri gl:+texture-2d+ gl:+texture-wrap-t+ gl:+clamp-to-edge+) (gl:tex-parameteri gl:+texture-2d+ gl:+texture-min-filter+ gl:+linear+) (gl:tex-parameteri gl:+texture-2d+ gl:+texture-mag-filter+ gl:+linear+) (gl:bind-texture gl:+texture-2d+ 0);idk about this stuff (gl:bind-vertex-array 0)) (define gl-init (lambda() (gl:init) (set! vert-shader (make-shader gl:+vertex-shader+ vert-source)) (set! frag-shader (make-shader gl:+fragment-shader+ frag-source)) (program (make-program (list vert-shader frag-shader))) (check-error) (mesh-make-vao! rect `((position . ,(gl:get-attrib-location (program) "position")) )) )) (define gl-resize (lambda (w h) (when (zero? h) (set! h 1)) (gl:viewport 0 0 w h) )) (define gl-paint (lambda() void ;(render) )) (define (gui) ;;;;;;;;;;;;;;;;;;;;;;;;; ;gui def (let* ((app (qt:init)) (mainwindow (qt:widget (read-all "gui.ui"))) (glparent (qt:find mainwindow "f")) ) (define gl-widget (qt:gl "glwidget" glparent gl-init gl-resize gl-paint 4 3 "core")) (qt:layout-add-widget (qt:find mainwindow "vl") gl-widget) ;;;;;;;;;;;;;;;;;;;;;;;;; ;gui interactive (define (update-state) (set! xr (+ xr a)) (set! yr (+ yr b)) (set! zr (+ zr c)) ) (define t (qt:timer 1/30)) (qt:connect t "timeout()" (qt:receiver (lambda () (update-state) (qt:update gl-widget) ))) (let ((sliders (map (cut qt:find mainwindow <>) '("sl1" "sl2" "sl3" "sl4"))) (signals '("valueChanged(int)" "valueChanged(int)" "valueChanged(int)" "valueChanged(int)")) (fns (list (qt:receiver (lambda(val)(set! a val))) (qt:receiver (lambda(val)(set! b val))) (qt:receiver (lambda(val)(set! c val))) (qt:receiver (lambda(val)(set! d val))) )) (slots '("slot(int)" "slot(int)" "slot(int)" "slot(int)")) ) (map qt:connect sliders signals fns slots) ) (qt:start t) (qt:show mainwindow) (qt:run) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;; (define N 10) (define (main) (gui) (define rands (genrn N)) (simu-2d rands) ) (print (main))