no message

Util/flexwin.icl

@@ -9,9 +9,10 @@ o Button functions + header & body look updates...
 o Sensible size handling
 */
 
-import StdEnv, StdIO
-import StdDebug
-import ioutil
+//import StdEnv, StdIO
+import StdEnum, StdString, StdFunc, StdList, StdBool, StdTuple, StdMisc, StdArray
+import StdWindow, StdId, StdProcess, StdWindowAttribute, StdReceiver
+import StdPSt, StdPicture, StdControl, StdControlReceiver
 
 class content_size c :: FontMetrics c -> Int
 
@@ -51,7 +52,21 @@ mi2cw (Just w)
 
 //--
 
-::	FlexBarWindow s ls pst	= FlexBarWindow Title [(String, Maybe Int)] s (!s .Int .Int [.Int] -> (.SelectState .UpdateState -> .(*Picture -> *Picture))) ![(FlexBarState s) -> FlexBarState s]	(R2Id (MessageIn s) (MessageOut s)) [WindowAttribute *(ls,pst)]
+::	FlexBarWindow s ls pst
+	= FlexBarWindow
+		Title
+		[(String, Maybe Int)]
+		s
+		(!s .Int .Int [.Int] -> (.SelectState .UpdateState -> .(*Picture -> *Picture)))
+		![(FlexBarState s) -> FlexBarState s]
+		(R2Id (MessageIn s) (MessageOut s))
+		[WindowAttribute *(ls,pst)]
+
+flexFont =
+	{ fName		= "Courier New"
+	, fStyles	= [BoldStyle]
+	, fSize		= 8
+	}
 
 instance Windows (FlexBarWindow s) | content_size s
 where
@@ -61,34 +76,39 @@ where
 										Nothing		-> openId ps
 										(Just wId)	-> (wId,ps)
 		# (headerId,ps)				= openId ps
-		# ((ok,font),ps) = accScreenPicture (openFont {fName="Courier New",    fStyles=[BoldStyle],fSize=8}) ps 
+		# ((ok,font),ps)			= accScreenPicture (openFont flexFont) ps 
 		# (metrics,ps)				= accScreenPicture (getFontMetrics font) ps
 		# ((size,line_height),ps)	= accScreenPicture (profileSize info o (setPenFont font)) ps
 		# domain					= {zero & corner2 = {x=last columnPoss,y=height + size}}
+		# inistate					= newstate info domain line_height metrics headerId windowId
 		= openWindow
-			(newstate info domain line_height metrics headerId windowId)
-			(Window title (header info domain line_height metrics font headerId windowId) (newatts info domain font size line_height metrics headerId windowId)) ps
+			inistate
+			(Window
+				title
+				(header font headerId inistate)
+				(newatts domain font line_height windowId inistate)
+			) ps
 	where
 		hasWindowIdAtt
 			 # los = filter (isWindowId) atts
 			 | isEmpty los = Nothing
 			 = Just (getWindowIdAtt (hd los))
-		header info domain line_height metrics font headerId windowId
+		header font headerId inistate
 			= CustomControl
 				{w=4096,h=height}			// zinniger maximum invullen???
 				(headerLook height columnTexts columnPoss`)
 				[ControlId headerId
-				,ControlMouse mouseFilter Able (mouseFunction (newstate info domain line_height metrics headerId windowId))
+				,ControlMouse mouseFilter Able (mouseFunction inistate)
 				,ControlPos (Fix,OffsetFun 1 (\({corner1={x}},{y})->{vx = x,vy = y}))
 				,ControlPen [PenFont font]
 				]
 			:+: Receiver2 receiverId receiver []
-		newatts info domain font size line_height metrics headerId windowId = 
+		newatts domain font line_height windowId inistate = 
 			[ WindowPen [PenBack Vellum, PenFont font]
-			, WindowLook True (flexLook (newstate info domain line_height metrics headerId windowId))
+			, WindowLook True (flexLook inistate)
 			, WindowViewDomain domain
 			, WindowId windowId
-			, WindowMouse mouseFilter Able (mouseFunction (newstate info domain line_height metrics headerId windowId))
+			, WindowMouse mouseFilter Able (mouseFunction inistate)
 			, WindowKeyboard keyboardFilter Able (keyboardFunction)
 			, WindowHScroll (myScrollFunction Horizontal LR_STEP)
 			, WindowVScroll (myScrollFunction Vertical line_height)
@@ -213,6 +233,7 @@ where
 		
 keyboardFunction _ (fs,ps)
 	= (fs,ps)
+
 //--
 
 receiver :: (MessageIn s) (FlexBarState s, PSt .l) -> (MessageOut s,(FlexBarState s, PSt .l)) | content_size s
@@ -293,7 +314,8 @@ where
 		= findCol (dec i) x l
 		
 mouseFunction _ (MouseDrag pos=:{x,y} mod) (fs=:{cursep,curcol,columnPoss,windowId,headerId,height},ps)
-	| isEmpty columnPoss = (fs,ps)
+	| isEmpty columnPoss
+		= (fs,ps)
 	| cursep == ~1
 		| curcol == 0 || curcol > length columnPoss
 			= (fs,ps)
@@ -309,11 +331,14 @@ mouseFunction _ (MouseDrag pos=:{x,y} mod) (fs=:{cursep,curcol,columnPoss,window
 		# fs		= {fs & curcol = ~curcol}
 		= (fs,ps)
 	# (vd,ps)		= accPIO (getWindowViewDomain windowId) ps
-	| isNothing vd = (fs,ps)
+	| isNothing vd
+		= (fs,ps)
 	# vd			= fromJust vd
 
-	# (changed,columnPoss`)	= dragCol cursep x columnPoss
-	| not changed = (fs,ps)
+	# (changed,columnPoss`)
+					= dragCol cursep x columnPoss
+	| not changed
+		= (fs,ps)
 	# fs			= {fs & columnPoss = columnPoss`}
 ///*
 	# ps			= appPIO (setWindowLook windowId False (True,flexLook fs)) ps	// need to optimize this...
@@ -351,7 +376,6 @@ where
 			= inc i
 		= findCol (dec i) x l
 		
-	
 	dragCol _ _ [] = (False,[])
 	dragCol (-1) _ cs = (False,cs)
 	dragCol i x cs
@@ -386,7 +410,8 @@ mouseFunction _ _ (fs=:{windowId,curcol},ps)
 
 unpressLook :: !(FlexBarState s) !*Picture -> *Picture;
 unpressLook fs=:{columnPoss,height,curcol} pict
-	| curcol == 0 = pict
+	| curcol == 0
+		= pict
 	# columnPoss`	= [0:columnPoss]
 	# spos			= columnPoss`!!(dec curcol)
 	# epos			= columnPoss`!!curcol
@@ -431,7 +456,7 @@ flexLook flexbarState=:{columnTexts,columnPoss,height,line_height,info,body_look
 		, back_look domain ss us
 		]
 	
-headerLook :: .Int [.{#Char}] [.Int] .a !.UpdateState -> .(*Picture -> .Picture);
+headerLook :: .Int [.{#Char}] [.Int] .a !.UpdateState -> .(*Picture -> *Picture);
 headerLook height columnTexts columnPoss ss us=:{newFrame,updArea}
 	= seq
 	[ setPenColour backgroundColour
@@ -482,7 +507,7 @@ where
 		cwidth = epos - spos
 		kwidth = cwidth - leading - trailing
 	
-drawFrame :: !.Int !.Int !.Int !*Picture -> .Picture;
+drawFrame :: !.Int !.Int !.Int !*Picture -> *Picture;
 drawFrame height spos epos picture
 	# picture	= setPenColour LighterGrey picture
 	# picture	= drawAt {x=spos,y=0} {zero & vx = epos-spos-1} picture
@@ -544,3 +569,8 @@ where
 			SliderDecLarge	-> x-edge/d*d
 			SliderThumb x	-> x	//x/d*d
 
+//--
+
+instance accScreenPicture (PSt .l)
+where
+	accScreenPicture f ps = accPIO (accScreenPicture f) ps