video.inc 6.8 KB

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