Потоки и заняты ожидания в схеме

Question

Я пишу схему программы, которая позволяет пользователю создавать планеты, которые следуют законам гравитации. Для выполнения задания я должен изменить код, чтобы избежать ожидания ожидания, а также создать новый поток для каждой планеты или при каждом щелчке мыши. Я не очень хорошо понимаю GUI в схеме, и был бы очень благодарен за некоторую помощь.

Вот код:

#lang racket

(require racket/gui)

;; Small 2d vector library for the Newtonian physics
(define (x v) (vector-ref v 0))
(define (y v) (vector-ref v 1))
(define (x! v value) (vector-set! v 0 value))
(define (y! v value) (vector-set! v 1 value))
(define (v* v value) (vector-map (lambda (x) (* x value)) v))
(define (v+ v w) (vector-map + v w))
(define (v- v w) (vector-map - v w))
(define (v-zero! v) (vector-map! (lambda (x) 0) v))
(define (v-dot v w) (let ((vw (vector-map * v w))) (+ (x vw) (y vw))))
(define (v-mag v) (sqrt (v-dot v v)))

;; Planet object
(define planet%
 (class object%
    (public m p v calculate-force move draw)
    (init-field (mass 1)
                (position (vector 0 0 ))
                (velocity (vector 0 0 ))
                (force (vector 0 0 )))
(define (m) mass)
(define (p) position)
(define (v) velocity)
;; Use Newton's law of gravitation.
;; I assume the gravitational constant is one
(define (calculate-force pl)
  (v-zero! force)
  (for-each (lambda (other-planet)
              (when (not (equal? this other-planet))
                (let* ((direction (v- (send other-planet p) position))
                       (dist (max 1 (v-mag direction)))
                       (other-mass (send other-planet m))
                       (new-force (v* direction (/ (* mass other-mass) (* dist dist))))
                       )
                  (vector-map! + force new-force))))
            pl)
  )
;; Simple Euler integration of acceleration and velocity
(define (move) 
  (let ((acc (v* force (/ 1.0 mass))))
    (vector-map! + velocity acc)
    (vector-map! + position velocity)))
;; Draw a circle 
(define (draw dc) 
  (send dc set-brush brush)
  (send dc set-pen pen)
  (send dc draw-ellipse (x position) (y position) radius radius ))
;; Initialize to random velocity, mass, and color
(x! velocity (* 2 (random)))
(y! velocity (* 2 (random)))
(set! mass (+ 1 (* 10 (random))))
(define radius (* 5 (sqrt mass)))
(define color 
  (let* ((r (random))
         (b (real->floating-point-bytes r 4)))
    (make-object color% (bytes-ref b 0) (bytes-ref b 1) (bytes-ref b 2) )))
(define brush (make-object brush% color))
(define pen (make-object pen% color))
;; Don't forget the super-new!
(super-new)
))
;; Abstract the list-handling for a list of planets
(define planet-container%
  (class object%
(public add-planet calculate-force move draw get-planets)
(init-field (planets '()))
(define (get-planets) planets)
(define (add-planet planet)
  (set! planets (cons planet planets)))
(define (calculate-force)
  (for-each (lambda (planet)
              (send planet calculate-force planets))
            planets))
(define (move)
  (for-each (lambda (planet)
              (send planet move))
            planets))
(define (draw dc)
  (for-each (lambda (planet)
              (send planet draw dc))
            planets))
(super-new)
)
  )
(define planet-container (new planet-container%))

;; The GUI
(define frame (new frame% 
               (label "Planets")
               (min-width 120)
               (min-height 80)
               ))
(send frame create-status-line)
(send frame show #t)

(define h-panel
  (new horizontal-panel%
   (parent frame)
   (stretchable-height #f)
   (style '(border))
   (border 2)))

(define run-checkbox
  (new check-box%
   (parent h-panel)
   (label "Run animation")
   ))

(define my-canvas%
  (class canvas%
    (override on-paint on-event)

(define (on-paint)
  (let ((dc (send this get-dc))
        (w (send this get-width))
        (h (send this get-height)))
    (send dc clear)
    (send planet-container draw dc)
    ))
(define (on-event event)
  (when (send event button-down?)
    (let ((x (send event get-x))
          (y (send event get-y)))
      (send frame set-status-text (format "Mouse at ~a ~a" x y))
      (send planet-container add-planet (new planet% (position (vector x y))))
      (send this refresh)))
  )
(super-new)
(send (send this get-dc) set-background (make-object color% 8 8 64))
))

(define canvas
  (new my-canvas%
   (parent frame)
   (style '(border))
   (min-width 640)
   (min-height 480)))

;; Busy loop planet animator
(let loop ()
  (sleep/yield .05)
  (when (send run-checkbox get-value)
    (send planet-container calculate-force)
    (send planet-container move)
    (send canvas refresh)
    )
  (loop))

Answer 1

Вот ключевой фрагмент кода:

(define ch (make-channel))

(define run-checkbox
  (new check-box%
   (parent h-panel)
   (label "Run animation")
   [callback (λ _ (channel-put ch (send run-checkbox get-value)))]))

(thread (λ ()           
          (define moving? #f)
          (let loop ()
            ;; either get a message on ch, or wait for 50 ms
            (define r (sync ch (alarm-evt (+ (current-inexact-milliseconds) 50))))
            ;; if we got a message, update the state
            (when (boolean? r) (set! moving? r))
            ;; move things if necessary
            (when moving?
              (send planet-container calculate-force)
              (send planet-container move)
              (send canvas refresh))
            (loop))))

Сначала мы создаем канал для связи между флажком и потоком обновления.

Затем, когда есть щелчок на флажке, мы отправляем значение флажка по каналу.

В потоке мы отслеживаем, движемся ли мы с moving? переменная. Поток просто сидит в цикле, обновляя холст всякий раз, когда мы находимся в "движущемся" состоянии.

Для проверки новых сообщений мы используем sync, Призыв к sync вернет результат либо, если есть сообщение о ch (или #t или же #f) или alarm-evt заканчивается (через 50 миллисекунд). Если мы действительно получили сообщение, то есть логическое сообщение на канале, мы обновляем то состояние, в котором мы находимся, обновляем холст, если необходимо, и возвращаемся к циклу.