! Copyright (C) 2005, 2006 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax namespaces kernel words ;
+USING: alien alien.c-types alien.syntax namespaces kernel words
+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
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
TYPEDEF: HANDLE HGLOBAL
TYPEDEF: HANDLE HHOOK
TYPEDEF: HANDLE HINSTANCE
-TYPEDEF: HANDLE HKEY
+TYPEDEF: DWORD HKEY
TYPEDEF: HANDLE HKL
TYPEDEF: HANDLE HLOCAL
TYPEDEF: HANDLE HMENU
TYPEDEF: void* WNDPROC
-: FALSE 0 ; inline
-: TRUE 1 ; inline
+CONSTANT: FALSE 0
+CONSTANT: TRUE 1
-: >BOOLEAN ( ? -- 1/0 ) 1 0 ? ; inline
+: >BOOLEAN ( ? -- 1/0 ) TRUE FALSE ? ; inline
! 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 } ;
+
+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 )
+ dupd v+ [ first2 ] bi@ RECT <struct-boa> ;
TYPEDEF: RECT* PRECT
TYPEDEF: RECT* LPRECT
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
+TYPEDEF: DWORD* LPCOLORREF
+
+: RGB ( r g b -- COLORREF )
+ { 16 8 0 } bitfield ; inline
+
+: color>RGB ( color -- COLORREF )
+ >rgba-components drop [ 255 * >integer ] tri@ RGB ;
+
+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