#lang scheme
#|  , __              _                                                 
   /|/  \            | |                                                
    |___/  __,   __  | |   __,  __,   _  _  _    _  _  _    __   _  _   
    | \   /  |  /    |/_) /  | /  |  / |/ |/ |  / |/ |/ |  /  \_/ |/ |  
    |  \_/\_/|_/\___/| \_/\_/|/\_/|_/  |  |  |_/  |  |  |_/\__/   |  |_/
                            /|                                          
                            \|                                          
   Rackgammon: Backgammon for PLT Racket.

   Copyright (c) 2010 David Van Horn
   Licensed under the Academic Free License version 3.0

   (at dvanhorn (dot ccs neu edu))

   For M.M.
|#
(require test-engine/scheme-tests
         2htdp/universe 
         2htdp/image)
(require (file "private/list.ss"))
(provide play)

;;======================================================================
;; Description

;; A Board consists of a list of lists of checkers, representing the
;; points on the board; a list of checkers that are on the bar, and
;; an off bar component that contains a list of checkers off on the
;; top of the board and a list of checkers off on the bottom of the
;; board.

;; A Moment represents a moment in the play of the game.  At any given
;; moment there is a board, some number of dice, and possibly a selected
;; checker (the selected checker, if any, should be thought of as in
;; the hand of the player).

;; Moments are either active or passive.  An active moment is one that
;; the player "owns"; it is the player's moment to respond to.  A
;; passive moment is one the opponent owns.  The player can only observe
;; the moment, but cannot respond to it.

;; An active or passive moment is a World and the game is played with
;; the following form:
;; pas_0 -> ... -> pas_n ->
;; act_0 -> ... -> act_m ->
;; pas_0 -> ... -> pas_p ->
;;          ...

;; When the moment is active, the player may:
;;   - defer to the opponent; pick up all dice to indicate the play is
;;     complete and the player is ready for the opponent to make a play.
;;     Doing so causing the new moment to be passive and sends a message
;;     to the opponent to become active.
;;   - update the moment by selecting a checker, placing a checker, or
;;     rolling the dice.  The resulting moment remains active.

;; The player defers to the opponent by pressing "D". 
;; The player rolls the dice by pressing "R".
;; The player selects a checker by clicking on it.
;; The player places a checker (when one is selected) by clicking on a
;; region of the board.

;; While passive, the player receives updates from the opponent during
;; its play.  Once passive, the moment only becomes active again when
;; the opponent sends a message indicated it is now passive and the
;; player should become active.


;;======================================================================
;; Idioms

;; This program uses the Scheme idiom of non-false values counting as
;; true in conditionals.  This will cause problems in the student
;; languages.  Otherwise it is written in the style of HtDP.


;;======================================================================
;; Known issues:
;; - stacking too many checkers on a point will render incorrectly.
;; - the `prev' field of moment should go away.


;;======================================================================
;; Data definitions

;; [Maybe X] = (U X #f).  Assumed: #f not in X.

;; A Moment is a (make-moment Board Dice [Maybe Checker] [Maybe Moment]).
(define-struct moment (board dice selected prev) #:transparent)

;; An Active is a (make-act Moment Nat Nat).
(define-struct act (moment x y))
;; Interp: this moment is "active" -- this computer owns it.
;; X and Y give the coordinates of the mouse.

;; A Passive is a (make-pas Moment).
;; Interp: this moment is "passive" -- another computer owns it.
(define-struct pas (moment))

;; World = (U Active Passive)

;; (Moment -> Moment) -> (World -> World)
;; Lift given function on moments to worlds.
(define (lift-wrapped s2s)
  (λ (w)
    (cond [(act? w)
           (make-act (s2s (act-moment w))
                     (act-x w)
                     (act-y w))]
          [(pas? w)
           (make-pas (s2s w))])))

(define B 'black)
(define W 'white)
;; A Checker is one of:
;; - B
;; - W

;; A Board is a (make-board [Listof-24 Checker]
;;                          [Listof Checker]
;;                          (make-off [Listof Checker] [Listof Checker])).
(define-struct board (points bar off) #:transparent)
(define-struct off (top bot) #:transparent)

;; A Dice is a [Listof Die].
;; A Die is a (make-die [0,6) [0,360)).
(define-struct die (val degree) #:transparent)

;; A Destination is one of:
;; - [0,24)  ; one of the points
;; - 'TOP    ; off on the top
;; - 'BOT    ; off on the bottom
;; - 'BAR    ; the bar
;; Interp: indexes regions on the board.

;; A Source is one of:
;; - (make-source Destination Natural)
;; Interp: indexes checkers on the board.
(define-struct source (dest i) #:transparent)

;; Checker -> Boolean
(define (white? c) (symbol=? c W))
(define (black? c) (symbol=? c B))

;; (Checker -> Boolean) Board -> Nat
;; Count how many checkers satisfy p? on the board.
(define (board-count p? b)
  (+ (foldl (λ (p s) (+ (count p? p) s))
            0
            (board-points b))
     (count p? (board-bar b))
     (count p? (off-top (board-off b)))
     (count p? (off-bot (board-off b)))))

;; A board as you would find it packed up in a Backgammon set.
;; All checkers are off the board.
(define packed-up-board 
  (make-board (make-list 24 empty)
              empty
              (make-off (make-list 15 B)
                        (make-list 15 W))))

(define (board-remove-points b i j)
  (make-board (replace-at (board-points b)
                          (remove-at (list-ref (board-points b)
                                               i)
                                     j)
                          i)
              (board-bar b)
              (board-off b)))            

;; Board Source -> Checker
(define (board-ref b s)
  (list-ref 
   ((cond [(eq? (source-dest s) 'BAR) board-bar]
          [(eq? (source-dest s) 'TOP) (λ (b) (off-top (board-off b)))]
          [(eq? (source-dest s) 'BOT) (λ (b) (off-bot (board-off b)))]
          [else (λ (b) (list-ref (board-points b)
                                 (source-dest s)))])
    b)
   (source-i s)))

(check-expect (board-ref initial-board (make-source 0 0)) W)
(check-expect (board-ref initial-board (make-source 0 1)) W)

;; Board Checker Destination -> Board
(define (board-add b c d)
  (cond [(eq? 'TOP d) 
         (make-board (board-points b)
                     (board-bar b)
                     (make-off (cons c (off-top (board-off b)))
                               (off-bot (board-off b))))]
        [(eq? 'BOT d) 
         (make-board (board-points b)
                     (board-bar b)
                     (make-off (off-top (board-off b))
                               (cons c (off-bot (board-off b)))))]
        [(eq? 'BAR d)
         (make-board (board-points b)
                     (cons c (board-bar b))
                     (board-off b))]
        [else
         (make-board (points-add (board-points b) c d)
                     (board-bar b)
                     (board-off b))]))

;; For testing only.  Not a valid Board.
(define mt-board (make-board (list empty) empty (make-off empty empty)))

(check-expect (board-add mt-board W 'BAR)
              (make-board (list empty) (list W) (make-off empty empty)))
(check-expect (board-add mt-board W 'TOP)
              (make-board (list empty) empty (make-off (list W) empty)))
(check-expect (board-add mt-board W 'BOT)
              (make-board (list empty) empty (make-off empty (list W))))                          
(check-expect (board-add mt-board W 0)
              (make-board (list (list W)) empty (make-off empty empty)))

;; Points Checker [0,24) -> Points
(define (points-add pts c i)
  (replace-at pts (append (list-ref pts i) (list c)) i))

(check-expect (points-add (list empty) B 0)
              (list (list B)))
(check-expect (points-add (list (list W) empty) B 1)
              (list (list W)
                    (list B)))

;; Board Nat -> (list Checker Board)
(define (board-bar-fetch b i)
  (list (list-ref (board-bar b) i)
        (make-board (board-points b)
                    (remove-at (board-bar b) i)
                    (board-off b))))


(define (board-flip b)
  (make-board (reverse (board-points b))
              (reverse (board-bar b))
              (make-off (off-bot (board-off b))
                        (off-top (board-off b)))))
                       

;;======================================================================
;; Message views

;; Conversions between structures and S-Expressions.

(define (moment->sexp m)
  (list (board->sexp (moment-board m))
        (dice->sexp (moment-dice m))
        (maybe-checker->sexp (moment-selected m))))

(define (sexp->moment s)
  (make-moment (sexp->board (first s))
               (sexp->dice (second s))
               (sexp->maybe-checker (third s))
               #f))

(define (board->sexp b)
  (list (map checker->sexp (board-points b))
        (map checker->sexp (board-bar b))
        (map checker->sexp (off-top (board-off b)))
        (map checker->sexp (off-bot (board-off b)))))
        

(define (sexp->board s)
  (make-board (map sexp->checker (first s))
              (map sexp->checker (second s))
              (make-off (map sexp->checker (third s))
                        (map sexp->checker (fourth s)))))
  
(define (checker->sexp c) c)
(define (dice->sexp ds) (map (λ (d) (list (die-val d) (die-degree d))) ds))

(define (sexp->checker s) s)
(define (sexp->dice s) (map (λ (s) (make-die (first s) (second s))) s))

(define (sexp->maybe-checker s)
  (and s (sexp->checker s)))

(check-expect (sexp->maybe-checker #f) #f)
(check-expect (sexp->maybe-checker B) B)
(check-expect (sexp->maybe-checker W) W)

(define (maybe-checker->sexp c)
  (and c (checker->sexp c)))

(check-expect (sexp->board (board->sexp initial-board))
              initial-board)

;;======================================================================
;; Rendering

;; Nat -> Image
;; Creates an image of 0 height and given width.
(define (hspace size)
  (rectangle size 0 'solid 'red))

;; Nat -> Image
;; Creates an image of 0 width and given height.
(define (vspace size)
  (rectangle 0 size 'solid 'red))

;; Image ... -> Image
;; Extension of above to zero- and un-ary case.
(define (above0 . is)
  (cond [(empty? is) (hspace 0)]
        [(empty? (rest is)) (first is)]
        [else (apply above is)]))

;; Image ... -> Image
;; Extension of beside to zero- and un-ary case.
(define (beside0 . is)
  (cond [(empty? is) (hspace 0)]
        [(empty? (rest is)) (first is)]
        [else (apply beside is)]))

;; Radius and diameter of Checker image
(define CRADIUS 20)
(define CDIAM (* 2 CRADIUS))

;; Checker -> Image
(define (checker->img c)
  (cond [(white? c)
         (overlay (circle CRADIUS 'outline 'black)
                  (circle CRADIUS 'solid 'white))]
        [(black? c)
         (overlay (circle CRADIUS 'outline 'white)
                  (circle CRADIUS 'solid 'black))]
        [else
         (circle CRADIUS 'solid c)]))

(define (raw-points->img ps)
  (apply beside/align "bottom" 
         (map point->img (reverse ps))))

(define (point->img p)
  (above (hspace CDIAM)
         (apply above0 (reverse (map checker->img p)))))



(define BORDER-CLR 'darkslateblue)
(define FLOOR-CLR 'slateblue)

(define (point-img c)
  (let ((theta (* 2 (atan 1/10))))
    (isosceles-triangle (/ CRADIUS (sin (* 1/2 theta))) 
                        (* theta (/ 180 pi)) 
                        'solid
                        c)))


(define black-point-img (point-img 'black))
(define white-point-img (point-img 'white))

(define QUAD-HEIGHT (* 7 CDIAM))
(define BOARD-HEIGHT (* 2 QUAD-HEIGHT))

(define quadrant-background-img   
  (rectangle (* 6 CDIAM)
             QUAD-HEIGHT
             'solid
             FLOOR-CLR))

(define quadrant-img
  (overlay/align
   "center" "bottom"
   (apply beside 
          (build-list 6
                      (λ (i)
                        (if (even? i)
                            black-point-img
                            white-point-img))));)
   quadrant-background-img))

(define bar-img
  (rectangle CDIAM QUAD-HEIGHT 'solid BORDER-CLR))

;; [Listof-6 [Listof Checker]] -> Image
(define (quadrant->img ps)
  (overlay/align "center" "bottom"
                 (raw-points->img ps)
                 quadrant-img))

;; Board [0,4) -> [Listof-6 [Listof Checker]]
(define (board-quadrant b q)
  (take (drop (board-points b) (* q 6)) 6))

;; Checker -> Image
;; Render the checker on its side (the way it looks when placed "off" the board).
(define (checker-off->img c)
  (overlay (rectangle CDIAM
                      (* 1/2 CRADIUS)
                      'outline
                      (if (white? c) 'black 'white))
           (rectangle CDIAM
                      (* 1/2 CRADIUS)
                      'solid
                      (if (white? c) 'white 'black))))

;; [Listof Checker] -> Image
;; Render a list of checkers on their side.
(define (off->img o)
  (apply above0 (map checker-off->img o)))

(define (top-board->img b)
  (rotate 180 
          (beside (overlay/align 'center 'bottom 
                                 (off->img (off-top (board-off b)))
                                 bar-img)
                  (quadrant->img (board-quadrant b 3))
                  bar-img
                  (quadrant->img (board-quadrant b 2))
                  bar-img)))

(define (bot-board->img b)
  (beside bar-img
          (quadrant->img (board-quadrant b 1))
          bar-img
          (quadrant->img (board-quadrant b 0))
          (overlay/align 'center 'bottom 
                         (off->img (off-bot (board-off b)))
                         bar-img)))  

;; Board -> Image
;; Render the board as an image.
(define (board->img b)
  (overlay (apply above0 (map checker->img (board-bar b)))
           (above (top-board->img b)
                  (bot-board->img b))))

;; World -> Image
;; Render the world as an image.
(define (world->img w)
  (cond [(act? w)
         (if (and (act-x w) 
                  (moment-selected (act-moment w)))
             (place-image (checker->img (moment-selected (act-moment w)))
                          (act-x w)
                          (act-y w)
                          (act-moment->img (act-moment w)))
             (act-moment->img (act-moment w)))]
        
        [(pas? w)
         (overlay (text "Passive" 40 'red)
                  (pas-moment->img (pas-moment w)))]))



;;======================================================================
;; Dice Rendering

(define DIE-SIZE (* 2 CRADIUS))
(define BRADIUS 5)

(define die-sq-img
  (square DIE-SIZE 'outline 'black))

(define bullet (circle BRADIUS 'solid 'black))

(define die-face-one
  (overlay bullet die-sq-img))

(define die-face-two
  (overlay/xy bullet 
              (- (* 5/8 DIE-SIZE))
              (- (* 5/8 DIE-SIZE))
              (overlay/xy bullet 
                          (- (* 1/8 DIE-SIZE))
                          (- (* 1/8 DIE-SIZE))
                          die-sq-img)))

(define die-face-three
  (overlay bullet die-face-two))

(define die-face-four
  (overlay (rotate 90 die-face-two) die-face-two))

(define die-face-five
  (overlay bullet die-face-four))

(define die-half-six 
  (overlay/align 'left 'center
                 (beside (hspace (* 1/2 BRADIUS))
                         (apply above (interleave (vspace (* 1/2 BRADIUS))
                                                  (make-list 3 bullet))))                 
                 die-sq-img))

(define die-face-six
  (overlay die-half-six (rotate 180 die-half-six)))

(define (die->img d)
  (rotate (die-degree d)
          (overlay (list-ref (list die-face-one 
                                   die-face-two 
                                   die-face-three 
                                   die-face-four 
                                   die-face-five 
                                   die-face-six)
                             (die-val d))
                   (square DIE-SIZE 'solid 'white))))

(define (dice->img ds)
  (apply beside0 (interleave (hspace DIE-SIZE) 
                             (map die->img ds))))


;;======================================================================
;; Boards

(define initial-board
  (make-board (list (list W W)
                    empty
                    empty
                    empty
                    empty
                    (list B B B B B)
                    empty
                    (list B B B)
                    empty
                    empty
                    empty
                    (list W W W W W)
                    (list B B B B B)
                    empty
                    empty
                    empty
                    (list W W W)
                    empty
                    (list W W W W W)
                    empty
                    empty
                    empty
                    empty
                    (list B B))
              empty
              (make-off empty empty)))

(define some-board0
  (make-board (list (list W W)
                    empty
                    empty
                    empty
                    empty
                    (list B B B B B)
                    empty
                    (list B B B)
                    empty
                    empty
                    empty
                    (list W W W W W)
                    (list B B B B B)
                    empty
                    empty
                    empty
                    (list W W W)
                    empty
                    (list W W W W)
                    empty
                    empty
                    empty
                    (list W)
                    empty)
              (list B B)
              (make-off empty empty)))

(define some-board1
  (make-board (list empty
                    empty
                    empty
                    empty
                    empty
                    (list B B B B B)
                    empty
                    (list B B B)
                    empty
                    empty
                    empty
                    empty
                    (list B B B B B)
                    empty
                    empty
                    empty
                    empty
                    empty
                    (list W W W W)
                    empty
                    empty
                    (list W)
                    (list W W W)
                    empty)
              (list B B)
              (make-off (list W W W W W W W)
                        empty)))

;; A roll off board
(define some-board2
  (make-board (list empty
                    (list B B B)
                    empty
                    empty
                    (list B)
                    (list B B B)
                    empty
                    empty
                    empty
                    empty
                    empty
                    empty
                    empty
                    empty
                    empty
                    empty
                    empty
                    empty
                    (list W W W W)
                    empty
                    empty
                    (list W)
                    (list W W W)
                    empty)
              empty
              (make-off (list W W W W W W W)
                        (list B B B B B B B B))))


;;======================================================================
;; Moments

(define (act-moment->img w)
  (overlay (beside (hspace (* 7 CDIAM))
                   (dice->img (moment-dice w)))
           (board->img (moment-board w))))

(define (pas-moment->img w)
  (overlay (beside (rotate 180 (dice->img (moment-dice w)))
                   (hspace (* 7 CDIAM)))
           (board->img (moment-board w))))

(define moment0
  (make-moment initial-board
               empty
               #f
               #f))

;; Moment -> Moment
;; Remove the dice from the given moment.
(define (moment-no-dice m)
  (make-moment (moment-board m)
               empty
               (moment-selected m)
               m))

;; Moment -> Moment
;; Flip the board within the moment.
(define (moment-flip m)
  (make-moment (board-flip (moment-board m))
               (moment-dice m)
               (moment-selected m)
               (moment-prev m)))

;; Moment -> Moment
;; Roll the dice
(define (roll-dice m)
  (make-moment (moment-board m)
               (list (make-die (random 6) (random 360))
                     (make-die (random 6) (random 360)))
               (moment-selected m)
               m))

;; Moment -> Moment
;; Go to previous moment, if any.
(define (moment-undo m)
  (or (moment-prev m) m))

;;======================================================================
;; More testing

(check-expect (board-count white? initial-board) 15)
(check-expect (board-count black? initial-board) 15)
(check-expect (board-count white? packed-up-board) 15)
(check-expect (board-count black? packed-up-board) 15)
(check-expect (board-count white? some-board0) 15)
(check-expect (board-count black? some-board0) 15)
(check-expect (board-count white? some-board1) 15)
(check-expect (board-count black? some-board1) 15)
(check-expect (board-count white? some-board2) 15)
(check-expect (board-count black? some-board2) 15)

;;======================================================================
;; Board interactions

;; Is y in the top half of the board?
;; Nat -> Boolean
(define (top? y)
  (<= 0 y QUAD-HEIGHT))

;; [0,16) Boolean -> [Maybe Destination]
(define (click-dest col top?)
  (cond [(<= 1 col 6) 
         (if top? 
             (+ 11 col)
             (+ 6 (- 6 col)))]                          
        [(= 7 col) 'BAR]
        [(<= 8 col 13)
         (if top?
             (+ 10 col)
             (+ 6 (- 7 col)))]
        [(<= 14 col) (if top? 'TOP 'BOT)]
        [else #f]))

;; Tells you index of checker-size grid square on the points.
(define (y->points-index y)
  (let ((a (quotient y CDIAM)))
    (if (< a 7)
        a
        (- 13 a))))

;; Nat Boolean -> Integer
;; Interpetation: a negative index indicates being above the midpoint.
;; When odd?, zero means the middle element.
;; When not odd?, zero means the first element.
(define (y->bar-index y odd?)
  (ceiling (/ (- y QUAD-HEIGHT (if odd? CRADIUS 0)) CDIAM)))     

(check-expect (y->bar-index QUAD-HEIGHT true) 0)
(check-expect (y->bar-index (- QUAD-HEIGHT CRADIUS) true) -1)
(check-expect (y->bar-index (- QUAD-HEIGHT CRADIUS 1) true) -1)
(check-expect (y->bar-index (+ QUAD-HEIGHT CRADIUS) true) 0)
(check-expect (y->bar-index (+ QUAD-HEIGHT CRADIUS 1) true) 1)

(check-expect (y->bar-index QUAD-HEIGHT false) 0)
(check-expect (y->bar-index (- QUAD-HEIGHT CRADIUS) false) 0)

; Nat Nat -> [Maybe Destination]
(define (maybe-dest x y)
  (click-dest (quotient x CDIAM)
              (top? y)))


;; Board Nat Nat -> [Maybe (list Checker Board)]
(define (maybe-select-bar b x y)
  (let ((n (length (board-bar b))))
    (let ((o? (odd? n)))
      (let ((bi (y->bar-index y o?)))
        (if o?
            (and (<= (- (quotient (sub1 n) 2)) 
                     bi 
                     (quotient (sub1 n) 2))
                 (board-bar-fetch b (- (quotient (sub1 n) 2) (- bi))))
            
            (and (<= (- (sub1 (quotient n 2)))
                     bi 
                     (quotient n 2))
                 
                 (board-bar-fetch b (sub1 (- (quotient n 2) (- bi))))))))))


;; Board Nat Nat -> [Maybe (list Checker Board)]
(define (maybe-select b x y)
  (let ((d (maybe-dest x y)))
    (and d
         (cond [(eq? 'BAR d) 
                (maybe-select-bar b x y)]
               [(eq? 'TOP d)
                (and (cons? (off-top (board-off b)))
                     (list (first (off-top (board-off b)))
                           (make-board (board-points b)
                                       (board-bar b)
                                       (make-off (rest (off-top (board-off b)))
                                                 (off-bot (board-off b))))))]               
               [(eq? 'BOT d)
                (and (cons? (off-bot (board-off b)))
                     (list (first (off-bot (board-off b)))
                           (make-board (board-points b)
                                       (board-bar b)
                                       (make-off (off-top (board-off b))
                                                 (rest (off-bot (board-off b)))))))]                
               [else 
                (let ((pt (list-ref (board-points b) d)))
                  (and (< (y->points-index y)
                          (length pt))
                       
                       ;; Return the Checker and Update the board.
                       (list (list-ref pt (y->points-index y))
                             (board-remove-points b d (y->points-index y)))))]))))

;; Moment Nat Nat -> Moment
(define (moment-maybe-move w x y)
  (if (maybe-dest x y)
      (make-moment (board-add (moment-board w) 
                              (moment-selected w)
                              (maybe-dest x y))
                   (moment-dice w)
                   #f
                   w)
      w))

;; Moment Nat Nat -> Moment
(define (moment-maybe-select w x y)
  (let ((ms (maybe-select (moment-board w) x y)))
    (if ms
        (make-moment (second ms)
                     (moment-dice w)
                     (first ms)
                     w)
        w)))

;; Feature request: click on the dice to indicate being done.

;; World Nat Nat MouseEvent -> (U World Package)
(define (squeek w x y m)
  (cond [(act? w)
         (let* ((s (act-moment w))
                (s* (cond [(mouse=? m "button-down")
                           (cond [(moment-selected s)
                                  (moment-maybe-move s x y)]
                                 [else
                                  (moment-maybe-select s x y)])]
                          [else s])))
           
           (if (eq? s s*)
               (make-act s x y)
               (make-package 
                (make-act s* x y) 
                `(moment ,(moment->sexp s*)))))]        
        [else w]))


;;=================================================================
;; Play

;; String -> Void
(define (play player-name #:IP [ip LOCALHOST])
  (big-bang (make-pas moment0)
            (register ip)
            (name (format "Backgammon: ~a" player-name))
            (on-draw world->img)
            (on-mouse squeek)
            (on-key 
             (λ (w k)
               (cond [(act? w)
                      (cond [(and (key=? "D" k)
                                  (not (moment-selected (act-moment w))))
                             (make-package (make-pas (moment-no-dice (act-moment w)))
                                           '(passive))]                                    
                            [(key=? "R" k) 
                             (let ((w* ((lift-wrapped roll-dice) w)))
                               (make-package 
                                w*
                                `(moment ,(moment->sexp (act-moment w*)))))]
                            [else w])]
                     [else w])))
            (on-receive 
             (λ (w msg)
               (cond [(equal? msg '(initial))
                      (make-act (moment-flip moment0) #f #f)]
                     [(equal? msg '(active))
                      (make-act (moment-no-dice (pas-moment w)) #f #f)]
                     [(equal? msg '(passive))
                      (make-pas (act-moment w))]
                     [(equal? (first msg) 'moment)
                      ;; May not do the right thing with history
                      (make-pas (moment-flip (sexp->moment (second msg))))])))))

(test)