Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Comparing changes

Choose two branches to see what's changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
base fork: candera/kchordr
base: 8e776dd078
...
head fork: candera/kchordr
compare: 556de87c79
Checking mergeability… Don't worry, you can still create the pull request.
  • 2 commits
  • 2 files changed
  • 0 commit comments
  • 1 contributor
Showing with 46 additions and 38 deletions.
  1. +34 −26 src/clj/kchordr/core.clj
  2. +12 −12 test/kchordr/test/core.clj
View
60 src/clj/kchordr/core.clj 100644 → 100755
@@ -1,4 +1,5 @@
-(ns kchordr.core)
+(ns kchordr.core
+ (:refer-clojure :exclude [key name]))
(def ^{:private true
:doc "Map of keys to classes. Absence from this list means it's a normal key."}
@@ -12,32 +13,38 @@
(second alias)
key))
-(defn key-state
+(defn state
"Returns a new key-state object."
[]
{:to-send []
:state :ground})
-;; (defprotocol KeyState
-;; (next-state [this key direction] "Compute the next state given the current state and a new key press"))
-;; (defrecord GroundState []
-;; KeyState
-;; (next-state [this key direction]
-;; )
-;; )
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Key events
-;; (defmulti next-state
-;; "Given the current state, a Return a new key state ")
+(defn event
+ "Given a key name and a direction, return a new key event."
+ [name direction]
+ [name direction])
-(def ^{:private true
- :doc "Maps the current state a key class and a direction to a
- new state"}
- state-transitions
- {[:ground :normal :up] :ground
- [:ground :normal :dn] :ground
- [:ground :modifier-alias :dn] :mod-undecided
- [:ground :modifier-alias :up] :error})
+(defn key
+ "Given a key event, return the key."
+ [event]
+ (first event))
+
+(defn direction
+ "Given a key event, return the direction."
+ [event]
+ (second event))
+
+(defn append
+ "Append bs to a, where bs and a are (potentially empty) sequences of
+ events."
+ [a & bs]
+ (concat a bs))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn modifier-alias?
"Given a key class, return true if it is a modifier alias"
@@ -99,10 +106,11 @@
(reduce decide-modifier {} keystate))
(defn process
- "Given the current key state and a key event, return an updated key
- state."
- [state key direction]
- (let [cls (get key-classes key :normal)
+ "Given the current state and a key event, return an updated state."
+ [state event]
+ (let [key (key event)
+ direction (direction event)
+ cls (get key-classes key :normal)
keystate (:keystate state)]
(cond
(and (modifier-alias? cls) (= :dn direction))
@@ -111,13 +119,13 @@
(and (undecided-modifier? keystate)
(regular-keydown? key direction))
(assoc state
- :to-send (concat (:to-send state)
+ :to-send (append (:to-send state)
(undecided-modifier-downs keystate)
- [key :dn])
+ (event key :dn))
:keystate (decide-modifiers keystate))
:else
- (update-in state [:to-send] #(concat % [[key direction]])))))
+ (assoc state :to-send (append (:to-send state) (event key direction))))))
(defn to-send
"Given a key state, return any pending key events, in the form of
View
24 test/kchordr/test/core.clj 100644 → 100755
@@ -5,29 +5,29 @@
(defn- sent
"Given a sequence of key events, return the sequence of keys that
will actually be sent."
- [pressed]
- (loop [state (key-state)
- presses pressed]
+ [presses]
+ (loop [state (state)
+ press presses]
(if (seq presses)
- (recur (process state (first presses) (second presses))
+ (recur (process state press)
(rest (rest presses)))
(to-send state))))
(deftest key-tests
- (are [pressed expected-sent] (= (partition 2 expected-sent) (sent pressed))
+ (are [pressed anticipated] (= anticipated (sent pressed))
;; Single non-modifier key press
- [:b :dn]
- [:b :dn]
+ [[:b :dn]]
+ [[:b :dn]]
;; Single non-modified key press and release
- [:b :dn :b :up]
- [:b :dn :b :up]
+ [[:b :dn] [:b :up]]
+ [[:b :dn] [:b :up]]
;; Modified key press only
- [:j :dn]
+ [[:j :dn]]
[]
;; Modified shifted key
- [:j :dn :x :dn]
- [:rshift :dn :x :dn]))
+ [[:j :dn] [:x :dn]]
+ [[:rshift :dn] [:x :dn]]))

No commit comments for this range

Something went wrong with that request. Please try again.