steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

win32 changes

darcs
erg 2006-02-23 01:53:01 +00:00
parent b6d7eb8923
commit c2e07dd5ae
4 changed files with 56 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
contrib/win32/examples.factor
View File

@ -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
<WNDCLASSEX>
: 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" <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
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

3
contrib/win32/load.factor
View File

@ -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

7
contrib/win32/types.factor
View File

@ -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

28
contrib/win32/user32.factor
View File

@ -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