view togglePanel.ur @ 19:3a303df9ae92

Partial generalize togglePanel solution (breaks build)
author Ron de Bruijn <rmbruijn@gmail.com>
date Fri, 23 Sep 2011 13:30:01 +0200
parents 16447dc6a68c
children 554e342665fe
line wrap: on
line source
datatype panelState = Open | Closed

con formatCtl :: {Unit} -> Type = fn other_ctx => {FormatPanel : (xml ([Body] ++ other_ctx) [] []) -> (xml ([Body] ++ other_ctx) [] []) -> (xml ([Body] ++ other_ctx) [] []),
                  OpenCtl : transaction unit -> xml ([Body] ++ other_ctx) [] [],
                  CloseCtl : transaction unit -> xml ([Body] ++ other_ctx) [] []}

val defaultFormat = {FormatPanel = fn ctl panel => <xml>{ctl}{panel}</xml>,
                     OpenCtl = fn behaviour => <xml><button value="Open" onclick={behaviour}/></xml>,
                     CloseCtl = fn behaviour => <xml><button value="Close" onclick={behaviour}/></xml>}
                    
con togglePanel t other_ctx = {PanelState : source panelState,
                     FormatCtl : formatCtl other_ctx,
                     Content : t}

open Gui

fun create [t ::: Type] [other_ctx:::{Unit}] [other_ctx ~ body] (toXml : gui t (xml ([Body] ++ other_ctx) [] [])) (f : formatCtl other_ctx) (content : t) (startOpen : bool) : transaction (togglePanel t other_ctx) =
    state <- source (if startOpen then Open else Closed);

    return {PanelState = state,
            FormatCtl = f,
            Content = content}

fun render [t ::: Type]  [other_ctx:::{Unit}] [other_ctx ~ body] (_ : gui t (xml ([Body] ++ other_ctx) [] [])) (panel : togglePanel t other_ctx) =
    let
        val openCtl = panel.FormatCtl.CloseCtl (set panel.PanelState Closed)
        val closeCtl = panel.FormatCtl.OpenCtl (set panel.PanelState Open)

        val content = toXml panel.Content
    in
        panel.FormatCtl.FormatPanel
            <xml>
              <dyn signal={c <- signal panel.PanelState;
                           return
                               (case c of
                                    Open => <xml>{openCtl}</xml>
                                  | Closed => <xml>{closeCtl}</xml>)
                          }/>
            </xml>

            <xml>
              <dyn signal={c <- signal panel.PanelState;
                           return
                               (case c of
                                    Open => <xml>{content}</xml>
                                  | Closed => <xml/>)
                          }/>
            </xml>
    end

fun gui_togglePanel [t ::: Type]  [other_ctx:::{Unit}] [other_ctx ~ body] (_ : gui t (xml ([Body] ++ other_ctx) [] [])) = mkGui render