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;
Copyright ©
1996 Simon Johnston &
Addison Wesley Longman