2019-07-02 03:01:10 +00:00
|
|
|
#lang racket
|
|
|
|
|
2019-07-02 05:27:33 +00:00
|
|
|
;; this file simulates the hardware necessary to test the keyboard firmware,
|
|
|
|
;; because doing actual development on an atmega32u4 is nightmarishly tedious.
|
|
|
|
|
2019-07-02 03:01:10 +00:00
|
|
|
(define pins (make-vector 20))
|
|
|
|
(define keys (make-vector 44 #f))
|
|
|
|
|
2019-07-02 05:27:33 +00:00
|
|
|
(define output void) ; don't bother to simulate pin modes
|
2019-07-02 03:01:10 +00:00
|
|
|
(define input void)
|
|
|
|
(define pause void)
|
|
|
|
|
|
|
|
(define (high pin) (vector-set! pins pin #t))
|
|
|
|
(define (low pin) (vector-set! pins pin #f))
|
|
|
|
|
2019-07-02 05:27:33 +00:00
|
|
|
;; microscheme has this as a separate form but it's just for
|
2019-07-02 03:01:10 +00:00
|
|
|
(define (for-each-vector f v) (for ([x v]) (f x)))
|
|
|
|
|
2019-07-02 05:27:33 +00:00
|
|
|
(define last-usb-frame #f) ; save this off so we can test it
|
2019-07-02 03:01:10 +00:00
|
|
|
|
|
|
|
(define (call-c-func f-name . args)
|
|
|
|
;; (printf "FFI ~s~n" args)
|
|
|
|
(set! last-usb-frame args))
|
|
|
|
|
|
|
|
(define (active-row)
|
2019-07-02 05:27:33 +00:00
|
|
|
;; hypothetically we could have multiple active rows but we just assume one
|
2019-07-02 03:01:10 +00:00
|
|
|
(for/first ([pin row-pins]
|
|
|
|
[row (range (length rows))]
|
|
|
|
#:when (not (vector-ref pins pin)))
|
|
|
|
row))
|
|
|
|
|
|
|
|
(define (col-for pin)
|
|
|
|
(for/first ([c-pin column-pins]
|
|
|
|
[col (range (length columns))]
|
|
|
|
#:when (= c-pin pin))
|
|
|
|
col))
|
|
|
|
|
|
|
|
(define (low? pin)
|
|
|
|
;; (when (vector-ref keys (offset-for (active-row) (col-for pin)))
|
|
|
|
;; (printf "lookup ~s ~s ~n" pin (offset-for (active-row) (col-for pin)))
|
|
|
|
;; (printf "Keys ~s~n" keys))
|
|
|
|
(vector-ref keys (offset-for (active-row) (col-for pin))))
|
|
|
|
|
|
|
|
(define (make-test-data)
|
|
|
|
;; have to put this in a function so we can internal-define; eww
|
|
|
|
(include "keycodes.scm")
|
|
|
|
;; pair of pins/keycodes
|
|
|
|
`(((1) . (0 ,key-w 0 0 0 0 0))
|
2019-07-02 05:00:43 +00:00
|
|
|
((2) . (0 ,key-e 0 0 0 0 0))
|
|
|
|
((27) . (4 0 0 0 0 0 0))
|
|
|
|
((36 4) . (2 ,key-t 0 0 0 0 0))
|
|
|
|
((36 4 6) . (2 ,key-t ,key-y 0 0 0 0))))
|
2019-07-02 03:01:10 +00:00
|
|
|
|
|
|
|
(define test-data (make-test-data))
|
|
|
|
|
2019-07-02 05:27:33 +00:00
|
|
|
(define failures '())
|
2019-07-02 03:01:10 +00:00
|
|
|
|
|
|
|
(define (fail expected actual)
|
2019-07-02 05:27:33 +00:00
|
|
|
(printf "F")
|
|
|
|
(set! failures
|
|
|
|
(cons (format "Expected ~s, got ~s~n" expected actual) failures)))
|
|
|
|
|
|
|
|
(define (finish)
|
|
|
|
(printf (string-join failures "~n" #:before-first "~n" #:after-last "~n"))
|
|
|
|
(exit (if (empty? failures) 0 1)))
|
2019-07-02 03:01:10 +00:00
|
|
|
|
|
|
|
;; we can perform our checks here and make changes to the pin state.
|
|
|
|
(define-syntax free!
|
|
|
|
(syntax-rules ()
|
|
|
|
[(free! body) (if (empty? test-data)
|
2019-07-02 05:27:33 +00:00
|
|
|
(finish)
|
2019-07-02 03:01:10 +00:00
|
|
|
(let ([test-case (car test-data)])
|
|
|
|
(for ([i (vector-length keys)])
|
|
|
|
(vector-set! keys i
|
|
|
|
(and (member i (car test-case)) #t)))
|
|
|
|
body
|
|
|
|
(if (equal? (cdr test-case) last-usb-frame)
|
2019-07-02 05:27:33 +00:00
|
|
|
(printf ".")
|
2019-07-02 03:01:10 +00:00
|
|
|
(fail (cdr test-case) last-usb-frame))
|
|
|
|
(set! test-data (cdr test-data))))]))
|
|
|
|
|
|
|
|
(include "menelaus.scm")
|