Merge pull request #86 from FolkComputer/ac/editor

Add keyboard editor claim

4 files changed, 484 insertions, 29 deletions

diff --git a/virtual-programs/editor.folk b/virtual-programs/editor.folk
new file mode 100644
index 00000000..0b77bc7f
--- /dev/null
+++ b/virtual-programs/editor.folk
@@ -0,0 +1,374 @@
+set ::debug_print false
+set baseCode "Wish \$this is outlined green"
+
+# This makes all keyboards into editors automatically, so a keyboard
+# doesn't need an extra printed claim to be an editor. May choose to
+# change later, or exclude keyboards that opt out.
+When /page/ is a keyboard with path /anything/ {
+    Claim $page is an editor
+}
+
+When /page/ is a keyboard with path /kbPath/ & /page/ is an editor & /page/ has region /r/ {
+  set id "$page$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 
+    }
+  }
+}
+
+proc updateCursor {oldCursor updates} {
+  set newCursor $oldCursor
+  if {[dict exists $updates x]} {
+    lset newCursor 0 [expr {max(0, [dict get $updates x] + [x $oldCursor])}]
+  }
+  if {[dict exists $updates y]} {
+    lset newCursor 1 [expr {max(0, [dict get $updates y] + [y $oldCursor])}]
+  }
+  return $newCursor
+}
+
+# NOTE: Should this go into a common-functions file?
+proc x {vector} { lindex $vector 0 }
+proc y {vector} { lindex $vector 1 }
+
+When /page/ is a keyboard with path /kbPath/ & /page/ is an editor {
+  set id "$page$kbPath"
+  When /nobody/ claims $id has program code /c/ {
+    Commit "cursor$kbPath" {
+      Claim the $kbPath cursor is [list 0 0]
+    }
+  }
+}
+
+proc insertCharacter {code newCharacter cursor} {
+  set lines [split $code "\n"]
+  lassign $cursor x y
+  set x [- $x 1]
+  set line [lindex $lines $y]
+
+  if {$x < 0} {
+    lset lines $y [string cat $newCharacter $line]
+    return [join $lines "\n"]
+  } else {
+    set character [string cat [string index $line $x] $newCharacter]
+    set line [string replace $line $x $x $character]
+    lset lines $y $line
+    return [join $lines "\n"]
+  }
+}
+
+proc deleteCharacter {code cursor} {
+  set lines [split $code "\n"]
+  lassign $cursor x y
+  if {$x == 0 && $y > 0} {
+    set previousLine [lindex $lines [expr {$y - 1}]]
+    set thisLine [lindex $lines $y]
+    set mergedLine [string cat $previousLine $thisLine]
+    lset lines [expr {$y - 1}] $mergedLine
+    lset lines $y ""
+    set newLines {}
+    for {set i 0} {$i < [llength $lines]} {incr i} {
+      if {$i != $y} {
+        lappend newLines [lindex $lines $i]
+      }
+    }
+    set lines $newLines
+  } else {
+    set line [lindex $lines $y]
+    set line [string replace $line [expr {$x - 1}] [expr {$x - 1}] ""]
+    lset lines $y $line
+  }
+  return [join $lines "\n"]
+}
+
+proc deleteToBeginning {code cursor} {
+  set lines [split $code "\n"]
+  lassign $cursor x y
+  set line [lindex $lines $y]
+  set newLine [string range $line $x end]
+  lset lines $y $newLine
+  return [join $lines "\n"]
+}
+
+proc insertNewline {code cursor} {
+  set lines [split $code "\n"]
+  lassign $cursor x y
+  set line [lindex $lines $y]
+  set beforeCursor [string range $line 0 [expr {$x - 1}]]
+  set afterCursor [string range $line $x end]
+  set newLines [list $beforeCursor $afterCursor]
+  lset lines $y [join $newLines "\n"]
+  return [join $lines "\n"]
+}
+
+proc getLineLength {code cursor} {
+  set lines [split $code "\n"]
+  set line [lindex $lines [lindex $cursor 1]]
+  set ll [string length $line]
+  return $ll
+}
+
+proc lineNumberView {ystart linecount} {
+  set yend [expr {$ystart + $linecount}]
+  set numbers [list]
+  for {set i [expr {$ystart + 1}]} {$i <= $yend} {incr i} {
+    lappend numbers $i
+  }
+  join $numbers "\n"
+}
+
+proc debug {position color} {
+  Display::circle {*}$position 5 2 $color true
+}
+
+When /page/ is a keyboard with path /kbPath/ & /page/ is an editor {
+  set id "$page$kbPath"
+  When $id has program code /code/ & $id has editor code /editorCode/ & the clock time is /t/ & the $kbPath cursor is /cursor/ & $id has region /r/ {
+    set intTime [expr {int($t * 10)}]
+    set scale 0.60
+
+    set relativeRegion [region move $r down 105%]
+    Claim $id' has region $relativeRegion
+    Wish $id' is outlined white
+    lassign [region topleft $r] xstart ystart
+    set em [expr {$scale * 25}]
+    # From NeomatrixCode.csv
+    set advance [expr {0.5859375 * $em}]
+    set margin [expr {$advance * 3 + 10}]
+
+    set p [region topleft [region move $relativeRegion right ${margin}px down 10px]]
+    set lp [region topleft [region move $relativeRegion right 5px down 10px]]
+    set height [expr {[region height $relativeRegion] - 25}]
+    set width [expr {[region width $relativeRegion] - ($margin + 20)}]
+    set radians [region angle $relativeRegion]
+
+    set curs [vec2 scale $cursor $advance $em]
+
+    set x1 [vec2 sub $p $curs]
+    set x2 [vec2 sub $x1 [list 0 [expr {$em + 4}]]]
+
+    set theta [expr {$radians + 3.14159}]
+    set x1 [vec2 add [vec2 rotate [vec2 sub $x1 $p] $theta] $p]
+    set x2 [vec2 add [vec2 rotate [vec2 sub $x2 $p] $theta] $p]
+    set s [expr {$scale * 4}]
+
+    # Draw text
+    Wish to draw text with position $p text $editorCode scale $scale anchor topleft radians [region angle $relativeRegion] font NeomatrixCode
+
+    # Draw line numbers
+    set linecount [llength [split $editorCode "\n"]]
+    set linenumbers [lineNumberView 0 $linecount]
+    Wish to draw text with position $lp text $linenumbers scale $scale anchor topleft radians $radians font NeomatrixCode
+
+    # Draw cursor
+    Wish to draw a circle with center $x1 radius $s thickness 0 color green filled true
+    Wish to draw a stroke with points [list $x1 $x2] width $s color green
+  }
+}
+
+proc getCurrentLineLength {lines cursor} {
+  set splitLines [split $lines "\n"]
+  set currentLine [lindex $splitLines [y $cursor]]
+  string length $currentLine
+}
+
+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/ &\
+             the $kbPath cursor is /cursor/ &\
+             $id has program code /code/ &\
+             $id has editor code /editorCode/ {
+    if {$keyState == "down" || $keyState == "repeat"} {
+      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]
+
+            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
+            }
+          }
+          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}]
+            }
+          }
+          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}]
+            }
+          }
+          BACKSPACE {
+            # if cursor is at the beginning of the line, delete the newline
+            if {[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]
+            }
+          }
+          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]
+            }
+          }
+          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]
+            }
+          }
+          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"} {
+              # TODO: Save time instead and prevent printing the same code within the same ... second?
+              When $id has printed /lastPrintedCode/ {
+                if {$lastPrintedCode == $code} {
+                  Claim the $kbPath cursor is $cursor
+                  if {$::debug_print} {
+                    puts "Not printing the same code twice"
+                  }
+                  return
+                }
+              }
+              When /nobody/ has printed /lastPrintedCode/ {
+                if {$::debug_print} {
+                  puts "Printing $code"
+                }
+                Commit print { Claim $id has printed $code}
+                Wish to print $code with job id [expr {rand()}]
+                return
+              }
+              Commit "code$kbPath" {
+                Claim $id has program code $code
+                Claim $id has editor code $editorCode
+              }
+              Claim the $kbPath cursor is $cursor
+              return
+            }
+            if {$modifier == "ctrl" & $currentCharacter == "r"} {
+              Commit "code$kbPath" {
+                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"} {
+              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"} {
+              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"} {
+              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"} {
+              # delete from cursor back to 0 and move cursor to 0
+              Commit "code$kbPath" {
+                Claim $id has program code $code
+                Claim $id has editor code [deleteToBeginning $editorCode $cursor]
+              }
+              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]
+            }
+          }
+        }
+      }
+    }
+  }
+}
+
+Claim $this has demo {
+  # Find your keyboard path with the script in this guide: https://folk.computer/guides/keyboard
+  Claim $this is a keyboard with path /dev/input/by-path/pci-0000:02:00.0-usb-0:2:1.2-event-mouse
+  Claim $this is an editor
+}
diff --git a/virtual-programs/esc-restart.folk b/virtual-programs/esc-restart.folk
index ee8aa847..17b56163 100644
--- a/virtual-programs/esc-restart.folk
+++ b/virtual-programs/esc-restart.folk
@@ -1,3 +1,3 @@
-When keyboard claims key ESC is down with modifiers alt {
+When keyboard /k/ claims key ESC is down with modifiers alt timestamp /any/ {
 	exec sudo systemctl restart folk
 }
diff --git a/virtual-programs/keyboard.folk b/virtual-programs/keyboard.folk
index a49ac29e..9746af91 100644
--- a/virtual-programs/keyboard.folk
+++ b/virtual-programs/keyboard.folk
@@ -1,36 +1,116 @@
-return
-if {!$::isLaptop} { return }
-Wish $this is outlined skyblue
+set ::debug_keyboard true
 
-Wish $this has neighbors
+proc udevadmProperties {device} {
+    return [exec udevadm info --query=property --name=$device]
+}
 
-global pageOrigin neighborAbove
+proc establishKeyPressListener {keyboard} {
+    set kb [open $keyboard r]
+    fconfigure $kb -translation binary
+    return $kb
+}
 
-set ::neighborAbove none
+# Function to check if the device is a keyboard
+proc isKeyboard {device} {
+    set properties [udevadmProperties $device]
+    if {$properties eq ""} {
+        return false
+    }
+    set isKeyboard [string match *ID_INPUT_KEYBOARD=1* $properties]
+    return $isKeyboard
+    # TODO: Excluding mice would nice to keey the list of keyboard devices short
+    #       Alas, including mice is necessary for the Logitech K400R keyboard
+    # set isMouse [string match *ID_INPUT_MOUSE=1* $properties]
+    # return [expr {$isKeyboard && !$isMouse}]
+}
 
-When $this has region /r/ {
-	lassign [lindex $r 0] one
-        set ::pageOrigin $one
+####
+# /dev/input/event* addresses are the ground truth for keyboard devices
+#
+# This function goes through each of them and checks if they are keyboards
+proc walkInputEventPaths {} {
+    # set allDevices [glob -nocomplain "/dev/input/event*"]
+    set allDevices [glob -nocomplain "/dev/input/by-path/*"]
+    set keyboards [list]
+    foreach device $allDevices {
+        if {[isKeyboard $device]} {
+            if {[file readable $device] == 0} {
+                puts "Device $device is not readable. Attempting to change permissions."
+                # Attempt to change permissions so that the file can be read
+                exec sudo chmod +r $device
+            }
+            lappend keyboards $device
+        }
+    }
+    return $keyboards
 }
 
+set keyboardDevices [walkInputEventPaths]
 
-When $this has neighbor /n/ {
-    Wish $n is outlined thick papayawhip
-    # Wish $this is labelled $::pageOrigin
-    When $n has region /r/ {
-      set neighborOrigin [lindex [lindex $r 0] 0]
-      lassign $neighborOrigin _ nOriginY
-      lassign $pageOrigin _ pageOriginY
-      if {$nOriginY < $pageOriginY} {
-        set ::neighborAbove $n
-        variable neighborCode none
-        When $neighborAbove has program code /c/ {
-          set neighborCode $c
-          Wish $neighborAbove is labelled "$neighborCode"
+# go through each keyboard device and start a process that 
+foreach keyboard $keyboardDevices {
+    Claim the keyboards are $keyboardDevices
+    Start process "keyboard-$keyboard" {
+        source "pi/KeyCodes.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/]
+        variable evtBytes 16
+        variable evtFormat iissi
+        if {[exec getconf LONG_BIT] == 64} {
+            set evtBytes 24
+            set evtFormat wwssi
         }
-        When the keyboard character log is /k/ {
-          Wish $this is labelled $k
+        set keyboardSpecifier $keyboard
+
+        variable keyboardChannel [open $keyboard r]
+        chan configure $keyboardChannel -translation binary
+
+        set modifiers [dict create \
+            shift 0 \
+            ctrl 0 \
+            alt 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]
+                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
+                }
+
+                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
+
+                # 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/]]
+                foreach event $events {
+                    dict with event {
+                        if {$now - $timestamp > 5000} {
+                            Retract keyboard $keyboardSpecifier claims key $key is $keyState with modifiers $ms timestamp $timestamp
+                        }
+                    }
+                }
+
+                Step
+            }
         }
-      }
     }
-}
\ No newline at end of file
+}
diff --git a/virtual-programs/label.folk b/virtual-programs/label.folk
index 2a4458ad..88a86c18 100644
--- a/virtual-programs/label.folk
+++ b/virtual-programs/label.folk
@@ -21,7 +21,8 @@ fn text {coords text angle} {
 
 When /anyone/ wishes /p/ has halo message /message/ & /p/ has region /r/ {
   lassign [lindex $r 0] a b c d
+  set angle [region angle $r]
   lassign $a x y
-  text [list [lindex $a 0] [expr {[lindex $a 1] - 50}]] $message 0
-  text [list [lindex $d 0] [expr {[lindex $d 1] + 50}]] $message 3.1415
+  text [list [lindex $a 0] [expr {[lindex $a 1] - 50}]] $message $angle
+  text [list [lindex $d 0] [expr {[lindex $d 1] + 50}]] $message [+ 3.1415 $angle]
 }