freepascal.compiler/packages/extra/ptc/consolei.inc

{
    Free Pascal port of the OpenPTC C++ library.
    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
    Original C++ version by Glenn Fiedler ([email protected])

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
    License as published by the Free Software Foundation; either
    version 2.1 of the License, or (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
}

Const
 {$IFDEF GO32V2}
  ConsoleTypesNumber = 4;
 {$ENDIF GO32V2}
 {$IFDEF Win32}
  ConsoleTypesNumber = 2;
 {$ENDIF Win32}
 {$IFDEF WinCE}
  ConsoleTypesNumber = 2;
 {$ENDIF WinCE}
 {$IFDEF UNIX}
  ConsoleTypesNumber = 1;
 {$ENDIF UNIX}
  ConsoleTypes : Array[0..ConsoleTypesNumber - 1] Of
    Record
      ConsoleClass : Class Of TPTCBaseConsole;
      Names : Array[1..2] Of String;
    End =
  (
  {$IFDEF GO32V2}
   (ConsoleClass : TVESAConsole;      Names : ('VESA', '')),
   (ConsoleClass : TVGAConsole;       Names : ('VGA', 'Fakemode')),
   (ConsoleClass : TCGAConsole;       Names : ('CGA', '')),
   (ConsoleClass : TTEXTFX2Console;   Names : ('TEXTFX2', 'Text'))
  {$ENDIF GO32V2}

  {$IFDEF Win32}
   (ConsoleClass : TDirectXConsole;   Names : ('DirectX', '')),
   (ConsoleClass : TGDIConsole;       Names : ('GDI', ''))
  {$ENDIF Win32}

  {$IFDEF WinCE}
   (ConsoleClass : TWinCEGAPIConsole; Names : ('GAPI', '')),
   (ConsoleClass : TWinCEGDIConsole;  Names : ('GDI', ''))
  {$ENDIF WinCE}

  {$IFDEF UNIX}
   (ConsoleClass : TX11Console;       Names : ('X11', ''))
  {$ENDIF UNIX}
  );

Constructor TPTCConsole.Create;

Var
  I : Integer;
  {$IFDEF UNIX}
  s : AnsiString;
  {$ENDIF UNIX}

Begin
  Inherited Create;
  console := Nil;
  hacky_option_console_flag := False;
  FillChar(m_modes, SizeOf(m_modes), 0);
  For I := Low(m_modes) To High(m_modes) Do
    m_modes[I] := TPTCMode.Create;

  {$IFDEF UNIX}
    configure('/usr/share/ptcpas/ptcpas.conf');
    s := fpgetenv('HOME');
    If s = '' Then
      s := '/';
    If s[Length(s)] <> '/' Then
      s := s + '/';
    s := s + '.ptcpas.conf';
    configure(s);
  {$ENDIF UNIX}

  {$IFDEF Win32}
    configure('ptcpas.cfg');
  {$ENDIF Win32}

  {$IFDEF GO32V2}
    configure('ptcpas.cfg');
  {$ENDIF GO32V2}

  {$IFDEF WinCE}
  {todo: configure WinCE}
  {$ENDIF WinCE}
End;

Destructor TPTCConsole.Destroy;

Var
  I : Integer;

Begin
  close;
  console.Free;
  For I := Low(m_modes) To High(m_modes) Do
    m_modes[I].Free;
  Inherited Destroy;
End;

Procedure TPTCConsole.configure(Const _file : String);

Var
  F : Text;
  S : String;

Begin
  AssignFile(F, _file);
  {$I-}
  Reset(F);
  {$I+}
  If IOResult <> 0 Then
    Exit;
  While Not EoF(F) Do
  Begin
    {$I-}
    Readln(F, S);
    {$I+}
    If IOResult <> 0 Then
      Break;
    option(S);
  End;
  CloseFile(F);
End;

Function TPTCConsole.option(Const _option : String) : Boolean;

Begin
  If _option = 'enable logging' Then
  Begin
    LOG_enabled := True;
    option := True;
    Exit;
  End;
  If _option = 'disable logging' Then
  Begin
    LOG_enabled := False;
    option := True;
    Exit;
  End;

  If Assigned(console) Then
    option := console.option(_option)
  Else
  Begin
    console := ConsoleCreate(_option);
    If Assigned(console) Then
    Begin
      hacky_option_console_flag := True;
      option := True;
    End
    Else
      option := False;
  End;
End;

Function TPTCConsole.modes : PPTCMode;

Var
  _console : TPTCBaseConsole;
  index, mode : Integer;
  local : Integer;
  _modes : PPTCMode;
  tmp : TPTCMode;

Begin
  If Assigned(console) Then
    modes := console.modes
  Else
  Begin
    _console := Nil;
    index := -1;
    mode := 0;
    Try
      Repeat
        Inc(index);
        Try
          _console := ConsoleCreate(index);
        Except
          On TPTCError Do Begin
            FreeAndNil(_console);
            Continue;
          End;
        End;
        If _console = Nil Then
          Break;
        _modes := _console.modes;
        local := 0;
        While _modes[local].valid Do
        Begin
          m_modes[mode].Assign(_modes[local]);
          Inc(local);
          Inc(mode);
        End;
        FreeAndNil(_console);
      Until False;
    Finally
      _console.Free;
    End;
    { todo: strip duplicate modes from list? }
    tmp := TPTCMode.Create;
    Try
      m_modes[mode].Assign(tmp);
    Finally
      tmp.Free;
    End;
    modes := m_modes;
  End;
End;

Procedure TPTCConsole.open(Const _title : String; _pages : Integer);{ Overload;}

Var
  composite, tmp : TPTCError;
  index : Integer;
  success : Boolean;

Begin
  If Assigned(console) Then
  Begin
    Try
      console.open(_title, _pages);
      Exit;
    Except
      On error : TPTCError Do Begin
        FreeAndNil(console);
        If hacky_option_console_flag Then
        Begin
          hacky_option_console_flag := False;
          Raise TPTCError.Create('could not open console', error);
        End;
      End;
    End;
  End;
  index := -1;
  composite := TPTCError.Create;
  success := False;
  Try
    Repeat
      Inc(index);
      Try
        console := ConsoleCreate(index);
        If console = Nil Then
          Break;
        console.open(_title, _pages);
        success := True;
        Exit;
      Except
        On error : TPTCError Do Begin
          tmp := TPTCError.Create(error.message, composite);
          Try
            composite.Assign(tmp);
          Finally
            tmp.Free;
          End;
          FreeAndNil(console);
          Continue;
        End;
      End;
    Until False;
    console := Nil;
    Raise TPTCError.Create(composite);
  Finally
    composite.Free;
    If Not success Then
      FreeAndNil(console);
  End;
End;

Procedure TPTCConsole.open(Const _title : String; Const _format : TPTCFormat;
                           _pages : Integer);{ Overload;}

Var
  composite, tmp : TPTCError;
  index : Integer;
  success : Boolean;

Begin
  If Assigned(console) Then
  Begin
    Try
      console.open(_title, _format, _pages);
      Exit;
    Except
      On error : TPTCError Do Begin
        FreeAndNil(console);
        If hacky_option_console_flag Then
        Begin
          hacky_option_console_flag := False;
          Raise TPTCError.Create('could not open console', error);
        End;
      End;
    End;
  End;
  index := -1;
  composite := TPTCError.Create;
  success := False;
  Try
    Repeat
      Inc(index);
      Try
        console := ConsoleCreate(index);
        If console = Nil Then
          Break;
        console.open(_title, _format, _pages);
        success := True;
        Exit;
      Except
        On error : TPTCError Do Begin
          tmp := TPTCError.Create(error.message, composite);
          Try
            composite.Assign(tmp);
          Finally
            tmp.Free;
          End;
          FreeAndNil(console);
          Continue;
        End;
      End;
    Until False;
    console := Nil;
    Raise TPTCError.Create(composite);
  Finally
    composite.Free;
    If Not success Then
      FreeAndNil(console);
  End;
End;

Procedure TPTCConsole.open(Const _title : String; _width, _height : Integer;
                           Const _format : TPTCFormat; _pages : Integer);{ Overload;}

Var
  composite, tmp : TPTCError;
  index : Integer;
  success : Boolean;

Begin
  If Assigned(console) Then
  Begin
    Try
      console.open(_title, _width, _height, _format, _pages);
      Exit;
    Except
      On error : TPTCError Do Begin
        FreeAndNil(console);
        If hacky_option_console_flag Then
        Begin
          hacky_option_console_flag := False;
          Raise TPTCError.Create('could not open console', error);
        End;
      End;
    End;
  End;
  index := -1;
  composite := TPTCError.Create;
  success := False;
  Try
    Repeat
      Inc(index);
      Try
        console := ConsoleCreate(index);
        If console = Nil Then
          Break;
        console.open(_title, _width, _height, _format, _pages);
        success := True;
        Exit;
      Except
        On error : TPTCError Do Begin
          tmp := TPTCError.Create(error.message, composite);
          Try
            composite.Assign(tmp);
          Finally
            tmp.Free;
          End;
          FreeAndNil(console);
          Continue;
        End;
      End;
    Until False;
    console := Nil;
    Raise TPTCError.Create(composite);
  Finally
    composite.Free;
    If Not success Then
      FreeAndNil(console);
  End;
End;

Procedure TPTCConsole.open(Const _title : String; Const _mode : TPTCMode;
                           _pages : Integer);{ Overload;}

Var
  composite, tmp : TPTCError;
  index : Integer;
  success : Boolean;

Begin
  If Assigned(console) Then
  Begin
    Try
      console.open(_title, _mode, _pages);
      Exit;
    Except
      On error : TPTCError Do Begin
        FreeAndNil(console);
        If hacky_option_console_flag Then
        Begin
          hacky_option_console_flag := False;
          Raise TPTCError.Create('could not open console', error);
        End;
      End;
    End;
  End;
  index := -1;
  composite := TPTCError.Create;
  success := False;
  Try
    Repeat
      Inc(index);
      Try
        console := ConsoleCreate(index);
        If console = Nil Then
          Break;
        console.open(_title, _mode, _pages);
        success := True;
        Exit;
      Except
        On error : TPTCError Do Begin
          tmp := TPTCError.Create(error.message, composite);
          Try
            composite.Assign(tmp);
          Finally
            tmp.Free;
          End;
          FreeAndNil(console);
          Continue;
        End;
      End;
    Until False;
    console := Nil;
    Raise TPTCError.Create(composite);
  Finally
    composite.Free;
    If Not success Then
      FreeAndNil(console);
  End;
End;

Procedure TPTCConsole.close;

Begin
  If Assigned(console) Then
    console.close;
  hacky_option_console_flag := False;
End;

Procedure TPTCConsole.flush;

Begin
  check;
  console.flush;
End;

Procedure TPTCConsole.finish;

Begin
  check;
  console.finish;
End;

Procedure TPTCConsole.update;

Begin
  check;
  console.update;
End;

Procedure TPTCConsole.update(Const _area : TPTCArea);

Begin
  check;
  console.update(_area);
End;

Procedure TPTCConsole.copy(Var surface : TPTCBaseSurface);

Begin
  check;
  console.copy(surface);
End;

Procedure TPTCConsole.copy(Var surface : TPTCBaseSurface;
                           Const source, destination : TPTCArea);

Begin
  check;
  console.copy(surface, source, destination);
End;

Function TPTCConsole.lock : Pointer;

Begin
  check;
  lock := console.lock;
End;

Procedure TPTCConsole.unlock;

Begin
  check;
  console.unlock;
End;

Procedure TPTCConsole.load(Const pixels : Pointer;
                           _width, _height, _pitch : Integer;
                           Const _format : TPTCFormat;
                           Const _palette : TPTCPalette);

Begin
  check;
  console.load(pixels, _width, _height, _pitch, _format, _palette);
End;

Procedure TPTCConsole.load(Const pixels : Pointer;
                           _width, _height, _pitch : Integer;
                           Const _format : TPTCFormat;
                           Const _palette : TPTCPalette;
                           Const source, destination : TPTCArea);

Begin
  check;
  console.load(pixels, _width, _height, _pitch, _format, _palette,
               source, destination);
End;

Procedure TPTCConsole.save(pixels : Pointer;
                           _width, _height, _pitch : Integer;
                           Const _format : TPTCFormat;
                           Const _palette : TPTCPalette);

Begin
  check;
  console.save(pixels, _width, _height, _pitch, _format, _palette);
End;

Procedure TPTCConsole.save(pixels : Pointer;
                           _width, _height, _pitch : Integer;
                           Const _format : TPTCFormat;
                           Const _palette : TPTCPalette;
                           Const source, destination : TPTCArea);

Begin
  check;
  console.save(pixels, _width, _height, _pitch, _format, _palette,
               source, destination);
End;

Procedure TPTCConsole.clear;

Begin
  check;
  console.clear;
End;

Procedure TPTCConsole.clear(Const color : TPTCColor);

Begin
  check;
  console.clear(color);
End;

Procedure TPTCConsole.clear(Const color : TPTCColor;
                           Const _area : TPTCArea);

Begin
  check;
  console.clear(color, _area);
End;

Procedure TPTCConsole.palette(Const _palette : TPTCPalette);

Begin
  check;
  console.palette(_palette);
End;

Function TPTCConsole.Palette : TPTCPalette;

Begin
  check;
  Result := console.Palette;
End;

Procedure TPTCConsole.Clip(Const _area : TPTCArea);

Begin
  check;
  console.clip(_area);
End;

Function TPTCConsole.GetWidth : Integer;

Begin
  check;
  Result := console.GetWidth;
End;

Function TPTCConsole.GetHeight : Integer;

Begin
  check;
  Result := console.GetHeight;
End;

Function TPTCConsole.GetPitch : Integer;

Begin
  check;
  Result := console.GetPitch;
End;

Function TPTCConsole.GetPages : Integer;

Begin
  check;
  Result := console.GetPages;
End;

Function TPTCConsole.GetArea : TPTCArea;

Begin
  check;
  Result := console.GetArea;
End;

Function TPTCConsole.Clip : TPTCArea;

Begin
  check;
  Result := console.Clip;
End;

Function TPTCConsole.GetFormat : TPTCFormat;

Begin
  check;
  Result := console.GetFormat;
End;

Function TPTCConsole.GetName : String;

Begin
  Result := '';
  If Assigned(console) Then
    Result := console.GetName
  Else
{$IFDEF GO32V2}
    Result := 'DOS';
{$ENDIF GO32V2}
{$IFDEF WIN32}
    Result := 'Win32';
{$ENDIF WIN32}
{$IFDEF LINUX}
    Result := 'Linux';
{$ENDIF LINUX}
End;

Function TPTCConsole.GetTitle : String;

Begin
  check;
  Result := console.GetTitle;
End;

Function TPTCConsole.GetInformation : String;

Begin
  check;
  Result := console.GetInformation;
End;

Function TPTCConsole.NextEvent(Var event : TPTCEvent; wait : Boolean; Const EventMask : TPTCEventMask) : Boolean;

Begin
  check;
  Result := console.NextEvent(event, wait, EventMask);
End;

Function TPTCConsole.PeekEvent(wait : Boolean; Const EventMask : TPTCEventMask) : TPTCEvent;

Begin
  check;
  Result := console.PeekEvent(wait, EventMask);
End;

Function TPTCConsole.ConsoleCreate(index : Integer) : TPTCBaseConsole;

Begin
  Result := Nil;
  If (index >= Low(ConsoleTypes)) And (index <= High(ConsoleTypes)) Then
    Result := ConsoleTypes[index].ConsoleClass.Create;

  If Result <> Nil Then
    Result.KeyReleaseEnabled := KeyReleaseEnabled;
End;

Function TPTCConsole.ConsoleCreate(Const AName : String) : TPTCBaseConsole;

Var
  I, J : Integer;

Begin
  Result := Nil;

  If AName = '' Then
    Exit;

  For I := Low(ConsoleTypes) To High(ConsoleTypes) Do
    For J := Low(ConsoleTypes[I].Names) To High(ConsoleTypes[I].Names) Do
      If AName = ConsoleTypes[I].Names[J] Then
      Begin
        Result := ConsoleTypes[I].ConsoleClass.Create;

        If Result <> Nil Then
        Begin
          Result.KeyReleaseEnabled := KeyReleaseEnabled;
          Exit;
        End;
      End;
End;

Procedure TPTCConsole.check;

Begin
  { $IFDEF DEBUG}
  If console = Nil Then
    Raise TPTCError.Create('console is not open (core)');
  { $ENDIF DEBUG}
End;