--- a/Color.st Wed Mar 30 03:25:26 1994 +0200
+++ b/Color.st Wed Mar 30 12:13:08 1994 +0200
@@ -28,14 +28,14 @@
see Color documentation for more info
-$Header: /cvs/stx/stx/libview/Color.st,v 1.10 1994-02-25 13:09:54 claus Exp $
+$Header: /cvs/stx/stx/libview/Color.st,v 1.11 1994-03-30 10:10:51 claus Exp $
totally rewritten summer 92 by claus (from XColor)
'!
!Color class methodsFor:'documentation'!
documentation
- "
+"
Color represents colors in a device independent manner, main info I keep about
mySelf are the red, green and blue components in percent (0 .. 100).
The device specific color can be aquired by sending a color the 'on:aDevice' message,
@@ -84,7 +84,7 @@
%W% %E%
totally rewritten summer 92 by claus (from XColor)
- "
+"
! !
!Color class methodsFor:'initialization'!
@@ -287,6 +287,12 @@
^ Blue
!
+yellow
+ "return yellow - ST-80 compatibility"
+
+ ^ self red:100 green:100 blue:0
+!
+
red:r green:g blue:b
"return a color from red, green and blue values;
the arguments, r, g and b are interpreted as percent (0..100)"
@@ -1471,7 +1477,8 @@
"two colors are considered equal, if the color components are;
independent of the device, the color is on"
- (aColor isKindOf:Color) ifTrue:[
+ aColor == self ifTrue:[^ self].
+ aColor isColor ifTrue:[
(redVal = aColor red) ifTrue:[
(greenVal = aColor green) ifTrue:[
(blueVal = aColor blue) ifTrue:[
@@ -1481,6 +1488,13 @@
]
].
^ false
+!
+
+hash
+ "return an integer useful as hash key for the receiver.
+ Redefined since = is redefined"
+
+ ^ redVal hash + greenVal hash + redVal hash
! !
!Color methodsFor:'instance creation'!
@@ -1505,6 +1519,12 @@
!Color methodsFor:'queries'!
+isColor
+ "return true if the receivir is a Color."
+
+ ^ true
+!
+
isGreyColor
"return true, if this color is a grey one -
i.e. red = green = blue"
@@ -1518,45 +1538,47 @@
!Color methodsFor:'accessing'!
red
- "return the red component in percent"
+ "return the red component in percent [0..100]"
^ redVal
!
green
- "return the green component in percent"
+ "return the green component in percent [0..100]"
^ greenVal
!
blue
- "return the blue component in percent"
+ "return the blue component in percent [0..100]"
^ blueVal
!
greyIntensity
- "return the grey intensity in percent"
+ "return the grey intensity in percent [0..100]"
^ (0.3 * redVal) + (0.6 * greenVal) + (0.1 * blueVal)
!
brightness
- "ST80 compatibility: return the grey intensity in 0..1"
+ "ST80 compatibility: return the grey intensity in [0..1]"
^ ((0.3 * redVal) + (0.6 * greenVal) + (0.1 * blueVal)) / 100
!
hue
- "return the hue"
+ "return the hue in degrees [0..360)"
self class withHLSFromRed:redVal green:greenVal blue:blueVal do:[:h :l :s |
^ h
]
+
+ "Color yellow hue"
!
light
- "return the hue"
+ "return the light in percent [0..100]"
self class withHLSFromRed:redVal green:greenVal blue:blueVal do:[:h :l :s |
^ l
@@ -1564,7 +1586,7 @@
!
saturation
- "return the hue"
+ "return the saturation in percent [0..100]"
self class withHLSFromRed:redVal green:greenVal blue:blueVal do:[:h :l :s |
^ s
@@ -1590,25 +1612,34 @@
!
deviceRedValue
- "return the value of the red component in device metrics"
+ "return the value of the red component in device metrics.
+ (usually 16bit in X; but could be different on other systems)"
^ device redComponentOfColor:colorId
+
+ "
+ (Color yellow on:Display) deviceRedValue
+ (Color yellow on:aPrinterPage) deviceRedValue
+ "
!
deviceGreenValue
- "return the value of the green component in device metrics"
+ "return the value of the green component in device metrics.
+ (usually 16bit in X; but could be different on other systems)"
^ device greenComponentOfColor:colorId
!
deviceBlueValue
- "return the value of the blue component in device metrics"
+ "return the value of the blue component in device metrics.
+ (usually 16bit in X; but could be different on other systems)"
^ device blueComponentOfColor:colorId
!
deviceRedValue:r deviceGreenValue:g deviceBlueValue:b
- "set r/g/b components in device metrics"
+ "set r/g/b components in device metrics.
+ (usually 16bit values in X; but could be different on other systems)"
device setColor:colorId red:r green:g blue:b
! !
--- a/Cursor.st Wed Mar 30 03:25:26 1994 +0200
+++ b/Cursor.st Wed Mar 30 12:13:08 1994 +0200
@@ -31,7 +31,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Cursor.st,v 1.7 1994-02-25 13:10:15 claus Exp $
+$Header: /cvs/stx/stx/libview/Cursor.st,v 1.8 1994-03-30 10:11:08 claus Exp $
see Cursor class documentation for info.
@@ -41,30 +41,30 @@
!Cursor class methodsFor:'documentation'!
documentation
- "
-I represents cursors in a device independent manner.
+"
+ I represents cursors in a device independent manner.
-Instance variables:
+ Instance variables:
-shape <Symbol> a shape (i.e. #arrow, #hand, ...) or nil
-sourceForm <Form> if shape is nil, the source bits
-maskForm <Form> if shape is nil, the mask bits
-hotX <SmallInteger> if shape is nil, the hotSpot x of the cursor
-hotY <SmallInteger> if shape is nil, the hotSpot y of the cursor
-device <aDevice> the device, if associated to one
-cursorId <anObject> the device-specific id if device is nonNil
+ shape <Symbol> a shape (i.e. #arrow, #hand, ...) or nil
+ sourceForm <Form> if shape is nil, the source bits
+ maskForm <Form> if shape is nil, the mask bits
+ hotX <SmallInteger> if shape is nil, the hotSpot x of the cursor
+ hotY <SmallInteger> if shape is nil, the hotSpot y of the cursor
+ device <aDevice> the device, if associated to one
+ cursorId <anObject> the device-specific id if device is nonNil
-class variables:
+ class variables:
-Lobby <Registry> keeps track of known device cursors
+ Lobby <Registry> keeps track of known device cursors
-DefaultFgColor <Color> default foreground color for cursors (usually black)
-DefaultBgColor <Color> default background color for cursors (usually white)
+ DefaultFgColor <Color> default foreground color for cursors (usually black)
+ DefaultBgColor <Color> default background color for cursors (usually white)
-NormalCursor <Cursor> cached instance of normal (arrow) cursor
- ...
+ NormalCursor <Cursor> cached instance of normal (arrow) cursor
+ ...
- "
+"
! !
!Cursor class methodsFor:'initialization'!
@@ -680,7 +680,7 @@
shape notNil ifTrue:[
id := aDevice createCursorShape:shape.
id isNil ifTrue:[
- 'no cursor with shape:' print. shape printNewline.
+ 'no cursor with shape:' errorPrint. shape errorPrintNewline.
^ nil
].
] ifFalse:[
@@ -689,7 +689,7 @@
hotX:hotX
hotY:hotY.
id isNil ifTrue:[
- 'cannot create cursor' printNewline.
+ 'cannot create cursor' errorPrintNewline.
^ nil
].
].
--- a/Depth1Image.st Wed Mar 30 03:25:26 1994 +0200
+++ b/Depth1Image.st Wed Mar 30 12:13:08 1994 +0200
@@ -23,7 +23,7 @@
this class represents bilevel (1 bit / pixel) images
-$Header: /cvs/stx/stx/libview/Depth1Image.st,v 1.4 1994-02-25 13:10:17 claus Exp $
+$Header: /cvs/stx/stx/libview/Depth1Image.st,v 1.5 1994-03-30 10:11:25 claus Exp $
written summer 93 by claus
'!
@@ -109,7 +109,10 @@
Pixels start at x=0 , y=0 for upper left pixel, end at
x = width-1, y=height-1 for lower right pixel"
- |lineIndex byte shift value|
+ |lineIndex "{ Class: SmallInteger }"
+ byte "{ Class: SmallInteger }"
+ shift "{ Class: SmallInteger }"
+ value "{ Class: SmallInteger }"|
lineIndex := (self bytesPerRow * y) + 1.
@@ -133,9 +136,10 @@
self error:'format not supported'.
^ nil
].
- ^ Color red:(((colorMap at:1) at:(value + 1)) * 100 / 255)
- green:(((colorMap at:2) at:(value + 1)) * 100 / 255)
- blue:(((colorMap at:3) at:(value + 1)) * 100 / 255)
+ value := value + 1.
+ ^ Color red:(((colorMap at:1) at:value) * (100.0 / 255.0))
+ green:(((colorMap at:2) at:value) * (100.0 / 255.0))
+ blue:(((colorMap at:3) at:value) * (100.0 / 255.0))
!
atX:x y:y putValue:aPixelValue
@@ -193,46 +197,37 @@
in the image; i.e. for b/w images, the color MUST be black
or white; for palette images it must be present in the palette."
- |value|
+ |clr0 clr1|
photometric == #whiteIs0 ifTrue:[
- aColor = Color white ifTrue:[
- value := 0
- ] ifFalse:[
- aColor = Color black ifTrue:[
- value := 1
- ] ifFalse:[
- self error:'invalid color'
- ]
- ]
+ clr0 := Color whilte.
+ clr1 := Color black.
] ifFalse:[
photometric == #blackIs0 ifTrue:[
- aColor = Color black ifTrue:[
- value := 0
- ] ifFalse:[
- aColor = Color white ifTrue:[
- value := 1
- ] ifFalse:[
- self error:'invalid color'
- ]
- ]
+ clr0 := Color black.
+ clr1 := Color whilte.
] ifFalse:[
photometric ~~ #palette ifTrue:[
self error:'format not supported'.
^ nil
].
- (aColor = colorMap at:1) ifTrue:[
- value := 0
- ] ifFalse:[
- (aColor = colorMap at:2) ifTrue:[
- value := 0
- ] ifFalse:[
- self error:'invalid color'
- ]
- ]
+ clr0 := colorMap at:1.
+ clr1 := colorMap at:2.
]
].
- self atX:x y:y putValue:value
+ aColor = clr0 ifTrue:[
+ self atX:x y:y putValue:0.
+ ^ self
+ ].
+ aColor = clr1 ifTrue:[
+ self atX:x y:y putValue:1.
+ ^ self
+ ].
+ "
+ the color to be stored is not in the images
+ colormap
+ "
+ self error:'invalid color'
!
atY:y from:xLow to:xHigh do:aBlock
--- a/Depth24Image.st Wed Mar 30 03:25:26 1994 +0200
+++ b/Depth24Image.st Wed Mar 30 12:13:08 1994 +0200
@@ -23,7 +23,7 @@
this class represents truecolor (24 bit / pixel) images
-$Header: /cvs/stx/stx/libview/Depth24Image.st,v 1.3 1994-02-25 13:10:20 claus Exp $
+$Header: /cvs/stx/stx/libview/Depth24Image.st,v 1.4 1994-03-30 10:11:45 claus Exp $
written summer 93 by claus
'!
@@ -66,7 +66,8 @@
Pixels start at x=0 , y=0 for upper left pixel, end at
x = width-1, y=height-1 for lower right pixel"
- |index rVal gVal bVal|
+ |index "{ Class: SmallInteger }"
+ rVal gVal bVal|
index := 1 + (((width * y) + x) * 3).
rVal := bytes at:(index).
@@ -873,8 +874,7 @@
blueArray at:b put:true.
nColors := nColors + 1.
(nColors > nColorCells) ifTrue:[
- 'more than ' print. nColorCells print.
- ' colors' printNewline.
+ 'D24IMAGE: more than ' errorPrint. nColorCells errorPrint. ' colors' errorPrintNewline.
srcIndex := dataSize + 1
]
]
@@ -893,12 +893,15 @@
gMask := (gMask bitShift:1) bitAnd:2r11111111.
bMask := (bMask bitShift:1) bitAnd:2r11111111
].
+ 'D24IMAGE: retry with less color resolution' errorPrintNewline.
+"
'masks:' print. rMask print. ' ' print. gMask print. ' ' print.
bMask printNewline
+"
]
].
- nColors print. ' colors used' printNewline.
+ 'D24IMAGE: ' errorPrint. nColors errorPrint. ' colors used' errorPrintNewline.
colors := Array new:nColors.
colorIndex := 1.
@@ -940,7 +943,7 @@
"again with less color bits if we didnt get all colors"
fit ifFalse:[
- 'still no fit' printNewline.
+ 'D24IMAGE: still no fit' errorPrintNewline.
"free the allocated colors"
colors atAllPut:nil.
@@ -1092,7 +1095,7 @@
_dstP[0] = sP[0];
_dstP[1] = sP[1];
_dstP[2] = sP[2];
- _dstP += 3;
+ _dstP += 3;
}
}
%}
--- a/Depth2Image.st Wed Mar 30 03:25:26 1994 +0200
+++ b/Depth2Image.st Wed Mar 30 12:13:08 1994 +0200
@@ -23,7 +23,7 @@
this class represents (2 bit / pixel) images (i.e. NeXT images)
-$Header: /cvs/stx/stx/libview/Depth2Image.st,v 1.4 1994-02-25 13:10:24 claus Exp $
+$Header: /cvs/stx/stx/libview/Depth2Image.st,v 1.5 1994-03-30 10:12:01 claus Exp $
written summer 93 by claus
'!
@@ -72,7 +72,9 @@
Pixels start at x=0 , y=0 for upper left pixel, end at
x = width-1, y=height-1 for lower right pixel"
- |lineIndex byte shift value|
+ |lineIndex "{ Class: SmallInteger }"
+ byte "{ Class: SmallInteger }"
+ shift "{ Class: SmallInteger }" |
lineIndex := (self bytesPerRow * y) + 1.
@@ -87,7 +89,10 @@
Pixels start at x=0 , y=0 for upper left pixel, end at
x = width-1, y=height-1 for lower right pixel"
- |lineIndex byte shift value|
+ |lineIndex "{ Class: SmallInteger }"
+ byte "{ Class: SmallInteger }"
+ shift "{ Class: SmallInteger }"
+ value "{ Class: SmallInteger }" |
lineIndex := (self bytesPerRow * y) + 1.
@@ -123,9 +128,10 @@
self error:'format not supported'.
^ nil
].
- ^ Color red:(((colorMap at:1) at:(value + 1)) * 100 / 255)
- green:(((colorMap at:2) at:(value + 1)) * 100 / 255)
- blue:(((colorMap at:3) at:(value + 1)) * 100 / 255)
+ value := value + 1.
+ ^ Color red:(((colorMap at:1) at:value) * (100.0 / 255.0))
+ green:(((colorMap at:2) at:value) * (100.0 / 255.0))
+ blue:(((colorMap at:3) at:value) * (100.0 / 255.0))
!
atX:x y:y putValue:aPixelValue
@@ -133,7 +139,10 @@
Pixels start at x=0 , y=0 for upper left pixel, end at
x = width-1, y=height-1 for lower right pixel"
- |lineIndex index byte shift|
+ |lineIndex "{ Class: SmallInteger }"
+ index "{ Class: SmallInteger }"
+ byte "{ Class: SmallInteger }"
+ shift "{ Class: SmallInteger }" |
lineIndex := (self bytesPerRow * y) + 1.
--- a/Depth8Image.st Wed Mar 30 03:25:26 1994 +0200
+++ b/Depth8Image.st Wed Mar 30 12:13:08 1994 +0200
@@ -23,7 +23,7 @@
this class represents 8 bit / pixel images (palette, greyscale ...)
-$Header: /cvs/stx/stx/libview/Depth8Image.st,v 1.7 1994-02-25 13:10:29 claus Exp $
+$Header: /cvs/stx/stx/libview/Depth8Image.st,v 1.8 1994-03-30 10:12:25 claus Exp $
written summer 93 by claus
'!
@@ -66,7 +66,8 @@
Pixels start at x=0 , y=0 for upper left pixel, end at
x = width-1, y=height-1 for lower right pixel"
- |value index|
+ |value "{ Class: SmallInteger }"
+ index "{ Class: SmallInteger }"|
index := (width * y) + 1 + x.
value := bytes at:index.
@@ -196,9 +197,10 @@
pixel0bytes := ByteArray uninitializedNew:nColors.
pixel1bytes := ByteArray uninitializedNew:nColors.
- "extract dither patterns and values to use for 1/0 bits
- in those from the dithercolors"
-
+ "
+ extract dither patterns and values to use for 1/0 bits
+ in those from the dithercolors
+ "
1 to:nColors do:[:i |
clr := (map at:i) on:aDevice.
ditherPattern := clr ditherForm.
@@ -438,9 +440,9 @@
v := ((3 * r) + (6 * g) + (1 * b)) // 10.
v := v bitShift:-7. "only keep hi-bit"
(v == 1) ifTrue:[
- map at:i put:1
+ map at:i put:0 "was: 1"
] ifFalse:[
- map at:i put:0
+ map at:i put:1 "was: 0"
]
]
].
@@ -508,10 +510,10 @@
f := Form width:w height:h depth:1 on:aDevice.
f isNil ifTrue:[^ nil].
f initGC.
- (aDevice blackpixel == 0) ifFalse:[
- "have to invert bits"
- f function:#copyInverted
- ].
+"/ (aDevice blackpixel == 0) ifFalse:[
+"/ "have to invert bits"
+"/ f function:#copyInverted
+"/ ].
aDevice drawBits:monoBits depth:1 width:w height:h
x:0 y:0
into:(f id) x:0 y:0 width:w height:h with:(f gcId).
@@ -638,7 +640,7 @@
shift "{Class: SmallInteger }"
m "{Class: SmallInteger }" |
- 'IMAGE: allocating colors ...' printNewline.
+ 'D8IMAGE: allocating colors ...' errorPrintNewline.
"find used colors"
@@ -768,9 +770,9 @@
].
error > 100 ifTrue:[
- 'not enough colors for a reasonable image' printNewline
+ 'D8Image: not enough colors for a reasonable image' errorPrintNewline
] ifFalse:[
- 'not enough colors for exact picture' printNewline.
+ 'D8Image: not enough colors for exact picture' errorPrintNewline.
]
].
--- a/DevDraw.st Wed Mar 30 03:25:26 1994 +0200
+++ b/DevDraw.st Wed Mar 30 12:13:08 1994 +0200
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/DevDraw.st,v 1.7 1994-01-09 21:51:31 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DevDraw.st,v 1.8 1994-03-30 10:12:43 claus Exp $
totally rewritten (from XDrawable) summer 92 by claus
'!
@@ -32,19 +32,20 @@
documentation
"
-I represent any drawable on a display device (i.e. Bitmaps, Pixmaps, RootWindow and Windows in Xs world).
-My instance variables are mainly caching device-related stuff (such as font- and color-Ids)
-to avoid needless message traffic. This class is abstract, no direct instances of it
-exist in the system.
-
-Instance variables:
+ I represent any drawable on a device (i.e. Bitmaps, Pixmaps, RootWindow and Windows in Xs world).
+ My instance variables are mainly caching device-related stuff (such as font- and color-Ids)
+ to avoid needless message traffic. This class is abstract, no direct instances of it
+ exist in the system.
+ All real work is done by my device, most drawing requests are simply forwarded to it.
-device <Device> the device this drawable is on
-deviceId <SmallInteger> cached (device id)
-drawableId <SmallInteger> my drawableId on the device
-gcId <SmallInteger> my gcs ID on the device
-realized <Boolean> true if visible (i.e. mapped)
- - for pixmaps this is always true
+ Instance variables:
+
+ device <Device> the device this drawable is on
+ deviceId <SmallInteger> cached (device id)
+ drawableId <SmallInteger> my drawableId on the device
+ gcId <SmallInteger> my gcs ID on the device
+ realized <Boolean> true if visible (i.e. mapped)
+ - for bit/pixmaps this is always true
"
! !
@@ -82,7 +83,7 @@
"make shure Workstation is initialized - just a check - will vanish soon"
Display isNil ifTrue:[
- 'Warning: Display not initialized when first DeviceDrawable created' printNewline.
+ 'DEVDRAW: Display not initialized when first DeviceDrawable created' errorPrintNewline.
Workstation initialize
].
@@ -214,8 +215,8 @@
!
reinitialize
- 'reinit of ' print. self classNameWithArticle print.
- ' failed' printNewline
+ 'reinit of ' errorPrint. self classNameWithArticle errorPrint.
+ ' failed' errorPrintNewline
! !
!DeviceDrawable methodsFor:'accessing'!
@@ -1053,7 +1054,7 @@
bitmap will be nil. This will be fixed soon."
id isNil ifTrue:[
- 'invalid bitmap copy - ignored' printNewline.
+ 'DEVDRAW: invalid bitmap copy - ignored' errorPrintNewline.
^ self
].
@@ -1101,7 +1102,7 @@
"temporary ..."
id isNil ifTrue:[
- 'invalid form draw - ignored' printNewline.
+ 'DEVDRAW: invalid form draw - ignored' errorPrintNewline.
^ self
].
gcId isNil ifTrue:[
--- a/DevWorkst.st Wed Mar 30 03:25:26 1994 +0200
+++ b/DevWorkst.st Wed Mar 30 12:13:08 1994 +0200
@@ -34,7 +34,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/DevWorkst.st,v 1.10 1994-01-09 21:53:00 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DevWorkst.st,v 1.11 1994-03-30 10:13:08 claus Exp $
written jan 93 by claus
'!
@@ -42,47 +42,47 @@
documentation
"
-this abstract class defines common protocol to all Display types.
+ this abstract class defines common protocol to all Display types.
-instance variables:
+ instance variables:
-displayId <Number> the device id of the display
-visualType <Symbol> one of #StaticGray, #PseudoColor, ... #TrueColor
-monitorType <Symbol> one of #monochrome, #color, #unknown
+ displayId <Number> the device id of the display
+ visualType <Symbol> one of #StaticGray, #PseudoColor, ... #TrueColor
+ monitorType <Symbol> one of #monochrome, #color, #unknown
-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)
-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
-height <Integer> number of vertical pixels
-heightMM <Number> screen height in millimeter
-widthMM <Number> screen width in millimeter
-resolutionHor <Number> pixels per horizontal millimeter
-resolutionVer <Number> pixels per vertical millimeter
+ 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)
+ 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
+ height <Integer> number of vertical pixels
+ heightMM <Number> screen height in millimeter
+ widthMM <Number> screen width in millimeter
+ resolutionHor <Number> pixels per horizontal millimeter
+ resolutionVer <Number> pixels per vertical millimeter
-knownViews <Collection> all views known
-knownIds <Collection> corresponding device-view ids
-knownBitmaps <Collection> all known device bitmaps
-knownBitmapIds <Collection> corresponding device-bitmap ids
+ knownViews <Collection> all views known
+ knownIds <Collection> corresponding device-view ids
+ knownBitmaps <Collection> all known device bitmaps
+ knownBitmapIds <Collection> corresponding device-bitmap ids
-dispatching <Boolean> true, if currently in dispatch loop
+ dispatching <Boolean> true, if currently in dispatch loop
-controlDown <Boolean> true, if control key currently pressed
-shiftDown <Boolean> true, if shift key currently pressed
-metaDown <Boolean> true, if meta key (cmd-key) is currently pressed
-altDown <Boolean> true, if alt key is currently pressed
+ controlDown <Boolean> true, if control key currently pressed
+ shiftDown <Boolean> true, if shift key currently pressed
+ metaDown <Boolean> true, if meta key (cmd-key) is currently pressed
+ altDown <Boolean> true, if alt key is currently pressed
-motionEventCompression
+ motionEventCompression
-lastId <Number>
-lastView <View>
+ lastId <Number>
+ lastView <View>
-keyboardMap <KeyBdMap> mapping for keys
-isSlow <Boolean> set/cleared from startup - used to turn off
- things like popup-shadows etc.
+ keyboardMap <KeyBdMap> mapping for keys
+ isSlow <Boolean> set/cleared from startup - used to turn off
+ things like popup-shadows etc.
"
! !
@@ -844,8 +844,8 @@
"add the View aView with Id:aNumber to the list of known views/id's"
knownViews isNil ifTrue:[
- knownViews := (VariableArray new:100) grow:0.
- knownIds := (VariableArray new:100) grow:0
+ knownViews := OrderedCollection new "(VariableArray new:100) grow:0".
+ knownIds := OrderedCollection new "(VariableArray new:100) grow:0"
].
knownViews add:aView.
knownIds add:aNumber.
@@ -994,8 +994,10 @@
!
dispatchPendingEvents
- [self eventPending] whileTrue:[
- self dispatchEventFor:nil withMask:nil
+ Object abortSignal catch:[
+ [self eventPending] whileTrue:[
+ self dispatchEventFor:nil withMask:nil
+ ]
]
!
@@ -1664,30 +1666,79 @@
!DeviceWorkstation methodsFor:'drawing'!
-displayString:aString x:x y:y in:aDrawableId with:aGCId
- "draw a string - draw foreground only"
+displayString:aString x:x y:y in:aDrawableId with:aGCId round:round opaque:opaque
+ "draw a string"
^ self subclassResponsibility
!
-displayString:aString from:index1 to:index2 x:x y:y in:aDrawableId with:aGCId
- "draw part of a string - draw foreground only"
+displayString:aString from:i1 to:i2 x:x y:y in:aDrawableId with:aGCId round:round opaque:opaque
+ "draw part of a string"
+
+ "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
+!
+
+displayString:aString x:x y:y in:aDrawableId with:aGCId
+ "draw a string - draw foreground only.
+ If the coordinates are not integers, retry with rounded."
- self displayString:(aString copyFrom:index1 to:index2)
- x:x y:y in:aDrawableId with:aGCId
+ self displayString:aString
+ 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
+ "draw a sub-string - draw foreground only.
+ 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
!
displayOpaqueString:aString x:x y:y in:aDrawableId with:aGCId
- "draw a string - draw both foreground and background"
+ "draw a string - draw foreground on background.
+ If the coordinates are not integers, retry with rounded."
- ^ self subclassResponsibility
+ self displayString:aString
+ 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
- "draw part of a string - draw both foreground and background"
+ "draw a sub-string - draw foreground on background.
+ If the coordinates are not integers, retry with rounded."
- self displayOpaqueString:(aString copyFrom:index1 to:index2)
- x:x y:y in:aDrawableId with:aGCId
+ self displayString:aString
+ from:index1
+ to:index2
+ x:x
+ y:y
+ in:aDrawableId
+ with:aGCId
+ round:true
+ opaque:true
!
displayPointX:x y:y in:aDrawableId with:aGCId
@@ -1699,18 +1750,21 @@
displayLineFromX:x0 y:y0 toX:x1 y:y1 in:aDrawableId with:aGCId
"draw a line"
+ "could add a bresenham line drawer here ..."
^ self subclassResponsibility
!
displayRectangleX:x y:y width:width height:height in:aDrawableId with:aGCId
"draw a rectangle"
+ "should draw four lines here"
^ self subclassResponsibility
!
displayPolygon:aPolygon in:aDrawableId with:aGCId
"draw a polygon"
+ "should draw the lines here"
^ self subclassResponsibility
!
--- a/DeviceWorkstation.st Wed Mar 30 03:25:26 1994 +0200
+++ b/DeviceWorkstation.st Wed Mar 30 12:13:08 1994 +0200
@@ -34,7 +34,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.10 1994-01-09 21:53:00 claus Exp $
+$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.11 1994-03-30 10:13:08 claus Exp $
written jan 93 by claus
'!
@@ -42,47 +42,47 @@
documentation
"
-this abstract class defines common protocol to all Display types.
+ this abstract class defines common protocol to all Display types.
-instance variables:
+ instance variables:
-displayId <Number> the device id of the display
-visualType <Symbol> one of #StaticGray, #PseudoColor, ... #TrueColor
-monitorType <Symbol> one of #monochrome, #color, #unknown
+ displayId <Number> the device id of the display
+ visualType <Symbol> one of #StaticGray, #PseudoColor, ... #TrueColor
+ monitorType <Symbol> one of #monochrome, #color, #unknown
-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)
-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
-height <Integer> number of vertical pixels
-heightMM <Number> screen height in millimeter
-widthMM <Number> screen width in millimeter
-resolutionHor <Number> pixels per horizontal millimeter
-resolutionVer <Number> pixels per vertical millimeter
+ 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)
+ 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
+ height <Integer> number of vertical pixels
+ heightMM <Number> screen height in millimeter
+ widthMM <Number> screen width in millimeter
+ resolutionHor <Number> pixels per horizontal millimeter
+ resolutionVer <Number> pixels per vertical millimeter
-knownViews <Collection> all views known
-knownIds <Collection> corresponding device-view ids
-knownBitmaps <Collection> all known device bitmaps
-knownBitmapIds <Collection> corresponding device-bitmap ids
+ knownViews <Collection> all views known
+ knownIds <Collection> corresponding device-view ids
+ knownBitmaps <Collection> all known device bitmaps
+ knownBitmapIds <Collection> corresponding device-bitmap ids
-dispatching <Boolean> true, if currently in dispatch loop
+ dispatching <Boolean> true, if currently in dispatch loop
-controlDown <Boolean> true, if control key currently pressed
-shiftDown <Boolean> true, if shift key currently pressed
-metaDown <Boolean> true, if meta key (cmd-key) is currently pressed
-altDown <Boolean> true, if alt key is currently pressed
+ controlDown <Boolean> true, if control key currently pressed
+ shiftDown <Boolean> true, if shift key currently pressed
+ metaDown <Boolean> true, if meta key (cmd-key) is currently pressed
+ altDown <Boolean> true, if alt key is currently pressed
-motionEventCompression
+ motionEventCompression
-lastId <Number>
-lastView <View>
+ lastId <Number>
+ lastView <View>
-keyboardMap <KeyBdMap> mapping for keys
-isSlow <Boolean> set/cleared from startup - used to turn off
- things like popup-shadows etc.
+ keyboardMap <KeyBdMap> mapping for keys
+ isSlow <Boolean> set/cleared from startup - used to turn off
+ things like popup-shadows etc.
"
! !
@@ -844,8 +844,8 @@
"add the View aView with Id:aNumber to the list of known views/id's"
knownViews isNil ifTrue:[
- knownViews := (VariableArray new:100) grow:0.
- knownIds := (VariableArray new:100) grow:0
+ knownViews := OrderedCollection new "(VariableArray new:100) grow:0".
+ knownIds := OrderedCollection new "(VariableArray new:100) grow:0"
].
knownViews add:aView.
knownIds add:aNumber.
@@ -994,8 +994,10 @@
!
dispatchPendingEvents
- [self eventPending] whileTrue:[
- self dispatchEventFor:nil withMask:nil
+ Object abortSignal catch:[
+ [self eventPending] whileTrue:[
+ self dispatchEventFor:nil withMask:nil
+ ]
]
!
@@ -1664,30 +1666,79 @@
!DeviceWorkstation methodsFor:'drawing'!
-displayString:aString x:x y:y in:aDrawableId with:aGCId
- "draw a string - draw foreground only"
+displayString:aString x:x y:y in:aDrawableId with:aGCId round:round opaque:opaque
+ "draw a string"
^ self subclassResponsibility
!
-displayString:aString from:index1 to:index2 x:x y:y in:aDrawableId with:aGCId
- "draw part of a string - draw foreground only"
+displayString:aString from:i1 to:i2 x:x y:y in:aDrawableId with:aGCId round:round opaque:opaque
+ "draw part of a string"
+
+ "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
+!
+
+displayString:aString x:x y:y in:aDrawableId with:aGCId
+ "draw a string - draw foreground only.
+ If the coordinates are not integers, retry with rounded."
- self displayString:(aString copyFrom:index1 to:index2)
- x:x y:y in:aDrawableId with:aGCId
+ self displayString:aString
+ 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
+ "draw a sub-string - draw foreground only.
+ 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
!
displayOpaqueString:aString x:x y:y in:aDrawableId with:aGCId
- "draw a string - draw both foreground and background"
+ "draw a string - draw foreground on background.
+ If the coordinates are not integers, retry with rounded."
- ^ self subclassResponsibility
+ self displayString:aString
+ 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
- "draw part of a string - draw both foreground and background"
+ "draw a sub-string - draw foreground on background.
+ If the coordinates are not integers, retry with rounded."
- self displayOpaqueString:(aString copyFrom:index1 to:index2)
- x:x y:y in:aDrawableId with:aGCId
+ self displayString:aString
+ from:index1
+ to:index2
+ x:x
+ y:y
+ in:aDrawableId
+ with:aGCId
+ round:true
+ opaque:true
!
displayPointX:x y:y in:aDrawableId with:aGCId
@@ -1699,18 +1750,21 @@
displayLineFromX:x0 y:y0 toX:x1 y:y1 in:aDrawableId with:aGCId
"draw a line"
+ "could add a bresenham line drawer here ..."
^ self subclassResponsibility
!
displayRectangleX:x y:y width:width height:height in:aDrawableId with:aGCId
"draw a rectangle"
+ "should draw four lines here"
^ self subclassResponsibility
!
displayPolygon:aPolygon in:aDrawableId with:aGCId
"draw a polygon"
+ "should draw the lines here"
^ self subclassResponsibility
!