graph.pp 21 KB

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