!+
!   "Life": A TPU implementation of Conway's Life experiment,
!           from the Spr'86 DECUS Langs&Tools Session Notes
!           (Author's name currently unknown; good job, though...)
!
!   Usage: invoked by command
!                   LIFE n
!          where n is number of generations desired.  Will translate current 
!          buffer to *'s (live cells) and begin.  Buffer ought be VERY SHORT
!          and have NOT MANY cells in it, else will take nigh on forever.
!
!   [mpg] - Modifications to procedure eve_life
!             (1) turns on and off screen_update; this saves time (?)
!             (2) copies victim buffer to buffer Life Simulation so as not 
!                 to be destructive
!-
                                                                           
procedure life$go_horizontal (amount)

local offset;

offset := current_offset;

! or now we can't go beyond the begining of the line
if (offset = 0) and (amount<0) then
    return(0);
endif;

! if we're going beyond the end of 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;   ! life$go_horizontal

procedure  life$go_vertical (amount)

local offset;

on_error
    if error <> tpu$_noeobstr then

! if at end of buffer, add a line
        if error = tpu$_endofbuf then
            position (search (line_end,forward));
            split_line;
        else
! if at begining of buffer, add a line
            if error = tpu$_begofbuf then
                position (search(line_begin,reverse));
                split_line;
                move_vertical (-1);
            else
! whatever 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;   ! life$go_vertical
                  

! evaluate the region around the cell
procedure life$evaluate_cell (cell_range)

local cell_mark;

! start by dealing with current row
cell_mark := beginning_of (cell_range);
life$evaluate_row (cell_mark);

! deal with preceding row
life$go_vertical (-1);
life$evaluate_row (mark(none));
position (cell_mark);

! deal with following row if we have one
life$go_vertical (1);
life$evaluate_row (mark(none));
position (cell_mark);

endprocedure;      ! life$evaluate_cell


! evaluate a single row
procedure life$evaluate_row (cell_mark)

local trans_range, 
      end_mark, 
      start_mark, 
      status;

status := life$go_horizontal(-1);
start_mark := mark(reverse);
if status then
    position (cell_mark);
endif;

status := life$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       ! life$evaluate_row

procedure life$init_life
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 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);

! init various strings
life$status := " Buffer " + get_info(current_buffer,"name") + 
                "          (Life Environment --- Generation: !SL)";
life$translate_in :=  " abcdefg012345678";
life$translate_out := "abcdefgh123456789";

! setup the status line and update the window
set (status_line, current_window, reverse, fao(life$status,0));
update(current_window);

endprocedure;    ! life$init_life;
                  

! procedure implemenmts the life game
! uses buffer to store state as we evaluate each cell
procedure eve_life (input_generation)                      

local saving_range,
      cell_pattern,
      cell_range,
      current_gen,
      max_gen;
      
! eat "no string found" mssg
on_error
    if error <> tpu$_strnotfound then
        abort;
    endif;
endon_error;

if not eve$prompt_number (input_generation, max_gen, 
              'Number of generations to run simulation: ',
              'Aborting simulation.') then
    return;
endif;
          
current_gen := 0;
cell_pattern := any('0123456789');
                              
life$init_life;

loop
    set (screen_update, on);                     ! [mpg]
    exitif current_gen >= max_gen;
    current_gen := current_gen + 1;
    translate (current_buffer, '0', '*');   ! prepare to evaluate buf
    set (screen_update, off);                    ! [mpg]
    position(beginning_of(current_buffer));
    loop
        cell_range := search (cell_pattern, forward);
        exitif cell_range = 0;
        position (cell_range);
        life$evaluate_cell (cell_range);
        position (cell_range);
        life$go_horizontal(1);
    endloop;
    position (beginning_of(current_buffer));
    translate (current_buffer, 
                             '   *        **     ',
                             ' abcdefgh0123456789');
    set (status_line, current_window, reverse, fao (life$status, current_gen));
    update (current_window);
endloop;
message ("Simulation complete.");                       
  
endprocedure;   ! eve_life