summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.dir-locals.el4
-rw-r--r--gpio.scm176
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 ...))))