graph.inc 80 KB

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