ufo

m-ufo.rtk

#lang racket

;; ---------------------------------------------------------------------------------------------------
;; a functional brain control implementation

(require 2htdp/universe 2htdp/image)

;; decide what is an event on the data stream from the headset
(define meditation? (make-parameter (lambda (meditation0 meditation1) #true)))
(define attention? (make-parameter (lambda (attention0 attention1) #false)))

;; [ *-> Void] -> Boolean
;; launch the (fake) head-set process, a universe that forwards messages from there to world
(define (main)
 (brain-universe)
 (functional-brain))

;; ---------------------------------------------------------------------------------------------------
;; the Jedi world

;; World = Number
;; interpretation: the y coordinate of the UFO

;; B-expression is (list number number)
;; interpretation: (list M A) is a pair of mediatation and attention levels

(define HEIGHT 400)
(define WIDTH  400)
(define HEIGHT0 100)
(define UFO
 (underlay/align "center" "center" (circle 10 "solid" "green") (rectangle 40 4 "solid" "green")))

(define (functional-brain)
 ;; Number -> Image
 (define (create-UFO-scene height)
   (place-image UFO 180 height (empty-scene WIDTH HEIGHT)))

 ;; Word B-expression -> World
 (define (calculate-height-using-meditation height0 message)
   (printf "got new meditation value: ~a\n" message)
   (cond
     [(boolean? message) (stop-with height0)]
     [else (define-values (M A) (apply values message))
           (define height1 (+ height0 (if (< M 65) +1 -1)))
           ;; don't let the UFO get out of the interval [0,(- HEIGHT 20)]
           (max 0 (min height1 HEIGHT))]))

 (big-bang HEIGHT0
           (register LOCALHOST)
           (on-receive calculate-height-using-meditation)
           (to-draw create-UFO-scene)))

;; Number Number -> Number
(define (increment reading height)
 (max 0 (min HEIGHT (if (< reading 65) (+ height 1) (- height 1)))))

;; ---------------------------------------------------------------------------------------------------
;; the simulate universe, which forwards messages from the fake head-set reader to the world

(define SQPORT 4567)
(define BRAIN-PORT 13854)

(define (brain-universe)
 (define listener (tcp-listen SQPORT 1 #true LOCALHOST))
 (thread
  (lambda ()
    ;; registering
    (define-values (in out) (tcp-accept listener))
    (receive-registration in out)
    (pipe-messages-from-headset out))))

(define (receive-registration in out)
 (sync (handle-evt in (lambda (in) (displayln '(OKAY) out) (flush-output out)))))

(define (pipe-messages-from-headset out)
 (define-values (in _out) (tcp-connect LOCALHOST BRAIN-PORT))
 ;; S-expression -> Void
 (define (send x)
   (write x out)
   (newline out)
   (flush-output out))
 ;; (Number Number -> Void) Number Number #:att Number #:med Number -> Void
 ;; if it is an attention or a meditation event, send it to the world
 (define (check loop meditation0 attention0 #:att [attention1 #false] #:med [meditation1 #false])
   (printf "in check att0 ~a att1 ~a med0 ~a med1 ~a\n" attention0 attention1 meditation0 meditation1)
   (define attention (or attention1 attention0))
   (define meditation (or meditation1 meditation0))
   (when (or (and attention1 ((attention?) attention0 attention1))
             (and meditation1 ((meditation?) meditation0 meditation1)))
     (printf "sending med: ~a att: ~a\n" meditation attention)
     (send `(,meditation ,attention)))
   (loop meditation attention))
 ;; -- IN --
 (let loop ([meditation 0] [attention 0])
   (sync
    (handle-evt in
                (lambda (in)
                  (with-handlers ((exn? (lambda (x) (kill-thread (current-thread)))))
                    (define typ (read-byte in))
                    (cond
                      [(eof-object? typ) (send #false)]
                      [else
                       (case typ
                         [(4)(check loop meditation attention #:att (read-byte in))]
                         [(5)(check loop meditation attention #:med (read-byte in))]
                         [else (loop meditation attention)])])))))))

;; ---------------------------------------------------------------------------------------------------
;; run program run
(main)