graph.inc 77 KB

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