Path: utzoo!utgpu!jarvis.csri.toronto.edu!mailrus!iuvax!purdue!ames!uhccux!munnari.oz.au!otc!metro!basser!usage!elecvax!cheops!lambert From: lambert@cheops.eecs.unsw.oz (Timothy Lambert) Newsgroups: comp.sys.apollo Subject: Play life on a bitmap Keywords: life,bitmap,bit-blt Message-ID: <1203@cheops.eecs.unsw.oz> Date: 1 Aug 89 13:30:28 GMT Organization: EE & CS, Uni N.S.W., Sydney, Australia Lines: 386 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.