在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。

這和下面兩個例子是僅有的原始 CreateWindow的代碼，我能找到的寫在Haskell :(

我rethoric問題：

• 據我所知，C++程序很好創建。來到功能，Winproc傳會調用它，如果一些win_msg是真的...
  但是，它不是唯一的方式。很快足夠MS提出，在MFC類。而且我們有做的基本上是一回事事件偵聽器，而是直接測試win_msg的你創建/ addEven tListener，通過所需的功能，它的工作原理。
  但是，代碼分組更好，更容易維護，它更像OO。

• 什麼是Haskell的Haskellising winProc的方法？有可能有模仿addEventListener（evt，my_func）的方法。
  該代碼的外觀如何？有多少種不同的解決方案？它可用嗎？

• 而更重要的，是有一些像哈斯克爾（更好的）辦法，我一個不知道呢？

• 以何種方式，你可以使用這些代碼，改進了一下，創建類似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}