fpusrscr.pas 42 KB

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