Ticket #309: viewsizebug.2.hs

File viewsizebug.2.hs, 1.7 KB (added by brassel, 9 years ago)
Line 
1-- Each click in the window should increase the view domain. But this never happens,
2-- as the debug output and the peculiar scrollbar-behaviour reveal.
3-- When replacing the TextControl with NilLS the resulting window suddenly
4-- shows the wanted behaviour. Compare also with the Clean program viewsizenobug.icl
5import Graphics.UI.ObjectIO
6
7main = do wid <- openId
8          startIO SDI () (openWindow undefined (theWindow wid)) [ProcessClose closeProcess]
9
10theWindow wid = Window "Each click should increase viewdomain by 1000" 
11                  (TextControl "Hello" [ControlPos (Center,zero)])
12                  -- try NilLS instead of the above TextControl!
13                  [WindowId wid,
14                       WindowViewSize size,
15                       WindowViewDomain (Rectangle zero (Point2 width height)),
16                       WindowHScroll slide,
17                       WindowVScroll slide,
18                       WindowMouse (const True) Able (noLS1 mouseEvent)
19                  ]
20    where                 
21      size = Size width height
22      width = 300
23      height = 360
24      mouseEvent (MouseUp p _) ps = do
25                   (Just dom) <- getWindowViewDomain wid
26                   let Point2 width height = corner2 dom
27                       newdom = dom {corner2 = Point2 (width + 1000) (height+1000)}
28                   setWindowViewDomain wid newdom
29                   liftIO $ print newdom --debug output
30                   return ps
31      mouseEvent _ ps = return ps
32
33slide viewFrame (SliderState{sliderThumb=st}) state
34      =  case state of 
35         SliderThumb i  -> i
36         SliderIncSmall -> st+20 
37         SliderDecSmall -> st-20
38         SliderIncLarge -> st+100
39         SliderDecLarge -> st-100