.
--- a/Color.st Tue Jun 27 04:21:46 1995 +0200
+++ b/Color.st Sun Jul 02 18:18:17 1995 +0200
@@ -26,7 +26,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Color.st,v 1.28 1995-06-27 02:18:18 claus Exp $
+$Header: /cvs/stx/stx/libview/Color.st,v 1.29 1995-07-02 16:15:12 claus Exp $
'!
!Color class methodsFor:'documentation'!
@@ -47,7 +47,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Color.st,v 1.28 1995-06-27 02:18:18 claus Exp $
+$Header: /cvs/stx/stx/libview/Color.st,v 1.29 1995-07-02 16:15:12 claus Exp $
"
!
@@ -250,6 +250,13 @@
NumFixBlue := nB.
!
+releaseDitherColors
+ "release dither colors"
+
+ FixColors := nil.
+ NumFixRed := NumFixGreen := NumFixBlue := 0.
+!
+
getColors5x5x5
"preallocates a 5x5x5 (125) colorMap and later uses those colors only.
Doing so has the advantage that the system will never run out of colors,
--- a/Controll.st Tue Jun 27 04:21:46 1995 +0200
+++ b/Controll.st Sun Jul 02 18:18:17 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/Controll.st,v 1.21 1995-06-27 02:18:28 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/Controll.st,v 1.22 1995-07-02 16:15:18 claus Exp $
'!
!Controller class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/Controll.st,v 1.21 1995-06-27 02:18:28 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/Controll.st,v 1.22 1995-07-02 16:15:18 claus Exp $
"
!
@@ -157,12 +157,14 @@
menuHolder
"by default, the model has to provide the menu"
+ model isNil ifTrue:[^ view].
^ model
!
menuPerformer
"by default, the model is performing menu actions"
+ model isNil ifTrue:[^ view].
^ model
! !
@@ -213,22 +215,29 @@
"actually, this should be called 'middleButtonActivity'.
But for ST-80 compatibility ...."
- |sym menu actionSelector menuHolder menuPerformer|
+ |menu actionSelector menuPerformer|
menu := self yellowButtonMenu.
menu notNil ifTrue:[
menuPerformer := self menuPerformer.
+
"
got one, launch the menu. It is supposed
to return an actionSelector.
"
- "
- a temporary kludge: subMenus dont know about
- actionSelectors yet ...
+ "
+ a temporary kludge: subMenus dont know about
+ actionSelectors yet ...
+ "
+ menu receiver isNil ifTrue:[
+ menu receiver:menuPerformer
+ ] ifFalse:[
"
- menu receiver isNil ifTrue:[
- menu receiver:menuPerformer
- ].
+ if the menu has an explicit receiver,
+ thats the one to do the work.
+ "
+ menuPerformer := menu receiver
+ ].
actionSelector := menu startUp.
(actionSelector notNil
--- a/Controller.st Tue Jun 27 04:21:46 1995 +0200
+++ b/Controller.st Sun Jul 02 18:18:17 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Controller.st,v 1.21 1995-06-27 02:18:28 claus Exp $
+$Header: /cvs/stx/stx/libview/Controller.st,v 1.22 1995-07-02 16:15:18 claus Exp $
'!
!Controller class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Controller.st,v 1.21 1995-06-27 02:18:28 claus Exp $
+$Header: /cvs/stx/stx/libview/Controller.st,v 1.22 1995-07-02 16:15:18 claus Exp $
"
!
@@ -157,12 +157,14 @@
menuHolder
"by default, the model has to provide the menu"
+ model isNil ifTrue:[^ view].
^ model
!
menuPerformer
"by default, the model is performing menu actions"
+ model isNil ifTrue:[^ view].
^ model
! !
@@ -213,22 +215,29 @@
"actually, this should be called 'middleButtonActivity'.
But for ST-80 compatibility ...."
- |sym menu actionSelector menuHolder menuPerformer|
+ |menu actionSelector menuPerformer|
menu := self yellowButtonMenu.
menu notNil ifTrue:[
menuPerformer := self menuPerformer.
+
"
got one, launch the menu. It is supposed
to return an actionSelector.
"
- "
- a temporary kludge: subMenus dont know about
- actionSelectors yet ...
+ "
+ a temporary kludge: subMenus dont know about
+ actionSelectors yet ...
+ "
+ menu receiver isNil ifTrue:[
+ menu receiver:menuPerformer
+ ] ifFalse:[
"
- menu receiver isNil ifTrue:[
- menu receiver:menuPerformer
- ].
+ if the menu has an explicit receiver,
+ thats the one to do the work.
+ "
+ menuPerformer := menu receiver
+ ].
actionSelector := menu startUp.
(actionSelector notNil
--- a/Depth2Image.st Tue Jun 27 04:21:46 1995 +0200
+++ b/Depth2Image.st Sun Jul 02 18:18:17 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Depth2Image.st,v 1.12 1995-03-18 05:10:28 claus Exp $
+$Header: /cvs/stx/stx/libview/Depth2Image.st,v 1.13 1995-07-02 16:15:28 claus Exp $
'!
!Depth2Image class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Depth2Image.st,v 1.12 1995-03-18 05:10:28 claus Exp $
+$Header: /cvs/stx/stx/libview/Depth2Image.st,v 1.13 1995-07-02 16:15:28 claus Exp $
"
!
@@ -151,12 +151,13 @@
byte "{ Class: SmallInteger }"
shift "{ Class: SmallInteger }"
value "{ Class: SmallInteger }"
- p|
+ p grey|
lineIndex := (self bytesPerRow * y) + 1.
"left pixel in high bits"
byte := bytes at:(lineIndex + (x // 4)).
+
shift := #(-6 -4 -2 0) at:((x \\ 4) + 1).
value := (byte bitShift:shift) bitAnd:3.
p := photometric.
@@ -164,17 +165,19 @@
value := 3 - value.
p := #blackIs0
].
- photometric == #blackIs0 ifTrue:[
+ p == #blackIs0 ifTrue:[
(value == 0) ifTrue:[
^ Color black
].
- (value == 1) ifTrue:[
- ^ Color grey:33
+ (value == 3) ifTrue:[
+ ^ Color white
].
- (value == 2) ifTrue:[
- ^ Color grey:67
+ (value == 1) ifTrue:[
+ grey := 33
+ ] ifFalse:[
+ grey := 67
].
- ^ Color white
+ ^ Color grey:grey
].
photometric ~~ #palette ifTrue:[
self error:'format not supported'.
--- a/Depth8Image.st Tue Jun 27 04:21:46 1995 +0200
+++ b/Depth8Image.st Sun Jul 02 18:18:17 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Depth8Image.st,v 1.22 1995-06-06 04:05:24 claus Exp $
+$Header: /cvs/stx/stx/libview/Depth8Image.st,v 1.23 1995-07-02 16:15:33 claus Exp $
'!
!Depth8Image class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Depth8Image.st,v 1.22 1995-06-06 04:05:24 claus Exp $
+$Header: /cvs/stx/stx/libview/Depth8Image.st,v 1.23 1995-07-02 16:15:33 claus Exp $
"
!
@@ -948,24 +948,26 @@
|pseudoBits f gcRound has8BitImage deviceDepth
imgMap newImage pxl
- usedColors usageCounts nUsed map
+ usedColors usageCounts maxIndex map
fit scale lastOK error
- div
- shift "{Class: SmallInteger }"
- m "{Class: SmallInteger }" |
+ div
+ bitsPerRGB "{Class: SmallInteger }"
+ shift "{Class: SmallInteger }"
+ m "{Class: SmallInteger }" |
Color fixColors notNil ifTrue:[
f := self paletteImageAsDitheredPseudoFormOn:aDevice.
f notNil ifTrue:[^ f].
].
- 'D8IMAGE: allocating colors ...' infoPrintNL.
-
"find used colors"
- usedColors := bytes usedValues. "gets us an array filled with used values"
- "(could use bytes asBag)"
- nUsed := usedColors max + 1.
+ usedColors := bytes usedValues. "gets us an array filled with used values"
+ "(could use bytes asBag)"
+ maxIndex := usedColors max + 1.
+
+ ('D8IMAGE: allocating ' , usedColors size printString , ' colors ...') infoPrintNL.
+
"sort by usage"
usageCounts := bytes usageCounts.
@@ -974,13 +976,14 @@
"allocate the colors (in order of usage count)"
- imgMap := Array new:nUsed.
+ imgMap := Array new:maxIndex.
"
first, try to get the exact colors ...
"
- shift := (8 - aDevice bitsPerRGB) negated.
- m := (1 bitShift:(aDevice bitsPerRGB)) - 1.
+ bitsPerRGB := aDevice bitsPerRGB.
+ shift := (8 - bitsPerRGB) negated.
+ m := (1 bitShift:bitsPerRGB) - 1.
div := m asFloat.
fit := true.
@@ -1119,10 +1122,11 @@
mapIndex := aColorIndex + 1.
color := colorMap at:mapIndex.
color brightness > 0.5 ifTrue:[
- imgMap at:mapIndex put:(Color white on:aDevice).
+ color := Color white.
] ifFalse:[
- imgMap at:mapIndex put:(Color black on:aDevice).
- ]
+ color := Color black.
+ ].
+ imgMap at:mapIndex put:(color on:aDevice).
].
fit := true.
]
@@ -1140,11 +1144,16 @@
"
map := ByteArray new:256.
1 to:imgMap size do:[:i |
- (imgMap at:i) notNil ifTrue:[
- map at:i put:(imgMap at:i) colorId
+ |clr|
+
+ (clr := imgMap at:i) notNil ifTrue:[
+ map at:i put:clr colorId
]
].
+ "
+ does the device support 8-bit images ?
+ "
deviceDepth := aDevice depth.
deviceDepth == 8 ifTrue:[
has8BitImage := true.
@@ -1443,176 +1452,176 @@
^ self dither1PlaneUsingMap:map on:aDevice.
- formBytes := ByteArray uninitializedNew:(w + 7 // 8) * h.
- patterns := Array new:256.
- pixel0bytes := ByteArray uninitializedNew:256.
- pixel1bytes := ByteArray uninitializedNew:256.
-
- "extract dither patterns and values to use for 1/0 bits
- in those from the dithercolors"
-
- 1 to:256 do:[:i |
- clr := (map at:i) on:aDevice.
- ditherPattern := clr ditherForm.
-
- ditherPattern isNil ifTrue:[
- patterns at:i put:#[2r11111111
- 2r11111111
- 2r11111111
- 2r11111111
- 2r11111111
- 2r11111111
- 2r11111111
- 2r11111111].
- pixel0bytes at:i put:clr colorId.
- pixel1bytes at:i put:clr colorId
- ] ifFalse:[
- patterns at:i put:(ditherPattern bits).
- pixel0bytes at:i put:(ditherPattern colorMap at:1) colorId.
- pixel1bytes at:i put:(ditherPattern colorMap at:2) colorId.
- ].
- ].
-
- srcIndex := 1.
- dstIndex := 1.
- mask := 16r80.
- outBits := 0.
- patternOffset := 1.
- 1 to:h do:[:dstY |
- last := nil.
- 1 to:w do:[:dstX |
- v := bytes at:srcIndex. "pixel value"
- srcIndex := srcIndex + 1.
-
- v == last ifFalse:[
- index := v + 1. "index into map"
-
- patternBytes := patterns at:index. "dither pattern for color"
- patternBits := patternBytes at:patternOffset. "dither row"
- p0 := pixel0bytes at:index. "value for 0-dither bit"
- p1 := pixel1bytes at:index. "value for 1-dither bit"
- last := v.
- ].
- outBits := outBits bitShift:1.
- (patternBits bitAnd:mask) == 0 ifTrue:[
- outBits := outBits bitOr:p0.
- ] ifFalse:[
- outBits := outBits bitOr:p1
- ].
- mask := mask bitShift:-1.
- mask == 0 ifTrue:[
- mask := 16r80.
- formBytes at:dstIndex put:outBits.
- dstIndex := dstIndex + 1.
- outBits := 0
- ]
- ].
- mask == 16r80 ifFalse:[
- dstIndex := dstIndex + 1.
- mask := 16r80.
- outBits := 0
- ].
- patternOffset := patternOffset + 1.
- patternOffset == 9 ifTrue:[
- patternOffset := 1
- ]
- ].
- f := Form width:w height:h fromArray:formBytes.
- ^ f
+"/ formBytes := ByteArray uninitializedNew:(w + 7 // 8) * h.
+"/ patterns := Array new:256.
+"/ pixel0bytes := ByteArray uninitializedNew:256.
+"/ pixel1bytes := ByteArray uninitializedNew:256.
+"/
+"/ "extract dither patterns and values to use for 1/0 bits
+"/ in those from the dithercolors"
+"/
+"/ 1 to:256 do:[:i |
+"/ clr := (map at:i) on:aDevice.
+"/ ditherPattern := clr ditherForm.
+"/
+"/ ditherPattern isNil ifTrue:[
+"/ patterns at:i put:#[2r11111111
+"/ 2r11111111
+"/ 2r11111111
+"/ 2r11111111
+"/ 2r11111111
+"/ 2r11111111
+"/ 2r11111111
+"/ 2r11111111].
+"/ pixel0bytes at:i put:clr colorId.
+"/ pixel1bytes at:i put:clr colorId
+"/ ] ifFalse:[
+"/ patterns at:i put:(ditherPattern bits).
+"/ pixel0bytes at:i put:(ditherPattern colorMap at:1) colorId.
+"/ pixel1bytes at:i put:(ditherPattern colorMap at:2) colorId.
+"/ ].
+"/ ].
+"/
+"/ srcIndex := 1.
+"/ dstIndex := 1.
+"/ mask := 16r80.
+"/ outBits := 0.
+"/ patternOffset := 1.
+"/ 1 to:h do:[:dstY |
+"/ last := nil.
+"/ 1 to:w do:[:dstX |
+"/ v := bytes at:srcIndex. "pixel value"
+"/ srcIndex := srcIndex + 1.
+"/
+"/ v == last ifFalse:[
+"/ index := v + 1. "index into map"
+"/
+"/ patternBytes := patterns at:index. "dither pattern for color"
+"/ patternBits := patternBytes at:patternOffset. "dither row"
+"/ p0 := pixel0bytes at:index. "value for 0-dither bit"
+"/ p1 := pixel1bytes at:index. "value for 1-dither bit"
+"/ last := v.
+"/ ].
+"/ outBits := outBits bitShift:1.
+"/ (patternBits bitAnd:mask) == 0 ifTrue:[
+"/ outBits := outBits bitOr:p0.
+"/ ] ifFalse:[
+"/ outBits := outBits bitOr:p1
+"/ ].
+"/ mask := mask bitShift:-1.
+"/ mask == 0 ifTrue:[
+"/ mask := 16r80.
+"/ formBytes at:dstIndex put:outBits.
+"/ dstIndex := dstIndex + 1.
+"/ outBits := 0
+"/ ]
+"/ ].
+"/ mask == 16r80 ifFalse:[
+"/ dstIndex := dstIndex + 1.
+"/ mask := 16r80.
+"/ outBits := 0
+"/ ].
+"/ patternOffset := patternOffset + 1.
+"/ patternOffset == 9 ifTrue:[
+"/ patternOffset := 1
+"/ ]
+"/ ].
+"/ f := Form width:w height:h fromArray:formBytes.
+"/ ^ f
].
depth == 2 ifTrue:[
^ self dither2PlaneUsingMap:map on:aDevice.
- formBytes := ByteArray uninitializedNew:(w * 2 + 7 // 8) * h.
- patterns := Array new:256.
- pixel0bytes := ByteArray uninitializedNew:256.
- pixel1bytes := ByteArray uninitializedNew:256.
-
- "extract dither patterns and values to use for 1/o bits
- in those from the dithercolors"
-
- 1 to:256 do:[:i |
- clr := (map at:i) on:aDevice.
- ditherPattern := clr ditherForm.
-
- ditherPattern isNil ifTrue:[
- patterns at:i put:#[2r11111111
- 2r11111111
- 2r11111111
- 2r11111111
- 2r11111111
- 2r11111111
- 2r11111111
- 2r11111111].
- pixel0bytes at:i put:clr colorId.
- pixel1bytes at:i put:clr colorId
- ] ifFalse:[
- patterns at:i put:(ditherPattern bits).
- pixel0bytes at:i put:(ditherPattern colorMap at:1) colorId.
- pixel1bytes at:i put:(ditherPattern colorMap at:2) colorId.
- ].
- ].
-
- srcIndex := 1.
- dstIndex := 1.
- mask := 16r80.
- outBits := 0.
- patternOffset := 1.
- 1 to:h do:[:dstY |
- last := nil.
- 1 to:w do:[:dstX |
- v := bytes at:srcIndex. "pixel value"
- srcIndex := srcIndex + 1.
-
- v == last ifFalse:[
- index := v + 1. "index into map"
-
- patternBytes := patterns at:index. "dither pattern for color"
- patternBits := patternBytes at:patternOffset. "dither row"
- p0 := pixel0bytes at:index. "value for 0-dither bit"
- p1 := pixel1bytes at:index. "value for 1-dither bit"
- last := v.
- ].
- outBits := outBits bitShift:2.
-
- (patternBits bitAnd:mask) == 0 ifTrue:[
- outBits := outBits bitOr:p0.
- ] ifFalse:[
- outBits := outBits bitOr:p1
- ].
- mask := mask bitShift:-1.
- mask == 16r08 ifTrue:[
- formBytes at:dstIndex put:outBits.
- dstIndex := dstIndex + 1.
- outBits := 0
- ] ifFalse:[
- mask == 0 ifTrue:[
- mask := 16r80.
- formBytes at:dstIndex put:outBits.
- dstIndex := dstIndex + 1.
- outBits := 0
- ]
- ]
- ].
- ((mask == 16r80) or:[mask == 16r08]) ifFalse:[
- formBytes at:dstIndex put:outBits.
- dstIndex := dstIndex + 1.
- mask := 16r80.
- outBits := 0
- ].
- patternOffset := patternOffset + 1.
- patternOffset == 9 ifTrue:[
- patternOffset := 1
- ]
- ].
-
- f := Form width:w height:h depth:2.
- f initGC.
- f device drawBits:formBytes depth:2
- width:w height:h x:0 y:0
- into:f id x:0 y:0 width:w height:h with:f gcId.
- ^ f
+"/ formBytes := ByteArray uninitializedNew:(w * 2 + 7 // 8) * h.
+"/ patterns := Array new:256.
+"/ pixel0bytes := ByteArray uninitializedNew:256.
+"/ pixel1bytes := ByteArray uninitializedNew:256.
+"/
+"/ "extract dither patterns and values to use for 1/o bits
+"/ in those from the dithercolors"
+"/
+"/ 1 to:256 do:[:i |
+"/ clr := (map at:i) on:aDevice.
+"/ ditherPattern := clr ditherForm.
+"/
+"/ ditherPattern isNil ifTrue:[
+"/ patterns at:i put:#[2r11111111
+"/ 2r11111111
+"/ 2r11111111
+"/ 2r11111111
+"/ 2r11111111
+"/ 2r11111111
+"/ 2r11111111
+"/ 2r11111111].
+"/ pixel0bytes at:i put:clr colorId.
+"/ pixel1bytes at:i put:clr colorId
+"/ ] ifFalse:[
+"/ patterns at:i put:(ditherPattern bits).
+"/ pixel0bytes at:i put:(ditherPattern colorMap at:1) colorId.
+"/ pixel1bytes at:i put:(ditherPattern colorMap at:2) colorId.
+"/ ].
+"/ ].
+"/
+"/ srcIndex := 1.
+"/ dstIndex := 1.
+"/ mask := 16r80.
+"/ outBits := 0.
+"/ patternOffset := 1.
+"/ 1 to:h do:[:dstY |
+"/ last := nil.
+"/ 1 to:w do:[:dstX |
+"/ v := bytes at:srcIndex. "pixel value"
+"/ srcIndex := srcIndex + 1.
+"/
+"/ v == last ifFalse:[
+"/ index := v + 1. "index into map"
+"/
+"/ patternBytes := patterns at:index. "dither pattern for color"
+"/ patternBits := patternBytes at:patternOffset. "dither row"
+"/ p0 := pixel0bytes at:index. "value for 0-dither bit"
+"/ p1 := pixel1bytes at:index. "value for 1-dither bit"
+"/ last := v.
+"/ ].
+"/ outBits := outBits bitShift:2.
+"/
+"/ (patternBits bitAnd:mask) == 0 ifTrue:[
+"/ outBits := outBits bitOr:p0.
+"/ ] ifFalse:[
+"/ outBits := outBits bitOr:p1
+"/ ].
+"/ mask := mask bitShift:-1.
+"/ mask == 16r08 ifTrue:[
+"/ formBytes at:dstIndex put:outBits.
+"/ dstIndex := dstIndex + 1.
+"/ outBits := 0
+"/ ] ifFalse:[
+"/ mask == 0 ifTrue:[
+"/ mask := 16r80.
+"/ formBytes at:dstIndex put:outBits.
+"/ dstIndex := dstIndex + 1.
+"/ outBits := 0
+"/ ]
+"/ ]
+"/ ].
+"/ ((mask == 16r80) or:[mask == 16r08]) ifFalse:[
+"/ formBytes at:dstIndex put:outBits.
+"/ dstIndex := dstIndex + 1.
+"/ mask := 16r80.
+"/ outBits := 0
+"/ ].
+"/ patternOffset := patternOffset + 1.
+"/ patternOffset == 9 ifTrue:[
+"/ patternOffset := 1
+"/ ]
+"/ ].
+"/
+"/ f := Form width:w height:h depth:2.
+"/ f initGC.
+"/ f device drawBits:formBytes depth:2
+"/ width:w height:h x:0 y:0
+"/ into:f id x:0 y:0 width:w height:h with:f gcId.
+"/ ^ f
].
"draw each pixel using dither color (let others do the dithering)
--- a/GraphAttr.st Tue Jun 27 04:21:46 1995 +0200
+++ b/GraphAttr.st Sun Jul 02 18:18:17 1995 +0200
@@ -25,7 +25,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/GraphAttr.st,v 1.1 1995-06-06 04:07:14 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/GraphAttr.st,v 1.2 1995-07-02 16:16:15 claus Exp $
'!
!GraphicsAttributes class methodsFor:'documentation'!
@@ -46,7 +46,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/GraphAttr.st,v 1.1 1995-06-06 04:07:14 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/GraphAttr.st,v 1.2 1995-07-02 16:16:15 claus Exp $
"
!
@@ -77,7 +77,7 @@
installOn:aGC
paint notNil ifTrue:[aGC paint:paint].
font notNil ifTrue:[aGC font:font].
- lineWIdth notNil ifTrue:[aGC lineWidth:lineWidth].
+ lineWidth notNil ifTrue:[aGC lineWidth:lineWidth].
lineStyle notNil ifTrue:[aGC lineStyle:lineStyle].
joinStyle notNil ifTrue:[aGC joinStyle:joinStyle].
capStyle notNil ifTrue:[aGC capStyle:capStyle].
--- a/GraphicsAttributes.st Tue Jun 27 04:21:46 1995 +0200
+++ b/GraphicsAttributes.st Sun Jul 02 18:18:17 1995 +0200
@@ -25,7 +25,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/GraphicsAttributes.st,v 1.1 1995-06-06 04:07:14 claus Exp $
+$Header: /cvs/stx/stx/libview/GraphicsAttributes.st,v 1.2 1995-07-02 16:16:15 claus Exp $
'!
!GraphicsAttributes class methodsFor:'documentation'!
@@ -46,7 +46,7 @@
version
"
-$Header: /cvs/stx/stx/libview/GraphicsAttributes.st,v 1.1 1995-06-06 04:07:14 claus Exp $
+$Header: /cvs/stx/stx/libview/GraphicsAttributes.st,v 1.2 1995-07-02 16:16:15 claus Exp $
"
!
@@ -77,7 +77,7 @@
installOn:aGC
paint notNil ifTrue:[aGC paint:paint].
font notNil ifTrue:[aGC font:font].
- lineWIdth notNil ifTrue:[aGC lineWidth:lineWidth].
+ lineWidth notNil ifTrue:[aGC lineWidth:lineWidth].
lineStyle notNil ifTrue:[aGC lineStyle:lineStyle].
joinStyle notNil ifTrue:[aGC joinStyle:joinStyle].
capStyle notNil ifTrue:[aGC capStyle:capStyle].
--- a/Image.st Tue Jun 27 04:21:46 1995 +0200
+++ b/Image.st Sun Jul 02 18:18:17 1995 +0200
@@ -28,7 +28,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Image.st,v 1.33 1995-06-27 02:19:16 claus Exp $
+$Header: /cvs/stx/stx/libview/Image.st,v 1.34 1995-07-02 16:16:20 claus Exp $
'!
!Image class methodsFor:'documentation'!
@@ -49,7 +49,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Image.st,v 1.33 1995-06-27 02:19:16 claus Exp $
+$Header: /cvs/stx/stx/libview/Image.st,v 1.34 1995-07-02 16:16:20 claus Exp $
"
!
@@ -2352,13 +2352,40 @@
"((Image fromFile:'bitmaps/claus.gif') magnifiedBy:0.5@0.5)"
!
+magnifiedPreservingRatioTo:anExtent
+ "return a new image magnified to fit into anExtent,
+ preserving the receivers width/height ratio.
+ (i.e. not distorting the image).
+ See also #magnifiedTo: and #magnifiedBy:"
+
+ |rX rY|
+
+ rX := anExtent x / self width.
+ rY := anExtent y / self height.
+ ^ self magnifiedBy:(rX min:rY)
+
+ "
+ ((Image fromFile:'bitmaps/garfield.gif') magnifiedPreservingRatioTo:100@100)
+
+ in contrast to:
+
+ ((Image fromFile:'bitmaps/garfield.gif') magnifiedTo:100@100)
+ "
+!
+
magnifiedTo:anExtent
- "return a new image magnified to have the size specified by extent."
+ "return a new image magnified to have the size specified by extent.
+ This may distort the image if the arguments ratio is not the images ratio.
+ See also #magnifiedPreservingRatioTo: and #magnifiedBy:"
^ self magnifiedBy:(anExtent / self extent)
"
((Image fromFile:'bitmaps/garfield.gif') magnifiedTo:100@100)
+
+ in contrast to:
+
+ ((Image fromFile:'bitmaps/garfield.gif') magnifiedPreservingRatioTo:100@100)
"
!
--- a/Make.proto Tue Jun 27 04:21:46 1995 +0200
+++ b/Make.proto Sun Jul 02 18:18:17 1995 +0200
@@ -1,4 +1,4 @@
-# $Header: /cvs/stx/stx/libview/Make.proto,v 1.33 1995-06-27 02:21:06 claus Exp $
+# $Header: /cvs/stx/stx/libview/Make.proto,v 1.34 1995-07-02 16:18:17 claus Exp $
#
# -------------- no need to change anything below ----------
@@ -93,12 +93,17 @@
ValModel.$(O) \
PlugAdptr.$(O) \
ValHolder.$(O) \
+ TriggerVal.$(O) \
ProtAdptr.$(O) \
AspctAdptr.$(O) \
Plug.$(O) \
Controll.$(O) \
StdSysC.$(O) \
WTrans.$(O) \
+ Layout.$(O) \
+ LayoutOrg.$(O) \
+ LayoutFrm.$(O) \
+ AlignOrg.$(O) \
WEvent.$(O) \
WGroup.$(O) \
KeybdFwd.$(O) \
@@ -165,13 +170,13 @@
# special BIG-rule (kludge for HP)
#
XWorkstat.$(O):
- $(MAKE) $(BIG_STFILE_RULE) BIG_FILE=XWorkstat
+ $(MAKE) $(BIG_STFILE_RULE) BIG_FILE=XWorkstat CC=$(CC)
GLXWorkstat.$(O):
- $(MAKE) $(BIG_STFILE_RULE) BIG_FILE=GLXWorkstat
+ $(MAKE) $(BIG_STFILE_RULE) BIG_FILE=GLXWorkstat CC=$(CC)
-View.$(O):
- $(MAKE) $(BIG_STFILE_RULE) BIG_FILE=View
+SimpleView.$(O):
+ $(MAKE) $(BIG_STFILE_RULE) BIG_FILE=SimpleView CC=$(CC)
#
# install the extra objects
@@ -228,6 +233,7 @@
ValHolder.$(O): ValHolder.st $(I)/ValModel.H $(I)/Model.H $(OBJECT)
ProtAdptr.$(O): ProtAdptr.st $(VALHOLDER)
AspctAdptr.$(O): AspctAdptr.st $(I)/ProtAdptr.H $(VALHOLDER)
+TriggerVal.$(O): TriggerVal.st $(VALHOLDER)
Controll.$(O): Controll.st $(OBJECT)
StdSysC.$(O): StdSysC.st $(I)/Controll.H $(OBJECT)
@@ -284,3 +290,9 @@
DevHandle.$(O): DevHandle.st $(OBJECT)
DevViewH.$(O): DevViewH.st $(I)/DevHandle.H $(OBJECT)
DevFormH.$(O): DevFormH.st $(I)/DevHandle.H $(OBJECT)
+
+Layout.$(O): Layout.st $(OBJECT)
+LayoutOrg.$(O): LayoutOrg.st $(I)/Layout.H $(OBJECT)
+LayoutFrm.$(O): LayoutFrm.st $(I)/LayoutOrg.H $(I)/Layout.H $(OBJECT)
+AlignOrg.$(O): AlignOrg.st $(I)/LayoutOrg.H $(I)/Layout.H $(OBJECT)
+
--- a/SimpleView.st Tue Jun 27 04:21:46 1995 +0200
+++ b/SimpleView.st Sun Jul 02 18:18:17 1995 +0200
@@ -44,7 +44,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.10 1995-06-27 02:19:58 claus Exp $
+$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.11 1995-07-02 16:17:13 claus Exp $
'!
!SimpleView class methodsFor:'documentation'!
@@ -65,7 +65,7 @@
version
"
-$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.10 1995-06-27 02:19:58 claus Exp $
+$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.11 1995-07-02 16:17:13 claus Exp $
"
!
@@ -924,7 +924,7 @@
transformation
"return the transformation"
- |vP|
+ |vP org|
transformation isNil ifTrue:[
"
@@ -932,13 +932,12 @@
"
window notNil ifTrue:[
superView isNil ifTrue:[
- vP := (0@0 extent:self extent)
+ org := 0 @ 0
] ifFalse:[
- vP := (self origin extent:self extent)
+ org := self origin
].
- ^ WindowingTransformation
- window:window
- viewport:vP
+ vP := org extent:(self extent).
+ ^ WindowingTransformation window:window viewport:vP
]
].
^ transformation
@@ -3779,8 +3778,8 @@
].
((edgeStyle == #soft) and:[l > 1]) ifTrue:[
super paint:Black "shadowColor".
- super displayDeviceLineFromX:(x + 1-1) y:b toX:r y:b.
- super displayDeviceLineFromX:r y:(y + 1 - 1) toX:r y:b
+ super displayDeviceLineFromX:(x + (1 - 1)) y:b toX:r y:b.
+ super displayDeviceLineFromX:r y:(y + (1 - 1)) toX:r y:b
]
!
@@ -4536,9 +4535,9 @@
with relative coordinates, or an instance of LayoutFrame, specifying
both relative coordinates and the insets."
- |origin corner l|
-
"/ old code:
+"/ |origin corner l|
+"/
"/ origin := aRectangleOrLayoutFrame origin.
"/ origin := origin x asFloat @ origin y asFloat.
"/ corner := aRectangleOrLayoutFrame corner.
@@ -4553,16 +4552,19 @@
"/ ].
"/ new (being validated):
+
+ |l|
+
(aRectangleOrLayoutFrame isMemberOf:Rectangle) ifTrue:[
l := aRectangleOrLayoutFrame asLayout.
] ifFalse:[
l := aRectangleOrLayoutFrame
].
- aComponent geometryLayout:l.
"/ will soon be replaced by:
"/ aComponent layout:l.
-"/
+ aComponent geometryLayout:l.
+
self addComponent:aComponent
!
--- a/WSensor.st Tue Jun 27 04:21:46 1995 +0200
+++ b/WSensor.st Sun Jul 02 18:18:17 1995 +0200
@@ -26,7 +26,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/WSensor.st,v 1.26 1995-06-27 02:20:39 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/WSensor.st,v 1.27 1995-07-02 16:17:47 claus Exp $
'!
!WindowSensor class methodsFor:'documentation'!
@@ -47,7 +47,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/WSensor.st,v 1.26 1995-06-27 02:20:39 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/WSensor.st,v 1.27 1995-07-02 16:17:47 claus Exp $
"
!
@@ -701,7 +701,7 @@
Except for special cases (moveOpaque of a view over one of my views),
these optimizations are not noticable."
- |temp index newEvent r rL rT rB rR nD s
+ |temp index newEvent r rL rT rB rR
count "{ Class: SmallInteger }"
sz "{ Class: SmallInteger }"
firstInterresting "{ Class: SmallInteger }"
--- a/WindowSensor.st Tue Jun 27 04:21:46 1995 +0200
+++ b/WindowSensor.st Sun Jul 02 18:18:17 1995 +0200
@@ -26,7 +26,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.26 1995-06-27 02:20:39 claus Exp $
+$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.27 1995-07-02 16:17:47 claus Exp $
'!
!WindowSensor class methodsFor:'documentation'!
@@ -47,7 +47,7 @@
version
"
-$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.26 1995-06-27 02:20:39 claus Exp $
+$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.27 1995-07-02 16:17:47 claus Exp $
"
!
@@ -701,7 +701,7 @@
Except for special cases (moveOpaque of a view over one of my views),
these optimizations are not noticable."
- |temp index newEvent r rL rT rB rR nD s
+ |temp index newEvent r rL rT rB rR
count "{ Class: SmallInteger }"
sz "{ Class: SmallInteger }"
firstInterresting "{ Class: SmallInteger }"
--- a/XWorkstat.st Tue Jun 27 04:21:46 1995 +0200
+++ b/XWorkstat.st Sun Jul 02 18:18:17 1995 +0200
@@ -35,7 +35,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/XWorkstat.st,v 1.48 1995-06-27 02:20:55 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/XWorkstat.st,v 1.49 1995-07-02 16:18:06 claus Exp $
'!
!XWorkstation class methodsFor:'documentation'!
@@ -56,7 +56,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/XWorkstat.st,v 1.48 1995-06-27 02:20:55 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/XWorkstat.st,v 1.49 1995-07-02 16:18:06 claus Exp $
"
!
@@ -2511,8 +2511,6 @@
"set the text selection, and make aWindowId be the owner.
This can be used by any other X application."
- |cutBuffer|
-
(self setSelectionOwner:aWindowId of:primaryAtom) ifFalse:[
'ownerchange failed' errorPrintNL.
].
@@ -2661,40 +2659,119 @@
next time. The elements of the returned collection are instances of
FontDescription."
- |stream aName fntDescr|
+ |stream names aName fntDescr|
listOfXFonts isNil ifTrue:[
- stream := PipeStream readingFrom:'xlsfonts ''*'''.
- stream isNil ifTrue:[^ nil].
- listOfXFonts := OrderedCollection new.
- [stream atEnd] whileFalse:[
- aName := stream nextLine.
- aName notNil ifTrue:[
- self decomposeXFontName:aName into:
- [:family :face :style :size :coding |
- family notNil ifTrue:[
- fntDescr := FontDescription
- family:family
- face:face
- style:style
- size:size
- encoding:coding.
- listOfXFonts add:fntDescr
- ]
- ]
- ]
+"/
+"/ old code; using a pipe to xlsfonts
+"/
+"/ stream := PipeStream readingFrom:'xlsfonts ''*'''.
+"/ stream isNil ifTrue:[^ nil].
+"/ listOfXFonts := OrderedCollection new.
+"/ [stream atEnd] whileFalse:[
+"/ aName := stream nextLine.
+"/ aName notNil ifTrue:[
+"/ self decomposeXFontName:aName into:
+"/ [:family :face :style :size :coding |
+"/ family notNil ifTrue:[
+"/ fntDescr := FontDescription
+"/ family:family
+"/ face:face
+"/ style:style
+"/ size:size
+"/ encoding:coding.
+"/ listOfXFonts add:fntDescr
+"/ ]
+"/ ]
+"/ ]
+"/ ].
+"/ stream close.
+"/ "if xlsfont is broken ... (hey sco)"
+"/ (listOfXFonts size == 0) ifTrue:[
+"/ listOfXFonts := nil
+"/ ] ifFalse:[
+"/ listOfXFonts sort:[:a :b | a family < b family].
+"/ ].
+
+ "/
+ "/ new code:
+ "/ use new primitive to get font names;
+ "/ this is much faster, and also works on systems where
+ "/ a) xlsfonts is broken (sco)
+ "/ b) xlsfonts is not available (aix)
+ "/
+ names := self getAvailableFontsMatching:'*'.
+ names isNil ifTrue:[
+ "no names returned ..."
+ ^ nil
].
- stream close.
- "if xlsfont is broken ... (hey sco)"
- (listOfXFonts size == 0) ifTrue:[
- listOfXFonts := nil
- ] ifFalse:[
- listOfXFonts sort:[:a :b | a family < b family].
- ]
+ listOfXFonts := names collect:[:aName |
+ |fntDescr|
+
+ self decomposeXFontName:aName into:
+ [:family :face :style :size :coding |
+ family notNil ifTrue:[
+ fntDescr := FontDescription
+ family:family
+ face:face
+ style:style
+ size:size
+ encoding:coding.
+ ] ifFalse:[
+ fntDescr := FontDescription
+ name:aName
+ ]
+ ].
+ fntDescr
+ ].
+
].
^ listOfXFonts
- "Display listOfAvailableFonts"
+ "
+ Display listOfAvailableFonts
+ "
+!
+
+getAvailableFontsMatching:pattern
+ "return anArray filled with font names patching aPattern"
+
+%{ /* UNLIMITEDSTACK */
+
+ int nnames = 1500;
+ int available = nnames + 1;
+ char **fonts;
+ OBJ arr, str;
+ OBJ __ARRAY_NEW_INT(), _MKSTRING_INIT();
+ int i;
+
+ if (ISCONNECTED) {
+ if (__isString(pattern)) {
+ for (;;) {
+ fonts = XListFonts(myDpy, __stringVal(pattern), nnames, &available);
+ if ((fonts == NULL) || (available < nnames)) break;
+ XFreeFontNames(fonts);
+ nnames = available * 2;
+ }
+ if (fonts == NULL) {
+ RETURN ( nil );
+ }
+ arr = __ARRAY_NEW_INT(available);
+ if (! arr) {
+ RETURN (nil);
+ }
+ for (i=0; i<available; i++) {
+ PROTECT(arr);
+ str = _MKSTRING_INIT(fonts[i]);
+ UNPROTECT(arr);
+ __ArrayInstPtr(arr)->a_element[i] = str;
+ __STORE(arr, str);
+ }
+ RETURN (arr);
+ }
+ }
+%}.
+ ^ nil
!
getFontWithFamily:familyString face:faceString
--- a/XWorkstation.st Tue Jun 27 04:21:46 1995 +0200
+++ b/XWorkstation.st Sun Jul 02 18:18:17 1995 +0200
@@ -35,7 +35,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.48 1995-06-27 02:20:55 claus Exp $
+$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.49 1995-07-02 16:18:06 claus Exp $
'!
!XWorkstation class methodsFor:'documentation'!
@@ -56,7 +56,7 @@
version
"
-$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.48 1995-06-27 02:20:55 claus Exp $
+$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.49 1995-07-02 16:18:06 claus Exp $
"
!
@@ -2511,8 +2511,6 @@
"set the text selection, and make aWindowId be the owner.
This can be used by any other X application."
- |cutBuffer|
-
(self setSelectionOwner:aWindowId of:primaryAtom) ifFalse:[
'ownerchange failed' errorPrintNL.
].
@@ -2661,40 +2659,119 @@
next time. The elements of the returned collection are instances of
FontDescription."
- |stream aName fntDescr|
+ |stream names aName fntDescr|
listOfXFonts isNil ifTrue:[
- stream := PipeStream readingFrom:'xlsfonts ''*'''.
- stream isNil ifTrue:[^ nil].
- listOfXFonts := OrderedCollection new.
- [stream atEnd] whileFalse:[
- aName := stream nextLine.
- aName notNil ifTrue:[
- self decomposeXFontName:aName into:
- [:family :face :style :size :coding |
- family notNil ifTrue:[
- fntDescr := FontDescription
- family:family
- face:face
- style:style
- size:size
- encoding:coding.
- listOfXFonts add:fntDescr
- ]
- ]
- ]
+"/
+"/ old code; using a pipe to xlsfonts
+"/
+"/ stream := PipeStream readingFrom:'xlsfonts ''*'''.
+"/ stream isNil ifTrue:[^ nil].
+"/ listOfXFonts := OrderedCollection new.
+"/ [stream atEnd] whileFalse:[
+"/ aName := stream nextLine.
+"/ aName notNil ifTrue:[
+"/ self decomposeXFontName:aName into:
+"/ [:family :face :style :size :coding |
+"/ family notNil ifTrue:[
+"/ fntDescr := FontDescription
+"/ family:family
+"/ face:face
+"/ style:style
+"/ size:size
+"/ encoding:coding.
+"/ listOfXFonts add:fntDescr
+"/ ]
+"/ ]
+"/ ]
+"/ ].
+"/ stream close.
+"/ "if xlsfont is broken ... (hey sco)"
+"/ (listOfXFonts size == 0) ifTrue:[
+"/ listOfXFonts := nil
+"/ ] ifFalse:[
+"/ listOfXFonts sort:[:a :b | a family < b family].
+"/ ].
+
+ "/
+ "/ new code:
+ "/ use new primitive to get font names;
+ "/ this is much faster, and also works on systems where
+ "/ a) xlsfonts is broken (sco)
+ "/ b) xlsfonts is not available (aix)
+ "/
+ names := self getAvailableFontsMatching:'*'.
+ names isNil ifTrue:[
+ "no names returned ..."
+ ^ nil
].
- stream close.
- "if xlsfont is broken ... (hey sco)"
- (listOfXFonts size == 0) ifTrue:[
- listOfXFonts := nil
- ] ifFalse:[
- listOfXFonts sort:[:a :b | a family < b family].
- ]
+ listOfXFonts := names collect:[:aName |
+ |fntDescr|
+
+ self decomposeXFontName:aName into:
+ [:family :face :style :size :coding |
+ family notNil ifTrue:[
+ fntDescr := FontDescription
+ family:family
+ face:face
+ style:style
+ size:size
+ encoding:coding.
+ ] ifFalse:[
+ fntDescr := FontDescription
+ name:aName
+ ]
+ ].
+ fntDescr
+ ].
+
].
^ listOfXFonts
- "Display listOfAvailableFonts"
+ "
+ Display listOfAvailableFonts
+ "
+!
+
+getAvailableFontsMatching:pattern
+ "return anArray filled with font names patching aPattern"
+
+%{ /* UNLIMITEDSTACK */
+
+ int nnames = 1500;
+ int available = nnames + 1;
+ char **fonts;
+ OBJ arr, str;
+ OBJ __ARRAY_NEW_INT(), _MKSTRING_INIT();
+ int i;
+
+ if (ISCONNECTED) {
+ if (__isString(pattern)) {
+ for (;;) {
+ fonts = XListFonts(myDpy, __stringVal(pattern), nnames, &available);
+ if ((fonts == NULL) || (available < nnames)) break;
+ XFreeFontNames(fonts);
+ nnames = available * 2;
+ }
+ if (fonts == NULL) {
+ RETURN ( nil );
+ }
+ arr = __ARRAY_NEW_INT(available);
+ if (! arr) {
+ RETURN (nil);
+ }
+ for (i=0; i<available; i++) {
+ PROTECT(arr);
+ str = _MKSTRING_INIT(fonts[i]);
+ UNPROTECT(arr);
+ __ArrayInstPtr(arr)->a_element[i] = str;
+ __STORE(arr, str);
+ }
+ RETURN (arr);
+ }
+ }
+%}.
+ ^ nil
!
getFontWithFamily:familyString face:faceString