fpusrscr.pas 40 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511
  1. {
  2. This file is part of the Free Pascal Integrated Development Environment
  3. Copyright (c) 1998 by Berczi Gabor
  4. User screen support routines
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. {$i globdir.inc}
  12. unit FPUsrScr;
  13. interface
  14. uses
  15. {$ifdef Windows}
  16. windows,
  17. {$endif Windows}
  18. {$ifdef Unix}
  19. {$ifdef VER1_0}
  20. linux,
  21. {$else}
  22. baseunix,
  23. termio,
  24. {$endif}
  25. {$endif}
  26. video,Objects;
  27. type
  28. PScreen = ^TScreen;
  29. TScreen = object(TObject)
  30. function GetWidth: integer; virtual;
  31. function GetHeight: integer; virtual;
  32. procedure GetLine(Line: integer; var Text, Attr: string); virtual;
  33. procedure GetCursorPos(var P: TPoint); virtual;
  34. { remember the initial video screen }
  35. procedure Capture; virtual;
  36. { restore the initial video mode }
  37. procedure Restore; virtual;
  38. { move up or down if supported by OS }
  39. function Scroll(i : integer) : integer; virtual;
  40. { is moving supported by OS }
  41. function CanScroll : boolean; virtual;
  42. { saves the current IDE screen }
  43. procedure SaveIDEScreen; virtual;
  44. { saves the current console screen }
  45. procedure SaveConsoleScreen; virtual;
  46. { restores the saved console screen }
  47. procedure SwitchToConsoleScreen; virtual;
  48. { restores the saved IDE screen }
  49. procedure SwitchBackToIDEScreen; virtual;
  50. end;
  51. {$IFDEF netwlibc}
  52. PNWLScreen = ^TNWLScreen;
  53. TNWLScreen = object(TScreen)
  54. function GetWidth: integer; virtual;
  55. function GetHeight: integer; virtual;
  56. procedure GetLine(Line: integer; var Text, Attr: string); virtual;
  57. procedure GetCursorPos(var P: TPoint); virtual;
  58. { remember the initial video screen }
  59. procedure Capture; virtual;
  60. { restore the initial video mode }
  61. procedure Restore; virtual;
  62. { saves the current IDE screen }
  63. procedure SaveIDEScreen; virtual;
  64. { saves the current console screen }
  65. procedure SaveConsoleScreen; virtual;
  66. { restores the saved console screen }
  67. procedure SwitchToConsoleScreen; virtual;
  68. { restores the saved IDE screen }
  69. procedure SwitchBackToIDEScreen; virtual;
  70. end;
  71. {$ENDIF}
  72. {$IFDEF OS2}
  73. POS2Screen = ^TOS2Screen;
  74. TOS2Screen = object(TScreen)
  75. constructor Init;
  76. destructor Done; virtual;
  77. public
  78. function GetWidth: integer; virtual;
  79. function GetHeight: integer; virtual;
  80. procedure GetLine(Line: integer; var Text, Attr: string); virtual;
  81. procedure GetCursorPos(var P: TPoint); virtual;
  82. { remember the initial video screen }
  83. procedure Capture; virtual;
  84. { restore the initial video mode }
  85. procedure Restore; virtual;
  86. { move up or down if supported by OS }
  87. function Scroll(i : integer) : integer; virtual;
  88. { saves the current IDE screen }
  89. procedure SaveIDEScreen; virtual;
  90. { saves the current console screen }
  91. procedure SaveConsoleScreen; virtual;
  92. { restores the saved console screen }
  93. procedure SwitchToConsoleScreen; virtual;
  94. { restores the saved IDE screen }
  95. procedure SwitchBackToIDEScreen; virtual;
  96. end;
  97. {$ENDIF}
  98. {$ifdef DOS}
  99. TDOSVideoInfo = record
  100. Mode : word;
  101. ScreenSize: word;
  102. Page : byte;
  103. Rows,Cols : integer;
  104. CurPos : TPoint;
  105. CurShapeT : integer;
  106. CurShapeB : integer;
  107. StateSize : word;
  108. StateBuf : pointer;
  109. end;
  110. PDOSScreen = ^TDOSScreen;
  111. TDOSScreen = object(TScreen)
  112. constructor Init;
  113. destructor Done; virtual;
  114. public
  115. function GetWidth: integer; virtual;
  116. function GetHeight: integer; virtual;
  117. procedure GetLine(Line: integer; var Text, Attr: string); virtual;
  118. procedure GetCursorPos(var P: TPoint); virtual;
  119. procedure Capture; virtual;
  120. procedure Restore; virtual;
  121. procedure SaveIDEScreen; virtual;
  122. procedure SaveConsoleScreen; virtual;
  123. procedure SwitchToConsoleScreen; virtual;
  124. procedure SwitchBackToIDEScreen; virtual;
  125. procedure FreeGraphBuffer;
  126. private
  127. LastTextConsoleVideoInfo,
  128. ConsoleVideoInfo : TDOSVideoInfo;
  129. VBufferSize : longint;
  130. VIDEBufferSize : longint;
  131. VBuffer : PByteArray;
  132. VIDEBuffer : PByteArray;
  133. IDEVideoInfo : TDOSVideoInfo;
  134. ctrl_c_state : boolean;
  135. {$ifdef USE_GRAPH_SWITCH}
  136. GraphImageSize : longint;
  137. GraphDriverName,
  138. GraphModeName : string;
  139. GraphXres,GraphYres : longint;
  140. GraphBuffer : pointer;
  141. ConsoleGraphDriver, ConsoleGraphMode : word;
  142. {$endif USE_GRAPH_SWITCH}
  143. function GetLineStartOfs(Line: integer): word;
  144. procedure GetBuffer(Size: word);
  145. procedure FreeBuffer;
  146. procedure GetVideoMode(var MI: TDOSVideoInfo);
  147. procedure SetVideoMode(MI: TDOSVideoInfo);
  148. end;
  149. {$endif}
  150. {$ifdef Unix}
  151. TConsoleType = (ttyNetwork,ttyLinux,ttyFreeBSD,ttyNetBSD);
  152. PLinuxScreen = ^TLinuxScreen;
  153. TLinuxScreen = object(TScreen)
  154. constructor Init;
  155. destructor Done; virtual;
  156. public
  157. function GetWidth: integer; virtual;
  158. function GetHeight: integer; virtual;
  159. procedure GetLine(Line: integer; var Text, Attr: string); virtual;
  160. procedure GetCursorPos(var P: TPoint); virtual;
  161. procedure Capture; virtual;
  162. procedure Restore; virtual;
  163. procedure SaveIDEScreen; virtual;
  164. procedure SaveConsoleScreen; virtual;
  165. procedure SwitchToConsoleScreen; virtual;
  166. procedure SwitchBackToIDEScreen; virtual;
  167. private
  168. IdeScreen: PByteArray;
  169. IdeSize : longint;
  170. IsXterm : boolean;
  171. Console : TConsoleType;
  172. TTyfd : longint;
  173. ConsVideoBuf : PByteArray;
  174. ConsHeight, ConsWidth,
  175. ConsCursorX, ConsCursorY : byte;
  176. ConsVideoBufSize : longint;
  177. ConsTio : termios;
  178. ConsTioValid : boolean;
  179. end;
  180. {$endif}
  181. {$ifdef Windows}
  182. PWindowsScreen = ^TWindowsScreen;
  183. TWindowsScreen = object(TScreen)
  184. constructor Init;
  185. destructor Done; virtual;
  186. public
  187. function GetWidth: integer; virtual;
  188. function GetHeight: integer; virtual;
  189. procedure GetLine(Line: integer; var Text, Attr: string); virtual;
  190. procedure GetCursorPos(var P: TPoint); virtual;
  191. function CanScroll : boolean; virtual;
  192. function Scroll(i : integer) : integer; virtual;
  193. procedure Capture; virtual;
  194. procedure Restore; virtual;
  195. procedure SaveIDEScreen; virtual;
  196. procedure SaveConsoleScreen; virtual;
  197. procedure SwitchToConsoleScreen; virtual;
  198. procedure SwitchBackToIDEScreen; virtual;
  199. private
  200. DosScreenBufferHandle,
  201. IDEScreenBufferHandle,
  202. StartScreenBufferHandle,
  203. DummyScreenBufferHandle,
  204. NewScreenBufferHandle : THandle;
  205. IDEActive : boolean;
  206. ConsoleMode,IdeMode : Dword;
  207. IdeScreenMode : TVideoMode;
  208. procedure BufferCopy(src,dest : THandle);
  209. end;
  210. {$endif}
  211. procedure InitUserScreen;
  212. procedure DoneUserScreen;
  213. const UserScreen : PScreen = nil;
  214. implementation
  215. uses
  216. Dos,WUtils
  217. (* {$ifdef TP}
  218. {$ifdef DPMI}
  219. ,WinAPI
  220. {$endif}
  221. {$endif}*)
  222. {$ifdef FPC}
  223. {$ifdef GO32V2}
  224. ,Dpmiexcp, Go32
  225. {$endif}
  226. {$endif}
  227. ,Drivers,App
  228. {$ifdef USE_GRAPH_SWITCH}
  229. ,Graph,VESA
  230. {$else not USE_GRAPH_SWITCH}
  231. {$ifdef VESA}
  232. ,VESA
  233. {$endif VESA}
  234. {$endif not USE_GRAPH_SWITCH}
  235. ;
  236. function TScreen.GetWidth: integer;
  237. begin
  238. Getwidth:=0;
  239. Abstract;
  240. end;
  241. function TScreen.GetHeight: integer;
  242. begin
  243. Getheight:=0;
  244. Abstract;
  245. end;
  246. procedure TScreen.GetLine(Line: integer; var Text, Attr: string);
  247. begin
  248. Abstract;
  249. end;
  250. procedure TScreen.GetCursorPos(var P: TPoint);
  251. begin
  252. Abstract;
  253. end;
  254. procedure TScreen.Capture;
  255. begin
  256. Abstract;
  257. end;
  258. procedure TScreen.Restore;
  259. begin
  260. Abstract;
  261. end;
  262. procedure TScreen.SwitchToConsoleScreen;
  263. begin
  264. Abstract;
  265. end;
  266. procedure TScreen.SwitchBackToIDEScreen;
  267. begin
  268. Abstract;
  269. end;
  270. procedure TScreen.SaveIDEScreen;
  271. begin
  272. Abstract;
  273. end;
  274. function TScreen.Scroll(i : integer) : integer;
  275. begin
  276. Scroll:=0;
  277. end;
  278. function TScreen.CanScroll : boolean;
  279. begin
  280. CanScroll:=false;
  281. end;
  282. procedure TScreen.SaveConsoleScreen;
  283. begin
  284. Abstract;
  285. end;
  286. {****************************************************************************
  287. TDOSScreen
  288. ****************************************************************************}
  289. {$ifdef DOS}
  290. constructor TDOSScreen.Init;
  291. begin
  292. inherited Init;
  293. FillChar(LastTextConsoleVideoInfo,Sizeof(TDOSVideoInfo),#0);
  294. Capture;
  295. { get the current ctrl-C state }
  296. Ctrl_c_state:=djgpp_set_ctrl_c(false);
  297. djgpp_set_ctrl_c(Ctrl_c_state);
  298. end;
  299. destructor TDOSScreen.Done;
  300. begin
  301. FreeBuffer;
  302. if assigned(VIDEBuffer) then
  303. FreeMem(VIDEBuffer,VIDEBufferSize);
  304. inherited Done;
  305. end;
  306. function TDOSScreen.GetWidth: integer;
  307. begin
  308. GetWidth:=ConsoleVideoInfo.Cols;
  309. end;
  310. function TDOSScreen.GetHeight: integer;
  311. begin
  312. GetHeight:=ConsoleVideoInfo.Rows;
  313. end;
  314. procedure TDOSScreen.GetLine(Line: integer; var Text, Attr: string);
  315. var
  316. X: integer;
  317. W: word;
  318. begin
  319. Text:=''; Attr:='';
  320. if (Line<GetHeight) and
  321. {$ifdef USE_GRAPH_SWITCH}
  322. not assigned(GraphBuffer) and
  323. {$endif USE_GRAPH_SWITCH}
  324. assigned(VBuffer) then
  325. begin
  326. W:=GetLineStartOfs(Line);
  327. for X:=0 to GetWidth-1 do
  328. begin
  329. {Text:=Text+chr(VBuffer^[W+X*2]);
  330. Attr:=Attr+chr(VBuffer^[W+X*2+1]);}
  331. System.Insert(chr(VBuffer^[W+X*2]),Text,Length(Text)+1);
  332. System.Insert(chr(VBuffer^[W+X*2+1]),Attr,Length(Attr)+1);
  333. end;
  334. {$ifdef USE_GRAPH_SWITCH}
  335. end
  336. else if assigned(GraphBuffer) then
  337. begin
  338. if (Line=0) then
  339. Text:='Console in graph mode, use Alt+F5'
  340. else if (Line=1) then
  341. Text:='Graph driver: '+GraphDriverName
  342. else if (Line=2) then
  343. Text:='Graph mode: '+GraphModeName+' ('+
  344. IntToStr(GraphXres+1)+'x'+IntToStr(GraphYres+1)+')';
  345. Attr:=CharStr(chr($0F),Length(Text));
  346. end;
  347. {$else not USE_GRAPH_SWITCH}
  348. end;
  349. {$endif USE_GRAPH_SWITCH}
  350. end;
  351. procedure TDOSScreen.GetCursorPos(var P: TPoint);
  352. begin
  353. P:=ConsoleVideoInfo.CurPos;
  354. end;
  355. procedure TDOSScreen.Capture;
  356. begin
  357. SaveConsoleScreen;
  358. end;
  359. procedure TDOSScreen.FreeGraphBuffer;
  360. begin
  361. { We don't want to restore the last user screen if
  362. it was a grpahic screen, for example if we
  363. leave in the middle of the debugging of a
  364. graphic program, so we first
  365. dispose the graphic buffer, thus
  366. SwitchToConsoleScreen will restore the
  367. last used text mode }
  368. if LastTextConsoleVideoInfo.Mode<>0 then
  369. begin
  370. ConsoleVideoInfo:=LastTextConsoleVideoInfo;
  371. {$ifdef USE_GRAPH_SWITCH}
  372. if assigned(GraphBuffer) then
  373. begin
  374. FreeMem(GraphBuffer,GraphImageSize);
  375. GraphBuffer:=nil;
  376. GraphImageSize:=0;
  377. end;
  378. {$endif USE_GRAPH_SWITCH}
  379. end;
  380. end;
  381. procedure TDosScreen.Restore;
  382. begin
  383. FreeGraphBuffer;
  384. SwitchToConsoleScreen;
  385. end;
  386. procedure TDosScreen.SaveIDEScreen;
  387. var
  388. VSeg,SOfs: word;
  389. begin
  390. GetVideoMode(IDEVideoInfo);
  391. { First keep a copy of IDE screen }
  392. if ConsoleVideoInfo.Mode=7 then
  393. VSeg:=SegB000
  394. else
  395. VSeg:=SegB800;
  396. SOfs:=MemW[Seg0040:$4e];
  397. if not assigned(VIDEBuffer) or (VIDEBufferSize<>IDEVideoInfo.ScreenSize) then
  398. begin
  399. if assigned(VIDEBuffer) then
  400. FreeMem(VIDEBuffer,VIDEBufferSize);
  401. GetMem(VIDEBuffer,IDEVideoInfo.ScreenSize);
  402. VIDEBufferSize:=IDEVideoInfo.ScreenSize;
  403. end;
  404. {$ifdef FPC}
  405. DosmemGet(VSeg,SOfs,VIDEBuffer^,IDEVideoInfo.ScreenSize);
  406. {$else}
  407. Move(ptr(VSeg,SOfs)^,VIDEBuffer^,IDEVideoInfo.ScreenSize);
  408. {$endif}
  409. end;
  410. procedure TDosScreen.SaveConsoleScreen;
  411. var
  412. VSeg,SOfs: word;
  413. {$ifdef USE_GRAPH_SWITCH}
  414. saved : boolean;
  415. GraphDriver,GraphMode : integer;
  416. {$endif USE_GRAPH_SWITCH}
  417. begin
  418. GetVideoMode(ConsoleVideoInfo);
  419. {$ifdef USE_GRAPH_SWITCH}
  420. saved:=false;
  421. if assigned(GraphBuffer) then
  422. begin
  423. FreeMem(GraphBuffer,GraphImageSize);
  424. GraphBuffer:=nil;
  425. GraphImageSize:=0;
  426. end;
  427. if (ConsoleVideoInfo.Mode>= $100) or
  428. (ConsoleVideoInfo.Mode=$13) or
  429. (ConsoleVideoInfo.Mode=$12) or
  430. (ConsoleVideoInfo.Mode=$10) or
  431. (ConsoleVideoInfo.Mode=$E) then
  432. begin
  433. if VesaSetMode(ConsoleVideoInfo.Mode or $8000) then
  434. begin
  435. Graph.DontClearGraphMemory:=true;
  436. if ConsoleVideoInfo.Mode>=$100 then
  437. begin
  438. GraphDriver:=Graph.Vesa;
  439. GraphMode:=ConsoleVideoInfo.Mode and $fff;
  440. end
  441. else
  442. begin
  443. GraphDriver:=Graph.VGA;
  444. case ConsoleVideoInfo.Mode of
  445. $E : GraphMode:=VGALo;
  446. $10 : GraphMode:=VGAMed;
  447. $12 : GraphMode:=VGAHi;
  448. $13 : begin
  449. GraphDriver:=Graph.LowRes;
  450. GraphMode:=0;
  451. end;
  452. end;
  453. end;
  454. Graph.InitGraph(GraphDriver,GraphMode,'');
  455. if graphresult=grOk then
  456. begin
  457. ConsoleGraphDriver:=GraphDriver;
  458. GraphDriverName:=GetDriverName;
  459. GraphModeName:=GetModeName(GraphMode);
  460. ConsoleGraphMode:=GraphMode;
  461. Graph.DontClearGraphMemory:=false;
  462. GraphXres:=Graph.GetmaxX;
  463. GraphYres:=Graph.GetmaxY;
  464. GraphImageSize:=ImageSize(0,0,GraphXres,GraphYres);
  465. GetMem(GraphBuffer,GraphImageSize);
  466. FillChar(GraphBuffer^,GraphImageSize,#0);
  467. GetImage(0,0,GraphXres,GraphYres,GraphBuffer^);
  468. ConsoleVideoInfo.Rows:=GraphYres div 8;
  469. ConsoleVideoInfo.Cols:=GraphXres div 8;
  470. {FreeBuffer;}
  471. saved:=true;
  472. end
  473. {$ifdef DEBUG}
  474. else
  475. Writeln(stderr,'Error in InitGraph ',Graphdriver, ' ',Graphmode)
  476. {$endif DEBUG}
  477. ;
  478. end;
  479. end;
  480. { mode < $100 so use standard Save code }
  481. if not saved then
  482. {$endif USE_GRAPH_SWITCH}
  483. begin
  484. LastTextConsoleVideoInfo:=ConsoleVideoInfo;
  485. GetBuffer(ConsoleVideoInfo.ScreenSize);
  486. if ConsoleVideoInfo.Mode=7 then
  487. VSeg:=SegB000
  488. else
  489. VSeg:=SegB800;
  490. SOfs:=MemW[Seg0040:$4e];
  491. {$ifdef FPC}
  492. DosmemGet(VSeg,SOfs,VBuffer^,ConsoleVideoInfo.ScreenSize);
  493. {$else}
  494. Move(ptr(VSeg,SOfs)^,VBuffer^,ConsoleVideoInfo.ScreenSize);
  495. {$endif}
  496. end;
  497. end;
  498. procedure TDOSScreen.SwitchToConsoleScreen;
  499. var
  500. VSeg,SOfs: word;
  501. {$ifdef USE_GRAPH_SWITCH}
  502. restored : boolean;
  503. GraphDriver,GraphMode : integer;
  504. {$endif USE_GRAPH_SWITCH}
  505. begin
  506. SetVideoMode(ConsoleVideoInfo);
  507. {$ifdef USE_GRAPH_SWITCH}
  508. restored:=false;
  509. if assigned(GraphBuffer) then
  510. begin
  511. if VesaSetMode(ConsoleVideoInfo.Mode) then
  512. begin
  513. if ConsoleVideoInfo.Mode>=$100 then
  514. begin
  515. GraphDriver:=Graph.Vesa;
  516. GraphMode:=ConsoleVideoInfo.Mode and $fff;
  517. end
  518. else
  519. begin
  520. GraphDriver:=Graph.VGA;
  521. case ConsoleVideoInfo.Mode of
  522. $E : GraphMode:=VGALo;
  523. $10 : GraphMode:=VGAMed;
  524. $12 : GraphMode:=VGAHi;
  525. $13 : begin
  526. GraphDriver:=Graph.LowRes;
  527. GraphMode:=0;
  528. end;
  529. end;
  530. end;
  531. if (ConsoleGraphDriver<>GraphDriver) or
  532. (ConsoleGraphMode<>GraphMode) then
  533. Graph.InitGraph(GraphDriver,GraphMode,'');
  534. if graphresult=grOk then
  535. begin
  536. PutImage(0,0,GraphBuffer^,CopyPut);
  537. FreeMem(GraphBuffer,GraphImageSize);
  538. GraphBuffer:=nil;
  539. GraphImageSize:=0;
  540. restored:=true;
  541. end;
  542. end;
  543. end;
  544. { mode < $100 so use standard Save code }
  545. if not restored then
  546. {$endif USE_GRAPH_SWITCH}
  547. begin
  548. if ConsoleVideoInfo.Mode=7 then
  549. VSeg:=SegB000
  550. else
  551. VSeg:=SegB800;
  552. SOfs:=MemW[Seg0040:$4e];
  553. {$ifdef FPC}
  554. DosmemPut(VSeg,SOfs,VBuffer^,ConsoleVideoInfo.ScreenSize);
  555. djgpp_set_ctrl_c(Ctrl_c_state);
  556. {$else}
  557. Move(VBuffer^,ptr(VSeg,SOfs)^,ConsoleVideoInfo.ScreenSize);
  558. {$endif}
  559. end;
  560. end;
  561. procedure TDOSScreen.SwitchBackToIDEScreen;
  562. var
  563. VSeg,SOfs: word;
  564. begin
  565. SetVideoMode(IDEVideoInfo);
  566. if ConsoleVideoInfo.Mode=7 then
  567. VSeg:=SegB000
  568. else
  569. VSeg:=SegB800;
  570. SOfs:=MemW[Seg0040:$4e];
  571. if assigned(VIDEBuffer) then
  572. {$ifdef FPC}
  573. DosmemPut(VSeg,SOfs,VIDEBuffer^,IDEVideoInfo.ScreenSize);
  574. Ctrl_c_state := djgpp_set_ctrl_c(false);
  575. {$else}
  576. Move(VIDEBuffer^,ptr(VSeg,SOfs)^,IDEVideoInfo.ScreenSize);
  577. {$endif}
  578. { Its difficult to know
  579. the state of the mouse
  580. so simply show it always
  581. fixes bug 2253 PM }
  582. ShowMouse;
  583. end;
  584. function TDOSScreen.GetLineStartOfs(Line: integer): word;
  585. begin
  586. GetLineStartOfs:=(ConsoleVideoInfo.Cols*Line)*2;
  587. end;
  588. procedure TDOSScreen.GetBuffer(Size: word);
  589. begin
  590. if (VBuffer<>nil) and (VBufferSize=Size) then Exit;
  591. if VBuffer<>nil then FreeBuffer;
  592. VBufferSize:=Size;
  593. GetMem(VBuffer,VBufferSize);
  594. end;
  595. procedure TDOSScreen.FreeBuffer;
  596. begin
  597. if (VBuffer<>nil) and (VBufferSize>0) then FreeMem(VBuffer,VBufferSize);
  598. VBuffer:=nil;
  599. end;
  600. procedure TDOSScreen.GetVideoMode(var MI: TDOSVideoInfo);
  601. var
  602. r: registers;
  603. {$ifdef TP}
  604. P: pointer;
  605. Sel: longint;
  606. (* {$I realintr.inc} *)
  607. {$endif}
  608. begin
  609. if (MI.StateSize>0) and (MI.StateBuf<>nil) then
  610. begin FreeMem(MI.StateBuf,MI.StateSize); MI.StateBuf:=nil; end;
  611. MI.ScreenSize:=MemW[Seg0040:$4c];
  612. r.ah:=$0f;
  613. intr($10,r);
  614. MI.Mode:=r.al;
  615. MI.Page:=r.bh;
  616. MI.Cols:=r.ah;
  617. {$ifdef VESA}
  618. VESAGetMode(MI.Mode);
  619. MI.Mode:=MI.Mode and $fff;
  620. {$endif}
  621. MI.Rows:=MI.ScreenSize div (MI.Cols*2);
  622. if MI.Rows=51 then MI.Rows:=50;
  623. r.ah:=$03;
  624. r.bh:=MI.Page;
  625. intr($10,r);
  626. with MI do
  627. begin
  628. CurPos.X:=r.dl; CurPos.Y:=r.dh;
  629. CurShapeT:=r.ch; CurShapeB:=r.cl;
  630. end;
  631. (*
  632. {$ifdef TP}
  633. { check VGA functions }
  634. MI.StateSize:=0;
  635. r.ah:=$1c; r.al:=0; r.cx:=7; intr($10,r);
  636. if (r.al=$1c) and ((r.flags and fCarry)=0) and (r.bx>0) then
  637. begin
  638. MI.StateSize:=r.bx;
  639. GetMem(MI.StateBuf,MI.StateSize); FillChar(MI.StateBuf^,MI.StateSize,0);
  640. P:=MI.StateBuf;
  641. {$ifdef DPMI}
  642. Sel:=GlobalDosAlloc(MI.StateSize);
  643. P:=Ptr(Sel shr 16,0);
  644. {$endif}
  645. r.ah:=$1c; r.al:=1; r.cx:=7;
  646. r.es:=PtrRec(P).Seg; r.bx:=PtrRec(P).Ofs;
  647. {$ifdef DPMI}realintr($10,r);{$else}intr($10,r);{$endif}
  648. {$ifdef DPMI}
  649. Move(Ptr(Sel and $ffff,0)^,MI.StateBuf^,MI.StateSize);
  650. GlobalDosFree(Sel and $ffff);
  651. {$endif}
  652. end;
  653. {$endif}
  654. *)
  655. end;
  656. procedure TDOSScreen.SetVideoMode(MI: TDOSVideoInfo);
  657. var r: registers;
  658. CM: TDOSVideoInfo;
  659. {$ifdef TP}
  660. P: pointer;
  661. Sel: longint;
  662. {$I realintr.inc}
  663. {$endif}
  664. begin
  665. FillChar(CM,sizeof(CM),0);
  666. GetVideoMode(CM);
  667. if (CM.Mode<>MI.Mode) or (CM.Cols<>MI.Cols) or (CM.Rows<>MI.Rows) then
  668. begin
  669. {$ifdef VESA}
  670. if MI.Mode>=$100 then
  671. VESASetMode(MI.Mode)
  672. else
  673. {$endif}
  674. begin
  675. r.ah:=$00; r.al:=MI.Mode; intr($10,r);
  676. end;
  677. if (MI.Mode=3) and (MI.Cols=80) and (MI.Rows=50) then
  678. begin
  679. r.ax:=$1112; r.bx:=$0;
  680. intr($10,r);
  681. end;
  682. end;
  683. r.ah:=$05; r.al:=MI.Page; intr($10,r);
  684. r.ah:=$02; r.bh:=MI.Page; r.dl:=MI.CurPos.X; r.dh:=MI.CurPos.Y; intr($10,r);
  685. r.ah:=$01; r.ch:=MI.CurShapeT; r.cl:=MI.CurShapeB; intr($10,r);
  686. (*
  687. {$ifdef TP}
  688. if (MI.StateSize>0) and (MI.StateBuf<>nil) then
  689. begin
  690. P:=MI.StateBuf;
  691. {$ifdef DPMI}
  692. Sel:=GlobalDosAlloc(MI.StateSize);
  693. Move(MI.StateBuf^,ptr(Sel and $ffff,0)^,MI.StateSize);
  694. P:=Ptr(Sel shr 16,0);
  695. {$endif}
  696. r.ah:=$1c; r.al:=2; r.cx:=7;
  697. r.es:=PtrRec(P).Seg; r.bx:=PtrRec(P).Ofs;
  698. {$ifdef DPMI}realintr($10,r);{$else}intr($10,r);{$endif}
  699. {$ifdef DPMI}
  700. GlobalDosFree(Sel and $ffff);
  701. {$endif}
  702. end;
  703. {$endif}
  704. *)
  705. end;
  706. {$endif}
  707. {****************************************************************************
  708. TLinuxScreen
  709. ****************************************************************************}
  710. {$ifdef Unix}
  711. constructor TLinuxScreen.Init;
  712. var
  713. ThisTTY: string[30];
  714. FName: string;
  715. WS: packed record
  716. ws_row, ws_col, ws_xpixel, ws_ypixel: Word;
  717. end;
  718. begin
  719. inherited Init;
  720. IdeScreen := nil;
  721. TTYFd:=-1;
  722. IsXterm:=getenv('TERM')='xterm';
  723. ThisTTY:=TTYName(stdinputhandle);
  724. if Not IsXterm and {$ifdef ver1_0}IsATTY(stdinputhandle){$else}(IsATTY(stdinputhandle)<>-1){$endif} then
  725. begin
  726. Console:=TTyNetwork; {Default: Network or other vtxxx tty}
  727. if (Copy(ThisTTY, 1, 8) = '/dev/tty') and (ThisTTY[9]<>'p') Then
  728. begin
  729. Case ThisTTY[9] of
  730. '0'..'9' :
  731. begin { running Linux on native console or native-emulation }
  732. FName:='/dev/vcsa' + ThisTTY[9];
  733. {$ifdef ver1_0}
  734. TTYFd:=fdOpen(FName, &666, Open_RdWr); { open console }
  735. {$else}
  736. TTYFd:=fpOpen(FName, &666, O_RdWr); { open console }
  737. {$endif}
  738. If TTYFd <>-1 Then
  739. Console:=ttyLinux;
  740. end;
  741. 'v' : { check for (Free?)BSD native}
  742. If (ThisTTY[10]>='0') and (ThisTTY[10]<='9') Then
  743. Console:=ttyFreeBSD; {TTYFd ?}
  744. end;
  745. end;
  746. If Copy(GetEnv('TERM'),1,6)='cons25' Then
  747. Console:=ttyFreeBSD;
  748. {$ifdef ver1_0}ioctl{$else}fpioctl{$endif}(stdinputhandle, TIOCGWINSZ, @WS);
  749. if WS.ws_Col=0 then
  750. WS.ws_Col:=80;
  751. if WS.ws_Row=0 then
  752. WS.ws_Row:=25;
  753. ConsWidth:=WS.ws_Col;
  754. ConsHeight:=WS.ws_row;
  755. end;
  756. Capture;
  757. end;
  758. destructor TLinuxScreen.Done;
  759. begin
  760. if assigned(IdeScreen) then
  761. freemem(IdeScreen,IdeSize);
  762. if assigned(ConsVideoBuf) then
  763. freemem(ConsVideoBuf,ConsVideoBufSize);
  764. inherited Done;
  765. end;
  766. function TLinuxScreen.GetWidth: integer;
  767. begin
  768. GetWidth:=ConsWidth;
  769. end;
  770. function TLinuxScreen.GetHeight: integer;
  771. begin
  772. GetHeight:=ConsHeight;
  773. end;
  774. procedure TLinuxScreen.GetLine(Line: integer; var Text, Attr: string);
  775. var
  776. X, W : longint;
  777. begin
  778. Text:='';
  779. Attr:='';
  780. if (TtyFd<>-1) and assigned(ConsVideoBuf) then
  781. begin
  782. if Line<GetHeight then
  783. begin
  784. W:=(ConsWidth*Line)*Sizeof(word);
  785. for X:=0 to GetWidth-1 do
  786. begin
  787. {Text:=Text+chr(VBuffer^[W+X*2]);
  788. Attr:=Attr+chr(VBuffer^[W+X*2+1]);}
  789. System.Insert(chr(ConsVideoBuf^[W+X*2]),Text,Length(Text)+1);
  790. System.Insert(chr(ConsVideoBuf^[W+X*2+1]),Attr,Length(Attr)+1);
  791. end;
  792. end;
  793. end;
  794. end;
  795. procedure TLinuxScreen.GetCursorPos(var P: TPoint);
  796. begin
  797. P.X:=ConsCursorX+1;
  798. P.Y:=ConsCursorY+1;
  799. end;
  800. procedure TLinuxScreen.Capture;
  801. begin
  802. SaveConsoleScreen;
  803. end;
  804. procedure TLinuxScreen.Restore;
  805. begin
  806. SwitchToConsoleScreen;
  807. end;
  808. procedure TLinuxScreen.SaveIDEScreen;
  809. begin
  810. if assigned(IdeScreen) then
  811. freemem(IdeScreen,IdeSize);
  812. getmem(IdeScreen,videobufsize);
  813. IdeSize:=videobufsize;
  814. move(videobuf^,IdeScreen^,videobufsize);
  815. end;
  816. procedure TLinuxScreen.SaveConsoleScreen;
  817. var
  818. NewSize : longint;
  819. begin
  820. if IsXTerm then
  821. write(#27'7'#27'[?47h')
  822. else if (TTYfd<>-1) then
  823. begin
  824. {$ifdef ver1_0}fdSeek{$else}fpLSeek{$endif}(TTYFd, 0, Seek_Set);
  825. {$ifdef ver1_0}fdread{$else}fpread{$endif}(TTYFd,ConsHeight,sizeof(byte));
  826. {$ifdef ver1_0}fdread{$else}fpread{$endif}(TTYFd,ConsWidth,sizeof(byte));
  827. {$ifdef ver1_0}fdread{$else}fpread{$endif}(TTYFd,ConsCursorX,sizeof(byte));
  828. {$ifdef ver1_0}fdread{$else}fpread{$endif}(TTYFd,ConsCursorY,sizeof(byte));
  829. NewSize:=ConsWidth*ConsHeight*sizeof(word);
  830. if (NewSize<>ConsVideoBufSize) and
  831. assigned(ConsVideoBuf) then
  832. Begin
  833. FreeMem(ConsVideoBuf,ConsVideoBufSize);
  834. ConsVideoBuf:=nil;
  835. End;
  836. If not assigned(ConsVideoBuf) then
  837. GetMem(ConsVideoBuf,NewSize);
  838. ConsVideoBufSize:=NewSize;
  839. {$ifdef ver1_0}fdread{$else}fpread{$endif}(TTYFd,ConsVideoBuf^,ConsVideoBufSize);
  840. end
  841. else
  842. begin
  843. ConsWidth:=80;
  844. ConsHeight:=25;
  845. ConsCursorX:=0;
  846. ConsCursorY:=0;
  847. ConsVideoBuf:=nil;
  848. end;
  849. {$ifdef ver1_0}
  850. ConsTioValid:=TCGetAttr(1,ConsTio);
  851. {$else}
  852. ConsTioValid:=(TCGetAttr(1,ConsTio)<>-1);
  853. {$endif}
  854. end;
  855. procedure TLinuxScreen.SwitchToConsoleScreen;
  856. begin
  857. if IsXterm then
  858. begin
  859. write(#27'[0m');
  860. write(#27'[?47l'#27'8'#27'[m');
  861. end
  862. else if (TTyfd<>-1) then
  863. begin
  864. {$ifdef ver1_0}fdSeek{$else}fplSeek{$endif}(TTYFd, 2, Seek_Set);
  865. {$ifdef ver1_0}fdwrite{$else}fpwrite{$endif}(TTYFd, ConsCursorX, sizeof(byte));
  866. {$ifdef ver1_0}fdwrite{$else}fpwrite{$endif}(TTYFd, ConsCursorY, sizeof(byte));
  867. {$ifdef ver1_0}fdwrite{$else}fpwrite{$endif}(TTYFd, ConsVideoBuf^,ConsVideoBufSize);
  868. { FreeMem(ConsVideoBuf,ConsVideoBufSize);
  869. ConsVideoBuf:=nil; }
  870. end;
  871. If ConsTioValid then
  872. TCSetAttr(1,TCSANOW,ConsTio);
  873. end;
  874. procedure TLinuxScreen.SwitchBackToIDEScreen;
  875. begin
  876. if IdeScreen = nil then
  877. exit;
  878. move(IdeScreen^,videobuf^,videobufsize);
  879. freemem(IdeScreen,IdeSize);
  880. IdeScreen := nil;
  881. end;
  882. {$endif}
  883. {****************************************************************************
  884. TWindowsScreen
  885. ****************************************************************************}
  886. {$ifdef Windows}
  887. procedure UpdateFileHandles;
  888. begin
  889. {StdInputHandle:=longint(GetStdHandle(STD_INPUT_HANDLE));}
  890. StdOutputHandle:=longint(GetStdHandle(cardinal(STD_OUTPUT_HANDLE)));
  891. {StdErrorHandle:=longint(GetStdHandle(STD_ERROR_HANDLE));}
  892. TextRec(Output).Handle:=StdOutputHandle;
  893. TextRec(StdOut).Handle:=StdOutputHandle;
  894. {TextRec(StdErr).Handle:=StdErrorHandle;}
  895. end;
  896. constructor TWindowsScreen.Init;
  897. var
  898. SecurityAttr : Security_attributes;
  899. BigWin : Coord;
  900. res : longbool;
  901. Error : dword;
  902. ConsoleScreenBufferInfo : Console_screen_buffer_info;
  903. begin
  904. inherited Init;
  905. {if GetConsoleOutputCP<>437 then
  906. res:=SetConsoleOutputCP(437);}
  907. SecurityAttr.nLength:=SizeOf(Security_attributes);
  908. SecurityAttr.lpSecurityDescriptor:=nil;
  909. SecurityAttr.bInheritHandle:=true;
  910. NewScreenBufferHandle:=CreateConsoleScreenBuffer(
  911. GENERIC_READ or GENERIC_WRITE,
  912. FILE_SHARE_READ or FILE_SHARE_WRITE,SecurityAttr,
  913. CONSOLE_TEXTMODE_BUFFER,nil);
  914. DummyScreenBufferHandle:=CreateConsoleScreenBuffer(
  915. GENERIC_READ or GENERIC_WRITE,
  916. FILE_SHARE_READ or FILE_SHARE_WRITE,SecurityAttr,
  917. CONSOLE_TEXTMODE_BUFFER,nil);
  918. StartScreenBufferHandle:=GetStdHandle(cardinal(STD_OUTPUT_HANDLE));
  919. GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @ConsoleMode);
  920. IdeMode:=ConsoleMode;
  921. {$ifdef debug}
  922. {define Windowsbigwin}
  923. {$endif debug}
  924. {$ifdef Windowsbigwin}
  925. GetConsoleScreenBufferInfo(StartScreenBufferHandle,
  926. @ConsoleScreenBufferInfo);
  927. BigWin.X:=ConsoleScreenBufferInfo.dwSize.X;
  928. BigWin.Y:=200;
  929. { Try to allow to store more info }
  930. res:=SetConsoleScreenBufferSize(NewScreenBufferHandle,BigWin);
  931. if not res then
  932. error:=GetLastError;
  933. res:=SetConsoleScreenBufferSize(StartScreenBufferHandle,BigWin);
  934. if not res then
  935. error:=GetLastError;
  936. {$endif Windowsbigwin}
  937. GetConsoleScreenBufferInfo(StartScreenBufferHandle,
  938. @ConsoleScreenBufferInfo);
  939. { make sure that the IDE Screen Handle has the maximum display size
  940. this removes the scroll bars if it is maximized }
  941. res:=SetConsoleScreenBufferSize(NewScreenBufferHandle,
  942. ConsoleScreenBufferInfo.dwMaximumWindowSize);
  943. if not res then
  944. error:=GetLastError;
  945. IDEScreenBufferHandle:=NewScreenBufferHandle;
  946. DosScreenBufferHandle:=StartScreenBufferHandle;
  947. Capture;
  948. IdeScreenMode.row:=0;
  949. SwitchBackToIDEScreen;
  950. end;
  951. destructor TWindowsScreen.Done;
  952. begin
  953. { copy the Dos buffer content into the original ScreenBuffer
  954. which remains the startup std_output_handle PM }
  955. {if StartScreenBufferHandle=IDEScreenBufferHandle then}
  956. BufferCopy(DosScreenBufferHandle,IDEScreenBufferHandle);
  957. SetConsoleActiveScreenBuffer(StartScreenBufferHandle);
  958. SetStdHandle(cardinal(Std_Output_Handle),StartScreenBufferHandle);
  959. UpdateFileHandles;
  960. CloseHandle(NewScreenBufferHandle);
  961. CloseHandle(DummyScreenBufferHandle);
  962. inherited Done;
  963. end;
  964. function TWindowsScreen.GetWidth: integer;
  965. var
  966. ConsoleScreenBufferInfo : Console_screen_buffer_info;
  967. begin
  968. GetConsoleScreenBufferInfo(DosScreenBufferHandle,
  969. @ConsoleScreenBufferInfo);
  970. GetWidth:=ConsoleScreenBufferInfo.dwSize.X;
  971. end;
  972. function TWindowsScreen.GetHeight: integer;
  973. var
  974. ConsoleScreenBufferInfo : Console_screen_buffer_info;
  975. begin
  976. GetConsoleScreenBufferInfo(DosScreenBufferHandle,
  977. @ConsoleScreenBufferInfo);
  978. GetHeight:=ConsoleScreenBufferInfo.dwSize.Y;
  979. end;
  980. function TWindowsScreen.CanScroll : boolean;
  981. var
  982. ConsoleScreenBufferInfo : Console_screen_buffer_info;
  983. BufferLines : longint;
  984. WindowLines : longint;
  985. begin
  986. GetConsoleScreenBufferInfo(DosScreenBufferHandle,
  987. @ConsoleScreenBufferInfo);
  988. WindowLines:=ConsoleScreenBufferInfo.srWindow.Bottom-
  989. ConsoleScreenBufferInfo.srWindow.Top;
  990. BufferLines:= ConsoleScreenBufferInfo.dwSize.Y-1;
  991. CanScroll:=(BufferLines>WindowLines);
  992. end;
  993. function TWindowsScreen.Scroll(i : integer) : integer;
  994. var
  995. ConsoleScreenBufferInfo : Console_screen_buffer_info;
  996. ConsoleWindow : Small_rect;
  997. begin
  998. GetConsoleScreenBufferInfo(DosScreenBufferHandle,
  999. @ConsoleScreenBufferInfo);
  1000. if (ConsoleScreenBufferInfo.srWindow.Top + i < 0) then
  1001. i:= -ConsoleScreenBufferInfo.srWindow.Top;
  1002. if (ConsoleScreenBufferInfo.srWindow.Bottom + i > ConsoleScreenBufferInfo.dwSize.Y) then
  1003. i:= ConsoleScreenBufferInfo.dwSize.Y - ConsoleScreenBufferInfo.srWindow.Bottom;
  1004. if i<>0 then
  1005. begin
  1006. ConsoleWindow.Left:=ConsoleScreenBufferInfo.srWindow.Left;
  1007. ConsoleWindow.Right:=ConsoleScreenBufferInfo.srWindow.Right;
  1008. ConsoleWindow.Top:=ConsoleScreenBufferInfo.srWindow.Top+i;
  1009. ConsoleWindow.Bottom:=ConsoleScreenBufferInfo.srWindow.Bottom+i;
  1010. SetConsoleWindowInfo(DosScreenBufferHandle,true,ConsoleWindow);
  1011. Scroll:=i;
  1012. end
  1013. else
  1014. Scroll:=0;
  1015. end;
  1016. procedure TWindowsScreen.GetLine(Line: integer; var Text, Attr: string);
  1017. type
  1018. CharInfoArray = Array [0..255] of Char_Info;
  1019. var
  1020. LineBuf : ^CharInfoArray;
  1021. BufSize,BufCoord : Coord;
  1022. i,LineSize : longint;
  1023. WriteRegion : SMALL_RECT;
  1024. begin
  1025. GetMem(LineBuf,SizeOf(CharInfoArray));
  1026. LineSize:=ScreenWidth;
  1027. If LineSize>256 then
  1028. LineSize:=256;
  1029. BufSize.X:=LineSize;
  1030. BufSize.Y:=1;
  1031. BufCoord.X:=0;
  1032. BufCoord.Y:=0;
  1033. with WriteRegion do
  1034. begin
  1035. Top :=Line;
  1036. Left :=0;
  1037. Bottom := Line+1;
  1038. Right := LineSize-1;
  1039. end;
  1040. ReadConsoleOutput(DosScreenBufferHandle, PChar_info(LineBuf),
  1041. BufSize, BufCoord, @WriteRegion);
  1042. for i:=1 to LineSize do
  1043. begin
  1044. Text[i]:=LineBuf^[i-1].AsciiChar;
  1045. Attr[i]:=char(byte(LineBuf^[i-1].Attributes));
  1046. end;
  1047. FreeMem(LineBuf,SizeOf(CharInfoArray));
  1048. Text[0]:=char(byte(LineSize));
  1049. Attr[0]:=char(byte(LineSize));
  1050. end;
  1051. procedure TWindowsScreen.GetCursorPos(var P: TPoint);
  1052. var
  1053. ConsoleScreenBufferInfo : Console_screen_buffer_info;
  1054. begin
  1055. GetConsoleScreenBufferInfo(DosScreenBufferHandle,
  1056. @ConsoleScreenBufferInfo);
  1057. P.X:=ConsoleScreenBufferInfo.dwCursorPosition.X;
  1058. P.Y:=ConsoleScreenBufferInfo.dwCursorPosition.Y;
  1059. end;
  1060. procedure TWindowsScreen.BufferCopy(Src, Dest : THandle);
  1061. type
  1062. CharInfoArray = Array [0..256*255-1] of Char_Info;
  1063. var
  1064. LineBuf : ^CharInfoArray;
  1065. BufSize,BufCoord : Coord;
  1066. Error, LineSize,
  1067. Part, OnePartY: longint;
  1068. res : boolean;
  1069. WriteRegion : SMALL_RECT;
  1070. ConsoleScreenBufferInfo : Console_screen_buffer_info;
  1071. DestConsoleScreenBufferInfo : Console_screen_buffer_info;
  1072. begin
  1073. GetConsoleScreenBufferInfo(Src,
  1074. @ConsoleScreenBufferInfo);
  1075. GetConsoleScreenBufferInfo(Dest,
  1076. @DestConsoleScreenBufferInfo);
  1077. GetMem(LineBuf,SizeOf(CharInfoArray));
  1078. FillChar(LineBuf^,SizeOf(CharInfoArray),#0);
  1079. LineSize:=ConsoleScreenBufferInfo.dwSize.X;
  1080. If LineSize>256 then
  1081. LineSize:=256;
  1082. BufSize.X:=LineSize;
  1083. BufSize.Y:=ConsoleScreenBufferInfo.dwSize.Y;
  1084. BufCoord.X:=0;
  1085. BufCoord.Y:=0;
  1086. with WriteRegion do
  1087. begin
  1088. Top :=0;
  1089. Left :=0;
  1090. Bottom := ConsoleScreenBufferInfo.dwSize.Y-1;
  1091. Right := LineSize-1;
  1092. end;
  1093. if BufSize.X*BufSize.Y*Sizeof(CHAR_INFO) >= $8000 then
  1094. begin
  1095. OnePartY := ($8000 -1) div (BufSize.X * SizeOf(Char_Info) );
  1096. BufSize.Y:=OnePartY;
  1097. Part:=0;
  1098. while ((Part+1)*OnePartY < ConsoleScreenBufferInfo.dwSize.Y) do
  1099. begin
  1100. WriteRegion.Top := Part*OnePartY;
  1101. WriteRegion.Bottom := (Part+1)*OnePartY-1;
  1102. res:=ReadConsoleOutput(Src, PChar_info(LineBuf),
  1103. BufSize, BufCoord, @WriteRegion);
  1104. if not res then
  1105. Error:=GetLastError;
  1106. res:=WriteConsoleOutput(Dest, PChar_info(LineBuf),
  1107. BufSize, BufCoord, @WriteRegion);
  1108. if not res then
  1109. Error:=GetLastError;
  1110. Inc(Part);
  1111. end;
  1112. BufSize.Y:=ConsoleScreenBufferInfo.dwSize.Y - Part*OnePartY;
  1113. WriteRegion.Top := Part*OnePartY;
  1114. WriteRegion.Bottom := ConsoleScreenBufferInfo.dwSize.Y-1;
  1115. res:=ReadConsoleOutput(Src, PChar_info(LineBuf),
  1116. BufSize, BufCoord, @WriteRegion);
  1117. if not res then
  1118. Error:=GetLastError;
  1119. res:=WriteConsoleOutput(Dest, PChar_info(LineBuf),
  1120. BufSize, BufCoord, @WriteRegion);
  1121. if not res then
  1122. Error:=GetLastError;
  1123. end
  1124. else
  1125. begin
  1126. res:=ReadConsoleOutput(Src, PChar_info(LineBuf),
  1127. BufSize, BufCoord, @WriteRegion);
  1128. if not res then
  1129. Error:=GetLastError;
  1130. res:=WriteConsoleOutput(Dest, PChar_info(LineBuf),
  1131. BufSize, BufCoord, @WriteRegion);
  1132. if not res then
  1133. Error:=GetLastError;
  1134. end;
  1135. FreeMem(LineBuf,SizeOf(CharInfoArray));
  1136. SetConsoleCursorPosition(Dest, ConsoleScreenBufferInfo.dwCursorPosition);
  1137. end;
  1138. procedure TWindowsScreen.Capture;
  1139. begin
  1140. {if StartScreenBufferHandle=IdeScreenBufferHandle then
  1141. BufferCopy(IDEScreenBufferHandle,DosScreenBufferHandle)
  1142. else
  1143. BufferCopy(DosScreenBufferHandle,IDEScreenBufferHandle);}
  1144. SaveConsoleScreen;
  1145. end;
  1146. procedure TWindowsScreen.Restore;
  1147. begin
  1148. SwitchToConsoleScreen;
  1149. end;
  1150. { dummy for Windows as the Buffer screen
  1151. do hold all the info }
  1152. procedure TWindowsScreen.SaveIDEScreen;
  1153. begin
  1154. IdeScreenMode:=ScreenMode;
  1155. GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @IdeMode);
  1156. { set the dummy buffer as active already now PM }
  1157. SetStdHandle(cardinal(Std_Output_Handle),DummyScreenBufferHandle);
  1158. UpdateFileHandles;
  1159. end;
  1160. { dummy for Windows as the Buffer screen
  1161. do hold all the info }
  1162. procedure TWindowsScreen.SaveConsoleScreen;
  1163. begin
  1164. GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @ConsoleMode);
  1165. { set the dummy buffer as active already now PM }
  1166. SetStdHandle(cardinal(Std_Output_Handle),DummyScreenBufferHandle);
  1167. UpdateFileHandles;
  1168. end;
  1169. procedure TWindowsScreen.SwitchToConsoleScreen;
  1170. begin
  1171. SetConsoleActiveScreenBuffer(DosScreenBufferHandle);
  1172. SetStdHandle(cardinal(Std_Output_Handle),DosScreenBufferHandle);
  1173. SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), ConsoleMode);
  1174. UpdateFileHandles;
  1175. IDEActive:=false;
  1176. end;
  1177. procedure TWindowsScreen.SwitchBackToIDEScreen;
  1178. var
  1179. ConsoleScreenBufferInfo : Console_screen_buffer_info;
  1180. WindowPos : Small_rect;
  1181. res : boolean;
  1182. error : longint;
  1183. begin
  1184. SetStdHandle(cardinal(Std_Output_Handle),IDEScreenBufferHandle);
  1185. UpdateFileHandles;
  1186. GetConsoleScreenBufferInfo(IDEScreenBufferHandle,
  1187. @ConsoleScreenBufferInfo);
  1188. SetConsoleActiveScreenBuffer(IDEScreenBufferHandle);
  1189. { Needed to force InitSystemMsg to use the right console handle }
  1190. DoneEvents;
  1191. InitEvents;
  1192. IdeMode:=(IdeMode or ENABLE_MOUSE_INPUT or ENABLE_WINDOW_INPUT) and not ENABLE_PROCESSED_INPUT;
  1193. SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), IdeMode);
  1194. WindowPos.left:=0;
  1195. WindowPos.right:=ConsoleScreenBufferInfo.srWindow.right
  1196. -ConsoleScreenBufferInfo.srWindow.left;
  1197. WindowPos.top:=0;
  1198. WindowPos.bottom:=ConsoleScreenBufferInfo.srWindow.bottom
  1199. -ConsoleScreenBufferInfo.srWindow.top;
  1200. with ConsoleScreenBufferInfo.dwMaximumWindowSize do
  1201. begin
  1202. if WindowPos.Right<X-1 then
  1203. WindowPos.right:=X-1;
  1204. if WindowPos.Bottom<Y-1 then
  1205. WindowPos.Bottom:=Y-1;
  1206. end;
  1207. res:=SetConsoleWindowInfo(IDEScreenBufferHandle,true,WindowPos);
  1208. if not res then
  1209. error:=GetLastError;
  1210. {$ifdef DEBUG}
  1211. IdeScreenMode.row:=WindowPos.bottom+1;
  1212. IdeScreenMode.col:=WindowPos.right+1;
  1213. {$endif DEBUG}
  1214. { needed to force the correct size for videobuf }
  1215. if Assigned(Application) and (IdeScreenMode.row<>0)then
  1216. Application^.SetScreenVideoMode(IdeScreenMode);
  1217. IDEActive:=true;
  1218. end;
  1219. {$endif}
  1220. {****************************************************************************
  1221. TOS2Screen
  1222. ****************************************************************************}
  1223. {$ifdef OS2}
  1224. function TOS2Screen.GetWidth: integer;
  1225. begin
  1226. GetWidth:=80;
  1227. end;
  1228. function TOS2Screen.GetHeight: integer;
  1229. begin
  1230. GetHeight:=25;
  1231. end;
  1232. procedure TOS2Screen.GetLine(Line: integer; var Text, Attr: string);
  1233. begin
  1234. Text:=' ';
  1235. Attr:=' ';
  1236. end;
  1237. procedure TOS2Screen.GetCursorPos(var P: TPoint);
  1238. begin
  1239. P.X:=1;
  1240. P.Y:=1;
  1241. end;
  1242. { remember the initial video screen }
  1243. procedure TOS2Screen.Capture;
  1244. begin
  1245. end;
  1246. { restore the initial video mode }
  1247. procedure TOS2Screen.Restore;
  1248. begin
  1249. end;
  1250. { move up or down if supported by OS }
  1251. function TOS2Screen.Scroll(i : integer) : integer;
  1252. begin
  1253. end;
  1254. { saves the current IDE screen }
  1255. procedure TOS2Screen.SaveIDEScreen;
  1256. begin
  1257. end;
  1258. { saves the current console screen }
  1259. procedure TOS2Screen.SaveConsoleScreen;
  1260. begin
  1261. end;
  1262. { restores the saved console screen }
  1263. procedure TOS2Screen.SwitchToConsoleScreen;
  1264. begin
  1265. end;
  1266. { restores the saved IDE screen }
  1267. procedure TOS2Screen.SwitchBackToIDEScreen;
  1268. begin
  1269. end;
  1270. constructor TOS2Screen.Init;
  1271. begin
  1272. end;
  1273. destructor TOS2Screen.Done;
  1274. begin
  1275. end;
  1276. {$ENDIF}
  1277. {****************************************************************************
  1278. TNWLScreen
  1279. ****************************************************************************}
  1280. {$ifdef netwlibc}
  1281. function TNWLScreen.GetWidth: integer;
  1282. begin
  1283. GetWidth:=80;
  1284. end;
  1285. function TNWLScreen.GetHeight: integer;
  1286. begin
  1287. GetHeight:=25;
  1288. end;
  1289. procedure TNWLScreen.GetLine(Line: integer; var Text, Attr: string);
  1290. begin
  1291. Text:=' ';
  1292. Attr:=' ';
  1293. end;
  1294. procedure TNWLScreen.GetCursorPos(var P: TPoint);
  1295. begin
  1296. P.X:=1;
  1297. P.Y:=1;
  1298. end;
  1299. { remember the initial video screen }
  1300. procedure TNWLScreen.Capture;
  1301. begin
  1302. end;
  1303. { restore the initial video mode }
  1304. procedure TNWLScreen.Restore;
  1305. begin
  1306. end;
  1307. { saves the current IDE screen }
  1308. procedure TNWLScreen.SaveIDEScreen;
  1309. begin
  1310. end;
  1311. { saves the current console screen }
  1312. procedure TNWLScreen.SaveConsoleScreen;
  1313. begin
  1314. end;
  1315. { restores the saved console screen }
  1316. procedure TNWLScreen.SwitchToConsoleScreen;
  1317. begin
  1318. end;
  1319. { restores the saved IDE screen }
  1320. procedure TNWLScreen.SwitchBackToIDEScreen;
  1321. begin
  1322. end;
  1323. {$ENDIF}
  1324. {****************************************************************************
  1325. Initialize
  1326. ****************************************************************************}
  1327. procedure InitUserScreen;
  1328. begin
  1329. {$ifdef DOS}
  1330. UserScreen:=New(PDOSScreen, Init);
  1331. {$else}
  1332. {$ifdef Unix}
  1333. UserScreen:=New(PLinuxScreen, Init);
  1334. {$else}
  1335. {$ifdef Windows}
  1336. UserScreen:=New(PWindowsScreen, Init);
  1337. {$else}
  1338. {$ifdef OS2}
  1339. UserScreen:=New(POS2Screen, Init);
  1340. {$else}
  1341. {$ifdef netwlibc}
  1342. UserScreen:=New(PNWLScreen, Init);
  1343. {$else}
  1344. UserScreen:=New(PScreen, Init);
  1345. {$endif netwlibc}
  1346. {$endif OS2}
  1347. {$endif Windows}
  1348. {$endif Unix}
  1349. {$endif Dos}
  1350. end;
  1351. procedure DoneUserScreen;
  1352. begin
  1353. if UserScreen<>nil then
  1354. begin
  1355. UserScreen^.Restore;
  1356. Dispose(UserScreen, Done);
  1357. UserScreen:=nil;
  1358. end;
  1359. end;
  1360. end.