Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

First source commit, quite a few random files. But a beginning at least.

  • Loading branch information...
commit 49303d08fe002a20d8e4252615be2fb18cc7b72f 1 parent 140a11c
Sean Grove authored
18 config/environment.scm
View
@@ -0,0 +1,18 @@
+(define *debug-mode* #f)
+
+(define *window-title* "Schope")
+
+(define *window-resolution* '(640 480))
+(define *window-position* '(100 100))
+(define *clear-color* '(0 0 0 0))
+(define *clear-depth* 1.0)
+
+(define *ignore-key-repeat* #f)
+
+(define *shade-model* gl:SMOOTH)
+
+(define (pre-main-hook)
+ (move-camera (vertex 5 10 5))
+ (turn-camera (vertex 45 225 0)))
+
+(define *texture-files* '("rpg-char-4.bmp" "rpg-char-4-2.bmp" "grid.bmp" "tree.bmp" "corner_test.bmp" "grass.bmp"))
14 config/settings.scm
View
@@ -0,0 +1,14 @@
+(define *debug-mode* #f)
+
+(define *window-title* "Schope")
+
+(define *window-resolution* '(640 480))
+(define *window-position* '(100 100))
+(define *clear-color* '(1 1 1 0))
+(define *clear-depth* 1.0)
+
+(define *ignore-key-repeat* #t)
+
+(define *shade-model* gl:SMOOTH)
+
+(define *texture-files* '("resources/rpg-char-4.bmp" "resources/rpg-char-4-2.bmp" "resources/grid.bmp" "resources/tree.bmp" "resources/corner_test.bmp" "resources/grass.bmp" "resources/water_64x64.bmp" "resources/grass-water_64x64.bmp"))
7 examples/floor.scm
View
@@ -0,0 +1,7 @@
+(define (draw-floor)
+ (textured-quad (u32vector-ref texture-handles 5)
+ (vertex -100 -5 100)
+ (vertex 100 -5 100)
+ (vertex 100 -5 -100)
+ (vertex -100 -5 -100)
+ 25 25))
154 examples/thick_triangles.scm
View
@@ -0,0 +1,154 @@
+(require-extension gl)
+(require-extension glu)
+(require-extension glut)
+
+(set! *start-time* (current-milliseconds))
+
+(define (init)
+ (gl:ClearColor 0.0 0.0 0.0 0.0)
+ (gl:ShadeModel gl:SMOOTH))
+
+(define (with-gl type body)
+ (gl:Begin type)
+ (body)
+ (gl:End))
+
+
+(define (triangle c1-r c1-g c1-b
+ x1 y1 z1
+ c2-r c2-g c2-b
+ x2 y2 z2
+ c3-r c3-g c3-b
+ x3 y3 z3)
+ (with-gl gl:TRIANGLES
+ (lambda ()
+ (gl:Color3f c1-r c1-g c1-b)
+ (gl:Vertex3f x1 y1 z1)
+ (gl:Color3f c2-r c2-g c2-b)
+ (gl:Vertex3f x2 y2 z2)
+ (gl:Color3f c3-r c3-g c3-b)
+ (gl:Vertex3f x3 y3 z3)
+ )))
+
+
+(define (flat-triangle r g b
+ x1 y1 z1
+ x2 y2 z2
+ x3 y3 z3)
+ (triangle r g b
+ x1 y1 z1
+ r g b
+ x2 y2 z2
+ r g b
+ x3 y3 z3))
+
+(define (thick-triangle r g b
+ x y s)
+ ; front face
+ (flat-triangle r g b
+ (+ (- (/ s 2)) x) y 0
+ x (+ y s) 0
+ (+ (/ s 2) x) y 0)
+ ;undersides
+ (flat-triangle r g b
+ (+ (- (/ s 2)) x) y 0
+ (+ (- (/ s 2)) x) y 0.25
+ (+ (/ s 2) x) y 0)
+ (flat-triangle r g b
+ (+ (- (/ s 2)) x) y 0.25
+ (+ (/ s 2) x) y 0.25
+ (+ (/ s 2) x) y 0.0)
+
+ ;side-1
+ (flat-triangle r g b
+ (+ (- (/ s 2)) x) y 0
+ (+ (- (/ s 2)) x) y 0.25
+ x (+ y s) 0.25)
+ (flat-triangle r g b
+ (+ (- (/ s 2)) x) y 0
+ x (+ y s) 0
+ x (+ y s) 0.25)
+
+ ;side-2
+ (flat-triangle r g b
+ (+ (/ s 2) x) y 0
+ (+ (/ s 2) x) y 0.25
+ x (+ y s) 0.25)
+ (flat-triangle r g b
+ (+ (/ s 2) x) y 0
+ x (+ y s) 0
+ x (+ y s) 0.25))
+
+
+(define (triangles-4 delta)
+ (gl:PushMatrix)
+ (gl:Rotated (* 90 delta) 0 1 0)
+ (do ((i 0 (+ i 1))
+ (a 10 (- a 1)))
+ ((> i 4))
+ (begin
+ (gl:Rotated 90 0 1 0)
+ (gl:Translated 0.8 0 1)
+ (thick-triangle 0.65 0.65 0
+ 0 0 1)
+ (thick-triangle 0.65 0.65 0
+ -0.5 -1 1)
+ (thick-triangle 0.65 0.65 0
+ 0.5 -1 1)))
+
+ ; flip the matrix
+ (gl:Translated 0 2 0)
+ (gl:Rotated 180 0 0 1)
+
+
+ (do ((i 0 (+ i 1))
+ (a 10 (- a 1)))
+ ((> i 4))
+ (begin
+ (gl:Rotated 90 0 1 0)
+ (gl:Translated 0.8 0 1)
+ (thick-triangle 0.65 0.65 0
+ 0 0 1)
+ (thick-triangle 0.65 0.65 0
+ -0.5 -1 1)
+ (thick-triangle 0.65 0.65 0
+ 0.5 -1 1)))
+ (gl:PopMatrix))
+
+(define (display)
+ (gl:Clear gl:COLOR_BUFFER_BIT)
+ (gl:MatrixMode gl:MODELVIEW)
+ (let ((delta (/ (- *start-time* (current-milliseconds)) 100)))
+ (print delta)
+ (triangles-4 (/ delta 4))
+ (gl:Flush)))
+
+(define (reshape width height)
+ (gl:Viewport 0 0 width height)
+ (gl:MatrixMode gl:PROJECTION)
+ (gl:LoadIdentity)
+ (glu:Perspective 60.0 (/ width height) 1.0 30.0)
+ (gl:MatrixMode gl:MODELVIEW)
+ (gl:LoadIdentity)
+ (gl:Translatef 0.0 0.0 (- 3.6)))
+
+(define (keyboard key x y)
+ (if (equal? key 27)
+ (exit 0)))
+
+(define (render-loop delta)
+ (glut:PostRedisplay)
+ (glut:TimerFunc 0 render-loop 0))
+
+(define (main)
+ (glut:InitWindowSize 250 250)
+ (glut:InitWindowPosition 100 100)
+ (glut:CreateWindow "Schemer's Hope")
+ (init)
+ (glut:DisplayFunc display)
+ (glut:ReshapeFunc reshape)
+ (glut:KeyboardFunc keyboard)
+ (glut:TimerFunc 1 render-loop 0)
+ (glut:MainLoop))
+
+(main)
195 game.scm
View
@@ -0,0 +1,195 @@
+(define tree-heights
+ (let* ((heights (make-vector tree-count)))
+ (do ((tree 0 (+ 1 tree))) ((equal? tree tree-count))
+ (vector-set! heights tree (+ (/ (random 8) 2) 1)))
+ heights))
+
+(define tree-rotations
+ (let* ((rotations (make-vector tree-count)))
+ (do ((tree 0 (+ 1 tree))) ((equal? tree tree-count))
+ (vector-set! rotations tree (/ (- (random 1080) 720) 2)))
+ rotations))
+
+(define (draw-tree n)
+ (let ((position (vector-ref tree-positions n))
+ (rotation (vector-ref tree-rotations n))
+ (height (vector-ref tree-heights n)))
+ ;(print (vertex->string position))
+ (with-new-matrix
+ (gl:Rotatef rotation 0 1 0)
+ (gl:Translatef (vertex-x position) (vertex-y position) (vertex-z position))
+ (textured-quad (u32vector-ref texture-handles tree-texture-handle)
+ (vertex 0 height 0)
+ (vertex 1 height 0)
+ (vertex 1 0 0)
+ (vertex 0 0 0)))))
+
+(define (draw-trees)
+ (do ((counter 0 (+ counter 1))) ((equal? counter tree-count))
+ (draw-tree counter)))
+
+;; ----- Characters -----
+
+(define character-count 40)
+(define character-texture-handle 0)
+
+(define character-positions
+ (let* ((positions (make-vector character-count)))
+ (do ((character 0 (+ 1 character))) ((equal? character character-count))
+ ;;(vector-set! positions character (vertex 0 -5 0)))
+ (vector-set! positions character (vertex (/ (- (random 1000) 500) 100)
+ -5
+ (/ (- (random 10000) 500) 100))))
+ positions))
+
+(define character-velocities
+ (let* ((velocities (make-vector character-count)))
+ (do ((character 0 (+ 1 character))) ((equal? character character-count)))
+ velocities))
+
+
+(define (update-character-positions)
+ (do ((character 0 (+ 1 character))) ((equal? character character-count))
+ (vector-set! character-positions character
+ (vertex-add (vector-ref character-positions character) (vector-ref character-velocities character)))
+ (vector-set! character-velocities character (vertex 0 0 0))))
+
+(define character-rotations
+ (let* ((rotations (make-vector character-count)))
+ (do ((character 0 (+ 1 character))) ((equal? character character-count))
+ (vector-set! rotations character (/ (- (random 1080) 720) 2)))
+ rotations))
+
+(define (characters-wander)
+ (do ((character 0 (+ 1 character))) ((equal? character character-count))
+ (vector-set! character-velocities character
+ (vertex (/ (- (random 1) 1) 100) 0 (/ (- (random 1) 1) 100)))))
+
+(define (draw-character position
+ rotation
+ scale)
+ (let ((texture-number (remainder (- (current-milliseconds) *start-time*) 2)))
+ (with-new-matrix
+ (gl:Rotatef rotation 0 1 0)
+ (gl:Translatef (vertex-x position) (vertex-y position) (vertex-z position))
+ (textured-quad (u32vector-ref texture-handles texture-number)
+ (vertex 0 1 0)
+ (vertex 1 1 0)
+ (vertex 1 0 0)
+ (vertex 0 0 0)))))
+
+(define (draw-character-from-array n)
+ (characters-wander)
+ (update-character-positions)
+ (let ((position (vector-ref character-positions n))
+ (rotation (vector-ref character-rotations n)))
+ ;(print (vertex->string position))
+ (with-new-matrix
+ ;(gl:Rotatef rotation 0 1 0)
+ (gl:Translatef (vertex-x position) (vertex-y position) (vertex-z position))
+ (textured-quad (u32vector-ref texture-handles character-texture-handle)
+ (vertex 0 1 0)
+ (vertex 1 1 0)
+ (vertex 1 0 0)
+ (vertex 0 0 0)))))
+
+(define (draw-characters)
+ (do ((counter 0 (+ counter 1))) ((equal? counter character-count))
+ (draw-character-from-array counter)))
+
+
+;; floor
+
+(define (draw-floor)
+ (let ((grass-texture (u32vector-ref texture-handles 5))
+ (grid-texture (u32vector-ref texture-handles 2))
+ (base -5))
+ (do ((x -10 (+ x 1))) ((> x 100))
+ (do ((z -5 (+ z 1))) ((> z 0))
+ (bottomless-cube grass-texture
+ grid-texture
+ x (+ (sin (/ x 4)) base) (+ z (sin (/ x 3)))
+ 1)))))
+
+
+(define (handle-keyboard-state delta)
+ (let* ((delta (+ (- (current-milliseconds) *last-frame*) 1))
+ (turn-sensitivity (* 1.0 delta))
+ (move-sensitivity (* 0.01 delta))
+ (walk-length (* 0.5 delta)))
+ (print delta)
+ ;; (if (kb:key-pressed? glut:KEY_LEFT) (turn-camera (vertex (- turn-sensitivity) 0 0)))
+ ;; (if (kb:key-pressed? glut:KEY_RIGHT) (turn-camera (vertex turn-sensitivity 0 0)))
+ ;; (if (kb:key-pressed? glut:KEY_UP) (move-camera-forward walk-length))
+ ;; (if (kb:key-pressed? glut:KEY_DOWN) (move-camera-forward (- walk-length)))
+
+ (if (kb:key-pressed? glut:KEY_LEFT) (iso-move-camera (vertex 1 0 0)))
+ (if (kb:key-pressed? glut:KEY_RIGHT) (iso-move-camera (vertex -1 0 0)))
+ (if (kb:key-pressed? glut:KEY_UP) (iso-move-camera (vertex 0 0 1)))
+ (if (kb:key-pressed? glut:KEY_DOWN) (iso-move-camera (vertex 0 0 -1)))
+
+ (if (kb:key-pressed? #\q) (iso-turn-camera (vertex 0 1 0)))
+ (if (kb:key-pressed? #\e) (iso-turn-camera (vertex 0 -1 0)))
+
+
+ (if (kb:key-pressed? #\a) (strafe-camera (vertex walk-length 0 0)))
+ (if (kb:key-pressed? #\d) (strafe-camera (vertex (- walk-length) 0 0)))
+ (if (kb:key-pressed? #\a) (strafe-camera (vertex walk-length 0 0)))
+ (if (kb:key-pressed? #\d) (strafe-camera (vertex (- walk-length) 0 0)))
+ (if (kb:key-pressed? #\w) (strafe-camera (vertex 0 walk-length 0)))
+ (if (kb:key-pressed? #\s) (strafe-camera (vertex 0 (- walk-length) 0)))
+ (if (kb:key-pressed? #\z) (move-camera (vertex 0 walk-length 0)))
+ (if (kb:key-pressed? #\x) (move-camera (vertex 0 (- walk-length) 0)))
+
+ (if (kb:key-pressed? #\r) (turn-camera (vertex 0 0 (- turn-sensitivity))))
+ (if (kb:key-pressed? #\f) (turn-camera (vertex 0 0 turn-sensitivity)))
+
+ (if (kb:key-pressed? #\space) (returnable-repl))))
+
+;; --- Main loop
+(define (game-looper delta)
+ (print "Do something here!")
+ (print delta)
+ (define (textured-triangle-example delta)
+ (let* ((total-time (- (current-milliseconds) *start-time*))
+ (seconds (/ (inexact->exact (truncate total-time)) 1000))
+ (current-texture (inexact->exact (truncate (remainder seconds 2)))))
+ ;(print seconds)
+ ;(print current-texture)
+ ;(print delta)
+ ;(move-camera-forward (- 0.1))
+ (update-camera delta)
+ (adjust-for-camera)
+ ;(camera-debug print)
+
+ ;; (do ((x -20.0 (+ x 1))) ((> x 20))
+ ;; (do ((z -2.0 (+ z 1))) ((> z 2))
+ ;; (with-new-matrix
+ ;; (textured-quad (u32vector-ref texture-handles 2)
+ ;; (vertex x -0.5 z)
+ ;; (vertex (+ x 1) -0.5 z)
+ ;; (vertex (+ x 1) -0.5 (- z 1))
+ ;; (vertex x -0.5 (- z 1))))))
+
+ (draw-floor)
+
+ (with-new-matrix
+
+ (flat-triangle (color 0.25 0.5 0.75)
+ (vertex -1 1 -2)
+ (vertex 1 1 -2)
+ (vertex 1 0 -2)))
+
+ (draw-trees)
+ (draw-characters))))
+
+(define tree-count 100)
+(define tree-texture-handle 3)
+
+(define tree-positions
+ (let* ((positions (make-vector tree-count)))
+ (do ((tree 0 (+ 1 tree))) ((equal? tree tree-count))
+ (vector-set! positions tree (vertex (/ (- (random 10000) 5000) 100)
+ -5
+ (/ (- (random 10000) 5000) 100))))
+ positions))
1  launcher.scm
View
@@ -0,0 +1 @@
+(load "lib/core.scm")
5 lib/binary_utils.scm
View
@@ -0,0 +1,5 @@
+(define (read-binary-file)
+ (let ((current-byte (read-byte)))
+ (if (equal? #!eof current-byte)
+ '()
+ (cons current-byte (read-binary-file)))))
21 lib/bmp_reader.scm
View
@@ -0,0 +1,21 @@
+(load "list_utils.scm")
+(load "binary_utils.scm")
+(load "image_utils.scm")
+
+(set! data (load-bmp "example.bmp"))
+
+;(print data)
+(set! *offset* (nth data 10))
+(set! *width* (nth data 18))
+(set! *height* (nth data 22))
+
+(print (string-append "example.bmp" " is "
+ (number->string *width*) "x"
+ (number->string *height*) ", and bmp data starts at "
+ (number->string *offset*)))
+
+(do ((i *offset* (+ i 4)))
+ ((> i (+ *offset* (* *width* *height*))))
+ (print (string-append (number->string i) " -> "
+ (reduce string-append "" (map (lambda (x) (string-append (number->string x) ", ")) (read-color-at data i))))))
+(exit)
152 lib/camera.scm
View
@@ -0,0 +1,152 @@
+(define camera-position (vertex 0 0 0))
+(define camera-velocity (vertex 0 0 0))
+(define camera-angle (vertex 0 0 0))
+(define camera-rotation (vertex 0 0 0))
+(define camera-orbit-angle (vertex 0 0 0))
+(define camera-orbit-offset 10)
+
+(define (current-camera-position)
+ camera-position)
+
+(define (update-camera delta)
+ (set! camera-position (map (lambda (a b) (+ a b)) camera-position camera-velocity))
+ ;(stop-camera)
+ ;(camera-look-at (vertex 0 0 0))
+ (set! camera-angle (map (lambda (a b) (print (+ a b)) (if (equal? (inexact->exact (+ a b)) 0) 0 (remainder 360 (+ a b)))) camera-angle camera-rotation))
+ (print (string-append "Position: " (vertex->string camera-position)))
+ (print (string-append "Angle : " (vertex->string camera-angle)))
+ (print (string-append "Offset : " (number->string camera-orbit-offset)))
+ (stop-camera)
+ (print "------------------------------------------------------------------------------"))
+
+(define (turn-camera rotation)
+ (print "Turning camera!")
+ (print (vertex->string rotation))
+ (set! camera-rotation (map (lambda (a b) (+ a b)) camera-rotation rotation)))
+
+;; TODO: Currently 2d. Make it 3d
+(define (camera-look-at position)
+ (let* ((height (- (vertex-z position) (vertex-z camera-position)))
+ (width (- (vertex-x position) (vertex-x camera-position)))
+ (hypo (sqrt (+ (^2 height) (^2 width))))
+
+ (dummy (print (string-append (number->string (vertex-z position)) " - " (number->string (vertex-z camera-position)) " = " (number->string height))))
+ (dummy (print (string-append (number->string (vertex-x position)) " - " (number->string (vertex-x camera-position)) " = " (number->string width))))
+ (dummy (print (string-append (number->string height) "^2 + " (number->string width) "^2 = " (number->string hypo) "^2")))
+ (dummy (print (string-append "Hypo: " (number->string hypo))))
+
+ (angle (if (equal? hypo 0.0)
+ 0
+ (radians->degrees (asin (/ height hypo)))))
+ (old-angle (if (equal? 0 (vertex-y camera-angle))
+ 0
+ (vertex-y camera-angle)))
+ (turn-angle (- angle old-angle)))
+ (print (string-append "To look\n at " (vertex->string position) " \nfrom " (vertex->string camera-position) " will \nturn " (vertex->string (vertex 0 turn-angle 0)) " degrees\nfrom " (vertex->string camera-angle)))
+ (print (string-append (number->string angle) " angle, " (number->string old-angle) " old-angle"))
+ (when (not (equal? turn-angle 0))
+ (print "not 0"))
+ ;(exit))
+ (turn-camera (vertex 0 turn-angle 0))))
+
+(define (orbit-camera rotation)
+ (print "Orbiting camera!")
+ (print (vertex->string rotation))
+ (let* ((offset camera-orbit-offset)
+ (old-angle (vertex-y camera-angle))
+ (old-x (* offset (cos (degrees->radians old-angle))))
+ (old-z (* offset (sin (degrees->radians old-angle))))
+ ;---
+ (new-angle (+ old-angle (vertex-y rotation)))
+ (new-x (* offset (cos (degrees->radians new-angle))))
+ (new-z (* offset (sin (degrees->radians new-angle)))))
+
+ (print (string-append "(" (number->string old-x) ", " (number->string old-z) ")"))
+ (print (string-append "(" (number->string new-x) ", " (number->string new-z) ")"))
+
+ (print (string-append " (" (number->string old-angle) " d)"))
+ (print (string-append "- (" (number->string new-angle) " d)"))
+ (print (string-append "= (" (number->string (- new-angle old-angle)) " d)"))
+ (print (string-append "O: " (number->string (vertex-y camera-angle)) " N: " (number->string (vertex-y rotation))))
+ (print (string-append "+: " (number->string (+ (vertex-y camera-angle) (vertex-y rotation))) " -: " (number->string (- new-angle old-angle))))
+
+
+ (move-camera (vertex (- new-x old-x) 0 (- new-z old-z)))
+ (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)))
+
+(define (move-camera-forward distance)
+ (let* ((angle-y (+ 270 (vertex-y camera-angle)))
+ (move-x (* distance (cos (degrees->radians angle-y))))
+ (move-z (* distance (sin (degrees->radians angle-y))))
+ (movement (vertex move-x 0 move-z)))
+ (print (string-append "Pointing: " (vertex->string camera-angle)))
+ (print (string-append "Angle : " (number->string (degrees->radians angle-y)) " (" (number->string angle-y) "d)"))
+ (print (string-append "Moving : " (vertex->string movement)))
+ (print (string-append "Velocity: " (vertex->string (map (lambda (a b) (+ a b)) movement camera-velocity))))
+ (move-camera movement)))
+
+(define (strafe-camera distances)
+ (let ((x (vertex-x distances))
+ (y (vertex-y distances))
+ (z (vertex-z distances)))
+ (move-camera (vertex
+ (* x (cos (degrees->radians (+ 90 (vertex-y camera-angle)))))
+ 0
+ (* x ( (degrees->radians (+ 90 (vertex-y camera-angle)))))))))
+
+
+(define (stop-camera)
+ (set! camera-velocity (vertex 0 0 0))
+ (set! camera-rotation (vertex 0 0 0)))
+
+(define (reset-camera-angle)
+ (set! camera-angle (vertex 0 0 0))
+ (set! camera-rotation (vertex 0 0 0)))
+
+(define (reset-camera-position)
+ (set! camera-position (vertex 0 0 0))
+ (set! camera-velocity (vertex 0 0 0)))
+
+(define (reset-camera)
+ (reset-camera-position)
+ (reset-camera-angle))
+
+(define (camera-debug debug-function)
+ (let ((orbit-center (get-orbit-center)))
+ (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)))
+ (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)))
+ (string-append "ORBIT: " (number->string (vertex-x camera-orbit-angle)) ", " (number->string (vertex-y camera-orbit-angle)) ", " (number->string (vertex-z camera-orbit-angle)))
+ (string-append "O-CENTER: " (number->string (vertex-x orbit-center)) ", " (number->string (vertex-y orbit-center)) ", " (number->string (vertex-z orbit-center)))))))
+
+(define (get-orbit-center)
+ (let* ((distance 10.0)
+ (angle-y (+ 0 (vertex-y camera-angle)))
+ (move-x (* distance (cos (degrees->radians angle-y))))
+ (move-z (* distance (sin (degrees->radians angle-y)))))
+ (vertex-add camera-position (vertex move-x 0 move-z))))
+
+
+(define (adjust-for-camera)
+ (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))))
+
+ (gl:Rotated (vertex-x camera-angle) 1 0 0)
+ (gl:Rotated (vertex-y camera-angle) 0 1 0)
+ (gl:Rotated (vertex-z camera-angle) 0 0 1)
+ (gl:Translated (- (vertex-x camera-position)) (- (vertex-y camera-position)) (- (vertex-z camera-position))))
+
+
+(define-syntax with-camera-matrix
+ (syntax-rules () ((_ body ...)
+ (begin
+ (with-new-matrix
+ (adjust-for-camera
+ body ...
+ (gl:PopMatrix)))))))
115 lib/core.scm
View
@@ -0,0 +1,115 @@
+(require-extension lolevel)
+(require-extension gl)
+(require-extension glu)
+(require-extension glut)
+(require-extension srfi-4)
+
+;; Hooks. Load early so they can be overridden anywhere
+(define (pre-main-hook) '())
+(define (post-main-hook) '())
+(define (pre-init-hook) '())
+(define (post-init-hook) '())
+(define (pre-reshape-hook) '())
+(define (post-reshape-hook) '())
+(define (pre-render-hook) '())
+(define (post-render-hook) '())
+(define (pre-display-hook) '())
+(define (post-display-hook) '())
+
+;; General helpers
+(load "lib/exceptions.scm")
+(load "lib/math_utils.scm")
+(load "lib/list_utils.scm")
+(load "lib/binary_utils.scm")
+(load "lib/image_utils.scm")
+(load "lib/repl_utils.scm")
+
+;; Graphics/OpenGL helpers
+(load "lib/gl_utils.scm")
+(load "lib/texture_utils.scm")
+(load "lib/keyboard.scm")
+(load "lib/camera.scm")
+;;(load "lib/iso_camera.scm")
+
+;; User settings
+(load "config/settings.scm")
+
+(if *debug-mode*
+ (load "lib/gl_debug_utils.scm"))
+
+(print "All helpers loaded")
+(print "Loading custom logic...")
+
+;; User's logic
+(load "main.scm")
+(print "Scaffolding application...")
+
+(set! *start-time* (current-milliseconds))
+(set! *last-frame* (current-milliseconds))
+(set! *texture-count* 0)
+
+(define texture-handles (make-u32vector (length *texture-files*)))
+
+(define (init)
+ (gl:ShadeModel gl:SMOOTH)
+ (apply gl:ClearColor *clear-color*)
+ (gl:ClearDepth *clear-depth*)
+ (gl:Enable gl:DEPTH_TEST)
+ (gl:DepthFunc gl:LEQUAL)
+ (gl:Enable gl:BLEND)
+ (gl:BlendFunc gl:SRC_ALPHA gl:ONE_MINUS_SRC_ALPHA)
+ (gl:Hint gl:PERSPECTIVE_CORRECTION_HINT gl:NICEST)
+ (load-textures *texture-files* 'bmp))
+
+(define (display)
+ (pre-display-hook)
+ (gl:Clear (+ gl:COLOR_BUFFER_BIT gl:DEPTH_BUFFER_BIT))
+ (gl:MatrixMode gl:MODELVIEW)
+ (gl:LoadIdentity)
+ (let ((delta (- *last-frame* (current-milliseconds))))
+ (+ 1 1)
+ (game-looper delta))
+ (gl:Flush)
+ (set! *last-frame* (current-milliseconds))
+ (post-display-hook))
+
+(define (reshape width height)
+ (pre-reshape-hook)
+ (gl:Viewport 0 0 width height)
+ (gl:MatrixMode gl:PROJECTION)
+ (gl:LoadIdentity)
+ (glu:Perspective 60.0 (/ width height) 1.0 300.0)
+ (gl:MatrixMode gl:MODELVIEW)
+ (gl:LoadIdentity)
+ (post-reshape-hook))
+
+(define (render-loop delta)
+ (pre-render-hook)
+ (glut:PostRedisplay)
+ (handle-keyboard-state delta)
+ (post-render-hook)
+ (glut:TimerFunc 0 render-loop 0))
+
+(define (main)
+ (glut:InitDisplayMode (+ glut:RGBA glut:DEPTH))
+ (glut:InitWindowSize (nth *window-resolution* 0) (nth *window-resolution* 1))
+ (glut:InitWindowPosition (nth *window-position* 0) (nth *window-position* 1))
+ (glut:CreateWindow *window-title*)
+ (init)
+ (glut:DisplayFunc display)
+ (glut:ReshapeFunc reshape)
+
+ (glut:IgnoreKeyRepeat *ignore-key-repeat*)
+
+ (glut:KeyboardFunc keyboard)
+ (glut:KeyboardUpFunc keyboard-up)
+ (glut:SpecialFunc keyboard)
+ (glut:SpecialUpFunc keyboard-up)
+
+ (glut:TimerFunc 1 render-loop 0)
+
+ (pre-main-hook)
+ (glut:MainLoop)
+ (post-main-hook))
+
+(main)
3  lib/exceptions.scm
View
@@ -0,0 +1,3 @@
+(define (exception message)
+ (print message)
+ (exit 1))
18 lib/gl_debug_utils.scm
View
@@ -0,0 +1,18 @@
+(require-extension srfi-1)
+
+;; hijack old functions
+(define-syntax wrap-in-debugger
+ (lambda (form rename compare)
+ (let* ((function (car (cdr form)))
+ (function-string (symbol->string function))
+ (fname (string-append "debug-" (symbol->string function))))
+ `(begin
+ (define ,(string->symbol fname) ,function)
+ (define (,function . args)
+ (print (string-append ,function-string " (" (string-append (fold (lambda (x b) (string-append b ", " (number->string x))) "" args) ")")))
+ (apply ,(string->symbol fname) args))))))
+
+(wrap-in-debugger gl:Translated)
+(wrap-in-debugger gl:Rotated)
+(wrap-in-debugger gl:Translatef)
+(wrap-in-debugger gl:Rotatef)
242 lib/gl_utils.scm
View
@@ -0,0 +1,242 @@
+(define (with-gl type body)
+ (gl:Begin type)
+ (body)
+ (gl:End))
+
+;; (define (vertex? item)
+;; (if (and (equal? (length item) 3)
+
+(define (vertex-x vertex)
+ (nth vertex 0))
+
+(define (vertex-y vertex)
+ (nth vertex 1))
+
+(define (vertex-z vertex)
+ (nth vertex 2))
+
+(define (vertex x y z)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
+ (list x y z))
+
+(define (vertex-invert vertex)
+ (map - vertex))
+
+(define (vertex-add vertex-1 vertex-2)
+ (map (lambda (a b) (+ a b)) vertex-1 vertex-2))
+
+(define (vertex->string vertex)
+ (string-append "(" (number->string (vertex-x vertex)) ", "
+ (number->string (vertex-y vertex)) ", "
+ (number->string (vertex-z vertex)) ")"))
+
+(define (vertex-scale factor vertex)
+ (let ((value (map (lambda (x) (* factor x)) vertex)))
+ (print (string-append "Scaled! (* " (number->string factor) " " (vertex->string vertex) ") => " (vertex->string value)))
+ value))
+
+(define (color x y z)
+ (list x y z))
+
+(define (tex-coord x y)
+ (list x y))
+
+(define (triangle color1
+ vertex1
+ color2
+ vertex2
+ color3
+ vertex3)
+ (gl:Begin gl:TRIANGLES)
+ (apply gl:Color3f color1)
+ (apply gl:Vertex3f vertex1)
+ (apply gl:Color3f color2)
+ (apply gl:Vertex3f vertex2)
+ (apply gl:Color3f color3)
+ (apply gl:Vertex3f vertex3)
+ (gl:End))
+
+(define (textured-triangle texture
+ texture-coord-1
+ vertex-1
+ texture-coord-2
+ vertex-2
+ texture-coord-3
+ vertex-3)
+ (gl:BindTexture gl:TEXTURE_2D texture)
+ (gl:Enable gl:TEXTURE_2D)
+ (gl:Begin gl:TRIANGLES)
+ (apply gl:TexCoord2f texture-coord-1)
+ (apply gl:Vertex3f vertex-1)
+ (apply gl:TexCoord2f texture-coord-2)
+ (apply gl:Vertex3f vertex-2)
+ (apply gl:TexCoord2f texture-coord-3)
+ (apply gl:Vertex3f vertex-3)
+ (gl:End)
+ (gl:Disable gl:TEXTURE_2D))
+
+(define (colored-textured-triangle texture
+ color-1
+ texture-coord-1
+ vertex-1
+ color-2
+ texture-coord-2
+ vertex-2
+ color-3
+ texture-coord-3
+ vertex-3)
+ ;(print "Drawing a textured triangle")
+ (gl:BindTexture gl:TEXTURE_2D texture)
+ (gl:Enable gl:TEXTURE_2D)
+ (gl:Begin gl:TRIANGLES)
+ (apply gl:Color3f color-1)
+ (apply gl:TexCoord2f texture-coord-1)
+ (apply gl:Vertex3f vertex-1)
+ (apply gl:Color3f color-2)
+ (apply gl:TexCoord2f texture-coord-2)
+ (apply gl:Vertex3f vertex-2)
+ (apply gl:Color3f color-3)
+ (apply gl:TexCoord2f texture-coord-3)
+ (apply gl:Vertex3f vertex-3)
+ (gl:End)
+ (gl:Disable gl:TEXTURE_2D))
+
+(define (flat-triangle triangle-color
+ vertex-1
+ vertex-2
+ vertex-3)
+ (triangle (apply color triangle-color)
+ (apply vertex vertex-1)
+ (apply color triangle-color)
+ (apply vertex vertex-2)
+ (apply color triangle-color)
+ (apply vertex vertex-3)))
+
+(define (thick-triangle triangle-color
+ x y s)
+ ; front face
+ (flat-triangle (color triangle-color)
+ (vector (+ (- (/ s 2)) x) y 0)
+ (vector x (+ y s) 0)
+ (vector (+ (/ s 2) x) y 0))
+ ;undersides
+ (flat-triangle (color triangle-color)
+ (vector (+ (- (/ s 2)) x) y 0)
+ (vector (+ (- (/ s 2)) x) y 0.25)
+ (vector (+ (/ s 2) x) y 0))
+
+ (flat-triangle (color triangle-color)
+ (vector (+ (- (/ s 2)) x) y 0.25)
+ (vector (+ (/ s 2) x) y 0.25)
+ (vector (+ (/ s 2) x) y 0.0))
+
+ ;side-1
+ (flat-triangle (color triangle-color)
+ (vector (+ (- (/ s 2)) x) y 0)
+ (vector (+ (- (/ s 2)) x) y 0.25)
+ (vector x (+ y s) 0.25))
+ (flat-triangle (color triangle-color)
+ (vector (+ (- (/ s 2)) x) y 0)
+ (vector x (+ y s) 0)
+ (vector x (+ y s) 0.25))
+
+ ;side-2
+ (flat-triangle (color triangle-color)
+ (vector (+ (/ s 2) x) y 0)
+ (vector (+ (/ s 2) x) y 0.25)
+ (vector x (+ y s) 0.25))
+ (flat-triangle (color triangle-color)
+ (vector (+ (/ s 2) x) y 0)
+ (vector x (+ y s) 0)
+ (vector x (+ y s) 0.25)))
+
+(define (textured-quad texture
+ upper-left
+ upper-right
+ lower-right
+ lower-left
+ #!optional
+ repeat-x
+ repeat-y
+ flip-texture)
+ (let* ((rx (if repeat-x repeat-x 1))
+ (ry (if repeat-y repeat-y 1))
+ (fh (if (and flip-texture (or (equal? 'flip flip-texture)
+ (equal? 'flip-horizontal flip-texture))) -1 1))
+ (fv (if (and flip-texture (or (equal? 'flip flip-texture)
+ (equal? 'flip-vertical flip-texture))) -1 1))
+ (texture-lower-left (tex-coord 0 0))
+ (texture-upper-left (tex-coord 0 (* 1 ry fv)))
+ (texture-upper-right (tex-coord (* 1 rx fh) (* 1 ry fv)))
+ (texture-lower-right (tex-coord (* 1 rx fh) 0)))
+
+
+ (textured-triangle texture
+ texture-lower-left
+ lower-left
+ texture-upper-left
+ upper-left
+ texture-lower-right
+ lower-right)
+
+ (textured-triangle texture
+ texture-upper-left
+ upper-left
+ texture-upper-right
+ upper-right
+ texture-lower-right
+ lower-right)))
+
+
+;; Matrix utils
+(define-syntax with-new-matrix
+ (syntax-rules () ((_ body ...)
+ (begin
+ (gl:PushMatrix)
+ body ...
+ (gl:PopMatrix)))))
+
+(define (bottomless-cube top-texture
+ side-texture
+ position
+ scale
+ #!optional flip-texture)
+ (set! *cube-debugger* (/ (- (current-milliseconds) *start-time*) 100000))
+
+ (with-new-matrix
+ (gl:Translated (vertex-x position) (vertex-y position) (vertex-z position))
+ (textured-quad top-texture
+ (vertex 0 1 1)
+ (vertex 1 1 1)
+ (vertex 1 1 0)
+ (vertex 0 1 0)
+ 1 1 flip-texture)
+
+ ; sides
+ ;; back
+ (textured-quad side-texture
+ (vertex 0 1 1)
+ (vertex 1 1 1)
+ (vertex 1 0 1)
+ (vertex 0 0 1))
+
+ ;; front
+ (textured-quad side-texture
+ (vertex 0 1 0)
+ (vertex 1 1 0)
+ (vertex 1 0 0)
+ (vertex 0 0 0))
+
+ ;; left
+ (textured-quad side-texture
+ (vertex 0 1 0)
+ (vertex 0 1 1)
+ (vertex 0 0 1)
+ (vertex 0 0 0))
+
+ ;; right
+ (textured-quad side-texture
+ (vertex 1 1 0)
+ (vertex 1 1 1)
+ (vertex 1 0 1)
+ (vertex 1 0 0))))
+
140 lib/image_utils.scm
View
@@ -0,0 +1,140 @@
+;; Depends on list_utils for (sublist nth)
+(define (read-color-at lst index)
+ (sublist lst index 4))
+
+(define (bmp-load file)
+ (if (file-exists? file)
+ (with-input-from-file file read-binary-file)
+ (exception (string-append "File: <" file "> not found"))))
+
+(define (bmp-data-offset data)
+ (nth data 10))
+
+(define (bmp-header data)
+ (print "File data:")
+ (print data)
+ (sublist data 0 (bmp-data-offset data)))
+
+(define (bmp-width data)
+ (nth data 18))
+
+(define (bmp-height data)
+ (nth data 18))
+
+(define (bmp-data data)
+ (sublist data (bmp-data-offset data) (length data)))
+
+(define (bmp-bit-depth data)
+ (nth data 28))
+
+(define (bmp-bits-per-pixel data)
+ (/ (bmp-bit-depth data) 8))
+
+; assumes vector type
+(define (bmp-read-red-byte bytes)
+ (vector-ref byte 0))
+
+(define (bmp-read-green-byte bytes)
+ (vector-ref byte 1))
+
+(define (bmp-read-blue-byte bytes)
+ (vector-ref byte 2))
+
+(define (bmp-read-alpha-byte bytes)
+ (vector-ref byte 3))
+
+(define (load-bmp-texture file)
+ (let* ((bmp (bmp-load file))
+ (header (bmp-header bmp))
+ (body (list->vector (bmp-data bmp)))
+ (width (bmp-width bmp))
+ (height (bmp-height bmp))
+ (bit-depth (bmp-bit-depth bmp))
+ (bpp (bmp-bits-per-pixel bmp))
+ (buffer-length (* bpp width height))
+ (buffer (make-u8vector buffer-length 0))
+ (counter 0))
+ ;; (print (string-append "File-length: " (number->string (length bmp))))
+ ;; (print (string-append "BPP: " (number->string bit-depth)))
+ ;; (print (string-append "body-length: " (number->string (vector-length body))))
+ ;; (print (string-append "buffered: " (number->string buffer-length)))
+ ;; (print (string-append "WxH: " (number->string width) "x" (number->string height)))
+ ;; (print (string-append "Offset: " (number->string (bmp-data-offset bmp))))
+ ;(print (string-append "Header: " (list->string header)))
+ (do ((row 0 (+ row 1))) ((> row (- height 1)) buffer)
+ (print (string-append "New Row: " (number->string row)))
+ (do ((column 3 (+ column bpp))) ((> column (* width bpp)))
+ (print (string-append "--- (" (number->string row) ", " (number->string column) ") ---"))
+ (let* ((position (+ (* row width bpp) column))
+ (red (vector-ref body (- position 3)))
+ (green (vector-ref body (- position 2)))
+ (blue (vector-ref body (- position 1))))
+
+ (print (string-append (number->string counter) "-" (number->string position)))
+ (u8vector-set! buffer (+ counter 0) red)
+ (u8vector-set! buffer (+ counter 1) green)
+ (u8vector-set! buffer (+ counter 2) blue)
+
+ (if (equal? bpp 4)
+ ;fun test for transparency
+ (if (and (equal? red 0) (equal? green 0) (equal? blue 0))
+ (u8vector-set! buffer (+ counter 3) 0)
+ (u8vector-set! buffer (+ counter 3) (vector-ref body (- position 0)))))
+
+ (u8vector-set! buffer counter (vector-ref body counter))
+ ;(print (string-append (number->string counter) ". [O->N] [" (number->string (vector-ref body counter)) " -> " (number->string (u8vector-ref buffer counter)) "]"))
+ (set! counter (+ counter bpp)))))
+ buffer))
+ ;(flip-bmp-vertically (* width 4) buffer)))
+
+(define (load-textures filenames type)
+ (if (equal? type 'bmp)
+ (begin
+ (print (gl:GenTextures (length filenames) texture-handles))
+ (for-each (lambda (file) (load-texture file *texture-count*) (add1 *texture-count*)) filenames))))
+
+; works on u8vectors
+; TODO: Iron out the alignment bugs
+(define (flip-bmp-vertically row-width data)
+ (let* ((data-size (u8vector-length data))
+ (buffer (make-u8vector data-size 0))
+ (height (/ data-size row-width))
+ (counter 0))
+ ;; (print (string-append (number->string height) " rows tall"))
+ (do ((row (- height 1) (- row 1))) ((equal? row -1) buffer)
+ (do ((column 0 (+ column 4))) ((equal? column row-width))
+ (let ((position (+ (* row row-width) column)))
+ ; beware rgb in bmp. Seems more like bgr. Fuckers. Hence the weird offsets
+ (u8vector-set! buffer (+ counter 0) (u8vector-ref data (+ position 0)))
+ (u8vector-set! buffer (+ counter 1) (u8vector-ref data (+ position 1)))
+ (u8vector-set! buffer (+ counter 2) (u8vector-ref data (+ position 2)))
+ (u8vector-set! buffer (+ counter 3) (u8vector-ref data (+ position 3))))
+
+ ;; (print (string-append (number->string (+ (* row row-width) column)) " -> " (number->string counter))))
+ (set! counter (+ counter 4))))))
+
+; works on u8vectors
+; TODO: Iron out the alignment bugs
+(define (flip-bmp-horizontally row-width data)
+ (let* ((data-size (u8vector-length data))
+ (buffer (make-u8vector data-size 255))
+ (height (/ data-size row-width))
+ (counter 0))
+ ;(print (string-append (number->string height) " rows tall"))
+ (do ((row 0 (+ row 1))) ((equal? row height))
+ (do ((column 1 (+ column 4))) ((> column row-width))
+ (let ((position (+ (* row row-width) (- row-width column))))
+ ; beware rgb in bmp. Seems more like bgr. Fuckers. Hence the weird offsets
+ (u8vector-set! buffer (+ counter 0) (u8vector-ref data (- position 1)))
+ (u8vector-set! buffer (+ counter 1) (u8vector-ref data (- position 2)))
+ (u8vector-set! buffer (+ counter 2) (u8vector-ref data (- position 3)))
+ (u8vector-set! buffer (+ counter 3) (u8vector-ref data (- position 0)))
+
+ ;; (print (string-append (number->string (+ counter 0)) " = " (number->string (u8vector-ref data (- position 3))) ", Actual: [" (number->string (u8vector-ref buffer (+ counter 0)))))
+ ;; (print (string-append (number->string (+ counter 1)) " = " (number->string (u8vector-ref data (- position 2))) ", Actual: [" (number->string (u8vector-ref buffer (+ counter 1)))))
+ ;; (print (string-append (number->string (+ counter 2)) " = " (number->string (u8vector-ref data (- position 1))) ", Actual: [" (number->string (u8vector-ref buffer (+ counter 2)))))
+ ;; (print (string-append (number->string (+ counter 3)) " = " (number->string (u8vector-ref data (- position 0))) ", Actual: [" (number->string (u8vector-ref buffer (+ counter 3)))))
+ )
+ (set! counter (+ counter 4))))
+ buffer))
+
9 lib/iso_camera.scm
View
@@ -0,0 +1,9 @@
+;; Depends on original camera system
+(define (iso-turn-camera rotation)
+ (print "Turning camera!")
+ (print (vertex->string rotation))
+ (set! camera-rotation (map (lambda (a b) (+ a (* 90 b))) camera-rotation rotation)))
+
+(define (iso-move-camera delta)
+ (set! camera-velocity (map (lambda (a b) (+ a b)) camera-velocity delta)))
+
28 lib/keyboard.scm
View
@@ -0,0 +1,28 @@
+(require-extension srfi-1)
+
+; TODO: Keeping this sorted may be a good idea for performance
+(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))
+
+(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 (keyboard key x y)
+ (kb:add-key key))
+
+(define (keyboard-up key x y)
+ (kb:remove-key key))
+
23 lib/list_utils.scm
View
@@ -0,0 +1,23 @@
+(define (first lst)
+ (car lst))
+
+(define (rest lst)
+ (cdr lst))
+
+(define (reduce fn base-value lst)
+ (if (null? lst)
+ base-value
+ (fn (car lst)
+ (reduce fn base-value (cdr lst)))))
+
+(define (nth lst index)
+ (if (equal? 0 index)
+ (car lst)
+ (nth (cdr lst) (- index 1))))
+
+(define (sublist lst start finish)
+ (if (< start 1)
+ (if (< finish 1)
+ '()
+ (cons (car lst) (sublist (cdr lst) 0 (- finish 1))))
+ (sublist (cdr lst) (- start 1) (- finish 1))))
10 lib/math_utils.scm
View
@@ -0,0 +1,10 @@
+(define PI 3.14159265)
+
+(define (degrees->radians degrees)
+ (/ (* degrees PI) 180))
+
+(define (radians->degrees degrees)
+ (/ (* degrees 180) PI))
+
+(define (^2 b)
+ (* b b))
5 lib/repl_utils.scm
View
@@ -0,0 +1,5 @@
+(define return)
+(define (returnable-repl)
+ (call/cc (lambda (k)
+ (set! return (lambda () (k #f)))
+ (repl))))
48 lib/texture_utils.scm
View
@@ -0,0 +1,48 @@
+(define (load-texture filename position)
+ (let* ((dummy (bmp-load filename))
+ (dummy2 (print "here1"))
+ (dummy2 (print dummy))
+ (t-meta (bmp-header (bmp-load filename)))
+ (dummy (print "here"))
+ (width (bmp-width t-meta))
+ (bpp (bmp-bits-per-pixel t-meta))
+ (height (bmp-height t-meta))
+ (format (if (equal? bpp 4)
+ gl:RGBA
+ gl:RGB))
+ ;(t (load-bmp-texture filename)))
+ ;(t (flip-bmp-vertically (* width bpp) (load-bmp-texture filename))))
+ ;(t (flip-bmp-horizontally (* width bpp) (load-bmp-texture filename))))
+ (t (flip-bmp-vertically (* width bpp) (flip-bmp-horizontally (* width bpp) (load-bmp-texture filename)))))
+ (print "---------------------------------------------------------------------------")
+ (print (string-append "Setting " filename " to texture: " (number->string position)))
+ ;; (print t)
+ (print (string-append (number->string width) "x" (number->string height) " pixels"))
+ (gl:BindTexture gl:TEXTURE_2D (u32vector-ref texture-handles position))
+ (gl:PixelStorei gl:UNPACK_ALIGNMENT 1)
+ (gl:PixelStorei gl:UNPACK_ROW_LENGTH 0)
+ (gl:PixelStorei gl:UNPACK_SKIP_PIXELS 0)
+ (gl:PixelStorei gl:UNPACK_SKIP_ROWS 0)
+ (gl:TexImage2D gl:TEXTURE_2D 0 format width height
+ 0 format gl:UNSIGNED_BYTE (make-locative (u8vector->blob t)))
+ (gl:TexParameteri gl:TEXTURE_2D gl:TEXTURE_MAG_FILTER gl:LINEAR)
+ (gl:TexParameteri gl:TEXTURE_2D gl:TEXTURE_MIN_FILTER gl:LINEAR)
+ (gl:TexParameteri gl:TEXTURE_2D gl:TEXTURE_WRAP_S gl:REPEAT)
+ (gl:TexParameteri gl:TEXTURE_2D gl:TEXTURE_WRAP_T gl:REPEAT)
+ (set! *texture-count* (+ *texture-count* 1))))
+
+(define (make-check-image)
+ (let* ((check-image-height 64)
+ (check-image-width 64)
+ (buffer-size (* check-image-width check-image-height 3))
+ (buffer (make-u8vector (* check-image-width check-image-height 3) 0))
+ (dummy 255)
+ (counter 0))
+ (do ((i 0 (+ i 1))) ((> i (- check-image-height 1)) buffer)
+ (do ((j 0 (+ j 1))) ((> j (- check-image-width 1)))
+ (let ((c (if (> (remainder i 10) 3) 255 0)))
+ (u8vector-set! buffer (+ counter 0) c)
+ (u8vector-set! buffer (+ counter 1) counter)
+ (u8vector-set! buffer (+ counter 2) c)
+ ;(u8vector-set! buffer (+ counter 3) 0)
+ (set! counter (+ 3 counter)))))))
291 main.scm
View
@@ -0,0 +1,291 @@
+(define (pre-main-hook)
+ (move-camera (vertex 5 10 5))
+ ;(turn-camera (vertex 45 225 0))
+ )
+
+
+(define (game-looper delta)
+ ;(print "Do something here!")
+ ;(print delta)
+ (let* ((total-time (- (current-milliseconds) *start-time*))
+ (seconds (/ (inexact->exact (truncate total-time)) 1000))
+ (current-texture (inexact->exact (truncate (remainder seconds 2)))))
+ ;(print seconds)
+ ;(print current-texture)
+ ;(print delta)
+ ;(move-camera-forward (- 0.1))
+ (update-camera delta)
+ (adjust-for-camera)
+ ;(camera-debug print)
+
+ ;; (do ((x -20.0 (+ x 1))) ((> x 20))
+ ;; (do ((z -2.0 (+ z 1))) ((> z 2))
+ ;; (with-new-matrix
+ ;; (textured-quad (u32vector-ref texture-handles 2)
+ ;; (vertex x -0.5 z)
+ ;; (vertex (+ x 1) -0.5 z)
+ ;; (vertex (+ x 1) -0.5 (- z 1))
+ ;; (vertex x -0.5 (- z 1))))))
+
+ (draw-floor)
+ (draw-trees)
+ (draw-custom-characters)
+
+ (with-new-matrix
+ (flat-triangle (color 0.25 0.5 0.75)
+ (vertex -1 1 -2)
+ (vertex 1 1 -2)
+ (vertex 1 0 -2)))))
+
+
+
+
+(define tree-count 10)
+(define tree-texture-handle 3)
+
+(define tree-positions
+ (let* ((positions (make-vector tree-count)))
+ ;; (do ((tree 0 (+ 1 tree))) ((equal? tree tree-count))
+ ;; (vector-set! positions tree (vertex (/ (- (random 1000) 500) 100)
+ ;; 0
+ ;; (/ (- (random 1000) 500) 100))))
+ (vector-set! positions 0 (vertex -10 0 1))
+ (vector-set! positions 1 (vertex -10 0 2))
+ (vector-set! positions 2 (vertex -10 0 3))
+ (vector-set! positions 3 (vertex -10 0 4))
+ (vector-set! positions 4 (vertex -10 0 5))
+ (vector-set! positions 5 (vertex 10 0 6))
+ (vector-set! positions 6 (vertex 10 0 7))
+ (vector-set! positions 7 (vertex 10 0 8))
+ (vector-set! positions 8 (vertex 10 0 9))
+ (vector-set! positions 9 (vertex 10 0 10))
+ positions))
+
+(define tree-heights
+ (let* ((heights (make-vector tree-count)))
+ (do ((tree 0 (+ 1 tree))) ((equal? tree tree-count))
+ (vector-set! heights tree (+ (/ (random 8) 2) 2)))
+ heights))
+
+(define tree-rotations
+ (let* ((rotations (make-vector tree-count)))
+ (do ((tree 0 (+ 1 tree))) ((equal? tree tree-count))
+ ;(vector-set! rotations tree (/ (- (random 1080) 720) 2)))
+ (vector-set! rotations tree 0))
+ rotations))
+
+(define (draw-tree n)
+ (let ((position (vector-ref tree-positions n))
+ (rotation (vector-ref tree-rotations n))
+ (height (vector-ref tree-heights n)))
+ ;(print (vertex->string position))
+ (with-new-matrix
+ (gl:Rotatef rotation 0 1 0)
+ (gl:Translatef (vertex-x position) (vertex-y position) (vertex-z position))
+ (textured-quad (u32vector-ref texture-handles tree-texture-handle)
+ (vertex 0 height 0)
+ (vertex 1 height 0)
+ (vertex 1 0 0)
+ (vertex 0 0 0)))))
+
+(define (draw-trees)
+ (do ((counter 0 (+ counter 1))) ((equal? counter tree-count))
+ (draw-tree counter)))
+
+;; ----- Characters -----
+
+(define character-count 20)
+(define character-texture-handle 0)
+
+(define character-positions
+ (let* ((positions (make-vector character-count)))
+ (do ((character 0 (+ 1 character))) ((equal? character character-count))
+ ;;(vector-set! positions character (vertex 0 -5 0)))
+ (vector-set! positions character (vertex (/ (- (random 1000) 500) 1000)
+ -0
+ (/ (- (random 1000) 500) 1000))))
+ positions))
+
+(define character-velocities
+ (let* ((velocities (make-vector character-count)))
+ (do ((character 0 (+ 1 character))) ((equal? character character-count)))
+ velocities))
+
+(define (update-character-positions)
+ (do ((character 0 (+ 1 character))) ((equal? character character-count))
+ (vector-set! character-positions character
+ (vertex-add (vector-ref character-positions character) (vector-ref character-velocities character)))
+ (vector-set! character-velocities character (vertex 0 0 0))))
+
+(define character-rotations
+ (let* ((rotations (make-vector character-count)))
+ (do ((character 0 (+ 1 character))) ((equal? character character-count))
+ (vector-set! rotations character (/ (- (random 1080) 720) 2)))
+ rotations))
+
+(define (characters-wander)
+ (do ((character 0 (+ 1 character))) ((equal? character character-count))
+ (vector-set! character-velocities character
+ (vertex (/ (- (random 1) 1) 10) 0 (/ (- (random 1) 1) 10)))))
+
+(define (draw-custom-characters)
+ (draw-character (vertex -10.0 1 5.0) 90 1)
+ (draw-character (vertex -9.0 1 5.0) 90 1)
+ (draw-character (vertex -8.0 1 5.0) 90 1)
+ (draw-character (vertex -7.0 1 5.0) 90 1)
+ (draw-character (vertex -6.0 1 5.0) 90 1)
+ (draw-character (vertex -5.0 1 5.0) 90 1)
+
+ (draw-character (vertex -10.0 1 4.0) 90 1)
+ (draw-character (vertex -9.0 1 4.0) 90 1)
+ (draw-character (vertex -8.0 1 4.0) 90 1)
+ (draw-character (vertex -7.0 1 4.0) 90 1)
+ (draw-character (vertex -6.0 1 4.0) 90 1)
+ (draw-character (vertex -5.0 1 4.0) 90 1)
+
+ (draw-character (vertex -10.0 1 6.0) 90 1)
+ (draw-character (vertex -9.0 1 6.0) 90 1)
+ (draw-character (vertex -8.0 1 6.0) 90 1)
+ (draw-character (vertex -7.0 1 6.0) 90 1)
+ (draw-character (vertex -6.0 1 6.0) 90 1)
+ (draw-character (vertex -5.0 1 6.0) 90 1)
+
+ (draw-character (vertex -10.0 1 7.0) 90 1)
+ (draw-character (vertex -9.0 1 7.0) 90 1)
+ (draw-character (vertex -8.0 1 7.0) 90 1)
+ (draw-character (vertex -7.0 1 7.0) 90 1)
+ (draw-character (vertex -6.0 1 7.0) 90 1)
+ (draw-character (vertex -5.0 1 7.0) 90 1)
+
+ ; v's
+ (draw-character (vertex -10.0 1 -1.0) 90 1)
+ (draw-character (vertex -9.0 1 -2.0) 90 1)
+ (draw-character (vertex -8.0 1 -3.0) 90 1)
+ (draw-character (vertex -7.0 1 -4.0) 90 1)
+ (draw-character (vertex -6.0 1 -3.0) 90 1)
+ (draw-character (vertex -5.0 1 -2.0) 90 1)
+ (draw-character (vertex -4.0 1 -1.0) 90 1)
+
+ (draw-character (vertex -7.0 1 -5.0) 90 1)
+ (draw-character (vertex -6.0 1 -4.0) 90 1)
+ (draw-character (vertex -5.0 1 -3.0) 90 1)
+ (draw-character (vertex -4.0 1 -2.0) 90 1)
+ (draw-character (vertex -3.0 1 -3.0) 90 1)
+ (draw-character (vertex -2.0 1 -4.0) 90 1)
+ (draw-character (vertex -1.0 1 -5.0) 90 1)
+)
+
+(define (draw-character position
+ rotation
+ scale)
+ (let ((texture-number (remainder (- (current-milliseconds) *start-time*) 2)))
+ (with-new-matrix
+ (gl:Rotatef rotation 0 1 0)
+ (gl:Translatef (vertex-x position) (vertex-y position) (vertex-z position))
+ (textured-quad (u32vector-ref texture-handles texture-number)
+ (vertex 0 1 0)
+ (vertex 1 1 0)
+ (vertex 1 0 0)
+ (vertex 0 0 0)))))
+
+(define (draw-character-from-array n)
+ (characters-wander)
+ (update-character-positions)
+ (let ((position (vector-ref character-positions n))
+ (rotation (vector-ref character-rotations n)))
+ ;(print (vertex->string position))
+ (with-new-matrix
+ ;(gl:Rotatef rotation 0 1 0)
+ (gl:Translatef (vertex-x position) (vertex-y position) (vertex-z position))
+ (textured-quad (u32vector-ref texture-handles character-texture-handle)
+ (vertex 0 1 0)
+ (vertex 1 1 0)
+ (vertex 1 0 0)
+ (vertex 0 0 0)))))
+
+(define (draw-characters)
+ (do ((counter 0 (+ counter 1))) ((equal? counter character-count))
+ (draw-character-from-array counter)))
+
+
+;; floor
+
+(define (draw-floor)
+ (let ((grass-texture (u32vector-ref texture-handles 5))
+ (water-texture (u32vector-ref texture-handles 6))
+ (grass-water-transition-texture (u32vector-ref texture-handles 7))
+ (grid-texture (u32vector-ref texture-handles 2))
+ (base -5))
+
+ ; river
+ (do ((x 0 (+ x 1))) ((> x 2))
+ (do ((z 0 (+ z 1))) ((> z 10))
+ (bottomless-cube water-texture
+ water-texture
+ (vertex x 0 z)
+ 1)))
+
+ ; land
+ (do ((x 4 (+ x 1))) ((> x 10))
+ (do ((z 0 (+ z 1))) ((> z 10))
+ (bottomless-cube grass-texture
+ grass-texture
+ (vertex x 0 z)
+ 1)))
+
+ (do ((z 0 (+ z 1))) ((> z 10))
+ (bottomless-cube grass-water-transition-texture
+ grid-texture
+ (vertex 3 0 z)
+ 1))
+
+ (do ((z 0 (+ z 1))) ((> z 10))
+ (bottomless-cube grass-water-transition-texture
+ grid-texture
+ (vertex -1 0 z)
+ 1
+ 'flip-horizontal))
+
+ (do ((x -10 (+ x 1))) ((equal? x -1))
+ (do ((z 0 (+ z 1))) ((> z 10))
+ (bottomless-cube grass-texture
+ grass-texture
+ (vertex x 0 z)
+ 1)))))
+
+
+(define (handle-keyboard-state delta)
+ (let* ((delta (+ (- (current-milliseconds) *last-frame*) 1))
+ (turn-sensitivity (* 1.0 delta))
+ (move-sensitivity (* 0.01 delta))
+ (walk-length (* 5 delta)))
+ ;(print delta)
+ (if (kb:key-pressed? glut:KEY_LEFT) (turn-camera (vertex 0 (- turn-sensitivity) 0)))
+ (if (kb:key-pressed? glut:KEY_RIGHT) (turn-camera (vertex 0 turn-sensitivity 0)))
+ (if (kb:key-pressed? glut:KEY_UP) (move-camera-forward walk-length))
+ (if (kb:key-pressed? glut:KEY_DOWN) (move-camera-forward (- walk-length)))
+
+ ;; (if (kb:key-pressed? glut:KEY_LEFT) (iso-move-camera (vertex 1 0 0)))
+ ;; (if (kb:key-pressed? glut:KEY_RIGHT) (iso-move-camera (vertex -1 0 0)))
+ ;; (if (kb:key-pressed? glut:KEY_UP) (iso-move-camera (vertex 0 0 1)))
+ ;; (if (kb:key-pressed? glut:KEY_DOWN) (iso-move-camera (vertex 0 0 -1)))
+
+ ;; (if (kb:key-pressed? #\q) (iso-turn-camera (vertex 0 1 0)))
+ ;; (if (kb:key-pressed? #\e) (iso-turn-camera (vertex 0 -1 0)))
+
+ (if (kb:key-pressed? #\a) (strafe-camera (vertex walk-length 0 0)))
+ (if (kb:key-pressed? #\d) (strafe-camera (vertex (- walk-length) 0 0)))
+ (if (kb:key-pressed? #\a) (strafe-camera (vertex walk-length 0 0)))
+ (if (kb:key-pressed? #\d) (strafe-camera (vertex (- walk-length) 0 0)))
+ (if (kb:key-pressed? #\w) (strafe-camera (vertex 0 walk-length 0)))
+ (if (kb:key-pressed? #\s) (strafe-camera (vertex 0 (- walk-length) 0)))
+ (if (kb:key-pressed? #\z) (move-camera (vertex 0 walk-length 0)))
+ (if (kb:key-pressed? #\x) (move-camera (vertex 0 (- walk-length) 0)))
+
+ (if (kb:key-pressed? #\r) (turn-camera (vertex 0 (- turn-sensitivity) 0)))
+ (if (kb:key-pressed? #\f) (turn-camera (vertex 0 turn-sensitivity 0)))
+
+ (if (kb:key-pressed? #\q) (orbit-camera (vertex 0 10 0)))
+ (if (kb:key-pressed? #\e) (orbit-camera (vertex 0 -10 0)))
+
+ (if (kb:key-pressed? #\space) (returnable-repl))))
15 misc/macro.scm
View
@@ -0,0 +1,15 @@
+(define-syntax ez-debug (syntax-rules () ((_ var) (print 'var ": "
+ var))))
+
+(define-syntax with-gl
+ (lambda (exp rename compare)
+ (let ((body (cdr exp)))
+ (print "1")
+ `(print ,@body)
+ (print "2"))))
+
+(with-gl
+ (print "body!"))
+
+(print "finish")
+(exit)
12 misc/make_checker.scm
View
@@ -0,0 +1,12 @@
+(define (make-check-image)
+ (let* ((check-image-height 64)
+ (check-image-width 64)
+ (buffer (make-u8vector (* check-image-width check-image-height 4) 0)))
+ (do ((i 0 (+ i 1))) ((> i check-image-height) buffer)
+ (do ((j 0 (+ j 1))) ((> j check-image-width))
+ (let ((c (if (or (equal? i 0) (equal? (remainder 64 i) 0)) 255 0)))
+ (print c)
+ (u8vector-set! buffer (+ (* i j) 0) c)
+ (u8vector-set! buffer (+ (* i j) 1) c)
+ (u8vector-set! buffer (+ (* i j) 1) c)
+ (u8vector-set! buffer (+ (* i j) 3) 255))))))
0  resources/.add_resources_here
View
No changes.
17 tests/camera.scm
View
@@ -0,0 +1,17 @@
+(require-extension test)
+(load "lib/gl_utils.scm")
+(load "lib/camera.scm")
+
+(test "Default camera velocity" (vertex 0 0 0) (current-camera-position))
+(test "Default camera position" camera-position (current-camera-position))
+(test "Default camera velocity" (vertex 0 0 0) (current-camera-position))
+(test "Default camera position" camera-position (current-camera-position))
+
+;; (test "Default camera angle" camera-position (vertex 0 0 0))
+;; (test "Default camera " camera-position (vertex 0 0 0))
+;; (test "Default camera position" camera-position (vertex 0 0 0))
+;; (test "Default camera position" camera-position (vertex 0 0 0))
+
+
+
+(exit)
1  tests/keyboard_test.scm
View
@@ -0,0 +1 @@
+(load "keyboard.scm")
28 tests/test.scm
View
@@ -0,0 +1,28 @@
+(require-extension lolevel)
+(require-extension gl)
+(require-extension glu)
+(require-extension glut)
+(require-extension srfi-4)
+
+(load "list_utils.scm")
+(load "binary_utils.scm")
+(load "image_utils.scm")
+(print "Ok, good to go. Enjoy")
+
+(define (make-check-image)
+ (let* ((check-image-height 64)
+ (check-image-width 64)
+ (buffer-size (* check-image-width check-image-height 4))
+ (buffer (make-u8vector (* check-image-width check-image-height 4) 0))
+ (dummy 255)
+ (counter 0))
+ (do ((i 0 (+ i 1))) ((> i (- check-image-height 1)) buffer)
+ (do ((j 0 (+ j 1))) ((> j (- check-image-width 1)))
+ (let ((c (if (or (equal? i 0) (equal? (remainder 64 i) 0)) 255 0)))
+ (u8vector-set! buffer (+ counter 0) dummy)
+ (u8vector-set! buffer (+ counter 1) dummy)
+ (u8vector-set! buffer (+ counter 2) dummy)
+ (u8vector-set! buffer (+ counter 3) 255)
+ (set! counter (+ 4 counter)))))))
+
+(print (make-check-image))
171 tests/texture-test.scm
View
@@ -0,0 +1,171 @@
+(require-extension lolevel)
+(require-extension gl)
+(require-extension glu)
+(require-extension glut)
+(require-extension srfi-4)
+
+(set! *cube-debugger* 1)
+
+(load "math_utils.scm")
+(load "list_utils.scm")
+(load "binary_utils.scm")
+(load "image_utils.scm")
+(load "gl_utils.scm")
+(load "texture_utils.scm")
+
+(load "repl_utils.scm")
+;(load "gl_debug_utils.scm")
+
+(load "keyboard.scm")
+(load "camera.scm")
+(load "iso_camera.scm")
+
+(load "game.scm")
+
+(set! *start-time* (current-milliseconds))
+(set! *last-frame* (current-milliseconds))
+(set! *texture-count* 0)
+(set! *texture-files* '("rpg-char-4.bmp" "rpg-char-4-2.bmp" "grid.bmp" "tree.bmp" "corner_test.bmp" "grass.bmp"))
+;(set! *texture-files* '("rpg-char-4.bmp" "rpg-char-4-2.bmp" "grid.bmp" "tree.bmp" "corner_test.bmp"))
+;(set! *texture-files* '("corner_test.bmp" "corner_test.bmp" "corner_test.bmp" "corner_test.bmp" "corner_test.bmp"))
+
+(define texture-handles (make-u32vector (length *texture-files*)))
+
+;; (define (draw-floor new-matrix?)
+;; (if new-matrix? (gl:PushMatrix))
+;; (textured-quad (u32vector-ref texture-handles 5)
+;; (vertex -100 -5 100)
+;; (vertex 100 -5 100)
+;; (vertex 100 -5 -100)
+;; (vertex -100 -5 -100)
+;; 25 25)
+;; (if new-matrix? (gl:PopMatrix)))
+
+(define (textured-triangle-example delta)
+ (let* ((total-time (- (current-milliseconds) *start-time*))
+ (seconds (/ (inexact->exact (truncate total-time)) 1000))
+ (current-texture (inexact->exact (truncate (remainder seconds 2)))))
+ ;(print seconds)
+ ;(print current-texture)
+ ;(print delta)
+ ;(move-camera-forward (- 0.1))
+ (update-camera delta)
+ (adjust-for-camera)
+ ;(camera-debug print)
+
+ ;; (do ((x -20.0 (+ x 1))) ((> x 20))
+ ;; (do ((z -2.0 (+ z 1))) ((> z 2))
+ ;; (with-new-matrix
+ ;; (textured-quad (u32vector-ref texture-handles 2)
+ ;; (vertex x -0.5 z)
+ ;; (vertex (+ x 1) -0.5 z)
+ ;; (vertex (+ x 1) -0.5 (- z 1))
+ ;; (vertex x -0.5 (- z 1))))))
+
+ (draw-floor)
+
+ (with-new-matrix
+
+ (flat-triangle (color 0.25 0.5 0.75)
+ (vertex -1 1 -2)
+ (vertex 1 1 -2)
+ (vertex 1 0 -2)))
+))
+ ;; (draw-trees)
+ ;; (draw-characters)))
+
+
+
+(define (init)
+ (gl:ShadeModel gl:SMOOTH)
+ (gl:ClearColor 1.0 1.0 1.0 0.0)
+ (gl:ClearDepth 1.0)
+ (gl:Enable gl:DEPTH_TEST)
+ (gl:DepthFunc gl:LEQUAL)
+ ;(gl:Enable gl:BLEND)
+ ;(gl:BlendFunc gl:SRC_ALPHA gl:ONE_MINUS_SRC_ALPHA)
+ (gl:Hint gl:PERSPECTIVE_CORRECTION_HINT gl:NICEST)
+ (load-textures *texture-files* 'bmp))
+
+(define (display)
+ (gl:Clear (+ gl:COLOR_BUFFER_BIT gl:DEPTH_BUFFER_BIT))
+ (gl:MatrixMode gl:MODELVIEW)
+ (gl:LoadIdentity)
+ (let ((delta (/ (- *last-frame* (current-milliseconds)) 100)))
+ (textured-triangle-example (/ delta 4))
+ (gl:Flush))
+ (set! *last-frame* (current-milliseconds)))
+
+(define (reshape width height)
+ (gl:Viewport 0 0 width height)
+ (gl:MatrixMode gl:PROJECTION)
+ (gl:LoadIdentity)
+ (glu:Perspective 60.0 (/ width height) 1.0 300.0)
+ (gl:MatrixMode gl:MODELVIEW)
+ (gl:LoadIdentity))
+
+(define (act-on-keyboard-state delta-loop)
+ (let* ((delta (+ (- (current-milliseconds) *last-frame*) 1))
+ (turn-sensitivity (* 1.0 delta))
+ (move-sensitivity (* 0.01 delta))
+ (walk-length (* 0.5 delta)))
+ (print delta)
+ ;; (if (kb:key-pressed? glut:KEY_LEFT) (turn-camera (vertex (- turn-sensitivity) 0 0)))
+ ;; (if (kb:key-pressed? glut:KEY_RIGHT) (turn-camera (vertex turn-sensitivity 0 0)))
+ ;; (if (kb:key-pressed? glut:KEY_UP) (move-camera-forward walk-length))
+ ;; (if (kb:key-pressed? glut:KEY_DOWN) (move-camera-forward (- walk-length)))
+
+ (if (kb:key-pressed? glut:KEY_LEFT) (iso-move-camera (vertex 1 0 0)))
+ (if (kb:key-pressed? glut:KEY_RIGHT) (iso-move-camera (vertex -1 0 0)))
+ (if (kb:key-pressed? glut:KEY_UP) (iso-move-camera (vertex 0 0 1)))
+ (if (kb:key-pressed? glut:KEY_DOWN) (iso-move-camera (vertex 0 0 -1)))
+
+ (if (kb:key-pressed? #\q) (iso-turn-camera (vertex 0 1 0)))
+ (if (kb:key-pressed? #\e) (iso-turn-camera (vertex 0 -1 0)))
+
+
+ (if (kb:key-pressed? #\a) (strafe-camera (vertex walk-length 0 0)))
+ (if (kb:key-pressed? #\d) (strafe-camera (vertex (- walk-length) 0 0)))
+ (if (kb:key-pressed? #\a) (strafe-camera (vertex walk-length 0 0)))
+ (if (kb:key-pressed? #\d) (strafe-camera (vertex (- walk-length) 0 0)))
+ (if (kb:key-pressed? #\w) (strafe-camera (vertex 0 walk-length 0)))
+ (if (kb:key-pressed? #\s) (strafe-camera (vertex 0 (- walk-length) 0)))
+ (if (kb:key-pressed? #\z) (move-camera (vertex 0 walk-length 0)))
+ (if (kb:key-pressed? #\x) (move-camera (vertex 0 (- walk-length) 0)))
+
+ (if (kb:key-pressed? #\r) (turn-camera (vertex 0 0 (- turn-sensitivity))))
+ (if (kb:key-pressed? #\f) (turn-camera (vertex 0 0 turn-sensitivity)))
+
+ (if (kb:key-pressed? #\space) (returnable-repl))))
+ ;(glut:TimerFunc 0 act-on-keyboard-state 0))
+
+(define (render-loop delta)
+ (glut:PostRedisplay)
+ (print "render loop")
+ (act-on-keyboard-state delta)
+ (kb:debug-keyboard-state)
+ (glut:TimerFunc 0 render-loop 0))
+
+(define (main)
+ (glut:InitDisplayMode (+ glut:RGBA glut:DEPTH))
+ (glut:InitWindowSize 640 480)
+ (glut:InitWindowPosition 100 100)
+ (glut:CreateWindow "Schemer's Hope")
+ (init)
+ (glut:DisplayFunc display)
+ (glut:ReshapeFunc reshape)
+
+ (glut:IgnoreKeyRepeat #t)
+ (glut:KeyboardFunc keyboard)
+ (glut:KeyboardUpFunc keyboard-up)
+ (glut:SpecialFunc keyboard)
+ (glut:SpecialUpFunc keyboard-up)
+
+ (glut:TimerFunc 1 render-loop 0)
+ ;(glut:TimerFunc 1 act-on-keyboard-state 0)
+
+ (move-camera (vertex 5 10 5))
+ (turn-camera (vertex 45 225 0))
+ (glut:MainLoop))
+
+(main)
Please sign in to comment.
Something went wrong with that request. Please try again.