fpusrscr.pas 39 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497
  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. end;
  558. function TDOSScreen.GetLineStartOfs(Line: integer): word;
  559. begin
  560. GetLineStartOfs:=(ConsoleVideoInfo.Cols*Line)*2;
  561. end;
  562. procedure TDOSScreen.GetBuffer(Size: word);
  563. begin
  564. if (VBuffer<>nil) and (VBufferSize=Size) then Exit;
  565. if VBuffer<>nil then FreeBuffer;
  566. VBufferSize:=Size;
  567. GetMem(VBuffer,VBufferSize);
  568. end;
  569. procedure TDOSScreen.FreeBuffer;
  570. begin
  571. if (VBuffer<>nil) and (VBufferSize>0) then FreeMem(VBuffer,VBufferSize);
  572. VBuffer:=nil;
  573. end;
  574. procedure TDOSScreen.GetVideoMode(var MI: TDOSVideoInfo);
  575. var
  576. r: registers;
  577. {$ifdef TP}
  578. P: pointer;
  579. Sel: longint;
  580. (* {$I realintr.inc} *)
  581. {$endif}
  582. begin
  583. if (MI.StateSize>0) and (MI.StateBuf<>nil) then
  584. begin FreeMem(MI.StateBuf,MI.StateSize); MI.StateBuf:=nil; end;
  585. MI.ScreenSize:=MemW[Seg0040:$4c];
  586. r.ah:=$0f;
  587. intr($10,r);
  588. MI.Mode:=r.al;
  589. MI.Page:=r.bh;
  590. MI.Cols:=r.ah;
  591. {$ifdef VESA}
  592. VESAGetMode(MI.Mode);
  593. MI.Mode:=MI.Mode and $fff;
  594. {$endif}
  595. MI.Rows:=MI.ScreenSize div (MI.Cols*2);
  596. if MI.Rows=51 then MI.Rows:=50;
  597. r.ah:=$03;
  598. r.bh:=MI.Page;
  599. intr($10,r);
  600. with MI do
  601. begin
  602. CurPos.X:=r.dl; CurPos.Y:=r.dh;
  603. CurShapeT:=r.ch; CurShapeB:=r.cl;
  604. end;
  605. (*
  606. {$ifdef TP}
  607. { check VGA functions }
  608. MI.StateSize:=0;
  609. r.ah:=$1c; r.al:=0; r.cx:=7; intr($10,r);
  610. if (r.al=$1c) and ((r.flags and fCarry)=0) and (r.bx>0) then
  611. begin
  612. MI.StateSize:=r.bx;
  613. GetMem(MI.StateBuf,MI.StateSize); FillChar(MI.StateBuf^,MI.StateSize,0);
  614. P:=MI.StateBuf;
  615. {$ifdef DPMI}
  616. Sel:=GlobalDosAlloc(MI.StateSize);
  617. P:=Ptr(Sel shr 16,0);
  618. {$endif}
  619. r.ah:=$1c; r.al:=1; r.cx:=7;
  620. r.es:=PtrRec(P).Seg; r.bx:=PtrRec(P).Ofs;
  621. {$ifdef DPMI}realintr($10,r);{$else}intr($10,r);{$endif}
  622. {$ifdef DPMI}
  623. Move(Ptr(Sel and $ffff,0)^,MI.StateBuf^,MI.StateSize);
  624. GlobalDosFree(Sel and $ffff);
  625. {$endif}
  626. end;
  627. {$endif}
  628. *)
  629. end;
  630. procedure TDOSScreen.SetVideoMode(MI: TDOSVideoInfo);
  631. var r: registers;
  632. CM: TDOSVideoInfo;
  633. {$ifdef TP}
  634. P: pointer;
  635. Sel: longint;
  636. {$I realintr.inc}
  637. {$endif}
  638. begin
  639. FillChar(CM,sizeof(CM),0);
  640. GetVideoMode(CM);
  641. if (CM.Mode<>MI.Mode) or (CM.Cols<>MI.Cols) or (CM.Rows<>MI.Rows) then
  642. begin
  643. {$ifdef VESA}
  644. if MI.Mode>=$100 then
  645. VESASetMode(MI.Mode)
  646. else
  647. {$endif}
  648. begin
  649. r.ah:=$00; r.al:=MI.Mode; intr($10,r);
  650. end;
  651. if (MI.Mode=3) and (MI.Cols=80) and (MI.Rows=50) then
  652. begin
  653. r.ax:=$1112; r.bx:=$0;
  654. intr($10,r);
  655. end;
  656. end;
  657. r.ah:=$05; r.al:=MI.Page; intr($10,r);
  658. r.ah:=$02; r.bh:=MI.Page; r.dl:=MI.CurPos.X; r.dh:=MI.CurPos.Y; intr($10,r);
  659. r.ah:=$01; r.ch:=MI.CurShapeT; r.cl:=MI.CurShapeB; intr($10,r);
  660. (*
  661. {$ifdef TP}
  662. if (MI.StateSize>0) and (MI.StateBuf<>nil) then
  663. begin
  664. P:=MI.StateBuf;
  665. {$ifdef DPMI}
  666. Sel:=GlobalDosAlloc(MI.StateSize);
  667. Move(MI.StateBuf^,ptr(Sel and $ffff,0)^,MI.StateSize);
  668. P:=Ptr(Sel shr 16,0);
  669. {$endif}
  670. r.ah:=$1c; r.al:=2; r.cx:=7;
  671. r.es:=PtrRec(P).Seg; r.bx:=PtrRec(P).Ofs;
  672. {$ifdef DPMI}realintr($10,r);{$else}intr($10,r);{$endif}
  673. {$ifdef DPMI}
  674. GlobalDosFree(Sel and $ffff);
  675. {$endif}
  676. end;
  677. {$endif}
  678. *)
  679. end;
  680. {$endif}
  681. {****************************************************************************
  682. TLinuxScreen
  683. ****************************************************************************}
  684. {$ifdef Unix}
  685. constructor TLinuxScreen.Init;
  686. var
  687. ThisTTY: string[30];
  688. FName: string;
  689. WS: packed record
  690. ws_row, ws_col, ws_xpixel, ws_ypixel: Word;
  691. end;
  692. begin
  693. inherited Init;
  694. IdeScreen := nil;
  695. TTYFd:=-1;
  696. IsXterm:=getenv('TERM')='xterm';
  697. ThisTTY:=TTYName(stdinputhandle);
  698. if Not IsXterm and IsATTY(stdinputhandle) then
  699. begin
  700. Console:=TTyNetwork; {Default: Network or other vtxxx tty}
  701. if (Copy(ThisTTY, 1, 8) = '/dev/tty') and (ThisTTY[9]<>'p') Then
  702. begin
  703. Case ThisTTY[9] of
  704. '0'..'9' :
  705. begin { running Linux on native console or native-emulation }
  706. FName:='/dev/vcsa' + ThisTTY[9];
  707. TTYFd:=fdOpen(FName, Octal(666), Open_RdWr); { open console }
  708. If TTYFd <>-1 Then
  709. Console:=ttyLinux;
  710. end;
  711. 'v' : { check for (Free?)BSD native}
  712. If (ThisTTY[10]>='0') and (ThisTTY[10]<='9') Then
  713. Console:=ttyFreeBSD; {TTYFd ?}
  714. end;
  715. end;
  716. If Copy(GetEnv('TERM'),1,6)='cons25' Then
  717. Console:=ttyFreeBSD;
  718. ioctl(stdinputhandle, TIOCGWINSZ, @WS);
  719. if WS.ws_Col=0 then
  720. WS.ws_Col:=80;
  721. if WS.ws_Row=0 then
  722. WS.ws_Row:=25;
  723. ConsWidth:=WS.ws_Col;
  724. ConsHeight:=WS.ws_row;
  725. end;
  726. Capture;
  727. end;
  728. destructor TLinuxScreen.Done;
  729. begin
  730. if assigned(IdeScreen) then
  731. freemem(IdeScreen,IdeSize);
  732. if assigned(ConsVideoBuf) then
  733. freemem(ConsVideoBuf,ConsVideoBufSize);
  734. inherited Done;
  735. end;
  736. function TLinuxScreen.GetWidth: integer;
  737. begin
  738. GetWidth:=ConsWidth;
  739. end;
  740. function TLinuxScreen.GetHeight: integer;
  741. begin
  742. GetHeight:=ConsHeight;
  743. end;
  744. procedure TLinuxScreen.GetLine(Line: integer; var Text, Attr: string);
  745. var
  746. X, W : longint;
  747. begin
  748. Text:='';
  749. Attr:='';
  750. if (TtyFd<>-1) and assigned(ConsVideoBuf) then
  751. begin
  752. if Line<GetHeight then
  753. begin
  754. W:=(ConsWidth*Line)*Sizeof(word);
  755. for X:=0 to GetWidth-1 do
  756. begin
  757. {Text:=Text+chr(VBuffer^[W+X*2]);
  758. Attr:=Attr+chr(VBuffer^[W+X*2+1]);}
  759. System.Insert(chr(ConsVideoBuf^[W+X*2]),Text,Length(Text)+1);
  760. System.Insert(chr(ConsVideoBuf^[W+X*2+1]),Attr,Length(Attr)+1);
  761. end;
  762. end;
  763. end;
  764. end;
  765. procedure TLinuxScreen.GetCursorPos(var P: TPoint);
  766. begin
  767. P.X:=ConsCursorX+1;
  768. P.Y:=ConsCursorY+1;
  769. end;
  770. procedure TLinuxScreen.Capture;
  771. begin
  772. SaveConsoleScreen;
  773. end;
  774. procedure TLinuxScreen.Restore;
  775. begin
  776. SwitchToConsoleScreen;
  777. end;
  778. procedure TLinuxScreen.SaveIDEScreen;
  779. begin
  780. if assigned(IdeScreen) then
  781. freemem(IdeScreen,IdeSize);
  782. getmem(IdeScreen,videobufsize);
  783. IdeSize:=videobufsize;
  784. move(videobuf^,IdeScreen^,videobufsize);
  785. end;
  786. procedure TLinuxScreen.SaveConsoleScreen;
  787. var
  788. NewSize : longint;
  789. begin
  790. if IsXTerm then
  791. write(#27'7'#27'[?47h')
  792. else if (TTYfd<>-1) then
  793. begin
  794. fdSeek(TTYFd, 0, Seek_Set);
  795. fdRead(TTYFd,ConsHeight,sizeof(byte));
  796. fdRead(TTYFd,ConsWidth,sizeof(byte));
  797. fdRead(TTYFd,ConsCursorX,sizeof(byte));
  798. fdRead(TTYFd,ConsCursorY,sizeof(byte));
  799. NewSize:=ConsWidth*ConsHeight*sizeof(word);
  800. if (NewSize<>ConsVideoBufSize) and
  801. assigned(ConsVideoBuf) then
  802. Begin
  803. FreeMem(ConsVideoBuf,ConsVideoBufSize);
  804. ConsVideoBuf:=nil;
  805. End;
  806. If not assigned(ConsVideoBuf) then
  807. GetMem(ConsVideoBuf,NewSize);
  808. ConsVideoBufSize:=NewSize;
  809. fdRead(TTYFd,ConsVideoBuf^,ConsVideoBufSize);
  810. end
  811. else
  812. begin
  813. ConsWidth:=80;
  814. ConsHeight:=25;
  815. ConsCursorX:=0;
  816. ConsCursorY:=0;
  817. ConsVideoBuf:=nil;
  818. end;
  819. ConsTioValid:=TCGetAttr(1,ConsTio);
  820. end;
  821. procedure TLinuxScreen.SwitchToConsoleScreen;
  822. begin
  823. if IsXterm then
  824. begin
  825. write(#27'[0m');
  826. write(#27'[?47l'#27'8'#27'[m');
  827. end
  828. else if (TTyfd<>-1) then
  829. begin
  830. fdSeek(TTYFd, 2, Seek_Set);
  831. fdWrite(TTYFd, ConsCursorX, sizeof(byte));
  832. fdWrite(TTYFd, ConsCursorY, sizeof(byte));
  833. fdWrite(TTYFd, ConsVideoBuf^,ConsVideoBufSize);
  834. { FreeMem(ConsVideoBuf,ConsVideoBufSize);
  835. ConsVideoBuf:=nil; }
  836. end;
  837. If ConsTioValid then
  838. TCSetAttr(1,TCSANOW,ConsTio);
  839. end;
  840. procedure TLinuxScreen.SwitchBackToIDEScreen;
  841. begin
  842. if IdeScreen = nil then
  843. exit;
  844. move(IdeScreen^,videobuf^,videobufsize);
  845. freemem(IdeScreen,IdeSize);
  846. IdeScreen := nil;
  847. end;
  848. {$endif}
  849. {****************************************************************************
  850. TWin32Screen
  851. ****************************************************************************}
  852. {$ifdef win32}
  853. procedure UpdateFileHandles;
  854. begin
  855. {StdInputHandle:=longint(GetStdHandle(STD_INPUT_HANDLE));}
  856. StdOutputHandle:=longint(GetStdHandle(cardinal(STD_OUTPUT_HANDLE)));
  857. {StdErrorHandle:=longint(GetStdHandle(STD_ERROR_HANDLE));}
  858. TextRec(Output).Handle:=StdOutputHandle;
  859. TextRec(StdOut).Handle:=StdOutputHandle;
  860. {TextRec(StdErr).Handle:=StdErrorHandle;}
  861. end;
  862. constructor TWin32Screen.Init;
  863. var
  864. SecurityAttr : Security_attributes;
  865. BigWin : Coord;
  866. res : longbool;
  867. Error : dword;
  868. ConsoleScreenBufferInfo : Console_screen_buffer_info;
  869. begin
  870. inherited Init;
  871. {if GetConsoleOutputCP<>437 then
  872. res:=SetConsoleOutputCP(437);}
  873. SecurityAttr.nLength:=SizeOf(Security_attributes);
  874. SecurityAttr.lpSecurityDescriptor:=nil;
  875. SecurityAttr.bInheritHandle:=true;
  876. NewScreenBufferHandle:=CreateConsoleScreenBuffer(
  877. GENERIC_READ or GENERIC_WRITE,
  878. FILE_SHARE_READ or FILE_SHARE_WRITE,SecurityAttr,
  879. CONSOLE_TEXTMODE_BUFFER,nil);
  880. DummyScreenBufferHandle:=CreateConsoleScreenBuffer(
  881. GENERIC_READ or GENERIC_WRITE,
  882. FILE_SHARE_READ or FILE_SHARE_WRITE,SecurityAttr,
  883. CONSOLE_TEXTMODE_BUFFER,nil);
  884. StartScreenBufferHandle:=GetStdHandle(cardinal(STD_OUTPUT_HANDLE));
  885. GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @ConsoleMode);
  886. IdeMode:=ConsoleMode;
  887. {$ifdef debug}
  888. {define win32bigwin}
  889. {$endif debug}
  890. {$ifdef win32bigwin}
  891. GetConsoleScreenBufferInfo(StartScreenBufferHandle,
  892. @ConsoleScreenBufferInfo);
  893. BigWin.X:=ConsoleScreenBufferInfo.dwSize.X;
  894. BigWin.Y:=200;
  895. { Try to allow to store more info }
  896. res:=SetConsoleScreenBufferSize(NewScreenBufferHandle,BigWin);
  897. if not res then
  898. error:=GetLastError;
  899. res:=SetConsoleScreenBufferSize(StartScreenBufferHandle,BigWin);
  900. if not res then
  901. error:=GetLastError;
  902. {$endif win32bigwin}
  903. GetConsoleScreenBufferInfo(StartScreenBufferHandle,
  904. @ConsoleScreenBufferInfo);
  905. { make sure that the IDE Screen Handle has the maximum display size
  906. this removes the scroll bars if it is maximized }
  907. res:=SetConsoleScreenBufferSize(NewScreenBufferHandle,
  908. ConsoleScreenBufferInfo.dwMaximumWindowSize);
  909. if not res then
  910. error:=GetLastError;
  911. IDEScreenBufferHandle:=NewScreenBufferHandle;
  912. DosScreenBufferHandle:=StartScreenBufferHandle;
  913. Capture;
  914. {$ifdef fvision}
  915. if TextModeGFV then
  916. {$endif fvision}
  917. IdeScreenMode.row:=0;
  918. SwitchBackToIDEScreen;
  919. end;
  920. destructor TWin32Screen.Done;
  921. begin
  922. { copy the Dos buffer content into the original ScreenBuffer
  923. which remains the startup std_output_handle PM }
  924. {if StartScreenBufferHandle=IDEScreenBufferHandle then}
  925. BufferCopy(DosScreenBufferHandle,IDEScreenBufferHandle);
  926. SetConsoleActiveScreenBuffer(StartScreenBufferHandle);
  927. SetStdHandle(cardinal(Std_Output_Handle),StartScreenBufferHandle);
  928. UpdateFileHandles;
  929. CloseHandle(NewScreenBufferHandle);
  930. CloseHandle(DummyScreenBufferHandle);
  931. inherited Done;
  932. end;
  933. function TWin32Screen.GetWidth: integer;
  934. var
  935. ConsoleScreenBufferInfo : Console_screen_buffer_info;
  936. begin
  937. GetConsoleScreenBufferInfo(DosScreenBufferHandle,
  938. @ConsoleScreenBufferInfo);
  939. GetWidth:=ConsoleScreenBufferInfo.dwSize.X;
  940. end;
  941. function TWin32Screen.GetHeight: integer;
  942. var
  943. ConsoleScreenBufferInfo : Console_screen_buffer_info;
  944. begin
  945. GetConsoleScreenBufferInfo(DosScreenBufferHandle,
  946. @ConsoleScreenBufferInfo);
  947. GetHeight:=ConsoleScreenBufferInfo.dwSize.Y;
  948. end;
  949. function TWin32Screen.CanScroll : boolean;
  950. var
  951. ConsoleScreenBufferInfo : Console_screen_buffer_info;
  952. BufferLines : longint;
  953. WindowLines : longint;
  954. begin
  955. GetConsoleScreenBufferInfo(DosScreenBufferHandle,
  956. @ConsoleScreenBufferInfo);
  957. WindowLines:=ConsoleScreenBufferInfo.srWindow.Bottom-
  958. ConsoleScreenBufferInfo.srWindow.Top;
  959. BufferLines:= ConsoleScreenBufferInfo.dwSize.Y-1;
  960. CanScroll:=(BufferLines>WindowLines);
  961. end;
  962. function TWin32Screen.Scroll(i : integer) : integer;
  963. var
  964. ConsoleScreenBufferInfo : Console_screen_buffer_info;
  965. ConsoleWindow : Small_rect;
  966. begin
  967. GetConsoleScreenBufferInfo(DosScreenBufferHandle,
  968. @ConsoleScreenBufferInfo);
  969. if (ConsoleScreenBufferInfo.srWindow.Top + i < 0) then
  970. i:= -ConsoleScreenBufferInfo.srWindow.Top;
  971. if (ConsoleScreenBufferInfo.srWindow.Bottom + i > ConsoleScreenBufferInfo.dwSize.Y) then
  972. i:= ConsoleScreenBufferInfo.dwSize.Y - ConsoleScreenBufferInfo.srWindow.Bottom;
  973. if i<>0 then
  974. begin
  975. ConsoleWindow.Left:=ConsoleScreenBufferInfo.srWindow.Left;
  976. ConsoleWindow.Right:=ConsoleScreenBufferInfo.srWindow.Right;
  977. ConsoleWindow.Top:=ConsoleScreenBufferInfo.srWindow.Top+i;
  978. ConsoleWindow.Bottom:=ConsoleScreenBufferInfo.srWindow.Bottom+i;
  979. SetConsoleWindowInfo(DosScreenBufferHandle,true,ConsoleWindow);
  980. Scroll:=i;
  981. end
  982. else
  983. Scroll:=0;
  984. end;
  985. procedure TWin32Screen.GetLine(Line: integer; var Text, Attr: string);
  986. type
  987. CharInfoArray = Array [0..255] of Char_Info;
  988. var
  989. LineBuf : ^CharInfoArray;
  990. BufSize,BufCoord : Coord;
  991. i,LineSize : longint;
  992. WriteRegion : SMALL_RECT;
  993. begin
  994. GetMem(LineBuf,SizeOf(CharInfoArray));
  995. LineSize:=ScreenWidth;
  996. If LineSize>256 then
  997. LineSize:=256;
  998. BufSize.X:=LineSize;
  999. BufSize.Y:=1;
  1000. BufCoord.X:=0;
  1001. BufCoord.Y:=0;
  1002. with WriteRegion do
  1003. begin
  1004. Top :=Line;
  1005. Left :=0;
  1006. Bottom := Line+1;
  1007. Right := LineSize-1;
  1008. end;
  1009. ReadConsoleOutput(DosScreenBufferHandle, PChar_info(LineBuf),
  1010. BufSize, BufCoord, @WriteRegion);
  1011. for i:=1 to LineSize do
  1012. begin
  1013. Text[i]:=LineBuf^[i-1].AsciiChar;
  1014. Attr[i]:=char(byte(LineBuf^[i-1].Attributes));
  1015. end;
  1016. FreeMem(LineBuf,SizeOf(CharInfoArray));
  1017. Text[0]:=char(byte(LineSize));
  1018. Attr[0]:=char(byte(LineSize));
  1019. end;
  1020. procedure TWin32Screen.GetCursorPos(var P: TPoint);
  1021. var
  1022. ConsoleScreenBufferInfo : Console_screen_buffer_info;
  1023. begin
  1024. GetConsoleScreenBufferInfo(DosScreenBufferHandle,
  1025. @ConsoleScreenBufferInfo);
  1026. P.X:=ConsoleScreenBufferInfo.dwCursorPosition.X;
  1027. P.Y:=ConsoleScreenBufferInfo.dwCursorPosition.Y;
  1028. end;
  1029. procedure TWin32Screen.BufferCopy(Src, Dest : THandle);
  1030. type
  1031. CharInfoArray = Array [0..256*255-1] of Char_Info;
  1032. var
  1033. LineBuf : ^CharInfoArray;
  1034. BufSize,BufCoord : Coord;
  1035. Error, LineSize,
  1036. Part, OnePartY: longint;
  1037. res : boolean;
  1038. WriteRegion : SMALL_RECT;
  1039. ConsoleScreenBufferInfo : Console_screen_buffer_info;
  1040. DestConsoleScreenBufferInfo : Console_screen_buffer_info;
  1041. begin
  1042. GetConsoleScreenBufferInfo(Src,
  1043. @ConsoleScreenBufferInfo);
  1044. GetConsoleScreenBufferInfo(Dest,
  1045. @DestConsoleScreenBufferInfo);
  1046. GetMem(LineBuf,SizeOf(CharInfoArray));
  1047. FillChar(LineBuf^,SizeOf(CharInfoArray),#0);
  1048. LineSize:=ConsoleScreenBufferInfo.dwSize.X;
  1049. If LineSize>256 then
  1050. LineSize:=256;
  1051. BufSize.X:=LineSize;
  1052. BufSize.Y:=ConsoleScreenBufferInfo.dwSize.Y;
  1053. BufCoord.X:=0;
  1054. BufCoord.Y:=0;
  1055. with WriteRegion do
  1056. begin
  1057. Top :=0;
  1058. Left :=0;
  1059. Bottom := ConsoleScreenBufferInfo.dwSize.Y-1;
  1060. Right := LineSize-1;
  1061. end;
  1062. if BufSize.X*BufSize.Y*Sizeof(CHAR_INFO) >= $8000 then
  1063. begin
  1064. OnePartY := ($8000 -1) div (BufSize.X * SizeOf(Char_Info) );
  1065. BufSize.Y:=OnePartY;
  1066. Part:=0;
  1067. while ((Part+1)*OnePartY < ConsoleScreenBufferInfo.dwSize.Y) do
  1068. begin
  1069. WriteRegion.Top := Part*OnePartY;
  1070. WriteRegion.Bottom := (Part+1)*OnePartY-1;
  1071. res:=ReadConsoleOutput(Src, PChar_info(LineBuf),
  1072. BufSize, BufCoord, @WriteRegion);
  1073. if not res then
  1074. Error:=GetLastError;
  1075. res:=WriteConsoleOutput(Dest, PChar_info(LineBuf),
  1076. BufSize, BufCoord, @WriteRegion);
  1077. if not res then
  1078. Error:=GetLastError;
  1079. Inc(Part);
  1080. end;
  1081. BufSize.Y:=ConsoleScreenBufferInfo.dwSize.Y - Part*OnePartY;
  1082. WriteRegion.Top := Part*OnePartY;
  1083. WriteRegion.Bottom := ConsoleScreenBufferInfo.dwSize.Y-1;
  1084. res:=ReadConsoleOutput(Src, PChar_info(LineBuf),
  1085. BufSize, BufCoord, @WriteRegion);
  1086. if not res then
  1087. Error:=GetLastError;
  1088. res:=WriteConsoleOutput(Dest, PChar_info(LineBuf),
  1089. BufSize, BufCoord, @WriteRegion);
  1090. if not res then
  1091. Error:=GetLastError;
  1092. end
  1093. else
  1094. begin
  1095. res:=ReadConsoleOutput(Src, PChar_info(LineBuf),
  1096. BufSize, BufCoord, @WriteRegion);
  1097. if not res then
  1098. Error:=GetLastError;
  1099. res:=WriteConsoleOutput(Dest, PChar_info(LineBuf),
  1100. BufSize, BufCoord, @WriteRegion);
  1101. if not res then
  1102. Error:=GetLastError;
  1103. end;
  1104. FreeMem(LineBuf,SizeOf(CharInfoArray));
  1105. SetConsoleCursorPosition(Dest, ConsoleScreenBufferInfo.dwCursorPosition);
  1106. end;
  1107. procedure TWin32Screen.Capture;
  1108. begin
  1109. {if StartScreenBufferHandle=IdeScreenBufferHandle then
  1110. BufferCopy(IDEScreenBufferHandle,DosScreenBufferHandle)
  1111. else
  1112. BufferCopy(DosScreenBufferHandle,IDEScreenBufferHandle);}
  1113. SaveConsoleScreen;
  1114. end;
  1115. procedure TWin32Screen.Restore;
  1116. begin
  1117. SwitchToConsoleScreen;
  1118. end;
  1119. { dummy for win32 as the Buffer screen
  1120. do hold all the info }
  1121. procedure TWin32Screen.SaveIDEScreen;
  1122. begin
  1123. {$ifdef fvision}
  1124. if TextModeGFV then
  1125. {$endif fvision}
  1126. begin
  1127. IdeScreenMode:=ScreenMode;
  1128. GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @IdeMode);
  1129. { set the dummy buffer as active already now PM }
  1130. SetStdHandle(cardinal(Std_Output_Handle),DummyScreenBufferHandle);
  1131. UpdateFileHandles;
  1132. end;
  1133. end;
  1134. { dummy for win32 as the Buffer screen
  1135. do hold all the info }
  1136. procedure TWin32Screen.SaveConsoleScreen;
  1137. begin
  1138. {$ifdef fvision}
  1139. if TextModeGFV then
  1140. {$endif fvision}
  1141. begin
  1142. GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @ConsoleMode);
  1143. { set the dummy buffer as active already now PM }
  1144. SetStdHandle(cardinal(Std_Output_Handle),DummyScreenBufferHandle);
  1145. UpdateFileHandles;
  1146. end;
  1147. end;
  1148. procedure TWin32Screen.SwitchToConsoleScreen;
  1149. begin
  1150. {$ifdef fvision}
  1151. if TextModeGFV then
  1152. {$endif fvision}
  1153. begin
  1154. SetConsoleActiveScreenBuffer(DosScreenBufferHandle);
  1155. SetStdHandle(cardinal(Std_Output_Handle),DosScreenBufferHandle);
  1156. SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), ConsoleMode);
  1157. UpdateFileHandles;
  1158. end;
  1159. IDEActive:=false;
  1160. end;
  1161. procedure TWin32Screen.SwitchBackToIDEScreen;
  1162. var
  1163. ConsoleScreenBufferInfo : Console_screen_buffer_info;
  1164. WindowPos : Small_rect;
  1165. res : boolean;
  1166. error : longint;
  1167. begin
  1168. {$ifdef fvision}
  1169. if TextModeGFV then
  1170. {$endif fvision}
  1171. begin
  1172. SetStdHandle(cardinal(Std_Output_Handle),IDEScreenBufferHandle);
  1173. UpdateFileHandles;
  1174. GetConsoleScreenBufferInfo(IDEScreenBufferHandle,
  1175. @ConsoleScreenBufferInfo);
  1176. SetConsoleActiveScreenBuffer(IDEScreenBufferHandle);
  1177. {$ifdef fvision}
  1178. { Needed to force InitSystemMsg to use the right console handle }
  1179. DoneEvents;
  1180. InitEvents;
  1181. {$endif fvision}
  1182. IdeMode:=(IdeMode or ENABLE_MOUSE_INPUT or ENABLE_WINDOW_INPUT) and not ENABLE_PROCESSED_INPUT;
  1183. SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), IdeMode);
  1184. WindowPos.left:=0;
  1185. WindowPos.right:=ConsoleScreenBufferInfo.srWindow.right
  1186. -ConsoleScreenBufferInfo.srWindow.left;
  1187. WindowPos.top:=0;
  1188. WindowPos.bottom:=ConsoleScreenBufferInfo.srWindow.bottom
  1189. -ConsoleScreenBufferInfo.srWindow.top;
  1190. with ConsoleScreenBufferInfo.dwMaximumWindowSize do
  1191. begin
  1192. if WindowPos.Right<X-1 then
  1193. WindowPos.right:=X-1;
  1194. if WindowPos.Bottom<Y-1 then
  1195. WindowPos.Bottom:=Y-1;
  1196. end;
  1197. res:=SetConsoleWindowInfo(IDEScreenBufferHandle,true,WindowPos);
  1198. if not res then
  1199. error:=GetLastError;
  1200. {$ifdef DEBUG}
  1201. IdeScreenMode.row:=WindowPos.bottom+1;
  1202. IdeScreenMode.col:=WindowPos.right+1;
  1203. {$endif DEBUG}
  1204. { needed to force the correct size for videobuf }
  1205. if Assigned(Application) and (IdeScreenMode.row<>0)then
  1206. Application^.SetScreenVideoMode(IdeScreenMode);
  1207. end;
  1208. IDEActive:=true;
  1209. end;
  1210. {$endif}
  1211. {****************************************************************************
  1212. TOS2Screen
  1213. ****************************************************************************}
  1214. {$ifdef OS2}
  1215. function TOS2Screen.GetWidth: integer;
  1216. begin
  1217. GetWidth:=80;
  1218. end;
  1219. function TOS2Screen.GetHeight: integer;
  1220. begin
  1221. GetHeight:=25;
  1222. end;
  1223. procedure TOS2Screen.GetLine(Line: integer; var Text, Attr: string);
  1224. begin
  1225. Text:=' ';
  1226. Attr:=' ';
  1227. end;
  1228. procedure TOS2Screen.GetCursorPos(var P: TPoint);
  1229. begin
  1230. P.X:=1;
  1231. P.Y:=1;
  1232. end;
  1233. { remember the initial video screen }
  1234. procedure TOS2Screen.Capture;
  1235. begin
  1236. end;
  1237. { restore the initial video mode }
  1238. procedure TOS2Screen.Restore;
  1239. begin
  1240. end;
  1241. { move up or down if supported by OS }
  1242. function TOS2Screen.Scroll(i : integer) : integer;
  1243. begin
  1244. end;
  1245. { saves the current IDE screen }
  1246. procedure TOS2Screen.SaveIDEScreen;
  1247. begin
  1248. end;
  1249. { saves the current console screen }
  1250. procedure TOS2Screen.SaveConsoleScreen;
  1251. begin
  1252. end;
  1253. { restores the saved console screen }
  1254. procedure TOS2Screen.SwitchToConsoleScreen;
  1255. begin
  1256. end;
  1257. { restores the saved IDE screen }
  1258. procedure TOS2Screen.SwitchBackToIDEScreen;
  1259. begin
  1260. end;
  1261. constructor TOS2Screen.Init;
  1262. begin
  1263. end;
  1264. destructor TOS2Screen.Done;
  1265. begin
  1266. end;
  1267. {$ENDIF}
  1268. {****************************************************************************
  1269. Initialize
  1270. ****************************************************************************}
  1271. procedure InitUserScreen;
  1272. begin
  1273. {$ifdef DOS}
  1274. UserScreen:=New(PDOSScreen, Init);
  1275. {$else}
  1276. {$ifdef Unix}
  1277. UserScreen:=New(PLinuxScreen, Init);
  1278. {$else}
  1279. {$ifdef Win32}
  1280. UserScreen:=New(PWin32Screen, Init);
  1281. {$else}
  1282. {$ifdef OS2}
  1283. UserScreen:=New(POS2Screen, Init);
  1284. {$else}
  1285. UserScreen:=New(PScreen, Init);
  1286. {$endif OS2}
  1287. {$endif Win32}
  1288. {$endif Unix}
  1289. {$endif Dos}
  1290. end;
  1291. procedure DoneUserScreen;
  1292. begin
  1293. if UserScreen<>nil then
  1294. begin
  1295. UserScreen^.Restore;
  1296. Dispose(UserScreen, Done);
  1297. UserScreen:=nil;
  1298. end;
  1299. end;
  1300. end.
  1301. {
  1302. $Log$
  1303. Revision 1.26 2002-10-30 22:07:11 pierre
  1304. * only handle direction keys specially if buffer is bigger than window
  1305. Revision 1.25 2002/10/12 19:41:30 hajny
  1306. * dummy OS/2 implementation to enable compilation
  1307. Revision 1.24 2002/10/07 15:43:15 pierre
  1308. * set TTYFd to -1 in TLinuxScreen constructor
  1309. Revision 1.23 2002/09/25 22:02:13 pierre
  1310. * fix compilation error
  1311. Revision 1.22 2002/09/21 22:22:10 pierre
  1312. * new Restore method added, used for dos graphic applications
  1313. Revision 1.21 2002/09/13 22:27:07 pierre
  1314. * fix several problems with go32v2 graphic support
  1315. Revision 1.20 2002/09/13 08:15:06 pierre
  1316. * fix cursor position for linux vcsa support
  1317. Revision 1.19 2002/09/13 07:17:33 pierre
  1318. + use vcsa for linux console
  1319. Revision 1.18 2002/09/07 21:04:42 carl
  1320. * fix range check errors for version 1.1 compilation
  1321. Revision 1.17 2002/09/07 15:40:46 peter
  1322. * old logs removed and tabs fixed
  1323. Revision 1.16 2002/09/04 08:35:31 pierre
  1324. * remember IDE screen mode for win32
  1325. to avoid videobuf writes after allocated size.
  1326. Revision 1.15 2002/09/03 05:45:39 pierre
  1327. * fix compilation without DEBUG conditional
  1328. Revision 1.14 2002/09/02 09:29:55 pierre
  1329. + new test code for go32v2 graphic screen saves (only with -dDEBUG)
  1330. Revision 1.13 2002/06/13 11:18:32 pierre
  1331. + xterm window switching support
  1332. Revision 1.12 2002/06/07 14:10:24 pierre
  1333. * try to get resizing to work
  1334. Revision 1.11 2002/06/06 14:10:34 pierre
  1335. * allow window input for fvsion system messages
  1336. Revision 1.10 2002/06/06 06:46:28 pierre
  1337. * No videobuffer switch necessary for fvision win32 graphic version
  1338. Revision 1.9 2002/04/25 13:34:17 pierre
  1339. * fix the disappearing desktop for win32
  1340. Revision 1.8 2002/01/22 16:29:52 pierre
  1341. * try to fix win32 problem with Dos program ouptut in command shell
  1342. Warning, to debug under win32 with GDB you must use "set new-console on"
  1343. }