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 ++过程相当不错。你创建了come函数，如果某些win_msg为真，winProc会调用它...
但是，这不是唯一的方法。很快，MS就把它放在了mfc课程中。我们有EventListeners基本上做同样的事情。而不是直接测试win_msg你创建/ addEventListener，传递所需的功能，它的工作原理但是代码分组更好，更易于维护，而且更像OO。
Haskell的Haskellising winProc是什么方式？可能有办法模仿addEventListener（evt，my_func）那段代码怎么样？有多少种不同的解决方案？可以使用吗？
更重要的是，有一些Haskell喜欢（更好）的方式，我不知道吗？
您可以在哪些方面使用该代码，稍微改进一下并创建类似wxWidgets或gtk的内容，但非常简单，易于理解等。

Answer 1

这是createWindow的第二个版本。 Link

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

Here排名第三。请注意日语，需要翻译。这三个只有我能在网上找到的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}

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

1 个答案: