AGfxPaths.Mod 45 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404
  1. (* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich.
  2. Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *)
  3. MODULE GfxPaths; (** portable *) (* eos *)
  4. (** AUTHOR "eos"; PURPOSE "Two_dimensional paths consisting of lines, arcs and bezier curves"; *)
  5. (*
  6. 9.2.98 - made behaviour of EnumSpline similar to that of EnumArc and EnumBezier (produces no Enter/Exit)
  7. 11.2.98 - eliminated offset parameter in Enter elements, optimized data structure (now always pair in CoordBlock)
  8. 12.2.98 - added length functions
  9. 18.3.98 - fixed bug in EnumQuery (kept wrong code for next line)
  10. 13.5.98 - fixed bug in EnumBezier (wrong calculation; used x instead of y)
  11. 15.9.98 - minor cleanup: removed position, Save/Restore, GetBBox; simplified scanner interface
  12. 26.11.98 - added procedure Close
  13. 26.1.99 - added procedure Split
  14. 21.5.99 - fixed major bug in ReverseTo (no update of destination path fields)
  15. 12.7.99 - fixed another bug in ReverseTo (wrong direction when reverting Exit element)
  16. 12.7.99 - approximate arc with line if radius is smaller than flatness
  17. 18.02.2000 - simpler initial step without sqrt in EnumArc
  18. 18.02.2000 - more robust bezier code (deals with folded curves and cusps)
  19. 27.02.2000 - fixed arc code for starting points that are not on the ellipse
  20. 04.05.2000 - fixed solve; one execution path never set number of solutions (noticed by gf)
  21. *)
  22. IMPORT
  23. Math, GfxMatrix;
  24. CONST
  25. Stop* = 0; Enter* = 1; Line* = 2; Arc* = 3; Bezier* = 4; Exit* = 5; (** path element types **)
  26. ElemBlockSize = 16; (* base of number of path elements *)
  27. CoordBlockSize = 32; (* base of number of path coordinates *)
  28. MaxSplinePoints* = 128; (** maximal number of control points in a spline **)
  29. Left = 0; Right = 1; Bottom = 2; Top = 3; (* clip codes *)
  30. TYPE
  31. (* internal path structures *)
  32. ElemBlock = POINTER TO ElemBlockDesc;
  33. ElemBlockDesc = RECORD
  34. next: ElemBlock;
  35. elem: ARRAY ElemBlockSize OF SHORTINT;
  36. coords: INTEGER;
  37. END;
  38. CoordBlock = POINTER TO CoordBlockDesc;
  39. CoordBlockDesc = RECORD
  40. next: CoordBlock;
  41. x, y: ARRAY CoordBlockSize OF REAL;
  42. END;
  43. (** path abstraction **)
  44. (**
  45. A paths consists of any number of subpaths, where each subpath starts with a Enter element, followed by
  46. any number of curve elements, and terminated by an Exit element.
  47. Enter
  48. (x, y) is the starting point for the following curve element
  49. (dx, dy) is the tangent vector at the end of an adjacent subpath or (0, 0) if there is none
  50. Line
  51. (x, y) is the end point of the line and the starting point of any subsequent curve
  52. Arc
  53. (x, y) is the end point of the arc and the starting point of any subsequent curve (may coincide with the
  54. current point, resulting in a circle or ellipse)
  55. (x0, y0) is the center of the circle/ellipse this arc is part of
  56. (x1, y1) is the end point of the first half axis vector
  57. (x2, y2) is the end point of the first half axis vector (not necessarily perpendicular to the first HAV)
  58. Bezier
  59. (x, y) is the end point of the cubic bezier curve and the starting point of any subsequent curve
  60. (x1, y1) is the first control point of the cubic bezier curve
  61. (x1, y1) is the second control point of the cubic bezier curve
  62. Exit
  63. (dx, dy) is the tangent vector at the starting point of an adjacent subpath or (0, 0) if there is none
  64. **)
  65. Path* = OBJECT
  66. VAR
  67. elems* := 0, coords* := 0: INTEGER; (** number of elements/coordinate pairs in path **)
  68. firstEB := NIL, lastEB := NIL: ElemBlock; (* path element types *)
  69. firstCB := NIL, lastCB := NIL: CoordBlock; (* path element coordinates *)
  70. (** discard previous contents and start new path **)
  71. PROCEDURE Clear* ();
  72. BEGIN
  73. IF SELF.firstEB = NIL THEN NEW(SELF.firstEB) END;
  74. SELF.lastEB := SELF.firstEB; SELF.lastEB.next := NIL;
  75. IF SELF.firstCB = NIL THEN NEW(SELF.firstCB) END;
  76. SELF.lastCB := SELF.firstCB; SELF.lastCB.next := NIL;
  77. SELF.elems := 0; SELF.coords := 0;
  78. SELF.firstEB.coords := 0
  79. END Clear;
  80. (** append enter element **)
  81. PROCEDURE AddEnter* (x, y, dx, dy: REAL);
  82. BEGIN
  83. AddElem(SELF, Enter);
  84. AddCoord(SELF, dx, dy);
  85. AddCoord(SELF, x, y)
  86. END AddEnter;
  87. (** append line element **)
  88. PROCEDURE AddLine* (x, y: REAL);
  89. BEGIN
  90. AddElem(SELF, Line);
  91. AddCoord(SELF, x, y)
  92. END AddLine;
  93. (** append arc element **)
  94. PROCEDURE AddArc* (x, y, x0, y0, x1, y1, x2, y2: REAL);
  95. BEGIN
  96. AddElem(SELF, Arc);
  97. AddCoord(SELF, x0, y0);
  98. AddCoord(SELF, x1, y1);
  99. AddCoord(SELF, x2, y2);
  100. AddCoord(SELF, x, y)
  101. END AddArc;
  102. (** append bezier element **)
  103. PROCEDURE AddBezier* (x, y, x1, y1, x2, y2: REAL);
  104. BEGIN
  105. AddElem(SELF, Bezier);
  106. AddCoord(SELF, x1, y1);
  107. AddCoord(SELF, x2, y2);
  108. AddCoord(SELF, x, y)
  109. END AddBezier;
  110. (** append exit element **)
  111. PROCEDURE AddExit* (dx, dy: REAL);
  112. BEGIN
  113. AddElem(SELF, Exit);
  114. AddCoord(SELF, dx, dy)
  115. END AddExit;
  116. (** append subpath for axis-aligned rectangle **)
  117. PROCEDURE AddRect* (llx, lly, urx, ury: REAL);
  118. BEGIN
  119. SELF.AddEnter(llx, lly, 0, lly - ury);
  120. SELF.AddLine(urx, lly); SELF.AddLine(urx, ury); SELF.AddLine(llx, ury); SELF.AddLine(llx, lly);
  121. SELF.AddExit(urx - llx, 0)
  122. END AddRect;
  123. (** append one path path another **)
  124. PROCEDURE Append* (from: Path);
  125. VAR pos, epos, cpos, n: INTEGER; eb: ElemBlock; cb: CoordBlock; elem: SHORTINT;
  126. BEGIN
  127. pos := 0; epos := 0; cpos := 0; eb := from.firstEB; cb := from.firstCB;
  128. WHILE pos < from.elems DO
  129. IF epos = ElemBlockSize THEN
  130. eb := eb.next; epos := 0
  131. END;
  132. elem := eb.elem[epos]; INC(epos);
  133. AddElem(SELF, elem);
  134. n := Coords[elem];
  135. WHILE n > 0 DO
  136. IF cpos = CoordBlockSize THEN
  137. cb := cb.next; cpos := 0
  138. END;
  139. AddCoord(SELF, cb.x[cpos], cb.y[cpos]);
  140. INC(cpos); DEC(n)
  141. END;
  142. INC(pos)
  143. END
  144. END Append;
  145. (** enumerate path elements **)
  146. PROCEDURE Enumerate* (enum: Enumerator; VAR data: EnumData);
  147. VAR eb: ElemBlock; cb: CoordBlock; pos, epos, cpos: INTEGER;
  148. PROCEDURE get (VAR x, y: REAL);
  149. BEGIN
  150. IF cpos = CoordBlockSize THEN
  151. cb := cb.next; cpos := 0;
  152. END;
  153. x := cb.x[cpos]; y := cb.y[cpos]; INC(cpos);
  154. END get;
  155. BEGIN
  156. eb := SELF.firstEB; cb := SELF.firstCB;
  157. pos := 0; epos := 0; cpos := 0;
  158. WHILE pos < SELF.elems DO
  159. IF epos = ElemBlockSize THEN
  160. eb := eb.next; epos := 0;
  161. END;
  162. data.elem := eb.elem[epos];
  163. CASE data.elem OF
  164. | Enter: get(data.dx, data.dy); get(data.x, data.y);
  165. | Line: get(data.x, data.y);
  166. | Arc: get(data.x0, data.y0); get(data.x1, data.y1); get(data.x2, data.y2); get(data.x, data.y);
  167. | Bezier: get(data.x1, data.y1); get(data.x2, data.y2); get(data.x, data.y);
  168. | Exit: get(data.dx, data.dy);
  169. END;
  170. enum(data);
  171. INC(pos); INC(epos);
  172. END
  173. END Enumerate;
  174. (** enumerate flattened path, i.e. arcs and bezier curves will be approximated with lines **)
  175. PROCEDURE EnumFlattened* (flatness: REAL; enum: Enumerator; VAR data: EnumData);
  176. VAR eb: ElemBlock; cb: CoordBlock; pos, epos, cpos: INTEGER; x0, y0, x1, y1, x2, y2, x, y: REAL;
  177. PROCEDURE get (VAR x, y: REAL);
  178. BEGIN
  179. IF cpos = CoordBlockSize THEN
  180. cb := cb.next; cpos := 0;
  181. END;
  182. x := cb.x[cpos]; y := cb.y[cpos]; INC(cpos);
  183. END get;
  184. BEGIN
  185. eb := SELF.firstEB; cb := SELF.firstCB;
  186. pos := 0; epos := 0; cpos := 0;
  187. WHILE pos < SELF.elems DO
  188. IF epos = ElemBlockSize THEN
  189. eb := eb.next; epos := 0
  190. END;
  191. data.elem := eb.elem[epos];
  192. CASE data.elem OF
  193. | Enter:
  194. get(data.dx, data.dy); get(data.x, data.y);
  195. enum(data)
  196. | Line:
  197. get(data.x, data.y);
  198. enum(data)
  199. | Arc:
  200. get(x0, y0); get(x1, y1); get(x2, y2); get(x, y);
  201. EnumArc(x0, y0, x1, y1, x2, y2, x, y, flatness, enum, data)
  202. | Bezier:
  203. get(x1, y1); get(x2, y2); get(x, y);
  204. EnumBezier(x1, y1, x2, y2, x, y, flatness, enum, data);
  205. (* why this? data.elem := Line; data.x := x; data.y := y; enum(data) *)
  206. | Exit:
  207. get(data.dx, data.dy);
  208. enum(data);
  209. END;
  210. INC(pos); INC(epos)
  211. END
  212. END EnumFlattened;
  213. (** calculate path length **)
  214. PROCEDURE Length* (flatness: REAL): REAL;
  215. VAR data: LengthData;
  216. BEGIN
  217. data.len := 0;
  218. SELF.EnumFlattened(flatness, EnumLength, data);
  219. RETURN data.len
  220. END Length;
  221. (** return whether path is empty **)
  222. PROCEDURE Empty* (): BOOLEAN;
  223. BEGIN
  224. RETURN SELF.elems = 0
  225. END Empty;
  226. (** calculate bounding box of path **)
  227. PROCEDURE GetBox* (VAR llx, lly, urx, ury: REAL);
  228. VAR data: QueryData;
  229. BEGIN
  230. data.llx := MAX(REAL); data.lly := MAX(REAL); data.urx := MIN(REAL); data.ury := MIN(REAL);
  231. SELF.EnumFlattened(1, EnumBoxElem, data);
  232. llx := data.llx; lly := data.lly; urx := data.urx; ury := data.ury
  233. END GetBox;
  234. (**--- Path Operations ---**)
  235. (** put reversed source path into destination path; dst remains unchanged if src is empty **)
  236. PROCEDURE ReverseTo* (dst: Path);
  237. VAR
  238. elems, sepos, scpos, depos, dcpos: INTEGER; dstEB, nextEB, srcEB, eb: ElemBlock;
  239. dstCB, nextCB, srcCB: CoordBlock; dx, dy, x, y, x0, y0, x1, y1, x2, y2: REAL;
  240. PROCEDURE get (VAR x, y: REAL);
  241. BEGIN
  242. IF scpos = CoordBlockSize THEN
  243. srcCB := srcCB.next; scpos := 0
  244. END;
  245. x := srcCB.x[scpos]; y := srcCB.y[scpos]; INC(scpos)
  246. END get;
  247. PROCEDURE put (x, y: REAL);
  248. VAR cb: CoordBlock;
  249. BEGIN
  250. IF dcpos = 0 THEN
  251. IF nextCB # NIL THEN cb := nextCB; nextCB := cb.next
  252. ELSE NEW(cb)
  253. END;
  254. cb.next := dstCB; dstCB := cb;
  255. dcpos := CoordBlockSize
  256. END;
  257. DEC(dcpos); INC(dstEB.coords);
  258. dstCB.x[dcpos] := x; dstCB.y[dcpos] := y
  259. END put;
  260. BEGIN
  261. ASSERT(SELF # dst, 100);
  262. elems := SELF.elems;
  263. IF elems > 0 THEN
  264. IF dst.firstEB # NIL THEN dstEB := dst.firstEB; dstEB.coords := 0; nextEB := dstEB.next; dstEB.next := NIL
  265. ELSE NEW(dstEB); nextEB := NIL
  266. END;
  267. IF dst.firstCB # NIL THEN dstCB := dst.firstCB; nextCB := dstCB.next; dstCB.next := NIL
  268. ELSE NEW(dstCB); nextCB := NIL
  269. END;
  270. dst.lastEB := dstEB; dst.lastCB := dstCB;
  271. srcEB := SELF.firstEB; srcCB := SELF.firstCB;
  272. sepos := 0; scpos := 0;
  273. depos := (SELF.elems-1) MOD ElemBlockSize + 1; dcpos := (SELF.coords-1) MOD CoordBlockSize + 1;
  274. REPEAT
  275. (*
  276. store reverted path in dst:
  277. - segment end points become end points of their inverted successors
  278. - order of control points is reversed
  279. - directions are inverted
  280. *)
  281. IF sepos = ElemBlockSize THEN
  282. srcEB := srcEB.next; sepos := 0
  283. END;
  284. IF depos = 0 THEN
  285. IF nextEB # NIL THEN eb := nextEB; eb.coords := 0; nextEB := eb.next
  286. ELSE NEW(eb)
  287. END;
  288. eb.next := dstEB; dstEB := eb;
  289. depos := ElemBlockSize
  290. END;
  291. DEC(depos);
  292. CASE srcEB.elem[sepos] OF
  293. | Enter:
  294. dstEB.elem[depos] := Exit;
  295. get(dx, dy); get(x, y);
  296. put(-dx, -dy); put(x, y)
  297. | Line:
  298. dstEB.elem[depos] := Line;
  299. get(x, y);
  300. put(x, y)
  301. | Arc:
  302. dstEB.elem[depos] := Arc;
  303. get(x0, y0); get(x1, y1); get(x2, y2); get(x, y);
  304. put(x1, y1); put(x2, y2); put(x0, y0); put(x, y)
  305. | Bezier:
  306. dstEB.elem[depos] := Bezier;
  307. get(x1, y1); get(x2, y2); get(x, y);
  308. put(x1, y1); put(x2, y2); put(x, y)
  309. | Exit:
  310. dstEB.elem[depos] := Enter;
  311. get(dx, dy);
  312. put(-dx, -dy)
  313. END;
  314. INC(sepos); DEC(elems)
  315. UNTIL elems = 0;
  316. dst.firstEB := dstEB; dst.firstCB := dstCB;
  317. dst.elems := SELF.elems; dst.coords := SELF.coords
  318. END
  319. END ReverseTo;
  320. (** return copy of source path in destination path **)
  321. PROCEDURE CopyTo* (dst: Path);
  322. VAR srcEB, dstEB: ElemBlock; n: INTEGER; srcCB, dstCB: CoordBlock;
  323. BEGIN
  324. IF SELF # dst THEN
  325. IF dst.firstEB = NIL THEN NEW(dst.firstEB) END;
  326. srcEB := SELF.firstEB; dstEB := dst.firstEB;
  327. LOOP
  328. IF srcEB = SELF.lastEB THEN n := (SELF.elems-1) MOD ElemBlockSize + 1
  329. ELSE n := ElemBlockSize
  330. END;
  331. WHILE n > 0 DO
  332. DEC(n); dstEB.elem[n] := srcEB.elem[n]
  333. END;
  334. dstEB.coords := srcEB.coords;
  335. IF srcEB = SELF.lastEB THEN EXIT END;
  336. IF dstEB.next = NIL THEN NEW(dstEB.next) END;
  337. srcEB := srcEB.next; dstEB := dstEB.next
  338. END;
  339. dst.lastEB := dstEB; dstEB.next := NIL;
  340. IF dst.firstCB = NIL THEN NEW(dst.firstCB) END;
  341. srcCB := SELF.firstCB; dstCB := dst.firstCB;
  342. LOOP
  343. IF srcCB = SELF.lastCB THEN n := (SELF.coords-1) MOD CoordBlockSize + 1
  344. ELSE n := CoordBlockSize
  345. END;
  346. WHILE n > 0 DO
  347. DEC(n); dstCB.x[n] := srcCB.x[n]; dstCB.y[n] := srcCB.y[n]
  348. END;
  349. IF srcCB = SELF.lastCB THEN EXIT END;
  350. IF dstCB.next = NIL THEN NEW(dstCB.next) END;
  351. srcCB := srcCB.next; dstCB := dstCB.next
  352. END;
  353. dst.lastCB := dstCB; dstCB.next := NIL;
  354. dst.elems := SELF.elems; dst.coords := SELF.coords
  355. END
  356. END CopyTo;
  357. (** apply transformation to all coordinates in path **)
  358. PROCEDURE Apply* (VAR mat: GfxMatrix.Matrix);
  359. VAR eb: ElemBlock; cb: CoordBlock; pos, epos, cpos: INTEGER;
  360. PROCEDURE point (VAR b: CoordBlock; VAR idx: INTEGER);
  361. BEGIN
  362. IF idx = CoordBlockSize THEN
  363. b := b.next; idx := 0
  364. END;
  365. GfxMatrix.Apply(mat, b.x[idx], b.y[idx], b.x[idx], b.y[idx]);
  366. INC(idx)
  367. END point;
  368. PROCEDURE vector (VAR b: CoordBlock; VAR idx: INTEGER);
  369. BEGIN
  370. IF idx = CoordBlockSize THEN
  371. b := b.next; idx := 0
  372. END;
  373. GfxMatrix.ApplyToVector(mat, b.x[idx], b.y[idx], b.x[idx], b.y[idx]);
  374. INC(idx)
  375. END vector;
  376. BEGIN
  377. eb := SELF.firstEB; cb := SELF.firstCB;
  378. pos := 0; epos := 0; cpos := 0;
  379. WHILE pos < SELF.elems DO
  380. IF epos = ElemBlockSize THEN
  381. eb := eb.next; epos := 0
  382. END;
  383. CASE eb.elem[epos] OF
  384. | Enter: vector(cb, cpos); point(cb, cpos)
  385. | Line: point(cb, cpos)
  386. | Arc: point(cb, cpos); point(cb, cpos); point(cb, cpos); point(cb, cpos)
  387. | Bezier: point(cb, cpos); point(cb, cpos); point(cb, cpos)
  388. | Exit: vector(cb, cpos)
  389. END;
  390. INC(pos); INC(epos)
  391. END
  392. END Apply;
  393. (** try to close disconnected enter/exit points by modifying their direction vectors **)
  394. PROCEDURE Close* ();
  395. CONST
  396. eps = 0.001;
  397. VAR
  398. pos, epos, cpos, p, spos: INTEGER; eb: ElemBlock; cb, b, sb: CoordBlock; dx, dy, cx, cy, sx, sy, sdx, sdy, x, y, edx, edy: REAL;
  399. data: DirData;
  400. PROCEDURE get (VAR x, y: REAL);
  401. BEGIN
  402. IF cpos = CoordBlockSize THEN
  403. cb := cb.next; cpos := 0
  404. END;
  405. x := cb.x[cpos]; y := cb.y[cpos];
  406. INC(cpos)
  407. END get;
  408. BEGIN
  409. pos := 0; epos := 0; cpos := 0; eb := SELF.firstEB; cb := SELF.firstCB;
  410. WHILE pos < SELF.elems DO
  411. IF epos = ElemBlockSize THEN
  412. eb := eb.next; epos := 0
  413. END;
  414. CASE eb.elem[epos] OF
  415. | Enter:
  416. b := cb; p := cpos;
  417. get(dx, dy); get(cx, cy);
  418. IF (dx = 0) & (dy = 0) THEN
  419. sb := b; spos := p; sx := cx; sy := cy; sdx := 0; sdy := 0
  420. END
  421. | Line:
  422. get(x, y); dx := x - cx; dy := y - cy; cx := x; cy := y;
  423. IF (sdx = 0) & (sdy = 0) THEN
  424. sdx := dx; sdy := dy
  425. END
  426. | Arc:
  427. data.sdx := 0; data.sdy := 0; data.cx := cx; data.cy := cy; data.x := cx; data.y := cy;
  428. get(data.x0, data.y0); get(data.x1, data.y1); get(data.x2, data.y2); get(cx, cy);
  429. EnumArc(data.x0, data.y0, data.x1, data.y1, data.x2, data.y2, cx, cy, 1.0, GetDir, data);
  430. IF (sdx = 0) & (sdy = 0) THEN
  431. sdx := data.sdx; sdy := data.sdy
  432. END;
  433. dx := data.edx; dy := data.edy
  434. | Bezier:
  435. get(x, y);
  436. IF (sdx = 0) & (sdy = 0) THEN
  437. sdx := x - cx; sdy := y - cy
  438. END;
  439. get(x, y); get(cx, cy); dx := cx - x; dy := cy - y
  440. | Exit:
  441. b := cb; p := cpos;
  442. get(edx, edy);
  443. IF (edx = 0) & (edy = 0) & (ABS(x - sx) <= eps) & (ABS(y - sy) <= eps) THEN
  444. IF spos = CoordBlockSize THEN
  445. sb := sb.next; spos := 0
  446. END;
  447. sb.x[spos] := dx; sb.y[spos] := dy;
  448. IF p = CoordBlockSize THEN
  449. b := b.next; p := 0
  450. END;
  451. b.x[p] := sdx; b.y[p] := sdy
  452. END
  453. END;
  454. INC(pos); INC(epos)
  455. END
  456. END Close;
  457. (** split subpath in two at given offset (resulting subpaths may be flattened in the process) **)
  458. PROCEDURE Split* (offset: REAL; head, tail: Path);
  459. VAR data: SplitData;
  460. BEGIN
  461. IF offset <= 0 THEN
  462. SELF.CopyTo(tail); head.Clear()
  463. ELSIF offset >= SELF.Length(1) THEN
  464. SELF.CopyTo(head); tail.Clear()
  465. ELSE
  466. head.Clear(); tail.Clear();
  467. data.offset := offset; data.head := head; data.tail := tail;
  468. SELF.EnumFlattened(1, EnumSplit, data)
  469. END
  470. END Split;
  471. (** return projection of point onto path **)
  472. PROCEDURE ProjectToPath* (x, y: REAL; VAR u, v: REAL);
  473. VAR data: ProjectData;
  474. BEGIN
  475. data.px := x; data.py := y; data.dist := MAX(REAL); data.rx := MAX(REAL); data.ry := MAX(REAL);
  476. SELF.EnumFlattened(1, EnumProject, data);
  477. u := data.rx; v := data.ry
  478. END ProjectToPath;
  479. (**--- Path Queries ---**)
  480. (** return whether rectangle is completely inside (closed) path **)
  481. PROCEDURE InPath* (llx, lly, urx, ury: REAL; evenOdd: BOOLEAN): BOOLEAN;
  482. VAR data: QueryData;
  483. BEGIN
  484. data.thorough := TRUE; data.sum := 0; data.hit := FALSE; data.llx := llx; data.lly := lly; data.urx := urx; data.ury := ury;
  485. SELF.EnumFlattened(1, EnumQuery, data);
  486. RETURN data.hit OR evenOdd & ODD(ABS(data.sum) DIV 2) OR ~evenOdd & (data.sum # 0)
  487. END InPath;
  488. (** return whether rectangle intersects SELF **)
  489. PROCEDURE OnPath* (llx, lly, urx, ury: REAL): BOOLEAN;
  490. VAR data: QueryData;
  491. BEGIN
  492. data.thorough := FALSE; data.hit := FALSE; data.llx := llx; data.lly := lly; data.urx := urx; data.ury := ury;
  493. SELF.EnumFlattened(1, EnumQuery, data);
  494. RETURN data.hit
  495. END OnPath;
  496. END Path;
  497. (** path scanner **)
  498. (**
  499. Path scanners can be used to iterate over a path under client control. The scanner's elem field specifies what
  500. the current element is, whereas the remaining fields contain the parameters for that element. A Stop element
  501. indicates that the end of the path has been reached.
  502. **)
  503. Scanner* = RECORD
  504. path*: Path; (** visited path **)
  505. pos*: INTEGER; (** element position **)
  506. elem*: INTEGER; (** current path element **)
  507. x*, y*: REAL; (** current end coordinates **)
  508. dx*, dy*: REAL; (** direction vector **)
  509. x0*, y0*, x1*, y1*, x2*, y2*: REAL; (** additional control point coordinates **)
  510. curEB: ElemBlock; (* current element block *)
  511. curCB: CoordBlock; (* current coordinate block *)
  512. epos, cpos: INTEGER; (* next element and coordinate position within current block *)
  513. (** open scanner on path and load parameters of element at given position **)
  514. PROCEDURE Open* (path: Path; pos: INTEGER);
  515. BEGIN
  516. SELF.path := path;
  517. SELF.curEB := path.firstEB; SELF.curCB := path.firstCB;
  518. SELF.pos := pos; SELF.epos := pos; SELF.cpos := 0;
  519. WHILE SELF.epos > ElemBlockSize DO
  520. DEC(SELF.epos, ElemBlockSize);
  521. INC(SELF.cpos, SELF.curEB.coords);
  522. SELF.curEB := SELF.curEB.next
  523. END;
  524. pos := 0;
  525. WHILE pos < SELF.epos DO
  526. SELF.cpos := SELF.cpos + Coords[SELF.curEB.elem[pos]]; INC(pos)
  527. END;
  528. WHILE SELF.cpos > CoordBlockSize DO
  529. DEC(SELF.cpos, CoordBlockSize);
  530. SELF.curCB := SELF.curCB.next
  531. END;
  532. IF SELF.pos = path.elems THEN
  533. SELF.elem := Stop
  534. ELSE
  535. IF SELF.epos = ElemBlockSize THEN (* at end of current block *)
  536. SELF.curEB := SELF.curEB.next; SELF.epos := 0
  537. END;
  538. SELF.elem := SELF.curEB.elem[SELF.epos]; INC(SELF.epos);
  539. CASE SELF.elem OF
  540. | Enter: get(SELF.dx, SELF.dy); get(SELF.x, SELF.y)
  541. | Line: get(SELF.x, SELF.y)
  542. | Arc: get(SELF.x0, SELF.y0); get(SELF.x1, SELF.y1); get(SELF.x2, SELF.y2); get(SELF.x, SELF.y)
  543. | Bezier: get(SELF.x1, SELF.y1); get(SELF.x2, SELF.y2); get(SELF.x, SELF.y)
  544. | Exit: get(SELF.dx, SELF.dy)
  545. END
  546. END
  547. END Open;
  548. (** advance to next element and load its parameters **)
  549. PROCEDURE Scan* ();
  550. BEGIN
  551. IF SELF.pos < SELF.path.elems THEN
  552. INC(SELF.pos);
  553. IF SELF.pos = SELF.path.elems THEN
  554. SELF.elem := Stop
  555. ELSE
  556. IF SELF.epos = ElemBlockSize THEN (* at end of current block *)
  557. SELF.curEB := SELF.curEB.next; SELF.epos := 0
  558. END;
  559. SELF.elem := SELF.curEB.elem[SELF.epos]; INC(SELF.epos);
  560. CASE SELF.elem OF
  561. | Enter: get(SELF.dx, SELF.dy); get(SELF.x, SELF.y)
  562. | Exit: get(SELF.dx, SELF.dy)
  563. | Line: get(SELF.x, SELF.y)
  564. | Arc: get(SELF.x0, SELF.y0); get(SELF.x1, SELF.y1); get(SELF.x2, SELF.y2); get(SELF.x, SELF.y)
  565. | Bezier: get(SELF.x1, SELF.y1); get(SELF.x2, SELF.y2); get(SELF.x, SELF.y)
  566. END
  567. END
  568. END
  569. END Scan;
  570. PROCEDURE get (VAR x, y: REAL);
  571. BEGIN
  572. IF SELF.cpos = CoordBlockSize THEN
  573. SELF.curCB := SELF.curCB.next; SELF.cpos := 0
  574. END;
  575. x := SELF.curCB.x[SELF.cpos]; y := SELF.curCB.y[SELF.cpos]; INC(SELF.cpos)
  576. END get;
  577. END (* Scanner *);
  578. (** path enumeration **)
  579. EnumData* = RECORD
  580. elem*: INTEGER; (** current path element **)
  581. x*, y*, dx*, dy*, x0*, y0*, x1*, y1*, x2*, y2*: REAL; (** element parameters **)
  582. END;
  583. Enumerator* = PROCEDURE (VAR data: EnumData);
  584. ProjectData = RECORD (EnumData)
  585. px, py: REAL; (* point coordinates *)
  586. rx, ry: REAL; (* projection coordinates *)
  587. sx, sy: REAL; (* previous coordinates *)
  588. dist: REAL; (* distance of projection to original point *)
  589. END;
  590. QueryData = RECORD (EnumData)
  591. llx, lly, urx, ury: REAL; (* query rectangle *)
  592. sx, sy: REAL; (* previous coordinates *)
  593. code: SET; (* clip code of previous point *)
  594. sum: LONGINT; (* number of ray crossings for inside test *)
  595. hit, thorough: BOOLEAN;
  596. END;
  597. LengthData = RECORD (EnumData)
  598. sx, sy: REAL; (* previous coordinates *)
  599. len: REAL;
  600. END;
  601. DirData = RECORD (EnumData)
  602. cx, cy: REAL;
  603. sdx, sdy: REAL;
  604. edx, edy: REAL;
  605. END;
  606. SplitData = RECORD (EnumData)
  607. head, tail: Path;
  608. offset: REAL;
  609. sx, sy: REAL;
  610. sdx, sdy: REAL
  611. END;
  612. VAR
  613. Coords: ARRAY Exit+1 OF SHORTINT; (* number of coordinate pairs for each element type *)
  614. (**--- Path Construction ---**)
  615. PROCEDURE AddElem (path: Path; elem: SHORTINT);
  616. VAR elems: INTEGER; eb: ElemBlock;
  617. BEGIN
  618. elems := path.elems MOD ElemBlockSize;
  619. IF (elems = 0) & (path.elems > 0) THEN
  620. NEW(eb); path.lastEB.next := eb; path.lastEB := eb;
  621. END;
  622. path.lastEB.elem[elems] := elem;
  623. INC(path.elems)
  624. END AddElem;
  625. PROCEDURE AddCoord (path: Path; x, y: REAL);
  626. VAR coords: INTEGER; cb: CoordBlock;
  627. BEGIN
  628. coords := path.coords MOD CoordBlockSize;
  629. IF (coords = 0) & (path.coords > 0) THEN
  630. NEW(cb); path.lastCB.next := cb; path.lastCB := cb
  631. END;
  632. path.lastCB.x[coords] := x; path.lastCB.y[coords] := y;
  633. INC(path.coords); INC(path.lastEB.coords)
  634. END AddCoord;
  635. (**--- Enumerating (Flattened) Paths ---**)
  636. (**
  637. In addition to being scanned, path elements may also be enumerated. The advantage of enumerating path
  638. elements is that arcs and bezier curves can be enumerated as a sequence of lines approximating the original
  639. curve. Besides, natural splines can enumerated in terms of regular path elements.
  640. **)
  641. (** enumerate arc as a sequence of lines with maximal error 'flatness'; current point must be in (data.x, data.y) **)
  642. PROCEDURE EnumArc* (x0, y0, x1, y1, x2, y2, x, y, flatness: REAL; enum: Enumerator; VAR data: EnumData);
  643. CONST
  644. eps = 1.0E-3;
  645. VAR
  646. lx, ly, sense, xs, ys, xe, ye, dt, p2, tmp, p1, dx1, dx2, dy1, dy2, sx, sy, tx, ty, limit, dx, dy, tlen, ex, ey: REAL;
  647. positive: BOOLEAN;
  648. BEGIN
  649. (* algorithm: D. Fellner & C. Helmberg, Robust Rendering of General Ellipses and Elliptical Arcs, ACM TOG July 1993 *)
  650. data.elem := Line;
  651. x1 := x1 - x0; y1 := y1 - y0;
  652. x2 := x2 - x0; y2 := y2 - y0;
  653. IF ABS(x1 * y2 - y1 * x2) <= eps * ABS(x1 * x2 + y1 * y2) THEN (* approximate with line *)
  654. data.x := x; data.y := y; enum(data);
  655. RETURN
  656. END;
  657. lx := ABS(x1) + ABS(x2); ly := ABS(y1) + ABS(y2);
  658. IF (lx <= ly) & (lx <= flatness) OR (ly <= lx) & (ly <= flatness) THEN (* radius smaller than flatness *)
  659. data.x := x; data.y := y; enum(data);
  660. RETURN
  661. END;
  662. IF flatness < eps THEN flatness := eps END;
  663. IF x1 * y2 > y1 * x2 THEN sense := 1 ELSE sense := -1 END;
  664. xs := data.x - x0; ys := data.y - y0;
  665. xe := x - x0; ye := y - y0;
  666. IF lx >= ly THEN dt := flatness/lx
  667. ELSE dt := flatness/ly
  668. END;
  669. (* find first point on arc *)
  670. p2 := xs * y2 - ys * x2;
  671. IF ABS(p2) < eps THEN (* (x2, y2) on start vector *)
  672. tmp := x1; x1 := x2; x2 := -tmp;
  673. tmp := y1; y1 := y2; y2 := -tmp;
  674. p1 := 0
  675. ELSE
  676. p1 := xs * y1 - ys * x1
  677. END;
  678. IF ABS(p1) < eps THEN (* (x1, y1) on start vector *)
  679. IF xs * x1 + ys * y1 < -eps THEN (* on opposite side of origin *)
  680. x1 := -x1; y1 := -y1;
  681. x2 := -x2; y2 := -y2
  682. END;
  683. IF ABS(x1 - xs) + ABS(y1 - ys) > flatness THEN
  684. data.x := x0 + x1; data.y := y0 + y1;
  685. enum(data)
  686. END;
  687. dx1 := 0; dx2 := 0; dy1 := 0; dy2 := 0
  688. ELSE (* search start point on ellipse *)
  689. IF (p1 > 0) = (p2 > 0) THEN
  690. tmp := x1; x1 := x2; x2 := -tmp;
  691. tmp := y1; y1 := y2; y2 := -tmp;
  692. p1 := p2
  693. END;
  694. IF p1 * sense > 0 THEN
  695. x1 := -x1; y1 := -y1;
  696. x2 := -x2; y2 := -y2
  697. END;
  698. dx1 := 0; dx2 := 0; dy1 := 0; dy2 := 0;
  699. REPEAT
  700. tmp := dx1;
  701. dx1 := (x2 - 0.5 * dx2) * dt; dx2 := (x1 + 0.5 * tmp) * dt;
  702. x1 := x1 + dx1; x2 := x2 - dx2;
  703. tmp := dy1;
  704. dy1 := (y2 - 0.5 * dy2) * dt; dy2 := (y1 + 0.5 * tmp) * dt;
  705. y1 := y1 + dy1; y2 := y2 - dy2
  706. UNTIL (xs * y1 - ys * x1) * sense >= 0;
  707. data.x := x0 + x1; data.y := y0 + y1;
  708. enum(data)
  709. END;
  710. sx := x1; sy := y1; (* start point of current line *)
  711. tx := 0; ty := 0; (* (approximate) tangent vector at start point *)
  712. limit := flatness * flatness;
  713. positive := ((ye * x1 - xe * y1) * sense > 0);
  714. LOOP
  715. tmp := dx1;
  716. dx1 := (x2 - 0.5 * dx2) * dt; dx2 := (x1 + 0.5 * tmp) * dt;
  717. x1 := x1 + dx1; x2 := x2 - dx2;
  718. tmp := dy1;
  719. dy1 := (y2 - 0.5 * dy2) * dt; dy2 := (y1 + 0.5 * tmp) * dt;
  720. y1 := y1 + dy1; y2 := y2 - dy2;
  721. p1 := (ye * x1 - xe * y1) * sense;
  722. IF p1 > 0 THEN
  723. positive := TRUE
  724. ELSIF positive THEN
  725. EXIT
  726. END;
  727. dx := x1 - sx; dy := y1 - sy;
  728. IF (tx = 0) & (ty = 0) THEN (* first point *)
  729. tx := dx; ty := dy; tlen := tx * tx + ty * ty
  730. ELSE
  731. tmp := dx * ty - dy * tx;
  732. IF (tmp * tmp)/tlen > limit THEN (* distance from new point to tangent vector is greater than flatness *)
  733. sx := ex; sy := ey;
  734. data.x := x0 + sx; data.y := y0 + sy;
  735. enum(data);
  736. tx := dx; ty := dy; tlen := tx * tx + ty * ty
  737. END
  738. END;
  739. ex := x1; ey := y1
  740. END;
  741. data.x := x; data.y := y;
  742. enum(data)
  743. END EnumArc;
  744. (** enumerate bezier curve as a sequence of lines with maximal error 'flatness'; current point must be in (data.x, data.y) **)
  745. PROCEDURE EnumBezier* (x1, y1, x2, y2, x, y, flatness: REAL; enum: Enumerator; VAR data: EnumData);
  746. CONST eps = 1.0E-8;
  747. VAR f2, ax, bx, t, x01, x11, x12, x22, x23, y01, y11, y12, y22, y23: REAL;
  748. PROCEDURE subdiv (t, x0, x1, x2, x3: REAL; VAR a1, a2, m, b1, b2: REAL);
  749. VAR s, x12: REAL;
  750. BEGIN
  751. s := 1-t;
  752. a1 := s * x0 + t * x1; b2 := s * x2 + t * x3; x12 := s * x1 + t * x2;
  753. a2 := s * a1 + t * x12; b1 := s * x12 + t * b2;
  754. m := s * a2 + t * b1
  755. END subdiv;
  756. PROCEDURE draw (x1, y1, x2, y2, x, y: REAL);
  757. VAR x01, x11, x12, x22, x23, y01, y11, y12, y22, y23, dx, dy, ex, ey, cp: REAL;
  758. BEGIN
  759. subdiv(0.5, data.x, x1, x2, x, x01, x11, x12, x22, x23);
  760. subdiv(0.5, data.y, y1, y2, y, y01, y11, y12, y22, y23);
  761. dx := x12 - data.x; dy := y12 - data.y;
  762. ex := x - data.x; ey := y - data.y;
  763. cp := dx*ey - dy*ex;
  764. IF cp*cp <= f2 * (ex*ex + ey*ey) THEN (* flat enough *)
  765. data.x := x; data.y := y; enum(data)
  766. ELSE
  767. draw(x01, y01, x11, y11, x12, y12);
  768. draw(x22, y22, x23, y23, x, y)
  769. END
  770. END draw;
  771. PROCEDURE solve (a, b, c: REAL; VAR t1, t2: REAL; VAR n: INTEGER);
  772. VAR d, e, t: REAL;
  773. BEGIN
  774. n := 0; d := b * b - a * c;
  775. IF d >= 0 THEN
  776. d := Math.sqrt(d); e := -b + d;
  777. IF (a * e > 0) & (ABS(e) < ABS(a)) THEN
  778. t1 := e/a; n := 1;
  779. e := -b - d;
  780. IF (d > 0) & (a * e > 0) & (ABS(e) < ABS(a)) THEN
  781. t2 := e/a; n := 2;
  782. IF t2 < t1 THEN t := t1; t1 := t2; t2 := t END
  783. END
  784. ELSE
  785. e := -b - d;
  786. IF (a * e > 0) & (ABS(e) < ABS(a)) THEN
  787. t1 := e/a; n := 1
  788. END
  789. END
  790. END;
  791. ASSERT((n = 0) OR (n = 1) & (0 < t1) & (t1 < 1) OR (n = 2) & (0 < t1) & (t1 < t2) & (t2 < 1))
  792. END solve;
  793. PROCEDURE norm2y (x1, y1, x2, y2, x, y: REAL);
  794. VAR t1, t2, x01, x11, x12, x22, x23, y01, y11, y12, y22, y23: REAL; n: INTEGER;
  795. BEGIN
  796. solve(y - data.y + 3*(y1 - y2), data.y - 2*y1 + y2, y1 - data.y, t1, t2, n);
  797. IF n = 0 THEN
  798. draw(x1, y1, x2, y2, x, y)
  799. ELSE
  800. subdiv(t1, data.x, x1, x2, x, x01, x11, x12, x22, x23);
  801. subdiv(t1, data.y, y1, y2, y, y01, y11, y12, y22, y23);
  802. draw(x01, y01, x11, y11, x12, y12);
  803. IF n = 2 THEN
  804. t2 := (t2 - t1)/(1-t1);
  805. subdiv(t2, data.x, x22, x23, x, x01, x11, x12, x22, x23);
  806. subdiv(t2, data.y, y22, y23, y, y01, y11, y12, y22, y23);
  807. draw(x01, y01, x11, y11, x12, y12)
  808. END;
  809. draw(x22, y22, x23, y23, x, y)
  810. END
  811. END norm2y;
  812. PROCEDURE norm2x (x1, y1, x2, y2, x, y: REAL);
  813. VAR t1, t2, x01, x11, x12, x22, x23, y01, y11, y12, y22, y23: REAL; n: INTEGER;
  814. BEGIN
  815. solve(x - data.x + 3*(x1 - x2), data.x - 2*x1 + x2, x1 - data.x, t1, t2, n);
  816. IF n = 0 THEN
  817. norm2y(x1, y1, x2, y2, x, y)
  818. ELSE
  819. subdiv(t1, data.x, x1, x2, x, x01, x11, x12, x22, x23);
  820. subdiv(t1, data.y, y1, y2, y, y01, y11, y12, y22, y23);
  821. norm2y(x01, y01, x11, y11, x12, y12);
  822. IF n = 2 THEN
  823. t2 := (t2 - t1)/(1-t1);
  824. subdiv(t2, data.x, x22, x23, x, x01, x11, x12, x22, x23);
  825. subdiv(t2, data.y, y22, y23, y, y01, y11, y12, y22, y23);
  826. norm2y(x01, y01, x11, y11, x12, y12)
  827. END;
  828. norm2y(x22, y22, x23, y23, x, y)
  829. END
  830. END norm2x;
  831. PROCEDURE norm1y (x1, y1, x2, y2, x, y: REAL);
  832. VAR ay, by, t, x01, x11, x12, x22, x23, y01, y11, y12, y22, y23: REAL;
  833. BEGIN
  834. ay := y - data.y + 3*(y1 - y2); by := data.y - 2*y1 + y2;
  835. IF (ay * by < 0) & (ABS(by) < ABS(ay)) THEN
  836. t := -by/ay;
  837. subdiv(t, data.x, x1, x2, x, x01, x11, x12, x22, x23);
  838. subdiv(t, data.y, y1, y2, y, y01, y11, y12, y22, y23);
  839. norm2x(x01, y01, x11, y11, x12, y12);
  840. norm2x(x22, y22, x23, y23, x, y)
  841. ELSE
  842. norm2x(x1, y1, x2, y2, x, y)
  843. END
  844. END norm1y;
  845. BEGIN
  846. data.elem := Line;
  847. f2 := flatness * flatness;
  848. IF f2 < eps THEN f2 := eps END;
  849. ax := x - data.x + 3*(x1 - x2); bx := data.x - 2*x1 + x2;
  850. IF (ax * bx < 0) & (ABS(bx) < ABS(ax)) THEN
  851. t := -bx/ax;
  852. subdiv(t, data.x, x1, x2, x, x01, x11, x12, x22, x23);
  853. subdiv(t, data.y, y1, y2, y, y01, y11, y12, y22, y23);
  854. norm1y(x01, y01, x11, y11, x12, y12);
  855. norm1y(x22, y22, x23, y23, x, y)
  856. ELSE
  857. norm1y(x1, y1, x2, y2, x, y)
  858. END
  859. END EnumBezier;
  860. (*
  861. * The code for the spline evaluation has been adapted from Beat Stamm's Graphic module. It handles natural open
  862. * and closed splines.
  863. *)
  864. PROCEDURE SolveClosed (n: LONGINT; VAR x, y, d: ARRAY OF REAL);
  865. VAR hn, dn, d0, d1, t1, t2: REAL; a, b, c, u: ARRAY MaxSplinePoints OF REAL; i: LONGINT;
  866. BEGIN
  867. hn := 1/(x[n - 1] - x[n - 2]); dn := 3 * (y[n - 1] - y[n - 2]) * hn * hn;
  868. b[0] := 1/(x[1] - x[0]); a[0] := hn + 2*b[0]; c[0] := b[0];
  869. d0 := 3 * (y[1] - y[0]) * b[0] * b[0]; d[0] := dn + d0;
  870. u[0] := 1;
  871. i := 1;
  872. WHILE i < n - 2 DO
  873. b[i] := 1/(x[i + 1] - x[i]); a[i] := 2 * (c[i - 1] + b[i]); c[i] := b[i];
  874. d1 := 3 * (y[i + 1] - y[i]) * b[i] * b[i]; d[i] := d0 + d1; d0 := d1;
  875. u[i] := 0;
  876. INC(i)
  877. END;
  878. a[i] := 2 * b[i - 1] + hn; d[i] := dn + d0; u[i] := 1;
  879. i := 0;
  880. WHILE i < n - 2 DO
  881. c[i] := c[i]/a[i];
  882. a[i + 1] := a[i + 1] - c[i] * b[i];
  883. INC(i)
  884. END;
  885. i := 1;
  886. WHILE i < n - 1 DO
  887. t1 := c[i - 1];
  888. t2 := t1 * d[i - 1];
  889. d[i] := d[i] - t2;
  890. t2 := t1 * u[i - 1];
  891. u[i] := u[i] - t2;
  892. INC(i)
  893. END;
  894. d[n - 2] := d[n - 2]/a[n - 2];
  895. u[n - 2] := u[n - 2]/a[n - 2];
  896. i := n - 3;
  897. WHILE i >= 0 DO
  898. t1 := b[i] * d[i + 1];
  899. d[i] := (d[i] - t1)/a[i];
  900. t1 := b[i] * u[i + 1];
  901. u[i] := (u[i] - t1)/a[i];
  902. DEC(i)
  903. END;
  904. d0 := (d[0] + d[n - 2])/(u[0] + u[n - 2] + x[n - 1] - x[n - 2]);
  905. i := 0;
  906. WHILE i < n - 1 DO
  907. d[i] := d[i] - d0 * u[i];
  908. INC(i)
  909. END;
  910. d[n - 1] := d[0]
  911. END SolveClosed;
  912. PROCEDURE Solve (n: LONGINT; VAR x, y, d: ARRAY OF REAL);
  913. VAR a, b, c: ARRAY MaxSplinePoints OF REAL; d0, d1, t: REAL; i: LONGINT;
  914. BEGIN
  915. b[0] := 1/(x[1] - x[0]); a[0] := 2*b[0]; c[0] := b[0];
  916. d0 := 3 * (y[1] - y[0]) * b[0] * b[0]; d[0] := d0;
  917. i := 1;
  918. WHILE i < n - 1 DO
  919. b[i] := 1/(x[i + 1] - x[i]); a[i] := 2 * (c[i - 1] + b[i]); c[i] := b[i];
  920. d1 := 3 * (y[i + 1] - y[i]) * b[i] * b[i]; d[i] := d0 + d1; d0 := d1;
  921. INC(i)
  922. END;
  923. a[i] := 2 * b[i - 1]; d[i] := d0;
  924. i := 0;
  925. WHILE i < n - 1 DO
  926. c[i] := c[i]/a[i];
  927. a[i + 1] := a[i + 1] - c[i] * b[i];
  928. INC(i)
  929. END;
  930. i := 1;
  931. WHILE i < n DO
  932. t := c[i - 1] * d[i - 1];
  933. d[i] := d[i] - t;
  934. INC(i)
  935. END;
  936. d[n - 1] := d[n - 1]/a[n - 1];
  937. i := n - 2;
  938. WHILE i >= 0 DO
  939. t := b[i] * d[i + 1];
  940. d[i] := (d[i] - t)/a[i];
  941. DEC(i)
  942. END
  943. END Solve;
  944. (** enumerate natural spline as sequence of path elements; current point must be in (data.x, data.y) **)
  945. PROCEDURE EnumSpline* (VAR x, y: ARRAY OF REAL; n: LONGINT; closed: BOOLEAN; enum: Enumerator; VAR data: EnumData);
  946. VAR s, xp, yp: ARRAY MaxSplinePoints OF REAL; i: LONGINT; dx, dy, ds, ds2, bx, by, t: REAL;
  947. BEGIN
  948. ASSERT((n >= 2) & (n <= MaxSplinePoints));
  949. ASSERT(~closed OR (x[0] = x[n - 1]) & (y[0] = y[n - 1]));
  950. IF ~closed & (n = 2) THEN
  951. data.elem := Line; data.x := x[1]; data.y := y[1]; enum(data)
  952. ELSIF closed & (n = 3) THEN
  953. data.elem := Arc; data.x0 := 0.5*(x[0] + x[1]); data.y0 := 0.5*(y[0] + y[1]); data.x1 := x[0]; data.y1 := y[0];
  954. data.x2 := data.x0 + (data.y0 - data.y); data.y2 := data.y0 + (data.x - data.x0); enum(data)
  955. ELSE
  956. (* use arc length for parametrizing the spline *)
  957. s[0] := 0.0;
  958. i := 1;
  959. WHILE i < n DO
  960. dx := x[i] - x[i - 1]; dy := y[i] - y[i - 1];
  961. s[i] := s[i - 1] + Math.sqrt(dx * dx + dy * dy) + 0.01; (* make sure s[i] > s[i - 1] *)
  962. INC(i)
  963. END;
  964. (* calculate derivatives *)
  965. IF closed THEN
  966. SolveClosed(n, s, x, xp);
  967. SolveClosed(n, s, y, yp)
  968. ELSE
  969. Solve(n, s, x, xp);
  970. Solve(n, s, y, yp)
  971. END;
  972. data.elem := Bezier;
  973. i := 1;
  974. WHILE i < n DO
  975. ds := 1.0/(s[i] - s[i - 1]); ds2 := ds * ds;
  976. dx := ds * (x[i] - x[i - 1]);
  977. dy := ds * (y[i] - y[i - 1]);
  978. bx := ds * (3*dx - 2*xp[i - 1] - xp[i]);
  979. by := ds * (3*dy - 2*yp[i - 1] - yp[i]);
  980. t := 1/ds;
  981. data.x1 := x[i - 1] + (1/3)*xp[i - 1]*t;
  982. data.y1 := y[i - 1] + (1/3)*yp[i - 1]*t;
  983. t := 1/ds2;
  984. data.x2 := 2*data.x1 - x[i - 1] + (1/3) * bx * t;
  985. data.y2 := 2*data.y1 - y[i - 1] + (1/3) * by * t;
  986. data.x := x[i]; data.y := y[i];
  987. enum(data);
  988. INC(i)
  989. END
  990. END
  991. END EnumSpline;
  992. (**--- Path Queries ---**)
  993. PROCEDURE Code (VAR data: QueryData; x, y: REAL): SET;
  994. VAR code: SET;
  995. BEGIN
  996. code := {};
  997. IF x < data.llx THEN INCL(code, Left)
  998. ELSIF x > data.urx THEN INCL(code, Right)
  999. END;
  1000. IF y < data.lly THEN INCL(code, Bottom)
  1001. ELSIF y > data.ury THEN INCL(code, Top)
  1002. END;
  1003. RETURN code
  1004. END Code;
  1005. PROCEDURE EnumQuery (VAR data: EnumData);
  1006. VAR x, y: REAL; code, cc: SET;
  1007. BEGIN
  1008. (*
  1009. The procedure uses a simplified version of the Cohen-Sutherland clipping algorithm. The endpoint of
  1010. the current line is consecutively clipped against all sides of the rectangle until both points of the line
  1011. are outside the rectangle with respect to one single rectangle border or until the clipped endpoint
  1012. is inside the rectangle.
  1013. *)
  1014. WITH data: QueryData DO
  1015. IF ~data.hit THEN
  1016. IF data.elem = Enter THEN
  1017. data.code := Code(data, data.x, data.y);
  1018. IF data.code = {} THEN (* point inside rectangle *)
  1019. data.hit := TRUE
  1020. ELSE
  1021. data.sx := data.x; data.sy := data.y
  1022. END
  1023. ELSIF (data.elem = Line) & ((data.x # data.sx) OR (data.y # data.sy)) THEN
  1024. x := data.x; y := data.y;
  1025. LOOP
  1026. code := Code(data, x, y);
  1027. IF code = {} THEN (* point inside rectangle *)
  1028. data.hit := TRUE;
  1029. EXIT
  1030. END;
  1031. cc := data.code * code;
  1032. IF cc # {} THEN (* no intersection with rectangle *)
  1033. IF data.thorough THEN
  1034. (*
  1035. For every line crossing the rectangle's middle y coordinate, accumulate how often the rectangle's
  1036. midpoint lies to the left/right of the line
  1037. *)
  1038. y := 0.5*(data.lly + data.ury);
  1039. IF (data.sy <= y) & (y < data.y) OR (data.y <= y) & (y < data.sy) THEN
  1040. x := 0.5*(data.llx + data.urx);
  1041. IF (data.x - data.sx) * (y - data.sy) >= (data.y - data.sy) * (x - data.sx) THEN
  1042. INC(data.sum)
  1043. ELSE
  1044. DEC(data.sum)
  1045. END
  1046. END
  1047. END;
  1048. data.code := Code(data, data.x, data.y); data.sx := data.x; data.sy := data.y;
  1049. EXIT
  1050. END;
  1051. IF Left IN code THEN
  1052. y := data.sy + (y - data.sy) * (data.llx - data.sx)/(x - data.sx);
  1053. x := data.llx
  1054. ELSIF Right IN code THEN
  1055. y := data.sy + (y - data.sy) * (data.urx - data.sx)/(x - data.sx);
  1056. x := data.urx
  1057. ELSIF Bottom IN code THEN
  1058. x := data.sx + (x - data.sx) * (data.lly - data.sy)/(y - data.sy);
  1059. y := data.lly
  1060. ELSE (* Top IN code *)
  1061. x := data.sx + (x - data.sx) * (data.ury - data.sy)/(y - data.sy);
  1062. y := data.ury
  1063. END
  1064. END
  1065. END
  1066. END
  1067. END
  1068. END EnumQuery;
  1069. PROCEDURE EnumBoxElem (VAR data: EnumData);
  1070. BEGIN
  1071. WITH data: QueryData DO
  1072. IF data.elem IN {Enter, Line} THEN
  1073. IF data.x < data.llx THEN data.llx := data.x END;
  1074. IF data.x > data.urx THEN data.urx := data.x END;
  1075. IF data.y < data.lly THEN data.lly := data.y END;
  1076. IF data.y > data.ury THEN data.ury := data.y END
  1077. END
  1078. END
  1079. END EnumBoxElem;
  1080. (** calculate bounding box of path **)
  1081. PROCEDURE GetBox* (path: Path; VAR llx, lly, urx, ury: REAL); (**DEPRECATED -- SVGRenderer *)
  1082. BEGIN
  1083. path.GetBox(llx, lly, urx, ury);
  1084. END GetBox;
  1085. (** calculate line length **)
  1086. PROCEDURE LineLength* (x0, y0, x1, y1: REAL): REAL;
  1087. VAR dx, dy: REAL;
  1088. BEGIN
  1089. dx := x1 - x0; dy := y1 - y0;
  1090. RETURN Math.sqrt(dx * dx + dy * dy)
  1091. END LineLength;
  1092. PROCEDURE EnumLength (VAR data: EnumData);
  1093. VAR dx, dy: REAL;
  1094. BEGIN
  1095. WITH data: LengthData DO
  1096. IF data.elem = Line THEN
  1097. dx := data.x - data.sx; dy := data.y - data.sy;
  1098. data.len := data.len + Math.sqrt(dx * dx + dy * dy)
  1099. END;
  1100. data.sx := data.x; data.sy := data.y
  1101. END
  1102. END EnumLength;
  1103. (** calculate arc length **)
  1104. PROCEDURE ArcLength* (sx, sy, ex, ey, x0, y0, x1, y1, x2, y2, flatness: REAL): REAL;
  1105. VAR data: LengthData;
  1106. BEGIN
  1107. data.x := sx; data.y := sy; data.sx := sx; data.sy := sy; data.len := 0;
  1108. EnumArc(x0, y0, x1, y1, x2, y2, ex, ey, flatness, EnumLength, data);
  1109. RETURN data.len
  1110. END ArcLength;
  1111. (** calculate bezier length **)
  1112. PROCEDURE BezierLength* (x0, y0, x1, y1, x2, y2, x3, y3, flatness: REAL): REAL;
  1113. VAR data: LengthData;
  1114. BEGIN
  1115. data.x := x0; data.y := y0; data.sx := x0; data.sy := y0; data.len := 0;
  1116. EnumBezier(x1, y1, x2, y2, x3, y3, flatness, EnumLength, data);
  1117. RETURN data.len
  1118. END BezierLength;
  1119. (**--- Path Operations ---**)
  1120. (** apply transformation to all coordinates in path **)
  1121. PROCEDURE Apply* (path: Path; VAR mat: GfxMatrix.Matrix); (**DEPRECATED -- Used in SVGRenderer *)
  1122. BEGIN
  1123. path.Apply(mat);
  1124. END Apply;
  1125. PROCEDURE GetDir (VAR data: EnumData);
  1126. BEGIN
  1127. WITH data: DirData DO
  1128. IF (data.sdx = 0) & (data.sdy = 0) THEN
  1129. data.sdx := data.x - data.cx; data.sdy := data.y - data.cy
  1130. END;
  1131. data.edx := data.x - data.cx; data.edy := data.y - data.cy;
  1132. data.cx := data.x; data.cy := data.y
  1133. END
  1134. END GetDir;
  1135. PROCEDURE EnumSplit (VAR data: EnumData);
  1136. VAR dx, dy, d, s, sx, sy: REAL;
  1137. BEGIN
  1138. WITH data: SplitData DO
  1139. CASE data.elem OF
  1140. | Enter:
  1141. IF data.offset > 0 THEN data.head.AddEnter(data.x, data.y, data.dx, data.dy)
  1142. ELSE data.tail.AddEnter(data.x, data.y, data.dx, data.dy)
  1143. END;
  1144. data.sx := data.x; data.sy := data.y
  1145. | Line:
  1146. IF data.offset > 0 THEN (* still appending to head *)
  1147. dx := data.x - data.sx; dy := data.y - data.sy; d := Math.sqrt(dx * dx + dy * dy);
  1148. IF d > 0 THEN
  1149. IF d < data.offset THEN (* doesn't reach split offset *)
  1150. data.head.AddLine(data.x, data.y);
  1151. data.offset := data.offset - d; data.sx := data.x; data.sy := data.y
  1152. ELSIF d > data.offset THEN (* split within line *)
  1153. s := data.offset/d;
  1154. sx := data.sx + s * dx; sy := data.sy + s * dy;
  1155. data.head.AddLine(sx, sy); data.head.AddExit(dx, dy); (* leave head... *)
  1156. data.tail.AddEnter(sx, sy, dx, dy); data.tail.AddLine(data.x, data.y); (* ...and enter tail *)
  1157. data.offset := data.offset - d (* now < 0 *)
  1158. ELSE (* d = offset: delay until next line/exit *)
  1159. data.offset := 0; data.sx := data.x; data.sy := data.y; data.sdx := dx; data.sdy := dy
  1160. END
  1161. END
  1162. ELSIF data.offset < 0 THEN (* appending to tail *)
  1163. data.tail.AddLine(data.x, data.y)
  1164. ELSE (* split point at previous line end point *)
  1165. data.head.AddLine(data.sx, data.sy); data.head.AddExit(dx, dy); (* leave head... *)
  1166. data.tail.AddEnter(data.sx, data.sy, data.sdx, data.sdy); (* ...and enter tail *)
  1167. data.tail.AddLine(data.x, data.y);
  1168. data.offset := -1
  1169. END
  1170. | Exit:
  1171. IF data.offset > 0 THEN data.head.AddExit(data.dx, data.dy)
  1172. ELSIF data.offset < 0 THEN data.tail.AddExit(data.dx, data.dy)
  1173. ELSE data.head.AddLine(data.sx, data.sy); data.head.AddExit(data.dx, data.dy); data.offset := -1
  1174. END
  1175. END
  1176. END
  1177. END EnumSplit;
  1178. (**--- Geometry Support ---**)
  1179. (** compute intersection of two lines **)
  1180. PROCEDURE IntersectLines* (x1, y1, dx1, dy1, x2, y2, dx2, dy2: REAL; VAR x, y: REAL);
  1181. VAR d, t: REAL;
  1182. BEGIN
  1183. d := dx1 * dy2 - dy1 * dx2;
  1184. t := (x2 - x1) * dy2 - (y2 - y1) * dx2;
  1185. IF (ABS(d) >= 1) OR (ABS(d) * MAX(REAL) >= ABS(t)) THEN
  1186. t := t/d;
  1187. x := x1 + t * dx1; y := y1 + t * dy1
  1188. ELSE
  1189. x := 0.5*(x2 - x1); y := 0.5*(y2 - y1)
  1190. END
  1191. END IntersectLines;
  1192. (** compute intersection(s) of line with circle; returns number of solutions in nsol **)
  1193. PROCEDURE IntersectLineCircle* (sx, sy, tx, ty, mx, my, r: REAL; VAR x1, y1, x2, y2: REAL; VAR nsol: LONGINT);
  1194. VAR dx, dy, cx, cy, a2, b, c, d, t: REAL;
  1195. BEGIN
  1196. dx := tx - sx; dy := ty - sy;
  1197. cx := sx - mx; cy := sy - my;
  1198. a2 := 2 * (dx * dx + dy * dy);
  1199. b := 2 * (dx * cx + dy * cy);
  1200. c := cx * cx + cy * cy - r * r;
  1201. d := b * b - 2 * a2 * c;
  1202. IF d < 0 THEN
  1203. nsol := 0
  1204. ELSE
  1205. d := Math.sqrt(d);
  1206. IF (d >= b) & (d - b <= a2) THEN
  1207. t := (d - b)/a2;
  1208. x1 := sx + t * dx; y1 := sy + t * dy;
  1209. IF (b + d <= 0) & (b + d >= -a2) THEN
  1210. t := (b + d)/a2;
  1211. x2 := sx - t * dx; y2 := sy - t * dy;
  1212. nsol := 2
  1213. ELSE
  1214. nsol := 1
  1215. END
  1216. ELSIF (b + d <= 0) & (b + d >= -a2) THEN
  1217. t := (b + d)/a2;
  1218. x2 := sx - t * dx; y2 := sy - t * dy;
  1219. nsol := 1
  1220. END
  1221. END
  1222. END IntersectLineCircle;
  1223. (** return projection of point onto line **)
  1224. PROCEDURE ProjectToLine* (px, py, qx, qy, x, y: REAL; VAR u, v: REAL);
  1225. VAR vx, vy, vv, wx, wy, w, d: REAL;
  1226. BEGIN
  1227. vx := qx - px; vy := qy - py;
  1228. vv := vx * vx + vy * vy;
  1229. wx := x - px; wy := y - py;
  1230. w := wx * vx + wy * vy;
  1231. IF (vv >= 1) OR (vv * MAX(REAL) >= ABS(w)) THEN
  1232. d := w/vv;
  1233. u := px + d * vx; v := py + d * vy
  1234. ELSE
  1235. u := px; v := py
  1236. END
  1237. END ProjectToLine;
  1238. (** return projection of point onto ellipse at origin **)
  1239. PROCEDURE ProjectToEllipse* (ax, ay, bx, by, x, y: REAL; VAR u, v: REAL);
  1240. VAR a, sina, cosa, b, shear, l: REAL;
  1241. BEGIN
  1242. IF ABS(ax * by - ay * bx) < 1.0E-10 THEN
  1243. u := 0.0; v := 0.0
  1244. ELSE (* find parameters to rotate, shear and scale ellipse to unit circle *)
  1245. a := Math.sqrt(ax * ax + ay * ay);
  1246. sina := ay/a; cosa := ax/a;
  1247. b := cosa * by - sina * bx;
  1248. shear := (cosa * bx + sina * by)/b;
  1249. v := cosa * y - sina * x;
  1250. u := (cosa * x + sina * y - shear * v)/a;
  1251. v := v/b;
  1252. l := Math.sqrt(u * u + v * v);
  1253. u := u/l; v := v/l;
  1254. (* map u, v back to original coordinates *)
  1255. y := v * b;
  1256. x := u * a + shear * y;
  1257. u := cosa * x - sina * y;
  1258. v := sina * x + cosa * y
  1259. END
  1260. END ProjectToEllipse;
  1261. PROCEDURE EnumProject (VAR data: EnumData);
  1262. VAR x, y, dx, dy, d:REAL;
  1263. BEGIN
  1264. WITH data: ProjectData DO
  1265. IF data.elem = Enter THEN
  1266. data.sx := data.x; data.sy := data.y
  1267. ELSIF data.elem = Line THEN
  1268. ProjectToLine(data.sx, data.sy, data.x, data.y, data.px, data.py, x, y);
  1269. dx := data.px - x; dy := data.py - y;
  1270. d := dx * dx + dy * dy;
  1271. IF d < data.dist THEN
  1272. dx := data.x - data.sx; dy := data.y - data.sy;
  1273. IF ((x - data.sx) * dx + (y - data.sy) * dy >= 0) & ((data.x - x) * dx + (data.y - y) * dy >= 0) THEN
  1274. data.rx := x; data.ry := y; data.dist := d
  1275. END
  1276. END;
  1277. data.sx := data.x; data.sy := data.y
  1278. END
  1279. END
  1280. END EnumProject;
  1281. BEGIN
  1282. Coords[Enter] := 2; Coords[Line] := 1; Coords[Arc] := 4; Coords[Bezier] := 3; Coords[Exit] := 1
  1283. END GfxPaths.