{- 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++です。
これと以下の 2 つの例は、Haskell で書かれた生のcreateWindow コードのみです :(
私の修辞的な質問:
C++ のプロセスがよくわかります。come 関数を作成すると、win_msg が true の場合、winProc がそれを呼び出します...
しかし、それが唯一の方法ではありません。すぐに、MS はそれを mfc クラスに入れました。そして、基本的に同じことを行う EventListeners があります。win_msg を直接テストする代わりに、EventListener を作成/追加し、目的の関数を渡すと機能します。
しかし、コードのグループ化は、メンテナンスがより適切で簡単になり、オブジェクト指向に似ています。Haskellising winProcのためのHaskellの方法は何ですか? おそらく、addEventListener(evt, my_func) を模倣する方法があります。
そのコードはどのように見えるでしょうか？いくつの異なるソリューションがありますか? 使用可能ですか？さらに重要なことに、私が気付いていない Haskell のような (より良い) 方法はありますか?
- そのコードをどのように使用できるか、少し改善して、wxWidgets や gtk のようなものを作成できますが、非常に単純化され、理解しやすいなど.