steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

win32 support for window-controls

Joe Groff 2009-06-18 11:41:34 -05:00
parent c19c0d0395
commit 62ed8d1404
7 changed files with 114 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/game-input/dinput/dinput.factor
View File

@ -190,7 +190,7 @@ TUPLE: window-rect < rect window-loc ;
DBT_DEVTYP_DEVICEINTERFACE over set-DEV_BROADCAST_DEVICEW-dbcc_devicetype ;
: create-device-change-window ( -- )
<zero-window-rect> create-window
<zero-window-rect> WS_OVERLAPPEDWINDOW 0 create-window
[
(device-notification-filter)
DEVICE_NOTIFY_WINDOW_HANDLE DEVICE_NOTIFY_ALL_INTERFACE_CLASSES bitor

21
basis/math/bitwise/bitwise-docs.factor Normal file → Executable file
View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax math sequences ;
USING: assocs help.markup help.syntax math sequences ;
IN: math.bitwise
HELP: bitfield
@ -145,6 +145,25 @@ HELP: flags
}
} ;
HELP: symbols>flags
{ $values { "symbols" sequence } { "assoc" assoc } { "flag-bits" integer } }
{ $description "Constructs an integer value by mapping the values in the " { $snippet "symbols" } " sequence to integer values using " { $snippet "assoc" } " and " { $link bitor } "ing the values together." }
{ $examples
{ $example "USING: math.bitwise prettyprint ui.gadgets.worlds ;"
"IN: scratchpad"
"CONSTANT: window-controls>flags H{"
" { close-button 1 }"
" { minimize-button 2 }"
" { maximize-button 4 }"
" { resize-handles 8 }"
" { small-title-bar 16 }"
" { normal-title-bar 32 }"
"}"
"{ resize-handles close-button small-title-bar } window-controls>flags symbols>flags ."
"25"
}
} ;
HELP: mask
{ $values
{ "x" integer } { "n" integer }

10
basis/math/bitwise/bitwise.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2007, 2008 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel math sequences accessors math.bits
sequences.private words namespaces macros hints
combinators fry io.binary combinators.smart ;
USING: arrays assocs kernel math sequences accessors
math.bits sequences.private words namespaces macros
hints combinators fry io.binary combinators.smart ;
IN: math.bitwise
! utilities
@ -44,6 +44,10 @@ IN: math.bitwise
MACRO: flags ( values -- )
[ 0 ] [ [ ?execute bitor ] curry compose ] reduce ;
: symbols>flags ( symbols assoc -- flag-bits )
[ at ] curry map
0 [ bitor ] reduce ;
! bitfield
<PRIVATE

4
basis/ui/backend/cocoa/cocoa.factor
View File

@ -6,7 +6,7 @@ cocoa.pasteboard cocoa.runtime cocoa.subclassing cocoa.types
cocoa.views cocoa.windows combinators command-line
core-foundation core-foundation.run-loop core-graphics
core-graphics.types destructors fry generalizations io.thread
kernel libc literals locals math math.rectangles memory
kernel libc literals locals math math.bitwise math.rectangles memory
namespaces sequences specialized-arrays.int threads ui
ui.backend ui.backend.cocoa.views ui.clipboards ui.gadgets
ui.gadgets.worlds ui.pixel-formats ui.pixel-formats.private
@ -120,7 +120,7 @@ CONSTANT: window-control>styleMask
}
: world>styleMask ( world -- n )
window-controls>> [ window-control>styleMask at ] map 0 [ bitor ] reduce ;
window-controls>> window-control>styleMask symbols>flags ;
M:: cocoa-ui-backend (open-window) ( world -- )
world [ [ dim>> ] dip <FactorView> ]

73
basis/ui/backend/windows/windows.factor
View File

@ -9,7 +9,7 @@ windows.kernel32 windows.gdi32 windows.user32 windows.opengl32
windows.messages windows.types windows.offscreen windows.nt
threads libc combinators fry combinators.short-circuit continuations
command-line shuffle opengl ui.render math.bitwise locals
accessors math.rectangles math.order calendar ascii
accessors math.rectangles math.order calendar ascii sets
io.encodings.utf16n windows.errors literals ui.pixel-formats
ui.pixel-formats.private memoize classes struct-arrays ;
IN: ui.backend.windows
@ -223,8 +223,36 @@ M: pasteboard set-clipboard-contents drop copy ;
SYMBOLS: msg-obj class-name-ptr mouse-captured ;
: style ( -- n ) WS_OVERLAPPEDWINDOW ; inline
: ex-style ( -- n ) WS_EX_APPWINDOW WS_EX_WINDOWEDGE bitor ; inline
CONSTANT: window-control>style
H{
{ close-button 0 }
{ minimize-button $ WS_MINIMIZEBOX }
{ maximize-button $ WS_MAXIMIZEBOX }
{ resize-handles $ WS_THICKFRAME }
{ small-title-bar $ WS_CAPTION }
{ normal-title-bar $ WS_CAPTION }
}
CONSTANT: window-control>ex-style
H{
{ close-button 0 }
{ minimize-button 0 }
{ maximize-button 0 }
{ resize-handles $ WS_EX_WINDOWEDGE }
{ small-title-bar $ WS_EX_TOOLWINDOW }
{ normal-title-bar $ WS_EX_APPWINDOW }
}
: needs-sysmenu? ( controls -- ? )
{ close-button minimize-button maximize-button } intersects? ;
: world>style ( world -- n )
window-controls>>
[ window-control>style symbols>flags ]
[ needs-sysmenu? [ WS_SYSMENU bitor ] when ] bi ;
: world>ex-style ( world -- n )
window-controls>> window-control>ex-style symbols>flags ;
: get-RECT-top-left ( RECT -- x y )
[ RECT-left ] keep RECT-top ;
@ -571,8 +599,8 @@ M: windows-ui-backend do-events
RegisterClassEx win32-error=0/f
] [ drop ] if ;
: adjust-RECT ( RECT -- )
style 0 ex-style AdjustWindowRectEx win32-error=0/f ;
: adjust-RECT ( RECT style ex-style -- )
[ 0 ] dip AdjustWindowRectEx win32-error=0/f ;
: make-RECT ( world -- RECT )
[ window-loc>> ] [ dim>> ] bi <RECT> ;
@ -584,10 +612,12 @@ M: windows-ui-backend do-events
CW_USEDEFAULT over set-RECT-left
CW_USEDEFAULT swap set-RECT-top ;
: make-adjusted-RECT ( rect -- RECT )
: make-adjusted-RECT ( rect style ex-style -- RECT )
[
make-RECT
dup get-RECT-top-left [ zero? ] both? swap
dup adjust-RECT
dup
] 2dip adjust-RECT
swap [ dup default-position-RECT ] when ;
: get-window-class ( -- class-name )
@ -597,12 +627,12 @@ M: windows-ui-backend do-events
dup
] change-global ;
: create-window ( rect -- hwnd )
make-adjusted-RECT
:: create-window ( rect style ex-style -- hwnd )
rect style ex-style make-adjusted-RECT
[ get-window-class f ] dip
[
[ ex-style ] 2dip
{ WS_CLIPSIBLINGS WS_CLIPCHILDREN style } flags
WS_CLIPSIBLINGS WS_CLIPCHILDREN bitor style bitor
] dip get-RECT-dimensions
f f f GetModuleHandle f CreateWindowEx dup win32-error=0/f ;
@ -636,8 +666,21 @@ M: windows-ui-backend do-events
[ swap [ handle>> hDC>> set-pixel-format ] [ get-rc ] bi ]
with-world-pixel-format ;
: disable-close-button ( hwnd -- )
0 GetSystemMenu
SC_CLOSE MF_BYCOMMAND MF_GRAYED bitor EnableMenuItem drop ;
: ?disable-close-button ( world hwnd -- )
swap window-controls>> close-button swap member? not
[ disable-close-button ] [ drop ] if ;
M: windows-ui-backend (open-window) ( world -- )
[ dup create-window [ f f ] dip f f <win> >>handle setup-gl ]
[
dup
[ ] [ world>style ] [ world>ex-style ] tri create-window
[ ?disable-close-button ]
[ [ f f ] dip f f <win> >>handle setup-gl ] 2bi
]
[ dup handle>> hWnd>> register-window ]
[ handle>> hWnd>> show-window ] tri ;
@ -743,13 +786,9 @@ M: windows-ui-backend (ungrab-input) ( handle -- )
} cleave ;
: exit-fullscreen ( world -- )
handle>> hWnd>>
dup handle>> hWnd>>
{
[
GWL_STYLE GetWindowLong
fullscreen-flags bitor
]
[ GWL_STYLE rot SetWindowLong win32-error=0/f ]
[ GWL_STYLE rot world>style SetWindowLong win32-error=0/f ]
[
f
over hwnd>RECT get-RECT-dimensions

26
basis/windows/user32/user32.factor
View File

@ -582,6 +582,28 @@ CONSTANT: SWP_NOREPOSITION SWP_NOOWNERZORDER
CONSTANT: SWP_DEFERERASE 8192
CONSTANT: SWP_ASYNCWINDOWPOS 16384
CONSTANT: MF_ENABLED HEX: 0000
CONSTANT: MF_GRAYED HEX: 0001
CONSTANT: MF_DISABLED HEX: 0002
CONSTANT: MF_STRING HEX: 0000
CONSTANT: MF_BITMAP HEX: 0004
CONSTANT: MF_UNCHECKED HEX: 0000
CONSTANT: MF_CHECKED HEX: 0008
CONSTANT: MF_POPUP HEX: 0010
CONSTANT: MF_MENUBARBREAK HEX: 0020
CONSTANT: MF_MENUBREAK HEX: 0040
CONSTANT: MF_UNHILITE HEX: 0000
CONSTANT: MF_HILITE HEX: 0080
CONSTANT: MF_OWNERDRAW HEX: 0100
CONSTANT: MF_USECHECKBITMAPS HEX: 0200
CONSTANT: MF_BYCOMMAND HEX: 0000
CONSTANT: MF_BYPOSITION HEX: 0400
CONSTANT: MF_SEPARATOR HEX: 0800
CONSTANT: MF_DEFAULT HEX: 1000
CONSTANT: MF_SYSMENU HEX: 2000
CONSTANT: MF_HELP HEX: 4000
CONSTANT: MF_RIGHTJUSTIFY HEX: 4000
CONSTANT: MF_MOUSESELECT HEX: 8000
LIBRARY: user32
@ -807,7 +829,7 @@ FUNCTION: BOOL DrawIcon ( HDC hDC, int X, int Y, HICON hIcon ) ;
! FUNCTION: DrawTextW
! FUNCTION: EditWndProc
FUNCTION: BOOL EmptyClipboard ( ) ;
! FUNCTION: EnableMenuItem
FUNCTION: BOOL EnableMenuItem ( HMENU hMenu, UINT uIDEnableItem, UINT uEnable ) ;
! FUNCTION: EnableScrollBar
! FUNCTION: EnableWindow
! FUNCTION: EndDeferWindowPos
@ -975,7 +997,7 @@ FUNCTION: int GetPriorityClipboardFormat ( UINT* paFormatPriorityList, int cForm
! FUNCTION: GetSubMenu
! FUNCTION: GetSysColor
FUNCTION: HBRUSH GetSysColorBrush ( int nIndex ) ;
! FUNCTION: GetSystemMenu
FUNCTION: HMENU GetSystemMenu ( HWND hWnd, BOOL bRevert ) ;
! FUNCTION: GetSystemMetrics
! FUNCTION: GetTabbedTextExtentA
! FUNCTION: GetTabbedTextExtentW

3
extra/window-controls-demo/window-controls-demo.factor
View File

@ -7,9 +7,10 @@ CONSTANT: window-control-sets-to-test
H{
{ "No controls" { } }
{ "Normal title bar" { normal-title-bar } }
{ "Small title bar" { small-title-bar } }
{ "Small title bar" { small-title-bar close-button } }
{ "Close button" { normal-title-bar close-button } }
{ "Close and minimize buttons" { normal-title-bar close-button minimize-button } }
{ "Minimize button" { normal-title-bar minimize-button } }
{ "Close, minimize, and maximize buttons" { normal-title-bar close-button minimize-button maximize-button } }
{ "Resizable" { normal-title-bar close-button minimize-button maximize-button resize-handles } }
}