(module aux-mixin-macros frtime (require "mixin-macros.ss") (require mzlib/class) ;; consider taking out setter ; currently, get- will return an event stream (define-syntax behavior->callbacks (lambda (stx) (syntax-case stx () [(_ field-name update-call) (let ([s-field-name (syntax field-name)]) (with-syntax ([the-cell-name (string->symbol (format "~a-cell" (syntax-e s-field-name)))] [init-beh-val (string->symbol (format "value-now-~a-b" (syntax-e s-field-name)))]) (syntax (lambda (default super) (class ((events->callbacks field-name update-call) (class super (init init-beh-val) (super-new (field-name init-beh-val)))) (init (field-name default)) (super-new (field-name (changes (default . until . field-name))) (init-beh-val (value-now (default . until . field-name)))) )))))] ))) (define-syntax (embed-processor stx) (syntax-case stx () [(_ processed-name processor getter ...) (with-syntax ([processed-getter (string->symbol (format "get-~a" (syntax-e (syntax processed-name))))]) #'(lambda (super-class) (class super-class (super-new) (inherit getter ...) (define processed-name (processor (getter) ...)) (define/public (processed-getter) processed-name))))])) ; merges event streams created by callbacks->args-evts (define-syntax (mixin-merge-e stx) (syntax-case stx () [(_ result-name get-name ...) #'(embed-processor result-name (lambda args (apply merge-e args)) get-name ...)])) ; given a name for a behavior, an init-field name, and a getter method, ; produces get- which is the hold of calling the getter method ; with the initial value being init-field-name (define-syntax (mixin-hold stx) (syntax-case stx () [(_ b-name get-init get-event-stream) #'(embed-processor b-name (lambda (es) (hold es (send this get-init))) get-event-stream)])) ; batch application of behavior->callbacks (define-syntax add-signal-controls (syntax-rules () [(_ src (field-name0 update-call0 default-val0) clause ...) ((behavior->callbacks field-name0 update-call0) default-val0 (add-signal-controls src clause ...))] [(_ src) src])) (provide (all-defined)))