Add beginning of multi-keyboard handling in keyboard process

2 files changed, 20 insertions, 126 deletions

diff --git a/virtual-programs/editor.folk b/virtual-programs/editor.folk
index 705bcd39..4f9945c3 100644
--- a/virtual-programs/editor.folk
+++ b/virtual-programs/editor.folk
@@ -2,9 +2,7 @@ set id "editor-1"
 set ::debug_cursor false
 set ::debug_print false
 
-# When /page/ is editor /n/ & /page/ has region /r/ {
 When /page/ is a keyboard with path /kbPath/ & /page/ has region /r/ {
-    # Claim $this is a keyboard with path /dev/input/by-path/platform-i8042-serio-0-event-kbd
     Wish $page is outlined gray
     Claim $id has region [region move $r up 450px]
 }
@@ -378,9 +376,5 @@ Every time keyboard claims key /currentCharacter/ is down with modifiers /modifi
 }
 
 Claim $this has demo {
-  # Tape this program underneath the main keyboard of your system to try it out
-  Claim $this is editor editor-1
-
-  # Ideally:
   Claim $this is keyboard with path /dev/input/by-path/platform-i8042-serio-0-event-kbd
 }
diff --git a/virtual-programs/keyboard.folk b/virtual-programs/keyboard.folk
index ef122eec..41b2c1f8 100644
--- a/virtual-programs/keyboard.folk
+++ b/virtual-programs/keyboard.folk
@@ -1,123 +1,23 @@
 set ::debug_keyboard true
 
-# TODO: Make this respond to a keyboard being plugged in or unplugged
-# TODO: Make this the main keyboard logic and change keyboard.tcl to just use utilities from in here or from some share utils/keyboard.tcl
-
-When /someone/ claims /keyboardPage/ is a keyboard with path /kbPath/ {
-    # (2023-11-07) on folk0 this is /dev/input/by-path/platform-i8042-serio-0-event-kbd
-    # (2023-11-08) on folk-convivial this is /dev/input/by-path/pci-0000:04:00.3-usb-0:3:1.0-event-kbd
-    Wish $keyboardPage is outlined white
-    Wish $keyboardPage is labelled "\n\n\n\n\n\n$kbPath"
-
-    set keyboardDevices [list]
-
-    # Get udevadm information for the device
-    set deviceInfo [exec udevadm info --query=property --name=$kbPath]
-
-    # Check if it's a keyboard by looking for "ID_INPUT_KEYBOARD=1" in the udevadm output
-    if {[string first "ID_INPUT_KEYBOARD=1" $deviceInfo] >= 0} {
-        # It's a keyboard, add to list of keyboard devices
-        if {$::debug_keyboard} {
-            Wish $this is labelled "---------\ngot device $kbPath"
-        }
-       
-        lappend keyboardDevices $kbPath
-
-        if {[file readable $kbPath] == 0} {
-            puts "Device $kbPath is not readable. Attempting to change permissions."
-            # Attempt to change permissions so that the file can be read
-            exec sudo chmod +r $device
-        }
-
-        Claim $kbPath is a valid keyboard
+Start process "keyboard" {
+  Wish $::thisProcess shares statements like \
+    [list /someone/ claims /node/ has keyboards /...anything/]
+  Wish $::thisProcess shares statements like \
+    [list /someone/ claims the default keyboard is /defaultKb/]
+
+  source "pi/Keyboard.tcl"
+
+  set keyboardDevices [Keyboard::walkInputEventPaths]
+
+  puts "=========== keyboard info block =============="
+  puts "Found [llength $keyboardDevices] keyboards:"
+  foreach keyboard $keyboardDevices {
+    puts " * eventpath: [dict get $keyboard eventPath]"
+    foreach devlink [dict get $keyboard devLinks] {
+          puts " ** : $devlink"
     }
-}
-
-proc getKeyEvent {kb} {
-    variable evtBytes
-    variable evtFormat
-
-    # See https://www.kernel.org/doc/Documentation/input/input.txt
-    # https://www.kernel.org/doc/Documentation/input/event-codes.txt
-    # https://github.com/torvalds/linux/blob/master/include/uapi/linux/input-event-codes.h
-    #
-    # struct input_event {
-    #     struct timeval time;
-    #     unsigned short type; (should be EV_KEY = 0x01)
-    #     unsigned short code; (scancode; for example, 16 = q)
-    #     unsigned int value; (0 for key release, 1 for press, 2 for repeat)
-    # };
-    #
-    while 1 {
-        binary scan [read $kb $evtBytes] $evtFormat tvSec tvUsec type code value
-        if {$type == 0x01} {
-            return [list $code $value]
-        }
-    }
-}
-
-When /keyboard/ is a valid keyboard {
-  set kb [open $keyboard r]
-  fconfigure $kb -translation binary
-
-    variable evtBytes 16
-    variable evtFormat iissi
-    if {[exec getconf LONG_BIT] == 64} {
-      set evtBytes 24
-      set evtFormat wwssi
-    }
-
-  Wish $this is labelled "$kb"; # Hmmmm, this crashes Folk ;# \n---\n [getKeyEvent $kb]"
-  # write to the statement DB a stream of millisecond timecodes and keys e.g.
-  #    123450 platform-i8042-serio-0-event-kbd H
-  #    123451 platform-i8042-serio-0-event-kbd e
-  #    123452 platform-i8042-serio-0-event-kbd l
-  #    123453 platform-i8042-serio-0-event-kbd l
-  #    123454 platform-i8042-serio-0-event-kbd o
-}
-
-Claim $this has demo {
-	# TODO: Move this out into the top of keyboard.folk, I think? (2023-11-09 @cwervo)
-	# Keyboard detection functions
-	proc udevadm_properties {device} {
-	    set status [catch {exec udevadm info --query=property --name=$device} result]
-	    if {$status == 0} {
-		return $result
-	    } else {
-		return ""
-	    }
-	}
-
-	proc is_keyboard {device} {
-	    set properties [udevadm_properties $device]
-	    if {$properties eq ""} {
-		return false
-	    }
-	    # Check if device is a keyboard and not a mouse
-	    set isKeyboard [string match *ID_INPUT_KEYBOARD=1* $properties]
-	    set isMouse [string match *ID_INPUT_MOUSE=1* $properties]
-	    return [expr {$isKeyboard && !$isMouse}]
-	}
-
-	set result [exec ls /dev/input/by-path]
-	set keyboards [list]
-
-	foreach device $result {
-	  set fullDevice "/dev/input/by-path/$device"
-	  set keyboardCheck [is_keyboard $fullDevice]
-	  # Only add the device to the list if it is a keyboard
-	  if {$keyboardCheck} {
-	    # lappend keyboards "$device // \n[udevadm_properties $fullDevice]\n"
-	    lappend keyboards $fullDevice
-	  }
-	}
-
-	# The following lines seem to be pseudo-code or comments, they should be removed or corrected
-	Wish $this is outlined white
-
-	foreach kb $keyboards {
-	  Wish $this is labelled "----- $kb"
-	  Claim $this is a keyboard with path $kb
-	  Wish $this draws a circle with color navy filled true radius 10
-	}
-}
+  }
+  Claim the default keyboard is [lindex $keyboardDevices 0]
+  Claim $::thisNode has keyboards $keyboardDevices
+}
\ No newline at end of file