fpusrscr.pas 42 KB

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