home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 12 / extra / traffic.mod < prev    next >
Encoding:
Text File  |  1988-10-05  |  16.8 KB  |  483 lines
  1. (* -------------------------------------------------------------------------- *)
  2. (*                   TRAFFIC.MOD - eine Verkehrssimulation                    *)
  3. (*             Copyright (C) 1987 Jensen & Partners International             *)
  4. (*     Freie deutsche Übersetzungen und Kommentare von Karsten Gieselmann     *)
  5. (* -------------------------------------------------------------------------- *)
  6.  
  7. (*$A-,B-,I-,O-,Q-,R-,S-,V-,Z-*)                               (* Full Speed!! *)
  8.  
  9. MODULE Traffic;
  10.  
  11. IMPORT SYSTEM, IO, Window, Lib, Process;                  (* benötigte Module *)
  12.  
  13. CONST
  14.   xNum      = Window.ScreenWidth;
  15.   yNum      = Window.ScreenDepth;
  16.   CarNum    = 100;                         (* Maximalzahl von fahrenden Autos *)
  17.  
  18. TYPE
  19.   xCoord    = [0..xNum-1];
  20.   yCoord    = [0..yNum-1];
  21.   Coord     = RECORD
  22.                 x : xCoord;
  23.                 y : yCoord;
  24.               END;
  25.   Direction = (East, South, North, West);
  26.   DirSet    = SET OF Direction;
  27.   Location  = RECORD
  28.                 Entry,Exit : DirSet;
  29.                 Occupied   : BOOLEAN;
  30.                 Scenery    : SHORTCARD;
  31.               END;
  32.   DA        = ARRAY Direction OF Direction;
  33.   CarRange  = [0..CarNum-1];
  34.  
  35. CONST
  36.   Reverse   = DA(West, North, South, East);        (* Kehrstück von Direction *)
  37.  
  38. VAR
  39.   World     : ARRAY xCoord,yCoord OF Location;            (* die Straßenkarte *)
  40.   Car       : ARRAY CarRange OF
  41.                 RECORD
  42.                   Pos   : Coord;             (* Position des Autos in "World" *)
  43.                   Color : Window.Color;
  44.                   Speed : CARDINAL;             (* Geschwindigkeit in km/h*10 *)
  45.                   LastD : Direction;
  46.                 END;
  47.   ToNorth   : ARRAY yCoord OF CARDINAL;
  48.   ToSouth   : ARRAY yCoord OF CARDINAL;
  49.   ToEast    : ARRAY xCoord OF CARDINAL;
  50.   ToWest    : ARRAY xCoord OF CARDINAL;
  51.   IsBW      : BOOLEAN;
  52.  
  53. (*W+*)    (* folgende Variablen wegen Prozeßzugriff nicht in Register halten! *)
  54.  
  55. VAR
  56.   AvSpeed   : CARDINAL;                  (* Durchschnittsgeschwindigkeit * 10 *)
  57.   MaxCar    : CarRange;         (* Zahl der gerade im Netz befindlichen Autos *)
  58.  
  59. (*$W=*)                       (* den letzten Zustand von $W wieder herstellen *)
  60.  
  61. (* -------------------------------------------------------------------------- *)
  62.  
  63. PROCEDURE Plot(x : xCoord; y : yCoord);
  64.   (* setzt ein "Landschaftszeichen" entsprechend der Straßenkarte *)
  65. TYPE
  66.   Chars = ARRAY SHORTCARD [0..15] OF SHORTCARD;
  67. CONST
  68.   Road = Chars(176,32,32,201,32,200,186,204,32,205,187,203,188,202,185,206);
  69. VAR
  70.   loc   : Location;
  71.   sc    : SHORTCARD;
  72.   color : Window.Color;
  73. BEGIN
  74.   loc := World[x, y];
  75.   sc := Road[SHORTCARD(loc.Entry+loc.Exit)];
  76.   IF sc=176 THEN
  77.     IF IsBW THEN color := Window.LightGray
  78.             ELSE color := Window.Brown
  79.     END;
  80.   ELSIF sc=32 THEN RETURN
  81.   ELSE color := Window.LightGray;
  82.   END;
  83.   Window.TextColor(color);
  84.   Window.DirectWrite(x+1, y+1, ADR(sc), 1);
  85. END Plot;
  86.  
  87. (* -------------------------------------------------------------------------- *)
  88.  
  89. PROCEDURE PlotCar(v : CarRange; dir : Direction);
  90.   (* setzt ein Auto an die Bildschirmposition (x,y) *)
  91. TYPE
  92.   Chars = ARRAY Direction OF SHORTCARD;
  93. CONST
  94.   CarSym  = Chars(16, 31, 30, 17);
  95. BEGIN
  96.   Window.TextColor(Car[v].Color);
  97.   Window.DirectWrite(Car[v].Pos.x+1, Car[v].Pos.y+1, ADR(CarSym[dir]), 1);
  98. END PlotCar;
  99.  
  100. (* -------------------------------------------------------------------------- *)
  101.  
  102. PROCEDURE NewCar;
  103.   (* läßt ein neues Auto zu und placiert es im Straßennetz *)
  104. VAR
  105.   x : xCoord;
  106.   y : yCoord;
  107.   v : CarRange;
  108.   d : Direction;
  109. BEGIN
  110.   INC(MaxCar);
  111.   v := MaxCar;
  112.   d := MAX(Direction);
  113.   LOOP
  114.     IF d=MAX(Direction) THEN
  115.       REPEAT
  116.         x := Lib.RANDOM(xNum);
  117.         y := Lib.RANDOM(yNum);
  118.       UNTIL NOT World[x,y].Occupied;                 (* keine Doppelbelegung! *)
  119.       d := MIN(Direction);
  120.     ELSE
  121.       INC(d);
  122.     END;
  123.     IF d IN World[x,y].Exit THEN EXIT END;
  124.   END;
  125.   World[x,y].Occupied := TRUE;   (* Position ist jetzt mit einem Auto besetzt *)
  126.   WITH Car[v] DO
  127.     Pos.x := x; Pos.y := y;
  128.     Speed := Lib.RANDOM(100);                    (* zufällige Geschwindigkeit *)
  129.     LastD := Direction(Lib.RANDOM(4));
  130.   END;
  131.   IF IsBW THEN Car[v].Color := Window.White;
  132.           ELSE Car[v].Color := Window.Color(9+Lib.RANDOM(7));
  133.   END;
  134.   PlotCar(v,d);                   (* und das Auto auf den Bildschirm bringen! *)
  135. END NewCar;
  136.  
  137. (* -------------------------------------------------------------------------- *)
  138.  
  139. PROCEDURE ParkCar(v : CarRange);
  140.   (* zieht das Auto Nr.v aus dem Verkehr *)
  141. VAR
  142.   x : xCoord;
  143.   y : yCoord;
  144. BEGIN
  145.   x := Car[v].Pos.x;
  146.   y := Car[v].Pos.y;
  147.   IF MaxCar = 0 THEN HALT END;
  148.   World[x,y].Occupied := FALSE;           (* Position ist nicht mehr besetzt! *)
  149.   Plot(x, y);                  (* das Autosymbol mit Landschaft überschreiben *)
  150.   WHILE v<MaxCar DO
  151.     Car[v] := Car[v+1]; INC(v);        (* die restlichen Autodaten umkopieren *)
  152.   END;
  153.   DEC(MaxCar);
  154. END ParkCar;
  155.  
  156. (* -------------------------------------------------------------------------- *)
  157.  
  158. PROCEDURE MoveCar(v : CarRange);
  159.   (* erhöht die Geschwindigkeit des v-ten Autos; bei Zusammenstößen mit einem
  160.      anderen Auto bzw. in Kurven verringert sie sich jedoch wieder.  Das Auto
  161.      wird je nach Speed und Straßenverlauf an seine neue Position gesetzt.    *)
  162. VAR
  163.   exit      : Direction;
  164.   x,newx    : xCoord;
  165.   y,newy    : yCoord;
  166.   tried     : DirSet;
  167. CONST
  168.   SpeedLimit = 800;
  169. BEGIN
  170.   WITH Car[v] DO
  171.     IF Speed < SpeedLimit THEN
  172.       INC(Speed, Lib.RANDOM(80));                       (* etwas Gas geben... *)
  173.       IF Speed > SpeedLimit THEN        (* ...oder vielleicht Radarkontrolle? *)
  174.         Speed := SpeedLimit                       (* Lieber langsamer fahren! *)
  175.       END;
  176.       IF Speed < Lib.RANDOM(SpeedLimit) THEN
  177.         RETURN
  178.       END;
  179.     END;
  180.     x := Pos.x;
  181.     y := Pos.y;
  182.   END;
  183.   tried := DirSet{};
  184.   LOOP
  185.     exit := Direction(Lib.RANDOM(4));
  186.     IF exit IN World[x,y].Exit THEN
  187.       newx := x;
  188.       newy := y;
  189.       CASE exit OF
  190.       | East  : newx := ToEast[x];
  191.       | South : newy := ToSouth[y];
  192.       | North : newy := ToNorth[y];
  193.       | West  : newx := ToWest[x];
  194.       END;
  195.       IF World[newx,newy].Occupied THEN        (* neuer Platz schon belegt... *)
  196.         Car[v].Speed := Car[v].Speed DIV 4;       (* ...Achtung, Crashhhhh!!! *)
  197.         RETURN;
  198.       ELSE
  199.         World[x,y].Occupied := FALSE;
  200.         Plot(x, y);                    (* alte Position ist wieder Landschaft *)
  201.         World[newx,newy].Occupied := TRUE;
  202.         WITH Car[v] DO
  203.           Pos.x := newx;
  204.           Pos.y := newy;
  205.           IF LastD <> exit THEN                          (* Vorsicht Kurve... *)
  206.             Speed := Speed DIV 2;              (* ...lieber langsamer fahren! *)
  207.             LastD := exit;
  208.           END;
  209.         END;
  210.         PlotCar(v, exit);                  (* Auto an neue Position schreiben *)
  211.         RETURN;
  212.       END;
  213.     END;
  214.     INCL(tried, exit);
  215.     IF tried = DirSet{East..West} THEN
  216.       Car[v].Speed := 0;
  217.       RETURN;
  218.     END;
  219.   END;
  220. END MoveCar;
  221.  
  222. (* -------------------------------------------------------------------------- *)
  223.  
  224. PROCEDURE InitWorld;
  225.   (* generiert das Einbahnstraßennetz und setzt die Autos an ihre Positionen *)
  226.  
  227.     PROCEDURE ok(x :xCoord; y : yCoord) : BOOLEAN;
  228.       (* gibt an, ob die Genehmigung für den Bau
  229.          einer Straße bei (x,y) erteilt wird!    *)
  230.     BEGIN
  231.       RETURN (World[x,y].Exit                   = DirSet{}) OR
  232.              (World[ToEast[x],y].Exit           = DirSet{}) OR
  233.              (World[ToEast[x],ToSouth[y]].Exit  = DirSet{}) OR
  234.              (World[x,ToSouth[y]].Exit          = DirSet{});
  235.     END ok;
  236.  
  237. VAR
  238.   x,newx  : xCoord;
  239.   y,newy  : yCoord;
  240.   n       : CARDINAL;
  241.   newdir,
  242.   newentry: Direction;
  243.   v       : CarRange;
  244. BEGIN
  245.   FOR x := MIN(xCoord) TO MAX(xCoord) DO
  246.     ToEast[x] := (x+1) MOD xNum;
  247.     ToWest[x] := (x+xNum-1) MOD xNum;
  248.   END;
  249.   FOR y := MIN(yCoord) TO MAX(yCoord) DO
  250.     ToSouth[y] := (y+1) MOD yNum;
  251.     ToNorth[y] := (y+yNum-1) MOD yNum;
  252.   END;
  253.   Lib.Fill(ADR(World), SIZE(World), 0);
  254.   x := xNum DIV 2;
  255.   y := yNum DIV 2;
  256.   newx := x;
  257.   newy := y;
  258.   newdir := Direction(Lib.RANDOM(4));
  259.   n := 1000 + Lib.RANDOM(1000);
  260.   WHILE n <> 0 DO     (* Aufbau des Straßennetzes durch zufällige Schrittwahl *)
  261.     DEC(n);
  262.     IF Lib.RANDOM(4)=0 THEN
  263.       newdir := Direction(Lib.RANDOM(4));
  264.     END;
  265.     WHILE newdir IN World[x,y].Entry DO            (* Einbahnstraße erzwingen *)
  266.       newdir := Direction(Lib.RANDOM(4));
  267.     END;
  268.     newx := x; newy := y;
  269.     CASE newdir OF
  270.     | East  : newx := ToEast[x];
  271.     | South : newy := ToSouth[y];
  272.     | North : newy := ToNorth[y];
  273.     | West  : newx := ToWest[x];
  274.     END;
  275.     newentry := Reverse[newdir];
  276.     IF NOT (newentry IN World[newx,newy].Entry) THEN
  277.       INCL(World[newx,newy].Entry, newentry);
  278.       IF (Lib.RANDOM(50)=0) OR
  279.          (ok(newx, newy)                  AND
  280.           ok(ToWest[newx], newy)          AND
  281.           ok(ToWest[newx], ToNorth[newy]) AND
  282.           ok(newx, ToNorth[newy]))
  283.       THEN
  284.         INCL(World[x,y].Exit, newdir);
  285.         Plot(x, y         );
  286.         Plot(newx, newy   );
  287.         Plot(ToEast[x], y );
  288.         Plot(ToWest[x], y );
  289.         Plot(x, ToNorth[y]);
  290.         Plot(x, ToSouth[y]);
  291.         x := newx;
  292.         y := newy;
  293.       ELSE
  294.         EXCL(World[newx,newy].Entry, newentry);
  295.       END;
  296.     ELSE
  297.       x := newx;
  298.       y := newy;
  299.     END;
  300.   END;
  301.   MaxCar := MAX(CARDINAL);
  302.   FOR v := 1 TO CarNum-Lib.RANDOM(50) DO (* ein paar Autos zufällig verteilen *)
  303.     NewCar;
  304.   END;
  305. END InitWorld;
  306.  
  307. (* -------------------------------------------------------------------------- *)
  308.  
  309. PROCEDURE Statistics;
  310.   (* diese Prozedur läuft als Prozeß quasiparallel  (abwechselnd scheibchen-
  311.      weise)  mit der Endloschleife in "RunSimulation"  und zeigt jeweils die
  312.      aktuell gültige Durchschnittsgeschwindigleit aller im Netz befindlichen
  313.      Autos an. Nach jeder 200. Ausgabe wird das Ausgabefenster verschoben.    *)
  314. CONST
  315.   MsgWindowDef = Window.WinDef (5,5, 37,10,             (* das Ausgabefenster *)
  316.                                  Window.Blue,Window.LightGray,
  317.                                  FALSE,TRUE,FALSE,TRUE,
  318.                                  Window.SingleFrame,
  319.                                  Window.Red, Window.LightGray);
  320. VAR
  321.   MsgW      : Window.WinType;
  322.   MsgX,MsgY : CARDINAL;
  323.   WD        : Window.WinDef;
  324.   count     : CARDINAL;
  325.   change    : BOOLEAN;
  326. BEGIN
  327.   WD := MsgWindowDef;   (* Dieser Teil (bis LOOP) wird nur einmal ausgeführt! *)
  328.   IF IsBW THEN
  329.     WD.Foreground := Window.Black;
  330.     WD.FrameBack := Window.LightGray;
  331.     WD.FrameFore := Window.Black;
  332.   END;
  333.   MsgW := Window.Open(WD);
  334.   Window.SetTitle(MsgW,' JPI TopSpeed Modula-2 Demo ',Window.CenterUpperTitle);
  335.   MsgX := 5; MsgY := 5;
  336.   Window.Use(MsgW);                     (* jetzt das Ausgabefenster benutzen! *)
  337.   count := 200;
  338.   LOOP
  339.     Process.Delay(1);
  340.     IO.WrLn;                                                (* Daten ausgeben *)
  341.     IO.WrStr('Cars: ');IO.WrCard(MaxCar+1,1);
  342.     IO.WrStr('  Average Speed: ');IO.WrCard(AvSpeed DIV 10, 1);
  343.     IO.WrChar('.');IO.WrCard(AvSpeed MOD 10, 1);
  344.     IF count=0 THEN
  345.       MsgX := Lib.RANDOM(50);        (* nach jedem 200. Durchlauf wird das... *)
  346.       MsgY := Lib.RANDOM(20);      (* ... Ausgabefenster zufällig verschoben! *)
  347.       count := 200;
  348.     ELSE
  349.       DEC(count);
  350.     END;
  351.     change := TRUE;
  352.     IF    WD.X1+2<MsgX THEN INC(WD.X1,3); INC(WD.X2,3);
  353.     ELSIF WD.X1>MsgX+2 THEN DEC(WD.X1,3); DEC(WD.X2,3);
  354.     ELSIF WD.Y1=MsgY THEN change := FALSE;
  355.     END;
  356.     IF    WD.Y1<MsgY THEN INC(WD.Y1); INC(WD.Y2);
  357.     ELSIF WD.Y1>MsgY THEN DEC(WD.Y1); DEC(WD.Y2);
  358.     END;
  359.     IF change THEN
  360.        Window.Change(MsgW, WD.X1, WD.Y1, WD.X2, WD.Y2);
  361.     END;
  362.   END;
  363. END Statistics;
  364.  
  365. (* -------------------------------------------------------------------------- *)
  366.  
  367. PROCEDURE RunSimulation;
  368.   (* Der Hauptteil des Programms:  alle Autos werden mit zufällig geänderter
  369.      Geschwindigkeit weiterbewegt (Kurve, Unfall?), bei durchschnittlich je-
  370.      dem 5. Aufruf wird die Zahl der Autos um eins erhöht bzw. verringert.    *)
  371. VAR
  372.   v        : CARDINAL;
  373.   i        : CARDINAL;
  374.   SumSpeed : CARDINAL;
  375.   up       : BOOLEAN;
  376.   c        : CHAR;
  377. BEGIN
  378.   up := TRUE;
  379.   LOOP                          (* diese Simulationsschleife läuft solange... *)
  380.     SumSpeed := 0;
  381.     v := MaxCar+1;
  382.     REPEAT                               (* alle vorhandenen Autos bewegen... *)
  383.         DEC(v);                      (* ...und Geschwindigkeiten aufsummieren *)
  384.         MoveCar(v);
  385.         SumSpeed := SumSpeed + Car[v].Speed;
  386.     UNTIL v=0;
  387.     IF IO.KeyPressed() THEN
  388.       c := IO.RdKey();                  (* ...bis eine Taste gedrückt wurde...*)
  389.       EXIT                               (* ...dann ist Ende der Vorstellung! *)
  390.     END;
  391.     AvSpeed := SumSpeed DIV (MaxCar+1);                (* Durchschnitt bilden *)
  392.     IF Lib.RANDOM(5)=0 THEN                     (* Anzahl der Autos verändern *)
  393.       IF MaxCar=1 THEN
  394.         up := TRUE
  395.       ELSIF MaxCar=CarNum-1 THEN
  396.         up := FALSE;
  397.       END;
  398.       IF up THEN
  399.         NewCar                                (* die Blechlawine wird größer! *)
  400.       ELSE
  401.         ParkCar(Lib.RANDOM(MaxCar+1));                 (* TÜV ist abgelaufen! *)
  402.       END;
  403.       Window.TextColor(Window.Black);
  404.     END;
  405.   END;
  406. END RunSimulation;
  407.  
  408. (* -------------------------------------------------------------------------- *)
  409.  
  410. PROCEDURE Intro;
  411.   (* Anzeige des Titelbildschirms, Generierung des Straßennetzes *)
  412. VAR
  413.   DescWin : Window.WinType;
  414.   r       : CARDINAL;
  415. BEGIN
  416.   Window.CursorOff;
  417.   Window.SetProcessLocks(Process.Lock,Process.Unlock);
  418.   DescWin := Window.Open(Window.WinDef(0,11,79,25,Window.LightGray,Window.Black,
  419.                          FALSE,TRUE,FALSE,TRUE,
  420.                          Window.DoubleFrame,Window.Black,Window.LightGray));
  421.  
  422.   Window.SetTitle(DescWin,' JPI TopSpeed Modula-2 : Verkehrssimulation ',Window.CenterUpperTitle);
  423.   IO.WrLn;
  424.   IO.WrStr('  Dieses Programm simuliert den Verkehrsfluß in einem geschlossenen System.');
  425.   IO.WrLn;
  426.   IO.WrStr('  Bis zu 200 Autos bewegen sich zufällig in einem Netz von Einbahnstraßen.');IO.WrLn;
  427.   IO.WrLn;
  428.   IO.WrStr('  Ein Prozeß zeigt die mittlere Geschwindigkeit der sich bewegenden Autos an.');IO.WrLn;
  429.   IO.WrStr('  Bei Geschwindigkeiten von unter 20.0 km/h besteht akute Staugefahr!.');IO.WrLn;
  430.   IO.WrLn;
  431.   IO.WrStr('  Jede Ähnlichkeit mit dem Rush-Hour-Verkehr in New York ist rein zufällig!');IO.WrLn;
  432.   IO.WrLn; IO.WrLn; Window.TextColor(Window.White);
  433.   IO.WrStr('  Start und Abbruch der Simulation durch Drücken einer beliebigen Taste.');IO.WrLn;
  434.   Window.Use(Window.FullScreen);
  435.   Window.SetWrap(FALSE);
  436.   Window.TextBackground(Window.Black);
  437.   IF IsBW THEN
  438.     Window.TextColor(Window.LightGray);
  439.   ELSE
  440.     Window.TextColor(Window.Green);
  441.   END;
  442.   FOR r := 1 TO Window.ScreenDepth DO   (* Bildschirm mit Rastermuster füllen *)
  443.     Window.GotoXY(1,r);
  444.     IO.WrCharRep(CHAR(178),Window.ScreenWidth);
  445.   END;
  446.   Window.TextBackground(Window.Black);
  447.   Lib.RANDOMIZE;                     (* Zufallszahlengenerator initialisieren *)
  448.   InitWorld;                    (* Straßennetz generieren und Autos placieren *)
  449.   WHILE NOT IO.KeyPressed() DO END;               (* auf Starttaste warten... *)
  450.   IF IO.RdKey()=' ' THEN END;                     (* ...und Taste auslesen... *)
  451.   Window.Close(DescWin);                    (* ...und Info-Fenster schließen! *)
  452. END Intro;
  453.  
  454. (* -------------------------------------------------------------------------- *)
  455.  
  456. PROCEDURE CheckBW;
  457.   (* ermittelt, ob der eingestellte Bildschirmmodus farbig oder monochrom ist *)
  458. VAR
  459.   R : SYSTEM.Registers;
  460. BEGIN
  461.   R.AH := 15;                          (* Ermittle aktuellen Bildschirmstatus *)
  462.   Lib.Intr(R,10H);
  463.   IsBW :=    (R.AL = 0)                                      (* Text BW 40x25 *)
  464.           OR (R.AL = 2)                                      (* Text BW 80x25 *)
  465.           OR (R.AL = 4)                                  (* Grafik BW 320x200 *)
  466.           OR (R.AL = 6)                                  (* Grafik BW 640x200 *)
  467.           OR (R.AL = 7);                                 (* Grafik BW 720x350 *)
  468. END CheckBW;
  469.  
  470. (* -------------------------------------------------------------------------- *)
  471.  
  472. BEGIN
  473.   CheckBW;                              (* welcher Bildschirmmodus ist aktiv? *)
  474.   Intro;
  475.   AvSpeed := 500;
  476.   Process.StartScheduler;                     (* Scheduler initialisieren ... *)
  477.   Process.StartProcess(Statistics, 2000H, 1);    (* ...den Prozess starten... *)
  478.   RunSimulation;                                  (* ...und ab geht die Post! *)
  479.   Lib.NoSound;
  480.   Window.GotoXY(1, Window.ScreenDepth);
  481.   Window.CursorOn;
  482. END Traffic.
  483.