Soothing GPIO Light Changer in Racket

gpio.rkt

#lang racket/base

#|

Three color LED connected to RPi GPIO pins 2 3 4.

The process is pretty straightforward.

1. Use FFI to get open and mmap /dev/gpiomem
2. Use FFI ptr-ref and ptr-set! to change the gpio registers

I wrote this before finding that Sam Tobin-Hochstadt has a mmap package on the package
server.  Unfortunately as of this writing I don't think that package works with
RacketCS.

https://pkgs.racket-lang.org/package/mmap

|#

(require ffi/unsafe
         ffi/unsafe/define)

(define-ffi-definer define-libc (ffi-lib #f))

;; hardwire open setting O_RDWR
(define-libc open
  (_fun _string [_int = 2] -> _int))

(define-libc close
  (_fun _int -> _int))

;; hardwire most of these mmap settings
(define-libc mmap
  (_fun [_pointer = #f]
        [_size    = 4096]
        ;; PROT_READ + PROT_WRITE
        [_int     = (+ #x01 #x02)]
        ;; MAP_SHARED
        [_int     = #x01]
        _int
        [_int = 0]
        ->
        _pointer))

(define gpiomem-fd (open "/dev/gpiomem"))
(when (zero? gpiomem-fd)
  (error "oops"))
(define gpiomem (mmap gpiomem-fd))
(void (close gpiomem-fd))

(define (fsel-mask/invert pin)
  (bitwise-and #xFFFFFFFF (bitwise-not (arithmetic-shift #b111 (* 3 pin)))))

(define (fsel-set reg pin val)
  (bitwise-ior
    (bitwise-and reg (fsel-mask/invert pin))
    (arithmetic-shift val (* 3 pin))))

(define (fsel-ref reg pin)
  (define i (* pin 3))
  (define j (+ i 3))
  (bitwise-bit-field reg i j))

;; set up pins 2 3 4 for output
(let* ([fsel0 (ptr-ref gpiomem _uint32 0)]
       [reg (fsel-set fsel0 2 #b001)]
       [reg (fsel-set reg 3 #b001)]
       [reg (fsel-set reg 4 #b001)])
  (ptr-set! gpiomem _uint32 0 reg))

(define (lamp-on pin)
  (ptr-set! gpiomem _uint32 7 (arithmetic-shift 1 pin)))

(define (lamp-off pin)
  (ptr-set! gpiomem _uint32 10 (arithmetic-shift 1 pin)))

(define (color pin)
  (values (lambda () (lamp-on pin))
          (lambda () (lamp-off pin))))

(define-values (blue-on blue-off)   (color 2))
(define-values (green-on green-off) (color 3))
(define-values (red-on red-off)     (color 4))

(define state (vector #f #f #f))

(define (flip! i)
  (define old (vector-ref state i))
  (define new (not old))
  (vector-set! state i new)
  new)

(define (lamps-update! i s)
  (define f (if s lamp-on lamp-off))
  (f (+ 2 i)))

(define (run)
  (define i (random 3))
  (define new (flip! i))
  (lamps-update! i new)
  (sleep (add1 (* (random) 4)))
  (run))

(module* main #f
  (define (all-off)
    (ptr-set! gpiomem _uint32 10 (arithmetic-shift #b111 2 )))

  (dynamic-wind void run all-off))