-- FILE: 	playfield.adb
-- AUTHOR: 	E. Burke
-- DATE:	November, 1996
-- PURPOSE: 	Procedures to initialize, update and display stacks of
--              boxes (the 'play-field')

package body PLAY_FIELD is


-- Ask user for fixed parameters of boxes and stacks

  procedure Input (Play_Box : out BOXES;
		   Play_Stack : out STACKS) is  

    subtype INPUT_NUMBER is NATURAL range 0..MAX_INPUT;

    package Number_IO is 
       new Text_IO.Integer_IO(INPUT_NUMBER);

    Height	 : INPUT_NUMBER;
    Color	 : CHARACTER;
    Base	 : constant POSITIVE := 2;
    Screen_Width : constant POSITIVE := 80;
    Start_Pos	 : INTEGER range -10..70;
  begin
    
    -- Initialize stacks
    Start_Pos := -10;
    For i in 1..MAX_STACKS loop
      Start_Pos := Start_Pos + 20;
      Play_Stack(i).ID := STACK_ID(i);
      Play_Stack(i).Box_ID_Top := 0;
      Play_Stack(i).Base_Height := Base;
      Play_Stack(i).Center_Pos := Start_Pos;    
    end loop;    

    Text_IO.Put(Item => "For each box, you will be asked for its");  
    Text_IO.Put(Item => " height and what symbol to use "); 
    Text_IO.New_Line;
    Text_IO.Put(Item => "for display");
    Text_IO.New_Line;
    Text_IO.Put(Item => "Terminate the list by entering 0 for the height");
    Text_IO.New_Line;

    for i in 1..MAX_BOXES loop		-- initialize id's to zero
      Play_Box(i).Id := 0;    
    end loop;    

    for i in Play_Box'Range loop -- outer loop continues until 0 is entered
                                 -- to exit
 
      begin             --  exception-handler block
	Text_IO.Put(Item => "Input info. for box number: ");
	Number_IO.Put(Item => i);
    	Text_IO.New_Line;
        Text_IO.Put(Item => "Height (1 to 4): ");
        Number_IO.Get(Item => Height);
        exit when Height = 0;
        Text_IO.Put(Item => "Enter a character to represent this box: ");
        Text_IO.Get(Item => Color);
	Play_Box(i).Id     := i;
        Play_Box(i).Height := Height; 	-- process inputs
	Play_Box(i).Color  := Color;
	Play_Box(i).Radius := 0;

	Place_Box (i,1, Play_Box, Play_Stack); -- Put box on stack 1
 	
	-- grow boxes below as each new
	-- box is added to initial stack

        for j in 1..i loop  
          Play_Box(j).Radius := Play_Box(j).Radius + 1;  
    	end loop;

      exception
        when Text_IO.Data_Error =>
          Text_IO.Put (Item => "Value entered is out of range");
          Text_IO.New_line;    
          Text_IO.Skip_line;    
        when Constraint_Error =>
          Text_IO.Put (Item => "Value entered is out of range");
          Text_IO.New_line;    
          Text_IO.Skip_line;    
      end; 	 		-- end of exception handler block

    end loop; -- for loop
  end Input;


-- Place a Box on a Stack

  procedure Place_Box (Bid : in BOX_ID;	
		       Sid : in STACK_ID;
		       Play_Box : in out BOXES;
		       Play_Stack : in out STACKS) is

    Box_Under :  BOX_PROP;

  begin
    Play_Box(Bid).Cur_Stack := Sid;
    Play_Box(Bid).Cur_Box_Below := Play_Stack(Sid).Box_Id_Top;
    if Play_Stack(Sid).Box_Id_Top = 0 then
      Play_Box(Bid).Cur_Height_Bottom := Play_Stack(Sid).Base_Height;
    else
      Box_Under := Play_Box(Play_Stack(Sid).Box_Id_Top);
      Play_Box(Bid).Cur_Height_Bottom := Box_Under.Cur_Height_Bottom +
					 Box_Under.Height;
    end if;

    Play_Stack(Sid).Box_Id_Top := Bid;
  end Place_Box;


-- Remove Box from Stack

  procedure Remove_Box (Bid : out BOX_ID;	
		        Sid : in STACK_ID;
			Play_Box : in BOXES;
		   	Play_Stack : in out STACKS) is
  begin
    Bid := Play_Stack(Sid).Box_Id_Top;
    Play_Stack(Sid).Box_Id_Top := Play_Box(Bid).Cur_Box_Below;
  end Remove_Box;


-- User moves box from one stack to another
 
  procedure Move_Box (Play_Box : in out BOXES;
		      Play_Stack : in out STACKS;
		      Continue : out BOOLEAN) is  

    type INS_TYPE is (E,M);
    Instruction : INS_TYPE;
    Bid : BOX_ID;
    Sid1 : STACK_ID;
    Sid2 : STACK_ID;

    package STACKID_IO is 
       new Text_IO.Integer_IO(STACK_ID);
    package Instruction_IO is 
       new Text_IO.Enumeration_IO(Enum => INS_TYPE);

  begin
    
    Text_IO.Put(Item => "To Move a box, enter M and the from and to ");  
    Text_IO.Put(Item => "stack numbers");
    Text_IO.New_Line;
    Text_IO.Put(Item => "Terminate the game by entering E");
    Text_IO.New_Line;

    loop
      begin		-- exception-handler block
        Text_IO.Put(Item => "Enter instruction: ");
        Instruction_IO.Get(Item => Instruction);
        exit;
      exception
        when Text_IO.Data_Error =>
          Text_IO.Put (Item => "Instruction must be M or E");
          Text_IO.New_line;    
          Text_IO.Skip_line;    
      end; 	 		-- end of exception handler block
    end loop;

    Continue := TRUE;
    case Instruction is
    when M =>
      loop
        begin             --  exception-handler block
          Text_IO.Put(Item => "Enter from stack no: ");
          STACKID_IO.Get(Item => Sid1);
          Text_IO.New_Line;
          Text_IO.Put(Item => "Enter to stack no: ");
          STACKID_IO.Get(Item => Sid2);
          Text_IO.New_Line;

          if Play_Stack(Sid1).Box_ID_Top > Play_Stack(Sid2).Box_ID_Top then
            Remove_Box (Bid, Sid1, Play_Box, Play_Stack);
            Place_Box (Bid, Sid2, Play_Box, Play_Stack);	  
            exit;
          else
            Text_IO.Put(Item => "Cannot place larger box on smaller box");
            Text_IO.New_line;    
            Text_IO.Skip_line;    
          end if;

        exception
          when Text_IO.Data_Error =>
            Text_IO.Put (Item => "Value entered is out of range");
            Text_IO.New_line;    
            Text_IO.Skip_line;    
          when Constraint_Error =>
            Text_IO.Put (Item => "Value entered is out of range");
            Text_IO.New_line;    
            Text_IO.Skip_line;    
        end; 	 		-- end of exception handler block
      end loop;
    when others =>
      Continue := FALSE;
    end case;
         
  end Move_Box;


-- Display boxes
 
  procedure Display (Play_Box   : in BOXES;
                     Play_Stack : in STACKS) is

  Bid		:	BOX_ID;
  Box_Display	:	SCREEN_DISPLAY;
  j		:	FIELD_DIM;

  begin
    for i in Box_Display'Range(1) loop
      for j in Box_Display'Range(2) loop
        Box_Display(i,j) := ' ';
      end loop;
    end loop;

    for i in Play_Stack'Range loop
      j := Play_Stack(i).Center_Pos;
      case i is 
        when 1 =>
          Box_Display(23,j) := '1';
        when 2 =>
          Box_Display(23,j) := '2';
        when 3 =>
          Box_Display(23,j) := '3';
        when 4 =>
          Box_Display(23,j) := '4';
        when others =>
          NULL; 
      end case;
    end loop;

    for i in Play_Box'Range loop
      Bid := i;
      if Play_Box(Bid).ID > 0 then
        Output(Bid, Play_Box, Play_Stack, Box_Display);  -- load screen array
      end if;
    end loop;
    
    for i in Box_Display'Range(1) loop
      for j in Box_Display'Range(2) loop
        Text_IO.Put(Item => Box_Display(i,j));  -- output screen array
      end loop;
      Text_IO.New_Line;
    end loop;
    
  end Display;


--  Load boxes to screen display array

  procedure Output (Bid : in BOX_ID;
		    Play_Box : in BOXES;
		    Play_Stack : in STACKS;
		    Box_Display : out SCREEN_DISPLAY) is

	Sid		: STACK_ID;
	Left_Side	: FIELD_DIM;
	Bottom		: FIELD_DIM;
        Width		: BOX_DIM;
	k		: FIELD_DIM;
	m		: FIELD_DIM;

  begin
     
      Sid := Play_Box(Bid).Cur_Stack;
      Left_Side := Play_Stack(Sid).Center_Pos - Play_Box(Bid).Radius;
      Bottom := Play_Box(Bid).Cur_Height_Bottom;
      Width := 2 * Play_Box(Bid).Radius + 1;
      for i in 1..Play_Box(Bid).Height loop
        for j in 1..Width loop
	  k := SCREEN_HEIGHT - (Bottom + i);
          m := Left_Side + j;
          Box_Display(k,m) := Play_Box(Bid).Color;
        end loop;
      end loop; 
  end Output;


-- Ask user whether to run another or update cycle or terminate
 
 function Enquire return BOOLEAN is
 
    Run_again	:	BOOLEAN;
    Response	:	CHARACTER;

  begin

    while Response /= 'Y' and then Response /= 'y' and then 
          Response /= 'N' and then Response /= 'n' loop
      Text_IO.Put (Item => "Continue (y / n)");
      Text_IO.New_Line;
      Text_IO.Get (Item => Response);
    end loop;

    Run_Again := (Response ='Y') or else (Response = 'y');
  
    return Run_Again;
  end Enquire;
end PLAY_FIELD;

-- comments by G. Levine
-- Documentation, of course, is to be improved.

-- You should separate the stack operations into a separate package.
-- Then you can declare your pegs to be an array of some generic number
-- of stacks

-- Incorrect input should raise a Data_Error, nor a Constraint_Error.

--   for i in Play_Stack'Range loop
--      j := Play_Stack(i).Center_Pos;
--      case i is
--        when 1 =>
--          Box_Display(23,j) := '1';
--        when 2 =>
--          Box_Display(23,j) := '2';
--        when 3 =>
--          Box_Display(23,j) := '3';
--        when 4 =>
--          Box_Display(23,j) := '4';
--        when others =>
--          NULL;
--      end case;
--    end loop;

-- Change to Box_Display((23,j) := Character'Val (Integer'Pos(i)+     
--                                                Integer'Pos(0));

-- Besides a simplification, this also generalizes to 9 pegs instead of 4