T.R | Title | User | Personal Name | Date | Lines |
---|
99.1 | Specification | JUNIPR::DMCLURE | Vaxnote your way to ubiquity | Fri Aug 22 1986 06:05 | 27 |
| I got the idea for this particular program from an assignment I
found in my copy of "Oh! Pascal!" (by Doug Cooper and Michael Clancy,
W.W. Norton & Co. N.Y. & London publisher, page 337). In order to
limit my interpretation of the program, I will enter the problem as
it is written in the book, and then we can discuss any other ground-
rules which need to be disscussed in following replies.
SPECIFICATION:
12-24 The game of *Life* was developed by a matematician named John
Conway. It's intended to provide a model of life, death, and survival
among simple organisms that inhabit an n by m board. The current
population of the board is considered to comprise one generation.
There are only three rules, as follows: 1) every empty cell with three
living neighbors will come to life in the next generation; 2) any
cell with one or zero neighbors will die of loneliness, while any cell
with four or more neighbors will die from overcrowding; 3) any cell
with two or three neighbors will live into the next generation. All
births and deaths occur simultaneously.
Why is *Life* a game? Well, it turns out that although some starting
populations die out quickly, others form interesting patterns that repeat,
grow, or move across the board as they go from generation to generation.
Write a program that plays *Life*. Let the program user specify the
locations of the starting population, as well as the number of generations
that should be shown as output.
|
99.2 | what's a neighbour? | RDGE28::TLINDE | Everything became softly amorphous, as if ... | Fri Aug 22 1986 11:37 | 10 |
| I assume a 'neighbour' is an adjacent living cell in any direction,
so:
A B C
D E F
G H I
cell 'E' has 8 neighbours: A B C D F G H & I.
Is this right?
|
99.3 | Yes, diagonals count as neighbors | ANYWAY::GORDON | Think of it as evolution in action... | Fri Aug 22 1986 12:57 | 1 |
|
|
99.4 | Simple C Life | TLE::MORRIS | | Fri Aug 22 1986 13:36 | 96 |
| /*
* simple (less than 100 lines) C implementation of Conway's life.
*/
#include <stdio.h>
#define XDIM 79
#define YDIM 20
char board[XDIM][YDIM];
int generation, npieces;
#define BOARD(x, y) (((x)>=0 && (x)<XDIM && (y)>=0 && (y)<YDIM) \
? board[x][y] : 0)
main()
{
initialize();
do{
printBoard();
liveAndLetDie();
} while(npieces > 0);
exit(0);
}
initialize()
{
int x, y;
printf("Enter x y pairs, then end-of-file:\n");
while(scanf("%d%d", &x, &y) == 2){
if(x < 0 || x >= XDIM || y < 0 || y >= YDIM)
printf("%d, %d out of bounds.\n", x, y);
else
board[x][y] = 1;
}
}
liveAndLetDie()
{
char temp[XDIM][YDIM];
int x, y;
for(x = 0; x < XDIM; x++){
for(y = 0; y < YDIM; y++){
int n; /* # of neighbors */
n = BOARD(x, y - 1)
+ BOARD(x + 1, y - 1)
+ BOARD(x + 1, y)
+ BOARD(x + 1, y + 1);
n += BOARD(x, y + 1)
+ BOARD(x - 1, y + 1)
+ BOARD(x - 1, y)
+ BOARD(x - 1, y - 1);
if(BOARD(x, y) == 0 && n == 3)
temp[x][y] = 1;
else if(n < 2)
temp[x][y] = 0;
else if(n >= 4)
temp[x][y] = 0;
else
temp[x][y] = BOARD(x, y);
}
}
npieces = 0;
for(x = 0; x < XDIM; x++)
for(y = 0; y < YDIM; y++)
if(board[x][y] = temp[x][y])
npieces++;
generation++;
}
printBoard()
{
int x, y;
printf("Generation %d:\n", generation);
for(y = 0; y < YDIM; y++){
for(x = 0; x < XDIM; x++){
if(board[x][y])
printf("o");
else
printf(" ");
}
printf("\n");
}
printf("\n");
}
|
99.5 | here it is in Pascal | REGENT::MPCOHAN | Michael Cohan MLO3-6/B16 | Fri Aug 22 1986 15:42 | 94 |
| Here is a simple Pascal implementation. It seems to work ok.
Error trapping of input is not exactly robust; when it asks for
integers, you must enter integers. I didn't bother to check for
all possible input.
PROGRAM Life (INPUT,OUTPUT);
CONST
XLim = 40;
YLim = 20;
TYPE
BoardType = ARRAY [0..XLim + 1, 0..YLim + 1] OF INTEGER;
VAR
Howmany, Generation : INTEGER;
Board : BoardType;
PROCEDURE Initialize (VAR Board : BoardType);
VAR
x,y,nx,ny : INTEGER;
BEGIN
FOR x := 0 TO XLim DO
FOR y := 0 TO YLim DO
Board [x,y] := 0;
WRITELN ('To bring a cell to life, type the X and Y coordinates');
WRITELN ('separated by a space, 0 0 to end. Range is 40 x 20.');
REPEAT
WRITE('X Y> ');
READ (nx,ny);
IF ((nx > Xlim) OR (nx < 1) OR (NY > YLim) OR (NY < 1)) THEN BEGIN
IF NOT ((nx = 0) AND (ny = 0)) THEN
WRITELN ('out of range');
END ELSE
IF (nx <> 0) THEN
Board [nx,ny] := 1;
UNTIL (nx = 0) AND (ny = 0);
END;
PROCEDURE PrintBoard (Board : BoardType);
VAR
x,y : INTEGER;
BEGIN
FOR y := 1 TO ylim DO BEGIN
FOR x := 1 TO xlim DO
IF Board [x,y] = 1 THEN
WRITE ('O ')
ELSE
WRITE ('. ');
WRITELN;
END;
WRITELN;
END;
PROCEDURE NewGeneration (VAR NewBoard : BoardType);
VAR
x,y,Total : INTEGER;
OldBoard : BoardType;
BEGIN
OldBoard := NewBoard;
FOR x := 1 TO xlim DO
FOR y := 1 TO ylim DO BEGIN
Total := OldBoard [x-1,y-1] + OldBoard [x,y-1] + OldBoard [x+1,y-1] +
OldBoard [x-1,y] + OldBoard [x+1,y] + OldBoard [x-1,y+1] +
OldBoard [x,y+1] + OldBoard [x+1,y+1];
IF (Total <= 1) OR (Total >= 4) THEN
NewBoard [x,y] := 0
ELSE
IF Total = 3 THEN
NewBoard [x,y] := 1;
END;
END;
BEGIN
WRITELN ('How many generations do you want?');
REPEAT
WRITE ('Generations> ');
READ (HowMany);
IF (HowMany < 1) THEN
WRITELN ('Enter a number greater than 0');
UNTIL (HowMany > 0);
WRITELN;
Initialize (Board);
WRITELN ('Starting configuration');
PrintBoard (Board);
FOR Generation := 1 TO HowMany DO BEGIN
NewGeneration (Board);
WRITELN ('Generation # ',Generation);
PrintBoard (Board);
END;
END.
|
99.6 | Congratulations! | JUNIPR::DMCLURE | Vaxnote your way to ubiquity | Fri Aug 22 1986 16:53 | 16 |
| Congratulations! I have successfully compiled both the C and Pascal
versions listed here and they both work! I must admit, I like the user-
interface for the Pascal version by REGENT::MPCOHAN a little better,
but you gotta hand it to C program by TLE::MORRIS who was able to get
the first working version entered!
Ok all of you other hackers, where's your code? We won't hold the
official programming language comparison disscussion until all entries
are in. Take your time, and don't be afraid to use GKS graphics, system
calls, or any other generic sorts of tools you would normally use in a
DEC programming project.
By the way, I'm glad I chose the *Life* programming example, it's
really alot of fun to run it! Keep that code rolling in!
-davo
|
99.7 | Not Quite | CIM::JONAN | Hey, it's all line noise to me... | Fri Aug 22 1986 17:06 | 26 |
| Re: .4 and .5
> #define XDIM 79
> #define YDIM 20
> char board[XDIM, YDIM]
> XLim = 40;
> YLim = 20;
> BoardType = ARRAY[0..XLim + 1, 0..YLim + 1] OF Integer;
Neither of these implement a reasonable simulation of LIFE. The
rules state that the "action" takes place on an *unbounded* 2-D
grid. Without a good model of this, all kinds of distortions arise
when cells "fall off the edge of the world". A good (best?) approach
to this is to use a hash table with chaining collision resolution and
model the grid as an Integer X Integer array, i.e. it will appear
as though you have a TYPE boardtype = ARRAY[Integer,Integer] OF
cell_type. I wrote a "real fancy" implementation for life in Pascal
using this approach. (Also, you should keep dynamic lists of living
and dieing cells, so that updates do NOT depend on "full board sweeps"!!
Such "sweeping" techniques are W*A*Y*T*O*O*S*L*O*W for even small
simulations.)
Just Stirring Up The Pot...
/Jon
|
99.8 | not unbounded... | REGENT::MPCOHAN | Michael Cohan MLO3-6/B16 | Fri Aug 22 1986 17:33 | 11 |
| The rules don't state that the action takes place on an unbounded
2-D grid. They state (here at least) that the grid is N by M.
Besides, how do you display an unbounded grid on the terminal?
Only show bits and pieces where cells are alive? I don't think
it would look good.
Nonetheless, you are quite correct that the full board sweep is
inefficient. I was trying to make the program as short as possible,
basically. (wrote it in < 10 minutes). Well, I shall make a few
minor modifications...
|
99.9 | It can be done! | SQM::CURLEY | | Fri Aug 22 1986 17:42 | 17 |
|
Re. .7
Just want to let you know that it can be done. Two semesters ago
I did this exact thing for a project for one of my CS courses in
school. Not only did I use a hash table for the unbounded board
and dynamic lists for the living and dying cells, but also implemented
it with color graphics so that the different generations were each
a different color or combination of colors. The language was C
using a Vax/Unix operating system. It was fun to write but even
better to watch! If I remember correctly though, I also used another
rule that gave each cell a maximum number of generations to live
and from time to time would insert a parasite into the colony that
would kill off or infect other cells. This parasite had its own
set of rules it followed. Have fun everyone!
tmc
|
99.10 | The programs pass the test. | JUNIPR::DMCLURE | Vaxnote your way to ubiquity | Fri Aug 22 1986 18:05 | 25 |
| re: .7,
> Neither of these implement a reasonable simulation of LIFE. The
> rules state that the "action" takes place on an *unbounded* 2-D
> grid.
But Jon, the point here is not to "implement a reasonable simulation
of LIFE", but to compare the features and benefits of all the possible
progamming languages available to John Q. Progammer here at DEC.
If you re-read the specification I gave (from the book) in .1, you
will find no mention of an *un-bounded* 2-D grid (while I agree that this
would definately be an interesting twist and would like to see your version
of that implementation as well), all the spec states is that the "organisms
inhabit an n by m board", and that the user gets to specify two things:
1) locations of the starting populations, and 2) Number of generations.
While this spec is somewhat simple, I didn't want to blow everybody
out of the water on the first shot at this whole experiment. As it is,
there are only two entries so far, but I have hit almost every single
DEC programming language notesfile (I hope - I couldn't find one for MACRO)
with this spec and am confident that more entries will appear in due time
since the spec is hopefully simple enough to implement in any language.
-davo
|
99.11 | | CSSE32::PHILPOTT | CSSE/Lang. & Tools, ZK02-1/N71 | Fri Aug 22 1986 19:11 | 4 |
| The old Digital Press book "101 Basic Games" had a version in
BASIC-PLUS.
/. Ian .\
|
99.12 | Another twist | JON::MORONEY | Madman | Fri Aug 22 1986 22:32 | 10 |
| I wrote a version in Fortran 77 about 4 years ago which could properly
track a population moving in one direction by seeing if any of the edge
cells were occupied, and then shifting the whole grid. Will look to see if
I can find it.
Another varient which might provide some really interesting patterns, and is a
little bit more of a programming challange: Same rules, except done on a
HEXAGONAL grid. Has anyone done this?
-Mike
|
99.13 | | CLT::GILBERT | eager like a child | Sat Aug 23 1986 01:33 | 14 |
| While it lasts, grab CLT::SYS$PUBLIC:LIFE.EXE. Set your terminal
to a VT100, and run it.
For the starting position, it reads a file (LOGIN.COM is usually fine).
It also prompts for a 'delta' -- number of generations between screen
updates -- I suggest 1, 2, 3 or 6. It stops when the screen becomes
fairly uninteresting.
It was written back in '81 in Macro-32. The advantage of this language
over C and Pascal (or so it seems) is that Macro-32 allows comments to
be included in the source.
It was written as a demo for a minimal screen updating package called
ANIMOD that's available in the Toolshed (aka STC).
|
99.14 | | PSW::WINALSKI | Paul S. Winalski | Sat Aug 23 1986 16:13 | 3 |
| Does anybody have Dick Hustvedt's APL one-line version of LIFE?
--PSW
|
99.15 | | SMOP::GLOSSOP | Kent Glossop | Sat Aug 23 1986 21:44 | 80 |
| Here's a straightforward PL/I implementation not using perverse PL/I
features for compactness or speed. RE: .? - comments are left as an
excercise for the reader... :-)
Kent
%Replace True by '1'b;
%Replace False by '0'b;
Life: Procedure Options(Main);
Declare
(Rows, Columns, Desired_Generations) Fixed Binary,
(Row, Col, Generation) Fixed Binary,
(I, J, Number_Alive) Fixed Binary,
Eof_SysIn Bit Aligned Initial(False),
(Old_Base, Current_Base) Pointer,
(Old_Board Based(Old_Base), Current_Board Based(Current_Base))
(0:Rows+1, 0:Columns+1) Fixed Binary(7),
Function(0:1, 0:8) Fixed Binary(7) Static ReadOnly
Initial( 0, 0, 0, 1, 0, 0, 0, 0, 0,
0, 0, 1, 1, 0, 0, 0, 0, 0 ),
Display_String(0:1) Character(10) Varying Static ReadOnly
Initial('.', 'O');
On EndFile(SysIn) Stop;
Get List(Rows, Columns) Options(Prompt('Enter Rows, Columns: '));
Get Skip List(Desired_Generations)
Options(Prompt('Enter Generations: '));
Allocate Old_Board;
Allocate Current_Board;
Old_Board = 0;
Current_Board = 0;
On EndFile(SysIn) Eof_SysIn = True;
Get Skip List(Row,Col)
Options(Prompt('Row, Col to toggle [0,0 or EOF to stop]: '));
Do While((Row ^= 0 | Col ^= 0) & ^Eof_SysIn);
If (1 <= Row & Row <= Rows) & (1 <= Col & Col <= Columns)
Then
Current_Board(Row,Col) = 1 - Current_Board(Row,Col);
Else
Put Skip Edit('The specified subscripts were out of bounds, ' ||
'please try again.')(A);
Get Skip List(Row,Col)
Options(Prompt('Row, Col to toggle [0,0 or EOF to stop]: '));
End /* While */;
Put Edit('Starting configuration',
( ( Display_String(Current_Board(I,J))
Do J = 1 To Columns) Do I = 1 To Rows) )
(Skip(2), A, (Rows)(Skip,X(4),(Columns)A));
Do Generation = 1 To Desired_Generations Until(Number_Alive = 0);
Old_Board = Current_Board;
Number_Alive = 0;
Do Row = 1 To Rows;
Do Col = 1 To Columns;
Current_Board(Row,Col) = Function(
Old_Board( Row, Col ),
Old_Board( Row-1, Col-1 ) + Old_Board( Row-1, Col ) + Old_Board( Row-1, Col+1 ) +
Old_Board( Row, Col-1 ) + Old_Board( Row, Col+1 ) +
Old_Board( Row+1, Col-1 ) + Old_Board( Row+1, Col ) + Old_Board( Row+1, Col+1 ) );
Number_Alive = Number_Alive + Current_Board(Row,Col);
End /* Do */;
End /* Do */;
Put Edit('Generation ' || Trim(Char(Generation)),
( ( Display_String(Current_Board(I,J))
Do J = 1 To Columns) Do I = 1 To Rows) )
(Skip(2), A, (Rows)(Skip,X(4),(Columns)A));
End /* Do */;
End Life;
|
99.16 | A different way of going through life... | BACH::VANROGGEN | | Sun Aug 24 1986 15:10 | 108 |
| ;;; The Game of Life
;;; Walter van Roggen, 23 August 1986
;;; Uses an unusual cell representation and ``parallel'' method of calculating
;;; the number of neighbors for each cell (traditional algorithms are
;;; both boring and inefficient).
;;; Automatically resizes the grid as the colony gets bigger or smaller.
;;; The whole grid is represented by a list of rows.
;;; Each row of the grid is represented by an integer.
;;; Each cell of a row is represented by the value of four bits in
;;; the integer when treated as a binary number. A one represents
;;; a "live" cell; a zero an empty one.
;;; We use four bits per cell so we can do row-wise arithmetic
;;; without getting any overflow between cells.
;;; For each cell, add up the contributions from the adjacent rows along
;;; with the amounts from the cell's row.
(defun calculate-neighbors (rows)
(let* (;; for each cell, add up the contribution from each side
(side-contributions
(mapcar #'(lambda (n) (+ (ash n 4) (ash n -4))) rows))
;; for each cell, add the current value of the cell to the
;; contribution from each side
(row-contributions
(mapcar #'(lambda (n m) (+ n m)) rows side-contributions)))
`(,(cadr row-contributions) ; only affected by second row
,.(mapcar #'(lambda (prev curr next) (+ prev curr next))
row-contributions ; previous row
(cdr side-contributions) ; current row
(cddr row-contributions)) ; next row
;; and the last row is only affected by the next to last row
,(elt row-contributions (- (length row-contributions) 2)))))
;;; At each cell determine the value for the next generation based on
;;; the number of neighbors for that cell. This is currently the most
;;; inefficient part of the algorithm, due to the repeated bignum arithmetic.
(defun next-generation (current-generation)
(mapcar #'(lambda (r n)
(let ((next-row 0))
(dotimes (i (ceiling (integer-length n) 4))
(setq next-row ; could be more efficient, say 16 bits at once
(dpb (case (ldb (byte 4 (* i 4)) n)
(2 (if (zerop (ldb (byte 4 (* i 4)) r)) 0 1))
(3 1)
(t 0))
(byte 4 (* i 4))
next-row))) ; ought to treat number as an array(!?)
next-row))
current-generation (calculate-neighbors current-generation)))
;;; Take off the first elements of the list which are EQL to the item.
(defun trim-start (list item)
(loop (if (eql item (car list))
(pop list)
(return list))))
;;; Make sure the grid is reasonably close to minimal, but grow it as needed
(defun normalize-grid (rows)
(let ((norm rows))
;; trim off all but one row of zeroes at the top and bottom.
(setq norm (cons 0 (trim-start (nreverse norm) 0)))
(setq norm (cons 0 (trim-start (nreverse norm) 0)))
;; if there extra columns available, cut them back one at a time.
(if (every #'(lambda (r)
(and (zerop (ldb (byte 4 0) r))
(zerop (ldb (byte 4 4) r))))
norm)
(setq norm (mapcar #'(lambda (r) (ash r -4)) norm)))
;; integers are only one-way infinite. If there are any live cells
;; at the fixed side, shift everything over.
(if (some #'(lambda (r) (not (zerop (ldb (byte 4 0) r)))) norm)
(setq norm (mapcar #'(lambda (r) (ash r 4)) norm)))
(values norm (not (equal norm rows)))))
(defparameter clear (coerce '(#\esc #\[ #\2 #\J) 'simple-string))
(defparameter home (coerce '(#\esc #\[ #\H) 'simple-string))
(defvar maxcol 80)
(defvar maxrow 23)
(defun display-generation (new gen prompt moved)
(format t "~&~A~AGeneration ~D~%" home (if moved clear "") gen)
(dolist (n (subseq new 1 (min maxrow (- (length new) 1))))
(dotimes (i (min maxcol (ceiling (integer-length n) 4)))
(if (zerop (ldb (byte 4 (* (1+ i) 4)) n))
(princ #\space)
(princ #\O)))
(terpri))
(if prompt (read-line)) ;wait for a #\newline
new)
(defun life (rows &optional (prompt nil) (max most-positive-fixnum)
&aux moved (*gc-verbose* nil))
(princ clear)
(dotimes (i max)
(multiple-value-setq (rows moved) (normalize-grid rows))
(let ((new (next-generation (display-generation rows i prompt moved))))
(if (equal new rows) (return)) ;see if any changes occurred
(setq rows new)))
(values))
(defun collision () ;example of a glider hitting a star
(life '(#x00000010 ;these numbers are actually left-right reversed
#x00000100 ;note that 4 bits per cell makes hex numbers convenient
#x00000111
#x00000000
#x00000000
#x00000000
#x11111000)))
|
99.17 | Here's a DESIGN version (what the ?$#% is DESIGN?) | JUNIPR::DMCLURE | Vaxnote your way to ubiquity | Sun Aug 24 1986 18:30 | 158 |
|
Well, I wasn't going to participate here (since I'm the one requesting
all of this stuff), but it seemed like so much fun that I couldn't resist.
This is the DESIGN code module (and associated package description file)
which runs under anything beyond version 1.5 of VAX Producer.
While I don't expect too many people to try to compile this (and as
a result, didn't bother to test it...Ha Ha! - Just kidding, it works), I
should point out that you'll need to have Producer installed along with
compatibility mode (neither of which I have on JUNIPR - I had to log back
into my old CSTVAX account back at my old job to do this).
This is a somewhat "boring and innefficient" version of code here. I
thought about doing something with dynamic string representation of rows
to allow for an "unlimited" board, but DESIGN is slow enough without fid-
dling with strings. Binary representation also came to mind, but I decided
instead to try and show the similarities of DESIGN and Pascal by modeling
this after the Pascal version entered earlier.
If you look closely, there are some major shortcomings in DESIGN which
prevented an easy translation: 1) There's no way to read an integer as input
- all input must be read in as string and converted (Thus, the Get_Coords
unit). 2) Array bounds begin at 1 in design, forcing me to add an extra
two unnused elements to both the X and Y axis to avoid array-out-of-bounds
errors during the Total summation in the New_Generation unit. 3) As I said,
DESIGN (being an interpreted language) is slooooow, and as a result, I had
to limit my board to 20 by 10 (22 by 12) in order to run at half a clip.
For anyone familiar with VAX Producer, they will recognize the follow-
ing package description. This is similar to an "Environment File" in
Pascal, whereby global definitions of all variables and units for a given
module are placed. This would normally exist as a separate file by the
same prefix name as it's associated design code module file. In this case,
the following file: "Life.Dpk" (.Dpk stands for Design PacKage).
Have fun trying to find a PRODUCER compiler,
-davo
(Dave McLure)
PACKAGE Life
CONSTANT INTEGER X_Lim:= 22
CONSTANT INTEGER Y_Lim:= 12
DEFINE BOOLEAN Input_Status
DEFINE STRING Answer
UNIT Get_Coords (X_Coord INTEGER,
Y_Coord INTEGER,
Coords STRING)
UNIT Initialize_Board (Board[X_Lim,Y_Lim] INTEGER)
UNIT Print_Board (Board[X_Lim,Y_Lim] INTEGER,
Generation INTEGER)
UNIT New_Generation (Board[X_Lim,Y_Lim] INTEGER)
UNIT Main
END_PACKAGE Life
This is the actual design code module for the Producer version of Life.
Fooled you, huh, I'll bet you thought the whole program was only as long as
the preceeding package description! - ah the wonders of the formfeed!
MODULE Life
UNIT Get_Coords (X_Coord INTEGER,
Y_Coord INTEGER,
Coords STRING)
DEFINE INTEGER Comma_Pos
Input_Status:= TRUE
Comma_Pos:= FIND(Coords,",")
IF (Comma_Pos > 0) THEN
X_Coord:= INTEGER(SUBSTRING(Coords,1,Comma_Pos-1))+1
Y_Coord:= INTEGER(SUBSTRING(Coords,Comma_Pos+1,
(LENGTH(Coords)-Comma_Pos+1)))+1
END_IF
END_UNIT Get_Coords
UNIT Initialize_Board (Board[X_Lim,Y_Lim] INTEGER)
DEFINE INTEGER X,Y
FOR X FROM 1 TO X_Lim LOOP
FOR Y FROM 1 TO Y_Lim LOOP
Board[X,Y]:= 0
END_LOOP
END_LOOP
OUTPUTL "*Life* is played on an grid of 20 columns (X) by 10 rows (Y)"
OUTPUTL "Enter all live coordinates separated with a comma X,Y to begin"
LOOP
OUTPUT "Enter X,Y (0,0 when done)> "
INPUT LINE TO Answer
DO Get_Coords (X,Y,Answer)
IF ((X>=X_Lim) OR (X<=1) OR (Y>=Y_Lim) OR (Y<=1)) THEN
IF (NOT((X=1) AND (Y=1))) THEN
OUTPUTL "Coordinates out of range! Please try again..."
END_IF
ELSE
Board[X,Y]:= 1
END_IF
END_LOOP UNTIL (((X=1) AND (Y=1)) OR (NOT(Input_Status)))
END_UNIT Initialize_Board
UNIT Print_Board (Board[X_Lim,Y_Lim] INTEGER,
Generation INTEGER)
DEFINE INTEGER X,Y
OUTPUTL "Generation #",STRING(Generation)
OUTPUTL "--------+--------+"
FOR Y FROM 2 TO Y_Lim-1 LOOP
FOR X FROM 2 TO X_Lim-1 LOOP
IF (Board[X,Y] = 1) THEN
OUTPUT "#"
ELSE
OUTPUT " "
END_IF
END_LOOP
OUTPUTL " "
END_LOOP
OUTPUTL "--------+--------+"
END_UNIT Print_Board
UNIT New_Generation (Board[X_Lim,Y_Lim] INTEGER)
DEFINE INTEGER Old_Board[X_Lim,Y_Lim],Total,X,Y
FOR X FROM 2 TO X_Lim-1 LOOP
FOR Y FROM 2 TO Y_Lim-1 LOOP
Old_Board[X,Y]:= Board[X,Y]
END_LOOP
END_LOOP
FOR X FROM 2 TO X_Lim-1 LOOP
FOR Y FROM 2 TO Y_Lim-1 LOOP
Total:= Old_Board[X-1,Y-1] + Old_Board[X,Y-1] + Old_Board[X+1,Y-1] +
Old_Board[X-1,Y] + Old_Board[X+1,Y] + Old_Board[X-1,Y+1] +
Old_Board[X,Y+1] + Old_Board[X+1,Y+1]
!OUTPUTL "Total of coords[",STRING(X),",",STRING(Y),"]= ",STRING(Total)
IF ((Total <= 1) OR (Total >= 4)) THEN
Board[X,Y]:= 0
ELSE
IF (Total = 3) THEN
Board[X,Y]:= 1
END_IF
END_IF
END_LOOP
END_LOOP
END_UNIT New_Generation
START UNIT Main
DEFINE INTEGER Board[X_Lim,Y_Lim],Life_Cycle,Generations
ON INPUT_CONVERSION_ERROR() THEN
Input_Status:= FALSE
RESUME CONTINUE
END_ON
OUTPUTL "Welcome to the game *Life* by the mathematician John Conway"
LOOP
OUTPUT "Enter a number greater than 0 for the total generations of life> "
Input_Status:= TRUE
INPUT LINE TO Answer
Generations:= INTEGER(Answer)
END_LOOP UNTIL ((Generations > 0) AND (Input_Status))
DO Initialize_Board (Board)
DO Print_Board (Board,0)
FOR Life_Cycle FROM 1 TO Generations LOOP
DO New_Generation (Board)
DO Print_Board (Board,Life_Cycle)
END_LOOP
END_UNIT Main
END_MODULE Life
|
99.18 | Here's a quick KOALA version | KOALA::ROBINS | Scott A. Robins, ZKO2-2/R94 | Mon Aug 25 1986 16:04 | 238 |
|
This one assumes a VT100, and constrains the grid size.
Program LIFE
Version "V1.000"
is
!++++
!
! Here is the original specification:
!
! <<< TLE::PUBD$:[VAXNOTES]LANGUAGES.NOTE;1 >>>
!================================================================================
!Note 99.1 Battle of the Languages 1 of 4
!JUNIPR::DMCLURE "Vaxnote your way to ubiquity" 27 lines 22-AUG-1986 02:05
! -< Specification >-
!--------------------------------------------------------------------------------
!
! I got the idea for this particular program from an assignment I
! found in my copy of "Oh! Pascal!" (by Doug Cooper and Michael Clancy,
! W.W. Norton & Co. N.Y. & London publisher, page 337). In order to
! limit my interpretation of the program, I will enter the problem as
! it is written in the book, and then we can discuss any other ground-
! rules which need to be disscussed in following replies.
!
!SPECIFICATION:
!
!12-24 The game of *Life* was developed by a matematician named John
! Conway. It's intended to provide a model of life, death, and survival
! among simple organisms that inhabit an n by m board. The current
! population of the board is considered to comprise one generation.
! There are only three rules, as follows: 1) every empty cell with three
! living neighbors will come to life in the next generation; 2) any
! cell with one or zero neighbors will die of loneliness, while any cell
! with four or more neighbors will die from overcrowding; 3) any cell
! with two or three neighbors will live into the next generation. All
! births and deaths occur simultaneously.
!
! Why is *Life* a game? Well, it turns out that although some starting
! populations die out quickly, others form interesting patterns that repeat,
! grow, or move across the board as they go from generation to generation.
! Write a program that plays *Life*. Let the program user specify the
! locations of the starting population, as well as the number of generations
! that should be shown as output.
!----
Constant
max_board_cols
: integer
:= 80 ;
max_board_lines
: integer
:= 23 ;
max_generations
: integer
:= 100 ;
Type
board_type IS array(max_board_lines,max_board_cols) of boolean ;
Variable
board
: board_type ;
foo,
begin_time,
end_time
: string ;
current_board_lines, ! Number of lines we are using
current_board_cols, ! Number of columns
number_of_generations ! How many times
: integer ;
Function number_of_neighbors ( i : integer, j : integer, b : board_type )
return integer
is
Variable
result
: integer ;
begin
!+
! We want to look at up to 8 different cells:
! (I-1,J), (I-1,J-1), (I-1,J+1),
! (I+1,J), (I+1,J-1), (I+1,J+1),
! (I,J+1),
! (I,J-1)
!
! Of course, we don't want to look at any cell that is 'off' the board.
!-
result := 0 ;
for ii in (i-1)..(i+1)
loop
for jj in (j-1)..(j+1)
loop
if (jj=j) and (ii=i)
then ! Ignore the cell which we are examining for # of neighbors.
else
if (ii>max_board_lines) OR (jj>max_board_cols) OR
(ii<1) OR (jj<1)
then ! Ignore cells not on the board.
else
if b(ii,jj)
then result := result + 1 ;
end if ;
end if ;
end if ;
end loop ;
end loop ;
return result ;
end number_of_neighbors ;
Function should_die( i : integer, j : integer, b : board_type )
return BOOLEAN
is
Variable
n : INTEGER ;
begin
!+
! 2) any cell with one or zero neighbors will die of loneliness,
! while any cell with four or more neighbors will die from overcrowding;
!-
if (NOT b(i,j))
then return FALSE ; ! Can't die if you're not alive.
end if ;
N := number_of_neighbors(i,j,b) ;
if (n<=1) OR (N>=4)
then return TRUE ;
else return FALSE ;
end if ;
end should_die ;
Function should_come_to_life( i : integer, j : integer, b : board_type )
return BOOLEAN
is
Variable
n : integer ;
Begin
!+
! 1) every empty cell with three living neighbors will come to life in
! the next generation;
!-
if B(i,j)
then return false ; ! Can't come to life if you're already alive.
end if ;
n := number_of_neighbors(i,j,b) ;
if (n=3) ! Should this be >=?
then return TRUE ;
else return FALSE ;
end if ;
End should_come_to_life ;
Statement generation b : in out board_type
is
begin
For i in 1..current_board_lines
loop
for j in 1..current_board_cols
loop
if should_die(i,j,b)
then b(i,j) := FALSE ;
else
if should_come_to_life(i,j,b)
then b(i,j) := TRUE ;
end if ;
end if ;
end loop ;
end loop ;
end generation ;
Statement display_generation b : board_type
is
begin
erase_screen ;
for i in 1..current_board_lines
loop
for j in 1..current_board_cols
loop
if b(i,j)
then position_to j,i ; write "X" ;
end if ;
position_to j,i ;
end loop ;
end loop ;
FORCE_SCREEN_UPDATE ;
end display_generation ;
Statement initialize_board b : in out board_type
is
begin
for i in 1..current_board_lines
loop
b(i,50) := TRUE ;
b(i,51) := TRUE ;
b(i,52) := TRUE ;
end loop ;
end initialize_board ;
begin
begin_time := NOW ;
current_board_cols := max_board_cols ;
current_board_lines:= max_board_lines;
POSITION_TO 1,24 ;
input number_of_generations prompt "Number of generations? " ;
initialize_board board ;
for g in 1..number_of_generations
loop
POSITION_TO 1,24 ;
! input foo prompt "Press RETURN to see generation " & string g ;
! sleep "1" ;
display_generation board ;
generation board ;
end loop ;
end_time := now ;
POSITION_TO 1,24 ;
write_line INTERVAL(begin_time,end_time) ;
end ;
|
99.19 | Winner? | CIM::JONAN | Hey, it's all line noise to me... | Mon Aug 25 1986 16:33 | 29 |
| Re: -.* (Unboundedness stuff)
J.H. Conway (the mathematician who "created" LIFE) states that the
grid *IS* unbounded.
It is not messy looking to allow this a previous note suggested;
in fact, since you eliminate distortion, it's just the opposite.
To really make use of this, you need to allow the user to "pan"
around in the LIFE world and to "zoom" in and out tooo.
Re: .16
Clearly, this solution has the required unboundedness! I must confess
that when I brought this point up, I was thinking that a LISP solution
would take the prize, as the problem lends itself so well to "list
processing"! I am not a real LISPer yet, but from what I can see
from .16, asside from the novel grid representation, the techniques
used are about the same as those that I used. The difference really
hits home when you realize the difference in code amounts. Though
my Pascal version does all sorts of support things (save and restore
simulations to file, pan and zoom the LIFE grid, twiddle simulation
time parameters, print any given stage of the simulation, "graphical"
input, and a few others) the size is much greater. The actual code
associated with the LIFE simulation is probably in the order of
300 lines or a good 3 times the LISP program (I suppose this could
be streamlined some, but not *that* much). Anyway, I think that
.16 is the one to beat (though I still think the hash table approach
is more efficient)
/Jon
|
99.20 | It's going real well so far! | JUNIPR::DMCLURE | Vaxnote your way to ubiquity | Mon Aug 25 1986 18:13 | 51 |
| I am running into a problem in judging these programs: I don't have
all of the compilers I need loaded onto to JUNIPR, and I'm not sure if
it would be feasable to try to load them ALL on. Maybe someone can help
me out in testing these things so I can be sure to send a note of recog-
nition back to the specific notesfile.
Specifically, who has the KOALA compiler? Obviously Scott A. Robins
does, but it's no fun to congratulate yourself (is it?). If someone could
test this KOALA program and send me a note, I'd appreciate it.
re: unboundedness,
Jon, I have no problem with multiple language entries of this program
here, so feel free to add your Pascal version to the collection. I will
only mention that I had kindof hoped to see pretty much the same old boring
stuff in each different language (in the simplest possible form), even so
far as using identical variable names and algorithms so that we can then
take a closer look at each of these languages to pinpoint all of the simi-
larities (i.e. define the "FORGOL" qualities, etc.).
Don't fret though, this is only the 1st Battle, I have plans to do
more later (if this turns out to be a success) and I will be sure to ask
for something a little more tricky next time. }8-)
Let me point out once again that I am not exactly immediately inter-
ested in developing the ultimate *Life* implementation, although I do have
to admit that a version matching your description would be alot of fun to
play. My interests in doing this "Battle" were to compare as many languages
as possible in as fun a way as possible. Maybe "Battle II" should simply
be an extension to this specification which includes unboundedness, window-
scrolling, color-graphics, etc., but I want to first wait until we can
get enough different language implementations of this first step before
going too much further.
Wouldn't it be nifty to have a database of all language control words
(similar to the way LSEDIT works) sorted by function, so that you could
write an AI program to help you decipher whatever program it is that you're
looking at? In addition, maybe through close exploration, we might arrive
at a consensus upon what the "best" language might be for a new corporate
standard (although I'm not holding my breath on this religious issue).
Anyway, This is some of the stuff I want to play around with once we
get a more representative sampling of available languages. So, why don't
you guys help me bring-in the rest of the implementations? Who wants to
do FORTRAN? How about APL? I'm also surprised there's no Cobol version
yet (the most common language - supposedly). I will be entering a list
of all languages which I solicited to be included in this study in a
subsequent reply complete with check-marks beside the languages which
have been entered here so far.
-davo
|
99.22 | comparing languages. Not doing the ultimate LIFE hack. | REGENT::MPCOHAN | Michael Cohan MLO3-6/B16 | Mon Aug 25 1986 20:23 | 10 |
| If I understand it right, the purpose of this note is to allow us
to compare the features of lots of different languages. Therefore,
I think that the simplest possible implementation of the program
is desirable. If I'm looking at a language I've never seen before,
I don't want to look at the ultimate implementation of LIFE. I
want to look at a real simple version, similar to the PASCAL version
I posted early on. This is so I can look at the basic layout of
the language as used in a simple program that still does something
reasonable. Please folks-- keep it simple! It will be a lot better
that way!
|
99.23 | Programmers of the World, UNITE! | JUNIPR::DMCLURE | Vaxnote your way to ubiquity | Mon Aug 25 1986 20:40 | 7 |
| re: -1,
Now you're catching on! We all know that we're guru's on our own
respective turf, so we don't really need to prove that here. Instead,
let's see what we can do to bridge the programming language gap.
-davo
|
99.24 | Yeah, but... | CIM::JONAN | Hey, it's all line noise to me... | Mon Aug 25 1986 21:02 | 8 |
| Re: -1 & -2
On the other hand, .16 (the LISP solution) doesn't look much more
complicated than the others, is as short (or shorter) and goes the
whole "9 yards". It seems that this too should count in the
comparisons. At least it seems that way to me.
/Jon
|
99.25 | Go against your instincts | JUNIPR::DMCLURE | Vaxnote your way to ubiquity | Mon Aug 25 1986 21:23 | 22 |
| re: .24,
Oh, it will definately count. No doubt about that! It's just that
there were all sorts of things I had to resist doing in my DESIGN version
(such as graphic touch-screen menu selection of coordinates, color-graphic
displays of each generation with actual human figures, linked lists of
the "live" objects to allow for the unbounded feature, even an IVIS disc
to accompany the program, etc.), but since I figured nobody would probably
compile it anyway, it would defeat the purpose by going off on too many
tangents.
By following a pretty strict model (for me, the Pascal program - since
I know Pascal), I was hoping to allow others to get the "feel" of DESIGN
at first glance. Now, LISP is going to probably blow alot of people away
regardless of how closely it comes to the simple array structure found in
the Pascal version, but I guess we'll have to wait and see about that.
-davo
p.s. funny how this sort of breaks all of the rules of being an individual
(i.e. if you were to copy algorithms like this at school, you'd be
flunked for cheating).
|
99.26 | Pretend like you're Schroeder... | JUNIPR::DMCLURE | Vaxnote your way to ubiquity | Mon Aug 25 1986 21:46 | 11 |
| ...this kind-of reminds me of the classic *Peanuts* cartoon in
which Schroeder is playing the piano for Lucy, and she keeps asking him
to play some song (_Mary_had_a_little_lamb_?), each time Schroeder tries
harder and harder to impress Lucy by playing more and more brilliant
versions, but to his dismay, she still doesn't recognize the tune.
Finally, Schroeder is so ticked-off, that he sits back and uses one
finger to play the simplest version possible of the meledy "PLINK..PLINK..
..PLINK..PLINK..PLINK..etc.", and Lucy perks-up and says "THATS IT!!!"
-davo
|
99.27 | do we have to use *virtual* memory? | PASTIS::MONAHAN | | Tue Aug 26 1986 08:52 | 8 |
| 13 years ago, before I joined DEC I had an implementation that
met all of the requirements. It was written in BLIP (BLock
structured Interpreter Programme). It had some restrictions - it
only had a 64*64 grid, and the stages were displayed on a storage
oscilloscope, but then it did run on a 4k word PDP-8.
If I can find a VAX with an ASR-33 I will try to find it to
enter it in the competition.
|
99.28 | NEW RULES | JUNIPR::DMCLURE | Vaxnote your way to ubiquity | Tue Aug 26 1986 16:24 | 26 |
| I have decided to broaden the scope of this focus a bit to encourage
more "Schroeders" (people who made have since walked away in disgust) to
enter their code listings here.
I have decided that you may do whatever you little black heart desires.
If you want to write code that goes upside-down in parallel with itself,
or includes full-color 3D imaging graphics, or is normally written for
laser-holographic plasma storage systems, or is all contained in a single
line of code, or is documented in Chinese, I don't mind. I just want to
see CODE!
I figure that if we get enough different versions of the same thing
entered here, that it won't matter that some of it is a little harder to
figure out than others. While I would like to see the fancy stuff, I still
want to encourage the simple stuff (for "Lucy's" like myself). For example:
it would be nice to also have a LISP version which implements a simple
(inefficient) array structure as was done in the Pascal example.
So, these are the NEW RULES. This means that we no longer have to wait
until "Battle of the Languages II" to see the fancy versions of *Life* (I
figure that it might be better to come up with a totally different program
spec if we ever do a "Battle of the Languages II"), so go ahead and enter
the fancy stuff here in this note (seeing as how some of the fancy stuff
has already been entered). So, what are you waiting for? GO FOR IT!!!
-davo
|
99.29 | PDP-11 BASIC-PLUS-2 / VAX BASIC | WHYVAX::HETRICK | Brian Hetrick | Tue Aug 26 1986 20:44 | 140 |
| Here is the game of Life in PDP-11 BASIC-PLUS-2. It also works
in VAX BASIC.
Brian Hetrick
----------------------------------------------------------------------
10 !+
! The game of LIFE in PDP-11 BASIC-PLUS-2
!-
OPTION &
TYPE = INTEGER ! Constants are integers not reals
DECLARE INTEGER CONSTANT &
Board_size_horizontal = 80, &
Board_size_vertical = 23, &
FALSE = 0, &
TRUE = -1
DECLARE BYTE &
Board (Board_size_vertical, Board_size_horizontal), &
Neighbors (Board_size_vertical, Board_size_horizontal)
DECLARE INTEGER &
Column_increment, ! Index for neighbor columns &
Column_index, ! Index for current column &
End_file_type, ! Where end of file came from &
Row_increment, ! Index for neighbor rows &
Row_index, ! Index for current row &
Valid_entry ! Board initialization entry
! is valid
DECLARE STRING &
Text_line ! User input to continue
DEF INTEGER Minimum (INTEGER A, INTEGER B)
Minimum = B
Minimum = A IF A < B
END DEF
DEF INTEGER Maximum (INTEGER A, INTEGER B)
Maximum = B
Maximum = A IF A > B
END DEF
ON ERROR GO TO Error_handler
!+
! Initialize the game board
!-
Board (Row_index, Column_index) = 0 &
FOR Column_index = 1 TO Board_size_horizontal &
FOR Row_index = 1 TO Board_size_vertical
PRINT "Enter coordinate pairs for initial cells, end with ^Z"
End_file_type = 1
WHILE TRUE
Valid_entry = FALSE
WHILE NOT Valid_entry
INPUT "Row, Column "; Row_index, Column_index
Valid_entry = Row_index > 0 AND &
Row_index <= Board_size_vertical AND Column_index > 0 AND &
Column_index <= Board_size_horizontal
NEXT
Board (Row_index, Column_index) = TRUE IF Valid_entry
NEXT
End_of_entry:
!+
! Compute and display the generations
!-
End_file_type = 2
WHILE TRUE
PRINT ESC; "[2J";
FOR Row_index = 1 TO Board_size_vertical
PRINT ESC; "["; NUM1$ (Row_index); ";"; &
NUM1$ (Column_index); "H"; "X"; &
IF Board (Row_index, Column_index) &
FOR Column_index = 1 TO Board_size_horizontal
PRINT
NEXT Row_index
PRINT "Press RETURN for next generation";
!+
! Figure out next generation
!-
Neighbors (Row_index, Column_index) = 0 &
FOR Column_index = 1 TO Board_size_horizontal &
FOR Row_index = 1 TO Board_size_vertical
FOR Row_index = 1 TO Board_size_vertical
FOR Column_index = 1 TO Board_size_horizontal
IF Board (Row_index, Column_index)
THEN
FOR Row_increment = Maximum (Row_index - 1, 1) TO &
Minimum (Row_index + 1, Board_size_vertical)
FOR Column_increment = Maximum (Column_index - 1, 1) TO &
Minimum (Column_index + 1, Board_size_horizontal)
Neighbors (Row_increment, Column_increment) = &
Neighbors (Row_increment, Column_increment) + 1 &
UNLESS Row_increment = Row_index AND &
Column_increment = Column_index
NEXT Column_increment
NEXT Row_increment
END IF
NEXT Column_index
NEXT Row_index
FOR Row_index = 1 TO Board_size_vertical
FOR Column_index = 1 TO Board_size_horizontal
SELECT Neighbors (Row_index, Column_index)
CASE < 2, >= 4
Board (Row_index, Column_index) = FALSE
CASE 3
Board (Row_index, Column_index) = TRUE
END SELECT
NEXT Column_index
NEXT Row_index
INPUT Text_line
NEXT
Error_handler:
ON ERROR GO TO 0 IF ERR <> 11 ! System error handling for non-
! end of file
RESUME End_of_entry IF End_file_type = 1
RESUME End_of_program
End_of_program:
END
|
99.30 | Here's a VAX FORTRAN version | JUNIPR::DMCLURE | Vaxnote your way to ubiquity | Wed Aug 27 1986 05:43 | 189 |
| C This version of *Life* includes death and birth counters so you can see
C how you are doing as it generates, as well as getting a total at the end.
C
C One minor bug which had/has me racking my brains (I haven't done FORTRAN
C in years), is where I try to concatenate a number to the current generation
C header. I ended-up adding 48 to the current count to get the ascii value
C via the CHAR function (because I couldn't find a STRING conversion fuction).
C This works fine until you try ten generations or more, when the ascii value
C no longer means anything.
C
C Other than that, I think you'll find this version kind-of fun to play.
C
C -davo
C
C*******************************************************************************
PROGRAM LIFE
IMPLICIT NONE
COMMON/B1/BOARD,GENERATION
INTEGER X_LIM /42/, Y_LIM /12/
INTEGER*2 BOARD(42,12),
2 GENERATION,
3 BIRTHS,
4 DEATHS,
5 TOTAL_GENS,
6 TOTAL_DEATHS,
7 TOTAL_BIRTHS,
8 X,
9 Y
C *** Initialize game variables ***
TOTAL_DEATHS= 0
TOTAL_BIRTHS= 0
C *** Get user input first ***
CALL INITIALIZE_BOARD (TOTAL_GENS)
CALL PRINT_BOARD
C *** Generation (main) loop ***
DO 1040 GENERATION=1, TOTAL_GENS
CALL NEW_GENERATION (DEATHS,BIRTHS)
TOTAL_DEATHS= TOTAL_DEATHS +DEATHS
TOTAL_BIRTHS= TOTAL_BIRTHS +BIRTHS
CALL PRINT_BOARD
1040 END DO
TYPE *, ' Total Deaths= ',TOTAL_DEATHS,
2 ' Total Births= ',TOTAL_BIRTHS
END
C
SUBROUTINE PRINT_BOARD
IMPLICIT NONE
COMMON/B1/BOARD,GENERATION
INTEGER X_LIM /42/, Y_LIM /12/
INTEGER*2 BOARD(42,12),
2 ASCII_ADDER,
3 GENERATION,
4 TOTAL_GENERATIONS,
5 X,
6 Y
LOGICAL GEN_NUM
CHARACTER*2 TEXT_CHAR
CHARACTER*42 TEXT_STRING
C *** Construct header for display ***
ASCII_ADDER= 48
GEN_NUM= ASCII_ADDER + GENERATION
TEXT_CHAR= CHAR (GEN_NUM)
TEXT_STRING= 'Generation # '//TEXT_CHAR
TYPE *, ' -------------------------- '
TYPE *, TEXT_STRING
TYPE *, ' -------------------------- '
C *** Print current board ***
DO 1011 Y= 2, Y_LIM-1
TEXT_STRING= ' '
DO 1010 X= 2, X_LIM-1
IF (BOARD(X,Y) .EQ. 1) THEN
TEXT_STRING(X:X)= '#'
ELSE
TEXT_STRING(X:X)= '.'
END IF
1010 END DO
TYPE *, TEXT_STRING
1011 END DO
END
C
SUBROUTINE INITIALIZE_BOARD (TOTAL_GENERATIONS)
IMPLICIT NONE
COMMON/B1/BOARD,GENERATION
INTEGER X_LIM /42/, Y_LIM /12/
INTEGER*2 BOARD(42,12),
2 GENERATION,
3 TOTAL_GENERATIONS,
4 X,
5 Y,
6 TEMP_NUM
INTEGER*4 IOS,
2 STATUS
INCLUDE '($FORDEF)'
DO 2010 X= 1, X_LIM
DO 2010 Y= 1, Y_LIM
BOARD(X,Y)= 0
2010 END DO
TYPE *, 'The game of *Life* is played on a 40 by 10 (X,Y) grid. '
WRITE (UNIT=*,FMT='(A,$)')
2 ' Enter total generations: '
IOS= 0
READ (UNIT=*,IOSTAT=IOS,FMT='(BN,I)',ERR=2020) TEMP_NUM
DO WHILE (IOS .NE. 0)
2020 TYPE *, ' Error reading generations... '
CALL ERRSNS (,,,,STATUS)
IF (STATUS .EQ. FOR$_INPCONERR) THEN
WRITE (UNIT=*,FMT='(A,$)') ' Please Try again. '
READ (UNIT=*,IOSTAT=IOS,FMT='(BN,I)') TEMP_NUM
ELSE
CALL LIB$SIGNAL (%VAL (STATUS))
END IF
END DO
TOTAL_GENERATIONS= TEMP_NUM
TYPE *, 'Enter beginning X,Y coordinates (0,0 when done) '
X= 1
DO WHILE (.NOT.((X .EQ. 0) .AND. (Y .EQ. 0)))
WRITE (UNIT=*,FMT='(A,$)') ' Enter coordinates: '
READ (UNIT=*,IOSTAT=IOS,FMT='(BN,2I)') X,Y
DO WHILE (IOS .NE. 0)
CALL ERRSNS (,,,,STATUS)
IF (STATUS .EQ. FOR$_INPCONERR) THEN
WRITE (UNIT=*,FMT='(A,$)') ' Oops. Try again. '
READ (UNIT=*,IOSTAT=IOS,FMT='(BN,2I)') X,Y
ELSE
CALL LIB$SIGNAL (%VAL (STATUS))
END IF
END DO
IF ((X .GE. X_LIM) .OR. (X .LT. 1) .OR. (Y .GE. Y_LIM)
2 .OR. (Y .LT. 1)) THEN
IF ((X .EQ. 0) .AND. (Y .EQ. 0)) THEN
TYPE *, ' Life begins!... '
ELSE
TYPE *, ' Error - out of range, try again... '
TYPE *, ' X= ', X, ' Y= ', Y
X= 1
END IF
ELSE
BOARD(X+1,Y+1)= 1
END IF
END DO
END
SUBROUTINE NEW_GENERATION (DEATHS,BIRTHS)
IMPLICIT NONE
COMMON/B1/BOARD,GENERATION
INTEGER X_LIM /42/, Y_LIM /12/
INTEGER*2 BOARD(42,12),
2 OLD_BOARD(42,12),
3 GENERATION,
4 X,
5 Y,
6 TOTAL_NEIGHBORS,
7 DEATH_COUNT,
8 BIRTH_COUNT,
9 DEATHS,
1 BIRTHS
C *** Initialize variable ***
DEATH_COUNT= 0
BIRTH_COUNT= 0
DO 3010 Y=1,Y_LIM
DO 3010 X=1, X_LIM
OLD_BOARD(X,Y)= BOARD(X,Y)
3010 END DO
C *** Calculate new life and death total ***
DO 3020 Y=2,Y_LIM-1
DO 3020 X=2, X_LIM-1
TOTAL_NEIGHBORS= OLD_BOARD(X-1,Y-1) + OLD_BOARD(X,Y-1) +
2 OLD_BOARD(X+1,Y-1) + OLD_BOARD(X-1,Y) +
2 OLD_BOARD(X+1,Y) + OLD_BOARD(X-1,Y+1) +
2 OLD_BOARD(X,Y+1) + OLD_BOARD(X+1,Y+1)
C *** Test for life or death ***
IF ((TOTAL_NEIGHBORS .LE. 1) .OR.
2 (TOTAL_NEIGHBORS .GE. 4)) THEN
BOARD(X,Y)= 0
IF (OLD_BOARD(X,Y) .EQ. 1) THEN
DEATH_COUNT= DEATH_COUNT +1
END IF
ELSE
IF (TOTAL_NEIGHBORS .EQ. 3) THEN
BOARD(X,Y)= 1
BIRTH_COUNT= BIRTH_COUNT +1
END IF
END IF
3020 END DO
DEATHS= DEATH_COUNT
BIRTHS= BIRTH_COUNT
TYPE *, 'Generation Deaths= ',DEATHS,
2 ', Generation Births= ',BIRTHS
END
|
99.32 | That's life? | GALLO::AMARTIN | Alan H. Martin | Wed Aug 27 1986 14:51 | 2 |
| AllTheI/OCallsMakeTheProgramLookLikeARansomNote.
/AHM
|
99.34 | | WHYVAX::HETRICK | Brian Hetrick | Wed Aug 27 1986 19:00 | 8 |
| Re: .29
At least some of you are having trouble compiling this. It
requires PDP-11 BASIC-PLUS-2 V2.3, and will not work with PDP-11
BASIC-PLUS-2 V2.2 or earlier. It works with VAX BASIC T3.0, but I do
not know about earlier versions.
Brian Hetrick
|
99.35 | TECO - The original DEC programming language! | STAR::VATNE | | Wed Aug 27 1986 22:25 | 17 |
| ! Here is a ten line TECO32 macro that does everything the PASCAL program
does. Note that there are embedded control characters (including escape).
To invoke it, extract this note into LIFE.TEC, then type:
$ TECO LIFE.TEC
*HXXMX$$ Where $ is the escape key !
How many generations do you want?
<Generations> HK<U1Q1I10-Q1;>BJ\UGQG-1;Enter a number greater than 0
>To bring a cell to life, type the X and Y coordinates
separated by a space, 0 0 to end. Range is 38 x 18.
HKI0A-79"E%1'HXMHK20<40<I. >I
><<X Y> ZJ<U1Q1I10-Q1;>-L\U1C\U20KK-Q1;Q1-39;-Q2;Q2-19;Q2*82+Q1+Q1JDIO>
Q1"EQ2"E0;''out of range
>Starting configuration
HT0U0QG<Generation #%0=HXAZJGABJ18<38<0U1MM2CMM2CMM78CMM4CMM78CMM2CMM2CMM
.+1556JQ1-2"LDI.R'Q1-3"EDIOR'Q1-3"GDI.R'.-1722J>L>B,1640KHT>
|
99.37 | Life in Modula-2! | TLE::NOLAN | | Thu Aug 28 1986 13:47 | 191 |
|
This is a new version of LIFE in Modula-2. The previous notes (.31
and .37) presented a version that implemented the wrong rules for
dying and for germination. This new version is now correct I believe.
Note that there is a bug in the Modula library routine ReadInt.
Do not leave trailing spaces on input lines to the questions, as
this will cause a zero value to be input to the next input.
MODULE life;
(*
GAme Of Life - VAX Modula X1.0-002
*)
FROM InOut IMPORT WriteString, WriteLn, Read, ReadString, ReadInt, ReadLn;
CONST
MAX_ROW = 133; (* maximum grid size *)
MAX_COL = 65;
STATE_ALIVE = 2; (* cell is alive *)
STATE_DEAD = -2; (* cell is dead *)
STATE_GERMINATING = -1; (* cell was dead, is becoming alive *)
STATE_DYING = 1; (* cell was alive, is dying *)
MIN_STATE = STATE_DEAD; (* min and max state values *)
MAX_STATE = STATE_ALIVE;
VAR
state : ARRAY [0..MAX_ROW] OF ARRAY [0..MAX_COL] OF INTEGER; (* state grid *)
generation, display_generation : INTEGER; (* global display variables *)
change : BOOLEAN; (* flag for whether grid changes *)
num_rows, num_cols : INTEGER; (* user selected grid size *)
PROCEDURE Display; (* display the current state *)
VAR
row, col : INTEGER;
BEGIN
FOR row := 0 TO num_cols+1 DO WriteString ("--") END; (* top border *)
WriteLn;
FOR row := 1 TO num_rows
DO
WriteString ("| "); (* left border *)
FOR col := 1 TO num_cols
DO
IF state[row][col] > 0
THEN WriteString ("* ") (* live cell *)
ELSE WriteString (" ") (* dead cell *)
END;
END;
WriteString ("|"); WriteLn; (* right border *)
END;
FOR row := 0 TO num_cols+1 DO WriteString ("--") END; (* bottom border *)
WriteLn;
END Display;
PROCEDURE Update; (* update state for next generation *)
VAR
row, col : INTEGER;
i, j : INTEGER;
neighbours : INTEGER;
BEGIN
change := FALSE; (* initialize flag *)
FOR row := 1 TO num_rows
DO
FOR col := 1 TO num_cols
DO
neighbours := 0; (* initialize count of neighbours *)
FOR i := row-1 TO row+1
DO
FOR j := col-1 TO col+1
DO
IF state [i][j] > 0 (* if neighbour is alive *)
THEN INC (neighbours) (* increment count of neighbours *)
END;
END;
END;
IF state [row][col] > 0 (* if cell is currently alive *)
THEN DEC (neighbours); (* we also counted ourself above *)
IF (neighbours < 2) (* those with less than 2 *)
OR (neighbours > 3) (* or greater than 3 neighbours *)
THEN state [row][col] := STATE_DYING; (* die *)
change := TRUE; (* grid has changed *)
END;
ELSE (* else cell is currently dead *)
IF (neighbours = 3) (* only those with 3 neighbours *)
THEN state [row][col] := STATE_GERMINATING; (* germinate *)
change := TRUE; (* grid has changed *)
END;
END;
END;
END;
FOR row := 1 TO num_rows
DO
FOR col := 1 TO num_cols
DO
IF state [row][col] = STATE_DYING (* those that are dying *)
THEN state [row][col] := STATE_DEAD (* go to dead *)
ELSE IF state [row][col] = STATE_GERMINATING (* those that are germianting *)
THEN state [row][col] := STATE_ALIVE; (* become alive *)
END;
END;
END;
END;
INC (generation);
END Update;
PROCEDURE Initialize; (* set up grid for start - do all user interaction *)
VAR
row, col : INTEGER;
BEGIN
REPEAT
WriteString ("Please enter grid size (rows cols): "); (* get grid size *)
ReadInt (num_rows); ReadInt (num_cols);
IF (num_rows <= 0) OR (num_rows >= MAX_ROW) (* must be within bounds *)
OR (num_cols <= 0) OR (num_cols >= MAX_COL)
THEN WriteString (">>>Invalid grid size - please try again.");
WriteLn;
num_rows := 0;
END;
UNTIL num_rows > 0;
FOR row := 0 TO num_rows + 1 (* init state grid to dead *)
DO
FOR col := 0 TO num_cols + 1
DO
state [row][col] := STATE_DEAD;
END;
END;
REPEAT
WriteString ("Please enter coordinates (eg n m): "); (* get start patterns from user *)
ReadInt (row);
IF row <> 0
THEN
IF (row < 0) OR (row > num_rows)
THEN WriteString (">>>Invalid row coordinate - please try again.");
WriteLn;
ELSE
ReadInt (col);
IF (col <= 0) OR (col > num_cols)
THEN WriteString (">>>Invalid column coordinate - please try again.");
WriteLn;
ELSE state [row][col] := STATE_ALIVE;
END;
END
END;
UNTIL row = 0;
WriteString ("Please enter display count: "); (* get number of generations between displays *)
ReadInt (display_generation);
IF display_generation = 0
THEN INC (display_generation);
END;
ReadLn;
change := TRUE; (* init flag *)
END Initialize;
PROCEDURE More; (* ask user whether to continue *)
VAR
ch : CHAR;
BEGIN
WriteString ("More? ");
Read (ch);
IF (ch = 'N') OR (ch = 'n')
THEN change := FALSE; (* make sure that we stop *)
END;
END More;
BEGIN
Initialize; Display; (* initialize and display starting grid *)
generation := 0;
WHILE change DO
Update; (* generate next grid *)
IF generation MOD display_generation = 0 (* ready for next display *)
THEN Display;
IF change
THEN More; (* do we continue *)
ELSE WriteString ("Stabilized."); WriteLn;
END;
END;
END;
END life.
|
99.38 | Here's a DSM (mumps) version | OZONE::CRAIG | Gort, klatu barada nikto | Thu Aug 28 1986 17:22 | 97 |
|
Here's a VAX DSM version written some time ago by Jack Bowie. I can't
take credit (or blame) for the code, the only thing I've done is
to change the commands (which in MUMPS can be one character) and
expand them to the full command syntax. (This to make it more readable
to you non-MUMPS people). Note that this is written specifically
to run on a VT100 or compatable.
28-AUG-1986 10:09:07.69
Saved by ^%EDT from WRK$:[CRAIG]ROUTINES.DSM;
LIFE
LIFE ;JEB;;The Game of Life
set esc=$c(27),nr=22,nc=22,bug=$c(97)
write esc,"[2J",esc,"[1;56H",esc,"[1;7m","The Game of Life",esc,"[m"
kill l do EDGE
INPUT use 0:(esc:noecho)
for i=0:1 set x=$p($t(TEXT+i),";",3,99) quit:x="" write esc,"[",4+i,";48H",x
write esc,"[11;21H" set (r,c)=9
READ read *x
if '$zb goto INPUTX:x=13,ERASE:x=32,MARK
set x=$zb\256 goto UP:x=17,DOWN:x=18,RIGHT:x=19,LEFT:x=20
ERR write $c(7) goto READ
ERASE goto ERR:'$d(l(r,c)) write " ",esc,"[D" kill l(r,c) goto READ
MARK write esc,"(0","a",esc,"(B",esc,"[D" set l(r,c)=0 goto READ
UP goto ERR:r=0 write esc,"[A" set r=r-1 goto READ
DOWN goto ERR:nr-1=r write esc,"[B" set r=r+1 goto READ
RIGHT goto ERR:nc-1=c write esc,"[2C" set c=c+1 goto READ
LEFT goto ERR:c=0 write esc,"[2D" set c=c-1 goto READ
INPUTX for i=0:1:i-1 write esc,"[",4+i,";48H",esc,"[K"
use 0:echo write esc,"[11;52HPattern completed (Y/N)? "
read x write esc,"[11;52H",esc,"[K"
if '(x="Y"!(x="y")) goto INPUT
if $o(l(""))="" write esc,"[2J" kill l,r,c,x,u,v,i,esc quit
set gen=1 write esc,"[3;58HGeneration 1"
;
CONT write esc,"[11;53HPress any key to pause"
use 0:(pack:noecho)
for gen=gen+1:1 do RENEW r *x:0 write esc,"[3;69H",gen do DRAW quit:$o(l(""))=""!(x'<0)
use 0:(echo:nopack)
write esc,"[11;52HPress RETURN to continue,",esc,"[12;55Hany other to quit"
read *x
for i=11,12 write esc,"[",i,";48H",esc,"[K"
goto CONT:x=13,LIFE
;
EDGE write esc,"[H",esc,"(0","l" for i=1:1:2*nc+1 write "q"
write "k" for i=1:1:nr write !,"x",esc,"[",2*nc+1,"Cx"
write !,"m" for i=1:1:2*nc+1 write "q"
write "j",esc,"(B" quit
quit
;
RENEW set r=""
for i=0:0 set r=$o(l(r)) quit:r="" set c="" for j=0:0 set c=$o(l(r,c)) quit:c="" do NEIGH:l(r,c)'<0
quit
;
NEIGH for i=-1,0,1 for j=-1,0,1 if i!j set u=r+i+nr#nr,v=c+j+nc#nc set l(u,v)=$s($d(l(u,v)):l(u,v)+1,1:-9)
quit
;
DRAW set r=""
for i=0:0 set r=$o(l(r)) quit:r="" set c="" for j=0:0 set c=$o(l(r,c)) quit:c="" do @(l(r,c)+10)
write esc,"[1;80H" use 0:flush
quit
;
TEXT ;; Create the starting pattern by
;;pressing the cursor keys to move
;;the cursor to the desired point.
;;Pressing any key other than SPACE
;;or RETURN will enter a cell. Use
;;SPACE to delete an existing cell.
;;Press RETURN when your pattern is
;;completed.
;;
;l(r,c) entry table
; entry is alive ("active") if value>9
; value#10 is number of alive neighbors
1 goto DIEX
2 goto DIEX
3 goto BIRTH
4 goto DIEX
5 goto DIEX
6 goto DIEX
7 goto DIEX
8 goto DIEX
10 goto DIE
11 goto DIE
12 goto LIVE
13 goto LIVE
14 goto DIE
15 goto DIE
16 goto DIE
17 goto DIE
18 goto DIE
DIE write esc,"[",r+2,";",2*c+3,"H "
DIEX kill l(r,c) quit
BIRTH write esc,"[",r+2,";",2*c+3,"H",esc,"(0","a",esc,"(B"
LIVE set l(r,c)=0 quit
|
99.40 | Life in APL! | TLE::NOLAN | | Thu Aug 28 1986 20:04 | 57 |
|
Well here is a version in VAX APL. It works, slowly, runs the
same as my Modula version does - same questions and input. I did
not spend much time trying to get the fastest algorithm, so I am
sure that a REAL APL hacker could come up with something faster.
.DL LIFE; GEN; COUNT
[1] INIT .DM DISPLAY
[2] L0: GEN _ 0
[3] L1: UPDATE .DM .GO (DELAY > (GEN _ GEN + 1)) / L1
[4] COUNT _ +/,STATE .DM DISPLAY .DM .GO ((0=COUNT) .OR (~CHANGE)) / L2 .DM MORE
[5] L2: .GO ((0 .NE COUNT) & CHANGE) / L0
.DL
.DL INIT; Z; COORDS; LEN
[1] LEN _ .RO .QQ _ 'Please enter grid size: '
[2] Z _ .BXFI LEN .DA .QQ
[3] ROWS _ Z[0] .DM COLS _ Z[1]
[4] STATE _ (ROWS+2) (COLS+2) .RO 0
[5] L0: LEN _ .RO .QQ _ 'Please enter coordinates: '
[6] COORDS _ .BXFI LEN .DA .QQ
[7] .GO (0 = 1 ^ COORDS) / L8
[8] .GO (2 = .RO COORDS) /L1
[9] '>>>bad coordinates - please try again.' .DM .GO L0
[10] L1: STATE [COORDS[0];COORDS[1]] _ 1 .DM .GO L0
[11] L8: LEN _ .RO .QQ _ 'Please enter display delay: '
[12] DELAY _ .BXFI LEN .DA .QQ
.DL
.DL UPDATE; Z; I; J; Z1; Z2
[1] Z _ (ROWS+2) (COLS+2) .RO 0 .DM I _ 1
[2] L0: J _ 1
[3] L1: Z [I;J] _ (+/,STATE[((ROWS+1) .FL (0 .CE (I-1) I (I+1))); ((COLS+1) .FL (0 .CE (J-1) J (J+1)))]) - STATE [I;J]
[4] .GO (COLS .GE (J_J+1)) / L1
[5] .GO (ROWS .GE (I_I+1)) / L0
[6] Z1 _ (Z=3) & ~STATE .DM Z2 _ ((Z=2) .OR (Z=3)) & STATE
[7] CHANGE _ .OR/,(Z1 .NE 0) .OR (Z2 .NE STATE) .DM STATE _ Z1 .OR Z2
.DL
.DL DISPLAY;Z; Z1; Z2; Z3
[1] Z1 _ (COLS+4) .RO '-'
[2] Z2 _ (ROWS+2) 1 .RO '|'
[3] Z3 _ Z2 , ((.RO STATE) .RO (,STATE) \ '*'), Z2
[4] Z _ Z1 .CC Z3 .CC Z1
[5] Z
.DL
.DL MORE; LEN; ANSWER
[1] LEN _ .RO .QQ _ 'More? '
[2] ANSWER _ 1 ^ LEN .DA .QQ
[3] .GO (('N' .NE ANSWER) & ('n' .NE ANSWER)) / L1
[4] CHANGE _ 0
[5] L1:
.DL
.BXIO _ 0
|
99.41 | BASIC-PLUS-2 again (with fixed typo) | EVER11::EKLOF | We're everywhere. | Thu Aug 28 1986 21:41 | 28 |
|
Well, here's another BASIC-PLUS-2 version. It's not as dressy as Brian's
version, but it works within the constraints of the problem. While this is not
what might be considered good coding, it is short, and it does work. When run,
you are prompted with a question mark (?). Enter a matrix as follows:
0 is an empty cell
1 is an occupied cell
The grid is arbitrarily 9x9, but you must enter a tenth row, and column with
a zero value. After each row, place an ampersand (&).
example: +-- this column must be present, and equal to zero
>run life v
? 0,0,0,0,1,0,1,0,0,0&
? 0,0,0,0,0,1,0,1,0,0&
? 0,0,0,0,0,0,1,0,0,0&
? 0,0,0,0,1,0
at this point, the user typed return, and the rest of the matrix was initialized
to zero.
Anyway, here's the program:
1 MAT INPUT A\MAT B=A\FOR K=1 TO 5\MAT A=B\FOR I=1 TO 9\FOR J=1 TO 9 &
\X=A(I-1,J-1)+A(I-1,J)+A(I-1,J+1)+A(I,J-1)+A(I,J+1)+A(I+1,J-1)+A(I+1,J)+ &
A(I+1,J+1)\B(I,J)=1 IF X=3\B(I,J)=0 IF (X<=1 OR X>=4)\NEXT J\NEXT I &
\MAT PRINT B(9,9);\PRINT\NEXT K
|
99.42 | bitwise (word foolish?) | VAXWRK::PRAETORIUS | _636741600744_ | Fri Aug 29 1986 01:58 | 639 |
| TITLE LIFMNG Conway's life via obtuse bit munging
COMMENT ~
Since this is a MACRO program and nobody in their right mind is gonna read
more that the first coupla screenfulls, I might as well lay my cards on the
table. I figured a tight inner loop for life a number of years ago and this is
just a flimsy shell around it.
The inner loop centers on the notion that a cell and its eight neighbors
can be represented by nine contiguous bits. As these bits are contiguous, they
can be treated as an integer and used as an index into a table with 512 (2^9)
entries. The table, you might have guessed, contains a bit indicating whether
or not this entry corresponds to a live cell in the next generation.
The other half of the hat trick is a data represenation to make this kind
of calculation convenient. It can be tersely stated that this is done by
having the bit position (NOT bit number) corresponding to location X,Y be
(Y MOD 3) + 3 * (X MOD 12)
If we name the bit positions 0..9A..Z (LSB to MSB, little-endian fashion), the
bits in a word map to the grid in the following way (Y increases up the page,
X to the right):
258BEHKNQTWZ
147ADGJMPSVY
0369CFILORUX
You can see that, for example, bit 4 corresponds to a cell and 0-3, 5-9 to
its neighbors.
For those that got this far and don't expect to go much further, the loop:
CELLUP: MOVE T1,C3
ANDI T1,777
LSHC C2,-3
IOR C2,CELTAB(T1)
SOJG P1,CELLUP
NOTES:
MOVE, ANDI could be replaced by a LDB, but I think it might be slower.
Before somebody points it out to me, yeah, the loop can be done in
3 instructions on a VAX (EXTZV, INSV, ACBL), but I wouldna wanna
fight the housekeeping (32 MOD 3 <> 0).
The user interface is nonexistent, the code is not properly bummed
and somewhat ragged in style and some features i'd like to have put
in (like compression of blank space in the grid (good for gliders)
and display optimization) have been left out to avoid increasing the
factor by which the size of this posting exceeds good taste.
~
SUBTTL Explicit and implicit constant definitions, etc.
SEARCH LIFPAR ; Get GRDINI and TABINI and a buncha constants
SEARCH MONSYM ; Get a coupla JSI and associated paraphenalia
; AC definitions
F==0 ; Flags
T1==1 ; T1-T4 are temps
T2==T1+1
T3==T2+1
T4==T3+1
P1==T4+1 ; P1-P6 are more permanent
P2==P1+1
P3==P2+1
P4==P3+1
P5==P4+1
P6==P5+1
C1==P6+1 ; Three contiguous ACs used by the cell loop
C2==C1+1
C3==C2+1
R==16 ; Return address
P==17 ; PDL pointer
; Flag bit for today
F.DONT==1B0 ; Suppress generation of next generation
; Make a dumb macro to find the bottom bit of a mask
DEFINE BB(MASK),<<MASK&-MASK>>
; Fabricate some names for characters
.CHFFD==14 ; Form feed (^L)
.CHCRT==15 ; Carriage return (^M)
.CHCTW==27 ; Control W
.CHEOF==32 ; EOF (^Z)
.CHESC==33 ; Escape
SUBTTL Storage definitions
; Cell storage (see LIFPAR for GRDINI and TABINI)
TOPBLK: REPEAT WRDROW,<EXP 0> ; A top guard row of blanks
GRID: GRDINI <.**,**.,.*.> ; Playing grid for the cells
BOTBLK: REPEAT WRDROW,<EXP 0> ; A bottom guard row of blanks
ROWBUF: BLOCK WRDROW ; Buffer for a set of 3 rows (see PUTWRD)
; CELTAB is the table which is the better half of this often confused
; and pointless algorithm. Given a representation where the cell and its
; 8 neighbors reside in 9 consecutive bits, one can simply use this 9 bit
; quantity as an index into CELTAB to determine the survival of a cell:
; Death is represented by a zero and survival by a word with the top bit lit.
CELTAB: TABINI
; A place to save the terminal modes
MODSAV: BLOCK 1
; A stack (what the heck)
PDLSIZ==50
PDL: BLOCK PDLSIZ
; The output character buffer
CHRBUF: BYTE (7).CHCRT,.CHESC,"[","2","J" ; clears the screen
CHRBF1: BLOCK 2000
SUBTTL MAIN - Top level
MAIN: MOVE P,[IOWD PDLSIZ,PDL] ; Set up the stack
MOVSI F,(F.DONT) ; Don't do calculation 1st time
MOVEI T1,.CTTRM ; For the controlling terminal
RFMOD% ; get the mode word
MOVEM T2,MODSAV ; Save it for posterity
TRZ T2,TT%DAM!TT%ECO ; Clear out what we'll change
TRO T2,.TTBIN*BB<TT%DAM> ; change it
SFMOD% ; Tell TOPS-20 we changed it (details)
HRROI T1,[ BYTE (7).CHCRT,.CHESC,"[","2","J"
ASCIZ /type ^Z to quit,
^L or ^W to refresh the screen,
most anything else to continue (each time)/ ]
PSOUT% ; Type a helpful message
CMDLUP: PBIN% ; Get a character
CAIN T1,.CHEOF ; ^Z?
JRST DONE ; Yeah, quit
CAIE T1,.CHFFD ; ^L?
CAIN T1,.CHCTW ; or ^W?
TLO (F.DONT)
TLZN (F.DONT) ; or 1st time?
PUSHJ P,DOGRID ; No, doit
PUSHJ P,DISPLA ; Display the grid
JRST CMDLUP
DONE: MOVEI T1,.CTTRM ; For our main TTY
MOVE T2,MODSAV ; get the JFN mode word
SFMOD% ; Put it back how it was
HALTF ; RIP
JRST MAIN
SUBTTL DOGRID - Loop over whole grid, row by row
; DOGRID - Loop over the whole grid, row by row
;
; Note that the looping is done left to right, top to bottom - this means
; that the X coordinatee increases in the inner loop and Y DEcreases in the
; outer loop. It's done in this order in case it's ever decided to do display
; at the same time that the next generation is calculated (currently display is
; handled by a separate loop).
;
; AC Usage:
;
; P3/ (byte) Pointer to current word in GRID
; P4/ Row within word (2, 1 or 0)
; P5/ Pointer to current row in GRID
;
; Calling sequence:
;
; PUSHJ P,DOGRID
DOGRID: SETZM ROWBUF ; BLT zeroes through ROWBUF
MOVE T1,[ROWBUF,,ROWBUF+1]
BLT T1,ROWBUF+WRDROW-1
MOVEI P5,GRID ; Point to the cell array
GRDLUP: MOVEI P4,3-1 ; Loop for each row within word
RWWLUP: HRR P3,P5 ; Make a pointer to 36 bit bytes in P3
HRLI P3,444400 ; pointing to the beginning of this row
PUSHJ P,DOROW
SOJGE P4,RWWLUP ; (SOJGE instead SOJG for zero based loop)
ADDI P5,WRDROW ; Add a row's worth of words to P5
CAIGE P5,BOTBLK ; Has it reached the bottom fence?
JRST GRDLUP ; Nope, more to do
POPJ P,
SUBTTL DOROW - Calculate the next generation for one row of cells
; DOROW - Calculate the next generation for one row of cells
;
; AC Usage:
;
; P2/ Contains one less than the remaining number of words to be done
; C1/ The last cell from the previous word is saved in C1's top bit
; C2/ high order word of cell bitmap in munged format
; C3/ low order word of cell bitmap in munged format
;
; Arguments:
;
; P4/ Row within word
; P6/ (byte) Pointer to current word in row buffer
;
; Calling sequence:
;
; PUSHJ P,DOROW
DOROW: MOVEI P6,ROWBUF ; Point P6 to the row buffer
SETZB C1,C3 ; Start with C1 and C3 clear
MOVEI P2,WRDROW ; Get number of word in row into P2
XCT GETWRD(P4) ; Pick up next word in C2
LSHC C2,-<^D36-3> ; Shift C2 down into C3, less one col.
MOVEI P1,1 ; Do the magic thing once
JSP R,CELLUP
MOVE C1,C2 ; Save the one cell in the top of C1
SOJLE P2,ROWLST ; Handle single word case
ROWLUP: XCT GETWRD(P4) ; Next word into C2
MOVEI P1,COLPWD ; Do the magic thing for every column
JSP R,CELLUP
ROTC C1,-<^D36-3> ; Tack saved cell onto new batch
JSP R,@PUTWRD(P4) ; Put out new cells, except last one
LSHC C1,<^D36*2-3> ; Make last cell new saved cell
SOJG P2,ROWLUP ; Loop until all words consumed
ROWLST: MOVEI P1,COLPWD-1 ; Do it for every column but one
JSP R,CELLUP
LSH C2,-3 ; Make it next to saved cell, ROTCwise
ROTC C1,-<^D36-3> ; Align last batch of cells
JSP R,@PUTWRD(P4)
POPJ P,
SUBTTL GETWRD - Get the next word of cells, in bitmunged format
; GETWRD - Get the next word of cells, in bitmunged format
;
; The theory of operation of GETWRD is pretty much explained by the
; follow table:
;
; Output row Inputs Corrective Shift
;
; 0 (prev) 2
; 2 2 (cur) -1
; 1 (cur) -1
;
; 2 (cur) 0
; 1 1 (cur) 0
; 0 (cur) 0
;
; 1 (cur) 1
; 0 0 (cur) 1
; 2 (next) -2
;
; Calling Sequence:
;
; XCT GETWRD(P4)
;
; Arguments:
;
; P3/ Current (byte) pointer into GRID
GETWRD: JSP R,GETWD0
ILDB C2,P3 ; Middle row - everything's already aligned
JSP R,GETWD2
GETWD0: ILDB T1,P3 ; Get a word from current set of 3 rows
AND T1,[333333333333] ; Use rows 0 and 1
LSH T1,1 ; as rows 1 and 2
MOVE C2,WRDROW(P3) ; Get a word from the next row
AND C2,[444444444444] ; Use row 2
LSH C2,-2 ; as row 0
IOR C2,T1 ; Merge the bits
JRST (R)
GETWD2: ILDB T1,P3 ; Get a word from current set of 3 rows
AND T1,[666666666666] ; Use rows 1 and 2
LSH T1,-1 ; as rows 0 and 1
MOVE C2,-WRDROW(P3) ; Get a word from the previous row
AND C2,[111111111111] ; Use row 0
LSH C2,2 ; as row 2
IOR C2,T1 ; Merge the bits
JRST (R)
SUBTTL CELLUP - Generate a word's worth of cells, or less
; CELLUP - Generate a word's worth of cells, or less
;
; Arguments:
;
; C2/ high order word of cell bitmap in munged format
; C3/ low order word of cell bitmap in munged format
; P1/ iteration count, normally COLPWD
;
; Calling sequence:
;
; JSP R,CELLUP
;
; Returns:
;
; +1, always, with
; C2/ fresh set of cells (normally)
; C3/ old contents of C2 (high order cell bitmap)
; P1/ 0
CELLUP: MOVE T1,C3 ; Get munged bits in T1
ANDI T1,777 ; Only want the bottom nine bits
LSHC C2,-3 ; Advance to next cell
IOR C2,CELTAB(T1) ; Look up the next generation
SOJG P1,CELLUP ; more, maybe
JRST (R)
SUBTTL PUTWRD - Put a word into the row buffer
; PUTWRD - Put a word into the row buffer
;
; Arguments:
;
; C1/ COLPWD (12) cells in row 2 format
; P4/ Row within word (2, 1 or 0)
; P5/ Beginning of current row in grid
; P6/ (byte) pointer to row buffer
;
; Calling sequence:
;
; JSP R,@PUTWRD(P4)
PUTWRD: PUTWD0
PUTWD1
PUTWD2
PUTWD2: MOVE T1,(P6) ; Pull a word out of the row buffer
SETZM (P6) ; Clear the row buffer word
MOVEI T2,-ROWBUF(P6) ; Calculate index into row buffer
ADDI T2,-WRDROW(P5) ; Find corresponding place in previous row
MOVEM T1,(T2) ; Cycle from the row buffer back to grid
PUTWD0:
PUTWD1: LSH C1,-2(P4) ; Align the output from CELLUP
IORM C1,(P6) ; Or the bits into the row buffer
AOJ P6, ; Point to next word in ROWBUF
JRST (R)
; N.B. - Something potentially nonobvious and critical occurs here:
;
; There is a very narrow window where the row buffer can be can be returned
; to the grid:
;
; The idea behind ROWBUF is that a context of 3 lines must be
; maintained to insulate this generation from the previous
; one. As the current line begins (on row 2), it needs to
; refer to the last row (0) of the previous line - however,
; once the stuff from the previous is in the ACs, the row
; buffer word resulting from the previous line can be written
; back to the grid, just in time for the results from CELLUP
; to be stored in the freshly vacated ROWBUF word.
;
; Also note that it is a side effect of PUTWRD's behavior that the
; initially zeroed ROWBUF is written into the initially zeroed TOPBLK
; (the top blank border on the grid) first time through. This doesn't hurt
; anything, but it's sorta ugly, ain't it?
SUBTTL DISPLA - Display the grid
; DISPLA - display the grid
;
; AC usage:
;
; P1/ row within word counter (2..0)
; P2/ column within word counter
; P3/ word within row counter
; P4/ column within grid counter
; P5/ pointer to current word in grid
; P6/ output buffer byte pointer
; C1/ sliding bit (2^0..2^35)
; C2/ current column on screen
; C3/ current row on screen
;
; Calling sequence:
;
; PUSHJ P,DISPLA
DISPLA: MOVEI P5,GRID ; Point P5 at the cell grid
HRRI P6,CHRBF1 ; Point P6 at the output buffer
HRLI P6,440700
MOVEI C3,1-<ACTROW-ROWCNT>/2 ; Center Y on the screen
MOVEI P4,WRDCOL ; For each row. . .
DISLP1: HRREI C2,1-<ACTCOL-COLCNT>/2 ; Center X on the screen
MOVEI P3,WRDROW ; For each word in the row. . .
DISLP2: MOVEI C1,1 ; Plant a bit in the bottom of C1
MOVEI P2,COLPWD ; For each column within the word. . .
DISLP3: MOVEI P1,3-1 ; For each row within the word. . .
DISLP4: TDNE C1,(P5) ; Check for a live cell
JSP R,TRYOUT ; Saw one, try to output it
LSH C1,1 ; Move cell mask up by one
SOJGE P1,DISLP4 ; Back for next row within word
AOJ C2, ; Bump current column on screen
SOJG P2,DISLP3 ; Back for next column within word
AOJ P5, ; Point at next word
SOJG P3,DISLP2 ; Back for next word within row
ADDI C3,3 ; Bump current row on screen by 3
SOJG P4,DISLP1 ; Back for next row in grid
SETZ T1, ; Null terminate CHRBUF
IDPB T1,P6
HRROI T1,CHRBUF ; Point at screen clear & cells
PSOUT% ; Output it all
POPJ P,
SUBTTL TRYOUT - Try to output a cell to the screen
; TRYOUT - Try to output a cell to the screen
;
; Arguments:
;
; P2/ 2 - <Row within column>
; C2/ current column on
; C3/ current row on screen
;
; Calling sequence:
;
; JSP R,TRYOUT
TRYOUT:
IFG ACTCOL-COLCNT,< ; If more columns are stored than seen
CAIL C2,1 ; Check column number
CAIL C2,COLCNT
JRST (R) ; Not on display, return>
DMOVE T3,C2 ; Put column and row in T3 and T4
ADDI T4,(P1) ; Add row within word to row
IFG ACTROW-ROWCNT,< ; If more rows are stored than seen
CAIL T4,1 ; Check row number
CAILE T4,ROWCNT
JRST (R) ; Not on display, return>
MOVEI T1,.CHESC ; Output <ESC>[row;columnH*
IDPB T1,P6
MOVEI T1,"["
IDPB T1,P6
MOVE T1,T4 ; Get the row
PUSHJ P,DECOUT ; and convert it to decimal
MOVEI T1,";"
IDPB T1,P6
MOVE T1,T3 ; Get the column
PUSHJ P,DECOUT ; convert it, too
MOVEI T1,"H"
IDPB T1,P6
MOVEI T1,"*"
IDPB T1,P6
JRST (R)
SUBTTL DECOUT - Canonical decimal output routine
; DECOUT - Canonical decimal output routine
;
; Arguments:
;
; T1/ Positive integer to be output
; P6/ Byte pointer to character buffer
;
; Calling sequence:
;
; PUSHJ P,DECOUT
; returns +1, always, creams T2
DECOUT: IDIVI T1,^D10 ; Rip out bottom digit into T2
PUSH P,T2 ; Save it
SKIPE T1 ; Anything left?
PUSHJ P,DECOUT ; Yup, do some more
POP P,T1 ; Get the digit back
MOVEI T1,"0"(T1) ; Turn the digit into ASCII
IDPB T1,P6 ; Output to buffer
POPJ P,
SUBTTL The end
END MAIN
-------------------------------------------------------------------------------
LIFPAR.MAC
-------------------------------------------------------------------------------
UNIVERSAL LIFPAR
; NOTE: LIFPAR exists only so that you wouldn't have to wade through obscure
; macro definitions before looking at code, on the infinitesimal chance
; that you are looking at this at all.
SUBTTL Constant definitions
; Various lifelike constants
BITPWD==^D36 ; Bits per word
ROWCNT==^D24 ; Number of rows to display
COLCNT==^D80 ; Number of columns to display
ROWPWD==3 ; Rows stored per word
COLPWD==BITPWD/ROWPWD ; Columns stored per word
WRDROW==<COLCNT+COLPWD-1>/COLPWD ; Total words per row
WRDCOL==<ROWCNT+ROWPWD-1>/ROWPWD ; Total words per column
ACTROW==WRDCOL*ROWPWD ; Actual number of rows in the grid
ACTCOL==WRDROW*COLPWD ; Actual number of columns in the grid
SUBTTL GRDINI - Initialize the cell grid
; GRDINI - Initializes the cell grid
;
; Arguments:
; CELLS - accepts a list of strings, each of equal length
; any character except . is taken as a cell (. is
; just used for spacing). The cells are assembled
; into the grid with the first string on top, the
; last on the bottom, approximately centered on
; both axes
;
; Variable usage:
; ..Gxy - The grid is stored into variables named ..Gxy
; where x ranges from 0 to WRDROW-1 (0 to 6 in this
; case) and y from WRDCOL-1 to 0 (7 to 0 in this
; case).
DEFINE GRDINI(CELLS,%CNT1,%CNT2,%X,%Y,%XX,%YY,%BIT),<
%CNT1==0
%CNT2==0
IRP CELLS,<
IFE %CNT2,<
IRPC CELLS,<
%CNT2==%CNT2+1 ;; count the characters in a row
>
>
%CNT1==%CNT1+1 ;; count the number of rows
>
GRDCLR ;; initialize the grid to all zeroes
%Y==<ACTROW+%CNT1>/2 ;; attempt to center the initial pattern
IRP CELLS,<
%X==<ACTCOL-%CNT2>/2
IRPC CELLS,<
IFDIF <CELLS>,<.>,<
%XX==%X/COLPWD ;; translate X and Y coordinates into
%YY==%Y/3 ;; wordwise X and Y index and bit shift amount
%BIT==1_<<%Y-%YY*3>+3*<%X-%XX*COLPWD>>
GRDIN1 \%XX,\%YY,\%BIT
>
%X==%X+1
>
%Y==%Y-1
>
GRDDMP ;; dump out the grid
>
; GRDIN1 - auxiliary macro to allow GRDINI to set a bit in a ..Gxy variable
DEFINE GRDIN1(X,Y,BIT),<
..G'X'Y==..G'X'Y!BIT
>
; GRDCLR - auxiliary macro that sets all ..Gxy variables to zero for GRDINI
DEFINE GRDCLR(%X,%Y),<
%Y==WRDCOL-1
REPEAT WRDCOL,<
%X==0
REPEAT WRDROW,<
GRDCL1 \%X,\%Y
%X==%X+1
>
%Y==%Y-1
>
>
; GRDCL1 - auxiliary macro to allow GRDCLR to set a ..Gxy variable to zero
DEFINE GRDCL1(X,Y),<
..G'X'Y==0
>
; GRDDMP - auxiliary macro that gets the ..Gxy variables into the .OBJ
DEFINE GRDDMP(%X,%Y),<
%Y==WRDCOL-1
REPEAT WRDCOL,<
%X==0
REPEAT WRDROW,<
GRDDM1 \%X,\%Y
%X==%X+1
>
%Y==%Y-1
>
>
; GRDDM1 - auxiliary macro for GRDDMP that allows it to dump one %Gxy var
DEFINE GRDDM1(X,Y),<
EXP ..G'X'Y
>
SUBTTL TABINI - Initialize the rule table for cell survival
; TABINI - Initialize the rule table for cell survival
;
; Given a cell and its eight neighbors represented as nine consecutive
; bits, TABINI simply counts the number of bits on in each of the 2^9
; possible patterns and lights the top bit of those words that correspond
; to cell survival
DEFINE TABINI(%CNT1,%CNT2,%BIT),<
%CNT1==0
REPEAT 1_^D9,< ;; Do this 2^9 times
%BIT==1
%CNT2==0
REPEAT ^D9,<
IFN %BIT&%CNT1,%CNT2==%CNT2+1
%BIT==%BIT*2
>
IFE %CNT2-3,< ;; Cell and two neighbors or a blank with three
SETZ ;; (time honored substitute for 1B0)
%BIT==0
>
IFN %BIT,<
IFN %CNT1&20,<
IFE %CNT2-4,< ;; Cell and three neighbors
SETZ
%BIT==0
>
>
>
IFN %BIT,<
EXP 0 ;; Anything else dies
>
%CNT1==%CNT1+1
>
>
END
|
99.44 | One more time | EVER11::EKLOF | We're everywhere. | Fri Aug 29 1986 15:18 | 15 |
|
The version I entered in .41 does not conform to the spec. On
re-reading, I notice the user is to input the desired number of generations.
Here is the code modified to do this. At the first question mark, type the
number of generations, followed by a carriage return. At the next one,
proceed as in .41.
Mark
1 INPUT Y\MAT INPUT A\MAT B=A\FOR K=1 TO Y\MAT A=B\FOR I=1 TO 9\FOR J=1 TO 9 &
\X=A(I-1,J-1)+A(I-1,J)+A(I-1,J+1)+A(I,J-1)+A(I,J+1)+A(I+1,J-1)+A(I+1,J)+ &
A(I+1,J+1)\B(I,J)=1 IF X=3\B(I,J)=0 IF (X<=1 OR X>=4)\NEXT J\NEXT I &
\MAT PRINT B(9,9);\PRINT\NEXT K
|
99.46 | | KONING::KONING | Paul Koning | Fri Aug 29 1986 18:00 | 3 |
| re .45: TECO entry works -- user interface is unforgiving though.
paul
|
99.48 | | OOLA::OUELLETTE | Roland, you've lost your towel! | Fri Aug 29 1986 19:43 | 3 |
| .46> TECO entry works -- user interface is unforgiving though.
Just like TECO..... (<-:
|
99.49 | The program remains but the programmer is gone | REGENT::MPCOHAN | Michael Cohan MLO3-6/B16 | Fri Aug 29 1986 20:34 | 3 |
| Just a note to say that I am gone as of today (I'm a temporary.)
Back to college! However, you may all go right ahead and disparage
the simple version I submitted after I am gone... :-) bye!
|
99.50 | A Pascal hero pronounced M.I.A. | JUNIPR::DMCLURE | Vaxnote your way to ubiquity | Fri Aug 29 1986 21:38 | 11 |
| re: Michael Cohon,
Sorry to hear you're leaving! I suppose you might be recognized as
a Pascal "martyr" in the "Battle of the Languages" after your model
Pascal program. I hope the "morale" of the Pascal troops survives this
great loss; hopefully someone else can take over where you left off.
In memory of a great Pascal programmer...thanks!
-davo
p.s. Good luck in school, although I doubt if you'll need it.
|
99.51 | How about VAXTPU? | WHYVAX::BUXBAUM | Nothin' up my sleeve...presto | Fri Aug 29 1986 22:22 | 289 |
| Here's my favorite hacking language: TPU. The user interface is the nicest
of the ones submitted so far, but this is probably the slowest entry.
Since it's written in TPU, this only works on VT100's and VT200's.
Have fun, kids!
---- Cut Here ----
!+
! M. Buxbaum 29-AUG-1986
!
! TPU Section File to play Conway's game of life
!
! Instructions:
! To compile: EDIT/TPU/NOSECTION/COMMAND=LIFE
! To execute: EDIT/TPU/SECTION=SYS$DISK:[]LIFE
!
! Arrow keys move the cursor around the screen;
! Space bar will toggle a cell on or off
! Return key will create the next life generation in the current buffer
!-
PROCEDURE life$neighbors
LOCAL temp, count, lc;
life$x := mark(none);
temp := current_character;
count := 0;
IF life$up(temp) <> 0 THEN ! there is something above
IF current_offset > 0 THEN
lc := 3; ! move left one
move_horizontal(-1);
ELSE
lc := 2; ! couldn't move left
ENDIF;
LOOP ! check next 3 characters (next 2?)
EXITIF lc = 0;
IF (current_character = "X") or (current_character = "D") THEN
count := count + 1;
ENDIF;
EXITIF life$right(temp) = 0;
lc := lc - 1;
ENDLOOP;
ENDIF;
position(life$x);
IF life$down(temp) <> 0 THEN ! try to move down
IF current_offset > 0 THEN ! try to move left
lc := 3;
move_horizontal(-1); ! ok to move left
ELSE
lc := 2; ! couldn't move left
ENDIF;
LOOP
EXITIF lc = 0; ! check next 3 (or 2) characters
IF (current_character = "X") or (current_character = "D") THEN
count := count + 1;
ENDIF;
EXITIF life$right(temp) = 0;
lc := lc - 1;
ENDLOOP;
ENDIF;
position(life$x); ! see one character to left
IF current_offset <> 0 THEN
move_horizontal(-1);
IF (current_character = "X") or (current_character = "D") THEN
count := count + 1;
ENDIF;
ENDIF;
position(life$x); ! see one character to the right
IF life$right(temp) <> 0 THEN
IF (current_character = "X") or (current_character = "D") THEN
count := count + 1;
ENDIF;
ENDIF;
position(life$x);
RETURN count
ENDPROCEDURE
PROCEDURE life$up(x)
! bomb proof move_vertical(-1);
! if x is "X" then extend the buffer upward to make this work
LOCAL temp;
ON_ERROR
IF error = TPU$_BEGOFBUF THEN
IF x = "X" THEN
move_horizontal(-current_offset);
split_line;
move_vertical(-1);
copy_text(substr(life$spaces,1,temp));
RETURN 1;
ELSE
position(temp2);
RETURN 0;
ENDIF;
ENDIF;
ENDON_ERROR;
temp := current_offset;
temp2 := mark(none);
move_vertical(-1);
IF current_offset = temp THEN RETURN 1; ENDIF;
IF x = "X" THEN
copy_text(substr(life$spaces, 1, temp-current_offset));
RETURN 1;
ENDIF;
position(temp2);
RETURN 0;
ENDPROCEDURE
PROCEDURE life$down(x)
! bomb proof move_vertical(1)
! if x is "X" then extend buffer downward
LOCAL temp;
ON_ERROR
IF error = TPU$_ENDOFBUF THEN
IF x = "X" THEN
move_horizontal(-current_offset);
move_vertical(1);
split_line;
copy_text(substr(life$spaces,1,temp));
RETURN 1;
ELSE
position(temp2);
RETURN 0;
ENDIF;
ENDIF;
ENDON_ERROR;
temp := current_offset;
temp2 := mark(none);
move_vertical(1);
IF mark(none) = end_of(current_buffer) THEN
IF x = "X" THEN
copy_text(" ");
RETURN 1;
ELSE
RETURN 0;
ENDIF;
ENDIF;
IF current_offset = temp THEN RETURN 1; ENDIF;
IF x = "X" THEN
copy_text(substr(life$spaces, 1, temp-current_offset));
RETURN 1;
ENDIF;
position(temp2);
RETURN 0;
ENDPROCEDURE;
PROCEDURE life$right(x)
! bomb proof move_horizontal(1);
! if x is "X" then extend buffer rightward
move_horizontal(1);
IF (mark(none) = end_of(current_buffer)) or
(current_character = "") THEN
IF x = "X" THEN
copy_text(" ");
move_horizontal(-1);
ELSE
move_horizontal(-1);
RETURN 0;
ENDIF;
ENDIF;
RETURN 1;
ENDPROCEDURE;
PROCEDURE life$go
! run one generation; take three passes...not the most efficient, but it works
LOCAL number_of_neighbors;
! pass 1: clean up the edges
! IF any line ends with an "X", add a space there
position(beginning_of(main_buffer));
LOOP
EXITIF mark(none) = end_of(main_buffer);
IF length(current_line) > 0 THEN
move_horizontal(length(current_line)-1);
IF current_character = "X" THEN
move_horizontal(1);
copy_text(" ");
ENDIF;
move_horizontal(-current_offset);
ENDIF;
move_vertical(1);
ENDLOOP;
! if the first line of the buffer has "X"'s, then insert a line of spaces
position(beginning_of(main_buffer));
IF index(current_line,"X") > 0 THEN
split_line;
temp := length(current_line);
move_vertical(-1);
copy_text(substr(life$spaces,1,temp));
ENDIF;
! if the last line of the buffer has "X"'s, then append a line of spaces
position(end_of(main_buffer));
move_vertical(-1);
IF index(current_line,"X") > 0 THEN
temp := length(current_line);
move_vertical(1);
copy_text(substr(life$spaces,1,temp));
ENDIF;
! pass 2: mark all the births and deaths
position(beginning_of(main_buffer));
LOOP ! for each character
IF current_character = "" THEN move_horizontal(1); ENDIF;
EXITIF mark(none) = end_of(main_buffer); ! at eob
number_of_neighbors := life$neighbors;
IF current_character = " " THEN
IF number_of_neighbors = 3 THEN
copy_text("B");
move_horizontal(-1);
ENDIF;
ELSE
IF (number_of_neighbors < 2) or (number_of_neighbors > 3) THEN
copy_text("D");
move_horizontal(-1);
ENDIF;
ENDIF;
move_horizontal(1);
ENDLOOP; ! for each character
! pass 3: cleanup B's and D's
position(beginning_of(main_buffer));
LOOP
EXITIF mark(none) = end_of(main_buffer);
IF current_character = "B" THEN
copy_text("X");
move_horizontal(-1);
ENDIF;
IF current_character = "D" THEN
copy_text(" ");
move_horizontal(-1);
ENDIF;
move_horizontal(1);
ENDLOOP;
ENDPROCEDURE;
PROCEDURE life$toggle_on_off
! procedure bound to space key
IF current_character <> "X" THEN
copy_text("X");
cursor_horizontal(-1);
ELSE
copy_text(" ");
cursor_horizontal(-1);
ENDIF;
ENDPROCEDURE; ! life$toggle_on_off
PROCEDURE tpu$init_procedure
! main buffer, window
main_buffer := create_buffer("main buffer");
main_window := create_window(1, 24, on);
set(status_line, main_window, reverse, "Arrows move, <SP> toggles pixel, <CR> runs one generation");
map(main_window, main_buffer);
! prompt area
set(prompt_area, 24, 1, none);
! cursor starting pos
position(main_buffer);
set(overstrike, main_buffer);
! nice global variable
life$spaces := " ";
ENDPROCEDURE;
! define the keys
set(self_insert, "tpu$key_map_list", off);
define_key("life$toggle_on_off", key_name(" "));
define_key("life$go", ret_key);
define_key("cursor_horizontal(1)", right);
define_key("cursor_horizontal(-1)", left);
define_key("cursor_vertical(1)", down);
define_key("cursor_vertical(-1)", up);
! commands to build section file
save("life");
quit;
|
99.54 | In search of a NOTE_VOTE facility | VLNVAX::DMCLURE | I'm not your typical AI program... | Tue Sep 02 1986 21:41 | 57 |
|
I thought I'd check into the DCL program written by Didier called
AUDIT (check the S/W Tools Clearinghouse Catalog; press KP7 and all that
jazz...note number 30 I believe) to see if it might be useful as a vote
counting program for various issues that might pop-up here (or anywhere
else in the notesfiles).
I just thought I'd throw this out in case 1) Someone thought they'd
write a program to do this (since I did mention it as a possible candidate
for a "Battle of the Languages II" spec), and 2) Someone may have used this
"AUDIT" program already and could give me feedback for whether it could
work as a vote-counter for the "Battle" (or casualty-counter, as the case
may be).
Some of the things we might want for such a "NOTE_VOTE" facility would
be:
(1) A registration feature to help prevent multiple votes from the same
person. This would ideally perform checks against the Personnel Master
File, but since this may not be feasable, at least ask for the Full
Name, Badge, and then store the information in a database.
(2) A voting feature which could double as a survey feature. I think
the AUDIT program has this functionality already.
(3) A reporting feature which could provide several generic reports
to anyone who is interested (including a poll of the current voting
stats).
In case anyone is wondering why I have suddenly become so interested
in such a facility, my interest was initially spawned by a percieved need
to offer readers and contributors of the "Battle of the Languages" a chance
to vote for their favorite program implementation and/or language without
having to "go public" with the reasons, etc.
Since a person's favorite language is normally defended similar to
that of a person's religion, I thought there might be a need for a secret
ballot of this sort (secret to a certain degree anyway). Whether we would
even want to vote for our favorite program implementation (or even our
favorite language) is something that might make for a good first issue for
the ballot.
As we progress towards (what I would hope would be) PEACE on the
programming language "Battlefield", I would expect that we might have a
need for such a "NOTE_VOTE" facility to get a quick consensus on programming
issues as they come up. If nothing else, it might make for an interesting
experiment to try and facilitate such a network voting booth, and it might
turn out to be a useful feature to add to the Vaxnotes facility (after all,
obtaining a quick vote is one of the few things that you really can't yet
do through Vaxnotes, and still have to resort to live meetings or paper
ballots for, at least not on the large cross section view of things).
Please respond if you are familiar with the AUDIT program, or if you
are familiar with another such program that could suffice as a "NOTE_VOTE"
facility, or if you have problems with the whole idea, etc.
-davo
|
99.55 | Prolog life | NZOV01::DENHARTOG | The flightless Dutchman | Wed Sep 03 1986 04:29 | 105 |
| Here is a prolog version that I cooked up. I actually converted it
from the Simple C version, even though it would have been far better
to use the lisp for inspiration. Even though it went though a fair few
generations to end up as prolog.
The version of prolog used is actually called C-prolog, as discussed
in the prolog notes file (which I don't read).
It is extreemly slow, but it does seem to work. The size of the
universe is bounded at 40 * 20.
%-------------------------------------------------------------------------------
life:-
readpairs(40, 20),
assert(livecells), !, % set non-zero population indicator
repeat, % repeat ...
movenew, % clean up from last cycle
cycle(1, 1, 41, 21), % initiate cycle
not clause(livecells, Ignored). % until zero population
movenew :-
retract(cell(X, Y)), % remove old board
fail.
movenew :-
retract(livecells), % remove zero population indicator(s)
fail.
movenew :-
movecells.
movecells :- % move the last output board
newcell(X, Y), % to make it the next input board
assert(cell(X, Y)),
fail.
movecells :- !.
readpairs(MaxX, MaxY) :- % get a X and Y pair from the user.
print('Enter the value or "end" followed by a "."'), nl,
readnum(X, 2, MaxX, 'X> '),
( X = end % test for "end" as X input...
; print('Enter the value followed by a "."'), nl, % ... no
readnum(Y, 2, MaxY, 'Y> '),
integer(Y), % make sure y is an integer.
setxy(X, Y), % light up the cell
readpairs(MaxX, MaxY) % user input procedure
), !.
readnum(Num, Min, Max, Prompt) :- % get a value from the user
print(Prompt),
repeat,
read(Num),
( Num = end % either "end",
; integer(Num), % or an integer...
Num =< Max, Num >= Min % ...within range
).
resetxy(X, Y) :- % set a cell to dead. (It may alleady
retract(newcell(X, Y)), % be dead, but its slower if we test).
fail.
resetxy(X, Y).
setxy(X, Y) :- % Light up a cell. (It does actually
resetxy(X, Y), % kill it off first, to stop a cell
assert(newcell(X, Y)). % being lit more than once.)
valxy(X, Y, 1) :- % Get the curent cell value, as either
cell(X, Y), !. % 1 for on,
valxy(X, Y, 0) :- !. % or 0 for off.
cycle(X, MaxY, MaxX, MaxY) :- !, % print a row of '-' between boards.
print('----------------------------------------'), nl.
cycle(MaxX, Y, MaxX, MaxY) :- !, % reset X at the end of a row,
NextY is Y + 1, nl, % and print a new line.
cycle(1, NextY, MaxX, MaxY).
cycle(X, Y, MaxX, MaxY) :- !, % perform tests the cell X, Y
Xp is X + 1, Xm is X - 1,
Yp is Y + 1, Ym is Y - 1,
valxy(Xm, Ym, Value1), % get the neighbour values
valxy(X, Ym, Value2), % because we can add them up to get
valxy(Xp, Ym, Value3), % the neighbour count.
valxy(Xm, Y, Value4),
valxy(X, Y, Value),
valxy(Xp, Y, Value5),
valxy(Xm, Yp, Value6),
valxy(X, Yp, Value7),
valxy(Xp, Yp, Value8),
printcell(Value), % print cell status from source board
Count is Value1 + Value2 + Value3 + Value4 + Value5 + Value6 +
Value7 + Value8,
process(X, Y, Count, Value), !,
NextX is X + 1, !,
cycle(NextX, Y, MaxX, MaxY), !. % and loop (recurse).
printcell(0) :- print(' ').
printcell(1) :- print('o').
process(X, Y, 3, OldValue) :- % if there is 3 neighbours, give birth
setxy(X, Y),
assert(livecells).
process(X, Y, Count, OldValue) :- % kill off cell if lonely or overcrouded
( Count < 2 ; Count > 3),
resetxy(X, Y).
process(X, Y, Count, 0) :- % preserve current cell status (unlit).
resetxy(X, Y).
process(X, Y, Count, 1) :- % preserve current cell status (lit).
setxy(X, Y).
%-------------------------------------------------------------------------------
|
99.56 | Life.tpu 1+ | TOHOKU::TAYLOR | | Wed Sep 03 1986 14:18 | 415 |
|
I liked M. whyvax::buxbaum TPU version for Life, but saw
a few opportunties for bells and whistles. So, I replaced the text
literals for speed, added ^Z to exit, added a generation loop,
used the DO key for user control of the generation loop, and added
a line to show the generation count and cell counts.
So by request, here it is.
mike
!+
! M. Buxbaum 29-AUG-1986
!
! TPU Section File to play Conway's game of life
!
! Instructions:
! To compile: EDIT/TPU/NOSECTION/COMMAND=LIFE
! To execute: EDIT/TPU/SECTION=SYS$DISK:[]LIFE
!
! Arrow keys move the cursor around the screen;
! Space bar will toggle a cell on or off
! Return key will create the next life generation in the current buffer
!
! 2-SEP-1986 mjt show generation and cell count
! remove text (runs faster that way)
! add generation loop
!
!-
PROCEDURE life$neighbors
LOCAL temp, count, lc;
life$x := mark(none);
temp := current_character;
count := 0;
IF life$up(temp) <> 0 THEN ! there is something above
IF current_offset > 0 THEN
lc := 3; ! move left one
move_horizontal(-1);
ELSE
lc := 2; ! couldn't move left
ENDIF;
LOOP ! check next 3 characters (next 2?)
EXITIF lc = 0;
IF (current_character = life$x_live )
OR (current_character = life$x_dead ) THEN
count := count + 1;
ENDIF;
EXITIF life$right(temp) = 0;
lc := lc - 1;
ENDLOOP;
ENDIF;
position(life$x);
IF life$down(temp) <> 0 THEN ! try to move down
IF current_offset > 0 THEN ! try to move left
lc := 3;
move_horizontal(-1); ! ok to move left
ELSE
lc := 2; ! couldn't move left
ENDIF;
LOOP
EXITIF lc = 0; ! check next 3 (or 2) characters
IF (current_character = life$x_live)
OR (current_character = life$x_dead) THEN
count := count + 1;
ENDIF;
EXITIF life$right(temp) = 0;
lc := lc - 1;
ENDLOOP;
ENDIF;
position(life$x); ! see one character to left
IF current_offset <> 0 THEN
move_horizontal(-1);
IF (current_character = life$x_live)
OR (current_character = life$x_dead) THEN
count := count + 1;
ENDIF;
ENDIF;
position(life$x); ! see one character to the right
IF life$right(temp) <> 0 THEN
IF (current_character = life$x_live)
OR (current_character = life$x_dead) THEN
count := count + 1;
ENDIF;
ENDIF;
position(life$x);
RETURN count
ENDPROCEDURE
PROCEDURE life$up(x)
! bomb proof move_vertical(-1);
! if x is life$x_live then extend the buffer upward to make this work
LOCAL temp;
ON_ERROR
IF error = TPU$_BEGOFBUF THEN
IF x = life$x_live THEN
move_horizontal(-current_offset);
split_line;
move_vertical(-1);
copy_text(substr(life$spaces,1,temp));
RETURN 1;
ELSE
position(temp2);
RETURN 0;
ENDIF;
ENDIF;
ENDON_ERROR;
temp := current_offset;
temp2 := mark(none);
move_vertical(-1);
IF current_offset = temp THEN RETURN 1; ENDIF;
IF x = life$x_live THEN
copy_text(substr(life$spaces, 1, temp-current_offset));
RETURN 1;
ENDIF;
position(temp2);
RETURN 0;
ENDPROCEDURE
PROCEDURE life$down(x)
! bomb proof move_vertical(1)
! if x is life$x_live then extend buffer downward
LOCAL temp;
ON_ERROR
IF error = TPU$_ENDOFBUF THEN
IF x = life$x_live THEN
move_horizontal(-current_offset);
move_vertical(1);
split_line;
copy_text(substr(life$spaces,1,temp));
RETURN 1;
ELSE
position(temp2);
RETURN 0;
ENDIF;
ENDIF;
ENDON_ERROR;
temp := current_offset;
temp2 := mark(none);
move_vertical(1);
IF mark(none) = end_of(current_buffer) THEN
IF x = life$x_live THEN
copy_text(life$x_space);
RETURN 1;
ELSE
RETURN 0;
ENDIF;
ENDIF;
IF current_offset = temp THEN RETURN 1; ENDIF;
IF x = life$x_live THEN
copy_text(substr(life$spaces, 1, temp-current_offset));
RETURN 1;
ENDIF;
position(temp2);
RETURN 0;
ENDPROCEDURE;
PROCEDURE life$right(x)
! bomb proof move_horizontal(1);
! if x is life$x_live then extend buffer rightward
move_horizontal(1);
IF (mark(none) = end_of(current_buffer)) or
(current_character = life$x_null) THEN
IF x = life$x_live THEN
copy_text(life$x_space);
move_horizontal(-1);
ELSE
move_horizontal(-1);
RETURN 0;
ENDIF;
ENDIF;
RETURN 1;
ENDPROCEDURE;
PROCEDURE life$go
!+
! position cursor at EOB when looping
! position cursor at BOB when waiting for user to hit a key to continue
!
! This provides a visual que for the user to know when something
! needs to be done to keep going.
!-
local count ;
count := 0 ;
position( end_of( main_buffer ));
loop
life$do_one_generation ; ! do next generation
count := count + 1; ! increament count
exitif count >= life$x_show_gen_count ;! check if done
exitif life$x_live_count < 1 ; ! why bother, everyone is dead.
refresh ; ! display changes
endloop;
position(beginning_of(main_buffer));
ENDPROCEDURE; ! life$toggle_on_off
procedure life$do_one_generation
!+
! run one generation; take three passes...not the most efficient, but it works
!-
LOCAL number_of_neighbors;
! pass 1: clean up the edges
! IF any line ends with an life$x_live, add a space there
position(beginning_of(main_buffer));
LOOP
EXITIF mark(none) = end_of(main_buffer);
IF length(current_line) > 0 THEN
move_horizontal(length(current_line)-1);
IF current_character = life$x_live THEN
move_horizontal(1);
copy_text(life$x_space);
ENDIF;
move_horizontal(-current_offset);
ENDIF;
move_vertical(1);
ENDLOOP;
! if the first line of the buffer has life$x_live's, then insert a line of spaces
position(beginning_of(main_buffer));
IF index(current_line,life$x_live) > 0 THEN
split_line;
temp := length(current_line);
move_vertical(-1);
copy_text(substr(life$spaces,1,temp));
ENDIF;
! if the last line of the buffer has life$x_live's, then append a line of spaces
position(end_of(main_buffer));
move_vertical(-1);
IF index(current_line,life$x_live) > 0 THEN
temp := length(current_line);
move_vertical(1);
copy_text(substr(life$spaces,1,temp));
ENDIF;
! pass 2: mark all the births and deaths
position(beginning_of(main_buffer));
LOOP ! for each character
IF current_character = life$x_null THEN move_horizontal(1); ENDIF;
EXITIF mark(none) = end_of(main_buffer); ! at eob
number_of_neighbors := life$neighbors;
IF current_character = life$x_space THEN
IF number_of_neighbors = 3 THEN
copy_text(life$x_born);
move_horizontal(-1);
ENDIF;
ELSE
IF (number_of_neighbors < 2) or (number_of_neighbors > 3) THEN
copy_text(life$x_dead);
move_horizontal(-1);
ENDIF;
ENDIF;
move_horizontal(1);
ENDLOOP; ! for each character
! pass 3: cleanup B's and D's
life$x_born_count := 0 ; ! number of living cells
life$x_died_count := 0 ; ! number of cells that died
position(beginning_of(main_buffer));
LOOP
EXITIF mark(none) = end_of(main_buffer);
IF current_character = life$x_born THEN
life$x_born_count := life$x_born_count + 1 ; ! count cells born
copy_text(life$x_live);
move_horizontal(-1);
ENDIF;
IF current_character = life$x_dead THEN
copy_text(life$x_space);
life$x_died_count := life$x_died_count + 1 ; ! count cells died
move_horizontal(-1);
ENDIF;
move_horizontal(1);
ENDLOOP;
life$x_live_count := life$x_live_count + life$x_born_count
- life$x_died_count ;
life$x_gen_count := life$x_gen_count + 1 ; ! increament generation
status_line_text := " Generation: " + str( life$x_gen_count) +
" Dead cells: " + str( life$x_died_count) +
" New cells: " + str( life$x_born_count) +
" Living cells: " + str( life$x_live_count) ;
! set( status_line, main_window, reverse, status_line_text );
set( EOB_TEXT , main_buffer , status_line_text ); !
ENDPROCEDURE; ! life$do_one_generation
PROCEDURE life$toggle_on_off
! procedure bound to space key
IF current_character <> life$x_live THEN
copy_text(life$x_live);
life$x_live_count := life$x_live_count + 1 ; ! add a living cell
cursor_horizontal(-1);
ELSE
copy_text(life$x_space);
life$x_live_count := life$x_live_count - 1 ; ! kill a living cell
cursor_horizontal(-1);
ENDIF;
endprocedure ! life$do_one_generation
procedure life$ask_set_show_gen_count
!+
! Ask user how many generations to show before stopping
!-
Local prompt_msg , answer ;
prompt_msg := 'How many generations? [' + str( life$x_show_gen_count) + '] ' ;
answer := read_line( prompt_msg );
Edit( answer , trim );
if length( answer ) > 0 then
answer := int( answer ); ! make the answer numeric
else
return ; ! default is existing, why change
endif;
if answer > 0 then
life$x_show_gen_count := answer ;
else
life$x_show_gen_count := 32000 ; ! infinite
endif;
life$update_status_line;
endprocedure ! life$ask_set_show_gen_count
procedure life$update_status_line
LOCAL status_line_text ;
status_line_text := "Arrows move, <SP> toggles pixel, " +
" <CR> runs " + str( life$x_show_gen_count) +
" generation " +
"^Z exits " ;
set( status_line, main_window, reverse, status_line_text );
endprocedure ! life$update_status_line
procedure life$init_package_life
!+
! Create all the buffers and global variables
!-
LOCAL screen_length ;
! nice global variable
life$spaces := " " +
" ";
life$x_live := "X" ; ! living cell
life$x_dead := "D" ; ! dead cell
life$x_born := "B" ; ! just born cell
life$x_space := " " ; ! whitespace
life$x_null := "" ; ! null
life$x_live_count := 0 ; ! number of living cells
life$x_died_count := 0 ; ! number of cells that died
life$x_born_count := 0 ; ! number of cells born
life$x_gen_count := 0 ; ! current generation
life$x_show_gen_count := 32000 ; ! infinite
! number of generations to display before stopping
screen_length := get_info( SCREEN , "visible_length" );
! main buffer, window
main_buffer := create_buffer("main buffer");
main_window := create_window( 1, screen_length , on );
life$update_status_line ;
set( EOB_TEXT , main_buffer , "" ); ! no End of buffer text
set( no_write , main_buffer , ON ); ! do not write on exit/quiting
map( main_window, main_buffer );
! do not create a message buffer
! causes tpu error messages to be sent to the screen
! I accept that
! prompt area
set ( prompt_area , screen_length , 1 , reverse ); !
! cursor starting pos
position( beginning_of( main_buffer ));
copy_text( life$x_space ); ! errors result if start with an empty buffer
set( overstrike, main_buffer );
endprocedure ! life$init_package_life
PROCEDURE tpu$init_procedure
life$init_package_life ;
ENDPROCEDURE;
! define the keys
set(self_insert, "tpu$key_map_list", off);
define_key( "life$toggle_on_off", key_name(" "));
define_key( "life$go", ret_key);
define_key( "cursor_horizontal(1)", right);
define_key( "cursor_horizontal(-1)", left);
define_key( "cursor_vertical(1)", down);
define_key( "cursor_vertical(-1)", up);
define_key( "quit", ctrl_z_key );
define_key( "life$ask_set_show_gen_count", DO );
! commands to build section file
save("life");
quit;
|
99.57 | Ok, Ok, the trivial Ada version ... | TLE::MEIER | Bill Meier | Wed Sep 03 1986 20:34 | 131 |
| -- Ok, here is the "trivial" version, basically directly translated from the
-- Pascal version. No surprises, no great demostration of Ada features ...
-- Even this can be "cleaned up" using more Ada features, but I didn't bother
-- (actually someone else provided this translation, but I'm posting it)
--
with TEXT_IO; use TEXT_IO;
with INTEGER_TEXT_IO; use INTEGER_TEXT_IO;
procedure LIFE is
EMPTY: constant := 0;
BLOT: constant := 1;
X_LIMIT: constant := 40;
Y_LIMIT: constant := 20;
subtype ELEMENT is INTEGER range EMPTY..BLOT;
subtype X_RANGE is INTEGER range 0..X_LIMIT+1;
subtype Y_RANGE is INTEGER range 0..Y_LIMIT+1;
subtype LEGAL_X_RANGE is INTEGER range 1..X_LIMIT;
subtype LEGAL_Y_RANGE is INTEGER range 1..Y_LIMIT;
type BOARD_TYPE is array (X_RANGE, Y_RANGE) of ELEMENT;
LAST_GENERATION : INTEGER range 1..INTEGER'LAST;
BOARD : BOARD_TYPE;
procedure INITIALIZE (BOARD : out BOARD_TYPE) is
X : INTEGER;
Y : INTEGER;
begin
BOARD := (others => (others => EMPTY));
PUT_LINE ("To bring a cell to life, type the X and Y coordinates");
PUT_LINE ("separated by a space, 0 0 to end. Range is 40 x 20.");
READ_COORDINATES:
loop
PUT ("X Y> ");
begin
GET (X);
GET (Y);
exception
when others =>
X := 0;
Y := 0;
end;
SKIP_LINE;
if (X = 0) and then (Y = 0) then
exit READ_COORDINATES;
end if;
if ( X in LEGAL_X_RANGE and then
Y in LEGAL_Y_RANGE) then
BOARD (X,Y) := BLOT;
else
PUT_LINE ("Out of range.");
end if;
end loop READ_COORDINATES;
end INITIALIZE;
procedure PUT (BOARD : BOARD_TYPE) is
begin
ROWS:
for Y in LEGAL_Y_RANGE loop
COLUMNS:
for X in LEGAL_X_RANGE loop
case BOARD(X,Y) is
when EMPTY =>
PUT (". ");
when BLOT =>
PUT ("O ");
end case;
end loop COLUMNS;
NEW_LINE;
end loop ROWS;
NEW_LINE;
end PUT;
procedure NEW_GENERATION (NEW_BOARD : in out BOARD_TYPE) is
TOTAL : INTEGER;
OLD_BOARD : BOARD_TYPE;
begin
OLD_BOARD := NEW_BOARD;
for X in LEGAL_X_RANGE loop
for Y in LEGAL_Y_RANGE loop
TOTAL := OLD_BOARD (X-1,Y+1) + OLD_BOARD (X,Y+1) + OLD_BOARD (X+1,Y+1)
+ OLD_BOARD (X-1,Y) + OLD_BOARD (X+1,Y)
+ OLD_BOARD (X-1,Y-1) + OLD_BOARD (X,Y-1) + OLD_BOARD (X+1,Y-1);
if (TOTAL <= 1) or else (TOTAL >= 4) then
NEW_BOARD (X,Y) := EMPTY;
elsif (TOTAL = 3) then
NEW_BOARD (X,Y) := BLOT;
end if;
end loop;
end loop;
end NEW_GENERATION;
begin
PUT_LINE ("How many generations do you want?");
READ_GENERATIONS:
loop
begin
PUT ("Generations> ");
GET (LAST_GENERATION);
SKIP_LINE;
exit READ_GENERATIONS;
exception
when END_ERROR =>
raise;
when others =>
SKIP_LINE;
PUT_LINE ("Please enter a number greater than 0.");
end;
end loop READ_GENERATIONS;
NEW_LINE;
INITIALIZE (BOARD);
PUT_LINE ("Starting configuration:");
PUT (BOARD);
for GENERATION in 1..LAST_GENERATION loop
NEW_GENERATION (BOARD);
PUT ("Generation # ");
PUT (GENERATION);
NEW_LINE;
PUT (BOARD);
end loop;
exception
when END_ERROR =>
null;
end LIFE;
|
99.58 | Yet another TPU version (layered on EVE/NOTES) | DSSDEV::TANNENBAUM | TPU Developer | Wed Sep 03 1986 22:12 | 270 |
| !
! The following procedures implement the Life simulation. They work by
! using each character in the buffer to store the intermediate states
! of the simulation; each "dead" space with a "live" neighbor is
! incremented throught the alphabet, starting with "a", and each
! live space is incremented through the numbers, starting from "0".
! When all of the spaces have been evaluated, each previously dead
! space that now contains a "c" (had 3 live neighbors) becomes alive,
! and each previously live space that now contains either a "3" or a "4"
! remains alive. All other cells become dead.
!
! This simulation layers easily on the EVE editing interface. Since NOTES
! is layered on TPU and EVE, you can run it within NOTES! Give the
! commands:
! EXTRACT/NOHEADER/BUFFER game
! EVE BUFFER game
! <DO>EXTEND *
! <DO>BUFFER life
!
! extract the game into a buffer, compile the game and switch to an
! empty buffer. Use EVE to create the initial configuration. Any
! character other than a space will be considered a live cell. Note
! that TABs don't count as spaces, so don't use any! Now enter the
! command
! <DO>life
! and answer the question about the maximum numbers of generations, and
! watch it go.
!
PROCEDURE go_horizontal (amount)
LOCAL
offset;
offset := CURRENT_OFFSET;
!
! For now we can't go beyond the beginning of the line
!
IF (offset = 0) AND (amount < 0)
THEN
RETURN 0;
ENDIF;
!
! If we're going beyond the end of the line, add a space
!
IF (offset + 1 = LENGTH (CURRENT_LINE)) AND (amount > 0)
THEN
MOVE_HORIZONTAL (1);
COPY_TEXT (" ");
MOVE_HORIZONTAL (-1);
ELSE
MOVE_HORIZONTAL (amount);
ENDIF;
RETURN 1;
ENDPROCEDURE; ! go_horizontal
PROCEDURE go_vertical (amount)
LOCAL
offset;
ON_ERROR
IF ERROR <> TPU$_NOEOBSTR
THEN
!
! If at the end of the buffer, add a line
!
IF ERROR = TPU$_ENDOFBUF
THEN
POSITION (SEARCH (LINE_END, FORWARD));
SPLIT_LINE;
ELSE
!
! If at the beginning of the buffer, add a line
!
IF ERROR = TPU$_BEGOFBUF
THEN
POSITION (SEARCH (LINE_BEGIN, REVERSE));
SPLIT_LINE;
MOVE_VERTICAL (-1);
ELSE
!
! Whatever it is that happened, we can't deal with it
!
ABORT;
ENDIF;
ENDIF;
ENDIF;
ENDON_ERROR;
!
! Save where we are
!
offset := CURRENT_OFFSET;
MOVE_VERTICAL (amount);
!
! If we're no longer there, add the necessary spaces
!
IF (offset <> CURRENT_OFFSET) OR (offset = LENGTH (CURRENT_LINE))
THEN
offset := offset - CURRENT_OFFSET;
COPY_TEXT (FAO ("!#* ", offset + 1));
MOVE_HORIZONTAL (-1);
ENDIF;
ENDPROCEDURE; ! go_vertical
PROCEDURE evaluate_cell (cell_range)
!
! Evaluate the region around a cell
!
LOCAL
cell_mark;
!
! Start by dealing with the current row
!
cell_mark := BEGINNING_OF (cell_range);
evaluate_row (cell_mark);
!
! Deal with the preceding row, if we have one
!
go_vertical (-1);
evaluate_row (MARK (NONE));
POSITION (cell_mark);
!
! Deal with the following row, if we have one
!
go_vertical (1);
evaluate_row (MARK (NONE));
POSITION (cell_mark);
ENDPROCEDURE; ! evaluate_cell
PROCEDURE evaluate_row (cell_mark)
!
! Evaluate a single row
!
LOCAL
trans_range,
end_mark,
start_mark,
status;
status := go_horizontal (-1);
start_mark := MARK (REVERSE);
IF status
THEN
POSITION (cell_mark);
ENDIF;
status := go_horizontal (1);
end_mark := MARK (REVERSE);
IF status
THEN
POSITION (cell_mark);
ENDIF;
trans_range := CREATE_RANGE (start_mark, end_mark, reverse);
TRANSLATE (trans_range,
life_translate_out,
life_translate_in);
ENDPROCEDURE; ! evaluate_row
PROCEDURE init_life (max_gen)
LOCAL
counter,
in_string,
out_string;
!
! Build the input string
!
counter := 0;
in_string := '';
LOOP
in_string := in_string + ASCII (counter);
counter := counter + 1;
EXITIF counter > 255;
ENDLOOP;
!
! Build the output string
!
counter := 0;
out_string := '';
LOOP
CASE counter FROM 0 TO 255
[32]:
out_string := out_string + ' ';
[INRANGE]:
out_string := out_string + '*';
ENDCASE;
counter := counter + 1;
EXITIF counter > 255;
ENDLOOP;
!
! Translate the buffer contents
!
TRANSLATE (CURRENT_BUFFER, out_string, in_string);
!
! Initialize various strings
!
life_status := " LIFE Generation: !UL";
life_translate_in := ' abcdefg012345678';
life_translate_out := 'abcdefgh123456789';
!
! Get the maximum generation count
!
SET (STATUS_LINE, CURRENT_WINDOW, REVERSE, FAO (life_status, 0));
UPDATE (CURRENT_WINDOW);
max_gen := READ_LINE ("Number of Generations: ");
max_gen := INT (max_gen);
ENDPROCEDURE; ! init_life
PROCEDURE eve_life
!
! This procedure implements the Life "game". It works by using the buffer
! to store the state of the simulation, as we evaluate each cell.
!
LOCAL
cell_pattern,
cell_range,
current_gen,
max_gen;
!
! Eat the "No string found" message
!
ON_ERROR
IF ERROR <> TPU$_STRNOTFOUND
THEN
ABORT
ENDIF;
ENDON_ERROR;
current_gen := 0;
cell_pattern := ANY ('0123456789');
init_life (max_gen);
LOOP
EXITIF current_gen >= max_gen;
current_gen := current_gen + 1;
TRANSLATE (CURRENT_BUFFER, '0', '*'); ! Prepare to evaluate the buffer
POSITION (BEGINNING_OF (CURRENT_BUFFER));
LOOP
cell_range := SEARCH (cell_pattern, FORWARD);
EXITIF cell_range = 0;
POSITION (cell_range);
evaluate_cell (cell_range);
POSITION (cell_range);
go_horizontal (1);
ENDLOOP;
POSITION (BEGINNING_OF (CURRENT_BUFFER));
TRANSLATE (CURRENT_BUFFER, ! Prepare to display the buffer
' * ** ',
' abcdefgh0123456789');
SET (STATUS_LINE, CURRENT_WINDOW, REVERSE,
FAO (life_status, current_gen));
UPDATE (CURRENT_WINDOW);
ENDLOOP;
MESSAGE ("Simulation Completed");
ENDPROCEDURE; ! eve_life
|
99.60 | More efficent TPU version | ERLANG::WHALEN | Nothing is stranger than life | Thu Sep 04 1986 00:08 | 432 |
| Since I'm a TPU hacker from back in the days when it was called
XYZ, I was interesting in trying the TPU version. Naturally I wasn't
quite happy with it. I've made a few changes to improve its efficency,
here it is.
!+
! M. Buxbaum 29-AUG-1986
!
! TPU Section File to play Conway's game of life
!
! Instructions:
! To compile: EDIT/TPU/NOSECTION/COMMAND=LIFE
! To execute: EDIT/TPU/SECTION=SYS$DISK:[]LIFE
!
! Arrow keys move the cursor around the screen;
! Space bar will toggle a cell on or off
! Return key will create the next life generation in the current buffer
!
! 2-SEP-1986 mjt show generation and cell count
! remove text (runs faster that way)
! add generation loop
!
!-
PROCEDURE life$neighbors
LOCAL temp, count, lc;
life$x := mark(none);
temp := current_character;
count := 0;
IF life$up(temp) <> 0 THEN ! there is something above
IF current_offset > 0 THEN
lc := 3; ! move left one
move_horizontal(-1);
ELSE
lc := 2; ! couldn't move left
ENDIF;
LOOP ! check next 3 characters (next 2?)
EXITIF lc = 0;
IF (current_character = life$x_live )
OR (current_character = life$x_dead ) THEN
count := count + 1;
ENDIF;
EXITIF life$right(temp) = 0;
lc := lc - 1;
ENDLOOP;
ENDIF;
position(life$x);
IF life$down(temp) <> 0 THEN ! try to move down
IF current_offset > 0 THEN ! try to move left
lc := 3;
move_horizontal(-1); ! ok to move left
ELSE
lc := 2; ! couldn't move left
ENDIF;
LOOP
EXITIF lc = 0; ! check next 3 (or 2) characters
IF (current_character = life$x_live)
OR (current_character = life$x_dead) THEN
count := count + 1;
ENDIF;
EXITIF life$right(temp) = 0;
lc := lc - 1;
ENDLOOP;
ENDIF;
position(life$x); ! see one character to left
IF current_offset <> 0 THEN
move_horizontal(-1);
IF (current_character = life$x_live)
OR (current_character = life$x_dead) THEN
count := count + 1;
ENDIF;
ENDIF;
position(life$x); ! see one character to the right
IF life$right(temp) <> 0 THEN
IF (current_character = life$x_live)
OR (current_character = life$x_dead) THEN
count := count + 1;
ENDIF;
ENDIF;
position(life$x);
RETURN count
ENDPROCEDURE
PROCEDURE life$up(x)
! bomb proof move_vertical(-1);
! if x is life$x_live then extend the buffer upward to make this work
LOCAL
temp,
temp2;
ON_ERROR
IF error = TPU$_BEGOFBUF THEN
IF x = life$x_live THEN
move_horizontal(-current_offset);
split_line;
move_vertical(-1);
copy_text(substr(life$spaces,1,temp));
RETURN 1;
ELSE
position(temp2);
RETURN 0;
ENDIF;
ENDIF;
ENDON_ERROR;
temp := CURRENT_OFFSET;
temp2 := MARK(NONE);
MOVE_VERTICAL(-1);
IF CURRENT_OFFSET = temp THEN RETURN 1; ENDIF;
IF x = life$x_live THEN
COPY_TEXT(SUBSTR(life$spaces, 1, temp - CURRENT_OFFSET));
RETURN 1;
ENDIF;
POSITION(temp2);
RETURN 0;
ENDPROCEDURE
PROCEDURE life$down(x)
! bomb proof move_vertical(1)
! if x is life$x_live then extend buffer downward
LOCAL temp;
ON_ERROR
IF error = TPU$_ENDOFBUF THEN
IF x = life$x_live THEN
move_horizontal(-current_offset);
move_vertical(1);
split_line;
copy_text(substr(life$spaces,1,temp));
RETURN 1;
ELSE
position(temp2);
RETURN 0;
ENDIF;
ENDIF;
ENDON_ERROR;
temp := CURRENT_OFFSET;
temp2 := MARK(NONE);
MOVE_VERTICAL(1);
IF MARK(NONE) = END_OF(CURRENT_BUFFER) THEN
IF x = life$x_live THEN
COPY_TEXT(life$x_space);
RETURN 1;
ELSE
RETURN 0;
ENDIF;
ENDIF;
IF CURRENT_OFFSET = temp THEN RETURN 1; ENDIF;
IF x = life$x_live THEN
COPY_TEXT(SUBSTR(life$spaces, 1, temp-CURRENT_OFFSET));
RETURN 1;
ENDIF;
POSITION(temp2);
RETURN 0;
ENDPROCEDURE;
PROCEDURE life$right(x)
! bomb proof move_horizontal(1);
! if x is life$x_live then extend buffer rightward
MOVE_HORIZONTAL(1);
IF (mark(none) = end_of(current_buffer)) or
(current_character = life$x_null) THEN
IF x = life$x_live THEN
copy_text(life$x_space);
move_horizontal(-1);
ELSE
move_horizontal(-1);
RETURN 0;
ENDIF;
ENDIF;
RETURN 1;
ENDPROCEDURE;
PROCEDURE life$go
!+
! position cursor at EOB when looping
! position cursor at BOB when waiting for user to hit a key to continue
!
! This provides a visual que for the user to know when something
! needs to be done to keep going.
!-
local count ;
count := 0 ;
position( end_of( main_buffer ));
loop
life$do_one_generation ; ! do next generation
count := count + 1; ! increament count
exitif count >= life$x_show_gen_count ;! check if done
exitif life$x_live_count < 1 ; ! why bother, everyone is dead.
update(current_window); ! display changes
endloop;
POSITION(BEGINNING_OF(main_buffer));
ENDPROCEDURE; ! life$toggle_on_off
PROCEDURE life$do_one_generation
!+
! run one generation; take three passes...not the most efficient, but it works
!-
LOCAL
number_of_neighbors,
end_line_live,
occupied_cell,
search_result;
ON_ERROR
ENDON_ERROR;
end_line_live := life$x_live & LINE_END;
occupied_cell := '' & (life$x_live | life$x_born | life$x_dead);
! pass 1: clean up the edges
! IF any line ends with an life$x_live, add a space there
POSITION(BEGINNING_OF(main_buffer));
LOOP
search_result := SEARCH(end_line_live, FORWARD, NO_EXACT);
EXITIF search_result = 0;
POSITION(BEGINNING_OF(search_result));
MOVE_HORIZONTAL(1);
COPY_TEXT(life$x_space);
MOVE_HORIZONTAL(-CURRENT_OFFSET);
MOVE_VERTICAL(1);
ENDLOOP;
!
! if the first line of the buffer has life$x_live's, then insert a line of
! spaces
!
POSITION(BEGINNING_OF(main_buffer));
IF INDEX(CURRENT_LINE,life$x_live) > 0 THEN
SPLIT_LINE;
temp := LENGTH(CURRENT_LINE);
MOVE_VERTICAL(-1);
COPY_TEXT(SUBSTR(life$spaces,1,temp));
ENDIF;
! if the last line of the buffer has life$x_live's, then append a line of spaces
POSITION(END_OF(main_buffer));
MOVE_VERTICAL(-1);
IF INDEX(CURRENT_LINE,life$x_live) > 0 THEN
temp := LENGTH(CURRENT_LINE);
MOVE_VERTICAL(1);
COPY_TEXT(SUBSTR(life$spaces,1,temp));
ENDIF;
! pass 2: mark all the births and deaths
POSITION(BEGINNING_OF(main_buffer));
POSITION(SEARCH(life$x_live, FORWARD, NO_EXACT));
MOVE_HORIZONTAL(-CURRENT_OFFSET);
MOVE_VERTICAL(-2);
LOOP ! for each character
IF CURRENT_CHARACTER = life$x_null THEN MOVE_HORIZONTAL(1); ENDIF;
EXITIF MARK(NONE) = END_OF(main_buffer); ! at eob
number_of_neighbors := life$neighbors;
IF CURRENT_CHARACTER = life$x_space THEN
IF number_of_neighbors = 3 THEN
copy_text(life$x_born);
move_horizontal(-1);
ENDIF;
ELSE
IF (number_of_neighbors < 2) or (number_of_neighbors > 3) THEN
copy_text(life$x_dead);
move_horizontal(-1);
ENDIF;
ENDIF;
move_horizontal(1);
ENDLOOP; ! for each character
! pass 3: cleanup B's and D's
life$x_born_count := 0 ; ! number of living cells
life$x_died_count := 0 ; ! number of cells that died
POSITION(BEGINNING_OF(main_buffer));
search_result := SEARCH(occupied_cell, FORWARD, NO_EXACT);
IF search_result = 0
THEN
life$x_live_count := 0;
RETURN;
ENDIF;
POSITION(BEGINNING_OF(search_result));
LOOP
EXITIF mark(none) = end_of(main_buffer);
IF current_character = life$x_born THEN
life$x_born_count := life$x_born_count + 1 ; ! count cells born
copy_text(life$x_live);
move_horizontal(-1);
ENDIF;
IF current_character = life$x_dead THEN
copy_text(life$x_space);
life$x_died_count := life$x_died_count + 1 ; ! count cells died
move_horizontal(-1);
ENDIF;
move_horizontal(1);
ENDLOOP;
life$x_live_count := life$x_live_count + life$x_born_count
- life$x_died_count ;
life$x_gen_count := life$x_gen_count + 1 ; ! increament generation
status_line_text := " Generation: " + str( life$x_gen_count) +
" Dead cells: " + str( life$x_died_count) +
" New cells: " + str( life$x_born_count) +
" Living cells: " + str( life$x_live_count) ;
set( status_line, main_window, reverse, status_line_text );
! set( EOB_TEXT , main_buffer , status_line_text ); !
ENDPROCEDURE; ! life$do_one_generation
PROCEDURE life$toggle_on_off
! procedure bound to space key
IF current_character <> life$x_live THEN
copy_text(life$x_live);
life$x_live_count := life$x_live_count + 1 ; ! add a living cell
cursor_horizontal(-1);
ELSE
copy_text(life$x_space);
life$x_live_count := life$x_live_count - 1 ; ! kill a living cell
cursor_horizontal(-1);
ENDIF;
endprocedure ! life$toggle_on_off
procedure life$ask_set_show_gen_count
!+
! Ask user how many generations to show before stopping
!-
Local prompt_msg , answer ;
prompt_msg := 'How many generations? [' + str( life$x_show_gen_count) + '] ' ;
answer := read_line( prompt_msg );
Edit( answer , trim );
if length( answer ) > 0 then
answer := int( answer ); ! make the answer numeric
else
return ; ! default is existing, why change
endif;
if answer > 0 then
life$x_show_gen_count := answer ;
else
life$x_show_gen_count := 32000 ; ! infinite
endif;
life$update_status_line;
endprocedure ! life$ask_set_show_gen_count
procedure life$update_status_line
LOCAL status_line_text ;
status_line_text := "Arrows move, <SP> toggles pixel, " +
" <CR> runs " + str( life$x_show_gen_count) +
" generation " +
"^Z exits " ;
set( status_line, main_window, reverse, status_line_text );
endprocedure ! life$update_status_line
procedure life$init_package_life
!+
! Create all the buffers and global variables
!-
LOCAL screen_length ;
! nice global variable
life$spaces := " " +
" ";
life$x_live := "X" ; ! living cell
life$x_dead := "D" ; ! dead cell
life$x_born := "B" ; ! just born cell
life$x_space := " " ; ! whitespace
life$x_null := "" ; ! null
life$x_live_count := 0 ; ! number of living cells
life$x_died_count := 0 ; ! number of cells that died
life$x_born_count := 0 ; ! number of cells born
life$x_gen_count := 0 ; ! current generation
life$x_show_gen_count := 32000 ; ! infinite
! number of generations to display before stopping
screen_length := get_info( SCREEN , "visible_length" );
! main buffer, window
main_buffer := create_buffer("main buffer");
main_window := create_window( 1, screen_length , on );
life$update_status_line ;
set( EOB_TEXT , main_buffer , "" ); ! no End of buffer text
set( no_write , main_buffer , ON ); ! do not write on exit/quiting
map( main_window, main_buffer );
! do not create a message buffer
! causes tpu error messages to be sent to the screen
! I accept that
! prompt area
set ( prompt_area , screen_length , 1 , reverse ); !
! cursor starting pos
position( beginning_of( main_buffer ));
copy_text( life$x_space ); ! errors result if start with an empty buffer
set( overstrike, main_buffer );
endprocedure ! life$init_package_life
PROCEDURE tpu$init_procedure
life$init_package_life ;
ENDPROCEDURE;
! define the keys
set(self_insert, "tpu$key_map_list", off);
define_key( "life$toggle_on_off", key_name(" "));
define_key( "life$go", ret_key);
define_key( "cursor_horizontal(1)", right);
define_key( "cursor_horizontal(-1)", left);
define_key( "cursor_vertical(1)", down);
define_key( "cursor_vertical(-1)", up);
define_key( "quit", f10);
define_key( "quit", ctrl_z_key );
define_key( "life$ask_set_show_gen_count", DO );
! commands to build section file
save("life");
quit;
|
99.61 | Fix for 99.58 instructions | DSSDEV::TANNENBAUM | TPU Developer | Thu Sep 04 1986 00:13 | 12 |
| The instructions on how to extract the version of life int 99.58
are slightly wrong (serves me right for making a last minute change
to the documentation!). The NOTES command to extract the note into
the buffer should be
EXTRACT/BUFFER/NOHEADER game
If you put the /NOHEADER qualifier before the /BUFFER qualifier,
it gets ignored, and TPU will (rightfully) not compile the program
correctly.
- Barry
|
99.62 | Ada = VAXELN Ada | QUARK::LIONEL | Reality is frequently inaccurate | Thu Sep 04 1986 01:02 | 4 |
| By the way, the Ada version in .57 also suffices for VAXELN Ada.
If you want a physical image saveset of an RX50 with this program
on it to boot on your MicroVAX, let me know and I'll create one.
Steve
|
99.63 | Doesn't hurt to ask... | JUNIPR::DMCLURE | Vaxnote your way to ubiquity | Thu Sep 04 1986 14:43 | 5 |
| re: .62,
...while you're at it, can you also get me a Microvax?
-davo
|
99.64 | Real Programmers (Re)Unite! | FSTVAX::DICKINSON | doug dickinson | Sat Sep 06 1986 16:22 | 379 |
| this WAS note #64 before davo pointed out some errors, i
quickly deleted it, corrected it, but don't know if it will
be 64 now or not, so i'll put my apologies up front...there
is a good reason real programmers don't write documentation:
if i hadn't written it, it would have been correct. as it is,
it is rife with errors...but not no more. unless someone else
finds one...it is correcto now.
ok, even though i can't help but feel that "davo" has an ulterior
motive in asking for all these programs (like maybe the assignment
in the computer science class that he's taking was "write life in
as many different (and really far-out, if possible) languages as
you can, winner gets an "A"), (:-)) nonetheless, i shall make
my contribution in the ONLY programming language worth programming
in (and peter thought it was teco, huh? (hi peter)) -- VAX MACRO.
OR maybe i felt that since i've copied about 6 of these very clever
programs out of here, i should at least put one in!
this program was designed as a demo of smg, however i managed to work
in some bit manipulation instructions, as well as illustrations of
using simple rms (always the teacher). so, no, it doesn't use the most
elegant algorithms, but it's fast enough for my taste. this doesn't
follow all the specs for this "competition", but then, who has? (you
get the impression that i'm covering my tracks here, in hopes that that
person who was flaming on and on about his/her cutesy-little high
school program that runs so much better than any of these won't say
anything more -- i'm tired of his tirades). this program just runs till
there are 0 cells alive, or till you get sick up and fed with it and
hit either ^C or ^Z (^Y will also stop it, but i didn't have to tell
you that, did i?).
in addition to the program (and don't tell me you don't have the macro
assembler), you'll need two files, which you'll find appended to the
macro program within this note. (so don't just extract/nohead, and
assemble, you've got to think a little (get it? /nohead--think?)). the
first file is the rules...i got tired of playing with conway's rules of
who lives and who dies, and i also got tired of re-assembling every
time i changed them, so just change the file...directions are in the
file. also in the rules is the specifications of which characters to
use in the display for dead and alive cells. if you don't put them in,
the characters used are "A" and "H", not for "alive and
happily-departed", but for "AssH*le, you forget to specify the
characters."
the second file is the initial layout of the population. the one
i provide here is called grand-teton, for obvious reasons. i use
it because it lasts awhile while i'm testing the program.
then you need logical names as described in the rules file.
and now to the three files:
(btw - i only comment the obvious lines, the others are up to you'all
to figure out).
%-------------------------------------------------------------------------%
life.mar
%-------------------------------------------------------------------------%
.title life play conway's game of life
.macro check_status code=r0, ?go
blbs code, go
pushl code
calls #1, g^lib$stop
go:
.endm check_status
.macro smg routine,p1,p2,p3,p4,p5,p6,p7,p8,p9,p10
.narg ...num_param
.irp arg,<p10,p9,p8,p7,p6,p5,p4,p3,p2,p1>
.iif not_blank, arg, pushal arg
.endr
calls #<...num_param - 1>,g^smg$'routine'
check_status
.endm smg
.psect sym_def,rd,nowrt,noexe
$smgdef ;get those smg symbols
width = 60 ;board width in bits
height = 20 ;board height in bits
max_lines = 24
max_cols = 80
board_size = <<width+2>*<height+2>+7>/8 ;#bytes in the board
.psect ronly,rd,nowrt,noexe
o_gen: .ascid /Gen: !3UL, Alive: !5UL/
trans: .byte 0,1,1,2,1,2,2,3 ;neighbor translation table
s_line: .long max_lines - height + 1 / 2
s_col: .long max_cols - width / 2
gen_line: .long 1
gen_col: .long 1
lines: .long height
cols: .long width
attrs: .long smg$m_border
.psect rwdata,rd,wrt,noexe,long
birth_death: .blkb 18 ;where the rules go
o_char: .ascii /AH/ ;don't forget to specify these!
.align long ;this might speed it up
board: .blkb board_size ;reserve space for the board
new_board: .blkb board_size ;reserve space for the board
.align long
gen: .blkl 1 ;count of generations
wanna_stop: .blkl 1
position: .long smg$k_top
clr_at_end: .long 1
to_wait: .float 1.5
o_len: .blkw 1
orig_buf_len = 40
o_str: .blkb orig_buf_len
o_buf: .word orig_buf_len
.word 0
.address o_str
vd_id: .blkl 1
out_pbd_id: .blkl 1
; zyxwvutsrqponmlkjihgfedcba
cc_mask: .long ^b00000100000000000000000000001000
o_line: .blkl 1
o_col: .blkl 1
o_text: .ascid / /
.align long
init_fab: $fab fnm=<life-init>
init_rab: $rab fab=init_fab,-
ubf=init_line,-
usz=init_line_len
init_line: .blkb max_cols
init_line_len: .long max_cols
rules_fab: $fab fnm=<life-rules>
rules_rab: $rab fab=rules_fab,-
ubf=rules_line,-
usz=rules_line_len
rules_line: .blkb max_cols
rules_line_len: .long max_cols
.psect rocode,rd,nowrt,exe
.entry life,0
get_rules:
$open fab=rules_fab
check_status
$connect rab=rules_rab
check_status
10$: $get rab=rules_rab
blbc r0,30$
clrl r1
cmpb rules_line,#^a/C/ ;see if it's character definition
bneq 15$ ;if not, check dead
movw rules_line+1,o_char ;just shove them in
brb 10$ ;and go back for more
15$: cmpb rules_line,#^a/D/ ;see if it's a dead one
bneq 20$ ;else, check alive
subb3 #^x30,rules_line+1,r1 ;get the number of neighbors
brb 25$
20$:
cmpb rules_line,#^a/A/ ;see if alive
bneq 10$ ;if not, just ignore it
subb3 #^x30-9,rules_line+1,r1 ;get offset for alive ones
25$: movb #1,birth_death[r1]
brb 10$
30$:
$close fab=rules_fab
check_status
clrl gen ;set the generation number to zero.
get_init:
$open fab=init_fab
check_status
$connect rab=init_rab
check_status
30$: smg create_pasteboard, out_pbd_id
smg set_out_of_band_asts, out_pbd_id, cc_mask, band_ast
smg create_virtual_display, lines, cols, vd_id, attrs
smg paste_virtual_display, vd_id, out_pbd_id, s_line, s_col
movab new_board,r3
movab board,r4
print_the_dead:
smg begin_display_update, vd_id ;batch screen updating
clrl r9 ;r9=0 means dead
movl #1,r6
10$: movl #1,r7
15$: bsbw print_it ;just put something there
aobleq #width,r7,15$ ;for j = 1 to width
aobleq #height,r6,10$ ;for i = 1 to height
smg end_display_update, vd_id ;and display the batched stuff
print_first:
clrl r5 ;no one living yet
smg begin_display_update, vd_id ;batch screen updating
movl #1,r9 ;all the cells we'll see here are alive
movl #1,r6 ;start r6 at 1
10$:
$get rab=init_rab ;read a record from the initial settings
blbc r0,30$ ;if eof, goto 30$
movzwl init_rab+rab$w_rsz,r10 ;r10 is len of line read
decl r10 ;don't count the terminator
cmpl r10,#width-1 ;see if line is longer than width-1
bleq 15$ ;if not, no problem
movl #width-1,r10 ;if so, just set it equal to width-1
15$:
cmpb init_line[r10],#^a/*/ ;see if this is an alive cell
bneq 20$ ;if not, goto 20$
incl r5 ;increase number of living people
addl3 #1,r10,r7
mull3 r6,#width+2,r8 ;computing "two dimensional" index
addl2 r7,r8 ;r8 = cell to check
bbss r8,(r4),20$ ;stick the new cell into the board
bsbw print_it ;update the contents of the screen
20$:
sobgeq r10,15$ ;for r10 = line-len to 0 step -1
aobleq #height,r6,10$ ;for r6 = 1 to height
30$: $close fab=init_fab ;finally, close the file
$fao_s ctrstr=o_gen, outlen=o_len, outbuf=o_buf, -
p1=gen, p2=r5
movw o_len,o_buf
smg label_border, vd_id, o_buf, position
movw #orig_buf_len,o_buf
smg end_display_update, vd_id ;and display the batched stuff
generation:
smg begin_display_update, vd_id ;batch the updates
incl gen ;inc the generation number
clrl r5 ;set the number of living people to zero
movl #1,r6 ;start r6 (i) at 1
10$: movl #1,r7 ;start r7 (j) at 1
15$: mull3 r6,#width+2,r8 ;computing "two dimensional" index
addl2 r7,r8 ;r8 = cell to check
subl3 #width+3,r8,r10 ;r10 = position to start extracting
clrl r11 ;r11 will be count of neighbors
movl #3,r1 ;go through next loop 3 times
17$: extzv r10,#3,(r4),r9 ;r9 contains the bits we need to check
beql 20$ ;nobody alive here
addb2 trans[r9],r11 ;r11 = accumulated number of neighbors
20$: addl2 #width+2,r10 ;get the position of the next neighbor
sobgtr r1,17$ ;for r1 = 3 to 0 step -1
clrl r10 ;presume dead
bbc r8,(r4),30$ ;check our "cell of the moment"
incl r10 ;indicate it's alive
addl2 #8,r11 ;offset for aliveness into birth_death table
30$:
movb birth_death[r11],r9 ;r9 is 0/1 for dead/alive
beql 50$ ;if dead, goto 50$
incl r5 ;add 1 to number of living people
50$:
insv r9,r8,#1,(r3) ;stick new cell into board
cmpl r9,r10 ;see if we need to update the screen
beql 60$ ;if not, don't
bsbw print_it ;update the contents of the screen
60$: aobleq #width,r7,15$ ;for r7 = 1 to width
aobleq #height,r6,10$ ;for r6 = 1 to height
65$: $fao_s ctrstr=o_gen, outlen=o_len, outbuf=o_buf, -
p1=gen, p2=r5
movw o_len,o_buf
smg label_border, vd_id, o_buf, position
movw #orig_buf_len,o_buf
smg end_display_update, vd_id ;display the changes
tstl r5 ;if there are no living people
beql stop_it ;then we stop
tstb wanna_stop ;or if the user hit a control char
bgtr stop_it ;also stop.
movl r4,r0 ;switch boards
movl r3,r4
movl r0,r3
brw generation ;then go back for the next generation
stop_it:
pushaf to_wait
calls #1,g^lib$wait
smg delete_pasteboard, out_pbd_id, clr_at_end
check_status
movl #1,r0
ret ;we get here if 0 are living, or ^C
print_it:
movq r6,o_line ;big assumptions here!
movab o_char[r9],o_text+4 ;print a dead or alive cell
smg put_chars, vd_id, o_text, o_line, o_col
rsb
.entry band_ast,0 ;ast routine for out-of-band chars
movb #1, wanna_stop ;just set a flag to be polled in
ret ;main loop, and leave
.end life
%------------------------------------------------------------------------%
quite-heavily-commented-rules.life
%------------------------------------------------------------------------%
!3 files are needed to execute the life program,
!1: this file (which contains the rules)!
!2: a file with the initial setup in it. must consist of spaces and asterisks
!(*)
! space = dead, asterisk = alive (best not to use tabs!!!)
!3: the program, stupid!
!
!then define two logical names:
!life-rules points to this file,
!life-init points to the initial setup in it.
!
!the format of this file is:
!Lines which begin with anything except A or D (must be capitalized)
!are considered comments, and are ignored. Only the first 2 or 3 characters
!on a non-comment line are looked at.
!
!Code is:
! first character: A or D for alive or dead, C for character definition
!second character (for A and D): number of neighbors
!second character (for C): character to print for dead cells
!third character (for C): character to print for living cells
!List only the ones that are alive.
!
!for example the rules of life as defined by conway state:
! If a cell is alive and has two or three neighbors, then it remains alive.
! If a cell is dead and has three neighbors, then it becomes alive.
! All others die or remain dead.
!Those rules would be stated:
A2 !alive with two neighbors, lives
A3 !alive with three neighbors, lives
D3 !dead with three neighbors, is born
!Since A1, A4, A5, A6, A7, A8, D1, D2, D4, D5, D6, D7, D8 are not listed,
!they either die, or remain dead as the case may be.
C-+ !use '-' for dead, '+' for living.
!end of the rules
%------------------------------------------------------------------------%
grand-tetons-init.life
%------------------------------------------------------------------------%
* *
* * * *
* * * *
* * * *
* * * *
* * * *
* * * *
* ** *
%---------------------------------------------------------------------------%
|
99.65 | Another I/O variation | HYDRA::ECKERT | Jerry Eckert | Mon Sep 08 1986 00:29 | 71 |
| Using Kent Glossop's PL/I version as a starting point, I've
added some enhancements for video terminals. The new features
are:
o the board is displayed at a fixed location on the screen
and is updated (rather than scrolled) after each generation.
o the size of the board is user specified and can be as large
as the screen or current window (actually, the maximum size is
(cols-2, rows-4) to leave room for a border and status display.)
o the initial population is "drawn" on the board rather than
specified as (x,y) pairs.
o a function is provided to initialize the board with a randomly
generated pattern.
When the program is run you will be prompted for the size of the
board and the maximum number of generations to display. The defaults,
which are applied if no input is provided or if 0 is explicitly
specified, are to use the entire screen or window and to run "forever".
No error message is displayed if you attempt to make the board larger
than the screen or window, but the maximum size which will fit will be
used.
After the questions are answered a board of the appropriate size
is drawn on the screen and the cursor is placed in the upper left
corner. The user may then generate the initial population by moving
the cursor and marking each cell where an organism is desired.
The organism is displayed immediately and the population count
at the bottom of the screen is updated. After you finish entering
the initial generation hit the <ENTER> key and watch the board!
The following keys are used when entering the initial generation:
KP1, KP2, KP3, move the cursor (the direction of movement
KP4, KP6, is the same as the position of the key
KP7, KP8, KP9 relative to KP5)
KP5 place an organism at the current location
KP0 remove the organism at the current location
PF1 generate a random population (the new
organisms are logically ORed with those
already on the board)
ENTER start the simulation
Note that nothing will happen if an illegal key is hit or if an
attempt is made to move the cursor off the board.
The source is rather long (667 line with comments), so I won't post
it here. The source, object, or image may be copied from:
HYDRA::DISK$ECKERT:<ECKERT.PUBLIC>
The following files are located in the directory:
LIFE.PLI source which will compile with PL/I T3.0 (IFT
or later)
LIFE.OBJ, compiled with PL/I T3.0 (IFT) and linked under
LIFE.EXE VMS V4.4
LIFE_V2X.PLI source which will compile with PL/I V2.4 (or
earlier) and the internal version of PLISTARLET
which included the SMG definitions
LIFE_V2X.OBJ, compiled with PL/I V2.3 and linked under VMS
LIFE_V2X.EXE V4.4
|
99.66 | A few innocent questions | TLE::FELDMAN | LSE, zealously | Mon Sep 08 1986 03:55 | 27 |
| Not that I want to spoil the fun (since I'm a strong believe in
empirical studies), but since I personally am better at analysis
than synthesis (at least at low levels), I feel compelled to ask
the following:
1. What are the properties of this programming task that qualify
(or disqualify) it as a suitable task to "compare the features and
benefits of all the different programming languages"? (quoted from
.0)
2. What are the qualities that will be compared? Are they quantitative
or qualitative? objective or subjective? How can any particular
set of qualities be justified for use as a basis for comparing
languages? (Length of program has already been mentioned, but only
for a limited and possibly irrelevant reason.)
3. How do you factor differences in programming skill? (Traditionally,
differences in programming skill are considered to be the major
source of variation in experiments of this kind, which is one reason
that such experiments have fallen out of favor.)
All of these are hard questions, and #3 is essentially rhetorical
(if you have a pratical answer to it, I'd love to hear about it).
I'm really just trying to maintain interest for the benefit of those
of us who get bored by reading umpteen versions of the same task.
Gary
|
99.67 | FORTH language implementation | NZOV03::DENHARTOG | The flightless Dutchman | Mon Sep 08 1986 04:58 | 92 |
| Here is a simple implementation of life in FORTH. It is only about
60 lines long, but then again the user hsa to set up the board sort-
of manually (see the end of the program).
The forth that I used is called FIG-FORTH (kit location is listed
in the Easynet kits directory). It doen't have any easily used methods
of program loading and saving unless you wan't to learn how to use the
super simple line editor.
It is fairly slow, but part of that reason is that the FORTH runs
in RSX emulation mode on the VAX.
Also it doesn't support any true commenting, so I will use the
notation of "(" comment ")" (It is possible to add comments to the
language by writing the apropriate FORTH code, but I cant be bothered
doing that now, so if you have forth, remove the (...) to run this
program.
-- Robert den Hartog, New Zealand. (NZO)
--------------------------------------------------------------------------------
$ forth ! I set it up as a .com file, as FORTH has no real load facilities.
40 CONSTANT width ( Relatively small, to speed it up a bit )
14 CONSTANT depth
0 VARIABLE screen width depth * ALLOT ( No real arrays in FORTH, just use )
0 VARIABLE temp width depth * ALLOT ( variables, and increase allocation )
0 VARIABLE cellcount
: 1- 1 - ; ( Define some simple forms for repeated expressions )
: x width MOD ;
: y width / ;
: not 0= IF 1 ELSE 0 ENDIF ; ( Note: the IF is where the THEN should be )
: >= < not ;
: getxy ( Get a cell value 1 or 0, 0 if off the edge )
DUP depth >= OVER 0< OR ( If off the top or bottom )
IF DROP DROP 0 ( return a 0 )
ELSE OVER DUP width >= OVER 0< OR ( If off the side then )
IF DROP DROP DROP 0 ( return a 0 )
ELSE DROP width * + screen + C@ ( else return cell value )
ENDIF
ENDIF
;
: setxy width * + temp + 1 swap C! cellcount @ 1+ cellcount ! ; ( No range chk )
: resetxy width * + temp + 0 swap C! ;
: printcell 0= IF 32 EMIT ELSE 111 EMIT ENDIF ;
: printboard width depth * 0 DO
I x 0= IF 13 10 EMIT EMIT ENDIF
temp + C@ DUP printcell ( Print, and leave copy of val on stack... )
I screen + C! ( ... and store that into the source board )
LOOP ;
: action ( Set cell, according to neighbour count )
DUP 3 =
IF DROP setxy
ELSE DUP 2 < SWAP 3 > OR
IF resetxy
ELSE OVER OVER getxy 1 =
IF setxy
ELSE resetxy
ENDIF
ENDIF
ENDIF
;
: main width depth * 0 DO ( main loop, count neighbours, and act )
I x 1- I y 1- getxy
I x I y 1- getxy + ( Remenber that this is all RPN ... )
I x 1+ I y 1- getxy + ( ... so i+j becomes i j + )
I x 1- I y getxy +
I x 1+ I y getxy +
I x 1- I y 1+ getxy +
I x I y 1+ getxy +
I x 1+ I y 1+ getxy +
I x SWAP I y SWAP action
LOOP
;
: clearboard width depth * 0 DO I x I y resetxy LOOP ;
: life
10000 0 DO
cellcount @ 0= NOT
IF printboard main ENDIF
0 cellcount !
LOOP
;
(------------------------------- End of Program -------------------------------)
clearboard ( First the user should clear the board )
( then manually set cells by "X Y setxy" ... ie )
3 3 setxy 3 4 setxy
3 6 setxy
3 6 resetxy
3 5 setxy 4 5 setxy 5 5 setxy
life ( and then make it go. )
--------------------------------------------------------------------------------
|
99.68 | State of the Union Address | JUNIPR::DMCLURE | Vaxnote your way to ubiquity | Mon Sep 08 1986 08:50 | 119 |
| Ok, I see that some heads are beginning to scratch out there
regarding both my motives (re: .64), and my plans for carrying-out
this language comparison (re: 66). Well, I have been away from my
terminal for most of the week-end, and it's way too late to be awake
right now, but I thought I'd try to address a couple a points real
quickly for the morning readers so as to keep things rolling here.
First of all, I'm not taking a class which has an assignment of
gathering together all of the different versions in all of the diff-
erent programming languages...etc. (as Dick had pondered), although
I'd bet I probably would get an "A" if I were - since the results of
this little experiment have been so successful (so far).
The truth of the matter is that I have always enjoyed the kinds
of disscussions that are spawned from this particular notesfile, and
though I had been checking in fairly regularly for the past few months,
there really hadn't been much happening in here.
I addition to this, I have recently taken on a new job (see note
97.0 for details) which potentially involves using quite a variety of
different languages, and I had been looking for a fast way to learn a
little about alot of different programming languages.
Thirdly, I have always wondered how new things (i.e. programming
languages) are invented, and thought maybe I could do my part to at
least inspire someone else, if not actively participate in the creation
of something really BIG - you know? (Now I'm getting into the loftier
goals). And if not invent something newer and better (since the ideal
language might already exist), then at least shed some light on this
wonder-code so that everyone might benefit from it together.
Ok, so much for my motives, now for the benefits I see for DEC by
following through with such a language comparison study: first of all,
I think alot of people will agree that this study has been a fun way to
get a glimpse of all sorts of different languages in a way that's fairly
painless to follow - since all of these programs do basically the same
thing, and it's just a matter of figuring out the differences in style
and implementation in order to identify the similarities of each language.
If nothing else, this has been a giant step forward in recognising the
potentials of the Vaxnotes utility.
Secondly, I feel that we (as a company) can benefit by the fact that
programmers of all different faiths (i.e. languages) have been able to
meet on a common turf such as this notesfile to swap algorithms, frus-
trations, bugs, achievements, and recognition for all of the aforementioned
(without having to meet at the Sheraton Tara for megabucks to do so!).
Beyond just the programmers (who are basically the front-lines of this
"Battle"), there are the so-called "ivory-tower" thinkers and documentation
experts out there who are waiting their chance to join in on what may
yet turn out to be a fairly organized way of viewing the programming
language spectrum, but there are still some ground-rules that need to
be ironed out first.
I must apologize for the somewhat entrepreneurial (and, as such,
unorganized) flavor of this whole event, but I really couldn't think of
a better way to quickly bring attention to this "battleground" than to
sensationalize the event the way I have done.
Contrary to popular belief, however, there is but one man behind
this particular "green curtain", and I can only wear so many hats in
this study without spreading myself unneccessarily thin. After all,
there's an entire corporation full of ideas on how to run something
like this, and it would be not only foolish, but unfair for me to try
to do it alone. Besides, I can't stay up this late everynight, not to
mention my vacation will be coming up pretty soon!
So, I am going to request that anyone who has extra ideas on how to
proceed with this "Battle" please reply to this note (don't wait for it
to happen - because these issues may never be resolved as long as apathy
and confusion continue to reign!). I will continue to play my part as
sort-of a Secretary of State in this war effort, but I am counting on
some volunteers to enlist to help the cause along.
Now, I have been throwing around alot of somewhat confusing analogies
here, all of which revolve around the "Battle of the Languages", but I'll
bet that there are at least several different ways this could proceed from
here depending upon how you percieve this whole event. You might think
that once all of the different programming languages have entered their
code, that we just take a big vote and the one with the most votes wins...
well, that would be too easy (not to mention unrealistic).
In order to keep everybody's interest level, however, I think we should
offer some sort of recognition for all of the different programs which have
been entered here, and that's why I have tried to be very congratulatory
in my follow-up responses in the various language-specific notesfiles, in
addition to my encouraging words which would imply that one version "might
be a good contender" etc., and I would hope that we can decide upon a way
to evaluate these programs in a way which will shed some positive light
on all of the different implementations, while leaving room for improvement.
There is one little angle to this "Battle" which I'm not sure anyone
has quite figured out yet though (including myself), and that is: "who is
the enemy? Are we fighting for the survival of our own favorite language?
Or, is their some other enemy out their which we could all possibly team-up
against and fight together?", well, I would sort-of hope that the answer to
this would be the latter, and that the enemy could be summed-up as that of
sheer Ignorance, Isolation, and Incompatibility within the programming
world, and that this "battle" is the first in the World War against the
three I's (i.e. WWIII). ;^)
Well, I have succeeded in babbling long enough for now, but as the rest
of the program versions continue to roll in, I would hope that some more
of the "command headquarters" disscussions come into play at this point
so we can begin to shape the formation of the "troops" for their upcoming
"battle", as well as continue to learn from what works here so as to better
plan the next "battle" after this one is won.
-davo
p.s. I meant to address some of Gary's (re: .66) points here, but
got a little carried away with my "state of the union address", so
feel free to help decide on some of these issues. I will join in
as soon as I can get some sleep.
p.p.s. I now have Didier's AUDIT program installed on my system, so
I will be experimenting on ways to utilize this facility for gathering
such things as votes, etc., as time permits.
|
99.69 | | QUARK::LIONEL | Reality is frequently inaccurate | Mon Sep 08 1986 14:37 | 5 |
| I think this "battle" is simply a way to expose people to the
wide variety of languages we have. I see no point in voting,
especially as most of the entries have differed in ways unrelated
to the language used.
Steve
|
99.70 | VAX-11 SNOBOL, almost a subset of SNOBOL4 | SQM::HALLYB | Free the quarks! | Mon Sep 08 1986 21:00 | 184 |
| ! Request dump of variables at termination; trim trailing blanks from input
&DUMP = 1 ; &TRIM = 1
TOP ROWS = 20 ; COLS = 36
OUTPUT = "Enter rows, columns (Default = " ROWS "," COLS ")"
LINE = INPUT :F(ENDIT)
LINE POS(0) SPAN(" ") = ""
IDENT(LINE) :S(CRACK)
LINE SPAN(" ") = ","
LINE BREAK(",") . ROWS LEN(1) REM . COLS :F(TOP)
ROWS = INTEGER(ROWS) +ROWS :F(TOP)
COLS = INTEGER(COLS) +COLS :F(TOP)
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++!
! Set up variables ROOT and ROT, where ROT = the first non-{FILL,0,1}!
! COLS characters of the alphabet and ROOT is COLS interleaved !
! with FILL characters. This allows us to expand the output string. !
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++!
CRACK FILL = " "
USABLE = &ALPHABET
CRACK_0 USABLE (FILL | "0" | "1") = :S(CRACK_0)
USABLE LEN(COLS) . USABLE :F($'TOO_MANY_COLUMNS')
ROT = USABLE
CRACK_1 USABLE LEN(1) . G1 = :F(CRACK_E)
ROOT = ROOT FILL G1 :(CRACK_1)
CRACK_E
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++!
! Set up the "census" table NUM. NUM<STRING> is the number of !
! "1" digits in STRINGs that we will encounter when scanning. !
! There's probably a cleverer way to assign these, but anyway...!
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++!
NUM = TABLE()
NUM<""> = 0; NUM<"0"> = 0; NUM<"1"> = 1
NUM<"00"> = 0; NUM<"01"> = 1; NUM<"10"> = 1; NUM<"11"> = 2
NUM<"000"> = 0; NUM<"001"> = 1; NUM<"010"> = 1; NUM<"100"> = 1
NUM<"111"> = 3; NUM<"110"> = 2; NUM<"101"> = 2; NUM<"011"> = 2
! Read in the number of generations.
GIN OUTPUT = "Number of generations (0 = infinite)"
NG = INPUT :F(ENDIT)
IDENT(NG) :S(GIN)
NG = INTEGER(NG) +NG :F(GIN)
GENER = -1
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++!
! Initialize the board to be stored as an array of ROWS strings, !
! each of COLS characters. Initially each character is a "0". !
! Full SNOBOL would allow this to be done in one statement, viz.,!
! !
! A1 = ARRAY(ROWS,DUPL("0",COLS)) !
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++!
A1 = ARRAY(ROWS)
I = 1
BLANK_LINE = DUPL("0",COLS)
INIT A1<I> = BLANK_LINE
I = LT(I,ROWS) I + 1 :S(INIT)
!+++++++++++++++++++++++++++!
! Initialize the live cells !
!+++++++++++++++++++++++++++!
OUTPUT = "Enter cells to activate. Type 0,0 to begin." :(PROMPT)
BAD OUTPUT = "Type two comma-separated integers from 1,1 to " ROWS "," COLS
PROMPT OUTPUT =
OUTPUT = "Row Col"
READ LINE = INPUT :F(ENDIT)
LINE POS(0) SPAN(" ") = ""
IDENT(LINE) :S(PROMPT)
LINE SPAN(" ") = ","
LINE BREAK(",") . ROW LEN(1) REM . COL :F(BAD)
ROW = INTEGER(ROW) +ROW :F(BAD)
COL = INTEGER(COL) +COL :F(BAD)
GT(COL,0) :S(ENTER)
LE(ROW,0) :S(START)
ENTER A1<ROW> POS(COL - 1) LEN(1) = "1" :S(READ)F(BAD)
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++!
! Main loop starts here. First output the current situation. !
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++!
START GENER = EQ(NG,0) 1 + GENER :S(START_O)
GENER = LT(GENER,NG) 1 + GENER :F(ENDIT)
START_O OUTPUT =
OUTPUT =
OUTPUT = "Generation " GENER
OUTPUT =
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++!
! The grid is stored as an array of strings. Each character is !
! either "0" (empty) or "1" (alive). We use the REPLACE function !
! to convert to a fancier print representation. The arguments !
! for REPLACE are: !
! !
! REPLACE(source-string, character-set-1, character-set-2) !
! !
! This is basically a move-translated-characters call, where the !
! value returned is <source-string> with characters in set-1 !
! replaced by the (positional) corresponding characters in set-2. !
! Characters in <source-string> that are not in set-1 are left !
! unchanged by REPLACE. !
! !
! The "inner" REPLACE converts "0" and "1" into "." and "O". !
! The second "outer" call inserts blanks and is somewhat complex !
! to explain. Basically, REPLACE(" X Y Z","XYZ","110") = " 1 1 0".!
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++!
I = 1
PRINT_1 OUTPUT = " " REPLACE(ROOT, ROT, REPLACE(A1<I>,"01",".O"))
I = LT(I,ROWS) I + 1 :S(PRINT_1)
! Initialize the output grid A2 and start each line with null LINE
! R = row index, C = column index, N = count of neighbors,
! J controls access to {previous,current,next} lines
A2 = ARRAY(ROWS)
R = 1
NEXT_R LINE =
C = 1
NEXT_C N =
J = -1
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++!
! Construct a pattern to grab off the left edge 2, right edge 2, !
! or three non-edge characters in <current row>, give or take J. !
! If we're at the top or bottom row the array reference fails and !
! we take the branch to BUMP_J. !
! !
! Full SNOBOL4 has a lot of facilities to do the scan in one line, !
! but we'll have to contend ourselves with some setup work first !
! because this implementation doesn't allow dynamic evaluations. !
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++!
SCAN P = LEN(2) $ KEY
NE(J,0) :S(JN0)
P = ((LEN(1) . K) LEN(1)) $ KEY
JN0 EQ(C,1) :S(NZJ)
P = LEN(C - 2) (LEN(3) | REM) $ KEY
NE(J,0) :S(NZJ)
P = LEN(C - 2) ((LEN(1) LEN(1) . K) (LEN(1) | REM)) $ KEY
NZJ A1<R + J> P :F(BUMP_J)
N = N + NUM<KEY>
BUMP_J J = LT(J,1) J + 1 :S(SCAN)
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++!
! Integer N is now the count of "1"s including & adjacent to this cell. !
! Create a new cell with that integer, and go to the next column. !
! First line is special hack to fix fuzzy thinking when first coding, !
! disallowing birth at an empty cell with 4 neighbors. !
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++!
N = IDENT(K,"0" EQ(N,4)) "0"
LINE = LINE N
C = LT(C,COLS) C + 1 :S(NEXT_C)
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++!
! Here when we have scanned an entire line, and built LINE. !
! Another use of REPLACE to convert counts to living cells. !
! Here "3" and "4" are converted to "1", all others go to "0". !
! After this we go on to the next row. !
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++!
A2<R> = REPLACE(LINE,"0123456789","0001100000")
R = LT(R,ROWS) R + 1 :S(NEXT_R)
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++!
! Finally, make the new array equal to the old. Full SNOBOL4 would !
! allow the simple assignment A1 = A2, but that doesn't work here. !
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++!
I = 1
COPY A1<I> = A2<I>
I = LT(I,ROWS) I + 1 :S(COPY)F(START)
! When done, turn off variable dump which was enabled in case of run-time errors
ENDIT &DUMP = 0
END
|
99.71 | I'm thinking out loud here...anyone care to join in? | JUNIPR::DMCLURE | Vaxnote your way to ubiquity | Mon Sep 08 1986 21:27 | 80 |
| re: .66,
Now that I have a momment, I'll try to address what I started to
address last night. Keep in mind that I'm just throwing ideas around
here - I'd hate for everyone to think I'm running the show here (I'm
not a fascist).
> 1. What are the properties of this programming task that qualify
> (or disqualify) it as a suitable task to "compare the features and
> benefits of all the different programming languages"? (quoted from
> .0)
Nothing beyond the fact that it was the first program which caught my
eye (I closed my eyes, opened my book to a section of problems, and stuck
my finger down on the page) it took me around 2.3 seconds to decide on a
program. I think I got lucky in that this problem turned out to be quite
a bit of fun to implement for everyone.
> 2. What are the qualities that will be compared? Are they quantitative
> or qualitative? objective or subjective? How can any particular
> set of qualities be justified for use as a basis for comparing
> languages? (Length of program has already been mentioned, but only
> for a limited and possibly irrelevant reason.)
I thought it might be useful to take these programs and use them as
a reference in a disscussion. Depending upon the current topic of conver-
sation, you could extract examples at will. In this sense, I suppose it
could be a broad enough study to cover both the qualitative and the quant-
itative aspects of languages.
Ideally, we could formulate some criteria to use as measurement (as
we speak), and hopefully generate a standard form to use as a quick refer-
ence (similar to a miniaturized BNF specification for each language).
Once this is done, the control words for each language could be grouped
together and analyzed command by command (i.e. compare all for loop con-
structs on one screen, compare all array data-type syntax on the next, etc.)
all of which could be stored into a database for some heavy-duty analysis.
I keep thinking that a database such as this must already exist some-
where in a form which we could use for this purpose (are their any LSEDIT
hackers out there who could pull something like this together?). It seems
that most languages are defined individually and are not usually sorted
by function this way against other languages, but this is one thing we
might look at.
Length of programs might be another comparison; how much added baggage
does each language require (assuming you limit yourself to something like
one-letter variable names to be fair, etc.). Does the size affect read-
ability? Or are some languages easier to read (without comments and with
one-letter variable names) than others?
> 3. How do you factor differences in programming skill? (Traditionally,
> differences in programming skill are considered to be the major
> source of variation in experiments of this kind, which is one reason
> that such experiments have fallen out of favor.)
This is a good point, but I have tried not to emphasize programming
skill as much as analyzing available building blocks. This is why I have
encouraged people to copy algorithms as much as possible - even when these
implementations are not the most efficient or stylistic as they could be.
If you think of this in terms of grading papers, I would say that we
are looking more at the type of letters used (i.e. fonts) than we are
looking at the content (poetic interpretation, etc.). The latter being
so much more subjective than the former, and consequently more competitive.
Another example might be to think of comparing buildings; instead of
getting into artistic disscussions of gothic versus corinthian pillars, we
might instead focus in on the physical properties of various pillars (such
as stress factors, comparative wieghts etc.).
If we stick to the practical features of each language, we might be
less likely to get hung-up in empirical arguments over such things as using
goto's instead of loop exits, etc.
Anyway, these are a few ideas off the top of my stack, I reserve the
right to change my mind if somebody has a different approach to this com-
parison study which might work better.
-davo
|
99.72 | .... and more musings .... | ATLAST::BOUKNIGHT | Everything has an outline | Mon Sep 08 1986 22:04 | 19 |
| Another important but largely ignored factor in judging the usefullness
of a language is training to learn how to use it. And in addition
to that, consider the level of experience/education needed to become
minimally useful in coding in that language. Now, you are going
to jump on the term "minimally useful" as too subjective, and I
will agree with you, to a certain extent. What I am trying to say
is best illustrated with examples: coding in MACRO-11 vs
coding in FORTRAN, coding in BLISS vs coding in PASCAL, coding in
TECO vs coding in TPU.
IN addition to comparing related constructs, consider how simple
the language is, how intuitive it is, how well does it follow
structured programming practices, how modular is it, does it promote
reusable coding practices, and finally, maybe you need to establish
families of related languages before you try to compare them. Is
APL really comparable to LISP? Why bother with TECO at all when
TPU is a generation beyond any way.
jack (who figures that's enough to get some blood boiling somewhere)
|
99.73 | COBOL does LIFE! | LATOUR::KSTEVENS | I don't want to be Normal | Tue Sep 09 1986 02:28 | 136 |
| Well here' another one... This time written in COBOL
Ken
IDENTIFICATION DIVISION.
PROGRAM-ID. LIFE.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 X-LIMIT PIC S99 USAGE COMP VALUE 40.
01 Y-LIMIT PIC S99 USAGE COMP VALUE 20.
01 OLD-BOARD.
02 OLD-BOARD-COLUMN OCCURS 40 TIMES.
03 OLD-BOARD-SLOT PIC S9 USAGE COMP OCCURS 20 TIMES.
01 NEW-BOARD.
02 NEW-BOARD-COLUMN OCCURS 40 TIMES.
03 NEW-BOARD-SLOT PIC S9 USAGE COMP OCCURS 20 TIMES.
01 OUTPUT-BOARD.
02 OUTPUT-BOARD-ROW OCCURS 20 TIMES.
03 OUTPUT-BOARD-SLOT PIC XX OCCURS 40 TIMES.
01 EMPTY-SLOT PIC S9 USAGE COMP VALUE 0.
01 BLOT PIC S9 USAGE COMP VALUE 1.
01 OUTPUT-EMPTY-SLOT PIC XX VALUE ". ".
01 OUTPUT-BLOT PIC XX VALUE "O ".
01 INPUT-LINE PIC X(80).
01 P PIC S9(5) USAGE COMP.
01 Q PIC S9(5) USAGE COMP.
01 GENERATION PIC S9(5) USAGE COMP.
01 OUTPUT-GENERATION PIC Z(5).
01 LAST-GENERATION PIC S9(5) USAGE COMP.
01 X PIC S9(5) USAGE COMP.
01 Y PIC S9(5) USAGE COMP.
01 TOTAL PIC S9(5) USAGE COMP.
PROCEDURE DIVISION.
MAIN SECTION.
BEGIN.
DISPLAY "How many generations do you want?".
READ-GENERATIONS.
DISPLAY "Generations> " WITH NO ADVANCING.
ACCEPT INPUT-LINE.
MOVE 0 TO P, Q.
INSPECT INPUT-LINE TALLYING P FOR LEADING SPACES.
INSPECT INPUT-LINE(P + 1:) TALLYING Q FOR CHARACTERS BEFORE INITIAL SPACE.
MOVE INPUT-LINE(P + 1:Q) TO LAST-GENERATION.
IF LAST-GENERATION NOT > 0 THEN
DISPLAY "Please enter a number > 0."
GO TO READ-GENERATIONS.
PERFORM INITIALIZE-BOARD.
DISPLAY "Starting configuration:".
PERFORM DISPLAY-BOARD.
PERFORM VARYING GENERATION FROM 1 BY 1 UNTIL GENERATION > LAST-GENERATION
PERFORM NEW-GENERATION
MOVE GENERATION TO OUTPUT-GENERATION
DISPLAY "Generation # " OUTPUT-GENERATION
PERFORM DISPLAY-BOARD
END-PERFORM.
STOP RUN.
INITIALIZE-BOARD SECTION.
BLANK-BOARD.
PERFORM VARYING X FROM 1 BY 1 UNTIL X > X-LIMIT
PERFORM VARYING Y FROM 1 BY 1 UNTIL Y > Y-LIMIT
MOVE EMPTY-SLOT TO NEW-BOARD-SLOT (X, Y)
END-PERFORM
END-PERFORM.
DISPLAY "To bring a cell to life, type the X and Y coordinates".
DISPLAY "separated by a space, 0 0 to end. Range is 40 x 20.".
READ-COORDINATES.
DISPLAY "X Y> " WITH NO ADVANCING.
ACCEPT INPUT-LINE.
MOVE 0 TO P, Q.
INSPECT INPUT-LINE TALLYING P FOR LEADING SPACES.
INSPECT INPUT-LINE(P + 1:) TALLYING Q FOR CHARACTERS BEFORE INITIAL SPACE.
MOVE INPUT-LINE(P + 1:Q) TO X.
ADD Q TO P.
MOVE 0 TO Q.
INSPECT INPUT-LINE(P + 1:) TALLYING P FOR LEADING SPACES.
INSPECT INPUT-LINE(P + 1:) TALLYING Q FOR CHARACTERS BEFORE INITIAL SPACE.
MOVE INPUT-LINE(P + 1:Q) TO Y.
IF X = 0 AND Y = 0 THEN
GO TO EXIT-READ-COORDINATES.
IF X > 0 AND < X-LIMIT AND Y > 0 AND < Y-LIMIT THEN
MOVE BLOT TO NEW-BOARD-SLOT (X, Y)
ELSE
DISPLAY "Out of range.".
GO TO READ-COORDINATES.
EXIT-READ-COORDINATES.
EXIT.
DISPLAY-BOARD SECTION.
EDIT-BOARD.
PERFORM VARYING X FROM 1 BY 1 UNTIL X > X-LIMIT
PERFORM VARYING Y FROM 1 BY 1 UNTIL Y > Y-LIMIT
PERFORM EDIT-SLOT
END-PERFORM
END-PERFORM.
PERFORM VARYING Y FROM 1 BY 1 UNTIL Y > Y-LIMIT
DISPLAY OUTPUT-BOARD-ROW (Y)
END-PERFORM.
DISPLAY SPACES.
EDIT-SLOT SECTION.
CHECK-EMPTY-SLOT.
IF NEW-BOARD-SLOT (X, Y) = EMPTY-SLOT
THEN
MOVE OUTPUT-EMPTY-SLOT TO OUTPUT-BOARD-SLOT (Y, X)
ELSE
MOVE OUTPUT-BLOT TO OUTPUT-BOARD-SLOT (Y, X).
NEW-GENERATION SECTION.
COPY-BOARD.
MOVE NEW-BOARD TO OLD-BOARD.
PERFORM VARYING X FROM 2 BY 1 UNTIL X > X-LIMIT - 1
PERFORM VARYING Y FROM 2 BY 1 UNTIL Y > Y-LIMIT - 1
PERFORM COMPUTE-LIFE
END-PERFORM
END-PERFORM.
COMPUTE-LIFE SECTION.
TOTAL-BLOTS.
COMPUTE TOTAL = OLD-BOARD-SLOT (X - 1, Y - 1)
+ OLD-BOARD-SLOT (X , Y - 1)
+ OLD-BOARD-SLOT (X + 1, Y - 1)
+ OLD-BOARD-SLOT (X - 1, Y )
+ OLD-BOARD-SLOT (X + 1, Y )
+ OLD-BOARD-SLOT (X - 1, Y + 1)
+ OLD-BOARD-SLOT (X , Y + 1)
+ OLD-BOARD-SLOT (X + 1, Y + 1).
IF TOTAL NOT > 1 OR NOT < 4 THEN
MOVE EMPTY-SLOT TO NEW-BOARD-SLOT (X ,Y)
ELSE
IF TOTAL = 3 THEN
MOVE BLOT TO NEW-BOARD-SLOT (X, Y).
|
99.75 | Divide and Conquer! | JUNIPR::DMCLURE | Vaxnote your way to ubiquity | Tue Sep 09 1986 05:33 | 23 |
| re: .72,
> maybe you need to establish
> families of related languages before you try to compare them.
This is a good idea. Maybe we can start by grouping languages
by generation; while most of these programs would fall under the 3rd
generation, there are some that would not. Anyone care to assign all
of the languages entered so far by generation?
-------------------------------------------------
5th Generation:
-------------------------------------------------
4th Generation:
-------------------------------------------------
3rd Generation:
-------------------------------------------------
2nd Generation:
-------------------------------------------------
1st Generation:
-------------------------------------------------
-davo
|
99.76 | Trapped Like Mars Flies In a Klein Bottle?? | CIM::JONAN | We should've stopped at fire... | Tue Sep 09 1986 17:30 | 23 |
| Re: .75 (Generation categorization)
I have always found this a puzzle, because of questions about what
makes a generation. For example, LISP is about as old as FORTRAN
(chronologically) but would seem to fall into what seems to be called
the 5th generation nowadays. On the other hand there are properties
about standard Pascal that might make it seem older than 3rd generation
(such as lack of independent/separate compilation), where it is
traditionally placed. Similarly, there are those that class Ada
as a 4th generation language. Maybe the family categorization merits
being done first and then generations established inside these
familys - sort of like classifying the evolution of separate species.
.... Another criteria (one that it is used often today) for describing
the generations is the concept of data abstraction/hiding/objects
and the level to which these are supported by the language. This
idea is often described as the "topology of the language space"
(or some such thing). Of course, this just *another* criteria to
be considered (though many speak of it as *the* criteria)...
/Jon
|
99.77 | How's this for an analogy? | JUNIPR::DMCLURE | Vaxnote your way to ubiquity | Tue Sep 09 1986 20:06 | 42 |
| re: .76,
> ...Maybe the family categorization merits
> being done first and then generations established inside these
> familys - sort of like classifying the evolution of separate species.
I suppose you have a point, yet I'm at somewhat of a loss to come
up with what sort of qualities would distinguish each family from one
another. For example, the easynet_conferences listing lumps most of the
languages and editors together; I suppose you might consider dividing
languages from editors? What about Command languages (DCL, TCL, etc.),
and micro-code layers?
Maybe a tree model would work. Imagine a forest of language trees
growing on the fertile ground of the VAX/VMS programming environment.
The fruit would represent finished programs (complete with real bugs!),
while the leaves would represent all of the code written in developing
the programs. The trunk would represent the link to the operating system,
the branches could be the various language implementations, the roots
could be the RTL and System Services support for the language.
Each language could be a different species of tree which would be
constantly growing, spawning new implementations, and dying (years from
now - since most trees live along time). I suppose not all languages
would have to be a tree either: some might be vines which hang from trees,
others might be smaller in size and designed for PC's, etc. (more like a
bush than a tree), and some might simply be DCL command programs (grass).
How's this for creative fuel? Pick a species of plant for your par-
ticular language and explain why this plant describes the language and
what it's relationship is to the rest of the forest. I'll leave it to
the next person to figure out where data-abstraction/hiding/objects, etc.
would fit into this analogy. No vegetables please...
-davo
p.s. Command languages were intended to be included in this disscussion
as well, but I mistakenly announced the "Battle" in the wrong DCL notesfile
(the SQM::DCL conference - as opposed to the CLOSET::COMMAND_PROCEDURES
notesfile) not realizing that this notesfile was being used stricktly for
DCL review issues, and have not yet re-entered it. Oh well, I figure that
anyone who uses DCL also reads some other language notesfile.
|
99.78 | Here's a *fast* VS-II routine | ENGINE::ROTH | | Wed Sep 10 1986 01:38 | 480 |
| I'm a strong believer in elegantly meshing the inner loop of a high performance
routine with the machine architecture.
This is the generation routine if my VS-II life program, which has the nice
features of linear growth of exec time with population, an address space of
15 bits in the x and y direction, storage requirements of a little over
1 short integer per cell (actually two, since the next generation must be
built in a new buffer), and trivial mapping to device coordinates
(no bit-munging necessary).
An executable is in ENGINE::SYS$USRDISK:[ROTH]LIFE_ACORN.EXE (which is
hardwired to display the 'acorn' pattern).
It was origionally coded for the PC/350 and I have not had time to do a
proper editor, maybe I will now that my interest is reawakened. Probably
outputing the pattern with DOP's on the VAX-GPX would be nice, but not as
fast as twiddling the bitmap of the VS-II.
I note that this algorithm would carry over well into LISP - it would be
a pleasant exercise to do the proper LISP macros for this...
- Jim
.TITLE LIST-PROCESS LIFE PROGRAM
.IDENT /JR01/
; INSPIRATION SUPPLIED BY S.C.R. ... MANY THANKS.
.LIST MEB
.SBTTL MACRO DEFINES
.MACRO GENC N,A,B,C
SC'N'A'B'C: MOVW R0,(R4)+
FC'N'A'B'C: INCW R0
CMPW (R'N),R0
BNEQ 1$
ADDL #2,R'N
CMPW (R2),R0
$$ = B+C
FORKC 2$,BEQL,N,A,B,C,\$$,1,0
ADDL #2,R2
$$ = B+C
BRC BRW,N,A,B,C,\$$,1,1
1$: CMPW (R2),R0
$$ = B+C
FORKC 3$,BEQL,N,A,B,C,\$$,0,0
ADDL #2,R2
$$ = B+C
BRC BRW,N,A,B,C,\$$,0,1
.ENDM
.MACRO FORKC L,J,N,A,B,C,BC,D,E
$$=A+B+D+E
.IF EQ <$$&^O16>+<$$!C&1>-3
J L
BRW SC'N'BC'D'E
L:
.IFF
J L
BRW FC'N'BC'D'E
L:
.ENDC
.ENDM
.MACRO BRC J,N,A,B,C,BC,D,E
$$=A+B+D+E
.IF EQ <$$&^O16>+<$$!C&1>-3
J SC'N'BC'D'E
.IFF
J FC'N'BC'D'E
.ENDC
.ENDM
.MACRO GEN5 A,B
S5'A'B: MOVW R0,(R4)+
F5'A'B: INCW R0
CMPW (R1),R0
BNEQ 1$
ADDL #2,R1
CMPW (R3),R0
FORK5 2$,BEQL,A,B,1
ADDL #2,R3
BR5 BRW,A,B,2
1$: CMPW (R3),R0
FORK5 3$,BEQL,A,B,0
ADDL #2,R3
BR5 BRW,A,B,1
.ENDM
.MACRO FORK5 L,J,A,B,C
.IF EQ A+B+C-3
J L
BRW S5'B'C
L:
.IFF
J L
BRW F5'B'C
L:
.ENDC
.ENDM
.MACRO BR5 J,A,B,C
.IF EQ A+B+C-3
J S5'B'C
.IFF
J F5'B'C
.ENDC
.ENDM
; sample explanation of data usage: 3 column strip; others are similar.
;
; R1 R2 R3 ; Registers pointing at strips downward
; ! ! !
; V V V
;
; a a a ; a = # points on above c
; b c b ; b = # points on alongside, c = center on or not
;R0-> d e d ; d = # points on below sides, e = lower point on or not
;
; ; R0 = next expected value of Y in the list
; ; when moving to next row downward, a:=b+c, b:=d, c:=e
; ; a=0,1,2,3 b=0,1,2 c=0,1 4*3*2=24 GEN7 macro calls necessary.
;
; S means point successfully generated or kept, F means failure
.MACRO GEN7 A,B,C
S7'A'B'C: MOVW R0,(R4)+
F7'A'B'C: INCW R0
CMPW (R1),R0
BNEQ 1$
ADDL #2,R1
CMPW (R3),R0
BNEQ 2$
ADDL #2,R3
FORK7 3$,A,B,C,2
5$: ADDL #2,R3
2$: FORK7 4$,A,B,C,1
1$: CMPW (R3),R0
BEQL 5$
FORK7 6$,A,B,C,0
.ENDM
.MACRO FORK7 L,A,B,C,D
CMPW (R2),R0
$$=<6*A+<2*B>+C>-<6*<B+C>+D+D+0>
$$=72.*$$+<.-S7'A'B'C/2>
.IIF LT $$, $$=-$$
.IF LT $$-63.
$$ = B+C
JMP7 BNEQ,A,B,C,\$$,D,0
.IFF
BNEQ L
.IFTF
ADDL #2,R2
$$=<6*A+B+B+C>-<6*<B+C>+D+D+1>
$$=72.*$$+<.-S7'A'B'C/2>
.IIF LT $$, $$=-$$
.IF LT $$-63.
.IFTF
$$ = B+C
.IFT
JMP7 BRB,A,B,C,\$$,D,1
.IFF
JMP7 BRW,A,B,C,\$$,D,1
.ENDC
.IFF
$$ = B+C
L: JMP7 BRW,A,B,C,\$$,D,0
.ENDC
.ENDM
.MACRO JMP7 J,A,B,C,BC,D,E
$$=A+B+D+E
.IF EQ $$!C&1+<$$&^O16>-3
J S7'BC'D'E
.IFF
J F7'BC'D'E
.ENDC
.ENDM
.MACRO TESTY
TSTW -(R4)
BLSS 1$
ADDL #2,R4
1$:
.ENDM
.SBTTL PROCESS LIFE SPACE
; calling sequence:
;
; CALL GEN
;
; register usage:
;
; R1 -> input list of form XYYYYXYYYXYXYYYYYXYXYYXY...(-1)
; R4 -> output list storage area
;
; the list has monotonically increasing values of X and Y with no
; two adjacent values of X allowed; TESTY deletes any null columns.
;
; R1, R2, R3 used to point to 3 adjacent columns during processing
; R0 contains the next expected Y value we are looking for (below us)
;
; X values have the sign bit on, Y values have the sign bit off.
; the center of the space is 140000 for X and 40000 for Y.
; since we look for the least unsigned magnitude value when jumping down
; in a column this saves extra compares since we can test signs to
; discriminate X or Y later.
;
; the values of Y stored via R0 are one too large; this saves time during
; generation and can be cleaned up "infrequently" (every 100 generations or so)
; and compensated for during display formatting.
GEN:: MOVL R1,R2
MOVL R1,R3
MOVW (R3)+,(R4)
OOXGO: DECW (R4)+
BRB FE300
ENDXOO: TESTY
MOVW (R3)+,(R4)
CMPW (R4),#-1
BNEQ OOXGO
RSB
.SBTTL SINGLE COLUMN STRIPS
; DO --X STRIP
FE301: INCW R0
CMPW (R3),R0
BNEQ FE310
ADDL #2,R3
FE311: INCW R0
CMPW (R3),R0
BNEQ FE310
ADDL #2,R3
SE311: MOVW R0,(R4)+
BRB FE311
FE310:
FE300: MOVW (R3)+,R0
BGEQ FE301
SUBL #2,R3
BRB ENDOOX
; DO X-- STRIP
FE101: INCW R0
CMPW (R1),R0
BNEQ FE110
ADDL #2,R1
FE111: INCW R0
CMPW (R1),R0
BNEQ FE110
ADDL #2,R1
SE111: MOVW R0,(R4)+
BRB FE111
FE110:
FE100: MOVW (R1)+,R0
BGEQ FE101
SUBL #2,R1
BRB ENDXOO
; DO -X- STRIP
FC01: INCW R0
CMPW (R2),R0
BNEQ FC10
ADDL #2,R2
FC11: INCW R0
CMPW (R2),R0
BNEQ FC10
ADDL #2,R2
SC11: MOVW R0,(R4)+
BRB FC11
FC10:
FC00: MOVW (R2)+,R0
BGEQ FC01
SUBL #2,R2
BRW ENDOXO
.SBTTL DOUBLE COLUMN STRIPS
; CASTING ON LOGIC --X OR X-X TO -X- OR -XX
ENDOOX:
ENDXOX: TESTY
MOVW (R2)+,R0
MOVW R0,(R4)+
INCW R0
CMPW (R3)+,R0
BNEQ 3$
BRW FC3000
3$: SUBL #2,R3
BRB FC00
; DO X-X STRIP
F500: CMPW (R1),(R3)
BGTRU 1$
BLSSU 2$
MOVW (R1)+,R0
ADDL #2,R3
BRB F502
1$: MOVW (R3)+,R0
BGEQ F501
SUBL #2,R3
BRB ENDXOX
2$: MOVW (R1)+,R0
BGEQ F501
SUBL #2,R1
BRB ENDXOX
GEN5 0,1
GEN5 0,2
GEN5 1,0
GEN5 1,1
GEN5 1,2
GEN5 2,0
GEN5 2,1
GEN5 2,2
.SBTTL CASTING ON LOGIC FOR XX- OR -X- TO X-- OR X-X
ENDOXO:
ENDXXO: TESTY
MOVW (R1)+,R0
INCW R0
MOVW R0,(R4)+
INCW R0
CMPW (R3)+,R0
BNEQ 10$
BRW F500
10$: SUBL #2,R3
MOVW (R1)+,R0
BRW FE101
; DO XX- STRIP
FC1000: CMPW (R1),(R2)
BGTRU 1$
BLSSU 2$
MOVW (R1)+,R0
ADDL #2,R2
BRB FC1011
1$: MOVW (R2)+,R0
BGEQ FC1001
SUBL #2,R2
BRB ENDXXO
2$: MOVW (R1)+,R0
BGEQ FC1010
SUBL #2,R1
BRB ENDXXO
GENC 1,0,0,1
GENC 1,0,1,0
GENC 1,0,1,1
GENC 1,1,0,0
GENC 1,1,0,1
GENC 1,1,1,0
GENC 1,1,1,1
GENC 1,2,0,0
GENC 1,2,0,1
GENC 1,2,1,0
GENC 1,2,1,1
; DO -XX STRIP
FC3000: CMPW (R3),(R2)
BGTRU 1$
BLSSU 2$
MOVW (R3)+,R0
ADDL #2,R2
BRB FC3011
1$: MOVW (R2)+,R0
BGEQ FC3001
SUBL #2,R2
BRW ENDOXX
2$: MOVW (R3)+,R0
BGEQ FC3010
SUBL #2,R3
BRW ENDOXX
GENC 3,0,0,1
GENC 3,0,1,0
GENC 3,0,1,1
GENC 3,1,0,0
GENC 3,1,0,1
GENC 3,1,1,0
GENC 3,1,1,1
GENC 3,2,0,0
GENC 3,2,0,1
GENC 3,2,1,0
GENC 3,2,1,1
.SBTTL THREE COLUMN STRIP - THE BIGGY
; CASTING ON LOGIC FOR -XX TO XXX OR XX- TO XXX
ENDOXX:
ENDXXX: TESTY
ADDL #2,R1
MOVW (R2)+,R0
MOVW R0,(R4)+
INCW R0
CMPW (R3)+,R0
BEQL F7000
SUBL #2,R3
BRW FC1000
; DO XXX STUFF
S7000: MOVW R0,(R4)+
F7000: CMPW (R1),(R3)
BGTRU 3$
BLSSU 1$
CMPW (R1),(R2)
BGTRU 20$
BLSSU 13$
MOVW (R1)+,R0
ADDL #2,R2
ADDL #2,R3
BRW S7021
13$: MOVW (R1)+,R0
ADDL #2,R3
BRW F7020
3$: CMPW (R3),(R2)
BGTRU 20$
BLSSU 30$
MOVW (R3)+,R0
ADDL #2,R2
BRW F7011
1$: CMPW (R1),(R2)
BGTRU 20$
BLSSU 10$
MOVW (R1)+,R0
ADDL #2,R2
BRW F7011
10$: MOVW (R1)+,R0
BGEQ F7010
SUBL #2,R1
BRB ENDXXX
20$: MOVW (R2)+,R0
BGEQ F7001
SUBL #2,R2
BRB ENDXXX
30$: MOVW (R3)+,R0
BGEQ F7010
SUBL #2,R3
BRW ENDXXX
GEN7 0,0,1
GEN7 0,1,0
GEN7 0,1,1
GEN7 0,2,0
GEN7 0,2,1
GEN7 1,0,0
GEN7 1,0,1
GEN7 1,1,0
GEN7 1,1,1
GEN7 1,2,0
GEN7 1,2,1
GEN7 2,0,0
GEN7 2,0,1
GEN7 2,1,0
GEN7 2,1,1
GEN7 2,2,0
GEN7 2,2,1
GEN7 3,0,0
GEN7 3,0,1
GEN7 3,1,0
GEN7 3,1,1
GEN7 3,2,0
GEN7 3,2,1
.END
|
99.79 | Mesa (what's Mesa?!) entry | TAHOE::HAYNES | Charles Haynes | Wed Sep 10 1986 03:06 | 489 |
| I have a version written in Mesa (Xerox implementation language,
related to Pascal, and direct ancestor of Modula-2) for the Xerox
Development Environment, running on Dandelions. Unfortunately the
whole thing is over 2000 lines long, so I'll only post the "inner-loop"
module, the definitions, and the documentation. The user interface,
and state-machine tables are too big to post.
The design goals of this Life were:
1) be able to display any reasonable position (e.g. The Breeder)
2) be fast
3) be compact
4) use the bitmap in for a spiffy display
It will display any position up to 2^31 x 2^31 cells in size, its
speed is linear in the number of living cells plus the number of
rows with living cells in them, it uses space same as time, and
it displays on a bitmap.
For those of you truly fanatical, the whole thing is on
TAHOE::USER1:[haynes.life]*.*
I also have quite a few patterns in "Gosper" format (see Life.doc).
Strange ocillators, glider collisions, glider gun, puffer train,
Breeder etc. If you have a program that will accept this format, I'll
be glad to put the files somewhere accessable. (They live on an Ultrix
machine).
If you find a mesa compiler, please let me know! Someday I'll port
this sucker to Ultrix Modula-2 and X for my GPX, but not right now...
Die-hard Mesa fanatic,
-- Charles
Here are the files.
-- Life.doc, last edit:
-- Haynes, 28-Nov-83 3:26:45
--------------------------------------------------------------------------------
I - Overview
--------------------------------------------------------------------------------
This document is divided into five parts
I - Overview
II - The tool
III - Input Format for the "Load" command
IV - The rules of "Life"
V - Programming Notes
LifeWindow.bcd is an implementation of John Horton Conway's cellular
automata simulation "Life". See Martin Gardner's "Mathematical Games"
of sometime in the late 60's for a full explanation.
--------------------------------------------------------------------------------
II - The tool
--------------------------------------------------------------------------------
LifeWindow will bring up a scrollable graphic window for the cell
display. You add cells with Point and delete them with Adjust. The
"Life" menu attached to this window has six commands: Go, Next, Shrink,
Magnify, Clear, and Load.
Go:
Run the simulation, updating the display as you go.
Next:
Display the next generation.
Shrink:
Reduce the cell size by a factor of two.
Magnify:
Increase the cell size by a factor of two.
Clear:
Erase the board and re-center it.
Load:
Load the board from the current selection. There are some interesting
positions in >Source>Life>*.life. Select in the file starting at any
"D" and ending just before the next one, then use this command.
You can bring up a property sheet (FormSW) by hitting [Control]
otherwise known as [Prop's]. The property sheet is destroyed when the
Life window is deactivated, or you hit [Prop's] again. This FormSW has
the following items in it: Close, Dump, File Name, Generation, Cells,
and Scale.
Close:
Closes the output file.
Dump:
If the output file is open, it appends the current pattern to it. If
there is no output file open, and no name for one, it dumps the pattern
to the msgSW, otherwise it opens the log file named in File Name, and
outputs the current pattern to it.
File Name:
String item to specify the file name for Dump, if an output file is
open, it will be the name used to open the file.
Generation:
Generation number, incremented for each new generation. Can be set
manually.
Cells:
Number of living cells in the current generation.
Scale:
Set the size of the individual cells.
Generating will stop under the following conditions:
1) The [STOP] key is pressed while the cursor is in the Life Window.
2) The position exceeds the storage allocated to it (free disk space).
3) The position exceed the boundaries of the board (currently 32767 x
32767)
4) The position dies completely.
5) The Life Window is deactivated.
The position CAN be edited dynamically. It's fun! Try it.
--------------------------------------------------------------------------------
III - Input Format for the "Load" command
--------------------------------------------------------------------------------
These are the "official" Life Commands from Gosper's Life program at
Stanford. Thanks to Don Woods for snarfing them for me. I suspect
small glitches in it and have interpolated what I thought were missing
characters. Local modifications follow the complete list.
Life (Virtual machine) Commands
P Advance one generation
D,E Enter input mode, D also clear screen.
. Insert point at center and move center right.
n. Do . n times.
n<sp> Move center right n places.
x,y<delim> Insert pt. at x,y (relative to center).
x,yD Delete pt. at x,y.
x,yC Move center to x,y.
nD Delete n pt. right (or left).
n<cr> Set x to 0 and add n to y.
n_ Go left n places.
n^,n<lf> Figure it out for yourself.
nX,nY Move X (Y) n positions.
n# Set generation no. to n.
E Leave input mode.
I,O Select file for input,output
W Write current screen pattern onto output file.
C CLOSE disk output
nR Read n'th pattern from input file.
Print generation no. and no. of points.
Print scale and (if nonzero) shift factor.
S n>0 sets scale to n. *n0 set shift factor to n.
X,Y Prints X(Y)-coordinate of focal pt.
nX,nY Adds n to focal pt.
n^X(),n^Y() Set focal pt. to n.
XORG_-XOFF, YORG_-YOFF, Print XORG and YORG
<cr>,<lf>,<ff> No-ops
;,: Comment, ignores text to <cr>
Q QUIT Exit, return screen to normal
nP if n>0, proceed n steps. otherwise |n|-k steps
nG set current generation to n
Local modifications:
There is no "edit" mode, what I have implemented is the following
subset:
Note: lower case letters are used as non-terminals, anywhere an
uppercase letter is used, its lowercase equivalent is allowed.
X,. Insert point at center and move center right
O,<sp> Move center right
; Comment, ignores text to <cr>
D Clear the screen, reset center to middle of board
E,<eof> Terminates inputting a pattern
R,<cr>,<lf>,<ff> No-ops
n. Do "." n times
n<sp> Do "<sp>" n times
nD delete point n to the right (or left)
n<cr> center _ [row: center.row+n, col: 0];
n_ center.col _ center.col-n (**BUG** currently adds n instead)
n^ center.row _ center.row-n (**BUG** currently adds n instead)
n<lf> center.row _ center.row+n (**BUG** currently subtracts)
nX center.col _ center.col+n
nY center.row _ center.row+n
nG,n# generation _ n
nS scale _ n (currently only 1, 2, 4, 8, and 16 implemented, others
go to next higher value, or 16)
x,yD Delete point at (col, row) x,y
x,yC set center to x,y
x,y. Add point at x,y
Note that life is completely symmetric so the choice of which are rows
and which are columns, and which direction is "increasing" is completely
arbitrary.
--------------------------------------------------------------------------------
IV - The rules of "Life"
--------------------------------------------------------------------------------
Life is played on a rectilinear grid. Each position has eight
neighbors.
A cell dies if it has 0 or 1 neighbor (underpopulation)
A cell lives if it has 2 or 3 neighbors
A cell dies if it has 4 or more neighbors (overpopulation)
A new cell is born in any empty space with exactly three neighbors.
So for example the position "blinker":
abcde
1 00000
2 01110
3 00000 (where 0 is a dead position and 1 is a live cell)
becomes
bcd
0 000
1 010
2 010
3 010
4 000
a2 dies (underpopulation)
b2 lives (2 neighbors)
c2 dies (underpopulation)
c1, c3 are born.
etc.
--------------------------------------------------------------------------------
V - Programming Notes
--------------------------------------------------------------------------------
For those of you who might be interested in implementing Life with
another user interface, here are some notes.
A Board (position) is a sequence of Rows in ascending order, ending with
an empty Row. A row is a Row Entry followed by a sequence of Col
Entry's in ascending order (see Life.mesa).
Generate takes a Board that is the current position (oldBoard) and a
Board to put the new position into (newBoard), a procedure to call for
each cell that changes state (noteChange), and client data to pass to
noteChange. oldBoard[0] is the Row Entry of the first row,
oldBoard[oldBoard.LENGTH-1] is the Row Entry of the empty row at the
end. newBoard[0] is where to put the Row Entry of the first Row of the
new position and newBoard.LENGTH is the maximum number of entries that
you can put into newBoard. newBoard[newMaxIndex] is the Row Entry of
the empty Row at the end of the new position. cells is the number of
living cells in newBoard.
the following loop can be used to generate new positions until a
termination condition arises:
DO
temp: BoardHandle;
[maxIndex, cells] _
Life.Generate[
oldBoard: DESCRIPTOR[board, maxIndex+1],
newBoard: DESCRIPTOR[nextBoard, boardSize],
noteChange: NoteChange,
cd: graphSW
! Life.Error => {
SELECT code FROM
dead => Put.Text[msgSW, "\NDead..."L];
boardTooSmall => Put.Text[msgSW, "\NToo many cells for
board..."L];
atEdge => Put.Text[msgSW, "\NAt edge..."L];
ENDCASE;
GOTO exit}];
temp _ board; board _ nextBoard; nextBoard _ temp;
REPEAT
exit => {};
ENDLOOP;
Error is raised if any of the obvious termination conditions arise.
Some day I may add a signal Stable that gets raised if the position in
oldBoard is "uninteresting".
The NoteChangeProc is called with your client data, the Row and Col of
the cell that chenged state, and whether or not it is NOW living.
Implementation details:
LifeImpl is basically a 64 state finite state machine. Consider the
current 9x9 of interest:
abc
1 xxx
2 xxx
3 xxx
the current state is defined by the cells in columns a and b. the input
to the state machine is column c. The output is the tuple (newState,
changed, living). New state is just columns b and c, changed and living
are defined by the rules of Life. I keep a row cursor which is the row
number of "row 3" in the diagram, and a column cursor which is the
column number of "column c" in the diagram. Calculating the input is
the bulk of the algorithm. The algorithm is linear in the number of
living cells plus the number of rows with living cells in them. The
constant of proportionality is roughly three (since I have to look at
each living cell three times, once for the row before it, once for the
row it's in, and once for the row following it), the fixed overhead per
generation is quite low.
-- LifeImpl.mesa, Last Edit:
-- Haynes, 6-Nov-83 21:08:27
DIRECTORY
Life USING [Board, ClientData, Col, Entry, ErrorCode, NoteChangeProc,
Row],
LifeState USING [Alive, changed, Input, output, State, transitions];
LifeImpl: PROGRAM EXPORTS Life =
BEGIN
----------
-- Types
----------
Board: TYPE = Life.Board;
ClientData: TYPE = Life.ClientData;
Entry: TYPE = Life.Entry;
Col: TYPE = Life.Col;
Row: TYPE = Life.Row;
Alive: TYPE = LifeState.Alive;
State: TYPE = LifeState.State;
Input: TYPE = LifeState.Input;
RowState: TYPE = CARDINAL [0..8);
RowInput: TYPE = BOOLEAN;
----------
-- Variables
----------
rowTransitions: ARRAY RowState OF ARRAY RowInput OF RowState = [
-- 0 ... -- [FALSE: 0, TRUE: 0],
-- 1 ..X -- [FALSE: 2, TRUE: 3],
-- 2 .X. -- [FALSE: 4, TRUE: 5],
-- 3 .XX -- [FALSE: 6, TRUE: 7],
-- 4 X.. -- [FALSE: 0, TRUE: 1],
-- 5 X.X -- [FALSE: 2, TRUE: 3],
-- 6 XX. -- [FALSE: 4, TRUE: 5],
-- 7 XXX -- [FALSE: 6, TRUE: 7]];
prev, this, next: LONG POINTER TO Entry;
nextEntry, maxEntry: LONG POINTER TO Entry;
----------
-- Public Procs
----------
Error: PUBLIC ERROR [code: Life.ErrorCode] = CODE;
Generate: PUBLIC PROCEDURE [
oldBoard, newBoard: Board, noteChange: Life.NoteChangeProc, cd:
ClientData]
RETURNS [newMaxIndex: CARDINAL, cells: CARDINAL] =
BEGIN
T: BOOLEAN = TRUE;
F: BOOLEAN = FALSE;
doRows: ARRAY RowState OF RECORD [BOOLEAN, BOOLEAN, BOOLEAN] = [
[F, F, F], [F, F, T], [F, T, F], [F, T, T], [T, F, F], [T, F, T],
[T, T, F], [T, T, T]];
rowState: RowState;
rowCursor: Row;
lastEntry: LONG POINTER TO Entry =
@oldBoard[oldBoard.LENGTH-SIZE[Entry]];
IF oldBoard.LENGTH = 1 THEN ERROR Error[dead];
nextEntry _ @newBoard[0];
maxEntry _ @newBoard[newBoard.LENGTH-SIZE[Entry]];
prev _ this _ next _ @oldBoard[0];
IF this^ = Row.FIRST THEN ERROR Error[atEdge];
nextEntry^ _ this^-1;
rowState _ 1;
cells _ 0;
WHILE rowState # 0 DO
input: RowInput;
doPrev, doThis, doNext: BOOLEAN;
[doPrev, doThis, doNext] _ doRows[rowState];
IF rowState = 1 THEN rowCursor _ this^;
cells _ cells + DoRow[rowCursor-1, doPrev, doThis, doNext,
noteChange, cd];
rowCursor _ SELECT TRUE FROM
rowState = 4 => next^,
rowCursor < Row.LAST => rowCursor+1,
ENDCASE => ERROR Error[atEdge];
NewRow[rowCursor-1];
input _ next # lastEntry AND rowCursor = next^;
rowState _ rowTransitions[rowState][input];
ENDLOOP;
newMaxIndex _ CARDINAL[(nextEntry-@newBoard[0])/SIZE[Entry]];
END;
----------
-- Procs
----------
NewRow: PROCEDURE [row: Row] = INLINE {
IF nextEntry^ NOT IN Row THEN {
IF nextEntry = maxEntry THEN ERROR Error[boardTooSmall];
nextEntry _ nextEntry+SIZE[Entry]};
nextEntry^ _ row};
NewCol: PROCEDURE [col: Col] = INLINE {
IF nextEntry = maxEntry THEN ERROR Error[boardTooSmall];
nextEntry _ nextEntry+SIZE[Entry];
nextEntry^ _ col};
MinProc: TYPE = PROCEDURE RETURNS [Col];
MinN: MinProc = {RETURN[next^]};
MinT: MinProc = {RETURN[this^]};
MinTN: MinProc = {RETURN[MIN[this^, next^]]};
MinP: MinProc = {RETURN[prev^]};
MinPN: MinProc = {RETURN[MIN[prev^, next^]]};
MinPT: MinProc = {RETURN[MIN[prev^, this^]]};
MinPTN: MinProc = {RETURN[MIN[prev^, this^, next^]]};
min: ARRAY --prev-- BOOLEAN OF
ARRAY --this-- BOOLEAN OF
ARRAY --next-- BOOLEAN OF MinProc = [
FALSE: [ -- prev
FALSE: [FALSE: NIL, TRUE: MinN], -- this
TRUE: [FALSE: MinT, TRUE: MinTN]], -- this
TRUE: [ -- prev
FALSE: [FALSE: MinP, TRUE: MinPN], -- this
TRUE: [FALSE: MinPT, TRUE: MinPTN]]]; -- this
DoRow: PROCEDURE [
row: Row,
doPrev, doThis, doNext: BOOLEAN,
noteChange: Life.NoteChangeProc, cd: ClientData] RETURNS [cells:
CARDINAL] =
BEGIN
state: State _ 0;
cursor: Col;
cells _ 0;
IF doPrev THEN prev _ prev+SIZE[Entry];
IF doThis THEN this _ this+SIZE[Entry];
IF doNext THEN next _ next+SIZE[Entry];
DO
input: Input _ 0;
IF state = 0 THEN
IF doPrev OR doThis OR doNext THEN cursor _
min[doPrev][doThis][doNext][]
ELSE EXIT;
IF doPrev AND cursor = prev^ THEN {
input _ input+4; prev _ prev+SIZE[Entry]; doPrev _ prev^ ~IN
Row};
IF doThis AND cursor = this^ THEN {
input _ input+2; this _ this+SIZE[Entry]; doThis _ this^ ~IN
Row};
IF doNext AND cursor = next^ THEN {
input _ input+1; next _ next+SIZE[Entry]; doNext _ next^ ~IN
Row};
IF LifeState.output[state][input] # dead THEN {
IF cursor = Col.FIRST THEN ERROR Error[atEdge];
cells _ cells+1;
NewCol[cursor-1]};
IF noteChange # NIL AND LifeState.changed[state][input] THEN
noteChange[cd, row, cursor-1, LifeState.output[state][input] #
dead];
state _ LifeState.transitions[state][input];
IF cursor = Col.LAST THEN ERROR Error[atEdge];
cursor _ cursor+1;
ENDLOOP;
END;
END.
|
99.80 | Is Knuth on the USENET? | SQM::HALLYB | Free the quarks! | Wed Sep 10 1986 19:22 | 3 |
| Maybe somebody has the guts to try writing in WEB?
John
|
99.81 | No, but he's on the internet | TAHOE::HAYNES | Charles Haynes | Wed Sep 10 1986 21:11 | 6 |
| Knuth is DEK@SU-AI.ARPA or RHEA::DECWRL::"DEK@SU-AI.ARPA" (I think
this is the right way to get from E-net to Arpa).
I assume HALLYB wasn't serious in .-1, but just in case...
-- Charles
|
99.82 | Small is beautiful! | PASTIS::MONAHAN | | Thu Sep 11 1986 09:57 | 18 |
| The first implementation of Life that I saw was implemented
in BLIP (Block-structured Interpreter Programme).
BLIP was a set of symbol definitions prepended to source code,
and then processed by the PAL-3 assembler. The resulting object
code was then run with an interpreter also written in PAL-3.
The implementation used a 128*128 board, and displayed on a
storage scope. It got very slow as the number of "things" got larger,
but then it did run on a 4k PDP-8 with no mass storage. If I still
had the paper tape I might enter it, but then this VAX does not
have an ASR-33 to read it in with.
But maybe size of machine required to run the thing should be
counted as part of the comparison criteria. That might bring the
Lisp score down a bit :-) :-)
Dave
|
99.83 | for your amusement | SJS::SAVIGNANO | Stephen Savignano - Lisp Devo | Thu Sep 11 1986 12:46 | 153 |
|
I resisted posting this for fear of reducing this discussion to
shouting match of personal and prejudicial opinions. But after
.82's :-) about the Walter's Lisp solution I thought is might be
amusing. I got this from the ARPAnet. Enjoy.
----------------------------------------------------------------
I think that I shall never see
A matrix lovely as a tree.
Trees are fifty times as fun
As structures a la PL/I
(Which Dijkstra claims are too baroque).
And SNOBOL's strings just can't compare
With all the leaves a tree may bear,
And COMIT strings are just a joke.
Vectors, tuples too, are nice,
But haven't the impressive flair
Of trees to which a LISP is heir.
A LISPer's life is paradise!
Many people think that JOSS
And others too, are strictly boss;
And there are many BASIC fans
Who think their favorite language spans
All that would a user please.
Compared to LISP they're all a loss,
For none of them gives all the ease
With which a LISP builds moby trees.
RPG is just a nurd
(As you no doubt have often heard);
The record layouts are absurd,
And numbers packed in decimal form
Will never fit a base-two word
Without a veritable storm
Of gross conversions fro and to
With them arithmetic to yield
And decimal places represent
Truncation loss to circumvent:
Thus RPG is second-rate.
In LISP one needn't allocate
(That boon alone is heaven-sent!)
The scheme is sheer simplicity:
A number's just another tree.
When numbers threaten overflow
LISP makes the number tree to grow,
Extending its significance
With classic tree-like elegance.
A LISP can generate reports,
Create a file, do chains and sorts;
But one thing you will never see
Is moby trees in RPG.
One thing the average language lacks
Is programmed use of push-down stacks.
But LISP provides this feature free:
A stack -you guessed it- is a tree.
An empty stack is simply NIL.
In order, then, the stack to fill
A CONS will push things on the top;
To empty it, a CDR will
Behave exactly like a pop.
A simple CAR will get you back
The last thing you pushed on the stack;
An empty stack's detectable
By testing with the function NULL.
Thus even should a LISPer lose
With PROGs and GOs, RETURNs and DOs,
He need his mind not overtax
To implement recursive hacks:
He'll utilize this clever ruse
Of using trees as moby stacks.
Some claim this method slow
Because it uses CONS so much
And thus requires the GC touch;
It has one big advantage, though:
You needn't fear for overflow.
Since LISP allows its trees to grow,
Stacks can to any limits go.
COBOL input is a shame:
The implementors play a game
That no two versions are the same.
And rocky is the FORTRAN road
One's alpha input to decode:
The FORMAT statement is to blame
But on the user falls the load.
And FOCAL input's just a farce;
But all LISP input comes pre-parsed!
(The input reader gets its fame
By getting storage for each node
From lists of free words scattered sparse.
It parses all the input strings
With aid of mystic mutterings;
From dots and strange parentheses,
From zeros, sevens, A's and Z's,
Constructs, with magic reckonings,
The pointers needed for its trees
It builds the trees with complex code
With rubout processing bestowed;
When typing errors do forebode
The rubout makes recovery tame,
And losers then will oft exclaim
Their sanity to LISP is owed -
To help these losers is Lisp's aim.)
The flow-control of APL
And OS data sets as well
Are best described as tortured hell.
For LISPers everything's a breeze;
They neatly output all their trees
With format-free parentheses
And see their program logic best
By how their lovely parens nest.
While others are by GOs possessed,
And WHILE-DO, CASE, and all the rest,
The LISPing hackers will prefer
With COND their programs to invest
And let their functions all recur
When searching trees in maddened quest.
Expanding records of fixed size
Will quickly programs paralyze.
Though ISAM claims to be so wise
In allocating overflow,
Its data handling is too slow
And finding it takes many tries.
But any fool can plainly see
Inherent flexiblilty
In data structured as a tree.
When all their efforts have gone sour
To swell fixed records, losers glower.
But list reclaimers hour by hour
By setting all the garbage free
Yield CONSequent capacity:
Thus trees indefinitely flower.
(And trees run on atomic power!)
To men of sensibility
The lesson here is plain to see:
Arrays are used by clods like me,
But only LISP can make a tree.
-The Great Quux (with apologies to Joyce Kilmer)
((c) 1973 Guy L. Steele Jr. @MIT )
|
99.84 | It is possible in DCL | QUARK::LIONEL | Reality is frequently inaccurate | Thu Sep 11 1986 17:31 | 3 |
| I remember seeing a DCL version back in Tewksbury, written by
Trev Porter, I think. That was about six years ago or more.
Steve
|
99.85 | Here is a simple BLISS version of LIFE | STAR::VATNE | | Thu Sep 11 1986 17:47 | 221 |
| MODULE LIFE (MAIN = LIFE) =
BEGIN
SWITCHES
ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE);
LIBRARY 'SYS$LIBRARY:STARLET';
LITERAL
EMPTY = 0,
BLOT = 1,
X_LIMIT = 40,
Y_LIMIT = 20,
INPUT_MAX_LENGTH = 80,
OUTPUT_MAX_LENGTH = 80;
STRUCTURE
ARRAY [I, J; M, N, UNIT=%UPVAL, EXT=1] =
[M*N*UNIT]
(ARRAY+(I*N+J))<0,8*UNIT,EXT>;
MACRO
BOARD_TYPE =
ARRAY [X_LIMIT+2, Y_LIMIT+2, BYTE] %,
STATIC_STRING_DESC =
BLOCK [DSC$K_S_BLN, BYTE] %,
CH$SEQUENCE (N) =
VECTOR [CH$ALLOCATION (N)] %,
RETURN_IF_ERROR (ACTION) =
BEGIN
LOCAL
STATUS : LONG;
STATUS = ACTION;
IF (NOT .STATUS)
THEN
RETURN .STATUS;
.STATUS
END %;
KEYWORDMACRO
INIT_STATIC_STRING_DESC (DESC = DESC, LENGTH = LENGTH, ADDRESS = ADDRESS) =
BEGIN
DESC [DSC$B_CLASS] = DSC$K_CLASS_S;
DESC [DSC$B_DTYPE] = DSC$K_DTYPE_D;
DESC [DSC$W_LENGTH] = LENGTH;
DESC [DSC$A_POINTER] = ADDRESS;
END %;
EXTERNAL ROUTINE
LIB$CVT_DTB,
LIB$GET_INPUT,
LIB$LOCC,
LIB$PUT_OUTPUT,
LIB$SYS_FAO;
FORWARD ROUTINE
INITIALIZE,
PRINT_BOARD : NOVALUE,
NEW_GENERATION : NOVALUE,
LIFE;
ROUTINE INITIALIZE (BOARD : REF BOARD_TYPE) =
BEGIN
LOCAL
X : LONG,
Y : LONG,
INPUT_LINE_DESC : STATIC_STRING_DESC,
INPUT_LINE : CH$SEQUENCE (INPUT_MAX_LENGTH),
INPUT_LINE_LENGTH : WORD,
DELIMITER_POSITION : LONG;
CH$FILL (EMPTY, %SIZE (BOARD_TYPE), .BOARD);
LIB$PUT_OUTPUT (%ASCID'To bring a cell to life, type the X and Y coordinates');
LIB$PUT_OUTPUT (%ASCID'separated by a space, 0 0 to end. Range is 40 x 20.');
INIT_STATIC_STRING_DESC (DESC = INPUT_LINE_DESC,
LENGTH = INPUT_MAX_LENGTH,
ADDRESS = INPUT_LINE);
WHILE 1 DO
BEGIN
RETURN_IF_ERROR (
LIB$GET_INPUT (INPUT_LINE_DESC, %ASCID'X Y> ', INPUT_LINE_LENGTH));
DELIMITER_POSITION = LIB$LOCC (%ASCID' ', INPUT_LINE_DESC);
IF NOT LIB$CVT_DTB (.DELIMITER_POSITION-1, INPUT_LINE, X) THEN
X = -1;
IF NOT LIB$CVT_DTB (.INPUT_LINE_LENGTH-.DELIMITER_POSITION,
INPUT_LINE+.DELIMITER_POSITION,
Y) THEN
Y = -1;
IF (.X EQL 0) AND (.Y EQL 0) THEN
EXITLOOP;
IF ( .X GEQ 1 AND .X LEQ X_LIMIT AND
.Y GEQ 1 AND .Y LEQ Y_LIMIT) THEN
BOARD [.X,.Y] = BLOT
ELSE
LIB$PUT_OUTPUT (%ASCID'Out of range.');
END;
RETURN SS$_NORMAL;
END;
ROUTINE PRINT_BOARD (BOARD : REF BOARD_TYPE) : NOVALUE =
BEGIN
LOCAL
X : LONG,
Y : LONG,
OUTPUT_LINE_DESC : STATIC_STRING_DESC,
OUTPUT_LINE : CH$SEQUENCE (X_LIMIT*2),
OUTPUT_POINTER : LONG;
INIT_STATIC_STRING_DESC (DESC = OUTPUT_LINE_DESC,
LENGTH = X_LIMIT*2,
ADDRESS = OUTPUT_LINE);
INCR Y FROM 1 TO Y_LIMIT DO
BEGIN
OUTPUT_POINTER = CH$PTR (OUTPUT_LINE);
INCR X FROM 1 TO X_LIMIT DO
CASE .BOARD [.X,.Y] FROM EMPTY TO BLOT OF
SET
[EMPTY]:
BEGIN
CH$WCHAR_A (%C'.', OUTPUT_POINTER);
CH$WCHAR_A (%C' ', OUTPUT_POINTER);
END;
[BLOT]:
BEGIN
CH$WCHAR_A (%C'O', OUTPUT_POINTER);
CH$WCHAR_A (%C' ', OUTPUT_POINTER);
END;
TES;
LIB$PUT_OUTPUT (OUTPUT_LINE_DESC);
END;
LIB$PUT_OUTPUT (%ASCID'');
END;
ROUTINE NEW_GENERATION (NEW_BOARD : REF BOARD_TYPE) : NOVALUE =
BEGIN
LOCAL
X : LONG,
Y : LONG,
TOTAL : BYTE,
OLD_BOARD : BOARD_TYPE;
CH$MOVE (%SIZE (BOARD_TYPE), .NEW_BOARD, OLD_BOARD);
INCR X FROM 1 TO X_LIMIT DO
INCR Y FROM 1 TO Y_LIMIT DO
BEGIN
TOTAL = .OLD_BOARD [.X-1,.Y-1]
+ .OLD_BOARD [.X,.Y-1]
+ .OLD_BOARD [.X+1,.Y-1]
+ .OLD_BOARD [.X-1,.Y]
+ .OLD_BOARD [.X+1,.Y]
+ .OLD_BOARD [.X-1,.Y+1]
+ .OLD_BOARD [.X,.Y+1]
+ .OLD_BOARD [.X+1,.Y+1];
IF (.TOTAL LEQ 1) OR (.TOTAL GEQ 4) THEN
NEW_BOARD [.X,.Y] = EMPTY
ELSE
IF (.TOTAL EQL 3) THEN
NEW_BOARD [.X,.Y] = BLOT;
END;
END;
ROUTINE LIFE =
BEGIN
LOCAL
INPUT_LINE_DESC : STATIC_STRING_DESC,
INPUT_LINE : CH$SEQUENCE (INPUT_MAX_LENGTH),
INPUT_LINE_LENGTH : WORD,
OUTPUT_LINE_DESC : STATIC_STRING_DESC,
OUTPUT_LINE : CH$SEQUENCE (OUTPUT_MAX_LENGTH),
OUTPUT_LINE_LENGTH : WORD,
LAST_GENERATION : LONG,
BOARD : BOARD_TYPE;
LIB$PUT_OUTPUT (%ASCID'How many generations do you want?');
INIT_STATIC_STRING_DESC (DESC = INPUT_LINE_DESC,
LENGTH = INPUT_MAX_LENGTH,
ADDRESS = INPUT_LINE);
WHILE 1 DO
BEGIN
RETURN_IF_ERROR (
LIB$GET_INPUT (INPUT_LINE_DESC,
%ASCID'Generations> ',
INPUT_LINE_LENGTH));
LIB$CVT_DTB (.INPUT_LINE_LENGTH, INPUT_LINE, LAST_GENERATION);
IF .LAST_GENERATION GTR 0 THEN
EXITLOOP;
LIB$PUT_OUTPUT (%ASCID'Please enter a number greater than 0.');
END;
RETURN_IF_ERROR (INITIALIZE (BOARD));
LIB$PUT_OUTPUT (%ASCID'Starting configuration:');
PRINT_BOARD (BOARD);
INCR GENERATION FROM 1 TO .LAST_GENERATION DO
BEGIN
NEW_GENERATION (BOARD);
INIT_STATIC_STRING_DESC (DESC = OUTPUT_LINE_DESC,
LENGTH = OUTPUT_MAX_LENGTH,
ADDRESS = OUTPUT_LINE);
RETURN_IF_ERROR (
LIB$SYS_FAO ( %ASCID'Generation # !UL',
OUTPUT_LINE_LENGTH,
OUTPUT_LINE_DESC,
.GENERATION));
INIT_STATIC_STRING_DESC (DESC = OUTPUT_LINE_DESC,
LENGTH = .OUTPUT_LINE_LENGTH,
ADDRESS= OUTPUT_LINE);
LIB$PUT_OUTPUT (OUTPUT_LINE_DESC);
PRINT_BOARD (BOARD);
END;
RETURN SS$_NORMAL;
END;
END
ELUDOM
|
99.86 | | LOGIC::VANTREECK | | Thu Sep 11 1986 19:35 | 10 |
| re: .76, .77
I agree that important criteria to judge a language on is the
completeness of the module system and data abstraction. Two other
distinctions can be made: 1) procedural vs declarative language, 2)
symbolic vs numeric. I think that, typically, 4th generation implies it
is a declarative language. And the procedural languages are considered
to be earlier generations.
-George
|
99.87 | | SMOP::GLOSSOP | Kent Glossop | Thu Sep 11 1986 22:44 | 6 |
| Note that there is a version of LISP that runs on a 4K PDP-8. (True,
it's a rather minimal implementation, but it was on par with the other
rather restricted implementations that managed to fit in 4K, like FOCAL,
ALGOL, BASIC, FORTRAN-II, etc.)
Kent
|
99.88 | Current Program Entries | JUNIPR::DMCLURE | Vaxnote your way to ubiquity | Thu Sep 11 1986 23:29 | 116 |
| NOTE: I'm leaving for a vacation in the Florida sun, but I'll be back to the
front lines in a week or so. Since it looks like we've managed to assemble
a pretty hefty squadron of fighter programs, then maybe it's time to start
concentrating on assembling a list of criteria to use in comparing these
various languages. I'll try to go through and pick out the various sug-
gestions for criteria when I get back, and then compile a list, etc. In
the meantime, keep that code rolling in!
-davo
--------------------------------------------------------------------------------
Entry Language Reply Supplier Name Tested Votes
----- ------------- ----- ----------------------------- ------ --------
(1) VAX C 99.4 TLE::MORRIS (Robert) yes 0
(2) VAX Pascal 99.5 REGENT::MPCOHAN (Michael) yes 0
(3) VAX PL/I 99.15 SMOP::GLOSSOP (Kent) yes 0
(4) LISP 99.16 BACH::VANROGGEN (Walter) yes 0
(5) DESIGN 99.17 JUNIPR::DMCLURE (Davo) yes 0
(6) KOALA 99.18 KOALA::ROBBINS (Scott) no 0
(7) VAX BASIC/BP2 99.29 WHYVAX::HETRICK (Brian) yes 0
(8) FORTRAN 99.30 JUNIPR::DMCLURE (Davo) yes 0
(9) TECO 99.35 STAR::VATNE (Peter) yes 0
(10) MODULA-2 99.37 TLE::NOLAN (Chris) no 0
(11) VAX DSM 99.38 OZONE::CRAIG (Bob) yes 0
(12) VAX APL 99.40 TLE::NOLAN (Chris) no 0
(13) MACRO 99.42 VAXWRK::PRAETORIUS (Robert) no 0
(14) BASIC/BP2 99.44 EVER::EKLOF (Mark) yes 0
(15) VAXTPU 99.51 WHYVAX::BUXBAUM (Mark) yes 0
(16) CPROLOG 99.55 NZOV01::DENHARTOG (Robert) no 0
(17) VAXTPU 99.56 TOHOKU::TAYLOR (Mike) yes 0
(18) VAX ADA 99.57 TLE::MEIER (Bill) yes 0
(19) VAXTPU 99.58 DSSDEV::TANNENBAUM (Barry) no 0
(20) VAXTPU 99.60 ERLANG::WHALEN (Richard) yes 0
(21) VAX MACRO 99.64 FSTVAX::DICKINSON (Doug) yes 0
(22) VAX PL/I 99.65 HYDRA::ECKERT (Jerry) yes 0
(23) FIG-FORTH 99.67 NZOV03::DENHARTOG (Robert) no 0
(24) VAX-11 SNOBOL 99.70 SQM::HALLYB (?) no 0
(25) COBOL 99.73 LATOUR::KSTEVENS (Ken) yes 0
(26) VS-II 99.78 ENGINE::ROTH (Jim) no 0
(27) MESA 99.79 TAHOE::HAYNES (Charles) no 0
(28) BLISS 99.85 STAR::VATNE (Peter) yes 0
--------------------------------------------------------------------------------
Listed above are the current program entries in order of appearance.
As you can see, I haven't had a chance to test all of these programs so
far for various reasons (mostly due to lack of neccessary compilers, etc.),
so I would appreciate if anyone (other than the Supplier) who has performed
tests on any of the programs listed here would contact me by mail so that I
might update this, I (as well as they) would most likely appreciate it.
Also, you may have noticed the Votes column, as you can see, the
voting has been very close so far...mainly due to the fact that I'm not
sure whether voting is either feasable, fair, or useful. However, if
we had a method of easily reading in votes, then we could vote on whether
or not to vote for these programs. I'm currently investigating some soft-
ware to allow for this sort of feedback.
--------------------------------------------------------------------------------
BASIC-PLUS-2 {EVER11,WHYVAX}::BP2
BLISS TLE::BLISS
DIBOL {FREMEN,CLOUD9,BCSENG}::DIBOL
DIGITAL Standard MUMPS VAXWRK::DSM
Datatrieve Interest Group DAMSEL::DTRDIG
FORTH TALLIS::FORTH
KOALA KOALA::KOALA
LISP {BACH,BARTOK,BIZET}::LISP
Logic Programming (PROLOG) {LOGIC,BIZET,BACH,BARTOK,BLAKE}::PROLOG
MODULA-2 TLE::MODULA
MicroPower/PASCAL PAXVAX::MPPNOTES
Natural Language Computation CDR::NATURAL_LANGUAGE_COMPUTATION
OPS5 {LOGIC,BIZET,BACH,BARTOK,BLAKE}::OPS5
Object Oriented Design/Language SERVU::OBJECT_ORIENTED
PDP-11 COBOL or COBOL-81 {WHYVAX,EVER11}::COBOL81
POSTSCRIPT {RAJA,REX,PAUPER}::POSTSCRIPT
PRODUCER - IVIS Course Dev. ToolCYCLPS::PRODUCER
TCL-Ted's Command Language {HBO,MTV,ESPN}::TCL
TECO DSSDEV::TECO
VAX APL TLE::APL
VAX Ada TLE::ADA
VAX BASIC CLT::VAX_BASIC
VAX C TLE::VAXC
VAX COBOL CLT::COBOL
VAX FORTRAN TLE::FORTRAN
VAX PASCAL TLE::PASCAL
VAX PL/I TLE::PLI
VAX SCAN CLT::SCAN
VAX SDL TLE::SDL
VAX SNOBOL CLT::SNOBOL
VAXELN Ada TLE::VAXELN_ADA
XLISP {ALIEN,BEING}::XLISP
XPORT TLE::XPORT
--------------------------------------------------------------------------------
Above Conferences currently containing Battle of the Languages
announcements (taken from the EASYNET_CONFERENCES note 2.2 list).
If anyone knows of a related conference which might also be interested
in this, let me know by mail and I'll post additional announcements there.
--------------------------------------------------------------------------------
MicroSoft Programming Languages PARVAX::MS_LANGUAGES
Computer GRAPHICS discussion SARAH::GRAPHICS
Programming Standards {SIVA,NANDI}::PROGSTNDS
VAX GKS, GKS, and GKS 3D DDSDEV::GKSNOTES
Games PICA::GAMES
Hackers {CLOSET|VAXUUM}::HACKERS
--------------------------------------------------------------------------------
Listed above are Language related notesfiles also containing announce-
ments.
--------------------------------------------------------------------------------
I will be updating this list from time to time as new entries come in,
and I plan to delete this reply when I add it back to the end of the topic
in it's updated form (to save space), so don't be surprised if it disappears
and reappears from time to time.
When a "sufficient number" of different languages have been entered,
the comparison will begin. While some of this will naturally occur simul-
taneously to the new program entries, the true comparison would be difficult
without a majority of languages represented. Keep that code rolling in!
-davo
|
99.90 | | VOGON::HAXBY | John Haxby -- Definitively Wrong | Sat Sep 20 1986 13:10 | 10 |
| As Andy Walker, author of "The Unix Environment", said in his book
and thereafter quoted by Brian Kernighan (no less): "Awk is one
of those languages which I occasionally think can be used to solve
almost any problem. Fortunately, the feeling wears off after about
a week".
jch
(Apologies to Andy for almost certainly mis-quoting him, but I got
the gist right)
|
99.91 | ULTRIX awk driven by csh (revised) | SMURF::JMARTIN | US out of Central America! | Mon Sep 22 1986 19:35 | 40 |
| Dear Mr. Haxby:
Thank you for your interest in our entry (formerly 99.89). The following
incorporates some bug fixes and improvements in readability. :-)
Your expressed misgivings about this undertaking have inspired us to
commence a feasibility study for a lex implementation in the hopes of giving
further offense.
Regards,
--Joe
--------------------------------cut here------------------------------------
#!/bin/csh
# Invoke with "<file_name> <generations> <seed>".
# <seed> is a text file with "*"s in even-numbered columns for live cells.
# Lines in <seed> are empty or end with "*".
# Uses VT100 control sequences.
echo '[2J'; cat $2 > life_0
@ n = 0
@ k = 0
while (1)
echo -n '[H'; cat life_$n; echo -n $k
if ($k == $1) break
@ m = $n
@ n = ($n + 1) % 2
awk 'BEGIN {FS = "*"} \
/\*/ {k = -1; for (i=1; i<=NF; i++) { \
k += (length($i)+1)/2 \
for (j = -1; j<2; j++) { \
row0[k+j] += 2; row1[k+j] += 2; row2[k+j] += 2} \
row1[k] -= 1 }} \
NR > 1 {for (i=0; i<40; i++) { \
if(row0[i]<5 || row0[i]>7) row0[i]=32; else row0[i]=42 \
printf(" %c",row0[i])} \
printf("\n")} \
{for (i=0; i<40; i++) {row0[i]=row1[i]; row1[i]=row2[i]; row2[i]=0}}\
END {for (i=0; i<40; i++) { \
if(row0[i]<5 || row0[i]>7) row0[i]=32; else row0[i]=42 \
printf(" %c",row0[i])} \
printf("\n")}' < life_$m > life_$n
@ k ++
end
|
99.92 | All quiet on the western front, however... | JUNIPR::DMCLURE | Vaxnote your way to ubiquity | Fri Sep 26 1986 06:41 | 13 |
| As the war against Ignorance, Isolation, and Incompatability
(WWIII) drags on, a new breakthrough in technology was discovered
in the Science Fiction notesfile which will serve to facilitate
data abstraction in ways never before dreamed possible!
Perhaps, with this new secret weapon, the surmounting tides
of the enemy will be driven back into submission and the Battle of
the Languages can soon be won!
See the official announcement of this exciting new development
in note 106.0 of this (TLE::LANGUAGES) notesfile.
-davo
|
99.93 | More Fun than Life | YIPPEE::GOULNIK | | Mon Sep 29 1986 09:12 | 370 |
|
I wrote a Lisp program last year, which on second thought looks very similar
to the game of life. I got the idea from an article in Scientific American, and
went a bit further. The original idea is a political simulation game, where
again you represent a population (of voters) on an N x M grid, each cell in the
grid being either black or white (2 political parties). Although you could
imagine filling it up manually, which I think is a tedious process, my initial
configuration is pseudo-randomly generated.
The simulation goes on as follows: the program keeps picking up cells randomly,
(individuals) and for each cell, picks up a neighbour (again randomly) and
replaces the political opininion of the original cell (black/white) by that of
his/her neighbour. Since I thought the model was over-simplified, I added the
following:
o Each cell has two paramaters, his/her opinion, not only 0/1 but any
value up to a specified maximum, AND a strength (or degree of belief in the
above mentionned opinion) again ranging from 1 to a specified maximum.
o The simulation program has been expanded to consider the new
parameters, as follows: the board is again generated randomly, opinion and
strength independantly. Then again, at each run, a cell is picked up randomly
(CELL) and a neighbour is picked up randomly (NEIGHBOUR), but the opinion
transfer uses the following rule:
o IF strength (CELL) < strength (NEIGHBOUR)
THEN opinion (CELL) <- opinion (NEIGHBOUR)
ELSE opinion (NEIGHBOUR) <- opinion (CELL)
It's been done in Vax Common Lisp as part of a training, and optimized to take
advantage of type specifiers and other fancy features of the implementation,
such as multiple return values, but if I was to re-code it, I think it'd be in
Pascal, slightly faster but significantly more compact.
To run the program, extract the following Lisp code into file.LSP, then :
o COMPILE LISP file.LSP/compile/optimize ! ignore the warnings
o LOAD LISP> (load "file.FAS"_)
o RUN LISP> (VOTERS SIZE OPINION STRENGTH LINE COLUM)
Supply the parameters as follow:
SIZE size of population
LINE,COLUMN size of grid
OPINION number of opinions (<10)
STRENGTH range of strengths
As I said earlier, the a population of SIZE individuals is generated in a grid,
and if SIZE is less than (LINE x COLUMN) it will be made up of islands. After
each pass (SIZE cells processed) the program displays for each opinion the
number of supporters and the sum of their strenghts.
Have fun.
Yves GOULNIK - European A.I. Technology Group / Valbonne.
(defun int-div (x y) (floor (/ x y)))
(defun erase-screen ()
"
erase VT100 screen
"
(write-char #\Escape)
(write-char #\[ )
(write-char #\2 )
(write-char #\J )
(values))
(defun set-cursor (line column)
"
move VT100 cursor to specified location
"
(declare (type fixnum line))
(declare (type fixnum column))
(write-char #\Escape)
(write-char #\[ )
(princ line)
(write-char #\; )
(princ column)
(write-char #\H )
(values))
(defun at-cursor (line column thing)
"
prints specified object to VT100
screen at specified location
"
(declare (type fixnum line))
(declare (type fixnum column))
(set-cursor line column)
(princ thing)
(values))
(defun voters (size part infl line column)
"
simulates the political opinion of a population
"
(declare (type fixnum size))
(declare (type fixnum line))
(declare (type fixnum column))
(declare (type fixnum part))
(declare (type fixnum infl))
(setf *gc-verbose* nil)
(setq *max-line* (min line 22))
(setq *max-column* (min column 50))
(setq *size* (min size (* *max-line* *max-column*)))
(setq *people* (make-array (list *max-line* *max-column*)))
(setq *average* (make-array (list part)))
(let()
(erase-screen)
(at-cursor 1 52 "initializing opinions")
(random-fill part infl)
(at-cursor 2 52 "propagating opinions")
(dotimes (pass *size*)
(screen-it (1+ pass) part)
(random-reset))))
(defun screen-it (pass part)
"
after each pass on the *people* population
screens it to determine opinion partitions
"
(declare (type fixnum pass))
(declare (type fixnum part))
(at-cursor 4 58 "pass")
(at-cursor 4 64 pass)
(dotimes
(a-part part)
(setf (aref *average* a-part) (quote (0 0))))
(dotimes
(at-x *max-line*)
(dotimes
(at-y *max-column*)
(update at-x at-y)))
(dotimes
(a-part part)
(at-cursor (+ a-part 8) 52 a-part)
(at-cursor (+ a-part 8) 56 ":: ")
(at-cursor (+ a-part 8) 60 (car (aref *average* a-part)))
(at-cursor (+ a-part 8) 64 ":: ")
(at-cursor (+ a-part 8) 68 (cadr (aref *average* a-part)))))
(defun update (at-x at-y)
"
updates the *average* array with the contents of the
specified cell of the *people* population
"
(declare (type fixnum at-x))
(declare (type fixnum at-y))
(let(
(at (aref *people* at-x at-y)))
(cond
((consp at)
(let(
(av (aref *average* (car at))))
(setf (aref *average* (car at))
(list (1+ (car av))
(+ (cadr av) (cadr at)))))))))
(defun random-reset ()
"
change the content of a random individual in the *people*
population to the content of one of its randomly chosen neighbour
"
(declare (type fixnum size))
(declare (type fixnum at-x))
(declare (type fixnum at-y))
(declare (type fixnum at-part))
(declare (type fixnum an-infl))
(declare (type fixnum an-x))
(declare (type fixnum an-y))
(declare (type fixnum an-part))
(declare (type fixnum an-infl))
(multiple-value-setq
(an-x an-y)
(get-fun (function consp)))
(dotimes (at *size*)
(let(
(at-x an-x)
(at-y an-y))
(multiple-value-setq
(an-x an-y)
(random-fun at-x at-y (function consp) t))
(multiple-value-setq
(at-part at-infl)
(get-it at-x at-y))
(multiple-value-setq
(an-part an-infl)
(get-it an-x an-y))
(cond
((< (random at-infl) (random an-infl))
(swap-opinion at-x at-y an-x an-y))
(t (swap-opinion an-x an-y at-x at-y)))
(show-opinion at-x at-y))))
(defun get-fun (fun)
"
randomly picks up a cell in the *people* population that satisfies
the FUN predicate
"
(declare (type fixnum at-x))
(declare (type fixnum at-y))
(loop
(let(
(at-x (random *max-line*))
(at-y (random *max-column*)))
(cond
((funcall fun (aref *people* at-x at-y))
(return (values at-x at-y)))))))
(defun swap-opinion (from-x from-y to-x to-y)
"
swaps the opinions of two individuals in the *people* population
"
(declare (type fixnum from-x))
(declare (type fixnum from-y))
(declare (type fixnum to-x))
(declare (type fixnum to-y))
(setf (car (aref *people* to-x to-y))
(car (aref *people* from-x from-y))))
(defun locate (from-x from-y to-x to-y)
"
determines the relative position of two points
"
(declare (type fixnum from-x))
(declare (type fixnum from-y))
(declare (type fixnum to-x))
(declare (type fixnum to-y))
(cond ((< from-x to-x) (at-cursor 7 58 "right"))
(t(at-cursor 7 58 "left ")))
(cond ((< from-y to-y) (at-cursor 8 58 "below"))
(t(at-cursor 8 58 "above"))))
(defun random-fill (part infl)
"
randomly fills in the cells of the *people* population
with opinions and strengths
"
(declare (type fixnum part))
(declare (type fixnum infl))
(declare (type fixnum at-x))
(declare (type fixnum at-y))
(declare (type fixnum at))
(let(
(at-x (int-div *max-line* 2))
(at-y (int-div *max-column* 2)))
(dotimes (at *size* ())
(set-it at-x at-y part infl)
(show-opinion at-x at-y)
(multiple-value-setq
(at-x at-y)
(random-fun at-x at-y (function null) t)))))
(defun random-fun (at-x at-y fun flag)
"
returns the pair of coordinates of a randomly selected neighbour cell of
an individual of the *people* population that satisfies the FUN predicate
if there is no such neighour then if FLAG is NIL then NIL is returned else
another random cell is selected
"
(declare (type fixnum at-x))
(declare (type fixnum at-y))
(loop
(let(
(around-it (around-fun at-x at-y fun)))
(cond
((null around-it)
(cond
((null flag) (return nil))
(t
(setf at-x (random *max-line*))
(setf at-y (random *max-column*)))))
(t (return (random-car around-it)))))))
(defun around-fun (at-x at-y fun)
"
builds the list of neighbour cells from an individual in the *people*
population that satisfy the FUN predicate
"
(declare (type fixnum at-x))
(declare (type fixnum at-y))
(declare (type fixnum an-x))
(declare (type fixnum an-y))
(declare (type fixnum off-x))
(declare (type fixnum off-y))
(let(
(around-it ()))
(dolist (off-x (quote (-1 0 +1)) around-it)
(dolist (off-y (quote (-1 0 +1)) ())
(let(
(an-x (+ at-x off-x))
(an-y (+ at-y off-y)))
(cond(
(and
(not (and (zerop off-x) (zerop off-y)))
(< -1 an-x *max-line*)
(< -1 an-y *max-column*)
(funcall fun (aref *people* an-x an-y)))
(setf around-it (cons (list an-x an-y) around-it)))))))))
(defun random-car (a-list)
"
returns the CAR & CADR from a randomly chosen CAR of a non-empty list
returns NIL if the list was empty
"
(cond
((null a-list) nil)
(t (let(
(at (nth (random (list-length a-list)) a-list)))
(values (car at) (cadr at))))))
(defun show-opinion (at-x at-y)
"
displays political opinion of individual of the
*people* population at corresponding screen location
"
(declare (type fixnum at-x))
(declare (type fixnum at-y))
(at-cursor
(+ (1+ at-x) (int-div (- 22 *max-line*) 2))
(+ (1+ at-y) (int-div (- 50 *max-column*) 2))
(car (aref *people* at-x at-y))))
(defun set-it (at-x at-y part infl)
"
randomly sets the opinion and strength of an individual in the
*people* population
"
(declare (type fixnum at-x))
(declare (type fixnum at-y))
(declare (type fixnum part))
(declare (type fixnum infl))
(setf (aref *people* at-x at-y)
(list (random part) (1+ (random infl)))))
(defun get-it (at-x at-y)
"
returns the opinion and strength of an individual in the
*people* population
"
(declare (type fixnum at-x))
(declare (type fixnum at-y))
(let(
(at (aref *people* at-x at-y)))
(values (car at) (cadr at))))
|
99.94 | | SWAMI::LAMIA | Cheap, fast, good -- pick two | Mon Sep 29 1986 14:15 | 12 |
| 1. This exercise in interesting, but proves nothing fundamental about
languages and applications. Like it or not, every language is (was)
designed with a certain model or paradigm in mind, in my opinion --
batch business applications for COBOL, teaching algorithms for Pascal,
scientific calculations for Fortran, etc. Drawing conclusions about
one language's suitability over another based on what a LIFE program
might look like when written in it is quite fruitless.
2. One of the better books written on this largely religious issue
is _Comparing and Assessing Programming Languages -- Ada, C, Pascal_
edited by Alan Feuer & Narain Gehani, Prentice-Hall, 1984. I recommend
reading it.
|
99.95 | A nice user interface... | COOKIE::ROLLOW | Redneck cookin'... Fryit! | Sun Oct 05 1986 02:58 | 17 |
| I don't know who wrote it (probably someone at MIT), but there's
a nice version of LIFE on the Ultrix-32w distribution. To run
it find an Ultrix workstation and get the owner to say:
xdemo life { options }
If the workstation is a GPX use "menulife" instead of "life"; it's
a nicer interface. It appears to be able to handle an unbounded
board, but I suspect a full screen version would make run the MicroVAX
run very slowly. If there's also an 8600+ class machine on the
same net running Ultrix you might want to try:
xdemo { life menulife } vs:display
That might get reasonable response on a full screen display.
Alan
|
99.96 | cooking with boolean algebra | GALLO::MERRILL | | Tue Oct 07 1986 01:52 | 184 |
|
Well, I thought about how to improve on the solutions I've seen
so far, and think I've come up with an interesting one. This is also
in VAX C, but the algorithm is VERY different. Since the problem is
only described as being n by m, I've chosen, for reasons which will be
obvious, 32 by 20. Actually the 20 is arbitrary.
/Brad
------------------------------------------------------------------------
/*
* Brad Merrill 4-Oct-86
*/
#include stdio
#include ctype
#ifdef VAX
typedef unsigned long LOGICAL;
#define WIDTH 32
#else
typedef unsigned int LOGICAL;
#define WIDTH 8
#endif
LOGICAL *cur_array, *nxt_array, array1[22], array2[22];
LOGICAL getrow(), newgen();
char line[80];
main()
{
int i, j, gencnt;
cur_array = array1;
nxt_array = array2;
for (i = 0; i <= 21; i++)
cur_array[i] = nxt_array[i] = 0;
printf("Specify pattern (X for cell, space for empty):\n");
for (i = 1; i <= 20; i++) {
printf("Row %d: ",i);
array1[i] = getrow();
}
printf("\nInitial generation:\n");
disp_array();
gencnt = 0;
for (;;) {
printf("\nType <CR> to continue:");
gets(line);
gencnt++;
printf("\nGeneration %d:\n", gencnt);
if (newgen() != 0)
disp_array();
else {
printf("\nAll cells dead.\n");
break;
}
}
}
#define AND(n) ((cur_array[n] << 1) & (cur_array[n] >> 1))
#define XOR(n) ((cur_array[n] << 1) ^ (cur_array[n] >> 1))
#define A1 and_array[i-1]
#define A2 and_array[i]
#define A3 and_array[i+1]
#define A4 a4
#define X1 xor_array[i-1]
#define X2 xor_array[i]
#define X3 xor_array[i+1]
#define X4 x4
/* doublet productions */
#define D1 (X1 & X2)
#define D2 (X1 & X3)
#define D3 (X1 & X4)
#define D4 (X2 & X3)
#define D5 (X2 & X4)
#define D6 (X3 & X4)
/*
* All cells are mapped as:
*
* A1 A4 A1 X1 X4 X1
* A2 OO A2 X2 OO X2
* A3 A4 A3 X3 X4 X3
*
* Where 'A' refers to logical AND and 'X' refers to logical XOR,
* and their relative positions show how they are derived.
*
* In this setup we are limited to WIDTH cell positions.
*/
LOGICAL
newgen()
{
LOGICAL xor_array[22], and_array[22], *tmp_array, chksum;
int i, j;
and_array[0] = and_array[21] = 0;
xor_array[0] = xor_array[21] = 0;
and_array[1] = AND(1); /* initialize the first row, subsequent rows */
xor_array[1] = XOR(1); /* are initialized by the previous production */
chksum = 0;
for(i = 1; i <= 20; i++) {
LOGICAL t2, t3, t4, a4, x4;
A3 = AND(i+1);
A4 = cur_array[i-1] & cur_array[i+1];
X3 = XOR(i+1);
X4 = cur_array[i-1] ^ cur_array[i+1];
t4 = (A1 & (A2 | A3 | A4 | D4 | D5 | D6)) |
(A2 & (A3 | A4 | D2 | D3 | D6)) |
(A3 & (A4 | D1 | D3 | D5)) |
(A4 & (D1 | D2 | D4)) |
(D1 & D6);
t3 = (X1 & (A2 | A3 | A4)) |
(X2 & (A1 | A3 | A4)) |
(X3 & (A1 | A2 | A4)) |
(X4 & (A1 | A2 | A3)) |
(D1 & X3) |
(D1 & X4) |
(D4 & X4);
t2 = (X1 & (X2 | X3 | X4)) |
(X2 & (X3 | X4)) |
(X3 & X4) |
A1 | A2 | A3 | A4;
nxt_array[i] = (t2 & ~t4) & cur_array[i];
nxt_array[i] |= (t3 & ~t4);
chksum |= nxt_array[i];
}
tmp_array = cur_array;
cur_array = nxt_array;
nxt_array = tmp_array;
return(chksum);
}
#define BSET(n) (01 << n)
#ifdef VAX
LOGICAL btab[WIDTH] = {
BSET(0), BSET(1), BSET(2), BSET(3), BSET(4), BSET(5), BSET(6), BSET(7),
BSET(8), BSET(9), BSET(10), BSET(11), BSET(12), BSET(13), BSET(14), BSET(15),
BSET(16), BSET(17), BSET(18), BSET(19), BSET(20), BSET(21), BSET(22), BSET(23),
BSET(24), BSET(25), BSET(26), BSET(27), BSET(28), BSET(29), BSET(30), BSET(31)
};
#else
LOGICAL btab[WIDTH] = {
BSET(0), BSET(1), BSET(2), BSET(3), BSET(4), BSET(5), BSET(6), BSET(7),
BSET(8), BSET(9), BSET(10), BSET(11), BSET(12), BSET(13), BSET(14), BSET(15)
};
#endif
disp_array()
{
char str[WIDTH+1];
int i, j;
for (i = 1; i <= 20; i++) {
for (j = WIDTH-1; j >= 0; j--)
str[WIDTH-1-j] = (cur_array[i] & btab[j]) ? '*' : '.';
str[WIDTH] = NULL;
printf("Row %2d: %s\n", i, str);
}
}
LOGICAL
getrow()
{
int j;
LOGICAL num;
char *c;
c = gets(line);
for (j = 0; j < WIDTH; j++, c++)
if (*c == NULL) {
num = (num << (WIDTH-j));
break;
}
else
num = ((num << 1) | ((*c == 'x') | *c == 'X'));
return (num);
}
|
99.97 | CLU... | COOKIE::ROLLOW | Redneck cookin'... Fryit! | Wed Oct 08 1986 01:41 | 7 |
| re: my previous response (95?)
I went looking at the sources to xdemo life and menufile and
found that they are written in CLU.
Alan
|
99.98 | That code looks familiar | TLE::AMARTIN | Alan H. Martin | Wed Oct 08 1986 14:09 | 5 |
| Re .96:
Are you sure that isn't the transitive closure algorithm from our graph
coloring register allocator?
/AHM/THX
|
99.99 | life goes on... | LATOUR::MERRILL | | Thu Oct 09 1986 19:26 | 7 |
| Yes, I'm sure its not, primarily because I've never seen your algorithm...
My boolean algebra was so rusty I had to back to the books and work it
out on paper first. I couldn't even remember how to do Karnaugh map's :-)
/Brad
|
99.100 | VLIFE for video | LATOUR::MERRILL | | Fri Oct 10 1986 19:07 | 250 |
|
This is a video version of the LIFE program I submitted, it runs very
quickly so you may wish to define the SLEEP parameter to 1 to get it to
slow down. This version uses the curses library, so to link this you
must define:
DEF LNK$LIBRARY SYS$LIBRARY:VAXCRTL
DEF LNK$LIBRARY_1 SYS$LIBRARY:VAXCCURSE
------------------------------------------------------------------------
/*
* Brad Merrill 4-Oct-86
*/
#include curses
#include stdio
#include ctype
#ifdef vax
typedef unsigned long LOGICAL;
#define WIDTH 32
#else
typedef unsigned int LOGICAL;
#define WIDTH 16
#endif
#define HEIGTH 22
#define SLEEP 0
LOGICAL *cur_array, *nxt_array, array1[HEIGTH], array2[HEIGTH];
LOGICAL getrow(), newgen();
char line[80];
main()
{
int i, j, gencnt;
int gennum = 0;
cur_array = array1;
nxt_array = array2;
for (i = 0; i <= 21; i++)
cur_array[i] = nxt_array[i] = 0;
printf("Specify %d cell pattern for %d rows (X for cell, space for empty):\n",
WIDTH, HEIGTH-2);
printf("Row 00: ");
for (i = 1; i <= WIDTH; i++)
printf("%c",(i%10+48));
printf("\n");
for (i = 1; i <= 20; i++) {
printf("Row %2d: ",i);
cur_array[i] = getrow();
}
initscr();
disp_array(0);
gennum = gencnt = 0;
for (;;) {
if (gennum <= 0) {
gennum = getcmd(gencnt);
if (gennum < 0)
break;
else if (gennum == 0)
continue;
}
gennum--;
gencnt++;
if (newgen() != 0) {
#if SLEEP > 0
sleep(SLEEP);
#endif
disp_array(gencnt);
}
else {
endwin();
printf("\nAll cells are dead.\n");
break;
}
}
}
#define AND(n) ((cur_array[n] << 1) & (cur_array[n] >> 1))
#define XOR(n) ((cur_array[n] << 1) ^ (cur_array[n] >> 1))
#define A1 and_array[i-1]
#define A2 and_array[i]
#define A3 and_array[i+1]
#define A4 a4
#define X1 xor_array[i-1]
#define X2 xor_array[i]
#define X3 xor_array[i+1]
#define X4 x4
/* doublet productions */
#define D1 (X1 & X2)
#define D2 (X1 & X3)
#define D3 (X1 & X4)
#define D4 (X2 & X3)
#define D5 (X2 & X4)
#define D6 (X3 & X4)
/*
* All cells are mapped as:
*
* A1 A4 A1 X1 X4 X1
* A2 OO A2 X2 OO X2
* A3 A4 A3 X3 X4 X3
*
* Where 'A' refers to logical AND and 'X' refers to logical XOR,
* and their relative positions show how they are derived.
*
* In this setup we are limited to WIDTH cell positions.
*/
LOGICAL
newgen()
{
LOGICAL xor_array[HEIGTH], and_array[HEIGTH], *tmp_array, chksum;
int i, j;
and_array[0] = and_array[21] = 0;
xor_array[0] = xor_array[21] = 0;
and_array[1] = AND(1); /* initialize the first row, subsequent rows */
xor_array[1] = XOR(1); /* are initialized by the previous production */
chksum = 0;
for(i = 1; i <= 20; i++) {
LOGICAL t2, t3, t4, a4, x4;
A3 = AND(i+1);
A4 = cur_array[i-1] & cur_array[i+1];
X3 = XOR(i+1);
X4 = cur_array[i-1] ^ cur_array[i+1];
t4 = (A1 & (A2 | A3 | A4 | D4 | D5 | D6)) |
(A2 & (A3 | A4 | D2 | D3 | D6)) |
(A3 & (A4 | D1 | D3 | D5)) |
(A4 & (D1 | D2 | D4)) |
(D1 & D6);
t3 = (X1 & (A2 | A3 | A4)) |
(X2 & (A1 | A3 | A4)) |
(X3 & (A1 | A2 | A4)) |
(X4 & (A1 | A2 | A3)) |
(D1 & X3) |
(D1 & X4) |
(D4 & X4);
t2 = (X1 & (X2 | X3 | X4)) |
(X2 & (X3 | X4)) |
(X3 & X4) |
A1 | A2 | A3 | A4;
nxt_array[i] = (t2 & ~t4) & cur_array[i];
nxt_array[i] |= (t3 & ~t4);
chksum |= nxt_array[i];
}
tmp_array = cur_array;
cur_array = nxt_array;
nxt_array = tmp_array;
return(chksum);
}
#define BSET(n) (01 << n)
LOGICAL btab[WIDTH] = {
#ifdef vax
BSET(31), BSET(30), BSET(29), BSET(28), BSET(27), BSET(26), BSET(25), BSET(24),
BSET(23), BSET(22), BSET(21), BSET(20), BSET(19), BSET(18), BSET(17), BSET(16),
#endif
BSET(15), BSET(14), BSET(13), BSET(12), BSET(11), BSET(10), BSET(9), BSET(8),
BSET(7), BSET(6), BSET(5), BSET(4), BSET(3), BSET(2), BSET(1), BSET(0)
};
disp_array(gnum)
int gnum;
{
char str[WIDTH+1];
int i, j;
move( 0, 0);
if (gnum <= 0) {
if (gnum < 0)
printw("Generation %d: ", -gnum);
else
printw("Initial generation:");
for (i = 1; i <= 20; i++) {
move( i, 10);
if (cur_array[i] == 0)
printw("Row %2d: ................................", i);
else {
printw("Row %2d:", i);
for (j = 0; j < WIDTH; j++)
mvaddch( i, 18+j, ((cur_array[i] & btab[j]) ? '*' : '.'));
}
}
}
else {
printw("Generation %d: ", gnum);
for (i = 1; i <= 20; i++)
if (cur_array[i] != nxt_array[i])
for (j = 0; j < WIDTH; j++)
if((cur_array[i] ^ nxt_array[i]) & btab[j])
mvaddch( i, 18+j, ((cur_array[i] & btab[j]) ? '*' : '.'));
}
refresh();
}
LOGICAL
getrow()
{
int j;
LOGICAL num;
char *c;
c = gets(line);
for (j = 0; j < WIDTH; j++, c++)
if (*c == NULL) {
num = (num << (WIDTH-j));
break;
}
else
num = (num << 1) | (*c == 'x') | (*c == 'X');
return (num);
}
int
getcmd(gen)
int gen;
{
move( 22, 0);
printw("Number of generations(E to exit, R to refresh): ");
clrtoeol();
getstr(line);
if (line[0] == 'e' || line[0] == 'E') {
endwin();
return (-1);
}
if (line[0] == 'r' || line[0] == 'R') {
clear();
disp_array(-gen);
return (0);
}
if (isdigit(line[0])) {
int num = 0;
char *c;
c = line;
while (*c != NULL && isdigit(*c)) {
num = num*10 + (*c - 48);
c++;
}
return (num);
}
return(1);
}
|
99.101 | 3-D Life and implications. | ALBANY::MULLER | | Sun Aug 14 1988 22:03 | 25 |
| There was an article on page 16 (the Computer Recreations column by A.
K. Dewdney) of the February, 1987 issue of the Scientific American
subtitled "The game of Life acquires some successors in three
dimensions."
If anyone is interested there is an offer by Carter Bays, Department of
Computer Science, University of South Carolina, Columbia, SC 29208 for
a $3 copy of his 40 page paper: "The Game of Three-Dimensional Life".
Someone in one of the earlier 99.x notes mentioned a suggestion
about doing something on a hexagonal grid and there was no follow
up by anyone.
There is an implication in that suggestion that is fundamentally very
intriguing. The mathematics of symmetry (space group theory) state
that there are only 17 different ways to replicate a two dimensional
pattern and 230 ways to do it in three dimensions. This means that
there are only 230 different ways to make an asymetrical object (like a
molecule) grow into macroscopic crystals. Anyone else see how the game
could be extended into a scientific research topic? Might be fun
to try if I didn't have to make a living first. If anyone is
interested I could put them on the right path to some of the references.
An old crystallographer, Fred
ALBANY::MULLER
|
99.102 | Late entry over the Rainbow | SAACT0::SAKOVICH_A | Keep RIGHT except to PASS! | Wed Nov 30 1988 15:12 | 29 |
| I know it's kinda late, but just for those of us without a VAX,
I created a version of LIFE that runs on a Rainbow using POWER-C
($19.95 from Mix Software) (see - there are advantages to not having
a VAX ;^)
Rather than put the listing here (I wrote the program before I knew
of this topic), I'll just give you a pointer -->
CSCMAS::SYS$RAINBOW:LIFE010.ARC
It contains the sources, executables, and some sample "genesis"
files. This version is played on a 24x24 grid which can wrap around
the edges (top-bottom, left-right) so that noone falls off the edge
of the world (that makes it infinite, right???), or can terminate
so that you can fall off the edges. The ability to create mutant
cells also exists, cells that randomly appear and create havoc with
otherwise stagnant or uninteresting structures.
There's a generation and population counter displayed on screen.
It's not short (otherwise, I'd post it here), but it's elegant.
It'll be faster when I put my Turbow-286 accelerator in, too! ;^)
Regards,
Aaron
P.S., since I wrote this before I knew of this note, it does not
necessarily adhere to the spec in .1
|