.
--- a/Color.st Mon Jul 03 02:35:52 1995 +0200
+++ b/Color.st Sun Jul 23 04:29:59 1995 +0200
@@ -26,7 +26,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Color.st,v 1.29 1995-07-02 16:15:12 claus Exp $
+$Header: /cvs/stx/stx/libview/Color.st,v 1.30 1995-07-23 02:25:22 claus Exp $
'!
!Color class methodsFor:'documentation'!
@@ -47,7 +47,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Color.st,v 1.29 1995-07-02 16:15:12 claus Exp $
+$Header: /cvs/stx/stx/libview/Color.st,v 1.30 1995-07-23 02:25:22 claus Exp $
"
!
@@ -2182,6 +2182,17 @@
"ST80 compatibility: return the grey intensity in [0..1]"
^ ((0.3 * redVal) + (0.6 * greenVal) + (0.1 * blueVal)) / 100
+!
+
+errorFrom:aColor
+ "return some value which can be used to compare colors.
+ The following simply returns the vector distance of the r/g/b vectors.
+ This may not be a very good idea; probably, we should honor the
+ fact that the hue difference should have more weight than saturation and/or light"
+
+ ^ (redVal - aColor red) asInteger squared
+ + (greenVal - aColor green) asInteger squared
+ + (blueVal - aColor blue) asInteger squared.
! !
!Color methodsFor:'inspecting'!
--- a/ContrWMenu.st Mon Jul 03 02:35:52 1995 +0200
+++ b/ContrWMenu.st Sun Jul 23 04:29:59 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/ContrWMenu.st,v 1.4 1995-05-10 02:24:54 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/ContrWMenu.st,v 1.5 1995-07-23 02:25:30 claus Exp $
'!
!ControllerWithMenu class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/ContrWMenu.st,v 1.4 1995-05-10 02:24:54 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/ContrWMenu.st,v 1.5 1995-07-23 02:25:30 claus Exp $
"
!
@@ -73,8 +73,11 @@
!
menu
- "to be redefined in subclasses"
+ "can be redefined in subclasses"
+ menuHolder notNil ifTrue:[
+ ^ menuHolder value
+ ].
^ nil
! !
--- a/Controll.st Mon Jul 03 02:35:52 1995 +0200
+++ b/Controll.st Sun Jul 23 04:29:59 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/Controll.st,v 1.22 1995-07-02 16:15:18 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/Controll.st,v 1.23 1995-07-23 02:25:33 claus Exp $
'!
!Controller class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/Controll.st,v 1.22 1995-07-02 16:15:18 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/Controll.st,v 1.23 1995-07-23 02:25:33 claus Exp $
"
!
@@ -86,7 +86,7 @@
right before it becomes visible.
Can be redefined in subclasses to do some startup action."
- ^ self
+ self controlInitialize.
!
release
@@ -97,6 +97,10 @@
view notNil ifTrue:[view controller:nil].
view := nil.
model := nil
+!
+
+controlInitialize
+ ^ self
! !
!Controller methodsFor:'ST-80 compatibility'!
--- a/Controller.st Mon Jul 03 02:35:52 1995 +0200
+++ b/Controller.st Sun Jul 23 04:29:59 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Controller.st,v 1.22 1995-07-02 16:15:18 claus Exp $
+$Header: /cvs/stx/stx/libview/Controller.st,v 1.23 1995-07-23 02:25:33 claus Exp $
'!
!Controller class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Controller.st,v 1.22 1995-07-02 16:15:18 claus Exp $
+$Header: /cvs/stx/stx/libview/Controller.st,v 1.23 1995-07-23 02:25:33 claus Exp $
"
!
@@ -86,7 +86,7 @@
right before it becomes visible.
Can be redefined in subclasses to do some startup action."
- ^ self
+ self controlInitialize.
!
release
@@ -97,6 +97,10 @@
view notNil ifTrue:[view controller:nil].
view := nil.
model := nil
+!
+
+controlInitialize
+ ^ self
! !
!Controller methodsFor:'ST-80 compatibility'!
--- a/ControllerWithMenu.st Mon Jul 03 02:35:52 1995 +0200
+++ b/ControllerWithMenu.st Sun Jul 23 04:29:59 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/ControllerWithMenu.st,v 1.4 1995-05-10 02:24:54 claus Exp $
+$Header: /cvs/stx/stx/libview/ControllerWithMenu.st,v 1.5 1995-07-23 02:25:30 claus Exp $
'!
!ControllerWithMenu class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/ControllerWithMenu.st,v 1.4 1995-05-10 02:24:54 claus Exp $
+$Header: /cvs/stx/stx/libview/ControllerWithMenu.st,v 1.5 1995-07-23 02:25:30 claus Exp $
"
!
@@ -73,8 +73,11 @@
!
menu
- "to be redefined in subclasses"
+ "can be redefined in subclasses"
+ menuHolder notNil ifTrue:[
+ ^ menuHolder value
+ ].
^ nil
! !
--- a/Cursor.st Mon Jul 03 02:35:52 1995 +0200
+++ b/Cursor.st Sun Jul 23 04:29:59 1995 +0200
@@ -19,7 +19,10 @@
NormalCursor HandCursor ArrowCursor
WaitCursor CrossHairCursor OriginCursor
CornerCursor SquareCursor FourWayCursor
- UpDownArrowCursor LeftRightArrowCursor'
+ UpDownArrowCursor LeftRightArrowCursor
+ ThumbsUpCursor ThumbsDownCursor
+ ReadCursor WriteCursor XeqCursor
+ StopCursor'
poolDictionaries:''
category:'Graphics-Support'
!
@@ -28,7 +31,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Cursor.st,v 1.19 1995-06-06 04:05:07 claus Exp $
+$Header: /cvs/stx/stx/libview/Cursor.st,v 1.20 1995-07-23 02:25:38 claus Exp $
'!
!Cursor class methodsFor:'documentation'!
@@ -49,7 +52,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Cursor.st,v 1.19 1995-06-06 04:05:07 claus Exp $
+$Header: /cvs/stx/stx/libview/Cursor.st,v 1.20 1995-07-23 02:25:38 claus Exp $
"
!
@@ -627,6 +630,9 @@
stop
"return a stop cursor (the default here is a wait-cursor)"
+ StopCursor notNil ifTrue:[
+ ^ StopCursor
+ ].
^ self wait
!
@@ -640,32 +646,47 @@
!
read
- "return a reading-file cursor"
+ "return a reading-file cursor (the default here is a wait-cursor)"
+ ReadCursor notNil ifTrue:[
+ ^ ReadCursor
+ ].
^ self wait
!
write
- "return a writing-file cursor"
+ "return a writing-file cursor (the default here is a wait-cursor)"
+ WriteCursor notNil ifTrue:[
+ ^ WriteCursor
+ ].
^ self wait
!
execute
- "return a execute cursor - ST-80 compatibility"
+ "return a execute cursor - (the default here is a wait-cursor)"
+ XeqCursor notNil ifTrue:[
+ ^ XeqCursor
+ ].
^ self wait
!
thumbsUp
"return a hand cursor - ST-80 compatibility"
+ ThumbsUpCursor notNil ifTrue:[
+ ^ ThumbsUpCursor
+ ].
^ self hand
!
thumbsDown
"return a hand cursor - ST-80 compatibility"
+ ThumbsDownCursor notNil ifTrue:[
+ ^ ThumbsDownCursor
+ ].
^ self hand
! !
@@ -901,7 +922,7 @@
cursorId := nil
! !
-!Cursor methodsFor:'displaying'!
+!Cursor methodsFor:'ST-80 displaying'!
showIn:aView
aView cursor:self
@@ -932,6 +953,13 @@
^ v
!
+show
+ "change cursors in active groups views to the receiver.
+ In X this seems to be very slow"
+
+ WindowGroup activeGroup showCursor:self
+!
+
displayOn:aGC at:origin clippingBox:aRectangle rule:aRule mask:aMask
"ST-80 compatibility;
limited functionality: can only display bitmap cursors (yet)"
--- a/DMedium.st Mon Jul 03 02:35:52 1995 +0200
+++ b/DMedium.st Sun Jul 23 04:29:59 1995 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/DMedium.st,v 1.9 1995-02-06 00:35:42 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DMedium.st,v 1.10 1995-07-23 02:25:42 claus Exp $
'!
!DisplayMedium class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/DMedium.st,v 1.9 1995-02-06 00:35:42 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DMedium.st,v 1.10 1995-07-23 02:25:42 claus Exp $
"
!
@@ -72,6 +72,36 @@
height := 0
! !
+!DisplayMedium ignoredMethodsFor:'accessing'!
+
+insideWidth
+ "return the usable width for drawing in the receiver;
+ this is width here, but Views/Pages may subtract margins"
+
+ ^ width
+!
+
+insideHeight
+ "return the usable height for drawing in the receiver;
+ this is height here, but Views/Pages may subtract margins"
+
+ ^ height
+!
+
+insideLeftOffset
+ "return the left offset for drawing in the receiver;
+ this is 0 here, but Views/Pages may add margins"
+
+ ^ 0
+!
+
+insideTopOffset
+ "return the top offset for drawing in the receiver;
+ this is 0 here, but Views/Pages may add margins"
+
+ ^ 0
+! !
+
!DisplayMedium methodsFor:'accessing'!
isView
@@ -98,20 +128,6 @@
^ 0
!
-insideLeftOffset
- "return the left offset for drawing in the receiver;
- this is 0 here, but Views/Pages may add margins"
-
- ^ 0
-!
-
-insideTopOffset
- "return the top offset for drawing in the receiver;
- this is 0 here, but Views/Pages may add margins"
-
- ^ 0
-!
-
width
"return the width of the receiver"
@@ -150,20 +166,6 @@
height := h
!
-insideWidth
- "return the usable width for drawing in the receiver;
- this is width here, but Views/Pages may subtract margins"
-
- ^ width
-!
-
-insideHeight
- "return the usable height for drawing in the receiver;
- this is height here, but Views/Pages may subtract margins"
-
- ^ height
-!
-
extent
"return the extent i.e. a point with width as x, height as y
coordinate"
@@ -301,11 +303,12 @@
]
"
- RootView fillRectangleX:0
- y:0
- width:50
- height:50
- with:(Color grey:50)
+ Display rootView
+ fillRectangleX:0
+ y:0
+ width:50
+ height:50
+ with:(Color grey:50)
"
!
--- a/Depth8Image.st Mon Jul 03 02:35:52 1995 +0200
+++ b/Depth8Image.st Sun Jul 23 04:29:59 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Depth8Image.st,v 1.25 1995-07-03 00:35:37 claus Exp $
+$Header: /cvs/stx/stx/libview/Depth8Image.st,v 1.26 1995-07-23 02:25:54 claus Exp $
'!
!Depth8Image class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Depth8Image.st,v 1.25 1995-07-03 00:35:37 claus Exp $
+$Header: /cvs/stx/stx/libview/Depth8Image.st,v 1.26 1995-07-23 02:25:54 claus Exp $
"
!
@@ -1058,6 +1058,24 @@
].
fit ifFalse:[
+"/ |tree|
+"/
+"/ "/ first, create an octTree containing colors which we got ...
+"/ tree := ColorOctree new.
+"/
+"/ usedColors from:1 to:lastOK do:[:aColorIndex |
+"/ tree insert:(colorMap at:aColorIndex + 1).
+"/ ].
+"/
+"/ "/ then, remap remaining, using nearest from those already allocated
+"/
+"/ usedColors from:(lastOK+1) to:(usedColors size) do:[:aColorIndex |
+"/ |mapIndex|
+"/
+"/ mapIndex := aColorIndex + 1.
+"/ imgMap at:mapIndex put:(tree findBest:(colorMap at:mapIndex))
+"/ ].
+
"
again, this time allow wrong colors (loop while increasing allowed error)
"
--- a/DevDraw.st Mon Jul 03 02:35:52 1995 +0200
+++ b/DevDraw.st Sun Jul 23 04:29:59 1995 +0200
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/DevDraw.st,v 1.24 1995-06-27 02:18:43 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DevDraw.st,v 1.25 1995-07-23 02:26:01 claus Exp $
'!
!DeviceDrawable class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/DevDraw.st,v 1.24 1995-06-27 02:18:43 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DevDraw.st,v 1.25 1995-07-23 02:26:01 claus Exp $
"
!
@@ -876,6 +876,23 @@
]
!
+atX:x y:y
+ "return the pixel at the coordinate given by x/y"
+
+ ^ device getPixelX:x y:y from:drawableId
+!
+
+atX:x y:y put:aPixel
+ "set a pixel"
+
+ |oldFg|
+
+ oldFg := foreground.
+ self foreground:aPixel.
+ self displayPointX:x y:y.
+ self foreground:oldFg
+!
+
at:aPoint
"return the pixel at the coordinate given by aPoint"
@@ -1747,23 +1764,23 @@
"/ look if we have a scaled version in our pocket ...
"/
realForm := nil.
- CachedScaledForms notNil ifTrue:[
- (CachedScales at:formToDraw ifAbsent:nil) = transformation scale ifTrue:[
- realForm := CachedScaledForms at:formToDraw ifAbsent:nil.
- ]
- ].
- realForm isNil ifTrue:[
+ CachedScaledForms notNil ifTrue:[
+ (CachedScales at:formToDraw ifAbsent:nil) = transformation scale ifTrue:[
+ realForm := CachedScaledForms at:formToDraw ifAbsent:nil.
+ ]
+ ].
+ realForm isNil ifTrue:[
"/
"/ nope - must do the work ...
"/
- realForm := formToDraw magnifiedBy:(nW / w) @ (nH / h).
- CachedScaledForms isNil ifTrue:[
- CachedScaledForms := WeakIdentityDictionary new.
- CachedScales := WeakIdentityDictionary new.
- ].
- CachedScaledForms at:formToDraw put:realForm.
- CachedScales at:formToDraw put:transformation scale.
- ]
+ realForm := formToDraw magnifiedBy:(nW / w) @ (nH / h).
+ CachedScaledForms isNil ifTrue:[
+ CachedScaledForms := WeakIdentityDictionary new.
+ CachedScales := WeakIdentityDictionary new.
+ ].
+ CachedScaledForms at:formToDraw put:realForm.
+ CachedScales at:formToDraw put:transformation scale.
+ ]
]
]
] ifFalse:[
@@ -1819,23 +1836,23 @@
"/ look if we have a scaled version in our pocket ...
"/
realForm := nil.
- CachedScaledForms notNil ifTrue:[
- (CachedScales at:formToDraw ifAbsent:nil) = transformation scale ifTrue:[
- realForm := CachedScaledForms at:formToDraw ifAbsent:nil.
- ]
- ].
- realForm isNil ifTrue:[
+ CachedScaledForms notNil ifTrue:[
+ (CachedScales at:formToDraw ifAbsent:nil) = transformation scale ifTrue:[
+ realForm := CachedScaledForms at:formToDraw ifAbsent:nil.
+ ]
+ ].
+ realForm isNil ifTrue:[
"/
"/ nope - must do the work ...
"/
- realForm := formToDraw magnifiedBy:(nW / w) @ (nH / h).
- CachedScaledForms isNil ifTrue:[
- CachedScaledForms := WeakIdentityDictionary new.
- CachedScales := WeakIdentityDictionary new.
- ].
- CachedScaledForms at:formToDraw put:realForm.
- CachedScales at:formToDraw put:transformation scale.
- ]
+ realForm := formToDraw magnifiedBy:(nW / w) @ (nH / h).
+ CachedScaledForms isNil ifTrue:[
+ CachedScaledForms := WeakIdentityDictionary new.
+ CachedScales := WeakIdentityDictionary new.
+ ].
+ CachedScaledForms at:formToDraw put:realForm.
+ CachedScales at:formToDraw put:transformation scale.
+ ]
]
]
] ifFalse:[
--- a/DevWorkst.st Mon Jul 03 02:35:52 1995 +0200
+++ b/DevWorkst.st Sun Jul 23 04:29:59 1995 +0200
@@ -36,7 +36,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/DevWorkst.st,v 1.38 1995-06-06 04:06:28 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DevWorkst.st,v 1.39 1995-07-23 02:26:12 claus Exp $
'!
!DeviceWorkstation class methodsFor:'documentation'!
@@ -57,7 +57,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/DevWorkst.st,v 1.38 1995-06-06 04:06:28 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DevWorkst.st,v 1.39 1995-07-23 02:26:12 claus Exp $
"
!
@@ -406,7 +406,8 @@
platformName
"ST-80 compatibility.
Return a string describing the display systems platform.
- Returns a dummy here. This method is redefined in concrete classes."
+ Returns a dummy here. This must be redefined in concrete
+ Workstation classes, to return somthing like 'X', 'MSWindows', 'OS/2' etc."
^ 'unknown'
!
@@ -778,6 +779,10 @@
Returns a dummy here."
^ 0
+
+ "
+ Display vendorRelease
+ "
!
protocolVersion
@@ -785,6 +790,10 @@
Returns a dummy here"
^ 0
+
+ "
+ Display protocolVersion
+ "
!
blackpixel
@@ -855,9 +864,9 @@
"
!
-viewFromPoint:aPoint
- "given a point on the screen, return the ST/X view in which that
- point is (this may be a subview). Return nil, if its not an st/X view
+viewIdFromPoint:aPoint
+ "given a point on the screen, return the id of the ST/X view in which that
+ point is (this may be a subview). Return nil, if its not an ST/X view
or if the point is on the background"
|view id searchId foundId|
@@ -868,12 +877,26 @@
foundId := searchId.
searchId := id
].
- view := self viewFromId:foundId.
+ ^ foundId
+!
+
+viewFromPoint:aPoint
+ "given a point on the screen, return the ST/X view in which that
+ point is (this may be a subview). Return nil, if its not an ST/X view
+ or if the point is on the background"
+
+ |view id|
+
+ id := self viewIdFromPoint:aPoint.
+ view := self viewFromId:id.
^ view
!
windowAt:aPoint
- "alias for viewFromPoint: - ST-80 compatibility"
+ "given a point on the screen, return the ST/X topview in which that
+ point is.
+ Return nil, if its not an ST/X view or if the point is on the background.
+ Alias for viewFromPoint: - ST-80 compatibility"
^ self viewFromPoint:aPoint
!
@@ -957,7 +980,7 @@
^ monitorType
"
- Display monitorType
+ Display monitorType
"
!
@@ -973,7 +996,7 @@
^ hasColors
"
- Display hasColors
+ Display hasColors
"
!
@@ -984,7 +1007,7 @@
^ hasGreyscales
"
- Display hasGreyscales
+ Display hasGreyscales
"
!
@@ -1025,6 +1048,10 @@
"This method has to be reimplemented in concrete display classes."
^ self subclassResponsibility
+
+ "
+ Display supportsDeepIcons
+ "
!
supportsViewGravity
@@ -1034,6 +1061,22 @@
"This method should to be reimplemented in concrete display classes."
^ false
+
+ "
+ Display supportsViewGravity
+ "
+!
+
+supportsGLDrawing
+ "return true, if this device supports 3D GL drawing.
+ We do not depend on that being implemented."
+
+ "This method should to be reimplemented in concrete display classes."
+ ^ false
+
+ "
+ Display supportsGLDrawing
+ "
!
keyboardMap
@@ -1301,7 +1344,11 @@
pointerMode:#async keyboardMode:#sync confineTo:nil.
activePointerGrab := rootView.
+ "
+ wait for leftButton ...
+ "
[self leftButtonPressed] whileFalse:[Processor yield].
+
p := self pointerPosition.
self ungrabPointer.
@@ -1313,6 +1360,7 @@
"
Display pointFromUserShowing:(Cursor stop)
Display pointFromUserShowing:(Cursor crossHair)
+ Display pointFromUserShowing:(Cursor origin)
Display pointFromUser
"
!
@@ -1332,10 +1380,9 @@
Start with initialRectangle.
A helper for rectangleFromUser; can also be used for resizing operations."
- |curs1 curs2 origin corner root rect|
-
- curs1 := Cursor origin on:self.
- curs2 := Cursor corner on:self.
+ |curs1 origin corner root rect|
+
+ curs1 := Cursor corner on:self.
root := self rootView.
@@ -1354,8 +1401,17 @@
rect := origin corner:corner.
root displayRectangle:rect.
- self grabPointerIn:root id withCursor:curs2 id
- pointerMode:#async keyboardMode:#sync confineTo:nil.
+ self
+ grabPointerIn:root id
+ withCursor:curs1 id
+ pointerMode:#async
+ keyboardMode:#sync
+ confineTo:nil.
+
+ "
+ just in case; wait for button to be down ...
+ "
+ [self leftButtonPressed] whileFalse:[Processor yield].
[self leftButtonPressed] whileTrue:[
left := initialRectangle origin x.
@@ -1401,6 +1457,8 @@
root displayRectangle:rect.
self disposeButtonEventsFor:nil.
self flush.
+ ] ifFalse:[
+ Processor yield
]
].
root displayRectangle:rect.
@@ -1417,6 +1475,10 @@
self disposeButtonEventsFor:nil.
^ rect
+
+ "
+ Display rectangleFromUser:(100@100 corner:300@300)
+ "
!
rectangleFromUser
@@ -1439,6 +1501,85 @@
"
!
+originFromUser:extent
+ "let user specify a rectangles origin on the screen, return the rectangle.
+ Start with initialRectangle.
+ Can be used for dragging operations."
+
+ |curs origin root rect|
+
+ curs := Cursor origin on:self.
+
+ "
+ just in case; wait for button to be down ...
+ "
+ [self leftButtonPressed] whileFalse:[Processor yield].
+
+ root := self rootView.
+
+ "
+ grab and wait for leftButton being pressed
+ "
+ origin := self pointerPosition.
+
+ root noClipByChildren.
+ root foreground:Color black background:Color white.
+
+ root xoring:[
+ |left right top bottom newOrigin newCorner p|
+
+ rect := origin extent:extent.
+ root displayRectangle:rect.
+
+ self
+ grabPointerIn:root id
+ withCursor:curs id
+ pointerMode:#async
+ keyboardMode:#sync
+ confineTo:nil.
+
+ [self leftButtonPressed] whileTrue:[
+ newOrigin := self pointerPosition.
+
+ (newOrigin ~= origin) ifTrue:[
+ root displayRectangle:rect.
+
+ self
+ grabPointerIn:root id
+ withCursor:curs id
+ pointerMode:#async
+ keyboardMode:#sync
+ confineTo:nil.
+
+ rect := newOrigin extent:extent.
+ root displayRectangle:rect.
+ self disposeButtonEventsFor:nil.
+ self flush.
+ origin := newOrigin.
+ ] ifFalse:[
+ Processor yield
+ ]
+ ].
+ root displayRectangle:rect.
+ self ungrabPointer.
+ ].
+
+ self ungrabPointer.
+
+ "flush all events pending on my display"
+
+ root clipByChildren.
+
+ self flush.
+ self disposeButtonEventsFor:nil.
+
+ ^ rect
+
+ "
+ Display originFromUser:200@200
+ "
+!
+
viewFromUser
"let user specify a view on the screen; if the selected view is
not an ST/X view, nil is returned.
--- a/DeviceWorkstation.st Mon Jul 03 02:35:52 1995 +0200
+++ b/DeviceWorkstation.st Sun Jul 23 04:29:59 1995 +0200
@@ -36,7 +36,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.38 1995-06-06 04:06:28 claus Exp $
+$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.39 1995-07-23 02:26:12 claus Exp $
'!
!DeviceWorkstation class methodsFor:'documentation'!
@@ -57,7 +57,7 @@
version
"
-$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.38 1995-06-06 04:06:28 claus Exp $
+$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.39 1995-07-23 02:26:12 claus Exp $
"
!
@@ -406,7 +406,8 @@
platformName
"ST-80 compatibility.
Return a string describing the display systems platform.
- Returns a dummy here. This method is redefined in concrete classes."
+ Returns a dummy here. This must be redefined in concrete
+ Workstation classes, to return somthing like 'X', 'MSWindows', 'OS/2' etc."
^ 'unknown'
!
@@ -778,6 +779,10 @@
Returns a dummy here."
^ 0
+
+ "
+ Display vendorRelease
+ "
!
protocolVersion
@@ -785,6 +790,10 @@
Returns a dummy here"
^ 0
+
+ "
+ Display protocolVersion
+ "
!
blackpixel
@@ -855,9 +864,9 @@
"
!
-viewFromPoint:aPoint
- "given a point on the screen, return the ST/X view in which that
- point is (this may be a subview). Return nil, if its not an st/X view
+viewIdFromPoint:aPoint
+ "given a point on the screen, return the id of the ST/X view in which that
+ point is (this may be a subview). Return nil, if its not an ST/X view
or if the point is on the background"
|view id searchId foundId|
@@ -868,12 +877,26 @@
foundId := searchId.
searchId := id
].
- view := self viewFromId:foundId.
+ ^ foundId
+!
+
+viewFromPoint:aPoint
+ "given a point on the screen, return the ST/X view in which that
+ point is (this may be a subview). Return nil, if its not an ST/X view
+ or if the point is on the background"
+
+ |view id|
+
+ id := self viewIdFromPoint:aPoint.
+ view := self viewFromId:id.
^ view
!
windowAt:aPoint
- "alias for viewFromPoint: - ST-80 compatibility"
+ "given a point on the screen, return the ST/X topview in which that
+ point is.
+ Return nil, if its not an ST/X view or if the point is on the background.
+ Alias for viewFromPoint: - ST-80 compatibility"
^ self viewFromPoint:aPoint
!
@@ -957,7 +980,7 @@
^ monitorType
"
- Display monitorType
+ Display monitorType
"
!
@@ -973,7 +996,7 @@
^ hasColors
"
- Display hasColors
+ Display hasColors
"
!
@@ -984,7 +1007,7 @@
^ hasGreyscales
"
- Display hasGreyscales
+ Display hasGreyscales
"
!
@@ -1025,6 +1048,10 @@
"This method has to be reimplemented in concrete display classes."
^ self subclassResponsibility
+
+ "
+ Display supportsDeepIcons
+ "
!
supportsViewGravity
@@ -1034,6 +1061,22 @@
"This method should to be reimplemented in concrete display classes."
^ false
+
+ "
+ Display supportsViewGravity
+ "
+!
+
+supportsGLDrawing
+ "return true, if this device supports 3D GL drawing.
+ We do not depend on that being implemented."
+
+ "This method should to be reimplemented in concrete display classes."
+ ^ false
+
+ "
+ Display supportsGLDrawing
+ "
!
keyboardMap
@@ -1301,7 +1344,11 @@
pointerMode:#async keyboardMode:#sync confineTo:nil.
activePointerGrab := rootView.
+ "
+ wait for leftButton ...
+ "
[self leftButtonPressed] whileFalse:[Processor yield].
+
p := self pointerPosition.
self ungrabPointer.
@@ -1313,6 +1360,7 @@
"
Display pointFromUserShowing:(Cursor stop)
Display pointFromUserShowing:(Cursor crossHair)
+ Display pointFromUserShowing:(Cursor origin)
Display pointFromUser
"
!
@@ -1332,10 +1380,9 @@
Start with initialRectangle.
A helper for rectangleFromUser; can also be used for resizing operations."
- |curs1 curs2 origin corner root rect|
-
- curs1 := Cursor origin on:self.
- curs2 := Cursor corner on:self.
+ |curs1 origin corner root rect|
+
+ curs1 := Cursor corner on:self.
root := self rootView.
@@ -1354,8 +1401,17 @@
rect := origin corner:corner.
root displayRectangle:rect.
- self grabPointerIn:root id withCursor:curs2 id
- pointerMode:#async keyboardMode:#sync confineTo:nil.
+ self
+ grabPointerIn:root id
+ withCursor:curs1 id
+ pointerMode:#async
+ keyboardMode:#sync
+ confineTo:nil.
+
+ "
+ just in case; wait for button to be down ...
+ "
+ [self leftButtonPressed] whileFalse:[Processor yield].
[self leftButtonPressed] whileTrue:[
left := initialRectangle origin x.
@@ -1401,6 +1457,8 @@
root displayRectangle:rect.
self disposeButtonEventsFor:nil.
self flush.
+ ] ifFalse:[
+ Processor yield
]
].
root displayRectangle:rect.
@@ -1417,6 +1475,10 @@
self disposeButtonEventsFor:nil.
^ rect
+
+ "
+ Display rectangleFromUser:(100@100 corner:300@300)
+ "
!
rectangleFromUser
@@ -1439,6 +1501,85 @@
"
!
+originFromUser:extent
+ "let user specify a rectangles origin on the screen, return the rectangle.
+ Start with initialRectangle.
+ Can be used for dragging operations."
+
+ |curs origin root rect|
+
+ curs := Cursor origin on:self.
+
+ "
+ just in case; wait for button to be down ...
+ "
+ [self leftButtonPressed] whileFalse:[Processor yield].
+
+ root := self rootView.
+
+ "
+ grab and wait for leftButton being pressed
+ "
+ origin := self pointerPosition.
+
+ root noClipByChildren.
+ root foreground:Color black background:Color white.
+
+ root xoring:[
+ |left right top bottom newOrigin newCorner p|
+
+ rect := origin extent:extent.
+ root displayRectangle:rect.
+
+ self
+ grabPointerIn:root id
+ withCursor:curs id
+ pointerMode:#async
+ keyboardMode:#sync
+ confineTo:nil.
+
+ [self leftButtonPressed] whileTrue:[
+ newOrigin := self pointerPosition.
+
+ (newOrigin ~= origin) ifTrue:[
+ root displayRectangle:rect.
+
+ self
+ grabPointerIn:root id
+ withCursor:curs id
+ pointerMode:#async
+ keyboardMode:#sync
+ confineTo:nil.
+
+ rect := newOrigin extent:extent.
+ root displayRectangle:rect.
+ self disposeButtonEventsFor:nil.
+ self flush.
+ origin := newOrigin.
+ ] ifFalse:[
+ Processor yield
+ ]
+ ].
+ root displayRectangle:rect.
+ self ungrabPointer.
+ ].
+
+ self ungrabPointer.
+
+ "flush all events pending on my display"
+
+ root clipByChildren.
+
+ self flush.
+ self disposeButtonEventsFor:nil.
+
+ ^ rect
+
+ "
+ Display originFromUser:200@200
+ "
+!
+
viewFromUser
"let user specify a view on the screen; if the selected view is
not an ST/X view, nil is returned.
--- a/DisplayMedium.st Mon Jul 03 02:35:52 1995 +0200
+++ b/DisplayMedium.st Sun Jul 23 04:29:59 1995 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/DisplayMedium.st,v 1.9 1995-02-06 00:35:42 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DisplayMedium.st,v 1.10 1995-07-23 02:25:42 claus Exp $
'!
!DisplayMedium class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/DisplayMedium.st,v 1.9 1995-02-06 00:35:42 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DisplayMedium.st,v 1.10 1995-07-23 02:25:42 claus Exp $
"
!
@@ -72,6 +72,36 @@
height := 0
! !
+!DisplayMedium ignoredMethodsFor:'accessing'!
+
+insideWidth
+ "return the usable width for drawing in the receiver;
+ this is width here, but Views/Pages may subtract margins"
+
+ ^ width
+!
+
+insideHeight
+ "return the usable height for drawing in the receiver;
+ this is height here, but Views/Pages may subtract margins"
+
+ ^ height
+!
+
+insideLeftOffset
+ "return the left offset for drawing in the receiver;
+ this is 0 here, but Views/Pages may add margins"
+
+ ^ 0
+!
+
+insideTopOffset
+ "return the top offset for drawing in the receiver;
+ this is 0 here, but Views/Pages may add margins"
+
+ ^ 0
+! !
+
!DisplayMedium methodsFor:'accessing'!
isView
@@ -98,20 +128,6 @@
^ 0
!
-insideLeftOffset
- "return the left offset for drawing in the receiver;
- this is 0 here, but Views/Pages may add margins"
-
- ^ 0
-!
-
-insideTopOffset
- "return the top offset for drawing in the receiver;
- this is 0 here, but Views/Pages may add margins"
-
- ^ 0
-!
-
width
"return the width of the receiver"
@@ -150,20 +166,6 @@
height := h
!
-insideWidth
- "return the usable width for drawing in the receiver;
- this is width here, but Views/Pages may subtract margins"
-
- ^ width
-!
-
-insideHeight
- "return the usable height for drawing in the receiver;
- this is height here, but Views/Pages may subtract margins"
-
- ^ height
-!
-
extent
"return the extent i.e. a point with width as x, height as y
coordinate"
@@ -301,11 +303,12 @@
]
"
- RootView fillRectangleX:0
- y:0
- width:50
- height:50
- with:(Color grey:50)
+ Display rootView
+ fillRectangleX:0
+ y:0
+ width:50
+ height:50
+ with:(Color grey:50)
"
!
--- a/Font.st Mon Jul 03 02:35:52 1995 +0200
+++ b/Font.st Sun Jul 23 04:29:59 1995 +0200
@@ -12,8 +12,8 @@
FontDescription subclass:#Font
instanceVariableNames:'device fontId replacementFont
- ascent descent height width isFixedWidth
- minWidth maxWidth'
+ ascent descent width isFixedWidth
+ minWidth maxWidth maxAscent maxDescent'
classVariableNames:'Lobby Replacements'
poolDictionaries:''
category:'Graphics-Support'
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Font.st,v 1.21 1995-06-06 04:06:37 claus Exp $
+$Header: /cvs/stx/stx/libview/Font.st,v 1.22 1995-07-23 02:26:23 claus Exp $
'!
!Font class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Font.st,v 1.21 1995-06-06 04:06:37 claus Exp $
+$Header: /cvs/stx/stx/libview/Font.st,v 1.22 1995-07-23 02:26:23 claus Exp $
"
!
@@ -53,6 +53,7 @@
Font represents fonts in a device independent manner; after being
created using 'Font family:family face:face style:style size:size',
the returned font is not associated to a specific device.
+ (therefore, those fonts can be used to draw on any GC)
To get a device font, any font can be sent the message
'aFont on:aDevice' which returns an instance of Font which is
@@ -62,7 +63,7 @@
For proper operation, each graphics operation working with fonts
must get a device font before doing the draw.
Most draw methods in DeviceDrawable do that automatically for you,
- before doing the draw.
+ before doing the draw; so you do not have to care.
However, some operations require explicit conversion to a device font
before being allowed. For example, a query for a fonts height (in device
@@ -109,7 +110,6 @@
ascent <Integer> the fonts ascent in device units on device
descent <Integer> the fonts descent in device units on device
- height <Integer> the fonts height in device units on device
width <Integer> the character width in device units on device
(for variable fonts, its the width of a space)
isFixedWidth <Boolean> true if font is a fixed width font
@@ -235,6 +235,44 @@
!Font methodsFor:'getting a device font'!
+on:aDevice ifAbsent:exceptionBlock
+ "create a new Font representing the same font as
+ myself on aDevice. This does NOT try to look for existing
+ or replacement fonts (i.e. can be used to get physical fonts)."
+
+ |newFont id rep|
+
+ "ask that device for the font"
+ id := aDevice getFontWithFamily:family face:face style:style size:size encoding:encoding.
+ id isNil ifTrue:[
+ "oops did not work - (device has no such font)"
+
+ ^ exceptionBlock value
+ ].
+
+ "receiver was not associated - do it now"
+ device isNil ifTrue:[
+ device := aDevice.
+ fontId := id.
+
+ self getFontInfos.
+ Lobby changed:self.
+ ^ self
+ ].
+
+ "receiver was already associated to another device - need a new font"
+ newFont := (self class basicNew) setFamily:family
+ face:face
+ style:style
+ size:size
+ encoding:encoding
+ device:aDevice.
+ newFont setFontId:id.
+ newFont getFontInfos.
+ Lobby register:newFont.
+ ^ newFont
+!
+
on:aDevice
"create a new Font representing the same font as
myself on aDevice; if one already exists, return the one."
@@ -261,9 +299,8 @@
]
].
- "ask that device for the font"
- id := aDevice getFontWithFamily:family face:face style:style size:size encoding:encoding.
- id isNil ifTrue:[
+ newFont := self on:aDevice ifAbsent:nil.
+ newFont isNil ifTrue:[
"oops did not work - (device has no such font)"
rep := self replacementFontOn:aDevice.
@@ -280,26 +317,6 @@
^ newFont
].
- "receiver was not associated - do it now"
- device isNil ifTrue:[
- device := aDevice.
- fontId := id.
-
- self getFontInfos.
- Lobby changed:self.
- ^ self
- ].
-
- "receiver was already associated to another device - need a new font"
- newFont := (self class basicNew) setFamily:family
- face:face
- style:style
- size:size
- encoding:encoding
- device:aDevice.
- newFont setFontId:id.
- newFont getFontInfos.
- Lobby register:newFont.
^ newFont
!
@@ -374,14 +391,16 @@
replacementFont isNil ifTrue:[
ascent := device ascentOf:fontId.
descent := device descentOf:fontId.
- height := descent + ascent.
+ maxAscent := device maxAscentOf:fontId.
+ maxDescent := device maxDescentOf:fontId.
width := device widthOf:' ' inFont:fontId.
minWidth := device minWidthOfFont:fontId.
maxWidth := device maxWidthOfFont:fontId.
] ifFalse:[
ascent := replacementFont ascent.
descent := replacementFont descent.
- height := descent + ascent.
+ maxAscent := replacementFont maxAscent.
+ maxDescent := replacementFont maxDescent.
width := replacementFont width.
minWidth := replacementFont minWidth.
maxWidth := replacementFont maxWidth.
@@ -405,11 +424,23 @@
!Font methodsFor:'queries'!
+existsOn:aDevice
+ "return true, if the recevier is available on aDevice;
+ false otherwise. This is a kludge method; its better to
+ ask a device for its available fonts and use this info ...
+ Notice, that if you simply use a font by name, the system
+ will automatically take a replacement font."
+
+ ^ (self on:aDevice ifAbsent:nil) isNil
+!
+
isFixedWidth
- "return true, if all characters have same width (as in courier"
+ "return true, if all characters have same width (as in courier).
+ The receiver must be associated to a device,
+ for this query to be legal."
device isNil ifTrue:[
- self errorNoDevice
+ self errorNoDevice.
].
replacementFont notNil ifTrue:[
^ replacementFont isFixedWidth
@@ -417,26 +448,46 @@
^ isFixedWidth
!
-height
- "return the characters maximum height;
- That is the number of units (usually pixels) on the device"
+maxHeight
+ "return the fonts characters maximum height;
+ That is the number of units (usually pixels) on the device.
+ The receiver must be associated to a device,
+ for this query to be legal."
device isNil ifTrue:[
- self errorNoDevice
+ self errorNoDevice.
+ ].
+ replacementFont notNil ifTrue:[
+ ^ replacementFont maxHeight
+ ].
+ ^ maxDescent + maxAscent.
+!
+
+height
+ "return the fonts characters normal (average) height;
+ That is the number of units (usually pixels) on the device.
+ The receiver must be associated to a device,
+ for this query to be legal."
+
+ device isNil ifTrue:[
+ self errorNoDevice.
].
replacementFont notNil ifTrue:[
^ replacementFont height
].
- ^ height
+ ^ descent + ascent.
!
width
- "return the characters width;
+ "return the fonts characters width;
That is the number of units (usually pixels) on the device.
- For variable pitch fonts, the width of the space character is returned"
+ For variable pitch fonts, the width of the space character is returned.
+ For fixed fonts, this is the same as minWidth or maxWidth.
+ The receiver must be associated to a device,
+ for this query to be legal."
device isNil ifTrue:[
- self errorNoDevice
+ self errorNoDevice.
].
replacementFont notNil ifTrue:[
^ replacementFont width
@@ -446,7 +497,9 @@
minWidth
"return the width of the smallest character;
- if the receiver is a fixed width font its the width of every character"
+ if the receiver is a fixed width font its the width of every character.
+ The receiver must be associated to a device,
+ for this query to be legal."
device isNil ifTrue:[
self errorNoDevice
@@ -459,7 +512,9 @@
maxWidth
"return the width of the widest character;
- if the receiver is a fixed width font its the width of every character"
+ if the receiver is a fixed width font its the width of every character.
+ The receiver must be associated to a device,
+ for this query to be legal."
device isNil ifTrue:[
self errorNoDevice
@@ -470,9 +525,41 @@
^ maxWidth
!
+maxAscent
+ "return the fonts maximum-ascent (i.e. the maximum of all characters);
+ That is the number of units (usually pixels) above the baseline.
+ The receiver must be associated to a device,
+ for this query to be legal."
+
+ device isNil ifTrue:[
+ self errorNoDevice
+ ].
+ replacementFont notNil ifTrue:[
+ ^ replacementFont maxAscent
+ ].
+ ^ maxAscent
+!
+
+maxDescent
+ "return the font-descent (i.e. the maximum of all characters);
+ That is the number of units (usually pixels) below the baseline.
+ The receiver must be associated to a device,
+ for this query to be legal."
+
+ device isNil ifTrue:[
+ self errorNoDevice
+ ].
+ replacementFont notNil ifTrue:[
+ ^ replacementFont maxDescent
+ ].
+ ^ maxDescent
+!
+
ascent
- "return the font-ascent i.e. the maximum of all characters;
- That is the number of units (usually pixels) above the baseline"
+ "return the font-ascent (i.e. the normal average of all characters);
+ That is the number of units (usually pixels) above the baseline.
+ The receiver must be associated to a device,
+ for this query to be legal."
device isNil ifTrue:[
self errorNoDevice
@@ -484,8 +571,10 @@
!
descent
- "return the font-descent i.e. the maximum of all characters;
- That is the number of units (usually pixels) below the baseline"
+ "return the font-descent (i.e. the normal average of all characters);
+ That is the number of units (usually pixels) below the baseline.
+ The receiver must be associated to a device,
+ for this query to be legal."
device isNil ifTrue:[
self errorNoDevice
@@ -498,8 +587,10 @@
widthOf:textOrString
"return the width (device specific) of the argument;
- the argument may be a String or some Text;
- in the later case the width of the longest line in the text is returned"
+ the argument may be a Character, String or some Text;
+ in the last case the width of the longest line in the text is returned.
+ The receiver must be associated to a device,
+ for this query to be legal."
|this max|
@@ -517,6 +608,12 @@
].
^ width * textOrString size
].
+ (textOrString isCharacter) ifTrue:[
+ isFixedWidth ifFalse:[
+ ^ device widthOf:textOrString asString inFont:fontId
+ ].
+ ^ width
+ ].
max := 0.
isFixedWidth ifFalse:[
@@ -537,7 +634,9 @@
!
widthOf:aString from:start to:stop
- "return the width of a substring"
+ "return the width of a substring.
+ The receiver must be associated to a device,
+ for this query to be legal."
device isNil ifTrue:[
self errorNoDevice.
@@ -557,7 +656,8 @@
displayString:aString x:x y:y in:aGC
"this is only called for fonts which have a nil fontId,
- and therefore use the replacementFont"
+ and therefore use the replacementFont. Should never be called
+ for non-replacement fonts."
replacementFont isNil ifTrue:[
'FONT: oops should not happen' errorPrintNL.
@@ -569,7 +669,8 @@
displayString:aString from:index1 to:index2 x:x y:y in:aGC
"this is only called for fonts which have a nil fontId,
- and therefore use the replacementFont"
+ and therefore use the replacementFont. Should never be called
+ for non-replacement fonts."
replacementFont isNil ifTrue:[
'FONT: oops should not happen' errorPrintNL.
@@ -599,7 +700,12 @@
printOn:aStream
face isNil ifTrue:[
- aStream nextPutAll:('a ' , family , '-Font')
+ family isNil ifTrue:[
+ aStream nextPutAll:('a replacement-Font').
+ ^ self
+ ].
+ aStream nextPutAll:('a ' , family , '-Font').
+ ^ self.
].
aStream nextPutAll:('a ' , family , '-' ,
face , '-' ,
--- a/GC.st Mon Jul 03 02:35:52 1995 +0200
+++ b/GC.st Sun Jul 23 04:29:59 1995 +0200
@@ -25,7 +25,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/GC.st,v 1.16 1995-06-06 04:06:53 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/GC.st,v 1.17 1995-07-23 02:26:30 claus Exp $
'!
!GraphicsContext class methodsFor:'documentation'!
@@ -46,7 +46,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/GC.st,v 1.16 1995-06-06 04:06:53 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/GC.st,v 1.17 1995-07-23 02:26:30 claus Exp $
"
!
@@ -704,6 +704,12 @@
self displayOpaqueString:aString x:(aPoint x) y:(aPoint y)
!
+displayOpaqueString:aString from:start to:stop at:aPoint
+ "draw part of a string - drawing both fg and bg"
+
+ ^ self displayOpaqueString:aString from:start to:stop x:aPoint x y:aPoint y
+!
+
displayString:aString x:x y:y
"draw a string - drawing fg only"
@@ -716,6 +722,12 @@
self displayString:aString x:aPoint x y:aPoint y
!
+displayString:aString from:start to:stop at:aPoint
+ "draw part of a string - drawing fg only"
+
+ ^ self displayString:aString from:start to:stop x:aPoint x y:aPoint y
+!
+
displayPointX:x y:y
"draw a point at x/y"
--- a/GLXWorkstat.st Mon Jul 03 02:35:52 1995 +0200
+++ b/GLXWorkstat.st Sun Jul 23 04:29:59 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/GLXWorkstat.st,v 1.21 1995-06-06 04:07:06 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/GLXWorkstat.st,v 1.22 1995-07-23 02:26:55 claus Exp $
'!
!GLXWorkstation class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/GLXWorkstat.st,v 1.21 1995-06-06 04:07:06 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/GLXWorkstat.st,v 1.22 1995-07-23 02:26:55 claus Exp $
"
!
@@ -93,6 +93,8 @@
*** NO WARRANTY ** for this.
Notice: this should be rewritten to use the openGL library functions
+ (actually, to not loose the VGL interface, another OpenGLWorkstation
+ class should be written)
"
! !
@@ -126,6 +128,7 @@
#else
# undef memset
# include <vogl.h>
+# undef move
# include <X11/Xlib.h>
#endif
@@ -171,6 +174,9 @@
#define myDpy MKDPY(_INST(displayId))
+/*
+ * set the GLXWindow for followup drawing
+ */
#define SETWIN(aGLXWindowId) \
if (_INST(activeWindow) != aGLXWindowId) { \
if (! __isSmallInteger(aGLXWindowId)) { \
@@ -182,12 +188,29 @@
_INST(activeWindow) = aGLXWindowId; \
}
+#define _MKBOOLEAN(b) ((b==FALSE) ? false : true)
+#define _booleanVal(b) ((b==false) ? (Boolean)FALSE : (Boolean)TRUE)
+#define _coordVal(c) \
+ ((__isFloat(c)) ? (Coord)(_floatVal(c)) \
+ : (Coord)(_intVal(c)))
+#define _icoordVal(c) ((Icoord)(_intVal(c)))
+#define _scoordVal(c) ((Scoord)(_intVal(c)))
+#define _screencoordVal(c) ((Screencoord)(_intVal(c)))
+#define _colorindexVal(c) ((Colorindex)(_intVal(c)))
+#define _linestyleVal(l) ((Linestyle)(_intVal(l)))
+#define _shortVal(l) ((short)(_intVal(l)))
+#define _longVal(l) ((long)(_intVal(l)))
+#define _deviceVal(l) ((Device)(_intVal(l)))
+#define _tagVal(l) ((Tag)(_intVal(l)))
+#define _objectVal(l) ((Object)(_intVal(l)))
+#define _offsetVal(l) ((Offset)(_intVal(l)))
+#define _rgbVal(l) ((RGBvalue)(_intVal(l)))
+#define _angleVal(c) ((Angle)(_intVal(c)))
+
/*
* check for and fetch a boolean from ST-arg into C-dst
- * ST-object must be true or false
+ * ST-object must be true or false. Return wth false if invalid.
*/
-#define _MKBOOLEAN(b) ((b==FALSE) ? false : true)
-#define _booleanVal(b) ((b==false) ? (Boolean)FALSE : (Boolean)TRUE)
#define _BOOLEAN_(arg, dst) \
if (arg==true) \
dst = (Boolean)TRUE; \
@@ -197,12 +220,9 @@
/*
* check for and fetch a coord from ST-arg into C-dst
- * ST-object must be Float, SmallInteger or Fraction
+ * ST-object must be Float, SmallInteger or Fraction.
+ * Return wth false if invalid.
*/
-#define _coordVal(c) \
- ((__isFloat(c)) ? (Coord)(_floatVal(c)) \
- : (Coord)(_intVal(c)))
-
#define _COORD_(arg, dst) \
if (__isFloat(arg)) \
dst = (Coord)(_floatVal(arg)); \
@@ -220,46 +240,32 @@
/*
* check for and fetch an icoord from ST-arg into C-dst
- * ST-object must be SmallInteger
+ * ST-object must be SmallInteger. Return wth false if invalid.
*/
-#define _icoordVal(c) ((Icoord)(_intVal(c)))
#define _ICOORD_(arg, dst) \
if (__isSmallInteger(arg)) \
dst = (Icoord)(_intVal(arg)); \
else { RETURN(false); }
/*
- * check for and fetch an icoord from ST-arg into C-dst
- * ST-object must be SmallInteger
+ * check for and fetch an scoord from ST-arg into C-dst
+ * ST-object must be SmallInteger. Return wth false if invalid.
*/
-#define _scoordVal(c) ((Scoord)(_intVal(c)))
#define _SCOORD_(arg, dst) \
if (__isSmallInteger(arg)) \
dst = (Scoord)(_intVal(arg)); \
else { RETURN(false); }
-#define _screencoordVal(c) ((Screencoord)(_intVal(c)))
#define _SCREENCOORD_(arg, dst) \
if (__isSmallInteger(arg)) \
dst = (Screencoord)(_intVal(arg)); \
else { RETURN(false); }
-#define _colorindexVal(c) ((Colorindex)(_intVal(c)))
#define _COLORINDEX_(arg, dst) \
if (__isSmallInteger(arg)) \
dst = (Colorindex)(_intVal(arg)); \
else { RETURN(false); }
-#define _linestyleVal(l) ((Linestyle)(_intVal(l)))
-#define _shortVal(l) ((short)(_intVal(l)))
-#define _longVal(l) ((long)(_intVal(l)))
-#define _deviceVal(l) ((Device)(_intVal(l)))
-#define _tagVal(l) ((Tag)(_intVal(l)))
-#define _objectVal(l) ((Object)(_intVal(l)))
-#define _offsetVal(l) ((Offset)(_intVal(l)))
-#define _rgbVal(l) ((RGBvalue)(_intVal(l)))
-
-#define _angleVal(c) ((Angle)(_intVal(c)))
#define _ANGLE_(arg, dst) \
if (__isSmallInteger(arg)) \
dst = (Angle)(_intVal(arg)); \
@@ -962,10 +968,22 @@
!GLXWorkstation methodsFor:'queries'!
+supportsGLDrawing
+ "return true, if this device supports 3D GL drawing."
+
+ ^ true
+
+ "
+ Display supportsGLDrawing
+ "
+!
+
supportsRGB
"return true, if this gl workstation supports rgb
(in addition to indexed) colors. Actually, we return true
- for a real GL engine, false for the simulator here."
+ for a real GL engine, false for the simulator here.
+ For portable applications, always combine this with a query
+ if the display supports GL drawing at all."
%{ /* NOCONTEXT */
#ifdef GLX
@@ -980,8 +998,10 @@
!
supportsLight
- "return true, if this gl workstation supports light
- (i.e. if its a real GL)"
+ "return true, if this gl workstation supports light sources
+ (i.e. if its a real GL).
+ For portable applications, always combine this with a query
+ if the display supports GL drawing at all."
%{ /* NOCONTEXT */
#ifdef GLX
@@ -997,7 +1017,9 @@
supportsTextures
"return true, if this gl workstation supports texture mapping
- (i.e. if its a real GL)"
+ (i.e. if its a real GL).
+ For portable applications, always combine this with a query
+ if the display supports GL drawing at all."
%{ /* NOCONTEXT */
#ifdef GLX
@@ -1014,7 +1036,10 @@
!
supportsDoubleBuffer
- "return true, if this gl workstation supports double buffering"
+ "return true, if this gl workstation supports double buffering.
+ For portable applications, always combine this with a query
+ if the display supports GL drawing at all."
+
%{ /* NOCONTEXT */
#ifdef GLX
@@ -1031,7 +1056,10 @@
!
supportsZBuffer
- "return true, if this gl workstation has z buffer support"
+ "return true, if this gl workstation has z buffer support.
+ For portable applications, always combine this with a query
+ if the display supports GL drawing at all."
+
%{ /* NOCONTEXT */
#ifdef GLX
@@ -1068,11 +1096,7 @@
!GLXWorkstation methodsFor:'window creation'!
createGLXWindowFor:aView left:xpos top:ypos width:wwidth height:wheight type:glxType
- |ext minWidth minHeight maxWidth maxHeight
- bWidth bColor viewBg viewBgId wsuperView wsuperViewId wcreateOnTop
- winputOnly wlabel wcursor wcursorId wicon wiconId windowId
- weventMask wiconView wiconViewId bitGravity viewGravity vBgColor
- vBgForm deepForm|
+ |ext wsuperView wsuperViewId windowId|
wsuperView := aView superView.
wsuperView notNil ifTrue:[
@@ -3242,6 +3266,7 @@
!
glxBackface: b in: aGLXWindowId
+ "enable/disable backface culling"
%{ /* NOCONTEXT */
SETWIN(aGLXWindowId)
@@ -3820,6 +3845,18 @@
^ false
!
+glxDraw:v in: aGLXWindowId
+
+%{ /* NOCONTEXT */
+ float vec[3], *c_v;
+
+ if (! (c_v = getFloatsFromInto(v, vec, 3))) RETURN(false);
+ SETWIN(aGLXWindowId)
+ draw((Coord)(c_v[0]), (Coord)(c_v[1]), (Coord)(c_v[2]));
+ RETURN (true);
+%}
+!
+
glxDrawX: x y: y z: z in: aGLXWindowId
%{ /* NOCONTEXT */
@@ -3862,6 +3899,18 @@
%}
!
+glxDraw2:v in: aGLXWindowId
+
+%{ /* NOCONTEXT */
+ float vec[2], *c_v;
+
+ if (! (c_v = getFloatsFromInto(v, vec, 2))) RETURN(false);
+ SETWIN(aGLXWindowId)
+ draw2((Coord)(c_v[0]), (Coord)(c_v[1]));
+ RETURN (true);
+%}
+!
+
glxDraw2X: x y: y in: aGLXWindowId
%{ /* NOCONTEXT */
@@ -4849,6 +4898,18 @@
^ false
!
+glxMove:v in: aGLXWindowId
+
+%{ /* NOCONTEXT */
+ float vec[3], *c_v;
+
+ if (! (c_v = getFloatsFromInto(v, vec, 3))) RETURN(false);
+ SETWIN(aGLXWindowId)
+ move((Coord)(c_v[0]), (Coord)(c_v[1]), (Coord)(c_v[2]));
+ RETURN (true);
+%}
+!
+
glxMoveX: x y: y z: z in: aGLXWindowId
%{ /* NOCONTEXT */
@@ -4891,6 +4952,18 @@
%}
!
+glxMove2:v in: aGLXWindowId
+
+%{ /* NOCONTEXT */
+ float vec[2], *c_v;
+
+ if (! (c_v = getFloatsFromInto(v, vec, 2))) RETURN(false);
+ SETWIN(aGLXWindowId)
+ move2((Coord)(c_v[0]), (Coord)(c_v[1]));
+ RETURN (true);
+%}
+!
+
glxMove2X: x y: y in: aGLXWindowId
%{ /* NOCONTEXT */
@@ -5684,6 +5757,18 @@
%}
!
+glxRdr:v in: aGLXWindowId
+
+%{ /* NOCONTEXT */
+ float vec[3], *c_v;
+
+ if (! (c_v = getFloatsFromInto(v, vec, 3))) RETURN(false);
+ SETWIN(aGLXWindowId)
+ rdr((Coord)(c_v[0]), (Coord)(c_v[1]), (Coord)(c_v[2]));
+ RETURN (true);
+%}
+!
+
glxRdrX: x y: y z: z in: aGLXWindowId
%{ /* NOCONTEXT */
@@ -5726,6 +5811,18 @@
%}
!
+glxRdr2:v in: aGLXWindowId
+
+%{ /* NOCONTEXT */
+ float vec[2], *c_v;
+
+ if (! (c_v = getFloatsFromInto(v, vec, 2))) RETURN(false);
+ SETWIN(aGLXWindowId)
+ rdr2((Coord)(c_v[0]), (Coord)(c_v[1]));
+ RETURN (true);
+%}
+!
+
glxRdr2X: x y: y in: aGLXWindowId
%{ /* NOCONTEXT */
@@ -5915,6 +6012,18 @@
^ false
!
+glxRmv:v in: aGLXWindowId
+
+%{ /* NOCONTEXT */
+ float vec[3], *c_v;
+
+ if (! (c_v = getFloatsFromInto(v, vec, 3))) RETURN(false);
+ SETWIN(aGLXWindowId)
+ rmv((Coord)(c_v[0]), (Coord)(c_v[1]), (Coord)(c_v[2]));
+ RETURN (true);
+%}
+!
+
glxRmvX: x y: y z: z in: aGLXWindowId
%{ /* NOCONTEXT */
@@ -5957,6 +6066,18 @@
%}
!
+glxRmv2:v in: aGLXWindowId
+
+%{ /* NOCONTEXT */
+ float vec[2], *c_v;
+
+ if (! (c_v = getFloatsFromInto(v, vec, 2))) RETURN(false);
+ SETWIN(aGLXWindowId)
+ rmv2((Coord)(c_v[0]), (Coord)(c_v[1]));
+ RETURN (true);
+%}
+!
+
glxRmv2X: x y: y in: aGLXWindowId
%{ /* NOCONTEXT */
--- a/GLXWorkstation.st Mon Jul 03 02:35:52 1995 +0200
+++ b/GLXWorkstation.st Sun Jul 23 04:29:59 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/GLXWorkstation.st,v 1.21 1995-06-06 04:07:06 claus Exp $
+$Header: /cvs/stx/stx/libview/GLXWorkstation.st,v 1.22 1995-07-23 02:26:55 claus Exp $
'!
!GLXWorkstation class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/GLXWorkstation.st,v 1.21 1995-06-06 04:07:06 claus Exp $
+$Header: /cvs/stx/stx/libview/GLXWorkstation.st,v 1.22 1995-07-23 02:26:55 claus Exp $
"
!
@@ -93,6 +93,8 @@
*** NO WARRANTY ** for this.
Notice: this should be rewritten to use the openGL library functions
+ (actually, to not loose the VGL interface, another OpenGLWorkstation
+ class should be written)
"
! !
@@ -126,6 +128,7 @@
#else
# undef memset
# include <vogl.h>
+# undef move
# include <X11/Xlib.h>
#endif
@@ -171,6 +174,9 @@
#define myDpy MKDPY(_INST(displayId))
+/*
+ * set the GLXWindow for followup drawing
+ */
#define SETWIN(aGLXWindowId) \
if (_INST(activeWindow) != aGLXWindowId) { \
if (! __isSmallInteger(aGLXWindowId)) { \
@@ -182,12 +188,29 @@
_INST(activeWindow) = aGLXWindowId; \
}
+#define _MKBOOLEAN(b) ((b==FALSE) ? false : true)
+#define _booleanVal(b) ((b==false) ? (Boolean)FALSE : (Boolean)TRUE)
+#define _coordVal(c) \
+ ((__isFloat(c)) ? (Coord)(_floatVal(c)) \
+ : (Coord)(_intVal(c)))
+#define _icoordVal(c) ((Icoord)(_intVal(c)))
+#define _scoordVal(c) ((Scoord)(_intVal(c)))
+#define _screencoordVal(c) ((Screencoord)(_intVal(c)))
+#define _colorindexVal(c) ((Colorindex)(_intVal(c)))
+#define _linestyleVal(l) ((Linestyle)(_intVal(l)))
+#define _shortVal(l) ((short)(_intVal(l)))
+#define _longVal(l) ((long)(_intVal(l)))
+#define _deviceVal(l) ((Device)(_intVal(l)))
+#define _tagVal(l) ((Tag)(_intVal(l)))
+#define _objectVal(l) ((Object)(_intVal(l)))
+#define _offsetVal(l) ((Offset)(_intVal(l)))
+#define _rgbVal(l) ((RGBvalue)(_intVal(l)))
+#define _angleVal(c) ((Angle)(_intVal(c)))
+
/*
* check for and fetch a boolean from ST-arg into C-dst
- * ST-object must be true or false
+ * ST-object must be true or false. Return wth false if invalid.
*/
-#define _MKBOOLEAN(b) ((b==FALSE) ? false : true)
-#define _booleanVal(b) ((b==false) ? (Boolean)FALSE : (Boolean)TRUE)
#define _BOOLEAN_(arg, dst) \
if (arg==true) \
dst = (Boolean)TRUE; \
@@ -197,12 +220,9 @@
/*
* check for and fetch a coord from ST-arg into C-dst
- * ST-object must be Float, SmallInteger or Fraction
+ * ST-object must be Float, SmallInteger or Fraction.
+ * Return wth false if invalid.
*/
-#define _coordVal(c) \
- ((__isFloat(c)) ? (Coord)(_floatVal(c)) \
- : (Coord)(_intVal(c)))
-
#define _COORD_(arg, dst) \
if (__isFloat(arg)) \
dst = (Coord)(_floatVal(arg)); \
@@ -220,46 +240,32 @@
/*
* check for and fetch an icoord from ST-arg into C-dst
- * ST-object must be SmallInteger
+ * ST-object must be SmallInteger. Return wth false if invalid.
*/
-#define _icoordVal(c) ((Icoord)(_intVal(c)))
#define _ICOORD_(arg, dst) \
if (__isSmallInteger(arg)) \
dst = (Icoord)(_intVal(arg)); \
else { RETURN(false); }
/*
- * check for and fetch an icoord from ST-arg into C-dst
- * ST-object must be SmallInteger
+ * check for and fetch an scoord from ST-arg into C-dst
+ * ST-object must be SmallInteger. Return wth false if invalid.
*/
-#define _scoordVal(c) ((Scoord)(_intVal(c)))
#define _SCOORD_(arg, dst) \
if (__isSmallInteger(arg)) \
dst = (Scoord)(_intVal(arg)); \
else { RETURN(false); }
-#define _screencoordVal(c) ((Screencoord)(_intVal(c)))
#define _SCREENCOORD_(arg, dst) \
if (__isSmallInteger(arg)) \
dst = (Screencoord)(_intVal(arg)); \
else { RETURN(false); }
-#define _colorindexVal(c) ((Colorindex)(_intVal(c)))
#define _COLORINDEX_(arg, dst) \
if (__isSmallInteger(arg)) \
dst = (Colorindex)(_intVal(arg)); \
else { RETURN(false); }
-#define _linestyleVal(l) ((Linestyle)(_intVal(l)))
-#define _shortVal(l) ((short)(_intVal(l)))
-#define _longVal(l) ((long)(_intVal(l)))
-#define _deviceVal(l) ((Device)(_intVal(l)))
-#define _tagVal(l) ((Tag)(_intVal(l)))
-#define _objectVal(l) ((Object)(_intVal(l)))
-#define _offsetVal(l) ((Offset)(_intVal(l)))
-#define _rgbVal(l) ((RGBvalue)(_intVal(l)))
-
-#define _angleVal(c) ((Angle)(_intVal(c)))
#define _ANGLE_(arg, dst) \
if (__isSmallInteger(arg)) \
dst = (Angle)(_intVal(arg)); \
@@ -962,10 +968,22 @@
!GLXWorkstation methodsFor:'queries'!
+supportsGLDrawing
+ "return true, if this device supports 3D GL drawing."
+
+ ^ true
+
+ "
+ Display supportsGLDrawing
+ "
+!
+
supportsRGB
"return true, if this gl workstation supports rgb
(in addition to indexed) colors. Actually, we return true
- for a real GL engine, false for the simulator here."
+ for a real GL engine, false for the simulator here.
+ For portable applications, always combine this with a query
+ if the display supports GL drawing at all."
%{ /* NOCONTEXT */
#ifdef GLX
@@ -980,8 +998,10 @@
!
supportsLight
- "return true, if this gl workstation supports light
- (i.e. if its a real GL)"
+ "return true, if this gl workstation supports light sources
+ (i.e. if its a real GL).
+ For portable applications, always combine this with a query
+ if the display supports GL drawing at all."
%{ /* NOCONTEXT */
#ifdef GLX
@@ -997,7 +1017,9 @@
supportsTextures
"return true, if this gl workstation supports texture mapping
- (i.e. if its a real GL)"
+ (i.e. if its a real GL).
+ For portable applications, always combine this with a query
+ if the display supports GL drawing at all."
%{ /* NOCONTEXT */
#ifdef GLX
@@ -1014,7 +1036,10 @@
!
supportsDoubleBuffer
- "return true, if this gl workstation supports double buffering"
+ "return true, if this gl workstation supports double buffering.
+ For portable applications, always combine this with a query
+ if the display supports GL drawing at all."
+
%{ /* NOCONTEXT */
#ifdef GLX
@@ -1031,7 +1056,10 @@
!
supportsZBuffer
- "return true, if this gl workstation has z buffer support"
+ "return true, if this gl workstation has z buffer support.
+ For portable applications, always combine this with a query
+ if the display supports GL drawing at all."
+
%{ /* NOCONTEXT */
#ifdef GLX
@@ -1068,11 +1096,7 @@
!GLXWorkstation methodsFor:'window creation'!
createGLXWindowFor:aView left:xpos top:ypos width:wwidth height:wheight type:glxType
- |ext minWidth minHeight maxWidth maxHeight
- bWidth bColor viewBg viewBgId wsuperView wsuperViewId wcreateOnTop
- winputOnly wlabel wcursor wcursorId wicon wiconId windowId
- weventMask wiconView wiconViewId bitGravity viewGravity vBgColor
- vBgForm deepForm|
+ |ext wsuperView wsuperViewId windowId|
wsuperView := aView superView.
wsuperView notNil ifTrue:[
@@ -3242,6 +3266,7 @@
!
glxBackface: b in: aGLXWindowId
+ "enable/disable backface culling"
%{ /* NOCONTEXT */
SETWIN(aGLXWindowId)
@@ -3820,6 +3845,18 @@
^ false
!
+glxDraw:v in: aGLXWindowId
+
+%{ /* NOCONTEXT */
+ float vec[3], *c_v;
+
+ if (! (c_v = getFloatsFromInto(v, vec, 3))) RETURN(false);
+ SETWIN(aGLXWindowId)
+ draw((Coord)(c_v[0]), (Coord)(c_v[1]), (Coord)(c_v[2]));
+ RETURN (true);
+%}
+!
+
glxDrawX: x y: y z: z in: aGLXWindowId
%{ /* NOCONTEXT */
@@ -3862,6 +3899,18 @@
%}
!
+glxDraw2:v in: aGLXWindowId
+
+%{ /* NOCONTEXT */
+ float vec[2], *c_v;
+
+ if (! (c_v = getFloatsFromInto(v, vec, 2))) RETURN(false);
+ SETWIN(aGLXWindowId)
+ draw2((Coord)(c_v[0]), (Coord)(c_v[1]));
+ RETURN (true);
+%}
+!
+
glxDraw2X: x y: y in: aGLXWindowId
%{ /* NOCONTEXT */
@@ -4849,6 +4898,18 @@
^ false
!
+glxMove:v in: aGLXWindowId
+
+%{ /* NOCONTEXT */
+ float vec[3], *c_v;
+
+ if (! (c_v = getFloatsFromInto(v, vec, 3))) RETURN(false);
+ SETWIN(aGLXWindowId)
+ move((Coord)(c_v[0]), (Coord)(c_v[1]), (Coord)(c_v[2]));
+ RETURN (true);
+%}
+!
+
glxMoveX: x y: y z: z in: aGLXWindowId
%{ /* NOCONTEXT */
@@ -4891,6 +4952,18 @@
%}
!
+glxMove2:v in: aGLXWindowId
+
+%{ /* NOCONTEXT */
+ float vec[2], *c_v;
+
+ if (! (c_v = getFloatsFromInto(v, vec, 2))) RETURN(false);
+ SETWIN(aGLXWindowId)
+ move2((Coord)(c_v[0]), (Coord)(c_v[1]));
+ RETURN (true);
+%}
+!
+
glxMove2X: x y: y in: aGLXWindowId
%{ /* NOCONTEXT */
@@ -5684,6 +5757,18 @@
%}
!
+glxRdr:v in: aGLXWindowId
+
+%{ /* NOCONTEXT */
+ float vec[3], *c_v;
+
+ if (! (c_v = getFloatsFromInto(v, vec, 3))) RETURN(false);
+ SETWIN(aGLXWindowId)
+ rdr((Coord)(c_v[0]), (Coord)(c_v[1]), (Coord)(c_v[2]));
+ RETURN (true);
+%}
+!
+
glxRdrX: x y: y z: z in: aGLXWindowId
%{ /* NOCONTEXT */
@@ -5726,6 +5811,18 @@
%}
!
+glxRdr2:v in: aGLXWindowId
+
+%{ /* NOCONTEXT */
+ float vec[2], *c_v;
+
+ if (! (c_v = getFloatsFromInto(v, vec, 2))) RETURN(false);
+ SETWIN(aGLXWindowId)
+ rdr2((Coord)(c_v[0]), (Coord)(c_v[1]));
+ RETURN (true);
+%}
+!
+
glxRdr2X: x y: y in: aGLXWindowId
%{ /* NOCONTEXT */
@@ -5915,6 +6012,18 @@
^ false
!
+glxRmv:v in: aGLXWindowId
+
+%{ /* NOCONTEXT */
+ float vec[3], *c_v;
+
+ if (! (c_v = getFloatsFromInto(v, vec, 3))) RETURN(false);
+ SETWIN(aGLXWindowId)
+ rmv((Coord)(c_v[0]), (Coord)(c_v[1]), (Coord)(c_v[2]));
+ RETURN (true);
+%}
+!
+
glxRmvX: x y: y z: z in: aGLXWindowId
%{ /* NOCONTEXT */
@@ -5957,6 +6066,18 @@
%}
!
+glxRmv2:v in: aGLXWindowId
+
+%{ /* NOCONTEXT */
+ float vec[2], *c_v;
+
+ if (! (c_v = getFloatsFromInto(v, vec, 2))) RETURN(false);
+ SETWIN(aGLXWindowId)
+ rmv2((Coord)(c_v[0]), (Coord)(c_v[1]));
+ RETURN (true);
+%}
+!
+
glxRmv2X: x y: y in: aGLXWindowId
%{ /* NOCONTEXT */
--- a/GraphAttr.st Mon Jul 03 02:35:52 1995 +0200
+++ b/GraphAttr.st Sun Jul 23 04:29:59 1995 +0200
@@ -25,7 +25,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/GraphAttr.st,v 1.2 1995-07-02 16:16:15 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/GraphAttr.st,v 1.3 1995-07-23 02:27:20 claus Exp $
'!
!GraphicsAttributes class methodsFor:'documentation'!
@@ -46,7 +46,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/GraphAttr.st,v 1.2 1995-07-02 16:16:15 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/GraphAttr.st,v 1.3 1995-07-23 02:27:20 claus Exp $
"
!
@@ -54,6 +54,8 @@
"
instances keep multiple graphics attributes as used in a graphicsContext.
They can be used when multiple attributes are to be set.
+ This class is (currently) not used by the system, but has been added
+ to make porting of existing ST-80 applications easier.
Instance variables:
--- a/GraphicsAttributes.st Mon Jul 03 02:35:52 1995 +0200
+++ b/GraphicsAttributes.st Sun Jul 23 04:29:59 1995 +0200
@@ -25,7 +25,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/GraphicsAttributes.st,v 1.2 1995-07-02 16:16:15 claus Exp $
+$Header: /cvs/stx/stx/libview/GraphicsAttributes.st,v 1.3 1995-07-23 02:27:20 claus Exp $
'!
!GraphicsAttributes class methodsFor:'documentation'!
@@ -46,7 +46,7 @@
version
"
-$Header: /cvs/stx/stx/libview/GraphicsAttributes.st,v 1.2 1995-07-02 16:16:15 claus Exp $
+$Header: /cvs/stx/stx/libview/GraphicsAttributes.st,v 1.3 1995-07-23 02:27:20 claus Exp $
"
!
@@ -54,6 +54,8 @@
"
instances keep multiple graphics attributes as used in a graphicsContext.
They can be used when multiple attributes are to be set.
+ This class is (currently) not used by the system, but has been added
+ to make porting of existing ST-80 applications easier.
Instance variables:
--- a/GraphicsContext.st Mon Jul 03 02:35:52 1995 +0200
+++ b/GraphicsContext.st Sun Jul 23 04:29:59 1995 +0200
@@ -25,7 +25,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.16 1995-06-06 04:06:53 claus Exp $
+$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.17 1995-07-23 02:26:30 claus Exp $
'!
!GraphicsContext class methodsFor:'documentation'!
@@ -46,7 +46,7 @@
version
"
-$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.16 1995-06-06 04:06:53 claus Exp $
+$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.17 1995-07-23 02:26:30 claus Exp $
"
!
@@ -704,6 +704,12 @@
self displayOpaqueString:aString x:(aPoint x) y:(aPoint y)
!
+displayOpaqueString:aString from:start to:stop at:aPoint
+ "draw part of a string - drawing both fg and bg"
+
+ ^ self displayOpaqueString:aString from:start to:stop x:aPoint x y:aPoint y
+!
+
displayString:aString x:x y:y
"draw a string - drawing fg only"
@@ -716,6 +722,12 @@
self displayString:aString x:aPoint x y:aPoint y
!
+displayString:aString from:start to:stop at:aPoint
+ "draw part of a string - drawing fg only"
+
+ ^ self displayString:aString from:start to:stop x:aPoint x y:aPoint y
+!
+
displayPointX:x y:y
"draw a point at x/y"
--- a/Image.st Mon Jul 03 02:35:52 1995 +0200
+++ b/Image.st Sun Jul 23 04:29:59 1995 +0200
@@ -28,7 +28,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Image.st,v 1.34 1995-07-02 16:16:20 claus Exp $
+$Header: /cvs/stx/stx/libview/Image.st,v 1.35 1995-07-23 02:27:30 claus Exp $
'!
!Image class methodsFor:'documentation'!
@@ -49,7 +49,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Image.st,v 1.34 1995-07-02 16:16:20 claus Exp $
+$Header: /cvs/stx/stx/libview/Image.st,v 1.35 1995-07-23 02:27:30 claus Exp $
"
!
@@ -652,6 +652,15 @@
^ ImageInspectorView
! !
+!Image methodsFor:'displaying'!
+
+displayOn:aGC at:aPoint
+ "draw in aGC.
+ Smalltalk-80 compatibility"
+
+ aGC displayForm:self x:aPoint x y:aPoint y.
+! !
+
!Image methodsFor:'accessing'!
device
--- a/Make.proto Mon Jul 03 02:35:52 1995 +0200
+++ b/Make.proto Sun Jul 23 04:29:59 1995 +0200
@@ -1,4 +1,4 @@
-# $Header: /cvs/stx/stx/libview/Make.proto,v 1.34 1995-07-02 16:18:17 claus Exp $
+# $Header: /cvs/stx/stx/libview/Make.proto,v 1.35 1995-07-23 02:29:48 claus Exp $
#
# -------------- no need to change anything below ----------
@@ -151,7 +151,11 @@
-rm -f *.c *.H
clean::
- -rm -f *.c *.H classList.stc abbrev.stc
+ -mv XWorkstat.o __XWorkstat.o
+ -mv GLXWorkstat.o __GLXWorkstat.o
+ -rm -f [A-Z]*.o *.c *.H classList.stc abbrev.stc
+ -mv __XWorkstat.o XWorkstat.o
+ -mv __GLXWorkstat.o GLXWorkstat.o
clobber::
-rm -f *.c *.H classList.stc abbrev.stc
--- a/ModalBox.st Mon Jul 03 02:35:52 1995 +0200
+++ b/ModalBox.st Sun Jul 23 04:29:59 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.25 1995-06-06 04:07:35 claus Exp $
+$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.26 1995-07-23 02:27:44 claus Exp $
'!
!ModalBox class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.25 1995-06-06 04:07:35 claus Exp $
+$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.26 1995-07-23 02:27:44 claus Exp $
"
!
@@ -203,7 +203,7 @@
]
!
-createOnTop
+isPopUpView
^ UseTransientViews not
!
@@ -632,7 +632,17 @@
"this is the close from a windowmanager
(only if UseTransientViews == true)"
- self hide
+ "
+ if I am a dialog, make the receiver invisible and leave control.
+ But, do not destroy the underlying view resources, to allow for
+ another open/show to occur later.
+ if I have been opened modeLess, perform the normal destroy operation.
+ "
+ windowGroup isModal ifTrue:[
+ self hide
+ ] ifFalse:[
+ super terminate
+ ]
!
visibilityChange:how
@@ -660,7 +670,7 @@
if the other view is not a modal- (or shadow-, or popup-) -view,
bring myself to the front again.
"
- aView createOnTop ifFalse:[
+ aView isPopUpView ifFalse:[
"
if I have a mainGroup,
only raise if its one of my maingroup-views
--- a/NXWorkst.st Mon Jul 03 02:35:52 1995 +0200
+++ b/NXWorkst.st Sun Jul 23 04:29:59 1995 +0200
@@ -30,7 +30,7 @@
All non-monochrome stuff is untested (I only have a monochroome station)
-$Header: /cvs/stx/stx/libview/Attic/NXWorkst.st,v 1.10 1995-06-06 04:07:40 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/NXWorkst.st,v 1.11 1995-07-23 02:27:49 claus Exp $
written spring 92 by claus
'!
@@ -285,9 +285,9 @@
createWindowFor:aView left:xpos top:ypos width:wwidth height:wheight
|ext minWidth minHeight maxWidth maxHeight
- bWidth bColor viewBg viewBgId wsuperView wsuperViewId wcreateOnTop
- winputOnly wlabel wcursor wcursorId wicon wiconId windowId
- weventMask wiconView wiconViewId bitGravity viewGravity
+ bWidth bColor viewBg viewBgId wsuperView wsuperViewId
+ wlabel wcursor wcursorId wicon wiconId windowId
+ wiconView wiconViewId
drawableId|
wsuperView := aView superView.
--- a/NeXTWorkstation.st Mon Jul 03 02:35:52 1995 +0200
+++ b/NeXTWorkstation.st Sun Jul 23 04:29:59 1995 +0200
@@ -30,7 +30,7 @@
All non-monochrome stuff is untested (I only have a monochroome station)
-$Header: /cvs/stx/stx/libview/NeXTWorkstation.st,v 1.10 1995-06-06 04:07:40 claus Exp $
+$Header: /cvs/stx/stx/libview/NeXTWorkstation.st,v 1.11 1995-07-23 02:27:49 claus Exp $
written spring 92 by claus
'!
@@ -285,9 +285,9 @@
createWindowFor:aView left:xpos top:ypos width:wwidth height:wheight
|ext minWidth minHeight maxWidth maxHeight
- bWidth bColor viewBg viewBgId wsuperView wsuperViewId wcreateOnTop
- winputOnly wlabel wcursor wcursorId wicon wiconId windowId
- weventMask wiconView wiconViewId bitGravity viewGravity
+ bWidth bColor viewBg viewBgId wsuperView wsuperViewId
+ wlabel wcursor wcursorId wicon wiconId windowId
+ wiconView wiconViewId
drawableId|
wsuperView := aView superView.
--- a/PopUpView.st Mon Jul 03 02:35:52 1995 +0200
+++ b/PopUpView.st Sun Jul 23 04:29:59 1995 +0200
@@ -11,7 +11,7 @@
"
TopView subclass:#PopUpView
- instanceVariableNames:'shadowView haveControl'
+ instanceVariableNames:'shadowView haveControl exclusivePointer'
classVariableNames:'DefaultShadow DefaultLevel DefaultBorderWidth
DefaultBorderColor'
poolDictionaries:''
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/PopUpView.st,v 1.14 1995-06-06 04:08:00 claus Exp $
+$Header: /cvs/stx/stx/libview/PopUpView.st,v 1.15 1995-07-23 02:28:02 claus Exp $
'!
!PopUpView class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libview/PopUpView.st,v 1.14 1995-06-06 04:08:00 claus Exp $
+$Header: /cvs/stx/stx/libview/PopUpView.st,v 1.15 1995-07-23 02:28:02 claus Exp $
"
!
@@ -98,6 +98,7 @@
initialize
super initialize.
+ exclusivePointer := true.
haveControl := false.
type := #popup
!
@@ -237,9 +238,12 @@
try again and unrealize myself if that fails too."
super mapped.
- haveControl ifTrue:[
+ (haveControl
+ and:[exclusivePointer
+ and:[realized]]) ifTrue:[
(device grabPointerInView:self) ifFalse:[
"wait a little bit and try again"
+"/ 'grab pointer failed' errorPrintNL.
(Delay forSeconds:0.1) wait.
(device grabPointerInView:self) ifFalse:[
"give up"
@@ -274,6 +278,12 @@
shadowView := nil
!
-createOnTop
+exclusivePointer:aBoolean
+ exclusivePointer := aBoolean
+! !
+
+!PopUpView methodsFor:'queries'!
+
+isPopUpView
^ true
! !
--- a/ShadowV.st Mon Jul 03 02:35:52 1995 +0200
+++ b/ShadowV.st Sun Jul 23 04:29:59 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/ShadowV.st,v 1.10 1995-05-03 00:25:18 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/ShadowV.st,v 1.11 1995-07-23 02:28:15 claus Exp $
'!
!ShadowView class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/ShadowV.st,v 1.10 1995-05-03 00:25:18 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/ShadowV.st,v 1.11 1995-07-23 02:28:15 claus Exp $
"
!
@@ -210,6 +210,6 @@
myView := aView
!
-createOnTop
+isPopUpView
^ true
! !
--- a/ShadowView.st Mon Jul 03 02:35:52 1995 +0200
+++ b/ShadowView.st Sun Jul 23 04:29:59 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/ShadowView.st,v 1.10 1995-05-03 00:25:18 claus Exp $
+$Header: /cvs/stx/stx/libview/ShadowView.st,v 1.11 1995-07-23 02:28:15 claus Exp $
'!
!ShadowView class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/ShadowView.st,v 1.10 1995-05-03 00:25:18 claus Exp $
+$Header: /cvs/stx/stx/libview/ShadowView.st,v 1.11 1995-07-23 02:28:15 claus Exp $
"
!
@@ -210,6 +210,6 @@
myView := aView
!
-createOnTop
+isPopUpView
^ true
! !
--- a/SimpleView.st Mon Jul 03 02:35:52 1995 +0200
+++ b/SimpleView.st Sun Jul 23 04:29:59 1995 +0200
@@ -44,7 +44,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.11 1995-07-02 16:17:13 claus Exp $
+$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.12 1995-07-23 02:28:23 claus Exp $
'!
!SimpleView class methodsFor:'documentation'!
@@ -65,7 +65,7 @@
version
"
-$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.11 1995-07-02 16:17:13 claus Exp $
+$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.12 1995-07-23 02:28:23 claus Exp $
"
!
@@ -1136,7 +1136,7 @@
^ false
!
-createOnTop
+isPopUpView
"return true, if this view should be put on top (raised) automatically.
usually this is true for alertBoxes etc."
@@ -1718,16 +1718,6 @@
^ self
!
-terminate
- "window manager wants me to go away;
- - notice, that not all window managers are nice enough to
- send this event, but simply destroy the view instead.
- Can be redefined in subclasses to do whatever cleanup is
- required."
-
- ^ self destroy
-!
-
keyPress:key x:x y:y
"a key has been pressed. If there are components,
pass it to the corresponding one.
@@ -1869,6 +1859,16 @@
super destroyed
!
+terminate
+ "window manager wants me to go away;
+ - notice, that not all window managers are nice enough to
+ send this event, but simply destroy the view instead.
+ Can be redefined in subclasses to do whatever cleanup is
+ required."
+
+ ^ self destroy
+!
+
saveAndTerminate
"window manager wants me to save and go away;
- notice, that not all window managers are nice enough to
@@ -2361,6 +2361,16 @@
^ layout
!
+geometryLayout
+ "this method will vanish, as soon as all implementations of
+ #layout: are removed ...
+ (conflict for example in label>>layout:).
+ DO NOT USE #geometryLayout: in your code; it will be removed without
+ notice."
+
+ ^ here layout
+!
+
geometryLayout:aLayoutObject
"this method will vanish, as soon as all implementations of
#layout: are removed ...
@@ -2686,23 +2696,6 @@
self corner:corner
!
-rightInset:aNumber
- "set the inset of the right edge; positive is to the left,
- negative to the right"
-
- insets isNil ifTrue:[
- insets := Array new:4 withAll:0.
- ].
- insets at:3 put:aNumber.
-
- "force recomputation"
- drawableId isNil ifTrue:[
- originChanged := true
- ] ifFalse:[
- self superViewChangedSize
- ]
-!
-
relativeCorner
"return the relative corner or nil"
@@ -2728,9 +2721,22 @@
].
!
+width:aNumber
+ "set the views width in pixels"
+
+ self extent:(aNumber @ height)
+!
+
+inset:aNumber
+ "set all insets; positive makes the view smaller,
+ negative makes it larger."
+
+ self allInset:aNumber
+!
+
allInset:aNumber
- "set the inset of the left edge; positive is to the right,
- negative to the left"
+ "set all insets; positive makes the view smaller,
+ negative makes it larger."
insets isNil ifTrue:[
insets := Array new:4.
@@ -2745,9 +2751,64 @@
]
!
+horizontalInset:aNumber
+ "set the insets of the left/right edge;
+ positive makes it smaller, negative makes it larger"
+
+ insets isNil ifTrue:[
+ insets := Array new:4 withAll:0.
+ ].
+ insets at:1 put:aNumber.
+ insets at:3 put:aNumber.
+
+ "force recomputation"
+ drawableId isNil ifTrue:[
+ originChanged := true
+ ] ifFalse:[
+ self superViewChangedSize
+ ]
+!
+
+verticalInset:aNumber
+ "set the insets of the top/bottom edge;
+ positive makes it smaller, negative makes it larger"
+
+ insets isNil ifTrue:[
+ insets := Array new:4 withAll:0.
+ ].
+ insets at:2 put:aNumber.
+ insets at:4 put:aNumber.
+
+ "force recomputation"
+ drawableId isNil ifTrue:[
+ originChanged := true
+ ] ifFalse:[
+ self superViewChangedSize
+ ]
+!
+
+rightInset:aNumber
+ "set the inset of the right edge;
+ positive is to the left (view becomes smaller),
+ negative to the right (becomes larger)"
+
+ insets isNil ifTrue:[
+ insets := Array new:4 withAll:0.
+ ].
+ insets at:3 put:aNumber.
+
+ "force recomputation"
+ drawableId isNil ifTrue:[
+ originChanged := true
+ ] ifFalse:[
+ self superViewChangedSize
+ ]
+!
+
leftInset:aNumber
- "set the inset of the left edge; positive is to the right,
- negative to the left"
+ "set the inset of the left edge;
+ positive is to the right (view becomes smaller),
+ negative to the left (becomes larger)"
insets isNil ifTrue:[
insets := Array new:4 withAll:0.
@@ -2762,15 +2823,10 @@
]
!
-width:aNumber
- "set the views width in pixels"
-
- self extent:(aNumber @ height)
-!
-
topInset:aNumber
- "set the inset of the top edge; positive is to the bottom,
- negative to the top"
+ "set the inset of the top edge;
+ positive is to the bottom (view becomes smaller),
+ negative to the top (becomes larger)"
insets isNil ifTrue:[
insets := Array new:4 withAll:0.
@@ -2785,29 +2841,30 @@
]
!
+bottomInset:aNumber
+ "set the inset of the bottom edge;
+ positive is to the top (view becomes smaller),
+ negative to the bottom (becomes larger)"
+
+ insets isNil ifTrue:[
+ insets := Array new:4 withAll:0.
+ ].
+ insets at:4 put:aNumber.
+
+ "force recomputation"
+ drawableId isNil ifTrue:[
+ originChanged := true
+ ] ifFalse:[
+ self superViewChangedSize
+ ]
+!
+
left:aNumber
"set the x position"
self origin:(aNumber @ top)
!
-bottomInset:aNumber
- "set the inset of the bottom edge; positive is to the top,
- negative to the bottom"
-
- insets isNil ifTrue:[
- insets := Array new:4 withAll:0.
- ].
- insets at:4 put:aNumber.
-
- "force recomputation"
- drawableId isNil ifTrue:[
- originChanged := true
- ] ifFalse:[
- self superViewChangedSize
- ]
-!
-
relativeOrigin
"return the relative origin or nil"
@@ -2970,23 +3027,6 @@
^ left + width - 1
!
-inset:aNumber
- "set all insets; positive makes the view smaller,
- negative makes it larger."
-
- insets isNil ifTrue:[
- insets := Array new:4.
- ].
- insets atAllPut:aNumber.
-
- "force recomputation"
- drawableId isNil ifTrue:[
- originChanged := true
- ] ifFalse:[
- self superViewChangedSize
- ]
-!
-
bottom
"return the y position of the actual bottom border (in pixels)"
@@ -3138,7 +3178,7 @@
maxExtent:nil
borderWidth:borderWidth
subViewOf:superView
- onTop:(self createOnTop)
+ onTop:(self isPopUpView)
inputOnly:(self inputOnly)
label:nil
cursor:cursor
@@ -3352,10 +3392,10 @@
"
].
- controller notNil ifTrue:[
- controller release.
- controller := nil.
- ].
+"/ controller notNil ifTrue:[
+"/ controller release.
+"/ controller := nil.
+"/ ].
subs := subViews.
subs notNil ifTrue:[
@@ -3373,12 +3413,35 @@
].
super destroy.
+ controller notNil ifTrue:[
+ controller release.
+ controller := nil.
+ ].
+
windowGroup notNil ifTrue:[
windowGroup removeView:self.
windowGroup := nil
].
!
+rerealizeInGroup:aWindowGroup
+ "rerealize at old position in (a possibly different) windowGroup."
+
+ drawableId isNil ifTrue:[
+ self create
+ ].
+ drawableId notNil ifTrue:[
+ aWindowGroup ~~ windowGroup ifTrue:[
+ windowGroup notNil ifTrue:[
+ windowGroup removeView:self
+ ].
+ windowGroup := aWindowGroup.
+ aWindowGroup addTopView:self.
+ ].
+ self rerealize.
+ ]
+!
+
rerealize
"rerealize at old position"
@@ -3487,8 +3550,11 @@
windowGroup isNil ifTrue:[
windowGroup := WindowGroup new.
windowGroup addTopView:self.
+ windowGroup startup:false.
+ ] ifFalse:[
+ windowGroup startup:false.
+ self realizeInGroup.
].
- windowGroup startup:false.
] ifTrue:[
self realize
]
@@ -3596,6 +3662,39 @@
]
!
+waitUntilVisible
+ "wait until the receiver visible.
+ In normal applications, you do not need to wait till a view is
+ open - it should do all of its drawing itself when it gets the
+ first expose event.
+ However, if you want to 'manually' draw into the view (for example,
+ in doIt expressions), or subsequent views depend on some state of
+ another view (which is only available once visible),
+ use this to suspend the current process until the receiver is shown."
+
+ Processor activeProcess withPriority:1 do:[
+ [self shown] whileFalse:[
+ Processor yield
+ ]
+ ].
+
+ "does not work:
+
+ |v|
+
+ v := View new open.
+ v displayLineFrom:0@0 to:50@50
+
+ does work:
+
+ |v|
+
+ v := View new open.
+ v waitUntilVisible.
+ v displayLineFrom:0@0 to:50@50
+ "
+!
+
openAndWait
"open up the view - wait until it is visible.
In normal applications, you do not need to wait till the view is
@@ -3606,11 +3705,7 @@
Use this open in those situations."
self open.
- Processor activeProcess withPriority:1 do:[
- [self shown] whileFalse:[
- Processor yield
- ]
- ].
+ self waitUntilVisible.
"does not work:
--- a/StandardSystemView.st Mon Jul 03 02:35:52 1995 +0200
+++ b/StandardSystemView.st Sun Jul 23 04:29:59 1995 +0200
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.29 1995-06-27 02:20:14 claus Exp $
+$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.30 1995-07-23 02:28:37 claus Exp $
'!
!StandardSystemView class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.29 1995-06-27 02:20:14 claus Exp $
+$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.30 1995-07-23 02:28:37 claus Exp $
"
!
@@ -368,7 +368,9 @@
terminate
"terminate request from the windowManager. If there is an application,
let it decide if it really wants to be close. Otherwise, forward it to
- superclasses terminate which knows how to do this."
+ superclasses terminate which knows how to do this.
+ Notice, that not all windowmanagers are nice enough
+ to send this request; some simply distroy the view."
application notNil ifTrue:[
application closeRequest
@@ -382,7 +384,9 @@
save its data/files/text etc. somehow and close.
If there is an application, let it decide how do do that.
Otherwise, forward it to superclasses which knows how to do this.
- (it defaults to a terminate there)"
+ (it defaults to a terminate there).
+ Notice, that not all windowmanagers are nice enough
+ to send this request; some simply distroy the view."
application notNil ifTrue:[
application saveAndTerminateRequest
@@ -398,7 +402,16 @@
windowGroup notNil ifTrue:[
windowGroup focusSequence:nil.
].
+ application notNil ifTrue:[
+ application windowEvent:(#close -> self) from:self
+ ].
super destroy.
+!
+
+closeRequest
+ "programmatic close request"
+
+ ^ self terminate
! !
!StandardSystemView methodsFor:'private'!
@@ -445,7 +458,7 @@
maxExtent:maxExtent
borderWidth:borderWidth
subViewOf:nil
- onTop:(self createOnTop)
+ onTop:(self isPopUpView)
inputOnly:(self inputOnly)
label:label
cursor:cursor
--- a/StdSysV.st Mon Jul 03 02:35:52 1995 +0200
+++ b/StdSysV.st Sun Jul 23 04:29:59 1995 +0200
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/StdSysV.st,v 1.29 1995-06-27 02:20:14 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/StdSysV.st,v 1.30 1995-07-23 02:28:37 claus Exp $
'!
!StandardSystemView class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/StdSysV.st,v 1.29 1995-06-27 02:20:14 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/StdSysV.st,v 1.30 1995-07-23 02:28:37 claus Exp $
"
!
@@ -368,7 +368,9 @@
terminate
"terminate request from the windowManager. If there is an application,
let it decide if it really wants to be close. Otherwise, forward it to
- superclasses terminate which knows how to do this."
+ superclasses terminate which knows how to do this.
+ Notice, that not all windowmanagers are nice enough
+ to send this request; some simply distroy the view."
application notNil ifTrue:[
application closeRequest
@@ -382,7 +384,9 @@
save its data/files/text etc. somehow and close.
If there is an application, let it decide how do do that.
Otherwise, forward it to superclasses which knows how to do this.
- (it defaults to a terminate there)"
+ (it defaults to a terminate there).
+ Notice, that not all windowmanagers are nice enough
+ to send this request; some simply distroy the view."
application notNil ifTrue:[
application saveAndTerminateRequest
@@ -398,7 +402,16 @@
windowGroup notNil ifTrue:[
windowGroup focusSequence:nil.
].
+ application notNil ifTrue:[
+ application windowEvent:(#close -> self) from:self
+ ].
super destroy.
+!
+
+closeRequest
+ "programmatic close request"
+
+ ^ self terminate
! !
!StandardSystemView methodsFor:'private'!
@@ -445,7 +458,7 @@
maxExtent:maxExtent
borderWidth:borderWidth
subViewOf:nil
- onTop:(self createOnTop)
+ onTop:(self isPopUpView)
inputOnly:(self inputOnly)
label:label
cursor:cursor
--- a/TopView.st Mon Jul 03 02:35:52 1995 +0200
+++ b/TopView.st Sun Jul 23 04:29:59 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1995 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/TopView.st,v 1.4 1995-06-27 02:20:25 claus Exp $
+$Header: /cvs/stx/stx/libview/TopView.st,v 1.5 1995-07-23 02:28:44 claus Exp $
'!
!TopView class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/TopView.st,v 1.4 1995-06-27 02:20:25 claus Exp $
+$Header: /cvs/stx/stx/libview/TopView.st,v 1.5 1995-07-23 02:28:44 claus Exp $
"
!
@@ -77,6 +77,63 @@
type := #normal
! !
+!TopView methodsFor:'window events'!
+
+destroy
+ "the receiver is to be destroyed - look for partners and slaves"
+
+ |wg|
+
+ wg := windowGroup. "/ have to fetch windowGroup before;
+ super destroy. "/ since destroy nils it
+ wg notNil ifTrue:[
+ "/
+ "/ if I am a master or partner, close all slaves
+ "/
+ (type == #master or:[type == #partner]) ifTrue:[
+ wg slavesDo:[:v | v destroy].
+ ].
+ "/
+ "/ if I am a partner, close all partners
+ "/
+ type == #partner ifTrue:[
+ wg partnersDo:[:v | v ~~ self ifTrue:[v destroy]].
+ ].
+ ].
+!
+
+mapped
+ "the recevier was mapped (i.e. deiconified or just created);
+ look for partners and slaves."
+
+ realized := true.
+ super mapped.
+ windowGroup notNil ifTrue:[
+ (type == #master or:[type == #partner]) ifTrue:[
+ windowGroup slavesDo:[:v | v rerealize].
+ ].
+ type == #partner ifTrue:[
+ windowGroup partnersDo:[:v | v ~~ self ifTrue:[v rerealize]].
+ ]
+ ].
+!
+
+unmapped
+ "the recevier was unmapped (i.e. iconified);
+ look for partners and slaves."
+
+ super unmapped.
+ windowGroup notNil ifTrue:[
+ (type == #master or:[type == #partner]) ifTrue:[
+ windowGroup slavesDo:[:v | v unrealize].
+ ].
+ type == #partner ifTrue:[
+ windowGroup partnersDo:[:v | v ~~ self ifTrue:[v unrealize]].
+ ].
+ ].
+
+! !
+
!TopView methodsFor:'misc'!
withWaitCursorDo:aBlock
@@ -118,14 +175,49 @@
self extent:anExtent; sizeFixed:true.
self open
+!
+
+openInGroup:aGroup
+ "special open within another windowGroup.
+ This allows a view to be realized in any windowgroup;
+ for applications where multiple views act as a group
+ (i.e. close and iconify together)."
+
+ self windowGroup:aGroup.
+ aGroup addTopView:self.
+ self realizeLeavingGroup:true
! !
!TopView methodsFor:'accessing & queries'!
type
+ "return the views type. This is one of #normal,
+ #master, #slave or #partner."
+
^ type
!
+beMaster
+ "make this a master-view. All slave views within the same
+ windowGroup will be closed if any master is closed."
+
+ type := #master
+!
+
+beSlave
+ "make this a slave-view. It will be closed automatically,
+ whenever any master of the group is closed."
+
+ type := #slave
+!
+
+bePartner
+ "make this a partner-view. Each partner-view will automatically
+ close other partner views whenclosed."
+
+ type := #partner
+!
+
preferredExtent
"return my preferred extent - this is the minimum size I would like to have.
The default here is the classes default extent,
--- a/WGroup.st Mon Jul 03 02:35:52 1995 +0200
+++ b/WGroup.st Sun Jul 23 04:29:59 1995 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/WGroup.st,v 1.27 1995-06-06 04:10:15 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/WGroup.st,v 1.28 1995-07-23 02:29:01 claus Exp $
'!
!WindowGroup class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/WGroup.st,v 1.27 1995-06-06 04:10:15 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/WGroup.st,v 1.28 1995-07-23 02:29:01 claus Exp $
"
!
@@ -300,18 +300,50 @@
!WindowGroup methodsFor:'enumerating'!
allViewsDo:aBlock
- "evaluate aBlock for all views & topviews in this group"
+ "evaluate aBlock for all views & topviews in this group.
+ This works on a copy of the view collection, to allow for
+ destroy and other collection changeing operations to be done."
- topViews notNil ifTrue:[topViews do:aBlock].
- views notNil ifTrue:[views do:aBlock]
+ topViews notNil ifTrue:[topViews copy do:aBlock].
+ views notNil ifTrue:[views copy do:aBlock]
!
allTopViewsExcept:aView do:aBlock
- "evaluate aBlock for all topviews except aView in this group"
+ "evaluate aBlock for all topviews except aView in this group.
+ This works on a copy of the view collection, to allow for
+ destroy and other collection changeing operations to be done."
+
+ topViews notNil ifTrue:[
+ topViews copy do:[:v |
+ v ~~ aView ifTrue:[aBlock value:v]
+ ]
+ ].
+!
+
+slavesDo:aBlock
+ "evaluate aBlock for all slaveViews.
+ This works on a copy of the view collection, to allow for
+ destroy and other collection changeing operations to be done."
topViews notNil ifTrue:[
- topViews do:[:v |
- v ~~ aView ifTrue:[aBlock value:v]
+ topViews copy do:[:v |
+ v notNil ifTrue:[
+ v type == #slave ifTrue:[aBlock value:v].
+ ]
+ ]
+ ].
+!
+
+partnersDo:aBlock
+ "evaluate aBlock for all partnerViews.
+ This works on a copy of the view collection, to allow for
+ destroy and other collection changeing operations to be done."
+
+ topViews notNil ifTrue:[
+ topViews copy do:[:v |
+ v notNil ifTrue:[
+ v type == #partner ifTrue:[aBlock value:v].
+ ]
]
].
! !
@@ -781,7 +813,7 @@
|index|
- focusSequence isNil ifTrue:[^ self].
+ focusSequence size == 0 ifTrue:[^ self].
focusView notNil ifTrue:[
index := (focusSequence indexOf:focusView) + 1.
index > focusSequence size ifTrue:[index := 1].
@@ -809,7 +841,7 @@
|index|
- focusSequence isNil ifTrue:[^ self].
+ focusSequence size == 0 ifTrue:[^ self].
focusView notNil ifTrue:[
index := (focusSequence indexOf:focusView) - 1.
index < 1 ifTrue:[index := focusSequence size].
--- a/WSensor.st Mon Jul 03 02:35:52 1995 +0200
+++ b/WSensor.st Sun Jul 23 04:29:59 1995 +0200
@@ -16,8 +16,10 @@
instanceVariableNames:'eventSemaphore damage mouseAndKeyboard compressMotionEvents
ignoreUserInput exposeEventSemaphore catchExpose
gotExpose gotOtherEvent translateKeyboardEvents shiftDown
- ctrlDown metaDown altDown eventListener keyboardListener'
- classVariableNames:'ControlCEnabled EventListener'
+ ctrlDown metaDown altDown
+ leftButtonDown middleButtonDown rightButtonDown
+ eventListener keyboardListener'
+ classVariableNames:'ControlCEnabled EventListener ComposeTable GotCompose Compose1'
poolDictionaries:''
category:'Interface-Support'
!
@@ -26,7 +28,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/WSensor.st,v 1.27 1995-07-02 16:17:47 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/WSensor.st,v 1.28 1995-07-23 02:29:08 claus Exp $
'!
!WindowSensor class methodsFor:'documentation'!
@@ -47,7 +49,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/WSensor.st,v 1.27 1995-07-02 16:17:47 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/WSensor.st,v 1.28 1995-07-23 02:29:08 claus Exp $
"
!
@@ -59,13 +61,14 @@
gets a chance to handle them.
In contrast to ST-80 (which has one windowSensor per window), ST/X usually
only assigns one sensor per windowGroup.
- (however, you could manually arrange for per view private sensors - at least, theoretically)
+ (however, you could manually arrange for per view private sensors
+ - at least, theoretically)
When adding an expose rectangle, WindowSensor tries to merge the rectangle
with the list of existing damages to minimize redrawing.
Beside the above, windowSensors provide facilities (hooks) to allow
- a so-called 'eventListener' to get the events before it is enterred into
+ a so-called 'eventListener' to get the event before it is entered into
the queue. There are 3 possible listening hooks available:
a global EventListener - gets keybd/mouse events for all views
@@ -79,12 +82,14 @@
the WindowSensor class; local listeners are installed via instance methods.
Each listener should return true, if it handled the event and that event should
therefore NOT be enqueued. Likewise, if it returns false, the event is
- processed as usual.
+ processed as usual (i.e. enqueued and forwarded to the views controller).
+
The global listener is called before the local listener, which is called
before the keyboard listener. If any returns true, later listeners wont get
the event.
EventListeners were added to allow the implementation of event recorders
- or other spy functionality.
+ or other spy functionality. They also allow hooking up views which otherwise
+ insist on doing things themself.
Notice, that beside event listening, you can also define a delegate for
a views keyboard and button events.
@@ -168,6 +173,8 @@
This allows overall event catchers to be
installed for example to implement event
recorders, active help managers etc.
+
+ ComposeTable <Array> compose-key translation table
"
! !
@@ -175,6 +182,115 @@
initialize
ControlCEnabled := true.
+ ComposeTable := #(
+ "/ key1 key2 -> character or asciiValue
+ ($+ $+ $#) "/ number-sign
+ ($A $A $@) "/ at-sign
+
+ ($( $- ${) "/ left brace
+ ($) $- $}) "/ right brace
+
+ ($| $c 16rA2) "/ cent-sign
+ ($| $S $$) "/ dollar-sign
+ ($= $L 16rA3) "/ pound-sign
+ ($= $Y 16rA5) "/ yen-sign
+ ($!! $s 16rA7) "/ section-sign
+ ($O $C 16rA9) "/ copyright
+ ($< $< 16rAB) "/ french <<-quotes
+ ($O $R 16rAE) "/ registered
+ ($/ $u 16rB5) "/ greek mu
+ ($!! $p 16rB6) "/ paragraph sign
+ ($> $> 16rBB) "/ french >> quotes
+ ($^ $0 16rB0) "/ degree sign
+ ($+ $- 16rB1) "/ plus-minus
+ ($^ $2 16rB2) "/ superscript-2
+ ($^ $3 16rB3) "/ superscript-3
+ ($. $^ 16rB7) "/ middle dot
+ ($^ $1 16rB9) "/ superscript-1
+ ($1 $4 16rBC) "/ 1/4
+ ($1 $2 16rBD) "/ 1/2
+ ($3 $4 16rBE) "/ 3/4
+ ($? $? 16rBF) "/ ?-inverted
+ ($- $: 16rF7) "/ divide
+
+ "/ diacriticals: Compose diacrit character
+ "/ grave
+
+ ($A $` 16rC0) "/ A-`
+ ($a $` 16rE0) "/ a-`
+ ($E $` 16rC8) "/ E-`
+ ($e $` 16rE8) "/ e-`
+ ($I $` 16rCC) "/ I-`
+ ($i $` 16rEC) "/ i-`
+ ($O $` 16rD2) "/ O-`
+ ($o $` 16rF2) "/ o-`
+ ($U $` 16rD9) "/ U-`
+ ($u $` 16rF9) "/ u-`
+
+ "/ acute
+ ($A $' 16rC1) "/ A-'
+ ($a $' 16rE1) "/ a-'
+ ($E $' 16rC9) "/ E-'
+ ($e $' 16rE9) "/ e-'
+ ($I $' 16rCD) "/ I-'
+ ($i $' 16rED) "/ i-'
+ ($O $' 16rD3) "/ O-'
+ ($o $' 16rF3) "/ o-'
+ ($U $' 16rDA) "/ U-'
+ ($u $' 16rFA) "/ u-'
+ ($Y $' 16rDD) "/ Y-'
+ ($y $' 16rFD) "/ y-'
+
+ "/ circumflex
+ ($A $^ 16rC2) "/ A-^
+ ($a $^ 16rE2) "/ a-^
+ ($E $^ 16rCA) "/ E-^
+ ($e $^ 16rEA) "/ e-^
+ ($I $^ 16rCE) "/ I-^
+ ($i $^ 16rEE) "/ i-^
+ ($O $^ 16rD4) "/ O-^
+ ($o $^ 16rF4) "/ o-^
+ ($U $^ 16rDB) "/ U-^
+ ($u $^ 16rFB) "/ u-^
+
+ "/ tilde
+ ($A $~ 16rC3) "/ A-~
+ ($a $~ 16rE3) "/ a-~
+ ($O $~ 16rD5) "/ O-~
+ ($o $~ 16rF5) "/ o-~
+ ($N $~ 16rD1) "/ N-tilde
+ ($n $~ 16rF1) "/ n-~
+
+ "/ ring above
+ ($a $* 16rE5) "/ a-*
+ ($A $* 16rC5) "/ A-*
+
+ "/ cedille
+ ($C $, 16rC7) "/ C-,
+ ($c $, 16rE7) "/ c-,
+
+ "/ dieresis
+ ($A $" 16rC4) "/ A-"
+ ($a $" 16rE4) "/ a-"
+ ($E $" 16rCB) "/ E-"
+ ($e $" 16rEB) "/ e-"
+ ($I $" 16rCF) "/ I-"
+ ($i $" 16rEF) "/ i-"
+ ($O $" 16rD6) "/ O-"
+ ($o $" 16rF6) "/ o-"
+ ($U $" 16rDC) "/ U-"
+ ($u $" 16rFC) "/ u-"
+ ($y $" 16rFF) "/ y-"
+
+ "/ ligatures
+ ($s $s 16rDF) "/ german sz
+ ($a $e 16rE6) "/ (french) ae
+ ($A $E 16rC6) "/ (french) AE
+ ).
+
+ "
+ WindowSensor initialize
+ "
! !
!WindowSensor class methodsFor:'instance creation'!
@@ -208,13 +324,31 @@
- see documentation for what this can be used for"
^ EventListener
+!
+
+composeTable:aTable
+ "set the compose-key table.
+ Entries consist of 3-element arrays each, where
+ the first two entries (of each entry) are the raw characters,
+ and the third is the resulting composed-key"
+
+ ComposeTable := aTable
+!
+
+composeTable
+ "return the compose-key table.
+ Entries consist of 3-element arrays each, where
+ the first two entries (of each entry) are the raw characters,
+ and the third is the resulting composed-key"
+
+ ^ ComposeTable
! !
!WindowSensor class methodsFor:'queries'!
cursorPoint
"ST-80 compatibility:
- return the position of the cursor on the default display"
+ return the position of the cursor on the current display"
^ Screen current pointerPosition
@@ -223,23 +357,27 @@
"
! !
-!WindowSensor methodsFor:'event processing'!
-
-notifyEventArrival
- "an event arrived - if there is an eventSemaphore,
- signal it, to wake up any windowGroup process"
+!WindowSensor methodsFor:'private'!
- catchExpose == true ifTrue:[
- "
- dont wake up, if we are currently waiting for an expose
- but remember arrival of something.
- "
- gotOtherEvent := true.
- ^ self
+isModifierKey:key
+ (key == #Shift
+ or:[key == #'Shift_R'
+ or:[key == #'Shift_L']]) ifTrue:[
+ ^ true
+ ].
+ (key == #Alt
+ or:[key == #'Alt_R' or:[key == #'Alt_L']]) ifTrue:[
+ ^ true
].
- eventSemaphore notNil ifTrue:[
- eventSemaphore signal
- ]
+ (key == #Meta
+ or:[key == #'Meta_R' or:[key == #'Meta_L']]) ifTrue:[
+ ^ true
+ ].
+ (key == #Control
+ or:[key == #'Control_R' or:[key == #'Control_L']]) ifTrue:[
+ ^ true
+ ].
+ ^ false
!
key:key state:onOrOff
@@ -269,6 +407,64 @@
].
!
+compose:key1 with:key2
+ "compose a 2-character sequence into a composed key"
+
+ ComposeTable do:[:entry |
+ |v|
+
+ ((key1 == (entry at:1)) and:[key2 == (entry at:2)]) ifTrue:[
+ v := entry at:3.
+ v isCharacter ifFalse:[v := Character value:v].
+ ^ v
+ ]
+ ].
+ "/
+ "/ for illegal sequence, return 2nd key
+ "/
+"/ key1 print. ' ' print. key2 printNL.
+ ^ key2
+! !
+
+!WindowSensor methodsFor:'event processing'!
+
+notifyEventArrival
+ "an event arrived - if there is an eventSemaphore,
+ signal it, to wake up any windowGroup process"
+
+ catchExpose == true ifTrue:[
+ "
+ dont wake up, if we are currently waiting for an expose
+ but remember arrival of something.
+ "
+ gotOtherEvent := true.
+ ^ self
+ ].
+ eventSemaphore notNil ifTrue:[
+ eventSemaphore signal
+ ]
+!
+
+button:button inView:aView state:onOrOff
+ "update the state of the xxxButtonDown flags"
+
+ |physicalButton|
+
+ physicalButton := aView device buttonTranslation keyAtValue:button ifAbsent:button.
+ (physicalButton == 1) ifTrue:[
+ leftButtonDown := onOrOff.
+ ^ self
+ ].
+ (physicalButton == 2) ifTrue:[
+ middleButtonDown := onOrOff.
+ ^ self
+ ].
+ (physicalButton == 3) ifTrue:[
+ rightButtonDown := onOrOff.
+ ^ self
+ ].
+!
+
noExposeView:aView
"an noexpose event arrived - this is sent from the device (Display)"
@@ -347,6 +543,8 @@
buttonRelease:button x:x y:y view:aView
"mouse button was released- this is sent from the device (Display)"
+ self button:button inView:aView state:false.
+
EventListener notNil ifTrue:[
(EventListener buttonRelease:button x:x y:y view:aView) ifTrue:[^ self]
].
@@ -368,6 +566,8 @@
buttonPress:button x:x y:y view:aView
"mouse button was pressed - this is sent from the device (Display)"
+ self button:button inView:aView state:true.
+
EventListener notNil ifTrue:[
(EventListener buttonPress:button x:x y:y view:aView) ifTrue:[^ self]
].
@@ -474,15 +674,40 @@
] ifFalse:[
xlatedKey := key.
].
+
xlatedKey isNil ifTrue:[^ self].
- (xlatedKey == #CtrlV) ifTrue:[
+ (xlatedKey == #Compose) ifTrue:[
+ GotCompose := true. Compose1 := nil.
+ ^ self
+ ].
+ GotCompose == true ifTrue:[
+ Compose1 isNil ifTrue:[
+ (self isModifierKey:xlatedKey) ifFalse:[
+ Compose1 := xlatedKey.
+ ].
+ ^ self
+ ].
+ (self isModifierKey:xlatedKey) ifFalse:[
+ xlatedKey := self compose:Compose1 with:xlatedKey.
+ Compose1 := nil. GotCompose := false.
+ ]
+ ].
+
+ (xlatedKey == #CmdCtrlV) ifTrue:[
'Smalltalk/X ' errorPrint.
Smalltalk versionString errorPrint. ' of ' errorPrint.
Smalltalk versionDate errorPrintNL.
Smalltalk copyrightString errorPrintNL.
].
+ (xlatedKey == #DestroyView) ifTrue:[
+ aView closeRequest.
+ ].
+ (xlatedKey == #DestroyTopView) ifTrue:[
+ aView topView closeRequest.
+ ].
+
(xlatedKey == #FlushInput) ifTrue:[
"this removes any enqueued user events -
helps, if you pressed DoIt too often, and want to flush those
@@ -565,6 +790,8 @@
buttonShiftPress:button x:x y:y view:aView
"mouse button was pressed - this is sent from the device (Display)"
+ self button:button inView:aView state:true.
+
EventListener notNil ifTrue:[
(EventListener buttonShiftPress:button x:x y:y view:aView) ifTrue:[^ self]
].
@@ -882,19 +1109,53 @@
^ false
!
-hasButtonMotionEventsFor:aView
- "return true, if any buttonMotion events are pending"
+hasEvent:type orPendingDeviceEvent:dType for:aView
+ "return true, if a specific event is pending.
+ Type is the type of event, dType the corresponding device event.
+ If the argument, aView is nil, the information is regarding any
+ view (i.e. is there a motion event for any of my views);
+ otherwise, the information is regrding that specific view."
mouseAndKeyboard size ~~ 0 ifTrue:[
mouseAndKeyboard do:[:anEvent |
anEvent notNil ifTrue:[
- anEvent view == aView ifTrue:[
- anEvent type == #buttonMotion:x:y: ifTrue:[^ true].
+ (aView isNil or:[anEvent view == aView]) ifTrue:[
+ anEvent type == type ifTrue:[^ true].
]
].
]
].
- ^ aView device eventPending:#buttonMotion for:aView id
+ aView notNil ifTrue:[
+ ^ aView device eventPending:dType for:aView id
+ ].
+ ^ false
+!
+
+hasButtonMotionEventsFor:aView
+ "return true, if any buttonMotion events are pending.
+ If the argument, aView is nil, the information is regarding any
+ view (i.e. is there a motion event for any of my views);
+ otherwise, the information is regrding that specific view."
+
+ ^ self hasEvent:#buttonMotion:x:y: orPendingDeviceEvent:#buttonMotion for:aView
+!
+
+hasButtonReleaseEventFor:aView
+ "return true, if any buttonRelease events are pending.
+ If the argument, aView is nil, the information is regarding any
+ view (i.e. is there a motion event for any of my views);
+ otherwise, the information is regrding that specific view."
+
+ ^ self hasEvent:#buttonRelease:x:y: orPendingDeviceEvent:#buttonRelease for:aView
+!
+
+hasButtonPressEventFor:aView
+ "return true, if any buttonPress events are pending.
+ If the argument, aView is nil, the information is regarding any
+ view (i.e. is there a motion event for any of my views);
+ otherwise, the information is regrding that specific view."
+
+ ^ self hasEvent:#buttonPress:x:y: orPendingDeviceEvent:#buttonPress for:aView
!
eventPending
@@ -906,7 +1167,16 @@
mousePoint
"ST-80 compatibility:
- return the position of the mouse pointer on the default display"
+ return the position of the mouse pointer on the current display
+ (in screen coordinates)"
+
+ ^ self class cursorPoint
+!
+
+cursorPoint
+ "ST-80 compatibility:
+ return the position of the mouse pointer on the current display
+ (in screen coordinates)"
^ self class cursorPoint
!
@@ -945,6 +1215,72 @@
it is better to use 'sensor metaDown or:[sensor altDown]'."
^ altDown
+!
+
+leftButtonPressed
+ "return true, if the left mouse button is pressed.
+ This has been added to support ST-80 style button polling;
+ however, you should no use it in 'normal' applications.
+ Instead, keep track of the buttons state in your views or controllers
+ button-event methods."
+
+ ^ leftButtonDown
+!
+
+middleButtonPressed
+ "return true, if the middle mouse button is pressed.
+ This has been added to support ST-80 style button polling;
+ however, you should no use it in 'normal' applications.
+ Instead, keep track of the buttons state in your views or controllers
+ button-event methods."
+
+ ^ middleButtonDown
+!
+
+rightButtonPressed
+ "return true, if the right mouse button is pressed.
+ This has been added to support ST-80 style button polling;
+ however, you should no use it in 'normal' applications.
+ Instead, keep track of the buttons state in your views or controllers
+ button-event methods."
+
+ ^ rightButtonDown
+!
+
+redButtonPressed
+ "ST-80 compatibility: return true, if the left mouse button is pressed.
+ You should no use it in 'normal' applications.
+ Instead, keep track of the buttons state in your views or controllers
+ button-event methods."
+
+ ^ leftButtonDown
+!
+
+yellowButtonPressed
+ "ST-80 compatibility: return true, if the middle mouse button is pressed.
+ You should no use it in 'normal' applications.
+ Instead, keep track of the buttons state in your views or controllers
+ button-event methods."
+
+ ^ middleButtonDown
+!
+
+blueButtonPressed
+ "ST-80 compatibility: return true, if the right mouse button is pressed.
+ You should no use it in 'normal' applications.
+ Instead, keep track of the buttons state in your views or controllers
+ button-event methods."
+
+ ^ rightButtonDown
+!
+
+anyButtonPressed
+ "ST-80 compatibility: return true, if any mouse button is pressed.
+ You should no use it in 'normal' applications.
+ Instead, keep track of the buttons state in your views or controllers
+ button-event methods."
+
+ ^ rightButtonDown or:[middleButtonDown or:[rightButtonDown]]
! !
!WindowSensor methodsFor:'special'!
@@ -961,7 +1297,10 @@
!
waitForExposeFor:aView
- "wait until a noExpose arrives (after a bitblt)"
+ "wait until a graphicsExpose or a noExpose arrives (after a bitblt).
+ This may be too X-specific, and things may change in this area
+ in future versions. (or the new device may simulate the arrival of
+ such an event)"
Processor activeProcessIsSystemProcess ifTrue:[
"
@@ -1010,6 +1349,43 @@
catchExpose := false
!
+waitButton
+ "ST-80 compatibility: wait until any mouse button is pressed.
+ Do not use this in your applications; polling the sensor is
+ bad style."
+
+ [self anyButtonPressed] whileFalse:[
+ (Delay forSeconds:0.01) wait.
+ ].
+
+"/ (leftButtonPressed
+"/ or:[middleButtonPressed
+"/ or:[rightButtonPressed]]) ifTrue:[^ self].
+"/
+"/ [self hasButtonPressEventFor:nil] whileFalse:[
+"/ (Delay forSeconds:0.01) wait.
+"/ ]
+!
+
+waitNoButton
+ "ST-80 compatibility: wait until no mouse button is pressed.
+ Do not use this in your applications; polling the sensor is
+ bad style."
+
+ [self anyButtonPressed] whileTrue:[
+ (Delay forSeconds:0.01) wait.
+ ].
+"/ (leftButtonPressed
+"/ or:[middleButtonPressed
+"/ or:[rightButtonPressed]]) ifFalse:[^ self].
+"/
+"/ [self hasButtonReleaseEventFor:nil] whileFalse:[
+"/ (Delay forSeconds:0.01) wait.
+"/ ]
+! !
+
+!WindowSensor methodsFor:'event flushing'!
+
flushUserEvents
"throw away all pending user events"
@@ -1019,18 +1395,22 @@
!
flushExposeEventsFor:aView
- "throw away all pending expose events for aView;
- this can be done after a full redraw
+ "throw away all pending expose events for aView,
+ or any view, if the argument is nil.
+ This can be done after a full redraw
(or in views, which are always doing full redraws -
instead of drawing the clip-area only)"
+ |nEvent "{ Class: SmallInteger }"|
+
damage notNil ifTrue:[
- 1 to:damage size do:[:index |
+ nEvent := damage size.
+ 1 to:nEvent do:[:index |
|aDamage|
aDamage := damage at:index.
aDamage notNil ifTrue:[
- aDamage view == aView ifTrue:[
+ (aView isNil or:[aDamage view == aView]) ifTrue:[
damage at:index put:nil
]
]
@@ -1039,15 +1419,40 @@
!
flushUserEventsFor:aView
- "throw away all pending user events for aView"
+ "throw away all pending user events for aView,
+ or any view, if the argument is nil."
+
+ |nEvent "{ Class: SmallInteger }"|
mouseAndKeyboard notNil ifTrue:[
- 1 to:mouseAndKeyboard size do:[:i |
+ nEvent := mouseAndKeyboard size.
+ 1 to:nEvent do:[:i |
|anEvent|
anEvent := mouseAndKeyboard at:i.
anEvent notNil ifTrue:[
- anEvent view == aView ifTrue:[
+ (aView isNil or:[anEvent view == aView]) ifTrue:[
+ mouseAndKeyboard at:i put:nil
+ ]
+ ]
+ ]
+ ].
+!
+
+flushKeyboardFor:aView
+ "throw away all pending keyboard events for aView,
+ or any view, if the argument is nil."
+
+ |nEvent "{ Class: SmallInteger }"|
+
+ mouseAndKeyboard notNil ifTrue:[
+ nEvent := mouseAndKeyboard size.
+ 1 to:nEvent do:[:i |
+ |anEvent|
+
+ anEvent := mouseAndKeyboard at:i.
+ (anEvent notNil and:[anEvent isKeyEvent]) ifTrue:[
+ (aView isNil or:[anEvent view == aView]) ifTrue:[
mouseAndKeyboard at:i put:nil
]
]
@@ -1056,12 +1461,29 @@
!
flushEventsFor:aView
- "throw away all events for aView"
+ "throw away all events for aView,
+ or any view, if the argument is nil."
self flushExposeEventsFor:aView.
self flushUserEventsFor:aView.
!
+flushExposeEvents
+ "throw away all pending expose events; this
+ can be done after a full redraw (or in views, which are
+ doing full redraws anly)"
+
+ (damage isNil or:[damage size > 0]) ifTrue:[
+ damage := OrderedCollection new
+ ].
+!
+
+flushKeyboard
+ "ST-80 compatibility: throw away all pending keyboard events"
+
+ self flushKeyboardFor:nil
+!
+
compressKeyPressEventsWithKey:aKey
"count and remove multiple pending keyPress events for the
same key, aKey. This is currently used in TextViews to compress
@@ -1082,17 +1504,9 @@
]
].
^ n
-!
+! !
-flushExposeEvents
- "throw away all pending expose events; this
- can be done after a full redraw (or in views, which are
- doing full redraws anly)"
-
- (damage isNil or:[damage size > 0]) ifTrue:[
- damage := OrderedCollection new
- ].
-!
+!WindowSensor methodsFor:'event simulation'!
pushUserEvent:anEvent
"manually put an event into the queue - this allows
@@ -1127,7 +1541,7 @@
!
forwardKeyEventsTo:aView
- "remove all keyboard events and send them to aSensor instead"
+ "remove all keyboard events and send them to aViews sensor instead"
"/ 'fwd' printNL.
1 to:mouseAndKeyboard size do:[:i |
@@ -1219,7 +1633,8 @@
compressMotionEvents := translateKeyboardEvents := true.
ignoreUserInput := false.
- shiftDown := ctrlDown := altDown := metaDown := false
+ shiftDown := ctrlDown := altDown := metaDown := false.
+ leftButtonDown := middleButtonDown := rightButtonDown := false.
!
reinitialize
@@ -1230,6 +1645,8 @@
self flushExposeEvents.
gotExpose := true.
catchExpose := false.
+ shiftDown := ctrlDown := altDown := metaDown := false.
+ leftButtonDown := middleButtonDown := rightButtonDown := false.
! !
WindowSensor initialize!
--- a/WindowGroup.st Mon Jul 03 02:35:52 1995 +0200
+++ b/WindowGroup.st Sun Jul 23 04:29:59 1995 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.27 1995-06-06 04:10:15 claus Exp $
+$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.28 1995-07-23 02:29:01 claus Exp $
'!
!WindowGroup class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.27 1995-06-06 04:10:15 claus Exp $
+$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.28 1995-07-23 02:29:01 claus Exp $
"
!
@@ -300,18 +300,50 @@
!WindowGroup methodsFor:'enumerating'!
allViewsDo:aBlock
- "evaluate aBlock for all views & topviews in this group"
+ "evaluate aBlock for all views & topviews in this group.
+ This works on a copy of the view collection, to allow for
+ destroy and other collection changeing operations to be done."
- topViews notNil ifTrue:[topViews do:aBlock].
- views notNil ifTrue:[views do:aBlock]
+ topViews notNil ifTrue:[topViews copy do:aBlock].
+ views notNil ifTrue:[views copy do:aBlock]
!
allTopViewsExcept:aView do:aBlock
- "evaluate aBlock for all topviews except aView in this group"
+ "evaluate aBlock for all topviews except aView in this group.
+ This works on a copy of the view collection, to allow for
+ destroy and other collection changeing operations to be done."
+
+ topViews notNil ifTrue:[
+ topViews copy do:[:v |
+ v ~~ aView ifTrue:[aBlock value:v]
+ ]
+ ].
+!
+
+slavesDo:aBlock
+ "evaluate aBlock for all slaveViews.
+ This works on a copy of the view collection, to allow for
+ destroy and other collection changeing operations to be done."
topViews notNil ifTrue:[
- topViews do:[:v |
- v ~~ aView ifTrue:[aBlock value:v]
+ topViews copy do:[:v |
+ v notNil ifTrue:[
+ v type == #slave ifTrue:[aBlock value:v].
+ ]
+ ]
+ ].
+!
+
+partnersDo:aBlock
+ "evaluate aBlock for all partnerViews.
+ This works on a copy of the view collection, to allow for
+ destroy and other collection changeing operations to be done."
+
+ topViews notNil ifTrue:[
+ topViews copy do:[:v |
+ v notNil ifTrue:[
+ v type == #partner ifTrue:[aBlock value:v].
+ ]
]
].
! !
@@ -781,7 +813,7 @@
|index|
- focusSequence isNil ifTrue:[^ self].
+ focusSequence size == 0 ifTrue:[^ self].
focusView notNil ifTrue:[
index := (focusSequence indexOf:focusView) + 1.
index > focusSequence size ifTrue:[index := 1].
@@ -809,7 +841,7 @@
|index|
- focusSequence isNil ifTrue:[^ self].
+ focusSequence size == 0 ifTrue:[^ self].
focusView notNil ifTrue:[
index := (focusSequence indexOf:focusView) - 1.
index < 1 ifTrue:[index := focusSequence size].
--- a/WindowSensor.st Mon Jul 03 02:35:52 1995 +0200
+++ b/WindowSensor.st Sun Jul 23 04:29:59 1995 +0200
@@ -16,8 +16,10 @@
instanceVariableNames:'eventSemaphore damage mouseAndKeyboard compressMotionEvents
ignoreUserInput exposeEventSemaphore catchExpose
gotExpose gotOtherEvent translateKeyboardEvents shiftDown
- ctrlDown metaDown altDown eventListener keyboardListener'
- classVariableNames:'ControlCEnabled EventListener'
+ ctrlDown metaDown altDown
+ leftButtonDown middleButtonDown rightButtonDown
+ eventListener keyboardListener'
+ classVariableNames:'ControlCEnabled EventListener ComposeTable GotCompose Compose1'
poolDictionaries:''
category:'Interface-Support'
!
@@ -26,7 +28,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.27 1995-07-02 16:17:47 claus Exp $
+$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.28 1995-07-23 02:29:08 claus Exp $
'!
!WindowSensor class methodsFor:'documentation'!
@@ -47,7 +49,7 @@
version
"
-$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.27 1995-07-02 16:17:47 claus Exp $
+$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.28 1995-07-23 02:29:08 claus Exp $
"
!
@@ -59,13 +61,14 @@
gets a chance to handle them.
In contrast to ST-80 (which has one windowSensor per window), ST/X usually
only assigns one sensor per windowGroup.
- (however, you could manually arrange for per view private sensors - at least, theoretically)
+ (however, you could manually arrange for per view private sensors
+ - at least, theoretically)
When adding an expose rectangle, WindowSensor tries to merge the rectangle
with the list of existing damages to minimize redrawing.
Beside the above, windowSensors provide facilities (hooks) to allow
- a so-called 'eventListener' to get the events before it is enterred into
+ a so-called 'eventListener' to get the event before it is entered into
the queue. There are 3 possible listening hooks available:
a global EventListener - gets keybd/mouse events for all views
@@ -79,12 +82,14 @@
the WindowSensor class; local listeners are installed via instance methods.
Each listener should return true, if it handled the event and that event should
therefore NOT be enqueued. Likewise, if it returns false, the event is
- processed as usual.
+ processed as usual (i.e. enqueued and forwarded to the views controller).
+
The global listener is called before the local listener, which is called
before the keyboard listener. If any returns true, later listeners wont get
the event.
EventListeners were added to allow the implementation of event recorders
- or other spy functionality.
+ or other spy functionality. They also allow hooking up views which otherwise
+ insist on doing things themself.
Notice, that beside event listening, you can also define a delegate for
a views keyboard and button events.
@@ -168,6 +173,8 @@
This allows overall event catchers to be
installed for example to implement event
recorders, active help managers etc.
+
+ ComposeTable <Array> compose-key translation table
"
! !
@@ -175,6 +182,115 @@
initialize
ControlCEnabled := true.
+ ComposeTable := #(
+ "/ key1 key2 -> character or asciiValue
+ ($+ $+ $#) "/ number-sign
+ ($A $A $@) "/ at-sign
+
+ ($( $- ${) "/ left brace
+ ($) $- $}) "/ right brace
+
+ ($| $c 16rA2) "/ cent-sign
+ ($| $S $$) "/ dollar-sign
+ ($= $L 16rA3) "/ pound-sign
+ ($= $Y 16rA5) "/ yen-sign
+ ($!! $s 16rA7) "/ section-sign
+ ($O $C 16rA9) "/ copyright
+ ($< $< 16rAB) "/ french <<-quotes
+ ($O $R 16rAE) "/ registered
+ ($/ $u 16rB5) "/ greek mu
+ ($!! $p 16rB6) "/ paragraph sign
+ ($> $> 16rBB) "/ french >> quotes
+ ($^ $0 16rB0) "/ degree sign
+ ($+ $- 16rB1) "/ plus-minus
+ ($^ $2 16rB2) "/ superscript-2
+ ($^ $3 16rB3) "/ superscript-3
+ ($. $^ 16rB7) "/ middle dot
+ ($^ $1 16rB9) "/ superscript-1
+ ($1 $4 16rBC) "/ 1/4
+ ($1 $2 16rBD) "/ 1/2
+ ($3 $4 16rBE) "/ 3/4
+ ($? $? 16rBF) "/ ?-inverted
+ ($- $: 16rF7) "/ divide
+
+ "/ diacriticals: Compose diacrit character
+ "/ grave
+
+ ($A $` 16rC0) "/ A-`
+ ($a $` 16rE0) "/ a-`
+ ($E $` 16rC8) "/ E-`
+ ($e $` 16rE8) "/ e-`
+ ($I $` 16rCC) "/ I-`
+ ($i $` 16rEC) "/ i-`
+ ($O $` 16rD2) "/ O-`
+ ($o $` 16rF2) "/ o-`
+ ($U $` 16rD9) "/ U-`
+ ($u $` 16rF9) "/ u-`
+
+ "/ acute
+ ($A $' 16rC1) "/ A-'
+ ($a $' 16rE1) "/ a-'
+ ($E $' 16rC9) "/ E-'
+ ($e $' 16rE9) "/ e-'
+ ($I $' 16rCD) "/ I-'
+ ($i $' 16rED) "/ i-'
+ ($O $' 16rD3) "/ O-'
+ ($o $' 16rF3) "/ o-'
+ ($U $' 16rDA) "/ U-'
+ ($u $' 16rFA) "/ u-'
+ ($Y $' 16rDD) "/ Y-'
+ ($y $' 16rFD) "/ y-'
+
+ "/ circumflex
+ ($A $^ 16rC2) "/ A-^
+ ($a $^ 16rE2) "/ a-^
+ ($E $^ 16rCA) "/ E-^
+ ($e $^ 16rEA) "/ e-^
+ ($I $^ 16rCE) "/ I-^
+ ($i $^ 16rEE) "/ i-^
+ ($O $^ 16rD4) "/ O-^
+ ($o $^ 16rF4) "/ o-^
+ ($U $^ 16rDB) "/ U-^
+ ($u $^ 16rFB) "/ u-^
+
+ "/ tilde
+ ($A $~ 16rC3) "/ A-~
+ ($a $~ 16rE3) "/ a-~
+ ($O $~ 16rD5) "/ O-~
+ ($o $~ 16rF5) "/ o-~
+ ($N $~ 16rD1) "/ N-tilde
+ ($n $~ 16rF1) "/ n-~
+
+ "/ ring above
+ ($a $* 16rE5) "/ a-*
+ ($A $* 16rC5) "/ A-*
+
+ "/ cedille
+ ($C $, 16rC7) "/ C-,
+ ($c $, 16rE7) "/ c-,
+
+ "/ dieresis
+ ($A $" 16rC4) "/ A-"
+ ($a $" 16rE4) "/ a-"
+ ($E $" 16rCB) "/ E-"
+ ($e $" 16rEB) "/ e-"
+ ($I $" 16rCF) "/ I-"
+ ($i $" 16rEF) "/ i-"
+ ($O $" 16rD6) "/ O-"
+ ($o $" 16rF6) "/ o-"
+ ($U $" 16rDC) "/ U-"
+ ($u $" 16rFC) "/ u-"
+ ($y $" 16rFF) "/ y-"
+
+ "/ ligatures
+ ($s $s 16rDF) "/ german sz
+ ($a $e 16rE6) "/ (french) ae
+ ($A $E 16rC6) "/ (french) AE
+ ).
+
+ "
+ WindowSensor initialize
+ "
! !
!WindowSensor class methodsFor:'instance creation'!
@@ -208,13 +324,31 @@
- see documentation for what this can be used for"
^ EventListener
+!
+
+composeTable:aTable
+ "set the compose-key table.
+ Entries consist of 3-element arrays each, where
+ the first two entries (of each entry) are the raw characters,
+ and the third is the resulting composed-key"
+
+ ComposeTable := aTable
+!
+
+composeTable
+ "return the compose-key table.
+ Entries consist of 3-element arrays each, where
+ the first two entries (of each entry) are the raw characters,
+ and the third is the resulting composed-key"
+
+ ^ ComposeTable
! !
!WindowSensor class methodsFor:'queries'!
cursorPoint
"ST-80 compatibility:
- return the position of the cursor on the default display"
+ return the position of the cursor on the current display"
^ Screen current pointerPosition
@@ -223,23 +357,27 @@
"
! !
-!WindowSensor methodsFor:'event processing'!
-
-notifyEventArrival
- "an event arrived - if there is an eventSemaphore,
- signal it, to wake up any windowGroup process"
+!WindowSensor methodsFor:'private'!
- catchExpose == true ifTrue:[
- "
- dont wake up, if we are currently waiting for an expose
- but remember arrival of something.
- "
- gotOtherEvent := true.
- ^ self
+isModifierKey:key
+ (key == #Shift
+ or:[key == #'Shift_R'
+ or:[key == #'Shift_L']]) ifTrue:[
+ ^ true
+ ].
+ (key == #Alt
+ or:[key == #'Alt_R' or:[key == #'Alt_L']]) ifTrue:[
+ ^ true
].
- eventSemaphore notNil ifTrue:[
- eventSemaphore signal
- ]
+ (key == #Meta
+ or:[key == #'Meta_R' or:[key == #'Meta_L']]) ifTrue:[
+ ^ true
+ ].
+ (key == #Control
+ or:[key == #'Control_R' or:[key == #'Control_L']]) ifTrue:[
+ ^ true
+ ].
+ ^ false
!
key:key state:onOrOff
@@ -269,6 +407,64 @@
].
!
+compose:key1 with:key2
+ "compose a 2-character sequence into a composed key"
+
+ ComposeTable do:[:entry |
+ |v|
+
+ ((key1 == (entry at:1)) and:[key2 == (entry at:2)]) ifTrue:[
+ v := entry at:3.
+ v isCharacter ifFalse:[v := Character value:v].
+ ^ v
+ ]
+ ].
+ "/
+ "/ for illegal sequence, return 2nd key
+ "/
+"/ key1 print. ' ' print. key2 printNL.
+ ^ key2
+! !
+
+!WindowSensor methodsFor:'event processing'!
+
+notifyEventArrival
+ "an event arrived - if there is an eventSemaphore,
+ signal it, to wake up any windowGroup process"
+
+ catchExpose == true ifTrue:[
+ "
+ dont wake up, if we are currently waiting for an expose
+ but remember arrival of something.
+ "
+ gotOtherEvent := true.
+ ^ self
+ ].
+ eventSemaphore notNil ifTrue:[
+ eventSemaphore signal
+ ]
+!
+
+button:button inView:aView state:onOrOff
+ "update the state of the xxxButtonDown flags"
+
+ |physicalButton|
+
+ physicalButton := aView device buttonTranslation keyAtValue:button ifAbsent:button.
+ (physicalButton == 1) ifTrue:[
+ leftButtonDown := onOrOff.
+ ^ self
+ ].
+ (physicalButton == 2) ifTrue:[
+ middleButtonDown := onOrOff.
+ ^ self
+ ].
+ (physicalButton == 3) ifTrue:[
+ rightButtonDown := onOrOff.
+ ^ self
+ ].
+!
+
noExposeView:aView
"an noexpose event arrived - this is sent from the device (Display)"
@@ -347,6 +543,8 @@
buttonRelease:button x:x y:y view:aView
"mouse button was released- this is sent from the device (Display)"
+ self button:button inView:aView state:false.
+
EventListener notNil ifTrue:[
(EventListener buttonRelease:button x:x y:y view:aView) ifTrue:[^ self]
].
@@ -368,6 +566,8 @@
buttonPress:button x:x y:y view:aView
"mouse button was pressed - this is sent from the device (Display)"
+ self button:button inView:aView state:true.
+
EventListener notNil ifTrue:[
(EventListener buttonPress:button x:x y:y view:aView) ifTrue:[^ self]
].
@@ -474,15 +674,40 @@
] ifFalse:[
xlatedKey := key.
].
+
xlatedKey isNil ifTrue:[^ self].
- (xlatedKey == #CtrlV) ifTrue:[
+ (xlatedKey == #Compose) ifTrue:[
+ GotCompose := true. Compose1 := nil.
+ ^ self
+ ].
+ GotCompose == true ifTrue:[
+ Compose1 isNil ifTrue:[
+ (self isModifierKey:xlatedKey) ifFalse:[
+ Compose1 := xlatedKey.
+ ].
+ ^ self
+ ].
+ (self isModifierKey:xlatedKey) ifFalse:[
+ xlatedKey := self compose:Compose1 with:xlatedKey.
+ Compose1 := nil. GotCompose := false.
+ ]
+ ].
+
+ (xlatedKey == #CmdCtrlV) ifTrue:[
'Smalltalk/X ' errorPrint.
Smalltalk versionString errorPrint. ' of ' errorPrint.
Smalltalk versionDate errorPrintNL.
Smalltalk copyrightString errorPrintNL.
].
+ (xlatedKey == #DestroyView) ifTrue:[
+ aView closeRequest.
+ ].
+ (xlatedKey == #DestroyTopView) ifTrue:[
+ aView topView closeRequest.
+ ].
+
(xlatedKey == #FlushInput) ifTrue:[
"this removes any enqueued user events -
helps, if you pressed DoIt too often, and want to flush those
@@ -565,6 +790,8 @@
buttonShiftPress:button x:x y:y view:aView
"mouse button was pressed - this is sent from the device (Display)"
+ self button:button inView:aView state:true.
+
EventListener notNil ifTrue:[
(EventListener buttonShiftPress:button x:x y:y view:aView) ifTrue:[^ self]
].
@@ -882,19 +1109,53 @@
^ false
!
-hasButtonMotionEventsFor:aView
- "return true, if any buttonMotion events are pending"
+hasEvent:type orPendingDeviceEvent:dType for:aView
+ "return true, if a specific event is pending.
+ Type is the type of event, dType the corresponding device event.
+ If the argument, aView is nil, the information is regarding any
+ view (i.e. is there a motion event for any of my views);
+ otherwise, the information is regrding that specific view."
mouseAndKeyboard size ~~ 0 ifTrue:[
mouseAndKeyboard do:[:anEvent |
anEvent notNil ifTrue:[
- anEvent view == aView ifTrue:[
- anEvent type == #buttonMotion:x:y: ifTrue:[^ true].
+ (aView isNil or:[anEvent view == aView]) ifTrue:[
+ anEvent type == type ifTrue:[^ true].
]
].
]
].
- ^ aView device eventPending:#buttonMotion for:aView id
+ aView notNil ifTrue:[
+ ^ aView device eventPending:dType for:aView id
+ ].
+ ^ false
+!
+
+hasButtonMotionEventsFor:aView
+ "return true, if any buttonMotion events are pending.
+ If the argument, aView is nil, the information is regarding any
+ view (i.e. is there a motion event for any of my views);
+ otherwise, the information is regrding that specific view."
+
+ ^ self hasEvent:#buttonMotion:x:y: orPendingDeviceEvent:#buttonMotion for:aView
+!
+
+hasButtonReleaseEventFor:aView
+ "return true, if any buttonRelease events are pending.
+ If the argument, aView is nil, the information is regarding any
+ view (i.e. is there a motion event for any of my views);
+ otherwise, the information is regrding that specific view."
+
+ ^ self hasEvent:#buttonRelease:x:y: orPendingDeviceEvent:#buttonRelease for:aView
+!
+
+hasButtonPressEventFor:aView
+ "return true, if any buttonPress events are pending.
+ If the argument, aView is nil, the information is regarding any
+ view (i.e. is there a motion event for any of my views);
+ otherwise, the information is regrding that specific view."
+
+ ^ self hasEvent:#buttonPress:x:y: orPendingDeviceEvent:#buttonPress for:aView
!
eventPending
@@ -906,7 +1167,16 @@
mousePoint
"ST-80 compatibility:
- return the position of the mouse pointer on the default display"
+ return the position of the mouse pointer on the current display
+ (in screen coordinates)"
+
+ ^ self class cursorPoint
+!
+
+cursorPoint
+ "ST-80 compatibility:
+ return the position of the mouse pointer on the current display
+ (in screen coordinates)"
^ self class cursorPoint
!
@@ -945,6 +1215,72 @@
it is better to use 'sensor metaDown or:[sensor altDown]'."
^ altDown
+!
+
+leftButtonPressed
+ "return true, if the left mouse button is pressed.
+ This has been added to support ST-80 style button polling;
+ however, you should no use it in 'normal' applications.
+ Instead, keep track of the buttons state in your views or controllers
+ button-event methods."
+
+ ^ leftButtonDown
+!
+
+middleButtonPressed
+ "return true, if the middle mouse button is pressed.
+ This has been added to support ST-80 style button polling;
+ however, you should no use it in 'normal' applications.
+ Instead, keep track of the buttons state in your views or controllers
+ button-event methods."
+
+ ^ middleButtonDown
+!
+
+rightButtonPressed
+ "return true, if the right mouse button is pressed.
+ This has been added to support ST-80 style button polling;
+ however, you should no use it in 'normal' applications.
+ Instead, keep track of the buttons state in your views or controllers
+ button-event methods."
+
+ ^ rightButtonDown
+!
+
+redButtonPressed
+ "ST-80 compatibility: return true, if the left mouse button is pressed.
+ You should no use it in 'normal' applications.
+ Instead, keep track of the buttons state in your views or controllers
+ button-event methods."
+
+ ^ leftButtonDown
+!
+
+yellowButtonPressed
+ "ST-80 compatibility: return true, if the middle mouse button is pressed.
+ You should no use it in 'normal' applications.
+ Instead, keep track of the buttons state in your views or controllers
+ button-event methods."
+
+ ^ middleButtonDown
+!
+
+blueButtonPressed
+ "ST-80 compatibility: return true, if the right mouse button is pressed.
+ You should no use it in 'normal' applications.
+ Instead, keep track of the buttons state in your views or controllers
+ button-event methods."
+
+ ^ rightButtonDown
+!
+
+anyButtonPressed
+ "ST-80 compatibility: return true, if any mouse button is pressed.
+ You should no use it in 'normal' applications.
+ Instead, keep track of the buttons state in your views or controllers
+ button-event methods."
+
+ ^ rightButtonDown or:[middleButtonDown or:[rightButtonDown]]
! !
!WindowSensor methodsFor:'special'!
@@ -961,7 +1297,10 @@
!
waitForExposeFor:aView
- "wait until a noExpose arrives (after a bitblt)"
+ "wait until a graphicsExpose or a noExpose arrives (after a bitblt).
+ This may be too X-specific, and things may change in this area
+ in future versions. (or the new device may simulate the arrival of
+ such an event)"
Processor activeProcessIsSystemProcess ifTrue:[
"
@@ -1010,6 +1349,43 @@
catchExpose := false
!
+waitButton
+ "ST-80 compatibility: wait until any mouse button is pressed.
+ Do not use this in your applications; polling the sensor is
+ bad style."
+
+ [self anyButtonPressed] whileFalse:[
+ (Delay forSeconds:0.01) wait.
+ ].
+
+"/ (leftButtonPressed
+"/ or:[middleButtonPressed
+"/ or:[rightButtonPressed]]) ifTrue:[^ self].
+"/
+"/ [self hasButtonPressEventFor:nil] whileFalse:[
+"/ (Delay forSeconds:0.01) wait.
+"/ ]
+!
+
+waitNoButton
+ "ST-80 compatibility: wait until no mouse button is pressed.
+ Do not use this in your applications; polling the sensor is
+ bad style."
+
+ [self anyButtonPressed] whileTrue:[
+ (Delay forSeconds:0.01) wait.
+ ].
+"/ (leftButtonPressed
+"/ or:[middleButtonPressed
+"/ or:[rightButtonPressed]]) ifFalse:[^ self].
+"/
+"/ [self hasButtonReleaseEventFor:nil] whileFalse:[
+"/ (Delay forSeconds:0.01) wait.
+"/ ]
+! !
+
+!WindowSensor methodsFor:'event flushing'!
+
flushUserEvents
"throw away all pending user events"
@@ -1019,18 +1395,22 @@
!
flushExposeEventsFor:aView
- "throw away all pending expose events for aView;
- this can be done after a full redraw
+ "throw away all pending expose events for aView,
+ or any view, if the argument is nil.
+ This can be done after a full redraw
(or in views, which are always doing full redraws -
instead of drawing the clip-area only)"
+ |nEvent "{ Class: SmallInteger }"|
+
damage notNil ifTrue:[
- 1 to:damage size do:[:index |
+ nEvent := damage size.
+ 1 to:nEvent do:[:index |
|aDamage|
aDamage := damage at:index.
aDamage notNil ifTrue:[
- aDamage view == aView ifTrue:[
+ (aView isNil or:[aDamage view == aView]) ifTrue:[
damage at:index put:nil
]
]
@@ -1039,15 +1419,40 @@
!
flushUserEventsFor:aView
- "throw away all pending user events for aView"
+ "throw away all pending user events for aView,
+ or any view, if the argument is nil."
+
+ |nEvent "{ Class: SmallInteger }"|
mouseAndKeyboard notNil ifTrue:[
- 1 to:mouseAndKeyboard size do:[:i |
+ nEvent := mouseAndKeyboard size.
+ 1 to:nEvent do:[:i |
|anEvent|
anEvent := mouseAndKeyboard at:i.
anEvent notNil ifTrue:[
- anEvent view == aView ifTrue:[
+ (aView isNil or:[anEvent view == aView]) ifTrue:[
+ mouseAndKeyboard at:i put:nil
+ ]
+ ]
+ ]
+ ].
+!
+
+flushKeyboardFor:aView
+ "throw away all pending keyboard events for aView,
+ or any view, if the argument is nil."
+
+ |nEvent "{ Class: SmallInteger }"|
+
+ mouseAndKeyboard notNil ifTrue:[
+ nEvent := mouseAndKeyboard size.
+ 1 to:nEvent do:[:i |
+ |anEvent|
+
+ anEvent := mouseAndKeyboard at:i.
+ (anEvent notNil and:[anEvent isKeyEvent]) ifTrue:[
+ (aView isNil or:[anEvent view == aView]) ifTrue:[
mouseAndKeyboard at:i put:nil
]
]
@@ -1056,12 +1461,29 @@
!
flushEventsFor:aView
- "throw away all events for aView"
+ "throw away all events for aView,
+ or any view, if the argument is nil."
self flushExposeEventsFor:aView.
self flushUserEventsFor:aView.
!
+flushExposeEvents
+ "throw away all pending expose events; this
+ can be done after a full redraw (or in views, which are
+ doing full redraws anly)"
+
+ (damage isNil or:[damage size > 0]) ifTrue:[
+ damage := OrderedCollection new
+ ].
+!
+
+flushKeyboard
+ "ST-80 compatibility: throw away all pending keyboard events"
+
+ self flushKeyboardFor:nil
+!
+
compressKeyPressEventsWithKey:aKey
"count and remove multiple pending keyPress events for the
same key, aKey. This is currently used in TextViews to compress
@@ -1082,17 +1504,9 @@
]
].
^ n
-!
+! !
-flushExposeEvents
- "throw away all pending expose events; this
- can be done after a full redraw (or in views, which are
- doing full redraws anly)"
-
- (damage isNil or:[damage size > 0]) ifTrue:[
- damage := OrderedCollection new
- ].
-!
+!WindowSensor methodsFor:'event simulation'!
pushUserEvent:anEvent
"manually put an event into the queue - this allows
@@ -1127,7 +1541,7 @@
!
forwardKeyEventsTo:aView
- "remove all keyboard events and send them to aSensor instead"
+ "remove all keyboard events and send them to aViews sensor instead"
"/ 'fwd' printNL.
1 to:mouseAndKeyboard size do:[:i |
@@ -1219,7 +1633,8 @@
compressMotionEvents := translateKeyboardEvents := true.
ignoreUserInput := false.
- shiftDown := ctrlDown := altDown := metaDown := false
+ shiftDown := ctrlDown := altDown := metaDown := false.
+ leftButtonDown := middleButtonDown := rightButtonDown := false.
!
reinitialize
@@ -1230,6 +1645,8 @@
self flushExposeEvents.
gotExpose := true.
catchExpose := false.
+ shiftDown := ctrlDown := altDown := metaDown := false.
+ leftButtonDown := middleButtonDown := rightButtonDown := false.
! !
WindowSensor initialize!
--- a/XWorkstat.st Mon Jul 03 02:35:52 1995 +0200
+++ b/XWorkstat.st Sun Jul 23 04:29:59 1995 +0200
@@ -35,7 +35,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/XWorkstat.st,v 1.49 1995-07-02 16:18:06 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/XWorkstat.st,v 1.50 1995-07-23 02:29:31 claus Exp $
'!
!XWorkstation class methodsFor:'documentation'!
@@ -56,7 +56,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/XWorkstat.st,v 1.49 1995-07-02 16:18:06 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/XWorkstat.st,v 1.50 1995-07-23 02:29:31 claus Exp $
"
!
@@ -261,7 +261,7 @@
event->minor_code, event->minor_code, event->resourceid);
fprintf(stderr, "XWORKSTAT: x-error message is '%s'\n", lastErrorMsg);
- __errorInterruptWithID(@symbol(DisplayError));
+ __errorInterruptWithID__(@symbol(DisplayError));
return 0;
}
@@ -1190,7 +1190,6 @@
FAXImage newImage;
int _type, _msb, _k = 0;
unsigned char *bits;
- extern OBJ ByteArray;
if (__bothSmallInteger(w, h)
&& __bothSmallInteger(type, k)
@@ -1330,7 +1329,6 @@
unsigned char fastBits[10000];
OBJ num, *op;
int bytesPerRow;
- extern OBJ Array, ByteArray;
if (firstCall) {
for (index=0; index < 256; index++) {
@@ -1572,7 +1570,7 @@
borderWidth:(aView borderWidth)
"/ borderColor:(aView borderColor)
subViewOf:(aView superView)
- onTop:(aView createOnTop)
+ onTop:(aView isPopUpView)
inputOnly:(aView inputOnly)
label:(aView label)
cursor:(aView cursor)
@@ -1588,7 +1586,7 @@
borderWidth:bWidth
"/ borderColor:bColor
subViewOf:wsuperView
- onTop:wcreateOnTop
+ onTop:wisPopUpView
inputOnly:winputOnly
label:wlabel
cursor:wcursor
@@ -1791,7 +1789,7 @@
}
#endif
- if (wcreateOnTop == true)
+ if (wisPopUpView == true)
xswa.override_redirect = 1;
else
xswa.override_redirect = 0;
@@ -2742,7 +2740,6 @@
int available = nnames + 1;
char **fonts;
OBJ arr, str;
- OBJ __ARRAY_NEW_INT(), _MKSTRING_INIT();
int i;
if (ISCONNECTED) {
@@ -2762,7 +2759,7 @@
}
for (i=0; i<available; i++) {
PROTECT(arr);
- str = _MKSTRING_INIT(fonts[i]);
+ str = (OBJ)_MKSTRING_INIT(fonts[i]);
UNPROTECT(arr);
__ArrayInstPtr(arr)->a_element[i] = str;
__STORE(arr, str);
@@ -2985,6 +2982,7 @@
!
ascentOf:aFontId
+ "the normal ascent"
%{ /* NOCONTEXT */
@@ -3001,6 +2999,7 @@
!
descentOf:aFontId
+ "the normal descent"
%{ /* NOCONTEXT */
@@ -3032,7 +3031,42 @@
^ nil
!
+maxAscentOf:aFontId
+ "the max ascent"
+
+%{ /* NOCONTEXT */
+
+ XFontStruct *f;
+
+ if (__isSmallInteger(aFontId)) {
+ f = _FontVal(aFontId);
+ RETURN ( _MKSMALLINT(f->max_bounds.ascent) );
+ }
+%}
+.
+ self primitiveFailed.
+ ^ nil
+!
+
+maxDescentOf:aFontId
+ "the max descent"
+
+%{ /* NOCONTEXT */
+
+ XFontStruct *f;
+
+ if (__isSmallInteger(aFontId)) {
+ f = _FontVal(aFontId);
+ RETURN ( _MKSMALLINT(f->max_bounds.descent) );
+ }
+%}
+.
+ self primitiveFailed.
+ ^ nil
+!
+
maxWidthOfFont:aFontId
+ "the width of the widest character"
%{ /* NOCONTEXT */
@@ -3863,8 +3897,7 @@
g = _MKFLOAT(fg, __context);
b = _MKFLOAT(fb, __context);
}
-%}
-.
+%}.
aBlock value:r value:g value:b
! !
@@ -3889,8 +3922,7 @@
}
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -3929,8 +3961,7 @@
END_INTERRUPTSBLOCKED
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -3969,8 +4000,7 @@
END_INTERRUPTSBLOCKED
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -3988,8 +4018,7 @@
}
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -4004,8 +4033,7 @@
XSetWindowBackground(myDpy, _WindowVal(aWindowId), _intVal(aColorIndex));
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -4021,8 +4049,7 @@
XSetWindowBackgroundPixmap(myDpy, _WindowVal(aWindowId), _PixmapVal(aPixmapId));
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -4035,8 +4062,7 @@
XSetWindowBorder(myDpy, _WindowVal(aWindowId), _intVal(aColorIndex));
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -4063,8 +4089,7 @@
XSetWindowBorderWidth(myDpy, _WindowVal(aWindowId), _intVal(aNumber));
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -4082,8 +4107,7 @@
RETURN ( self );
}
#endif
-%}
-.
+%}.
self primitiveFailed
!
@@ -4102,8 +4126,7 @@
RETURN ( self );
}
#endif
-%}
-.
+%}.
self primitiveFailed
!
@@ -4118,8 +4141,7 @@
XDefineCursor(dpy, _WindowVal(aWindowId), _CursorVal(aCursorId));
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -4133,8 +4155,7 @@
XStoreName(myDpy, _WindowVal(aWindowId), (char *)_stringVal(aString));
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -4148,8 +4169,7 @@
XSetIconName(myDpy, _WindowVal(aWindowId), (char *)_stringVal(aString));
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -4170,8 +4190,7 @@
XSetWMHints(myDpy, _WindowVal(aWindowId), &hints);
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -4185,15 +4204,14 @@
].
%{
if (__bothSmallInteger(iconWindowId, aWindowId)) {
- XWMHints hints;
-
- hints.icon_window = _WindowVal(iconWindowId);
- hints.flags = IconWindowHint;
- XSetWMHints(myDpy, _WindowVal(aWindowId), &hints);
+ XWMHints wmhints;
+
+ wmhints.icon_window = _WindowVal(iconWindowId);
+ wmhints.flags = IconWindowHint;
+ XSetWMHints(myDpy, _WindowVal(aWindowId), &wmhints);
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -4207,8 +4225,7 @@
_WindowVal(aMainWindowId));
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -4488,6 +4505,24 @@
self primitiveFailed
! !
+!XWorkstation ignoredMethodsFor:'window stuff'!
+
+iconifyWindow:aWindowId
+ "iconify a topView"
+
+%{ /* NOCONTEXT */
+ if (__isSmallInteger(aWindowId)) {
+ XWMHints wmhints;
+
+ wmhints.initial_state = IconicState;
+ wmhints.flags |= StateHint;
+ XSetWMHints(myDpy, _WindowVal(aWindowId), &wmhints);
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailed
+! !
+
!XWorkstation methodsFor:'graphic context stuff'!
setForeground:fgColorIndex in:aGCId
@@ -4903,7 +4938,6 @@
Display *dpy = myDpy;
Window win = _WindowVal(aDrawableId);
- extern OBJ ByteArray;
XImage *image = (XImage *)0;
int pad, bytes_per_line, numBytes;
@@ -5531,7 +5565,6 @@
Display *dpy = myDpy;
GC gc = _GCVal(aGCId);
Window win = _WindowVal(aDrawableId);
- extern OBJ ByteArray;
XImage image;
if (__bothSmallInteger(aGCId, aDrawableId)
--- a/XWorkstation.st Mon Jul 03 02:35:52 1995 +0200
+++ b/XWorkstation.st Sun Jul 23 04:29:59 1995 +0200
@@ -35,7 +35,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.49 1995-07-02 16:18:06 claus Exp $
+$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.50 1995-07-23 02:29:31 claus Exp $
'!
!XWorkstation class methodsFor:'documentation'!
@@ -56,7 +56,7 @@
version
"
-$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.49 1995-07-02 16:18:06 claus Exp $
+$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.50 1995-07-23 02:29:31 claus Exp $
"
!
@@ -261,7 +261,7 @@
event->minor_code, event->minor_code, event->resourceid);
fprintf(stderr, "XWORKSTAT: x-error message is '%s'\n", lastErrorMsg);
- __errorInterruptWithID(@symbol(DisplayError));
+ __errorInterruptWithID__(@symbol(DisplayError));
return 0;
}
@@ -1190,7 +1190,6 @@
FAXImage newImage;
int _type, _msb, _k = 0;
unsigned char *bits;
- extern OBJ ByteArray;
if (__bothSmallInteger(w, h)
&& __bothSmallInteger(type, k)
@@ -1330,7 +1329,6 @@
unsigned char fastBits[10000];
OBJ num, *op;
int bytesPerRow;
- extern OBJ Array, ByteArray;
if (firstCall) {
for (index=0; index < 256; index++) {
@@ -1572,7 +1570,7 @@
borderWidth:(aView borderWidth)
"/ borderColor:(aView borderColor)
subViewOf:(aView superView)
- onTop:(aView createOnTop)
+ onTop:(aView isPopUpView)
inputOnly:(aView inputOnly)
label:(aView label)
cursor:(aView cursor)
@@ -1588,7 +1586,7 @@
borderWidth:bWidth
"/ borderColor:bColor
subViewOf:wsuperView
- onTop:wcreateOnTop
+ onTop:wisPopUpView
inputOnly:winputOnly
label:wlabel
cursor:wcursor
@@ -1791,7 +1789,7 @@
}
#endif
- if (wcreateOnTop == true)
+ if (wisPopUpView == true)
xswa.override_redirect = 1;
else
xswa.override_redirect = 0;
@@ -2742,7 +2740,6 @@
int available = nnames + 1;
char **fonts;
OBJ arr, str;
- OBJ __ARRAY_NEW_INT(), _MKSTRING_INIT();
int i;
if (ISCONNECTED) {
@@ -2762,7 +2759,7 @@
}
for (i=0; i<available; i++) {
PROTECT(arr);
- str = _MKSTRING_INIT(fonts[i]);
+ str = (OBJ)_MKSTRING_INIT(fonts[i]);
UNPROTECT(arr);
__ArrayInstPtr(arr)->a_element[i] = str;
__STORE(arr, str);
@@ -2985,6 +2982,7 @@
!
ascentOf:aFontId
+ "the normal ascent"
%{ /* NOCONTEXT */
@@ -3001,6 +2999,7 @@
!
descentOf:aFontId
+ "the normal descent"
%{ /* NOCONTEXT */
@@ -3032,7 +3031,42 @@
^ nil
!
+maxAscentOf:aFontId
+ "the max ascent"
+
+%{ /* NOCONTEXT */
+
+ XFontStruct *f;
+
+ if (__isSmallInteger(aFontId)) {
+ f = _FontVal(aFontId);
+ RETURN ( _MKSMALLINT(f->max_bounds.ascent) );
+ }
+%}
+.
+ self primitiveFailed.
+ ^ nil
+!
+
+maxDescentOf:aFontId
+ "the max descent"
+
+%{ /* NOCONTEXT */
+
+ XFontStruct *f;
+
+ if (__isSmallInteger(aFontId)) {
+ f = _FontVal(aFontId);
+ RETURN ( _MKSMALLINT(f->max_bounds.descent) );
+ }
+%}
+.
+ self primitiveFailed.
+ ^ nil
+!
+
maxWidthOfFont:aFontId
+ "the width of the widest character"
%{ /* NOCONTEXT */
@@ -3863,8 +3897,7 @@
g = _MKFLOAT(fg, __context);
b = _MKFLOAT(fb, __context);
}
-%}
-.
+%}.
aBlock value:r value:g value:b
! !
@@ -3889,8 +3922,7 @@
}
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -3929,8 +3961,7 @@
END_INTERRUPTSBLOCKED
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -3969,8 +4000,7 @@
END_INTERRUPTSBLOCKED
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -3988,8 +4018,7 @@
}
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -4004,8 +4033,7 @@
XSetWindowBackground(myDpy, _WindowVal(aWindowId), _intVal(aColorIndex));
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -4021,8 +4049,7 @@
XSetWindowBackgroundPixmap(myDpy, _WindowVal(aWindowId), _PixmapVal(aPixmapId));
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -4035,8 +4062,7 @@
XSetWindowBorder(myDpy, _WindowVal(aWindowId), _intVal(aColorIndex));
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -4063,8 +4089,7 @@
XSetWindowBorderWidth(myDpy, _WindowVal(aWindowId), _intVal(aNumber));
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -4082,8 +4107,7 @@
RETURN ( self );
}
#endif
-%}
-.
+%}.
self primitiveFailed
!
@@ -4102,8 +4126,7 @@
RETURN ( self );
}
#endif
-%}
-.
+%}.
self primitiveFailed
!
@@ -4118,8 +4141,7 @@
XDefineCursor(dpy, _WindowVal(aWindowId), _CursorVal(aCursorId));
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -4133,8 +4155,7 @@
XStoreName(myDpy, _WindowVal(aWindowId), (char *)_stringVal(aString));
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -4148,8 +4169,7 @@
XSetIconName(myDpy, _WindowVal(aWindowId), (char *)_stringVal(aString));
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -4170,8 +4190,7 @@
XSetWMHints(myDpy, _WindowVal(aWindowId), &hints);
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -4185,15 +4204,14 @@
].
%{
if (__bothSmallInteger(iconWindowId, aWindowId)) {
- XWMHints hints;
-
- hints.icon_window = _WindowVal(iconWindowId);
- hints.flags = IconWindowHint;
- XSetWMHints(myDpy, _WindowVal(aWindowId), &hints);
+ XWMHints wmhints;
+
+ wmhints.icon_window = _WindowVal(iconWindowId);
+ wmhints.flags = IconWindowHint;
+ XSetWMHints(myDpy, _WindowVal(aWindowId), &wmhints);
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -4207,8 +4225,7 @@
_WindowVal(aMainWindowId));
RETURN ( self );
}
-%}
-.
+%}.
self primitiveFailed
!
@@ -4488,6 +4505,24 @@
self primitiveFailed
! !
+!XWorkstation ignoredMethodsFor:'window stuff'!
+
+iconifyWindow:aWindowId
+ "iconify a topView"
+
+%{ /* NOCONTEXT */
+ if (__isSmallInteger(aWindowId)) {
+ XWMHints wmhints;
+
+ wmhints.initial_state = IconicState;
+ wmhints.flags |= StateHint;
+ XSetWMHints(myDpy, _WindowVal(aWindowId), &wmhints);
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailed
+! !
+
!XWorkstation methodsFor:'graphic context stuff'!
setForeground:fgColorIndex in:aGCId
@@ -4903,7 +4938,6 @@
Display *dpy = myDpy;
Window win = _WindowVal(aDrawableId);
- extern OBJ ByteArray;
XImage *image = (XImage *)0;
int pad, bytes_per_line, numBytes;
@@ -5531,7 +5565,6 @@
Display *dpy = myDpy;
GC gc = _GCVal(aGCId);
Window win = _WindowVal(aDrawableId);
- extern OBJ ByteArray;
XImage image;
if (__bothSmallInteger(aGCId, aDrawableId)
--- a/styles/generic.style Mon Jul 03 02:35:52 1995 +0200
+++ b/styles/generic.style Sun Jul 23 04:29:59 1995 +0200
@@ -26,7 +26,7 @@
; all of them for new styles.
;
;
-; $Header: /cvs/stx/stx/libview/styles/generic.style,v 1.5 1995-06-06 04:11:07 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/generic.style,v 1.6 1995-07-23 02:29:55 claus Exp $
;
; agenda:
@@ -177,9 +177,19 @@
;otherwise, it hides itself on button release.
;
pullDownMenuKeepMenu false
+
+;
+;if true, pressing button again (in the pull-menus item) hides a shown (kept)
+;menu. Otherwise a press outside of the item-area is required to hide the menu.
+;
pullDownMenuToggleKeep false
;
+;if true, menus topview is raised when an entry is activated
+;
+pullDownMenuRaiseTop true
+
+;
; label defaults
; (these are inherited by Button, Toggles etc. if not redefined)
--- a/styles/iris.style Mon Jul 03 02:35:52 1995 +0200
+++ b/styles/iris.style Sun Jul 23 04:29:59 1995 +0200
@@ -3,7 +3,7 @@
; silicon graphics style
; (somwehat like motif, but with smooth edges and bells&whistles)
;
-; $Header: /cvs/stx/stx/libview/styles/iris.style,v 1.3 1995-05-16 17:15:43 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/iris.style,v 1.4 1995-07-23 02:29:59 claus Exp $
comment 'Silicon graphics'' iris look alike'
@@ -52,7 +52,12 @@
editFieldSelectionBackgroundColor Color white
editFieldSelectionForegroundColor Color black
#endif
+
+#if (Font family:'screen' face:'bold' style:'roman' size:16) existsOn:Display
editFieldFont Font family:'screen' face:'bold' style:'roman' size:16
+#else
+editFieldFont Font family:'courier' face:'medium' style:'roman' size:12
+#endif
variableFont Font family:'helvetica' face:'medium' style:'roman' size:12
selectionFont =variableFont