#!/opt/rebol/rebview

REBOL [
	title: "Sample Menu"
	author: "François Vanzeveren"
	file: %menu.r
	version: 0.0.1
	history: [
		0.0.1 20-Feb-2011 "This file is created"
	]
]

g_menus: copy []
g_menus-titles: copy []

;======================================================================
; Gestion du comportement des menus:
;	1) Si un click a lieu en dehors de tout menu, il faut fermer tous
;		les menus ouverts
;	2) Si un click a lieu sur un menu (le titre ou le corps du menu), 
;		il faut fermer tous les autres menus, mais garder le menu
;		sélectionné (càd clické) ouvert (le titre et le corps) pour 
;		permettre son traitement en aval du flux du traitement des 
;		événements.
;
;======================================================================
close-menus-event: function [face event] [menus menus-titles index] [

	; 'face est un simple pointeur vers system/view/screen-face --> sans intérêt
	; 'event/face est un pointeur sur la FACE de la fenêtre dans laquelle 
	; l'événement a eu lieu, ce qui est intéressant pour restreindre
	; le périmètre d'application de la gestion globale des événements à une 
	; fenêtre en particulier (cfr ci-dessous).
	; 
	; Bref, nous devons mettre en place une solution de contournement pour 
	; retrouver la FACE qui a effectivement reçu l'événement!
	
	menus: copy g_menus
	menus-titles: copy g_menus-titles
	index: none 

	if all [equal? event/face main-win equal? event/type 'down] [
		foreach f event/face/pane [
			if all [f/show? greater-or-equal? event/offset/x f/offset/x
					greater-or-equal? event/offset/y f/offset/y 
					lesser-or-equal? event/offset/x add f/offset/x f/size/x
					lesser-or-equal? event/offset/y add f/offset/y f/size/y]
			[
				; Le click a eu lieu sur une FACE visible
				; Vérifions si le FACE clické est un menu (titre ou corps)
				index: find menus-titles f
				if none? index [index: find menus f]
				if not none? index [index: index? index]
				break
			]
		]
		if not none? index [
			; La FACE sur laquelle l'événement souris a eu lieu est un menu.
			; Nous le retirons de la liste des menus à fermer immédiatement
			remove at menus index
			remove at menus-titles index
		]
		
		foreach m menus-titles [
			m/state: false ; le titre du menu retourne à l'état de non sélectionné.
		]
		hide menus
		show g_menus-titles
	]
	event
]


insert-event-func :close-menus-event

main-win: layout/origin [
	; menu bar
	across
	space 0
	file-menu-title: toggle "Fichier" [
		either true? face/state [show file-menu] [hide file-menu]
	]
	
	edit-menu-title: toggle "Edition" [
		either true? face/state [show edit-menu] [hide edit-menu]
	]
		
	help-menu-title: toggle "Aide" [
		either true? face/state [show help-menu] [hide help-menu]
	]
	
	; File menu
	file-menu: panel sky [
		origin 0x0
		space 1x1
		tt "Nouveau..." [
			request/ok "Vous avez sélectionné [Fichier/Nouveau...]"
			hide face/parent-face
			file-menu-title/state: false
			show file-menu-title
		]
		tt "Ouvrir..." [
			request/ok "Vous avez sélectionné [Fichier/Ouvrir...]"
			hide face/parent-face
			file-menu-title/state: false
			show file-menu-title
		]
		tt "Fermer" [
			request/ok "Vous avez sélectionné [Fichier/Fermer]"
			hide face/parent-face
			file-menu-title/state: false
			show file-menu-title
		]
		box 180x1 coal
		tt "Enregistrer" [
			request/ok "Vous avez sélectionné [Fichier/Enregistrer]"
			hide face/parent-face
			file-menu-title/state: false
			show file-menu-title
		]
		tt "Enregistrer sous..." [
			request/ok "Vous avez sélectionné [Fichier/Enregistrer sous...]"
			hide face/parent-face
			file-menu-title/state: false
			show file-menu-title
		]
		box 180x1 coal
		tt "Mise en page..." [
			request/ok "Vous avez sélectionné [Fichier/Mise en page...]"
			hide face/parent-face
			file-menu-title/state: false
			show file-menu-title
		]
		tt "Aperçu avant impression..." [
			request/ok "Vous avez sélectionné [Fichier/Aperçu avant impression...]"
			hide face/parent-face
			file-menu-title/state: false
			show file-menu-title
		]
		tt "Imprimer..." [
			request/ok "Vous avez sélectionné [Fichier/Imprimer...]"
			hide face/parent-face
			file-menu-title/state: false
			show file-menu-title
		]
		box 180x1 coal
		tt "Exporter..." [
			request/ok "Vous avez sélectionné [Fichier/Exporter...]"
			hide face/parent-face
			file-menu-title/state: false
			show file-menu-title
		]
		tt "Importer..." [
			request/ok "Vous avez sélectionné [Fichier/Importer...]"
			hide face/parent-face
			file-menu-title/state: false
			show file-menu-title
		]
		box 180x1 coal
		tt "Propriétés..." [
			request/ok "Vous avez sélectionné [Fichier/Propriétés...]"
			hide face/parent-face
			file-menu-title/state: false
			show file-menu-title
		]
		box 180x1 coal
		tt "Quitter" [
			quit
		]
	] edge [color: coal size: 1x1]
	
	do [
		file-menu/show?: false
		file-menu/offset: add file-menu-title/offset to-pair reduce [0 file-menu-title/size/y]
		append g_menus file-menu
		append g_menus-titles file-menu-title
	]
	
	; Edit menu
	edit-menu: panel sky [
		origin 0x0
		space 1x1
		tt "Annuler" [
			request/ok "Vous avez sélectionné [Edition/Annuler]"
			hide face/parent-face
			edit-menu-title/state: false
			show edit-menu-title
		]
		tt "Rétablir" [
			request/ok "Vous avez sélectionné [Edition/Rétablir]"
			hide face/parent-face
			edit-menu-title/state: false
			show edit-menu-title
		]
		box 195x1 coal
		tt "Couper" [
			request/ok "Vous avez sélectionné [Edition/Couper]"
			hide face/parent-face
			edit-menu-title/state: false
			show edit-menu-title
		]
		tt "Copier" [
			request/ok "Vous avez sélectionné [Edition/Copier]"
			hide face/parent-face
			edit-menu-title/state: false
			show edit-menu-title
		]
		tt "Coller" [
			request/ok "Vous avez sélectionné [Edition/Coller]"
			hide face/parent-face
			edit-menu-title/state: false
			show edit-menu-title
		]
		tt "Tout sélectionner" [
			request/ok "Vous avez sélectionné [Edition/Tout sélectionner]"
			hide face/parent-face
			edit-menu-title/state: false
			show edit-menu-title
		]
		box 195x1 coal
		tt "Préférences..." [
			request/ok "Vous avez sélectionné [Edition/Préférences...]"
			hide face/parent-face
			edit-menu-title/state: false
			show edit-menu-title
		]
	] edge [color: coal size: 1x1]

	do [
		edit-menu/show?: false
		edit-menu/offset: add edit-menu-title/offset to-pair reduce [0 edit-menu-title/size/y]
		append g_menus edit-menu
		append g_menus-titles edit-menu-title
	]
		
	; Help menu
	help-menu: panel sky [
		origin 0x0
		space 1x1
		tt "Contenu..." [
			request/ok "Vous avez sélectionné [Aide/Contenu...]"
			hide face/parent-face
			help-menu-title/state: false
			show help-menu-title
		]
		tt "A propos de..." [
			request/ok "Vous avez sélectionné [Aide/A propos de...]"
			hide face/parent-face
			help-menu-title/state: false
			show help-menu-title
		]
	] edge [color:coal size: 1x1]

	do [
		help-menu/show?: false
		help-menu/offset: add help-menu-title/offset to-pair reduce [0 help-menu-title/size/y]
		append g_menus help-menu
		append g_menus-titles help-menu-title
	]
] 0x0

view main-win