Tim Felgentreff uploaded a new version of Nebraska to project The Trunk:
http://source.squeak.org/trunk/Nebraska-tfel.43.mcz ==================== Summary ==================== Name: Nebraska-tfel.43 Author: tfel Time: 2 August 2016, 10:02:13.874368 am UUID: 801e68f0-394e-2b45-8b91-be5dd271ad9f Ancestors: Nebraska-mt.42, Nebraska-bf.3 merge from Squeakland Etoys image =============== Diff against Nebraska-mt.42 =============== Item was changed: - SystemOrganization addCategory: #'Nebraska-Audio Chat'! SystemOrganization addCategory: #'Nebraska-Morphic-Collaborative'! SystemOrganization addCategory: #'Nebraska-Morphic-Experimental'! SystemOrganization addCategory: #'Nebraska-Morphic-Remote'! SystemOrganization addCategory: #'Nebraska-Network-EToy Communications'! SystemOrganization addCategory: #'Nebraska-Network-ObjectSocket'! + SystemOrganization addCategory: #'Nebraska-Audio Chat'! Item was changed: ----- Method: CanvasDecoder class>>decodeTTCFont: (in category 'decoding') ----- decodeTTCFont: fontString "Decode a string that consists of <familyName> <pointSize> <emphasis> (e.g. 'ComicSansMS 12 0') into a proper instance." | first second | + first _ fontString indexOf: $ startingAt: 1. + second _ fontString indexOf: $ startingAt: first + 1. - first := fontString indexOf: $ startingAt: 1. - second := fontString indexOf: $ startingAt: first + 1. (first ~= 0 and: [second ~= 0]) ifTrue: [ + ^ TTCFont familyName: (fontString copyFrom: 1 to: (first - 1)) + size: (fontString copyFrom: first + 1 to: second - 1) asNumber - ^ (TTCFont family: (fontString copyFrom: 1 to: (first - 1)) - size: (fontString copyFrom: first + 1 to: second - 1) asNumber) emphasized: (fontString copyFrom: second + 1 to: fontString size) asNumber. ]. ^ TextStyle defaultFont. ! Item was changed: ----- Method: CanvasEncoder>>image:at:sourceRect:rule: (in category 'drawing') ----- image: aForm at: aPoint sourceRect: sourceRect rule: argRule | cacheID cacheNew cacheReply formToSend cacheEntry destRect visRect aFormArea d2 rule | + rule _ argRule. - 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. - 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 := aForm boundingBox area. (aFormArea > 20000 and: [aForm isStatic not and: [lastTransform isPureTranslation]]) ifTrue: [ + visRect _ destRect intersect: lastClipRect. - 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 or: [rule = 34]) ifTrue: [rule _ 25]]. - 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 - 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 and: [ + rule ~= 24 and: [ + rule ~= 34]]]) ifTrue: [ + formToSend _ formToSend asFormOfDepth: 16. + ]. - (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. ! Item was changed: ----- Method: CanvasEncoder>>sendFont:atIndex: (in category 'fonts') ----- 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]. - code := CanvasEncoder codeFont. - aFont isTTCFont ifTrue: [code := CanvasEncoder codeTTCFont]. self sendCommand: { String with: code. self class encodeInteger: index. self class encodeFont: aFont }. ! Item was changed: ----- Method: EToyChatMorph class>>chatWindowForIP:name:picture:inWorld: (in category 'as yet unclassified') ----- chatWindowForIP: ipAddress name: senderName picture: aForm inWorld: aWorld | makeANewOne aSenderBadge existing | + existing _ self instanceForIP: ipAddress inWorld: aWorld. - existing := self instanceForIP: ipAddress inWorld: aWorld. existing ifNotNil: [^existing]. + makeANewOne _ [ - makeANewOne := [ self new recipientForm: aForm; open; setIPAddress: ipAddress ]. EToyCommunicatorMorph playArrivalSound. self doChatsInternalToBadge ifTrue: [ + aSenderBadge _ EToySenderMorph instanceForIP: ipAddress inWorld: aWorld. - aSenderBadge := EToySenderMorph instanceForIP: ipAddress inWorld: aWorld. aSenderBadge ifNotNil: [ aSenderBadge startChat: false. ^aSenderBadge findDeepSubmorphThat: [ :x | x isKindOf: EToyChatMorph] ifAbsent: makeANewOne ]. + aSenderBadge _ EToySenderMorph instanceForIP: ipAddress. - aSenderBadge := EToySenderMorph instanceForIP: ipAddress. aSenderBadge ifNotNil: [ + aSenderBadge _ aSenderBadge veryDeepCopy. - aSenderBadge := aSenderBadge veryDeepCopy. aSenderBadge killExistingChat; openInWorld: aWorld; startChat: false. ^aSenderBadge findDeepSubmorphThat: [ :x | x isKindOf: EToyChatMorph] ifAbsent: makeANewOne ]. + (aSenderBadge _ EToySenderMorph new) - (aSenderBadge := EToySenderMorph new) userName: senderName userPicture: aForm + userEmail: 'unknown' translated - userEmail: 'unknown' userIPAddress: ipAddress; position: 200@200; openInWorld: aWorld; startChat: false. ^aSenderBadge findDeepSubmorphThat: [ :x | x isKindOf: EToyChatMorph] ifAbsent: makeANewOne ]. ^makeANewOne value. ! Item was changed: ----- Method: EToyChatMorph class>>descriptionForPartsBin (in category 'parts bin') ----- descriptionForPartsBin + ^ self partName: 'Text chat' translatedNoop + categories: #() + documentation: 'A tool for sending messages to other Squeak users' translatedNoop! - ^ self partName: 'Text chat' - categories: #('Collaborative') - documentation: 'A tool for sending messages to other Squeak users'! Item was changed: ----- Method: EToyChatMorph>>rebuild (in category 'as yet unclassified') ----- rebuild | r1 r2 | + r1 _ self addARow: { + self simpleToggleButtonFor: self attribute: #acceptOnCR help: 'Send with Return?' translated. + self inAColumn: {StringMorph new contents: 'Your message to:' translated; font: Preferences standardMenuFont; lock}. - r1 := self addARow: { - self simpleToggleButtonFor: self attribute: #acceptOnCR help: 'Send with Return?'. - self inAColumn: {StringMorph new contents: 'Your message to:'; lock}. self textEntryFieldNamed: #ipAddress with: '' + help: 'IP address for chat partner' translated. - help: 'IP address for chat partner'. }. recipientForm ifNotNil: [ r1 addMorphBack: recipientForm asMorph lock ]. + sendingPane _ PluggableTextMorph - sendingPane := PluggableTextMorph on: self text: nil accept: #acceptTo:forMorph:. sendingPane hResizing: #spaceFill; vResizing: #spaceFill. + sendingPane font: Preferences standardMenuFont. self addMorphBack: sendingPane. + r2 _ self addARow: {self inAColumn: {StringMorph new contents: 'Replies' translated; font: Preferences standardMenuFont; lock}}. + receivingPane _ PluggableTextMorph - r2 := self addARow: {self inAColumn: {StringMorph new contents: 'Replies'; lock}}. - receivingPane := PluggableTextMorph on: self text: nil accept: nil. + receivingPane font: Preferences standardMenuFont. receivingPane hResizing: #spaceFill; vResizing: #spaceFill. self addMorphBack: receivingPane. receivingPane spaceFillWeight: 3. {r1. r2} do: [ :each | each vResizing: #shrinkWrap; minHeight: 18; color: Color veryLightGray. ]. + sendingPane acceptOnCR: (acceptOnCR ifNil: [acceptOnCR _ true])! - sendingPane acceptOnCR: (acceptOnCR ifNil: [acceptOnCR := true])! Item was changed: ----- Method: EToyFridgeMorph class>>descriptionForPartsBin (in category 'parts bin') ----- descriptionForPartsBin + ^ self partName: 'Fridge' translatedNoop + categories: #() + documentation: 'A tool for sending objects to other Squeak users' translatedNoop! - ^ self partName: 'Fridge' - categories: #('Collaborative') - documentation: 'A tool for sending objects to other Squeak users'! Item was changed: ----- Method: EToyFridgeMorph>>groupToggleButton (in category 'as yet unclassified') ----- groupToggleButton ^(self inAColumn: { (EtoyUpdatingThreePhaseButtonMorph checkBox) target: self; actionSelector: #toggleChoice:; arguments: {'group'}; getSelector: #getChoice:; + setBalloonText: 'Changes between group mode and individuals' translated; - setBalloonText: 'Changes between group mode and individuals'; step }) hResizing: #shrinkWrap ! Item was changed: ----- Method: EToyFridgeMorph>>rebuild (in category 'as yet unclassified') ----- rebuild | row filler fudge people maxPerRow insetY | + updateCounter _ self class updateCounter. - updateCounter := self class updateCounter. self removeAllMorphs. (self addARow: { + filler _ Morph new color: Color transparent; extent: 4@4. - filler := Morph new color: Color transparent; extent: 4@4. }) vResizing: #shrinkWrap. self addARow: { + (StringMorph contents: 'the Fridge' translated) lock. - (StringMorph contents: 'the Fridge') lock. self groupToggleButton. }. + row _ self addARow: {}. + people _ self class fridgeRecipients. + maxPerRow _ people size < 7 ifTrue: [2] ifFalse: [3]. - row := self addARow: {}. - people := self class fridgeRecipients. - maxPerRow := people size < 7 ifTrue: [2] ifFalse: [3]. "how big can this get before we need a different approach?" people do: [ :each | + row submorphCount >= maxPerRow ifTrue: [row _ self addARow: {}]. - row submorphCount >= maxPerRow ifTrue: [row := self addARow: {}]. row addMorphBack: ( groupMode ifTrue: [ (each userPicture scaledToSize: 35@35) asMorph lock ] ifFalse: [ each veryDeepCopy killExistingChat ] ) ]. + fullBounds _ nil. - fullBounds := nil. self fullBounds. + "htsBefore _ submorphs collect: [ :each | each height]." - "htsBefore := submorphs collect: [ :each | each height]." + fudge _ 20. + insetY _ self layoutInset. + insetY isPoint ifTrue: [insetY _ insetY y]. - fudge := 20. - insetY := self layoutInset. - insetY isPoint ifTrue: [insetY := insetY y]. filler extent: 4 @ (self height - filler height * 0.37 - insetY - borderWidth - fudge) truncated. "self fixLayout. + htsAfter _ submorphs collect: [ :each | each height]. - htsAfter := submorphs collect: [ :each | each height]. {htsBefore. htsAfter} explore." ! Item was changed: ----- Method: EToyIncomingMessage class>>allTypes (in category 'message types') ----- allTypes ^MessageTypes ifNil: [ + MessageTypes _ { - MessageTypes := { self typeKeyboardChat. self typeMorph. self typeFridge. self typeStatusRequest. self typeStatusReply. self typeSeeDesktop. - self typeAudioChat. - self typeAudioChatContinuous. self typeMultiChat. } ] ! Item was changed: ----- Method: EToyIncomingMessage class>>handleNewMorphFrom:sentBy:ipAddress: (in category 'handlers') ----- handleNewMorphFrom: dataStream sentBy: senderName ipAddress: ipAddressString | newObject thumbForm targetWorld | + newObject _ self newObjectFromStream: dataStream. - newObject := self newObjectFromStream: dataStream. EToyCommunicatorMorph playArrivalSound. + targetWorld _ self currentWorld. - targetWorld := self currentWorld. (EToyMorphsWelcomeMorph morphsWelcomeInWorld: targetWorld) ifTrue: [ newObject position: ( newObject valueOfProperty: #positionInOriginatingWorld ifAbsent: [(targetWorld randomBoundsFor: newObject) topLeft] ). WorldState addDeferredUIMessage: [ newObject openInWorld: targetWorld. + ] fixTemps. - ]. ^self ]. + thumbForm _ newObject imageForm scaledToSize: 50@50. + SugarListenerMorph addToGlobalIncomingQueue: { - thumbForm := newObject imageForm scaledToSize: 50@50. - EToyListenerMorph addToGlobalIncomingQueue: { thumbForm. newObject. senderName. ipAddressString }. WorldState addDeferredUIMessage: [ + SugarListenerMorph ensureListenerInCurrentWorld + ] fixTemps. - EToyListenerMorph ensureListenerInCurrentWorld - ]. ! Item was changed: ----- Method: EToyIncomingMessage class>>handleNewSeeDesktopFrom:sentBy:ipAddress: (in category 'handlers') ----- handleNewSeeDesktopFrom: dataStream sentBy: senderName ipAddress: ipAddressString "more later" ^ EToyChatMorph chatFrom: ipAddressString name: senderName + text: ipAddressString,' would like to see your desktop' translated. - text: ipAddressString,' would like to see your desktop'. ! Item was changed: ----- Method: EToyIncomingMessage class>>handleNewStatusRequestFrom:sentBy:ipAddress: (in category 'handlers') ----- handleNewStatusRequestFrom: dataStream sentBy: senderName ipAddress: ipAddressString "more later" ^ EToyChatMorph chatFrom: ipAddressString name: senderName + text: ipAddressString,' would like to know if you are available' translated. - text: ipAddressString,' would like to know if you are available'. ! Item was changed: ----- Method: EToyListenerMorph class>>commResultDeferred: (in category 'as yet unclassified') ----- commResultDeferred: anArrayOfAssociations | m ipAddress aDictionary | "to be run as part of the UI process in case user interaction is required" + aDictionary _ Dictionary new. - aDictionary := Dictionary new. anArrayOfAssociations do: [ :each | aDictionary add: each]. aDictionary at: #commFlash ifPresent: [ :ignore | ^self]. + m _ aDictionary at: #message ifAbsent: [^self]. - m := aDictionary at: #message ifAbsent: [^self]. m = 'OK' ifFalse: [^self]. + ipAddress _ aDictionary at: #ipAddress. - ipAddress := NetNameResolver stringFromAddress: (aDictionary at: #ipAddress). EToyIncomingMessage new incomingMessgage: (ReadStream on: (aDictionary at: #data)) fromIPAddress: ipAddress ! Item was changed: ----- Method: EToyListenerMorph class>>confirmListening (in category 'as yet unclassified') ----- confirmListening self isListening ifFalse: [ (self confirm: 'You currently are not listening and will not hear a reply. + Shall I start listening for you?' translated) ifTrue: [ - Shall I start listening for you?') ifTrue: [ self startListening ]. ]. ! Item was changed: ----- Method: EToyListenerMorph class>>descriptionForPartsBin (in category 'parts bin') ----- descriptionForPartsBin + ^ self partName: 'Listener' translatedNoop + categories: #() + documentation: 'A tool for receiving things from other Squeak users' translatedNoop! - - ^ self partName: 'Listener' - categories: #('Collaborative') - documentation: 'A tool for receiving things from other Squeak users'! Item was changed: ----- Method: EToyListenerMorph>>mouseDownEvent:for: (in category 'as yet unclassified') ----- mouseDownEvent: event for: aMorph + | menu selection depictedObject | - | menu depictedObject | depictedObject := aMorph firstSubmorph valueOfProperty: #depictedObject. + menu := CustomMenu new. - menu := MenuMorph new. menu + add: 'Grab' translated action: [event hand attachMorph: depictedObject veryDeepCopy]; + add: 'Delete' translated - add: 'Grab' action: [event hand attachMorph: depictedObject veryDeepCopy]; - add: 'Delete' action: [self class removeFromGlobalIncomingQueue: depictedObject. self rebuild]. + selection := menu build startUpCenteredWithCaption: 'Morph from ' translated + , (aMorph submorphs second) firstSubmorph contents. + selection ifNil: [^self]. + selection value! - menu title: 'Morph from ' , (aMorph submorphs second) firstSubmorph contents. - menu invokeModal.! Item was changed: ----- Method: EToyListenerMorph>>rebuild (in category 'as yet unclassified') ----- rebuild | earMorph | + updateCounter _ UpdateCounter. - updateCounter := UpdateCounter. self removeAllMorphs. self addGateKeeperMorphs. GlobalListener ifNil: [ + earMorph _ (self class makeListeningToggleNew: false) asMorph. + earMorph setBalloonText: 'Click to START listening for messages' translated. - earMorph := (self class makeListeningToggleNew: false) asMorph. - earMorph setBalloonText: 'Click to START listening for messages'. earMorph on: #mouseUp send: #startListening to: self. ] ifNotNil: [ + earMorph _ (self class makeListeningToggleNew: true) asMorph. + earMorph setBalloonText: 'Click to STOP listening for messages' translated. - earMorph := (self class makeListeningToggleNew: true) asMorph. - earMorph setBalloonText: 'Click to STOP listening for messages'. earMorph on: #mouseUp send: #stopListening to: self. ]. self addARow: {self inAColumn: {earMorph}}. self addARow: { + self inAColumn: {(StringMorph contents: 'Incoming communications' translated ) lock}. + self indicatorFieldNamed: #working color: Color blue help: 'working' translated. + self indicatorFieldNamed: #communicating color: Color green help: 'receiving' translated. - self inAColumn: {(StringMorph contents: 'Incoming communications') lock}. - self indicatorFieldNamed: #working color: Color blue help: 'working'. - self indicatorFieldNamed: #communicating color: Color green help: 'receiving'. }. "{thumbForm. newObject. senderName. ipAddressString}" self class globalIncomingQueueCopy do: [ :each | self addNewObject: each second thumbForm: each first sentBy: each third ipAddress: each fourth. ].! Item was changed: ----- Method: EToyMorphsWelcomeMorph class>>descriptionForPartsBin (in category 'parts bin') ----- descriptionForPartsBin + ^ self partName: 'Welcome' translatedNoop + categories: #() + documentation: 'A sign that you accept morphs dropped directly into your world' translatedNoop! - ^ self partName: 'Welcome' - categories: #('Collaborative') - documentation: 'A sign that you accept morphs dropped directly into your world'! Item was changed: ----- Method: EToyMorphsWelcomeMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" | earMorph | super initialize. "" self layoutInset: 8 @ 8. + "earMorph _ (EToyListenerMorph makeListeningToggle: true) - "earMorph := (EToyListenerMorph makeListeningToggle: true) asMorph." + earMorph _ TextMorph new contents: 'Morphs - earMorph := TextMorph new contents: 'Morphs welcome here'; fontName: Preferences standardEToysFont familyName size: 18; centered; lock. self addARow: {earMorph}. + self setBalloonText: 'My presence in this world means received morphs may appear automatically' translated! - self setBalloonText: 'My presence in this world means received morphs may appear automatically'! Item was changed: ----- Method: EToyMultiChatMorph class>>descriptionForPartsBin (in category 'parts bin') ----- descriptionForPartsBin + ^ self partName: 'Text chat+' translatedNoop + categories: #() + documentation: 'A tool for sending messages to several Squeak users at once' translatedNoop - ^ self partName: 'Text chat+' - categories: #('Collaborative') - documentation: 'A tool for sending messages to several Squeak users at once' sampleImageForm: (Form extent: 25@25 depth: 16 fromArray: #( 1177640695 1593270007 1593270007 1593270007 1593270007 1593270007 1593270007 1593270007 1593270007 1593270007 1593270007 1593270007 1593245696 1593263665 1593270007 1593270007 1593270007 1177634353 1177628012 1177628012 1177640695 1593270007 1593270007 1593278463 2147450879 1316159488 1593278459 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 1870200832 1593278459 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 1870200832 1593278459 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 1870200832 1593278459 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 1870200832 1593278459 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 1870200832 1593274233 1870229369 1870229369 1870229369 1870229369 1870229369 1870229369 1870229369 1870229369 1870229369 1870229369 1870229369 1731723264 1593257324 762064236 762064236 762064236 762064236 762057894 762057894 762064236 762064236 762064236 762064236 762064236 1177616384 1593278459 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 1870200832 1593278459 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 1870200832 1593278459 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 1870200832 1593278459 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 1870200832 1593278459 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 1870200832 1593278459 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 1870200832 1593278459 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 1870200832 1593278459 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 1870200832 1593278459 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 1870200832 1593278459 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 1870200832 1593278459 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 1870200832 1593278459 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 1870200832 1593278459 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 1870200832 1593278459 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 1870200832 1593278459 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 2147188731 1870200832 1593274233 1870229369 1870229369 1870229369 1870229369 1870229369 1870229369 1870229369 1870229369 1870229369 1870229369 1870229369 1731723264) offset: 0@0)! Item was changed: ----- Method: EToyMultiChatMorph>>editEvent:for: (in category 'as yet unclassified') ----- editEvent: anEvent for: aMorph | answer initialText aFillInTheBlankMorph | (aMorph bounds containsPoint: anEvent cursorPoint) ifFalse: [^self]. + initialText _ String streamContents: [ :strm | - initialText := String streamContents: [ :strm | targetIPAddresses do: [ :each | strm nextPutAll: each; cr]. ]. + aFillInTheBlankMorph _ FillInTheBlankMorph new + setQuery: 'Who are you chatting with?' translated - aFillInTheBlankMorph := FillInTheBlankMorph new - setQuery: 'Who are you chatting with?' initialAnswer: initialText answerHeight: 250 acceptOnCR: false. aFillInTheBlankMorph responseUponCancel: nil. self world addMorph: aFillInTheBlankMorph centeredNear: anEvent cursorPoint. + answer _ aFillInTheBlankMorph getUserResponse. - answer := aFillInTheBlankMorph getUserResponse. answer ifNil: [^self]. self updateIPAddressField: (answer findTokens: ' ',String cr). ! Item was changed: ----- Method: EToyMultiChatMorph>>rebuild (in category 'as yet unclassified') ----- rebuild | r1 r2 | + r1 _ self addARow: { + self simpleToggleButtonFor: self attribute: #acceptOnCR help: 'Send with Return?' translated. + self inAColumn: {StringMorph new contents: 'Multi chat with:' translated; lock}. - r1 := self addARow: { - self simpleToggleButtonFor: self attribute: #acceptOnCR help: 'Send with Return?'. - self inAColumn: {StringMorph new contents: 'Multi chat with:'; lock}. self textEntryFieldNamed: #ipAddress with: '' + help: 'Click to edit participant list' translated. - help: 'Click to edit participant list'. }. + sendingPane _ PluggableTextMorph - sendingPane := PluggableTextMorph on: self text: nil accept: #acceptTo:forMorph:. sendingPane hResizing: #spaceFill; vResizing: #spaceFill. self addMorphBack: sendingPane. + r2 _ self addARow: {self inAColumn: {StringMorph new contents: 'Replies' translated; lock}}. + receivingPane _ PluggableTextMorph - r2 := self addARow: {self inAColumn: {StringMorph new contents: 'Replies'; lock}}. - receivingPane := PluggableTextMorph on: self text: nil accept: nil. receivingPane hResizing: #spaceFill; vResizing: #spaceFill. self addMorphBack: receivingPane. receivingPane spaceFillWeight: 3. {r1. r2} do: [ :each | each vResizing: #shrinkWrap; minHeight: 18; color: Color veryLightGray. ]. self updateIPAddressField: targetIPAddresses. + sendingPane acceptOnCR: (acceptOnCR ifNil: [acceptOnCR _ true]).! - sendingPane acceptOnCR: (acceptOnCR ifNil: [acceptOnCR := true]).! Item was changed: ----- Method: EToyPeerToPeer>>awaitDataFor: (in category 'receiving') ----- awaitDataFor: aCommunicatorMorph Socket initializeNetwork. + connectionQueue _ ConnectionQueue + portNumber: self class eToyCommunicationsPorts - connectionQueue := ConnectionQueue - portNumber: self class eToyCommunicationsPort queueLength: 6. + communicatorMorph _ aCommunicatorMorph. + process _ [self doAwaitData] newProcess. - communicatorMorph := aCommunicatorMorph. - process := [self doAwaitData] newProcess. process priority: Processor highIOPriority. process resume. ! Item was changed: ----- Method: EToyPeerToPeer>>doConnectForSend (in category 'sending') ----- doConnectForSend + | addr port | - | addr | + addr := NetNameResolver addressForName: (ipAddress copyUpTo: $:). - addr := NetNameResolver addressForName: ipAddress. addr ifNil: [ communicatorMorph commResult: {#message -> ('could not find ',ipAddress)}. + ^false]. + + port := (ipAddress copyAfter: $:) asInteger. + port ifNil: [port := self class eToyCommunicationsPorts first]. + + socket connectNonBlockingTo: addr port: port. - ^false - ]. - socket connectNonBlockingTo: addr port: self class eToyCommunicationsPort. [socket waitForConnectionFor: 15] on: ConnectionTimedOut do: [:ex | communicatorMorph commResult: {#message -> ('no connection to ',ipAddress,' (', + ipAddress,')')}. - (NetNameResolver stringFromAddress: addr),')')}. ^false]. ^true ! Item was changed: ----- Method: EToyPeerToPeer>>doReceiveOneMessage (in category 'receiving') ----- doReceiveOneMessage + | awaitingLength i length answer header | - | awaitingLength i length answer | + awaitingLength _ true. + answer _ WriteStream on: String new. - awaitingLength := true. - answer := WriteStream on: String new. [awaitingLength] whileTrue: [ + leftOverData _ leftOverData , socket receiveData. + (i _ leftOverData indexOf: $ ) > 0 ifTrue: [ + awaitingLength _ false. + header _ leftOverData first: i - 1. + length _ header asNumber. + self parseOptionalHeader: header. - leftOverData := leftOverData , socket receiveData. - (i := leftOverData indexOf: $ ) > 0 ifTrue: [ - awaitingLength := false. - length := (leftOverData first: i - 1) asNumber. answer nextPutAll: (leftOverData allButFirst: i). ]. ]. + leftOverData _ ''. - leftOverData := ''. [answer size < length] whileTrue: [ answer nextPutAll: socket receiveData. communicatorMorph commResult: {#commFlash -> true}. ]. + answer _ answer contents. - answer := answer contents. answer size > length ifTrue: [ + leftOverData _ answer allButFirst: length. + answer _ answer first: length - leftOverData := answer allButFirst: length. - answer := answer first: length ]. ^answer ! Item was changed: ----- Method: EToyPeerToPeer>>doSendData (in category 'sending') ----- doSendData | totalLength myData allTheData | + myData _ dataQueue next ifNil: [socket sendData: '0 '. ^false]. + totalLength _ (myData collect: [ :x | x size]) sum. + socket sendData: totalLength printString, self makeOptionalHeader, ' '. + allTheData _ WriteStream on: (String new: totalLength). - myData := dataQueue next ifNil: [socket sendData: '0 '. ^false]. - totalLength := (myData collect: [ :x | x size]) sum. - socket sendData: totalLength printString,' '. - allTheData := WriteStream on: (String new: totalLength). myData do: [ :chunk | allTheData nextPutAll: chunk asString]. NebraskaDebug at: #peerBytesSent add: {totalLength}. self sendDataCautiously: allTheData contents. ^true ! Item was changed: ----- Method: EToyPeerToPeer>>receiveDataOn:for: (in category 'receiving') ----- receiveDataOn: aSocket for: aCommunicatorMorph + socket _ aSocket. + remoteSocketAddress _ socket remoteSocketAddress hostNumber. + communicatorMorph _ aCommunicatorMorph. + process _ [ + leftOverData _ ''. - socket := aSocket. - remoteSocketAddress := socket remoteAddress. - communicatorMorph := aCommunicatorMorph. - process := [ - leftOverData := ''. [self doReceiveData] whileTrue. socket closeAndDestroy. ] newProcess. process priority: Processor highIOPriority. process resume. ! Item was changed: ----- Method: EToySenderMorph class>>descriptionForPartsBin (in category 'parts bin') ----- (excessive size, no diff calculated) Item was changed: ----- Method: EToySenderMorph>>checkOnAFriend (in category 'as yet unclassified') ----- checkOnAFriend + | gateKeeperEntry caption choices resp | - | gateKeeperEntry caption resp | + gateKeeperEntry _ EToyGateKeeperMorph entryForIPAddress: self ipAddress. + caption _ + 'Last name: ' translated ,gateKeeperEntry latestUserName, + '\Last message in: ' translated ,gateKeeperEntry lastIncomingMessageTimeString, + '\Last status check at: ' translated ,gateKeeperEntry lastTimeCheckedString, + '\Last status in: ' translated ,gateKeeperEntry statusReplyReceivedString. + choices _ 'Get his status now\Send my status now' translated. + resp _ (PopUpMenu labels: choices withCRs) startUpWithCaption: caption withCRs. - gateKeeperEntry := EToyGateKeeperMorph entryForIPAddress: self ipAddress. - caption := - 'Last name: ',gateKeeperEntry latestUserName, - '\Last message in: ',gateKeeperEntry lastIncomingMessageTimeString, - '\Last status check at: ',gateKeeperEntry lastTimeCheckedString, - '\Last status in: ',gateKeeperEntry statusReplyReceivedString. - resp := UIManager default chooseFrom: #('Get his status now' 'Send my status now') - title: caption withCRs. resp = 1 ifTrue: [ gateKeeperEntry lastTimeChecked: Time totalSeconds. self sendStatusCheck. ]. resp = 2 ifTrue: [ self sendStatusReply. ]. ! Item was changed: ----- Method: EToySenderMorph>>startNebraskaClient (in category 'as yet unclassified') ----- startNebraskaClient + | newMorph | - [ + [ + newMorph _ NetworkTerminalMorph connectTo: (self ipAddress copyUpTo: $:). "FIXME: get real port of Nebraska Server" + WorldState addDeferredUIMessage: [newMorph openInStyle: #scaled] fixTemps. - [ | newMorph | - newMorph := NetworkTerminalMorph connectTo: self ipAddress. - WorldState addDeferredUIMessage: [newMorph openInStyle: #scaled]. ] on: Error do: [ :ex | WorldState addDeferredUIMessage: [ + self inform: 'No connection to: ' translated. self ipAddress,' (',ex printString,')' + ] fixTemps - self inform: 'No connection to: '. self ipAddress,' (',ex printString,')' - ] ]. ] fork ! Item was changed: ----- Method: EToySenderMorph>>userName:userPicture:userEmail:userIPAddress: (in category 'as yet unclassified') ----- userName: aString userPicture: aFormOrNil userEmail: emailString userIPAddress: ipString | dropZoneRow | self setProperty: #currentBadgeVersion toValue: self currentBadgeVersion. + userPicture _ aFormOrNil ifNil: [ - userPicture := aFormOrNil ifNil: [ (TextStyle default fontOfSize: 26) emphasized: 1; characterFormAt: $? ]. + userPicture _ userPicture scaledToSize: 61@53. - userPicture := userPicture scaledToSize: 61@53. self killExistingChat. self removeAllMorphs. self useRoundedCorners. self addARow: { self inAColumn: {(StringMorph contents: aString) lock} }. + dropZoneRow _ self - dropZoneRow := self addARow: { self inAColumn: {userPicture asMorph lock} }. self establishDropZone: dropZoneRow. self addARow: { self textEntryFieldNamed: #emailAddress with: emailString help: 'Email address for this person' }; addARow: { self textEntryFieldNamed: #ipAddress with: ipString help: 'IP address for this person' }; addARow: { + self indicatorFieldNamed: #working color: Color blue help: 'working' translated. + self indicatorFieldNamed: #communicating color: Color green help: 'sending' translated. - self indicatorFieldNamed: #working color: Color blue help: 'working'. - self indicatorFieldNamed: #communicating color: Color green help: 'sending'. self buttonNamed: 'C' action: #startChat color: Color paleBlue + help: 'Open a written chat with this person' translated. - help: 'Open a written chat with this person'. self buttonNamed: 'T' action: #startTelemorphic color: Color paleYellow + help: 'Start telemorphic with this person' translated. - help: 'Start telemorphic with this person'. self buttonNamed: '!!' action: #tellAFriend color: Color paleGreen + help: 'Tell this person about the current project' translated. - help: 'Tell this person about the current project'. self buttonNamed: '?' action: #checkOnAFriend color: Color lightBrown + help: 'See if this person is available' translated. + "self buttonNamed: 'A' action: #startAudioChat color: Color yellow + help: 'Open an audio chat with this person' translated." - help: 'See if this person is available'. - self buttonNamed: 'A' action: #startAudioChat color: Color yellow - help: 'Open an audio chat with this person'. self buttonNamed: 'S' action: #startNebraskaClient color: Color white + help: 'See this person''s world (if he allows that)' translated. - help: 'See this person''s world (if he allows that)'. }. ! Item was changed: ----- Method: MorphicTransform>>encodeForRemoteCanvas (in category '*nebraska-*nebraska-Morphic-Remote') ----- encodeForRemoteCanvas "encode this transform into a string for use by a RemoteCanvas" ^String streamContents: [ :str | str nextPutAll: 'Morphic,'; print: offset x truncated; nextPut: $,; print: offset y truncated; nextPut: $,; + print: scale asFloat; - print: scale; nextPut: $,; + print: angle asFloat - print: angle ]! Item was changed: ----- Method: NebraskaClient>>currentStatusString (in category 'as yet unclassified') ----- currentStatusString (connection isNil or: [connection isConnected not]) ifTrue: [^'nada']. + ^connection remoteSocketAddress hostNumber, - ^(NetNameResolver stringFromAddress: connection remoteAddress), ' - ', (self backlog // 1024) printString,'k'! Item was changed: ----- Method: NebraskaClient>>initialize: (in category 'initialization') ----- initialize: aConnection | remoteAddress userPicture | connection := aConnection. hand := RemoteControlledHandMorph on: (MorphicEventDecoder on: aConnection). hand nebraskaClient: self. + remoteAddress _ connection remoteSocketAddress. + userPicture _ EToySenderMorph pictureForIPAddress: remoteAddress. - remoteAddress := connection remoteAddress. - remoteAddress ifNotNil: [remoteAddress := NetNameResolver stringFromAddress: remoteAddress]. - userPicture := EToySenderMorph pictureForIPAddress: remoteAddress. hand userInitials: ((EToySenderMorph nameForIPAddress: remoteAddress) ifNil: ['???']) andPicture: (userPicture ifNotNil: [userPicture scaledToSize: 16@20]). encoder := CanvasEncoder on: aConnection. canvas := RemoteCanvas connection: encoder clipRect: NebraskaServer extremelyBigRectangle transform: MorphicTransform identity! Item was changed: ----- Method: NebraskaNavigationMorph>>buttonBuffered (in category 'as yet unclassified') ----- buttonBuffered + ^self makeButton: 'B' + balloonText: 'Request buffered Nebraska session' translated + for: #bufferNebraska - ^self makeButton: 'B' balloonText: 'Request buffered Nebraska session' for: #bufferNebraska ! Item was changed: ----- Method: NebraskaNavigationMorph>>buttonQuit (in category 'the buttons') ----- buttonQuit + ^self makeButton: 'Quit' translated + balloonText: 'Quit this Nebraska session' translated + for: #quitNebraska - ^self makeButton: 'Quit' balloonText: 'Quit this Nebraska session' for: #quitNebraska ! Item was changed: ----- Method: NebraskaNavigationMorph>>buttonScale (in category 'as yet unclassified') ----- buttonScale + ^self makeButton: '1x1' + balloonText: 'Switch between 1x1 and scaled view' translated + for: #toggleFullView - ^self makeButton: '1x1' balloonText: 'Switch between 1x1 and scaled view' for: #toggleFullView ! Item was changed: ----- Method: NebraskaServer class>>serveWorld: (in category 'instance creation') ----- serveWorld: aWorld + ^self serveWorld: aWorld onPort: self defaultPorts! - ^self serveWorld: aWorld onPort: self defaultPort! Item was changed: ----- Method: NebraskaServerMorph class>>serveWorld: (in category 'as yet unclassified') ----- serveWorld: aWorld "Check to make sure things won't crash. See Mantis #0000519" + ^aWorld isSafeToServe ifTrue:[ + self serveWorld: aWorld onPort: NebraskaServer defaultPorts] + ! - aWorld allMorphsDo:[:m| - m isSafeToServe ifFalse:[ - ^self inform: 'Can not share world if a ', m class, ' is present. Close the mprph and try again']]. - ^self serveWorld: aWorld onPort: NebraskaServer defaultPort! Item was changed: ----- Method: NebraskaServerMorph class>>serveWorld:onPort: (in category 'as yet unclassified') ----- serveWorld: aWorld onPort: aPortNumber | server | server := NebraskaServer serveWorld: aWorld onPort: aPortNumber. (self new) openInWorld: aWorld. + ^server - "server acceptNullConnection" "server acceptPhonyConnection." ! Item was changed: ----- Method: NebraskaServerMorph class>>supplementaryPartsDescriptions (in category 'as yet unclassified') ----- supplementaryPartsDescriptions ^ {DescriptionForPartsBin + formalName: 'NebraskaServer' translatedNoop + categoryList: #() + documentation: 'A button to start the Nebraska desktop sharing server' translatedNoop - formalName: 'NebraskaServer' - categoryList: #('Collaborative') - documentation: 'A button to start the Nebraska desktop sharing server' translated globalReceiverSymbol: #NebraskaServerMorph nativitySelector: #serveWorldButton }! Item was changed: ----- Method: NebraskaServerMorph>>delete (in category 'submorphs-add/remove') ----- delete self server ifNotNil:[ + (self confirm:'Shutdown the server?' translated) - (self confirm:'Shutdown the server?') ifTrue:[self world remoteServer: nil]]. super delete.! Item was changed: ----- Method: NebraskaServerMorph>>rebuild (in category 'initialization') ----- rebuild | myServer toggle closeBox font | + font _ StrikeFont familyName: #Palatino size: 14. - font := StrikeFont familyName: #Palatino size: 14. self removeAllMorphs. self setColorsAndBorder. self updateCurrentStatusString. + toggle _ SimpleHierarchicalListMorph new perform: ( - toggle := SimpleHierarchicalListMorph new perform: ( fullDisplay ifTrue: [#expandedForm] ifFalse: [#notExpandedForm] ). + closeBox _ SimpleButtonMorph new borderWidth: 0; + label: 'X' font: Preferences standardEToysButtonFont; color: Color transparent; - closeBox := SimpleButtonMorph new borderWidth: 0; - label: 'X' font: Preferences standardButtonFont; color: Color transparent; actionSelector: #delete; target: self; extent: 14@14; + setBalloonText: 'End Nebraska session' translated. - setBalloonText: 'End Nebrasks session'. self addARow: { self inAColumn: {closeBox}. self inAColumn: { UpdatingStringMorph new useStringFormat; target: self; font: font; getSelector: #currentStatusString; contents: self currentStatusString; stepTime: 2000; lock. }. self inAColumn: { toggle asMorph on: #mouseUp send: #toggleFull to: self; + setBalloonText: 'Show more or less of Nebraska Status' translated - setBalloonText: 'Show more or less of Nebraska Status' }. }. + myServer _ self server. - myServer := self server. (myServer isNil or: [fullDisplay not]) ifTrue: [ ^World startSteppingSubmorphsOf: self ]. "--- the expanded display ---" self addARow: { self inAColumn: { UpdatingStringMorph new useStringFormat; target: self; font: font; getSelector: #currentBacklogString; contents: self currentBacklogString; stepTime: 2000; lock. }. }. self addARow: { self inAColumn: { (StringMorph contents: '--clients--' translated) lock; font: font. }. }. myServer clients do: [ :each | self addARow: { UpdatingStringMorph new useStringFormat; target: each; font: font; getSelector: #currentStatusString; contents: each currentStatusString; stepTime: 2000; lock. } ]. World startSteppingSubmorphsOf: self.! Item was changed: ----- Method: NebraskaServerMorph>>updateCurrentStatusString (in category 'drawing') ----- updateCurrentStatusString self server ifNil:[ + currentStatusString _ '<Nebraska not active>' translated. + currentBacklogString _ ''. - currentStatusString := '<Nebraska not active>' translated. - currentBacklogString := ''. ] ifNotNil:[ + currentStatusString _ + ' Nebraska: {1} clients' translated format: {self server numClients printString}. + currentBacklogString _ 'backlog: ' translated, + ((previousBacklog _ self server backlog) // 1024) printString,'k' - currentStatusString := - ' Nebraska: ' translated, - self server numClients printString, - ' clients' translated. - currentBacklogString := 'backlog: ' translated, - ((previousBacklog := self server backlog) // 1024) printString,'k' ]. ! Item was changed: ----- Method: NetworkTerminalMorph class>>connectTo: (in category 'instance creation') ----- + connectTo: hostAndPort + | host port | + host := hostAndPort copyUpTo: $:. + port := (hostAndPort copyAfter: $:) asInteger. + port ifNil: [port := NebraskaServer defaultPorts first]. + ^self connectTo: host port:port - connectTo: serverHost - - ^self connectTo: serverHost port: NebraskaServer defaultPort - ! Item was changed: ----- Method: NetworkTerminalMorph class>>socketConnectedTo:port: (in category 'instance creation') ----- socketConnectedTo: serverHost port: serverPort | sock | Socket initializeNetwork. + sock _ Socket new. - sock := Socket new. [sock connectTo: (NetNameResolver addressForName: serverHost) port: serverPort] on: ConnectionTimedOut + do: [:ex | self error: 'could not connect to server' translated ]. - do: [:ex | self error: 'could not connect to server' ]. ^StringSocket on: sock ! Item was changed: ----- Method: NetworkTerminalMorph>>acceptDroppingMorph:event: (in category 'layout') ----- acceptDroppingMorph: morphToDrop event: evt | myCopy outData null | (morphToDrop isKindOf: NewHandleMorph) ifTrue: [ "don't send these" ^morphToDrop rejectDropMorphEvent: evt. ]. self eToyRejectDropMorph: morphToDrop event: evt. "we don't really want it" "7 mar 2001 - remove #veryDeepCopy" + myCopy _ morphToDrop. "gradient fills require doing this second" - myCopy := morphToDrop. "gradient fills require doing this second" myCopy setProperty: #positionInOriginatingWorld toValue: morphToDrop position. + outData _ myCopy eToyStreamedRepresentationNotifying: nil. + null _ String with: 0 asCharacter. - outData := myCopy eToyStreamedRepresentationNotifying: nil. - null := String with: 0 asCharacter. EToyPeerToPeer new sendSomeData: { EToyIncomingMessage typeMorph,null. Preferences defaultAuthorName,null. outData } + to: connection remoteSocketAddress hostNumber - to: (NetNameResolver stringFromAddress: connection remoteAddress) for: self. ! |
Free forum by Nabble | Edit this page |