package Ada_Store.PoST.Device.Display

with Ada_Store.PoST.Input_Queue;

package Ada_Store.PoST.Device.Display is

   type Instance	is new Ada_Store.PoST.Device.Instance with private;

   procedure Open
     (Display : in out Instance);
    
   function  Lines
     (Display : in Instance)
      return Positive;

   function  Columns
     (Display : in Instance)
      return Positive;

   procedure Write
     (Display : in out Instance;
      Line    : in     Positive;
      Text    : in     String;
      Center  : in     Boolean	:= false);
   
   procedure Clear
     (Display : in out Instance;
      Line    : in     Positive);

   procedure Clear
     (Display : in out Instance);

   procedure Flush
     (Display	 : in out Instance;
      Flush_Mode : in     Device_Mode);

   procedure Accept_Input
     (Display : in out Instance;
      Input   : in     Input_Queue.Message_Ptr);
	
private
   type Memory;
   type Memory_Ptr	is access Memory;

   type Instance       	is new Ada_Store.PoST.Device.Instance with 
      record
         Lines		: Positive 	:= 1;
	 Columns	: Positive 	:= 1;
	 Internal	: Memory_Ptr	:= null;
      end record;

end Ada_Store.PoST.Device.Display;

with Ada.Strings; 
with Ada.Strings.Fixed; 

with Ada_Store.Support.Screen;

package body Ada_Store.PoST.Device.Display is

   package Screen renames Ada_Store.Support.Screen;

   type String_Ptr	is access String;
   type String_Array	is array (Positive range ) of String_Ptr;
   
   type Memory (Lines : Positive) is
      record
	 Text		: String_Array(1 .. Lines);
      end record;

   Windows	: array (Unit range 1 .. 3) of Screen.Rectangle := 
     (((3, 1), (6, 22)), ((7, 1), (10, 22)), ((11, 1), (14, 22)));

   procedure Open
     (Display : in out Instance) is
   begin
      
      Display.Lines   := 2;
      Display.Columns := 20;
      
      Display.Internal := new Memory(Display.Lines);
      
      if Display.Internal /= null then
	 Display.Current_Status := Idle;
      end if;
      
      for Line in 1 .. Display.Lines loop
	 Display.Internal.Text(Line) := new String'(1 .. Display.Columns => ' ');
      end loop;

      Screen.Lock_Exclusive;
      Screen.Box(Windows(Display.Unit_ID));
      Screen.Unlock;
      
   end Open;
   
   function  Lines
     (Display : in Instance)
      return Positive is
   begin
      if Display.Current_Status = Closed then

	 raise Incorrect_Status;
      end if;
      return Display.Lines;
   end Lines;

   function  Columns
     (Display : in Instance)
      return Positive is
   begin
      if Display.Current_Status = Closed then

	 raise Incorrect_Status;
      end if;
      return Display.Columns;
   end Columns;

   procedure Write
     (Display : in out Instance;
      Line    : in     Positive;
      Text    : in     String;
      Center  : in     Boolean  := false) is
      
      Justification	: Ada.Strings.Alignment := Ada.Strings.Left;
   begin
      if Display.Current_Status = Closed then
	 raise Incorrect_Status;
      end if;
      if Center then
	 Justification := Ada.Strings.Center;
      end if;
      Ada.Strings.Fixed.Move(Source	=> Text,
			     Target	=> Display.Internal.Text(Line).all,
			     Drop		=> Ada.Strings.Right,
			     Justify	=> Justification);
      Flush(Display, Output);
   end Write;
   
   procedure Clear
     (Display : in out Instance;
      Line    : in     Positive) is
   begin
      if Display.Current_Status = Closed then
	 raise Incorrect_Status;
      end if;
      Display.Internal.Text(Line).all := (others => ' ');
   end Clear;

   procedure Clear
     (Display : in out Instance) is
   begin
      if Display.Current_Status = Closed then
	 raise Incorrect_Status;
      end if;
      for Line in 1 .. Lines(Display) loop
	 Clear(Display, Line);
      end loop;
   end Clear;
   
   procedure Flush
     (Display    : in out Instance;
      Flush_Mode : in     Device_Mode) is
   begin
      if Display.Current_Status = Closed then
	 raise Incorrect_Status;
      end if;
      if Flush_Mode = Input then
	 raise Incorrect_Mode;
      end if;

      Render:
	 declare
	    Line   : Integer      := Integer(Windows(Display.Unit_ID).Top_Left.Line);
	    Column : Screen.Width := 2;
	 begin

	    Screen.Lock_Exclusive;

	    for Line2 in 1 .. Display.Lines loop
	       Screen.Set_Cursor((Screen.Height(Line + Line2), Column));
	       Screen.Put(Display.Internal.Text(Line2).all);
	    end loop;

	    Screen.Unlock;
      
	 end Render;
   end Flush;

   procedure Accept_Input
     (Display : in out Instance;
      Input   : in     Input_Queue.Message_Ptr) is 
   begin
      Input.all := (Action => Input_Queue.Unknown,
		    Input  => (others => Character'Val(0)),
		    Length => 0);

      Input_Queue.Append(Input);
   end Accept_Input;
	
end Ada_Store.PoST.Device.Display;

Contents Page

Copyright © 1996 Simon Johnston &
Addison Wesley Longman