graph.inc 76 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by the Free Pascal development team
  5. Graph unit implementation part
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {$ifdef logging}
  13. var debuglog: text;
  14. function strf(l: longint): string;
  15. begin
  16. str(l, strf)
  17. end;
  18. Procedure Log(Const s: String);
  19. Begin
  20. Append(debuglog);
  21. Write(debuglog, s);
  22. Close(debuglog);
  23. End;
  24. Procedure LogLn(Const s: string);
  25. Begin
  26. Append(debuglog);
  27. Writeln(debuglog,s);
  28. Close(debuglog);
  29. End;
  30. {$endif logging}
  31. const
  32. StdBufferSize = 4096; { Buffer size for FloodFill }
  33. type
  34. tinttable = array[0..16383] of smallint;
  35. pinttable = ^tinttable;
  36. WordArray = Array [0..StdbufferSize] Of word;
  37. PWordArray = ^WordArray;
  38. const
  39. { Mask for each bit in byte used to determine pattern }
  40. BitArray: Array[0..7] of byte =
  41. ($01,$02,$04,$08,$10,$20,$40,$80);
  42. RevbitArray: Array[0..7] of byte =
  43. ($80,$40,$20,$10,$08,$04,$02,$01);
  44. { pre expanded line patterns }
  45. { 0 = LSB of byte pattern }
  46. { 15 = MSB of byte pattern }
  47. LinePatterns: Array[0..15] of BOOLEAN =
  48. (TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,
  49. TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,TRUE);
  50. const
  51. BGIPath : string = '.';
  52. { Default font 8x8 system from IBM PC }
  53. {$i fontdata.inc}
  54. var
  55. CurrentColor: Word;
  56. CurrentBkColor: Word;
  57. CurrentX : smallint; { viewport relative }
  58. CurrentY : smallint; { viewport relative }
  59. ClipPixels: Boolean; { Should cliiping be enabled }
  60. CurrentWriteMode: smallint;
  61. _GraphResult : smallint;
  62. LineInfo : LineSettingsType;
  63. FillSettings: FillSettingsType;
  64. { information for Text Output routines }
  65. CurrentTextInfo : TextSettingsType;
  66. CurrentXRatio, CurrentYRatio: graph_float;
  67. installedfonts: longint; { Number of installed fonts }
  68. StartXViewPort: smallint; { absolute }
  69. StartYViewPort: smallint; { absolute }
  70. ViewWidth : smallint;
  71. ViewHeight: smallint;
  72. IsGraphMode : Boolean; { Indicates if we are in graph mode or not }
  73. ArcCall: ArcCoordsType; { Information on the last call to Arc or Ellipse }
  74. var
  75. { ******************** HARDWARE INFORMATION ********************* }
  76. { Should be set in InitGraph once only. }
  77. IntCurrentMode : smallint;
  78. IntCurrentDriver : smallint; { Currently loaded driver }
  79. XAspect : word;
  80. YAspect : word;
  81. MaxX : smallint; { Maximum resolution - ABSOLUTE }
  82. MaxY : smallint; { Maximum resolution - ABSOLUTE }
  83. MaxColor : Longint;
  84. PaletteSize : longint; { Maximum palette entry we can set, usually equal}
  85. { maxcolor. }
  86. HardwarePages : byte; { maximum number of hardware visual pages }
  87. DriverName: String;
  88. DirectColor : Boolean ; { Is it a direct color mode? }
  89. ModeList : PModeInfo;
  90. DirectVideo : Boolean; { Direct access to video memory? }
  91. {--------------------------------------------------------------------------}
  92. { }
  93. { LINE AND LINE RELATED ROUTINES }
  94. { }
  95. {--------------------------------------------------------------------------}
  96. {$i clip.inc}
  97. procedure HLineDefault(x,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
  98. var
  99. xtmp: smallint;
  100. Begin
  101. { must we swap the values? }
  102. if x >= x2 then
  103. Begin
  104. xtmp := x2;
  105. x2 := x;
  106. x:= xtmp;
  107. end;
  108. { First convert to global coordinates }
  109. X := X + StartXViewPort;
  110. X2 := X2 + StartXViewPort;
  111. Y := Y + StartYViewPort;
  112. if ClipPixels then
  113. Begin
  114. if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
  115. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  116. exit;
  117. end;
  118. for x:= x to x2 do
  119. DirectPutPixel(X,Y);
  120. end;
  121. procedure VLineDefault(x,y,y2: smallint); {$ifndef fpc}far;{$endif fpc}
  122. var
  123. ytmp: smallint;
  124. Begin
  125. { must we swap the values? }
  126. if y >= y2 then
  127. Begin
  128. ytmp := y2;
  129. y2 := y;
  130. y:= ytmp;
  131. end;
  132. { First convert to global coordinates }
  133. X := X + StartXViewPort;
  134. Y2 := Y2 + StartYViewPort;
  135. Y := Y + StartYViewPort;
  136. if ClipPixels then
  137. Begin
  138. if LineClipped(x,y,x,y2,StartXViewPort,StartYViewPort,
  139. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  140. exit;
  141. end;
  142. for y := y to y2 do Directputpixel(x,y)
  143. End;
  144. Procedure DirectPutPixelClip(x,y: smallint);
  145. { for thickwidth lines, because they may call DirectPutPixel for coords }
  146. { outside the current viewport (bug found by CEC) }
  147. Begin
  148. If (Not ClipPixels) Or
  149. ((X >= StartXViewPort) And (X <= (StartXViewPort + ViewWidth)) And
  150. (Y >= StartYViewPort) And (Y <= (StartYViewPort + ViewHeight))) then
  151. Begin
  152. DirectPutPixel(x,y)
  153. End
  154. End;
  155. procedure LineDefault(X1, Y1, X2, Y2: smallint); {$ifndef fpc}far;{$endif fpc}
  156. var X, Y : smallint;
  157. deltax, deltay : smallint;
  158. d, dinc1, dinc2: smallint;
  159. xinc1 : smallint;
  160. xinc2 : smallint;
  161. yinc1 : smallint;
  162. yinc2 : smallint;
  163. i : smallint;
  164. Flag : Boolean; { determines pixel direction in thick lines }
  165. NumPixels : smallint;
  166. PixelCount : smallint;
  167. OldCurrentColor: Word;
  168. swtmp : smallint;
  169. TmpNumPixels : smallint;
  170. begin
  171. {******************************************}
  172. { SOLID LINES }
  173. {******************************************}
  174. if lineinfo.LineStyle = SolidLn then
  175. Begin
  176. { we separate normal and thick width for speed }
  177. { and because it would not be 100% compatible }
  178. { with the TP graph unit otherwise }
  179. if y1 = y2 then
  180. Begin
  181. {******************************************}
  182. { SOLID LINES HORIZONTAL }
  183. {******************************************}
  184. if lineinfo.Thickness=NormWidth then
  185. hline(x1,x2,y2)
  186. else
  187. begin
  188. { thick width }
  189. hline(x1,x2,y2-1);
  190. hline(x1,x2,y2);
  191. hline(x2,x2,y2+1);
  192. end;
  193. end
  194. else
  195. if x1 = x2 then
  196. Begin
  197. {******************************************}
  198. { SOLID LINES VERTICAL }
  199. {******************************************}
  200. if lineinfo.Thickness=NormWidth then
  201. vline(x1,y1,y2)
  202. else
  203. begin
  204. { thick width }
  205. vline(x1-1,y1,y2);
  206. vline(x1,y1,y2);
  207. vline(x1+1,y1,y2);
  208. end;
  209. end
  210. else
  211. begin
  212. { Convert to global coordinates. }
  213. x1 := x1 + StartXViewPort;
  214. x2 := x2 + StartXViewPort;
  215. y1 := y1 + StartYViewPort;
  216. y2 := y2 + StartYViewPort;
  217. { if fully clipped then exit... }
  218. if ClipPixels then
  219. begin
  220. if LineClipped(x1,y1,x2,y2,StartXViewPort, StartYViewPort,
  221. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  222. exit;
  223. end;
  224. {******************************************}
  225. { SLOPED SOLID LINES }
  226. {******************************************}
  227. oldCurrentColor :=
  228. CurrentColor;
  229. { Calculate deltax and deltay for initialisation }
  230. deltax := abs(x2 - x1);
  231. deltay := abs(y2 - y1);
  232. { Initialize all vars based on which is the independent variable }
  233. if deltax >= deltay then
  234. begin
  235. Flag := FALSE;
  236. { x is independent variable }
  237. numpixels := deltax + 1;
  238. d := (2 * deltay) - deltax;
  239. dinc1 := deltay Shl 1;
  240. dinc2 := (deltay - deltax) shl 1;
  241. xinc1 := 1;
  242. xinc2 := 1;
  243. yinc1 := 0;
  244. yinc2 := 1;
  245. end
  246. else
  247. begin
  248. Flag := TRUE;
  249. { y is independent variable }
  250. numpixels := deltay + 1;
  251. d := (2 * deltax) - deltay;
  252. dinc1 := deltax Shl 1;
  253. dinc2 := (deltax - deltay) shl 1;
  254. xinc1 := 0;
  255. xinc2 := 1;
  256. yinc1 := 1;
  257. yinc2 := 1;
  258. end;
  259. { Make sure x and y move in the right directions }
  260. if x1 > x2 then
  261. begin
  262. xinc1 := - xinc1;
  263. xinc2 := - xinc2;
  264. end;
  265. if y1 > y2 then
  266. begin
  267. yinc1 := - yinc1;
  268. yinc2 := - yinc2;
  269. end;
  270. { Start drawing at <x1, y1> }
  271. x := x1;
  272. y := y1;
  273. If LineInfo.Thickness=NormWidth then
  274. Begin
  275. { Draw the pixels }
  276. for i := 1 to numpixels do
  277. begin
  278. DirectPutPixel(x, y);
  279. if d < 0 then
  280. begin
  281. d := d + dinc1;
  282. x := x + xinc1;
  283. y := y + yinc1;
  284. end
  285. else
  286. begin
  287. d := d + dinc2;
  288. x := x + xinc2;
  289. y := y + yinc2;
  290. end;
  291. CurrentColor := OldCurrentColor;
  292. end;
  293. end
  294. else
  295. { Thick width lines }
  296. begin
  297. { Draw the pixels }
  298. for i := 1 to numpixels do
  299. begin
  300. { all depending on the slope, we can determine }
  301. { in what direction the extra width pixels will be put }
  302. If Flag then
  303. Begin
  304. DirectPutPixelClip(x-1,y);
  305. DirectPutPixelClip(x,y);
  306. DirectPutPixelClip(x+1,y);
  307. end
  308. else
  309. Begin
  310. DirectPutPixelClip(x, y-1);
  311. DirectPutPixelClip(x, y);
  312. DirectPutPixelClip(x, y+1);
  313. end;
  314. if d < 0 then
  315. begin
  316. d := d + dinc1;
  317. x := x + xinc1;
  318. y := y + yinc1;
  319. end
  320. else
  321. begin
  322. d := d + dinc2;
  323. x := x + xinc2;
  324. y := y + yinc2;
  325. end;
  326. CurrentColor := OldCurrentColor;
  327. end;
  328. end;
  329. end;
  330. end
  331. else
  332. {******************************************}
  333. { begin patterned lines }
  334. {******************************************}
  335. Begin
  336. { Convert to global coordinates. }
  337. x1 := x1 + StartXViewPort;
  338. x2 := x2 + StartXViewPort;
  339. y1 := y1 + StartYViewPort;
  340. y2 := y2 + StartYViewPort;
  341. { if fully clipped then exit... }
  342. if ClipPixels then
  343. begin
  344. if LineClipped(x1,y1,x2,y2,StartXViewPort, StartYViewPort,
  345. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  346. exit;
  347. end;
  348. OldCurrentColor := CurrentColor;
  349. PixelCount:=0;
  350. if y1 = y2 then
  351. Begin
  352. { Check if we must swap }
  353. if x1 >= x2 then
  354. Begin
  355. swtmp := x1;
  356. x1 := x2;
  357. x2 := swtmp;
  358. end;
  359. if LineInfo.Thickness = NormWidth then
  360. Begin
  361. for PixelCount:=x1 to x2 do
  362. { optimization: PixelCount mod 16 }
  363. if LinePatterns[PixelCount and 15] = TRUE then
  364. begin
  365. DirectPutPixel(PixelCount,y2);
  366. end;
  367. end
  368. else
  369. Begin
  370. for i:=-1 to 1 do
  371. Begin
  372. for PixelCount:=x1 to x2 do
  373. { Optimization from Thomas - mod 16 = and 15 }
  374. {this optimization has been performed by the compiler
  375. for while as well (JM)}
  376. if LinePatterns[PixelCount and 15] = TRUE then
  377. begin
  378. DirectPutPixelClip(PixelCount,y2+i);
  379. end;
  380. end;
  381. end;
  382. end
  383. else
  384. if x1 = x2 then
  385. Begin
  386. { Check if we must swap }
  387. if y1 >= y2 then
  388. Begin
  389. swtmp := y1;
  390. y1 := y2;
  391. y2 := swtmp;
  392. end;
  393. if LineInfo.Thickness = NormWidth then
  394. Begin
  395. for PixelCount:=y1 to y2 do
  396. { compare if we should plot a pixel here , compare }
  397. { with predefined line patterns... }
  398. if LinePatterns[PixelCount and 15] = TRUE then
  399. begin
  400. DirectPutPixel(x1,PixelCount);
  401. end;
  402. end
  403. else
  404. Begin
  405. for i:=-1 to 1 do
  406. Begin
  407. for PixelCount:=y1 to y2 do
  408. { compare if we should plot a pixel here , compare }
  409. { with predefined line patterns... }
  410. if LinePatterns[PixelCount and 15] = TRUE then
  411. begin
  412. DirectPutPixelClip(x1+i,PixelCount);
  413. end;
  414. end;
  415. end;
  416. end
  417. else
  418. Begin
  419. oldCurrentColor := CurrentColor;
  420. { Calculate deltax and deltay for initialisation }
  421. deltax := abs(x2 - x1);
  422. deltay := abs(y2 - y1);
  423. { Initialize all vars based on which is the independent variable }
  424. if deltax >= deltay then
  425. begin
  426. Flag := FALSE;
  427. { x is independent variable }
  428. numpixels := deltax + 1;
  429. d := (2 * deltay) - deltax;
  430. dinc1 := deltay Shl 1;
  431. dinc2 := (deltay - deltax) shl 1;
  432. xinc1 := 1;
  433. xinc2 := 1;
  434. yinc1 := 0;
  435. yinc2 := 1;
  436. end
  437. else
  438. begin
  439. Flag := TRUE;
  440. { y is independent variable }
  441. numpixels := deltay + 1;
  442. d := (2 * deltax) - deltay;
  443. dinc1 := deltax Shl 1;
  444. dinc2 := (deltax - deltay) shl 1;
  445. xinc1 := 0;
  446. xinc2 := 1;
  447. yinc1 := 1;
  448. yinc2 := 1;
  449. end;
  450. { Make sure x and y move in the right directions }
  451. if x1 > x2 then
  452. begin
  453. xinc1 := - xinc1;
  454. xinc2 := - xinc2;
  455. end;
  456. if y1 > y2 then
  457. begin
  458. yinc1 := - yinc1;
  459. yinc2 := - yinc2;
  460. end;
  461. { Start drawing at <x1, y1> }
  462. x := x1;
  463. y := y1;
  464. If LineInfo.Thickness=ThickWidth then
  465. Begin
  466. TmpNumPixels := NumPixels-1;
  467. { Draw the pixels }
  468. for i := 0 to TmpNumPixels do
  469. begin
  470. { all depending on the slope, we can determine }
  471. { in what direction the extra width pixels will be put }
  472. If Flag then
  473. Begin
  474. { compare if we should plot a pixel here , compare }
  475. { with predefined line patterns... }
  476. if LinePatterns[i and 15] = TRUE then
  477. begin
  478. DirectPutPixelClip(x-1,y);
  479. DirectPutPixelClip(x,y);
  480. DirectPutPixelClip(x+1,y);
  481. end;
  482. end
  483. else
  484. Begin
  485. { compare if we should plot a pixel here , compare }
  486. { with predefined line patterns... }
  487. if LinePatterns[i and 15] = TRUE then
  488. begin
  489. DirectPutPixelClip(x,y-1);
  490. DirectPutPixelClip(x,y);
  491. DirectPutPixelClip(x,y+1);
  492. end;
  493. end;
  494. if d < 0 then
  495. begin
  496. d := d + dinc1;
  497. x := x + xinc1;
  498. y := y + yinc1;
  499. end
  500. else
  501. begin
  502. d := d + dinc2;
  503. x := x + xinc2;
  504. y := y + yinc2;
  505. end;
  506. end;
  507. end
  508. else
  509. Begin
  510. { instead of putting in loop , substract by one now }
  511. TmpNumPixels := NumPixels-1;
  512. { NormWidth }
  513. for i := 0 to TmpNumPixels do
  514. begin
  515. if LinePatterns[i and 15] = TRUE then
  516. begin
  517. DirectPutPixel(x,y);
  518. end;
  519. if d < 0 then
  520. begin
  521. d := d + dinc1;
  522. x := x + xinc1;
  523. y := y + yinc1;
  524. end
  525. else
  526. begin
  527. d := d + dinc2;
  528. x := x + xinc2;
  529. y := y + yinc2;
  530. end;
  531. end;
  532. end
  533. end;
  534. {******************************************}
  535. { end patterned lines }
  536. {******************************************}
  537. { restore color }
  538. CurrentColor:=OldCurrentColor;
  539. end;
  540. end; { Line }
  541. {********************************************************}
  542. { Procedure DummyPatternLine() }
  543. {--------------------------------------------------------}
  544. { This is suimply an procedure that does nothing which }
  545. { can be passed as a patternlineproc for non-filled }
  546. { ellipses }
  547. {********************************************************}
  548. Procedure DummyPatternLine(x1, x2, y: smallint); {$ifdef tp} far; {$endif tp}
  549. begin
  550. end;
  551. {********************************************************}
  552. { Procedure InternalEllipse() }
  553. {--------------------------------------------------------}
  554. { This routine first calculates all points required to }
  555. { draw a circle to the screen, and stores the points }
  556. { to display in a buffer before plotting them. The }
  557. { aspect ratio of the screen is taken into account when }
  558. { calculating the values. }
  559. {--------------------------------------------------------}
  560. { INPUTS: X,Y : Center coordinates of Ellipse. }
  561. { XRadius - X-Axis radius of ellipse. }
  562. { YRadius - Y-Axis radius of ellipse. }
  563. { stAngle, EndAngle: Start angle and end angles of the }
  564. { ellipse (used for partial ellipses and circles) }
  565. { pl: procedure which either draws a patternline (for }
  566. { FillEllipse) or does nothing (arc etc) }
  567. {--------------------------------------------------------}
  568. { NOTE: - }
  569. { - }
  570. {********************************************************}
  571. Procedure InternalEllipseDefault(X,Y: smallint;XRadius: word;
  572. YRadius:word; stAngle,EndAngle: word; pl: PatternLineProc); {$ifndef fpc}far;{$endif fpc}
  573. Const ConvFac = Pi/180.0;
  574. var
  575. j, Delta, DeltaEnd: graph_float;
  576. NumOfPixels: longint;
  577. TempTerm: graph_float;
  578. xtemp, ytemp, xp, yp, xm, ym, xnext, ynext,
  579. plxpyp, plxmyp, plxpym, plxmym: smallint;
  580. BackupColor, TmpAngle, OldLineWidth: word;
  581. Begin
  582. If LineInfo.ThickNess = ThickWidth Then
  583. { first draw the two outer ellipses using normwidth and no filling (JM) }
  584. Begin
  585. OldLineWidth := LineInfo.Thickness;
  586. LineInfo.Thickness := NormWidth;
  587. InternalEllipseDefault(x,y,XRadius,YRadius,StAngle,EndAngle,
  588. {$ifdef fpc}@{$endif fpc}DummyPatternLine);
  589. InternalEllipseDefault(x,y,XRadius+1,YRadius+1,StAngle,EndAngle,
  590. {$ifdef fpc}@{$endif fpc}DummyPatternLine);
  591. If (XRadius > 0) and (YRadius > 0) Then
  592. { draw the smallest ellipse last, since that one will use the }
  593. { original pl, so it could possibly draw patternlines (JM) }
  594. Begin
  595. Dec(XRadius);
  596. Dec(YRadius);
  597. End
  598. Else Exit;
  599. { restore line thickness }
  600. LineInfo.Thickness := OldLineWidth;
  601. End;
  602. { Adjust for screen aspect ratio }
  603. XRadius:=(longint(XRadius)*10000) div XAspect;
  604. YRadius:=(longint(YRadius)*10000) div YAspect;
  605. If xradius = 0 then inc(xradius);
  606. if yradius = 0 then inc(yradius);
  607. { check for an ellipse with negligable x and y radius }
  608. If (xradius <= 1) and (yradius <= 1) then
  609. begin
  610. putpixel(x,y,CurrentColor);
  611. ArcCall.X := X;
  612. ArcCall.Y := Y;
  613. ArcCall.XStart := X;
  614. ArcCall.YStart := Y;
  615. ArcCall.XEnd := X;
  616. ArcCall.YEnd := Y;
  617. exit;
  618. end;
  619. { check if valid angles }
  620. stangle := stAngle mod 361;
  621. EndAngle := EndAngle mod 361;
  622. { if impossible angles then swap them! }
  623. if Endangle < StAngle then
  624. Begin
  625. TmpAngle:=EndAngle;
  626. EndAngle:=StAngle;
  627. Stangle:=TmpAngle;
  628. end;
  629. { approximate the number of pixels required by using the circumference }
  630. { equation of an ellipse. }
  631. { Changed this formula a it (trial and error), but the net result is that }
  632. { less pixels have to be calculated now }
  633. NumOfPixels:=Round(Sqrt(3)*sqrt(sqr(XRadius)+sqr(YRadius)));
  634. { Calculate the angle precision required }
  635. Delta := 90.0 / NumOfPixels;
  636. { for restoring after PatternLine }
  637. BackupColor := CurrentColor;
  638. { removed from inner loop to make faster }
  639. { store some arccall info }
  640. ArcCall.X := X;
  641. ArcCall.Y := Y;
  642. TempTerm := (StAngle)*ConvFac;
  643. ArcCall.XStart := round(XRadius*Cos(TempTerm)) + X;
  644. ArcCall.YStart := round(YRadius*Sin(TempTerm+Pi)) + Y;
  645. TempTerm := (EndAngle)*ConvFac;
  646. ArcCall.XEnd := round(XRadius*Cos(TempTerm)) + X;
  647. ArcCall.YEnd := round(YRadius*Sin(TempTerm+Pi)) + Y;
  648. { Always just go over the first 90 degrees. Could be optimized a }
  649. { bit if StAngle and EndAngle lie in the same quadrant, left as an }
  650. { exercise for the reader :) (JM) }
  651. j := 0;
  652. { calculate stop position, go 1 further than 90 because otherwise }
  653. { 1 pixel is sometimes not drawn (JM) }
  654. DeltaEnd := 91;
  655. { Calculate points }
  656. xnext := XRadius;
  657. ynext := 0;
  658. Repeat
  659. xtemp := xnext;
  660. ytemp := ynext;
  661. { this is used by both sin and cos }
  662. TempTerm := (j+Delta)*ConvFac;
  663. { Calculate points }
  664. xnext := round(XRadius*Cos(TempTerm));
  665. ynext := round(YRadius*Sin(TempTerm+Pi));
  666. xp := x + xtemp;
  667. xm := x - xtemp;
  668. yp := y + ytemp;
  669. ym := y - ytemp;
  670. plxpyp := maxsmallint;
  671. plxmyp := -maxsmallint-1;
  672. plxpym := maxsmallint;
  673. plxmym := -maxsmallint-1;
  674. If (j >= StAngle) and (j <= EndAngle) then
  675. begin
  676. plxpyp := xp;
  677. PutPixel(xp,yp,CurrentColor);
  678. end;
  679. If ((180-j) >= StAngle) and ((180-j) <= EndAngle) then
  680. begin
  681. plxmyp := xm;
  682. PutPixel(xm,yp,CurrentColor);
  683. end;
  684. If ((j+180) >= StAngle) and ((j+180) <= EndAngle) then
  685. begin
  686. plxmym := xm;
  687. PutPixel(xm,ym,CurrentColor);
  688. end;
  689. If ((360-j) >= StAngle) and ((360-j) <= EndAngle) then
  690. begin
  691. plxpym := xp;
  692. PutPixel(xp,ym,CurrentColor);
  693. end;
  694. If (ynext <> ytemp) and
  695. (xp - xm >= 1) then
  696. begin
  697. CurrentColor := FillSettings.Color;
  698. pl(plxmyp+1,plxpyp-1,yp);
  699. pl(plxmym+1,plxpym-1,ym);
  700. CurrentColor := BackupColor;
  701. end;
  702. j:=j+Delta;
  703. Until j > (DeltaEnd);
  704. end;
  705. {********************************************************}
  706. { Procedure InternalEllipse() }
  707. {--------------------------------------------------------}
  708. { This routine first calculates all points required to }
  709. { draw a circle to the screen, and stores the points }
  710. { to display in a buffer before plotting them. The }
  711. { aspect ratio of the screen is taken into account when }
  712. { calculating the values. }
  713. {--------------------------------------------------------}
  714. { INPUTS: X,Y : Center coordinates of Ellipse. }
  715. { XRadius - X-Axis radius of ellipse. }
  716. { YRadius - Y-Axis radius of ellipse. }
  717. { stAngle, EndAngle: Start angle and end angles of the }
  718. { ellipse (used for partial ellipses and circles) }
  719. {--------------------------------------------------------}
  720. { NOTE: - uses the current write mode. }
  721. { - Angles must both be between 0 and 360 }
  722. {********************************************************}
  723. (*
  724. Procedure InternalEllipseDefault (x, y : smallint;
  725. xradius, yradius, stAngle, EndAngle : Word; pl: PatternLineProc); {$ifndef fpc} far; {$endif fpc}
  726. { Draw an ellipse arc. Crude but it works (anyone have a better one?) }
  727. Var
  728. aSqr, bSqr, twoaSqr, twobSqr, xa, ya, twoXbSqr, twoYaSqr, error : LongInt;
  729. Alpha, TempTerm : graph_float;
  730. BackupColor: Word;
  731. plxpyp, plxmyp, plxpym, plxmym: smallint;
  732. const
  733. RadToDeg = 180/Pi;
  734. Procedure PlotPoints;
  735. var
  736. i,j: smallint;
  737. xm, ym: smallint;
  738. xp, yp: smallint;
  739. Begin
  740. ym := y-ya;
  741. yp := y+ya;
  742. xm := x-xa;
  743. xp := x+xa;
  744. plxpyp := maxsmallint;
  745. plxmyp := -maxsmallint-1;
  746. plxpym := maxsmallint;
  747. plxmym := -maxsmallint-1;
  748. if LineInfo.Thickness = Normwidth then
  749. Begin
  750. If (Alpha+270>=StAngle) And (Alpha+270<=EndAngle) then
  751. Begin
  752. plxmym := xm;
  753. PutPixel (xm,ym, CurrentColor);
  754. End;
  755. If ((180+270)-Alpha>=StAngle) And ((180+270)-Alpha<=EndAngle) then
  756. Begin
  757. plxmyp := xm;
  758. PutPixel (xm,yp, CurrentColor);
  759. End;
  760. If ((180+270)+Alpha>=StAngle) And ((180+270)+Alpha<=EndAngle) then
  761. Begin
  762. plxpyp := xp;
  763. PutPixel (xp,yp, CurrentColor);
  764. End;
  765. If ((360+270)-Alpha>=StAngle) And ((360+270)-Alpha<=EndAngle) then
  766. Begin
  767. plxpym := xp;
  768. PutPixel (xp,ym, CurrentColor);
  769. End;
  770. end
  771. else
  772. Begin
  773. If (Alpha+270>=StAngle) And (Alpha+270<=EndAngle) then
  774. Begin
  775. plxmym := xm + 1;
  776. for i:=-1 to 1 do
  777. for j:=-1 to 1 do
  778. PutPixel (xm+i,ym+j, CurrentColor);
  779. End;
  780. If ((180+270)-Alpha>=StAngle) And ((180+270)-Alpha<=EndAngle) then
  781. Begin
  782. plxmyp := xm + 1;
  783. for i:=-1 to 1 do
  784. for j:=-1 to 1 do
  785. PutPixel (xm+i,yp+j, CurrentColor);
  786. End;
  787. If ((180+270)+Alpha>=StAngle) And ((180+270)+Alpha<=EndAngle) then
  788. Begin
  789. plxpyp := xp - 1;
  790. for i:=-1 to 1 do
  791. for j:=-1 to 1 do
  792. PutPixel (xp+i,yp+j, CurrentColor);
  793. End;
  794. If ((360+270)-Alpha>=StAngle) And ((360+270)-Alpha<=EndAngle) then
  795. Begin
  796. plxpym := xp - 1;
  797. for i:=-1 to 1 do
  798. for j:=-1 to 1 do
  799. PutPixel (xp+i,ym+j, CurrentColor);
  800. End;
  801. end;
  802. If (xp <> xm) then
  803. begin
  804. CurrentColor := FillSettings.Color;
  805. pl(plxmyp+1,plxpyp-1,yp);
  806. pl(plxmym+1,plxpym-1,ym);
  807. CurrentColor := BackupColor;
  808. end;
  809. End;
  810. Begin
  811. { check for an ellipse with negligable x and y radius }
  812. If (xradius <= 1) and (yradius <= 1) then
  813. begin
  814. putpixel(x,y,CurrentColor);
  815. ArcCall.X := X;
  816. ArcCall.Y := Y;
  817. ArcCall.XStart := X;
  818. ArcCall.YStart := Y;
  819. ArcCall.XEnd := X;
  820. ArcCall.YEnd := Y;
  821. exit;
  822. end;
  823. { for restoring after PatternLine }
  824. BackupColor := CurrentColor;
  825. If xradius = 0 then inc(xradius);
  826. if yradius = 0 then inc(yradius);
  827. { store arccall info }
  828. ArcCall.x := x;
  829. ArcCall.y := y;
  830. TempTerm := StAngle*RadToDeg;
  831. ArcCall.XStart := round(XRadius*Cos(TempTerm)) + X;
  832. ArcCall.YStart := round(YRadius*Sin(TempTerm+Pi)) + Y;
  833. TempTerm := EndAngle*RadToDeg;
  834. ArcCall.XEnd := round(XRadius*Cos(TempTerm)) + X;
  835. ArcCall.YEnd := round(YRadius*Sin(TempTerm+Pi)) + Y;
  836. StAngle:=StAngle MOD 361;
  837. EndAngle:=EndAngle MOD 361;
  838. StAngle := StAngle + 270;
  839. EndAngle := EndAngle + 270;
  840. If StAngle>EndAngle then
  841. Begin
  842. StAngle:=StAngle Xor EndAngle; EndAngle:=EndAngle Xor StAngle; StAngle:=EndAngle Xor StAngle;
  843. End;
  844. { Adjust for screen aspect ratio }
  845. XRadius:=(longint(XRadius)*10000) div XAspect;
  846. YRadius:=(longint(YRadius)*10000) div YAspect;
  847. aSqr:=LongInt (xradius)*LongInt (xradius);
  848. bSqr:=LongInt (yradius)*LongInt (yradius);
  849. twoaSqr:=2*aSqr;
  850. twobSqr:=2*bSqr;
  851. xa:=0;
  852. ya:=yradius;
  853. twoXbSqr:=0;
  854. twoYaSqr:=ya*twoaSqr;
  855. error:=-ya*aSqr;
  856. While twoXbSqr<=twoYaSqr Do Begin
  857. If ya=0 then Alpha:=90 Else Alpha:=RadToDeg*Arctan (xa/ya); { Crude but it works }
  858. PlotPoints;
  859. Inc (xa);
  860. Inc (twoXbSqr,twobSqr);
  861. Inc (error,twoXbSqr-bSqr);
  862. If error>=0 then Begin
  863. Dec (ya);
  864. Dec (twoYaSqr,twoaSqr);
  865. Dec (error,twoYaSqr);
  866. End;
  867. End;
  868. xa:=xradius;
  869. ya:=0;
  870. twoXbSqr:=xa*twobSqr;
  871. twoYaSqr:=0;
  872. error:=-xa*bSqr;
  873. While twoXbSqr>twoYaSqr Do Begin
  874. If ya=0 then Alpha:=90 Else Alpha:=RadToDeg*Arctan (xa/ya);
  875. PlotPoints;
  876. Inc (ya);
  877. Inc (twoYaSqr,twoaSqr);
  878. Inc (error,twoYaSqr-aSqr);
  879. If error>=0 then Begin
  880. Dec (xa);
  881. Dec (twoXbSqr,twobSqr);
  882. Dec (error,twoXbSqr);
  883. End;
  884. End;
  885. End;
  886. *)
  887. procedure PatternLineDefault(x1,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
  888. {********************************************************}
  889. { Draws a horizontal patterned line according to the }
  890. { current Fill Settings. }
  891. {********************************************************}
  892. { Important notes: }
  893. { - CurrentColor must be set correctly before entering }
  894. { this routine. }
  895. {********************************************************}
  896. var
  897. NrIterations: smallint;
  898. i : smallint;
  899. j : smallint;
  900. TmpFillPattern : byte;
  901. OldWriteMode : word;
  902. OldCurrentColor : word;
  903. begin
  904. { convert to global coordinates ... }
  905. x1 := x1 + StartXViewPort;
  906. x2 := x2 + StartXViewPort;
  907. y := y + StartYViewPort;
  908. { if line was fully clipped then exit...}
  909. if LineClipped(x1,y,x2,y,StartXViewPort,StartYViewPort,
  910. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  911. exit;
  912. OldWriteMode := CurrentWriteMode;
  913. CurrentWriteMode := NormalPut;
  914. { Get the current pattern }
  915. TmpFillPattern := FillPatternTable
  916. [FillSettings.Pattern][(y and $7)+1];
  917. Case TmpFillPattern Of
  918. 0:
  919. begin
  920. OldCurrentColor := CurrentColor;
  921. CurrentColor := CurrentBkColor;
  922. { hline converts the coordinates to global ones, but that has been done }
  923. { already here!!! Convert them back to local ones... (JM) }
  924. HLine(x1-StartXViewPort,x2-StartXViewPort,y-StartYViewPort);
  925. CurrentColor := OldCurrentColor;
  926. end;
  927. $ff:
  928. begin
  929. HLine(x1-StartXViewPort,x2-StartXViewPort,y-StartYViewPort);
  930. end;
  931. else
  932. begin
  933. { number of times to go throuh the 8x8 pattern }
  934. NrIterations := abs(x2 - x1+8) div 8;
  935. For i:= 0 to NrIterations do
  936. Begin
  937. for j:=0 to 7 do
  938. Begin
  939. { x1 mod 8 }
  940. if RevBitArray[x1 and 7] and TmpFillPattern <> 0 then
  941. DirectPutpixel(x1,y)
  942. else
  943. begin
  944. { According to the TP graph manual, we overwrite everything }
  945. { which is filled up - checked against VGA and CGA drivers }
  946. { of TP. }
  947. OldCurrentColor := CurrentColor;
  948. CurrentColor := CurrentBkColor;
  949. DirectPutPixel(x1,y);
  950. CurrentColor := OldCurrentColor;
  951. end;
  952. Inc(x1);
  953. if x1 > x2 then
  954. begin
  955. CurrentWriteMode := OldWriteMode;
  956. exit;
  957. end;
  958. end;
  959. end;
  960. end;
  961. End;
  962. CurrentWriteMode := OldWriteMode;
  963. end;
  964. procedure LineRel(Dx, Dy: smallint);
  965. Begin
  966. Line(CurrentX, CurrentY, CurrentX + Dx, CurrentY + Dy);
  967. CurrentX := CurrentX + Dx;
  968. CurrentY := CurrentY + Dy;
  969. end;
  970. procedure LineTo(x,y : smallint);
  971. Begin
  972. Line(CurrentX, CurrentY, X, Y);
  973. CurrentX := X;
  974. CurrentY := Y;
  975. end;
  976. procedure Rectangle(x1,y1,x2,y2:smallint);
  977. begin
  978. { Do not draw the end points }
  979. Line(x1,y1,x2-1,y1);
  980. Line(x1,y1+1,x1,y2);
  981. Line(x2,y1,x2,y2-1);
  982. Line(x1+1,y2,x2,y2);
  983. end;
  984. procedure GetLineSettings(var ActiveLineInfo : LineSettingsType);
  985. begin
  986. Activelineinfo:=Lineinfo;
  987. end;
  988. procedure SetLineStyle(LineStyle: word; Pattern: word; Thickness: word);
  989. var
  990. i: byte;
  991. j: byte;
  992. Begin
  993. if (LineStyle > UserBitLn) or ((Thickness <> Normwidth) and (Thickness <> ThickWidth)) then
  994. _GraphResult := grError
  995. else
  996. begin
  997. LineInfo.Thickness := Thickness;
  998. LineInfo.LineStyle := LineStyle;
  999. case LineStyle of
  1000. UserBitLn: Lineinfo.Pattern := pattern;
  1001. SolidLn: Lineinfo.Pattern := $ffff; { ------- }
  1002. DashedLn : Lineinfo.Pattern := $F8F8; { -- -- --}
  1003. DottedLn: LineInfo.Pattern := $CCCC; { - - - - }
  1004. CenterLn: LineInfo.Pattern := $FC78; { -- - -- }
  1005. end; { end case }
  1006. { setup pattern styles }
  1007. j:=16;
  1008. for i:=0 to 15 do
  1009. Begin
  1010. dec(j);
  1011. { bitwise mask for each bit in the word }
  1012. if (word($01 shl i) AND LineInfo.Pattern) <> 0 then
  1013. LinePatterns[j]:=TRUE
  1014. else
  1015. LinePatterns[j]:=FALSE;
  1016. end;
  1017. end;
  1018. end;
  1019. {--------------------------------------------------------------------------}
  1020. { }
  1021. { VIEWPORT RELATED ROUTINES }
  1022. { }
  1023. {--------------------------------------------------------------------------}
  1024. Procedure ClearViewPortDefault; {$ifndef fpc}far;{$endif fpc}
  1025. var
  1026. j: smallint;
  1027. OldWriteMode, OldCurColor: word;
  1028. LineSets : LineSettingsType;
  1029. Begin
  1030. { CP is always RELATIVE coordinates }
  1031. CurrentX := 0;
  1032. CurrentY := 0;
  1033. { Save all old settings }
  1034. OldCurColor := CurrentColor;
  1035. CurrentColor:=CurrentBkColor;
  1036. OldWriteMode:=CurrentWriteMode;
  1037. CurrentWriteMode:=NormalPut;
  1038. GetLineSettings(LineSets);
  1039. { reset to normal line style...}
  1040. SetLineStyle(SolidLn, 0, NormWidth);
  1041. { routines are relative here...}
  1042. { ViewHeight is Height-1 ! }
  1043. for J:=0 to ViewHeight do
  1044. HLine(0, ViewWidth , J);
  1045. { restore old settings...}
  1046. SetLineStyle(LineSets.LineStyle, LineSets.Pattern, LineSets.Thickness);
  1047. CurrentColor := OldCurColor;
  1048. CurrentWriteMode := OldWriteMode;
  1049. end;
  1050. Procedure SetViewPort(X1, Y1, X2, Y2: smallint; Clip: Boolean);
  1051. Begin
  1052. if (X1 > GetMaxX) or (X2 > GetMaxX) or (X1 > X2) or (X1 < 0) then
  1053. Begin
  1054. _GraphResult := grError;
  1055. exit;
  1056. end;
  1057. if (Y1 > GetMaxY) or (Y2 > GetMaxY) or (Y1 > Y2) or (Y1 < 0) then
  1058. Begin
  1059. _GraphResult := grError;
  1060. exit;
  1061. end;
  1062. { CP is always RELATIVE coordinates }
  1063. CurrentX := 0;
  1064. CurrentY := 0;
  1065. StartXViewPort := X1;
  1066. StartYViewPort := Y1;
  1067. ViewWidth := X2-X1;
  1068. ViewHeight:= Y2-Y1;
  1069. ClipPixels := Clip;
  1070. end;
  1071. procedure GetViewSettings(var viewport : ViewPortType);
  1072. begin
  1073. ViewPort.X1 := StartXViewPort;
  1074. ViewPort.Y1 := StartYViewPort;
  1075. ViewPort.X2 := ViewWidth + StartXViewPort;
  1076. ViewPort.Y2 := ViewHeight + StartYViewPort;
  1077. ViewPort.Clip := ClipPixels;
  1078. end;
  1079. procedure ClearDevice;
  1080. var
  1081. ViewPort: ViewPortType;
  1082. begin
  1083. { Reset the CP }
  1084. CurrentX := 0;
  1085. CurrentY := 0;
  1086. { save viewport }
  1087. ViewPort.X1 := StartXviewPort;
  1088. ViewPort.X2 := ViewWidth - StartXViewPort;
  1089. ViewPort.Y1 := StartYViewPort;
  1090. ViewPort.Y2 := ViewHeight - StartYViewPort;
  1091. ViewPort.Clip := ClipPixels;
  1092. { put viewport to full screen }
  1093. StartXViewPort := 0;
  1094. ViewHeight := MaxY;
  1095. StartYViewPort := 0;
  1096. ViewWidth := MaxX;
  1097. ClipPixels := TRUE;
  1098. ClearViewPort;
  1099. { restore old viewport }
  1100. StartXViewPort := ViewPort.X1;
  1101. ViewWidth := ViewPort.X2-ViewPort.X1;
  1102. StartYViewPort := ViewPort.Y1;
  1103. ViewHeight := ViewPort.Y2-ViewPort.Y1;
  1104. ClipPixels := ViewPort.Clip;
  1105. end;
  1106. {--------------------------------------------------------------------------}
  1107. { }
  1108. { BITMAP PUT/GET ROUTINES }
  1109. { }
  1110. {--------------------------------------------------------------------------}
  1111. Procedure GetScanlineDefault (X1, X2, Y : smallint; Var Data); {$ifndef fpc}far;{$endif fpc}
  1112. {**********************************************************}
  1113. { Procedure GetScanLine() }
  1114. {----------------------------------------------------------}
  1115. { Returns the full scanline of the video line of the Y }
  1116. { coordinate. The values are returned in a WORD array }
  1117. { each WORD representing a pixel of the specified scanline }
  1118. { note: we only need the pixels inside the ViewPort! (JM) }
  1119. { note2: extended so you can specify start and end X coord }
  1120. { so it is usable for GetImage too (JM) }
  1121. {**********************************************************}
  1122. Var
  1123. x : smallint;
  1124. Begin
  1125. For x:=X1 to X2 Do
  1126. WordArray(Data)[x-x1]:=GetPixel(x, y);
  1127. End;
  1128. Function DefaultImageSize(X1,Y1,X2,Y2: smallint): longint; {$ifndef fpc}far;{$endif fpc}
  1129. Begin
  1130. { each pixel uses two bytes, to enable modes with colors up to 64K }
  1131. { to work. }
  1132. DefaultImageSize := 12 + (((X2-X1+1)*(Y2-Y1+1))*2);
  1133. end;
  1134. Procedure DefaultPutImage(X,Y: smallint; var Bitmap; BitBlt: Word); {$ifndef fpc}far;{$endif fpc}
  1135. type
  1136. pt = array[0..$fffffff] of word;
  1137. ptw = array[0..2] of longint;
  1138. var
  1139. k: longint;
  1140. oldCurrentColor: word;
  1141. oldCurrentWriteMode, i, j, y1, x1, deltaX, deltaX1, deltaY: smallint;
  1142. Begin
  1143. {$ifdef logging}
  1144. LogLn('putImage at ('+strf(x)+','+strf(y)+') with width '+strf(ptw(Bitmap)[0])+
  1145. ' and height '+strf(ptw(Bitmap)[1]));
  1146. deltaY := 0;
  1147. {$endif logging}
  1148. inc(x,startXViewPort);
  1149. inc(y,startYViewPort);
  1150. x1 := ptw(Bitmap)[0]+x; { get width and adjust end coordinate accordingly }
  1151. y1 := ptw(Bitmap)[1]+y; { get height and adjust end coordinate accordingly }
  1152. deltaX := 0;
  1153. deltaX1 := 0;
  1154. k := 3 * sizeOf(Longint) div sizeOf(Word); { Three reserved longs at start of bitmap }
  1155. { check which part of the image is in the viewport }
  1156. if clipPixels then
  1157. begin
  1158. if y < startYViewPort then
  1159. begin
  1160. deltaY := startYViewPort - y;
  1161. inc(k,(x1-x+1)*deltaY);
  1162. y := startYViewPort;
  1163. end;
  1164. if y1 > startYViewPort+viewHeight then
  1165. y1 := startYViewPort+viewHeight;
  1166. if x < startXViewPort then
  1167. begin
  1168. deltaX := startXViewPort-x;
  1169. x := startXViewPort;
  1170. end;
  1171. if x1 > startXViewPort + viewWidth then
  1172. begin
  1173. deltaX1 := x1 - (startXViewPort + viewWidth);
  1174. x1 := startXViewPort + viewWidth;
  1175. end;
  1176. end;
  1177. {$ifdef logging}
  1178. LogLn('deltax: '+strf(deltax)+', deltax1: '+strf(deltax1)+',deltay: '+strf(deltay));
  1179. {$endif logging}
  1180. oldCurrentColor := currentColor;
  1181. oldCurrentWriteMode := currentWriteMode;
  1182. currentWriteMode := bitBlt;
  1183. for j:=Y to Y1 do
  1184. Begin
  1185. inc(k,deltaX);
  1186. for i:=X to X1 do
  1187. begin
  1188. currentColor := pt(bitmap)[k];
  1189. directPutPixel(i,j);
  1190. inc(k);
  1191. end;
  1192. inc(k,deltaX1);
  1193. end;
  1194. currentWriteMode := oldCurrentWriteMode;
  1195. currentColor := oldCurrentColor;
  1196. end;
  1197. Procedure DefaultGetImage(X1,Y1,X2,Y2: smallint; Var Bitmap); {$ifndef fpc}far;{$endif fpc}
  1198. type
  1199. pt = array[0..$fffffff] of word;
  1200. ptw = array[0..2] of longint;
  1201. var
  1202. i,j: smallint;
  1203. k: longint;
  1204. Begin
  1205. k:= 3 * Sizeof(longint) div sizeof(word); { Three reserved longs at start of bitmap }
  1206. i := x2 - x1 + 1;
  1207. for j:=Y1 to Y2 do
  1208. Begin
  1209. GetScanLine(x1,x2,j,pt(Bitmap)[k]);
  1210. inc(k,i);
  1211. end;
  1212. ptw(Bitmap)[0] := X2-X1; { First longint is width }
  1213. ptw(Bitmap)[1] := Y2-Y1; { Second longint is height }
  1214. ptw(bitmap)[2] := 0; { Third longint is reserved}
  1215. end;
  1216. Procedure GetArcCoords(var ArcCoords: ArcCoordsType);
  1217. Begin
  1218. ArcCoords.X := ArcCall.X;
  1219. ArcCoords.Y := ArcCall.Y;
  1220. ArcCoords.XStart := ArcCall.XStart;
  1221. ArcCoords.YStart := ArcCall.YStart;
  1222. ArcCoords.XEnd := ArcCall.XEnd;
  1223. ArcCoords.YEnd := ArcCall.YEnd;
  1224. end;
  1225. procedure SetVisualPageDefault(page : word); {$ifndef fpc}far;{$endif fpc}
  1226. begin
  1227. end;
  1228. procedure SetActivePageDefault(page : word); {$ifndef fpc}far;{$endif fpc}
  1229. begin
  1230. end;
  1231. procedure DirectPutPixelDefault(X,Y: smallint);
  1232. begin
  1233. RunError(218);
  1234. end;
  1235. function GetPixelDefault(X,Y: smallint): word;
  1236. begin
  1237. RunError(218);
  1238. exit(0); { avoid warning }
  1239. end;
  1240. procedure PutPixelDefault(X,Y: smallint; Color: Word);
  1241. begin
  1242. RunError(218);
  1243. end;
  1244. procedure SetRGBPaletteDefault(ColorNum, RedValue, GreenValue, BlueValue: smallint);
  1245. begin
  1246. RunError(218);
  1247. end;
  1248. procedure GetRGBPaletteDefault(ColorNum: smallint; var
  1249. RedValue, GreenValue, BlueValue: smallint);
  1250. begin
  1251. RunError(218);
  1252. end;
  1253. Procedure DefaultHooks;
  1254. {********************************************************}
  1255. { Procedure DefaultHooks() }
  1256. {--------------------------------------------------------}
  1257. { Resets all hookable routine either to nil for those }
  1258. { which need overrides, and others to defaults. }
  1259. { This is called each time SetGraphMode() is called. }
  1260. {********************************************************}
  1261. Begin
  1262. { All default hooks procedures }
  1263. { required...}
  1264. DirectPutPixel := {$ifdef fpc}@{$endif}DirectPutPixelDefault;
  1265. PutPixel := {$ifdef fpc}@{$endif}PutPixelDefault;
  1266. GetPixel := {$ifdef fpc}@{$endif}GetPixelDefault;
  1267. SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteDefault;
  1268. GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteDefault;
  1269. { optional...}
  1270. SetActivePage := {$ifdef fpc}@{$endif}SetActivePageDefault;
  1271. SetVisualPage := {$ifdef fpc}@{$endif}SetVisualPageDefault;
  1272. ClearViewPort := {$ifdef fpc}@{$endif}ClearViewportDefault;
  1273. PutImage := {$ifdef fpc}@{$endif}DefaultPutImage;
  1274. GetImage := {$ifdef fpc}@{$endif}DefaultGetImage;
  1275. ImageSize := {$ifdef fpc}@{$endif}DefaultImageSize;
  1276. GraphFreeMemPtr := nil;
  1277. GraphGetMemPtr := nil;
  1278. GetScanLine := {$ifdef fpc}@{$endif}GetScanLineDefault;
  1279. Line := {$ifdef fpc}@{$endif}LineDefault;
  1280. InternalEllipse := {$ifdef fpc}@{$endif}InternalEllipseDefault;
  1281. PatternLine := {$ifdef fpc}@{$endif}PatternLineDefault;
  1282. HLine := {$ifdef fpc}@{$endif}HLineDefault;
  1283. VLine := {$ifdef fpc}@{$endif}VLineDefault;
  1284. end;
  1285. Procedure InitVars;
  1286. {********************************************************}
  1287. { Procedure InitVars() }
  1288. {--------------------------------------------------------}
  1289. { Resets all internal variables, and resets all }
  1290. { overridable routines. }
  1291. {********************************************************}
  1292. Begin
  1293. DirectVideo := TRUE; { By default use fastest access possible }
  1294. ArcCall.X := 0;
  1295. ArcCall.Y := 0;
  1296. ArcCall.XStart := 0;
  1297. ArcCall.YStart := 0;
  1298. ArcCall.XEnd := 0;
  1299. ArcCall.YEnd := 0;
  1300. { Reset to default values }
  1301. IntCurrentMode := 0;
  1302. IntCurrentDriver := 0;
  1303. XAspect := 0;
  1304. YAspect := 0;
  1305. MaxX := 0;
  1306. MaxY := 0;
  1307. MaxColor := 0;
  1308. PaletteSize := 0;
  1309. DirectColor := FALSE;
  1310. HardwarePages := 0;
  1311. if hardwarepages=0 then; { remove note }
  1312. DefaultHooks;
  1313. end;
  1314. {$i modes.inc}
  1315. {$i palette.inc}
  1316. function InstallUserDriver(Name: string; AutoDetectPtr: Pointer): smallint;
  1317. begin
  1318. _graphResult := grError;
  1319. InstallUserDriver:=grError;
  1320. end;
  1321. function RegisterBGIDriver(driver: pointer): smallint;
  1322. begin
  1323. _graphResult := grError;
  1324. RegisterBGIDriver:=grError;
  1325. end;
  1326. { ----------------------------------------------------------------- }
  1327. Procedure Arc(X,Y : smallint; StAngle,EndAngle,Radius: word);
  1328. { var
  1329. OldWriteMode: word;}
  1330. Begin
  1331. { Only if we are using thickwidths lines do we accept }
  1332. { XORput write modes. }
  1333. { OldWriteMode := CurrentWriteMode;
  1334. if (LineInfo.Thickness = NormWidth) then
  1335. CurrentWriteMode := NormalPut;}
  1336. InternalEllipse(X,Y,Radius,Radius,StAngle,Endangle,{$ifdef fpc}@{$endif}DummyPatternLine);
  1337. { CurrentWriteMode := OldWriteMode;}
  1338. end;
  1339. procedure Ellipse(X,Y : smallint; stAngle, EndAngle: word; XRadius,YRadius: word);
  1340. Begin
  1341. InternalEllipse(X,Y,XRadius,YRadius,StAngle,Endangle,{$ifdef fpc}@{$endif}DummyPatternLine);
  1342. end;
  1343. procedure FillEllipse(X, Y: smallint; XRadius, YRadius: Word);
  1344. {********************************************************}
  1345. { Procedure FillEllipse() }
  1346. {--------------------------------------------------------}
  1347. { Draws a filled ellipse using (X,Y) as a center point }
  1348. { and XRadius and YRadius as the horizontal and vertical }
  1349. { axes. The ellipse is filled with the current fill color}
  1350. { and fill style, and is bordered with the current color.}
  1351. {********************************************************}
  1352. begin
  1353. InternalEllipse(X,Y,XRadius,YRadius,0,360,PatternLine)
  1354. end;
  1355. procedure Circle(X, Y: smallint; Radius:Word);
  1356. {********************************************************}
  1357. { Draws a circle centered at X,Y with the given Radius. }
  1358. {********************************************************}
  1359. { Important notes: }
  1360. { - Thickwidth circles use the current write mode, while}
  1361. { normal width circles ALWAYS use CopyPut/NormalPut }
  1362. { mode. (Tested against VGA BGI driver -CEC 13/Aug/99 }
  1363. {********************************************************}
  1364. var OriginalArcInfo: ArcCoordsType;
  1365. OldWriteMode: word;
  1366. begin
  1367. if (Radius = 0) then
  1368. Exit;
  1369. if (Radius = 1) then
  1370. begin
  1371. { only normal put mode is supported by a call to PutPixel }
  1372. PutPixel(X, Y, CurrentColor);
  1373. Exit;
  1374. end;
  1375. { save state of arc information }
  1376. { because it is not needed for }
  1377. { a circle call. }
  1378. move(ArcCall,OriginalArcInfo, sizeof(ArcCall));
  1379. if LineInfo.Thickness = Normwidth then
  1380. begin
  1381. OldWriteMode := CurrentWriteMode;
  1382. CurrentWriteMode := CopyPut;
  1383. end;
  1384. InternalEllipse(X,Y,Radius,Radius,0,360,{$ifdef fpc}@{$endif}DummyPatternLine);
  1385. if LineInfo.Thickness = Normwidth then
  1386. CurrentWriteMode := OldWriteMode;
  1387. { restore arc information }
  1388. move(OriginalArcInfo, ArcCall,sizeof(ArcCall));
  1389. end;
  1390. procedure SectorPL(x1,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
  1391. var plx1, plx2: smallint;
  1392. {$ifdef sectorpldebug}
  1393. t : text;
  1394. {$endif sectorpldebug}
  1395. begin
  1396. {$ifdef sectorpldebug}
  1397. assign(t,'sector.log');
  1398. append(t);
  1399. writeln(t,'Got here for line ',y);
  1400. close(t);
  1401. {$endif sectorpldebug}
  1402. If (x1 = -maxsmallint) Then
  1403. If (x2 = maxsmallint-1) Then
  1404. { no ellipse points drawn on this line }
  1405. If (((Y < ArcCall.Y) and (Y > ArcCall.YStart)) or
  1406. ((Y > ArcCall.Y) and (Y < ArcCall.YStart))) Then
  1407. { there is a part of the sector at this y coordinate, but no }
  1408. { ellips points are plotted on this line, so draw a patternline }
  1409. { between the lines connecting (arccall.x,arccall.y) with }
  1410. { the start and the end of the arc (JM) }
  1411. { use: y-y1=(y2-y1)/(x2-x1)*(x-x1) => }
  1412. { x = (y-y1)/(y2-y1)*(x2-x1)+x1 }
  1413. Begin
  1414. {$ifdef sectorpldebug}
  1415. If (ArcCall.YStart-ArcCall.Y) = 0 then
  1416. begin
  1417. append(t);
  1418. writeln(t,'bug1');
  1419. close(t);
  1420. runerror(202);
  1421. end;
  1422. {$endif sectorpldebug}
  1423. plx1 := (y-ArcCall.Y)*(ArcCall.XStart-ArcCall.X)
  1424. div (ArcCall.YStart-ArcCall.Y)+ArcCall.X;
  1425. {$ifdef sectorpldebug}
  1426. If (ArcCall.YEnd-ArcCall.Y) = 0 then
  1427. begin
  1428. append(t);
  1429. writeln(t,'bug2');
  1430. close(t);
  1431. runerror(202);
  1432. end;
  1433. {$endif sectorpldebug}
  1434. plx2 := (y-ArcCall.Y)*(ArcCall.XEnd-ArcCall.X)
  1435. div (ArcCall.YEnd-ArcCall.Y)+ArcCall.X;
  1436. If plx1 > plx2 then
  1437. begin
  1438. plx1 := plx1 xor plx2;
  1439. plx2 := plx1 xor plx2;
  1440. plx1 := plx1 xor plx2;
  1441. end;
  1442. {$ifdef sectorpldebug}
  1443. append(t);
  1444. writeln(t,'lines: ',plx1,' - ',plx2);
  1445. close(t);
  1446. {$endif sectorpldebug}
  1447. End
  1448. { otherwise two points which have nothing to do with the sector }
  1449. Else exit
  1450. Else
  1451. { the arc is plotted at the right side, but not at the left side, }
  1452. { fill till the line between (ArcCall.X,ArcCall.Y) and }
  1453. { (ArcCall.XStart,ArcCall.YStart) }
  1454. Begin
  1455. If (y < ArcCall.Y) then
  1456. begin
  1457. {$ifdef sectorpldebug}
  1458. If (ArcCall.YEnd-ArcCall.Y) = 0 then
  1459. begin
  1460. append(t);
  1461. writeln(t,'bug3');
  1462. close(t);
  1463. runerror(202);
  1464. end;
  1465. {$endif sectorpldebug}
  1466. plx1 := (y-ArcCall.Y)*(ArcCall.XEnd-ArcCall.X)
  1467. div (ArcCall.YEnd-ArcCall.Y)+ArcCall.X
  1468. end
  1469. else if (y > ArcCall.Y) then
  1470. begin
  1471. {$ifdef sectorpldebug}
  1472. If (ArcCall.YStart-ArcCall.Y) = 0 then
  1473. begin
  1474. append(t);
  1475. writeln(t,'bug4');
  1476. close(t);
  1477. runerror(202);
  1478. end;
  1479. {$endif sectorpldebug}
  1480. plx1 := (y-ArcCall.Y)*(ArcCall.XStart-ArcCall.X)
  1481. div (ArcCall.YStart-ArcCall.Y)+ArcCall.X
  1482. end
  1483. else plx1 := ArcCall.X;
  1484. plx2 := x2;
  1485. {$ifdef sectorpldebug}
  1486. append(t);
  1487. writeln(t,'right: ',plx1,' - ',plx2);
  1488. close(t);
  1489. {$endif sectorpldebug}
  1490. End
  1491. Else
  1492. If (x2 = maxsmallint-1) Then
  1493. { the arc is plotted at the left side, but not at the rigth side. }
  1494. { the right limit can be either the first or second line. Just take }
  1495. { the closest one, but watch out for division by zero! }
  1496. Begin
  1497. If (y < ArcCall.Y) then
  1498. begin
  1499. {$ifdef sectorpldebug}
  1500. If (ArcCall.YStart-ArcCall.Y) = 0 then
  1501. begin
  1502. append(t);
  1503. writeln(t,'bug5');
  1504. close(t);
  1505. runerror(202);
  1506. end;
  1507. {$endif sectorpldebug}
  1508. plx2 := (y-ArcCall.Y)*(ArcCall.XStart-ArcCall.X)
  1509. div (ArcCall.YStart-ArcCall.Y)+ArcCall.X
  1510. end
  1511. else if (y > ArcCall.Y) then
  1512. begin
  1513. {$ifdef sectorpldebug}
  1514. If (ArcCall.YEnd-ArcCall.Y) = 0 then
  1515. begin
  1516. append(t);
  1517. writeln(t,'bug6');
  1518. close(t);
  1519. runerror(202);
  1520. end;
  1521. {$endif sectorpldebug}
  1522. plx2 := (y-ArcCall.Y)*(ArcCall.XEnd-ArcCall.X)
  1523. div (ArcCall.YEnd-ArcCall.Y)+ArcCall.X
  1524. end
  1525. else plx2 := ArcCall.X;
  1526. plx1 := x1;
  1527. {$ifdef sectorpldebug}
  1528. append(t);
  1529. writeln(t,'left: ',plx1,' - ',plx2);
  1530. close(t);
  1531. {$endif sectorpldebug}
  1532. End
  1533. Else
  1534. { the arc is plotted at both sides }
  1535. Begin
  1536. plx1 := x1;
  1537. plx2 := x2;
  1538. {$ifdef sectorpldebug}
  1539. append(t);
  1540. writeln(t,'normal: ',plx1,' - ',plx2);
  1541. close(t);
  1542. {$endif sectorpldebug}
  1543. End;
  1544. If plx2 > plx1 then
  1545. Begin
  1546. {$ifdef sectorpldebug}
  1547. append(t);
  1548. Writeln(t,'drawing...');
  1549. close(t);
  1550. {$endif sectorpldebug}
  1551. PatternLine(plx1,plx2,y);
  1552. end;
  1553. end;
  1554. procedure Sector(x, y: smallint; StAngle,EndAngle, XRadius, YRadius: Word);
  1555. begin
  1556. internalellipse(x,y,XRadius, YRadius, StAngle, EndAngle, {$ifdef fpc}@{$endif}SectorPL);
  1557. Line(ArcCall.XStart, ArcCall.YStart, x,y);
  1558. Line(x,y,ArcCall.Xend,ArcCall.YEnd);
  1559. end;
  1560. procedure SetFillStyle(Pattern : word; Color: word);
  1561. begin
  1562. { on invalid input, the current fill setting will be }
  1563. { unchanged. }
  1564. if (Pattern > UserFill) or (Color > GetMaxColor) then
  1565. begin
  1566. _GraphResult := grError;
  1567. exit;
  1568. end;
  1569. FillSettings.Color := Color;
  1570. FillSettings.Pattern := Pattern;
  1571. end;
  1572. procedure SetFillPattern(Pattern: FillPatternType; Color: word);
  1573. {********************************************************}
  1574. { Changes the Current FillPattern to a user defined }
  1575. { pattern and changes also the current fill color. }
  1576. { The FillPattern is saved in the FillPattern array so }
  1577. { it can still be used with SetFillStyle(UserFill,Color) }
  1578. {********************************************************}
  1579. var
  1580. i: smallint;
  1581. begin
  1582. if Color > GetMaxColor then
  1583. begin
  1584. _GraphResult := grError;
  1585. exit;
  1586. end;
  1587. FillSettings.Color := Color;
  1588. FillSettings.Pattern := UserFill;
  1589. { Save the pattern in the buffer }
  1590. For i:=1 to 8 do
  1591. FillPatternTable[UserFill][i] := Pattern[i];
  1592. end;
  1593. procedure Bar(x1,y1,x2,y2:smallint);
  1594. {********************************************************}
  1595. { Important notes for compatibility with BP: }
  1596. { - WriteMode is always CopyPut }
  1597. { - No contour is drawn for the lines }
  1598. {********************************************************}
  1599. var y : smallint;
  1600. origcolor : longint;
  1601. origlinesettings: Linesettingstype;
  1602. origwritemode : smallint;
  1603. begin
  1604. origlinesettings:=lineinfo;
  1605. origcolor:=CurrentColor;
  1606. if y1>y2 then
  1607. begin
  1608. y:=y1;
  1609. y1:=y2;
  1610. y2:=y;
  1611. end;
  1612. { Always copy mode for Bars }
  1613. origwritemode := CurrentWriteMode;
  1614. CurrentWriteMode := CopyPut;
  1615. { All lines used are of this style }
  1616. Lineinfo.linestyle:=solidln;
  1617. Lineinfo.thickness:=normwidth;
  1618. case Fillsettings.pattern of
  1619. EmptyFill :
  1620. begin
  1621. Currentcolor:=CurrentBkColor;
  1622. for y:=y1 to y2 do
  1623. Hline(x1,x2,y);
  1624. end;
  1625. SolidFill :
  1626. begin
  1627. CurrentColor:=FillSettings.color;
  1628. for y:=y1 to y2 do
  1629. Hline(x1,x2,y);
  1630. end;
  1631. else
  1632. Begin
  1633. CurrentColor:=FillSettings.color;
  1634. for y:=y1 to y2 do
  1635. patternline(x1,x2,y);
  1636. end;
  1637. end;
  1638. CurrentColor:= Origcolor;
  1639. LineInfo := OrigLineSettings;
  1640. CurrentWriteMode := OrigWritemode;
  1641. end;
  1642. procedure bar3D(x1, y1, x2, y2 : smallint;depth : word;top : boolean);
  1643. var
  1644. origwritemode : smallint;
  1645. OldX, OldY : smallint;
  1646. begin
  1647. origwritemode := CurrentWriteMode;
  1648. CurrentWriteMode := CopyPut;
  1649. Bar(x1,y1,x2,y2);
  1650. Rectangle(x1,y1,x2,y2);
  1651. { Current CP should not be updated in Bar3D }
  1652. { therefore save it and then restore it on }
  1653. { exit. }
  1654. OldX := CurrentX;
  1655. OldY := CurrentY;
  1656. if top then begin
  1657. Moveto(x1,y1);
  1658. Lineto(x1+depth,y1-depth);
  1659. Lineto(x2+depth,y1-depth);
  1660. Lineto(x2,y1);
  1661. end;
  1662. if Depth <> 0 then
  1663. Begin
  1664. Moveto(x2+depth,y1-depth);
  1665. Lineto(x2+depth,y2-depth);
  1666. Lineto(x2,y2);
  1667. end;
  1668. { restore CP }
  1669. CurrentX := OldX;
  1670. CurrentY := OldY;
  1671. CurrentWriteMode := origwritemode;
  1672. end;
  1673. {--------------------------------------------------------------------------}
  1674. { }
  1675. { COLOR AND PALETTE ROUTINES }
  1676. { }
  1677. {--------------------------------------------------------------------------}
  1678. procedure SetColor(Color: Word);
  1679. Begin
  1680. CurrentColor := Color;
  1681. end;
  1682. function GetColor: Word;
  1683. Begin
  1684. GetColor := CurrentColor;
  1685. end;
  1686. function GetBkColor: Word;
  1687. Begin
  1688. GetBkColor := CurrentBkColor;
  1689. end;
  1690. procedure SetBkColor(ColorNum: Word);
  1691. { Background color means background screen color in this case, and it is }
  1692. { INDEPENDANT of the viewport settings, so we must clear the whole screen }
  1693. { with the color. }
  1694. var
  1695. ViewPort: ViewportType;
  1696. Begin
  1697. GetViewSettings(Viewport);
  1698. SetViewPort(0,0,MaxX,MaxY,FALSE);
  1699. CurrentBkColor := ColorNum;
  1700. {ClearViewPort;}
  1701. if not DirectColor and (ColorNum<256) then
  1702. SetRGBPalette(0,
  1703. DefaultColors[ColorNum].Red,
  1704. DefaultColors[ColorNum].Green,
  1705. DefaultColors[ColorNum].Blue);
  1706. SetViewport(ViewPort.X1,Viewport.Y1,Viewport.X2,Viewport.Y2,Viewport.Clip);
  1707. end;
  1708. function GetMaxColor: word;
  1709. { Checked against TP VGA driver - CEC }
  1710. begin
  1711. GetMaxColor:=MaxColor-1; { based on an index of zero so subtract one }
  1712. end;
  1713. Procedure MoveRel(Dx, Dy: smallint);
  1714. Begin
  1715. CurrentX := CurrentX + Dx;
  1716. CurrentY := CurrentY + Dy;
  1717. end;
  1718. Procedure MoveTo(X,Y: smallint);
  1719. {********************************************************}
  1720. { Procedure MoveTo() }
  1721. {--------------------------------------------------------}
  1722. { Moves the current pointer in VIEWPORT relative }
  1723. { coordinates to the specified X,Y coordinate. }
  1724. {********************************************************}
  1725. Begin
  1726. CurrentX := X;
  1727. CurrentY := Y;
  1728. end;
  1729. function GraphErrorMsg(ErrorCode: smallint): string;
  1730. Begin
  1731. GraphErrorMsg:='';
  1732. case ErrorCode of
  1733. grOk,grFileNotFound,grInvalidDriver: exit;
  1734. grNoInitGraph: GraphErrorMsg:='Graphics driver not installed';
  1735. grNotDetected: GraphErrorMsg:='Graphics hardware not detected';
  1736. grNoLoadMem,grNoScanMem,grNoFloodMem: GraphErrorMsg := 'Not enough memory for graphics';
  1737. grNoFontMem: GraphErrorMsg := 'Not enough memory to load font';
  1738. grFontNotFound: GraphErrorMsg:= 'Font file not found';
  1739. grInvalidMode: GraphErrorMsg := 'Invalid graphics mode';
  1740. grError: GraphErrorMsg:='Graphics error';
  1741. grIoError: GraphErrorMsg:='Graphics I/O error';
  1742. grInvalidFont,grInvalidFontNum: GraphErrorMsg := 'Invalid font';
  1743. grInvalidVersion: GraphErrorMsg:='Invalid driver version';
  1744. end;
  1745. end;
  1746. Function GetMaxX: smallint;
  1747. { Routine checked against VGA driver - CEC }
  1748. Begin
  1749. GetMaxX := MaxX;
  1750. end;
  1751. Function GetMaxY: smallint;
  1752. { Routine checked against VGA driver - CEC }
  1753. Begin
  1754. GetMaxY := MaxY;
  1755. end;
  1756. Function GraphResult: smallint;
  1757. Begin
  1758. GraphResult := _GraphResult;
  1759. _GraphResult := grOk;
  1760. end;
  1761. Function GetX: smallint;
  1762. Begin
  1763. GetX := CurrentX;
  1764. end;
  1765. Function GetY: smallint;
  1766. Begin
  1767. GetY := CurrentY;
  1768. end;
  1769. Function GetDriverName: string;
  1770. begin
  1771. GetDriverName:=DriverName;
  1772. end;
  1773. procedure graphdefaults;
  1774. { PS: GraphDefaults does not ZERO the ArcCall structure }
  1775. { so a call to GetArcCoords will not change even the }
  1776. { returned values even if GraphDefaults is called in }
  1777. { between. }
  1778. var
  1779. i: smallint;
  1780. begin
  1781. lineinfo.linestyle:=solidln;
  1782. lineinfo.thickness:=normwidth;
  1783. { reset line style pattern }
  1784. for i:=0 to 15 do
  1785. LinePatterns[i] := TRUE;
  1786. { By default, according to the TP prog's reference }
  1787. { the default pattern is solid, and the default }
  1788. { color is the maximum color in the palette. }
  1789. fillsettings.color:=GetMaxColor;
  1790. fillsettings.pattern:=solidfill;
  1791. { GraphDefaults resets the User Fill pattern to $ff }
  1792. { checked with VGA BGI driver - CEC }
  1793. for i:=1 to 8 do
  1794. FillPatternTable[UserFill][i] := $ff;
  1795. CurrentColor:=white;
  1796. SetBkColor(Black);
  1797. ClipPixels := TRUE;
  1798. { Reset the viewport }
  1799. StartXViewPort := 0;
  1800. StartYViewPort := 0;
  1801. ViewWidth := MaxX;
  1802. ViewHeight := MaxY;
  1803. { Reset CP }
  1804. CurrentX := 0;
  1805. CurrentY := 0;
  1806. { normal write mode }
  1807. CurrentWriteMode := CopyPut;
  1808. { Schriftart einstellen }
  1809. CurrentTextInfo.font := DefaultFont;
  1810. CurrentTextInfo.direction:=HorizDir;
  1811. CurrentTextInfo.charsize:=1;
  1812. CurrentTextInfo.horiz:=LeftText;
  1813. CurrentTextInfo.vert:=TopText;
  1814. XAspect:=10000; YAspect:=10000;
  1815. end;
  1816. procedure GetAspectRatio(var Xasp,Yasp : word);
  1817. begin
  1818. XAsp:=XAspect;
  1819. YAsp:=YAspect;
  1820. end;
  1821. procedure SetAspectRatio(Xasp, Yasp : word);
  1822. begin
  1823. Xaspect:= XAsp;
  1824. YAspect:= YAsp;
  1825. end;
  1826. procedure SetWriteMode(WriteMode : smallint);
  1827. { TP sets the writemodes according to the following scheme (JM) }
  1828. begin
  1829. Case writemode of
  1830. xorput, andput: CurrentWriteMode := XorPut;
  1831. notput, orput, copyput: CurrentWriteMode := CopyPut;
  1832. End;
  1833. end;
  1834. procedure GetFillSettings(var Fillinfo:Fillsettingstype);
  1835. begin
  1836. Fillinfo:=Fillsettings;
  1837. end;
  1838. procedure GetFillPattern(var FillPattern:FillPatternType);
  1839. begin
  1840. FillPattern:=FillpatternTable[UserFill];
  1841. end;
  1842. procedure DrawPoly(numpoints : word;var polypoints);
  1843. type
  1844. ppointtype = ^pointtype;
  1845. pt = array[0..16000] of pointtype;
  1846. var
  1847. i : longint;
  1848. begin
  1849. if numpoints < 2 then
  1850. begin
  1851. _GraphResult := grError;
  1852. exit;
  1853. end;
  1854. for i:=0 to numpoints-2 do
  1855. line(pt(polypoints)[i].x,
  1856. pt(polypoints)[i].y,
  1857. pt(polypoints)[i+1].x,
  1858. pt(polypoints)[i+1].y);
  1859. end;
  1860. procedure PieSlice(X,Y,stangle,endAngle:smallint;Radius: Word);
  1861. begin
  1862. Sector(x,y,stangle,endangle,radius,radius);
  1863. end;
  1864. {$i fills.inc}
  1865. {$i gtext.inc}
  1866. procedure DetectGraph(var GraphDriver:smallint;var GraphMode:smallint);
  1867. var LoMode, HiMode: smallint;
  1868. CpyMode: smallint;
  1869. CpyDriver: smallint;
  1870. begin
  1871. HiMode := -1;
  1872. LoMode := -1;
  1873. { We start at VGA }
  1874. GraphDriver := VGA;
  1875. CpyMode := 0;
  1876. { search all possible graphic drivers in ascending order...}
  1877. { usually the new driver numbers indicate newest hardware...}
  1878. { Internal driver numbers start at VGA=9 }
  1879. repeat
  1880. GetModeRange(GraphDriver,LoMode,HiMode);
  1881. { save the highest mode possible...}
  1882. {$ifdef logging}
  1883. logln('Found driver '+strf(graphdriver)+' with modes '+
  1884. strf(lomode)+' - '+strf(himode));
  1885. {$endif logging}
  1886. if HiMode = -1 then break;
  1887. CpyMode:=HiMode;
  1888. CpyDriver:=GraphDriver;
  1889. { go to next driver if it exists...}
  1890. Inc(GraphDriver);
  1891. until (CpyMode=-1);
  1892. { If this is equal to -1 then no graph mode possible...}
  1893. if CpyMode = -1 then
  1894. begin
  1895. _GraphResult := grNotDetected;
  1896. exit;
  1897. end;
  1898. _GraphResult := grOK;
  1899. GraphDriver := CpyDriver;
  1900. GraphMode := CpyMode;
  1901. end;
  1902. procedure InitGraph(var GraphDriver:smallint;var GraphMode:smallint;
  1903. const PathToDriver:String);
  1904. const
  1905. {$IFDEF Linux}
  1906. dirchar = '/';
  1907. {$ELSE}
  1908. dirchar = '\';
  1909. {$ENDIF}
  1910. begin
  1911. InitVars;
  1912. { path to the fonts (where they will be searched)...}
  1913. bgipath:=PathToDriver;
  1914. if (Length(bgipath) > 0) and (bgipath[length(bgipath)]<>dirchar) then
  1915. bgipath:=bgipath+dirchar;
  1916. if not assigned(SaveVideoState) then
  1917. RunError(216);
  1918. DriverName:=InternalDriverName; { DOS Graphics driver }
  1919. if (Graphdriver=Detect) then
  1920. begin
  1921. DetectGraph(GraphDriver,GraphMode);
  1922. If _GraphResult = grNotDetected then Exit;
  1923. { _GraphResult is now already set to grOK by DetectGraph }
  1924. IntCurrentDriver := GraphDriver;
  1925. SaveVideoState;
  1926. { Actually set the graph mode...}
  1927. SetGraphMode(GraphMode);
  1928. end
  1929. else
  1930. begin
  1931. { Search if that graphics modec actually exists...}
  1932. if SearchMode(GraphDriver,GraphMode) = nil then
  1933. begin
  1934. _GraphResult := grInvalidMode;
  1935. exit;
  1936. end
  1937. else
  1938. begin
  1939. _GraphResult := grOK;
  1940. IntCurrentDriver := GraphDriver;
  1941. SaveVideoState;
  1942. {$ifdef logging}
  1943. If _GraphResult <> grOK then
  1944. LogLn('Mode setting failed after savevideostate');
  1945. {$endif logging}
  1946. SetGraphMode(GraphMode);
  1947. end;
  1948. end;
  1949. end;
  1950. procedure SetDirectVideo(DirectAccess: boolean);
  1951. begin
  1952. DirectVideo := DirectAccess;
  1953. end;
  1954. function GetDirectVideo: boolean;
  1955. begin
  1956. GetDirectVideo := DirectVideo;
  1957. end;
  1958. procedure GraphExitProc; {$ifndef fpc} far; {$endif fpc}
  1959. { deallocates all memory allocated by the graph unit }
  1960. var
  1961. list: PModeInfo;
  1962. tmp : PModeInfo;
  1963. c: graph_int;
  1964. begin
  1965. { restore old exitproc! }
  1966. exitproc := exitsave;
  1967. if IsGraphMode and ((errorcode<>0) or (erroraddr<>nil)) then
  1968. CloseGraph;
  1969. {$ifdef testsave}
  1970. restorevideostate;
  1971. {$endif testsave}
  1972. { release memory allocated for fonts }
  1973. for c := 1 to installedfonts do
  1974. with fonts[c] Do
  1975. If assigned(instr) Then
  1976. Freemem(instr,instrlength);
  1977. { release memory allocated for modelist }
  1978. list := ModeList;
  1979. while assigned(list) do
  1980. begin
  1981. tmp := list;
  1982. list:=list^.next;
  1983. dispose(tmp);
  1984. end;
  1985. {$IFDEF DPMI}
  1986. { We had copied the buffer of mode information }
  1987. { and allocated it dynamically... now free it }
  1988. { Warning: if GetVESAInfo returned false, this buffer is not allocated! (JM)}
  1989. If hasVesa then
  1990. Dispose(VESAInfo.ModeList);
  1991. {$ENDIF}
  1992. end;
  1993. procedure InitializeGraph;
  1994. begin
  1995. {$ifdef logging}
  1996. assign(debuglog,'grlog.txt');
  1997. rewrite(debuglog);
  1998. close(debuglog);
  1999. {$endif logging}
  2000. isgraphmode := false;
  2001. ModeList := nil;
  2002. SaveVideoState := nil;
  2003. RestoreVideoState := nil;
  2004. {$ifdef oldfont}
  2005. {$ifdef go32v2}
  2006. LoadFont8x8;
  2007. {$endif go32v2}
  2008. {$endif oldfont}
  2009. { This must be called at startup... because GetGraphMode may }
  2010. { be called even when not in graph mode. }
  2011. {$ifdef logging}
  2012. LogLn('Calling QueryAdapterInfo...');
  2013. {$endif logging}
  2014. QueryAdapterInfo;
  2015. { Install standard fonts }
  2016. { This is done BEFORE startup... }
  2017. InstalledFonts := 0;
  2018. InstallUserFont('TRIP');
  2019. InstallUserFont('LITT');
  2020. InstallUserFont('SANS');
  2021. InstallUserFont('GOTH');
  2022. InstallUserFont('SCRI');
  2023. InstallUserFont('SIMP');
  2024. InstallUserFont('TSCR');
  2025. InstallUserFont('LCOM');
  2026. InstallUserFont('EURO');
  2027. InstallUserFont('BOLD');
  2028. { This installs an exit procedure which cleans up the mode list...}
  2029. ExitSave := ExitProc;
  2030. ExitProc := @GraphExitProc;
  2031. {$ifdef testsave}
  2032. savevideostate;
  2033. {$endif testsave}
  2034. {$ifdef win32}
  2035. charmessagehandler:=nil;
  2036. {$endif win32}
  2037. end;
  2038. {
  2039. $Log$
  2040. Revision 1.29 2000-03-24 13:01:15 florian
  2041. * ClearViewPort fixed
  2042. Revision 1.28 2000/03/19 11:20:13 peter
  2043. * graph unit include is now independent and the dependent part
  2044. is now in graph.pp
  2045. * ggigraph unit for linux added
  2046. Revision 1.60 2000/03/18 10:45:07 sg
  2047. * Fix for ClearViewportDefault: The width and the height of the rectangle
  2048. it filled has been one pixel too high.
  2049. Revision 1.59 2000/03/17 13:28:54 sg
  2050. * Use linux unit under Linux
  2051. Revision 1.58 2000/03/08 14:20:14 jonas
  2052. * writemode was not set to normalput during clearviewport (and it uses hline)
  2053. Revision 1.57 2000/02/27 14:41:25 peter
  2054. * removed warnings/notes
  2055. Revision 1.56 2000/02/06 01:47:15 sg
  2056. * For Linux, "/" is added to the bgipath instead of "\" if this character
  2057. isn't already there.
  2058. Revision 1.55 2000/01/07 16:41:37 daniel
  2059. * copyright 2000
  2060. Revision 1.54 2000/01/07 16:32:25 daniel
  2061. * copyright 2000 added
  2062. Revision 1.53 2000/01/02 19:02:39 jonas
  2063. * removed/commented out (inited but) unused vars and unused types
  2064. Revision 1.52 1999/12/29 17:26:00 jonas
  2065. + by default, also attempt to install the fonts that come with TP7
  2066. Revision 1.51 1999/12/26 10:33:06 jonas
  2067. * XAspect and YAspect are now words instead of smallints, they
  2068. overflowed for resolutions > 640x480 otherwise
  2069. * the number of pixels required for an ellipse in internalellipsedef
  2070. is now calculated after the aspectratios have been taken into
  2071. account
  2072. Revision 1.50 1999/12/21 17:42:17 jonas
  2073. * changed vesa.inc do it doesn't try to use linear modes anymore (doesn't work
  2074. yet!!)
  2075. * fixed mode detection so the low modenumber of a driver doesn't have to be zero
  2076. anymore (so VESA autodetection now works)
  2077. Revision 1.49 1999/12/21 09:16:48 pierre
  2078. + CloseGraph if errors
  2079. Revision 1.48 1999/12/20 11:22:36 peter
  2080. * integer -> smallint to overcome -S2 switch needed for ggi version
  2081. Revision 1.47 1999/12/12 13:34:20 jonas
  2082. * putimage now performs the lipping itself and uses directputpixel
  2083. (note: this REQUIRES or/and/notput support in directputpixel,
  2084. this is not yet the case in the assembler versions!)
  2085. * YOffset addition moved in hlinevesa256 and vlinevesa256
  2086. because it uses still putpixel afterwards
  2087. Revision 1.46 1999/12/11 23:41:38 jonas
  2088. * changed definition of getscanlineproc to "getscanline(x1,x2,y:
  2089. smallint; var data);" so it can be used by getimage too
  2090. * changed getimage so it uses getscanline
  2091. * changed floodfill, getscanline16 and definitions in Linux
  2092. include files so they use this new format
  2093. + getscanlineVESA256 for 256 color VESA modes (banked)
  2094. Revision 1.45 1999/12/10 12:47:41 pierre
  2095. * SetBkColor like BP by changing Palette entry zero
  2096. Revision 1.44 1999/11/30 08:57:46 michael
  2097. + Removed charmessagehandler declaration, it is in graphh.inc
  2098. Revision 1.43 1999/11/28 16:13:55 jonas
  2099. * corrected misplacement of call to initvars in initgraph
  2100. + some extra debugging commands (for -dlogging) in the mode functions
  2101. Revision 1.42 1999/11/28 12:19:59 jonas
  2102. * _GraphResult is now properly set to grOK by DetectGraph and
  2103. InitGraph if there are no errors
  2104. Revision 1.41 1999/11/27 21:48:01 jonas
  2105. * fixed VlineVESA256 and re-enabled it in graph.inc
  2106. * added procedure detectgraph to interface of graph unit
  2107. Revision 1.40 1999/11/25 17:44:14 pierre
  2108. * memory corruption within GetImage removed
  2109. Revision 1.39 1999/11/24 23:42:31 pierre
  2110. * PutImage used an smallint index that became negative !!!!
  2111. * Default needed procedure now genrate a RTE 218 instead of a
  2112. GPF by call to nil pointer !
  2113. Revision 1.38 1999/11/11 17:55:07 florian
  2114. * the size was calculated wrong by imagesize
  2115. Revision 1.37 1999/11/11 14:07:14 florian
  2116. * better looking font
  2117. Revision 1.36 1999/11/08 15:01:38 peter
  2118. * fpcmake support
  2119. Revision 1.35 1999/11/08 11:15:22 peter
  2120. * move graph.inc to the target dir
  2121. Revision 1.34 1999/11/03 20:23:01 florian
  2122. + first release of win32 gui support
  2123. Revision 1.33 1999/10/17 10:20:13 jonas
  2124. * fixed clipping for thickwidth lines (bug 659)
  2125. * fixed the faster internalellipsedefault, but it doesn't plot
  2126. all pixels (there are gaps in the ellipses)
  2127. Revision 1.32 1999/09/28 15:07:46 jonas
  2128. * fix for disposing font data because it can contain #0 chars
  2129. Revision 1.31 1999/09/28 13:56:25 jonas
  2130. * reordered some local variables (first 4 byte vars, then 2 byte vars
  2131. etc)
  2132. * font data is now disposed in exitproc, exitproc is now called
  2133. GraphExitProc (was CleanModes) and resides in graph.pp instead of in
  2134. modes.inc
  2135. Revision 1.30 1999/09/27 23:34:41 peter
  2136. * new graph unit is default for go32v2
  2137. * removed warnings/notes
  2138. Revision 1.29 1999/09/26 13:31:06 jonas
  2139. * changed name of modeinfo variable to vesamodeinfo and fixed
  2140. associated errors (fillchar(modeinfo,sizeof(tmodeinfo),#0) instead
  2141. of sizeof(TVesamodeinfo) etc)
  2142. * changed several sizeof(type) to sizeof(varname) to avoid similar
  2143. errors in the future
  2144. Revision 1.28 1999/09/25 11:48:43 jonas
  2145. + detectgraph
  2146. * small change to internalellipsedefault so less pixels are
  2147. calculated twice
  2148. * some small corrections to graph.tex
  2149. Revision 1.27 1999/09/24 22:52:38 jonas
  2150. * optimized patternline a bit (always use hline when possible)
  2151. * isgraphmode stuff cleanup
  2152. * vesainfo.modelist now gets disposed in cleanmode instead of in
  2153. closegraph (required moving of some declarations from vesa.inc to
  2154. new vesah.inc)
  2155. * queryadapter gets no longer called from initgraph (is called from
  2156. initialization of graph unit)
  2157. * bugfix for notput in 32k and 64k vesa modes
  2158. * a div replaced by / in fillpoly
  2159. Revision 1.26 1999/09/22 13:13:35 jonas
  2160. * renamed text.inc -> gtext.inc to avoid conflict with system unit
  2161. * fixed textwidth
  2162. * isgraphmode now gets properly updated, so mode restoring works
  2163. again
  2164. Revision 1.25 1999/09/18 22:21:10 jonas
  2165. + hlinevesa256 and vlinevesa256
  2166. + support for not/xor/or/andput in vesamodes with 32k/64k colors
  2167. * lots of changes to avoid warnings under FPC
  2168. Revision 1.24 1999/09/18 16:03:37 jonas
  2169. * graph.pp: removed pieslice and sector from ToDo list
  2170. * closegraph: exits now immidiately if isgraphmode = false (caused
  2171. RTE 204 with VESA enabled if you set exitproc to call closegraph
  2172. and also called closegraph explicitely before exit, like bgidemo)
  2173. Revision 1.23 1999/09/17 13:58:31 jonas
  2174. * another fix for a case where internalellipsedefault went haywire
  2175. * sector() and pieslice() fully implemented!
  2176. * small change to prevent buffer overflow with floodfill
  2177. Revision 1.22 1999/09/15 13:37:50 jonas
  2178. * small change to internalellipsedef to be TP compatible
  2179. * fixed directputpixel for vga 320*200*256
  2180. Revision 1.21 1999/09/13 12:49:08 jonas
  2181. * fixed Arc: internallellipse went into an endless loop if StAngle =
  2182. EndAngle
  2183. * FillEllipse is now much faster: no more floodfill,
  2184. InternalEllipseDefault now draws the patternlines immediatety!
  2185. Revision 1.20 1999/09/12 17:29:00 jonas
  2186. * several changes to internalellipse to make it faster
  2187. and to make sure it updates the ArcCall correctly
  2188. (not yet done for width = 3)
  2189. * Arc mostly works now, only sometimes an endless loop, don't know
  2190. why
  2191. Revision 1.19 1999/09/11 19:43:01 jonas
  2192. * FloodFill: did not take into account current viewport settings
  2193. * GetScanLine: only get line inside viewport, data outside of it
  2194. is not used anyway
  2195. * InternalEllipseDefault: fix for when xradius or yradius = 0 and
  2196. increase xradius and yradius always by one (TP does this too)
  2197. * fixed conlict in vesa.inc from last update
  2198. * some conditionals to avoid range check and overflow errors in
  2199. places where it doesn't matter
  2200. Revision 1.18 1999/07/26 09:38:41 florian
  2201. * bar: y2 can be less y1, fixed
  2202. * settextstyle: charsize can be 0, must be changed into 1
  2203. Revision 1.17 1999/07/18 15:07:20 jonas
  2204. + xor-, and and- orput support for VESA256 modes
  2205. * compile with -dlogging if you wnt some info to be logged to grlog.txt
  2206. Revision 1.16 1999/07/14 18:18:04 florian
  2207. * cosmetic changes
  2208. }