home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 September / Chip_1999-09_cd.bin / ctenari / Trejbal / TRELL.PAK / SOURCE / ERSD.EXE / KOKTA.PAS < prev    next >
Pascal/Delphi Source File  |  1998-06-15  |  8KB  |  428 lines
  1. program editor(input, output);
  2.  
  3. uses Dos,Crt,slova;
  4.  
  5. const
  6.   pondeli : array [0..6] of String[9] =
  7.     ('Nedele','Pondeli','Utery',
  8.      'Streda','Ctvrtek','Patek',
  9.      'Sobota');
  10. var
  11.     sfs : PathStr;
  12.     iiu,rok,mesic,den,tyden,hh,m,s,hund : Word;
  13.     stara,rad,retez,kus,kuss,stara2,stara3,odpoved,radek,jmeno,slovo:string;
  14.     znak:char;
  15.     i,z,k,A,del,poz,pis:integer;
  16.     nouze,beh,chyby,zaznam,klic : text;
  17.  
  18.  
  19.  
  20. procedure doplnek;
  21.  
  22.  
  23. begin
  24.  
  25. dd[1]:='Správná odpovêâ k Va¿í poslední otázce pouæité v prûbêhu rozhovoru :';
  26. dd[2]:='';
  27. dd[3]:=jmeno;
  28. dd[4]:='';
  29. dd[5]:='bude';
  30.  
  31. kuss:=in_put(0,5,5,1,60);    { okenko vstup, vystup string }
  32. kuss:=bezmez(kuss);
  33.  
  34. if not((kuss='') or (jmeno='')) then
  35. begin
  36.  
  37. jmeno:=bezmez(jmeno);
  38. jmeno:=kam_asc(jmeno);
  39. jmeno:=upp(jmeno);
  40.  
  41.  
  42. if ord(jmeno[0])<8 then
  43. begin
  44.   append(klic);
  45.   writeln(klic,jmeno);
  46.   writeln(klic,kuss);
  47.   close(klic);
  48. end
  49. else
  50. begin
  51.   reset(klic);
  52.   rewrite(beh);
  53.   writeln(beh,jmeno);
  54.   writeln(beh,kuss);
  55.   while not(eof(klic)) do
  56.   begin
  57.     readln(klic,kuss);
  58.     writeln(beh,kuss);
  59.   end;
  60.   close(klic);
  61.   close(beh);
  62.  
  63.   reset(beh);
  64.   rewrite(klic);
  65.   while not(eof(beh)) do
  66.   begin
  67.     readln(beh,kuss);
  68.     writeln(klic,kuss);
  69.   end;
  70.   close(klic);
  71.   close(beh);
  72.  
  73. end;
  74. end;
  75.  
  76. kuss:='';
  77. plot:='';
  78. for i:=1 to 69 do plot:=plot+' ';
  79. kodt:=162;
  80. jmeno:='';
  81. textcolor(11);
  82.  
  83. end;  { konec doplnek }
  84.  
  85.  
  86.  
  87.  
  88. procedure uprav;
  89. begin
  90.   if znak='ê' then znak:='E';
  91.   if znak='¿' then znak:='S';
  92.   if znak='ç' then znak:='C';
  93.   if znak='⌐' then znak:='R';
  94.   if znak='æ' then znak:='Z';
  95.   if znak='ÿ' then znak:='Y';
  96.   if znak='á' then znak:='A';
  97.   if znak='í' then znak:='I';
  98.   if znak='é' then znak:='E';
  99.   if znak='ú' then znak:='U';
  100.   if znak='û' then znak:='U';
  101.   if znak='â' then znak:='D';
  102.   if znak='ƒ' then znak:='T';
  103.   if znak='ñ' then znak:='N';
  104.   if znak='ó' then znak:='O';
  105.   if znak='¢' then znak:='S';
  106.   if znak='Ç' then znak:='C';
  107.   if znak='₧' then znak:='R';
  108.   if znak='Æ' then znak:='Z';
  109.   if znak='Å' then znak:='A';
  110.   if znak='ï' then znak:='I';
  111.   if znak='ù' then znak:='U';
  112.  
  113. end;
  114.  
  115. procedure porovnej;
  116. begin
  117.  radek:='';
  118.  rad:='';
  119.  for i:=1 to ord(kus[0]) do
  120.  begin
  121.    znak:=upcase(slovo[i]);
  122.    if a=1 then uprav;
  123.    radek:=radek+znak;
  124.  end;
  125.  
  126.  for i:=1 to ord(kus[0]) do
  127.  begin
  128.    znak:=upcase(kus[i]);
  129.    if a=1 then uprav;
  130.    rad:=rad+znak;
  131.  end;
  132.  kus:=rad;
  133.  if radek=kus then k:=1;
  134.  
  135.  if ord(kus[0])>7 then
  136.  begin
  137.    k:= najdi(kus,jmeno,'1');
  138.  end;
  139.  
  140. end;
  141.  
  142.  
  143.  
  144. procedure prazdno;
  145. begin
  146.  odpoved:=stara;
  147.  while((odpoved=stara)or(odpoved=stara2)or(odpoved=stara3)) do
  148.  begin
  149.  
  150.  reset(nouze);
  151.  randomize;
  152.  for i:=1 to random(50) do
  153.  begin
  154.    readln(nouze);
  155.    if eof(nouze) then reset(nouze);
  156.  end;
  157.  retez:=odpoved;
  158.  while retez=odpoved do
  159.  begin
  160.    readln(nouze,retez);
  161.    if eof(nouze) then reset(nouze);
  162.  end;
  163.  odpoved:=retez;
  164.  close(nouze);
  165.  
  166.  end;
  167.  
  168. end;
  169.  
  170. procedure analyza;
  171. begin
  172.   k:=0;
  173.   reset(chyby);
  174.   while not((eof(chyby)) or(k=1)) do
  175.   begin
  176.     readln(chyby,kus);
  177.     porovnej;
  178.   end;
  179.   close(chyby);
  180.  
  181.   if k=0 then
  182.   begin
  183.     reset(klic);
  184.     while not((eof(klic)) or(k=1)) do
  185.     begin
  186.       readln(klic,kus);
  187.       readln(klic,retez);
  188.       porovnej;
  189.       if k=1 then
  190.       begin
  191.  
  192.         if (retez=stara) or (retez=stara2) or (retez=stara3) then k:=0
  193.         else
  194.         begin
  195.           odpoved:=retez;
  196.           del:=0;
  197.         end;
  198.  
  199.       end;
  200.     end;
  201.     close(klic);
  202.   end;
  203. end;
  204.  
  205.  
  206. procedure rozeber;
  207. begin
  208.   del:=ord(jmeno[0]);
  209.   if (jmeno[del]='.') or (jmeno[del]='!') or (jmeno[del]='?') then
  210.   begin
  211.     rad:='';
  212.     for i:=1 to del-1 do
  213.     begin
  214.      rad:=rad+jmeno[i];
  215.     end;
  216.     jmeno:=rad+' ';
  217.   end
  218.   else
  219.   begin
  220.     jmeno:=jmeno+' ';
  221.     del:=del+1;
  222.   end;
  223.  
  224.   poz:=del;
  225.   odpoved:='';
  226.   while not((del=0)or(poz=1)) do
  227.   begin
  228.     znak:='*';
  229.     while not((znak=' ') or (poz=1)) do
  230.     begin
  231.       poz:=poz-1;
  232.       znak:=jmeno[poz];
  233.     end;
  234.     slovo:='';
  235.     znak:='*';
  236.     pis:=poz;
  237.     while not(znak=' ') do
  238.     begin
  239.       pis:=pis+1;
  240.       slovo:=slovo+jmeno[pis];
  241.       znak:=jmeno[pis];
  242.     end;
  243.  
  244.     analyza;
  245.  
  246.   end;
  247.  
  248. end;
  249.  
  250.                          { ********************************** }
  251. begin
  252.  
  253. assign(zaznam,'zaznam.dll');
  254. assign(klic,'klic.dll');
  255. assign(chyby,'chyby.dll');
  256. assign(nouze,'nouze.dll');
  257. assign(beh,'beh.dll');
  258.  
  259.  
  260. textbackground(0);
  261. textcolor(7);
  262.  
  263. cls;
  264. GetDate(rok,mesic,den,tyden);
  265. GetTime(hh,m,s,hund);
  266. randomize;
  267.  
  268.  
  269. sfs:=fsearch('klic.dll',GetEnv('path'));
  270. if sfs='' then
  271. begin
  272.   rewrite(klic);
  273.   writeln(klic,'konec ');
  274.   writeln(klic,'Tak konçíme.');
  275.   close(klic);
  276. end;
  277.  
  278. sfs:=fsearch('chyby.dll',GetEnv('path'));
  279. if sfs='' then
  280. begin
  281.   rewrite(chyby);
  282.   writeln(chyby,'cast');
  283.   close(chyby);
  284. end;
  285.  
  286. sfs:=fsearch('nouze.dll',GetEnv('path'));
  287. if sfs='' then
  288. begin
  289.   rewrite(nouze);
  290.   writeln(nouze,'Tak to vidíte ! ');
  291.   writeln(nouze,'Hmmmm....');
  292.   writeln(nouze,'Jo.');
  293.   writeln(nouze,'Co se dá dêlat.');
  294.   writeln(nouze,'Tak jo.');
  295.   writeln(nouze,'Tak, tak.');
  296.   writeln(nouze,'To jsem nepochopil.');
  297.   writeln(nouze,'Co po⌐ád chcete ?');
  298.   writeln(nouze,'Ale ne.');
  299.   writeln(nouze,'Ach jo !');
  300.   writeln(nouze,'Neuvê⌐itelné !!');
  301.   writeln(nouze,'Taky ?');
  302.   writeln(nouze,'Nesmysl.');
  303.   writeln(nouze,'To nemá cenu.');
  304.   writeln(nouze,'Nechcete uæ skonçit ?');
  305.   writeln(nouze,'Uæ to trvá moc dlouho.');
  306.   writeln(nouze,'Kdyæ myslíte..');
  307.   writeln(nouze,'Ale co s tím ?');
  308.   writeln(nouze,'Já nevím.');
  309.   writeln(nouze,'A jak dál ?');
  310.   writeln(nouze,'Chvilku strpení.');
  311.   writeln(nouze,'Zkuste si odpovêdêt sám.');
  312.   writeln(nouze,'Nikdo nemûæe vêdêt v¿echno.');
  313.   writeln(nouze,'A proç ?');
  314.   writeln(nouze,'Krucinál, tak je to.');
  315.   writeln(nouze,'Uæ nemûæu.');
  316.   writeln(nouze,'Uæ ne.');
  317.   writeln(nouze,'Co já vím.');
  318.   writeln(nouze,'Nezmêníme téma ?');
  319.   writeln(nouze,'Nenudíte se ?');
  320.   writeln(nouze,'Na va¿em místê bych se ¿el projít.');
  321.   writeln(nouze,'Nesvítíte nêkde zbyteçnê ?');
  322.   writeln(nouze,'To máte pravdu.');
  323.   writeln(nouze,'Kdybych to byl vêdêl..');
  324.   writeln(nouze,'Kaædému jednou dojde trpêlivost.');
  325.   writeln(nouze,'To je moc komplikované.');
  326.   writeln(nouze,'Zastavte, chci vystoupit.');
  327.   writeln(nouze,'To nebylo v¿echno ?');
  328.   writeln(nouze,'Snad p⌐í¿tí tÿden.');
  329.   writeln(nouze,'Vítejte na Marsu.');
  330.   writeln(nouze,'Kolik je hodin ?');
  331.   writeln(nouze,'Opravdu ?');
  332.   writeln(nouze,'Je pozdê.');
  333.   writeln(nouze,'T⌐eba zítra.');
  334.   writeln(nouze,'Tak jindy.');
  335.  
  336.   close(nouze);
  337. end;
  338.  
  339.  
  340. jmeno:='';
  341. stara:='';
  342. stara2:='';
  343. stara3:='';
  344.  
  345.  
  346. ramuj(2,1,79,25,7,1,0,'Popovídejte si s umêlou inteligencí.   Konec = ESC.',
  347. 'Stiskem klávesy F2 vloæíte správnou odpovêâ k Va¿í otázce.');
  348.  
  349. textbackground(0);
  350. textcolor(7);
  351. gotoxy(5,3);
  352. writeln('Aktivace umêlé inteligence TRELLSOFT ver. 4.27 probêhla úspê¿nê .. OK');
  353. gotoxy(5,4);
  354. writeln('Interaktivní systém IQ..75 p⌐ipraven.');
  355. gotoxy(5,5);
  356. writeln('.....................................');
  357. textcolor(14);
  358. gotoxy(5,8);
  359. writeln('Dobrÿ den. ');
  360. gotoxy(5,9);
  361. writeln('Chcete se na nêco zeptat ?');
  362.  
  363.  
  364. odpoved:='';
  365.  
  366. while not(odpoved='Tak konçíme.') do
  367. begin
  368.  
  369.   textcolor(11);
  370.   plot:='';
  371.   for i:=1 to 69 do plot:=plot+' ';
  372.   while bezmez(plot)='' do
  373.   begin
  374.    sejmi(5,19);
  375.    if kodt=27 then plot:='konec';
  376.    if kodt=360 then
  377.    begin
  378.     if not(jmeno='') then doplnek;
  379.    end;
  380.   end;
  381.   jmeno:=plot;
  382.   if kodt=27 then jmeno:='konec';
  383.   jmeno:=bezmez(jmeno);
  384.  
  385.   jmeno:=' '+jmeno;
  386.   a:=0;
  387.  
  388.   {
  389.   write('l');
  390.   write(jmeno);
  391.   write('l');
  392.   readln;
  393.   }
  394.  
  395.   rozeber;
  396.   if not(del=0) then
  397.   begin
  398.    a:=1;
  399.    rozeber;
  400.   end;
  401.   if (not(del=0) or (odpoved='')) then
  402.   begin
  403.  
  404.    prazdno;
  405.   end;
  406.  
  407.  
  408.   horre(5,2,75,19,0,7,'                                                                    ');
  409.   horre(5,2,75,19,0,14,odpoved);
  410.  
  411.   stara3:=stara2;
  412.   stara2:=stara;
  413.   stara:=odpoved;
  414.  
  415.   horre(5,2,75,19,0,7,'                                                                    ');
  416.   horre(5,2,75,19,0,7,'                                                                    ');
  417.  
  418. end;
  419.  
  420. erase(chyby);
  421.  
  422. textcolor(7);
  423. textbackground(0);
  424. cls;
  425.  
  426. end.
  427.  
  428.