Commit cf9c89f2 authored by Diederik van Arkel's avatar Diederik van Arkel
Browse files

no message

parent 079ce4c4
...@@ -9,9 +9,10 @@ o Button functions + header & body look updates... ...@@ -9,9 +9,10 @@ o Button functions + header & body look updates...
o Sensible size handling o Sensible size handling
*/ */
import StdEnv, StdIO //import StdEnv, StdIO
import StdDebug import StdEnum, StdString, StdFunc, StdList, StdBool, StdTuple, StdMisc, StdArray
import ioutil import StdWindow, StdId, StdProcess, StdWindowAttribute, StdReceiver
import StdPSt, StdPicture, StdControl, StdControlReceiver
class content_size c :: FontMetrics c -> Int class content_size c :: FontMetrics c -> Int
...@@ -51,44 +52,63 @@ mi2cw (Just w) ...@@ -51,44 +52,63 @@ 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 instance Windows (FlexBarWindow s) | content_size s
where where
getWindowType _ = "FlexBarWindow" getWindowType _ = "FlexBarWindow"
openWindow ls (FlexBarWindow title elts info look funs receiverId atts) ps openWindow ls (FlexBarWindow title elts info look funs receiverId atts) ps
# (windowId,ps) = case hasWindowIdAtt of # (windowId,ps) = case hasWindowIdAtt of
Nothing -> openId ps Nothing -> openId ps
(Just wId) -> (wId,ps) (Just wId) -> (wId,ps)
# (headerId,ps) = openId 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 # (metrics,ps) = accScreenPicture (getFontMetrics font) ps
# ((size,line_height),ps) = accScreenPicture (profileSize info o (setPenFont font)) ps # ((size,line_height),ps) = accScreenPicture (profileSize info o (setPenFont font)) ps
# domain = {zero & corner2 = {x=last columnPoss,y=height + size}} # domain = {zero & corner2 = {x=last columnPoss,y=height + size}}
# inistate = newstate info domain line_height metrics headerId windowId
= openWindow = openWindow
(newstate info domain line_height metrics headerId windowId) inistate
(Window title (header info domain line_height metrics font headerId windowId) (newatts info domain font size line_height metrics headerId windowId)) ps (Window
title
(header font headerId inistate)
(newatts domain font line_height windowId inistate)
) ps
where where
hasWindowIdAtt hasWindowIdAtt
# los = filter (isWindowId) atts # los = filter (isWindowId) atts
| isEmpty los = Nothing | isEmpty los = Nothing
= Just (getWindowIdAtt (hd los)) = Just (getWindowIdAtt (hd los))
header info domain line_height metrics font headerId windowId header font headerId inistate
= CustomControl = CustomControl
{w=4096,h=height} // zinniger maximum invullen??? {w=4096,h=height} // zinniger maximum invullen???
(headerLook height columnTexts columnPoss`) (headerLook height columnTexts columnPoss`)
[ControlId headerId [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})) ,ControlPos (Fix,OffsetFun 1 (\({corner1={x}},{y})->{vx = x,vy = y}))
,ControlPen [PenFont font] ,ControlPen [PenFont font]
] ]
:+: Receiver2 receiverId receiver [] :+: 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] [ WindowPen [PenBack Vellum, PenFont font]
, WindowLook True (flexLook (newstate info domain line_height metrics headerId windowId)) , WindowLook True (flexLook inistate)
, WindowViewDomain domain , WindowViewDomain domain
, WindowId windowId , WindowId windowId
, WindowMouse mouseFilter Able (mouseFunction (newstate info domain line_height metrics headerId windowId)) , WindowMouse mouseFilter Able (mouseFunction inistate)
, WindowKeyboard keyboardFilter Able (keyboardFunction) , WindowKeyboard keyboardFilter Able (keyboardFunction)
, WindowHScroll (myScrollFunction Horizontal LR_STEP) , WindowHScroll (myScrollFunction Horizontal LR_STEP)
, WindowVScroll (myScrollFunction Vertical line_height) , WindowVScroll (myScrollFunction Vertical line_height)
...@@ -213,6 +233,7 @@ where ...@@ -213,6 +233,7 @@ where
keyboardFunction _ (fs,ps) keyboardFunction _ (fs,ps)
= (fs,ps) = (fs,ps)
//-- //--
receiver :: (MessageIn s) (FlexBarState s, PSt .l) -> (MessageOut s,(FlexBarState s, PSt .l)) | content_size s receiver :: (MessageIn s) (FlexBarState s, PSt .l) -> (MessageOut s,(FlexBarState s, PSt .l)) | content_size s
...@@ -293,7 +314,8 @@ where ...@@ -293,7 +314,8 @@ where
= findCol (dec i) x l = findCol (dec i) x l
mouseFunction _ (MouseDrag pos=:{x,y} mod) (fs=:{cursep,curcol,columnPoss,windowId,headerId,height},ps) mouseFunction _ (MouseDrag pos=:{x,y} mod) (fs=:{cursep,curcol,columnPoss,windowId,headerId,height},ps)
| isEmpty columnPoss = (fs,ps) | isEmpty columnPoss
= (fs,ps)
| cursep == ~1 | cursep == ~1
| curcol == 0 || curcol > length columnPoss | curcol == 0 || curcol > length columnPoss
= (fs,ps) = (fs,ps)
...@@ -304,31 +326,34 @@ mouseFunction _ (MouseDrag pos=:{x,y} mod) (fs=:{cursep,curcol,columnPoss,window ...@@ -304,31 +326,34 @@ mouseFunction _ (MouseDrag pos=:{x,y} mod) (fs=:{cursep,curcol,columnPoss,window
# fs = {fs & curcol = abs curcol} # fs = {fs & curcol = abs curcol}
# ps = appPIO (appControlPicture headerId (pressLook fs)) ps # ps = appPIO (appControlPicture headerId (pressLook fs)) ps
= (fs,ps) = (fs,ps)
// # ps = appPIO (setControlLooks [(customId, False, (True,flexLook fs))]) ps // # ps = appPIO (setControlLooks [(customId, False, (True,flexLook fs))]) ps
# ps = appPIO (appControlPicture headerId (unpressLook fs)) ps # ps = appPIO (appControlPicture headerId (unpressLook fs)) ps
# fs = {fs & curcol = ~curcol} # fs = {fs & curcol = ~curcol}
= (fs,ps) = (fs,ps)
# (vd,ps) = accPIO (getWindowViewDomain windowId) ps # (vd,ps) = accPIO (getWindowViewDomain windowId) ps
| isNothing vd = (fs,ps) | isNothing vd
# vd = fromJust vd = (fs,ps)
# vd = fromJust vd
# (changed,columnPoss`) = dragCol cursep x columnPoss # (changed,columnPoss`)
| not changed = (fs,ps) = dragCol cursep x columnPoss
| not changed
= (fs,ps)
# fs = {fs & columnPoss = columnPoss`} # fs = {fs & columnPoss = columnPoss`}
///* ///*
# ps = appPIO (setWindowLook windowId False (True,flexLook fs)) ps // need to optimize this... # ps = appPIO (setWindowLook windowId False (True,flexLook fs)) ps // need to optimize this...
# ps = appPIO (setControlLook headerId True (True,headerLook fs.height fs.columnTexts [0:fs.columnPoss])) ps // need to optimize this... # ps = appPIO (setControlLook headerId True (True,headerLook fs.height fs.columnTexts [0:fs.columnPoss])) ps // need to optimize this...
# (sz,ps) = accPIO (getWindowViewFrame windowId) ps # (sz,ps) = accPIO (getWindowViewFrame windowId) ps
# cp = /*trace_n ("csi: "+++toString (cursep))*/ (cursep) # cp = /*trace_n ("csi: "+++toString (cursep))*/ (cursep)
#! cp = [0:columnPoss`]!!cp #! cp = [0:columnPoss`]!!cp
// # vf = {corner1={x=cp,y=0},corner2={x=sz.corner2.x,y=fs.height}} // # vf = {corner1={x=cp,y=0},corner2={x=sz.corner2.x,y=fs.height}}
// # ps = appPIO (updateWindow windowId (Just vf)) ps // # ps = appPIO (updateWindow windowId (Just vf)) ps
# vf = {corner1={x=cp,y=height},corner2={x=sz.corner2.x,y=sz.corner2.y}} # vf = {corner1={x=cp,y=height},corner2={x=sz.corner2.x,y=sz.corner2.y}}
# ps = appPIO (updateWindow windowId (Just vf)) ps # ps = appPIO (updateWindow windowId (Just vf)) ps
| (last columnPoss` > sz.corner2.x) || (vd.corner2.x > sz.corner2.x) | (last columnPoss` > sz.corner2.x) || (vd.corner2.x > sz.corner2.x)
# domain = {vd & corner2 = {vd.corner2 & x = last columnPoss`}} # domain = {vd & corner2 = {vd.corner2 & x = last columnPoss`}}
# ps = appPIO (setWindowViewDomain windowId domain) ps # ps = appPIO (setWindowViewDomain windowId domain) ps
# fs = {fs & domain = domain} // moet dan nu eigenlijk opnieuw look zetten... # fs = {fs & domain = domain} // moet dan nu eigenlijk opnieuw look zetten...
//--> moet hier ook header control size aanpassen... //--> moet hier ook header control size aanpassen...
= (fs,ps) = (fs,ps)
//*/ //*/
...@@ -338,11 +363,11 @@ mouseFunction _ (MouseDrag pos=:{x,y} mod) (fs=:{cursep,curcol,columnPoss,window ...@@ -338,11 +363,11 @@ mouseFunction _ (MouseDrag pos=:{x,y} mod) (fs=:{cursep,curcol,columnPoss,window
*/ */
= (fs,ps) = (fs,ps)
where where
inVert = 0 <= y && y <= height inVert = 0 <= y && y <= height
inHorz = findCol (dec (length hcols)) x hcols == abs curcol inHorz = findCol (dec (length hcols)) x hcols == abs curcol
hcols = [0:columnPoss] hcols = [0:columnPoss]
isInside = inHorz && inVert isInside = inHorz && inVert
wasInside = curcol > 0 wasInside = curcol > 0
findCol -1 _ _ = 0 findCol -1 _ _ = 0
findCol i x l findCol i x l
...@@ -351,7 +376,6 @@ where ...@@ -351,7 +376,6 @@ where
= inc i = inc i
= findCol (dec i) x l = findCol (dec i) x l
dragCol _ _ [] = (False,[]) dragCol _ _ [] = (False,[])
dragCol (-1) _ cs = (False,cs) dragCol (-1) _ cs = (False,cs)
dragCol i x cs dragCol i x cs
...@@ -373,7 +397,7 @@ mouseFunction _ (MouseUp pos=:{x,y} mod) (fs=:{columnPoss,columnFuncs,windowId,h ...@@ -373,7 +397,7 @@ mouseFunction _ (MouseUp pos=:{x,y} mod) (fs=:{columnPoss,columnFuncs,windowId,h
# ps = appPIO (appControlPicture headerId (unpressLook fs)) ps # ps = appPIO (appControlPicture headerId (unpressLook fs)) ps
# fs = {fs & curcol = 0} # fs = {fs & curcol = 0}
= (fs,ps) = (fs,ps)
# fs = {fs & curcol = 0} # fs = {fs & curcol = 0}
= (fs,ps) = (fs,ps)
mouseFunction _ _ (fs=:{windowId,curcol},ps) mouseFunction _ _ (fs=:{windowId,curcol},ps)
| curcol <> 0 | curcol <> 0
...@@ -386,10 +410,11 @@ mouseFunction _ _ (fs=:{windowId,curcol},ps) ...@@ -386,10 +410,11 @@ mouseFunction _ _ (fs=:{windowId,curcol},ps)
unpressLook :: !(FlexBarState s) !*Picture -> *Picture; unpressLook :: !(FlexBarState s) !*Picture -> *Picture;
unpressLook fs=:{columnPoss,height,curcol} pict unpressLook fs=:{columnPoss,height,curcol} pict
| curcol == 0 = pict | curcol == 0
# columnPoss` = [0:columnPoss] = pict
# spos = columnPoss`!!(dec curcol) # columnPoss` = [0:columnPoss]
# epos = columnPoss`!!curcol # spos = columnPoss`!!(dec curcol)
# epos = columnPoss`!!curcol
= drawFrame height spos epos pict = drawFrame height spos epos pict
// pressLook generates the pressed button look for the curcol pressed button... // pressLook generates the pressed button look for the curcol pressed button...
...@@ -399,22 +424,22 @@ pressLook fs=:{columnPoss,height,curcol} pict ...@@ -399,22 +424,22 @@ pressLook fs=:{columnPoss,height,curcol} pict
= pressLook pict = pressLook pict
where where
pressLook picture pressLook picture
# picture = setPenSize 1 picture # picture = setPenSize 1 picture
# columnPoss` = [0:columnPoss] # columnPoss` = [0:columnPoss]
# spos = columnPoss`!!(dec curcol) # spos = columnPoss`!!(dec curcol)
# epos = columnPoss`!!curcol # epos = columnPoss`!!curcol
# picture = setPenColour Black picture # picture = setPenColour Black picture
# picture = drawAt {x=spos,y=0} {zero & vx = epos-spos-1} picture # picture = drawAt {x=spos,y=0} {zero & vx = epos-spos-1} picture
# picture = drawAt {x=spos,y=0} {zero & vy = height-1} picture # picture = drawAt {x=spos,y=0} {zero & vy = height-1} picture
# picture = setPenColour LighterGrey picture # picture = setPenColour LighterGrey picture
# picture = drawAt {x=spos,y=height-1} {zero & vx = epos-spos} picture # picture = drawAt {x=spos,y=height-1} {zero & vx = epos-spos} picture
# picture = drawAt {x=epos-1,y=0} {zero & vy = height-1} picture # picture = drawAt {x=epos-1,y=0} {zero & vy = height-1} picture
# picture = setPenColour Grey picture # picture = setPenColour Grey picture
# picture = drawAt {x=spos+1,y=1} {zero & vx = epos-spos-3} picture # picture = drawAt {x=spos+1,y=1} {zero & vx = epos-spos-3} picture
# picture = drawAt {x=spos+1,y=1} {zero & vy = height-3} picture # picture = drawAt {x=spos+1,y=1} {zero & vy = height-3} picture
# picture = setPenColour LightGrey picture # picture = setPenColour LightGrey picture
# picture = drawAt {x=spos+2,y=height-2} {zero & vx = epos-spos-2} picture # picture = drawAt {x=spos+2,y=height-2} {zero & vx = epos-spos-2} picture
# picture = drawAt {x=epos-2,y=1} {zero & vy = height-3} picture # picture = drawAt {x=epos-2,y=1} {zero & vy = height-3} picture
= picture = picture
LighterGrey :: .Colour; LighterGrey :: .Colour;
...@@ -431,7 +456,7 @@ flexLook flexbarState=:{columnTexts,columnPoss,height,line_height,info,body_look ...@@ -431,7 +456,7 @@ flexLook flexbarState=:{columnTexts,columnPoss,height,line_height,info,body_look
, back_look domain ss us , 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} headerLook height columnTexts columnPoss ss us=:{newFrame,updArea}
= seq = seq
[ setPenColour backgroundColour [ setPenColour backgroundColour
...@@ -482,7 +507,7 @@ where ...@@ -482,7 +507,7 @@ where
cwidth = epos - spos cwidth = epos - spos
kwidth = cwidth - leading - trailing kwidth = cwidth - leading - trailing
drawFrame :: !.Int !.Int !.Int !*Picture -> .Picture; drawFrame :: !.Int !.Int !.Int !*Picture -> *Picture;
drawFrame height spos epos picture drawFrame height spos epos picture
# picture = setPenColour LighterGrey picture # picture = setPenColour LighterGrey picture
# picture = drawAt {x=spos,y=0} {zero & vx = epos-spos-1} picture # picture = drawAt {x=spos,y=0} {zero & vx = epos-spos-1} picture
...@@ -503,8 +528,8 @@ drawFrame height spos epos picture ...@@ -503,8 +528,8 @@ drawFrame height spos epos picture
//profileSize :: (a b) *Picture -> (.(Int,Int),.Picture) | length a; //profileSize :: (a b) *Picture -> (.(Int,Int),.Picture) | length a;
profileSize lines pic profileSize lines pic
# (fMetrics,pic) = getPenFontMetrics pic # (fMetrics,pic) = getPenFontMetrics pic
# line_height = fontLineHeight fMetrics # line_height = fontLineHeight fMetrics
# height = content_size fMetrics lines # height = content_size fMetrics lines
= ((height,line_height),pic) = ((height,line_height),pic)
//-- //--
...@@ -544,3 +569,8 @@ where ...@@ -544,3 +569,8 @@ where
SliderDecLarge -> x-edge/d*d SliderDecLarge -> x-edge/d*d
SliderThumb x -> x //x/d*d SliderThumb x -> x //x/d*d
//--
instance accScreenPicture (PSt .l)
where
accScreenPicture f ps = accPIO (accScreenPicture f) ps
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment