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

no message

parent 079ce4c4
......@@ -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
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