graph.pp 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849
  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. { F�llmuster }
  310. aktfillsettings.color:=white;
  311. aktfillsettings.pattern:=solidfill;
  312. { Zeichenfarbe }
  313. aktcolor:=(white shl 24)+(white shl 16)+(white shl 8)+white;
  314. aktbackcolor:=black;
  315. { Viewport setzen }
  316. aktviewport.clip:=true;
  317. aktviewport.x1:=0;
  318. aktviewport.y1:=0;
  319. aktviewport.x2:=_maxx-1;
  320. aktviewport.y2:=_maxy-1;
  321. aktscreen:=aktviewport;
  322. { normaler Schreibmodus }
  323. setwritemode(normalput);
  324. { Schriftart einstellen }
  325. akttextinfo.font:=DefaultFont;
  326. akttextinfo.direction:=HorizDir;
  327. akttextinfo.charsize:=1;
  328. akttextinfo.horiz:=LeftText;
  329. akttextinfo.vert:=TopText;
  330. { VergrӇerungsfaktoren}
  331. XAsp:=10000; YAsp:=10000;
  332. aspectratio:=1;
  333. end;
  334. { ############################################################### }
  335. { ################# Ende der internen Routinen ################ }
  336. { ############################################################### }
  337. {$I COLORS.PPI}
  338. {$I PALETTE.PPI}
  339. {$I PIXEL.PPI}
  340. {$I LINE.PPI}
  341. {$I ELLIPSE.PPI}
  342. {$I TRIANGLE.PPI}
  343. {$I ARC.PPI}
  344. {$I IMAGE.PPI}
  345. {$I TEXT.PPI}
  346. {$I FILL.PPI}
  347. function GetDrivername:String;
  348. begin
  349. if not isgraphmode then
  350. begin
  351. _graphresult:=grNoInitGraph;
  352. Exit;
  353. end;
  354. GetDriverName:=('internal VESA-Driver');
  355. end;
  356. function GetModeName(Mode:Integer):String;
  357. var s1,s2,s3:string;
  358. begin
  359. if not isgraphmode then
  360. begin
  361. _graphresult:=grNoInitGraph;
  362. Exit;
  363. end;
  364. str(_maxx,s1);
  365. str(_maxy,s2);
  366. str(getmaxcolor+1,s3);
  367. GetModeName:=('VESA '+s1+'x'+s2+'x'+s3);
  368. end;
  369. function GetGraphMode:Integer;
  370. begin
  371. if not isgraphmode then
  372. begin
  373. _graphresult:=grNoInitGraph;
  374. Exit;
  375. end;
  376. GetGraphMode:=GetVesaMode;
  377. end;
  378. procedure ClearViewport;
  379. var bank1,bank2,diff,c:longint;
  380. ofs1,ofs2 :longint;
  381. y : integer;
  382. begin
  383. if not isgraphmode then
  384. begin
  385. _graphresult:=grNoInitGraph;
  386. Exit;
  387. end;
  388. c:=aktcolor;
  389. aktcolor:=aktbackcolor;
  390. ofs1:=Y_ARRAY[aktviewport.y1] + X_ARRAY[aktviewport.x1] ;
  391. ofs2:=Y_ARRAY[aktviewport.y1] + X_ARRAY[aktviewport.x2] ;
  392. for y:=aktviewport.y1 to aktviewport.y2 do
  393. begin
  394. bank1:=ofs1 shr winshift;
  395. bank2:=ofs2 shr winshift;
  396. if bank1 <> AW_BANK then
  397. begin
  398. Switchbank(bank1);
  399. AW_BANK:=bank1;
  400. end;
  401. if bank1 <> bank2 then
  402. begin
  403. diff:=((bank2 shl winshift)-ofs1) div BytesPerPixel;
  404. horizontalline(aktviewport.x1, aktviewport.x1+diff-1, y);
  405. Switchbank(bank2); AW_BANK:=bank2;
  406. horizontalline(aktviewport.x1+diff, aktviewport.x2, y);
  407. end else horizontalline(aktviewport.x1, aktviewport.x2, y);
  408. ofs1:=ofs1 + BytesPerLine;
  409. ofs2:=ofs2 + BytesPerLine;
  410. end;
  411. aktcolor:=c;
  412. end;
  413. procedure GetAspectRatio(var _Xasp,_Yasp : word);
  414. begin
  415. _graphresult:=grOk;
  416. if not isgraphmode then
  417. begin
  418. _graphresult:=grnoinitgraph;;
  419. exit;
  420. end;
  421. _XAsp:=XAsp; _YAsp:=YAsp;
  422. end;
  423. procedure SetAspectRatio(_Xasp, _Yasp : word);
  424. begin
  425. _graphresult:=grOk;
  426. if not isgraphmode then
  427. begin
  428. _graphresult:=grnoinitgraph;
  429. exit;
  430. end;
  431. Xasp:=_XAsp; YAsp:=_YAsp;
  432. end;
  433. procedure ClearDevice;
  434. var Viewport:ViewportType;
  435. begin
  436. if not isgraphmode then
  437. begin
  438. _graphresult:=grNoInitGraph;
  439. Exit;
  440. end;
  441. Viewport:=aktviewport;
  442. SetViewport(0,0,_maxx-1,_maxy-1,Clipon);
  443. ClearViewport;
  444. aktviewport:=viewport;
  445. end;
  446. procedure Rectangle(x1,y1,x2,y2:integer);
  447. begin
  448. if not isgraphmode then
  449. begin
  450. _graphresult:=grNoInitGraph;
  451. Exit;
  452. end;
  453. Line(x1,y1,x2,y1);
  454. Line(x1,y1,x1,y2);
  455. Line(x2,y1,x2,y2);
  456. Line(x1,y2,x2,y2);
  457. end;
  458. procedure Bar(x1,y1,x2,y2:integer);
  459. var y : Integer;
  460. origcolor : longint;
  461. origlinesettings: Linesettingstype;
  462. begin
  463. if not isgraphmode then
  464. begin
  465. _graphresult:=grNoInitGraph;
  466. Exit;
  467. end;
  468. origlinesettings:=aktlineinfo;
  469. origcolor:=aktcolor;
  470. aktlineinfo.linestyle:=solidln;
  471. aktlineinfo.thickness:=normwidth;
  472. case aktfillsettings.pattern of
  473. 0 : begin
  474. aktcolor:=aktbackcolor;
  475. for y:=y1 to y2 do line(x1,y,x2,y);
  476. end;
  477. 1 : begin
  478. aktcolor:=aktfillsettings.color;
  479. for y:=y1 to y2 do line(x1,y,x2,y);
  480. end;
  481. else for y:=y1 to y2 do patternline(x1,x2,y);
  482. end;
  483. aktcolor:=origcolor;
  484. aktlineinfo:=origlinesettings;
  485. end;
  486. procedure bar3D(x1, y1, x2, y2 : integer;depth : word;top : boolean);
  487. begin
  488. if not isgraphmode then
  489. begin
  490. _graphresult:=grNoInitGraph;
  491. Exit;
  492. end;
  493. Bar(x1,y1,x2,y2);
  494. Rectangle(x1,y1,x2,y2);
  495. if top then begin
  496. Moveto(x1,y1);
  497. Lineto(x1+depth,y1-depth);
  498. Lineto(x2+depth,y1-depth);
  499. Lineto(x2,y1);
  500. end;
  501. Moveto(x2+depth,y1-depth);
  502. Lineto(x2+depth,y2-depth);
  503. Lineto(x2,y2);
  504. end;
  505. procedure SetGraphBufSize(BufSize : longint);
  506. begin
  507. if assigned(buffermem) then
  508. freemem(buffermem,buffersize);
  509. getmem(buffermem,bufsize);
  510. if not assigned(buffermem) then
  511. buffersize:=0
  512. else buffersize:=bufsize;
  513. end;
  514. const
  515. { Vorgabegr”áe f�r Hilfsspeicher }
  516. bufferstandardsize = 64*8196; { 0,5 MB }
  517. procedure CloseGraph;
  518. begin
  519. if isgraphmode then begin
  520. SetVESAMode(startmode);
  521. DoneVESA;
  522. isgraphmode:=false;
  523. end;
  524. end;
  525. procedure InitGraph(var GraphDriver:Integer;var GraphMode:Integer;const PathToDriver:String);
  526. var i,index:Integer;
  527. begin
  528. { Pfad zu den Fonts }
  529. bgipath:=PathToDriver;
  530. if bgipath[length(bgipath)]<>'\' then
  531. bgipath:=bgipath+'\';
  532. if Graphdriver=detect then GraphMode:=GetMaxMode;
  533. { Standardfonts installieren }
  534. InstallUserFont('TRIP');
  535. InstallUserFont('LITT');
  536. InstallUserFont('SANS');
  537. InstallUserFont('GOTH');
  538. InstallUserFont('SCRI');
  539. InstallUserFont('SIMP');
  540. InstallUserFont('TSCR');
  541. InstallUserFont('LCOM');
  542. InstallUserFont('EURO');
  543. InstallUserFont('BOLD');
  544. GetVESAInfo(GraphMode);
  545. {$IFDEF DEBUG}
  546. {$I VESADEB.PPI}
  547. {$ENDIF}
  548. for i:=VESANumber downto 0 do
  549. if GraphMode=VESAModes[i] then break;
  550. { the modes can be refused due to the monitor ? }
  551. { that happens by me at home Pierre Muller }
  552. while i>=0 do begin
  553. isgraphmode:=SetVESAMode(GraphMode);
  554. if isgraphmode then begin
  555. for index:=0 to VESAInfo.XResolution do X_Array[index]:=index * BytesPerPixel;
  556. for index:=0 to VESAInfo.YResolution do Y_Array[index]:=index * BytesPerLine;
  557. SetGraphBufSize(bufferstandardsize);
  558. graphdefaults;
  559. exit;
  560. end;
  561. dec(i);
  562. GraphMode:=VESAModes[i];
  563. end;
  564. _graphresult:=grInvalidMode
  565. end;
  566. procedure SetGraphMode(GraphMode:Integer);
  567. var index:Integer;
  568. begin
  569. _graphresult:=grOk;
  570. if not isgraphmode then
  571. begin
  572. _graphresult:=grNoInitGraph;
  573. Exit;
  574. end;
  575. if GetVesaInfo(GraphMode) then
  576. begin
  577. isgraphmode:=SetVESAMode(GraphMode);
  578. if isgraphmode then
  579. begin
  580. for index:=0 to VESAInfo.XResolution do
  581. X_Array[index]:=index * BytesPerPixel;
  582. for index:=0 to VESAInfo.YResolution do
  583. Y_Array[index]:=index * BytesPerLine;
  584. graphdefaults;
  585. exit;
  586. end;
  587. end;
  588. _graphresult:=grInvalidMode;
  589. end;
  590. function RegisterBGIdriver(driver : pointer) : integer;
  591. begin
  592. RegisterBGIdriver:=grerror;
  593. end;
  594. function InstallUserDriver(const DriverFileName : string;AutoDetectPtr : pointer) : integer;
  595. begin
  596. installuserdriver:=grerror;
  597. end;
  598. function GetMaxMode:Integer;
  599. var i:Byte;
  600. begin
  601. for i:=VESANumber downto 0 do
  602. if GetVesaInfo(VESAModes[i]) then
  603. begin
  604. GetMaxMode:=VESAModes[i];
  605. Exit;
  606. end;
  607. end;
  608. function GetMaxX:Integer;
  609. begin
  610. if not isgraphmode then
  611. begin
  612. _graphresult:=grNoInitGraph;
  613. Exit;
  614. end;
  615. GetMaxX:=VESAInfo.XResolution-1;
  616. end;
  617. function GetMaxY:Integer;
  618. begin
  619. if not isgraphmode then
  620. begin
  621. _graphresult:=grNoInitGraph;
  622. Exit;
  623. end;
  624. GetMaxY:=VESAInfo.YResolution-1;
  625. end;
  626. function GetX : integer;
  627. begin
  628. _graphresult:=grOk;
  629. if not isgraphmode then
  630. begin
  631. _graphresult:=grNoInitGraph;
  632. Exit;
  633. end;
  634. GetX:=curx;
  635. end;
  636. function GetY : integer;
  637. begin
  638. _graphresult:=grOk;
  639. if not isgraphmode then
  640. begin
  641. _graphresult:=grNoInitGraph;
  642. Exit;
  643. end;
  644. GetY:=cury;
  645. end;
  646. procedure SetViewPort(x1,y1,x2,y2 : integer;clip : boolean);
  647. begin
  648. _graphresult:=grOk;
  649. if not isgraphmode then
  650. begin
  651. _graphresult:=grNoInitGraph;
  652. exit;
  653. end;
  654. { Daten �berpr�fen }
  655. if (x1<0) or (y1<0) or (x2>=_maxx) or (y2>=_maxy) then exit;
  656. aktviewport.x1:=x1;
  657. aktviewport.y1:=y1;
  658. aktviewport.x2:=x2;
  659. aktviewport.y2:=y2;
  660. aktviewport.clip:=clip;
  661. end;
  662. procedure GetViewSettings(var viewport : ViewPortType);
  663. begin
  664. _graphresult:=grOk;
  665. if not isgraphmode then
  666. begin
  667. _graphresult:=grNoInitGraph;
  668. exit;
  669. end;
  670. viewport:=aktviewport;
  671. end;
  672. { mehrere Bildschirmseiten werden nicht unterst�tzt }
  673. { Dummy aus Kompatibilit„tsgr�nden }
  674. procedure SetVisualPage(page : word);
  675. begin
  676. _graphresult:=grOk;
  677. if not isgraphmode then
  678. begin
  679. _graphresult:=grNoInitGraph;;
  680. exit;
  681. end;
  682. end;
  683. { mehrere Bildschirmseiten werden nicht unterst�tzt }
  684. { Dummy aus Kompatibilit„tsgr�nden }
  685. procedure SetActivePage(page : word);
  686. begin
  687. _graphresult:=grOk;
  688. if not isgraphmode then
  689. begin
  690. _graphresult:=grNoInitGraph;;
  691. exit;
  692. end;
  693. end;
  694. procedure SetWriteMode(WriteMode : integer);
  695. begin
  696. _graphresult:=grOk;
  697. if not isgraphmode then
  698. begin
  699. _graphresult:=grNoInitGraph;;
  700. exit;
  701. end;
  702. if (writemode<>xorput) and (writemode<>normalput) then
  703. begin
  704. _graphresult:=grError;
  705. exit;
  706. end;
  707. aktwritemode:=writemode;
  708. end;
  709. function GraphResult:Integer;
  710. begin
  711. GraphResult:=_graphresult;
  712. end;
  713. procedure RestoreCRTMode;
  714. begin
  715. if not isgraphmode then
  716. begin
  717. _graphresult:=grNoInitGraph;
  718. Exit;
  719. end;
  720. SetVESAMode(startmode);
  721. isgraphmode:=false;
  722. end;
  723. begin
  724. InitVESA;
  725. if not DetectVESA then Oh_Kacke('VESA-BIOS not found...');
  726. startmode:=GetVESAMode;
  727. bankswitchptr:=@switchbank;
  728. GraphGetMemPtr:[email protected];
  729. GraphFreeMemPtr:[email protected];
  730. Getdefaultfont;
  731. if not isDPMI then begin
  732. wrbuffer:=pointer($D0000000);
  733. rbuffer:=pointer($D0200000);
  734. wbuffer:=pointer($D0200000);
  735. end else begin
  736. wrbuffer:=pointer($0);
  737. rbuffer:=pointer($0);
  738. wbuffer:=pointer($0);
  739. end;
  740. end.
  741. {
  742. $Log$
  743. Revision 1.5 1998-09-16 16:47:25 peter
  744. * merged fixes
  745. Revision 1.4.2.1 1998/09/16 16:15:41 peter
  746. * no smartlinking!
  747. Revision 1.4 1998/05/31 14:18:14 peter
  748. * force att or direct assembling
  749. * cleanup of some files
  750. Revision 1.3 1998/05/22 00:39:23 peter
  751. * go32v1, go32v2 recompiles with the new objects
  752. * remake3 works again with go32v2
  753. - removed some "optimizes" from daniel which were wrong
  754. }