home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 11 / algorith / atnbox.inc next >
Encoding:
Text File  |  1989-08-29  |  16.4 KB  |  510 lines
  1. (********************************************************)
  2. (*                       ATNBOX.INC                     *)
  3. (*   Include-Datei mit den Prozeduren für eine          *)
  4. (*   natürlichsprachliche Schnittstelle von "KARTEI"    *)
  5. (*           (C) 1989 Stephan Diehl & TOOLBOX           *)
  6.  
  7. FUNCTION match : BOOLEAN;
  8. (* Sucht die nächste Karteikarte, die zu den *)
  9. (* aktuellen Suchbegriffen paßt              *)
  10.  
  11. VAR bb:BOOLEAN;
  12.  
  13. BEGIN
  14.   bb:=FALSE;
  15.   IF karte<>NIL THEN
  16.   WHILE (((suchbegriff[inh4]^.begriff
  17.            <>karte^.inhalt[ 4])
  18.           AND (suchbegriff[inh4]^.begriff
  19.                <>wildcard))
  20.       OR ((suchbegriff[inh3]^.begriff
  21.            <>karte^.inhalt[3])
  22.           AND (suchbegriff[inh3]^.begriff
  23.                <>wildcard))
  24.       OR ((suchbegriff[inh2]^.begriff
  25.            <>karte^.inhalt[2])
  26.           AND (suchbegriff[inh2]^.begriff
  27.                <>wildcard))
  28.       OR ((suchbegriff[inh1]^.begriff
  29.            <>karte^.inhalt[1])
  30.           AND (suchbegriff[inh1]^.begriff
  31.                <>wildcard)) )
  32.           AND NOT bb
  33.     DO BEGIN
  34.       IF karte<>NIL THEN
  35.         karte:=karte^.naechste
  36.       ELSE
  37.         bb:=TRUE;
  38.     END
  39.     ELSE bb:=TRUE;
  40.   match:=NOT bb;
  41. END;
  42.  
  43.  
  44. PROCEDURE aktionen_ausfuehren;
  45. BEGIN
  46.   befehl:=erster_befehl;
  47.   IF befehl=NIL THEN feld_mit_inhalt_ausgeben(z)
  48.   ELSE
  49.     REPEAT
  50.       CASE befehl^.anw OF
  51.         monitor  : feld_mit_inhalt_ausgeben(z);
  52.         drucker  : BEGIN
  53.                      feld_mit_inhalt_ausdrucken(z);
  54.                      auf_drucker:=TRUE;
  55.                    END;
  56.         loeschen : BEGIN
  57.                      Write('Sind Sie sicher,daß diese ');
  58.                      Write('Karte gelöscht ');
  59.                      WriteLn('werden soll:');
  60.                      FOR u:=1 TO 4 DO
  61.                        feld_mit_inhalt_ausgeben(u);
  62.                      WriteLn;WriteLn('j/n');
  63.                      IF ant='j' THEN BEGIN
  64.                        IF karte=erste_karte THEN
  65.                          erste_karte:=karte^.naechste
  66.                        ELSE BEGIN
  67.                          ksuch2:=NIL;
  68.                          ksuch1:=erste_karte;
  69.                          WHILE ksuch1<>karte DO BEGIN
  70.                            ksuch2:=ksuch1;
  71.                            ksuch1:=ksuch1^.naechste;
  72.                          END;
  73.                          ksuch2^.naechste
  74.                            :=karte^.naechste;
  75.                        END;
  76.                        Dispose(karte); kartanz:=kartanz-1;
  77.                        cty:=inh4;
  78.                        (* => kein weiteres feld *)
  79.                        WriteLn('Karte gelöscht !!!');
  80.                      END;
  81.                    END;
  82.        editieren : BEGIN
  83.                      IF no_feld
  84.                         OR  (no_feld2 AND zweite_anfrage)
  85.                         THEN BEGIN
  86.                        editiere_karteikarte(karte);
  87.                        cty:=inh4;
  88.                       END
  89.                       ELSE BEGIN
  90.                         feld_mit_inhalt_ausgeben(z);
  91.                         WriteLn;
  92.                         WriteLn('Wollen Sie dies ändern ?');
  93.                         WriteLn('j/n'); ReadLn(ant);
  94.                         WriteLn;
  95.                         IF ant='j' THEN BEGIN
  96.                           Write(feldnamen[karte^.
  97.                                           kartentyp,z],
  98.                                           ': ');
  99.                           ReadLn(karte^.inhalt[z]);
  100.                         END;
  101.                       END;
  102.                     END;
  103.      kartedrucken : BEGIN
  104.                       FOR u:=1 TO 4 DO BEGIN
  105.                         feld_mit_inhalt_ausdrucken(u);
  106.                         WriteLn(LST);
  107.                       END;
  108.                       WriteLn(LST);WriteLn(LST);
  109.                       WriteLn(LST,feldnamen[karte^.
  110.                                             kartentyp,
  111.                                             5],': ');
  112.                       WriteLn(LST);
  113.                       FOR u:=1 TO 7 DO
  114.                         WriteLn(LST,karte^.inhalt5[u]);
  115.                       WriteLn(LST); WriteLn(LST);
  116.                       WriteLn(LST); WriteLn(LST);
  117.                       WriteLn(LST);
  118.                       cty:=inh4;
  119.                (* => kein weiteres feld bearbeiten *)
  120.                     END;
  121.       END;
  122.       befehl:=befehl^.naechste;
  123.     UNTIL befehl=NIL;
  124. END;
  125.  
  126. PROCEDURE feldinhalt_ausgeben;
  127. (* Die Aktionen werden mit allen Feldinhalten *)
  128. (* durchgeführt, nach denen gefragt wurde     *)
  129. BEGIN
  130.   suchbegriff[feld]:=erster_begriff[feld];
  131.   REPEAT
  132.     cty:=inh1;
  133.     REPEAT
  134.       z:=Ord(cty);
  135.       IF (suchbegriff[feld]^.begriff=wildcard)
  136.          OR (feldnamen[karte^.kartentyp,z]
  137.              =suchbegriff[feld]^.begriff) THEN
  138.         aktionen_ausfuehren;
  139.       cty:=Succ(cty);
  140.     UNTIL cty=inh5;
  141.     suchbegriff[feld]:=suchbegriff[feld]^.naechste;
  142.   UNTIL suchbegriff[feld]=NIL;
  143. END;
  144.  
  145.  
  146. PROCEDURE drucke_antwort;
  147. (* Die Karteikarten werden nach allen  *)
  148. (* Kombinationen von Suchbegriffen der *)
  149. (* verschiedenen Felder durchsucht     *)
  150.  
  151. VAR xyi:INTEGER;
  152.  
  153. BEGIN
  154.   schwarzaufweiss;
  155.   FOR xyi:=3 TO 5 DO BEGIN
  156.     resetfenster;
  157.     fenster(xyi,xyi,81-xyi,26-xyi);
  158.     ClrScr;
  159.   END;
  160.   weissaufschwarz;
  161.   ClrScr;
  162.   suchbegriff[inh1]:=erster_begriff[inh1];
  163.   WHILE suchbegriff[inh1]<>NIL DO BEGIN
  164.     suchbegriff[inh2]:=erster_begriff[inh2];
  165.     WHILE suchbegriff[inh2]<>NIL DO BEGIN
  166.       suchbegriff[inh3]:=erster_begriff[inh3];
  167.       WHILE suchbegriff[inh3]<>NIL DO BEGIN
  168.         suchbegriff[inh4]:=erster_begriff[inh4];
  169.         WHILE suchbegriff[inh4]<>NIL DO BEGIN
  170.           karte:=erste_karte;
  171.           WHILE match AND (karte<>NIL) DO BEGIN
  172.             auf_drucker:=FALSE;
  173.             feldinhalt_ausgeben;
  174.             IF auf_drucker THEN WriteLn(LST)
  175.             ELSE WriteLn;
  176.             IF karte<>NIL THEN karte:=karte^.naechste;
  177.           END;
  178.           suchbegriff[inh4]
  179.             :=suchbegriff[inh4]^.naechste;
  180.         END;
  181.         suchbegriff[inh3]:=suchbegriff[inh3]^.naechste;
  182.       END;
  183.       suchbegriff[inh2]:=suchbegriff[inh2]^.naechste;
  184.     END;
  185.     suchbegriff[inh1]:=suchbegriff[inh1]^.naechste;
  186.   END;
  187.   weissaufschwarz;
  188.   resetfenster;
  189. END;
  190.  
  191. PROCEDURE getcategory;
  192. (* Liefert die Kategorie des nächsten *)
  193. (* Wortes in der Eingabe              *)
  194. VAR bb,is_bdl:BOOLEAN;
  195.  
  196. BEGIN
  197.   REPEAT
  198.     IF eingabe='' THEN category:=pop
  199.     ELSE BEGIN
  200.       u:=Length(eingabe);
  201.       z:=1;
  202.       IF eingabe[1]='"' THEN BEGIN
  203.         wort:=Copy(eingabe,2,
  204.                    Pos('"',Copy(eingabe,2,u-1))-1);
  205.         z:=Length(wort)+4;
  206.       END
  207.       ELSE BEGIN
  208.         wort:=Copy(eingabe,1,Pos(' ',eingabe)-1);
  209.         z:=Length(wort)+2;
  210.       END;
  211.       eingabe:=Copy(eingabe,z,u-z+1);
  212.       kt:=nix;         is_bdl:=FALSE;
  213.       anweis:=keine;   category:=bdl;
  214.       IF (wort='nach') OR (wort='NACH') THEN nach:=TRUE
  215.       ELSE BEGIN  (* Ist das Wort eine Anweisung ? *)
  216.         FOR z:=1 TO bdlanz DO
  217.           IF wort=bdlos[z] THEN is_bdl:=TRUE;
  218.         IF NOT is_bdl THEN BEGIN
  219.           FOR z:=1 TO sortanz DO
  220.             IF wort=sort[z] THEN anweis:=sortieren;
  221.            IF anweis=keine THEN
  222.            FOR z:=1 TO monanz DO
  223.              IF wort=mon[z] THEN
  224.              anweis:=monitor;
  225.            IF anweis=keine THEN
  226.              FOR z:=1 TO druckanz DO
  227.                IF wort=druck[z] THEN anweis:=drucker;
  228.            IF anweis=keine THEN
  229.              FOR z:=1 TO editanz DO
  230.                IF wort=edit[z] THEN anweis:=editieren;
  231.            IF anweis=keine THEN
  232.              FOR z:=1 TO loeschanz DO
  233.                IF wort=loesch[z] THEN anweis:=loeschen;
  234.            IF anweis=keine THEN
  235.              FOR z:=1 TO kdruckanz DO
  236.                IF wort=kartdruck[z] THEN
  237.                  anweis:=kartedrucken;
  238.            IF anweis<>keine THEN category:=anweisung
  239.            ELSE BEGIN (* Ist das Wort ein Feldname ? *)
  240.              bb:=FALSE;
  241.              REPEAT
  242.                kt:=Succ(kt); z:=0;
  243.                REPEAT
  244.                  z:=z+1;
  245.                  hilfstr:=feldnamen[kt,z];
  246.                  IF enthalten_in(wort,hilfstr) THEN
  247.                    bb:=TRUE;
  248.                UNTIL bb OR (z=5);
  249.              UNTIL (kt=letzter_typ) OR bb;
  250.              IF bb THEN BEGIN
  251.                         category:=feld;
  252.                         no_feld2:=no_feld;
  253.                         no_feld:=FALSE;
  254.              END
  255.              ELSE BEGIN
  256.                (* Ist das Wort ein Feldinhalt ? *)
  257.                category:=bdl;
  258.                hilf:=erste_karte;
  259.                REPEAT
  260.                  z:=0;
  261.                  REPEAT
  262.                    z:=z+1;
  263.                    hilfstr:=hilf^.inhalt[z];
  264.                    IF enthalten_in(wort,hilfstr) THEN
  265.                      bb:=TRUE;
  266.                  UNTIL bb OR (z=4);
  267.                 IF bb THEN
  268.                   CASE z OF 1: category:=inh1;
  269.                             2: category:=inh2;
  270.                             3: category:=inh3;
  271.                             4: category:=inh4;
  272.                   END;
  273.                 hilf:=hilf^.naechste;
  274.                 (* Bedeutungslose Wörter *)
  275.                 (* werden überlesen      *)
  276.               UNTIL (hilf=NIL) OR (category<>bdl);
  277.             END;
  278.           END;
  279.         END;
  280.       END;
  281.     END;
  282.   UNTIL category<>bdl;
  283. END;
  284.  
  285. FUNCTION richtig_verstanden:BOOLEAN;
  286.  
  287. VAR begriffe:begriffsfeld;
  288.     befehle:befehlszeiger;
  289.     cty:kategorien;
  290.     xi:INTEGER;
  291. BEGIN
  292.   schwarzaufweiss;
  293.   resetfenster;
  294.   IF hga THEN
  295.     Move(speichere_bildschirm,bildschirm_hga,4000)
  296.   ELSE
  297.     Move(speichere_bildschirm,bildschirm_cga,4000);
  298.   fenster(10,5,70,19);
  299.   ClrScr;
  300.   GotoXY(10,9);
  301.   WriteLn(' Ich soll folgendes tun : ');
  302.   begriffe:=erster_begriff;
  303.   befehle:=erster_befehl;
  304.   WriteLn;
  305.   IF begriffe[feld]^.begriff<>wildcard THEN BEGIN
  306.     IF begriffe[feld]^.naechste<>NIL THEN
  307.       WriteLn(' folgende Felder:')
  308.     ELSE
  309.       WriteLn(' folgendes Feld:');
  310.     WHILE begriffe[feld]<>NIL DO BEGIN
  311.       Write('':10);
  312.       weissaufschwarz;
  313.       Write(begriffe[feld]^.begriff);
  314.       schwarzaufweiss;
  315.       WriteLn;
  316.       begriffe[feld]:=begriffe[feld]^.naechste;
  317.     END;
  318.   END
  319.   ELSE
  320.     WriteLn(' alle Karteikarten ');
  321.   WriteLn;
  322.   IF (begriffe[inh1]^.begriff<>wildcard)
  323.      OR (begriffe[inh2]^.begriff<>wildcard)
  324.      OR (begriffe[inh3]^.begriff<>wildcard)
  325.      OR (begriffe[inh4]^.begriff<>wildcard) THEN BEGIN
  326.     WriteLn(' mit folgenden Feldinhalten:');
  327.     FOR cty:=inh1 TO inh4 DO BEGIN
  328.       WHILE begriffe[cty]<>NIL DO BEGIN
  329.         Write('':10);
  330.         weissaufschwarz;
  331.         IF begriffe[cty]^.begriff<> wildcard THEN
  332.           Write(begriffe[cty]^.begriff);
  333.         schwarzaufweiss;
  334.         WriteLn;
  335.         begriffe[cty]:=begriffe[cty]^.naechste;
  336.       END;
  337.     END;
  338.   END;
  339.   Write(' soll ich ');
  340.   IF befehle=NIL THEN
  341.     WriteLn('auf dem Bildschirm ausgeben !');
  342.   WHILE befehle<>NIL DO BEGIN
  343.     IF befehle<>erster_befehl THEN
  344.       Write(' und ');
  345.     CASE befehle^.anw OF
  346.             monitor  : WriteLn(
  347.                        'auf dem Bildschirm ausgeben');
  348.             drucker  : WriteLn(
  349.                        'auf dem Drucker ausgeben');
  350.             loeschen : WriteLn(
  351.                        'aus der Kartei streichen');
  352.            editieren : WriteLn('editieren');
  353.         kartedrucken : WriteLn(
  354.                        'formatiert auf dem ',
  355.                        'Drucker ausgeben');
  356.             sortieren : IF (sortierer<>wildcard)
  357.                            AND (sortierer<>'') THEN
  358.                           WriteLn('nach ',sortierer,
  359.                                   ' sortieren')
  360.                          ELSE
  361.                            WriteLn('sortieren');
  362.     END;
  363.     befehle:=befehle^.naechste;
  364.   END;
  365.   resetfenster;
  366.   resetfenster;TextColor(blink);
  367.   fenster(19,22,62,23);
  368.   TextColor(white);ClrScr;
  369.   Write(' Ist diese Interpretation richtig ?  ');
  370.   schwarzaufweiss;
  371.   REPEAT
  372.     Read(KBD,ant);
  373.     IF ant=Chr(27) THEN hilfe(8);
  374.   UNTIL ant IN ['j','J','n','N']; WriteLn; WriteLn;
  375.   richtig_verstanden :=  (ant IN ['j','J']);
  376.   weissaufschwarz;
  377.   resetfenster;
  378.   ClrScr;
  379. END;
  380.  
  381.  
  382. PROCEDURE anfragen;
  383.  
  384. VAR x,y:INTEGER;
  385.  
  386. BEGIN
  387.   resetfenster;
  388.   fenster(2,22,79,23);  eingabe:=''; zeile:=1;
  389.   ClrScr;WriteLn('Ihre Anfrage: ');
  390.   x:=WhereX; y:=WhereY;
  391.   weissaufschwarz;
  392.   Write('':62);
  393.   schwarzaufweiss;   GotoXY(x,y);
  394.   my_readln(eingabe,76,3);
  395.   IF eingabe<>'' THEN BEGIN
  396.     eingabe:=eingabe+' ';
  397.     (* initialisierecc die Befehlsliste *)
  398.     erster_befehl := NIL;
  399.     letzter_befehl := NIL;
  400.     befehl := NIL;
  401.     sortierer := ''; nach := FALSE; antworten := 1;
  402.     getcategory; no_feld := TRUE;
  403.     (* Einfaches ATN mit einer Aktion, naemlich dem *)
  404.     (* Erkennen einer zweiten Anfrage               *)
  405.     REPEAT
  406.       zustand:=za; (* anfangszustand *)
  407.       zweite_anfrage:=FALSE; no_feld2:=no_feld;
  408.       (* initialisiere die Listen der Suchbegriffe *)
  409.       FOR cty:=feld TO inh5 DO BEGIN
  410.         suchbegriff[cty]:=NIL;
  411.         erster_begriff[cty]:=NIL;
  412.         letzter_begriff[cty]:=NIL;
  413.       END;
  414.       REPEAT
  415.       (* Kante von za nach zb *)
  416.       IF category IN [inh1..inh4] THEN zustand:=zb;
  417.       (* Kante von zb nach za mit Aufruf der *)
  418.       (* Aktion "Beantworte erste Anfrage !" *)
  419.       IF (zustand=zb) AND (category=feld) THEN
  420.         zweite_anfrage:=TRUE;
  421.       (* Anweisung wird in die Befehlsliste aufgenommen *)
  422.       IF category=anweisung THEN BEGIN
  423.         New(befehl);
  424.         IF erster_befehl=NIL THEN erster_befehl:=befehl
  425.         ELSE letzter_befehl^.naechste:=befehl;
  426.         befehl^.anw:=anweis;
  427.         befehl^.naechste:=NIL;
  428.         letzter_befehl:=befehl;
  429.         getcategory;
  430.       END
  431.       ELSE BEGIN (* Sonderfall: sortiere nach ... *)
  432.         IF (category=feld) AND nach THEN BEGIN
  433.           sortierer:=wort;
  434.           nach:=FALSE;
  435.           getcategory;
  436.         END
  437.         ELSE
  438.         (* Das Wort ist ein Feldname oder Feldinhalt *)
  439.         (* und wird in die entsprechende Liste der   *)
  440.         (* Suchbegriffe aufgenommen                  *)
  441.           IF (category<>pop)
  442.               AND NOT zweite_anfrage THEN BEGIN
  443.            New(suchbegriff[category]);
  444.            IF erster_begriff[category]=NIL
  445.            THEN
  446.              erster_begriff[category]
  447.                := suchbegriff[category]
  448.            ELSE
  449.              letzter_begriff[category]^.naechste
  450.                := suchbegriff[category];
  451.            suchbegriff[category]^.naechste := NIL;
  452.            suchbegriff[category]^.begriff := wort;
  453.            letzter_begriff[category]
  454.              := suchbegriff[category];
  455.            getcategory;
  456.          END;
  457.      END;
  458.    UNTIL (category=pop) OR zweite_anfrage;
  459.    (* Steht in einer der Listen kein Suchbegriff, *)
  460.    (* dann sei der Suchbegriff ein "Joker"        *)
  461.    FOR cty:=feld TO inh5 DO
  462.      IF erster_begriff[cty]=NIL THEN BEGIN
  463.        New(erster_begriff[cty]);
  464.        erster_begriff[cty]^.begriff:=wildcard;
  465.        erster_begriff[cty]^.naechste:=NIL;
  466.       END;
  467.    (* Lösche Anweisung, die mehrfach in *)
  468.    (* der Befehlsliste vorkommen        *)
  469.    ctrlmenge:=[];
  470.    befehl:=erster_befehl;
  471.    WHILE befehl<>NIL DO BEGIN
  472.      IF befehl^.anw IN ctrlmenge THEN BEGIN
  473.        letzter_befehl^.naechste:=befehl^.naechste;
  474.        Dispose(befehl);
  475.      END
  476.      ELSE BEGIN
  477.        ctrlmenge:=ctrlmenge+[befehl^.anw];
  478.        letzter_befehl:=befehl;
  479.        (* Lautet eine Anweisung 'sortieren', so *)
  480.        (* führe sie sofort aus                  *)
  481.        IF befehl^.anw=sortieren THEN bubble_sort;
  482.      END;
  483.      befehl:=letzter_befehl^.naechste;
  484.    END;
  485.    WriteLn;WriteLn;
  486.    (* Das ATN ist für eine Anfrage durchlaufen, nun *)
  487.    (* beantworte diese *)
  488.    IF richtig_verstanden THEN drucke_antwort;
  489.    (* Lösche die Liste der Suchbegriffe*)
  490.    FOR cty:=feld TO inh5 DO BEGIN
  491.      suchbegriff[cty]:=erster_begriff[cty];
  492.      WHILE suchbegriff[cty]<>NIL DO BEGIN
  493.        letzter_begriff[cty]:=suchbegriff[cty];
  494.        suchbegriff[cty]:=suchbegriff[cty]^.naechste;
  495.        Dispose(letzter_begriff[cty]);
  496.      END;
  497.    END;
  498.   UNTIL category=pop; (* Die Eingabe ist abgearbeitet *)
  499.   befehl:=erster_befehl;
  500.   (* Lösche die Befehlsliste *)
  501.   WHILE befehl<>NIL DO BEGIN
  502.     letzter_befehl:=befehl;
  503.     befehl:=befehl^.naechste;
  504.     Dispose(letzter_befehl);
  505.   END;
  506.     ReadLn;
  507.   END;
  508.   resetfenster;
  509. END;
  510.