fade3.scm

   1 (use-modules (ice-9 rdelim)
   2              (ice-9 match)
   3              (ice-9 receive)
   4              (srfi srfi-1)
   5              (ice-9 format))
   6
   7 (system "stty -F /dev/ttyACM0 cs8 115200 ignbrk -brkint -icrnl -imaxbel -opost -onlcr -isig -icanon -iexten -echo -echoe -echok -echoctl -echoke noflsh -ixon -crtscts")
   8
   9 (set! *random-state* (random-state-from-platform))
  10
  11 (define out (open-file "/dev/ttyACM0" "w0+"))
  12
  13 (define pi 3.14159)
  14
  15 (define (deg->rad degrees)
  16   (* degrees (/ pi 180)))
  17
  18 (define (hsv->rgb h s v)
  19   (let* ((chroma (* v s))
  20          (hue' (/ h (/ pi 3)))
  21          (x (* chroma (- 1 (abs (- (euclidean-remainder hue' 2) 1)))))
  22          (m (- v chroma)))
  23     (receive (r₁ g₁ b₁)
  24         (case (inexact->exact (floor hue'))
  25           ((0) (values chroma x 0))
  26           ((1) (values x chroma 0))
  27           ((2) (values 0 chroma x))
  28           ((3) (values 0 x chroma))
  29           ((4) (values x 0 chroma))
  30           ((5) (values chroma 0 x)))
  31       (values (+ r₁ m) (+ g₁ m) (+ b₁ m)))))
  32
  33 ;; (define ts (make-termios-struct))
  34 ;; ;; Get the current setings of the serial-device.
  35 ;; (tc-get-attr! out ts)
  36 ;; (cf-set-speed! ts termios-B9600)
  37 ;; (tc-set-attr out ts)
  38
  39 (sleep 3)
  40
  41 (define tick-increment (/ (* 2 pi) (* 360 1)))
  42
  43 (define (random-ticks n) (* tick-increment (random n)))
  44
  45 (define last-pulse (car (gettimeofday)))
  46
  47 (let loop ((tick 0)
  48            (saturation 0))
  49   (format #t "~A " saturation)
  50   (let ((h (euclidean-remainder tick (* 2 pi))))
  51     (receive (r g b)
  52              (hsv->rgb h (or 0.9 (- 1.0 (* (min saturation 10) 0.1))) 1)
  53       (let ((r' (inexact->exact (round (* r 255))))
  54             (g' (inexact->exact (round (* g 255))))
  55             (b' (inexact->exact (round (* b 255)))))
  56
  57 #;
  58         (format #t "~A ~A ~A -> ~A ~A ~A~%" h 1 1 r' g' b')
  59         (format out "~A,~A,~A,0~c" r' g' b' #\return)
  60         (format out "~A,~A,~A,1~c" r' g' b' #\return)
  61         #;(display (read-line out))))
  62     (usleep 450000)
  63     (loop (+ tick-increment tick)
  64           (if (> (- (car (gettimeofday)) last-pulse) 1)
  65               (begin (set! last-pulse (car (gettimeofday)))
  66                      8)
  67               (if (= saturation 0) 0 (1- saturation))))))
  68
  69 #;
  70 (let loop ((rt (random-ticks 128))
  71            (bt (random-ticks 128))
  72            (gt (random-ticks 128)))
  73   (let ((r (inexact->exact (truncate (* 128 (+ 1 (sin rt))))))
  74         (g (- 256 (inexact->exact (truncate (* 128 (+ 1 (cos gt)))))))
  75         (b (inexact->exact (truncate (* 128 (+ 1 (sin bt)))))))
  76     #;(format #t "~A ~A ~A~%" r g b)
  77     (format out "~A,~A,~A,4~c" r g b #\return)
  78     (display (read-line out))
  79     (usleep 45000)
  80     (loop (+ rt (* tick-increment (1+ (random 3))))
  81           (+ gt (* tick-increment (1+ (random 3))))
  82           (+ bt (* tick-increment (1+ (random 3)))))))
  83