home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sonderh1 / automat.pas < prev    next >
Pascal/Delphi Source File  |  1994-03-02  |  9KB  |  283 lines
  1. {---------------------------------------------------------------------------}
  2. {                     Simulation in Pascal                                  }
  3. {           Idee und Ausfuehrung : Ernst Heinz, 22.9.1986                   }
  4. {---------------------------------------------------------------------------}
  5.  
  6. PROGRAM fahrkarten_automat (INPUT, OUTPUT);
  7.  
  8. CONST max_geld_stuecke =   7;          (* Anzahl verschiedener Geldstuecke *)
  9.       max_speicher     = 100;          (* Kapazitaet des Geldspeichers     *)
  10.  
  11.  
  12. TYPE  feld_index = 1..max_geld_stuecke;
  13.       int_feld   = ARRAY[1..max_geld_stuecke] OF INTEGER;
  14.       str_feld   = ARRAY[1..max_geld_stuecke] OF STRING[5];
  15.  
  16.  
  17. VAR  preis         : INTEGER;  (* der zu zahlende Preis *)
  18.      bezahlt       : INTEGER;  (* das eingeworfene Geld *)
  19.      eingabe       : int_feld; (* die eingegebenen Geldstuecke *)
  20.      rueckgabe     : int_feld; (* die zurueckzugebenden Geldstuecke *)
  21.      geld_speicher : int_feld; (* die im Automaten vorhandenen Geldstuecke *)
  22.      geld_wert     : int_feld; (* der Wert der einzelnen Geldstuecke *)
  23.      geld_name     : str_feld; (* die Bezeichnung der einzelnen Stuecke *)
  24.      ch            : CHAR;
  25.  
  26. {---------------------------------------------------------------------------}
  27.  
  28. PROCEDURE loesche_bildschirm;      (* u.U. an Ihre Pacalversion anpassen ! *)
  29.  
  30. BEGIN
  31.   PAGE(output);
  32. END;
  33.  
  34. {---------------------------------------------------------------------------}
  35.  
  36. PROCEDURE pieps_ton;              (* u.U. an Ihre Pascalversion anpassen ! *)
  37.  
  38. BEGIN
  39.   WRITE(CHR(7))
  40. END;
  41.  
  42. {---------------------------------------------------------------------------}
  43.  
  44. PROCEDURE init_name;      (* belegt das Feld mit den Namen der Geldstuecke *)
  45.  
  46. BEGIN
  47.   geld_name[1] := '10 PF';
  48.   geld_name[2] := '50 PF';
  49.   geld_name[3] := '1 DM';
  50.   geld_name[4] := '2 DM';
  51.   geld_name[5] := '5 DM';
  52.   geld_name[6] := '10 DM';
  53.   geld_name[7] := '20 DM';
  54. END;
  55.  
  56. {---------------------------------------------------------------------------}
  57.  
  58. PROCEDURE init_wert;      (* wird intern in Pfennigdarstellung gespeichert *)
  59.  
  60. BEGIN
  61.   geld_wert[1] :=   10;  (* 10 PF,     muss der Groesse nach belegt werden *)
  62.   geld_wert[2] :=   50;  (* 50 PF *)
  63.   geld_wert[3] :=  100;  (*  1 DM *)
  64.   geld_wert[4] :=  200;  (*  2 DM *)
  65.   geld_wert[5] :=  500;  (*  5 DM *)
  66.   geld_wert[6] := 1000;  (* 10 DM *)
  67.   geld_wert[7] := 2000;  (* 20 DM *)
  68. END;
  69.  
  70. {---------------------------------------------------------------------------}
  71.  
  72. PROCEDURE init_speicher;      (* am Anfang im Automaten gespeichertes Geld *)
  73.  
  74. VAR i : INTEGER;
  75.  
  76. BEGIN
  77.   geld_speicher[max_geld_stuecke] := 0;
  78.   FOR i := 1 TO (max_geld_stuecke - 1) DO
  79.     geld_speicher[i] := 20;
  80. END;
  81.  
  82. {---------------------------------------------------------------------------}
  83.  
  84. PROCEDURE init_int_feld (VAR feld: int_feld);
  85.  
  86. VAR i: INTEGER;
  87.  
  88. BEGIN
  89.   FOR i := 1 TO max_geld_stuecke DO feld[i] := 0;
  90. END;
  91.  
  92. {---------------------------------------------------------------------------}
  93.  
  94. PROCEDURE write_dm_wert (pf: INTEGER);
  95.  
  96. VAR dm_string: STRING[8];                      (* zur Pfg./DM - Umwandlung *)
  97.  
  98. BEGIN
  99.   STR(pf, dm_string);
  100.   WHILE LENGTH(dm_string) < 3 DO
  101.     INSERT('0', dm_string,1);                           (* fuehrend Nullen *)
  102.   INSERT('.', dm_string, LENGTH(dm_string)-1);
  103.   WRITE(dm_string, ' DM')
  104. END;
  105.  
  106. {---------------------------------------------------------------------------}
  107.  
  108. FUNCTION waehle_fahrkartenpreis: INTEGER;   (* Fahrkarte und Preis waehlen *)
  109.  
  110. VAR wahl: CHAR;
  111.  
  112. BEGIN
  113.   loesche_bildschirm;
  114.   WRITELN('< Ende durch Eingabe von "0" >'); WRITELN;
  115.   WRITELN('Fahrkarte Nr.1 = 0.80 DM');
  116.   WRITELN('Fahrkarte Nr.2 = 1.20 DM');
  117.   WRITELN('Fahrkarte Nr.3 = 1.90 DM');
  118.   WRITELN('Fahrkarte Nr.4 = 2.50 DM');
  119.   WRITELN('Fahrkarte Nr.5 = 3.20 DM');
  120.   WRITELN('Fahrkarte Nr.6 = 4.70 DM');
  121.   WRITELN('Fahrkarte Nr.7 = 5.90 DM');
  122.   WRITELN('Fahrkarte Nr.8 = 8.30 DM');
  123.   WRITELN; WRITELN;
  124.   WRITE ('Ihre Wahl - Sie wuenschen Fahrkarte Nr.'); pieps_ton;
  125.   REPEAT
  126.     READLN(wahl);
  127.   UNTIL wahl IN ['0'..'8'];
  128.   CASE wahl OF
  129.     '0' : waehle_fahrkartenpreis :=   0;
  130.     '1' : waehle_fahrkartenpreis :=  80;
  131.     '2' : waehle_fahrkartenpreis := 120;
  132.     '3' : waehle_fahrkartenpreis := 190;
  133.     '4' : waehle_fahrkartenpreis := 250;
  134.     '5' : waehle_fahrkartenpreis := 320;
  135.     '6' : waehle_fahrkartenpreis := 470;
  136.     '7' : waehle_fahrkartenpreis := 590;
  137.     '8' : waehle_fahrkartenpreis := 830;
  138.   END;
  139. END;
  140.  
  141. {---------------------------------------------------------------------------}
  142.  
  143. PROCEDURE geld_einwerfen;  (* laesst den Benutzer ein Geldstueck einwerfen *)
  144.  
  145. VAR i, wert     : INTEGER;            (* in 'wert' der eingeworfene Betrag *)
  146.      einwurf    : STRING[7];                 (* zum Lesen beim Geldeinwurf *)
  147.  
  148.   FUNCTION speicher_voll (nr: INTEGER): BOOLEAN;    (* Geldspeicher voll ? *)
  149.  
  150.   BEGIN
  151.     speicher_voll := (geld_speicher[nr] = max_speicher);
  152.   END;
  153.  
  154.  
  155. BEGIN
  156.   WRITE('Ihre Fahrkarte kostet '); write_dm_wert(preis); WRITELN('.');
  157.   WRITE('Zu bezahlen sind noch '); write_dm_wert(preis-bezahlt);
  158.   WRITE('.           Bitte Geld einwerfen -->  ');
  159.   READLN(einwurf);
  160.                                      (* alles in Grossbuchstaben umwandeln *)
  161.   FOR i := 1 TO LENGTH(einwurf) DO
  162.     IF einwurf[i] IN ['a'..'z'] THEN
  163.       einwurf[i] := CHR(ORD(einwurf[i])-32);
  164.   wert := 0;
  165.   FOR i := 1 TO max_geld_stuecke DO
  166.     IF LENGTH(einwurf) >= LENGTH(geld_name[i]) THEN
  167.       IF geld_name[i] = COPY(einwurf, 1, LENGTH(geld_name[i])) THEN
  168.         IF speicher_voll(i) THEN
  169.         BEGIN
  170.           WRITELN('Der ',geld_name[i],' - Speicher ist voll !');
  171.           pieps_ton;
  172.           wert := -1;
  173.         END
  174.         ELSE
  175.         BEGIN
  176.           wert := geld_wert[i];
  177.           eingabe[i] := eingabe[i]+1;
  178.           geld_speicher[i] := geld_speicher[i]+1;
  179.         END;
  180.   IF wert=0 THEN
  181.   BEGIN
  182.     WRITE('Falschgeld wird nicht akzeptiert !'); pieps_ton; pieps_ton;
  183.     WRITELN;
  184.   END
  185.   ELSE IF wert > 0 THEN bezahlt := bezahlt + wert;
  186.   WRITELN;
  187. END;
  188.  
  189. {---------------------------------------------------------------------------}
  190.  
  191. FUNCTION kann_herausgeben: BOOLEAN;  (* ist Rueckgabe denn auch moeglich ? *)
  192.  
  193. VAR i, anz, rest: INTEGER;
  194.  
  195. BEGIN
  196.   rest := bezahlt-preis;
  197.   FOR i := max_geld_stuecke DOWNTO 1 DO  (* zuerst die grossen Geldstuecke *)
  198.   BEGIN
  199.     anz := rest DIV geld_wert[i];  (* Anzahl der zurueckzugebenden Stuecke *)
  200.     IF anz > geld_speicher[i] THEN (* sind hiervon genug vorhanden ? *)
  201.       anz := geld_speicher[i];
  202.     rueckgabe[i] := anz;
  203.     rest := rest-anz*geld_wert[i];
  204.   END;
  205.   kann_herausgeben := (rest=0);    (* geht die Rueckgabe auf ? *)
  206. END;
  207.  
  208. {---------------------------------------------------------------------------}
  209.  
  210. PROCEDURE herausgeben (VAR geld: int_feld);     (* gibt das 'geld' zurueck *)
  211.  
  212. VAR i: INTEGER;
  213.  
  214. BEGIN
  215.   FOR i := max_geld_stuecke DOWNTO 1 DO
  216.     IF geld[i] > 0 THEN
  217.     BEGIN
  218.       geld_speicher[i] := geld_speicher[i]-geld[i];  (* Bestand verringern *)
  219.       WRITELN;
  220.       WRITE(geld[i]:3, 'x ', geld_name[i]:5);
  221.     END;
  222. END;
  223.  
  224. {---------------------------------------------------------------------------}
  225.  
  226. PROCEDURE drucke_fahrkarte;
  227.  
  228. BEGIN
  229.   WRITELN('##################################################');
  230.   WRITELN('#                                                #');
  231.   WRITELN('#                                                #');
  232.   WRITELN('#    automatisch gedruckte  F A H R K A R T E    #');
  233.   WRITELN('#                                                #');
  234.   WRITE  ('#    zum  F A H R P R E I S  von  < ');
  235.   write_dm_wert(preis);
  236.   WRITELN(' >    #');
  237.   WRITELN('#                                                #');
  238.   WRITELN('#                                                #');
  239.   WRITELN('##################################################');
  240. END;
  241.  
  242. {---------------------------------------------------------------------------}
  243.  
  244. BEGIN { main }
  245.   init_name;
  246.   init_wert;
  247.   init_speicher;
  248.   REPEAT
  249.     bezahlt := 0;
  250.     preis := waehle_fahrkartenpreis;
  251.     IF preis > 0 THEN
  252.     BEGIN
  253.       init_int_feld(eingabe);
  254.       loesche_bildschirm;
  255.       REPEAT
  256.         geld_einwerfen;
  257.       UNTIL bezahlt >= preis;      (* Geld einwerfen, bis 'preis' erreicht *)
  258.       init_int_feld(rueckgabe);
  259.       IF kann_herausgeben THEN          (* Restgeldherausgabe ist moeglich *)
  260.       BEGIN
  261.         loesche_bildschirm;
  262.         drucke_fahrkarte;
  263.         WRITELN; WRITELN; WRITELN;
  264.         WRITE('O.k. , von den bezahlten ');
  265.         write_dm_wert(bezahlt);
  266.         WRITE(' erhalten Sie ');
  267.         write_dm_wert(bezahlt-preis);
  268.         WRITELN(' zurueck !');
  269.         herausgeben(rueckgabe);
  270.      END
  271.      ELSE
  272.      BEGIN
  273.        WRITELN; WRITELN;
  274.        WRITE('Restgeldherausgabe unmoeglich - Sie erhalten Ihr ');
  275.        WRITELN('ganzes Geld zurueck !');
  276.        herausgeben(eingabe);
  277.      END;
  278.      WRITELN; WRITELN('RETURN druecken...');
  279.      READLN(ch);
  280.    END;
  281.  UNTIL preis = 0;
  282. END.
  283.