:- discontiguous(perform/4).
:- discontiguous(validate/4).
:- discontiguous(validate/3).

%%%%%%%%%%%%%
%%% Model %%%
%%%%%%%%%%%%%

% Facts %

block(b1).
block(b2).
block(b3).
block(b4).
block(b5).
block(b6).
block(b7).
block(b8).

size(b1, large).
size(b2, large).
size(b3, large).
size(b4, large).
size(b5, small).
size(b6, small).
size(b7, small).
size(b8, small).

color(b1, yellow).
color(b2, red).
color(b3, blue).
color(b4, green).
color(b5, yellow).
color(b6, red).
color(b7, blue).
color(b8, green).

initial_state([on(b1, table), on(b2, table), on(b3, table), on(b4, table), on(b5, table),
    on(b6, table), on(b7, table), on(b8, table)]).
    
%%%%%%%%%%%%%
%%% Rules %%%
%%%%%%%%%%%%%
    
clear(Block, State) :- \+ member(on(_, Block), State).
empty_hand(State) :- \+ member(hand(_), State).
holding(State, Block) :- member(hand(Block), State).
is_on(Block1, Block2, State) :- member(on(Block1, Block2), State).

% PICKUP:
validate(pickup, Block, State) :- clear(Block, State), empty_hand(State).
%error text
validate(pickup, Block, State) :- \+clear(Block, State), 
    is_on(TopBlock, Block, State), color(TopBlock, C), size(TopBlock, S),
    write("Sorry, but that block is under the "), write(S), write(" "), write(C), write(" block."), nl, !, false.
validate(pickup, _, State) :- \+empty_hand(State), 
    write("Sorry, but there is already something in the hand."), nl, !, false.

validate(pickup, Block1, Block2, State) :- clear(Block1, State), is_on(Block1, Block2, State),
    (empty_hand(State)).
%error text
validate(pickup, Block1, _, State) :- \+clear(Block1, State), color(Block1, C1), size(Block1,S1),
    is_on(TopBlock, Block1, State), color(TopBlock, C), size(TopBlock, S), 
    write("Sorry, but the "), write(S1), write(" "), write(C1), write(" block is under the "), 
    write(S), write(" "), write(C), write(" block."), nl, !, false.
validate(pickup, Block1, Block2, State) :- \+is_on(Block1, Block2, State), 
    color(Block1, C1), size(Block1,S1),
    color(Block2, C2), size(Block2, S2), 
    write("The "), write(S1), write(" "), write(C1), write(" block is not on top of the "), 
    write(S2), write(" "), write(C2), write(" block."), nl, !, false.
validate(pickup, _, _, State) :- \+empty_hand(State), 
    write("Sorry, but there is already something in the hand."), nl, !, false.


% PUT
validate(put, Block1, Block2, State) :- \+(Block1= Block2), clear(Block1, State), clear(Block2, State),
    (empty_hand(State) ; holding(State, Block1)).
%error text
validate(put, Block1, Block2, _) :- Block1 = Block2,
    write("You cannot place a block on top of itself."), nl, !, false.
validate(put, Block1, _, State) :- \+clear(Block1, State), color(Block1, C1), size(Block1,S1),
    is_on(TopBlock, Block1, State), color(TopBlock, C), size(TopBlock, S), 
    write("Sorry, but the "), write(S1), write(" "), write(C1), write(" block is under the "), 
    write(S), write(" "), write(C), write(" block."), nl, !, false.
validate(put, _, Block2, State) :- \+clear(Block2, State), color(Block2, C1), size(Block2,S1),
    is_on(TopBlock, Block2, State), color(TopBlock, C), size(TopBlock, S), 
    write("Sorry, but the "), write(S1), write(" "), write(C1), write(" block can't have anything put on it. It's currently under the "), 
    write(S), write(" "), write(C), write(" block."), nl, !, false.
validate(put, Block1, _, State) :- \+(empty_hand(State) ; holding(State, Block1)),
    write("There is already something in the hand."), nl, !, false.

%this was missing the state condition to let it be an alternate rule for prolog
validate(put, Block, table, State) :- clear(Block, State), \+is_on(Block, table, State),
    (empty_hand(State) ; holding(State, Block)).
%error text
validate(put, Block, table, State) :- \+clear(Block, State), 
    is_on(TopBlock, Block, State), color(TopBlock, C), size(TopBlock, S),
    write("That block is under the "), write(S), write(" "), write(C), write(" block. You can't move it."), nl, !, false.
validate(put, Block, table, State) :- is_on(Block, table, State), 
    write("That block is already on the table."), nl, !, false.
validate(put, Block, table, State) :- \+(empty_hand(State) ; holding(State, Block)),
    write("There is already something in the hand."), nl, !, false.
    

% STACK
%this was missing the very important don't let us stack things on top of each other rule
validate(stack, Block1, Block2, State) :- Block1 \= Block2, clear(Block1, State), clear(Block2, State), 
    (empty_hand(State) ; holding(State, Block1)).
%error text
validate(stack, Block1, Block2, _) :- Block1 = Block2,
    write("You cannot stack a block on top of itself."), nl, !, false.
validate(stack, Block1, _, State) :- \+clear(Block1, State), color(Block1, C1), size(Block1,S1),
    is_on(TopBlock, Block1, State), color(TopBlock, C), size(TopBlock, S), 
    write("Sorry, but the "), write(S1), write(" "), write(C1), write(" block is under the "), 
    write(S), write(" "), write(C), write(" block."), nl, !, false.
validate(stack, _, Block2, State) :- \+clear(Block2, State), color(Block2, C1), size(Block2,S1),
    is_on(TopBlock, Block2, State), color(TopBlock, C), size(TopBlock, S), 
    write("Sorry, but the "), write(S1), write(" "), write(C1), write(" block can't have anything stacked on top of it. It's currently under the "), 
    write(S), write(" "), write(C), write(" block."), nl, !, false.
validate(stack, Block1, _, State) :- \+(empty_hand(State) ; holding(State, Block1)),
    write("There is already something else in the hand."), nl, !, false.


% UNSTACK
%this was missing a check to make sure the block wasn't already unstacked
validate(unstack, Block, State) :- \+is_on(Block, table, State), clear(Block, State), empty_hand(State).
%error text
validate(unstack, Block, State) :- is_on(Block, table, State),
    write("That block is already on the table."), nl, !, false.
validate(unstack, Block, State) :- \+clear(Block, State),
     is_on(TopBlock, Block, State), color(TopBlock, C), size(TopBlock, S),
    write("That block is under the "), write(S), write(" "), write(C), write(" block. You can't move it."), nl, !, false.
validate(unstack, _, State) :- \+empty_hand(State),
    write("There is already something in the hand."), nl, !, false.

%added check that Block2 is in fact a block
validate(unstack, Block1, Block2, State) :- block(Block2), clear(Block1, State), is_on(Block1, Block2, State),
    (empty_hand(State)).
%error text
validate(unstack, _, Block2, _) :- \+block(Block2),
    write("You cannot unstack a block from the table."), nl, !, false.
validate(unstack, Block1, _, State) :- \+clear(Block1, State),
    color(Block1, C1), size(Block1,S1),
    is_on(TopBlock, Block1, State), color(TopBlock, C), size(TopBlock, S), 
    write("The "), write(S1), write(" "), write(C1), write(" block is currently under the "), 
    write(S), write(" "), write(C), write(" block. You can't move it"), nl, !, false.
validate(unstack, Block1, Block2, State) :- \+is_on(Block1, Block2, State),
    color(Block1, C1), size(Block1, S1),
    color(Block2, C2), size(Block2, S2),
    write("The "), write(S1), write(" "), write(C1), write(" block isn't on the "),
    write(S2), write(" "), write(C2), write(" block."), nl, !, false.
validate(unstack, _, _, State) :- \+(empty_hand(State)),
    write("There is already something in the hand."), nl, !, false.
    

perform(pickup, Block, State, NewState) :- replace(on(Block,_), hand(Block), State, NewState).
perform(put, Block1, Target, State, NewState) :- perform(pickup, Block1, State, State1),
    replace(hand(Block1), on(Block1, Target), State1, NewState).
perform(stack, Block1, Target, State, NewState) :- perform(pickup, Block1, State, State1),
    replace(hand(Block1), on(Block1, Target), State1, NewState).
perform(unstack, Block, State, NewState) :- replace(on(Block,_), on(Block,table), State, NewState).

%%%%%%%%%%%
%%% NLP %%%
%%%%%%%%%%%

% Parsing %

sentence(s(VP)) --> verb_phrase(VP).
sentence(s(VP)) --> verb_phrase(VP), dot.
noun_phrase(np(Det, Noun)) --> det(Det), noun(Noun).
noun_phrase(np(Det, Adjp, Noun)) --> det(Det), adj_phrase(Adjp), noun(Noun).
verb_phrase(vp(Verb, NP)) --> verb(Verb), noun_phrase(NP).
verb_phrase(vp(Verb, NP, PP)) --> verb(Verb), noun_phrase(NP), prep_phrase(PP).
verb_phrase(vp(v(exit))) --> [exit]. %exit added to grammar
verb_phrase(vp(v(help))) --> [help]. %help added to grammar
prep_phrase(pp(Prep, NP)) --> prep(Prep), noun_phrase(NP).
adj_phrase(adjp(Adj)) --> adj(Adj).
adj_phrase(adjp(Adj, Adjp)) --> adj(Adj), adj_phrase(Adjp).
verb(v(put)) --> [put].
verb(v(pickup)) --> [pickup].
verb(v(stack)) --> [stack].
verb(v(unstack)) --> [unstack].
det(d(the)) --> [the].
adj(a(large)) --> [large].
adj(a(small)) --> [small].
adj(a(green)) --> [green].
adj(a(red)) --> [red].
adj(a(yellow)) --> [yellow].
adj(a(blue)) --> [blue].
noun(n(block)) --> [block].
noun(n(table)) --> [table].
prep(p(on)) --> [on].
prep(p(from)) --> [from].
dot --> ['.'].

%% Extracting Verbs and NPs %%

extract(s(vp(v(Verb), NounPhrase)), Verb, NounPhrase).
extract(s(vp(v(Verb), NounPhrase1, pp(p(Preposition), NounPhrase2))), Verb, NounPhrase1, NounPhrase2, Preposition).

%% Reference Resolution %%

% 2-adjective
resolve_ref(NP, _, Block) :- NP = np(_, adjp(a(Size), adjp(a(Color))), n(block)), 
    size(Block, Size), color(Block, Color).
resolve_ref(NP, _, Block) :- NP = np(_, adjp(a(Color), adjp(a(Size))), n(block)), 
    size(Block, Size), color(Block, Color).
resolve_ref(NP, _,_) :- NP = np(_, adjp(a(A1), adjp(a(A2))), n(table)), 
    write("The table is many things, but it isn't "), write(A1), write(" and "), write(A2), write("."), nl, !, false.
    
% 1-adjective 
resolve_ref(NP, State, Block) :- NP = np(_, adjp(a(Adjective)), n(block)), 
    findall(Block, identify(Adjective, State, Block), [Block]).
resolve_ref(NP, _,_) :- NP = np(_, adjp(a(_)), n(block)), 
    write("I can't find the block you're talking about. Be more descriptive."), nl, !, false.
resolve_ref(NP, _,_) :- NP = np(_, adjp(a(A)), n(table)), 
    write("The table is many things, but "), write(A), write(" is not one of them."), nl, !, false.

% 0-adjective  
resolve_ref(NP, State, Block) :- NP = np(d(the), n(block)), member(hand(Block), State).
resolve_ref(NP, _,_) :- NP = np(d(the), n(block)), 
    write("I can't find the block you're talking about. Use more adjectives."), nl, !, false.
resolve_ref(NP, _, table) :- NP = np(d(the), n(table)).

%find all the clear blocks
identify(Adjective, State, Block) :- (   size(Block, Adjective); color(Block, Adjective)),
    %member(on(Block, _), State), 
    clear(Block, State).

idTop(Adjective, State, TopBlock, BottomBlock) :- 
    (   size(TopBlock, Adjective); color(TopBlock, Adjective)),
    member(on(TopBlock, BottomBlock), State),
    clear(TopBlock, State).
idBottom(Adjective, State, TopBlock, BottomBlock) :- 
    (   size(BottomBlock, Adjective); color(BottomBlock, Adjective)),
    member(on(TopBlock, BottomBlock), State).

% double-reference resolution rules
% dont forget the table checks

% Need:
% 2 and 2
stacked_resolve(NP1, NP2, _, Block1, Block2) :-
    NP1 = np(_, adjp(a(_), adjp(a(_))), n(block)),
    NP2 = np(_, adjp(a(_), adjp(a(_))), n(block)),
    resolve_ref(NP1, _, Block1), resolve_ref(NP2, _, Block2).
%errors
stacked_resolve(NP1, _, _, _, _) :-
    NP1 = np(_, adjp(a(A1), adjp(a(A2))), n(table)),
    write("The table is many things, but it isn't "), write(A1), write(" and "), write(A2), write("."), nl, !, false.
stacked_resolve(_, NP2, _, _, _) :-
    NP2 = np(_, adjp(a(A1), adjp(a(A2))), n(table)),
    write("The table is many things, but it isn't "), write(A1), write(" and "), write(A2), write("."), nl, !, false.

% 1 and 2
stacked_resolve(NP1, NP2, State, Block1, Block2) :-
    NP2 = np(_, adjp(a(_), adjp(a(_))), n(block)),
    resolve_ref(NP2, _, Block2),
    NP1 = np(_, adjp(a(Adj)), n(block)),
    findall(Block1, idTop(Adj, State, Block1, Block2), [Block1]).
%errors
stacked_resolve(NP1, _, _, _, _) :-
    NP1 = np(_, adjp(a(Adj)), n(table)),
     write("The table takes offense when you call it "), write(Adj), write("."), nl, !, false.
stacked_resolve(_, NP2, _, _, _) :-
    NP2 = np(_, adjp(a(A1), adjp(a(A2))), n(table)),
    write("The table is many things, but it isn't "), write(A1), write(" and "), write(A2), write("."), nl, !, false.

% 2 and 1
stacked_resolve(NP1, NP2, State, Block1, Block2) :-
    NP1 = np(_, adjp(a(_), adjp(a(_))), n(block)),
    resolve_ref(NP1, _, Block1),
    NP2 = np(_, adjp(a(Adj)), n(block)),
    findall(Block2, idBottom(Adj, State, Block1, Block2), [Block2]).
%errors
stacked_resolve(_, NP2, _, _, _) :-
    NP2 = np(_, adjp(a(Adj)), n(table)),
     write("The table takes offense when you call it "), write(Adj), write("."), nl, !, false.
stacked_resolve(NP1, _, _, _, _) :-
    NP1 = np(_, adjp(a(A1), adjp(a(A2))), n(table)),
    write("The table is many things, but it isn't "), write(A1), write(" and "), write(A2), write("."), nl, !, false.

% 1 and 1
stacked_resolve(NP1, NP2, State, Block1, Block2) :-
    NP1 = np(_, adjp(a(Adj1)), n(block)),
    NP2 = np(_, adjp(a(Adj2)), n(block)),
    (   size(Block1, Adj1); color(Block1, Adj1)),
    findall(Block2, idBottom(Adj2, State, Block1, Block2), [Block2]).
%errors 
stacked_resolve(NP1, _, _, _, _) :-
    NP1 = np(_, adjp(a(Adj)), n(table)),
     write("The table takes offense when you call it "), write(Adj), write("."), nl, !, false.
stacked_resolve(_, NP2, _, _, _) :-
    NP2 = np(_, adjp(a(Adj)), n(table)),
     write("The table takes offense when you call it "), write(Adj), write("."), nl, !, false.
stacked_resolve(NP1, NP2, State, Block1, Block2) :-
    NP1 = np(_, adjp(a(Adj1)), n(block)),
    NP2 = np(_, adjp(a(Adj2)), n(block)),
    (   size(Block1, Adj1); color(Block1, Adj1)),
    \+findall(Block2, idBottom(Adj2, State, Block1, Block2), [Block2]),
    write("I can't find what you're looking for. Be more precise."), nl, !, false.

% 0 and 2
stacked_resolve(NP1, NP2, State, Block1, Block2) :-
    NP1 = np(d(the), n(block)),
    NP2 = np(_, adjp(a(_), adjp(a(_))), n(block)),
    resolve_ref(NP2, _, Block2), 
    findall(Block1, member(on(Block1, Block2), State), [Block1]).
%errors
stacked_resolve(NP1, _, _, _, _) :-
    NP1 = np(d(the), n(table)),
    write("Please don't try to move the table."), nl, !, false.
stacked_resolve(_, NP2, _, _, _) :-
    NP2 = np(_, adjp(a(A1), adjp(a(A2))), n(table)),
    write("The table is many things, but it isn't "), write(A1), write(" and "), write(A2), write("."), nl, !, false.

% 2 and 0 
stacked_resolve(NP1, NP2, State, Block1, Block2) :-
    NP1 = np(_, adjp(a(_), adjp(a(_))), n(block)),
    NP2 = np(d(the), n(_)),
    resolve_ref(NP1, _, Block1), 
    findall(Block2, member(on(Block1, Block2), State), [Block2]).
stacked_resolve(_, _, _, _, _) :-
    write("I can't find the blocks your referring to."), nl, !, false.

% 1 and 0 and 0 and 1 are ambiguous too often.


%% Natural Language Generation %%

nlg(Block) :- size(Block, S), color(Block, C), write("the "), write(S), write(" "), 
    write(C), write(" block"). 
nlg(table) :- write("the table"). 
nlg(on(Block, Target)) :- nlg(Block), write(" is on "), nlg(Target), nl.
nlg(hand(Block)) :- nlg(Block), write(" is in the hand "), nl.

nlg([StateItem]) :- nlg(StateItem).
nlg([StateItem|Rest]) :- nlg(StateItem), nlg(Rest).

%%%%%%%%%%%%%%%%%
%%% Main Loop %%%
%%%%%%%%%%%%%%%%%

perform_act(Parse, State, NewState) :- extract(Parse, Verb, NP), 
    resolve_ref(NP, State, Block), 
    validate(Verb, Block, State), 
    perform(Verb, Block, State, NewState).
perform_act(Parse, State, NewState) :- extract(Parse, Verb, NP1, NP2, Prep),
    (   (   Prep = from, stacked_resolve(NP1, NP2, State, Block1, Block2));
    (   Prep = on, resolve_ref(NP1, State, Block1), resolve_ref(NP2, State, Block2))), 
    validate(Verb, Block1, Block2, State), 
    (perform(Verb, Block1, State, NewState) ; perform(Verb, Block1, Block2, State, NewState)).
%actually get help for stuff
perform_act(s(vp(v(help))), State, State) :- write("Valid sentences are:"), nl, 
    tab(4), write("pickup [a block] (from [another block]|the table)(.)"), nl,
    tab(4), write("put [a block] on [another block]|the table(.)"), nl,
    tab(4), write("stack [a block] on [another block](.)"), nl,
    tab(4), write("unstack [a block] (from [another block])(.)"), nl,
    write("Where expressions in parenthesis are optional, expressions in brackets"),
    write(" need to be specified, and '|' means 'or'."), nl.

%process the exit command
process_input(State) :-
    read_word_list(Input), 
    (   sentence(s(vp(v(exit))),Input, []), !;
    process_input(State, Input)).
process_input(State) :- talktome(State).%write("I'm not sure how to do that."), nl, talktome(State).

process_input(State, Input) :-
    sentence(Parse, Input, []), 
    perform_act(Parse, State, NewState), 
    write("Currently..."), nl, 
    nlg(NewState), 
    talktome(NewState).


talktome :- initial_state(State), write("Currently..."), nl, nlg(State), talktome(State).
talktome(State) :- write("What would you like to do next?"), nl, process_input(State).
        
%%%%%%%%%%%%%%%%
%%% Planning %%%
%%%%%%%%%%%%%%%%

%An auto-runner for create_plan if you don't want to define your own states.
create_plan(Steps) :- 
    State1 = [on(b1, b2), on(b2, table), on(b3, b1), on(b4, table), on(b5, table), on(b6, table), 
            	on(b7, table), on(b8, table)], 
    State2 = [on(b1, table), on(b2, b1), on(b3, b2), on(b4, b5), on(b5, table), on(b6, table), 
            	on(b7, table), on(b8, table)], 
    create_plan(State1, State2, Steps).

create_plan(CurrentState, GoalState, Steps) :- feasable(CurrentState), feasable(GoalState),
    hand_feasable(CurrentState), hand_feasable(GoalState),
    unstack(CurrentState, H),
	unstack_2_electric_boogaloo(GoalState, T),
    reverse(T, FinalT),
    append(H,FinalT, Steps), 
    !. %cut is added bc I don't like the nonsense repeats I keep getting back on Next.


% Step 1: Feasability check
feasable([]).
feasable(State) :- State = [H|Tail], H = on(_, Block2), 
    (   (   block(Block2), findall(Block1, member(on(Block1, Block2), State), [Block1]));
    Block2 = table), 
    feasable(Tail).
feasable(State) :- State = [H|Tail], H = hand(Block), block(Block),
    findall(Block1, member(on(Block1, Block), State), []), 
    feasable(Tail).

hand_feasable(State) :- (  empty_hand(State); findall(B, member(hand(B), State), [B])).

% Step 2: unstack everything
unstack(State, []) :- initial_state(State), !.
unstack(State, Steps) :- block(Block2), find_in(on(Block1, Block2), State, _),
    clear(Block1, State),
    perform(unstack, Block1, State, NextState), 
    unstack(NextState, Steps1),
    Steps = [unstack(Block1, Block2)|Steps1].

% Step 3: restack via unstacking here
unstack_2_electric_boogaloo(State, []) :- initial_state(State), !.
unstack_2_electric_boogaloo(State, Steps) :- block(Block2), find_in(on(Block1, Block2), State, _),
    clear(Block1, State),
    perform(unstack, Block1, State, NextState), 
    unstack_2_electric_boogaloo(NextState, Steps1),
    Steps = [stack(Block1, Block2)|Steps1].


% Utilities

replace(_, _, [], []).
replace(O, R, [O|T], [R|T2]) :- replace(O, R, T, T2).
replace(O, R, [H|T], [H|T2]) :- dif(H,O), replace(O, R, T, T2).

find_in(Pattern, [H|_], Result) :- Pattern = H, Result = H.
find_in(Pattern, [_|R], Result) :- find_in(Pattern, R, Result).
find_in(_, [], _) :- fail.

read_word_list(Ws) :-
    read_line_to_codes(user_input, Cs),
    atom_codes(A, Cs),
    tokenize_atom(A, Ws).