]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/windows/types/types.factor
fix windows test failures
[factor.git] / basis / windows / types / types.factor
index 062196c3f88183d72f01d3a34f57986717c4bad9..bac9ebf3725c4f3c8999e6a706ea3413125cd825 100755 (executable)
@@ -1,7 +1,9 @@
 ! Copyright (C) 2005, 2006 Doug Coleman.
 ! 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 ;
+sequences math math.bitwise math.vectors colors
+io.encodings.utf16n classes.struct accessors ;
+FROM: alien.c-types => float short ;
 IN: windows.types
 
 TYPEDEF: char                CHAR
@@ -9,6 +11,12 @@ TYPEDEF: uchar               UCHAR
 TYPEDEF: uchar               BYTE
 
 TYPEDEF: ushort              wchar_t
+SYMBOL: wchar_t*
+<<
+{ char* utf16n } \ wchar_t* typedef
+wchar_t wchar_t* "pointer-c-type" set-word-prop
+>>
+
 TYPEDEF: wchar_t             WCHAR
 
 TYPEDEF: short               SHORT
@@ -213,132 +221,120 @@ 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" } ;
-
-C-STRUCT: PAINTSTRUCT
-    { "HDC" " hdc" }
-    { "BOOL" "fErase" }
-    { "RECT" "rcPaint" }
-    { "BOOL" "fRestore" }
-    { "BOOL" "fIncUpdate" }
-    { "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" } ;
-
-C-STRUCT: RGBQUAD
-    { "BYTE" "rgbBlue" }
-    { "BYTE" "rgbGreen" }
-    { "BYTE" "rgbRed" }
-    { "BYTE" "rgbReserved" } ;
-
-C-STRUCT: BITMAPINFO
-    { "BITMAPINFOHEADER" "bmiHeader" }
-    { "RGBQUAD[1]" "bmiColors" } ;
+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 } ;
+
+STRUCT: PAINTSTRUCT
+    { hdc HDC }
+    { fErase BOOL }
+    { rcPaint RECT }
+    { fRestore BOOL }
+    { fIncUpdate BOOL }
+    { rgbReserved BYTE[32] } ;
+
+STRUCT: BITMAPINFOHEADER
+    { biSize DWORD }
+    { biWidth LONG }
+    { biHeight LONG }
+    { biPlanes WORD }
+    { biBitCount WORD }
+    { biCompression DWORD }
+    { biSizeImage DWORD }
+    { biXPelsPerMeter LONG }
+    { biYPelsPerMeter LONG }
+    { biClrUsed DWORD }
+    { biClrImportant DWORD } ;
+
+STRUCT: RGBQUAD
+    { rgbBlue BYTE }
+    { rgbGreen BYTE }
+    { rgbRed BYTE }
+    { rgbReserved BYTE } ;
+
+STRUCT: BITMAPINFO
+    { bmiHeader BITMAPINFOHEADER }
+    { bimColors RGBQUAD[1] } ;
 
 TYPEDEF: void* LPPAINTSTRUCT
 TYPEDEF: void* PAINTSTRUCT
 
-C-STRUCT: POINT
-    { "LONG" "x" }
-    { "LONG" "y" } ; 
+STRUCT: POINT
+    { x LONG }
+    { y LONG } ; 
 
-C-STRUCT: SIZE
-    { "LONG" "cx" }
-    { "LONG" "cy" } ; 
+STRUCT: SIZE
+    { cx LONG }
+    { cy LONG } ;
 
-C-STRUCT: MSG
-    { "HWND" "hWnd" }
-    { "UINT" "message" }
-    { "WPARAM" "wParam" }
-    { "LPARAM" "lParam" }
-    { "DWORD" "time" }
-    { "POINT" "pt" } ;
+STRUCT: MSG
+    { hWnd HWND }
+    { message UINT }
+    { wParam WPARAM }
+    { lParam LPARAM }
+    { time DWORD }
+    { pt POINT } ;
 
 TYPEDEF: MSG*                LPMSG
 
-C-STRUCT: PIXELFORMATDESCRIPTOR
-    { "WORD" "nSize" }
-    { "WORD" "nVersion" }
-    { "DWORD" "dwFlags" }
-    { "BYTE" "iPixelType" }
-    { "BYTE" "cColorBits" }
-    { "BYTE" "cRedBits" }
-    { "BYTE" "cRedShift" }
-    { "BYTE" "cGreenBits" }
-    { "BYTE" "cGreenShift" }
-    { "BYTE" "cBlueBits" }
-    { "BYTE" "cBlueShift" }
-    { "BYTE" "cAlphaBits" }
-    { "BYTE" "cAlphaShift" }
-    { "BYTE" "cAccumBits" }
-    { "BYTE" "cAccumRedBits" }
-    { "BYTE" "cAccumGreenBits" }
-    { "BYTE" "cAccumBlueBits" }
-    { "BYTE" "cAccumAlphaBits" }
-    { "BYTE" "cDepthBits" }
-    { "BYTE" "cStencilBits" }
-    { "BYTE" "cAuxBuffers" }
-    { "BYTE" "iLayerType" }
-    { "BYTE" "bReserved" }
-    { "DWORD" "dwLayerMask" }
-    { "DWORD" "dwVisibleMask" }
-    { "DWORD" "dwDamageMask" } ;
-
-C-STRUCT: RECT
-    { "LONG" "left" }
-    { "LONG" "top" }
-    { "LONG" "right" }
-    { "LONG" "bottom" } ;
+STRUCT: PIXELFORMATDESCRIPTOR
+    { nSize WORD }
+    { nVersion WORD }
+    { dwFlags DWORD }
+    { iPixelType BYTE }
+    { cColorBits BYTE }
+    { cRedBits BYTE }
+    { cRedShift BYTE }
+    { cGreenBits BYTE }
+    { cGreenShift BYTE }
+    { cBlueBits BYTE }
+    { cBlueShift BYTE }
+    { cAlphaBits BYTE }
+    { cAlphaShift BYTE }
+    { cAccumBits BYTE }
+    { cAccumRedBits BYTE }
+    { cAccumGreenBits BYTE }
+    { cAccumBlueBits BYTE }
+    { cAccumAlphaBits BYTE }
+    { cDepthBits BYTE }
+    { cStencilBits BYTE }
+    { cAuxBuffers BYTE }
+    { iLayerType BYTE }
+    { bReserved BYTE }
+    { dwLayerMask DWORD }
+    { dwVisibleMask DWORD }
+    { dwDamageMask DWORD } ;
 
 : <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 ;
+    dupd v+ [ first2 ] bi@ RECT <struct-boa> ;
 
 TYPEDEF: RECT* PRECT
 TYPEDEF: RECT* LPRECT
@@ -347,34 +343,34 @@ TYPEDEF: PFD* LPPFD
 TYPEDEF: HANDLE HGLRC
 TYPEDEF: HANDLE HRGN
 
-C-STRUCT: LVITEM
-    { "uint" "mask" }
-    { "int" "iItem" }
-    { "int" "iSubItem" }
-    { "uint" "state" }
-    { "uint" "stateMask" }
-    { "void*" "pszText" }
-    { "int" "cchTextMax" }
-    { "int" "iImage" }
-    { "long" "lParam" }
-    { "int" "iIndent" }
-    { "int" "iGroupId" }
-    { "uint" "cColumns" }
-    { "uint*" "puColumns" }
-    { "int*" "piColFmt" }
-    { "int" "iGroup" } ;
-
-C-STRUCT: LVFINDINFO
-    { "uint" "flags" }
-    { "char*" "psz" }
-    { "long" "lParam" }
-    { "POINT" "pt" }
-    { "uint" "vkDirection" } ;
-
-C-STRUCT: ACCEL
-    { "BYTE" "fVirt" }
-    { "WORD" "key" }
-    { "WORD" "cmd" } ;
+STRUCT: LVITEM
+    { mask uint }
+    { iItem int }
+    { iSubItem int }
+    { state uint }
+    { stateMask uint }
+    { pszText void* }
+    { cchTextMax int }
+    { iImage int }
+    { lParam long }
+    { iIndent int }
+    { iGroupId int }
+    { cColumns uint }
+    { puColumns uint* }
+    { piColFmt int* }
+    { iGroup int } ;
+
+STRUCT: LVFINDINFO
+    { flags uint }
+    { psz char* }
+    { lParam long }
+    { pt POINT }
+    { vkDirection uint } ;
+
+STRUCT: ACCEL
+    { fVirt BYTE }
+    { key WORD }
+    { cmd WORD } ;
 TYPEDEF: ACCEL* LPACCEL
 
 TYPEDEF: DWORD COLORREF
@@ -386,26 +382,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