Nebraska ------> Error: not strike2 format!

Lic. Edgar J. De Cleene edgardec2001 at yahoo.com.ar
Fri Feb 24 15:57:03 UTC 2006


radouane el marjani puso en su mail :

> Hi,
> Thanks Edgar for your help, I think that it  was what I need but
> I had trying Nebraska bei Squeak version 3.8 and 3.7 in the both computer.
> But I have all time this error:  not strike2 format. I don't know what I
> must do,
> I think it's a coding problem bei data transmission. I need a Help, have
> someone an idea.
> Thanks.
> Radouane
You must update both images with this recipe.
File in in order the attached .cs (0489 first ).
Was on smalland branch and tip sended to me by Yoshiki.
The last one should cure the case in what you don't have the same font set
in both images.
I have this working on all images from 3.7, 3.8, 3.9 and smalland brach (the
plugin one)
In case you have problems, send email to me private if you wish and I could
assist via Squeak IRC chat (this way you have your image running for asking
questions)
And if you don't have proxys , routers or similar on your end, I could send
living objects from Argentina to you, Squeak to Squeak none package loaded
!!

Edgar

-------------- next part --------------
'From Squeakland 3.8-05 of 7 September 2005 [latest update: #530] on 31 January 2006 at 5:53:48 pm'!
"Change Set:		NebraskaTextAndImageFix
Date:			6 October 2005
Author:			Yoshiki Ohshima

* DropShadow + Text + Nebraska wasn't working right.
* Form depth = 32 wasn't working right.  It isn't right or optimal but better in many ways."!


!CanvasEncoder methodsFor: 'drawing' stamp: 'yo 10/6/2005 17:00'!
image: aForm at: aPoint sourceRect: sourceRect rule: argRule

	| cacheID cacheNew cacheReply formToSend cacheEntry destRect visRect aFormArea d2 rule |

	rule _ argRule.

	"first if we are only going to be able to draw a small part of the form,
	it may be faster just to send the part of the form that will actually show up"

	destRect _ aPoint extent: sourceRect extent.
	d2 _ (lastTransform invertBoundsRect: destRect) expandBy: 1.
	(d2 intersects: lastClipRect) ifFalse: [
		^NebraskaDebug at: #bigImageSkipped add: {lastClipRect. d2}.
	].
	aFormArea _ aForm boundingBox area.
	(aFormArea > 20000 and: [aForm isStatic not and: [lastTransform isPureTranslation]]) ifTrue: [
		visRect _ destRect intersect: lastClipRect.
		visRect area < (aFormArea // 20) ifTrue: [
			"NebraskaDebug 
				at: #bigImageReduced 
				add: {lastClipRect. aPoint. sourceRect extent. lastTransform}."
			formToSend _ aForm copy: (visRect translateBy: sourceRect origin - aPoint).
			formToSend depth = 32 ifTrue: [formToSend _ formToSend asFormOfDepth: 16. rule = 24 ifTrue: [rule _ 25]].
			^self 
				image: formToSend 
				at: visRect origin 
				sourceRect: formToSend boundingBox
				rule: rule
				cacheID: 0 		"no point in trying to cache this - it's a one-timer"
				newToCache: false.
		].
	].

	cacheID _ 0.
	cacheNew _ false.
	formToSend _ aForm.
	(aFormArea > 1000 and: [(cacheReply _ self testCache: aForm) notNil]) ifTrue: [
		cacheID _ cacheReply first.
		cacheEntry _ cacheReply third.
		(cacheNew _ cacheReply second) ifFalse: [
			formToSend _ aForm isStatic 
				ifTrue: [nil] 
				ifFalse: [aForm depth <= 8 ifTrue: [aForm] ifFalse: [aForm deltaFrom: cacheEntry fourth]].
		].
		cacheEntry at: 4 put: (aForm isStatic ifTrue: [aForm] ifFalse: [aForm deepCopy]).
	].
	(formToSend notNil and: [formToSend depth = 32]) ifTrue: [formToSend _ formToSend asFormOfDepth: 16. rule = 24 ifTrue: [rule _ 25]].
	self
		image: formToSend 
		at: aPoint 
		sourceRect: sourceRect 
		rule: rule 
		cacheID: cacheID 
		newToCache: cacheNew.

! !


!RemoteCanvas methodsFor: 'accessing' stamp: 'yo 10/6/2005 14:44'!
isShadowDrawing
	^ self shadowColor notNil! !

!RemoteCanvas methodsFor: 'drawing-rectangles' stamp: 'yo 10/6/2005 15:53'!
fillRectangle: aRectangle fillStyle: aFillStyle
	"Fill the given rectangle."
	| pattern |
	(self isShadowDrawing not and: [self shadowColor notNil]) ifTrue:
		[^self fillRectangle: aRectangle color: self shadowColor].

	(aFillStyle isKindOf: InfiniteForm) ifTrue: [
		^self infiniteFillRectangle: aRectangle fillStyle: aFillStyle
	].

	(aFillStyle isSolidFill) 
		ifTrue:[^self fillRectangle: aRectangle color: aFillStyle asColor].
	"We have a very special case for filling with infinite forms"
	(aFillStyle isBitmapFill and:[aFillStyle origin = (0 at 0)]) ifTrue:[
		pattern _ aFillStyle form.
		(aFillStyle direction = (pattern width @ 0) 
			and:[aFillStyle normal = (0 at pattern height)]) ifTrue:[
				"Can use an InfiniteForm"
				^self fillRectangle: aRectangle color: (InfiniteForm with: pattern)].
	].
	"Use a BalloonCanvas instead"
	self balloonFillRectangle: aRectangle fillStyle: aFillStyle.! !

!RemoteCanvas methodsFor: 'drawing-text' stamp: 'yo 10/6/2005 15:57'!
drawString: s from: firstIndex to: lastIndex in: boundsRect font: fontOrNil color: c
	"Draw the given string in the given font and color clipped to the given rectangle. If the font is nil, the default font is used."
	"(innerClipRect intersects: (transform transformBoundsRect: boundsRect)) ifFalse: [ ^self ]."
		"clip rectangles seem to be all screwed up...."
	s isAllSeparators ifTrue: [ ^self ].   "is this correct??  it sure does speed things up!!"
	self drawCommand: [ :executor |
		executor drawString: s from: firstIndex to: lastIndex in: boundsRect font: fontOrNil color: (self isShadowDrawing ifTrue: [self shadowColor] ifFalse: [c])]! !

-------------- next part --------------
'From Squeakland 3.8-05 of 7 September 2005 [latest update: #530] on 31 January 2006 at 5:53:35 pm'!
ObjectSocket subclass: #StringSocket
	instanceVariableNames: 'numStringsInNextArray stringsForNextArray nextStringSize files startTime stringCounter socketWriterProcess outputQueue bytesInOutputQueue extraUnsentBytes transmissionError readBuffer '
	classVariableNames: 'MaxRatesSeen RecentSendHistory RunningSendCount '
	poolDictionaries: ''
	category: 'Nebraska-Network-ObjectSocket'!

!Socket methodsFor: 'receiving' stamp: 'yo 10/10/2005 18:47'!
receiveAvailableDataIntoBuffer: buffer
	"Receive all available data (if any). Do not wait."
 
	| bytesRead |
	bytesRead _ self receiveAvailableDataInto: buffer.
	^buffer copyFrom: 1 to: bytesRead! !


!StringSocket methodsFor: 'private-IO' stamp: 'yo 10/10/2005 18:49'!
addToInBuf: aString

	| newAlloc |
	newAlloc _ aString size * 2 max: 80000.
	inBuf ifNil: [
		inBuf _ String new: newAlloc.
		inBufIndex _ 1.
		inBufLastIndex _ 0.
	].
	aString size > (inBuf size - inBufLastIndex) ifTrue: [
		inBuf _ inBuf , (String new: newAlloc)
	].
	inBuf 
		replaceFrom: inBufLastIndex + 1 
		to: inBufLastIndex + aString size
		with: aString 
		startingAt: 1.
	inBufLastIndex _ inBufLastIndex + aString size.
! !

!StringSocket methodsFor: 'private-IO' stamp: 'yo 10/10/2005 18:47'!
processInput
	| totalReceived chunkOfData |
	"do as much input as possible"

	self flag: #XXX.  "should have resource limits here--no more than X objects and Y bytes"

	chunkOfData _ socket receiveAvailableDataIntoBuffer: self readBuffer.
	self addToInBuf: chunkOfData.
	totalReceived _ chunkOfData size.

	totalReceived > 0 ifTrue: [
		NebraskaDebug at: #SendReceiveStats add: {'GET'. totalReceived}.
	].

	[ self gotSomething ] whileTrue: [].		"decode as many string arrays as possible"

	self shrinkInBuf.! !

!StringSocket methodsFor: 'as yet unclassified' stamp: 'yo 10/10/2005 18:47'!
readBuffer

	^ readBuffer ifNil: [readBuffer _ String new: 20000].
! !

ObjectSocket subclass: #StringSocket
	instanceVariableNames: 'numStringsInNextArray stringsForNextArray nextStringSize files startTime stringCounter socketWriterProcess outputQueue bytesInOutputQueue extraUnsentBytes transmissionError readBuffer'
	classVariableNames: 'MaxRatesSeen RecentSendHistory RunningSendCount'
	poolDictionaries: ''
	category: 'Nebraska-Network-ObjectSocket'!
-------------- next part --------------
'From Squeakland 3.8-05 of 7 September 2005 [latest update: #530] on 1 February 2006 at 6:44:05 am'!
"Change Set:		nebraskaFix
Date:			28 September 2005
Author:			Yoshiki Ohshima

Make Nebraska work (again) in Vancouver image."!


!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: 'fonts' stamp: 'yo 9/28/2005 12:06'!
sendFont: aFont atIndex: index
	"Transmits the given fint to the other side"

	| code |
	code _ CanvasEncoder codeFont.
	(aFont isMemberOf: StrikeFontSet) ifTrue: [code _ CanvasEncoder codeFontSet].
	aFont isTTCFont ifTrue: [code _ CanvasEncoder codeTTCFont].
	self sendCommand: {
		String with: code.
		self class encodeInteger: index.
		self class encodeFont: aFont }.
! !


!RemoteCanvas methodsFor: 'as yet unclassified' stamp: 'yo 9/28/2005 12:53'!
isVisible: aRectangle
	"Optimization"
	| myOrigin myRect |
	myRect _ self clipRect.
	myOrigin _ self origin.
	(aRectangle right + myOrigin x) < myRect left	ifTrue: [^ false].
	(aRectangle left + myOrigin x) > myRect right	ifTrue: [^ false].
	(aRectangle bottom + myOrigin y) < myRect top	ifTrue: [^ false].
	(aRectangle top + myOrigin y) > myRect bottom	ifTrue: [^ false].
	^ true
! !

CanvasDecoder initialize!
"Postscript:"
CanvasDecoder reinitialize.
!

-------------- next part --------------
'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!
-------------- next part --------------
'From Squeakland 3.8-05 of 7 September 2005 [latest update: #530] on 1 February 2006 at 5:41:06 pm'!

!CanvasDecoder class methodsFor: 'decoding' stamp: 'edc 2/1/2006 17:36'!
decodeTTCFont: fontString

	"Decode a string that consists of <familyName> <pointSize> <emphasis> (e.g. 'ComicSansMS 12 0') into a proper instance."

	| first second familyName fontSize fontFromServer  emphasis |
	first _ fontString indexOf: $  startingAt: 1.
	second _ fontString indexOf: $  startingAt: first + 1.

	(first ~= 0 and: [second ~= 0]) ifTrue: [familyName := (fontString copyFrom: 1 to: (first - 1)).
fontSize := (fontString copyFrom: first + 1 to: second - 1) asNumber .
emphasis := (fontString copyFrom: second + 1 to: fontString size) asNumber .
fontFromServer := TTCFont family: familyName.
fontFromServer ifNil: [PopUpMenu notify: 'Font family name do not exist on server']
ifNotNil: [fontFromServer := TTCFont family: familyName size: fontSize .
fontFromServer ifNil: [PopUpMenu notify: 'Font size do not exist on server'.
((TextStyle named: familyName) addNewFontSize: fontSize) emphasis: emphasis.
]
ifNotNil:[^ TTCFont familyName: familyName size: fontSize  emphasized: emphasis
]]].

	^ TextStyle defaultFont.
! !


More information about the Squeak-dev mailing list