First commit!

2 files changed, 180 insertions, 0 deletions

diff --git a/.dir-locals.el b/.dir-locals.el
new file mode 100644
index 0000000..376ba53
--- /dev/null
+++ b/.dir-locals.el
@@ -0,0 +1,4 @@
+((scheme-mode
+  .
+  ((eval . (put 'call-with-pin 'scheme-indent-function 1))
+   (eval . (put 'with-pins 'scheme-indent-function 1)))))
diff --git a/gpio.scm b/gpio.scm
new file mode 100644
index 0000000..ca51064
--- /dev/null
+++ b/gpio.scm
@@ -0,0 +1,176 @@
+;;; guile-gpio --- Guile interface to the Linux GPIO Sysfs API
+;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;;
+;;; This file is part of guile-gpio.
+;;;
+;;; Guile-gpio is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU Lesser General Public License as
+;;; published by the Free Software Foundation; either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; Guile-gpio is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with guile-gpio.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Wrapper over the Linux GPIO Sysfs API.
+;;
+;;; Code:
+
+(define-module (gpio)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-9)
+  #:export (make-pin
+            pin?
+            interrupt-generating-pin?
+            pin-number
+            pin-exported?
+            pin-export!
+            pin-unexport!
+            pin-high?
+            pin-low?
+            pin-set!
+            pin-edge
+            set-pin-edge!
+            pin-direction
+            set-pin-direction!
+            call-with-pin
+            with-pins))
+
+(define-record-type <pin>
+  (make-pin number)
+  pin?
+  (number pin-number))
+
+(define %gpio-sysfs "/sys/class/gpio")
+
+(define (read-boolean port)
+  "Read boolean value, as specified by the GPIO Sysfs API, from PORT.
+The value is represented as a single character: \"1\" for true and
+\"0\" for false, naturally."
+  (eqv? (read-char port) #\1))
+
+(define (pin-directory pin)
+  "Return the directory name associated with PIN in the GPIO Sysfs
+interface."
+  (string-append %gpio-sysfs "/gpio" (number->string (pin-number pin))))
+
+(define (pin-value-file pin)
+  "Return the file name where the value of PIN is stored."
+  (string-append (pin-directory pin) "/value"))
+
+(define (pin-edge-file pin)
+  "Return the file name where the edge of PIN is stored."
+  (string-append (pin-directory pin) "/edge"))
+
+(define (pin-direction-file pin)
+  "Return the file name where the direction of PIN is stored."
+  (string-append (pin-directory pin) "/direction"))
+
+(define (pin-exported? pin)
+  "Return #t if PIN has been exported, meaning that it can be
+manipulated in userspace."
+  (file-exists? (pin-directory pin)))
+
+(define pin-export!
+  (let ((export-file (string-append %gpio-sysfs "/export")))
+    (lambda (pin)
+      "Export PIN so that it may be manipulated in userspace."
+      (call-with-output-file export-file
+        (lambda (port)
+          (display (number->string (pin-number pin)) port))))))
+
+(define pin-unexport!
+  (let ((unexport-file (string-append %gpio-sysfs "/unexport")))
+    (lambda (pin)
+      "Relinquish userspace control of PIN."
+      (call-with-output-file unexport-file
+        (lambda (port)
+          (display (number->string (pin-number pin)) port))))))
+
+(define (pin-high? pin)
+  "Return if PIN is set to a high value."
+  (call-with-input-file (pin-value-file pin) read-boolean))
+
+(define (pin-low? pin)
+  "Return #t if PIN is set to a low value."
+  (not (pin-high? pin)))
+
+(define (pin-set! pin high?)
+  "Set PIN to a high value if HIGH?, otherwise set PIN to a low
+value."
+  (call-with-output-file (pin-value-file pin)
+    (lambda (port)
+      (display (if high? "1" "0") port))))
+
+(define (interrupt-generating-pin? pin)
+  "Return #t if PIN is capable of generating interrupts."
+  (file-exists? (pin-edge-file pin)))
+
+(define (pin-edge pin)
+  "Return the signal edges of PIN that trigger interrupts.  The edge
+type may be one of four possible values: none, rising, falling, or
+both."
+  (call-with-input-file (pin-edge-file pin) read))
+
+(define (set-pin-edge! pin edge)
+  "Set the signal EDGE type for PIN that will trigger an interrupt.
+The edge type may be one of four possible values: none, rising,
+falling, or both.  PIN must be an input pin."
+  (match edge
+    ((or 'none 'rising 'falling 'both)
+     (call-with-output-file (pin-edge-file pin)
+       (lambda (port)
+         (write edge port))))))
+
+(define (pin-direction pin)
+  "Return the direction of PIN, either 'in' or 'out'."
+  (call-with-input-file (pin-direction-file pin) read))
+
+(define (set-pin-direction! pin direction)
+  "Set the direction of PIN to DIRECTION, either 'in' or 'out'."
+  (match direction
+    ((or 'in 'out)
+     (call-with-output-file (pin-direction-file pin)
+       (lambda (port)
+         (write direction port))))))
+
+(define* (call-with-pin number proc #:key direction edge)
+  "Import GPIO pin NUMBER and apply PROC with an object representing
+that pin.  When PROC exits, the pin is unexported.  If DIRECTION is
+specified, set the pin to that direction, otherwise use the system
+default.  If EDGE is specified, set the pin to that edge, otherwise
+use the system default.  Only interrupt generating input pins may
+specify a value for EDGE."
+  (let ((pin (make-pin number)))
+    ;; Try to export before entering the dynamic-wind.  This way, if
+    ;; the pin was already exported it won't be automatically
+    ;; unexported, potentially screwing up some other process that was
+    ;; using it.
+    (pin-export! pin)
+    (dynamic-wind
+      (const #t)
+      (lambda ()
+        ;; It's important to set the direction first, because only
+        ;; input pins may set their edge.
+        (when direction (set-pin-direction! pin direction))
+        (when edge (set-pin-edge! pin edge))
+        (proc pin))
+      (lambda ()
+        (pin-unexport! pin)))))
+
+(define-syntax with-pins
+  (syntax-rules ()
+    ((_ () body ...)
+     (begin body ...))
+    ((_ ((name number kwargs ...) . rest) body ...)
+     (call-with-pin number
+       (lambda (name)
+         (with-pins rest body ...))
+       kwargs ...))))