home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / IOInterface / Picture.icl < prev    next >
Encoding:
Modula Implementation  |  1997-04-23  |  16.6 KB  |  558 lines  |  [TEXT/3PRM]
  1. implementation module Picture;
  2.  
  3. //
  4. //    Drawing functions and other operations on Pictures. 
  5. //
  6.  
  7. import StdClass,StdBool, StdInt, StdReal;
  8. import    quickdraw, fonts, pointer;
  9. import    font, commonDef;
  10.  
  11.  
  12. ::    *Picture        :== * Int;
  13. ::    DrawFunction    :== Picture -> Picture;
  14.  
  15. //    The predefined figures that can be drawn:
  16.  
  17. ::    Point            :== (!Int, !Int);
  18. ::    Line            :== (!Point, !Point);
  19. ::    Curve            :== (!Oval, !Int, !Int);
  20. ::    Rectangle        :== (!Point, !Point);
  21. ::    RoundRectangle    :== (!Rectangle, !Int, !Int);
  22. ::    Oval            :== Rectangle;
  23. ::    Circle            :== (!Point, !Int);
  24. ::    Wedge            :== (!Oval, !Int, !Int);
  25. ::    Polygon            :== (!Point, !PolygonShape);
  26.  
  27. ::    PolygonShape    :== [Vector];
  28. ::    Vector            :== (!Int, !Int);
  29.  
  30.  
  31. //    The pen attributes which influence the way figures are drawn:
  32.  
  33. ::    PenSize            :== (!Int, !Int);
  34. ::    PenMode            =    CopyMode        | OrMode    | XorMode        | ClearMode   | HiliteMode
  35.                     |    NotCopyMode    | NotOrMode    | NotXorMode    | NotClearMode;
  36. ::    PenPattern        =    BlackPattern
  37.                     |    DkGreyPattern
  38.                     |    GreyPattern
  39.                     |    LtGreyPattern
  40.                     |    WhitePattern;
  41.  
  42.  
  43. //    The colours:
  44.  
  45. ::    Colour            =  RGB Real Real Real
  46.                     |    BlackColour    | RedColour
  47.                     |    WhiteColour    | GreenColour
  48.                     |    BlueColour    | YellowColour
  49.                     |    CyanColour    | MagentaColour;
  50.  
  51.  
  52. PI        :== 3.1415926535898;
  53. MinRGB    :== 0.0;
  54. MaxRGB    :== 1.0;
  55.  
  56.  
  57. //    Conversion of Toolbox to Picture and vise versa.
  58.  
  59. NewPicture :: Picture;
  60. NewPicture = 0;
  61.  
  62. MakePicture    :: !Toolbox -> Picture;
  63. MakePicture picture = picture;
  64.     
  65. MakeMacPicture    :: !Picture -> Toolbox;
  66. MakeMacPicture picture = picture;
  67.  
  68.  
  69. //    Calculations with rects and regions.
  70.  
  71. Rect_in_region :: !Rectangle !RgnHandle !Toolbox -> (!Bool, !Toolbox);
  72. Rect_in_region ((l,t),(r,b)) updRgn tb
  73.     =    (not empty, tb7);
  74.     where {
  75.         (newRgn, tb1)    = QNewRgn        tb;
  76.         tb2                = QRectRgn        newRgn (l,t,r,b) tb1;
  77.         (resRgn, tb3)    = QNewRgn        tb2;
  78.         (sectRgn,tb4)    = QSectRgn        newRgn updRgn resRgn tb3;
  79.         (empty,    tb5)    = QEmptyRgn        sectRgn tb4;
  80.         tb6                = QDisposeRgn    newRgn  tb5;
  81.         tb7                = QDisposeRgn    sectRgn tb6;
  82.     };
  83.  
  84.  
  85. //    Rules setting the attributes of a Picture:
  86.  
  87. SetPenSize :: !PenSize !Picture -> Picture;
  88. SetPenSize (w,h) p = QPenSize w h p;
  89.  
  90. SetPenMode :: !PenMode !Picture -> Picture;
  91. SetPenMode CopyMode        p = QPenMode PatCopy    (QTextMode SrcCopy    p);
  92. SetPenMode OrMode        p = QPenMode PatOr        (QTextMode SrcOr    p);
  93. SetPenMode XorMode        p = QPenMode PatXor        (QTextMode SrcXor    p);
  94. SetPenMode ClearMode     p = QPenMode PatBic        (QTextMode SrcBic    p);
  95. SetPenMode NotCopyMode    p = QPenMode NotPatCopy    (QTextMode SrcOr    p);
  96. SetPenMode NotOrMode    p = QPenMode NotPatOr    (QTextMode SrcOr    p);
  97. SetPenMode NotXorMode    p = QPenMode NotPatXor    (QTextMode SrcOr    p);
  98. SetPenMode NotClearMode p = QPenMode NotPatBic    (QTextMode SrcOr    p);
  99. SetPenMode HiliteMode     p
  100. |    hasColorQD    = QPenMode PatHilite (QTextMode PatHilite    p1);
  101.                 = QPenMode PatXor    (QTextMode SrcOr       p1);
  102.     where {
  103.         (hasColorQD, p1) = HasColorQD p;
  104.     };
  105.  
  106. SetPenPattern :: !PenPattern !Picture -> Picture;
  107. SetPenPattern BlackPattern    p = QPenPat Black    p;
  108. SetPenPattern DkGreyPattern    p = QPenPat DkGray    p;
  109. SetPenPattern GreyPattern    p = QPenPat Gray    p;
  110. SetPenPattern LtGreyPattern    p = QPenPat LtGray    p;
  111. SetPenPattern WhitePattern    p = QPenPat White    p;
  112.  
  113. SetPenNormal :: !Picture -> Picture;
  114. SetPenNormal p = QPenNormal (QTextMode SrcOr p);
  115.  
  116.  
  117. //    Using colours:
  118.  
  119. SetPenColour :: !Colour !Picture -> Picture;
  120. SetPenColour colour=:(RGB rd gr bl) p
  121. |    hasColorQD    = QRGBForeColor (RealToRGB rd, RealToRGB gr, RealToRGB bl) p1;
  122.                 = QForeColor (ColourToNormalColor colour) p1;
  123.     where {
  124.         (hasColorQD, p1) = HasColorQD p;
  125.     };
  126. SetPenColour colour p = QForeColor (ColourToNormalColor colour) p;
  127.  
  128. SetBackColour :: !Colour !Picture -> Picture;
  129. SetBackColour colour=:(RGB rd gr bl) p
  130. |    hasColorQD    = QRGBBackColor (RealToRGB rd, RealToRGB gr, RealToRGB bl) p1;
  131.                 = QBackColor (ColourToNormalColor colour) p1;
  132.     where {
  133.         (hasColorQD, p1) = HasColorQD p;
  134.     };
  135. SetBackColour colour p = QBackColor (ColourToNormalColor colour) p;
  136.  
  137. RealToRGB :: !Real -> Int;
  138. RealToRGB real | real >= MaxRGB =  65535;
  139. |    real <= MinRGB    = 0;
  140.                     = toInt (real * 65535.0);
  141.  
  142. ColourToNormalColor    :: !Colour -> Int;
  143. ColourToNormalColor BlackColour                    = BlackColor;
  144. ColourToNormalColor RedColour                    = RedColor;
  145. ColourToNormalColor WhiteColour                    = WhiteColor;
  146. ColourToNormalColor GreenColour                    = GreenColor;
  147. ColourToNormalColor BlueColour                    = BlueColor;
  148. ColourToNormalColor YellowColour                = YellowColor;
  149. ColourToNormalColor CyanColour                    = CyanColor;
  150. ColourToNormalColor MagentaColour                = MagentaColor;
  151. ColourToNormalColor (RGB MaxRGB MaxRGB MaxRGB)    = WhiteColor;
  152. ColourToNormalColor _                            = BlackColor;
  153.  
  154.  
  155. //    Using fonts:
  156.  
  157. SetFont    :: !Font !Picture -> Picture;
  158. SetFont font p
  159.     =    QTextFace (StyleToStyleID style) (QTextSize size (QTextFont nr p));
  160.     where {
  161.         (nr, name, style, size) = FontAtts font;
  162.     };
  163.  
  164. SetFontName    :: !FontName !Picture -> Picture;
  165. SetFontName name p = QTextFont fontNum p1;
  166.     where {
  167.         (fontNum, p1) = GetFNum name p;
  168.     };
  169.  
  170. SetFontStyle :: ![FontStyle] !Picture -> Picture;
  171. SetFontStyle style p = QTextFace (StyleToStyleID style) p;
  172.  
  173. SetFontSize    :: !FontSize !Picture -> Picture;
  174. SetFontSize size p = QTextSize (SetBetween size MinFontSize MaxFontSize) p;
  175.  
  176. PictureCharWidth :: !Char !Picture -> (!Int, !Picture);
  177. PictureCharWidth char p = QCharWidth char p;
  178.  
  179. PictureStringWidth :: !{#Char} !Picture -> (!Int, !Picture);
  180. PictureStringWidth string p = QStringWidth string p;
  181.  
  182. PictureFontMetrics :: !Picture -> (!FontInfo, !Picture);
  183. PictureFontMetrics p = ((ascent,descent,maxWidth,leading),p1);
  184.     where {
  185.         (ascent,descent,maxWidth,leading,p1) = QGetFontInfo p;
  186.     };
  187.  
  188.  
  189. //    Rules changing the position of the pen:
  190.  
  191. //    Absolute and relative pen move operations (without drawing).
  192.  
  193. MovePenTo :: !Point !Picture -> Picture;
  194. MovePenTo (x, y) p = QMoveTo x y p;
  195.  
  196. MovePen :: !Vector !Picture -> Picture;
  197. MovePen (vx, vy) p = QMove vx vy p;
  198.  
  199.  
  200. //    Absolute and relative pen move operations (with drawing).
  201.  
  202. LinePenTo :: !Point !Picture -> Picture;
  203. LinePenTo (x, y) p = QLineTo x y p;
  204.     
  205. LinePen :: !Vector !Picture -> Picture;
  206. LinePen (vx, vy) p = QLine vx vy p;
  207.  
  208.     
  209. //    Drawing text:
  210.  
  211. DrawChar :: !Char !Picture -> Picture;
  212. DrawChar c p = QDrawChar c p;
  213.     
  214. DrawString :: !{#Char} !Picture -> Picture;
  215. DrawString s p = QDrawString s p;
  216.  
  217.  
  218. //    Rules not changing the position of the pen after drawing:
  219.  
  220. //    Non plane figures:
  221.  
  222. DrawPoint :: !Point !Picture -> Picture;
  223. DrawPoint point p =  DrawPoint` point (penX,penY) p1;
  224.     where {
  225.         (penX,penY,p1) = QGetPen p;
  226.     };
  227.  
  228. DrawPoint` :: !Point !Point !Picture -> Picture;
  229. DrawPoint` (x, y) (cx, cy) p = QMoveTo cx cy (QLine 0 0 (QMoveTo x y p));
  230.  
  231. DrawLine :: !Line !Picture -> Picture;
  232. DrawLine line p = DrawLine` line (penX,penY) p1;
  233.     where {
  234.         (penX,penY,p1) = QGetPen p;
  235.     };
  236.  
  237. DrawLine` :: !Line !Point !Picture -> Picture;
  238. DrawLine` ((px,py),(qx,qy)) (cx, cy) p = QMoveTo cx cy (QLineTo qx qy (QMoveTo px py p));
  239.  
  240. DrawCurve :: !Curve !Picture -> Picture;
  241. DrawCurve (r, s, t) p = QFrameArc (RectangleToRect r) (90 - s) (s - t) p;
  242.  
  243. DrawCPoint :: !Point !Colour !Picture -> Picture;
  244. DrawCPoint point=:(h,v) colour=:(RGB rd gr bl) p
  245. |    hasColorQD    = QSetCPixel h v (RealToRGB rd, RealToRGB gr, RealToRGB bl) p1;
  246.                 = DrawPoint` point (x,y) (QForeColor (ColourToNormalColor colour) p2);
  247.     where {
  248.         (hasColorQD,p1) = HasColorQD p;
  249.         (x,y,p2)        = QGetPen p1;
  250.     };
  251. DrawCPoint point colour p
  252.     =    DrawPoint` point (x,y) (QForeColor (ColourToNormalColor colour) p1);
  253.     where {
  254.         (x,y,p1) = QGetPen p;
  255.     };
  256.  
  257. DrawCLine :: !Line !Colour !Picture -> Picture;
  258. DrawCLine line colour p = DrawLine` line (x,y) (SetPenColour colour p1);
  259.     where {
  260.         (x,y,p1) = QGetPen p;
  261.     };
  262.  
  263. DrawCCurve :: !Curve !Colour !Picture -> Picture;
  264. DrawCCurve curve colour p = DrawCurve curve (SetPenColour colour p);
  265.  
  266.  
  267. //    Rectangles:
  268.  
  269. DrawRectangle :: !Rectangle !Picture -> Picture;
  270. DrawRectangle r p = QFrameRect (RectangleToRect r) p;
  271.  
  272. FillRectangle :: !Rectangle !Picture -> Picture;
  273. FillRectangle r p = QPaintRect (RectangleToRect r) p;
  274.     
  275. EraseRectangle :: !Rectangle !Picture -> Picture;
  276. EraseRectangle r p = QEraseRect (RectangleToRect r) p;
  277.     
  278. InvertRectangle :: !Rectangle !Picture -> Picture;
  279. InvertRectangle r p = QInvertRect (RectangleToRect r) p;
  280.  
  281.  
  282. MoveRectangleTo :: !Rectangle !Point !Picture -> Picture;
  283. MoveRectangleTo r (x, y) pict
  284.     | IsEmptyRect clip_rect
  285.         = pict2;
  286.         = MoveRectangle` grafPtr clip_rect (x-left,y-top) pict2;
  287.     where {
  288.         (grafPtr, pict1)= QGetPort pict;
  289.         (clipRect,pict2)= GrafPtrClipRect grafPtr pict1;
  290.         clip_rect        = ClipRect rect clipRect;
  291.         (left,top, _,_)    = rect;
  292.         rect            = RectangleToRect r;
  293.     };
  294.  
  295. MoveRectangle :: !Rectangle !Vector !Picture -> Picture;
  296. MoveRectangle r vector pict
  297.     | IsEmptyRect clip_rect
  298.         = pict2;
  299.         = MoveRectangle` grafPtr clip_rect vector pict2;
  300.     where {
  301.         (grafPtr, pict1)    = QGetPort pict;
  302.         (clipRect,pict2)    = GrafPtrClipRect grafPtr pict1;
  303.         clip_rect             = ClipRect (RectangleToRect r) clipRect;
  304.     };
  305.  
  306. MoveRectangle` :: !GrafPtr !Rect !Vector !Picture -> Picture;
  307. MoveRectangle` grafPtr rect=:(left,top, right,bottom) (dh,dv) pict
  308. |    dh_eq_0 && dv_eq_0    = pict;
  309. |    ABS dh >= w
  310. ||    ABS dv >= h            = QEraseRect rect copy;
  311. |    dv_eq_0 && dh_gr_0    = QEraseRect (left,top, x,    bottom) copy;
  312. |    dv_eq_0 && dh_sm_0    = QEraseRect (x`,  top, right,bottom) copy;
  313. |    dh_eq_0 && dv_gr_0    = QEraseRect (left,top, right,y     ) copy;
  314. |    dh_eq_0 && dv_sm_0    = QEraseRect (left,y`,  right,bottom) copy;
  315. |    dh_gr_0                = QEraseRect (left,top, x,bottom`) (QEraseRect (left,bottom`, x,bottom) copy);
  316. |    dv_gr_0                = QEraseRect (left,top, right,y)   (QEraseRect (x,y,    right,bottom) copy);
  317.                         = QEraseRect (left,y`,  x`,bottom) (QEraseRect (x`,top, right,bottom) copy);
  318.     where {
  319.         copy    = CopyRectangle` grafPtr rect rect` pict;
  320.         x        = left + dh;        x` = right  + dh;        w = right  - left;
  321.         y        = top  + dv;        y` = bottom + dv;        h = bottom - top;
  322.         rect`    = (x,y, x`,y`);
  323.         bottom`    = Min y` bottom;
  324.         dv_sm_0    = dv < 0;
  325.         dv_gr_0    = dv > 0;
  326.         dh_sm_0    = dh < 0;
  327.         dh_gr_0    = dh > 0;
  328.         dh_eq_0    = dh == 0;
  329.         dv_eq_0    = dv == 0;
  330.     };
  331.  
  332. ClipRect :: !Rect !Rect -> Rect;
  333. ClipRect rect clipRect
  334. |    left    >= rightC
  335. ||    top        >= bottomC
  336. ||    right    <= leftC
  337. ||    bottom    <= topC        = (0,0,0,0);
  338.                         = (    SetBetween left   leftC rightC,
  339.                             SetBetween top    topC  bottomC,
  340.                             SetBetween right  leftC rightC,
  341.                             SetBetween bottom topC  bottomC    );
  342.     where {
  343.         (left, top,  right, bottom ) = rect;
  344.         (leftC,topC, rightC,bottomC) = clipRect;
  345.     };
  346.  
  347.  
  348. CopyRectangleTo :: !Rectangle !Point !Picture -> Picture;
  349. CopyRectangleTo r (x,y) pict
  350. |    IsEmptyRect clip_rect
  351.     =    pict2;
  352.     =    CopyRectangle` grafPtr clip_rect (leftC+dh,topC+dv, rightC+dh,bottomC+dv) pict2;
  353.     where {
  354.         (grafPtr, pict1)            = QGetPort pict;
  355.         dh                            = x - left;
  356.         dv                            = y - top;
  357.         (clipRect,pict2)            = GrafPtrClipRect grafPtr pict1;
  358.         clip_rect                    = ClipRect rect clipRect;
  359.         (leftC,topC, rightC,bottomC)= clip_rect;
  360.         (left, top,  right, bottom)    = rect;
  361.         rect                        = RectangleToRect r;
  362.     };
  363.  
  364. CopyRectangle :: !Rectangle !Vector !Picture -> Picture;
  365. CopyRectangle r (dh,dv) pict
  366. |    IsEmptyRect clip_rect
  367.     =    pict2;
  368.     =    CopyRectangle` grafPtr clip_rect (leftC+dh,topC+dv, rightC+dh,bottomC+dv) pict2;
  369.     where {
  370.         (grafPtr,    pict1)                = QGetPort pict;
  371.         (clipRect,    pict2)                = GrafPtrClipRect grafPtr pict1;
  372.         clip_rect                        = ClipRect (RectangleToRect r) clipRect;
  373.         (leftC,topC, rightC,bottomC)    = clip_rect;
  374.     };
  375.  
  376. CopyRectangle` :: !GrafPtr !Rect !Rect !Picture -> Picture;
  377. CopyRectangle` grafPtr source dest pict
  378.     =    CopyBits baseAddr rowBytes bounds baseAddr rowBytes bounds source dest SrcCopy 0 pict6;
  379.     where {
  380.         bitMap                = grafPtr+GrafPtrportBits;
  381.         (baseAddr,    pict1)    = LoadLong  bitMap        pict;
  382.         (rowBytes,    pict2)    = LoadWord (bitMap+4)    pict1;
  383.         (top,        pict3)    = LoadWord (bitMap+6)    pict2;
  384.         (left,        pict4)    = LoadWord (bitMap+8)    pict3;
  385.         (bottom,    pict5)    = LoadWord (bitMap+10)    pict4;
  386.         (right,        pict6)    = LoadWord (bitMap+12)    pict5;
  387.         bounds                = (left,top, right,bottom);
  388.     };
  389.  
  390. GrafPtrClipRect :: !GrafPtr !Picture -> (!Rect, !Picture);
  391. GrafPtrClipRect grafPtr pict
  392.     =    ((left,top, right,bottom), pict6); 
  393.     where {
  394.         (clip_rgnhandle,pict1)    = LoadLong (grafPtr+GrafPtrclipRgn) pict;
  395.         (clip_rgn,        pict2)    = LoadLong clip_rgnhandle pict1;
  396.         rect                    = 2+clip_rgn;
  397.         (top,            pict3)    = LoadWord rect        pict2;
  398.         (left,            pict4)    = LoadWord (rect+2)    pict3;
  399.         (bottom,        pict5)    = LoadWord (rect+4)    pict4;
  400.         (right,            pict6)    = LoadWord (rect+6)    pict5;
  401.     };
  402.  
  403.  
  404. GrafPtrportBits    :== 2;
  405. GrafPtrclipRgn    :== 28;
  406.     
  407.  
  408. //    Rounded corner rectangles:
  409.  
  410. DrawRoundRectangle :: !RoundRectangle !Picture -> Picture;
  411. DrawRoundRectangle (r, w, h) p = QFrameRoundRect (RectangleToRect r) w h p;
  412.     
  413. FillRoundRectangle :: !RoundRectangle !Picture -> Picture;
  414. FillRoundRectangle (r, w, h) p = QPaintRoundRect (RectangleToRect r) w h p;
  415.     
  416. EraseRoundRectangle :: !RoundRectangle !Picture -> Picture;
  417. EraseRoundRectangle (r, w, h) p = QEraseRoundRect (RectangleToRect r) w h p;
  418.     
  419. InvertRoundRectangle :: !RoundRectangle !Picture -> Picture;
  420. InvertRoundRectangle (r, w, h) p = QInvertRoundRect (RectangleToRect r) w h p;
  421.  
  422.  
  423. //    Ovals:
  424.  
  425. DrawOval :: !Oval !Picture -> Picture;
  426. DrawOval r p = QFrameOval (RectangleToRect r) p;
  427.  
  428. FillOval :: !Oval !Picture -> Picture;
  429. FillOval r p = QPaintOval (RectangleToRect r) p;
  430.  
  431. EraseOval :: !Oval !Picture -> Picture;
  432. EraseOval r p = QEraseOval (RectangleToRect r) p;
  433.  
  434. InvertOval :: !Oval !Picture -> Picture;
  435. InvertOval r p = QInvertOval (RectangleToRect r) p;
  436.  
  437.  
  438. //    Circles:
  439.  
  440. DrawCircle :: !Circle !Picture -> Picture;
  441. DrawCircle ((cx, cy), r) p = QFrameOval (RectangleToRect ((cx-r, cy-r), (cx+r, cy+r))) p;
  442.  
  443. FillCircle :: !Circle !Picture -> Picture;
  444. FillCircle ((cx, cy), r) p = QPaintOval (RectangleToRect ((cx-r, cy-r), (cx+r, cy+r))) p;
  445.  
  446. EraseCircle :: !Circle !Picture -> Picture;
  447. EraseCircle ((cx, cy), r) p = QEraseOval (RectangleToRect ((cx-r, cy-r), (cx+r, cy+r))) p;
  448.  
  449. InvertCircle :: !Circle !Picture -> Picture;
  450. InvertCircle ((cx, cy), r) p = QInvertOval (RectangleToRect ((cx-r, cy-r), (cx+r, cy+r))) p;
  451.  
  452.  
  453. //    Wedges:
  454.  
  455. DrawWedge :: !Wedge !Picture -> Picture;
  456. DrawWedge w p = DrawWedge` w (x,y) p1;
  457.     where {
  458.         (x,y,p1) = QGetPen p;
  459.     };
  460.  
  461. DrawWedge` :: !Wedge !Point !Picture -> Picture;
  462. DrawWedge` (r, s, t) (cx, cy) p
  463.     =    QMoveTo cx cy (
  464.         QLineTo st`_x st`_y (
  465.         QLineTo (px + toInt rx) (py + toInt ry) (
  466.         QMoveTo sr`_x sr`_y (
  467.         QFrameArc rect s` t` p))));
  468.     where {
  469.         s`                = 90 - s;        sr`        = toReal s / 180.0;
  470.         t`                = s  - t;        st`        = toReal t / 180.0;
  471.         cos_sr`            = cos rads;        sin_sr`    = sin rads;
  472.         cos_st`            = cos radt;        sin_st`    = sin radt;
  473.         sr`_x            = px` +  toInt (cos_sr` * rx);
  474.         sr`_y            = py` -  toInt (sin_sr` * ry);
  475.         st`_x            = px` +  toInt (cos_st` * rx);
  476.         st`_y            = py` -  toInt (sin_st` * ry);
  477.         rx                = toReal (qx - px) / 2.0;
  478.         ry                = toReal (qy - py) / 2.0;
  479.         px`                = px + toInt rx;
  480.         py`                = py + toInt ry;
  481.         (px,py, qx,qy)    = rect;
  482.         rect            = RectangleToRect r;
  483.         rads            = sr` * PI;
  484.         radt            = st` * PI;
  485.     };
  486.  
  487. FillWedge :: !Wedge !Picture -> Picture;
  488. FillWedge (r, s, t) p = QPaintArc (RectangleToRect r) (90 - s) (s - t) p;
  489.  
  490. EraseWedge :: !Wedge !Picture -> Picture;
  491. EraseWedge (r, s, t) p = QEraseArc (RectangleToRect r) (90 - s) (s - t) p;
  492.  
  493. InvertWedge :: !Wedge !Picture -> Picture;
  494. InvertWedge (r, s, t) p = QInvertArc (RectangleToRect r) (90 - s) (s - t) p;
  495.     
  496.  
  497. //    Polygons:
  498.  
  499. DrawPolygon :: !Polygon !Picture -> Picture;
  500. DrawPolygon (base=:(x,y), shape) p
  501.     =    p1;
  502.     where {
  503.         (poly_h,p1) = Draw_polygon base base shape 0 (QMoveTo x y p);
  504.     };
  505.  
  506. Draw_polygon :: !Point !Point !PolygonShape !PolyHandle !Picture -> (!PolyHandle, !Picture);
  507. Draw_polygon base position [v=:(dh, dv) : vs] polygon mp
  508.     =     Draw_polygon base (TranslatePoint position v) vs polygon (QLine dh dv mp);
  509. Draw_polygon (x,y) position [] polygon mp =  (polygon, QLineTo x y mp);
  510.  
  511. FillPolygon :: !Polygon !Picture -> Picture;
  512. FillPolygon (pos, shape) p
  513.     =     QKillPoly poly_h (QPaintPoly poly_h p1);
  514.     where {
  515.         (poly_h, p1) = New_poly pos shape p;
  516.     };
  517.  
  518. ErasePolygon :: !Polygon !Picture -> Picture;
  519. ErasePolygon (pos, shape) p
  520.     =    QKillPoly poly_h (QErasePoly poly_h p1);
  521.     where {
  522.         (poly_h, p1) = New_poly pos shape p;
  523.     };
  524.  
  525. InvertPolygon :: !Polygon !Picture -> Picture;
  526. InvertPolygon (pos, shape) p
  527.     =     QKillPoly poly_h (QInvertPoly poly_h p1);
  528.     where {
  529.         (poly_h, p1) = New_poly pos shape p;
  530.     };
  531.  
  532. New_poly :: !Point !PolygonShape !Picture -> (!PolyHandle, !Picture);
  533. New_poly base=:(x,y) shape p
  534.     =    (polygon, QClosePoly polygon p2);
  535.     where {
  536.         (polygon,p2) = Draw_polygon base base shape poly (QMoveTo x y p1);
  537.         (poly,     p1) = QOpenPoly p;
  538.     };
  539.  
  540. ScalePolygon :: !Int !Polygon -> Polygon;
  541. ScalePolygon k (position, shape) = (position, ScaleShape shape k);
  542.         
  543. ScaleShape :: !PolygonShape !Int -> PolygonShape;
  544. ScaleShape [v : vs]    k = [ScaleVector k v : ScaleShape vs k];
  545. ScaleShape vs        k = vs;
  546.     
  547. MovePolygonTo :: !Point !Polygon -> Polygon;
  548. MovePolygonTo p` (p, shape) = (p`, shape);
  549.     
  550. MovePolygon    :: !Vector !Polygon -> Polygon;
  551. MovePolygon v (position, shape) = (TranslatePoint position v, shape);
  552.  
  553. TranslatePoint :: !Point !Vector -> Point;
  554. TranslatePoint (x,y) (v,w) = (x + v, y + w);
  555.  
  556. ScaleVector :: !Int !Vector -> Vector;
  557. ScaleVector k (v,w) = (k*v,k*w);
  558.