--- a/DeviceWorkstation.st Tue Oct 04 19:10:54 1994 +0100
+++ b/DeviceWorkstation.st Mon Oct 10 03:30:48 1994 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -12,28 +12,29 @@
Object subclass:#DeviceWorkstation
instanceVariableNames:'displayId
- visualType monitorType
- depth ncells bitsPerRGB
- hasColors hasGreyscales
- width height widthMM heightMM resolutionHor resolutionVer
- idToViewMapping knownViews knownIds knownBitmaps knownBitmapIds
- dispatching
- controlDown shiftDown metaDown altDown
- motionEventCompression
- lastId lastView
- keyboardMap
- isSlow activeGrab'
+ visualType monitorType
+ depth ncells bitsPerRGB
+ hasColors hasGreyscales
+ width height widthMM heightMM resolutionHor resolutionVer
+ idToViewMapping knownViews knownIds knownBitmaps knownBitmapIds
+ dispatching
+ controlDown shiftDown metaDown altDown
+ motionEventCompression
+ lastId lastView
+ keyboardMap
+ isSlow activeGrab
+ buttonTranslation multiClickTimeDelta'
classVariableNames: 'ButtonTranslation MultiClickTimeDelta
- DeviceErrorSignal'
+ DeviceErrorSignal'
poolDictionaries:''
category:'Interface-Graphics'
!
DeviceWorkstation comment:'
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
-
-$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.17 1994-08-11 23:41:18 claus Exp $
+ All Rights Reserved
+
+$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.18 1994-10-10 02:29:56 claus Exp $
'!
!DeviceWorkstation class methodsFor:'documentation'!
@@ -41,7 +42,7 @@
copyright
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -54,7 +55,7 @@
version
"
-$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.17 1994-08-11 23:41:18 claus Exp $
+$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.18 1994-10-10 02:29:56 claus Exp $
"
!
@@ -71,7 +72,7 @@
depth <Integer> bits per color
ncells <Integer> number of colors (i.e. colormap size; not always == 2^depth)
bitsPerRGB <Integer> number of valid bits per rgb component
- (actual number taken in A/D converter; not all devices report the true value)
+ (actual number taken in A/D converter; not all devices report the true value)
hasColors <Boolean> true, if display supports colors
hasGreyscales <Boolean> true, if display supports grey-scales (i.e is not b/w display)
width <Integer> number of horizontal pixels
@@ -101,7 +102,7 @@
keyboardMap <KeyBdMap> mapping for keys
isSlow <Boolean> set/cleared from startup - used to turn off
- things like popup-shadows etc.
+ things like popup-shadows etc.
"
! !
@@ -109,8 +110,8 @@
initialize
DeviceErrorSignal isNil ifTrue:[
- DeviceErrorSignal := (Signal new) mayProceed:true.
- DeviceErrorSignal notifierString:'device error'.
+ DeviceErrorSignal := (Signal new) mayProceed:true.
+ DeviceErrorSignal notifierString:'device error'.
].
!
@@ -153,7 +154,7 @@
to be the display-string i.e. hostname:displayNr.
If the argument is nil, connect to the default display."
- self subclassResponsibility
+ ^ self subclassResponsibility
!
close
@@ -188,37 +189,37 @@
"/ prevMapping notNil ifTrue:[
prevKnownViews notNil ifTrue:[
- "
- first round: flush all device specific stuff
- "
+ "
+ first round: flush all device specific stuff
+ "
"/ prevMapping keysAndValuesDo:[:anId :aView |
- prevKnownViews do:[:aView |
- aView notNil ifTrue:[
- aView prepareForReinit
- ]
- ].
-
- "
- 2nd round: all views should reinstall themself
- on the new display
- "
+ prevKnownViews do:[:aView |
+ aView notNil ifTrue:[
+ aView prepareForReinit
+ ]
+ ].
+
+ "
+ 2nd round: all views should reinstall themself
+ on the new display
+ "
"/ prevMapping keysAndValuesDo:[:anId :aView |
- prevKnownViews do:[:aView |
- aView notNil ifTrue:[
- "have to re-create the view"
- aView reinitialize
- ]
- ].
- "
- 3rd round: all views get a chance to handle
- changed environment (colors, font sizes etc)
- "
+ prevKnownViews do:[:aView |
+ aView notNil ifTrue:[
+ "have to re-create the view"
+ aView reinitialize
+ ]
+ ].
+ "
+ 3rd round: all views get a chance to handle
+ changed environment (colors, font sizes etc)
+ "
"/ prevMapping keysAndValuesDo:[:anId :aView |
- prevKnownViews do:[:aView |
- aView notNil ifTrue:[
- aView reAdjustGeometry
- ]
- ]
+ prevKnownViews do:[:aView |
+ aView notNil ifTrue:[
+ aView reAdjustGeometry
+ ]
+ ]
].
dispatching := false.
!
@@ -231,7 +232,7 @@
"
keyboardMap isNil ifTrue:[
- keyboardMap := KeyboardMap new.
+ keyboardMap := KeyboardMap new.
].
"
@@ -260,14 +261,14 @@
badId := self resourceIdOfLastError.
badId ~~ 0 ifTrue:[
- badResource := self resourceOfId:badId.
+ badResource := self resourceOfId:badId.
].
msg := 'Display error: ' , (self lastError).
DeviceErrorSignal isHandled ifFalse:[
- msg printNL
+ msg printNL
] ifTrue:[
- ^ DeviceErrorSignal
- raiseRequestWith:badResource errorString:msg
+ ^ DeviceErrorSignal
+ raiseRequestWith:badResource errorString:msg
]
!
@@ -276,14 +277,14 @@
Needed for error handling"
Form allInstances do:[:f |
- f id == id ifTrue:[^ f]
+ f id == id ifTrue:[^ f]
].
self allInstances do:[:aDisplay |
- aDisplay allViewsDo:[:aView |
- aView id == id ifTrue:[^ aView].
- aView gcId == id ifTrue:[^ aView]
- ].
+ aDisplay allViewsDo:[:aView |
+ aView id == id ifTrue:[^ aView].
+ aView gcId == id ifTrue:[^ aView]
+ ].
"/ |views|
"/ views := aDisplay knownViews.
@@ -296,11 +297,11 @@
].
Color allInstances do:[:c |
- c colorId == id ifTrue:[^ c]
+ c colorId == id ifTrue:[^ c]
].
Font allInstances do:[:f |
- f fontId == id ifTrue:[^ f]
+ f fontId == id ifTrue:[^ f]
].
^ nil
! !
@@ -413,9 +414,9 @@
knownViews notNil ifTrue:[
knownViews do:[:aView |
- aView notNil ifTrue:[
- aBlock value:aView
- ]
+ aView notNil ifTrue:[
+ aBlock value:aView
+ ]
]
]
@@ -482,7 +483,8 @@
- use to find window to drop objects after a cross-view drag"
"returning nil here actually makes drag&drop impossible
- - could also be reimplemented to make a search over all knownViews here"
+ - could also be reimplemented to make a search over all knownViews here.
+ This method has to be reimplemented in concrete display classes."
^ nil
!
@@ -491,10 +493,27 @@
"given a point in window1, return the coordinate in window2
- use to xlate points from a window to rootwindow"
- "could be reimplemented to make a search over all knownViews here"
+ "This method has to be reimplemented in concrete display classes."
^ self subclassResponsibility
!
+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 searchId foundId|
+
+ searchId := RootView id.
+ [searchId notNil] whileTrue:[
+ id := self viewIdFromPoint:aPoint in:searchId.
+ foundId := searchId.
+ searchId := id
+ ].
+ view := self viewFromId:foundId.
+ ^ view
+!
+
id
"return the displayId"
@@ -535,9 +554,9 @@
visualType := aSymbol.
(visualType == #StaticGray or:[visualType == #GrayScale]) ifTrue:[
- hasColors := false
+ hasColors := false
] ifFalse:[
- hasColors := true
+ hasColors := true
]
!
@@ -748,6 +767,24 @@
knownViews := aCollection
!
+buttonTranslation
+ ^ buttonTranslation
+!
+
+multiClickTimeDelta
+ ^ multiClickTimeDelta
+!
+
+buttonTranslation:anArray
+ buttonTranslation := anArray
+!
+
+multiClickTimeDelta:milliseconds
+ multiClickTimeDelta := milliseconds
+! !
+
+!DeviceWorkstation methodsFor:'interactive queries'!
+
pointFromUser
"let user specify a point on the screen"
@@ -757,7 +794,7 @@
self ungrabPointer.
self grabPointerIn:RootView id withCursor:curs id
- pointerMode:#async keyboardMode:#sync confineTo:nil.
+ pointerMode:#async keyboardMode:#sync confineTo:nil.
ActiveGrab := RootView.
[self leftButtonPressed] whileFalse:[].
@@ -771,28 +808,30 @@
^ p
- "Display pointFromUser"
+ "
+ Display pointFromUser
+ "
!
rectangleFromUser
- "let user specify a rectangle"
-
- |curs1 curs2 p1 p2 |
+ "let user specify a rectangle in the screen, return the rectangle"
+
+ |curs1 curs2 origin corner newCorner|
curs1 := Cursor origin on:self.
curs2 := Cursor corner on:self.
self ungrabPointer.
self grabPointerIn:RootView id withCursor:curs1 id
- pointerMode:#async keyboardMode:#sync confineTo:nil.
+ pointerMode:#async keyboardMode:#sync confineTo:nil.
ActiveGrab := RootView.
[self leftButtonPressed] whileFalse:[].
- p1 := self pointerPosition.
+ origin := self pointerPosition.
self ungrabPointer.
self grabPointerIn:RootView id withCursor:curs1 id
- pointerMode:#async keyboardMode:#sync confineTo:nil.
+ pointerMode:#async keyboardMode:#sync confineTo:nil.
RootView noClipByChildren.
@@ -801,21 +840,23 @@
RootView background:Color white.
RootView xoring:[
- p2 := p1.
- RootView displayRectangle:(p1 corner:p2).
- [self leftButtonPressed] whileTrue:[
- RootView displayRectangle:(p1 corner:p2).
-
- self ungrabPointer.
- self grabPointerIn:RootView id withCursor:curs2 id
- pointerMode:#async keyboardMode:#sync confineTo:nil.
-
- p2 := self pointerPosition.
- RootView displayRectangle:(p1 corner:p2).
- self synchronizeOutput.
-
- ].
- RootView displayRectangle:(p1 corner:p2).
+ corner := origin.
+ RootView displayRectangle:(origin corner:corner).
+ [self leftButtonPressed] whileTrue:[
+ newCorner := self pointerPosition.
+ newCorner ~= corner ifTrue:[
+ RootView displayRectangle:(origin corner:corner).
+
+ self ungrabPointer.
+ self grabPointerIn:RootView id withCursor:curs2 id
+ pointerMode:#async keyboardMode:#sync confineTo:nil.
+
+ corner := newCorner.
+ RootView displayRectangle:(origin corner:corner).
+ self synchronizeOutput.
+ ]
+ ].
+ RootView displayRectangle:(origin corner:corner).
].
self ungrabPointer.
@@ -826,9 +867,11 @@
RootView clipByChildren.
- ^ p1 corner:p2
-
- "Display rectangleFromUser"
+ ^ origin corner:corner
+
+ "
+ Display rectangleFromUser
+ "
!
viewFromUser
@@ -836,24 +879,34 @@
not an st/x view, nil is returned.
(send topView to the returned view to get its root-top)"
- |view p id searchId foundId|
-
- p := self pointFromUser.
-
- "search view the point is in"
- searchId := RootView id.
- [searchId notNil] whileTrue:[
- id := self viewIdFromPoint:p in:searchId.
- foundId := searchId.
- searchId := id
+ ^ self viewFromPoint:(self pointFromUser)
+
+ "
+ Display viewFromUser
+ "
+ "
+ |v|
+ v := Display viewFromUser.
+ v notNil ifTrue:[v topView] ifFalse:[nil]
+ "
+!
+
+topviewFromUser
+ "let user specify a view on the screen; if the selected view is
+ not an st/x view, nil is returned.
+ Otherwise, the topview is returned."
+
+ |v|
+
+ v := self viewFromUser.
+ v notNil ifTrue:[
+ v := v topView
].
- view := self viewFromId:foundId.
- ^ view
-
- "Display viewFromUser"
- "|v|
- v := Display viewFromUser.
- v notNil ifTrue:[v topView] ifFalse:[nil]"
+ ^ v
+
+ "
+ Display topviewFromUser
+ "
! !
!DeviceWorkstation methodsFor:'keyboard mapping'!
@@ -866,11 +919,11 @@
xlatedKey := self translateKey:untranslatedKey.
xlatedKey notNil ifTrue:[
- someone delegate notNil ifTrue:[
- someone delegate keyPress:xlatedKey x:x y:y view:someone
- ] ifFalse:[
- someone keyPress:xlatedKey x:x y:y
- ]
+ someone delegate notNil ifTrue:[
+ someone delegate keyPress:xlatedKey x:x y:y view:someone
+ ] ifFalse:[
+ someone keyPress:xlatedKey x:x y:y
+ ]
]
!
@@ -882,11 +935,11 @@
xlatedKey := self translateKey:untranslatedKey.
xlatedKey notNil ifTrue:[
- someone delegate notNil ifTrue:[
- someone delegate keyRelease:xlatedKey x:x y:y view:someone
- ] ifFalse:[
- someone keyRelease:xlatedKey x:x y:y
- ]
+ someone delegate notNil ifTrue:[
+ someone delegate keyRelease:xlatedKey x:x y:y view:someone
+ ] ifFalse:[
+ someone keyRelease:xlatedKey x:x y:y
+ ]
]
!
@@ -903,19 +956,19 @@
xlatedKey := untranslatedKey.
controlDown ifTrue:[
- (xlatedKey size == 1) ifTrue:[ "a single character"
- xlatedKey := ('Ctrl' , untranslatedKey asString) asSymbol
- ].
+ (xlatedKey size == 1) ifTrue:[ "a single character"
+ xlatedKey := ('Ctrl' , untranslatedKey asString) asSymbol
+ ].
].
metaDown ifTrue:[
- (untranslatedKey isMemberOf:Character) ifTrue:[
- xlatedKey := ('Cmd' , untranslatedKey asString) asSymbol
- ]
+ (untranslatedKey isMemberOf:Character) ifTrue:[
+ xlatedKey := ('Cmd' , untranslatedKey asString) asSymbol
+ ]
].
altDown ifTrue:[
- (untranslatedKey isMemberOf:Character) ifTrue:[
- xlatedKey := ('Alt' , untranslatedKey asString) asSymbol
- ]
+ (untranslatedKey isMemberOf:Character) ifTrue:[
+ xlatedKey := ('Alt' , untranslatedKey asString) asSymbol
+ ]
].
xlatedKey := keyboardMap valueFor:xlatedKey.
@@ -932,36 +985,36 @@
|freeIdx newArr sz newSize id|
knownViews isNil ifTrue:[
- knownViews := WeakArray new:50. "/ OrderedCollection new:50.
- knownViews addDependent:self.
- knownIds := Array new:50.
- freeIdx := 1.
+ knownViews := WeakArray new:50. "/ OrderedCollection new:50.
+ knownViews addDependent:self.
+ knownIds := Array new:50.
+ freeIdx := 1.
] ifFalse:[
- 1 to:knownViews size do:[:idx |
- (knownViews at:idx) isNil ifTrue:[
- id := knownIds at:idx.
- id notNil ifTrue:[
- "/ this one is to be destroyed ...
- self destroyView:nil withId:id.
- knownIds at:idx put:nil.
- ].
- freeIdx := idx
- ]
- ].
+ 1 to:knownViews size do:[:idx |
+ (knownViews at:idx) isNil ifTrue:[
+ id := knownIds at:idx.
+ id notNil ifTrue:[
+ "/ this one is to be destroyed ...
+ self destroyView:nil withId:id.
+ knownIds at:idx put:nil.
+ ].
+ freeIdx := idx
+ ]
+ ].
].
freeIdx isNil ifTrue:[
- sz := knownViews size.
- newSize := sz * 2.
- newArr := WeakArray new:newSize.
- newArr replaceFrom:1 to:sz with:knownViews.
- knownViews := newArr.
- knownViews addDependent:self.
-
- newArr := Array new:newSize.
- newArr replaceFrom:1 to:sz with:knownIds.
- knownIds := newArr.
- freeIdx := sz + 1
+ sz := knownViews size.
+ newSize := sz * 2.
+ newArr := WeakArray new:newSize.
+ newArr replaceFrom:1 to:sz with:knownViews.
+ knownViews := newArr.
+ knownViews addDependent:self.
+
+ newArr := Array new:newSize.
+ newArr replaceFrom:1 to:sz with:knownIds.
+ knownIds := newArr.
+ freeIdx := sz + 1
].
knownViews at:freeIdx put:aView.
knownIds at:freeIdx put:aNumber.
@@ -979,13 +1032,13 @@
"/ lastView := nil
knownViews notNil ifTrue:[
- index := knownViews identityIndexOf:aView.
- index == 0 ifFalse:[
- knownViews at:index put:nil.
- knownIds at:index put:nil.
- lastId := nil.
- lastView := nil
- ]
+ index := knownViews identityIndexOf:aView.
+ index == 0 ifFalse:[
+ knownViews at:index put:nil.
+ knownIds at:index put:nil.
+ lastId := nil.
+ lastView := nil
+ ]
]
!
@@ -1005,20 +1058,20 @@
|id|
something == knownViews ifTrue:[
- "
- some view was garbage-collected;
- destroy it ...
- "
- 1 to:knownViews size do:[:idx |
- (knownViews at:idx) isNil ifTrue:[
- id := knownIds at:idx.
- id notNil ifTrue:[
- "/ this one is to be destroyed ...
- self destroyView:nil withId:id.
- knownIds at:idx put:nil.
- ].
- ]
- ].
+ "
+ some view was garbage-collected;
+ destroy it ...
+ "
+ 1 to:knownViews size do:[:idx |
+ (knownViews at:idx) isNil ifTrue:[
+ id := knownIds at:idx.
+ id notNil ifTrue:[
+ "/ this one is to be destroyed ...
+ self destroyView:nil withId:id.
+ knownIds at:idx put:nil.
+ ].
+ ]
+ ].
]
! !
@@ -1036,14 +1089,14 @@
"/ idToViewMapping keysAndValuesDo:[:viewId :view |
"/ self setCursor:id in:viewId
"/ ].
- knownViews do:[:aView |
- |vid|
-
- (aView notNil and:[(vid := aView id) notNil]) ifTrue:[
- self setCursor:id in:vid
- ]
- ].
- self synchronizeOutput
+ knownViews do:[:aView |
+ |vid|
+
+ (aView notNil and:[(vid := aView id) notNil]) ifTrue:[
+ self setCursor:id in:vid
+ ]
+ ].
+ self synchronizeOutput
"/ ]
]
@@ -1069,17 +1122,17 @@
"/ ]
knownViews notNil ifTrue:[
- knownViews do:[:aView |
- |c vid cid|
-
- (aView notNil and:[(vid := aView id) notNil]) ifTrue:[
- c := aView cursor.
- (c notNil and:[(cid := c id) notNil]) ifTrue:[
- self setCursor:cid in:vid
- ]
- ]
- ].
- self synchronizeOutput
+ knownViews do:[:aView |
+ |c vid cid|
+
+ (aView notNil and:[(vid := aView id) notNil]) ifTrue:[
+ c := aView cursor.
+ (c notNil and:[(cid := c id) notNil]) ifTrue:[
+ self setCursor:cid in:vid
+ ]
+ ]
+ ].
+ self synchronizeOutput
]
"Display setCursors:(Cursor wait)"
@@ -1099,61 +1152,61 @@
fd := self displayFileDescriptor.
ProcessorScheduler isPureEventDriven ifTrue:[
- "
- no threads built in;
- handle all events by having processor call a block when something
- arrives on my filedescriptor
- "
- Processor enableIOAction:[
- dispatching ifTrue:[
- [self eventPending] whileTrue:[
- self dispatchPendingEvents.
- self checkForEndOfDispatch.
- ].
- dispatching ifFalse:[
- Processor disableFd:fd
- ]
- ]
- ]
- on:fd
+ "
+ no threads built in;
+ handle all events by having processor call a block when something
+ arrives on my filedescriptor
+ "
+ Processor enableIOAction:[
+ dispatching ifTrue:[
+ [self eventPending] whileTrue:[
+ self dispatchPendingEvents.
+ self checkForEndOfDispatch.
+ ].
+ dispatching ifFalse:[
+ Processor disableFd:fd
+ ]
+ ]
+ ]
+ onInput:fd
] ifFalse:[
- "
- handle stuff as a process - sitting on a semaphore.
- Tell Processor to trigger this semaphore when something arrives
- on my filedescriptor. Since a select alone is not enough to
- know if events are pending (Xlib reads out event-queue while
- doing output), we also have to install a poll-check block.
- "
- inputSema := Semaphore new.
- p := [
- [dispatching] whileTrue:[
- self eventPending ifFalse:[
- inputSema wait.
- ].
-
- "
- in case of an error in the dispatch (i.e. WSensor
- is broken) AND user presses abort in the debugger,
- we want to continue here.
- "
- Object abortSignal catch:[
- self dispatchPendingEvents.
- ].
- self dispatchPendingEvents.
- self checkForEndOfDispatch.
-
- dispatching ifFalse:[
- Processor disableSemaphore:inputSema.
- inputSema := nil
- ]
- ]
- ] forkAt:(Processor userInterruptPriority).
- "
- give the process a nice name
- "
- p name:'event dispatcher'.
- Processor signal:inputSema onInput:fd orCheck:[self eventPending].
+ "
+ handle stuff as a process - sitting on a semaphore.
+ Tell Processor to trigger this semaphore when something arrives
+ on my filedescriptor. Since a select alone is not enough to
+ know if events are pending (Xlib reads out event-queue while
+ doing output), we also have to install a poll-check block.
+ "
+ inputSema := Semaphore new.
+ p := [
+ [dispatching] whileTrue:[
+ self eventPending ifFalse:[
+ inputSema wait.
+ ].
+
+ "
+ in case of an error in the dispatch (i.e. WSensor
+ is broken) AND user presses abort in the debugger,
+ we want to continue here.
+ "
+ Object abortSignal catch:[
+ self dispatchPendingEvents.
+ ].
+ self dispatchPendingEvents.
+ self checkForEndOfDispatch.
+
+ dispatching ifFalse:[
+ Processor disableSemaphore:inputSema.
+ inputSema := nil
+ ]
+ ]
+ ] forkAt:(Processor userInterruptPriority).
+ "
+ give the process a nice name
+ "
+ p name:'event dispatcher'.
+ Processor signal:inputSema onInput:fd orCheck:[self eventPending].
]
!
@@ -1163,17 +1216,17 @@
self == Display ifTrue:[
"/ idToViewMapping isEmpty ifTrue:[
- knownViews isEmpty ifTrue:[
- dispatching := false
- ]
+ knownViews isEmpty ifTrue:[
+ dispatching := false
+ ]
]
!
dispatchPendingEvents
Object abortSignal catch:[
- [self eventPending] whileTrue:[
- self dispatchEventFor:nil withMask:nil
- ]
+ [self eventPending] whileTrue:[
+ self dispatchEventFor:nil withMask:nil
+ ]
]
!
@@ -1194,17 +1247,17 @@
"
myFd := self displayFileDescriptor.
[aBlock value] whileTrue:[
- self eventPending ifFalse:[
- myFd isNil ifTrue:[
- OperatingSystem millisecondDelay:50
- ] ifFalse:[
- OperatingSystem selectOn:myFd withTimeOut:50.
- ].
- Processor evaluateTimeouts.
- ].
- self eventPending ifTrue:[
- self dispatchEvent
- ].
+ self eventPending ifFalse:[
+ myFd isNil ifTrue:[
+ OperatingSystem millisecondDelay:50
+ ] ifFalse:[
+ OperatingSystem selectOn:myFd withTimeOut:50.
+ ].
+ Processor evaluateTimeouts.
+ ].
+ self eventPending ifTrue:[
+ self dispatchEvent
+ ].
]
!
@@ -1245,7 +1298,7 @@
"flush all events pending on this display"
[self eventPending] whileTrue:[
- self getEventFor:nil withMask:nil
+ self getEventFor:nil withMask:nil
].
!
@@ -1281,9 +1334,9 @@
extension (you won't find it in standard X-servers).
type: 0 -> uncompressed
- 1 -> group3 1D (k is void)
- 2 -> group3 2D
- 3 -> group4 2D (k is void)
+ 1 -> group3 1D (k is void)
+ 2 -> group3 2D
+ 3 -> group4 2D (k is void)
"
^ nil
@@ -1365,10 +1418,10 @@
"/ old:
"/ family := fntDescr at:1.
"/ new:
- family := fntDescr family.
- family notNil ifTrue:[
- families add:family
- ]
+ family := fntDescr family.
+ family notNil ifTrue:[
+ families add:family
+ ]
].
^ families
@@ -1394,9 +1447,9 @@
"/ faces add:face
"/ ]
"/ new:
- fntDescr family = aFamilyName ifTrue:[
- faces add:(fntDescr face)
- ]
+ fntDescr family = aFamilyName ifTrue:[
+ faces add:(fntDescr face)
+ ]
].
^ faces
@@ -1425,11 +1478,11 @@
"/ styles add:style
"/ ]
"/ ]
- (fntDescr family = aFamilyName) ifTrue:[
- (fntDescr face = aFaceName) ifTrue:[
- styles add:fntDescr style
- ]
- ]
+ (fntDescr family = aFamilyName) ifTrue:[
+ (fntDescr face = aFaceName) ifTrue:[
+ styles add:fntDescr style
+ ]
+ ]
].
^ styles
@@ -1461,13 +1514,13 @@
"/ ]
"/ ]
"/ ]
- (fntDescr family = aFamilyName) ifTrue:[
- (fntDescr face = aFaceName) ifTrue:[
- (fntDescr style = aStyleName) ifTrue:[
- sizes add:fntDescr size
- ]
- ]
- ]
+ (fntDescr family = aFamilyName) ifTrue:[
+ (fntDescr face = aFaceName) ifTrue:[
+ (fntDescr style = aStyleName) ifTrue:[
+ sizes add:fntDescr size
+ ]
+ ]
+ ]
].
^ sizes
@@ -1477,10 +1530,10 @@
!
getFontWithFamily:familyString
- face:faceString
- style:styleString
- size:sizeArg
- encoding:encodingSym
+ face:faceString
+ style:styleString
+ size:sizeArg
+ encoding:encodingSym
"try to get the specified font, return id.
If not available, try next smaller font.
@@ -1617,7 +1670,7 @@
"support some of them ..."
self getRGBFromName:aString into:[:r :g :b |
- ^ self colorRed:r green:g blue:b
+ ^ self colorRed:r green:g blue:b
].
^ nil
!
@@ -1646,23 +1699,23 @@
names := #('red' 'green' 'blue' 'yellow' 'magenta' 'cyan' 'white' 'black').
idx := names indexOf:colorName.
idx == 0 ifTrue:[
- idx := (names asLowercase) indexOf:colorName.
+ idx := (names asLowercase) indexOf:colorName.
].
idx == 0 ifFalse:[
- triple := #(
- (100 0 0) "red"
- ( 0 100 0) "green"
- ( 0 0 100) "blue"
- (100 100 0) "yellow"
- (100 0 100) "magenta"
- ( 0 100 100) "cyan"
- (100 100 100) "white"
- ( 0 0 0) "black"
- ) at:idx.
+ triple := #(
+ (100 0 0) "red"
+ ( 0 100 0) "green"
+ ( 0 0 100) "blue"
+ (100 100 0) "yellow"
+ (100 0 100) "magenta"
+ ( 0 100 100) "cyan"
+ (100 100 100) "white"
+ ( 0 0 0) "black"
+ ) at:idx.
- ^ aBlock value:(triple at:1)
- value:(triple at:2)
- value:(triple at:3)
+ ^ aBlock value:(triple at:1)
+ value:(triple at:2)
+ value:(triple at:3)
].
^ nil
!
@@ -1906,12 +1959,12 @@
"should be redefined to avoid creation of throw-away string"
self displayString:(aString copyFrom:i1 to:i2)
- x:x
- y:y
- in:aDrawableId
- with:aGCId
- round:round
- opaque:opaque
+ x:x
+ y:y
+ in:aDrawableId
+ with:aGCId
+ round:round
+ opaque:opaque
!
displayString:aString x:x y:y in:aDrawableId with:aGCId
@@ -1919,12 +1972,12 @@
If the coordinates are not integers, retry with rounded."
self displayString:aString
- x:x
- y:y
- in:aDrawableId
- with:aGCId
- round:true
- opaque:false
+ x:x
+ y:y
+ in:aDrawableId
+ with:aGCId
+ round:true
+ opaque:false
!
displayString:aString from:index1 to:index2 x:x y:y in:aDrawableId with:aGCId
@@ -1932,14 +1985,14 @@
If the coordinates are not integers, retry with rounded."
self displayString:aString
- from:index1
- to:index2
- x:x
- y:y
- in:aDrawableId
- with:aGCId
- round:true
- opaque:false
+ from:index1
+ to:index2
+ x:x
+ y:y
+ in:aDrawableId
+ with:aGCId
+ round:true
+ opaque:false
!
displayOpaqueString:aString x:x y:y in:aDrawableId with:aGCId
@@ -1947,12 +2000,12 @@
If the coordinates are not integers, retry with rounded."
self displayString:aString
- x:x
- y:y
- in:aDrawableId
- with:aGCId
- round:true
- opaque:true
+ x:x
+ y:y
+ in:aDrawableId
+ with:aGCId
+ round:true
+ opaque:true
!
displayOpaqueString:aString from:index1 to:index2 x:x y:y in:aDrawableId with:aGCId
@@ -1960,14 +2013,14 @@
If the coordinates are not integers, retry with rounded."
self displayString:aString
- from:index1
- to:index2
- x:x
- y:y
- in:aDrawableId
- with:aGCId
- round:true
- opaque:true
+ from:index1
+ to:index2
+ x:x
+ y:y
+ in:aDrawableId
+ with:aGCId
+ round:true
+ opaque:true
!
displayPointX:x y:y in:aDrawableId with:aGCId
@@ -1998,35 +2051,35 @@
!
copyFromFaxImage:sourceId x:srcX y:srcY to:destId x:dstX y:dstY
- width:w height:h with:aGCId scaleX:scaleX scaleY:scaleY
+ width:w height:h with:aGCId scaleX:scaleX scaleY:scaleY
"do a bit-blt"
^ self subclassResponsibility
!
copyFromId:sourceId x:srcX y:srcY to:destId x:dstX y:dstY
- width:w height:h with:aGCId
+ width:w height:h with:aGCId
"do a bit-blt"
^ self subclassResponsibility
!
copyPlaneFromId:sourceId x:srcX y:srcY to:destId x:dstX y:dstY
- width:w height:h with:aGCId
+ width:w height:h with:aGCId
"do a bit-blt"
^ self subclassResponsibility
!
displayArcX:x y:y w:width h:height from:startAngle angle:angle
- in:aDrawableId with:aGCId
+ in:aDrawableId with:aGCId
"draw an arc"
^ self subclassResponsibility
!
fillArcX:x y:y w:width h:height from:startAngle angle:angle
- in:aDrawableId with:aGCId
+ in:aDrawableId with:aGCId
"fill an arc"
^ self subclassResponsibility
@@ -2045,8 +2098,8 @@
!
drawBits:imageBits depth:imageDepth width:imageWidth height:imageHeight
- x:srcx y:srcy
- into:aDrawableId x:dstx y:dsty width:w height:h with:aGCId
+ x:srcx y:srcy
+ into:aDrawableId x:dstx y:dsty width:w height:h with:aGCId
"draw a bitimage which has depth id, width iw and height ih into
the drawable. draw a region of w/h pixels from srcx/srcy to dstx/dsty.