graph.pp 100 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1993,99 by the Free Pascal development team
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. Unit Graph;
  12. {-------------------------------------------------------}
  13. { Differences with TP Graph unit: }
  14. { - default putimage and getimage only support a max. }
  15. { of 64K colors on screen, because all pixels are }
  16. { saved as words. }
  17. { - Set RGB Palette is not used, SetPalette must be }
  18. { used instead. }
  19. { - In the TP graph unit, Clipping is always performed }
  20. { on strings written with OutText, and this clipping }
  21. { is done on a character per character basis (for }
  22. { example, if ONE part of a character is outside the }
  23. { viewport , then that character is not written at }
  24. { all to the screen. In FPC Pascal, clipping is done }
  25. { on a PIXEL basis, not a character basis, so part of }
  26. { characters which are not entirely in the viewport }
  27. { may appear on the screen. }
  28. { - SetTextStyle only conforms to the TP version when }
  29. { the correct (and expected) values are used for }
  30. { CharSize for stroked fonts (4 = stroked fonts) }
  31. { - InstallUserDriver is not supported, so always }
  32. { returns an error. }
  33. { - RegisterBGIDriver is not supported, so always }
  34. { returns an error. }
  35. { - DrawPoly XORPut mode is not exactly the same as in }
  36. { the TP graph unit. }
  37. { - Imagesize returns a longint instead of a word }
  38. { - ImageSize cannot return an error value }
  39. {-------------------------------------------------------}
  40. { AUTHORS: }
  41. { Gernot Tenchio - original version }
  42. { Florian Klaempfl - major updates }
  43. { Pierre Mueller - major bugfixes }
  44. { Carl Eric Codere - complete rewrite }
  45. { Thomas Schatzl - optimizations,routines and }
  46. { suggestions. }
  47. { Jonas Maebe - bugfixes and optimizations }
  48. { Credits (external): }
  49. { - Original FloodFill code by }
  50. { Menno Victor van der star }
  51. { (the code has been heavily modified) }
  52. {-------------------------------------------------------}
  53. {-------------------------------------------------------}
  54. { For significant speed improvements , is is recommended }
  55. { that these routines be hooked (otherwise the default, }
  56. { slower routines will be used) : }
  57. { HLine() }
  58. { VLine() }
  59. { PatternLine() }
  60. { ClearViewPort() }
  61. { PutImage() }
  62. { GetImage() - ImageSize() should also be changed }
  63. { InternalEllipse() }
  64. { Line() }
  65. { GetScanLine() }
  66. {--------------------------------------------------------}
  67. { FPC unit requirements: }
  68. { All modes should at least have 1 graphics page to }
  69. { make it possible to create animation on all supported }
  70. { systems , this can be done either by double-buffering }
  71. { yourself in the heap if no hardware is available to do}
  72. { it. }
  73. {--------------------------------------------------------}
  74. { COMPATIBILITY WARNING: Some of the compatibility tests }
  75. { were done using the CGA and other the VGA drivers. }
  76. { Within the BGI drivers themselves the BEHAVIOUR is not }
  77. { the same, so be warned!!! }
  78. {--------------------------------------------------------}
  79. { History log: }
  80. { 15th February 1999: }
  81. { + Added support for system font in vertical mode }
  82. { + system font is now available for all platforms }
  83. { * font support routines now compile }
  84. { * textHeight would not return correct size for system }
  85. { font }
  86. { * Alignment of fonts partly fixed }
  87. { 17th Feb. 1999: }
  88. { + First support for stroked fonts }
  89. { 18th Feb. 1999: }
  90. { * bugfix of line drawing which fixes stroked font }
  91. { displays. }
  92. { 23rd Feb. 1999: }
  93. { + Applied Pierre's patches to font }
  94. { + Added scaling of bitmapped fonts }
  95. { + Vertical stroked fonts }
  96. { 24th Feb. 1999: }
  97. { * Scaling of stroked fonts must be done using FPs }
  98. { to be 100% compatible with turbo pascal }
  99. { + Sped up by 40% stroked font scaling calculations }
  100. { + RegisterBGIFont }
  101. { 9th march 1999: }
  102. { + Starting implementing Fillpoly() }
  103. { 15th march 1999: }
  104. { + SetFillStyle() }
  105. { + patternLine() }
  106. { + Bar() }
  107. { * GraphDefaults would not make the Default color }
  108. { of the fill pattern to the Max. Palette entry. }
  109. { + SetFillPattern() }
  110. { 20th march 1999: }
  111. { * GraphDefaults would not reset to the text system }
  112. { * DefaultFont would write one character too much to }
  113. { the screen }
  114. { + Sloped thick lines in Line() }
  115. { + Sloped patterned lines in Line() }
  116. { * GraphDefaults would not reset the User Fill pattern}
  117. { to $ff }
  118. { + DirectPutPixel takes care of XOR mode writes }
  119. { improves speed by about 30% over old method of }
  120. { GetPixel XOR CurrentColor }
  121. { * Dashed LineStyle exactly like BP version now }
  122. { + Center LineStyle (checked against CGA driver) }
  123. { * GraphDefaults() now resets linepattern array }
  124. { 1st april 1999: }
  125. { + First implementation of FillPoly (incomplete) }
  126. { 2nd april 1999: }
  127. { * FillPoly did not Reset PatternLine index }
  128. { * FillPoly did not use correct color }
  129. { * PatternLine was writing modes in reverse direction }
  130. { * PatternLine would not work with non-rectangular }
  131. { shapes. }
  132. { * PatternLine must fill up the ENTIRE pattern, }
  133. { with either the foreground or background color. }
  134. { * GraphDefaults() would not call SetBkColor() }
  135. { * Fixed some memory leaks in FillPoly() }
  136. { 11th April 1999: }
  137. { * PatternLine() was drawing one pixel less then }
  138. { requested }
  139. { 12th April 1999: }
  140. { + FloodFill - first working implementation }
  141. { Horrbly slow even on very fast cpu's }
  142. { + Some suggestions of Thomas implemented }
  143. { 13th April 1999: }
  144. { * FloodFill() vertical index was off by one pixel }
  145. { * FloodFill() would never draw the last line in the }
  146. { list }
  147. { - Removed ClearViewPort320 which was wrong anyways, }
  148. { will need to be implemented later. }
  149. { * PatternLine() would not always restore write mode }
  150. { + Circle() uses NormalPut always with NormWidth lines}
  151. { + FillEllipse() initial version }
  152. { * InternalEllipse() - 0 to 360 now supported as }
  153. { angles. }
  154. { 14th April 1999: }
  155. { * mod x = and (x-1)(from Thomas Schatzl) gives a }
  156. { significant speed improvement. }
  157. { 15th april 1999: }
  158. { + Arc() ok except for Aspect Ratio, which does not }
  159. { give us the correct ratio on a 320x200 screen. }
  160. { + Added FillPoly() from Thomas Schatzl }
  161. { + More hookable routines }
  162. { 16th april 1999: }
  163. { + Line() checked ok. }
  164. { 17th april 1999: }
  165. { * GraphDefaults() would not reset CP }
  166. { + GetX(), GetY(), MoveTo() checked for viewports }
  167. { * OutTextXY() should not update the CP }
  168. { * ClearViewPort() would not update the CP }
  169. { * ClearDevice() would not update the CP }
  170. { * Sector() would update the CP by calling LineTo }
  171. { * Bar3D() would update the CP }
  172. { * PieSlice() would update the CP }
  173. { 18th april 1999: }
  174. { + Clipping algorithm }
  175. { 19th april 1999: }
  176. { + Adapterinfo structure }
  177. { 20th april 1999: }
  178. { + GetModeName }
  179. { + GetGraphMode }
  180. { + GetModeRange }
  181. {--------------------------------------------------------}
  182. { LEFT TO DO: }
  183. { - optimize scaling of stroked fonts }
  184. { - optimize InternalEllipse() }
  185. { using linear appx. of sine/cosine tables }
  186. { - justification for stroked fonts does not work }
  187. { - On Closegraph deallocate all font pointers }
  188. {--------------------------------------------------------}
  189. { text.inc will crash on aligned requirement machines. }
  190. { (packed record for fontrec) }
  191. {$ifndef fpc}
  192. {$G+}
  193. {$endif}
  194. Interface
  195. {$ifdef win32}
  196. uses
  197. windows;
  198. {$endif win32}
  199. const
  200. { error codes }
  201. grOk = 0;
  202. grNoInitGraph = -1;
  203. grNotDetected = -2;
  204. grFileNotFound = -3;
  205. grInvalidDriver = -4;
  206. grNoLoadMem = -5;
  207. grNoScanMem = -6;
  208. grNoFloodMem = -7;
  209. grFontNotFound = -8;
  210. grNoFontMem = -9;
  211. grInvalidMode = -10;
  212. grError = -11;
  213. grIOerror = -12;
  214. grInvalidFont = -13;
  215. grInvalidFontNum = -14;
  216. grInvalidVersion = -18;
  217. { Color constants for setpalette }
  218. black = 0;
  219. blue = 1;
  220. green = 2;
  221. cyan = 3;
  222. red = 4;
  223. magenta = 5;
  224. brown = 6;
  225. lightgray = 7;
  226. darkgray = 8;
  227. lightblue = 9;
  228. lightgreen = 10;
  229. lightcyan = 11;
  230. lightred = 12;
  231. lightmagenta = 13;
  232. yellow = 14;
  233. white = 15;
  234. EGABlack = 0;
  235. EGABlue = 1;
  236. EGAGreen = 2;
  237. EGACyan = 3;
  238. EGARed = 4;
  239. EGAMagenta = 5;
  240. EGALightgray= 7;
  241. EGABrown = 20;
  242. EGADarkgray = 56;
  243. EGALightblue = 57;
  244. EGALightgreen = 58;
  245. EGALightcyan = 59;
  246. EGALightred = 60;
  247. EGALightmagenta=61;
  248. EGAYellow = 62;
  249. EGAWhite = 63;
  250. { Line styles for GetLineStyle/SetLineStyle }
  251. SolidLn = 0;
  252. DottedLn = 1;
  253. CenterLn = 2;
  254. DashedLn = 3;
  255. UserBitLn = 4;
  256. NormWidth = 1;
  257. ThickWidth = 3;
  258. { Set/GetTextStyle Konstanten: }
  259. DefaultFont = 0;
  260. TriplexFont = 1;
  261. SmallFont = 2;
  262. SansSerifFont = 3;
  263. GothicFont = 4;
  264. ScriptFont = 5;
  265. SimpleFont = 6;
  266. TSCRFont = 7;
  267. LCOMFont = 8;
  268. EuroFont = 9;
  269. BoldFont = 10;
  270. HorizDir = 0;
  271. VertDir = 1;
  272. UserCharSize = 0;
  273. ClipOn = true;
  274. ClipOff = false;
  275. { Bar3D constants }
  276. TopOn = true;
  277. TopOff = false;
  278. { fill pattern for Get/SetFillStyle: }
  279. EmptyFill = 0;
  280. SolidFill = 1;
  281. LineFill = 2;
  282. LtSlashFill = 3;
  283. SlashFill = 4;
  284. BkSlashFill = 5;
  285. LtBkSlashFill = 6;
  286. HatchFill = 7;
  287. XHatchFill = 8;
  288. InterleaveFill = 9;
  289. WideDotFill = 10;
  290. CloseDotFill = 11;
  291. UserFill = 12;
  292. { bitblt operators }
  293. NormalPut = 0;
  294. CopyPut = 0;
  295. XORPut = 1;
  296. OrPut = 2;
  297. AndPut = 3;
  298. NotPut = 4;
  299. { SetTextJustify constants }
  300. LeftText = 0;
  301. CenterText = 1;
  302. RightText = 2;
  303. BottomText = 0;
  304. TopText = 2;
  305. { graphic drivers }
  306. CurrentDriver = -128;
  307. Detect = 0;
  308. LowRes = 1;
  309. HercMono = 7;
  310. VGA = 9;
  311. VESA = 10;
  312. { graph modes }
  313. Default = 0;
  314. { VGA Driver modes }
  315. VGALo = 0;
  316. VGAMed = 1;
  317. VGAHi = 2;
  318. { Hercules mono card }
  319. HercMonoHi = 0;
  320. MaxColors = 255; { Maximum possible colors using a palette }
  321. { otherwise, direct color encoding }
  322. type
  323. RGBRec = packed record
  324. Red: integer;
  325. Green: integer;
  326. Blue : integer;
  327. end;
  328. PaletteType = record
  329. Size : longint;
  330. Colors : array[0..MaxColors] of RGBRec;
  331. end;
  332. LineSettingsType = record
  333. linestyle : word;
  334. pattern : word;
  335. thickness : word;
  336. end;
  337. TextSettingsType = record
  338. font : word;
  339. direction : word;
  340. charsize : word;
  341. horiz : word;
  342. vert : word;
  343. end;
  344. FillSettingsType = record
  345. pattern : word;
  346. color : word;
  347. end;
  348. FillPatternType = array[1..8] of byte;
  349. PointType = record
  350. x,y : integer;
  351. end;
  352. ViewPortType = record
  353. x1,y1,x2,y2 : integer;
  354. Clip : boolean;
  355. end;
  356. ArcCoordsType = record
  357. x,y : integer;
  358. xstart,ystart : integer;
  359. xend,yend : integer;
  360. end;
  361. {$IFDEF FPC}
  362. graph_int = longint; { platform specific integer used for indexes;
  363. should be 16 bits on TP/BP and 32 bits on every-
  364. thing else for speed reasons }
  365. graph_float = single; { the platform's preferred floating point size }
  366. {$ELSE}
  367. graph_int = integer; { platform specific integer used for indexes;
  368. should be 16 bits on TP/BP and 32 bits on every-
  369. thing else for speed reasons }
  370. graph_float = real; { the platform's preferred floating point size }
  371. {$ENDIF}
  372. const
  373. fillpatternTable : array[0..12] of FillPatternType = (
  374. ($00,$00,$00,$00,$00,$00,$00,$00), { background color }
  375. ($ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff), { foreground color }
  376. ($ff,$ff,$00,$00,$ff,$ff,$00,$00), { horizontal lines }
  377. ($01,$02,$04,$08,$10,$20,$40,$80), { slashes }
  378. ($07,$0e,$1c,$38,$70,$e0,$c1,$83), { thick slashes }
  379. ($07,$83,$c1,$e0,$70,$38,$1c,$0e), { thick backslashes }
  380. ($5a,$2d,$96,$4b,$a5,$d2,$69,$b4), { backslashes }
  381. ($ff,$88,$88,$88,$ff,$88,$88,$88), { small boxes }
  382. ($18,$24,$42,$81,$81,$42,$24,$18), { rhombus }
  383. ($cc,$33,$cc,$33,$cc,$33,$cc,$33), { wall pattern }
  384. ($80,$00,$08,$00,$80,$00,$08,$00), { wide points }
  385. ($88,$00,$22,$00,$88,$00,$22,$00), { dense points }
  386. (0,0,0,0,0,0,0,0) { user defined line style }
  387. );
  388. { ******************** PROCEDURAL VARIABLES ********************* }
  389. { * These are hooks which have device specific stuff in them, * }
  390. { * therefore to add new modes or to redirect these routines * }
  391. { * then declare variables of these types as shown below. * }
  392. {-----------------------------------------------------------------}
  393. TYPE
  394. { This is the standard putpixel routine used by all function }
  395. { drawing routines, it will use the viewport settings, as }
  396. { well as clip, and use the current foreground color to plot }
  397. { the desired pixel. }
  398. defpixelproc = procedure(X,Y: Integer);
  399. { standard plot and get pixel }
  400. getpixelproc = function(X,Y: Integer): word;
  401. putpixelproc = procedure(X,Y: Integer; Color: Word);
  402. { clears the viewport, also used to clear the device }
  403. clrviewproc = procedure;
  404. { putimage procedure, can be hooked to accomplish transparency }
  405. putimageproc = procedure (X,Y: Integer; var Bitmap; BitBlt: Word);
  406. getimageproc = procedure(X1,Y1,X2,Y2: Integer; Var Bitmap);
  407. imagesizeproc= function (X1,Y1,X2,Y2: Integer): longint;
  408. graphfreememprc = procedure (var P: Pointer; size: word);
  409. graphgetmemprc = procedure (var P: pointer; size: word);
  410. { internal routines -- can be hooked for much faster drawing }
  411. { draw filled horizontal lines using current color }
  412. { on entry coordinates are already clipped. }
  413. hlineproc = procedure (x, x2,y : integer);
  414. { on entry coordinates are already clipped. }
  415. { draw filled vertical line using current color }
  416. vlineproc = procedure (x,y,y2: integer);
  417. { this routine is used to draw filled patterns for all routines }
  418. { that require it. (FillPoly, FloodFill, Sector, etc... }
  419. { clipping is verified, uses current Fill settings for drawing }
  420. patternlineproc = procedure (x1,x2,y: integer);
  421. { this routine is used to draw all circles/ellipses/sectors }
  422. { more info... on this later... }
  423. ellipseproc = procedure (X,Y: Integer;XRadius: word;
  424. YRadius:word; stAngle,EndAngle: word; fp: PatternLineProc);
  425. { Line routine - draws lines thick/norm widths with current }
  426. { color and line style - LINE must be clipped here. }
  427. lineproc = procedure (X1, Y1, X2, Y2 : Integer);
  428. { this routine is used for FloodFill - it returns an entire }
  429. { screen scan line with a word for each pixel in the scanline }
  430. getscanlineproc = procedure (Y : integer; var data);
  431. { changes the active display screen where we draw to... }
  432. setactivepageproc = procedure (page: word);
  433. { changes the active display screen which we see ... }
  434. setvisualpageproc = procedure (page: word);
  435. { this routine actually switches to the desired video mode. }
  436. initmodeproc = procedure;
  437. { this routine is called to save the sate just before a mode set }
  438. savestateproc = procedure;
  439. { this routine is called in closegraph to cleanup... }
  440. restorestateproc = procedure;
  441. { This routine is a hook for SetRGBPalette }
  442. setrgbpaletteproc =
  443. procedure(ColorNum, RedValue, GreenValue, BlueValue: Integer);
  444. { This routine is a hook for GetRGBPalette }
  445. getrgbpaletteproc =
  446. procedure(ColorNum: integer; var
  447. RedValue, GreenValue, BlueValue: Integer);
  448. TYPE
  449. {-----------------------------------}
  450. { Linked list for mode information }
  451. { This list is set up by one of the }
  452. { following routines: }
  453. { It lists all available resolutions}
  454. { on this display adapter. }
  455. {-----------------------------------}
  456. { QueryAdapter() }
  457. { DetectGraph() }
  458. { InitGraph() }
  459. {-----------------------------------}
  460. PModeInfo = ^TModeInfo;
  461. TModeInfo = record
  462. DriverNumber: Integer;
  463. ModeNumber: Integer;
  464. MaxColor: Longint; { Maximum colors on screen }
  465. PaletteSize : Longint; { Maximum palette entry we can change }
  466. XAspect : Integer; { XAspect ratio correction factor }
  467. YAspect : Integer; { YAspect ratio correction factor }
  468. MaxX: Integer; { Max-X row }
  469. MaxY: Integer; { Max. column. }
  470. DirectColor: boolean; { Is this a direct color mode?? }
  471. Hardwarepages: byte; { total number of image pages - 1 }
  472. ModeName: String[18];
  473. { necessary hooks ... }
  474. DirectPutPixel : DefPixelProc;
  475. GetPixel : GetPixelProc;
  476. PutPixel : PutPixelProc;
  477. SetRGBPalette : SetRGBPaletteProc;
  478. GetRGBPalette : GetRGBPaletteProc;
  479. { defaults possible ... }
  480. SetVisualPage : SetVisualPageProc;
  481. SetActivePage : SetActivePageProc;
  482. ClearViewPort : ClrViewProc;
  483. PutImage : PutImageProc;
  484. GetImage : GetImageProc;
  485. ImageSize : ImageSizeProc;
  486. GetScanLine : GetScanLineProc;
  487. Line : LineProc;
  488. InternalEllipse: EllipseProc;
  489. PatternLine : PatternLineProc;
  490. HLine : HLineProc;
  491. VLine : VLineProc;
  492. InitMode : InitModeProc;
  493. next: PModeInfo;
  494. end;
  495. VAR
  496. DirectPutPixel : DefPixelProc;
  497. ClearViewPort : ClrViewProc;
  498. PutPixel : PutPixelProc;
  499. PutImage : PutImageProc;
  500. GetImage : GetImageProc;
  501. ImageSize : ImageSizeProc;
  502. GetPixel : GetPixelProc;
  503. SetVisualPage : SetVisualPageProc;
  504. SetActivePage : SetActivePageProc;
  505. SetRGBPalette : SetRGBPaletteProc;
  506. GetRGBPalette : GetRGBPaletteProc;
  507. GraphFreeMemPtr: graphfreememprc;
  508. GraphGetMemPtr : graphgetmemprc;
  509. GetScanLine : GetScanLineProc;
  510. Line : LineProc;
  511. InternalEllipse: EllipseProc;
  512. PatternLine : PatternLineProc;
  513. HLine : HLineProc;
  514. VLine : VLineProc;
  515. SaveVideoState : SaveStateProc;
  516. RestoreVideoState: RestoreStateProc;
  517. ExitSave: pointer;
  518. Procedure Closegraph;
  519. procedure SetLineStyle(LineStyle: word; Pattern: word; Thickness: word);
  520. function GraphErrorMsg(ErrorCode: Integer): string;
  521. Function GetMaxX: Integer;
  522. Function GetMaxY: Integer;
  523. Procedure SetViewPort(X1, Y1, X2, Y2: Integer; Clip: Boolean);
  524. Function GraphResult: Integer;
  525. function GetModeName(ModeNumber: integer): string;
  526. procedure SetGraphMode(Mode: Integer);
  527. function GetGraphMode: Integer;
  528. function GetMaxMode: word;
  529. procedure RestoreCrtMode;
  530. procedure GetModeRange(GraphDriver: Integer; var LoMode, HiMode: Integer);
  531. Function GetX: Integer;
  532. Function GetY: Integer;
  533. procedure GraphDefaults;
  534. procedure ClearDevice;
  535. procedure GetViewSettings(var viewport : ViewPortType);
  536. procedure SetWriteMode(WriteMode : integer);
  537. procedure GetFillSettings(var Fillinfo:Fillsettingstype);
  538. procedure GetFillPattern(var FillPattern:FillPatternType);
  539. procedure GetLineSettings(var ActiveLineInfo : LineSettingsType);
  540. procedure InitGraph(var GraphDriver:Integer;var GraphMode:Integer;const PathToDriver:String);
  541. procedure DetectGraph(var GraphDriver:Integer;var GraphMode:Integer);
  542. function InstallUserDriver(Name: string; AutoDetectPtr: Pointer): integer;
  543. function RegisterBGIDriver(driver: pointer): integer;
  544. procedure SetFillStyle(Pattern : word; Color: word);
  545. procedure SetFillPattern(Pattern: FillPatternType; Color: word);
  546. Function GetDriverName: string;
  547. procedure MoveRel(Dx, Dy: Integer);
  548. procedure MoveTo(X,Y: Integer);
  549. procedure SetDirectVideo(DirectAccess: boolean);
  550. function GetDirectVideo: boolean;
  551. { -------------------- Color/Palette ------------------------------- }
  552. procedure SetBkColor(ColorNum: Word);
  553. function GetColor: Word;
  554. function GetBkColor: Word;
  555. procedure SetColor(Color: Word);
  556. function GetMaxColor: word;
  557. procedure SetAllPalette(var Palette:PaletteType);
  558. procedure SetPalette(ColorNum: word; Color: shortint);
  559. procedure GetPalette(var Palette: PaletteType);
  560. function GetPaletteSize: integer;
  561. procedure GetDefaultPalette(var Palette: PaletteType);
  562. { -------------------- Shapes/Lines -------------------------------- }
  563. procedure Rectangle(x1,y1,x2,y2:integer);
  564. procedure Bar(x1,y1,x2,y2:integer);
  565. procedure Bar3D(x1, y1, x2, y2 : integer;depth : word;top : boolean);
  566. procedure FillPoly(NumPoints: word; Var PolyPoints);
  567. procedure DrawPoly(NumPoints : word;var polypoints);
  568. procedure LineRel(Dx, Dy: Integer);
  569. procedure LineTo(X,Y : Integer);
  570. procedure FloodFill(x : integer; y : integer; Border: word);
  571. { -------------------- Circle related routines --------------------- }
  572. procedure GetAspectRatio(var Xasp,Yasp : word);
  573. procedure SetAspectRatio(Xasp, Yasp : word);
  574. procedure GetArcCoords(var ArcCoords: ArcCoordsType);
  575. procedure Arc(X,Y : Integer; StAngle,EndAngle,Radius: word);
  576. procedure PieSlice(X,Y,stangle,endAngle:integer;Radius: Word);
  577. procedure FillEllipse(X, Y: Integer; XRadius, YRadius: Word);
  578. procedure Circle(X, Y: Integer; Radius:Word);
  579. procedure Sector(x, y: Integer; StAngle,EndAngle, XRadius, YRadius: Word);
  580. procedure Ellipse(X,Y : Integer; stAngle, EndAngle: word; XRadius,
  581. YRadius: word);
  582. { --------------------- Text related routines --------------------- }
  583. function InstallUserFont(const FontFileName : string) : integer;
  584. function RegisterBGIfont(font : pointer) : integer;
  585. procedure GetTextSettings(var TextInfo : TextSettingsType);
  586. function TextHeight(const TextString : string) : word;
  587. function TextWidth(const TextString : string) : word;
  588. procedure SetTextJustify(horiz,vert : word);
  589. procedure SetTextStyle(font,direction : word;charsize : word);
  590. procedure SetUserCharSize(Multx,Divx,Multy,Divy : word);
  591. procedure OutTextXY(x,y : integer;const TextString : string);
  592. procedure OutText(const TextString : string);
  593. { Load extra graph additions per system like mode constants }
  594. {$i graphh.inc}
  595. Implementation
  596. { what a mess ... it would be much better if the graph unit }
  597. { would follow the structure of the FPC system unit: }
  598. { the main file is system depended and the system independend part }
  599. { is included (FK) }
  600. {$ifdef fpc}
  601. {$ifdef go32v2}
  602. {$define dpmi}
  603. uses go32,ports;
  604. Type TDPMIRegisters = go32.registers;
  605. {$endif go32v2}
  606. {$ifdef win32}
  607. uses
  608. strings;
  609. {$endif}
  610. {$else fpc}
  611. {$IFDEF DPMI}
  612. uses WinAPI;
  613. {$ENDIF}
  614. {$endif fpc}
  615. {$ifdef logging}
  616. var debuglog: text;
  617. function strf(l: longint): string;
  618. begin
  619. str(l, strf)
  620. end;
  621. Procedure Log(Const s: String);
  622. Begin
  623. Append(debuglog);
  624. Write(debuglog, s);
  625. Close(debuglog);
  626. End;
  627. Procedure LogLn(Const s: string);
  628. Begin
  629. Append(debuglog);
  630. Writeln(debuglog,s);
  631. Close(debuglog);
  632. End;
  633. {$endif logging}
  634. const
  635. StdBufferSize = 4096; { Buffer size for FloodFill }
  636. type
  637. tinttable = array[0..16383] of integer;
  638. pinttable = ^tinttable;
  639. WordArray = Array [0..StdbufferSize] Of word;
  640. PWordArray = ^WordArray;
  641. const
  642. { Mask for each bit in byte used to determine pattern }
  643. BitArray: Array[0..7] of byte =
  644. ($01,$02,$04,$08,$10,$20,$40,$80);
  645. RevbitArray: Array[0..7] of byte =
  646. ($80,$40,$20,$10,$08,$04,$02,$01);
  647. { pre expanded line patterns }
  648. { 0 = LSB of byte pattern }
  649. { 15 = MSB of byte pattern }
  650. LinePatterns: Array[0..15] of BOOLEAN =
  651. (TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,
  652. TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,TRUE);
  653. const
  654. BGIPath : string = '.';
  655. { Default font 8x8 system from IBM PC }
  656. {$i fontdata.inc}
  657. var
  658. CurrentColor: Word;
  659. CurrentBkColor: Word;
  660. CurrentX : Integer; { viewport relative }
  661. CurrentY : Integer; { viewport relative }
  662. ClipPixels: Boolean; { Should cliiping be enabled }
  663. CurrentWriteMode: Integer;
  664. _GraphResult : Integer;
  665. LineInfo : LineSettingsType;
  666. FillSettings: FillSettingsType;
  667. { information for Text Output routines }
  668. CurrentTextInfo : TextSettingsType;
  669. CurrentXRatio, CurrentYRatio: graph_float;
  670. installedfonts: longint; { Number of installed fonts }
  671. StartXViewPort: Integer; { absolute }
  672. StartYViewPort: Integer; { absolute }
  673. ViewWidth : Integer;
  674. ViewHeight: Integer;
  675. IsGraphMode : Boolean; { Indicates if we are in graph mode or not }
  676. ArcCall: ArcCoordsType; { Information on the last call to Arc or Ellipse }
  677. var
  678. { ******************** HARDWARE INFORMATION ********************* }
  679. { Should be set in InitGraph once only. }
  680. IntCurrentMode : Integer;
  681. IntCurrentDriver : Integer; { Currently loaded driver }
  682. XAspect : Integer;
  683. YAspect : Integer;
  684. MaxX : Integer; { Maximum resolution - ABSOLUTE }
  685. MaxY : Integer; { Maximum resolution - ABSOLUTE }
  686. MaxColor : Longint;
  687. PaletteSize : longint; { Maximum palette entry we can set, usually equal}
  688. { maxcolor. }
  689. HardwarePages : byte; { maximum number of hardware visual pages }
  690. DriverName: String;
  691. DirectColor : Boolean ; { Is it a direct color mode? }
  692. ModeList : PModeInfo;
  693. DirectVideo : Boolean; { Direct access to video memory? }
  694. {--------------------------------------------------------------------------}
  695. { }
  696. { LINE AND LINE RELATED ROUTINES }
  697. { }
  698. {--------------------------------------------------------------------------}
  699. {$i clip.inc}
  700. procedure HLineDefault(x,x2,y: integer); {$ifndef fpc}far;{$endif fpc}
  701. var
  702. xtmp: integer;
  703. Begin
  704. { must we swap the values? }
  705. if x >= x2 then
  706. Begin
  707. xtmp := x2;
  708. x2 := x;
  709. x:= xtmp;
  710. end;
  711. { First convert to global coordinates }
  712. X := X + StartXViewPort;
  713. X2 := X2 + StartXViewPort;
  714. Y := Y + StartYViewPort;
  715. if ClipPixels then
  716. Begin
  717. if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
  718. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  719. exit;
  720. end;
  721. for x:= x to x2 do
  722. DirectPutPixel(X,Y);
  723. end;
  724. procedure VLineDefault(x,y,y2: integer); {$ifndef fpc}far;{$endif fpc}
  725. var
  726. ytmp: integer;
  727. Begin
  728. { must we swap the values? }
  729. if y >= y2 then
  730. Begin
  731. ytmp := y2;
  732. y2 := y;
  733. y:= ytmp;
  734. end;
  735. { First convert to global coordinates }
  736. X := X + StartXViewPort;
  737. Y2 := Y2 + StartYViewPort;
  738. Y := Y + StartYViewPort;
  739. if ClipPixels then
  740. Begin
  741. if LineClipped(x,y,x,y2,StartXViewPort,StartYViewPort,
  742. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  743. exit;
  744. end;
  745. for y := y to y2 do Directputpixel(x,y)
  746. End;
  747. Procedure DirectPutPixelClip(x,y: Integer);
  748. { for thickwidth lines, because they may call DirectPutPixel for coords }
  749. { outside the current viewport (bug found by CEC) }
  750. Begin
  751. If (Not ClipPixels) Or
  752. ((X >= StartXViewPort) And (X <= (StartXViewPort + ViewWidth)) And
  753. (Y >= StartYViewPort) And (Y <= (StartYViewPort + ViewHeight))) then
  754. Begin
  755. DirectPutPixel(x,y)
  756. End
  757. End;
  758. procedure LineDefault(X1, Y1, X2, Y2: Integer); {$ifndef fpc}far;{$endif fpc}
  759. var X, Y : Integer;
  760. deltax, deltay : Integer;
  761. d, dinc1, dinc2: Integer;
  762. xinc1 : Integer;
  763. xinc2 : Integer;
  764. yinc1 : Integer;
  765. yinc2 : Integer;
  766. i : Integer;
  767. Flag : Boolean; { determines pixel direction in thick lines }
  768. NumPixels : Integer;
  769. PixelCount : Integer;
  770. OldCurrentColor: Word;
  771. swtmp : integer;
  772. TmpNumPixels : integer;
  773. begin
  774. {******************************************}
  775. { SOLID LINES }
  776. {******************************************}
  777. if lineinfo.LineStyle = SolidLn then
  778. Begin
  779. { we separate normal and thick width for speed }
  780. { and because it would not be 100% compatible }
  781. { with the TP graph unit otherwise }
  782. if y1 = y2 then
  783. Begin
  784. {******************************************}
  785. { SOLID LINES HORIZONTAL }
  786. {******************************************}
  787. if lineinfo.Thickness=NormWidth then
  788. hline(x1,x2,y2)
  789. else
  790. begin
  791. { thick width }
  792. hline(x1,x2,y2-1);
  793. hline(x1,x2,y2);
  794. hline(x2,x2,y2+1);
  795. end;
  796. end
  797. else
  798. if x1 = x2 then
  799. Begin
  800. {******************************************}
  801. { SOLID LINES VERTICAL }
  802. {******************************************}
  803. if lineinfo.Thickness=NormWidth then
  804. vline(x1,y1,y2)
  805. else
  806. begin
  807. { thick width }
  808. vline(x1-1,y1,y2);
  809. vline(x1,y1,y2);
  810. vline(x1+1,y1,y2);
  811. end;
  812. end
  813. else
  814. begin
  815. { Convert to global coordinates. }
  816. x1 := x1 + StartXViewPort;
  817. x2 := x2 + StartXViewPort;
  818. y1 := y1 + StartYViewPort;
  819. y2 := y2 + StartYViewPort;
  820. { if fully clipped then exit... }
  821. if ClipPixels then
  822. begin
  823. if LineClipped(x1,y1,x2,y2,StartXViewPort, StartYViewPort,
  824. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  825. exit;
  826. end;
  827. {******************************************}
  828. { SLOPED SOLID LINES }
  829. {******************************************}
  830. oldCurrentColor :=
  831. CurrentColor;
  832. { Calculate deltax and deltay for initialisation }
  833. deltax := abs(x2 - x1);
  834. deltay := abs(y2 - y1);
  835. { Initialize all vars based on which is the independent variable }
  836. if deltax >= deltay then
  837. begin
  838. Flag := FALSE;
  839. { x is independent variable }
  840. numpixels := deltax + 1;
  841. d := (2 * deltay) - deltax;
  842. dinc1 := deltay Shl 1;
  843. dinc2 := (deltay - deltax) shl 1;
  844. xinc1 := 1;
  845. xinc2 := 1;
  846. yinc1 := 0;
  847. yinc2 := 1;
  848. end
  849. else
  850. begin
  851. Flag := TRUE;
  852. { y is independent variable }
  853. numpixels := deltay + 1;
  854. d := (2 * deltax) - deltay;
  855. dinc1 := deltax Shl 1;
  856. dinc2 := (deltax - deltay) shl 1;
  857. xinc1 := 0;
  858. xinc2 := 1;
  859. yinc1 := 1;
  860. yinc2 := 1;
  861. end;
  862. { Make sure x and y move in the right directions }
  863. if x1 > x2 then
  864. begin
  865. xinc1 := - xinc1;
  866. xinc2 := - xinc2;
  867. end;
  868. if y1 > y2 then
  869. begin
  870. yinc1 := - yinc1;
  871. yinc2 := - yinc2;
  872. end;
  873. { Start drawing at <x1, y1> }
  874. x := x1;
  875. y := y1;
  876. If LineInfo.Thickness=NormWidth then
  877. Begin
  878. { Draw the pixels }
  879. for i := 1 to numpixels do
  880. begin
  881. DirectPutPixel(x, y);
  882. if d < 0 then
  883. begin
  884. d := d + dinc1;
  885. x := x + xinc1;
  886. y := y + yinc1;
  887. end
  888. else
  889. begin
  890. d := d + dinc2;
  891. x := x + xinc2;
  892. y := y + yinc2;
  893. end;
  894. CurrentColor := OldCurrentColor;
  895. end;
  896. end
  897. else
  898. { Thick width lines }
  899. begin
  900. { Draw the pixels }
  901. for i := 1 to numpixels do
  902. begin
  903. { all depending on the slope, we can determine }
  904. { in what direction the extra width pixels will be put }
  905. If Flag then
  906. Begin
  907. DirectPutPixelClip(x-1,y);
  908. DirectPutPixelClip(x,y);
  909. DirectPutPixelClip(x+1,y);
  910. end
  911. else
  912. Begin
  913. DirectPutPixelClip(x, y-1);
  914. DirectPutPixelClip(x, y);
  915. DirectPutPixelClip(x, y+1);
  916. end;
  917. if d < 0 then
  918. begin
  919. d := d + dinc1;
  920. x := x + xinc1;
  921. y := y + yinc1;
  922. end
  923. else
  924. begin
  925. d := d + dinc2;
  926. x := x + xinc2;
  927. y := y + yinc2;
  928. end;
  929. CurrentColor := OldCurrentColor;
  930. end;
  931. end;
  932. end;
  933. end
  934. else
  935. {******************************************}
  936. { begin patterned lines }
  937. {******************************************}
  938. Begin
  939. { Convert to global coordinates. }
  940. x1 := x1 + StartXViewPort;
  941. x2 := x2 + StartXViewPort;
  942. y1 := y1 + StartYViewPort;
  943. y2 := y2 + StartYViewPort;
  944. { if fully clipped then exit... }
  945. if ClipPixels then
  946. begin
  947. if LineClipped(x1,y1,x2,y2,StartXViewPort, StartYViewPort,
  948. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  949. exit;
  950. end;
  951. OldCurrentColor := CurrentColor;
  952. PixelCount:=0;
  953. if y1 = y2 then
  954. Begin
  955. { Check if we must swap }
  956. if x1 >= x2 then
  957. Begin
  958. swtmp := x1;
  959. x1 := x2;
  960. x2 := swtmp;
  961. end;
  962. if LineInfo.Thickness = NormWidth then
  963. Begin
  964. for PixelCount:=x1 to x2 do
  965. { optimization: PixelCount mod 16 }
  966. if LinePatterns[PixelCount and 15] = TRUE then
  967. begin
  968. DirectPutPixel(PixelCount,y2);
  969. end;
  970. end
  971. else
  972. Begin
  973. for i:=-1 to 1 do
  974. Begin
  975. for PixelCount:=x1 to x2 do
  976. { Optimization from Thomas - mod 16 = and 15 }
  977. {this optimization has been performed by the compiler
  978. for while as well (JM)}
  979. if LinePatterns[PixelCount and 15] = TRUE then
  980. begin
  981. DirectPutPixelClip(PixelCount,y2+i);
  982. end;
  983. end;
  984. end;
  985. end
  986. else
  987. if x1 = x2 then
  988. Begin
  989. { Check if we must swap }
  990. if y1 >= y2 then
  991. Begin
  992. swtmp := y1;
  993. y1 := y2;
  994. y2 := swtmp;
  995. end;
  996. if LineInfo.Thickness = NormWidth then
  997. Begin
  998. for PixelCount:=y1 to y2 do
  999. { compare if we should plot a pixel here , compare }
  1000. { with predefined line patterns... }
  1001. if LinePatterns[PixelCount and 15] = TRUE then
  1002. begin
  1003. DirectPutPixel(x1,PixelCount);
  1004. end;
  1005. end
  1006. else
  1007. Begin
  1008. for i:=-1 to 1 do
  1009. Begin
  1010. for PixelCount:=y1 to y2 do
  1011. { compare if we should plot a pixel here , compare }
  1012. { with predefined line patterns... }
  1013. if LinePatterns[PixelCount and 15] = TRUE then
  1014. begin
  1015. DirectPutPixelClip(x1+i,PixelCount);
  1016. end;
  1017. end;
  1018. end;
  1019. end
  1020. else
  1021. Begin
  1022. oldCurrentColor := CurrentColor;
  1023. { Calculate deltax and deltay for initialisation }
  1024. deltax := abs(x2 - x1);
  1025. deltay := abs(y2 - y1);
  1026. { Initialize all vars based on which is the independent variable }
  1027. if deltax >= deltay then
  1028. begin
  1029. Flag := FALSE;
  1030. { x is independent variable }
  1031. numpixels := deltax + 1;
  1032. d := (2 * deltay) - deltax;
  1033. dinc1 := deltay Shl 1;
  1034. dinc2 := (deltay - deltax) shl 1;
  1035. xinc1 := 1;
  1036. xinc2 := 1;
  1037. yinc1 := 0;
  1038. yinc2 := 1;
  1039. end
  1040. else
  1041. begin
  1042. Flag := TRUE;
  1043. { y is independent variable }
  1044. numpixels := deltay + 1;
  1045. d := (2 * deltax) - deltay;
  1046. dinc1 := deltax Shl 1;
  1047. dinc2 := (deltax - deltay) shl 1;
  1048. xinc1 := 0;
  1049. xinc2 := 1;
  1050. yinc1 := 1;
  1051. yinc2 := 1;
  1052. end;
  1053. { Make sure x and y move in the right directions }
  1054. if x1 > x2 then
  1055. begin
  1056. xinc1 := - xinc1;
  1057. xinc2 := - xinc2;
  1058. end;
  1059. if y1 > y2 then
  1060. begin
  1061. yinc1 := - yinc1;
  1062. yinc2 := - yinc2;
  1063. end;
  1064. { Start drawing at <x1, y1> }
  1065. x := x1;
  1066. y := y1;
  1067. If LineInfo.Thickness=ThickWidth then
  1068. Begin
  1069. TmpNumPixels := NumPixels-1;
  1070. { Draw the pixels }
  1071. for i := 0 to TmpNumPixels do
  1072. begin
  1073. { all depending on the slope, we can determine }
  1074. { in what direction the extra width pixels will be put }
  1075. If Flag then
  1076. Begin
  1077. { compare if we should plot a pixel here , compare }
  1078. { with predefined line patterns... }
  1079. if LinePatterns[i and 15] = TRUE then
  1080. begin
  1081. DirectPutPixelClip(x-1,y);
  1082. DirectPutPixelClip(x,y);
  1083. DirectPutPixelClip(x+1,y);
  1084. end;
  1085. end
  1086. else
  1087. Begin
  1088. { compare if we should plot a pixel here , compare }
  1089. { with predefined line patterns... }
  1090. if LinePatterns[i and 15] = TRUE then
  1091. begin
  1092. DirectPutPixelClip(x,y-1);
  1093. DirectPutPixelClip(x,y);
  1094. DirectPutPixelClip(x,y+1);
  1095. end;
  1096. end;
  1097. if d < 0 then
  1098. begin
  1099. d := d + dinc1;
  1100. x := x + xinc1;
  1101. y := y + yinc1;
  1102. end
  1103. else
  1104. begin
  1105. d := d + dinc2;
  1106. x := x + xinc2;
  1107. y := y + yinc2;
  1108. end;
  1109. end;
  1110. end
  1111. else
  1112. Begin
  1113. { instead of putting in loop , substract by one now }
  1114. TmpNumPixels := NumPixels-1;
  1115. { NormWidth }
  1116. for i := 0 to TmpNumPixels do
  1117. begin
  1118. if LinePatterns[i and 15] = TRUE then
  1119. begin
  1120. DirectPutPixel(x,y);
  1121. end;
  1122. if d < 0 then
  1123. begin
  1124. d := d + dinc1;
  1125. x := x + xinc1;
  1126. y := y + yinc1;
  1127. end
  1128. else
  1129. begin
  1130. d := d + dinc2;
  1131. x := x + xinc2;
  1132. y := y + yinc2;
  1133. end;
  1134. end;
  1135. end
  1136. end;
  1137. {******************************************}
  1138. { end patterned lines }
  1139. {******************************************}
  1140. { restore color }
  1141. CurrentColor:=OldCurrentColor;
  1142. end;
  1143. end; { Line }
  1144. {********************************************************}
  1145. { Procedure DummyPatternLine() }
  1146. {--------------------------------------------------------}
  1147. { This is suimply an procedure that does nothing which }
  1148. { can be passed as a patternlineproc for non-filled }
  1149. { ellipses }
  1150. {********************************************************}
  1151. Procedure DummyPatternLine(x1, x2, y: integer); {$ifdef tp} far; {$endif tp}
  1152. begin
  1153. end;
  1154. {********************************************************}
  1155. { Procedure InternalEllipse() }
  1156. {--------------------------------------------------------}
  1157. { This routine first calculates all points required to }
  1158. { draw a circle to the screen, and stores the points }
  1159. { to display in a buffer before plotting them. The }
  1160. { aspect ratio of the screen is taken into account when }
  1161. { calculating the values. }
  1162. {--------------------------------------------------------}
  1163. { INPUTS: X,Y : Center coordinates of Ellipse. }
  1164. { XRadius - X-Axis radius of ellipse. }
  1165. { YRadius - Y-Axis radius of ellipse. }
  1166. { stAngle, EndAngle: Start angle and end angles of the }
  1167. { ellipse (used for partial ellipses and circles) }
  1168. { pl: procedure which either draws a patternline (for }
  1169. { FillEllipse) or does nothing (arc etc) }
  1170. {--------------------------------------------------------}
  1171. { NOTE: - }
  1172. { - }
  1173. {********************************************************}
  1174. Procedure InternalEllipseDefault(X,Y: Integer;XRadius: word;
  1175. YRadius:word; stAngle,EndAngle: word; pl: PatternLineProc); {$ifndef fpc}far;{$endif fpc}
  1176. Const ConvFac = Pi/180.0;
  1177. var
  1178. j, Delta, DeltaEnd: graph_float;
  1179. NumOfPixels: longint;
  1180. TempTerm: graph_float;
  1181. xtemp, ytemp, xp, yp, xm, ym, xnext, ynext,
  1182. plxpyp, plxmyp, plxpym, plxmym: integer;
  1183. BackupColor, DeltaAngle, TmpAngle, OldLineWidth: word;
  1184. Begin
  1185. If LineInfo.ThickNess = ThickWidth Then
  1186. { first draw the two outer ellipses using normwidth and no filling (JM) }
  1187. Begin
  1188. OldLineWidth := LineInfo.Thickness;
  1189. LineInfo.Thickness := NormWidth;
  1190. InternalEllipseDefault(x,y,XRadius,YRadius,StAngle,EndAngle,
  1191. {$ifdef fpc}@{$endif fpc}DummyPatternLine);
  1192. InternalEllipseDefault(x,y,XRadius+1,YRadius+1,StAngle,EndAngle,
  1193. {$ifdef fpc}@{$endif fpc}DummyPatternLine);
  1194. If (XRadius <> 0) and (YRadius <> 0) Then
  1195. { draw the smallest ellipse last, since that one will use the }
  1196. { original pl, so it could possibly draw patternlines (JM) }
  1197. Begin
  1198. Dec(XRadius);
  1199. Dec(YRadius);
  1200. End
  1201. Else Exit;
  1202. { restore line thickness }
  1203. LineInfo.Thickness := OldLineWidth;
  1204. End;
  1205. { check for an ellipse with negligable x and y radius }
  1206. If (xradius <= 1) and (yradius <= 1) then
  1207. begin
  1208. putpixel(x,y,CurrentColor);
  1209. ArcCall.X := X;
  1210. ArcCall.Y := Y;
  1211. ArcCall.XStart := X;
  1212. ArcCall.YStart := Y;
  1213. ArcCall.XEnd := X;
  1214. ArcCall.YEnd := Y;
  1215. exit;
  1216. end;
  1217. { for restoring after PatternLine }
  1218. BackupColor := CurrentColor;
  1219. If xradius = 0 then inc(xradius);
  1220. if yradius = 0 then inc(yradius);
  1221. { check if valid angles }
  1222. stangle := stAngle mod 361;
  1223. EndAngle := EndAngle mod 361;
  1224. { if impossible angles then swap them! }
  1225. if Endangle < StAngle then
  1226. Begin
  1227. TmpAngle:=EndAngle;
  1228. EndAngle:=StAngle;
  1229. Stangle:=TmpAngle;
  1230. end;
  1231. { calculate difference of angle now so we don't always have to calculate it }
  1232. DeltaAngle:= EndAngle-StAngle;
  1233. { approximate the number of pixels required by using the circumference }
  1234. { equation of an ellipse. }
  1235. { Changed this formula a it (trial and error), but the net result is that }
  1236. { less pixels have to be calculated now }
  1237. NumOfPixels:=Round(Sqrt(3)*sqrt(sqr(XRadius)+sqr(YRadius)));
  1238. { Calculate the angle precision required }
  1239. Delta := 90.0 / (NumOfPixels);
  1240. { Adjust for screen aspect ratio }
  1241. XRadius:=(longint(XRadius)*10000) div XAspect;
  1242. YRadius:=(longint(YRadius)*10000) div YAspect;
  1243. { removed from inner loop to make faster }
  1244. { store some arccall info }
  1245. ArcCall.X := X;
  1246. ArcCall.Y := Y;
  1247. TempTerm := (StAngle)*ConvFac;
  1248. ArcCall.XStart := round(XRadius*Cos(TempTerm)) + X;
  1249. ArcCall.YStart := round(YRadius*Sin(TempTerm+Pi)) + Y;
  1250. TempTerm := (EndAngle)*ConvFac;
  1251. ArcCall.XEnd := round(XRadius*Cos(TempTerm)) + X;
  1252. ArcCall.YEnd := round(YRadius*Sin(TempTerm+Pi)) + Y;
  1253. { Always just go over the first 90 degrees. Could be optimized a }
  1254. { bit if StAngle and EndAngle lie in the same quadrant, left as an }
  1255. { exercise for the reader :) (JM) }
  1256. j := 0;
  1257. { calculate stop position, go 1 further than 90 because otherwise }
  1258. { 1 pixel is sometimes not drawn (JM) }
  1259. DeltaEnd := 91;
  1260. { Calculate points }
  1261. xnext := XRadius;
  1262. ynext := 0;
  1263. Repeat
  1264. xtemp := xnext;
  1265. ytemp := ynext;
  1266. { this is used by both sin and cos }
  1267. TempTerm := (j+Delta)*ConvFac;
  1268. { Calculate points }
  1269. xnext := round(XRadius*Cos(TempTerm));
  1270. ynext := round(YRadius*Sin(TempTerm+Pi));
  1271. xp := x + xtemp;
  1272. xm := x - xtemp;
  1273. yp := y + ytemp;
  1274. ym := y - ytemp;
  1275. plxpyp := maxint;
  1276. plxmyp := -maxint-1;
  1277. plxpym := maxint;
  1278. plxmym := -maxint-1;
  1279. If (j >= StAngle) and (j <= EndAngle) then
  1280. begin
  1281. plxpyp := xp;
  1282. PutPixel(xp,yp,CurrentColor);
  1283. end;
  1284. If ((180-j) >= StAngle) and ((180-j) <= EndAngle) then
  1285. begin
  1286. plxmyp := xm;
  1287. PutPixel(xm,yp,CurrentColor);
  1288. end;
  1289. If ((j+180) >= StAngle) and ((j+180) <= EndAngle) then
  1290. begin
  1291. plxmym := xm;
  1292. PutPixel(xm,ym,CurrentColor);
  1293. end;
  1294. If ((360-j) >= StAngle) and ((360-j) <= EndAngle) then
  1295. begin
  1296. plxpym := xp;
  1297. PutPixel(xp,ym,CurrentColor);
  1298. end;
  1299. If (ynext <> ytemp) and
  1300. (xp <> xm) then
  1301. begin
  1302. CurrentColor := FillSettings.Color;
  1303. pl(plxmyp+1,plxpyp-1,yp);
  1304. pl(plxmym+1,plxpym-1,ym);
  1305. CurrentColor := BackupColor;
  1306. end;
  1307. j:=j+Delta;
  1308. Until j > (DeltaEnd);
  1309. end;
  1310. {********************************************************}
  1311. { Procedure InternalEllipse() }
  1312. {--------------------------------------------------------}
  1313. { This routine first calculates all points required to }
  1314. { draw a circle to the screen, and stores the points }
  1315. { to display in a buffer before plotting them. The }
  1316. { aspect ratio of the screen is taken into account when }
  1317. { calculating the values. }
  1318. {--------------------------------------------------------}
  1319. { INPUTS: X,Y : Center coordinates of Ellipse. }
  1320. { XRadius - X-Axis radius of ellipse. }
  1321. { YRadius - Y-Axis radius of ellipse. }
  1322. { stAngle, EndAngle: Start angle and end angles of the }
  1323. { ellipse (used for partial ellipses and circles) }
  1324. {--------------------------------------------------------}
  1325. { NOTE: - uses the current write mode. }
  1326. { - Angles must both be between 0 and 360 }
  1327. {********************************************************}
  1328. (*
  1329. Procedure InternalEllipseDefault (x, y : integer;
  1330. xradius, yradius, stAngle, EndAngle : Word; pl: PatternLineProc); {$ifndef fpc} far; {$endif fpc}
  1331. { Draw an ellipse arc. Crude but it works (anyone have a better one?) }
  1332. Var
  1333. aSqr, bSqr, twoaSqr, twobSqr, xa, ya, twoXbSqr, twoYaSqr, error : LongInt;
  1334. Alpha, TempTerm : graph_float;
  1335. BackupColor: Word;
  1336. plxpyp, plxmyp, plxpym, plxmym: integer;
  1337. const
  1338. RadToDeg = 180/Pi;
  1339. Procedure PlotPoints;
  1340. var
  1341. i,j: integer;
  1342. xm, ym: integer;
  1343. xp, yp: integer;
  1344. Begin
  1345. ym := y-ya;
  1346. yp := y+ya;
  1347. xm := x-xa;
  1348. xp := x+xa;
  1349. plxpyp := maxint;
  1350. plxmyp := -maxint-1;
  1351. plxpym := maxint;
  1352. plxmym := -maxint-1;
  1353. if LineInfo.Thickness = Normwidth then
  1354. Begin
  1355. If (Alpha+270>=StAngle) And (Alpha+270<=EndAngle) then
  1356. Begin
  1357. plxmym := xm;
  1358. PutPixel (xm,ym, CurrentColor);
  1359. End;
  1360. If ((180+270)-Alpha>=StAngle) And ((180+270)-Alpha<=EndAngle) then
  1361. Begin
  1362. plxmyp := xm;
  1363. PutPixel (xm,yp, CurrentColor);
  1364. End;
  1365. If ((180+270)+Alpha>=StAngle) And ((180+270)+Alpha<=EndAngle) then
  1366. Begin
  1367. plxpyp := xp;
  1368. PutPixel (xp,yp, CurrentColor);
  1369. End;
  1370. If ((360+270)-Alpha>=StAngle) And ((360+270)-Alpha<=EndAngle) then
  1371. Begin
  1372. plxpym := xp;
  1373. PutPixel (xp,ym, CurrentColor);
  1374. End;
  1375. end
  1376. else
  1377. Begin
  1378. If (Alpha+270>=StAngle) And (Alpha+270<=EndAngle) then
  1379. Begin
  1380. plxmym := xm + 1;
  1381. for i:=-1 to 1 do
  1382. for j:=-1 to 1 do
  1383. PutPixel (xm+i,ym+j, CurrentColor);
  1384. End;
  1385. If ((180+270)-Alpha>=StAngle) And ((180+270)-Alpha<=EndAngle) then
  1386. Begin
  1387. plxmyp := xm + 1;
  1388. for i:=-1 to 1 do
  1389. for j:=-1 to 1 do
  1390. PutPixel (xm+i,yp+j, CurrentColor);
  1391. End;
  1392. If ((180+270)+Alpha>=StAngle) And ((180+270)+Alpha<=EndAngle) then
  1393. Begin
  1394. plxpyp := xp - 1;
  1395. for i:=-1 to 1 do
  1396. for j:=-1 to 1 do
  1397. PutPixel (xp+i,yp+j, CurrentColor);
  1398. End;
  1399. If ((360+270)-Alpha>=StAngle) And ((360+270)-Alpha<=EndAngle) then
  1400. Begin
  1401. plxpym := xp - 1;
  1402. for i:=-1 to 1 do
  1403. for j:=-1 to 1 do
  1404. PutPixel (xp+i,ym+j, CurrentColor);
  1405. End;
  1406. end;
  1407. If (xp <> xm) then
  1408. begin
  1409. CurrentColor := FillSettings.Color;
  1410. pl(plxmyp+1,plxpyp-1,yp);
  1411. pl(plxmym+1,plxpym-1,ym);
  1412. CurrentColor := BackupColor;
  1413. end;
  1414. End;
  1415. Begin
  1416. { check for an ellipse with negligable x and y radius }
  1417. If (xradius <= 1) and (yradius <= 1) then
  1418. begin
  1419. putpixel(x,y,CurrentColor);
  1420. ArcCall.X := X;
  1421. ArcCall.Y := Y;
  1422. ArcCall.XStart := X;
  1423. ArcCall.YStart := Y;
  1424. ArcCall.XEnd := X;
  1425. ArcCall.YEnd := Y;
  1426. exit;
  1427. end;
  1428. { for restoring after PatternLine }
  1429. BackupColor := CurrentColor;
  1430. If xradius = 0 then inc(xradius);
  1431. if yradius = 0 then inc(yradius);
  1432. { store arccall info }
  1433. ArcCall.x := x;
  1434. ArcCall.y := y;
  1435. TempTerm := StAngle*RadToDeg;
  1436. ArcCall.XStart := round(XRadius*Cos(TempTerm)) + X;
  1437. ArcCall.YStart := round(YRadius*Sin(TempTerm+Pi)) + Y;
  1438. TempTerm := EndAngle*RadToDeg;
  1439. ArcCall.XEnd := round(XRadius*Cos(TempTerm)) + X;
  1440. ArcCall.YEnd := round(YRadius*Sin(TempTerm+Pi)) + Y;
  1441. StAngle:=StAngle MOD 361;
  1442. EndAngle:=EndAngle MOD 361;
  1443. StAngle := StAngle + 270;
  1444. EndAngle := EndAngle + 270;
  1445. If StAngle>EndAngle then
  1446. Begin
  1447. StAngle:=StAngle Xor EndAngle; EndAngle:=EndAngle Xor StAngle; StAngle:=EndAngle Xor StAngle;
  1448. End;
  1449. { Adjust for screen aspect ratio }
  1450. XRadius:=(longint(XRadius)*10000) div XAspect;
  1451. YRadius:=(longint(YRadius)*10000) div YAspect;
  1452. aSqr:=LongInt (xradius)*LongInt (xradius);
  1453. bSqr:=LongInt (yradius)*LongInt (yradius);
  1454. twoaSqr:=2*aSqr;
  1455. twobSqr:=2*bSqr;
  1456. xa:=0;
  1457. ya:=yradius;
  1458. twoXbSqr:=0;
  1459. twoYaSqr:=ya*twoaSqr;
  1460. error:=-ya*aSqr;
  1461. While twoXbSqr<=twoYaSqr Do Begin
  1462. If ya=0 then Alpha:=90 Else Alpha:=RadToDeg*Arctan (xa/ya); { Crude but it works }
  1463. PlotPoints;
  1464. Inc (xa);
  1465. Inc (twoXbSqr,twobSqr);
  1466. Inc (error,twoXbSqr-bSqr);
  1467. If error>=0 then Begin
  1468. Dec (ya);
  1469. Dec (twoYaSqr,twoaSqr);
  1470. Dec (error,twoYaSqr);
  1471. End;
  1472. End;
  1473. xa:=xradius;
  1474. ya:=0;
  1475. twoXbSqr:=xa*twobSqr;
  1476. twoYaSqr:=0;
  1477. error:=-xa*bSqr;
  1478. While twoXbSqr>twoYaSqr Do Begin
  1479. If ya=0 then Alpha:=90 Else Alpha:=RadToDeg*Arctan (xa/ya);
  1480. PlotPoints;
  1481. Inc (ya);
  1482. Inc (twoYaSqr,twoaSqr);
  1483. Inc (error,twoYaSqr-aSqr);
  1484. If error>=0 then Begin
  1485. Dec (xa);
  1486. Dec (twoXbSqr,twobSqr);
  1487. Dec (error,twoXbSqr);
  1488. End;
  1489. End;
  1490. End;
  1491. *)
  1492. procedure PatternLineDefault(x1,x2,y: integer); {$ifndef fpc}far;{$endif fpc}
  1493. {********************************************************}
  1494. { Draws a horizontal patterned line according to the }
  1495. { current Fill Settings. }
  1496. {********************************************************}
  1497. { Important notes: }
  1498. { - CurrentColor must be set correctly before entering }
  1499. { this routine. }
  1500. {********************************************************}
  1501. var
  1502. NrIterations: Integer;
  1503. i : Integer;
  1504. j : Integer;
  1505. TmpFillPattern : byte;
  1506. OldWriteMode : word;
  1507. OldCurrentColor : word;
  1508. begin
  1509. { convert to global coordinates ... }
  1510. x1 := x1 + StartXViewPort;
  1511. x2 := x2 + StartXViewPort;
  1512. y := y + StartYViewPort;
  1513. { if line was fully clipped then exit...}
  1514. if LineClipped(x1,y,x2,y,StartXViewPort,StartYViewPort,
  1515. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  1516. exit;
  1517. OldWriteMode := CurrentWriteMode;
  1518. CurrentWriteMode := NormalPut;
  1519. { Get the current pattern }
  1520. TmpFillPattern := FillPatternTable
  1521. [FillSettings.Pattern][(y and $7)+1];
  1522. Case TmpFillPattern Of
  1523. 0:
  1524. begin
  1525. OldCurrentColor := CurrentColor;
  1526. CurrentColor := CurrentBkColor;
  1527. { hline converts the coordinates to global ones, but that has been done }
  1528. { already here!!! Convert them back to local ones... (JM) }
  1529. HLine(x1-StartXViewPort,x2-StartXViewPort,y-StartYViewPort);
  1530. CurrentColor := OldCurrentColor;
  1531. end;
  1532. $ff:
  1533. begin
  1534. HLine(x1-StartXViewPort,x2-StartXViewPort,y-StartYViewPort);
  1535. end;
  1536. else
  1537. begin
  1538. { number of times to go throuh the 8x8 pattern }
  1539. NrIterations := abs(x2 - x1+1) div 8;
  1540. Inc(NrIterations);
  1541. For i:= 0 to NrIterations do
  1542. Begin
  1543. for j:=0 to 7 do
  1544. Begin
  1545. { x1 mod 8 }
  1546. if RevBitArray[x1 and 7] and TmpFillPattern <> 0 then
  1547. DirectPutpixel(x1,y)
  1548. else
  1549. begin
  1550. { According to the TP graph manual, we overwrite everything }
  1551. { which is filled up - checked against VGA and CGA drivers }
  1552. { of TP. }
  1553. OldCurrentColor := CurrentColor;
  1554. CurrentColor := CurrentBkColor;
  1555. DirectPutPixel(x1,y);
  1556. CurrentColor := OldCurrentColor;
  1557. end;
  1558. Inc(x1);
  1559. if x1 > x2 then
  1560. begin
  1561. CurrentWriteMode := OldWriteMode;
  1562. exit;
  1563. end;
  1564. end;
  1565. end;
  1566. end;
  1567. End;
  1568. CurrentWriteMode := OldWriteMode;
  1569. end;
  1570. procedure LineRel(Dx, Dy: Integer);
  1571. Begin
  1572. Line(CurrentX, CurrentY, CurrentX + Dx, CurrentY + Dy);
  1573. CurrentX := CurrentX + Dx;
  1574. CurrentY := CurrentY + Dy;
  1575. end;
  1576. procedure LineTo(x,y : Integer);
  1577. Begin
  1578. Line(CurrentX, CurrentY, X, Y);
  1579. CurrentX := X;
  1580. CurrentY := Y;
  1581. end;
  1582. procedure Rectangle(x1,y1,x2,y2:integer);
  1583. begin
  1584. { Do not draw the end points }
  1585. Line(x1,y1,x2-1,y1);
  1586. Line(x1,y1+1,x1,y2);
  1587. Line(x2,y1,x2,y2-1);
  1588. Line(x1+1,y2,x2,y2);
  1589. end;
  1590. procedure GetLineSettings(var ActiveLineInfo : LineSettingsType);
  1591. begin
  1592. Activelineinfo:=Lineinfo;
  1593. end;
  1594. procedure SetLineStyle(LineStyle: word; Pattern: word; Thickness: word);
  1595. var
  1596. i: byte;
  1597. j: byte;
  1598. Begin
  1599. if (LineStyle > UserBitLn) or ((Thickness <> Normwidth) and (Thickness <> ThickWidth)) then
  1600. _GraphResult := grError
  1601. else
  1602. begin
  1603. LineInfo.Thickness := Thickness;
  1604. LineInfo.LineStyle := LineStyle;
  1605. case LineStyle of
  1606. UserBitLn: Lineinfo.Pattern := pattern;
  1607. SolidLn: Lineinfo.Pattern := $ffff; { ------- }
  1608. DashedLn : Lineinfo.Pattern := $F8F8; { -- -- --}
  1609. DottedLn: LineInfo.Pattern := $CCCC; { - - - - }
  1610. CenterLn: LineInfo.Pattern := $FC78; { -- - -- }
  1611. end; { end case }
  1612. { setup pattern styles }
  1613. j:=16;
  1614. for i:=0 to 15 do
  1615. Begin
  1616. dec(j);
  1617. { bitwise mask for each bit in the word }
  1618. if (word($01 shl i) AND LineInfo.Pattern) <> 0 then
  1619. LinePatterns[j]:=TRUE
  1620. else
  1621. LinePatterns[j]:=FALSE;
  1622. end;
  1623. end;
  1624. end;
  1625. {--------------------------------------------------------------------------}
  1626. { }
  1627. { VIEWPORT RELATED ROUTINES }
  1628. { }
  1629. {--------------------------------------------------------------------------}
  1630. Procedure ClearViewPortDefault; {$ifndef fpc}far;{$endif fpc}
  1631. var
  1632. j: integer;
  1633. OldWriteMode, OldCurColor: word;
  1634. LineSets : LineSettingsType;
  1635. Begin
  1636. { CP is always RELATIVE coordinates }
  1637. CurrentX := 0;
  1638. CurrentY := 0;
  1639. { Save all old settings }
  1640. OldCurColor := CurrentColor;
  1641. CurrentColor:=CurrentBkColor;
  1642. OldWriteMode:=CurrentWriteMode;
  1643. GetLineSettings(LineSets);
  1644. { reset to normal line style...}
  1645. SetLineStyle(SolidLn, 0, NormWidth);
  1646. { routines are relative here...}
  1647. for J:=0 to ViewHeight do
  1648. HLine(0, ViewWidth, J);
  1649. { restore old settings...}
  1650. SetLineStyle(LineSets.LineStyle, LineSets.Pattern, LineSets.Thickness);
  1651. CurrentColor := OldCurColor;
  1652. CurrentWriteMode := OldWriteMode;
  1653. end;
  1654. Procedure SetViewPort(X1, Y1, X2, Y2: Integer; Clip: Boolean);
  1655. Begin
  1656. if (X1 > GetMaxX) or (X2 > GetMaxX) or (X1 > X2) or (X1 < 0) then
  1657. Begin
  1658. _GraphResult := grError;
  1659. exit;
  1660. end;
  1661. if (Y1 > GetMaxY) or (Y2 > GetMaxY) or (Y1 > Y2) or (Y1 < 0) then
  1662. Begin
  1663. _GraphResult := grError;
  1664. exit;
  1665. end;
  1666. { CP is always RELATIVE coordinates }
  1667. CurrentX := 0;
  1668. CurrentY := 0;
  1669. StartXViewPort := X1;
  1670. StartYViewPort := Y1;
  1671. ViewWidth := X2-X1;
  1672. ViewHeight:= Y2-Y1;
  1673. ClipPixels := Clip;
  1674. end;
  1675. procedure GetViewSettings(var viewport : ViewPortType);
  1676. begin
  1677. ViewPort.X1 := StartXViewPort;
  1678. ViewPort.Y1 := StartYViewPort;
  1679. ViewPort.X2 := ViewWidth + StartXViewPort;
  1680. ViewPort.Y2 := ViewHeight + StartYViewPort;
  1681. ViewPort.Clip := ClipPixels;
  1682. end;
  1683. procedure ClearDevice;
  1684. var
  1685. ViewPort: ViewPortType;
  1686. begin
  1687. { Reset the CP }
  1688. CurrentX := 0;
  1689. CurrentY := 0;
  1690. { save viewport }
  1691. ViewPort.X1 := StartXviewPort;
  1692. ViewPort.X2 := ViewWidth - StartXViewPort;
  1693. ViewPort.Y1 := StartYViewPort;
  1694. ViewPort.Y2 := ViewHeight - StartYViewPort;
  1695. ViewPort.Clip := ClipPixels;
  1696. { put viewport to full screen }
  1697. StartXViewPort := 0;
  1698. ViewHeight := MaxY;
  1699. StartYViewPort := 0;
  1700. ViewWidth := MaxX;
  1701. ClipPixels := TRUE;
  1702. ClearViewPort;
  1703. { restore old viewport }
  1704. StartXViewPort := ViewPort.X1;
  1705. ViewWidth := ViewPort.X2-ViewPort.X1;
  1706. StartYViewPort := ViewPort.Y1;
  1707. ViewHeight := ViewPort.Y2-ViewPort.Y1;
  1708. ClipPixels := ViewPort.Clip;
  1709. end;
  1710. {--------------------------------------------------------------------------}
  1711. { }
  1712. { BITMAP PUT/GET ROUTINES }
  1713. { }
  1714. {--------------------------------------------------------------------------}
  1715. Procedure GetScanlineDefault (Y : Integer; Var Data); {$ifndef fpc}far;{$endif fpc}
  1716. {**********************************************************}
  1717. { Procedure GetScanLine() }
  1718. {----------------------------------------------------------}
  1719. { Returns the full scanline of the video line of the Y }
  1720. { coordinate. The values are returned in a WORD array }
  1721. { each WORD representing a pixel of the specified scanline }
  1722. { note: we only need the pixels inside the ViewPort! (JM) }
  1723. {**********************************************************}
  1724. Var
  1725. x : Integer;
  1726. Begin
  1727. For x:=0 to ViewWidth Do
  1728. WordArray(Data)[x]:=GetPixel(x, y);
  1729. End;
  1730. Function DefaultImageSize(X1,Y1,X2,Y2: Integer): longint; {$ifndef fpc}far;{$endif fpc}
  1731. Begin
  1732. { each pixel uses two bytes, to enable modes with colors up to 64K }
  1733. { to work. }
  1734. DefaultImageSize := 12 + (((X2-X1+1)*(Y2-Y1+1))*2);
  1735. end;
  1736. Procedure DefaultPutImage(X,Y: Integer; var Bitmap; BitBlt: Word); {$ifndef fpc}far;{$endif fpc}
  1737. type
  1738. pt = array[0..$fffffff] of word;
  1739. ptw = array[0..2] of longint;
  1740. var
  1741. color: word;
  1742. i,j: Integer;
  1743. Y1,X1: Integer;
  1744. k: longint;
  1745. Begin
  1746. X1:= ptw(Bitmap)[0]+X; { get width and adjust end coordinate accordingly }
  1747. Y1:= ptw(Bitmap)[1]+Y; { get height and adjust end coordinate accordingly }
  1748. k:= 3 * Sizeof(longint) div Sizeof(word); { Three reserved longs at start of bitmap }
  1749. for j:=Y to Y1 do
  1750. Begin
  1751. for i:=X to X1 do
  1752. begin
  1753. case BitBlt of
  1754. {$R-}
  1755. CopyPut: color:= pt(Bitmap)[k]; { also = normalput }
  1756. XORPut: color:= pt(Bitmap)[k] XOR GetPixel(i,j);
  1757. OrPut: color:= pt(Bitmap)[k] OR GetPixel(i,j);
  1758. AndPut: color:= pt(Bitmap)[k] AND GetPixel(i,j);
  1759. NotPut: color:= not pt(Bitmap)[k];
  1760. {$ifdef debug}
  1761. {$R+}
  1762. {$endif debug}
  1763. end;
  1764. putpixel(i,j,color);
  1765. Inc(k);
  1766. end;
  1767. end;
  1768. end;
  1769. Procedure DefaultGetImage(X1,Y1,X2,Y2: Integer; Var Bitmap); {$ifndef fpc}far;{$endif fpc}
  1770. type
  1771. pt = array[0..$fffffff] of word;
  1772. ptw = array[0..2] of longint;
  1773. var
  1774. i,j: integer;
  1775. k: longint;
  1776. Begin
  1777. k:= 3 * Sizeof(longint) div Sizeof(word); { Three reserved longs at start of bitmap }
  1778. for j:=Y1 to Y2 do
  1779. Begin
  1780. for i:=X1 to X2 do
  1781. begin
  1782. {$R-}
  1783. pt(Bitmap)[k] :=getpixel(i,j);
  1784. {$ifdef debug}
  1785. {$R+}
  1786. {$endif debug}
  1787. Inc(k);
  1788. end;
  1789. end;
  1790. ptw(Bitmap)[0] := X2-X1; { First longint is width }
  1791. ptw(Bitmap)[1] := Y2-Y1; { Second longint is height }
  1792. ptw(bitmap)[2] := 0; { Third longint is reserved}
  1793. end;
  1794. Procedure GetArcCoords(var ArcCoords: ArcCoordsType);
  1795. Begin
  1796. ArcCoords.X := ArcCall.X;
  1797. ArcCoords.Y := ArcCall.Y;
  1798. ArcCoords.XStart := ArcCall.XStart;
  1799. ArcCoords.YStart := ArcCall.YStart;
  1800. ArcCoords.XEnd := ArcCall.XEnd;
  1801. ArcCoords.YEnd := ArcCall.YEnd;
  1802. end;
  1803. procedure SetVisualPageDefault(page : word); {$ifndef fpc}far;{$endif fpc}
  1804. begin
  1805. end;
  1806. procedure SetActivePageDefault(page : word); {$ifndef fpc}far;{$endif fpc}
  1807. begin
  1808. end;
  1809. procedure DirectPutPixelDefault(X,Y: Integer);
  1810. begin
  1811. RunError(218);
  1812. end;
  1813. function GetPixelDefault(X,Y: Integer): word;
  1814. begin
  1815. RunError(218);
  1816. exit(0); { avoid warning }
  1817. end;
  1818. procedure PutPixelDefault(X,Y: Integer; Color: Word);
  1819. begin
  1820. RunError(218);
  1821. end;
  1822. procedure SetRGBPaletteDefault(ColorNum, RedValue, GreenValue, BlueValue: Integer);
  1823. begin
  1824. RunError(218);
  1825. end;
  1826. procedure GetRGBPaletteDefault(ColorNum: integer; var
  1827. RedValue, GreenValue, BlueValue: Integer);
  1828. begin
  1829. RunError(218);
  1830. end;
  1831. Procedure DefaultHooks;
  1832. {********************************************************}
  1833. { Procedure DefaultHooks() }
  1834. {--------------------------------------------------------}
  1835. { Resets all hookable routine either to nil for those }
  1836. { which need overrides, and others to defaults. }
  1837. { This is called each time SetGraphMode() is called. }
  1838. {********************************************************}
  1839. Begin
  1840. { All default hooks procedures }
  1841. {$ifdef fpc}
  1842. { required...}
  1843. DirectPutPixel := @DirectPutPixelDefault;
  1844. PutPixel := @PutPixelDefault;
  1845. GetPixel := @GetPixelDefault;
  1846. SetRGBPalette := @SetRGBPaletteDefault;
  1847. GetRGBPalette := @GetRGBPaletteDefault;
  1848. { optional...}
  1849. SetActivePage := @SetActivePageDefault;
  1850. SetVisualPage := @SetVisualPageDefault;
  1851. ClearViewPort := @ClearViewportDefault;
  1852. PutImage := @DefaultPutImage;
  1853. GetImage := @DefaultGetImage;
  1854. ImageSize := @DefaultImageSize;
  1855. {$else fpc}
  1856. { required...}
  1857. DirectPutPixel := DirectPutPixelDefault;
  1858. PutPixel := PutPixelDefault;
  1859. GetPixel := GetPixelDefault;
  1860. SetRGBPalette := SetRGBPaletteDefault;
  1861. GetRGBPalette := GetRGBPaletteDefault;
  1862. { optional...}
  1863. SetActivePage := SetActivePageDefault;
  1864. SetVisualPage := SetVisualPageDefault;
  1865. ClearViewPort := ClearViewportDefault;
  1866. PutImage := DefaultPutImage;
  1867. GetImage := DefaultGetImage;
  1868. ImageSize := DefaultImageSize;
  1869. {$endif fpc}
  1870. GraphFreeMemPtr := nil;
  1871. GraphGetMemPtr := nil;
  1872. {$ifdef fpc}
  1873. GetScanLine := @GetScanLineDefault;
  1874. Line := @LineDefault;
  1875. InternalEllipse := @InternalEllipseDefault;
  1876. PatternLine := @PatternLineDefault;
  1877. HLine := @HLineDefault;
  1878. VLine := @VLineDefault;
  1879. {$else fpc}
  1880. GetScanLine := GetScanLineDefault;
  1881. Line := LineDefault;
  1882. InternalEllipse := InternalEllipseDefault;
  1883. PatternLine := PatternLineDefault;
  1884. HLine := HLineDefault;
  1885. VLine := VLineDefault;
  1886. {$endif fpc}
  1887. end;
  1888. Procedure InitVars;
  1889. {********************************************************}
  1890. { Procedure InitVars() }
  1891. {--------------------------------------------------------}
  1892. { Resets all internal variables, and resets all }
  1893. { overridable routines. }
  1894. {********************************************************}
  1895. Begin
  1896. DirectVideo := TRUE; { By default use fastest access possible }
  1897. ArcCall.X := 0;
  1898. ArcCall.Y := 0;
  1899. ArcCall.XStart := 0;
  1900. ArcCall.YStart := 0;
  1901. ArcCall.XEnd := 0;
  1902. ArcCall.YEnd := 0;
  1903. { Reset to default values }
  1904. IntCurrentMode := 0;
  1905. IntCurrentDriver := 0;
  1906. XAspect := 0;
  1907. YAspect := 0;
  1908. MaxX := 0;
  1909. MaxY := 0;
  1910. MaxColor := 0;
  1911. PaletteSize := 0;
  1912. DirectColor := FALSE;
  1913. HardwarePages := 0;
  1914. DefaultHooks;
  1915. end;
  1916. {$i modes.inc}
  1917. {$i palette.inc}
  1918. {$i graph.inc}
  1919. function InstallUserDriver(Name: string; AutoDetectPtr: Pointer): integer;
  1920. begin
  1921. _graphResult := grError;
  1922. InstallUserDriver:=grError;
  1923. end;
  1924. function RegisterBGIDriver(driver: pointer): integer;
  1925. begin
  1926. _graphResult := grError;
  1927. RegisterBGIDriver:=grError;
  1928. end;
  1929. { ----------------------------------------------------------------- }
  1930. Procedure Arc(X,Y : Integer; StAngle,EndAngle,Radius: word);
  1931. { var
  1932. OldWriteMode: word;}
  1933. Begin
  1934. { Only if we are using thickwidths lines do we accept }
  1935. { XORput write modes. }
  1936. { OldWriteMode := CurrentWriteMode;
  1937. if (LineInfo.Thickness = NormWidth) then
  1938. CurrentWriteMode := NormalPut;}
  1939. {$ifdef fpc}
  1940. InternalEllipse(X,Y,Radius,Radius,StAngle,Endangle,@DummyPatternLine);
  1941. {$else fpc}
  1942. InternalEllipse(X,Y,Radius,Radius,StAngle,Endangle,DummyPatternLine);
  1943. {$endif fpc}
  1944. { CurrentWriteMode := OldWriteMode;}
  1945. end;
  1946. procedure Ellipse(X,Y : Integer; stAngle, EndAngle: word; XRadius,YRadius: word);
  1947. Begin
  1948. {$ifdef fpc}
  1949. InternalEllipse(X,Y,XRadius,YRadius,StAngle,Endangle,@DummyPatternLine);
  1950. {$else fpc}
  1951. InternalEllipse(X,Y,XRadius,YRadius,StAngle,Endangle,DummyPatternLine);
  1952. {$endif fpc}
  1953. end;
  1954. procedure FillEllipse(X, Y: Integer; XRadius, YRadius: Word);
  1955. {********************************************************}
  1956. { Procedure FillEllipse() }
  1957. {--------------------------------------------------------}
  1958. { Draws a filled ellipse using (X,Y) as a center point }
  1959. { and XRadius and YRadius as the horizontal and vertical }
  1960. { axes. The ellipse is filled with the current fill color}
  1961. { and fill style, and is bordered with the current color.}
  1962. {********************************************************}
  1963. begin
  1964. InternalEllipse(X,Y,XRadius,YRadius,0,360,PatternLine)
  1965. end;
  1966. procedure Circle(X, Y: Integer; Radius:Word);
  1967. {********************************************************}
  1968. { Draws a circle centered at X,Y with the given Radius. }
  1969. {********************************************************}
  1970. { Important notes: }
  1971. { - Thickwidth circles use the current write mode, while}
  1972. { normal width circles ALWAYS use CopyPut/NormalPut }
  1973. { mode. (Tested against VGA BGI driver -CEC 13/Aug/99 }
  1974. {********************************************************}
  1975. var OriginalArcInfo: ArcCoordsType;
  1976. OldWriteMode: word;
  1977. begin
  1978. if (Radius = 0) then
  1979. Exit;
  1980. if (Radius = 1) then
  1981. begin
  1982. { only normal put mode is supported by a call to PutPixel }
  1983. PutPixel(X, Y, CurrentColor);
  1984. Exit;
  1985. end;
  1986. { save state of arc information }
  1987. { because it is not needed for }
  1988. { a circle call. }
  1989. move(ArcCall,OriginalArcInfo, sizeof(ArcCall));
  1990. if LineInfo.Thickness = Normwidth then
  1991. begin
  1992. OldWriteMode := CurrentWriteMode;
  1993. CurrentWriteMode := CopyPut;
  1994. end;
  1995. {$ifdef fpc}
  1996. InternalEllipse(X,Y,Radius,Radius,0,360,@DummyPatternLine);
  1997. {$else fpc}
  1998. InternalEllipse(X,Y,Radius,Radius,0,360,DummyPatternLine);
  1999. {$endif fpc}
  2000. if LineInfo.Thickness = Normwidth then
  2001. CurrentWriteMode := OldWriteMode;
  2002. { restore arc information }
  2003. move(OriginalArcInfo, ArcCall,sizeof(ArcCall));
  2004. end;
  2005. procedure SectorPL(x1,x2,y: Integer); {$ifndef fpc}far;{$endif fpc}
  2006. var plx1, plx2: integer;
  2007. {$ifdef sectorpldebug}
  2008. t : text;
  2009. {$endif sectorpldebug}
  2010. begin
  2011. {$ifdef sectorpldebug}
  2012. assign(t,'sector.log');
  2013. append(t);
  2014. writeln(t,'Got here for line ',y);
  2015. close(t);
  2016. {$endif sectorpldebug}
  2017. If (x1 = -maxint) Then
  2018. If (x2 = maxint-1) Then
  2019. { no ellipse points drawn on this line }
  2020. If (((Y < ArcCall.Y) and (Y > ArcCall.YStart)) or
  2021. ((Y > ArcCall.Y) and (Y < ArcCall.YStart))) Then
  2022. { there is a part of the sector at this y coordinate, but no }
  2023. { ellips points are plotted on this line, so draw a patternline }
  2024. { between the lines connecting (arccall.x,arccall.y) with }
  2025. { the start and the end of the arc (JM) }
  2026. { use: y-y1=(y2-y1)/(x2-x1)*(x-x1) => }
  2027. { x = (y-y1)/(y2-y1)*(x2-x1)+x1 }
  2028. Begin
  2029. {$ifdef sectorpldebug}
  2030. If (ArcCall.YStart-ArcCall.Y) = 0 then
  2031. begin
  2032. append(t);
  2033. writeln(t,'bug1');
  2034. close(t);
  2035. runerror(202);
  2036. end;
  2037. {$endif sectorpldebug}
  2038. plx1 := (y-ArcCall.Y)*(ArcCall.XStart-ArcCall.X)
  2039. div (ArcCall.YStart-ArcCall.Y)+ArcCall.X;
  2040. {$ifdef sectorpldebug}
  2041. If (ArcCall.YEnd-ArcCall.Y) = 0 then
  2042. begin
  2043. append(t);
  2044. writeln(t,'bug2');
  2045. close(t);
  2046. runerror(202);
  2047. end;
  2048. {$endif sectorpldebug}
  2049. plx2 := (y-ArcCall.Y)*(ArcCall.XEnd-ArcCall.X)
  2050. div (ArcCall.YEnd-ArcCall.Y)+ArcCall.X;
  2051. If plx1 > plx2 then
  2052. begin
  2053. plx1 := plx1 xor plx2;
  2054. plx2 := plx1 xor plx2;
  2055. plx1 := plx1 xor plx2;
  2056. end;
  2057. {$ifdef sectorpldebug}
  2058. append(t);
  2059. writeln(t,'lines: ',plx1,' - ',plx2);
  2060. close(t);
  2061. {$endif sectorpldebug}
  2062. End
  2063. { otherwise two points which have nothing to do with the sector }
  2064. Else exit
  2065. Else
  2066. { the arc is plotted at the right side, but not at the left side, }
  2067. { fill till the line between (ArcCall.X,ArcCall.Y) and }
  2068. { (ArcCall.XStart,ArcCall.YStart) }
  2069. Begin
  2070. If (y < ArcCall.Y) then
  2071. begin
  2072. {$ifdef sectorpldebug}
  2073. If (ArcCall.YEnd-ArcCall.Y) = 0 then
  2074. begin
  2075. append(t);
  2076. writeln(t,'bug3');
  2077. close(t);
  2078. runerror(202);
  2079. end;
  2080. {$endif sectorpldebug}
  2081. plx1 := (y-ArcCall.Y)*(ArcCall.XEnd-ArcCall.X)
  2082. div (ArcCall.YEnd-ArcCall.Y)+ArcCall.X
  2083. end
  2084. else if (y > ArcCall.Y) then
  2085. begin
  2086. {$ifdef sectorpldebug}
  2087. If (ArcCall.YStart-ArcCall.Y) = 0 then
  2088. begin
  2089. append(t);
  2090. writeln(t,'bug4');
  2091. close(t);
  2092. runerror(202);
  2093. end;
  2094. {$endif sectorpldebug}
  2095. plx1 := (y-ArcCall.Y)*(ArcCall.XStart-ArcCall.X)
  2096. div (ArcCall.YStart-ArcCall.Y)+ArcCall.X
  2097. end
  2098. else plx1 := ArcCall.X;
  2099. plx2 := x2;
  2100. {$ifdef sectorpldebug}
  2101. append(t);
  2102. writeln(t,'right: ',plx1,' - ',plx2);
  2103. close(t);
  2104. {$endif sectorpldebug}
  2105. End
  2106. Else
  2107. If (x2 = maxint-1) Then
  2108. { the arc is plotted at the left side, but not at the rigth side. }
  2109. { the right limit can be either the first or second line. Just take }
  2110. { the closest one, but watch out for division by zero! }
  2111. Begin
  2112. If (y < ArcCall.Y) then
  2113. begin
  2114. {$ifdef sectorpldebug}
  2115. If (ArcCall.YStart-ArcCall.Y) = 0 then
  2116. begin
  2117. append(t);
  2118. writeln(t,'bug5');
  2119. close(t);
  2120. runerror(202);
  2121. end;
  2122. {$endif sectorpldebug}
  2123. plx2 := (y-ArcCall.Y)*(ArcCall.XStart-ArcCall.X)
  2124. div (ArcCall.YStart-ArcCall.Y)+ArcCall.X
  2125. end
  2126. else if (y > ArcCall.Y) then
  2127. begin
  2128. {$ifdef sectorpldebug}
  2129. If (ArcCall.YEnd-ArcCall.Y) = 0 then
  2130. begin
  2131. append(t);
  2132. writeln(t,'bug6');
  2133. close(t);
  2134. runerror(202);
  2135. end;
  2136. {$endif sectorpldebug}
  2137. plx2 := (y-ArcCall.Y)*(ArcCall.XEnd-ArcCall.X)
  2138. div (ArcCall.YEnd-ArcCall.Y)+ArcCall.X
  2139. end
  2140. else plx2 := ArcCall.X;
  2141. plx1 := x1;
  2142. {$ifdef sectorpldebug}
  2143. append(t);
  2144. writeln(t,'left: ',plx1,' - ',plx2);
  2145. close(t);
  2146. {$endif sectorpldebug}
  2147. End
  2148. Else
  2149. { the arc is plotted at both sides }
  2150. Begin
  2151. plx1 := x1;
  2152. plx2 := x2;
  2153. {$ifdef sectorpldebug}
  2154. append(t);
  2155. writeln(t,'normal: ',plx1,' - ',plx2);
  2156. close(t);
  2157. {$endif sectorpldebug}
  2158. End;
  2159. If plx2 > plx1 then
  2160. Begin
  2161. {$ifdef sectorpldebug}
  2162. append(t);
  2163. Writeln(t,'drawing...');
  2164. close(t);
  2165. {$endif sectorpldebug}
  2166. PatternLine(plx1,plx2,y);
  2167. end;
  2168. end;
  2169. procedure Sector(x, y: Integer; StAngle,EndAngle, XRadius, YRadius: Word);
  2170. (* var angle : graph_float;
  2171. writemode : word; *)
  2172. begin
  2173. {$ifdef fpc}
  2174. internalellipse(x,y,XRadius, YRadius, StAngle, EndAngle, @SectorPL);
  2175. {$else fpc}
  2176. internalellipse(x,y,XRadius, YRadius, StAngle, EndAngle, SectorPL);
  2177. {$endif fpc}
  2178. Line(ArcCall.XStart, ArcCall.YStart, x,y);
  2179. Line(x,y,ArcCall.Xend,ArcCall.YEnd);
  2180. end;
  2181. procedure SetFillStyle(Pattern : word; Color: word);
  2182. begin
  2183. { on invalid input, the current fill setting will be }
  2184. { unchanged. }
  2185. if (Pattern > UserFill) or (Color > GetMaxColor) then
  2186. begin
  2187. _GraphResult := grError;
  2188. exit;
  2189. end;
  2190. FillSettings.Color := Color;
  2191. FillSettings.Pattern := Pattern;
  2192. end;
  2193. procedure SetFillPattern(Pattern: FillPatternType; Color: word);
  2194. {********************************************************}
  2195. { Changes the Current FillPattern to a user defined }
  2196. { pattern and changes also the current fill color. }
  2197. { The FillPattern is saved in the FillPattern array so }
  2198. { it can still be used with SetFillStyle(UserFill,Color) }
  2199. {********************************************************}
  2200. var
  2201. i: integer;
  2202. begin
  2203. if Color > GetMaxColor then
  2204. begin
  2205. _GraphResult := grError;
  2206. exit;
  2207. end;
  2208. FillSettings.Color := Color;
  2209. FillSettings.Pattern := UserFill;
  2210. { Save the pattern in the buffer }
  2211. For i:=1 to 8 do
  2212. FillPatternTable[UserFill][i] := Pattern[i];
  2213. end;
  2214. procedure Bar(x1,y1,x2,y2:integer);
  2215. {********************************************************}
  2216. { Important notes for compatibility with BP: }
  2217. { - WriteMode is always CopyPut }
  2218. { - No contour is drawn for the lines }
  2219. {********************************************************}
  2220. var y : Integer;
  2221. origcolor : longint;
  2222. origlinesettings: Linesettingstype;
  2223. origwritemode : Integer;
  2224. begin
  2225. origlinesettings:=lineinfo;
  2226. origcolor:=CurrentColor;
  2227. if y1>y2 then
  2228. begin
  2229. y:=y1;
  2230. y1:=y2;
  2231. y2:=y;
  2232. end;
  2233. { Always copy mode for Bars }
  2234. origwritemode := CurrentWriteMode;
  2235. CurrentWriteMode := CopyPut;
  2236. { All lines used are of this style }
  2237. Lineinfo.linestyle:=solidln;
  2238. Lineinfo.thickness:=normwidth;
  2239. case Fillsettings.pattern of
  2240. EmptyFill :
  2241. begin
  2242. Currentcolor:=CurrentBkColor;
  2243. for y:=y1 to y2 do
  2244. Hline(x1,x2,y);
  2245. end;
  2246. SolidFill :
  2247. begin
  2248. CurrentColor:=FillSettings.color;
  2249. for y:=y1 to y2 do
  2250. Hline(x1,x2,y);
  2251. end;
  2252. else
  2253. Begin
  2254. CurrentColor:=FillSettings.color;
  2255. for y:=y1 to y2 do
  2256. patternline(x1,x2,y);
  2257. end;
  2258. end;
  2259. CurrentColor:= Origcolor;
  2260. LineInfo := OrigLineSettings;
  2261. CurrentWriteMode := OrigWritemode;
  2262. end;
  2263. procedure bar3D(x1, y1, x2, y2 : integer;depth : word;top : boolean);
  2264. var
  2265. origwritemode : integer;
  2266. OldX, OldY : integer;
  2267. begin
  2268. origwritemode := CurrentWriteMode;
  2269. CurrentWriteMode := CopyPut;
  2270. Bar(x1,y1,x2,y2);
  2271. Rectangle(x1,y1,x2,y2);
  2272. { Current CP should not be updated in Bar3D }
  2273. { therefore save it and then restore it on }
  2274. { exit. }
  2275. OldX := CurrentX;
  2276. OldY := CurrentY;
  2277. if top then begin
  2278. Moveto(x1,y1);
  2279. Lineto(x1+depth,y1-depth);
  2280. Lineto(x2+depth,y1-depth);
  2281. Lineto(x2,y1);
  2282. end;
  2283. if Depth <> 0 then
  2284. Begin
  2285. Moveto(x2+depth,y1-depth);
  2286. Lineto(x2+depth,y2-depth);
  2287. Lineto(x2,y2);
  2288. end;
  2289. { restore CP }
  2290. CurrentX := OldX;
  2291. CurrentY := OldY;
  2292. CurrentWriteMode := origwritemode;
  2293. end;
  2294. {--------------------------------------------------------------------------}
  2295. { }
  2296. { COLOR AND PALETTE ROUTINES }
  2297. { }
  2298. {--------------------------------------------------------------------------}
  2299. procedure SetColor(Color: Word);
  2300. Begin
  2301. CurrentColor := Color;
  2302. end;
  2303. function GetColor: Word;
  2304. Begin
  2305. GetColor := CurrentColor;
  2306. end;
  2307. function GetBkColor: Word;
  2308. Begin
  2309. GetBkColor := CurrentBkColor;
  2310. end;
  2311. procedure SetBkColor(ColorNum: Word);
  2312. { Background color means background screen color in this case, and it is }
  2313. { INDEPENDANT of the viewport settings, so we must clear the whole screen }
  2314. { with the color. }
  2315. var
  2316. ViewPort: ViewportType;
  2317. Begin
  2318. GetViewSettings(Viewport);
  2319. SetViewPort(0,0,MaxX,MaxY,FALSE);
  2320. CurrentBkColor := ColorNum;
  2321. {ClearViewPort;}
  2322. if not DirectColor and (ColorNum<256) then
  2323. SetRGBPalette(0,
  2324. DefaultColors[ColorNum].Red,
  2325. DefaultColors[ColorNum].Green,
  2326. DefaultColors[ColorNum].Blue);
  2327. SetViewport(ViewPort.X1,Viewport.Y1,Viewport.X2,Viewport.Y2,Viewport.Clip);
  2328. end;
  2329. function GetMaxColor: word;
  2330. { Checked against TP VGA driver - CEC }
  2331. begin
  2332. GetMaxColor:=MaxColor-1; { based on an index of zero so subtract one }
  2333. end;
  2334. Procedure MoveRel(Dx, Dy: Integer);
  2335. Begin
  2336. CurrentX := CurrentX + Dx;
  2337. CurrentY := CurrentY + Dy;
  2338. end;
  2339. Procedure MoveTo(X,Y: Integer);
  2340. {********************************************************}
  2341. { Procedure MoveTo() }
  2342. {--------------------------------------------------------}
  2343. { Moves the current pointer in VIEWPORT relative }
  2344. { coordinates to the specified X,Y coordinate. }
  2345. {********************************************************}
  2346. Begin
  2347. CurrentX := X;
  2348. CurrentY := Y;
  2349. end;
  2350. function GraphErrorMsg(ErrorCode: Integer): string;
  2351. Begin
  2352. GraphErrorMsg:='';
  2353. case ErrorCode of
  2354. grOk,grFileNotFound,grInvalidDriver: exit;
  2355. grNoInitGraph: GraphErrorMsg:='Graphics driver not installed';
  2356. grNotDetected: GraphErrorMsg:='Graphics hardware not detected';
  2357. grNoLoadMem,grNoScanMem,grNoFloodMem: GraphErrorMsg := 'Not enough memory for graphics';
  2358. grNoFontMem: GraphErrorMsg := 'Not enough memory to load font';
  2359. grFontNotFound: GraphErrorMsg:= 'Font file not found';
  2360. grInvalidMode: GraphErrorMsg := 'Invalid graphics mode';
  2361. grError: GraphErrorMsg:='Graphics error';
  2362. grIoError: GraphErrorMsg:='Graphics I/O error';
  2363. grInvalidFont,grInvalidFontNum: GraphErrorMsg := 'Invalid font';
  2364. grInvalidVersion: GraphErrorMsg:='Invalid driver version';
  2365. end;
  2366. end;
  2367. Function GetMaxX: Integer;
  2368. { Routine checked against VGA driver - CEC }
  2369. Begin
  2370. GetMaxX := MaxX;
  2371. end;
  2372. Function GetMaxY: Integer;
  2373. { Routine checked against VGA driver - CEC }
  2374. Begin
  2375. GetMaxY := MaxY;
  2376. end;
  2377. Function GraphResult: Integer;
  2378. Begin
  2379. GraphResult := _GraphResult;
  2380. _GraphResult := grOk;
  2381. end;
  2382. Function GetX: Integer;
  2383. Begin
  2384. GetX := CurrentX;
  2385. end;
  2386. Function GetY: Integer;
  2387. Begin
  2388. GetY := CurrentY;
  2389. end;
  2390. Function GetDriverName: string;
  2391. begin
  2392. GetDriverName:=DriverName;
  2393. end;
  2394. procedure graphdefaults;
  2395. { PS: GraphDefaults does not ZERO the ArcCall structure }
  2396. { so a call to GetArcCoords will not change even the }
  2397. { returned values even if GraphDefaults is called in }
  2398. { between. }
  2399. var
  2400. i: integer;
  2401. begin
  2402. lineinfo.linestyle:=solidln;
  2403. lineinfo.thickness:=normwidth;
  2404. { reset line style pattern }
  2405. for i:=0 to 15 do
  2406. LinePatterns[i] := TRUE;
  2407. { By default, according to the TP prog's reference }
  2408. { the default pattern is solid, and the default }
  2409. { color is the maximum color in the palette. }
  2410. fillsettings.color:=GetMaxColor;
  2411. fillsettings.pattern:=solidfill;
  2412. { GraphDefaults resets the User Fill pattern to $ff }
  2413. { checked with VGA BGI driver - CEC }
  2414. for i:=1 to 8 do
  2415. FillPatternTable[UserFill][i] := $ff;
  2416. CurrentColor:=white;
  2417. SetBkColor(Black);
  2418. ClipPixels := TRUE;
  2419. { Reset the viewport }
  2420. StartXViewPort := 0;
  2421. StartYViewPort := 0;
  2422. ViewWidth := MaxX;
  2423. ViewHeight := MaxY;
  2424. { Reset CP }
  2425. CurrentX := 0;
  2426. CurrentY := 0;
  2427. { normal write mode }
  2428. CurrentWriteMode := CopyPut;
  2429. { Schriftart einstellen }
  2430. CurrentTextInfo.font := DefaultFont;
  2431. CurrentTextInfo.direction:=HorizDir;
  2432. CurrentTextInfo.charsize:=1;
  2433. CurrentTextInfo.horiz:=LeftText;
  2434. CurrentTextInfo.vert:=TopText;
  2435. XAspect:=10000; YAspect:=10000;
  2436. end;
  2437. procedure GetAspectRatio(var Xasp,Yasp : word);
  2438. begin
  2439. XAsp:=XAspect;
  2440. YAsp:=YAspect;
  2441. end;
  2442. procedure SetAspectRatio(Xasp, Yasp : word);
  2443. begin
  2444. Xaspect:= XAsp;
  2445. YAspect:= YAsp;
  2446. end;
  2447. procedure SetWriteMode(WriteMode : integer);
  2448. { TP sets the writemodes according to the following scheme (JM) }
  2449. begin
  2450. Case writemode of
  2451. xorput, andput: CurrentWriteMode := XorPut;
  2452. notput, orput, copyput: CurrentWriteMode := CopyPut;
  2453. End;
  2454. end;
  2455. procedure GetFillSettings(var Fillinfo:Fillsettingstype);
  2456. begin
  2457. Fillinfo:=Fillsettings;
  2458. end;
  2459. procedure GetFillPattern(var FillPattern:FillPatternType);
  2460. begin
  2461. FillPattern:=FillpatternTable[UserFill];
  2462. end;
  2463. procedure DrawPoly(numpoints : word;var polypoints);
  2464. type
  2465. ppointtype = ^pointtype;
  2466. pt = array[0..16000] of pointtype;
  2467. var
  2468. i : longint;
  2469. begin
  2470. if numpoints < 2 then
  2471. begin
  2472. _GraphResult := grError;
  2473. exit;
  2474. end;
  2475. for i:=0 to numpoints-2 do
  2476. line(pt(polypoints)[i].x,
  2477. pt(polypoints)[i].y,
  2478. pt(polypoints)[i+1].x,
  2479. pt(polypoints)[i+1].y);
  2480. end;
  2481. procedure PieSlice(X,Y,stangle,endAngle:integer;Radius: Word);
  2482. begin
  2483. Sector(x,y,stangle,endangle,radius,radius);
  2484. end;
  2485. {$i fills.inc}
  2486. {$i gtext.inc}
  2487. procedure DetectGraph(var GraphDriver:Integer;var GraphMode:Integer);
  2488. var LoMode, HiMode: Integer;
  2489. CpyMode: Integer;
  2490. CpyDriver: Integer;
  2491. begin
  2492. HiMode := -1;
  2493. LoMode := -1;
  2494. { We start at VGA }
  2495. GraphDriver := VGA;
  2496. CpyMode := 0;
  2497. { search all possible graphic drivers in ascending order...}
  2498. { usually the new driver numbers indicate newest hardware...}
  2499. { Internal driver numbers start at VGA=9 }
  2500. repeat
  2501. GetModeRange(GraphDriver,LoMode,HiMode);
  2502. { save the highest mode possible...}
  2503. if HiMode = -1 then break;
  2504. CpyMode:=HiMode;
  2505. CpyDriver:=GraphDriver;
  2506. { go to next driver if it exists...}
  2507. Inc(GraphDriver);
  2508. until (CpyMode=-1);
  2509. { If this is equal to -1 then no graph mode possible...}
  2510. if CpyMode = -1 then
  2511. begin
  2512. _GraphResult := grNotDetected;
  2513. exit;
  2514. end;
  2515. _GraphResult := grOK;
  2516. GraphDriver := CpyDriver;
  2517. GraphMode := CpyMode;
  2518. end;
  2519. procedure InitGraph(var GraphDriver:Integer;var GraphMode:Integer;
  2520. const PathToDriver:String);
  2521. begin
  2522. InitVars;
  2523. { path to the fonts (where they will be searched)...}
  2524. bgipath:=PathToDriver;
  2525. if bgipath[length(bgipath)]<>'\' then
  2526. bgipath:=bgipath+'\';
  2527. if not assigned(SaveVideoState) then
  2528. RunError(216);
  2529. DriverName:=InternalDriverName; { DOS Graphics driver }
  2530. if (Graphdriver=Detect) then
  2531. begin
  2532. DetectGraph(GraphDriver,GraphMode);
  2533. If _GraphResult = grNotDetected then Exit;
  2534. { _GraphResult is now already set to grOK by DetectGraph }
  2535. IntCurrentDriver := GraphDriver;
  2536. SaveVideoState;
  2537. { Actually set the graph mode...}
  2538. SetGraphMode(GraphMode);
  2539. end
  2540. else
  2541. begin
  2542. { Search if that graphics modec actually exists...}
  2543. if SearchMode(GraphDriver,GraphMode) = nil then
  2544. begin
  2545. _GraphResult := grInvalidMode;
  2546. exit;
  2547. end
  2548. else
  2549. begin
  2550. _GraphResult := grOK;
  2551. IntCurrentDriver := GraphDriver;
  2552. SaveVideoState;
  2553. {$ifdef logging}
  2554. If _GraphResult <> grOK then
  2555. LogLn('Mode setting failed after savevideostate');
  2556. {$endif logging}
  2557. SetGraphMode(GraphMode);
  2558. end;
  2559. end;
  2560. end;
  2561. procedure SetDirectVideo(DirectAccess: boolean);
  2562. begin
  2563. DirectVideo := DirectAccess;
  2564. end;
  2565. function GetDirectVideo: boolean;
  2566. begin
  2567. GetDirectVideo := DirectVideo;
  2568. end;
  2569. procedure GraphExitProc; {$ifndef fpc} far; {$endif fpc}
  2570. { deallocates all memory allocated by the graph unit }
  2571. var
  2572. list: PModeInfo;
  2573. tmp : PModeInfo;
  2574. c: graph_int;
  2575. begin
  2576. { restore old exitproc! }
  2577. exitproc := exitsave;
  2578. {$ifdef testsave}
  2579. restorevideostate;
  2580. {$endif testsave}
  2581. { release memory allocated for fonts }
  2582. for c := 1 to installedfonts do
  2583. with fonts[c] Do
  2584. If assigned(instr) Then
  2585. Freemem(instr,instrlength);
  2586. { release memory allocated for modelist }
  2587. list := ModeList;
  2588. while assigned(list) do
  2589. begin
  2590. tmp := list;
  2591. list:=list^.next;
  2592. dispose(tmp);
  2593. end;
  2594. {$IFDEF DPMI}
  2595. { We had copied the buffer of mode information }
  2596. { and allocated it dynamically... now free it }
  2597. { Warning: if GetVESAInfo returned false, this buffer is not allocated! (JM)}
  2598. If hasVesa then
  2599. Dispose(VESAInfo.ModeList);
  2600. {$ENDIF}
  2601. end;
  2602. begin
  2603. {$ifdef logging}
  2604. assign(debuglog,'grlog.txt');
  2605. rewrite(debuglog);
  2606. close(debuglog);
  2607. {$endif logging}
  2608. isgraphmode := false;
  2609. ModeList := nil;
  2610. SaveVideoState := nil;
  2611. RestoreVideoState := nil;
  2612. SavePtr := Nil;
  2613. {$ifdef oldfont}
  2614. {$ifdef go32v2}
  2615. LoadFont8x8;
  2616. {$endif go32v2}
  2617. {$endif oldfont}
  2618. { This must be called at startup... because GetGraphMode may }
  2619. { be called even when not in graph mode. }
  2620. {$ifdef logging}
  2621. LogLn('Calling QueryAdapterInfo...');
  2622. {$endif logging}
  2623. QueryAdapterInfo;
  2624. { Install standard fonts }
  2625. { This is done BEFORE startup... }
  2626. InstalledFonts := 0;
  2627. InstallUserFont('TRIP');
  2628. InstallUserFont('LITT');
  2629. InstallUserFont('SANS');
  2630. InstallUserFont('GOTH');
  2631. { This installs an exit procedure which cleans up the mode list...}
  2632. ExitSave := ExitProc;
  2633. ExitProc := @GraphExitProc;
  2634. {$ifdef testsave}
  2635. savevideostate;
  2636. {$endif testsave}
  2637. {$ifdef win32}
  2638. charmessagehandler:=nil;
  2639. {$endif win32}
  2640. end.
  2641. SetGraphBufSize
  2642. {
  2643. $Log$
  2644. Revision 1.45 1999-12-10 12:47:41 pierre
  2645. * SetBkColor like BP by changing Palette entry zero
  2646. Revision 1.44 1999/11/30 08:57:46 michael
  2647. + Removed charmessagehandler declaration, it is in graphh.inc
  2648. Revision 1.43 1999/11/28 16:13:55 jonas
  2649. * corrected misplacement of call to initvars in initgraph
  2650. + some extra debugging commands (for -dlogging) in the mode functions
  2651. Revision 1.42 1999/11/28 12:19:59 jonas
  2652. * _GraphResult is now properly set to grOK by DetectGraph and
  2653. InitGraph if there are no errors
  2654. Revision 1.41 1999/11/27 21:48:01 jonas
  2655. * fixed VlineVESA256 and re-enabled it in graph.inc
  2656. * added procedure detectgraph to interface of graph unit
  2657. Revision 1.40 1999/11/25 17:44:14 pierre
  2658. * memory corruption within GetImage removed
  2659. Revision 1.39 1999/11/24 23:42:31 pierre
  2660. * PutImage used an integer index that became negative !!!!
  2661. * Default needed procedure now genrate a RTE 218 instead of a
  2662. GPF by call to nil pointer !
  2663. Revision 1.38 1999/11/11 17:55:07 florian
  2664. * the size was calculated wrong by imagesize
  2665. Revision 1.37 1999/11/11 14:07:14 florian
  2666. * better looking font
  2667. Revision 1.36 1999/11/08 15:01:38 peter
  2668. * fpcmake support
  2669. Revision 1.35 1999/11/08 11:15:22 peter
  2670. * move graph.inc to the target dir
  2671. Revision 1.34 1999/11/03 20:23:01 florian
  2672. + first release of win32 gui support
  2673. Revision 1.33 1999/10/17 10:20:13 jonas
  2674. * fixed clipping for thickwidth lines (bug 659)
  2675. * fixed the faster internalellipsedefault, but it doesn't plot
  2676. all pixels (there are gaps in the ellipses)
  2677. Revision 1.32 1999/09/28 15:07:46 jonas
  2678. * fix for disposing font data because it can contain #0 chars
  2679. Revision 1.31 1999/09/28 13:56:25 jonas
  2680. * reordered some local variables (first 4 byte vars, then 2 byte vars
  2681. etc)
  2682. * font data is now disposed in exitproc, exitproc is now called
  2683. GraphExitProc (was CleanModes) and resides in graph.pp instead of in
  2684. modes.inc
  2685. Revision 1.30 1999/09/27 23:34:41 peter
  2686. * new graph unit is default for go32v2
  2687. * removed warnings/notes
  2688. Revision 1.29 1999/09/26 13:31:06 jonas
  2689. * changed name of modeinfo variable to vesamodeinfo and fixed
  2690. associated errors (fillchar(modeinfo,sizeof(tmodeinfo),#0) instead
  2691. of sizeof(TVesamodeinfo) etc)
  2692. * changed several sizeof(type) to sizeof(varname) to avoid similar
  2693. errors in the future
  2694. Revision 1.28 1999/09/25 11:48:43 jonas
  2695. + detectgraph
  2696. * small change to internalellipsedefault so less pixels are
  2697. calculated twice
  2698. * some small corrections to graph.tex
  2699. Revision 1.27 1999/09/24 22:52:38 jonas
  2700. * optimized patternline a bit (always use hline when possible)
  2701. * isgraphmode stuff cleanup
  2702. * vesainfo.modelist now gets disposed in cleanmode instead of in
  2703. closegraph (required moving of some declarations from vesa.inc to
  2704. new vesah.inc)
  2705. * queryadapter gets no longer called from initgraph (is called from
  2706. initialization of graph unit)
  2707. * bugfix for notput in 32k and 64k vesa modes
  2708. * a div replaced by / in fillpoly
  2709. Revision 1.26 1999/09/22 13:13:35 jonas
  2710. * renamed text.inc -> gtext.inc to avoid conflict with system unit
  2711. * fixed textwidth
  2712. * isgraphmode now gets properly updated, so mode restoring works
  2713. again
  2714. Revision 1.25 1999/09/18 22:21:10 jonas
  2715. + hlinevesa256 and vlinevesa256
  2716. + support for not/xor/or/andput in vesamodes with 32k/64k colors
  2717. * lots of changes to avoid warnings under FPC
  2718. Revision 1.24 1999/09/18 16:03:37 jonas
  2719. * graph.pp: removed pieslice and sector from ToDo list
  2720. * closegraph: exits now immidiately if isgraphmode = false (caused
  2721. RTE 204 with VESA enabled if you set exitproc to call closegraph
  2722. and also called closegraph explicitely before exit, like bgidemo)
  2723. Revision 1.23 1999/09/17 13:58:31 jonas
  2724. * another fix for a case where internalellipsedefault went haywire
  2725. * sector() and pieslice() fully implemented!
  2726. * small change to prevent buffer overflow with floodfill
  2727. Revision 1.22 1999/09/15 13:37:50 jonas
  2728. * small change to internalellipsedef to be TP compatible
  2729. * fixed directputpixel for vga 320*200*256
  2730. Revision 1.21 1999/09/13 12:49:08 jonas
  2731. * fixed Arc: internallellipse went into an endless loop if StAngle =
  2732. EndAngle
  2733. * FillEllipse is now much faster: no more floodfill,
  2734. InternalEllipseDefault now draws the patternlines immediatety!
  2735. Revision 1.20 1999/09/12 17:29:00 jonas
  2736. * several changes to internalellipse to make it faster
  2737. and to make sure it updates the ArcCall correctly
  2738. (not yet done for width = 3)
  2739. * Arc mostly works now, only sometimes an endless loop, don't know
  2740. why
  2741. Revision 1.19 1999/09/11 19:43:01 jonas
  2742. * FloodFill: did not take into account current viewport settings
  2743. * GetScanLine: only get line inside viewport, data outside of it
  2744. is not used anyway
  2745. * InternalEllipseDefault: fix for when xradius or yradius = 0 and
  2746. increase xradius and yradius always by one (TP does this too)
  2747. * fixed conlict in vesa.inc from last update
  2748. * some conditionals to avoid range check and overflow errors in
  2749. places where it doesn't matter
  2750. Revision 1.18 1999/07/26 09:38:41 florian
  2751. * bar: y2 can be less y1, fixed
  2752. * settextstyle: charsize can be 0, must be changed into 1
  2753. Revision 1.17 1999/07/18 15:07:20 jonas
  2754. + xor-, and and- orput support for VESA256 modes
  2755. * compile with -dlogging if you wnt some info to be logged to grlog.txt
  2756. Revision 1.16 1999/07/14 18:18:04 florian
  2757. * cosmetic changes
  2758. }