/packages/ptc/src/core/baseconsolei.inc

  1{
  2    Free Pascal port of the OpenPTC C++ library.
  3    Copyright (C) 2001-2003, 2006, 2007, 2009-2012  Nikolay Nikolov (nickysn@users.sourceforge.net)
  4    Original C++ version by Glenn Fiedler (ptc@gaffer.org)
  5
  6    This library is free software; you can redistribute it and/or
  7    modify it under the terms of the GNU Lesser General Public
  8    License as published by the Free Software Foundation; either
  9    version 2.1 of the License, or (at your option) any later version
 10    with the following modification:
 11
 12    As a special exception, the copyright holders of this library give you
 13    permission to link this library with independent modules to produce an
 14    executable, regardless of the license terms of these independent modules,and
 15    to copy and distribute the resulting executable under terms of your choice,
 16    provided that you also meet, for each linked independent module, the terms
 17    and conditions of the license of that module. An independent module is a
 18    module which is not derived from or based on this library. If you modify
 19    this library, you may extend this exception to your version of the library,
 20    but you are not obligated to do so. If you do not wish to do so, delete this
 21    exception statement from your version.
 22
 23    This library is distributed in the hope that it will be useful,
 24    but WITHOUT ANY WARRANTY; without even the implied warranty of
 25    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 26    Lesser General Public License for more details.
 27
 28    You should have received a copy of the GNU Lesser General Public
 29    License along with this library; if not, write to the Free Software
 30    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 31}
 32
 33type
 34  TPTCBaseConsole = class(TInterfacedObject, IPTCConsole, IPTCSurface)
 35  private
 36    FReleaseEnabled: Boolean;
 37
 38    procedure SetKeyReleaseEnabled(AValue: Boolean);
 39    function GetKeyReleaseEnabled: Boolean;
 40
 41    function GetWidth: Integer; virtual; abstract;
 42    function GetHeight: Integer; virtual; abstract;
 43    function GetPitch: Integer; virtual; abstract;
 44    function GetArea: IPTCArea; virtual; abstract;
 45    function GetFormat: IPTCFormat; virtual; abstract;
 46
 47    function GetPages: Integer; virtual; abstract;
 48    function GetName: string; virtual; abstract;
 49    function GetTitle: string; virtual; abstract;
 50    function GetInformation: string; virtual; abstract;
 51
 52    function GetOpenGL_Enabled: Boolean; virtual; abstract;
 53    procedure SetOpenGL_Enabled(AValue: Boolean); virtual; abstract;
 54    function GetOpenGL_Attributes: IPTCOpenGLAttributes;
 55  protected
 56    FOpenGLAttributes: IPTCOpenGLAttributes;
 57  public
 58    constructor Create; virtual;
 59
 60    procedure Copy(ASurface: IPTCSurface); virtual; abstract;
 61    procedure Copy(ASurface: IPTCSurface;
 62                   ASource, ADestination: IPTCArea); virtual; abstract;
 63    function Lock: Pointer; virtual; abstract;
 64    procedure Unlock; virtual; abstract;
 65    procedure Load(const APixels: Pointer;
 66                   AWidth, AHeight, APitch: Integer;
 67                   AFormat: IPTCFormat;
 68                   APalette: IPTCPalette); virtual; abstract;
 69    procedure Load(const APixels: Pointer;
 70                   AWidth, AHeight, APitch: Integer;
 71                   AFormat: IPTCFormat;
 72                   APalette: IPTCPalette;
 73                   ASource, ADestination: IPTCArea); virtual; abstract;
 74    procedure Save(APixels: Pointer;
 75                   AWidth, AHeight, APitch: Integer;
 76                   AFormat: IPTCFormat;
 77                   APalette: IPTCPalette); virtual; abstract;
 78    procedure Save(APixels: Pointer;
 79                   AWidth, AHeight, APitch: Integer;
 80                   AFormat: IPTCFormat;
 81                   APalette: IPTCPalette;
 82                   ASource, ADestination: IPTCArea); virtual; abstract;
 83    procedure Clear; virtual; abstract;
 84    procedure Clear(AColor: IPTCColor); virtual; abstract;
 85    procedure Clear(AColor: IPTCColor;
 86                    AArea: IPTCArea); virtual; abstract;
 87    procedure Palette(APalette: IPTCPalette); virtual; abstract;
 88    procedure Clip(AArea: IPTCArea); virtual; abstract;
 89    function Option(const AOption: String): Boolean; virtual; abstract;
 90    function Clip: IPTCArea; virtual; abstract;
 91    function Palette: IPTCPalette; virtual; abstract;
 92
 93    procedure Configure(const AFileName: String); virtual; abstract;
 94    function Modes: TPTCModeList; virtual; abstract;
 95    procedure Open(const ATitle: string; APages: Integer = 0); overload; virtual; abstract;
 96    procedure Open(const ATitle: string; AFormat: IPTCFormat;
 97                   APages: Integer = 0); overload; virtual; abstract;
 98    procedure Open(const ATitle: string; AWidth, AHeight: Integer;
 99                   AFormat: IPTCFormat; APages: Integer = 0); overload; virtual; abstract;
100    procedure Open(const ATitle: string; AMode: IPTCMode;
101                   APages: Integer = 0); overload; virtual; abstract;
102    procedure Close; virtual; abstract;
103    procedure Flush; virtual; abstract;
104    procedure Finish; virtual; abstract;
105    procedure Update; virtual; abstract;
106    procedure Update(AArea: IPTCArea); virtual; abstract;
107
108    { event handling }
109    function NextEvent(out AEvent: IPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean; virtual; abstract;
110    function PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): IPTCEvent; virtual; abstract;
111
112    { key handling }
113    function KeyPressed: Boolean;
114    function PeekKey(out AKey: IPTCKeyEvent): Boolean;
115    procedure ReadKey(out AKey: IPTCKeyEvent);
116    procedure ReadKey;
117    property KeyReleaseEnabled: Boolean read GetKeyReleaseEnabled write SetKeyReleaseEnabled;
118
119    property Pages: Integer read GetPages;
120    property Name: string read GetName;
121    property Title: string read GetTitle;
122    property Information: string read GetInformation;
123
124    property Width: Integer read GetWidth;
125    property Height: Integer read GetHeight;
126    property Pitch: Integer read GetPitch;
127    property Area: IPTCArea read GetArea;
128    property Format: IPTCFormat read GetFormat;
129
130    property OpenGL_Enabled: Boolean read GetOpenGL_Enabled write SetOpenGL_Enabled;
131    procedure OpenGL_SwapBuffers; virtual; abstract;
132    procedure OpenGL_SetSwapInterval(AInterval: Integer); virtual; abstract;
133    function OpenGL_GetSwapInterval: Integer; virtual; abstract;
134  end;
135
136  TPTCOpenGLLessConsole = class(TPTCBaseConsole)
137  private
138    function GetOpenGL_Enabled: Boolean; override;
139    procedure SetOpenGL_Enabled(AValue: Boolean); override;
140  public
141    procedure OpenGL_SwapBuffers; override;
142    procedure OpenGL_SetSwapInterval(AInterval: Integer); override;
143    function OpenGL_GetSwapInterval: Integer; override;
144  end;
145
146constructor TPTCBaseConsole.Create;
147begin
148  FReleaseEnabled := False;
149  FOpenGLAttributes := TPTCOpenGLAttributes.Create;
150end;
151
152function TPTCBaseConsole.GetOpenGL_Attributes: IPTCOpenGLAttributes;
153begin
154  Result := FOpenGLAttributes;
155end;
156
157function TPTCBaseConsole.KeyPressed: Boolean;
158var
159  k, kpeek: IPTCEvent;
160begin
161  repeat
162    kpeek := PeekEvent(False, [PTCKeyEvent]);
163    if kpeek = nil then
164      exit(False);
165    if FReleaseEnabled or (kpeek as IPTCKeyEvent).Press then
166      exit(True);
167    NextEvent(k, False, [PTCKeyEvent]);
168  until False;
169end;
170
171procedure TPTCBaseConsole.ReadKey(out AKey: IPTCKeyEvent);
172var
173  ev: IPTCEvent;
174begin
175  repeat
176    NextEvent(ev, True, [PTCKeyEvent]);
177  until FReleaseEnabled or (ev as IPTCKeyEvent).Press;
178  AKey := ev as IPTCKeyEvent;
179end;
180
181function TPTCBaseConsole.PeekKey(out AKey: IPTCKeyEvent): Boolean;
182begin
183  if KeyPressed then
184  begin
185    ReadKey(AKey);
186    Result := True;
187  end
188  else
189    Result := False;
190end;
191
192procedure TPTCBaseConsole.ReadKey;
193var
194  k: IPTCKeyEvent;
195begin
196  ReadKey(k);
197end;
198
199procedure TPTCBaseConsole.SetKeyReleaseEnabled(AValue: Boolean);
200begin
201  FReleaseEnabled := AValue;
202end;
203
204function TPTCBaseConsole.GetKeyReleaseEnabled: Boolean;
205begin
206  Result := FReleaseEnabled;
207end;
208
209function TPTCOpenGLLessConsole.GetOpenGL_Enabled: Boolean;
210begin
211  Result := False;
212end;
213
214procedure TPTCOpenGLLessConsole.SetOpenGL_Enabled(AValue: Boolean);
215begin
216  if AValue then
217    raise TPTCError.Create('Console does not support OpenGL');
218end;
219
220procedure TPTCOpenGLLessConsole.OpenGL_SwapBuffers;
221begin
222  raise TPTCError.Create('Console does not support OpenGL');
223end;
224
225procedure TPTCOpenGLLessConsole.OpenGL_SetSwapInterval(AInterval: Integer);
226begin
227  raise TPTCError.Create('Console does not support OpenGL');
228end;
229
230function TPTCOpenGLLessConsole.OpenGL_GetSwapInterval: Integer;
231begin
232  Result := -1;
233  raise TPTCError.Create('Console does not support OpenGL');
234end;