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
! 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
}
} ;
+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 }
! 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
MACRO: flags ( values -- )
[ 0 ] [ [ ?execute bitor ] curry compose ] reduce ;
+: symbols>flags ( symbols assoc -- flag-bits )
+ [ at ] curry map
+ 0 [ bitor ] reduce ;
+
! bitfield
<PRIVATE
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
}
: 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> ]
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
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 ;
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> ;
CW_USEDEFAULT over set-RECT-left
CW_USEDEFAULT swap set-RECT-top ;
-: make-adjusted-RECT ( rect -- RECT )
- make-RECT
- dup get-RECT-top-left [ zero? ] both? swap
- dup adjust-RECT
+: make-adjusted-RECT ( rect style ex-style -- RECT )
+ [
+ make-RECT
+ dup get-RECT-top-left [ zero? ] both? swap
+ dup
+ ] 2dip adjust-RECT
swap [ dup default-position-RECT ] when ;
: get-window-class ( -- class-name )
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 ;
[ 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 ;
} 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
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
! FUNCTION: DrawTextW
! FUNCTION: EditWndProc
FUNCTION: BOOL EmptyClipboard ( ) ;
-! FUNCTION: EnableMenuItem
+FUNCTION: BOOL EnableMenuItem ( HMENU hMenu, UINT uIDEnableItem, UINT uEnable ) ;
! FUNCTION: EnableScrollBar
! FUNCTION: EnableWindow
! FUNCTION: EndDeferWindowPos
! FUNCTION: GetSubMenu
! FUNCTION: GetSysColor
FUNCTION: HBRUSH GetSysColorBrush ( int nIndex ) ;
-! FUNCTION: GetSystemMenu
+FUNCTION: HMENU GetSystemMenu ( HWND hWnd, BOOL bRevert ) ;
! FUNCTION: GetSystemMetrics
! FUNCTION: GetTabbedTextExtentA
! FUNCTION: GetTabbedTextExtentW
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 } }
}