morecontrols.icl 1.91 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
implementation module morecontrols

import StdList
import  StdControl

// font name control

FontNameControl :: [.String] (String -> IdFun *(.a,.b)) .Index [.ControlAttribute *(.a,.b)] -> .PopUpControl .a .b;
FontNameControl names action initial atts =
  	PopUpControl
  	[ (name, (action name))
  	\\ name <- names
  	] initial (atts++[])

// font size control

FontSizeControl :: .[a] (a -> IdFun *(.b,.c)) .Index [.ControlAttribute *(.b,.c)] -> .PopUpControl .b .c | toString a;
FontSizeControl sizes action initial atts =
	PopUpControl
	[ (toString size, (action size))
	\\ size <- sizes
	] initial (atts++[])				// make editable...

//--

findNameInList :: a !.[a] -> Int | == a;
findNameInList name list
	= find 1 list
where
	find i [] = 0
	find i [h:t]
		| name==h = i
		= find (inc i) t

//==
import StdEnv,StdIO

:: FontNameSizeControl ls pst =
  FontNameSizeControl
	.String
	.Int
	[.String]
	[.Int]
	(String -> IdFun *(ls,pst))
	(Int -> IdFun *(ls,pst))
	[.ControlAttribute *(ls,pst)]

instance Controls FontNameSizeControl
where
	getControlType _ = "FontNameSizeControl"
	controlToHandles (FontNameSizeControl fontname fontsize fontNames fontSizes nameFun sizeFun atts) ps
		# (namesId,ps)	= openId ps
		# (sizesId,ps)	= openId ps
		# control
		      =	LayoutControl
		      	(	TextControl "Font:" [ left ]
			  	:+: FontNameControl fontNames nameFun (findNameInList fontname fontNames) [ControlId namesId]
				:+:	TextControl "Size:" [ left ]
				:+: FontSizeControl fontSizes sizeFun (findNameInList fontsize fontSizes) [ControlId sizesId]
				) (atts++[ControlHMargin 0 0,ControlVMargin 0 0])
61 62 63 64
		# selectfun = \fontname fontsize ps ->
						let
					    	namesIdx		= findNameInList fontname fontNames
					    	sizesIdx		= findNameInList fontsize fontSizes
Diederik van Arkel's avatar
Diederik van Arkel committed
65 66 67 68
				    	in appPIO (selectPopUpControlItem sizesId sizesIdx o selectPopUpControlItem namesId namesIdx) ps
		= controlToHandles control ps
	where
	    left = ControlPos (Left, zero)