在 Haskell 中创建窗口的方法有哪些？零级

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

原链接是here

用法：复制/粘贴代码，保存在一个文件中，用ghc --make -optl-mwindows fileName.hs编译，它会创建一个漂亮的小窗口。它是基本的 C/C++，例如 here。

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

我的反问：

• 我理解 C++ 处理得很好。您创建来函数，如果某些 win_msg 为真，winProc 将调用它...
  但是，这不是唯一的方法。很快，MS 就把它放在了 mfc 类中。我们有 EventListeners，它们基本上做同样的事情。您无需直接测试 win_msg，而是创建/addEventListener，传递所需的函数即可。
  但是代码分组更好，更容易维护，更像是面向对象的。

• Haskell 有哪些方法用于 Haskellising winProc？可能有一些方法可以模仿 addEventListener(evt, my_func)。
  那个代码会是什么样子？有多少种不同的解决方案？好用吗？

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

• 您可以通过哪些方式使用该代码，对其进行一些改进并创建类似 wxWidgets 或 gtk 的东西，但极其简化、易于理解等。

Answer 1

这是 createWindow 的第二个版本。 Link

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

Here 排在第三位。注意是日文，需要翻译。 这三个只是我可以在网上找到的 Haskell win32 createWindow 文件！

没有cmets，没有解释，什么都没有:(

%
% (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}