WMGraphicsSmooth.Mod 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720
  1. (**
  2. AUTHOR: "Alexey Morozov";
  3. PURPOSE: "Smooth (antialiased) graphics";
  4. *)
  5. MODULE WMGraphicsSmooth;
  6. IMPORT SYSTEM, Raster, Strings, WMGraphics;
  7. CONST
  8. (** Line cap types *)
  9. CapButt* = 0; (** A flat edge is added to each end of the line; *)
  10. CapRound* = 1; (** A rounded end cap is added to each end of the line; *)
  11. CapSquare* = 2; (** A square end cap is added to each end of the line; *)
  12. TYPE
  13. (**
  14. Cancas used for smooth (antialiased) graphics
  15. *)
  16. Canvas* = OBJECT(WMGraphics.BufferCanvas)
  17. VAR
  18. lineWidth-: REAL; (** line width in pixels *)
  19. capType-: LONGINT; (** line cap type *)
  20. srcOverDstMode: Raster.Mode;
  21. pixAlphaMap: ARRAY 256 OF Raster.Pixel;
  22. PROCEDURE &New(img : Raster.Image);
  23. VAR firstTime: BOOLEAN;
  24. BEGIN
  25. firstTime := generator = NIL;
  26. New^(img);
  27. IF firstTime THEN (*! for cases when the same canvas is reused with another image *)
  28. generator := Strings.NewString("WMGraphicsSmooth.GenCanvas");
  29. SetLineWidth(1.0);
  30. SetLineCap(CapButt);
  31. SetColor(WMGraphics.Blue);
  32. Raster.InitMode(srcOverDstMode,Raster.srcOverDst);
  33. END;
  34. END New;
  35. PROCEDURE SetColor(x: WMGraphics.Color);
  36. VAR
  37. i: LONGINT;
  38. s: LONGINT;
  39. r, g, b, a: LONGINT;
  40. BEGIN
  41. SetColor^(x);
  42. WMGraphics.ColorToRGBA(color,r,g,b,a);
  43. s := (256 * a) DIV 255;
  44. FOR i := 0 TO 255 DO Raster.SetRGBA(pixAlphaMap[i],r,g,b,a - (s*i+128) DIV 256); END;
  45. END SetColor;
  46. (**
  47. Set line width in pixels
  48. *)
  49. PROCEDURE SetLineWidth*(w: REAL);
  50. BEGIN
  51. IF w < 0.5 THEN w := 0.5; END;
  52. lineWidth := w;
  53. END SetLineWidth;
  54. (**
  55. Setup line cap type
  56. *)
  57. (*! REMARK: currently onle CapButt is implemented! *)
  58. PROCEDURE SetLineCap*(lineCap: LONGINT);
  59. BEGIN
  60. capType := MIN(CapSquare,MAX(CapButt,lineCap));
  61. END SetLineCap;
  62. PROCEDURE Line(x0, y0, x1, y1: LONGINT; lineColor: WMGraphics.Color; mode: LONGINT);
  63. VAR xr0, yr0, xr1, yr1: REAL;
  64. BEGIN
  65. IF lineColor # color THEN SetColor(lineColor); END;
  66. (* transform local coordinates to the global coordinate system *)
  67. xr0 := x0 + dx; yr0 := y0 + dy;
  68. xr1 := x1 + dx; yr1 := y1 + dy;
  69. IF lineWidth = 1 THEN
  70. (* does the line cross the canvas rectangle? *)
  71. IF ~ClipLineReal(limits.l,limits.t,limits.r-1,limits.b-1, xr0,yr0,xr1,yr1) THEN RETURN; END;
  72. ThinSmoothLineReal(img, xr0,yr0, xr1,yr1, pixAlphaMap, srcOverDstMode);
  73. ELSE
  74. (* does the line cross the canvas rectangle with account of the line width? *)
  75. IF ~ClipLineReal(limits.l-lineWidth,limits.t-lineWidth,limits.r-1+lineWidth,limits.b-1+lineWidth, xr0,yr0,xr1,yr1) THEN RETURN; END;
  76. ThickSmoothLineReal(img, xr0,yr0, xr1,yr1, pixAlphaMap, srcOverDstMode, lineWidth);
  77. END;
  78. END Line;
  79. (**
  80. Draw an antialiased line represented by real-valued coordinates of the starting and ending points
  81. *)
  82. PROCEDURE LineReal*(x0, y0, x1, y1: REAL; lineColor: WMGraphics.Color; mode: LONGINT);
  83. VAR
  84. dx, dy, g: REAL;
  85. x01, y01, x02, y02: REAL;
  86. x11, y11, x12, y12: REAL;
  87. points : ARRAY 4 OF WMGraphics.Point2d;
  88. BEGIN
  89. IF lineColor # color THEN SetColor(lineColor); END;
  90. (* transform local coordinates to the global coordinate system *)
  91. x0 := x0 + dx; y0 := y0 + dy;
  92. x1 := x1 + dx; y1 := y1 + dy;
  93. IF lineWidth <= 1 THEN
  94. (* does the line cross the canvas rectangle? *)
  95. IF ~ClipLineReal(limits.l,limits.t,limits.r-1,limits.b-1, x0,y0,x1,y1) THEN RETURN; END;
  96. ThinSmoothLineReal(img, x0,y0, x1,y1, pixAlphaMap, srcOverDstMode);
  97. ELSE
  98. (* does the line cross the canvas rectangle with account of the line width? *)
  99. IF ~ClipLineReal(limits.l-lineWidth,limits.t-lineWidth,limits.r-1+lineWidth,limits.b-1+lineWidth, x0,y0,x1,y1) THEN RETURN; END;
  100. ThickSmoothLineReal(img, x0,y0, x1,y1, pixAlphaMap, srcOverDstMode, lineWidth);
  101. (*! an alternative way based on FillPolygonFlat - potentially faster than the current implementation of ThickSmoothLineReal; *)
  102. (*
  103. dx := x1 - x0;
  104. dy := y1 - y0;
  105. g := (0.5*lineWidth) * InvSqrt(dx*dx + dy*dy);
  106. x01 := x0 + dy*g;
  107. y01 := y0 - dx*g;
  108. x11 := x1 + dy*g;
  109. y11 := y1 - dx*g;
  110. x02 := x01 - 2*dy*g;
  111. y02 := y01 + 2*dx*g;
  112. x12 := x11 - 2*dy*g;
  113. y12 := y11 + 2*dx*g;
  114. points[0].x := Round(x01); points[0].y := Round(y01);
  115. points[1].x := Round(x02); points[1].y := Round(y02);
  116. points[2].x := Round(x12); points[2].y := Round(y12);
  117. points[3].x := Round(x11); points[3].y := Round(y11);
  118. FillPolygonFlat(points,4,lineColor,WMGraphics.ModeCopy);
  119. ThinSmoothLineReal(img, x01,y01, x11,y11, pixAlphaMap, srcOverDstMode);
  120. ThinSmoothLineReal(img, x02,y02, x12,y12, pixAlphaMap, srcOverDstMode);
  121. ThinSmoothLineReal(img, x01,y01, x02,y02, pixAlphaMap, srcOverDstMode);
  122. ThinSmoothLineReal(img, x11,y11, x12,y12, pixAlphaMap, srcOverDstMode);
  123. *)
  124. END;
  125. END LineReal;
  126. END Canvas;
  127. PROCEDURE GenCanvas*(img:Raster.Image):WMGraphics.BufferCanvas; (* generator procedure *)
  128. VAR c:Canvas;
  129. BEGIN
  130. NEW(c,img); RETURN c (* img is NIL, needs a call of c.New(img) later on *)
  131. END GenCanvas;
  132. (**
  133. Fast inverse square root (1 / sqrt(x))
  134. Based on the "0x5f3759df" algorithm described in Wikipedia ( https://en.wikipedia.org/wiki/Fast_inverse_square_root )
  135. *)
  136. PROCEDURE InvSqrt(x: REAL): REAL;
  137. VAR y: REAL;
  138. BEGIN
  139. y := SYSTEM.VAL(REAL,0x5f3759df - SYSTEM.VAL(LONGINT,x) DIV 2); (* ~4% of error *)
  140. RETURN y * ( 1.5E0 - y * y * (x * 0.5E0) ); (* ~0.15% of error *)
  141. END InvSqrt;
  142. (**
  143. Draw a thin (<=1 pixel wide) antialiased line defined by starting and ending points with real coordinates
  144. img: raster image object
  145. x0, y0: starting line position
  146. x1, y1: ending line position
  147. pixAlphaMap: pixel map for 256 alpha values for a given line color
  148. srcOverDstMode: raster mode corresponding to source over destination transfer (use Raster.InitMode(srcOverDstMode,Raster.srcOverDst);)
  149. REMARK:
  150. In this code the signed distance function is defined as: sdist(x,y) = (dx*(y-y0) - dy*(x-x0)) / sqrt(dx*dx+dy*dy), where dx = x1-x0, dy = y1-y0
  151. POSSIBLE COMPILER BUG: if "CONST pixAlphaMap: ARRAY 256 OF Raster.Pixel" is replaced by "CONST pixAlphaMap: ARRAY OF Raster.Pixel" the generated code traps with an access violation!!!
  152. *)
  153. (*!TODO: optimize the code for performance; consider to use fixed point arithmetics *)
  154. PROCEDURE ThinSmoothLineReal(
  155. img: Raster.Image;
  156. x0, y0, x1, y1: REAL;
  157. CONST pixAlphaMap: ARRAY 256 OF Raster.Pixel;
  158. VAR srcOverDstMode: Raster.Mode
  159. );
  160. VAR
  161. swapped: BOOLEAN;
  162. a, i, incx, incy, x, y, yy, xend: LONGINT;
  163. dx, dy, sdx, sdy, dc, dm, dd, d0, d1, v, v0, v1, w: REAL;
  164. x0p, y0p, x1p: REAL;
  165. BEGIN
  166. dx := x1 - x0;
  167. dy := y1 - y0;
  168. IF dx < 0 THEN
  169. x0 := x0 + dx; x1 := x1 - dx;
  170. y0 := y0 + dy; y1 := y1 - dy;
  171. dx := -dx; dy := -dy;
  172. END;
  173. IF ABS(dy) > ABS(dx) THEN (* slope > 1 *)
  174. v := x0; x0 := y0; y0 := v;
  175. v := x1; x1 := y1; y1 := v;
  176. v := dx; dx := dy; dy := v;
  177. swapped := TRUE;
  178. END;
  179. IF dx >= 0 THEN incx := 1; ELSE incx := -1; END;
  180. IF dy >= 0 THEN incy := 1; ELSE incy := -1; END;
  181. (* normalize ranges by the distance between the point- will be used for computing the signed distance to the line *)
  182. v := InvSqrt(dx*dx + dy*dy);
  183. dx := dx*v; dy := dy*v;
  184. sdx := dx; sdy := dy; (* differences used for lines perpendicular to the original line *)
  185. (* account for the signs of the coordinate differences *)
  186. IF ~((dx >= 0) & (dy >= 0)) OR (((dx < 0) & (dy < 0))) THEN
  187. dx := -dx; dy := -dy;
  188. END;
  189. (* move start and end points to the left and right accordingly by 2 units along the line *)
  190. x0p := x0 - 2.0*sdx;
  191. y0p := y0 - 2.0*sdy;
  192. x1p := x1 + 2.0*sdx;
  193. x := ENTIER(x0p);
  194. y := ENTIER(y0p);
  195. dm := dx*(y + 0.5*incy - y0) - dy*((x+incx) - x0); (* signed distance at the midpoint dm = sdist(x+incx,y+0.5*incy) *)
  196. d0 := sdy*(y - y0) + sdx*(x - x0); (* signed distance for the line, which goes through (x0,y0) and perpendicular to the original line (sdist0) *)
  197. d1 := sdy*(y - y1) + sdx*(x - x1); (* signed distance for the line, which goes through (x0,y0) and perpendicular to the original line (sdist1) *)
  198. dd := dx*0.5*incy - dy*incx; (* offset for computing signed distance at the current point (x,y-incy) *)
  199. (* account for the signs of the increments *)
  200. IF incx < 0 THEN dy := -dy; sdx := -sdx; END;
  201. IF incy < 0 THEN dx := -dx; sdy := -sdy; END;
  202. xend := ENTIER(x1p);
  203. WHILE x # xend DO
  204. dc := dm - dd; (* dc = sdist(x,y) *)
  205. w := ABS(dc);
  206. IF w < 1.0 THEN
  207. w := MAX(MAX(-d0,d1),w);
  208. IF w < 1.0 THEN
  209. IF swapped THEN Raster.Put(img,y,x,pixAlphaMap[ENTIER(255*w)],srcOverDstMode); ELSE Raster.Put(img,x,y,pixAlphaMap[ENTIER(255*w)],srcOverDstMode); END;
  210. END;
  211. END;
  212. yy := y;
  213. v := dc - dx; w := ABS(v);
  214. IF w < 1.0 THEN
  215. (* y - incy *)
  216. DEC(yy,incy); v0 := d0 - sdy; v1 := d1 - sdy;
  217. w := MAX(MAX(-v0,v1),w);
  218. IF w < 1.0 THEN
  219. IF swapped THEN Raster.Put(img,yy,x,pixAlphaMap[ENTIER(255*w)],srcOverDstMode); ELSE Raster.Put(img,x,yy,pixAlphaMap[ENTIER(255*w)],srcOverDstMode); END;
  220. END;
  221. (* y - 2*incy *)
  222. v := v - dx; w := ABS(v);
  223. IF w < 1.0 THEN
  224. DEC(yy,incy); v0 := v0 - sdy; v1 := v1 - sdy;
  225. w := MAX(MAX(-v0,v1),w);
  226. IF w < 1.0 THEN
  227. IF swapped THEN Raster.Put(img,yy,x,pixAlphaMap[ENTIER(255*w)],srcOverDstMode); ELSE Raster.Put(img,x,yy,pixAlphaMap[ENTIER(255*w)],srcOverDstMode); END;
  228. END;
  229. END;
  230. END;
  231. yy := y;
  232. v := dc + dx; w := ABS(v);
  233. IF w < 1.0 THEN
  234. (* y + incy *)
  235. INC(yy,incy); v0 := d0 + sdy; v1 := d1 + sdy;
  236. w := MAX(MAX(-v0,v1),w);
  237. IF w < 1.0 THEN
  238. IF swapped THEN Raster.Put(img,yy,x,pixAlphaMap[ENTIER(255*w)],srcOverDstMode); ELSE Raster.Put(img,x,yy,pixAlphaMap[ENTIER(255*w)],srcOverDstMode); END;
  239. END;
  240. (* y + 2*incy *)
  241. v := v + dx; w := ABS(v);
  242. IF w < 1.0 THEN
  243. INC(yy,incy); v0 := v0 + sdy; v1 := v1 + sdy;
  244. w := MAX(MAX(-v0,v1),w);
  245. IF w < 1.0 THEN
  246. IF swapped THEN Raster.Put(img,yy,x,pixAlphaMap[ENTIER(255*w)],srcOverDstMode); ELSE Raster.Put(img,x,yy,pixAlphaMap[ENTIER(255*w)],srcOverDstMode); END;
  247. END;
  248. END;
  249. END;
  250. IF dm < 0 THEN
  251. INC(y,incy);
  252. dm := dm + dx;
  253. d0 := d0 + sdy; d1 := d1 + sdy;
  254. END;
  255. dm := dm - dy;
  256. d0 := d0 + sdx; d1 := d1 + sdx;
  257. INC(x,incx);
  258. END;
  259. END ThinSmoothLineReal;
  260. (**
  261. Draw a thick (>1 pixel wide) antialiased line defined by starting and ending points with real coordinates
  262. img: raster image object
  263. x0, y0: starting line position
  264. x1, y1: ending line position
  265. pixAlphaMap: pixel map for 256 alpha values for a given line color
  266. srcOverDstMode: raster mode corresponding to source over destination transfer (use Raster.InitMode(srcOverDstMode,Raster.srcOverDst);)
  267. lineWidth: real-value line width
  268. REMARK:
  269. In this code the signed distance function is defined as: sdist(x,y) = (dx*(y-y0) - dy*(x-x0)) / sqrt(dx*dx+dy*dy), where dx = x1-x0, dy = y1-y0
  270. POSSIBLE COMPILER BUG: if "CONST pixAlphaMap: ARRAY 256 OF Raster.Pixel" is replaced by "CONST pixAlphaMap: ARRAY OF Raster.Pixel" the generated code traps with an access violation!!!
  271. *)
  272. (*!TODO: optimize the code for performance; consider to use fixed point arithmetics *)
  273. PROCEDURE ThickSmoothLineReal(img: Raster.Image; x0, y0, x1, y1: REAL; CONST pixAlphaMap: ARRAY 256 OF Raster.Pixel; VAR srcOverDstMode: Raster.Mode; lineWidth: REAL);
  274. VAR
  275. swapped: BOOLEAN;
  276. a, i, incx, incy, x, y, yy, xend: LONGINT;
  277. dx, dy, sdx, sdy, dc, dm, dd, d0, d1, v, v0, v1, w: REAL;
  278. x0p, y0p, x1p: REAL;
  279. halfWidth: REAL;
  280. BEGIN
  281. halfWidth := 0.5*lineWidth;
  282. dx := x1 - x0;
  283. dy := y1 - y0;
  284. IF dx < 0 THEN
  285. x0 := x0 + dx; x1 := x1 - dx;
  286. y0 := y0 + dy; y1 := y1 - dy;
  287. dx := -dx; dy := -dy;
  288. END;
  289. IF ABS(dy) > ABS(dx) THEN (* slope > 1 *)
  290. v := x0; x0 := y0; y0 := v;
  291. v := x1; x1 := y1; y1 := v;
  292. v := dx; dx := dy; dy := v;
  293. swapped := TRUE;
  294. END;
  295. IF dx >= 0 THEN incx := 1; ELSE incx := -1; END;
  296. IF dy >= 0 THEN incy := 1; ELSE incy := -1; END;
  297. (* normalize ranges by the distance between the point- will be used for computing the signed distance to the line *)
  298. v := InvSqrt(dx*dx + dy*dy);
  299. dx := dx*v; dy := dy*v;
  300. sdx := dx; sdy := dy; (* differences used for lines perpendicular to the original line *)
  301. (* account for the signs of the coordinate differences *)
  302. IF ~((dx >= 0) & (dy >= 0)) OR (((dx < 0) & (dy < 0))) THEN
  303. dx := -dx; dy := -dy;
  304. END;
  305. (* move start and end points to the left and right accordingly by 2 units along the line *)
  306. x0p := x0 - lineWidth*sdx;
  307. y0p := y0 - lineWidth*sdy;
  308. x1p := x1 + lineWidth*sdx;
  309. x := ENTIER(x0p);
  310. y := ENTIER(y0p);
  311. dm := dx*(y + 0.5*incy - y0) - dy*((x+incx) - x0); (* signed distance at the midpoint dm = sdist(x+incx,y+0.5*incy) *)
  312. d0 := sdy*(y - y0) + sdx*(x - x0); (* signed distance for the line, which goes through (x0,y0) and perpendicular to the original line (sdist0) *)
  313. d1 := sdy*(y - y1) + sdx*(x - x1); (* signed distance for the line, which goes through (x0,y0) and perpendicular to the original line (sdist1) *)
  314. dd := dx*0.5*incy - dy*incx; (* offset for computing signed distance at the current point (x,y-incy) *)
  315. (* account for the signs of the increments *)
  316. IF incx < 0 THEN dy := -dy; sdx := -sdx; END;
  317. IF incy < 0 THEN dx := -dx; sdy := -sdy; END;
  318. xend := ENTIER(x1p);
  319. WHILE x # xend DO
  320. dc := dm - dd; (* dc = sdist(x,y) *)
  321. w := MAX(MAX(-d0,d1),ABS(dc));
  322. IF (d0 >= 0) & (d1 <= 0) THEN
  323. IF swapped THEN Raster.Put(img,y,x,pixAlphaMap[0],srcOverDstMode); ELSE Raster.Put(img,x,y,pixAlphaMap[0],srcOverDstMode); END;
  324. ELSIF w < 1 THEN
  325. IF swapped THEN Raster.Put(img,y,x,pixAlphaMap[ENTIER(255*w)],srcOverDstMode); ELSE Raster.Put(img,x,y,pixAlphaMap[ENTIER(255*w)],srcOverDstMode); END;
  326. END;
  327. yy := y;
  328. v := dc - dx; v0 := d0; v1 := d1;
  329. w := -v - halfWidth;
  330. WHILE w < 1 DO
  331. DEC(yy,incy); v0 := v0 - sdy; v1 := v1 - sdy;
  332. w := MAX(MAX(-v0,v1),w);
  333. IF w < 0 THEN
  334. IF swapped THEN Raster.Put(img,yy,x,pixAlphaMap[0],srcOverDstMode); ELSE Raster.Put(img,x,yy,pixAlphaMap[0],srcOverDstMode); END;
  335. ELSIF w < 1 THEN
  336. IF swapped THEN Raster.Put(img,yy,x,pixAlphaMap[ENTIER(255*w)],srcOverDstMode); ELSE Raster.Put(img,x,yy,pixAlphaMap[ENTIER(255*w)],srcOverDstMode); END;
  337. END;
  338. v := v - dx; w := -v - halfWidth;
  339. END;
  340. yy := y;
  341. v := dc + dx; v0 := d0; v1 := d1;
  342. w := v - halfWidth;
  343. WHILE w < 1 DO
  344. INC(yy,incy); v0 := v0 + sdy; v1 := v1 + sdy;
  345. w := MAX(MAX(-v0,v1),w);
  346. IF w < 0 THEN
  347. IF swapped THEN Raster.Put(img,yy,x,pixAlphaMap[0],srcOverDstMode); ELSE Raster.Put(img,x,yy,pixAlphaMap[0],srcOverDstMode); END;
  348. ELSIF w < 1 THEN
  349. IF swapped THEN Raster.Put(img,yy,x,pixAlphaMap[ENTIER(255*w)],srcOverDstMode); ELSE Raster.Put(img,x,yy,pixAlphaMap[ENTIER(255*w)],srcOverDstMode); END;
  350. END;
  351. v := v + dx; w := v - halfWidth;
  352. END;
  353. IF dm < 0 THEN
  354. INC(y,incy);
  355. dm := dm + dx;
  356. d0 := d0 + sdy; d1 := d1 + sdy;
  357. END;
  358. dm := dm - dy;
  359. d0 := d0 + sdx; d1 := d1 + sdx;
  360. INC(x,incx);
  361. END;
  362. (*VAR
  363. dx, dy, ig: REAL;
  364. x01, y01, x02, y02: REAL;
  365. x11, y11, x12, y12: REAL;
  366. BEGIN
  367. dx := x1 - x0;
  368. dy := y1 - y0;
  369. ig := halfWidth * InvSqrt(dx*dx + dy*dy);
  370. dx := dx*ig; dy := dy*ig;
  371. x01 := x0 + dy;
  372. y01 := y0 - dx;
  373. x11 := x1 + dy;
  374. y11 := y1 - dx;
  375. x02 := x01 - 2*dy;
  376. y02 := y01 + 2*dx;
  377. x12 := x11 - 2*dy;
  378. y12 := y11 + 2*dx;
  379. ThinSmoothLineReal(img, x01,y01, x11,y11, pixAlphaMap, srcOverDstMode);
  380. ThinSmoothLineReal(img, x02,y02, x12,y12, pixAlphaMap, srcOverDstMode);
  381. ThinSmoothLineReal(img, x01,y01, x02,y02, pixAlphaMap, srcOverDstMode);
  382. ThinSmoothLineReal(img, x11,y11, x12,y12, pixAlphaMap, srcOverDstMode);*)
  383. END ThickSmoothLineReal;
  384. PROCEDURE Round(x: REAL): LONGINT;
  385. BEGIN
  386. IF x >= 0 THEN
  387. RETURN ENTIER(x+0.5);
  388. ELSE
  389. RETURN -ENTIER(-x+0.5);
  390. END;
  391. END Round;
  392. (*
  393. Find intersection of a line with a given rectangle
  394. l, r, t, b: left,right,top,bottom coordinates of the rectangle
  395. x0, y0: starting line point
  396. x1, y1: end line point
  397. Intersection points are returned in x0, y0, x1, y1
  398. *)
  399. PROCEDURE ClipLineReal(l, t, r, b: REAL; VAR x0, y0, x1, y1: REAL): BOOLEAN;
  400. VAR
  401. dy, dx, x00, y00: REAL;
  402. BEGIN
  403. dx := x1 - x0;
  404. dy := y1 - y0;
  405. IF dy = 0 THEN (* horizontal line *)
  406. IF (y0 >= t) & (y0 <= b) THEN
  407. IF x0 <= x1 THEN
  408. RETURN (x0 <= r) & (x1 >= l);
  409. ELSE
  410. RETURN (x1 <= r) & (x0 >= l);
  411. END;
  412. ELSE
  413. RETURN FALSE;
  414. END;
  415. ELSIF dx = 0 THEN (* vertical line *)
  416. IF (x0 >= l) & (x0 <= r) THEN
  417. IF y0 <= y1 THEN
  418. RETURN (y0 <= b) & (y1 >= t);
  419. ELSE
  420. RETURN (y1 <= b) & (y0 >= t);
  421. END;
  422. ELSE
  423. RETURN FALSE;
  424. END;
  425. ELSE
  426. IF x0 < x1 THEN
  427. IF (x0 <= r) & (x1 >= l) THEN
  428. IF y0 <= y1 THEN
  429. IF (y0 <= b) & (y1 >= t) THEN
  430. x00 := x0;
  431. y00 := y0;
  432. IF x0 < l THEN
  433. (* intersection with x = left *)
  434. y0 := y00 + (dy*(l-x00)) / dx; x0 := l;
  435. IF y0 < t THEN
  436. (* intersection with y = tody *)
  437. x0 := x00 + (dx*(t-y00)) / dy; y0 := t;
  438. END;
  439. ELSIF y0 < t THEN
  440. (* intersection with y = tody *)
  441. x0 := x00 + (dx*(t-y00)) / dy; y0 := t;
  442. IF x0 < l THEN
  443. (* intersection with x = left *)
  444. y0 := y00 + (dy*(l-x00)) / dx; x0 := l;
  445. END;
  446. END;
  447. IF x1 > r THEN
  448. (* intersection with x = right *)
  449. y1 := y00 + (dy*(r-x00)) / dx; x1 := r;
  450. IF y1 > b THEN
  451. (* intersection with y = bottom *)
  452. x1 := x00 + (dx*(b-y00)) / dy; y1 := b;
  453. END;
  454. ELSIF y1 > b THEN
  455. (* intersection with y = bottom *)
  456. x1 := x00 + (dx*(b-y00)) / dy; y1 := b;
  457. IF x1 > r THEN
  458. (* intersection with x = right *)
  459. y1 := y00 + (dy*(r-x00)) / dx; x1 := r;
  460. END;
  461. END;
  462. ASSERT(x0 >= l);
  463. ASSERT(y0 >= t);
  464. ASSERT(x1 <= r);
  465. ASSERT(y1 <= b);
  466. ELSE
  467. RETURN FALSE;
  468. END;
  469. ELSIF (y1 <= b) & (y0 >= t) THEN (* y0 > y1, dy < 0 *)
  470. x00 := x0;
  471. y00 := y0;
  472. dy := -dy;
  473. IF x0 < l THEN
  474. (* intersection with x = left *)
  475. y0 := y00 - (dy*(l-x00)) / dx; x0 := l;
  476. IF y0 > b THEN
  477. (* intersection with y = bottom *)
  478. x0 := x00 - (dx*(b-y00)) / dy; y0 := b;
  479. END;
  480. ELSIF y0 > b THEN
  481. (* intersection with y = bottom *)
  482. x0 := x00 - (dx*(b-y00)) / dy; y0 := b;
  483. IF x0 < l THEN
  484. (* intersection with x = left *)
  485. y0 := y00 - (dy*(l-x00)) / dx; x0 := l;
  486. END;
  487. END;
  488. IF x1 > r THEN
  489. (* intersection with x = right *)
  490. y1 := y00 - (dy*(r-x00)) / dx; x1 := r;
  491. IF y1 < t THEN
  492. (* intersection with y = tody *)
  493. x1 := x00 - (dx*(t-y00)) / dy; y1 := t;
  494. END;
  495. ELSIF y1 < t THEN
  496. (* intersection with y = tody *)
  497. x1 := x00 - (dx*(t-y00)) / dy; y1 := t;
  498. IF x1 > r THEN
  499. (* intersection with x = right *)
  500. y1 := y00 - (dy*(r-x00)) / dx; x1 := r;
  501. END;
  502. END;
  503. ASSERT(x0 >= l);
  504. ASSERT(y0 <= b);
  505. ASSERT(x1 <= r);
  506. ASSERT(y1 >= t);
  507. ELSE
  508. RETURN FALSE;
  509. END;
  510. ELSE
  511. RETURN FALSE;
  512. END;
  513. ELSE (* x0 >= x1 *)
  514. IF (x1 <= r) & (x0 >= l) THEN
  515. IF y0 <= y1 THEN
  516. IF (y0 <= b) & (y1 >= t) THEN
  517. x00 := x0;
  518. y00 := y0;
  519. dx := -dx;
  520. IF x0 > r THEN
  521. (* intersection with x = right *)
  522. y0 := y00 - (dy*(r-x00)) / dx; x0 := r;
  523. IF y0 < t THEN
  524. (* intersection with y = tody *)
  525. x0 := x00 - (dx*(t-y00)) / dy; y0 := t;
  526. END;
  527. ELSIF y0 < t THEN
  528. (* intersection with y = tody *)
  529. x0 := x00 - (dx*(t-y00)) / dy; y0 := t;
  530. IF x0 > r THEN
  531. (* intersection with x = right *)
  532. y0 := y00 - (dy*(r-x00)) / dx; x0 := r;
  533. END;
  534. END;
  535. IF x1 < l THEN
  536. (* intersection with x = left *)
  537. y1 := y00 - (dy*(l-x00)) / dx; x1 := l;
  538. IF y1 > b THEN
  539. (* intersection with y = bottom *)
  540. x1 := x00 - (dx*(b-y00)) / dy; y1 := b;
  541. END;
  542. ELSIF y1 > b THEN
  543. (* intersection with y = bottom *)
  544. x1 := x00 - (dx*(b-y00)) / dy; y1 := b;
  545. IF x1 < l THEN
  546. (* intersection with x = left *)
  547. y1 := y00 - (dy*(l-x00)) / dx; x1 := l;
  548. END;
  549. END;
  550. ASSERT(x0 <= r);
  551. ASSERT(y0 >= t);
  552. ASSERT(x1 >= l);
  553. ASSERT(y1 <= b);
  554. ELSE
  555. RETURN FALSE;
  556. END;
  557. ELSIF (y1 <= b) & (y0 >= t) THEN (* dy < 0, dx < 0 *)
  558. x00 := x0;
  559. y00 := y0;
  560. dy := -dy;
  561. dx := -dx;
  562. IF x0 > r THEN
  563. (* intersection with x = right *)
  564. y0 := y00 + (dy*(r-x00)) / dx; x0 := r;
  565. IF y0 > b THEN
  566. (* intersection with y = bottom *)
  567. x0 := x00 + (dx*(b-y00)) / dy; y0 := b;
  568. END;
  569. ELSIF y0 > b THEN
  570. (* intersection with y = bottom *)
  571. x0 := x00 + (dx*(b-y00)) / dy; y0 := b;
  572. IF x0 > r THEN
  573. (* intersection with x = right *)
  574. y0 := y00 + (dy*(r-x00)) / dx; x0 := r;
  575. END;
  576. END;
  577. IF x1 < l THEN
  578. (* intersection with x = left *)
  579. y1 := y00 + (dy*(l-x00)) / dx; x1 := l;
  580. IF y1 < t THEN
  581. (* intersection with y = tody *)
  582. x1 := x00 + (dx*(t-y00)) / dy; y1 := t;
  583. END;
  584. ELSIF y1 < t THEN
  585. (* intersection with y = tody *)
  586. x1 := x00 + (dx*(t-y00)) / dy; y1 := t;
  587. IF x1 < l THEN
  588. (* intersection with x = left *)
  589. y1 := y00 + (dy*(l-x00)) / dx; x1 := l;
  590. END;
  591. END;
  592. ASSERT(x0 <= r);
  593. ASSERT(y0 <= b);
  594. ASSERT(x1 >= l);
  595. ASSERT(y1 >= t);
  596. ELSE
  597. RETURN FALSE;
  598. END;
  599. ELSE
  600. RETURN FALSE;
  601. END;
  602. END;
  603. END;
  604. RETURN TRUE
  605. END ClipLineReal;
  606. END WMGraphicsSmooth.