(*
%use "Difference_equations/life.fsh";; 
*)

(* Conway's Game of Life  *)


%use "Difference_equations/difference.fsh";;


let life_or_death_pr (life: var a) (mask:var [a]) = 	
					// computes new status of cell
  new centre = copy {numdim #mask : int_shape} 1   
					// mask centre
  and #n = int_shape 			// no. of live neighbours
  in
    life := entry centre mask ;		// current status 
    n := sum_int mask - life ;		
    if life=1 
    then 
	if n<2 || n>3 
	then life := 0
	else skip
    else 
	if n=3 
	then life:=1 
	else skip
  end
;;

let life_or_death_sh mask_sh = int_shape 
;;

let life_or_death = proc2fun life_or_death_pr life_or_death_sh
;;

let display_and_test even bde bdo =
  new #b = bool_shape in		// the test result
    (if even 				// bde is the latest
    then output bdo 			// output is one step behind
					// to display the initial state 
    else output bde) ;			// output the current value
    b := all(zipop equal_int bde bdo) 	// stop if equal 
  return b
;;

let no_display_and_test even bde bdo =
  all(zipop equal_int bde bdo) // stop if equal 
;;

let continuing_life_inner board = 
   diff_solver_inner 
	life_or_death 
	(ones #board) 
	(ones #board)
	display_and_test
	board
;;

let continuing_life_outer board = 
   diff_solver_outer
	(fun x -> 0) 
	life_or_death 
	(ones #board) 
	(ones #board)
	display_and_test
	board
;;

let quiet_life board = 
   diff_solver_inner 
	life_or_death 
	(ones #board) 
	(ones #board)
	no_display_and_test
	board
;;


let short_life_pr (bd2:var [a]) (bd1:var [a]) = 
  new #mask = {3,3:int_shape} in
    for i< lendim #bd1 - 2 do
      for j< lendim (preddim #bd1) -2 do
	for k<3 do
	  for l<3 do
	    mask[k,l] := bd1[i+k+1,j+k+1] 
	  done
    	done ;
        bd2[i,j] := life_or_death mask
      done
    done
  end
;;

let short_life board = 
  proc2fun short_life_pr identity
;;

let continuing_short_life_pr (final:var[a]) (initial:var[a])  = 
  new 	even = false 				// final will be latest
  in 			
    final := initial ;				// set the boundary
    short_life_pr final initial ;		// first computation 
    whiletrue 
	(not (display_and_test even initial final))  	// work to do
    (	if even 				// if initial is freshest
    	then short_life_pr final initial	// then update final
	else short_life_pr initial final 	// else update initial
    )
  end
;;

let continuing_short_life  = 
  proc2fun continuing_short_life_pr identity 
;;

let quiet_short_life_pr (final:var[a]) (initial:var[a]) =
  new 	even = false 				// final will be latest
  in 			
    final := initial ;				// set the boundary
    short_life_pr final initial ;		// first computation 
    whiletrue 
	(not (no_display_and_test even initial final))  	// work to do
    (	if even 				// if initial is freshest
    	then short_life_pr final initial	// then update final
	else short_life_pr initial final 	// else update initial
    )
  end
;;

let quiet_short_life  = 
  proc2fun quiet_short_life_pr identity 
;;




(* An example 

let life_test1 = 
	continuing_life_inner
	(copy {10,10:int_shape} 0)
;;	

let x = fill {100:int_shape} with 
[
1,2,3,4,5,6,7,8,9,0,
1,2,3,4,5,6,7,8,9,0,
1,2,3,4,5,6,7,8,9,0,
1,2,3,4,5,6,7,8,9,0,
1,2,3,4,5,6,7,8,9,0,
1,2,3,4,5,6,7,8,9,0,
1,2,3,4,5,6,7,8,9,0,
1,2,3,4,5,6,7,8,9,0,
1,2,3,4,5,6,7,8,9,0,
1,2,3,4,5,6,7,8,9,0
]
;;



let life_test1a = 
	quiet_life 
	(copy {10,10:int_shape} 0)
;;

let short_test1a = quiet_short_life 
	(copy {10,10:int_shape} 0)
;;


let life_test2 = 
  new board = copy {10,10:int_shape} 0 in 
    board[2,3] := 1 ;
    board [2,4] := 1 ;
    board := continuing_life_inner board 
  end 
;;

let life_test2a = 
  new board = copy {10,10:int_shape} 0 in 
    board[2,3] := 1 ;
    board [2,4] := 1 ;
    board := continuing_life_outer board 
  end 
;;


let life_test3 = 
  new board = 
    fill {10,10:int_shape} 
    with 
	[0,0,0,0,0,0,0,0,0,0,
	 0,1,0,1,1,0,1,1,1,0,
	 0,1,0,1,0,1,0,0,0,0,
	 0,1,1,1,0,1,1,0,0,0,
	 0,1,0,1,1,0,1,1,1,0,
	 0,1,0,1,0,1,0,0,0,0,
	 0,1,1,1,0,1,1,0,0,0,
	 0,1,0,1,1,0,1,1,1,0,
	 0,1,0,1,0,1,0,0,0,0,
	 0,0,0,0,0,0,0,0,0,0 ] 
  in 
    board := continuing_life_inner board
  end 
;;


let life_test4 = 
  new board = 
    fill {5,5:int_shape} 
    with 
	[0,0,0,0,0,
	 0,0,1,0,0,
	 0,0,1,0,0,
	 0,0,1,0,0,
	 0,0,0,0,0] 
  in 
    board := continuing_life_inner board
  end 
;;

let life_test4a = 
  new board = 
    fill {3,3:int_shape} 
    with 
	[0,1,0,
	 0,1,0,
	 0,1,0] 
  in 
    board := continuing_life_outer board
  end 
;;

let life_test5 = 
  new board = 
    fill {4,4:int_shape} 
    with 
	[0,1,0,0,
	 1,0,1,0,
	 1,0,0,1,
	 0,1,1,0] 
  in 
    board := continuing_life_outer board
  end 
;;


let life_test6 = 
  new board = 
    fill {3,3,3:int_shape} 
    with 
	[0,0,0,
	 0,1,0,
	 0,0,0,
	 
	 0,0,0,
	 0,1,0,
	 0,0,0,
	 
	 0,0,0,
	 0,1,0,
	 0,0,0,
] 
  in 
    board := continuing_life_outer board
  end 
;;



*)