home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / adav313.zip / gnat-3_13p-os2-bin-20010916.zip / emx / gnat / examples / windows.adb < prev    next >
Text File  |  2000-07-19  |  4KB  |  149 lines
  1. --::::::::::
  2. --windows.adb
  3. --::::::::::
  4. with Text_IO, Screen;
  5. package body Windows is
  6.  
  7.   -- manager for simple, nonoverlapping screen windows
  8.   -- Michael Feldman, The George Washington University
  9.   -- July, 1995
  10.  
  11.   function Open (UpperLeft: Screen.Position;
  12.                  Height   : Screen.Height;
  13.                  Width    : Screen.Width) return Window is
  14.     Result: Window;
  15.   begin
  16.     Result.Current:= UpperLeft;
  17.     Result.First  := UpperLeft;
  18.     Result.Last   := (Row    => UpperLeft.Row + Height - 1, 
  19.                       Column => UpperLeft.Column + Width - 1);
  20.     return Result; 
  21.   end Open;
  22.  
  23.   procedure EraseToEndOfLine (W : in out Window) is
  24.   begin
  25.     Screen.MoveCursor (W.Current);
  26.     for Count in W.Current.Column .. W.Last.Column loop
  27.       Text_IO.Put (' ');
  28.     end loop;
  29.     Screen.MoveCursor (W.Current);
  30.   end EraseToEndOfLine;
  31.  
  32.   procedure Put (W  : in out Window;
  33.                  Ch : in CHARACTER) is
  34.   begin
  35.  
  36.     -- If at end of current line, move to next line 
  37.     if W.Current.Column > W.Last.Column then
  38.       if W.Current.Row = W.Last.Row then
  39.         W.Current.Row := W.First.Row;
  40.       else
  41.         W.Current.Row := W.Current.Row + 1;
  42.       end IF;
  43.       W.Current.Column := W.First.Column;
  44.     end IF;
  45.  
  46.     -- If at First char, erase line
  47.     if W.Current.Column = W.First.Column then
  48.       EraseToEndOfLine (W);
  49.     end IF;
  50.  
  51.     Screen.MoveCursor (To => W.Current);
  52.  
  53.      -- here is where we actually write the character!
  54.      Text_IO.Put (Ch);
  55.      W.Current.Column := W.Current.Column + 1;
  56.  
  57.   end Put;
  58.  
  59.   procedure Put (W : in out Window;
  60.                  S : in String) is
  61.   begin
  62.     for Count in S'Range loop
  63.       Put (W, S (Count));
  64.     end loop;
  65.   end Put;
  66.  
  67.   procedure New_Line (W : in out Window) is
  68.   begin
  69.     if W.Current.Column = 1 then
  70.       EraseToEndOfLine (W);
  71.     end IF;
  72.     if W.Current.Row = W.Last.Row then
  73.       W.Current.Row := W.First.Row;
  74.     else
  75.       W.Current.Row := W.Current.Row + 1;
  76.     end IF;
  77.     W.Current.Column := W.First.Column;
  78.   end New_Line;
  79.  
  80.   procedure Title (W     : in out Window;
  81.                    Name  : in String;
  82.                    Under : in Character) is
  83.   begin
  84.     -- Put name on top line
  85.     W.Current := W.First;
  86.     Put (W, Name);
  87.     New_Line (W);
  88.     -- Underline name if desired, and reduce the writable area
  89.     -- of the window by one line
  90.     if Under = ' ' then   -- no underlining
  91.       W.First.Row := W.First.Row + 1;      
  92.     else                  -- go across the row, underlining
  93.       for Count in W.First.Column..W.Last.Column loop 
  94.         Put (W, Under);
  95.       end loop;
  96.       New_Line (W);
  97.       W.First.Row := W.First.Row + 2; -- reduce writable area
  98.     end IF;
  99.   end Title;
  100.  
  101.   procedure Borders (W                    : in out Window;
  102.                      Corner, Down, Across : in Character) is
  103.   begin
  104.     -- Put top line of border
  105.     Screen.MoveCursor (W.First);
  106.     Text_IO.Put (Corner);
  107.     for Count in W.First.Column + 1 .. W.Last.Column - 1 loop
  108.       Text_IO.Put (Across);
  109.     end loop;
  110.     Text_IO.Put (Corner);
  111.  
  112.     -- Put the two side lines
  113.     for Count in W.First.Row + 1 .. W.Last.Row - 1 loop
  114.       Screen.MoveCursor ((Row => Count, Column => W.First.Column));
  115.       Text_IO.Put (Down);
  116.       Screen.MoveCursor ((Row => Count, Column => W.Last.Column));
  117.       Text_IO.Put (Down);
  118.     end loop;
  119.  
  120.     -- Put the bottom line of the border
  121.     Screen.MoveCursor ((Row => W.Last.Row, Column => W.First.Column));
  122.     Text_IO.Put (corner);
  123.     for Count in W.First.Column + 1 .. W.Last.Column - 1 loop
  124.       Text_IO.Put (Across);
  125.     end loop;
  126.     Text_IO.Put (Corner);
  127.  
  128.     -- Make the Window smaller by one character on each side
  129.     W.First  := (Row => W.First.Row  + 1, Column => W.First.Column  + 1);
  130.     W.Last   := (Row => W.Last.Row - 1,   Column => W.Last.Column - 1);
  131.     W.Current    := W.First;
  132.   end Borders;
  133.  
  134.   procedure MoveCursor (W : in out Window;
  135.                         P : in Screen.Position) is
  136.     -- Relative to writable Window boundaries, of course
  137.   begin
  138.     W.Current.Row    := W.First.Row + P.Row;
  139.     W.Current.Column := W.First.Column + P.Column;
  140.   end MoveCursor;
  141.  
  142. begin
  143.  
  144.   Text_IO.New_Line;
  145.   Screen.ClearScreen;
  146.   Text_IO.New_Line;
  147.  
  148. end Windows;
  149.