Turbo Toolbox/Turbo_Toolbox.iso/1991/09_10/grdlagen/apfel.pas

Pascal/Delphi Source File | 1991-07-19 | 10.6 KB | 337 lines

(* ------------------------------------------------------ *)
(*                     APFEL.PAS                          *)
(*       Demonstrationsprogramm zur Verteilung von        *)
(*     Rechenkapazitäten auf freie Netzwerk-PCs bei       *)
(*      gemeinsamer Festplattenzugriffsmöglichkeit        *)
(*                 Turbo Pascal ab 5.0                    *)
(*          (c) 1991 Sven de Vries & TOOLBOX              *)
(* ------------------------------------------------------ *)
PROGRAM Mandel;

USES Dos, Crt, Graph;

CONST
  DatenPfad  = 'K:\COMUNIC\';        { Pfad für gemeinsame }
      { Kommunikationsdateien aller Rechner, ggf. anpassen }
  Max        = 800;     { maximale Anzahl Punkte pro Zeile }
  PausenZeit = 300;   { Pause zwischen zwei Datenzugriffen }
  lux        = -2;    { x-Koord. links unten Apfelmännchen }
  luy        = -1.25;           { linke unter y-Koordinate }
  lx         = 4;                { X-Ausdehnung des Bildes }
  ly         = 2.5;              { Y-Ausdehnung des Bildes }
  MaxIter    = 100;    { max. Anzahl Iterationen pro Punkt }
  nn         = 'NACHRICH.';     { Name der zu versendenden }
                                                { Arbeiten }
  FarbAnzahl = 10;            { Anzahl verfügbarer Farben, }
                                { muß ggf. geändert werden }
  MasterID   = 'A';                     { Name des Masters }

TYPE
  Arbeit = RECORD
             Feld : ARRAY [0..Max] OF INTEGER;
                         { Zwischenspeicher für eine Zeile }
             MaxX,                         { Spaltenanzahl }
             yy   : INTEGER;                { Zeilennummer }
             x,               { Realkoordinaten des ersten }
             y,                        { Punktes der Zeile }
             dx,       { Veränderung von x und y pro Pixel }
             dy   : REAL ;
             Mode : (Normal, Ende);         { Arbeitsmodus }
           END;

VAR
  OwnID                       : CHAR;
                              { Name des eigenen Prozesses }
  ProzessAnzahl               : INTEGER;
  Anzahl_ausgegebener_Zeilen,
  Naechste_Arbeits_Zeile      : INTEGER;
  SpaltenMax, ZeilenMax       : INTEGER; { Grafikauflösung }
  SchrittZahl                 : INTEGER;
                { Anzahl der Rechenaufträge dieses Sklaven }

PROCEDURE MakeMasterOn;
VAR                { meldet an, daß ein Master im Netz ist }
  F : FILE;
BEGIN
  Assign(F, DatenPfad + 'master.on'); ReWrite(F); Close(F);
END;

PROCEDURE MakeMasterOff;            { meldet den Master ab }
VAR
  F : FILE;
BEGIN
  Assign(F, DatenPfad + 'master.on'); Erase(F);
END;

FUNCTION IsMasterOn : BOOLEAN;
BEGIN                  { testet, ob ein Master im Netz ist }
  IsMasterOn := FSearch(DatenPfad + 'master.on', '') <> '';
END;

PROCEDURE SetID(z : CHAR);
VAR       { setzt den nächsten zu vergebenden Rechnernamen }
  F : FILE OF CHAR;
BEGIN
  WHILE NOT((FSearch(DatenPfad + 'nr.id', '') = '')
  AND (FSearch(DatenPfad + 'readallow.id', '') ='')) DO
    Delay(PausenZeit);
                 { wartet, bis niemand mehr Leserechte hat }
  Assign(F, DatenPfad + 'nr.id');         { erst dann darf }
  ReWrite(F);                         { geschrieben werden }
  Write(F, z);
  Close(F);
  Assign(F, DatenPfad + 'readallow.id');
  ReWrite(F);              { zuletzt allen Leserecht geben }
  Close(F);
END;

FUNCTION GetID : CHAR;   { holt einen eigenen Rechnernamen }
VAR
  i : CHAR;
  F : FILE OF CHAR;
BEGIN
  REPEAT
    WHILE FSearch(DatenPfad + 'readallow.id', '') = '' DO
      Delay(PausenZeit);
    Assign(F, DatenPfad + 'readallow.id');
    {$I-} Erase(F); {$I+}
  UNTIL IOResult = 0;   { wartet auf erfolgreiches Löschen }
  Assign(F, DatenPfad + 'nr.id');
     { nun besitzt dieser Prozeß die exklusiven Leserechte }
  Reset(F); Read(F, i); Close(F); Erase(F);
  GetID := i;
END;

PROCEDURE DelID;  { löscht den nächsten Rechnernamen, kein }
VAR            { weiterer Rechner kann sich noch einloggen }
  i : CHAR;
  F : FILE OF CHAR;
BEGIN
  IF FSearch(DatenPfad + 'readallow.id', '') <> '' THEN
  BEGIN
    Assign(F, DatenPfad + 'readallow.id'); Erase(F);
  END;
  IF FSearch(DatenPfad + 'nr.id', '') <> '' THEN BEGIN
    Assign(F, DatenPfad + 'nr.id'); Erase(F);
  END;
END;

PROCEDURE SendeArbeit(VAR a : Arbeit;
                      FromChar, ToChar : CHAR);
VAR        { sendet eine Arbeit von "FromChar" an "ToChar" }
  F                  : FILE OF Arbeit;
  FileName, FileFlag : STRING;
BEGIN
  FileName := DatenPfad + nn + FromChar;
  FileFlag := FileName + 'F' + ToChar;
  FileName := FileName + 'D' + ToChar;
  WHILE FSearch(FileFlag, '') <> '' DO
    Delay(PausenZeit);    { warte, bis letzte Nachricht an }
                                { "ToChar" abgerufen wurde }
  Assign(F, FileName);                { schreibe Nachricht }
  ReWrite(F); Write(F, a); Close(F);
  Assign(F, FileFlag);                   { erlaube Zugriff }
  ReWrite(F); Close(F);
END;

PROCEDURE LeseArbeit(VAR a : Arbeit;
                     VAR FromChar : CHAR; ToChar : CHAR);
{ liest eine Arbeit von "FromChar" an "ToChar"; dabei
  funktioniert auch "FromChar='?'". Setzt voraus, daß nur
  "ToChar versucht, die Arbeit zu lesen                    }
VAR
  F                            : FILE OF Arbeit;
  Gefunden                     : SearchRec;
  FileName, FileFlag, FromStrg : STRING;
BEGIN
  FileFlag := DatenPfad + nn + FromChar + 'F' + ToChar;
  Gefunden.Name := '';
  FindFirst(FileFlag, AnyFile, Gefunden);
  WHILE DosError <> 0 DO BEGIN    { warte, bis Lesezugriff }
    Delay(PausenZeit);                       { erlaubt ist }
    FindFirst(FileFlag, AnyFile, Gefunden);
  END;
  FileFlag := DatenPfad + Gefunden.Name;
  FromStrg := Copy(Gefunden.Name,
                   Length(Gefunden.Name) - 2, 1);
  FromChar := FromStrg[1];
  FileName := DatenPfad + nn + FromChar + 'D' + ToChar;
  Assign(F, FileName); Reset(F); Read(F, a); Close(F);
  Erase(F); Assign(F, FileFlag);
  Erase(F); { lösche Fileflag als Signal für Absender, daß }
END;               { eine neue Arbeit gesendet werden kann }

PROCEDURE MakeMasterAnmeldung;       { erledigt den Login- }
VAR                { Vorgang für alle untergebenen Rechner }
  z  : CHAR;
  Kb : BOOLEAN;
BEGIN
  z := Succ(MasterID);
  WriteLn('Anmeldung läuft, zum Beenden bitte ');
  WriteLn('eine Taste drücken, nicht jedoch ');
  WriteLn('bevor sich alle gestarteten ');
  WriteLn('Prozesse angemeldet haben.');
  REPEAT
    SetID(z);
    Kb := KeyPressed;
    WHILE NOT Kb AND
     (FSearch(DatenPfad + 'nr.id', '') <> '') DO BEGIN
      Delay(PausenZeit); Kb := KeyPressed;
    END;
    IF NOT Kb THEN BEGIN
      WriteLn ('Rechner ', z, ' eingeloggt');
      Inc(z); Inc(ProzessAnzahl);
    END;
  UNTIL Kb;
  WHILE KeyPressed DO z := (ReadKey);
  WriteLn('Start...');
END;

PROCEDURE InitArbeit(VAR a : Arbeit);
VAR
  i : INTEGER;
BEGIN
  WITH a DO BEGIN;
    FOR i := 1 TO Max DO
      Feld[i] := 0;
    MaxX := SpaltenMax; yy := 0; x := lux; y := 0;
    dx := lx / SpaltenMax; dy := ly / ZeilenMax;
    Mode := Normal;
  END;
END;

PROCEDURE NeueArbeit(VAR StandardA, a : Arbeit);
BEGIN                           { erzeugt eine neue Arbeit }
  a := StandardA;
  WITH a DO BEGIN
    yy := Naechste_Arbeits_Zeile; y := luy + ly - yy * dy;
  END;
  Inc(Naechste_Arbeits_Zeile);
  IF Naechste_Arbeits_Zeile = ZeilenMax THEN
    StandardA.Mode := Ende;      { genug Zeilen produziert }
END;

FUNCTION Iteriere(cr, ci : REAL) : INTEGER;
VAR { führt die Apfelmänncheniteration für einen Punkt aus }
  xr, x, xi : REAL;
  i         : INTEGER;
BEGIN
  xr := 0; xi := 0; i  := 0;
  WHILE (i < MaxIter) AND (xr * xr + xi * xi < 4) DO BEGIN
    x  := xr * xr - xi * xi; xi := xr * xi * 2 + ci;
    xr := x + cr; Inc(i);
  END;
  Iteriere := i;
END;

PROCEDURE MacheArbeit(VAR a : Arbeit);
VAR { führt die Apfelmänncheniterationen für einen Job aus }
  x, y : REAL;
  i    : INTEGER;
  b    : LONGINT;
BEGIN
  y := a.y;
  FOR i := 0 TO a.MaxX DO BEGIN
    x := a.x + i * a.dx;
    a.Feld[i] := Iteriere(x,y) MOD FarbAnzahl;
  END;
END;

PROCEDURE ArbeitAusgeben(a : Arbeit);
VAR  { gibt das Ergebnis eines Jobs auf dem Bildschirm aus }
  i : INTEGER;
BEGIN
  FOR i := 0 TO a.MaxX DO
    PutPixel(i, ZeilenMax - a.yy, a.Feld[i]);
  Inc(Anzahl_ausgegebener_Zeilen);
END;

PROCEDURE SendeErsteArbeiten(StandardA : Arbeit);
VAR       { gibt Arbeitsaufträge für alle anderen Prozesse }
  z : CHAR;
  a : Arbeit;
BEGIN
  FOR z := 'B' TO Chr(Ord(MasterID) + ProzessAnzahl - 1) DO
  BEGIN
    NeueArbeit(StandardA, a); SendeArbeit(a, OwnID, z);
  END;
END;

PROCEDURE InitGrafik;
VAR
  GrDriver, GrMode, ErrCode : INTEGER;
BEGIN
  DetectGraph(GrDriver, GrMode);
  InitGraph(GrDriver, GrMode, GetEnv('BGIPATH'));
  ErrCode := GraphResult;
  IF ErrCode <> 0 THEN BEGIN
    WriteLn('Fehler: ', GraphErrorMsg(ErrCode)); Halt(1);
  END;
END;

PROCEDURE Slave;
VAR        { ruft alle Routinen mit Sklaventätigkeiten auf }
  a  : Arbeit;
  ch : CHAR;
BEGIN
  SchrittZahl := 0; OwnID := GetID;
  WriteLn('Rechenknecht ', OwnID);
  ch := MasterID;
  WriteLn('Warte auf Daten ', SchrittZahl);
  LeseArbeit(a, ch, OwnID);
  WHILE a.Mode <> Ende DO BEGIN
    Inc(SchrittZahl); WriteLn('Daten da, rechne... ');
    MacheArbeit(a);
    SendeArbeit(a, OwnID, MasterID);
    WriteLn('Warte auf Daten ', SchrittZahl);
    LeseArbeit(a, ch, OwnID);
  END;
END;

PROCEDURE Master;
VAR         { ruft alle Routinen mit Mastertätigkeiten auf }
  a, mY, StandardA : Arbeit;
  z                : CHAR;
BEGIN
  ProzessAnzahl := 1;
  MakeMasterOn;
  WriteLn('Master');
  OwnID := MasterID;
  MakeMasterAnmeldung;
  DelID;
  InitGrafik;
  ZeilenMax  := GetMaxY; SpaltenMax := GetMaxX;
  InitArbeit(StandardA);
  IF ProzessAnzahl = 1 THEN
    REPEAT
      a.Mode := Normal;
      NeueArbeit(StandardA, a);
      MacheArbeit(a);
      ArbeitAusgeben(a);
    UNTIL a.Mode = Ende
  ELSE BEGIN
    SendeErsteArbeiten(StandardA);
    a.Mode := Normal;
    REPEAT
      z := '?';
      LeseArbeit(mY, z, OwnID);
      NeueArbeit(StandardA, a);
      SendeArbeit(a, OwnID, z);
      ArbeitAusgeben(mY);
    UNTIL Anzahl_ausgegebener_Zeilen = ZeilenMax;
  END;
  REPEAT UNTIL KeyPressed;
  CloseGraph;
  MakeMasterOff;
END;

BEGIN                                      { Hauptprogramm }
  ClrScr;
  Naechste_Arbeits_Zeile := 0;
  Anzahl_ausgegebener_Zeilen := 0;
  IF IsMasterOn THEN Slave
                ELSE Master;
END.
(* ------------------------------------------------------ *)
(*                 Ende von APFEL.PAS                     *)