Moved specific things from mapping/retention to the appropriate locat…

…ions.

controller.lisp

@@ -7,6 +7,23 @@
 (in-package #:org.shirakumo.fraf.trial)
 (in-readtable :qtools)
 
+(define-action system-action ())
+
+(define-action launch-editor (system-action)
+  (key-press (eql key :section)))
+
+(define-action save-game (system-action)
+  (key-press (eql key :f2)))
+
+(define-action load-game (system-action)
+  (key-press (eql key :f3)))
+
+(define-action reload-assets (system-action)
+  (key-press (eql key :f5)))
+
+(define-action reload-scene (system-action)
+  (key-press (eql key :f6)))
+
 (define-subject controller (hud-entity)
   (;; Has to be a double to avoid bignums after ~3.8 hours of runtime.
    (tick-count :initform 0.0d0 :accessor tick-count)

input.lisp

@@ -181,3 +181,12 @@
   (let ((axis (gamepad-axis->symbol device axis)))
     (dolist (handler *input-handlers*)
       (handle (make-instance 'gamepad-move :axis axis :old-pos last-value :pos value :device device) handler))))
+
+(define-uniform-retention key (key-press key-release key)
+  key)
+
+(define-uniform-retention mouse (mouse-press mouse-release button)
+  button)
+
+(define-uniform-retention gamepad (gamepad-press gamepad-release button)
+  button)

mapping.lisp

@@ -62,68 +62,3 @@
          ())
        (remove-action-mappings ',name)
        ,@(mapcar #'compile-mapping mappings))))
-
-(define-action system-action ())
-
-(define-action launch-editor (system-action)
-  (key-press (eql key :section)))
-
-(define-action save-game (system-action)
-  (key-press (eql key :f2)))
-
-(define-action load-game (system-action)
-  (key-press (eql key :f3)))
-
-(define-action reload-assets (system-action)
-  (key-press (eql key :f5)))
-
-(define-action reload-scene (system-action)
-  (key-press (eql key :f6)))
-
-(define-action player-action ())
-
-(define-action movement (player-action))
-
-(define-action start-left (movement)
-  (key-press (one-of key :a :left))
-  (gamepad-press (eql button :dpad-left))
-  (gamepad-move (one-of axis :left-h :dpad-h) (< pos -0.2 old-pos)))
-
-(define-action start-right (movement)
-  (key-press (one-of key :d :right))
-  (gamepad-press (eql button :dpad-right))
-  (gamepad-move (one-of axis :left-h :dpad-h) (< old-pos 0.2 pos)))
-
-(define-action start-up (movement)
-  (key-press (one-of key :w :up))
-  (gamepad-press (eql button :dpad-up))
-  (gamepad-move (one-of axis :left-v :dpad-v) (< pos -0.2 old-pos)))
-
-(define-action start-down (movement)
-  (key-press (one-of key :s :down))
-  (gamepad-press (eql button :dpad-down))
-  (gamepad-move (one-of axis :left-v :dpad-v) (< old-pos 0.2 pos)))
-
-(define-action stop-left (movement)
-  (key-release (one-of key :a :left))
-  (gamepad-release (eql button :dpad-left))
-  (gamepad-move (one-of axis :left-h :dpad-h) (< old-pos -0.2 pos)))
-
-(define-action stop-right (movement)
-  (key-release (one-of key :d :right))
-  (gamepad-release (eql button :dpad-right))
-  (gamepad-move (one-of axis :left-h :dpad-h) (< pos 0.2 old-pos)))
-
-(define-action stop-up (movement)
-  (key-release (one-of key :w :up))
-  (gamepad-release (eql button :dpad-up))
-  (gamepad-move (one-of axis :left-v :dpad-v) (< old-pos -0.2 pos)))
-
-(define-action stop-down (movement)
-  (key-release (one-of key :s :down))
-  (gamepad-release (eql button :dpad-down))
-  (gamepad-move (one-of axis :left-v :dpad-v) (< pos 0.2 old-pos)))
-
-(define-action perform (player-action)
-  (key-press (one-of key :space))
-  (gamepad-press (eql button :a)))

player.lisp

@@ -7,6 +7,65 @@
 (in-package #:org.shirakumo.fraf.trial)
 (in-readtable :qtools)
 
+(define-action player-action ())
+
+(define-action movement (player-action))
+
+(define-action start-left (movement)
+  (key-press (one-of key :a :left))
+  (gamepad-press (eql button :dpad-left))
+  (gamepad-move (one-of axis :left-h :dpad-h) (< pos -0.2 old-pos)))
+
+(define-action start-right (movement)
+  (key-press (one-of key :d :right))
+  (gamepad-press (eql button :dpad-right))
+  (gamepad-move (one-of axis :left-h :dpad-h) (< old-pos 0.2 pos)))
+
+(define-action start-up (movement)
+  (key-press (one-of key :w :up))
+  (gamepad-press (eql button :dpad-up))
+  (gamepad-move (one-of axis :left-v :dpad-v) (< pos -0.2 old-pos)))
+
+(define-action start-down (movement)
+  (key-press (one-of key :s :down))
+  (gamepad-press (eql button :dpad-down))
+  (gamepad-move (one-of axis :left-v :dpad-v) (< old-pos 0.2 pos)))
+
+(define-action stop-left (movement)
+  (key-release (one-of key :a :left))
+  (gamepad-release (eql button :dpad-left))
+  (gamepad-move (one-of axis :left-h :dpad-h) (< old-pos -0.2 pos)))
+
+(define-action stop-right (movement)
+  (key-release (one-of key :d :right))
+  (gamepad-release (eql button :dpad-right))
+  (gamepad-move (one-of axis :left-h :dpad-h) (< pos 0.2 old-pos)))
+
+(define-action stop-up (movement)
+  (key-release (one-of key :w :up))
+  (gamepad-release (eql button :dpad-up))
+  (gamepad-move (one-of axis :left-v :dpad-v) (< old-pos -0.2 pos)))
+
+(define-action stop-down (movement)
+  (key-release (one-of key :s :down))
+  (gamepad-release (eql button :dpad-down))
+  (gamepad-move (one-of axis :left-v :dpad-v) (< pos 0.2 old-pos)))
+
+(define-action perform (player-action)
+  (key-press (one-of key :space))
+  (gamepad-press (eql button :a)))
+
+(define-retention movement (ev)
+  (typecase ev
+    (start-left (setf (retained 'movement :left) T))
+    (start-right (setf (retained 'movement :right) T))
+    (start-up (setf (retained 'movement :up) T))
+    (start-down (setf (retained 'movement :down) T))
+    (stop-left (setf (retained 'movement :left) NIL))
+    (stop-right (setf (retained 'movement :right) NIL))
+    (stop-up (setf (retained 'movement :up) NIL))
+    (stop-down (setf (retained 'movement :down) NIL))))
+
 (define-subject player (face-entity collidable-entity selectable-entity)
   ((velocity :initarg :velocity :accessor velocity))
   (:default-initargs

retention.lisp

@@ -68,23 +68,3 @@
 
 (defmacro define-uniform-retention (type (start end &rest args) &body body)
   `(define-coupled-retention ,type (,start ,args ,@body) (,end ,args ,@body)))
-
-(define-uniform-retention key (key-press key-release key)
-  key)
-
-(define-uniform-retention mouse (mouse-press mouse-release button)
-  button)
-
-(define-uniform-retention gamepad (gamepad-press gamepad-release button)
-  button)
-
-(define-retention movement (ev)
-  (typecase ev
-    (start-left (setf (retained 'movement :left) T))
-    (start-right (setf (retained 'movement :right) T))
-    (start-up (setf (retained 'movement :up) T))
-    (start-down (setf (retained 'movement :down) T))
-    (stop-left (setf (retained 'movement :left) NIL))
-    (stop-right (setf (retained 'movement :right) NIL))
-    (stop-up (setf (retained 'movement :up) NIL))
-    (stop-down (setf (retained 'movement :down) NIL))))

trial.asd

@@ -41,10 +41,10 @@
                (:file "camera")
                (:file "selectable")
                (:file "flare")
-               (:file "input-tables")
-               (:file "input")
                (:file "mapping")
                (:file "retention")
+               (:file "input-tables")
+               (:file "input")
                (:file "player")
                (:file "controller")
                (:file "main")