Christoph Thiede uploaded a new version of Graphics to project The Trunk:
http://source.squeak.org/trunk/Graphics-ct.457.mcz
==================== Summary ====================
Name: Graphics-ct.457
Author: ct
Time: 3 January 2022, 9:19:39.486397 pm
UUID: fd7bbdad-6898-7041-8182-7fea4f36fbee
Ancestors: Graphics-mt.456
Improves multilingual support in Graphics-Files. Also includes a few recategorizations and removes two outdated helper methods.
=============== Diff against Graphics-mt.456 ===============
Item was changed:
----- Method: BMPReadWriter>>nextPutImage: (in category 'writing') -----
nextPutImage: aForm
| bhSize rowBytes rgb data colorValues depth image ppw scanLineLen pixline |
depth := aForm depth.
depth := #(1 4 8 32 ) detect: [ :each | each >= depth].
image := aForm asFormOfDepth: depth.
image unhibernate.
bhSize := 14. "# bytes in file header"
biSize := 40. "info header size in bytes"
biWidth := image width.
biHeight := image height.
biClrUsed := depth = 32 ifTrue: [0] ifFalse:[1 << depth]. "No. color table entries"
bfOffBits := biSize + bhSize + (4*biClrUsed).
rowBytes := ((depth min: 24) * biWidth + 31 // 32) * 4.
biSizeImage := biHeight * rowBytes.
"Write the file header"
stream position: 0.
stream nextLittleEndianNumber: 2 put: 19778. "bfType = BM"
stream nextLittleEndianNumber: 4 put: bfOffBits + biSizeImage. "Entire file size in bytes"
stream nextLittleEndianNumber: 4 put: 0. "bfReserved"
stream nextLittleEndianNumber: 4 put: bfOffBits. "Offset of bitmap data from start of hdr (and file)"
"Write the bitmap info header"
stream position: bhSize.
stream nextLittleEndianNumber: 4 put: biSize. "info header size in bytes"
stream nextLittleEndianNumber: 4 put: image width. "biWidth"
stream nextLittleEndianNumber: 4 put: image height. "biHeight"
stream nextLittleEndianNumber: 2 put: 1. "biPlanes"
stream nextLittleEndianNumber: 2 put: (depth min: 24). "biBitCount"
stream nextLittleEndianNumber: 4 put: 0. "biCompression"
stream nextLittleEndianNumber: 4 put: biSizeImage. "size of image section in bytes"
stream nextLittleEndianNumber: 4 put: 2800. "biXPelsPerMeter"
stream nextLittleEndianNumber: 4 put: 2800. "biYPelsPerMeter"
stream nextLittleEndianNumber: 4 put: biClrUsed.
stream nextLittleEndianNumber: 4 put: 0. "biClrImportant"
biClrUsed > 0 ifTrue: [
"write color map; this works for ColorForms, too"
colorValues := image colormapIfNeededForDepth: 32.
1 to: biClrUsed do: [:i |
rgb := colorValues at: i.
0 to: 24 by: 8 do: [:j | stream nextPut: (rgb >> j bitAnd: 16rFF)]]].
depth < 32 ifTrue: [
"depth = 1, 4 or 8."
data := image bits asByteArray.
ppw := 32 // depth.
scanLineLen := biWidth + ppw - 1 // ppw * 4. "# of bytes in line"
1 to: biHeight do: [:i |
stream next: scanLineLen putAll: data startingAt: (biHeight-i)*scanLineLen+1.
].
] ifFalse: [
data := image bits.
pixline := ByteArray new: (((biWidth * 3 + 3) // 4) * 4).
1 to: biHeight do:[:i |
self store24BitBmpLine: pixline from: data startingAt: (biHeight-i)*biWidth+1 width: biWidth.
stream nextPutAll: pixline.
].
].
+ stream position = (bfOffBits + biSizeImage) ifFalse: [self error: 'Write failure' translated].
- stream position = (bfOffBits + biSizeImage) ifFalse: [self error:'Write failure'].
stream close.!
Item was changed:
----- Method: GIFReadWriter class>>grabScreenAndSaveOnDisk (in category 'examples') -----
grabScreenAndSaveOnDisk
"GIFReadWriter grabScreenAndSaveOnDisk"
| form fileName |
form := Form fromUser.
form bits size = 0 ifTrue: [^Beeper beep].
fileName := FileDirectory default nextNameFor: 'Squeak' extension: 'gif'.
+ Project uiManager
+ informUser: ('Writing {1}' translated format: {fileName})
+ during: [GIFReadWriter putForm: form onFileNamed: fileName].!
- UIManager default informUser: 'Writing ' , fileName
- during: [GIFReadWriter putForm: form onFileNamed: fileName]!
Item was changed:
----- Method: GIFReadWriter>>nextImage (in category 'accessing') -----
nextImage
"Read in the next GIF image from the stream."
| f thisImageColorTable |
localColorTable := nil.
self readHeader.
f := self readBody.
self close.
+ f == nil ifTrue: [^ self error: 'corrupt GIF file' translated].
- f == nil ifTrue: [^ self error: 'corrupt GIF file'].
thisImageColorTable := localColorTable ifNil: [colorPalette].
transparentIndex ifNotNil: [
transparentIndex + 1 > thisImageColorTable size ifTrue: [
thisImageColorTable := thisImageColorTable
forceTo: transparentIndex + 1
paddingWith: Color white
].
thisImageColorTable at: transparentIndex + 1 put: Color transparent
].
f colors: thisImageColorTable.
^ f
!
Item was changed:
----- Method: GIFReadWriter>>readBitData (in category 'private-decoding') -----
readBitData
"using modified Lempel-Ziv Welch algorithm."
| outCodes outCount bitMask initCodeSize code curCode oldCode inCode finChar i bytes f c packedBits hasLocalColor localColorSize maxOutCodes |
maxOutCodes := 4096.
offset := self readWord@self readWord. "Image Left@Image Top"
width := self readWord.
height := self readWord.
"---
Local Color Table Flag 1 Bit
Interlace Flag 1 Bit
Sort Flag 1 Bit
Reserved 2 Bits
Size of Local Color Table 3 Bits
----"
packedBits := self next.
interlace := (packedBits bitAnd: 16r40) ~= 0.
hasLocalColor := (packedBits bitAnd: 16r80) ~= 0.
localColorSize := 1 bitShift: ((packedBits bitAnd: 16r7) + 1).
hasLocalColor ifTrue: [localColorTable := self readColorTable: localColorSize].
pass := 0.
xpos := 0.
ypos := 0.
rowByteSize := ((width + 3) // 4) * 4.
remainBitCount := 0.
bufByte := 0.
bufStream := ReadStream on: ByteArray new.
outCodes := ByteArray new: maxOutCodes + 1.
outCount := 0.
bitMask := (1 bitShift: bitsPerPixel) - 1.
prefixTable := Array new: 4096.
suffixTable := Array new: 4096.
initCodeSize := self next.
self setParameters: initCodeSize.
+ bitsPerPixel > 8 ifTrue: [^self error: ('never heard of a GIF that deep (depth = {1})' translated format: {bitsPerPixel})].
- bitsPerPixel > 8 ifTrue: [^self error: 'never heard of a GIF that deep'].
bytes := ByteArray new: rowByteSize * height.
[(code := self readCode) = eoiCode] whileFalse:
[code = clearCode
ifTrue:
[self setParameters: initCodeSize.
curCode := oldCode := code := self readCode.
finChar := curCode bitAnd: bitMask.
"Horrible hack to avoid running off the end of the bitmap. Seems to cure problem reading some gifs!!? tk 6/24/97 20:16"
xpos = 0 ifTrue: [
ypos < height ifTrue: [
bytes at: (ypos * rowByteSize) + xpos + 1 put: finChar]]
ifFalse: [bytes at: (ypos * rowByteSize) + xpos + 1 put: finChar].
self updatePixelPosition]
ifFalse:
[curCode := inCode := code.
curCode >= freeCode ifTrue:
[curCode := oldCode.
outCodes at: (outCount := outCount + 1) put: finChar].
[curCode > bitMask] whileTrue:
[outCount > maxOutCodes
+ ifTrue: [^self error: ('corrupt GIF file ({1})' translated format: {'OutCount'})].
- ifTrue: [^self error: 'corrupt GIF file (OutCount)'].
outCodes at: (outCount := outCount + 1)
put: (suffixTable at: curCode + 1).
curCode := prefixTable at: curCode + 1].
finChar := curCode bitAnd: bitMask.
outCodes at: (outCount := outCount + 1) put: finChar.
i := outCount.
[i > 0] whileTrue:
["self writePixel: (outCodes at: i) to: bits"
bytes at: (ypos * rowByteSize) + xpos + 1 put: (outCodes at: i).
self updatePixelPosition.
i := i - 1].
outCount := 0.
prefixTable at: freeCode + 1 put: oldCode.
suffixTable at: freeCode + 1 put: finChar.
oldCode := inCode.
freeCode := freeCode + 1.
self checkCodeSize]].
prefixTable := suffixTable := nil.
f := ColorForm extent: width@height depth: 8.
f bits copyFromByteArray: bytes.
"Squeak can handle depths 1, 2, 4, and 8"
bitsPerPixel > 4 ifTrue: [^ f].
"reduce depth to save space"
c := ColorForm extent: width@height
depth: (bitsPerPixel = 3 ifTrue: [4] ifFalse: [bitsPerPixel]).
f displayOn: c.
+ ^ c!
- ^ c
- !
Item was changed:
----- Method: GIFReadWriter>>readHeader (in category 'private-decoding') -----
readHeader
| is89 byte hasColorMap |
(self hasMagicNumber: 'GIF87a' asByteArray)
ifTrue: [is89 := false]
ifFalse: [(self hasMagicNumber: 'GIF89a' asByteArray)
ifTrue: [is89 := true]
+ ifFalse: [^ self error: 'This does not appear to be a GIF file' translated]].
- ifFalse: [^ self error: 'This does not appear to be a GIF file']].
self readWord. "skip Screen Width"
self readWord. "skip Screen Height"
byte := self next.
hasColorMap := (byte bitAnd: 16r80) ~= 0.
bitsPerPixel := (byte bitAnd: 7) + 1.
byte := self next. "skip background color."
self next ~= 0
ifTrue: [is89
+ ifFalse: [^self error: ('corrupt GIF file ({1})' translated format: {'screen descriptor'})]].
- ifFalse: [^self error: 'corrupt GIF file (screen descriptor)']].
hasColorMap
ifTrue:
[colorPalette := self readColorTable: (1 bitShift: bitsPerPixel)]
ifFalse:
["Transcript cr; show: 'GIF file does not have a color map.'."
colorPalette := nil "Palette monochromeDefault"].!
Item was changed:
----- Method: GIFReadWriter>>updatePixelPosition (in category 'private') -----
updatePixelPosition
(xpos := xpos + 1) >= width ifFalse: [^self].
xpos := 0.
interlace
ifFalse: [ypos := ypos + 1. ^self].
pass = 0 ifTrue:
[(ypos := ypos + 8) >= height
ifTrue:
[pass := pass + 1.
ypos := 4].
^self].
pass = 1 ifTrue:
[(ypos := ypos + 8) >= height
ifTrue:
[pass := pass + 1.
ypos := 2].
^self].
pass = 2 ifTrue:
[(ypos := ypos + 4) >= height
ifTrue:
[pass := pass + 1.
ypos := 1].
^self].
pass = 3 ifTrue:
[ypos := ypos + 2.
^self].
+ ^pass caseError!
- ^self error: 'can''t happen'!
Item was changed:
----- Method: ImageReadWriter class>>formFromStream: (in category 'image reading/writing') -----
formFromStream: aBinaryStream
"Answer a ColorForm stored on the given stream. closes the stream"
| reader readerClass form |
readerClass := self withAllSubclasses
detect: [:subclass |
aBinaryStream reset.
subclass understandsImageFormat: aBinaryStream]
ifNone: [
aBinaryStream close.
+ ^self error: 'image format not recognized' translated].
- ^self error: 'image format not recognized'].
aBinaryStream reset.
reader := readerClass new on: aBinaryStream.
Cursor read showWhile: [
form := reader nextImage.
reader close].
^ form
!
Item was changed:
----- Method: ImageReadWriter>>changePadOfBits:width:height:depth:from:to: (in category 'private') -----
changePadOfBits: bits width: width height: height depth: depth from: oldPad
to: newPad
"Change padding size of bits."
| srcRowByteSize dstRowByteSize newBits srcRowBase rowEndOffset |
(#(8 16 32) includes: oldPad)
+ ifFalse: [^self error: ('Invalid pad: {1}' translated format: {oldPad})].
- ifFalse: [^self error: 'Invalid pad: ', oldPad printString].
(#(8 16 32) includes: newPad)
+ ifFalse: [^self error: ('Invalid pad: {1}' translated format: {newPad})].
- ifFalse: [^self error: 'Invalid pad: ', newPad printString].
srcRowByteSize := width * depth + oldPad - 1 // oldPad * (oldPad / 8).
srcRowByteSize * height = bits size
+ ifFalse: [^self error: 'Incorrect bitmap array size.' translated].
- ifFalse: [^self error: 'Incorrect bitmap array size.'].
dstRowByteSize := width * depth + newPad - 1 // newPad * (newPad / 8).
newBits := ByteArray new: dstRowByteSize * height.
srcRowBase := 1.
rowEndOffset := dstRowByteSize - 1.
1 to: newBits size by: dstRowByteSize do:
[:dstRowBase |
newBits replaceFrom: dstRowBase
to: dstRowBase + rowEndOffset
with: bits
startingAt: srcRowBase.
srcRowBase := srcRowBase + srcRowByteSize].
^newBits!
Item was changed:
----- Method: ImageReadWriter>>unpackBits:depthTo8From:with:height:pad: (in category 'private') -----
unpackBits: bits depthTo8From: depth with: width height: height pad: pad
"Unpack bits of depth 1, 2, or 4 image to it of depth 8 image."
| bitMask pixelInByte bitsWidth upBitsWidth stopWidth
trailingSize upBits bitIndex upBitIndex val |
(#(1 2 4) includes: depth)
+ ifFalse: [^self error: 'depth must be 1, 2, or 4' translated].
- ifFalse: [^self error: 'depth must be 1, 2, or 4'].
(#(8 16 32) includes: pad)
+ ifFalse: [^self error: 'pad must be 8, 16, or 32' translated].
- ifFalse: [^self error: 'pad must be 8, 16, or 32'].
bitMask := (1 bitShift: depth) - 1.
pixelInByte := 8 / depth.
bitsWidth := width * depth + pad - 1 // pad * (pad / 8).
upBitsWidth := width * 8 + pad - 1 // pad * (pad / 8).
stopWidth := width * depth + 7 // 8.
trailingSize := width - (stopWidth - 1 * pixelInByte).
upBits := ByteArray new: upBitsWidth * height.
1 to: height do: [:i |
bitIndex := i - 1 * bitsWidth.
upBitIndex := i - 1 * upBitsWidth.
1 to: stopWidth - 1 do: [:j |
val := bits at: (bitIndex := bitIndex + 1).
upBitIndex := upBitIndex + pixelInByte.
1 to: pixelInByte do: [:k |
upBits at: (upBitIndex - k + 1) put: (val bitAnd: bitMask).
val := val bitShift: depth negated]].
val := (bits at: (bitIndex := bitIndex + 1))
bitShift: depth negated * (pixelInByte - trailingSize).
upBitIndex := upBitIndex + trailingSize.
1 to: trailingSize do: [:k |
upBits at: (upBitIndex - k + 1) put: (val bitAnd: bitMask).
val := val bitShift: depth negated]].
^ upBits
!
Item was changed:
----- Method: JPEGReadStream>>decodeValueFrom: (in category 'huffman trees') -----
decodeValueFrom: table
"Decode the next value in the receiver using the given huffman table."
| bits bitsNeeded tableIndex value |
bitsNeeded := (table at: 1) bitShift: -24. "Initial bits needed"
tableIndex := 2. "First real table"
[bits := self getBits: bitsNeeded. "Get bits"
value := table at: (tableIndex + bits). "Lookup entry in table"
(value bitAnd: 16r3F000000) = 0] "Check if it is a non-leaf node"
whileFalse:["Fetch sub table"
tableIndex := value bitAnd: 16rFFFF. "Table offset in low 16 bit"
bitsNeeded := (value bitShift: -24) bitAnd: 255. "Additional bits in high 8 bit"
+ bitsNeeded > MaxBits ifTrue:[^self error: 'Invalid huffman table entry' translated]].
- bitsNeeded > MaxBits ifTrue:[^self error:'Invalid huffman table entry']].
^value!
Item was changed:
----- Method: JPEGReadStream>>getBits: (in category 'accessing') -----
getBits: requestedBits
| value |
requestedBits > bitsInBuffer ifTrue:[
self fillBuffer.
requestedBits > bitsInBuffer ifTrue:[
+ self error: 'not enough bits available to decode' translated]].
- self error: 'not enough bits available to decode']].
value := bitBuffer bitShift: (requestedBits - bitsInBuffer).
bitBuffer := bitBuffer bitAnd: (1 bitShift: (bitsInBuffer - requestedBits)) -1.
bitsInBuffer := bitsInBuffer - requestedBits.
^ value!
Item was changed:
----- Method: JPEGReadWriter>>nextImageDitheredToDepth: (in category 'public access') -----
nextImageDitheredToDepth: depth
| form xStep yStep x y bb |
ditherMask := DitherMasks
at: depth
+ ifAbsent: [self error: 'can only dither to display depths' translated].
- ifAbsent: [self error: 'can only dither to display depths'].
residuals := WordArray new: 3.
sosSeen := false.
self parseFirstMarker.
[sosSeen] whileFalse: [self parseNextMarker].
form := Form extent: (width @ height) depth: depth.
bb := BitBlt toForm: form.
bb sourceForm: mcuImageBuffer.
bb colorMap: (mcuImageBuffer colormapIfNeededFor: form).
bb sourceRect: mcuImageBuffer boundingBox.
bb combinationRule: Form over.
xStep := mcuWidth * DCTSize.
yStep := mcuHeight * DCTSize.
y := 0.
1 to: mcuRowsInScan do:
[:row |
x := 0.
1 to: mcusPerRow do:
[:col |
self decodeMCU.
self idctMCU.
self colorConvertMCU.
bb destX: x; destY: y; copyBits.
x := x + xStep].
y := y + yStep].
^ form!
Item was removed:
- ----- Method: JPEGReadWriter>>notSupported: (in category 'error handling') -----
- notSupported: aString
-
- self error: aString , ' is not currently supported'!
Item was changed:
----- Method: JPEGReadWriter>>parseAPPn (in category 'marker parsing') -----
parseAPPn
| length buffer thumbnailLength markerStart |
markerStart := self position.
length := self nextWord.
buffer := self next: 4.
(buffer asString = 'JFIF') ifFalse: [
"Skip APPs that we're not interested in"
stream next: length-6.
^self].
self next.
majorVersion := self next.
minorVersion := self next.
densityUnit := self next.
xDensity := self nextWord.
yDensity := self nextWord.
thumbnailLength := self next * self next * 3.
length := length - (self position - markerStart).
+ length = thumbnailLength ifFalse: [self error: 'APP0 thumbnail length is incorrect.' translated].
- length = thumbnailLength ifFalse: [self error: 'APP0 thumbnail length is incorrect.'].
self next: length!
Item was changed:
----- Method: JPEGReadWriter>>parseDecoderRestartInterval (in category 'marker parsing') -----
parseDecoderRestartInterval
| length |
length := self nextWord.
+ length = 4 ifFalse: [self error: 'DRI length is incorrect.' translated].
- length = 4 ifFalse: [self error: 'DRI length incorrect'].
restartInterval := self nextWord.!
Item was changed:
----- Method: JPEGReadWriter>>parseFirstMarker (in category 'marker parsing') -----
parseFirstMarker
| marker |
+ self next = 16rFF ifFalse: [self error: 'JFIF marker expected' translated].
- self next = 16rFF ifFalse: [self error: 'JFIF marker expected'].
marker := self next.
marker = 16rD9
ifTrue: [^self "halt: 'EOI encountered.'"].
+ marker = 16rD8 ifFalse: [self error: 'SOI marker expected' translated].
- marker = 16rD8 ifFalse: [self error: 'SOI marker expected'].
self parseStartOfInput.
!
Item was changed:
----- Method: JPEGReadWriter>>parseHuffmanTable (in category 'marker parsing') -----
parseHuffmanTable
| length markerStart index bits count huffVal isACTable hTable |
markerStart := self position.
length := self nextWord.
[self position - markerStart >= length] whileFalse:
[index := self next.
isACTable := (index bitAnd: 16r10) ~= 0.
index := (index bitAnd: 16r0F) + 1.
index > HuffmanTableSize
+ ifTrue: [self error: ('image has more than {1} quantization tables' translated format: {HuffmanTableSize})].
- ifTrue: [self error: 'image has more than ', HuffmanTableSize printString,
- ' quantization tables'].
bits := self next: 16.
count := bits sum.
(count > 256 or: [(count > (length - (self position - markerStart)))])
+ ifTrue: [self error: 'Huffman Table count is incorrect' translated].
- ifTrue: [self error: 'Huffman Table count is incorrect'].
huffVal := self next: count.
hTable := stream buildLookupTable: huffVal counts: bits.
isACTable
ifTrue:
[self hACTable at: index put: hTable]
ifFalse:
[self hDCTable at: index put: hTable]].!
Item was changed:
----- Method: JPEGReadWriter>>parseNextMarker (in category 'marker parsing') -----
parseNextMarker
"Parse the next marker of the stream"
| byte discardedBytes |
discardedBytes := 0.
[(byte := self next) = 16rFF] whileFalse: [discardedBytes := discardedBytes + 1].
[[(byte := self next) = 16rFF] whileTrue. byte = 16r00] whileTrue:
[discardedBytes := discardedBytes + 2].
discardedBytes > 0 ifTrue: [self "notifyWithLabel: 'warning: extraneous data discarded'"].
self perform:
(JFIFMarkerParser
at: byte
ifAbsent:
[(self okToIgnoreMarker: byte)
ifTrue: [#skipMarker]
+ ifFalse: [self error: ('marker {1} cannot be handled' translated format: {byte printStringHex})]])!
- ifFalse: [self error: 'marker ', byte printStringHex , ' cannot be handled']])!
Item was changed:
----- Method: JPEGReadWriter>>parseQuantizationTable (in category 'marker parsing') -----
parseQuantizationTable
| length markerStart n prec value table |
markerStart := self position.
length := self nextWord.
[self position - markerStart >= length] whileFalse:
[value := self next.
n := (value bitAnd: 16r0F) + 1.
prec := (value >> 4) > 0.
n > QuantizationTableSize
+ ifTrue: [self error: ('image has more than {1} quantization tables' translated format: {QuantizationTableSize})].
- ifTrue: [self error: 'image has more than ',
- QuantizationTableSize printString,
- ' quantization tables'].
table := IntegerArray new: DCTSize2.
1 to: DCTSize2 do:
[:i |
value := (prec
ifTrue: [self nextWord]
ifFalse: [self next]).
table at: (JPEGNaturalOrder at: i) put: value].
self useFloatingPoint ifTrue: [self scaleQuantizationTable: table].
self qTable at: n put: table]!
Item was changed:
----- Method: JPEGReadWriter>>parseStartOfFile (in category 'marker parsing') -----
parseStartOfFile
| length markerStart value n |
markerStart := self position.
length := self nextWord.
dataPrecision := self next.
dataPrecision = 8
+ ifFalse: [self error: ('cannot handle {1}-bit components' translated format: {dataPrecision})].
- ifFalse: [self error: 'cannot handle ', dataPrecision printString, '-bit components'].
height := self nextWord.
width := self nextWord.
n := self next.
+ (height = 0) | (width = 0) | (n = 0) ifTrue: [self error: 'empty image' translated].
- (height = 0) | (width = 0) | (n = 0) ifTrue: [self error: 'empty image'].
(length - (self position - markerStart)) ~= (n * 3)
+ ifTrue: [self error: 'component length is incorrect' translated].
- ifTrue: [self error: 'component length is incorrect'].
components := Array new: n.
1 to: components size do:
[:i |
components
at: i
put:
(JPEGColorComponent new
id: self next;
"heightInBlocks: (((value := self next) >> 4) bitAnd: 16r0F);
widthInBlocks: (value bitAnd: 16r0F);"
widthInBlocks: (((value := self next) >> 4) bitAnd: 16r0F);
heightInBlocks: (value bitAnd: 16r0F);
qTableIndex: self next + 1)]!
Item was changed:
----- Method: JPEGReadWriter>>parseStartOfScan (in category 'marker parsing') -----
parseStartOfScan
| length n id value dcNum acNum comp |
length := self nextWord.
n := self next.
+ (length ~= (n*2 + 6)) | (n < 1) ifTrue: [self error: 'SOS length is incorrect' translated].
- (length ~= (n*2 + 6)) | (n < 1) ifTrue: [self error: 'SOS length is incorrect'].
currentComponents := Array new: n.
1 to: n do: [:i |
id := self next.
value := self next.
dcNum := (value >> 4) bitAnd: 16r0F.
acNum := value bitAnd: 16r0F.
comp := components detect: [:c | c id = id].
comp
dcTableIndex: dcNum+1;
acTableIndex: acNum+1.
currentComponents at: i put: comp].
ss := self next.
se := self next.
value := self next.
ah := (value >> 4) bitAnd: 16r0F.
al := value bitAnd: 16r0F.
self initialSOSSetup.
self perScanSetup.
sosSeen := true!
Item was changed:
----- Method: JPEGReadWriter>>perScanSetup (in category 'marker parsing') -----
perScanSetup
mcusPerRow := (width / (mcuWidth * DCTSize)) ceiling.
mcuRowsInScan := (height / (mcuHeight * DCTSize)) ceiling.
(currentComponents size = 3 or: [currentComponents size = 1])
+ ifFalse: [self error: 'JPEG color space not recognized' translated].
- ifFalse: [self error: 'JPEG color space not recognized'].
mcuMembership := OrderedCollection new.
currentComponents withIndexDo:
[:c :i |
c priorDCValue: 0.
mcuMembership addAll: ((1 to: c totalMcuBlocks) collect: [:b | i])].
mcuMembership := mcuMembership asArray.
mcuSampleBuffer := (1 to: mcuMembership size) collect: [:i | IntegerArray new: DCTSize2].
currentComponents withIndexDo:
[:c :i |
c initializeSampleStreamBlocks:
((1 to: mcuMembership size)
select: [:j | i = (mcuMembership at: j)]
thenCollect: [:j | mcuSampleBuffer at: j])].
mcuImageBuffer := Form
extent: (mcuWidth @ mcuHeight) * DCTSize
depth: 32.
restartsToGo := restartInterval.!
Item was changed:
----- Method: JPEGReadWriter2>>compress:quality: (in category 'public access') -----
compress: aForm quality: quality
"Encode the given Form and answer the compressed ByteArray. Quality goes from 0 (low) to 100 (high), where -1 means default.
We can only compress:
* 32-bit deep Forms
* -32-bit deep Forms
* 16-bit deep Forms
* -16-bit deep Forms
* GrayScale ColorForms (see #isGrayScale)"
| sourceForm jpegCompressStruct jpegErrorMgr2Struct buffer byteCount |
aForm unhibernate.
sourceForm := self supports8BitGrayscaleJPEGs
ifTrue: [
(aForm depth = 32) | (aForm depth = 16) | (aForm isGrayScale)
ifTrue: [aForm]
ifFalse: [aForm asFormOfDepth: 32 ]]
ifFalse: [
(aForm nativeDepth > 0) & ((aForm depth = 32) | ((aForm depth = 16) & (aForm width even)))
ifTrue: [aForm]
ifFalse: [aForm asFormOfDepth: 32 ]].
jpegCompressStruct := ByteArray new: self primJPEGCompressStructSize.
jpegErrorMgr2Struct := ByteArray new: self primJPEGErrorMgr2StructSize.
buffer := ByteArray new: sourceForm width * sourceForm height + 1024.
byteCount := self primJPEGWriteImage: jpegCompressStruct
onByteArray: buffer
form: sourceForm
quality: quality
progressiveJPEG: false
errorMgr: jpegErrorMgr2Struct.
+ byteCount = 0 ifTrue: [self error: 'buffer too small for compressed data' translated].
- byteCount = 0 ifTrue: [self error: 'buffer too small for compressed data'].
^ buffer copyFrom: 1 to: byteCount
!
Item was changed:
----- Method: JPEGReadWriter2>>nextPutImage:quality:progressiveJPEG: (in category 'public access') -----
nextPutImage: aForm quality: quality progressiveJPEG: progressiveFlag
"Encode the given Form on my stream with the given settings. Quality goes from 0 (low) to 100 (high), where -1 means default. If progressiveFlag is true, encode as a progressive JPEG.
We can compress:
* 32-bit deep Forms
* -32-bit deep Forms
* 16-bit deep
* -16-bit deep
* GrayScale ColorForms (see #isGrayScale)"
| sourceForm jpegCompressStruct jpegErrorMgr2Struct buffer byteCount |
aForm unhibernate.
sourceForm := self supports8BitGrayscaleJPEGs
ifTrue: [
(aForm depth = 32) | (aForm depth = 16) | (aForm isGrayScale)
ifTrue: [aForm]
ifFalse: [aForm asFormOfDepth: 32 ]]
ifFalse: [
(aForm nativeDepth > 0) & ((aForm depth = 32) | ((aForm depth = 16) & (aForm width even)))
ifTrue: [aForm]
ifFalse: [aForm asFormOfDepth: 32 ]].
jpegCompressStruct := ByteArray new: self primJPEGCompressStructSize.
jpegErrorMgr2Struct := ByteArray new: self primJPEGErrorMgr2StructSize.
buffer := ByteArray new: sourceForm width * sourceForm height + 1024.
"Try to write the image. Retry with a larger buffer if needed."
[
byteCount := self primJPEGWriteImage: jpegCompressStruct
onByteArray: buffer
form: sourceForm
quality: quality
progressiveJPEG: progressiveFlag
errorMgr: jpegErrorMgr2Struct.
byteCount = 0 and: [ buffer size < (sourceForm width * sourceForm height * 3 + 1024) ] ]
whileTrue: [ buffer := ByteArray new: buffer size * 2 ].
+ byteCount = 0 ifTrue: [ self error: 'buffer too small for compressed data' translated ].
- byteCount = 0 ifTrue: [ self error: 'buffer too small for compressed data' ].
stream next: byteCount putAll: buffer startingAt: 1.
self close.
!
Item was changed:
----- Method: JPEGReadWriter2>>uncompress:into:doDithering: (in category 'public access') -----
uncompress: aByteArray into: aForm doDithering: ditherFlag
"Uncompress an image from the given ByteArray into the given Form.
Fails if the given Form has the wrong dimensions or depth.
We can read RGB JPEGs into:
* 32-bit Forms
* -32-bit Forms
* 16-bit Forms (with or without dithering!!)
* -16-bit Forms (with or without dithering!!)
We can read grayscale JPEGs into:
* 32-bit Forms
* -32-bit Forms
* 16-bit Forms (with or without dithering!!)
* -16-bit Forms (with or without dithering!!)
* 8-bit grayScale ColorForms (see #isGrayScale)
* -8-bit grayScale ColorForms (see #isGrayScale)"
| jpegDecompressStruct jpegErrorMgr2Struct width height components |
aForm unhibernate.
jpegDecompressStruct := ByteArray new: self primJPEGDecompressStructSize.
jpegErrorMgr2Struct := ByteArray new: self primJPEGErrorMgr2StructSize.
self
primJPEGReadHeader: jpegDecompressStruct
fromByteArray: aByteArray
errorMgr: jpegErrorMgr2Struct.
width := self primImageWidth: jpegDecompressStruct.
height := self primImageHeight: jpegDecompressStruct.
components := self primImageNumComponents: jpegDecompressStruct.
((aForm width = width) & (aForm height = height)) ifFalse: [
+ ^ self error: 'form dimensions do not match' translated ].
- ^ self error: 'form dimensions do not match' ].
self supports8BitGrayscaleJPEGs
ifTrue: [
components = 3
ifTrue: [
aForm depth = 8
+ ifTrue: [ ^ self error: 'Cannot uncompress multi-channel JPEGs into 8-bit deep forms' translated ]].
- ifTrue: [ ^ self error: 'Cannot uncompress multi-channel JPEGs into 8-bit deep forms' ]].
components = 1
ifTrue: [
aForm depth = 8
ifTrue: [
aForm isGrayScale
+ ifFalse: [ ^ self error: 'Cannot uncompress single-channel JPEGs into 8-bit deep forms that are not grayscale' translated ]]]]
- ifFalse: [ ^ self error: 'Cannot uncompress single-channel JPEGs into 8-bit deep forms that are not grayscale' ]]]]
ifFalse: [
aForm nativeDepth < 0
+ ifTrue: [ ^ self error: 'Current plugin version doesn''t support uncompressing JPEGs into little-endian forms' translated ]
- ifTrue: [ ^ self error: 'Current plugin version doesn''t support uncompressing JPEGs into little-endian forms' ]
ifFalse: [
aForm depth = 16
ifTrue: [
width odd
+ ifTrue: [ ^ self error: 'Current plugin version doesn''t support uncompressing JPEGs with an odd width into 16-bit deep forms' translated ]].
- ifTrue: [ ^ self error: 'Current plugin version doesn''t support uncompressing JPEGs with an odd width into 16-bit deep forms' ]].
aForm depth = 8
+ ifTrue: [ ^ self error: 'Current plugin version doesn''t support uncompressing JPEGs into 8-bit deep forms' translated ]]].
- ifTrue: [ ^ self error: 'Current plugin version doesn''t support uncompressing JPEGs into 8-bit deep forms' ]]].
self primJPEGReadImage: jpegDecompressStruct
fromByteArray: aByteArray
onForm: aForm
doDithering: ditherFlag
+ errorMgr: jpegErrorMgr2Struct.!
- errorMgr: jpegErrorMgr2Struct.
- !
Item was changed:
----- Method: PCXReadWriter>>readPalette (in category 'private-decoding') -----
readPalette
| r g b array |
+ self next = 12 ifFalse: [self error: 'no Color Palette!!' translated].
- self next = 12 ifFalse: [self error: 'no Color Palette!!'].
array := Array new: (1 bitShift: bitsPerPixel).
1 to: array size do:
[:i |
r := self next. g := self next. b := self next.
array at: i put: (Color r: r g: g b: b range: 255)].
^ array.
!
Item was changed:
+ ----- Method: PNGReadWriter class>>computeSwizzleMapForDepth: (in category 'class initialization') -----
- ----- Method: PNGReadWriter class>>computeSwizzleMapForDepth: (in category 'as yet unclassified') -----
computeSwizzleMapForDepth: depth
"Answer a map that maps pixels in a word to their opposite location. Used for 'middle-endian' forms where the byte-order is different from the bit order (good joke, eh?)."
| map swizzled |
map := Bitmap new: 256.
depth = 4 ifTrue:[
0 to: 255 do:[:pix|
swizzled := 0.
swizzled := swizzled bitOr: (((pix bitShift: 0) bitAnd: 15) bitShift: 4).
swizzled := swizzled bitOr: (((pix bitShift: -4) bitAnd: 15) bitShift: 0).
map at: pix+1 put: swizzled.
].
^ColorMap colors: map
].
depth = 2 ifTrue:[
0 to: 255 do:[:pix|
swizzled := 0.
swizzled := swizzled bitOr: (((pix bitShift: 0) bitAnd: 3) bitShift: 6).
swizzled := swizzled bitOr: (((pix bitShift: -2) bitAnd: 3) bitShift: 4).
swizzled := swizzled bitOr: (((pix bitShift: -4) bitAnd: 3) bitShift: 2).
swizzled := swizzled bitOr: (((pix bitShift: -6) bitAnd: 3) bitShift: 0).
map at: pix+1 put: swizzled.
].
^ColorMap colors: map
].
depth = 1 ifTrue:[
0 to: 255 do:[:pix|
swizzled := 0.
swizzled := swizzled bitOr: (((pix bitShift: 0) bitAnd: 1) bitShift: 7).
swizzled := swizzled bitOr: (((pix bitShift: -1) bitAnd: 1) bitShift: 6).
swizzled := swizzled bitOr: (((pix bitShift: -2) bitAnd: 1) bitShift: 5).
swizzled := swizzled bitOr: (((pix bitShift: -3) bitAnd: 1) bitShift: 4).
swizzled := swizzled bitOr: (((pix bitShift: -4) bitAnd: 1) bitShift: 3).
swizzled := swizzled bitOr: (((pix bitShift: -5) bitAnd: 1) bitShift: 2).
swizzled := swizzled bitOr: (((pix bitShift: -6) bitAnd: 1) bitShift: 1).
swizzled := swizzled bitOr: (((pix bitShift: -7) bitAnd: 1) bitShift: 0).
map at: pix+1 put: swizzled.
].
^ColorMap colors: map
].
self error: 'Unrecognized depth'!
Item was changed:
+ ----- Method: PNGReadWriter class>>debugging: (in category 'support') -----
- ----- Method: PNGReadWriter class>>debugging: (in category 'as yet unclassified') -----
debugging: aBoolean
Debugging := aBoolean!
Item was changed:
+ ----- Method: PNGReadWriter class>>initialize (in category 'class initialization') -----
- ----- Method: PNGReadWriter class>>initialize (in category 'as yet unclassified') -----
initialize
"
PNGReadWriter initialize
"
BPP := { #(1 2 4 8 16).
#(0 0 0 0 0).
#(0 0 0 24 48).
#(1 2 4 8 0).
#(0 0 0 16 32).
#(0 0 0 0 0).
#(0 0 0 32 64).
#(0 0 0 0 0) }.
BlockHeight := #(8 8 4 4 2 2 1).
BlockWidth := #(8 4 4 2 2 1 1).
StandardColors := Color indexedColors collect:[:aColor|
Color
r: (aColor red * 255) truncated / 255
g: (aColor green * 255) truncated / 255
b: (aColor blue * 255) truncated / 255.
].
StandardSwizzleMaps := Array new: 4.
#(1 2 4) do:[:i| StandardSwizzleMaps at: i put: (self computeSwizzleMapForDepth: i)].!
Item was removed:
- ----- Method: PNGReadWriter class>>insertMorph:named:into: (in category 'as yet unclassified') -----
- insertMorph: aMorph named: aString into: aBook
-
- | newPage |
-
- aBook ifNil: [^self].
- newPage := aBook insertPageLabel: aString morphs: {aMorph}.
- newPage color: Color lightYellow.
- newPage extent: (
- newPage submorphs inject: 10@10 into: [ :ex :m |
- m left: 10.
- ex max: m width @ m bottom
- ]
- ) + (20@20).
- !
Item was changed:
----- Method: PNGReadWriter>>nextImage (in category 'accessing') -----
nextImage
bigEndian := Smalltalk isBigEndian.
filtersSeen := Bag new.
idatChunkStream := nil.
transparentPixelValue := nil.
unknownChunks := Set new.
stream reset.
stream binary.
stream skip: 8.
[stream atEnd] whileFalse: [self processNextChunk].
"Set up our form"
palette ifNotNil:
["Dump the palette if it's the same as our standard palette"
palette = (StandardColors copyFrom: 1 to: palette size)
ifTrue: [palette := nil]].
(depth <= 8 and: [palette notNil])
ifTrue:
[form := ColorForm extent: width @ height depth: depth.
form colors: palette]
ifFalse: [form := Form extent: width @ height depth: depth].
backColor ifNotNil: [form fillColor: backColor].
idatChunkStream
+ ifNil: [ self error: 'image data is missing' translated ]
- ifNil: [ self error: 'image data is missing' ]
ifNotNil: [ self processIDATChunk ].
unknownChunks isEmpty
ifFalse:
["Transcript show: ' ',unknownChunks asSortedCollection asArray printString."
].
self debugging
ifTrue:
[Transcript
cr;
show: 'form = ' , form printString.
Transcript
cr;
show: 'colorType = ' , colorType printString.
Transcript
cr;
show: 'interlaceMethod = ' , interlaceMethod printString.
Transcript
cr;
show: 'filters = ' , filtersSeen sortedCounts asArray printString].
^form!
Item was changed:
----- Method: PNGReadWriter>>processInterlaced (in category 'chunks') -----
processInterlaced
| z startingCol colIncrement rowIncrement startingRow |
startingCol := #(0 4 0 2 0 1 0 ).
colIncrement := #(8 8 4 4 2 2 1 ).
rowIncrement := #(8 8 8 4 4 2 2 ).
startingRow := #(0 0 4 0 2 0 1 ).
z := ZLibReadStream
on: idatChunkStream originalContents
from: 1
to: idatChunkStream position.
1 to: 7 do: [:pass |
| cx sc bytesPerPass |
(self doPass: pass)
ifTrue:
[cx := colIncrement at: pass.
sc := startingCol at: pass.
bytesPerPass := width - sc + cx - 1 // cx * bitsPerPixel + 7 // 8.
prevScanline := ByteArray new: bytesPerPass.
thisScanline := ByteArray new: bytesPerScanline.
(startingRow at: pass)
to: height - 1
by: (rowIncrement at: pass)
do: [:y |
| filter temp |
filter := z next.
filtersSeen add: filter.
(filter isNil or: [(filter between: 0 and: 4) not])
ifTrue: [^ self].
thisScanline := z next: bytesPerPass into: thisScanline startingAt: 1.
self filterScanline: filter count: bytesPerPass.
self copyPixels: y at: sc by: cx.
temp := prevScanline.
prevScanline := thisScanline.
thisScanline := temp.
]
]
].
+ z atEnd ifFalse:[self error: 'Unexpected data' translated].!
- z atEnd ifFalse:[self error:'Unexpected data'].!
Item was changed:
----- Method: PNGReadWriter>>processNextChunk (in category 'chunks') -----
processNextChunk
| length chunkType crc chunkCrc |
length := self nextLong.
chunkType := (self next: 4) asString.
(chunk isNil or: [ chunk size ~= length ])
ifTrue: [ chunk := self next: length ]
ifFalse: [ stream next: length into: chunk startingAt: 1 ].
chunkCrc := self nextLong bitXor: 16rFFFFFFFF.
crc := self updateCrc: 16rFFFFFFFF from: 1 to: 4 in: chunkType.
crc := self updateCrc: crc from: 1 to: length in: chunk.
crc = chunkCrc ifFalse:[
+ self error: ('PNGReadWriter crc error in chunk {1}' translated format: {chunkType}).
- self error: 'PNGReadWriter crc error in chunk ', chunkType.
].
chunkType = 'IEND' ifTrue: [stream setToEnd. ^self "*should* be the last chunk"].
chunkType = 'sBIT' ifTrue: [^self processSBITChunk "could indicate unusual sample depth in original"].
chunkType = 'gAMA' ifTrue: [^self "indicates gamma correction value"].
chunkType = 'bKGD' ifTrue: [^self processBackgroundChunk].
chunkType = 'pHYs' ifTrue: [^self processPhysicalPixelChunk].
chunkType = 'tRNS' ifTrue: [^self processTransparencyChunk].
chunkType = 'IHDR' ifTrue: [^self processIHDRChunk].
chunkType = 'PLTE' ifTrue: [^self processPLTEChunk].
chunkType = 'IDAT' ifTrue: [
"---since the compressed data can span multiple
chunks, stitch them all together first. later,
if memory is an issue, we need to figure out how
to do this on the fly---"
idatChunkStream
ifNil: [ idatChunkStream := WriteStream with: chunk copy ]
ifNotNil: [ idatChunkStream nextPutAll: chunk ].
^self
].
unknownChunks add: chunkType.
!
Item was changed:
----- Method: PNGReadWriter>>processPLTEChunk (in category 'chunks') -----
processPLTEChunk
| colorCount i |
+ colorCount := chunk size // 3.
+ self flag: #todo. "validate colorCount against depth"
- colorCount := chunk size // 3. "TODO - validate colorCount against depth"
palette := Array new: colorCount.
0 to: colorCount-1 do: [ :index |
i := index * 3 + 1.
palette at: index+1 put:
(Color r: (chunk at: i)/255.0 g: (chunk at: i+1)/255.0 b: (chunk at: i+2)/255.0)
].!
Item was changed:
----- Method: PNGReadWriter>>writeSBITChunkOn: (in category 'writing') -----
writeSBITChunkOn: aStream
"Write the IDAT chunk"
aStream nextPutAll: 'sBIT' asByteArray.
+ form depth = 16 ifFalse: [self notYetImplemented].
- form depth = 16 ifFalse:[self error: 'Unimplemented feature'].
aStream nextPut: 5.
aStream nextPut: 5.
aStream nextPut: 5.
aStream nextPut: 1.!
Item was changed:
----- Method: PNMReadWriter>>nextImage (in category 'reading') -----
nextImage
"read one image"
| data p |
first ifNil:[
first := false.
data := stream contentsOfEntireFile.
stream := (RWBinaryOrTextStream with: data) reset.
]
ifNotNil:[
type < 4 ifTrue:[
+ self error: 'Plain PBM, PGM or PPM have only one image' translated
- self error:'Plain PBM, PGM or PPM have only one image'
].
].
stream ascii.
p := stream next.
type := (stream next) asInteger - 48.
(p = $P and:[type > 0 and:[type < 8]]) ifFalse:[
+ self error: 'Not a PNM file' translated
- self error:'Not a PNM file'
].
type = 7 ifTrue:[
self readHeaderPAM
]
ifFalse: [
self readHeader
].
type caseOf: {
[1] -> [^self readPlainBW].
[2] -> [^self readPlainGray].
[3] -> [^self readPlainRGB].
[4] -> [^self readBWreverse: false].
[5] -> [^self readGray].
[6] -> [^self readRGB].
[7] -> [ "PAM"
(tupleType asUppercase) caseOf: {
['BLACKANDWHITE'] -> [^self readBWreverse: true].
['GRAYSCALE'] -> [^self readGray].
['RGB'] -> [^self readRGB].
+ ['RGB_ALPHA'] -> [^self notYetImplemented].
+ ['GRAYSCALE_ALPHA'] -> [^self notYetImplemented].
- ['RGB_ALPHA'] -> [^self error:'Not implemented'].
- ['GRAYSCALE_ALPHA'] -> [^self error:'Not implemented'].
} otherwise: [^self readData].
]
}!
Item was changed:
----- Method: PNMReadWriter>>readGray (in category 'reading') -----
readGray
"gray form, return ColorForm with gray ramp"
| form poker |
+ maxValue > 255 ifTrue:[self error: ('Gray value > {1} bits not supported in Squeak' translated format: {8})].
- maxValue > 255 ifTrue:[self error:'Gray value > 8 bits not supported in Squeak'].
stream binary.
form := ColorForm extent: cols@rows depth: depth.
form colors: nil.
poker := BitBlt bitPokerToForm: form.
0 to: rows-1 do: [:y |
0 to: cols-1 do: [:x |
|val|
val := stream next.
poker pixelAt: x@y put: val.
]
].
"a better way is using a gamma corrected palette"
form colors: ((0 to: 255) collect:[:c|
c > maxValue
ifTrue:[Color white]
ifFalse:[Color gray: (c/maxValue) asFloat]]).
form colors at: 1 put: (Color black).
^form
!
Item was changed:
----- Method: PNMReadWriter>>readHeader (in category 'reading') -----
readHeader
"read header for pbm, pgm or ppm"
| tokens aux d c |
tokens := OrderedCollection new.
aux := self getTokenPbm: tokens.
cols := aux at: 1. tokens := aux at: 2.
aux := self getTokenPbm: tokens.
rows := aux at: 1. tokens := aux at: 2.
(type = 1 or:[type = 4]) ifTrue:[
maxValue := 1
]
ifFalse: [
aux := self getTokenPbm: tokens.
maxValue := aux at: 1. tokens := aux at: 2.
].
d := {1 . 2 . 4 . 8 . 16 . 32}.
c := {2 . 4 . 16 . 256 . 32768 . 16777216}.
(type = 3 or:[type = 6]) ifTrue: [
maxValue >= 65536 ifTrue:[
+ self error: ('Pixmap > {1} bits not supported in PPM' translated format: {48})
- self error:'Pixmap > 48 bits not supported in PPM'
].
maxValue >= 256 ifTrue:[
+ self error: ('Pixmap > {1} bits are not supported in Squeak' translated format: {32})
- self error:'Pixmap > 32 bits are not supported in Squeak'
].
maxValue < 32 ifTrue:[depth := 16] ifFalse:[depth := 32].
]
ifFalse: [
depth := nil.
1 to: c size do:[:i| ((c at: i) > maxValue and:[depth = nil]) ifTrue:[depth:=d at: i]].
].
Transcript cr; show: 'PBM file class ', type asString, ' size ', cols asString, ' x ',
rows asString, ' maxValue =', maxValue asString, ' depth=', depth asString.
!
Item was changed:
----- Method: PNMReadWriter>>readPlainBW (in category 'reading') -----
readPlainBW
"plain BW"
| val form poker |
form := Form extent: cols@rows depth: depth.
poker := BitBlt bitPokerToForm: form.
0 to: rows-1 do: [:y |
0 to: cols-1 do: [:x |
[val := stream next. (val = $0 or:[val = $1])] whileFalse:[
+ val ifNil: [self error: 'End of file reading PBM' translated].
- val ifNil:[self error:'End of file reading PBM'].
].
poker pixelAt: x@y put: (val asInteger).
]
].
^form
!
Item was changed:
----- Method: PNMReadWriter>>readPlainRGB (in category 'reading') -----
readPlainRGB
"RGB form, use 32 bits"
| val form poker tokens aux |
+ maxValue > 255 ifTrue:[self error: ('RGB value > {1} bits not supported in Squeak' translated format: {32})].
- maxValue > 255 ifTrue:[self error:'RGB value > 32 bits not supported in Squeak'].
form := Form extent: cols@rows depth: 32.
poker := BitBlt bitPokerToForm: form.
tokens := OrderedCollection new.
0 to: rows-1 do: [:y |
0 to: cols-1 do: [:x | | r g b|
aux := self getTokenPbm: tokens. r := aux at: 1. tokens := aux at: 2.
aux := self getTokenPbm: tokens. g := aux at: 1. tokens := aux at: 2.
aux := self getTokenPbm: tokens. b := aux at: 1. tokens := aux at: 2.
val := self r: r g: g b: b for: depth.
poker pixelAt: x@y put: val.
]
].
^form
!
Item was changed:
----- Method: PNMReadWriter>>readRGB (in category 'reading') -----
readRGB
"RGB form, use 16/32 bits"
| val form poker sample shift |
+ maxValue > 255 ifTrue:[self error: ('RGB value > {1} bits not supported in Squeak' translated format: {32})].
- maxValue > 255 ifTrue:[self error:'RGB value > 32 bits not supported in Squeak'].
stream binary.
form := Form extent: cols@rows depth: depth.
poker := BitBlt bitPokerToForm: form.
depth = 32 ifTrue:[shift := 8] ifFalse:[shift := 5].
0 to: rows-1 do: [:y |
0 to: cols-1 do: [:x |
val := 16rFF. "no transparency"
1 to: 3 do: [:i |
sample := stream next.
val := val << shift + sample.
].
poker pixelAt: x@y put: val.
]
].
^form
!
Item was changed:
----- Method: StrikeFont class>>generateDejaVuMethods: (in category 'font creation') -----
generateDejaVuMethods: directory
"StrikeFont generateDejaVuMethods: 'DejaVu'."
| dir formTemplate dataTemplate methodCategory |
methodCategory := #'dejaVu font data'.
formTemplate := '{1}
<generated>
" Form data for {2}. Generated with StrikeFont generateDejaVuMethods: ''{3}''"
^Form fromBinaryStream: (
''{4}''
) base64Decoded asByteArray readStream
'.
dataTemplate := '{1}
<generated>
" Font meta data for {2}. Generated with StrikeFont generateDejaVuMethods: ''{3}''"
^ #({4})
'.
dir := FileDirectory default / directory.
#('*.txt' 'Data' '*.png' 'Form') pairsDo:
[:match :suffix | (dir fileNamesMatching: match)
do:
[:local | | selector source stringContent|
" .txt and .png have both length 4"
selector := (local allButLast: 4) asLegalSelector, suffix.
stringContent := dir readOnlyFileNamed: local do:
[:stream | suffix = 'Data'
ifTrue: [stream contentsOfEntireFile]
ifFalse: [(stream binary; contentsOfEntireFile) base64Encoded]].
source := (suffix = 'Data' ifTrue: [dataTemplate] ifFalse: [formTemplate])
format: {selector . (local allButLast: 4) . directory . stringContent }.
self class compile: source classified: methodCategory]
+ displayingProgress: [:local | 'Generating {1}' translated format: {local}]].!
- displayingProgress: [:local | 'Generating ', local]].!
1
0
Christoph Thiede uploaded a new version of EToys to project The Trunk:
http://source.squeak.org/trunk/EToys-ct.455.mcz
==================== Summary ====================
Name: EToys-ct.455
Author: ct
Time: 3 January 2022, 7:42:29.166703 pm
UUID: 9495aecb-a9c1-884e-bfc7-67c3deaf0691
Ancestors: EToys-mt.454
Improves multilingual support and performs recategorizations for Squeakland-Sound and FileStream extensions.
=============== Diff against EToys-mt.454 ===============
Item was changed:
+ ----- Method: CodecDemoMorph>>codecClassName: (in category 'accessing') -----
- ----- Method: CodecDemoMorph>>codecClassName: (in category 'as yet unclassified') -----
codecClassName: aStringOrSymbol
| label |
codecClassName := aStringOrSymbol asSymbol.
self removeAllMorphs.
label := StringMorph contents: aStringOrSymbol.
label position: self position + (5@5).
self addMorph: label.
label lock: true.
self extent: label extent + (10@10).
!
Item was changed:
+ ----- Method: CodecDemoMorph>>selectCodec (in category 'accessing') -----
- ----- Method: CodecDemoMorph>>selectCodec (in category 'as yet unclassified') -----
selectCodec
| aMenu codecs newCodec |
+ aMenu := CustomMenu new title: 'Codec:' translated.
- aMenu := CustomMenu new title: 'Codec:'.
codecs := SoundCodec allSubclasses collect: [:c | c name] as: OrderedCollection.
codecs add: 'None'.
codecs sort do:[:cName | aMenu add: cName action: cName].
newCodec := aMenu startUp ifNil: [^ self].
self codecClassName: newCodec.
!
Item was changed:
+ ----- Method: MIDIPianoKeyboardMorph>>closeMIDIPort (in category 'accessing') -----
- ----- Method: MIDIPianoKeyboardMorph>>closeMIDIPort (in category 'as yet unclassified') -----
closeMIDIPort
midiPort := nil.
!
Item was changed:
+ ----- Method: MIDIPianoKeyboardMorph>>makeMIDIController: (in category 'accessing') -----
- ----- Method: MIDIPianoKeyboardMorph>>makeMIDIController: (in category 'as yet unclassified') -----
makeMIDIController: evt
self world activeHand attachMorph:
(MIDIControllerMorph new midiPort: midiPort).
!
Item was changed:
+ ----- Method: MIDIPianoKeyboardMorph>>openMIDIPort (in category 'accessing') -----
- ----- Method: MIDIPianoKeyboardMorph>>openMIDIPort (in category 'as yet unclassified') -----
openMIDIPort
| portNum |
portNum := SimpleMIDIPort outputPortNumFromUser.
portNum ifNil: [^ self].
midiPort := SimpleMIDIPort openOnPortNumber: portNum.
!
Item was changed:
+ ----- Method: MIDIPianoKeyboardMorph>>turnOffNote (in category 'accessing') -----
- ----- Method: MIDIPianoKeyboardMorph>>turnOffNote (in category 'as yet unclassified') -----
turnOffNote
midiPort notNil & soundPlaying notNil ifTrue: [
soundPlaying isInteger ifTrue: [
midiPort midiCmd: 16r90 channel: channel byte: soundPlaying byte: 0]].
soundPlaying := nil.
!
Item was changed:
+ ----- Method: MIDIPianoKeyboardMorph>>turnOnNote: (in category 'accessing') -----
- ----- Method: MIDIPianoKeyboardMorph>>turnOnNote: (in category 'as yet unclassified') -----
turnOnNote: midiKey
midiPort midiCmd: 16r90 channel: channel byte: midiKey byte: velocity.
soundPlaying := midiKey.
!
Item was changed:
+ ----- Method: MidiInputMorph>>addChannel (in category 'actions') -----
- ----- Method: MidiInputMorph>>addChannel (in category 'as yet unclassified') -----
addChannel
"Add a set of controls for another channel. Prompt the user for the channel number."
| menu existingChannels newChannel |
menu := CustomMenu new.
existingChannels := Set new.
1 to: 16 do: [:ch | (instrumentSelector at: ch) ifNotNil: [existingChannels add: ch]].
1 to: 16 do: [:ch |
(existingChannels includes: ch) ifFalse: [
menu add: ch printString action: ch]].
newChannel := menu startUp.
newChannel ifNotNil: [self addChannelControlsFor: newChannel].
!
Item was changed:
+ ----- Method: MidiInputMorph>>addChannelControlsFor: (in category 'accessing') -----
- ----- Method: MidiInputMorph>>addChannelControlsFor: (in category 'as yet unclassified') -----
addChannelControlsFor: channelIndex
| r divider col |
r := self makeRow
hResizing: #shrinkWrap;
vResizing: #shrinkWrap.
r addMorphBack: (self channelNumAndMuteButtonFor: channelIndex).
r addMorphBack: (Morph new extent: 10@5; color: color). "spacer"
r addMorphBack: (self panAndVolControlsFor: channelIndex).
divider := AlignmentMorph new
extent: 10@1;
layoutInset: 0;
borderStyle: (BorderStyle raised width: 1);
color: color;
hResizing: #spaceFill;
vResizing: #rigid.
col := self lastSubmorph.
col addMorphBack: divider.
col addMorphBack: r.
!
Item was changed:
+ ----- Method: MidiInputMorph>>atChannel:from:selectInstrument: (in category 'accessing') -----
- ----- Method: MidiInputMorph>>atChannel:from:selectInstrument: (in category 'as yet unclassified') -----
atChannel: channelIndex from: aPopUpChoice selectInstrument: selection
| oldSnd name snd instSelector |
oldSnd := midiSynth instrumentForChannel: channelIndex.
(selection beginsWith: 'edit ')
ifTrue:
[name := selection copyFrom: 6 to: selection size.
aPopUpChoice contentsClipped: name.
(oldSnd isKindOf: FMSound) | (oldSnd isKindOf: LoopedSampledSound)
ifTrue: [EnvelopeEditorMorph openOn: oldSnd title: name].
(oldSnd isKindOf: SampledInstrument)
ifTrue: [EnvelopeEditorMorph openOn: oldSnd allNotes first title: name].
^self].
snd := nil.
1 to: instrumentSelector size
do:
[:i |
(channelIndex ~= i and:
[(instSelector := instrumentSelector at: i) notNil
and: [selection = instSelector contents]])
ifTrue: [snd := midiSynth instrumentForChannel: i]]. "use existing instrument prototype"
snd ifNil:
[snd := (selection = 'clink'
ifTrue:
[(SampledSound samples: SampledSound coffeeCupClink samplingRate: 11025)]
ifFalse: [(AbstractSound soundNamed: selection) ])copy ].
midiSynth instrumentForChannel: channelIndex put: snd.
(instrumentSelector at: channelIndex) contentsClipped: selection!
Item was changed:
+ ----- Method: MidiInputMorph>>channelNumAndMuteButtonFor: (in category 'accessing') -----
- ----- Method: MidiInputMorph>>channelNumAndMuteButtonFor: (in category 'as yet unclassified') -----
channelNumAndMuteButtonFor: channelIndex
| muteButton instSelector r |
muteButton := SimpleSwitchMorph new
onColor: (Color r: 1.0 g: 0.6 b: 0.6);
offColor: color;
color: color;
+ label: 'Mute' translated;
- label: 'Mute';
target: midiSynth;
actionSelector: #mutedForChannel:put:;
arguments: (Array with: channelIndex).
instSelector := PopUpChoiceMorph new
extent: 95@14;
contentsClipped: 'oboe1';
target: self;
actionSelector: #atChannel:from:selectInstrument:;
getItemsSelector: #instrumentChoicesForChannel:;
getItemsArgs: (Array with: channelIndex).
instSelector arguments:
(Array with: channelIndex with: instSelector).
instrumentSelector at: channelIndex put: instSelector.
r := self makeRow
hResizing: #rigid;
vResizing: #spaceFill;
extent: 70@10.
r addMorphBack:
(StringMorph
contents: channelIndex printString
font: (TextStyle default fontOfSize: 24)).
channelIndex < 10
ifTrue: [r addMorphBack: (Morph new color: color; extent: 19@8)] "spacer"
ifFalse: [r addMorphBack: (Morph new color: color; extent: 8@8)]. "spacer"
r addMorphBack: instSelector.
r addMorphBack: (AlignmentMorph newRow color: color). "spacer"
r addMorphBack: muteButton.
+ ^ r!
- ^ r
- !
Item was changed:
+ ----- Method: MidiInputMorph>>closeMIDIPort (in category 'accessing') -----
- ----- Method: MidiInputMorph>>closeMIDIPort (in category 'as yet unclassified') -----
closeMIDIPort
midiSynth isOn ifTrue: [midiSynth stopMIDITracking].
midiSynth closeMIDIPort.
!
Item was changed:
+ ----- Method: MidiInputMorph>>disableReverb: (in category 'accessing') -----
- ----- Method: MidiInputMorph>>disableReverb: (in category 'as yet unclassified') -----
disableReverb: aBoolean
Preferences setPreference: #soundReverb toValue: aBoolean not
!
Item was changed:
+ ----- Method: MidiInputMorph>>instrumentChoicesForChannel: (in category 'accessing') -----
- ----- Method: MidiInputMorph>>instrumentChoicesForChannel: (in category 'as yet unclassified') -----
instrumentChoicesForChannel: channelIndex
| names inst |
names := AbstractSound soundNames asOrderedCollection.
names := names collect: [:n |
inst := AbstractSound soundNamed: n.
(inst isKindOf: UnloadedSound)
ifTrue: [n, '(out)']
ifFalse: [n]].
names add: 'clink'.
names add: 'edit ', (instrumentSelector at: channelIndex) contents.
^ names asArray
!
Item was changed:
+ ----- Method: MidiInputMorph>>invokeMenu (in category 'actions') -----
- ----- Method: MidiInputMorph>>invokeMenu (in category 'as yet unclassified') -----
invokeMenu
"Invoke a menu of additonal commands."
| aMenu |
aMenu := CustomMenu new.
aMenu add: 'add channel' translated action: #addChannel.
aMenu add: 'reload instruments' translated target: AbstractSound selector: #updateScorePlayers.
midiSynth isOn ifFalse: [
aMenu add: 'set MIDI port' translated action: #setMIDIPort.
midiSynth midiPort
ifNotNil: [aMenu add: 'close MIDI port' translated action: #closeMIDIPort]].
aMenu invokeOn: self defaultSelection: nil.
!
Item was changed:
+ ----- Method: MidiInputMorph>>makeControls (in category 'initialization') -----
- ----- Method: MidiInputMorph>>makeControls (in category 'as yet unclassified') -----
makeControls
| bb r reverbSwitch onOffSwitch |
bb := SimpleButtonMorph new
target: self;
borderStyle: (BorderStyle raised width: 2);
color: color.
r := AlignmentMorph newRow.
r color: bb color; borderWidth: 0; layoutInset: 0.
r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5.
r addMorphBack: (
bb label: '<>';
actWhen: #buttonDown;
actionSelector: #invokeMenu).
onOffSwitch := SimpleSwitchMorph new
offColor: color;
onColor: (Color r: 1.0 g: 0.6 b: 0.6);
borderWidth: 2;
+ label: 'On' translated;
- label: 'On';
actionSelector: #toggleOnOff;
target: self;
setSwitchState: false.
r addMorphBack: onOffSwitch.
reverbSwitch := SimpleSwitchMorph new
offColor: color;
onColor: (Color r: 1.0 g: 0.6 b: 0.6);
borderWidth: 2;
+ label: 'Reverb Disable' translated;
- label: 'Reverb Disable';
actionSelector: #disableReverb:;
target: self;
setSwitchState: SoundPlayer isReverbOn not.
r addMorphBack: reverbSwitch.
+ ^ r!
- ^ r
- !
Item was changed:
+ ----- Method: MidiInputMorph>>makeRow (in category 'initialization') -----
- ----- Method: MidiInputMorph>>makeRow (in category 'as yet unclassified') -----
makeRow
^ AlignmentMorph newRow
color: color;
layoutInset: 0;
wrapCentering: #center; cellPositioning: #leftCenter;
hResizing: #spaceFill;
vResizing: #shrinkWrap
!
Item was changed:
+ ----- Method: MidiInputMorph>>panAndVolControlsFor: (in category 'initialization') -----
- ----- Method: MidiInputMorph>>panAndVolControlsFor: (in category 'as yet unclassified') -----
panAndVolControlsFor: channelIndex
| volSlider panSlider c r middleLine |
volSlider := SimpleSliderMorph new
color: color;
extent: 101@2;
target: midiSynth;
arguments: (Array with: channelIndex);
actionSelector: #volumeForChannel:put:;
minVal: 0.0;
maxVal: 1.0;
adjustToValue: (midiSynth volumeForChannel: channelIndex).
panSlider := SimpleSliderMorph new
color: color;
extent: 101@2;
target: midiSynth;
arguments: (Array with: channelIndex);
actionSelector: #panForChannel:put:;
minVal: 0.0;
maxVal: 1.0;
adjustToValue: (midiSynth panForChannel: channelIndex).
c := AlignmentMorph newColumn
color: color;
layoutInset: 0;
wrapCentering: #center; cellPositioning: #topCenter;
hResizing: #spaceFill;
vResizing: #shrinkWrap.
middleLine := Morph new "center indicator for pan slider"
color: (Color r: 0.4 g: 0.4 b: 0.4);
extent: 1@(panSlider height - 4);
position: panSlider center x@(panSlider top + 2).
panSlider addMorphBack: middleLine.
r := self makeRow.
r addMorphBack: (StringMorph contents: '0').
r addMorphBack: volSlider.
r addMorphBack: (StringMorph contents: '10').
c addMorphBack: r.
r := self makeRow.
r addMorphBack: (StringMorph contents: 'L').
r addMorphBack: panSlider.
r addMorphBack: (StringMorph contents: 'R').
c addMorphBack: r.
^ c
!
Item was changed:
+ ----- Method: MidiInputMorph>>setMIDIPort (in category 'accessing') -----
- ----- Method: MidiInputMorph>>setMIDIPort (in category 'as yet unclassified') -----
setMIDIPort
| portNum |
portNum := SimpleMIDIPort outputPortNumFromUser.
portNum ifNil: [^ self].
midiPortNumber := portNum.
!
Item was changed:
+ ----- Method: MidiInputMorph>>toggleOnOff (in category 'accessing') -----
- ----- Method: MidiInputMorph>>toggleOnOff (in category 'as yet unclassified') -----
toggleOnOff
midiSynth isOn
ifTrue: [
midiSynth stopMIDITracking]
ifFalse: [
midiPortNumber ifNil: [self setMIDIPort].
midiPortNumber ifNil: [midiPortNumber := 0].
midiSynth midiPort: (SimpleMIDIPort openOnPortNumber: midiPortNumber).
midiSynth startMIDITracking].
!
Item was changed:
+ ----- Method: MidiInputMorph>>updateInstrumentsFromLibraryExcept: (in category 'fileIn/out') -----
- ----- Method: MidiInputMorph>>updateInstrumentsFromLibraryExcept: (in category 'as yet unclassified') -----
updateInstrumentsFromLibraryExcept: soundsBeingEdited
"The instrument library has been modified. Update my instruments with the new versions from the library. Use a single instrument prototype for all parts with the same name; this allows the envelope editor to edit all the parts by changing a single sound prototype."
"soundsBeingEdited is a collection of sounds being edited (by an EnvelopeEditor). If any of my instruments share one of these, then they will be left alone so as not to disturb that dynamic linkage."
| unloadPostfix myInstruments name displaysAsUnloaded isUnloaded |
unloadPostfix := '(out)'.
myInstruments := Dictionary new.
1 to: instrumentSelector size do: [:i |
name := (instrumentSelector at: i) contents.
displaysAsUnloaded := name endsWith: unloadPostfix.
displaysAsUnloaded ifTrue: [
name := name copyFrom: 1 to: name size - unloadPostfix size].
(myInstruments includesKey: name) ifFalse: [
myInstruments at: name put:
(name = 'clink'
ifTrue: [
(SampledSound
samples: SampledSound coffeeCupClink
samplingRate: 11025) copy]
ifFalse: [
(AbstractSound
soundNamed: name
ifAbsent: [
(instrumentSelector at: i) contentsClipped: 'default'.
FMSound default]) copy])].
(soundsBeingEdited includes: (midiSynth instrumentForChannel: i)) ifFalse:
["Do not update any instrument that is currently being edited"
midiSynth instrumentForChannel: i put: (myInstruments at: name)].
"update loaded/unloaded status in instrumentSelector if necessary"
isUnloaded := (myInstruments at: name) isKindOf: UnloadedSound.
(displaysAsUnloaded and: [isUnloaded not])
ifTrue: [(instrumentSelector at: i) contentsClipped: name].
(displaysAsUnloaded not and: [isUnloaded])
ifTrue: [(instrumentSelector at: i) contentsClipped: name, unloadPostfix]].
!
Item was changed:
----- Method: OggDriver class>>example3 (in category 'examples') -----
example3
"OggDriver example3"
"Primitive metatada test: Reading Ogg Vorbis and output to Transcript."
| f compressed driver ogg vendor comment commentSize fileName rate channels |
fileName := 'majorChord.ogg'.
f := FileDirectory default readOnlyFileNamed: fileName.
[f binary.
compressed := f contents]
ensure: [f close].
driver := self new.
ogg := driver
primitiveOpen: (SqVorbis bitOr: SqOggDecode).
driver
primitiveWrite: ogg
buffer: compressed
size: compressed size.
self assert: (driver primitiveGetState: ogg)
== SqOggRunning.
rate := driver primitiveGetRate: ogg.
channels := driver primitiveGetChannels: ogg.
Transcript cr;
+ show: ('Bitstream is {1} channel, {2} Hz' translated format: {rate. channels}).
- show: ('Bitstream is {1} channel, {2} Hz' format: {rate. channels}).
vendor := String new: 1024.
driver
primitiveGetVendor: ogg
buffer: vendor
size: 1024.
Transcript cr; show: 'Encoded by:'
, (vendor readStream
upTo: (Character value: 0)).
commentSize := driver primitiveGetCommentSize: ogg.
comment := String new: commentSize.
driver
primitiveGetComment: ogg
buffer: comment
size: commentSize.
Transcript cr; show: comment.
driver primitiveClose: ogg!
Item was changed:
----- Method: OggDriver class>>services (in category 'class initialization') -----
services
| service |
service := SimpleServiceEntry
+ provider: self
+ label: 'sound file' translatedNoop
+ selector: #playFileNamed:
+ description: 'play the sound' translatedNoop
+ buttonLabel: 'play' translatedNoop.
- provider: self
- label: 'sound file'
- selector: #playFileNamed:
- description: 'play the sound'
- buttonLabel: 'play'.
^ Array with: service!
Item was changed:
----- Method: OggDriver>>decodeCompressedData: (in category 'compress/decompress') -----
decodeCompressedData: aByteArray
"Answer decompressed SoundBuffer, or nil if it needs more data"
| decoded size result |
state
ifNil: [state := self startDecoder].
result := self
primitiveWrite: state
buffer: aByteArray
size: aByteArray size.
result = SqOggSuccess
+ ifFalse: [self error: 'Compressed data is corrupt' translated].
- ifFalse: [self error: 'Compressed data is corrupt'].
size := self primitiveReadSize: state.
size = 0
ifTrue: [^ nil].
decoded := SoundBuffer newMonoSampleCount: size // 2.
self
primitiveRead: state
buffer: decoded
size: size.
self hasHeader
ifFalse: [self headerComplete].
^ decoded!
Item was changed:
----- Method: OggSoundData>>asSound (in category 'asSound') -----
asSound
| codecClass theDecoder |
self isHeader
ifTrue: [codecClass := Smalltalk
at: codecName
+ ifAbsent: [^ self error: 'The codec for decompressing this sound is not available' translated].
- ifAbsent: [^ self error: 'The codec for decompressing this sound is not available'].
codecClass isAvailable
+ ifFalse: [^ self error: 'The codec for decompressing this sound is not available' translated].
- ifFalse: [^ self error: 'The codec for decompressing this sound is not available'].
decoder
ifNotNil: [decoder release].
theDecoder := decoder := codecClass new]
ifFalse: [theDecoder := header decoder].
^ theDecoder soundFromCompressedData: channels first!
Item was changed:
----- Method: OggSoundData>>decoder (in category 'accessing') -----
decoder
self isHeader
ifTrue: [^ decoder].
+ self error: 'Only header has a decoder.' translated.!
- self error: 'Only header has a decoder.'!
Item was changed:
+ ----- Method: RecordingControls class>>additionsToViewerCategories (in category 'scripting') -----
- ----- Method: RecordingControls class>>additionsToViewerCategories (in category 'as yet unclassified') -----
additionsToViewerCategories
"Answer a list of (<categoryName> <list of category specs>) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories."
^ #((#'sound recorder'
((command recordButtonHit 'start recording')
(command stopButtonHit 'stop recording or playback')
(command playButtonHit 'play recording')
)))!
Item was changed:
----- Method: RecordingControls>>makeSoundMorph (in category 'private') -----
makeSoundMorph
"Hand the user an anonymous-sound object representing the receiver's sound."
| m aName |
recorder verifyExistenceOfRecordedSound ifFalse: [^ self].
recorder pause.
recordingSaved := true.
m := AnonymousSoundMorph new.
+ m sound: recorder recordedSound interimName: (aName := 'Unnamed Sound' translated).
- m sound: recorder recordedSound interimName: (aName := 'Unnamed Sound').
m setNameTo: aName.
self currentHand attachMorph: m.!
Item was changed:
+ ----- Method: SoundDemoMorph>>makeControls (in category 'private') -----
- ----- Method: SoundDemoMorph>>makeControls (in category 'as yet unclassified') -----
makeControls
| bb r cc |
cc := Color black.
r := AlignmentMorph newRow.
r color: cc; borderWidth: 0; layoutInset: 0.
r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5.
bb := SimpleButtonMorph new target: self; borderColor: cc.
r addMorphBack: (bb label: 'V1'; actionSelector: #playV1).
bb := SimpleButtonMorph new target: self; borderColor: cc.
r addMorphBack: (bb label: 'V2'; actionSelector: #playV2).
bb := SimpleButtonMorph new target: self; borderColor: cc.
r addMorphBack: (bb label: 'V3'; actionSelector: #playV3).
bb := SimpleButtonMorph new target: self; borderColor: cc.
r addMorphBack: (bb label: 'All'; actionSelector: #playAll).
bb := SimpleButtonMorph new target: self; borderColor: cc.
r addMorphBack: (bb label: 'Stop'; actionSelector: #stopSound).
^ r
!
Item was changed:
+ ----- Method: SoundDemoMorph>>playAll (in category 'private') -----
- ----- Method: SoundDemoMorph>>playAll (in category 'as yet unclassified') -----
playAll
| snd |
soundColumn submorphs isEmpty
ifTrue: [^ self].
self setTimbreFromTile: soundColumn submorphs first.
snd := SampledSound bachFugueVoice1On: SampledSound new.
soundColumn submorphs size >= 2
ifTrue: [""self setTimbreFromTile: soundColumn submorphs second.
snd := snd
+ (AbstractSound bachFugueVoice2On: SampledSound new)].
soundColumn submorphs size >= 3
ifTrue: [""self setTimbreFromTile: soundColumn submorphs third.
snd := snd
+ (AbstractSound bachFugueVoice3On: SampledSound new)].
snd play!
Item was changed:
+ ----- Method: SoundDemoMorph>>playV1 (in category 'private') -----
- ----- Method: SoundDemoMorph>>playV1 (in category 'as yet unclassified') -----
playV1
soundColumn submorphs isEmpty
ifTrue: [^ self].
self
setTimbreFromTile: (soundColumn submorphs first).
(SampledSound bachFugueVoice1On: SampledSound new) play!
Item was changed:
+ ----- Method: SoundDemoMorph>>playV2 (in category 'private') -----
- ----- Method: SoundDemoMorph>>playV2 (in category 'as yet unclassified') -----
playV2
soundColumn submorphs size < 2
ifTrue: [^ self].
self
setTimbreFromTile: (soundColumn submorphs second).
(SampledSound bachFugueVoice2On: SampledSound new) playSilentlyUntil: 4.8;
resumePlaying!
Item was changed:
+ ----- Method: SoundDemoMorph>>playV3 (in category 'private') -----
- ----- Method: SoundDemoMorph>>playV3 (in category 'as yet unclassified') -----
playV3
soundColumn submorphs size < 3
ifTrue: [^ self].
self
setTimbreFromTile: (soundColumn submorphs third).
(AbstractSound bachFugueVoice3On: SampledSound new) playSilentlyUntil: 14.4;
resumePlaying!
Item was changed:
+ ----- Method: SoundDemoMorph>>setTimbreFromTile: (in category 'private') -----
- ----- Method: SoundDemoMorph>>setTimbreFromTile: (in category 'as yet unclassified') -----
setTimbreFromTile: aSoundTile
SampledSound defaultSampleTable: aSoundTile sound samples.
SampledSound nominalSamplePitch: 400.
!
Item was changed:
+ ----- Method: SoundDemoMorph>>stopSound (in category 'private') -----
- ----- Method: SoundDemoMorph>>stopSound (in category 'as yet unclassified') -----
stopSound
SoundPlayer shutDown.
!
Item was changed:
+ ----- Method: SoundMorph>>buildImage (in category 'accessing') -----
- ----- Method: SoundMorph>>buildImage (in category 'as yet unclassified') -----
buildImage
| scale env h imageColor |
owner ifNil: [scale := 128@128] "Default is 128 pix/second, 128 pix fullscale"
ifNotNil: [scale := owner soundScale].
env := sound volumeEnvelopeScaledTo: scale.
self image: (ColorForm extent: env size @ env max).
1 to: image width do:
[:x | h := env at: x.
image fillBlack: ((x-1)@(image height-h//2) extent: 1@h)].
imageColor := #(black red orange green blue) atPin:
(sound pitch / 110.0) rounded highBit.
image colors: (Array with: Color transparent with: (Color perform: imageColor)).
!
Item was changed:
+ ----- Method: SoundMorph>>reset (in category 'accessing') -----
- ----- Method: SoundMorph>>reset (in category 'as yet unclassified') -----
reset
sound reset!
Item was changed:
+ ----- Method: SoundMorph>>sound (in category 'accessing') -----
- ----- Method: SoundMorph>>sound (in category 'as yet unclassified') -----
sound
^ sound!
Item was changed:
+ ----- Method: SoundMorph>>sound: (in category 'accessing') -----
- ----- Method: SoundMorph>>sound: (in category 'as yet unclassified') -----
sound: aSound
sound := aSound copy.
sound reset.
self buildImage!
Item was changed:
+ ----- Method: SoundSequencerMorph>>makeControlPanel (in category 'initialization') -----
- ----- Method: SoundSequencerMorph>>makeControlPanel (in category 'as yet unclassified') -----
makeControlPanel
| bb cc |
cc := Color black.
bb := SimpleButtonMorph new target: self; borderColor: cc.
controlPanel := AlignmentMorph newRow.
bb := SimpleButtonMorph new target: self; borderColor: cc.
controlPanel color: bb color; borderWidth: 0; layoutInset: 0.
controlPanel hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5.
bb := SimpleButtonMorph new target: self; borderColor: cc.
+ controlPanel addMorphBack: (bb label: 'reset' translated; actionSelector: #reset).
- controlPanel addMorphBack: (bb label: 'reset'; actionSelector: #reset).
bb := SimpleButtonMorph new target: self; borderColor: cc.
+ controlPanel addMorphBack: (bb label: 'stop' translated; actionSelector: #stop).
- controlPanel addMorphBack: (bb label: 'stop'; actionSelector: #stop).
bb := SimpleButtonMorph new target: self; borderColor: cc.
+ controlPanel addMorphBack: (bb label: 'play' translated; actionSelector: #play).
- controlPanel addMorphBack: (bb label: 'play'; actionSelector: #play).
!
Item was changed:
+ ----- Method: SoundSequencerMorph>>play (in category 'accessing') -----
- ----- Method: SoundSequencerMorph>>play (in category 'as yet unclassified') -----
play
self submorphsDo: [:m | m == controlPanel ifFalse: [m play]]!
Item was changed:
+ ----- Method: SoundSequencerMorph>>reset (in category 'accessing') -----
- ----- Method: SoundSequencerMorph>>reset (in category 'as yet unclassified') -----
reset
self submorphsDo: [:m | m == controlPanel ifFalse: [m reset]]!
Item was changed:
+ ----- Method: SpectrumAnalyzerMorph class>>descriptionForPartsBin (in category 'parts bin') -----
- ----- Method: SpectrumAnalyzerMorph class>>descriptionForPartsBin (in category 'as yet unclassified') -----
descriptionForPartsBin
^ self
partName: 'Spectrum Analyzer' translatedNoop
categories: {'Multimedia' translatedNoop}
documentation: 'A device for analyzing sound input' translatedNoop
!
Item was changed:
----- Method: StandardFileStream class>>fileDoesNotExistUserHandling: (in category '*Etoys-Squeakland-error handling') -----
fileDoesNotExistUserHandling: fullFileName
| selection newName |
selection := (PopUpMenu labels:
'create a new file
choose another name
cancel' translated)
startUpWithCaption: ('{1}
does not exist.' translated format: {FileDirectory localNameFor: fullFileName}) .
selection = 1 ifTrue:
[^ self new open: fullFileName forWrite: true].
selection = 2 ifTrue:
[ newName := FillInTheBlank request: 'Enter a new file name' translated
initialAnswer: fullFileName.
^ self oldFileNamed:
(self fullName: newName)].
+ ^ self error: 'Could not open a file' translated!
- ^ self error: 'Could not open a file'!
Item was changed:
----- Method: StandardFileStream class>>readOnlyFileDoesNotExistUserHandling: (in category '*Etoys-Squeakland-error handling') -----
readOnlyFileDoesNotExistUserHandling: fullFileName
| dir files choices selection newName fileName |
dir := FileDirectory forFileName: fullFileName.
files := dir fileNames.
fileName := FileDirectory localNameFor: fullFileName.
choices := fileName correctAgainst: files.
choices add: 'Choose another name' translated.
choices add: 'Cancel' translated.
selection := (PopUpMenu labelArray: choices lines: (Array with: 5) )
startUpWithCaption: ( '{1}
does not exist.' translated format: {FileDirectory localNameFor: fullFileName}).
selection = choices size ifTrue:["cancel" ^ nil "should we raise another exception here?"].
selection < (choices size - 1) ifTrue: [
newName := (dir pathName , FileDirectory slash , (choices at: selection))].
selection = (choices size - 1) ifTrue: [
newName := FillInTheBlank
request: 'Enter a new file name' translated
initialAnswer: fileName].
newName = '' ifFalse: [^ self readOnlyFileNamed: (self fullName: newName)].
+ ^ self error: 'Could not open a file' translated!
- ^ self error: 'Could not open a file'!
1
0
Christoph Thiede uploaded a new version of Compression to project The Trunk:
http://source.squeak.org/trunk/Compression-ct.57.mcz
==================== Summary ====================
Name: Compression-ct.57
Author: ct
Time: 3 January 2022, 7:17:31.519703 pm
UUID: 32eabe2a-30cb-9e45-9820-3f00c262870f
Ancestors: Compression-dtl.55
Fixes ZipWriteStream regression tests. The file stream under test, and thus FastInflateStream, streams bytes rather than chracters, so provide ByteArrays rather than strings as target buffers.
=============== Diff against Compression-dtl.55 ===============
Item was changed:
----- Method: ZipWriteStream class>>regressionDecompress:from:notifying:stats: (in category 'regression test') -----
regressionDecompress: aFile from: tempFile notifying: progressBar stats: stats
"Validate aFile as decompressed from tempFile"
| unzip rawSize compressedSize buffer1 buffer2 |
rawSize := aFile size.
compressedSize := tempFile size.
aFile ascii.
aFile position: 0.
tempFile ascii.
tempFile position: 0.
+ buffer1 := ByteArray new: 4096.
- buffer1 := String new: 4096.
buffer2 := buffer1 copy.
unzip := FastInflateStream on: tempFile.
[aFile atEnd] whileFalse:[
progressBar value: aFile position.
buffer1 := aFile nextInto: buffer1.
buffer2 := unzip nextInto: buffer2.
buffer1 = buffer2
ifFalse:[^self logProblem: 'contents ' for: aFile].
].
unzip next = nil ifFalse:[^self logProblem: 'EOF' for: aFile].
stats at: #rawSize put:
(stats at: #rawSize ifAbsent:[0]) + rawSize.
stats at: #compressedSize put:
(stats at: #compressedSize ifAbsent:[0]) + compressedSize.
^compressedSize asFloat / rawSize asFloat.!
1
0
Christoph Thiede uploaded a new version of Compiler to project The Trunk:
http://source.squeak.org/trunk/Compiler-ct.466.mcz
==================== Summary ====================
Name: Compiler-ct.466
Author: ct
Time: 3 January 2022, 5:59:21.929703 pm
UUID: 22900e61-c1eb-914e-be93-b57e0e7901fd
Ancestors: Compiler-eem.465, Compiler-ct.421
Recategorizations and multilingual improvements.
=============== Diff against Compiler-eem.465 ===============
Item was changed:
----- Method: AmbiguousSelector>>openMenuIn: (in category 'handling') -----
openMenuIn: aBlock
"Ask the user which selector to choose.
Answer the choosen selector or nil if cancellation is requested."
| labels actions lines caption choice |
labels := {
+ ('selector is {1} and argument is negative' translated format: {name copyFrom: 1 to: name size - 1}).
+ ('selector is {1} and argument is positive' translated format: {name}).
+ 'cancel' translated}.
- 'selector is ' , (name copyFrom: 1 to: name size - 1) , ' argument is negative'.
- 'selector is ' , name , ' argument is positive'.
- 'cancel'}.
actions := {
name copyReplaceFrom: name size to: name size - 1 with: ' '.
name copyReplaceFrom: name size + 1 to: name size with: ' '.
nil.
}.
lines := {2}.
+ caption := 'Ambiguous selector: {1} please correct, or cancel:' translated format: {name}.
- caption := 'Ambiguous selector: ' , name , ' please correct, or cancel:'.
choice := aBlock value: labels value: lines value: caption.
self resume: (actions at: choice ifAbsent: [nil])!
Item was changed:
+ ----- Method: AmbiguousSelector>>setName:range: (in category 'initialization') -----
- ----- Method: AmbiguousSelector>>setName:range: (in category 'private') -----
setName: aString range: anInterval
name := aString.
interval := anInterval!
Item was changed:
+ ----- Method: OutOfScopeNotification>>defaultAction (in category 'priv handling') -----
- ----- Method: OutOfScopeNotification>>defaultAction (in category 'as yet unclassified') -----
defaultAction
^false!
Item was changed:
+ ----- Method: ParserNotification class>>name: (in category 'instance creation') -----
- ----- Method: ParserNotification class>>name: (in category 'as yet unclassified') -----
name: aString
^ (self new setName: aString) signal!
Item was changed:
+ ----- Method: ParserNotification>>setName: (in category 'initialization') -----
- ----- Method: ParserNotification>>setName: (in category 'private') -----
setName: aString
name := aString!
Item was changed:
+ ----- Method: UndeclaredVariable>>openMenuIn: (in category 'handling') -----
- ----- Method: UndeclaredVariable>>openMenuIn: (in category 'as yet unclassified') -----
openMenuIn: aBlock
| alternatives labels actions lines caption choice |
alternatives := parser possibleVariablesFor: name.
labels := OrderedCollection new.
actions := OrderedCollection new.
lines := OrderedCollection new.
name first isLowercase
ifTrue:
+ [labels add: 'declare method temp' translated.
- [labels add: 'declare method temp'.
actions add: [parser declareTemp: name at: #method].
+ labels add: 'declare block-local temp' translated.
- labels add: 'declare block-local temp'.
actions add: [parser declareTemp: name at: #block].
parser canDeclareInstanceVariable
ifTrue:
+ [labels add: 'declare instance' translated.
- [labels add: 'declare instance'.
actions add: [parser declareInstVar: name]]]
ifFalse:
+ [labels add: 'define new class' translated.
- [labels add: 'define new class'.
actions add: [parser defineClass: name].
+ labels add: 'declare global' translated.
- labels add: 'declare global'.
actions add: [parser declareGlobal: name].
parser canDeclareClassVariable
ifTrue:
+ [labels add: 'declare class variable' translated.
- [labels add: 'declare class variable'.
actions add: [parser declareClassVar: name]]].
lines add: labels size.
alternatives do:
[:each |
labels add: each.
actions add: [parser substituteVariable: each atInterval: interval]].
lines add: labels size.
+ labels add: 'cancel' translated.
+ caption := 'Unknown variable: {1}!! please correct, or cancel:' translated format: {name}.
- labels add: 'cancel'.
- caption := 'Unknown variable: ' , name , ' please correct, or cancel:'.
choice := aBlock value: labels value: lines value: caption.
self resume: (actions at: choice ifAbsent: [nil])!
Item was changed:
+ ----- Method: UndeclaredVariable>>setParser:name:range: (in category 'initialize-release') -----
- ----- Method: UndeclaredVariable>>setParser:name:range: (in category 'as yet unclassified') -----
setParser: aParser name: aString range: anInterval
parser := aParser.
name := aString.
interval := anInterval!
Item was changed:
+ ----- Method: UndefinedVariable>>openMenuIn: (in category 'handling') -----
- ----- Method: UndefinedVariable>>openMenuIn: (in category 'as yet unclassified') -----
openMenuIn: aBlock
self resume: (Project uiManager
confirm: ('{1} appears to be undefined at this point.\Proceed anyway?' withCRs translated asText
format: {name asText allBold})
orCancel: [false]
title: 'Undefined Variable' translated).!
Item was changed:
+ ----- Method: UnknownSelector>>openMenuIn: (in category 'handling') -----
- ----- Method: UnknownSelector>>openMenuIn: (in category 'as yet unclassified') -----
openMenuIn: aBlock
| alternatives labels lines caption choice |
alternatives := Symbol possibleSelectorsFor: name.
labels := Array streamContents:
[:s | s nextPut: name; nextPutAll: alternatives].
lines := {1. alternatives size + 1}.
+ caption := 'Unknown selector, please\confirm, correct, or cancel' translated withCRs.
- caption := 'Unknown selector, please\confirm, correct, or cancel' withCRs.
choice := aBlock value: labels value: lines value: caption.
choice = 0 ifTrue: [^ self resume: nil].
choice = 1 ifTrue: [^ self resume: name asSymbol].
self resume: (alternatives at: choice - 1)!
1
0
Christoph Thiede uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-ct.1840.mcz
==================== Summary ====================
Name: Morphic-ct.1840
Author: ct
Time: 3 January 2022, 5:10:40.762703 pm
UUID: 3a699b7d-f8fa-8343-9bb3-d6f8891fffbf
Ancestors: Morphic-mt.1839
Implements "browse action code" and "debug action invocation" on SimpleButtonMorph. Try it out on a system window's box, for instance.
=============== Diff against Morphic-mt.1839 ===============
Item was added:
+ ----- Method: SimpleButtonMorph>>browseImplementationOfActionSelector (in category 'debug menu') -----
+ browseImplementationOfActionSelector
+
+ ToolSet browseMethod: (self target class lookupSelector: self actionSelector).!
Item was added:
+ ----- Method: SimpleButtonMorph>>buildDebugMenu: (in category 'debug menu') -----
+ buildDebugMenu: aHandMorph
+
+ | aMenu |
+ aMenu := super buildDebugMenu: aHandMorph.
+ aMenu addLine.
+ aMenu add: 'browse action code' translated target: self action: #browseImplementationOfActionSelector.
+ aMenu add: 'debug action invocation' translated target: self action: #debugAction.
+ ^ aMenu!
Item was added:
+ ----- Method: SimpleButtonMorph>>debugAction (in category 'debug menu') -----
+ debugAction
+
+ (Process
+ forBlock: [self doButtonAction]
+ runUntil: [:context | context selector = self actionSelector])
+ debugWithTitle: ('Debug button action "{1}" in model "{2}"' translated format: {self label. self target printString}).!
1
0
Christoph Thiede uploaded a new version of Speech to project The Treated Inbox:
http://source.squeak.org/treated/Speech-ct.11.mcz
==================== Summary ====================
Name: Speech-ct.11
Author: ct
Time: 18 September 2021, 4:08:09.405753 pm
UUID: 2a0c4fff-4f32-a442-a771-2d504dc76307
Ancestors: Speech-md.9
Fix deprecation warnings by switching from #clone to #copy. Ensure order of class initializations.
==================== Snapshot ====================
SystemOrganization addCategory: #'Speech-Events'!
SystemOrganization addCategory: #'Speech-Gestures'!
SystemOrganization addCategory: #'Speech-Klatt'!
SystemOrganization addCategory: #'Speech-Phoneme Recognizer'!
SystemOrganization addCategory: #'Speech-Phoneme Recognize-Test'!
SystemOrganization addCategory: #'Speech-Phonetics'!
SystemOrganization addCategory: #'Speech-Support'!
SystemOrganization addCategory: #'Speech-TTS'!
EllipseMorph subclass: #EyeMorph
instanceVariableNames: 'iris'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Gestures'!
----- Method: EyeMorph>>closeEyelid (in category 'actions') -----
closeEyelid
self iris delete.
self position: self position + (0 @ (self extent y // 2)).
self extent: self extent x @ 2!
----- Method: EyeMorph>>defaultColor (in category 'initialization') -----
defaultColor
"answer the default color/fill style for the receiver"
^ Color
r: 1.0
g: 0.968
b: 0.935!
----- Method: EyeMorph>>dilate: (in category 'actions') -----
dilate: amount
| irisCenter |
irisCenter := self iris center.
self iris extent: self iris extent * amount.
self iris position: irisCenter - self iris center + self iris position!
----- Method: EyeMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self extent: 30 @ 37.
self addMorphFront: (iris := EllipseMorph new extent: 6 @ 6;
borderWidth: 0;
color: Color black).
self lookAtFront!
----- Method: EyeMorph>>iris (in category 'accessing') -----
iris
^ iris!
----- Method: EyeMorph>>lookAt: (in category 'actions') -----
lookAt: aPoint
| theta scale |
(self containsPoint: aPoint) ifTrue: [self iris align: iris center with: aPoint. ^ self].
theta := (aPoint - self center) theta.
scale := (aPoint - self center) r / 100.0 min: 1.0.
self iris align: self iris center with: self center + (theta cos @ theta sin * self extent / 3.0 * scale) rounded!
----- Method: EyeMorph>>lookAtFront (in category 'actions') -----
lookAtFront
self iris position: self center - self iris center + self iris position!
----- Method: EyeMorph>>lookAtMorph: (in category 'actions') -----
lookAtMorph: aMorph
self lookAt: aMorph center!
----- Method: EyeMorph>>openEyelid (in category 'actions') -----
openEyelid
self extent: self extent x @ (self extent x * 37.0 / 30.0) rounded.
self position: self position - (0 @ (self extent y // 2)).
self addMorphFront: self iris!
----- Method: EyeMorph>>openness: (in category 'actions') -----
openness: aNumber
| previousCenter |
previousCenter := self center.
self extent: self extent x @ (self extent x * 37.0 / 30.0 * aNumber) rounded.
self align: self center with: previousCenter.
(self containsPoint: self iris center) ifFalse: [self lookAtFront]!
EllipseMorph subclass: #HeadMorph
instanceVariableNames: 'face queue'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Gestures'!
----- Method: HeadMorph>>addAfroHair (in category 'furnitures') -----
addAfroHair
| hair |
hair := CurveMorph
vertices: {115@4. 144@20. 166@79. 132@131. 116@93. 88@85. 54@94. 40@134. 2@79. 31@16. 79@1}
color: self randomHairColor
borderWidth: 1
borderColor: Color black.
hair extent: (hair extent * (self width / hair width * 1.9)) rounded.
hair align: hair center with: self center x @ self top.
self addMorphFront: hair!
----- Method: HeadMorph>>addBeret (in category 'furnitures') -----
addBeret
| beret pompon |
beret := CurveMorph
vertices: {66@1. 90@14. 106@22. 114@35. 98@43. 55@35. 20@46. 2@38. 8@23. 23@13. 39@7}
color: Color random
borderWidth: 1
borderColor: Color black.
beret extent: (beret extent * (self width / beret width * 4 / 3)) rounded.
beret align: beret center x @ beret bottom with: self center x @ self face top.
pompon := EllipseMorph new color: beret color; borderWidth: 1; borderColor: Color black; extent: beret height // 2.
pompon align: pompon center with: beret center x @ beret top.
beret addMorphFront: pompon.
self addMorphFront: beret!
----- Method: HeadMorph>>addEars (in category 'furnitures') -----
addEars
| leftEar rightEar |
leftEar := EllipseMorph new color: self color; extent: self height // 10 @ (self height // 7).
rightEar := leftEar copy.
leftEar align: leftEar center with: self left @ self center y.
rightEar align: rightEar center with: self right @ self center y.
self addMorphBack: leftEar; addMorphBack: rightEar!
----- Method: HeadMorph>>addGlasses (in category 'furnitures') -----
addGlasses
| glass glass2 diameter |
diameter := self face leftEye height * 2 // 3.
glass := EllipseMorph new extent: diameter @ diameter; color: (Color yellow alpha: 0.5).
glass2 := glass copy.
glass align: glass center with: self face leftEye center.
glass2 align: glass2 center with: self face rightEye center.
self addMorph: glass; addMorph: glass2!
----- Method: HeadMorph>>addHighHat (in category 'furnitures') -----
addHighHat
| hat |
hat := CurveMorph
vertices: {70@3. 98@11. 94@46. 112@50. 96@58. 53@50. 18@61. 2@58. 24@48. 30@6. 47@6}
color: Color random
borderWidth: 1
borderColor: Color black.
hat extent: (hat extent * (self width / hat width * 4 / 3)) rounded.
hat align: hat center x @ hat bottom with: self center x @ self face top.
self addMorphFront: hat!
----- Method: HeadMorph>>addLargeMustache (in category 'furnitures') -----
addLargeMustache
| mustache |
mustache := CurveMorph
vertices: {48@4. 75@3. 93@15. 48@9. 3@19. 17@5}
color: self randomHairColor
borderWidth: 1
borderColor: Color black.
mustache extent: (mustache extent * (self width / mustache width)) rounded.
mustache align: mustache center with: self face mustachePosition.
self addMorphFront: mustache!
----- Method: HeadMorph>>addRandomFurnitures (in category 'furnitures') -----
addRandomFurnitures
self perform: #(#yourself #addBeret #addHighHat #addAfroHair #addShortHair #addSpikyHair ) atRandom.
self perform: #(#yourself #yourself #addShortMustache ) atRandom!
----- Method: HeadMorph>>addShortHair (in category 'furnitures') -----
addShortHair
| hair |
hair := CurveMorph
vertices: {81@3. 101@22. 105@48. 93@65. 76@32. 54@32. 28@35. 11@64. 2@52. 10@15. 45@2}
color: self randomHairColor
borderWidth: 1
borderColor: Color black.
hair extent: (hair extent * (self width / hair width * 1.15)) rounded.
hair align: hair center x @ (hair top * 4 + hair bottom // 5) with: self center x @ self top.
self addMorphFront: hair!
----- Method: HeadMorph>>addShortMustache (in category 'furnitures') -----
addShortMustache
| mustache |
mustache := CurveMorph
vertices: {29@1. 54@14. 30@11. 1@15}
color: self randomHairColor
borderWidth: 1
borderColor: Color black.
mustache extent: (mustache extent * (self width / mustache width * 0.5)) rounded.
mustache align: mustache center with: self face mustachePosition.
self addMorphFront: mustache!
----- Method: HeadMorph>>addSpikyHair (in category 'furnitures') -----
addSpikyHair
| hair |
hair := PolygonMorph
vertices: {83@3. 81@30. 91@27. 111@23. 97@32. 112@37. 99@45. 114@52. 95@53. 55@43. 10@50. 1@40. 14@40. 8@26. 24@37. 15@11. 29@29. 30@16. 36@30. 41@6. 49@31. 54@8. 61@32. 64@1. 70@27}
color: self randomHairColor
borderWidth: 1
borderColor: Color black.
hair extent: (hair extent * (self width / hair width * 1.15)) rounded.
hair align: hair center with: self center x @ self top.
self addMorphFront: hair!
----- Method: HeadMorph>>addWhiteHat (in category 'furnitures') -----
addWhiteHat
| stage1 stage2 |
stage1 := CurveMorph
vertices: {18@1. 93@18. 91@45. 8@40}
color: (Color r: 1.0 g: 0.968 b: 0.935)
borderWidth: 1
borderColor: Color black.
stage1 extent: (stage1 extent * (self width / stage1 width * 1.20)) rounded.
stage2 := CurveMorph
vertices: {27@7. 81@5. 111@34. 11@28}
color: stage1 color
borderWidth: 1
borderColor: Color black.
stage2 extent: (stage2 extent * (self width / stage2 width * 1.20)) rounded.
stage1 align: stage1 center with: self center x @ self top.
stage2 align: stage2 center with: stage1 center x @ stage1 top.
stage1 addMorphFront: stage2.
self addMorphFront: stage1!
----- Method: HeadMorph>>defaultColor (in category 'initialization') -----
defaultColor
"answer the default color/fill style for the receiver"
^ {Color
r: 0.258
g: 0.161
b: 0.0. Color
r: 0.452
g: 0.258
b: 0.0. Color
r: 0.516
g: 0.323
b: 0.0. Color
r: 1.0
g: 0.935
b: 0.645. Color
r: 1.0
g: 0.806
b: 0.548} atRandom!
----- Method: HeadMorph>>face (in category 'accessing') -----
face
^ face!
----- Method: HeadMorph>>face: (in category 'accessing') -----
face: aFaceMorph
face notNil ifTrue: [face delete].
self addMorphFront: (face := aFaceMorph)!
----- Method: HeadMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self face: FaceMorph new.
self extent: self face extent * (1.5 @ 1.7).
self face align: self face center with: self center + (0 @ self height // 10).
self addRandomFurnitures.
queue := SharedQueue new!
----- Method: HeadMorph>>playEvent:at: (in category 'accessing') -----
playEvent: event at: time
self queue nextPut: time -> event!
----- Method: HeadMorph>>queue (in category 'accessing-private') -----
queue
^ queue!
----- Method: HeadMorph>>randomHairColor (in category 'furnitures') -----
randomHairColor
| hairColors |
hairColors := {Color r: 0.613 g: 0.161 b: 0.0. "red"
Color r: 0.323 g: 0.226 b: 0.0. "dark brown"
Color r: 0.774 g: 0.548 b: 0.0. "light brown"
Color r: 0.968 g: 0.871 b: 0.0. "yellow"
Color r: 0.581 g: 0.581 b: 0.581. "gray"
Color black}.
self submorphs do: [ :each | (hairColors includes: each color) ifTrue: [^ each color]].
^ hairColors atRandom!
----- Method: HeadMorph>>step (in category 'stepping and presenter') -----
step
| now |
super step.
now := Time millisecondClockValue.
[queue isEmpty not and: [now >= queue peek key]]
whileTrue: [queue next value actOn: self].
self face lips updateShape!
----- Method: HeadMorph>>stepTime (in category 'testing') -----
stepTime
^ 0!
PolygonMorph subclass: #LipsMorph
instanceVariableNames: 'newVertices newScale'
classVariableNames: 'PhoneticArticulations'
poolDictionaries: ''
category: 'Speech-Gestures'!
----- Method: LipsMorph class>>initialize (in category 'class initialization') -----
initialize
"
LipsMorph initialize
"
| o u a e i m n p t s |
a := {22@2. 39@4. 45@16. 23@23. 2@15. 9@4}.
e := {23@2. 41@3. 45@15. 21@19. 2@14. 6@3}.
i := {21@2. 40@4. 45@14. 23@16. 2@13. 8@4}.
o := {18@1. 31@5. 31@20. 16@24. 3@19. 5@5}.
u := {14@1. 23@6. 22@16. 11@20. 2@14. 3@4}.
m := {17@2. 31@2. 27@4. 15@3. 2@4. 6@2}.
n := {20@3. 33@2. 39@8. 19@9. 2@8. 7@2}.
p := {7@1. 16@3. 12@5. 6@6. 1@4}.
t := {14@2. 29@3. 21@7. 12@8. 1@3}.
s := {19@2. 32@4. 35@10. 18@13. 2@10. 9@3}.
PhoneticArticulations := Dictionary new.
"Default"
PhonemeSet initialize. "arpabet needs to be initialized first"
PhonemeSet arpabet do: [ :each | PhoneticArticulations at: each put: p].
"Vowels"
PhonemeSet arpabet do: [ :each |
each name first = $a ifTrue: [PhoneticArticulations at: each put: a].
each name first = $e ifTrue: [PhoneticArticulations at: each put: e].
each name first = $i ifTrue: [PhoneticArticulations at: each put: i].
each name first = $o ifTrue: [PhoneticArticulations at: each put: o].
each name first = $u ifTrue: [PhoneticArticulations at: each put: u].
each name first = $w ifTrue: [PhoneticArticulations at: each put: u]].
"Particulars"
PhoneticArticulations
at: (PhonemeSet arpabet at: 'm') put: m;
at: (PhonemeSet arpabet at: 'n') put: n;
at: (PhonemeSet arpabet at: 't') put: t;
at: (PhonemeSet arpabet at: 's') put: s;
at: (PhonemeSet arpabet at: 'sh') put: s;
at: (PhonemeSet arpabet at: 'sh') put: s;
at: (PhonemeSet arpabet at: 'zh') put: s;
at: (PhonemeSet arpabet at: 'th') put: s;
at: (PhonemeSet arpabet at: 'jh') put: s;
at: (PhonemeSet arpabet at: 'dh') put: s;
at: (PhonemeSet arpabet at: 'd') put: s;
at: (PhonemeSet arpabet at: 'z') put: s!
----- Method: LipsMorph>>articulate: (in category 'actions') -----
articulate: aPhoneme
self newVerticesCentered: (PhoneticArticulations at: aPhoneme ifAbsent: [^ self]) scaled: 0.5!
----- Method: LipsMorph>>defaultBorderColor (in category 'initialization') -----
defaultBorderColor
"answer the default border color/fill style for the receiver"
^ Color black!
----- Method: LipsMorph>>defaultBorderWidth (in category 'initialization') -----
defaultBorderWidth
"answer the default border width for the receiver"
^ 1!
----- Method: LipsMorph>>defaultColor (in category 'initialization') -----
defaultColor
"answer the default color/fill style for the receiver"
^ Color black!
----- Method: LipsMorph>>grin (in category 'actions') -----
grin
self newVerticesCentered: {17@5. 30@7. 33@12. 16@14. 2@10. 5@2}!
----- Method: LipsMorph>>hideTongue (in category 'actions') -----
hideTongue
self submorphs do: [ :each | each delete]!
----- Method: LipsMorph>>horror (in category 'actions') -----
horror
self newVerticesCentered: {21@3. 37@5. 36@19. 19@19. 3@19. 5@4}!
----- Method: LipsMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self beSmoothCurve.
vertices := {11 @ 3. 35 @ 1. 60 @ 5. 67 @ 17. 34 @ 24. 3 @ 17}.
closed := true.
self neutral; updateShape!
----- Method: LipsMorph>>neutral (in category 'actions') -----
neutral
self newVerticesCentered: {13@1. 22@4. 12@6. 1@4}!
----- Method: LipsMorph>>newVerticesCentered: (in category 'actions') -----
newVerticesCentered: anArray
self newVerticesCentered: anArray scaled: 0.5!
----- Method: LipsMorph>>newVerticesCentered:scaled: (in category 'actions') -----
newVerticesCentered: anArray scaled: aNumber
newVertices := anArray.
newScale := aNumber!
----- Method: LipsMorph>>openness: (in category 'actions') -----
openness: amount
self newVerticesCentered: {40@-3. 74@8. 59@ (21 * amount). 38@ (20 * amount). 22@ (21 * amount). 3@8}!
----- Method: LipsMorph>>sad (in category 'actions') -----
sad
self newVerticesCentered: {26@4. 50@10. 41@4. 27@2. 14@3. 1@10}!
----- Method: LipsMorph>>showTongue (in category 'actions') -----
showTongue
| tongue |
self hideTongue.
tongue := CurveMorph vertices: {10@2. 21@5. 16@23. 10@27. 5@23. 2@4} color: Color red borderWidth: 0 borderColor: Color black.
tongue position: self center - (10 @ 0).
self addMorphFront: tongue!
----- Method: LipsMorph>>smile (in category 'actions') -----
smile
self newVerticesCentered: {26@11. 43@7. 51@2. 44@12. 26@19. 8@14. 2@4. 12@9}!
----- Method: LipsMorph>>surprise (in category 'actions') -----
surprise
self newVerticesCentered: {22@3. 38@7. 37@21. 20@26. 4@21. 6@6}!
----- Method: LipsMorph>>updateShape (in category 'actions') -----
updateShape
| center median |
newVertices isNil ifTrue: [^ self].
median := 0 @ 0.
newVertices do: [ :each | median := median + each].
median := median / newVertices size.
center := self center.
self setVertices: (newVertices collect: [ :each | (each - median) * newScale + median]).
self position: self position - self center + center.
newVertices := nil!
----- Method: LipsMorph>>verticesString (in category 'accessing') -----
verticesString
| stream first |
stream := WriteStream with: ''.
stream nextPut: ${.
first := true.
vertices do: [ :each |
first ifFalse: [stream nextPutAll: '. '].
stream print: (each - self position) rounded.
first := false].
stream nextPut: $}.
^ stream contents!
SharedPool subclass: #KlattResonatorIndices
instanceVariableNames: ''
classVariableNames: 'R1c R1vp R2c R2fp R2vp R3c R3fp R3vp R4c R4fp R4vp R5c R5fp R6c R6fp R7c R8c Rnpc Rnpp Rnz Rout Rtpc Rtpp Rtz'
poolDictionaries: ''
category: 'Speech-Klatt'!
----- Method: KlattResonatorIndices class>>initialize (in category 'pool initialization') -----
initialize
"KlattResonatorIndices initialize"
Rnpp := 1.
Rtpp := 2.
R1vp := 3.
R2vp := 4.
R3vp := 5.
R4vp := 6.
R2fp := 7.
R3fp := 8.
R4fp := 9.
R5fp := 10.
R6fp := 11.
R1c := 12.
R2c := 13.
R3c := 14.
R4c := 15.
R5c := 16.
R6c := 17.
R7c := 18.
R8c := 19.
Rnpc := 20.
Rnz := 21.
Rtpc := 22.
Rtz := 23.
Rout := 24.!
FloatArray variableWordSubclass: #KlattFrame
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Klatt'!
!KlattFrame commentStamp: '<historical>' prior: 0!
My instances are frames of parameters which are inputs for KlattSynthesizers. See the class method category 'documentation' for more details.!
----- Method: KlattFrame class>>default (in category 'instance creation') -----
default
"
KlattFrame default edit
"
^ self new
f0: 133;
flutter: 0; jitter: 0; shimmer: 0; diplophonia: 0;
voicing: 62;
ro: 0.4; ra: 0.01; rk: 0.25;
aspiration: 0;
friction: 0;
turbulence: 0;
f1: 500; b1: 60;
df1: 0; db1: 0;
f2: 1500; b2: 90;
f3: 2800; b3: 150;
f4: 3250; b4: 200;
f5: 3700; b5: 200;
f6: 4990; b6: 500;
fnp: 280; bnp: 90;
fnz: 280; bnz: 90;
ftp: 2150; btp: 180;
ftz: 2150; btz: 180;
a2f: 52.5; b2f: 200;
a3f: 39.3; b3f: 350;
a4f: 25.4; b4f: 500;
a5f: 0; b5f: 600;
a6f: 0; b6f: 800;
bypass: 0;
anv: 0;
a1v: 60.3;
a2v: 52.5;
a3v: 39.3;
a4v: 25.4;
atv: 0;
gain: 62!
----- Method: KlattFrame class>>defaultForParameter: (in category 'documentation') -----
defaultForParameter: aSymbol
^ self default perform: aSymbol asSymbol!
----- Method: KlattFrame class>>descriptionForParameter: (in category 'documentation') -----
descriptionForParameter: aSymbol
^ (self parameterData detect: [ :one | one first = aSymbol]) at: 4!
----- Method: KlattFrame class>>example1 (in category 'examples') -----
example1
"
KlattFrame example1.
KlattFrame example2.
KlattFrame example3
"
| frame |
frame := self default
voicing: 62;
anv: 0; a1v: 0; a2v: 0; a3v: 0; a4v: 0;
yourself.
(KlattSynthesizer new cascade: 6; millisecondsPerFrame: 1000; soundFromFrames: {frame}) play!
----- Method: KlattFrame class>>example2 (in category 'examples') -----
example2
"
KlattFrame example2
"
| frame |
frame := self default
voicing: 62;
anv: 0; a1v: 62; a2v: 62; a3v: 62; a4v: 62;
yourself.
(KlattSynthesizer new cascade: 6; millisecondsPerFrame: 1000; soundFromFrames: {frame}) play!
----- Method: KlattFrame class>>example3 (in category 'examples') -----
example3
"
KlattFrame example3
"
| frame |
frame := self default
voicing: 62;
anv: 0; a1v: 62; a2v: 62; a3v: 62; a4v: 62;
yourself.
(KlattSynthesizer new cascade: 0; millisecondsPerFrame: 1000; soundFromFrames: {frame}) play!
----- Method: KlattFrame class>>fromArray: (in category 'instance creation') -----
fromArray: anArray
| answer |
answer := self new.
anArray doWithIndex: [ :each :i | answer at: i put: each].
^ answer!
----- Method: KlattFrame class>>fromString: (in category 'instance creation') -----
fromString: aString
^ self fromArray: (aString substrings collect: [ :each | each asNumber])!
----- Method: KlattFrame class>>generateAccessors (in category 'code generation') -----
generateAccessors
"
KlattFrame generateAccessors
"
| crtab getter setter |
crtab := String with: Character cr with: Character tab.
self parameterNames
doWithIndex: [ :selector :i |
getter := selector, crtab, '^ self at: ', i printString.
setter := selector, ': aNumber', crtab, 'self at: ', i printString,' put: aNumber'.
self compile: getter classified: 'accessing'.
self compile: setter classified: 'accessing']!
----- Method: KlattFrame class>>maximumForParameter: (in category 'documentation') -----
maximumForParameter: aSymbol
^ (self parameterData detect: [ :one | one first = aSymbol]) at: 3!
----- Method: KlattFrame class>>minimumForParameter: (in category 'documentation') -----
minimumForParameter: aSymbol
^ (self parameterData detect: [ :one | one first = aSymbol]) at: 2!
----- Method: KlattFrame class>>new (in category 'instance creation') -----
new
^ super new: 52!
----- Method: KlattFrame class>>parameterData (in category 'documentation') -----
parameterData
"This is a table describing the Klatt parameters. The columns are: parameter name, minimum value, maximum, parameter description, unit."
^ #(
"Excitation source (voice, aspiration and friction):"
(f0 20 1000 'Fundamental frequency (hz)' hz)
(flutter 0 1 'Amount of flutter' value)
(jitter 0 1 'Amount of jitter' value)
(shimmer 0 1 'Amount of shimmer' value)
(diplophonia 0 1 'Amount of diplophonia' value)
(voicing 0 80 'Amplitude of voicing' hz)
(ro 0.01 1 'Relative duration of open phase of voicing waveform = Te/T0 (0.01 - 1)' value)
(ra 0.01 0.2 'Relative duration of return phase of voicing waveform = Ta/T0 (0.01 - 1)' value)
(rk 0.01 1 'Simmetry of the glottal pulse = (Te-Tp)/Tp (0.01 - 1)' value)
(aspiration 0 80 'Amplitude of aspiration' dB)
(friction 0 80 'Amplitude of friction' dB)
(turbulence 0 80 'Amplitude of turbulence (in open glottal phase)' dB)
"Formants frequencies and bandwidths:"
(f1 200 1300 'Frequency of 1st formant' hz)
(b1 40 1000 'Bandwidth of 1st formant' hz)
(df1 0 100 'Change in F1 during open portion of period' hz)
(db1 0 400 'Change in B1 during open portion of period' hz)
(f2 550 3000 'Frequency of 2nd formant' hz)
(b2 40 1000 'Bandwidth of 2nd formant' hz)
(f3 1200 4999 'Frequency of 3rd formant' hz)
(b3 40 1000 'Bandwidth of 3rd formant' hz)
(f4 1200 4999 'Frequency of 4th formant' hz)
(b4 40 1000 'Bandwidth of 4th formant' hz)
(f5 1200 4999 'Frequency of 5th formant' hz)
(b5 40 1000 'Bandwidth of 5th formant' hz)
(f6 1200 4999 'Frequency of 6th formant' hz)
(b6 40 1000 'Bandwidth of 6th formant' hz)
(fnp 248 528 'Frequency of nasal pole' hz)
(bnp 40 1000 'Bandwidth of nasal pole' hz)
(fnz 248 528 'Frequency of nasal zero' hz)
(bnz 40 1000 'Bandwidth of nasal zero' hz)
(ftp 300 3000 'Frequency of tracheal pole' hz)
(btp 40 1000 'Bandwidth of tracheal pole' hz)
(ftz 300 3000 'Frequency of tracheal zero' hz)
(btz 40 2000 'Bandwidth of tracheal zero' hz)
"Parallel Friction-Excited:"
(a2f 0 80 'Amplitude of friction-excited parallel 2nd formant' dB)
(a3f 0 80 'Amplitude of friction-excited parallel 3rd formant' dB)
(a4f 0 80 'Amplitude of friction-excited parallel 4th formant' dB)
(a5f 0 80 'Amplitude of friction-excited parallel 5th formant' dB)
(a6f 0 80 'Amplitude of friction-excited parallel 6th formant' dB)
(bypass 0 80 'Amplitude of friction-excited parallel bypass path' dB)
(b2f 40 1000 'Bandwidth of friction-excited parallel 2nd formant' hz)
(b3f 60 1000 'Bandwidth of friction-excited parallel 2nd formant' hz)
(b4f 100 1000 'Bandwidth of friction-excited parallel 2nd formant' hz)
(b5f 100 1500 'Bandwidth of friction-excited parallel 2nd formant' hz)
(b6f 100 4000 'Bandwidth of friction-excited parallel 2nd formant' hz)
"Parallel Voice-Excited:"
(anv 0 80 'Amplitude of voice-excited parallel nasal formant' dB)
(a1v 0 80 'Amplitude of voice-excited parallel 1st formant' dB)
(a2v 0 80 'Amplitude of voice-excited parallel 2nd formant' dB)
(a3v 0 80 'Amplitude of voice-excited parallel 3rd formant' dB)
(a4v 0 80 'Amplitude of voice-excited parallel 4th formant' dB)
(atv 0 80 'Amplitude of voice-excited parallel tracheal formant' dB)
"Overall gain:"
(gain 0 80 'Overall gain' dB))!
----- Method: KlattFrame class>>parameterNames (in category 'documentation') -----
parameterNames
^ self parameterData collect: [ :each | each first]!
----- Method: KlattFrame class>>unitForParameter: (in category 'documentation') -----
unitForParameter: aSymbol
^ (self parameterData detect: [ :one | one first = aSymbol]) at: 5!
----- Method: KlattFrame>>a1v (in category 'accessing') -----
a1v
^ self at: 47!
----- Method: KlattFrame>>a1v: (in category 'accessing') -----
a1v: aNumber
self at: 47 put: aNumber!
----- Method: KlattFrame>>a2f (in category 'accessing') -----
a2f
^ self at: 35!
----- Method: KlattFrame>>a2f: (in category 'accessing') -----
a2f: aNumber
self at: 35 put: aNumber!
----- Method: KlattFrame>>a2v (in category 'accessing') -----
a2v
^ self at: 48!
----- Method: KlattFrame>>a2v: (in category 'accessing') -----
a2v: aNumber
self at: 48 put: aNumber!
----- Method: KlattFrame>>a3f (in category 'accessing') -----
a3f
^ self at: 36!
----- Method: KlattFrame>>a3f: (in category 'accessing') -----
a3f: aNumber
self at: 36 put: aNumber!
----- Method: KlattFrame>>a3v (in category 'accessing') -----
a3v
^ self at: 49!
----- Method: KlattFrame>>a3v: (in category 'accessing') -----
a3v: aNumber
self at: 49 put: aNumber!
----- Method: KlattFrame>>a4f (in category 'accessing') -----
a4f
^ self at: 37!
----- Method: KlattFrame>>a4f: (in category 'accessing') -----
a4f: aNumber
self at: 37 put: aNumber!
----- Method: KlattFrame>>a4v (in category 'accessing') -----
a4v
^ self at: 50!
----- Method: KlattFrame>>a4v: (in category 'accessing') -----
a4v: aNumber
self at: 50 put: aNumber!
----- Method: KlattFrame>>a5f (in category 'accessing') -----
a5f
^ self at: 38!
----- Method: KlattFrame>>a5f: (in category 'accessing') -----
a5f: aNumber
self at: 38 put: aNumber!
----- Method: KlattFrame>>a6f (in category 'accessing') -----
a6f
^ self at: 39!
----- Method: KlattFrame>>a6f: (in category 'accessing') -----
a6f: aNumber
self at: 39 put: aNumber!
----- Method: KlattFrame>>anv (in category 'accessing') -----
anv
^ self at: 46!
----- Method: KlattFrame>>anv: (in category 'accessing') -----
anv: aNumber
self at: 46 put: aNumber!
----- Method: KlattFrame>>aspiration (in category 'accessing') -----
aspiration
^ self at: 10!
----- Method: KlattFrame>>aspiration: (in category 'accessing') -----
aspiration: aNumber
self at: 10 put: aNumber!
----- Method: KlattFrame>>atv (in category 'accessing') -----
atv
^ self at: 51!
----- Method: KlattFrame>>atv: (in category 'accessing') -----
atv: aNumber
self at: 51 put: aNumber!
----- Method: KlattFrame>>b1 (in category 'accessing') -----
b1
^ self at: 14!
----- Method: KlattFrame>>b1: (in category 'accessing') -----
b1: aNumber
self at: 14 put: aNumber!
----- Method: KlattFrame>>b2 (in category 'accessing') -----
b2
^ self at: 18!
----- Method: KlattFrame>>b2: (in category 'accessing') -----
b2: aNumber
self at: 18 put: aNumber!
----- Method: KlattFrame>>b2f (in category 'accessing') -----
b2f
^ self at: 41!
----- Method: KlattFrame>>b2f: (in category 'accessing') -----
b2f: aNumber
self at: 41 put: aNumber!
----- Method: KlattFrame>>b3 (in category 'accessing') -----
b3
^ self at: 20!
----- Method: KlattFrame>>b3: (in category 'accessing') -----
b3: aNumber
self at: 20 put: aNumber!
----- Method: KlattFrame>>b3f (in category 'accessing') -----
b3f
^ self at: 42!
----- Method: KlattFrame>>b3f: (in category 'accessing') -----
b3f: aNumber
self at: 42 put: aNumber!
----- Method: KlattFrame>>b4 (in category 'accessing') -----
b4
^ self at: 22!
----- Method: KlattFrame>>b4: (in category 'accessing') -----
b4: aNumber
self at: 22 put: aNumber!
----- Method: KlattFrame>>b4f (in category 'accessing') -----
b4f
^ self at: 43!
----- Method: KlattFrame>>b4f: (in category 'accessing') -----
b4f: aNumber
self at: 43 put: aNumber!
----- Method: KlattFrame>>b5 (in category 'accessing') -----
b5
^ self at: 24!
----- Method: KlattFrame>>b5: (in category 'accessing') -----
b5: aNumber
self at: 24 put: aNumber!
----- Method: KlattFrame>>b5f (in category 'accessing') -----
b5f
^ self at: 44!
----- Method: KlattFrame>>b5f: (in category 'accessing') -----
b5f: aNumber
self at: 44 put: aNumber!
----- Method: KlattFrame>>b6 (in category 'accessing') -----
b6
^ self at: 26!
----- Method: KlattFrame>>b6: (in category 'accessing') -----
b6: aNumber
self at: 26 put: aNumber!
----- Method: KlattFrame>>b6f (in category 'accessing') -----
b6f
^ self at: 45!
----- Method: KlattFrame>>b6f: (in category 'accessing') -----
b6f: aNumber
self at: 45 put: aNumber!
----- Method: KlattFrame>>bnp (in category 'accessing') -----
bnp
^ self at: 28!
----- Method: KlattFrame>>bnp: (in category 'accessing') -----
bnp: aNumber
self at: 28 put: aNumber!
----- Method: KlattFrame>>bnz (in category 'accessing') -----
bnz
^ self at: 30!
----- Method: KlattFrame>>bnz: (in category 'accessing') -----
bnz: aNumber
self at: 30 put: aNumber!
----- Method: KlattFrame>>btp (in category 'accessing') -----
btp
^ self at: 32!
----- Method: KlattFrame>>btp: (in category 'accessing') -----
btp: aNumber
self at: 32 put: aNumber!
----- Method: KlattFrame>>btz (in category 'accessing') -----
btz
^ self at: 34!
----- Method: KlattFrame>>btz: (in category 'accessing') -----
btz: aNumber
self at: 34 put: aNumber!
----- Method: KlattFrame>>bypass (in category 'accessing') -----
bypass
^ self at: 40!
----- Method: KlattFrame>>bypass: (in category 'accessing') -----
bypass: aNumber
self at: 40 put: aNumber!
----- Method: KlattFrame>>db1 (in category 'accessing') -----
db1
^ self at: 16!
----- Method: KlattFrame>>db1: (in category 'accessing') -----
db1: aNumber
self at: 16 put: aNumber!
----- Method: KlattFrame>>df1 (in category 'accessing') -----
df1
^ self at: 15!
----- Method: KlattFrame>>df1: (in category 'accessing') -----
df1: aNumber
self at: 15 put: aNumber!
----- Method: KlattFrame>>diplophonia (in category 'accessing') -----
diplophonia
^ self at: 5!
----- Method: KlattFrame>>diplophonia: (in category 'accessing') -----
diplophonia: aNumber
self at: 5 put: aNumber!
----- Method: KlattFrame>>edit (in category 'editing') -----
edit
^ KlattFrameMorph new
frame: self;
addTestButton;
openInWorld!
----- Method: KlattFrame>>f0 (in category 'accessing') -----
f0
^ self at: 1!
----- Method: KlattFrame>>f0: (in category 'accessing') -----
f0: aNumber
self at: 1 put: aNumber!
----- Method: KlattFrame>>f1 (in category 'accessing') -----
f1
^ self at: 13!
----- Method: KlattFrame>>f1: (in category 'accessing') -----
f1: aNumber
self at: 13 put: aNumber!
----- Method: KlattFrame>>f2 (in category 'accessing') -----
f2
^ self at: 17!
----- Method: KlattFrame>>f2: (in category 'accessing') -----
f2: aNumber
self at: 17 put: aNumber!
----- Method: KlattFrame>>f3 (in category 'accessing') -----
f3
^ self at: 19!
----- Method: KlattFrame>>f3: (in category 'accessing') -----
f3: aNumber
self at: 19 put: aNumber!
----- Method: KlattFrame>>f4 (in category 'accessing') -----
f4
^ self at: 21!
----- Method: KlattFrame>>f4: (in category 'accessing') -----
f4: aNumber
self at: 21 put: aNumber!
----- Method: KlattFrame>>f5 (in category 'accessing') -----
f5
^ self at: 23!
----- Method: KlattFrame>>f5: (in category 'accessing') -----
f5: aNumber
self at: 23 put: aNumber!
----- Method: KlattFrame>>f6 (in category 'accessing') -----
f6
^ self at: 25!
----- Method: KlattFrame>>f6: (in category 'accessing') -----
f6: aNumber
self at: 25 put: aNumber!
----- Method: KlattFrame>>flutter (in category 'accessing') -----
flutter
^ self at: 2!
----- Method: KlattFrame>>flutter: (in category 'accessing') -----
flutter: aNumber
self at: 2 put: aNumber!
----- Method: KlattFrame>>fnp (in category 'accessing') -----
fnp
^ self at: 27!
----- Method: KlattFrame>>fnp: (in category 'accessing') -----
fnp: aNumber
self at: 27 put: aNumber!
----- Method: KlattFrame>>fnz (in category 'accessing') -----
fnz
^ self at: 29!
----- Method: KlattFrame>>fnz: (in category 'accessing') -----
fnz: aNumber
self at: 29 put: aNumber!
----- Method: KlattFrame>>friction (in category 'accessing') -----
friction
^ self at: 11!
----- Method: KlattFrame>>friction: (in category 'accessing') -----
friction: aNumber
self at: 11 put: aNumber!
----- Method: KlattFrame>>ftp (in category 'accessing') -----
ftp
^ self at: 31!
----- Method: KlattFrame>>ftp: (in category 'accessing') -----
ftp: aNumber
self at: 31 put: aNumber!
----- Method: KlattFrame>>ftz (in category 'accessing') -----
ftz
^ self at: 33!
----- Method: KlattFrame>>ftz: (in category 'accessing') -----
ftz: aNumber
self at: 33 put: aNumber!
----- Method: KlattFrame>>gain (in category 'accessing') -----
gain
^ self at: 52!
----- Method: KlattFrame>>gain: (in category 'accessing') -----
gain: aNumber
self at: 52 put: aNumber!
----- Method: KlattFrame>>jitter (in category 'accessing') -----
jitter
^ self at: 3!
----- Method: KlattFrame>>jitter: (in category 'accessing') -----
jitter: aNumber
self at: 3 put: aNumber!
----- Method: KlattFrame>>play (in category 'playing') -----
play
(KlattSynthesizer new cascade: 6; millisecondsPerFrame: 1000; soundFromFrames: {self}) play!
----- Method: KlattFrame>>printOn: (in category 'printing') -----
printOn: aStream
self class parameterNames do: [ :each |
aStream
nextPutAll: each;
nextPut: $=;
print: (self perform: each);
space]!
----- Method: KlattFrame>>ra (in category 'accessing') -----
ra
^ self at: 8!
----- Method: KlattFrame>>ra: (in category 'accessing') -----
ra: aNumber
self at: 8 put: aNumber!
----- Method: KlattFrame>>rk (in category 'accessing') -----
rk
^ self at: 9!
----- Method: KlattFrame>>rk: (in category 'accessing') -----
rk: aNumber
self at: 9 put: aNumber!
----- Method: KlattFrame>>ro (in category 'accessing') -----
ro
^ self at: 7!
----- Method: KlattFrame>>ro: (in category 'accessing') -----
ro: aNumber
self at: 7 put: aNumber!
----- Method: KlattFrame>>shimmer (in category 'accessing') -----
shimmer
^ self at: 4!
----- Method: KlattFrame>>shimmer: (in category 'accessing') -----
shimmer: aNumber
self at: 4 put: aNumber!
----- Method: KlattFrame>>turbulence (in category 'accessing') -----
turbulence
^ self at: 12!
----- Method: KlattFrame>>turbulence: (in category 'accessing') -----
turbulence: aNumber
self at: 12 put: aNumber!
----- Method: KlattFrame>>voicing (in category 'accessing') -----
voicing
^ self at: 6!
----- Method: KlattFrame>>voicing: (in category 'accessing') -----
voicing: aNumber
self at: 6 put: aNumber!
Morph subclass: #FaceMorph
instanceVariableNames: 'leftEye leftEyebrow rightEye rightEyebrow lips'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Gestures'!
----- Method: FaceMorph>>closeEyelids (in category 'actions') -----
closeEyelids
leftEye closeEyelid.
rightEye closeEyelid!
----- Method: FaceMorph>>defaultColor (in category 'initialization') -----
defaultColor
"answer the default color/fill style for the receiver"
^ Color transparent!
----- Method: FaceMorph>>drawNoseOn: (in category 'drawing') -----
drawNoseOn: aCanvas
| nosePosition |
nosePosition := self center * 2 + self lips center // 3.
aCanvas fillOval: (nosePosition- (3@0) extent: 2 @ 2) color: Color black.
aCanvas fillOval: (nosePosition + (3@0) extent: 2 @ 2) color: Color black!
----- Method: FaceMorph>>drawOn: (in category 'drawing') -----
drawOn: aCanvas
super drawOn: aCanvas.
self drawNoseOn: aCanvas!
----- Method: FaceMorph>>grin (in category 'actions') -----
grin
self leftEye openness: (0.2 to: 1.0 by: 0.1) atRandom.
self rightEye openness: (0.2 to: 1.0 by: 0.1) atRandom.
self lips grin!
----- Method: FaceMorph>>happy (in category 'actions') -----
happy
self lips smile!
----- Method: FaceMorph>>hideTonge (in category 'actions') -----
hideTonge
self lips hideTonge!
----- Method: FaceMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self addMorph: (leftEye := EyeMorph new);
addMorph: (rightEye := EyeMorph new);
addMorph: (lips := LipsMorph new).
leftEye position: self position.
rightEye position: leftEye extent x @ 0 + leftEye position.
lips position: 0 @ 20 + (leftEye bottomRight + rightEye bottomLeft - lips extent // 2).
self bounds: self fullBounds!
----- Method: FaceMorph>>leftEye (in category 'accessing') -----
leftEye
^ leftEye!
----- Method: FaceMorph>>lips (in category 'accessing') -----
lips
^ lips!
----- Method: FaceMorph>>lookAt: (in category 'actions') -----
lookAt: aPoint
self leftEye lookAt: aPoint.
self rightEye lookAt: aPoint!
----- Method: FaceMorph>>lookAtFront (in category 'actions') -----
lookAtFront
self leftEye lookAtFront.
self rightEye lookAtFront!
----- Method: FaceMorph>>lookAtHand (in category 'actions') -----
lookAtHand
| hand |
self isInWorld ifFalse: [^ self].
hand := (self world activeHand) ifNil: [self world primaryHand].
self lookAtMorph: hand!
----- Method: FaceMorph>>lookAtMorph: (in category 'actions') -----
lookAtMorph: aMorph
self leftEye lookAtMorph: aMorph.
self rightEye lookAtMorph: aMorph!
----- Method: FaceMorph>>mustachePosition (in category 'geometry') -----
mustachePosition
^ self nosePosition + self lips center // 2!
----- Method: FaceMorph>>neutral (in category 'actions') -----
neutral
self lips neutral!
----- Method: FaceMorph>>nosePosition (in category 'geometry') -----
nosePosition
^ self center * 2 + self lips center // 3!
----- Method: FaceMorph>>openEyelids (in category 'actions') -----
openEyelids
leftEye openEyelid.
rightEye openEyelid!
----- Method: FaceMorph>>rightEye (in category 'accessing') -----
rightEye
^ rightEye!
----- Method: FaceMorph>>say: (in category 'actions') -----
say: aString
self lips showBalloon: aString!
----- Method: FaceMorph>>step (in category 'stepping and presenter') -----
step
| amount |
super step.
10 atRandom = 1
ifTrue: [[self lips perform: #(smile horror surprise sad grin) atRandom.
(Delay forMilliseconds: 2000 atRandom) wait.
self lips perform: #(neutral neutral smile sad) atRandom] fork].
5 atRandom = 1
ifTrue: [[self closeEyelids.
(Delay forMilliseconds: 180) wait.
self openEyelids.
2 atRandom = 1 ifTrue: [self lookAtFront]] fork.
^ self].
"20 atRandom = 1 ifTrue: [(self perform: #(leftEye rightEye) atRandom) closeEyelid]."
20 atRandom = 1 ifTrue: [amount := (0.2 to: 1.0 by: 0.01) atRandom.
self leftEye openness: amount. self rightEye openness: amount].
3 atRandom = 1 ifTrue: [self lookAtHand. ^ self].
3 atRandom = 1 ifTrue: [self lookAtFront. ^ self].
3 atRandom = 1 ifTrue: [self lookAtMorph: self world submorphs atRandom]!
----- Method: FaceMorph>>stepTime (in category 'testing') -----
stepTime
^ 1000!
ClassTestCase subclass: #PhonemeRecognizerTest
instanceVariableNames: 'recognizer'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Phoneme Recognize-Test'!
!PhonemeRecognizerTest commentStamp: '<historical>' prior: 0!
This is the unit test for the class PhonemeRecognizer.!
----- Method: PhonemeRecognizerTest>>setUp (in category 'initialize-release') -----
setUp
recognizer := PhonemeRecognizer new initialize.
recognizer phonemes add: PhonemeRecordTest sampleOne; add: PhonemeRecordTest sampleTwo.!
----- Method: PhonemeRecognizerTest>>testFindMatchFor (in category 'testing') -----
testFindMatchFor
| soundBuffer bestMatch |
soundBuffer := SoundBuffer fromArray: (Array new: 512 withAll: 0).
bestMatch := recognizer findMatchFor: soundBuffer samplingRate: 22050.
"Because the sound buffer is empty, the recognizer should find nothing but an empty phoneme record."
self assert: bestMatch name = '...'.
!
ClassTestCase subclass: #PhonemeRecordTest
instanceVariableNames: 'phoneme'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Phoneme Recognize-Test'!
----- Method: PhonemeRecordTest class>>sampleOne (in category 'as yet unclassified') -----
sampleOne
^ PhonemeRecord new name: 'a'; mouthPosition: 1; features: #(221 341 240 128 22 8 3 3 2 2 2 1 1 2 2 1 1 1 1 1 1 1 0 3).!
----- Method: PhonemeRecordTest class>>sampleTwo (in category 'as yet unclassified') -----
sampleTwo
^ PhonemeRecord new name: 'a'; mouthPosition: 2; features: #(632 232 28 11 6 15 5 7 3 2 3 4 5 3 3 1 2 2 2 4 5 2 2 7).!
----- Method: PhonemeRecordTest>>setUp (in category 'initialize-release') -----
setUp
phoneme := PhonemeRecordTest sampleOne.!
----- Method: PhonemeRecordTest>>testDistanceToPhoneme (in category 'testing') -----
testDistanceToPhoneme
| p distance |
p := PhonemeRecordTest sampleTwo.
distance := phoneme distanceToPhoneme: p.
self assert: distance > 0.
distance := phoneme distanceToPhoneme: phoneme.
self assert: distance = 0.!
----- Method: PhonemeRecordTest>>testFeatures (in category 'testing') -----
testFeatures
self deny: phoneme features isEmptyOrNil.!
----- Method: PhonemeRecordTest>>testMouthPosition (in category 'testing') -----
testMouthPosition
| p |
p := PhonemeRecordTest sampleOne.
self assert: phoneme mouthPosition = p mouthPosition.
phoneme mouthPosition: 3.
self assert: phoneme mouthPosition = 3.!
----- Method: PhonemeRecordTest>>testName (in category 'testing') -----
testName
| p |
p := PhonemeRecordTest sampleOne.
self assert: phoneme name = p name.
phoneme name: 'p3'.
self assert: phoneme name = 'p3'.!
AlignmentMorph subclass: #KlattFrameMorph
instanceVariableNames: 'frame lastSnapshot glottal'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Klatt'!
----- Method: KlattFrameMorph>>addSliderForParameter:target:min:max:description: (in category 'initialization') -----
addSliderForParameter: parameter target: target min: min max: max description: description
self addMorphFront: (self newSliderForParameter: parameter target: target min: min max: max description: description)!
----- Method: KlattFrameMorph>>addSlidersForParameters: (in category 'initialization') -----
addSlidersForParameters: params
| left right container current slider |
params size < 10
ifTrue: [left := right := self]
ifFalse: [container := AlignmentMorph new color: self color; listDirection: #leftToRight.
left := container copy listDirection: #topToBottom.
right := left copy.
container addMorphBack: left; addMorphBack: right.
self addMorphBack: container].
params do: [ :each |
current := current == left ifTrue: [right] ifFalse: [left].
slider := self newSliderNamed: each min: (KlattFrame minimumForParameter: each) max: (KlattFrame maximumForParameter: each).
slider setBalloonText: (KlattFrame descriptionForParameter: each).
current addMorphBack: slider]!
----- Method: KlattFrameMorph>>addTestButton (in category 'initialization') -----
addTestButton
self addMorphBack: (SimpleButtonMorph new target: self; actWhen: #buttonDown; actionSelector: #playTest; labelString: 'play')!
----- Method: KlattFrameMorph>>defaultColor (in category 'initialization') -----
defaultColor
"answer the default color/fill style for the receiver"
^ Color
r: 0.452
g: 0.935
b: 0.548!
----- Method: KlattFrameMorph>>frame: (in category 'initialization') -----
frame: aKlattFrame
self frame: aKlattFrame edit: KlattFrame parameterNames!
----- Method: KlattFrameMorph>>frame:edit: (in category 'initialization') -----
frame: aKlattFrame edit: params
frame := aKlattFrame.
self addSlidersForParameters: params.
(params detect: [ :one | #(ro ra rk) includes: one] ifNone: []) notNil
ifTrue: [glottal := GraphMorph new extent: 210 @ 100.
glottal setBalloonText: 'Glottal pulse'.
self addMorphBack: glottal]!
----- Method: KlattFrameMorph>>initialize (in category 'initialization') -----
initialize
super initialize.
self listDirection: #topToBottom.
self layoutInset: 6; cellInset: 4.
self hResizing: #shrinkWrap; vResizing: #shrinkWrap.!
----- Method: KlattFrameMorph>>newSliderForParameter:target:min:max:description: (in category 'initialization') -----
newSliderForParameter: parameter target: target min: min max: max description: description
| r slider m |
r := AlignmentMorph newRow.
r color: self color; borderWidth: 0; layoutInset: 0.
r hResizing: #spaceFill; vResizing: #shrinkWrap; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter; cellInset: 4@0.
slider := SimpleSliderMorph new
color: (Color r: 0.065 g: 0.548 b: 0.645);
extent: 120@2;
target: target;
actionSelector: (parameter, ':') asSymbol;
minVal: min;
maxVal: max;
adjustToValue: (target perform: parameter asSymbol).
r addMorphBack: slider.
m := StringMorph new contents: parameter, ': '; hResizing: #rigid.
r addMorphBack: m.
m := UpdatingStringMorph new
target: target; getSelector: parameter asSymbol; putSelector: (parameter, ':') asSymbol;
width: 60; growable: false; floatPrecision: (max - min / 100.0 min: 1.0); vResizing: #spaceFill; step.
r addMorphBack: m.
r setBalloonText: description.
^ r!
----- Method: KlattFrameMorph>>newSliderNamed:min:max: (in category 'initialization') -----
newSliderNamed: name min: min max: max
^ self newSliderForParameter: name target: frame min: min max: max description: ''!
----- Method: KlattFrameMorph>>playTest (in category 'menu') -----
playTest
| synth |
synth := KlattSynthesizer new.
synth millisecondsPerFrame: 1000; cascade: 8.
(SampledSound samples: (synth samplesFromFrames: {frame}) samplingRate: synth samplingRate) play!
----- Method: KlattFrameMorph>>step (in category 'stepping and presenter') -----
step
| lf |
lastSnapshot = frame ifTrue: [^ self].
lastSnapshot := frame copy.
lf := LiljencrantsFant new
t0: 1 / frame f0 ro: frame ro rk: frame rk ra: frame ra samplingRate: 44000.
glottal data: lf init samples!
----- Method: KlattFrameMorph>>stepTime (in category 'testing') -----
stepTime
^ 500!
AlignmentMorph subclass: #PhonemeRecognizerMorph
instanceVariableNames: 'recognizer soundInput statusLight levelMeter phonemeDisplay currentPhoneme'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Phoneme Recognizer'!
!PhonemeRecognizerMorph commentStamp: 'dd 2/18/2005 17:45' prior: 0!
I provide a morph for controlling a phoneme recognizer.
The first step is to plan how many different mouth positions will be used by the animation, and which phonemes map to which mouth positions. Traditional animators might draw four mouth positions for vowels and four to six for consonants.
The person whose speech is to be recognized then records phoneme examples for the phonemes to be recognized. For animation, these phonems might consist of the vowel sounds "eh", "ee", "ah", "o", "u" and the consonants "n", "r", "s", "sh", "th", "z", "l", "r", "w", and "m". In some cases "f" and "v" might also be included. The consonants "b" and "p" are also significant in animation, since these sounds, like "m", bring the lips together. Unfortunately, "b" and "p" are tricky to recognize with the scheme used here because they are actually two things in quick succession: a momentary silence followed by the sound of the released breath. However, if the mouth position for silence is drawn with the mouth closed, then the animation of "b" and "p" will probably look okay.
Each phoneme example is recorded by clicking the "add" button and speaking the phoneme into the microphone. Leading and trailing silence is automatically removed. The user is prompted for the phoneme name and a mouth position index. The name is just a mnemonic for the user. The index can be used to select a costume from a holder during animation. It is handy to list and number the mouth positions before recording the phoneme example set.
A phoneme can be reviewed with the "play phoneme" menu command. If it contains noise, includes slides between several different sounds, or doesn't sound like a representative example of the phoneme, delete it and record it again. English contains a number of "diphthongs"--vowel sounds that are actually slides between two different vowel sounds, as in the words "boy" or "boat". It is best to record each component of a diphthong individually. You can also set the name and mouth position index for the "silence" phoneme, the phoneme that is reported whenever the input sound falls below a certain threshold. A graphical view of the features vector for a given phoneme can be generated by selecting "show phoneme features" from the menu. A phoneme set can be saved to a file and restored later.
Once you have recorded your phoneme examples, you can try them by clicking the "run" button and speaking into the microphone. You should see the phoneme display update to report the current match. The "match sound file" menu command can be used to analyze an entire AIFF or a WAV sound file at once. The resulting phoneme stream is currently reported by opening an inspector on the phoneme list. There is one phoneme in this list for each 1/24th of a second window of sound in the sound file.
To allow use of the phoneme recognizer in tile scripts, the "mouth position tile" menu command creates a tile that reports the current phonemes mouth position index. This can be used to set the cursor of a holder containing the set of mouth position drawings. A two-line tile script can thus drive the mouth of an animated character. On a reasonably fast machine, the current phoneme can be watched by a program and used to drive real-time mouth animation.!
----- Method: PhonemeRecognizerMorph>>addButtonRows (in category 'private') -----
addButtonRows
"Create and add my button row."
| r |
r := AlignmentMorph newRow vResizing: #shrinkWrap.
r addMorphBack: ((self buttonName: 'Menu' action: #invokeMenu)
actWhen: #buttonDown).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Add' action: #addPhoneme).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Run' action: #startRecognizing).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Stop' action: #stopRecognizing).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: self makeStatusLight.
self addMorphBack: r.
!
----- Method: PhonemeRecognizerMorph>>addLevelSlider (in category 'private') -----
addLevelSlider
"Create and add a slider to set the sound input level. This level is used both when recognizing and adding phonemes."
| levelSlider r |
levelSlider := SimpleSliderMorph new
color: color;
extent: 100@2;
target: soundInput;
actionSelector: #recordLevel:;
adjustToValue: soundInput recordLevel.
r := AlignmentMorph newRow
color: color;
layoutInset: 0;
wrapCentering: #center; cellPositioning: #leftCenter;
hResizing: #shrinkWrap;
vResizing: #rigid;
height: 24.
r addMorphBack: (StringMorph contents: '0 ').
r addMorphBack: levelSlider.
r addMorphBack: (StringMorph contents: ' 10').
self addMorphBack: r.
!
----- Method: PhonemeRecognizerMorph>>addPhoneme (in category 'button and menu commands') -----
addPhoneme
"Record and add a new phoneme example to my phoneme set. Prompt the user for its name and mouth position."
| phoneme |
self stopRecognizing.
Utilities
informUser: 'Press and hold the mouse button while speaking the phoneme.'
during: [Sensor waitButton].
soundInput isRecording ifTrue: [self stop].
phoneme := PhonemeRecord new initialize.
phoneme recordWithLevel: soundInput recordLevel.
phoneme samples size < 10000 ifTrue: [
^ self inform: 'Nothing recorded; check the record input source and adjust the level'].
self promptForDetailsOfPhoneme: phoneme.
recognizer phonemes add: phoneme.
!
----- Method: PhonemeRecognizerMorph>>addPhonemeDisplay (in category 'private') -----
addPhonemeDisplay
"Add a display to show the currently matching phoneme."
| font r |
font := StrikeFont familyName: 'Helvetica' size: 36.
phonemeDisplay := StringMorph contents: '...' font: font.
r := AlignmentMorph newColumn
color: color;
layoutInset: 0;
wrapCentering: #center; cellPositioning: #topCenter;
hResizing: #spaceFill;
vResizing: #rigid;
height: 20.
r addMorphBack: phonemeDisplay.
self addMorphBack: (Morph new extent: 5@8; color: Color transparent). "spacer"
self addMorphBack: r.
!
----- Method: PhonemeRecognizerMorph>>addTitle (in category 'private') -----
addTitle
"Add a title."
| font title r |
font := StrikeFont familyName: Preferences standardEToysFont familyName size: 20.
title := StringMorph contents: 'Phoneme Recognizer' font: font.
r := AlignmentMorph newColumn
color: color;
layoutInset: 0;
wrapCentering: #center; cellPositioning: #topCenter;
hResizing: #spaceFill;
vResizing: #rigid;
height: 20.
r addMorphBack: title.
self addMorphBack: r.
self addMorphBack: (Morph new extent: 5@8; color: Color transparent). "spacer"
!
----- Method: PhonemeRecognizerMorph>>buttonName:action: (in category 'private') -----
buttonName: aString action: aSymbol
"Create a button of the given name to send myself the given unary message."
^ SimpleButtonMorph new
target: self;
label: aString;
actionSelector: aSymbol
!
----- Method: PhonemeRecognizerMorph>>changePhonemeDetails (in category 'button and menu commands') -----
changePhonemeDetails
"Change the name and mouth position index of a phoneme specified by the user."
| phoneme |
phoneme := self selectPhonemeFromMenu: 'Phoneme to rename'.
phoneme ifNotNil: [self promptForDetailsOfPhoneme: phoneme].
!
----- Method: PhonemeRecognizerMorph>>currentPhonemeMouthPosition (in category 'accessing') -----
currentPhonemeMouthPosition
"Answer the mouth position index (a position integer) of the currently matching phoneme."
^ currentPhoneme mouthPosition
!
----- Method: PhonemeRecognizerMorph>>currentPhonemeName (in category 'accessing') -----
currentPhonemeName
"Answer the name of the currently matching phoneme."
^ currentPhoneme name
!
----- Method: PhonemeRecognizerMorph>>deletePhoneme (in category 'button and menu commands') -----
deletePhoneme
"Delete a phoneme specified by the user."
| phoneme |
phoneme := self selectPhonemeFromMenu: 'Phoneme to delete'.
phoneme ifNotNil: [
recognizer phonemes remove: phoneme ifAbsent: [] ].
!
----- Method: PhonemeRecognizerMorph>>getMouthPosition (in category 'e-toy support') -----
getMouthPosition
"Answer the mouth position index (a position integer) of the currently matching phoneme. Sent by tile scripts."
^ currentPhoneme mouthPosition
!
----- Method: PhonemeRecognizerMorph>>getPhonemeName (in category 'e-toy support') -----
getPhonemeName
"Answer the name (a string) of the currently matching phoneme. Used by script tile."
^ currentPhoneme name!
----- Method: PhonemeRecognizerMorph>>initialize (in category 'initialization') -----
initialize
"PhonemeRecognizerMorph new openInWorld."
| r |
super initialize.
soundInput := SoundInputStream new samplingRate: 22050.
recognizer := PhonemeRecognizer new.
borderWidth := 2.
self listDirection: #topToBottom.
"Morph must be told how to resize before adding submorphs, not after."
self hResizing: #shrinkWrap; vResizing: #shrinkWrap.
self addTitle.
self addButtonRows.
self addLevelSlider.
r := AlignmentMorph newRow vResizing: #shrinkWrap.
r addMorphBack: self makeLevelMeter.
self addMorphBack: r.
self addPhonemeDisplay.!
----- Method: PhonemeRecognizerMorph>>invokeMenu (in category 'button and menu commands') -----
invokeMenu
"Invoke the settings menu."
| aMenu |
aMenu := CustomMenu new.
aMenu title: 'Phoneme Recognizer'.
aMenu addList: #(
('add phoneme' addPhoneme)
('play phoneme' playPhoneme)
('show phoneme features' showPhonemeFeatures)
('change phoneme name' changePhonemeDetails)
('set phoneme for silence' setSilentPhoneme)
('delete phoneme' deletePhoneme)
-
('mouth position tile' makeTile)
('phoneme name tile' makePhonemeNameTile)
('match sound file' matchSoundFile)
-
('save phonemes to file' savePhonemes)
('read phonemes from file' readPhonemes)
-
('help' presentHelp)).
aMenu invokeOn: self defaultSelection: nil.
!
----- Method: PhonemeRecognizerMorph>>makeLevelMeter (in category 'private') -----
makeLevelMeter
"Create a recording level meter."
| outerBox |
outerBox := RectangleMorph new extent: 125@14; color: Color lightGray.
levelMeter := Morph new extent: 2@10; color: Color yellow.
levelMeter position: outerBox topLeft + (2@2).
outerBox addMorph: levelMeter.
^ outerBox
!
----- Method: PhonemeRecognizerMorph>>makePhonemeNameTile (in category 'button and menu commands') -----
makePhonemeNameTile
"Make a scripting tile to fetch the current phoneme's name."
self makeTile: #getPhonemeName ofType: #String.!
----- Method: PhonemeRecognizerMorph>>makeStatusLight (in category 'private') -----
makeStatusLight
"Create a status light to show when the recognizer is running."
| s |
statusLight := RectangleMorph new extent: 24@19.
statusLight color: Color gray.
s := StringMorph contents: 'On'.
s position: statusLight center - (s extent // 2).
statusLight addMorph: s.
^ statusLight
!
----- Method: PhonemeRecognizerMorph>>makeTile (in category 'button and menu commands') -----
makeTile
"Make a scripting tile to fetch the current phoneme's mouth position."
self makeTile: #getMouthPosition ofType: #Number.!
----- Method: PhonemeRecognizerMorph>>makeTile:ofType: (in category 'private') -----
makeTile: anOperator ofType: aType
"Make a scripting tile to fetch an operator. Attach it to the hand, allowing the user to drop it directly into a tile script."
| tile argTile |
tile := PhraseTileMorph new setSlotRefOperator: anOperator type: aType.
argTile := self tileToRefer.
argTile bePossessive.
tile firstSubmorph addMorph: argTile.
tile enforceTileColorPolicy.
ActiveHand attachMorph: tile
!
----- Method: PhonemeRecognizerMorph>>matchSoundFile (in category 'button and menu commands') -----
matchSoundFile
"Process an AIFF or WAV sound file and generate a sequence of phoneme matches for that file in the Transcript. When done, open an inspector on the resulting collection of phonemes."
| fileName snd phonemes |
fileName := Utilities
chooseFileWithSuffixFromList: #('.aif' '.aiff' '.wav')
withCaption: 'Sound file?'.
fileName = #none ifTrue: [^ self inform: 'No sound files.'].
('*aif*' match: fileName) ifTrue:
[snd := SampledSound fromAIFFfileNamed: fileName].
('*wav' match: fileName) ifTrue:
[snd := SampledSound fromWaveFileNamed: fileName].
phonemes := recognizer findMatchesFor: snd.
phonemes collect: [ :p | Transcript show: p name. ].
phonemes inspect.!
----- Method: PhonemeRecognizerMorph>>playPhoneme (in category 'button and menu commands') -----
playPhoneme
"Play a phoneme specified by the user."
| phoneme |
phoneme := self selectPhonemeFromMenu: 'Phoneme to play'.
phoneme ifNotNil: [
"Stop recognizing otherwise I can't play the phoneme"
self stopRecognizing.
"Play the phoneme"
phoneme play.
].
!
----- Method: PhonemeRecognizerMorph>>presentHelp (in category 'initialization') -----
presentHelp
self class organization classComment asString openInWorkspaceWithTitle: 'About Phoneme Recognizer'.!
----- Method: PhonemeRecognizerMorph>>promptForDetailsOfPhoneme: (in category 'private') -----
promptForDetailsOfPhoneme: phoneme
"Prompt the user for the name and mouth position of the given phoneme."
| response |
response := FillInTheBlank
request: 'Phoneme name?'
initialAnswer: phoneme name.
response ifNotNil: [phoneme name: response].
response := FillInTheBlank
request: 'Mouth Position Index?'
initialAnswer: phoneme mouthPosition printString.
response ifNotNil: [phoneme mouthPosition: response asNumber asInteger].
!
----- Method: PhonemeRecognizerMorph>>readPhonemes (in category 'button and menu commands') -----
readPhonemes
"Read a previously saved phoneme set from a file."
| fname s newPhonemes |
fname := Utilities chooseFileWithSuffixFromList: #('.pho' '.phonemes')
withCaption: 'Phoneme file?'.
fname isNil ifTrue: [^self].
fname ifNil: [^self].
s := FileStream readOnlyFileNamed: fname.
newPhonemes := s fileInObjectAndCode.
s close.
recognizer phonemes: newPhonemes!
----- Method: PhonemeRecognizerMorph>>savePhonemes (in category 'button and menu commands') -----
savePhonemes
"Save the current phoneme set in a file."
| fname refStream |
fname := FillInTheBlank request: 'Phoneme file name?'.
fname isEmpty ifTrue: [^ self].
((fname endsWith: '.pho') or: [fname endsWith: '.phonemes'])
ifFalse: [fname := fname, '.phonemes'].
refStream := SmartRefStream fileNamed: fname.
refStream nextPut: recognizer phonemes.
refStream close.
!
----- Method: PhonemeRecognizerMorph>>selectPhonemeFromMenu: (in category 'private') -----
selectPhonemeFromMenu: title
"Answer the phone selected by the user from a menu of the current phoneme records. Answer nil if the user does not select any phoneme."
| aMenu |
recognizer phonemes isEmpty ifTrue: [self inform: 'The phoneme database is empty.'. ^ nil].
aMenu := CustomMenu new title: title.
recognizer phonemes do: [:phoneme |
aMenu add: phoneme name action: phoneme].
^ aMenu startUp
!
----- Method: PhonemeRecognizerMorph>>setSilentPhoneme (in category 'button and menu commands') -----
setSilentPhoneme
"Prompt the user for the name and mouth position associated with silence."
self promptForDetailsOfPhoneme: recognizer silentPhoneme.
phonemeDisplay contents: recognizer silentPhoneme name.
!
----- Method: PhonemeRecognizerMorph>>showPhonemeFeatures (in category 'button and menu commands') -----
showPhonemeFeatures
"Show a graph of the features array for the phoneme selected by the user."
| phoneme m |
phoneme := self selectPhonemeFromMenu: 'Show Features'.
phoneme ifNotNil: [
m := ImageMorph new image: phoneme featuresGraph.
self world firstHand attachMorph: m].
!
----- Method: PhonemeRecognizerMorph>>startRecognizing (in category 'button and menu commands') -----
startRecognizing
"Start recognizing phonemes from the sound input."
self stopRecognizing.
soundInput bufferSize: (PhonemeRecord fftSize).
soundInput startRecording.
!
----- Method: PhonemeRecognizerMorph>>step (in category 'stepping and presenter') -----
step
"Update the record light, level meter, and display."
| w buf |
"update the record light and level meter"
soundInput isRecording
ifTrue: [statusLight color: Color yellow]
ifFalse: [statusLight color: Color gray].
w := ((121 * soundInput meterLevel) // 100) max: 1.
levelMeter width ~= w ifTrue: [levelMeter width: w].
soundInput isRecording ifTrue: [
[soundInput bufferCount > 0] whileTrue: [
"skip to the most recent buffer"
buf := soundInput nextBufferOrNil].
buf ifNotNil: [
currentPhoneme := recognizer findMatchFor: buf samplingRate: soundInput samplingRate.
phonemeDisplay contents: currentPhoneme name]].
!
----- Method: PhonemeRecognizerMorph>>stepTime (in category 'testing') -----
stepTime
^ 30
!
----- Method: PhonemeRecognizerMorph>>stopRecognizing (in category 'button and menu commands') -----
stopRecognizing
"Stop listening."
soundInput stopRecording.
currentPhoneme := recognizer silentPhoneme.
!
----- Method: PhonemeRecognizerMorph>>stopStepping (in category 'stepping and presenter') -----
stopStepping
"Turn off recording."
super stopStepping.
soundInput stopRecording.
!
Object subclass: #Clause
instanceVariableNames: 'string phrases accent'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-TTS'!
!Clause commentStamp: '<historical>' prior: 0!
My instances are clauses. They can carry a phrase accent (applicable to their last phrase) and a boundary tone: 'L- L%' (for declarative sentences in American English), 'H- H%' (for Yes-No questions), etc.!
----- Method: Clause>>accent (in category 'accessing') -----
accent
^ accent!
----- Method: Clause>>accent: (in category 'accessing') -----
accent: aString
accent := aString!
----- Method: Clause>>accept: (in category 'accessing') -----
accept: anObject
anObject clause: self!
----- Method: Clause>>events (in category 'accessing') -----
events
| answer |
answer := CompositeEvent new.
self phrases do: [ :each | answer addAll: each events].
^ answer!
----- Method: Clause>>eventsDo: (in category 'enumarating') -----
eventsDo: aBlock
self phrases do: [ :phrase | phrase eventsDo: aBlock]!
----- Method: Clause>>lastSyllable (in category 'accessing') -----
lastSyllable
^ self phrases last lastSyllable!
----- Method: Clause>>phrases (in category 'accessing') -----
phrases
^ phrases!
----- Method: Clause>>phrases: (in category 'accessing') -----
phrases: aCollection
phrases := aCollection!
----- Method: Clause>>printOn: (in category 'printing') -----
printOn: aStream
self phrases do: [ :each | aStream print: each; nextPutAll: '- ']!
----- Method: Clause>>string (in category 'accessing') -----
string
^ string!
----- Method: Clause>>string: (in category 'accessing') -----
string: aString
string := aString!
----- Method: Clause>>syllablesDo: (in category 'enumarating') -----
syllablesDo: aBlock
self wordsDo: [ :each | each syllables do: aBlock]!
----- Method: Clause>>wordsDo: (in category 'enumarating') -----
wordsDo: aBlock
self phrases do: [ :each | each words do: aBlock]!
Object subclass: #CosineInterpolator
instanceVariableNames: 'origin points stack'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Support'!
----- Method: CosineInterpolator class>>fromArray: (in category 'instance creation') -----
fromArray: anArray
| answer |
answer := self new.
1 to: anArray size by: 2 do: [ :each | answer at: (anArray at: each) put: (anArray at: each + 1)].
^ answer!
----- Method: CosineInterpolator>>at: (in category 'accessing') -----
at: time
"Answer the value of the receiver at a given time. (Do linear interpolation.)"
^ self cosineAt: time + self origin!
----- Method: CosineInterpolator>>at:put: (in category 'accessing') -----
at: time put: value
self points add: time + self origin -> value.
^ value!
----- Method: CosineInterpolator>>cleanBetween:and: (in category 'private') -----
cleanBetween: start and: end
self points: (self points reject: [ :each | each key between: start and: end])!
----- Method: CosineInterpolator>>commit (in category 'accessing') -----
commit
self cleanBetween: stack first key and: stack last key.
self points addAll: stack.
stack := SortedCollection new!
----- Method: CosineInterpolator>>cosineAt: (in category 'private') -----
cosineAt: time
"Answer the value of the receiver at a given time. (Do cosine interpolation.)"
| xVal count x1 x2 y1 y2 |
points isNil ifTrue: [^ nil].
xVal := points first key.
count := 1.
[xVal < time]
whileTrue: [count := count + 1.
count > points size ifTrue: [^ points last value].
xVal := (points at: count) key].
xVal = time ifTrue: [^ (points at: count) value].
count = 1 ifTrue: [^ points first value].
x1 := (points at: count - 1) key.
x2 := (points at: count) key.
y1 := (points at: count - 1) value.
y2 := (points at: count) value.
^ ((time - x1 / (x2 - x1) * Float pi) cos - 1 / -2.0) * (y2 - y1) + y1!
----- Method: CosineInterpolator>>duration (in category 'accessing') -----
duration
^ self points last key - self points first key!
----- Method: CosineInterpolator>>initialize (in category 'initialization') -----
initialize
points := SortedCollection new.
stack := SortedCollection new.
origin := 0!
----- Method: CosineInterpolator>>linearAt: (in category 'private') -----
linearAt: time
"Answer the value of the receiver at a given time. (Do linear interpolation.)"
| xVal count x1 x2 y1 y2 |
points isNil ifTrue: [^ nil].
xVal := points first key.
count := 1.
[xVal < time]
whileTrue: [count := count + 1.
count > points size ifTrue: [^ points last value].
xVal := (points at: count) key].
xVal = time ifTrue: [^ (points at: count) value].
count = 1 ifTrue: [^ points first value].
x1 := (points at: count - 1) key.
x2 := (points at: count) key.
y1 := (points at: count - 1) value.
y2 := (points at: count) value.
^ (time - x1) / (x2 - x1) * (y2 - y1) + y1!
----- Method: CosineInterpolator>>origin (in category 'accessing') -----
origin
^ origin!
----- Method: CosineInterpolator>>origin: (in category 'accessing') -----
origin: aNumber
origin := aNumber!
----- Method: CosineInterpolator>>points (in category 'private') -----
points
^ points!
----- Method: CosineInterpolator>>points: (in category 'private') -----
points: aCollection
points := aCollection!
----- Method: CosineInterpolator>>x:y: (in category 'accessing') -----
x: x y: y
stack add: x + self origin -> y!
Object subclass: #DECTalkReader
instanceVariableNames: 'stream phonemes durations events currentDuration currentPitch f0Contour'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Support'!
----- Method: DECTalkReader class>>daisy (in category 'examples') -----
daisy
"
DECTalkReader daisy playOn: KlattVoice new delayed: 10000
"
^ self eventsFromString: '_<50,22>dey<400,22>ziy<400,19>dey<400,15>ziy<400,10>
gih<200,12>vmiy<200,14>yurr<200,15>ae<400,12>nsax<200,15>
rduw<400,10>.
ay<400,17>mhxae<400,22>fkrey<400,19>ziy<400,15>ao<200,12>
lfao<200,14>rdhax<200,15>lah<400,17>vao<200,19>vyu<400,17>.
ih<200,19>twow<200,20>ntbiy<200,19>ax<200,17>stay<400,22>
lih<200,19>shmae<200,17>rih<400,15>jh<50,15>.
ay<200,17>kae<400,19>ntax<200,15>fow<400,12>rdax<200,15>
kae<200,12>rih<400,10>jh<50,10>.
bah<200,10>tyu<400,15>lluh<200,19>kswiy<400,17>tah<200,10>
pao<400,15>ndhax<200,19>siy<400,17>t<50,17>.
ao<200,17>vax<200,19>bay<200,22>six<200,19>kel<200,15>
bih<400,17>ltfao<200,10>rtuw<800,15>.'!
----- Method: DECTalkReader class>>eventsFromStream: (in category 'instance creation') -----
eventsFromStream: aStream
^ self new stream: aStream; read; events!
----- Method: DECTalkReader class>>eventsFromString: (in category 'instance creation') -----
eventsFromString: aString
^ self eventsFromStream: (ReadStream on: aString)!
----- Method: DECTalkReader class>>flower (in category 'examples') -----
flower
"
DECTalkReader flower playOn: KlattVoice new delayed: 15000
"
^ self eventsFromString: '_<25,22>ow<200,22>flaw<400,22>rax<200,20>vskao<400,18>
ao<200,18>tlae<800,13>nd<200,13>
weh<200,13>nwih<400,18>lwiy<200,22>siy<800,20>yu<200,20>
rlay<400,18>kax<200,20>geh<1600,22>n<25,22>
dhax<200,22>tfao<300,23>ao<100,22>tae<200,23>nday<400,25>
d<200,25>fao<800,18>r<25,18>
yu<200,13>rwiy<400,20>bih<200,20>t hxih<200,20>ih<200,18>
lae<200,20>ndgleh<400,22>nae<200,23>ndstuh<400,22>dax<200,20>
geh<600,18>nst hxih<800,13>m<200,13>
praw<200,22>deh<300,23>eh<100,22>dwax<200,23>rdzaa<400,25>
aa<200,25>rmih<800,18>ih<200,18>
ae<200,22>ndseh<200,23>eh<200,22>nt hxih<200,20>mhxow<300,22>
ow<100,20>ow<200,18>mwax<800,18>ax<200,18>rdtey<200,18>
thih<400,16>nxkax<200,20>geh<800,18>eh<400,18>n<200,18>
_<600,22>dhax<200,22>hxih<400,22>lzax<200,20>rbey<400,18>
rr<200,18>naw<800,13>
ae<200,13>ndao<400,18>tah<200,22>mliy<800,20>vzlay<200,20>
thih<400,18>kax<200,20>ndstih<800,22>ih<800,22>l<25,22>
ow<200,22>rlae<300,23>nddhax<100,22>tih<200,23>zlao<400,25>
ao<200,25>stnaw<800,18>
wih<200,13>chdhow<400,20>zsow<200,20>diy<200,20>ax<200,18>
lih<200,20>hxeh<400,22>ldhax<200,23>tstuh<400,22>dax<200,20>
geh<400,18>eh<200,18>nst hxih<800,13>m<200,13>
praw<200,22>deh<300,23>eh<100,22>dwax<200,23>rdzaa<400,25>
aa<200,25>rmih<800,18>ih<200,18>
ae<200,22>ndseh<200,23>eh<200,22>nt hxih<200,20>mhxow<300,22>
ow<100,20>ow<200,18>mwax<800,18>ax<200,18>rdtey<200,18>
thih<400,16>nxkax<200,20>geh<1200,18>n<200,18>
_<600,22>dhow<200,22>zdey<400,22>zax<200,20>rpae<400,18>
ae<200,18>stnaw<800,13>
ae<200,13>ndih<400,18>ndhax<200,22>pae<800,20>stdhey<200,20>
mah<400,18>strix<200,20>mey<800,22>ey<800,22>n<25,22>
bah<200,22>twiy<300,23>kae<100,22>nstih<200,23>lray<600,25>
znaw<800,18>
ae<200,13>ndbiy<400,20>dhax<200,20>ney<200,20>shax<200,18>
nax<200,20>geh<400,22>ndhax<200,23>tstuh<400,22>dax<200,20>
geh<600,18>nst hxih<800,13>m<200,13>
praw<200,22>deh<300,23>eh<100,22>dwax<200,23>rdzaa<400,25>
aa<200,25>rmih<800,18>ih<200,18>
ae<200,22>ndseh<200,23>eh<200,22>nt hxih<200,20>mhxow<300,22>
ow<100,20>ow<200,18>mwax<800,18>ax<200,18>rdtey<200,18>
thih<400,16>nxkax<200,20>geh<1200,18>n<200,18>.'!
----- Method: DECTalkReader class>>great (in category 'examples') -----
great
"
(DECTalkReader great pitchBy: 0.5) playOn: (KlattVoice new tract: 19; flutter: 0.5) delayed: 10000
"
^ self eventsFromString: '_<50,20>ax<200,20>_<1>ax<500,22>_<10>ow<300,20>yxeh<1000,17>
say<200,15>mdhax<80,13>grey<1000,15>t_priy<200,17>iy<200,18>
teh<200,17>eh<200,15>ndrr<1600,13>
_<200,13>priy<200,13>teh<1000,22>ndih<200,22>nxdhae<100,22>
day<1000,18>mduh<200,20>ix<200,22>nweh<1600,20>l<600,20>
_<60,25>may<300,25>niy<1200,22>dix<200,22>zsah<1000,24>chay<200,22>
priy<200,24>teh<1000,25>ndtuh<200,22>_<10>uw<200,25>mah<1000,20>ch<100,20>
_<20,20>ay<300,20>mlow<300,20>neliy<800,17>bah<200,13>
tnow<1000,15>wah<200,13>nkae<200,15>nteh<1800,13>l<400,13>
_<50,20>ax<200,20>_<1>ax<500,22>_<1>ow<300,20>yxeh<1000,17>
say<200,15>mdhax<80,13>grey<1000,15>t_priy<200,17>iy<200,18>
teh<200,17>eh<200,15>ndrr<1800,13>
_<10,13>ah<200,13>drih<1000,22>ftih<50,22>nax<200,22>
wrr<1000,18>ldax<200,20>vmay<200,22>ax<200,22>_<1>ow<1400,20>n<600,20>
_<60,25>ay<300,25>pley<1100,22>dhax<200,22>gey<1000,24>
m<100,24>bah<200,22>tuh<200,24>may<1000,25>riy<200,22>ax<200,25>
lshey<600,20>m<400,20>
_<20,20>yu<200,20>vleh<200,20>ftmiy<800,17>tuw<200,13>
driy<800,15>mao<200,13>lah<200,15>low<1600,13>n<400,13>.'!
----- Method: DECTalkReader class>>hawaii (in category 'examples') -----
hawaii
"
DECTalkReader hawaii playOn: (KlattVoice new tract: 14.4) delayed: 10000
"
^ self eventsFromString: '_<300> naa<600,23> ay<300,23>t ae<300,22>nd yuw<1200,23> ,<600>
ae<600,24>nd
bluw<900,25> hxah<300,24> waa<940,23> aa<240,22> aa<240,21> iy<1200,20>
,<600> dhah<600,32> naa<600,33> ay<300,33>t ih<300,32>z hxeh<900,30>
veh<300,22>n liy<1200,25>
,<600> ae<300,30> ae<300,31>nd yu<900,32> aa<300,30>rx
hxeh<440,28> veh<440,28>n tuw<440,25> miy<2400,23> ,<600> lah<900,23>v
liy<300,22> yuw<1200,23> ,<600> ae<600,24>nd bluw<900,25> hxah<300,24>
waa<940,23>-aa<240,22>-aa<240,21>-iy<1200,20>
,<600> wih<600,32>dh ao<900,33>lx dhih<300,32>s lah<880,30> v<40,30>
liy<300,22> neh<1200,25>s
,<600> dheh<300,30> eh<300,31>rx shuh<900,32>d biy<300,27>
lah<4140,28> v<60,28> ,<600> kah<900,25>m wih<300,32>dh miy<1800,30> ,<600>
waa<400,28> ay<200,28>lx dhah<600,25> muw<300,28>n ih<300,25>z aa<300,28>n
dhah<300,25> siy<2400,23> ,<600> dhah<600,24> naa<600,25> ay<300,25>t
ih<300,32>z yxah<1200,30>nx ,<600> ae<600,28>nd sow<600,25>
aa<600,28>rx-wiy<4200,30> ,<600> driy<900,23>mz kah<300,22>m truw<1000,23>
uw<200,23> ,<600> ih<600,24>n
bluw<900,25> hxah<300,24> waa<940,23> aa<240,22> aa<240,21> iy<1200,20>
,<600> ae<600,32>nd maa<600,33> iy<300>n kuh<300,32>d ao<900,30>lx
kah<300,22>m truw<1200,25> ,<600> dhih<300,30> ih<300,31>s mae<900,32>
jhih<330,27>k naa<600,28> ay<350,28>t ah<350,27>v naa<600,28> ay<350,28>ts
,<40> wih<380,27>dh yuw<1000,28>-uw<600,455>-uw<1800,35>.'!
----- Method: DECTalkReader class>>silentNightDuetExample (in category 'examples') -----
silentNightDuetExample
"
DECTalkReader silentNightDuetExample
"
| song1 song2 voice1 voice2 time |
song1 := DECTalkReader silentNightVoice1.
song2 := DECTalkReader silentNightVoice2.
voice1 := KlattVoice new tract: 14.4.
voice2 := KlattVoice new tract: 18.5; turbulence: 59.
time := Time millisecondClockValue + 30000. "give it 30 secounds for precomputing"
song1 playOn: voice1 at: time.
song2 playOn: voice2 at: time!
----- Method: DECTalkReader class>>silentNightDuetExample2 (in category 'examples') -----
silentNightDuetExample2
"
DECTalkReader silentNightDuetExample2
"
| song1 song2 voice1 voice2 time |
song1 := DECTalkReader silentNightVoice1 pitchBy: 0.5.
song2 := DECTalkReader silentNightVoice2 pitchBy: 0.5.
voice1 := KlattVoice new tract: 14.4.
voice2 := KlattVoice new tract: 18.5; turbulence: 59.
time := Time millisecondClockValue + 30000. "give it 30 secounds for precomputing"
song1 playOn: voice1 at: time.
song2 playOn: voice2 at: time!
----- Method: DECTalkReader class>>silentNightDuetExample3 (in category 'examples') -----
silentNightDuetExample3
"
DECTalkReader silentNightDuetExample3
"
| song1 song2 voice1 voice2 time |
song1 := DECTalkReader silentNightVoice1 pitchBy: 0.25.
song2 := DECTalkReader silentNightVoice2 pitchBy: 0.25.
voice1 := KlattVoice new tract: 18.5; turbulence: 59.
voice2 := KlattVoice new tract: 20; flutter: 0.5.
time := Time millisecondClockValue + 30000. "give it 30 secounds for precomputing"
song1 playOn: voice1 at: time.
song2 playOn: voice2 at: time!
----- Method: DECTalkReader class>>silentNightDuetExample4 (in category 'examples') -----
silentNightDuetExample4
"
DECTalkReader silentNightDuetExample4
"
| song1 song2 voice1 voice2 gestural1 gestural2 time |
song1 := DECTalkReader silentNightVoice1 pitchBy: 0.5.
song2 := DECTalkReader silentNightVoice2 pitchBy: 0.5.
gestural1 := GesturalVoice new.
gestural1 newHead position: 1 @ 50.
voice1 := (KlattVoice new tract: 14.4) + gestural1.
gestural2 := GesturalVoice new.
gestural2 newHead position: 150 @ 50.
voice2 := (KlattVoice new tract: 18.5; turbulence: 59) + gestural2.
time := Time millisecondClockValue + 30000. "give it 30 secounds for precomputing"
song1 playOn: voice1 at: time.
song2 playOn: voice2 at: time!
----- Method: DECTalkReader class>>silentNightVoice1 (in category 'examples') -----
silentNightVoice1
"
(DECTalkReader silentNightVoice1 pitchBy: 0.5) playOn: KlattVoice new delayed: 1000
"
^ self eventsFromString: 'sae<600,32>ay<200,34>leh<400,32>nt nae<600,29>ay<400>t.
hxow<600,32>ow<200,34>liy<400,32> nae<600,29>ay<400>t.
ao<600,39>l ih<200>z kaa<800,36>lm.
ao<600,37>l ih<200>z bray<800,32>t.
raw<600,34>nd yah<400>ng ver<600,37>er<200,36>jhah<400,34>n
mah<600,32>dher<200,32> ae<400>nd chah<600,29>ay<200>ld.
hxow<800,34>liy<400> ih<600,37>nfah<200,36>nt
sow<400,34> teh<600,32>nder<400,34> ae<400,32>nd may<600,29>ld.
sliy<600,39>p ah<400>n hxeh<400,42>vah<400,39>nliy<400,36> piy<1000,37>iy<800,41>s.
sliy<400,37>iy<400,32>p ah<400,29>n hxeh<400,32>vah<400,30>nliy<600,27> piy<1800,25>s.'!
----- Method: DECTalkReader class>>silentNightVoice2 (in category 'examples') -----
silentNightVoice2
"
(DECTalkReader silentNightVoice2 pitchBy: 0.5) playOn: KlattVoice new delayed: 1000
"
^ self eventsFromString: 'sae<600,29>ay<200,30>leh<400,29>nt nae<600,25>ay<400>t.
hxow<600,29>ow<200,30>liy<400,29> nae<600,25>ay<400>t.
ao<600,30>l ih<200>z kaa<800,27>lm.
ao<600,29>l ih<200>z bray<800,29>t.
raw<600,30>nd yah<400>ng ver<600,34>er<200,32>jhah<400,30>n
mah<600,29>dher<200,30> ae<400,29>nd chah<600,25>ay<200>ld.
hxow<800,30>liy<400> ih<600,34>nfah<200,32>nt
sow<400,30> teh<600,29>nder<400,30> ae<400,29>nd may<600,25>ld.
sliy<600,30>p ah<400>n hxeh<400,27>vah<400,30>nliy<400,27> piy<1000,29>iy<800,32>s.
sliy<400,29>iy<400,29>p ah<400,25>n hxeh<400,24>vah<400,24>nliy<600,24> piy<1800,25>s.'!
----- Method: DECTalkReader class>>startrek (in category 'examples') -----
startrek
"
DECTalkReader startrek playOn: KlattVoice new delayed: 15000
"
^ self eventsFromString: '_<50,17>dhey<400,17>rsklih<100,17>nxao<100,17>nzao<100,17>
ndhax<100,17>staa<100,20>rbao<100,20>rdbaw<200,17>staa<100,18>
rbao<100,18>rdbaw<200,15>staa<100,17>rbao<100,17>rdbaw<200,13>.
dhey<100,17>rsklih<100,17>nxao<100,17>nzao<100,17>ndhax<100,17>
staa<100,20>rbao<100,20>rdbaw<200,17>staa<100,18>rbao<100,18>
rdbaw<200,15>jhih<400,13>m<50,13>.
_<50,17>ih<400,17>tslay<100,17>fjhih<100,17>mbah<100,17>
tnao<50,20>tax<50,20>zwiy<100,20>now<100,17>ih<200,17>
tnao<50,18>tax<50,18>zwiy<100,18>now<100,15>ih<200,15>
tnao<50,17>tax<50,17>zwiy<100,17>now<100,13>ih<200,13>
t<50,13>.
ih<100,17>tslay<100,17>fjhih<100,17>mbah<100,17>tnao<50,20>
tax<50,20>zwiy<100,20>now<100,17>ih<200,17>tnao<50,18>
tax<50,18>zwiy<100,18>now<100,15>ih<200,15>tkae<200,13>
ptix<200,13>n<50,13>.
_<50,17>ih<400,17>tswah<100,17>rsdhae<100,17>ndhae<100,17>
t_hxiy<100,20>zdeh<200,20>djhih<200,17>mdeh<200,18>djhih<200,15>
mdeh<200,17>djhih<200,13>m<50,13>.
ih<100,17>tswah<100,17>rsdhae<100,17>ndhae<100,17>t_hxiy<100,20>
zdeh<200,20>djhih<200,17>mdeh<200,18>djhih<200,15>mdeh<400,13>
d<50,13>.
_<50,17>wiy<400,17>kah<100,17>mih<100,17>npiy<200,17>
sshuh<100,20>tuh<100,20>kih<200,17>lshuh<100,18>tuh<100,18>
kih<200,15>lshuh<100,17>tuh<100,17>kih<200,13>l<50,13>.
wiy<100,17>kah<100,17>mih<100,17>npiy<200,17>sshuh<100,20>
tuh<100,20>kih<200,17>lshuh<100,18>tuh<100,18>kih<200,15>
lmeh<400,13>n<50,13>.
_<50,17>yxih<400,17>kaa<100,17>naa<100,17>chey<100,17>
njhdhax<50,17>lao<50,20>zax<100,20>fih<100,17>zih<100,17>
kslao<50,18>zax<100,18>fih<100,15>zih<100,15>kslao<50,17>
zax<100,17>fih<100,13>zih<100,13>ks<50,13>.
yxih<400,17>kaa<100,17>naa<100,17>chey<100,17>njhdhax<50,17>
lao<50,20>zax<100,20>fih<100,17>zih<100,17>kslao<50,18>
zax<100,18>fih<100,15>zih<100,15>kskaa<200,13>ptix<200,13>
n<50,13>.'!
----- Method: DECTalkReader class>>startrek1 (in category 'examples') -----
startrek1
"
DECTalkReader startrek1 playOn: KlattVoice new delayed: 5000
"
^ self eventsFromString: '_<50,17>dhey<400,17>rsklih<100,17>nxao<100,17>nzao<100,17>
ndhax<100,17>staa<100,20>rbao<100,20>rdbaw<200,17>staa<100,18>
rbao<100,18>rdbaw<200,15>staa<100,17>rbao<100,17>rdbaw<200,13>.'!
----- Method: DECTalkReader class>>vermont (in category 'examples') -----
vermont
"
(DECTalkReader vermont pitchBy: 0.5) playOn: (KlattVoice new tract: 18.5; turbulence: 59) delayed: 15000
"
^ self eventsFromString: 'peh<400,25> niy<400,23>z ih<400,20>n ah<400,18> striy<1200,20>m
,<400> fao<400,25> lih<400,23>nx liy<500,20>vz ,<100> ah<200,16>v
sih<200,18> kah<200,20> mao<1000,12>rx ,<200> muw<400,20>n lay<400,18>t
ih<400,16>n vrr<400,13> maa<1200,16>nt ,<400> ay<400,25> siy<400,23>
fih<400,20>nx grr<400,18> wey<1200,20>vz ,<400> skiy<400,25> trae<300,23>lxz
,<100> aa<600,20>n ah<200,16> maw<200,18>n tih<200,20>n
saa<800,12>-ay<200,12>d ,<200> snow<400,20> lay<400,18>t
ih<400,16>n vrr<400,13> maa<1200,16>nt ,<400> teh<200,15> lah<200,15>
grae<200,15>f key<400,15> bah<300,15>lxz ,<100> dhey<200,15> sih<200,15>nx
daw<400,15>n dhah<200,15> hxay<200,15> wey<300,15> ,<100> ae<200,15>nd
trae<200,15> vuh<200,15>lx iy<200,15>ch beh<500,27>nd,<100> ih<200,25>n
dhah<200,27> row<1200,24>d ,<400> piy<200,16> pah<200,16>lx hxuw<200,16>
miy<200,16>t ,<200>
ih<400,16>n-dhih<200,16>s-row<200,16>-mae<400,16>n-tih<160,16>k ,<40>
seh<200,16> tih<300,16>nx ,<100> aa<200,16>rx sow<200,16>
hxih<200,16>p nah<200,16> tay<400,28>zd ,<200> bay<200,26> dhah<200,28>
lah<900,25>v liy<700,24> ,<200> iy<400,25>v nih<400,23>nx sah<400,20>
mrr<400,18> briy<1200,20>z ,<400> wao<400,25>rx blih<400,23>nx ah<400,20>v
,<200> ah<200,16> meh<200,18> dow<200,20> laa<800,12>rxk ,<400> muw<400,20>n
lay<400,18>t ih<400,16>n vrr<400,13> maa<1300,16>nt ,<400>
iy<40,12>-yuw<280,12> ae<350,13>n day<420,16> ,<60> ae<340,20>nd
muw<380,25>n lay<340,27>t ,<100> ih<500,24>n vrr<540,26> maa<2000,23>nt.'!
----- Method: DECTalkReader>>addPitches (in category 'reading') -----
addPitches
| offset |
offset := 0.0.
events do: [ :each |
each pitchPoints: (self pitchesBetween: offset and: offset + each duration).
offset := offset + each duration].!
----- Method: DECTalkReader>>defaultDurationFor: (in category 'accessing') -----
defaultDurationFor: aPhoneme
^ durations at: aPhoneme ifAbsent: [0.080]!
----- Method: DECTalkReader>>events (in category 'accessing') -----
events
^ events!
----- Method: DECTalkReader>>initialize (in category 'initialization') -----
initialize
phonemes := PhonemeSet dectalkToArpabet.
events := CompositeEvent new.
currentDuration := 80.
currentPitch := 100.
f0Contour := CosineInterpolator new.
durations := Dictionary new.
#(
('ae' 230.0 80.0)
('aa' 240.0 100.0)
('ax' 120.0 60.0)
('er' 180.0 80.0)
('ay' 250.0 150.0)
('aw' 240.0 100.0)
('b' 85.0 60.0)
('ch' 70.0 50.0)
('d' 75.0 50.0)
('dh' 50.0 30.0)
('eh' 150.0 70.0)
('ea' 270.0 130.0)
('ey' 180.0 100.0)
('f' 100.0 80.0)
('g' 80.0 60.0)
('hh' 80.0 20.0)
('ih' 135.0 40.0)
('ia' 230.0 100.0)
('iy' 155.0 55.0)
('jh' 70.0 50.0)
('k' 80.0 60.0)
('l' 80.0 40.0)
('m' 70.0 60.0)
('n' 60.0 50.0)
('ng' 95.0 60.0)
" ('oh' 240.0 130.0)"
('oy' 280.0 150.0)
('ao' 240.0 130.0)
('ow' 220.0 80.0)
('p' 90.0 50.0)
('r' 80.0 30.0)
('s' 105.0 60.0)
('sh' 105.0 80.0)
('t' 75.0 50.0)
('th' 90.0 60.0)
('uh' 210.0 70.0)
('ua' 230.0 110.0)
('ah' 160.0 60.0)
('uw' 230.0 150.0)
('v' 60.0 40.0)
('w' 80.0 60.0)
('y' 80.0 40.0)
('z' 75.0 40.0)
('zh' 70.0 40.0)
('sil' 100.0 100.0)) do: [ :each |
durations at: (PhonemeSet arpabet at: each first) put: each second / 1000.0]!
----- Method: DECTalkReader>>nextPhoneme (in category 'reading') -----
nextPhoneme
| try try2 phon |
try := stream next asString.
(',.;-' includes: try first) ifTrue: [^ phonemes at: 'sil'].
try2 := try, stream peek asString.
(phon := phonemes at: try2 ifAbsent: []) notNil ifTrue: [stream next. ^ phon].
^ phonemes at: try!
----- Method: DECTalkReader>>phonemes (in category 'accessing') -----
phonemes
^ phonemes!
----- Method: DECTalkReader>>pitchesBetween:and: (in category 'reading') -----
pitchesBetween: t1 and: t2
| step |
step := (t2 - t1 / 0.035) asInteger + 1. "step small enough"
^ (t1 to: t2 by: t2 - t1 / step) collect: [ :each | each - t1 @ (f0Contour at: each)]!
----- Method: DECTalkReader>>read (in category 'reading') -----
read
| phoneme time |
time := 0.
[stream skipSeparators; atEnd]
whileFalse: [phoneme := self nextPhoneme.
currentDuration := self defaultDurationFor: phoneme.
stream peek = $< ifTrue: [self readPitchAndDuration].
f0Contour at: time + (currentDuration / 2.0 min: 0.1) put: currentPitch.
time := time + currentDuration.
f0Contour at: time put: currentPitch.
events add: (PhoneticEvent new phoneme: phoneme; duration: currentDuration; loudness: 1.0)].
self addPitches!
----- Method: DECTalkReader>>readPitchAndDuration (in category 'reading') -----
readPitchAndDuration
| tokens code |
stream next.
tokens := (stream upTo: $>) findTokens: ','.
currentDuration := tokens first asNumber / 1000.0.
tokens size > 1 ifFalse: [^ self].
code := tokens last asNumber.
currentPitch := code > "37" 64 ifTrue: [code] ifFalse: [AbstractSound pitchForMIDIKey: 35 + code]!
----- Method: DECTalkReader>>stream: (in category 'accessing') -----
stream: aStream
stream := aStream!
Object subclass: #KlattSegment
instanceVariableNames: 'name features rank duration parameters'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Klatt'!
----- Method: KlattSegment>>addParameter: (in category 'accessing') -----
addParameter: aKlattSegmentParameter
^ self parameters at: aKlattSegmentParameter selector put: aKlattSegmentParameter!
----- Method: KlattSegment>>compileOn: (in category 'printing') -----
compileOn: aClass
| stream |
stream := WriteStream on: ''.
self methodPrintOn: stream.
aClass compile: stream contents classified: 'default segments'!
----- Method: KlattSegment>>cosine:with:time:duration: (in category 'processing') -----
cosine: a with: b time: time duration: dur
time <= 0 ifTrue: [^ a].
time >= dur ifTrue: [^ b].
^ ((time / dur * Float pi) cos - 1 / -2.0) * (b - a) + a!
----- Method: KlattSegment>>doesNotUnderstand: (in category 'message dispatching') -----
doesNotUnderstand: aMessage
| sel |
(parameters includesKey: (sel := (aMessage selector copyWith: $:) asSymbol))
ifTrue: [^ parameters at: sel].
^ super doesNotUnderstand: aMessage!
----- Method: KlattSegment>>dominates: (in category 'testing') -----
dominates: aKlattSegment
"Answer true if the receiver dominates the argument,
i.e. if the receiver has greater rank than the argument."
^ self rank > aKlattSegment rank!
----- Method: KlattSegment>>duration (in category 'accessing') -----
duration
^ duration!
----- Method: KlattSegment>>duration: (in category 'accessing') -----
duration: aNumber
duration := aNumber!
----- Method: KlattSegment>>features (in category 'accessing') -----
features
^ features!
----- Method: KlattSegment>>features: (in category 'accessing') -----
features: aCollection
features := aCollection!
----- Method: KlattSegment>>initialize (in category 'initialization') -----
initialize
self parameters: Dictionary new!
----- Method: KlattSegment>>interpolate:with:mid:time:speed: (in category 'processing') -----
interpolate: slope1 with: slope2 mid: mid time: time speed: speed
| steady p1 p2 |
steady := self duration * speed - (slope1 x + slope2 x).
steady < 0 "steady state cannot be reached"
ifTrue: [p1 := self linear: slope1 y with: mid time: time duration: slope1 x.
p2 := self linear: slope2 y with: mid time: self duration * speed - time duration: slope2 x.
^ p2 - p1 * time / (self duration * speed) + p1].
time < slope1 x
ifTrue: [^ self linear: slope1 y with: mid time: time duration: slope1 x].
^ time - slope1 x <= steady "steady state reached"
ifTrue: [mid]
ifFalse: [self linear: mid with: slope2 y time: time - slope1 x - steady duration: slope2 x]!
----- Method: KlattSegment>>left:right:speed:pattern: (in category 'processing') -----
left: left right: right speed: speed pattern: patternFrame
| frames leftSlope rightSlope value |
frames := (1 to: self duration * speed) collect: [ :each | patternFrame copy].
self parameters do: [ :each |
leftSlope := self slopeWith: left selector: each selector speed: speed.
rightSlope := self slopeWith: right selector: each selector speed: speed.
0 to: self duration * speed - 1 do: [ :time |
value := self interpolate: leftSlope with: rightSlope mid: each steady time: time speed: speed.
(frames at: (time + 1) asInteger) perform: each selector with: value]].
^ frames!
----- Method: KlattSegment>>linear:with:time:duration: (in category 'processing') -----
linear: a with: b time: time duration: dur
time <= 0 ifTrue: [^ a].
time >= dur ifTrue: [^ b].
^ b - a * time / dur + a!
----- Method: KlattSegment>>methodPrintOn: (in category 'printing') -----
methodPrintOn: aStream
| param |
aStream print: self name; cr;
tab; nextPutAll: '^ self segmentFromArray: '; cr;
tab; tab; nextPutAll: '"name rank duration features"'; cr;
tab; tab; nextPutAll: '#('; print: self name; tab; tab; print: self rank; tab; tab; print: self duration; tab; tab; tab; print: (self features ifNil: [#()]); cr;
tab; tab; nextPutAll: '"selector steady fixed prop extern intern"'.
KlattFrame parameterNames do: [ :each |
(param := self parameters at: (each, ':') asSymbol ifAbsent: [])
ifNotNil: [aStream cr; tab; tab.
param methodPrintOn: aStream]].
aStream nextPut: $)!
----- Method: KlattSegment>>methodString (in category 'printing') -----
methodString
| stream |
stream := WriteStream on: ''.
self methodPrintOn: stream.
^ stream contents!
----- Method: KlattSegment>>name (in category 'accessing') -----
name
^ name!
----- Method: KlattSegment>>name: (in category 'accessing') -----
name: aString
name := aString!
----- Method: KlattSegment>>parameters (in category 'accessing') -----
parameters
^ parameters!
----- Method: KlattSegment>>parameters: (in category 'accessing') -----
parameters: aDictionary
parameters := aDictionary!
----- Method: KlattSegment>>printOn: (in category 'printing') -----
printOn: aStream
aStream nextPutAll: self name!
----- Method: KlattSegment>>rank (in category 'accessing') -----
rank
^ rank!
----- Method: KlattSegment>>rank: (in category 'accessing') -----
rank: aNumber
rank := aNumber!
----- Method: KlattSegment>>slopeWith:selector:speed: (in category 'processing') -----
slopeWith: aKlattSegment selector: selector speed: speed
| me other |
me := self parameters at: selector.
other := aKlattSegment parameters at: selector.
^ (self dominates: aKlattSegment)
ifTrue: [me slopeWithDominated: other speed: speed]
ifFalse: [me slopeWithDominant: other speed: speed]!
Object subclass: #KlattSegmentParameter
instanceVariableNames: 'selector steady fixed proportion internal external'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Klatt'!
----- Method: KlattSegmentParameter>>external (in category 'accessing') -----
external
^ external!
----- Method: KlattSegmentParameter>>external: (in category 'accessing') -----
external: aNumber
external := aNumber!
----- Method: KlattSegmentParameter>>fixed (in category 'accessing') -----
fixed
^ fixed!
----- Method: KlattSegmentParameter>>fixed: (in category 'accessing') -----
fixed: aNumber
fixed := aNumber!
----- Method: KlattSegmentParameter>>internal (in category 'accessing') -----
internal
^ internal!
----- Method: KlattSegmentParameter>>internal: (in category 'accessing') -----
internal: aNumber
internal := aNumber!
----- Method: KlattSegmentParameter>>methodPrintOn: (in category 'printing') -----
methodPrintOn: aStream
aStream nextPut: $(; print: self selector; tab.
self selector size < 4 ifTrue: [aStream tab].
self selector size < 8 ifTrue: [aStream tab].
aStream print: self steady; tab; tab; print: self fixed; tab; tab; print: self proportion; tab; tab; print: self external; tab; tab; print: self internal; nextPut: $)!
----- Method: KlattSegmentParameter>>printOn: (in category 'printing') -----
printOn: aStream
aStream nextPutAll: self selector; space; print: self steady!
----- Method: KlattSegmentParameter>>proportion (in category 'accessing') -----
proportion
^ proportion!
----- Method: KlattSegmentParameter>>proportion: (in category 'accessing') -----
proportion: aNumber
proportion := aNumber!
----- Method: KlattSegmentParameter>>selector (in category 'accessing') -----
selector
^ selector!
----- Method: KlattSegmentParameter>>selector: (in category 'accessing') -----
selector: aSymbol
selector := aSymbol asSymbol!
----- Method: KlattSegmentParameter>>slopeWith:dominant:speed: (in category 'processing') -----
slopeWith: parameter dominant: dominant speed: speed
| dominated time value |
dominated := self == dominant ifTrue: [parameter] ifFalse: [self].
time := dominant == self ifTrue: [dominant internal] ifFalse: [dominant external].
time := time * speed.
value := time ~= 0
ifTrue: [dominant proportion * dominated steady * 0.01 + dominant fixed]
ifFalse: [dominated steady].
^ time @ value!
----- Method: KlattSegmentParameter>>slopeWithDominant:speed: (in category 'processing') -----
slopeWithDominant: parameter speed: speed
^ self slopeWith: parameter dominant: parameter speed: speed!
----- Method: KlattSegmentParameter>>slopeWithDominated:speed: (in category 'processing') -----
slopeWithDominated: parameter speed: speed
^ self slopeWith: parameter dominant: self speed: speed!
----- Method: KlattSegmentParameter>>steady (in category 'accessing') -----
steady
^ steady!
----- Method: KlattSegmentParameter>>steady: (in category 'accessing') -----
steady: aNumber
steady := aNumber!
Object subclass: #KlattSegmentSet
instanceVariableNames: 'phonemes segments'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Klatt'!
!KlattSegmentSet commentStamp: '<historical>' prior: 0!
My instances are sets of KlattSegments, and they map phonemes to actual KlattSegments. The default segments are adapted from rsynth 2.0, a public domain TTS.!
----- Method: KlattSegmentSet class>>arpabet (in category 'instance creation') -----
arpabet
^ self new initializeArpabet!
----- Method: KlattSegmentSet>>a (in category 'default segments') -----
a
^ self segmentFromArray:
"name rank duration features"
#(a 2 4 (cnt mdl unr vwl )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 490 230.0 50 4 4)
(b1: 60 30.0 50 4 4)
(f2: 1480 710.0 50 4 4)
(b2: 90 45.0 50 4 4)
(f3: 2500 1220.0 50 4 4)
(b3: 150 75.0 50 4 4)
(fnz: 270 135.0 50 0 0)
(a2f: 64.75 31.5 50 4 4)
(a3f: 47.25 24.5 50 4 4)
(a4f: 40.25 21.0 50 4 4)
(a5f: -16 -8.0 50 4 4)
(a6f: -16 -8.0 50 4 4)
(bypass: -16 -8.0 50 4 4)
(b2f: 90 45.0 50 4 4)
(b3f: 150 75.0 50 4 4)
(anv: -16 0.0 100 4 4)
(a1v: 64.75 31.5 50 4 4)
(a2v: 64.75 31.5 50 4 4)
(a3v: 47.25 24.5 50 4 4)
(a4v: 40.25 21.0 50 4 4))!
----- Method: KlattSegmentSet>>aa (in category 'default segments') -----
aa
^ self segmentFromArray:
"name rank duration features"
#(aa 2 5 (fnt low unr vwl )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 790 410.0 50 4 4)
(b1: 130 65.0 50 4 4)
(f2: 1780 950.0 50 4 4)
(b2: 90 45.0 50 4 4)
(f3: 2500 1220.0 50 4 4)
(b3: 150 75.0 50 4 4)
(fnz: 270 135.0 50 0 0)
(a2f: 61.25 31.5 50 4 4)
(a3f: 52.5 24.5 50 4 4)
(a4f: 45.5 21.0 50 4 4)
(a5f: -16 -8.0 50 4 4)
(a6f: -16 -8.0 50 4 4)
(bypass: -16 -8.0 50 4 4)
(b2f: 90 45.0 50 4 4)
(b3f: 150 75.0 50 4 4)
(anv: -16 0.0 100 4 4)
(a1v: 64.75 31.5 50 4 4)
(a2v: 61.25 31.5 50 4 4)
(a3v: 52.5 24.5 50 4 4)
(a4v: 45.5 21.0 50 4 4))!
----- Method: KlattSegmentSet>>ai (in category 'default segments') -----
ai
^ self segmentFromArray:
"name rank duration features"
#(ai 2 6 (fnt lmd unr vwl )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 640 290.0 50 5 5)
(b1: 60 30.0 50 5 5)
(f2: 1600 830.0 50 5 5)
(b2: 90 45.0 50 5 5)
(f3: 2500 1220.0 50 5 5)
(b3: 150 75.0 50 5 5)
(fnz: 270 135.0 50 0 0)
(a2f: 59.5 28.0 50 5 5)
(a3f: 49 24.5 50 5 5)
(a4f: 43.75 21.0 50 5 5)
(a5f: -16 -8.0 50 5 5)
(a6f: -16 -8.0 50 5 5)
(bypass: -16 -8.0 50 5 5)
(b2f: 90 45.0 50 5 5)
(b3f: 150 75.0 50 5 5)
(anv: -16 0.0 100 5 5)
(a1v: 64.75 31.5 50 5 5)
(a2v: 59.5 28.0 50 5 5)
(a3v: 49 24.5 50 5 5)
(a4v: 43.75 21.0 50 5 5))!
----- Method: KlattSegmentSet>>air (in category 'default segments') -----
air
^ self segmentFromArray:
"name rank duration features"
#(air 2 6 (fnt lmd unr vwl )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 640 350.0 50 5 5)
(b1: 60 30.0 50 5 5)
(f2: 2020 1070.0 50 5 5)
(b2: 90 45.0 50 5 5)
(f3: 2500 1220.0 50 5 5)
(b3: 150 75.0 50 5 5)
(fnz: 270 135.0 50 0 0)
(a2f: 56 28.0 50 5 5)
(a3f: 52.5 24.5 50 5 5)
(a4f: 45.5 21.0 50 5 5)
(a5f: -16 -8.0 50 5 5)
(a6f: -16 -8.0 50 5 5)
(bypass: -16 -8.0 50 5 5)
(b2f: 90 45.0 50 5 5)
(b3f: 150 75.0 50 5 5)
(anv: -16 0.0 100 5 5)
(a1v: 64.75 31.5 50 5 5)
(a2v: 56 28.0 50 5 5)
(a3v: 52.5 24.5 50 5 5)
(a4v: 45.5 21.0 50 5 5))!
----- Method: KlattSegmentSet>>ar (in category 'default segments') -----
ar
^ self segmentFromArray:
"name rank duration features"
#(ar 2 15 (bck low unr vwl )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 790 410.0 50 4 4)
(b1: 60 30.0 50 4 4)
(f2: 880 470.0 50 4 4)
(b2: 90 45.0 50 4 4)
(f3: 2500 1220.0 50 4 4)
(b3: 150 75.0 50 4 4)
(fnz: 270 135.0 50 0 0)
(a2f: 63 31.5 50 4 4)
(a3f: 43.75 21.0 50 4 4)
(a4f: 36.75 17.5 50 4 4)
(a5f: -16 -8.0 50 4 4)
(a6f: -16 -8.0 50 4 4)
(bypass: -16 -8.0 50 4 4)
(b2f: 90 45.0 50 4 4)
(b3f: 150 75.0 50 4 4)
(anv: -16 0.0 100 4 4)
(a1v: 64.75 31.5 50 4 4)
(a2v: 63 31.5 50 4 4)
(a3v: 43.75 21.0 50 4 4)
(a4v: 36.75 17.5 50 4 4))!
----- Method: KlattSegmentSet>>at: (in category 'accessing') -----
at: aPhoneme
^ self segments at: aPhoneme!
----- Method: KlattSegmentSet>>at:ifAbsent: (in category 'accessing') -----
at: aPhoneme ifAbsent: aBlock
^ self segments at: aPhoneme ifAbsent: aBlock!
----- Method: KlattSegmentSet>>aw (in category 'default segments') -----
aw
^ self segmentFromArray:
"name rank duration features"
#(aw 2 10 (bck lmd rnd vwl )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 490 230.0 50 4 4)
(b1: 60 30.0 50 4 4)
(f2: 820 470.0 50 4 4)
(b2: 90 45.0 50 4 4)
(f3: 2500 1220.0 50 4 4)
(b3: 150 75.0 50 4 4)
(fnz: 270 135.0 50 0 0)
(a2f: 59.5 28.0 50 4 4)
(a3f: 36.75 17.5 50 4 4)
(a4f: 31.5 14.0 50 4 4)
(a5f: -16 -8.0 50 4 4)
(a6f: -16 -8.0 50 4 4)
(bypass: -16 -8.0 50 4 4)
(b2f: 90 45.0 50 4 4)
(b3f: 150 75.0 50 4 4)
(anv: -16 0.0 100 4 4)
(a1v: 64.75 31.5 50 4 4)
(a2v: 59.5 28.0 50 4 4)
(a3v: 36.75 17.5 50 4 4)
(a4v: 31.5 14.0 50 4 4))!
----- Method: KlattSegmentSet>>b (in category 'default segments') -----
b
^ self segmentFromArray:
"name rank duration features"
#(b 26 12 (blb stp vcd )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 190 110.0 50 2 2)
(b1: 60 30.0 50 2 2)
(f2: 760 350.0 50 2 2)
(b2: 90 45.0 50 2 2)
(f3: 2500 0.0 100 0 2)
(b3: 150 0.0 100 0 2)
(fnz: 270 135.0 50 0 0)
(a2f: -16 0.0 100 0 0)
(a3f: -16 0.0 100 0 0)
(a4f: -16 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 2 2)
(b3f: 150 0.0 100 0 2)
(anv: -16 0.0 100 0 0)
(a1v: 38.5 0.0 100 0 0)
(a2v: -16 0.0 100 0 0)
(a3v: -16 0.0 100 0 0)
(a4v: -16 0.0 100 0 0))!
----- Method: KlattSegmentSet>>by (in category 'default segments') -----
by
^ self segmentFromArray:
"name rank duration features"
#(by 29 1 (blb stp vcd )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 190 0.0 100 0 0)
(b1: 60 0.0 100 0 0)
(f2: 760 0.0 100 0 0)
(b2: 90 0.0 100 0 0)
(f3: 2500 0.0 100 0 0)
(b3: 150 0.0 100 0 0)
(fnz: 270 135.0 50 0 0)
(a2f: 63 0.0 100 0 0)
(a3f: 57.25 0.0 100 0 0)
(a4f: 52.5 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 0.0 100 0 0)
(b3f: 150 0.0 100 0 0)
(anv: -16 0.0 100 0 0)
(a1v: 38.5 0.0 100 0 0)
(a2v: 63 0.0 100 0 0)
(a3v: 57.25 0.0 100 0 0)
(a4v: 52.5 0.0 100 0 0))!
----- Method: KlattSegmentSet>>bz (in category 'default segments') -----
bz
^ self segmentFromArray:
"name rank duration features"
#(bz 26 0 (blb stp vcd )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 190 110.0 50 2 0)
(b1: 60 30.0 50 2 0)
(f2: 760 350.0 50 2 0)
(b2: 90 45.0 50 2 0)
(f3: 2500 0.0 100 0 0)
(b3: 150 0.0 100 0 0)
(fnz: 270 135.0 50 0 0)
(a2f: -16 0.0 100 0 0)
(a3f: -16 0.0 100 0 0)
(a4f: -16 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 2 0)
(b3f: 150 0.0 100 0 0)
(anv: -16 0.0 100 0 0)
(a1v: -16 0.0 100 0 0)
(a2v: -16 0.0 100 0 0)
(a3v: -16 0.0 100 0 0)
(a4v: -16 0.0 100 0 0))!
----- Method: KlattSegmentSet>>ch (in category 'default segments') -----
ch
^ self segmentFromArray:
"name rank duration features"
#(ch 23 4 (alv stp vls )
"selector steady fixed prop extern intern"
(voicing: 0 0.0 50 0 0)
(aspiration: 60 30.0 50 0 0)
(friction: 60 30.0 50 0 0)
(f1: 190 110.0 50 2 2)
(b1: 60 30.0 50 2 2)
(f2: 1780 950.0 50 2 2)
(b2: 90 45.0 50 2 2)
(f3: 2680 2680.0 0 2 2)
(b3: 150 150.0 0 2 2)
(fnz: 270 135.0 50 0 0)
(a2f: -16 0.0 100 0 0)
(a3f: -16 0.0 100 0 0)
(a4f: -16 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 2 2)
(b3f: 150 150.0 0 2 2)
(anv: -16 0.0 100 0 0)
(a1v: -16 0.0 100 0 0)
(a2v: -16 0.0 100 0 0)
(a3v: -16 0.0 100 0 0)
(a4v: -16 0.0 100 0 0))!
----- Method: KlattSegmentSet>>ci (in category 'default segments') -----
ci
^ self segmentFromArray:
"name rank duration features"
#(ci 18 8 (frc pla vls )
"selector steady fixed prop extern intern"
(voicing: 0 0.0 50 0 0)
(aspiration: 60 30.0 50 0 0)
(friction: 60 30.0 50 0 0)
(f1: 400 170.0 50 3 2)
(b1: 60 30.0 50 3 2)
(f2: 2020 1190.0 50 3 2)
(b2: 90 45.0 50 3 2)
(f3: 2560 0.0 100 3 2)
(b3: 150 0.0 100 3 2)
(fnz: 270 135.0 50 0 0)
(a2f: 45.5 0.0 100 0 0)
(a3f: 56 0.0 100 0 0)
(a4f: 45.5 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 3 2)
(b3f: 150 0.0 100 3 2)
(anv: -16 0.0 100 0 0)
(a1v: -16 0.0 100 0 0)
(a2v: 45.5 0.0 100 0 0)
(a3v: 56 0.0 100 0 0)
(a4v: 45.5 0.0 100 0 0))!
----- Method: KlattSegmentSet>>d (in category 'default segments') -----
d
^ self segmentFromArray:
"name rank duration features"
#(d 26 8 (alv stp vcd )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 190 110.0 50 2 2)
(b1: 60 30.0 50 2 2)
(f2: 1780 950.0 50 2 2)
(b2: 90 45.0 50 2 2)
(f3: 2680 2680.0 0 2 2)
(b3: 150 150.0 0 2 2)
(fnz: 270 135.0 50 0 0)
(a2f: -16 0.0 100 0 0)
(a3f: -16 0.0 100 0 0)
(a4f: -16 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 2 2)
(b3f: 150 150.0 0 2 2)
(anv: -16 0.0 100 0 0)
(a1v: 45.5 0.0 100 0 0)
(a2v: -16 0.0 100 0 0)
(a3v: -16 0.0 100 0 0)
(a4v: -16 0.0 100 0 0))!
----- Method: KlattSegmentSet>>dh (in category 'default segments') -----
dh
^ self segmentFromArray:
"name rank duration features"
#(dh 20 4 (dnt frc vcd )
"selector steady fixed prop extern intern"
(voicing: 36 18.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 60 30.0 50 0 0)
(f1: 280 170.0 50 3 2)
(b1: 60 30.0 50 3 2)
(f2: 1600 1190.0 50 3 2)
(b2: 90 45.0 50 3 2)
(f3: 2560 0.0 100 3 2)
(b3: 150 0.0 100 3 2)
(fnz: 270 135.0 50 0 0)
(a2f: 45.5 0.0 100 0 0)
(a3f: 40.25 0.0 100 0 0)
(a4f: 42 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: 54 27.0 50 0 0)
(b2f: 90 45.0 50 3 2)
(b3f: 150 0.0 100 3 2)
(anv: -16 0.0 100 0 0)
(a1v: 43.75 0.0 100 0 0)
(a2v: 45.5 0.0 100 0 0)
(a3v: 40.25 0.0 100 0 0)
(a4v: 42 0.0 100 0 0))!
----- Method: KlattSegmentSet>>di (in category 'default segments') -----
di
^ self segmentFromArray:
"name rank duration features"
#(di 20 4 (dnt frc vcd )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 280 170.0 50 3 2)
(b1: 60 30.0 50 3 2)
(f2: 1600 1190.0 50 3 2)
(b2: 90 45.0 50 3 2)
(f3: 2560 0.0 100 3 2)
(b3: 150 0.0 100 3 2)
(fnz: 270 135.0 50 0 0)
(a2f: 45.5 0.0 100 0 0)
(a3f: 40.25 0.0 100 0 0)
(a4f: 42 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 3 2)
(b3f: 150 0.0 100 3 2)
(anv: -16 0.0 100 0 0)
(a1v: 43.75 0.0 100 0 0)
(a2v: 45.5 0.0 100 0 0)
(a3v: 40.25 0.0 100 0 0)
(a4v: 42 0.0 100 0 0))!
----- Method: KlattSegmentSet>>do: (in category 'enumerating') -----
do: aBlock
self segments do: [ :each | each do: aBlock]!
----- Method: KlattSegmentSet>>dy (in category 'default segments') -----
dy
^ self segmentFromArray:
"name rank duration features"
#(dy 29 1 (alv stp vcd )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 190 0.0 100 0 0)
(b1: 60 0.0 100 0 0)
(f2: 1780 0.0 100 0 0)
(b2: 90 0.0 100 0 0)
(f3: 2680 0.0 100 0 0)
(b3: 150 0.0 100 0 0)
(fnz: 270 135.0 50 0 0)
(a2f: 52.5 0.0 100 0 0)
(a3f: 49 0.0 100 0 0)
(a4f: 59.5 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 0.0 100 0 0)
(b3f: 150 0.0 100 0 0)
(anv: -16 0.0 100 0 0)
(a1v: 52.5 0.0 100 0 0)
(a2v: 52.5 0.0 100 0 0)
(a3v: 49 0.0 100 0 0)
(a4v: 59.5 0.0 100 0 0))!
----- Method: KlattSegmentSet>>dz (in category 'default segments') -----
dz
^ self segmentFromArray:
"name rank duration features"
#(dz 26 1 (alv stp vcd )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 190 110.0 50 2 0)
(b1: 60 30.0 50 2 0)
(f2: 1780 950.0 50 2 0)
(b2: 90 45.0 50 2 0)
(f3: 2680 2680.0 0 2 0)
(b3: 150 150.0 0 2 0)
(fnz: 270 135.0 50 0 0)
(a2f: 42 0.0 100 0 0)
(a3f: 38.5 0.0 100 0 0)
(a4f: 49 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 2 0)
(b3f: 150 150.0 0 2 0)
(anv: -16 0.0 100 0 0)
(a1v: 52.5 0.0 100 0 0)
(a2v: 42 0.0 100 0 0)
(a3v: 38.5 0.0 100 0 0)
(a4v: 49 0.0 100 0 0))!
----- Method: KlattSegmentSet>>e (in category 'default segments') -----
e
^ self segmentFromArray:
"name rank duration features"
#(e 2 4 (fnt lmd unr vwl )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 640 350.0 50 4 4)
(b1: 60 30.0 50 4 4)
(f2: 2020 1070.0 50 4 4)
(b2: 90 45.0 50 4 4)
(f3: 2500 1220.0 50 4 4)
(b3: 150 75.0 50 4 4)
(fnz: 270 135.0 50 0 0)
(a2f: 56 28.0 50 4 4)
(a3f: 52.5 24.5 50 4 4)
(a4f: 45.5 21.0 50 4 4)
(a5f: -16 -8.0 50 4 4)
(a6f: -16 -8.0 50 4 4)
(bypass: -16 -8.0 50 4 4)
(b2f: 90 45.0 50 4 4)
(b3f: 150 75.0 50 4 4)
(anv: -16 0.0 100 4 4)
(a1v: 64.75 31.5 50 4 4)
(a2v: 56 28.0 50 4 4)
(a3v: 52.5 24.5 50 4 4)
(a4v: 45.5 21.0 50 4 4))!
----- Method: KlattSegmentSet>>ee (in category 'default segments') -----
ee
^ self segmentFromArray:
"name rank duration features"
#(ee 2 7 (fnt hgh unr vwl )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 250 110.0 50 4 4)
(b1: 60 30.0 50 4 4)
(f2: 2320 1190.0 50 4 4)
(b2: 90 45.0 50 4 4)
(f3: 3200 1580.0 50 4 4)
(b3: 150 75.0 50 4 4)
(fnz: 270 135.0 50 0 0)
(a2f: 47.25 24.5 50 4 4)
(a3f: 50.75 24.5 50 4 4)
(a4f: 45.5 21.0 50 4 4)
(a5f: -16 -8.0 50 4 4)
(a6f: -16 -8.0 50 4 4)
(bypass: -16 -8.0 50 4 4)
(b2f: 90 45.0 50 4 4)
(b3f: 150 75.0 50 4 4)
(anv: -16 0.0 100 4 4)
(a1v: 64.75 31.5 50 4 4)
(a2v: 47.25 24.5 50 4 4)
(a3v: 50.75 24.5 50 4 4)
(a4v: 45.5 21.0 50 4 4))!
----- Method: KlattSegmentSet>>end (in category 'default segments') -----
end
^ self segmentFromArray:
"name rank duration features"
#(end 31 5 (0 )
"selector steady fixed prop extern intern"
(voicing: 0 0.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 490 0.0 100 0 0)
(b1: 60 0.0 100 0 0)
(f2: 1480 0.0 100 0 0)
(b2: 90 0.0 100 0 0)
(f3: 2500 0.0 100 0 0)
(b3: 150 0.0 100 0 0)
(fnz: 270 135.0 50 3 3)
(a2f: -16 -10.5 100 3 0)
(a3f: -16 -10.5 100 3 0)
(a4f: -16 -10.5 100 3 0)
(a5f: -16 0.0 100 3 0)
(a6f: -16 0.0 100 3 0)
(bypass: -16 0.0 100 3 0)
(b2f: 90 0.0 100 0 0)
(b3f: 150 0.0 100 0 0)
(anv: -16 -10.5 100 3 0)
(a1v: -16 -10.5 100 3 0)
(a2v: -16 -10.5 100 3 0)
(a3v: -16 -10.5 100 3 0)
(a4v: -16 -10.5 100 3 0))!
----- Method: KlattSegmentSet>>er (in category 'default segments') -----
er
^ self segmentFromArray:
"name rank duration features"
#(er 2 16 (cnt lmd unr vwl )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 580 290.0 50 4 4)
(b1: 60 30.0 50 4 4)
(f2: 1420 710.0 50 4 4)
(b2: 90 45.0 50 4 4)
(f3: 2500 1220.0 50 4 4)
(b3: 150 75.0 50 4 4)
(fnz: 270 135.0 50 0 0)
(a2f: 59.5 28.0 50 4 4)
(a3f: 47.25 24.5 50 4 4)
(a4f: 40.25 21.0 50 4 4)
(a5f: -16 -8.0 50 4 4)
(a6f: -16 -8.0 50 4 4)
(bypass: -16 -8.0 50 4 4)
(b2f: 90 45.0 50 4 4)
(b3f: 150 75.0 50 4 4)
(anv: -16 0.0 100 4 4)
(a1v: 64.75 31.5 50 4 4)
(a2v: 59.5 28.0 50 4 4)
(a3v: 47.25 24.5 50 4 4)
(a4v: 40.25 21.0 50 4 4))!
----- Method: KlattSegmentSet>>f (in category 'default segments') -----
f
^ self segmentFromArray:
"name rank duration features"
#(f 18 12 (frc lbd vls )
"selector steady fixed prop extern intern"
(voicing: 0 0.0 50 0 0)
(aspiration: 32 16.0 50 0 0)
(friction: 54 30.0 50 0 0)
(f1: 400 170.0 50 3 2)
(b1: 60 30.0 50 3 2)
(f2: 1420 350.0 50 3 2)
(b2: 90 45.0 50 3 2)
(f3: 2560 980.0 50 3 2)
(b3: 150 75.0 50 3 2)
(fnz: 270 135.0 50 0 0)
(a2f: 14 0.0 100 0 0)
(a3f: 14 0.0 100 0 0)
(a4f: -16 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: 54 27.0 50 0 0)
(b2f: 90 45.0 50 3 2)
(b3f: 150 75.0 50 3 2)
(anv: -16 0.0 100 0 0)
(a1v: -16 0.0 100 0 0)
(a2v: 14 0.0 100 0 0)
(a3v: 14 0.0 100 0 0)
(a4v: -16 0.0 100 0 0))!
----- Method: KlattSegmentSet>>g (in category 'default segments') -----
g
^ self segmentFromArray:
"name rank duration features"
#(g 26 12 (stp vcd vel )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 190 110.0 50 3 3)
(b1: 60 30.0 50 3 3)
(f2: 1480 1550.0 50 3 3)
(b2: 90 45.0 50 3 3)
(f3: 2620 1580.0 50 3 3)
(b3: 150 75.0 50 3 3)
(fnz: 270 135.0 50 0 0)
(a2f: -16 0.0 100 0 0)
(a3f: -16 0.0 100 0 0)
(a4f: -16 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 3 3)
(b3f: 150 75.0 50 3 3)
(anv: -16 0.0 100 0 0)
(a1v: 49 0.0 100 0 0)
(a2v: -16 0.0 100 0 0)
(a3v: -16 0.0 100 0 0)
(a4v: -16 0.0 100 0 0))!
----- Method: KlattSegmentSet>>gy (in category 'default segments') -----
gy
^ self segmentFromArray:
"name rank duration features"
#(gy 29 1 (stp vcd vel )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 190 0.0 100 0 0)
(b1: 60 0.0 100 0 0)
(f2: 1480 0.0 100 0 0)
(b2: 90 0.0 100 0 0)
(f3: 2620 0.0 100 0 0)
(b3: 150 0.0 100 0 0)
(fnz: 270 135.0 50 0 0)
(a2f: 59.5 0.0 100 0 0)
(a3f: 54.25 0.0 100 0 0)
(a4f: 38.5 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 0.0 100 0 0)
(b3f: 150 0.0 100 0 0)
(anv: -16 0.0 100 0 0)
(a1v: 49 0.0 100 0 0)
(a2v: 59.5 0.0 100 0 0)
(a3v: 54.25 0.0 100 0 0)
(a4v: 38.5 0.0 100 0 0))!
----- Method: KlattSegmentSet>>gz (in category 'default segments') -----
gz
^ self segmentFromArray:
"name rank duration features"
#(gz 26 2 (stp vcd vel )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 190 110.0 50 3 2)
(b1: 60 30.0 50 3 2)
(f2: 1480 1550.0 50 3 2)
(b2: 90 45.0 50 3 2)
(f3: 2620 1580.0 50 3 2)
(b3: 150 75.0 50 3 2)
(fnz: 270 135.0 50 0 0)
(a2f: 49 0.0 100 0 0)
(a3f: 43.75 0.0 100 0 0)
(a4f: 28 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 3 2)
(b3f: 150 75.0 50 3 2)
(anv: -16 0.0 100 0 0)
(a1v: 49 0.0 100 0 0)
(a2v: 49 0.0 100 0 0)
(a3v: 43.75 0.0 100 0 0)
(a4v: 28 0.0 100 0 0))!
----- Method: KlattSegmentSet>>h (in category 'default segments') -----
h
^ self segmentFromArray:
"name rank duration features"
#(h 9 10 (apr glt )
"selector steady fixed prop extern intern"
(voicing: 0 0.0 50 0 0)
(aspiration: 60 30.0 50 0 0)
(friction: 60 30.0 50 0 0)
(f1: 490 0.0 100 0 7)
(b1: 60 0.0 100 0 7)
(f2: 1480 0.0 100 0 7)
(b2: 90 0.0 100 0 7)
(f3: 2500 0.0 100 0 7)
(b3: 150 0.0 100 0 7)
(fnz: 270 135.0 50 0 0)
(a2f: 50.75 -14.0 100 0 7)
(a3f: 40.25 -7.0 100 0 7)
(a4f: 36.75 -3.5 100 0 7)
(a5f: -16 0.0 100 0 7)
(a6f: -16 0.0 100 0 7)
(bypass: -16 0.0 100 0 7)
(b2f: 90 0.0 100 0 7)
(b3f: 150 0.0 100 0 7)
(anv: -16 0.0 100 0 7)
(a1v: 49 -14.0 100 0 7)
(a2v: 50.75 -14.0 100 0 7)
(a3v: 40.25 -7.0 100 0 7)
(a4v: 36.75 -3.5 100 0 7))!
----- Method: KlattSegmentSet>>i (in category 'default segments') -----
i
^ self segmentFromArray:
"name rank duration features"
#(i 2 6 (fnt smh unr vwl )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 400 170.0 50 4 4)
(b1: 60 30.0 50 4 4)
(f2: 2080 1070.0 50 4 4)
(b2: 90 45.0 50 4 4)
(f3: 2560 1340.0 50 4 4)
(b3: 150 75.0 50 4 4)
(fnz: 270 135.0 50 0 0)
(a2f: 50.75 24.5 50 4 4)
(a3f: 49 24.5 50 4 4)
(a4f: 43.75 21.0 50 4 4)
(a5f: -16 -8.0 50 4 4)
(a6f: -16 -8.0 50 4 4)
(bypass: -16 -8.0 50 4 4)
(b2f: 90 45.0 50 4 4)
(b3f: 150 75.0 50 4 4)
(anv: -16 0.0 100 4 4)
(a1v: 64.75 31.5 50 4 4)
(a2v: 50.75 24.5 50 4 4)
(a3v: 49 24.5 50 4 4)
(a4v: 43.75 21.0 50 4 4))!
----- Method: KlattSegmentSet>>ia (in category 'default segments') -----
ia
^ self segmentFromArray:
"name rank duration features"
#(ia 2 6 (fnt smh unr vwl )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 310 170.0 50 5 5)
(b1: 60 30.0 50 5 5)
(f2: 2200 1070.0 50 5 5)
(b2: 90 45.0 50 5 5)
(f3: 2920 1460.0 50 5 5)
(b3: 150 75.0 50 5 5)
(fnz: 270 135.0 50 0 0)
(a2f: 49 24.5 50 5 5)
(a3f: 50.75 24.5 50 5 5)
(a4f: 45.5 21.0 50 5 5)
(a5f: -16 -8.0 50 5 5)
(a6f: -16 -8.0 50 5 5)
(bypass: -16 -8.0 50 5 5)
(b2f: 90 45.0 50 5 5)
(b3f: 150 75.0 50 5 5)
(anv: -16 0.0 100 5 5)
(a1v: 64.75 31.5 50 5 5)
(a2v: 49 24.5 50 5 5)
(a3v: 50.75 24.5 50 5 5)
(a4v: 45.5 21.0 50 5 5))!
----- Method: KlattSegmentSet>>ib (in category 'default segments') -----
ib
^ self segmentFromArray:
"name rank duration features"
#(ib 2 6 (fnt low unr vwl )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 490 230.0 50 4 4)
(b1: 60 30.0 50 4 4)
(f2: 1480 710.0 50 4 4)
(b2: 90 45.0 50 4 4)
(f3: 2500 1220.0 50 4 4)
(b3: 150 75.0 50 4 4)
(fnz: 270 135.0 50 0 0)
(a2f: 64.75 31.5 50 4 4)
(a3f: 47.25 24.5 50 4 4)
(a4f: 40.25 21.0 50 4 4)
(a5f: -16 -8.0 50 4 4)
(a6f: -16 -8.0 50 4 4)
(bypass: -16 -8.0 50 4 4)
(b2f: 90 45.0 50 4 4)
(b3f: 150 75.0 50 4 4)
(anv: -16 0.0 100 4 4)
(a1v: 64.75 31.5 50 4 4)
(a2v: 64.75 31.5 50 4 4)
(a3v: 47.25 24.5 50 4 4)
(a4v: 40.25 21.0 50 4 4))!
----- Method: KlattSegmentSet>>ie (in category 'default segments') -----
ie
^ self segmentFromArray:
"name rank duration features"
#(ie 2 6 (cnt low unr vwl )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 790 410.0 50 5 5)
(b1: 60 30.0 50 5 5)
(f2: 880 470.0 50 5 5)
(b2: 90 45.0 50 5 5)
(f3: 2500 1220.0 50 5 5)
(b3: 150 75.0 50 5 5)
(fnz: 270 135.0 50 0 0)
(a2f: 63 31.5 50 5 5)
(a3f: 43.75 21.0 50 5 5)
(a4f: 36.75 17.5 50 5 5)
(a5f: -16 -8.0 50 5 5)
(a6f: -16 -8.0 50 5 5)
(bypass: -16 -8.0 50 5 5)
(b2f: 90 45.0 50 5 5)
(b3f: 150 75.0 50 5 5)
(anv: -16 0.0 100 5 5)
(a1v: 64.75 31.5 50 5 5)
(a2v: 63 31.5 50 5 5)
(a3v: 43.75 21.0 50 5 5)
(a4v: 36.75 17.5 50 5 5))!
----- Method: KlattSegmentSet>>initializeArpabet (in category 'initialization') -----
initializeArpabet
phonemes := PhonemeSet arpabet.
segments := Dictionary new.
#(('p' (p py pz))
('t' (t ty tz))
('k' (k ky kz))
('b' (b by bz))
('d' (d dy dz))
('g' (g gy gz))
('m' (m))
('n' (n))
('ng' (ng))
('f' (f))
('th' (th))
('s' (s))
('sh' (sh))
('hh' (h))
('v' (v qq v))
('dh' (dh qq di))
('z' (z qq zz))
('zh' (zh qq zh))
('ch' (ch ci))
('jh' (j jy qq jy))
('l' (l))
('r' (r))
('w' (w))
('q' (qq)) "stop-ness - not quite glottal stop"
('y' (y))
('ih' (i))
('eh' (e))
('ae' (aa))
('ah' (u))
" ('oh' (o)) ????????????????????????"
('uh' (oo))
('ax' (a))
('iy' (ee))
('er' (er))
('aa' (ar))
('ao' (aw))
('uw' (uu))
('ey' (ai i))
('ay' (ie i))
('oy' (oi i))
('aw' (ou ov))
('ow' (oa ov))
('ia' (ia ib))
('ea' (air ib))
('ua' (oor ib))
('sil' (q))
('ll' (ll))
('wh' (w))
('ix' (a))
('el' (l))
('rx' (rx))) do: [ :each |
segments at: (phonemes at: each first)
put: (each last collect: [ :selector | self perform: selector])]!
----- Method: KlattSegmentSet>>j (in category 'default segments') -----
j
^ self segmentFromArray:
"name rank duration features"
#(j 26 4 (alv stp vcd )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 190 110.0 50 2 2)
(b1: 60 30.0 50 2 2)
(f2: 1780 950.0 50 2 2)
(b2: 90 45.0 50 2 2)
(f3: 2680 2680.0 0 2 2)
(b3: 150 150.0 0 2 2)
(fnz: 270 135.0 50 0 0)
(a2f: -16 0.0 100 0 0)
(a3f: -16 0.0 100 0 0)
(a4f: -16 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 2 2)
(b3f: 150 150.0 0 2 2)
(anv: -16 0.0 100 0 0)
(a1v: 45.5 0.0 100 0 0)
(a2v: -16 0.0 100 0 0)
(a3v: -16 0.0 100 0 0)
(a4v: -16 0.0 100 0 0))!
----- Method: KlattSegmentSet>>jy (in category 'default segments') -----
jy
^ self segmentFromArray:
"name rank duration features"
#(jy 20 3 (frc pla vcd )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 280 170.0 50 3 2)
(b1: 60 30.0 50 3 2)
(f2: 2020 1190.0 50 3 2)
(b2: 90 45.0 50 3 2)
(f3: 2560 0.0 100 3 2)
(b3: 150 0.0 100 3 2)
(fnz: 270 135.0 50 0 0)
(a2f: 40.25 0.0 100 0 0)
(a3f: 50.75 0.0 100 0 0)
(a4f: 40.25 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 3 2)
(b3f: 150 0.0 100 3 2)
(anv: -16 0.0 100 0 0)
(a1v: 43.75 0.0 100 0 0)
(a2v: 40.25 0.0 100 0 0)
(a3v: 50.75 0.0 100 0 0)
(a4v: 40.25 0.0 100 0 0))!
----- Method: KlattSegmentSet>>k (in category 'default segments') -----
k
^ self segmentFromArray:
"name rank duration features"
#(k 23 8 (stp vel vls )
"selector steady fixed prop extern intern"
(voicing: 0 0.0 50 0 0)
(aspiration: 60 30.0 50 0 0)
(friction: 60 30.0 50 0 0)
(f1: 190 110.0 50 3 3)
(b1: 60 30.0 50 3 3)
(f2: 1480 1550.0 50 3 3)
(b2: 90 45.0 50 3 3)
(f3: 2620 1580.0 50 3 3)
(b3: 150 75.0 50 3 3)
(fnz: 270 135.0 50 0 0)
(a2f: -16 0.0 100 0 0)
(a3f: -16 0.0 100 0 0)
(a4f: -16 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 3 3)
(b3f: 150 75.0 50 3 3)
(anv: -16 0.0 100 0 0)
(a1v: -16 0.0 100 0 0)
(a2v: -16 0.0 100 0 0)
(a3v: -16 0.0 100 0 0)
(a4v: -16 0.0 100 0 0))!
----- Method: KlattSegmentSet>>ky (in category 'default segments') -----
ky
^ self segmentFromArray:
"name rank duration features"
#(ky 29 1 (stp vel vls )
"selector steady fixed prop extern intern"
(voicing: 0 0.0 50 0 0)
(aspiration: 60 30.0 50 0 0)
(friction: 60 30.0 50 0 0)
(f1: 190 0.0 100 0 0)
(b1: 60 0.0 100 0 0)
(f2: 1480 0.0 100 0 0)
(b2: 90 0.0 100 0 0)
(f3: 2620 0.0 100 0 0)
(b3: 150 0.0 100 0 0)
(fnz: 270 135.0 50 0 0)
(a2f: 64.75 0.0 100 0 0)
(a3f: 64.75 0.0 100 0 0)
(a4f: 43.75 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 0.0 100 0 0)
(b3f: 150 0.0 100 0 0)
(anv: -16 0.0 100 0 0)
(a1v: -16 0.0 100 0 0)
(a2v: 64.75 0.0 100 0 0)
(a3v: 64.75 0.0 100 0 0)
(a4v: 43.75 0.0 100 0 0))!
----- Method: KlattSegmentSet>>kz (in category 'default segments') -----
kz
^ self segmentFromArray:
"name rank duration features"
#(kz 23 4 (stp vel vls )
"selector steady fixed prop extern intern"
(voicing: 0 0.0 50 0 0)
(aspiration: 60 30.0 50 0 0)
(friction: 60 30.0 50 0 0)
(f1: 190 110.0 50 3 3)
(b1: 60 30.0 50 3 3)
(f2: 1480 1550.0 50 3 3)
(b2: 90 45.0 50 3 3)
(f3: 2620 1580.0 50 3 3)
(b3: 150 75.0 50 3 3)
(fnz: 270 135.0 50 0 0)
(a2f: 54.25 0.0 100 0 0)
(a3f: 54.25 0.0 100 0 0)
(a4f: 33.25 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 3 3)
(b3f: 150 75.0 50 3 3)
(anv: -16 0.0 100 0 0)
(a1v: -16 0.0 100 0 0)
(a2v: 54.25 0.0 100 0 0)
(a3v: 54.25 0.0 100 0 0)
(a4v: 33.25 0.0 100 0 0))!
----- Method: KlattSegmentSet>>l (in category 'default segments') -----
l
^ self segmentFromArray:
"name rank duration features"
#(l 11 8 (alv lat vcd )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 460 230.0 50 6 0)
(b1: 60 30.0 50 6 0)
(f2: 1480 710.0 50 6 0)
(b2: 90 45.0 50 6 0)
(f3: 2500 1220.0 50 6 0)
(b3: 150 75.0 50 6 0)
(fnz: 270 135.0 50 0 0)
(a2f: 40.25 0.0 100 0 0)
(a3f: 40.25 0.0 100 0 0)
(a4f: 35 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 6 0)
(b3f: 150 75.0 50 6 0)
(anv: -16 0.0 100 0 0)
(a1v: 50.75 0.0 100 0 0)
(a2v: 40.25 0.0 100 0 0)
(a3v: 40.25 0.0 100 0 0)
(a4v: 35 0.0 100 0 0))!
----- Method: KlattSegmentSet>>ll (in category 'default segments') -----
ll
^ self segmentFromArray:
"name rank duration features"
#(ll 11 8 (alv lat vcd )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 460 230.0 50 6 0)
(b1: 60 30.0 50 6 0)
(f2: 940 470.0 50 6 0)
(b2: 90 45.0 50 6 0)
(f3: 2500 1220.0 50 6 0)
(b3: 150 75.0 50 6 0)
(fnz: 270 135.0 50 0 0)
(a2f: 40.25 0.0 100 0 0)
(a3f: 40.25 0.0 100 0 0)
(a4f: 35 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 6 0)
(b3f: 150 75.0 50 6 0)
(anv: -16 0.0 100 0 0)
(a1v: 50.75 0.0 100 0 0)
(a2v: 40.25 0.0 100 0 0)
(a3v: 40.25 0.0 100 0 0)
(a4v: 35 0.0 100 0 0))!
----- Method: KlattSegmentSet>>m (in category 'default segments') -----
m
^ self segmentFromArray:
"name rank duration features"
#(m 15 8 (blb nas )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 2 0)
(aspiration: 0 0.0 50 2 0)
(friction: 0 0.0 50 2 0)
(f1: 480 480.0 0 3 0)
(b1: 40 20.0 50 3 0)
(f2: 1000 350.0 50 3 0)
(b2: 175 87.0 50 3 0)
(f3: 2200 0.0 100 5 0)
(b3: 120 0.0 100 5 0)
(fnz: 360 360.0 0 3 0)
(a2f: 44 -10.0 100 3 0)
(a3f: 47 -10.0 100 3 0)
(a4f: -16 -10.0 100 3 0)
(a5f: -16 0.0 100 3 0)
(a6f: -16 0.0 100 3 0)
(bypass: -16 0.0 100 3 0)
(b2f: 175 87.0 50 3 0)
(b3f: 120 0.0 100 5 0)
(anv: 56 28.0 50 3 0)
(a1v: 40 -10.0 100 3 0)
(a2v: 44 -10.0 100 3 0)
(a3v: 47 -10.0 100 3 0)
(a4v: -16 -10.0 100 3 0))!
----- Method: KlattSegmentSet>>n (in category 'default segments') -----
n
^ self segmentFromArray:
"name rank duration features"
#(n 15 8 (alv nas )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 2 0)
(aspiration: 0 0.0 50 2 0)
(friction: 0 0.0 50 2 0)
(f1: 480 480.0 0 3 0)
(b1: 40 20.0 50 3 0)
(f2: 1780 950.0 50 3 3)
(b2: 300 150.0 50 3 3)
(f3: 2620 2680.0 0 3 0)
(b3: 260 130.0 50 3 0)
(fnz: 450 450.0 0 3 0)
(a2f: 49 -10.0 100 3 0)
(a3f: 49 -10.0 100 3 0)
(a4f: 34 -10.0 100 3 0)
(a5f: -16 0.0 100 3 0)
(a6f: -16 0.0 100 3 0)
(bypass: -16 0.0 100 3 0)
(b2f: 300 150.0 50 3 3)
(b3f: 260 130.0 50 3 0)
(anv: 56 28.0 50 3 0)
(a1v: 49 -10.0 100 3 0)
(a2v: 49 -10.0 100 3 0)
(a3v: 49 -10.0 100 3 0)
(a4v: 34 -10.0 100 3 0))!
----- Method: KlattSegmentSet>>ng (in category 'default segments') -----
ng
^ self segmentFromArray:
"name rank duration features"
#(ng 15 8 (nas vel )
"selector steady fixed prop extern intern"
(voicing: 52 26.0 50 2 0)
(aspiration: 0 0.0 50 2 0)
(friction: 0 0.0 50 2 0)
(f1: 480 480.0 0 3 0)
(b1: 160 80.0 0 5 0)
(f2: 820 1550.0 50 5 3)
(b2: 150 75.0 50 5 3)
(f3: 2800 1580.0 50 3 3)
(b3: 100 50.0 50 3 0)
(fnz: 360 360.0 0 3 0)
(a2f: 44 0.0 100 3 0)
(a3f: 49 0.0 100 3 0)
(a4f: 14 0.0 100 3 0)
(a5f: -16 0.0 100 3 0)
(a6f: -16 0.0 100 3 0)
(bypass: -16 0.0 100 3 0)
(b2f: 150 75.0 50 5 3)
(b3f: 100 50.0 50 3 0)
(anv: 56 28.0 50 3 3)
(a1v: 34 0.0 100 3 0)
(a2v: 44 0.0 100 3 0)
(a3v: 49 0.0 100 3 0)
(a4v: 14 0.0 100 3 0))!
----- Method: KlattSegmentSet>>o (in category 'default segments') -----
o
^ self segmentFromArray:
"name rank duration features"
#(o 2 6 (bck low rnd vwl )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 610 290.0 50 4 4)
(b1: 60 30.0 50 4 4)
(f2: 880 470.0 50 4 4)
(b2: 90 45.0 50 4 4)
(f3: 2500 1220.0 50 4 4)
(b3: 150 75.0 50 4 4)
(fnz: 270 135.0 50 0 0)
(a2f: 61.25 31.5 50 4 4)
(a3f: 36.75 17.5 50 4 4)
(a4f: 29.75 14.0 50 4 4)
(a5f: -16 -8.0 50 4 4)
(a6f: -16 -8.0 50 4 4)
(bypass: -16 -8.0 50 4 4)
(b2f: 90 45.0 50 4 4)
(b3f: 150 75.0 50 4 4)
(anv: -16 0.0 100 4 4)
(a1v: 64.75 31.5 50 4 4)
(a2v: 61.25 31.5 50 4 4)
(a3v: 36.75 17.5 50 4 4)
(a4v: 29.75 14.0 50 4 4))!
----- Method: KlattSegmentSet>>oa (in category 'default segments') -----
oa
^ self segmentFromArray:
"name rank duration features"
#(oa 2 6 (cnt mdl unr vwl )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 490 230.0 50 5 5)
(b1: 60 30.0 50 5 5)
(f2: 1480 710.0 50 5 5)
(b2: 90 45.0 50 5 5)
(f3: 2500 1220.0 50 5 5)
(b3: 150 75.0 50 5 5)
(fnz: 270 135.0 50 0 0)
(a2f: 64.75 31.5 50 5 5)
(a3f: 47.25 24.5 50 5 5)
(a4f: 40.25 21.0 50 5 5)
(a5f: -16 -8.0 50 5 5)
(a6f: -16 -8.0 50 5 5)
(bypass: -16 -8.0 50 5 5)
(b2f: 90 45.0 50 5 5)
(b3f: 150 75.0 50 5 5)
(anv: -16 0.0 100 5 5)
(a1v: 64.75 31.5 50 5 5)
(a2v: 64.75 31.5 50 5 5)
(a3v: 47.25 24.5 50 5 5)
(a4v: 40.25 21.0 50 5 5))!
----- Method: KlattSegmentSet>>oi (in category 'default segments') -----
oi
^ self segmentFromArray:
"name rank duration features"
#(oi 2 6 (bck rnd umd vwl )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 490 230.0 50 5 5)
(b1: 60 30.0 50 5 5)
(f2: 820 350.0 50 5 5)
(b2: 90 45.0 50 5 5)
(f3: 2500 1220.0 50 5 5)
(b3: 150 75.0 50 5 5)
(fnz: 270 135.0 50 0 0)
(a2f: 59.5 28.0 50 5 5)
(a3f: 36.75 17.5 50 5 5)
(a4f: 31.5 14.0 50 5 5)
(a5f: -16 -8.0 50 5 5)
(a6f: -16 -8.0 50 5 5)
(bypass: -16 -8.0 50 5 5)
(b2f: 90 45.0 50 5 5)
(b3f: 150 75.0 50 5 5)
(anv: -16 0.0 100 5 5)
(a1v: 64.75 31.5 50 5 5)
(a2v: 59.5 28.0 50 5 5)
(a3v: 36.75 17.5 50 5 5)
(a4v: 31.5 14.0 50 5 5))!
----- Method: KlattSegmentSet>>oo (in category 'default segments') -----
oo
^ self segmentFromArray:
"name rank duration features"
#(oo 2 4 (bck rnd smh vwl )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 370 170.0 50 4 4)
(b1: 60 30.0 50 4 4)
(f2: 1000 470.0 50 4 4)
(b2: 90 45.0 50 4 4)
(f3: 2500 1220.0 50 4 4)
(b3: 150 75.0 50 4 4)
(fnz: 270 135.0 50 0 0)
(a2f: 56 28.0 50 4 4)
(a3f: 42 21.0 50 4 4)
(a4f: 36.75 17.5 50 4 4)
(a5f: -16 -8.0 50 4 4)
(a6f: -16 -8.0 50 4 4)
(bypass: -16 -8.0 50 4 4)
(b2f: 90 45.0 50 4 4)
(b3f: 150 75.0 50 4 4)
(anv: -16 0.0 100 4 4)
(a1v: 64.75 31.5 50 4 4)
(a2v: 56 28.0 50 4 4)
(a3v: 42 21.0 50 4 4)
(a4v: 36.75 17.5 50 4 4))!
----- Method: KlattSegmentSet>>oor (in category 'default segments') -----
oor
^ self segmentFromArray:
"name rank duration features"
#(oor 2 6 (bck rnd smh vwl )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 370 170.0 50 5 5)
(b1: 60 30.0 50 5 5)
(f2: 1000 470.0 50 5 5)
(b2: 90 45.0 50 5 5)
(f3: 2500 1220.0 50 5 5)
(b3: 150 75.0 50 5 5)
(fnz: 270 135.0 50 0 0)
(a2f: 56 28.0 50 5 5)
(a3f: 42 21.0 50 5 5)
(a4f: 36.75 14.0 50 5 5)
(a5f: -16 -8.0 50 5 5)
(a6f: -16 -8.0 50 5 5)
(bypass: -16 -8.0 50 5 5)
(b2f: 90 45.0 50 5 5)
(b3f: 150 75.0 50 5 5)
(anv: -16 0.0 100 5 5)
(a1v: 64.75 31.5 50 5 5)
(a2v: 56 28.0 50 5 5)
(a3v: 42 21.0 50 5 5)
(a4v: 36.75 14.0 50 5 5))!
----- Method: KlattSegmentSet>>or (in category 'default segments') -----
or
^ self segmentFromArray:
"name rank duration features"
#(or 2 6 (bck lmd rnd vwl )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 490 230.0 50 5 5)
(b1: 60 30.0 50 5 5)
(f2: 820 470.0 50 5 5)
(b2: 90 45.0 50 5 5)
(f3: 2500 1220.0 50 5 5)
(b3: 150 75.0 50 5 5)
(fnz: 270 135.0 50 0 0)
(a2f: 59.5 28.0 50 5 5)
(a3f: 36.75 17.5 50 5 5)
(a4f: 31.5 14.0 50 5 5)
(a5f: -16 -8.0 50 5 5)
(a6f: -16 -8.0 50 5 5)
(bypass: -16 -8.0 50 5 5)
(b2f: 90 45.0 50 5 5)
(b3f: 150 75.0 50 5 5)
(anv: -16 0.0 100 5 5)
(a1v: 64.75 31.5 50 5 5)
(a2v: 59.5 28.0 50 5 5)
(a3v: 36.75 17.5 50 5 5)
(a4v: 31.5 14.0 50 5 5))!
----- Method: KlattSegmentSet>>ou (in category 'default segments') -----
ou
^ self segmentFromArray:
"name rank duration features"
#(ou 2 6 (cnt low unr vwl )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 790 410.0 50 5 5)
(b1: 60 30.0 50 5 5)
(f2: 1300 590.0 50 5 5)
(b2: 90 45.0 50 5 5)
(f3: 2500 1220.0 50 5 5)
(b3: 150 75.0 50 5 5)
(fnz: 270 135.0 50 0 0)
(a2f: 61.25 31.5 50 5 5)
(a3f: 49 24.5 50 5 5)
(a4f: 42 21.0 50 5 5)
(a5f: -16 -8.0 50 5 5)
(a6f: -16 -8.0 50 5 5)
(bypass: -16 -8.0 50 5 5)
(b2f: 90 45.0 50 5 5)
(b3f: 150 75.0 50 5 5)
(anv: -16 0.0 100 5 5)
(a1v: 64.75 31.5 50 5 5)
(a2v: 61.25 31.5 50 5 5)
(a3v: 49 24.5 50 5 5)
(a4v: 42 21.0 50 5 5))!
----- Method: KlattSegmentSet>>ov (in category 'default segments') -----
ov
^ self segmentFromArray:
"name rank duration features"
#(ov 2 6 (bck rnd smh vwl )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 370 170.0 50 4 4)
(b1: 60 30.0 50 4 4)
(f2: 1000 470.0 50 4 4)
(b2: 90 45.0 50 4 4)
(f3: 2500 1220.0 50 4 4)
(b3: 150 75.0 50 4 4)
(fnz: 270 135.0 50 0 0)
(a2f: 56 28.0 50 4 4)
(a3f: 42 21.0 50 4 4)
(a4f: 36.75 17.5 50 4 4)
(a5f: -16 -8.0 50 4 4)
(a6f: -16 -8.0 50 4 4)
(bypass: -16 -8.0 50 4 4)
(b2f: 90 45.0 50 4 4)
(b3f: 150 75.0 50 4 4)
(anv: -16 0.0 100 4 4)
(a1v: 64.75 31.5 50 4 4)
(a2v: 56 28.0 50 4 4)
(a3v: 42 21.0 50 4 4)
(a4v: 36.75 17.5 50 4 4))!
----- Method: KlattSegmentSet>>p (in category 'default segments') -----
p
^ self segmentFromArray:
"name rank duration features"
#(p 23 8 (blb stp vls )
"selector steady fixed prop extern intern"
(voicing: 0 0.0 50 0 0)
(aspiration: 60 30.0 50 0 0)
(friction: 60 30.0 50 0 0)
(f1: 190 110.0 50 2 2)
(b1: 60 30.0 50 2 2)
(f2: 760 350.0 50 2 2)
(b2: 90 45.0 50 2 2)
(f3: 2500 0.0 100 0 2)
(b3: 150 0.0 100 0 2)
(fnz: 270 135.0 50 0 0)
(a2f: -16 0.0 100 0 0)
(a3f: -16 0.0 100 0 0)
(a4f: -16 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 2 2)
(b3f: 150 0.0 100 0 2)
(anv: -16 0.0 100 0 0)
(a1v: -16 0.0 100 0 0)
(a2v: -16 0.0 100 0 0)
(a3v: -16 0.0 100 0 0)
(a4v: -16 0.0 100 0 0))!
----- Method: KlattSegmentSet>>parameterFromArray: (in category 'segments creation') -----
parameterFromArray: anArray
| answer |
answer := KlattSegmentParameter new.
#(selector: steady: fixed: proportion: external: internal:)
doWithIndex: [ :each :index | answer perform: each with: (anArray at: index)].
^ answer!
----- Method: KlattSegmentSet>>phonemes (in category 'accessing') -----
phonemes
^ phonemes!
----- Method: KlattSegmentSet>>phonemes: (in category 'accessing-private') -----
phonemes: aPhonemeSet
phonemes := aPhonemeSet!
----- Method: KlattSegmentSet>>py (in category 'default segments') -----
py
^ self segmentFromArray:
"name rank duration features"
#(py 29 1 (blb stp vls )
"selector steady fixed prop extern intern"
(voicing: 0 0.0 50 0 0)
(aspiration: 60 30.0 50 0 0)
(friction: 60 30.0 50 0 0)
(f1: 190 0.0 100 0 0)
(b1: 60 0.0 100 0 0)
(f2: 760 0.0 100 0 0)
(b2: 90 0.0 100 0 0)
(f3: 2500 0.0 100 0 0)
(b3: 150 0.0 100 0 0)
(fnz: 270 135.0 50 0 0)
(a2f: 63 0.0 100 0 0)
(a3f: 57.75 0.0 100 0 0)
(a4f: 52.5 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 0.0 100 0 0)
(b3f: 150 0.0 100 0 0)
(anv: -16 0.0 100 0 0)
(a1v: 38.5 0.0 100 0 0)
(a2v: 63 0.0 100 0 0)
(a3v: 57.75 0.0 100 0 0)
(a4v: 52.5 0.0 100 0 0))!
----- Method: KlattSegmentSet>>pz (in category 'default segments') -----
pz
^ self segmentFromArray:
"name rank duration features"
#(pz 23 2 (blb stp vls )
"selector steady fixed prop extern intern"
(voicing: 0 0.0 50 0 0)
(aspiration: 60 30.0 50 0 0)
(friction: 60 30.0 50 0 0)
(f1: 190 110.0 50 2 2)
(b1: 60 30.0 50 2 2)
(f2: 760 350.0 50 2 2)
(b2: 90 45.0 50 2 2)
(f3: 2500 0.0 100 2 2)
(b3: 150 0.0 100 2 2)
(fnz: 270 135.0 50 0 0)
(a2f: 52.5 0.0 100 0 0)
(a3f: 47.25 0.0 100 0 0)
(a4f: 42 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 2 2)
(b3f: 150 0.0 100 2 2)
(anv: -16 0.0 100 0 0)
(a1v: 38.5 0.0 100 0 0)
(a2v: 52.5 0.0 100 0 0)
(a3v: 47.25 0.0 100 0 0)
(a4v: 42 0.0 100 0 0))!
----- Method: KlattSegmentSet>>q (in category 'default segments') -----
q
^ self segmentFromArray:
"name rank duration features"
#(q 29 6 (0 )
"selector steady fixed prop extern intern"
(voicing: 0 0.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 490 0.0 100 3 3)
(b1: 60 0.0 100 3 3)
(f2: 1480 0.0 100 3 3)
(b2: 90 0.0 100 3 3)
(f3: 2500 0.0 100 3 3)
(b3: 150 0.0 100 3 3)
(fnz: 270 135.0 50 3 3)
(a2f: -16 -10.5 100 3 0)
(a3f: -16 -10.5 100 3 0)
(a4f: -16 -10.5 100 3 0)
(a5f: -16 0.0 100 3 0)
(a6f: -16 0.0 100 3 0)
(bypass: -16 0.0 100 3 0)
(b2f: 90 0.0 100 3 3)
(b3f: 150 0.0 100 3 3)
(anv: -16 -10.5 100 3 0)
(a1v: -16 -10.5 100 3 0)
(a2v: -16 -10.5 100 3 0)
(a3v: -16 -10.5 100 3 0)
(a4v: -16 -10.5 100 3 0))!
----- Method: KlattSegmentSet>>qq (in category 'default segments') -----
qq
^ self segmentFromArray:
"name rank duration features"
#(qq 30 0 (frc vcd )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 280 0.0 100 0 0)
(b1: 60 0.0 100 0 0)
(f2: 1420 0.0 100 0 0)
(b2: 90 0.0 100 0 0)
(f3: 2560 0.0 100 0 0)
(b3: 150 0.0 100 0 0)
(fnz: 270 135.0 50 0 0)
(a2f: 54.25 0.0 100 0 0)
(a3f: 50.75 0.0 100 0 0)
(a4f: 47.25 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 0.0 100 0 0)
(b3f: 150 0.0 100 0 0)
(anv: -16 0.0 100 0 0)
(a1v: 43.75 0.0 100 0 0)
(a2v: 54.25 0.0 100 0 0)
(a3v: 50.75 0.0 100 0 0)
(a4v: 47.25 0.0 100 0 0))!
----- Method: KlattSegmentSet>>r (in category 'default segments') -----
r
^ self segmentFromArray:
"name rank duration features"
#(r 10 11 (alv apr )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 490 0.0 100 0 5)
(b1: 60 0.0 100 0 5)
(f2: 1180 590.0 50 5 5)
(b2: 90 45.0 50 5 5)
(f3: 1600 740.0 50 5 5)
(b3: 150 75.0 50 5 5)
(fnz: 270 135.0 50 0 0)
(a2f: 49 24.5 50 5 5)
(a3f: 49 24.5 50 5 5)
(a4f: -16 7.0 50 5 5)
(a5f: -16 -8.0 50 5 5)
(a6f: -16 -8.0 50 5 5)
(bypass: -16 -8.0 50 5 5)
(b2f: 90 45.0 50 5 5)
(b3f: 150 75.0 50 5 5)
(anv: -16 0.0 100 5 5)
(a1v: 56 28.0 50 5 5)
(a2v: 49 24.5 50 5 5)
(a3v: 49 24.5 50 5 5)
(a4v: -16 7.0 50 5 5))!
----- Method: KlattSegmentSet>>rx (in category 'default segments') -----
rx
^ self segmentFromArray:
"name rank duration features"
#(rx 10 10 (rzd )
"selector steady fixed prop extern intern"
(voicing: 50 25.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 490 0.0 100 0 5)
(b1: 60 30.0 50 0 5)
(f2: 1180 0.0 100 0 5)
(b2: 90 45.0 50 5 5)
(f3: 1600 1600.0 0 5 5)
(b3: 70 35.0 50 5 5)
(fnz: 270 135.0 50 0 0)
(a2f: 49 24.5 50 5 5)
(a3f: 49 24.5 50 5 5)
(a4f: -16 7.0 50 5 5)
(a5f: -16 -8.0 50 5 5)
(a6f: -16 -8.0 50 5 5)
(bypass: -16 -8.0 50 5 5)
(b2f: 90 45.0 50 5 5)
(b3f: 70 35.0 50 5 5)
(anv: -16 0.0 100 5 5)
(a1v: 56 28.0 50 5 5)
(a2v: 49 24.5 50 5 5)
(a3v: 49 24.5 50 5 5)
(a4v: -16 7.0 50 5 5))!
----- Method: KlattSegmentSet>>s (in category 'default segments') -----
s
^ self segmentFromArray:
"name rank duration features"
#(s 18 12 (alv frc vls )
"selector steady fixed prop extern intern"
(voicing: 0 0.0 50 0 0)
(aspiration: 32 16.0 50 0 0)
(friction: 60 30.0 50 0 0)
(f1: 400 170.0 50 3 2)
(b1: 200 100.0 50 3 2)
(f2: 1720 950.0 50 3 2)
(b2: 96 48.0 50 3 2)
(f3: 2620 0.0 100 3 2)
(b3: 220 0.0 100 3 2)
(fnz: 270 135.0 50 0 0)
(a2f: 42 0.0 100 0 0)
(a3f: 42 0.0 100 0 0)
(a4f: 54.25 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 96 48.0 50 3 2)
(b3f: 220 0.0 100 3 2)
(anv: -16 0.0 100 0 0)
(a1v: -16 0.0 100 0 0)
(a2v: 42 0.0 100 0 0)
(a3v: 42 0.0 100 0 0)
(a4v: 54.25 0.0 100 0 0))!
----- Method: KlattSegmentSet>>segmentFromArray: (in category 'segments creation') -----
segmentFromArray: anArray
| answer |
answer := KlattSegment new.
#(name: rank: duration: features:)
doWithIndex: [ :each :index | answer perform: each with: (anArray at: index)].
5 to: anArray size do: [ :each | answer addParameter: (self parameterFromArray: (anArray at: each))].
^ answer!
----- Method: KlattSegmentSet>>segments (in category 'accessing') -----
segments
^ segments!
----- Method: KlattSegmentSet>>segments: (in category 'accessing-private') -----
segments: aDictionary
segments := aDictionary!
----- Method: KlattSegmentSet>>sh (in category 'default segments') -----
sh
^ self segmentFromArray:
"name rank duration features"
#(sh 18 12 (frc pla vls )
"selector steady fixed prop extern intern"
(voicing: 0 0.0 50 0 0)
(aspiration: 60 30.0 50 0 0)
(friction: 60 30.0 50 0 0)
(f1: 400 170.0 50 3 2)
(b1: 60 30.0 50 3 2)
(f2: 2200 1190.0 50 3 2)
(b2: 90 45.0 50 3 2)
(f3: 2560 0.0 100 3 2)
(b3: 150 0.0 100 3 2)
(fnz: 270 135.0 50 0 0)
(a2f: 45.5 0.0 100 0 0)
(a3f: 56 0.0 100 0 0)
(a4f: 45.5 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 3 2)
(b3f: 150 0.0 100 3 2)
(anv: -16 0.0 100 0 0)
(a1v: -16 0.0 100 0 0)
(a2v: 45.5 0.0 100 0 0)
(a3v: 56 0.0 100 0 0)
(a4v: 45.5 0.0 100 0 0))!
----- Method: KlattSegmentSet>>silence (in category 'accessing') -----
silence
self phonemes do: [ :each | each isSilence ifTrue: [^ self at: each]].
self error: 'silence segment not found'!
----- Method: KlattSegmentSet>>t (in category 'default segments') -----
t
^ self segmentFromArray:
"name rank duration features"
#(t 23 6 (alv stp vls )
"selector steady fixed prop extern intern"
(voicing: 0 0.0 50 0 0)
(aspiration: 60 30.0 50 0 0)
(friction: 60 30.0 50 0 0)
(f1: 190 110.0 50 2 2)
(b1: 60 30.0 50 2 2)
(f2: 1780 950.0 50 2 2)
(b2: 90 45.0 50 2 2)
(f3: 2680 2680.0 0 0 2)
(b3: 150 150.0 0 0 2)
(fnz: 270 135.0 50 0 0)
(a2f: -16 0.0 100 0 0)
(a3f: -16 0.0 100 0 0)
(a4f: -16 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 2 2)
(b3f: 150 150.0 0 0 2)
(anv: -16 0.0 100 0 0)
(a1v: -16 0.0 100 0 0)
(a2v: -16 0.0 100 0 0)
(a3v: -16 0.0 100 0 0)
(a4v: -16 0.0 100 0 0))!
----- Method: KlattSegmentSet>>th (in category 'default segments') -----
th
^ self segmentFromArray:
"name rank duration features"
#(th 18 15 (dnt frc vls )
"selector steady fixed prop extern intern"
(voicing: 0 0.0 50 0 0)
(aspiration: 60 30.0 50 0 0)
(friction: 60 30.0 50 0 0)
(f1: 400 170.0 50 3 2)
(b1: 60 30.0 50 3 2)
(f2: 1780 1190.0 50 3 2)
(b2: 90 45.0 50 3 2)
(f3: 2680 2680.0 0 3 2)
(b3: 150 150.0 0 3 2)
(fnz: 270 135.0 50 0 0)
(a2f: 40.25 0.0 100 0 0)
(a3f: 42 0.0 100 0 0)
(a4f: 36.75 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 3 2)
(b3f: 150 150.0 0 3 2)
(anv: -16 0.0 100 0 0)
(a1v: -16 0.0 100 0 0)
(a2v: 40.25 0.0 100 0 0)
(a3v: 42 0.0 100 0 0)
(a4v: 36.75 0.0 100 0 0))!
----- Method: KlattSegmentSet>>ty (in category 'default segments') -----
ty
^ self segmentFromArray:
"name rank duration features"
#(ty 29 1 (alv stp vls )
"selector steady fixed prop extern intern"
(voicing: 0 0.0 50 0 0)
(aspiration: 60 30.0 50 0 0)
(friction: 60 30.0 50 0 0)
(f1: 190 0.0 100 0 0)
(b1: 60 0.0 100 0 0)
(f2: 1780 0.0 100 0 0)
(b2: 90 0.0 100 0 0)
(f3: 2680 0.0 100 0 0)
(b3: 150 0.0 100 0 0)
(fnz: 270 135.0 50 0 0)
(a2f: -16 0.0 100 0 0)
(a3f: 52.5 0.0 100 0 0)
(a4f: 64.75 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 0.0 100 0 0)
(b3f: 150 0.0 100 0 0)
(anv: -16 0.0 100 0 0)
(a1v: -16 0.0 100 0 0)
(a2v: -16 0.0 100 0 0)
(a3v: 52.5 0.0 100 0 0)
(a4v: 64.75 0.0 100 0 0))!
----- Method: KlattSegmentSet>>tz (in category 'default segments') -----
tz
^ self segmentFromArray:
"name rank duration features"
#(tz 23 2 (alv stp vls )
"selector steady fixed prop extern intern"
(voicing: 0 0.0 50 0 0)
(aspiration: 60 30.0 50 0 0)
(friction: 60 30.0 50 0 0)
(f1: 190 110.0 50 2 1)
(b1: 60 30.0 50 2 1)
(f2: 1780 950.0 50 2 1)
(b2: 90 45.0 50 2 1)
(f3: 2680 2680.0 0 2 0)
(b3: 150 150.0 0 2 0)
(fnz: 270 135.0 50 0 0)
(a2f: -16 0.0 100 0 0)
(a3f: 42 0.0 100 0 0)
(a4f: 54.25 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 2 1)
(b3f: 150 150.0 0 2 0)
(anv: -16 0.0 100 0 0)
(a1v: -16 0.0 100 0 0)
(a2v: -16 0.0 100 0 0)
(a3v: 42 0.0 100 0 0)
(a4v: 54.25 0.0 100 0 0))!
----- Method: KlattSegmentSet>>u (in category 'default segments') -----
u
^ self segmentFromArray:
"name rank duration features"
#(u 2 6 (bck lmd unr vwl )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 700 350.0 50 4 4)
(b1: 60 30.0 50 4 4)
(f2: 1360 710.0 50 4 4)
(b2: 90 45.0 50 4 4)
(f3: 2500 1220.0 50 4 4)
(b3: 150 75.0 50 4 4)
(fnz: 270 135.0 50 0 0)
(a2f: 57.75 28.0 50 4 4)
(a3f: 45.5 21.0 50 4 4)
(a4f: 38.5 17.5 50 4 4)
(a5f: -16 -8.0 50 4 4)
(a6f: -16 -8.0 50 4 4)
(bypass: -16 -8.0 50 4 4)
(b2f: 90 45.0 50 4 4)
(b3f: 150 75.0 50 4 4)
(anv: -16 0.0 100 4 4)
(a1v: 64.75 31.5 50 4 4)
(a2v: 57.75 28.0 50 4 4)
(a3v: 45.5 21.0 50 4 4)
(a4v: 38.5 17.5 50 4 4))!
----- Method: KlattSegmentSet>>uu (in category 'default segments') -----
uu
^ self segmentFromArray:
"name rank duration features"
#(uu 2 9 (bck hgh rnd vwl )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 250 110.0 50 4 4)
(b1: 60 30.0 50 4 4)
(f2: 880 470.0 50 4 4)
(b2: 90 45.0 50 4 4)
(f3: 2200 1100.0 50 4 4)
(b3: 150 75.0 50 4 4)
(fnz: 270 135.0 50 0 0)
(a2f: 52.5 24.5 50 4 4)
(a3f: 31.5 14.0 50 4 4)
(a4f: 24.5 10.5 50 4 4)
(a5f: -16 -8.0 50 4 4)
(a6f: -16 -8.0 50 4 4)
(bypass: -16 -8.0 50 4 4)
(b2f: 90 45.0 50 4 4)
(b3f: 150 75.0 50 4 4)
(anv: -16 0.0 100 4 4)
(a1v: 64.75 31.5 50 4 4)
(a2v: 52.5 24.5 50 4 4)
(a3v: 31.5 14.0 50 4 4)
(a4v: 24.5 10.5 50 4 4))!
----- Method: KlattSegmentSet>>v (in category 'default segments') -----
v
^ self segmentFromArray:
"name rank duration features"
#(v 20 4 (frc lbd vcd )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 280 170.0 50 3 2)
(b1: 60 30.0 50 3 2)
(f2: 1420 350.0 50 3 2)
(b2: 90 45.0 50 3 2)
(f3: 2560 980.0 50 3 2)
(b3: 150 75.0 50 3 2)
(fnz: 270 135.0 50 0 0)
(a2f: 54.25 0.0 100 0 0)
(a3f: 50.75 0.0 100 0 0)
(a4f: 47.25 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 3 2)
(b3f: 150 75.0 50 3 2)
(anv: -16 0.0 100 0 0)
(a1v: 43.75 0.0 100 0 0)
(a2v: 54.25 0.0 100 0 0)
(a3v: 50.75 0.0 100 0 0)
(a4v: 47.25 0.0 100 0 0))!
----- Method: KlattSegmentSet>>w (in category 'default segments') -----
w
^ self segmentFromArray:
"name rank duration features"
#(w 10 8 (apr lbv vcd )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 190 50.0 50 4 4)
(b1: 60 30.0 50 4 4)
(f2: 760 350.0 50 4 4)
(b2: 90 45.0 50 4 4)
(f3: 2020 980.0 50 4 4)
(b3: 150 75.0 50 4 4)
(fnz: 270 135.0 50 0 0)
(a2f: 42 21.0 50 4 4)
(a3f: 35 17.5 50 4 4)
(a4f: -16 7.0 50 4 4)
(a5f: -16 -8.0 50 4 4)
(a6f: -16 -8.0 50 4 4)
(bypass: -16 -8.0 50 4 4)
(b2f: 90 45.0 50 4 4)
(b3f: 150 75.0 50 4 4)
(anv: -16 0.0 100 4 4)
(a1v: 57.75 28.0 50 4 4)
(a2v: 42 21.0 50 4 4)
(a3v: 35 17.5 50 4 4)
(a4v: -16 7.0 50 4 4))!
----- Method: KlattSegmentSet>>x (in category 'default segments') -----
x
^ self segmentFromArray:
"name rank duration features"
#(x 18 12 (frc vel vls )
"selector steady fixed prop extern intern"
(voicing: 0 0.0 50 0 0)
(aspiration: 60 30.0 50 0 0)
(friction: 60 30.0 50 0 0)
(f1: 190 110.0 50 3 3)
(b1: 60 30.0 50 3 3)
(f2: 1480 1550.0 50 3 3)
(b2: 90 45.0 50 3 3)
(f3: 2620 1580.0 50 3 3)
(b3: 150 75.0 50 3 3)
(fnz: 270 135.0 50 0 0)
(a2f: 54.25 0.0 100 0 0)
(a3f: 54.25 0.0 100 0 0)
(a4f: 33.25 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 3 3)
(b3f: 150 75.0 50 3 3)
(anv: -16 0.0 100 0 0)
(a1v: -16 0.0 100 0 0)
(a2v: 54.25 0.0 100 0 0)
(a3v: 54.25 0.0 100 0 0)
(a4v: 33.25 0.0 100 0 0))!
----- Method: KlattSegmentSet>>y (in category 'default segments') -----
y
^ self segmentFromArray:
"name rank duration features"
#(y 10 7 (apr pal vcd )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 250 110.0 50 4 4)
(b1: 60 30.0 50 4 4)
(f2: 2500 1190.0 50 4 4)
(b2: 90 45.0 50 4 4)
(f3: 2980 1460.0 50 4 4)
(b3: 150 75.0 50 4 4)
(fnz: 270 135.0 50 0 0)
(a2f: 47.25 24.5 50 4 4)
(a3f: 52.5 24.5 50 4 4)
(a4f: 45.5 21.0 50 4 4)
(a5f: -16 -8.0 50 4 4)
(a6f: -16 -8.0 50 4 4)
(bypass: -16 -8.0 50 4 4)
(b2f: 90 45.0 50 4 4)
(b3f: 150 75.0 50 4 4)
(anv: -16 0.0 100 4 4)
(a1v: 64.75 31.5 50 4 4)
(a2v: 47.25 24.5 50 4 4)
(a3v: 52.5 24.5 50 4 4)
(a4v: 45.5 21.0 50 4 4))!
----- Method: KlattSegmentSet>>z (in category 'default segments') -----
z
^ self segmentFromArray:
"name rank duration features"
#(z 20 4 (alv frc vcd )
"selector steady fixed prop extern intern"
(voicing: 40 20.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 60 30.0 50 0 0)
(f1: 280 170.0 50 3 2)
(b1: 60 30.0 50 3 2)
(f2: 1720 950.0 50 3 2)
(b2: 90 45.0 50 3 2)
(f3: 2560 0.0 100 3 2)
(b3: 150 0.0 100 3 2)
(fnz: 270 135.0 50 0 0)
(a2f: 38.5 0.0 100 0 0)
(a3f: 38.5 0.0 100 0 0)
(a4f: 50.75 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 3 2)
(b3f: 150 0.0 100 3 2)
(anv: -16 0.0 100 0 0)
(a1v: 43.75 0.0 100 0 0)
(a2v: 38.5 0.0 100 0 0)
(a3v: 38.5 0.0 100 0 0)
(a4v: 50.75 0.0 100 0 0))!
----- Method: KlattSegmentSet>>zh (in category 'default segments') -----
zh
^ self segmentFromArray:
"name rank duration features"
#(zh 20 4 (frc pla vcd )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 280 170.0 50 3 2)
(b1: 60 30.0 50 3 2)
(f2: 2020 1190.0 50 3 2)
(b2: 90 45.0 50 3 2)
(f3: 2560 0.0 100 3 2)
(b3: 150 0.0 100 3 2)
(fnz: 270 135.0 50 0 0)
(a2f: 40.25 0.0 100 0 0)
(a3f: 50.75 0.0 100 0 0)
(a4f: 40.25 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 3 2)
(b3f: 150 0.0 100 3 2)
(anv: -16 0.0 100 0 0)
(a1v: 43.75 0.0 100 0 0)
(a2v: 40.25 0.0 100 0 0)
(a3v: 50.75 0.0 100 0 0)
(a4v: 40.25 0.0 100 0 0))!
----- Method: KlattSegmentSet>>zz (in category 'default segments') -----
zz
^ self segmentFromArray:
"name rank duration features"
#(zz 20 4 (alv frc vcd )
"selector steady fixed prop extern intern"
(voicing: 62 31.0 50 0 0)
(aspiration: 0 0.0 50 0 0)
(friction: 0 0.0 50 0 0)
(f1: 280 170.0 50 3 2)
(b1: 60 30.0 50 3 2)
(f2: 1720 950.0 50 3 2)
(b2: 90 45.0 50 3 2)
(f3: 2560 0.0 100 3 2)
(b3: 150 0.0 100 3 2)
(fnz: 270 135.0 50 0 0)
(a2f: 38.5 0.0 100 0 0)
(a3f: 38.5 0.0 100 0 0)
(a4f: 50.75 0.0 100 0 0)
(a5f: -16 0.0 100 0 0)
(a6f: -16 0.0 100 0 0)
(bypass: -16 0.0 100 0 0)
(b2f: 90 45.0 50 3 2)
(b3f: 150 0.0 100 3 2)
(anv: -16 0.0 100 0 0)
(a1v: 43.75 0.0 100 0 0)
(a2v: 38.5 0.0 100 0 0)
(a3v: 38.5 0.0 100 0 0)
(a4v: 50.75 0.0 100 0 0))!
Object subclass: #KlattSynthesizer
instanceVariableNames: 'resonators frame pitch t0 nper nopen nmod a1 a2 x1 x2 b1 c1 glast vlast nlast periodCount samplesCount seed cascade samplesPerFrame samplingRate'
classVariableNames: 'Epsilon'
poolDictionaries: 'KlattResonatorIndices'
category: 'Speech-Klatt'!
!KlattSynthesizer commentStamp: '<historical>' prior: 0!
My instances are Klatt-style cascade/parallel formant synthesizers, first described by Dennis Klatt in [1]. An updated version of the model was described in [2]. This version implements the LF (Liljencrants-Fant) glottal pulse model from [3], and the jitter and shimmer parameters suggested in [4]. For a description of the Klatt parameters, see KlattFrame.
References:
[1] Klatt,D.H. "Software for a cascade/parallel formant synthesizer", in the Journal of the Acoustical Society of America, pages 971-995, volume 67, number 3, March 1980.
[2] Klatt,D.H. and Klatt, L.C. "Analysis, synthesis and perception of voice quality variations among female and male talkers". In the Journal of the Acoustical Society of America, pages 820-857, volume 87, number 2. February 1990.
[3] Fant, G., Liljencrants, J., & Lin, Q. "A four-parameter model of glottal flow", Speech Transmission Laboratory Qurterly Progress Report 4/85, KTH.
[4] Alwan, A., Bangayan, P., Kreiman, J., and Long, C. "Time and Frequency Synthesis Parameters of Severely Pathological Voice Qualities."!
----- Method: KlattSynthesizer class>>initialize (in category 'class initialization') -----
initialize
"
KlattSynthesizer initialize
"
Epsilon := 1.0e-04.
!
----- Method: KlattSynthesizer>>antiResonator:frequency:bandwidth: (in category 'accessing-resonators') -----
antiResonator: index frequency: freq bandwidth: bw
"Set up an anti-resonator"
| arg r a b c |
arg := 0.0 - Float pi / samplingRate * bw.
r := arg exp.
c := 0.0 - (r * r).
arg := Float pi * 2.0 / samplingRate * freq.
b := r * arg cos * 2.0.
a := 1.0 - b - c.
a := 1.0 / a.
b := 0.0 - b * a.
c := 0.0 - c * a.
self resonatorA: index put: a.
self resonatorB: index put: b.
self resonatorC: index put: c!
----- Method: KlattSynthesizer>>antiResonator:value: (in category 'accessing-resonators') -----
antiResonator: index value: aFloat
| answer p1 |
answer := (self resonatorA: index) * aFloat
+ ((self resonatorB: index) * (p1 := self resonatorP1: index))
+ ((self resonatorC: index) * (self resonatorP2: index)).
self resonatorP2: index put: p1.
self resonatorP1: index put: aFloat.
^ answer!
----- Method: KlattSynthesizer>>cascade (in category 'accessing') -----
cascade
"Answer the number of formants in the cascade branch."
^ cascade!
----- Method: KlattSynthesizer>>cascade: (in category 'accessing') -----
cascade: anInteger
"Set the number of formants in the cascade branch."
cascade := anInteger!
----- Method: KlattSynthesizer>>defaultMillisecondsPerFrame (in category 'initialization') -----
defaultMillisecondsPerFrame
"Default is 10 milliseconds per frame."
^ 10!
----- Method: KlattSynthesizer>>initialize (in category 'initialization') -----
initialize
"Initialize the Klatt synthesizer."
"Seed for noise generation:"
seed := 17.
"Sampling rate and millseconds per frame:"
self samplingRate: 22025.
self millisecondsPerFrame: self defaultMillisecondsPerFrame.
"Number of formants in the cascade branch: (0 to 8)"
self cascade: 0!
----- Method: KlattSynthesizer>>initializeResonators (in category 'initialization') -----
initializeResonators
resonators := FloatArray new: 24 * 5 "24 resonators, 5 floats each"!
----- Method: KlattSynthesizer>>initializeState (in category 'initialization') -----
initializeState
self initializeResonators.
pitch := 110.0.
t0 := (samplingRate / pitch) asInteger.
nper := 0.
nopen := 0.
nmod := 0.
periodCount := 0.
samplesCount := 0.
vlast := 0.0.
glast := 0.0.
nlast := 0.0.
self ro: 0.25 ra: 0.01 rk: 0.25!
----- Method: KlattSynthesizer>>isAllParallel (in category 'testing') -----
isAllParallel
"Answer true if the receiver is not using the cascade branch."
^ self cascade = 0!
----- Method: KlattSynthesizer>>millisecondsPerFrame (in category 'accessing') -----
millisecondsPerFrame
^ 1000.0 / self samplingRate * self samplesPerFrame!
----- Method: KlattSynthesizer>>millisecondsPerFrame: (in category 'accessing') -----
millisecondsPerFrame: aNumber
self samplesPerFrame: (aNumber * self samplingRate / 1000) asInteger!
----- Method: KlattSynthesizer>>qu:phi:cosphi:sinphi:rphid: (in category 'processing-LF') -----
qu: u phi: phi cosphi: cosphi sinphi: sinphi rphid: rphid
| expuphi |
expuphi := (u * phi) exp.
^ expuphi * ((rphid * (u*u + 1.0) + u) * sinphi - cosphi) + 1.0!
----- Method: KlattSynthesizer>>resonator:frequency:bandwidth: (in category 'accessing-resonators') -----
resonator: index frequency: freq bandwidth: bw
"Convert formant frequencies and bandwidth into
resonator difference equation coefficients."
| arg r a b c |
arg := 0.0 - Float pi / samplingRate * bw.
r := arg exp.
c := 0.0 - (r * r).
arg := Float pi * 2.0 / samplingRate * freq.
b := r * arg cos * 2.0.
a := 1.0 - b - c.
self resonatorA: index put: a.
self resonatorB: index put: b.
self resonatorC: index put: c!
----- Method: KlattSynthesizer>>resonator:frequency:bandwidth:gain: (in category 'accessing-resonators') -----
resonator: index frequency: freq bandwidth: bw gain: gain
"Convert formant frequencies and bandwidth into
resonator difference equation coefficients."
self resonator: index frequency: freq bandwidth: bw.
self resonatorA: index put: (self resonatorA: index) * gain!
----- Method: KlattSynthesizer>>resonator:value: (in category 'accessing-resonators') -----
resonator: index value: aFloat
| answer p1 |
answer := (self resonatorA: index) * aFloat
+ ((self resonatorB: index) * (p1 := self resonatorP1: index))
+ ((self resonatorC: index) * (self resonatorP2: index)).
self resonatorP2: index put: p1.
self resonatorP1: index put: answer.
^ answer!
----- Method: KlattSynthesizer>>resonatorA: (in category 'accessing-resonators') -----
resonatorA: index
^resonators at: index * 5 - 4!
----- Method: KlattSynthesizer>>resonatorA:put: (in category 'accessing-resonators') -----
resonatorA: index put: aFloat
resonators at: index*5-4 put: aFloat!
----- Method: KlattSynthesizer>>resonatorB: (in category 'accessing-resonators') -----
resonatorB: index
^resonators at: index*5-3!
----- Method: KlattSynthesizer>>resonatorB:put: (in category 'accessing-resonators') -----
resonatorB: index put: aFloat
resonators at: index*5-3 put: aFloat!
----- Method: KlattSynthesizer>>resonatorC: (in category 'accessing-resonators') -----
resonatorC: index
^resonators at: index*5-2!
----- Method: KlattSynthesizer>>resonatorC:put: (in category 'accessing-resonators') -----
resonatorC: index put: aFloat
resonators at: index*5-2 put: aFloat!
----- Method: KlattSynthesizer>>resonatorP1: (in category 'accessing-resonators') -----
resonatorP1: index
^resonators at: index*5-1!
----- Method: KlattSynthesizer>>resonatorP1:put: (in category 'accessing-resonators') -----
resonatorP1: index put: aFloat
resonators at: index*5-1 put: aFloat!
----- Method: KlattSynthesizer>>resonatorP2: (in category 'accessing-resonators') -----
resonatorP2: index
^resonators at: index*5!
----- Method: KlattSynthesizer>>resonatorP2:put: (in category 'accessing-resonators') -----
resonatorP2: index put: aFloat
resonators at: index*5 put: aFloat!
----- Method: KlattSynthesizer>>ro:ra:rk: (in category 'processing-LF') -----
ro: roNumber ra: raNumber rk: rkNumber
| r d phi cosphi sinphi rphid u theta rho gamma gammapwr te ro ra rk |
te := (t0 * roNumber) asInteger.
ro := te asFloat / t0 asFloat.
rk := rkNumber.
ra := raNumber.
ra <= 0.0
ifTrue: [d := 1.0]
ifFalse: [r := 1.0 - ro / ra.
d := 1.0 - (r / (r exp - 1.0))].
phi := Float pi * (rk + 1.0).
cosphi := phi cos.
sinphi := phi sin.
rphid := ra / ro * phi * d.
u := self zeroQphi: phi cosphi: cosphi sinphi: sinphi rphid: rphid.
theta := phi / te.
rho := (u * theta) exp.
a1 := 2.0 * theta cos * rho.
a2 := 0.0 - (rho * rho).
x2 := 0.0.
x1 := rho * theta sin.
gamma := (-1.0 / (ra * t0)) exp.
gammapwr := gamma raisedTo: t0 - te.
b1 := gamma.
c1 := (1.0 - gamma) * gammapwr / (1.0 - gammapwr)!
----- Method: KlattSynthesizer>>samplesFromFrames: (in category 'processing') -----
samplesFromFrames: aCollection
| buffer index |
buffer := SoundBuffer newMonoSampleCount: aCollection size * samplesPerFrame.
index := 1.
aCollection do: [ :each |
self synthesizeFrame: each into: buffer startingAt: index.
index := samplesPerFrame + index].
^ buffer!
----- Method: KlattSynthesizer>>samplesPerFrame (in category 'accessing') -----
samplesPerFrame
^ samplesPerFrame!
----- Method: KlattSynthesizer>>samplesPerFrame: (in category 'accessing') -----
samplesPerFrame: anInteger
samplesPerFrame := anInteger!
----- Method: KlattSynthesizer>>samplingRate (in category 'accessing') -----
samplingRate
^ samplingRate!
----- Method: KlattSynthesizer>>samplingRate: (in category 'accessing') -----
samplingRate: anInteger
samplingRate := anInteger.
self initializeState!
----- Method: KlattSynthesizer>>soundFromFrames: (in category 'processing') -----
soundFromFrames: aCollection
^ SampledSound samples: (self samplesFromFrames: aCollection) samplingRate: samplingRate!
----- Method: KlattSynthesizer>>synthesizeFrame:into:startingAt: (in category 'processing') -----
synthesizeFrame: aKlattFrame into: aSoundBuffer startingAt: index
<primitive: 'primitiveSynthesizeFrameIntoStartingAt' module: 'Klatt'>
^(Smalltalk at: #KlattSynthesizerPlugin ifAbsent:[^self primitiveFail])
doPrimitive: 'primitiveSynthesizeFrameIntoStartingAt'!
----- Method: KlattSynthesizer>>zeroQphi:cosphi:sinphi:rphid: (in category 'processing-LF') -----
zeroQphi: phi cosphi: cosphi sinphi: sinphi rphid: rphid
| qzero ua ub qa qb uc qc |
qzero := self qu: 0 phi: phi cosphi: cosphi sinphi: sinphi rphid: rphid.
qzero > 0
ifTrue: [ua := 0. ub := 1.
qa := qzero. qb := self qu: ub phi: phi cosphi: cosphi sinphi: sinphi rphid: rphid.
[qb > 0]
whileTrue: [ua := ub. qa := qb.
ub := ub * 2. qb := self qu: ub phi: phi cosphi: cosphi sinphi: sinphi rphid: rphid]]
ifFalse: [ua := -1. ub := 0.
qa := self qu: ua phi: phi cosphi: cosphi sinphi: sinphi rphid: rphid. qb := qzero.
[qa < 0]
whileTrue: [ub := ua. qb := qa.
ua := ua * 2. qa := self qu: ua phi: phi cosphi: cosphi sinphi: sinphi rphid: rphid]].
[ub - ua > Epsilon]
whileTrue: [uc := ub + ua / 2. qc := self qu: uc phi: phi cosphi: cosphi sinphi: sinphi rphid: rphid.
qc > 0 ifTrue: [ua := uc. qa := qc] ifFalse: [ub := uc. qb := qc]].
^ ub + ua / 2!
Object subclass: #LiljencrantsFant
instanceVariableNames: 'ro ra rk a1 a2 x1 x2 b1 c1 n0 ne'
classVariableNames: 'Epsilon'
poolDictionaries: ''
category: 'Speech-Klatt'!
!LiljencrantsFant commentStamp: '<historical>' prior: 0!
This is the LF glottal-pulse model. Actually this is here only for pedagogical purposes. The LF model is again implemented in KlattSynthesizer (and as primitive in the KlattSynthesizerPluggin). For more details on the LF model see:
Fant, G., Liljencrants, J., & Lin, Q. "A four-parameter model of glottal flow", Speech Transmission Laboratory Qurterly Progress Report 4/85, KTH.
!
----- Method: LiljencrantsFant class>>initialize (in category 'initialize-release') -----
initialize
"
LiljencrantsFant initialize
"
Epsilon := 1.0e-04!
----- Method: LiljencrantsFant>>computeSamplesInto: (in category 'processing') -----
computeSamplesInto: aFloatArray
| s0 s1 s2 |
aFloatArray at: 1 put: x1.
s2 := x1.
aFloatArray at: 2 put: x2.
s1 := x2.
3 to: ne - 1 do: [ :each |
s0 := a1 * s1 + (a2 * s2).
aFloatArray at: each put: s0.
s2 := s1.
s1 := s0].
ne to: n0 do: [ :each | aFloatArray at: each put: b1 * (aFloatArray at: each - 1) - c1]!
----- Method: LiljencrantsFant>>d (in category 'processing') -----
d
| r |
ra <= 0.0 ifTrue: [^ 1.0].
r := 1.0 - ro / ra.
^ 1.0 - (r / (r exp - 1.0))!
----- Method: LiljencrantsFant>>example1 (in category 'processing') -----
example1
"
Utilities plot: LiljencrantsFant new example1
"
self t0: 1 / 133 * 4 ro: 0.25 rk: 0.25 ra: 0.01 samplingRate: 22025.
self init.
^ self samples!
----- Method: LiljencrantsFant>>init (in category 'processing') -----
init
| d phi cosphi sinphi rphid u theta rho gamma gammapwr |
d := self d.
phi := Float pi * (rk + 1.0).
cosphi := phi cos.
sinphi := phi sin.
rphid := ra / ro * phi * d.
u := self zeroQphi: phi cosphi: cosphi sinphi: sinphi rphid: rphid.
theta := phi / ne.
rho := (u * theta) exp.
a1 := 2.0 * theta cos * rho.
a2 := 0.0 - (rho * rho).
x1 := 0.0.
x2 := rho * theta sin.
gamma := (-1.0 / (ra * n0)) exp.
gammapwr := gamma raisedTo: n0 - ne.
b1 := gamma.
c1 := (1.0 - gamma) * gammapwr / (1.0 - gammapwr)!
----- Method: LiljencrantsFant>>n0: (in category 'accessing') -----
n0: anInteger
n0 := anInteger!
----- Method: LiljencrantsFant>>ne: (in category 'accessing') -----
ne: anInteger
ne := anInteger!
----- Method: LiljencrantsFant>>qu:phi:cosphi:sinphi:rphid: (in category 'processing') -----
qu: u phi: phi cosphi: cosphi sinphi: sinphi rphid: rphid
| expuphi |
expuphi := (u * phi) exp.
^ expuphi * ((rphid * (u*u + 1.0) + u) * sinphi - cosphi) + 1.0!
----- Method: LiljencrantsFant>>ra (in category 'accessing') -----
ra
^ ra!
----- Method: LiljencrantsFant>>ra: (in category 'accessing') -----
ra: aNumber
ra := aNumber!
----- Method: LiljencrantsFant>>rk (in category 'accessing') -----
rk
^ rk!
----- Method: LiljencrantsFant>>rk: (in category 'accessing') -----
rk: aNumber
rk := aNumber!
----- Method: LiljencrantsFant>>ro (in category 'accessing') -----
ro
^ ro!
----- Method: LiljencrantsFant>>ro: (in category 'accessing') -----
ro: aNumber
ro := aNumber!
----- Method: LiljencrantsFant>>samples (in category 'processing') -----
samples
| answer |
answer := FloatArray new: n0.
self computeSamplesInto: answer.
^ answer!
----- Method: LiljencrantsFant>>t0:ro:rk:ra:samplingRate: (in category 'processing') -----
t0: t0 ro: roNumber rk: rkNumber ra: raNumber samplingRate: samplingRate
| doubleN0 |
doubleN0 := samplingRate * t0.
n0 := doubleN0 asInteger.
ne := (doubleN0 * roNumber) asInteger.
ro := ne asFloat / n0 asFloat.
rk := rkNumber.
ra := raNumber!
----- Method: LiljencrantsFant>>t0:tp:te:ta:samplingRate: (in category 'processing') -----
t0: t0 tp: tp te: te ta: ta samplingRate: samplingRate
self t0: t0 ro: te / t0 rk: te - tp / tp ra: ta / t0 samplingRate: samplingRate!
----- Method: LiljencrantsFant>>zeroQphi:cosphi:sinphi:rphid: (in category 'processing') -----
zeroQphi: phi cosphi: cosphi sinphi: sinphi rphid: rphid
| qzero ua ub qa qb uc qc |
qzero := self qu: 0 phi: phi cosphi: cosphi sinphi: sinphi rphid: rphid.
qzero > 0
ifTrue: [ua := 0. ub := 1.
qa := qzero. qb := self qu: ub phi: phi cosphi: cosphi sinphi: sinphi rphid: rphid.
[qb > 0]
whileTrue: [ua := ub. qa := qb.
ub := ub * 2. qb := self qu: ub phi: phi cosphi: cosphi sinphi: sinphi rphid: rphid]]
ifFalse: [ua := -1. ub := 0.
qa := self qu: ua phi: phi cosphi: cosphi sinphi: sinphi rphid: rphid. qb := qzero.
[qa < 0]
whileTrue: [ub := ua. qb := qa.
ua := ua * 2. qa := self qu: ua phi: phi cosphi: cosphi sinphi: sinphi rphid: rphid]].
[ub - ua > Epsilon]
whileTrue: [uc := ub + ua / 2. qc := self qu: uc phi: phi cosphi: cosphi sinphi: sinphi rphid: rphid.
qc > 0 ifTrue: [ua := uc. qa := qc] ifFalse: [ub := uc. qb := qc]].
^ ub + ua / 2!
Object subclass: #PHOReader
instanceVariableNames: 'stream phonemes events pitches time'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Support'!
!PHOReader commentStamp: '<historical>' prior: 0!
My instances read PHO files with lines of the form 'phoneme duration time0 pitch0 time1 pitch1 ...'. Time is in milliseconds, and pitch is in hertz. Files on this format are used as inputs for the MBROLA synthesizer, and there are lots of them available on the web. Here's an example:
_ 120 0 105
m 60 33 105
E 70 42 102
r 50 20 108
I 50 20 125 100 142
k 100
r 50 80 137
I 50 80 121
s 70
m 50
@ 90 33 111 88 108
s 90
!
----- Method: PHOReader class>>aliceExample (in category 'examples') -----
aliceExample
| events |
events := self eventsFromString: self aliceExampleString.
events do: [ :each | each pitchBy: 0.63489].
^ events!
----- Method: PHOReader class>>aliceExampleFemale (in category 'examples') -----
aliceExampleFemale
| events |
events := self eventsFromString: self aliceExampleString.
events do: [ :each | each pitchBy: 1.3].
^ events!
----- Method: PHOReader class>>aliceExampleMale (in category 'examples') -----
aliceExampleMale
| events |
events := self eventsFromString: self aliceExampleString.
events do: [ :each | each pitchBy: 0.63489].
^ events!
----- Method: PHOReader class>>aliceExampleString (in category 'examples-private') -----
aliceExampleString
^ '_ 48 0 222
{ 80 40 222 90 235
l 72 44 250 66 250
I 80
s 88
w 40 80 235
@ 40 80 210
z 64 12 210 50 181 75 181
b 72 33 173 88 181
I 56 71 181
g 56 28 153 100 166
I 64 62 160
n 40 60 160
I 88 27 166
N 40 100 166
t 80 20 160
U 40 40 181 80 166
g 48 100 166
E 104 38 153 76 137
t 56
v 48
E 72 11 166 66 153
r 88 18 160 63 166
i 112.8 14 166 49 173 77 173
t 104.8 98 137
AI 178.4 21 148 70 148 92 137
r= 108 25 137 62 133 98 129
d 49
@ 59.2 6 137 73 133
v 46
s 89
I 40 40 173
t 40 40 166
I 64 62 166
N 72 22 160 77 153
b 40 40 142 100 153
AI 136 29 142
h 80 30 142 100 148
r= 64 62 153 100 153
s 125
I 64 37 210 100 190
s 72 11 190
t 72
r= 104 30 160 69 142
O 72
n 40 40 142
D 40 40 153
@ 40 40 160
b 40 40 153 100 160
{ 216 18 166 51 166 70 153 88 137 100 133
n 40
k 56
_ 144 94 129 100 100
_ 100 0 137
{ 40
n 88 9 137 36 137 72 142
t 40 40 137 60 133
@ 48 16 148 100 148
h 40 100 142
{ 48 83 148
v 48 16 142
I 56 14 148 85 137
N 56 71 137
n 64 37 137 100 142
O 96 41 137 83 153 100 153
T 64
I 56 42 166
N 64 12 160 75 153
t 80 30 142
@ 56 28 166 100 148
d 56 71 137
u 160 15 160 45 160 70 153 95 142
w 136 23 137 58 137 88 148
A 112 21 153 57 160 92 173
n 64 50 166 62 153
s 56
O 48 50 153
r 40 40 142 100 133
t 130
w 56 57 166
AI 168 9 173 33 166 57 153 80 148 100 148
s 88
_ 300
S 92
i 48 50 235
h 40 40 235 100 250
@ 40 60 210 100 210
d 40
p 40
i 150
k 56
d 56
I 72 44 222 100 210
n 40 80 210
t 56
@ 48 83 181
D 40 39 173 99 173
@ 39.2 100 160
b 104 30 153 100 153
U 112 35 153 85 153 100 153
k 72
h 56
r= 48 50 200
s 136 5 181
I 64 25 166 87 142
s 56 14 137
t 56
r= 56 28 173 100 173
w 56 71 166
@ 56 42 181
z 48 16 181 50 173
r 120 73 181
i 104 7 190 69 190 100 181
d 40
I 112 7 166 50 137 85 129
N 80 30 114 50 111
_ 56 83 111 100 100
_ 140 0 153
b 40 60 153 100 153
U 64 75 148
4 40 80 148 100 142
I 40
t 40 40 148
h 40 40 142
{ 48 33 137
d 136 5 133 11 129 88 148
n 48 66 148
@U 144 16 160 44 173 72 190 100 210
p 80
I 96 75 190 100 181
k 56
tS 96
r= 104 30 190 69 181
z 72 11 181 33 173
O 40 60 173
r 64 37 160 100 153
k 72 11 153
O 152 63 190 89 200
n 40 60 181
v 40 60 166
r= 40 60 160
s 104 15 142
EI 120 20 190 53 190 86 210
S 104 7 210
@ 56 28 181 100 160
n 64 62 153 100 137
z 40
I 56 14 148 85 133
n 40 100 133
I 96 41 129 83 125
t 80
_ 64 85 125 100 100
_ 140 0 222
{ 56 14 222 28 220 42 235 85 235 100 220
n 96 33 222 75 235 100 235
w 48 33 222 66 250
O 90
4 48 50 222 66 252
I 48 33 250
z 64 12 235 62 210
D 56
@ 56 71 190
j 104 23 166 61 166 100 181
u 112 35 190 42 210 71 210 100 210
s 150
@ 56 42 200
v 40 20 160 60 148
@ 64 25 153 87 142
b 136 23 133 47 137
U 96 8 160 50 173 91 181 100 181
k 56
_ 56
T 56
O 119.2 20 166 53 142 80 137
4 40 20 133
{ 136 5 137 35 129 64 125
l 48 16 125 100 133
I 80 50 153 100 181
s 120
_ 40
_ 40
w 88 9 166 54 142
I 40 40 142
D 40 40 137
aU 62.4 38 137 63 133
t 80
p 55
I 72 16 210 38 210
k 40
tS 75.2 99 173
r= 136 29 160 64 160 76 166
z 48
O 44 90 185
r 60 6 198 46 200 72 190
k 40
O 81.6 12 148 61 133
n 40 20 133
v 48 33 133
r= 56 28 181 100 181
s 120 6 173
EI 136 11 222 41 210 94 210
S 120
@ 128 12 190 43 148 75 137
n 64 12 129 50 125
_ 80 88 125 100 100'!
----- Method: PHOReader class>>aliceShortExample (in category 'examples') -----
aliceShortExample
| events |
events := self eventsFromString: self aliceShortExampleString.
events do: [ :each | each pitchBy: 1.3].
^ events!
----- Method: PHOReader class>>aliceShortExampleMale (in category 'examples') -----
aliceShortExampleMale
| events |
events := self eventsFromString: self aliceShortExampleString.
events do: [ :each | each pitchBy: 0.4].
^ events!
----- Method: PHOReader class>>aliceShortExampleString (in category 'examples-private') -----
aliceShortExampleString
^ '_ 48 0 222
{ 80 40 222 90 235
l 72 44 250 66 250
I 80
s 88
w 40 80 235
@ 40 80 210
z 64 12 210 50 181 75 181
b 72 33 173 88 181
I 56 71 181
g 56 28 153 100 166
I 64 62 160
n 40 60 160
I 88 27 166
N 40 100 166
t 80 20 160
U 40 40 181 80 166
g 48 100 166
E 104 38 153 76 137
t 56
v 48
E 72 11 166 66 153
r 88 18 160 63 166
i 112.8 14 166 49 173 77 173
t 104.8 98 137
AI 178.4 21 148 70 148 92 137
r= 108 25 137 62 133 98 129
d 49
@ 59.2 6 137 73 133
v 46
s 89
I 40 40 173
t 40 40 166
I 64 62 166
N 72 22 160 77 153
b 40 40 142 100 153
AI 136 29 142
h 80 30 142 100 148
@ 60 50 150
r= 64 62 153 100 153
s 125
I 64 37 210 100 190
s 72 11 190
t 72
r= 104 30 160 69 142
O 72
n 40 40 142
D 40 40 153
@ 40 40 160
b 40 40 153 100 160
{ 216 18 166 51 166 70 153 88 137 100 133
n 40
k 56
_ 144 94 129 100 100'!
----- Method: PHOReader class>>eventsFromStream: (in category 'instance creation') -----
eventsFromStream: aStream
^ self new stream: aStream; read; events!
----- Method: PHOReader class>>eventsFromString: (in category 'instance creation') -----
eventsFromString: aString
^ self eventsFromStream: (ReadStream on: aString)!
----- Method: PHOReader class>>mbrolaExample (in category 'examples') -----
mbrolaExample
^ self eventsFromString:
'_ 50
E 40 0 102
m 50
b 50
r 30
@U 80 5 119 35 126 70 140
l 50
@ 50 50 173
w 100 75 133
V 30 85 114
z 60 75 101
d 60
@ 40
v 40 85 105
E 60 75 121
l 50 70 121
@ 60 60 150
p 50
d 70
b 70 0 90
AI 130 85 101
T 70
j 50 0 180
E 120 0 185 95 131
r 40
i 90 85 135
d 80 60 134
@ 50 0 119 50 114
t 70
w 70 10 117 65 127 85 115
A 180 0 102 55 91 95 85
_ 100
_ 100
I 80 18 111
t 80
s 50
@ 30
s 70
p 80
i 80 25 171 85 200
tS 110
s 70
I 30 35 112
n 40
T 80
@ 40 85 108
s 80
AI 130 80 115
z 70 90 125
r= 120 75 111
b 80
EI 80 95 133
z 70
d 50
A 40
n 30
D 60
@ 30 65 121
k 90
A 30
n 30 100 140
k 80
{ 70 5 170
t 70
@ 40 50 186
n 40 75 163
EI 100 90 173
S 130
@ 40
n 30 65 153
V 40
v 70 0 148
d 60
AI 130 5 112 80 109
f 110
@U 160 87 88
n 70
z 210 88 82
_ 80
_ 100
I 40 0 140
t 50
t 100
EI 60 50 221
k 70
s 80
@ 30 0 190
l 50
I 30 65 180
s 110
t 70
V 50 20 171
v 50
f 90
@U 140 25 157
n 30
i 60 66 160
m 50 60 130
z 80
@ 40 62 78
z 80
I 70 78 134
n 50 70 163
p 120
U 90 15 119 75 98
t 90
_ 140
_ 100
t 60 0 111
u 50 80 119
g 70
E 50 90 145
D 50
r= 50 40 139 90 163
w 90
I 30 15 114
D 50
_ 40
p 50
r 30 0 102
@ 30 65 110
s 120
A 50 90 148
d 80
I 50 50 178
k 80
I 50 66 167
n 60
f 50
r= 50 90 125
m 50
EI 140 95 96
S 140
@ 80 35 168
n 100 95 142
_ 190
{ 90 0 133
n 30
d 30
p 80
r 40
@ 40 0 97 65 103
d 70
j 20
u 60 65 150
s 90
I 30 50 210
z 50
s 140
p 70
i 130 0 138 95 98
tS 160
{ 70 0 127
t 50
D 50
@ 30 15 93
s 140
{ 30 35 127
m 50
p 70
l 50
I 30 35 184
N 70
f 70
r 60
i 90 30 125
k 40
w 30
@ 30 15 185
n 30
s 100
i 50 20 148 70 142
V 30 5 148
v 40
D 80
@ 40 25 106
d 80
AI 150 95 115
f 90
@U 130 95 114
n 70
d 80
EI 80 80 137
4 50
@ 30
b 100
EI 120 95 78
s 210
_ 80'!
----- Method: PHOReader class>>plotPitchFromStream: (in category 'instance creation') -----
plotPitchFromStream: aStream
^ self new stream: aStream; read; plotPitch!
----- Method: PHOReader class>>plotPitchFromString: (in category 'instance creation') -----
plotPitchFromString: aString
^ self plotPitchFromStream: (ReadStream on: aString)!
----- Method: PHOReader class>>pushExample (in category 'examples') -----
pushExample
^ self eventsFromString:
'_ 60 0 137
p 50 100 137
u 110 90 137
S 100 10 121
D 90
@ 70 57 114 100 102
s 70
t 50
A 100 57 121 64 121
r 40
t 50
b 110
V 140 21 117 57 100 92 100
_ 3
n 130 25 102 50 105
t 60
u 70 28 129 71 111
b 70
i 70 50 102
g 20 10 100 80 102
i 130 25 117 66 114
n 260 3 111 23 105 42 97 61 93 73 93
_ 140 92 93 100 100'!
----- Method: PHOReader class>>pushExampleFemale (in category 'examples') -----
pushExampleFemale
| events |
events := self pushExample.
events do: [ :each | each pitchBy: 1.93489].
^ events!
----- Method: PHOReader class>>pushShortExample (in category 'examples') -----
pushShortExample
^ self eventsFromString:
'i 70 50 102
g 20 10 100 80 102
i 130 25 117 66 114
n 260 3 111 23 105 42 97 61 93 73 93'.
"
':= 3
n 130 25 102 50 105
t 60
u 70 28 129 71 111
b 70
i 70 50 102
g 20 10 100 80 102
i 130 25 117 66 114
n 260 3 111 23 105 42 97 61 93 73 93
:= 140 92 93 100 100'"!
----- Method: PHOReader class>>xmasExample (in category 'examples') -----
xmasExample
^ self eventsFromString:
'_ 120 0 105
m 60 33 105
E 70 42 102
r 50 20 108
I 50 20 125 100 142
k 100
r 50 80 137
I 50 80 121
s 70
m 50
@ 90 33 111 88 108
s 90
{ 70
n 100 50 105 100 97
d 50 80 93
h 50 20 93
{ 50 20 102 60 114
p 50
i 50 100 125
n 60 83 121
u 100
j 130 7 121 23 121 100 108
r= 250 41 102 83 97
_ 210 95 86 100 100'
!
----- Method: PHOReader class>>xmasKidExample (in category 'examples') -----
xmasKidExample
| events |
events := self xmasExample.
events do: [ :each | each pitchBy: 1.6].
^ events!
----- Method: PHOReader>>addPitches (in category 'accessing') -----
addPitches
| offset |
offset := 0.0.
events do: [ :each |
each pitchPoints: (self pitchesBetween: offset and: offset + each duration).
offset := offset + each duration].!
----- Method: PHOReader>>events (in category 'accessing') -----
events
^ CompositeEvent new addAll: events; yourself!
----- Method: PHOReader>>initialize (in category 'initialization') -----
initialize
events := OrderedCollection new.
pitches := OrderedCollection new.
time := 0.0.
phonemes := PhonemeSet sampaToArpabet!
----- Method: PHOReader>>nextEvent (in category 'accessing') -----
nextEvent
| line phonemeName phoneme duration answer ptime pitch |
line := ReadStream on: stream nextLine.
phonemeName := line upTo: Character space.
phoneme := phonemes at: phonemeName.
[line peek isSeparator] whileTrue: [line next].
duration := (line upTo: Character space) asNumber / 1000.0.
answer := PhoneticEvent new phoneme: phoneme; duration: duration; loudness: 1.0.
[line atEnd]
whileFalse: [ptime := (line upTo: Character space) asNumber * duration / 100.0.
pitch := (line upTo: Character space) asNumber asFloat.
pitches add: time + ptime @ pitch].
time := time + duration.
^ answer!
----- Method: PHOReader>>pitchAt: (in category 'accessing') -----
pitchAt: t
"Answer the pitch of the receiver at a given time. (Do linear interpolation.)"
| xVal count x1 x2 y1 y2 |
xVal := pitches first x.
count := 1.
[xVal < t]
whileTrue: [count := count + 1.
count > pitches size ifTrue: [^ pitches last y].
xVal := (pitches at: count) x].
xVal = t ifTrue: [^ (pitches at: count) y].
count = 1 ifTrue: [^ pitches first y].
x1 := (pitches at: count - 1) x.
x2 := (pitches at: count) x.
y1 := (pitches at: count - 1) y.
y2 := (pitches at: count) y.
^ (t - x1) / (x2 - x1) * (y2 - y1) + y1!
----- Method: PHOReader>>pitchesBetween:and: (in category 'accessing') -----
pitchesBetween: t1 and: t2
| step |
step := (t2 - t1 / 0.035) asInteger + 1. "step small enough"
^ (t1 to: t2 by: t2 - t1 / step) collect: [ :each | each - t1 @ (self pitchAt: each)]!
----- Method: PHOReader>>plotPitch (in category 'accessing') -----
plotPitch
Utilities plot: ((0 to: time by: 0.050) collect: [ :each | self pitchAt: each])!
----- Method: PHOReader>>read (in category 'accessing') -----
read
stream reset.
[stream atEnd] whileFalse: [events add: self nextEvent].
self addPitches!
----- Method: PHOReader>>stream: (in category 'accessing') -----
stream: aStream
stream := aStream!
Object subclass: #Phoneme
instanceVariableNames: 'name properties'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Phonetics'!
!Phoneme commentStamp: '<historical>' prior: 0!
My instances are phonemes. See also PhonemeSet class.!
----- Method: Phoneme class>>name: (in category 'instance creation') -----
name: aString
^ self new name: aString!
----- Method: Phoneme class>>name:example: (in category 'instance creation') -----
name: aString example: anotherString
^ self new name: aString; example: anotherString!
----- Method: Phoneme class>>name:example:features: (in category 'instance creation') -----
name: aString example: anotherString features: anArray
| answer |
answer := self new name: aString; example: anotherString.
anArray do: [ :each | answer addProperty: each].
^ answer!
----- Method: Phoneme>>= (in category 'comparing') -----
= aPhoneme
^ self species == aPhoneme species and: [self name = aPhoneme name]!
----- Method: Phoneme>>addProperty: (in category 'properties') -----
addProperty: anObject
self at: anObject put: #nothing!
----- Method: Phoneme>>at: (in category 'properties') -----
at: anObject
^ properties at: anObject!
----- Method: Phoneme>>at:ifAbsent: (in category 'properties') -----
at: anObject ifAbsent: aBlock
properties isNil ifFalse: [^ properties at: anObject ifAbsent: aBlock].
^ aBlock value!
----- Method: Phoneme>>at:put: (in category 'properties') -----
at: anObject put: anotherObject
properties isNil ifTrue: [properties := IdentityDictionary new].
^ properties at: anObject put: anotherObject!
----- Method: Phoneme>>copy (in category 'copying') -----
copy
^ super copy properties: properties copy!
----- Method: Phoneme>>example (in category 'accessing') -----
example
^ self at: #example ifAbsent: []!
----- Method: Phoneme>>example: (in category 'accessing') -----
example: aString
self at: #example put: aString!
----- Method: Phoneme>>hasFeature: (in category 'testing') -----
hasFeature: aSymbol
^ self hasProperty: aSymbol!
----- Method: Phoneme>>hasProperty: (in category 'properties') -----
hasProperty: anObject
^ properties notNil and: [properties includesKey: anObject]!
----- Method: Phoneme>>hash (in category 'comparing') -----
hash
^ self name hash!
----- Method: Phoneme>>isAffricate (in category 'testing') -----
isAffricate
"Answer true if the receiver is an affricate phoneme."
^ self hasFeature: #affricate!
----- Method: Phoneme>>isBackVowel (in category 'testing') -----
isBackVowel
"Answer true if the receiver is a back vowel phoneme."
^ self isVowel and: [self hasFeature: #back]!
----- Method: Phoneme>>isConsonant (in category 'testing') -----
isConsonant
"Answer true if the receiver is a consonant phoneme."
^ self hasFeature: #consonant!
----- Method: Phoneme>>isContinuant (in category 'testing') -----
isContinuant
"Answer true if the receiver is a continuant phoneme."
^ self hasFeature: #continuant!
----- Method: Phoneme>>isDiphthong (in category 'testing') -----
isDiphthong
"Answer true if the receiver is a diphthong phoneme."
^ self hasFeature: #diphthong!
----- Method: Phoneme>>isFricative (in category 'testing') -----
isFricative
"Answer true if the receiver is a fricative phoneme."
^ self hasFeature: #fricative!
----- Method: Phoneme>>isFrontVowel (in category 'testing') -----
isFrontVowel
"Answer true if the receiver is a front vowel phoneme."
^ self isVowel and: [self hasFeature: #front]!
----- Method: Phoneme>>isGlide (in category 'testing') -----
isGlide
"Answer true if the receiver is a glide phoneme."
^ self hasFeature: #glide!
----- Method: Phoneme>>isLiquid (in category 'testing') -----
isLiquid
"Answer true if the receiver is a liquid phoneme."
^ self hasFeature: #liquid!
----- Method: Phoneme>>isMidVowel (in category 'testing') -----
isMidVowel
"Answer true if the receiver is a mid vowel phoneme."
^ self isVowel and: [self hasFeature: #mid]!
----- Method: Phoneme>>isNasal (in category 'testing') -----
isNasal
"Answer true if the receiver is an nasal phoneme."
^ self hasFeature: #nasal!
----- Method: Phoneme>>isNonContinuant (in category 'testing') -----
isNonContinuant
"Answer true if the receiver is a noncontinuant phoneme."
^ self isContinuant not!
----- Method: Phoneme>>isObstruent (in category 'testing') -----
isObstruent
"Answer true if the receiver is an obstruent phoneme."
^ self isStop or: [self isFricative or: [self isAffricate]]!
----- Method: Phoneme>>isSemivowel (in category 'testing') -----
isSemivowel
"Answer true if the receiver is a semivowel phoneme."
^ self hasFeature: #semivowel!
----- Method: Phoneme>>isSilence (in category 'testing') -----
isSilence
"Answer true if the receiver is the silence phoneme."
^ self hasFeature: #silence!
----- Method: Phoneme>>isSonorant (in category 'testing') -----
isSonorant
"Answer true if the receiver is a sonorant phoneme."
^ self isObstruent not!
----- Method: Phoneme>>isStop (in category 'testing') -----
isStop
"Answer true if the receiver is a stop phoneme."
^ self hasFeature: #stop!
----- Method: Phoneme>>isSyllabic (in category 'testing') -----
isSyllabic
"Answer true if the receiver is a syllabic consonant (or a vowel)."
^ self isVowel or: [self isDiphthong]!
----- Method: Phoneme>>isUnvoiced (in category 'testing') -----
isUnvoiced
"Answer true if the receiver is an uvoiced phoneme."
^ self hasFeature: #unvoiced!
----- Method: Phoneme>>isVoiced (in category 'testing') -----
isVoiced
"Answer true if the receiver is a voiced phoneme."
^ self hasFeature: #voiced!
----- Method: Phoneme>>isVoicedConsonant (in category 'testing') -----
isVoicedConsonant
"Answer true if the receiver is a voiced consonant."
^ self isVoiced and: [self isConsonant]!
----- Method: Phoneme>>isVowel (in category 'testing') -----
isVowel
"Answer true if the receiver is a vowel phoneme."
^ self hasFeature: #vowel!
----- Method: Phoneme>>isWhisper (in category 'testing') -----
isWhisper
"Answer true if the receiver is an whisper phoneme."
^ self hasFeature: #whisper!
----- Method: Phoneme>>name (in category 'accessing') -----
name
^ name!
----- Method: Phoneme>>name: (in category 'accessing') -----
name: aString
name := aString!
----- Method: Phoneme>>printOn: (in category 'printing') -----
printOn: aStream
name isNil ifTrue: [^ super printOn: aStream].
aStream nextPutAll: name.
self stress > 0 ifTrue: [aStream print: self stress]!
----- Method: Phoneme>>properties (in category 'properties') -----
properties
^ properties!
----- Method: Phoneme>>properties: (in category 'properties') -----
properties: anIdentityDictionary
properties := anIdentityDictionary!
----- Method: Phoneme>>stress (in category 'accessing') -----
stress
"Answer the stress level of the receiver."
^ self at: #stress ifAbsent: [0]!
----- Method: Phoneme>>stress: (in category 'accessing') -----
stress: aNumber
"Set the stress level of the receiver."
self at: #stress put: aNumber!
----- Method: Phoneme>>stressed: (in category 'transforming') -----
stressed: aNumber
^ self copy stress: aNumber!
Object subclass: #PhonemeRecognizer
instanceVariableNames: 'phonemeRecords silentPhoneme'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Phoneme Recognizer'!
!PhonemeRecognizer commentStamp: 'dd 2/18/2005 17:43' prior: 0!
I am experimental phoneme recognizer. My approach to phoneme recognition is fairly crude, but the goal is not full speech recognition, but merely a close enough approximation to drive the mouth of an animated character from speech input.
The phoneme recognizer has a collection of phoneme examples that were recorded in advance. Each of these phomemes has a "features vector" that describes that phoneme. Currently, feature vectors are basically a simplified version of the frequency spectrum measuring the sound energy in about two dozen frequency bands up to around 4000 Hz. The exact parameters are described in the class initialization method of PhonemeRecord and can be tweaked.
To do phoneme recognition, a short window of sound is analyzed via FFT, and its feature vector is extracted. This feature vector is then compared to the feature vectors of all phonemes in the example set. The phoneme that matches most closely is considered the currently sounding phoneme. This phoneme matching approach is similar to some of the earliest speech recognition work. However, current speech recognition software is generally driven by features derived from a linear predictive or vocal tract model of speech, rather than the raw spectrum data.!
----- Method: PhonemeRecognizer>>findMatchFor:samplingRate: (in category 'analysis') -----
findMatchFor: aSoundBuffer samplingRate: samplingRate
"Find the phoneme whose features most closesly match those of the given sound buffer."
| unknown bestMatch bestDistance d |
unknown := PhonemeRecord new
samples: aSoundBuffer samplingRate: samplingRate.
unknown peakLevel > 1500
ifTrue: [
unknown computeFeatures.
bestMatch := silentPhoneme.
bestDistance := SmallInteger maxVal.
phonemeRecords do: [:p |
d := p featureDistanceFrom: unknown features to: p features.
d < bestDistance ifTrue: [
bestMatch := p.
bestDistance := d]]]
ifFalse: [bestMatch := silentPhoneme].
^ bestMatch!
----- Method: PhonemeRecognizer>>findMatchesFor: (in category 'analysis') -----
findMatchesFor: aSampledSound
"Process a sampled sound and return a sequence of phoneme matches for that sound."
| out fftSize samplesPerInterval startIndex buf p |
out := OrderedCollection new: 1000.
fftSize := PhonemeRecord fftSize.
samplesPerInterval := aSampledSound samplingRate / 24.0.
1 to: (aSampledSound samples size - fftSize) + 1 by: samplesPerInterval do: [:i |
startIndex := i truncated.
buf := aSampledSound samples copyFrom: startIndex to: startIndex + fftSize - 1.
p := self findMatchFor: buf samplingRate: aSampledSound samplingRate.
out addLast: p.
].
^ out asArray.!
----- Method: PhonemeRecognizer>>initialize (in category 'initialize-release') -----
initialize
phonemeRecords := OrderedCollection new.
silentPhoneme := PhonemeRecord new initialize name: '...'.
!
----- Method: PhonemeRecognizer>>phonemes (in category 'accessing') -----
phonemes
"Answer all phonemes available in the phoneme set."
^ phonemeRecords !
----- Method: PhonemeRecognizer>>phonemes: (in category 'accessing') -----
phonemes: newPhonemes
"Replace the phoneme set with new phonemes."
phonemeRecords := newPhonemes !
----- Method: PhonemeRecognizer>>silentPhoneme (in category 'accessing') -----
silentPhoneme
"Answer a silent phoneme."
^ silentPhoneme!
Object subclass: #PhonemeRecord
instanceVariableNames: 'name mouthPosition samples samplingRate features'
classVariableNames: 'AverageFeatures CutoffFreq FFTSize FilterBandwidth HighFreqWeight'
poolDictionaries: ''
category: 'Speech-Phoneme Recognizer'!
!PhonemeRecord commentStamp: '<historical>' prior: 0!
I represent a single phoneme. I contain the phoneme's name and an integer that represents the mouth position associated with this phoneme. This integer can be used as an index to select the mouth shape for an animated character. I also contain a 'features vector' derived from an analysis of my sound; this 'features vector' is the basis of matching during phoneme recognition. I also retain the original sound from which the features were computed so that it can be re-analyzed to create a new feature vector when the analysis algorithm is changed.
!
----- Method: PhonemeRecord class>>fftSize (in category 'class initialization') -----
fftSize
"Answer the FFT size for frequency analysis. It must be a power of two."
^ FFTSize
!
----- Method: PhonemeRecord class>>initialize (in category 'class initialization') -----
initialize
"Initialize the parameter used to extract phoneme features. After changing these parameters, execute 'PhonemeRecord initialize'. The features vectors of any existing phoneme records will be cleared and recomputed as needed."
"PhonemeRecord initialize"
FFTSize := 512. "size of FFT for analysis; this must be a power of two"
CutoffFreq := 4000. "boundary between fine and coarse ranges"
FilterBandwidth := 160. "bandwidth of each frequency band in the fine range"
HighFreqWeight := 5. "weighting of energy above the cutoff frequency"
AverageFeatures := false.
"If AverageFeatures is true, then average features over the phoneme recording. Otherwise, extract features from the center of the recording."
"clear all cached feature vectors"
PhonemeRecord allInstancesDo: [:p | p clearFeatures].
!
----- Method: PhonemeRecord>>averageFeatures (in category 'feature analysis') -----
averageFeatures
"Compute the average features vector across my sound samples."
| startI endI featureVectors |
"skip the first and last bits"
startI := (samplingRate // 5).
endI := samples monoSampleCount - (samplingRate // 5).
endI - startI < FFTSize ifTrue: [^ self extractFeaturesAt: endI].
featureVectors := (startI to: endI by: FFTSize)
collect: [:i | (self extractFeaturesAt: i)].
^ self prunedAverageFeatures: featureVectors
!
----- Method: PhonemeRecord>>clearFeatures (in category 'feature analysis') -----
clearFeatures
"Clear my features vector cache. This must be done when new sample data is recorded or when the analysis algorithm is changed."
features := nil.
!
----- Method: PhonemeRecord>>computeFeatures (in category 'feature analysis') -----
computeFeatures
"Compute and record a features vector take from the start of my samples. This method is typically used to analyze a single buffer during recognition."
self features: (self extractFeaturesAt: 1).
!
----- Method: PhonemeRecord>>distanceToPhoneme: (in category 'feature analysis') -----
distanceToPhoneme: otherPhoneme
"Answer the distance in feature space between this phoneme and the given phoneme."
^ self featureDistanceFrom: self features to: otherPhoneme features
!
----- Method: PhonemeRecord>>extractFeaturesAt: (in category 'feature analysis') -----
extractFeaturesAt: startIndex
"Extract a features vector from the given point in my samples."
| spectrum cutoffIndex binSize s i avg unscaledFeatures total |
spectrum := (FFT new: FFTSize)
transformDataFrom: samples
startingAt: (startIndex min: (samples monoSampleCount - FFTSize + 1)).
cutoffIndex := ((CutoffFreq * spectrum size) / (samplingRate / 2)) rounded.
binSize := ((FilterBandwidth * spectrum size) / (samplingRate / 2)) rounded.
s := WriteStream on: (Array new: 50).
i := 2. "skip first bin of FFT data, which just contains the D.C. component"
[i < cutoffIndex] whileTrue: [
avg := (spectrum copyFrom: i to: i + binSize - 1) sum / binSize.
s nextPut: avg.
i := i + binSize].
"final entry of feature vector sums all energy above the cutoff frequency"
s nextPut: HighFreqWeight *
((spectrum copyFrom: i to: spectrum size) sum / (spectrum size + 1 - i)).
unscaledFeatures := s contents.
total := unscaledFeatures sum.
^ unscaledFeatures collect: [:n | (1000.0 * n) // total].
!
----- Method: PhonemeRecord>>featureDistanceFrom:to: (in category 'feature analysis') -----
featureDistanceFrom: featuresVec1 to: featuresVec2
"Answer the distance between the given two feature vectors. The lower this value, the closer the phonemes match."
| sumOfSquares |
sumOfSquares := 0.
1 to: featuresVec1 size do: [:i |
sumOfSquares := sumOfSquares +
((featuresVec1 at: i) - (featuresVec2 at: i)) squared].
^ sumOfSquares sqrt
!
----- Method: PhonemeRecord>>features (in category 'access') -----
features
"Answer the features vector for this phoneme, an array of numbers used in the phoneme matching process. Compute the features if necessary."
features ifNil: [
AverageFeatures
ifTrue: [features := self averageFeatures]
ifFalse: [features := self featuresAtCenter]].
^ features
!
----- Method: PhonemeRecord>>features: (in category 'access') -----
features: anObject
features := anObject.
!
----- Method: PhonemeRecord>>featuresAtCenter (in category 'feature analysis') -----
featuresAtCenter
"Answer the features vector computed from a single FFT window taken from the center of my samples."
^ self extractFeaturesAt: (samples monoSampleCount // 2)
!
----- Method: PhonemeRecord>>featuresGraph (in category 'other') -----
featuresGraph
"Answer a Form containing a pictorial view of my features vector."
| labelForm graphHeight barWidth bottom f min max scale x h |
labelForm := name asParagraph asForm.
graphHeight := 100.
barWidth := 5.
bottom := graphHeight + 2. "2 pixel border"
f := Form
extent: (self features size * barWidth) @ (graphHeight + labelForm height + 5)
depth: 16.
f fillWhite: f boundingBox.
f border: f boundingBox width: 2.
min := 1.0e30.
max := -1.0e30.
features do: [:v |
v < min ifTrue: [min := v].
v > max ifTrue: [max := v]].
scale := (graphHeight - 1) asFloat / (max - min).
x := 2.
self features do: [:v |
h := (scale * (v - min)) asInteger.
f fill: ((x@(bottom - h)) extent: barWidth@h) fillColor: (Color r: 0.581 g: 0.581 b: 0.0).
x := x + barWidth].
f fillBlack: ((0@bottom) extent: (f width@1)).
labelForm displayOn: f
at: ((f width - labelForm width) // 2)@bottom
rule: Form paint.
^ f
!
----- Method: PhonemeRecord>>initialize (in category 'initialization') -----
initialize
name := ''.
mouthPosition := 1.
samples := SoundBuffer new.
samplingRate := 22050.
features := nil.
!
----- Method: PhonemeRecord>>mouthPosition (in category 'access') -----
mouthPosition
"Answer the mouth position associated with this phoneme, a positive integer that can be used to index into a collection of frames for an animation."
^ mouthPosition!
----- Method: PhonemeRecord>>mouthPosition: (in category 'access') -----
mouthPosition: anInteger
mouthPosition := anInteger.
!
----- Method: PhonemeRecord>>name (in category 'access') -----
name
"Answer the name the user gave this phoneme."
^ name!
----- Method: PhonemeRecord>>name: (in category 'access') -----
name: anObject
name := anObject.!
----- Method: PhonemeRecord>>peakLevel (in category 'feature analysis') -----
peakLevel
"Answer the absolute value of the peak sample value my buffer."
| maxVal v |
maxVal := 0.
1 to: samples size do: [:i |
v := samples at: i.
v < 0 ifTrue: [v := 0 - v].
v > maxVal ifTrue: [maxVal := v]].
^ maxVal
!
----- Method: PhonemeRecord>>phonemeDistanceTo: (in category 'feature analysis') -----
phonemeDistanceTo: otherPhoneme
"Answer the distance in feature space between this phoneme and the given phoneme."
^ self featureDistanceFrom: self features to: otherPhoneme features
!
----- Method: PhonemeRecord>>play (in category 'other') -----
play
"Playback my samples."
(SampledSound samples: samples samplingRate: samplingRate) play.
!
----- Method: PhonemeRecord>>prunedAverageFeatures: (in category 'feature analysis') -----
prunedAverageFeatures: featureVectors
"Compute the average of the given collection of feature vectors, then discard the outliers and average the remainding feature vectors. The result is an average of the most typical feature vectors in the given collection."
| centroid sum vectorsWithErrors filtered |
"compute the average of all the feature vectors"
centroid := (1 to: featureVectors first size) collect: [:i |
sum := 0.
1 to: featureVectors size do: [:j | sum := sum + ((featureVectors at: j) at: i)].
(sum asFloat / featureVectors size) rounded].
"sort vectors by their distance from the centroid"
vectorsWithErrors := SortedCollection sortBlock: [:e1 :e2 | e1 last < e2 last].
featureVectors do: [:v |
vectorsWithErrors add: (Array with: v with: (self featureDistanceFrom: v to: centroid))].
"reject outlying feature vectors"
filtered := (1 to: (0.8 * vectorsWithErrors size) rounded)
collect: [:i | (vectorsWithErrors at: i) first].
"answer the average of the remaining feature vectors"
^ (1 to: filtered first size) collect: [:i |
sum := 0.
1 to: filtered size do: [:j | sum := sum + ((filtered at: j) at: i)].
(sum asFloat / filtered size) rounded].
!
----- Method: PhonemeRecord>>recordWithLevel: (in category 'other') -----
recordWithLevel: recordLevel
"Initialize my sound samples by recording a snippet of sound while the mouse is held down. Trim off leading and trailing silence, and normalize the level of the recording."
| recorder |
"record the sound"
recorder := SoundRecorder new
samplingRate: samplingRate;
recordLevel: recordLevel;
clearRecordedSound.
Utilities
informUser: 'Recording a phoneme. Release the mouse button when done.'
during: [
recorder resumeRecording.
Sensor waitNoButton.
recorder stopRecording].
Utilities
informUser: 'Removing leading/trailing silence...'
during: [
samples := recorder condensedSamples.
samples size > 0 ifTrue: [
samples := self trimAndNormalize: samples]].
self clearFeatures.
!
----- Method: PhonemeRecord>>samples (in category 'access') -----
samples
"Answer the SoundBuffer containing my sampled sound data."
^ samples
!
----- Method: PhonemeRecord>>samples:samplingRate: (in category 'access') -----
samples: aSoundBuffer samplingRate: aNumber
"Set my samples and sampling rate, and clear my cached features vector."
samples := aSoundBuffer.
samplingRate := aNumber.
self clearFeatures.
!
----- Method: PhonemeRecord>>samplingRate (in category 'access') -----
samplingRate
"Answer the sampling rate used to record my samples."
^ samplingRate
!
----- Method: PhonemeRecord>>trimAndNormalize: (in category 'other') -----
trimAndNormalize: aSoundBuffer
"Trim leading and trailing silence and normalize the sound level of the given samples."
| lastSampleIndex maxLevel v threshold startI endI adjust count result |
"skip the sound of the terminating mouse click..."
lastSampleIndex := (aSoundBuffer monoSampleCount - (samplingRate // 10)) max: 1.
"find maximum level"
maxLevel := 0.
1 to: lastSampleIndex do: [:i |
v := aSoundBuffer at: i.
v < 0 ifTrue: [v := 0 - v].
v > maxLevel ifTrue: [maxLevel := v]].
"find indices of start and end"
threshold := (0.1 * maxLevel) asInteger.
startI := 1.
[(aSoundBuffer at: startI) < threshold]
whileTrue: [startI := startI + 1]. "scan for starting point"
endI := lastSampleIndex.
[(aSoundBuffer at: endI) < threshold]
whileTrue: [endI := endI - 1]. "scan for ending point"
"extend range by a twentieth of a second on both ends"
startI := (startI - (samplingRate // 20)) max: 1.
endI := (endI + (samplingRate // 20)) min: aSoundBuffer monoSampleCount.
adjust := (10000 * (30000 / maxLevel)) asInteger. "fixed point constant for speed"
count := (endI - startI) + 1.
result := SoundBuffer newMonoSampleCount: (endI - startI) + 1.
1 to: count do: [:i |
v := (adjust * (aSoundBuffer at: (startI + i - 1))) // 10000.
result at: i put: v].
^ result
!
Object subclass: #PhonemeSet
instanceVariableNames: 'name description phonemes specials'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Phonetics'!
PhonemeSet class
instanceVariableNames: 'arpabet'!
!PhonemeSet commentStamp: '<historical>' prior: 0!
My instances are phoneme sets, i.e. phonetic alphabets.
There are several "standard" phoneme sets used among phoneticians. We choosed ARPABET to be the default phoneme set in this system, but other examples are implemented, such as DARPA (radio), MRPA and SAMPA. As well, mappings from those phoneme sets to ARPABET are provided.!
PhonemeSet class
instanceVariableNames: 'arpabet'!
----- Method: PhonemeSet class>>arpabet (in category 'examples') -----
arpabet
"Answer the ARPAbet phoneme set."
^ arpabet!
----- Method: PhonemeSet class>>arpabetToSampa (in category 'examples') -----
arpabetToSampa
"Answer a dictionary with ARPAbet phonemes
as keys and SAMPA phoneme names as values."
| answer |
answer := Dictionary new.
self sampaToArpabet associationsDo: [ :each | answer at: each value put: each key].
^ answer!
----- Method: PhonemeSet class>>darpa (in category 'examples') -----
darpa
"Answer the DARPA phoneme set."
^ self radio!
----- Method: PhonemeSet class>>dectalkToArpabet (in category 'examples') -----
dectalkToArpabet
"Answer a dictionary with DECTalk phoneme names
as keys and ARPAbet phonemes as values."
| answer |
answer := Dictionary new.
self arpabet do: [ :each | answer at: each name put: each].
#(
('nx' 'ng')
('yx' 'jh')
('lx' 'l')
('rr' 'r')
('u' 'uw')
('hx' 'hh')
('h' 'hh')
('_' 'sil')) do: [ :each | answer at: each first put: (self arpabet at: each last)].
^ answer!
----- Method: PhonemeSet class>>default (in category 'examples') -----
default
^ self arpabet!
----- Method: PhonemeSet class>>initialize (in category 'class initialization') -----
initialize
"
PhonemeSet initialize
"
arpabet := self new name: 'ARPAbet'; description: 'This is the ARPAbet phonetic alphabet.'.
#("Name" "Example" "Features"
('iy' 'heed' #(continuant vowel front))
('ih' 'hid' #(continuant vowel front))
('ey' 'hayed' #(continuant vowel front))
('eh' 'head' #(continuant vowel front))
('ae' 'had' #(continuant vowel front))
('aa' 'hod' #(continuant vowel back))
('ao' 'hawed' #(continuant vowel back))
('ow' 'hoed' #(continuant vowel back))
('uh' 'hood' #(continuant vowel back))
('uw' 'who''d' #(continuant vowel back))
('er' 'heard' #(continuant vowel mid))
('ax' 'ago' #(continuant vowel mid))
('ah' 'mud' #(continuant vowel mid))
('ay' 'hide' #(diphthong))
('aw' 'how''d' #(diphthong))
('oy' 'boy' #(diphthong))
('ix' 'roses' #())
('p' 'pea' #(consonant stop unvoiced))
('b' 'bat' #(consonant stop voiced))
('t' 'tea' #(consonant stop unvoiced))
('d' 'deep' #(consonant stop voiced))
('k' 'kick' #(consonant stop unvoiced))
('g' 'go' #(consonant stop voiced))
('f' 'five' #(continuant consonant fricative unvoiced))
('v' 'vice' #(continuant consonant fricative voiced))
('th' 'thing' #(continuant consonant fricative unvoiced))
('dh' 'then' #(continuant consonant fricative voiced))
('s' 'so' #(continuant consonant fricative unvoiced))
('z' 'zebra' #(continuant consonant fricative voiced))
('sh' 'show' #(continuant consonant fricative unvoiced))
('zh' 'measure' #(continuant consonant fricative voiced))
('hh' 'help' #(continuant consonant whisper))
('m' 'mom' #(continuant consonant nasal))
('n' 'noon' #(continuant consonant nasal))
('ng' 'sing' #(continuant consonant nasal)) "old name: nx"
('l' 'love' #(semivowel liquid))
('el' 'cattle')
('em' 'some')
('en' 'son')
('dx' 'batter')
('q' '[glottal stop]')
('w' 'want' #(continuant semivowel glide))
('y' 'yard' #(continuant semivowel glide))
('r' 'race' #(continuant semivowel liquid))
('ch' 'church' #(continuant consonant affricate))
('jh' 'just' #(continuant consonant affricate))
('wh' 'when' #(semivowel liquid))
"not found in the original:"
('sil' '[silence]' #(silence))
('ll' '') "dark l"
('ai' '' #(vowel)) "what is this?"
('ia' '' #(vowel))
('ea' '' #(vowel))
('ua' '' #(vowel))
('aor' '')
('rx' '' #())
) do: [ :each |
arpabet add: (each size > 2
ifTrue: [Phoneme name: each first example: each second features: each last]
ifFalse: [Phoneme name: each first example: each last])].
arpabet specials at: #silence put: (arpabet at: 'sil')!
----- Method: PhonemeSet class>>mactalkToArpabet (in category 'examples') -----
mactalkToArpabet
"Answer a dictionary with MacTalk phoneme names
as keys and ARPAbet phonemes as values."
| answer |
answer := Dictionary new.
#(
('IY' 'iy')
('IH' 'ih')
('EY' 'ey')
('EH' 'eh')
('AE' 'ae')
('AA' 'aa')
('AO' 'ao')
('OW' 'ow')
('UH' 'uh')
('UW' 'uw')
" ('' 'er')"
('AX' 'ax')
('AH' 'ah')
('AY' 'ay')
('AW' 'aw')
('OY' 'oy')
" ('' 'ix')"
('p' 'p')
('b' 'b')
('t' 't')
('d' 'd')
('k' 'k')
('g' 'g')
('f' 'f')
('v' 'v')
('T' 'th')
('D' 'dh')
('s' 's')
('z' 'z')
('S' 'sh')
('Z' 'zh')
('h' 'hh')
('m' 'm')
('n' 'n')
('N' 'ng')
('l' 'l')
('w' 'w')
('y' 'y')
('r' 'r')
('C' 'ch')
('J' 'jh')
('UX' 'ax')
('_' 'sil')
('~' 'sil')) do: [ :each | answer at: each first put: (self arpabet at: each last)].
^ answer!
----- Method: PhonemeSet class>>mrpa (in category 'examples') -----
mrpa
"Answer the MRPA phoneme set."
self notYetImplemented!
----- Method: PhonemeSet class>>mrpaToArpabet (in category 'examples') -----
mrpaToArpabet
"Answer a dictionary with MRPA phoneme names
as keys and ARPAbet Phonemes as values."
self notYetImplemented!
----- Method: PhonemeSet class>>radio (in category 'examples') -----
radio
"Answer the radio phoneme set, named after the BU RADIO FM corpus."
self notYetImplemented!
----- Method: PhonemeSet class>>sampa (in category 'examples') -----
sampa
"Answer the sampa phoneme set."
| answer mapping |
mapping := self sampaToArpabet.
answer := self new.
mapping keysDo: [ :each | answer add: ((self arpabet at: (mapping at: each)) copy name: each)].
^ answer!
----- Method: PhonemeSet class>>sampaToArpabet (in category 'examples') -----
sampaToArpabet
"Answer a dictionary with SAMPA phoneme names
as keys and ARPAbet phonemes as values."
| answer |
answer := Dictionary new.
#( ('p' 'p')
('b' 'b')
('t' 't')
('d' 'd')
('k' 'k')
('m' 'm')
('n' 'n')
('l' 'l')
('r' 'r')
('f' 'f')
('v' 'v')
('s' 's')
('z' 'z')
('h' 'hh')
('w' 'w')
('g' 'g')
('tS' 'ch')
('dZ' 'jh')
('N' 'ng')
('T' 'th')
('D' 'dh')
('S' 'sh')
('Z' 'zh')
('j' 'y')
('i:' 'iy')
('i' 'iy')
('A:' 'aa')
('A' 'aa')
('O:' 'ao')
('O' 'ao')
('u:' 'uw')
('u' 'uw')
('3:' 'er')
('r=' 'er')
('I' 'ih')
('e' 'eh')
('E' 'eh')
('{' 'ae')
('V' 'ah')
" ('Q' 'oh')"
('U' 'uh')
('@' 'ax')
('eI' 'ey')
('aI' 'ay')
('OI' 'oy')
('@U' 'ow')
('aU' 'aw')
('I@' 'ia')
('e@' 'ea')
('U@' 'ua')
('AI' 'ay')
('EI' 'ey')
('4' 't')
('_' 'sil')) do: [ :each | answer at: each first put: (self arpabet at: each last)].
^ answer!
----- Method: PhonemeSet>>add: (in category 'accessing') -----
add: aPhoneme
^ phonemes at: aPhoneme name put: aPhoneme!
----- Method: PhonemeSet>>at: (in category 'accessing') -----
at: aString
^ phonemes at: aString!
----- Method: PhonemeSet>>at:ifAbsent: (in category 'accessing') -----
at: aString ifAbsent: aBlock
^ phonemes at: aString ifAbsent: aBlock!
----- Method: PhonemeSet>>copy (in category 'copying') -----
copy
^ self class new addAll: self phonemes; yourself!
----- Method: PhonemeSet>>description (in category 'accessing') -----
description
^ description!
----- Method: PhonemeSet>>description: (in category 'accessing') -----
description: aString
description := aString!
----- Method: PhonemeSet>>do: (in category 'enumerating') -----
do: aBlock
phonemes do: aBlock!
----- Method: PhonemeSet>>initialize (in category 'initialization') -----
initialize
phonemes := Dictionary new.
specials := Dictionary new!
----- Method: PhonemeSet>>name (in category 'accessing') -----
name
^ name!
----- Method: PhonemeSet>>name: (in category 'accessing') -----
name: aString
name := aString!
----- Method: PhonemeSet>>names (in category 'accessing') -----
names
"Answer the names of all the phonemes."
^ phonemes keys!
----- Method: PhonemeSet>>pause (in category 'accessing') -----
pause
^ self silence!
----- Method: PhonemeSet>>phonemes (in category 'accessing') -----
phonemes
^ phonemes values!
----- Method: PhonemeSet>>printOn: (in category 'printing') -----
printOn: aStream
name isNil ifTrue: [^ super printOn: aStream].
aStream nextPutAll: name, ' phoneme set'!
----- Method: PhonemeSet>>silence (in category 'accessing') -----
silence
^ self specials at: #silence!
----- Method: PhonemeSet>>specials (in category 'accessing') -----
specials
^ specials!
----- Method: PhonemeSet>>transcriptionOf: (in category 'transcribing') -----
transcriptionOf: aString
^ (aString findTokens: '/ ')
collect: [ :each |
each last isDigit
ifTrue: [(self at: (each copyFrom: 1 to: each size - 1))
stressed: each last asString asNumber]
ifFalse: [self at: each]]!
Object subclass: #PhoneticRule
instanceVariableNames: 'left text right phonemes'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Phonetics'!
!PhoneticRule commentStamp: '<historical>' prior: 0!
My instances are letter-to-sound rules for perform automatic text-to-phonemes transcription. (See the PhoneticTranscriber class comment too.)
Rules are made up of four parts: (1) left context pattern, (2) the text to match, (3) the right context pattern, and (4) the phonemes to substitute for the matched text.
The transcription procedure begins separating each block of letters (apostrophes included) and adding a space on each side. For each unmatched letter in the word, look through the rules where the text to match starts with the letter in the word. If the text to match if found and the right and left contexts patterns also match, output the phonemes for that rule and skip to the next unmatched letter.
Context patterns special characters:
# One or more vowels
: Zero or more consonants
^ One consonant
. One of B, D, V, G, J, L, M, N, R, W, or Z (voiced consonants)
% One of ER, E, ES, ED, ING, ELY (a suffix) [ONLY FOR RIGHT CONTEXT]
+ One of E, I or Y (a "front" vowel)
Furthermore, the space character means any separator (space, comma, colon, etc), and any other character means that character it self.
The english example is derived from: "Automatic Translation of English Text to Phonetics by Means of Letter-To-Sound Rules", NRL Report 7948, January 21st, 1976, Naval Research Laboratory, Washington, D.C. Published by the National Technical Information Service as document "AD/A021 929".
!
----- Method: PhoneticRule class>>english (in category 'examples-english') -----
english
"Answer the english phonetic rules."
| answer |
answer := OrderedCollection new.
#(englishPunctuationRules
englishARules englishBRules englishCRules englishDRules englishERules
englishFRules englishGRules englishHRules englishIRules englishJRules
englishKRules englishLRules englishMRules englishNRules englishORules
englishPRules englishQRules englishRRules englishSRules englishTRules
englishURules englishVRules englishWRules englishXRules englishYRules
englishZRules) do: [ :each | answer addAll: (self perform: each)].
^ answer asArray!
----- Method: PhoneticRule class>>englishARules (in category 'examples-english') -----
englishARules
^ #(('' 'a' ' ' 'ax')
(' ' 'are' ' ' 'aa/r')
(' ' 'ar' 'o' 'ax/r')
('' 'ar' '#' 'eh/r')
('^' 'as' '#' 'ey/s')
('' 'a' 'wa' 'ax')
('' 'aw' '' 'ao')
(' :' 'any' '' 'eh/n/iy')
('' 'a' '^+#' 'ey')
('#:' 'ally' '' 'ax/l/iy')
(' ' 'al' '#' 'ax/l')
('' 'again' '' 'ax/g/eh/n')
('#:' 'ag' 'e' 'ih/jh')
('' 'a' '^+:#' 'ae')
(' :' 'a' '^+ ' 'ey')
(' ' 'arr' '' 'ax/r')
('' 'arr' '' 'ae/r')
(' :' 'ar' ' ' 'aa/r')
('' 'ar' ' ' 'er')
('' 'ar' '' 'aa/r')
('' 'air' '' 'eh/r')
('' 'ai' '' 'ey')
('' 'ay' '' 'ey')
('' 'au' '' 'ao')
('#:' 'al' ' ' 'ax/l')
('#:' 'als' ' ' 'ax/l/z')
('' 'alk' '' 'ao/k')
('' 'al' '^' 'ao/l')
(' :' 'able' '' 'ey/b/ax/l')
('' 'able' '' 'ax/b/ax/l')
('' 'ang' '+' 'ey/n/jh')
('^' 'a' '^#' 'ey')
('' 'a' '' 'ae')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishBRules (in category 'examples-english') -----
englishBRules
^ #((' ' 'be' '^#' 'b/ih')
('' 'being' '' 'b/iy/ih/ng')
(' ' 'both' '' 'b/ow/th')
(' ' 'bus' '#' 'b/ih/z')
('' 'buil' '' 'b/ih/l')
('' 'b' '' 'b')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishCRules (in category 'examples-english') -----
englishCRules
^ #((' ' 'ch' '^' 'k')
('^e' 'ch' '' 'k')
('' 'ch' '' 'ch')
(' s' 'ci' '#' 's/ay')
('' 'ci' 'a' 'sh')
('' 'ci' 'o' 'sh')
('' 'ci' 'en' 'sh')
('' 'c' '+' 's')
('' 'ck' '' 'k')
('' 'com' '%' 'k/ah/m')
('' 'c' '' 'k')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishDRules (in category 'examples-english') -----
englishDRules
^ #(('#:' 'ded' ' ' 'd/ih/d')
('.e' 'd' ' ' 'd')
('#:^e' 'd' ' ' 't')
(' ' 'de' '^#' 'd/ih')
(' ' 'do' ' ' 'd/uw')
(' ' 'does' '' 'd/ah/z')
(' ' 'doing' '' 'd/uw/ih/ng')
(' ' 'dow' '' 'd/aw')
('' 'du' 'a' 'jh/uw')
('' 'd' '' 'd')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishERules (in category 'examples-english') -----
englishERules
^ #(('#:' 'e' ' ' '')
(''':^' 'e' ' ' '')
(' :' 'e' ' ' 'iy')
('#' 'ed' ' ' 'd')
('#:' 'e' 'd' '')
('' 'ev' 'er' 'eh/v')
('' 'e' '^%' 'iy')
('' 'eri' '#' 'iy/r/iy')
('' 'eri' '' 'eh/r/ih')
('#:' 'er' '#' 'er')
('' 'er' '#' 'eh/r')
('' 'er' '' 'er')
(' ' 'even' '' 'iy/v/eh/n')
('#:' 'e' 'w' '')
('t' 'ew' '' 'uw')
('s' 'ew' '' 'uw')
('r' 'ew' '' 'uw')
('d' 'ew' '' 'uw')
('l' 'ew' '' 'uw')
('z' 'ew' '' 'uw')
('n' 'ew' '' 'uw')
('j' 'ew' '' 'uw')
('th' 'ew' '' 'uw')
('ch' 'ew' '' 'uw')
('sh' 'ew' '' 'uw')
('' 'ew' '' 'y/uw')
('' 'e' 'o' 'iy')
('#:s' 'es' ' ' 'ih/z')
('#:c' 'es' ' ' 'ih/z')
('#:g' 'es' ' ' 'ih/z')
('#:z' 'es' ' ' 'ih/z')
('#:x' 'es' ' ' 'ih/z')
('#:j' 'es' ' ' 'ih/z')
('#:ch' 'es' ' ' 'ih/z')
('#:sh' 'es' ' ' 'ih/z')
('#:' 'e' 's' '')
('#:' 'ely' ' ' 'l/iy')
('#:' 'ement' '' 'm/eh/n/t')
('' 'eful' '' 'f/uh/l')
('' 'ee' '' 'iy')
('' 'earn' '' 'er/n')
(' ' 'ear' '^' 'er')
('' 'ead' '' 'eh/d')
('#:' 'ea' ' ' 'iy/ax')
('' 'ea' 'su' 'eh')
('' 'ea' '' 'iy')
('' 'eigh' '' 'ey')
('' 'ei' '' 'iy')
(' ' 'eye' '' 'ay')
('' 'ey' '' 'iy')
('' 'eu' '' 'y/uw')
('' 'e' '' 'eh')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishFRules (in category 'examples-english') -----
englishFRules
^ #(('' 'ful' '' 'f/uh/l')
('' 'f' '' 'f')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishGRules (in category 'examples-english') -----
englishGRules
^ #(('' 'giv' '' 'g/iy/v')
(' ' 'g' 'i^' 'g')
('' 'ge' 't' 'g/eh')
('su' 'gges' '' 'g/jh/eh/s')
('' 'gg' '' 'g')
(' b#' 'g' '' 'g')
('' 'g' '+' 'jh')
('' 'great' '' 'g/r/ey/t')
('#' 'gh' '' '')
('' 'g' '' 'g')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishHRules (in category 'examples-english') -----
englishHRules
^ #((' ' 'hav' '' 'hh/ae/v')
(' ' 'here' '' 'hh/iy/r')
(' ' 'hour' '' 'aw/er')
('' 'how' '' 'hh/aw')
('' 'h' '#' 'hh')
('' 'h' '' '')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishIRules (in category 'examples-english') -----
englishIRules
^ #((' ' 'in' '' 'ih/n')
(' ' 'i' ' ' 'ay')
('' 'in' 'd' 'ay/n')
('' 'ier' '' 'iy/er')
('#:r' 'ied' '' 'iy/d')
('' 'ied' ' ' 'ay/d')
('' 'ien' '' 'iy/eh/n')
('' 'ie' 't' 'ay/eh')
(' :' 'i' '%' 'ay')
('' 'i' '%' 'iy')
('' 'ie' '' 'iy')
('' 'i' '^+:#' 'ih')
('' 'ir' '#' 'ay/r')
('' 'iz' '%' 'ay/z')
('' 'is' '%' 'ay/z')
('' 'i' 'd%' 'ay')
('+^' 'i' '^+' 'ih')
('' 'i' 't%' 'ay')
('#:^' 'i' '^+' 'ih')
('' 'i' '^+' 'ay')
('' 'ir' '' 'er')
('' 'igh' '' 'ay')
('' 'ild' '' 'ay/l/d')
('' 'ign' ' ' 'ay/n')
('' 'ign' '^' 'ay/n')
('' 'ign' '%' 'ay/n')
('' 'ique' '' 'iy/k')
('' 'i' '' 'ih')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishJRules (in category 'examples-english') -----
englishJRules
^ #(('' 'j' '' 'jh')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishKRules (in category 'examples-english') -----
englishKRules
^ #(('' 'k' 'n' '')
('' 'k' '' 'k')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishLRules (in category 'examples-english') -----
englishLRules
^ #(('' 'lo' 'c#' 'l/ow')
('l' 'l' '' '')
('#:^' 'l' '%' 'ax/l')
('' 'lead' '' 'l/iy/d')
('' 'l' '' 'l')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishMRules (in category 'examples-english') -----
englishMRules
^ #(('' 'mov' '' 'm/uw/v')
('' 'm' '' 'm')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishNRules (in category 'examples-english') -----
englishNRules
^ #(('e' 'ng' '+' 'n/jh')
('' 'ng' 'r' 'ng/g')
('' 'ng' '#' 'ng/g')
('' 'ngl' '%' 'ng/g/ax/l')
('' 'ng' '' 'ng')
('' 'nk' '' 'ng/k')
(' ' 'now' ' ' 'n/aw')
('' 'n' '' 'n')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishORules (in category 'examples-english') -----
englishORules
^ #(('' 'of' ' ' 'ax/v')
('' 'orough' '' 'er/ow')
('#:' 'or' ' ' 'er')
('#:' 'ors' ' ' 'er/z')
('' 'or' '' 'ao/r')
(' ' 'one' '' 'w/ah/n')
('' 'ow' '' 'ow')
(' ' 'over' '' 'ow/v/er')
('' 'ov' '' 'ah/v')
('' 'o' '^%' 'ow')
('' 'o' '^en' 'ow')
('' 'o' '^i#' 'ow')
('' 'ol' 'd' 'ow/l')
('' 'ought' '' 'ao/t')
('' 'ough' '' 'ah/f')
(' ' 'ou' '' 'aw')
('h' 'ou' 's#' 'aw')
('' 'ous' '' 'ax/s')
('' 'our' '' 'ao/r')
('' 'ould' '' 'uh/d')
('^' 'ou' '^l' 'ah')
('' 'oup' '' 'uw/p')
('' 'ou' '' 'aw')
('' 'oy' '' 'oy')
('' 'oing' '' 'ow/ih/ng')
('' 'oi' '' 'oy')
('' 'oor' '' 'ao/r')
('' 'ook' '' 'uh/k')
('' 'ood' '' 'uh/d')
('' 'oo' '' 'uw')
('' 'o' 'e' 'ow')
('' 'o' ' ' 'ow')
('' 'oa' '' 'ow')
(' ' 'only' '' 'ow/n/l/iy')
(' ' 'once' '' 'w/ah/n/s')
('' 'on''t' '' 'ow/n/t')
('c' 'o' 'n' 'aa')
('' 'o' 'ng' 'ao')
(' :^' 'o' 'n' 'ah')
('i' 'on' '' 'ax/n')
('#:' 'on' ' ' 'ax/n')
('#^' 'on' '' 'ax/n')
('' 'o' 'st ' 'ow')
('' 'of' '^' 'ao/f')
('' 'other' '' 'ah/dh/er')
('' 'oss' ' ' 'ao/s')
('#:^' 'om' '' 'ah/m')
('' 'o' '' 'aa')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishPRules (in category 'examples-english') -----
englishPRules
^ #(('' 'ph' '' 'f')
('' 'peop' '' 'p/iy/p')
('' 'pow' '' 'p/aw')
('' 'put' ' ' 'p/uh/t')
('' 'p' '' 'p')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishPunctuationRules (in category 'examples-english') -----
englishPunctuationRules
^ #(('.' '''s' '' 'z')
('#:.e' '''s' '' 'z')
('#' '''s' '' 'z')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishQRules (in category 'examples-english') -----
englishQRules
^ #(('' 'quar' '' 'k/w/ao/r')
('' 'qu' '' 'k/w')
('' 'q' '' 'k')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishRRules (in category 'examples-english') -----
englishRRules
^ #(('' 're' '^#' 'r/iy')
('' 'r' '' 'r')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishSRules (in category 'examples-english') -----
englishSRules
^ #(('' 'sh' '' 'sh')
('#' 'sion' '' 'zh/ax/n')
('' 'some' '' 's/ah/m')
('#' 'sur' '#' 'zh/er')
('' 'sur' '#' 'sh/er')
('#' 'su' '#' 'zh/uw')
('#' 'ssu' '#' 'sh/uw')
('#' 'sed' ' ' 'z/d')
('#' 's' '#' 'z')
('' 'said' '' 's/eh/d')
('^' 'sion' '' 'sh/ax/n')
('' 's' 's' '')
('.' 's' ' ' 'z')
('#:.e' 's' ' ' 'z')
('#:^##' 's' ' ' 'z')
('#:^#' 's' ' ' 's')
('u' 's' ' ' 's')
(' :#' 's' ' ' 'z')
(' ' 'sch' '' 's/k')
('' 's' 'c+' '')
('#' 'sm' '' 'z/m')
('#' 'sn' '''' 'z/ax/n')
('' 's' '' 's')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishTRules (in category 'examples-english') -----
englishTRules
^ #((' ' 'the' ' ' 'dh/ax')
('' 'to' ' ' 't/uw')
('' 'that' ' ' 'dh/ae/t')
(' ' 'this' ' ' 'dh/ih/s')
(' ' 'they' '' 'dh/ey')
(' ' 'there' '' 'dh/eh/r')
('' 'ther' '' 'dh/er')
('' 'their' '' 'dh/eh/r')
(' ' 'than' ' ' 'dh/ae/n')
(' ' 'them' ' ' 'dh/eh/m')
('' 'these' ' ' 'dh/iy/z')
(' ' 'then' '' 'dh/eh/n')
('' 'through' '' 'th/r/uw')
('' 'those' '' 'dh/ow/z')
('' 'though' ' ' 'dh/ow')
(' ' 'thus' '' 'dh/ah/s')
('' 'th' '' 'th')
('#:' 'ted' ' ' 't/ih/d')
('s' 'ti' '#n' 'ch')
('' 'ti' 'o' 'sh')
('' 'ti' 'a' 'sh')
('' 'tien' '' 'sh/ax/n')
('' 'tur' '#' 'ch/er')
('' 'tu' 'a' 'ch/uw')
('' 'two' '' 't/uw')
('' 't' '' 't')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishURules (in category 'examples-english') -----
englishURules
^ #((' ' 'un' 'i' 'y/uw/n')
(' ' 'un' '' 'ah/n')
(' ' 'upon' '' 'ax/p/ao/n')
('t' 'ur' '#' 'uh/r')
('s' 'ur' '#' 'uh/r')
('r' 'ur' '#' 'uh/r')
('d' 'ur' '#' 'uh/r')
('l' 'ur' '#' 'uh/r')
('z' 'ur' '#' 'uh/r')
('n' 'ur' '#' 'uh/r')
('j' 'ur' '#' 'uh/r')
('th' 'ur' '#' 'uh/r')
('ch' 'ur' '#' 'uh/r')
('sh' 'ur' '#' 'uh/r')
('' 'ur' '#' 'y/uh/r')
('' 'ur' '' 'er')
('' 'u' '^' 'ah')
('' 'u' '^^' 'ah')
('' 'uy' '' 'ay')
(' g' 'u' '#' '')
('g' 'u' '%' '')
('g' 'u' '#' 'w')
('#n' 'u' '' 'y/uw')
('t' 'u' '' 'uw')
('s' 'u' '' 'uw')
('r' 'u' '' 'uw')
('d' 'u' '' 'uw')
('l' 'u' '' 'uw')
('z' 'u' '' 'uw')
('n' 'u' '' 'uw')
('j' 'u' '' 'uw')
('th' 'u' '' 'uw')
('ch' 'u' '' 'uw')
('sh' 'u' '' 'uw')
('' 'u' '' 'y/uw')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishVRules (in category 'examples-english') -----
englishVRules
^ #(('' 'view' '' 'v/y/uw')
('' 'v' '' 'v')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishWRules (in category 'examples-english') -----
englishWRules
^ #((' ' 'were' '' 'w/er')
('' 'wa' 's' 'w/aa')
('' 'wa' 't' 'w/aa')
('' 'where' '' 'wh/eh/r')
('' 'what' '' 'wh/aa/t')
('' 'whol' '' 'hh/ow/l')
('' 'who' '' 'hh/uw')
('' 'wh' '' 'wh')
('' 'war' '' 'w/ao/r')
('' 'wor' '^' 'w/er')
('' 'wr' '' 'r')
('' 'w' '' 'w')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishXRules (in category 'examples-english') -----
englishXRules
^ #(('' 'x' '' 'k/s')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishYRules (in category 'examples-english') -----
englishYRules
^ #(('' 'young' '' 'y/ah/ng')
(' ' 'you' '' 'y/uw')
(' ' 'yes' '' 'y/eh/s')
(' ' 'y' '' 'y')
('#:^' 'y' ' ' 'iy')
('#:^' 'y' 'i' 'iy')
(' :' 'y' '' 'ay')
(' :' 'y' '#' 'ay')
(' :' 'y' '^+:#' 'ih')
(' :' 'y' '^#' 'ay')
('' 'y' '' 'ih')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>englishZRules (in category 'examples-english') -----
englishZRules
^ #(('' 'z' '' 'z')
) collect: [ :each | self fromArray: each]!
----- Method: PhoneticRule class>>fromArray: (in category 'instance creation') -----
fromArray: anArray
^ self fromArray: anArray phonemes: PhonemeSet arpabet!
----- Method: PhoneticRule class>>fromArray:phonemes: (in category 'instance creation') -----
fromArray: anArray phonemes: aPhonemeSet
^ self new
left: (anArray at: 1);
text: (anArray at: 2);
right: (anArray at: 3);
phonemes: (aPhonemeSet transcriptionOf: (anArray at: 4)) asArray!
----- Method: PhoneticRule class>>spanish (in category 'examples') -----
spanish
"Answer the spanish phonetic rules."
| phonemes |
phonemes := PhonemeSet spanish.
^ #(
('' 'a' '' 'a')
('' 'b' '' 'b')
('' 'ch' '' 'ch')
('' 'c' 'i' 'z')
('' 'c' 'e' 'z')
('' 'c' '' 'k')
('' 'd' '' 'd')
('' 'e' '' 'e')
('' 'f' '' 'f')
('' 'g' 'e' 'j')
('' 'g' 'i' 'j')
('' 'gu' 'e' 'g')
('' 'gu' 'i' 'g')
('' 'g' '' 'g')
('' 'h' '' '')
('' 'i' '' 'i')
('' 'j' '' 'j')
('' 'k' '' 'k')
('' 'll' '' 'y')
('' 'l' '' 'l')
('' 'm' '' 'm')
('' 'n' '' 'n')
('' 'o' '' 'o')
('' 'p' '' 'p')
('' 'qu' '' 'k')
('' 'rr' '' 'rx')
(' ' 'r' '' 'rx')
('' 'r' '' 'r')
('' 's' '' 's')
('' 't' '' 't')
('' 'u' '' 'u')
('' 'v' '' 'v')
('' 'w' '' 'w')
('' 'x' '' 'k/s')
('' 'y' ' ' 'i')
('' 'y' '' 'y')
('' 'z' '' 'z')
) collect: [ :each | self fromArray: each phonemes: phonemes]!
----- Method: PhoneticRule>>= (in category 'comparing') -----
= anObject
self species == anObject species ifFalse: [^ false].
^ anObject left = self left
and: [anObject right = self right
and: [anObject text = self text
and: [anObject phonemes = self phonemes]]]!
----- Method: PhoneticRule>>hash (in category 'comparing') -----
hash
^ self text hash!
----- Method: PhoneticRule>>left (in category 'accessing') -----
left
^ left!
----- Method: PhoneticRule>>left: (in category 'accessing') -----
left: aString
left := aString!
----- Method: PhoneticRule>>leftMatches:at: (in category 'private') -----
leftMatches: aString at: anInteger
| leftindex textindex pattern |
left isEmpty ifTrue: [^ true].
leftindex := left size.
textindex := anInteger - 1.
[leftindex >= 1 and: [textindex >= 1]] whileTrue: [
pattern := left at: leftindex.
"first check for simple text or apostrophe:"
(pattern isAlphaNumeric or: [pattern = $'])
ifTrue: [(aString at: textindex) asLowercase ~= pattern asLowercase
ifTrue: [^ false].
textindex := textindex - 1].
"space:"
pattern = Character space
ifTrue: [((aString at: textindex) isSeparator
or: ['.,;:' includes: (aString at: textindex)]) ifFalse: [^ false].
textindex := textindex - 1].
"one or more vowels:"
pattern = $#
ifTrue: [(aString at: textindex) isVowel ifFalse: [^ false].
textindex := textindex - 1.
[textindex >= 1 and: [(aString at: textindex) isVowel]]
whileTrue: [textindex := textindex - 1]].
"zero or more consonants:"
pattern = $:
ifTrue: [[textindex >= 1
and: ['bcdfghjklmnpqrstvwxyz'
includes: (aString at: textindex) asLowercase]]
whileTrue: [textindex := textindex - 1]].
"one consonant:"
pattern = $^
ifTrue: [('bcdfghjklmnpqrstvwxyz' includes: (aString at: textindex))
ifFalse: [^ false].
textindex := textindex - 1].
"b, d, v, g, j, l, m, n, r, w, z (voiced consonants):"
pattern = $.
ifTrue: [('bdvgjlmnrwz' includes: (aString at: textindex) asLowercase)
ifFalse: [^ false].
textindex := textindex - 1].
"e, i or y (front vowels)"
pattern = $+
ifTrue: [('eiy' includes: (aString at: textindex) asLowercase)
ifFalse: [^ false].
textindex := textindex - 1].
leftindex := leftindex - 1].
^ true!
----- Method: PhoneticRule>>matches:at: (in category 'testing') -----
matches: aString at: anInteger
^ (self textMatches: aString at: anInteger)
and: [(self leftMatches: aString at: anInteger)
and: [self rightMatches: aString at: anInteger]]!
----- Method: PhoneticRule>>phonemes (in category 'accessing') -----
phonemes
^ phonemes!
----- Method: PhoneticRule>>phonemes: (in category 'accessing') -----
phonemes: aCollection
phonemes := aCollection!
----- Method: PhoneticRule>>printOn: (in category 'printing') -----
printOn: aStream
aStream
nextPut: $[; print: left; nextPut: $,; print: text; nextPut: $,; print: right; nextPut: $];
nextPutAll: ' -> '.
phonemes isEmpty ifTrue: [aStream nextPutAll: '{}'] ifFalse: [aStream nextPut: $/].
phonemes do: [ :each | aStream nextPutAll: each name; nextPut: $/]!
----- Method: PhoneticRule>>right (in category 'accessing') -----
right
^ right!
----- Method: PhoneticRule>>right: (in category 'accessing') -----
right: aString
right := aString!
----- Method: PhoneticRule>>rightMatches:at: (in category 'private') -----
rightMatches: aString at: anInteger
| rightindex textindex pattern |
right isEmpty ifTrue: [^ true].
rightindex := 1.
textindex := anInteger + text size.
[rightindex <= right size and: [textindex <= aString size]] whileTrue: [
pattern := right at: rightindex.
"first check for simple text or apostrophe:"
(pattern isAlphaNumeric or: [pattern = $'])
ifTrue: [(aString at: textindex) asLowercase ~= pattern asLowercase
ifTrue: [^ false].
textindex := textindex + 1].
"space:"
pattern = Character space
ifTrue: [((aString at: textindex) isSeparator
or: ['.,;:' includes: (aString at: textindex)]) ifFalse: [^ false].
textindex := textindex + 1].
"one or more vowels:"
pattern = $#
ifTrue: [(aString at: textindex) isVowel ifFalse: [^ false].
textindex := textindex + 1.
[textindex <= aString size and: [(aString at: textindex) isVowel]]
whileTrue: [textindex := textindex + 1]].
"zero or more consonants:"
pattern = $:
ifTrue: [[textindex <= aString size
and: ['bcdfghjklmnpqrstvwxyz'
includes: (aString at: textindex) asLowercase]]
whileTrue: [textindex := textindex + 1]].
"one consonant:"
pattern = $^
ifTrue: [('bcdfghjklmnpqrstvwxyz' includes: (aString at: textindex))
ifFalse: [^ false].
textindex := textindex + 1].
"b, d, v, g, j, l, m, n, r, w, z (voiced consonants):"
pattern = $.
ifTrue: [('bdvgjlmnrwz' includes: (aString at: textindex) asLowercase)
ifFalse: [^ false].
textindex := textindex + 1].
"e, i or y (front vowels):"
pattern = $+
ifTrue: [('eiy' includes: (aString at: textindex) asLowercase)
ifFalse: [^ false].
textindex := textindex + 1].
"er, e, es, ed, ing, ely (a suffix):"
pattern = $%
ifTrue: [(aString at: textindex) asLowercase = $e
ifTrue: [textindex := textindex + 1.
(textindex < aString size and: [(aString at: textindex) asLowercase = $l])
ifTrue: [textindex := textindex + 1.
(textindex < aString size and: [(aString at: textindex) asLowercase = $y])
ifTrue: [textindex := textindex + 1]
ifFalse: [textindex := textindex - 1]]
ifFalse: [('rsd' includes: (aString at: textindex) asLowercase)
ifTrue: [textindex := textindex + 1]]]
ifFalse: [(textindex + 2 <= aString size
and: [(aString at: textindex) asLowercase = $i
and: [(aString at: textindex + 1) asLowercase = $n
and: [(aString at: textindex + 2) asLowercase = $g]]])
ifTrue: [textindex := textindex + 3]
ifFalse: [^ false]]].
rightindex := rightindex + 1].
^ true!
----- Method: PhoneticRule>>species (in category 'comparing') -----
species
^PhoneticRule !
----- Method: PhoneticRule>>text (in category 'accessing') -----
text
^ text!
----- Method: PhoneticRule>>text: (in category 'accessing') -----
text: aString
text := aString!
----- Method: PhoneticRule>>textMatches:at: (in category 'private') -----
textMatches: aString at: anInteger
text size > (aString size - anInteger + 1) ifTrue: [^ false].
1 to: text size do: [ :each |
(text at: each) asLowercase = (aString at: anInteger + each - 1) asLowercase ifFalse: [^ false]].
^ true!
Object subclass: #PhoneticTranscriber
instanceVariableNames: 'phonemes rules lexicon'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Phonetics'!
!PhoneticTranscriber commentStamp: '<historical>' prior: 0!
My instances perform automatic words-to-phonemes transcription. (See the PhoneticRule class comment too.)
Each transcriber must have a collection of PhoneticRules, and optionally a lexicon. When a transcriber is asked for the transcription of a word, it searches for the word in the lexicon first, and if the word is not found then the rules are used.
Rules are made up of four parts: (1) left context pattern, (2) the text to match, (3) the right context pattern, and (4) the phonemes to substitute for the matched text.
The transcription procedure begins when a text is provided to a transcriber. For each unmatched letter in the word, look through the rules where the text to match starts with the letter in the word. If one matching rule is found, then the rule is applied, writing the corresponding phonemes in the output and moving forward to the next unmatched position. If no rule is found for a position in the text, then the unmatched position is logged. At the end of the transcription, the phonemes extracted are provided in a collection and so are the unmatched positions.
!
----- Method: PhoneticTranscriber class>>default (in category 'examples') -----
default
^ self english!
----- Method: PhoneticTranscriber class>>english (in category 'examples') -----
english
"Answer an english phonetic transcriber."
^ self new rules: PhoneticRule english; phonemes: PhonemeSet arpabet; lexicon: self englishLexicon!
----- Method: PhoneticTranscriber class>>englishLexicon (in category 'examples') -----
englishLexicon
^ Dictionary new
add: 'HOW' -> 'HH AW1';
add: 'YOU' -> 'Y UW1';
add: 'ARE' -> 'AA1 R';
add: 'DOING' -> 'D UW1 IH0 NG';
add: 'THIS' -> 'DH IH1 S';
add: 'IS' -> 'IH1 Z';
add: 'MY' -> 'M AY1';
add: 'HI' -> 'HH AY1';
add: 'VOICE' -> 'V OY1 S';
add: 'FAST' -> 'F AE1 S T';
add: 'SLOW' -> 'S L OW1';
add: 'I' -> 'AY1';
add: 'AM' -> 'AE1 M';
add: 'A' -> 'AH0';
add: 'AN' -> 'AE1 N';
add: 'LOW' -> 'L OW1';
add: 'SPEAKER' -> 'S P IY1 K ER0';
add: 'ANSWER' -> 'AE1 N S ER0';
add: 'RECEIVER' -> 'R AH0 S IY1 V ER0';
add: 'OBJECT' -> 'AA1 B JH EH0 K T';
add: 'READ' -> 'R IY1 D';
add: 'WRITE' -> 'R AY1 T';
add: 'SQUEAK' -> 'S K W IY1 K';
add: 'SMALLTALK' -> ' S M AO1 L T AO2 K';
add: 'CLASS' -> 'K L AE1 S';
add: 'WOMAN' -> 'W UH1 M AH0 N';
add: 'BICYCLIC' -> 'B AY1 S IH0 K L IH0 K';
add: 'LISTEN' -> 'L IH1 S AH0 N';
add: 'ZERO' -> 'Z IY1 R OW';
add: 'SEVEN' -> 'S EH1 V EH N';
add: 'ELEVEN' -> 'EH1 L EH1 V EH N';
add: 'SEVENTEEN' -> 'S EH1 V EH N T IY N';
add: 'SEVENTY' -> 'S EH1 V EH N T IH';
add: 'NINETEEN' -> 'N AH1 N T IY N';
add: 'NINETY' -> 'N AH1 N T IH';
yourself!
----- Method: PhoneticTranscriber class>>spanish (in category 'examples') -----
spanish
"Answer a spanish phonetic transcriber."
^ self new rules: PhoneticRule spanish; phonemes: PhonemeSet arpabet!
----- Method: PhoneticTranscriber>>lexicon (in category 'accessing') -----
lexicon
^ lexicon!
----- Method: PhoneticTranscriber>>lexicon: (in category 'accessing-private') -----
lexicon: aDictionary
lexicon := aDictionary!
----- Method: PhoneticTranscriber>>phonemes (in category 'accessing') -----
phonemes
^ phonemes!
----- Method: PhoneticTranscriber>>phonemes: (in category 'accessing-private') -----
phonemes: aPhonemeSet
phonemes := aPhonemeSet!
----- Method: PhoneticTranscriber>>rules (in category 'accessing') -----
rules
^ rules!
----- Method: PhoneticTranscriber>>rules: (in category 'accessing-private') -----
rules: aCollection
rules := aCollection!
----- Method: PhoneticTranscriber>>transcriptionOf: (in category 'computing') -----
transcriptionOf: aString
"Answer the phonetic transcription of the word in aString."
| rule string index transcription stressed |
(transcription := self tryLexicon: aString) isNil ifFalse: [^ transcription].
transcription := OrderedCollection new.
string := ' ', aString,' '.
index := 2.
[index < string size] whileTrue: [
rule := self rules
detect: [ :one | one matches: string at: index]
ifNone: [].
rule isNil
ifTrue: ["unmatched character" index := index+1]
ifFalse: [index := index + rule text size.
transcription addAll: rule phonemes]].
stressed := false.
^ transcription collect: [ :each |
(stressed not and: [each isVowel or: [each isDiphthong]])
ifTrue: [stressed := true. each stressed: 1] ifFalse: [each]]!
----- Method: PhoneticTranscriber>>tryLexicon: (in category 'computing-private') -----
tryLexicon: aWord
| string |
self lexicon isNil ifTrue: [^ nil].
string := self lexicon at: aWord asUppercase ifAbsent: [^ nil].
^ self phonemes transcriptionOf: string asLowercase!
Object subclass: #Phrase
instanceVariableNames: 'string words accent'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-TTS'!
!Phrase commentStamp: '<historical>' prior: 0!
My instances are phrases. They can carry a phrase accent ('H-' or 'L-') and a boundary tone ('H%', 'L%', '%H').!
----- Method: Phrase>>accent (in category 'accessing') -----
accent
^ accent!
----- Method: Phrase>>accent: (in category 'accessing') -----
accent: aString
accent := aString!
----- Method: Phrase>>accept: (in category 'accessing') -----
accept: anObject
anObject phrase: self!
----- Method: Phrase>>events (in category 'accessing') -----
events
| answer |
answer := CompositeEvent new.
self words do: [ :each | answer addAll: each events].
^ answer!
----- Method: Phrase>>eventsDo: (in category 'enumarating') -----
eventsDo: aBlock
self words do: [ :word | word eventsDo: aBlock]!
----- Method: Phrase>>lastSyllable (in category 'accessing') -----
lastSyllable
^ self words last lastSyllable!
----- Method: Phrase>>printOn: (in category 'printing') -----
printOn: aStream
self words do: [ :each | aStream print: each; space]!
----- Method: Phrase>>string (in category 'accessing') -----
string
^ string!
----- Method: Phrase>>string: (in category 'accessing') -----
string: aString
string := aString!
----- Method: Phrase>>syllablesDo: (in category 'enumarating') -----
syllablesDo: aBlock
self words do: [ :each | each syllables do: aBlock]!
----- Method: Phrase>>words (in category 'accessing') -----
words
^ words!
----- Method: Phrase>>words: (in category 'accessing') -----
words: aCollection
words := aCollection!
Object subclass: #Speaker
instanceVariableNames: 'pitch range loudness speed transcriber voice visitors'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-TTS'!
----- Method: Speaker class>>bicyclic (in category 'examples') -----
bicyclic
"
Speaker bicyclic say: 'This is my voice. I am a woman with bicyclic voice.'
"
^ self new
pitch: 200.0;
voice: (KlattVoice new diplophonia: 0.4; tract: 14.4)!
----- Method: Speaker class>>bigMan (in category 'examples') -----
bigMan
"
Speaker bigMan say: 'I am the child? No. I am the big man speaking.'
"
^ self new
pitch: 90.0;
range: 0.5;
voice: (KlattVoice new tract: 20)!
----- Method: Speaker class>>breathy (in category 'examples') -----
breathy
"
Speaker breathy say: 'This is my breathy voice.'
"
^ self new
pitch: 100.0;
voice: (KlattVoice new ro: 0.6; turbulence: 70)!
----- Method: Speaker class>>child (in category 'examples') -----
child
"
Speaker child say: 'Hello. I am a child speaking.'
"
^ self new
pitch: 320.0;
voice: (KlattVoice new tract: 12)!
----- Method: Speaker class>>creaky (in category 'examples') -----
creaky
"
Speaker creaky say: 'This is my creaky voice with hight jitter and shimmer.'
"
^ self new
pitch: 90.0;
speed: 0.5;
voice: (KlattVoice new jitter: 0.5; shimmer: 0.5)!
----- Method: Speaker class>>default (in category 'examples') -----
default
"
Speaker default say: 'This is the default voice.'
"
^ self new voice: KlattVoice new!
----- Method: Speaker class>>exorsist (in category 'examples') -----
exorsist
"
Speaker exorsist say: 'This is an scary voice. Boo.'
"
^ self new
pitch: 40.0;
speed: 0.5;
voice: (KlattVoice new tract: 10; diplophonia: 0.4; jitter: 0.3; shimmer: 0.5; turbulence: 50)!
----- Method: Speaker class>>fly (in category 'examples') -----
fly
"
Speaker fly say: 'Haaaaaalp.'
"
^ self new
pitch: 650.0;
loudness: 0.5;
speed: 0.8;
voice: (KlattVoice new flutter: 1.0; tract: 1)!
----- Method: Speaker class>>kid (in category 'examples') -----
kid
"
Speaker kid say: 'Do you like my voice? I am the kid speaking.'
"
^ self new
pitch: 170.0;
range: 0.4;
voice: (KlattVoice new tract: 16)!
----- Method: Speaker class>>man (in category 'examples') -----
man
"
Speaker man say: 'Listen to my voice. I am a man speaking.'
"
^ self default pitch: 90.0!
----- Method: Speaker class>>manWithEditor (in category 'examples-others') -----
manWithEditor
"
Speaker manWithEditor say: 'With this editor you can change my voice.'
"
^ self man edit!
----- Method: Speaker class>>manWithHead (in category 'examples-others') -----
manWithHead
"
Speaker manWithHead say: 'This is my voice. Can you see my lips?'
"
^ self man newHead!
----- Method: Speaker class>>notPressed (in category 'examples') -----
notPressed
"
Speaker notPressed say: 'This is a non pressed voice.'
"
^ self new
pitch: 100.0;
voice: (KlattVoice new ro: 0.9)!
----- Method: Speaker class>>pressed (in category 'examples') -----
pressed
"
Speaker pressed say: 'This is a pressed voice.'
"
^ self new
pitch: 100.0;
voice: (KlattVoice new ro: 0.1)!
----- Method: Speaker class>>whispery (in category 'examples') -----
whispery
"
Speaker whispery say: 'This is my whispery voice.'
"
^ self new
voice: (KlattVoice new breathiness: 1.0)!
----- Method: Speaker class>>woman (in category 'examples') -----
woman
"
Speaker woman say: 'Do you listen? I am a woman speaking.'
"
^ self new
pitch: 230.0;
range: 0.5;
speed: 0.7;
voice: (KlattVoice new flutter: 0.5; ro: 0.3; ra: 0.003; tract: 14.4)!
----- Method: Speaker>>clauseFromString: (in category 'parsing') -----
clauseFromString: aString
^ Clause new
string: aString;
phrases: ((aString findTokens: '!!?.,;()') collect: [ :each | self phraseFromString: each])!
----- Method: Speaker>>edit (in category 'editing') -----
edit
| answer buttons |
answer := (self findAVoice: KlattVoice) editor.
buttons := AlignmentMorph new listDirection: #leftToRight; color: answer color.
buttons
addMorphFront: (SimpleButtonMorph new target: self; actWhen: #buttonDown; actionSelector: #newHead; labelString: 'new head');
addMorphFront: (SimpleButtonMorph new target: self; actWhen: #buttonDown; actionSelector: #saySomething; labelString: 'test').
answer
addSliderForParameter: #speed target: self min: 0.1 max: 2.0 description: 'Speed';
addSliderForParameter: #loudness target: self min: 0.0 max: 1.0 description: 'Loudness';
addSliderForParameter: #range target: self min: 0.0 max: 1.0 description: 'Pitch Range';
addSliderForParameter: #pitch target: self min: 20.0 max: 800.0 description: 'Pitch';
addMorphFront: buttons;
openInWorld!
----- Method: Speaker>>eventsFromString: (in category 'parsing') -----
eventsFromString: aString
| clause |
clause := self clauseFromString: aString.
clause phrases do: [ :each | each lastSyllable events add: (PhoneticEvent new phoneme: self phonemes silence; duration: 0.1)].
clause lastSyllable events last duration: 0.5.
visitors do: [ :each | each speaker: self. clause accept: each].
clause eventsDo: [ :each | each loudness: self loudness].
^ clause events!
----- Method: Speaker>>findAVoice: (in category 'editing') -----
findAVoice: aClass
(self voice isKindOf: aClass) ifTrue: [^ self voice].
(self voice isKindOf: CompositeVoice)
ifTrue: [self voice do: [ :each | (each isKindOf: aClass) ifTrue: [^ each]]].
^ nil!
----- Method: Speaker>>initialize (in category 'initialization') -----
initialize
self pitch: 100.0; range: 0.3; loudness: 1.0; speed: 0.6; "normalizer: TextNormalizer new;" transcriber: PhoneticTranscriber default; visitors: {IntonationVisitor default. DurationsVisitor default. F0RenderingVisitor default}!
----- Method: Speaker>>loudness (in category 'accessing') -----
loudness
^ loudness!
----- Method: Speaker>>loudness: (in category 'accessing') -----
loudness: aNumber
loudness := aNumber!
----- Method: Speaker>>makeGestural (in category 'editing') -----
makeGestural
(self findAVoice: GesturalVoice) isNil ifFalse: [^ self].
self voice: self voice + GesturalVoice new!
----- Method: Speaker>>newHead (in category 'editing') -----
newHead
self makeGestural.
(self findAVoice: GesturalVoice) newHead!
----- Method: Speaker>>numberSignDelay (in category 'playing') -----
numberSignDelay
"Answer the number of milliseconds that a # symbol in the string given to say: will generate."
^200!
----- Method: Speaker>>phonemes (in category 'accessing') -----
phonemes
"Answer the phoneme set of the receiver."
^ self transcriber phonemes!
----- Method: Speaker>>phraseFromString: (in category 'parsing') -----
phraseFromString: aString
^ Phrase new
string: aString;
words: ((aString findTokens: ' !!?.,;()') collect: [ :each | self wordFromString: each])!
----- Method: Speaker>>pitch (in category 'accessing') -----
pitch
"Answer the average pitch."
^ pitch!
----- Method: Speaker>>pitch: (in category 'accessing') -----
pitch: aNumber
"Set the average pitch."
pitch := aNumber!
----- Method: Speaker>>range (in category 'accessing') -----
range
"Answer the pitch range (variation)."
^ range!
----- Method: Speaker>>range: (in category 'accessing') -----
range: aNumber
"Set the pitch range (variation)."
range := aNumber!
----- Method: Speaker>>say: (in category 'playing') -----
say: aString
"aString may contain characters and punctuation.
You may also include the # symbol in aString;
for each one of these, a 200msec delay will be generated."
| events stream string token delay |
stream := ReadStream
on: ((aString
copyReplaceAll: '-'
with: ' '
asTokens: false)
findTokens: '?# '
keep: '?#').
string := ''.
delay := 0.
[stream atEnd]
whileFalse: [token := stream next.
token = '#'
ifTrue: [ self voice playSilenceMSecs: self numberSignDelay.
delay := delay + self numberSignDelay ]
ifFalse: [string := string , ' ' , token.
(token = '?' or: [stream atEnd])
ifTrue: [
events := CompositeEvent new.
events addAll: (self eventsFromString: string).
events playOn: self voice delayed: delay.
delay := delay + (events duration * 1000).
string := '' ]]].
self voice flush!
----- Method: Speaker>>saySomething (in category 'editing') -----
saySomething
self say: #('This is my voice.' 'I am speaking.' 'Do you like my voice?' 'Listen to my voice.' 'Hello.' 'Hay. What are you doing?' 'How are you?' 'Is this my voice?' 'Are you there?' 'Help, please.' 'Howdy.' 'Ha ha he he hi.') atRandom!
----- Method: Speaker>>speed (in category 'accessing') -----
speed
^ speed!
----- Method: Speaker>>speed: (in category 'accessing') -----
speed: aNumber
speed := aNumber!
----- Method: Speaker>>syllabizationOf: (in category 'parsing') -----
syllabizationOf: phonemes
| syllable stream last answer |
answer := OrderedCollection new.
syllable := Syllable new phonemes: (OrderedCollection new: 4).
stream := ReadStream on: phonemes.
[stream atEnd]
whileFalse: [syllable phonemes add: (last := stream next).
(stream atEnd not and: [last isConsonant not and: [stream peek isConsonant]])
ifTrue: [answer add: syllable. syllable := Syllable new phonemes: (OrderedCollection new: 4)]].
syllable phonemes isEmpty ifFalse: [answer add: syllable].
^ answer!
----- Method: Speaker>>transcriber (in category 'accessing') -----
transcriber
^ transcriber!
----- Method: Speaker>>transcriber: (in category 'accessing') -----
transcriber: aPhoneticTranscriber
transcriber := aPhoneticTranscriber!
----- Method: Speaker>>visitors (in category 'accessing') -----
visitors
^ visitors!
----- Method: Speaker>>visitors: (in category 'accessing') -----
visitors: aCollection
visitors := aCollection!
----- Method: Speaker>>voice (in category 'accessing') -----
voice
^ voice!
----- Method: Speaker>>voice: (in category 'accessing') -----
voice: aVoice
voice := aVoice!
----- Method: Speaker>>wordFromString: (in category 'parsing') -----
wordFromString: aString
^ Word new
string: aString;
syllables: (self syllabizationOf: (self transcriber transcriptionOf: aString))!
Object subclass: #Syllable
instanceVariableNames: 'phonemes accent events'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-TTS'!
!Syllable commentStamp: '<historical>' prior: 0!
My instances are syllables. They can carry a pitch accent: 'H*', 'L*', etc.!
----- Method: Syllable>>accent (in category 'accessing') -----
accent
^ accent!
----- Method: Syllable>>accent: (in category 'accessing') -----
accent: aString
accent := aString!
----- Method: Syllable>>accept: (in category 'accessing') -----
accept: anObject
anObject syllable: self!
----- Method: Syllable>>events (in category 'accessing') -----
events
^ events ifNil: [events := CompositeEvent new addAll: (self phonemes collect: [ :each | PhoneticEvent new phoneme: each; duration: 0.080]); yourself]!
----- Method: Syllable>>eventsDo: (in category 'enumarating') -----
eventsDo: aBlock
self events do: aBlock!
----- Method: Syllable>>hasPrimaryStress (in category 'testing') -----
hasPrimaryStress
^ self stress = 1!
----- Method: Syllable>>hasSecondaryStress (in category 'testing') -----
hasSecondaryStress
^ self stress = 2!
----- Method: Syllable>>isAccented (in category 'testing') -----
isAccented
^ self accent notNil!
----- Method: Syllable>>phonemes (in category 'accessing') -----
phonemes
^ phonemes!
----- Method: Syllable>>phonemes: (in category 'accessing') -----
phonemes: aCollection
phonemes := aCollection!
----- Method: Syllable>>printOn: (in category 'printing') -----
printOn: aStream
| first |
aStream nextPut: $[.
first := true.
self phonemes do: [ :each |
first ifFalse: [aStream space].
aStream print: each.
first := false].
aStream nextPut: $]!
----- Method: Syllable>>stress (in category 'accessing') -----
stress
self phonemes do: [ :each | each stress > 0 ifTrue: [^ each stress]].
^ 0!
Object subclass: #UtteranceVisitor
instanceVariableNames: 'clause phrase word syllable'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-TTS'!
UtteranceVisitor subclass: #DurationsVisitor
instanceVariableNames: 'inherents lowers speed'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-TTS'!
!DurationsVisitor commentStamp: '<historical>' prior: 0!
This is an implementation of the Klatt rule system as described in chapter 9 of "From text to speech: The MITalk system", Allen, Hunnicutt and Klatt.!
----- Method: DurationsVisitor class>>default (in category 'examples') -----
default
| phonemes inherents lowers |
phonemes := PhonemeSet arpabet.
inherents := Dictionary new.
lowers := Dictionary new.
#(
('ae' 230.0 80.0)
('aa' 240.0 100.0)
('ax' 120.0 60.0)
('er' 180.0 80.0)
('ay' 250.0 150.0)
('aw' 240.0 100.0)
('b' 85.0 60.0)
('ch' 70.0 50.0)
('d' 75.0 50.0)
('dh' 50.0 30.0)
('eh' 150.0 70.0)
('ea' 270.0 130.0)
('ey' 180.0 100.0)
('f' 100.0 80.0)
('g' 80.0 60.0)
('hh' 80.0 20.0)
('ih' 135.0 40.0)
('ia' 230.0 100.0)
('iy' 155.0 55.0)
('jh' 70.0 50.0)
('k' 80.0 60.0)
('l' 80.0 40.0)
('m' 70.0 60.0)
('n' 60.0 50.0)
('ng' 95.0 60.0)
" ('oh' 240.0 130.0)"
('oy' 280.0 150.0)
('ao' 240.0 130.0)
('ow' 220.0 80.0)
('p' 90.0 50.0)
('r' 80.0 30.0)
('s' 105.0 60.0)
('sh' 105.0 80.0)
('t' 75.0 50.0)
('th' 90.0 60.0)
('uh' 210.0 70.0)
('ua' 230.0 110.0)
('ah' 160.0 60.0)
('uw' 230.0 150.0)
('v' 60.0 40.0)
('w' 80.0 60.0)
('y' 80.0 40.0)
('z' 75.0 40.0)
('zh' 70.0 40.0)
('sil' 100.0 100.0)) do: [ :each |
inherents at: (phonemes at: each first) put: each second / 1000.0.
lowers at: (phonemes at: each first) put: each last / 1000.0].
^ self inherents: inherents lowers: lowers!
----- Method: DurationsVisitor class>>inherents:lowers: (in category 'instance creation') -----
inherents: aDictionary lowers: anotherDictionary
^ self new inherents: aDictionary; lowers: anotherDictionary!
----- Method: DurationsVisitor>>clause: (in category 'visiting') -----
clause: aClause
| min |
super clause: aClause.
self rule2.
clause wordsDo: [ :eachWord |
eachWord events do: [ :each |
min := self lowerDurationAt: each phoneme.
eachWord isAccented ifFalse: [min := min / 2.0].
each duration: each duration + min / 1.4 / self speed]].
clause syllablesDo: [ :each | each events recomputeTimes]!
----- Method: DurationsVisitor>>defaultDurationFor: (in category 'accessing') -----
defaultDurationFor: aPhoneme
"Some hardcoded durations for phonemes."
aPhoneme isVoiced ifTrue: [^ 0.0565].
aPhoneme isUnvoiced ifTrue: [^ 0.0751].
aPhoneme isConsonant ifTrue: [^ 0.06508].
aPhoneme isDiphthong ifTrue: [^ 0.1362].
^ 0.0741!
----- Method: DurationsVisitor>>inherentDurationAt: (in category 'accessing') -----
inherentDurationAt: aPhoneme
^ self inherents at: aPhoneme ifAbsent: [Transcript show: ' default duration for ', aPhoneme name. self defaultDurationFor: aPhoneme]!
----- Method: DurationsVisitor>>inherents (in category 'accessing') -----
inherents
^ inherents!
----- Method: DurationsVisitor>>inherents: (in category 'accessing') -----
inherents: aDictionary
inherents := aDictionary!
----- Method: DurationsVisitor>>lowerDurationAt: (in category 'accessing') -----
lowerDurationAt: aPhoneme
^ self lowers at: aPhoneme ifAbsent: [self inherentDurationAt: aPhoneme]!
----- Method: DurationsVisitor>>lowers (in category 'accessing') -----
lowers
^ lowers!
----- Method: DurationsVisitor>>lowers: (in category 'accessing') -----
lowers: aDictionary
lowers := aDictionary!
----- Method: DurationsVisitor>>phrase: (in category 'visiting') -----
phrase: aPhrase
super phrase: aPhrase.
self rule3; rule3b!
----- Method: DurationsVisitor>>rule10 (in category 'rules') -----
rule10
"Rule 10: Shortening in clusters."
| current next previous stream |
phrase lastSyllable == syllable ifTrue: [^ self].
stream := ReadStream on: syllable events.
current := nil.
next := stream next.
[stream atEnd]
whileFalse: [previous := current.
current := next.
next := stream next.
current phoneme isVowel
ifTrue: [next phoneme isVowel
ifTrue: [current stretch: 1.2]
ifFalse: [(previous notNil and: [previous phoneme isVowel])
ifTrue: [current stretch: 0.7]]]
ifFalse: [next phoneme isConsonant
ifTrue: [(previous notNil and: [previous phoneme isConsonant])
ifTrue: [current stretch: 0.5]
ifFalse: [current stretch: 0.7]]
ifFalse: [(previous notNil and: [previous phoneme isConsonant])
ifTrue: [current stretch: 0.5]]]]!
----- Method: DurationsVisitor>>rule2 (in category 'rules') -----
rule2
"Rule 2: Clause Final Lengthening."
clause lastSyllable events stretch: 1.4!
----- Method: DurationsVisitor>>rule3 (in category 'rules') -----
rule3
"Rule 3: Non-phrase-final shortening.
Syllabic segments are shortened by 60 if not in a phrase-final syllable."
phrase syllablesDo: [ :each |
phrase lastSyllable == each
ifFalse: [each events do: [ :event | event phoneme isSyllabic ifTrue: [event stretch: 0.6]]]]!
----- Method: DurationsVisitor>>rule3b (in category 'rules') -----
rule3b
"A phrase-final postvocalic liquid or nasal is lengthened by 140"
phrase lastSyllable events do: [ :each | (each phoneme isNasal or: [each phoneme isLiquid]) ifTrue: [each stretch: 1.4]]!
----- Method: DurationsVisitor>>rule4 (in category 'rules') -----
rule4
"Rule 4: Non-word-final shortening.
Syllabic segments are shortened by 85 if not in a word-final syllable."
word lastSyllable == syllable ifTrue: [^ self].
syllable events do: [ :each | each phoneme isSyllabic ifTrue: [each stretch: 0.85]]!
----- Method: DurationsVisitor>>rule5 (in category 'rules') -----
rule5
"Rule 5: Polysyllabic Shortening.
Syllabic segments in a polysyllabic word are shortened by 80."
word isPolysyllabic ifFalse: [^ self].
syllable events do: [ :each | each phoneme isSyllabic ifTrue: [each stretch: 0.8]]!
----- Method: DurationsVisitor>>rule6 (in category 'rules') -----
rule6
"Rule 6: Non-initial-consonant shortening."
| nonInitial |
nonInitial := false.
word events do: [ :each |
(nonInitial and: [each phoneme isConsonant]) ifTrue: [each stretch: 0.85].
nonInitial := true]!
----- Method: DurationsVisitor>>rule7 (in category 'rules') -----
rule7
"Rule 7: Unstressed shortening."
word syllables
do: [ :each |
each stress > 0
ifFalse: [each events do: [ :event | event phoneme isSyllabic ifTrue: [event stretch: 0.5]].
each events first phoneme isSyllabic ifTrue: [each events first stretch: 0.7 / 0.5].
(each events last phoneme isSyllabic and: [each events size > 1]) ifTrue: [each events last stretch: 0.7 / 0.5]]]
!
----- Method: DurationsVisitor>>rule8 (in category 'rules') -----
rule8
"Rule 8: Lengthening for emphasis."
word isAccented
ifTrue: [word events do: [ :each | each phoneme isVowel ifTrue: [each stretch: 1.4]]]!
----- Method: DurationsVisitor>>rule9a (in category 'rules') -----
rule9a
"Rule 9a: Postvocalic context of vowels."
| events current next nextnext |
phrase lastSyllable == syllable ifTrue: [^ self].
events := syllable events.
1 to: events size do: [ :i |
current := events at: i.
next := i + 1 <= events size ifTrue: [(events at: i + 1) phoneme].
nextnext := i + 2 <= events size ifTrue: [(events at: i + 2) phoneme].
current stretch: (self rule9a: current phoneme next: next nextnext: nextnext)]!
----- Method: DurationsVisitor>>rule9a:next:nextnext: (in category 'rules') -----
rule9a: current next: next nextnext: nextnext
"Rule 9a: Postvocalic context of vowels."
current isVowel
ifTrue: [next isNil ifTrue: [^ 1.2].
nextnext isNil ifTrue: [^ self subRule9a: next].
(next isSonorant and: [nextnext isObstruent]) ifTrue: [^ self subRule9a: nextnext]]
ifFalse: [current isSonorant
ifTrue: [next isNil ifTrue: [^ 1.2].
next isObstruent ifTrue: [^ self subRule9a: next]]].
^ 1.0!
----- Method: DurationsVisitor>>rule9b (in category 'rules') -----
rule9b
"Rule 9b: Postvocalic context of vowels."
| events current next nextnext |
phrase lastSyllable == syllable ifFalse: [^ self].
events := syllable events.
1 to: events size do: [ :i |
current := events at: i.
next := i + 1 <= events size ifTrue: [(events at: i + 1) phoneme].
nextnext := i + 2 <= events size ifTrue: [(events at: i + 2) phoneme].
current stretch: 0.3 * (self rule9a: current phoneme next: next nextnext: nextnext) + 0.7]!
----- Method: DurationsVisitor>>speaker: (in category 'visiting') -----
speaker: aSpeaker
self speed: aSpeaker speed!
----- Method: DurationsVisitor>>speed (in category 'accessing') -----
speed
^ speed!
----- Method: DurationsVisitor>>speed: (in category 'accessing') -----
speed: aNumber
speed := aNumber!
----- Method: DurationsVisitor>>subRule9a: (in category 'rules') -----
subRule9a: aPhoneme
"Sub-rule 9a, independent of segment position."
aPhoneme isVoiced ifFalse: [^ aPhoneme isStop ifTrue: [0.7] ifFalse: [1.0]].
aPhoneme isFricative ifTrue: [^ 1.6].
aPhoneme isStop ifTrue: [^ 1.2].
aPhoneme isNasal ifTrue: [^ 0.85].
^ 1.0!
----- Method: DurationsVisitor>>syllable: (in category 'visiting') -----
syllable: aSyllable
super syllable: aSyllable.
syllable events do: [ :each | each duration: (self inherentDurationAt: each phoneme) - (self lowerDurationAt: each phoneme)].
self rule4; rule5; rule9a; rule9b; rule10!
----- Method: DurationsVisitor>>word: (in category 'visiting') -----
word: aWord
super word: aWord.
self rule6; rule7; rule8!
UtteranceVisitor subclass: #F0RenderingVisitor
instanceVariableNames: 'pitch range contour'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-TTS'!
----- Method: F0RenderingVisitor class>>default (in category 'examples') -----
default
^ self new!
----- Method: F0RenderingVisitor>>assignF0ToEvents (in category 'private') -----
assignF0ToEvents
| time |
time := 0.
clause events do: [ :each |
each pitchPoints: (self pitchesBetween: time and: time + each duration).
time := time + each duration]!
----- Method: F0RenderingVisitor>>boundaryStartTime (in category 'rendering-boundary tones') -----
boundaryStartTime
^ self timeForEvent: (phrase ifNil: [clause phrases last]) words last events first!
----- Method: F0RenderingVisitor>>boundaryStopTime (in category 'rendering-boundary tones') -----
boundaryStopTime
| lastEvent |
lastEvent := (phrase ifNil: [clause phrases last]) lastSyllable events last.
^ (self timeForEvent: lastEvent) + lastEvent duration!
----- Method: F0RenderingVisitor>>clause: (in category 'visiting') -----
clause: aClause
contour := CosineInterpolator new at: 0 put: pitch; yourself.
super clause: aClause.
self renderPhraseAccentOrBoundaryTone: clause accent.
self assignF0ToEvents!
----- Method: F0RenderingVisitor>>highPitch (in category 'accessing') -----
highPitch
^ pitch + (pitch * range)!
----- Method: F0RenderingVisitor>>initialStopTime (in category 'rendering-boundary tones') -----
initialStopTime
| lastEvent |
lastEvent := clause phrases first words first lastSyllable events last.
^ (self timeForEvent: lastEvent) + lastEvent duration!
----- Method: F0RenderingVisitor>>lowPitch (in category 'accessing') -----
lowPitch
^ pitch - (pitch * range)!
----- Method: F0RenderingVisitor>>phrase: (in category 'visiting') -----
phrase: aPhrase
super phrase: aPhrase.
self renderPhraseAccentOrBoundaryTone: phrase accent!
----- Method: F0RenderingVisitor>>phraseAccentStartTime (in category 'rendering-phrase accents') -----
phraseAccentStartTime
| syl |
syl := nil.
(phrase ifNil: [clause phrases last]) syllablesDo: [ :each | (syl isNil or: [syl isAccented]) ifTrue: [syl := each]].
^ self timeForEvent: syl events last!
----- Method: F0RenderingVisitor>>phraseAccentStopTime (in category 'rendering-phrase accents') -----
phraseAccentStopTime
| lastEvent |
lastEvent := (phrase ifNil: [clause phrases last]) lastSyllable events last.
^ (self timeForEvent: lastEvent) + lastEvent duration!
----- Method: F0RenderingVisitor>>pitchesBetween:and: (in category 'private') -----
pitchesBetween: t1 and: t2
| step |
step := (t2 - t1 / 0.035) asInteger + 1. "step small enough"
^ (t1 to: t2 by: t2 - t1 / step) collect: [ :each | each - t1 @ (contour at: each)]!
----- Method: F0RenderingVisitor>>renderHighBoundary (in category 'rendering-boundary tones') -----
renderHighBoundary
"Render a H% boundary tone."
| start stop |
start := self boundaryStartTime.
stop := self boundaryStopTime.
self time: start
startingF0: (contour at: start)
amplitude: self highPitch - (contour at: start)
duration: stop - start
peakPosition: stop - start
tilt: 1.0!
----- Method: F0RenderingVisitor>>renderHighInitial (in category 'rendering-boundary tones') -----
renderHighInitial
"Render a %H tone."
| start stop |
start := 0.
stop := self initialStopTime.
self time: start
startingF0: (contour at: start)
amplitude: self highPitch - (contour at: start) * 2
duration: stop - start
peakPosition: start
tilt: 0.0!
----- Method: F0RenderingVisitor>>renderHighPhraseAccent (in category 'rendering-phrase accents') -----
renderHighPhraseAccent
"Render a H- accent."
| start stop |
start := self phraseAccentStartTime.
stop := self phraseAccentStopTime.
self time: start
startingF0: (contour at: start)
amplitude: self highPitch - (contour at: start)
duration: stop - start
peakPosition: stop - start
tilt: 1.0!
----- Method: F0RenderingVisitor>>renderLowAccent (in category 'rendering-pitch accents') -----
renderLowAccent
"Render a L* accent."
| start stop peakPosition |
start := self syllableStartTime.
stop := self syllableStopTime.
peakPosition := (syllable events detect: [ :one | one phoneme isSyllabic] ifNone: [syllable events first]) duration / 2.0.
self time: start
startingF0: (contour at: start)
amplitude: (contour at: start) - self lowPitch
duration: stop - start
peakPosition: peakPosition
tilt: 0.0!
----- Method: F0RenderingVisitor>>renderLowBoundary (in category 'rendering-boundary tones') -----
renderLowBoundary
"Render a L% boundary tone."
| start stop |
start := self boundaryStartTime.
stop := self boundaryStopTime.
self time: start
startingF0: (contour at: start)
amplitude: (contour at: start) - self lowPitch
duration: stop - start
peakPosition: stop - start
tilt: -1.0!
----- Method: F0RenderingVisitor>>renderLowPhraseAccent (in category 'rendering-phrase accents') -----
renderLowPhraseAccent
"Render a L- accent."
| start stop |
start := self phraseAccentStartTime.
stop := self phraseAccentStopTime.
self time: start
startingF0: (contour at: start)
amplitude: (contour at: start) - self lowPitch
duration: stop - start
peakPosition: stop - start
tilt: -0.5!
----- Method: F0RenderingVisitor>>renderPeakAccent (in category 'rendering-pitch accents') -----
renderPeakAccent
"Render a H* accent."
| start stop peakPosition |
start := self syllableStartTime.
stop := self syllableStopTime.
peakPosition := (syllable events detect: [ :one | one phoneme isSyllabic] ifNone: [syllable events first]) duration / 2.0.
self time: start
startingF0: (contour at: start)
amplitude: self highPitch - (contour at: start)
duration: stop - start
peakPosition: peakPosition
tilt: 0.0!
----- Method: F0RenderingVisitor>>renderPhraseAccentOrBoundaryTone: (in category 'visiting') -----
renderPhraseAccentOrBoundaryTone: aStringOrNil
aStringOrNil isNil ifTrue: [^ self].
(aStringOrNil findTokens: ' ') do: [ :each |
each = 'H-' ifTrue: [self renderHighPhraseAccent].
each = 'L-' ifTrue: [self renderLowPhraseAccent].
each = 'H%' ifTrue: [self renderHighBoundary].
each = 'L%' ifTrue: [self renderLowBoundary].
each = '%H' ifTrue: [self renderHighInitial].
each = '%r' ifTrue: [self notYetImplemented]]!
----- Method: F0RenderingVisitor>>renderRisingPeakAccent (in category 'rendering-pitch accents') -----
renderRisingPeakAccent
"Render a L+H* accent."
self notYetImplemented!
----- Method: F0RenderingVisitor>>renderScoopedAccent (in category 'rendering-pitch accents') -----
renderScoopedAccent
"Render a L*+H accent."
self notYetImplemented!
----- Method: F0RenderingVisitor>>speaker: (in category 'visiting') -----
speaker: aSpeaker
pitch := aSpeaker pitch.
range := aSpeaker range!
----- Method: F0RenderingVisitor>>syllable: (in category 'visiting') -----
syllable: aSyllable
super syllable: aSyllable.
aSyllable isAccented ifFalse: [^ self].
aSyllable accent = 'H*' ifTrue: [^ self renderPeakAccent].
aSyllable accent = 'L*' ifTrue: [^ self renderLowAccent].
aSyllable accent = 'L*+H' ifTrue: [^ self renderScoopedAccent].
aSyllable accent = 'L+H*' ifTrue: [^ self renderRisingPeakAccent]!
----- Method: F0RenderingVisitor>>syllableStartTime (in category 'rendering-pitch accents') -----
syllableStartTime
^ self timeForEvent: syllable events first!
----- Method: F0RenderingVisitor>>syllableStopTime (in category 'rendering-pitch accents') -----
syllableStopTime
^ self syllableStartTime + syllable events duration!
----- Method: F0RenderingVisitor>>time:startingF0:amplitude:duration:peakPosition:tilt: (in category 'private') -----
time: time startingF0: startingF0 amplitude: amplitude duration: duration peakPosition: peakPosition tilt: tilt
| vowelStart riseAmplitude fallAmplitude |
vowelStart := self timeOfFirstVowelAfter: time.
riseAmplitude := tilt + 1.0 * amplitude / 2.0.
fallAmplitude := amplitude - riseAmplitude.
contour
x: time y: startingF0;
x: vowelStart + peakPosition y: ((startingF0 + riseAmplitude max: self lowPitch) min: self highPitch);
x: time + duration y: ((startingF0 + riseAmplitude - fallAmplitude max: self lowPitch) min: self highPitch);
commit!
----- Method: F0RenderingVisitor>>timeForEvent: (in category 'accessing') -----
timeForEvent: aVoiceEvent
| time |
time := 0.
clause eventsDo: [ :each | aVoiceEvent == each ifTrue: [^ time] ifFalse: [time := time + each duration]]!
----- Method: F0RenderingVisitor>>timeOfFirstVowelAfter: (in category 'private') -----
timeOfFirstVowelAfter: time
| currentTime |
currentTime := 0.
clause events do: [ :each |
(currentTime >= time and: [each phoneme isSyllabic]) ifTrue: [^ currentTime].
currentTime := currentTime + each duration].
^ time "if not found, answer the time itself"!
UtteranceVisitor subclass: #IntonationVisitor
instanceVariableNames: 'functionWords'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-TTS'!
----- Method: IntonationVisitor class>>default (in category 'examples') -----
default
^ self english!
----- Method: IntonationVisitor class>>english (in category 'examples') -----
english
^ self new functionWords: self englishFunctionWords!
----- Method: IntonationVisitor class>>englishFunctionWords (in category 'examples') -----
englishFunctionWords
^ #('a' 'about' 'above' 'across' 'after' 'ago' 'all' 'along' 'although' 'am' 'among'
'an' 'and' 'any' 'apart' 'are' 'aren''t' 'around' 'as' 'aside' 'at' 'away'
'back' 'be' 'because' 'been' 'before' 'behind' 'below' 'between' 'both'
'but' 'by' 'can' 'can''t' 'could' 'couldn''t' 'down' 'each' 'either' 'every'
'few' 'for' 'forever' 'forward' 'fro' 'from' 'has' 'hasn''t' 'have' 'haven''t'
'he' 'her' 'here' 'him' 'his' 'home' 'how' 'however' 'i' 'if' 'immediately'
'in' 'inside' 'is' 'it' 'its' 'least' 'less' 'like' 'little' 'many' 'more' 'most' 'much'
'my' 'neither' 'no' 'none' 'nor' 'not' 'now' 'of' 'off' 'on' 'once' 'only' 'or'
'our' 'out' 'outside' 'over' 'part' 'plenty' 'right' 'round' 'several' 'she'
'should' 'shouldn''t' 'since' 'so' 'some' 'than' 'that' 'the' 'their' 'theirs'
'then' 'there' 'these' 'they' 'this' 'those' 'though' 'through' 'till' 'to' 'together'
'unless' 'until' 'up' 'upon' 'was' 'wasn''t' 'we' 'were' 'weren''t' 'what'
'whatever' 'when' 'where' 'whereas' 'whether' 'which' 'while' 'who' 'whom'
'whose' 'why' 'will' 'with' 'without' 'would' 'wouldn''t' 'yet' 'you' 'your' 'yours'
) asSet!
----- Method: IntonationVisitor>>clause: (in category 'visiting') -----
clause: aClause
super clause: aClause.
self isYesNoQuestionClause ifTrue: [^ clause accent: 'L- H%'].
self isWHQuestionClause ifTrue: [^ clause accent: '%H H- L%'].
clause accent: 'L- L%' "it's a declarative phrase"!
----- Method: IntonationVisitor>>functionWords (in category 'accessing') -----
functionWords
^ functionWords!
----- Method: IntonationVisitor>>functionWords: (in category 'accessing') -----
functionWords: aCollection
functionWords := aCollection!
----- Method: IntonationVisitor>>isQuestionClause (in category 'visiting') -----
isQuestionClause
^ clause string includes: $?!
----- Method: IntonationVisitor>>isWHQuestionClause (in category 'visiting') -----
isWHQuestionClause
| firstWordString |
self isQuestionClause ifFalse: [^ false].
firstWordString := clause phrases first words first string asLowercase.
^ (firstWordString beginsWith: 'wh') or: [firstWordString = 'how']!
----- Method: IntonationVisitor>>isYesNoQuestionClause (in category 'visiting') -----
isYesNoQuestionClause
^ self isQuestionClause and: [self isWHQuestionClause not]!
----- Method: IntonationVisitor>>phrase: (in category 'visiting') -----
phrase: aPhrase
super phrase: aPhrase.
" phrase == clause phrases last ifFalse: [phrase accent: 'L- H%']"!
----- Method: IntonationVisitor>>word: (in category 'visiting') -----
word: aWord
| accent |
super word: aWord.
((self functionWords includes: word string asLowercase) and: [phrase words first ~~ word]) ifTrue: [^ self].
self isYesNoQuestionClause ifTrue: [accent := 'L*'] ifFalse: [accent := 'H*'].
(word syllables detect: [ :one | one stress > 0] ifNone: [word syllables first]) accent: accent!
----- Method: UtteranceVisitor>>clause: (in category 'visiting') -----
clause: aClause
clause := aClause.
clause phrases do: [ :each | each accept: self].
phrase := word := syllable := nil!
----- Method: UtteranceVisitor>>phrase: (in category 'visiting') -----
phrase: aPhrase
phrase := aPhrase.
phrase words do: [ :each | each accept: self].
word := syllable := nil!
----- Method: UtteranceVisitor>>speaker: (in category 'visiting') -----
speaker: aSpeaker
^ self!
----- Method: UtteranceVisitor>>syllable: (in category 'visiting') -----
syllable: aSyllable
syllable := aSyllable!
----- Method: UtteranceVisitor>>word: (in category 'visiting') -----
word: aWord
word := aWord.
word syllables do: [ :each | each accept: self].
syllable := nil!
Object subclass: #Voice
instanceVariableNames: 'name sound'
classVariableNames: 'Voices'
poolDictionaries: ''
category: 'Speech-Events'!
!Voice commentStamp: '<historical>' prior: 0!
I am an abstract class for speaking voices that know how to play VoiceEvents.!
Voice subclass: #CompositeVoice
instanceVariableNames: 'voices'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Events'!
----- Method: CompositeVoice>>add: (in category 'accessing') -----
add: aVoice
^ self voices add: aVoice!
----- Method: CompositeVoice>>do: (in category 'enumerating') -----
do: aBlock
self voices do: aBlock!
----- Method: CompositeVoice>>flush (in category 'playing') -----
flush
"Play all the events in the queue."
super flush.
self do: [ :each | each flush]!
----- Method: CompositeVoice>>initialize (in category 'initialization') -----
initialize
super initialize.
self voices: OrderedCollection new!
----- Method: CompositeVoice>>playGesturalEvent:at: (in category 'playing') -----
playGesturalEvent: event at: time
self do: [ :each | each playGesturalEvent: event at: time]!
----- Method: CompositeVoice>>playPhoneticEvent:at: (in category 'playing') -----
playPhoneticEvent: event at: time
self do: [ :each | each playPhoneticEvent: event at: time]!
----- Method: CompositeVoice>>reset (in category 'playing') -----
reset
"Reset the state of the receiver."
super reset.
self do: [ :each | each reset]!
----- Method: CompositeVoice>>voices (in category 'accessing') -----
voices
^ voices!
----- Method: CompositeVoice>>voices: (in category 'accessing') -----
voices: aCollection
voices := aCollection!
Voice subclass: #GesturalVoice
instanceVariableNames: 'head'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Gestures'!
!GesturalVoice commentStamp: '<historical>' prior: 0!
My instances are speaking voices with a head that acts in response to gestural events.!
----- Method: GesturalVoice>>face (in category 'accessing') -----
face
^ self head face!
----- Method: GesturalVoice>>head (in category 'accessing') -----
head
^ head!
----- Method: GesturalVoice>>head: (in category 'accessing') -----
head: aHeadMorph
head notNil ifTrue: [aHeadMorph position: head position. head delete].
head := aHeadMorph!
----- Method: GesturalVoice>>lips (in category 'accessing') -----
lips
^ self face lips!
----- Method: GesturalVoice>>newHead (in category 'accessing') -----
newHead
| m |
m := HeadMorph new.
self head: m.
m openInWorld.
^ m!
----- Method: GesturalVoice>>playGesturalEvent:at: (in category 'playing') -----
playGesturalEvent: event at: time
self head playEvent: event at: time!
----- Method: GesturalVoice>>playPhoneticEvent:at: (in category 'playing') -----
playPhoneticEvent: event at: time
(TalkGesturalEvent new phoneme: event phoneme) playOn: self at: time!
Voice subclass: #KlattVoice
instanceVariableNames: 'segments lastEvent lastEventTime left current right synthesizer patternFrame breathiness tract'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Klatt'!
!KlattVoice commentStamp: '<historical>' prior: 0!
My instances are voices that play PhoneticEvents using a KlattSynthesizer and KlattSegments. There are many controls to change voice personalities, such as vocal tract length, breathiness, jitter, shimmer and glottal pulse shape.!
----- Method: KlattVoice>>breathiness (in category 'personality') -----
breathiness
^ breathiness!
----- Method: KlattVoice>>breathiness: (in category 'personality') -----
breathiness: aNumber
breathiness := aNumber!
----- Method: KlattVoice>>currentFramesCount: (in category 'playing-private') -----
currentFramesCount: n
| answer |
answer := current left: left right: right speed: n / current duration asFloat pattern: self patternFrame.
answer size > 0 ifTrue: [self patternFrame: answer last].
^ answer!
----- Method: KlattVoice>>dBFromLinear: (in category 'playing-private') -----
dBFromLinear: aNumber
^ aNumber log / 2 log * 6.0 + 87.0!
----- Method: KlattVoice>>defaultPatternFrame (in category 'initialization') -----
defaultPatternFrame
^ KlattFrame default copy
f0: 133;
flutter: 0; jitter: 0; shimmer: 0; diplophonia: 0;
voicing: 60;
aspiration: 0;
friction: 0;
bypass: 0;
turbulence: 0;
ro: 0.5; rk: 0.25; ra: 0.01;
f1: 500; b1: 60;
f2: 1500; b2: 90;
f3: 2800; b3: 150;
f4: 3250; b4: 200;
f5: 3700; b5: 200;
f6: 4990; b6: 500;
fnz: 270; bnz: 100;
fnp: 270; bnp: 100;
b2f: 200;
b3f: 350;
b4f: 500;
b5f: 600;
b6f: 800;
anv: 0;
gain: 61!
----- Method: KlattVoice>>diplophonia (in category 'personality') -----
diplophonia
^ self patternFrame diplophonia!
----- Method: KlattVoice>>diplophonia: (in category 'personality') -----
diplophonia: aNumber
self patternFrame diplophonia: aNumber!
----- Method: KlattVoice>>durationsForEvent:segments: (in category 'playing-private') -----
durationsForEvent: event segments: segs
| scale |
scale := event duration / ((segs inject: 0 into: [ :result :each | result + each duration]) * 10 / 1000.0).
^ segs collect: [ :each | (each duration * scale) rounded]!
----- Method: KlattVoice>>edit (in category 'editing') -----
edit
self editor openInWorld!
----- Method: KlattVoice>>editor (in category 'editing') -----
editor
^ KlattFrameMorph new
frame: self patternFrame edit: #(flutter jitter shimmer diplophonia ro rk ra turbulence gain);
addSliderForParameter: #breathiness target: self min: 0.0 max: 1.0 description: 'Amount of breathiness';
addSliderForParameter: #tract target: self min: 10.0 max: 20.0 description: 'Vocal tract length (average male=17.3, average female=14.4)'!
----- Method: KlattVoice>>flush (in category 'playing') -----
flush
"Play all the events in the queue, and then reset."
| lastEventSegments |
lastEvent isNil
ifFalse: [lastEventSegments := self segments at: lastEvent phoneme ifAbsent: [self segments silence].
self playEvent: lastEvent segments: lastEventSegments boundary: self segments end at: lastEventTime].
super flush.
self reset!
----- Method: KlattVoice>>flutter (in category 'personality') -----
flutter
^ self patternFrame flutter!
----- Method: KlattVoice>>flutter: (in category 'personality') -----
flutter: aNumber
self patternFrame flutter: aNumber!
----- Method: KlattVoice>>formantScale (in category 'playing-private') -----
formantScale
self flag: #fixThis. "NOTE: this approximation is good only for vocal-tract lengths near 14.4 and 17.3 (and between them)... but it is certainly wrong for lengths such as 10 or 20."
^ (17.3 - self tract) / (17.3 - 14.4) * 0.175 + 1.0!
----- Method: KlattVoice>>initialize (in category 'initialization') -----
initialize
super initialize.
synthesizer := KlattSynthesizer new cascade: 0.
self segments: KlattSegmentSet arpabet.
self patternFrame: self defaultPatternFrame.
self breathiness: 0.0.
self tract: 17.3. "Set a male vocal tract."
self reset!
----- Method: KlattVoice>>jitter (in category 'personality') -----
jitter
^ self patternFrame jitter!
----- Method: KlattVoice>>jitter: (in category 'personality') -----
jitter: aNumber
self patternFrame jitter: aNumber!
----- Method: KlattVoice>>linearFromdB: (in category 'playing-private') -----
linearFromdB: aNumber
^ (2 raisedTo: (aNumber-87/6.0))!
----- Method: KlattVoice>>patternFrame (in category 'accessing-private') -----
patternFrame
^ patternFrame!
----- Method: KlattVoice>>patternFrame: (in category 'accessing-private') -----
patternFrame: aKlattFrame
patternFrame isNil ifTrue: [patternFrame := aKlattFrame. ^ self].
patternFrame replaceFrom: 1 to: patternFrame size with: aKlattFrame!
----- Method: KlattVoice>>phonemes (in category 'accessing') -----
phonemes
^ self segments phonemes!
----- Method: KlattVoice>>playEvent:frames:at: (in category 'playing-private') -----
playEvent: event frames: frames at: time
| frame breathyAspiration formantScale |
breathyAspiration := self dBFromLinear: (self linearFromdB: 68) * self breathiness.
formantScale := self formantScale.
1 to: frames size do: [ :each |
frame := frames at: each.
frame gain: (self dBFromLinear: (self linearFromdB: frame gain) * event loudness).
frame f0: (event pitchAt: each - 1 * event duration / frames size).
frame voicing: (self dBFromLinear: (self linearFromdB: frame voicing) * (1.0 - self breathiness)).
frame aspiration: (frame aspiration max: breathyAspiration).
frame
f1: frame f1 * formantScale;
f2: frame f2 * formantScale;
f3: frame f3 * formantScale;
f4: frame f4 * formantScale;
f5: frame f5 * formantScale;
f6: frame f6 * formantScale].
"Transcript cr; show: (event duration * 1000 / frames size) printString."
synthesizer millisecondsPerFrame: event duration * 1000 / frames size.
self playBuffer: (synthesizer samplesFromFrames: frames) at: time!
----- Method: KlattVoice>>playEvent:segments:boundary:at: (in category 'playing-private') -----
playEvent: event segments: segs boundary: boundarySegment at: time
| frames stream dur durations |
frames := OrderedCollection new.
stream := ReadStream on: segs.
durations := ReadStream on: (self durationsForEvent: event segments: segs).
[stream atEnd]
whileFalse: [current := stream next.
dur := durations next.
dur > 0
ifTrue: [right := stream atEnd ifTrue: [boundarySegment] ifFalse: [stream peek].
frames addAll: (self currentFramesCount: dur)].
left := current].
frames isEmpty ifTrue: [^ self].
self playEvent: event frames: frames at: time!
----- Method: KlattVoice>>playPhoneticEvent:at: (in category 'playing') -----
playPhoneticEvent: event at: time
| lastEventSegments boundarySegment |
"Play an event."
lastEvent isNil
ifFalse: [lastEventSegments := self segments at: lastEvent phoneme ifAbsent: [self segments silence].
boundarySegment := (self segments at: event phoneme ifAbsent: [self segments silence]) first.
self playEvent: lastEvent segments: lastEventSegments boundary: boundarySegment at: lastEventTime].
lastEvent := event.
lastEventTime := time!
----- Method: KlattVoice>>ra (in category 'personality') -----
ra
^ self patternFrame ra!
----- Method: KlattVoice>>ra: (in category 'personality') -----
ra: aNumber
self patternFrame ra: aNumber!
----- Method: KlattVoice>>reset (in category 'playing') -----
reset
"Reset the state of the receiver."
super reset.
lastEvent := lastEventTime := nil.
current := right := left := self segments end!
----- Method: KlattVoice>>rk (in category 'personality') -----
rk
^ self patternFrame rk!
----- Method: KlattVoice>>rk: (in category 'personality') -----
rk: aNumber
self patternFrame rk: aNumber!
----- Method: KlattVoice>>ro (in category 'personality') -----
ro
^ self patternFrame ro!
----- Method: KlattVoice>>ro: (in category 'personality') -----
ro: aNumber
self patternFrame ro: aNumber!
----- Method: KlattVoice>>samplingRate (in category 'accessing') -----
samplingRate
^ self synthesizer samplingRate!
----- Method: KlattVoice>>segments (in category 'accessing') -----
segments
^ segments!
----- Method: KlattVoice>>segments: (in category 'accessing') -----
segments: aKlattSegmentSet
segments := aKlattSegmentSet!
----- Method: KlattVoice>>shimmer (in category 'personality') -----
shimmer
^ self patternFrame shimmer!
----- Method: KlattVoice>>shimmer: (in category 'personality') -----
shimmer: aNumber
self patternFrame shimmer: aNumber!
----- Method: KlattVoice>>synthesizer (in category 'accessing') -----
synthesizer
^ synthesizer!
----- Method: KlattVoice>>tract (in category 'personality') -----
tract
^ tract!
----- Method: KlattVoice>>tract: (in category 'personality') -----
tract: aNumber
tract := aNumber!
----- Method: KlattVoice>>turbulence (in category 'personality') -----
turbulence
^ self patternFrame turbulence!
----- Method: KlattVoice>>turbulence: (in category 'personality') -----
turbulence: aNumber
self patternFrame turbulence: aNumber!
----- Method: Voice class>>addVoice: (in category 'accessing') -----
addVoice: aVoice
^ self voices add: aVoice!
----- Method: Voice class>>default (in category 'instance creation') -----
default
self voices isEmpty ifTrue: [^ KlattVoice new].
^ self voices detect: [ :one | one name = 'Kurt']
ifNone: [self voices detect: [ :one | one samplingRate >= 16000]
ifNone: [self voices anyOne]]!
----- Method: Voice class>>doesNotUnderstand: (in category 'accessing') -----
doesNotUnderstand: aMessage
self voices do: [ :each | each name asLowercase = aMessage selector asString ifTrue: [^ each]].
^ super doesNotUnderstand: aMessage!
----- Method: Voice class>>initialize (in category 'class initialization') -----
initialize
"
Voice initialize
"
Voices := Set new!
----- Method: Voice class>>named: (in category 'accessing') -----
named: aString
^ self voices detect: [ :one | one name = aString]!
----- Method: Voice class>>voices (in category 'accessing') -----
voices
^ Voices!
----- Method: Voice>>+ (in category 'converting') -----
+ aVoice
"Answer the composition of the receiver with the argument."
^ CompositeVoice new add: self; add: aVoice; yourself!
----- Method: Voice>>flush (in category 'playing') -----
flush
"Play all the events in the queue."
sound notNil ifTrue: [sound done: true; play. sound := nil]!
----- Method: Voice>>initialize (in category 'initialization') -----
initialize
name := 'anonymous'!
----- Method: Voice>>name (in category 'accessing') -----
name
^ name!
----- Method: Voice>>name: (in category 'accessing') -----
name: aString
name := aString!
----- Method: Voice>>playBuffer:at: (in category 'playing') -----
playBuffer: buffer at: time
| tail |
tail := SampledSound samples: buffer samplingRate: self samplingRate.
sound isNil
ifTrue: [sound := QueueSound new startTime: time - SoundPlayer bufferMSecs.
sound add: tail; play]
ifFalse: [sound add: tail]!
----- Method: Voice>>playGesturalEvent:at: (in category 'playing') -----
playGesturalEvent: event at: time
^ self!
----- Method: Voice>>playPhoneticEvent:at: (in category 'playing') -----
playPhoneticEvent: event at: time
^ self!
----- Method: Voice>>playSilenceMSecs: (in category 'playing') -----
playSilenceMSecs: msecs
Transcript cr; show: 'silence ', msecs printString, 'msecs'.
sound isNil ifTrue: [^ self].
sound add: (RestSound dur: msecs / 1000.0)!
----- Method: Voice>>printOn: (in category 'printing') -----
printOn: aStream
aStream nextPutAll: self class name; nextPutAll: ' ('; nextPutAll: self name; nextPut: $)!
----- Method: Voice>>reset (in category 'playing') -----
reset
"Reset the state of the receiver."
sound notNil ifTrue: [sound done: true. sound := nil]!
----- Method: Voice>>sound (in category 'accessing') -----
sound
^ sound!
Object subclass: #VoiceEvent
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Events'!
!VoiceEvent commentStamp: '<historical>' prior: 0!
I am an abstract class for all events to be played on speaking Voices, such as PhoneticEvents or GesturalEvents.!
VoiceEvent subclass: #CompositeEvent
instanceVariableNames: 'timedEvents'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Events'!
----- Method: CompositeEvent class>>new (in category 'instance creation') -----
new
^ self new: 10!
----- Method: CompositeEvent class>>new: (in category 'instance creation') -----
new: anInteger
^ self basicNew initialize: anInteger!
----- Method: CompositeEvent>>add: (in category 'accessing') -----
add: aVoiceEvent
^ self add: aVoiceEvent at: self lastTime!
----- Method: CompositeEvent>>add:at: (in category 'accessing') -----
add: aVoiceEvent at: time
^ self timedEvents add: time -> aVoiceEvent!
----- Method: CompositeEvent>>add:delayed: (in category 'accessing') -----
add: aVoiceEvent delayed: time
^ self add: aVoiceEvent at: self lastTime + time!
----- Method: CompositeEvent>>addAll: (in category 'accessing') -----
addAll: aCollection
aCollection do: [ :each | self add: each].
^ aCollection!
----- Method: CompositeEvent>>asArray (in category 'converting') -----
asArray
^ (1 to: self size) collect: [ :each | self at: each]!
----- Method: CompositeEvent>>asPHOString (in category 'converting') -----
asPHOString
| stream |
stream := WriteStream on: String new.
self do: [ :each | stream nextPutAll: each asPHOString; nextPut: Character cr].
^ stream contents!
----- Method: CompositeEvent>>at: (in category 'accessing') -----
at: anInteger
^ (self timedEvents at: anInteger) value!
----- Method: CompositeEvent>>compress: (in category 'transforming') -----
compress: aNumber
self stretch: aNumber reciprocal!
----- Method: CompositeEvent>>copy (in category 'copying') -----
copy
| answer |
answer := self class new: self size.
self timedEvents do: [ :each | answer add: each value copy at: each key].
^ answer!
----- Method: CompositeEvent>>delay: (in category 'transforming') -----
delay: time
self timedEvents do: [ :each | each key: each key + time]!
----- Method: CompositeEvent>>detect: (in category 'enumerating') -----
detect: aBlock
self detect: aBlock ifNone: [self error: 'event not found']!
----- Method: CompositeEvent>>detect:ifNone: (in category 'enumerating') -----
detect: aBlock ifNone: exceptionBlock
self do: [ :each | (aBlock value: each) ifTrue: [^ each]].
^ exceptionBlock value!
----- Method: CompositeEvent>>do: (in category 'enumerating') -----
do: aBlock
self timedEvents do: [ :each | aBlock value: each value]!
----- Method: CompositeEvent>>duration (in category 'accessing') -----
duration
"Answer the duration (in seconds) of the receiver."
^ self lastTime / 1000.0!
----- Method: CompositeEvent>>first (in category 'accessing') -----
first
^ self at: 1!
----- Method: CompositeEvent>>initialize: (in category 'initialization') -----
initialize: anInteger
timedEvents := SortedCollection new: anInteger!
----- Method: CompositeEvent>>isEmpty (in category 'testing') -----
isEmpty
^ self timedEvents isEmpty!
----- Method: CompositeEvent>>last (in category 'accessing') -----
last
^ self at: self size!
----- Method: CompositeEvent>>lastTime (in category 'accessing') -----
lastTime
| last |
self isEmpty ifTrue: [^ 0].
last := self timedEvents last.
^ last key + (last value duration * 1000) rounded!
----- Method: CompositeEvent>>pitchBy: (in category 'transforming') -----
pitchBy: aNumber
self do: [ :each | each pitchBy: aNumber]!
----- Method: CompositeEvent>>playOn:at: (in category 'playing') -----
playOn: aVoice at: time
self timedEvents do: [ :each | each value playOn: aVoice at: each key + time].
aVoice flush!
----- Method: CompositeEvent>>recomputeTimes (in category 'private') -----
recomputeTimes
| oldTimedEvents |
oldTimedEvents := timedEvents.
timedEvents := SortedCollection new: oldTimedEvents size.
oldTimedEvents do: [ :each | self add: each value]!
----- Method: CompositeEvent>>size (in category 'accessing') -----
size
^ self timedEvents size!
----- Method: CompositeEvent>>stretch: (in category 'transforming') -----
stretch: aNumber
self do: [ :each | each stretch: aNumber].
self timedEvents do: [ :each | each key: (each key * aNumber) rounded]!
----- Method: CompositeEvent>>timedEvents (in category 'accessing-private') -----
timedEvents
^ timedEvents!
----- Method: CompositeEvent>>timedEvents: (in category 'accessing-private') -----
timedEvents: aCollection
timedEvents := aCollection!
VoiceEvent subclass: #GesturalEvent
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Events'!
GesturalEvent subclass: #GazeGesturalEvent
instanceVariableNames: 'point'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Events'!
----- Method: GazeGesturalEvent>>actOn: (in category 'playing') -----
actOn: aHeadMorph
aHeadMorph face lookAt: self point!
----- Method: GazeGesturalEvent>>point (in category 'accessing') -----
point
^ point!
----- Method: GazeGesturalEvent>>point: (in category 'accessing') -----
point: aPoint
point := aPoint!
----- Method: GazeGesturalEvent>>printOn: (in category 'printing') -----
printOn: aStream
aStream nextPutAll: 'look at '; print: self point!
----- Method: GesturalEvent>>actOn: (in category 'playing') -----
actOn: aHeadMorph
self subclassResponsibility!
----- Method: GesturalEvent>>isGestural (in category 'testing') -----
isGestural
^ true!
----- Method: GesturalEvent>>playOn:at: (in category 'playing') -----
playOn: aVoice at: time
aVoice playGesturalEvent: self at: time!
----- Method: GesturalEvent>>voice (in category 'accessing') -----
voice
"Answer the default voice for the reciever."
^ Voice voices detect: [ :one | one class == GesturalVoice] ifNone: [super voice]!
GesturalEvent subclass: #MoodGesturalEvent
instanceVariableNames: 'state'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Events'!
----- Method: MoodGesturalEvent>>actOn: (in category 'playing') -----
actOn: aHeadMorph
aHeadMorph face perform: self state!
----- Method: MoodGesturalEvent>>printOn: (in category 'printing') -----
printOn: aStream
aStream nextPutAll: 'set ', self state, ' mood'!
----- Method: MoodGesturalEvent>>state (in category 'accessing') -----
state
^ state!
----- Method: MoodGesturalEvent>>state: (in category 'accessing') -----
state: aSymbol
state := aSymbol asSymbol!
GesturalEvent subclass: #TalkGesturalEvent
instanceVariableNames: 'phoneme'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Events'!
----- Method: TalkGesturalEvent>>actOn: (in category 'playing') -----
actOn: aHeadMorph
aHeadMorph face lips articulate: self phoneme!
----- Method: TalkGesturalEvent>>phoneme (in category 'accessing') -----
phoneme
^ phoneme!
----- Method: TalkGesturalEvent>>phoneme: (in category 'accessing') -----
phoneme: aPhoneme
phoneme := aPhoneme!
----- Method: TalkGesturalEvent>>printOn: (in category 'printing') -----
printOn: aStream
aStream nextPutAll: 'articulate '; print: self phoneme!
VoiceEvent subclass: #PhoneticEvent
instanceVariableNames: 'phoneme pitchPoints duration loudness'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-Events'!
!PhoneticEvent commentStamp: '<historical>' prior: 0!
My instances are events for a Voice.!
----- Method: PhoneticEvent>>asPHOString (in category 'converting') -----
asPHOString
| stream |
stream := WriteStream on: String new.
stream
nextPutAll: (PhonemeSet arpabetToSampa at: self phoneme); space;
print: (self duration * 1000) rounded.
self pitchPoints do: [ :each | stream space; print: (each x * 1000) rounded; space; print: each y rounded].
^ stream contents!
----- Method: PhoneticEvent>>averagePitch (in category 'accessing') -----
averagePitch
| sum previous |
self pitchPoints size = 1 ifTrue: [^ self pitchPoints first y].
sum := 0.0.
self pitchPoints do: [ :each |
previous isNil ifFalse: [sum := (each y + previous y) / 2.0 * (each x - previous x) + sum].
previous := each].
sum := previous y * (self duration - previous x) + sum.
^ sum / self duration!
----- Method: PhoneticEvent>>copy (in category 'copying') -----
copy
^ super copy pitchPoints: self pitchPoints copy!
----- Method: PhoneticEvent>>duration (in category 'accessing') -----
duration
"Answer the duration (in seconds) of the receiver."
^ duration!
----- Method: PhoneticEvent>>duration: (in category 'accessing') -----
duration: aNumber
"Set the duration of the receiver (in seconds)."
((pitchPoints isNil or: [duration isNil]) or: [duration = 0])
ifFalse: [pitchPoints := pitchPoints collect: [ :each | each x / duration * aNumber @ each y]].
duration := aNumber!
----- Method: PhoneticEvent>>hasPitch (in category 'testing') -----
hasPitch
"Answer true if there is a pitch contour specified for the receiver."
^ pitchPoints notNil!
----- Method: PhoneticEvent>>isPhonetic (in category 'testing') -----
isPhonetic
^ true!
----- Method: PhoneticEvent>>loudness (in category 'accessing') -----
loudness
^ loudness!
----- Method: PhoneticEvent>>loudness: (in category 'accessing') -----
loudness: aNumber
loudness := aNumber!
----- Method: PhoneticEvent>>phoneme (in category 'accessing') -----
phoneme
^ phoneme!
----- Method: PhoneticEvent>>phoneme: (in category 'accessing') -----
phoneme: aPhoneme
phoneme := aPhoneme!
----- Method: PhoneticEvent>>pitch: (in category 'accessing') -----
pitch: aNumber
self pitchPoints: aNumber!
----- Method: PhoneticEvent>>pitchApply: (in category 'transforming') -----
pitchApply: aBlock
"Apply aBlock to the pitch points in the receiver."
self hasPitch ifFalse: [^ self].
pitchPoints := pitchPoints collect: aBlock!
----- Method: PhoneticEvent>>pitchAt: (in category 'accessing') -----
pitchAt: time
"Answer the pitch of the receiver at a given time. (Do linear interpolation.)"
| xVal count x1 x2 y1 y2 |
pitchPoints isNil ifTrue: [^ nil].
xVal := pitchPoints first x.
count := 1.
[xVal < time]
whileTrue: [count := count + 1.
count > pitchPoints size ifTrue: [^ pitchPoints last y].
xVal := (pitchPoints at: count) x].
xVal = time ifTrue: [^ (pitchPoints at: count) y].
count = 1 ifTrue: [^ pitchPoints first y].
x1 := (pitchPoints at: count - 1) x.
x2 := (pitchPoints at: count) x.
y1 := (pitchPoints at: count - 1) y.
y2 := (pitchPoints at: count) y.
^ (time - x1) / (x2 - x1) * (y2 - y1) + y1!
----- Method: PhoneticEvent>>pitchAt:put: (in category 'accessing') -----
pitchAt: time put: aNumber
"Set the pitch of the receiver at a given time."
pitchPoints isNil ifTrue: [pitchPoints := Array with: time @ aNumber. ^ self].
pitchPoints := pitchPoints copyWith: time @ aNumber!
----- Method: PhoneticEvent>>pitchBy: (in category 'transforming') -----
pitchBy: aNumber
"Multiply the receiver's pitch contour by aNumber."
self hasPitch ifFalse: [^ self].
pitchPoints := pitchPoints collect: [ :each | each x @ (each y * aNumber)]!
----- Method: PhoneticEvent>>pitchPoints (in category 'accessing-private') -----
pitchPoints
^ pitchPoints!
----- Method: PhoneticEvent>>pitchPoints: (in category 'accessing-private') -----
pitchPoints: p
pitchPoints := p isNumber
ifTrue: [((0.0 to: duration by: 0.035) collect: [ :time | time @ p])]
ifFalse: [p first isPoint ifTrue: [p] ifFalse: [(p collect: [ :each | each first @ each last])]]!
----- Method: PhoneticEvent>>playOn:at: (in category 'playing') -----
playOn: aVoice at: time
aVoice playPhoneticEvent: self at: time!
----- Method: PhoneticEvent>>printOn: (in category 'printing') -----
printOn: aStream
| first |
aStream nextPutAll: '#('; print: phoneme; space; print: loudness; space; print: duration.
self pitchPoints isNil ifTrue: [aStream nextPut: $). ^ self].
aStream nextPutAll: ' #('.
first := true.
self pitchPoints do: [ :each |
first ifFalse: [aStream space].
aStream print: each x; space; print: each y.
first := false].
aStream nextPutAll: '))'!
----- Method: PhoneticEvent>>stretch: (in category 'transforming') -----
stretch: aNumber
self duration: self duration * aNumber!
----- Method: PhoneticEvent>>transposeBy: (in category 'transforming') -----
transposeBy: aNumber
"Add the given step to the receiver's pitch."
pitchPoints := pitchPoints collect: [ :each | each x @ (each y + aNumber)]!
----- Method: VoiceEvent>>compress: (in category 'transforming') -----
compress: aNumber
self stretch: 1.0 / aNumber!
----- Method: VoiceEvent>>duration (in category 'accessing') -----
duration
"Answer the duration (in seconds) of the receiver."
^ 0!
----- Method: VoiceEvent>>isGestural (in category 'testing') -----
isGestural
^ false!
----- Method: VoiceEvent>>isPhonetic (in category 'testing') -----
isPhonetic
^ false!
----- Method: VoiceEvent>>play (in category 'playing') -----
play
^ self playOn: self voice!
----- Method: VoiceEvent>>playAt: (in category 'playing') -----
playAt: time
^ self playOn: self voice at: time!
----- Method: VoiceEvent>>playDelayed: (in category 'playing') -----
playDelayed: delay
self playAt: Time millisecondClockValue + delay!
----- Method: VoiceEvent>>playOn: (in category 'playing') -----
playOn: aVoice
self playOn: aVoice at: Time millisecondClockValue!
----- Method: VoiceEvent>>playOn:at: (in category 'playing') -----
playOn: aVoice at: time
self subclassResponsibility!
----- Method: VoiceEvent>>playOn:delayed: (in category 'playing') -----
playOn: aVoice delayed: delay
self playOn: aVoice at: Time millisecondClockValue + delay!
----- Method: VoiceEvent>>stretch: (in category 'transforming') -----
stretch: aNumber
^ self!
----- Method: VoiceEvent>>voice (in category 'accessing') -----
voice
"Answer the default voice for the receiver."
^ Voice default!
Object subclass: #Word
instanceVariableNames: 'string syllables'
classVariableNames: ''
poolDictionaries: ''
category: 'Speech-TTS'!
----- Method: Word>>accept: (in category 'accessing') -----
accept: anObject
anObject word: self!
----- Method: Word>>events (in category 'accessing') -----
events
| answer |
answer := CompositeEvent new.
self syllables do: [ :each | answer addAll: each events].
^ answer!
----- Method: Word>>eventsDo: (in category 'enumerating') -----
eventsDo: aBlock
self syllables do: [ :syllable | syllable eventsDo: aBlock]!
----- Method: Word>>isAccented (in category 'testing') -----
isAccented
^ (self syllables detect: [ :one | one isAccented] ifNone: []) notNil!
----- Method: Word>>isPolysyllabic (in category 'testing') -----
isPolysyllabic
^ self syllables size > 1!
----- Method: Word>>lastSyllable (in category 'accessing') -----
lastSyllable
^ self syllables last!
----- Method: Word>>printOn: (in category 'printing') -----
printOn: aStream
aStream nextPutAll: (self isAccented ifTrue: [self string asUppercase] ifFalse: [self string])!
----- Method: Word>>string (in category 'accessing') -----
string
^ string!
----- Method: Word>>string: (in category 'accessing') -----
string: aString
string := aString!
----- Method: Word>>syllables (in category 'accessing') -----
syllables
^ syllables!
----- Method: Word>>syllables: (in category 'accessing') -----
syllables: aCollection
syllables := aCollection!
1
0
Christoph Thiede uploaded a new version of Kernel to project The Treated Inbox:
http://source.squeak.org/treated/Kernel-ct.1320.mcz
==================== Summary ====================
Name: Kernel-ct.1320
Author: ct
Time: 22 March 2020, 8:25:11.31556 pm
UUID: d08c3179-cda9-2944-b692-9ef1b00d7742
Ancestors: Kernel-eem.1319
Proposal: Add convenience method #runSimulated to BlockClosure. While this should not be used in production, it can be helpful for exploring and testing the simulation machinery.
=============== Diff against Kernel-eem.1319 ===============
Item was added:
+ ----- Method: BlockClosure>>runSimulated (in category 'system simulation') -----
+ runSimulated
+
+ ^ Context runSimulated: self!
1
0
Eliot Miranda uploaded a new version of SystemReporter to project The Trunk:
http://source.squeak.org/trunk/SystemReporter-eem.54.mcz
==================== Summary ====================
Name: SystemReporter-eem.54
Author: eem
Time: 2 January 2022, 8:21:30.381231 pm
UUID: 3719df64-bb5c-403b-be71-44d3b86c7865
Ancestors: SystemReporter-eem.53
Add a description of the new primitive suspend feature flag
=============== Diff against SystemReporter-eem.53 ===============
Item was changed:
----- Method: SystemReporter>>reportVMParameters: (in category 'reporting') -----
reportVMParameters: aStream
| vmParameters isStack isCog isSpur |
self header: 'Virtual Machine Parameters' on: aStream.
vmParameters := Smalltalk vm getVMParameters.
isStack := (vmParameters at: 42 ifAbsent: [0]) ~= 0. "42 = number of stack pages available"
isCog := isStack and: [(vmParameters at: 46) ~= 0]. "46 is machine code zone size"
isSpur := isStack and: [(vmParameters at: 41) anyMask: 2r10000]. "41 is imageFormatVersion for the VM; bit 16 is the Spur bit"
(isSpur
ifFalse:
[#( 1 'size of old space'
2 'size of young+old space'
3 'size of memory'
4 'allocationCount'
5 'allocations between GCs')]
ifTrue:
[#( 1 'size of old space'
2 'used bytes in new space (used eden + used past space)'
3 'size of heap')]),
#( 6 'survivor count tenuring threshold'
7 'full GCs since startup'
8 'total milliseconds in full GCs since startup'),
(isSpur
ifFalse: [#( 9 'incremental GCs since startup'
10 'total milliseconds in incremental GCs since startup'
11 'tenures of surving objects since startup'),
{12 to: 19. 'specific to the translating VM'}]
ifTrue: [#( 9 'scavenging GCs since startup'
10 'total milliseconds in scavenging GCs since startup'
11 'tenures of surving objects since startup'
12 'event trace mask (for debugging input events)'
13 'VM ticker start microseconds (Croquet/QwaqVM)'
14 'VM ticker count (Croquet/QwaqVM)'
15 'VM ticker call count (Croquet/QwaqVM)'
16 'total microseconds in idle since startup'
17 'proportion of code zone available for use (Sista VMs only; read-write)'
18 'total milliseconds in full GC compaction since startup (a portion of parameter 8)'
19 'scavenge threshold; the effective size of eden')]),
#( 20 'utc microseconds at startup (if non-zero)'
21 'root/remembered table size (occupancy)'
22 'root/remembered table overflows since startup'
23 'bytes of extra memory to reserve for VM buffers, plugins, etc.'
24 'free memory threshold above which object memory will be shrunk'
25 'memory headroom when growing object memory'),
(isStack
ifFalse:
[#( 26 'interruptChecksEveryNms - force an ioProcessEvents every N milliseconds, in case the image is not calling getNextEvent often')]
ifTrue:
[#( 26 'heartbeat period (ms; see #58)')]),
(isSpur
ifFalse:
[#( 27 'number of times mark loop iterated for current IGC/FGC includes ALL marking'
28 'number of times sweep loop iterated for current IGC/FGC'
29 'number of times make forward loop iterated for current IGC/FGC'
30 'number of times compact move loop iterated for current IGC/FGC')]
ifTrue: [#()]),
#( 31 'number of grow memory requests'
32 'number of shrink memory requests'),
(isSpur
ifFalse:
[#( 33 'number of root table entries used for current IGC/FGC'
34 'number of allocations done before current IGC/FGC'
35 'number of survivor objects after current IGC/FGC'
36 'millisecond clock when current IGC/FGC completed'
37 'number of marked objects for Roots of the world, not including Root Table entries for current IGC/FGC'
38 'milliseconds taken by current IGC'
39 'Number of finalization signals for Weak Objects pending when current IGC/FGC completed')]
ifTrue:
[#( 33 'number of root table entries at last scavenge'
35 'number of survivor objects at last scavenge (if non-zero)'
36 'millisecond clock when current scavenge completed'
38 'milliseconds taken by current scavenge'
39 'Number of finalization signals for Weak Objects pending when current SGC/FGC completed')]),
#( 40 'VM word size - 4 or 8'),
(isStack
ifTrue:
[#(
41 'imageFormatVersion for the VM'
42 'number of stack pages available'
43 'desired number of stack pages (stored in image file header, max 65535)'
44 'size of eden, in bytes'
45 'desired size of eden, in bytes (stored in image file header)'
46 'machine code zone size, in bytes (0 in Stack VM)'
47 'desired machine code zone size (0 => default 1Mb to 2Mb depending on processor)'),
{ 48. 'Persistent image header flags\ bit 0: implies Process has threadId as its 4th inst var\ bit 1: if set, methods that are interpreted will have the flag bit set in their header\ bit 2: if set, implies preempting a process does not put it to the back of its run queue\ bit 3: if set, implies the GUI should run on the first thread and event queues should not be accessed from other threads\ bit 4: if set, implies the new finalization scheme where WeakArrays are queued\ bit 5: if set, implies wheel events will be delivered as such and not mapped to arrow key events\ bit 6: if set, implies arithmetic primitives will fail if given arguments of different types (float vs int)\ bit 7: if set, causes times delivered from file primitives to be in UTC rather than local time.' withCRs },
#( 49 'max size the image promises to grow the external semaphore table to'),
(isSpur
ifFalse:
[{ 50 to: 51. 'reserved for VM parameters that persist in the image (such as size of eden above)'.
52 to: 56. 'specific to Spur' }]
ifTrue:
[{ 50 to: 51. 'reserved for VM parameters that persist in the image (such as size of eden above)' },
#( 52 'root/remembered table capacity'
53 'number of old space segments'
54 'total free old space'
55 'ratio of growth and image size at or above which a GC will be performed post scavenge')]),
#( 56 'number of process switches since startup'
57 'number of ioProcessEvents calls since startup'
58 'number of forceInterruptCheck calls since startup'
59 'number of check event calls since startup'
60 'number of stack page overflows since startup'
61 'number of stack page divorces since startup'
62 'compiled code compactions since startup'),
(isCog
ifFalse:
[#()]
ifTrue:
[#( 63 'total milliseconds in compiled code compactions since startup'
64 'the number of methods that currently have jitted machine-code')]),
+ { 65. 'Cog feature flags\ bit 0: set if the VM supports MULTIPLE_BYTECODE_SETS.\ bit 1: set if the VM supports read-only objects (IMMUTABILITY).\ bit 2: set if the VM has an ITIMER_HEARTBEAT\ bit 3: set if the VM supports cross-platform BIT_IDENTICAL_FLOATING_POINT arithmetic\ bit 4: set if the VM can catch exceptions in FFI calls and answer them as primitive failures\ bit 5: set if the VM''s suspend primitive backs up the process to before the wait if it was waiting on a condition variable' withCRs.
- { 65. 'Cog feature flags\ bit 0: set if the VM supports MULTIPLE_BYTECODE_SETS.\ bit 1: set if the VM supports read-only objects (IMMUTABILITY).\ bit 2: set if the VM has an ITIMER_HEARTBEAT\ bit 3: set if the VM supports cross-platform BIT_IDENTICAL_FLOATING_POINT arithmetic\ bit 4: set if the VM can catch exceptions in FFI calls and answer them as primitive failures' withCRs.
66. 'the byte size of a stack page'.},
(isSpur
ifFalse:
[{ 67 to: 69. 'reserved for more Cog-related info' }]
ifTrue:
[#( 67 'the maximum allowed size of old space (if zero there is no limit)'
68 'the average number of live stack pages when scanned by scavenge/gc/become'
69 'the maximum number of live stack pages when scanned by scavenge/gc/become')]),
#( 70 'the vmProxyMajorVersion (the interpreterProxy VM_MAJOR_VERSION)'
71 'the vmProxyMinorVersion (the interpreterProxy VM_MINOR_VERSION)'),
(isSpur
ifFalse: [#()]
ifTrue:
[#( 72 'milliseconds spent marking since startup'
73 'reserved for more Spur-related info'
74 'reserved for more Spur-related info'
75 'do mixed arithmetic; if false binary arithmetic primitives will fail unless receiver and argument are of the same type')]),
(isCog
ifFalse: [#()]
ifTrue: [#(76 'minimum unused bytes of headroom on all stack pages')])]
ifFalse:
[#()])
pairsDo: [:idx :desc | | value values |
(idx isInteger ifTrue: [idx] ifFalse: [idx last]) <= vmParameters size ifTrue:
[aStream nextPut: $#.
idx isInteger
ifTrue:
[value := vmParameters at: idx.
aStream
print: idx; tab: (idx < 10 ifTrue: [2] ifFalse: [1]);
nextPutAll: ((value isInteger and: [idx ~= 41])
ifTrue: [(desc includesSubstring: 'bit 0:')
ifTrue: [value printStringBase: 2 nDigits: value highBit]
ifFalse: [value asStringWithCommas]]
ifFalse: [value printString])]
ifFalse:
[value := vmParameters at: idx first.
aStream print: idx first; next: 2 put: $.; print: idx last; tab.
values := idx collect: [:i| vmParameters at: i].
values asSet size = 1
ifTrue: [aStream print: value]
ifFalse: [values do: [:v| aStream print: v] separatedBy: [aStream nextPutAll: ', ']]].
aStream tab; nextPutAll: desc; cr]]!
1
0
Eliot Miranda uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-eem.1277.mcz
==================== Summary ====================
Name: System-eem.1277
Author: eem
Time: 1 January 2022, 5:41:21.359006 pm
UUID: f9ad3ac9-3c66-4e80-a0ec-a9484093e82f
Ancestors: System-mt.1276
Add processSuspensionUnblocks, the accessor that answers whether the VM's suspend primitive is fixed or not.
Streamline some of the other vmParameterAt: based accessors.
=============== Diff against System-mt.1276 ===============
Item was changed:
----- Method: SmalltalkImage>>isRunningCogit (in category 'system attributes') -----
isRunningCogit
"Answers if we're running on the Cog JIT"
+ ^(self vmParameterAt: 46 "machine code size in Cog VMs" ifAbsent: 0) > 0!
- ^(self vmParameterAt: 46 ifAbsent: nil)
- ifNil: [false]
- ifNotNil: [:machineCodeZoneSize| machineCodeZoneSize > 0]!
Item was changed:
----- Method: SmalltalkImage>>processPreemptionYields (in category 'system attributes') -----
processPreemptionYields
"Answer whether the VM causes a process to yield on process preemption,
i.e. to put a preempted process at the back of its run queue. If the parameter
is unavailable (non-Cog VMs) or bit 2 (4) is 0 then preemption yields."
+ ^(self vmParameterAt: 48 ifAbsent: 0) noMask: 4!
- ^((self vmParameterAt: 48 ifAbsent: [^true]) allMask: 4) not
- !
Item was added:
+ ----- Method: SmalltalkImage>>processSuspensionUnblocks (in category 'system attributes') -----
+ processSuspensionUnblocks
+ "Answer whether the suspend primitive backs up a process waiting on a
+ condition variable to before the send or not. The original behaviour was to
+ remove a process from its condition variable (Semaphore, Mutex; both kinds
+ of LinkedList). Hence resuming would allow the process past the condition
+ variable, and hence required special behaviour in Process>>signalException:.
+ The new behaviour is to back up a blocked process one bytecode so that if
+ and when resumed it enters the wait state. It also implies that the suspend
+ primitive answers nil if the process is blocked, and only answers a list when
+ suspending a runnable process that is not the active process.
+
+ To be clear, this method answers true on VMs with the old behaviour and
+ false on those with the new."
+
+ ^(self vmParameterAt: 65 ifAbsent: 0) noMask: 32!
Item was changed:
----- Method: SmalltalkImage>>vmParameterAt: (in category 'vm parameters') -----
vmParameterAt: parameterIndex
"parameterIndex is a positive integer corresponding to one of the VM's internal parameter/metric registers.
Answer with the current value of that register. Fail if parameterIndex is invalid or has no corresponding register.
Coerce positive integers for parameterIndices unknown to teh VM to nil.
VM parameters are numbered as follows:
1 byte size of old-space (read-only)
2 byte size of young-space (read-only)
3 byte size of object memory (read-only)
4 allocationCount (read-only; nil in Cog VMs)
5 allocations between GCs (read-write; nil in Cog VMs)
6 survivor count tenuring threshold (read-write)
7 full GCs since startup (read-only)
8 total milliseconds in full GCs since startup (read-only)
9 incremental GCs since startup (read-only; scavenging GCs on Spur)
10 total milliseconds in incremental/scavenging GCs since startup (read-only)
11 tenures of surving objects since startup/last write (read-write)
12 event trace mask; if 1 << eventType is set in the mask then event received by primGetNextEvent: will be printed to stderr.
13 VM ticker start microseconds (Croquet/QwaqVM only)
14 VM ticker count (Croquet/QwaqVM only)
15 VM ticker call count (Croquet/QwaqVM only)
16 total microseconds in idle since startup
17 proportion of code zone available for use (Sista VMs only; read-write)
18 total milliseconds in full GC compaction since startup (a portion of parameter 8)
19 scavenge threshold; the effective size of eden
20 utc microseconds at VM start-up (actually at time initialization, which precedes image load) (newer Cog VMs only).
21 root (remembered) table size (read-only)
22 root (remembered) table overflows since startup (read-only)
23 bytes of extra memory to reserve for VM buffers, plugins, etc.
24 memory threshold above which to shrink object memory (read-write)
25 ammount to grow by when growing object memory (read-write)
26 interruptChecksEveryNms - force an ioProcessEvents every N milliseconds (read-write)
27 number of times mark loop iterated for current IGC/FGC (read-only) includes ALL marking
28 number of times sweep loop iterated for current IGC/FGC (read-only)
29 number of times make forward loop iterated for current IGC/FGC (read-only)
30 number of times compact move loop iterated for current IGC/FGC (read-only)
31 number of grow memory requests (read-only)
32 number of shrink memory requests (read-only)
33 number of root table entries used for current IGC/FGC (read-only)
34 bytes allocated in total since start-up or reset (read-write)
35 number of survivor objects after current IGC/FGC (read-only)
36 millisecond clock when current IGC/FGC completed (read-only)
37 number of marked objects for Roots of the world, not including Root Table entries for current IGC/FGC (read-only)
38 milliseconds taken by current IGC (read-only)
39 Number of finalization signals for Weak Objects pending when current IGC/FGC completed (read-only)
40 BytesPerWord for this image
41 imageFormatVersion for the VM
42 number of stack pages in use (Cog Stack VM only, otherwise nil)
43 desired number of stack pages (stored in image file header, max 65535; Cog VMs only, otherwise nil)
44 size of eden, in bytes (Cog VMs only, otherwise nil)
45 desired size of eden, in bytes (stored in image file header; Cog VMs only, otherwise nil)
46 size of machine code zone, in bytes (stored in image file header; Cog JIT VM only, otherwise nil)
47 desired size of machine code zone, in bytes (applies at startup only, stored in image file header; Cog JIT VM only)
48 various properties stored in the image header (that instruct the VM) as an integer encoding an array of bit flags.
Bit 0: tells the VM that the image's Process class has threadId as its 5th inst var (after nextLink, suspendedContext, priority & myList)
Bit 1: on Cog JIT VMs asks the VM to set the flag bit in interpreted methods
Bit 2: if set, preempting a process puts it to the head of its run queue, not the back,
i.e. preempting a process by a higher priority one will not cause the preempted process to yield
to others at the same priority.
Bit 3: in a muilt-threaded VM, if set, the Window system will only be accessed from the first VM thread
Bit 4: in a Spur vm, if set, causes weaklings and ephemerons to be queued individually for finalization
Bit 5: if set, implies wheel events will be delivered as such and not mapped to arrow key events
Bit 6: if set, implies arithmetic primitives will fail if given arguments of different types (float vs int)
49 the size of the external semaphore table (read-write; Cog VMs only)
50-51 reserved for VM parameters that persist in the image (such as eden above)
52 root (remembered) table maximum size (read-only)
53 the number of oldSpace segments (Spur only, otherwise nil)
54 total size of free old space (Spur only, otherwise nil)
55 ratio of growth and image size at or above which a GC will be performed post scavenge (Spur only, otherwise nil)
56 number of process switches since startup (read-only)
57 number of ioProcessEvents calls since startup (read-only)
58 number of forceInterruptCheck (Cog VMs) or quickCheckInterruptCalls (non-Cog VMs) calls since startup (read-only)
59 number of check event calls since startup (read-only)
60 number of stack page overflows since startup (read-only; Cog VMs only)
61 number of stack page divorces since startup (read-only; Cog VMs only)
62 number of machine code zone compactions since startup (read-only; Cog VMs only)
63 milliseconds taken by machine code zone compactions since startup (read-only; Cog VMs only)
64 current number of machine code methods (read-only; Cog VMs only)
65 In newer Cog VMs a set of flags describing VM features,
if non-zero bit 0 implies multiple bytecode set support;
if non-zero bit 1 implies read-only object support;
if non-zero bit 2 implies the VM suffers from using an ITIMER heartbeat (if 0 it has a thread that provides the heartbeat)
(read-only; Cog VMs only; nil in older Cog VMs, a boolean answering multiple bytecode support in not so old Cog VMs)
+ if non-zero bit 3 implies the VM supports cross-platform BIT_IDENTICAL_FLOATING_POINT arithmetic
+ if non-zero bit 4 implies the VM can catch exceptions in FFI calls and answer them as primitive failures
+ if non-zero bit 5 implies the VM's suspend primitive backs up the process to before the wait if it was waiting on a condition variable
66 the byte size of a stack page in the stack zone (read-only; Cog VMs only)
67 the maximum allowed size of old space in bytes, 0 implies no internal limit (Spur VMs only).
68 the average number of live stack pages when scanned by GC (at scavenge/gc/become et al)
69 the maximum number of live stack pages when scanned by GC (at scavenge/gc/become et al)
70 the value of VM_PROXY_MAJOR (the interpreterProxy major version number)
71 the value of VM_PROXY_MINOR (the interpreterProxy minor version number)
72 total milliseconds in full GCs Mark phase since startup (read-only)
73 total milliseconds in full GCs Sweep phase since startup (read-only, can be 0 depending on compactors)
74 maximum pause time due to segment allocation
75 whether arithmetic primitives will do mixed type arithmetic; if false they fail for different receiver and argument types
76 the minimum unused headroom in all stack pages; Cog VMs only"
<primitive: 254>
(parameterIndex isInteger
and: [parameterIndex > 0]) ifTrue:
[^nil].
self primitiveFailed!
1
0