program latino;
(* coniugazione verbi latini turbo pascal v.5 *)
(* scritto con turbo v.3 e poi leggermente modificato *)
uses crt,printer; (* printer per stampare su carta LST *)
const des1:array[1..84] of string[10]=('o','as','at','amus','atis','ant',
'abam','abas','abat','abamus','abatis','abant','abo','abis','abit',
'abimus','abitis','abunt',
'i','isti','it','imus','istis','erunt',
'eram','eras','erat','eramus','eratis','erant',
'ero','eris','erit','erimus','eritis','erint',
'em','es','et','emus','etis','ent',
'm','s','t','mus','tis','nt',
'erim','eris','erit','erimus','eritis','erint',
'issem','isses','isset','issemus','issetis','issent',
'a','ate','ato','ato','atote','anto',
'are','isse','urum esse','uram esse','urum esse',
'uros esse','uras esse','ura esse','ans','antis',
'urus','ura','urum','andi','ando','andum','ando','um');
const des2:array[1..84] of string[10]=('eo','es','et','emus','etis','ent',
'ebam','ebas','ebat','ebamus','ebatis','ebant','ebo','ebis','ebit',
'ebimus','ebitis','ebunt',
'i','isti','it','imus','istis','erunt',
'eram','eras','erat','eramus','eratis','erant',
'ero','eris','erit','erimus','eritis','erint',
'eam','eas','eat','eamus','eatis','eant',
'm','s','t','mus','tis','nt',
'erim','eris','erit','erimus','eritis','erint',
'issem','isses','isset','issemus','issetis','issent',
'e','ete','eto','eto','etote','ento',
'ere','isse','urum esse','uram esse','urum esse',
'uros esse','uras esse','ura esse','ens','entis',
'urus','ura','urum','endi','endo','endum','endo','um');
const des3:array[1..84] of string[10]=('o','is','it','imus','itis','unt',
'ebam','ebas','ebat','ebamus','ebatis','ebant','am','es','et',
'emus','etis','ent',
'i','isti','it','imus','istis','erunt',
'eram','eras','erat','eramus','eratis','erant',
'ero','eris','erit','erimus','eritis','erint',
'am','as','at','amus','atis','ant',
'm','s','t','mus','tis','nt',
'erim','eris','erit','erimus','eritis','erint',
'issem','isses','isset','issemus','issetis','issent',
'e','ite','ito','ito','itote','unto',
'ere','isse','urum esse','uram esse','urum esse',
'uros esse','uras esse','ura esse','ens','entis',
'urus','ura','urum','endi','endo','endum','endo','um');
const des4:array[1..84] of string[10]=('io','is','it','imus','itis','iunt',
'iebam','iebas','iebat','iebamus','iebatis','iebant',
'iam','ies','iet',
'iemus','ietis','ient',
'i','isti','it','imus','istis','erunt',
'eram','eras','erat','eramus','eratis','erant',
'ero','eris','erit','erimus','eritis','erint',
'iam','ias','iat','iamus','iatis','iant',
'm','s','t','mus','tis','nt',
'erim','eris','erit','erimus','eritis','erint',
'issem','isses','isset','issemus','issetis','issent',
'i','ite','ito','ito','itote','iunto',
'ire','isse','urum esse','uram esse','urum esse',
'uros esse','uras esse','ura esse','iens','ientis',
'urus','ura','urum','iendi','iendo','iendum','iendo','um');
type stringa35=string[35];
var rad1,rad2,rad3,rad:string[12];
finale:string[3];
coniugazione,modo:string[35];
infinito:string[20];
t,yx,numero,c,d1,d2,dx,pro,rs,re:integer;
procedure testo(x,y:integer;stringa:stringa35); (* stampa testi vari *)
begin
gotoxy(x,y);
writeln(stringa);
end;
procedure presenta; (* presentazione scopo programma *)
begin
writeln('il programma permette di coniugare i verbi regolari latini');
writeln('della 1,2,3,4 coniugazione attiva');
writeln('----------------------------------------------------------');
writeln('viene richiesto il paradigma del verbo da coniugare');
writeln('scrivere tutto in minuscolo:');
writeln('presente,infinito,perfetto,supino');
writeln('es.laudo,laudare,laudavi,laudatum');
writeln('----------------------------------------------------------');
writeln('si offrono varie opzioni:');
writeln('1....coniugazione automatica dei tempi richiesti');
writeln('2....coniugazione interattiva e correzione errori');
writeln('3....coniugazione automatica e stampa su carta');
writeln('4....coniugazione sequenziale tempi da 1 a 19 ');
writeln('.....in questo caso,premere return invece di numero tempo');
writeln;
writeln('.....si deve scrivere la forma richiesta:se errata viene ');
writeln('.....stampata la forma corretta:conteggio errori ');
writeln;
writeln('.....possibile richiedere tempi e modi in vario ordine');
writeln('.....possibile cambiare verbo o modalita-auto-interattiva');
writeln;
writeln('premi return,prego');
readln;
clrscr;
end;
procedure fine; (* fine operazione *)
begin
clrscr;
case pro of
1:writeln('fine prova:arrivederci');
2:begin writeln('totale risposte esatte.....',re);
writeln('totale risposte errate.....',rs);
writeln('totale risposte............',re+rs);
end;
end;
writeln('premi return,prego');
readln;
halt;
clrscr;
end;
procedure pausa;
begin
gotoxy(2,22);
writeln('premi return,prego');
readln;
clrscr;
end;
procedure paradigma; (* richiesta paradigma verbo*)
var lunghezza:integer;
perfetto,prima,supino:string[20];
termine:string[3];
begin
writeln('SCRIVI PARADIGMA VERBO LATINO REGOLARE,come richiesto');
writeln;
writeln('scrivi prima forma indicativo presente:es.laudo');
readln(prima);
lunghezza:=length(prima);
termine:=copy(prima,lunghezza-1,2);
if (termine='eo') then dx:=2
else dx:=3;
repeat
writeln('scrivi infinito verbo latino regolare:es.laudare');
writeln('se forma errata o non regolare,viene ripetuta la richiesta');
readln(infinito);
lunghezza:=length(infinito);
rad1:=copy(infinito,1,lunghezza-3);
finale:=copy(infinito,lunghezza-2,3);
until (finale = 'are') or (finale = 'ere') or (finale = 'ire');
writeln('scrivi perfetto indicativo:es.laudavi');
readln(perfetto);
lunghezza:=length(perfetto);
rad2:=copy(perfetto,1,lunghezza-1);
writeln('scrivi forma del supino:es.laudatum');
readln(supino);
lunghezza:=length(supino);
rad3:=copy(supino,1,lunghezza-2);
end;
procedure analisi; (* riconoscimento coniugazione 1 2 3 4 *)
begin
if (finale='are') then c:=1
else if (finale='ere') and (dx=2) then c:=2
else if (finale='ere') and (dx=3) then c:=3
else if (finale='ire') then c:=4;
case c of
1: coniugazione:='prima coniugazione';
2: coniugazione:='seconda coniugazione';
3: coniugazione:='terza coniugazione';
4: coniugazione:='quarta coniugazione';
end;
end;
procedure tempo; (* indicazione tempo da coniugare *)
begin
clrscr;
textcolor(4);
writeln('scrivere numero per indicare tempo da coniugare');
writeln('1...presente indicativo');
writeln('2...imperfetto indicativo');
writeln('3...futuro semplice');
writeln('4...perfetto indicativo');
writeln('5...piuccheperfetto indicativo');
writeln('6...futuro anteriore');
textcolor(2);
writeln('7...presente congiuntivo');
writeln('8...imperfetto congiuntivo');
writeln('9...perfetto congiuntivo');
writeln('10..piuccheperfetto congiuntivo');
textcolor(3);
writeln('11..imperativo presente');
writeln('12..imperativo futuro');
writeln('13..infinito presente');
writeln('14..infinito perfetto');
writeln('15..infinito futuro');
writeln('16..participio presente');
writeln('17..participio futuro');
writeln('18..gerundio ');
writeln('19..supino ');
writeln;
writeln('0...per finire');
writeln('-------------------------------');
readln(numero);
if (numero=0) then fine;
textcolor(14);
clrscr;
end;
procedure coniuga1; (* coniugazione automatica su richiesta tempo *)
var a:integer;
begin
textcolor(2);
testo(2,2,modo);
testo(45,2,coniugazione);
testo(45,3,'verbo:'+infinito);
writeln('---------------------------------------------');
textcolor(14);
for a:=d1 to d2 do
begin
case c of
1:writeln(rad,des1[a]);
2:writeln(rad,des2[a]);
3:writeln(rad,des3[a]);
4:writeln(rad,des4[a]);
end;
end;
writeln('---------------------------------------------');
end;
procedure stampa; (* coniugazione automatica e stampa *)
var a:integer;
begin
textcolor(2);
testo(2,2,modo);
testo(45,2,coniugazione);
testo(45,3,'verbo:'+infinito);
writeln('---------------------------------------------');
textcolor(14);
for a:=d1 to d2 do
begin
case c of
1:begin writeln(rad,des1[a]);writeln(lst,rad,des1[a]);end;
2:begin writeln(rad,des2[a]);writeln(lst,rad,des2[a]);end;
3:begin writeln(rad,des3[a]);writeln(lst,rad,des3[a]);end;
4:begin writeln(rad,des4[a]);writeln(lst,rad,des4[a]);end;
end;
end;
writeln('---------------------------------------------');
end;
procedure coniuga2; (* coniugazione automatica sequenziale tempi *)
var a:integer;
begin
textcolor(2);
testo(2,2,modo);
testo(45,2,coniugazione);
testo(45,3,'verbo:'+infinito);
writeln('---------------------------------------------');
textcolor(14);
for a:=d1 to d2 do
begin
case c of
1:writeln(rad,des1[a]);
2:writeln(rad,des2[a]);
3:writeln(rad,des3[a]);
4:writeln(rad,des4[a]);
end;
end;
writeln('---------------------------------------------');
end;
procedure prova1; (* coniugazione interattiva e correzione *)
var a:integer;
r:string[15];
persona:integer;
cambio:string[4];
begin
textcolor(2);
testo(2,2,modo);
testo(45,2,coniugazione);
testo(45,3,'verbo:'+infinito);
writeln('-------------------------------------------------------');
textcolor(14);
writeln('scrivi la forma esatta:tutto in minuscolo');
writeln('altrimenti premi return:viene stampa forma richiesta');
writeln('-------------------------------------------------------');
yx:=12;
persona:=1;
for a:=d1 to d2 do
begin
str(persona,cambio);
yx:=yx+1;
persona:=persona+1;
testo(2,yx,'forma esatta:'+cambio);gotoxy(20,yx);read(r);
case c of
1:if (r <> (rad+des1[a])) then testo(40,yx,rad+des1[a]);
2:if (r <> (rad+des2[a])) then testo(40,yx,rad+des2[a]);
3:if (r <> (rad+des3[a])) then testo(40,yx,rad+des3[a]);
4:if (r <> (rad+des4[a])) then testo(40,yx,rad+des4[a]);
end;
case c of
1:if (r <> (rad+des1[a])) then rs:=rs+1 else re:=re+1;
2:if (r <> (rad+des2[a])) then rs:=rs+1 else re:=re+1;
3:if (r <> (rad+des3[a])) then rs:=rs+1 else re:=re+1;
4:if (r <> (rad+des4[a])) then re:=rs+1 else re:=re+1;
end;
writeln;
readln;
end;
writeln('risposte esatte=',re,'....risposte errate=',rs,' su totale:',re+rs);
writeln('------------------------------------------------------------------');
end;
procedure decide; (* stabilisce desinenze e radici da usare *)
begin
case numero of
1:begin d1:=1;d2:=6;rad:=rad1;modo:='presente indicativo';end;
2:begin d1:=7;d2:=12;rad:=rad1;modo:='imperfetto indicativo';end;
3:begin d1:=13;d2:=18;rad:=rad1;modo:='futuro semplice';end;
4:begin d1:=19;d2:=24;rad:=rad2;modo:='perfetto indicativo';end;
5:begin d1:=25;d2:=30;rad:=rad2;modo:='piuccheperfetto indicativo';end;
6:begin d1:=31;d2:=36;rad:=rad2;modo:='futuro anteriore';end;
7:begin d1:=37;d2:=42;rad:=rad1;modo:='presente congiuntivo';end;
8:begin d1:=43;d2:=48;rad:=infinito;modo:='imperfetto congiuntivo';end;
9:begin d1:=49;d2:=54;rad:=rad2;modo:='perfetto congiuntivo';end;
10:begin d1:=55;d2:=60;rad:=rad2;modo:='piuccheperfetto congiuntivo';end;
11:begin d1:=61;d2:=62;rad:=rad1;modo:='imperativo presente';end;
12:begin d1:=63;d2:=66;rad:=rad1;modo:='imperativo futuro';end;
13:begin d1:=67;d2:=67;rad:=rad1;modo:='infinito presente';end;
14:begin d1:=68;d2:=68;rad:=rad2;modo:='infinito perfetto';end;
15:begin d1:=69;d2:=74;rad:=rad3;modo:='infinito futuro';end;
16:begin d1:=75;d2:=76;rad:=rad1;modo:='participio presente';end;
17:begin d1:=77;d2:=79;rad:=rad3;modo:='participio futuro';end;
18:begin d1:=80;d2:=83;rad:=rad1;modo:='gerundio';end;
19:begin d1:=84;d2:=84;rad:=rad3;modo:='supino';end;
end;
end;
procedure programma; (* programma e scelta opzioni *)
procedure scelta;
var ch:char;
begin
textmode(2);
numero:=0;
writeln('per altra prova,premi S,per finire premi N');
readln(ch);
ch:=upcase(ch);
if ch='S' then programma
else fine;
end;
begin
clrscr;
numero:=1;
writeln(' opzioni possibili:');
writeln('1...coniugazione automatica,senza interazione');
writeln('2...coniugazione con interazione e correzione errori');
writeln('3...coniugazione automatica e stampa su carta');
writeln('4...coniugazione sequenziale tempi da 1 a 19 ');
readln(pro);
paradigma; (* chiede presente infinito perfetto supino*)
analisi; (* ricerca coniugazione 1 2 3 4 *)
testo(2,20,coniugazione);
while numero <> 0 do
begin
tempo; (* chiede tempo da coniugare *)
decide; (* decide se automatica o interazione *)
case pro of
1:coniuga1; (* coniugazione automatica singoli tempi *)
2:prova1; (* coniugazione interattiva *)
3:stampa;
4:begin
for t:=1 to 19 do
begin
numero:=t;
decide;
coniuga2; (* coniugazione totale sequenziale *)
pausa;
end;
numero:=0;
end;
end;
pausa;
end;
numero:=0;
scelta; (* opzione per finire o altra prova *)
clrscr;
end;
begin (* programma principale *)
clrscr;
presenta; (* presentazione scopo programma *)
rs:=0;
re:=0;
programma;
end.