在哈斯克尔中创建窗口的方法是什么?零级

Question

    {- 2012-05-16
    ghc --make -optl-mwindows fileName.hs
option -mwindows is passed to the linker!
attempting to read from stdin with -mwindows may cause a runtime error
any output on stdout/stderr will be lost.
ghc links console app with stdout/stderr as default
-}

--import Graphics.Win32
import Graphics.Win32 hiding (messageBox, c_MessageBox) -- bugfix
import System.Win32.DLL
import Control.Exception (bracket)
import Foreign
import System.Exit


-- bugfix whole msg box
messageBox :: HWND -> String -> String -> MBStyle -> IO MBStatus
messageBox wnd text caption style =
  withTString text $  c_text ->
  withTString caption $  c_caption ->
  failIfZero "MessageBox" $ c_MessageBox wnd c_text c_caption style
foreign import stdcall safe "windows.h MessageBoxW"
  c_MessageBox :: HWND -> LPCTSTR -> LPCTSTR -> MBStyle -> IO MBStatus

main :: IO ()
main = do
    mainInstance <- getModuleHandle Nothing
    hwnd <- createWindow_ 200 200 wndProc mainInstance
    createButton_ hwnd mainInstance
    messagePump hwnd
wndProc :: HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT
wndProc hwnd wmsg wParam lParam
    | wmsg == wM_DESTROY = do
        sendMessage hwnd wM_QUIT 1 0
        return 0
    | wmsg == wM_COMMAND && wParam == 3 = do
        messageBox nullPtr "You pressed me." "Haskell msg" 0
        return 0
    | otherwise = defWindowProc (Just hwnd) wmsg wParam lParam

createWindow_ :: Int -> Int -> WindowClosure -> HINSTANCE -> IO HWND
createWindow_ width height wndProc mainInstance = do
    let winClass = mkClassName "Window Empty"
    icon <- loadIcon Nothing iDI_APPLICATION
    cursor <- loadCursor Nothing iDC_ARROW
    bgBrush <- createSolidBrush (rgb 255 0 0)
    registerClass (cS_VREDRAW + cS_HREDRAW, mainInstance, Just icon, Just cursor, Just bgBrush, Nothing, winClass)
    w <- createWindow winClass "Window Empty" wS_OVERLAPPEDWINDOW Nothing Nothing (Just width) (Just height) Nothing Nothing mainInstance wndProc
    showWindow w sW_SHOWNORMAL
    updateWindow w
    return w

createButton_ :: HWND -> HINSTANCE -> IO ()
createButton_ hwnd mainInstance = do
    hBtn <- createButton "Button test" wS_EX_CLIENTEDGE (bS_PUSHBUTTON + wS_VISIBLE + wS_CHILD) (Just 50) (Just 80) (Just 80) (Just 20) (Just hwnd) (Just (castUINTToPtr 3)) mainInstance
    return ()

messagePump :: HWND -> IO ()
messagePump hwnd = allocaMessage $  msg ->
    let pump = do
        getMessage msg (Just hwnd) `catch`  _ -> exitWith ExitSuccess
        translateMessage msg
        dispatchMessage msg
        pump
    in pump

原始链接在这里

用法：复制/粘贴代码，将其保存在文件中，使用ghc --make -optl-mwindows fileName.hs编译，它将创建漂亮的小窗口。这是基本的C/C++，就像这里一样。

这个和下面的另外两个例子是我能找到的用Haskell编写的原始createWindow代码:(

我的回想问题：

• 我非常理解C++这个过程。你创建来函数，如果某些win_msg是真的，winProc 会调用它......
  但是，这不是唯一的方法。很快，MS就把它放在了mfc类中。我们有 EventListener 来做基本相同的事情。而不是直接测试你创建/添加事件侦听器win_msg，传递所需的函数，它就可以工作了。
  但是代码分组更好，更容易维护，而且更像OO。

• Haskell 为 Haskellising winProc 提供的方法是什么？可能有一些方法可以模仿addEventListener（evt，my_func）。
  该代码会是什么样子？有多少种不同的解决方案？它可用吗？

• 更重要的是，是否有一些我不知道的类似Haskell的（更好的）方式？

• 你可以用什么方式使用该代码，稍微改进一下，创建像wxWidgets或gtk这样的东西，但非常简化，易于理解等。

Answer 1

这是

createWindow的第二个版本。链接

略有不同，但不幸的是没有任何评论，或解释为什么有些事情是这样的。更不用说它已经13岁了！

这是第三。请注意，它是日语，需要翻译。 这三个是我在网上能找到的唯一 Haskell win32 createWindow 文件！

没有评论，没有

解释，没有:(

%
% (c) sof, 1999
%
Haskell version of "Hello, World" using the Win32 library.
Demonstrates how the Win32 library can be put to use.
Works with Hugs and GHC. To compile it up using the latter,
do: "ghc -o main hello.lhs -syslib win32 -fglasgow-exts"
For GHC 5.03:
  ghc -package win32 hello.lhs -o hello.exe -optl "-Wl,--subsystem,windows"
begin{code}
module Main(main) where
import qualified Graphics.Win32
import qualified System.Win32.DLL
import qualified System.Win32.Types
import Control.Exception (bracket)
import Foreign
import System.Exit
{-import Addr-}
end{code}
Toplevel main just creates a window and pumps messages.
The window procedure (wndProc) we pass in is partially
applied with the user action that takes care of responding
to repaint messages (WM_PAINT).
begin{code}
main :: IO ()
main =
  Graphics.Win32.allocaPAINTSTRUCT $  lpps -> do
  hwnd <- createWindow 200 200 (wndProc lpps onPaint)
  messagePump hwnd
{-
 OnPaint handler for a window - draw a string centred
 inside it.
-}
onPaint :: Graphics.Win32.RECT -> Graphics.Win32.HDC -> IO ()
onPaint (_,_,w,h) hdc = do
   Graphics.Win32.setBkMode hdc Graphics.Win32.tRANSPARENT
   Graphics.Win32.setTextColor hdc (Graphics.Win32.rgb 255 255 0)
   let y | h==10     = 0
         | otherwise = ((h-10) `div` 2)
       x | w==50     = 0
         | otherwise = (w-50) `div` 2
   Graphics.Win32.textOut hdc x y "Hello, world"
   return ()
end{code}
Simple window procedure - one way to improve and generalise
it would be to pass it a message map (represented as a
finite map from WindowMessages to actions, perhaps).
begin{code}
wndProc :: Graphics.Win32.LPPAINTSTRUCT
    -> (Graphics.Win32.RECT -> Graphics.Win32.HDC -> IO ()) -- on paint action
        -> Graphics.Win32.HWND
        -> Graphics.Win32.WindowMessage
    -> Graphics.Win32.WPARAM
    -> Graphics.Win32.LPARAM
    -> IO Graphics.Win32.LRESULT
wndProc lpps onPaint hwnd wmsg wParam lParam
 | wmsg == Graphics.Win32.wM_DESTROY = do
     Graphics.Win32.sendMessage hwnd Graphics.Win32.wM_QUIT 1 0
     return 0
 | wmsg == Graphics.Win32.wM_PAINT && hwnd /= nullPtr = do
     r <- Graphics.Win32.getClientRect hwnd
     paintWith lpps hwnd (onPaint r)
     return 0
 | otherwise =
     Graphics.Win32.defWindowProc (Just hwnd) wmsg wParam lParam
createWindow :: Int -> Int -> Graphics.Win32.WindowClosure -> IO Graphics.Win32.HWND
createWindow width height wndProc = do
  let winClass = Graphics.Win32.mkClassName "Hello"
  icon         <- Graphics.Win32.loadIcon   Nothing Graphics.Win32.iDI_APPLICATION
  cursor       <- Graphics.Win32.loadCursor Nothing Graphics.Win32.iDC_ARROW
  bgBrush      <- Graphics.Win32.createSolidBrush (Graphics.Win32.rgb 0 0 255)
  mainInstance <- System.Win32.DLL.getModuleHandle Nothing
  Graphics.Win32.registerClass
      ( Graphics.Win32.cS_VREDRAW + Graphics.Win32.cS_HREDRAW
      , mainInstance
      , Just icon
      , Just cursor
      , Just bgBrush
      , Nothing
      , winClass
      )
  w <- Graphics.Win32.createWindow
         winClass
         "Hello, World example"
         Graphics.Win32.wS_OVERLAPPEDWINDOW
         Nothing Nothing -- leave it to the shell to decide the position
                 -- at where to put the window initially
                 (Just width)
         (Just height)
         Nothing      -- no parent, i.e, root window is the parent.
         Nothing      -- no menu handle
         mainInstance
         wndProc
  Graphics.Win32.showWindow w Graphics.Win32.sW_SHOWNORMAL
  Graphics.Win32.updateWindow w
  return w
messagePump :: Graphics.Win32.HWND -> IO ()
messagePump hwnd = Graphics.Win32.allocaMessage $  msg ->
  let pump = do
        Graphics.Win32.getMessage msg (Just hwnd)
        `catch`  _ -> exitWith ExitSuccess
    Graphics.Win32.translateMessage msg
    Graphics.Win32.dispatchMessage msg
    pump
  in pump
paintWith :: Graphics.Win32.LPPAINTSTRUCT -> Graphics.Win32.HWND -> (Graphics.Win32.HDC -> IO a) -> IO a
paintWith lpps hwnd p =
  bracket
    (Graphics.Win32.beginPaint hwnd lpps)
    (const $ Graphics.Win32.endPaint hwnd lpps)
    p
end{code}