PreviousUpNext

15.4.1394  src/lib/x-kit/widget/leaf/item-list.pkg

## item-list.pkg
#
# Package for maintaining lists of items with widget state.

# Compiled by:
#     src/lib/x-kit/widget/xkit-widget.sublib






###                "The computer programmer is a creator of
###                 universes for which he alone is responsible.
###                 Universes of virtually unlimited complexity
###                 can be created in the form of computer programs."
###
###                                    -- Joseph Weizenbaum


stipulate
#   package wg =  widget;                       # widget                is from   src/lib/x-kit/widget/basic/widget.pkg
    package wt =  widget_types;                 # widget_types          is from   src/lib/x-kit/widget/basic/widget-types.pkg
    package li =  list_indexing;                # list_indexing         is from   src/lib/x-kit/widget/lib/list-indexing.pkg
herein

    package   item_list
    : (weak)  Item_List                         # Item_List             is from   src/lib/x-kit/widget/leaf/item-list.api
    {
        exception BAD_INDEX = li::BAD_INDEX;

        Item(X) = (X, Ref( wt::Button_State ));

        Pick(X) = Null_Or ((Int, Item(X)));

        fun mki (i, s)
            =
            (i, REF s);

        Pickfns(X) = { pickfn:  (X, Bool) -> Void,
                       setpickfn:  ((Bool, Int,  Item(X),  Pick(X)) ) ->  Pick(X),
                       getpickfn:  (Pick(X),  List( Item(X) )) -> List( Int )
                     };

        Items(X) = ITEMS { multi:  Bool,
                           items:  List(  Item(X) ),
                           count:  Int,
                           pick:  Pick(X),
                           pickfns:  Pickfns(X)
                         };

        fun is_chosen (  wt::ACTIVE v) => v;
            is_chosen (wt::INACTIVE v) => v;
        end;

        fun flip_state (  wt::ACTIVE v) => (  wt::ACTIVE (not v));
            flip_state (wt::INACTIVE v) => (wt::INACTIVE (not v));
        end;

        fun set_active' (wt::ACTIVE   v, FALSE) => (wt::INACTIVE v);
            set_active' (wt::INACTIVE v,  TRUE) => (  wt::ACTIVE v);
            set_active' (s, _) => s;
        end;

        fun get_pick (_, slist)
            =
            li::find
                (fn (i, (_, state)) =  (is_chosen *state) ?? THE i
                                                          :: NULL
                                       )
                slist;

        fun pick pickfn (do_pick, index, (item, state), _)
            =
            if   (do_pick != is_chosen *state)

                 pickfn (item, do_pick);
                 state := flip_state *state;
                 NULL;
            else
                 NULL;
            fi;

        fun init_pick1 slist
            =
            {   fun setp (item as (_, state), (i, p))
                    =
                    if (is_chosen *state)  (i+1, THE (i, item));
                    else                   (i+1, p);
                    fi;

                #2 (list::fold_forward setp (0, NULL) slist);
            };

        fun get_pick1 (NULL, _) => [];
            get_pick1 (THE (i, _), _) => [i];
        end;

        fun pick1 pickfn (TRUE, index, v as (item, state), NULL)
                =>
                {   pickfn (item, TRUE);
                    state := flip_state *state; THE (index, v);
                };

            pick1 pickfn (FALSE, index, _, NULL)
                =>
                NULL;

            pick1 pickfn (TRUE, index, (item', state'), p as THE (i, (item, state)))
               =>
               if (i == index)
                   p;
               else
                   pickfn (item, FALSE);
                   pickfn (item', TRUE);
                   state' := flip_state *state';
                   state := flip_state *state;
                   THE (index, (item', state'));
               fi;

            pick1 pickfn (FALSE, index, (item, state), p as THE (i, _))
                =>
                if (i != index)
                    p;
                else
                    pickfn (item, FALSE);
                    state := flip_state *state; NULL;
                fi;
        end;

        fun items { multiple, items=>l, pickfn }
            =
            {   itemlist = map mki l;

                my (pick, setpickfn, getpickfn)
                    =
                    if multiple  (NULL,                pick  pickfn, get_pick );
                    else         (init_pick1 itemlist, pick1 pickfn, get_pick1);
                    fi;

                pickfns = { pickfn, setpickfn, getpickfn };

                  ITEMS {
                    multi => multiple,
                    items => itemlist,
                    count => length itemlist,
                    pick,
                    pickfns
                  };
              };

        fun vals_count (ITEMS { count, ... } )
            =
            count;

        fun get_chosen (ITEMS { pick, items, pickfns, ... } )
            = 
            pickfns.getpickfn (pick, items);

        fun get_state (ITEMS { items, ... } )
            =
            {   fun get_state (_, state) = *state;
                map get_state items;
            };

        fun vals_list (ITEMS { count, items, ... }, start, len)
            =
            {   fun nthtail (0, l) => l;
                    nthtail (_,[]) => [];
                    nthtail (n, _ ! t) => nthtail (n - 1, t);
                end;

                fun get ([], _, l) => reverse l;
                    get (_, 0, l) => reverse l;
                    get ((i, s) ! t, n, l) => get (t, n - 1, (i,*s) ! l);
                end;

                if (start < 0)  raise exception BAD_INDEX;
                else            get (nthtail (start, items), int::max (0, len),[]);
                fi;
            };

        fun item (i, start)
            =
            head (vals_list (i, start, 1));

        fun revfold f b (ITEMS { items, ... } )
            = 
            list::fold_forward
                (fn ((v, _), b) = f (v, b))
                b
                items;

        fun delete (ITEMS { multi, count, items, pick, pickfns }, indices)
            =
            {   indices = li::check_sort indices;

                my (items', dl)
                    =
                    li::delete (items, indices);

                pickfn = pickfns.pickfn;

                fun unpick (i, state)
                    =
                    if (is_chosen *state)

                        pickfn (i, FALSE); 
                    fi;

                pick' = case pick   

                            NULL => NULL;

                            THE (i, item)
                                => 
                                case (li::pre_indices (i, indices))   
                                    #
                                    THE j => THE (i-j, item);
                                    NULL => NULL;
                                esac;
                        esac;

                apply unpick dl;

                ITEMS {
                  multi,
                  items => items',
                  count => count - length indices,
                  pick  => pick',
                  pickfns
                };
            };

        fun set (ITEMS { multi, count, items, pick, pickfns }, index, ilist)
            =
            {   if (index < 0 or index > count)  raise exception BAD_INDEX;   fi;

                initstate = wt::ACTIVE FALSE;

                ilist' = map (fn i = (i, REF initstate)) ilist;

                count' = length ilist;

                pick' = case pick   
                            NULL => NULL;
                            THE (i, item) => if (index > i ) pick;
                                             else THE (i+count', item);
                                             fi;
                        esac;

                items' = li::set (items, index, ilist');

                ITEMS {
                  multi,
                  items => items',
                  count => count + count',
                  pick => pick',
                  pickfns
                };
              };

        fun set_active (il as ITEMS { items, ... }, ilist)
            =
            {   fun seta (i, on_off)
                    =
                    {   state = #2 (li::keyed_find (items, i));
                        state := set_active'(*state, on_off);
                    };

                apply seta ilist;

                il;
            };

        fun set_chosen (ITEMS { multi, count, items, pick, pickfns }, ilist)
            =
            {   optpick = case pick
                              THE (i, _) => THE i;
                              NULL => NULL;
                          esac;

                setpickfn = pickfns.setpickfn;

                fun picki ((i, on_off), pick)
                    =
                    setpickfn (on_off, i, li::keyed_find (items, i), pick);

                ( ITEMS { multi,
                          items,
                          count,
                          pick => list::fold_forward picki pick ilist,
                          pickfns
                        },
                  optpick
                );
              };

    };                  # package item_list

end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext