Canvas destroy callback Crossplatform

Share your advanced PureBasic knowledge/code with the community.
Justin
Addict
Addict
Posts: 948
Joined: Sat Apr 26, 2003 2:49 pm

Canvas destroy callback Crossplatform

Post by Justin »

A callback that will be called just before the canvas is freed so you have a chance to release any associated memory set with SetGadgetData().
In MacOS when closing a window or exiting the application you have to use CloseWindowEx(), so use always CloseWindowEx() in the three platforms and always close the window when the program exits.
I hardcoded it for the canvas only.

Hopefully Fred will add a native solution in a future version.

Code: Select all

;DestroyCallback.pb
;In MacOS you must always use CloseWindowEx() when closing a window
;and always close the window when the app exits.

EnableExplicit

;API
CompilerIf #PB_Compiler_OS = #PB_OS_Windows

CompilerElseIf #PB_Compiler_OS = #PB_OS_Linux

CompilerElseIf #PB_Compiler_OS = #PB_OS_MacOS
#OBJC_ASSOCIATION_ASSIGN = 0

Structure sdkGadget
	gadget.i
	container.i
	vt.i
	UserData.i
	Window.i
	Type.i
	Flags.i
EndStructure

ImportC ""
	PB_Object_EnumerateStart( PB_Objects )
	PB_Object_EnumerateNext( PB_Objects, *ID.Integer )
	PB_Object_EnumerateAbort( PB_Objects )
	PB_Object_GetObject( PB_Object , DynamicOrArrayID)
	PB_Window_Objects.i
	PB_Gadget_Objects.i
	PB_Image_Objects.i
EndImport
CompilerEndIf

Prototype canvas_callback(gdt.i)
PrototypeC _canvas_viewDidMoveToSuperview(obj.i, sel.i)

#_CANVAS_PROP_CALLBACK = "_pb_cb_"
#_CANVAS_PROP_PROC = "_pb_oldProc_"
#_CANVAS_PROP_VIEWDIDMOVETOSUPERVIEW = "_pb_vdmsv_"

CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Procedure.i _canvas_OnNcDestroy(hwnd.i, msg.l, wparam.i, lparam.i)
	Protected.canvas_callback cb
	Protected.i oldProc
	
	oldProc = GetProp_(hwnd, #_CANVAS_PROP_PROC)
	cb = GetProp_(hwnd, #_CANVAS_PROP_CALLBACK)
	If cb
		cb(GetProp_(hwnd, "PB_ID"))
	EndIf
	
	SetWindowLongPtr_(hwnd, #GWLP_WNDPROC, oldProc)
	RemoveProp_(hwnd, #_CANVAS_PROP_PROC)
	RemoveProp_(hwnd, #_CANVAS_PROP_CALLBACK)
	
	ProcedureReturn CallWindowProc_(oldProc, hwnd, msg, wparam, lparam)
EndProcedure

Procedure.i _canvas_proc(hwnd.i, msg.l, wparam.i, lparam.i)
	Select msg
		Case #WM_NCDESTROY : ProcedureReturn _canvas_OnNcDestroy(hwnd, msg, wparam, lparam)
	EndSelect
	
	ProcedureReturn CallWindowProc_(GetProp_(hwnd, #_CANVAS_PROP_PROC), hwnd, msg, wparam, lparam)
EndProcedure

CompilerElseIf #PB_Compiler_OS = #PB_OS_Linux
	Procedure _canvas_onUnrealize(widget.i, gdt.i)
		Protected.canvas_callback cb
		
		cb = g_object_get_data_(widget, #_CANVAS_PROP_CALLBACK)
		If cb
			cb(gdt)
		EndIf
	EndProcedure
	
CompilerElseIf #PB_Compiler_OS = #PB_OS_MacOS	  
	ProcedureC _canvas_onViewDidMoveToSuperview(obj.i, sel.i)
		Protected.i superview
		Protected.canvas_callback cb
		Protected._canvas_viewDidMoveToSuperview oldVdm
	
		superview = CocoaMessage(0, obj, "superview")
		cb = objc_getAssociatedObject_(obj, #_CANVAS_PROP_CALLBACK)
		oldVdm = objc_getAssociatedObject_(obj, #_CANVAS_PROP_VIEWDIDMOVETOSUPERVIEW)
		
		If superview = 0 And cb
			cb(CocoaMessage(0, obj, "tag"))
		EndIf
	
		If oldVdm
			ProcedureReturn oldVdm(obj, sel)
		EndIf 
	EndProcedure
CompilerEndIf

Procedure.l canvas_setup(gdt.i, cb.canvas_callback)
	Protected.i osHandle
	
	If GadgetType(gdt) <> #PB_GadgetType_Canvas Or cb = 0
		ProcedureReturn
	EndIf 
	
	osHandle = GadgetID(gdt)
	
	CompilerIf #PB_Compiler_OS = #PB_OS_Windows
		Protected.i oldProc
		
		If GetProp_(osHandle, #_CANVAS_PROP_CALLBACK) <> 0
			ProcedureReturn
		EndIf 
		
		SetProp_(osHandle, #_CANVAS_PROP_CALLBACK, cb)
		oldProc = SetWindowLongPtr_(osHandle, #GWLP_WNDPROC, @_canvas_proc())
		SetProp_(osHandle, #_CANVAS_PROP_PROC, oldProc)
		
	CompilerElseIf #PB_Compiler_OS = #PB_OS_Linux
		If g_object_get_data_(osHandle, #_CANVAS_PROP_CALLBACK) <> 0
			ProcedureReturn
		EndIf
	
		g_object_set_data_(osHandle, #_CANVAS_PROP_CALLBACK, cb)
		g_signal_connect_(osHandle, "unrealize", @_canvas_onUnrealize(), gdt)

	CompilerElseIf #PB_Compiler_OS = #PB_OS_MacOS
		Protected.i viewClass
		Protected.i oldVdm, selVdm
		
		If objc_getAssociatedObject_(osHandle, #_CANVAS_PROP_CALLBACK) <> 0
			ProcedureReturn
		EndIf 

		objc_setAssociatedObject_(osHandle, #_CANVAS_PROP_CALLBACK, cb, #OBJC_ASSOCIATION_ASSIGN)

		viewClass = object_getClass_(osHandle)
		selVdm = sel_registerName_("viewDidMoveToSuperview")
		
		If class_getMethodImplementation_(viewClass, selVdm) <> @_canvas_onViewDidMoveToSuperview()
			oldVdm = class_replaceMethod_(viewClass, selVdm, @_canvas_onViewDidMoveToSuperview(), "v@:@")
			objc_setAssociatedObject_(osHandle, #_CANVAS_PROP_VIEWDIDMOVETOSUPERVIEW, oldVdm, #OBJC_ASSOCIATION_ASSIGN)
		EndIf 
	CompilerEndIf
EndProcedure

Procedure CloseWindowEx(win.i)	
	CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
		Protected.i object
		Protected.sdkGadget *gadget

		HideWindow(win, #True)

		;Free all canvas gadgets
		PB_Object_EnumerateStart(PB_Gadget_Objects)
		While PB_Object_EnumerateNext(PB_Gadget_Objects, @object)
			*gadget = IsGadget(object)
			If *gadget = 0 : Continue : EndIf
			
			If *gadget\Window = win
				If GadgetType(object) = #PB_GadgetType_Canvas
					FreeGadget(object)
				EndIf 
			EndIf 
		Wend
	CompilerEndIf
	
	CloseWindow(win)
EndProcedure

;-
;-TEST
Enumeration
	#TEST1
	#TEST2
	#TEST3
EndEnumeration

;- _APP
Structure _APP
	win.i
	menu.i
	canvas1.i
	canvas2.i
	panel.i
EndStructure
Global._APP app

Procedure canvas_onDestroy(gdt.i)
	Debug "destroy " + IsGadget(gdt)
	Debug GadgetWidth(gdt)
EndProcedure

Procedure test1()
	If IsGadget(app\canvas1)
		FreeGadget(app\canvas1)
	EndIf	
EndProcedure

Procedure test2()
	If IsGadget(app\canvas2)
		FreeGadget(app\canvas2)
	EndIf
EndProcedure

Procedure test3()
	RemoveGadgetItem(app\panel, 0)
EndProcedure

Procedure canvas1_draw()
	StartDrawing(CanvasOutput(app\canvas1))
	Box(0, 0, OutputWidth(), OutputHeight(), RGB(255, 0, 0))
	StopDrawing()
EndProcedure

Procedure canvas2_draw()
	StartDrawing(CanvasOutput(app\canvas2))
	Box(0, 0, OutputWidth(), OutputHeight(), RGB(0, 255, 0))
	StopDrawing()
EndProcedure

Procedure canvas_onLBDown()
	FreeGadget(EventGadget())
EndProcedure

Procedure main()
	Protected.l ev, quit
	
	app\win = OpenWindow(#PB_Any, 10, 10, 600, 400, "Test", #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget | #PB_Window_SizeGadget)
	app\menu = CreateMenu(#PB_Any, WindowID(app\win))
	MenuTitle("Test")
	MenuItem(#TEST1, "Free canvas 1")
	BindMenuEvent(app\menu, #TEST1, @test1())
	MenuItem(#TEST2, "Free canvas 2")
	BindMenuEvent(app\menu, #TEST2, @test2())
	MenuItem(#TEST3, "Remove panel item")
	BindMenuEvent(app\menu, #TEST3, @test3())
	
	app\panel = PanelGadget(#PB_Any, 0, 0, 300, 300)
	AddGadgetItem(app\panel, -1, "Panel1")
	app\canvas1 = CanvasGadget(#PB_Any, 0, 0, 200, 200, #PB_Canvas_Container)
	canvas_setup(app\canvas1, @canvas_onDestroy())
	app\canvas2 = CanvasGadget(#PB_Any, 0, 0, 100, 100, #PB_Canvas_Container)
	canvas_setup(app\canvas2, @canvas_onDestroy())
	CloseGadgetList()
	CloseGadgetList()
	CloseGadgetList()
	
	BindGadgetEvent(app\canvas1, @canvas_onLBDown(), #PB_EventType_LeftButtonDown)
	BindGadgetEvent(app\canvas2, @canvas_onLBDown(), #PB_EventType_LeftButtonDown)

	canvas1_draw()
	canvas2_draw()
	
	Repeat
		ev = WaitWindowEvent()
		Select ev
			Case #PB_Event_CloseWindow
				CloseWindowEx(app\win)
				quit = #True
		EndSelect
	Until quit

EndProcedure
	
main()
mrbungle
Enthusiast
Enthusiast
Posts: 149
Joined: Wed Dec 30, 2020 3:18 am

Re: Canvas destroy callback Crossplatform

Post by mrbungle »

I get an invalid memory access using PB 6.12 on an M2 Mac
Justin
Addict
Addict
Posts: 948
Joined: Sat Apr 26, 2003 2:49 pm

Re: Canvas destroy callback Crossplatform

Post by Justin »

Strange, works here on x64 Monterrey (i know is old), probably a M2 issue, where do you get the error?
I'll have to setup a VM with that os. Or maybe someone can give us a hint about M2 changes.
Post Reply