├── .gitignore ├── LICENSE ├── README.md ├── elm.json └── src └── Keyboard.elm /.gitignore: -------------------------------------------------------------------------------- 1 | elm-stuff -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016-present, Evan Czaplicki 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Evan Czaplicki nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Moved into [`elm/browser`](https://github.com/elm/browser) 2 | -------------------------------------------------------------------------------- /elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "package", 3 | "name": "elm-lang/keyboard", 4 | "summary": "Subscribe to keyboard events.", 5 | "license": "BSD-3-Clause", 6 | "version": "1.0.1", 7 | "exposed-modules": [ 8 | "Keyboard" 9 | ], 10 | "elm-version": "0.19.0 <= v < 0.20.0", 11 | "dependencies": { 12 | "elm-lang/core": "6.0.0 <= v < 7.0.0", 13 | "elm-lang/dom": "2.0.0 <= v < 3.0.0" 14 | }, 15 | "test-dependencies": {}, 16 | "effect-modules": true 17 | } -------------------------------------------------------------------------------- /src/Keyboard.elm: -------------------------------------------------------------------------------- 1 | effect module Keyboard where { subscription = MySub } exposing 2 | ( KeyCode 3 | , presses, downs, ups 4 | ) 5 | 6 | {-| This library lets you listen to global keyboard events. 7 | 8 | # Key Codes 9 | @docs KeyCode 10 | 11 | # Subscriptions 12 | @docs presses, downs, ups 13 | 14 | -} 15 | 16 | import Dict 17 | import Dom.LowLevel as Dom 18 | import Json.Decode as Json 19 | import Process 20 | import Task exposing (Task) 21 | 22 | 23 | 24 | -- KEY CODES 25 | 26 | 27 | {-| Keyboard keys can be represented as integers. These are called *key codes*. 28 | You can use [`toCode`](http://package.elm-lang.org/packages/elm-lang/core/latest/Char#toCode) 29 | and [`fromCode`](http://package.elm-lang.org/packages/elm-lang/core/latest/Char#fromCode) 30 | to convert between key codes and characters. 31 | -} 32 | type alias KeyCode = 33 | Int 34 | 35 | 36 | keyCode : Json.Decoder KeyCode 37 | keyCode = 38 | Json.field "keyCode" Json.int 39 | 40 | 41 | 42 | -- MOUSE EVENTS 43 | 44 | 45 | {-| Subscribe to all key presses. 46 | -} 47 | presses : (KeyCode -> msg) -> Sub msg 48 | presses tagger = 49 | subscription (MySub "keypress" tagger) 50 | 51 | 52 | {-| Subscribe to get codes whenever a key goes down. 53 | -} 54 | downs : (KeyCode -> msg) -> Sub msg 55 | downs tagger = 56 | subscription (MySub "keydown" tagger) 57 | 58 | 59 | {-| Subscribe to get codes whenever a key goes up. 60 | -} 61 | ups : (KeyCode -> msg) -> Sub msg 62 | ups tagger = 63 | subscription (MySub "keyup" tagger) 64 | 65 | 66 | 67 | -- SUBSCRIPTIONS 68 | 69 | 70 | type MySub msg 71 | = MySub String (KeyCode -> msg) 72 | 73 | 74 | subMap : (a -> b) -> MySub a -> MySub b 75 | subMap func (MySub category tagger) = 76 | MySub category (tagger >> func) 77 | 78 | 79 | 80 | -- EFFECT MANAGER STATE 81 | 82 | 83 | type alias State msg = 84 | Dict.Dict String (Watcher msg) 85 | 86 | 87 | type alias Watcher msg = 88 | { taggers : List (KeyCode -> msg) 89 | , pid : Process.Id 90 | } 91 | 92 | 93 | 94 | -- CATEGORIZE SUBSCRIPTIONS 95 | 96 | 97 | type alias SubDict msg = 98 | Dict.Dict String (List (KeyCode -> msg)) 99 | 100 | 101 | categorize : List (MySub msg) -> SubDict msg 102 | categorize subs = 103 | categorizeHelp subs Dict.empty 104 | 105 | 106 | categorizeHelp : List (MySub msg) -> SubDict msg -> SubDict msg 107 | categorizeHelp subs subDict = 108 | case subs of 109 | [] -> 110 | subDict 111 | 112 | MySub category tagger :: rest -> 113 | categorizeHelp rest <| 114 | Dict.update category (categorizeHelpHelp tagger) subDict 115 | 116 | 117 | categorizeHelpHelp : a -> Maybe (List a) -> Maybe (List a) 118 | categorizeHelpHelp value maybeValues = 119 | case maybeValues of 120 | Nothing -> 121 | Just [value] 122 | 123 | Just values -> 124 | Just (value :: values) 125 | 126 | 127 | 128 | -- EFFECT MANAGER 129 | 130 | 131 | init : Task Never (State msg) 132 | init = 133 | Task.succeed Dict.empty 134 | 135 | 136 | type alias Msg = 137 | { category : String 138 | , keyCode : KeyCode 139 | } 140 | 141 | 142 | (&>) task1 task2 = 143 | Task.andThen (\_ -> task2) task1 144 | 145 | 146 | onEffects : Platform.Router msg Msg -> List (MySub msg) -> State msg -> Task Never (State msg) 147 | onEffects router newSubs oldState = 148 | let 149 | leftStep category {pid} task = 150 | Process.kill pid &> task 151 | 152 | bothStep category {pid} taggers task = 153 | Task.map (Dict.insert category (Watcher taggers pid)) task 154 | 155 | rightStep category taggers task = 156 | task 157 | |> Task.andThen (\state -> Process.spawn (Dom.onDocument category keyCode (Platform.sendToSelf router << Msg category)) 158 | |> Task.andThen (\pid -> Task.succeed (Dict.insert category (Watcher taggers pid) state))) 159 | in 160 | Dict.merge 161 | leftStep 162 | bothStep 163 | rightStep 164 | oldState 165 | (categorize newSubs) 166 | (Task.succeed Dict.empty) 167 | 168 | 169 | onSelfMsg : Platform.Router msg Msg -> Msg -> State msg -> Task Never (State msg) 170 | onSelfMsg router {category,keyCode} state = 171 | case Dict.get category state of 172 | Nothing -> 173 | Task.succeed state 174 | 175 | Just {taggers} -> 176 | let 177 | send tagger = 178 | Platform.sendToApp router (tagger keyCode) 179 | in 180 | Task.sequence (List.map send taggers) 181 | |> Task.andThen (\_ -> Task.succeed state) 182 | 183 | --------------------------------------------------------------------------------