{- 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
Original link is here
Usage: copy/paste code, save it in a file, compile with ghc --make -optl-mwindows fileName.hs and it will create nice little window. It's basic C/C++ like here.
This and two more examples below are ONLY raw createWindow code I could find written in Haskell :(
My rethoric questions:
I understand that C++ process quite well. You create come functions, winProc will call it if some win_msg is true...
But, it's not the only way. Soon enough MS put that in mfc classes. And we have EventListeners that do basically the same thing. Instead of directly testing win_msg you create/addEventListener, pass desired function and it works.
But grouping of code is nicer and easier for maintenance and it's more OO like.What are Haskell's ways for Haskellising winProc? There probably are ways to mimic addEventListener(evt, my_func).
How would that code look like? How many different solutions are there? Is it usable?And more important, is there some Haskell like (better) way that I an not aware of?
- In what ways you can use that code, improve it a bit and create something like wxWidgets or gtk, but extremely simplified, easy to understand, etc.
