--- a/DeviceWorkstation.st Mon Feb 06 01:30:10 1995 +0100
+++ b/DeviceWorkstation.st Mon Feb 06 01:38:04 1995 +0100
@@ -34,7 +34,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.22 1994-11-28 21:00:42 claus Exp $
+$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.23 1995-02-06 00:36:13 claus Exp $
'!
!DeviceWorkstation class methodsFor:'documentation'!
@@ -55,7 +55,7 @@
version
"
-$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.22 1994-11-28 21:00:42 claus Exp $
+$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.23 1995-02-06 00:36:13 claus Exp $
"
!
@@ -402,7 +402,7 @@
^ self subclassResponsibility
! !
-!DeviceWorkstation methodsFor:'enumeration'!
+!DeviceWorkstation methodsFor:'enumerating'!
allViewsDo:aBlock
"evaluate the argument, aBlock for all known views"
@@ -1008,14 +1008,17 @@
"forward a key-press event to some handler;
the key is translated via the translation table here."
- |xlatedKey|
+ |xlatedKey delegate dest|
xlatedKey := self translateKey:untranslatedKey.
xlatedKey notNil ifTrue:[
- someone delegate notNil ifTrue:[
- someone delegate keyPress:xlatedKey x:x y:y view:someone
+ (delegate := someone delegate) notNil ifTrue:[
+ delegate keyPress:xlatedKey x:x y:y view:someone
] ifFalse:[
- someone keyPress:xlatedKey x:x y:y
+ (dest := someone controller) isNil ifTrue:[
+ dest := someone
+ ].
+ dest keyPress:xlatedKey x:x y:y
]
]
!
@@ -1024,24 +1027,38 @@
"forward a key-release event to some handler;
the key is translated via the translation table here."
- |xlatedKey|
+ |xlatedKey delegate dest|
xlatedKey := self translateKey:untranslatedKey.
xlatedKey notNil ifTrue:[
- someone delegate notNil ifTrue:[
- someone delegate keyRelease:xlatedKey x:x y:y view:someone
+ (delegate := someone delegate) notNil ifTrue:[
+ delegate keyRelease:xlatedKey x:x y:y view:someone
] ifFalse:[
- someone keyRelease:xlatedKey x:x y:y
+ (dest := someone controller) isNil ifTrue:[
+ dest := someone
+ ].
+ dest keyRelease:xlatedKey x:x y:y
]
]
!
translateKey:untranslatedKey
"Return the key translated via the translation table.
+ Your application program should never depend on the values returned
+ by this method, but instead use symbolic keys (such as #FindNext).
+ Doing so allows easier reconfiguration by changing the translation map
+ in the 'smalltalk.rc' or 'display.rc' startup files.
First, the modifier is prepended, making character X into
AltX, CtrlX or CmdX (on most systems, no separate Cmd (or Meta)
key exists; on those we always get AltX).
+ If multiple modifiers are active, the symbol becoms the concatenation
+ as in AltCtrlq (for control-alt-q). Shift will affect the last component,
+ thus the above with shift becoms: AltCtrlQ instead.
+ Some keyboards offer both Alt and Meta keys - on those, the first has a
+ prefix of Alt, the second has Cmd as prefix. Keyboards with only an Alt
+ key will will create prefix codes of Cmd for that.
+ For symbolic keys (i.e.Tab, Backspace etc, shift is ignored).
Then the result is used as a key into the translation keyboardMap
to get the final return value."
@@ -1049,19 +1066,13 @@
xlatedKey := untranslatedKey.
controlDown ifTrue:[
- (xlatedKey size == 1) ifTrue:[ "a single character"
- xlatedKey := ('Ctrl' , untranslatedKey asString) asSymbol
- ].
+ xlatedKey := ('Ctrl' , xlatedKey asString) asSymbol
].
metaDown ifTrue:[
- (untranslatedKey isMemberOf:Character) ifTrue:[
- xlatedKey := ('Cmd' , untranslatedKey asString) asSymbol
- ]
+ xlatedKey := ('Cmd' , xlatedKey asString) asSymbol
].
altDown ifTrue:[
- (untranslatedKey isMemberOf:Character) ifTrue:[
- xlatedKey := ('Alt' , untranslatedKey asString) asSymbol
- ]
+ xlatedKey := ('Alt' , xlatedKey asString) asSymbol
].
xlatedKey := keyboardMap valueFor:xlatedKey.
@@ -1510,15 +1521,12 @@
allFonts isNil ifTrue:[^ nil].
families := Set new.
allFonts do:[:fntDescr |
-"/ old:
-"/ family := fntDescr at:1.
-"/ new:
family := fntDescr family.
family notNil ifTrue:[
families add:family
]
].
- ^ families
+ ^ families asSortedCollection
"
Display fontFamilies
@@ -1535,18 +1543,11 @@
faces := Set new.
allFonts do:[:fntDescr |
-"/ old:
-"/ family := fntDescr at:1.
-"/ (family = aFamilyName) ifTrue:[
-"/ face := fntDescr at:2.
-"/ faces add:face
-"/ ]
-"/ new:
aFamilyName = fntDescr family ifTrue:[
faces add:(fntDescr face)
]
].
- ^ faces
+ ^ faces asSortedCollection
"
Display facesInFamily:'times'
@@ -1564,22 +1565,13 @@
styles := Set new.
allFonts do:[:fntDescr |
-"/ old:
-"/ family := fntDescr at:1.
-"/ (family = aFamilyName) ifTrue:[
-"/ face := fntDescr at:2.
-"/ (face = aFaceName) ifTrue:[
-"/ style := fntDescr at:3.
-"/ styles add:style
-"/ ]
-"/ ]
(aFamilyName = fntDescr family) ifTrue:[
(aFaceName = fntDescr face) ifTrue:[
styles add:fntDescr style
]
]
].
- ^ styles
+ ^ styles asSortedCollection
"
Display stylesInFamily:'times' face:'medium'
@@ -1844,6 +1836,24 @@
^ self subclassResponsibility
!
+redComponentOfColor:colorId
+ "get red component (0..100) of color in map at:index"
+
+ self getRGBFrom:colorId into:[:r :g :b | ^ r]
+!
+
+greenComponentOfColor:colorId
+ "get green component (0..100) of color in map at:index"
+
+ self getRGBFrom:colorId into:[:r :g :b | ^ g]
+!
+
+blueComponentOfColor:colorId
+ "get blue component (0..100) of color in map at:index"
+
+ self getRGBFrom:colorId into:[:r :g :b | ^ b]
+!
+
getRGBFromName:colorName into:aBlock
"get rgb components (0..100) of color named colorName,
and evaluate the 3-arg block, aBlock with them.