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

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