Skip to content
GitLab
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-libraries
Commits
3cb3e377
Commit
3cb3e377
authored
Nov 29, 1999
by
Peter Achten
Browse files
(PA): moveWindowViewFrame now takes advantage of system look.
parent
42aafe76
Changes
6
Hide whitespace changes
Inline
Side-by-side
ObjectIO/ObjectIO/controlpos.icl
View file @
3cb3e377
...
...
@@ -3,7 +3,7 @@ implementation module controlpos
// Clean Object I/O library version 1.2
import
StdBool
,
StdFunc
,
StdMisc
,
StdTuple
import
StdBool
,
StdFunc
,
StdInt
,
StdList
,
StdMisc
,
StdTuple
import
commondef
,
windowaccess
from
controllayout
import
layoutControls
,
getWindowContentRect
from
controlrelayout
import
relayoutControls
...
...
@@ -11,65 +11,108 @@ from windowclipstate import forceValidWindowClipState
from
windowdefaccess
import
isWindowItemSpace
,
getWindowItemSpaceAtt
,
isWindowHMargin
,
getWindowHMarginAtt
,
isWindowVMargin
,
getWindowVMarginAtt
from
windowdraw
import
drawwindowlook
from
windowdraw
import
drawwindowlook
`
from
windowupdate
import
updatewindowbackgrounds
from
ospicture
import
pictscroll
from
osrgn
import
osgetrgnbox
from
ostypes
import
Rect
from
ostoolbox
import
OSToolbox
from
oswindow
import
OSWindowMetrics
,
OSscrollbarsAreVisible
,
OSsetWindowSliderThumb
,
toOSscrollbarRange
,
OSMinWindowSize
controlposFatalError
::
String
String
->
.
x
controlposFatalError
function
error
=
FatalError
function
"controlpos"
error
/* movewindowviewframe moves the current view frame of the WindowHandle by the given Vector2.
movewindowviewframe assumes that the argument WindowHandle is a Window.
*/
movewindowviewframe
::
!
OSWindowMetrics
!
Vector2
!
WIDS
!(
WindowHandle
.
ls
.
pst
)
!*
OSToolbox
->
(!
WindowHandle
.
ls
.
pst
,!*
OSToolbox
)
movewindowviewframe
wMetrics
v
wids
=:{
wPtr
}
wH
tb
#
visScrolls
=
OSscrollbarsAreVisible
wMetrics
(
RectangleToRect
domain
)
(
toTuple
wSize
)
(
hasHScroll
,
hasVScroll
)
contentRect
=
getWindowContentRect
wMetrics
visScrolls
(
SizeToRect
wSize
)
contentSize
=
RectSize
contentRect
(
minx
,
maxx
,
viewx
)
=
(
domainRect
.
rleft
,
domainRect
.
rright
,
contentSize
.
w
)
(
miny
,
maxy
,
viewy
)
=
(
domainRect
.
rtop
,
domainRect
.
rbottom
,
contentSize
.
h
)
newOrigin
=
movePoint
v
oldOrigin
newOrigin
=
{
x
=
SetBetween
newOrigin
.
x
minx
(
maxx
-
viewx
),
y
=
SetBetween
newOrigin
.
y
miny
(
maxy
-
viewy
)}
movewindowviewframe
wMetrics
v
wids
=:{
wPtr
}
wH
=:{
whWindowInfo
,
whItems
=
oldItems
,
whSize
,
whAtts
,
whSelect
}
tb
|
newOrigin
==
oldOrigin
=
(
wH
,
tb
)
|
otherwise
#
tb
=
setsliderthumb
hasHScroll
wMetrics
wPtr
True
(
minx
,
newOrigin
.
x
,
maxx
)
viewx
(
toTuple
wSize
)
tb
#
tb
=
setsliderthumb
hasVScroll
wMetrics
wPtr
False
(
miny
,
newOrigin
.
y
,
maxy
)
viewy
(
toTuple
wSize
)
tb
(
defHSpace
,
defVSpace
)
=
(
wMetrics
.
osmHorItemSpace
,
wMetrics
.
osmVerItemSpace
)
hMargins
=
getWindowHMarginAtt
(
snd
(
Select
isWindowHMargin
(
WindowHMargin
0
0
)
atts
))
vMargins
=
getWindowVMarginAtt
(
snd
(
Select
isWindowVMargin
(
WindowVMargin
0
0
)
atts
))
spaces
=
getWindowItemSpaceAtt
(
snd
(
Select
isWindowItemSpace
(
WindowItemSpace
defHSpace
defVSpace
)
atts
))
#
tb
=
setsliderthumb
hasHScroll
wMetrics
wPtr
True
(
minx
,
newOrigin
.
x
,
maxx
)
vieww
(
toTuple
whSize
)
tb
#
tb
=
setsliderthumb
hasVScroll
wMetrics
wPtr
False
(
miny
,
newOrigin
.
y
,
maxy
)
viewh
(
toTuple
whSize
)
tb
reqSize
=
{
w
=
contentSize
.
w
-
fst
hMargins
-
snd
hMargins
,
h
=
contentSize
.
h
-
fst
vMargins
-
snd
vMargins
}
#
(_,
newItems
,
tb
)
=
layoutControls
wMetrics
hMargins
vMargins
spaces
reqSize
minSize
[(
domain
,
newOrigin
)]
oldItems
tb
windowInfo
=
{
windowInfo
&
windowOrigin
=
newOrigin
}
// wH = {wH & whItems=newItems,whWindowInfo=Just windowInfo} Mike: changed Just into WindowInfo
wH
=
{
wH
&
whItems
=
newItems
,
whWindowInfo
=
WindowInfo
windowInfo
}
#
(
wH
,
tb
)
=
forceValidWindowClipState
wMetrics
True
wPtr
wH
tb
#
(
updRgn
,
tb
)
=
relayoutControls
wMetrics
whSelect
contentRect
contentRect
zero
zero
wPtr
whDefaultId
oldItems
wH
.
whItems
tb
#
(
isRect
,
areaRect
,
tb
)
=
case
wH
.
whWindowInfo
of
WindowInfo
{
windowClip
={
clipRgn
}}
->
osgetrgnbox
clipRgn
tb
_
->
controlposFatalError
"movewindowviewframe"
"unexpected whWindowInfo field"
#
(
updRgn
,
tb
)
=
relayoutControls
wMetrics
whSelect
contentRect
contentRect
zero
zero
wPtr
wH
.
whDefaultId
oldItems
wH
.
whItems
tb
#
(
wH
,
tb
)
=
updatewindowbackgrounds
wMetrics
updRgn
wids
wH
tb
newFrame
=
PosSizeToRectangle
newOrigin
contentSize
// PA: drawinwindow might be redundant because of updatewindowbackgrounds
updState
=
{
oldFrame
=
PosSizeToRectangle
oldOrigin
contentSize
,
newFrame
=
newFrame
,
updArea
=[
newFrame
]}
#
(
wH
,
tb
)
=
drawwindowlook
wMetrics
wPtr
id
updState
wH
tb
newFrame
=
PosSizeToRectangle
newOrigin
contentSize
toMuch
=
(
abs
(
newOrigin
.
x
-
oldOrigin
.
x
)>=
w`
)
||
(
abs
(
newOrigin
.
y
-
oldOrigin
.
y
)>=
h`
)
(
updArea
,
updAction
)
=
if
(
not
lookInfo
.
lookSysUpdate
||
toMuch
||
not
isRect
)
([
newFrame
],
return
[])
(
calcScrollUpdateArea
oldOrigin
newOrigin
areaRect
)
updState
=
{
oldFrame
=
PosSizeToRectangle
oldOrigin
contentSize
,
newFrame
=
newFrame
,
updArea
=
updArea
}
#
(
wH
,
tb
)
=
drawwindowlook`
wMetrics
wPtr
updAction
updState
wH
tb
=
(
wH
,
tb
)
where
wSize
=
wH
.
whSize
// windowInfo = fromJust wH.whWindowInfo Mike: changed fromJust into getWindowInfoWindowData
windowInfo
=
getWindowInfoWindowData
wH
.
whWindowInfo
domainRect
=
windowInfo
.
windowDomain
windowInfo
=
getWindowInfoWindowData
whWindowInfo
(
oldOrigin
,
domainRect
,
hasHScroll
,
hasVScroll
,
lookInfo
)
=
(
windowInfo
.
windowOrigin
,
windowInfo
.
windowDomain
,
isJust
windowInfo
.
windowHScroll
,
isJust
windowInfo
.
windowVScroll
,
windowInfo
.
windowLook
)
domain
=
RectToRectangle
domainRect
oldOrigin
=
windowInfo
.
windowOrigin
hasHScroll
=
isJust
windowInfo
.
windowHScroll
hasVScroll
=
isJust
windowInfo
.
windowVScroll
atts
=
wH
.
whAtts
oldItems
=
wH
.
whItems
whSelect
=
wH
.
whSelect
whDefaultId
=
wH
.
whDefaultId
visScrolls
=
OSscrollbarsAreVisible
wMetrics
domainRect
(
toTuple
whSize
)
(
hasHScroll
,
hasVScroll
)
contentRect
=
getWindowContentRect
wMetrics
visScrolls
(
SizeToRect
whSize
)
contentSize
=
RectSize
contentRect
{
w
=
w`
,
h
=
h`
}
=
contentSize
(
minx
,
maxx
,
vieww
)
=
(
domainRect
.
rleft
,
domainRect
.
rright
,
contentSize
.
w
)
(
miny
,
maxy
,
viewh
)
=
(
domainRect
.
rtop
,
domainRect
.
rbottom
,
contentSize
.
h
)
newOrigin
=
{
x
=
SetBetween
(
oldOrigin
.
x
+
v
.
vx
)
minx
(
max
minx
(
maxx
-
vieww
))
,
y
=
SetBetween
(
oldOrigin
.
y
+
v
.
vy
)
miny
(
max
miny
(
maxy
-
viewh
))
}
(
defMinW
,
defMinH
)
=
OSMinWindowSize
minSize
=
{
w
=
defMinW
,
h
=
defMinH
}
(
defHSpace
,
defVSpace
)
=
(
wMetrics
.
osmHorItemSpace
,
wMetrics
.
osmVerItemSpace
)
hMargins
=
getWindowHMarginAtt
(
snd
(
Select
isWindowHMargin
(
WindowHMargin
0
0
)
whAtts
))
vMargins
=
getWindowVMarginAtt
(
snd
(
Select
isWindowVMargin
(
WindowVMargin
0
0
)
whAtts
))
spaces
=
getWindowItemSpaceAtt
(
snd
(
Select
isWindowItemSpace
(
WindowItemSpace
defHSpace
defVSpace
)
whAtts
))
setsliderthumb
::
!
Bool
OSWindowMetrics
OSWindowPtr
Bool
(
Int
,
Int
,
Int
)
Int
(
Int
,
Int
)
!*
OSToolbox
->
*
OSToolbox
setsliderthumb
::
!
Bool
!
OSWindowMetrics
!
OSWindowPtr
!
Bool
!(!
Int
,
!
Int
,
!
Int
)
!
Int
!(!
Int
,
!
Int
)
!*
OSToolbox
->
*
OSToolbox
setsliderthumb
hasScroll
wMetrics
wPtr
isHScroll
scrollValues
viewSize
maxcoords
tb
|
hasScroll
=
OSsetWindowSliderThumb
wMetrics
wPtr
isHScroll
osThumb
maxcoords
True
tb
|
otherwise
=
tb
where
(_,
osThumb
,_,_)
=
toOSscrollbarRange
scrollValues
viewSize
/* calcScrollUpdateArea p1 p2 area calculates the new update area that has to be updated.
Assumptions: p1 is the origin before scrolling,
p2 is the origin after scrolling,
area is the visible area of the window view frame.
*/
calcScrollUpdateArea
::
!
Point2
!
Point2
!
Rect
->
(![
Rectangle
],!
St
*
Picture
[
Rect
])
calcScrollUpdateArea
oldOrigin
newOrigin
areaRect
=
(
map
RectToRectangle
updArea
,
scroll
{
newOriginAreaRect
&
rright
=
rright
+1
,
rbottom
=
rbottom
+1
}
restArea
v
)
where
newOriginAreaRect
=
addVector
(
toVector
newOrigin
)
areaRect
{
rleft
,
rtop
,
rright
,
rbottom
}
=
newOriginAreaRect
v
=
toVector
(
oldOrigin
-
newOrigin
)
{
vx
,
vy
}
=
v
(
updArea
,
restArea
)
=
if
(
vx
<=
0
&&
vy
<=
0
)
(
[{
newOriginAreaRect
&
rleft
=
rright
+
vx
,
rbottom
=
rbottom
+
vy
},{
newOriginAreaRect
&
rtop
=
rbottom
+
vy
}]
,
{
newOriginAreaRect
&
rright
=
rright
+
vx
,
rbottom
=
rbottom
+
vy
}
)
(
if
(
vx
<=
0
&&
vy
>=
0
)
(
[{
newOriginAreaRect
&
rbottom
=
rtop
+
vy
},{
newOriginAreaRect
&
rleft
=
rright
+
vx
,
rtop
=
rtop
+
vy
}]
,
{
newOriginAreaRect
&
rtop
=
rtop
+
vy
,
rright
=
rright
+
vx
}
)
(
if
(
vx
>=
0
&&
vy
<=
0
)
(
[{
newOriginAreaRect
&
rright
=
rleft
+
vx
,
rbottom
=
rbottom
+
vy
},{
newOriginAreaRect
&
rtop
=
rbottom
+
vy
}]
,
{
newOriginAreaRect
&
rleft
=
rleft
+
vx
,
rbottom
=
rbottom
+
vy
}
)
// if (vx>=0 && vy>=0)
(
[{
newOriginAreaRect
&
rbottom
=
rtop
+
vy
},{
newOriginAreaRect
&
rtop
=
rtop
+
vy
,
rright
=
rleft
+
vx
}]
,
{
newOriginAreaRect
&
rleft
=
rleft
+
vx
,
rtop
=
rtop
+
vy
}
)))
scroll
::
!
Rect
!
Rect
!
Vector2
!*
Picture
->
(![
Rect
],!*
Picture
)
scroll
scrollRect
restRect
v
picture
#
(
updRect
,
picture
)
=
pictscroll
scrollRect
v
picture
|
updRect
==
zero
=
([],
picture
)
|
otherwise
=
([
restRect
],
picture
)
ObjectIO/ObjectIO/documentinterface.dcl
deleted
100644 → 0
View file @
42aafe76
definition
module
documentinterface
// Clean Object I/O library, version 1.2
from
iostate
import
PSt
,
IOSt
from
osdocumentinterface
import
OSDInfo
/* setOSDInfoInMenuDevice stores process document interface information in the menu device.
*/
setOSDInfoInMenuDevice
::
!
OSDInfo
!(
PSt
.
l
.
p
)
->
PSt
.
l
.
p
/* closeOSDInfo is the final call needed to close the proper document interface resources.
It should be called only after all other devices have been closed.
*/
closeOSDInfo
::
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
ObjectIO/ObjectIO/documentinterface.icl
deleted
100644 → 0
View file @
42aafe76
implementation
module
documentinterface
// Clean Object I/O library, version 1.2
import
StdBool
,
StdFunc
,
StdMisc
import
osdocumentinterface
,
osmenu
import
commondef
,
iostate
,
menudevice
,
menuevent
documentinterfaceFatalError
::
String
String
->
.
x
documentinterfaceFatalError
function
error
=
FatalError
function
"documentinterface"
error
/* setOSDInfoInMenuDevice stores process document interface information in the menu device.
*/
setOSDInfoInMenuDevice
::
!
OSDInfo
!(
PSt
.
l
.
p
)
->
PSt
.
l
.
p
setOSDInfoInMenuDevice
OSNoInfo
pState
=
pState
setOSDInfoInMenuDevice
osdinfo
pState
#
pState
=
MenuFunctions
.
dOpen
pState
#
(
mDevice
,
ioState
)
=
IOStGetDevice
MenuDevice
pState
.
io
mHs
=
MenuSystemStateGetMenuHandles
mDevice
mHs
=
{
mHs
&
mOSMenuBar
=
OSMenuBarNew
frame
client
menubar
}
#
ioState
=
IOStSetDevice
(
MenuSystemState
mHs
)
ioState
=
{
pState
&
io
=
ioState
}
where
(
frame
,
client
,
menubar
)
=
case
osdinfo
of
OSMDInfo
info
->
(
info
.
osmdFrame
,
info
.
osmdClient
,
info
.
osmdMenubar
)
OSSDInfo
info
->
(
info
.
ossdFrame
,
info
.
ossdClient
,
info
.
ossdMenubar
)
OSNoInfo
->
documentinterfaceFatalError
"setOSDInfoInMenuDevice"
"unexpected OSDInfo argument"
closeOSDInfo
::
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
closeOSDInfo
ioState
#
(
osdinfo
,
ioState
)
=
IOStGetOSDInfo
ioState
close
=
case
osdinfo
of
OSMDInfo
info
->
OScloseMDI
info
OSSDInfo
info
->
OScloseSDI
info
_
->
id
=
appIOToolbox
close
ioState
ObjectIO/ObjectIO/windowdevice.icl
View file @
3cb3e377
...
...
@@ -1387,33 +1387,29 @@ where
=
(
wH
,
tb
)
|
otherwise
#
(_,
newOSThumb
,_,_)
=
toOSscrollbarRange
(
min`
,
newThumb
,
max`
)
viewSize
newOrigin
=
if
isHorizontal
{
origin
&
x
=
newThumb
}
{
origin
&
y
=
newThumb
}
newOrigin
=
if
isHorizontal
{
o
ldO
rigin
&
x
=
newThumb
}
{
o
ldO
rigin
&
y
=
newThumb
}
#
tb
=
OSsetWindowSliderThumb
wMetrics
wPtr
isHorizontal
newOSThumb
(
toTuple
whSize
)
True
tb
#
(_,
newItems
,
tb
)
=
layoutControls
wMetrics
hMargins
vMargins
spaces
contentSize
minSize
[(
domain
,
newOrigin
)]
oldItems
tb
wH
=
{
wH
&
whWindowInfo
=
WindowInfo
{
windowInfo
&
windowOrigin
=
newOrigin
}
,
whItems
=
newItems
}
#
(
wH
,
tb
)
=
forceValidWindowClipState
wMetrics
True
wPtr
wH
tb
(
scrollWindowInfo
,
wH
)
=
(\
wH
=:{
whWindowInfo
}->(
whWindowInfo
,
wH
))
wH
#
(
isRect
,
areaRect
,
tb
)
=
case
scrollWindowInfo
of
#
(
isRect
,
areaRect
,
tb
)
=
case
wH
.
whWindowInfo
of
WindowInfo
{
windowClip
={
clipRgn
}}
->
osgetrgnbox
clipRgn
tb
_
->
windowdeviceFatalError
"windowScrollActionIO"
"unexpected
empty
whWindowInfo field"
_
->
windowdeviceFatalError
"windowScrollActionIO"
"unexpected whWindowInfo field"
#
(
updRgn
,
tb
)
=
relayoutControls
wMetrics
whSelect
contentRect
contentRect
zero
zero
wPtr
wH
.
whDefaultId
oldItems
wH
.
whItems
tb
#
(
wH
,
tb
)
=
updatewindowbackgrounds
wMetrics
updRgn
info
.
wsaWIDS
wH
tb
newFrame
=
PosSizeToRectangle
newOrigin
contentSize
toMuch
=
if
isHorizontal
(
abs
(
newOrigin
.
x
-
origin
.
x
)>=
w`
)
(
abs
(
newOrigin
.
y
-
origin
.
y
)>=
h`
)
toMuch
=
if
isHorizontal
(
abs
(
newOrigin
.
x
-
o
ldO
rigin
.
x
)>=
w`
)
(
abs
(
newOrigin
.
y
-
o
ldO
rigin
.
y
)>=
h`
)
(
updArea
,
updAction
)
=
if
(
not
lookInfo
.
lookSysUpdate
||
toMuch
||
not
isRect
)
(
newFrame
,\
s
->(
zero
,
s
))
(
calcScrollUpdateArea
origin
newOrigin
areaRect
)
updState
=
{
oldFrame
=
oldFrame
,
newFrame
=
newFrame
,
updArea
=[
updArea
]
}
(
newFrame
,
return
[])
(
calcScrollUpdateArea
oldOrigin
newOrigin
areaRect
)
updState
=
{
oldFrame
=
oldFrame
,
newFrame
=
newFrame
,
updArea
=[
updArea
]}
#
(
wH
,
tb
)
=
drawwindowlook`
wMetrics
wPtr
updAction
updState
wH
tb
#
tb
=
OSvalidateWindowRect
wPtr
(
SizeToRect
whSize
)
tb
//
# tb = OSvalidateWindowRect wPtr (SizeToRect whSize) tb
=
(
wH
,
tb
)
where
windowInfo
=
getWindowInfoWindowData
whWindowInfo
(
origin
,
domainRect
,
hasHScroll
,
hasVScroll
,
lookInfo
)
(
o
ldO
rigin
,
domainRect
,
hasHScroll
,
hasVScroll
,
lookInfo
)
=
(
windowInfo
.
windowOrigin
,
windowInfo
.
windowDomain
,
isJust
windowInfo
.
windowHScroll
,
isJust
windowInfo
.
windowVScroll
,
windowInfo
.
windowLook
)
isHorizontal
=
info
.
wsaDirection
==
Horizontal
domain
=
RectToRectangle
domainRect
...
...
@@ -1421,11 +1417,11 @@ where
contentRect
=
getWindowContentRect
wMetrics
visScrolls
(
SizeToRect
whSize
)
contentSize
=
RectSize
contentRect
{
w
=
w`
,
h
=
h`
}
=
contentSize
oldFrame
=
PosSizeToRectangle
origin
contentSize
oldFrame
=
PosSizeToRectangle
o
ldO
rigin
contentSize
(
min`
,
oldThumb
,
max`
,
viewSize
)
=
if
isHorizontal
(
domain
.
corner1
.
x
,
origin
.
x
,
domain
.
corner2
.
x
,
w`
)
(
domain
.
corner1
.
y
,
origin
.
y
,
domain
.
corner2
.
y
,
h`
)
(
domain
.
corner1
.
x
,
o
ldO
rigin
.
x
,
domain
.
corner2
.
x
,
w`
)
(
domain
.
corner1
.
y
,
o
ldO
rigin
.
y
,
domain
.
corner2
.
y
,
h`
)
sliderState
=
{
sliderMin
=
min`
,
sliderThumb
=
oldThumb
,
sliderMax
=
max`
-
viewSize
}
scrollInfo
=
fromJust
(
if
isHorizontal
windowInfo
.
windowHScroll
windowInfo
.
windowVScroll
)
scrollFun
=
scrollInfo
.
scrollFunction
...
...
@@ -1444,28 +1440,28 @@ where
area is the visible area of the window view frame,
scrolling occurs either horizontally or vertically.
*/
calcScrollUpdateArea
::
!
Point2
!
Point2
!
Rect
->
(!
Rectangle
,!
St
*
Picture
Rect
)
calcScrollUpdateArea
::
!
Point2
!
Point2
!
Rect
->
(!
Rectangle
,!
St
*
Picture
[
Rect
]
)
calcScrollUpdateArea
oldOrigin
newOrigin
areaRect
=
(
updArea
,
scroll
{
o
riginAreaRect
&
rright
=
rright
+1
,
rbottom
=
rbottom
+1
}
restArea
v
)
=
(
updArea
,
scroll
{
newO
riginAreaRect
&
rright
=
rright
+1
,
rbottom
=
rbottom
+1
}
restArea
v
)
where
o
riginAreaRect
=
addVector
(
toVector
newOrigin
)
areaRect
{
rleft
,
rtop
,
rright
,
rbottom
}
=
o
riginAreaRect
o
riginAreaRectangle
=
RectToRectangle
o
riginAreaRect
newO
riginAreaRect
=
addVector
(
toVector
newOrigin
)
areaRect
{
rleft
,
rtop
,
rright
,
rbottom
}
=
newO
riginAreaRect
newO
riginAreaRectangle
=
RectToRectangle
newO
riginAreaRect
v
=
toVector
(
oldOrigin
-
newOrigin
)
{
vx
,
vy
}
=
v
(
updArea
,
restArea
)
=
if
(
vx
<
0
)
({
o
riginAreaRectangle
&
corner1
={
x
=
rright
+
vx
,
y
=
rtop
}},
{
o
riginAreaRect
&
rright
=
rright
+
vx
})
(
if
(
vx
>
0
)
({
o
riginAreaRectangle
&
corner2
={
x
=
rleft
+
vx
,
y
=
rbottom
}},
{
o
riginAreaRect
&
rleft
=
rleft
+
vx
})
(
if
(
vy
<
0
)
({
o
riginAreaRectangle
&
corner1
={
x
=
rleft
,
y
=
rbottom
+
vy
}},{
o
riginAreaRect
&
rbottom
=
rbottom
+
vy
})
(
if
(
vy
>
0
)
({
o
riginAreaRectangle
&
corner2
={
x
=
rright
,
y
=
r
bot
to
m
+
vy
}},
{
o
riginAreaRect
&
rtop
=
rtop
+
vy
})
(
windowdeviceFatalError
"calcUpdateArea (scrolling window)"
"assumption violation"
))))
(
updArea
,
restArea
)
=
if
(
vx
<
0
)
({
newO
riginAreaRectangle
&
corner1
={
x
=
rright
+
vx
,
y
=
rtop
}},
{
newO
riginAreaRect
&
rright
=
rright
+
vx
})
(
if
(
vx
>
0
)
({
newO
riginAreaRectangle
&
corner2
={
x
=
rleft
+
vx
,
y
=
rbottom
}},
{
newO
riginAreaRect
&
rleft
=
rleft
+
vx
})
(
if
(
vy
<
0
)
({
newO
riginAreaRectangle
&
corner1
={
x
=
rleft
,
y
=
rbottom
+
vy
}},{
newO
riginAreaRect
&
rbottom
=
rbottom
+
vy
})
(
if
(
vy
>
0
)
({
newO
riginAreaRectangle
&
corner2
={
x
=
rright
,
y
=
rto
p
+
vy
}},
{
newO
riginAreaRect
&
rtop
=
rtop
+
vy
})
(
windowdeviceFatalError
"calc
Scroll
UpdateArea (scrolling window)"
"assumption violation"
))))
scroll
::
!
Rect
!
Rect
!
Vector2
!*
Picture
->
(!
Rect
,!*
Picture
)
scroll
::
!
Rect
!
Rect
!
Vector2
!*
Picture
->
(!
[
Rect
]
,!*
Picture
)
scroll
scrollRect
restRect
v
picture
#
(
updRect
,
picture
)
=
pictscroll
scrollRect
v
picture
|
updRect
==
zero
=
(
zero
,
picture
)
=
(
[]
,
picture
)
|
otherwise
=
(
restRect
,
picture
)
=
(
[
restRect
]
,
picture
)
windowStateScrollActionIO
_
_
_
_
=
windowdeviceFatalError
"windowStateScrollActionIO"
"unexpected window placeholder"
...
...
ObjectIO/ObjectIO/windowdraw.dcl
View file @
3cb3e377
...
...
@@ -16,11 +16,11 @@ import windowhandle
drawinwindow applies the drawing function to the given WindowHandle.
These functions assume that WindowHandle refers to a Window with a valid ClipState.
*/
drawwindowlook
::
!
OSWindowMetrics
!
OSWindowPtr
!(
IdFun
*
Picture
)
!
UpdateState
!(
WindowHandle
.
ls
.
pst
)
!*
OSToolbox
->
(!
WindowHandle
.
ls
.
pst
,
!*
OSToolbox
)
drawwindowlook`
::
!
OSWindowMetrics
!
OSWindowPtr
!(
St
*
Picture
Rect
)
!
UpdateState
!(
WindowHandle
.
ls
.
pst
)
!*
OSToolbox
->
(!
WindowHandle
.
ls
.
pst
,
!*
OSToolbox
)
drawinwindow
::
!
OSWindowMetrics
!
OSWindowPtr
!.(
St
*
Picture
.
x
)
!(
WindowHandle
.
ls
.
pst
)
!*
OSToolbox
->
(.
x
,
!
WindowHandle
.
ls
.
pst
,
!*
OSToolbox
)
drawwindowlook
::
!
OSWindowMetrics
!
OSWindowPtr
!(
IdFun
*
Picture
)
!
UpdateState
!(
WindowHandle
.
ls
.
pst
)
!*
OSToolbox
->
(!
WindowHandle
.
ls
.
pst
,
!*
OSToolbox
)
drawwindowlook`
::
!
OSWindowMetrics
!
OSWindowPtr
!(
St
*
Picture
[
Rect
]
)
!
UpdateState
!(
WindowHandle
.
ls
.
pst
)
!*
OSToolbox
->
(!
WindowHandle
.
ls
.
pst
,
!*
OSToolbox
)
drawinwindow
::
!
OSWindowMetrics
!
OSWindowPtr
!.(
St
*
Picture
.
x
)
!(
WindowHandle
.
ls
.
pst
)
!*
OSToolbox
->
(.
x
,!
WindowHandle
.
ls
.
pst
,
!*
OSToolbox
)
ObjectIO/ObjectIO/windowdraw.icl
View file @
3cb3e377
...
...
@@ -43,34 +43,34 @@ where
{
w
,
h
}
=
RectSize
(
getWindowContentRect
wMetrics
visScrolls
(
SizeToRect
whSize
))
wFrame
=
{
corner1
=
origin
,
corner2
={
x
=
origin
.
x
+
w
,
y
=
origin
.
y
+
h
}}
drawwindowlook`
::
!
OSWindowMetrics
!
OSWindowPtr
!(
St
*
Picture
Rect
)
!
UpdateState
!(
WindowHandle
.
ls
.
pst
)
!*
OSToolbox
->
(!
WindowHandle
.
ls
.
pst
,
!*
OSToolbox
)
drawwindowlook`
::
!
OSWindowMetrics
!
OSWindowPtr
!(
St
*
Picture
[
Rect
]
)
!
UpdateState
!(
WindowHandle
.
ls
.
pst
)
!*
OSToolbox
->
(!
WindowHandle
.
ls
.
pst
,
!*
OSToolbox
)
drawwindowlook`
wMetrics
wPtr
drawFirst
updState
wH
=:{
whSelect
,
whSize
,
whWindowInfo
}
tb
#!
(
osPict
,
tb
)
=
OSgrabWindowPictContext
wPtr
tb
#!
picture
=
packPicture
origin
(
copyPen
look
.
lookPen
)
True
osPict
tb
#!
picture
=
pictsetcliprgn
clipRgn
picture
#!
(
additionalUpdate
Rect
,
picture
)
=
drawFirst
picture
updState
=
if
(
additionalUpdateRect
==
zero
)
updState
{
updState
&
updArea
=
[
RectToRectangle
additionalUpdate
Rect
:
updState
.
updArea
]
}
#!
picture
=
appClipPicture
(
toRegion
wFrame
)
(
look
.
lookFun
select
updState
)
picture
#!
(_,
pen
,_,
osPict
,
tb
)=
unpackPicture
picture
#!
tb
=
OSreleaseWindowPictContext
wPtr
osPict
tb
#!
tb
=
OSvalidateWindowRgn
wPtr
clipRgn
tb
// PA: added to eliminate update of window (in drawing part)
#!
look
=
{
look
&
lookPen
=
pen
}
#!
info
=
{
info
&
windowLook
=
look
}
#!
(
osPict
,
tb
)
=
OSgrabWindowPictContext
wPtr
tb
#!
picture
=
packPicture
origin
(
copyPen
look
.
lookPen
)
True
osPict
tb
#!
picture
=
pictsetcliprgn
clipRgn
picture
#!
(
additionalUpdate
Area
,
picture
)
=
drawFirst
picture
updState
=
{
updState
&
updArea
=
[
RectToRectangle
r
\\
r
<-
additionalUpdate
Area
|
not
(
IsEmptyRect
r
)]
++
updState
.
updArea
}
#!
picture
=
appClipPicture
(
toRegion
wFrame
)
(
look
.
lookFun
select
updState
)
picture
#!
(_,
pen
,_,
osPict
,
tb
)
=
unpackPicture
picture
#!
tb
=
OSreleaseWindowPictContext
wPtr
osPict
tb
#!
tb
=
OSvalidateWindowRgn
wPtr
clipRgn
tb
// PA: added to eliminate update of window (in drawing part)
#!
look
=
{
look
&
lookPen
=
pen
}
#!
info
=
{
info
&
windowLook
=
look
}
=
({
wH
&
whWindowInfo
=
WindowInfo
info
},
tb
)
where
select
=
if
whSelect
Able
Unable
info
=
getWindowInfoWindowData
whWindowInfo
domainRect
=
info
.
windowDomain
origin
=
info
.
windowOrigin
look
=
info
.
windowLook
clip
=
info
.
windowClip
clipRgn
=
clip
.
clipRgn
hasScrolls
=
(
isJust
info
.
windowHScroll
,
isJust
info
.
windowVScroll
)
visScrolls
=
OSscrollbarsAreVisible
wMetrics
domainRect
(
toTuple
whSize
)
hasScrolls
{
w
,
h
}
=
RectSize
(
getWindowContentRect
wMetrics
visScrolls
(
SizeToRect
whSize
))
wFrame
=
{
corner1
=
origin
,
corner2
={
x
=
origin
.
x
+
w
,
y
=
origin
.
y
+
h
}}
select
=
if
whSelect
Able
Unable
info
=
getWindowInfoWindowData
whWindowInfo
domainRect
=
info
.
windowDomain
origin
=
info
.
windowOrigin
look
=
info
.
windowLook
clip
=
info
.
windowClip
clipRgn
=
clip
.
clipRgn
hasScrolls
=
(
isJust
info
.
windowHScroll
,
isJust
info
.
windowVScroll
)
visScrolls
=
OSscrollbarsAreVisible
wMetrics
domainRect
(
toTuple
whSize
)
hasScrolls
{
w
,
h
}
=
RectSize
(
getWindowContentRect
wMetrics
visScrolls
(
SizeToRect
whSize
))
wFrame
=
{
corner1
=
origin
,
corner2
={
x
=
origin
.
x
+
w
,
y
=
origin
.
y
+
h
}}
/* drawinwindow wPtr drawfun window
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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