--- a/Controll.st Mon Feb 06 01:30:10 1995 +0100
+++ b/Controll.st Mon Feb 06 01:38:04 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/Controll.st,v 1.8 1994-11-28 21:00:41 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/Controll.st,v 1.9 1995-02-06 00:35:35 claus Exp $
'!
!Controller class methodsFor:'documentation'!
@@ -42,19 +42,22 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/Controll.st,v 1.8 1994-11-28 21:00:41 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/Controll.st,v 1.9 1995-02-06 00:35:35 claus Exp $
"
!
documentation
"
Controllers can be used to controll the user-interactions
- to a Model which is shown in a view. For very simple views,
+ to a model which is shown in a view. For very simple views,
(and due to the evolution of Smalltalk/X) many view-classes have
the controller function integrated.
To allow both controller and non-controller operation, events are
sent directly to the view, if its controller instance variable
is nil. Otherwise, the controller gets the event.
+ For now (vsn 2.10.4) there are only a few view classes using controllers;
+ however, over time, more will be converted, since separating the controller
+ offers much more flexibility (although view initialization becomes a bit more complex).
Instance variables:
view aView the view I controll
@@ -62,6 +65,12 @@
"
! !
+!Controller class methodsFor:'instance creation'!
+
+new
+ ^ self basicNew initialize
+! !
+
!Controller methodsFor:'initialize / release'!
initialize
@@ -128,7 +137,36 @@
"actually, this should be called 'middleButtonActivity'.
But for ST-80 compatibility ...."
- ^ self
+ |sym menu actionSelector|
+
+ "
+ try ST-80 style menus first:
+ if there is a model, and a menuSymbol is defined,
+ ask model for the menu and launch that if non-nil.
+ "
+ (model notNil
+ and:[(sym := view menuSymbol) notNil
+ and:[sym isSymbol]]) ifTrue:[
+ "
+ ask model for the menu
+ "
+ menu := model perform:sym.
+ menu notNil ifTrue:[
+ "
+ got one, launch the menu. It is supposed
+ to return an actionSelector.
+ "
+ actionSelector := menu startUp.
+ (actionSelector notNil
+ and:[actionSelector isSymbol]) ifTrue:[
+ model perform:actionSelector
+ ]
+ ].
+ ^ self
+ ].
+ view middleButtonMenu notNil ifTrue:[
+ view middleButtonMenu showAtPointer
+ ]
!
blueButtonActivity
--- a/Controller.st Mon Feb 06 01:30:10 1995 +0100
+++ b/Controller.st Mon Feb 06 01:38:04 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Controller.st,v 1.8 1994-11-28 21:00:41 claus Exp $
+$Header: /cvs/stx/stx/libview/Controller.st,v 1.9 1995-02-06 00:35:35 claus Exp $
'!
!Controller class methodsFor:'documentation'!
@@ -42,19 +42,22 @@
version
"
-$Header: /cvs/stx/stx/libview/Controller.st,v 1.8 1994-11-28 21:00:41 claus Exp $
+$Header: /cvs/stx/stx/libview/Controller.st,v 1.9 1995-02-06 00:35:35 claus Exp $
"
!
documentation
"
Controllers can be used to controll the user-interactions
- to a Model which is shown in a view. For very simple views,
+ to a model which is shown in a view. For very simple views,
(and due to the evolution of Smalltalk/X) many view-classes have
the controller function integrated.
To allow both controller and non-controller operation, events are
sent directly to the view, if its controller instance variable
is nil. Otherwise, the controller gets the event.
+ For now (vsn 2.10.4) there are only a few view classes using controllers;
+ however, over time, more will be converted, since separating the controller
+ offers much more flexibility (although view initialization becomes a bit more complex).
Instance variables:
view aView the view I controll
@@ -62,6 +65,12 @@
"
! !
+!Controller class methodsFor:'instance creation'!
+
+new
+ ^ self basicNew initialize
+! !
+
!Controller methodsFor:'initialize / release'!
initialize
@@ -128,7 +137,36 @@
"actually, this should be called 'middleButtonActivity'.
But for ST-80 compatibility ...."
- ^ self
+ |sym menu actionSelector|
+
+ "
+ try ST-80 style menus first:
+ if there is a model, and a menuSymbol is defined,
+ ask model for the menu and launch that if non-nil.
+ "
+ (model notNil
+ and:[(sym := view menuSymbol) notNil
+ and:[sym isSymbol]]) ifTrue:[
+ "
+ ask model for the menu
+ "
+ menu := model perform:sym.
+ menu notNil ifTrue:[
+ "
+ got one, launch the menu. It is supposed
+ to return an actionSelector.
+ "
+ actionSelector := menu startUp.
+ (actionSelector notNil
+ and:[actionSelector isSymbol]) ifTrue:[
+ model perform:actionSelector
+ ]
+ ].
+ ^ self
+ ].
+ view middleButtonMenu notNil ifTrue:[
+ view middleButtonMenu showAtPointer
+ ]
!
blueButtonActivity
--- a/Cursor.st Mon Feb 06 01:30:10 1995 +0100
+++ b/Cursor.st Mon Feb 06 01:38:04 1995 +0100
@@ -28,7 +28,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Cursor.st,v 1.13 1994-11-17 14:24:52 claus Exp $
+$Header: /cvs/stx/stx/libview/Cursor.st,v 1.14 1995-02-06 00:35:38 claus Exp $
'!
!Cursor class methodsFor:'documentation'!
@@ -49,7 +49,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Cursor.st,v 1.13 1994-11-17 14:24:52 claus Exp $
+$Header: /cvs/stx/stx/libview/Cursor.st,v 1.14 1995-02-06 00:35:38 claus Exp $
"
!
@@ -626,16 +626,18 @@
shape notNil ifTrue:[
id := aDevice createCursorShape:shape.
id isNil ifTrue:[
- 'no cursor with shape:' errorPrint. shape errorPrintNewline.
+ 'CURSOR: no cursor with shape:' errorPrint. shape errorPrintNewline.
^ nil
].
] ifFalse:[
+ sourceForm := sourceForm on:aDevice.
+ maskForm := maskForm on:aDevice.
id := aDevice createCursorSourceForm:sourceForm
maskForm:maskForm
hotX:hotX
hotY:hotY.
id isNil ifTrue:[
- 'cannot create cursor' errorPrintNewline.
+ 'CURSOR: cannot create pixmap cursor' errorPrintNewline.
^ nil
].
].
--- a/DMedium.st Mon Feb 06 01:30:10 1995 +0100
+++ b/DMedium.st Mon Feb 06 01:38:04 1995 +0100
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/DMedium.st,v 1.8 1994-11-17 14:24:54 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DMedium.st,v 1.9 1995-02-06 00:35:42 claus Exp $
'!
!DisplayMedium class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/DMedium.st,v 1.8 1994-11-17 14:24:54 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DMedium.st,v 1.9 1995-02-06 00:35:42 claus Exp $
"
!
@@ -74,6 +74,12 @@
!DisplayMedium methodsFor:'accessing'!
+isView
+ "return true, if the receiver is a view"
+
+ ^ false
+!
+
origin
"return the origin i.e. coordinate of top-left of the receiver"
@@ -137,6 +143,13 @@
height := h
!
+setWidth:w height:h
+ "set both width and height - not to be redefined"
+
+ width := w.
+ height := h
+!
+
insideWidth
"return the usable width for drawing in the receiver;
this is width here, but Views/Pages may subtract margins"
--- a/DRootView.st Mon Feb 06 01:30:10 1995 +0100
+++ b/DRootView.st Mon Feb 06 01:38:04 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/DRootView.st,v 1.8 1994-10-10 02:29:37 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DRootView.st,v 1.9 1995-02-06 00:35:46 claus Exp $
'!
Smalltalk at:#RootView put:nil!
@@ -44,14 +44,31 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/DRootView.st,v 1.8 1994-10-10 02:29:37 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DRootView.st,v 1.9 1995-02-06 00:35:46 claus Exp $
"
!
documentation
"
this class describes Xs rootWindow (which is the background window and
- must be used for drawing outside of Views i.e. for dragging between Views)
+ must be used for drawing outside of Views i.e. for dragging between Views).
+
+ To draw in the root window:
+
+ RootView paint:(Color red).
+ RootView fillRectangleX:10 y:10 width:100 height:100.
+
+ of course, all stuff from View and its superclasses can be used:
+
+ RootView paint:(Color red).
+ RootView noClipByChildren.
+ RootView fillRectangleX:10 y:10 width:100 height:100.
+
+ you have to be careful with some window managers, since what you
+ see on the screen is not always really the root window. Some Desktops
+ add their own view in between (although the Xworkstation class does
+ care for this, it seems not to work correctly on all systems).
+ In general, you should never use the RootView for normal applications.
"
! !
@@ -67,7 +84,9 @@
!DisplayRootView class methodsFor:'instance creation'!
new
- "since there is only one RootView - catch new"
+ "since there is only one RootView - catch new and return
+ the one and only rootView."
+
RootView isNil ifTrue:[
RootView := super new
].
@@ -78,10 +97,11 @@
initialize
super initialize.
+
width := device width.
height := device height.
+ drawableId := device rootWindowFor:self.
realized := true.
- drawableId := device rootWindowFor:self
!
reinitialize
@@ -90,6 +110,7 @@
width := device width.
height := device height.
drawableId := device rootWindowFor:self.
+ realized := true.
gcId := nil.
! !
--- a/Depth1Image.st Mon Feb 06 01:30:10 1995 +0100
+++ b/Depth1Image.st Mon Feb 06 01:38:04 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Depth1Image.st,v 1.9 1994-11-21 16:43:06 claus Exp $
+$Header: /cvs/stx/stx/libview/Depth1Image.st,v 1.10 1995-02-06 00:35:47 claus Exp $
'!
!Depth1Image class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Depth1Image.st,v 1.9 1994-11-21 16:43:06 claus Exp $
+$Header: /cvs/stx/stx/libview/Depth1Image.st,v 1.10 1995-02-06 00:35:47 claus Exp $
"
!
@@ -56,6 +56,12 @@
"
! !
+!Depth1Image class methodsFor:'queries'!
+
+imageDepth
+ ^ 1
+! !
+
!Depth1Image methodsFor:'queries'!
bitsPerPixel
@@ -93,6 +99,28 @@
"return the number of samples per pixel in the image."
^ 1
+!
+
+usedColors
+ "return a collection of colors used in the receiver.
+ For depth1 images, this is very easy"
+
+ photometric ~~ #palette ifTrue:[
+ ^ Array with:Color white with:Color black.
+ ].
+ ^ colorMap
+
+ "
+ (Image fromFile:'bitmaps/garfield.gif') usedColors
+ (Image fromFile:'bitmaps/SBrowser.xbm') usedColors
+ "
+!
+
+usedValues
+ "return a collection of color values used in the receiver.
+ For depth1 images, this is very easy"
+
+ ^ #(0 1)
! !
!Depth1Image methodsFor:'accessing'!
@@ -123,21 +151,25 @@
}
%}.
- "the above is equivalent to:
- (notice that the code below is evaluated if the bytes-collection is
- not a byteArray, or the arguments are not integers)"
+"/ the above is equivalent to:
+"/ (notice that the code below is evaluated if the bytes-collection is
+"/ not a byteArray, or the arguments are not integers)
- bytesPerRow := width // 8.
- ((width \\ 8) ~~ 0) ifTrue:[
- bytesPerRow := bytesPerRow + 1
- ].
- index := (bytesPerRow * y) + 1 + (x // 8).
+"/ bytesPerRow := width // 8.
+"/ ((width \\ 8) ~~ 0) ifTrue:[
+"/ bytesPerRow := bytesPerRow + 1
+"/ ].
+"/ index := (bytesPerRow * y) + 1 + (x // 8).
+"/
+"/ "left pixel is in high bit"
+"/ byte := bytes at:index.
+"/ mask := #(16r80 16r40 16r20 16r10 16r08 16r04 16r02 16r01) at:((x \\ 8) + 1).
+"/ (byte bitAnd:mask) == 0 ifTrue:[^ 0].
+"/ ^ 1
- "left pixel is in high bit"
- byte := bytes at:index.
- mask := #(16r80 16r40 16r20 16r10 16r08 16r04 16r02 16r01) at:((x \\ 8) + 1).
- (byte bitAnd:mask) == 0 ifTrue:[^ 0].
- ^ 1
+"/ since that cannot happen, we faile here
+ self primitiveFailed.
+ ^ 0
!
atX:x y:y
@@ -148,7 +180,8 @@
|lineIndex "{ Class: SmallInteger }"
byte "{ Class: SmallInteger }"
shift "{ Class: SmallInteger }"
- value "{ Class: SmallInteger }"|
+ value "{ Class: SmallInteger }"
+ p|
lineIndex := (self bytesPerRow * y) + 1.
@@ -156,26 +189,22 @@
byte := bytes at:(lineIndex + (x // 8)).
shift := #(-7 -6 -5 -4 -3 -2 -1 0) at:((x \\ 8) + 1).
value := (byte bitShift:shift) bitAnd:1.
- photometric == #whiteIs0 ifTrue:[
- (value == 0) ifTrue:[
- ^ Color white
- ].
- ^ Color black
+ (p := photometric) == #whiteIs0 ifTrue:[
+ value := 1-value.
+ p := #blackIs0
].
- photometric == #blackIs0 ifTrue:[
+ p == #blackIs0 ifTrue:[
(value == 0) ifTrue:[
^ Color black
].
^ Color white
].
- photometric ~~ #palette ifTrue:[
+ p ~~ #palette ifTrue:[
self error:'format not supported'.
^ nil
].
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))
+ ^ colorMap at:value
!
atX:x y:y putValue:aPixelValue
@@ -266,7 +295,7 @@
self error:'invalid color'
! !
-!Depth1Image methodsFor:'enumeration'!
+!Depth1Image methodsFor:'enumerating'!
valueAtY:y from:xLow to:xHigh do:aBlock
"perform aBlock for each pixelValue from x1 to x2 in row y.
@@ -349,12 +378,8 @@
color1 := Color white
] ifFalse:[
photometric == #palette ifTrue:[
- color0 := Color red:(((colorMap at:1) at:1) * 100 / 255)
- green:(((colorMap at:2) at:1) * 100 / 255)
- blue:(((colorMap at:3) at:1) * 100 / 255).
- color1 := Color red:(((colorMap at:1) at:2) * 100 / 255)
- green:(((colorMap at:2) at:2) * 100 / 255)
- blue:(((colorMap at:3) at:2) * 100 / 255).
+ color0 := colorMap at:1.
+ color1 := colorMap at:2
] ifFalse:[
self error:'format not supported'.
^ nil
@@ -421,9 +446,7 @@
"
this is easy, since Form already supports colorMaps
"
- f := Form width:width
- height:height
- fromArray:bytes.
+ f := Form width:width height:height fromArray:bytes.
f colorMap:colorMap.
^ f
! !
--- a/Depth24Image.st Mon Feb 06 01:30:10 1995 +0100
+++ b/Depth24Image.st Mon Feb 06 01:38:04 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Depth24Image.st,v 1.8 1994-11-17 14:31:05 claus Exp $
+$Header: /cvs/stx/stx/libview/Depth24Image.st,v 1.9 1995-02-06 00:35:49 claus Exp $
'!
!Depth24Image class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Depth24Image.st,v 1.8 1994-11-17 14:31:05 claus Exp $
+$Header: /cvs/stx/stx/libview/Depth24Image.st,v 1.9 1995-02-06 00:35:49 claus Exp $
"
!
@@ -54,6 +54,12 @@
"
! !
+!Depth24Image class methodsFor:'queries'!
+
+imageDepth
+ ^ 24
+! !
+
!Depth24Image methodsFor:'queries'!
bitsPerPixel
@@ -111,6 +117,23 @@
blue:bVal * 100 / 255
!
+atX:x y:y put:aColor
+ "set the pixel at x/y to aColor.
+ Pixels start at x=0 , y=0 for upper left pixel, end at
+ x = width-1, y=height-1 for lower right pixel."
+
+ |index "{ Class: SmallInteger }"
+ val "{ Class: SmallInteger }" |
+
+ index := 1 + (((width * y) + x) * 3).
+ val := (aColor red / 100 * 255) rounded.
+ bytes at:(index) put:val.
+ val := (aColor green / 100 * 255) rounded.
+ bytes at:(index + 1) put:val.
+ val := (aColor blue / 100 * 255) rounded.
+ bytes at:(index + 2) put:val.
+!
+
valueAtX:x y:y
"retrieve a pixel at x/y; return a color.
Pixels start at x=0 , y=0 for upper left pixel, end at
@@ -145,7 +168,7 @@
bytes at:(index) put:val.
! !
-!Depth24Image methodsFor:'accessing'!
+!Depth24Image methodsFor:'enumerating'!
valueAtY:y from:xLow to:xHigh do:aBlock
"perform aBlock for each pixelValue from x1 to x2 in row y.
@@ -284,12 +307,12 @@
dstIndex "{ Class: SmallInteger }"
bits "{ Class: SmallInteger }"
bitCount "{ Class: SmallInteger }"
- fast |
+ failed |
w := width.
h := height.
monoBits := ByteArray uninitializedNew:(((w + 7) // 8) * h).
- fast := false.
+ failed := true.
%{
register unsigned char *srcPtr, *dstPtr;
register _v, _bits, _bitCount;
@@ -297,8 +320,9 @@
register i;
extern OBJ ByteArray;
- if (__isByteArray(_INST(bytes)) && __isByteArray(monoBits)) {
- fast = true;
+ if (__isByteArray(_INST(bytes))
+ && __isByteArray(monoBits)) {
+ failed = false;
srcPtr = _ByteArrayInstPtr(_INST(bytes))->ba_element;
dstPtr = _ByteArrayInstPtr(monoBits)->ba_element;
for (i=_intVal(h); i>0; i--) {
@@ -327,44 +351,48 @@
}
}
}
-%}
-.
- fast ifFalse:[
- srcIndex := 1.
- dstIndex := 1.
- 1 to:h do:[:row |
- bitCount := 0.
- bits := 0.
- 1 to:w do:[:col |
- bits := bits bitShift:1.
+%}.
- r := bytes at:srcIndex.
- srcIndex := srcIndex + 1.
- g := bytes at:srcIndex.
- srcIndex := srcIndex + 1.
- b := bytes at:srcIndex.
- srcIndex := srcIndex + 1.
- v := ((3 * r) + (6 * g) + (1 * b)) // 10.
- ((v bitAnd:16r80) == 0) ifFalse:[
- bits := bits bitOr:1
- ].
- bitCount := bitCount + 1.
- (bitCount == 8) ifTrue:[
- monoBits at:dstIndex put:bits.
- dstIndex := dstIndex + 1.
- bits := 0.
- bitCount := 0
- ]
- ].
- (bitCount ~~ 0) ifTrue:[
- [bitCount == 8] whileFalse:[
- bitCount := bitCount + 1.
- bits := bits bitShift:1.
- ].
- monoBits at:dstIndex put:bits.
- dstIndex := dstIndex + 1
- ]
- ]
+ failed ifTrue:[
+"/ the above is equivalent to:
+"/
+"/ srcIndex := 1.
+"/ dstIndex := 1.
+"/ 1 to:h do:[:row |
+"/ bitCount := 0.
+"/ bits := 0.
+"/ 1 to:w do:[:col |
+"/ bits := bits bitShift:1.
+"/
+"/ r := bytes at:srcIndex.
+"/ srcIndex := srcIndex + 1.
+"/ g := bytes at:srcIndex.
+"/ srcIndex := srcIndex + 1.
+"/ b := bytes at:srcIndex.
+"/ srcIndex := srcIndex + 1.
+"/ v := ((3 * r) + (6 * g) + (1 * b)) // 10.
+"/ ((v bitAnd:16r80) == 0) ifFalse:[
+"/ bits := bits bitOr:1
+"/ ].
+"/ bitCount := bitCount + 1.
+"/ (bitCount == 8) ifTrue:[
+"/ monoBits at:dstIndex put:bits.
+"/ dstIndex := dstIndex + 1.
+"/ bits := 0.
+"/ bitCount := 0
+"/ ]
+"/ ].
+"/ (bitCount ~~ 0) ifTrue:[
+"/ [bitCount == 8] whileFalse:[
+"/ bitCount := bitCount + 1.
+"/ bits := bits bitShift:1.
+"/ ].
+"/ monoBits at:dstIndex put:bits.
+"/ dstIndex := dstIndex + 1
+"/ ]
+"/ ]
+ self primitiveFailed.
+ ^ nil
].
f := Form width:w height:h depth:1 on:aDevice.
@@ -388,7 +416,7 @@
|twoPlaneBits f
map rMap gMap bMap
- fast
+ failed
r "{ Class: SmallInteger }"
g "{ Class: SmallInteger }"
b "{ Class: SmallInteger }"
@@ -404,7 +432,7 @@
h := height.
twoPlaneBits := ByteArray uninitializedNew:(((w * 2 + 7) // 8) * h).
- fast := false.
+ failed := true.
%{
register unsigned char *srcPtr, *dstPtr;
register _v, _bits, _bitCount;
@@ -414,7 +442,7 @@
if ((_Class(_INST(bytes)) == ByteArray)
&& (_Class(twoPlaneBits) == ByteArray)) {
- fast = true;
+ failed = false;
srcPtr = _ByteArrayInstPtr(_INST(bytes))->ba_element;
dstPtr = _ByteArrayInstPtr(twoPlaneBits)->ba_element;
for (i=_intVal(h); i>0; i--) {
@@ -440,41 +468,44 @@
}
}
}
-%}
-.
- fast ifFalse:[
- srcIndex := 1.
- dstIndex := 1.
- 1 to:h do:[:row |
- bitCount := 0.
- bits := 0.
- 1 to:w do:[:col |
- r := bytes at:srcIndex.
- srcIndex := srcIndex + 1.
- g := bytes at:srcIndex.
- srcIndex := srcIndex + 1.
- b := bytes at:srcIndex.
- srcIndex := srcIndex + 1.
- v := ((3 * r) + (6 * g) + (1 * b)) // 10.
- v := v bitShift:-6. "take 2 hi bits"
- bits := (bits bitShift:2) bitOr:v.
- bitCount := bitCount + 1.
- (bitCount == 4) ifTrue:[
- twoPlaneBits at:dstIndex put:bits.
- dstIndex := dstIndex + 1.
- bits := 0.
- bitCount := 0
- ]
- ].
- (bitCount ~~ 0) ifTrue:[
- [bitCount == 4] whileFalse:[
- bitCount := bitCount + 1.
- bits := bits bitShift:2.
- ].
- twoPlaneBits at:dstIndex put:bits.
- dstIndex := dstIndex + 1
- ]
- ]
+%}.
+ failed ifTrue:[
+"/ the above is equivalent to:
+"/
+"/ srcIndex := 1.
+"/ dstIndex := 1.
+"/ 1 to:h do:[:row |
+"/ bitCount := 0.
+"/ bits := 0.
+"/ 1 to:w do:[:col |
+"/ r := bytes at:srcIndex.
+"/ srcIndex := srcIndex + 1.
+"/ g := bytes at:srcIndex.
+"/ srcIndex := srcIndex + 1.
+"/ b := bytes at:srcIndex.
+"/ srcIndex := srcIndex + 1.
+"/ v := ((3 * r) + (6 * g) + (1 * b)) // 10.
+"/ v := v bitShift:-6. "take 2 hi bits"
+"/ bits := (bits bitShift:2) bitOr:v.
+"/ bitCount := bitCount + 1.
+"/ (bitCount == 4) ifTrue:[
+"/ twoPlaneBits at:dstIndex put:bits.
+"/ dstIndex := dstIndex + 1.
+"/ bits := 0.
+"/ bitCount := 0
+"/ ]
+"/ ].
+"/ (bitCount ~~ 0) ifTrue:[
+"/ [bitCount == 4] whileFalse:[
+"/ bitCount := bitCount + 1.
+"/ bits := bits bitShift:2.
+"/ ].
+"/ twoPlaneBits at:dstIndex put:bits.
+"/ dstIndex := dstIndex + 1
+"/ ]
+"/ ]
+ self primitiveFailed.
+ ^ nil
].
f := Form width:width height:height depth:2 on:aDevice.
@@ -496,10 +527,10 @@
|greyBits f v
srcIndex "{ Class: SmallInteger }"
dstIndex "{ Class: SmallInteger }"
- fast|
+ failed|
greyBits := ByteArray uninitializedNew:(width * height).
- fast := false.
+ failed := false.
%{
register unsigned char *srcPtr, *dstPtr;
register _v;
@@ -509,7 +540,7 @@
if ((_Class(_INST(bytes)) == ByteArray)
&& (_Class(greyBits) == ByteArray)) {
- fast = true;
+ failed = false;
srcPtr = _ByteArrayInstPtr(_INST(bytes))->ba_element;
dstPtr = _ByteArrayInstPtr(greyBits)->ba_element;
for (i=_intVal(_INST(height)); i>0; i--) {
@@ -524,30 +555,34 @@
}
%}
.
- fast ifFalse:[
- srcIndex := 1.
- dstIndex := 1.
-
- 1 to:height do:[:h |
- 1 to:width do:[:w |
- |v
- r "{ Class: SmallInteger }"
- g "{ Class: SmallInteger }"
- b "{ Class: SmallInteger }"|
-
- r := bytes at:srcIndex.
- srcIndex := srcIndex + 1.
- g := bytes at:srcIndex.
- srcIndex := srcIndex + 1.
- b := bytes at:srcIndex.
- srcIndex := srcIndex + 1.
-
- v := ((3 * r) + (6 * g) + (1 * b)) // 10.
- v := v bitShift:-4.
- greyBits at:dstIndex put:v.
- dstIndex := dstIndex + 1
- ]
- ]
+ failed ifTrue:[
+"/ the above is equivalent to:
+"/
+"/ srcIndex := 1.
+"/ dstIndex := 1.
+"/
+"/ 1 to:height do:[:h |
+"/ 1 to:width do:[:w |
+"/ |v
+"/ r "{ Class: SmallInteger }"
+"/ g "{ Class: SmallInteger }"
+"/ b "{ Class: SmallInteger }"|
+"/
+"/ r := bytes at:srcIndex.
+"/ srcIndex := srcIndex + 1.
+"/ g := bytes at:srcIndex.
+"/ srcIndex := srcIndex + 1.
+"/ b := bytes at:srcIndex.
+"/ srcIndex := srcIndex + 1.
+"/
+"/ v := ((3 * r) + (6 * g) + (1 * b)) // 10.
+"/ v := v bitShift:-4.
+"/ greyBits at:dstIndex put:v.
+"/ dstIndex := dstIndex + 1
+"/ ]
+"/ ]
+ self primitiveFailed.
+ ^ nil
].
f := Form width:width height:height depth:8 on:aDevice.
@@ -848,7 +883,219 @@
f fillRectangleX:width-run y:dstY width:run height:1.
].
^ f
+!
+rgbImageAsDitheredPseudoFormOn:aDevice
+ "return a dithered pseudocolor form from the rgb-picture.
+ This method depends on fixColors being allocated (see Color>>getColors*)"
+
+ ^ self rgbImageAsDitheredPseudoFormOn:aDevice
+ colors:Color fixColors
+ nRed:Color numFixRed
+ nGreen:Color numFixGreen
+ nBlue:Color numFixBlue
+!
+
+rgbImageAsDitheredPseudoFormOn:aDevice colors:fixColors nRed:nRed nGreen:nGreen nBlue:nBlue
+ "return a dithered pseudocolor form from the rgb-picture"
+
+ |pseudoBits f
+ h "{ Class: SmallInteger }"
+ w "{ Class: SmallInteger }"
+"/ eR "{Class: SmallInteger }"
+"/ eG "{Class: SmallInteger }"
+"/ eB "{Class: SmallInteger }"
+"/ wantR "{Class: SmallInteger }"
+"/ wantG "{Class: SmallInteger }"
+"/ wantB "{Class: SmallInteger }"
+ fixR "{Class: SmallInteger }"
+ fixG "{Class: SmallInteger }"
+ fixB "{Class: SmallInteger }"
+ srcIndex "{ Class: SmallInteger }"
+ dstIndex "{ Class: SmallInteger }"
+ deviceDepth has8BitImage
+ fixIds failed|
+
+ aDevice ~~ Display ifTrue:[^ nil].
+
+ fixR := nRed.
+ fixR == 0 ifTrue:[ ^ nil].
+ fixG := nGreen.
+ fixG == 0 ifTrue:[ ^ nil].
+ fixB := nBlue.
+ fixB == 0 ifTrue:[ ^ nil].
+ "/ simple check
+ (fixR * fixG * fixB) ~~ fixColors size ifTrue:[
+ self error:'invalid color array passed'.
+ ^ nil
+ ].
+ fixIds := (fixColors asArray collect:[:clr | clr colorId]) asByteArray.
+
+ deviceDepth := aDevice depth.
+ deviceDepth == 8 ifTrue:[
+ has8BitImage := true.
+ ] ifFalse:[
+ has8BitImage := false.
+ aDevice supportedImageFormats do:[:fmt |
+ (fmt at:2) == 8 ifTrue:[
+ has8BitImage := true.
+ ]
+ ]
+ ].
+ has8BitImage ifFalse:[^ nil].
+
+ 'D24IMAGE: dithering ...' errorPrintNL.
+
+ pseudoBits := ByteArray uninitializedNew:(width * height).
+
+ h := height.
+ w := width.
+
+%{
+ int __x, __y;
+ int __eR, __eG, __eB;
+ int __wantR, __wantG, __wantB;
+ unsigned char *srcP, *dstP;
+ unsigned char *redP, *greenP, *blueP;
+ int pix;
+ unsigned char *idP;
+ int __fR, __fG, __fB;
+ int iR, iG, iB;
+ int idx;
+
+ if (__isByteArray(_INST(bytes))
+ && __isByteArray(pseudoBits)
+ && __isByteArray(fixIds)
+ && _isSmallInteger(fixR)
+ && _isSmallInteger(fixG)
+ && _isSmallInteger(fixB)) {
+ failed = false;
+
+ srcP = _ByteArrayInstPtr(_INST(bytes))->ba_element;
+ dstP = _ByteArrayInstPtr(pseudoBits)->ba_element;
+ idP = _ByteArrayInstPtr(fixIds)->ba_element;
+ __fR = _intVal(fixR)-1;
+ __fG = _intVal(fixG)-1;
+ __fB = _intVal(fixB)-1;
+
+ for (__y=_intVal(h); __y>0; __y--) {
+ __eR = __eG = __eB = 0;
+ for (__x=_intVal(w); __x>0; __x--) {
+ int t;
+ int __want;
+
+ /*
+ * wR, wG and wB is the wanted r/g/b value;
+ * compute the index into the dId table ..
+ * values: 0..255; scale to 0..fR-1, 0..fG-1, 0..fB-1
+ *
+ * bad kludge: knows how to index into FixColor table
+ */
+ __wantR = srcP[0] + __eR;
+ __wantG = srcP[1] + __eG;
+ __wantB = srcP[2] + __eB;
+ srcP += 3;
+
+ if (__wantR > 255) __want = 255;
+ else if (__wantR < 0) __want = 0;
+ else __want = __wantR;
+
+ iR = __want * __fR / 128;
+ iR = (iR / 2) + (iR & 1);
+ idx = iR * (__fG+1);
+
+ if (__wantG > 255) __want = 255;
+ else if (__wantG < 0) __want = 0;
+ else __want = __wantG;
+
+ iG = __want * __fG / 128;
+ iG = (iG / 2) + (iG & 1);
+ idx = (idx + iG) * (__fB+1);
+
+ if (__wantB > 255) __want = 255;
+ else if (__wantB < 0) __want = 0;
+ else __want = __wantB;
+
+ iB = __want * __fB / 128;
+ iB = (iB / 2) + (iB & 1);
+ idx = idx + iB;
+
+ /*
+ * store the corresponding dither colorId
+ */
+ *dstP++ = idP[idx];
+
+ /*
+ * the new error:
+ */
+ __eR = __wantR - (iR * 256 / __fR);
+ __eG = __wantG - (iG * 256 / __fG);
+ __eB = __wantB - (iB * 256 / __fB);
+ }
+ }
+ }
+%}.
+ failed ifTrue:[
+ self primitiveFailed.
+ ^ nil
+
+"/ for non-C programmers:
+"/ the above code is (roughly) equivalent to:
+"/ srcIndex := 1.
+"/ dstIndex := 1.
+"/ 1 to:h do:[:y |
+"/ eR := eG := eB := 0.
+"/ 1 to:w do:[:x |
+"/ |pixel "{ Class: SmallInteger }"
+"/ clr
+"/ idx "{ Class: SmallInteger }"
+"/ iR "{ Class: SmallInteger }"
+"/ iG "{ Class: SmallInteger }"
+"/ iB "{ Class: SmallInteger }"
+"/ wR "{ Class: SmallInteger }"
+"/ wG "{ Class: SmallInteger }"
+"/ wB "{ Class: SmallInteger }" |
+"/
+"/ wantR := ((bytes at:srcIndex) + eR). srcIndex := srcIndex + 1.
+"/ wantG := ((bytes at:srcIndex) + eG). srcIndex := srcIndex + 1.
+"/ wantB := ((bytes at:srcIndex) + eB). srcIndex := srcIndex + 1.
+"/ wR := wantR.
+"/ wR > 255 ifTrue:[wR := 255] ifFalse:[wR < 0 ifTrue:[wR := 0]].
+"/ wG := wantG.
+"/ wG > 255 ifTrue:[wG := 255] ifFalse:[wG < 0 ifTrue:[wG := 0]].
+"/ wB := wantB.
+"/ wB > 255 ifTrue:[wB := 255] ifFalse:[wB < 0 ifTrue:[wB := 0]].
+"/
+"/ iR := wR * (fixR-1) // 128.
+"/ iR := (iR // 2) + (iR bitAnd:1).
+"/ iG := wG * (fixG-1) // 128.
+"/ iG := (iG // 2) + (iG bitAnd:1).
+"/ iB := wB * (fixB-1) // 128.
+"/ iB := (iB // 2) + (iB bitAnd:1).
+"/ idx := (iR * fixR + iG) * fixB + iB + 1.
+"/
+"/ clr := fixColors at:idx.
+"/
+"/ eR := wantR - (clr red * 2) asInteger.
+"/ eG := wantG - (clr green * 2) asInteger.
+"/ eB := wantB - (clr blue * 2) asInteger.
+"/
+"/ pixel := clr colorId.
+"/ pseudoBits at:dstIndex put:pixel.
+"/
+"/ dstIndex := dstIndex + 1
+"/ ].
+ ].
+
+ f := Form width:width height:height depth:aDevice depth on:aDevice.
+ f isNil ifTrue:[^ nil].
+ f colorMap:fixColors.
+ f initGC.
+ aDevice drawBits:pseudoBits bitsPerPixel:8 depth:aDevice depth
+ width:width height:height
+ x:0 y:0
+ into:(f id) x:0 y:0 width:width height:height with:(f gcId).
+ ^ f
!
rgbImageAsPseudoFormOn:aDevice
@@ -869,7 +1116,12 @@
fit fitMap colors color
fast
colorIndex "{ Class: SmallInteger }"
- depth nColorCells|
+ depth nColorCells deep|
+
+ Color fixColors notNil ifTrue:[
+ f := self rgbImageAsDitheredPseudoFormOn:aDevice.
+ f notNil ifTrue:[^ f].
+ ].
"find used colors; build color-tree"
@@ -878,19 +1130,23 @@
depth := aDevice depth.
nColorCells := aDevice ncells.
+ deep := (depth > 8).
+
rMask := 2r11111111.
gMask := 2r11111111.
bMask := 2r11111111.
- 'D24Image: allocating colors ...' errorPrintNL.
+ 'D24IMAGE: allocating colors ...' errorPrintNL.
[fit] whileFalse:[
[fitMap] whileFalse:[
srcIndex := 1.
redArray := Array new:256.
- "find used colors"
-
+ "
+ find used colors, build [r][g][b] 3-dimensional array
+ containing true for used colors
+ "
nColors := 0.
srcIndex := 1.
dataSize := bytes size.
@@ -929,14 +1185,15 @@
].
blueArray := greenArray at:g.
blueArray isNil ifTrue:[
- blueArray := Array new:256.
+ deep ifTrue:[blueArray := Array new:256]
+ ifFalse:[blueArray := ByteArray new:256].
greenArray at:g put:blueArray
].
- (blueArray at:b) isNil ifTrue:[
- blueArray at:b put:true.
+ (blueArray at:b) == 0 ifTrue:[
+ blueArray at:b put:1.
nColors := nColors + 1.
(nColors > nColorCells) ifTrue:[
- 'D24Image: more than ' errorPrint. nColorCells errorPrint. ' colors' errorPrintNL.
+ 'D24IMAGE: more than ' errorPrint. nColorCells errorPrint. ' colors' errorPrintNL.
srcIndex := dataSize + 1
]
]
@@ -951,11 +1208,15 @@
(bMask == 2r11111111) ifTrue:[
bMask := 2r11111110
] ifFalse:[
- rMask := (rMask bitShift:1) bitAnd:2r11111111.
- gMask := (gMask bitShift:1) bitAnd:2r11111111.
- bMask := (bMask bitShift:1) bitAnd:2r11111111
+ (bMask == 2r11111110) ifTrue:[
+ bMask := 2r11111100
+ ] ifFalse:[
+ rMask := (rMask bitShift:1) bitAnd:2r11111111.
+ gMask := (gMask bitShift:1) bitAnd:2r11111111.
+ bMask := (bMask bitShift:1) bitAnd:2r11111111
+ ]
].
- 'D24Image: retry with less color resolution' errorPrintNL.
+ 'D24IMAGE: too many colors; retry with less color resolution' errorPrintNL.
"
'masks:' print. rMask print. ' ' print. gMask print. ' ' print.
bMask printNewline
@@ -963,12 +1224,17 @@
]
].
- 'D24Image: ' errorPrint. nColors errorPrint. ' colors used' errorPrintNL.
+ 'D24IMAGE: ' errorPrint. nColors errorPrint. ' colors used' errorPrintNL.
+
colors := Array new:nColors.
colorIndex := 1.
- "allocate all used colors"
-
+ "
+ now, we have reduced things to the number of colors
+ which are theoretically supported by the devices colormap.
+ allocate all used colors in walking over true entries in
+ the [r][g][b] table - this may still fail
+ "
fit := true.
r := 0.
@@ -978,19 +1244,20 @@
greenArray do:[:blueArray |
(fit and:[blueArray notNil]) ifTrue:[
b := 0.
- blueArray do:[:x |
- (fit and:[x notNil]) ifTrue:[
+ blueArray do:[:present |
+ |id|
+
+ (fit and:[present ~~ 0]) ifTrue:[
color := Color red:(r * 100.0 / 255.0)
green:(g * 100.0 / 255.0)
blue:(b * 100.0 / 255.0).
color := color on:aDevice.
- color colorId isNil ifTrue:[
+ (id := color colorId) isNil ifTrue:[
fit := false
] ifFalse:[
colors at:colorIndex put:color.
colorIndex := colorIndex + 1.
- blueArray at:(b + 1)
- put:color colorId
+ blueArray at:(b + 1) put:id
]
].
b := b + 1
@@ -1005,7 +1272,7 @@
"again with less color bits if we did not get all colors"
fit ifFalse:[
- 'D24Image: still no fit' errorPrintNL.
+ 'D24IMAGE: could not allocate color(s)' errorPrintNL.
"free the allocated colors"
colors atAllPut:nil.
@@ -1036,27 +1303,44 @@
srcIndex := 1.
dstIndex := 1.
- [srcIndex < dataSize] whileTrue:[
- r := bytes at:srcIndex.
- r := r bitAnd:rMask.
- srcIndex := srcIndex + 1.
- g := bytes at:srcIndex.
- g := g bitAnd:gMask.
- srcIndex := srcIndex + 1.
- b := bytes at:srcIndex.
- b := b bitAnd:bMask.
- srcIndex := srcIndex + 1.
- greenArray := redArray at:(r + 1).
- blueArray := greenArray at:(g + 1).
- pseudoBits at:dstIndex put:(blueArray at:(b + 1)).
- dstIndex := dstIndex + 1
+ (rMask == 2r11111111
+ and:[gMask == 2r11111111
+ and:[bMask == 2r11111111]]) ifTrue:[
+ [srcIndex < dataSize] whileTrue:[
+ r := bytes at:srcIndex.
+ srcIndex := srcIndex + 1.
+ g := bytes at:srcIndex.
+ srcIndex := srcIndex + 1.
+ b := bytes at:srcIndex.
+ srcIndex := srcIndex + 1.
+ greenArray := redArray at:(r + 1).
+ blueArray := greenArray at:(g + 1).
+ pseudoBits at:dstIndex put:(blueArray at:(b + 1)).
+ dstIndex := dstIndex + 1
+ ]
+ ] ifFalse:[
+ [srcIndex < dataSize] whileTrue:[
+ r := bytes at:srcIndex.
+ r := r bitAnd:rMask.
+ srcIndex := srcIndex + 1.
+ g := bytes at:srcIndex.
+ g := g bitAnd:gMask.
+ srcIndex := srcIndex + 1.
+ b := bytes at:srcIndex.
+ b := b bitAnd:bMask.
+ srcIndex := srcIndex + 1.
+ greenArray := redArray at:(r + 1).
+ blueArray := greenArray at:(g + 1).
+ pseudoBits at:dstIndex put:(blueArray at:(b + 1)).
+ dstIndex := dstIndex + 1
+ ]
].
- f := Form width:width height:height depth:aDevice depth on:aDevice.
+ f := Form width:width height:height depth:depth on:aDevice.
f isNil ifTrue:[^ nil].
f colorMap:colors.
f initGC.
- aDevice drawBits:pseudoBits bitsPerPixel:8 depth:aDevice depth
+ aDevice drawBits:pseudoBits bitsPerPixel:8 depth:depth
width:width height:height
x:0 y:0
into:(f id) x:0 y:0 width:width height:height with:(f gcId).
--- a/Depth2Image.st Mon Feb 06 01:30:10 1995 +0100
+++ b/Depth2Image.st Mon Feb 06 01:38:04 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Depth2Image.st,v 1.8 1994-11-17 14:29:10 claus Exp $
+$Header: /cvs/stx/stx/libview/Depth2Image.st,v 1.9 1995-02-06 00:35:55 claus Exp $
'!
!Depth2Image class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Depth2Image.st,v 1.8 1994-11-17 14:29:10 claus Exp $
+$Header: /cvs/stx/stx/libview/Depth2Image.st,v 1.9 1995-02-06 00:35:55 claus Exp $
"
!
@@ -55,6 +55,12 @@
"
! !
+!Depth2Image class methodsFor:'queries'!
+
+imageDepth
+ ^ 2
+! !
+
!Depth2Image methodsFor:'queries'!
bitsPerPixel
@@ -92,6 +98,29 @@
"return the number of samples per pixel in the image."
^ 1
+!
+
+usedColors
+ "return a collection of colors used in the receiver.
+ For depth1 images, this is very easy"
+
+ photometric ~~ #palette ifTrue:[
+ ^ Array with:Color black
+ with:(Color grey:33)
+ with:(Color grey:67)
+ with:Color black.
+ ].
+ ^ colorMap
+!
+
+usedValues
+ "return a collection of color values used in the receiver."
+
+ "actually, this is wrong - we have to look if those are
+ really used. However, assume that we dont care for
+ those extra colors here ..."
+
+ ^ #(0 1 2 3)
! !
!Depth2Image methodsFor:'accessing'!
@@ -121,7 +150,8 @@
|lineIndex "{ Class: SmallInteger }"
byte "{ Class: SmallInteger }"
shift "{ Class: SmallInteger }"
- value "{ Class: SmallInteger }" |
+ value "{ Class: SmallInteger }"
+ p|
lineIndex := (self bytesPerRow * y) + 1.
@@ -129,17 +159,10 @@
byte := bytes at:(lineIndex + (x // 4)).
shift := #(-6 -4 -2 0) at:((x \\ 4) + 1).
value := (byte bitShift:shift) bitAnd:3.
- photometric == #whiteIs0 ifTrue:[
- (value == 0) ifTrue:[
- ^ Color white
- ].
- (value == 1) ifTrue:[
- ^ Color grey:67
- ].
- (value == 2) ifTrue:[
- ^ Color grey:33
- ].
- ^ Color black
+ p := photometric.
+ p == #whiteIs0 ifTrue:[
+ value := 3 - value.
+ p := #blackIs0
].
photometric == #blackIs0 ifTrue:[
(value == 0) ifTrue:[
@@ -157,10 +180,7 @@
self error:'format not supported'.
^ nil
].
- 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))
+ ^ colorMap at:(value+1).
!
atX:x y:y putValue:aPixelValue
@@ -183,7 +203,7 @@
bytes at:index put:byte
! !
-!Depth2Image methodsFor:'enumeration'!
+!Depth2Image methodsFor:'enumerating'!
valueAtY:y from:xLow to:xHigh do:aBlock
"perform aBlock for each pixelValue from x1 to x2 in row y.
@@ -238,8 +258,7 @@
value "{ Class: SmallInteger }"
x1 "{ Class: SmallInteger }"
x2 "{ Class: SmallInteger }"
- color0 color1 color2 color3 color
- redMap greenMap blueMap|
+ color0 color1 color2 color3 color|
photometric == #whiteIs0 ifTrue:[
color0 := Color white.
@@ -254,21 +273,10 @@
color3 := Color white
] ifFalse:[
photometric == #palette ifTrue:[
- redMap := colorMap at:1.
- greenMap := colorMap at:2.
- blueMap := colorMap at:3.
- color0 := Color red:((redMap at:1) * 100 / 255)
- green:((greenMap at:1) * 100 / 255)
- blue:((blueMap at:1) * 100 / 255).
- color1 := Color red:((redMap at:2) * 100 / 255)
- green:((greenMap at:2) * 100 / 255)
- blue:((blueMap at:2) * 100 / 255).
- color2 := Color red:((redMap at:3) * 100 / 255)
- green:((greenMap at:3) * 100 / 255)
- blue:((blueMap at:3) * 100 / 255).
- color3 := Color red:((redMap at:4) * 100 / 255)
- green:((greenMap at:4) * 100 / 255)
- blue:((blueMap at:4) * 100 / 255).
+ color0 := colorMap at:1.
+ color1 := colorMap at:2.
+ color2 := colorMap at:3.
+ color3 := colorMap at:4.
] ifFalse:[
self error:'format not supported'.
^ nil
--- a/Depth4Image.st Mon Feb 06 01:30:10 1995 +0100
+++ b/Depth4Image.st Mon Feb 06 01:38:04 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Depth4Image.st,v 1.8 1994-11-17 14:29:11 claus Exp $
+$Header: /cvs/stx/stx/libview/Depth4Image.st,v 1.9 1995-02-06 00:35:57 claus Exp $
'!
!Depth4Image class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Depth4Image.st,v 1.8 1994-11-17 14:29:11 claus Exp $
+$Header: /cvs/stx/stx/libview/Depth4Image.st,v 1.9 1995-02-06 00:35:57 claus Exp $
"
!
@@ -55,6 +55,12 @@
"
! !
+!Depth4Image class methodsFor:'queries'!
+
+imageDepth
+ ^ 4
+! !
+
!Depth4Image methodsFor:'queries'!
bitsPerPixel
@@ -92,6 +98,29 @@
"return the number of samples per pixel in the image."
^ 1
+!
+
+usedValues
+ "return a collection of color values used in the receiver."
+
+ |useFlags usedValues|
+
+ useFlags := Array new:16 withAll:false.
+ width even ifFalse:[
+ 0 to:self height - 1 do:[:y |
+ self valueAtY:y from:0 to:self width - 1 do:[:x :pixel |
+ useFlags at:(pixel + 1) put:true
+ ]
+ ].
+ ] ifTrue:[
+ bytes usedValues do:[:byte |
+ useFlags at:(byte bitShift:-4)+1 put:true.
+ useFlags at:(byte bitAnd:2r1111)+1 put:true.
+ ].
+ ].
+ usedValues := OrderedCollection new.
+ 1 to:16 do:[:i | (useFlags at:i) ifTrue:[usedValues add:(i-1)]].
+ ^ usedValues
! !
!Depth4Image methodsFor:'accessing'!
@@ -142,9 +171,7 @@
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)
+ ^ colorMap at:(value + 1)
!
atX:x y:y putValue:aPixelValue
@@ -169,7 +196,7 @@
bytes at:index put:byte
! !
-!Depth4Image methodsFor:'enumeration'!
+!Depth4Image methodsFor:'enumerating'!
valueAtY:y from:xLow to:xHigh do:aBlock
"perform aBlock for each pixelValue from x1 to x2 in row y.
@@ -179,12 +206,12 @@
avoided when going from pixel to pixel. However, for
real image processing, specialized methods should be written."
- |srcIndex "{ Class: SmallInteger }"
- byte "{ Class: SmallInteger }"
- shift "{ Class: SmallInteger }"
- pixelValue "{ Class: SmallInteger }"
- x1 "{ Class: SmallInteger }"
- x2 "{ Class: SmallInteger }"
+ |srcIndex "{ Class: SmallInteger }"
+ byte "{ Class: SmallInteger }"
+ shift "{ Class: SmallInteger }"
+ pixelValue "{ Class: SmallInteger }"
+ x1 "{ Class: SmallInteger }"
+ x2 "{ Class: SmallInteger }"
|
x1 := xLow.
@@ -226,30 +253,26 @@
value "{ Class: SmallInteger }"
x1 "{ Class: SmallInteger }"
x2 "{ Class: SmallInteger }"
- colors|
+ colors p |
- colors := Array new:16.
- photometric == #whiteIs0 ifTrue:[
+ (p := photometric) == #whiteIs0 ifTrue:[
+ colors := Array new:16.
0 to:15 do:[:i |
colors at:(i+1) put:(Color grey:100 - (100 / 15 * i))
]
] ifFalse:[
- photometric == #blackIs0 ifTrue:[
+ p == #blackIs0 ifTrue:[
+ colors := Array new:16.
0 to:15 do:[:i |
colors at:(i+1) put:(Color grey:(100 / 15 * i))
]
] ifFalse:[
- photometric == #palette ifTrue:[
- 1 to:16 do:[:i |
- colors at:i
- put:(Color red:(((colorMap at:1) at:i) * 100 / 255)
- green:(((colorMap at:2) at:i) * 100 / 255)
- blue:(((colorMap at:3) at:i) * 100 / 255))
- ]
+ p == #palette ifTrue:[
+ colors := colorMap.
] ifFalse:[
self error:'format not supported'.
^ nil
- ]
+ ]
]
].
@@ -283,7 +306,8 @@
magnifyRowFrom:srcBytes offset:srcStart
into:dstBytes offset:dstStart factor:mX
- "magnify a single pixel row - can only magnify by integer factors"
+ "magnify a single pixel row - can only magnify by integer factors.
+ Specially tuned for factor 2."
%{
unsigned char *srcP, *dstP;
--- a/Depth8Image.st Mon Feb 06 01:30:10 1995 +0100
+++ b/Depth8Image.st Mon Feb 06 01:38:04 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Depth8Image.st,v 1.15 1994-11-28 21:00:47 claus Exp $
+$Header: /cvs/stx/stx/libview/Depth8Image.st,v 1.16 1995-02-06 00:35:59 claus Exp $
'!
!Depth8Image class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Depth8Image.st,v 1.15 1994-11-28 21:00:47 claus Exp $
+$Header: /cvs/stx/stx/libview/Depth8Image.st,v 1.16 1995-02-06 00:35:59 claus Exp $
"
!
@@ -54,7 +54,13 @@
"
! !
-!Depth8Image methodsFor:'accessing'!
+!Depth8Image class methodsFor:'queries'!
+
+imageDepth
+ ^ 8
+! !
+
+!Depth8Image methodsFor:'queries'!
bitsPerPixel
"return the number of bits per pixel"
@@ -85,6 +91,12 @@
"return the number of samples per pixel in the image."
^ 1
+!
+
+usedValues
+ "return a collection of color values used in the receiver."
+
+ ^ bytes usedValues
! !
!Depth8Image methodsFor:'accessing'!
@@ -111,9 +123,7 @@
^ nil
].
index := value + 1.
- ^ Color red:(((colorMap at:1) at:index) * 100 / 255)
- green:(((colorMap at:2) at:index) * 100 / 255)
- blue:(((colorMap at:3) at:index) * 100 / 255)
+ ^ colorMap at:index
!
valueAtX:x y:y
@@ -138,7 +148,7 @@
bytes at:index put:aPixelValue.
! !
-!Depth8Image methodsFor:'enumeration'!
+!Depth8Image methodsFor:'enumerating'!
valueAtY:y from:xLow to:xHigh do:aBlock
"perform aBlock for each pixelValue from x1 to x2 in row y.
@@ -149,7 +159,6 @@
real image processing, specialized methods should be written."
|srcIndex "{ Class: SmallInteger }"
- index "{ Class: SmallInteger }"
pixelValue "{ Class: SmallInteger }"
x1 "{ Class: SmallInteger }"
x2 "{ Class: SmallInteger }"|
@@ -180,7 +189,11 @@
x2 "{ Class: SmallInteger }"
color colors last|
- colors := Array new:256.
+ photometric == #palette ifTrue:[
+ colors := colorMap.
+ ] ifFalse:[
+ colors := Array new:256.
+ ].
x1 := xLow.
x2 := xHigh.
@@ -195,16 +208,12 @@
color := colors at:index.
color isNil ifTrue:[
photometric == #whiteIs0 ifTrue:[
- color := (Color grey:100 - (100 / 255 * value))
+ color := (Color grey:100 - (100 * value / 255))
] ifFalse:[
photometric == #blackIs0 ifTrue:[
- color := (Color grey:(100 / 255 * value))
+ color := (Color grey:(100 * value / 255))
] ifFalse:[
- photometric == #palette ifTrue:[
- color := (Color red:(((colorMap at:1) at:index) * 100 / 255)
- green:(((colorMap at:2) at:index) * 100 / 255)
- blue:(((colorMap at:3) at:index) * 100 / 255))
- ] ifFalse:[
+ photometric ~~ #palette ifTrue:[
self error:'format not supported'.
^ nil
]
@@ -368,7 +377,7 @@
pixel0bytes := ByteArray uninitializedNew:nColors.
pixel1bytes := ByteArray uninitializedNew:nColors.
- "extract dither patterns and values to use for 1/o bits
+ "extract dither patterns and values to use for 1/0 bits
in those from the dithercolors"
1 to:nColors do:[:i |
@@ -466,7 +475,7 @@
|monoBits f
map rMap gMap bMap
- fast
+ failed
r g b
v "{ Class: SmallInteger }"
bitCount "{ Class: SmallInteger }"
@@ -475,34 +484,23 @@
h "{ Class: SmallInteger }"
mapSize "{ Class: SmallInteger }"
srcIndex "{ Class: SmallInteger }"
- dstIndex "{ Class: SmallInteger }" |
+ dstIndex "{ Class: SmallInteger }"|
w := width.
h := height.
monoBits := ByteArray uninitializedNew:(((w + 7) // 8) * h).
- rMap := colorMap at:1.
- gMap := colorMap at:2.
- bMap := colorMap at:3.
map := ByteArray uninitializedNew:256.
+ mapSize := colorMap size.
- mapSize := rMap size.
+ "
+ map entries: 0 for dark entries, 1 for bright entries
+ "
1 to:mapSize do:[:i |
- r := rMap at:i.
- r notNil ifTrue:[
- g := gMap at:i.
- b := bMap at:i.
- v := ((3 * r) + (6 * g) + (1 * b)) // 10.
- v := v bitShift:-7. "only keep hi-bit"
- (v == 1) ifTrue:[
- map at:i put:0 "was: 1"
- ] ifFalse:[
- map at:i put:1 "was: 0"
- ]
- ]
+ map at:i put:(colorMap at:i) brightness rounded
].
- fast := false.
+ failed := true.
%{
register unsigned char *srcPtr, *dstPtr, *mapPtr;
register __v, __bits, __bitCount;
@@ -510,8 +508,10 @@
register i;
extern OBJ ByteArray;
- if (__isByteArray(_INST(bytes)) && __isByteArray(map) && __isByteArray(monoBits)) {
- fast = true;
+ if (__isByteArray(_INST(bytes))
+ && __isByteArray(map)
+ && __isByteArray(monoBits)) {
+ failed = false;
srcPtr = _ByteArrayInstPtr(_INST(bytes))->ba_element;
dstPtr = _ByteArrayInstPtr(monoBits)->ba_element;
mapPtr = _ByteArrayInstPtr(map)->ba_element;
@@ -535,31 +535,38 @@
}
%}
.
- fast ifFalse:[
- srcIndex := 1.
- dstIndex := 1.
- 1 to:h do:[:row |
-
- bitCount := 0.
- bits := 0.
- 1 to:w do:[:col |
- v := bytes at:srcIndex.
- srcIndex := srcIndex + 1.
- v := map at:(v + 1).
- bits := (bits bitShift:1) bitOr:v.
- bitCount := bitCount + 1.
- (bitCount == 8) ifTrue:[
- monoBits at:dstIndex put:bits.
- dstIndex := dstIndex + 1.
- bits := 0.
- bitCount := 0
- ]
- ].
- (bitCount ~~ 0) ifTrue:[
- monoBits at:dstIndex put:bits.
- dstIndex := dstIndex + 1
- ]
- ]
+ failed ifTrue:[
+"/
+"/ the above code is equivalent to:
+"/
+"/ srcIndex := 1.
+"/ dstIndex := 1.
+"/ 1 to:h do:[:row |
+"/
+"/ bitCount := 0.
+"/ bits := 0.
+"/ 1 to:w do:[:col |
+"/ v := bytes at:srcIndex.
+"/ srcIndex := srcIndex + 1.
+"/ v := map at:(v + 1).
+"/ bits := (bits bitShift:1) bitOr:v.
+"/ bitCount := bitCount + 1.
+"/ (bitCount == 8) ifTrue:[
+"/ monoBits at:dstIndex put:bits.
+"/ dstIndex := dstIndex + 1.
+"/ bits := 0.
+"/ bitCount := 0
+"/ ]
+"/ ].
+"/ (bitCount ~~ 0) ifTrue:[
+"/ monoBits at:dstIndex put:bits.
+"/ dstIndex := dstIndex + 1
+"/ ]
+"/ ]
+"/
+"/ we dont need the fall-back code; so trigger an error
+ self primitiveFailed.
+ ^ nil
].
f := Form width:w height:h depth:1 on:aDevice.
@@ -581,7 +588,7 @@
and black for brightness values 100..75, 75..50, 50..25 and 25..0 %"
|twoPlaneBits f
- map rMap gMap bMap fast
+ map rMap gMap bMap failed
v "{ Class: SmallInteger }"
bitCount "{ Class: SmallInteger }"
bits "{ Class: SmallInteger }"
@@ -595,23 +602,17 @@
h := height.
twoPlaneBits := ByteArray uninitializedNew:(((w * 2 + 7) // 8) * h).
- rMap := colorMap at:1.
- gMap := colorMap at:2.
- bMap := colorMap at:3.
map := ByteArray uninitializedNew:256.
- 1 to:(rMap size) do:[:i |
- |r g b v|
+ mapSize := colorMap size.
- r := rMap at:i.
- r notNil ifTrue:[
- g := gMap at:i.
- b := bMap at:i.
- v := ((3 * r) + (6 * g) + (1 * b)) // 10.
- v := v bitShift:-6. "only keep hi-2-bits"
- map at:i put:v
- ]
+ "
+ map entries: 0 .. 3 give brightness in 4 thresholded steps
+ "
+ 1 to:mapSize do:[:i |
+ map at:i put:(colorMap at:i) brightness * 3 rounded
].
- fast := false.
+
+ failed := true.
%{
register unsigned char *srcPtr, *dstPtr, *mapPtr;
register __v, __bits, __bitCount;
@@ -619,8 +620,10 @@
register i;
extern OBJ ByteArray;
- if ((__isByteArray(_INST(bytes))) && (__isByteArray(map)) && (__isByteArray(twoPlaneBits))) {
- fast = true;
+ if ((__isByteArray(_INST(bytes)))
+ && (__isByteArray(map))
+ && (__isByteArray(twoPlaneBits))) {
+ failed = false;
srcPtr = _ByteArrayInstPtr(_INST(bytes))->ba_element;
dstPtr = _ByteArrayInstPtr(twoPlaneBits)->ba_element;
mapPtr = _ByteArrayInstPtr(map)->ba_element;
@@ -642,32 +645,37 @@
}
}
}
-%}
-.
- fast ifFalse:[
- srcIndex := 1.
- dstIndex := 1.
- 1 to:h do:[:row |
- bitCount := 0.
- bits := 0.
- 1 to:w do:[:col |
- v := bytes at:srcIndex.
- srcIndex := srcIndex + 1.
- v := map at:(v + 1).
- bits := (bits bitShift:2) bitOr:v.
- bitCount := bitCount + 1.
- (bitCount == 4) ifTrue:[
- twoPlaneBits at:dstIndex put:bits.
- dstIndex := dstIndex + 1.
- bits := 0.
- bitCount := 0
- ]
- ].
- (bitCount ~~ 0) ifTrue:[
- twoPlaneBits at:dstIndex put:bits.
- dstIndex := dstIndex + 1
- ]
- ]
+%}.
+ failed ifTrue:[
+"/
+"/ the above code is equivalent to:
+"/
+"/ srcIndex := 1.
+"/ dstIndex := 1.
+"/ 1 to:h do:[:row |
+"/ bitCount := 0.
+"/ bits := 0.
+"/ 1 to:w do:[:col |
+"/ v := bytes at:srcIndex.
+"/ srcIndex := srcIndex + 1.
+"/ v := map at:(v + 1).
+"/ bits := (bits bitShift:2) bitOr:v.
+"/ bitCount := bitCount + 1.
+"/ (bitCount == 4) ifTrue:[
+"/ twoPlaneBits at:dstIndex put:bits.
+"/ dstIndex := dstIndex + 1.
+"/ bits := 0.
+"/ bitCount := 0
+"/ ]
+"/ ].
+"/ (bitCount ~~ 0) ifTrue:[
+"/ twoPlaneBits at:dstIndex put:bits.
+"/ dstIndex := dstIndex + 1
+"/ ]
+"/ ]
+"/
+ self primitiveFailed.
+ ^ nil
].
f := Form width:w height:h depth:2 on:aDevice.
@@ -683,19 +691,303 @@
^ f
!
+paletteImageAsDitheredPseudoFormOn:aDevice
+ "return a dithered pseudoForm from the palette picture. Depend
+ on dither colors being preallocated (see Color>>getColors*)"
+
+ ^ self paletteImageAsDitheredPseudoFormOn:aDevice
+ colors:Color fixColors
+ nRed:Color numFixRed
+ nGreen:Color numFixGreen
+ nBlue:Color numFixBlue
+!
+
+paletteImageAsDitheredPseudoFormOn:aDevice colors:fixColors nRed:nRed nGreen:nGreen nBlue:nBlue
+ "return a dithered pseudoForm from the palette picture.
+ Use the colors in the fixColors array, which must be fixR x fixG x fixB
+ colors assigned to aDevice, such as the preallocated colors of the
+ Color class.
+ By passing the ditherColors as extra array, this method can
+ also be used to dither an 8bit image into a smaller number of colors,
+ for example to create Depth4Images."
+
+ "the code below is a q&d hack - it needs a rewrite to use a
+ floyd-steinberg dither (currently, the error is only forwarded
+ to the next pixel on the right, which seems ok for photograph-like
+ images, but leads to more artifacts with equal colored areas).
+ "
+
+ |pseudoBits f has8BitImage deviceDepth
+ redBytes greenBytes blueBytes
+"/ eR "{Class: SmallInteger }"
+"/ eG "{Class: SmallInteger }"
+"/ eB "{Class: SmallInteger }"
+"/ wantR "{Class: SmallInteger }"
+"/ wantG "{Class: SmallInteger }"
+"/ wantB "{Class: SmallInteger }"
+ w "{Class: SmallInteger }"
+ h "{Class: SmallInteger }"
+ index "{Class: SmallInteger }"
+ fixR "{Class: SmallInteger }"
+ fixG "{Class: SmallInteger }"
+ fixB "{Class: SmallInteger }"
+ fixIds failed|
+
+ aDevice ~~ Display ifTrue:[^ nil].
+
+ fixR := nRed.
+ fixR == 0 ifTrue:[ ^ nil].
+ fixG := nGreen.
+ fixG == 0 ifTrue:[ ^ nil].
+ fixB := nBlue.
+ fixB == 0 ifTrue:[ ^ nil].
+ "/ simple check
+ (fixR * fixG * fixB) ~~ fixColors size ifTrue:[
+ self error:'invalid color array passed'.
+ ^ nil
+ ].
+ fixIds := (fixColors asArray collect:[:clr | clr colorId]) asByteArray.
+
+ deviceDepth := aDevice depth.
+ deviceDepth == 8 ifTrue:[
+ has8BitImage := true.
+ ] ifFalse:[
+ has8BitImage := false.
+ aDevice supportedImageFormats do:[:fmt |
+ (fmt at:2) == 8 ifTrue:[
+ has8BitImage := true.
+ ]
+ ]
+ ].
+ has8BitImage ifFalse:[^ nil].
+
+ 'D8IMAGE: dithering ...' errorPrintNL.
+
+ "
+ collect color components as integer values
+ (code below uses components percent * 2.55 asInteger everywhere, to avoid
+ float arithmetic, rounding etc. Thus, the range is 0..255 here)
+ "
+ redBytes := ByteArray uninitializedNew:(colorMap size).
+ greenBytes := ByteArray uninitializedNew:(colorMap size).
+ blueBytes := ByteArray uninitializedNew:(colorMap size).
+ 1 to:(colorMap size) do:[:i |
+ |clr|
+ clr := colorMap at:i.
+ redBytes at:i put:(clr red * 2.55) asInteger.
+ greenBytes at:i put:(clr green * 2.55) asInteger.
+ blueBytes at:i put:(clr blue * 2.55) asInteger.
+ ].
+
+ pseudoBits := ByteArray uninitializedNew:(width * height).
+
+ w := width.
+ h := height.
+
+ failed := true.
+
+%{
+ int __x, __y;
+ int __eR, __eG, __eB;
+ int __wantR, __wantG, __wantB;
+ unsigned char *srcP, *dstP;
+ unsigned char *redP, *greenP, *blueP;
+ int pix;
+ unsigned char *idP;
+ int __fR, __fG, __fB;
+ int iR, iG, iB;
+ int idx;
+
+ if (__isByteArray(_INST(bytes))
+ && __isByteArray(pseudoBits)
+ && __isByteArray(redBytes)
+ && __isByteArray(greenBytes)
+ && __isByteArray(blueBytes)
+ && __isByteArray(fixIds)
+ && _isSmallInteger(fixR)
+ && _isSmallInteger(fixG)
+ && _isSmallInteger(fixB)) {
+ failed = false;
+
+ srcP = _ByteArrayInstPtr(_INST(bytes))->ba_element;
+ dstP = _ByteArrayInstPtr(pseudoBits)->ba_element;
+ redP = _ByteArrayInstPtr(redBytes)->ba_element;
+ greenP = _ByteArrayInstPtr(greenBytes)->ba_element;
+ blueP = _ByteArrayInstPtr(blueBytes)->ba_element;
+ idP = _ByteArrayInstPtr(fixIds)->ba_element;
+ __fR = _intVal(fixR)-1;
+ __fG = _intVal(fixG)-1;
+ __fB = _intVal(fixB)-1;
+
+ for (__y=_intVal(h); __y>0; __y--) {
+ __eR = __eG = __eB = 0;
+ for (__x=_intVal(w); __x>0; __x--) {
+ int t;
+ int __want;
+
+ pix = *srcP++;
+
+ /*
+ * wR, wG and wB is the wanted r/g/b value;
+ * compute the index into the dId table ..
+ * values: 0..255; scale to 0..fR-1, 0..fG-1, 0..fB-1
+ *
+ * bad kludge: knows how to index into FixColor table
+ */
+ __wantR = redP[pix] + __eR;
+ __wantG = greenP[pix] + __eG;
+ __wantB = blueP[pix] + __eB;
+
+ if (__wantR > 255) __want = 255;
+ else if (__wantR < 0) __want = 0;
+ else __want = __wantR;
+
+ iR = __want * __fR / 128;
+ iR = (iR / 2) + (iR & 1);
+ idx = iR * (__fG+1);
+
+ if (__wantG > 255) __want = 255;
+ else if (__wantG < 0) __want = 0;
+ else __want = __wantG;
+
+ iG = __want * __fG / 128;
+ iG = (iG / 2) + (iG & 1);
+ idx = (idx + iG) * (__fB+1);
+
+ if (__wantB > 255) __want = 255;
+ else if (__wantB < 0) __want = 0;
+ else __want = __wantB;
+
+ iB = __want * __fB / 128;
+ iB = (iB / 2) + (iB & 1);
+ idx = idx + iB;
+
+ /*
+ * store the corresponding dither colorId
+ */
+ *dstP++ = idP[idx];
+
+ /*
+ * the new error:
+ */
+ __eR = __wantR - (iR * 256 / __fR);
+ __eG = __wantG - (iG * 256 / __fG);
+ __eB = __wantB - (iB * 256 / __fB);
+ }
+ }
+ }
+%}.
+ failed ifTrue:[
+ self primitiveFailed.
+ ^ nil
+
+"/ for non-C programmers:
+"/ the above code is (roughly) equivalent to:
+"/
+"/ index := 1.
+"/ 1 to:h do:[:y |
+"/ eR := eG := eB := 0.
+"/ 1 to:w do:[:x |
+"/ |pixel "{ Class: SmallInteger }"
+"/ clr
+"/ wR "{ Class: SmallInteger }"
+"/ wG "{ Class: SmallInteger }"
+"/ wB "{ Class: SmallInteger }" |
+"/
+"/ pixel := (bytes at:index) + 1.
+"/
+"/ wantR := ((redBytes at:pixel) + eR).
+"/ wantG := ((greenBytes at:pixel) + eG).
+"/ wantB := ((blueBytes at:pixel) + eB).
+"/ wR := wantR.
+"/ wR > 200 ifTrue:[wR := 200] ifFalse:[wR < 0 ifTrue:[wR := 0]].
+"/ wG := wantG.
+"/ wG > 200 ifTrue:[wG := 200] ifFalse:[wG < 0 ifTrue:[wG := 0]].
+"/ wB := wantB.
+"/ wB > 200 ifTrue:[wB := 200] ifFalse:[wB < 0 ifTrue:[wB := 0]].
+"/
+"/ iR := wR * (fixR-1) / 128.
+"/ iR := (iR / 2) + (iR bitAnd:1).
+"/ iG := wG * (fixG-1) / 128.
+"/ iG := (iG / 2) + (iG bitAnd:1).
+"/ iB := wB * (fixB-1) / 128.
+"/ iB := (iB / 2) + (iB bitAnd:1).
+"/ idx := (iR * fixR + iG) * fixB + iB.
+"/ clr := fixColors at:idx.
+"/
+"/ eR := wantR - (clr red * 2) asInteger.
+"/ eG := wantG - (clr green * 2) asInteger.
+"/ eB := wantB - (clr blue * 2) asInteger.
+"/
+"/ pixel := clr colorId.
+"/ pseudoBits at:index put:pixel.
+"/
+"/ index := index + 1
+"/ ].
+"/ ].
+ ].
+
+ f := Form width:width height:height depth:deviceDepth on:aDevice.
+ f isNil ifTrue:[^ nil].
+ f colorMap:fixColors.
+ f initGC.
+ aDevice drawBits:pseudoBits bitsPerPixel:8 depth:deviceDepth
+ width:width height:height
+ x:0 y:0
+ into:(f id) x:0 y:0
+ width:width height:height with:(f gcId).
+ ^ f
+
+ "
+ example: color reduction from Depth8 to Depth4 can be done by:
+
+ |img8 reducedImg8 img4 map|
+
+ map := #(
+ (0 0 0)
+ (0 0 100)
+ (0 50 0)
+ (0 50 100)
+ (0 100 0)
+ (0 100 100)
+ (100 0 0)
+ (100 0 100)
+ (100 50 0)
+ (100 50 100)
+ (100 100 0)
+ (100 100 100)) collect:[:rgb | (Color red:(rgb at:1)
+ green:(rgb at:2)
+ blue:(rgb at:3)) on:Display].
+
+ img8 := Image fromFile:'bitmaps/bf.im8'.
+ form := img8 paletteImageAsDitheredPseudoFormOn:Display
+ colors:map
+ nRed:2
+ nGreen:3
+ nBlue:2.
+ img8 := Depth8Image fromForm:form.
+ img4 := Depth4Image fromImage:img8.
+ "
+!
+
paletteImageAsPseudoFormOn:aDevice
"return a pseudoForm from the palette picture. The main work is
in color reduction, when not all colors can be aquired."
|pseudoBits f gcRound has8BitImage deviceDepth
imgMap newImage pxl
- usedColors usageCounts nUsed map mapIndex rMap gMap bMap
- fit scale lastOK error
+ usedColors usageCounts nUsed map
+ fit scale lastOK error
div
shift "{Class: SmallInteger }"
m "{Class: SmallInteger }" |
- 'D8Image: allocating colors ...' errorPrintNewline.
+ Color fixColors notNil ifTrue:[
+ f := self paletteImageAsDitheredPseudoFormOn:aDevice.
+ f notNil ifTrue:[^ f].
+ ].
+
+ 'D8IMAGE: allocating colors ...' errorPrintNL.
"find used colors"
@@ -710,14 +1002,11 @@
"allocate the colors (in order of usage count)"
- rMap := colorMap at:1.
- gMap := colorMap at:2.
- bMap := colorMap at:3.
-
imgMap := Array new:nUsed.
- "first, we try to get the exact colors"
-
+ "
+ first, try to get the exact colors ...
+ "
shift := (8 - aDevice bitsPerRGB) negated.
m := (1 bitShift:(aDevice bitsPerRGB)) - 1.
div := m asFloat.
@@ -725,42 +1014,48 @@
fit := true.
scale := 100.0 / div. "to scale 0..255 into 0.0 .. 100.0"
lastOK := 0.
+ gcRound := 0.
+
usedColors do:[:aColorIndex |
|devColor color
- r "{Class: SmallInteger }"
- g "{Class: SmallInteger }"
- b "{Class: SmallInteger }"
- rMask "{Class: SmallInteger }"
- gMask "{Class: SmallInteger }"
- bMask "{Class: SmallInteger }"|
+ r "{Class: SmallInteger }"
+ g "{Class: SmallInteger }"
+ b "{Class: SmallInteger }"
+ mapIndex "{Class: SmallInteger }"
+ rMask "{Class: SmallInteger }"
+ gMask "{Class: SmallInteger }"
+ bMask "{Class: SmallInteger }"|
fit ifTrue:[
gMask := bMask := rMask := m.
mapIndex := aColorIndex + 1.
- r := rMap at:mapIndex.
- g := gMap at:mapIndex.
- b := bMap at:mapIndex.
- color := Color red:((r bitShift:shift) bitAnd:rMask) * scale
- green:((g bitShift:shift) bitAnd:gMask) * scale
- blue:((b bitShift:shift) bitAnd:bMask) * scale.
- devColor := color exactOn:aDevice.
- devColor isNil ifTrue:[
- "no such color - on the first round, do a GC to flush unused
- colors - this may help"
- gcRound == 0 ifTrue:[
- ObjectMemory scavenge.
- devColor := color exactOn:aDevice.
- gcRound := 1
+ color := colorMap at:mapIndex.
+ color colorId notNil ifTrue:[
+ "wow - an immediate hit"
+ devColor := color
+ ] ifFalse:[
+ devColor := color exactOn:aDevice.
+ devColor isNil ifTrue:[
+ "
+ could not allocate color - on the first round, do a GC to flush
+ unused colors - this may help if some colors where locked by
+ already free images.
+ "
+ gcRound == 0 ifTrue:[
+ ObjectMemory scavenge.
+ devColor := color exactOn:aDevice.
+ gcRound := 1
+ ].
+ devColor isNil ifTrue:[
+ gcRound == 1 ifTrue:[
+ 'D8IMAGE: force GC for possible color reclamation.' errorPrintNL.
+ ObjectMemory markAndSweep.
+ devColor := color exactOn:aDevice.
+ gcRound := 2
+ ]
+ ]
].
- devColor isNil ifTrue:[
- gcRound == 1 ifTrue:[
- 'D8Image: force GC for possible color reclamation.' errorPrintNL.
- ObjectMemory markAndSweep.
- devColor := color exactOn:aDevice.
- gcRound := 2
- ]
- ]
].
(devColor notNil and:[devColor colorId notNil]) ifTrue:[
imgMap at:mapIndex put:devColor.
@@ -771,49 +1066,61 @@
]
].
- "again, this time allow wrong colors (loop while increasing allowed error)"
-
fit ifFalse:[
- gcRound := 0.
+ "
+ again, this time allow wrong colors (loop while increasing allowed error)
+ "
error := 10.
[fit] whileFalse:[
fit := true.
usedColors from:(lastOK+1) to:(usedColors size) do:[:aColorIndex |
|devColor color
- r "{Class: SmallInteger }"
- g "{Class: SmallInteger }"
- b "{Class: SmallInteger }"
- rMask "{Class: SmallInteger }"
- gMask "{Class: SmallInteger }"
- bMask "{Class: SmallInteger }"|
+ r "{Class: SmallInteger }"
+ g "{Class: SmallInteger }"
+ b "{Class: SmallInteger }"
+ mapIndex "{Class: SmallInteger }"
+ rMask "{Class: SmallInteger }"
+ gMask "{Class: SmallInteger }"
+ bMask "{Class: SmallInteger }"|
fit ifTrue:[
gMask := bMask := rMask := m.
mapIndex := aColorIndex + 1.
- r := rMap at:mapIndex.
- g := gMap at:mapIndex.
- b := bMap at:mapIndex.
+ color := colorMap at:mapIndex.
+ r := (color red * 255 / 100) rounded.
+ g := (color green * 255 / 100) rounded.
+ b := (color blue * 255 / 100) rounded.
+
color := Color red:((r bitShift:shift) bitAnd:rMask) * scale
green:((g bitShift:shift) bitAnd:gMask) * scale
blue:((b bitShift:shift) bitAnd:bMask) * scale.
- devColor := color nearestOn:aDevice error:error.
- devColor isNil ifTrue:[
- "no such color - on the first round, do a GC to flush unused
- colors - this may help"
- gcRound == 0 ifTrue:[
- ObjectMemory scavenge.
- devColor := color nearestOn:aDevice error:error.
- gcRound := 1
+
+ color colorId notNil ifTrue:[
+ "wow - an immediate hit"
+ devColor := color
+ ] ifFalse:[
+ devColor := color nearestOn:aDevice error:error.
+ devColor isNil ifTrue:[
+ "
+ no free color - on the first round, do a GC to flush unused
+ colors - this may help if some colors where locked by already
+ free images.
+ "
+ gcRound == 0 ifTrue:[
+ ObjectMemory scavenge.
+ devColor := color nearestOn:aDevice error:error.
+ gcRound := 1
+ ].
+ devColor isNil ifTrue:[
+ gcRound == 1 ifTrue:[
+ 'D8IMAGE: force GC for possible color reclamation.' errorPrintNL.
+ ObjectMemory markAndSweep.
+ devColor := color nearestOn:aDevice error:error.
+ gcRound := 2
+ ]
+ ]
].
- devColor isNil ifTrue:[
- gcRound == 1 ifTrue:[
- 'D8Image: force GC for possible color reclamation.' errorPrintNL.
- ObjectMemory markAndSweep.
- devColor := color nearestOn:aDevice error:error.
- gcRound := 2
- ]
- ]
].
(devColor notNil and:[devColor colorId notNil]) ifTrue:[
imgMap at:mapIndex put:devColor.
@@ -823,17 +1130,42 @@
]
].
].
- error := error * 2
+ error := error * 2.
+ error > 1000 ifTrue:[
+ "
+ break out, if the error becomes too big.
+ "
+ 'D8IMAGE: hard color allocation problem - revert to b&w' errorPrintNL.
+ "
+ map to b&w as a last fallback.
+ (should really do a dither here)
+ "
+ usedColors from:(lastOK+1) to:(usedColors size) do:[:aColorIndex |
+ |color
+ mapIndex "{ Class: SmallInteger }"|
+
+ mapIndex := aColorIndex + 1.
+ color := colorMap at:mapIndex.
+ color brightness > 0.5 ifTrue:[
+ imgMap at:mapIndex put:(Color white on:aDevice).
+ ] ifFalse:[
+ imgMap at:mapIndex put:(Color black on:aDevice).
+ ]
+ ].
+ fit := true.
+ ]
].
error > 100 ifTrue:[
- 'D8Image: not enough colors for a reasonable image' errorPrintNewline
+ 'D8IMAGE: not enough colors for a reasonable image' errorPrintNL
] ifFalse:[
- 'D8Image: not enough colors for exact picture' errorPrintNewline.
+ 'D8IMAGE: not enough colors for exact picture' errorPrintNL.
]
].
- "create translation map"
+ "
+ create translation map (from image colors to allocated colorIds)
+ "
map := ByteArray new:256.
1 to:imgMap size do:[:i |
(imgMap at:i) notNil ifTrue:[
@@ -853,6 +1185,10 @@
]
].
+ "
+ finally, create a form on the device and copy (& translate)
+ the pixel values
+ "
has8BitImage ifTrue:[
pseudoBits := ByteArray uninitializedNew:(width * height).
@@ -909,30 +1245,18 @@
"return an 8-bit greyForm from the 8-bit palette picture;
only a translation has to be done"
- |greyBits f v
- nColors "{ Class: SmallInteger }"
- r "{ Class: SmallInteger }"
- g "{ Class: SmallInteger }"
- b "{ Class: SmallInteger }"
- map rMap gMap bMap|
+ |greyBits f map
+ mapSize "{ Class: SmallInteger }"|
greyBits := ByteArray uninitializedNew:(width * height).
- rMap := colorMap at:1.
- gMap := colorMap at:2.
- bMap := colorMap at:3.
- nColors := rMap size.
map := ByteArray uninitializedNew:256.
+ mapSize := colorMap size.
- 1 to:nColors do:[:i |
- r := rMap at:i.
- r notNil ifTrue:[
- g := gMap at:i.
- b := bMap at:i.
- v := ((3 * r) + (6 * g) + (1 * b)) // 10.
- map at:i put:v
- ]
+ 1 to:mapSize do:[:i |
+ map at:i put:((colorMap at:i) brightness * 255) rounded
].
+
bytes expandPixels:8 "xlate only"
width:width
height:height
@@ -954,10 +1278,8 @@
works for any destination depth - but is very slow for some."
|f
- r g b
- map rMap gMap bMap
- run last ditherColors first delta
- clr depth
+ map run last ditherColors first delta
+ clr depth grey
nDither "{Class: SmallInteger }"
nColors "{Class: SmallInteger }"
w "{Class: SmallInteger }"
@@ -977,23 +1299,12 @@
ditherColors at:i+1 put:(Color grey:(i * delta + first)).
].
- rMap := colorMap at:1.
- gMap := colorMap at:2.
- bMap := colorMap at:3.
- nColors := rMap size.
+ nColors := colorMap size.
map := Array new:nColors.
-
1 to:nColors do:[:i |
- r := rMap at:i.
- r notNil ifTrue:[
- g := gMap at:i.
- b := bMap at:i.
- v := ((3 * r) + (6 * g) + (1 * b)) asInteger.
- " v is now in the range 0 .. 2550 "
- v := (v * (nDither - 1) // 2550) rounded.
- " v is now 0 .. nDither-1 "
- map at:i put:(ditherColors at:(v + 1))
- ]
+ clr := colorMap at:i.
+ grey := clr brightness.
+ map at:i put:(ditherColors at:(v * (nDither - 1)) rounded)
].
"tuning - code below is so slooow"
@@ -1395,7 +1706,7 @@
into:dstBytes offset:dstStart factor:mX
"magnify a single pixel row - can only magnify by integer factors.
- Especially tuned for factors 2,3 and 4."
+ Specially tuned for factors 2,3 and 4."
%{
REGISTER unsigned char *srcP, *dstP;
@@ -1468,7 +1779,7 @@
|mX mY
newWidth "{ Class: SmallInteger }"
newHeight "{ Class: SmallInteger }"
- w "{ Class: SmallInteger }"
+ w "{ Class: SmallInteger }"
h "{ Class: SmallInteger }"
newImage newBytes
value "{ Class: SmallInteger }"
@@ -1518,21 +1829,21 @@
}
%}
.
-" the above C-code is equivalent to:
-
- dstIndex := 1.
- w := newWidth - 1.
- h := newHeight - 1.
- 0 to:h do:[:row |
- srcRowIdx := (width * (row // mY)) + 1.
- 0 to:w do:[:col |
- srcIndex := srcRowIdx + (col // mX).
- value := bytes at:srcIndex.
- newBytes at:dstIndex put:value.
- dstIndex := dstIndex + 1
- ]
- ].
-"
+"/ the above C-code is equivalent to:
+"/
+"/ dstIndex := 1.
+"/ w := newWidth - 1.
+"/ h := newHeight - 1.
+"/ 0 to:h do:[:row |
+"/ srcRowIdx := (width * (row // mY)) + 1.
+"/ 0 to:w do:[:col |
+"/ srcIndex := srcRowIdx + (col // mX).
+"/ value := bytes at:srcIndex.
+"/ newBytes at:dstIndex put:value.
+"/ dstIndex := dstIndex + 1
+"/ ]
+"/ ].
+"/
^ newImage
! !
--- a/DevDraw.st Mon Feb 06 01:30:10 1995 +0100
+++ b/DevDraw.st Mon Feb 06 01:38:04 1995 +0100
@@ -14,7 +14,7 @@
instanceVariableNames:'device drawableId gcId
realized
deviceFont foreground background'
- classVariableNames:''
+ classVariableNames:'CachedScaledForms CachedScales'
poolDictionaries:''
category:'Graphics-Support'
!
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/DevDraw.st,v 1.16 1994-11-21 16:43:08 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DevDraw.st,v 1.17 1995-02-06 00:36:03 claus Exp $
'!
!DeviceDrawable class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/DevDraw.st,v 1.16 1994-11-21 16:43:08 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DevDraw.st,v 1.17 1995-02-06 00:36:03 claus Exp $
"
!
@@ -607,10 +607,18 @@
lineWidth:aNumber
"set the line width for drawing if it has changed"
+ |n|
+
(aNumber ~~ lineWidth) ifTrue:[
lineWidth := aNumber.
+ transformation isNil ifTrue:[
+ n := aNumber.
+ ] ifFalse:[
+ n := transformation applyScaleX:aNumber.
+ n := n rounded
+ ].
gcId notNil ifTrue:[
- device setLineWidth:aNumber
+ device setLineWidth:n
style:lineStyle
cap:capStyle
join:joinStyle
@@ -706,12 +714,18 @@
!
setMaskOrigin:aPoint
- "set the origin of the pattern"
+ "set the origin of the fill pattern"
(maskOrigin isNil or:[maskOrigin ~= aPoint]) ifTrue:[
- maskOrigin := aPoint.
+ transformation isNil ifTrue:[
+ maskOrigin := aPoint.
+ ] ifFalse:[
+ maskOrigin := transformation applyTo:aPoint
+ ].
gcId notNil ifTrue:[
- device setMaskOriginX:aPoint x rounded y:aPoint y rounded in:gcId
+ device setMaskOriginX:maskOrigin x rounded
+ y:maskOrigin y rounded
+ in:gcId
]
]
!
@@ -737,33 +751,13 @@
(maskOrigin isNil or:[
((x ~~ maskOrigin x) or:[y ~~ maskOrigin y]) ]) ifTrue:[
- maskOrigin := x @ y.
+ maskOrigin := x @ y.
gcId notNil ifTrue:[
device setMaskOriginX:x y:y in:gcId
]
]
!
-XXXclipDeviceX:x y:y width:w height:h
- "set the clipping rectangle for drawing "
-
- clipRect notNil ifTrue:[
- (clipRect left == x) ifTrue:[
- (clipRect top == y) ifTrue:[
- (clipRect width == w) ifTrue:[
- (clipRect height == h) ifTrue:[
- ^ self
- ]
- ]
- ]
- ]
- ].
- clipRect := Rectangle left:x top:y width:w height:h.
- gcId notNil ifTrue:[
- device setClipX:x y:y width:w height:h in:gcId
- ]
-!
-
clipRect:aRectangle
"set the clipping rectangle for drawing (in logical coordinates);
a nil argument turn off clipping (i.e. whole view is drawable)"
@@ -814,7 +808,15 @@
clipRect
"return the clipping rectangle for drawing"
- clipRect isNil ifTrue:[^ 0@0 extent:width@height].
+ |rect|
+
+ clipRect isNil ifTrue:[
+ rect := 0@0 extent:width@height.
+ transformation notNil ifTrue:[
+ rect := transformation applyInverseTo:rect.
+ ].
+ ^ rect
+ ].
^ clipRect
!
@@ -1420,7 +1422,7 @@
!
displayPointX:x y:y
- "draw a point (with current paint-color); apply transformation of nonNil"
+ "draw a point (with current paint-color); apply transformation if nonNil"
|pX pY|
@@ -1444,7 +1446,7 @@
!
displayLineFromX:x0 y:y0 toX:x1 y:y1
- "draw a line (with current paint-color); apply transformation of nonNil"
+ "draw a line (with current paint-color); apply transformation if nonNil"
|pX0 pY0 pX1 pY1|
@@ -1531,7 +1533,7 @@
displayPolygon:aPolygon
"draw (the outline of) a polygon (with current paint-color).
- Apply transformation of nonNil"
+ Apply transformation if nonNil"
|newPolygon|
@@ -1555,7 +1557,7 @@
!
displayArcX:x y:y w:w h:h from:startAngle angle:angle
- "draw an arc; apply transformation of nonNil"
+ "draw an arc; apply transformation if nonNil"
|pX pY nW nH|
@@ -1776,7 +1778,20 @@
].
((nW ~= w) or:[nH ~= h]) ifTrue:[
- aForm := formToDraw magnifyBy:(nW / w) @ (nH / h).
+ CachedScaledForms notNil ifTrue:[
+ (CachedScales at:formToDraw ifAbsent:[]) = transformation scale ifTrue:[
+ aForm := CachedScaledForms at:formToDraw ifAbsent:[].
+ ]
+ ].
+ aForm isNil ifTrue:[
+ aForm := formToDraw magnifyBy:(nW / w) @ (nH / h).
+ CachedScaledForms isNil ifTrue:[
+ CachedScaledForms := WeakIdentityDictionary new.
+ CachedScales := WeakIdentityDictionary new.
+ ].
+ CachedScaledForms at:formToDraw put:aForm.
+ CachedScales at:formToDraw put:transformation scale.
+ ]
] ifFalse:[
aForm := formToDraw
].
@@ -1878,7 +1893,7 @@
!DeviceDrawable methodsFor:'filling'!
fillArcX:x y:y w:w h:h from:startAngle angle:angle
- "draw a filled arc; apply transformation of nonNil"
+ "draw a filled arc; apply transformation if nonNil"
|pX pY nW nH|
@@ -1924,7 +1939,7 @@
!
fillRectangleX:x y:y width:w height:h
- "draw a filled rectangle; apply transformation of nonNil"
+ "draw a filled rectangle; apply transformation if nonNil"
|pX pY nW nH|
@@ -1971,7 +1986,7 @@
!
fillPolygon:aPolygon
- "draw a filled polygon; apply transformation of nonNil"
+ "draw a filled polygon; apply transformation if nonNil"
|newPolygon|
--- a/DevWorkst.st Mon Feb 06 01:30:10 1995 +0100
+++ b/DevWorkst.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/Attic/DevWorkst.st,v 1.22 1994-11-28 21:00:42 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DevWorkst.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/Attic/DevWorkst.st,v 1.22 1994-11-28 21:00:42 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DevWorkst.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.
--- 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.
--- a/DisplayMedium.st Mon Feb 06 01:30:10 1995 +0100
+++ b/DisplayMedium.st Mon Feb 06 01:38:04 1995 +0100
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/DisplayMedium.st,v 1.8 1994-11-17 14:24:54 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DisplayMedium.st,v 1.9 1995-02-06 00:35:42 claus Exp $
'!
!DisplayMedium class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/DisplayMedium.st,v 1.8 1994-11-17 14:24:54 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DisplayMedium.st,v 1.9 1995-02-06 00:35:42 claus Exp $
"
!
@@ -74,6 +74,12 @@
!DisplayMedium methodsFor:'accessing'!
+isView
+ "return true, if the receiver is a view"
+
+ ^ false
+!
+
origin
"return the origin i.e. coordinate of top-left of the receiver"
@@ -137,6 +143,13 @@
height := h
!
+setWidth:w height:h
+ "set both width and height - not to be redefined"
+
+ width := w.
+ height := h
+!
+
insideWidth
"return the usable width for drawing in the receiver;
this is width here, but Views/Pages may subtract margins"
--- a/DisplayRootView.st Mon Feb 06 01:30:10 1995 +0100
+++ b/DisplayRootView.st Mon Feb 06 01:38:04 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/DisplayRootView.st,v 1.8 1994-10-10 02:29:37 claus Exp $
+$Header: /cvs/stx/stx/libview/DisplayRootView.st,v 1.9 1995-02-06 00:35:46 claus Exp $
'!
Smalltalk at:#RootView put:nil!
@@ -44,14 +44,31 @@
version
"
-$Header: /cvs/stx/stx/libview/DisplayRootView.st,v 1.8 1994-10-10 02:29:37 claus Exp $
+$Header: /cvs/stx/stx/libview/DisplayRootView.st,v 1.9 1995-02-06 00:35:46 claus Exp $
"
!
documentation
"
this class describes Xs rootWindow (which is the background window and
- must be used for drawing outside of Views i.e. for dragging between Views)
+ must be used for drawing outside of Views i.e. for dragging between Views).
+
+ To draw in the root window:
+
+ RootView paint:(Color red).
+ RootView fillRectangleX:10 y:10 width:100 height:100.
+
+ of course, all stuff from View and its superclasses can be used:
+
+ RootView paint:(Color red).
+ RootView noClipByChildren.
+ RootView fillRectangleX:10 y:10 width:100 height:100.
+
+ you have to be careful with some window managers, since what you
+ see on the screen is not always really the root window. Some Desktops
+ add their own view in between (although the Xworkstation class does
+ care for this, it seems not to work correctly on all systems).
+ In general, you should never use the RootView for normal applications.
"
! !
@@ -67,7 +84,9 @@
!DisplayRootView class methodsFor:'instance creation'!
new
- "since there is only one RootView - catch new"
+ "since there is only one RootView - catch new and return
+ the one and only rootView."
+
RootView isNil ifTrue:[
RootView := super new
].
@@ -78,10 +97,11 @@
initialize
super initialize.
+
width := device width.
height := device height.
+ drawableId := device rootWindowFor:self.
realized := true.
- drawableId := device rootWindowFor:self
!
reinitialize
@@ -90,6 +110,7 @@
width := device width.
height := device height.
drawableId := device rootWindowFor:self.
+ realized := true.
gcId := nil.
! !
--- a/Font.st Mon Feb 06 01:30:10 1995 +0100
+++ b/Font.st Mon Feb 06 01:38:04 1995 +0100
@@ -24,7 +24,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Font.st,v 1.12 1994-11-28 21:00:49 claus Exp $
+$Header: /cvs/stx/stx/libview/Font.st,v 1.13 1995-02-06 00:36:10 claus Exp $
'!
!Font class methodsFor:'documentation'!
@@ -45,7 +45,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Font.st,v 1.12 1994-11-28 21:00:49 claus Exp $
+$Header: /cvs/stx/stx/libview/Font.st,v 1.13 1995-02-06 00:36:10 claus Exp $
"
!
@@ -179,14 +179,15 @@
!Font class methodsFor:'instance creation'!
family:familyString face:faceString style:styleString size:sizeNum
- "returns a font for given family, face, style and size.
+ "returns a font for given family, face, style and size with
+ unspecified encoding.
The returned font is not associated to a specific device"
^ self family:familyString
face:faceString
style:styleString
size:sizeNum
- encoding:#iso8859
+ encoding:nil
!
family:familyString face:faceString style:styleString size:sizeNum encoding:encodingSym
@@ -262,7 +263,7 @@
(family = aFont family) ifTrue:[
(face = aFont face) ifTrue:[
(style = aFont style) ifTrue:[
- (encoding == aFont encoding) ifTrue:[
+ (encoding isNil or:[encoding == aFont encoding]) ifTrue:[
^ aFont
]
]
--- a/FontDescr.st Mon Feb 06 01:30:10 1995 +0100
+++ b/FontDescr.st Mon Feb 06 01:38:04 1995 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1994 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
@@ -19,9 +19,9 @@
FontDescription comment:'
COPYRIGHT (c) 1994 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/FontDescr.st,v 1.1 1994-08-05 01:14:09 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/FontDescr.st,v 1.2 1995-02-06 00:36:20 claus Exp $
'!
!FontDescription class methodsFor:'documentation'!
@@ -29,7 +29,7 @@
copyright
"
COPYRIGHT (c) 1994 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/FontDescr.st,v 1.1 1994-08-05 01:14:09 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/FontDescr.st,v 1.2 1995-02-06 00:36:20 claus Exp $
"
!
@@ -64,17 +64,23 @@
family:familyString face:faceString style:styleString size:sizeNum encoding:encodingSym
^ self new
- family:familyString face:faceString style:styleString size:sizeNum encoding:encodingSym
+ family:familyString face:faceString style:styleString size:sizeNum encoding:encodingSym
! !
!FontDescription methodsFor:'accessing'!
-family:familyString face:faceString style:styleString size:sizeNum encoding:encodingSym
- family := familyString.
- face := faceString.
- style := styleString.
+family:familyString face:faceString style:styleString size:sizeNum encoding:encodingString
+ family := familyString asSymbol.
+ faceString notNil ifTrue:[
+ face := faceString asSymbol.
+ ].
+ styleString notNil ifTrue:[
+ style := styleString asSymbol.
+ ].
size := sizeNum.
- encoding := encodingSym.
+ encodingString notNil ifTrue:[
+ encoding := encodingString asSymbol.
+ ]
!
family
--- a/FontDescription.st Mon Feb 06 01:30:10 1995 +0100
+++ b/FontDescription.st Mon Feb 06 01:38:04 1995 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1994 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
@@ -19,9 +19,9 @@
FontDescription comment:'
COPYRIGHT (c) 1994 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
-$Header: /cvs/stx/stx/libview/FontDescription.st,v 1.1 1994-08-05 01:14:09 claus Exp $
+$Header: /cvs/stx/stx/libview/FontDescription.st,v 1.2 1995-02-06 00:36:20 claus Exp $
'!
!FontDescription class methodsFor:'documentation'!
@@ -29,7 +29,7 @@
copyright
"
COPYRIGHT (c) 1994 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/FontDescription.st,v 1.1 1994-08-05 01:14:09 claus Exp $
+$Header: /cvs/stx/stx/libview/FontDescription.st,v 1.2 1995-02-06 00:36:20 claus Exp $
"
!
@@ -64,17 +64,23 @@
family:familyString face:faceString style:styleString size:sizeNum encoding:encodingSym
^ self new
- family:familyString face:faceString style:styleString size:sizeNum encoding:encodingSym
+ family:familyString face:faceString style:styleString size:sizeNum encoding:encodingSym
! !
!FontDescription methodsFor:'accessing'!
-family:familyString face:faceString style:styleString size:sizeNum encoding:encodingSym
- family := familyString.
- face := faceString.
- style := styleString.
+family:familyString face:faceString style:styleString size:sizeNum encoding:encodingString
+ family := familyString asSymbol.
+ faceString notNil ifTrue:[
+ face := faceString asSymbol.
+ ].
+ styleString notNil ifTrue:[
+ style := styleString asSymbol.
+ ].
size := sizeNum.
- encoding := encodingSym.
+ encodingString notNil ifTrue:[
+ encoding := encodingString asSymbol.
+ ]
!
family
--- a/Form.st Mon Feb 06 01:30:10 1995 +0100
+++ b/Form.st Mon Feb 06 01:38:04 1995 +0100
@@ -26,7 +26,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Form.st,v 1.14 1994-11-28 21:00:51 claus Exp $
+$Header: /cvs/stx/stx/libview/Form.st,v 1.15 1995-02-06 00:36:22 claus Exp $
'!
!Form class methodsFor:'documentation'!
@@ -47,7 +47,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Form.st,v 1.14 1994-11-28 21:00:51 claus Exp $
+$Header: /cvs/stx/stx/libview/Form.st,v 1.15 1995-02-06 00:36:22 claus Exp $
"
!
@@ -287,6 +287,12 @@
"return a constant usable as bitblt-combinationrule"
^ #xor
+!
+
+and
+ "return a constant usable as bitblt-combinationrule"
+
+ ^ #and
! !
!Form class methodsFor:'instance creation'!
@@ -303,6 +309,13 @@
^ newForm
!
+extent:ext offset:anOffset
+ "create a new, cleared form, take dimensions from ext.
+ Smalltalk-80 compatibility"
+
+ ^ (self extent:ext) offset:anOffset.
+!
+
extent:ext fromArray:data offset:offs
"create a new form, take dimensions from ext, bits from data.
Smalltalk-80 compatibility."
@@ -1599,11 +1612,30 @@
^ offset
!
+displayOn:aGC rule:rule
+ "draw in aGC.
+ Smalltalk-80 (2.x) compatibility"
+
+ ^ self displayOn:aGC at:0@0 rule:rule
+!
+
+displayOn:aGC at:aPoint rule:rule
+ "draw in aGC.
+ Smalltalk-80 (2.x) compatibility"
+
+ |f|
+
+ f := aGC function.
+ aGC function:rule.
+ aGC displayOpaqueForm:self x:aPoint x y:aPoint y.
+ aGC function:f.
+!
+
displayOn:aGC at:aPoint
"draw in aGC.
- Smalltalk-80 compatibility"
+ Smalltalk-80 (2.x) compatibility"
- aGC displayOpaqueForm:self x:aPoint x y:aPoint y
+ ^ self displayOn:aGC at:aPoint rule:#copy
! !
!Form methodsFor:'accessing'!
@@ -1809,6 +1841,23 @@
"ScrollBar scrollUpButtonForm magnifyBy:(2 @ 2)"
!
+hardMagnifyBy:extent
+ "return a new form magnified by extent, aPoint.
+ This method handles non-integral factors."
+
+ "
+ since Form will be replaced by Image in the long run,
+ and this operation is slow anyway, use the implementation
+ in Image for this."
+
+ ^ ((Image fromForm:self) magnifyBy:extent) asFormOn:device.
+
+ "
+ (Form fromFile:'OutputOn.64') magnifyBy:0.5@0.5
+ (Form fromFile:'OutputOn.64') magnifyBy:1.5@1.5
+ "
+!
+
flipVertical
"return a new form flipped vertically"
--- a/GLXWorkstat.st Mon Feb 06 01:30:10 1995 +0100
+++ b/GLXWorkstat.st Mon Feb 06 01:38:04 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/GLXWorkstat.st,v 1.16 1994-11-21 16:43:13 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/GLXWorkstat.st,v 1.17 1995-02-06 00:36:30 claus Exp $
'!
!GLXWorkstation class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/GLXWorkstat.st,v 1.16 1994-11-21 16:43:13 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/GLXWorkstat.st,v 1.17 1995-02-06 00:36:30 claus Exp $
"
!
@@ -71,7 +71,8 @@
(see a bit of this in 'clients/IRIS-specials')
Some functions are duplicated, Jeff and I developed those in parallel -
- those will be merged and duplicates removed ...
+ for now, both will remain - finally they will be merged and duplicates removed ...
+ (examples are makeobj and makeObject).
Also, in a hurry to implement all those methods, many do no or only
limited argument checking - make certain, that you pass the correct
@@ -95,7 +96,7 @@
"
! !
-!GLXWorkstation class primitiveDefinitions!
+!GLXWorkstation primitiveDefinitions!
%{
/*
@@ -151,7 +152,7 @@
*/
#if defined(hpux) && defined(POSITIVE_ADDRESSES)
# define MKDPY(o) (Display *)((int)(o) & ~TAG_INT)
-# define MKWIN(o) (Window)((int)(o) & ~TAG_INT)
+# define MKWIN(o) (Window)((int)(o) & ~TAG_INT)
#else
# define MKDPY(o) (Display *)(_intVal(o))
# define MKWIN(o) (Window)(_intVal(o))
@@ -280,7 +281,7 @@
%}
! !
-!GLXWorkstation class primitiveFunctions!
+!GLXWorkstation primitiveFunctions!
%{
/*
@@ -667,28 +668,101 @@
for a real GL engine, false for the simulator here."
%{ /* NOCONTEXT */
-
-#ifdef VGL
- RETURN ( false );
-#endif
#ifdef GLX
RETURN ( true );
#endif
-%}
+%}.
+ ^ false
+
+ "
+ Display supportsRGB
+ "
!
supportsLight
- "return true, if this gl workstation supports light (i.e.
- if its a real GL)"
-%{ /* NOCONTEXT */
-
-#ifdef VGL
- RETURN ( false );
-#endif
+ "return true, if this gl workstation supports light
+ (i.e. if its a real GL)"
+
+%{ /* NOCONTEXT */
#ifdef GLX
RETURN ( true );
#endif
-%}
+%}.
+ ^ false
+
+ "
+ Display supportsLight
+ "
+!
+
+supportsTextures
+ "return true, if this gl workstation supports texture mapping
+ (i.e. if its a real GL)"
+
+%{ /* NOCONTEXT */
+#ifdef GLX
+ if (getgdesc(GD_TEXTURE) != 0) {
+ RETURN ( true );
+ }
+#endif
+%}.
+ ^ false
+
+ "
+ Display supportsTextures
+ "
+!
+
+supportsDoubleBuffer
+ "return true, if this gl workstation supports double buffering"
+%{ /* NOCONTEXT */
+
+#ifdef GLX
+ if (getgdesc(GD_BITS_NORM_DBL_RED) != 0) {
+ RETURN ( true );
+ }
+#endif
+%}.
+ ^ false
+
+ "
+ Display supportsDoubleBuffer
+ "
+!
+
+supportsZBuffer
+ "return true, if this gl workstation has z buffer support"
+%{ /* NOCONTEXT */
+
+#ifdef GLX
+ if (getgdesc(GD_BITS_NORM_ZBUFFER) != 0) {
+ RETURN ( true );
+ }
+#endif
+%}.
+ ^ false
+
+ "
+ Display supportsZBuffer
+ "
+!
+
+maxZValue
+ "return the max. Z value (only valid if z-buffer is supported)"
+%{
+#ifdef GLX
+ long zMax;
+ extern OBJ _MKLARGEINT();
+
+ zMax = getgdesc(GD_ZMAX);
+
+ if ((zMax >= _MIN_INT) && (zMax <= _MAX_INT)) {
+ RETURN ( _MKSMALLINT(zMax) );
+ }
+ RETURN ( _MKLARGEINT(zMax) );
+#endif
+%}.
+ ^ nil
! !
!GLXWorkstation methodsFor:'window creation'!
@@ -859,10 +933,9 @@
_FLOAT_(bottom, f_bottom)
_FLOAT_(top, f_top)
ortho2(f_left, f_right, f_bottom, f_top);
- RETURN (true);
-%}
-.
- ^ false
+%}
+.
+ ^ true
!
glxReshapeViewPortIn: aGLXWindowId
@@ -870,10 +943,9 @@
%{ /* NOCONTEXT */
SETWIN(aGLXWindowId)
reshapeviewport();
- RETURN (true);
-%}
-.
- ^ false
+%}
+.
+ ^ true
! !
!GLXWorkstation methodsFor:'transformations'!
@@ -1033,8 +1105,6 @@
SETWIN(aGLXWindowId)
RETURN (doRotate(angle, 'x'));
%}
-.
- ^ false
!
glxRotateY:angle in:aGLXWindowId
@@ -1046,8 +1116,6 @@
SETWIN(aGLXWindowId)
RETURN (doRotate(angle, 'y'));
%}
-.
- ^ false
!
glxRotateZ:angle in:aGLXWindowId
@@ -1059,8 +1127,6 @@
SETWIN(aGLXWindowId)
RETURN (doRotate(angle, 'z'));
%}
-.
- ^ false
!
glxRotate:angle axis:axis in:aGLXWindowId
@@ -1223,6 +1289,7 @@
glxLmdef:what index:index np:np props:props in:aGLXWindowId
"define a material, light source or lighting model;
+ what must be one of #material, #light or #lightModel.
props must be a FloatArray or a subclass of FloatArray"
%{ /* NOCONTEXT */
@@ -1271,7 +1338,9 @@
!
glxLmbind:target index:index in:aGLXWindowId
- "select a material, lighyt or lighting model"
+ "select a material, light or lighting model.
+ target must be a symbol from: #material, #backMaterial,
+ #light0-light7 or #lightModel."
%{ /* NOCONTEXT */
#ifdef GLX
@@ -1312,6 +1381,138 @@
%}
.
^ false
+!
+
+glxTexDef2d:index nc:nc width:w height:h bits:image np:np props:props in:aGLXWindowId
+ "define a 2D texture. index is the 'name' of the texture;
+ nc is the number of components (1-4) per pixel;
+ w/h define the size of the texture; bits is a byteArray containing the
+ long-word aligned pixel data; np is the number of props found in
+ the floatArray props. Props must be delimited by a 0.0 entry."
+
+%{ /* NOCONTEXT */
+#ifdef GLX
+ unsigned char *cp;
+ const float *fp;
+ OBJ cls;
+ float fbuff[30];
+
+ if (__isByteArray(image)) {
+ cp = _ByteArrayInstPtr(image)->ba_element;
+ fp = getFloatsFromFloatArrayInto(props, fbuff);
+
+ SETWIN(aGLXWindowId)
+ texdef2d(_intVal(index), _intVal(nc), _intVal(w), _intVal(h),
+ (const unsigned long *)cp, _intVal(np), fp);
+ RETURN (true);
+ }
+#endif
+%}
+.
+ ^ false
+!
+
+glxTexDef3d:index nc:nc width:w height:h depth:d bits:image np:np props:props in:aGLXWindowId
+ "define a 3D texture. index is the 'name' of the texture;
+ nc is the number of components (1-4) per pixel;
+ w/h/d define the size of the texture; bits is a byteArray containing the
+ long-word aligned pixel data; np is the number of props found in
+ the floatArray props. Props must be delimited by a 0.0 entry."
+
+%{ /* NOCONTEXT */
+#ifdef GLX
+ unsigned char *cp;
+ const float *fp;
+ OBJ cls;
+ float fbuff[30];
+
+ if (__isByteArray(image)) {
+ cp = _ByteArrayInstPtr(image)->ba_element;
+ fp = getFloatsFromFloatArrayInto(props, fbuff);
+
+ SETWIN(aGLXWindowId)
+ texdef3d(_intVal(index), _intVal(nc), _intVal(w), _intVal(h),
+ _intVal(d),
+ (const unsigned long *)cp, _intVal(np), fp);
+ RETURN (true);
+ }
+#endif
+%}
+.
+ ^ false
+!
+
+glxTevdef:index np:np props:props in:aGLXWindowId
+
+%{ /* NOCONTEXT */
+#ifdef GLX
+ const float *fp;
+ float fbuff[30];
+
+ SETWIN(aGLXWindowId)
+ fp = getFloatsFromFloatArrayInto(props, fbuff);
+ tevdef(_intVal(index), _intVal(np), fp);
+ RETURN (true);
+#endif
+%}
+.
+ ^ false
+!
+
+glxTevbind:target index:index in:aGLXWindowId
+ "bind a texture environment; target must be 0
+ or the symbol #env0."
+
+%{ /* NOCONTEXT */
+#ifdef GLX
+ long t;
+
+ if (_isSmallInteger(target)) {
+ t = _intVal(target);
+ } else {
+ if (target == @symbol(env0)) {
+ t = TV_ENV0;
+ } else {
+ RETURN (false);
+ }
+ }
+ SETWIN(aGLXWindowId)
+ tevbind(t, _intVal(index));
+ RETURN (true);
+#endif
+%}
+.
+ ^ false
+!
+
+glxTexbind:target index:index in:aGLXWindowId
+ "bind a texture; target must be an integer or one
+ of the symbols #texture0, #textureDetail or #textureIdle."
+
+%{ /* NOCONTEXT */
+#ifdef GLX
+ long t;
+
+ if (_isSmallInteger(target)) {
+ t = _intVal(target);
+ } else {
+ if (target == @symbol(texture0)) {
+ t = TX_TEXTURE_0;
+ } else if (target == @symbol(textureDetail)) {
+ t = TX_TEXTURE_DETAIL;
+ } else if (target == @symbol(textureIdle)) {
+ t = TX_TEXTURE_IDLE;
+ } else {
+ RETURN (false);
+ }
+ }
+ SETWIN(aGLXWindowId)
+ texbind(t, _intVal(index));
+ RETURN (true);
+#endif
+%}
+.
+ ^ false
! !
!GLXWorkstation methodsFor:'color'!
@@ -1338,7 +1539,7 @@
!
glxColorRed:r green:g blue:b in:aGLXWindowId
- "set color, args must be integer values"
+ "set color, args must be integer values in 0..255"
%{ /* NOCONTEXT */
@@ -1355,6 +1556,27 @@
%}
.
^ false
+!
+
+glxColorRed:r green:g blue:b alpha:a in:aGLXWindowId
+ "set color including alpha value, args must be integer values within 0..255"
+
+%{ /* NOCONTEXT */
+
+#ifdef GLX
+ short s_r, s_g, s_b, s_a;
+
+ _INT_(r, s_r);
+ _INT_(g, s_g);
+ _INT_(b, s_b);
+ _INT_(a, s_a);
+ SETWIN(aGLXWindowId)
+ cpack((((((s_a<<8) | s_b) << 8) | s_g) << 8) | s_r);
+ RETURN (true);
+#endif
+%}
+.
+ ^ false
! !
!GLXWorkstation methodsFor:'clearing'!
@@ -1367,8 +1589,6 @@
clear();
RETURN (true);
%}
-.
- ^ false
!
glxZClearIn:aGLXWindowId
@@ -1383,6 +1603,20 @@
%}
.
^ false
+!
+
+glxCzclearCval:cval zval:zval in:aGLXWindowId
+ "clear to a color (cval) and clear z buffer to zval simultaniously"
+
+%{ /* NOCONTEXT */
+#ifdef GLX
+ SETWIN(aGLXWindowId)
+ czclear((ulong)_intVal(cval), _intVal(zval));
+ RETURN (true);
+#endif
+%}
+.
+ ^ false
! !
!GLXWorkstation methodsFor:'matrix stack'!
@@ -1395,8 +1629,6 @@
pushmatrix();
RETURN (true);
%}
-.
- ^ false
!
glxPopmatrixIn:aGLXWindowId
@@ -1407,8 +1639,6 @@
popmatrix();
RETURN (true);
%}
-.
- ^ false
!
glxGetMatrix:arrayOf16Floats in:aGLXWindowId
@@ -1439,8 +1669,6 @@
loadmatrix(*m);
RETURN (true);
%}
-.
- ^ false
!
glxMultMatrix:arrayOf16Floats in:aGLXWindowId
@@ -1456,8 +1684,6 @@
multmatrix(*m);
RETURN (true);
%}
-.
- ^ false
! !
!GLXWorkstation methodsFor:'double buffering'!
@@ -1470,8 +1696,16 @@
doublebuffer();
RETURN (true);
%}
-.
- ^ false
+!
+
+glxSingleBufferIn: aGLXWindowId
+ "set single buffer mode"
+
+%{ /* NOCONTEXT */
+ SETWIN(aGLXWindowId)
+ singlebuffer();
+ RETURN (true);
+%}
!
glxSwapBuffersIn:aGLXWindowId
@@ -1482,8 +1716,6 @@
swapbuffers();
RETURN (true);
%}
-.
- ^ false
!
glxFrontBufferIn:aGLXWindowId
@@ -1497,8 +1729,6 @@
frontbuffer(TRUE);
RETURN (true);
%}
-.
- ^ false
!
glxBackBufferIn:aGLXWindowId
@@ -1512,8 +1742,6 @@
backbuffer(TRUE);
RETURN (true);
%}
-.
- ^ false
!
glxBackbuffer: b in: aGLXWindowId
@@ -1523,8 +1751,6 @@
backbuffer(_booleanVal(b));
RETURN (true);
%}
-.
- ^ false
!
glxFrontbuffer: b in: aGLXWindowId
@@ -1534,8 +1760,6 @@
frontbuffer(_booleanVal(b));
RETURN (true);
%}
-.
- ^ false
! !
!GLXWorkstation methodsFor:'zbuffer'!
@@ -1668,8 +1892,6 @@
gconfig();
RETURN (true);
%}
-.
- ^ false
!
glxNmode:aSymbol in:aGLXWindowId
@@ -1728,8 +1950,6 @@
bgnpoint();
RETURN (true);
%}
-.
- ^ false
!
glxEndPointIn:aGLXWindowId
@@ -1740,8 +1960,6 @@
endpoint();
RETURN (true);
%}
-.
- ^ false
!
glxBeginClosedLineIn:aGLXWindowId
@@ -1752,8 +1970,6 @@
bgnclosedline();
RETURN (true);
%}
-.
- ^ false
!
glxEndClosedLineIn:aGLXWindowId
@@ -1764,8 +1980,6 @@
endclosedline();
RETURN (true);
%}
-.
- ^ false
!
glxBeginLineIn:aGLXWindowId
@@ -1776,8 +1990,6 @@
bgnline();
RETURN (true);
%}
-.
- ^ false
!
glxEndLineIn:aGLXWindowId
@@ -1788,8 +2000,6 @@
endline();
RETURN (true);
%}
-.
- ^ false
!
glxBeginPolygonIn:aGLXWindowId
@@ -1800,8 +2010,6 @@
bgnpolygon();
RETURN (true);
%}
-.
- ^ false
!
glxEndPolygonIn:aGLXWindowId
@@ -1812,8 +2020,6 @@
endpolygon();
RETURN (true);
%}
-.
- ^ false
!
glxBeginTriangleMeshIn:aGLXWindowId
@@ -1824,8 +2030,6 @@
bgntmesh();
RETURN (true);
%}
-.
- ^ false
!
glxEndTriangleMeshIn:aGLXWindowId
@@ -1836,8 +2040,6 @@
endtmesh();
RETURN (true);
%}
-.
- ^ false
!
glxBeginQuadrilateralStripIn:aGLXWindowId
@@ -1848,8 +2050,6 @@
bgnqstrip();
RETURN (true);
%}
-.
- ^ false
!
glxEndQuadrilateralStripIn:aGLXWindowId
@@ -1860,8 +2060,6 @@
endqstrip();
RETURN (true);
%}
-.
- ^ false
! !
!GLXWorkstation methodsFor:'sphere drawing'!
@@ -1980,8 +2178,6 @@
patch(*mX, *mY, *mZ);
RETURN (true);
%}
-.
- ^ false
!
glxBeginCurveIn:aGLXWindowId
@@ -2083,7 +2279,7 @@
^ false
! !
-!GLXWorkstation methodsFor:'arcs and circles '!
+!GLXWorkstation methodsFor:'arcs and circles'!
glxArcX: x y: y radius: radius startang: startang endang: endang in: aGLXWindowId
"draw an arc"
@@ -2119,8 +2315,6 @@
arci(c_x, c_y, c_radius, a_startang, a_endang);
RETURN (true);
%}
-.
- ^ false
!
glxArcsX: x y: y radius: radius startang: startang endang: endang in: aGLXWindowId
@@ -2139,8 +2333,6 @@
arcs(c_x, c_y, c_radius, a_startang, a_endang);
RETURN (true);
%}
-.
- ^ false
!
glxArcfX: x y: y radius: radius startang: startang endang: endang in: aGLXWindowId
@@ -2159,8 +2351,6 @@
arcf(c_x, c_y, c_radius, a_startang, a_endang);
RETURN (true);
%}
-.
- ^ false
!
glxArcfiX: x y: y radius: radius startang: startang endang: endang in: aGLXWindowId
@@ -2179,8 +2369,6 @@
arcfi(c_x, c_y, c_radius, a_startang, a_endang);
RETURN (true);
%}
-.
- ^ false
!
glxArcfsX: x y: y radius: radius startang: startang endang: endang in: aGLXWindowId
@@ -2199,8 +2387,6 @@
arcfs(c_x, c_y, c_radius, a_startang, a_endang);
RETURN (true);
%}
-.
- ^ false
!
glxCircX: x y: y radius: radius in: aGLXWindowId
@@ -2216,8 +2402,6 @@
circ(c_x, c_y, c_radius);
RETURN (true);
%}
-.
- ^ false
!
glxCirciX: x y: y radius: radius in: aGLXWindowId
@@ -2233,8 +2417,6 @@
circi(c_x, c_y, c_radius);
RETURN (true);
%}
-.
- ^ false
!
glxCircsX: x y: y radius: radius in: aGLXWindowId
@@ -2250,8 +2432,6 @@
circs(c_x, c_y, c_radius);
RETURN (true);
%}
-.
- ^ false
!
glxCircfX: x y: y radius: radius in: aGLXWindowId
@@ -2267,8 +2447,6 @@
circf(c_x, c_y, c_radius);
RETURN (true);
%}
-.
- ^ false
!
glxCircfiX: x y: y radius: radius in: aGLXWindowId
@@ -2284,8 +2462,6 @@
circfi(c_x, c_y, c_radius);
RETURN (true);
%}
-.
- ^ false
!
glxCircfsX: x y: y radius: radius in: aGLXWindowId
@@ -2301,13 +2477,151 @@
circfs(c_x, c_y, c_radius);
RETURN (true);
%}
-.
- ^ false
! !
-!GLXWorkstation methodsFor:'unspecified rest '!
-
-glxAcbufOp: op value: value in: aGLXWindowId
+!GLXWorkstation methodsFor:'objects'!
+
+glxCallObject:obj in:aGLXWindowId
+ "perform the commands of an object (macro)."
+
+%{ /* NOCONTEXT */
+ if (_isSmallInteger(obj)) {
+ SETWIN(aGLXWindowId)
+ callobj(_objectVal(obj));
+ RETURN (true);
+ }
+%}
+.
+ ^ false
+!
+
+glxCallobj: obj in: aGLXWindowId
+ "OBSOLETE; use glxCallObject:in:
+ This one will be removed soon."
+
+%{ /* NOCONTEXT */
+ if (_isSmallInteger(obj)) {
+ SETWIN(aGLXWindowId)
+ callobj(_objectVal(obj));
+ RETURN (true);
+ }
+%}
+.
+ ^ false
+!
+
+glxCloseObjectIn:aGLXWindowId
+ "end object defnition"
+
+%{ /* NOCONTEXT */
+ SETWIN(aGLXWindowId)
+ closeobj();
+ RETURN (true);
+%}
+!
+
+glxCloseobjIn:aGLXWindowId
+ "OBSOLETE: use glxCloseObjectIn:
+ This one will be removed."
+
+%{ /* NOCONTEXT */
+ SETWIN(aGLXWindowId)
+ closeobj();
+ RETURN (true);
+%}
+!
+
+glxDeleteObject:obj in:aGLXWindowId
+
+%{ /* NOCONTEXT */
+ SETWIN(aGLXWindowId)
+ delobj(_objectVal(obj));
+ RETURN (true);
+%}
+!
+
+glxDelobj:obj in:aGLXWindowId
+ "OBSOLETE: use glxDeleteObject:in:
+ This one will be removed."
+
+%{ /* NOCONTEXT */
+ SETWIN(aGLXWindowId)
+ delobj(_objectVal(obj));
+ RETURN (true);
+%}
+!
+
+glxGenObjectIn:aGLXWindowId
+ "return a new (free & unused) object id for use
+ with makeObj"
+
+%{ /* NOCONTEXT */
+ SETWIN(aGLXWindowId)
+ RETURN (_MKSMALLINT(genobj()));
+%}
+!
+
+glxGenobjIn:aGLXWindowId
+ "OBSOLETE: use glxGenObject:in:
+ This one will be removed."
+
+%{ /* NOCONTEXT */
+ SETWIN(aGLXWindowId)
+ RETURN (_MKSMALLINT(genobj()));
+%}
+!
+
+glxMakeObject:id in:aGLXWindowId
+ "start object definition -
+ another name conflict"
+
+%{ /* NOCONTEXT */
+ if (_isSmallInteger(id)) {
+ SETWIN(aGLXWindowId)
+ makeobj(_objectVal(id));
+ RETURN (true);
+ }
+%}
+.
+ ^ false
+!
+
+glxMakeobj:obj in:aGLXWindowId
+ "OBSOLETE; use glxMakeObject:in:
+ This one will be removed soon."
+
+%{ /* NOCONTEXT */
+ if (_isSmallInteger(obj)) {
+ SETWIN(aGLXWindowId)
+ makeobj(_objectVal(obj));
+ RETURN (true);
+ }
+%}
+.
+ ^ false
+!
+
+glxIsobj:obj in:aGLXWindowId
+ "return true, if obj is a valid object id"
+
+%{ /* NOCONTEXT */
+ SETWIN(aGLXWindowId)
+ RETURN (_MKBOOLEAN(isobj(_objectVal(obj))));
+%}
+!
+
+glxGetopenobjIn:aGLXWindowId
+ "return the currently open objects id; -1 if none is open"
+
+%{ /* NOCONTEXT */
+ SETWIN(aGLXWindowId)
+ RETURN (_MKSMALLINT(getopenobj()));
+%}
+! !
+
+!GLXWorkstation methodsFor:'unspecified rest'!
+
+glxAcbufOp:op value:value in:aGLXWindowId
%{ /* NOCONTEXT */
#ifdef GLX
@@ -2353,8 +2667,6 @@
backface(_booleanVal(b));
RETURN (true);
%}
-.
- ^ false
!
glxBbox2Xmin: xmin ymin: ymin x1: x1 y1: y1 x2: x2 y2: y2 in: aGLXWindowId
@@ -2623,34 +2935,6 @@
^ false
!
-glxCallObject:obj in:aGLXWindowId
- "do objects definition
- I defined that one too - but with a different name"
-
-%{ /* NOCONTEXT */
- if (_isSmallInteger(obj)) {
- SETWIN(aGLXWindowId)
- callobj(_objectVal(obj));
- RETURN (true);
- }
-%}
-.
- ^ false
-!
-
-glxCallobj: obj in: aGLXWindowId
-
-%{ /* NOCONTEXT */
- if (_isSmallInteger(obj)) {
- SETWIN(aGLXWindowId)
- callobj(_objectVal(obj));
- RETURN (true);
- }
-%}
-.
- ^ false
-!
-
glxClearhitcodeIn: aGLXWindowId
%{ /* NOCONTEXT */
@@ -2680,29 +2964,6 @@
^ false
!
-glxCloseObjectIn:aGLXWindowId
- "end object defnition - JEFF and I defined this with different names"
-
-%{ /* NOCONTEXT */
- SETWIN(aGLXWindowId)
- closeobj();
- RETURN (true);
-%}
-.
- ^ false
-!
-
-glxCloseobjIn: aGLXWindowId
-
-%{ /* NOCONTEXT */
- SETWIN(aGLXWindowId)
- closeobj();
- RETURN (true);
-%}
-.
- ^ false
-!
-
glxCmodeIn: aGLXWindowId
%{ /* NOCONTEXT */
@@ -2728,8 +2989,6 @@
cmov(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxCmoviX: x y: y z: z in: aGLXWindowId
@@ -2744,8 +3003,6 @@
cmovi(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxCmovsX: x y: y z: z in: aGLXWindowId
@@ -2760,8 +3017,6 @@
cmovs(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxCmov2X: x y: y in: aGLXWindowId
@@ -2775,8 +3030,6 @@
cmov2(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxCmov2iX: x y: y in: aGLXWindowId
@@ -2790,8 +3043,6 @@
cmov2i(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxCmov2sX: x y: y in: aGLXWindowId
@@ -2805,8 +3056,6 @@
cmov2s(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxColorfIndex: index in: aGLXWindowId
@@ -2821,8 +3070,6 @@
concave(_booleanVal(b));
RETURN (true);
%}
-.
- ^ false
!
glxCuroriginN: n xorigin: xorigin yorigin: yorigin in: aGLXWindowId
@@ -2884,8 +3131,6 @@
curvebasis(_shortVal(basid));
RETURN (true);
%}
-.
- ^ false
!
glxCurveit: iterationcount in: aGLXWindowId
@@ -2895,8 +3140,6 @@
curveit(_shortVal(iterationcount));
RETURN (true);
%}
-.
- ^ false
!
glxCurveprecision: nsegments in: aGLXWindowId
@@ -2906,8 +3149,6 @@
curveprecision(_shortVal(nsegments));
RETURN (true);
%}
-.
- ^ false
!
glxCyclemapDuration: duration map: map nxtmap: nxtmap in: aGLXWindowId
@@ -2923,19 +3164,6 @@
^ false
!
-glxCzclearCval: cval zval: zval in: aGLXWindowId
-
-%{ /* NOCONTEXT */
-#ifdef GLX
- SETWIN(aGLXWindowId)
- czclear((ulong)_intVal(cval), _intVal(zval));
- RETURN (true);
-#endif
-%}
-.
- ^ false
-!
-
glxDeflinestyleN: n ls: ls in: aGLXWindowId
"define a line style"
@@ -2944,8 +3172,6 @@
deflinestyle(_shortVal(n), _linestyleVal(ls));
RETURN (true);
%}
-.
- ^ false
!
glxDefpatternN: n size: size mask: mask in: aGLXWindowId
@@ -2961,17 +3187,6 @@
^ false
!
-glxDelobj: obj in: aGLXWindowId
-
-%{ /* NOCONTEXT */
- SETWIN(aGLXWindowId)
- delobj(_objectVal(obj));
- RETURN (true);
-%}
-.
- ^ false
-!
-
glxDeltag: t in: aGLXWindowId
%{ /* NOCONTEXT */
@@ -3036,8 +3251,6 @@
draw(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxDrawiX: x y: y z: z in: aGLXWindowId
@@ -3052,8 +3265,6 @@
drawi(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxDrawsX: x y: y z: z in: aGLXWindowId
@@ -3068,8 +3279,6 @@
draws(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxDraw2X: x y: y in: aGLXWindowId
@@ -3083,8 +3292,6 @@
draw2(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxDraw2iX: x y: y in: aGLXWindowId
@@ -3098,8 +3305,6 @@
draw2i(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxDraw2sX: x y: y in: aGLXWindowId
@@ -3113,8 +3318,6 @@
draw2s(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxDrawmode: mode in: aGLXWindowId
@@ -3215,8 +3418,6 @@
font(_shortVal(fntnum));
RETURN (true);
%}
-.
- ^ false
!
glxForegroundIn: aGLXWindowId
@@ -3226,8 +3427,6 @@
foreground();
RETURN (true);
%}
-.
- ^ false
!
glxFreepup: pup in: aGLXWindowId
@@ -3292,16 +3491,6 @@
^ false
!
-glxGenobjIn: aGLXWindowId
-
-%{ /* NOCONTEXT */
- SETWIN(aGLXWindowId)
- RETURN (_MKSMALLINT(genobj()));
-%}
-.
- ^ false
-!
-
glxGentagIn: aGLXWindowId
%{ /* NOCONTEXT */
@@ -3332,8 +3521,6 @@
SETWIN(aGLXWindowId)
RETURN (_MKSMALLINT(getbutton(_deviceVal(num))));
%}
-.
- ^ false
!
glxGetcmmodeIn: aGLXWindowId
@@ -3355,8 +3542,6 @@
SETWIN(aGLXWindowId)
RETURN (_MKSMALLINT(getcolor()));
%}
-.
- ^ false
!
glxGetcposIn: aGLXWindowId
@@ -3453,8 +3638,6 @@
SETWIN(aGLXWindowId)
RETURN (_MKSMALLINT(getgdesc(_longVal(inquiry))));
%}
-.
- ^ false
!
glxGetheightIn: aGLXWindowId
@@ -3463,8 +3646,6 @@
SETWIN(aGLXWindowId)
RETURN (_MKSMALLINT(getheight()));
%}
-.
- ^ false
!
glxGethitcodeIn: aGLXWindowId
@@ -3575,18 +3756,6 @@
^ false
!
-glxGetopenobjIn: aGLXWindowId
-
-%{ /* NOCONTEXT */
-#ifdef GLX
- SETWIN(aGLXWindowId)
- RETURN (_MKSMALLINT(getopenobj()));
-#endif
-%}
-.
- ^ false
-!
-
glxGetothermonitorIn: aGLXWindowId
%{ /* NOCONTEXT */
@@ -3834,16 +4003,6 @@
^ false
!
-glxIsobj: obj in: aGLXWindowId
-
-%{ /* NOCONTEXT */
- SETWIN(aGLXWindowId)
- RETURN (_MKBOOLEAN(isobj(_objectVal(obj))));
-%}
-.
- ^ false
-!
-
glxIsqueued: dev in: aGLXWindowId
%{ /* NOCONTEXT */
@@ -3928,8 +4087,6 @@
linewidth(_shortVal(n));
RETURN (true);
%}
-.
- ^ false
!
glxLinewidthf: n in: aGLXWindowId
@@ -3940,8 +4097,6 @@
linewidthf(_floatVal(n));
RETURN (true);
%}
-.
- ^ false
!
glxLmcolorMode: mode in: aGLXWindowId
@@ -4052,35 +4207,6 @@
^ false
!
-glxMakeObject:id in:aGLXWindowId
- "start object definition -
- another name conflict"
-
-%{ /* NOCONTEXT */
- if (_isSmallInteger(id)) {
- SETWIN(aGLXWindowId)
- makeobj(_objectVal(id));
- RETURN (true);
- }
-%}
-.
- ^ false
-!
-
-glxMakeobj: obj in: aGLXWindowId
- "start object definition"
-
-%{ /* NOCONTEXT */
- if (_isSmallInteger(obj)) {
- SETWIN(aGLXWindowId)
- makeobj(_objectVal(obj));
- RETURN (true);
- }
-%}
-.
- ^ false
-!
-
glxMaketag: t in: aGLXWindowId
%{ /* NOCONTEXT */
@@ -4101,8 +4227,6 @@
mapcolor(_colorindexVal(i), _shortVal(red), _shortVal(green), _shortVal(blue));
RETURN (true);
%}
-.
- ^ false
!
glxMaxsizeX: x y: y in: aGLXWindowId
@@ -4156,8 +4280,6 @@
move(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxMoveiX: x y: y z: z in: aGLXWindowId
@@ -4172,8 +4294,6 @@
movei(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxMovesX: x y: y z: z in: aGLXWindowId
@@ -4188,8 +4308,6 @@
moves(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxMove2X: x y: y in: aGLXWindowId
@@ -4203,8 +4321,6 @@
move2(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxMove2iX: x y: y in: aGLXWindowId
@@ -4218,8 +4334,6 @@
move2i(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxMove2sX: x y: y in: aGLXWindowId
@@ -4233,8 +4347,6 @@
move2s(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxMsalphaMode: mode in: aGLXWindowId
@@ -4545,8 +4657,6 @@
pdr(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxPdriX: x y: y z: z in: aGLXWindowId
@@ -4561,8 +4671,6 @@
pdri(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxPdrsX: x y: y z: z in: aGLXWindowId
@@ -4577,8 +4685,6 @@
pdrs(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxPdr2X: x y: y in: aGLXWindowId
@@ -4592,8 +4698,6 @@
pdr2(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxPdr2iX: x y: y in: aGLXWindowId
@@ -4607,8 +4711,6 @@
pdr2i(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxPdr2sX: x y: y in: aGLXWindowId
@@ -4622,8 +4724,6 @@
pdr2s(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxPicksizeX: x y: y in: aGLXWindowId
@@ -4664,8 +4764,6 @@
pmv(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxPmviX: x y: y z: z in: aGLXWindowId
@@ -4680,8 +4778,6 @@
pmvi(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxPmvsX: x y: y z: z in: aGLXWindowId
@@ -4696,8 +4792,6 @@
pmvs(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxPmv2X: x y: y in: aGLXWindowId
@@ -4711,8 +4805,6 @@
pmv2(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxPmv2iX: x y: y in: aGLXWindowId
@@ -4726,8 +4818,6 @@
pmv2i(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxPmv2sX: x y: y in: aGLXWindowId
@@ -4741,8 +4831,6 @@
pmv2s(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxPntX: x y: y z: z in: aGLXWindowId
@@ -4757,8 +4845,6 @@
pnt(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxPntiX: x y: y z: z in: aGLXWindowId
@@ -4773,8 +4859,6 @@
pnti(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxPntsX: x y: y z: z in: aGLXWindowId
@@ -4789,8 +4873,6 @@
pnts(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxPnt2X: x y: y in: aGLXWindowId
@@ -4804,8 +4886,6 @@
pnt2(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxPnt2iX: x y: y in: aGLXWindowId
@@ -4819,8 +4899,6 @@
pnt2i(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxPnt2sX: x y: y in: aGLXWindowId
@@ -4834,8 +4912,6 @@
pnt2s(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxPntsize: n in: aGLXWindowId
@@ -4891,8 +4967,6 @@
polarview(c_dist, a_azim, a_inc, a_twist);
RETURN (true);
%}
-.
- ^ false
!
glxPolymode: mode in: aGLXWindowId
@@ -4902,8 +4976,6 @@
polymode(_longVal(mode));
RETURN (true);
%}
-.
- ^ false
!
glxPolysmoothMode: mode in: aGLXWindowId
@@ -4926,8 +4998,6 @@
popattributes();
RETURN (true);
%}
-.
- ^ false
!
glxPopnameIn: aGLXWindowId
@@ -4950,8 +5020,6 @@
popviewport();
RETURN (true);
%}
-.
- ^ false
!
glxPrefpositionX1: x1 x2: x2 y1: y1 y2: y2 in: aGLXWindowId
@@ -4961,8 +5029,6 @@
prefposition(_longVal(x1), _longVal(x2), _longVal(y1), _longVal(y2));
RETURN (true);
%}
-.
- ^ false
!
glxPrefsizeX: x y: y in: aGLXWindowId
@@ -4972,8 +5038,6 @@
prefsize(_longVal(x), _longVal(y));
RETURN (true);
%}
-.
- ^ false
!
glxPushattributesIn: aGLXWindowId
@@ -4983,8 +5047,6 @@
pushattributes();
RETURN (true);
%}
-.
- ^ false
!
glxPushname: name In: aGLXWindowId
@@ -5007,8 +5069,6 @@
pushviewport();
RETURN (true);
%}
-.
- ^ false
!
glxQdevice: dev in: aGLXWindowId
@@ -5018,8 +5078,6 @@
qdevice(_deviceVal(dev));
RETURN (true);
%}
-.
- ^ false
!
glxQenterDev: dev val: val in: aGLXWindowId
@@ -5029,8 +5087,6 @@
qenter(_deviceVal(dev), _shortVal(val));
RETURN (true);
%}
-.
- ^ false
!
glxQgetfdIn: aGLXWindowId
@@ -5066,8 +5122,6 @@
qreset();
RETURN (true);
%}
-.
- ^ false
!
glxQtestIn: aGLXWindowId
@@ -5076,8 +5130,6 @@
SETWIN(aGLXWindowId)
RETURN (_MKSMALLINT(qtest()));
%}
-.
- ^ false
!
glxRdrX: x y: y z: z in: aGLXWindowId
@@ -5092,8 +5144,6 @@
rdr(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxRdriX: x y: y z: z in: aGLXWindowId
@@ -5108,8 +5158,6 @@
rdri(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxRdrsX: x y: y z: z in: aGLXWindowId
@@ -5124,8 +5172,6 @@
rdrs(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxRdr2X: x y: y in: aGLXWindowId
@@ -5139,8 +5185,6 @@
rdr2(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxRdr2iX: x y: y in: aGLXWindowId
@@ -5154,8 +5198,6 @@
rdr2i(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxRdr2sX: x y: y in: aGLXWindowId
@@ -5169,8 +5211,6 @@
rdr2s(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxReadsource: src in: aGLXWindowId
@@ -5193,8 +5233,6 @@
rect(_coordVal(x1), _coordVal(y1), _coordVal(x2), _coordVal(y2));
RETURN (true);
%}
-.
- ^ false
!
glxRectiX1: x1 y1: y1 x2: x2 y2: y2 in: aGLXWindowId
@@ -5204,8 +5242,6 @@
recti(_icoordVal(x1), _icoordVal(y1), _icoordVal(x2), _icoordVal(y2));
RETURN (true);
%}
-.
- ^ false
!
glxRectsX1: x1 y1: y1 x2: x2 y2: y2 in: aGLXWindowId
@@ -5215,8 +5251,6 @@
rects(_scoordVal(x1), _scoordVal(y1), _scoordVal(x2), _scoordVal(y2));
RETURN (true);
%}
-.
- ^ false
!
glxRectfX1: x1 y1: y1 x2: x2 y2: y2 in: aGLXWindowId
@@ -5226,8 +5260,6 @@
rectf(_coordVal(x1), _coordVal(y1), _coordVal(x2), _coordVal(y2));
RETURN (true);
%}
-.
- ^ false
!
glxRectfiX1: x1 y1: y1 x2: x2 y2: y2 in: aGLXWindowId
@@ -5237,8 +5269,6 @@
rectfi(_icoordVal(x1), _icoordVal(y1), _icoordVal(x2), _icoordVal(y2));
RETURN (true);
%}
-.
- ^ false
!
glxRectfsX1: x1 y1: y1 x2: x2 y2: y2 in: aGLXWindowId
@@ -5248,8 +5278,6 @@
rectfs(_scoordVal(x1), _scoordVal(y1), _scoordVal(x2), _scoordVal(y2));
RETURN (true);
%}
-.
- ^ false
!
glxRectcopyX1: x1 y1: y1 x2: x2 y2: y2 newx: newx newy: newy in: aGLXWindowId
@@ -5347,8 +5375,6 @@
rmv(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxRmviX: x y: y z: z in: aGLXWindowId
@@ -5363,8 +5389,6 @@
rmvi(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxRmvsX: x y: y z: z in: aGLXWindowId
@@ -5379,8 +5403,6 @@
rmvs(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxRmv2X: x y: y in: aGLXWindowId
@@ -5394,8 +5416,6 @@
rmv2(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxRmv2iX: x y: y in: aGLXWindowId
@@ -5409,8 +5429,6 @@
rmv2i(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxRmv2sX: x y: y in: aGLXWindowId
@@ -5424,8 +5442,6 @@
rmv2s(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxRpdrX: x y: y z: z in: aGLXWindowId
@@ -5440,8 +5456,6 @@
rpdr(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxRpdriX: x y: y z: z in: aGLXWindowId
@@ -5456,8 +5470,6 @@
rpdri(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxRpdrsX: x y: y z: z in: aGLXWindowId
@@ -5472,8 +5484,6 @@
rpdrs(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxRpdr2X: x y: y in: aGLXWindowId
@@ -5487,8 +5497,6 @@
rpdr2(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxRpdr2iX: x y: y in: aGLXWindowId
@@ -5502,8 +5510,6 @@
rpdr2i(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxRpdr2sX: x y: y in: aGLXWindowId
@@ -5517,8 +5523,6 @@
rpdr2s(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxRpmvX: x y: y z: z in: aGLXWindowId
@@ -5533,8 +5537,6 @@
rpmv(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxRpmviX: x y: y z: z in: aGLXWindowId
@@ -5549,8 +5551,6 @@
rpmvi(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxRpmvsX: x y: y z: z in: aGLXWindowId
@@ -5565,8 +5565,6 @@
rpmvs(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxRpmv2X: x y: y in: aGLXWindowId
@@ -5580,8 +5578,6 @@
rpmv2(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxRpmv2iX: x y: y in: aGLXWindowId
@@ -5595,8 +5591,6 @@
rpmv2i(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxRpmv2sX: x y: y in: aGLXWindowId
@@ -5610,8 +5604,6 @@
rpmv2s(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxSboxX1: x1 y1: y1 x2: x2 y2: y2 in: aGLXWindowId
@@ -5940,17 +5932,6 @@
^ false
!
-glxSinglebufferIn: aGLXWindowId
-
-%{ /* NOCONTEXT */
- SETWIN(aGLXWindowId)
- singlebuffer();
- RETURN (true);
-%}
-.
- ^ false
-!
-
glxSmoothline: mode in: aGLXWindowId
%{ /* NOCONTEXT */
@@ -6214,7 +6195,7 @@
^ false
!
-glxT3s: v in: aGLXWindowId
+glxT3s:v in:aGLXWindowId
%{ /* NOCONTEXT */
#ifdef FULL_GLX
@@ -6230,7 +6211,7 @@
^ false
!
-glxT3i: v in: aGLXWindowId
+glxT3i:v in:aGLXWindowId
%{ /* NOCONTEXT */
#ifdef FULL_GLX
@@ -6246,7 +6227,7 @@
^ false
!
-glxT3f: v in: aGLXWindowId
+glxT3f:v in:aGLXWindowId
%{ /* NOCONTEXT */
#ifdef FULL_GLX
@@ -6262,7 +6243,7 @@
^ false
!
-glxT3d: v in: aGLXWindowId
+glxT3d:v in:aGLXWindowId
%{ /* NOCONTEXT */
#ifdef FULL_GLX
@@ -6342,58 +6323,6 @@
^ false
!
-glxTexDef2dIndex: index nc:nc width:w height:h bits:image np:np props:props in: aGLXWindowId
- "bind a texture"
-
-%{ /* NOCONTEXT */
-#ifdef GLX
- unsigned char *cp;
- const float *fp;
- OBJ cls;
- float fbuff[30];
-
- if (__isByteArray(image)) {
- cp = _ByteArrayInstPtr(image)->ba_element;
- fp = getFloatsFromFloatArrayInto(props, fbuff);
-
- SETWIN(aGLXWindowId)
- texdef2d(_longVal(index), _longVal(nc), _longVal(w), _longVal(h),
- (const unsigned long *)cp, _longVal(np), fp);
- RETURN (true);
- }
-#endif
-%}
-.
- ^ false
-!
-
-glxTevbind: target index: index in: aGLXWindowId
-
-%{ /* NOCONTEXT */
-#ifdef GLX
- SETWIN(aGLXWindowId)
- tevbind(_longVal(target), _longVal(index));
- RETURN (true);
-#endif
-%}
-.
- ^ false
-!
-
-glxTexbind: target index: index in: aGLXWindowId
- "bind a texture"
-
-%{ /* NOCONTEXT */
-#ifdef GLX
- SETWIN(aGLXWindowId)
- texbind(_longVal(target), _longVal(index));
- RETURN (true);
-#endif
-%}
-.
- ^ false
-!
-
glxTextcolor: tcolor in: aGLXWindowId
%{ /* NOCONTEXT */
@@ -6838,7 +6767,7 @@
^ false
! !
-!GLXWorkstation methodsFor:'vertex data transfer '!
+!GLXWorkstation methodsFor:'vertex data transfer'!
glxV2s:v in:aGLXWindowId
"pass a vertex; v must be a vector with 2 shorts; z is taken as 0"
--- a/GLXWorkstation.st Mon Feb 06 01:30:10 1995 +0100
+++ b/GLXWorkstation.st Mon Feb 06 01:38:04 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/GLXWorkstation.st,v 1.16 1994-11-21 16:43:13 claus Exp $
+$Header: /cvs/stx/stx/libview/GLXWorkstation.st,v 1.17 1995-02-06 00:36:30 claus Exp $
'!
!GLXWorkstation class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/GLXWorkstation.st,v 1.16 1994-11-21 16:43:13 claus Exp $
+$Header: /cvs/stx/stx/libview/GLXWorkstation.st,v 1.17 1995-02-06 00:36:30 claus Exp $
"
!
@@ -71,7 +71,8 @@
(see a bit of this in 'clients/IRIS-specials')
Some functions are duplicated, Jeff and I developed those in parallel -
- those will be merged and duplicates removed ...
+ for now, both will remain - finally they will be merged and duplicates removed ...
+ (examples are makeobj and makeObject).
Also, in a hurry to implement all those methods, many do no or only
limited argument checking - make certain, that you pass the correct
@@ -95,7 +96,7 @@
"
! !
-!GLXWorkstation class primitiveDefinitions!
+!GLXWorkstation primitiveDefinitions!
%{
/*
@@ -151,7 +152,7 @@
*/
#if defined(hpux) && defined(POSITIVE_ADDRESSES)
# define MKDPY(o) (Display *)((int)(o) & ~TAG_INT)
-# define MKWIN(o) (Window)((int)(o) & ~TAG_INT)
+# define MKWIN(o) (Window)((int)(o) & ~TAG_INT)
#else
# define MKDPY(o) (Display *)(_intVal(o))
# define MKWIN(o) (Window)(_intVal(o))
@@ -280,7 +281,7 @@
%}
! !
-!GLXWorkstation class primitiveFunctions!
+!GLXWorkstation primitiveFunctions!
%{
/*
@@ -667,28 +668,101 @@
for a real GL engine, false for the simulator here."
%{ /* NOCONTEXT */
-
-#ifdef VGL
- RETURN ( false );
-#endif
#ifdef GLX
RETURN ( true );
#endif
-%}
+%}.
+ ^ false
+
+ "
+ Display supportsRGB
+ "
!
supportsLight
- "return true, if this gl workstation supports light (i.e.
- if its a real GL)"
-%{ /* NOCONTEXT */
-
-#ifdef VGL
- RETURN ( false );
-#endif
+ "return true, if this gl workstation supports light
+ (i.e. if its a real GL)"
+
+%{ /* NOCONTEXT */
#ifdef GLX
RETURN ( true );
#endif
-%}
+%}.
+ ^ false
+
+ "
+ Display supportsLight
+ "
+!
+
+supportsTextures
+ "return true, if this gl workstation supports texture mapping
+ (i.e. if its a real GL)"
+
+%{ /* NOCONTEXT */
+#ifdef GLX
+ if (getgdesc(GD_TEXTURE) != 0) {
+ RETURN ( true );
+ }
+#endif
+%}.
+ ^ false
+
+ "
+ Display supportsTextures
+ "
+!
+
+supportsDoubleBuffer
+ "return true, if this gl workstation supports double buffering"
+%{ /* NOCONTEXT */
+
+#ifdef GLX
+ if (getgdesc(GD_BITS_NORM_DBL_RED) != 0) {
+ RETURN ( true );
+ }
+#endif
+%}.
+ ^ false
+
+ "
+ Display supportsDoubleBuffer
+ "
+!
+
+supportsZBuffer
+ "return true, if this gl workstation has z buffer support"
+%{ /* NOCONTEXT */
+
+#ifdef GLX
+ if (getgdesc(GD_BITS_NORM_ZBUFFER) != 0) {
+ RETURN ( true );
+ }
+#endif
+%}.
+ ^ false
+
+ "
+ Display supportsZBuffer
+ "
+!
+
+maxZValue
+ "return the max. Z value (only valid if z-buffer is supported)"
+%{
+#ifdef GLX
+ long zMax;
+ extern OBJ _MKLARGEINT();
+
+ zMax = getgdesc(GD_ZMAX);
+
+ if ((zMax >= _MIN_INT) && (zMax <= _MAX_INT)) {
+ RETURN ( _MKSMALLINT(zMax) );
+ }
+ RETURN ( _MKLARGEINT(zMax) );
+#endif
+%}.
+ ^ nil
! !
!GLXWorkstation methodsFor:'window creation'!
@@ -859,10 +933,9 @@
_FLOAT_(bottom, f_bottom)
_FLOAT_(top, f_top)
ortho2(f_left, f_right, f_bottom, f_top);
- RETURN (true);
-%}
-.
- ^ false
+%}
+.
+ ^ true
!
glxReshapeViewPortIn: aGLXWindowId
@@ -870,10 +943,9 @@
%{ /* NOCONTEXT */
SETWIN(aGLXWindowId)
reshapeviewport();
- RETURN (true);
-%}
-.
- ^ false
+%}
+.
+ ^ true
! !
!GLXWorkstation methodsFor:'transformations'!
@@ -1033,8 +1105,6 @@
SETWIN(aGLXWindowId)
RETURN (doRotate(angle, 'x'));
%}
-.
- ^ false
!
glxRotateY:angle in:aGLXWindowId
@@ -1046,8 +1116,6 @@
SETWIN(aGLXWindowId)
RETURN (doRotate(angle, 'y'));
%}
-.
- ^ false
!
glxRotateZ:angle in:aGLXWindowId
@@ -1059,8 +1127,6 @@
SETWIN(aGLXWindowId)
RETURN (doRotate(angle, 'z'));
%}
-.
- ^ false
!
glxRotate:angle axis:axis in:aGLXWindowId
@@ -1223,6 +1289,7 @@
glxLmdef:what index:index np:np props:props in:aGLXWindowId
"define a material, light source or lighting model;
+ what must be one of #material, #light or #lightModel.
props must be a FloatArray or a subclass of FloatArray"
%{ /* NOCONTEXT */
@@ -1271,7 +1338,9 @@
!
glxLmbind:target index:index in:aGLXWindowId
- "select a material, lighyt or lighting model"
+ "select a material, light or lighting model.
+ target must be a symbol from: #material, #backMaterial,
+ #light0-light7 or #lightModel."
%{ /* NOCONTEXT */
#ifdef GLX
@@ -1312,6 +1381,138 @@
%}
.
^ false
+!
+
+glxTexDef2d:index nc:nc width:w height:h bits:image np:np props:props in:aGLXWindowId
+ "define a 2D texture. index is the 'name' of the texture;
+ nc is the number of components (1-4) per pixel;
+ w/h define the size of the texture; bits is a byteArray containing the
+ long-word aligned pixel data; np is the number of props found in
+ the floatArray props. Props must be delimited by a 0.0 entry."
+
+%{ /* NOCONTEXT */
+#ifdef GLX
+ unsigned char *cp;
+ const float *fp;
+ OBJ cls;
+ float fbuff[30];
+
+ if (__isByteArray(image)) {
+ cp = _ByteArrayInstPtr(image)->ba_element;
+ fp = getFloatsFromFloatArrayInto(props, fbuff);
+
+ SETWIN(aGLXWindowId)
+ texdef2d(_intVal(index), _intVal(nc), _intVal(w), _intVal(h),
+ (const unsigned long *)cp, _intVal(np), fp);
+ RETURN (true);
+ }
+#endif
+%}
+.
+ ^ false
+!
+
+glxTexDef3d:index nc:nc width:w height:h depth:d bits:image np:np props:props in:aGLXWindowId
+ "define a 3D texture. index is the 'name' of the texture;
+ nc is the number of components (1-4) per pixel;
+ w/h/d define the size of the texture; bits is a byteArray containing the
+ long-word aligned pixel data; np is the number of props found in
+ the floatArray props. Props must be delimited by a 0.0 entry."
+
+%{ /* NOCONTEXT */
+#ifdef GLX
+ unsigned char *cp;
+ const float *fp;
+ OBJ cls;
+ float fbuff[30];
+
+ if (__isByteArray(image)) {
+ cp = _ByteArrayInstPtr(image)->ba_element;
+ fp = getFloatsFromFloatArrayInto(props, fbuff);
+
+ SETWIN(aGLXWindowId)
+ texdef3d(_intVal(index), _intVal(nc), _intVal(w), _intVal(h),
+ _intVal(d),
+ (const unsigned long *)cp, _intVal(np), fp);
+ RETURN (true);
+ }
+#endif
+%}
+.
+ ^ false
+!
+
+glxTevdef:index np:np props:props in:aGLXWindowId
+
+%{ /* NOCONTEXT */
+#ifdef GLX
+ const float *fp;
+ float fbuff[30];
+
+ SETWIN(aGLXWindowId)
+ fp = getFloatsFromFloatArrayInto(props, fbuff);
+ tevdef(_intVal(index), _intVal(np), fp);
+ RETURN (true);
+#endif
+%}
+.
+ ^ false
+!
+
+glxTevbind:target index:index in:aGLXWindowId
+ "bind a texture environment; target must be 0
+ or the symbol #env0."
+
+%{ /* NOCONTEXT */
+#ifdef GLX
+ long t;
+
+ if (_isSmallInteger(target)) {
+ t = _intVal(target);
+ } else {
+ if (target == @symbol(env0)) {
+ t = TV_ENV0;
+ } else {
+ RETURN (false);
+ }
+ }
+ SETWIN(aGLXWindowId)
+ tevbind(t, _intVal(index));
+ RETURN (true);
+#endif
+%}
+.
+ ^ false
+!
+
+glxTexbind:target index:index in:aGLXWindowId
+ "bind a texture; target must be an integer or one
+ of the symbols #texture0, #textureDetail or #textureIdle."
+
+%{ /* NOCONTEXT */
+#ifdef GLX
+ long t;
+
+ if (_isSmallInteger(target)) {
+ t = _intVal(target);
+ } else {
+ if (target == @symbol(texture0)) {
+ t = TX_TEXTURE_0;
+ } else if (target == @symbol(textureDetail)) {
+ t = TX_TEXTURE_DETAIL;
+ } else if (target == @symbol(textureIdle)) {
+ t = TX_TEXTURE_IDLE;
+ } else {
+ RETURN (false);
+ }
+ }
+ SETWIN(aGLXWindowId)
+ texbind(t, _intVal(index));
+ RETURN (true);
+#endif
+%}
+.
+ ^ false
! !
!GLXWorkstation methodsFor:'color'!
@@ -1338,7 +1539,7 @@
!
glxColorRed:r green:g blue:b in:aGLXWindowId
- "set color, args must be integer values"
+ "set color, args must be integer values in 0..255"
%{ /* NOCONTEXT */
@@ -1355,6 +1556,27 @@
%}
.
^ false
+!
+
+glxColorRed:r green:g blue:b alpha:a in:aGLXWindowId
+ "set color including alpha value, args must be integer values within 0..255"
+
+%{ /* NOCONTEXT */
+
+#ifdef GLX
+ short s_r, s_g, s_b, s_a;
+
+ _INT_(r, s_r);
+ _INT_(g, s_g);
+ _INT_(b, s_b);
+ _INT_(a, s_a);
+ SETWIN(aGLXWindowId)
+ cpack((((((s_a<<8) | s_b) << 8) | s_g) << 8) | s_r);
+ RETURN (true);
+#endif
+%}
+.
+ ^ false
! !
!GLXWorkstation methodsFor:'clearing'!
@@ -1367,8 +1589,6 @@
clear();
RETURN (true);
%}
-.
- ^ false
!
glxZClearIn:aGLXWindowId
@@ -1383,6 +1603,20 @@
%}
.
^ false
+!
+
+glxCzclearCval:cval zval:zval in:aGLXWindowId
+ "clear to a color (cval) and clear z buffer to zval simultaniously"
+
+%{ /* NOCONTEXT */
+#ifdef GLX
+ SETWIN(aGLXWindowId)
+ czclear((ulong)_intVal(cval), _intVal(zval));
+ RETURN (true);
+#endif
+%}
+.
+ ^ false
! !
!GLXWorkstation methodsFor:'matrix stack'!
@@ -1395,8 +1629,6 @@
pushmatrix();
RETURN (true);
%}
-.
- ^ false
!
glxPopmatrixIn:aGLXWindowId
@@ -1407,8 +1639,6 @@
popmatrix();
RETURN (true);
%}
-.
- ^ false
!
glxGetMatrix:arrayOf16Floats in:aGLXWindowId
@@ -1439,8 +1669,6 @@
loadmatrix(*m);
RETURN (true);
%}
-.
- ^ false
!
glxMultMatrix:arrayOf16Floats in:aGLXWindowId
@@ -1456,8 +1684,6 @@
multmatrix(*m);
RETURN (true);
%}
-.
- ^ false
! !
!GLXWorkstation methodsFor:'double buffering'!
@@ -1470,8 +1696,16 @@
doublebuffer();
RETURN (true);
%}
-.
- ^ false
+!
+
+glxSingleBufferIn: aGLXWindowId
+ "set single buffer mode"
+
+%{ /* NOCONTEXT */
+ SETWIN(aGLXWindowId)
+ singlebuffer();
+ RETURN (true);
+%}
!
glxSwapBuffersIn:aGLXWindowId
@@ -1482,8 +1716,6 @@
swapbuffers();
RETURN (true);
%}
-.
- ^ false
!
glxFrontBufferIn:aGLXWindowId
@@ -1497,8 +1729,6 @@
frontbuffer(TRUE);
RETURN (true);
%}
-.
- ^ false
!
glxBackBufferIn:aGLXWindowId
@@ -1512,8 +1742,6 @@
backbuffer(TRUE);
RETURN (true);
%}
-.
- ^ false
!
glxBackbuffer: b in: aGLXWindowId
@@ -1523,8 +1751,6 @@
backbuffer(_booleanVal(b));
RETURN (true);
%}
-.
- ^ false
!
glxFrontbuffer: b in: aGLXWindowId
@@ -1534,8 +1760,6 @@
frontbuffer(_booleanVal(b));
RETURN (true);
%}
-.
- ^ false
! !
!GLXWorkstation methodsFor:'zbuffer'!
@@ -1668,8 +1892,6 @@
gconfig();
RETURN (true);
%}
-.
- ^ false
!
glxNmode:aSymbol in:aGLXWindowId
@@ -1728,8 +1950,6 @@
bgnpoint();
RETURN (true);
%}
-.
- ^ false
!
glxEndPointIn:aGLXWindowId
@@ -1740,8 +1960,6 @@
endpoint();
RETURN (true);
%}
-.
- ^ false
!
glxBeginClosedLineIn:aGLXWindowId
@@ -1752,8 +1970,6 @@
bgnclosedline();
RETURN (true);
%}
-.
- ^ false
!
glxEndClosedLineIn:aGLXWindowId
@@ -1764,8 +1980,6 @@
endclosedline();
RETURN (true);
%}
-.
- ^ false
!
glxBeginLineIn:aGLXWindowId
@@ -1776,8 +1990,6 @@
bgnline();
RETURN (true);
%}
-.
- ^ false
!
glxEndLineIn:aGLXWindowId
@@ -1788,8 +2000,6 @@
endline();
RETURN (true);
%}
-.
- ^ false
!
glxBeginPolygonIn:aGLXWindowId
@@ -1800,8 +2010,6 @@
bgnpolygon();
RETURN (true);
%}
-.
- ^ false
!
glxEndPolygonIn:aGLXWindowId
@@ -1812,8 +2020,6 @@
endpolygon();
RETURN (true);
%}
-.
- ^ false
!
glxBeginTriangleMeshIn:aGLXWindowId
@@ -1824,8 +2030,6 @@
bgntmesh();
RETURN (true);
%}
-.
- ^ false
!
glxEndTriangleMeshIn:aGLXWindowId
@@ -1836,8 +2040,6 @@
endtmesh();
RETURN (true);
%}
-.
- ^ false
!
glxBeginQuadrilateralStripIn:aGLXWindowId
@@ -1848,8 +2050,6 @@
bgnqstrip();
RETURN (true);
%}
-.
- ^ false
!
glxEndQuadrilateralStripIn:aGLXWindowId
@@ -1860,8 +2060,6 @@
endqstrip();
RETURN (true);
%}
-.
- ^ false
! !
!GLXWorkstation methodsFor:'sphere drawing'!
@@ -1980,8 +2178,6 @@
patch(*mX, *mY, *mZ);
RETURN (true);
%}
-.
- ^ false
!
glxBeginCurveIn:aGLXWindowId
@@ -2083,7 +2279,7 @@
^ false
! !
-!GLXWorkstation methodsFor:'arcs and circles '!
+!GLXWorkstation methodsFor:'arcs and circles'!
glxArcX: x y: y radius: radius startang: startang endang: endang in: aGLXWindowId
"draw an arc"
@@ -2119,8 +2315,6 @@
arci(c_x, c_y, c_radius, a_startang, a_endang);
RETURN (true);
%}
-.
- ^ false
!
glxArcsX: x y: y radius: radius startang: startang endang: endang in: aGLXWindowId
@@ -2139,8 +2333,6 @@
arcs(c_x, c_y, c_radius, a_startang, a_endang);
RETURN (true);
%}
-.
- ^ false
!
glxArcfX: x y: y radius: radius startang: startang endang: endang in: aGLXWindowId
@@ -2159,8 +2351,6 @@
arcf(c_x, c_y, c_radius, a_startang, a_endang);
RETURN (true);
%}
-.
- ^ false
!
glxArcfiX: x y: y radius: radius startang: startang endang: endang in: aGLXWindowId
@@ -2179,8 +2369,6 @@
arcfi(c_x, c_y, c_radius, a_startang, a_endang);
RETURN (true);
%}
-.
- ^ false
!
glxArcfsX: x y: y radius: radius startang: startang endang: endang in: aGLXWindowId
@@ -2199,8 +2387,6 @@
arcfs(c_x, c_y, c_radius, a_startang, a_endang);
RETURN (true);
%}
-.
- ^ false
!
glxCircX: x y: y radius: radius in: aGLXWindowId
@@ -2216,8 +2402,6 @@
circ(c_x, c_y, c_radius);
RETURN (true);
%}
-.
- ^ false
!
glxCirciX: x y: y radius: radius in: aGLXWindowId
@@ -2233,8 +2417,6 @@
circi(c_x, c_y, c_radius);
RETURN (true);
%}
-.
- ^ false
!
glxCircsX: x y: y radius: radius in: aGLXWindowId
@@ -2250,8 +2432,6 @@
circs(c_x, c_y, c_radius);
RETURN (true);
%}
-.
- ^ false
!
glxCircfX: x y: y radius: radius in: aGLXWindowId
@@ -2267,8 +2447,6 @@
circf(c_x, c_y, c_radius);
RETURN (true);
%}
-.
- ^ false
!
glxCircfiX: x y: y radius: radius in: aGLXWindowId
@@ -2284,8 +2462,6 @@
circfi(c_x, c_y, c_radius);
RETURN (true);
%}
-.
- ^ false
!
glxCircfsX: x y: y radius: radius in: aGLXWindowId
@@ -2301,13 +2477,151 @@
circfs(c_x, c_y, c_radius);
RETURN (true);
%}
-.
- ^ false
! !
-!GLXWorkstation methodsFor:'unspecified rest '!
-
-glxAcbufOp: op value: value in: aGLXWindowId
+!GLXWorkstation methodsFor:'objects'!
+
+glxCallObject:obj in:aGLXWindowId
+ "perform the commands of an object (macro)."
+
+%{ /* NOCONTEXT */
+ if (_isSmallInteger(obj)) {
+ SETWIN(aGLXWindowId)
+ callobj(_objectVal(obj));
+ RETURN (true);
+ }
+%}
+.
+ ^ false
+!
+
+glxCallobj: obj in: aGLXWindowId
+ "OBSOLETE; use glxCallObject:in:
+ This one will be removed soon."
+
+%{ /* NOCONTEXT */
+ if (_isSmallInteger(obj)) {
+ SETWIN(aGLXWindowId)
+ callobj(_objectVal(obj));
+ RETURN (true);
+ }
+%}
+.
+ ^ false
+!
+
+glxCloseObjectIn:aGLXWindowId
+ "end object defnition"
+
+%{ /* NOCONTEXT */
+ SETWIN(aGLXWindowId)
+ closeobj();
+ RETURN (true);
+%}
+!
+
+glxCloseobjIn:aGLXWindowId
+ "OBSOLETE: use glxCloseObjectIn:
+ This one will be removed."
+
+%{ /* NOCONTEXT */
+ SETWIN(aGLXWindowId)
+ closeobj();
+ RETURN (true);
+%}
+!
+
+glxDeleteObject:obj in:aGLXWindowId
+
+%{ /* NOCONTEXT */
+ SETWIN(aGLXWindowId)
+ delobj(_objectVal(obj));
+ RETURN (true);
+%}
+!
+
+glxDelobj:obj in:aGLXWindowId
+ "OBSOLETE: use glxDeleteObject:in:
+ This one will be removed."
+
+%{ /* NOCONTEXT */
+ SETWIN(aGLXWindowId)
+ delobj(_objectVal(obj));
+ RETURN (true);
+%}
+!
+
+glxGenObjectIn:aGLXWindowId
+ "return a new (free & unused) object id for use
+ with makeObj"
+
+%{ /* NOCONTEXT */
+ SETWIN(aGLXWindowId)
+ RETURN (_MKSMALLINT(genobj()));
+%}
+!
+
+glxGenobjIn:aGLXWindowId
+ "OBSOLETE: use glxGenObject:in:
+ This one will be removed."
+
+%{ /* NOCONTEXT */
+ SETWIN(aGLXWindowId)
+ RETURN (_MKSMALLINT(genobj()));
+%}
+!
+
+glxMakeObject:id in:aGLXWindowId
+ "start object definition -
+ another name conflict"
+
+%{ /* NOCONTEXT */
+ if (_isSmallInteger(id)) {
+ SETWIN(aGLXWindowId)
+ makeobj(_objectVal(id));
+ RETURN (true);
+ }
+%}
+.
+ ^ false
+!
+
+glxMakeobj:obj in:aGLXWindowId
+ "OBSOLETE; use glxMakeObject:in:
+ This one will be removed soon."
+
+%{ /* NOCONTEXT */
+ if (_isSmallInteger(obj)) {
+ SETWIN(aGLXWindowId)
+ makeobj(_objectVal(obj));
+ RETURN (true);
+ }
+%}
+.
+ ^ false
+!
+
+glxIsobj:obj in:aGLXWindowId
+ "return true, if obj is a valid object id"
+
+%{ /* NOCONTEXT */
+ SETWIN(aGLXWindowId)
+ RETURN (_MKBOOLEAN(isobj(_objectVal(obj))));
+%}
+!
+
+glxGetopenobjIn:aGLXWindowId
+ "return the currently open objects id; -1 if none is open"
+
+%{ /* NOCONTEXT */
+ SETWIN(aGLXWindowId)
+ RETURN (_MKSMALLINT(getopenobj()));
+%}
+! !
+
+!GLXWorkstation methodsFor:'unspecified rest'!
+
+glxAcbufOp:op value:value in:aGLXWindowId
%{ /* NOCONTEXT */
#ifdef GLX
@@ -2353,8 +2667,6 @@
backface(_booleanVal(b));
RETURN (true);
%}
-.
- ^ false
!
glxBbox2Xmin: xmin ymin: ymin x1: x1 y1: y1 x2: x2 y2: y2 in: aGLXWindowId
@@ -2623,34 +2935,6 @@
^ false
!
-glxCallObject:obj in:aGLXWindowId
- "do objects definition
- I defined that one too - but with a different name"
-
-%{ /* NOCONTEXT */
- if (_isSmallInteger(obj)) {
- SETWIN(aGLXWindowId)
- callobj(_objectVal(obj));
- RETURN (true);
- }
-%}
-.
- ^ false
-!
-
-glxCallobj: obj in: aGLXWindowId
-
-%{ /* NOCONTEXT */
- if (_isSmallInteger(obj)) {
- SETWIN(aGLXWindowId)
- callobj(_objectVal(obj));
- RETURN (true);
- }
-%}
-.
- ^ false
-!
-
glxClearhitcodeIn: aGLXWindowId
%{ /* NOCONTEXT */
@@ -2680,29 +2964,6 @@
^ false
!
-glxCloseObjectIn:aGLXWindowId
- "end object defnition - JEFF and I defined this with different names"
-
-%{ /* NOCONTEXT */
- SETWIN(aGLXWindowId)
- closeobj();
- RETURN (true);
-%}
-.
- ^ false
-!
-
-glxCloseobjIn: aGLXWindowId
-
-%{ /* NOCONTEXT */
- SETWIN(aGLXWindowId)
- closeobj();
- RETURN (true);
-%}
-.
- ^ false
-!
-
glxCmodeIn: aGLXWindowId
%{ /* NOCONTEXT */
@@ -2728,8 +2989,6 @@
cmov(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxCmoviX: x y: y z: z in: aGLXWindowId
@@ -2744,8 +3003,6 @@
cmovi(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxCmovsX: x y: y z: z in: aGLXWindowId
@@ -2760,8 +3017,6 @@
cmovs(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxCmov2X: x y: y in: aGLXWindowId
@@ -2775,8 +3030,6 @@
cmov2(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxCmov2iX: x y: y in: aGLXWindowId
@@ -2790,8 +3043,6 @@
cmov2i(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxCmov2sX: x y: y in: aGLXWindowId
@@ -2805,8 +3056,6 @@
cmov2s(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxColorfIndex: index in: aGLXWindowId
@@ -2821,8 +3070,6 @@
concave(_booleanVal(b));
RETURN (true);
%}
-.
- ^ false
!
glxCuroriginN: n xorigin: xorigin yorigin: yorigin in: aGLXWindowId
@@ -2884,8 +3131,6 @@
curvebasis(_shortVal(basid));
RETURN (true);
%}
-.
- ^ false
!
glxCurveit: iterationcount in: aGLXWindowId
@@ -2895,8 +3140,6 @@
curveit(_shortVal(iterationcount));
RETURN (true);
%}
-.
- ^ false
!
glxCurveprecision: nsegments in: aGLXWindowId
@@ -2906,8 +3149,6 @@
curveprecision(_shortVal(nsegments));
RETURN (true);
%}
-.
- ^ false
!
glxCyclemapDuration: duration map: map nxtmap: nxtmap in: aGLXWindowId
@@ -2923,19 +3164,6 @@
^ false
!
-glxCzclearCval: cval zval: zval in: aGLXWindowId
-
-%{ /* NOCONTEXT */
-#ifdef GLX
- SETWIN(aGLXWindowId)
- czclear((ulong)_intVal(cval), _intVal(zval));
- RETURN (true);
-#endif
-%}
-.
- ^ false
-!
-
glxDeflinestyleN: n ls: ls in: aGLXWindowId
"define a line style"
@@ -2944,8 +3172,6 @@
deflinestyle(_shortVal(n), _linestyleVal(ls));
RETURN (true);
%}
-.
- ^ false
!
glxDefpatternN: n size: size mask: mask in: aGLXWindowId
@@ -2961,17 +3187,6 @@
^ false
!
-glxDelobj: obj in: aGLXWindowId
-
-%{ /* NOCONTEXT */
- SETWIN(aGLXWindowId)
- delobj(_objectVal(obj));
- RETURN (true);
-%}
-.
- ^ false
-!
-
glxDeltag: t in: aGLXWindowId
%{ /* NOCONTEXT */
@@ -3036,8 +3251,6 @@
draw(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxDrawiX: x y: y z: z in: aGLXWindowId
@@ -3052,8 +3265,6 @@
drawi(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxDrawsX: x y: y z: z in: aGLXWindowId
@@ -3068,8 +3279,6 @@
draws(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxDraw2X: x y: y in: aGLXWindowId
@@ -3083,8 +3292,6 @@
draw2(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxDraw2iX: x y: y in: aGLXWindowId
@@ -3098,8 +3305,6 @@
draw2i(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxDraw2sX: x y: y in: aGLXWindowId
@@ -3113,8 +3318,6 @@
draw2s(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxDrawmode: mode in: aGLXWindowId
@@ -3215,8 +3418,6 @@
font(_shortVal(fntnum));
RETURN (true);
%}
-.
- ^ false
!
glxForegroundIn: aGLXWindowId
@@ -3226,8 +3427,6 @@
foreground();
RETURN (true);
%}
-.
- ^ false
!
glxFreepup: pup in: aGLXWindowId
@@ -3292,16 +3491,6 @@
^ false
!
-glxGenobjIn: aGLXWindowId
-
-%{ /* NOCONTEXT */
- SETWIN(aGLXWindowId)
- RETURN (_MKSMALLINT(genobj()));
-%}
-.
- ^ false
-!
-
glxGentagIn: aGLXWindowId
%{ /* NOCONTEXT */
@@ -3332,8 +3521,6 @@
SETWIN(aGLXWindowId)
RETURN (_MKSMALLINT(getbutton(_deviceVal(num))));
%}
-.
- ^ false
!
glxGetcmmodeIn: aGLXWindowId
@@ -3355,8 +3542,6 @@
SETWIN(aGLXWindowId)
RETURN (_MKSMALLINT(getcolor()));
%}
-.
- ^ false
!
glxGetcposIn: aGLXWindowId
@@ -3453,8 +3638,6 @@
SETWIN(aGLXWindowId)
RETURN (_MKSMALLINT(getgdesc(_longVal(inquiry))));
%}
-.
- ^ false
!
glxGetheightIn: aGLXWindowId
@@ -3463,8 +3646,6 @@
SETWIN(aGLXWindowId)
RETURN (_MKSMALLINT(getheight()));
%}
-.
- ^ false
!
glxGethitcodeIn: aGLXWindowId
@@ -3575,18 +3756,6 @@
^ false
!
-glxGetopenobjIn: aGLXWindowId
-
-%{ /* NOCONTEXT */
-#ifdef GLX
- SETWIN(aGLXWindowId)
- RETURN (_MKSMALLINT(getopenobj()));
-#endif
-%}
-.
- ^ false
-!
-
glxGetothermonitorIn: aGLXWindowId
%{ /* NOCONTEXT */
@@ -3834,16 +4003,6 @@
^ false
!
-glxIsobj: obj in: aGLXWindowId
-
-%{ /* NOCONTEXT */
- SETWIN(aGLXWindowId)
- RETURN (_MKBOOLEAN(isobj(_objectVal(obj))));
-%}
-.
- ^ false
-!
-
glxIsqueued: dev in: aGLXWindowId
%{ /* NOCONTEXT */
@@ -3928,8 +4087,6 @@
linewidth(_shortVal(n));
RETURN (true);
%}
-.
- ^ false
!
glxLinewidthf: n in: aGLXWindowId
@@ -3940,8 +4097,6 @@
linewidthf(_floatVal(n));
RETURN (true);
%}
-.
- ^ false
!
glxLmcolorMode: mode in: aGLXWindowId
@@ -4052,35 +4207,6 @@
^ false
!
-glxMakeObject:id in:aGLXWindowId
- "start object definition -
- another name conflict"
-
-%{ /* NOCONTEXT */
- if (_isSmallInteger(id)) {
- SETWIN(aGLXWindowId)
- makeobj(_objectVal(id));
- RETURN (true);
- }
-%}
-.
- ^ false
-!
-
-glxMakeobj: obj in: aGLXWindowId
- "start object definition"
-
-%{ /* NOCONTEXT */
- if (_isSmallInteger(obj)) {
- SETWIN(aGLXWindowId)
- makeobj(_objectVal(obj));
- RETURN (true);
- }
-%}
-.
- ^ false
-!
-
glxMaketag: t in: aGLXWindowId
%{ /* NOCONTEXT */
@@ -4101,8 +4227,6 @@
mapcolor(_colorindexVal(i), _shortVal(red), _shortVal(green), _shortVal(blue));
RETURN (true);
%}
-.
- ^ false
!
glxMaxsizeX: x y: y in: aGLXWindowId
@@ -4156,8 +4280,6 @@
move(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxMoveiX: x y: y z: z in: aGLXWindowId
@@ -4172,8 +4294,6 @@
movei(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxMovesX: x y: y z: z in: aGLXWindowId
@@ -4188,8 +4308,6 @@
moves(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxMove2X: x y: y in: aGLXWindowId
@@ -4203,8 +4321,6 @@
move2(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxMove2iX: x y: y in: aGLXWindowId
@@ -4218,8 +4334,6 @@
move2i(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxMove2sX: x y: y in: aGLXWindowId
@@ -4233,8 +4347,6 @@
move2s(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxMsalphaMode: mode in: aGLXWindowId
@@ -4545,8 +4657,6 @@
pdr(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxPdriX: x y: y z: z in: aGLXWindowId
@@ -4561,8 +4671,6 @@
pdri(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxPdrsX: x y: y z: z in: aGLXWindowId
@@ -4577,8 +4685,6 @@
pdrs(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxPdr2X: x y: y in: aGLXWindowId
@@ -4592,8 +4698,6 @@
pdr2(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxPdr2iX: x y: y in: aGLXWindowId
@@ -4607,8 +4711,6 @@
pdr2i(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxPdr2sX: x y: y in: aGLXWindowId
@@ -4622,8 +4724,6 @@
pdr2s(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxPicksizeX: x y: y in: aGLXWindowId
@@ -4664,8 +4764,6 @@
pmv(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxPmviX: x y: y z: z in: aGLXWindowId
@@ -4680,8 +4778,6 @@
pmvi(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxPmvsX: x y: y z: z in: aGLXWindowId
@@ -4696,8 +4792,6 @@
pmvs(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxPmv2X: x y: y in: aGLXWindowId
@@ -4711,8 +4805,6 @@
pmv2(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxPmv2iX: x y: y in: aGLXWindowId
@@ -4726,8 +4818,6 @@
pmv2i(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxPmv2sX: x y: y in: aGLXWindowId
@@ -4741,8 +4831,6 @@
pmv2s(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxPntX: x y: y z: z in: aGLXWindowId
@@ -4757,8 +4845,6 @@
pnt(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxPntiX: x y: y z: z in: aGLXWindowId
@@ -4773,8 +4859,6 @@
pnti(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxPntsX: x y: y z: z in: aGLXWindowId
@@ -4789,8 +4873,6 @@
pnts(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxPnt2X: x y: y in: aGLXWindowId
@@ -4804,8 +4886,6 @@
pnt2(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxPnt2iX: x y: y in: aGLXWindowId
@@ -4819,8 +4899,6 @@
pnt2i(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxPnt2sX: x y: y in: aGLXWindowId
@@ -4834,8 +4912,6 @@
pnt2s(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxPntsize: n in: aGLXWindowId
@@ -4891,8 +4967,6 @@
polarview(c_dist, a_azim, a_inc, a_twist);
RETURN (true);
%}
-.
- ^ false
!
glxPolymode: mode in: aGLXWindowId
@@ -4902,8 +4976,6 @@
polymode(_longVal(mode));
RETURN (true);
%}
-.
- ^ false
!
glxPolysmoothMode: mode in: aGLXWindowId
@@ -4926,8 +4998,6 @@
popattributes();
RETURN (true);
%}
-.
- ^ false
!
glxPopnameIn: aGLXWindowId
@@ -4950,8 +5020,6 @@
popviewport();
RETURN (true);
%}
-.
- ^ false
!
glxPrefpositionX1: x1 x2: x2 y1: y1 y2: y2 in: aGLXWindowId
@@ -4961,8 +5029,6 @@
prefposition(_longVal(x1), _longVal(x2), _longVal(y1), _longVal(y2));
RETURN (true);
%}
-.
- ^ false
!
glxPrefsizeX: x y: y in: aGLXWindowId
@@ -4972,8 +5038,6 @@
prefsize(_longVal(x), _longVal(y));
RETURN (true);
%}
-.
- ^ false
!
glxPushattributesIn: aGLXWindowId
@@ -4983,8 +5047,6 @@
pushattributes();
RETURN (true);
%}
-.
- ^ false
!
glxPushname: name In: aGLXWindowId
@@ -5007,8 +5069,6 @@
pushviewport();
RETURN (true);
%}
-.
- ^ false
!
glxQdevice: dev in: aGLXWindowId
@@ -5018,8 +5078,6 @@
qdevice(_deviceVal(dev));
RETURN (true);
%}
-.
- ^ false
!
glxQenterDev: dev val: val in: aGLXWindowId
@@ -5029,8 +5087,6 @@
qenter(_deviceVal(dev), _shortVal(val));
RETURN (true);
%}
-.
- ^ false
!
glxQgetfdIn: aGLXWindowId
@@ -5066,8 +5122,6 @@
qreset();
RETURN (true);
%}
-.
- ^ false
!
glxQtestIn: aGLXWindowId
@@ -5076,8 +5130,6 @@
SETWIN(aGLXWindowId)
RETURN (_MKSMALLINT(qtest()));
%}
-.
- ^ false
!
glxRdrX: x y: y z: z in: aGLXWindowId
@@ -5092,8 +5144,6 @@
rdr(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxRdriX: x y: y z: z in: aGLXWindowId
@@ -5108,8 +5158,6 @@
rdri(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxRdrsX: x y: y z: z in: aGLXWindowId
@@ -5124,8 +5172,6 @@
rdrs(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxRdr2X: x y: y in: aGLXWindowId
@@ -5139,8 +5185,6 @@
rdr2(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxRdr2iX: x y: y in: aGLXWindowId
@@ -5154,8 +5198,6 @@
rdr2i(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxRdr2sX: x y: y in: aGLXWindowId
@@ -5169,8 +5211,6 @@
rdr2s(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxReadsource: src in: aGLXWindowId
@@ -5193,8 +5233,6 @@
rect(_coordVal(x1), _coordVal(y1), _coordVal(x2), _coordVal(y2));
RETURN (true);
%}
-.
- ^ false
!
glxRectiX1: x1 y1: y1 x2: x2 y2: y2 in: aGLXWindowId
@@ -5204,8 +5242,6 @@
recti(_icoordVal(x1), _icoordVal(y1), _icoordVal(x2), _icoordVal(y2));
RETURN (true);
%}
-.
- ^ false
!
glxRectsX1: x1 y1: y1 x2: x2 y2: y2 in: aGLXWindowId
@@ -5215,8 +5251,6 @@
rects(_scoordVal(x1), _scoordVal(y1), _scoordVal(x2), _scoordVal(y2));
RETURN (true);
%}
-.
- ^ false
!
glxRectfX1: x1 y1: y1 x2: x2 y2: y2 in: aGLXWindowId
@@ -5226,8 +5260,6 @@
rectf(_coordVal(x1), _coordVal(y1), _coordVal(x2), _coordVal(y2));
RETURN (true);
%}
-.
- ^ false
!
glxRectfiX1: x1 y1: y1 x2: x2 y2: y2 in: aGLXWindowId
@@ -5237,8 +5269,6 @@
rectfi(_icoordVal(x1), _icoordVal(y1), _icoordVal(x2), _icoordVal(y2));
RETURN (true);
%}
-.
- ^ false
!
glxRectfsX1: x1 y1: y1 x2: x2 y2: y2 in: aGLXWindowId
@@ -5248,8 +5278,6 @@
rectfs(_scoordVal(x1), _scoordVal(y1), _scoordVal(x2), _scoordVal(y2));
RETURN (true);
%}
-.
- ^ false
!
glxRectcopyX1: x1 y1: y1 x2: x2 y2: y2 newx: newx newy: newy in: aGLXWindowId
@@ -5347,8 +5375,6 @@
rmv(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxRmviX: x y: y z: z in: aGLXWindowId
@@ -5363,8 +5389,6 @@
rmvi(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxRmvsX: x y: y z: z in: aGLXWindowId
@@ -5379,8 +5403,6 @@
rmvs(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxRmv2X: x y: y in: aGLXWindowId
@@ -5394,8 +5416,6 @@
rmv2(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxRmv2iX: x y: y in: aGLXWindowId
@@ -5409,8 +5429,6 @@
rmv2i(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxRmv2sX: x y: y in: aGLXWindowId
@@ -5424,8 +5442,6 @@
rmv2s(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxRpdrX: x y: y z: z in: aGLXWindowId
@@ -5440,8 +5456,6 @@
rpdr(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxRpdriX: x y: y z: z in: aGLXWindowId
@@ -5456,8 +5470,6 @@
rpdri(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxRpdrsX: x y: y z: z in: aGLXWindowId
@@ -5472,8 +5484,6 @@
rpdrs(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxRpdr2X: x y: y in: aGLXWindowId
@@ -5487,8 +5497,6 @@
rpdr2(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxRpdr2iX: x y: y in: aGLXWindowId
@@ -5502,8 +5510,6 @@
rpdr2i(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxRpdr2sX: x y: y in: aGLXWindowId
@@ -5517,8 +5523,6 @@
rpdr2s(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxRpmvX: x y: y z: z in: aGLXWindowId
@@ -5533,8 +5537,6 @@
rpmv(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxRpmviX: x y: y z: z in: aGLXWindowId
@@ -5549,8 +5551,6 @@
rpmvi(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxRpmvsX: x y: y z: z in: aGLXWindowId
@@ -5565,8 +5565,6 @@
rpmvs(c_x, c_y, c_z);
RETURN (true);
%}
-.
- ^ false
!
glxRpmv2X: x y: y in: aGLXWindowId
@@ -5580,8 +5578,6 @@
rpmv2(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxRpmv2iX: x y: y in: aGLXWindowId
@@ -5595,8 +5591,6 @@
rpmv2i(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxRpmv2sX: x y: y in: aGLXWindowId
@@ -5610,8 +5604,6 @@
rpmv2s(c_x, c_y);
RETURN (true);
%}
-.
- ^ false
!
glxSboxX1: x1 y1: y1 x2: x2 y2: y2 in: aGLXWindowId
@@ -5940,17 +5932,6 @@
^ false
!
-glxSinglebufferIn: aGLXWindowId
-
-%{ /* NOCONTEXT */
- SETWIN(aGLXWindowId)
- singlebuffer();
- RETURN (true);
-%}
-.
- ^ false
-!
-
glxSmoothline: mode in: aGLXWindowId
%{ /* NOCONTEXT */
@@ -6214,7 +6195,7 @@
^ false
!
-glxT3s: v in: aGLXWindowId
+glxT3s:v in:aGLXWindowId
%{ /* NOCONTEXT */
#ifdef FULL_GLX
@@ -6230,7 +6211,7 @@
^ false
!
-glxT3i: v in: aGLXWindowId
+glxT3i:v in:aGLXWindowId
%{ /* NOCONTEXT */
#ifdef FULL_GLX
@@ -6246,7 +6227,7 @@
^ false
!
-glxT3f: v in: aGLXWindowId
+glxT3f:v in:aGLXWindowId
%{ /* NOCONTEXT */
#ifdef FULL_GLX
@@ -6262,7 +6243,7 @@
^ false
!
-glxT3d: v in: aGLXWindowId
+glxT3d:v in:aGLXWindowId
%{ /* NOCONTEXT */
#ifdef FULL_GLX
@@ -6342,58 +6323,6 @@
^ false
!
-glxTexDef2dIndex: index nc:nc width:w height:h bits:image np:np props:props in: aGLXWindowId
- "bind a texture"
-
-%{ /* NOCONTEXT */
-#ifdef GLX
- unsigned char *cp;
- const float *fp;
- OBJ cls;
- float fbuff[30];
-
- if (__isByteArray(image)) {
- cp = _ByteArrayInstPtr(image)->ba_element;
- fp = getFloatsFromFloatArrayInto(props, fbuff);
-
- SETWIN(aGLXWindowId)
- texdef2d(_longVal(index), _longVal(nc), _longVal(w), _longVal(h),
- (const unsigned long *)cp, _longVal(np), fp);
- RETURN (true);
- }
-#endif
-%}
-.
- ^ false
-!
-
-glxTevbind: target index: index in: aGLXWindowId
-
-%{ /* NOCONTEXT */
-#ifdef GLX
- SETWIN(aGLXWindowId)
- tevbind(_longVal(target), _longVal(index));
- RETURN (true);
-#endif
-%}
-.
- ^ false
-!
-
-glxTexbind: target index: index in: aGLXWindowId
- "bind a texture"
-
-%{ /* NOCONTEXT */
-#ifdef GLX
- SETWIN(aGLXWindowId)
- texbind(_longVal(target), _longVal(index));
- RETURN (true);
-#endif
-%}
-.
- ^ false
-!
-
glxTextcolor: tcolor in: aGLXWindowId
%{ /* NOCONTEXT */
@@ -6838,7 +6767,7 @@
^ false
! !
-!GLXWorkstation methodsFor:'vertex data transfer '!
+!GLXWorkstation methodsFor:'vertex data transfer'!
glxV2s:v in:aGLXWindowId
"pass a vertex; v must be a vector with 2 shorts; z is taken as 0"
--- a/Image.st Mon Feb 06 01:30:10 1995 +0100
+++ b/Image.st Mon Feb 06 01:38:04 1995 +0100
@@ -28,7 +28,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Image.st,v 1.18 1994-11-28 21:00:57 claus Exp $
+$Header: /cvs/stx/stx/libview/Image.st,v 1.19 1995-02-06 00:37:05 claus Exp $
'!
!Image class methodsFor:'documentation'!
@@ -49,7 +49,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Image.st,v 1.18 1994-11-28 21:00:57 claus Exp $
+$Header: /cvs/stx/stx/libview/Image.st,v 1.19 1995-02-06 00:37:05 claus Exp $
"
!
@@ -138,6 +138,12 @@
"
! !
+!Image class methodsFor:'queries'!
+
+imageDepth
+ self shouldNotImplement
+! !
+
!Image class methodsFor:'misc'!
dither:aSymbol
@@ -280,7 +286,11 @@
!
fromView:aView
- "return an image taken from a view"
+ "return an image taken from a views contents as currently
+ on the screen. The returned image has the same depth and photometric
+ as the Display. Notice, that for invisible or partial covered
+ views, the returned Image is NOT correct. You may want to raise
+ the view before using this method."
|org dev|
@@ -290,39 +300,112 @@
to:(DisplayRootView on:dev) id.
^ self fromScreen:(org extent:aView extent) on:dev
- "Image fromView:(Launcher allInstances first topView)"
- "Image fromView:(SystemBrowser allInstances first topView)"
+ "
+ Image fromView:(Launcher allInstances first topView)
+ Image fromView:(SystemBrowser allInstances first topView)
+ "
! !
!Image class methodsFor:'instance creation'!
+new
+ "create a new image. Redefined to set the photometric to
+ greyScale with black being 0 as default."
+
+ ^ super new photometric:#blackIs0
+!
+
+fromForm:aForm
+ "create & return an Image given a form"
+
+ |cls|
+
+ cls := self.
+ cls == Image ifTrue:[
+ cls := self implementorForDepth:aForm depth
+ ].
+ ^ (cls new) fromForm:aForm.
+
+ "
+ |f|
+
+ f := Form width:16 height:16.
+ f clear.
+ f displayLineFromX:0 y:0 toX:15 y:15.
+ f inspect.
+ (Image fromForm:f) inspect
+ "
+!
+
+fromImage:anImage
+ "create & return an Image given another image. This can be used to
+ convert an image to another depth."
+
+ (self == Image or:[anImage class == self]) ifTrue:[^ anImage].
+ ^ self new fromImage:anImage.
+
+ "
+ |i1 i8|
+
+ i1 := Image fromFile:'bitmaps/SBrowser.xbm'.
+ i8 := Depth8Image fromImage:i1.
+ i8 inspect
+ "
+!
+
+width:w height:h
+ "create a new image, given width, height. Assume a depth of 1."
+
+ |cls|
+
+ cls := self.
+ cls == Image ifTrue:[
+ cls := self implementorForDepth:1
+ ].
+ ^ cls new width:w height:h depth:1
+!
+
width:w height:h depth:d
- "create a new form on the default device"
-
- ^ (self implementorForDepth:d) new width:w height:h depth:d
+ "create a new image, given width, height and depth"
+
+ ^ (self implementorForDepth:d) width:w height:h depth:d
!
width:w height:h fromArray:anArray
- "create a new form on the default device - assume depth of 1"
-
- ^ (self implementorForDepth:1) new width:w height:h depth:1 fromArray:anArray
+ "create a new image, given width, height. Assume a depth of 1 of the
+ receiving class is Image.
+ Data must be a ByteArray containing correctly aligned bits for depth 1
+ (i.e. 8 bits per byte)."
+
+ |cls d|
+
+ cls := self.
+ cls == Image ifTrue:[
+ cls := self implementorForDepth:1.
+ d := 1.
+ ] ifFalse:[
+ d := cls imageDepth
+ ].
+ ^ cls new width:w height:h depth:d fromArray:anArray
"
Image width:8
height:8
- fromArray:#(2r11001100
+ fromArray:#[2r11001100
2r00110011
2r11001100
2r00110011
2r11001100
2r00110011
2r11001100
- 2r00110011).
+ 2r00110011].
"
!
width:w height:h depth:d fromArray:pixelData
- "create a new form on the default device"
+ "create a new image, given width, height, depth and data.
+ Data must be a ByteArray containing correctly aligned bits for the specified
+ depth."
^ (self implementorForDepth:d) new width:w height:h depth:d fromArray:pixelData
@@ -330,28 +413,42 @@
Image width:8
height:8
depth:1
- fromArray:#(2r11001100
+ fromArray:#[2r11001100
2r00110011
2r11001100
2r00110011
2r11001100
2r00110011
2r11001100
- 2r00110011).
+ 2r00110011].
"
"
Image width:8
height:8
depth:2
- fromArray:#(4r1100 4r1100
+ fromArray:#[4r1100 4r1100
4r0011 4r0011
4r1100 4r1100
4r0011 4r0011
4r1100 4r1100
4r0011 4r0011
4r1100 4r1100
- 4r0011 4r0011).
+ 4r0011 4r0011].
+ "
+
+ "
+ Image width:8
+ height:8
+ depth:4
+ fromArray:#[4r0001 4r0001
+ 4r0011 4r0011
+ 4r1100 4r1100
+ 4r0011 4r0011
+ 4r1100 4r1100
+ 4r0011 4r0011
+ 4r1100 4r1100
+ 4r0011 4r0011].
"
! !
@@ -362,27 +459,31 @@
out the file format itself (by the extension and by contents)
and lets the appropriate reader read the file."
- |readerClass image name|
+ |image name nm|
"
before trying each reader, check if file is readable
"
- aFileName asFilename isReadable ifFalse:[
- ('IMAGE: ' , aFileName , ' is not existing or not readable') errorPrintNL.
- ^ nil
+ name := aFileName.
+ name asFilename isReadable ifFalse:[
+ name := 'bitmaps/' , name.
+ name asFilename isReadable ifFalse:[
+ ('IMAGE: ' , aFileName , ' is not existing or not readable') errorPrintNL.
+ ^ nil
+ ].
].
"
get the imageReader class from the files extension
"
- name := aFileName.
+ nm := name.
(name endsWith:'.Z') ifTrue:[
- name := name copyTo:(name size - 2)
+ nm := name copyTo:(name size - 2)
].
FileFormats keysAndValuesDo:[:suffix :readerClass |
- (name endsWith:suffix) ifTrue:[
+ (nm endsWith:suffix) ifTrue:[
readerClass notNil ifTrue:[
- image := readerClass fromFile:aFileName.
+ image := readerClass fromFile:name.
image notNil ifTrue:[^ image].
]
]
@@ -394,8 +495,8 @@
"
FileFormats do:[:readerClass |
readerClass notNil ifTrue:[
- (readerClass isValidImageFile:aFileName) ifTrue:[
- ^ readerClass fromFile:aFileName
+ (readerClass isValidImageFile:name) ifTrue:[
+ ^ readerClass fromFile:name
]
]
].
@@ -404,21 +505,23 @@
'IMAGE: unknown image file format: ' errorPrint. aFileName errorPrintNL.
^ nil
- "Image fromFile:'bitmaps/dano.tiff'"
- "Image fromFile:'bitmaps/test.fax'"
- "Image fromFile:'bitmaps/voice.tiff'"
- "Image fromFile:'voice.tiff'"
-
- "Image fromFile:'../fileIn/bitmaps/claus.gif'"
- "Image fromFile:'../fileIn/bitmaps/garfield.gif'"
-
- "Image fromFile:'../fileIn/bitmaps/founders.im8'"
- "Image fromFile:'../goodies/faces/next.com/steve.face'"
-
- "Image fromFile:'/LocalLibrary/Images/OS2/dos3.ico'"
- "Image fromFile:'bitmaps/globe1.xbm'"
- "Image fromFile:'bitmaps/globe1.xbm.Z'"
- "Image fromFile:'bitmaps/hello_world.icon'"
+ "
+ Image fromFile:'bitmaps/dano.tiff'
+ Image fromFile:'bitmaps/test.fax'
+ Image fromFile:'bitmaps/voice.tiff'
+ Image fromFile:'voice.tiff'
+
+ Image fromFile:'../fileIn/bitmaps/claus.gif'
+ Image fromFile:'../fileIn/bitmaps/garfield.gif'
+
+ Image fromFile:'../fileIn/bitmaps/founders.im8'
+ Image fromFile:'../goodies/faces/next.com/steve.face'
+
+ Image fromFile:'/LocalLibrary/Images/OS2/dos3.ico'
+ Image fromFile:'bitmaps/globe1.xbm'
+ Image fromFile:'bitmaps/globe1.xbm.Z'
+ Image fromFile:'bitmaps/hello_world.icon'
+ "
! !
!Image class methodsFor:'queries'!
@@ -682,7 +785,29 @@
very slow ...
(it is meant to access individual pixels - for example, in a bitmap editor)"
- ^ self subclassResponsibility
+ |pixel maxPixel r g b|
+
+ pixel := self valueAtX:x y:y.
+ photometric == #blackIs0 ifTrue:[
+ maxPixel := (1 bitShift:self bitsPerPixel) - 1.
+ ^ Color grey:(pixel * (100 / maxPixel)).
+ ].
+ photometric == #whiteIs0 ifTrue:[
+ maxPixel := (1 bitShift:self bitsPerPixel) - 1.
+ ^ Color grey:100 - (pixel * (100 / maxPixel)).
+ ].
+ photometric == #palette ifTrue:[
+ ^ colorMap at:(pixel + 1)
+ ].
+ photometric == #rgb ifTrue:[
+ r := (pixel bitShift:16) bitAnd:16rFF.
+ g := (pixel bitShift:8) bitAnd:16rFF.
+ b := pixel bitAnd:16rFF.
+ ^ Color red:r / 255 * 100
+ green:g / 255 * 100
+ blue:b / 255 * 100
+ ].
+ self error:'invalid photometric'
!
at:aPoint put:aColor
@@ -700,11 +825,36 @@
"set the pixel at x/y to aColor.
Pixels start at 0@0 for the upper left pixel, end at
(width-1)@(height-1) for the lower right pixel.
- You should not use this method for image-processing, its
- very slow ...
+ This method checks if the color can be stored in the image.
+ (i.e. if the receiver is a palette image, the color must be present in there).
+ You should not use this method for image-processing, it is very slow ...
(it is meant to access individual pixels - for example, in a bitmap editor)"
- ^ self subclassResponsibility
+ |pixel maxPixel|
+
+ photometric == #whiteIs0 ifTrue:[
+ maxPixel := (1 bitShift:self bitsPerPixel) - 1.
+ pixel := maxPixel - (aColor brightness * maxPixel) rounded.
+ ] ifFalse:[
+ photometric == #blackIs0 ifTrue:[
+ maxPixel := (1 bitShift:self bitsPerPixel) - 1.
+ pixel := (aColor brightness * maxPixel) rounded.
+ ] ifFalse:[
+ photometric ~~ #palette ifTrue:[
+ self error:'format not supported'.
+ ^ nil
+ ].
+ pixel := colorMap indexOf:aColor.
+ pixel == 0 ifTrue:[
+ "
+ the color to be stored is not in the images colormap
+ "
+ self error:'invalid color'
+ ].
+ pixel := pixel - 1
+ ]
+ ].
+ self atX:x y:y putValue:pixel.
!
valueAt:aPoint
@@ -746,7 +896,7 @@
^ self subclassResponsibility
! !
-!Image methodsFor:'enumeration'!
+!Image methodsFor:'enumerating'!
valueAtY:y from:x1 to:x2 do:aBlock
"perform aBlock for each pixelValue from x1 to x2 in row y.
@@ -828,6 +978,15 @@
!Image methodsFor:'queries'!
+brightness
+ "return the brightness of the image.
+ This usually only makes sense for textures and patterns
+ (i.e. to compute shadow & light colors for viewBackgrounds).
+ Notice, that for the above purpose, only a subimage is inspected here"
+
+ ^ (self averageColorIn:(0@0 corner:7@7)) brightness
+!
+
averageColor
"return the average color of the image.
This usually only makes sense for textures and patterns
@@ -889,6 +1048,48 @@
bytesPerRow := bytesPerRow + 1
].
^ bytesPerRow
+!
+
+usedValues
+ "return a collection of color values used in the receiver.
+ Notice, that the interpretation of the pixels depends on the photometric
+ of the image.
+ This is a general and therefore slow implementation; subclasses
+ may want to redefine this method for more performance."
+
+ |set|
+
+ set := IdentitySet new.
+ self valuesFromX:0 y:0 toX:(self width-1) y:(self height-1) do:[:x :y :pixel |
+ set add:pixel
+ ].
+ ^ set
+
+ "
+ (Image fromFile:'bitmaps/garfield.gif') usedValues
+ (Image fromFile:'bitmaps/SBrowser.xbm') usedValues
+ (Image fromFile:'ttt.tiff') usedValues
+ "
+!
+
+usedColors
+ "return a collection of colors used in the receiver."
+
+ |usedValues max|
+
+ usedValues := self usedValues asArray.
+ photometric ~~ #palette ifTrue:[
+ max := (1 bitShift:self depth) - 1.
+ ^ usedValues collect:[:val | (Color grey:(100 * val / max ))]
+ ].
+
+ ^ usedValues collect:[:val | (colorMap at:val+1)]
+
+ "
+ (Image fromFile:'bitmaps/garfield.gif') usedColors
+ (Image fromFile:'bitmaps/SBrowser.xbm') usedColors
+ (Image fromFile:'ttt.tiff') usedColors
+ "
! !
!Image methodsFor:'printing & storing'!
@@ -930,8 +1131,8 @@
h "{ Class: SmallInteger }"
dstIndex "{ Class: SmallInteger }"
srcIndex "{ Class: SmallInteger }"
- inData tmpData usedColors nUsed
- rMap gMap bMap bitsPerPixel bytesPerLine
+ inData tmpData usedPixels mapSize
+ map bitsPerPixel bytesPerLine
info bytesPerLineIn curs cid rootView|
curs := Cursor sourceForm:(Form fromFile:'Camera.xbm')
@@ -1038,25 +1239,20 @@
what we have now are the color numbers - still need the r/g/b values.
find out, which colors are in the picture
"
- usedColors := inData usedValues.
- nUsed := usedColors max + 1.
+ usedPixels := inData usedValues.
+ mapSize := usedPixels max + 1.
"get the palette"
- rMap := Array new:nUsed.
- gMap := Array new:nUsed.
- bMap := Array new:nUsed.
- usedColors do:[:colorIndex |
- |i scale|
+ map := Array new:mapSize.
+ usedPixels do:[:colorIndex |
+ |i|
i := colorIndex + 1.
- scale := 255.0 / 100.0.
aDevice getRGBFrom:colorIndex into:[:r :g :b |
- rMap at:i put:(r * scale) rounded.
- gMap at:i put:(g * scale) rounded.
- bMap at:i put:(b * scale) rounded
+ map at:i put:(Color red:r green:g blue:b)
]
].
- colorMap := Array with:rMap with:gMap with:bMap.
+ colorMap := map.
].
aDevice ungrabPointer.
@@ -1212,6 +1408,105 @@
].
^ form
+!
+
+fromImage:anImage
+ "setup the receiver from another image.
+ Color precision may be lost, if conversion is from a higher depth
+ image. This implementation is a slow fallback (the loop over the
+ source pixels is very slow). If this method is used heavily, you
+ may want to redefine it in concrete subclasses for common source images."
+
+ width := anImage width.
+ height := anImage height.
+ bytes := ByteArray uninitializedNew:(self bytesPerRow * height).
+ bitsPerSample := self bitsPerSample.
+ samplesPerPixel := self samplesPerPixel.
+ samplesPerPixel == 3 ifTrue:[
+ photometric := #rgb
+ ] ifFalse:[
+ photometric := anImage photometric.
+ photometric == #palette ifTrue:[
+ colorMap := anImage colorMap copy.
+ "
+ must compress the colormap, if source image has higher depth
+ than myself.
+ "
+ anImage bitsPerPixel > self bitsPerPixel ifTrue:[
+ "
+ get used colors are extracted into our colorMap
+ (the at-put below will set the pixelValue according the
+ new colorIndex
+ "
+ colorMap := anImage usedColors asArray.
+ colorMap size > (1 bitShift:self bitsPerPixel) ifTrue:[
+ 'IMAGE: possibly too many colors in image' errorPrintNL
+ ]
+ ]
+ ]
+ ].
+ anImage colorsFromX:0 y:0 toX:(width-1) y:(height-1) do:[:x :y :clr |
+ self atX:x y:y put:clr
+ ].
+
+ "
+ |i i2 i4 i8 i24|
+
+ i := Image fromFile:'bitmaps/SBrowser.xbm'.
+ i inspect.
+ i2 := Depth2Image fromImage:i.
+ i2 inspect.
+ i4 := Depth4Image fromImage:i.
+ i4 inspect.
+ i8 := Depth8Image fromImage:i.
+ i8 inspect.
+ i24 := Depth24Image fromImage:i.
+ i24 inspect.
+ "
+!
+
+fromForm:aForm
+ "setup receiver from a form"
+
+ |newImage cls map c0 c1 redMap greenMap blueMap|
+
+ width := aForm width.
+ height := aForm height.
+ bytes := aForm bits.
+ bitsPerSample := self bitsPerSample.
+ samplesPerPixel := self samplesPerPixel.
+ map := aForm colorMap.
+
+ aForm depth == 1 ifTrue:[
+ map isNil ifTrue:[
+ photometric := #whiteIs0
+ ] ifFalse:[
+ c0 := map at:1.
+ c1 := map at:2.
+ ((c0 = Color white)
+ and:[c1 = Color black]) ifTrue:[
+ photometric := #whiteIs0
+ ] ifFalse:[
+ ((c0 = Color black)
+ and:[c1 = Color white]) ifTrue:[
+ photometric := #blackIs0
+ ] ifFalse:[
+ photometric := #palette.
+ colorMap := Array with:c0 with:c1.
+ ]
+ ]
+ ]
+ ] ifFalse:[
+ map notNil ifTrue:[
+ photometric := #palette.
+ colorMap := map copy.
+ ] ifFalse:[
+ "
+ photometric stays at default
+ (which is rgb for d24, greyscale for others)
+ "
+ ]
+ ].
! !
!Image methodsFor:'converting rgb images'!
@@ -1353,6 +1648,26 @@
paletteImageAsPseudoFormOn:aDevice
"return a pseudo-deviceForm from the palette image."
+ |tempImage d temp8|
+
+ d := self depth.
+ (#(1 2 4 8) includes:d) ifTrue:[
+ "
+ fallback code for some depth's:
+ create a temporary Depth8Image and use its conversion method
+ "
+ temp8 := ByteArray uninitializedNew:(width * height).
+
+ bytes expandPixels:d
+ width:width
+ height:height
+ into:temp8
+ mapping:nil.
+
+ tempImage := Image width:width height:height depth:8 fromArray:temp8.
+ tempImage colorMap:colorMap.
+ ^ tempImage paletteImageAsPseudoFormOn:aDevice
+ ].
^ self subclassResponsibility
!
@@ -1653,10 +1968,12 @@
!Image methodsFor:'image manipulations'!
-copyWithColorMapProcessingRed:rBlock green:gBlock blue:bBlock
+copyWithColorMapProcessing:aBlock
"a helper to create & return new images based on the receiver with
- some colorMap processing. The arguments are called
- for each color component and are supposed to return new values."
+ some colorMap processing. The receiver is copied, and the copied images
+ colormap is modified by replacing entries with the result of the processing block,
+ which is called with the original color values. The block is supposed to return
+ a color."
|newImage|
@@ -1670,94 +1987,84 @@
the code below manipulates the colormap.
For non-palette images, special code is required
"
- newImage colorMapProcessingRed:rBlock green:gBlock blue:bBlock.
+ newImage colorMapProcessing:aBlock.
^ newImage
"
leave red component only:
(Image fromFile:'bitmaps/claus.gif')
- copyWithColorMapProcessingRed:[:r | r]
- green:[:g | 0]
- blue:[:b | 0]
+ copyWithColorMapProcessing:[:clr | Color red:(clr red) green:0 blue:0]
"
+
"
make it reddish:
(Image fromFile:'bitmaps/claus.gif')
- copyWithColorMapProcessingRed:[:r | (r * 2) min:255]
- green:[:g | g]
- blue:[:b | b]
+ copyWithColorMapProcessing:[:clr | Color red:((clr red * 2) min:100) green:clr green blue:clr blue]
"
+
"
invert:
(Image fromFile:'bitmaps/claus.gif')
- copyWithColorMapProcessingRed:[:r | 255-r]
- green:[:g | 255-g]
- blue:[:b | 255-b]
+ copyWithColorMapProcessing:[:clr | Color red:(100 - clr red) green:(100 - clr green) blue:(100 - clr green)]
"
+
"
lighter:
(Image fromFile:'bitmaps/claus.gif')
- copyWithColorMapProcessingRed:[:r | r + (255-r//2)]
- green:[:g | g + (255-g//2)]
- blue:[:b | b + (255-b//2)]
+ copyWithColorMapProcessing:[:clr | |r g b|
+ r := clr red. g := clr green. b := clr blue.
+ Color red:(r + (100-r//2))
+ green:(g + (100-g//2))
+ blue:(b + (100-b//2))]
"
+
"
darker:
(Image fromFile:'bitmaps/claus.gif')
- copyWithColorMapProcessingRed:[:r | r//2]
- green:[:g | g//2]
- blue:[:b | b//2]
+ copyWithColorMapProcessing:[:clr | Color red:(clr red//2) green:(clr green // 2) blue:(clr blue // 2)]
"
!
-colorMapProcessingRed:rBlock green:gBlock blue:bBlock
+colorMapProcessing:aBlock
"a helper for all kinds of colormap manipulations.
- The argument blocks are called for each pixel r/g/b and
- are supposed to return new r/g/b values.
+ The argument aBlocks is called for every colormap entry, and the returned value
+ will replace that entry in the map.
This will fail for non-palette images.
- see examples in Image>>copyWithColorMapProcessingRed:green:blue:"
-
- |rMap gMap bMap nColors|
+ see examples in Image>>copyWithColorMapProcessing:"
+
+ |nColors "{ Class: SmallInteger }"|
colorMap isNil ifTrue:[
^ self error:'image has no colormap'
].
- "
- the code below manipulates the colormap.
- For non-palette images, special code is required
- "
- rMap := colorMap at:1.
- gMap := colorMap at:2.
- bMap := colorMap at:3.
- nColors := rMap size.
-
+ nColors := colorMap size.
1 to:nColors do:[:index |
- |red green blue|
-
- red := (rMap at:index).
- green := (gMap at:index).
- blue := (bMap at:index).
-
- rMap at:index put:(rBlock value:red).
- gMap at:index put:(gBlock value:green).
- bMap at:index put:(bBlock value:blue).
+ |clr|
+
+ clr := colorMap at:index.
+ clr notNil ifTrue:[
+ colorMap at:index put:(aBlock value:clr)
+ ]
]
!
lightened
- "return a new image which is slightly darker than the receiver.
+ "return a new image which is slightly brighter than the receiver.
+ The receiver must be a palette image (currently).
Need an argument, which specifies by how much it should be lighter."
^ self
- copyWithColorMapProcessingRed:[:r | r + (255-r//2)]
- green:[:g | g + (255-g//2)]
- blue:[:b | b + (255-b//2)]
+ copyWithColorMapProcessing:[:clr | |r g b|
+ r := clr red. g := clr green. b := clr blue.
+ Color red:(r + (255-r//2))
+ green:(g + (255-g//2))
+ blue:(b + (255-b//2))]
"
(Image fromFile:'bitmaps/claus.gif') inspect
@@ -1769,12 +2076,11 @@
darkened
"return a new image which is slightly darker than the receiver.
+ The receiver must be a palette image (currently).
Need an argument, which specifies by how much it should be darker."
^ self
- copyWithColorMapProcessingRed:[:r | r // 2]
- green:[:g | g // 2]
- blue:[:b | b // 2]
+ copyWithColorMapProcessing:[:clr | Color red:(clr r // 2) green:(clr green // 2) blue:(clr blue // 2)]
"
(Image fromFile:'bitmaps/claus.gif') inspect
@@ -1929,6 +2235,16 @@
"((Image fromFile:'bitmaps/claus.gif') magnifyBy:0.5@0.5)"
!
+magnifyTo:anExtent
+ "return a new image magnified to have the size specified by extent."
+
+ ^ self magnifyBy:(anExtent / self extent)
+
+ "
+ ((Image fromFile:'bitmaps/garfield.gif') magnifyTo:100@100)
+ "
+!
+
flipHorizontal
"inplace horizontal flip"
@@ -2066,9 +2382,34 @@
!Image methodsFor: 'binary storage'!
+storeBinaryDefinitionOn: stream manager: manager
+ "store a binary representation of the receiver on stream.
+ Redefined to not store the device form (which is recreated at
+ load time anyway)"
+
+ |tDevice tDeviceForm tMonoDeviceForm tFullColorDeviceForm|
+
+ tDevice := device.
+ tDeviceForm := deviceForm.
+ tMonoDeviceForm := monoDeviceForm.
+ tFullColorDeviceForm := fullColorDeviceForm.
+
+ device := nil.
+ deviceForm := nil.
+ monoDeviceForm := nil.
+ fullColorDeviceForm := nil.
+
+ super storeBinaryDefinitionOn: stream manager: manager.
+
+ device := tDevice.
+ deviceForm := tDeviceForm.
+ monoDeviceForm := tMonoDeviceForm.
+ fullColorDeviceForm := tFullColorDeviceForm.
+!
+
readBinaryContentsFrom: stream manager: manager
"read a binary representation of an image from stream.
- Redefined to fLush any device data."
+ Redefined to flush any device data."
super readBinaryContentsFrom: stream manager: manager.
device := nil.
--- a/ImageRdr.st Mon Feb 06 01:30:10 1995 +0100
+++ b/ImageRdr.st Mon Feb 06 01:38:04 1995 +0100
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/ImageRdr.st,v 1.11 1994-11-17 14:29:36 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/ImageRdr.st,v 1.12 1995-02-06 00:37:26 claus Exp $
'!
!ImageReader class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/ImageRdr.st,v 1.11 1994-11-17 14:29:36 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/ImageRdr.st,v 1.12 1995-02-06 00:37:26 claus Exp $
"
!
@@ -146,7 +146,7 @@
inStream := FileStream readonlyFileNamed:aFilename.
].
inStream isNil ifTrue:[
- 'open error on: ' print. aFilename errorPrintNewline.
+ 'IMGREADER: open error on: ' errorPrint. aFilename errorPrintNL.
].
^ inStream
! !
@@ -328,7 +328,7 @@
self primitiveFailed
! !
-!ImageReader class primitiveFunctions!
+!ImageReader primitiveFunctions!
%{
--- a/ImageReader.st Mon Feb 06 01:30:10 1995 +0100
+++ b/ImageReader.st Mon Feb 06 01:38:04 1995 +0100
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/ImageReader.st,v 1.11 1994-11-17 14:29:36 claus Exp $
+$Header: /cvs/stx/stx/libview/ImageReader.st,v 1.12 1995-02-06 00:37:26 claus Exp $
'!
!ImageReader class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libview/ImageReader.st,v 1.11 1994-11-17 14:29:36 claus Exp $
+$Header: /cvs/stx/stx/libview/ImageReader.st,v 1.12 1995-02-06 00:37:26 claus Exp $
"
!
@@ -146,7 +146,7 @@
inStream := FileStream readonlyFileNamed:aFilename.
].
inStream isNil ifTrue:[
- 'open error on: ' print. aFilename errorPrintNewline.
+ 'IMGREADER: open error on: ' errorPrint. aFilename errorPrintNL.
].
^ inStream
! !
@@ -328,7 +328,7 @@
self primitiveFailed
! !
-!ImageReader class primitiveFunctions!
+!ImageReader primitiveFunctions!
%{
--- a/KeybdMap.st Mon Feb 06 01:30:10 1995 +0100
+++ b/KeybdMap.st Mon Feb 06 01:38:04 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/KeybdMap.st,v 1.5 1994-10-10 02:32:37 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/KeybdMap.st,v 1.6 1995-02-06 00:37:29 claus Exp $
'!
!KeyboardMap class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/KeybdMap.st,v 1.5 1994-10-10 02:32:37 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/KeybdMap.st,v 1.6 1995-02-06 00:37:29 claus Exp $
"
!
@@ -50,33 +50,67 @@
"
instances of KeyboardMap are used for mapping keystrokes AND sequences
of keystrokes to a function key.
- There is usually only one instance in the system - hold in Display.
- The setup of this map is usually done in the smalltalk.rc or one of the
- display.rc files during startup.
+ There is usually only one instance in the system - held in an instance
+ variable of Display.
+
+ The setup of this map is done in the 'smalltalk.rc' or one of the
+ 'display.rc' files during startup.
+ To add a mapping (for example, to attach the logical function 'DoIt' to
+ the key-combination Cmd-'d'):
+
+ |m|
+
+ m := Display keyboardMap.
+ m bindValue:#DoIt to:#Cmdd.
+
+ Key sequences can also be defined (hey emacs fans ;-) as in:
+
+ |m|
+
+ m := Display keyboardMap.
+ m bindValue:#DoIt to:#Ctrlx followedBy:#Ctrld
+
+ Key prefixes are defined in the DeviceWorkstation>>translateKey: method.
+ Typical prefixes are Cmd (for Alt or Meta), Ctrl etc.
+ 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.
+
+ To remove a mapping, use the same value for both logical and physical key,
+ as in:
+
+ |m|
+
+ m := Display keyboardMap.
+ m bindValue:#Cmdd to:#Cmdd.
"
! !
!KeyboardMap methodsFor:'accessing'!
-bindValue:anObject to:aKey
- self at:aKey put:anObject
+bindValue:logicalKey to:aKey
+ aKey == logicalKey ifTrue:[
+ self removeKey:aKey
+ ] ifFalse:[
+ self at:aKey put:logicalKey
+ ]
!
-bindValue:anObject to:key1 followedBy:key2
+bindValue:logicalKey to:key1 followedBy:key2
|submap|
- submap := self at:key1.
+ submap := self at:key1 ifAbsent:[].
submap isNil ifTrue:[
submap := KeyboardMap new.
self at:key1 put:submap.
].
- submap at:key2 put:anObject
+ submap at:key2 put:logicalKey
!
valueFor:aKey
|where value|
- where := current notNil ifTrue:[current] ifFalse:[self].
+ where := (current notNil ifTrue:[current] ifFalse:[self]).
value := where at:aKey ifAbsent:aKey.
(value isMemberOf:KeyboardMap) ifTrue:[
--- a/KeyboardMap.st Mon Feb 06 01:30:10 1995 +0100
+++ b/KeyboardMap.st Mon Feb 06 01:38:04 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/KeyboardMap.st,v 1.5 1994-10-10 02:32:37 claus Exp $
+$Header: /cvs/stx/stx/libview/KeyboardMap.st,v 1.6 1995-02-06 00:37:29 claus Exp $
'!
!KeyboardMap class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/KeyboardMap.st,v 1.5 1994-10-10 02:32:37 claus Exp $
+$Header: /cvs/stx/stx/libview/KeyboardMap.st,v 1.6 1995-02-06 00:37:29 claus Exp $
"
!
@@ -50,33 +50,67 @@
"
instances of KeyboardMap are used for mapping keystrokes AND sequences
of keystrokes to a function key.
- There is usually only one instance in the system - hold in Display.
- The setup of this map is usually done in the smalltalk.rc or one of the
- display.rc files during startup.
+ There is usually only one instance in the system - held in an instance
+ variable of Display.
+
+ The setup of this map is done in the 'smalltalk.rc' or one of the
+ 'display.rc' files during startup.
+ To add a mapping (for example, to attach the logical function 'DoIt' to
+ the key-combination Cmd-'d'):
+
+ |m|
+
+ m := Display keyboardMap.
+ m bindValue:#DoIt to:#Cmdd.
+
+ Key sequences can also be defined (hey emacs fans ;-) as in:
+
+ |m|
+
+ m := Display keyboardMap.
+ m bindValue:#DoIt to:#Ctrlx followedBy:#Ctrld
+
+ Key prefixes are defined in the DeviceWorkstation>>translateKey: method.
+ Typical prefixes are Cmd (for Alt or Meta), Ctrl etc.
+ 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.
+
+ To remove a mapping, use the same value for both logical and physical key,
+ as in:
+
+ |m|
+
+ m := Display keyboardMap.
+ m bindValue:#Cmdd to:#Cmdd.
"
! !
!KeyboardMap methodsFor:'accessing'!
-bindValue:anObject to:aKey
- self at:aKey put:anObject
+bindValue:logicalKey to:aKey
+ aKey == logicalKey ifTrue:[
+ self removeKey:aKey
+ ] ifFalse:[
+ self at:aKey put:logicalKey
+ ]
!
-bindValue:anObject to:key1 followedBy:key2
+bindValue:logicalKey to:key1 followedBy:key2
|submap|
- submap := self at:key1.
+ submap := self at:key1 ifAbsent:[].
submap isNil ifTrue:[
submap := KeyboardMap new.
self at:key1 put:submap.
].
- submap at:key2 put:anObject
+ submap at:key2 put:logicalKey
!
valueFor:aKey
|where value|
- where := current notNil ifTrue:[current] ifFalse:[self].
+ where := (current notNil ifTrue:[current] ifFalse:[self]).
value := where at:aKey ifAbsent:aKey.
(value isMemberOf:KeyboardMap) ifTrue:[
--- a/ModalBox.st Mon Feb 06 01:30:10 1995 +0100
+++ b/ModalBox.st Mon Feb 06 01:38:04 1995 +0100
@@ -11,7 +11,7 @@
"
StandardSystemView subclass:#ModalBox
- instanceVariableNames:'haveControl shadowView exclusiveKeyboard '
+ instanceVariableNames:'shadowView exclusiveKeyboard '
classVariableNames:'UseTransientViews'
poolDictionaries:''
category:'Views-Basic'
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.15 1994-11-28 21:01:03 claus Exp $
+$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.16 1995-02-06 00:37:31 claus Exp $
'!
!ModalBox class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.15 1994-11-28 21:01:03 claus Exp $
+$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.16 1995-02-06 00:37:31 claus Exp $
"
!
@@ -52,55 +52,113 @@
others, in that they take control over the current topview, until
all processing is done (i.e. the currently active topview and all of
its subviews will not handle user events while the box is active).
+
+ ModalBoxes are either implemented as transient windows
+ (if UseTransientViews := true) or as override redirect views.
+ Some window managers have problems with either; so you may want to
+ change the default setting from your display.rc file.
"
! !
!ModalBox class methodsFor:'initialization'!
initialize
- UseTransientViews := false.
+ UseTransientViews := true.
+! !
+
+!ModalBox class methodsFor:'defaults'!
+
+defaultExtent
+ "this defines the defaultExtent for instances of me;
+ the value returned here is usually not correct for concrete subclasses,
+ so you better redefine this method"
+
+ ^ (Display pixelPerMillimeter * (60 @ 30)) rounded
+!
+
+useTransientViews:aBoolean
+ "change the way modalBoxes are created on the Display.
+ If the argument is true, transient views are used; otherwise
+ override redirect views are used. Depending on your windowmanager,
+ either one may have problems. You may want to change the setting
+ from your display.rc or d_xxx.rc file."
+
+ UseTransientViews := aBoolean.
+
+ "
+ ModalBox useTransient:false
+ ModalBox useTransient:true
+ "
! !
!ModalBox methodsFor:'initialize / release'!
initialize
- |form resizeButton|
+ |form resizeButton moveButton|
super initialize.
- haveControl := false.
exclusiveKeyboard := false.
label := ' '.
+ label := 'Popup'.
+
UseTransientViews ifFalse:[
(StyleSheet at:#popupShadow default:false) ifTrue:[
shadowView := (ShadowView on:device) for:self
- ]
+ ].
+
+ form := Form width:8 height:8
+ fromArray:#[2r00000000
+ 2r00000000
+ 2r00000000
+ 2r00000001
+ 2r00000011
+ 2r00000111
+ 2r00001111
+ 2r00011111
+ ]
+ on:device.
+ resizeButton := Button form:form in:self.
+ resizeButton origin:1.0 @ 1.0 corner:1.0@1.0.
+ resizeButton activeForegroundColor:(resizeButton foregroundColor).
+ resizeButton activeBackgroundColor:(resizeButton backgroundColor).
+ resizeButton enteredBackgroundColor:(resizeButton backgroundColor).
+ resizeButton leftInset:-8; topInset:-8.
+ resizeButton releaseAction:[].
+ resizeButton pressAction:[resizeButton turnOff; redraw. self doResize].
+ resizeButton borderWidth:0.
+ resizeButton onLevel:0; offLevel:0.
+ resizeButton cursor:(Cursor corner).
+
+ form := Form width:8 height:8
+ fromArray:#[2r11111000
+ 2r11110000
+ 2r11100000
+ 2r11000000
+ 2r10000000
+ 2r00000000
+ 2r00000000
+ 2r00000000
+ ]
+ on:device.
+ moveButton := Button form:form in:self.
+ moveButton origin:0.0 @ 0.0 corner:0.0@0.0.
+ moveButton activeForegroundColor:(moveButton foregroundColor).
+ moveButton activeBackgroundColor:(moveButton backgroundColor).
+ moveButton enteredBackgroundColor:(moveButton backgroundColor).
+ moveButton rightInset:-8; bottomInset:-8.
+ moveButton releaseAction:[].
+ moveButton pressAction:[moveButton turnOff; redraw. self doMove].
+ moveButton borderWidth:0.
+ moveButton onLevel:0; offLevel:0.
+ moveButton cursor:(Cursor origin)
].
- form := Form width:8 height:8
- fromArray:#[2r00000000
- 2r00000000
- 2r00000000
- 2r00000001
- 2r00000011
- 2r00000111
- 2r00001111
- 2r00011111
- ]
- on:device.
- resizeButton := Button form:form in:self.
- resizeButton origin:1.0 @ 1.0 corner:1.0@1.0.
- resizeButton activeForegroundColor:(resizeButton foregroundColor).
- resizeButton leftInset:-8; topInset:-8.
- resizeButton releaseAction:[].
- resizeButton pressAction:[resizeButton turnOff; redraw. self doResize].
- resizeButton borderWidth:0.
- resizeButton onLevel:-2; offLevel:0.
- resizeButton cursor:(Cursor corner)
!
initEvents
+ super initEvents.
self enableEvent:#visibilityChange
!
@@ -108,7 +166,9 @@
super initStyle.
((style ~~ #normal) and:[style ~~ #mswindows]) ifTrue:[
borderWidth := 0.
- self level:2
+ UseTransientViews ifFalse:[
+ self level:2
+ ]
]
!
@@ -203,11 +263,13 @@
device grabKeyboardInView:self.
].
- "
- get the focus
- "
- device setInputFocusTo:drawableId.
- self enableEnterLeaveEvents
+"/ UseTransientViews ifFalse:[
+ "
+ get the focus
+ "
+ self getKeyboardFocus.
+ self enableEnterLeaveEvents
+"/ ]
!
fixPosition:aPoint
@@ -275,7 +337,6 @@
].
self raise.
- haveControl := true.
mainGroup notNil ifTrue:[
"
flush pending key & mouse events.
@@ -470,6 +531,7 @@
|p|
shadowView notNil ifTrue:[shadowView unrealize].
+ windowGroup notNil ifTrue:[windowGroup focusView:nil].
self unrealize.
device synchronizeOutput.
@@ -513,7 +575,23 @@
"
! !
-!ModalBox methodsFor:'event handling'!
+!ModalBox methodsFor:'move & resize'!
+
+doMove
+ "the move button was pressed"
+
+ |r|
+
+ r := device rectangleFromUser:(self origin corner:self corner).
+ shadowView notNil ifTrue:[
+ shadowView unrealize
+ ].
+ self origin:r origin extent:(r extent max:(100@100)).
+ shadowView notNil ifTrue:[
+ shadowView realize.
+ self raise
+ ].
+!
doResize
"the resize button was pressed"
@@ -529,6 +607,15 @@
shadowView realize.
self raise
].
+! !
+
+!ModalBox methodsFor:'event handling'!
+
+terminate
+ "this is the close from a windowmanager
+ (only if UseTransientViews == true)"
+
+ self hide
!
visibilityChange:how
@@ -537,7 +624,7 @@
stay on top - but some window managers (fvwm) seem to ignore
this ..."
- "code below is not good, since it will lead to
+ "the code below is not good, since it will lead to
oscillating raises when two modalBoxes are going to cover
each other - see coveredBy:-handling ..."
@@ -581,12 +668,11 @@
!
pointerEnter:state x:x y:y
- "
- mhmh: this seems to be a special X kludge;
+ "mhmh: this seems to be a special X kludge;
without the following, we will not regain input focus after
- pointer is reentered"
+ pointer is reentered."
- device setInputFocusTo:drawableId.
+ self getKeyboardFocus.
super pointerEnter:state x:x y:y
! !
@@ -601,7 +687,6 @@
g restoreCursors
]
].
- haveControl := false.
exclusiveKeyboard ifTrue:[
device ungrabKeyboard
]
--- a/PopUpView.st Mon Feb 06 01:30:10 1995 +0100
+++ b/PopUpView.st Mon Feb 06 01:38:04 1995 +0100
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/PopUpView.st,v 1.9 1994-11-17 14:29:40 claus Exp $
+$Header: /cvs/stx/stx/libview/PopUpView.st,v 1.10 1995-02-06 00:37:38 claus Exp $
'!
!PopUpView class methodsFor:'documentation'!
@@ -43,15 +43,16 @@
version
"
-$Header: /cvs/stx/stx/libview/PopUpView.st,v 1.9 1994-11-17 14:29:40 claus Exp $
+$Header: /cvs/stx/stx/libview/PopUpView.st,v 1.10 1995-02-06 00:37:38 claus Exp $
"
!
documentation
"
this class implements an abstract superclass for all views which bypass the
- window manager and pop up on top of the screen.
- They are usually not decorated by window managers.
+ window manager and pop up on top of the screen. A typical example is
+ a PopUpMenu. PopUpView itself is abstract, providing basic mechanisms.
+ They are not decorated by window managers.
styleSheet parameters:
@@ -74,7 +75,7 @@
DefaultBorderColor := StyleSheet colorAt:'popupBorderColor'.
! !
-!PopUpView methodsFor:'initialization / release'!
+!PopUpView methodsFor:'initialize / release'!
initialize
|center|
@@ -155,6 +156,65 @@
leaveControl
haveControl := false
+!
+
+regainControl
+ device grabPointerInView:self
+! !
+
+!PopUpView methodsFor:'activation'!
+
+show
+ "realize the view at its last position"
+
+ self fixSize.
+ self openModal:[true] "realize "
+!
+
+showAt:aPoint resizing:aBoolean
+ "realize the view at aPoint"
+
+ aBoolean ifTrue:[
+ self fixSize.
+ ].
+ self origin:aPoint.
+ self makeFullyVisible.
+ self openModal:[true] "realize "
+!
+
+showAt:aPoint
+ "realize the view at aPoint"
+
+ self showAt:aPoint resizing:true
+!
+
+showCenteredIn:aView
+ "make myself visible at the screen center."
+
+ |top|
+
+ top := aView topView.
+ top raise.
+ self showAt:(top origin
+ + (aView originRelativeTo:top)
+ + (aView extent // 2)
+ - (self extent // 2))
+!
+
+showAtPointer
+ "realize the view at the current pointer position"
+
+ self showAt:(device pointerPosition) resizing:true
+!
+
+hide
+ "hide the view, leave its modal event loop"
+
+ windowGroup notNil ifTrue:[
+ windowGroup removeView:self.
+ windowGroup := nil.
+ ].
+ self unrealize.
! !
!PopUpView methodsFor:'realize / unrealize'!
--- a/PseudoV.st Mon Feb 06 01:30:10 1995 +0100
+++ b/PseudoV.st Mon Feb 06 01:38:04 1995 +0100
@@ -26,7 +26,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/PseudoV.st,v 1.21 1994-11-22 23:09:18 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/PseudoV.st,v 1.22 1995-02-06 00:37:41 claus Exp $
'!
!PseudoView class methodsFor:'documentation'!
@@ -47,7 +47,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/PseudoV.st,v 1.21 1994-11-22 23:09:18 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/PseudoV.st,v 1.22 1995-02-06 00:37:41 claus Exp $
"
!
@@ -128,9 +128,6 @@
viewBackground := viewBackground on:device
].
super recreate.
-"/ viewBackground isColor ifTrue:[
-"/ viewBackground := viewBackground on:device
-"/ ].
cursor := cursor on:device.
exposePending := false
!
@@ -202,7 +199,10 @@
!
viewBackground:something
- "set the viewBackground to something, a color, image or form"
+ "set the viewBackground to something, a color, image or form.
+ The viewBackground is the color or pattern with which exposed
+ regions are filled - do not confuse this with the drawing background
+ color, which is used with opaque drawing."
viewBackground ~~ something ifTrue:[
viewBackground := something.
@@ -518,6 +518,12 @@
^ false
!
+getKeyboardFocus
+ "tell the Display to assign keyboard focus to the receiver"
+
+ device setInputFocusTo:drawableId.
+!
+
eventMask
"return a (numeric) mask of allowed events -
this is X-specific and will be removed / replaced by symbolic values)"
@@ -607,8 +613,11 @@
self paint:viewBackground.
viewBackground isColor ifFalse:[
-"/ self setMaskOriginX:0 y:0
- self setMaskOriginX:self viewOrigin x negated y:self viewOrigin y negated
+ gcId notNil ifTrue:[
+ device setMaskOriginX:self viewOrigin x rounded negated
+ y:self viewOrigin y rounded negated
+ in:gcId
+ ].
].
"
fill in device coordinates - not logical coordinates
@@ -628,8 +637,11 @@
self paint:viewBackground.
viewBackground isColor ifFalse:[
-"/ self setMaskOriginX:0 y:0
- self setMaskOriginX:self viewOrigin x negated y:self viewOrigin y negated
+ gcId notNil ifTrue:[
+ device setMaskOriginX:self viewOrigin x rounded negated
+ y:self viewOrigin y rounded negated
+ in:gcId
+ ].
].
self fillRectangleX:x y:y width:w height:h.
self paint:oldPaint
@@ -832,12 +844,18 @@
!PseudoView methodsFor:'queries'!
+isView
+ "return true, if the receiver is a view"
+
+ ^ true
+!
+
exposeEventPending
- "return true, if an expose event is pending.
- Dont use it, since it does not honor the windowGroup, but
- goes directly to the device instead.
- Actually, its a historical leftover"
+ "return true, if an expose event is pending."
+ |sensor|
+
+ ((sensor := self sensor) notNil and:[sensor hasDamageFor:self]) ifTrue:[^ true].
^ device eventPending:#expose for:drawableId
!
@@ -861,6 +879,139 @@
^ device eventPending:#buttonRelease for:drawableId
! !
+!PseudoView methodsFor:'selection handling '!
+
+selectionClear
+ "someone else has the selection"
+
+ Smalltalk at:#CopyBuffer put:nil.
+!
+
+getSelection
+ "return the object selection - either the local one, or the displays
+ selection buffer."
+
+ |sel|
+
+ sel := Smalltalk at:#CopyBuffer.
+ sel isNil ifTrue:[
+ sel := device getSelectionFor:drawableId.
+ sel isNil ifTrue:[^ nil].
+ ].
+ ^ sel
+!
+
+getTextSelection
+ "return the text selection - either the local one, or the displays
+ selection buffer."
+
+ |sel|
+
+ sel := Smalltalk at:#CopyBuffer.
+ sel isNil ifTrue:[
+ sel := device getTextSelectionFor:drawableId.
+ sel isNil ifTrue:[^ nil].
+ ].
+ ^ sel
+!
+
+setTextSelection:something
+ "set the text selection - both the local one, and tell the display
+ that we have changed it."
+
+ |s|
+
+ Smalltalk at:#CopyBuffer put:something.
+ s := something.
+ s isString ifFalse:[
+ s := s asStringFrom:1 to:(s size)
+ compressTabs:false
+ withCR:false
+ ].
+ (device setTextSelection:s owner:drawableId) ifFalse:[
+ 'selection failed' errorPrintNL
+ ]
+!
+
+setSelection:something
+ "set the object selection - both the local one, and tell the display
+ that we have changed it."
+
+ |s|
+
+ Smalltalk at:#CopyBuffer put:something.
+ (device setSelection:something owner:drawableId) ifFalse:[
+ 'selection failed' errorPrintNL
+ ]
+!
+
+selectionRequest:propertyID target:targetID selection:selectionID from:windowID
+ "someone asks for our selection"
+
+ |o s stream|
+
+ o := Smalltalk at:#CopyBuffer.
+ targetID == (device atomIDOf:'STRING') ifTrue:[
+ s := o.
+ o isString ifFalse:[
+ o isNil ifTrue:[
+ s := ''
+ ] ifFalse:[
+ (o isMemberOf:Text) ifTrue:[
+ s := o asStringFrom:1 to:(o size)
+ compressTabs:false
+ withCR:false
+ ] ifFalse:[
+ s := o storeString
+ ]
+ ]
+ ].
+ device
+ sendSelection:s
+ property:propertyID
+ target:targetID
+ to:windowID
+ ] ifFalse:[
+ stream := WriteStream on:(ByteArray new:200).
+ o storeBinaryOn:stream.
+ device
+ sendSelection:(stream contents)
+ property:propertyID
+ target:(device atomIDOf:'ST_OBJECT' create:true)
+ to:windowID
+ ]
+!
+
+selectionNotify:propertyID target:targetID selection:selectionID from:windowID
+ "this is sent from the server as a reply to a request for a
+ selection. The view should be prepared to paste the received
+ string (it asked for it so that should not be a problem)"
+
+ |s|
+
+ targetID == (device atomIDOf:'STRING') ifTrue:[
+ "
+ a returned string
+ "
+ s := device getTextProperty:propertyID from:windowID.
+ s notNil ifTrue:[
+ (s endsWith:Character cr) ifTrue:[
+ self paste:(s asText copyWith:'')
+ ] ifFalse:[
+ self paste:s
+ ]
+ ]
+ ] ifFalse:[
+ "
+ a returned object
+ "
+ s := device getObjectProperty:propertyID from:windowID.
+ s notNil ifTrue:[
+ self paste:s
+ ]
+ ]
+! !
+
!PseudoView methodsFor:'event handling'!
catchExpose
@@ -1195,7 +1346,7 @@
readBinaryContentsFrom: stream manager: manager
"tell the newly restored View to recreate itself.
- Bug: restored view seems to loose its position."
+ Bug: restored view seems to loose its position (if its not an StdSysView)."
super readBinaryContentsFrom: stream manager: manager.
--- a/StandardSystemView.st Mon Feb 06 01:30:10 1995 +0100
+++ b/StandardSystemView.st Mon Feb 06 01:38:04 1995 +0100
@@ -13,7 +13,7 @@
View subclass:#StandardSystemView
instanceVariableNames:'label icon iconView iconLabel
minExtent maxExtent'
- classVariableNames: 'DefaultIcon'
+ classVariableNames: 'DefaultIcon TakeFocusWhenMapped'
poolDictionaries:''
category:'Views-Basic'
!
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.14 1994-11-21 16:43:21 claus Exp $
+$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.15 1995-02-06 00:37:53 claus Exp $
'!
!StandardSystemView class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.14 1994-11-21 16:43:21 claus Exp $
+$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.15 1995-02-06 00:37:53 claus Exp $
"
!
@@ -113,7 +113,7 @@
minExtent:minExtent
maxExtent:nil.
newView model:aModel.
- newView controller:(self defaultController new view:newView).
+"/ newView controller:(self defaultController new view:newView).
^ newView
!
@@ -223,10 +223,15 @@
name := self class name.
!
+initEvents
+ super initEvents.
+ self enableFocusEvents.
+!
+
defaultController
"for ST-80 compatibility only - not used in ST/X"
- ^ StandardSystemController
+ ^ nil "/ StandardSystemController
!
addToCurrentProject
@@ -284,13 +289,8 @@
"if I was mapped, do it again"
realized ifTrue:[
"if it was iconified, try to remap iconified"
- shown ifFalse:[
- device mapView:self id:drawableId iconified:true
- atX:left y:top width:width height:height
- ] ifTrue:[
- device mapView:self id:drawableId iconified:false
- atX:left y:top width:width height:height
- ].
+ device mapView:self id:drawableId iconified:(shown not)
+ atX:left y:top width:width height:height.
"and restart the window-group process"
windowGroup notNil ifTrue:[
@@ -336,6 +336,23 @@
'moving view into visible area' errorPrintNewline.
self origin:(device width - dX) @ (device height - dY)
]
+!
+
+realize
+ super realize.
+ windowGroup notNil ifTrue:[
+ windowGroup focusSequence:(self focusSequence)
+ ]
+!
+
+focusSequence
+ "return a sequence which defines the order in which the focus
+ is passed for FocusNext and FocusPrevious keys.
+ All views which like to support these keys should redefine
+ this method and return a collection of (sub-) views"
+
+ ^ nil
+
! !
!StandardSystemView methodsFor:'destroying'!
@@ -653,3 +670,44 @@
]
]
! !
+
+!StandardSystemView methodsFor:'event handling'!
+
+focusOut
+ "the view lost keyboard focus"
+
+ |v|
+
+ windowGroup notNil ifTrue:[
+ (v := windowGroup focusView) notNil ifTrue:[
+ v showNoFocus
+ ]
+ ].
+!
+
+focusIn
+ "the view got the keyboard focus"
+
+ |v|
+
+ windowGroup notNil ifTrue:[
+ (v := windowGroup focusView) notNil ifTrue:[
+ v showFocus
+ ]
+ ].
+!
+
+mapped
+ "the view got mapped"
+
+ super mapped.
+ "
+ ask for the focus - this avoids having to click on the
+ view with WM's which need an explicit click.
+ Q: is this a good idea ?
+ "
+ TakeFocusWhenMapped == true ifTrue:[
+ self getKeyboardFocus.
+ ]
+! !
+
--- a/StdSysV.st Mon Feb 06 01:30:10 1995 +0100
+++ b/StdSysV.st Mon Feb 06 01:38:04 1995 +0100
@@ -13,7 +13,7 @@
View subclass:#StandardSystemView
instanceVariableNames:'label icon iconView iconLabel
minExtent maxExtent'
- classVariableNames: 'DefaultIcon'
+ classVariableNames: 'DefaultIcon TakeFocusWhenMapped'
poolDictionaries:''
category:'Views-Basic'
!
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/StdSysV.st,v 1.14 1994-11-21 16:43:21 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/StdSysV.st,v 1.15 1995-02-06 00:37:53 claus Exp $
'!
!StandardSystemView class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/StdSysV.st,v 1.14 1994-11-21 16:43:21 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/StdSysV.st,v 1.15 1995-02-06 00:37:53 claus Exp $
"
!
@@ -113,7 +113,7 @@
minExtent:minExtent
maxExtent:nil.
newView model:aModel.
- newView controller:(self defaultController new view:newView).
+"/ newView controller:(self defaultController new view:newView).
^ newView
!
@@ -223,10 +223,15 @@
name := self class name.
!
+initEvents
+ super initEvents.
+ self enableFocusEvents.
+!
+
defaultController
"for ST-80 compatibility only - not used in ST/X"
- ^ StandardSystemController
+ ^ nil "/ StandardSystemController
!
addToCurrentProject
@@ -284,13 +289,8 @@
"if I was mapped, do it again"
realized ifTrue:[
"if it was iconified, try to remap iconified"
- shown ifFalse:[
- device mapView:self id:drawableId iconified:true
- atX:left y:top width:width height:height
- ] ifTrue:[
- device mapView:self id:drawableId iconified:false
- atX:left y:top width:width height:height
- ].
+ device mapView:self id:drawableId iconified:(shown not)
+ atX:left y:top width:width height:height.
"and restart the window-group process"
windowGroup notNil ifTrue:[
@@ -336,6 +336,23 @@
'moving view into visible area' errorPrintNewline.
self origin:(device width - dX) @ (device height - dY)
]
+!
+
+realize
+ super realize.
+ windowGroup notNil ifTrue:[
+ windowGroup focusSequence:(self focusSequence)
+ ]
+!
+
+focusSequence
+ "return a sequence which defines the order in which the focus
+ is passed for FocusNext and FocusPrevious keys.
+ All views which like to support these keys should redefine
+ this method and return a collection of (sub-) views"
+
+ ^ nil
+
! !
!StandardSystemView methodsFor:'destroying'!
@@ -653,3 +670,44 @@
]
]
! !
+
+!StandardSystemView methodsFor:'event handling'!
+
+focusOut
+ "the view lost keyboard focus"
+
+ |v|
+
+ windowGroup notNil ifTrue:[
+ (v := windowGroup focusView) notNil ifTrue:[
+ v showNoFocus
+ ]
+ ].
+!
+
+focusIn
+ "the view got the keyboard focus"
+
+ |v|
+
+ windowGroup notNil ifTrue:[
+ (v := windowGroup focusView) notNil ifTrue:[
+ v showFocus
+ ]
+ ].
+!
+
+mapped
+ "the view got mapped"
+
+ super mapped.
+ "
+ ask for the focus - this avoids having to click on the
+ view with WM's which need an explicit click.
+ Q: is this a good idea ?
+ "
+ TakeFocusWhenMapped == true ifTrue:[
+ self getKeyboardFocus.
+ ]
+! !
+
--- a/View.st Mon Feb 06 01:30:10 1995 +0100
+++ b/View.st Mon Feb 06 01:38:04 1995 +0100
@@ -33,7 +33,8 @@
DefaultStyle StyleSheet
DefaultViewBackgroundColor DefaultBorderColor
DefaultLightColor DefaultShadowColor
- DefaultBorderWidth DefaultFont'
+ DefaultBorderWidth DefaultFont
+ DefaultFocusColor DefaultFocusBorderWidth'
poolDictionaries: ''
category:'Views-Basic'
!
@@ -44,7 +45,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/View.st,v 1.25 1994-12-21 19:19:18 claus Exp $
+$Header: /cvs/stx/stx/libview/View.st,v 1.26 1995-02-06 00:38:04 claus Exp $
'!
"this flag controls (globally) how views look - it will vanish"
@@ -69,7 +70,7 @@
version
"
-$Header: /cvs/stx/stx/libview/View.st,v 1.25 1994-12-21 19:19:18 claus Exp $
+$Header: /cvs/stx/stx/libview/View.st,v 1.26 1995-02-06 00:38:04 claus Exp $
"
!
@@ -143,11 +144,10 @@
!View class methodsFor:'initialization'!
initialize
- "Workstation initialize."
-
super initialize.
Form initialize.
Color initialize.
+"/ self updateStyleCache
! !
!View class methodsFor:'defaults'!
@@ -311,6 +311,9 @@
DefaultViewBackgroundColor := StyleSheet colorAt:'viewBackground' default:bgGrey.
DefaultShadowColor := StyleSheet colorAt:'shadowColor'.
DefaultLightColor := StyleSheet colorAt:'lightColor'.
+ DefaultFocusColor := StyleSheet colorAt:'focusColor' default:Color red.
+ DefaultFocusBorderWidth := StyleSheet at:'focusBorderWidth' default:2.
+
DefaultFont := StyleSheet at:'font'.
DefaultFont isNil ifTrue:[
DefaultFont := Font family:'courier' face:'medium' style:'roman' size:12.
@@ -538,7 +541,7 @@
(in this case, it should set all of its style-dependent things, but
leave the state and contents as-is)"
- |ext|
+ |ext controllerClass|
super initialize.
@@ -573,14 +576,18 @@
bitGravity := nil.
viewGravity := nil.
-"
- controller := self defaultController new.
- controller view:self.
-"
+ controllerClass := self defaultController.
+ controllerClass notNil ifTrue:[
+ controller := controllerClass new.
+ controller view:self.
+ model notNil ifTrue:[
+ controller model:model
+ ]
+ ].
!
defaultController
- ^ Controller
+ ^ nil "/ Controller
!
initStyle
@@ -719,8 +726,10 @@
"set the controller"
controller := aController.
- controller view:self.
- controller model:model
+ controller notNil ifTrue:[
+ controller view:self.
+ controller model:model
+ ]
!
model
@@ -766,6 +775,12 @@
changeSymbol := changeMsg
!
+changeSymbol
+ "Return the symbol sent to the model if nonNil when something changes."
+
+ ^ changeSymbol
+!
+
menu:menuMsg
"ST-80 style menus. If a views menuSymbol is nonNil, it
will send it to its model when the middleButton is pressed.
@@ -774,6 +789,12 @@
make sense to define an initial menu."
menuSymbol := menuMsg
+!
+
+menuSymbol
+ "Return the symbol sent to the model to aquire the menu"
+
+ ^ menuSymbol
! !
!View methodsFor:'accessing-dimensions'!
@@ -907,7 +928,7 @@
and float values mean relative-to-superview;
or a block returning a point"
- |w h pixelExtent|
+ |w h pixelExtent e|
extent isBlock ifTrue:[
extentRule := extent.
@@ -919,14 +940,17 @@
] ifFalse:[
w := extent x.
h := extent y.
+ w isNil ifTrue:[w := width].
+ h isNil ifTrue:[h := height].
+ e := w@h.
((w isMemberOf:Float) or:[h isMemberOf:Float]) ifTrue:[
- relativeExtent := extent.
+ relativeExtent := e.
pixelExtent := self extentFromRelativeExtent.
pixelExtent isNil ifTrue:[
extentChanged := true
]
] ifFalse:[
- pixelExtent := extent
+ pixelExtent := e
]
].
pixelExtent notNil ifTrue:[
@@ -940,7 +964,7 @@
and float values mean relative-to-superview;
or a block returning a point"
- |newLeft newTop pixelOrigin|
+ |newLeft newTop pixelOrigin o|
origin isBlock ifTrue:[
originRule := origin.
@@ -950,16 +974,20 @@
originChanged := true
]
] ifFalse:[
+ o := origin.
newLeft := origin x.
newTop := origin y.
+ newLeft isNil ifTrue:[newLeft := left].
+ newTop isNil ifTrue:[newTop := top].
+ o := newLeft @ newTop.
((newLeft isMemberOf:Float) or:[newTop isMemberOf:Float]) ifTrue:[
- relativeOrigin := origin.
+ relativeOrigin := o.
pixelOrigin := self originFromRelativeOrigin.
pixelOrigin isNil ifTrue:[
originChanged := true
]
] ifFalse:[
- pixelOrigin := origin
+ pixelOrigin := o
]
].
pixelOrigin notNil ifTrue:[
@@ -1160,7 +1188,7 @@
and float values mean relative-to-superview;
or a block returning a point"
- |x y pixelCorner|
+ |x y pixelCorner c|
corner isBlock ifTrue:[
cornerRule := corner.
@@ -1172,14 +1200,17 @@
] ifFalse:[
x := corner x.
y := corner y.
+ x isNil ifTrue:[x := self corner x].
+ y isNil ifTrue:[y := self corner y].
+ c := x @ y.
((x isMemberOf:Float) or:[y isMemberOf:Float]) ifTrue:[
- relativeCorner := corner.
+ relativeCorner := c.
pixelCorner := self cornerFromRelativeCorner.
pixelCorner isNil ifTrue:[
extentChanged := true
]
] ifFalse:[
- pixelCorner := corner
+ pixelCorner := c
]
].
@@ -1226,26 +1257,26 @@
viewport:aRectangle
"define my extend in my superviews coordinate-system."
- |relW relH relX relY winW winH|
+"/ |relW relH relX relY winW winH|
viewport := aRectangle.
self dimensionFromViewport
-"
- superView notNil ifTrue:[
- superView window isNil ifTrue:[
- winW := 1.
- winH := 1
- ] ifFalse:[
- winW := superView window width.
- winH := superView window height
- ].
- relW := (aRectangle width / winW) asFloat.
- relH := (aRectangle height / winH) asFloat.
- relX := (aRectangle left / winW) asFloat.
- relY := (aRectangle top / winH) asFloat.
- self origin:(relX @ relY) extent:(relW @ relH)
- ]
-"
+"/
+"/ superView notNil ifTrue:[
+"/ superView window isNil ifTrue:[
+"/ winW := 1.
+"/ winH := 1
+"/ ] ifFalse:[
+"/ winW := superView window width.
+"/ winH := superView window height
+"/ ].
+"/ relW := (aRectangle width / winW) asFloat.
+"/ relH := (aRectangle height / winH) asFloat.
+"/ relX := (aRectangle left / winW) asFloat.
+"/ relY := (aRectangle top / winH) asFloat.
+"/ self origin:(relX @ relY) extent:(relW @ relH)
+"/ ]
+"/
!
window:aRectangle viewport:vRect
@@ -1258,6 +1289,25 @@
]
!
+scale
+ "return the scale factor (as point) of the transformation"
+
+ transformation isNil ifTrue:[^ 1].
+ ^ transformation scale
+!
+
+scale:aPoint
+ "set the scale factor of the transformation"
+
+ transformation isNil ifTrue:[
+ aPoint = 1 ifTrue:[^ self].
+ transformation := WindowingTransformation scale:aPoint translation:0
+ ].
+
+ transformation scale:aPoint.
+ self computeInnerClip
+!
+
transformation
"return the transformation"
@@ -1299,31 +1349,44 @@
which is shown topLeft in the view
(i.e. the origin of the visible part of the contents)."
- ^ viewOrigin
+ transformation isNil ifTrue:[
+ ^ 0@0
+ ].
+ ^ transformation translation negated
!
setViewOrigin:aPoint
"set the viewOrigin - i.e. virtually scroll without redrawing"
- viewOrigin := aPoint
+ |p|
+
+ p := aPoint negated.
+ transformation isNil ifTrue:[
+ transformation := WindowingTransformation scale:1 translation:p
+ ] ifFalse:[
+ transformation translation:p
+ ].
+ clipRect notNil ifTrue:[
+ self setInnerClip.
+ ].
!
xOriginOfContents
- "return the x coordinate of the viewOrigin;
+ "return the x coordinate of the viewOrigin in pixels;
used by scrollBars to compute thumb position within the document."
^ self viewOrigin x
!
yOriginOfContents
- "return the y coordinate of the viewOrigin;
+ "return the y coordinate of the viewOrigin in pixels;
used by scrollBars to compute thumb position within the document."
^ self viewOrigin y
!
heightOfContents
- "return the height of the contents in pixels
+ "return the height of the contents in logical units
- defaults to views visible area here.
This method MUST be redefined in all view classess which are
going to be scrolled AND show data which has different size than
@@ -1332,13 +1395,15 @@
A view showing a bitmap of height 1000 should return 1000.
If not redefined, scrollbars have no way of knowing the actual size
of the contents being shown. This is called by scrollBars to compute
- the relative height of the document vs. the views actual size."
+ the relative height of the document vs. the views actual size.
+ The value returned here must be based on a scale of 1, since users
+ of this will scale as appropriate."
^ self innerHeight
!
widthOfContents
- "return the width of the contents in pixels
+ "return the width of the contents in logical units
- defaults to views visible area here.
This method MUST be redefined in all view classess which are
@@ -1348,7 +1413,9 @@
A view showing a bitmap of width 700 should return 700.
If not redefined, scrollbars have no way of knowing the actual size
of the contents being shown. This is called by scrollBars to compute
- the relative width of the document vs. the views actual size."
+ the relative width of the document vs. the views actual size.
+ The value returned here must be based on a scale of 1, since users
+ of this will scale as appropriate."
^ self innerWidth
! !
@@ -1939,6 +2006,212 @@
self changed:#sizeOfContents
! !
+!View methodsFor:'scrolling-basic'!
+
+scrollDown:nPixels
+ "change origin to scroll down some pixels"
+
+ |count "{ Class:SmallInteger }"
+ m2 "{ Class:SmallInteger }"
+ w "{ Class:SmallInteger }"
+ h "{ Class:SmallInteger }"
+ hCont
+ ih "{ Class:SmallInteger }"
+ orgX orgY|
+
+ hCont := self heightOfContents.
+ transformation isNil ifTrue:[
+ orgY := orgX := 0
+ ] ifFalse:[
+ hCont := (transformation applyScaleY:hCont) rounded.
+ orgY := transformation translation y negated.
+ orgX := transformation translation x negated.
+ ].
+
+ count := nPixels.
+ ih := self innerHeight.
+
+ ((orgY + nPixels + ih) > hCont) ifTrue:[
+ count := hCont - orgY - ih
+ ].
+ (count <= 0) ifTrue:[^ self].
+
+ self originWillChange.
+ self setViewOrigin:(orgX @ (orgY + count)).
+
+ m2 := margin * 2.
+ (count >= ih) ifTrue:[
+ self redrawDeviceX:margin y:margin
+ width:(width - m2)
+ height:(height - m2).
+ ] ifFalse:[
+ h := height - m2 - count.
+ w := self width.
+ self catchExpose.
+ self copyFrom:self x:margin y:(count + margin)
+ toX:margin y:margin
+ width:w
+ height:h.
+
+ self setInnerClip.
+ self redrawDeviceX:margin y:(h + margin)
+ width:(width - m2) height:count.
+
+ self waitForExpose.
+ ].
+ self originChanged:(0 @ count).
+!
+
+scrollUp:nPixels
+ "change origin to scroll up (towards the origin) by some pixels"
+
+ |count "{ Class:SmallInteger }"
+ m2 "{ Class:SmallInteger }"
+ w "{ Class:SmallInteger }"
+ h "{ Class:SmallInteger }"
+ orgX
+ orgY "{ Class:SmallInteger }"|
+
+ transformation isNil ifTrue:[
+ orgY := orgX := 0
+ ] ifFalse:[
+ orgY := transformation translation y negated.
+ orgX := transformation translation x negated
+ ].
+
+ count := nPixels.
+ (count > orgY) ifTrue:[
+ count := orgY
+ ].
+ (count <= 0) ifTrue:[^ self].
+
+ self originWillChange.
+ self setViewOrigin:(orgX @ (orgY - count)).
+
+ m2 := margin * 2. "top & bottom margins"
+ (count >= self innerHeight) ifTrue:[
+ self redrawDeviceX:margin y:margin
+ width:(width - m2)
+ height:(height - m2).
+ ] ifFalse:[
+ h := height - m2 - count.
+ w := width.
+ self catchExpose.
+ self copyFrom:self x:margin y:margin
+ toX:margin y:(count + margin)
+ width:w height:h.
+
+ self setInnerClip.
+ self redrawDeviceX:margin y:margin
+ width:(width - m2)
+ height:count.
+
+ self waitForExpose.
+ ].
+ self originChanged:(0 @ count negated).
+!
+
+scrollLeft:nPixels
+ "change origin to scroll left some pixels"
+
+ |count "{ Class:SmallInteger }"
+ m2 "{ Class:SmallInteger }"
+ h "{ Class:SmallInteger }"
+ orgX orgY|
+
+ transformation isNil ifTrue:[
+ orgY := orgX := 0
+ ] ifFalse:[
+ orgY := transformation translation y negated.
+ orgX := transformation translation x negated.
+ ].
+
+ count := nPixels.
+ (count > orgX) ifTrue:[
+ count := orgX
+ ].
+ (count <= 0) ifTrue:[^ self].
+
+ self originWillChange.
+ self setViewOrigin:(orgX - count) @ orgY.
+
+ m2 := margin * 2.
+ (count >= self innerWidth) ifTrue:[
+ self redrawDeviceX:margin y:margin
+ width:(width - m2)
+ height:(height - m2).
+ ] ifFalse:[
+ h := (height - m2).
+
+ self catchExpose.
+ self copyFrom:self x:margin y:margin
+ toX:(count + margin) y:margin
+ width:(width - m2 - count)
+ height:h.
+
+ self setInnerClip.
+ self redrawDeviceX:margin y:margin
+ width:count height:(height - m2).
+
+ self waitForExpose.
+ ].
+ self originChanged:(count negated @ 0).
+!
+
+scrollRight:nPixels
+ "change origin to scroll right some pixels"
+
+ |count "{ Class:SmallInteger }"
+ m2 "{ Class:SmallInteger }"
+ h "{ Class:SmallInteger }"
+ wCont
+ iw "{ Class:SmallInteger }"
+ orgX orgY|
+
+ wCont := self widthOfContents.
+ transformation isNil ifTrue:[
+ orgY := orgX := 0
+ ] ifFalse:[
+ wCont := (transformation applyScaleX:wCont) rounded.
+ orgY := transformation translation y negated.
+ orgX := transformation translation x negated.
+ ].
+
+ count := nPixels.
+ iw := self innerWidth.
+
+ ((orgX + nPixels + iw) > wCont) ifTrue:[
+ count := wCont - orgX - iw
+ ].
+ (count <= 0) ifTrue:[^ self].
+
+ self originWillChange.
+ self setViewOrigin:(orgX + count) @ orgY.
+
+ m2 := margin * 2.
+ (count >= iw) ifTrue:[
+ self redrawDeviceX:margin y:margin
+ width:(width - m2)
+ height:(height - m2).
+ ] ifFalse:[
+ m2 := margin * 2.
+ h := (height - m2).
+
+ self catchExpose.
+ self copyFrom:self x:(count + margin) y:margin
+ toX:margin y:margin
+ width:(width - m2 - count)
+ height:h.
+
+ self setInnerClip.
+ self redrawDeviceX:(width - margin - count) y:margin
+ width:count height:(height - m2).
+
+ self waitForExpose.
+ ].
+ self originChanged:(count @ 0).
+! !
+
!View methodsFor:'scrolling'!
widthForScrollBetween:yStart and:yEnd
@@ -1969,8 +2242,14 @@
scrollVerticalToPercent:percent
"scroll to a position given in percent of total"
+ |hCont|
+
+ hCont := self heightOfContents.
+ transformation notNil ifTrue:[
+ hCont := transformation applyScaleY:hCont.
+ ].
self scrollVerticalTo:
- ((((self heightOfContents * percent) / 100.0) + 0.5) asInteger)
+ ((((hCont * percent) / 100.0) + 0.5) asInteger)
!
scrollVerticalTo:aPixelOffset
@@ -1992,8 +2271,14 @@
scrollHorizontalToPercent:percent
"scroll to a position given in percent of total"
+ |wCont|
+
+ wCont := self widthOfContents.
+ transformation notNil ifTrue:[
+ wCont := transformation applyScaleX:wCont.
+ ].
self scrollHorizontalTo:
- ((((self widthOfContents * percent) / 100.0) + 0.5) asInteger)
+ ((((wCont * percent) / 100.0) + 0.5) asInteger)
!
scrollHorizontalTo:aPixelOffset
@@ -2031,50 +2316,6 @@
self scrollHorizontalTo:0
!
-scrollUp:nPixels
- "change origin to scroll up (towards the origin) by some pixels"
-
- |count "{ Class:SmallInteger }"
- m2 "{ Class:SmallInteger }"
- w "{ Class:SmallInteger }"
- h "{ Class:SmallInteger }"
- viewOrigin
- orgY "{ Class:SmallInteger }"|
-
- viewOrigin := self viewOrigin.
- orgY := viewOrigin y.
-
- count := nPixels.
- (count > orgY) ifTrue:[
- count := orgY
- ].
- (count <= 0) ifTrue:[^ self].
-
- self originWillChange.
- self setViewOrigin:(viewOrigin x @ (orgY - count)).
-
- (count >= self innerHeight) ifTrue:[
- self redraw.
- ] ifFalse:[
- m2 := margin * 2. "top & bottom margins"
- h := height - m2 - count.
- w := self widthForScrollBetween:orgY and:(orgY + h).
- w := w min:(width - m2).
-
- self catchExpose.
- self copyFrom:self x:margin y:margin
- toX:margin y:(count + margin)
- width:w height:h.
-
- self redrawDeviceX:margin y:margin
- width:(width - m2)
- height:count.
-
- self waitForExpose.
- ].
- self originChanged:(0 @ count negated).
-!
-
scrollUp
"scroll up by some amount; this is called when the scrollbars
scroll-step up button is pressed."
@@ -2082,55 +2323,6 @@
self scrollUp:(self verticalScrollStep)
!
-scrollDown:nPixels
- "change origin to scroll down some pixels"
-
- |count "{ Class:SmallInteger }"
- m2 "{ Class:SmallInteger }"
- w "{ Class:SmallInteger }"
- h "{ Class:SmallInteger }"
- hCont "{ Class:SmallInteger }"
- ih "{ Class:SmallInteger }"
- viewOrigin orgY|
-
- viewOrigin := self viewOrigin.
- orgY := viewOrigin y.
-
- count := nPixels.
- hCont := self heightOfContents.
- ih := self innerHeight.
-
- ((orgY + nPixels + ih) > hCont) ifTrue:[
- count := hCont - orgY - ih
- ].
- (count <= 0) ifTrue:[^ self].
-
- self originWillChange.
- viewOrigin := viewOrigin x @ (orgY + count).
- self setViewOrigin:viewOrigin.
-
- (count >= ih) ifTrue:[
- self redraw.
- ] ifFalse:[
- m2 := margin * 2.
- h := height - m2 - count.
- w := self widthForScrollBetween:orgY and:(orgY + h).
- w := w min:(width - m2).
-
- self catchExpose.
- self copyFrom:self x:margin y:(count + margin)
- toX:margin y:margin
- width:w
- height:h.
-
- self redrawDeviceX:margin y:(h + margin)
- width:(width - m2) height:count.
-
- self waitForExpose.
- ].
- self originChanged:(0 @ count).
-!
-
scrollDown
"scroll down by some amount; this is called when the scrollbars
scroll-step down button is pressed."
@@ -2138,47 +2330,6 @@
self scrollDown:(self verticalScrollStep)
!
-scrollLeft:nPixels
- "change origin to scroll left some pixels"
-
- |count "{ Class:SmallInteger }"
- m2 "{ Class:SmallInteger }"
- h "{ Class:SmallInteger }"
- viewOrigin orgX|
-
- viewOrigin := self viewOrigin.
- orgX := viewOrigin x.
-
- count := nPixels.
- (count > orgX) ifTrue:[
- count := orgX
- ].
- (count <= 0) ifTrue:[^ self].
-
- self originWillChange.
- viewOrigin := (orgX - count) @ viewOrigin y.
- self setViewOrigin:viewOrigin.
-
- (count >= self innerWidth) ifTrue:[
- self redraw.
- ] ifFalse:[
- m2 := margin * 2.
- h := (height - m2).
-
- self catchExpose.
- self copyFrom:self x:margin y:margin
- toX:(count + margin) y:margin
- width:(width - m2 - count)
- height:h.
-
- self redrawDeviceX:margin y:margin
- width:count height:(height - m2).
-
- self waitForExpose.
- ].
- self originChanged:(count negated @ 0).
-!
-
scrollLeft
"scroll left by some amount; this is called when the scrollbars
scroll-step left button is pressed."
@@ -2186,52 +2337,6 @@
self scrollLeft:(self horizontalScrollStep)
!
-scrollRight:nPixels
- "change origin to scroll right some pixels"
-
- |count "{ Class:SmallInteger }"
- m2 "{ Class:SmallInteger }"
- h "{ Class:SmallInteger }"
- wCont "{ Class:SmallInteger }"
- iw "{ Class:SmallInteger }"
- viewOrigin orgX|
-
- viewOrigin := self viewOrigin.
- orgX := viewOrigin x.
-
- count := nPixels.
- wCont := self widthOfContents.
- iw := self innerWidth.
-
- ((orgX + nPixels + iw) > wCont) ifTrue:[
- count := wCont - orgX - iw
- ].
- (count <= 0) ifTrue:[^ self].
-
- self originWillChange.
- viewOrigin := (orgX + count) @ viewOrigin y.
- self setViewOrigin:viewOrigin.
-
- (count >= iw) ifTrue:[
- self redraw.
- ] ifFalse:[
- m2 := margin * 2.
- h := (height - m2).
-
- self catchExpose.
- self copyFrom:self x:(count + margin) y:margin
- toX:margin y:margin
- width:(width - m2 - count)
- height:h.
-
- self redrawDeviceX:(width - margin - count) y:margin
- width:count height:(height - m2).
-
- self waitForExpose.
- ].
- self originChanged:(count @ 0).
-!
-
scrollRight
"scroll right by some amount; this is called when the scrollbars
scroll-step right button is pressed."
@@ -2824,8 +2929,11 @@
!
fixSize
- "adjust size of window according to either relative/abs or
- block extent; also set origin"
+ "This is called right before the view is made visible.
+ Adjust the size of the view according to either relative/abs or
+ block extent; also set origin. Also, subclasses may redefine this
+ method to adjust the size based on some extent (for example, PopUpMenus
+ do so to take care of changed number of menu entries)."
window notNil ifTrue:[
^ self superViewChangedSize
@@ -2908,8 +3016,6 @@
realizeInGroup
"special realize - leave windowgroup as is; for special applications"
- |superGroup groupChange|
-
drawableId isNil ifTrue:[
self create.
].
@@ -2970,9 +3076,13 @@
].
model notNil ifTrue:[
- model removeDependent:self
+ model removeDependent:self.
+ model := nil.
].
- controller := nil.
+ controller notNil ifTrue:[
+ controller release.
+ controller := nil.
+ ].
subs := subViews.
subs notNil ifTrue:[
@@ -3043,16 +3153,20 @@
!
openModal:aBlock
- "create a new windowgroup, but start processing in the current process
+ "create a new windowgroup, but start processing in the current process -
actually suspending event processing for the currently active group.
Stay in this modal loop while aBlock evaluates to true AND the receiver is
visible.
This makes any interaction with the current window impossible -
- however, other views (in their groups) still work."
+ however, other views (in other windowgroups) still work."
+
+ |activeGroup tops|
Processor activeProcessIsSystemProcess ifTrue:[
self realize
] ifFalse:[
+ activeGroup := WindowGroup activeGroup.
+
"
create a new window group and put myself into it
"
@@ -3066,8 +3180,23 @@
self hide.
ex return.
] do:[
- windowGroup startupModal:[realized and:aBlock]
+ [
+ windowGroup startupModal:[realized and:aBlock]
+ ] valueOnUnwindDo:[
+ self hide.
+ ]
].
+ "
+ return input focus to previously active groups top.
+ This helps with windowmanagers which need an explicit click
+ on the view for the focus.
+ "
+ activeGroup notNil ifTrue:[
+ tops := activeGroup topViews.
+ (tops notNil and:[tops notEmpty]) ifTrue:[
+ tops first getKeyboardFocus
+ ]
+ ]
]
!
@@ -3241,7 +3370,7 @@
!
drawLeftEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle
- |leftFg leftHalfFg paint
+ |leftFg leftHalfFg paint b
count "{ Class: SmallInteger }" |
count := level.
@@ -3259,21 +3388,22 @@
leftHalfFg := leftFg
].
- super lineWidth:0.
((edgeStyle == #soft) and:[level > 0]) ifTrue:[
paint := leftHalfFg
] ifFalse:[
paint := leftFg
].
-
super paint:paint.
+ super lineWidth:0.
+
+ b := height - 1.
0 to:(count - 1) do:[:i |
- super displayDeviceLineFromX:i y:i toX:i y:(height - 1 - i)
+ super displayDeviceLineFromX:i y:i toX:i y:(b - i)
].
((edgeStyle == #soft) and:[level > 2]) ifTrue:[
super paint:Black.
- super displayDeviceLineFromX:0 y:0 toX:0 y:height-1.
+ super displayDeviceLineFromX:0 y:0 toX:0 y:b.
]
!
@@ -3291,7 +3421,7 @@
drawRightEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle
|rightFg
count "{ Class: SmallInteger }"
- r|
+ r b|
count := level.
count == 0 ifTrue:[^ self].
@@ -3306,16 +3436,18 @@
rightFg := shadowColor
].
].
-
+ super paint:rightFg.
super lineWidth:0.
- super paint:rightFg.
+
+ b := height - 1.
0 to:(count - 1) do:[:i |
r := width - 1 - i.
- super displayDeviceLineFromX:r y:i toX:r y:(height - 1 - i)
+ super displayDeviceLineFromX:r y:i toX:r y:(b - i)
].
((edgeStyle == #soft) and:[level > 1]) ifTrue:[
+ r := width - 1.
super paint:shadowColor.
- super displayDeviceLineFromX:width-1 y:1 toX:width-1 y:height-1.
+ super displayDeviceLineFromX:r y:1 toX:r y:b.
]
!
@@ -3331,7 +3463,7 @@
!
drawTopEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle
- |topFg topHalfFg
+ |topFg topHalfFg paint r
count "{ Class: SmallInteger }" |
count := level.
@@ -3349,18 +3481,21 @@
topHalfFg := topFg
].
- super lineWidth:0.
((edgeStyle == #soft) and:[level > 0]) ifTrue:[
- super paint:topHalfFg
+ paint := topHalfFg
] ifFalse:[
- super paint:topFg
+ paint := topFg
].
+ super paint:paint.
+ super lineWidth:0.
+
+ r := width - 1.
0 to:(count - 1) do:[:i |
- super displayDeviceLineFromX:i y:i toX:(width - 1 - i) y:i
+ super displayDeviceLineFromX:i y:i toX:(r - i) y:i
].
((edgeStyle == #soft) and:[level > 2]) ifTrue:[
super paint:Black.
- super displayDeviceLineFromX:0 y:0 toX:width-1 y:0.
+ super displayDeviceLineFromX:0 y:0 toX:r y:0.
]
!
@@ -3378,7 +3513,7 @@
drawBottomEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle
|botFg
count "{ Class: SmallInteger }"
- b|
+ b r|
count := level.
count == 0 ifTrue:[^ self].
@@ -3393,16 +3528,19 @@
botFg := shadowColor
].
].
-
+ super paint:botFg.
super lineWidth:0.
- super paint:botFg.
+
+ r := width - 1.
0 to:(count - 1) do:[:i |
b := height - 1 - i.
- super displayDeviceLineFromX:i y:b toX:(width "- 1" - i) y:b
+ super displayDeviceLineFromX:i y:b toX:(r - i) y:b
].
+
((edgeStyle == #soft) and:[level > 1]) ifTrue:[
+ b := height - 1.
super paint:shadowColor.
- super displayDeviceLineFromX:1 y:height-1 toX:width-1 y:height-1.
+ super displayDeviceLineFromX:1 y:b toX:r y:b.
]
!
@@ -3483,6 +3621,36 @@
lh := transformation applyInverseScaleY:lh.
].
self redrawX:lx y:ly width:lw height:lh
+!
+
+showFocus
+ "highlight myself somehow to tell user that I have the focus"
+
+ |delta|
+
+ drawableId notNil ifTrue:[
+ delta := DefaultFocusBorderWidth - borderWidth.
+ delta ~~ 0 ifTrue:[
+ device moveWindow:drawableId x:left-delta y:top-delta
+ ].
+ device setWindowBorderWidth:DefaultFocusBorderWidth in:drawableId.
+ device setWindowBorderColor:(DefaultFocusColor on:device) colorId in:drawableId.
+ ]
+!
+
+showNoFocus
+ "undo the effect of showFocus"
+
+ |delta|
+
+ drawableId notNil ifTrue:[
+ delta := DefaultFocusBorderWidth - borderWidth.
+ delta ~~ 0 ifTrue:[
+ device moveWindow:drawableId x:left+delta y:top+delta
+ ].
+ device setWindowBorderWidth:borderWidth in:drawableId.
+ self setBorderColor.
+ ]
! !
!View methodsFor:'event handling'!
@@ -3793,11 +3961,23 @@
^ self
!
+focusIn
+ "got keyboard focus"
+
+ self showFocus
+!
+
+focusOut
+ "lost keyboard focus"
+
+ self showNoFocus
+!
+
exposeX:x y:y width:w height:h
"a low level redraw event from device
- let subclass handle the redraw and take care of edges here"
- |leftEdge topEdge rightEdge botEdge anyEdge nx ny nw nh|
+ |leftEdge topEdge rightEdge botEdge anyEdge nx ny nw nh old|
nw := w.
nh := h.
@@ -3807,7 +3987,7 @@
anyEdge := false.
"
- check if there is a need to draw an edge
+ check if there is a need to draw an edge (i.e. if margin is hit)
"
(margin ~~ 0) ifTrue:[
leftEdge := false.
@@ -3823,13 +4003,19 @@
nw := transformation applyScaleX:nw.
nh := transformation applyScaleY:nh.
].
+ "
+ adjust expose rectangle, to exclude the margin.
+ Care for rounding errors ...
+ "
(nx isMemberOf:SmallInteger) ifFalse:[
- nw := nw + (nx - nx truncated).
+ old := nx.
nx := nx truncated.
+ nw := nw + (nx - old).
].
(ny isMemberOf:SmallInteger) ifFalse:[
- nh := nh + (ny - ny truncated).
+ old := ny.
ny := ny truncated.
+ nh := nh + (ny - old).
].
(nw isMemberOf:SmallInteger) ifFalse:[
nw := nw truncated + 1
@@ -3837,21 +4023,23 @@
(nh isMemberOf:SmallInteger) ifFalse:[
nh := nh truncated + 1
].
- (x < margin) ifTrue:[
+ (nx < margin) ifTrue:[
+ old := nx.
nx := margin.
- nw := nw - (nx - x).
+ nw := nw - (nx - old).
leftEdge := anyEdge := true.
].
- ((x + w - 1) >= (width - margin)) ifTrue:[
+ ((nx + nw - 1) >= (width - margin)) ifTrue:[
nw := (width - margin - nx).
rightEdge := anyEdge := true.
].
- (y < margin) ifTrue:[
+ (ny < margin) ifTrue:[
+ old := ny.
ny := margin.
- nh := nh - (ny - y).
+ nh := nh - (ny - old).
topEdge := anyEdge := true.
].
- ((y + h - 1) >= (height - margin)) ifTrue:[
+ ((ny + nh - 1) >= (height - margin)) ifTrue:[
nh := (height - margin - ny).
botEdge := anyEdge := true.
].
@@ -3866,12 +4054,14 @@
].
].
- "redraw inside area"
-
+ "
+ redraw inside area
+ "
self redrawX:nx y:ny width:nw height:nh.
- "redraw edge(s)"
-
+ "
+ redraw edge(s)
+ "
anyEdge ifTrue:[
self clipRect:nil.
(topEdge and:[leftEdge and:[botEdge and:[rightEdge]]]) ifTrue:[
--- a/WEvent.st Mon Feb 06 01:30:10 1995 +0100
+++ b/WEvent.st Mon Feb 06 01:38:04 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/WEvent.st,v 1.10 1994-11-22 14:32:22 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/WEvent.st,v 1.11 1995-02-06 00:38:02 claus Exp $
'!
!WindowEvent class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/WEvent.st,v 1.10 1994-11-22 14:32:22 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/WEvent.st,v 1.11 1995-02-06 00:38:02 claus Exp $
"
!
@@ -84,7 +84,23 @@
isKeyEvent
"return true, if this event is a keyboard event"
- ^ (type == #keyPress:x:y) or:[type == #keyRelease:x:y]
+ ^ (type == #keyPress:x:y:) or:[type == #keyRelease:x:y:]
+!
+
+isKeyPressEvent
+ "return true, if this event is a keyboard event"
+
+ ^ (type == #keyPress:x:y:)
+!
+
+isButtonEvent
+ "return true, if this event is a button event"
+
+ ^ (type == #buttonPress:x:y:)
+ or:[type == #buttonRelease:x:y:
+ or:[type == #'buttonShiftPress:x:y:'
+ or:[type == #'buttonMultiPress:x:y:'
+ or:[type == #'buttonMotion:x:y:']]]]
!
isDamage
@@ -129,18 +145,42 @@
"return the damage rectangle"
^ arguments "consider this a kludge"
+!
+
+key
+ "return the key of the key-event. For non key-events, nil is returned."
+
+ ((type == #keyPress:x:y:)
+ or:[type == #keyRelease:x:y:]) ifTrue:[
+ ^ arguments at:1
+ ].
+ ^ nil
! !
!WindowEvent methodsFor:'sending'!
sendEvent
"forward the event represented by the receiver to the delegate,
- the controller or the view.
+ the controller or the view. Only messages which are understood by
+ the delegate are forwarded.
Delegated messages get the original view as an extra argument."
+ self sendEventWithFocusOn:nil
+!
+
+sendEventWithFocusOn:focusView
+ "forward the event represented by the receiver to the delegate,
+ the controller or the view. If focusView is nonNil, and its a keyboard
+ event, the event is forwarded to it (but not if there is a delegate).
+ If there is a delegate, only messages which are understood by it are
+ forwarded. Delegated messages get the original view as an extra argument.
+ Delegation has higher priority than both controller or focusView
+ forwarding."
+
|delegate selector eventReceiver controller|
selector := type.
+
delegate := view delegate.
delegate notNil ifTrue:[
"
@@ -153,61 +193,117 @@
] ifFalse:[
selector := (selector , 'View:') asSymbol.
].
- arguments isNil ifTrue:[
- delegate perform:selector with:view
- ] ifFalse:[
- delegate perform:selector withArguments:(arguments copyWith:view)
+ (delegate respondsTo:selector) ifTrue:[
+ "
+ mhmh have to convert to logical coordinates ...
+ "
+ view transformation notNil ifTrue:[
+ (#(
+ #'buttonPress:x:y:'
+ #'buttonRelease:x:y:'
+ #'buttonShiftPress:x:y:'
+ #'buttonMultiPress:x:y:'
+ #'buttonMotion:x:y:'
+ #'keyPress:x:y:'
+ #'keyRelease:x:y:'
+ #'pointerEnter:x:y:'
+ #'exposeX:y:width:height:'
+ #'graphicExposeX:y:width:height:'
+ )includes:type) ifTrue:[
+ arguments at:2 put:(view transformation applyInverseToX:(arguments at:2)).
+ arguments at:3 put:(view transformation applyInverseToY:(arguments at:3)).
+ (#(
+ #'exposeX:y:width:height:'
+ #'graphicExposeX:y:width:height:'
+ )includes:type) ifTrue:[
+ arguments at:4 put:(view transformation applyInverseScaleX:(arguments at:4)).
+ arguments at:5 put:(view transformation applyInverseScaleY:(arguments at:5)).
+ ].
+ ].
+ ].
+ arguments isNil ifTrue:[
+ delegate perform:selector with:view
+ ] ifFalse:[
+ delegate perform:selector withArguments:(arguments copyWith:view)
+ ].
+ ^ self
+ ].
+ selector := type.
+ ].
+
+ "
+ if there is a controller, that one gets all user events
+ "
+ eventReceiver := view.
+ (controller := view controller) notNil ifTrue:[
+ (#(
+ #'buttonPress:x:y:'
+ #'buttonRelease:x:y:'
+ #'buttonShiftPress:x:y:'
+ #'buttonMultiPress:x:y:'
+ #'buttonMotion:x:y:'
+ #'keyPress:x:y:'
+ #'keyRelease:x:y:'
+ #'focusIn'
+ #'focusOut'
+ #'pointerEnter:x:y:'
+ #'pointerLeave:'
+ ) includes:selector) ifTrue:[
+ eventReceiver := controller.
]
- ] ifFalse:[
- "
- another one:
- if the view has a transformation, edit the selector
- from #foo to #deviceFoo...
- This allows the view to handle the event either in device or
- logical coordinates. (since the deviceFoo-messages default implementation
- in PseudoView translates and resends).
- Actually, I could always send deviceXXX without speed penalty
- (event sending is no high frequency operation), but that just adds
- another context to any debuggers walkback, making things less clear.
- "
- eventReceiver := view.
- (controller := view controller) notNil ifTrue:[
- (#(
- #'buttonPress:x:y:'
- #'buttonRelease:x:y:'
- #'buttonShiftPress:x:y:'
- #'buttonMultiPress:x:y:'
- #'buttonMotion:x:y:'
- #'keyPress:x:y:'
- #'keyRelease:x:y:'
- #'exposeX:y:width:height:'
- #'graphicExposeX:y:width:height:'
- #'pointerEnter:x:y:'
- ) includes:selector) ifTrue:[
+ ].
+
+ "
+ if there is a focusView, and its a keyboard event, pass it
+ to that view (or its controller). In this case, some coordinate which is outside of
+ the focusView is passed as x/y coordinates.
+ "
+ focusView notNil ifTrue:[
+ (#(#'keyPress:x:y:'
+ #'keyRelease:x:y:'
+ )includes:selector) ifTrue:[
+ eventReceiver := focusView.
+ (controller := focusView controller) notNil ifTrue:[
eventReceiver := controller.
- ]
- ].
+ ].
+ eventReceiver perform:selector
+ withArguments:(Array with:(arguments at:1)
+ with:-1
+ with:-1).
+ ^ self
+ ]
+ ].
- view transformation notNil ifTrue:[
- (#(
- #'buttonPress:x:y:'
- #'buttonRelease:x:y:'
- #'buttonShiftPress:x:y:'
- #'buttonMultiPress:x:y:'
- #'buttonMotion:x:y:'
- #'keyPress:x:y:'
- #'keyRelease:x:y:'
- #'exposeX:y:width:height:'
- #'graphicExposeX:y:width:height:'
- #'pointerEnter:x:y:'
- )includes:selector) ifTrue:[
- selector := selector asString.
- selector at:1 put:(selector at:1) asUppercase.
- selector := ('device' , selector) asSymbol
- ]
- ].
- eventReceiver perform:selector withArguments:arguments
- ]
+ "
+ another one:
+ if the view has a transformation, edit the selector
+ from #foo to #deviceFoo...
+ This allows the view to handle the event either in device or
+ logical coordinates. (since the deviceFoo-messages default implementation
+ in PseudoView translates and resends).
+ Actually, I could always send deviceXXX without speed penalty
+ (event sending is no high frequency operation), but that just adds
+ another context to any debuggers walkback, making things less clear.
+ "
+ view transformation notNil ifTrue:[
+ (#(
+ #'buttonPress:x:y:'
+ #'buttonRelease:x:y:'
+ #'buttonShiftPress:x:y:'
+ #'buttonMultiPress:x:y:'
+ #'buttonMotion:x:y:'
+ #'keyPress:x:y:'
+ #'keyRelease:x:y:'
+ #'exposeX:y:width:height:'
+ #'graphicExposeX:y:width:height:'
+ #'pointerEnter:x:y:'
+ ) includes:selector) ifTrue:[
+ selector := selector asString.
+ selector at:1 put:(selector at:1) asUppercase.
+ selector := ('device' , selector) asSymbol
+ ]
+ ].
+ eventReceiver perform:selector withArguments:arguments
! !
!WindowEvent methodsFor:'private accessing'!
--- a/WindowEvent.st Mon Feb 06 01:30:10 1995 +0100
+++ b/WindowEvent.st Mon Feb 06 01:38:04 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/WindowEvent.st,v 1.10 1994-11-22 14:32:22 claus Exp $
+$Header: /cvs/stx/stx/libview/WindowEvent.st,v 1.11 1995-02-06 00:38:02 claus Exp $
'!
!WindowEvent class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/WindowEvent.st,v 1.10 1994-11-22 14:32:22 claus Exp $
+$Header: /cvs/stx/stx/libview/WindowEvent.st,v 1.11 1995-02-06 00:38:02 claus Exp $
"
!
@@ -84,7 +84,23 @@
isKeyEvent
"return true, if this event is a keyboard event"
- ^ (type == #keyPress:x:y) or:[type == #keyRelease:x:y]
+ ^ (type == #keyPress:x:y:) or:[type == #keyRelease:x:y:]
+!
+
+isKeyPressEvent
+ "return true, if this event is a keyboard event"
+
+ ^ (type == #keyPress:x:y:)
+!
+
+isButtonEvent
+ "return true, if this event is a button event"
+
+ ^ (type == #buttonPress:x:y:)
+ or:[type == #buttonRelease:x:y:
+ or:[type == #'buttonShiftPress:x:y:'
+ or:[type == #'buttonMultiPress:x:y:'
+ or:[type == #'buttonMotion:x:y:']]]]
!
isDamage
@@ -129,18 +145,42 @@
"return the damage rectangle"
^ arguments "consider this a kludge"
+!
+
+key
+ "return the key of the key-event. For non key-events, nil is returned."
+
+ ((type == #keyPress:x:y:)
+ or:[type == #keyRelease:x:y:]) ifTrue:[
+ ^ arguments at:1
+ ].
+ ^ nil
! !
!WindowEvent methodsFor:'sending'!
sendEvent
"forward the event represented by the receiver to the delegate,
- the controller or the view.
+ the controller or the view. Only messages which are understood by
+ the delegate are forwarded.
Delegated messages get the original view as an extra argument."
+ self sendEventWithFocusOn:nil
+!
+
+sendEventWithFocusOn:focusView
+ "forward the event represented by the receiver to the delegate,
+ the controller or the view. If focusView is nonNil, and its a keyboard
+ event, the event is forwarded to it (but not if there is a delegate).
+ If there is a delegate, only messages which are understood by it are
+ forwarded. Delegated messages get the original view as an extra argument.
+ Delegation has higher priority than both controller or focusView
+ forwarding."
+
|delegate selector eventReceiver controller|
selector := type.
+
delegate := view delegate.
delegate notNil ifTrue:[
"
@@ -153,61 +193,117 @@
] ifFalse:[
selector := (selector , 'View:') asSymbol.
].
- arguments isNil ifTrue:[
- delegate perform:selector with:view
- ] ifFalse:[
- delegate perform:selector withArguments:(arguments copyWith:view)
+ (delegate respondsTo:selector) ifTrue:[
+ "
+ mhmh have to convert to logical coordinates ...
+ "
+ view transformation notNil ifTrue:[
+ (#(
+ #'buttonPress:x:y:'
+ #'buttonRelease:x:y:'
+ #'buttonShiftPress:x:y:'
+ #'buttonMultiPress:x:y:'
+ #'buttonMotion:x:y:'
+ #'keyPress:x:y:'
+ #'keyRelease:x:y:'
+ #'pointerEnter:x:y:'
+ #'exposeX:y:width:height:'
+ #'graphicExposeX:y:width:height:'
+ )includes:type) ifTrue:[
+ arguments at:2 put:(view transformation applyInverseToX:(arguments at:2)).
+ arguments at:3 put:(view transformation applyInverseToY:(arguments at:3)).
+ (#(
+ #'exposeX:y:width:height:'
+ #'graphicExposeX:y:width:height:'
+ )includes:type) ifTrue:[
+ arguments at:4 put:(view transformation applyInverseScaleX:(arguments at:4)).
+ arguments at:5 put:(view transformation applyInverseScaleY:(arguments at:5)).
+ ].
+ ].
+ ].
+ arguments isNil ifTrue:[
+ delegate perform:selector with:view
+ ] ifFalse:[
+ delegate perform:selector withArguments:(arguments copyWith:view)
+ ].
+ ^ self
+ ].
+ selector := type.
+ ].
+
+ "
+ if there is a controller, that one gets all user events
+ "
+ eventReceiver := view.
+ (controller := view controller) notNil ifTrue:[
+ (#(
+ #'buttonPress:x:y:'
+ #'buttonRelease:x:y:'
+ #'buttonShiftPress:x:y:'
+ #'buttonMultiPress:x:y:'
+ #'buttonMotion:x:y:'
+ #'keyPress:x:y:'
+ #'keyRelease:x:y:'
+ #'focusIn'
+ #'focusOut'
+ #'pointerEnter:x:y:'
+ #'pointerLeave:'
+ ) includes:selector) ifTrue:[
+ eventReceiver := controller.
]
- ] ifFalse:[
- "
- another one:
- if the view has a transformation, edit the selector
- from #foo to #deviceFoo...
- This allows the view to handle the event either in device or
- logical coordinates. (since the deviceFoo-messages default implementation
- in PseudoView translates and resends).
- Actually, I could always send deviceXXX without speed penalty
- (event sending is no high frequency operation), but that just adds
- another context to any debuggers walkback, making things less clear.
- "
- eventReceiver := view.
- (controller := view controller) notNil ifTrue:[
- (#(
- #'buttonPress:x:y:'
- #'buttonRelease:x:y:'
- #'buttonShiftPress:x:y:'
- #'buttonMultiPress:x:y:'
- #'buttonMotion:x:y:'
- #'keyPress:x:y:'
- #'keyRelease:x:y:'
- #'exposeX:y:width:height:'
- #'graphicExposeX:y:width:height:'
- #'pointerEnter:x:y:'
- ) includes:selector) ifTrue:[
+ ].
+
+ "
+ if there is a focusView, and its a keyboard event, pass it
+ to that view (or its controller). In this case, some coordinate which is outside of
+ the focusView is passed as x/y coordinates.
+ "
+ focusView notNil ifTrue:[
+ (#(#'keyPress:x:y:'
+ #'keyRelease:x:y:'
+ )includes:selector) ifTrue:[
+ eventReceiver := focusView.
+ (controller := focusView controller) notNil ifTrue:[
eventReceiver := controller.
- ]
- ].
+ ].
+ eventReceiver perform:selector
+ withArguments:(Array with:(arguments at:1)
+ with:-1
+ with:-1).
+ ^ self
+ ]
+ ].
- view transformation notNil ifTrue:[
- (#(
- #'buttonPress:x:y:'
- #'buttonRelease:x:y:'
- #'buttonShiftPress:x:y:'
- #'buttonMultiPress:x:y:'
- #'buttonMotion:x:y:'
- #'keyPress:x:y:'
- #'keyRelease:x:y:'
- #'exposeX:y:width:height:'
- #'graphicExposeX:y:width:height:'
- #'pointerEnter:x:y:'
- )includes:selector) ifTrue:[
- selector := selector asString.
- selector at:1 put:(selector at:1) asUppercase.
- selector := ('device' , selector) asSymbol
- ]
- ].
- eventReceiver perform:selector withArguments:arguments
- ]
+ "
+ another one:
+ if the view has a transformation, edit the selector
+ from #foo to #deviceFoo...
+ This allows the view to handle the event either in device or
+ logical coordinates. (since the deviceFoo-messages default implementation
+ in PseudoView translates and resends).
+ Actually, I could always send deviceXXX without speed penalty
+ (event sending is no high frequency operation), but that just adds
+ another context to any debuggers walkback, making things less clear.
+ "
+ view transformation notNil ifTrue:[
+ (#(
+ #'buttonPress:x:y:'
+ #'buttonRelease:x:y:'
+ #'buttonShiftPress:x:y:'
+ #'buttonMultiPress:x:y:'
+ #'buttonMotion:x:y:'
+ #'keyPress:x:y:'
+ #'keyRelease:x:y:'
+ #'exposeX:y:width:height:'
+ #'graphicExposeX:y:width:height:'
+ #'pointerEnter:x:y:'
+ ) includes:selector) ifTrue:[
+ selector := selector asString.
+ selector at:1 put:(selector at:1) asUppercase.
+ selector := ('device' , selector) asSymbol
+ ]
+ ].
+ eventReceiver perform:selector withArguments:arguments
! !
!WindowEvent methodsFor:'private accessing'!