%
%  vtsam.pro (Very Tiny SAM)
%
%  Adaptacao de vt_sam (AI Expert, October 1987, p.19-27), simplissimo aplicador de 
%  scripts inspirado no famoso SAM (Script Applier Mechanism).
%
%  Fornecem-se como exemplo dois scripts para um restaurante universitario (bandeijao).
%
%  Predicado principal: main/0 (auto-explicativo).
%
%  Obs.: talvez o maior feito desse programa, dada da pouca experiencia do programador em
%        processamento de lingua natural, foi o desacoplamento alcancado entre os niveis
%        lexico, sintatico e semantico no tratamento das frases de entrada. Apesar de con-
%        ter passagens memoraveis em Prolog, o esquema concebido eh, ainda, extremamente
%        modesto.
%


%
%  Predicados de acesso às estruturas Being, que contem informacao sobre cada ser envolvido
%  numa estorinha.
%

id(Id, b(Id, _, _, _, _)).

noun(Noun, b(_, Noun, _, _, _)).

gender(G, b(_, _, G, _, _)).

number(N, b(_, _, _, N, _)).


prop(id(Id), b(Id, _, _, _, _)) :-
  !.

prop(noun(Noun), b(_, Noun, _, _, _)) :-
  !.

prop(gender(G), b(_, _, G, _, _)) :-
  !.

prop(number(N), b(_, _, _, N, _)) :-
  !.

prop(Prop, b(_, _, _, _, Props)) :-
  elem(Prop, Props).


anonymous(b(_, _, _, _, _)) :-
  idsDisabled,
  !.

anonymous(b(Id, _, _, _, _)) :-
  var(Id),
  gensym(b, Id). 


notAnonymous(b(_, _, _, _, _)) :-
  idsDisabled,
  !.

notAnonymous(b(Id, _, _, _, _)) :-
  nonvar(Id).


enableIds :-
  retractall(idsDisabled).

disableIds :-
  retractall(idsDisabled),
  assert(idsDisabled).


%
%  Gramatica DCG de conversao significado-frase (significados em Dependencia Conceitual
%  simplificada)
%
%  Simbolo incial: s
%
%  Obs.: essa gramatica faz conversoes nos dois sentidos, capacidade explorada pelo programa
%        para expandir a estoria de forma adequada.
%
%  Com os ids de objeto habilitados (enableIds), essa gramatica se torna bastante rigorosa
%  quanto ao uso de artigos.
%
%  Conseguiu-se um desacoplamento consideravel entre os niveis semantico, sintatico e lexico. A
%  presente DCG representa a base sintatica.
%

s(Trans) --> nounPhrase(G, N, Suj, SujIsOk), verbPhrase(G, N, SujIsOk, Suj, Trans).


nounPhrase(G, N, B, IsOk) --> [Noun], {noun(Noun, B), gender(G, B), number(N, B), being(B), (prop(uncountable, B), IsOk = anonymous(B); prop(proper, B), not prop(defArtRequired, B), IsOk = true; idsDisabled, IsOk = true)}.

nounPhrase(G, N, B, notAnonymous(B)) --> defArt(G, N), [Noun], {noun(Noun, B), gender(G, B), number(N, B), being(B)}.

nounPhrase(G, N, B, true) --> undefArt(G, N), [Noun], {noun(Noun, B), anonymous(B), gender(G, B), number(N, B), being(B), not prop(uncountable, B)}.

nounPhrase(G, sing, each(B), IsOk) --> {number(sing, B)}, nounPhrase(G, sing, B, IsOk).

nounPhrase(G, sing, each(B), true) --> {number(pl, B)}, [cada, SingNoun], {sing(SingNoun, PlNoun), noun(PlNoun, B), being(B)}.


defArt(G, N) --> [X], {defArt(X, G, N)}.

undefArt(G, N) --> [X], {undefArt(X, G, N)}.


verbPhrase(G, N, SujIsOk, Suj, Trans) --> [Verb], {conjug(Verb, N, Inf), baseForm(Inf, Objs, Suj, Trans, VerbIsOk), call(SujIsOk)}, objPhrase(Objs), {call(VerbIsOk)}.

objPhrase([]) --> [].

objPhrase([Prep:Obj| Rest]) --> prep(Prep), nounPhrase(_, _, Obj, ObjIsOk), {call(ObjIsOk)}, objPhrase(Rest).


prep(x) --> [].

prep(Prep) --> {Prep \= x}, [Prep].


%
%  Base semantica
%
%  Refere-se aos significados dos verbos, de acordo com cada regencia, compondo-se de 
%  um conjunto de predicados
%
%    baseForm(Inf, ObjsERegs, Suj, DC, IsOk)
%
%  onde: . Inf eh o infinitivo do verbo ("base form");
%        . ObjsERegs eh uma lista contendo pares de objetos e respectivas preposicoes 
%          introdutorias na ordem em que devem aparecer. ObjsERegs pode ser vazia, carac-
%          terizando um verbo intransitivo, ou conter um numero qualquer de elementos. 
%          Uma preposicao 'x' representa, na verdade, ausencia de preposicao, caracteri-
%          zando o objeto direto;
%        . Suj eh o sujeito do verbo;
%        . DC eh a representacao da acao do verbo em Dependencia Conceitual; e
%        . IsOk eh um predicado de validacao a ser chamado quando todos os objetos estiverem
%          disponiveis. Recorrendo-se a IsOk, pode-se, por exemplo, garantir que a acao de
%          beber so se aplique a objetos liquidos.
%


baseForm(tomar, [x: What, de: Whom], Suj, atrans(Suj, Whom, Suj, What), (holdsForEach(living, Suj), holdsForEach(living, Whom))).
baseForm(dar, [x: What, a: Whom], Suj, atrans(Suj, Suj, Whom, What), holdsForEach(living, Whom)).
baseForm(pegar, [x: What, em: Where], Suj, atrans(Suj, Where, Suj, What), not holdsForEach(living, Where)).
baseForm(colocar, [x: What, em: Where], Suj, atrans(Suj, Suj, Where, What), not holdsForEach(living, Where)).
baseForm(transferir, [x: What, de: Src, para: Dest], Suj, ptrans(Suj, What, Src, Dest), Suj \= What).
baseForm(tomar, [x: What], Suj, ingest(Suj, What), holdsForEach(drinkable, What)).
baseForm(comer, [x: What], Suj, ingest(Suj, What), not holdsForEach(drinkable, What)).
baseForm(pegar, [x: Disease], Suj, ingest(Suj, Bacteria), (noun(DisName, Disease), badBacteria(DisName, BactName), being(BactName, Bacteria))).
baseForm(ir, [a: Dest], Suj, ptrans(Suj, Suj, unknown, Dest), true).
baseForm(ir, [de: Src, a: Dest], Suj, ptrans(Suj, Suj, Src, Dest), true).
baseForm(sair, [de: Src], Suj, ptrans(Suj, Suj, Src, unknown), true).


holdsForEach(Prop, each(B)) :-
  !,
  prop(Prop, B).

holdsForEach(Prop, B) :-
  prop(Prop, B).


%
%  Base lexical (com "tracos semanticos")
%

defArt(o, m, sing).
defArt(os, m, pl).
defArt(a, f, sing).
defArt(as, f, pl).

undefArt(um, m, sing).
undefArt(uns, m, pl).
undefArt(uma, f, sing).
undefArt(umas, f, pl).

/*
conjug(u, sing, r).
conjug(ram, pl, r).
*/

conjug(comeu, sing, comer).
conjug(comeram, pl, comer).

conjug(tomou, sing, tomar).
conjug(tomaram, pl, tomar).

conjug(pegou, sing, pegar).
conjug(pegaram, pl, pegar).

conjug(colocou, sing, colocar).
conjug(colocaram, pl, colocar).

conjug(deu, sing, dar).
conjug(deram, pl, dar).

conjug(depositou, sing, depositar).
conjug(depositaram, pl, depositar).

conjug(transferiu, sing, transferir).
conjug(transferiram, pl, transferir).

conjug(foi, sing, ir).
conjug(foram, pl, ir).

conjug(saiu, sing, sair).
conjug(sairam, pl, sair).

exchange([de, a], [da]).
exchange([de, o], [do]).
exchange([a, a], ['à']).
exchange([a, o], [ao]).
exchange([em, a], [na]).
exchange([em, o], [no]).



being(Noun, Being) :-
  noun(Noun, Being),
  being(Being).

being(b(Id, Noun, G, N, Props)) :-
  singBeing(Id, SingNoun, G, Props),
  (
    Noun = SingNoun,
    N = sing
  ;
    sing(SingNoun, Noun),
    N = pl
  ).


singBeing(_, Obj, G, Props) :-
  object(Obj, G, Props).

singBeing(_, Matter, G, [uncountable]) :-
  matter(Matter, G).

singBeing(_, GenLiving, G, [living]) :-
  genLiving(GenLiving, G).

singBeing(_, Individual, G, [proper, living]) :-
  individual(Individual, G).

singBeing(Id, SpecificPlace, G, [proper, defArtRequired]) :-
  specificPlace(Id, SpecificPlace, G).

sing(ticket, tickets).
sing(mulher, mulheres).
sing(homem, homens).

object(roleta, f, []).
object(roleta_de_entrada, f, []).
object(roleta_de_saida, f, []).
object(pilha_de_bandeijas_semilimpas, f, []).
object(janela_de_devolucao, f, []).
object(pilha_de_bandeijas_sujas, f, []).
object(carne, f, []).
object(mistura, f, []).
object(sobremesa, f, []).
object(sobremesa_boa, f, []).
object(sobremesa_reles, f, []).
object(mesa, f, []).
object(cacamba, f, []).
object(bandeija, f, []).
object(cacamba, f, []).
object(pedrinha, f, []).
object(banana, f, []).
object(maca, f, []).
object(ova_de_inseto, f, []).
object(balcao_de_carne, m, []).
object(balcao_self_service, m, []).
object(restaurante_universitario, m, []).
object(ru, m, []).
object(bandeijao, m, []).
object(bandex, m, []).
object(ticket, m, []).
object(corpo_estranho, m, []).
object(bife_cinza, m, []).
object(bife_a_milanesa, m, []).
object(chocolate, m, []).
object(nutry, m, []).
object(danette, m, [drinkable]).

matter(salada, f).
matter(couve_refogada, f).
matter(abobrinha_refogada, f).
matter(banana_caramelada, f).
matter(chicoria, f).
matter(alface, f).
matter(toxoplasmose, f).
matter(arroz, m).
matter(almeirao, m).
matter(agriao, m).
matter(strogonoff, m).
matter(creme_de_milho, m).
matter(feijao, m).
matter(toxoplasma_gondii, m).
matter(arroz_doce, m).
matter(manjar_mingau_duro, m).

genLiving(mulher, f).
genLiving(tia, f).
genLiving(lagarta, f).
genLiving(homem, m).
genLiving(tio, m).
genLiving(roleteiro, m).

individual(joao, m).
individual(maria, f).

specificPlace(band, bandeijao, m).
specificPlace(band, bandex, m).
specificPlace(band, restaurante_universitario, m).
specificPlace(band, ru, m).

badBacteria(toxoplasmose, toxoplasma_gondii).


%
%  Base de conhecimento especifica sobre o Bandeijao
%

%
%  Cardapio - conhecimento especifico de cardapios do Bandex
%

carne(carne).
carne(bife_cinza).
carne(bife_a_milanesa).
carne(strogonoff).

mistura(mistura).
mistura(couve_refogada).
mistura(abobrinha_refogada).
mistura(creme_de_milho).

salada(alface).
salada(chicoria).
salada(almeirao).
salada(agriao).

sobremesa_boa(sobremesa_boa).
sobremesa_boa(sobremesa).
sobremesa_boa(danette).
sobremesa_boa(nutry).
sobremesa_boa(chocolate).

sobremesa_reles(sobremesa_reles).
sobremesa_reles(sobremesa).
sobremesa_reles(banana_caramelada).
sobremesa_reles(arroz_doce).
sobremesa_reles(banana).
sobremesa_reles(maca).
sobremesa_reles(manjar_mingau_duro).

corpo_estranho(corpo_estranho).
corpo_estranho(toxoplasma_gondii).
corpo_estranho(pedrinha).
corpo_estranho(lagarta).
corpo_estranho(ova_de_inseto).


tipo_prato(carne).
tipo_prato(mistura).
tipo_prato(salada).
tipo_prato(sobremesa_boa).
tipo_prato(sobremesa_reles).
tipo_prato(corpo_estranho).


comida_bandeijao(X) :-
  tipo_prato(Tipo),
  Pred =.. [Tipo, X],
  Pred.


%
%  Predicados auxiliares para a validacao de scripts do bandeijao
%

foodBeing(Type, Being) :-
  var(Being),
  !,
  being(Type, Being).

foodBeing(Type, Being) :-
  noun(Noun, Being),
  nonvar(Noun),
  IsOk =.. [Type, Noun],
  IsOk.


opt(Pred) :-
  call(Pred),
  !.

opt(_).


alienBeing(Being) :-
  var(Being),
  !,
  retract(corpo_estranho(Noun)),
  assertz(corpo_estranho(Noun)),
  noun(Noun, Being),
  being(Being).

alienBeing(Being) :-
  foodBeing(corpo_estranho, Being).

%
%  Base de scripts 
%
%  Dois scripts referentes ao Bandeijao sao fornecidos: o primeiro refere-se aos dias em que a 
%  sobremesa eh boa (tendo, portanto, distribuicao controlada); o segundo, aos dias em que a
%  sobremesa nao eh tao concorrida assim.
%
%  Os scripts estao representados no seguinte formato:
%
%    script(Id, ListaEventos, PredValidacao)
%
%  onde: . Id - identificador do script;
%        . ListaEventos - lista dos eventos (em dependencia conceitual) do script;
%        . PredValidacao - um predicado a ser chamado apos o script ter sido casado
%          com uma estoria, possivelmente resolvendo valores default e fazendo algum
%          tipo de validacao.
%

script(bandeijao, 
  [
    ptrans(Vitima, Vitima, DeOnde, Bandeijao),
    atrans(each(Vitima), each(Vitima), Roleteiro, Ticket),
    ptrans(Vitima, Vitima, RoletaIn, BalcaoDeCarne),
    atrans(each(Vitima), PilhaDeBandeijasSemilimpas, each(Vitima), Bandeija),
    ptrans(Tia, Carne, Cacamba1, Bandeija),
    atrans(Tio, Tio, each(Vitima), SobremesaBoa),
    ptrans(Vitima, Vitima, BalcaoDeCarne, BalcaoSelfService),
    ptrans(each(Vitima), Arroz, Cacamba2, Bandeija),
    ptrans(each(Vitima), Feijao, Cacamba3, Bandeija),
    ptrans(each(Vitima), Mistura, Cacamba4, Bandeija),
    ptrans(each(Vitima), Salada, Cacamba5, Bandeija),
    ptrans(Vitima, Vitima, BalcaoSelfService, Mesa),
    ingest(Vitima, Carne),
    ingest(Vitima, Arroz),
    ingest(Vitima, Feijao),
    ingest(Vitima, Mistura),
    ingest(Vitima, Salada),
    ingest(Vitima, SobremesaBoa),
    ingest(Vitima, Alien),
    ptrans(Vitima, Vitima, Mesa, JanelaDeDevolucao),
    atrans(each(Vitima), each(Vitima), PilhaDeBandeijasSujas, Bandeija),
    ptrans(Vitima, Vitima, JanelaDeDevolucao, RoletaOut),
    ptrans(Vitima, Vitima, Bandeijao, ParaOnde)
  ],
  (
    opt(DeOnde = unknown),
    opt(being(bandeijao, Bandeijao)),
    opt(being(roleteiro, Roleteiro)),
    opt(being(ticket, Ticket)),
    opt(being(balcao_de_carne, BalcaoDeCarne)),
    opt(being(bandeija, Bandeija)),
    opt(being(pilha_de_bandeijas_semilimpas, PilhaDeBandeijasSemilimpas)),
    foodBeing(carne, Carne),
    opt(being(cacamba, Cacamba1)),
    opt(being(cacamba, Cacamba2)),
    opt(being(cacamba, Cacamba3)),
    opt(being(cacamba, Cacamba4)),
    opt(being(cacamba, Cacamba5)),
    opt(being(balcao_self_service, BalcaoSelfService)),
    foodBeing(sobremesa_boa, SobremesaBoa),
    foodBeing(mistura, Mistura),
    foodBeing(salada, Salada),
    alienBeing(Alien),
    opt(being(mesa, Mesa)),
    opt(being(janela_de_devolucao, JanelaDeDevolucao)),
    opt(being(pilha_de_bandeijas_sujas, PilhaDeBandeijasSujas)),
    opt(ParaOnde = unknown)
  )
) :-
    being(arroz, Arroz),
    being(feijao, Feijao),
    being(roleta_de_entrada, RoletaIn),
    being(roleta_de_saida, RoletaOut),
    being(tia, Tia),
    being(tio, Tio).


script(bandeijao, 
  [
    ptrans(Vitima, Vitima, DeOnde, Bandeijao),
    atrans(each(Vitima), each(Vitima), Roleteiro, Ticket),
    ptrans(Vitima, Vitima, RoletaIn, BalcaoDeCarne),
    atrans(each(Vitima), PilhaDeBandeijasSemilimpas, each(Vitima), Bandeija),
    ptrans(Tia, Carne, Cacamba1, Bandeija),
    ptrans(Vitima, Vitima, BalcaoDeCarne, BalcaoSelfService),
    ptrans(each(Vitima), Arroz, Cacamba2, Bandeija),
    ptrans(each(Vitima), Feijao, Cacamba3, Bandeija),
    ptrans(each(Vitima), Mistura, Cacamba4, Bandeija),
    ptrans(each(Vitima), Salada, Cacamba5, Bandeija),
    ptrans(each(Vitima), SobremesaReles, Cacamba6, Bandeija),
    ptrans(Vitima, Vitima, BalcaoSelfService, Mesa),
    ingest(Vitima, Carne),
    ingest(Vitima, Arroz),
    ingest(Vitima, Feijao),
    ingest(Vitima, Mistura),
    ingest(Vitima, Salada),
    ingest(Vitima, SobremesaReles),
    ingest(Vitima, Alien),
    ptrans(Vitima, Vitima, Mesa, JanelaDeDevolucao),
    atrans(each(Vitima), each(Vitima), PilhaDeBandeijasSujas, Bandeija),
    ptrans(Vitima, Vitima, JanelaDeDevolucao, RoletaOut),
    ptrans(Vitima, Vitima, Bandeijao, ParaOnde)
  ],
  (
    opt(DeOnde = unknown),
    opt(being(bandeijao, Bandeijao)),
    opt(being(roleteiro, Roleteiro)),
    opt(being(ticket, Ticket)),
    opt(being(balcao_de_carne, BalcaoDeCarne)),
    opt(being(bandeija, Bandeija)),
    opt(being(pilha_de_bandeijas_semilimpas, PilhaDeBandeijasSemilimpas)),
    foodBeing(carne, Carne),
    opt(being(cacamba, Cacamba1)),
    opt(being(cacamba, Cacamba2)),
    opt(being(cacamba, Cacamba3)),
    opt(being(cacamba, Cacamba4)),
    opt(being(cacamba, Cacamba5)),
    opt(being(cacamba, Cacamba6)),
    opt(being(balcao_self_service, BalcaoSelfService)),
    foodBeing(sobremesa_reles, SobremesaReles),
    foodBeing(mistura, Mistura),
    foodBeing(salada, Salada),
    alienBeing(Alien),
    opt(being(mesa, Mesa)),
    opt(being(janela_de_devolucao, JanelaDeDevolucao)),
    opt(being(pilha_de_bandeijas_sujas, PilhaDeBandeijasSujas)),
    opt(ParaOnde = unknown)
  )
) :-
    being(arroz, Arroz),
    being(feijao, Feijao),
    being(roleta_de_entrada, RoletaIn),
    being(roleta_de_saida, RoletaOut),
    being(tia, Tia),
    being(tio, Tio).

%
%  vt_sam
%

vt_sam(Story, Script):-
  find(Story, Script, IsOk),
  match(Script, Story),
  IsOk.

vt_sam(Story, []):-
  write('Ops, nao houve script que casasse com essa estoria.'), nl.

%  find/3 - procura de um script que case com a estoria.

find(Story, Script, IsOk):-
  filler(Slot, Story),
  nonvar(Slot),  
  noun(Noun, Slot),
  trigger(Noun, ScriptId),
  script(ScriptId, Script, IsOk).


%  match(Script, Story) - para toda linha da estoria Story ha uma linha que casa no
%                         script Script, na ordem.

match(_, []).

match([Line| Script], [Line| Story]):-
  match(Script, Story).

match([_| Script], Story):-
  match(Script, Story).


%  filler(Slot, Story) - Slot eh um dos parametros de algum evento da estoria Story.

filler(Slot, Story):-
  elem(Event, Story),
  Event =.. [_| Args],
  elem(Slot, Args).

%  trigger(Trigger, ScriptId) - Trigger eh uma palavra-chave que ativa o script de id ScriptId.

trigger(bandex, bandeijao).
trigger(bandeijao, bandeijao).
trigger(ru, bandeijao).
trigger(restaurante_universitario, bandeijao).
trigger(bandeija, bandeijao).
trigger(tia, bandeijao).
trigger(tio, bandeijao).
trigger(Comida, bandeijao) :- comida_bandeijao(Comida).
trigger(ticket, bandeijao).
trigger(roleta_de_entrada, bandeijao).
trigger(roleta_de_saida, bandeijao).
trigger(roleta, bandeijao).


%
%  Predicados auxiliares
%


elem(X, [X| _]).

elem(X, [_| Xs]) :-
  elem(X, Xs).


%
%  list_dl(List, OpenDl)
%
%  Converte a lista convencional List na lista-diferenca aberta OpenDl e vice-
%  versa. Uma lista-diferenca aberta OpenL/Tail eh, em ultima analise, uma lis-
%  ta aberta OpenL a cuja cauda variavel - Tail - tem-se acesso direto. 
%
%  Por exemplo, [a, b, c| X]/X eh a lista-diferenca aberta correspondente a [a,
%  b, c].
%

list_dl([], Xs/Xs) :-
  !.

list_dl([X| Xs], [X| Ys]/Zs) :-
  list_dl(Xs, Ys/Zs).


%
%  buildExchange_dl(X, Y, Exchange_dl).
%  
%  A partir do par de substituicao-padrao X->Y, a ser obtido pelo acesso a 
%  exchange/2, buildExchange_dl/3 monta o termo Exchange_dl correspondente, que
%  nao faz nada mais que agregar X e Y em versao lista-diferenca aberta.  
%
%  Para que se tenha uma ideia da vantagem de se usar listas-diferenca abertas
%  nessa aplicacao, observe o seguinte exemplo: supondo que exista o par de
%  substituicao
%
%    [a, b, c, d, e| Resto1]/Resto1 -> [o, p, q, r| Resto2]/Resto2,
%    |<------- L1 -------->|           |<-- L2 ->|           
%
%  e que se queira comecar a realizar substituicoes na sequencia L3, gerando
%  Rslt,
%
%    [a, b, c, d, e, f, g] -> Rslt
%    |<------ L3 ------->|
%        
%  basta tentar unificar L1 = L3 e L2 = Rslt (operacoes bastante eficientes,
%  se comparadas com suas alternativas mais triviais). Caso ambas as unifica-
%  coes sejam bem-sucedidas, tem-se os seguintes efeitos colaterais:
%
%    . a presenca de [a, b, c, d, e] foi detectada no inicio de L1; 
%    
%    . Rslt eh igual a [o, p, q, r| Resto2], consumando a substituicao;
%
%    . Resto1 casou com [f, g]. Dessa forma, pode-se continuar o processamen-
%      to das substituicoes diretamente a partir de Resto1 e Resto2.  
%
%  O uso de exchange_dl/2 pode ser observado em fixReply/2. 
%

buildExchange_dl(X, Y, exchange_dl(DX, DY)) :-
  list_dl(X, DX),
  list_dl(Y, DY).


exchanged(As, Xs) :-
  exchanged_dl(As, Xs/[]).

exchanged_dl([], Xs/Xs).

exchanged_dl(As, Xs/Zs) :-
  exchange_dl(As/Bs, Xs/Ys),  %  <- uma vez casados os padroes, tem-se acesso 
  !,                          %     direto ao restante ainda nao processado
  exchanged_dl(Bs, Ys/Zs).    %     das duas listas (Bs e Ys).

exchanged_dl([X| Xs], [X| Ys]/Zs) :-
  exchanged_dl(Xs, Ys/Zs).


prepare(exchange_dl) :-
  retractall((exchange_dl(_, _) :- _)), % <- evita duplicacao.
  clause(exchange(X, Y), Body),
  buildExchange_dl(X, Y, Head),
  assert((Head :- Body)),
  fail.

prepare(_).

:- prepare(_).


%-------------------------------------------------------------------------------------
/* Ler uma frase */

le_frase([W|Ws]):- get0(C), 
        readword(C, W, C1), 
        restsent(W, C1, Ws).

/* Dado uma palavra e um caracter apos a palavra, ler o resto da frase */

restsent(W,_, []):- lastword(W), !. 
restsent(W, C, [W1|Ws]):- readword(C, W1, C1), restsent(W1, C1, Ws).

/* ler uma palavra simples, dado um caracter inicial, lembras qual caracter vem apos a 
palavra */

readword(C, W, C1):- single_character(C), !, name(W, [C]), get0(C1).
readword(C, W, C2):-
        in_word(C, NewC), !,
        get0(C1),
        restword(C1, Cs, C2),
        name(W, [NewC|Cs]).
readword(C, W, C2):- get0(C1), readword(C1, W, C2).

restword(C, [NewC|Cs], C2):- 
        in_word(C, NewC), !, 
        get0(C1),
        restword(C1, Cs, C2).
restword(C, [], C).

single_character(44).  /* , */
single_character(59).  /* ; */
single_character(58).  /* : */
single_character(63).  /* ? */
single_character(33).  /* ! */
single_character(46).  /* . */

/* caracteres que podem aparecer com uma palavra */
in_word(C, C):- C>96, C<123.    /* a, b, ....z*/
in_word(C, L):- C>64, C<91, L is C+32.  /* A, B, ....Z */ 
in_word(C, C):- C>47, C<58.   /* 1, 2, 3, ....9*/
in_word(39, 39).
in_word(45, 45).
in_word(95, 95).

/* Pontuacao */
lastword('.').
lastword('!').
lastword('?').

%-------------------------------------------------------------------------------------

le_estoria(Estoria) :-
  le_frase(Frase),
  processa_frase(Frase, Estoria).

processa_frase([fim, '.'], []) :-
  !.

processa_frase(Frase, [T| Estoria]) :-
  exchanged(Expansao, Frase),
  s(T, Expansao, ['.']),
  !,
  le_estoria(Estoria).

processa_frase(_, []) :-
  nl, write('Frase invalida: abortando a operacao!'), nl, nl,
  fail.

%-------------------------------------------------------------------------------------

translate([]) :-
  write('fim.').

translate([T| Ts]) :-
  s(T, Phrase, []),
  !,
  exchanged(Phrase, FinalForm),
  writePhrase(FinalForm),
  translate(Ts).


writePhrase([]) :-
  write('.'), nl.

writePhrase([W| Ws]) :-
  write(' '),
  write(W),
  writePhrase(Ws).


main :-
  write('Alguns itens uteis de vocabulario: '), nl, nl,
  write('\t. atores: joao, maria, homem(s), mulher(es);'), nl,
  write('\t. verbos: comeu(ram) <alguma comida>, tomou(ram) danette, pegou(ram) toxoplasmose;'), nl,
  write('\t. carnes: strogonoff, bife_cinza, bife_a_milanesa;'), nl,
  write('\t. "misturas": couve_refogada, abobrinha_refogada, creme_de_milho;'), nl,
  write('\t. saladas: alface, chicoria, agriao, almeirao;'), nl,
  write('\t. sobremesas boas (distribuicao controlada): danette, chocolate, nutry;'), nl,
  write('\t. sobremesas reles (livre): maca, banana, banana_caramelada, arroz_doce.'), nl,
  write('\t. corpos estranhos (inevitaveis): toxoplasma_gondii, pedrinha, lagarta, ova_de_inseto.'), nl, nl,
  write('Obs.: 1 - devido às limitacoes da linguagem de scripts aqui usada, os pratos, na'), nl,
  write('          historia, devem ser comidos na ordem acima (nunca dois tipos de sobremesa!);'), nl,
  write('Obs.: 2 - pelo mesmo motivo, o ato de pegar toxoplasmose conta como um ato de'), nl,
  write('          comer um corpo estranho, devendo ser narrado na ordem correta.'), nl, nl,
  write('Entre com uma estoria, cada frase terminada com um ponto-final seguido de <ENTER>.'), nl,
  write('Finalize a estoria com a frase "fim."'), nl, nl,
  disableIds,
  le_estoria(Estoria),
  enableIds,
  vt_sam(Estoria, Script),
  !, nl, nl, 
  write('Estoria completa: '), nl,
  translate(Script),
  !.
  

main :-
  enableIds,
  fail.