Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-and-itasks
clean-ide
Commits
cf9c89f2
Commit
cf9c89f2
authored
Dec 11, 2001
by
Diederik van Arkel
Browse files
no message
parent
079ce4c4
Changes
1
Hide whitespace changes
Inline
Side-by-side
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
w
in
dowId
header
font
headerId
in
istate
=
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
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment