;;File: mwm-buttons.gwm --
;;Author: colas@mirsa.inria.fr (Colas NAHABOO) -- Bull Research FRANCE
;;Author: Frederic CHARTON
;;Revision: 1.0 -- Sep 12 19189
;;State: Exp
;;GWM Version: 1.4
; Drawing of the shadows :
; ----------------------
(de draw-shadow (theTile x1 y1 x2 y2 topSC bottomSC)
(with (foreground topSC)
(draw-line theTile x1 y1 x2 y1)
(draw-line theTile x1 y1 x1 y2 )
)
(with (foreground bottomSC)
(draw-line theTile x2 y2 x2 y1 )
(draw-line theTile x1 y2 x2 y2 )
)
theTile
)
; The FSM of buttons :
; ------------------
(: button.fsm
(fsm-make
;-----------------------------------------------------------NORMAL
(: normal (state-make
(on (user-event 'focus-in) (: wob-tile (# 'activepixmap wob)) )
(on (user-event 'focus-out) (: wob-tile (# 'pixmap wob)) )
(on (user-event 'find-button)
(if (= button-to-find (# 'button-name wob))
(: button wob)))
(on (double-button 1 alone)
(if (and (# 'is-button-menu wob) wMenuButtonClick2) ()))
(on (buttonpress any any)
(with (cerx (current-event-relative-x)
cery (current-event-relative-y))
(do-binding-button (current-event-code)
(current-event-modifier) 'press '(frame))
(if (= (current-event-code) (# 'button-to-press wob))
(send-user-event 'press wob)
))
)
(on (user-event 'press)
(progn
(: wob-tile (draw-shadow
wob-pixmap
0 0 (- wob-width 1) (- wob-height 1)
clientActiveBottomShadowColor clientActiveTopShadowColor
))
(send-user-event 'goto-pushed wob)
(if (and (> cerx 0)
(> cery 0)
(< cerx wob-width)
(< cery wob-height)
)
(eval (# 'press-action wob))
(eval (# 'bad-press-action wob))
)
)
)
(on (buttonrelease any any)
(with (cerx (current-event-relative-x)
cery (current-event-relative-y))
(do-binding-button (current-event-code)
(current-event-modifier) 'release '(frame))
(if (= (current-event-code) (# 'button-to-press wob))
(send-user-event 'release wob)
))
)
(on (user-event 'release)
(progn
(: wob-tile (draw-shadow
wob-pixmap
0 0 (- wob-width 1) (- wob-height 1)
clientActiveTopShadowColor clientActiveBottomShadowColor
))
(send-user-event 'goto-normal wob)
(if (and (> cerx 0)
(> cery 0)
(< cerx wob-width)
(< cery wob-height)
)
(eval (# 'release-action wob))
(eval (# 'bad-release-action wob))
)
)
)
(on (user-event 'goto-pushed) () pushed)
(on (user-event 'depop)
(if (# 'menu-son wob) (send-user-event 'depop (# 'menu-son wob))))
))
;-----------------------------------------------------------PUSHED
(: pushed (state-make
(on (user-event 'find-button)
(if (= button-to-find (# 'button-name wob))
(: button wob)))
(on (buttonrelease any any)
(with (cerx (current-event-relative-x)
cery (current-event-relative-y))
(do-binding-button (current-event-code)
(current-event-modifier) 'release '(frame))
(if (= (current-event-code) (# 'button-to-press wob))
(send-user-event 'release wob)
))
)
(on (user-event 'release)
(progn
(: wob-tile (draw-shadow
wob-pixmap
0 0 (- wob-width 1) (- wob-height 1)
clientActiveTopShadowColor clientActiveBottomShadowColor
))
(send-user-event 'goto-normal wob)
(if (and (> cerx 0)
(> cery 0)
(< cerx wob-width)
(< cery wob-height)
)
(eval (# 'release-action wob))
(eval (# 'bad-release-action wob))
)
)
)
(on (user-event 'goto-normal) () normal)
(on (user-event 'button-release)
(: wob-tile (draw-shadow
wob-pixmap
0 0 (- wob-width 1) (- wob-height 1)
clientActiveTopShadowColor clientActiveBottomShadowColor
)) normal
)
(on (user-event 'depop)
(if (# 'menu-son wob) (send-user-event 'depop (# 'menu-son wob))))
)
)
)
)
(de button.draw-pixmap (pixmap mode)
; mode : t = active / ()
(draw-shadow
(: button.pix
(with (background (if mode clientActiveBackground clientBackground))
(foreground (if mode clientActiveForeground clientForeground))
(pixmap-make pixmap)
))
0 0 (- (width button.pix) 1) (- (height button.pix) 1)
(if mode clientActiveTopShadowColor clientTopShadowColor)
(if mode clientActiveBottomShadowColor clientBottomShadowColor) )
)
; BUTTON.MAKE :
; ===========
; button.button-to-press : mouse button to use
; button.pixmap : button's pixmap
; button.press-action
; button.release-action
(de button.make ()
(with (
fsm button.fsm
borderwidth 0
property (+ (list
'button-to-press button.button-to-press
'press-action button.press-action
'bad-press-action button.bad-press-action
'release-action button.release-action
'bad-release-action button.bad-release-action
'pixmap button.pixmap
'activepixmap button.activepixmap
'already-popped ()
'button-name button.name
) property)
)
(plug-make button.pixmap)
)
)
; Drawing of the buttons :
; ----------------------
(de button.draw (x1 y1 x2 y2 mode)
; mode : t = active / ()
(draw-shadow
(draw-shadow
(with (foreground (if mode clientActiveBackground clientBackground))
(pixmap-make button.size button.size)
)
x2 y2 x1 y1
(if mode clientActiveBottomShadowColor clientBottomShadowColor)
(if mode clientActiveTopShadowColor clientTopShadowColor) )
0 0 (- button.size 1) (- button.size 1)
(if mode clientActiveTopShadowColor clientTopShadowColor)
(if mode clientActiveBottomShadowColor clientBottomShadowColor) )
)
(with (font clientFontList)
(: button.size (+ 4 (height "A"))))
(: menu-activate-by-wob ())
;==================================================================
; THE MWM-LIKE BUTTONS
;==================================================================
; BUTTON-OF-MENU :
; ==============
(: button-of-menu
(with (
property '(is-button-menu t)
button.button-to-press 1
button.pixmap (button.draw
(/ button.size 5) (- (/ button.size 2) 2)
(/ (* 4 button.size) 5) (+ (/ button.size 2) 2)
() )
button.activepixmap (button.draw
(/ button.size 5) (- (/ button.size 2) 2)
(/ (* 4 button.size) 5) (+ (/ button.size 2) 2)
t )
button.press-action
'(with (theMenuWob (menu-wob (window-menu)))
(if (# 'already-popped wob-property)
(progn
(send-user-event 'unselect-item
(# (current-valid-item theMenuWob)
(valid-items theMenuWob)))
(send-user-event 'activate-menu theMenuWob)
)
(progn
(## 'already-popped wob t)
(with (x wob-x y (+ wob-y wob-height))
(if (> (+ y (height theMenuWob)) screen-height)
(: y (- wob-y (height theMenuWob))))
(if (> (+ x (width theMenuWob)) screen-width)
(: x (- screen-width (width theMenuWob))))
(move-window theMenuWob x y)
(menu.pop (window-menu) 1 'here)
)
)
))
button.release-action
(if wMenuButtonClick
'(with (theMenuWob (menu-wob (window-menu)))
(with (wob theMenuWob)
(## 'current-valid-item wob 0))
(send-user-event 'goto-activable theMenuWob)
(send-user-event 'select-item
(# 0 (valid-items theMenuWob)) )
)
'(with (theMenuWob (menu-wob (window-menu)))
(send-user-event 'goto-activable theMenuWob)
(send-user-event 'unselect-item
(# (current-valid-item theMenuWob)
(valid-items theMenuWob)))
(send-user-event 'depop wob)
)
)
button.bad-release-action
'(with (theMenuWob (menu-wob (window-menu)))
(send-user-event 'goto-activable theMenuWob)
(send-user-event 'unselect-item
(# (current-valid-item theMenuWob)
(valid-items theMenuWob)))
(send-user-event 'depop theMenuWob)
)
button.bad-press-action
'(with (theMenuWob (menu-wob (window-menu)))
(send-user-event 'unselect-item
(# (current-valid-item theMenuWob)
(valid-items theMenuWob)))
(send-user-event 'activate-menu theMenuWob)
)
button.name 'menu
)
(button.make)
)
)
; BUTTON-ICONIFY :
; ==============
(: button-iconify
(with (
property ()
coord (/ (- button.size 4) 2)
button.button-to-press 1
button.pixmap (button.draw
coord coord (+ coord 4) (+ coord 4)
() )
button.activepixmap (button.draw
coord coord (+ coord 4) (+ coord 4)
t )
button.press-action ()
button.bad-press-action ()
button.release-action '(f.minimize)
button.bad-release-action ()
button.name 'iconify
)
(button.make)
)
)
; BUTTON-ZOOM :
; ===========
(: button-zoom
(with (
property (list
'pushed-pixmap
(button.draw
(- button.size 6) (- button.size 6)
5 5
() )
'activepushed-pixmap
(button.draw
(- button.size 6) (- button.size 6)
5 5
t )
)
button.button-to-press 1
button.pixmap (button.draw
5 5
(- button.size 6) (- button.size 6)
() )
button.activepixmap (button.draw
5 5
(- button.size 6) (- button.size 6)
t )
button.press-action ()
button.bad-press-action ()
button.release-action '(zoom)
button.bad-release-action ()
button.name 'zoom
)
(button.make)
)
)