interface for controlling window controls (close, minimize, resize, titlebar, etc.). cocoa backend

basis/cocoa/cocoa.factor

@@ -60,6 +60,7 @@ SYNTAX: IMPORT: scan [ ] import-objc-class ;
         "NSOpenGLPixelFormat"
         "NSOpenGLView"
         "NSOpenPanel"
+        "NSPanel"
         "NSPasteboard"
         "NSPropertyListSerialization"
         "NSResponder"

basis/cocoa/windows/windows.factor

@@ -4,36 +4,37 @@ USING: arrays kernel math cocoa cocoa.messages cocoa.classes
 sequences math.bitwise ;
 IN: cocoa.windows
 
+! Window styles
 CONSTANT: NSBorderlessWindowMask     0
 CONSTANT: NSTitledWindowMask         1
 CONSTANT: NSClosableWindowMask       2
 CONSTANT: NSMiniaturizableWindowMask 4
 CONSTANT: NSResizableWindowMask      8
 
+! Additional panel-only styles 
+CONSTANT: NSUtilityWindowMask       16
+CONSTANT: NSDocModalWindowMask      64
+CONSTANT: NSNonactivatingPanelMask 128
+CONSTANT: NSHUDWindowMask    HEX: 1000
+
 CONSTANT: NSBackingStoreRetained    0
 CONSTANT: NSBackingStoreNonretained 1
 CONSTANT: NSBackingStoreBuffered    2
 
-: standard-window-type ( -- n )
+: <NSWindow> ( rect style class -- window )
-    {
+    [ -> alloc ] curry 2dip NSBackingStoreBuffered 1
-        NSTitledWindowMask
-        NSClosableWindowMask
-        NSMiniaturizableWindowMask
-        NSResizableWindowMask
-    } flags ; inline
-
-: <NSWindow> ( rect -- window )
-    NSWindow -> alloc swap
-    standard-window-type NSBackingStoreBuffered 1
     -> initWithContentRect:styleMask:backing:defer: ;
 
-: <ViewWindow> ( view rect -- window )
+: class-for-style ( style -- NSWindow/NSPanel )
-    <NSWindow> [ swap -> setContentView: ] keep
+    HEX: 1ff0 bitand zero? NSWindow NSPanel ? ;
+
+: <ViewWindow> ( view rect style -- window )
+    dup class-for-style <NSWindow> [ swap -> setContentView: ] keep
     dup dup -> contentView -> setInitialFirstResponder:
     dup 1 -> setAcceptsMouseMovedEvents:
     dup 0 -> setReleasedWhenClosed: ;
 
 : window-content-rect ( window -- rect )
-    [ NSWindow ] dip
+    dup -> class swap
     [ -> frame ] [ -> styleMask ] bi
     -> contentRectForFrameRect:styleMask: ;

basis/ui/backend/cocoa/cocoa.factor

@@ -109,10 +109,23 @@ M: cocoa-ui-backend (set-fullscreen) ( world ? -- )
 M: cocoa-ui-backend (fullscreen?) ( world -- ? )
     handle>> view>> -> isInFullScreenMode zero? not ;
 
+CONSTANT: window-control>styleMask
+    H{
+        { close-button $ NSClosableWindowMask }
+        { minimize-button $ NSMiniaturizableWindowMask }
+        { maximize-button 0 }
+        { resize-handles $ NSResizableWindowMask }
+        { small-title-bar $[ NSTitledWindowMask NSUtilityWindowMask bitor ] }
+        { normal-title-bar $ NSTitledWindowMask }
+    }
+
+: world>styleMask ( world -- n )
+    window-controls>> [ window-control>styleMask at ] map 0 [ bitor ] reduce ;
+
 M:: cocoa-ui-backend (open-window) ( world -- )
     world [ [ dim>> ] dip <FactorView> ]
     with-world-pixel-format :> view
-    view world world>NSRect <ViewWindow> :> window
+    view world [ world>NSRect ] [ world>styleMask ] bi <ViewWindow> :> window
     view -> release
     world view register-window
     window world window-loc>> auto-position

basis/ui/gadgets/worlds/worlds.factor

@@ -7,16 +7,34 @@ ui.gadgets ui.gestures ui.render ui.backend ui.gadgets.tracks
 ui.pixel-formats destructors literals strings ;
 IN: ui.gadgets.worlds
 
+SYMBOLS:
+    close-button
+    minimize-button
+    maximize-button
+    resize-handles
+    small-title-bar
+    normal-title-bar ;
+
 CONSTANT: default-world-pixel-format-attributes
     { windowed double-buffered T{ depth-bits { value 16 } } }
 
+CONSTANT: default-world-window-controls
+    {
+        normal-title-bar
+        close-button
+        minimize-button
+        maximize-button
+        resize-handles
+    }
+
 TUPLE: world < track
     active? focused? grab-input?
     layers
     title status status-owner
     text-handle handle images
     window-loc
-    pixel-format-attributes ;
+    pixel-format-attributes
+    window-controls ;
 
 TUPLE: world-attributes
     { world-class initial: world }
@@ -24,7 +42,8 @@ TUPLE: world-attributes
     { title string initial: "Factor Window" }
     status
     gadgets
-    { pixel-format-attributes initial: $ default-world-pixel-format-attributes } ;
+    { pixel-format-attributes initial: $ default-world-pixel-format-attributes }
+    { window-controls initial: $ default-world-window-controls } ;
 
 : <world-attributes> ( -- world-attributes )
     world-attributes new ; inline
@@ -86,6 +105,7 @@ M: world request-focus-on ( child gadget -- )
         [ title>> >>title ]
         [ status>> >>status ]
         [ pixel-format-attributes>> >>pixel-format-attributes ]
+        [ window-controls>> >>window-controls ]
         [ grab-input?>> >>grab-input? ]
         [ gadgets>> [ 1 track-add ] each ]
     } cleave ;