A library for Menus

let rec type menuStruct <->
  [ title: string;
     items: var seq menuItem;
     private display := meth() :int is
       use c := var 0 in 
         (newlines(2);
          printstring(self.title);
          newlines(1);
          loop (at self.items) do display(c);
          newlines(1);
          printstring("Type a number");
          newlines(1);
          at(c)
         );
     interact := meth() :null is
     % See the effect of changing getchar with inchar %
         use rec noBlanks := fun(x: string):string is
             use s := explode(x)
             in
               if first(s) = " "
                 then noBlanks(implode(rest(s)))
                 else x
         in
         if emptyseq(at self.items) then nil
          else
         use validItems := self.display
         ext char := var first (explodeascii(getchar()))
         ext one := first (explodeascii("1"))
         ext last := one + validItems - 1
          in (while ((at char < one) Or (at char > last)) do 
                 (newlines(1);
                  printstring
                     (implode({"Retry: the digits must be between 1 and ";    
                                noBlanks(stringofint(validItems))}));
                  newlines(1);
                  char <- first (explodeascii(getchar())) );
              use numHit := var (at char - first (explodeascii("0")))
               in loop i In (at self.items) do
                      (if i.IamNth(numHit) then 
                           (i.operation(i);
                            if i.tailAction is enterMenu
                               then (i.tailAction as enterMenu).interact
                               else nil;
                            exit)
                       else nil));
     addItem := meth(newItem: menuItem, position:int): menuItem is
         use rec addOrd := fun(itemNum:int, itemList: seq menuItem)
                              : seq menuItem is
                   if position <= itemNum then newItem :: itemList
                   else if emptyseq(itemList) then {newItem}
                   else first(itemList) :: addOrd(itemNum+1, rest(itemList))
          in (if some (at self.items) with id = newItem.id 
                 then failwith "duplicated item id"
                 else nil;
              self.items <- addOrd(1, at(self.items));
              newItem);
     remItem := meth(itemId: int): null is
         self.items <- (at self.items) where Not(id = itemId);
     itemWithId := meth(itemId: int): menuItem is
         (get x In (at self.items) where (x.id = itemId)).x
            iffails failwith "No item with such id";
     itemWithName := meth(itemName: string): menuItem is
         pick((at self.items) where name = itemName)
            iffails failwith "No item with such name"
  ]

and type menuItem <->
  [ name: string;
     id: int;
     operation: menuItem -> null;
     tailAction: (| quitMenu or enterMenu: menuStruct |);
     private active: var bool;
     private visible: var bool;
     setActive := meth() :null is self.active <- true;
     setVisible := meth() :null is self.visible <- true;
     setInvisible := meth() :null is self.visible <- false;
     setInactive := meth() :null is self.active <- false;
     IamNth := meth(c:var int): bool is
       (if (at self.visible) And (at self.active) 
           then c <- at c - 1 
           else nil;
        (at c) = 0);
     display := meth(c:var int):null is
     (if (at self.visible) then
        (newlines(1);
         if (at self.active) then
            (c <- at c + 1;
             printint(at c))
         else printstring("-");
         printstring(")");
         blanks(3);
         printstring(self.name);
         newlines(1)
        )
        else nil
     )
  ];


% Redefinition of the constructors  %
  
let mkMenu := 
      fun(title:string): menuStruct is
        mkmenuStruct ([title := title; 
                        items := var({}:seq menuItem)]);

let mkItem := fun(name: string, id:int, op: menuItem -> null, tail: 
                 (| quitMenu or enterMenu: menuStruct|)): menuItem is
              mkmenuItem([name := name; 
                           id := id; 
                           operation := op; 
                           tailAction := tail;
                           active := var true; 
                           visible := var true]);

let NullOperation := fun (x:menuItem):null is nil;

% Declarations for the simple menu version %

let private lastIdSelected := var 0
ext 
mkSimpleMenu := 
  use idOp := fun(i: menuItem): null is lastIdSelected <- i.id
  ext mkSimpleItem := 
        fun(name: string, id:int): menuItem is
        mkmenuItem([name := name; 
                     id := id; 
                     operation := idOp; 
                     tailAction := (|quitMenu|);
                     active := var true; 
                     visible := var true])
  in fun(title: string, items: seq string): menuStruct is 
       mkmenuStruct ([title := title;
                       items :=  var 
                              (use c := var 0
                              in select ( c <- (at c) + 1; 
                                         mkSimpleItem(i, (at c)))
                                 from i In items 
                              )])
ext
 simpleInteract := 
      fun(m: menuStruct): int is
        (m.interact;
         at lastIdSelected);


% Elimination of the standard constructors %

let mkmenuStruct := 
     fun(x:[title : string; items : var seq menuItem]): none is
       failwith "To create a menuStruct please use mkSimpleMenu or mkMenu";

let mkmenuItem := fun(
   x:[name : string; id: int;
       operation: menuItem -> null;
       tailAction: (| quitMenu or enterMenu: menuStruct |);
       active: var bool; visible: var bool]): none is
     failwith "To create a menuItem please use mkItem";