From c2e07dd5aeca60e53ed8bd484e325ff0ee3240bf Mon Sep 17 00:00:00 2001 From: erg Date: Thu, 23 Feb 2006 01:53:01 +0000 Subject: [PATCH] win32 changes --- contrib/win32/examples.factor | 40 ++++++++++++++++++++++++----------- contrib/win32/load.factor | 3 +++ contrib/win32/types.factor | 7 ++++-- contrib/win32/user32.factor | 28 +++++++++++++++++------- 4 files changed, 56 insertions(+), 22 deletions(-) diff --git a/contrib/win32/examples.factor b/contrib/win32/examples.factor index 1f748b6db2..e0b0c05a25 100644 --- a/contrib/win32/examples.factor +++ b/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 - f GetModuleHandle hInst set - +: wndproc ( hwnd uMsg wParam lParam -- lresult ) + "uint" { "void*" "uint" "long" "long" } [ + pick WM_DESTROY = [ + 3drop drop + f PostQuitMessage 0 + ] [ + DefWindowProc + ] if + ] alien-callback ; + +: register-wndclassex ( name wndproc -- ) + "WNDCLASSEX" "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 - f over set-WNDCLASSEX-lpszMenuName - className get over set-WNDCLASSEX-lpszClassName - ! ! f IDI_APPLICATION LoadIcon over [ set-WNDCLASSEX-hIcon ] keep set-WNDCLASSEX-hIconSm - ! f IDC_ARROW LoadCursor over set-WNDCLASSEX-hCursor + ! COLOR_WINDOW 1+ GetSysColorBrush over set-WNDCLASSEX-hbrBackground + ! "" over set-WNDCLASSEX-lpszMenuName + ! [ set-WNDCLASSEX-lpszClassName ] keep + f IDI_APPLICATION LoadIcon over [ set-WNDCLASSEX-hIcon ] 2keep + 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 diff --git a/contrib/win32/load.factor b/contrib/win32/load.factor index 3a039062a3..e1d6942b12 100644 --- a/contrib/win32/load.factor +++ b/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 diff --git a/contrib/win32/types.factor b/contrib/win32/types.factor index 502dfe4cc9..818a0bb458 100644 --- a/contrib/win32/types.factor +++ b/contrib/win32/types.factor @@ -273,8 +273,11 @@ BEGIN-STRUCT: WNDCLASSEX FIELD: int cbClsExtra FIELD: int cbWndExtra FIELD: HINSTANCE hInstance - FIELD: HICON hIcon - FIELD: HCURSOR hCursor + ! FIELD: HICON hIcon + FIELD: ushort* hIcon + ! FIELD: HCURSOR hCursor + FIELD: ushort* hCursor + ! FIELD: HBRUSH hbrBackground FIELD: HBRUSH hbrBackground FIELD: LPCTSTR lpszMenuName FIELD: LPCTSTR lpszClassName diff --git a/contrib/win32/user32.factor b/contrib/win32/user32.factor index 8a6dd8b1d9..2588822145 100644 --- a/contrib/win32/user32.factor +++ b/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: DefWindowProcW +FUNCTION: LRESULT DefWindowProcA ( HWND hWnd, UINT Msg, WPARAM wParam, LPARAM lParam ) ; +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 LoadCursorW ( HINSTANCE hInstance, LPCWSTR lpCursorName ) ; +! FUNCTION: HCURSOR LoadCursorA ( HINSTANCE hInstance, LPCTSTR 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 LoadIconW ( HINSTANCE hInstance, LPCTSTR lpIconName ) ; +! FUNCTION: HICON LoadIconA ( 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