initial commit

outrun.rkt

@@ -0,0 +1,63 @@
+#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.2
+                            #:diffuse 0.5
+                            #:specular 0.6
+                            #:roughness 0.2))
+
+(define (mesh)
+  (with-emitted (emitted-hex "05ffa1" 0)
+    (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")
+

pict3d-lib.rkt

@@ -0,0 +1,18 @@
+#lang racket
+(require pict3d)
+
+(provide rgba-hex emitted-hex)
+
+(define (get-hex str)
+  (let*-values ([(num) (string->number str 16)]
+                [(scale-n) (lambda (x) (/ x 255))]
+                [(num blue) (quotient/remainder num 256)]
+                [(red green) (quotient/remainder num 256)])
+    (list (scale-n red) (scale-n green) (scale-n blue))))
+
+;; TODO: alpha
+(define (rgba-hex str)
+  (apply rgba (get-hex str)))
+(define (emitted-hex str intensity)
+  (apply emitted `(,@(get-hex str) ,intensity)))
+