← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to rtl/inc/video.inc

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
rtl/inc/video.inc
1
 
{
2
 
    $Id: video.inc,v 1.7 2002/09/07 15:07:46 peter Exp $
3
 
    This file is part of the Free Pascal run time library.
4
 
    Copyright (c) 1999-2000 by the Free Pascal development team
5
 
 
6
 
    See the file COPYING.FPC, included in this distribution,
7
 
    for details about the copyright.
8
 
 
9
 
    This program is distributed in the hope that it will be useful,
10
 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
11
 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12
 
 
13
 
 **********************************************************************}
14
 
 
15
 
Const
16
 
  LockUpdateScreen : Integer = 0;
17
 
 
18
 
Procedure LockScreenUpdate;
19
 
 
20
 
begin
21
 
  Inc(LockUpdateScreen);
22
 
end;
23
 
 
24
 
Procedure UnLockScreenUpdate;
25
 
 
26
 
begin
27
 
  If LockUpdateScreen>0 then
28
 
    Dec(LockUpdateScreen);
29
 
end;
30
 
 
31
 
Function GetLockScreenCount : integer;
32
 
begin
33
 
  GetLockScreenCount:=LockUpdateScreen;
34
 
end;
35
 
 
36
 
Var
37
 
  CurrentVideoDriver : TVideoDriver;
38
 
  NextVideoMode      : TVideoMode;
39
 
 
40
 
Const
41
 
  VideoInitialized : Boolean = False;
42
 
  DriverInitialized : Boolean = False;
43
 
  NextVideoModeSet  : Boolean = False;
44
 
 
45
 
Function SetVideoDriver (Const Driver : TVideoDriver) : Boolean;
46
 
{ Sets the videodriver to be used }
47
 
begin
48
 
  If Not VideoInitialized then
49
 
    Begin
50
 
    CurrentVideoDriver:=Driver;
51
 
      DriverInitialized:=true;
52
 
      NextVideoModeSet:=false;
53
 
    End;
54
 
  SetVideoDriver:=Not VideoInitialized;
55
 
end;
56
 
 
57
 
Procedure GetVideoDriver (Var Driver : TVideoDriver);
58
 
{ Retrieves the current videodriver }
59
 
begin
60
 
  Driver:=CurrentVideoDriver;
61
 
end;
62
 
 
63
 
{ ---------------------------------------------------------------------
64
 
  External functions that use the video driver.
65
 
  ---------------------------------------------------------------------}
66
 
 
67
 
Procedure FreeVideoBuf;
68
 
 
69
 
begin
70
 
  if (VideoBuf<>Nil) then
71
 
    begin
72
 
    FreeMem(VideoBuf);
73
 
    FreeMem(OldVideoBuf);
74
 
    VideoBuf:=Nil;
75
 
    OldVideoBuf:=Nil;
76
 
    VideoBufSize:=0;
77
 
    end;
78
 
end;
79
 
 
80
 
Procedure AssignVideoBuf (OldCols, OldRows : Word);
81
 
 
82
 
Var NewVideoBuf,NewOldVideoBuf : PVideoBuf;
83
 
    S,I,C,R,NewVideoBufSize : Integer;
84
 
 
85
 
begin
86
 
  S:=SizeOf(TVideoCell);
87
 
  NewVideoBufSize:=ScreenWidth*ScreenHeight*S;
88
 
  GetMem(NewVideoBuf,NewVideoBufSize);
89
 
  GetMem(NewOldVideoBuf,NewVideoBufSize);
90
 
  // Move contents of old videobuffers to new if there are any.
91
 
  if (VideoBuf<>Nil) then
92
 
    begin
93
 
    If (ScreenWidth<OldCols) then
94
 
      C:=ScreenWidth
95
 
    else
96
 
      C:=OldCols;
97
 
    If (ScreenHeight<OldRows) then
98
 
      R:=ScreenHeight
99
 
    else
100
 
      R:=OldRows;
101
 
    For I:=0 to R-1 do
102
 
      begin
103
 
      Move(VideoBuf^[I*OldCols],NewVideoBuf^[I*ScreenWidth],S*C);
104
 
      Move(OldVideoBuf^[I*OldCols],NewOldVideoBuf^[I*ScreenWidth],S*C);
105
 
      end;
106
 
    end;
107
 
  FreeVideoBuf;
108
 
  VideoBufSize:=NewVideoBufSize;
109
 
  VideoBuf:=NewVideoBuf;
110
 
  OldVideoBuf:=NewOldVideoBuf;
111
 
end;
112
 
 
113
 
Procedure InitVideo;
114
 
 
115
 
begin
116
 
  If Not VideoInitialized then
117
 
    begin
118
 
    If Assigned(CurrentVideoDriver.InitDriver) then
119
 
      CurrentVideoDriver.InitDriver;
120
 
    VideoInitialized:=True;
121
 
    if NextVideoModeSet then
122
 
      SetVideoMode(NextVideoMode)
123
 
    else
124
 
    AssignVideoBuf(0,0);
125
 
    ClearScreen;
126
 
    end;
127
 
end;
128
 
 
129
 
 
130
 
Procedure DoneVideo;
131
 
 
132
 
begin
133
 
  If VideoInitialized then
134
 
    begin
135
 
    If Assigned(CurrentVideoDriver.DoneDriver) then
136
 
      CurrentVideoDriver.DoneDriver;
137
 
    FreeVideoBuf;
138
 
    VideoInitialized:=False;
139
 
    end;
140
 
end;
141
 
 
142
 
Procedure UpdateScreen (Force : Boolean);
143
 
 
144
 
begin
145
 
  If (LockUpdateScreen<=0) and
146
 
     Assigned(CurrentVideoDriver.UpdateScreen) then
147
 
      CurrentVideoDriver.UpdateScreen(Force);
148
 
end;
149
 
 
150
 
Procedure ClearScreen;
151
 
 
152
 
begin
153
 
  // Should this not be the current color ?
154
 
  FillWord(VideoBuf^,VideoBufSize shr 1,$0720);
155
 
  If Assigned(CurrentVideoDriver.ClearScreen) then
156
 
    CurrentVideoDriver.ClearScreen
157
 
  else
158
 
    UpdateScreen(True);
159
 
  FillWord(OldVideoBuf^,VideoBufSize shr 1,$0720);
160
 
end;
161
 
 
162
 
Procedure SetCursorType (NewType : Word);
163
 
 
164
 
begin
165
 
  if Assigned(CurrentVideoDriver.SetCursorType) then
166
 
    CurrentVideoDriver.SetCursorType(NewType)
167
 
end;
168
 
 
169
 
Function GetCursorType : Word;
170
 
 
171
 
begin
172
 
  if Assigned(CurrentVideoDriver.GetCursorType) then
173
 
    GetCursorType:=CurrentVideoDriver.GetCursorType()
174
 
  else
175
 
    GetCursorType:=0;
176
 
end;
177
 
 
178
 
procedure SetCursorPos(NewCursorX, NewCursorY: Word);
179
 
 
180
 
begin
181
 
  If Assigned(CurrentVideoDriver.SetCursorPos) then
182
 
    CurrentVideoDriver.SetCursorPos(NewCursorX, NewCursorY)
183
 
end;
184
 
 
185
 
function GetCapabilities: Word;
186
 
begin
187
 
  If Assigned(CurrentVideoDriver.GetCapabilities) then
188
 
    GetCapabilities:=CurrentVideoDriver.GetCapabilities()
189
 
  else
190
 
    GetCapabilities:=0;
191
 
end;
192
 
 
193
 
 
194
 
{ ---------------------------------------------------------------------
195
 
    General functions
196
 
  ---------------------------------------------------------------------}
197
 
 
198
 
 
199
 
procedure GetVideoMode(var Mode: TVideoMode);
200
 
begin
201
 
  Mode.Col := ScreenWidth;
202
 
  Mode.Row := ScreenHeight;
203
 
  Mode.Color := ScreenColor;
204
 
end;
205
 
 
206
 
Function SetVideoMode(Const Mode: TVideoMode) : Boolean;
207
 
 
208
 
Var
209
 
  OldR,OldC: Word;
210
 
 
211
 
begin
212
 
  SetVideoMode:=DriverInitialized;
213
 
  if not DriverInitialized then
214
 
    exit;
215
 
  If VideoInitialized then
216
 
    begin
217
 
  OldC:=ScreenWidth;
218
 
  OldR:=ScreenHeight;
219
 
  If Assigned(CurrentVideoDriver.SetVideoMode) then
220
 
    SetVideoMode:=CurrentVideoDriver.SetVideoMode(Mode)
221
 
  else
222
 
    SetVideoMode:=False;
223
 
  // Assign buffer
224
 
  If SetVideoMode then
225
 
    AssignVideoBuf(OldC,Oldr);
226
 
    end
227
 
  else
228
 
    begin
229
 
    NextVideoMode:=Mode;
230
 
    NextVideoModeSet:=true;
231
 
    end;
232
 
end;
233
 
 
234
 
 
235
 
Function GetVideoModeCount : Word;
236
 
 
237
 
begin
238
 
  If Assigned(CurrentVideoDriver.GetVideoModeCount) then
239
 
    GetVideoModeCount:=CurrentVideoDriver.GetVideoModeCount()
240
 
  else
241
 
    GetVideoModeCount:=1;
242
 
end;
243
 
 
244
 
Function GetVideoModeData(Index : Word; Var Data: TVideoMode) : Boolean;
245
 
 
246
 
begin
247
 
  If Assigned(CurrentVideoDriver.GetVideoModeData) then
248
 
    GetVideoModeData:=CurrentVideoDriver.GetVideoModeData(Index,Data)
249
 
  else
250
 
    begin
251
 
    GetVideoModeData:=(Index=0);
252
 
    If GetVideoModeData then
253
 
      GetVideoMode(Data);
254
 
    end
255
 
end;
256
 
 
257
 
function DefaultErrorHandler(AErrorCode: Longint; AErrorInfo: Pointer): TErrorHandlerReturnValue;
258
 
begin
259
 
  ErrorCode := AErrorCode;
260
 
  ErrorInfo := AErrorInfo;
261
 
  DefaultErrorHandler := errAbort; { return error code }
262
 
end;
263
 
 
264
 
{
265
 
  $Log: video.inc,v $
266
 
  Revision 1.7  2002/09/07 15:07:46  peter
267
 
    * old logs removed and tabs fixed
268
 
 
269
 
}
270