Don't like ads? PRO users don't see any ads ;-)
Public Pastes
Guest

Untitled

By: a guest on May 8th, 2012  |  syntax: None  |  size: 4.13 KB  |  hits: 9  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. #lang racket
  2.  
  3. ;; ---------------------------------------------------------------------------------------------------
  4. ;; a functional brain control implementation
  5.  
  6. (require 2htdp/universe 2htdp/image)
  7.  
  8. ;; decide what is an event on the data stream from the headset
  9. (define meditation? (make-parameter (lambda (meditation0 meditation1) #true)))
  10. (define attention? (make-parameter (lambda (attention0 attention1) #false)))
  11.  
  12. ;; [ *-> Void] -> Boolean
  13. ;; launch the (fake) head-set process, a universe that forwards messages from there to world
  14. (define (main)
  15.  (brain-universe)
  16.  (functional-brain))
  17.  
  18. ;; ---------------------------------------------------------------------------------------------------
  19. ;; the Jedi world
  20.  
  21. ;; World = Number
  22. ;; interpretation: the y coordinate of the UFO
  23.  
  24. ;; B-expression is (list number number)
  25. ;; interpretation: (list M A) is a pair of mediatation and attention levels
  26.  
  27. (define HEIGHT 400)
  28. (define WIDTH  400)
  29. (define HEIGHT0 100)
  30. (define UFO
  31.  (underlay/align "center" "center" (circle 10 "solid" "green") (rectangle 40 4 "solid" "green")))
  32.  
  33. (define (functional-brain)
  34.  ;; Number -> Image
  35.  (define (create-UFO-scene height)
  36.    (place-image UFO 180 height (empty-scene WIDTH HEIGHT)))
  37.  
  38.  ;; Word B-expression -> World
  39.  (define (calculate-height-using-meditation height0 message)
  40.    (printf "got new meditation value: ~a\n" message)
  41.    (cond
  42.      [(boolean? message) (stop-with height0)]
  43.      [else (define-values (M A) (apply values message))
  44.            (define height1 (+ height0 (if (< M 65) +1 -1)))
  45.            ;; don't let the UFO get out of the interval [0,(- HEIGHT 20)]
  46.            (max 0 (min height1 HEIGHT))]))
  47.  
  48.  (big-bang HEIGHT0
  49.            (register LOCALHOST)
  50.            (on-receive calculate-height-using-meditation)
  51.            (to-draw create-UFO-scene)))
  52.  
  53. ;; Number Number -> Number
  54. (define (increment reading height)
  55.  (max 0 (min HEIGHT (if (< reading 65) (+ height 1) (- height 1)))))
  56.  
  57. ;; ---------------------------------------------------------------------------------------------------
  58. ;; the simulate universe, which forwards messages from the fake head-set reader to the world
  59.  
  60. (define SQPORT 4567)
  61. (define BRAIN-PORT 13854)
  62.  
  63. (define (brain-universe)
  64.  (define listener (tcp-listen SQPORT 1 #true LOCALHOST))
  65.  (thread
  66.   (lambda ()
  67.     ;; registering
  68.     (define-values (in out) (tcp-accept listener))
  69.     (receive-registration in out)
  70.     (pipe-messages-from-headset out))))
  71.  
  72. (define (receive-registration in out)
  73.  (sync (handle-evt in (lambda (in) (displayln '(OKAY) out) (flush-output out)))))
  74.  
  75. (define (pipe-messages-from-headset out)
  76.  (define-values (in _out) (tcp-connect LOCALHOST BRAIN-PORT))
  77.  ;; S-expression -> Void
  78.  (define (send x)
  79.    (write x out)
  80.    (newline out)
  81.    (flush-output out))
  82.  ;; (Number Number -> Void) Number Number #:att Number #:med Number -> Void
  83.  ;; if it is an attention or a meditation event, send it to the world
  84.  (define (check loop meditation0 attention0 #:att [attention1 #false] #:med [meditation1 #false])
  85.    (printf "in check att0 ~a att1 ~a med0 ~a med1 ~a\n" attention0 attention1 meditation0 meditation1)
  86.    (define attention (or attention1 attention0))
  87.    (define meditation (or meditation1 meditation0))
  88.    (when (or (and attention1 ((attention?) attention0 attention1))
  89.              (and meditation1 ((meditation?) meditation0 meditation1)))
  90.      (printf "sending med: ~a att: ~a\n" meditation attention)
  91.      (send `(,meditation ,attention)))
  92.    (loop meditation attention))
  93.  ;; -- IN --
  94.  (let loop ([meditation 0] [attention 0])
  95.    (sync
  96.     (handle-evt in
  97.                 (lambda (in)
  98.                   (with-handlers ((exn? (lambda (x) (kill-thread (current-thread)))))
  99.                     (define typ (read-byte in))
  100.                     (cond
  101.                       [(eof-object? typ) (send #false)]
  102.                       [else
  103.                        (case typ
  104.                          [(4)(check loop meditation attention #:att (read-byte in))]
  105.                          [(5)(check loop meditation attention #:med (read-byte in))]
  106.                          [else (loop meditation attention)])])))))))
  107.  
  108. ;; ---------------------------------------------------------------------------------------------------
  109. ;; run program run
  110. (main)
create a new version of this paste RAW Paste Data