tabcontrol.icl 2.88 KB
Newer Older
Diederik van Arkel's avatar
Diederik van Arkel committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
implementation module tabcontrol

import StdEnum, StdFunc, StdList
import StdId, StdPSt, StdControl, windowhandle
import Platform

LighterGrey = RGB {r=225,g=225,b=225}
Vellum = RGB {r=200,g=225,b=255}


//--- Tab Control

:: TabControl c ls pst = TabControl (c ls pst) [ControlAttribute *(ls,pst)]

instance Controls (TabControl c) | Panes c
where
	getControlType _ = "TabControl"
	controlToHandles (TabControl tabs atts) ps
		# (rid,ps)		= openId ps
		# (ts,is,cs,ps)	= getLC tabs True rid ps
		# (sz,ps)		= controlSize (rdef rid ts is) False (Just (0,0)) (Just (0,0)) Nothing ps
		# (cs`,ps)		= controlToHandles (imp sz rid ts cs is atts) ps
		= (cs`,ps)

look sz ss us=:{newFrame} pc
	# pc = PlatformDependant pc (setPenBack White pc)
	# pc = PlatformDependant pc (stdUnfillUpdAreaLook ss us pc)

	# pc = setPenColour DarkGrey pc
	# pc = drawLine
			{x=left, y=yoffset}
			{x=right, y=yoffset}
			pc
	# pc = setPenColour LighterGrey pc
	# pc = drawLine
			{x=left, y=yoffset`}
			{x=right, y=yoffset`}
			pc
	# pc = PlatformDependant pc (setPenColour Black pc)
	= pc
where
	left		= newFrame.corner1.x
	right		= newFrame.corner2.x
	yoffset		= sz.h + 5
	yoffset`	= inc yoffset

imp sz rid labels panes ids atts
		= CompoundControl
		(	rdef rid labels ids
		:+:	(Handles panes)
		)
		[ControlLook True (look sz),ControlHMargin 0 0, ControlVMargin 0 0:atts]

rdef rid labels ids
	= RadioControl
		[ (label,Nothing,noLS (switchto x))
		\\	label <- labels
		&	x <- [0..]
		] (Columns 2) 1 [ControlId rid]
where
	switchto x ps
		= appPIO (showControl (ids!!x) o hideControls ids) ps

//--

66
:: Handles ls pst = Handles (pst -> *(*[ControlState ls pst],pst))
Diederik van Arkel's avatar
Diederik van Arkel committed
67
68
69
70
71
72

instance Controls Handles
where
	getControlType _ = "Handles"
	controlToHandles (Handles h) ps = h ps

73
:: Xane ls l :== (PSt l) -> *(*[ControlState ls (PSt l)],(PSt l))
Diederik van Arkel's avatar
Diederik van Arkel committed
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121

class Panes pdef
where
	getLC :: !(pdef .ls (PSt .l)) !Bool !Id !*(PSt .l) -> (![String],![Id],!Xane .ls .l,!*(PSt .l))
	

instance Panes (Pane c) | Controls c
where
	getLC (Pane t c) ini rid ps
		# (i,ps) = openId ps
		# h = controlToHandles (LayoutControl c
					[ ControlId i
					, ControlPos (Below rid,OffsetVector {vx=0,vy=10})
					, ControlHMargin 0 0
					, ControlVMargin 0 0
					: if ini [] [ControlHide]
					])
		= ([t],[i],h,ps)

instance Panes (:+: c1 c2) | Panes c1 & Panes c2
where
	getLC (c1 :+: c2) ini rid ps
		# (t1,i1,h1,ps) = getLC c1 ini rid ps
		# (t2,i2,h2,ps) = getLC c2 False rid ps
		= (t1++t2,i1++i2,hh h1 h2,ps)
	where
		hh h1 h2 ps
			# (hh1,ps) = h1 ps
			# (hh2,ps) = h2 ps
			= (hh1++hh2,ps)
/*
instance Panes (AddLS  c) | Panes c
where
	getLC NilLS ini rid ps = ([],[],[],ps)
instance Panes (NewLS  c) | Panes c
where
	getLC NilLS ini rid ps = ([],[],[],ps)
instance Panes (ListLS c) | Panes c
where
	getLC NilLS ini rid ps = ([],[],[],ps)
instance Panes NilLS
where
	getLC NilLS ini rid ps
		# h = controlToHandles NilLS
		= ([],[],h,ps)
*/

:: Pane c ls pst = Pane String (c ls pst)