home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / demos / swarm.mod (.txt) < prev    next >
Oberon Text  |  2012-04-20  |  6KB  |  152 lines
  1. Syntax10.Scn.Fnt
  2. MODULE Swarm;  (* MB 25.1.90 *)
  3.   IMPORT
  4.     Oberon, Display, Viewers, Input, Texts, Display1;
  5.   CONST
  6.     Border = 50;
  7.     BeeVel = 11;
  8.     WaspVel = 12;
  9.     MaxWasps = 10;
  10.     MaxBees = 500;
  11.   TYPE
  12.     Point = RECORD
  13.       x, y: INTEGER
  14.     END;
  15.     Insect = RECORD
  16.       pos: ARRAY 3 OF Point;
  17.       vx, vy: INTEGER
  18.     END;
  19.   VAR
  20.     Wasps: ARRAY MaxWasps OF Insect;
  21.     Bees: ARRAY MaxBees OF Insect;
  22.     seed: LONGINT;
  23.     NrWasps, NrBees, Delay, WaspAcc, BeeAcc: INTEGER;
  24.     firstTime: BOOLEAN;
  25.     F: Display.Frame;
  26.   PROCEDURE random(): INTEGER;
  27.   BEGIN seed := (seed + 773)*13 MOD 99991; RETURN SHORT(seed MOD 32749)
  28.   END random;
  29.   PROCEDURE Rand(x: INTEGER): INTEGER;
  30.   BEGIN RETURN random() MOD x - x DIV 2
  31.   END Rand;
  32.   PROCEDURE Wait(d: LONGINT);
  33.     VAR t, t1: LONGINT;
  34.   BEGIN
  35.     t := Oberon.Time();
  36.     REPEAT t1 := Oberon.Time() UNTIL t+d <= t1 
  37.   END Wait;
  38.   PROCEDURE InitWasp(VAR Wasp: Insect);
  39.   BEGIN
  40.     Wasp.pos[0].x := Border + random() MOD (Display.Width-2*Border);
  41.     Wasp.pos[0].y := Border + random() MOD (Display.Height-2*Border);
  42.     Wasp.pos[1] := Wasp.pos[0];
  43.     Wasp.vx := 0; Wasp.vy := 0
  44.   END InitWasp;
  45.   PROCEDURE InitBee(VAR Bee: Insect);
  46.     VAR j: INTEGER;
  47.   BEGIN
  48.     j := random() MOD Display.Width; Bee.pos[0].x := j; Bee.pos[1].x := j;
  49.     j := random() MOD Display.Height; Bee.pos[0].y := j; Bee.pos[1].y := j;
  50.     Bee.vx := Rand(7); Bee.vy := Rand(7)
  51.   END InitBee;
  52.   PROCEDURE InitSwarm;
  53.     VAR i: INTEGER;
  54.   BEGIN
  55.     seed := Oberon.Time() MOD 231; (*DIM(Wasps, NrWasps); DIM(Bees, NrBees);*)
  56.     NEW(F); F.X := 0; F.Y := 0; F.W := Display.Width; F.H := Display.Height; firstTime := TRUE;
  57.     i := 0; WHILE i < NrWasps DO InitWasp(Wasps[i]); INC(i) END;
  58.     i := 0; WHILE i < NrBees DO InitBee(Bees[i]); INC(i) END
  59.   END InitSwarm;
  60.   PROCEDURE Age(VAR i: Insect);
  61.   BEGIN i.pos[2] := i.pos[1]; i.pos[1] := i.pos[0]
  62.   END Age;
  63.   PROCEDURE BoundSpeed(VAR i: Insect; limit: INTEGER);
  64.   BEGIN
  65.     IF i.vx > limit THEN i.vx := limit ELSIF i.vx < -limit THEN i.vx := -limit END;
  66.     IF i.vy > limit THEN i.vy := limit ELSIF i.vy < -limit THEN i.vy := -limit END
  67.   END BoundSpeed;
  68.   PROCEDURE AccelerateWasp(VAR Wasp: Insect);
  69.   BEGIN
  70.     Wasp.vx := Wasp.vx+Rand(WaspAcc); Wasp.vy := Wasp.vy+Rand(WaspAcc);
  71.     BoundSpeed(Wasp, WaspVel)
  72.   END AccelerateWasp;
  73.   PROCEDURE ReflectWasp(VAR Wasp: Insect);
  74.   BEGIN
  75.     IF (Wasp.pos[0].x < Border) OR (Wasp.pos[0].x > Display.Width-Border-1) THEN
  76.       Wasp.vx := -Wasp.vx; INC(Wasp.pos[0].x, Wasp.vx)
  77.     END;
  78.     IF (Wasp.pos[0].y < Border) OR (Wasp.pos[0].y > Display.Height-Border-1) THEN
  79.       Wasp.vy := -Wasp.vy; INC(Wasp.pos[0].y, Wasp.vy)
  80.     END
  81.   END ReflectWasp;
  82.   PROCEDURE AccelerateBee(VAR Bee: Insect);
  83.     VAR dx, dy, distance, dx1, dy1, distance1, i: INTEGER;
  84.   BEGIN
  85.     i := 0; distance := 10000;
  86.     WHILE i < NrWasps DO
  87.       dx1 := Wasps[i].pos[1].x-Bee.pos[1].x; dy1 := Wasps[i].pos[1].y-Bee.pos[1].y; distance1 := ABS(dx1)+ABS(dy1);
  88.       IF distance1 < distance THEN dx := dx1; dy := dy1; distance := distance1 END;
  89.       INC(i)
  90.     END;
  91.     IF distance = 0 THEN distance := 1 END;
  92.     Bee.vx := Bee.vx + (dx*BeeAcc) DIV distance; Bee.vy := Bee.vy + (dy*BeeAcc) DIV distance;
  93.     BoundSpeed(Bee, BeeVel)
  94.   END AccelerateBee;
  95.   PROCEDURE Move(VAR i: Insect);
  96.   BEGIN i.pos[0].x := i.pos[1].x + i.vx; i.pos[0].y := i.pos[1].y + i.vy
  97.   END Move;
  98.   PROCEDURE Draw(VAR i: Insect);
  99.   BEGIN
  100.     IF ~firstTime THEN Display1.Line(F, Display.white, i.pos[1].x, i.pos[1].y, i.pos[2].x, i.pos[2].y,  Display.invert) END;
  101.     Display1.Line(F, Display.white, i.pos[0].x, i.pos[0].y, i.pos[1].x, i.pos[1].y, Display.invert)
  102.   END Draw;
  103.   PROCEDURE DrawSwarm;
  104.     VAR i: INTEGER;
  105.   BEGIN
  106.     i := 0; 
  107.     WHILE i < NrWasps DO
  108.       Age(Wasps[i]); AccelerateWasp(Wasps[i]); Move(Wasps[i]); ReflectWasp(Wasps[i]); Draw(Wasps[i]); INC(i)
  109.     END;
  110.     i := random() MOD NrBees; Bees[i].vx := Bees[i].vx + Rand(3);  (* change a random bee *)
  111.     i := random() MOD NrBees; Bees[i].vy := Bees[i].vy + Rand(3);
  112.     i := 0;
  113.     WHILE i < NrBees DO
  114.       Age(Bees[i]); AccelerateBee(Bees[i]); Move(Bees[i]); Draw(Bees[i]); INC(i)
  115.     END
  116.   END DrawSwarm;
  117.   PROCEDURE GetPar(VAR S: Texts.Scanner; lbound, ubound, default: INTEGER; VAR val: INTEGER; VAR list: BOOLEAN);
  118.   BEGIN
  119.     IF list THEN
  120.       IF S.class = Texts.Int THEN
  121.         IF S.i < lbound THEN val := lbound ELSIF S.i < ubound THEN val := SHORT(S.i) ELSE val := ubound END
  122.       ELSE
  123.         list := FALSE; val := default
  124.       END;
  125.       Texts.Scan(S)
  126.     ELSE
  127.       val := default
  128.     END
  129.   END GetPar;
  130.   PROCEDURE Start*;
  131.     VAR msg: Viewers.ViewerMsg; S: Texts.Scanner; T: Texts.Text; pos, t, dummy: LONGINT; list: BOOLEAN;
  132.   BEGIN
  133.     Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  134.     IF (S.class = Texts.Char) & (S.c = "^") THEN
  135.       Oberon.GetSelection(T, pos, dummy, t); 
  136.       IF t >= 0 THEN Texts.OpenScanner(S, T, pos); Texts.Scan(S) END
  137.     END;
  138.     list := TRUE; GetPar(S, 1, MaxWasps, 2, NrWasps, list); GetPar(S, 1, MaxBees, 100, NrBees, list); GetPar(S, 2, 20, 5, WaspAcc, list);
  139.     GetPar(S, 1, 19, 3, BeeAcc, list); GetPar(S, 0, 20, 5, Delay, list);
  140.     InitSwarm;
  141.     msg.id := Viewers.suspend; Viewers.Broadcast(msg);
  142.     Display.ReplConst(Display.black, 0, 0, Display.Width, Display.Height, Display.replace);
  143.     WHILE Input.Available() = 0 DO
  144.       DrawSwarm; Wait(Delay); firstTime := FALSE
  145.     END;
  146.     msg.id := Viewers.restore; Viewers.Broadcast(msg)
  147.   END Start;
  148. END Swarm.Start 5 200 5 3 20
  149. (* Parameters: number of wasps, number of bees, wasp acceleration, bee acceleration, delay between steps (Input.Tick's) *)
  150. Swarm.Start 
  151. System.State Swarm
  152.