graph.pp 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1993-98 by Florian Klaempf & Gernot Tenchio
  5. members of the Free Pascal development team.
  6. Graph unit for BP7 compatible RTL
  7. See the file COPYING.FPC, included in this distribution,
  8. for details about the copyright.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12. **********************************************************************}
  13. unit GRAPH;
  14. { $DEFINE DEBUG}
  15. {$I os.inc}
  16. { Don't use smartlinking, becuase of the direct assembler that is used }
  17. {$SMARTLINK OFF}
  18. interface
  19. uses go32,mmx;
  20. {$I GLOBAL.PPI}
  21. {$I STDCOLOR.PPI}
  22. procedure CloseGraph;
  23. function GraphResult : Integer;
  24. procedure InitGraph(var GraphDriver:Integer;var GraphMode:Integer;const PathToDriver:String);
  25. procedure SetGraphMode(GraphMode : integer);
  26. procedure RestoreCRTMode;
  27. procedure SetGraphBufSize(BufSize : longint);
  28. function RegisterBGIdriver(driver : pointer) : integer;
  29. function InstallUserDriver(const DriverFileName : string;AutoDetectPtr : pointer) : integer;
  30. function GetDriverName: String;
  31. function GetModeName(Mode:Integer):String;
  32. function GetGraphMode:Integer;
  33. procedure GetAspectRatio(var _Xasp,_Yasp : word);
  34. procedure SetAspectRatio(_Xasp,_Yasp : word);
  35. function GraphErrorMsg(ErrorCode: Integer): string;
  36. function GetMaxMode : Integer;
  37. function GetMaxX : Integer;
  38. function GetMaxY : Integer;
  39. function GetX : Integer;
  40. function GetY : Integer;
  41. procedure Bar(x1,y1,x2,y2 : Integer);
  42. procedure bar3D(x1, y1, x2, y2 : integer;depth : word;top : boolean);
  43. procedure GetViewSettings(var viewport : ViewPortType);
  44. procedure SetActivePage(page : word);
  45. procedure SetVisualPage(page : word);
  46. procedure SetWriteMode(WriteMode : integer);
  47. procedure SetViewPort(x1,y1,x2,y2 : integer;clip : boolean);
  48. procedure Cleardevice;
  49. procedure ClearViewport;
  50. procedure Rectangle(x1,y1,x2,y2 : integer);
  51. { PIXEL.PPI }
  52. function GetPixel(x,y : integer):longint;
  53. procedure PutPixel(x,y : integer; Colour: longint);
  54. { LINE.PPI }
  55. procedure Line(x1,y1,x2,y2 : integer);
  56. procedure LineTo(x,y : integer);
  57. procedure LineRel(dx,dy : integer);
  58. procedure MoveTo(x,y : integer);
  59. procedure MoveRel(dx,dy : integer);
  60. procedure GetLineSettings(var LineInfo : LineSettingsType);
  61. procedure SetLineStyle(LineStyle : word;pattern : word;thickness : word);
  62. procedure DrawPoly(points : word;var polypoints);
  63. { PALETTE.PPI }
  64. procedure GetRGBPalette(ColorNum:byte; var RedValue,GreenValue,BlueValue:byte);
  65. procedure SetRGBPalette(ColorNum,RedValue,GreenValue,BlueValue:byte);
  66. procedure SetAllPalette(var Palette : PaletteType);
  67. procedure GetPalette(var Palette : PaletteType);
  68. { ELLIPSE.PPI }
  69. procedure FillEllipse(x,y:Integer;XRadius,YRadius:Word);
  70. procedure Circle(x,y:Integer;Radius:Word);
  71. { ARC.PPI }
  72. procedure Arc(x,y,alpha,beta:Integer;Radius:Word);
  73. { COLORS.PPI }
  74. function GetBkColor : longint;
  75. function GetColor : longint;
  76. function GetMaxColor : longint;
  77. procedure SetColor(Color : longint);
  78. procedure SetBkColor(Color : longint);
  79. { FILL.PPI }
  80. procedure FloodFill(x,y:integer; Border:longint);
  81. procedure GetFillSettings(var FillInfo : FillSettingsType);
  82. procedure GetFillPattern(var FillPattern : FillPatternType);
  83. procedure SetFillStyle(pattern : word;color : longint);
  84. procedure SetFillPattern(pattern : FillPatternType;color : longint);
  85. { IMAGE.PPI }
  86. function ImageSize(x1,y1,x2,y2 : integer) : word;
  87. procedure GetImage(x1,y1,x2,y2 : integer;var BitMap);
  88. procedure PutImage(x,y : integer;var BitMap;BitBlt : word);
  89. { TEXT.PPI }
  90. procedure GetTextSettings(var TextInfo : TextSettingsType);
  91. procedure OutText(const TextString : string);
  92. procedure OutTextXY(x,y : integer;const TextString : string);
  93. procedure OutText(const Charakter : char);
  94. procedure OutTextXY(x,y : integer;const Charakter : char);
  95. procedure SetTextJustify(horiz,vert : word);
  96. procedure SetTextStyle(Font, Direction : word; CharSize : word);
  97. procedure SetUserCharSize(Multx,Divx,Multy,Divy : word);
  98. function TextHeight(const TextString : string) : word;
  99. function TextWidth(const TextString : string) : word;
  100. function RegisterBGIfont(font : pointer) : integer;
  101. function InstallUserFont(const FontFileName : string) : integer;
  102. { extended non Borland-compatible }
  103. { TRIANGLE.PPI }
  104. procedure FillTriangle(A,B,C:Pointtype);
  105. procedure WaitRetrace;
  106. function Convert(color:longint):longint;
  107. implementation
  108. {$ASMMODE DIRECT}
  109. type
  110. PString=^String;
  111. PInteger=^integer;
  112. PWord=^word;
  113. PLong=^longint;
  114. VgaInfoBlock = record
  115. VESASignature: array[1..4]of Char;
  116. VESAloVersion: Byte;
  117. VESAhiVersion: Byte;
  118. OEMStringPtr : longint;
  119. Capabilities : longint;
  120. VideoModePtr : longint;
  121. TotalMem : word;
  122. { VESA 2.0 }
  123. OEMversion : word;
  124. VendorPtr : longint;
  125. ProductPtr : longint;
  126. RevisionPtr : longint;
  127. filler : Array[1..478]of Byte;
  128. end;
  129. VesaInfoBlock=record
  130. ModeAttributes : word;
  131. WinAAttributes : byte;
  132. WinBAttributes : byte;
  133. WinGranularity : word;
  134. WinSize : word;
  135. segWINA : word;
  136. segWINB : word;
  137. RealWinFuncPtr : longint;
  138. BPL : word;
  139. { VESA 1.2 }
  140. XResolution : word;
  141. YResolution : word;
  142. XCharSize : byte;
  143. YCharSize : byte;
  144. MumberOfPlanes : byte;
  145. BitsPerPixel : byte;
  146. NumberOfBanks : byte;
  147. MemoryModel : byte;
  148. BankSize : byte;
  149. NumberOfPages : byte;
  150. reserved : byte;
  151. rm_size : byte;
  152. rf_pos : byte;
  153. gm_size : byte;
  154. gf_pos : byte;
  155. bm_size : byte;
  156. bf_pos : byte;
  157. res_mask : word;
  158. DirectColorInfo: byte;
  159. { VESA 2.0 }
  160. PhysAddress : longint;
  161. OffscreenPtr : longint;
  162. OffscreenMem : word;
  163. reserved2 : Array[1..458]of Byte;
  164. end;
  165. {$I MODES.PPI}
  166. const
  167. CheckRange : Boolean=true;
  168. isVESA2 : Boolean=false;
  169. core : longint=$E0000000;
  170. var { X/Y Verhaeltnis des Bildschirm }
  171. AspectRatio : real;
  172. XAsp , YAsp : Word;
  173. { Zeilen & Spalten des aktuellen Graphikmoduses }
  174. _maxx,_maxy : longint;
  175. { aktuell eingestellte Farbe }
  176. aktcolor : longint;
  177. { Hintegrundfarbe }
  178. aktbackcolor : longint;
  179. { Videospeicherbereiche }
  180. wbuffer,rbuffer,wrbuffer : ^byte;
  181. { aktueller Ausgabebereich }
  182. aktviewport : ViewPortType;
  183. aktscreen : ViewPortType;
  184. { der Graphikmodus, der beim Start gesetzt war }
  185. startmode : byte;
  186. { Position des Graphikcursors }
  187. curx,cury : longint;
  188. { true, wenn die Routinen des Graphikpaketes verwendet werden d�rfen }
  189. isgraphmode : boolean;
  190. { Einstellung zum Linien zeichnen }
  191. aktlineinfo : LineSettingsType;
  192. { Fehlercode, wird von graphresult zur�ckgegeben }
  193. _graphresult : integer;
  194. { aktuell eingestellte F�llart }
  195. aktfillsettings : FillSettingsType;
  196. { aktuelles F�llmuster }
  197. aktfillpattern : FillPatternType;
  198. { Schreibmodus }
  199. aktwritemode : word;
  200. { Schrifteinstellung }
  201. akttextinfo : TextSettingsType;
  202. { momentan gesetzte Textskalierungswerte }
  203. aktmultx,aktdivx,aktmulty,aktdivy : word;
  204. { Pfad zu den Fonts }
  205. bgipath : string;
  206. { Pointer auf Hilfsspeicher }
  207. buffermem : pointer;
  208. { momentane GrӇe des Buffer }
  209. buffersize : longint;
  210. { in diesem Puffer werden bei SetFillStyle bereits die Pattern in der }
  211. { zu verwendenden Farbe abgelegt }
  212. PatternBuffer : Array[0..63]of LongInt;
  213. X_Array : array[0..1280]of LongInt;
  214. Y_Array : array[0..1024]of LongInt;
  215. Sel,Seg : word;
  216. VGAInfo : VGAInfoBlock;
  217. VESAInfo : VESAInfoBlock;
  218. { Selectors for Protected Mode }
  219. seg_WRITE : word;
  220. seg_READ : word;
  221. { Registers for RealModeInterrupts in DPMI-Mode }
  222. dregs : TRealRegs;
  223. AW_Bank : longint;
  224. { AR_Bank : Longint;}
  225. { Variables for Bankswitching }
  226. BytesPerLine : longint;
  227. BytesPerPixel: Word;
  228. WinSize : longint; { Expample $0x00010000 . $0x00008000 }
  229. WinLoMask : longint; { $0x0000FFFF $0x00007FFF }
  230. WinShift : byte;
  231. GranShift : byte;
  232. Granular : longint;
  233. Granularity : longint;
  234. graphgetmemptr,
  235. graphfreememptr,
  236. bankswitchptr :pointer;
  237. isDPMI :Boolean;
  238. SwitchCS,SwitchIP : word;
  239. function GraphErrorMsg(ErrorCode: Integer): string;
  240. Begin
  241. GraphErrorMsg:='';
  242. case ErrorCode of
  243. grOk,grFileNotFound,grInvalidDriver: exit;
  244. grNoInitGraph: GraphErrorMsg:='Graphics driver not installed';
  245. grNotDetected: GraphErrorMsg:='Graphics hardware not detected';
  246. grNoLoadMem,grNoScanMem,grNoFloodMem: GraphErrorMsg := 'Not enough memory for graphics';
  247. grNoFontMem: GraphErrorMsg := 'Not enough memory to load font';
  248. grFontNotFound: GraphErrorMsg:= 'Font file not found';
  249. grInvalidMode: GraphErrorMsg := 'Invalid graphics mode';
  250. grError: GraphErrorMsg:='Graphics error';
  251. grIoError: GraphErrorMsg:='Graphics I/O error';
  252. grInvalidFont,grInvalidFontNum: GraphErrorMsg := 'Invalid font';
  253. grInvalidVersion: GraphErrorMsg:='Invalid driver version';
  254. end;
  255. end;
  256. procedure Oh_Kacke(ErrString:String);
  257. begin
  258. CloseGraph;
  259. writeln('Error in Unit VESA: ',ErrString);
  260. halt;
  261. end;
  262. {$I MOVE.PPI}
  263. {$I IBM.PPI}
  264. procedure WaitRetrace;
  265. begin
  266. asm
  267. cli
  268. movw $0x03Da,%dx
  269. WaitNotHSyncLoop:
  270. inb %dx,%al
  271. testb $0x8,%al
  272. jnz WaitNotHSyncLoop
  273. WaitHSyncLoop:
  274. inb %dx,%al
  275. testb $0x8,%al
  276. jz WaitHSyncLoop
  277. sti
  278. end;
  279. end;
  280. procedure getmem(var p : pointer;size : longint);
  281. begin
  282. asm
  283. pushl 12(%ebp)
  284. pushl 8(%ebp)
  285. movl _GRAPHGETMEMPTR,%eax
  286. call %eax
  287. end;
  288. end;
  289. procedure freemem(var p : pointer;size : longint);
  290. begin
  291. asm
  292. pushl 12(%ebp)
  293. pushl 8(%ebp)
  294. movl _GRAPHFREEMEMPTR,%eax
  295. call %eax
  296. end;
  297. end;
  298. procedure graphdefaults;
  299. begin
  300. _graphresult:=grOk;
  301. if not isgraphmode then
  302. begin
  303. _graphresult:=grnoinitgraph;
  304. exit;
  305. end;
  306. { Linientyp }
  307. aktlineinfo.linestyle:=solidln;
  308. aktlineinfo.thickness:=normwidth;
  309. { Zeichenfarbe }
  310. aktcolor:=(white shl 24)+(white shl 16)+(white shl 8)+white;
  311. aktbackcolor:=black;
  312. { F�llmuster }
  313. setfillstyle(solidfill,white);
  314. { necessary to load patternbuffer !! (PM)
  315. aktfillsettings.color:=white;
  316. aktfillsettings.pattern:=solidfill; }
  317. { Viewport setzen }
  318. aktviewport.clip:=true;
  319. aktviewport.x1:=0;
  320. aktviewport.y1:=0;
  321. aktviewport.x2:=_maxx-1;
  322. aktviewport.y2:=_maxy-1;
  323. aktscreen:=aktviewport;
  324. { normaler Schreibmodus }
  325. setwritemode(normalput);
  326. { Schriftart einstellen }
  327. akttextinfo.font:=DefaultFont;
  328. akttextinfo.direction:=HorizDir;
  329. akttextinfo.charsize:=1;
  330. akttextinfo.horiz:=LeftText;
  331. akttextinfo.vert:=TopText;
  332. { VergrӇerungsfaktoren}
  333. XAsp:=10000; YAsp:=10000;
  334. aspectratio:=1;
  335. end;
  336. { ############################################################### }
  337. { ################# Ende der internen Routinen ################ }
  338. { ############################################################### }
  339. {$I COLORS.PPI}
  340. {$I PALETTE.PPI}
  341. {$I PIXEL.PPI}
  342. {$I LINE.PPI}
  343. {$I ELLIPSE.PPI}
  344. {$I TRIANGLE.PPI}
  345. {$I ARC.PPI}
  346. {$I IMAGE.PPI}
  347. {$I TEXT.PPI}
  348. {$I FILL.PPI}
  349. function GetDrivername:String;
  350. begin
  351. if not isgraphmode then
  352. begin
  353. _graphresult:=grNoInitGraph;
  354. Exit;
  355. end;
  356. GetDriverName:=('internal VESA-Driver');
  357. end;
  358. function GetModeName(Mode:Integer):String;
  359. var s1,s2,s3:string;
  360. begin
  361. if not isgraphmode then
  362. begin
  363. _graphresult:=grNoInitGraph;
  364. Exit;
  365. end;
  366. str(_maxx,s1);
  367. str(_maxy,s2);
  368. str(getmaxcolor+1,s3);
  369. GetModeName:=('VESA '+s1+'x'+s2+'x'+s3);
  370. end;
  371. function GetGraphMode:Integer;
  372. begin
  373. if not isgraphmode then
  374. begin
  375. _graphresult:=grNoInitGraph;
  376. Exit;
  377. end;
  378. GetGraphMode:=GetVesaMode;
  379. end;
  380. procedure ClearViewport;
  381. var bank1,bank2,diff,c:longint;
  382. ofs1,ofs2 :longint;
  383. y : integer;
  384. begin
  385. if not isgraphmode then
  386. begin
  387. _graphresult:=grNoInitGraph;
  388. Exit;
  389. end;
  390. c:=aktcolor;
  391. aktcolor:=aktbackcolor;
  392. ofs1:=Y_ARRAY[aktviewport.y1] + X_ARRAY[aktviewport.x1] ;
  393. ofs2:=Y_ARRAY[aktviewport.y1] + X_ARRAY[aktviewport.x2] ;
  394. for y:=aktviewport.y1 to aktviewport.y2 do
  395. begin
  396. bank1:=ofs1 shr winshift;
  397. bank2:=ofs2 shr winshift;
  398. if bank1 <> AW_BANK then
  399. begin
  400. Switchbank(bank1);
  401. AW_BANK:=bank1;
  402. end;
  403. if bank1 <> bank2 then
  404. begin
  405. diff:=((bank2 shl winshift)-ofs1) div BytesPerPixel;
  406. horizontalline(aktviewport.x1, aktviewport.x1+diff-1, y);
  407. Switchbank(bank2); AW_BANK:=bank2;
  408. horizontalline(aktviewport.x1+diff, aktviewport.x2, y);
  409. end else horizontalline(aktviewport.x1, aktviewport.x2, y);
  410. ofs1:=ofs1 + BytesPerLine;
  411. ofs2:=ofs2 + BytesPerLine;
  412. end;
  413. aktcolor:=c;
  414. end;
  415. procedure GetAspectRatio(var _Xasp,_Yasp : word);
  416. begin
  417. _graphresult:=grOk;
  418. if not isgraphmode then
  419. begin
  420. _graphresult:=grnoinitgraph;;
  421. exit;
  422. end;
  423. _XAsp:=XAsp; _YAsp:=YAsp;
  424. end;
  425. procedure SetAspectRatio(_Xasp, _Yasp : word);
  426. begin
  427. _graphresult:=grOk;
  428. if not isgraphmode then
  429. begin
  430. _graphresult:=grnoinitgraph;
  431. exit;
  432. end;
  433. Xasp:=_XAsp; YAsp:=_YAsp;
  434. end;
  435. procedure ClearDevice;
  436. var Viewport:ViewportType;
  437. begin
  438. if not isgraphmode then
  439. begin
  440. _graphresult:=grNoInitGraph;
  441. Exit;
  442. end;
  443. Viewport:=aktviewport;
  444. SetViewport(0,0,_maxx-1,_maxy-1,Clipon);
  445. ClearViewport;
  446. aktviewport:=viewport;
  447. end;
  448. procedure Rectangle(x1,y1,x2,y2:integer);
  449. begin
  450. if not isgraphmode then
  451. begin
  452. _graphresult:=grNoInitGraph;
  453. Exit;
  454. end;
  455. Line(x1,y1,x2,y1);
  456. Line(x1,y1,x1,y2);
  457. Line(x2,y1,x2,y2);
  458. Line(x1,y2,x2,y2);
  459. end;
  460. procedure Bar(x1,y1,x2,y2:integer);
  461. var y : Integer;
  462. origcolor : longint;
  463. origlinesettings: Linesettingstype;
  464. begin
  465. if not isgraphmode then
  466. begin
  467. _graphresult:=grNoInitGraph;
  468. Exit;
  469. end;
  470. origlinesettings:=aktlineinfo;
  471. origcolor:=aktcolor;
  472. aktlineinfo.linestyle:=solidln;
  473. aktlineinfo.thickness:=normwidth;
  474. case aktfillsettings.pattern of
  475. emptyfill : begin
  476. aktcolor:=aktbackcolor;
  477. for y:=y1 to y2 do line(x1,y,x2,y);
  478. end;
  479. solidfill : begin
  480. aktcolor:=aktfillsettings.color;
  481. for y:=y1 to y2 do line(x1,y,x2,y);
  482. end;
  483. else for y:=y1 to y2 do patternline(x1,x2,y);
  484. end;
  485. aktcolor:=origcolor;
  486. aktlineinfo:=origlinesettings;
  487. end;
  488. procedure bar3D(x1, y1, x2, y2 : integer;depth : word;top : boolean);
  489. begin
  490. if not isgraphmode then
  491. begin
  492. _graphresult:=grNoInitGraph;
  493. Exit;
  494. end;
  495. Bar(x1,y1,x2,y2);
  496. Rectangle(x1,y1,x2,y2);
  497. if top then begin
  498. Moveto(x1,y1);
  499. Lineto(x1+depth,y1-depth);
  500. Lineto(x2+depth,y1-depth);
  501. Lineto(x2,y1);
  502. end;
  503. Moveto(x2+depth,y1-depth);
  504. Lineto(x2+depth,y2-depth);
  505. Lineto(x2,y2);
  506. end;
  507. procedure SetGraphBufSize(BufSize : longint);
  508. begin
  509. if assigned(buffermem) then
  510. freemem(buffermem,buffersize);
  511. getmem(buffermem,bufsize);
  512. if not assigned(buffermem) then
  513. buffersize:=0
  514. else buffersize:=bufsize;
  515. end;
  516. const
  517. { Vorgabegr”áe f�r Hilfsspeicher }
  518. bufferstandardsize = 64*8196; { 0,5 MB }
  519. procedure CloseGraph;
  520. begin
  521. if isgraphmode then begin
  522. SetVESAMode(startmode);
  523. DoneVESA;
  524. isgraphmode:=false;
  525. end;
  526. end;
  527. procedure InitGraph(var GraphDriver:Integer;var GraphMode:Integer;const PathToDriver:String);
  528. var i,index:Integer;
  529. begin
  530. { Pfad zu den Fonts }
  531. bgipath:=PathToDriver;
  532. if bgipath[length(bgipath)]<>'\' then
  533. bgipath:=bgipath+'\';
  534. if Graphdriver=detect then GraphMode:=GetMaxMode;
  535. { Standardfonts installieren }
  536. InstallUserFont('TRIP');
  537. InstallUserFont('LITT');
  538. InstallUserFont('SANS');
  539. InstallUserFont('GOTH');
  540. InstallUserFont('SCRI');
  541. InstallUserFont('SIMP');
  542. InstallUserFont('TSCR');
  543. InstallUserFont('LCOM');
  544. InstallUserFont('EURO');
  545. InstallUserFont('BOLD');
  546. GetVESAInfo(GraphMode);
  547. {$IFDEF DEBUG}
  548. {$I VESADEB.PPI}
  549. {$ENDIF}
  550. for i:=VESANumber downto 0 do
  551. if GraphMode=VESAModes[i] then break;
  552. { the modes can be refused due to the monitor ? }
  553. { that happens by me at home Pierre Muller }
  554. while i>=0 do begin
  555. isgraphmode:=SetVESAMode(GraphMode);
  556. if isgraphmode then begin
  557. for index:=0 to VESAInfo.XResolution do X_Array[index]:=index * BytesPerPixel;
  558. for index:=0 to VESAInfo.YResolution do Y_Array[index]:=index * BytesPerLine;
  559. SetGraphBufSize(bufferstandardsize);
  560. graphdefaults;
  561. exit;
  562. end;
  563. dec(i);
  564. GraphMode:=VESAModes[i];
  565. end;
  566. _graphresult:=grInvalidMode
  567. end;
  568. procedure SetGraphMode(GraphMode:Integer);
  569. var index:Integer;
  570. begin
  571. _graphresult:=grOk;
  572. if not isgraphmode then
  573. begin
  574. _graphresult:=grNoInitGraph;
  575. Exit;
  576. end;
  577. if GetVesaInfo(GraphMode) then
  578. begin
  579. isgraphmode:=SetVESAMode(GraphMode);
  580. if isgraphmode then
  581. begin
  582. for index:=0 to VESAInfo.XResolution do
  583. X_Array[index]:=index * BytesPerPixel;
  584. for index:=0 to VESAInfo.YResolution do
  585. Y_Array[index]:=index * BytesPerLine;
  586. graphdefaults;
  587. exit;
  588. end;
  589. end;
  590. _graphresult:=grInvalidMode;
  591. end;
  592. function RegisterBGIdriver(driver : pointer) : integer;
  593. begin
  594. RegisterBGIdriver:=grerror;
  595. end;
  596. function InstallUserDriver(const DriverFileName : string;AutoDetectPtr : pointer) : integer;
  597. begin
  598. installuserdriver:=grerror;
  599. end;
  600. function GetMaxMode:Integer;
  601. var i:Byte;
  602. begin
  603. for i:=VESANumber downto 0 do
  604. if GetVesaInfo(VESAModes[i]) then
  605. begin
  606. GetMaxMode:=VESAModes[i];
  607. Exit;
  608. end;
  609. end;
  610. function GetMaxX:Integer;
  611. begin
  612. if not isgraphmode then
  613. begin
  614. _graphresult:=grNoInitGraph;
  615. Exit;
  616. end;
  617. GetMaxX:=VESAInfo.XResolution-1;
  618. end;
  619. function GetMaxY:Integer;
  620. begin
  621. if not isgraphmode then
  622. begin
  623. _graphresult:=grNoInitGraph;
  624. Exit;
  625. end;
  626. GetMaxY:=VESAInfo.YResolution-1;
  627. end;
  628. function GetX : integer;
  629. begin
  630. _graphresult:=grOk;
  631. if not isgraphmode then
  632. begin
  633. _graphresult:=grNoInitGraph;
  634. Exit;
  635. end;
  636. GetX:=curx;
  637. end;
  638. function GetY : integer;
  639. begin
  640. _graphresult:=grOk;
  641. if not isgraphmode then
  642. begin
  643. _graphresult:=grNoInitGraph;
  644. Exit;
  645. end;
  646. GetY:=cury;
  647. end;
  648. procedure SetViewPort(x1,y1,x2,y2 : integer;clip : boolean);
  649. begin
  650. _graphresult:=grOk;
  651. if not isgraphmode then
  652. begin
  653. _graphresult:=grNoInitGraph;
  654. exit;
  655. end;
  656. { Daten �berpr�fen }
  657. if (x1<0) or (y1<0) or (x2>=_maxx) or (y2>=_maxy) then exit;
  658. aktviewport.x1:=x1;
  659. aktviewport.y1:=y1;
  660. aktviewport.x2:=x2;
  661. aktviewport.y2:=y2;
  662. aktviewport.clip:=clip;
  663. end;
  664. procedure GetViewSettings(var viewport : ViewPortType);
  665. begin
  666. _graphresult:=grOk;
  667. if not isgraphmode then
  668. begin
  669. _graphresult:=grNoInitGraph;
  670. exit;
  671. end;
  672. viewport:=aktviewport;
  673. end;
  674. { mehrere Bildschirmseiten werden nicht unterst�tzt }
  675. { Dummy aus Kompatibilit„tsgr�nden }
  676. procedure SetVisualPage(page : word);
  677. begin
  678. _graphresult:=grOk;
  679. if not isgraphmode then
  680. begin
  681. _graphresult:=grNoInitGraph;;
  682. exit;
  683. end;
  684. end;
  685. { mehrere Bildschirmseiten werden nicht unterst�tzt }
  686. { Dummy aus Kompatibilit„tsgr�nden }
  687. procedure SetActivePage(page : word);
  688. begin
  689. _graphresult:=grOk;
  690. if not isgraphmode then
  691. begin
  692. _graphresult:=grNoInitGraph;;
  693. exit;
  694. end;
  695. end;
  696. procedure SetWriteMode(WriteMode : integer);
  697. begin
  698. _graphresult:=grOk;
  699. if not isgraphmode then
  700. begin
  701. _graphresult:=grNoInitGraph;;
  702. exit;
  703. end;
  704. if (writemode<>xorput) and (writemode<>normalput) then
  705. begin
  706. _graphresult:=grError;
  707. exit;
  708. end;
  709. aktwritemode:=writemode;
  710. end;
  711. function GraphResult:Integer;
  712. begin
  713. GraphResult:=_graphresult;
  714. end;
  715. procedure RestoreCRTMode;
  716. begin
  717. if not isgraphmode then
  718. begin
  719. _graphresult:=grNoInitGraph;
  720. Exit;
  721. end;
  722. SetVESAMode(startmode);
  723. isgraphmode:=false;
  724. end;
  725. begin
  726. InitVESA;
  727. if not DetectVESA then Oh_Kacke('VESA-BIOS not found...');
  728. startmode:=GetVESAMode;
  729. bankswitchptr:=@switchbank;
  730. GraphGetMemPtr:[email protected];
  731. GraphFreeMemPtr:[email protected];
  732. Getdefaultfont;
  733. if not isDPMI then begin
  734. wrbuffer:=pointer($D0000000);
  735. rbuffer:=pointer($D0200000);
  736. wbuffer:=pointer($D0200000);
  737. end else begin
  738. wrbuffer:=pointer($0);
  739. rbuffer:=pointer($0);
  740. wbuffer:=pointer($0);
  741. end;
  742. end.
  743. {
  744. $Log$
  745. Revision 1.6 1998-10-22 09:44:57 pierre
  746. * PatternBuffer was not set on entry !!
  747. Revision 1.5 1998/09/16 16:47:25 peter
  748. * merged fixes
  749. Revision 1.4.2.1 1998/09/16 16:15:41 peter
  750. * no smartlinking!
  751. Revision 1.4 1998/05/31 14:18:14 peter
  752. * force att or direct assembling
  753. * cleanup of some files
  754. Revision 1.3 1998/05/22 00:39:23 peter
  755. * go32v1, go32v2 recompiles with the new objects
  756. * remake3 works again with go32v2
  757. - removed some "optimizes" from daniel which were wrong
  758. }