(module book frtime
(require racket/gui/base
racket/class
racket/stream
data/gvector
(as-is racket/base hash-ref make-hasheqv hash-count hash-set!))
(define book%
(class pane%
(init page)
(define page-e page)
(define locs (make-hasheqv))
(define book-pages (gvector))
(super-new)
(define/public (add-loc l) (hash-set! locs l (hash-count locs)))
(inherit change-children)
(define/override (after-new-child c)
(gvector-add! book-pages c))
(define (internal-set-page l)
(change-children
(lambda (_)
(let ((x (hash-ref locs l #f)))
(if (and x (> (gvector-count book-pages) 0))
(list (gvector-ref book-pages x)) '())))))
(define/public (set-page l) (internal-set-page l))
(define page-action
(map-e internal-set-page page-e))))
(define cycle%
(class pane%
(define page-e (new-cell))
(define current-page -1)
(define book-pages (gvector))
(super-new)
(inherit change-children)
(define/override (after-new-child c)
(gvector-add! book-pages c))
(define (inc-page)
(set! current-page (+ current-page 1))
(when (= current-page (gvector-count book-pages))
(set! current-page 0))
(change-children
(lambda (_)
(if (> (gvector-count book-pages) 0)
(list (gvector-ref book-pages current-page)) '()))))
(define page-action
(==> page-e
(lambda (_) (inc-page))))
(define/public (activate)
(set-cell! page-e
(apply merge-e
(map
(lambda (x)
(send x get-value-e)) (stream->list book-pages))))
(inc-page)))))