/packages/ptc/src/core/baseconsolei.inc
Pascal | 234 lines | 175 code | 26 blank | 33 comment | 4 complexity | 6925311c34c7cb93330eb61c1f1f6d13 MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
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;