Browse files

Committing changes from last night

  • Loading branch information...
1 parent c42d008 commit e471964d30a5ccd83fed3a39575b6bff8afc1435 Sean Grove committed Apr 14, 2010
Showing with 171 additions and 12 deletions.
  1. +2 −0 config/settings.scm
  2. +145 −0 examples/tehila_basic_camera.scm
  3. +1 −0 launcher.scm
  4. +9 −6 lib/camera.scm
  5. +4 −0 lib/core.scm
  6. +10 −6 lib/keyboard.scm
View
2 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)
View
145 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*)))
View
1 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")
View
15 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))))
View
4 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")
View
16 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)

0 comments on commit e471964

Please sign in to comment.