fpusrscr.pas 43 KB

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