fpusrscr.pas 41 KB

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