struct-arrays ui.backend.windows vectors windows.com
windows.dinput windows.dinput.constants windows.errors
windows.kernel32 windows.messages windows.ole32
-windows.user32 ;
+windows.user32 classes.struct ;
IN: game-input.dinput
CONSTANT: MOUSE-BUFFER-SIZE 16
[ remove-controller ] each ;
: device-interface? ( dbt-broadcast-hdr -- ? )
- DEV_BROADCAST_HDR-dbch_devicetype DBT_DEVTYP_DEVICEINTERFACE = ;
+ dbch_devicetype>> DBT_DEVTYP_DEVICEINTERFACE = ;
: device-arrived ( dbt-broadcast-hdr -- )
device-interface? [ find-controllers ] when ;
{ 0 0 } >>dim ;
: (device-notification-filter) ( -- DEV_BROADCAST_DEVICEW )
- "DEV_BROADCAST_DEVICEW" <c-object>
- "DEV_BROADCAST_DEVICEW" heap-size over set-DEV_BROADCAST_DEVICEW-dbcc_size
- DBT_DEVTYP_DEVICEINTERFACE over set-DEV_BROADCAST_DEVICEW-dbcc_devicetype ;
+ DEV_BROADCAST_DEVICEW <struct>
+ DEV_BROADCAST_DEVICEW heap-size >>dbcc_size
+ DBT_DEVTYP_DEVICEINTERFACE >>dbcc_devicetype ;
: create-device-change-window ( -- )
<zero-window-rect> WS_OVERLAPPEDWINDOW 0 create-window
delete-dinput ;
M: dinput-game-input-backend (reset-game-input)
- {
- +dinput+ +keyboard-device+ +keyboard-state+
- +controller-devices+ +controller-guids+
- +device-change-window+ +device-change-handle+
- } [ f swap set-global ] each ;
+ global [
+ {
+ +dinput+ +keyboard-device+ +keyboard-state+
+ +controller-devices+ +controller-guids+
+ +device-change-window+ +device-change-handle+
+ } [ off ] each
+ ] bind ;
M: dinput-game-input-backend get-controllers
+controller-devices+ get
window-controls>> window-control>ex-style symbols>flags ;
: get-RECT-top-left ( RECT -- x y )
- [ RECT-left ] keep RECT-top ;
+ [ left>> ] [ top>> ] bi ;
+
+: get-RECT-width/height ( RECT -- width height )
+ [ [ right>> ] [ left>> ] bi - ]
+ [ [ bottom>> ] [ top>> ] bi - ] bi ;
: get-RECT-dimensions ( RECT -- x y width height )
- [ get-RECT-top-left ] keep
- [ RECT-right ] keep [ RECT-left - ] keep
- [ RECT-bottom ] keep RECT-top - ;
+ [ get-RECT-top-left ] [ get-RECT-width/height ] bi ;
: handle-wm-paint ( hWnd uMsg wParam lParam -- )
#! wParam and lParam are unused
] if ;
: make-TRACKMOUSEEVENT ( hWnd -- alien )
- "TRACKMOUSEEVENT" <c-object> [ set-TRACKMOUSEEVENT-hwndTrack ] keep
- "TRACKMOUSEEVENT" heap-size over set-TRACKMOUSEEVENT-cbSize ;
+ TRACKMOUSEEVENT <struct>
+ swap >>hwndTrack
+ TRACKMOUSEEVENT heap-size >>cbSize ;
: handle-wm-mousemove ( hWnd uMsg wParam lParam -- )
2nip
over make-TRACKMOUSEEVENT
- TME_LEAVE over set-TRACKMOUSEEVENT-dwFlags
- 0 over set-TRACKMOUSEEVENT-dwHoverTime
+ TME_LEAVE >>dwFlags
+ 0 >>dwHoverTime
TrackMouseEvent drop
>lo-hi swap window move-hand fire-motion ;
] if ;
:: register-window-class ( class-name-ptr -- )
- "WNDCLASSEX" <c-object> f GetModuleHandle
+ WNDCLASSEX <struct> f GetModuleHandle
class-name-ptr pick GetClassInfoEx 0 = [
- "WNDCLASSEX" heap-size over set-WNDCLASSEX-cbSize
- { CS_HREDRAW CS_VREDRAW CS_OWNDC } flags over set-WNDCLASSEX-style
- ui-wndproc over set-WNDCLASSEX-lpfnWndProc
- 0 over set-WNDCLASSEX-cbClsExtra
- 0 over set-WNDCLASSEX-cbWndExtra
- f GetModuleHandle over set-WNDCLASSEX-hInstance
- f GetModuleHandle "fraptor" utf16n string>alien LoadIcon
- over set-WNDCLASSEX-hIcon
- f IDC_ARROW LoadCursor over set-WNDCLASSEX-hCursor
-
- class-name-ptr over set-WNDCLASSEX-lpszClassName
+ WNDCLASSEX heap-size >>cbSize
+ { CS_HREDRAW CS_VREDRAW CS_OWNDC } flags >>style
+ ui-wndproc >>lpfnWndProc
+ 0 >>cbClsExtra
+ 0 >>cbWndExtra
+ f GetModuleHandle >>hInstance
+ f GetModuleHandle "fraptor" utf16n string>alien LoadIcon >>hIcon
+ f IDC_ARROW LoadCursor >>hCursor
+
+ class-name-ptr >>lpszClassName
RegisterClassEx win32-error=0/f
] [ drop ] if ;
: make-RECT ( world -- RECT )
[ window-loc>> ] [ dim>> ] bi <RECT> ;
-: default-position-RECT ( RECT -- )
- dup get-RECT-dimensions [ 2drop ] 2dip
- CW_USEDEFAULT + pick set-RECT-bottom
- CW_USEDEFAULT + over set-RECT-right
- CW_USEDEFAULT over set-RECT-left
- CW_USEDEFAULT swap set-RECT-top ;
+: default-position-RECT ( RECT -- RECT' )
+ dup get-RECT-width/height
+ [ CW_USEDEFAULT + >>bottom ] dip
+ CW_USEDEFAULT + >>right
+ CW_USEDEFAULT >>left
+ CW_USEDEFAULT >>top ;
: make-adjusted-RECT ( rect style ex-style -- RECT )
[
dup get-RECT-top-left [ zero? ] both? swap
dup
] 2dip adjust-RECT
- swap [ dup default-position-RECT ] when ;
+ swap [ default-position-RECT ] when ;
: get-window-class ( -- class-name )
class-name-ptr [
: fullscreen-RECT ( hwnd -- RECT )
MONITOR_DEFAULTTONEAREST MonitorFromWindow
- "MONITORINFOEX" <c-object> dup length over set-MONITORINFOEX-cbSize
- [ GetMonitorInfo win32-error=0/f ] keep MONITORINFOEX-rcMonitor ;
+ MONITORINFOEX <struct>
+ MONITORINFOEX heap-size >>cbSize
+ [ GetMonitorInfo win32-error=0/f ] keep rcMonitor>> ;
: client-area>RECT ( hwnd -- RECT )
- "RECT" <c-object>
+ RECT <struct>
[ GetClientRect win32-error=0/f ]
[ "POINT" byte-array>struct-array [ ClientToScreen drop ] with each ]
[ nip ] 2tri ;
: hwnd>RECT ( hwnd -- RECT )
- "RECT" <c-object> [ GetWindowRect win32-error=0/f ] keep ;
+ RECT <struct> [ GetWindowRect win32-error=0/f ] keep ;
M: windows-ui-backend (grab-input) ( handle -- )
0 ShowCursor drop
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: classes.struct tools.test windows.types ;
+IN: windows.types.tests
+
+[ S{ RECT { right 100 } { bottom 100 } } ]
+[ { 0 0 } { 100 100 } <RECT> ] unit-test
+
+[ S{ RECT { left 100 } { top 100 } { right 200 } { bottom 200 } } ]
+[ { 100 100 } { 100 100 } <RECT> ] unit-test
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.syntax namespaces kernel words
sequences math math.bitwise math.vectors colors
-io.encodings.utf16n classes.struct ;
+io.encodings.utf16n classes.struct accessors ;
IN: windows.types
TYPEDEF: char CHAR
! typedef LRESULT (CALLBACK* WNDPROC)(HWND, UINT, WPARAM, LPARAM);
-C-STRUCT: WNDCLASS
- { "UINT" "style" }
- { "WNDPROC" "lpfnWndProc" }
- { "int" "cbClsExtra" }
- { "int" "cbWndExtra" }
- { "HINSTANCE" "hInstance" }
- { "HICON" "hIcon" }
- { "HCURSOR" "hCursor" }
- { "HBRUSH" "hbrBackground" }
- { "LPCTSTR" "lpszMenuName" }
- { "LPCTSTR" "lpszClassName" } ;
-
-C-STRUCT: WNDCLASSEX
- { "UINT" "cbSize" }
- { "UINT" "style" }
- { "WNDPROC" "lpfnWndProc" }
- { "int" "cbClsExtra" }
- { "int" "cbWndExtra" }
- { "HINSTANCE" "hInstance" }
- { "HICON" "hIcon" }
- { "HCURSOR" "hCursor" }
- { "HBRUSH" "hbrBackground" }
- { "LPCTSTR" "lpszMenuName" }
- { "LPCTSTR" "lpszClassName" }
- { "HICON" "hIconSm" } ;
-
-C-STRUCT: RECT
- { "LONG" "left" }
- { "LONG" "top" }
- { "LONG" "right" }
- { "LONG" "bottom" } ;
+STRUCT: WNDCLASS
+ { style UINT }
+ { lpfnWndProc WNDPROC }
+ { cbClsExtra int }
+ { cbWndExtra int }
+ { hInstance HINSTANCE }
+ { hIcon HICON }
+ { hCursor HCURSOR }
+ { hbrBackground HBRUSH }
+ { lpszMenuName LPCTSTR }
+ { lpszClassName LPCTSTR } ;
+
+STRUCT: WNDCLASSEX
+ { cbSize UINT }
+ { style UINT }
+ { lpfnWndProc WNDPROC }
+ { cbClsExtra int }
+ { cbWndExtra int }
+ { hInstance HINSTANCE }
+ { hIcon HICON }
+ { hCursor HCURSOR }
+ { hbrBackground HBRUSH }
+ { lpszMenuName LPCTSTR }
+ { lpszClassName LPCTSTR }
+ { hIconSm HICON } ;
+
+STRUCT: RECT
+ { left LONG }
+ { top LONG }
+ { right LONG }
+ { bottom LONG } ;
C-STRUCT: PAINTSTRUCT
{ "HDC" " hdc" }
{ dwVisibleMask DWORD }
{ dwDamageMask DWORD } ;
-C-STRUCT: RECT
- { "LONG" "left" }
- { "LONG" "top" }
- { "LONG" "right" }
- { "LONG" "bottom" } ;
-
: <RECT> ( loc dim -- RECT )
- over v+
- "RECT" <c-object>
- over first over set-RECT-right
- swap second over set-RECT-bottom
- over first over set-RECT-left
- swap second over set-RECT-top ;
+ [ RECT <struct> ] 2dip
+ [ drop [ first >>left ] [ second >>top ] bi ]
+ [ v+ [ first >>right ] [ second >>bottom ] bi ] 2bi ;
TYPEDEF: RECT* PRECT
TYPEDEF: RECT* LPRECT
! Copyright (C) 2005, 2006 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.syntax parser namespaces kernel math
-windows.types generalizations math.bitwise classes.struct ;
+windows.types generalizations math.bitwise classes.struct
+literals ;
IN: windows.user32
! HKL for ActivateKeyboardLayout
CONSTANT: WS_EX_CONTROLPARENT HEX: 00010000
CONSTANT: WS_EX_STATICEDGE HEX: 00020000
CONSTANT: WS_EX_APPWINDOW HEX: 00040000
+
: WS_EX_OVERLAPPEDWINDOW ( -- n )
WS_EX_WINDOWEDGE WS_EX_CLIENTEDGE bitor ; foldable
+
: WS_EX_PALETTEWINDOW ( -- n )
{ WS_EX_WINDOWEDGE WS_EX_TOOLWINDOW WS_EX_TOPMOST } flags ; foldable
CONSTANT: TME_QUERY HEX: 40000000
CONSTANT: TME_CANCEL HEX: 80000000
CONSTANT: HOVER_DEFAULT HEX: ffffffff
-C-STRUCT: TRACKMOUSEEVENT
- { "DWORD" "cbSize" }
- { "DWORD" "dwFlags" }
- { "HWND" "hwndTrack" }
- { "DWORD" "dwHoverTime" } ;
+STRUCT: TRACKMOUSEEVENT
+ { cbSize DWORD }
+ { dwFlags DWORD }
+ { hwndTrack HWND }
+ { dwHoverTime DWORD } ;
TYPEDEF: TRACKMOUSEEVENT* LPTRACKMOUSEEVENT
CONSTANT: DBT_DEVICEARRIVAL HEX: 8000
CONSTANT: DEVICE_NOTIFY_ALL_INTERFACE_CLASSES 4
-C-STRUCT: DEV_BROADCAST_HDR
- { "DWORD" "dbch_size" }
- { "DWORD" "dbch_devicetype" }
- { "DWORD" "dbch_reserved" } ;
+STRUCT: DEV_BROADCAST_HDR
+ { dbch_size DWORD }
+ { dbch_devicetype DWORD }
+ { dbch_reserved DWORD } ;
-C-STRUCT: DEV_BROADCAST_DEVICEW
- { "DWORD" "dbcc_size" }
- { "DWORD" "dbcc_devicetype" }
- { "DWORD" "dbcc_reserved" }
- { "GUID" "dbcc_classguid" }
- { { "WCHAR" 1 } "dbcc_name" } ;
+STRUCT: DEV_BROADCAST_DEVICEW
+ { dbcc_size DWORD }
+ { dbcc_devicetype DWORD }
+ { dbcc_reserved DWORD }
+ { dbcc_classguid GUID }
+ { dbcc_name WCHAR[1] } ;
CONSTANT: CCHDEVICENAME 32
-C-STRUCT: MONITORINFOEX
- { "DWORD" "cbSize" }
- { "RECT" "rcMonitor" }
- { "RECT" "rcWork" }
- { "DWORD" "dwFlags" }
- { { "TCHAR" CCHDEVICENAME } "szDevice" } ;
+STRUCT: MONITORINFOEX
+ { cbSize DWORD }
+ { rcMonitor RECT }
+ { rcWork RECT }
+ { dwFlags DWORD }
+ { szDevice { "TCHAR" $ CCHDEVICENAME } } ;
TYPEDEF: MONITORINFOEX* LPMONITORINFOEX
TYPEDEF: MONITORINFOEX* LPMONITORINFO
projects / factor.git / commitdiff