first commit

5 files changed, 181 insertions, 0 deletions

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..a3c43c5
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+snek
+gambit-raylib.c
diff --git a/.gitmodules b/.gitmodules
new file mode 100644
index 0000000..14817be
--- /dev/null
+++ b/.gitmodules
@@ -0,0 +1,3 @@
+[submodule "gambit-raylib"]
+	path = gambit-raylib
+	url = git@toniatuh:gambit-raylib.git
diff --git a/gambit-raylib b/gambit-raylib
new file mode 160000
+Subproject 5e764e9edd3c5e33fa9a384b49b74e5c4eb370a
diff --git a/makefile b/makefile
new file mode 100644
index 0000000..57f22e8
--- /dev/null
+++ b/makefile
@@ -0,0 +1,10 @@
+all: snek
+
+.PHONY: all
+
+lib: ./gambit-raylib/raylib.sld
+	gsc -:s -c -module-ref raylib -o gambit-raylib.c ./gambit-raylib/raylib.sld
+
+snek: lib snek.scm
+	gsc -:s -exe -ld-options "-lm -lraylib" -o snek gambit-raylib.c snek.scm
+
diff --git a/snek.scm b/snek.scm
new file mode 100644
index 0000000..d92d43f
--- /dev/null
+++ b/snek.scm
@@ -0,0 +1,166 @@
+(define-syntax with-drawing
+  (syntax-rules ()
+    ((with-drawing body ...)
+     (dynamic-wind
+       raylib#begin-drawing
+       (lambda () (begin body ...))
+       raylib#end-drawing))))
+
+(define BLACK (raylib#make-color 0 0 0 255))
+(define WHITE (raylib#make-color 255 255 255 255))
+(define RED   (raylib#make-color 255 0 0 255))
+
+(define KEY_ESC 256)
+(define KEY_RIGHT 262)
+(define KEY_LEFT 263)
+(define KEY_DOWN 264)
+(define KEY_UP 265)
+
+(define VP_WIDTH 560)
+(define VP_HEIGHT 320)
+(define GRID_SIZE 16)
+(define GRID_WIDTH (fixnum->flonum (/ VP_WIDTH GRID_SIZE)))
+(define GRID_HEIGHT (fixnum->flonum (/ VP_HEIGHT GRID_SIZE)))
+
+(define VP_WIDTH_F (fixnum->flonum VP_WIDTH))
+(define VP_HEIGHT_F (fixnum->flonum VP_HEIGHT))
+(define GRID_SIZE_F (fixnum->flonum GRID_SIZE))
+
+(define FC 0)
+(define game-running #f)
+
+(define (check-pos pos snake-limbs)
+	(if (null? snake-limbs) #t
+		(and (not (and (= (raylib#vec2-x pos)
+						  (raylib#vec2-x (car snake-limbs)))
+					   (= (raylib#vec2-y pos)
+						  (raylib#vec2-y (car snake-limbs)))))
+			 (check-pos pos (cdr snake-limbs)))))
+
+(define (place-apple! state)
+  (let ((candidate
+		 (raylib#make-vec2 (* GRID_SIZE_F
+							  (flfloor (* GRID_WIDTH (random-real))))
+                           (* GRID_SIZE_F
+							  (flfloor (* GRID_HEIGHT (random-real)))))))
+	(if (check-pos candidate (vector->list (state-snake-limbs state)))
+		(state-apple-pos-set! state candidate)
+		(place-apple! state))))
+
+(define-structure state
+  snake-limbs
+  apple-pos
+  square-dims
+  score
+  direction)
+
+(define (wrap pos)
+  (cond ((> (raylib#vec2-x pos) VP_WIDTH_F)
+		 (raylib#vec2-x-set! pos 0.0))
+		((< (raylib#vec2-x pos) 0.0)
+		 (raylib#vec2-x-set! pos (+ (raylib#vec2-x pos) VP_WIDTH_F)))
+		((> (raylib#vec2-y pos) VP_HEIGHT_F)
+		 (raylib#vec2-y-set! pos 0.0))
+		((< (raylib#vec2-y pos) 0.0)
+		 (raylib#vec2-y-set! pos (+ (raylib#vec2-y pos) VP_HEIGHT_F)))))
+
+(define (update state)
+  (cond ((raylib#key-pressed? KEY_RIGHT)
+		 (state-direction-set! state 'right))
+		((raylib#key-pressed? KEY_LEFT)
+		 (state-direction-set! state 'left))
+		((raylib#key-pressed? KEY_UP)
+		 (state-direction-set! state 'down))
+		((raylib#key-pressed? KEY_DOWN)
+		 (state-direction-set! state 'up)))
+  (when (and game-running (= FC 10))
+	(set! FC 0)
+	(let* ((last-limb (vector-ref (state-snake-limbs state) 0))
+		   (new-limb (cond ((eq? 'right (state-direction state))
+							(raylib#make-vec2 (+ (raylib#vec2-x last-limb)
+												 GRID_SIZE_F)
+											  (raylib#vec2-y last-limb)))
+						   ((eq? 'left (state-direction state))
+							(raylib#make-vec2 (- (raylib#vec2-x last-limb)
+												 GRID_SIZE_F)
+											  (raylib#vec2-y last-limb)))
+						   ((eq? 'up (state-direction state))
+							(raylib#make-vec2 (raylib#vec2-x last-limb)
+											  (+ (raylib#vec2-y last-limb)
+												 GRID_SIZE_F)))
+						   ((eq? 'down (state-direction state))
+							(raylib#make-vec2 (raylib#vec2-x last-limb)
+											  (- (raylib#vec2-y last-limb)
+												 GRID_SIZE_F))))))
+	  (wrap new-limb)
+	  (if (not (check-pos new-limb
+					 (cdr (vector->list (state-snake-limbs state)))))
+		  (set! game-running #f))
+	  (if (and (= (raylib#vec2-x (state-apple-pos state))
+				  (raylib#vec2-x new-limb))
+			   (= (raylib#vec2-y (state-apple-pos state))
+				  (raylib#vec2-y new-limb)))
+		  (begin
+			(state-snake-limbs-set! state
+									(vector-append (make-vector 1 new-limb)
+												   (state-snake-limbs state)))
+			(place-apple! state))
+		  (begin
+			(vector-copy! (state-snake-limbs state) 1
+						  (state-snake-limbs state) 0
+						  (- (vector-length (state-snake-limbs state)) 1))
+			(vector-set! (state-snake-limbs state) 0 new-limb)))))
+  state)
+
+(define (draw-snake limbs sq_sz)
+  (unless (null? limbs)
+	(raylib#draw-rectangle-V (car limbs) sq_sz WHITE)
+	(raylib#draw-rec-lines (raylib#make-rec (raylib#vec2-x (car limbs))
+											(raylib#vec2-y (car limbs))
+											GRID_SIZE_F GRID_SIZE_F)
+						   1.0 BLACK)
+	(draw-snake (cdr limbs) sq_sz)))
+
+(define (draw state)
+  (with-drawing
+    (raylib#clear-background BLACK)
+    ;; (raylib#draw-fps 5 5)
+
+	;; draw snake
+	(draw-snake (vector->list (state-snake-limbs state))
+				(state-square-dims state))
+	
+    ;; draw apple
+    (raylib#draw-rectangle-V (state-apple-pos state)
+                             (state-square-dims state)
+                             RED)))
+
+(define (main-loop state)
+  (unless (raylib#window-sould-close)
+	(set! FC (+ FC 1))
+	(update state)
+	(draw state)
+	(main-loop state)))
+	  
+
+(define (init)
+  (make-state (vector (raylib#make-vec2 (* 6.0 GRID_SIZE_F) GRID_SIZE_F)
+					  (raylib#make-vec2 (* 5.0 GRID_SIZE_F) GRID_SIZE_F)
+					  (raylib#make-vec2 (* 4.0 GRID_SIZE_F) GRID_SIZE_F))
+			  (raylib#make-vec2 0.0 0.0)
+			  (raylib#make-vec2 GRID_SIZE_F GRID_SIZE_F)
+			  0
+			  'right))
+
+(define (main arg)
+  (raylib#set-target-fps 60)
+  (raylib#init-window VP_WIDTH VP_HEIGHT "snek")
+  (raylib#set-exit-key KEY_ESC)
+  (set! game-running #t)
+  (display "GAME ON!")
+  (let ((state (init)))
+	(place-apple! state)
+	(main-loop state))
+  (raylib#close-window))
+
+(main '())