Turbo Pascal CA code fix

From: Darcy Boese (dboese@spartan.ac.BrockU.CA)
Date: Wed May 05 1993 - 17:28:08 UTC


I took the liberty of rewriting a bit of the TP/BP code for the
ants, so that you don't have to recompile the code every time you
want to pick out a different set of rules.  Of course, the way to
go would be to have it read a user-specified data file instead, or
even a run-time editing/loading/saving option for the rules.

I also fixed a bit of the code so that it initializes the graphics
screen before it randomly places the ants.  This way they don't all
end up starting in the upper-left corner every time.

------- CUT HERE -------
PROGRAM Langtons_Ants;

(*
	Written by John N. Rachlin
	Dept. of Computer Science
	Johns Hopkins University
	May 1, 1993

	Email:  rachlin@cs.jhu.edu
	Phone:  (410) 516-7052


	DESCRIPTION:

	This Program was written in Turbo Pascal, ver. 6.0
	It requires EGA or VGA graphics. (I haven't tested
	it with other graphics modes.)

	This program is based on "Langton's Automoton" and
	demonstrates the complex patterns of one or more
	"ants" moving according to simple user-defined rules.

	A "rule" has four parts:

	1. Current Color :  The color at the ant's current location
	2. New Color     :  The location's new (replacement) color
	3. Turn          :  Specifies how the ant turns.
	4. Step Size	 :  How much the ant moves after turning
			    (Number of pixels)

	LEGAL COLORS:  (These are predefined Turbo Pascal colors)
	-------------
	 BLACK, BLUE, GREEN, CYAN, RED, MAGENTA, BROWN, LIGHTGRAY,
	 DARKGRAY, LIGHTBLUE, LIGHTGREEN, LIGHTCYAN, LIGHTRED,
	 LIGHTMAGENTA, YELLOW, WHITE

	LEGAL TURNS:
	------------
	 LEFT 	 (Counter-Clockwise 90 degrees)
	 RIGHT 	 (Clockwise 90 degrees)
	 REVERSE (180 degree turn)
	 NOTURN  (The ant does not change direction)


	Rules are defined by calls the the procedure: MakeRule (See Below).

	"Langton's Automaton" is defined by the following 2 rules:

	Current     New
	Color       Color       Turn	   Step
	-------	    ------	-----	   ------
	WHITE	    RED	        RIGHT       1
	RED         WHITE       LEFT        1


	An ant moving according to these rules will appear to move
	chaotically for thousands of moves, but will suddenly
	begin to exhibit cyclic behavior.  This program allows
	one to experiment with similar kinds of rules.

	NOTE!  MAKE SURE THE TURBO PASCAL FILE "EGAVGA.BGI"
	IS IN THE CURRENT DIRECTORY.

*)



USES
   graph, crt;

CONST
   NOTURN  = 0;
   RIGHT   = 1;
   REVERSE = 2;
   LEFT    = 3;


TYPE

   ant_type   = RECORD
       x,y : INTEGER;  (* Ant Position *)
       dir : INTEGER;  (* Ant Direction *)
   END;


   rule_type = RECORD
       newcolor : INTEGER;	(* New (replacement) color 	*)
	   turn  : INTEGER;		(* How the ant turns  		*)
       step     : INTEGER;	(* How much the ant jumps	*)
   END;



VAR

   ant        : ARRAY [1..1000] OF ant_type; (* Ants		   *)
   Nant       : INTEGER;		     (* Number of ants     *)
   xmax, ymax : INTEGER;		     (* Screen boarders    *)
   rule       : ARRAY [0..15] of rule_type;  (* One for each color *)


(* --------------------------------------------------------- 	*)
(* MAKERULE: Creates a new rule					*)
(* Inputs:  oldcolor = color at ant's current location		*)
(*	    newcolor = replacement color			*)
(*	    turn     = how the ant turns                       	*)
(*			(LEFT,RIGHT,NOTURN,REVERSE 		*)
(*	    step     = how much the ant jumps after turning     *)

PROCEDURE MakeRule(oldcolor, newcolor, turn, step : INTEGER);
BEGIN
    rule[oldcolor].newcolor := newcolor;
	rule[oldcolor].turn     := turn;
    rule[oldcolor].step     := step;
END;



(* ----------------------------------------------------------- *)
(* SETRULES:  Defines rules by calls to "MakeRule" (See above) *)

PROCEDURE SetRules;
var f: text;
	s: string;
	a,b: integer;
	c: char;
BEGIN

		ClrScr;
		Write('Default set 1/2/3? ');
		repeat
			c := ReadKey;
		until (c>='1') and (c<='3') ;
		WriteLn;
		case c of
			'1': begin
				MakeRule(WHITE,	RED,	RIGHT,	1);
				MakeRule(RED,	WHITE,	LEFT,	1);
				end;
			'2': begin
				MakeRule(WHITE,	RED,	RIGHT,	1);
				MakeRule(RED,	GREEN,	LEFT,	1);
				MakeRule(GREEN,	BLUE,	LEFT,	1);
				MakeRule(BLUE,	WHITE,	RIGHT,	1);
				end;
			'3': begin
				MakeRule(WHITE,	RED,	RIGHT,	1);
				MakeRule(RED,	BLUE,	REVERSE,1);
				MakeRule(BLUE,	WHITE,	NOTURN, 1);
				end;
			end;
END;


(* ------------------------------------------------- *)
PROCEDURE EnterGraphMode;

VAR
    Driver, Mode : INTEGER;
BEGIN
   DetectGraph(Driver, Mode);
   InitGraph(Driver, Mode, '');
   xmax := GetMaxX;
   ymax := GetMaxY;

END (*EnterGraph*);



(*-------------------------------------------------*)
PROCEDURE Initialize;
VAR
    i : INTEGER;

BEGIN
    Write('Number of Ants? [1..1000]: ');
    readln(Nant);

	EnterGraphMode;

    Randomize;
	ant[1].x := xmax DIV 2;
    ant[1].y := ymax DIV 2;
    ant[1].dir := 2;

    FOR i := 2 TO Nant DO
    BEGIN
	ant[i].x := Random(xmax);
	ant[i].y := Random(ymax);
	ant[i].dir := Random(4);
    END;

	SetColor(WHITE);			 (* Create White Background *)
    SetFillStyle(SOLIDFILL,WHITE);
    Rectangle(0,0,xmax-1,ymax-1);
    FloodFill(1,1,WHITE);

END;


(*-------------------------------------------------*)
PROCEDURE MoveAnt;
VAR
    i : INTEGER;
    x,y,color, dir, step : INTEGER;

BEGIN

    FOR i := 1 TO Nant DO
    BEGIN
	x := ant[i].x;		(* Get current parameters *)
	y := ant[i].y;
	dir := ant[i].dir;
	color := getpixel(x,y);
	step := rule[color].step;

	putpixel(x,y,rule[color].newcolor);    (* Change color *)
	dir := (dir + rule[color].turn) MOD 4; (* Change Ant direction *)

	CASE dir OF                  	      (* Change ant position *)
	0 : y := (y + step) MOD ymax;	      (* Assume screen wrap-around *)
	1 : x := (x + step) MOD xmax;
	2 : y := (y - step + ymax) MOD ymax;
	3 : x := (x - step + xmax) MOD xmax;
	END;

	ant[i].x := x;				(* Save ant parameters *)
	ant[i].y := y;
	ant[i].dir := dir;
    END;

END;


(* ========================================================= *)

BEGIN

	SetRules;
	Initialize;

    WHILE (not(KeyPressed)) DO
	MoveAnt;

    RestoreCRTMode;
END.


This archive was generated by hypermail 2.1.7 : Tue Oct 14 2003 - 21:44:13 UTC