[Implemented] New window flag for Mac: #PB_Window_Composited

Got an idea for enhancing PureBasic? New command(s) you'd like to see?
User avatar
Shardik
Addict
Addict
Posts: 2058
Joined: Thu Apr 21, 2005 2:38 pm
Location: Germany

[Implemented] New window flag for Mac: #PB_Window_Composited

Post by Shardik »

Cocoa uses composition

I would like to propose a new flag for creating windows in the Mac version:
#PB_Window_Composited

Although I know that this attribute is useless for Windows and Linux and
contradicts the cross-platform ideal, this attribute is important for Mac
Carbon programming because a lot of features are not possible without it.
A small example is the function to autohide the scrollbar in ListIconGadgets
(DataBrowser control in Mac speak): this function only works in windows
with compositing attribute:
HIDataBrowser.h wrote:This attribute is only respected in compositing mode; it will be ignored in non-compositing mode.
And it's not possible to change the compositing attribute
kHIWindowBitCompositing once a window is created:
Apple's Window Manager Reference wrote:This attribute must be specified at window creation; you may not add this attribute after the window has been created.
Although it is perfectly possible to create composited windows with API
functions, the resulting code is much more complicated because it's not
possible to use PB's window event loop anymore. Here are two examples
with the non-working short code with PB's standard window and a much
more complicated working code creating a composited API window:

Image

Code: Select all

ImportC ""
  DataBrowserChangeAttributes(DataBrowserRef.L, AttributesToSet.L, AttributesToClear.L)
EndImport

#kDataBrowserAttributeAutoHideScrollBars = 1 << 3

OpenWindow(0, 200, 100, 200, 150, "PB Window")
ListIconGadget(0, 5, 5, WindowWidth(0) - 10, WindowHeight(0) - 40, "Column 1", 84)
AddGadgetColumn(0, 1, "Column 2", 84)
ButtonGadget(1, 10, WindowHeight(0) - 30, WindowWidth(0) - 20, 20, "Add new row")

DataBrowserChangeAttributes(GadgetID(0), #kDataBrowserAttributeAutoHideScrollBars, 0)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Break
    Case #PB_Event_Gadget
      If EventGadget() = 1
        If EventType() = #PB_EventType_LeftClick
          RowCount + 1
          AddGadgetItem(0, -1, "Row " + Str(RowCount))
        EndIf
      EndIf
  EndSelect
ForEver
Image

Code: Select all

EnableExplicit

ImportC ""
  CreateNewWindow(WindowClass.L, Attributes.L, *Bounds, *WindowRef)
  DataBrowserChangeAttributes(DataBrowserRef.L, AttributesToSet.L, AttributesToClear.L)
  DisposeEventHandlerUPP(EventHandlerUPP.L)
  GetEventClass(EventRef.L)
  HIViewAddSubview(HIViewParentRef.L, HIViewNewChildRef.L)
  HIViewGetRoot(WindowRef.L)
  HIViewPlaceInSuperviewAt(HIViewRef.L, x.F, y.F)
  HIViewRemoveFromSuperview(HIViewRef.L)
  QuitApplicationEventLoop()
  RunApplicationEventLoop()
  SetWindowTitleWithCFString(WindowRef.L, CFStringRef.L)
EndImport

#kDataBrowserAttributeAutoHideScrollBars = 1 << 3
#kEventClassControl = 'cntl'
#kEventClassWindow = 'wind'
#kEventControlClick = 13
#kEventWindowClose = 72
#kMovableModalWindowClass = 4
#kWindowCloseBoxAttribute = 1 << 0
#kWindowCompositingAttribute = 1 << 19
#kWindowStandardHandlerAttribute = 1 << 25

Structure EventTypeSpec
  EventClass.L
  EventKind.L
EndStructure

Structure Rect
  Top.W
  Left.W
  Bottom.W
  Right.W
EndStructure

ProcedureC EventHandler(*NextEventHandler, EventRef.L, UserData.L)
  Static RowCount.L

  Select GetEventClass(EventRef)
    Case #kEventClassWindow
      HIViewRemoveFromSuperview(GadgetID(0))
      HIViewRemoveFromSuperview(GadgetID(1))
      QuitApplicationEventLoop()
      ProcedureReturn 0
    Case #kEventClassControl
      RowCount + 1
      AddGadgetItem(0, -1, "Row " + Str(RowCount))
  EndSelect
EndProcedure

Define Bounds.Rect
Define EventHandlerUPP.L
Define RootView.L
Define WindowRef.L

Dim EventTypes.EventTypeSpec(0)

Bounds\Left = 200
Bounds\Top = 100
Bounds\Right = Bounds\Left + 200
Bounds\Bottom = Bounds\Top + 150

Debug ArraySize(EventTypes())

If CreateNewWindow(#kMovableModalWindowClass, #kWindowCloseBoxAttribute | #kWindowCompositingAttribute | #kWindowStandardHandlerAttribute, @Bounds, @WindowRef) = 0
  SetWindowTitleWithCFString(WindowRef, CFStringCreateWithCString_(0, "Composited API window", 0))

  ; ----- Install EventHandler to detect click on window's close button
  EventHandlerUPP = NewEventHandlerUPP_(@EventHandler())
  EventTypes(0)\EventClass = #kEventClassWindow
  EventTypes(0)\EventKind  = #kEventWindowClose
  InstallEventHandler_(GetWindowEventTarget_(WindowRef), EventHandlerUPP, 1, @EventTypes(), 0, 0)

  ListIconGadget(0, 5, 5, 190, 110, "Column 1", 84)
  AddGadgetColumn(0, 1, "Column 2", 84)
  ButtonGadget(1, 10, 120, 185, 20, "Add new row")

  DataBrowserChangeAttributes(GadgetID(0), #kDataBrowserAttributeAutoHideScrollBars, 0)

  ; ----- Install EventHandler to detect left click on "Add new row" button
  EventTypes(0)\EventClass = #kEventClassControl
  EventTypes(0)\EventKind = #kEventControlClick
  InstallEventHandler_(GetControlEventTarget_(GadgetID(1)), EventHandlerUPP, 1, @EventTypes(), 0, 0)

  RootView = HIViewGetRoot(WindowRef)

  If RootView
    HIViewAddSubView(RootView, GadgetID(0))
    HIViewPlaceInSuperviewAt(GadgetID(0), 5, 27)
    HIViewAddSubView(RootView, GadgetID(1))
    HIViewPlaceInSuperviewAt(GadgetID(1), 7, 142)
  EndIf

  ShowWindow_(WindowRef)
  RunApplicationEventLoop()
  DisposeEventHandlerUPP(EventHandlerUPP)
EndIf
Another problem that could be solved by using a composited window
would be by embedding the WebGadget in a composited window. WilliamL
experienced excessive CPU load which even heats up his laptop when
using the WebGadget in a standard PB window and wilbert assumed that
the 'official' way of embedding a Cocoa view (like WebView) requires
compositing windows. Testing my code example that embeds a WebGadget
in a composited window WilliamL reported that the CPU load became normal:
http://www.purebasic.fr/english/viewtop ... 1&start=12

But by far the most useful application areas for composited windows are the
creation of transparent windows and transparent gadgets. Transparent
gadgets - as far as I know - are only possible in composited windows. For
demonstration purposes I converted Apple's demonstration source code
CarbonTransparentWindow.c from C to PureBasic (the blue background
is my desktop wallpaper):

Image

Image

This is the code to display the two above windows:

Code: Select all

; Converted from Apple's sample code CarbonTransparentWindow.c

EnableExplicit

ImportC ""
  CGContextClearRect(CGContextRef.L, x.F, y.F, Width.F, Height.F)
  CGContextFillRect(CGContextRef.L, x.F, y.F, Width.F, Height.F)
  CGContextSetRGBFillColor(CGContextRef.L, Red.F, Green.F, Blue.F, Alpha.F)
  CreateNewWindow(WindowClass.L, Attributes.L, *Bounds, *WindowRef)
  CreatePushButtonControl(WindowRef.L, *BoundsRect, CFStringRef.L, *ControlRef)
  CreateStaticTextControl(WindowRef.L, *BoundsRect, CFStringRef.L, *FontStyle, *ControlRef)
  CreateUserPaneControl(WindowRef.L, *BoundsRect, Features.L, *ControlRef)
  GetControlBounds(ControlRef.L, *Bounds)
  GetPort(*Port)
  GetPortBounds(Port.L, *Rect)
  GetWindowAttributes(WindowRef.L, *Attributes)
  GetWindowFeatures(WindowRef.L, *Features)
  HIViewFindByID(StartView.L, HIViewSignature.L, HIViewID, *FoundControl)
  HIViewGetBounds(HIViewRef.L, *HIRect)
  HIViewGetRoot(HIViewRef.L)
  HIWindowChangeFeatures(WindowRef.L, *AttributesToSet, *AttributesToClear)
  InsetRect(*Rect, HorizontalDistance.W, VerticalDistance.W)
  PaintRect(*Rect)
  QDBeginCGContext(CGrafPtr.L, *CGContextRef)
  QDEndCGContext(CGrafPtr.L, *CGContextRef)
  QuitApplicationEventLoop()
  ReshapeCustomWindow(WindowRef.L)
  RGBForeColor(*RGBColor)
  RunApplicationEventLoop()
  SetControlFontStyle(ControlRef.L, *ControlFontStyleRec)
  SetEmptyRgn(RegionHandle.L)
  SetWindowAlpha(WindowRef.L, Alpha.F)
  SetWindowTitleWithCFString(WindowRef.L, CFStringRef.L)
  ShowControl(ControlRef.L)
EndImport

#EventNotHandledErr = -9874
#kControlUseJustMask = 64
#kControlSupportsEmbedding = 1 << 1
#kDocumentWindowClass = 6
#kEventClassControl = 'cntl'
#kEventClassWindow = 'wind'
#kEventControlDraw = 4
#kEventParamCGContextRef = 'cntx'
#kEventParamRgnHandle = 'rgnh'
#kEventParamWindowRegionCode = 'wshp'
#kEventWindowClose = 72
#kEventWindowDrawContent = 2
#kEventWindowGetRegion = 1002
#kHIViewWindowContentID = 'cnvw'
#kMovableModalWindowClass = 4
#kWindowCloseBoxAttribute = 1 << 0
#kWindowCompositingAttribute = 1 << 19
#kWindowIsOpaque = 1 << 14
#kWindowOpaqueRgn = 35
#kWindowStandardHandlerAttribute = 1 << 25
#NoErr = 0
#teCenter = 1
#typeCGContextRef = 'cntx'
#typeQDRgnHandle = 'rgnh'
#typeWindowRegionCode = 'wshp'

Structure ControlFontStyleRec
  Flags.W
  Font.W
  Size.W
  Style.W
  Mode.W
  Just.W
  ForeColor.L
  BackColor.L
EndStructure

Structure EventTypeSpec
  EventClass.L
  EventKind.L
EndStructure

Structure HIRect
  x.F
  y.F
  Width.F
  Height.F
EndStructure

Structure HIViewID
  Signature.L
  ID.L
EndStructure

Structure Rect
  Top.W
  Left.W
  Bottom.W
  Right.W
EndStructure

Structure RGBColor
  Red.U
  Green.U
  Blue.U
EndStructure

ProcedureC TransparentUserPaneEventHandler(*NextEventHandler, Event.L, UserData.L)
  Protected Bounds.HIRect
  Protected CGContext.L
  Protected Status.L = #False

  If GetEventParameter_(Event, #kEventParamCGContextRef, #typeCGContextRef, 0, SizeOf(CGContext), 0, @CGContext) = 0
    If HIViewGetBounds(UserData, @Bounds) = 0
      CGContextSetRGBFillColor(CGContext, 1, 0, 0, 0.5)
      CGContextFillRect(CGContext, Bounds\x, Bounds\y, Bounds\Width, Bounds\Height)

      CGContextSetRGBFillColor(CGContext, 1, 1, 0, 0.5)
      CGContextFillRect(CGContext, Bounds\x + 30, Bounds\y + 30, Bounds\Width - 60, Bounds\Height - 60)

      Status = #NoErr
    EndIf
  EndIf

  ProcedureReturn Status
EndProcedure

ProcedureC OpaqueUserPaneEventHandler(*NextEventHandler, Event.L, UserData.L)
  Protected Bounds.HIRect
  Protected CGContext.L
  Protected RedColor.RGBColor
  Protected Status.L = #False
  Protected YellowColor.RGBColor

  GetControlBounds(UserData, @Bounds)

  RedColor\Red = $FFFF
  RedColor\Green = 0
  RedColor\Blue = 0
  RGBForeColor(@RedColor)
  PaintRect(@Bounds)

  YellowColor\Red = $FFFF
  YellowColor\Green = $FFFF
  YellowColor\Blue = 0
  RGBForeColor(@YellowColor)
  InsetRect(@Bounds, 30, 30)
  PaintRect(@Bounds)

  ProcedureReturn Status
EndProcedure

ProcedureC TransparentWindowHandler(*NextEventHandler, Event.L, UserData.L)
  Protected CGContext.L
  Protected Bounds.HIRect
  Protected Port.L
  Protected PortBounds.Rect
  Protected RegionHandle.L
  Protected RegionCode.L
  Protected Status.L = #EventNotHandledErr

  Select GetEventKind_(Event)
    Case #kEventWindowClose
      QuitApplicationEventLoop()
      Status = #NoErr
    Case #kEventWindowGetRegion
      GetEventParameter_(Event, #kEventParamWindowRegionCode, #typeWindowRegionCode, 0, SizeOf(RegionCode), 0, @RegionCode)

      ; ----- If it is the opaque region code then set the region to empty and
      ;       return #NoErr to stop the propagation
      If RegionCode = #kWindowOpaqueRgn
        GetEventParameter_(Event, #kEventParamRgnHandle, #typeQDRgnHandle, 0, SizeOf(RegionHandle), 0, @RegionHandle)
        SetEmptyRgn(RegionHandle)
        Status = #NoErr
      EndIf
    Case #kEventWindowDrawContent
      GetPort(@Port)
      GetPortBounds(Port, @PortBounds)

      ; ----- Get Quartz context to be able to use transparency
      QDBeginCGContext(Port, @CGContext)

      ; ----- Make the whole content transparent
      CGContextClearRect(CGContext, 0, 0, PortBounds\Right, PortBounds\Bottom)
			
			QDEndCGContext(Port, @CGContext)
			
			; ----- We need to let the HIToolbox and the regular
      ;       kEventWindowDrawContent handler do their work, mainly draw the
      ;       subviews, so we return #EventNotHandledErr to propagate
      Status = #EventNotHandledErr
    Case #kEventControlDraw
      GetEventParameter_(Event, #kEventParamCGContextRef, #typeCGContextRef, 0, SizeOf(CGContext), 0, @CGContext)
      HIViewGetBounds(UserData, @Bounds)

      ; ----- Make the whole content transparent
      CGContextClearRect(CGContext, Bounds\x, Bounds\y, Bounds\Width, Bounds\Height)

      ; ----- We must not let the default draw handler of the content view be
      ;       called (it would draw the default opaque theme) so we return
      ;       #NoErr to stop the propagation
      Status = #NoErr
  EndSelect

  ProcedureReturn Status
EndProcedure

ProcedureC MakeWindowTransparent(WindowRef.L)
  Protected ContentView.L
  Protected Status.L = #False
  Protected WindowAttributes.L
  Protected WindowFeatures.L

  Protected Dim EventTypes.EventTypeSpec(2)

  If GetWindowAttributes(WindowRef, @WindowAttributes) = 0
    ; ----- Handle closing of window
    EventTypes(0)\EventClass = #kEventClassWindow
    EventTypes(0)\EventKind  = #kEventWindowClose

    ; ----- Intercept the kEventWindowGetRegion event so we are able to specify an
    ;       empty opaque region
    EventTypes(1)\EventClass = #kEventClassWindow
    EventTypes(1)\EventKind  = #kEventWindowGetRegion
    
    If WindowAttributes & #kWindowCompositingAttribute
      InstallEventHandler_(GetWindowEventTarget_(WindowRef), @TransparentWindowHandler(), 2, @EventTypes(), WindowRef, 0)

      If HIViewFindByID(HIViewGetRoot(WindowRef), 'wind', 1, @ContentView) = 0
        ; ----- Intercept the kEventControlDraw event of our content view so that
        ;       we can make it transparent
        EventTypes(0)\EventClass = #kEventClassControl
        EventTypes(0)\EventKind  = #kEventControlDraw
        
        InstallEventHandler_(GetControlEventTarget_(ContentView), @TransparentWindowHandler(), 1, @EventTypes(), ContentView, 0)
      EndIf
    Else
      ; ----- Intercept the kEventWindowDrawContent event of our window so that we
      ;       can make it transparent
      EventTypes(2)\EventClass = #kEventClassWindow
      EventTypes(2)\EventKind  = #kEventWindowDrawContent
      
      InstallEventHandler_(GetWindowEventTarget_(WindowRef), @TransparentWindowHandler(), 3, @EventTypes(), WindowRef, 0)
    EndIf    

    If GetWindowFeatures(WindowRef, @WindowFeatures) = 0
      If WindowFeatures & #kWindowIsOpaque
        HIWindowChangeFeatures(WindowRef, 0, #kWindowIsOpaque)
      EndIf
    EndIf
    
    ; ----- Force opaque shape to be recalculated
    ReshapeCustomWindow(WindowRef)
    
    ; ----- Ensure that HIToolbox doesn't use standard shadow style, which
    ;       defeats custom opaque shape
    SetWindowAlpha(WindowRef, 0.999)
    Status = #NoErr
  EndIf    

  ProcedureReturn Status
EndProcedure

ProcedureC CreateCompositingWindow()
  Protected Bounds.Rect
  Protected PushButtonRef.L
  Protected Status.L = #False
  Protected StaticText.S
  Protected StaticTextRef.L
  Protected Style.ControlFontStyleRec
  Protected UserPaneRef.L
  Protected WindowRef.L

  Protected Dim EventTypes.EventTypeSpec(0)

  Bounds\Left = 69
  Bounds\Top = 113
  Bounds\Right = 549
  Bounds\Bottom = 473
  
  If CreateNewWindow(#kDocumentWindowClass, #kWindowCloseBoxAttribute | #kWindowCompositingAttribute | #kWindowStandardHandlerAttribute, @Bounds, @WindowRef) = 0
    SetWindowTitleWithCFString(WindowRef, CFStringCreateWithCString_(0, "Transparent Compositing Window", 0))

    EventTypes(0)\EventClass = #kEventClassControl
    EventTypes(0)\EventKind  = #kEventControlDraw

    ; Original: com.apple.HIStaticTextView 

    Bounds\Left   = 22
    Bounds\Top    = 115
    Bounds\Right  = 457
    Bounds\Bottom = 185

    StaticText = "Set your own controls in this window" + #CR$ + #CR$ + "instead of this neat placeholder."
    CreateStaticTextControl(WindowRef, @Bounds, CFStringCreateWithCString_(0, @StaticText, 0), 0, @StaticTextRef)
 
    Style\Flags = #kControlUseJustMask
    Style\Just = #teCenter
    SetControlFontStyle(StaticTextRef, @Style)
    ShowControl(StaticTextRef)

    Bounds\Left   = 390
    Bounds\Top    = 320
    Bounds\Right  = 460
    Bounds\Bottom = 340

    CreatePushButtonControl(WindowRef, @Bounds, CFStringCreateWithCString_(0, @"OK", 0), @PushButtonRef)
    
    Bounds\Left   = 20
    Bounds\Top    = 20
    Bounds\Right  = 230
    Bounds\Bottom = 340
    
    If CreateUserPaneControl(WindowRef, @Bounds, #kControlSupportsEmbedding, @UserPaneRef) = 0
      If InstallEventHandler_(GetControlEventTarget_(UserPaneRef), @TransparentUserPaneEventHandler(), 1, @EventTypes(), UserPaneRef, 0) = 0
        If MakeWindowTransparent(WindowRef) = #NoErr
          ShowWindow_(WindowRef)
          Status = #NoErr
        EndIf
      EndIf
    EndIf
  EndIf

  ProcedureReturn Status
EndProcedure

ProcedureC CreateNonCompositingWindow()
  Protected Bounds.Rect
  Protected PushButtonRef.L
  Protected StaticText.S
  Protected StaticTextRef.L
  Protected Status.L = #False
  Protected Style.ControlFontStyleRec
  Protected UserPaneRef.L
  Protected WindowRef.L

  Protected Dim EventTypes.EventTypeSpec(0)

  Bounds\Left = 567
  Bounds\Top = 113
  Bounds\Right = 1047
  Bounds\Bottom = 473
  
  If CreateNewWindow(#kDocumentWindowClass, #kWindowCloseBoxAttribute | #kWindowStandardHandlerAttribute, @Bounds, @WindowRef) = 0
    SetWindowTitleWithCFString(WindowRef, CFStringCreateWithCString_(0, "Transparent Non-Compositing Window", 0))

    EventTypes(0)\EventClass = #kEventClassControl
    EventTypes(0)\EventKind  = #kEventControlDraw

    Bounds\Left   = 22
    Bounds\Top    = 115
    Bounds\Right  = 457
    Bounds\Bottom = 185

    StaticText = "Set your own controls in this window" + #CR$ + #CR$ + "instead of this neat placeholder."
    CreateStaticTextControl(WindowRef, @Bounds, CFStringCreateWithCString_(0, @StaticText, 0), 0, @StaticTextRef)
 
    Style\Flags = #kControlUseJustMask
    Style\Just = #teCenter
    SetControlFontStyle(StaticTextRef, @Style)
    ShowControl(StaticTextRef)

    Bounds\Left   = 390
    Bounds\Top    = 320
    Bounds\Right  = 460
    Bounds\Bottom = 340

    CreatePushButtonControl(WindowRef, @Bounds, CFStringCreateWithCString_(0, @"OK", 0), @PushButtonRef)
    
    Bounds\Left   = 20
    Bounds\Top    = 20
    Bounds\Right  = 230
    Bounds\Bottom = 340

    If CreateUserPaneControl(WindowRef, @Bounds, #kControlSupportsEmbedding, @UserPaneRef) = 0
      If InstallEventHandler_(GetControlEventTarget_(UserPaneRef), @OpaqueUserPaneEventHandler(), 1, @EventTypes(), UserPaneRef, 0) = 0
        If MakeWindowTransparent(WindowRef) = #NoErr
          ShowWindow_(WindowRef)
          Status = #NoErr
        EndIf
      EndIf
    EndIf
  EndIf

  ProcedureReturn Status
EndProcedure

If CreateCompositingWindow() = #NoErr
  If CreateNonCompositingWindow() = #NoErr
    RunApplicationEventLoop()
  EndIf
EndIf
If implementing a compositing flag should be a no go, is it at least possible
to evaluate Apple's flag
#kWindowCompositingAttribute = 1 << 19
in PB's OpenWindow() function? Because PB currently doesn't seem to evaluate
this flag:

Code: Select all

ImportC ""
  GetWindowAttributes(WindowRef.L, *WindowAttributes)
EndImport

#kWindowCompositingAttribute = 1 << 19

Define WindowAttributes.L

If OpenWindow(0, 270, 100, 200, 170, "Composited ?", #PB_Window_SystemMenu | #kWindowCompositingAttribute)
  While WindowEvent()
  Wend

  If GetWindowAttributes(WindowID(0), @WindowAttributes) <> 0
    MessageRequester("Error", "GetWindowAttributes() failed")
  Else
    If WindowAttributes & #kWindowCompositingAttribute
      MessageRequester("Info", "Compositing is enabled")
    Else 
      MessageRequester("Info", "Compositing is disabled")
    EndIf
  EndIf
  
  Repeat
  Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf
Polo
Addict
Addict
Posts: 2422
Joined: Tue May 06, 2003 5:07 pm
Location: UK

Re: New window flag for Mac: #PB_Window_Composited

Post by Polo »

That'd be great indeed!
Fred
Administrator
Administrator
Posts: 18162
Joined: Fri May 17, 2002 4:39 pm
Location: France
Contact:

Re: New window flag for Mac: #PB_Window_Composited

Post by Fred »

That will come with the Cocoa binding when it will be finished.
Polo
Addict
Addict
Posts: 2422
Joined: Tue May 06, 2003 5:07 pm
Location: UK

Re: New window flag for Mac: #PB_Window_Composited

Post by Polo »

Fred wrote:That will come with the Cocoa binding when it will be finished.
May I ask what is the overall progress on this? Just to get an idea, not rushing you or anything! :)
Post Reply