]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' of git://factorcode.org/git/factor
authorDoug Coleman <doug.coleman@gmail.com>
Sat, 29 Aug 2009 20:29:34 +0000 (15:29 -0500)
committerDoug Coleman <doug.coleman@gmail.com>
Sat, 29 Aug 2009 20:29:34 +0000 (15:29 -0500)
12 files changed:
basis/calendar/windows/windows.factor
basis/game-input/dinput/dinput.factor
basis/io/directories/windows/windows.factor
basis/io/files/info/windows/windows.factor
basis/io/monitors/windows/nt/nt.factor
basis/ui/backend/windows/windows.factor
basis/windows/fonts/fonts.factor
basis/windows/kernel32/kernel32.factor
basis/windows/types/types-tests.factor [new file with mode: 0755]
basis/windows/types/types.factor
basis/windows/uniscribe/uniscribe.factor
basis/windows/user32/user32.factor

index caab530a23fb798437af2d216567a0e99e1ee36f..65c922f1197e9efbea67cdcc9d0e17af809c442c 100644 (file)
@@ -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 ;
index 6cd161bd28686e3dbaf36fa03e2b25dbeb5013a7..26d57871d72daa0e684f5ccbc32b6779ff3785fe 100755 (executable)
@@ -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
index 7554baa944d9728980479779b97d070b0f289986..d1931526bd3d8d4fc8e141f5161ed5d6c0517945 100755 (executable)
@@ -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 )
index 587747ac34c24ae0de89a7dcee0752449d476a96..684df6191ed0adb59de0333fd1621387fc75f258 100755 (executable)
@@ -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
index bec249c04c70bf7adfa9a5b0c1170ff0bf903504..3d837d79d8bc67d2675b7e3e327a2f75620aefbd 100755 (executable)
@@ -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 )
@@ -55,17 +55,14 @@ 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 )
+    FILE_NOTIFY_INFORMATION memory>struct
     dup ,
-    dup FILE_NOTIFY_INFORMATION-NextEntryOffset zero? [
-        [ FILE_NOTIFY_INFORMATION-NextEntryOffset ] keep <displaced-alien>
+    dup NextEntryOffset>> zero? [
+        [ NextEntryOffset>> ] [ >c-ptr <displaced-alien> ] bi
         (file-notify-records)
     ] unless ;
 
index 7ce9afe5e64e716bdd04b42f97ae00c8a52798b4..cf4966b75606f352597eaea92cebbb499b3d9038 100755 (executable)
@@ -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
@@ -503,14 +505,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 ;
 
@@ -588,19 +591,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
-
-        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 ;
 
@@ -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 [
@@ -749,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
index 269e8f8f489297c0aa12d487c0cc21164f9acfc9..b8acf5d8d1ab9f31d390b6b1de787e137c70f5b6 100755 (executable)
@@ -1,37 +1,37 @@
-USING: assocs memoize locals kernel accessors init fonts math\r
-combinators windows.errors windows.types windows.gdi32 ;\r
-IN: windows.fonts\r
-\r
-: windows-font-name ( string -- string' )\r
-    H{\r
-        { "sans-serif" "Tahoma" }\r
-        { "serif" "Times New Roman" }\r
-        { "monospace" "Courier New" }\r
-    } ?at drop ;\r
-    \r
-MEMO:: (cache-font) ( font -- HFONT )\r
-    font size>> neg ! nHeight\r
-    0 0 0 ! nWidth, nEscapement, nOrientation\r
-    font bold?>> FW_BOLD FW_NORMAL ? ! fnWeight\r
-    font italic?>> TRUE FALSE ? ! fdwItalic\r
-    FALSE ! fdwUnderline\r
-    FALSE ! fdWStrikeOut\r
-    DEFAULT_CHARSET ! fdwCharSet\r
-    OUT_OUTLINE_PRECIS ! fdwOutputPrecision\r
-    CLIP_DEFAULT_PRECIS ! fdwClipPrecision\r
-    DEFAULT_QUALITY ! fdwQuality\r
-    DEFAULT_PITCH ! fdwPitchAndFamily\r
-    font name>> windows-font-name\r
-    CreateFont\r
-    dup win32-error=0/f ;\r
-\r
-: cache-font ( font -- HFONT ) strip-font-colors (cache-font) ;\r
-\r
-[ \ (cache-font) reset-memoized ] "windows.fonts" add-init-hook\r
-\r
-: TEXTMETRIC>metrics ( TEXTMETRIC -- metrics )\r
-    [ metrics new 0 >>width ] dip {\r
-        [ TEXTMETRICW-tmHeight >>height ]\r
-        [ TEXTMETRICW-tmAscent >>ascent ]\r
-        [ TEXTMETRICW-tmDescent >>descent ]\r
-    } cleave ;\r
+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 ;
index 50a03945f3e579c099e8c24d5058c12f580bb088..1adb07cf1e1db0813836dc7186b02cce1e815691 100755 (executable)
@@ -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
@@ -226,14 +227,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 }
@@ -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 }
diff --git a/basis/windows/types/types-tests.factor b/basis/windows/types/types-tests.factor
new file mode 100755 (executable)
index 0000000..04b480d
--- /dev/null
@@ -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
index 36823db424386673cf1502f6e42c10af8c10ef6a..c62de58bcd64925ca79e0a18cac27e3b6ff42705 100755 (executable)
@@ -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
@@ -216,37 +216,37 @@ 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" } ;
-
-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" }
@@ -329,19 +329,10 @@ STRUCT: PIXELFORMATDESCRIPTOR
     { 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
@@ -389,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
index 457f4bc9f017e59e3301d976f16c2376fc2457b2..7dd630ca5b1ad5f3d27c50f8991657c56b16f033 100755 (executable)
@@ -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 ;
 
index 58981920dad45994febffba90dd7719aedea114d..4c39385ce5b239c7c513929d312705efd694971c 100755 (executable)
@@ -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
 
@@ -521,11 +524,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
@@ -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