% КА "Жизнь" - распределенная версия. Число процессоров не меньше 3х.

functor
import
	Remote
	Application(exit)
	QTk at 'x-oz://system/wp/QTk.ozf'
	Browser(browse:Browse)
define


% Переменные:

ProcessorsAddr = ['cluster@10.254.0.15' 'cluster@10.254.0.14' 'cluster@10.254.0.10']
NumProc = {Length ProcessorsAddr}
Processors
Processes
PProcesses

WgN WgText

FieldSize = 40
PFieldSize = [14 13 13]


% ГИП:

proc {ExitProg}
	for P in PProcesses do
		{Send P endapp()}
	end

	{Application.exit 0}
end


Window = {QTk.build td(
	text(tdscrollbar:false lrscrollbar:false handle:WgText font:'Courier 8 bold' width:FieldSize height:FieldSize bg:'white' foreground:'DarkBlue')
	numberentry(min:1 max:1000 init:1 handle:WgN)
	button(text:'Next' glue:we action:CalcCadres)
	button(text:'Init' glue:we action:InitProg)
	button(text:'Exit' glue:we action:ExitProg)
	action:proc{$} {ExitProg} end
	)}
{Window show}
{Window set(title:"Life dist. ver.")}


% Функторы:

FtrProcess = functor % Задание для удаленной машины
import
	Application(exit)

export
	p:Pin % Порт для вызова процедур
	pb:Pbarrier % Порт для использования синхронизации барьер
	plin:PLin
	prin:PRin
	plout:PLout
	prout:PRout
	r:R
	pd:PDebug

define
	R
	Sin Pin Pbarrier
	SLin SRin
	SLout SRout
	PLin PRin
	PLout PRout
	PDebug
	
	local
		Data1 Data2 FieldSizeX FieldSizeY ArrSel
		Name
	in
	
	Pin = {NewPort Sin}

	PLin = {NewPort SLin}
	PRin = {NewPort SRin}


	% Функции и процедуры:
	
	proc {Barrier}
		local B in
		
		{Send Pbarrier barrier(B)}
		{Wait B}
		
		end
	end


	fun {Get X Y}
		if {Or {Or X<0 X>FieldSizeX+1} {Or Y<0 Y>=FieldSizeY}} then
			false
		elseif @ArrSel then
			{Array.get Data1 X+Y*(FieldSizeX+2)}
		else
			{Array.get Data2 X+Y*(FieldSizeX+2)}
		end
	end

	proc {Set X Y V}
		if {Or {Or X<0 X>FieldSizeX+1} {Or Y<0 Y>=FieldSizeY}} then
			skip
		elseif {Not @ArrSel} then
			{Array.put Data1 X+Y*(FieldSizeX+2) V}
		else
			{Array.put Data2 X+Y*(FieldSizeX+2) V}
		end
	end

	
	fun {FunGetLine Lst X Y}
		if Y == FieldSizeY then
			Lst
		elseif Y == 0 then
			{FunGetLine {Get X Y} X Y+1}
		elseif Y == 1 then
			{FunGetLine [Lst {Get X Y}] X Y+1}
		else
			{FunGetLine {Append Lst [{Get X Y}]} X Y+1}
		end
	end
	
	proc {SendCol P X}
		local R in
		{Send P col({FunGetLine nil X 0} R)}
		{Wait R}
		end
	end

	proc {Sw}
		ArrSel := {Not @ArrSel}
	end


	proc {Clear}
		for I in 0..(FieldSizeX+2)*FieldSizeY-1 do
			if {Not @ArrSel} then
				{Array.put Data1 I false}
			else
				{Array.put Data2 I false}
			end
		end
	end


	% Серверы и потоки:

	proc {SetCol Lst X}
		local FunSetCol Y in
		Y = {NewCell 0}
		
		{Sw}
		for I in Lst do
			{Set X @Y I}
			Y := @Y + 1
		end
		{Sw}

		end

	end

	thread % Прием данных от левого потока
		for Msg in SLin do
			case Msg
			of	col(Data R) then
				{SetCol Data 0}
				R = true
			end
		end
	end

	thread % Прием данных от правого потока
		for Msg in SRin do
			case Msg
			of	col(Data R) then
				{SetCol Data FieldSizeX+1}
				R = true
			end
		end
	end
	
	
	thread % Сервер обработки вызовов
		for Msg in Sin do
			case Msg
			of	init0(Par R) then				
				FieldSizeX#FieldSizeY = Par
				
				Data1 = {Array.new 0 (FieldSizeX+2)*FieldSizeY-1 false}
				Data2 = {Array.new 0 (FieldSizeX+2)*FieldSizeY-1 false}
				ArrSel = {NewCell true}
				
				R = true
			
			[]	clear(R) then
				{Sw}
				{Clear}
				{Sw}
				{Clear}
				
				ArrSel := true
				
				R = true
			
			[]	set(Par R) then
				local X Y V in
				
				X#Y#V = Par

				{Sw}
				{Set X Y V}
				{Sw}
				
				R = true
				
				end

			[]	get(Par Ans R) then
				local X Y in
					
				X#Y = Par

				Ans = {Get X Y}

				R = true
				
				end

			[]	getline(Par Ans R) then
				Ans = {FunGetLine nil Par 0}
				R = true

			[]	setname(Par R) then % для отладочных целей
				Name = Par
				R = true

			[]	calccadres(Par R) then
				thread
				local N in
				
				N = Par

				for Iter in 1..N do

				% Шаг 1: послать первый и последний столбец соседям

				if PLout \= false then {SendCol PLout 1} end
				if PRout \= false then {SendCol PRout FieldSizeX} end

				{Barrier}
				
	
				% Шаг 2: вычисления

				{Clear}

				for X in 1..FieldSizeX do
					for Y in 0..FieldSizeY-1 do
						local C in
						C = {NewCell 0}

						for DX in X-1..X+1 do
							for DY in Y-1..Y+1 do
								if {And {Not {And DX == X DY == Y}} {Get DX DY}} == true then
									C := @C + 1
								end
							end
						end
			
						if {Get X Y} == true then
							if {And @C >= 2 @C =< 3} then
								{Set X Y true}
							end
						else
							if @C == 3 then
								{Set X Y true}
							end
						end
						
						end
					end
				end

				% Шаг 3: Переключить массивы

				{Sw}

				{Barrier}

				end
				
				R = true
				end	
				end
			
			[]	endapp() then {Application.exit 0}
			end
		end
	end

	R = true
	end
end


% Программа:

% Старт многопроцессорной системы:

{Browse 'start program'}
{Browse 'cluster: connect...'}
Processors = {Map ProcessorsAddr fun {$ A} {New Remote.manager init(host:A fork:ssh)} end}
Processes = {Map Processors fun {$ P} {P apply(FtrProcess $)} end}
PProcesses = {Map Processes fun {$ P} P.p end}
{Browse 'ok connect'}
{Browse NumProc#' processors'}


% Сервер механизма синхронизации барьер:

Pinbarrier Sinbarrier
Pinbarrier = {NewPort Sinbarrier}

thread
	local N ArB in
	N = {NewCell 1}
	ArB = {Array.new 1 NumProc nil}
	
	for Msg in Sinbarrier do
		case Msg
		of barrier(B) then {Array.put ArB @N B}
		end
		
		N := @N + 1

		if @N > NumProc then
			for I in 1..NumProc do
				{Array.get ArB I} = true
			end
		
			N := 1
		end
	end
	
	end
end


for P in Processes do
	P.pb = Pinbarrier
end


% Функции и процедуры:

proc {ParalCall PName InPar OutPar}
	local R in
	
	R = {Map {List.zip PProcesses {List.zip InPar OutPar fun {$ X Y} X|Y end} fun {$ X Y} X|Y end}
		fun {$ Par}
			P In Out R in
			P = Par.1	In = Par.2.1	Out = Par.2.2
			
			{Send P PName(In Out R)}
			R
		end
		}
	
	for W in R do
		{Wait W}
	end
	
	end
end


proc {ParalCall2 PName InPar}
	local R in
	
	R = {Map {List.zip PProcesses InPar fun {$ X Y} X|Y end}
		fun {$ Par}
			P In R in
			P = Par.1	In = Par.2
			
			{Send P PName(In R)}
			R
		end
		}
	
	for W in R do
		{Wait W}
	end
	
	end
end

proc {ParalCall3 PName}
	local R in
	
	R = {Map PProcesses
		fun {$ P}
			R in
			{Send P PName(R)}
			R
		end
		}
	
	for W in R do
		{Wait W}
	end
	
	end
end


proc {InitProg}
	{ParalCall3 clear}

	for I in 0..8 do
		{Set 17+I 12 true}
	end

	for I in 0..4 do
		{Set 27+I 12 true}
	end

	{DrawField}
end

fun {GetItem Lst I}
	{List.last {List.take Lst I}}
end

fun {ConvX X}
	NProc in
	
	fun {NProc X LstSize I}
		if LstSize.1 > X then
			I#X
		else
			{NProc X-LstSize.1 LstSize.2 I+1}
		end
	end
	
	{NProc X PFieldSize 1}
end

fun {Get X Y}
	local NP XP P R V in
		
	NP#XP = {ConvX X}

	P = {GetItem PProcesses NP}
	{Send P get(XP+1#Y V R)} {Wait R}
	V
	end
end

proc {Set X Y V}
	local NP XP P R in
		
	NP#XP = {ConvX X}

	P = {GetItem PProcesses NP}
	{Send P set(XP+1#Y#V R)} {Wait R}
	
	end
end

proc {DrawField}
	local S in
	S = {NewCell ""}
	
	{WgText delete('1.0' 'end')}

	
	for X in 0..FieldSize-1 do
		local P PN X1 R Ans in
		
		PN#X1 = {ConvX X}
		P = {GetItem PProcesses PN}
		
		{Send P getline(X1+1 Ans R)} {Wait R}
		
		for I in Ans do
			if I == true then
				S := @S#"O"
			else
				S := @S#" "
			end
		end

		S := @S#"\n"
			
		end
	end


	{WgText insert('end' @S)}

	end
end


proc {CalcCadres}
	local T1 T2 T3 N in

	N = {WgN get($)}

	{Time.time T1}
	
	{ParalCall2 calccadres {Map PProcesses fun {$ X} N end}}
	
	{Time.time T2}
	T3 = T2 - T1
	{Browse 'N: '#N#'  total: '#T3#'  one: '#{Int.toFloat T3}/{Int.toFloat N}}

	{DrawField}
		
	end
end


proc {SetLinks}
	{FoldL Processes
		fun {$ L R}
			R.plout = L
			R.prin
		end
	false _}

	{FoldR Processes
		fun {$ L R}
			L.prout = R
			L.plin
		end
	false _}
end

PDebug SDebug
PDebug = {NewPort SDebug}

thread % сервер отладочных сообщений
	for Msg in SDebug do
		{Browse Msg}
	end
end


% Собственно программа:

for P in Processes do
	{Wait P.r}
	P.pd = PDebug
end

{Browse 'start mainproc'}

{ParalCall2 init0 {Map PFieldSize fun {$ X} (X#FieldSize) end}}
{SetLinks}
{InitProg}

{ParalCall2 setname ['Term' 'Robo' 'Mega']} % для отладочных целей

{Browse 'ok mainproc'}

end