[Squeak-fr]Créer une image (bmp,..) avec SmallTalk
Eric Winger
ewinger at keyww.com
Lun 12 Mai 12:43:55 CEST 2003
hmmm .... mon attachement n'a marche pas? Je vais essayer encore. Aussi,
j'ai copié les methodes dans la texte de c'email.
J'ai fait un 'fileout' parce que je ne veux pas de vous envoyer le plein
package avec beaucoup du poubelle. De tout façon, tu peux 'filein' ces
methodes et voir quoi nous avons fait.
J'espere que ce marche maintenant.
Pardonez-moi pour l'email longe.
eric
_____ le fichier 1 _______
<?xml version="1.0"?>
<st-source>
<time-stamp>From VisualWorks®, Release 7 of June 14, 2002 on May 12,
2003 at 11:27:11 am</time-stamp>
<methods>
<class-id>Graphics.ColorValue</class-id> <category>accessing</category>
<body package="Graphics-Support">blue
"Answer the blue component of the color in RGB space."
^ScaleValue * blue</body>
<body package="GraphicsExtensions">blueByte
^blue bitShift: -5</body>
<body package="Graphics-Support">brightness
"Answer the value component of the color in HSV space, a number
between 0 and 1."
^ScaleValue * ((red max: green) max: blue)</body>
<body package="Graphics-Support">cyan
"Answer the cyan component of the color in CMY space."
^ScaleValue * (MaxValue - red)</body>
<body package="GraphicsExtensions">distance: aColorValue
| r g b |
r := red - aColorValue scaledRed.
g := green - aColorValue scaledGreen.
b := blue - aColorValue scaledBlue.
^(r * r + (g * g) + (b * b)) sqrt * ScaleValue</body>
<body package="Graphics-Support">distanceFrom: aColorValue
" Answer a number representing the perceptual color distance from
aColorValue.
Note that we do not define the maximum value of the result. "
^(self distanceSquaredFrom: aColorValue) sqrt</body>
<body package="Graphics-Support">distanceSquaredFrom: aColorValue
"Answer the square of the perceptual color distance from aColorValue."
"For now, perform the calculation in RGB space. For more
accuracy, the calculation should use CIE Lab or CIE LUV*
space."
| rdiff gdiff bdiff |
rdiff := (red - aColorValue scaledRed).
gdiff := (green - aColorValue scaledGreen).
bdiff := (blue - aColorValue scaledBlue).
^(rdiff * rdiff) + (gdiff * gdiff) + (bdiff * bdiff)</body>
<body package="Graphics-Support">distanceSquaredFrom: aColorValue
ifLessThan: dist
"If the square of the perceptual color distance from aColorValue
is less than dist, answer the square of the distance,
otherwise answer nil."
"For now, perform the calculation in RGB space. For more
accuracy, the calculation should use CIE Lab or CIE LUV*
space."
| rdiff gdiff bdiff diff |
rdiff := (red - aColorValue scaledRed).
diff := (rdiff * rdiff).
diff >= dist ifTrue: [^nil].
gdiff := (green - aColorValue scaledGreen).
diff := diff + (gdiff * gdiff).
diff >= dist ifTrue: [^nil].
bdiff := (blue - aColorValue scaledBlue).
diff := diff + (bdiff * bdiff).
diff >= dist ifTrue: [^nil].
^diff</body>
<body package="Graphics-Support">green
"Answer the green component of the color in RGB space."
^ScaleValue * green</body>
<body package="GraphicsExtensions">greenByte
^green bitShift: -5</body>
<body package="Graphics-Support">hue
"Answer the hue component of the color in HSV space, a number
between 0 and 1."
| bright diff hue |
bright := (red max: green) max: blue.
diff := bright - ((red min: green) min: blue).
^diff = 0
ifTrue: [0]
ifFalse:
[diff := diff asFloat.
hue := bright = red
ifTrue: [(green - blue) / diff]
ifFalse:
[bright = green
ifTrue: [(blue - red) / diff + 2]
ifFalse: [(red - green) / diff + 4]].
hue < 0 ifTrue: [hue := hue + 6].
hue / 6]</body>
<body package="Graphics-Support">luminance
"Answer the Y component of the YIQ representation of the color.
The transformation assumes NTSC RGB primaries. It is adapted from
Hall, Illumination and Color in Computer Generated Imagery (corrects
an error in the blue scaling factor)."
^LuminanceScaleValue * self scaledLuminance</body>
<body package="Graphics-Support">luminanceScalingValue
"Answer the scaling value for luminance."
^MaxLuminanceValue</body>
<body package="Graphics-Support">magenta
"Answer the magenta component of the color in CMY space."
^ScaleValue * (MaxValue - green)</body>
<body package="Graphics-Support">red
"Answer the red component of the color in RGB space."
^ScaleValue * red</body>
<body package="GraphicsExtensions">redByte
^red bitShift: -5</body>
<body package="Graphics-Support">saturation
"Answer the saturation component of the color in HSV space, a number
between 0 and 1."
| bright diff |
bright := (red max: green) max: blue.
diff := bright - ((red min: green) min: blue).
^diff = 0
ifTrue: [0]
ifFalse: [diff asFloat / bright]</body>
<body package="Graphics-Support">scaledBlue
"Answer the scaled (integer) blue intensity."
^blue</body>
<body package="Graphics-Support">scaledGreen
"Answer the scaled (integer) green value."
^green</body>
<body package="Graphics-Support">scaledLuminance
" Answer the Y component of the YIQ representation of the color.
The transformation assumes NTSC RGB primaries. It is adapted from
Hall, Illumination and Color in Computer Generated Imagery (corrects
an error in the blue scaling factor). The result is scaled (multiplied)
by the value of MaxLuminance. "
^(299 * red) + (587 * green) + (114 * blue)</body>
<body package="Graphics-Support">scaledRed
"Answer the scaled (integer) red intensity."
^red</body>
<body package="Graphics-Support">scalingValue
"Answer the scaling value used to internally represent RGB components."
^MaxValue</body>
<body package="Graphics-Support">yellow
"Answer the yellow component of the color in CMY space."
^ScaleValue * (MaxValue - blue)</body>
</methods>
</st-source>
__________________ le fichier 2________________
<?xml version="1.0"?>
<st-source>
<time-stamp>From VisualWorks®, Release 7 of June 14, 2002 on May 12,
2003 at 8:23:29 am</time-stamp>
<methods>
<class-id>Graphics.Image</class-id> <category>Windows BMP</category>
<body package="GraphicsExtensions">bmpBitsPerPixel
^self bitsPerPixel</body>
<body package="GraphicsExtensions">bmpPaletteByteSize
^(palette isKindOf: MappedPalette)
ifTrue: [palette size]
ifFalse: [0]</body>
<body package="GraphicsExtensions">writeBMPDataFastOn: aStream
| tempLine |
tempLine := ByteArray new: rowByteSize.
self height - 1
to: 0
by: -1
do:
[:i |
self packedRowAt: i into: tempLine.
aStream nextPutAll: tempLine]</body>
<body package="GraphicsExtensions">writeBMPDataOn: aStream
| windowsBMPPalette |
windowsBMPPalette := FixedPalette
redShift: 0
redMask: 255
greenShift: 8
greenMask: 255
blueShift: 16
blueMask: 255.
palette = windowsBMPPalette
ifTrue: [self writeBMPDataFastOn: aStream]
ifFalse: [self writeBMPDataSlowOn: aStream]</body>
<body package="GraphicsExtensions">writeBMPDataSlowOn: aStream
| tempLine ws color |
tempLine := ByteArray new: (width * 3 / 4) ceiling * 4.
self height - 1 to: 0
by: -1
do:
[:y |
ws := tempLine writeStream.
0 to: width - 1
do:
[:x |
color := self valueAtX: x y: y.
ws
nextPut: color blueByte;
nextPut: color greenByte;
nextPut: color redByte].
aStream nextPutAll: tempLine]</body>
<body package="GraphicsExtensions">writeBMPFile: aFilenameOrString
| strm |
strm := aFilenameOrString asFilename writeStream.
strm binary.
[self writeBMPOn: strm] ensure: [strm close]</body>
<body package="GraphicsExtensions">writeBMPHeaderOn: aStream
aStream nextPutNativeUnsignedShort: 19778. "magical BM, backwards
for little endian"
aStream nextPutNativeUnsignedLong: 14 + 40 + (self
bmpPaletteByteSize * 4) + (self width * self height * self depth /
8). "total file size"
aStream nextPutAll: #[0 0 0 0]. "two reserved words"
aStream nextPutNativeUnsignedLong: 14 + 40 + (self
bmpPaletteByteSize * 4). "offset to data"
aStream nextPutNativeUnsignedLong: 40. "info header size"
aStream nextPutNativeLong: self width. "width"
aStream nextPutNativeLong: self height. "length or height"
aStream nextPutNativeUnsignedShort: 1. "planes, always 1"
aStream nextPutNativeUnsignedShort: self bmpBitsPerPixel. "bits
per pixel"
aStream nextPutNativeUnsignedLong: 0. "compression - none"
aStream nextPutNativeUnsignedLong: 0. "bitmap size, only
necessary if compressed, otherwise use zero"
aStream nextPutNativeLong: 0. "vertical resolution, no default"
aStream nextPutNativeLong: 0. "horizontal resolution, no default"
aStream nextPutNativeUnsignedLong: self bmpPaletteByteSize.
"number of colors"
"chance to indicate significant colors - do nothing for now"
aStream nextPutNativeUnsignedLong: 0</body>
<body package="GraphicsExtensions">writeBMPOn: aStream
self writeBMPHeaderOn: aStream.
palette writeBMPPaletteOn: aStream.
self writeBMPDataOn: aStream</body>
</methods>
</st-source>
_____ le fichier 3 _______
<st-source>
<time-stamp>From VisualWorks®, Release 7 of June 14, 2002 on May 12,
2003 at 11:37:44 am</time-stamp>
<methods>
<class-id>Core.Stream</class-id> <category>accessing</category>
<body package="Collections-Streams">contents
"Answer with a copy of the receiver's readable information."
self subclassResponsibility</body>
<body package="Collections-Streams">flush
"Write any unwritten information.
This is for compatibility with BufferedExternalStreams."
^self subclassResponsibility</body>
<body package="Collections-Streams">next
"Answer the next object in the receiver."
self subclassResponsibility</body>
<body package="Collections-Streams">next: anInteger
"Answer the next anInteger elements of the receiver."
| newCollection |
newCollection := self contentsSpecies new: anInteger.
^self next: anInteger into: newCollection startingAt: 1</body>
<body package="Collections-Streams">next: anInteger into:
aSequenceableCollection startingAt: startIndex
"Store the next anInteger elements of the receiver into
aSequenceableCollection
starting at startIndex in aSequenceableCollection. Answer
aSequenceableCollection."
| index stopIndex |
index := startIndex.
stopIndex := index + anInteger.
[[index < stopIndex]
whileTrue: [aSequenceableCollection at: index put: self
next.
index := index + 1]]
on: Stream endOfStreamSignal
do:
[:ex | ex retryUsing:
[(Stream incompleteNextCountSignal newExceptionFrom:
self)
parameter: index - startIndex;
raiseRequest]].
^aSequenceableCollection</body>
<body package="Collections-Streams">next: anInteger put: anObject
"Put anObject into the next anInteger elements of the receiver.
Answer anObject."
anInteger timesRepeat: [self nextPut: anObject].
^anObject</body>
<body package="Collections-Streams">next: anInteger putAll:
aSequenceableCollection startingAt: startIndex
"Store the anInteger elements of aSequenceableCollection starting
at startIndex into the next anInteger elements of the receiver.
Answer aSequenceableCollection"
startIndex to: startIndex + anInteger - 1 do:
[:index | self nextPut: (aSequenceableCollection at: index)].
^aSequenceableCollection</body>
<body package="Collections-Streams">nextAvailable: anInteger
"Answer the next anInteger elements of the receiver. If there are not
enough elements available, answer a collection of as many as are
available.
For example:
(ReadStream on: #(a b c)) next: 10
is an error
(ReadStream on: #(a b c)) nextAvailable: 10
answers (a b c )
"
| newCollection count |
newCollection := self contentsSpecies new: anInteger.
count := self nextAvailable: anInteger into: newCollection
startingAt: 1.
^count = anInteger
ifTrue: [newCollection]
ifFalse: [newCollection copyFrom: 1 to: count]</body>
<body package="Collections-Streams">nextAvailable: anInteger into:
aSequenceableCollection startingAt: startIndex
"Store the next anInteger elements of the receiver into
aSequenceableCollection
starting at startIndex in aSequenceableCollection. If there are not
enough elements
available, store as many as are available. Answer the number of
elements stored.
For example:
(ReadStream on: #(a b c)) next: 10 into: aSequenceableCollection
startingAt: 1
is an error
(ReadStream on: #(a b c)) nextAvailable: 10 into:
aSequenceableCollection startingAt: 1
answers 3
"
^ [self next: anInteger into: aSequenceableCollection startingAt:
startIndex.
anInteger]
on: Stream incompleteNextCountSignal
do: [:ex | ex return: ex parameter]</body>
<body package="BaseExtensions">nextLine
"Return the a collection of characters up to the next instance of cr."
^self upTo: Character cr</body>
<body package="Collections-Streams">nextMatchFor: anObject
"Read the next element and answer whether it is equal to anObject."
^anObject = self next</body>
<body package="Collections-Streams">nextPut: anObject
"Put the argument, anObject, at the next position in the receiver.
Answer anObject."
self subclassResponsibility</body>
<body package="Collections-Streams">nextPutAll: aCollection
"Put each of the elements of aCollection starting at the current
position of the receiver. Answer aCollection."
aCollection isSequenceable
ifTrue: [self next: aCollection size putAll: aCollection
startingAt: 1]
ifFalse: [aCollection do: [:v | self nextPut: v]].
^aCollection</body>
<body package="Collections-Streams">policy
^StreamPolicy default copy</body>
<body package="BaseExtensions">skipLine
"jump to the next instance of cr."
^self skipThrough: Character cr</body>
<body package="Collections-Streams">skipThrough: anObject
"Skip forward to the occurrence of anObject.
Leaves positioned after anObject.
If the object is not found the stream is positioned at the end and
nil is returned."
[self atEnd ifTrue: [^nil].
self next = anObject ifTrue: [^self]] repeat</body>
<body package="Collections-Streams">skipThroughAll: pattern
"Skip forward to the next occurrence (if any) of aCollection.
If found, leave the stream positioned after the occurrence,
and answer the receiver; if not found, answer nil,
and leave the stream positioned at the end."
^self upToAll: pattern returnMatch: false includePattern: false.</body>
<body package="Collections-Streams">through: anObject
"Answer a subcollection from the current position to the occurrence
(if any, inclusive)
of anObject. If not there, answer everything."
| newStream element |
newStream := (self contentsSpecies new: 64) writeStream.
[self atEnd]
whileFalse:
[element := self next.
newStream nextPut: element.
element = anObject ifTrue: [^newStream contents]].
^newStream contents</body>
<body package="Collections-Streams">throughAll: pattern
"Answer a subcollection from the current position to the occurrence
(if any, inclusive)
of pattern. If not there, answer everything."
^self upToAll: pattern returnMatch: true includePattern: true.</body>
<body package="Collections-Streams">upTo: anObject
"Answer a subcollection from position to the occurrence (if any,
exclusive) of anObject.
The stream is left positioned after anObject.
If anObject is not found answer everything."
| newStream element |
newStream := (self contentsSpecies new: 64) writeStream.
[self atEnd]
whileFalse:
[element := self next.
element = anObject
ifTrue: [^newStream contents].
newStream nextPut: element.].
^newStream contents</body>
<body package="Collections-Streams">upToAndSkipThroughAll: pattern
" Answer a subcollection from the current position
up to the occurrence (if any, not inclusive) of aCollection,
and leave the stream positioned after the occurrence.
If no occurrence is found, answer the entire remaining
stream contents, and leave the stream positioned at the end. "
^self upToAll: pattern returnMatch: true includePattern: false.</body>
<body package="Collections-Streams">upToEnd
"Answer a collection consisting of all the elements from the current
position
to the end of stream."
| newStream |
newStream := (self contentsSpecies new: 64) writeStream.
[self atEnd] whileFalse: [newStream nextPut: self next].
^newStream contents</body>
</methods>
<methods>
<class-id>Core.Stream</class-id> <category>binary numbers</category>
<body package="BaseExtensions">nextNativeDouble
^(self next: 8) doubleAt: 1</body>
<body package="BaseExtensions">nextNativeFloat
^(self next: 4) floatAt: 1</body>
<body package="BaseExtensions">nextNativeLong
^(self next: 4)
longAt: 1</body>
<body package="BaseExtensions">nextNativeShort
^(self next: 2) shortAt: 1</body>
<body package="BaseExtensions">nextNativeUnsignedLong
^(self next: 4) unsignedShortAt: 1</body>
<body package="BaseExtensions">nextNativeUnsignedShort
^(self next: 2) unsignedShortAt: 1</body>
<body package="BaseExtensions">nextPutNativeDouble: aDouble
self nextPutAll: ((ByteArray new: 8)
doubleAt: 1 put: aDouble;
yourself)</body>
<body package="BaseExtensions">nextPutNativeFloat: aFloat
self nextPutAll: ((ByteArray new: 4)
floatAt: 1 put: aFloat;
yourself)</body>
<body package="BaseExtensions">nextPutNativeLong: anInteger
self nextPutAll: ((ByteArray new: 4)
longAt: 1 put: anInteger; yourself)</body>
<body package="BaseExtensions">nextPutNativeShort: anInteger
self nextPutAll: ((ByteArray new: 2)
shortAt: 1 put: anInteger;
yourself)</body>
<body package="BaseExtensions">nextPutNativeUnsignedLong: anInteger
self nextPutAll: ((ByteArray new: 4)
unsignedLongAt: 1 put: anInteger; yourself)</body>
<body package="BaseExtensions">nextPutNativeUnsignedShort: anInteger
self nextPutAll: ((ByteArray new: 2)
unsignedShortAt: 1 put: anInteger;
yourself)</body>
</methods>
<methods>
<class-id>Core.Stream</class-id> <category>character writing</category>
<body package="Collections-Streams">cr
"Append a return character to the receiver."
self nextPut: Character cr</body>
<body package="Collections-Streams">crtab
"Append a return character, followed by a single tab character, to
the receiver."
self cr; tab</body>
<body package="Collections-Streams">crtab: anInteger
"Append a return character, followed by anInteger tab characters, to
the receiver."
self cr; tab: anInteger</body>
<body package="Collections-Streams">emphasis
"Answer nil."
"Allows compatibility with streams which carry emphasis"
^nil</body>
<body package="Collections-Streams">emphasis: ignored
"Ignore this message."
"Allows compatibility with streams which carry emphasis"
^self</body>
<body package="BaseExtensions">lf
self nextPut: Character lf</body>
<body package="BaseExtensions">nextPutLine: aString
"This is character specific, so we can ASSUME that the collection is
indeed sequenceable"
self nextPutAll: aString.
self cr.
^aString</body>
<body package="Collections-Streams">space
"Append a space character to the receiver."
self nextPut: Character space</body>
<body package="Collections-Streams">tab
"Append a tab character to the receiver."
self nextPut: Character tab</body>
<body package="Collections-Streams">tab: anInteger
"Append anInteger tab characters to the receiver."
anInteger timesRepeat: [self tab]</body>
</methods>
</st-source>
-------------- section suivante --------------
Une pièce jointe HTML a été enlevée...
URL: http://lnx-12.ams-2.theinternetone.net/pipermail/squeak-fr/attachments/20030512/7243a118/WindowsBMP.htm
-------------- section suivante --------------
Une pièce jointe HTML a été enlevée...
URL: http://lnx-12.ams-2.theinternetone.net/pipermail/squeak-fr/attachments/20030512/7243a118/ColorValue-accessing.htm
-------------- section suivante --------------
Une pièce jointe HTML a été enlevée...
URL: http://lnx-12.ams-2.theinternetone.net/pipermail/squeak-fr/attachments/20030512/7243a118/Stream-accessing.htm
Plus d'informations sur la liste de diffusion Squeak-fr