'From Squeakland 3.8-05 of 7 September 2005 [latest update: #530] on 31 January 2006 at 5:53:14 pm'! "Change Set: NebraskaFontSet Date: 17 December 2005 Author: Yoshiki Ohshima Support StrikeFontSet in better way."! !CanvasDecoder class methodsFor: 'decoding' stamp: 'yo 12/17/2005 22:44'! decodeFont: fontString ^StrikeFont decodedFromRemoteCanvas: fontString. ! ! !CanvasDecoder class methodsFor: 'decoding' stamp: 'yo 12/17/2005 22:42'! decodeFontSet: fontString ^ StrikeFontSet decodedFromRemoteCanvas: fontString ! ! !CanvasDecoder class methodsFor: 'class initialization' stamp: 'yo 12/15/2005 16:07'! initialize "CanvasDecoder initialize" "Set up my cache and decode table if necessary." CachedForms ifNil: [CachedForms := Array new: 100]. DecodeTable ifNotNil: [ ^self ]. DecodeTable _ Array new: 128. #((codeClip setClip:) (codeTransform setTransform:) (codeText drawText:) (codeLine drawLine:) (codeRect drawRect:) (codeBalloonRect drawBalloonRect:) (codeBalloonOval drawBalloonOval:) (codeInfiniteFill drawInfiniteFill:) (codeOval drawOval:) (codeImage drawImage:) (codeReleaseCache releaseImage:) (codePoly drawPoly:) (codeStencil drawStencil:) (codeForce forceToScreen:) (codeFont addFontToCache:) (codeFontSet addFontSetToCache:) (codeMultiText drawMultiText:) (codeTTCFont addTTCFontToCache:) (codeExtentDepth extentDepth:) (codeShadowColor shadowColor:)) do: [ :arr | (DecodeTable at: ((CanvasEncoder perform: arr first) asciiValue + 1)) ifNotNil: [self error: 'duplicated code']. DecodeTable at: ((CanvasEncoder perform: arr first) asciiValue + 1) put: arr second ]. ! ! !CanvasEncoder methodsFor: 'drawing' stamp: 'yo 12/17/2005 22:44'! drawString: s from: firstIndex to: lastIndex in: boundsRect font: fontOrNil color: c | fontIndex str | fontIndex := self establishFont: (fontOrNil ifNil: [ TextStyle defaultFont ]). str _ s asString copyFrom: firstIndex to: lastIndex. str isWideString ifTrue: [ self sendCommand: { String with: CanvasEncoder codeMultiText. str asByteArray asString. self class encodeRectangle: boundsRect. self class encodeInteger: fontIndex. self class encodeColor: c } ] ifFalse: [ self sendCommand: { String with: CanvasEncoder codeText. str. self class encodeRectangle: boundsRect. self class encodeInteger: fontIndex. self class encodeColor: c } ]. ! ! !NebraskaServerMorph class methodsFor: 'as yet unclassified' stamp: 'yo 12/17/2005 23:06'! serveWorld ^ self serveWorld: ActiveWorld. ! ! !NebraskaServerMorph class methodsFor: 'as yet unclassified' stamp: 'yo 12/17/2005 23:07'! serveWorldButton | button | button _ ScriptableButton new. button target: NebraskaServerMorph. button actionSelector: #serveWorld. button arguments: #(). button label: 'Share'. button color: Color yellow. ^ button. ! ! !NebraskaServerMorph class methodsFor: 'as yet unclassified' stamp: 'yo 12/17/2005 23:08'! supplementaryPartsDescriptions ^ {DescriptionForPartsBin formalName: 'NebraskaServer' categoryList: #('Collaborative') documentation: 'A button to start the Nebraska desktop sharing server' translated globalReceiverSymbol: #NebraskaServerMorph nativitySelector: #serveWorldButton }! ! !StrikeFont methodsFor: 'file in/out' stamp: 'yo 12/17/2005 20:36'! encodedForRemoteCanvas | stream | stream := RWBinaryOrTextStream on: ''. stream nextPutAll: self familyName. stream nextPut: Character space. stream nextPutAll: self name. stream nextPut: Character space. stream nextPutAll: self height. stream nextPut: Character space. stream nextPutAll: self emphasis asString. ^ stream contents asString. ! ! !StrikeFont class methodsFor: 'instance creation' stamp: 'yo 12/17/2005 22:41'! decodedFromRemoteCanvas: aString | array style base | array _ aString findTokens: #($ ). style _ TextStyle named: (array at: 1) asSymbol. style ifNil: [^ TextStyle defaultFont]. (style fontArray first name = style fontArray first name withoutTrailingDigits) ifTrue: [ ^ self familyName: (array at: 1) size: (array at: 3) asNumber emphasized: (array at: 4) asNumber]. base _ style fontArray detect: [:f | (array at: 2) beginsWith: f name]. ^ base emphasized: (array at: 4) asNumber. "^ self familyName: (array at: 1) size: (array at: 2) asNumber emphasized: (array at: 3) asNumber." ! ! !StrikeFontSet methodsFor: 'as yet unclassified' stamp: 'yo 12/17/2005 20:19'! encodedForRemoteCanvas | stream | stream := RWBinaryOrTextStream on: ''. stream nextPutAll: self familyName. stream nextPut: Character space. stream nextPutAll: self pointSize asString. stream nextPut: Character space. stream nextPutAll: self emphasis asString. ^ stream contents asString. ! ! !StrikeFontSet class methodsFor: 'as yet unclassified' stamp: 'yo 12/17/2005 22:42'! decodedFromRemoteCanvas: aString | array | array _ aString findTokens: #($ ). ^ self familyName: (array at: 1) size: (array at: 2) asNumber emphasized: (array at: 3) asNumber. ! ! StrikeFontSet class removeSelector: #fontNamed:! StrikeFontSet removeSelector: #writeNameOn:! CanvasDecoder initialize!