fpusrscr.pas 43 KB

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