#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 (road t) (define i-range-start -11) (define i-range-end 11) (define j-range-start -3) (define j-range-end 12) (define (calculate-noise-fn f) (lambda (i j) (scale-number (f (scale-number i i-range-start i-range-end -1 1) (scale-number j j-range-start j-range-end -1 1) (scale-number t 0 9000 -1 1)) -1 1 0 1))) (define calculate-noise (calculate-noise-fn perlin)) (define calculate-noise-simplex (calculate-noise-fn simplex)) (let* ([rgba-noise (lambda (i j) (let* ([r (calculate-noise i j)] [g (calculate-noise-simplex i j)] [b (calculate-noise-simplex r g)]) (rgba r g b 1)))] [vertex-with-noise (lambda (i j) (vertex (pos i (* (calculate-noise-simplex i j) 3) j) #:color (rgba-noise i j)))] [mesh (for*/list ([i (in-range i-range-start i-range-end)] [j (in-range j-range-start j-range-end)]) (quad (vertex-with-noise (add1 i) (add1 j)) (vertex-with-noise i (add1 j)) (vertex-with-noise i j) (vertex-with-noise (add1 i) j) #:back? #t))]) (combine mesh))) (define (spheres t) (define (calculate-noise i j) (scale-number (perlin (scale-number i -10 10 -1 1) (scale-number j -1 10 -1 1) (scale-number t 0 3000 -1 1)) -1 1 0 4)) (define (calculate-pos i j) (pos i (calculate-noise i j) j)) (define spheres (for*/list ([i (in-range -10 10)] [j (in-range -1 10)]) (let ([x i] [z j] [y (calculate-noise i j)] [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.33 1)]) (with-color (rgba-hex "ff71ce" alpha) (sphere (pos x y z) 0.2))))) (combine spheres)) (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))]) (combine lines-frozen (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) (move-y (rotate-x (bend+ my-pipe (/ t 3000) (/ t 4000) 69) 90) 2)) (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 (road t) -1) ;;(spheres t) ;;(scene t) )) (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 960 #:height 760)