lambert@cheops.eecs.unsw.oz (Timothy Lambert) (08/01/89)
If you get tired of melting your screen, then you can bring it
to life!
------------------cut here----------------------------
program life(input,output);
{This program plays Conway's game of life in a window (or on whole screen
if you specify -borrow). Pixels with the value of one are regarded as
alive and pixels with a value of 0 are regarded as dead.
All the calculating of the next generation are done using bit-blts,
so that the whole screen is done "in parallel".
If you give life the name of a bitmap file it will copy it to the
window and play life on it. You can bring your favourite picture to life!
Copyright 1989 Tim Lambert lambert@spectrum.eecs.unsw.oz
You can do whatever you want with this program provided
you leave this notice intact.
BUGS: Doesn't work properly on text windows on colour nodes
because xi doesn't save such windows properly.
Only enlivens plane 0 on colour nodes which doesn't look that good.
}
%nolist;
%include '/sys/ins/base.ins.pas';
%include '/sys/ins/pgm.ins.pas';
%include '/sys/ins/gpr.ins.pas';
%include '/sys/ins/gmf.ins.pas';
%include '/sys/ins/ios.ins.pas';
%include '/sys/ins/pad.ins.pas';
%include '/sys/ins/kbd.ins.pas';
%include '/sys/ins/name.ins.pas';
%include '/sys/ins/error.ins.pas';
%list;
type file_name_type = varying[128] of char;
VAR
status : status_$t; {all GPR calls return a status value indicating whether they've succeeded or failed}
mode : gpr_$display_mode_t := gpr_$direct; {direct means we'll be drawing inside a window}
display_bitmap : gpr_$bitmap_desc_t;
display_size : gpr_$offset_t := [gpr_$max_x_size,gpr_$max_y_size]; {x and y size of our window for drawing in}
{we ask for maximum possible bitmap size - GPR reduces this to fit our window}
display_hi_plane : gpr_$rgb_plane_t := gpr_$highest_plane; {number of highest plane on screen - 7 for 8 plane nodes
1 for monochrome nodes. we ask for maximum no of planes - GPR reduces this to fit}
bitmap_name : file_name_type := '/tmp/life_temp.gmf'; {name of bitmap file}
no_of_args : integer; {no of arguments to life (counting argument 0) }
arg_pointer : pgm_$argv_ptr; {pointer to the arguments - not used}
dm_copy_image : file_name_type := 'au;xi -f '; {append a file name to this and the DM will copy an image to that file}
PROCEDURE check(IN messagex : string);
{if last system call was unsuccesful prints an error message}
BEGIN
if status.all <> status_$ok then begin
error_$print (status);
writeln('error occurred while ',messagex);
end; {if}
END;
procedure acquire;
{acquire display if in direct mode}
begin
if mode = gpr_$direct then discard(gpr_$acquire_display( status ));
end;
procedure release;
{release display if in direct mode}
begin
if mode = gpr_$direct then gpr_$release_display( status );
end;
procedure life_bitmap(bitmap : gpr_$bitmap_desc_t);
const quit_set=['q','Q',KBD_$EXIT,KBD_$ABORT]; {stop if any of these keys pressed}
var
size : gpr_$offset_t;
hi_plane : gpr_$rgb_plane_t;
source : gpr_$window_t; {specifies origin and size of rectangular region of bitmap to copied from (to)}
sourceleft : gpr_$window_t; {specifies origin and size of rectangular region of bitmap to copied from (to)}
sourceup : gpr_$window_t; {specifies origin and size of rectangular region of bitmap to copied from (to)}
dest : static gpr_$position_t := [0,0]; {destinition point for our bit-blts}
destright : static gpr_$position_t := [1,0];
destdown : static gpr_$position_t := [0,1];
temp : gpr_$bitmap_desc_t; {bitmap for temporary results}
{let A be original bitmap, B A shifted one bit to left, C A shifted one bit right}
{three0 is low order bit of A+B+C and three1 is high order bit}
three0 : gpr_$bitmap_desc_t; {three0 := A xor B xor C}
three1 : gpr_$bitmap_desc_t; {three1 := (A and (B xor C)) or (B and C) = carry(A,B,C)}
{now if D,E,F are A,B,C shifted up one bit and G,H,I down one bit
sum0 is low bit of A+B+C+D+E+F+G+H+I sum1 is next bit (2s) sum2 is next bit (4s)
we don't care about 8s bit}
{using three0D for three0 shifted down and three0U for three0 shifted up}
sum0 : gpr_$bitmap_desc_t; {sum0 := three0 xor three0D xor three0U}
carry : gpr_$bitmap_desc_t; {carry := carry(three0,three0U,three0D)}
sum1 : gpr_$bitmap_desc_t; {sum1 := carry xor three1 xor three1D xor three1U}
sum2 : gpr_$bitmap_desc_t; {three1 := ((carry xor three1) and (three1U xor three1D)) xor (carry and three1) xor (three1U and three1D)}
attribs : gpr_$attribute_desc_t; {an attribute block for memory bitmaps}
event_type : gpr_$event_t;
event_data : char;
pos : gpr_$position_t;
begin
gpr_$enable_input(gpr_$keystroke,quit_set,status); check('enable');
gpr_$raster_op_prim_set([gpr_$rop_blt, gpr_$rop_line, gpr_$rop_fill],status);
gpr_$inq_bitmap_dimensions( bitmap, size, hi_plane, status ); {find out how big our window is}
source.window_base := dest; {we plan to bit_blt the whole}
source.window_size := size; {bitmap file}
sourceleft.window_base := destright;
sourceleft.window_size.y_size := size.y_size;
sourceleft.window_size.x_size := size.x_size - 1;
sourceup.window_base := destdown;
sourceup.window_size.y_size := size.y_size - 1;
sourceup.window_size.x_size := size.x_size;
gpr_$allocate_attribute_block( attribs, status ); check('allocate');
gpr_$allocate_bitmap(size,0,attribs,temp,status); check('allocate');
gpr_$allocate_bitmap(size,0,attribs,three0,status); check('allocate');
gpr_$allocate_bitmap(size,0,attribs,three1,status); check('allocate');
gpr_$allocate_bitmap(size,0,attribs,sum0,status); check('allocate');
gpr_$allocate_bitmap(size,0,attribs,carry,status); check('allocate');
gpr_$allocate_bitmap(size,0,attribs,sum1,status); check('allocate');
gpr_$allocate_bitmap(size,0,attribs,sum2,status); check('allocate');
repeat
gpr_$set_bitmap(three0,status);
gpr_$set_raster_op(0,gpr_$rop_src,status); {this is the default but set it anyway}
gpr_$bit_blt(bitmap,sourceleft,0,dest,0,status); {three0 := B} check('bit_blt1');
gpr_$set_raster_op(0,gpr_$rop_src_xor_dst,status);
gpr_$bit_blt(bitmap,source,0,destright,0,status); {three0 := B xor C} check('bit_blt2');
gpr_$set_bitmap(temp,status);
gpr_$set_raster_op(0,gpr_$rop_src,status);
gpr_$bit_blt(bitmap,sourceleft,0,dest,0,status); {temp := B} check('bit_blt3');
gpr_$set_raster_op(0,gpr_$rop_src_and_dst,status);
gpr_$bit_blt(bitmap,source,0,destright,0,status); {temp := B and C} check('bit_blt4');
gpr_$set_bitmap(three1,status);
gpr_$set_raster_op(0,gpr_$rop_src,status);
gpr_$bit_blt(bitmap,source,0,dest,0,status); {three1 := A} check('bit_blt5');
gpr_$set_raster_op(0,gpr_$rop_src_and_dst,status);
gpr_$bit_blt(three0,source,0,dest,0,status); {three1 := A and (B xor C)} check('bit_blt6');
gpr_$set_raster_op(0,gpr_$rop_src_or_dst,status);
gpr_$bit_blt(temp,source,0,dest,0,status); {three1 := (A and (B xor C)) or (B and C)} check('bit_blt7');
gpr_$set_bitmap(three0,status);
gpr_$set_raster_op(0,gpr_$rop_src_xor_dst,status);
gpr_$bit_blt(bitmap,source,0,dest,0,status); {three0 := B xor C xor A} check('from');
release;
gpr_$set_bitmap(sum0,status);
gpr_$set_raster_op(0,gpr_$rop_src,status);
gpr_$bit_blt(three0,sourceup,0,dest,0,status); {sum0 := three0U} check('bit_blt8');
gpr_$set_raster_op(0,gpr_$rop_src_xor_dst,status);
gpr_$bit_blt(three0,source,0,destdown,0,status); {sum0 := three0U xor three0D} check('bit_blt9');
gpr_$set_bitmap(temp,status);
gpr_$set_raster_op(0,gpr_$rop_src,status);
gpr_$bit_blt(three0,sourceup,0,dest,0,status); {temp := three0U} check('bit_blt10');
gpr_$set_raster_op(0,gpr_$rop_src_and_dst,status);
gpr_$bit_blt(three0,source,0,destdown,0,status); {temp := three0U and three0D} check('bit_blt11');
gpr_$set_bitmap(carry,status);
gpr_$set_raster_op(0,gpr_$rop_src,status);
gpr_$bit_blt(three0,source,0,dest,0,status); {carry := three0} check('bit_blt12');
gpr_$set_raster_op(0,gpr_$rop_src_and_dst,status);
gpr_$bit_blt(sum0,source,0,dest,0,status); {carry := three0 and (three0U xor three0D)} check('bit_blt13');
gpr_$set_raster_op(0,gpr_$rop_src_or_dst,status);
gpr_$bit_blt(temp,source,0,dest,0,status); {carry := (three0 and (three0U xor three0D)) or (three0U and three0D)} check('bit_blt14');
gpr_$set_bitmap(sum0,status);
gpr_$set_raster_op(0,gpr_$rop_src_xor_dst,status);
gpr_$bit_blt(three0,source,0,dest,0,status); {three0 := three0U xor three0D xor three0} check('bit_blt15');
gpr_$set_bitmap(sum1,status);
gpr_$set_raster_op(0,gpr_$rop_src,status);
gpr_$bit_blt(carry,source,0,dest,0,status); {sum1 := carry} check('bit_blt16');
gpr_$set_raster_op(0,gpr_$rop_src_xor_dst,status);
gpr_$bit_blt(three1,source,0,dest,0,status); {sum1 := carry xor three1} check('bit_blt17');
gpr_$set_bitmap(temp,status);
gpr_$set_raster_op(0,gpr_$rop_src,status);
gpr_$bit_blt(three1,sourceup,0,dest,0,status); {temp := three1U} check('bit_blt18');
gpr_$set_raster_op(0,gpr_$rop_src_xor_dst,status);
gpr_$bit_blt(three1,source,0,destdown,0,status); {temp := three1U xor three1D} check('bit_blt19');
gpr_$set_bitmap(sum2,status);
gpr_$set_raster_op(0,gpr_$rop_src,status);
gpr_$bit_blt(temp,source,0,dest,0,status); {sum2 := three1U xor three1D} check('bit_blt20');
gpr_$set_raster_op(0,gpr_$rop_src_and_dst,status);
gpr_$bit_blt(sum1,source,0,dest,0,status); {sum2 := (three1U xor three1D) and (carry xor three1)} check('bit_blt21');
gpr_$set_bitmap(sum1,status);
gpr_$set_raster_op(0,gpr_$rop_src_xor_dst,status);
gpr_$bit_blt(temp,source,0,dest,0,status); {sum1 := carry xor three1 xor three1U xor three1D} check('bit_blt22');
gpr_$set_bitmap(temp,status);
gpr_$set_raster_op(0,gpr_$rop_src,status);
gpr_$bit_blt(three1,sourceup,0,dest,0,status); {temp := three1U} check('bit_blt23');
gpr_$set_raster_op(0,gpr_$rop_src_and_dst,status);
gpr_$bit_blt(three1,source,0,destdown,0,status); {temp := three1U and three1D} check('bit_blt24');
gpr_$set_bitmap(sum2,status);
gpr_$set_raster_op(0,gpr_$rop_src_xor_dst,status);
gpr_$bit_blt(temp,source,0,dest,0,status); {sum2 := ((three1U xor three1D) and (carry xor three1)) xor (three1U and three1D)} check('bit_blt25');
gpr_$set_bitmap(temp,status);
gpr_$set_raster_op(0,gpr_$rop_src,status);
gpr_$bit_blt(carry,source,0,dest,0,status); {temp := carry} check('bit_blt26');
gpr_$set_raster_op(0,gpr_$rop_src_and_dst,status);
gpr_$bit_blt(three1,source,0,dest,0,status); {temp := carry and three1} check('bit_blt27');
gpr_$set_bitmap(sum2,status);
gpr_$set_raster_op(0,gpr_$rop_src_xor_dst,status);
gpr_$bit_blt(temp,source,0,dest,0,status); {sum2 := ((three1U xor three1D) and (carry xor three1)) xor (three1U and three1D) xor (carry and three1D)} check('bit_blt28');
{Right! we've now counted the neighbours of a cell. a cell is alive in the next generation if
it has exactly 3 neighbours or if it has exactly four neighbours and is alive now
i.e bitmap := (sum0 and sum1 and not sum2) or (bitmap and sum2 and not sum1 and not sum1)}
gpr_$set_bitmap(temp,status);
gpr_$set_raster_op(0,gpr_$rop_src,status); {this is the default but set it anyway}
gpr_$bit_blt(sum0,source,0,dest,0,status); {temp := sum0} check('bit_blt29');
gpr_$set_raster_op(0,gpr_$rop_src_and_dst,status);
gpr_$bit_blt(sum1,source,0,dest,0,status); {temp := sum0 and sum1} check('bit_blt30');
gpr_$set_raster_op(0,gpr_$rop_not_src_and_dst,status);
gpr_$bit_blt(sum2,source,0,dest,0,status); {temp := sum0 and sum1 and not sum2} check('bit_blt31');
acquire;
gpr_$set_bitmap(bitmap,status);
gpr_$set_raster_op(0,gpr_$rop_src_and_dst,status);
gpr_$bit_blt(sum2,source,0,dest,0,status); {bitmap := bitmap and sum2} check('bit_blt32');
gpr_$set_raster_op(0,gpr_$rop_not_src_and_dst,status);
gpr_$bit_blt(sum0,source,0,dest,0,status); {bitmap := bitmap and sum2 and not sum0} check('bit_blt33');
gpr_$bit_blt(sum1,source,0,dest,0,status); {bitmap := bitmap and sum2 and not sum0 and not sum1} check('bit_blt34');
gpr_$set_raster_op(0,gpr_$rop_src_or_dst,status);
gpr_$bit_blt(temp,source,0,dest,0,status); {bitmap := (bitmap and sum2 and not sum0 and not sum1) or (sum0 and sum1 and not sum2)} check('bit_blt35');
release;
acquire;
discard(gpr_$cond_event_wait( event_type, event_data, pos, status ));
until event_type=gpr_$keystroke;
end;
procedure read_bitmap(display_bitmap: gpr_$bitmap_desc_t;
IN bitmap_name:file_name_type);
{copy the bitmap stored in file_name to the screen (display_bitmap)}
var window : gpr_$window_t; {specifies origin and size of rectangular region of bitmap to copied from (to)}
dest : static gpr_$position_t := [0,0]; {destinition point for our bit-blts will always be (0,0)}
file_size : gpr_$offset_t;
file_bitmap : gpr_$bitmap_desc_t;
version : gpr_$version_t; {some useless information returned by gpr_$open_bitmap_file}
groups : integer; {more of the same}
group_hs : gpr_$bmf_group_header_array_t; {field pixel_size * field n_sects should give # of planes in bitmap}
created : boolean; {tells us if the bitmap file was created - should be false}
attribs : gpr_$attribute_desc_t; {the attribute block for the bitmap file}
wpl,bpi : integer;
stream : stream_$id_t;
type bit_row = array[1..gpr_$max_x_size div 8] of char;
gmf_header = record {WARNING these definition was found by looking in a gmf file}
unknown1,unknown2:integer; {these both seem to be one always}
x_size,y_size:integer; {dimensions of bitmap}
dpi:integer; {dots per inch of bitmap}
end;
var plane_ptr : ^bit_row;
data_ptr : ^gmf_header;
begin
gpr_$allocate_attribute_block( attribs, status ); {our window}
gpr_$open_bitmap_file( gpr_$readonly, bitmap_name.body, bitmap_name.length, version, {open the bitmap file}
file_size, groups, group_hs,
attribs, file_bitmap, created, status );
if status.all <> status_$ok then begin
gmf_$open(bitmap_name.body,bitmap_name.length,gmf_$read,stream,status);
if status.all <> status_$ok then begin
writeln('Couldn''t open ',bitmap_name);
error_$print(status);
pgm_$exit;
end; {if}
discard(ios_$locate(stream,[ios_$preview_opt],data_ptr,sizeof(gmf_header),status)); check('ios_locate');
file_size.x_size := data_ptr^.x_size;
file_size.y_size := data_ptr^.y_size;
gpr_$allocate_bitmap(file_size,0,attribs,file_bitmap,status);
gpr_$inq_bitmap_pointer(file_bitmap,plane_ptr,wpl,status); check('inq bmap ptr');
gmf_$restore_plane(stream,data_ptr^.x_size,data_ptr^.y_size,wpl,plane_ptr,bpi,status); check('restore');
gmf_$close(stream,status);
gpr_$set_raster_op(0,gpr_$rop_not_src,status); {flip bits on copy}
end;{if}
acquire;
gpr_$set_bitmap( display_bitmap, status );
window.window_base := dest; {we plan to bit_blt the whole}
window.window_size := file_size; {bitmap file}
gpr_$pixel_blt( file_bitmap, window, dest, status ); check('pixel_blt'); {does a bit_blt from bitmap file to display}
gpr_$deallocate_bitmap(file_bitmap,status);
gpr_$deallocate_attribute_block(attribs,status);
end; {read_bitmap}
BEGIN
pgm_$get_args(no_of_args,arg_pointer); {find out how bitmap files we have to display}
if no_of_args = 1 then begin
append(dm_copy_image,bitmap_name);
pad_$dm_cmd(stream_$stdout,dm_copy_image.body,dm_copy_image.length,status); check('dm command');
end else begin
bitmap_name.length := pgm_$get_arg( 1, bitmap_name.body, status, sizeof(bitmap_name.body)); {get the name of the file}
if bitmap_name.body[1] = '-' then begin
if bitmap_name.body[2] in ['b','B'] then begin
if no_of_args = 2 then begin
mode := gpr_$borrow_nc
end else begin
mode := gpr_$borrow;
bitmap_name.length := pgm_$get_arg( 2, bitmap_name.body, status, sizeof(bitmap_name.body)); {get the name of the file}
end;{if}
end else begin
writeln('Usage: life [-b[orrow]] [bitmap_name]');
pgm_$exit;
end; {if}
end; {if}
end; {if}
gpr_$init( mode, stream_$stdout, display_size, display_hi_plane, display_bitmap, status ); {initialises graphics package}
check('init');
gpr_$inq_bitmap_dimensions( display_bitmap, display_size, display_hi_plane, status ); {find out how big our window is}
gpr_$set_obscured_opt( gpr_$block_if_obs, status ); {if we try to draw in our window and it is covered - pop the window}
gpr_$set_auto_refresh(true,status);
gpr_$set_clipping_active(true,status);
if mode <> gpr_$borrow_nc then read_bitmap(display_bitmap,bitmap_name);
if no_of_args = 1 then name_$delete_file(bitmap_name.body,bitmap_name.length,status);
life_bitmap(display_bitmap);
release;
gpr_$terminate( true, status ); {all done}
END.