PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Submenus / family tree / multidim array / subitems

https://www.purebasic.fr/english/viewtopic.php?t=47818

Page 1 of 1

Submenus / family tree / multidim array / subitems

Posted: Tue Oct 11, 2011 5:00 pm
by jesperbrannmark
I have a project where you click on one thing which opens up another sets of buttons or keywords - and by clicking those another set opens up etc etc.
All my values are semicolon separated. I have put the submenu in [ ]
Took me an hour to do, so now hopefully I save someone else that hour. Maybe someone like to use it - go ahead to whatever you want to. Works cross platform, but as always it works best on a Mac.

Code: Select all

original.s="Fruit[Red[Apple;Plum];Green[Apple[Granny Smith;Winterfresh];Pear;Cactus];Yellow[Banana;Corn]];"
original.s+"Vegetable[Round[Tomato[Baby;Plum;Flat;Beef];Potato];Long[Cucumber]];"
original.s+"Others[Diary[Milk;Cream;Butter];Flour[Wheat;Whole grain]]"
Procedure.s clean_result(gadget,result.s)
  For i=1 To Len(result)
    If Mid(result,i,1)="["
      inbracks+1
    ElseIf Mid(result,i,1)="]"
      inbracks-1
    ElseIf inbracks=0
      realresult.s+Mid(result,i,1)
    EndIf
  Next
  ClearGadgetItems(gadget)
  For i=1 To CountString(realresult.s,";")+1
    AddGadgetItem(gadget,-1,StringField(realresult.s,i,";"))
  Next
  ProcedureReturn result
EndProcedure
Procedure.s clean_submenu(result.s,subresult.l)
  inbacks.b=0
  For i=1 To Len(result)
    If counter=subresult
      realresult.s+Mid(result,i,1)  
    EndIf  
    If Mid(result,i,1)="["
      inbracks+1
    ElseIf Mid(result,i,1)="]"
      inbracks-1
    ElseIf Mid(result,i,1)=";" And inbracks=0
      counter+1      
    EndIf
  Next
  If FindString(realresult,"[")
    For i=Len(realresult) To 1 Step -1
      If Mid(realresult,i,1)="]"
        Break
      EndIf
    Next
    realresult=Mid(realresult,FindString(realresult,"[")+1,i-FindString(realresult,"[")-1)
  Else
    realresult=""
  EndIf
  ProcedureReturn realresult
EndProcedure
OpenWindow(0,0,0,640,480,"")
ListIconGadget(0,0,0,100,480,"Go",100)
ListIconGadget(1,120,0,100,480,"Go",100)
ListIconGadget(2,240,0,100,480,"Go",100)
ListIconGadget(3,360,0,100,480,"Go",100)
;Set first menu
result.s=clean_result(0,original.s)
Repeat
  eventid=WaitWindowEvent()
  If eventid=#PB_Event_Gadget
    If EventGadget()=0
      result=clean_result(1,clean_submenu(original,GetGadgetState(0)))  
    ElseIf EventGadget()=1
      result=clean_result(2,clean_submenu(clean_submenu(original,GetGadgetState(0)),GetGadgetState(1)))  
    ElseIf EventGadget()=2
      result=clean_result(3,clean_submenu(clean_submenu(clean_submenu(original,GetGadgetState(0)),GetGadgetState(1)),GetGadgetState(2)))  
    EndIf
  EndIf  
Until eventid=#PB_Event_CloseWindow

Re: Submenus / family tree / multidim array / subitems

Posted: Tue Oct 11, 2011 5:04 pm
by Kiffi
Nice! Thanks for sharing!
jesperbrannmark wrote:[...] but as always it works best on a Mac.
:lol:

Greetings ... Kiffi

Re: Submenus / family tree / multidim array / subitems

Posted: Wed Oct 12, 2011 2:54 pm
by ebs
jesper,

Thank you for the handy nested submenus code.

I would suggest adding a couple of "ClearGadgetItems()" statements as shown below
to clear out previous results when clicking on higher-level menu items.

For example, choose "Fruit -> Green -> Apple" to fill all four lists.
When you click on "Vegetable" in the first list, the second list is filled
and the third and fourth lists are cleared, removing the older entries.

Regards,
Eric

Code: Select all

Repeat
  EventID=WaitWindowEvent()
  If EventID=#PB_Event_Gadget
    If EventGadget()=0
      result=clean_result(1,clean_submenu(original,GetGadgetState(0))) 
      ClearGadgetItems(2)
      ClearGadgetItems(3)
    ElseIf EventGadget()=1
      result=clean_result(2,clean_submenu(clean_submenu(original,GetGadgetState(0)),GetGadgetState(1))) 
      ClearGadgetItems(3)
    ElseIf EventGadget()=2
      result=clean_result(3,clean_submenu(clean_submenu(clean_submenu(original,GetGadgetState(0)),GetGadgetState(1)),GetGadgetState(2))) 
    EndIf
  EndIf 
Until EventID=#PB_Event_CloseWindow

String speed issue

Posted: Mon Apr 30, 2012 4:31 pm
by jesperbrannmark
I am using my code and some people are really getting larger lists (64KB and bigger).
Is there any cleaver options to speed up string handling? It takes like 10-20 seconds per click with that size...

Re: Submenus / family tree / multidim array / subitems

Posted: Mon Apr 30, 2012 5:15 pm
by jesperbrannmark
Ok.
I replaced MID(string,start.l,1) with PeekB(@string+start.l-1) instead and now there is fast as lighting

Re: Submenus / family tree / multidim array / subitems

Posted: Mon Apr 30, 2012 5:18 pm
by graph100
use list with a structure containing list, it should be pretty instaneous

Re: Submenus / family tree / multidim array / subitems

Posted: Mon Apr 30, 2012 5:28 pm
by Danilo
jesperbrannmark wrote:Ok.
I replaced MID(string,start.l,1) with PeekB(@string+start.l-1) instead and now there is fast as lighting
Does not work with Unicode. Requires PeekC() and * SizeOf(Character)

Code: Select all

string.s = "abcdefg"
start.l  = 3

Debug Mid( string,start.l,1 )

; wrong
Debug Chr( PeekB(@string+start.l-1) )

; right
Debug Chr( PeekC( @string+( (start.l-1)*SizeOf(Character) ) ) )

Re: Submenus / family tree / multidim array / subitems

Posted: Mon Apr 30, 2012 7:02 pm
by graph100
Here try this code :

Tell me if this is quicker than yours with big Menu...

Code: Select all

;{ Structure

Structure __NestedMenu
	Name.s
	List Menu.__NestedMenu()
EndStructure

Structure NestedMenu
	Array Gadget.l(0)
	Menu.__NestedMenu
EndStructure


;}

;{ Procedure


Procedure NMenu_SetLevelGadget(*NMenu.NestedMenu, Level.l, Gadget.l) ; Level start at 0, and goes too the deep of your choice, the Gadget is the one which will display the items
	If Level > ArraySize(*NMenu\Gadget())
		ReDim *NMenu\Gadget(Level)
	EndIf
	
	*NMenu\Gadget(Level) = Gadget
EndProcedure


Procedure __recursive_reset(*menu.__NestedMenu)
	ForEach *menu\Menu()
		__recursive_reset(*menu\Menu())
	Next
	
	FreeList(*menu\Menu())
	ClearStructure(*menu, __NestedMenu)
EndProcedure

Procedure NMenu_Reset(*NMenu.NestedMenu)
	__recursive_reset(*NMenu\Menu)
	
	InitializeStructure(*NMenu, NestedMenu)
EndProcedure


Procedure NMenu_Add(*NMenu.NestedMenu, List_Nested_Menu.s)
	Protected i, pos, *Old_menu.__NestedMenu, char.s, no.b = #False
	Protected NewList *menu.__NestedMenu()
	
	; on nettoie les menus avant
	NMenu_Reset(*NMenu)
	
	AddElement(*menu())
	*menu() = *NMenu\Menu
	
	pos = 1
	
	For i = 1 To Len(List_Nested_Menu)
		char = Mid(List_Nested_Menu, i, 1)
		
		If char = "["
			*Old_menu = AddElement(*menu()\Menu())
			*Old_menu\Name = Mid(List_Nested_Menu, pos, i - pos)
			
; 			Debug "Niveau : " + Str(ListIndex(*menu())) + " : " + *Old_menu\Name
			
			pos = i + 1
			
			AddElement(*menu())
			*menu() = *Old_menu
			
			
		ElseIf no = #True
			no = #False
			pos = i + 1
			
			If char = "]"
				pos = i + 1
				no = #True
				
				DeleteElement(*menu())
			EndIf
			
			
		ElseIf char = ";"
			AddElement(*menu()\Menu())
			*menu()\Menu()\Name = Mid(List_Nested_Menu, pos, i - pos)
			
; 			Debug "Niveau : " + Str(ListIndex(*menu())) + " : " + *menu()\Menu()\Name
			
			pos = i + 1
			
		ElseIf char = "]"
			AddElement(*menu()\Menu())
			*menu()\Menu()\Name = Mid(List_Nested_Menu, pos, i - pos)
			
; 			Debug "Niveau : " + Str(ListIndex(*menu())) + " : " + *menu()\Menu()\Name
			
			pos = i + 1
			
			no = #True
			
			DeleteElement(*menu())
			
		EndIf
		
	Next
	
	
	
EndProcedure

Procedure NMenu_Update(*NMenu.NestedMenu, gadget.l)
	Protected level, i, state
	Protected *menu.__NestedMenu = *NMenu\Menu
	
	If gadget = -1 ; Initialization
		ForEach *menu\Menu()
			AddGadgetItem(*NMenu\Gadget(0), -1, *menu\Menu()\Name)
		Next
		
		ProcedureReturn 
	EndIf
	
	
	; we first find in which level the modification was
	For level = 0 To ArraySize(*NMenu\Gadget())
		If gadget = *NMenu\Gadget(level)
			Break
		EndIf
	Next
	
	For i = 0 To ArraySize(*NMenu\Gadget())
		If i <= level
			state = GetGadgetState(*NMenu\Gadget(i))
			
			If state = -1 Or state > ListSize(*menu\Menu()) - 1
				state = 0
				level = i
			EndIf
			
			SelectElement(*menu\Menu(), state)
			
			*menu = *menu\Menu()
			
		ElseIf i = level + 1
			ClearGadgetItems(*NMenu\Gadget(i))
			
			ForEach *menu\Menu()
				AddGadgetItem(*NMenu\Gadget(i), -1, *menu\Menu()\Name)
			Next
			
		Else
			ClearGadgetItems(*NMenu\Gadget(i))
			
		EndIf
	Next
	
EndProcedure


Procedure DEBUG__recursive_debug(*menu.__NestedMenu, level = 0)
	ForEach *menu\Menu()
		Debug "Level : " + Str(level) + " : " + *menu\Menu()\Name
		
		DEBUG__recursive_debug(*menu\Menu(), level + 1)
	Next
EndProcedure


;}


;{ Exemple

InitializeStructure(MyMenu.NestedMenu, NestedMenu)


original.s = "Fruit[Red[Apple;Plum];Green[Apple[Granny Smith;Winterfresh];Pear;Cactus];Yellow[Banana;Corn]];"
original.s + "Vegetable[Round[Tomato[Baby;Plum;Flat;Beef];Potato];Long[Cucumber]];"
original.s + "Others[Diary[Milk;Cream;Butter];Flour[Wheat;Whole grain]]"



OpenWindow(0, 0, 0, 640, 480, "NestedMenu", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
ListIconGadget(0,0,0,100,480,"Go", 95, #PB_ListIcon_AlwaysShowSelection)
ListIconGadget(1, 120, 0, 100, 480, "Go", 95, #PB_ListIcon_AlwaysShowSelection)
ListIconGadget(2, 240, 0, 100, 480, "Go", 95, #PB_ListIcon_AlwaysShowSelection)
ListIconGadget(3, 360, 0, 100, 480, "Go", 95, #PB_ListIcon_AlwaysShowSelection)



; We init the nested menu
NMenu_Add(MyMenu, original)

; We set the gadget which will display the Menu
For a = 0 To 3
	NMenu_SetLevelGadget(MyMenu, a, a)
Next

; DEBUG__recursive_debug(MyMenu\Menu)

NMenu_Update(MyMenu, -1)

Repeat
	event = WaitWindowEvent()
	
	If event = #PB_Event_Gadget
		Select EventGadget()
			Case 0, 1, 2, 3
				NMenu_Update(MyMenu, EventGadget())
				
		EndSelect
		
	EndIf
	
Until event = #PB_Event_CloseWindow


;}
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited