From: Javier Sancho Date: Fri, 3 Mar 2017 16:08:15 +0000 (+0100) Subject: More keyboard events X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=39f20a9681fa52e854678fe5acb5b10e3244c1cd;p=gacela.git 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 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 +;;; +;;; 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 . + +(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 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 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 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 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 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 90840bf..2ed1e6a 100644 --- 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 9efd8e1..0422397 100644 --- 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 48bf129..e8e635a 100644 --- 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 ccdc23e..f3803cd 100644 --- 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 6d43ce6..29e1662 100644 --- 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 +;;; Copyright (C) 2017 by Javier Sancho Fernandez ;;; ;;; 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