--- a/EFGroup.st Tue Nov 22 01:50:27 1994 +0100
+++ b/EFGroup.st Tue Nov 22 15:33:56 1994 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1992 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -11,17 +11,17 @@
"
Object subclass:#EnterFieldGroup
- instanceVariableNames:'fields currentField leaveAction'
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Support'
+ instanceVariableNames:'fields currentField leaveAction'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Support'
!
EnterFieldGroup comment:'
COPYRIGHT (c) 1992 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/EFGroup.st,v 1.6 1994-10-10 03:00:56 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/EFGroup.st,v 1.7 1994-11-22 14:33:52 claus Exp $
'!
!EnterFieldGroup class methodsFor:'documentation'!
@@ -29,7 +29,7 @@
copyright
"
COPYRIGHT (c) 1992 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/EFGroup.st,v 1.6 1994-10-10 03:00:56 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/EFGroup.st,v 1.7 1994-11-22 14:33:52 claus Exp $
"
!
@@ -64,7 +64,7 @@
|thisIndex next|
fields isNil ifTrue:[
- fields := OrderedCollection new
+ fields := OrderedCollection new
].
fields add:aField.
thisIndex := fields size.
@@ -74,48 +74,48 @@
"set the fields enableAction to disable active field"
aField enableAction:[
- currentField notNil ifTrue:[
- currentField disable
- ].
- currentField := aField
+ currentField notNil ifTrue:[
+ currentField disable
+ ].
+ currentField := aField
].
"set the fields leaveAction to enable next field"
aField leaveAction:[:key |
- currentField notNil ifTrue:[
- currentField disable
- ].
- (key == #Up) ifTrue:[
- (thisIndex == 1) ifTrue:[
- next := fields size
- ] ifFalse:[
- next := thisIndex - 1
- ]
- ].
- (key == #Down) ifTrue:[
- (thisIndex == (fields size)) ifTrue:[
- next := 1
- ] ifFalse:[
- next := thisIndex + 1
- ]
- ].
- (key == #Return) ifTrue:[
- (thisIndex == (fields size)) ifTrue:[
- leaveAction notNil ifTrue:[
- leaveAction value.
- currentField := nil
- ] ifFalse:[
- next := 1
- ]
- ] ifFalse:[
- next := thisIndex + 1
- ]
- ].
- next notNil ifTrue:[
- (fields at:next) enable.
- currentField := fields at:next
- ]
+ currentField notNil ifTrue:[
+ currentField disable
+ ].
+ (key == #Up) ifTrue:[
+ (thisIndex == 1) ifTrue:[
+ next := fields size
+ ] ifFalse:[
+ next := thisIndex - 1
+ ]
+ ].
+ (key == #Down) ifTrue:[
+ (thisIndex == (fields size)) ifTrue:[
+ next := 1
+ ] ifFalse:[
+ next := thisIndex + 1
+ ]
+ ].
+ (key == #Return) ifTrue:[
+ (thisIndex == (fields size)) ifTrue:[
+ leaveAction notNil ifTrue:[
+ leaveAction value.
+ currentField := nil
+ ] ifFalse:[
+ next := 1
+ ]
+ ] ifFalse:[
+ next := thisIndex + 1
+ ]
+ ].
+ next notNil ifTrue:[
+ (fields at:next) enable.
+ currentField := fields at:next
+ ]
]
! !
@@ -129,7 +129,7 @@
makeActive:aField
currentField notNil ifTrue:[
- currentField disable
+ currentField disable
].
currentField := aField.
currentField enable.
@@ -155,7 +155,7 @@
"key-press in a field"
currentField notNil ifTrue:[
- currentField keyPress:key x:0 y:0
+ currentField keyPress:key x:0 y:0
]
!
@@ -178,6 +178,14 @@
aView buttonRelease:button x:x y:y
!
-buttonMotion:state x:x y:y view:aView
- aView buttonMotion:state x:x y:y
+buttonMotion:buttonMask x:x y:y view:aView
+ aView buttonMotion:buttonMask x:x y:y
+!
+
+pointerEnter:state x:x y:y view:aView
+ aView pointerEnter:state x:x y:y.
+!
+
+pointerLeave:state view:aView
+ aView pointerLeave:state
! !
--- a/EnterFieldGroup.st Tue Nov 22 01:50:27 1994 +0100
+++ b/EnterFieldGroup.st Tue Nov 22 15:33:56 1994 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1992 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -11,17 +11,17 @@
"
Object subclass:#EnterFieldGroup
- instanceVariableNames:'fields currentField leaveAction'
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Support'
+ instanceVariableNames:'fields currentField leaveAction'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Support'
!
EnterFieldGroup comment:'
COPYRIGHT (c) 1992 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/EnterFieldGroup.st,v 1.6 1994-10-10 03:00:56 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EnterFieldGroup.st,v 1.7 1994-11-22 14:33:52 claus Exp $
'!
!EnterFieldGroup class methodsFor:'documentation'!
@@ -29,7 +29,7 @@
copyright
"
COPYRIGHT (c) 1992 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/EnterFieldGroup.st,v 1.6 1994-10-10 03:00:56 claus Exp $
+$Header: /cvs/stx/stx/libwidg/EnterFieldGroup.st,v 1.7 1994-11-22 14:33:52 claus Exp $
"
!
@@ -64,7 +64,7 @@
|thisIndex next|
fields isNil ifTrue:[
- fields := OrderedCollection new
+ fields := OrderedCollection new
].
fields add:aField.
thisIndex := fields size.
@@ -74,48 +74,48 @@
"set the fields enableAction to disable active field"
aField enableAction:[
- currentField notNil ifTrue:[
- currentField disable
- ].
- currentField := aField
+ currentField notNil ifTrue:[
+ currentField disable
+ ].
+ currentField := aField
].
"set the fields leaveAction to enable next field"
aField leaveAction:[:key |
- currentField notNil ifTrue:[
- currentField disable
- ].
- (key == #Up) ifTrue:[
- (thisIndex == 1) ifTrue:[
- next := fields size
- ] ifFalse:[
- next := thisIndex - 1
- ]
- ].
- (key == #Down) ifTrue:[
- (thisIndex == (fields size)) ifTrue:[
- next := 1
- ] ifFalse:[
- next := thisIndex + 1
- ]
- ].
- (key == #Return) ifTrue:[
- (thisIndex == (fields size)) ifTrue:[
- leaveAction notNil ifTrue:[
- leaveAction value.
- currentField := nil
- ] ifFalse:[
- next := 1
- ]
- ] ifFalse:[
- next := thisIndex + 1
- ]
- ].
- next notNil ifTrue:[
- (fields at:next) enable.
- currentField := fields at:next
- ]
+ currentField notNil ifTrue:[
+ currentField disable
+ ].
+ (key == #Up) ifTrue:[
+ (thisIndex == 1) ifTrue:[
+ next := fields size
+ ] ifFalse:[
+ next := thisIndex - 1
+ ]
+ ].
+ (key == #Down) ifTrue:[
+ (thisIndex == (fields size)) ifTrue:[
+ next := 1
+ ] ifFalse:[
+ next := thisIndex + 1
+ ]
+ ].
+ (key == #Return) ifTrue:[
+ (thisIndex == (fields size)) ifTrue:[
+ leaveAction notNil ifTrue:[
+ leaveAction value.
+ currentField := nil
+ ] ifFalse:[
+ next := 1
+ ]
+ ] ifFalse:[
+ next := thisIndex + 1
+ ]
+ ].
+ next notNil ifTrue:[
+ (fields at:next) enable.
+ currentField := fields at:next
+ ]
]
! !
@@ -129,7 +129,7 @@
makeActive:aField
currentField notNil ifTrue:[
- currentField disable
+ currentField disable
].
currentField := aField.
currentField enable.
@@ -155,7 +155,7 @@
"key-press in a field"
currentField notNil ifTrue:[
- currentField keyPress:key x:0 y:0
+ currentField keyPress:key x:0 y:0
]
!
@@ -178,6 +178,14 @@
aView buttonRelease:button x:x y:y
!
-buttonMotion:state x:x y:y view:aView
- aView buttonMotion:state x:x y:y
+buttonMotion:buttonMask x:x y:y view:aView
+ aView buttonMotion:buttonMask x:x y:y
+!
+
+pointerEnter:state x:x y:y view:aView
+ aView pointerEnter:state x:x y:y.
+!
+
+pointerLeave:state view:aView
+ aView pointerLeave:state
! !
--- a/Label.st Tue Nov 22 01:50:27 1994 +0100
+++ b/Label.st Tue Nov 22 15:33:56 1994 +0100
@@ -26,7 +26,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Label.st,v 1.11 1994-11-17 14:38:08 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Label.st,v 1.12 1994-11-22 14:33:54 claus Exp $
'!
!Label class methodsFor:'documentation'!
@@ -47,7 +47,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Label.st,v 1.11 1994-11-17 14:38:08 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Label.st,v 1.12 1994-11-22 14:33:54 claus Exp $
"
!
@@ -535,14 +535,18 @@
!
resize
- "resize myself to make text fit into myself"
+ "resize myself to make text fit into myself.
+ but only do so, if I have not been given a relative extent
+ or an extend computation block."
|extra|
logo notNil ifTrue:[
(relativeExtent isNil and:[extentRule isNil]) ifTrue:[
- extra := margin * 2.
- self extent:(labelWidth + extra) @ (labelHeight + extra)
+ (relativeCorner isNil and:[cornerRule isNil]) ifTrue:[
+ extra := margin * 2.
+ self extent:(labelWidth + extra) @ (labelHeight + extra)
+ ].
].
self computeLabelOrigin
]
--- a/ObjView.st Tue Nov 22 01:50:27 1994 +0100
+++ b/ObjView.st Tue Nov 22 15:33:56 1994 +0100
@@ -48,7 +48,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/ObjView.st,v 1.14 1994-11-22 00:50:27 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ObjView.st,v 1.15 1994-11-22 14:33:56 claus Exp $
"
!
@@ -76,12 +76,12 @@
redrawX:x y:y width:w height:h
|innerX innerY innerW innerH redrawFrame |
- innerX := x.
- innerY := y.
- innerW := w.
- innerH := h.
+ ((contents size ~~ 0) or:[gridShown]) ifTrue:[
+ innerX := x.
+ innerY := y.
+ innerW := w.
+ innerH := h.
- ((contents size ~~ 0) or:[gridShown]) ifTrue:[
redrawFrame := Rectangle left:innerX top:innerY
width:innerW height:innerH.
self redrawObjectsInVisible:redrawFrame
@@ -354,12 +354,13 @@
alignToGrid:aPoint
"round aPoint to the next nearest point on the grid"
- |p0 pG|
+ |p0 pG viewOrigin|
aligning ifFalse:[
^ aPoint
].
+ viewOrigin := self viewOrigin.
viewOrigin ~= (0@0) ifTrue:[
p0 := aPoint - viewOrigin.
pG := (p0 grid:gridAlign) rounded. "/grid:(1 @ 1).
@@ -522,23 +523,27 @@
redrawObjectsOn:aGC
"redraw all objects on a graphic context"
- |vFrame org|
+ |vFrame org viewOrigin|
(aGC == self) ifTrue:[
- shown "realized" ifFalse:[^ self].
+ shown ifFalse:[^ self].
+ viewOrigin := self viewOrigin.
org := viewOrigin.
vFrame := Rectangle origin:org
corner:(viewOrigin + (width @ height)).
+ transformation notNil ifTrue:[
+ vFrame := transformation applyInverseTo:vFrame.
+ ].
self redrawObjectsIntersecting:vFrame
] ifFalse:[
"loop over pages"
+"
org := 0 @ 0.
vFrame := Rectangle origin:org
corner:(org + (width @ height)).
-"
self redrawObjectsIntersecting:vFrame
"
self objectsIntersecting:vFrame do:[:theObject |
@@ -578,9 +583,10 @@
"redraw all objects which have part of themselfes in aRectangle
draw only in (i.e. clip output to) aRectangle"
- |visRect|
+ |visRect viewOrigin|
shown ifTrue:[
+ viewOrigin := self viewOrigin.
visRect := Rectangle origin:(aRectangle origin - viewOrigin)
extent:(aRectangle extent).
clipRect notNil ifTrue:[
@@ -849,7 +855,7 @@
"find the last object (by looking from back to front) which is hit by
a visible point - this is the topmost object hit"
- ^ self findObjectAt:(aPoint + viewOrigin)
+ ^ self findObjectAt:(aPoint + self viewOrigin)
!
findObjectAt:aPoint suchThat:aBlock
@@ -873,7 +879,7 @@
the argument, aPoint and for which the testBlock, aBlock evaluates to
true"
- ^ self findObjectAt:(aPoint + viewOrigin) suchThat:aBlock
+ ^ self findObjectAt:(aPoint + self viewOrigin) suchThat:aBlock
!
canMove:something
@@ -1030,8 +1036,9 @@
objectsIntersectingVisible:aRectangle do:aBlock
"do something to every object which intersects a visible rectangle"
- |absRect|
+ |absRect viewOrigin|
+ viewOrigin := self viewOrigin.
absRect := Rectangle left:(aRectangle left + viewOrigin x)
top:(aRectangle top + viewOrigin y)
width:(aRectangle width)
@@ -1106,8 +1113,9 @@
"do something to every object which is completely in a
visible rectangle"
- |absRect|
+ |absRect viewOrigin|
+ viewOrigin := self viewOrigin.
absRect := Rectangle left:(aRectangle left + viewOrigin x)
top:(aRectangle top + viewOrigin y)
width:(aRectangle width)
@@ -1118,8 +1126,9 @@
visibleObjectsDo:aBlock
"do something to every visible object"
- |absRect|
+ |absRect viewOrigin|
+ viewOrigin := self viewOrigin.
absRect := Rectangle left:viewOrigin x
top:viewOrigin y
width:width
@@ -1130,8 +1139,9 @@
numberOfObjectsIntersectingVisible:aRectangle
"answer the number of objects intersecting the argument, aRectangle"
- |absRect|
+ |absRect viewOrigin|
+ viewOrigin := self viewOrigin.
absRect := Rectangle
left:(aRectangle left + viewOrigin x)
top:(aRectangle top + viewOrigin y)
@@ -1158,8 +1168,9 @@
objectsIntersectingVisible:aRectangle
"answer a Collection of objects intersecting a visible aRectangle"
- |absRect|
+ |absRect viewOrigin|
+ viewOrigin := self viewOrigin.
absRect := Rectangle left:(aRectangle left + viewOrigin x)
top:(aRectangle top + viewOrigin y)
width:(aRectangle width)
@@ -1202,8 +1213,9 @@
rectangleForScroll
"find the area occupied by visible objects"
- |left right top bottom frame oLeft oRight oTop oBottom orgX orgY|
+ |left right top bottom frame oLeft oRight oTop oBottom orgX orgY viewOrigin|
+ viewOrigin := self viewOrigin.
orgX := viewOrigin x.
orgY := viewOrigin y.
left := 9999.
@@ -1258,7 +1270,7 @@
|oldOrigin oldFrame newFrame
objectsIntersectingOldFrame objectsIntersectingNewFrame
wasObscured isObscured intersects
- vx vy oldLeft oldTop w h newLeft newTop griddedNewOrigin|
+ vx vy oldLeft oldTop w h newLeft newTop griddedNewOrigin viewOrigin|
anObject isNil ifTrue:[^ self].
anObject canBeMoved ifFalse:[^ self].
@@ -1280,6 +1292,7 @@
"if no other object intersects both frames we can do a copy:"
+ viewOrigin := self viewOrigin.
intersects := oldFrame intersects:newFrame.
intersects ifFalse:[
gridShown ifFalse:[
@@ -1623,6 +1636,24 @@
!ObjectView methodsFor:'view manipulation'!
+zoomIn
+ transformation isNil ifTrue:[
+ transformation := WindowingTransformation scale:1 translation:0
+ ].
+ transformation := WindowingTransformation scale:(transformation scale / 2)
+ translation:0.
+ self redraw
+!
+
+zoomOut
+ transformation isNil ifTrue:[
+ transformation := WindowingTransformation scale:1 translation:0
+ ].
+ transformation := WindowingTransformation scale:(transformation scale * 2)
+ translation:0.
+ self redraw
+!
+
zoom:factor
"set a zoom factor; nil or 1 is identity; 2 is magnify by 2;
0.5 is shrink by 2"
@@ -1693,15 +1724,24 @@
"dots every mm; lines every cm"
bigStepH := mmH * 10.0.
bigStepV := mmV * 10.0.
- littleStepH := mmH.
- littleStepV := mmV
+ (transformation notNil
+ and:[transformation scale <= 0.5]) ifFalse:[
+ littleStepH := mmH.
+ littleStepV := mmV
+ ]
].
(scaleMetric == #inch) ifTrue:[
"dots every eights inch; lines every half inch"
bigStepH := mmH * (25.4 / 2).
bigStepV := mmV * (25.4 / 2).
- littleStepH := mmH * (25.4 / 8).
- littleStepV := mmV * (25.4 / 8)
+ (transformation notNil
+ and:[transformation scale <= 0.5]) ifTrue:[
+ littleStepH := mmH * (25.4 / 4).
+ littleStepV := mmV * (25.4 / 4)
+ ] ifFalse:[
+ littleStepH := mmH * (25.4 / 8).
+ littleStepV := mmV * (25.4 / 8)
+ ]
].
arr := Array new:8.
@@ -1919,7 +1959,7 @@
self invertDragRectangle.
self cursor:oldCursor.
- self selectAllIn:(dragObject + viewOrigin)
+ self selectAllIn:(dragObject + self viewOrigin)
!
doRectangleDrag:aPoint
@@ -1968,7 +2008,7 @@
rootMotion ifTrue:[
dragger := rootView.
- offs2 := viewOrigin.
+ offs2 := self viewOrigin.
top := self topView.
org := device translatePoint:0@0 from:(self id) to:(rootView id).
offs2 := offs2 - org
@@ -1992,7 +2032,7 @@
rootMotion ifTrue:[
dragger := rootView.
- offs2 := viewOrigin.
+ offs2 := self viewOrigin.
top := self topView.
org := device translatePoint:0@0 from:(self id) to:(rootView id).
offs2 := offs2 - org
@@ -2113,7 +2153,7 @@
movedObject notNil ifTrue:[
rootMotion ifTrue:[
dragger := rootView.
- offs2 := viewOrigin
+ offs2 := self viewOrigin
] ifFalse:[
dragger := self.
offs2 := 0@0
@@ -2175,7 +2215,7 @@
rootMotion ifTrue:[
dragger := rootView.
- offset := viewOrigin.
+ offset := self viewOrigin.
] ifFalse:[
dragger := self.
offset := 0@0.
--- a/ObjectView.st Tue Nov 22 01:50:27 1994 +0100
+++ b/ObjectView.st Tue Nov 22 15:33:56 1994 +0100
@@ -48,7 +48,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/ObjectView.st,v 1.14 1994-11-22 00:50:27 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ObjectView.st,v 1.15 1994-11-22 14:33:56 claus Exp $
"
!
@@ -76,12 +76,12 @@
redrawX:x y:y width:w height:h
|innerX innerY innerW innerH redrawFrame |
- innerX := x.
- innerY := y.
- innerW := w.
- innerH := h.
+ ((contents size ~~ 0) or:[gridShown]) ifTrue:[
+ innerX := x.
+ innerY := y.
+ innerW := w.
+ innerH := h.
- ((contents size ~~ 0) or:[gridShown]) ifTrue:[
redrawFrame := Rectangle left:innerX top:innerY
width:innerW height:innerH.
self redrawObjectsInVisible:redrawFrame
@@ -354,12 +354,13 @@
alignToGrid:aPoint
"round aPoint to the next nearest point on the grid"
- |p0 pG|
+ |p0 pG viewOrigin|
aligning ifFalse:[
^ aPoint
].
+ viewOrigin := self viewOrigin.
viewOrigin ~= (0@0) ifTrue:[
p0 := aPoint - viewOrigin.
pG := (p0 grid:gridAlign) rounded. "/grid:(1 @ 1).
@@ -522,23 +523,27 @@
redrawObjectsOn:aGC
"redraw all objects on a graphic context"
- |vFrame org|
+ |vFrame org viewOrigin|
(aGC == self) ifTrue:[
- shown "realized" ifFalse:[^ self].
+ shown ifFalse:[^ self].
+ viewOrigin := self viewOrigin.
org := viewOrigin.
vFrame := Rectangle origin:org
corner:(viewOrigin + (width @ height)).
+ transformation notNil ifTrue:[
+ vFrame := transformation applyInverseTo:vFrame.
+ ].
self redrawObjectsIntersecting:vFrame
] ifFalse:[
"loop over pages"
+"
org := 0 @ 0.
vFrame := Rectangle origin:org
corner:(org + (width @ height)).
-"
self redrawObjectsIntersecting:vFrame
"
self objectsIntersecting:vFrame do:[:theObject |
@@ -578,9 +583,10 @@
"redraw all objects which have part of themselfes in aRectangle
draw only in (i.e. clip output to) aRectangle"
- |visRect|
+ |visRect viewOrigin|
shown ifTrue:[
+ viewOrigin := self viewOrigin.
visRect := Rectangle origin:(aRectangle origin - viewOrigin)
extent:(aRectangle extent).
clipRect notNil ifTrue:[
@@ -849,7 +855,7 @@
"find the last object (by looking from back to front) which is hit by
a visible point - this is the topmost object hit"
- ^ self findObjectAt:(aPoint + viewOrigin)
+ ^ self findObjectAt:(aPoint + self viewOrigin)
!
findObjectAt:aPoint suchThat:aBlock
@@ -873,7 +879,7 @@
the argument, aPoint and for which the testBlock, aBlock evaluates to
true"
- ^ self findObjectAt:(aPoint + viewOrigin) suchThat:aBlock
+ ^ self findObjectAt:(aPoint + self viewOrigin) suchThat:aBlock
!
canMove:something
@@ -1030,8 +1036,9 @@
objectsIntersectingVisible:aRectangle do:aBlock
"do something to every object which intersects a visible rectangle"
- |absRect|
+ |absRect viewOrigin|
+ viewOrigin := self viewOrigin.
absRect := Rectangle left:(aRectangle left + viewOrigin x)
top:(aRectangle top + viewOrigin y)
width:(aRectangle width)
@@ -1106,8 +1113,9 @@
"do something to every object which is completely in a
visible rectangle"
- |absRect|
+ |absRect viewOrigin|
+ viewOrigin := self viewOrigin.
absRect := Rectangle left:(aRectangle left + viewOrigin x)
top:(aRectangle top + viewOrigin y)
width:(aRectangle width)
@@ -1118,8 +1126,9 @@
visibleObjectsDo:aBlock
"do something to every visible object"
- |absRect|
+ |absRect viewOrigin|
+ viewOrigin := self viewOrigin.
absRect := Rectangle left:viewOrigin x
top:viewOrigin y
width:width
@@ -1130,8 +1139,9 @@
numberOfObjectsIntersectingVisible:aRectangle
"answer the number of objects intersecting the argument, aRectangle"
- |absRect|
+ |absRect viewOrigin|
+ viewOrigin := self viewOrigin.
absRect := Rectangle
left:(aRectangle left + viewOrigin x)
top:(aRectangle top + viewOrigin y)
@@ -1158,8 +1168,9 @@
objectsIntersectingVisible:aRectangle
"answer a Collection of objects intersecting a visible aRectangle"
- |absRect|
+ |absRect viewOrigin|
+ viewOrigin := self viewOrigin.
absRect := Rectangle left:(aRectangle left + viewOrigin x)
top:(aRectangle top + viewOrigin y)
width:(aRectangle width)
@@ -1202,8 +1213,9 @@
rectangleForScroll
"find the area occupied by visible objects"
- |left right top bottom frame oLeft oRight oTop oBottom orgX orgY|
+ |left right top bottom frame oLeft oRight oTop oBottom orgX orgY viewOrigin|
+ viewOrigin := self viewOrigin.
orgX := viewOrigin x.
orgY := viewOrigin y.
left := 9999.
@@ -1258,7 +1270,7 @@
|oldOrigin oldFrame newFrame
objectsIntersectingOldFrame objectsIntersectingNewFrame
wasObscured isObscured intersects
- vx vy oldLeft oldTop w h newLeft newTop griddedNewOrigin|
+ vx vy oldLeft oldTop w h newLeft newTop griddedNewOrigin viewOrigin|
anObject isNil ifTrue:[^ self].
anObject canBeMoved ifFalse:[^ self].
@@ -1280,6 +1292,7 @@
"if no other object intersects both frames we can do a copy:"
+ viewOrigin := self viewOrigin.
intersects := oldFrame intersects:newFrame.
intersects ifFalse:[
gridShown ifFalse:[
@@ -1623,6 +1636,24 @@
!ObjectView methodsFor:'view manipulation'!
+zoomIn
+ transformation isNil ifTrue:[
+ transformation := WindowingTransformation scale:1 translation:0
+ ].
+ transformation := WindowingTransformation scale:(transformation scale / 2)
+ translation:0.
+ self redraw
+!
+
+zoomOut
+ transformation isNil ifTrue:[
+ transformation := WindowingTransformation scale:1 translation:0
+ ].
+ transformation := WindowingTransformation scale:(transformation scale * 2)
+ translation:0.
+ self redraw
+!
+
zoom:factor
"set a zoom factor; nil or 1 is identity; 2 is magnify by 2;
0.5 is shrink by 2"
@@ -1693,15 +1724,24 @@
"dots every mm; lines every cm"
bigStepH := mmH * 10.0.
bigStepV := mmV * 10.0.
- littleStepH := mmH.
- littleStepV := mmV
+ (transformation notNil
+ and:[transformation scale <= 0.5]) ifFalse:[
+ littleStepH := mmH.
+ littleStepV := mmV
+ ]
].
(scaleMetric == #inch) ifTrue:[
"dots every eights inch; lines every half inch"
bigStepH := mmH * (25.4 / 2).
bigStepV := mmV * (25.4 / 2).
- littleStepH := mmH * (25.4 / 8).
- littleStepV := mmV * (25.4 / 8)
+ (transformation notNil
+ and:[transformation scale <= 0.5]) ifTrue:[
+ littleStepH := mmH * (25.4 / 4).
+ littleStepV := mmV * (25.4 / 4)
+ ] ifFalse:[
+ littleStepH := mmH * (25.4 / 8).
+ littleStepV := mmV * (25.4 / 8)
+ ]
].
arr := Array new:8.
@@ -1919,7 +1959,7 @@
self invertDragRectangle.
self cursor:oldCursor.
- self selectAllIn:(dragObject + viewOrigin)
+ self selectAllIn:(dragObject + self viewOrigin)
!
doRectangleDrag:aPoint
@@ -1968,7 +2008,7 @@
rootMotion ifTrue:[
dragger := rootView.
- offs2 := viewOrigin.
+ offs2 := self viewOrigin.
top := self topView.
org := device translatePoint:0@0 from:(self id) to:(rootView id).
offs2 := offs2 - org
@@ -1992,7 +2032,7 @@
rootMotion ifTrue:[
dragger := rootView.
- offs2 := viewOrigin.
+ offs2 := self viewOrigin.
top := self topView.
org := device translatePoint:0@0 from:(self id) to:(rootView id).
offs2 := offs2 - org
@@ -2113,7 +2153,7 @@
movedObject notNil ifTrue:[
rootMotion ifTrue:[
dragger := rootView.
- offs2 := viewOrigin
+ offs2 := self viewOrigin
] ifFalse:[
dragger := self.
offs2 := 0@0
@@ -2175,7 +2215,7 @@
rootMotion ifTrue:[
dragger := rootView.
- offset := viewOrigin.
+ offset := self viewOrigin.
] ifFalse:[
dragger := self.
offset := 0@0.