#! ../mofe --f
# This script the useage of 
#  - pulldown menues
#  - popup menues
#  - cascaded menues
#  - option menues
# in mofe
# Gustaf Neumann                 Mohegan Lake, Oct 29, 1994

mergeResources topLevel \
    *menubar*tearOffModel TEAR_OFF_ENABLED \
    *XmPushButton.activateCallback {changePlace %w} \
    *draw*XmRowColumn.entryCallback {entry [widgetName %e]} \
    *header.scrolledWindowChildType COMMAND_WINDOW \
    *Help.sensitive false

proc mkColorItems {parent} {
  foreach color {green blue yellow red turquoise yellowgreen black pink} {
    XmPushButtonGadget $color $parent
} }

XmMainWindow main topLevel scrollingPolicy AUTOMATIC width 200 height 300
 XmMenuBar menubar main
  XmPulldownMenu pulldown menubar unmanaged 
   XmCascadeButtonGadget Colors pulldown
   XmSeparatorGadget sep pulldown
   XmPushButtonGadget quit pulldown \
       accelerator Ctrl<Key>C \
       acceleratorText Ctrl+C \
       activateCallback quit
  XmCascadeButtonGadget Actions menubar subMenuId pulldown mnemonic A

 XmRowColumn header main orientation HORIZONTAL
     XmLabel changeColor header 
     set SM [gV [XmSimpleOptionMenu places header] subMenuId]
     foreach place {foreground background area} { XmPushButton $place $SM }
     sV places menuHistory area
     sV places.OptionButton marginTop 2 marginBottom 2 

 XmDrawingArea draw main width 500 height 500 \
     inputCallback {input %=t}
 XmPopupMenu popup draw unmanaged 
   XmLabelGadget Colors popup
   XmSeparatorGadget sep popup
   mkColorItems popup

 XmPulldownMenu cascaded draw unmanaged
   mkColorItems cascaded

 sV Colors subMenuId cascaded
 sV main commandWindow header 
realize

proc entry {color} {
  global  widgets resource
  switch $color {
    quit { quit }
    default { foreach w $widgets { sV $w $resource $color } }
} }

proc input {eventType} {
  if ![string compare $eventType ButtonPress] {
    XmMenuPosition popup
    manageChild popup
} }

proc changePlace {where} {
  global widgets resource
  switch $where {
    area { set widgets draw; set resource background }
    background -
    foreground { 
      set widgets [concat menubar cascaded  popup  pulldown  \
	  main VertScrollBar HorScrollBar header  [gV header children]]
      set resource $where }
} }
changePlace area
