fpusrscr.pas 40 KB

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