graph.pp 21 KB

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