Committing changes from last night

config/settings.scm

@@ -13,3 +13,5 @@
 (define *shade-model* gl:SMOOTH)
 
 (define *texture-files* '("resources/grid.bmp" "resources/corner_test.bmp" "resources/example.bmp"))
+
+(define *default-debug-function* print)

examples/tehila_basic_camera.scm

@@ -0,0 +1,145 @@
+;; Tutorial-specific settings
+(define *clear-color* '(0 0 0 0))
+
+(define (game-loop delta)
+  (let* ((total-time (- (current-milliseconds) *start-time*))
+         (triangle-rotation (/ total-time 4))
+         (quad-rotation (/ total-time 2))
+         (object-count 20))
+
+    (update-camera delta)
+    (adjust-for-camera)
+
+    ;; Circle of triangles around the origin (0, 0, 0)
+    (do ((angle 0 (+ angle (/ 360 object-count)))) ((> angle 360))
+
+      ;; Get a new matrix (same as pushing and popping the matrix)
+      (with-new-matrix
+       (lambda ()
+
+         ;; Rotate about the Y axis before we move the pyramid
+         (rotate angle 0 1 0)
+
+         ;; Move "out of" the screen 15 units
+         (translate 0 0.0 -15)
+
+         ;; Rotate about the Y axis before we draw the pyramid
+         (rotate triangle-rotation 0 1 0)
+
+         ;; Draw one face of the pyramid (a colored triangle)
+         (triangle (color   1  0  0)  ;; Red
+                   (vertex  0  1  0)  ;; Top
+                   (color   0  1  0)  ;; Green
+                   (vertex -1 -1  1)  ;; Bottom Left
+                   (color   0  0  1)  ;; Blue
+                   (vertex  1 -1  1)) ;; Bottom Right
+
+         (triangle (color   1  0  0)  ;; Red
+                   (vertex  0  1  0)  ;; Top
+                   (color   0  0  1)  ;; Blue
+                   (vertex  1 -1  1)  ;; Bottom Left
+                   (color   0  1  0)  ;; Green
+                   (vertex  1 -1 -1)) ;; Bottom Right
+
+         (triangle (color   1  0  0)  ;; Red
+                   (vertex  0  1  0)  ;; Top
+                   (color   0  1  0)  ;; Green
+                   (vertex  1 -1 -1)  ;; Bottom Left
+                   (color   0  0  1)  ;; Blue
+                   (vertex -1 -1 -1)) ;; Bottom Right
+
+         (triangle (color   1  0  0)  ;; Red
+                   (vertex  0  1  0)  ;; Top
+                   (color   0  0  1)  ;; Blue
+                   (vertex -1 -1 -1)  ;; Bottom Left
+                   (color   0  1  0)  ;; Green
+                   (vertex -1 -1  1)) ;; Bottom Right
+         )))
+
+      ;; Reset to the default matrix
+      (with-new-matrix
+       (lambda ()
+
+         ;; Move left 1.5 units and "out of" the screen 6 units
+         (translate 0.0 0.0 -3.0)
+
+         ;; Rotate about the X, Y, and Z axis before we draw the cube
+         (rotate quad-rotation 0.25 1 1)
+
+         ;; Draw a flat-colored (one-color) quad
+         (flat-quad (color 0 1 0)      ;; Green
+                    (vertex  1  1 -1)  ;; Top Left
+                    (vertex -1  1 -1)  ;; Top Right
+                    (vertex -1  1  1)  ;; Bottom Right
+                    (vertex  1  1  1)) ;; Bottom Left     
+
+         (flat-quad (color 1 0.5 1)    ;; Orange
+                    (vertex  1 -1  1)  ;; Top Left
+                    (vertex -1 -1  1)  ;; Top Right
+                    (vertex -1 -1 -1)  ;; Bottom Right
+                    (vertex  1 -1 -1)) ;; Bottom Left 
+
+         (flat-quad (color 1 0 0)      ;; Red
+                    (vertex  1  1  1)  ;; Top Left
+                    (vertex -1  1  1)  ;; Top Right
+                    (vertex -1 -1  1)  ;; Bottom Right
+                    (vertex  1 -1  1)) ;; Bottom Left 
+
+         (flat-quad (color 1 1 0)      ;; Yellow
+                    (vertex  1 -1 -1)  ;; Top Left
+                    (vertex -1 -1 -1)  ;; Top Right
+                    (vertex -1  1 -1)  ;; Bottom Right
+                    (vertex  1  1 -1)) ;; Bottom Left      
+
+         (flat-quad (color 0 0 1)      ;; Blue
+                    (vertex -1  1  1)  ;; Top Left
+                    (vertex -1  1 -1)  ;; Top Right
+                    (vertex -1 -1 -1)  ;; Bottom Right
+                    (vertex -1 -1  1)) ;; Bottom Left      
+
+         (flat-quad (color   1  0  1)  ;; Violet
+                    (vertex  1  1 -1)  ;; Top Left
+                    (vertex  1  1  1)  ;; Top Right
+                    (vertex  1 -1  1)  ;; Bottom Right
+                    (vertex  1 -1 -1)) ;; Bottom Left      
+         ))))
+
+(define (handle-keyboard-state delta)
+  ;; bind keys to actions
+  (let* ((walk-speed 0.01)
+         (turn-speed 0.10)
+         (key-map
+          ;; Note: Strafe is essentially broken right now. Need to fix it.
+          `((#\a . ,(lambda () (strafe-camera (vertex (- walk-speed) 0 0))))
+            (#\d . ,(lambda () (strafe-camera (vertex walk-speed 0 0))))
+            (#\w . ,(lambda () (move-camera-forward walk-speed)))
+            (#\s . ,(lambda () (move-camera-forward (- walk-speed))))
+
+            ;; Move vertically
+            (#\z . ,(lambda () (move-camera (vertex 0 (- walk-speed) 0))))
+            (#\x . ,(lambda () (move-camera (vertex 0 walk-speed 0))))
+
+            ;; Rotate around the Z and X axis (note: disorienting)
+            (#\q . ,(lambda () (turn-camera (vertex 0 0 (- turn-speed)))))
+            (#\e . ,(lambda () (turn-camera (vertex 0 0 turn-speed ))))
+            (#\r . ,(lambda () (turn-camera (vertex (- turn-speed) 0 0))))
+            (#\f . ,(lambda () (turn-camera (vertex turn-speed 0 0 ))))
+
+            ;; Normal walking controls via arrow keys
+            (,kb:LEFT  . ,(lambda () (turn-camera (vertex 0 (- turn-speed) 0))))
+            (,kb:RIGHT . ,(lambda () (turn-camera (vertex 0 turn-speed 0))))
+            (,kb:UP    . ,(lambda () (move-camera-forward walk-speed)))
+            (,kb:DOWN  . ,(lambda () (move-camera-forward (- walk-speed))))
+
+            ;; Get a REPL. You can check the world state with things like
+            ;; (camera-debug)
+            (#\space . ,(lambda () (returnable-repl)))
+
+            ;; q to quit
+            (#\q . ,(lambda () (exit))))))
+
+    ;; execute actions for keys in *keyboard-state*
+    (for-each (lambda (key)
+                (and-let* ((handler (alist-ref key key-map)))
+                          (handler)))
+              *keyboard-state*)))

launcher.scm

@@ -2,5 +2,6 @@
 ;; (define *logic-file* "examples/nehe_tutorials_3.scm")
 ;; (define *logic-file* "examples/nehe_tutorials_4.scm")
 (define *logic-file* "examples/nehe_tutorials_5.scm")
+;; (define *logic-file* "examples/tehila_basic_camera.scm")
 
 (load "lib/core.scm")

lib/camera.scm

@@ -26,7 +26,8 @@
 (define (turn-camera rotation)
   ;(print "Turning camera!")
   ;(print (vertex->string rotation))
-  (set! camera-rotation (map (lambda (a b) (+ a b)) camera-rotation rotation)))
+  (set! camera-rotation (map (lambda (a b) (+ a b)) camera-rotation rotation))
+  (update-camera 1))
 
 ;; TODO: Currently 2d. Make it 3d
 (define (camera-look-at position)
@@ -79,7 +80,8 @@
     (turn-camera (vertex 0 (- 90 (vertex-y rotation)) 0))))
 
 (define (move-camera delta)
-  (set! camera-velocity (map (lambda (a b) (+ a b)) camera-velocity delta)))
+  (set! camera-velocity (map (lambda (a b) (+ a b)) camera-velocity delta))
+  (update-camera 1))
 
 (define (move-camera-forward distance)
   (let* ((angle-y (+ 270 (vertex-y camera-angle)))
@@ -115,9 +117,10 @@
   (reset-camera-position)
   (reset-camera-angle))
 
-(define (camera-debug debug-function)
-  (let ((orbit-center (get-orbit-center 10)))
-    (map debug-function (list (string-append "POSITION: " (number->string (vertex-x camera-position)) ", " (number->string (vertex-y camera-position)) ", " (number->string (vertex-z camera-position)))
+(define (camera-debug #!optional debug-function)
+  (let ((f (or debug-function *default-debug-function* print))
+        (orbit-center (get-orbit-center 10)))
+    (map f (list (string-append "POSITION: " (number->string (vertex-x camera-position)) ", " (number->string (vertex-y camera-position)) ", " (number->string (vertex-z camera-position)))
                               (string-append "VELOCITY: " (number->string (vertex-x camera-velocity)) ", " (number->string (vertex-y camera-velocity)) ", " (number->string (vertex-z camera-velocity)))
                               (string-append "ANGLE: "    (number->string (vertex-x camera-angle))    ", " (number->string (vertex-y camera-angle))    ", " (number->string (vertex-z camera-angle)))
                               (string-append "ROTATION: " (number->string (vertex-x camera-rotation)) ", " (number->string (vertex-y camera-rotation)) ", " (number->string (vertex-z camera-rotation)))
@@ -132,7 +135,7 @@
 
 
 (define (adjust-for-camera)
-  (camera-debug print)
+  ;(camera-debug print)
     ;(gl:Translated (vertex-x orbit-center) (vertex-y orbit-center) (vertex-z orbit-center))
     ;(gl:Rotated (vertex-y camera-orbit-angle) 0 1 0)
     ;(gl:Translated (- (vertex-x orbit-center)) (- (vertex-y orbit-center)) (- (vertex-z orbit-center))))

lib/core.scm

@@ -2,6 +2,7 @@
 (require-extension gl)
 (require-extension glu)
 (require-extension glut)
+(require-extension srfi-2)
 (require-extension srfi-4)
 
 ;; Hooks. Load early so they can be overridden anywhere
@@ -16,6 +17,9 @@
 (define (pre-display-hook) '())
 (define (post-display-hook) '())
 
+;; Defaults that can be overridden anywhere
+(define *default-debug-function* #f)
+
 ;; General helpers
 (load "lib/exceptions.scm")
 (load "lib/math_utils.scm")

lib/keyboard.scm

@@ -4,25 +4,29 @@
 (define *keyboard-state* (list))
 
 (define (kb:add-key key)
-  (print "Adding a key!")
-  (set! *keyboard-state* (append *keyboard-state* (list key))))
-  ;(kb:debug-keyboard-state))
+  (set! *keyboard-state* (append *keyboard-state* (list key)))
+  (kb:debug-keyboard-state))
 
 (define (kb:remove-key key)
-  (print "Removing a key!")
   (when (member key *keyboard-state*)
     (set! *keyboard-state* (remove (lambda (x) (equal? x key)) *keyboard-state*)))
     (kb:debug-keyboard-state))
 
 (define (kb:key-pressed? key)
   (member key *keyboard-state*))
 
-(define (kb:debug-keyboard-state)
-  (print (->string *keyboard-state*)))
+(define (kb:debug-keyboard-state #!optional output-function)
+  (let ((f (or output-function *default-debug-function* print)))
+    (f (string-append "*keyboard-state*: "(->string *keyboard-state*)))))
 
 (define (keyboard key x y)
   (kb:add-key key))
 
 (define (keyboard-up key x y)
   (kb:remove-key key))
 
+
+(define kb:LEFT 100)
+(define kb:RIGHT 102)
+(define kb:UP 101)
+(define kb:DOWN 103)