kkallio@16: type formatCtl = {Width : int,
kkallio@16:                   RangeCtl : $(mapU (transaction {} -> xbody) [First, Back, Next, Last]),
kkallio@16:                   PageCtl :  $(mapU (int -> transaction {} -> xbody) [Unsel, Sel]),
kkallio@16:                   WrapPageCtl : xbody -> xbody,
kkallio@16:                   Wrap : $(mapU xbody [First, Back, Pages, Next, Last]) -> xbody}
kkallio@16: 
kkallio@16: style firstCtl
kkallio@16: style backCtl
kkallio@16: style nextCtl
kkallio@16: style lastCtl
kkallio@16: style curPage
kkallio@16: style rangeCtl
kkallio@16: 
kkallio@16: fun defaultFormatLbl {First = fLbl, Back = bLbl, Next = nLbl, Last = lLbl} =
kkallio@16:     let
kkallio@16:         fun mkLink c txt = fn a => <xml><li onclick={a} class={c}><a class={c} onclick={return ()}>{[txt]}</a></li></xml>
kkallio@16:     in
kkallio@16:         {Width = 5,
kkallio@16:          RangeCtl = {First = mkLink firstCtl fLbl,
kkallio@16:                      Back = mkLink backCtl bLbl,
kkallio@16:                      Next = mkLink nextCtl nLbl,
kkallio@16:                      Last = mkLink lastCtl lLbl},
kkallio@16:          PageCtl = {Unsel = fn n a => <xml><li onclick={a}><a onclick={return ()}>{[n + 1]}</a></li></xml>,
kkallio@16:                     Sel = fn n a => <xml><li onclick={a} class={curPage}><a class={curPage} onclick={return ()}>{[n + 1]}</a></li></xml>},
kkallio@16:          WrapPageCtl = fn x => x,
kkallio@16:          Wrap = fn {First = f, Back = b, Pages = p, Next = n, Last = l} => <xml><ul class={rangeCtl}>{f}{b}{p}{n}{l}</ul></xml>}
kkallio@16:     end
kkallio@16: 
kkallio@16: val defaultFormat = defaultFormatLbl {First = "<<", Back = "<", Next = ">", Last = ">>"}
kkallio@16: 
kkallio@16: type pageData = {Content : xbody, Available : int}
kkallio@16: datatype response err = Good of pageData | Bad of err
kkallio@16: 
kkallio@16: functor Make(M : sig
kkallio@16:                  type errorMarker
kkallio@16:                  type pageGroup
kkallio@16:                  val initPage : pageGroup -> transaction pageData
kkallio@16:                  val getPage : pageGroup -> int -> transaction (response errorMarker)
kkallio@16:              end) : sig
kkallio@16:     type t
kkallio@16:     val createFmt : formatCtl -> M.pageGroup -> transaction t
kkallio@16:     val create : M.pageGroup -> transaction t
kkallio@16:     val onError : t -> (M.errorMarker -> transaction {}) -> transaction {}
kkallio@16:     val panelXml : t -> xbody
kkallio@16:     val ctlXml : t -> xbody
kkallio@16: end = struct
kkallio@16:     open M
kkallio@16: 
kkallio@16:     type t = {FormatCtl : formatCtl,
kkallio@16:               PageGroup : pageGroup,
kkallio@16:               OnError : source (errorMarker -> transaction {}),
kkallio@16:               CurrentPage : source int,
kkallio@16:               RangeStart : source int,
kkallio@16:               Available : source int,
kkallio@16:               Content : source xbody}
kkallio@16: 
kkallio@16:     fun max x y = if x > y then x else y
kkallio@16:     fun min x y = if x < y then x else y
kkallio@16: 
kkallio@16:     fun loadPage t pg =
kkallio@16:         ret <- rpc (getPage t.PageGroup pg);
kkallio@16: 
kkallio@16:         case ret of
kkallio@16:             Good pageData =>
kkallio@16:                 let
kkallio@16:                     val lst = max 0 (pageData.Available - 1)
kkallio@16:                     val rgtRange = max 0 (pageData.Available - t.FormatCtl.Width)
kkallio@16:                 in
kkallio@16:                     if pg > lst then
kkallio@16:                         loadPage t lst
kkallio@16:                     else
kkallio@16:                         rg <- get t.RangeStart;
kkallio@16:                         (if rg > rgtRange then
kkallio@16:                              set t.RangeStart rgtRange
kkallio@16:                          else
kkallio@16:                              return ());
kkallio@16:                         set t.CurrentPage pg;
kkallio@16:                         set t.Content pageData.Content;
kkallio@16:                         set t.Available pageData.Available
kkallio@16:                 end
kkallio@16:           | Bad e =>
kkallio@16:                 handler <- get t.OnError;
kkallio@16:                 handler e
kkallio@16: 
kkallio@16:     fun createFmt fmt grp =
kkallio@16:         pg <- source 0;
kkallio@16:         rg <- source 0;
kkallio@16: 
kkallio@16:         pageData <- initPage grp;
kkallio@16: 
kkallio@16:         av <- source (pageData.Available);
kkallio@16:         c <- source (pageData.Content);
kkallio@16: 
kkallio@16:         e <- source (fn _ => return {});
kkallio@16: 
kkallio@16:         return {FormatCtl = fmt,
kkallio@16:                 PageGroup = grp,
kkallio@16:                 OnError = e,
kkallio@16:                 CurrentPage = pg,
kkallio@16:                 RangeStart = rg,
kkallio@16:                 Available = av,
kkallio@16:                 Content = c}
kkallio@16: 
kkallio@16:     val create = createFmt defaultFormat
kkallio@16: 
kkallio@16:     fun onError t f =
kkallio@16:         set t.OnError f
kkallio@16: 
kkallio@16:     fun panelXml t =
kkallio@16:             <xml>
kkallio@16:               <dyn signal={signal t.Content}/>
kkallio@16:             </xml>
kkallio@16: 
kkallio@16:     fun ctlXml t =
kkallio@16:         let
kkallio@16:             val fmt = t.FormatCtl
kkallio@16:             val width = fmt.Width
kkallio@16: 
kkallio@16:             fun floor pg =
kkallio@16:                 return (max 0 pg)
kkallio@16: 
kkallio@16:             fun lastPage () =
kkallio@16:                 av <- get t.Available;
kkallio@16:                 floor (av - 1)
kkallio@16: 
kkallio@16:             fun rightRange () =
kkallio@16:                 lst <- lastPage ();
kkallio@16:                 floor (lst - width + 1)
kkallio@16: 
kkallio@16:             fun ceil pg =
kkallio@16:                 rgt <- rightRange ();
kkallio@16:                 return (min rgt pg)
kkallio@16: 
kkallio@16:             fun setRange startPage =
kkallio@16:                 startPage <- ceil startPage;
kkallio@16:                 startPage <- floor startPage;
kkallio@16:                 set t.RangeStart startPage
kkallio@16: 
kkallio@16:             fun printLinks start cur available =
kkallio@16:                 let
kkallio@16:                     val wanted = start + width - 1
kkallio@16:                     val have = max 0 (available - 1)
kkallio@16:                     val lst = min wanted have
kkallio@16: 
kkallio@16:                     fun printLinks' n (acc : xbody) =
kkallio@16:                         if n > lst then
kkallio@16:                             acc
kkallio@16:                         else
kkallio@16:                             printLinks' (n + 1)
kkallio@16:                                         <xml>{acc}{(if n = cur then
kkallio@16:                                                         fmt.PageCtl.Sel
kkallio@16:                                                     else
kkallio@16:                                                         fmt.PageCtl.Unsel) n (loadPage t n)}</xml>
kkallio@16:                 in
kkallio@16:                     printLinks' start <xml/>
kkallio@16:                 end
kkallio@16:         in
kkallio@16:             fmt.Wrap {First = fmt.RangeCtl.First (setRange 0),
kkallio@16:                       Back = fmt.RangeCtl.Back (pg <- get t.RangeStart; setRange (pg - 1)),
kkallio@16:                       Pages = fmt.WrapPageCtl
kkallio@16:                                   <xml>
kkallio@16:                                     <dyn signal={start <- signal t.RangeStart;
kkallio@16:                                                  av <- signal t.Available;
kkallio@16:                                                  cur <- signal t.CurrentPage;
kkallio@16:                                                  return (printLinks start cur av)}/>
kkallio@16:                                   </xml>,
kkallio@16:                       Next = fmt.RangeCtl.Next (pg <- get t.RangeStart; setRange (pg + 1)),
kkallio@16:                       Last = fmt.RangeCtl.Last (pg <- rightRange (); setRange pg)}
kkallio@16:         end
kkallio@16: end