[ create a new paste ] login | about

Link: http://codepad.org/L4wjFCmR    [ raw code | fork ]

hurracane - Scheme, pasted on Apr 15:
(define (newEventQueue)
  (let ((subscriptions '())
        (eventQueue '())
        (getSubscriptionMsg car)
        (getSubscriber cdr)
        (getActionMsg cdr))
    
    (define (addSubscription! subscriptionmsg subscriber)
      (set! subscriptions (cons (cons subscriptionmsg subscriber) subscriptions)))
    
    (define (enqueue! subscriptionmsg actionmsg)
      (set! eventQueue (cons (cons subscriptionmsg actionmsg) eventQueue)))
    
    (define (findTuple subscriptionmsg)
      (define (iter tuples)
          (cond ((null? tuples) 'no-subscription)
                ((eq? subscriptionmsg (getSubscriptionMsg (car tuples))) (car tuples))
                (else (iter (cdr tuples)))))
      (iter subscriptions))
    
    ;Receives a tuple from the eventqueue
    (define (sendToSubscriber event)
      ;find if there is a subscription for this subscriptionmsg
      (let ((subscription (findTuple (getSubscriptionMsg event))))
        (if (not (eq? subscription 'no-subscription))
            (sendActionMsg (getSubscriber subscription) (getActionMsg event)))))
    
    (define (sendActionMsg subscriber actionmsg)
      ((subscriber 'eventTrigger) actionmsg))
    
    (define (processQueue)
      (define (iter queue)
        (cond ((null? queue)
               (set! eventQueue '()))
              (else (sendToSubscriber (car queue))
                    (iter (cdr queue)))))
      (iter eventQueue))
    
    (define (dispatch msg)
      (case msg
        ((addSubscription) (lambda (subscriptionmsg subscriber)
                             (addSubscription! subscriptionmsg subscriber)))
        ((addEvent) (lambda (subscriptionmsg actionmsg)
                      (enqueue! subscriptionmsg actionmsg)))
        ((processQueue) (processQueue))
        (else (error "Unknown message in eventQueue: " msg))))
    dispatch))


Create a new paste based on this one


Comments: