← Back to branch summary

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

« back to all changes in this revision

Viewing changes to fpcsrc/rtl/inc/videoh.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:
fpcsrc/rtl/inc/videoh.inc
 
1
{
 
2
    This file is part of the Free Pascal run time library.
 
3
    Copyright (c) 1999-2000 by the Free Pascal development team
 
4
 
 
5
    See the file COPYING.FPC, included in this distribution,
 
6
    for details about the copyright.
 
7
 
 
8
    This program is distributed in the hope that it will be useful,
 
9
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 
10
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
11
 
 
12
 **********************************************************************}
 
13
 
 
14
type
 
15
  PVideoMode = ^TVideoMode;
 
16
  TVideoMode = record
 
17
    Col,Row : Word;
 
18
    Color   : Boolean;
 
19
  end;
 
20
  TVideoModeSelector = function (const VideoMode: TVideoMode; Params: Longint): Boolean;
 
21
 
 
22
  TVideoCell = Word;
 
23
  PVideoCell = ^TVideoCell;
 
24
 
 
25
  TVideoBuf = array[0..32759] of TVideoCell;
 
26
  PVideoBuf = ^TVideoBuf;
 
27
 
 
28
  TVideoDriver = Record
 
29
    InitDriver        : Procedure;
 
30
    DoneDriver        : Procedure;
 
31
    UpdateScreen      : Procedure(Force : Boolean);
 
32
    ClearScreen       : Procedure;
 
33
    SetVideoMode      : Function (Const Mode : TVideoMode) : Boolean;
 
34
    GetVideoModeCount : Function : Word;
 
35
    GetVideoModeData  : Function(Index : Word; Var Data : TVideoMode) : Boolean;
 
36
    SetCursorPos      : procedure (NewCursorX, NewCursorY: Word);
 
37
    GetCursorType     : function : Word;
 
38
    SetCursorType     : procedure (NewType: Word);
 
39
    GetCapabilities   : Function : Word;
 
40
  end;
 
41
 
 
42
const
 
43
  { Foreground and background color constants }
 
44
  Black         = 0;
 
45
  Blue          = 1;
 
46
  Green         = 2;
 
47
  Cyan          = 3;
 
48
  Red           = 4;
 
49
  Magenta       = 5;
 
50
  Brown         = 6;
 
51
  LightGray     = 7;
 
52
 
 
53
  { Foreground color constants }
 
54
  DarkGray      = 8;
 
55
  LightBlue     = 9;
 
56
  LightGreen    = 10;
 
57
  LightCyan     = 11;
 
58
  LightRed      = 12;
 
59
  LightMagenta  = 13;
 
60
  Yellow        = 14;
 
61
  White         = 15;
 
62
 
 
63
  { Add-in for blinking }
 
64
  Blink         = 128;
 
65
 
 
66
  { Capabilities bitmask }
 
67
  cpUnderLine     = $0001;
 
68
  cpBlink         = $0002;
 
69
  cpColor         = $0004;
 
70
  cpChangeFont    = $0008;
 
71
  cpChangeMode    = $0010;
 
72
  cpChangeCursor  = $0020;
 
73
 
 
74
  { Possible cursor types }
 
75
  crHidden        = 0;
 
76
  crUnderLine     = 1;
 
77
  crBlock         = 2;
 
78
  crHalfBlock     = 3;
 
79
 
 
80
  { Possible error codes }
 
81
  vioOK              = 0;
 
82
  errVioBase         = 1000;
 
83
  errVioInit         = errVioBase + 1; { Initialization error, shouldn't occur on DOS, but may
 
84
                         on Linux }
 
85
  errVioNotSupported = errVioBase + 2; { call to an unsupported function }
 
86
  errVioNoSuchMode   = errVioBase + 3; { No such video mode }
 
87
 
 
88
const
 
89
  ScreenWidth  : Word = 0;
 
90
  ScreenHeight : Word = 0;
 
91
 
 
92
var
 
93
  ScreenColor  : Boolean;
 
94
  CursorX,
 
95
  CursorY      : Word;
 
96
  VideoBuf,
 
97
  OldVideoBuf  : PVideoBuf;
 
98
  VideoBufSize : Longint;
 
99
  CursorLines  : Byte;
 
100
 
 
101
const {The following constants were variables in the past.
 
102
       - Lowascii was set to true if ASCII characters < 32 were available
 
103
       - NoExtendedFrame was set to true if the double with line drawing
 
104
         characters were set to true.
 
105
 
 
106
      These variables did exist because of VT100 limitations on Unix. However,
 
107
      only part of the character set problem was solved this way. Nowadays, the
 
108
      video unit converts characters to the output character set (which might be
 
109
      VT100) automatically, so the user does not need to worry about it anymore.}
 
110
      LowAscii = true;
 
111
      NoExtendedFrame = false;
 
112
 
 
113
      FVMaxWidth = 132;
 
114
 
 
115
Procedure LockScreenUpdate;
 
116
{ Increments the screen update lock count with one.}
 
117
Procedure UnlockScreenUpdate;
 
118
{ Decrements the screen update lock count with one.}
 
119
Function GetLockScreenCount : integer;
 
120
{ Gets the current lock level }
 
121
Function SetVideoDriver (Const Driver : TVideoDriver) : Boolean;
 
122
{ Sets the videodriver to be used }
 
123
Procedure GetVideoDriver (Var Driver : TVideoDriver);
 
124
{ Retrieves the current videodriver }
 
125
 
 
126
procedure InitVideo;
 
127
{ Initializes the video subsystem }
 
128
procedure DoneVideo;
 
129
{ Deinitializes the video subsystem }
 
130
function GetCapabilities: Word;
 
131
{ Return the capabilities of the current environment }
 
132
procedure ClearScreen;
 
133
{ Clears the screen }
 
134
procedure UpdateScreen(Force: Boolean);
 
135
{ Force specifies whether the whole screen has to be redrawn, or (if target
 
136
  platform supports it) its parts only }
 
137
procedure SetCursorPos(NewCursorX, NewCursorY: Word);
 
138
{ Position the cursor to the given position }
 
139
function GetCursorType: Word;
 
140
{ Return the cursor type: Hidden, UnderLine or Block }
 
141
procedure SetCursorType(NewType: Word);
 
142
{ Set the cursor to the given type }
 
143
 
 
144
procedure GetVideoMode(var Mode: TVideoMode);
 
145
{ Return dimensions of the current video mode }
 
146
Function SetVideoMode(Const Mode: TVideoMode) : Boolean;
 
147
{ Set video-mode to have Mode dimensions, may return errVioNoSuchMode }
 
148
Function GetVideoModeCount : Word;
 
149
{ Get the number of video modes supported by this driver }
 
150
Function GetVideoModeData(Index : Word; Var Data: TVideoMode) : Boolean;
 
151
{ Get the data for Video mode Index. Index is zero based. }
 
152
 
 
153
type
 
154
  TErrorHandlerReturnValue = (errRetry, errAbort, errContinue);
 
155
  { errRetry = retry the operation,
 
156
    errAbort = abort, return error code,
 
157
    errContinue = abort, without returning errorcode }
 
158
 
 
159
  TErrorHandler = function (Code: Longint; Info: Pointer): TErrorHandlerReturnValue;
 
160
    { ErrorHandler is the standard procedural interface for all error functions.
 
161
      Info may contain any data type specific to the error code passed to the
 
162
      function. }
 
163
 
 
164
function DefaultErrorHandler(AErrorCode: Longint; AErrorInfo: Pointer): TErrorHandlerReturnValue;
 
165
{ Default error handler, simply sets error code, and returns errContinue }
 
166
 
 
167
const
 
168
  errOk              = 0;
 
169
  ErrorCode: Longint = ErrOK;
 
170
  ErrorInfo: Pointer = nil;
 
171
  ErrorHandler: TErrorHandler = @DefaultErrorHandler;
 
172