Skip to content

GitLab

C
clean-ide
Commit cf9c89f2 authored by Diederik van Arkel's avatar Diederik van Arkel
Browse files
Options

no message

parent 079ce4c4
Hide whitespace changes
Inline Side-by-side
Showing with 97 additions and 67 deletions
Util/flexwin.icl
View file @ cf9c89f2
......@@ -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,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
where
getWindowType _ = "FlexBarWindow"
openWindow ls (FlexBarWindow title elts info look funs receiverId atts) ps
# (windowId,ps) = case hasWindowIdAtt of
Nothing -> openId ps
(Just wId) -> (wId,ps)
# (headerId,ps) = openId ps
# ((ok,font),ps) = accScreenPicture (openFont {fName="Courier New", fStyles=[BoldStyle],fSize=8}) 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}}
# (windowId,ps) = case hasWindowIdAtt of
Nothing -> openId ps
(Just wId) -> (wId,ps)
# (headerId,ps) = openId 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)
......@@ -304,31 +326,34 @@ mouseFunction _ (MouseDrag pos=:{x,y} mod) (fs=:{cursep,curcol,columnPoss,window
# fs = {fs & curcol = abs curcol}
# ps = appPIO (appControlPicture headerId (pressLook fs)) ps
= (fs,ps)
// # ps = appPIO (setControlLooks [(customId, False, (True,flexLook fs))]) ps
# ps = appPIO (appControlPicture headerId (unpressLook fs)) ps
# fs = {fs & curcol = ~curcol}
// # ps = appPIO (setControlLooks [(customId, False, (True,flexLook fs))]) ps
# ps = appPIO (appControlPicture headerId (unpressLook fs)) ps
# fs = {fs & curcol = ~curcol}
= (fs,ps)
# (vd,ps) = accPIO (getWindowViewDomain windowId) ps
| isNothing vd = (fs,ps)
# vd = fromJust vd
# (vd,ps) = accPIO (getWindowViewDomain windowId) 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...
# 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
# cp = /*trace_n ("csi: "+++toString (cursep))*/ (cursep)
#! cp = [0:columnPoss`]!!cp
// # vf = {corner1={x=cp,y=0},corner2={x=sz.corner2.x,y=fs.height}}
# (sz,ps) = accPIO (getWindowViewFrame windowId) ps
# cp = /*trace_n ("csi: "+++toString (cursep))*/ (cursep)
#! cp = [0:columnPoss`]!!cp
// # vf = {corner1={x=cp,y=0},corner2={x=sz.corner2.x,y=fs.height}}
// # 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
| (last columnPoss` > sz.corner2.x) || (vd.corner2.x > sz.corner2.x)
# domain = {vd & corner2 = {vd.corner2 & x = last columnPoss`}}
# ps = appPIO (setWindowViewDomain windowId domain) ps
# fs = {fs & domain = domain} // moet dan nu eigenlijk opnieuw look zetten...
# domain = {vd & corner2 = {vd.corner2 & x = last columnPoss`}}
# ps = appPIO (setWindowViewDomain windowId domain) ps
# fs = {fs & domain = domain} // moet dan nu eigenlijk opnieuw look zetten...
//--> moet hier ook header control size aanpassen...
= (fs,ps)
//*/
......@@ -338,11 +363,11 @@ mouseFunction _ (MouseDrag pos=:{x,y} mod) (fs=:{cursep,curcol,columnPoss,window
*/
= (fs,ps)
where
inVert = 0 <= y && y <= height
inHorz = findCol (dec (length hcols)) x hcols == abs curcol
hcols = [0:columnPoss]
isInside = inHorz && inVert
wasInside = curcol > 0
inVert = 0 <= y && y <= height
inHorz = findCol (dec (length hcols)) x hcols == abs curcol
hcols = [0:columnPoss]
isInside = inHorz && inVert
wasInside = curcol > 0
findCol -1 _ _ = 0
findCol i x l
......@@ -351,7 +376,6 @@ where
= inc i
= findCol (dec i) x l
dragCol _ _ [] = (False,[])
dragCol (-1) _ cs = (False,cs)
dragCol i x cs
......@@ -373,7 +397,7 @@ mouseFunction _ (MouseUp pos=:{x,y} mod) (fs=:{columnPoss,columnFuncs,windowId,h
# ps = appPIO (appControlPicture headerId (unpressLook fs)) ps
# fs = {fs & curcol = 0}
= (fs,ps)
# fs = {fs & curcol = 0}
# fs = {fs & curcol = 0}
= (fs,ps)
mouseFunction _ _ (fs=:{windowId,curcol},ps)
| curcol <> 0
......@@ -386,10 +410,11 @@ mouseFunction _ _ (fs=:{windowId,curcol},ps)
unpressLook :: !(FlexBarState s) !*Picture -> *Picture;
unpressLook fs=:{columnPoss,height,curcol} pict
| curcol == 0 = pict
# columnPoss` = [0:columnPoss]
# spos = columnPoss`!!(dec curcol)
# epos = columnPoss`!!curcol
| curcol == 0
= pict
# columnPoss` = [0:columnPoss]
# spos = columnPoss`!!(dec curcol)
# epos = columnPoss`!!curcol
= drawFrame height spos epos pict
// pressLook generates the pressed button look for the curcol pressed button...
......@@ -399,22 +424,22 @@ pressLook fs=:{columnPoss,height,curcol} pict
= pressLook pict
where
pressLook picture
# picture = setPenSize 1 picture
# columnPoss` = [0:columnPoss]
# spos = columnPoss`!!(dec curcol)
# epos = columnPoss`!!curcol
# picture = setPenColour Black 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 = setPenColour LighterGrey 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 = setPenColour Grey 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 = setPenColour LightGrey 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 = setPenSize 1 picture
# columnPoss` = [0:columnPoss]
# spos = columnPoss`!!(dec curcol)
# epos = columnPoss`!!curcol
# picture = setPenColour Black 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 = setPenColour LighterGrey 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 = setPenColour Grey 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 = setPenColour LightGrey 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
LighterGrey :: .Colour;
......@@ -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
......@@ -503,8 +528,8 @@ drawFrame height spos epos picture
//profileSize :: (a b) *Picture -> (.(Int,Int),.Picture) | length a;
profileSize lines pic
# (fMetrics,pic) = getPenFontMetrics pic
# line_height = fontLineHeight fMetrics
# height = content_size fMetrics lines
# line_height = fontLineHeight fMetrics
# height = content_size fMetrics lines
= ((height,line_height),pic)
//--
......@@ -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
Markdown is supported
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