outrun/outrun.rkt

63 lines
1.7 KiB
Racket

#lang racket
(require pict3d
pict3d/universe
"pict3d-lib.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)
(with-color (rgba-hex "05ffa1")
(let* ([lines
(for*/list ([i (in-range -10 10)]
[j (in-range 0 10)])
(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 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)
(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")