From 065db0868031e3d04c3e95abefd8b5c0efe62b08 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 27 Aug 2009 20:39:37 -0500
Subject: [PATCH 01/26] TRACKMOUSEVENT uses <struct> now
---
basis/ui/backend/windows/windows.factor | 9 +++++----
basis/windows/user32/user32.factor | 10 +++++-----
2 files changed, 10 insertions(+), 9 deletions(-)
diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor
index 7ce9afe5e6..64e87e0a4c 100755
--- a/basis/ui/backend/windows/windows.factor
+++ b/basis/ui/backend/windows/windows.factor
@@ -503,14 +503,15 @@ SYMBOL: nc-buttons
] 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 ;
diff --git a/basis/windows/user32/user32.factor b/basis/windows/user32/user32.factor
index 58981920da..543ce6e292 100755
--- a/basis/windows/user32/user32.factor
+++ b/basis/windows/user32/user32.factor
@@ -521,11 +521,11 @@ CONSTANT: TME_NONCLIENT 16
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
From 7df875c7fe3353f0a252b3f1fdc4abfa2d2dce9a Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 27 Aug 2009 20:43:42 -0500
Subject: [PATCH 02/26] update WNDCLASSEX
---
basis/ui/backend/windows/windows.factor | 21 ++++++++++----------
basis/windows/types/types.factor | 26 ++++++++++++-------------
2 files changed, 23 insertions(+), 24 deletions(-)
diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor
index 64e87e0a4c..6ccb53e8b2 100755
--- a/basis/ui/backend/windows/windows.factor
+++ b/basis/ui/backend/windows/windows.factor
@@ -589,19 +589,18 @@ M: windows-ui-backend do-events
] 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
+ 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 over set-WNDCLASSEX-lpszClassName
+ class-name-ptr >>lpszClassName
RegisterClassEx win32-error=0/f
] [ drop ] if ;
diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor
index 36823db424..37505210b5 100755
--- a/basis/windows/types/types.factor
+++ b/basis/windows/types/types.factor
@@ -228,19 +228,19 @@ C-STRUCT: WNDCLASS
{ "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" } ;
+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 } ;
C-STRUCT: RECT
{ "LONG" "left" }
From c9268547903e432abb0909e839a5d8e382a50357 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 27 Aug 2009 21:16:28 -0500
Subject: [PATCH 03/26] update RECT for new structs
---
basis/ui/backend/windows/windows.factor | 24 +++++++++++++-----------
basis/windows/types/types-tests.factor | 10 ++++++++++
basis/windows/types/types.factor | 21 +++++++++------------
3 files changed, 32 insertions(+), 23 deletions(-)
create mode 100755 basis/windows/types/types-tests.factor
diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor
index 6ccb53e8b2..5ff33c65d6 100755
--- a/basis/ui/backend/windows/windows.factor
+++ b/basis/ui/backend/windows/windows.factor
@@ -260,12 +260,14 @@ CONSTANT: window-control>ex-style
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
@@ -610,12 +612,12 @@ M: windows-ui-backend do-events
: 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 )
[
@@ -623,7 +625,7 @@ M: windows-ui-backend do-events
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 [
diff --git a/basis/windows/types/types-tests.factor b/basis/windows/types/types-tests.factor
new file mode 100755
index 0000000000..04b480d4d3
--- /dev/null
+++ b/basis/windows/types/types-tests.factor
@@ -0,0 +1,10 @@
+! 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
diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor
index 37505210b5..081e03f292 100755
--- a/basis/windows/types/types.factor
+++ b/basis/windows/types/types.factor
@@ -2,7 +2,7 @@
! 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
@@ -242,11 +242,11 @@ STRUCT: WNDCLASSEX
{ lpszClassName LPCTSTR }
{ hIconSm HICON } ;
-C-STRUCT: RECT
- { "LONG" "left" }
- { "LONG" "top" }
- { "LONG" "right" }
- { "LONG" "bottom" } ;
+STRUCT: RECT
+ { left LONG }
+ { top LONG }
+ { right LONG }
+ { bottom LONG } ;
C-STRUCT: PAINTSTRUCT
{ "HDC" " hdc" }
@@ -336,12 +336,9 @@ C-STRUCT: RECT
{ "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
From 111c0f6b895f02cacbe56a198fea22d17f5681f8 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 27 Aug 2009 21:43:29 -0500
Subject: [PATCH 04/26] more struct changes
---
basis/game-input/dinput/dinput.factor | 22 ++++++++-------
basis/ui/backend/windows/windows.factor | 9 +++---
basis/windows/types/types.factor | 28 ++++++++-----------
basis/windows/user32/user32.factor | 37 +++++++++++++------------
4 files changed, 48 insertions(+), 48 deletions(-)
diff --git a/basis/game-input/dinput/dinput.factor b/basis/game-input/dinput/dinput.factor
index 6cd161bd28..26d57871d7 100755
--- a/basis/game-input/dinput/dinput.factor
+++ b/basis/game-input/dinput/dinput.factor
@@ -6,7 +6,7 @@ math.rectangles namespaces parser sequences shuffle
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
@@ -162,7 +162,7 @@ SYMBOLS: +dinput+ +keyboard-device+ +keyboard-state+
[ 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 ;
@@ -185,9 +185,9 @@ TUPLE: window-rect < rect window-loc ;
{ 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
@@ -239,11 +239,13 @@ M: dinput-game-input-backend (close-game-input)
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
diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor
index 5ff33c65d6..cf4966b756 100755
--- a/basis/ui/backend/windows/windows.factor
+++ b/basis/ui/backend/windows/windows.factor
@@ -751,17 +751,18 @@ M: windows-ui-backend beep ( -- )
: 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
diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor
index 081e03f292..59192bb3b6 100755
--- a/basis/windows/types/types.factor
+++ b/basis/windows/types/types.factor
@@ -216,17 +216,17 @@ CONSTANT: TRUE 1
! 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" } ;
+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 }
@@ -329,12 +329,6 @@ STRUCT: PIXELFORMATDESCRIPTOR
{ dwVisibleMask DWORD }
{ dwDamageMask DWORD } ;
-C-STRUCT: RECT
- { "LONG" "left" }
- { "LONG" "top" }
- { "LONG" "right" }
- { "LONG" "bottom" } ;
-
: <RECT> ( loc dim -- RECT )
[ RECT <struct> ] 2dip
[ drop [ first >>left ] [ second >>top ] bi ]
diff --git a/basis/windows/user32/user32.factor b/basis/windows/user32/user32.factor
index 543ce6e292..4c39385ce5 100755
--- a/basis/windows/user32/user32.factor
+++ b/basis/windows/user32/user32.factor
@@ -1,7 +1,8 @@
! 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
@@ -74,8 +75,10 @@ CONSTANT: WS_EX_RIGHTSCROLLBAR HEX: 00000000
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
@@ -538,26 +541,26 @@ CONSTANT: DEVICE_NOTIFY_SERVICE_HANDLE 1
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
From f517e22e911fba522184ba2aa1ca8e0aefe0f269 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 29 Aug 2009 13:39:48 -0500
Subject: [PATCH 05/26] structs in calendar.windows
---
basis/calendar/windows/windows.factor | 14 ++++++--------
basis/windows/kernel32/kernel32.factor | 16 ++++++++--------
2 files changed, 14 insertions(+), 16 deletions(-)
diff --git a/basis/calendar/windows/windows.factor b/basis/calendar/windows/windows.factor
index caab530a23..65c922f119 100644
--- a/basis/calendar/windows/windows.factor
+++ b/basis/calendar/windows/windows.factor
@@ -1,15 +1,13 @@
USING: calendar namespaces alien.c-types system
-windows.kernel32 kernel math combinators windows.errors ;
+windows.kernel32 kernel math combinators windows.errors
+classes.struct accessors ;
IN: calendar.windows
M: windows gmt-offset ( -- hours minutes seconds )
- "TIME_ZONE_INFORMATION" <c-object>
+ TIME_ZONE_INFORMATION <struct>
dup GetTimeZoneInformation {
{ TIME_ZONE_ID_INVALID [ win32-error-string throw ] }
- { TIME_ZONE_ID_UNKNOWN [ TIME_ZONE_INFORMATION-Bias ] }
- { TIME_ZONE_ID_STANDARD [ TIME_ZONE_INFORMATION-Bias ] }
- { TIME_ZONE_ID_DAYLIGHT [
- [ TIME_ZONE_INFORMATION-Bias ]
- [ TIME_ZONE_INFORMATION-DaylightBias ] bi +
- ] }
+ { TIME_ZONE_ID_UNKNOWN [ Bias>> ] }
+ { TIME_ZONE_ID_STANDARD [ Bias>> ] }
+ { TIME_ZONE_ID_DAYLIGHT [ [ Bias>> ] [ DaylightBias>> ] bi + ] }
} case neg 60 /mod 0 ;
diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor
index 50a03945f3..30007bb5a0 100755
--- a/basis/windows/kernel32/kernel32.factor
+++ b/basis/windows/kernel32/kernel32.factor
@@ -226,14 +226,14 @@ STRUCT: SYSTEMTIME
{ wSecond WORD }
{ wMilliseconds WORD } ;
-C-STRUCT: TIME_ZONE_INFORMATION
- { "LONG" "Bias" }
- { { "WCHAR" 32 } "StandardName" }
- { "SYSTEMTIME" "StandardDate" }
- { "LONG" "StandardBias" }
- { { "WCHAR" 32 } "DaylightName" }
- { "SYSTEMTIME" "DaylightDate" }
- { "LONG" "DaylightBias" } ;
+STRUCT: TIME_ZONE_INFORMATION
+ { Bias LONG }
+ { StandardName WCHAR[32] }
+ { StandardDate SYSTEMTIME }
+ { StandardBias LONG }
+ { DaylightName WCHAR[32] }
+ { DaylightDate SYSTEMTIME }
+ { DaylightBias LONG } ;
STRUCT: FILETIME
{ dwLowDateTime DWORD }
From d2accedf8d9c4786b7a1531264d6fa8cec125b57 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 29 Aug 2009 13:45:25 -0500
Subject: [PATCH 06/26] more structs
---
basis/io/files/info/windows/windows.factor | 19 +++++-------
basis/io/monitors/windows/nt/nt.factor | 12 +++-----
basis/windows/kernel32/kernel32.factor | 35 +++++++++++-----------
3 files changed, 29 insertions(+), 37 deletions(-)
diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor
index 587747ac34..684df6191e 100755
--- a/basis/io/files/info/windows/windows.factor
+++ b/basis/io/files/info/windows/windows.factor
@@ -35,20 +35,17 @@ TUPLE: windows-file-info < file-info attributes ;
: WIN32_FIND_DATA>file-info ( WIN32_FIND_DATA -- file-info )
[ \ windows-file-info new ] dip
{
- [ WIN32_FIND_DATA-dwFileAttributes win32-file-type >>type ]
- [ WIN32_FIND_DATA-dwFileAttributes win32-file-attributes >>attributes ]
- [
- [ WIN32_FIND_DATA-nFileSizeLow ]
- [ WIN32_FIND_DATA-nFileSizeHigh ] bi >64bit >>size
- ]
- [ WIN32_FIND_DATA-dwFileAttributes >>permissions ]
- [ WIN32_FIND_DATA-ftCreationTime FILETIME>timestamp >>created ]
- [ WIN32_FIND_DATA-ftLastWriteTime FILETIME>timestamp >>modified ]
- [ WIN32_FIND_DATA-ftLastAccessTime FILETIME>timestamp >>accessed ]
+ [ dwFileAttributes>> win32-file-type >>type ]
+ [ dwFileAttributes>> win32-file-attributes >>attributes ]
+ [ [ nFileSizeLow>> ] [ nFileSizeHigh>> ] bi >64bit >>size ]
+ [ dwFileAttributes>> >>permissions ]
+ [ ftCreationTime>> FILETIME>timestamp >>created ]
+ [ ftLastWriteTime>> FILETIME>timestamp >>modified ]
+ [ ftLastAccessTime>> FILETIME>timestamp >>accessed ]
} cleave ;
: find-first-file-stat ( path -- WIN32_FIND_DATA )
- "WIN32_FIND_DATA" <c-object> [
+ WIN32_FIND_DATA <struct> [
FindFirstFile
[ INVALID_HANDLE_VALUE = [ win32-error ] when ] keep
FindClose win32-error=0/f
diff --git a/basis/io/monitors/windows/nt/nt.factor b/basis/io/monitors/windows/nt/nt.factor
index bec249c04c..cd497b1c87 100755
--- a/basis/io/monitors/windows/nt/nt.factor
+++ b/basis/io/monitors/windows/nt/nt.factor
@@ -55,17 +55,13 @@ TUPLE: win32-monitor < monitor port ;
memory>byte-array utf16n decode ;
: parse-notify-record ( buffer -- path changed )
- [
- [ FILE_NOTIFY_INFORMATION-FileName ]
- [ FILE_NOTIFY_INFORMATION-FileNameLength ]
- bi memory>u16-string
- ]
- [ FILE_NOTIFY_INFORMATION-Action parse-action ] bi ;
+ [ [ FileName>> ] [ FileNameLength>> ] bi memory>u16-string ]
+ [ Action>> parse-action ] bi ;
: (file-notify-records) ( buffer -- buffer )
dup ,
- dup FILE_NOTIFY_INFORMATION-NextEntryOffset zero? [
- [ FILE_NOTIFY_INFORMATION-NextEntryOffset ] keep <displaced-alien>
+ dup NextEntryOffset>> zero? [
+ [ NextEntryOffset>> ] [ <displaced-alien> ] bi
(file-notify-records)
] unless ;
diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor
index 30007bb5a0..1adb07cf1e 100755
--- a/basis/windows/kernel32/kernel32.factor
+++ b/basis/windows/kernel32/kernel32.factor
@@ -90,11 +90,12 @@ CONSTANT: FILE_ACTION_MODIFIED 3
CONSTANT: FILE_ACTION_RENAMED_OLD_NAME 4
CONSTANT: FILE_ACTION_RENAMED_NEW_NAME 5
-C-STRUCT: FILE_NOTIFY_INFORMATION
- { "DWORD" "NextEntryOffset" }
- { "DWORD" "Action" }
- { "DWORD" "FileNameLength" }
- { "WCHAR[1]" "FileName" } ;
+STRUCT: FILE_NOTIFY_INFORMATION
+ { NextEntryOffset DWORD }
+ { Action DWORD }
+ { FileNameLength DWORD }
+ { FileName WCHAR[1] } ;
+
TYPEDEF: FILE_NOTIFY_INFORMATION* PFILE_NOTIFY_INFORMATION
CONSTANT: STD_INPUT_HANDLE -10
@@ -694,19 +695,17 @@ C-STRUCT: OFSTRUCT
TYPEDEF: OFSTRUCT* LPOFSTRUCT
-! MAX_PATH = 260
-C-STRUCT: WIN32_FIND_DATA
- { "DWORD" "dwFileAttributes" }
- { "FILETIME" "ftCreationTime" }
- { "FILETIME" "ftLastAccessTime" }
- { "FILETIME" "ftLastWriteTime" }
- { "DWORD" "nFileSizeHigh" }
- { "DWORD" "nFileSizeLow" }
- { "DWORD" "dwReserved0" }
- { "DWORD" "dwReserved1" }
- ! { { "TCHAR" MAX_PATH } "cFileName" }
- { { "TCHAR" 260 } "cFileName" }
- { { "TCHAR" 14 } "cAlternateFileName" } ;
+STRUCT: WIN32_FIND_DATA
+ { dwFileAttributes DWORD }
+ { ftCreationTime FILETIME }
+ { ftLastAccessTime FILETIME }
+ { ftLastWriteTime FILETIME }
+ { nFileSizeHigh DWORD }
+ { nFileSizeLow DWORD }
+ { dwReserved0 DWORD }
+ { dwReserved1 DWORD }
+ { cFileName { "TCHAR" MAX_PATH } }
+ { cAlternateFileName TCHAR[14] } ;
STRUCT: BY_HANDLE_FILE_INFORMATION
{ dwFileAttributes DWORD }
From 56be96429ab2877ff76ce9549be64e27cbaccfcc Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 29 Aug 2009 14:28:00 -0500
Subject: [PATCH 07/26] fix io monitors
---
basis/io/monitors/windows/nt/nt.factor | 5 +++--
1 file changed, 3 insertions(+), 2 deletions(-)
diff --git a/basis/io/monitors/windows/nt/nt.factor b/basis/io/monitors/windows/nt/nt.factor
index cd497b1c87..3d837d79d8 100755
--- a/basis/io/monitors/windows/nt/nt.factor
+++ b/basis/io/monitors/windows/nt/nt.factor
@@ -7,7 +7,7 @@ system accessors threads splitting io.backend io.backend.windows
io.backend.windows.nt io.files.windows.nt io.monitors io.ports
io.buffers io.files io.timeouts io.encodings.string
io.encodings.utf16n io windows.errors windows.kernel32 windows.types
-io.pathnames ;
+io.pathnames classes.struct ;
IN: io.monitors.windows.nt
: open-directory ( path -- handle )
@@ -59,9 +59,10 @@ TUPLE: win32-monitor < monitor port ;
[ Action>> parse-action ] bi ;
: (file-notify-records) ( buffer -- buffer )
+ FILE_NOTIFY_INFORMATION memory>struct
dup ,
dup NextEntryOffset>> zero? [
- [ NextEntryOffset>> ] [ <displaced-alien> ] bi
+ [ NextEntryOffset>> ] [ >c-ptr <displaced-alien> ] bi
(file-notify-records)
] unless ;
From 6aeb3614ff808a9fd18937b2e5d1503e88d3df4c Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 29 Aug 2009 14:29:46 -0500
Subject: [PATCH 08/26] new structs in font rendering
---
basis/windows/fonts/fonts.factor | 74 ++++++++++++------------
basis/windows/types/types.factor | 42 +++++++-------
basis/windows/uniscribe/uniscribe.factor | 5 +-
3 files changed, 61 insertions(+), 60 deletions(-)
diff --git a/basis/windows/fonts/fonts.factor b/basis/windows/fonts/fonts.factor
index 269e8f8f48..b8acf5d8d1 100755
--- a/basis/windows/fonts/fonts.factor
+++ b/basis/windows/fonts/fonts.factor
@@ -1,37 +1,37 @@
-USING: assocs memoize locals kernel accessors init fonts math
-combinators windows.errors windows.types windows.gdi32 ;
-IN: windows.fonts
-
-: windows-font-name ( string -- string' )
- H{
- { "sans-serif" "Tahoma" }
- { "serif" "Times New Roman" }
- { "monospace" "Courier New" }
- } ?at drop ;
-
-MEMO:: (cache-font) ( font -- HFONT )
- font size>> neg ! nHeight
- 0 0 0 ! nWidth, nEscapement, nOrientation
- font bold?>> FW_BOLD FW_NORMAL ? ! fnWeight
- font italic?>> TRUE FALSE ? ! fdwItalic
- FALSE ! fdwUnderline
- FALSE ! fdWStrikeOut
- DEFAULT_CHARSET ! fdwCharSet
- OUT_OUTLINE_PRECIS ! fdwOutputPrecision
- CLIP_DEFAULT_PRECIS ! fdwClipPrecision
- DEFAULT_QUALITY ! fdwQuality
- DEFAULT_PITCH ! fdwPitchAndFamily
- font name>> windows-font-name
- CreateFont
- dup win32-error=0/f ;
-
-: cache-font ( font -- HFONT ) strip-font-colors (cache-font) ;
-
-[ \ (cache-font) reset-memoized ] "windows.fonts" add-init-hook
-
-: TEXTMETRIC>metrics ( TEXTMETRIC -- metrics )
- [ metrics new 0 >>width ] dip {
- [ TEXTMETRICW-tmHeight >>height ]
- [ TEXTMETRICW-tmAscent >>ascent ]
- [ TEXTMETRICW-tmDescent >>descent ]
- } cleave ;
+USING: assocs memoize locals kernel accessors init fonts math
+combinators windows.errors windows.types windows.gdi32 ;
+IN: windows.fonts
+
+: windows-font-name ( string -- string' )
+ H{
+ { "sans-serif" "Tahoma" }
+ { "serif" "Times New Roman" }
+ { "monospace" "Courier New" }
+ } ?at drop ;
+
+MEMO:: (cache-font) ( font -- HFONT )
+ font size>> neg ! nHeight
+ 0 0 0 ! nWidth, nEscapement, nOrientation
+ font bold?>> FW_BOLD FW_NORMAL ? ! fnWeight
+ font italic?>> TRUE FALSE ? ! fdwItalic
+ FALSE ! fdwUnderline
+ FALSE ! fdWStrikeOut
+ DEFAULT_CHARSET ! fdwCharSet
+ OUT_OUTLINE_PRECIS ! fdwOutputPrecision
+ CLIP_DEFAULT_PRECIS ! fdwClipPrecision
+ DEFAULT_QUALITY ! fdwQuality
+ DEFAULT_PITCH ! fdwPitchAndFamily
+ font name>> windows-font-name
+ CreateFont
+ dup win32-error=0/f ;
+
+: cache-font ( font -- HFONT ) strip-font-colors (cache-font) ;
+
+[ \ (cache-font) reset-memoized ] "windows.fonts" add-init-hook
+
+: TEXTMETRIC>metrics ( TEXTMETRIC -- metrics )
+ [ metrics new 0 >>width ] dip {
+ [ tmHeight>> >>height ]
+ [ tmAscent>> >>ascent ]
+ [ tmDescent>> >>descent ]
+ } cleave ;
diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor
index 59192bb3b6..c62de58bcd 100755
--- a/basis/windows/types/types.factor
+++ b/basis/windows/types/types.factor
@@ -380,26 +380,26 @@ TYPEDEF: DWORD* LPCOLORREF
: color>RGB ( color -- COLORREF )
>rgba-components drop [ 255 * >integer ] tri@ RGB ;
-C-STRUCT: TEXTMETRICW
- { "LONG" "tmHeight" }
- { "LONG" "tmAscent" }
- { "LONG" "tmDescent" }
- { "LONG" "tmInternalLeading" }
- { "LONG" "tmExternalLeading" }
- { "LONG" "tmAveCharWidth" }
- { "LONG" "tmMaxCharWidth" }
- { "LONG" "tmWeight" }
- { "LONG" "tmOverhang" }
- { "LONG" "tmDigitizedAspectX" }
- { "LONG" "tmDigitizedAspectY" }
- { "WCHAR" "tmFirstChar" }
- { "WCHAR" "tmLastChar" }
- { "WCHAR" "tmDefaultChar" }
- { "WCHAR" "tmBreakChar" }
- { "BYTE" "tmItalic" }
- { "BYTE" "tmUnderlined" }
- { "BYTE" "tmStruckOut" }
- { "BYTE" "tmPitchAndFamily" }
- { "BYTE" "tmCharSet" } ;
+STRUCT: TEXTMETRICW
+ { tmHeight LONG }
+ { tmAscent LONG }
+ { tmDescent LONG }
+ { tmInternalLeading LONG }
+ { tmExternalLeading LONG }
+ { tmAveCharWidth LONG }
+ { tmMaxCharWidth LONG }
+ { tmWeight LONG }
+ { tmOverhang LONG }
+ { tmDigitizedAspectX LONG }
+ { tmDigitizedAspectY LONG }
+ { tmFirstChar WCHAR }
+ { tmLastChar WCHAR }
+ { tmDefaultChar WCHAR }
+ { tmBreakChar WCHAR }
+ { tmItalic BYTE }
+ { tmUnderlined BYTE }
+ { tmStruckOut BYTE }
+ { tmPitchAndFamily BYTE }
+ { tmCharSet BYTE } ;
TYPEDEF: TEXTMETRICW* LPTEXTMETRIC
diff --git a/basis/windows/uniscribe/uniscribe.factor b/basis/windows/uniscribe/uniscribe.factor
index 457f4bc9f0..7dd630ca5b 100755
--- a/basis/windows/uniscribe/uniscribe.factor
+++ b/basis/windows/uniscribe/uniscribe.factor
@@ -4,7 +4,8 @@ USING: kernel assocs math sequences fry io.encodings.string
io.encodings.utf16n accessors arrays combinators destructors
cache namespaces init fonts alien.c-types windows.usp10
windows.offscreen windows.gdi32 windows.ole32 windows.types
-windows.fonts opengl.textures locals windows.errors ;
+windows.fonts opengl.textures locals windows.errors
+classes.struct ;
IN: windows.uniscribe
TUPLE: script-string < disposable font string metrics ssa size image ;
@@ -84,7 +85,7 @@ TUPLE: script-string < disposable font string metrics ssa size image ;
[ SIZE-cx ] [ SIZE-cy ] bi 2array ;
: dc-metrics ( dc -- metrics )
- "TEXTMETRICW" <c-object>
+ TEXTMETRICW <struct>
[ GetTextMetrics drop ] keep
TEXTMETRIC>metrics ;
From b8164120f5813756cb9c727d142c6eb8c0210083 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 29 Aug 2009 14:37:09 -0500
Subject: [PATCH 09/26] oops, forgot to update a struct
---
basis/io/directories/windows/windows.factor | 9 +++++----
1 file changed, 5 insertions(+), 4 deletions(-)
diff --git a/basis/io/directories/windows/windows.factor b/basis/io/directories/windows/windows.factor
index 7554baa944..d1931526bd 100755
--- a/basis/io/directories/windows/windows.factor
+++ b/basis/io/directories/windows/windows.factor
@@ -48,10 +48,11 @@ M: windows delete-directory ( path -- )
TUPLE: windows-directory-entry < directory-entry attributes ;
M: windows >directory-entry ( byte-array -- directory-entry )
- [ WIN32_FIND_DATA-cFileName utf16n alien>string ]
- [ WIN32_FIND_DATA-dwFileAttributes win32-file-type ]
- [ WIN32_FIND_DATA-dwFileAttributes win32-file-attributes ]
- tri
+ [ cFileName>> utf16n alien>string ]
+ [
+ dwFileAttributes>>
+ [ win32-file-type ] [ win32-file-attributes ] bi
+ ] bi
dupd remove windows-directory-entry boa ;
M: windows (directory-entries) ( path -- seq )
From 3ecb3a85db9bf15b21b56c61e220004257b04bbc Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 29 Aug 2009 17:08:25 -0500
Subject: [PATCH 10/26] SIZE struct
---
basis/windows/types/types.factor | 6 +++---
basis/windows/uniscribe/uniscribe.factor | 2 +-
2 files changed, 4 insertions(+), 4 deletions(-)
diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor
index c62de58bcd..fb3ba7f0f5 100755
--- a/basis/windows/types/types.factor
+++ b/basis/windows/types/types.factor
@@ -287,9 +287,9 @@ C-STRUCT: POINT
{ "LONG" "x" }
{ "LONG" "y" } ;
-C-STRUCT: SIZE
- { "LONG" "cx" }
- { "LONG" "cy" } ;
+STRUCT: SIZE
+ { cx LONG }
+ { cy LONG } ;
C-STRUCT: MSG
{ "HWND" "hWnd" }
diff --git a/basis/windows/uniscribe/uniscribe.factor b/basis/windows/uniscribe/uniscribe.factor
index 7dd630ca5b..1c1830fa02 100755
--- a/basis/windows/uniscribe/uniscribe.factor
+++ b/basis/windows/uniscribe/uniscribe.factor
@@ -82,7 +82,7 @@ TUPLE: script-string < disposable font string metrics ssa size image ;
: script-string-size ( script-string -- dim )
ssa>> ScriptString_pSize
dup win32-error=0/f
- [ SIZE-cx ] [ SIZE-cy ] bi 2array ;
+ [ cx>> ] [ cy>> ] bi 2array ;
: dc-metrics ( dc -- metrics )
TEXTMETRICW <struct>
From eb21a7b0dd93f4c41dbdfbf1474aff1ea4d47cd3 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 29 Aug 2009 17:18:30 -0500
Subject: [PATCH 11/26] fix uniscribe
---
basis/windows/uniscribe/uniscribe.factor | 1 +
1 file changed, 1 insertion(+)
diff --git a/basis/windows/uniscribe/uniscribe.factor b/basis/windows/uniscribe/uniscribe.factor
index 1c1830fa02..9555927ab1 100755
--- a/basis/windows/uniscribe/uniscribe.factor
+++ b/basis/windows/uniscribe/uniscribe.factor
@@ -82,6 +82,7 @@ TUPLE: script-string < disposable font string metrics ssa size image ;
: script-string-size ( script-string -- dim )
ssa>> ScriptString_pSize
dup win32-error=0/f
+ SIZE memory>struct
[ cx>> ] [ cy>> ] bi 2array ;
: dc-metrics ( dc -- metrics )
From 0c37990f53ae7c8f5d851dbe2b597cfadd2bc7ae Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 29 Aug 2009 17:35:11 -0500
Subject: [PATCH 12/26] windows.offscreen structs
---
basis/windows/offscreen/offscreen.factor | 33 +++++++++----------
basis/windows/types/types.factor | 40 ++++++++++++------------
2 files changed, 37 insertions(+), 36 deletions(-)
diff --git a/basis/windows/offscreen/offscreen.factor b/basis/windows/offscreen/offscreen.factor
index fea7240bf6..63cfd92ba1 100755
--- a/basis/windows/offscreen/offscreen.factor
+++ b/basis/windows/offscreen/offscreen.factor
@@ -2,25 +2,26 @@
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types kernel combinators sequences
math windows.gdi32 windows.types images destructors
-accessors fry locals ;
+accessors fry locals classes.struct ;
IN: windows.offscreen
: (bitmap-info) ( dim -- BITMAPINFO )
- "BITMAPINFO" <c-object> [
- BITMAPINFO-bmiHeader {
- [ nip "BITMAPINFOHEADER" heap-size swap set-BITMAPINFOHEADER-biSize ]
- [ [ first ] dip set-BITMAPINFOHEADER-biWidth ]
- [ [ second ] dip set-BITMAPINFOHEADER-biHeight ]
- [ nip 1 swap set-BITMAPINFOHEADER-biPlanes ]
- [ nip 32 swap set-BITMAPINFOHEADER-biBitCount ]
- [ nip BI_RGB swap set-BITMAPINFOHEADER-biCompression ]
- [ [ first2 * 4 * ] dip set-BITMAPINFOHEADER-biSizeImage ]
- [ nip 72 swap set-BITMAPINFOHEADER-biXPelsPerMeter ]
- [ nip 72 swap set-BITMAPINFOHEADER-biYPelsPerMeter ]
- [ nip 0 swap set-BITMAPINFOHEADER-biClrUsed ]
- [ nip 0 swap set-BITMAPINFOHEADER-biClrImportant ]
- } 2cleave
- ] keep ;
+ [
+ BITMAPINFO <struct>
+ dup bmiHeader>>
+ BITMAPINFOHEADER heap-size >>biSize
+ ] dip
+ [ first >>biWidth ]
+ [ second >>biHeight ]
+ [ first2 * 4 * >>biSizeImage ] tri
+ 1 >>biPlanes
+ 32 >>biBitCount
+ BI_RGB >>biCompression
+ 72 >>biXPelsPerMeter
+ 72 >>biYPelsPerMeter
+ 0 >>biClrUsed
+ 0 >>biClrImportant
+ drop ;
: make-bitmap ( dim dc -- hBitmap bits )
[ nip ]
diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor
index fb3ba7f0f5..8a5c963de0 100755
--- a/basis/windows/types/types.factor
+++ b/basis/windows/types/types.factor
@@ -257,28 +257,28 @@ C-STRUCT: PAINTSTRUCT
{ "BYTE[32]" "rgbReserved" }
;
-C-STRUCT: BITMAPINFOHEADER
- { "DWORD" "biSize" }
- { "LONG" "biWidth" }
- { "LONG" "biHeight" }
- { "WORD" "biPlanes" }
- { "WORD" "biBitCount" }
- { "DWORD" "biCompression" }
- { "DWORD" "biSizeImage" }
- { "LONG" "biXPelsPerMeter" }
- { "LONG" "biYPelsPerMeter" }
- { "DWORD" "biClrUsed" }
- { "DWORD" "biClrImportant" } ;
+STRUCT: BITMAPINFOHEADER
+ { biSize DWORD }
+ { biWidth LONG }
+ { biHeight LONG }
+ { biPlanes WORD }
+ { biBitCount WORD }
+ { biCompression DWORD }
+ { biSizeImage DWORD }
+ { biXPelsPerMeter LONG }
+ { biYPelsPerMeter LONG }
+ { biClrUsed DWORD }
+ { biClrImportant DWORD } ;
-C-STRUCT: RGBQUAD
- { "BYTE" "rgbBlue" }
- { "BYTE" "rgbGreen" }
- { "BYTE" "rgbRed" }
- { "BYTE" "rgbReserved" } ;
+STRUCT: RGBQUAD
+ { rgbBlue BYTE }
+ { rgbGreen BYTE }
+ { rgbRed BYTE }
+ { rgbReserved BYTE } ;
-C-STRUCT: BITMAPINFO
- { "BITMAPINFOHEADER" "bmiHeader" }
- { "RGBQUAD[1]" "bmiColors" } ;
+STRUCT: BITMAPINFO
+ { bmiHeader BITMAPINFOHEADER }
+ { bimColors RGBQUAD[1] } ;
TYPEDEF: void* LPPAINTSTRUCT
TYPEDEF: void* PAINTSTRUCT
From 50a99dcce6305904dcf92adae78b575c8b4e9132 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 29 Aug 2009 17:41:08 -0500
Subject: [PATCH 13/26] guid, system-info
---
basis/calendar/windows/windows.factor | 2 +-
basis/windows/kernel32/kernel32.factor | 24 +++----
basis/windows/ole32/ole32.factor | 79 ++++++++----------------
basis/windows/winsock/winsock.factor | 11 ++--
extra/system-info/windows/windows.factor | 14 ++---
5 files changed, 51 insertions(+), 79 deletions(-)
diff --git a/basis/calendar/windows/windows.factor b/basis/calendar/windows/windows.factor
index 65c922f119..265a58507c 100644
--- a/basis/calendar/windows/windows.factor
+++ b/basis/calendar/windows/windows.factor
@@ -1,6 +1,6 @@
USING: calendar namespaces alien.c-types system
windows.kernel32 kernel math combinators windows.errors
-classes.struct accessors ;
+accessors classes.struct ;
IN: calendar.windows
M: windows gmt-offset ( -- hours minutes seconds )
diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor
index 1adb07cf1e..2182088efe 100755
--- a/basis/windows/kernel32/kernel32.factor
+++ b/basis/windows/kernel32/kernel32.factor
@@ -307,13 +307,13 @@ STRUCT: MEMORYSTATUSEX
TYPEDEF: void* LPMEMORYSTATUSEX
-C-STRUCT: OSVERSIONINFO
- { "DWORD" "dwOSVersionInfoSize" }
- { "DWORD" "dwMajorVersion" }
- { "DWORD" "dwMinorVersion" }
- { "DWORD" "dwBuildNumber" }
- { "DWORD" "dwPlatformId" }
- { { "WCHAR" 128 } "szCSDVersion" } ;
+STRUCT: OSVERSIONINFO
+ { dwOSVersionInfoSize DWORD }
+ { dwMajorVersion DWORD }
+ { dwMinorVersion DWORD }
+ { dwBuildNumber DWORD }
+ { dwPlatformId DWORD }
+ { szCSDVersion WCHAR[128] } ;
TYPEDEF: void* LPOSVERSIONINFO
@@ -326,11 +326,11 @@ C-STRUCT: MEMORY_BASIC_INFORMATION
{ "DWORD" "protect" }
{ "DWORD" "type" } ;
-C-STRUCT: GUID
- { "ULONG" "Data1" }
- { "WORD" "Data2" }
- { "WORD" "Data3" }
- { { "UCHAR" 8 } "Data4" } ;
+STRUCT: GUID
+ { Data1 ULONG }
+ { Data2 WORD }
+ { Data3 WORD }
+ { Data4 UCHAR[8] } ;
/*
fBinary :1;
diff --git a/basis/windows/ole32/ole32.factor b/basis/windows/ole32/ole32.factor
index 639a9ba637..37a3a90d3b 100755
--- a/basis/windows/ole32/ole32.factor
+++ b/basis/windows/ole32/ole32.factor
@@ -1,7 +1,8 @@
USING: alien alien.syntax alien.c-types alien.strings math
kernel sequences windows.errors windows.types io
accessors math.order namespaces make math.parser windows.kernel32
-combinators locals specialized-arrays.direct.uchar ;
+combinators locals specialized-arrays.direct.uchar
+literals splitting grouping classes.struct combinators.smart ;
IN: windows.ole32
LIBRARY: ole32
@@ -130,60 +131,34 @@ TUPLE: ole32-error code message ;
: guid= ( a b -- ? )
[ 16 memory>byte-array ] bi@ = ;
-: GUID-STRING-LENGTH ( -- n )
- "{01234567-89ab-cdef-0123-456789abcdef}" length ; inline
-
-:: (guid-section>guid) ( string guid start end quot -- )
- start end string subseq hex> guid quot call ; inline
-
-:: (guid-byte>guid) ( string guid start end byte -- )
- start end string subseq hex> byte guid set-nth ; inline
+CONSTANT: GUID-STRING-LENGTH
+ $[ "{01234567-89ab-cdef-0123-456789abcdef}" length ]
: string>guid ( string -- guid )
- "GUID" <c-object> [
- {
- [ 1 9 [ set-GUID-Data1 ] (guid-section>guid) ]
- [ 10 14 [ set-GUID-Data2 ] (guid-section>guid) ]
- [ 15 19 [ set-GUID-Data3 ] (guid-section>guid) ]
- [ ]
- } 2cleave
-
- GUID-Data4 {
- [ 20 22 0 (guid-byte>guid) ]
- [ 22 24 1 (guid-byte>guid) ]
-
- [ 25 27 2 (guid-byte>guid) ]
- [ 27 29 3 (guid-byte>guid) ]
- [ 29 31 4 (guid-byte>guid) ]
- [ 31 33 5 (guid-byte>guid) ]
- [ 33 35 6 (guid-byte>guid) ]
- [ 35 37 7 (guid-byte>guid) ]
- } 2cleave
- ] keep ;
-
-: (guid-section%) ( guid quot len -- )
- [ call >hex ] dip CHAR: 0 pad-head % ; inline
-
-: (guid-byte%) ( guid byte -- )
- swap nth >hex 2 CHAR: 0 pad-head % ; inline
+ "{-}" split harvest
+ [ first3 [ hex> ] tri@ ]
+ [ 3 tail concat 2 group [ hex> ] B{ } map-as ] bi
+ GUID <struct-boa> ;
: guid>string ( guid -- string )
[
- "{" % {
- [ [ GUID-Data1 ] 8 (guid-section%) "-" % ]
- [ [ GUID-Data2 ] 4 (guid-section%) "-" % ]
- [ [ GUID-Data3 ] 4 (guid-section%) "-" % ]
- [ ]
+ [ "{" ] dip {
+ [ Data1>> >hex "-" ]
+ [ Data2>> >hex "-" ]
+ [ Data3>> >hex "-" ]
+ [
+ Data4>> [
+ {
+ [ >hex 2 CHAR: 0 pad-head ]
+ [ >hex 2 CHAR: 0 pad-head "-" ]
+ [ >hex 2 CHAR: 0 pad-head ]
+ [ >hex 2 CHAR: 0 pad-head ]
+ [ >hex 2 CHAR: 0 pad-head ]
+ [ >hex 2 CHAR: 0 pad-head ]
+ [ >hex 2 CHAR: 0 pad-head ]
+ [ >hex 2 CHAR: 0 pad-head ]
+ } spread
+ ] input<sequence "}"
+ ]
} cleave
- GUID-Data4 {
- [ 0 (guid-byte%) ]
- [ 1 (guid-byte%) "-" % ]
- [ 2 (guid-byte%) ]
- [ 3 (guid-byte%) ]
- [ 4 (guid-byte%) ]
- [ 5 (guid-byte%) ]
- [ 6 (guid-byte%) ]
- [ 7 (guid-byte%) "}" % ]
- } cleave
- ] "" make ;
-
+ ] "" append-outputs-as ;
diff --git a/basis/windows/winsock/winsock.factor b/basis/windows/winsock/winsock.factor
index f0d32588f5..7e6b2bd803 100755
--- a/basis/windows/winsock/winsock.factor
+++ b/basis/windows/winsock/winsock.factor
@@ -377,8 +377,6 @@ FUNCTION: DWORD WSAWaitForMultipleEvents ( DWORD cEvents,
BOOL fAlertable ) ;
-
-
LIBRARY: mswsock
! Not in Windows CE
@@ -388,14 +386,13 @@ FUNCTION: void GetAcceptExSockaddrs ( void* a, int b, int c, int d, void* e, voi
CONSTANT: SIO_GET_EXTENSION_FUNCTION_POINTER -939524090
: WSAID_CONNECTEX ( -- GUID )
- "GUID" <c-object>
- HEX: 25a207b9 over set-GUID-Data1
- HEX: ddf3 over set-GUID-Data2
- HEX: 4660 over set-GUID-Data3
+ HEX: 25a207b9
+ HEX: ddf3
+ HEX: 4660
B{
HEX: 8e HEX: e9 HEX: 76 HEX: e5
HEX: 8c HEX: 74 HEX: 06 HEX: 3e
- } over set-GUID-Data4 ;
+ } GUID <struct-boa> ;
: winsock-expected-error? ( n -- ? )
ERROR_IO_PENDING ERROR_SUCCESS WSA_IO_PENDING 3array member? ;
diff --git a/extra/system-info/windows/windows.factor b/extra/system-info/windows/windows.factor
index e68f6ce62f..8e0dc60e25 100755
--- a/extra/system-info/windows/windows.factor
+++ b/extra/system-info/windows/windows.factor
@@ -21,24 +21,24 @@ IN: system-info.windows
system-info dwOemId>> HEX: ffff0000 bitand ;
: os-version ( -- os-version )
- "OSVERSIONINFO" <c-object>
- "OSVERSIONINFO" heap-size over set-OSVERSIONINFO-dwOSVersionInfoSize
+ OSVERSIONINFO <struct>
+ OSVERSIONINFO heap-size >>dwOSVersionInfoSize
dup GetVersionEx win32-error=0/f ;
: windows-major ( -- n )
- os-version OSVERSIONINFO-dwMajorVersion ;
+ os-version dwMajorVersion>> ;
: windows-minor ( -- n )
- os-version OSVERSIONINFO-dwMinorVersion ;
+ os-version dwMinorVersion>> ;
: windows-build# ( -- n )
- os-version OSVERSIONINFO-dwBuildNumber ;
+ os-version dwBuildNumber>> ;
: windows-platform-id ( -- n )
- os-version OSVERSIONINFO-dwPlatformId ;
+ os-version dwPlatformId>> ;
: windows-service-pack ( -- string )
- os-version OSVERSIONINFO-szCSDVersion alien>native-string ;
+ os-version szCSDVersion>> alien>native-string ;
: feature-present? ( n -- ? )
IsProcessorFeaturePresent zero? not ;
From ec579dcfc1f8f2f52c22e94b020e11c341f0b6a7 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 29 Aug 2009 17:42:14 -0500
Subject: [PATCH 14/26] fix using
---
basis/windows/winsock/winsock.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/windows/winsock/winsock.factor b/basis/windows/winsock/winsock.factor
index 7e6b2bd803..bd7304cde1 100755
--- a/basis/windows/winsock/winsock.factor
+++ b/basis/windows/winsock/winsock.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings alien.syntax arrays
byte-arrays kernel math sequences windows.types windows.kernel32
-windows.errors math.bitwise io.encodings.utf16n ;
+windows.errors math.bitwise io.encodings.utf16n classes.struct ;
IN: windows.winsock
USE: libc
From 135d56fcd232ea78bfa2e48c654c417f55c90c37 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 29 Aug 2009 19:18:39 -0500
Subject: [PATCH 15/26] fix com, prettyprinting of GUIDs
---
basis/windows/com/syntax/syntax.factor | 5 ++++-
basis/windows/com/wrapper/wrapper.factor | 2 +-
basis/windows/ole32/ole32-tests.factor | 17 +++++------------
basis/windows/ole32/ole32.factor | 6 +++---
4 files changed, 13 insertions(+), 17 deletions(-)
diff --git a/basis/windows/com/syntax/syntax.factor b/basis/windows/com/syntax/syntax.factor
index 59a76bf4d7..56ae0aa71c 100755
--- a/basis/windows/com/syntax/syntax.factor
+++ b/basis/windows/com/syntax/syntax.factor
@@ -1,7 +1,8 @@
USING: alien alien.c-types alien.accessors effects kernel
windows.ole32 parser lexer splitting grouping sequences
namespaces assocs quotations generalizations accessors words
-macros alien.syntax fry arrays layouts math ;
+macros alien.syntax fry arrays layouts math classes.struct
+windows.kernel32 prettyprint.custom prettyprint.sections ;
IN: windows.com.syntax
<PRIVATE
@@ -100,3 +101,5 @@ SYNTAX: COM-INTERFACE:
define-words-for-com-interface ;
SYNTAX: GUID: scan string>guid parsed ;
+
+M: GUID pprint* guid>string "GUID: " prepend text ;
diff --git a/basis/windows/com/wrapper/wrapper.factor b/basis/windows/com/wrapper/wrapper.factor
index afa3abf287..3d78ccc849 100755
--- a/basis/windows/com/wrapper/wrapper.factor
+++ b/basis/windows/com/wrapper/wrapper.factor
@@ -48,7 +48,7 @@ unless
: (make-query-interface) ( interfaces -- quot )
(query-interface-cases)
'[
- swap 16 memory>byte-array
+ swap GUID memory>struct
_ case
[
"void*" heap-size * rot <displaced-alien> com-add-ref
diff --git a/basis/windows/ole32/ole32-tests.factor b/basis/windows/ole32/ole32-tests.factor
index ecd25738b1..aa02211ef3 100644
--- a/basis/windows/ole32/ole32-tests.factor
+++ b/basis/windows/ole32/ole32-tests.factor
@@ -1,4 +1,5 @@
-USING: kernel tools.test windows.ole32 alien.c-types ;
+USING: kernel tools.test windows.ole32 alien.c-types
+classes.struct specialized-arrays.uchar windows.kernel32 ;
IN: windows.ole32.tests
[ t ] [
@@ -19,17 +20,9 @@ IN: windows.ole32.tests
guid=
] unit-test
-little-endian?
-[ B{
- HEX: 67 HEX: 45 HEX: 23 HEX: 01 HEX: ab HEX: 89 HEX: ef HEX: cd
- HEX: 01 HEX: 23 HEX: 45 HEX: 67 HEX: 89 HEX: ab HEX: cd HEX: ef
-} ]
-[ B{
- HEX: 01 HEX: 23 HEX: 45 HEX: 67 HEX: 89 HEX: ab HEX: cd HEX: ef
- HEX: 01 HEX: 23 HEX: 45 HEX: 67 HEX: 89 HEX: ab HEX: cd HEX: ef
-} ] ?
-[ "{01234567-89ab-cdef-0123-456789abcdef}" string>guid ]
-unit-test
+[
+ GUID: 01234567-89ab-cdef-0123-456789abcdef}
+] [ "{01234567-89ab-cdef-0123-456789abcdef}" string>guid ] unit-test
[ "{01234567-89ab-cdef-0123-456789abcdef}" ]
[ "{01234567-89ab-cdef-0123-456789abcdef}" string>guid guid>string ]
diff --git a/basis/windows/ole32/ole32.factor b/basis/windows/ole32/ole32.factor
index 37a3a90d3b..0942123504 100755
--- a/basis/windows/ole32/ole32.factor
+++ b/basis/windows/ole32/ole32.factor
@@ -143,9 +143,9 @@ CONSTANT: GUID-STRING-LENGTH
: guid>string ( guid -- string )
[
[ "{" ] dip {
- [ Data1>> >hex "-" ]
- [ Data2>> >hex "-" ]
- [ Data3>> >hex "-" ]
+ [ Data1>> >hex 8 CHAR: 0 pad-head "-" ]
+ [ Data2>> >hex 4 CHAR: 0 pad-head "-" ]
+ [ Data3>> >hex 4 CHAR: 0 pad-head "-" ]
[
Data4>> [
{
From a81c78e4851cc3a7f5028e952b7c46ec2801e525 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 29 Aug 2009 19:25:18 -0500
Subject: [PATCH 16/26] WSABUF struct
---
basis/io/sockets/windows/nt/nt.factor | 19 +++++++++----------
basis/windows/winsock/winsock.factor | 6 +++---
2 files changed, 12 insertions(+), 13 deletions(-)
diff --git a/basis/io/sockets/windows/nt/nt.factor b/basis/io/sockets/windows/nt/nt.factor
index 6d082f953c..6780fdcdd6 100755
--- a/basis/io/sockets/windows/nt/nt.factor
+++ b/basis/io/sockets/windows/nt/nt.factor
@@ -2,7 +2,8 @@ USING: alien alien.accessors alien.c-types byte-arrays
continuations destructors io.ports io.timeouts io.sockets
io namespaces io.streams.duplex io.backend.windows
io.sockets.windows io.backend.windows.nt windows.winsock kernel
-libc math sequences threads system combinators accessors ;
+libc math sequences threads system combinators accessors
+classes.struct ;
IN: io.sockets.windows.nt
: malloc-int ( object -- object )
@@ -127,9 +128,9 @@ TUPLE: WSARecvFrom-args port
lpFlags lpFrom lpFromLen lpOverlapped lpCompletionRoutine ;
: make-receive-buffer ( -- WSABUF )
- "WSABUF" malloc-object &free
- default-buffer-size get over set-WSABUF-len
- default-buffer-size get malloc &free over set-WSABUF-buf ; inline
+ WSABUF malloc-struct &free
+ default-buffer-size get
+ [ >>len ] [ malloc &free >>buf ] bi ; inline
: <WSARecvFrom-args> ( datagram -- WSARecvFrom )
WSARecvFrom-args new
@@ -158,7 +159,7 @@ TUPLE: WSARecvFrom-args port
} cleave WSARecvFrom socket-error* ; inline
: parse-WSARecvFrom ( n WSARecvFrom -- packet sockaddr )
- [ lpBuffers>> WSABUF-buf swap memory>byte-array ]
+ [ lpBuffers>> buf>> swap memory>byte-array ]
[ [ lpFrom>> ] [ lpFromLen>> *int ] bi memory>byte-array ] bi ; inline
M: winnt (receive) ( datagram -- packet addrspec )
@@ -175,11 +176,9 @@ TUPLE: WSASendTo-args port
dwFlags lpTo iToLen lpOverlapped lpCompletionRoutine ;
: make-send-buffer ( packet -- WSABUF )
- "WSABUF" malloc-object &free
- [ [ malloc-byte-array &free ] dip set-WSABUF-buf ]
- [ [ length ] dip set-WSABUF-len ]
- [ nip ]
- 2tri ; inline
+ [ WSABUF malloc-struct &free ] dip
+ [ malloc-byte-array &free >>buf ]
+ [ length >>len ] bi ; inline
: <WSASendTo-args> ( packet addrspec datagram -- WSASendTo )
WSASendTo-args new
diff --git a/basis/windows/winsock/winsock.factor b/basis/windows/winsock/winsock.factor
index bd7304cde1..d19e4aca09 100755
--- a/basis/windows/winsock/winsock.factor
+++ b/basis/windows/winsock/winsock.factor
@@ -195,9 +195,9 @@ C-STRUCT: FLOWSPEC
TYPEDEF: FLOWSPEC* PFLOWSPEC
TYPEDEF: FLOWSPEC* LPFLOWSPEC
-C-STRUCT: WSABUF
- { "ulong" "len" }
- { "void*" "buf" } ;
+STRUCT: WSABUF
+ { len ulong }
+ { buf void* } ;
TYPEDEF: WSABUF* LPWSABUF
C-STRUCT: QOS
From 57673db7caf46f91e87b00e17912bcc6bcb8b6ed Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 29 Aug 2009 19:33:04 -0500
Subject: [PATCH 17/26] remove com-interface c-struct
---
basis/windows/com/syntax/syntax.factor | 7 ++-----
1 file changed, 2 insertions(+), 5 deletions(-)
diff --git a/basis/windows/com/syntax/syntax.factor b/basis/windows/com/syntax/syntax.factor
index 56ae0aa71c..d380b1ba83 100755
--- a/basis/windows/com/syntax/syntax.factor
+++ b/basis/windows/com/syntax/syntax.factor
@@ -7,13 +7,10 @@ IN: windows.com.syntax
<PRIVATE
-C-STRUCT: com-interface
- { "void*" "vtbl" } ;
-
MACRO: com-invoke ( n return parameters -- )
[ 2nip length ] 3keep
'[
- _ npick com-interface-vtbl _ cell * alien-cell _ _
+ _ npick *void* _ cell * alien-cell _ _
"stdcall" alien-indirect
] ;
@@ -32,7 +29,7 @@ unless
dup "f" = [ drop f ] [
dup +com-interface-definitions+ get-global at*
[ nip ]
- [ swap " COM interface hasn't been defined" append throw ]
+ [ " COM interface hasn't been defined" prepend throw ]
if
] if ;
From dedc1eb0cbe3dcec1f45466ed01ba82623f1b351 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 29 Aug 2009 19:43:56 -0500
Subject: [PATCH 18/26] more WIN32_FIND_DATA structs
---
basis/io/directories/windows/windows.factor | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/basis/io/directories/windows/windows.factor b/basis/io/directories/windows/windows.factor
index d1931526bd..3a69dbfedb 100755
--- a/basis/io/directories/windows/windows.factor
+++ b/basis/io/directories/windows/windows.factor
@@ -4,7 +4,7 @@ USING: system io.directories io.encodings.utf16n alien.strings
io.pathnames io.backend io.files.windows destructors
kernel accessors calendar windows windows.errors
windows.kernel32 alien.c-types sequences splitting
-fry continuations ;
+fry continuations classes.struct ;
IN: io.directories.windows
M: windows touch-file ( path -- )
@@ -33,12 +33,12 @@ M: windows delete-directory ( path -- )
RemoveDirectory win32-error=0/f ;
: find-first-file ( path -- WIN32_FIND_DATA handle )
- "WIN32_FIND_DATA" <c-object>
+ WIN32_FIND_DATA <struct>
[ nip ] [ FindFirstFile ] 2bi
[ INVALID_HANDLE_VALUE = [ win32-error-string throw ] when ] keep ;
: find-next-file ( path -- WIN32_FIND_DATA/f )
- "WIN32_FIND_DATA" <c-object>
+ WIN32_FIND_DATA <struct>
[ nip ] [ FindNextFile ] 2bi 0 = [
GetLastError ERROR_NO_MORE_FILES = [
win32-error
From 0be2e172467a637adbccc63a6e548a3c893e767f Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 29 Aug 2009 19:55:27 -0500
Subject: [PATCH 19/26] put a method on M\ tuple string>alien that calls
underlying>>
---
core/alien/strings/strings.factor | 2 ++
1 file changed, 2 insertions(+)
diff --git a/core/alien/strings/strings.factor b/core/alien/strings/strings.factor
index ff20b8b033..e96b13478e 100644
--- a/core/alien/strings/strings.factor
+++ b/core/alien/strings/strings.factor
@@ -35,6 +35,8 @@ M: string string>alien
[ stream>> >byte-array ]
tri ;
+M: tuple string>alien drop underlying>> ;
+
HOOK: alien>native-string os ( alien -- string )
M: windows alien>native-string utf16n alien>string ;
From e5b72af4037f1072f3c75f0fb29ebf6018dc94dc Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 29 Aug 2009 20:01:01 -0500
Subject: [PATCH 20/26] fix environment on winnt
---
basis/environment/winnt/winnt.factor | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git a/basis/environment/winnt/winnt.factor b/basis/environment/winnt/winnt.factor
index eb90a36ee7..d4ce25397c 100644
--- a/basis/environment/winnt/winnt.factor
+++ b/basis/environment/winnt/winnt.factor
@@ -6,8 +6,10 @@ alien.c-types sequences windows.errors io.streams.memory
io.encodings io ;
IN: environment.winnt
+<< "TCHAR" require-c-type-arrays >>
+
M: winnt os-env ( key -- value )
- MAX_UNICODE_PATH "TCHAR" <c-array>
+ MAX_UNICODE_PATH "TCHAR" <c-type-array>
[ dup length GetEnvironmentVariable ] keep over 0 = [
2drop f
] [
From 6e4ec190dfc5bd3689c23362e8e70d513e54dd17 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 29 Aug 2009 20:34:29 -0500
Subject: [PATCH 21/26] remove c-array usage
---
basis/io/files/info/windows/windows.factor | 5 +++--
1 file changed, 3 insertions(+), 2 deletions(-)
diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor
index 684df6191e..052f5058d2 100755
--- a/basis/io/files/info/windows/windows.factor
+++ b/basis/io/files/info/windows/windows.factor
@@ -5,7 +5,8 @@ io.files.windows io.files.windows.nt kernel windows.kernel32
windows.time windows accessors alien.c-types combinators
generalizations system alien.strings io.encodings.utf16n
sequences splitting windows.errors fry continuations destructors
-calendar ascii combinators.short-circuit locals classes.struct ;
+calendar ascii combinators.short-circuit locals classes.struct
+specialized-arrays.ushort ;
IN: io.files.info.windows
:: round-up-to ( n multiple -- n' )
@@ -144,7 +145,7 @@ M: winnt file-system-info ( path -- file-system-info )
calculate-file-system-info ;
: volume>paths ( string -- array )
- 16384 "ushort" <c-array> tuck dup length
+ 16384 <ushort-array> tuck dup length
0 <uint> dup [ GetVolumePathNamesForVolumeName 0 = ] dip swap [
win32-error-string throw
] [
From a5c078213a87d9ffe8fee83341f4b98afc1d52bb Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 29 Aug 2009 20:39:06 -0500
Subject: [PATCH 22/26] more struct work
---
basis/io/files/windows/nt/nt.factor | 12 +++++-------
basis/windows/kernel32/kernel32.factor | 14 +++++++-------
2 files changed, 12 insertions(+), 14 deletions(-)
diff --git a/basis/io/files/windows/nt/nt.factor b/basis/io/files/windows/nt/nt.factor
index 32424a37a3..17cfa0977e 100755
--- a/basis/io/files/windows/nt/nt.factor
+++ b/basis/io/files/windows/nt/nt.factor
@@ -5,19 +5,18 @@ windows.kernel32 kernel libc math threads system environment
alien.c-types alien.arrays alien.strings sequences combinators
combinators.short-circuit ascii splitting alien strings assocs
namespaces make accessors tr windows.time windows.shell32
-windows.errors ;
+windows.errors specialized-arrays.ushort classes.struct ;
IN: io.files.windows.nt
M: winnt cwd
- MAX_UNICODE_PATH dup "ushort" <c-array>
+ MAX_UNICODE_PATH dup <ushort-array>
[ GetCurrentDirectory win32-error=0/f ] keep
utf16n alien>string ;
M: winnt cd
SetCurrentDirectory win32-error=0/f ;
-: unicode-prefix ( -- seq )
- "\\\\?\\" ; inline
+CONSTANT: unicode-prefix "\\\\?\\"
M: winnt root-directory? ( path -- ? )
{
@@ -48,10 +47,9 @@ M: winnt CreateFile-flags ( DWORD -- DWORD )
<PRIVATE
: windows-file-size ( path -- size )
- normalize-path 0 "WIN32_FILE_ATTRIBUTE_DATA" <c-object>
+ normalize-path 0 WIN32_FILE_ATTRIBUTE_DATA <struct>
[ GetFileAttributesEx win32-error=0/f ] keep
- [ WIN32_FILE_ATTRIBUTE_DATA-nFileSizeLow ]
- [ WIN32_FILE_ATTRIBUTE_DATA-nFileSizeHigh ] bi >64bit ;
+ [ nFileSizeLow>> ] [ nFileSizeHigh>> ] bi >64bit ;
PRIVATE>
diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor
index 2182088efe..f4d6038954 100755
--- a/basis/windows/kernel32/kernel32.factor
+++ b/basis/windows/kernel32/kernel32.factor
@@ -660,13 +660,13 @@ C-STRUCT: TOKEN_PRIVILEGES
{ "LUID_AND_ATTRIBUTES*" "Privileges" } ;
TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
-C-STRUCT: WIN32_FILE_ATTRIBUTE_DATA
- { "DWORD" "dwFileAttributes" }
- { "FILETIME" "ftCreationTime" }
- { "FILETIME" "ftLastAccessTime" }
- { "FILETIME" "ftLastWriteTime" }
- { "DWORD" "nFileSizeHigh" }
- { "DWORD" "nFileSizeLow" } ;
+STRUCT: WIN32_FILE_ATTRIBUTE_DATA
+ { dwFileAttributes DWORD }
+ { ftCreationTime FILETIME }
+ { ftLastAccessTime FILETIME }
+ { ftLastWriteTime FILETIME }
+ { nFileSizeHigh DWORD }
+ { nFileSizeLow DWORD } ;
TYPEDEF: WIN32_FILE_ATTRIBUTE_DATA* LPWIN32_FILE_ATTRIBUTE_DATA
C-STRUCT: BY_HANDLE_FILE_INFORMATION
From d2dd2066380f39de31cfd8de9053e63e270fed6b Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 29 Aug 2009 20:43:07 -0500
Subject: [PATCH 23/26] remove c-array usage
---
basis/windows/errors/errors.factor | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git a/basis/windows/errors/errors.factor b/basis/windows/errors/errors.factor
index 8bdbb9f1e9..ea9c297c44 100644
--- a/basis/windows/errors/errors.factor
+++ b/basis/windows/errors/errors.factor
@@ -696,6 +696,8 @@ CONSTANT: FORMAT_MESSAGE_MAX_WIDTH_MASK HEX: 000000FF
: make-lang-id ( lang1 lang2 -- n )
10 shift bitor ; inline
+<< "TCHAR" require-c-type-arrays >>
+
ERROR: error-message-failed id ;
:: n>win32-error-string ( id -- string )
{
@@ -705,7 +707,7 @@ ERROR: error-message-failed id ;
f
id
LANG_NEUTRAL SUBLANG_DEFAULT make-lang-id
- 32768 [ "TCHAR" <c-array> ] keep
+ 32768 [ "TCHAR" <c-type-array> ] [ ] bi
f pick [ FormatMessage 0 = [ id error-message-failed ] when ] dip
utf16n alien>string [ blank? ] trim ;
From fb3fa1f7971e90ee4dafd230f08ba6e63f55277f Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 29 Aug 2009 20:52:14 -0500
Subject: [PATCH 24/26] remove dead code, use ${ and GUID:, structs
---
basis/io/sockets/windows/nt/nt.factor | 4 ++--
basis/windows/shell32/shell32.factor | 4 ++--
basis/windows/winsock/winsock.factor | 29 +++++++++------------------
3 files changed, 14 insertions(+), 23 deletions(-)
diff --git a/basis/io/sockets/windows/nt/nt.factor b/basis/io/sockets/windows/nt/nt.factor
index 6780fdcdd6..1bb5e0d102 100755
--- a/basis/io/sockets/windows/nt/nt.factor
+++ b/basis/io/sockets/windows/nt/nt.factor
@@ -3,7 +3,7 @@ continuations destructors io.ports io.timeouts io.sockets
io namespaces io.streams.duplex io.backend.windows
io.sockets.windows io.backend.windows.nt windows.winsock kernel
libc math sequences threads system combinators accessors
-classes.struct ;
+classes.struct windows.kernel32 ;
IN: io.sockets.windows.nt
: malloc-int ( object -- object )
@@ -15,7 +15,7 @@ M: winnt WSASocket-flags ( -- DWORD )
: get-ConnectEx-ptr ( socket -- void* )
SIO_GET_EXTENSION_FUNCTION_POINTER
WSAID_CONNECTEX
- "GUID" heap-size
+ GUID heap-size
"void*" <c-object>
[
"void*" heap-size
diff --git a/basis/windows/shell32/shell32.factor b/basis/windows/shell32/shell32.factor
index 016f5ab149..635c59a692 100644
--- a/basis/windows/shell32/shell32.factor
+++ b/basis/windows/shell32/shell32.factor
@@ -3,7 +3,7 @@
USING: alien alien.c-types alien.strings alien.syntax
combinators io.encodings.utf16n io.files io.pathnames kernel
windows.errors windows.com windows.com.syntax windows.user32
-windows.ole32 windows ;
+windows.ole32 windows specialized-arrays.ushort ;
IN: windows.shell32
CONSTANT: CSIDL_DESKTOP HEX: 00
@@ -90,7 +90,7 @@ ALIAS: ShellExecute ShellExecuteW
: shell32-directory ( n -- str )
f swap f SHGFP_TYPE_DEFAULT
- MAX_UNICODE_PATH "ushort" <c-array>
+ MAX_UNICODE_PATH <ushort-array>
[ SHGetFolderPath drop ] keep utf16n alien>string ;
: desktop ( -- str )
diff --git a/basis/windows/winsock/winsock.factor b/basis/windows/winsock/winsock.factor
index d19e4aca09..74f67a4924 100755
--- a/basis/windows/winsock/winsock.factor
+++ b/basis/windows/winsock/winsock.factor
@@ -2,7 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings alien.syntax arrays
byte-arrays kernel math sequences windows.types windows.kernel32
-windows.errors math.bitwise io.encodings.utf16n classes.struct ;
+windows.errors math.bitwise io.encodings.utf16n classes.struct
+literals windows.com.syntax ;
IN: windows.winsock
USE: libc
@@ -121,12 +122,12 @@ C-STRUCT: sockaddr-in6
{ { "uchar" 16 } "addr" }
{ "uint" "scopeid" } ;
-C-STRUCT: hostent
- { "char*" "name" }
- { "void*" "aliases" }
- { "short" "addrtype" }
- { "short" "length" }
- { "void*" "addr-list" } ;
+STRUCT: hostent
+ { name char* }
+ { aliases void* }
+ { addrtype short }
+ { length short }
+ { addr-list void* } ;
C-STRUCT: addrinfo
{ "int" "flags" }
@@ -142,11 +143,8 @@ C-STRUCT: timeval
{ "long" "sec" }
{ "long" "usec" } ;
-: hostent-addr ( hostent -- addr ) hostent-addr-list *void* ; ! *uint ;
-
LIBRARY: winsock
-
FUNCTION: int setsockopt ( SOCKET s, int level, int optname, char* optval, int optlen ) ;
FUNCTION: ushort htons ( ushort n ) ;
@@ -385,17 +383,10 @@ FUNCTION: void GetAcceptExSockaddrs ( void* a, int b, int c, int d, void* e, voi
CONSTANT: SIO_GET_EXTENSION_FUNCTION_POINTER -939524090
-: WSAID_CONNECTEX ( -- GUID )
- HEX: 25a207b9
- HEX: ddf3
- HEX: 4660
- B{
- HEX: 8e HEX: e9 HEX: 76 HEX: e5
- HEX: 8c HEX: 74 HEX: 06 HEX: 3e
- } GUID <struct-boa> ;
+CONSTANT: WSAID_CONNECTEX GUID: {25a207b9-ddf3-4660-8ee9-76e58c74063e}
: winsock-expected-error? ( n -- ? )
- ERROR_IO_PENDING ERROR_SUCCESS WSA_IO_PENDING 3array member? ;
+ ${ ERROR_IO_PENDING ERROR_SUCCESS WSA_IO_PENDING } member? ;
: (winsock-error-string) ( n -- str )
! #! WSAStartup returns the error code 'n' directly
From e837a5cea8db17cdb6601466d1e858b62d051171 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 29 Aug 2009 20:56:39 -0500
Subject: [PATCH 25/26] structs in windows.shell32
---
basis/windows/shell32/shell32.factor | 28 ++++++++++++++--------------
1 file changed, 14 insertions(+), 14 deletions(-)
diff --git a/basis/windows/shell32/shell32.factor b/basis/windows/shell32/shell32.factor
index 635c59a692..15ddc1a5df 100644
--- a/basis/windows/shell32/shell32.factor
+++ b/basis/windows/shell32/shell32.factor
@@ -3,7 +3,7 @@
USING: alien alien.c-types alien.strings alien.syntax
combinators io.encodings.utf16n io.files io.pathnames kernel
windows.errors windows.com windows.com.syntax windows.user32
-windows.ole32 windows specialized-arrays.ushort ;
+windows.ole32 windows specialized-arrays.ushort classes.struct ;
IN: windows.shell32
CONSTANT: CSIDL_DESKTOP HEX: 00
@@ -167,23 +167,23 @@ CONSTANT: SFGAO_NEWCONTENT HEX: 00200000
TYPEDEF: ULONG SFGAOF
-C-STRUCT: DROPFILES
- { "DWORD" "pFiles" }
- { "POINT" "pt" }
- { "BOOL" "fNC" }
- { "BOOL" "fWide" } ;
+STRUCT: DROPFILES
+ { pFiles DWORD }
+ { pt POINT }
+ { fNC BOOL }
+ { fWide BOOL } ;
TYPEDEF: DROPFILES* LPDROPFILES
TYPEDEF: DROPFILES* LPCDROPFILES
TYPEDEF: HANDLE HDROP
-C-STRUCT: SHITEMID
- { "USHORT" "cb" }
- { "BYTE[1]" "abID" } ;
+STRUCT: SHITEMID
+ { cb USHORT }
+ { abID BYTE[1] } ;
TYPEDEF: SHITEMID* LPSHITEMID
TYPEDEF: SHITEMID* LPCSHITEMID
-C-STRUCT: ITEMIDLIST
- { "SHITEMID" "mkid" } ;
+STRUCT: ITEMIDLIST
+ { mkid SHITEMID } ;
TYPEDEF: ITEMIDLIST* LPITEMIDLIST
TYPEDEF: ITEMIDLIST* LPCITEMIDLIST
TYPEDEF: ITEMIDLIST ITEMID_CHILD
@@ -195,9 +195,9 @@ CONSTANT: STRRET_OFFSET 1
CONSTANT: STRRET_CSTR 2
C-UNION: STRRET-union "LPWSTR" "LPSTR" "UINT" "char[260]" ;
-C-STRUCT: STRRET
- { "int" "uType" }
- { "STRRET-union" "union" } ;
+STRUCT: STRRET
+ { uType int }
+ { union STRRET-union } ;
COM-INTERFACE: IEnumIDList IUnknown {000214F2-0000-0000-C000-000000000046}
HRESULT Next ( ULONG celt, LPITEMIDLIST* rgelt, ULONG* pceltFetched )
From fb9d7d67d0c34cc4a3ffe60bbaf43579775adad0 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 29 Aug 2009 23:25:17 -0500
Subject: [PATCH 26/26] use struct in windows serial code
---
extra/io/serial/windows/windows.factor | 5 +++--
1 file changed, 3 insertions(+), 2 deletions(-)
diff --git a/extra/io/serial/windows/windows.factor b/extra/io/serial/windows/windows.factor
index 2d27a489ef..551fd16b33 100755
--- a/extra/io/serial/windows/windows.factor
+++ b/extra/io/serial/windows/windows.factor
@@ -2,7 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: io.files.windows io.streams.duplex kernel math
math.bitwise windows.kernel32 accessors alien.c-types
-windows io.files.windows fry locals continuations ;
+windows io.files.windows fry locals continuations
+classes.struct ;
IN: io.serial.windows
: <serial-stream> ( path encoding -- duplex )
@@ -10,7 +11,7 @@ IN: io.serial.windows
: get-comm-state ( duplex -- dcb )
in>> handle>>
- "DCB" <c-object> tuck
+ DCB <struct> tuck
GetCommState win32-error=0/f ;
: set-comm-state ( duplex dcb -- )