More keyboard events

diff --git a/examples/03-key-presses/03-key-presses.scm b/examples/03-key-presses/03-key-presses.scm
new file mode 100644 (file)
index 0000000..06fa186
--- /dev/null
+++ b/examples/03-key-presses/03-key-presses.scm
@@ -0,0 +1,51 @@
+#!/usr/bin/env guile
+!#
+
+;;; Gacela, a GNU Guile extension for fast games development
+;;; Copyright (C) 2017 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+(use-modules (gacela))
+
+
+(define get-pressed-scene #f)
+
+(set! get-pressed-scene
+  (let* ((up (bitmap "up.bmp"))
+        (down (bitmap "down.bmp"))
+        (left (bitmap "left.bmp"))
+        (right (bitmap "right.bmp"))
+        (press (bitmap "press.bmp"))
+        (actived press))
+    (lambda ()
+      (if (any-key-down?)
+         (cond ((key-down? 'up)
+                (set! actived up))
+               ((key-down? 'down)
+                (set! actived down))
+               ((key-down? 'left)
+                (set! actived left))
+               ((key-down? 'right)
+                (set! actived right))
+               (else
+                (set! actived press))))
+      actived)))
+
+(define press (bitmap "press.bmp"))
+
+(display-scene
+ (window ((resolution '(640 480)))
+   (lambda ()
+     (display-scene (get-pressed-scene)))))

diff --git a/examples/03-key-presses/down.bmp b/examples/03-key-presses/down.bmp
new file mode 100755 (executable)
index 0000000..da01d0d
Binary files /dev/null and b/examples/03-key-presses/down.bmp differ

diff --git a/examples/03-key-presses/left.bmp b/examples/03-key-presses/left.bmp
new file mode 100755 (executable)
index 0000000..8f4136c
Binary files /dev/null and b/examples/03-key-presses/left.bmp differ

diff --git a/examples/03-key-presses/press.bmp b/examples/03-key-presses/press.bmp
new file mode 100755 (executable)
index 0000000..3d9e142
Binary files /dev/null and b/examples/03-key-presses/press.bmp differ

diff --git a/examples/03-key-presses/right.bmp b/examples/03-key-presses/right.bmp
new file mode 100755 (executable)
index 0000000..e52d082
Binary files /dev/null and b/examples/03-key-presses/right.bmp differ

diff --git a/examples/03-key-presses/up.bmp b/examples/03-key-presses/up.bmp
new file mode 100755 (executable)
index 0000000..a8e5efa
Binary files /dev/null and b/examples/03-key-presses/up.bmp differ

diff --git a/gacela.scm b/gacela.scm
index 90840bf9e02d435b37d5e3c189bcebe31fde2b4a..2ed1e6a5c01f27e7e353d31c0e74ee7457904b55 100644 (file)
--- a/gacela.scm
+++ b/gacela.scm
@@ -22,7 +22,8 @@
 (eval-when (eval load compile)
   (begin
     (define %public-modules
-      '((gacela image)
+      '((gacela event)
+       (gacela image)
        (gacela game)
        (gacela math)
        (gacela scene)

diff --git a/gacela/event.scm b/gacela/event.scm
index 9efd8e1c552e6654dd5fdf9c197d2032bf905e3d..04223971108da1a33c1cb4980f41d85aed63b652 100644 (file)
--- a/gacela/event.scm
+++ b/gacela/event.scm
@@ -18,7 +18,12 @@
 (define-module (gacela event)
   #:use-module ((sdl2 events) #:prefix sdl2:)
   #:export (process-events
-           quit?))
+           quit-event?
+           key-events
+           any-key-down?
+           any-key-up?
+           key-down?
+           key-up?))
 
 
 (define *current-events* '())
@@ -33,5 +38,38 @@
 (define (process-events)
   (set! *current-events* (poll-events)))
 
-(define (quit?)
+(define (quit-event?)
   (not (null? (filter (lambda (e) (sdl2:quit-event? e)) *current-events*))))
+
+(define (key-events)
+  (filter (lambda (e) (sdl2:keyboard-event? e)) *current-events*))
+
+(define (any-key-down?)
+  (let loop ((events *current-events*))
+    (if (null? events)
+       #f
+       (or (sdl2:keyboard-down-event? (car events))
+           (loop (cdr events))))))
+
+(define (any-key-up?)
+  (let loop ((events *current-events*))
+    (if (null? events)
+       #f
+       (or (sdl2:keyboard-up-event? (car events))
+           (loop (cdr events))))))
+
+(define (key-down? key)
+  (let ((ke (filter
+            (lambda (e)
+              (and (sdl2:keyboard-down-event? e)
+                   (equal? (sdl2:keyboard-event-key e) key)))
+            *current-events*)))
+    (not (null? ke))))
+
+(define (key-up? key)
+  (let ((ke (filter
+            (lambda (e)
+              (and (sdl2:keyboard-up-event? e)
+                   (equal? (sdl2:keyboard-event-key e) key)))
+            *current-events*)))
+    (not (null? ke))))

diff --git a/gacela/game.scm b/gacela/game.scm
index 48bf1297b2fce045905db6d40030fa10165fe81e..e8e635a51b0ad632dc3662a124702e14f0b979ce 100644 (file)
--- a/gacela/game.scm
+++ b/gacela/game.scm
@@ -76,7 +76,7 @@ unused accumulator time."
               lag)
              ((>= lag tick-interval)
               (process-events)
-              (if (and (quit?) (procedure? when-quit))
+              (if (and (quit-event?) (procedure? when-quit))
                   (when-quit))
                                        ;(agenda-tick!)
               (iter (- lag tick-interval) (1+ ticks)))

diff --git a/gacela/scene.scm b/gacela/scene.scm
index ccdc23e9c47d9e536859360fa2962efe99aa1b19..f3803cdf7b4a2cf197a571dcee5d1c6615f400d9 100644 (file)
--- a/gacela/scene.scm
+++ b/gacela/scene.scm
@@ -40,8 +40,16 @@
 ;;; Scene Procedures
 
 (define (display-scene scene . args)
-  (apply (scene-procedure scene) args))
+  (apply
+   (if (scene? scene)
+       (scene-procedure scene)
+       scene)
+   args))
 
 (define (run-scene scene . args)
   (apply start-game
-        (cons (scene-procedure scene) args)))
+        (cons
+         (if (scene? scene)
+             (scene-procedure scene)
+             scene)
+         args)))

diff --git a/gacela/window.scm b/gacela/window.scm
index 6d43ce600971c29f18be332dcc4ca2d8de7ec0be..29e1662c8ec94c76ad6dc8ad62b902629a68fc10 100644 (file)
--- a/gacela/window.scm
+++ b/gacela/window.scm
@@ -1,5 +1,5 @@
 ;;; Gacela, a GNU Guile extension for fast games development
-;;; Copyright (C) 2016 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;; Copyright (C) 2017 by Javier Sancho Fernandez <jsf at jsancho dot org>
 ;;;
 ;;; This program is free software: you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by