#lang racket (require pict3d pict3d/universe "pict3d-lib.rkt" "noise.rkt") (struct scene-state (done? dx dy dz dsun) #:transparent) (define init-scene-state (scene-state #f 0 0 0 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)]) (let ([x i] [z j] [y (scale-number (perlin (scale-number i -10 10 -1 1) (scale-number j -1 10 -1 1) (scale-number t 0 2000 -1 1)) -1 1 0 4)] [alpha (scale-number (simplex (scale-number i -10 10 -1 1) (scale-number j -1 10 -1 1) (scale-number t 0 2000 -1 1)) -1 1 0.1 0.8)]) (with-color (rgba-hex "ff71ce" alpha) (sphere (pos x y z) 0.2))))]) (combine lines-frozen spheres (move (rotate-y lines-frozen 90) (dir -7 0 5))))) (define my-pipe (tessellate (pipe origin (dir 1 1/2 1)))) (define (bend+ p x y z) (bend p (scale-number (perlin x y z) -1 1 -180 180))) (define (scene t) (rotate-x (bend+ my-pipe (/ t 1000) (/ t 1200) 69) 90)) (define (make-sunlight dsun) (sunlight (angles->dir -30 (* 10 dsun)) (emitted "white" 1/2))) ;; Calculate camera position based on the state (define (camera-position s) (pos 0 (+ 4 (scene-state-dy s)) (- (scene-state-dz s) 4))) ;; Calculate camera direction based on the state (define (camera-direction s) (angles->dir -90 55)) (define (on-draw s n t) (combine (basis 'camera (point-at (camera-position s) (camera-direction s))) (make-sunlight (scene-state-dsun s)) (mesh t) (move-y (scene t) 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 [dsun (add1 (scene-state-dsun s))])] [("left") (struct-copy scene-state s [dsun (sub1 (scene-state-dsun s))])] [("up") (struct-copy scene-state s [dy (+ (scene-state-dy s) 0.1)])] [("down") (struct-copy scene-state s [dy (- (scene-state-dy s) 0.1)])] [("w") (struct-copy scene-state s [dz (+ (scene-state-dz s) 0.1)])] [("s") (struct-copy scene-state s [dz (- (scene-state-dz s) 0.1)])] [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 "sketch" #:width 800 #:height 600)