fpusrscr.pas 42 KB

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