graph.inc 77 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544
  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 OutTextXYDefault(x,y : smallint;const TextString : string);forward;
  1254. procedure CircleDefault(X, Y: smallint; Radius:Word);forward;
  1255. Procedure DefaultHooks;
  1256. {********************************************************}
  1257. { Procedure DefaultHooks() }
  1258. {--------------------------------------------------------}
  1259. { Resets all hookable routine either to nil for those }
  1260. { which need overrides, and others to defaults. }
  1261. { This is called each time SetGraphMode() is called. }
  1262. {********************************************************}
  1263. Begin
  1264. { All default hooks procedures }
  1265. { required...}
  1266. DirectPutPixel := {$ifdef fpc}@{$endif}DirectPutPixelDefault;
  1267. PutPixel := {$ifdef fpc}@{$endif}PutPixelDefault;
  1268. GetPixel := {$ifdef fpc}@{$endif}GetPixelDefault;
  1269. SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteDefault;
  1270. GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteDefault;
  1271. { optional...}
  1272. SetActivePage := {$ifdef fpc}@{$endif}SetActivePageDefault;
  1273. SetVisualPage := {$ifdef fpc}@{$endif}SetVisualPageDefault;
  1274. ClearViewPort := {$ifdef fpc}@{$endif}ClearViewportDefault;
  1275. PutImage := {$ifdef fpc}@{$endif}DefaultPutImage;
  1276. GetImage := {$ifdef fpc}@{$endif}DefaultGetImage;
  1277. ImageSize := {$ifdef fpc}@{$endif}DefaultImageSize;
  1278. GraphFreeMemPtr := nil;
  1279. GraphGetMemPtr := nil;
  1280. GetScanLine := {$ifdef fpc}@{$endif}GetScanLineDefault;
  1281. Line := {$ifdef fpc}@{$endif}LineDefault;
  1282. InternalEllipse := {$ifdef fpc}@{$endif}InternalEllipseDefault;
  1283. PatternLine := {$ifdef fpc}@{$endif}PatternLineDefault;
  1284. HLine := {$ifdef fpc}@{$endif}HLineDefault;
  1285. VLine := {$ifdef fpc}@{$endif}VLineDefault;
  1286. OuttextXY := {$ifdef fpc}@{$endif}OuttextXYDefault;
  1287. Circle := {$ifdef fpc}@{$endif}CircleDefault;
  1288. end;
  1289. Procedure InitVars;
  1290. {********************************************************}
  1291. { Procedure InitVars() }
  1292. {--------------------------------------------------------}
  1293. { Resets all internal variables, and resets all }
  1294. { overridable routines. }
  1295. {********************************************************}
  1296. Begin
  1297. DirectVideo := TRUE; { By default use fastest access possible }
  1298. ArcCall.X := 0;
  1299. ArcCall.Y := 0;
  1300. ArcCall.XStart := 0;
  1301. ArcCall.YStart := 0;
  1302. ArcCall.XEnd := 0;
  1303. ArcCall.YEnd := 0;
  1304. { Reset to default values }
  1305. IntCurrentMode := 0;
  1306. IntCurrentDriver := 0;
  1307. XAspect := 0;
  1308. YAspect := 0;
  1309. MaxX := 0;
  1310. MaxY := 0;
  1311. MaxColor := 0;
  1312. PaletteSize := 0;
  1313. DirectColor := FALSE;
  1314. HardwarePages := 0;
  1315. if hardwarepages=0 then; { remove note }
  1316. DefaultHooks;
  1317. end;
  1318. {$i modes.inc}
  1319. {$i palette.inc}
  1320. function InstallUserDriver(Name: string; AutoDetectPtr: Pointer): smallint;
  1321. begin
  1322. _graphResult := grError;
  1323. InstallUserDriver:=grError;
  1324. end;
  1325. function RegisterBGIDriver(driver: pointer): smallint;
  1326. begin
  1327. _graphResult := grError;
  1328. RegisterBGIDriver:=grError;
  1329. end;
  1330. { ----------------------------------------------------------------- }
  1331. Procedure Arc(X,Y : smallint; StAngle,EndAngle,Radius: word);
  1332. { var
  1333. OldWriteMode: word;}
  1334. Begin
  1335. { Only if we are using thickwidths lines do we accept }
  1336. { XORput write modes. }
  1337. { OldWriteMode := CurrentWriteMode;
  1338. if (LineInfo.Thickness = NormWidth) then
  1339. CurrentWriteMode := NormalPut;}
  1340. InternalEllipse(X,Y,Radius,Radius,StAngle,Endangle,{$ifdef fpc}@{$endif}DummyPatternLine);
  1341. { CurrentWriteMode := OldWriteMode;}
  1342. end;
  1343. procedure Ellipse(X,Y : smallint; stAngle, EndAngle: word; XRadius,YRadius: word);
  1344. Begin
  1345. InternalEllipse(X,Y,XRadius,YRadius,StAngle,Endangle,{$ifdef fpc}@{$endif}DummyPatternLine);
  1346. end;
  1347. procedure FillEllipse(X, Y: smallint; XRadius, YRadius: Word);
  1348. {********************************************************}
  1349. { Procedure FillEllipse() }
  1350. {--------------------------------------------------------}
  1351. { Draws a filled ellipse using (X,Y) as a center point }
  1352. { and XRadius and YRadius as the horizontal and vertical }
  1353. { axes. The ellipse is filled with the current fill color}
  1354. { and fill style, and is bordered with the current color.}
  1355. {********************************************************}
  1356. begin
  1357. InternalEllipse(X,Y,XRadius,YRadius,0,360,PatternLine)
  1358. end;
  1359. procedure CircleDefault(X, Y: smallint; Radius:Word);
  1360. {********************************************************}
  1361. { Draws a circle centered at X,Y with the given Radius. }
  1362. {********************************************************}
  1363. { Important notes: }
  1364. { - Thickwidth circles use the current write mode, while}
  1365. { normal width circles ALWAYS use CopyPut/NormalPut }
  1366. { mode. (Tested against VGA BGI driver -CEC 13/Aug/99 }
  1367. {********************************************************}
  1368. var OriginalArcInfo: ArcCoordsType;
  1369. OldWriteMode: word;
  1370. begin
  1371. if (Radius = 0) then
  1372. Exit;
  1373. if (Radius = 1) then
  1374. begin
  1375. { only normal put mode is supported by a call to PutPixel }
  1376. PutPixel(X, Y, CurrentColor);
  1377. Exit;
  1378. end;
  1379. { save state of arc information }
  1380. { because it is not needed for }
  1381. { a circle call. }
  1382. move(ArcCall,OriginalArcInfo, sizeof(ArcCall));
  1383. if LineInfo.Thickness = Normwidth then
  1384. begin
  1385. OldWriteMode := CurrentWriteMode;
  1386. CurrentWriteMode := CopyPut;
  1387. end;
  1388. InternalEllipse(X,Y,Radius,Radius,0,360,{$ifdef fpc}@{$endif}DummyPatternLine);
  1389. if LineInfo.Thickness = Normwidth then
  1390. CurrentWriteMode := OldWriteMode;
  1391. { restore arc information }
  1392. move(OriginalArcInfo, ArcCall,sizeof(ArcCall));
  1393. end;
  1394. procedure SectorPL(x1,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
  1395. var plx1, plx2: smallint;
  1396. {$ifdef sectorpldebug}
  1397. t : text;
  1398. {$endif sectorpldebug}
  1399. begin
  1400. {$ifdef sectorpldebug}
  1401. assign(t,'sector.log');
  1402. append(t);
  1403. writeln(t,'Got here for line ',y);
  1404. close(t);
  1405. {$endif sectorpldebug}
  1406. If (x1 = -maxsmallint) Then
  1407. If (x2 = maxsmallint-1) Then
  1408. { no ellipse points drawn on this line }
  1409. If (((Y < ArcCall.Y) and (Y > ArcCall.YStart)) or
  1410. ((Y > ArcCall.Y) and (Y < ArcCall.YStart))) Then
  1411. { there is a part of the sector at this y coordinate, but no }
  1412. { ellips points are plotted on this line, so draw a patternline }
  1413. { between the lines connecting (arccall.x,arccall.y) with }
  1414. { the start and the end of the arc (JM) }
  1415. { use: y-y1=(y2-y1)/(x2-x1)*(x-x1) => }
  1416. { x = (y-y1)/(y2-y1)*(x2-x1)+x1 }
  1417. Begin
  1418. {$ifdef sectorpldebug}
  1419. If (ArcCall.YStart-ArcCall.Y) = 0 then
  1420. begin
  1421. append(t);
  1422. writeln(t,'bug1');
  1423. close(t);
  1424. runerror(202);
  1425. end;
  1426. {$endif sectorpldebug}
  1427. plx1 := (y-ArcCall.Y)*(ArcCall.XStart-ArcCall.X)
  1428. div (ArcCall.YStart-ArcCall.Y)+ArcCall.X;
  1429. {$ifdef sectorpldebug}
  1430. If (ArcCall.YEnd-ArcCall.Y) = 0 then
  1431. begin
  1432. append(t);
  1433. writeln(t,'bug2');
  1434. close(t);
  1435. runerror(202);
  1436. end;
  1437. {$endif sectorpldebug}
  1438. plx2 := (y-ArcCall.Y)*(ArcCall.XEnd-ArcCall.X)
  1439. div (ArcCall.YEnd-ArcCall.Y)+ArcCall.X;
  1440. If plx1 > plx2 then
  1441. begin
  1442. plx1 := plx1 xor plx2;
  1443. plx2 := plx1 xor plx2;
  1444. plx1 := plx1 xor plx2;
  1445. end;
  1446. {$ifdef sectorpldebug}
  1447. append(t);
  1448. writeln(t,'lines: ',plx1,' - ',plx2);
  1449. close(t);
  1450. {$endif sectorpldebug}
  1451. End
  1452. { otherwise two points which have nothing to do with the sector }
  1453. Else exit
  1454. Else
  1455. { the arc is plotted at the right side, but not at the left side, }
  1456. { fill till the line between (ArcCall.X,ArcCall.Y) and }
  1457. { (ArcCall.XStart,ArcCall.YStart) }
  1458. Begin
  1459. If (y < ArcCall.Y) then
  1460. begin
  1461. {$ifdef sectorpldebug}
  1462. If (ArcCall.YEnd-ArcCall.Y) = 0 then
  1463. begin
  1464. append(t);
  1465. writeln(t,'bug3');
  1466. close(t);
  1467. runerror(202);
  1468. end;
  1469. {$endif sectorpldebug}
  1470. plx1 := (y-ArcCall.Y)*(ArcCall.XEnd-ArcCall.X)
  1471. div (ArcCall.YEnd-ArcCall.Y)+ArcCall.X
  1472. end
  1473. else if (y > ArcCall.Y) then
  1474. begin
  1475. {$ifdef sectorpldebug}
  1476. If (ArcCall.YStart-ArcCall.Y) = 0 then
  1477. begin
  1478. append(t);
  1479. writeln(t,'bug4');
  1480. close(t);
  1481. runerror(202);
  1482. end;
  1483. {$endif sectorpldebug}
  1484. plx1 := (y-ArcCall.Y)*(ArcCall.XStart-ArcCall.X)
  1485. div (ArcCall.YStart-ArcCall.Y)+ArcCall.X
  1486. end
  1487. else plx1 := ArcCall.X;
  1488. plx2 := x2;
  1489. {$ifdef sectorpldebug}
  1490. append(t);
  1491. writeln(t,'right: ',plx1,' - ',plx2);
  1492. close(t);
  1493. {$endif sectorpldebug}
  1494. End
  1495. Else
  1496. If (x2 = maxsmallint-1) Then
  1497. { the arc is plotted at the left side, but not at the rigth side. }
  1498. { the right limit can be either the first or second line. Just take }
  1499. { the closest one, but watch out for division by zero! }
  1500. Begin
  1501. If (y < ArcCall.Y) then
  1502. begin
  1503. {$ifdef sectorpldebug}
  1504. If (ArcCall.YStart-ArcCall.Y) = 0 then
  1505. begin
  1506. append(t);
  1507. writeln(t,'bug5');
  1508. close(t);
  1509. runerror(202);
  1510. end;
  1511. {$endif sectorpldebug}
  1512. plx2 := (y-ArcCall.Y)*(ArcCall.XStart-ArcCall.X)
  1513. div (ArcCall.YStart-ArcCall.Y)+ArcCall.X
  1514. end
  1515. else if (y > ArcCall.Y) then
  1516. begin
  1517. {$ifdef sectorpldebug}
  1518. If (ArcCall.YEnd-ArcCall.Y) = 0 then
  1519. begin
  1520. append(t);
  1521. writeln(t,'bug6');
  1522. close(t);
  1523. runerror(202);
  1524. end;
  1525. {$endif sectorpldebug}
  1526. plx2 := (y-ArcCall.Y)*(ArcCall.XEnd-ArcCall.X)
  1527. div (ArcCall.YEnd-ArcCall.Y)+ArcCall.X
  1528. end
  1529. else plx2 := ArcCall.X;
  1530. plx1 := x1;
  1531. {$ifdef sectorpldebug}
  1532. append(t);
  1533. writeln(t,'left: ',plx1,' - ',plx2);
  1534. close(t);
  1535. {$endif sectorpldebug}
  1536. End
  1537. Else
  1538. { the arc is plotted at both sides }
  1539. Begin
  1540. plx1 := x1;
  1541. plx2 := x2;
  1542. {$ifdef sectorpldebug}
  1543. append(t);
  1544. writeln(t,'normal: ',plx1,' - ',plx2);
  1545. close(t);
  1546. {$endif sectorpldebug}
  1547. End;
  1548. If plx2 > plx1 then
  1549. Begin
  1550. {$ifdef sectorpldebug}
  1551. append(t);
  1552. Writeln(t,'drawing...');
  1553. close(t);
  1554. {$endif sectorpldebug}
  1555. PatternLine(plx1,plx2,y);
  1556. end;
  1557. end;
  1558. procedure Sector(x, y: smallint; StAngle,EndAngle, XRadius, YRadius: Word);
  1559. begin
  1560. internalellipse(x,y,XRadius, YRadius, StAngle, EndAngle, {$ifdef fpc}@{$endif}SectorPL);
  1561. Line(ArcCall.XStart, ArcCall.YStart, x,y);
  1562. Line(x,y,ArcCall.Xend,ArcCall.YEnd);
  1563. end;
  1564. procedure SetFillStyle(Pattern : word; Color: word);
  1565. begin
  1566. { on invalid input, the current fill setting will be }
  1567. { unchanged. }
  1568. if (Pattern > UserFill) or (Color > GetMaxColor) then
  1569. begin
  1570. _GraphResult := grError;
  1571. exit;
  1572. end;
  1573. FillSettings.Color := Color;
  1574. FillSettings.Pattern := Pattern;
  1575. end;
  1576. procedure SetFillPattern(Pattern: FillPatternType; Color: word);
  1577. {********************************************************}
  1578. { Changes the Current FillPattern to a user defined }
  1579. { pattern and changes also the current fill color. }
  1580. { The FillPattern is saved in the FillPattern array so }
  1581. { it can still be used with SetFillStyle(UserFill,Color) }
  1582. {********************************************************}
  1583. var
  1584. i: smallint;
  1585. begin
  1586. if Color > GetMaxColor then
  1587. begin
  1588. _GraphResult := grError;
  1589. exit;
  1590. end;
  1591. FillSettings.Color := Color;
  1592. FillSettings.Pattern := UserFill;
  1593. { Save the pattern in the buffer }
  1594. For i:=1 to 8 do
  1595. FillPatternTable[UserFill][i] := Pattern[i];
  1596. end;
  1597. procedure Bar(x1,y1,x2,y2:smallint);
  1598. {********************************************************}
  1599. { Important notes for compatibility with BP: }
  1600. { - WriteMode is always CopyPut }
  1601. { - No contour is drawn for the lines }
  1602. {********************************************************}
  1603. var y : smallint;
  1604. origcolor : longint;
  1605. origlinesettings: Linesettingstype;
  1606. origwritemode : smallint;
  1607. begin
  1608. origlinesettings:=lineinfo;
  1609. origcolor:=CurrentColor;
  1610. if y1>y2 then
  1611. begin
  1612. y:=y1;
  1613. y1:=y2;
  1614. y2:=y;
  1615. end;
  1616. { Always copy mode for Bars }
  1617. origwritemode := CurrentWriteMode;
  1618. CurrentWriteMode := CopyPut;
  1619. { All lines used are of this style }
  1620. Lineinfo.linestyle:=solidln;
  1621. Lineinfo.thickness:=normwidth;
  1622. case Fillsettings.pattern of
  1623. EmptyFill :
  1624. begin
  1625. Currentcolor:=CurrentBkColor;
  1626. for y:=y1 to y2 do
  1627. Hline(x1,x2,y);
  1628. end;
  1629. SolidFill :
  1630. begin
  1631. CurrentColor:=FillSettings.color;
  1632. for y:=y1 to y2 do
  1633. Hline(x1,x2,y);
  1634. end;
  1635. else
  1636. Begin
  1637. CurrentColor:=FillSettings.color;
  1638. for y:=y1 to y2 do
  1639. patternline(x1,x2,y);
  1640. end;
  1641. end;
  1642. CurrentColor:= Origcolor;
  1643. LineInfo := OrigLineSettings;
  1644. CurrentWriteMode := OrigWritemode;
  1645. end;
  1646. procedure bar3D(x1, y1, x2, y2 : smallint;depth : word;top : boolean);
  1647. var
  1648. origwritemode : smallint;
  1649. OldX, OldY : smallint;
  1650. begin
  1651. origwritemode := CurrentWriteMode;
  1652. CurrentWriteMode := CopyPut;
  1653. Bar(x1,y1,x2,y2);
  1654. Rectangle(x1,y1,x2,y2);
  1655. { Current CP should not be updated in Bar3D }
  1656. { therefore save it and then restore it on }
  1657. { exit. }
  1658. OldX := CurrentX;
  1659. OldY := CurrentY;
  1660. if top then begin
  1661. Moveto(x1,y1);
  1662. Lineto(x1+depth,y1-depth);
  1663. Lineto(x2+depth,y1-depth);
  1664. Lineto(x2,y1);
  1665. end;
  1666. if Depth <> 0 then
  1667. Begin
  1668. Moveto(x2+depth,y1-depth);
  1669. Lineto(x2+depth,y2-depth);
  1670. Lineto(x2,y2);
  1671. end;
  1672. { restore CP }
  1673. CurrentX := OldX;
  1674. CurrentY := OldY;
  1675. CurrentWriteMode := origwritemode;
  1676. end;
  1677. {--------------------------------------------------------------------------}
  1678. { }
  1679. { COLOR AND PALETTE ROUTINES }
  1680. { }
  1681. {--------------------------------------------------------------------------}
  1682. procedure SetColor(Color: Word);
  1683. Begin
  1684. CurrentColor := Color;
  1685. end;
  1686. function GetColor: Word;
  1687. Begin
  1688. GetColor := CurrentColor;
  1689. end;
  1690. function GetBkColor: Word;
  1691. Begin
  1692. GetBkColor := CurrentBkColor;
  1693. end;
  1694. procedure SetBkColor(ColorNum: Word);
  1695. { Background color means background screen color in this case, and it is }
  1696. { INDEPENDANT of the viewport settings, so we must clear the whole screen }
  1697. { with the color. }
  1698. var
  1699. ViewPort: ViewportType;
  1700. Begin
  1701. GetViewSettings(Viewport);
  1702. SetViewPort(0,0,MaxX,MaxY,FALSE);
  1703. CurrentBkColor := ColorNum;
  1704. {ClearViewPort;}
  1705. if not DirectColor and (ColorNum<256) then
  1706. SetRGBPalette(0,
  1707. DefaultColors[ColorNum].Red,
  1708. DefaultColors[ColorNum].Green,
  1709. DefaultColors[ColorNum].Blue);
  1710. SetViewport(ViewPort.X1,Viewport.Y1,Viewport.X2,Viewport.Y2,Viewport.Clip);
  1711. end;
  1712. function GetMaxColor: word;
  1713. { Checked against TP VGA driver - CEC }
  1714. begin
  1715. GetMaxColor:=MaxColor-1; { based on an index of zero so subtract one }
  1716. end;
  1717. Procedure MoveRel(Dx, Dy: smallint);
  1718. Begin
  1719. CurrentX := CurrentX + Dx;
  1720. CurrentY := CurrentY + Dy;
  1721. end;
  1722. Procedure MoveTo(X,Y: smallint);
  1723. {********************************************************}
  1724. { Procedure MoveTo() }
  1725. {--------------------------------------------------------}
  1726. { Moves the current pointer in VIEWPORT relative }
  1727. { coordinates to the specified X,Y coordinate. }
  1728. {********************************************************}
  1729. Begin
  1730. CurrentX := X;
  1731. CurrentY := Y;
  1732. end;
  1733. function GraphErrorMsg(ErrorCode: smallint): string;
  1734. Begin
  1735. GraphErrorMsg:='';
  1736. case ErrorCode of
  1737. grOk,grFileNotFound,grInvalidDriver: exit;
  1738. grNoInitGraph: GraphErrorMsg:='Graphics driver not installed';
  1739. grNotDetected: GraphErrorMsg:='Graphics hardware not detected';
  1740. grNoLoadMem,grNoScanMem,grNoFloodMem: GraphErrorMsg := 'Not enough memory for graphics';
  1741. grNoFontMem: GraphErrorMsg := 'Not enough memory to load font';
  1742. grFontNotFound: GraphErrorMsg:= 'Font file not found';
  1743. grInvalidMode: GraphErrorMsg := 'Invalid graphics mode';
  1744. grError: GraphErrorMsg:='Graphics error';
  1745. grIoError: GraphErrorMsg:='Graphics I/O error';
  1746. grInvalidFont,grInvalidFontNum: GraphErrorMsg := 'Invalid font';
  1747. grInvalidVersion: GraphErrorMsg:='Invalid driver version';
  1748. end;
  1749. end;
  1750. Function GetMaxX: smallint;
  1751. { Routine checked against VGA driver - CEC }
  1752. Begin
  1753. GetMaxX := MaxX;
  1754. end;
  1755. Function GetMaxY: smallint;
  1756. { Routine checked against VGA driver - CEC }
  1757. Begin
  1758. GetMaxY := MaxY;
  1759. end;
  1760. Function GraphResult: smallint;
  1761. Begin
  1762. GraphResult := _GraphResult;
  1763. _GraphResult := grOk;
  1764. end;
  1765. Function GetX: smallint;
  1766. Begin
  1767. GetX := CurrentX;
  1768. end;
  1769. Function GetY: smallint;
  1770. Begin
  1771. GetY := CurrentY;
  1772. end;
  1773. Function GetDriverName: string;
  1774. begin
  1775. GetDriverName:=DriverName;
  1776. end;
  1777. procedure graphdefaults;
  1778. { PS: GraphDefaults does not ZERO the ArcCall structure }
  1779. { so a call to GetArcCoords will not change even the }
  1780. { returned values even if GraphDefaults is called in }
  1781. { between. }
  1782. var
  1783. i: smallint;
  1784. begin
  1785. lineinfo.linestyle:=solidln;
  1786. lineinfo.thickness:=normwidth;
  1787. { reset line style pattern }
  1788. for i:=0 to 15 do
  1789. LinePatterns[i] := TRUE;
  1790. { By default, according to the TP prog's reference }
  1791. { the default pattern is solid, and the default }
  1792. { color is the maximum color in the palette. }
  1793. fillsettings.color:=GetMaxColor;
  1794. fillsettings.pattern:=solidfill;
  1795. { GraphDefaults resets the User Fill pattern to $ff }
  1796. { checked with VGA BGI driver - CEC }
  1797. for i:=1 to 8 do
  1798. FillPatternTable[UserFill][i] := $ff;
  1799. CurrentColor:=white;
  1800. SetBkColor(Black);
  1801. ClipPixels := TRUE;
  1802. { Reset the viewport }
  1803. StartXViewPort := 0;
  1804. StartYViewPort := 0;
  1805. ViewWidth := MaxX;
  1806. ViewHeight := MaxY;
  1807. { Reset CP }
  1808. CurrentX := 0;
  1809. CurrentY := 0;
  1810. { normal write mode }
  1811. CurrentWriteMode := CopyPut;
  1812. { Schriftart einstellen }
  1813. CurrentTextInfo.font := DefaultFont;
  1814. CurrentTextInfo.direction:=HorizDir;
  1815. CurrentTextInfo.charsize:=1;
  1816. CurrentTextInfo.horiz:=LeftText;
  1817. CurrentTextInfo.vert:=TopText;
  1818. XAspect:=10000; YAspect:=10000;
  1819. end;
  1820. procedure GetAspectRatio(var Xasp,Yasp : word);
  1821. begin
  1822. XAsp:=XAspect;
  1823. YAsp:=YAspect;
  1824. end;
  1825. procedure SetAspectRatio(Xasp, Yasp : word);
  1826. begin
  1827. Xaspect:= XAsp;
  1828. YAspect:= YAsp;
  1829. end;
  1830. procedure SetWriteMode(WriteMode : smallint);
  1831. { TP sets the writemodes according to the following scheme (JM) }
  1832. begin
  1833. Case writemode of
  1834. xorput, andput: CurrentWriteMode := XorPut;
  1835. notput, orput, copyput: CurrentWriteMode := CopyPut;
  1836. End;
  1837. end;
  1838. procedure GetFillSettings(var Fillinfo:Fillsettingstype);
  1839. begin
  1840. Fillinfo:=Fillsettings;
  1841. end;
  1842. procedure GetFillPattern(var FillPattern:FillPatternType);
  1843. begin
  1844. FillPattern:=FillpatternTable[UserFill];
  1845. end;
  1846. procedure DrawPoly(numpoints : word;var polypoints);
  1847. type
  1848. ppointtype = ^pointtype;
  1849. pt = array[0..16000] of pointtype;
  1850. var
  1851. i : longint;
  1852. begin
  1853. if numpoints < 2 then
  1854. begin
  1855. _GraphResult := grError;
  1856. exit;
  1857. end;
  1858. for i:=0 to numpoints-2 do
  1859. line(pt(polypoints)[i].x,
  1860. pt(polypoints)[i].y,
  1861. pt(polypoints)[i+1].x,
  1862. pt(polypoints)[i+1].y);
  1863. end;
  1864. procedure PieSlice(X,Y,stangle,endAngle:smallint;Radius: Word);
  1865. begin
  1866. Sector(x,y,stangle,endangle,radius,radius);
  1867. end;
  1868. {$i fills.inc}
  1869. {$i gtext.inc}
  1870. procedure DetectGraph(var GraphDriver:smallint;var GraphMode:smallint);
  1871. var LoMode, HiMode: smallint;
  1872. CpyMode: smallint;
  1873. CpyDriver: smallint;
  1874. begin
  1875. HiMode := -1;
  1876. LoMode := -1;
  1877. { We start at VGA }
  1878. GraphDriver := VGA;
  1879. CpyMode := 0;
  1880. { search all possible graphic drivers in ascending order...}
  1881. { usually the new driver numbers indicate newest hardware...}
  1882. { Internal driver numbers start at VGA=9 }
  1883. repeat
  1884. GetModeRange(GraphDriver,LoMode,HiMode);
  1885. { save the highest mode possible...}
  1886. {$ifdef logging}
  1887. logln('Found driver '+strf(graphdriver)+' with modes '+
  1888. strf(lomode)+' - '+strf(himode));
  1889. {$endif logging}
  1890. if HiMode = -1 then break;
  1891. CpyMode:=HiMode;
  1892. CpyDriver:=GraphDriver;
  1893. { go to next driver if it exists...}
  1894. Inc(GraphDriver);
  1895. until (CpyMode=-1);
  1896. { If this is equal to -1 then no graph mode possible...}
  1897. if CpyMode = -1 then
  1898. begin
  1899. _GraphResult := grNotDetected;
  1900. exit;
  1901. end;
  1902. _GraphResult := grOK;
  1903. GraphDriver := CpyDriver;
  1904. GraphMode := CpyMode;
  1905. end;
  1906. procedure InitGraph(var GraphDriver:smallint;var GraphMode:smallint;
  1907. const PathToDriver:String);
  1908. const
  1909. {$IFDEF Linux}
  1910. dirchar = '/';
  1911. {$ELSE}
  1912. dirchar = '\';
  1913. {$ENDIF}
  1914. begin
  1915. InitVars;
  1916. { path to the fonts (where they will be searched)...}
  1917. bgipath:=PathToDriver;
  1918. if (Length(bgipath) > 0) and (bgipath[length(bgipath)]<>dirchar) then
  1919. bgipath:=bgipath+dirchar;
  1920. if not assigned(SaveVideoState) then
  1921. RunError(216);
  1922. DriverName:=InternalDriverName; { DOS Graphics driver }
  1923. if (Graphdriver=Detect) then
  1924. begin
  1925. DetectGraph(GraphDriver,GraphMode);
  1926. If _GraphResult = grNotDetected then Exit;
  1927. { _GraphResult is now already set to grOK by DetectGraph }
  1928. IntCurrentDriver := GraphDriver;
  1929. SaveVideoState;
  1930. { Actually set the graph mode...}
  1931. SetGraphMode(GraphMode);
  1932. end
  1933. else
  1934. begin
  1935. { Search if that graphics modec actually exists...}
  1936. if SearchMode(GraphDriver,GraphMode) = nil then
  1937. begin
  1938. _GraphResult := grInvalidMode;
  1939. exit;
  1940. end
  1941. else
  1942. begin
  1943. _GraphResult := grOK;
  1944. IntCurrentDriver := GraphDriver;
  1945. SaveVideoState;
  1946. {$ifdef logging}
  1947. If _GraphResult <> grOK then
  1948. LogLn('Mode setting failed after savevideostate');
  1949. {$endif logging}
  1950. SetGraphMode(GraphMode);
  1951. end;
  1952. end;
  1953. end;
  1954. procedure SetDirectVideo(DirectAccess: boolean);
  1955. begin
  1956. DirectVideo := DirectAccess;
  1957. end;
  1958. function GetDirectVideo: boolean;
  1959. begin
  1960. GetDirectVideo := DirectVideo;
  1961. end;
  1962. procedure GraphExitProc; {$ifndef fpc} far; {$endif fpc}
  1963. { deallocates all memory allocated by the graph unit }
  1964. var
  1965. list: PModeInfo;
  1966. tmp : PModeInfo;
  1967. c: graph_int;
  1968. begin
  1969. { restore old exitproc! }
  1970. exitproc := exitsave;
  1971. if IsGraphMode and ((errorcode<>0) or (erroraddr<>nil)) then
  1972. CloseGraph;
  1973. {$ifdef testsave}
  1974. restorevideostate;
  1975. {$endif testsave}
  1976. { release memory allocated for fonts }
  1977. for c := 1 to installedfonts do
  1978. with fonts[c] Do
  1979. If assigned(instr) Then
  1980. Freemem(instr,instrlength);
  1981. { release memory allocated for modelist }
  1982. list := ModeList;
  1983. while assigned(list) do
  1984. begin
  1985. tmp := list;
  1986. list:=list^.next;
  1987. dispose(tmp);
  1988. end;
  1989. {$IFDEF DPMI}
  1990. { We had copied the buffer of mode information }
  1991. { and allocated it dynamically... now free it }
  1992. { Warning: if GetVESAInfo returned false, this buffer is not allocated! (JM)}
  1993. If hasVesa then
  1994. Dispose(VESAInfo.ModeList);
  1995. {$ENDIF}
  1996. end;
  1997. procedure InitializeGraph;
  1998. begin
  1999. {$ifdef logging}
  2000. assign(debuglog,'grlog.txt');
  2001. rewrite(debuglog);
  2002. close(debuglog);
  2003. {$endif logging}
  2004. isgraphmode := false;
  2005. ModeList := nil;
  2006. SaveVideoState := nil;
  2007. RestoreVideoState := nil;
  2008. {$ifdef oldfont}
  2009. {$ifdef go32v2}
  2010. LoadFont8x8;
  2011. {$endif go32v2}
  2012. {$endif oldfont}
  2013. { This must be called at startup... because GetGraphMode may }
  2014. { be called even when not in graph mode. }
  2015. {$ifdef logging}
  2016. LogLn('Calling QueryAdapterInfo...');
  2017. {$endif logging}
  2018. QueryAdapterInfo;
  2019. { Install standard fonts }
  2020. { This is done BEFORE startup... }
  2021. InstalledFonts := 0;
  2022. InstallUserFont('TRIP');
  2023. InstallUserFont('LITT');
  2024. InstallUserFont('SANS');
  2025. InstallUserFont('GOTH');
  2026. InstallUserFont('SCRI');
  2027. InstallUserFont('SIMP');
  2028. InstallUserFont('TSCR');
  2029. InstallUserFont('LCOM');
  2030. InstallUserFont('EURO');
  2031. InstallUserFont('BOLD');
  2032. { This installs an exit procedure which cleans up the mode list...}
  2033. ExitSave := ExitProc;
  2034. ExitProc := @GraphExitProc;
  2035. {$ifdef testsave}
  2036. savevideostate;
  2037. {$endif testsave}
  2038. {$ifdef win32}
  2039. charmessagehandler:=nil;
  2040. {$endif win32}
  2041. end;
  2042. {
  2043. $Log$
  2044. Revision 1.31 2000-04-02 12:13:36 florian
  2045. * some more procedures can be now hooked by the OS specific implementation
  2046. Revision 1.30 2000/03/24 18:16:32 florian
  2047. * introduce a DrawBitmapCharHoriz procedure variable to accelerate output on
  2048. win32
  2049. Revision 1.29 2000/03/24 13:01:15 florian
  2050. * ClearViewPort fixed
  2051. Revision 1.28 2000/03/19 11:20:13 peter
  2052. * graph unit include is now independent and the dependent part
  2053. is now in graph.pp
  2054. * ggigraph unit for linux added
  2055. Revision 1.60 2000/03/18 10:45:07 sg
  2056. * Fix for ClearViewportDefault: The width and the height of the rectangle
  2057. it filled has been one pixel too high.
  2058. Revision 1.59 2000/03/17 13:28:54 sg
  2059. * Use linux unit under Linux
  2060. Revision 1.58 2000/03/08 14:20:14 jonas
  2061. * writemode was not set to normalput during clearviewport (and it uses hline)
  2062. Revision 1.57 2000/02/27 14:41:25 peter
  2063. * removed warnings/notes
  2064. Revision 1.56 2000/02/06 01:47:15 sg
  2065. * For Linux, "/" is added to the bgipath instead of "\" if this character
  2066. isn't already there.
  2067. Revision 1.55 2000/01/07 16:41:37 daniel
  2068. * copyright 2000
  2069. Revision 1.54 2000/01/07 16:32:25 daniel
  2070. * copyright 2000 added
  2071. Revision 1.53 2000/01/02 19:02:39 jonas
  2072. * removed/commented out (inited but) unused vars and unused types
  2073. Revision 1.52 1999/12/29 17:26:00 jonas
  2074. + by default, also attempt to install the fonts that come with TP7
  2075. Revision 1.51 1999/12/26 10:33:06 jonas
  2076. * XAspect and YAspect are now words instead of smallints, they
  2077. overflowed for resolutions > 640x480 otherwise
  2078. * the number of pixels required for an ellipse in internalellipsedef
  2079. is now calculated after the aspectratios have been taken into
  2080. account
  2081. Revision 1.50 1999/12/21 17:42:17 jonas
  2082. * changed vesa.inc do it doesn't try to use linear modes anymore (doesn't work
  2083. yet!!)
  2084. * fixed mode detection so the low modenumber of a driver doesn't have to be zero
  2085. anymore (so VESA autodetection now works)
  2086. Revision 1.49 1999/12/21 09:16:48 pierre
  2087. + CloseGraph if errors
  2088. Revision 1.48 1999/12/20 11:22:36 peter
  2089. * integer -> smallint to overcome -S2 switch needed for ggi version
  2090. Revision 1.47 1999/12/12 13:34:20 jonas
  2091. * putimage now performs the lipping itself and uses directputpixel
  2092. (note: this REQUIRES or/and/notput support in directputpixel,
  2093. this is not yet the case in the assembler versions!)
  2094. * YOffset addition moved in hlinevesa256 and vlinevesa256
  2095. because it uses still putpixel afterwards
  2096. Revision 1.46 1999/12/11 23:41:38 jonas
  2097. * changed definition of getscanlineproc to "getscanline(x1,x2,y:
  2098. smallint; var data);" so it can be used by getimage too
  2099. * changed getimage so it uses getscanline
  2100. * changed floodfill, getscanline16 and definitions in Linux
  2101. include files so they use this new format
  2102. + getscanlineVESA256 for 256 color VESA modes (banked)
  2103. Revision 1.45 1999/12/10 12:47:41 pierre
  2104. * SetBkColor like BP by changing Palette entry zero
  2105. Revision 1.44 1999/11/30 08:57:46 michael
  2106. + Removed charmessagehandler declaration, it is in graphh.inc
  2107. Revision 1.43 1999/11/28 16:13:55 jonas
  2108. * corrected misplacement of call to initvars in initgraph
  2109. + some extra debugging commands (for -dlogging) in the mode functions
  2110. Revision 1.42 1999/11/28 12:19:59 jonas
  2111. * _GraphResult is now properly set to grOK by DetectGraph and
  2112. InitGraph if there are no errors
  2113. Revision 1.41 1999/11/27 21:48:01 jonas
  2114. * fixed VlineVESA256 and re-enabled it in graph.inc
  2115. * added procedure detectgraph to interface of graph unit
  2116. Revision 1.40 1999/11/25 17:44:14 pierre
  2117. * memory corruption within GetImage removed
  2118. Revision 1.39 1999/11/24 23:42:31 pierre
  2119. * PutImage used an smallint index that became negative !!!!
  2120. * Default needed procedure now genrate a RTE 218 instead of a
  2121. GPF by call to nil pointer !
  2122. Revision 1.38 1999/11/11 17:55:07 florian
  2123. * the size was calculated wrong by imagesize
  2124. Revision 1.37 1999/11/11 14:07:14 florian
  2125. * better looking font
  2126. Revision 1.36 1999/11/08 15:01:38 peter
  2127. * fpcmake support
  2128. Revision 1.35 1999/11/08 11:15:22 peter
  2129. * move graph.inc to the target dir
  2130. Revision 1.34 1999/11/03 20:23:01 florian
  2131. + first release of win32 gui support
  2132. Revision 1.33 1999/10/17 10:20:13 jonas
  2133. * fixed clipping for thickwidth lines (bug 659)
  2134. * fixed the faster internalellipsedefault, but it doesn't plot
  2135. all pixels (there are gaps in the ellipses)
  2136. Revision 1.32 1999/09/28 15:07:46 jonas
  2137. * fix for disposing font data because it can contain #0 chars
  2138. Revision 1.31 1999/09/28 13:56:25 jonas
  2139. * reordered some local variables (first 4 byte vars, then 2 byte vars
  2140. etc)
  2141. * font data is now disposed in exitproc, exitproc is now called
  2142. GraphExitProc (was CleanModes) and resides in graph.pp instead of in
  2143. modes.inc
  2144. Revision 1.30 1999/09/27 23:34:41 peter
  2145. * new graph unit is default for go32v2
  2146. * removed warnings/notes
  2147. Revision 1.29 1999/09/26 13:31:06 jonas
  2148. * changed name of modeinfo variable to vesamodeinfo and fixed
  2149. associated errors (fillchar(modeinfo,sizeof(tmodeinfo),#0) instead
  2150. of sizeof(TVesamodeinfo) etc)
  2151. * changed several sizeof(type) to sizeof(varname) to avoid similar
  2152. errors in the future
  2153. Revision 1.28 1999/09/25 11:48:43 jonas
  2154. + detectgraph
  2155. * small change to internalellipsedefault so less pixels are
  2156. calculated twice
  2157. * some small corrections to graph.tex
  2158. Revision 1.27 1999/09/24 22:52:38 jonas
  2159. * optimized patternline a bit (always use hline when possible)
  2160. * isgraphmode stuff cleanup
  2161. * vesainfo.modelist now gets disposed in cleanmode instead of in
  2162. closegraph (required moving of some declarations from vesa.inc to
  2163. new vesah.inc)
  2164. * queryadapter gets no longer called from initgraph (is called from
  2165. initialization of graph unit)
  2166. * bugfix for notput in 32k and 64k vesa modes
  2167. * a div replaced by / in fillpoly
  2168. Revision 1.26 1999/09/22 13:13:35 jonas
  2169. * renamed text.inc -> gtext.inc to avoid conflict with system unit
  2170. * fixed textwidth
  2171. * isgraphmode now gets properly updated, so mode restoring works
  2172. again
  2173. Revision 1.25 1999/09/18 22:21:10 jonas
  2174. + hlinevesa256 and vlinevesa256
  2175. + support for not/xor/or/andput in vesamodes with 32k/64k colors
  2176. * lots of changes to avoid warnings under FPC
  2177. Revision 1.24 1999/09/18 16:03:37 jonas
  2178. * graph.pp: removed pieslice and sector from ToDo list
  2179. * closegraph: exits now immidiately if isgraphmode = false (caused
  2180. RTE 204 with VESA enabled if you set exitproc to call closegraph
  2181. and also called closegraph explicitely before exit, like bgidemo)
  2182. Revision 1.23 1999/09/17 13:58:31 jonas
  2183. * another fix for a case where internalellipsedefault went haywire
  2184. * sector() and pieslice() fully implemented!
  2185. * small change to prevent buffer overflow with floodfill
  2186. Revision 1.22 1999/09/15 13:37:50 jonas
  2187. * small change to internalellipsedef to be TP compatible
  2188. * fixed directputpixel for vga 320*200*256
  2189. Revision 1.21 1999/09/13 12:49:08 jonas
  2190. * fixed Arc: internallellipse went into an endless loop if StAngle =
  2191. EndAngle
  2192. * FillEllipse is now much faster: no more floodfill,
  2193. InternalEllipseDefault now draws the patternlines immediatety!
  2194. Revision 1.20 1999/09/12 17:29:00 jonas
  2195. * several changes to internalellipse to make it faster
  2196. and to make sure it updates the ArcCall correctly
  2197. (not yet done for width = 3)
  2198. * Arc mostly works now, only sometimes an endless loop, don't know
  2199. why
  2200. Revision 1.19 1999/09/11 19:43:01 jonas
  2201. * FloodFill: did not take into account current viewport settings
  2202. * GetScanLine: only get line inside viewport, data outside of it
  2203. is not used anyway
  2204. * InternalEllipseDefault: fix for when xradius or yradius = 0 and
  2205. increase xradius and yradius always by one (TP does this too)
  2206. * fixed conlict in vesa.inc from last update
  2207. * some conditionals to avoid range check and overflow errors in
  2208. places where it doesn't matter
  2209. Revision 1.18 1999/07/26 09:38:41 florian
  2210. * bar: y2 can be less y1, fixed
  2211. * settextstyle: charsize can be 0, must be changed into 1
  2212. Revision 1.17 1999/07/18 15:07:20 jonas
  2213. + xor-, and and- orput support for VESA256 modes
  2214. * compile with -dlogging if you wnt some info to be logged to grlog.txt
  2215. Revision 1.16 1999/07/14 18:18:04 florian
  2216. * cosmetic changes
  2217. }