2
0

fpusrscr.pas 40 KB

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