The Video unit implements a screen access layer which is system independent. It can be used to write on the screen in a system-independent way, which should be optimal on all platforms for which the unit is implemented.
The working of the Video is simple: After calling InitVideo, the array VideoBuf contains a representation of the video screen of size ScreenWidth*ScreenHeight, going from left to right and top to bottom when walking the array elements: VideoBuf[0] contains the character and color code of the top-left character on the screen. VideoBuf[ScreenWidth] contains the data for the character in the first column of the second row on the screen, and so on.
To write to the 'screen', the text to be written should be written to the VideoBuf array. Calling UpdateScreen will then cp the text to the screen in the most optimal way. (an example can be found further on).
The color attribute is a combination of the foreground and background color, plus the blink bit. The bits describe the various color combinations:
The contents of the VideoBuf array may be modified: This is 'writing' to the screen. As soon as everything that needs to be written in the array is in the VideoBuf array, calling UpdateScreen will copy the contents of the array screen to the screen, in a manner that is as efficient as possible.
The updating of the screen can be prohibited to optimize performance; To this end, the LockScreenUpdate function can be used: This will increment an internal counter. As long as the counter differs from zero, calling UpdateScreen will not do anything. The counter can be lowered with UnlockScreenUpdate. When it reaches zero, the next call to UpdateScreen will actually update the screen. This is useful when having nested procedures that do a lot of screen writing.
The video unit also presents an interface for custom screen drivers, thus it is possible to override the default screen driver with a custom screen driver, see the SetVideoDriver call. The current video driver can be retrieved using the GetVideoDriver call.
Remark: The video unit should not be used together with the crt unit. Doing so will result in very strange behaviour, possibly program crashes.
Black = 0; Blue = 1; Green = 2; Cyan = 3; Red = 4; Magenta = 5; Brown = 6; LightGray = 7;The following color constants can be used as foreground colors only:
DarkGray = 8; LightBlue = 9; LightGreen = 10; LightCyan = 11; LightRed = 12; LightMagenta = 13; Yellow = 14; White = 15;The foreground and background color can be combined to a color attribute with the following code:
Attr:=ForeGroundColor + (BackGroundColor shl 4);The color attribute can be logically or-ed with the blink attribute to produce a blinking character:
Blink = 128;But not all drivers may support this.
The following constants describe the capabilities of a certain video mode:
cpUnderLine = $0001; cpBlink = $0002; cpColor = $0004; cpChangeFont = $0008; cpChangeMode = $0010; cpChangeCursor = $0020;The following constants describe the various supported cursor modes:
crHidden = 0; crUnderLine = 1; crBlock = 2; crHalfBlock = 3;When a video function needs to report an error condition, the following constants are used:
vioOK = 0; errVioBase = 1000; errVioInit = errVioBase + 1; { Initialization error} errVioNotSupported = errVioBase + 2; { Unsupported function } errVioNoSuchMode = errVioBase + 3; { No such video mode }The following constants can be read to get some information about the current screen:
ScreenWidth : Word = 0; ScreenHeight : Word = 0; LowAscii : Boolean = true; NoExtendedFrame : Boolean = false; FVMaxWidth = 132;The error-handling code uses the following constants:
errOk = 0; ErrorCode: Longint = ErrOK; ErrorInfo: Pointer = nil; ErrorHandler: TErrorHandler = DefaultErrorHandler;The ErrorHandler variable can be set to a custom-error handling function. It is set by default to the DefaultErrorHandler function.
PVideoMode = ^TVideoMode; TVideoMode = record Col,Row : Word; Color : Boolean; end;TVideoCell describes one character on the screen. The high byte contains the color attribute with which the character is drawn on the screen, and the low byte contains the ASCII code of the character to be drawn.
TVideoCell = Word; PVideoCell = ^TVideoCell;The TVideoBuf and PVideoBuf are two types used to represent the screen.
TVideoBuf = array[0..32759] of TVideoCell; PVideoBuf = ^TVideoBuf;The following type is used when reporting error conditions:
TErrorHandlerReturnValue = (errRetry, errAbort, errContinue);Here, errRetry means retry the operation, errAbort abort and return error code and errContinue means abort without returning an errorcode.
The TErrorHandler function is used to register an own error handling function. It should be used when installing a custom error handling function, and must return one of the above values.
TErrorHandler = function (Code: Longint; Info: Pointer): TErrorHandlerReturnValue;Code should contain the error code for the error condition, and the Info parameter may contain any data type specific to the error code passed to the function.
The TVideoDriver record can be used to install a custom video driver, with the SetVideoDriver call:
TVideoDriver = Record InitDriver : Procedure; DoneDriver : Procedure; UpdateScreen : Procedure(Force : Boolean); ClearScreen : Procedure; SetVideoMode : Function (Const Mode : TVideoMode) : Boolean; GetVideoModeCount : Function : Word; GetVideoModeData : Function(Index : Word; Var Data : TVideoMode) : Boolean; SetCursorPos : procedure (NewCursorX, NewCursorY: Word); GetCursorType : function : Word; SetCursorType : procedure (NewType: Word); GetCapabilities : Function : Word; end;
ScreenColor : Boolean; CursorX, CursorY : Word;ScreenColor indicates whether the current screen supports colors. CursorX,CursorY contain the current cursor position.
The following variables form the heart of the Video unit: The VideoBuf array represents the physical screen. Writing to this array and calling UpdateScreen will write the actual characters to the screen. VideoBufSize contains the actual screen size, and is equal to the product of the number of columns times the number of lines on the screen (ScreenWidth*ScreenHeight).
VideoBuf : PVideoBuf; OldVideoBuf : PVideoBuf; VideoBufSize : Longint;The OldVideoBuf contains the state of the video screen after the last screen update. The UpdateScreen function uses this array to decide which characters on screen should be updated, and which not.
Note that the OldVideoBuf array may be ignored by some drivers, so it should not be used. The Array is in the interface section of the video unit mainly so drivers that need it can make use of it.
The examples in this section make use of the unit vidutil, which contains the TextOut function. This function writes a text to the screen at a given location. It looks as follows:
unit vidutil; Interface uses video; Procedure TextOut(X,Y : Word;Const S : String); Implementation Procedure TextOut(X,Y : Word;Const S : String); Var W,P,I,M : Word; begin P:=((X-1)+(Y-1)*ScreenWidth); M:=Length(S); If P+M>ScreenWidth*ScreenHeight then M:=ScreenWidth*ScreenHeight-P; For I:=1 to M do VideoBuf^[P+I-1]:=Ord(S[i])+($07 shr 8); end; end.
program testvideo; uses video,keyboard,vidutil; Var i : longint; k : TkeyEvent; begin InitVideo; InitKeyboard; For I:=1 to 10 do TextOut(i,i, 'Press any key to clear screen'); UpdateScreen(false); K:=GetKeyEvent; ClearScreen; TextOut(1,1,'Cleared screen. Press any key to end'); UpdateScreen(true); K:=GetKeyEvent; DoneKeyBoard; DoneVideo; end.
The DoneVideo should always be called if InitVideo was called. Failing to do so may leave the screen in an unusable state after the program exits.
For an example, see most other functions.
Program Example4; { Program to demonstrate the GetCapabilities function. } Uses video; Var W: Word; Procedure TestCap(Cap: Word; Msg : String); begin Write(Msg,' : '); If (W and Cap=Cap) then Writeln('Yes') else Writeln('No'); end; begin W:=GetCapabilities; Writeln('Video driver supports following functionality'); TestCap(cpUnderLine,'Underlined characters'); TestCap(cpBlink,'Blinking characters'); TestCap(cpColor,'Color characters'); TestCap(cpChangeFont,'Changing font'); TestCap(cpChangeMode,'Changing video mode'); TestCap(cpChangeCursor,'Changing cursor shape'); end.
Program Example5; { Program to demonstrate the GetCursorType function. } Uses video,keyboard,vidutil; Const Cursortypes : Array[crHidden..crHalfBlock] of string = ('Hidden','UnderLine','Block','HalfBlock'); begin InitVideo; InitKeyboard; TextOut(1,1,'Cursor type: '+CursorTypes[GetCursorType]); TextOut(1,2,'Press any key to exit.'); UpdateScreen(False); GetKeyEvent; DoneKeyboard; DoneVideo; end.
Program Example6; { Program to demonstrate the GetLockScreenCount function. } Uses video,keyboard,vidutil; Var I : Longint; S : String; begin InitVideo; InitKeyboard; TextOut(1,1,'Press key till new text appears.'); UpdateScreen(False); Randomize; For I:=0 to Random(10)+1 do LockScreenUpdate; I:=0; While GetLockScreenCount<>0 do begin Inc(I); Str(I,S); UnlockScreenUpdate; GetKeyEvent; TextOut(1,1,'UnLockScreenUpdate had to be called '+S+' times'); UpdateScreen(False); end; TextOut(1,2,'Press any key to end.'); UpdateScreen(False); GetKeyEvent; DoneKeyboard; DoneVideo; end.
For an example, see the section on writing a custom video driver.
Program Example7; { Program to demonstrate the GetVideoMode function. } Uses video,keyboard,vidutil; Var M : TVideoMode; S : String; begin InitVideo; InitKeyboard; GetVideoMode(M); if M.Color then TextOut(1,1,'Current mode has color') else TextOut(1,1,'Current mode does not have color'); Str(M.Row,S); TextOut(1,2,'Number of rows : '+S); Str(M.Col,S); TextOut(1,3,'Number of columns : '+S); Textout(1,4,'Press any key to exit.'); UpdateScreen(False); GetKeyEvent; DoneKeyboard; DoneVideo; end.
This function can be used in conjunction with the GetVideoModeData function to retrieve data for the supported video modes.
Program Example8; { Program to demonstrate the GetVideoModeCount function. } Uses video,keyboard,vidutil; Procedure DumpMode (M : TVideoMode; Index : Integer); Var S : String; begin Str(Index:2,S); inc(Index); TextOut(1,Index,'Data for mode '+S+': '); if M.Color then TextOut(19,Index,' color,') else TextOut(19,Index,'No color,'); Str(M.Row:3,S); TextOut(28,Index,S+' rows'); Str(M.Col:3,S); TextOut(36,index,S+' columns'); end; Var i,Count : Integer; m : TVideoMode; begin InitVideo; InitKeyboard; Count:=GetVideoModeCount; For I:=1 to Count do begin GetVideoModeData(I-1,M); DumpMode(M,I-1); end; TextOut(1,Count+1,'Press any key to exit'); UpdateScreen(False); GetKeyEvent; DoneKeyboard; DoneVideo; end.
The function returns True if the mode data was retrieved succesfully, False otherwise.
For an example, see GetVideoModeCount.
For an example, see most other functions.
This function can be used to optimize screen updating: If a lot of writing on the screen needs to be done (by possibly unknown functions), calling LockScreenUpdate before the drawing, and UnlockScreenUpdate after the drawing, followed by a UpdateScreen call, all writing will be shown on screen at once.
For an example, see GetLockScreenCount.
The current position is stored in the CursorX and CursorY variables.
program example2; uses video,keyboard; Var P,PP,D : Integer; K: TKeyEvent; Procedure PutSquare (P : INteger; C : Char); begin VideoBuf^[P]:=Ord(C)+($07 shr 8); VideoBuf^[P+ScreenWidth]:=Ord(c)+($07 shr 8); VideoBuf^[P+1]:=Ord(c)+($07 shr 8); VideoBuf^[P+ScreenWidth+1]:=Ord(c)+($07 shr 8); end; begin InitVideo; InitKeyBoard; P:=0; PP:=-1; Repeat If PP<>-1 then PutSquare(PP,' '); PutSquare(P,'#'); SetCursorPos(P Mod ScreenWidth,P div ScreenWidth); UpdateScreen(False); PP:=P; Repeat D:=0; K:=TranslateKeyEvent(GetKeyEvent); Case GetKeyEventCode(K) of kbdLeft : If (P Mod ScreenWidth)<>0 then D:=-1; kbdUp : If P>=ScreenWidth then D:=-ScreenWidth; kbdRight : If ((P+2) Mod ScreenWidth)<>0 then D:=1; kbdDown : if (P<(VideoBufSize div 2)-(ScreenWidth*2)) then D:=ScreenWidth; end; Until (D<>0) or (GetKeyEventChar(K)='q'); P:=P+D; until GetKeyEventChar(K)='q'; DoneKeyBoard; DoneVideo; end.
A new driver can only be installed if the previous driver was not yet activated (i.e. before a call to InitVideo) or after it was deactivated (i.e after a call to DoneVideo).
For more information about installing a videodriver, see section viddriver.
For an example, see the section on writing a custom video driver.
TVideoMode = record Col,Row : Word; Color : Boolean; end;If the call was succesful, then the screen will have Col columns and Row rows, and will be displaying in color if Color is True.
The function returns True if the mode was set succesfully, False otherwise.
Note that the video mode may not always be set. E.g. a console on Linux or a telnet session cannot always set the mode. It is important to check the error value returned by this function if it was not succesful.
The mode can be set when the video driver has not yet been initialized (i.e. before InitVideo was called) In that case, the video mode will be stored, and after the driver was initialized, an attempt will be made to set the requested mode. Changing the video driver before the call to InitVideo will clear the stored video mode.
To know which modes are valid, use the GetVideoModeCount and GetVideoModeData functions. To retrieve the current video mode, use the GetVideoMode procedure.
It is important to make sure that each call to LockScreenUpdate is matched by exactly one call to UnlockScreenUpdate
For an example, see GetLockScreenCount.
The Video unit keeps an internal copy of the screen as it last wrote it to the screen (in the OldVideoBuf array). The current contents of VideoBuf are examined to see what locations on the screen need to be updated. On slow terminals (e.g. a LINUX telnet session) this mechanism can speed up the screen redraw considerably.
For an example, see most other functions.
TVideoDriver = Record InitDriver : Procedure; DoneDriver : Procedure; UpdateScreen : Procedure(Force : Boolean); ClearScreen : Procedure; SetVideoMode : Function (Const Mode : TVideoMode) : Boolean; GetVideoModeCount : Function : Word; GetVideoModeData : Function(Index : Word; Var Data : TVideoMode) : Boolean; SetCursorPos : procedure (NewCursorX, NewCursorY: Word); GetCursorType : function : Word; SetCursorType : procedure (NewType: Word); GetCapabilities : Function : Word; end;Not all of these functions must be implemented. In fact, the only absolutely necessary function to write a functioning driver is the UpdateScreen function. The general calls in the Video unit will check which functionality is implemented by the driver.
The functionality of these calls is the same as the functionality of the calls in the video unit, so the expected behaviour can be found in the previous section. Some of the calls, however, need some additional remarks.
The following unit shows how to override a video driver, with a driver that writes debug information to a file.
unit viddbg; Interface uses video; Procedure StartVideoLogging; Procedure StopVideoLogging; Function IsVideoLogging : Boolean; Procedure SetVideoLogFileName(FileName : String); Const DetailedVideoLogging : Boolean = False; Implementation uses sysutils,keyboard; var NewVideoDriver, OldVideoDriver : TVideoDriver; Active,Logging : Boolean; LogFileName : String; VideoLog : Text; Function TimeStamp : String; begin TimeStamp:=FormatDateTime('hh:nn:ss',Time()); end; Procedure StartVideoLogging; begin Logging:=True; Writeln(VideoLog,'Start logging video operations at: ',TimeStamp); end; Procedure StopVideoLogging; begin Writeln(VideoLog,'Stop logging video operations at: ',TimeStamp); Logging:=False; end; Function IsVideoLogging : Boolean; begin IsVideoLogging:=Logging; end; Var ColUpd,RowUpd : Array[0..1024] of Integer; Procedure DumpScreenStatistics(Force : Boolean); Var I,Count : Integer; begin If Force then Write(VideoLog,'forced '); Writeln(VideoLog,'video update at ',TimeStamp,' : '); FillChar(Colupd,SizeOf(ColUpd),#0); FillChar(Rowupd,SizeOf(RowUpd),#0); Count:=0; For I:=0 to VideoBufSize div SizeOf(TVideoCell) do begin If VideoBuf^[i]<>OldVideoBuf^[i] then begin Inc(Count); Inc(ColUpd[I mod ScreenWidth]); Inc(RowUpd[I div ScreenHeight]); end; end; Write(VideoLog,Count,' videocells differed divided over '); Count:=0; For I:=0 to ScreenWidth-1 do If ColUpd[I]<>0 then Inc(Count); Write(VideoLog,Count,' columns and '); Count:=0; For I:=0 to ScreenHeight-1 do If RowUpd[I]<>0 then Inc(Count); Writeln(VideoLog,Count,' rows.'); If DetailedVideoLogging Then begin For I:=0 to ScreenWidth-1 do If (ColUpd[I]<>0) then Writeln(VideoLog,'Col ',i,' : ',ColUpd[I]:3,' rows changed'); For I:=0 to ScreenHeight-1 do If (RowUpd[I]<>0) then Writeln(VideoLog,'Row ',i,' : ',RowUpd[I]:3,' colums changed'); end; end; Procedure LogUpdateScreen(Force : Boolean); begin If Logging then DumpScreenStatistics(Force); OldVideoDriver.UpdateScreen(Force); end; Procedure LogInitVideo; begin OldVideoDriver.InitDriver(); Assign(VideoLog,logFileName); Rewrite(VideoLog); Active:=True; StartVideoLogging; end; Procedure LogDoneVideo; begin StopVideoLogging; Close(VideoLog); Active:=False; OldVideoDriver.DoneDriver(); end; Procedure SetVideoLogFileName(FileName : String); begin If Not Active then LogFileName:=FileName; end; Initialization GetVideoDriver(OldVideoDriver); NewVideoDriver:=OldVideoDriver; NewVideoDriver.UpdateScreen:=@LogUpdateScreen; NewVideoDriver.InitDriver:=@LogInitVideo; NewVideoDriver.DoneDriver:=@LogDoneVideo; LogFileName:='Video.log'; Logging:=False; SetVideoDriver(NewVideoDriver); end.
The unit can be used in any of the demonstration programs, by simply
including it in the uses clause. Setting DetailedVideoLogging to
True will create a more detailed log (but will also slow down
functioning)