## 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/old/basic/widget.pkg package wt = widget_types; # widget_types is from src/lib/x-kit/widget/old/basic/widget-types.pkg package li = list_indexing; # list_indexing is from src/lib/x-kit/widget/old/lib/list-indexing.pkgherein
package item_list
: (weak) Item_List # Item_List is from src/lib/x-kit/widget/old/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
(\\ (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
(\\ ((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 (\\ 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;