diff --git a/contrib/win32/clipboard.factor b/contrib/win32/clipboard.factor index 1104daf330..bd42063cc6 100644 --- a/contrib/win32/clipboard.factor +++ b/contrib/win32/clipboard.factor @@ -1,5 +1,5 @@ -USING: kernel win32 math namespaces io prettyprint errors sequences alien ; -IN: clipboard +USING: kernel win32-api math namespaces io prettyprint errors sequences alien ; +IN: win32 : (enum-clipboard) ( n -- ) EnumClipboardFormats win32-error dup 0 > [ dup , (enum-clipboard) ] when ; diff --git a/contrib/win32/gdi32.factor b/contrib/win32/gdi32.factor index 260a7c9b0a..9f3141f7ed 100644 --- a/contrib/win32/gdi32.factor +++ b/contrib/win32/gdi32.factor @@ -1,7 +1,7 @@ IN: win32 USING: alien kernel errors ; -LIBRARY: gdi +LIBRARY: gdi32 ! Stock Logical Objects : WHITE_BRUSH 0 ; inline diff --git a/contrib/win32/kernel32.factor b/contrib/win32/kernel32.factor index ff844b2cbd..6087025080 100644 --- a/contrib/win32/kernel32.factor +++ b/contrib/win32/kernel32.factor @@ -1,7 +1,7 @@ USING: alien kernel errors ; -IN: win32 +IN: win32-api -LIBRARY: kernel +LIBRARY: kernel32 ! FUNCTION: MAKEINTRESOURCEA ! FUNCTION: MAKEINTRESOURCEW diff --git a/contrib/win32/load.factor b/contrib/win32/load.factor index 68c39f6f0f..2a17c4aa10 100644 --- a/contrib/win32/load.factor +++ b/contrib/win32/load.factor @@ -2,9 +2,9 @@ IN: scratchpad USING: alien compiler kernel parser sequences words ; { - { "gdi" "gdi32" } - { "user" "user32" } - { "kernel" "kernel32" } + { "gdi32" "gdi32" } + { "user32" "user32" } + { "kernel32" "kernel32" } } [ first2 add-simple-library ] each { diff --git a/contrib/win32/opengl32.factor b/contrib/win32/opengl32.factor index 2fd34654ec..6c174ce2f7 100644 --- a/contrib/win32/opengl32.factor +++ b/contrib/win32/opengl32.factor @@ -1,5 +1,5 @@ USING: alien parser namespaces kernel syntax words math io prettyprint ; -IN: win32 +IN: win32-api ! PIXELFORMATDESCRIPTOR flags : PFD_DOUBLEBUFFER HEX: 00000001 ; inline diff --git a/contrib/win32/types.factor b/contrib/win32/types.factor index 2e2fb0d8c6..3512b004a8 100644 --- a/contrib/win32/types.factor +++ b/contrib/win32/types.factor @@ -1,5 +1,5 @@ USING: alien namespaces kernel words ; -IN: win32 +IN: win32-api ! http://msdn.microsoft.com/library/default.asp?url=/library/en-us/winprog/winprog/windows_data_types.asp diff --git a/contrib/win32/ui.factor b/contrib/win32/ui.factor index 01fd5b5087..d63b961d41 100644 --- a/contrib/win32/ui.factor +++ b/contrib/win32/ui.factor @@ -1,6 +1,6 @@ USING: alien arrays errors freetype gadgets gadgets-launchpad gadgets-layouts gadgets-listener hashtables io kernel lists math namespaces prettyprint - sequences strings vectors words windows-messages ; + sequences strings vectors words win32-api-messages win32-api ; USING: inspector threads memory ; IN: win32 @@ -11,6 +11,8 @@ SYMBOL: msg-obj ! hDC = handle to device context, hRC = handle to render context TUPLE: gadget-window world hWnd hDC hRC ; +: class-name "Factor" ; + : get-world ( hWnd -- world ) windows get hash gadget-window-world ; : get-gadget-window ( hWnd -- gadget-window ) windows get hash ; @@ -41,7 +43,12 @@ TUPLE: gadget-window world hWnd hDC hRC ; : handle-wm-size ( hWnd uMsg wParam lParam -- ) [ lo-word ] keep hi-word make-RECT get-RECT-dimensions 0 3array - 2nip swap get-world set-gadget-dim ; + 2nip + dup { 0 0 0 } = [ + 2drop + ] [ + swap get-world set-gadget-dim + ] if ; : wm-keydown-codes ( n -- key ) H{ @@ -212,11 +219,11 @@ SYMBOL: hWnd : init-win32-ui "MSG" msg-obj set - "Factor" ui-wndproc register-wndclassex win32-error=0 + class-name ui-wndproc register-wndclassex win32-error=0 H{ } clone windows set init-ui ; -: cleanup-win32-ui ( -- ) "Factor" f UnregisterClass drop ; +: cleanup-win32-ui ( -- ) class-name f UnregisterClass drop ; : setup-pixel-format ( hdc -- ) 16 make-pfd [ ChoosePixelFormat dup win32-error=0 ] 2keep @@ -234,7 +241,7 @@ SYMBOL: hWnd dup get-rc ; : make-gadget-window ( world title -- ) - "Factor" swap pick rect-dim first2 create-window + class-name swap pick rect-dim first2 create-window dup setup-gl ; IN: gadgets @@ -255,14 +262,14 @@ IN: gadgets get-gadget-window [ gadget-window-hDC SwapBuffers win32-error=0 ] when* ; IN: shells -: ui ( -- ) +: ui [ [ init-win32-ui launchpad-window listener-window event-loop - ] with-freetype + ] with-freetype ] [ cleanup-win32-ui ] cleanup ; : default-shell "ui" ; diff --git a/contrib/win32/user32.factor b/contrib/win32/user32.factor index 8c7eecc23b..a63a0a3623 100644 --- a/contrib/win32/user32.factor +++ b/contrib/win32/user32.factor @@ -1,5 +1,5 @@ USING: alien parser namespaces kernel syntax words math io prettyprint ; -IN: win32 +IN: win32-api TYPEDEF: void* MSGBOXPARAMSA @@ -438,8 +438,53 @@ TYPEDEF: void* MSGBOXPARAMSW : MK_XBUTTON2 HEX: 0040 ; inline +! Some fields are not defined for win64 +! Window field offsets for GetWindowLong() +! TODO: win32 only!! +windows? [ + : GWL_WNDPROC -4 ; + : GWL_HINSTANCE -6 ; + : GWL_HWNDPARENT -8 ; + : GWL_USERDATA -21 ; + : GWL_ID -12 ; +] when -LIBRARY: user +: GWL_STYLE -16 ; +: GWL_EXSTYLE -20 ; + +: GWLP_WNDPROC -4 ; +: GWLP_HINSTANCE -6 ; +: GWLP_HWNDPARENT -8 ; +: GWLP_USERDATA -21 ; +: GWLP_ID -12 ; + +! Class field offsets for GetClassLong() +! TODO: win32 only! +windows? [ + : GCL_MENUNAME -8 ; + : GCL_HBRBACKGROUND -10 ; + : GCL_HCURSOR -12 ; + : GCL_HICON -14 ; + : GCL_HMODULE -16 ; + : GCL_WNDPROC -24 ; + : GCL_HICONSM -34 ; +] when +: GCL_CBWNDEXTRA -18 ; +: GCL_CBCLSEXTRA -20 ; +: GCL_STYLE -26 ; +: GCW_ATOM -32 ; + +: GCLP_MENUNAME -8 ; +: GCLP_HBRBACKGROUND -10 ; +: GCLP_HCURSOR -12 ; +: GCLP_HICON -14 ; +: GCLP_HMODULE -16 ; +: GCLP_WNDPROC -24 ; +: GCLP_HICONSM -34 ; + + + +LIBRARY: user32 FUNCTION: HKL ActivateKeyboardLayout ( HKL hkl, UINT Flags ) ; FUNCTION: BOOL AdjustWindowRect ( LPRECT lpRect, DWORD dwStyle, BOOL bMenu ) ; @@ -734,12 +779,20 @@ FUNCTION: UINT EnumClipboardFormats ( UINT format ) ; ! FUNCTION: GetCapture ! FUNCTION: GetCaretBlinkTime ! FUNCTION: GetCaretPos -! FUNCTION: GetClassInfoA -! FUNCTION: GetClassInfoExA -! FUNCTION: GetClassInfoExW -! FUNCTION: GetClassInfoW -! FUNCTION: GetClassLongA -! FUNCTION: GetClassLongW +FUNCTION: BOOL GetClassInfoA ( HINSTANCE hInst, LPCTSTR lpszClass, LPWNDCLASS lpwcx ) ; +FUNCTION: BOOL GetClassInfoW ( HINSTANCE hInst, LPCWSTR lpszClass, LPWNDCLASS lpwcx ) ; +: GetClassInfo \ GetClassInfoW \ GetClassInfoA unicode-exec ; + +FUNCTION: BOOL GetClassInfoExA ( HINSTANCE hInst, LPCTSTR lpszClass, LPWNDCLASSEX lpwcx ) ; +FUNCTION: BOOL GetClassInfoExW ( HINSTANCE hInst, LPCWSTR lpszClass, LPWNDCLASSEX lpwcx ) ; +: GetClassInfoEx \ GetClassInfoExW \ GetClassInfoExA unicode-exec ; + +FUNCTION: ULONG_PTR GetClassLongA ( HWND hWnd, int nIndex ) ; +FUNCTION: ULONG_PTR GetClassLongW ( HWND hWnd, int nIndex ) ; +: GetClassLong \ GetClassLongW \ GetClassLongA unicode-exec ; +: GetClassLongPtr \ GetClassLongW \ GetClassLongA unicode-exec ; + + ! FUNCTION: GetClassNameA ! FUNCTION: GetClassNameW ! FUNCTION: GetClassWord @@ -1156,8 +1209,12 @@ FUNCTION: int ReleaseDC ( HWND hWnd, HDC hDC ) ; ! FUNCTION: SetCapture ! FUNCTION: SetCaretBlinkTime ! FUNCTION: SetCaretPos -! FUNCTION: SetClassLongA -! FUNCTION: SetClassLongW + +FUNCTION: ULONG_PTR SetClassLongW ( HWND hWnd, int nIndex, LONG_PTR dwNewLong ) ; +FUNCTION: ULONG_PTR SetClassLongA ( HWND hWnd, int nIndex, LONG_PTR dwNewLong ) ; +: SetClassLongPtr \ SetClassLongW \ SetClassLongA unicode-exec ; +: SetClassLong \ SetClassLongW \ SetClassLongA unicode-exec ; + ! FUNCTION: SetClassWord FUNCTION: HANDLE SetClipboardData ( UINT uFormat, HANDLE hMem ) ; ! FUNCTION: SetClipboardViewer diff --git a/contrib/win32/utils.factor b/contrib/win32/utils.factor index 7de6e81d67..bd203c3048 100644 --- a/contrib/win32/utils.factor +++ b/contrib/win32/utils.factor @@ -1,17 +1,14 @@ USING: alien parser namespaces kernel syntax words math io prettyprint ; -IN: win32 +IN: win32-api -: win32-error=0 0 = [ win32-error ] when ; +: win32-error=0 zero? [ win32-error ] when ; : win32-error>0 0 > [ win32-error ] when ; : win32-error<0 0 < [ win32-error ] when ; -: win32-error<>0 0 = [ win32-error ] unless ; +: win32-error<>0 zero? [ win32-error ] unless ; : lo-word ( wparam -- lo ) HEX: ffff bitand ; : hi-word ( wparam -- hi ) -16 shift ; -: hello-world - f "Hello, world!" "First Application" MB_OK MessageBox win32-error drop ; - : msgbox ( str -- ) f swap "DebugMsg" MB_OK MessageBox drop ; diff --git a/contrib/win32/windows-messages.factor b/contrib/win32/windows-messages.factor index 26be45500a..3c1f5ad5e2 100644 --- a/contrib/win32/windows-messages.factor +++ b/contrib/win32/windows-messages.factor @@ -1,5 +1,5 @@ USING: hashtables kernel math namespaces parser prettyprint words ; -IN: windows-messages +IN: win32-api-messages SYMBOL: windows-messages