#lang racket (require pict3d pict3d/universe "pict3d-lib.rkt" "noise.rkt") (struct scene-state (done? dx dy sun-dir) #:transparent) (define init-scene-state (scene-state #f 0 0 (dir 1 (- 3) 0))) (current-material (material #:ambient 0.1 #:diffuse 0.6 #:specular 0.3 #:roughness 0.5)) (define (mesh t) (let* ([lines (for*/list ([i (in-range -10 10)] [j (in-range 0 10)]) (with-color (rgba-hex "05ffa1") (move (cylinder (pos (- 0.1) (- 0.1) -5) (pos 0.1 0.1 10)) (dir i 0 j))))] [lines-frozen (freeze (apply combine lines))] [spheres (for*/list ([i (in-range -10 10)] [j (in-range -1 10)]) (with-color (rgba-hex "ff71ce" 0.8) (let ([x i] [z j] [y (scale-number (perlin (scale-number i -10 10 0 1) (scale-number j -1 10 0 1) (scale-number t 0 2000 0 1)) 0 1 1 5)]) (sphere (pos x y z) 0.2))))]) (combine lines-frozen spheres (move (rotate-y lines-frozen 90) (dir -7 0 5))))) (define scene (rotate-y (cube (pos 0 0 0) 1) 30)) (define (make-sunlight d) (sunlight d (emitted "white" 1/2))) (define (on-draw s n t) (combine (basis 'camera (point-at (pos 0 4 -6) origin)) (make-sunlight (scene-state-sun-dir s)) (mesh t) ;; (move-y (rotate-x scene (/ t 20)) 2) )) (define (on-key s n t k) (case k [("escape" "q") (struct-copy scene-state s [done? #t])] [("right") (struct-copy scene-state s [sun-dir (dir+ +x (scene-state-sun-dir s))])] [("left") (struct-copy scene-state s [sun-dir (dir+ -x (scene-state-sun-dir s))])] [else s])) (define (stop-state? s n t) (scene-state-done? s)) (big-bang3d init-scene-state #:on-draw on-draw #:on-key on-key #:stop-state? stop-state? #:name "Outrun")