syndicate-lang
/
racket-matrix-2012
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Update universe.rkt for latest os2.rkt

This commit is contained in:
Tony Garnock-Jones 2012-05-09 13:44:23 -04:00
parent 7395f9b1fa
commit 92d8a13450
1 changed files with 19 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
universe.rkt
View File

@ -4,7 +4,7 @@
(require racket/match) (require racket/match)
(require racket/class) (require racket/class)
(require racket/async-channel) (require racket/async-channel)
(require racket/gui/base) (require (except-in racket/gui/base yield))
(require 2htdp/image) (require 2htdp/image)
(require "os2.rkt") (require "os2.rkt")
@ -25,7 +25,7 @@
(wrap-evt (alarm-evt msecs) (lambda (_) (current-inexact-milliseconds)))) (wrap-evt (alarm-evt msecs) (lambda (_) (current-inexact-milliseconds))))
(define wild-sub (topic-subscriber (wild))) (define wild-sub (topic-subscriber (wild)))
(define (broadcast message) (send-message (topic-publisher 'universe) message)) (define (broadcast message) (send-message message))
(define (replace-world w1 w2) (define (replace-world w1 w2)
(cond (cond
@ -44,43 +44,41 @@
(on-tick tick-expr rate-expr 0)) (on-tick tick-expr rate-expr 0))
((_ tick-expr rate-expr limit-expr) ((_ tick-expr rate-expr limit-expr)
(list (list
(role wild-sub (role 'on-tick wild-sub
#:state w #:state w
#:id id
['tick (replace-world w (tick-expr w))]) ['tick (replace-world w (tick-expr w))])
(spawn (transition (ticker-state 0 rate-expr limit-expr) (spawn (transition (ticker-state 0 rate-expr limit-expr)
(role wild-sub (role 'tick-stopper wild-sub
#:state ts #:state ts
['stop (transition ts (kill))]) ['stop (transition ts (kill))])
(let loop ((next-alarm-time 0)) (let loop ((next-alarm-time 0))
(role (topic-subscriber (time-evt next-alarm-time)) (role 'tick-sequence (topic-subscriber (cons (time-evt next-alarm-time) (wild)))
#:state (and ts (ticker-state counter interval limit)) #:state (and ts (ticker-state counter interval limit))
#:id id [(cons _ now)
[now
(if (and (positive? limit) (>= counter limit)) (if (and (positive? limit) (>= counter limit))
(transition ts (kill)) (transition ts (kill))
(transition (ticker-state (+ counter 1) interval limit) (transition (ticker-state (+ counter 1) interval limit)
(delete-role id) (delete-role 'tick-sequence)
(loop (+ now (* 1000 interval))) (loop (+ now (* 1000 interval)))
(broadcast 'tick)))])))))))) (broadcast 'tick)))]))))))))
(define-syntax-rule (on-key key-expr) (define-syntax-rule (on-key key-expr)
(role wild-sub (role 'on-key wild-sub
#:state w #:state w
[`(key-down ,kev) (replace-world w (key-expr w kev))])) [`(key-down ,kev) (replace-world w (key-expr w kev))]))
(define-syntax-rule (on-release release-expr) (define-syntax-rule (on-release release-expr)
(role wild-sub (role 'on-release wild-sub
#:state w #:state w
[`(key-up ,kev) (replace-world w (release-expr w kev))])) [`(key-up ,kev) (replace-world w (release-expr w kev))]))
(define-syntax-rule (on-mouse mouse-expr) (define-syntax-rule (on-mouse mouse-expr)
(role wild-sub (role 'on-mouse wild-sub
#:state w #:state w
[`(mouse ,x ,y ,mev) (replace-world w (mouse-expr w x y mev))])) [`(mouse ,x ,y ,mev) (replace-world w (mouse-expr w x y mev))]))
(define-syntax-rule (stop-when last-world?) (define-syntax-rule (stop-when last-world?)
(role wild-sub (role 'stop-when wild-sub
#:state w #:state w
[`(new-state ,_) (if (last-world? w) [`(new-state ,_) (if (last-world? w)
(replace-world w (stop-with w)) (replace-world w (stop-with w))
@ -89,19 +87,22 @@
(define-syntax-rule (on-draw render-expr) (to-draw render-expr)) (define-syntax-rule (on-draw render-expr) (to-draw render-expr))
(define-syntax-rule (to-draw render-expr) (define-syntax-rule (to-draw render-expr)
(role wild-sub (role 'to-draw wild-sub
#:state w #:state w
[`(new-state ,_) (transition w (broadcast `(render ,(render-expr w))))])) [`(new-state ,_) (transition w (broadcast `(render ,(render-expr w))))]))
(define (ui-actions c:ui->world c:world->ui) (define (ui-actions c:ui->world c:world->ui)
(list (list
(role (topic-subscriber c:ui->world) #:state w) (role 'ui-actions (topic-subscriber (cons c:ui->world (wild)))
(role wild-sub #:state w
[(cons _ e)
(transition w (send-message e))])
(role 'ui-stopper wild-sub
#:state w #:state w
['stop ['stop
(async-channel-put c:world->ui 'stop) (async-channel-put c:world->ui 'stop)
(transition w (kill))]) (transition w (kill))])
(role wild-sub (role 'ui-renderer wild-sub
#:state w #:state w
[`(render ,scene) [`(render ,scene)
(async-channel-put c:world->ui `(render ,scene)) (async-channel-put c:world->ui `(render ,scene))
@ -173,7 +174,7 @@
(loop)))) (loop))))
(define (error-listener topic) (define (error-listener topic)
(role topic (role 'error-listener topic
#:state w #:state w
#:topic flow #:topic flow
#:reason reason #:reason reason