win32 changes

contrib/win32/examples.factor

@@ -1,5 +1,6 @@
 IN: win32
-USING: alien namespaces math io prettyprint kernel ;
+USING: alien namespaces math io prettyprint kernel words ;
+USING: inspector ;
 
 SYMBOL: hInst
 SYMBOL: wc
@@ -12,23 +13,38 @@ SYMBOL: className "SimpleWindowClass" className set
 ! : message-loop ( -- )
     ! message-loop ;
 
-: app2
+: wndproc ( hwnd uMsg wParam lParam -- lresult )
-    f GetModuleHandle hInst set
+    "uint" { "void*" "uint" "long" "long" } [
-    <WNDCLASSEX>
+        pick WM_DESTROY = [
+            3drop drop
+            f PostQuitMessage 0
+        ] [
+            DefWindowProc
+        ] if 
+     ] alien-callback ;
+
+: register-wndclassex ( name wndproc -- )
+    "WNDCLASSEX" <c-object>
     "WNDCLASSEX" c-size over set-WNDCLASSEX-cbSize
     CS_HREDRAW CS_VREDRAW bitor over set-WNDCLASSEX-style
-    ! [ event-loop ] over set-WNDCLASSEX-lpfnWndProc
+    >r execute r> [ set-WNDCLASSEX-lpfnWndProc ] keep
     0 over set-WNDCLASSEX-cbClsExtra
     0 over set-WNDCLASSEX-cbWndExtra
     hInst get over set-WNDCLASSEX-hInstance
-    COLOR_WINDOW 1 + over set-WNDCLASSEX-hbrBackground
+    ! COLOR_WINDOW 1+ GetSysColorBrush over set-WNDCLASSEX-hbrBackground
-    f over set-WNDCLASSEX-lpszMenuName
+    ! "" over set-WNDCLASSEX-lpszMenuName
-    className get over set-WNDCLASSEX-lpszClassName
+    ! [ set-WNDCLASSEX-lpszClassName ] keep
-    ! ! f IDI_APPLICATION LoadIcon over [ set-WNDCLASSEX-hIcon ] keep set-WNDCLASSEX-hIconSm
+    f IDI_APPLICATION LoadIcon over [ set-WNDCLASSEX-hIcon ] 2keep
-    ! f IDC_ARROW LoadCursor over set-WNDCLASSEX-hCursor
+        set-WNDCLASSEX-hIconSm
+    f IDC_ARROW LoadCursor over set-WNDCLASSEX-hCursor
     ! RegisterClassEx
+    ;
 
-    ! 0 className get "Second Application" WS_OVERLAPPEDWINDOW CW_USEDEFAULT CW_USEDEFAULT CW_USEDEFAULT CW_USEDEFAULT f f hInst get f ! CreateWindowEx
+: app2
+    f GetModuleHandle hInst set
+    "App2" \ wndproc register-wndclassex
+
+    ! 0 className get "Second Application" WS_OVERLAPPEDWINDOW CW_USEDEFAULT CW_USEDEFAULT CW_USEDEFAULT CW_USEDEFAULT f f hInst get f CreateWindowEx
     
     ! dup SW_SHOWDEFAULT ShowWindow
     ! dup UpdateWindow

contrib/win32/load.factor

@@ -2,6 +2,7 @@ IN: scratchpad
 USING: alien compiler kernel parser sequences words ;
 
 {
+    { "gdi" "gdi32" }
     { "user" "user32" }
     { "kernel" "kernel32" }
 } [ first2 add-simple-library ] each
@@ -9,6 +10,8 @@ USING: alien compiler kernel parser sequences words ;
 { 
     "utils"
     "types"
+    "gdi32"
     "kernel32"
     "user32"
+    "examples"
 } [ "/contrib/win32/" swap ".factor" append3 run-resource ] each

contrib/win32/types.factor

@@ -273,8 +273,11 @@ BEGIN-STRUCT: WNDCLASSEX
     FIELD: int cbClsExtra
     FIELD: int cbWndExtra
     FIELD: HINSTANCE hInstance
-    FIELD: HICON hIcon
+    ! FIELD: HICON hIcon
-    FIELD: HCURSOR hCursor
+    FIELD: ushort* hIcon
+    ! FIELD: HCURSOR hCursor
+    FIELD: ushort* hCursor
+    ! FIELD: HBRUSH hbrBackground
     FIELD: HBRUSH hbrBackground
     FIELD: LPCTSTR lpszMenuName
     FIELD: LPCTSTR lpszClassName

contrib/win32/user32.factor

@@ -185,6 +185,13 @@ TYPEDEF: void* MSGBOXPARAMSW
 : CF_GDIOBJLAST HEX: 3FF ; inline
 
 
+: WM_NULL                         0 ; inline
+: WM_CREATE                       1 ; inline
+: WM_DESTROY                      2 ; inline
+: WM_MOVE                         3 ; inline
+: WM_SIZE                         5 ; inline
+: WM_ACTIVATE                     6 ; inline
+
 
 
 
@@ -374,8 +381,9 @@ FUNCTION: HWND CreateWindowExW (
 ! FUNCTION: DefMDIChildProcA
 ! FUNCTION: DefMDIChildProcW
 ! FUNCTION: DefRawInputProc
-! FUNCTION: DefWindowProcA
+FUNCTION: LRESULT DefWindowProcA ( HWND hWnd, UINT Msg, WPARAM wParam, LPARAM lParam ) ;
-! FUNCTION: DefWindowProcW
+FUNCTION: LRESULT DefWindowProcW ( HWND hWnd, UINT Msg, WPARAM wParam, LPARAM lParam ) ;
+: DefWindowProc \ DefWindowProcW \ DefWindowProcA unicode-exec ;
 ! FUNCTION: DeleteMenu
 ! FUNCTION: DeregisterShellHookWindow
 ! FUNCTION: DestroyAcceleratorTable
@@ -586,7 +594,7 @@ FUNCTION: int GetPriorityClipboardFormat ( UINT* paFormatPriorityList, int cForm
 ! FUNCTION: GetShellWindow
 ! FUNCTION: GetSubMenu
 ! FUNCTION: GetSysColor
-! FUNCTION: GetSysColorBrush
+FUNCTION: HBRUSH GetSysColorBrush ( int nIndex ) ;
 ! FUNCTION: GetSystemMenu
 ! FUNCTION: GetSystemMetrics
 ! FUNCTION: GetTabbedTextExtentA
@@ -687,12 +695,16 @@ FUNCTION: BOOL IsZoomed ( HWND hWnd ) ;
 ! FUNCTION: LoadCursorFromFileW
 
 
-FUNCTION: HCURSOR LoadCursorA ( HINSTANCE hInstance, LPCTSTR lpCursorName ) ;
+! FUNCTION: HCURSOR LoadCursorA ( HINSTANCE hInstance, LPCTSTR lpCursorName ) ;
-FUNCTION: HCURSOR LoadCursorW ( HINSTANCE hInstance, LPCWSTR lpCursorName ) ;
+! FUNCTION: HCURSOR LoadCursorW ( HINSTANCE hInstance, LPCWSTR lpCursorName ) ;
+FUNCTION: HCURSOR LoadCursorA ( HINSTANCE hInstance, ushort lpCursorName ) ;
+FUNCTION: HCURSOR LoadCursorW ( HINSTANCE hInstance, ushort lpCursorName ) ;
 : LoadCursor \ LoadCursorW \ LoadCursorA unicode-exec ;
 
-FUNCTION: HICON LoadIconA ( HINSTANCE hInstance, LPCTSTR lpIconName ) ;
+! FUNCTION: HICON LoadIconA ( HINSTANCE hInstance, LPCTSTR lpIconName ) ;
-FUNCTION: HICON LoadIconW ( HINSTANCE hInstance, LPCTSTR lpIconName ) ;
+! FUNCTION: HICON LoadIconW ( HINSTANCE hInstance, LPCWSTR lpIconName ) ;
+FUNCTION: HICON LoadIconA ( HINSTANCE hInstance, ushort lpIconName ) ;
+FUNCTION: HICON LoadIconW ( HINSTANCE hInstance, ushort lpIconName ) ;
 : LoadIcon \ LoadIconW \ LoadIconA unicode-exec ;
 
 ! FUNCTION: LoadImageA
@@ -821,7 +833,7 @@ FUNCTION: BOOL OpenClipboard ( HWND hWndNewOwner ) ;
 ! FUNCTION: PeekMessageW
 ! FUNCTION: PostMessageA
 ! FUNCTION: PostMessageW
-! FUNCTION: PostQuitMessage
+FUNCTION: void PostQuitMessage ( int nExitCode ) ;
 ! FUNCTION: PostThreadMessageA
 ! FUNCTION: PostThreadMessageW
 ! FUNCTION: PrintWindow