outrun/outrun.rkt

#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))

(current-material (material #:ambient 0.05
                            #:diffuse 0.70
                            #:specular 0.25
                            #:roughness 0.1))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; the wavy road thingie

(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)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; the jumping spheres

(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))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; the static mesh

(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-comb (apply combine lines)])
    (freeze (combine lines
                     (move (rotate-y lines-comb 90)
                           (dir -7 0 5))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; the bendy pipe

(define my-pipe (tessellate (with-color (rgba-hex "01cdfe") (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))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; the static spheres

(define (sspheres amount)
  (let* ((calculate-noise-fn
          (lambda (f)
            (lambda (i j k)
              (scale-number (f (scale-number i -10 10 -1 1)
                               (scale-number j -10 10 -1 1)
                               (scale-number k -10 10 -1 1))
                            -1 1
                            0 1))))
         (noise1 (calculate-noise-fn simplex))
         (noise2 (calculate-noise-fn perlin))
         (random-position (lambda ()
                            (pos (* (- (random) 0.5) 15)
                                 (* (- (random) 0.5) 15)
                                 (* (- (random) 0.5) 15)))))
    (combine
     (for/list ([_ (in-range amount)])
       (match-let* ([(pos i j k) (random-position)]
                    [red (noise1 i j k)]
                    [green (noise2 i j k)]
                    [blue (noise1 red green 0)])
         (with-color (rgba red green blue)
           (sphere (pos i j k) (* 0.25 (+ (random) 0.1)))))))))

(define frozen-sspheres (freeze (sspheres 1000)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; the lights

(define (make-sunlight i)
  (define cx (cos (degrees->radians i)))
  (define sx (sin (degrees->radians i)))
  (define cx2 (cos (* 8 (degrees->radians i))))
  (define sx2 (sin (* 5 (degrees->radians i))))
  (define light-pos
        (pos (* 2 cx2) (* 3 sx2) (* 2 sx2)))
  (combine
   (with-emitted (emitted-hex "fffb96" 1/2)
     (sphere light-pos 0.1))
   (light light-pos (emitted-hex "fffb96" 10))
   (sunlight
    (angles->dir -30 30)
    (emitted "white" 1))))

;; Calculate camera position based on the state. Returns a `pos`.
(define (camera-position s)
  (pos (scene-state-dx s) (+ 4 (scene-state-dy s)) (- (scene-state-dz s) 4)))

;; Calculate camera direction based on the state. Returns a `dir` or a `pos`.
(define (camera-direction s)
  (angles->dir -90 55)
  ;;origin
)

(define (on-draw s n t)
  (combine (basis 'camera
                  (point-at (camera-position s)
                            (camera-direction s)))
           (make-sunlight (scene-state-dsun s))
           ;; (move-y (road t) -1)
           (spheres t)
           (scene t)
           frozen-sspheres
           (mesh 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)])]
    [("a") (struct-copy scene-state s
                         [dx (+ (scene-state-dx s) 0.5)])]
    [("d") (struct-copy scene-state s
                         [dx (- (scene-state-dx s) 0.5)])]
    [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)