SuperKamiGuru/foss-mmo
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add attempt at onscreen controls for touch screens.

Browse source
This commit is contained in:
David Thompson 2024-05-26 14:55:04 -04:00
parent 89b39ab6f0
commit aa0c826b3c
4 changed files with 249 additions and 32 deletions
Download patch file Download diff file Expand all files Collapse all files

69
game.scm
View file

@ -150,7 +150,7 @@
(set! *snapshots* older-snapshots)
(play-sound-effect audio:undo)
(unless *current-effect*
(show-effect! (make-wipe-effect 0.15))))))
(show-effect! (make-wipe-effect 0.25))))))
(define (sort lst compare)
(match lst
@ -639,34 +639,36 @@
(define (on-key-down event)
(let ((key (keyboard-event-code event)))
(pk 'key-down key)
(match *state*
('play
(cond
((string=? key key:left)
(move-player 'left))
((string=? key key:right)
(move-player 'right))
((string=? key key:up)
(move-player 'up))
((string=? key key:down)
(move-player 'down))
((string=? key key:undo)
(rollback-snapshot!)
(with-goblins (update-objects!)))
;; REMOVE BEFORE RELEASE!!!!
((string=? key key:confirm)
(next-level!))))
;; Pressing any bound key resets the game.
('win
(when (or
(string=? key key:left)
(string=? key key:right)
(string=? key key:up)
(string=? key key:down)
(string=? key key:undo)
(string=? key key:confirm))
(reset-game!))))))
(cond
((string=? key key:left)
(on-input-down 'left))
((string=? key key:right)
(on-input-down 'right))
((string=? key key:up)
(on-input-down 'up))
((string=? key key:down)
(on-input-down 'down))
((string=? key key:undo)
(on-input-down 'undo))
((string=? key key:confirm)
(on-input-down 'confirm)))))
(define (on-input-down input)
(pk 'input-down input)
(match *state*
('play
(match input
('left (move-player 'left))
('right (move-player 'right))
('up (move-player 'up))
('down (move-player 'down))
('undo
(rollback-snapshot!)
(with-goblins (update-objects!)))
;; REMOVE BEFORE RELEASE!!!!
('confirm (next-level!))))
;; Pressing any bound input resets the game.
('win (reset-game!))))
;; Canvas and event loop setup
(define canvas (get-element-by-id "canvas"))
@ -695,6 +697,15 @@
(procedure->external (lambda (_) (resize-canvas))))
(add-event-listener! (current-document) "keydown"
(procedure->external on-key-down))
(define (register-touch-control elem-id input-id)
(add-event-listener! (get-element-by-id elem-id) "click"
(procedure->external
(lambda (e) (on-input-down input-id)))))
(register-touch-control "dpad-left" 'left)
(register-touch-control "dpad-right" 'right)
(register-touch-control "dpad-down" 'down)
(register-touch-control "dpad-up" 'up)
(register-touch-control "button-a" 'undo)
(resize-canvas)
(request-animation-frame draw-callback)
(timeout update-callback dt)