(* button-bar.sml *)

(* Copyright (C) 2006 Alley Stoughton

   This file is part of crypto, a cryptogram encoder/decoder.  See the
   file COPYING.txt for copying and usage restrictions *)

(* button bar widget *)

structure ButtonBar :> BUTTON_BAR =
struct

open CML

structure A    = Attrs
structure Bttn = Button
structure Q    = Quark
structure SV   = SyncVar
structure W    = Widget

val attr_background  = A.attr_background
val attr_foreground  = A.attr_foreground
val attr_font        = A.attr_font
val attr_pad         = Q.quark "pad"
val attr_borderWidth = A.attr_borderWidth

val defaultBackground  = "grey"
val defaultForeground  = "black"
val defaultFont        = "9x15"
val defaultPad         = 5
val defaultBorderWidth = 4

val attrs =
      [(attr_background,  A.AT_Color, A.AV_Str defaultBackground),
       (attr_foreground,  A.AT_Color, A.AV_Str defaultForeground),
       (attr_font,        A.AT_Font,  A.AV_Str defaultFont),
       (attr_pad,         A.AT_Int,   A.AV_Int defaultPad),
       (attr_borderWidth, A.AT_Int,   A.AV_Int defaultBorderWidth)]

type button_bar =
       {widget    : W.widget,
        labEvt    : string event,
        setActive : bool list -> unit}

exception WrongNumber

fun buttonBar (root, view, args) labs =
      let val attrs = W.findAttr(W.attrs(view, attrs, args))

          val background  = A.getColor(attrs attr_background)
          val foreground  = A.getColor(attrs attr_foreground)
          val font        = A.getFont(attrs attr_font)
          val pad         = A.getInt(attrs attr_pad)
          val borderWidth = A.getInt(attrs attr_borderWidth)
                
          val padGlue = Box.Glue{nat = pad, min = pad, max = SOME pad}

          (* val isBttnUp : Bttn.button_act -> bool *)

          fun isBttnUp (Bttn.BtnUp _) = true
            | isBttnUp _              = false

          (* data for a single button; up events are queued, but
             this queue can be flushed *)

          type button_data =
                 {lab      : string,       (* label of button *)
                  bttn     : Bttn.button,  (* button itself *)
                  upEvt    : unit event,   (* up events; don't use button
                                              events directly *)
                  flushEvt : unit event}   (* for flushing queued up events *)

          (* val makeButton : string -> button_data

             create a button with the given label and return its button data *)

          fun makeButton lab =
                let val bttnArgs           =
                          [(A.attr_label,     A.AV_Str lab),
                           (attr_background,  A.AV_Color background),
                           (attr_foreground,  A.AV_Color foreground),
                           (attr_font,        A.AV_Font font),
                           (attr_pad,         A.AV_Int pad),
                           (attr_borderWidth, A.AV_Int 4)]
                    val bttn               = Bttn.textBtn(root, view, bttnArgs)
                    val (valEvt, flushEvt) =
                          FilterEvt.filterEvt isBttnUp (Bttn.evtOf bttn)
                in {lab      = lab,
                    bttn     = bttn,
                    upEvt    = wrap(valEvt, fn _ => ()),
                    flushEvt = flushEvt}
                end

          (* val activityBttn : button_data * bool -> unit

             changes activity of button given button data; flushes
             queued up events when making inactive *)

          fun activityBttn({bttn, flushEvt, ...} : button_data, b) =
                if b
                then Button.setActive(bttn, true)
                else (Button.setActive(bttn, false);
                      sync flushEvt)

          (* val buttsToBoxes : Bttn.button list -> Box.box list *)

          fun buttsToBoxes nil       = nil
            | buttsToBoxes [b]       =
                [Box.WBox(Shape.mkRigid(Bttn.widgetOf b))]
            | buttsToBoxes (b :: bs) =
                Box.WBox(Shape.mkRigid(Bttn.widgetOf b)) ::
                padGlue ::
                buttsToBoxes bs

          val bttnDatas = map makeButton labs
          val bttns     = map #bttn bttnDatas
          val box       = Box.HzCenter(buttsToBoxes bttns)

          val layout = Box.layout(root, view, args) box
          val widget = Box.widgetOf layout

          val labCh : string chan = channel()

          (* channel for asking server to change activities of
             buttons; ivar is filled with true if successful,
             false if unsuccessful (wrong number of booleans) *)

          val actCh : (bool list * bool SV.ivar)chan = channel()

          (* val activity : bool list -> unit *)

          fun activity bs =
                app activityBttn
                    (ListPair.zip(bttnDatas, bs))

          val allInactive : bool list = map (fn _ => false) labs

          (* val pos : ''a list * ''a -> int

             if xs contains at least one occurrence of y, then
             pos(xs, y) returns the position of the first occurrence
             of y in xs (counting from 0) *)

          fun pos(nil,     _) = raise Fail "cannot happen"
            | pos(x :: xs, y) =
                if x = y
                then 0
                else pos(xs, y) + 1

          (* val makeUpEvt :
                   (bool list -> 'a) ->
                   button_data * bool ->
                   'a event

             used in conjunction with server, below *)

          fun makeUpEvt (serv : bool list -> 'a)
                        ({lab, bttn, upEvt, ...} : button_data, b) =
                if b
                then wrap
                     (upEvt,
                      fn () =>
                           let val evt = sendEvt(labCh, lab)

                               (* val loop : unit -> 'a *)

                               fun loop() =
                                     select
                                     [wrap(evt,
                                           fn () => serv allInactive),
                                      wrap(recvEvt actCh,
                                           fn (bs, iVar) =>
                                                if length bs <> length labs
                                                then (SV.iPut(iVar, false);
                                                      loop())
                                                else (SV.iPut(iVar, true);
                                                      if List.nth
                                                         (bs, pos(labs, lab))
                                                      then loop()
                                                      else serv allInactive))]


                           in activity allInactive;
                              loop()
                           end)
                else never

          (* val server : bool list -> 'a *)

          fun server bs =
                select
                ([wrap(recvEvt actCh,
                       fn (bs, iVar) =>
                            if length bs <> length labs
                            then (SV.iPut(iVar, false); server bs)
                            else (SV.iPut(iVar, true);
                                  activity bs;
                                  server bs))] @
                 map (makeUpEvt server) (ListPair.zip(bttnDatas, bs)))

          (* val setActive : bool list -> unit *)

          fun setActive bs =
                let val iVar : bool SV.ivar = SV.iVar()
                in send(actCh, (bs, iVar));
                   case SV.iGet iVar of
                        true  => ()
                      | false => raise WrongNumber
                end

      in activity allInactive;
         spawn(fn () => server allInactive);
         {widget    = widget,
          labEvt    = recvEvt labCh,
          setActive = setActive}
      end

fun labEvtOf({labEvt, ...} : button_bar) = labEvt

fun setActive({setActive, ...} : button_bar) = setActive

fun widgetOf({widget, ...} : button_bar) = widget

end;