home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 02 / grdlagen / modlist.mod < prev   
Encoding:
Text File  |  1989-11-23  |  7.6 KB  |  275 lines
  1. (**********************************************************)
  2. (*          Modula-Kurs, Teil 5: Beispiel 1               *)
  3. (*          (C) Peter Viczena & toolbox 1990              *)
  4. (**********************************************************)
  5.  
  6. MODULE ArrayTstNeu;
  7.  
  8. FROM    InOut   IMPORT  WriteString, WriteLn,
  9.                         ReadInt, WriteInt, ReadString;
  10.  
  11. CONST   Anzahl   = 4;              (* Einzulesende Zahlen *)
  12.  
  13. TYPE    Nummern  = INTEGER;
  14.         Menge    = [0..Anzahl];       (* Unterbereichstyp *)
  15.   
  16.         Teilnehmer = RECORD
  17.                       Name           : ARRAY[1..20] OF CHAR;
  18.                       Strasse        : ARRAY[1..30] OF CHAR;
  19.                       ORT            : ARRAY[1..30] OF CHAR;
  20.                       Vorwahl        : Nummern;                    
  21.                       TelNummer      : Nummern;
  22.                      END;
  23.  
  24.         TelefonListe    = ARRAY Menge OF Teilnehmer;
  25.         
  26. VAR     TestArray       : TelefonListe;
  27.         Zahl            : Nummern;
  28.         l               : CARDINAL;
  29.  
  30.  
  31. PROCEDURE BubbleSort( VAR a : TelefonListe);
  32.                                  (* sortiert TelefonListe *)
  33. VAR     i, j,
  34.         k       : CARDINAL;
  35.  
  36. BEGIN
  37.   FOR i := 1 TO Anzahl DO              (* Für alle Zahlen *)
  38.     FOR j := Anzahl TO i BY -1 DO  (* gehe die folgenden  *)
  39.                                    (* durch und schau,    *)
  40.                   (* ob sie größer sind. Wenn ja, tausche *)
  41.       IF a[j-1].TelNummer > a[j].TelNummer THEN
  42.         k                := a[j-1].TelNummer;
  43.         a[j-1].TelNummer := a[j].TelNummer;
  44.         a[j].TelNummer   := k;
  45.       END; (* IF *)
  46.  
  47.     END; (* FOR *)
  48.   END; (* FOR *)
  49. END BubbleSort;
  50.  
  51.  
  52. BEGIN
  53.   WriteString( 'Array-Test OF INTEGER'); WriteLn;
  54.   WriteString( '---------------------'); WriteLn;
  55.   WriteLn;
  56.   WriteString('Bitte 5 Integer-Zahlen eingeben:'); WriteLn;
  57.   WriteLn;
  58.   
  59.   FOR l := 0 TO Anzahl DO   (* Lies Array-Komponenten ein *)
  60.      WriteString('Name :');
  61.      ReadString (TestArray[l].Name);   
  62.      WriteString( 'Zahl :');
  63.      ReadInt( Zahl);
  64.      WriteLn;
  65.      TestArray[l].TelNummer := Zahl;
  66.   END; (* FOR *)
  67.   
  68.   BubbleSort( TestArray);                     (* sortiere *)
  69.   
  70.   WriteString( 'Zahlen und Namen sortiert:'); WriteLn;
  71.   WriteLn;
  72.   
  73.   FOR l := 0 TO Anzahl DO          (* gib den Array aus   *)
  74.      WriteString('Name :');
  75.      WriteString(TestArray[l].Name);    
  76.      WriteLn;     
  77.      WriteInt( TestArray[l].TelNummer, 5);
  78.      WriteLn; WriteLn;
  79.   END; (* FOR *)
  80.   
  81. END ArrayTstNeu.
  82.  
  83.  
  84.  
  85.  
  86.  
  87. (**********************************************************)
  88. (*          Modula-Kurs, Teil 5: Beispiel 2               *)
  89. (*          (C) Peter Viczena & toolbox 1990              *)
  90. (**********************************************************)
  91.  
  92.  
  93. MODULE CaseTest;
  94.  
  95.  
  96. TYPE ArtTyp   = (Kunde,Lieferant, Privat);
  97.  
  98.   Adresse = RECORD
  99.       Name           : ARRAY[1..30] OF CHAR;
  100.       Strasse        : ARRAY[1..30] OF CHAR;
  101.       ORT            : ARRAY[1..30] OF CHAR;
  102.       Vorwahl        : Nummern;
  103.       TelNummer      : Nummern;
  104.  
  105.       CASE Art       : ArtTyp OF
  106.            Kunde     : Kundennummer : INTEGER;
  107.          | Lieferant : AnsprPartner : ARRAY [1..20] OF CHAR;
  108.          | Privat    :                            (* leer *)
  109.       END;                                        (* CASE *)
  110.  
  111.   END;                                          (* RECORD *)
  112.  
  113.  
  114. VAR p1,p2, p3 : Adresse;
  115.  
  116. BEGIN
  117.  
  118.   p1.Name        := "Peter Lustig";
  119.   p1.Strasse     := "Pusteblumenweg 13";
  120.   p1.Ort         := "4690 Wanne Eickel";
  121.   p1.Vorwahl     :=  02325;
  122.   p1.Nummer      :=  99989;
  123.   p1.Art         :=  Kunde;
  124.   p1.Kundenummer :=  234;
  125.  
  126.  
  127.   WITH p2 DO
  128.        Name           := "Advanced Applications";
  129.        Strasse        := "Sperlingweg 19";
  130.        Ort            := "7500 Karlsruhe 31";
  131.        Vorwahl        :=  0721;
  132.        Nummer         :=  700912;
  133.        Art            :=  Lieferant;
  134.        AnsprPartner   := "Herr Viczena";
  135.   END;                 %---> Programm "Kreisbogen"
  136. %---> demonstriert die Verwendung des Befehls "arcto"
  137. %---> zur Darstellung abgerundeter Ecken
  138.  
  139. % Hauptprogramm
  140.  
  141. /Times-Roman findfont
  142. 15 scalefont
  143. setfont
  144.  
  145. newpath                   % Seite öffnen
  146.  
  147. % markiere Kreisabschnitt
  148.  
  149.  0.1 setlinewidth         % Linienstärke fein
  150.  0 setgray                % 100 Prozent Schwarz
  151.  
  152.  190 380  moveto          % positioniere Cursor
  153.  (Startposition) show     % markiere Start und Ziel
  154.  200 400  moveto          % positioniere Cursor
  155.  300 500  lineto          % zeichne feine (Hilfs-)Linie
  156.  290 510  moveto          % Abstand für den Text
  157.  (X1,Y1) show
  158.  300 500  moveto          % an den Endpunkt der 1. Linie
  159.  400 400  lineto          % zeichne feine (Hilfs-)Linie
  160.  370 380  moveto          % Abstand für den Text
  161.  (X2,Y2) show
  162.  stroke                   % Ausführung
  163.  
  164. %------------------------------
  165. % zeichne die abgerundete Ecke
  166. %------------------------------
  167.  
  168.  2.0 setlinewidth         % grobere Linienstärke
  169.  200 400  movlem := Oben to (Start +1) By -1 DO
  170.   
  171.      BisherMax := Start;
  172.      FOR TestElem := (Start+1) TO LetztesUnsortElem DO
  173.           IF Feld[BisherMax] < Feld[TestElem] THEN 
  174.                BisherMax := TestElem
  175.           END;                                      (* IF *)
  176.      END;                                          (* FOR *)
  177.  
  178.      Tausch(Feld[BisherMax],Feld[LetzesUnsortElem]);
  179.  
  180.   END;                                             (* FOR *)
  181.  
  182. END MiniSort;
  183.  
  184.  
  185. PROCEDURE FindeMittel(Start, Oben:CARDINAL);
  186. (* setzt den zentralen Wert von Start, Oben, Mitte an die *)
  187. (* Indexposition von Start, damit die Partitionierung     *)
  188. (* starten kann                                           *)
  189.  
  190. VAR Mitte: CARDINAL;
  191.  
  192. BEGIN
  193.  
  194.   Mitte := (Start+Oben) DIV 2;
  195.   IF Feld[Oben] < Feld[Mitte] THEN 
  196.      Tausch(Feld[Oben], Feld[Mitte]) 
  197.   END;
  198.  
  199.   IF Feld[Start] < Feld[Mitte] THEN 
  200.      Tausch(Feld[Start], Feld[Mitte]) 
  201.   END;
  202.  
  203.   IF Feld[Oben] < Feld[Start] THEN 
  204.      Tausch(Feld[Oben], Feld[Start]) 
  205.   END;
  206.  
  207. END FindeMittel;
  208.  
  209.  
  210. PROCEDURE Partitioniere (VAR m:CARDINAL);
  211.  
  212. VAR l,r CARDINAL;
  213.  
  214. BEGIN
  215.  
  216.   l := Start;                            (* linker Zeiger *)
  217.   r := Oben;                            (* rechter Zeiger *)
  218.   m := Start;                         (* mittlerer Zeiger *)
  219.  
  220. While r > l DO
  221.  
  222.   While Feld[m]<Feld[t] AND (m<r) DO
  223.      r := r-1;                 (* rutsche durch solange   *)
  224.   END; (* WHILE *)             (* rechts alles größer ist *)
  225.  
  226.   IF m < r THEN
  227.      Tausch (Feld[m], Feld[r]);
  228.      m := r;                   (* Falls es ein kleineres  *)
  229.   END (* IF *)                 (* Feldelement gibt Tausche*)
  230.  
  231.   IF l < r THEN
  232.  
  233.      WHILE Feld[l] < Feld[m] AND (l<m)
  234.           s:= S+1;             (* rutsche durch solange   *)
  235.      END; (* WHILE *)          (* links alles kleiner ist *)
  236.  
  237.      IF l < m THEN
  238.           Tausch(Feld[l], Feld[m]);
  239.           m := l;               (* Falls es ein größeres  *)
  240.      END; (* IF *)            (* Feldelement gibt Tausche *)
  241.  
  242.   END;                                              (* IF *)
  243.  
  244. END;                                             (* WHILE *)
  245.  
  246. END Partitioniere;
  247.  
  248.  
  249.  
  250.  
  251. PROCEDURE Quicksort (Start, Oben:CARDINAL);
  252.  
  253. VAR p:Cardinal;               (* der Index des Fixpunktes *)
  254.  
  255. BEGIN
  256.  
  257. IF (Oben-Start) > 8 THEN
  258.      FindeMittel(Start, Oben);
  259.      Partitioniere(p);
  260.      Quicksort (Start, p-1);
  261.      Quicksort (p+1, Oben);
  262.  
  263.   ELSE
  264.      MiniSort(Start, Oben);
  265. END;                                                (* IF *)
  266.  
  267. END Quicksort;
  268.  
  269.  
  270. BEGIN                               (* der Rumpf von Sort *)
  271.  
  272.      Quicksort(Erstes, Letztes);
  273.  
  274. END Sort;
  275.