Support regional keymaps via libkeymap or dumpkeys

5 files changed, 157 insertions, 148 deletions

diff --git a/virtual-programs/editor.folk b/virtual-programs/editor.folk
index 201dc7bb..a5ebbfdd 100644
--- a/virtual-programs/editor.folk
+++ b/virtual-programs/editor.folk
@@ -15,8 +15,8 @@ When /page/ is a keyboard with path /kbPath/ &\
   Claim $id has region [region move $r up 210%]
   When /nobody/ claims $id has program code /c/ {
     Commit "code$kbPath" {
-      Claim $id has program code $baseCode 
-      Claim $id has editor code $baseCode 
+      Claim $id has program code $baseCode
+      Claim $id has editor code $baseCode
     }
   }
 
@@ -191,116 +191,111 @@ proc getCurrentLineLength {lines cursor} {
 
 When /page/ is a keyboard with path /kbPath/ & /page/ is an editor {
   set id "$page$kbPath"
-  Every time keyboard $kbPath claims key /currentCharacter/ is /keyState/ with modifiers /modifier/ timestamp /timestamp/ &\
+
+  Every time keyboard $kbPath claims key /key/ is /keyState/ with /...options/ &\
              the $kbPath cursor is /cursor/ &\
              $id has program code /code/ &\
              $id has editor code /editorCode/ &\
              $id has start time /startTime/ {
-    if {($keyState == "down" || $keyState == "repeat") & $timestamp > ($startTime * 1000) } {
-      Commit "cursor$kbPath" {
-        switch $currentCharacter {
-          UP {
-            set updatedCursor [updateCursor $cursor {y -1}]
-            set currentLineLength  [getCurrentLineLength $editorCode $updatedCursor]
-            if {[x $updatedCursor] > $currentLineLength} {
-              Claim the $kbPath cursor is [list $currentLineLength  [y $updatedCursor]]
-            } else {
-              Claim the $kbPath cursor is $updatedCursor
-            }
-          }
-          DOWN {
-            set linecount [llength [split $editorCode "\n"]]
-            set updatedCursor [updateCursor $cursor {y 1}]
-            set currentLineLength [getCurrentLineLength $editorCode $updatedCursor]
+    set timestamp [dict get $options timestamp]
 
-            if {[y $updatedCursor] == $linecount} {
-              Claim the $kbPath cursor is $cursor
-              return
-            } elseif {[x $updatedCursor] > $currentLineLength} {
-              Claim the $kbPath cursor is [list $currentLineLength  [y $updatedCursor]]
-            } else {
-              Claim the $kbPath cursor is $updatedCursor
-            }
+    if {$timestamp > ($startTime * 1000) && ($keyState == "down" || $keyState == "repeat")} {
+      # handle printable (character) input
+      if {[dict exists $options printable]} {
+        Commit "cursor$kbPath" {
+          Claim the $kbPath cursor is [updateCursor $cursor {x 1}]
+          Commit "code$kbPath" {
+            Claim $id has program code $code
+            Claim $id has editor code [insertCharacter $editorCode [dict get $options printable] $cursor]
           }
-          RIGHT {
-            set currentLineLength [getCurrentLineLength $editorCode $cursor]
-            if {[x $cursor] == $currentLineLength} {
-              if {[y $cursor] == [expr {[llength [split $editorCode "\n"]] - 1}]} {
+        }
+      } else {
+        Commit "cursor$kbPath" {
+          switch $key {
+            Up {
+              set updatedCursor [updateCursor $cursor {y -1}]
+              set currentLineLength  [getCurrentLineLength $editorCode $updatedCursor]
+              if {[x $updatedCursor] > $currentLineLength} {
+                Claim the $kbPath cursor is [list $currentLineLength  [y $updatedCursor]]
+              } else {
+                Claim the $kbPath cursor is $updatedCursor
+              }
+            }
+            Down {
+              set linecount [llength [split $editorCode "\n"]]
+              set updatedCursor [updateCursor $cursor {y 1}]
+              set currentLineLength [getCurrentLineLength $editorCode $updatedCursor]
+
+              if {[y $updatedCursor] == $linecount} {
                 Claim the $kbPath cursor is $cursor
+                return
+              } elseif {[x $updatedCursor] > $currentLineLength} {
+                Claim the $kbPath cursor is [list $currentLineLength  [y $updatedCursor]]
               } else {
-                set newCursor [updateCursor $cursor {y 1}]
-                Claim the $kbPath cursor is [list 0 [y $newCursor]]
+                Claim the $kbPath cursor is $updatedCursor
               }
-            } else {
-              Claim the $kbPath cursor is [updateCursor $cursor {x 1}]
             }
-          }
-          LEFT {
-            if {[x $cursor] == 0 && [y $cursor] == 0} {
-              Claim the $kbPath cursor is $cursor
-            } elseif {[x $cursor] == 0} {
-              set newCursor [updateCursor $cursor {y -1}]
-              set previousLineLength  [getCurrentLineLength $editorCode $newCursor]
-              set newCursor [list $previousLineLength [y $newCursor]]
-              Claim the $kbPath cursor is $newCursor
-            } else {
-              Claim the $kbPath cursor is [updateCursor $cursor {x -1}]
+            Right {
+              set currentLineLength [getCurrentLineLength $editorCode $cursor]
+              if {[x $cursor] == $currentLineLength} {
+                if {[y $cursor] == [expr {[llength [split $editorCode "\n"]] - 1}]} {
+                  Claim the $kbPath cursor is $cursor
+                } else {
+                  set newCursor [updateCursor $cursor {y 1}]
+                  Claim the $kbPath cursor is [list 0 [y $newCursor]]
+                }
+              } else {
+                Claim the $kbPath cursor is [updateCursor $cursor {x 1}]
+              }
             }
-          }
-          BACKSPACE {
-            # if cursor is at the beginning of the line, delete the newline
-            if {[x $cursor] == 0 && [y $cursor] > 0} {
-              set newCursor [updateCursor $cursor {y -1}]
-              set previousLineLength  [getCurrentLineLength $editorCode $newCursor]
-              set newCursor [list $previousLineLength [y $newCursor]]
-              Claim the $kbPath cursor is $newCursor
-            } else {
-              Claim the $kbPath cursor is [updateCursor $cursor {x -1}]
+            Left {
+              if {[x $cursor] == 0 && [y $cursor] == 0} {
+                Claim the $kbPath cursor is $cursor
+              } elseif {[x $cursor] == 0} {
+                set newCursor [updateCursor $cursor {y -1}]
+                set previousLineLength  [getCurrentLineLength $editorCode $newCursor]
+                set newCursor [list $previousLineLength [y $newCursor]]
+                Claim the $kbPath cursor is $newCursor
+              } else {
+                Claim the $kbPath cursor is [updateCursor $cursor {x -1}]
+              }
             }
-            Commit "code$kbPath" {
-              Claim $id has program code $code
-              Claim $id has editor code [deleteCharacter $editorCode $cursor]
+            Delete {
+              # if cursor is at the beginning of the line, delete the newline
+              if {[x $cursor] == 0 && [y $cursor] > 0} {
+                set newCursor [updateCursor $cursor {y -1}]
+                set previousLineLength  [getCurrentLineLength $editorCode $newCursor]
+                set newCursor [list $previousLineLength [y $newCursor]]
+                Claim the $kbPath cursor is $newCursor
+              } else {
+                Claim the $kbPath cursor is [updateCursor $cursor {x -1}]
+              }
+              Commit "code$kbPath" {
+                Claim $id has program code $code
+                Claim $id has editor code [deleteCharacter $editorCode $cursor]
+              }
             }
-          }
-          SPACE {
-            Claim the $kbPath cursor is [updateCursor $cursor {x 1}]
-            Commit "code$kbPath" {
-              Claim $id has program code $code
-              Claim $id has editor code [insertCharacter $editorCode " " $cursor]
+            Remove {
+              Claim the $kbPath cursor is $cursor
+              Commit "code$kbPath" {
+                Claim $id has program code $code
+                Claim $id has editor code [deleteCharacter $editorCode [updateCursor $cursor {x 1}]]
+              }
             }
-          }
-          ENTER {
-            set updatedCursor [updateCursor $cursor {y 1}]
-            Claim the $kbPath cursor is [list 0 [y $updatedCursor]]
-            Commit "code$kbPath" {
-              Claim $id has program code $code
-              Claim $id has editor code [insertNewline $editorCode $cursor]
+            Return {
+              set updatedCursor [updateCursor $cursor {y 1}]
+              Claim the $kbPath cursor is [list 0 [y $updatedCursor]]
+              Commit "code$kbPath" {
+                Claim $id has program code $code
+                Claim $id has editor code [insertNewline $editorCode $cursor]
+              }
             }
-          }
-          DELETE -
-          INSERT -
-          MUTE -
-          VOLUMEUP -
-          VOLUMEDOWN -
-          ESC -
-          TAB -
-          CAPSLOCK -
-          LEFTSHIFT -
-          RIGHTSHIFT -
-          LEFTALT -
-          RIGHTALT -
-          LEFTCTRL -
-          RIGHTCTRL {
-            # TODO: Implement DELETE, operates like BACKSPACE, but in the opposite direction
-            # TODO: MUTE VOLUMEUP VOLUMEDOWN
-            #       implement sound.folk that allows a system-wide 
-            #       volume setting to be adjusted.
-            #       Perhaps `Wish $system volume is 0.5` or something
-
-            Claim the $kbPath cursor is $cursor
-          }
-          default {
-            if {$modifier == "ctrl" & $currentCharacter == "p"} {
+            Control_p {
+              # TODO: Implement DELETE, operates like BACKSPACE, but in the opposite direction
+              # TODO: MUTE VOLUMEUP VOLUMEDOWN
+              #       implement sound.folk that allows a system-wide
+              #       volume setting to be adjusted.
+              #       Perhaps `Wish $system volume is 0.5` or something
               When $id has printed /lastPrintedCode/ at /previousTime/ {
                 if {($timestamp - $previousTime) < 1000} {
                   Commit "code$kbPath" {
@@ -308,7 +303,6 @@ When /page/ is a keyboard with path /kbPath/ & /page/ is an editor {
                     Claim $id has editor code $editorCode
                   }
                   Claim the $kbPath cursor is $cursor
-                  return
                 }
               }
 
@@ -320,43 +314,38 @@ When /page/ is a keyboard with path /kbPath/ & /page/ is an editor {
                 Claim $id has editor code $editorCode
               }
               Claim the $kbPath cursor is $cursor
-              return
             }
-            if {$modifier == "ctrl" & $currentCharacter == "r"} {
+            Control_r {
               Commit "code$kbPath" {
-                Claim $id has program code $baseCode 
-                Claim $id has editor code $baseCode 
+                Claim $id has program code $baseCode
+                Claim $id has editor code $baseCode
               }
               Claim the $kbPath cursor is [list 0 0]
-              return
             }
-            if {$modifier == "ctrl" & $currentCharacter == "s"} {
+            Control_s {
               Commit "code$kbPath" {
                 Claim $id has program code $editorCode
                 Claim $id has editor code $editorCode
               }
               Claim the $kbPath cursor is $cursor
-              return
             }
-            if {$modifier == "ctrl" & $currentCharacter == "a"} {
+            Control_a {
               Commit "code$kbPath" {
                 Claim $id has program code $code
                 Claim $id has editor code $editorCode
               }
               lassign $cursor x y
               Claim the $kbPath cursor is [list 0 $y]
-              return
             }
-            if {$modifier == "ctrl" & $currentCharacter == "e"} {
+            Control_e {
               Commit "code$kbPath" {
                 Claim $id has program code $code
                 Claim $id has editor code $editorCode
               }
               lassign $cursor x y
               Claim the $kbPath cursor is [list [getLineLength $editorCode $cursor] $y]
-              return
             }
-            if {$modifier == "ctrl" & $currentCharacter == "u"} {
+            Control_u {
               # delete from cursor back to 0 and move cursor to 0
               Commit "code$kbPath" {
                 Claim $id has program code $code
@@ -364,12 +353,9 @@ When /page/ is a keyboard with path /kbPath/ & /page/ is an editor {
               }
               lassign $cursor x y
               Claim the $kbPath cursor is [list 0 $y]
-              return
             }
-            Claim the $kbPath cursor is [updateCursor $cursor {x 1}]
-            Commit "code$kbPath" {
-              Claim $id has program code $code
-              Claim $id has editor code [insertCharacter $editorCode $currentCharacter $cursor]
+            default {
+              Claim the $kbPath cursor is $cursor
             }
           }
         }
diff --git a/virtual-programs/esc-restart.folk b/virtual-programs/esc-restart.folk
index 17b56163..1be6e0c7 100644
--- a/virtual-programs/esc-restart.folk
+++ b/virtual-programs/esc-restart.folk
@@ -1,3 +1,3 @@
-When keyboard /k/ claims key ESC is down with modifiers alt timestamp /any/ {
+When keyboard /k/ claims key Meta_Escape is down with timestamp /any/ {
 	exec sudo systemctl restart folk
 }
diff --git a/virtual-programs/keyboard.folk b/virtual-programs/keyboard.folk
index f28da39b..3faba7cd 100644
--- a/virtual-programs/keyboard.folk
+++ b/virtual-programs/keyboard.folk
@@ -1,4 +1,5 @@
 set ::debug_keyboard true
+source "lib/keymap.tcl"
 
 proc establishKeyPressListener {keyboard} {
     set kb [open $keyboard r]
@@ -42,69 +43,88 @@ proc walkInputEventPaths {} {
 }
 
 set keyboardDevices [walkInputEventPaths]
+set globalKeymap [keymap load "us"]
 
-# go through each keyboard device and start a process that 
+When /page/ is a keyboard with path /keyboard/ locale /locale/ {
+    Claim $page is a keyboard with path $keyboard
+}
+
+# go through each keyboard device and start a process that
 foreach keyboard $keyboardDevices {
     Claim the keyboards are $keyboardDevices
     Start process "keyboard-$keyboard" {
-        source "lib/key-codes.tcl"
+        source "lib/keymap.tcl"
         set KEY_STATES [list up down repeat]
 
         Wish $::thisProcess shares statements like \
-            [list keyboard /kb/ claims key /k/ is /t/ with modifiers /m/ timestamp /timestamp/]
+            [list keyboard /kb/ claims key /k/ is /t/ with /...options/]
+        Wish $::thisProcess receives statements like \
+            [list /someone/ claims /page/ is a keyboard with path $keyboard locale /locale/]
+
+        set ::localKeymap ""
+        When /page/ is a keyboard with path $keyboard locale /locale/ {
+            if {$::localKeymap ne ""} {keymap destroy $::localKeymap}
+            set ::localKeymap [keymap load $locale]
+            # @TODO: this races different locale on change
+            # On unmatch {
+            #     puts "KEYB LOCALE RESET"
+            #     keymap destroy $::localKeymap
+            #     set ::localKeymap ""
+            # }
+        }
+
+        Step
+
         variable evtBytes 16
         variable evtFormat iissi
         if {[exec getconf LONG_BIT] == 64} {
             set evtBytes 24
             set evtFormat wwssi
         }
-        set keyboardSpecifier $keyboard
 
         variable keyboardChannel [open $keyboard r]
         chan configure $keyboardChannel -translation binary
 
-        set modifiers [dict create \
-            shift 0 \
-            ctrl 0 \
-            alt 0 \
-        ]
+        set modifiers [dict map {k v} $keymap::modWeights {set v 0}]
         while 1 {
             binary scan [read $keyboardChannel $evtBytes] $evtFormat \
                 tvSec tvUsec type code value
 
             if {$type == 0x01} { ;# EV_KEY
-                set shift [dict get $modifiers shift]
-                set key [keyFromCode $code $shift]
+                Step
+
+                set activeKeymap [expr {$::localKeymap eq "" ? $globalKeymap : $::localKeymap}]
+                set mods [+ {*}[dict values $modifiers]]
+                lassign [keymap resolve $activeKeymap $code $mods] key keychar
                 if {$key eq ""} { continue }
 
                 set keyState [lindex $KEY_STATES $value]
 
                 set isDown [expr {$keyState != "up"}]
-                if {[string match *SHIFT $key]} {
-                    dict set modifiers shift $isDown
-                }
-                if {[string match *CTRL $key]} {
-                    dict set modifiers ctrl $isDown
-                }
-                if {[string match *ALT $key]} {
-                    dict set modifiers alt $isDown
+                if {[dict exists $keymap::modWeights $key]} {
+                    set weight [dict get $keymap::modWeights $key]
+                    dict set modifiers $key [expr {$isDown * $weight}]
                 }
 
-                set heldModifiers [dict keys [dict filter $modifiers value 1]]
                 set now [clock milliseconds]
-                Assert keyboard $keyboardSpecifier claims key $key is $keyState with \
-                                     modifiers $heldModifiers timestamp $now
+                if {$keychar eq ""} {
+                    Assert keyboard $keyboard claims key $key is $keyState with timestamp $now
+                } else {
+                    Assert keyboard $keyboard claims key $key is $keyState with timestamp $now printable $keychar
+                }
 
                 # Retract all key events that are more than 5 seconds old.
-                set events [Statements::findMatches [list keyboard $keyboardSpecifier claims key /key/ is /keyState/ with modifiers /ms/ timestamp /timestamp/]]
+                set events [Statements::findMatches [list keyboard $keyboard claims key /key/ is /keyState/ with /...options/]]
                 foreach event $events {
                     dict with event {
+                        set timestamp [dict get $options timestamp]
                         if {$now - $timestamp > 5000} {
-                            Retract keyboard $keyboardSpecifier claims key $key is $keyState with modifiers $ms timestamp $timestamp
+                            Retract keyboard $keyboard claims key $key is $keyState with {*}$options
                         }
                     }
                 }
 
+
                 Step
             }
         }
diff --git a/virtual-programs/terminal.folk b/virtual-programs/terminal.folk
index e5de23dd..38e304f4 100644
--- a/virtual-programs/terminal.folk
+++ b/virtual-programs/terminal.folk
@@ -77,10 +77,13 @@ When /anyone/ wishes /thing/ is a terminal spawning /cmd/ {
   }
 
   When /anyone/ claims $thing has keyboard input \
-    & keyboard /anyone/ claims key /key/ is /direction/ with modifiers /modifiers/ timestamp /timestamp/ {
+    & keyboard /anyone/ claims key /key/ is /direction/ with /...options/ {
     if {$direction != "up"} {
-      set ctrlPressed [expr {"ctrl" in $modifiers}]
-      Terminal::write $term $key $ctrlPressed
+      if {[dict exists $options printable]} {
+        Terminal::write $term [dict get $options printable]
+      } else {
+        Terminal::handleKey $term $key
+      }
     }
   }
 }
diff --git a/virtual-programs/web/web-keyboards.folk b/virtual-programs/web/web-keyboards.folk
index 6f18d962..54911b8f 100644
--- a/virtual-programs/web/web-keyboards.folk
+++ b/virtual-programs/web/web-keyboards.folk
@@ -23,16 +23,16 @@ When the keyboards are /keyboards/ {
           ws.onopen = () => {
             document.getElementById('status').innerHTML = "<span style=background-color:seagreen;color:white;>Connnected</span>";
             send(`
-              Assert when keyboard /kb/ claims key /k/ is down with modifiers /m/ timestamp /ts/ {{chan kb k m ts} {
+              Assert when keyboard /kb/ claims key /k/ is down with timestamp /ts/ printable /p/ {{chan kb k ts p} {
                 if {\$ts > [clock milliseconds]} {
-                  ::websocket::send \$chan text "\$kb||\$k"
+                  ::websocket::send \$chan text "\$kb||\$p"
                 }
               }} with environment \[list \$chan]
             `);
           };
           ws.onclose = window.onbeforeunload = () => {
             document.getElementById('status').innerHTML = "<span style=background-color:red;color:white;>Disconnnected</span>";
-            send(`Retract when keyboard /kb/ claims key /k/ is down with modifiers /m/ timestamp /ts/ /anything/ with environment \[list \$chan]`)
+            send(`Retract when keyboard /kb/ claims key /k/ is down with timestamp /ts/ printable /b/ /anything/ with environment \[list \$chan]`)
             setTimeout(() => { wsConnect(); }, 1000);
           };
           ws.onerror = (err) => {
@@ -41,8 +41,8 @@ When the keyboards are /keyboards/ {
             ws.close();
           }
           ws.onmessage = (msg) => {
-            const \[kb, key] = msg.data.split("||");
-            document.getElementById(kb + "-presses").innerText += key + " ";
+            const \[kb, p] = msg.data.split("||");
+            document.getElementById(kb + "-presses").innerText += p + " ";
           }
         };
         wsConnect();