diff options
Diffstat (limited to 'src/input.scm')
| -rw-r--r-- | src/input.scm | 192 |
1 files changed, 192 insertions, 0 deletions
diff --git a/src/input.scm b/src/input.scm new file mode 100644 index 0000000..f48518b --- /dev/null +++ b/src/input.scm @@ -0,0 +1,192 @@ +(module input + (create-input-state + input-state-update! + input-pressed? + input-held? + input-released? + input-any-pressed?) + +(import scheme + (chicken base) + (chicken module) + (only srfi-1 any) + (prefix sdl2 sdl2:)) + +;; Input state record - tracks current and previous frame state +(define-record input-state + up down left right a b start select + prev-up prev-down prev-left prev-right prev-a prev-b prev-start prev-select) + +;; Create a new input state with all buttons released +(define (create-input-state) + (make-input-state #f #f #f #f #f #f #f #f + #f #f #f #f #f #f #f #f)) + +;; Button name to keyboard scancode mapping +(define *keyboard-map* + '((up . w) + (down . s) + (left . a) + (right . d) + (a . j) + (b . k) + (start . return) + (select . backspace))) + +;; Button name to gamepad button mapping +(define *gamepad-button-map* + '((a . 0) ; Button 0 (typically A/Cross) + (b . 1) ; Button 1 (typically B/Circle) + (start . 9) ; Button 9 (Start) + (select . 8))) ; Button 8 (Select) + +;; Update input state based on SDL2 events +;; This should be called once per frame AFTER processing events +;; Pass the event list from your game loop +(define (input-state-update! state events) + ;; Save previous frame state + (input-state-prev-up-set! state (input-state-up state)) + (input-state-prev-down-set! state (input-state-down state)) + (input-state-prev-left-set! state (input-state-left state)) + (input-state-prev-right-set! state (input-state-right state)) + (input-state-prev-a-set! state (input-state-a state)) + (input-state-prev-b-set! state (input-state-b state)) + (input-state-prev-start-set! state (input-state-start state)) + (input-state-prev-select-set! state (input-state-select state)) + + ;; Process events to update current state + (for-each + (lambda (event) + (let ((type (sdl2:event-type event))) + (cond + ;; Keyboard events + ((eq? type 'key-down) + (let ((key (sdl2:keyboard-event-sym event))) + (cond + ((eq? key 'w) (input-state-up-set! state #t)) + ((eq? key 's) (input-state-down-set! state #t)) + ((eq? key 'a) (input-state-left-set! state #t)) + ((eq? key 'd) (input-state-right-set! state #t)) + ((eq? key 'j) (input-state-a-set! state #t)) + ((eq? key 'k) (input-state-b-set! state #t)) + ((eq? key 'return) (input-state-start-set! state #t)) + ((eq? key 'backspace) (input-state-select-set! state #t))))) + + ((eq? type 'key-up) + (let ((key (sdl2:keyboard-event-sym event))) + (cond + ((eq? key 'w) (input-state-up-set! state #f)) + ((eq? key 's) (input-state-down-set! state #f)) + ((eq? key 'a) (input-state-left-set! state #f)) + ((eq? key 'd) (input-state-right-set! state #f)) + ((eq? key 'j) (input-state-a-set! state #f)) + ((eq? key 'k) (input-state-b-set! state #f)) + ((eq? key 'return) (input-state-start-set! state #f)) + ((eq? key 'backspace) (input-state-select-set! state #f))))) + + ;; Joystick button events + ((eq? type 'joy-button-down) + (let ((button (sdl2:joy-button-event-button event))) + (cond + ((= button 0) (input-state-a-set! state #t)) + ((= button 1) (input-state-b-set! state #t)) + ((= button 8) (input-state-select-set! state #t)) + ((= button 9) (input-state-start-set! state #t))))) + + ((eq? type 'joy-button-up) + (let ((button (sdl2:joy-button-event-button event))) + (cond + ((= button 0) (input-state-a-set! state #f)) + ((= button 1) (input-state-b-set! state #f)) + ((= button 8) (input-state-select-set! state #f)) + ((= button 9) (input-state-start-set! state #f))))) + + ;; Joystick hat (d-pad) events + ((eq? type 'joy-hat-motion) + (let ((value (sdl2:joy-hat-event-value event))) + (input-state-up-set! state (or (= value 1) (= value 9) (= value 5))) ; UP, LEFT-UP, RIGHT-UP + (input-state-down-set! state (or (= value 4) (= value 6) (= value 10))) ; DOWN, LEFT-DOWN, RIGHT-DOWN + (input-state-left-set! state (or (= value 8) (= value 9) (= value 6))) ; LEFT, LEFT-UP, LEFT-DOWN + (input-state-right-set! state (or (= value 2) (= value 5) (= value 10))))) ; RIGHT, RIGHT-UP, RIGHT-DOWN + + ;; Joystick axis (analog stick as d-pad) + ((eq? type 'joy-axis-motion) + (let ((axis (sdl2:joy-axis-event-axis event)) + (value (sdl2:joy-axis-event-value event))) + (cond + ((= axis 0) ; X-axis + (input-state-left-set! state (< value -8000)) + (input-state-right-set! state (> value 8000))) + ((= axis 1) ; Y-axis + (input-state-up-set! state (< value -8000)) + (input-state-down-set! state (> value 8000))))))))) + events)) + +;; Check if a button was just pressed this frame +(define (input-pressed? state button) + (let ((current (case button + ((up) (input-state-up state)) + ((down) (input-state-down state)) + ((left) (input-state-left state)) + ((right) (input-state-right state)) + ((a) (input-state-a state)) + ((b) (input-state-b state)) + ((start) (input-state-start state)) + ((select) (input-state-select state)) + (else #f))) + (previous (case button + ((up) (input-state-prev-up state)) + ((down) (input-state-prev-down state)) + ((left) (input-state-prev-left state)) + ((right) (input-state-prev-right state)) + ((a) (input-state-prev-a state)) + ((b) (input-state-prev-b state)) + ((start) (input-state-prev-start state)) + ((select) (input-state-prev-select state)) + (else #f)))) + (and current (not previous)))) + +;; Check if a button is currently held down +(define (input-held? state button) + (case button + ((up) (input-state-up state)) + ((down) (input-state-down state)) + ((left) (input-state-left state)) + ((right) (input-state-right state)) + ((a) (input-state-a state)) + ((b) (input-state-b state)) + ((start) (input-state-start state)) + ((select) (input-state-select state)) + (else #f))) + +;; Check if a button was just released this frame +(define (input-released? state button) + (let ((current (case button + ((up) (input-state-up state)) + ((down) (input-state-down state)) + ((left) (input-state-left state)) + ((right) (input-state-right state)) + ((a) (input-state-a state)) + ((b) (input-state-b state)) + ((start) (input-state-start state)) + ((select) (input-state-select state)) + (else #f))) + (previous (case button + ((up) (input-state-prev-up state)) + ((down) (input-state-prev-down state)) + ((left) (input-state-prev-left state)) + ((right) (input-state-prev-right state)) + ((a) (input-state-prev-a state)) + ((b) (input-state-prev-b state)) + ((start) (input-state-prev-start state)) + ((select) (input-state-prev-select state)) + (else #f)))) + (and (not current) previous))) + +;; Check if any button was pressed this frame +(define (input-any-pressed? state) + (any (lambda (button) + (input-pressed? state button)) + '(up down left right a b start select))) + +) ; end module |