chiark / gitweb /
found in bessar:/etc (davenant:~/things/Bessar/...)
authorian <ian>
Mon, 16 Jun 2008 01:24:27 +0000 (01:24 +0000)
committerian <ian>
Mon, 16 Jun 2008 01:24:27 +0000 (01:24 +0000)
hostside/eventrun [new file with mode: 0755]

diff --git a/hostside/eventrun b/hostside/eventrun
new file mode 100755 (executable)
index 0000000..515e7bb
--- /dev/null
@@ -0,0 +1,106 @@
+#!/usr/bin/tclsh8.3
+
+proc do_scancode {sc} {
+    upvar #0 evmap($sc) em
+    if {[info exists em]} {
+       puts "=$sc $em"
+       uplevel #0 $em
+    } else {
+       puts "=$sc ???"
+    }
+}
+
+proc onevtest {} {
+    global evtest evmap state scancode
+    if {[gets $evtest l] < 0} {
+       if {![eof $evtest]} return
+       exit 0
+    }
+    set sl $state-$l
+    if {[regexp {^I-Testing.*interrupt to exit} $sl]} {
+       puts "*   $sl"
+       set state 0
+       upvar #0 evmap(INIT) em
+       if {[info exists em]} {
+           uplevel #0 $em
+       }
+       return
+    }
+    if {[regexp {^I.*} $sl]} {
+       puts "    $sl"
+       return
+    }
+    if {![regexp {^Event\: time \d+\.\d+,( .*)} $l dummy r]} {
+       puts "    $sl"
+       return
+    }
+    set sr [string trimright $state-$r]
+    if {[regexp {^[01]- type 4 \(Misc\)\, code 4 \(ScanCode\), value (\w+)$} \
+           $sr dummy scancode]} {
+       puts ">$scancode $sl"
+       set state 1 
+   } elseif {[regexp {^1- type 1 \(Key\), code \d+ \(\w+\), value (\w+)$}\
+          $sr dummy updown]} {
+       if {[regexp {[^0]} $updown]} {
+           do_scancode $scancode
+       } else {
+           puts "!$scancode $sl"
+       }
+       set scancode ??
+       set state 0
+    } elseif {[regexp {^0- type 20 \(Repeat\),} $sr]} {
+       puts "  $sl"
+       return
+    } elseif {[regexp {^0\- \-\-+ Report Sync \-\-+$} $sr]} {
+       puts "  $sl"
+       return
+    } elseif {[regexp {^1\- \-\-+ Report Sync \-\-+$} $sr]} {
+       if {![regexp {0000$} $scancode]} { do_scancode _$scancode }
+       puts "_ $sl"
+       set scancode ??
+       set state 0
+    } else {
+       puts stderr "unknown >$sl|$sr<"
+    }
+}   
+
+proc setup {} {
+    global evtest state scancode
+    set kbdinput [exec /etc/find-kbd-event < /proc/bus/input/devices]
+    set cmdl [list /u/ian/things/Bessar/evtest /dev/input/$kbdinput]
+    lappend cmdl 2>@ stderr
+    set evtest [open |$cmdl r]
+    set state I
+    set scancode ??
+    fconfigure $evtest -blocking no
+    fileevent $evtest readable onevtest
+}
+
+proc bgerror {m} {
+    if {[catch {
+       global errorInfo errorCode
+       puts stderr "$m\n$errorCode\n$errorInfo"
+       fail "bgerror $m"
+    } emsg]} {
+       exit 127
+    }
+}
+
+proc parsespecinput {fn} {
+    global evmap
+    set f [open $fn r]
+    while {[gets $f l] >= 0} {
+       set l [string trim $l]
+       if {[regexp {^(\w+)\s+(.*)$} $l dummy scancode action]} {
+           set evmap($scancode) $action
+       } elseif {[regexp {^\#} $l] || ![regexp {\S} $l]} {
+       } else {
+           error "bad spec line $l"
+       }
+    }
+}
+
+parsespecinput [lindex $argv 0]
+setup
+
+vwait end