fpusrscr.pas 40 KB

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