以下似乎有效...但看起来很笨拙。
data Point = Point Int Int
data Box = Box Int Int
data Path = Path [Point]
data Text = Text
data Color = Color Int Int Int
data WinPaintContext = WinPaintContext Graphics.Win32.HDC
class CanvasClass vc paint where
drawLine :: vc -> paint -> Point -> Point -> IO ()
drawRect :: vc -> paint -> Box -> IO ()
drawPath :: vc -> paint -> Path -> IO ()
class (CanvasClass vc paint) => TextBasicClass vc paint where
basicDrawText :: vc -> paint -> Point -> String -> IO ()
instance CanvasClass WinPaintContext WinPaint where
drawLine = undefined
drawRect = undefined
drawPath = undefined
instance TextBasicClass WinPaintContext WinPaint where
basicDrawText (WinPaintContext a) = winBasicDrawText a
op :: CanvasClass vc paint => vc -> Box -> IO ()
op canvas _ = do
basicDrawText canvas WinPaint (Point 30 30) "Hi"
open :: IO ()
open = do
makeWindow (Box 300 300) op
winBasicDrawText :: Graphics.Win32.HDC -> WinPaint -> Point -> String -> IO ()
winBasicDrawText hdc _ (Point x y) str = do
Graphics.Win32.setBkMode hdc Graphics.Win32.tRANSPARENT
Graphics.Win32.setTextColor hdc (Graphics.Win32.rgb 255 255 0)
Graphics.Win32.textOut hdc 20 20 str
return ()
windowsOnPaint :: (WinPaintContext -> Box -> IO ()) ->
Graphics.Win32.RECT ->
Graphics.Win32.HDC ->
IO ()
windowsOnPaint f rect hdc = f (WinPaintContext hdc) (Box 30 30)
makeWindow :: Box -> (WinPaintContext -> Box -> IO ()) -> IO ()
makeWindow (Box w h) onPaint =
Graphics.Win32.allocaPAINTSTRUCT $ \ lpps -> do
hwnd <- createWindow w h (wndProc lpps (windowsOnPaint onPaint))
messagePump hwnd
现在,似乎首选的方法就是简单地拥有
data Canvas = Canvas {
drawLine :: Point -> Point -> IO (),
drawRect :: Box -> IO (),
drawPath :: Path -> IO ()
}
hdc2Canvas :: Graphics.Win32.HDC -> Paint -> IO ( Canvas )
hdc2Canvas hdc paint = Canvas { drawLine = winDrawLine hdc paint ... }
...无论其
我们喜欢在整个绘图过程中保持颜色并改变它们,因为它们的制作和销毁成本很高。一个油漆可能只是一个像[bgColor red,fgColor blue,font“Tahoma”]之类的东西,或者它可能是一个指向绘图系统使用的内部结构的指针(这是对Windows GDI的抽象,但最终会抽象over direct2d和coregraphics),它有“绘制”对象,我不想一遍又一遍地重新创建然后绑定。
我心中的存在之美在于它们可以不透明地包裹着一些东西来抽象它,我们可以将它保存在某处,拉回来,无论如何。当您部分申请时,我认为存在的问题是,您已部分应用的东西现在“卡在”容器内部。这是一个例子。假设我有一个像
这样的绘画对象data Paint = Paint {
setFg :: Color -> IO () ,
setBg :: Color -> IO ()
}
我可以在哪里放指针?当我将Paint赋予Canvas中的某些功能时,他如何获得指针?设计此API的正确方法是什么?
答案 0 :(得分:9)
界面
首先,您需要问“我的要求是什么?”。让我们用简单的英语说明我们想要画布做什么(这些是我根据你的问题猜测的):
现在我们将这些想法转化为Haskell。 Haskell是一种“类型优先”的语言,所以当我们讨论需求和设计时,我们可能正在谈论类型。
show
类说“某些类型可以表示为字符串”。现在我们可以为每个要求编写类:
class ShapeCanvas c where -- c is the type of the Canvas
draw :: Shape -> c -> c
class TextCanvas c where
write :: Text -> c -> c
class PaintCanvas p c where -- p is the type of Paint
load :: p -> c -> c
类型变量c
仅使用一次,显示为c -> c
。这表明我们可以通过将c -> c
替换为c
来使这些更加通用。
class ShapeCanvas c where -- c is the type of the canvas
draw :: Shape -> c
class TextCanvas c where
write :: Text -> c
class PaintCanvas p c where -- p is the type of paint
load :: p -> c
现在PaintCanvas
看起来像是class
,在Haskell中存在问题。类型系统很难弄清楚像
class Implicitly a b where
convert :: b -> a
我会通过更改PaintCanvas
来利用TypeFamilies
扩展来缓解此问题。
class PaintCanvas c where
type Paint c :: * -- (Paint c) is the type of Paint for canvases of type c
load :: (Paint c) -> c
现在,让我们为我们的界面整理所有内容,包括形状和文本的数据类型(修改后对我有意义):
{-# LANGUAGE TypeFamilies #-}
module Data.Canvas (
Point(..),
Shape(..),
Text(..),
ShapeCanvas(..),
TextCanvas(..),
PaintCanvas(..)
) where
data Point = Point Int Int
data Shape = Dot Point
| Box Point Point
| Path [Point]
data Text = Text Point String
class ShapeCanvas c where -- c is the type of the Canvas
draw :: Shape -> c
class TextCanvas c where
write :: Text -> c
class PaintCanvas c where
type Paint c :: * -- (Paint c) is the type of Paint for canvases of type c
load :: (Paint c) -> c
一些例子
本节将介绍除了我们已经制定的有用画布之外的其他要求。它与我们在画布类中用c -> c
替换c
时丢失的内容相似。
让我们从您的第一个示例代码op
开始。使用我们的新界面,它只是:
op :: (TextCanvas c) => c
op = write $ Text (Point 30 30) "Hi"
让我们做一个稍微复杂的例子。绘制“X”的东西怎么样?我们可以制作“X”的第一个笔画
ex :: (ShapeCanvas c) => c
ex = draw $ Path [Point 10 10, Point 20 20]
但我们无法为横笔画添加另一个Path
。我们需要一些方法将两个绘图步骤放在一起。类型c -> c -> c
的东西是完美的。我能想到的最简单的Haskell类就是Monoid a
的{{1}}。 mappend :: a -> a -> a
需要身份和关联性。假设画布上的绘画操作不受影响,这是否合理?这听起来很合理。假设以相同的顺序完成的三个绘制操作即使前两个一起执行,然后是第三个,或者如果执行第一个,然后第二个和第三个一起执行,那么是否合理?再说一遍,这对我来说似乎很合理。这表明我们可以将Monoid
写为:
ex
最后,让我们考虑一些互动的东西,根据外部的东西决定要绘制什么:
ex :: (Monoid c, ShapeCanvas c) => c
ex = (draw $ Path [Point 10 10, Point 20 20]) `mappend` (draw $ Path [Point 10 20, Point 20 10])
这不太有用,因为我们没有randomDrawing :: (MonadIO m, ShapeCanvas (m ()), TextCanvas (m ())) => m ()
randomDrawing = do
index <- liftIO . getStdRandom $ randomR (0,2)
choices !! index
where choices = [op, ex, return ()]
的实例,因此(Monad m) => Monoid (m ())
可以正常工作。我们可以使用reducers包中的ex
,或者自己添加一个,但这会使我们处于不连贯的实例中。将ex改为:
Data.Semigroup.Monad
但类型系统无法确定第一个ex :: (Monad m, ShapeCanvas (m ())) => m ()
ex = do
draw $ Path [Point 10 10, Point 20 20]
draw $ Path [Point 10 20, Point 20 10]
中的单位与第二个中的单位相同。我们在这里的困难提出了额外的要求,我们最初无法完全理解:
直接从http://www.haskellforall.com/2013/06/from-zero-to-cooperative-threads-in-33.html:
窃取现在我们意识到我们的canvas实现很可能是monad转换器。我们可以回到我们的界面,并更改它,以便每个类都是monad的类,类似于变换器'draw
类和mtl的monad类。
界面,重新访问
MonadIO
示例,重新访问
现在我们所有的示例绘图操作都是某些未知{-# LANGUAGE TypeFamilies #-}
module Data.Canvas (
Point(..),
Shape(..),
Text(..),
ShapeCanvas(..),
TextCanvas(..),
PaintCanvas(..)
) where
data Point = Point Int Int
data Shape = Dot Point
| Box Point Point
| Path [Point]
data Text = Text Point String
class Monad m => ShapeCanvas m where -- c is the type of the Canvas
draw :: Shape -> m ()
class Monad m => TextCanvas m where
write :: Text -> m ()
class Monad m => PaintCanvas m where
type Paint m :: * -- (Paint c) is the type of Paint for canvases of type c
load :: (Paint m) -> m ()
m:
Monad
我们也可以用油漆做一个例子。由于我们不知道哪些涂料将存在,因此它们都必须在外部提供(作为示例的参数):
op :: (TextCanvas m) => m ()
op = write $ Text (Point 30 30) "Hi"
ex :: (ShapeCanvas m) => m ()
ex = do
draw $ Path [Point 10 10, Point 20 20]
draw $ Path [Point 10 20, Point 20 10]
randomDrawing :: (MonadIO m, ShapeCanvas m, TextCanvas m) => m ()
randomDrawing = do
index <- liftIO . getStdRandom $ randomR (0,2)
choices !! index
where choices = [op, ex, return ()]
实施
如果您可以使用各种绘图来使代码工作以绘制点,框,线和文本而不引入抽象,我们可以更改它以实现第一部分中的界面。