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
Show 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,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
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
)
...
...
@@ -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
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