fpusrscr.pas 42 KB

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