files/practicum/Figure.icl

   1 implementation module Figure
   2
   3 /** Example library to demonstrate the use of Existential Types.
   4     The library implements a simple set of drawing objects.
   5
   6     Author:  Peter Achten
   7     Version: April 14 2008
   8 */
   9 import StdEnv, StdIO
  10
  11 ::  Figure                                      = E.s:
  12                                               { data :: s
  13                                               , impl :: FigureI s
  14                                               }
  15 ::  FigureI s                           = { show :: s -> *Picture -> *Picture
  16                                               , move :: Vector2 s -> s
  17                                               }
  18
  19 //  drawFigure f creates a window in which f is displayed
  20 drawFigure                                      :: Figure -> *World -> *World
  21 drawFigure figure               = startIO SDI Void initGUI [ProcessClose closeProcess]
  22 where
  23     initGUI                                     :: (PSt .ps) -> PSt .ps
  24     initGUI pSt
  25         # (niceFont,pSt)        = accPIO (accScreenPicture (openFont {SerifFontDef & fSize=36} `bind` \(_,f) -> return f)) pSt
  26         # wDef                  = Window "Figure" NilLS
  27                                     [ WindowClose    (noLS closeProcess)
  28                                     , WindowLook     True (look figure)
  29                                     , WindowPen      [PenFont niceFont]
  30                                     , WindowViewSize maxFixedWindowSize
  31                                     ]
  32         = snd (openWindow undef wDef pSt)
  33     where
  34         look                            :: Figure SelectState UpdateState -> *Picture -> *Picture
  35         look figure _ updSt     = show figure o unfill updSt.newFrame
  36
  37 //  Lifting methods to functions:
  38 show                                            :: Figure *Picture -> *Picture
  39 show {data,impl} picture        = impl.show data picture
  40
  41 move                                            :: Vector2 Figure -> Figure
  42 move v fig=:{data,impl}         = {fig & data=impl.move v data}
  43
  44 //  General Figure constructor function:
  45 mkFigure                                        :: s (FigureI s) -> Figure
  46 mkFigure data impl                      = { data=data, impl=impl }
  47
  48 //  Specialized Figure constructor functions:
  49 //  mkFigures figs combines all figs in left-to-right order
  50 mkFigures                                       :: [Figure] -> Figure
  51 mkFigures figs                          = mkFigure figs
  52                                                    { show = flip (foldl (flip show))
  53                                                    , move = \vector -> map (move vector)
  54                                                    }
  55
  56 //  line a b draws a line from a to b
  57 line                                            :: Point2 Point2 -> Figure
  58 line a b                                        = mkFigure (a,b)
  59                                                            { show = \(a,b) = drawLine a b
  60                                                            , move = \v (a,b) = (movePoint v a,movePoint v b)
  61                                                            }
  62
  63 //  rectangle a b forms a rectangle with diagonal-points a and b
  64 rectangle                                       :: Point2 Point2 -> Figure
  65 rectangle a b                           = mkFigure {corner1=a,corner2=b}
  66                                                        { show = \r   = draw r
  67                                                        , move = \v r = {corner1=movePoint v r.corner1,corner2=movePoint v r.corner2}
  68                                                        }
  69
  70 //  ellips a b forms an ellips that fits in the rectangle with diagonal-points a and b
  71 ellips                                          :: Point2 Point2 -> Figure
  72 ellips a b                                      = mkFigure {corner1=a,corner2=b}
  73                                                        { show = \r   = let (pos,oval) = toOval r in drawAt pos oval
  74                                                        , move = \v r = {corner1=movePoint v r.corner1,corner2=movePoint v r.corner2}
  75                                                        }
  76 where
  77     toOval                                      :: Rectangle -> (Point2,Oval)
  78     toOval {corner1,corner2}= ({x=cx,y=cy},{oval_rx=abs rx,oval_ry=abs ry})
  79     where
  80         (rx,ry)                         = ((corner2.x-corner1.x)/2,(corner2.y-corner1.y)/2)
  81         (cx,cy)                         = (corner1.x+rx,corner1.y+ry)
  82
  83 //  text t a shows a text t with left-top corner at a
  84 text                                            :: String Point2 -> Figure
  85 text line pos                           = mkFigure (pos,line)
  86                                                        { show = \(pos,line) = getPenFontMetrics `bind` \fMetrics ->
  87                                                                               drawAt {pos & y=pos.y+fMetrics.fAscent+fMetrics.fLeading} line
  88                                                        , move = \v (pos,line) = (movePoint v pos,line)
  89                                                        }