#lang s-exp "../lang/wescheme.rkt"
(provide random-direction
random-color)
(define (char->string c)
(cond
((char=? c #\a) "a")
((char=? c #\b) "b")
((char=? c #\c) "c")
((char=? c #\d) "d")
((char=? c #\e) "e")
((char=? c #\f) "f")
((char=? c #\g) "g")
((char=? c #\h) "h")
((char=? c #\i) "i")
((char=? c #\j) "j")
((char=? c #\k) "k")
((char=? c #\l) "l")
((char=? c #\m) "m")
((char=? c #\n) "n")
((char=? c #\o) "o")
((char=? c #\p) "p")
((char=? c #\q) "q")
((char=? c #\r) "r")
((char=? c #\s) "s")
((char=? c #\t) "t")
((char=? c #\u) "u")
((char=? c #\v) "v")
((char=? c #\w) "w")
((char=? c #\x) "x")
((char=? c #\y) "y")
((char=? c #\z) "z")
((char=? c #\space) "space")))
(define (on-key-event/proc key-handler)
(on-key (lambda (w key)
(let ((key-str (cond
((symbol? key) (symbol->string key))
((char? key) (char->string key))
(else key))))
(key-handler w key-str)))))
(define (on-mouse-event/proc mouse-handler)
(on-mouse-event (lambda (w x y Mouse-event)
(let ((event-str (symbol->string Mouse-event)))
(mouse-handler w x y event-str)))))
(define (direction? s)
(or (equal? s "up")
(equal? s "down")
(equal? s "left")
(equal? s "right")))
(define (random-direction)
(let ((n (random 4)))
(case n
((0) "up")
((3) "down")
((1) "left")
((2) "right"))))
(define (random-color c)
(let ([new-c (random 8)])
(case new-c
[(0) (ensure-different-color "red" c)]
[(1) (ensure-different-color "green" c)]
[(2) (ensure-different-color "yellow" c)]
[(3) (ensure-different-color "blue" c)]
[(4) (ensure-different-color "turquoise" c)]
[(5) (ensure-different-color "purple" c)]
[(6) (ensure-different-color "light blue" c)]
[(7) (ensure-different-color "magenta" c)])))
(define (ensure-different-color c1 c2)
(if (equal? c1 c2)
(random-color c2)
c1))
(define-syntax (TEST stx)
(syntax-case stx ()
[(_ x ...)
(with-handlers ([exn? (lambda (e)
(raise (make-exn
(regexp-replace*
#rx"check-expect"
(exn-message e)
"test")
(exn-continuation-marks e))))])
(local-expand (syntax/loc stx (check-expect x ...))
(syntax-local-context)
(kernel-form-identifier-list)))]))