with DC_Text; use DC_Text;

procedure FistD is
---------------------------------------------------------------------------
---------------------------------------------------------------------------
  type Phase_Type is ( C, R, O, F );
  type Net_Type is array ( positive range <> ) of Phase_Type;
  type Inp_Type is ( L, M, H );
  type Inputs_Type is array ( positive range <> ) of Inp_Type;
  type Trans_Type is array ( positive range <>, positive range <> )
	 of boolean;
  type Wgt_Type is ( D, I, E );
  type Wgts_Type is array ( positive range <>, positive range <> )
	 of Wgt_Type;

procedure Get_Inputs ( Input_Neurons: in out Net_Type ) is
---------------------------------------------------------------------------
  Neuron : positive := 1;
  Phase_Char : string ( 1..( Input_Neurons'last + 1 ) );
  Phase_Count : natural;
begin
  loop
    Put ( "Input Neuron" & positive'image ( Neuron )
      & " Phase ( F = Fire, R = Rest, Default = float ): " );
    Get_Line ( Phase_Char, Phase_Count );
    if Phase_Count > 0 then
      for Phase in 1..Phase_Count loop
	case Phase_Char ( Phase ) is
	  when 'f' | 'F' => Input_Neurons ( Neuron ) := F;
	  when 'r' | 'R' => Input_Neurons ( Neuron ) := R;
	  when others => null;
	end case;
	Neuron := Neuron + 1;
	exit when Neuron > Input_Neurons'last;
      end loop;
    else
      Neuron := Neuron + 1;
    end if;
    exit when Neuron > Input_Neurons'last;
  end loop;
  Put_Line ( "" );
end Get_Inputs;

procedure Set_Inputs (
	    Inputs:    out Inputs_Type;
	    Trans : in     Trans_Type;
	    Wgts  : in     Wgts_Type ) is
---------------------------------------------------------------------------
  Exc, Inh : float;
  Inp_Total : float;
  Threshold : constant float := 1.0;
begin
  for Neuron in Trans'range ( 1 ) loop
    Exc := 0.0;
    Inh := 0.0;
    for Synapse in Trans'range ( 2 ) loop
      if Trans ( Neuron, Synapse ) then
	case Wgts ( Neuron, Synapse ) is
	  when D => null;
	  when I =>
	    Exc := Exc + 1.0;
	    Inh := Inh + 2.0;
	  when E =>
	    Exc := Exc + 2.0;
	    Inh := Inh + 1.0;
	end case;
      end if;
    end loop;
    Inp_Total := Exc / ( 1.0 + Inh );
    if Inp_Total >= Threshold then
      Inputs ( Neuron ) := H;
    elsif Inp_Total > 0.0 then
      Inputs ( Neuron ) := M;
    else
      Inputs ( Neuron ) := L;
    end if;
  end loop;
end Set_Inputs;

procedure Net_Update (
	    Net    : in out Net_Type;
	    Inputs : in     Inputs_Type ) is
---------------------------------------------------------------------------
begin
  for Neuron in Net'range loop
    case Net ( Neuron ) is
      when F => Net ( Neuron ) := C;
      when C | R | O =>
	case Inputs ( Neuron ) is
	  when H => Net ( Neuron ) := F;
	  when M => Net ( Neuron ) := O;
	  when L => Net ( Neuron ) := R;
	end case;
    end case;
  end loop;
end Net_Update;

procedure Learn
	    ( Wgts   : in out Wgts_Type;
	      Net    : in     Net_Type;
	      Trans  : in     Trans_Type ) is
---------------------------------------------------------------------------
begin
  for Neuron in Net'range loop
    for Synapse in Trans'range ( 2 ) loop
      if Trans ( Neuron, Synapse ) then
	case Net ( Neuron ) is
	  when C =>
	    case Wgts ( Neuron, Synapse ) is
	      when D => null;
	      when I => null;
	      when E => Wgts ( Neuron, Synapse ) := I;
	    end case;
	  when R => null;
	  when O | F =>
	    case Wgts ( Neuron, Synapse ) is
	      when D => null;
	      when I => Wgts ( Neuron, Synapse ) := E;
	      when E => null;
	    end case;
	end case;
      end if;
    end loop;
  end loop;
end Learn;

procedure Show ( Wgts: in Wgts_Type; Net: in Net_Type ) is
---------------------------------------------------------------------------
begin
  for Neuron in Net'range loop
    Put ( Phase_Type'image ( Net ( Neuron ) ) );
    Put ( ' ' );
  end loop;
  Put_Line ( "" );
  Put_Line ( "" );
  for Neuron in Net'range loop
    for Pre in Net'range loop
      Put ( Wgt_Type'image ( Wgts ( Neuron, Pre ) ) );
      Put ( ' ' );
    end loop;
    Put_Line ( "" );
  end loop;
  Put_Line ( "" );
end Show;

procedure Trans_Update (
	    Trans :    out Trans_Type;
	    Net   : in     Net_Type ) is
---------------------------------------------------------------------------
begin
  for Neuron in Net'range loop
    for Synapse in Trans'range ( 2 ) loop
      Trans ( Neuron, Synapse ) := Net ( Synapse ) = F;
    end loop;
  end loop;
end Trans_Update;

procedure Inculcate (
	    Input_Count : in natural  := 2;
	    Total_Count : in positive := 3 ) is
---------------------------------------------------------------------------
  Net : Net_Type ( 1..Total_Count ) := ( others => R );
  Inputs : Inputs_Type ( 1..Total_Count ) := ( others => L );
  Trans : Trans_Type ( 1..Total_Count, 1..Total_Count )
    := ( others => ( others => false ) );
  Wgts : Wgts_Type ( 1..Total_Count, 1..Total_Count )
    := ( others => ( others => E ) );
begin
  for Weight in Wgts'range loop
    Wgts ( Weight, Weight ) := D;
  end loop;
  loop
    Show ( Wgts, Net );
    Trans_Update ( Trans, Net );
    Set_Inputs ( Inputs, Trans, Wgts );
    Net_Update ( Net, Inputs );
    Learn ( Wgts, Net, Trans );
    Get_Inputs ( Net ( 1..Input_Count ) );
  end loop;
end Inculcate;

procedure Start is
---------------------------------------------------------------------------
  Input_Count : natural  := 2;
  Total_Count : positive := 3;
  package Nat_IO is new Integer_IO ( natural  );
  package Pos_IO is new Integer_IO ( positive );
begin
  Nat_IO.Ask ( Input_Count, "Input_Count ", Default => Input_Count );
  Pos_IO.Ask ( Total_Count, "Total_Count ", Default => Total_Count );
  Inculcate ( Input_Count, Total_Count );
end Start;

---------------------------------------------------------------------------
---------------------------------------------------------------------------
begin
  Start;
end FistD;