diff options
| -rw-r--r-- | .dir-locals.el | 4 | ||||
| -rw-r--r-- | gpio.scm | 176 |
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 ...)))) |