fpusrscr.pas 41 KB

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