------------------------------------------------------------------------------
-- COMMON                                                                   --
--                                                                          --
-- Part of TextTools                                                        --
-- Designed and Programmed by Ken O. Burtch                                 --
--                                                                          --
------------------------------------------------------------------------------
--                                                                          --
--                 Copyright (C) 1999-2007 Ken O. Burtch                    --
--                                                                          --
-- This is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  This is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with this;  see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
--                                                                          --
-- This is maintained at http://www.pegasoft.ca/tt.html                     --
--                                                                          --
------------------------------------------------------------------------------
with Ada.Containers.Indefinite_Vectors;
with Ada.Containers.Vectors;
with Ada.Containers.Ordered_Sets;
with Ada.Strings.Unbounded;

package Common is

--- Compile Flags
--
-- Differentiate between compiling the finder (ie. the server that first
-- runs and establishes the environment and contains routines to answer
-- all questions) from the normal applications running under it (ie. the
-- clients which must negotiate with the finder for control of the screen.

IsFinder : constant boolean := true; -- true if compiling for a server
pragma export( C, IsFinder, "is_finder" );

---> Basic Rectangles
--
-- Rectangles are used all over.

subtype Points is positive;

type ARect is record
   left, top, right, bottom : integer;
end record;

nullRect : constant ARect := (0, 0, -1, -1);
pragma export( C, nullRect, "null_rect" );

procedure SetRect( r : out ARect; left, top, right, bottom : integer );
pragma export( C, SetRect, "set_rect" );

procedure OffsetRect( r : in out ARect; dx, dy : integer );
function  OffsetRect( r : in ARect; dx, dy : integer ) return ARect;
pragma export( C, offsetRect, "offset_rect" );

procedure InsetRect( r : in out ARect; dx, dy : integer );
function  InsetRect( r : in ARect; dx, dy : integer ) return ARect;
pragma export( C, insetRect, "inset_rect" );

function  InsideRect( Inner, Outer : in ARect ) return boolean;

function  InRect( x, y : integer; r : ARect ) return boolean;

function  IsEmptyRect( r : ARect ) return boolean;

-- Lists of Bounded Strings

package StrList is new Ada.Containers.Indefinite_Vectors (Positive, String);

---> Lists of Booleans

package BooleanList is new Ada.Containers.Vectors (Positive, Boolean);

---> Lists of Rectangles

function RectOrder( left, right : ARect ) return boolean;
package RectList is new Ada.Containers.Ordered_Sets (ARect, Rectorder);

---> Various Pointer Types
--
-- These are listed for convenience.

type BooleanPtr       is access all Boolean;
type IntegerPtr       is access all Integer;
type Short_IntegerPtr is access all Short_Integer;
type Long_IntegerPtr  is access all Long_Integer;
type FloatPtr         is access all Float;
type RectPtr          is access all ARect;

---> Error Handling
---
--- To get the best of all worlds, I'm providing the following vars/
--- procs.  If RaiseErrors is used, all calls to Error will result
--- in a GeneralError being raised (the error code is in LastError).
--- If TrapErrors (default) is used, all calls to Error will save the
--- error code in LastError and return and it's up to the program to
--- check to see if an error occurred.  If you need to save the error
--- handling method of the caller, save the value of RaisingErrors.
--- (I was going to create a stack, but that's slower and more work.
--- This is better when memory is low, and often the flag doesn't need
--- saving.)  If your subprogram uses these routines, call NoError first
--- to clear any outstanding error codes.
---
--- Core Error Codes
---
--- Listed here for convenience and to ensure they are unique
---
--- Core System Errors

type AnErrorCode is new short_integer range -1..short_integer'last;
subtype ACoreErrorCode is AnErrorCode range -1..499;
subtype AnUserErrorCode is AnErrorCode range 500..AnErrorCode'last;

TT_NotYetWritten : constant ACoreErrorCode :=  -1; -- routine not yet written
TT_OK            : constant ACoreErrorCode :=   0; -- no error
TT_MemoryLeak    : constant ACoreErrorCode :=  10; -- memory not deallocated
TT_LowMemory     : constant ACoreErrorCode :=  11; -- low on memory

pragma export( C, TT_NotYetWritten, "TT_not_yet_written" );
pragma export( C, TT_OK, "TT_ok" );
pragma export( C, TT_MemoryLeak, "TT_memory_leak" );
pragma export( C, TT_LowMemory, "TT_low_memory" );

--- Core System and related

TT_SystemError   : constant ACoreErrorCode := 100; -- command failed
TT_ParamError    : constant ACoreErrorCode := 101; -- param too long
TT_FileExistance : constant ACoreErrorCode := 110; -- file found/not found
TT_PathExistance : constant ACoreErrorCode := 111; -- path found/not found
TT_VolExistance  : constant ACoreErrorCode := 112; -- volume found/not found
TT_DevExistance  : constant ACoreErrorCode := 113; -- device found/not found
TT_FileStatus    : constant ACoreErrorCode := 114; -- open / not open
TT_FileLocking   : constant ACoreErrorCode := 115; -- file is locked/unlocked
TT_FileAccess    : constant ACoreErrorCode := 116; -- file is un/accessible
TT_VolLocking    : constant ACoreErrorCode := 117; -- volume readonly or not
TT_VolAccess     : constant ACoreErrorCode := 118; -- volume is un/accessible
TT_VolFull       : constant ACoreErrorCode := 119; -- no space on disk
TT_DevSequential : constant ACoreErrorCode := 120; -- tape device
TT_IOError       : constant ACoreErrorCode := 121; -- hardware or media error
TT_PathError     : constant ACoreErrorCode := 122; -- bad path for file sys
TT_FileBounds    : constant ACoreErrorCode := 123; -- position out of bounds

TT_OSOld         : constant ACoreErrorCode := 130; -- UNIX too old
TT_OSService     : constant ACoreErrorCode := 131; -- UNIX service missing

TT_Integrity     : constant ACoreErrorCode := 140; -- integrity test failure
TT_TestData      : constant ACoreErrorCode := 141; -- test data in operation

pragma export( C, TT_SystemError, "TT_system_error" );
pragma export( C, TT_ParamError, "TT_param_error" );
pragma export( C, TT_FileExistance, "TT_file_existance" );
pragma export( C, TT_PathExistance, "TT_path_existance" );
pragma export( C, TT_VolExistance, "TT_vol_existance" );
pragma export( C, TT_DevExistance, "TT_dev_existance" );
pragma export( C, TT_FileStatus, "TT_file_status" );
pragma export( C, TT_FileLocking, "TT_file_locking" );
pragma export( C, TT_FileAccess, "TT_file_access" );
pragma export( C, TT_VolLocking, "TT_vol_locking" );
pragma export( C, TT_VolAccess, "TT_vol_access" );
pragma export( C, TT_VolFull, "TT_vol_full" );
pragma export( C, TT_DevSequential, "TT_dev_sequential" );
pragma export( C, TT_IOError, "TT_io_error" );
pragma export( C, TT_PathError, "TT_path_error" );
pragma export( C, TT_FileBounds, "TT_file_bounds" );
pragma export( C, TT_OSOld, "TT_os_old" );
pragma export( C, TT_OSService, "TT_os_service" );
pragma export( C, TT_Integrity, "TT_integrity" );
pragma export( C, TT_TestData, "TT_test_data" );

---> Interpreter Errors
-- (not used)

TT_UnexpErr        : constant ACoreErrorCode := 200; -- unexpected character
TT_ParanErr        : constant ACoreErrorCode := 201; -- Bad paranthesis
TT_OperandErr      : constant ACoreErrorCode := 202; -- missing operand
TT_SyntaxErr       : constant ACoreErrorCode := 203; -- bad syntax
TT_TooCompErr      : constant ACoreErrorCode := 204; -- formula too complex
TT_ClashErr        : constant ACoreErrorCode := 205; -- type clash
TT_NotDeclErr      : constant ACoreErrorCode := 206; -- ident not declared
TT_EOProgErr       : constant ACoreErrorCode := 207; -- end of prog encountered
TT_QuoteErr        : constant ACoreErrorCode := 208; -- bad quote marks
TT_DivZeroErr      : constant ACoreErrorCode := 209; -- divide by zero

---> Core Userio Errors

---> Core Control Errors

---> Core Window Errors

TT_WindowExistance : constant ACoreErrorCode := 160; --window found/not
TT_NoControls      : constant ACoreErrorCode := 161; --no controls in window
TT_ControlExistance: constant ACoreErrorCode := 162;
TT_NoDialogTaskCB  : constant ACoreErrorCode := 163; --no manual handler

pragma export( C, TT_WIndowExistance,  "TT_window_existance" );
pragma export( C, TT_NoControls,       "TT_no_controls" );
pragma export( C, TT_ControlExistance, "TT_control_existance" );
pragma export( C, TT_NoDialogTaskCB,   "TT_no_dialog_task_cb" );

---> Error Variables/Functions

GeneralError     : exception;       -- exception raised by Error();
LastError        : AnErrorCode;     -- last Error error code
RaisingErrors    : boolean;         -- TRUE if GeneralError will be raised

procedure NoError;  -- clear LastError
  pragma Inline( NoError );
  pragma Export( C, NoError, "no_error" );
procedure Error( ErrorCode : AnErrorCode ); -- log an error
  pragma Inline( Error );
  pragma Export( C, Error, "error" );
procedure RaiseErrors; -- cause Error to raise a GeneralError
  pragma Inline( RaiseErrors );
procedure TrapErrors; -- cause Error to return normally
  pragma Inline( TrapErrors );
function  RaiseErrors return boolean;
function  TrapErrors return boolean;
procedure RestoreRaising( oldflag : boolean );
  pragma Inline( RestoreRaising );

--- Housekeeping
--
ProgramName      : Ada.Strings.Unbounded.Unbounded_String;
ShortProgramName : Ada.Strings.Unbounded.Unbounded_String;

-- Short program name is used for $SYS directory in os package.
-- and (when I get to it) temp file name prefix.

procedure StartupCommon( theProgramName, theShortProgramName : string );

procedure IdleCommon( IdlePeriod : in Duration );

procedure ShutdownCommon;
pragma export( C, ShutdownCommon, "shutdown_common" );

end Common;
