Ðàçðàáîòêà èíôîðìàöèîííî ñïðàâî÷íîé ñèñòåìû Òåõ ïàñïîðò àâòîìîáèëÿ
code=9000
include
"tdoms.pro"
include
"tpreds.pro"
include
"menu.pro"
domains
i,z,n,dvig,god,n1,shasi=integer
j,mark,znac,fam,ima,otc,ucet=string
intList=integer*
strList=symbol*
charList=char*
database
avto(i,j,i,i,i,j,j,j,j,j)
predicates
/*
Íà÷àëî pàáîòû */
nachalo
/*
Ñîçäàíèå îñíîâíîãî ìåíþ */
mainmenu
/*
Çàãpóçêà áàçû äàííûõ */
zagruz
/*
Âûáîp çàïèñè */
choice1(i)
correct(i,i)
/*
Âûïîëíÿþòñÿ ïpè âûáîpå ïóíêòîâ ãëàâíîãî ìåíþ */
rabota(i)
/*
Ñîõpàíåíèå áàçû íà äèñêå */
savebase(i)
/*
Çàãpóçêà áàçû ñ äèñêà */
loadbase(i)
/*
Âûâîä íà ýêpàí íàéäåííîé èíôîpìàöèè */
print(i,i)
output(i)
output1(i,j,j,j)
/*
Íàõîæäåíèå max ýëåìåíòà ñïèñêà */
maxelem(intList, i)
/*
Âûâîä ñòðîêè íà ýêpàí ïîñèìâîëüíî (÷òîáû ýòó ñòpîêó ìîæíî áûëî påäàêòèpîâàòü)
*/
str_write(string)
/*
Äîñòóï ê ýëåìåíòó ñïèñêà ïî èíäåêñó */
strIndex(STRINGLIST, i, j)
intIndex(intList, i, i)
/*
Ïåpåâîä ñïèñêà öåëûõ ÷èñåë â ñïèñîê ñòpîê */
intList2strList(intList,
STRINGLIST)
goal
nachalo.
clauses
/*
Ñîçäàíèÿ ãëàâíîãî îêíà è çàãðóçêà áàçû äàííûõ */
nachalo:-
makewindow(1,7,23," ÒÅÕÍÈ×ÅÑÊÈÉ ÏÀÑÏÎÐÒ ÀÂÒÎÌÎÁÈËß
",0,0,25,80),
clearwindow,zagruz,
mainmenu.
/*
Ñîçäàíèå îñíîâíîãî ìåíþ */
mainmenu:-
menu(5,28,7,23,[" Êîppåêöèÿ
äàííûõ ", " Óäàëåíèå äàííûõ ",
"
Ïpîñìîòp áàçû ",
" Çàãpóçêà áàçû ",
" Ñîõpàíåíèå áàçû ", " Ââîä íîâûõ
äàííûõ ",
" Ïîèñê äàííûõ ", " Âûõîä èç
ïpîãpàììû ",
" Î ïpîãpàììå
"], " Ãëàâíîå ìåíþ ", 1, Vibor),
clearwindow,
rabota(Vibor),
clearwindow,
Vibor = 9,
retractall(_),
removewindow.
/*
Ïîèñêà è çàãðóçêà ôàéëà, ñîäåðæàùåãî áàçó äàííûõ */
zagruz:-
existfile("avto.dat"),
consult("avto.dat"),
cursor(2,20),
write("Áàçà çàãðóæåíà. Íàæìèòå ëþáóþ êëàâèøó..."),
readchar(_), clearwindow.
zagruz:-
cursor(2,20),
write("Íåò áàçû íà äèñêå. Íàæìèòå ëþáóþ êëàâèøó..."),
readchar(_), clearwindow.
/*
Êîppåêöèÿ çàïèñåé áàçû äàííûõ */
rabota(1):-
makewindow(21,48,90," Êîppåêöèÿ äàííûõ ",0,0,25,80),
nl,
choice1(N),
avto(N,MARK,GOD,DVIG,SHASI,ZNAC,FAM,IMA,OTC,UCET),
write(" ÍÎÌÅÐ ÇÀÏÈÑÈ : "),write(N),nl,nl,
write(" ÌÀÐÊÀ :
"),str_write(MARK),readln(MARK1),nl,
write(" ÃÎÄ ÂÛÏÓÑÊÀ :
"),str_int(GODstr,GOD),str_write(GODstr),
readint(GOD1),nl,
write(" N ÄÂÈÃÀÒÅËß :
"),str_int(DVIGstr,DVIG),str_write(DVIGstr),
readint(DVIG1),nl,
write(" N ØÀÑÑÈ :
"),str_int(SHASIstr,SHASI),str_write(SHASIstr),
readint(SHASI1),nl,
write(" ÍÎÌÅÐÍÎÉ ÇÍÀÊ:
"),str_write(ZNAC),readln(ZNAC1),nl,
write(" ÔÀÌÈËÈß :
"),str_write(FAM),readln(FAM1),nl,
write(" ÈÌß :
"),str_write(IMA),readln(IMA1),nl,
write("
ÎÒ×ÅÑÒÂÎ :
"),str_write(OTC),readln(OTC1),nl,
write(" ÐÀÉÎÍ Ó×ÅÒÀ :
"),str_write(UCET),readln(UCET1),nl,nl,
retract(avto(N,MARK,GOD,DVIG,SHASI,ZNAC,FAM,IMA,OTC,UCET)),
assert(avto(N,MARK1,GOD1,DVIG1,SHASI1,ZNAC1,FAM1,IMA1,OTC1,UCET1)),
removewindow,
mainmenu.
/*
Óäàëåíèå çàïèñåé èç áàçû äàííûõ */
rabota(2):-
makewindow(2,7,94," Óäàëåíèå çàïèñåé ",0,0,25,80),
nl,
choice1(N),
X=N,
avto(X,MARK,GOD,DVIG,SHASI,ZNAC,FAM,IMA,OTC,UCET),
retract(avto(X,MARK,GOD,DVIG,SHASI,ZNAC,FAM,IMA,OTC,UCET)),
removewindow,
mainmenu.
/*
Ïðîñìîòð ñîäåðæèìîãî áàçû äàííûõ */
rabota(3):-
makewindow(3,7,79," Ïðîñìîòp áàçû
äàííûõ ",0,0,25,80),
nl, output(_),
write(" Íàæìèòå íà ëþáóþ êëàâèøó...
"),
readchar(_),
removewindow,
mainmenu.
/*
Çàãðóçêà â ïàìÿòü áàçû äàííûõ */
rabota(4):-
nl,
makewindow(4,15,2," Çàãðóçêà
",0,0,25,80),
menu(5,15,7,23,[" Áàçà áóäåò çàãðóæåíà èç óêàçàííîãî
ôàéëà ",
" Áàçà áóäåò
çàãðóæåíà èç ôàéëà avto.dat ",
" Âûõîä â îñíîâíîå ìåíþ "], " Âûáåpèòå ", 2, C),
loadbase(C),
removewindow,
mainmenu.
/*
Ñîõðàíåíèå áàçû äàííûõ íà äèñêå */
rabota(5):-
nl,
makewindow(5,15,2," Çàïèñü ",0,0,25,80),
menu(5,15,7,23,[" Áàçà
áóäåò çàïèñàíà â óêàçàííûé ôàéë ",
" Áàçà áóäåò çàïèñàíà
â ôàéë avto.dat ",
" Âûõîä â îñíîâíîå
ìåíþ "], " Âûáåpèòå ",
2, I),
savebase(I),
removewindow,
mainmenu.
/* Ââîä
íîâûõ äàííûõ */
rabota(6):-
makewindow(7,26,48," Ââîä íîâûõ
äàííûõ ",0,0,25,80), nl,
findall(Numb,
avto(Numb,_,_,_,_,_,_,_,_,_), List),
maxelem(List, Elem),
write(" ÏÎÐßÄÊÎÂÛÉ ÍÎÌÅÐ
: "),K=Elem+1,write(K),nl,nl,
write(" Ââåäèòå ÌÀÐÊÓ
: "),readln(F),nl,
write(" Ââåäèòå ÃÎÄ ÂÛÏÓÑÊÀ
: "),readint(Y),nl,
write(" Ââåäèòå N ÄÂÈÃÀÒÅËß
: "),readint(J),nl,
write(" Ââåäèòå N ØÀÑÑÈ
: "),readint(G),nl,
write(" Ââåäèòå ÍÎÌÅÐÍÎÉ ÇÍÀÊ : "),readln(W),nl,
write(" Ââåäèòå ÔÀÌÈËÈÞ
: "),readln(B),nl,
write(" Ââåäèòå ÈÌß
: "),readln(C),nl,
write(" Ââåäèòå ÎÒ×ÅÑÒÂÎ
: "),readln(D),nl,
write(" Ââåäèòå ÐÀÉÎÍ Ó×ÅÒÀ
: "),readln(R),nl,
N1=K,MARK1=F,GOD1=Y,DVIG1=J,SHASI1=G,ZNAC1=W,
FAM1=B,IMA1=C,OTC1=D,UCET1=R,
assertz(avto(N1,MARK1,GOD1,DVIG1,SHASI1,ZNAC1,FAM1,IMA1,OTC1,UCET1)),
removewindow, mainmenu.
/*
Ïîèñê äàííûõ */
rabota(7):-
makewindow(7,113,94," Ïîèñê äàííûõ
",0,0,25,80),
menu(3,28,7,23,[" íîìåðó çàïèñè ", " ìàpêå
àâòîìîáèëÿ ",
" íîìåpó äâèãàòåëÿ ", " íîìåpó øàññè ",
" íîìåpíîìó çíàêó ",
" ôàìèëèè ", " èìåíè ", " îò÷åñòâó
",
" pàéîíó ó÷åòà ", " ãîäó âûïóñêà "],
" Ïîèñê ïî ", 1, Vibor),
correct(Vibor,N),
print(Vibor,N),
write(" Íàæìèòå íà ëþáóþ êëàâèøó...
"),
readchar(_),
removewindow,
mainmenu.
/*
Âûâîä ñïpàâêè î ïpîãpàììå */
rabota(9):-
makewindow(10,23,7," Î ïpîãpàììå ",2,15,20,50),nl,nl,
write(" Èíôîpìàöèîííî-ñïpàâî÷íàÿ
ñèñòåìà"),nl,nl,
write(" î òåõíè÷åñêîì ïàñïîðòå àâòîìîáèëÿ
"),nl,nl,
write(" ßçûê: TURBO-PROLOG v.2.0. "),nl,nl,
write(" Àâòîp: ñòóäåíò "),nl,nl,
write("
"),nl,nl,nl,
write(" Íàæìèòå íà ëþáóþ êëàâèøó"),
readchar(_),
removewindow,mainmenu.
rabota(_):-exit.
/*
Çàïèñü íà äèñê */
savebase(1):-
write("Ââåäèòå èìÿ ôàéëà
:"),
readln(N),
save(N),
write("Âñå â ïîðÿäêå"),
beep,
!.
savebase(1):-
write("Îøèáêà îáìåíà, íàæìèòå
ëþáóþ êëàâèøó"),
readchar(_).
savebase(2):-
save("avto.dat").
savebase(3).
/*
×òåíèå ñ äèñêà */
loadbase(1):-
retractall(_),
write("Ââåäèòå èìÿ ôàéëà
:"),
readln(N),
existfile(N),
consult(N),
write("Âñå â ïîðÿäêå"),
beep,
!.
loadbase(1):-
nl,
write("Äàííîãî ôàéëà íåò íà
äèñêå"),nl,
write("Íàæìèòå ëþáóþ
êëàâèøó"),
readchar(_).
loadbase(2):-
retractall(_),
existfile("avto.dat"),
consult("avto.dat"),
write("Âñå â ïîðÿäêå"),
beep,
!.
loadbase(2):-
write("Ôàéëà avto.dat íåò íà
äèñêå"),nl,
write("íàæìèòå ëþáóþ
êëàâèøó"),
readchar(_).
loadbase(3).
/*
Âûáîð çàïèñè */
choice1(N):-
menu(3,28,7,23,[" íîìåðó çàïèñè ", " ìàpêå
àâòîìîáèëÿ ",
" íîìåpó äâèãàòåëÿ ",
" íîìåpó øàññè ", " íîìåpíîìó çíàêó ",
" ôàìèëèè "], "
Âûáîp ïî ", 1, X),
correct(X,N).
correct(1,N):-
findall(Numb,
avto(Numb,_,_,_,_,_,_,_,_,_), List),
intList2strList(List, NewList),
menu(3,28,7,23,NewList," Çíà÷åíèÿ
",1,Number),
intIndex(List, Number, N).
correct(2,N):-
findall(Marka,
avto(_,Marka,_,_,_,_,_,_,_,_), List),
menu(3,28,7,23,List," Çíà÷åíèÿ
",1,Number),
strIndex(List, Number, Item),
avto(N,Item,_,_,_,_,_,_,_,_).
correct(3,N):-
findall(NDvig,
avto(_,_,_,NDvig,_,_,_,_,_,_), List),
intList2strList(List, NewList),
menu(3,28,7,23,NewList," Çíà÷åíèÿ
",1,Number),
intIndex(List, Number, Item),
avto(N,_,_,Item,_,_,_,_,_,_).
correct(4,N):-
findall(NShas,
avto(_,_,_,_,NShas,_,_,_,_,_), List),
intList2strList(List, NewList),
menu(3,28,7,23,NewList," Çíà÷åíèÿ
",1,Number),
intIndex(List, Number, Item),
avto(N,_,_,_,Item,_,_,_,_,_).
correct(5,N):-
findall(Znak,
avto(_,_,_,_,_,Znak,_,_,_,_), List),
menu(3,28,7,23,List," Çíà÷åíèÿ ",1,Number),
strIndex(List, Number, Item),
avto(N,_,_,_,_,Item,_,_,_,_).
correct(6,N):-
findall(Fam, avto(_,_,_,_,_,_,Fam,_,_,_),
List),
menu(3,28,7,23,List," Çíà÷åíèÿ
",1,Number),
strIndex(List, Number, Item),
avto(N,_,_,_,_,_,Item,_,_,_).
correct(7,N):-
findall(Ima, avto(_,_,_,_,_,_,_,Ima,_,_),
List),
menu(3,28,7,23,List," Çíà÷åíèÿ
",1,Number),
strIndex(List, Number, Item),
avto(N,_,_,_,_,_,_,Item,_,_).
correct(8,N):-
findall(Otch, avto(_,_,_,_,_,_,_,_,Otch,_),
List),
menu(3,28,7,23,List," Çíà÷åíèÿ
",1,Number),
strIndex(List, Number, Item),
avto(N,_,_,_,_,_,_,_,Item,_).
correct(9,N):-
menu(3,28,7,23,["Þæíûé",
"Ñåâåpíûé", "Öåíòpàëüíûé", "Âîñòî÷íûé",
"Çàïàäíûé"]," Çíà÷åíèÿ ",1,Number),
strIndex(["Þæíûé",
"Ñåâåpíûé", "Öåíòpàëüíûé", "Âîñòî÷íûé",
"Çàïàäíûé"], Number, Item),
avto(N,_,_,_,_,_,_,_,_,Item).
correct(10,N):-
findall(God,
avto(_,_,God,_,_,_,_,_,_,_), List),
intList2strList(List, NewList),
menu(3,28,7,23,NewList," Çíà÷åíèÿ
",1,Number),
intIndex(List, Number, Item),
avto(N,_,Item,_,_,_,_,_,_,_).
/*
Ïåpåâîä ñïèñêà öåëûõ ÷èñåë â ñïèñîê ñòpîê */
intList2strList([], []).
intList2strList([H1|T1], [H2|T2]):-
intList2strList(T1, T2),
str_int(H2, H1).
/*
Äîñòóï ê ýëåìåíòó ñïèñêà ïî èíäåêñó */
strIndex([H|_], 1, H).
strIndex([_|R], N, Y):-strIndex(R, K, Y),
N=K+1.
intIndex([H|_], 1, H).
intIndex([_|R], N, Y):-intIndex(R, K, Y),
N=K+1.
/*
Âûâîä ñòðîêè íà ýêpàí ïîñèìâîëüíî (÷òîáû ýòó ñòpîêó ìîæíî áûëî påäàêòèpîâàòü)
*/
str_write("").
str_write(S):-
frontchar(S, H, S1),
str_write(S1),
unreadchar(H).
/*
Íàõîæäåíèå max ýëåìåíòà ñïèñêà */
maxelem([E], E).
maxelem([F|L], X):- maxelem(L, X1),
X1>=F, X=X1.
maxelem([F|L], X):- maxelem(L, X1),
X1<F, X=F.
/*
Âûâîä íà ýêpàí íàéäåííîé èíôîpìàöèè */
output(N):-
nl,
write("
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"),nl,
write("
ÒÅÕÍÈ×ÅÑÊÈÉ ÏÀÑÏÎÐÒ
ÀÂÒÎÌÎÁÈËß
"),nl,
write("
ÌÍÍËÍÍÍÍÍÍÍÍÍËÍÍÍÍÍËÍÍÍÍÍËÍÍÍÍÍËÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍ͹"),nl,
write("
Nøº ÌÀÐÊÀ º ÃÎÄ º Nø º Nø
ÍÎÌÅÐÍ º Ô. È. Î. º ÐÀÉÎÍ º"),nl,
write("
ºÀÂÒÎÌÎÁÈ˺ÂÛÏÓѺÄÂÈà ºØÀÑÑȺ
ÇÍÀÊ º º Ó×ÅÒÀ
"),nl,
write("
ÌÍÍÎÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÎÍÍÍÍÍÎÍÍÍÍÍÎÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍ͹"),nl,
avto(N,MARK,GOD,DVIG,SHASI,ZNAC,FAM,IMA,OTC,UCET),
cursor(Z,_),cursor(Z,1),write("º"),
cursor(Z,2),write(N),cursor(Z,4),write("º"),
cursor(Z,5),write(MARK),cursor(Z,14),write("º"),
cursor(Z,15),write(GOD),cursor(Z,20),write("º"),
cursor(Z,21),write(DVIG),cursor(Z,26),write("º"),
cursor(Z,27),write(SHASI),cursor(Z,32),write("º"),
cursor(Z,33),write(ZNAC),cursor(Z,41),write("º"),
cursor(Z,42),write(FAM),cursor(Z,49),write("º"),
cursor(Z,50),write(IMA),cursor(Z,58),write("º"),
cursor(Z,59),write(OTC),cursor(Z,66),write("º"),
cursor(Z,67),write(UCET),
cursor(Z,76),write("º"),
nl,
fail.
output(_):-
write("
ÈÍÍÊÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÊÍÍÍÍÍÊÍÍÍÍÍÊÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍͼ"),
nl.
/*
Âûâîä íà ýêpàí íàéäåííîé èíôîpìàöèè */
output1(GOD,IMA,OTC,UCET):-
nl,
write("
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"),nl,
write("
ÒÅÕÍÈ×ÅÑÊÈÉ ÏÀÑÏÎÐÒ
ÀÂÒÎÌÎÁÈËß
"),nl,
write("
ÌÍÍËÍÍÍÍÍÍÍÍÍËÍÍÍÍÍËÍÍÍÍÍËÍÍÍÍÍËÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍ͹"),nl,
write("
Nøº ÌÀÐÊÀ º ÃÎÄ º Nø º Nø
ÍÎÌÅÐÍ º Ô. È. Î. º ÐÀÉÎÍ º"),nl,
write("
ºÀÂÒÎÌÎÁÈ˺ÂÛÏÓѺÄÂÈà ºØÀÑÑȺ
ÇÍÀÊ º º Ó×ÅÒÀ
"),nl,
write("
ÌÍÍÎÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÎÍÍÍÍÍÎÍÍÍÍÍÎÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍ͹"),nl,
avto(N,MARK,GOD,DVIG,SHASI,ZNAC,FAM,IMA,OTC,UCET),
cursor(Z,_),cursor(Z,1),write("º"),
cursor(Z,2),write(N),cursor(Z,4),write("º"),
cursor(Z,5),write(MARK),cursor(Z,14),write("º"),
cursor(Z,15),write(GOD),cursor(Z,20),write("º"),
cursor(Z,21),write(DVIG),cursor(Z,26),write("º"),
cursor(Z,27),write(SHASI),cursor(Z,32),write("º"),
cursor(Z,33),write(ZNAC),cursor(Z,41),write("º"),
cursor(Z,42),write(FAM),cursor(Z,49),write("º"),
cursor(Z,50),write(IMA),cursor(Z,58),write("º"),
cursor(Z,59),write(OTC),cursor(Z,66),write("º"),
cursor(Z,67),write(UCET),
cursor(Z,76),write("º"),
nl,
fail.
output1(_,_,_,_):-
write("
ÈÍÍÊÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÊÍÍÍÍÍÊÍÍÍÍÍÊÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍͼ"),
nl.
/*
Âûâîä íà ýêpàí íàéäåííîé èíôîpìàöèè */
print(Vibor,N):-Vibor<7, output(N).
print(7,N):-
avto(N,_,_,_,_,_,_,IMA,_,_),
output1(_,IMA,_,_).
print(8,N):-
avto(N,_,_,_,_,_,_,_,OTC,_),
output1(_,_,OTC,_).
print(9,N):-
avto(N,_,_,_,_,_,_,_,_,UCET),
output1(_,_,_,UCET).
print(10,N):-
avto(N,_,GOD,_,_,_,_,_,_,_),
output1(GOD,_,_,_).
/****************************************************************
Turbo Prolog Toolbox
(C) Copyright 1987 Borland International.
menu
Implements a popup menu with at most 23
possible choices.
For more than 23 possible choices use
longmenu.
The up and down arrow keys can be used to
move the bar.
RETURN or F10 will select an indicated item.
Pressing Esc aborts menu selection and
returns zero.
The arguments to menu are:
menu(ROW,COL,WINDOWATTR,FRAMEATTR,STRINGLIST,HEADER,STARTCHOICE,SELECTION)
ROW and COL determines the position of the
window
WATTR and FATTR determine the attributes
for the window
and its frame - if FATTR is zero
there
will be no frame around the window.
STRINGLIST is the list of menu items
HEADER is the text to appear at the top of
the menu window
STARTCHOICE determines where the bar
should be placed.
Ex:
menu(5,5,7,7,[this,is,a,test],"select word",0,CHOICE)
****************************************************************/
PREDICATES
menu(ROW,COL,ATTR,ATTR,STRINGLIST,STRING,INTEGER,INTEGER)
menuinit(ROW,COL,ATTR,ATTR,STRINGLIST,STRING,ROW,COL)
menu1(SYMBOL,ROW,ATTR,STRINGLIST,ROW,COl,INTEGER)
menu2(KEY,STRINGLIST,ROW,ROW,ROW,SYMBOL)
CLAUSES
menu(ROW,COL,WATTR,FATTR,LIST,HEADER,STARTCHOICE,CHOICE) :-
menuinit(ROW,COL,WATTR,FATTR,LIST,HEADER,NOOFROW,LEN),
ST1=STARTCHOICE-1,max(0,ST1,ST2),MAX=NOOFROW-1,min(ST2,MAX,STARTROW),
menu1(cont,STARTROW,WATTR,LIST,NOOFROW,LEN,CHOICE),
removewindow.
menuinit(ROW,COL,WATTR,FATTR,LIST,HEADER,NOOFROW,NOOFCOL):-
maxlen(LIST,0,MAXNOOFCOL),
str_len(HEADER,HEADLEN),
HEADL1=HEADLEN+4,
max(HEADL1,MAXNOOFCOL,NOOFCOL),
listlen(LIST,LEN), LEN>0,
NOOFROW=LEN,
adjframe(FATTR,NOOFROW,NOOFCOL,HH1,HH2),
adjustwindow(ROW,COL,HH1,HH2,AROW,ACOL),
makewindow(81,WATTR,FATTR,HEADER,AROW,ACOL,HH1,HH2),
writelist(0,NOOFCOL,LIST).
menu1(cont,ROW,ATTR,LIST,MAXROW,NOOFCOL,CHOICE):-!,
reverseattr(ATTR,REV),
field_attr(ROW,0,NOOFCOL,REV),
cursor(ROW,0),
readkey(KEY),
field_attr(ROW,0,NOOFCOL,ATTR),
menu2(KEY,LIST,MAXROW,ROW,NEXTROW,CONT),
menu1(CONT,NEXTROW,ATTR,LIST,MAXROW,NOOFCOL,CHOICE).
menu1(esc,ROW,_,_,_,_,CHOICE):-!,CHOICE=ROW+1.
menu1(_,ROW,ATTR,_,_,NOOFCOL,CHOICE):-
CHOICE=ROW+1,
reverseattr(ATTR,REV),
field_attr(ROW,0,NOOFCOL,REV).
menu2(esc,_,_,_,-1,esc):-!.
menu2(fkey(10),_,_,ROW,ROW,stop):-!.
menu2(char(C),LIST,_,_,CH,selection):-tryletter(C,LIST,CH),!.
/*menu2(fkey(1),_,_,ROW,ROW,cont):-!,help. If a help system is used */
menu2(cr,_,_,ROW,CH,selection):-!,CH=ROW.
menu2(up,_,_,ROW,NEXTROW,cont):-ROW>0,!,NEXTROW=ROW-1.
menu2(down,_,MAXROW,ROW,NEXTROW,cont):-NEXTROW=ROW+1,NEXTROW<MAXROW,!.
menu2(end,_,MAXROW,_,NEXT,cont):-!,NEXT=MAXROW-1.
menu2(pgdn,_,MAXROW,_,NEXT,cont):-!,NEXT=MAXROW-1.
menu2(home,_,_,_,0,cont):-!.
menu2(pgup,_,_,_,0,cont):-!.
menu2(_,_,_,ROW,ROW,cont).
/****************************************************************/
/* menu_leave */
/* As
menu but the window is not removed on return. */
/****************************************************************/
PREDICATES
menu_leave(ROW,COL,ATTR,ATTR,STRINGLIST,STRING,INTEGER,INTEGER)
CLAUSES
menu_leave(ROW,COL,WATTR,FATTR,LIST,HEADER,STARTCHOICE,CHOICE) :-
menuinit(ROW,COL,WATTR,FATTR,LIST,HEADER,NOOFROW,NOOFCOL),
ST1=STARTCHOICE-1,max(0,ST1,ST2),MAX=NOOFROW-1,min(ST2,MAX,STARTROW),
menu1(cont,STARTROW,WATTR,LIST,NOOFROW,NOOFCOL,CHOICE).
/****************************************************************
menu_mult
Implements a popup-menu which allows a
multiple number of
selections.
Each selection is made by pressing RETURN.
All selections are
then activated by pressing F10.
The arguments to menu_mult are:
menu(ROW,COL,WINDOWATTR,FRAMEATTR,STRINGLIST,HEADER,STARTLIST,NEWLIST)
ROW and COL determine the position of the
window
WATTR and FATTR determine the attributes
for the window
and its frame - if FATTR is zero
there
will be no frame around the window.
STRINGLIST is the list of menu items
HEADER is the text to appear at the top of
the menu window
STARTLIST determines the items to be
highlighted when
the menu is first displayed
NEWLIST
contains the list of selections
Ex:
menu_mult(5,5,7,7,[this,is,a,test],"select words",[1],NEWLIST)
****************************************************************/
PREDICATES
menu_mult(ROW,COL,ATTR,ATTR,STRINGLIST,STRING,INTEGERLIST,INTEGERLIST)
multmenu1(SYMBOL,ROW,ATTR,STRINGLIST,ROW,COL,INTEGERLIST,INTEGERLIST)
highlight_selected(INTEGERLIST,COL,ATTR)
handle_selection(INTEGER,INTEGERLIST,INTEGERLIST,COL,ATTR)
try_del(INTEGER,INTEGERLIST,INTEGERLIST,COL,ATTR)
CLAUSES
menu_mult(ROW,COL,WATTR,FATTR,LIST,HEADER,STARTCHLIST,CHLIST) :-
menuinit(ROW,COL,WATTR,FATTR,LIST,HEADER,NOOFROW,NOOFCOL),
multmenu1(cont,0,WATTR,LIST,NOOFROW,NOOFCOL,STARTCHLIST,CHLIST),
removewindow.
multmenu1(stop,_,_,_,_,_,CHL,CHL):-!.
multmenu1(esc,_,_,_,_,_,_,[]):-!.
multmenu1(selection,ROW,ATTR,LIST,MAXROW,NOOFCOL,OLDCHLIN,CHLOUT):-
CHOICE=1+ROW,
handle_selection(CHOICE,OLDCHLIN,NEWCHLIN,NOOFCOL,ATTR),
multmenu1(cont,ROW,ATTR,LIST,MAXROW,NOOFCOL,NEWCHLIN,CHLOUT).
multmenu1(cont,ROW,ATTR,LIST,MAXROW,NOOFCOL,CHLIN,CHLOUT):-
reverseattr(ATTR,REV),
highlight_selected(CHLIN,NOOFCOL,REV),
cursor(ROW,0),
readkey(KEY),
menu2(KEY,LIST,MAXROW,ROW,NEXTROW,CONT),
multmenu1(CONT,NEXTROW,ATTR,LIST,MAXROW,NOOFCOL,CHLIN,CHLOUT).
highlight_selected([],_,_).
highlight_selected([H|T],L,ATTR):-
ROW=H-1,
field_attr(ROW,0,L,ATTR),
highlight_selected(T,L,ATTR).
try_del(SELECTION,[SELECTION|REST],REST,LEN,ATTR):-
ROW=SELECTION-1,
field_attr(ROW,0,LEN,ATTR),!.
try_del(SELECTION,[H|REST],[H|REST1],LEN,ATTR):-
try_del(SELECTION,REST,REST1,LEN,ATTR).
handle_selection(SELECTION,OLDCHIN,NEWCHIN,LEN,ATTR):-
try_del(SELECTION,OLDCHIN,NEWCHIN,LEN,ATTR),!.
handle_selection(SELECTION,OLDCHIN,[SELECTION|OLDCHIN],_,_).
/****************************************************************/
/* In
order to use the tools, the following domain declarations */
/*
should be included in the start of your program */
/****************************************************************/
GLOBAL
DOMAINS
ROW, COL, LEN, ATTR = INTEGER
STRINGLIST = STRING*
INTEGERLIST = INTEGER*
KEY
= cr; esc; break; tab; btab; del; bdel; ctrlbdel; ins;
end ; home ; fkey(INTEGER) ; up ; down ;
left ; right ;
ctrlleft; ctrlright; ctrlend; ctrlhome;
pgup; pgdn;
ctrlpgup; ctrlpgdn; char(CHAR) ; otherspec
/****************************************************************/
/* This
module includes some routines which are used in nearly */
/* all
menu and screen tools. */
/****************************************************************/
/****************************************************************/
/* repeat */
/****************************************************************/
PREDICATES
nondeterm repeat
CLAUSES
repeat.
repeat:-repeat.
/****************************************************************/
/* miscellaneous */
/****************************************************************/
PREDICATES
maxlen(STRINGLIST,COL,COL) /* The length of the longest string */
listlen(STRINGLIST,ROW) /* The length of a list
*/
writelist(ROW,COL,STRINGLIST) /* used in the menu predicates
*/
reverseattr(ATTR,ATTR) /* Returns the reversed
attribute */
min(ROW,ROW,ROW) min(COL,COL,COL)
min(LEN,LEN,LEN) min(INTEGER,INTEGER,INTEGER)
max(ROW,ROW,ROW) max(COL,COL,COL)
max(LEN,LEN,LEN) max(INTEGER,INTEGER,INTEGER)
CLAUSES
maxlen([H|T],MAX,MAX1) :-
str_len(H,LENGTH),
LENGTH>MAX,!,
maxlen(T,LENGTH,MAX1).
maxlen([_|T],MAX,MAX1) :-
maxlen(T,MAX,MAX1).
maxlen([],LENGTH,LENGTH).
listlen([],0).
listlen([_|T],N):-
listlen(T,X),
N=X+1.
writelist(_,_,[]).
writelist(LI,ANTKOL,[H|T]):-
field_str(LI,0,ANTKOL,H),
LI1=LI+1,
writelist(LI1,ANTKOL,T).
min(X,Y,X):-X<=Y,!.
min(_,X,X).
max(X,Y,X):-X>=Y,!.
max(_,X,X).
reverseattr(A1,A2):-
bitand(A1,$07,H11),
bitleft(H11,4,H12),
bitand(A1,$70,H21),
bitright(H21,4,H22),
bitand(A1,$08,H31),
A2=H12+H22+H31.
/****************************************************************/
/* Find letter selection in a list of strings */
/* Look initially for first uppercase
letter. */
/* Then try with first letter of each
string. */
/****************************************************************/
PREDICATES
upc(CHAR,CHAR) lowc(CHAR,CHAR)
try_upper(CHAR,STRING)
tryfirstupper(CHAR,STRINGLIST,ROW,ROW)
tryfirstletter(CHAR,STRINGLIST,ROW,ROW)
tryletter(CHAR,STRINGLIST,ROW)
CLAUSES
upc(CHAR,CH):-
CHAR>='a',CHAR<='z',!,
char_int(CHAR,CI), CI1=CI-32,
char_int(CH,CI1).
upc(CH,CH).
lowc(CHAR,CH):-
CHAR>='A',CHAR<='Z',!,
char_int(CHAR,CI), CI1=CI+32,
char_int(CH,CI1).
lowc(CH,CH).
try_upper(CHAR,STRING):-
frontchar(STRING,CH,_),
CH>='A',CH<='Z',!,
CH=CHAR.
try_upper(CHAR,STRING):-
frontchar(STRING,_,REST),
try_upper(CHAR,REST).
tryfirstupper(CHAR,[W|_],N,N) :-
try_upper(CHAR,W),!.
tryfirstupper(CHAR,[_|T],N1,N2) :-
N3 = N1+1,
tryfirstupper(CHAR,T,N3,N2).
tryfirstletter(CHAR,[W|_],N,N) :-
frontchar(W,CHAR,_),!.
tryfirstletter(CHAR,[_|T],N1,N2) :-
N3 = N1+1,
tryfirstletter(CHAR,T,N3,N2).
tryletter(CHAR,LIST,SELECTION):-
upc(CHAR,CH),tryfirstupper(CH,LIST,0,SELECTION),!.
tryletter(CHAR,LIST,SELECTION):-
lowc(CHAR,CH),tryfirstletter(CH,LIST,0,SELECTION).
/*****************************************************************/
/*
adjustwindow takes a windowstart and a windowsize and adjusts */
/* the
windowstart so the window can be placed on the screen. */
/*
adjframe looks at the frameattribute: if it is different from */
/*
zero, two is added to the size of the window
*/
/****************************************************************/
PREDICATES
adjustwindow(ROW,COL,ROW,COL,ROW,COL)
adjframe(ATTR,ROW,COL,ROW,COL)
CLAUSES
adjustwindow(LI,KOL,DLI,DKOL,ALI,AKOL):-
LI<25-DLI,KOL<80-DKOL,!,ALI=LI,AKOL=KOL.
adjustwindow(LI,_,DLI,DKOL,ALI,AKOL):-
LI<25-DLI,!,ALI=LI,AKOL=80-DKOL.
adjustwindow(_,KOL,DLI,DKOL,ALI,AKOL):-
KOL<80-DKOL,!,ALI=25-DLI,
AKOL=KOL.
adjustwindow(_,_,DLI,DKOL,ALI,AKOL):-
ALI=25-DLI, AKOL=80-DKOL.
adjframe(0,R,C,R,C):-!.
adjframe(_,R1,C1,R2,C2):-R2=R1+2, C2=C1+2.
/****************************************************************/
/* Readkey */
/*
Returns a symbolic key from the KEY domain */
/****************************************************************/
PREDICATES
readkey(KEY)
readkey1(KEY,CHAR,INTEGER)
readkey2(KEY,INTEGER)
CLAUSES
readkey(KEY):-readchar(T),char_int(T,VAL),readkey1(KEY,T,VAL).
readkey1(KEY,_,0):-!,readchar(T),char_int(T,VAL),readkey2(KEY,VAL).
readkey1(cr,_,13):-!.
readkey1(esc,_,27):-!.
readkey1(break,_,3):-!.
readkey1(tab,_,9):-!.
readkey1(bdel,_,8):-!.
readkey1(ctrlbdel,_,127):-!.
readkey1(char(T),T,_) .
readkey2(btab,15):-!.
readkey2(del,83):-!.
readkey2(ins,82):-!.
readkey2(up,72):-!.
readkey2(down,80):-!.
readkey2(left,75):-!.
readkey2(right,77):-!.
readkey2(pgup,73):-!.
readkey2(pgdn,81):-!.
readkey2(end,79):-!.
readkey2(home,71):-!.
readkey2(ctrlleft,115):-!.
readkey2(ctrlright,116):-!.
readkey2(ctrlend,117):-!.
readkey2(ctrlpgdn,118):-!.
readkey2(ctrlhome,119):-!.
readkey2(ctrlpgup,132):-!.
readkey2(fkey(N),VAL):- VAL>58,
VAL<70, N=VAL-58, !.
readkey2(fkey(N),VAL):- VAL>=84,
VAL<104, N=11+VAL-84, !.
readkey2(otherspec,_).
avto(1,"Ìîñêâè÷",1984,2354,7257,"ë204öà","Âàñüêèí","Âàñèëèé","Ñåìåíîâè÷","Þæíûé")
avto(2,"Çàïîpîæåö",1987,8297,3789,"ì644ëã","Ïåòpîâ","Ïåòp","Ôîìè÷","Çàïàäíûé")
avto(3,"Mercedes",1988,7359,0358,"ï717çç","Ãàëêèí","Ñåpãåé","Èâàíîâè÷","Öåíòpàëüíûé")
avto(4,"Æèãóëè",1990,3453,2234,"ó444èò","Èâàíîâ","Èâàí","Ïåòpîâè÷","Ñåâåpíûé")
avto(5,"Audi",1994,4455,8290,"ó321àà","Ïòèöûí","Îëåã","Îëåãîâè÷","Çàïàäíûé")
avto(6,"BMW",1997,4875,9111,"ê777áá","Àãàïîâ","Íèêîëàé","Âàñèëüåâè÷","Âîñòî÷íûé")
|
