/****** MAIN PROGRAM ******-
/***** Inizializzazione *****/

'<LOAD>'(A) :-
    install_menu('Wall', ['Nuova analisi', 'Fine', 'Directory di lavoro', 'About']),
    grafix,
    workdir(Workdir),
    set_path(Workdir),
    inizio.

'Wall'('Nuova analisi'):-
    inizio.

'Wall'('Fine'):-
    forget(baco),
    kill_menu('Wall'),
    windows(grap, Lista),
    kill_win(Lista),
    saluti.

'Wall'('About'):-
    mdialog(100, 100, 200, 300,
                [button(160, 120, 20, 60, 'OK'),
                text(10, 10, 80, 280,
                wseq(['WALL, un Sistema Esperto per la datazione delle murature napoletane~M By Ugo Chirico']))],
                Button).

'Wall'('Directory di lavoro'):-
    workdir(WorkDir),
    message(['La directory di lavoro è:~M ',WorkDir]).

workdir('Macintosh HD:ugo:tesi:').

inizio:-
    windows(grap, Lista),
    kill_win(Lista),
    windows(disp, List),
    kill_win(List),
    close_windows,
    retractall(protocol(A)),
    !,
    materiale,
    prosegui.

/**** Prima domanda ****/

materiale:-
    retractall(spiegazioni(A)),
    pic_materiale([Pic1|P1],4),
    pic_materiale([Pic2|P2],5),
    pic_materiale([Pic3|P3],6),
    !,
    mdialog(70,100,330,400,
                [button(300,50,20,60,'HELP'),
                 button(300,280,20,60,'Cancel'),
                 button(300,170,20,60,'OK'),
                 pbutton(40,3,160,130,Pic1),
                 pbutton(40,135,160,130,Pic2),
                 pbutton(40,268,160,130,Pic3),
                 pcheck(220,8,42,126,frame([box(0,0,35,120),textbox(1,1,33,118,1,'Tufo giallo napoletano') ] ),off,T),
                 pcheck(220,136,42,126,frame([box(0,0,35,120),textbox(10,1,15,118,1,'Laterizio')]),off,L),
                 pcheck(220,264,42,126,frame([box(0,0,35,120),textbox(10,1,15,118,1,'Pietra da taglio')]),off,P),
                 text(10,12,20,350,'Scelta del materiale di cui  composta la muratura')],
                 Button,
                 handle(materiale,T, L, P)),
    !.

prosegui:-
    protocol(P),
    ramo(P),
    motore(Plaus),
    scrivi_spiegazioni(Plaus),
    fail.

prosegui.

ramo(tufo):-
    retractall(spiegazioni(A)),
    spiegazione(tufo, Expl),
    assert(spiegazioni([Expl])),
    geometria,
    !.

/**** Domanda geometria ****/

geometria:-
    pic_geometria([Pic1|P1],6),
    pic_geometria([Pic2|P2],7),
    pic_geometria([Pic3|P3],8),
    mdialog(70,100,330,400,
                [button(300,80,20,60,'HELP'),
                 button(300,250,20,60,'Cancel'),
                 button(210,30,30,80,'Regolare'),
                 button(210,160,30,80,'Sbozzato'),
                 button(210,295,30,80,'Irregolare'),
                 pbutton(40,3,160,130,Pic1),
                 pbutton(40,135,160,130,Pic2),
                 pbutton(40,268,160,130,Pic3),
                 text(10,12,20,350,'Definizione della geometria dei conci')],
                 Button,
                 handle(geo_tufo)),
    !.

irregolare:-
    recall(baco,irregolare).

irregolare:-
    filename('tufo irregolare.TXT', FileName),
    open(FileName),
    consult(FileName),
    close(FileName),
    remember(baco,irregolare).

regolare:-
    recall(baco,regolare).

regolare:-
    filename('tufo regolare.TXT', FileName),
    open(FileName),
    consult(FileName),
    close(FileName),
    remember(baco,regolare).

sbozzato:-
    recall(baco,sbozzato).

sbozzato:-
    filename('tufo sbozzato.TXT', FileName),
    open(FileName),
    consult(FileName),
    close(FileName),
    remember(baco,sbozzato).

ramo(pietra):-
    retractall(spiegazioni(A)),
    tipo(Tipo),
    spiegazione(Tipo, Expl),
    assert(spiegazioni([Expl])),
    !.

tipo(Tipo):-
    pic_pietra([Pic1|P1],5),
    pic_pietra([Pic2|P2],6),
    mdialog(70,100,330,400,
                [button(300,80,20,60,'HELP'),
                 button(300,250,20,60,'Cancel'),
                 button(210,75,30,80,'Piperno'),
                 button(210,225,30,80,'Pietrarsa'),
                 pbutton(40,37,160,150,Pic1),
                 pbutton(40,193,160,150,Pic2),
                 text(10,12,20,350,'Definizione del tipo di pietra da taglio')],
                 Button,
                 handle(pietra, Tipo)),
    !.

piperno:-
    recall(baco,piperno).

piperno:-
    filename('piperno.TXT', FileName),
    open(FileName),
    consult(FileName),
    close(FileName),
    remember(baco,piperno).

pietrarsa:-
    recall(baco,pietrarsa).

pietrarsa:-
    filename('pietrarsa.TXT', FileName),
    open(FileName),
    consult(FileName),
    close(FileName),
    remember(baco,pietrarsa).

ramo(laterizio):-
    retractall(spiegazioni(A)),
    spiegazione(laterizio, Expl),
    assert(spiegazioni([Expl])),
    banner(laterizio,'Attendere. Sto caricando la base di conoscenza del laterizio', 100,100),
    !.

laterizio:-
    recall(baco,laterizio).

laterizio:-
    filename('laterizio.TXT', FileName),
    open(FileName),
    consult(FileName),
    close(FileName),
    remember(baco,laterizio).

/***** HANDLES ****/
/**** handle per la finestra materiale *****/

handle(X,1,materiale, T, L, P):-
    fast_help('materiale', ''),
    !,
    fail.

handle(X,3,materiale, on, L, P):-
    assert(protocol(tufo)),
    fail.

handle(X,3,materiale, T, on, P):-
    assert(protocol(laterizio)),
    fail.

handle(X,3,materiale, T, L, on):-
    assert(protocol(pietra)),
    fail.

handle(X,3,materiale, off, off, off):-
    message('Devi sceglierne almeno una !!!'),
    !,
    fail.

handle(X,3,materiale, T, L, P):-
    !.

handle(X,N,materiale, T, L, P):-
    pic_materiale(Pic,N),
    write_pic(Pic),
    !,
    fail.

/***************************************/
/**** handle per la finestra geometria tufo ******/

handle(X, 1, geo_tufo):-
    fast_help('geometria_dei_conci_in_tufo', ''),
    !,
    fail.

handle(X, 3, geo_tufo):-
    retract(spiegazioni(L)),
    spiegazione(regolare, Sp),
    assert(spiegazioni([Sp| L])),
    banner(regolare,'Attendere. Sto caricando la base di conoscenza del tufo regolare', 100,100).

handle(X, 4, geo_tufo):-
    retract(spiegazioni(L)),
    spiegazione(sbozzato, Sp),
    assert(spiegazioni([Sp| L])),
    banner(sbozzato,'Attendere. Sto caricando la base di conoscenza del tufo sbozzato', 100,100).

handle(X, 5, geo_tufo):-
    retract(spiegazioni(L)),
    spiegazione(irregolare, Sp),
    assert(spiegazioni([Sp| L])),
    banner(irregolare,'Attendere. Sto caricando la base di conoscenza del tufo irregolare', 100,100).

handle(X, N, geo_tufo):-
    pic_geometria(Pic,N),
    write_pic(Pic),
    !,
    fail.

/**** handle per la finestra pietra da taglio ****/

handle(A,1, pietra, X):-
    fast_help('pietra_da_taglio', ''),
    !,
    fail.

handle(A, 3, pietra, piperno):-
    banner(piperno,'Attendere. Sto caricando la base di conoscenza del Piperno', 100,100),
    !.

handle(A, 4, pietra, pietrarsa):-
    banner(pietrarsa,'Attendere. Sto caricando la base di conoscenza della pietrarsa', 100,100),
    !.

handle(A, N, pietra, X):-
    pic_pietra(Pic,N),
    write_pic(Pic),
    !,
    fail.

/**** MOTORE INFERENZIALE ****/

motore(Plaus):-
    reset,
    ordina_ipotesi(Sorted),
    rifletti(Sorted),
    ipotesi_ipotesiibili(Plaus),
    wkill(giustificazioni),
    !.

reset:-
    ipotesi(H,N),
    forget(H),
    fail.

reset:-
    retractall(risposta(X)),
    retractall(out(X)),
    wcreate(giustificazioni, 1, 70, 430, 370, 200),
    wfont(giustificazioni, 'Chicago', 0, 12).

/***************************************/

rifletti( [ H |Rest] ):-
    get_class(H, Class), /* richiamo la classe di domanda dell'ipotesi H */
    arco_domanda(H, D, Class), /* scelgo la domanda corrispondente */
    rispondi(D),
    ordina_ipotesi(Lista),
    rifletti(Lista).

rifletti( [ H |Rest] ):-
    get_class(H, Class), /* richiamo la classe di domanda dell'ipotesi H */
    arco_domanda(H, D, Class),
    out(D),
    update_class(H, D), /*update quando la domanda è stata già suggerita da un'altra ipotesi */
    rifletti([H|Rest]).

rifletti( [H|Rest] ):-
    ipotesi(H, Min),
    get_value(H, Val),
    Val < Min,
    rifletti(Rest).

rifletti(Lista):-!.

/*******************************************/

rispondi(D):-
    out(D),
    !,
    fail.

rispondi(D):-
    giust(D, Giust),
    writeseq(giustificazioni, [Giust]),
    domanda(D),
    assert(out(D)),
    abduzione(D),
    parziale(D),
    !.

/**********************************/

abduzione(D):-
    arco_domanda_risposta(D, R),
    risposta(R),
    arco_risposta(H, R, Value),
    update_class(H, D),
    update_value(H, Value),
    explain(H, R),
    fail.

abduzione(D):-!.

/********************************/

explain(H, R):-
    default(H, [Val, Class, Expl1], [0, 1, [ ] ]),
    remember(H, [Val, Class, [R|Expl1] ]),
    !.

update_value(H, Value):- /* aggiorna il valore dell'ipotesi H */
    get_value(H,Val),
    Val1 is Val+Value,
    remember_value(H, Val1),
    !.

/* update_class, aggiorna la classe di domanda delle ipotesi legate alla domanda D. Se la classe della domanda appena risposta,  superiore o uguale alla classe di domanda dell'ipotesi H, allora quest'ultima viene aggiornata */

update_class(H, D):-
    arco_domanda(H, D, Class),
    get_class(H, Class1),
    Class >= Class1,
    Class2 is Class+1,
    remember_class(H, Class2),
    !.

update_class(H,D):-!.

/*******************************/

get_class(H, Class):-
    default(H, [Val, Class, Expl], [0 ,1, [ ] ]),
    !.

get_value(H, Value):-
    default(H, [Value, Class, Expl], [0 ,1, [ ] ]),
    !.

remember_class(H, Class):-
    default(H, [Value, Class1, Expl], [0, 1, [ ] ]),
    remember(H, [Value, Class,Expl]),
    !.

remember_value(H, Value):-
    default(H, [Val, Class, Expl], [0, 1, [ ] ]),
    remember(H, [Value, Class, Expl]),
    !.

get_explain(H, Expl):-
    default(H, [Value, Class, Expl], [0 ,1, [ ] ]),
    !.

/****************************/

ordina_ipotesi(Sorted):-
    ipotesi(H, N),
    get_value(H, Val),
    Val >= 0,
    insert( H, Val ),
    fail.

ordina_ipotesi( Sorted ):-
    sorted(Sorted),
    retract(sorted(Sorted)),
    !.

ordina_ipotesi( [ ] ):-!.

/*******************************/

insert( H, V1 ):-
    def(sorted),
    sorted(Lista),
    search(V1, Lista1, Lista, Lista2), /* mi da la lista spezzata in due */
    retract(sorted( Lista )),
    append(Lista1,[ H | Lista2 ], Sorted),
    assert(sorted(Sorted)),
    !.

insert(H, V1):-
    assert(sorted([ H ])),
    !.

search( V1, Lista1, [ ], [ ] ).

search( V1, Lista1, [ X | Lista ], [ X | Lista ] ):-
    get_value(X, Val1),
    V1> Val1.

search(V1, [ X | Lista1 ] , [ X | Lista ], Lista2 ):-
    search(V1, Lista1, Lista, Lista2 ).

/******************************/

ipotesi_ipotesiibili(Lista):-
    ipotesi(H, N),
    get_value(H,V),
    V >= N,
    insert(H,V),
    fail.

ipotesi_ipotesiibili(Lista):-
    sorted(Lista),
    retract(sorted(Lista)),
    !.

ipotesi_ipotesiibili(nil).

/***********************************/

risposta(0).

out(0).

/**** IMMAGINI *****/

pic_materiale(Pic_Tufo,4):-
    Pic_Tufo=[picture(0,0,120,100,resource(clipboard10,':foto:f/3')),
    picture(0,0,120,100,resource(clipboard0,':foto:e/1.2')),
    picture(0,0,120,100,resource(clipboard0,':foto:f/6'))].

pic_materiale(Pic_laterizio,5):-
    Pic_laterizio = [picture(0,0,120,100,resource(clipboard0,':foto:a/1')),
    picture(0,0,120,100,resource(clipboard2,':foto:a/d')),
    picture(0,0,120,100,resource(clipboard0,':foto:a/4.2'))].

pic_materiale(Pic_pietra,6):-
    Pic_pietra = [picture(0,0,120,100,resource(clipboard3,':foto:b/2')),
    picture(0,0,120,100,resource(clipboard4,':foto:b/2.1'))
    /* picture(0,0,120,100,resource(clipboard22,':foto:b/8'))*/].

pic_geometria(Pic_regolare,6):-
    Pic_regolare = [picture(0,0,120,100,resource(clipboard13,':foto:c/4')),
    picture(0,0,120,100,resource(clipboard15,':foto:g/3'))].

pic_geometria(Pic_sbozzato,7):-
    Pic_sbozzato= [picture(0,0,120,100,resource(clipboard0,':foto:f/6'))].

pic_geometria(Pic_irregolare,8):-
    Pic_irregolare =[picture(0,0,120,100,resource(clipboard0,':foto:e/1.2')),
    picture(0,0,120,100,resource(clipboard13,':foto:e/8.1')),
    picture(0,0,120,100,resource(clipboard7,':foto:d/p'))].

pic_pietra(Pic_piperno, 5):-
    Pic_piperno = [picture(0,0,120,100,resource(clipboard3,':foto:b/2'))].

pic_pietra(Pic_pietrarsa,6):-
    Pic_pietrarsa = [picture(0,0,120,100,resource(clipboard1,':foto:pietrarsa'))].

/***** UTILITY *****/
/**** Verifica la correttezza del valore inserito *****/

good(X):-
    number(X),
    X>3,
    X <120,
    !.

good(X):-
    number(X),
    X > 0,
    X < 4,
    !,
    myesno(['Sei sicuro che il valore ', X, ' corretto ?']).

good(X):-
    number(X),
    X > 120,
    !,
    myesno(['Sei sicuro che il valore ', X, ' corretto ?']).

good(X):-
    message(['Il valore', X, 'non  valido']),
    fail.

good(Max, Min):-
    Max > Min,
    !.

good(Max, Min):-
    message([Max, 'non Ž maggiore di', Min]),
    fail.

good1(X):-
    number(X),
    X >=0,
    !.

good1(X):-
    number(X),
    message(['Il valore', X, 'non  valido']),
    fail.

good1(X):-
    !.

good1(Max, Min):-
    number(Max),
    number(Min),
    Max >= Min,
    !.

good1(Max, Min):-
    number(Max),
    number(Min),
    message([Max, 'non Ž maggiore di', Min]),
    fail.

good1(Max, Min):-!.

/**** Crea il percorso corretto per il file *****/

filename(Name, FileName):-
    workdir(WorkDir),
    concat(WorkDir, Name, FileName).

/**** Visualizza il testo di HELP ****/

fast_help(Subject, Title):-
    filename('help.TXT', FileName),
    help(FileName, Subject, Title).

/**** Visualizza l’immagine ingrandita ****/

write_pic([ ]):-!.

write_pic([P | Pictures]):-
    mdialog(30,10,400,400,
                 [button(370,170,25,60,'OK'),
                 pbutton(10,22,330,360,P)],
                 Button),
    !.

write_pic([P|Pictures]):-
    write_pic(Pictures),
    !.

/*******************/

dif(A, B, X):-
    Y is A-B,
    abs(Y, Z),
    Z =< X,
    !.

/**** Chiude tutte le finestre inutili *****/

close_windows:-
    windows(prog,Lista),
    clwin(Lista),
    windows(disp,Lista1),
    clwin(Lista1).

clwin([]):-!.

clwin([A|B]):-
    whide(A),
    clwin(B).

kill_win( [ ] ).

kill_win([A|B]):-
    wkill(A),
    kill_win(B).

/**** Visualizza le spiegazioni finali ****/

scrivi_spiegazioni(Plaus):-
    scrivi(Plaus, 50, 20,1),
    !.

scrivi_spiegazioni( nil ):-
    message('I dati non sono sufficienti. Non sono in grado di prendere una decisione. ~MProva a ripetere l''analisi'),
    !.

scrivi( [ ], T, L, N ).

scrivi( [H|Lista], T, L, N ):-
    spiegazioni(List1),
    reverse(List1, List2),
    get_explain(H, List3),
    reverse(List3, List4),
    datazione(H, Datazione),
    qualità(N, Q),
    wgcreate(Datazione, T, L,300,500, 0, 400, 300,1,1),
    gviewer(Datazione, off),
    add_pic(Datazione, qualita, textbox('Chicago', 12, 0, 10, 10, 50, 420, 0, Q), (-290, 0)),
    add_pic(Datazione, datazione, textbox('Chicago', 12, 0, 10, 10, 50, 420, 0, Datazione), (-260,0)),
    add_list(Datazione, List2, -230),
    add_list(Datazione, List4, -130, 'a'),
    gscroll_to(Datazione, -300, 0),
    T1 is T+20,
    L1 is L+20,
    N1 is N +1,
    scrivi(Lista, T1, L1, N1 ).

add_list(D, [R|Lista], Y, C):-
    spiega(R, Expl),
    add_pic(D, Expl, textbox('Chicago', 12, 0, 10, 10, 90, 280, 0, Expl), (Y,0)),
    pic(R, [P|Pic]),
    add_pic(D, C, P, (Y,300)),
    Y1 is Y + 123,
    concat(C, 'a', C1),
    add_list(D, Lista, Y1, C1).

add_list(D, [R|Lista], Y, C):-
    add_list(D, Lista, Y, C).

add_list(D, [ ], Y, C).

add_list(D, [R|Lista], Y):-
    add_pic(D, R, textbox('Chicago', 12, 0, 10, 10, 35, 300, 0,R), (Y,0)),
    Y1 is Y + 30,
    add_list(D, Lista, Y1).

add_list(D, [ ], Y).

/************************************/

qualità(1,'La muratura appartiene probabilmente al periodo:').

qualità(2,'La muratura potrebbe anche appartenere al periodo:').

qualità(3,'La muratura potrebbe anche appartenere al periodo:').

qualità(4,'La muratura potrebbe anche appartenere al periodo:').

/**** Spiegazione dei segni attivati nelle prime domande ****/

spiegazione(tufo, 'Muratura in tufo giallo napoletano').

spiegazione(laterizio,'Muratura in laterizio').

spiegazione(regolare,'Il concio in tufo giallo ha geometria regolare').

spiegazione(sbozzato,'Il concio in tufo giallo  sbozzato').

spiegazione(irregolare,'Il concio in tufo giallo ha geometria irregolare').

spiegazione(piperno, 'Muratura in Piperno').