;-----------------------------------------------------------------------
; Modulo de Input Output
;
; 1. Leitura de STR e INT
;     lerstr : prompt -> string nao vazia e incluindo
;     lerint : prompt -> inteiro
;     lerany : prompt -> any      (* str entre "",inteiros, Sexp *)
;     lersetstr : prompt -> set of STR (* terminar com "." *)
;     lerset : prompt -> set of ANY    (* terminar com "." *)
;     lerfixdomff : ANY-set -> ffanyany
;
; 2. PrettyPrint 
;     pp   - Prettyprint 
;     fpp - Fast PrettyPrint
;
; 3. Escolha interactiva de um elemento dum SET, LIST, FF:
;     pickone : (ANY-set | ANY-list | ANY-> ANY) -> ANY
;     ppickone : (ANY-set | ANY-list | ANY-> ANY) x prompt -> ANY
;     pickmany : (ANY-set | ANY-list | ANY-> ANY) -> ANY-set
;
; 4. Menu que associa opcoes a expressoes, menus, funcoes ou valores
;    Inteiros
;          menu: tmenu -> ANY   (resultado duma funcao, resultado do
;                                calculo de uma expressao, Inteiro ou
;                                resultado da exec. dum menu )
;          run : tmenu ->       (executa menu ate' escolher opcao 0)
;
;TYPE
;   tmenu :: titger : STR                /*     titulo do menu     */
;            opcoes_list : opcoes-list;  /*     lista das opcoes   */
;   opcoes :: titopc : STR               /*     tilulo da opcao    */
;             accao_op : taccao;  
;   taccao =  tmenu | SYM |INT | _exp;
;   _exp = ANY;
;ENDTYPE
;
;Exemplo de menu: 
;M <- tmenu("Menu geral",            /* accao = calculo de expressao */
;           <opcoes("conteudo deste menu",'(pp(M))),
;            opcoes("invocacao deste menu",'(menu(M)))>);
;            
;-----------------------------------------------------------------------

FUNC lerstr(str:STR ,(stdout)): STR 
STATE  ppn(str)
RETURN let( a=fgets())
       in if(a=="\n") then _l(fgets())
                      else _l(a);
_l(y)=let( z=strlen(y))
     in substr(y,1,sub(z,1));

FUNC lerint(str:STR ,(stdout)): INT
STATE  ppn(str)
RETURN let( a=read())
       in if(type(a)=='INT) 
          then a
          else lerint(str);

lersetstr(str)=do(ppn(str),
                   let(a=lerstr("?- ")) 
                   in if (a == ".")
                      then {}
                      else {a} U lersetstr(" "));

metoo
(def FIM '.)
endmetoo

lerset(str)=do(ppn(str),
                   let(a=read()) 
                   in if (a == FIM )
                      then {}
                      else {a} U lerset("? "));

FUNC pickone(m1:ANY-set):ANY
RETURN
    let( m=if('SET == type(m1)  -> < x | x <- m1 >,
              'LIST == type(m1) -> m1 ,
              'FF == type(m1)   -> < [x -> m1[x]] | x <- dom(m1) >),
         a1=do(
            princ("\n--------------------------------------------------\n\t"),
            { princ (x," ",el(x,m),"\n\t") | x <- inds(m) },
            _b<- leropcao("\nqual destes ? "),
            while(( _b > length(m))||(_b<0),_b <-leropcao("qual destes ? ")),
            princ("\n--------------------------------------------------\n")))
    in if(_b==0) then NIL
                 else el(_b,m);

FUNC pickmany(m1:ANY-set):ANY-set
RETURN
    let( m=if('SET == type(m1)  -> < x | x <- m1 >,
              'LIST == type(m1) -> m1 ,
              'FF == type(m1)   -> < [x -> m1[x]] | x <- dom(m1) >),
         a1=do(
            princ("\n--------------------------------------------------\n\t"),
            { princ (x," ",el(x,m),"\n\t") | x <- inds(m) }))
    in { el(b,m) | b<- lerset("\nquais destes (. para terminar)\n ? ")};

FUNC ppickone(m1:ANY-set,s:STR):ANY
RETURN
    let( m=if('SET == type(m1)  -> < x | x <- m1 >,
              'LIST == type(m1) -> m1 ,
              'FF == type(m1)   -> < [x -> m1[x]] | x <- dom(m1) >),
         a1=do(
            princ("\n--------------------------------------------------\n\t"),
            { princ (x," ",el(x,m),"\n\t") | x <- inds(m) },
            _b<- leropcao(strcat("\n",s)),
            while(( _b > length(m))||(_b<0),_b <-leropcao(strcat("\n",s))),
            princ("\n--------------------------------------------------\n")))
    in if(_b==0) then NIL
                 else el(_b,m);

lerany(p)=do(ppn(p),read());

FUNC lerfixdomff(e:ANY-set):ffanyany
RETURNS [ x -> lerany(x) | x <- e ];

;---------------------------------------------------------------------
; PrettyPrint - pp
;---------------------------------------------------------------------

;    pp(valor) = do(  princ(" "),
;                     if valor == nil then
;                       fputs("{} ")
;                     else
;                       pprint1(valor, 1,0), princ("\n") );
;
    fpp(valor) = nwrite(stdout,valor);
;
;    ppn(valor) = do(  princ(" "),
;                     if valor == nil then
;                       fputs("{} ")
;                     else
;                      pprint1(valor, 1,0));
    /* --- */

;    pprint1(valor,i,ml) =
;    if valor == nil then 
;       fputs(" {} ")
;     else 
;       let (tipo = type(valor))
;       in if (tipo in {'INT, 'STR, 'SYM} -> pvalor(valor),
;              tipo == 'FF                -> pff(valor, i,ml),
;              tipo == 'REL               -> prel(valor, i,ml),
;              tipo == 'SET               -> pset(valor, i,ml),
;              tipo == 'LIST              -> plist(valor, i,ml),
;              tipo == 'ALT               -> palt(valor, i,ml),
;              tipo == 'FUN               -> pfunc(valor, i,ml)
;             )
;           otherwise
;             let (tipoex = gettype(tipo))
;             in if hd(tipoex) == 'EQ  then
;                   peq(valor, tipo, i,ml)
;                 else          
;                   ptup(tipo, valor, tl(tipoex), i,ml);
;
;    /* --- */
;
;    pvalor(valor) = princ(valor," ");
;
;    /* --- */
;
;    pff(valor,i,ml) =
;    do( if(ml == 1) then indent(i),
;        fputs("[ "),
;        let (y = choice(dom(valor)),
;             valor_ = dom(valor)-{y},
;             i2 = add(2,i))
;        in do( pprint1(y, i2, 0),
;               fputs("-> "),
;               pprint1(valor[y], i2, 0),
;               { do( indent(i2),
;                     pprint1(x, i2,1),
;                     fputs("-> "),
;                     pprint1(valor[x], i2, 0)) 
;               | x <- valor_ }
;             ),
;        fputs("]")
;      );
;
;     /* --- */
;    pfunc(valor,i,ml) =
;   do( if(ml == 1) then indent(i),
;        fputs("func ("),
;        foreach(x,hd(valor),pvalor(x)),
;        fputs(")="),
;        pexp(hd(tl(valor)),i.+1,1)
;     );
;
;    /* --- */
;    pexp(valor,i,ml) = plist(valor,i,ml);
;    /* --- */
;
;    prel(valor,i,ml) =
;    do(    if(ml == 1) then indent(i),
;           fputs("[ "),
;           let (y = choice(valor),
;                j = add(i,2),
;                valor_ = valor-[*hd(y) -> hd(tl(y))*]
;               )
;           in do( pprint1(first(y), j,0),
;                     fputs("<-> "),
;                     pprint1(second(y), j,0),
;                     { do( indent(j),
;                           pprint1(first(x), j,1),
;                           fputs("<-> "),
;                           pprint1(second(x), j,0)) 
;                     | x <- valor_
;                     }
;                ),
;           fputs("]")
;         );
;
;    /* --- */
;
;    pset(valor,i,ml) = 
;    do   (if (ml == 1) then indent(i), 
;          fputs("{ "),
;          let(p=choice(valor),
;              j=add(i,2),
;              r=valor - {p} )
;          in do( pprint1(p,j,0),
;                 { pprint1(x, j, 1) | x <- r }),
;          fputs("}")
;         );
;
;    /* --- */
;
;    plist(valor,i,ml) = 
;    do   (if (ml == 1) then indent(i), 
;          fputs("< "),
;          let(p=hd(valor),
;              j=add(i,2),
;              r=tail(valor))
;          in do( pprint1(p,j,0),
;                 { pprint1(x, j, 1) | x <- r }),
;          fputs(">")
;         );
;
;    /* --- */
;
;    peq(nome,valor,i,ml) =
;    do( fputs("("),
;           fputs(nome),
;           fputs(")"),
;           let (len = add(strlen(nome), 2))
;           in pprint1(ignlab(valor), add(lin, i),0)
;         );
;
;    /* --- */
;
;    ptup(nome,valor,tipo,i,ml) =
;    do(
;           if(ml == 1) then indent(i),
;           fputs("[ "),
;           let( len = add( 2, i),
;                k = choice(elems(inds(tipo))),
;                inds_ = elems(inds(tipo))-{k},
;                selec = first(nth(k, tipo)),
;                len_ = add(add(strlen(symstr(selec)), 2), len))
;           in  do( fputs(symstr(selec)),
;                   fputs(": "),
;                   pprint1((eval(selec))(valor), len_,0),
;                   { let (selector = first(nth(j, tipo)),
;                          len1 = add(add(strlen(symstr(selector)), 2), len)
;                         )
;                     in do( indent(len),
;                            fputs(symstr(selector)),
;                            fputs(": "),
;                            pprint1((eval(selector))(valor), len1,0)) 
;                   | j <- inds_ }
;                 ),
;           fputs("] ")
;       );
;
;    /* --- */
;
;    indent(i) = let (s = inseg(i))
;                in fputs(strcat("\n", strcat-orio("",
;                                <" "|y <- s : (y <= i)>)));
;
;                            
; pp(<1,2,3,{2,4},[ 1-> 3]>);
; pp(obs);
; pp(M);

/*-----------------------------------------------------------------*/
/* Menus  */
;          pickone 
;          menu
;          run 

leropcao (x)=let(a=lerstr(x))
            in if(a=="\e\n") then 0
                             else atoi(a);

TYPE
   tmenu :: titger : STR                /*     titulo do menu     */
            opcoes_list : opcoes-list;  /*     lista das opcoes   */
   opcoes :: titopc : STR               /*     tilulo da opcao    */
             accao_op : taccao;  
   taccao =  tmenu | SYM |INT | _exp;
   _exp = ANY;
ENDTYPE

FUNC menu(m:tmenu):SYM
RETURN
    let( m1=opcoes_list(m),
         a1=do(
            princ("\n--------------------------------------------------"),
            princ("\n\t",titger(m),"\n\n\t"),
            { princ(x," ",titopc(el(x,m1)),"\n\t") | x <- inds(m1) },
            _b<- leropcao("\nqual a opcao? "),
            while(( _b > length(m1))||(_b<0),_b <-leropcao("qual a opcao? ")),
            princ("\n--------------------------------------------------\n")),
         acc= if( 0 != _b) then accao_op(el(_b,m1))
                              else _b )
    in if(
            'SYM == type(acc)   -> (eval(acc))() ,
            is-tmenu(acc) -> menu(acc),
            'LIST == type(acc)  -> eval(acc),
            'INT == type(acc)   -> acc )
       otherwise acc;

;FUNC run (m:tmenu)
;STATE let(x=menu(m))
;       in if (x == 0) then NIL
;          else do( pp(x),run(m));
; dada a necessidade de eficiencia desta funcao, foi reescrita de modo 
;  mais imperativo...
FUNC run (m:tmenu)
STATE while(let(x=menu(m))
            in if(x != 0) then do(pp(x),true)
                          else false);

/*--(teste )-----------------------------------------------------------*/
;M <- tmenu("Menu geral",
;           <opcoes("conteudo deste menu",'(pp(M))),
;            opcoes("invocacao deste menu",'(menu(M)))>);
;            
;pptmenu(x,i)= do(fputs("\nTitulogeral: "), pp(titger(x)),
;                  fputs("\nOpcoes:\n"), pp(opcoes_list(x)));
;
;ppopcoes(x,i)= do(fputs("\ttiulo: "), pp(titopc(x)),
;                   fputs("\n\taccao: "), pp(accao_op(x)),
;                   fputs("\n"), NIL);
;