-- The gui defined by this program does not behave as expected:
-- when starting the program, both sliders do nothing but print the 
-- message "old scrollfunction" in the shell.
-- This should be changed by clicking anywhere within the window.
-- But the change affects the horizontal scrollbar only, the vertical
-- one keeps printing the message.

import Graphics.UI.ObjectIO
import Debug.Trace

main = do cid <- openId
          startIO SDI () (openWindow undefined (theWindow cid)) [ProcessClose closeProcess]

theWindow cid = Window "Click should change scroll function" 
                  (CompoundControl NilLS 
		              [ ControlOuterSize size,
                        ControlViewDomain (Rectangle zero $ Point2 10000 10000),
                        ControlMouse (const True) Able 
                          (noLS1 mouseEvent),
                        ControlHScroll oldSlide,
                        ControlVScroll oldSlide,
                        ControlId cid])
                  [WindowViewSize size]
    where                  
      size = Size width height
      width = 300
      height = 360
      mouseEvent (MouseUp p _) ps = do
                   setControlScrollFunction cid Horizontal slide
                   setControlScrollFunction cid Vertical slide
                   return ps
      mouseEvent _ ps = return ps

oldSlide _ _ _ = trace "old scrollfunction" 42

slide viewFrame (SliderState{sliderThumb=st}) state
      =  case state of 
         SliderThumb i  -> i
         SliderIncSmall -> st+20 
         SliderDecSmall -> st-20
         SliderIncLarge -> st+100
         SliderDecLarge -> st-100