2
0

fpusrscr.pas 41 KB

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