home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9303 / monte / brown.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-14  |  9.1 KB  |  324 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      BROWN.PAS                         *)
  3. (*      Simulation der Brownschen Molekularbewegung       *)
  4. (*  Man kann im Hauptprogramm zwischen der stochastischen *)
  5. (*  und der deterministischen Variante wählen -           *)
  6. (*  siehe Prozeduren: stochastisch & deterministisch      *)
  7. (*  Abbruch mit Escape.                                   *)
  8. (*        (c) 1993 Dr.Lothar Wenzel & DMV-Verlag          *)
  9. (* ------------------------------------------------------ *)
  10. PROGRAM Brown;
  11.  
  12. USES
  13.   Graph, Crt;
  14.  
  15. CONST
  16.   X_Richtung    =       200;         (* Grafikkoordinaten *)
  17.   Y_Richtung    =       200;
  18.   X_H_Richtung  =       100;
  19.   X_Position    =        10;
  20.   Y_Position    =        20;
  21.  
  22.   X_Bild        =       639;
  23.   Y_Bild        =       349;
  24.  
  25.   Gesamtzahl    =        70;   (* Gesamtzahl der Moleküle *)
  26.   Loch_Zahl     =         4;   (* # Löcher in der Wand    *)
  27.   Farbe_1       =     White;
  28.   Farbe_2       =    Yellow;
  29.   Farbe_3       =  LightRed;
  30.   Untergrund    =     Black;
  31.  
  32.   Auswahl       =        60;
  33.   Auswahl_2     =        30;
  34.   Tiefe_1       =       180;
  35.   Tiefe_2       =       190;
  36.   Oben          =       196;   (* Fadenkreuz *)
  37.   Unten         =       154;
  38.   Rechts        =       446;
  39.   Links         =       404;
  40.   Radius        =         3;
  41.  
  42.  
  43. TYPE
  44.   Punkte_X    =  ARRAY [1..Gesamtzahl] OF WORD;
  45.   Punkte_Y    =  ARRAY [1..Gesamtzahl] OF WORD;
  46.   Richtung_X  =  ARRAY [1..Gesamtzahl] OF INTEGER;
  47.   Richtung_Y  =  ARRAY [1..Gesamtzahl] OF INTEGER;
  48.  
  49.  
  50. VAR
  51.   Ort_X       : ^Punkte_X;      (* Koordinaten der Punkte *)
  52.   Ort_Y       : ^Punkte_Y;
  53.   Ort_X_Alt   : ^Punkte_X;
  54.   Ort_Y_Alt   : ^Punkte_Y;
  55.   Farben      : ^Punkte_X;
  56.   Faden_X     : INTEGER;      (* Koordinaten äußeres Feld *)
  57.   Faden_Y     : INTEGER;
  58.   Flug_X      : ^Richtung_X;  (* Flugrichtung beim        *)
  59.   Flug_Y      : ^Richtung_Y;  (* deterministischen Modell *)
  60.  
  61.  
  62.   PROCEDURE Graph_Init;
  63.   (* Initialisierung des Grafik-Systems *)
  64.   VAR
  65.     Gd, Gm : INTEGER;
  66.   BEGIN
  67.     Gd := Detect;
  68.     InitGraph(Gd, Gm, 'C:\TP');
  69.     IF GraphResult <> grOk THEN Halt(1);
  70.   END;
  71.  
  72.   PROCEDURE Start;
  73.     (* Aufbau des Startbildschirms *)
  74.   VAR
  75.     Index      : INTEGER;
  76.     Markierung : WORD;
  77.   BEGIN
  78.     Faden_X := 425;
  79.     Faden_Y := 175;
  80.     New(Ort_X);
  81.     New(Ort_Y);
  82.     New(Ort_X_Alt);
  83.     New(Ort_Y_Alt);
  84.     New(Farben);
  85.     New(Flug_X);
  86.     New(Flug_Y);
  87.  
  88.     SetColor(Farbe_3);
  89.     Rectangle(X_Position, Y_Position,
  90.        X_Position+X_Richtung+1, Y_Position+Y_Richtung+1);
  91.     SetColor(White);
  92.     OutTextXY(360, 140, 'Äußeres Kraftfeld');
  93.     Rectangle(400, 150, 450, 200);
  94.     Line(400, 175, 450, 175);
  95.     Line(425, 150, 425, 200);
  96.     Circle(Faden_X,Faden_Y, 3);
  97.     SetColor(LightBlue);
  98.     Rectangle(0, 0, X_Bild, Y_Bild);
  99.     Rectangle(2, 2, X_Bild-2, Y_Bild-2);
  100.     OutTextXY(X_Position, Y_Position-10,
  101.               '  Ablauf der Simaulation');
  102.     FOR Index := 1 TO Gesamtzahl DO BEGIN
  103.       Ort_X^[Index] := 100+Random(10);
  104.       Ort_Y^[Index] := Tiefe_1-160+Random(10);
  105.       IF Ort_X^[Index] < X_H_Richtung THEN
  106.         Markierung := Farbe_1
  107.       ELSE
  108.         Markierung := Farbe_2;
  109.       Markierung := 1+(Index MOD 15);
  110.       PutPixel(1+X_Position+X_Richtung-Ort_X^[Index],
  111.         1+Y_Position+Y_Richtung-Ort_Y^[Index], Markierung);
  112.       Farben^[Index] := Markierung;
  113.       IF Index = 1 THEN
  114.         Flug_X^[Index] := 1
  115.       ELSE
  116.         Flug_X^[Index] := -1;
  117.       IF Index = 1 THEN
  118.         Flug_Y^[Index] := 1
  119.       ELSE
  120.         Flug_Y^[Index] := -1;
  121.     END;
  122.   END;
  123.  
  124.   PROCEDURE Trichter;
  125.     (* Aufbau der zusätzlichen Wände mit Löchern *)
  126.   VAR
  127.     Alt_Farbe : WORD;
  128.     i, j      : INTEGER;
  129.   BEGIN
  130.     Alt_Farbe := GetColor;
  131.     SetColor(Farbe_3);
  132.  
  133.     (* Weitere Schikanen: 
  134.     FOR i := 0 TO 10 DO BEGIN
  135.       FOR j := 1 TO 10 DO BEGIN
  136.         Putpixel(10*I+J+X_POSITION,10*I+Y_POSITION,FARBE_3);
  137.         putpixel(X_RICHTUNG-10*I-J+X_POSITION,10*I+Y_POSITION,FARBE_3);
  138.       end;
  139.     end;
  140.    *)
  141.  
  142.     Rectangle(70,70,130,130);
  143.     SetColor(Black);
  144.  
  145.     { Löcher in den Innenwänden }
  146.     FOR I:=1 TO Loch_Zahl DO
  147.       Rectangle(60+Random(80),80+Random(40),60+Random(80),80+Random(40));
  148.     SetColor(Alt_Farbe);
  149.   END;
  150.  
  151.  
  152.   { Löschen der alten Konstellation }
  153.   PROCEDURE Loeschen;
  154.   VAR
  155.     INDEX : INTEGER;
  156.  
  157.   BEGIN
  158.     FOR INDEX:=1 TO Gesamtzahl DO
  159.     BEGIN
  160.       PutPixel(1+X_Position+X_Richtung-Ort_X_Alt^[INDEX],
  161.         1+Y_Position+Y_Richtung-Ort_Y_Alt^[INDEX],Untergrund);
  162.     END;
  163.   END;
  164.  
  165.   { Auswertung der Tastenbetätigung für äußeres Feld }
  166.   PROCEDURE Tasten_Druck;
  167.   VAR
  168.     Taste1,Taste2  : CHAR;
  169.     Faden_X_Alt    : INTEGER;
  170.     Faden_Y_Alt    : INTEGER;
  171.   BEGIN
  172.     Faden_X_Alt := Faden_X;
  173.     Faden_Y_Alt := Faden_Y;
  174.     Taste1      := ReadKey;
  175.     IF Taste1 = #27 THEN Halt;
  176.     IF Ord(Taste1)=0 THEN Taste2:=ReadKey;
  177.     IF Ord(Taste1)=0 THEN BEGIN
  178.       IF (Ord(Taste2)=80) AND (Faden_Y<Oben) THEN BEGIN
  179.         Faden_Y:=Succ(Faden_Y);
  180.       END;
  181.  
  182.       IF (Ord(Taste2)=72) AND (Faden_Y>Unten) THEN BEGIN
  183.         Faden_Y:=Pred(Faden_Y);
  184.       END;
  185.  
  186.       IF (Ord(Taste2)=75) AND (Faden_X>Links) THEN BEGIN
  187.         Faden_X:=Pred(Faden_X);
  188.       END;
  189.       IF (Ord(Taste2)=77) AND (Faden_X<Rechts) THEN BEGIN
  190.         Faden_X:=Succ(Faden_X);
  191.       END;
  192.  
  193.       SetColor(Black);
  194.       Circle(Faden_X_Alt,Faden_Y_Alt,Radius);
  195.       SetColor(Yellow);
  196.       Circle(Faden_X,Faden_Y,Radius);
  197.       SetColor(White);
  198.       Line(400,175,450,175);
  199.       Line(425,150,425,200);
  200.     END;
  201.   END;
  202.  
  203.  
  204.   { Simulation der stochastischen Molekülwanderung }
  205.   PROCEDURE Stochastisch;
  206.   VAR
  207.     INDEX    : INTEGER;
  208.     Richtung : INTEGER;
  209.     Lambda1  : REAL;
  210.     Lambda2  : REAL;
  211.     Alt_Farbe : WORD;
  212.  
  213.   { Zur Beschleunigung werden gleichzeitig x- und
  214.     y-Richtung bearbeitet -> 8er Nachbarschaft }
  215.   BEGIN
  216.     Ort_X_Alt^ := Ort_X^;
  217.     Ort_Y_Alt^ := Ort_Y^;
  218.     Lambda1    := (Faden_X-425)/Auswahl_2;
  219.     Lambda2    := (Faden_Y-175)/Auswahl_2;
  220.     FOR INDEX := 1 TO Gesamtzahl DO BEGIN
  221.       Richtung := Random(Auswahl)-Auswahl_2;
  222.       IF Richtung >= Auswahl*Lambda1 THEN BEGIN
  223.         IF GetPixel(1+X_Position+X_Richtung-Ort_X^[INDEX]-1,
  224.                     1+Y_Position+Y_Richtung-Ort_Y^[INDEX])
  225.                <>Farbe_3 THEN
  226.           Ort_X^[INDEX] := Succ(Ort_X^[INDEX]);
  227.       END ELSE IF GetPixel(1+X_Position+X_Richtung-Ort_X^[INDEX]+1,
  228.                            1+Y_Position+Y_Richtung-Ort_Y^[INDEX])
  229.                <> Farbe_3 THEN
  230.         Ort_X^[INDEX] := Pred(Ort_X^[INDEX]);
  231.       Richtung := Random(Auswahl)-Auswahl_2;
  232.  
  233.       IF Richtung >= Auswahl*Lambda2 THEN BEGIN
  234.         IF Ort_Y^[INDEX] < Y_Richtung THEN
  235.           IF GetPixel(1+X_Position+X_Richtung-Ort_X^[INDEX],
  236.                       1+Y_Position+Y_Richtung-Ort_Y^[INDEX]-1)
  237.               <> Farbe_3 THEN
  238.             Ort_Y^[INDEX]:=Succ(Ort_Y^[INDEX]);
  239.       END ELSE IF Ort_Y^[INDEX] > 1 THEN
  240.         IF GetPixel(1+X_Position+X_Richtung-Ort_X^[INDEX],
  241.                     1+Y_Position+Y_Richtung-Ort_Y^[INDEX]+1)
  242.               <> Farbe_3 THEN
  243.           Ort_Y^[INDEX]:=Pred(Ort_Y^[INDEX]);
  244.     END;
  245.   END;
  246.  
  247.   { Simulation der deterministischen Molekülwanderung }
  248.   { Kraftfeld hier ohne Bedeutung }
  249.   { Es werden Kollisionen der Moleküle berücksichtigt }
  250.   PROCEDURE Deterministisch;
  251.   VAR
  252.     INDEX    : INTEGER;
  253.     Richtung : INTEGER;
  254.     Lambda1  : REAL;
  255.     Lambda2  : REAL;
  256.     Alt_Farbe : WORD;
  257.   BEGIN
  258.     Ort_X_Alt^ := Ort_X^;
  259.     Ort_Y_Alt^ := Ort_Y^;
  260.     FOR INDEX := 1 TO Gesamtzahl DO BEGIN
  261.       Richtung := Flug_X^[INDEX];
  262.       BEGIN
  263.         IF GetPixel(1+X_Position+X_Richtung-Ort_X_Alt^[INDEX]-Richtung,
  264.                         1+Y_Position+Y_Richtung-Ort_Y_Alt^[INDEX])
  265.                =Black THEN
  266.           Ort_X^[INDEX]:=Ort_X^[INDEX]+Richtung
  267.         ELSE
  268.         BEGIN
  269.           Richtung:=-Richtung;
  270.         END;
  271.       END;
  272.       Flug_X^[INDEX]:=Richtung;
  273.       Richtung:=Flug_Y^[INDEX];
  274.       BEGIN
  275.         IF GetPixel(1+X_Position+X_Richtung-Ort_X^[INDEX],
  276.                         1+Y_Position+Y_Richtung-Ort_Y^[INDEX]-Richtung)
  277.                =Black THEN
  278.           Ort_Y^[INDEX]:=Ort_Y^[INDEX]+Richtung
  279.         ELSE
  280.         BEGIN
  281.           Richtung:=-Richtung;
  282.         END;
  283.       END;
  284.       Flug_Y^[INDEX]:=Richtung;
  285.     END;
  286.   END;
  287.  
  288.   { Nachfolgenden Position einzeichnen }
  289.   PROCEDURE Neu_Position;
  290.   VAR
  291.     INDEX : INTEGER;
  292.   BEGIN
  293.     FOR INDEX:=1 TO Gesamtzahl DO BEGIN
  294.       PutPixel(1+X_Position+X_Richtung-Ort_X^[INDEX],
  295.         1+Y_Position+Y_Richtung-Ort_Y^[INDEX],Farben^[INDEX]);
  296.     END;
  297.   END;
  298.  
  299.   { Steuerung des äußeren Feldes }
  300.   PROCEDURE Feld;
  301.   BEGIN
  302.     Tasten_Druck;
  303.   END;
  304.  
  305. BEGIN
  306.   Graph_Init;
  307.   Trichter;
  308.   Start;
  309.   REPEAT
  310.     IF KeyPressed THEN Feld;
  311.  
  312.     { genau eine der beiden folgenden Prozeduren muß aktiv sein }
  313.     { Sie können auch beides mixen - gibt schöne Bilder! }
  314.     Stochastisch;
  315.     {deterministisch;}
  316.  
  317.     Loeschen;
  318.     Neu_Position;
  319.   UNTIL (1=2);
  320.  
  321. END.
  322. (* ------------------------------------------------------ *)
  323. (*                Ende von BROWN.PAS                      *)
  324.