Ticket #309: viewsizenobug.2.icl

File viewsizenobug.2.icl, 1.2 KB (added by brassel, 9 years ago)
Line 
1module viewsizenobug
2
3import StdEnv, StdIO
4
5Start world = startIO SDI Void initialize [ProcessClose closeProcess] world
6  where
7    initialize pst 
8      # (wid,pst) = openId pst
9      # (error,pst) = openWindow Void (hello wid) pst
10      = pst
11     
12    hello wid = Window "Each click increases viewdomain by 1000"   
13              (TextControl "Hello" [])
14              [WindowClose (noLS closeProcess),
15               WindowViewSize {w=300, h=360},
16               WindowViewDomain {corner1=zero,corner2={x=1000,y=1000}},
17               WindowHScroll (slide Horizontal),
18               WindowVScroll (slide Vertical),
19               WindowMouse isUp Able (noLS1 (newView wid)),
20               WindowId wid,
21               WindowLook True look
22               ]
23   
24    isUp (MouseUp _ _) = True
25    isUp _ = False
26   
27    slide x = stdScrollFunction x 1
28
29    newView wid x pst
30      # (Just dom,pst) = accPIO (getWindowViewDomain wid) pst
31      # newDom = {dom & corner2={x=dom.corner2.x+1000,y=dom.corner2.y+1000}}
32      = appPIO (setWindowViewDomain wid newDom) pst
33
34    look _ {updArea} pict
35      # pict    = seq (map unfill updArea) pict
36      = drawAt {x=100, y=100} "xxx" pict