[Pkg] The Trunk: Nebraska-tfel.46.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Aug 30 09:49:41 UTC 2016
Tim Felgentreff uploaded a new version of Nebraska to project The Trunk:
http://source.squeak.org/trunk/Nebraska-tfel.46.mcz
==================== Summary ====================
Name: Nebraska-tfel.46
Author: tfel
Time: 30 August 2016, 11:49:18.410946 am
UUID: d047e9c0-26c3-8143-b66f-fc3496553dc1
Ancestors: Nebraska-tfel.45, Nebraska-mt.43
Merge Nebraska changes from Squeakland Etoys, and begin untangling Nebraska from Etoys
=============== Diff against Nebraska-mt.43 ===============
Item was changed:
+ SystemOrganization addCategory: #'Nebraska-Morphs-Experimental'!
- SystemOrganization addCategory: #'Nebraska-Audio Chat'!
- SystemOrganization addCategory: #'Nebraska-Morphic-Collaborative'!
- SystemOrganization addCategory: #'Nebraska-Morphic-Experimental'!
SystemOrganization addCategory: #'Nebraska-Morphic-Remote'!
+ SystemOrganization addCategory: #'Nebraska-Network-Communications'!
- SystemOrganization addCategory: #'Nebraska-Network-EToy Communications'!
SystemOrganization addCategory: #'Nebraska-Network-ObjectSocket'!
+ SystemOrganization addCategory: #'Nebraska-Audio Chat'!
+ SystemOrganization addCategory: #'Nebraska-Morphs'!
Item was changed:
+ NebraskaCommunicatorMorph subclass: #AudioChatGUI
- EToyCommunicatorMorph subclass: #AudioChatGUI
instanceVariableNames: 'mycodec myrecorder mytargetip myalert playOnArrival theConnectButton soundBlockNumber soundMessageID queueForMultipleSends transmitWhileRecording theTalkButton handsFreeTalking handsFreeTalkingFlashTime'
classVariableNames: 'DebugLog LiveMessages NewAudioMessages PlayOnArrival'
poolDictionaries: ''
+ category: 'Nebraska-Morphs'!
- category: 'Nebraska-Morphic-Collaborative'!
Item was changed:
----- Method: AudioChatGUI class>>initialize (in category 'class initialization') -----
initialize
+ NebraskaIncomingMessage
+ forType: NebraskaIncomingMessage typeAudioChat
- EToyIncomingMessage
- forType: EToyIncomingMessage typeAudioChat
send: #handleNewAudioChatFrom:sentBy:ipAddress:
to: self.
+ NebraskaIncomingMessage
+ forType: NebraskaIncomingMessage typeAudioChatContinuous
- EToyIncomingMessage
- forType: EToyIncomingMessage typeAudioChatContinuous
send: #handleNewAudioChat2From:sentBy:ipAddress:
to: self.
!
Item was changed:
----- Method: AudioChatGUI>>send (in category 'sending') -----
send
| null rawSound aSampledSound |
mytargetip isEmpty ifTrue: [
^self inform: 'You must connect with someone first.'.
].
rawSound := myrecorder recorder recordedSound ifNil: [^self].
aSampledSound := rawSound asSampledSound.
"Smalltalk at: #Q3 put: {rawSound. rawSound asSampledSound. aCompressedSound}."
self transmitWhileRecording ifTrue: [
self sendOneOfMany: rawSound asSampledSound.
queueForMultipleSends ifNotNil: [queueForMultipleSends nextPut: nil].
queueForMultipleSends := nil.
^self
].
null := String with: 0 asCharacter.
+ NebraskaPeerToPeer new
- EToyPeerToPeer new
sendSomeData: {
+ NebraskaIncomingMessage typeAudioChat,null.
- EToyIncomingMessage typeAudioChat,null.
Preferences defaultAuthorName,null.
aSampledSound originalSamplingRate asInteger printString,null.
(mycodec compressSound: aSampledSound) channels first.
}
to: mytargetip
for: self.
!
Item was changed:
----- Method: AudioChatGUI>>sendOneOfMany: (in category 'sending') -----
sendOneOfMany: aSampledSound
| null message aCompressedSound t ratio resultBuf maxVal |
self samplingRateForTransmission = aSampledSound originalSamplingRate ifTrue: [
aCompressedSound := mycodec compressSound: aSampledSound.
] ifFalse: [
t := [ | oldSamples val newCount fromIndex |
ratio := aSampledSound originalSamplingRate // self samplingRateForTransmission.
oldSamples := aSampledSound samples.
newCount := oldSamples monoSampleCount // ratio.
resultBuf := SoundBuffer newMonoSampleCount: newCount.
fromIndex := 1.
maxVal := 0.
1 to: newCount do: [ :i |
maxVal := maxVal max: (val := oldSamples at: fromIndex).
resultBuf at: i put: val.
fromIndex := fromIndex + ratio.
].
] timeToRun.
NebraskaDebug at: #soundReductionTime add: {t. maxVal}.
maxVal < 400 ifTrue: [
NebraskaDebug at: #soundReductionTime add: {'---dropped---'}.
^self
]. "awfully quiet"
aCompressedSound := mycodec compressSound: (
SampledSound new
setSamples: resultBuf
samplingRate: aSampledSound originalSamplingRate // ratio
).
].
null := String with: 0 asCharacter.
message := {
+ NebraskaIncomingMessage typeAudioChatContinuous,null.
- EToyIncomingMessage typeAudioChatContinuous,null.
Preferences defaultAuthorName,null.
aCompressedSound samplingRate asInteger printString,null.
aCompressedSound channels first.
}.
queueForMultipleSends ifNil: [
+ queueForMultipleSends := NebraskaPeerToPeer new
- queueForMultipleSends := EToyPeerToPeer new
sendSomeData: message
to: mytargetip
for: self
multiple: true.
] ifNotNil: [
queueForMultipleSends nextPut: message
].
!
Item was changed:
----- Method: AudioChatGUI>>talkButtonDown (in category 'sending') -----
talkButtonDown
+ NebraskaListenerMorph confirmListening.
- EToyListenerMorph confirmListening.
self handsFreeTalking ifFalse: [^self record].
theTalkButton label: 'Release'.
!
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 ~= 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.
"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 or: [rule = 34]) ifTrue: [rule := 25]].
- 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 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].
self sendCommand: {
String with: code.
self class encodeInteger: index.
self class encodeFont: aFont }.
!
Item was removed:
- EToyChatOrBadgeMorph subclass: #EToyChatMorph
- instanceVariableNames: 'listener receivingPane myForm recipientForm acceptOnCR sendingPane'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Nebraska-Morphic-Collaborative'!
-
- !EToyChatMorph commentStamp: '<historical>' prior: 0!
- EToyChatMorph new open setIPAddress: '1.2.3.4'
-
- "
- EToyChatMorph represents a chat session with another person. Type your message in the top text pane and press cmd-S.
- "!
Item was removed:
- ----- Method: EToyChatMorph class>>chatFrom:name:text: (in category 'as yet unclassified') -----
- chatFrom: ipAddress name: senderName text: text
-
- | chatWindow |
-
- chatWindow := self
- chatWindowForIP: ipAddress
- name: senderName
- picture: (EToySenderMorph pictureForIPAddress: ipAddress)
- inWorld: self currentWorld.
- chatWindow
- chatFrom: ipAddress
- name: senderName
- text: text
- !
Item was removed:
- ----- 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 ifNotNil: [^existing].
- makeANewOne := [
- self new
- recipientForm: aForm;
- open;
- setIPAddress: ipAddress
- ].
- EToyCommunicatorMorph playArrivalSound.
- self doChatsInternalToBadge ifTrue: [
- aSenderBadge := EToySenderMorph instanceForIP: ipAddress inWorld: aWorld.
- aSenderBadge ifNotNil: [
- aSenderBadge startChat: false.
- ^aSenderBadge
- findDeepSubmorphThat: [ :x | x isKindOf: EToyChatMorph]
- ifAbsent: makeANewOne
- ].
- aSenderBadge := EToySenderMorph instanceForIP: ipAddress.
- aSenderBadge ifNotNil: [
- aSenderBadge := aSenderBadge veryDeepCopy.
- aSenderBadge
- killExistingChat;
- openInWorld: aWorld;
- startChat: false.
- ^aSenderBadge
- findDeepSubmorphThat: [ :x | x isKindOf: EToyChatMorph]
- ifAbsent: makeANewOne
- ].
- (aSenderBadge := EToySenderMorph new)
- userName: senderName
- userPicture: aForm
- userEmail: 'unknown'
- userIPAddress: ipAddress;
- position: 200 at 200;
- openInWorld: aWorld;
- startChat: false.
- ^aSenderBadge
- findDeepSubmorphThat: [ :x | x isKindOf: EToyChatMorph]
- ifAbsent: makeANewOne
- ].
- ^makeANewOne value.
-
- !
Item was removed:
- ----- Method: EToyChatMorph class>>descriptionForPartsBin (in category 'parts bin') -----
- descriptionForPartsBin
-
- ^ self partName: 'Text chat'
- categories: #('Collaborative')
- documentation: 'A tool for sending messages to other Squeak users'!
Item was removed:
- ----- Method: EToyChatMorph class>>doChatsInternalToBadge (in category 'as yet unclassified') -----
- doChatsInternalToBadge
-
- ^true!
Item was removed:
- ----- Method: EToyChatMorph class>>instanceForIP:inWorld: (in category 'as yet unclassified') -----
- instanceForIP: ipAddress inWorld: aWorld
-
- ^self allInstances detect: [ :x |
- x world == aWorld and: [x ipAddress = ipAddress]
- ] ifNone: [nil]
-
- !
Item was removed:
- ----- Method: EToyChatMorph>>acceptTo:forMorph: (in category 'as yet unclassified') -----
- acceptTo: someText forMorph: aMorph
-
- | betterText |
-
- betterText := self improveText: someText forMorph: aMorph.
- self
- transmitStreamedObject: (betterText eToyStreamedRepresentationNotifying: self)
- to: self ipAddress.
- aMorph setText: '' asText.
- self appendMessage:
- self startOfMessageFromMe,
- ' - ',
- betterText,
- String cr.
-
- ^true!
Item was removed:
- ----- Method: EToyChatMorph>>appendMessage: (in category 'as yet unclassified') -----
- appendMessage: aText
-
- receivingPane appendTextEtoy: aText.!
Item was removed:
- ----- Method: EToyChatMorph>>chatFrom:name:text: (in category 'as yet unclassified') -----
- chatFrom: ipAddress name: senderName text: text
-
- | initialText attrib |
-
- recipientForm ifNil: [
- initialText := senderName asText allBold.
- ] ifNotNil: [
- attrib := TextAnchor new anchoredMorph: recipientForm "asMorph".
- initialText := (String value: 1) asText.
- initialText addAttribute: attrib from: 1 to: 1.
- ].
- self appendMessage: initialText,' - ',text,String cr.
- EToyCommunicatorMorph playArrivalSound.
-
-
- !
Item was removed:
- ----- Method: EToyChatMorph>>defaultBorderColor (in category 'initialization') -----
- defaultBorderColor
- "answer the default border color/fill style for the receiver"
- ^ self standardBorderColor!
Item was removed:
- ----- Method: EToyChatMorph>>defaultBorderWidth (in category 'initialization') -----
- defaultBorderWidth
- "answer the default border width for the receiver"
- ^ 8!
Item was removed:
- ----- Method: EToyChatMorph>>defaultBounds (in category 'initialization') -----
- defaultBounds
- "answer the default bounds for the receiver"
- ^ 400 @ 100 extent: 200 @ 150!
Item was removed:
- ----- Method: EToyChatMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ Color paleYellow!
Item was removed:
- ----- Method: EToyChatMorph>>getChoice: (in category 'as yet unclassified') -----
- getChoice: aSymbol
-
- aSymbol == #acceptOnCR ifTrue: [^acceptOnCR ifNil: [true]].
- ^false.
- !
Item was removed:
- ----- Method: EToyChatMorph>>improveText:forMorph: (in category 'as yet unclassified') -----
- improveText: someText forMorph: aMorph
-
- | betterText conversions fontForAll |
-
- fontForAll := aMorph eToyGetMainFont.
- betterText := someText veryDeepCopy.
- conversions := OrderedCollection new.
- betterText runs withStartStopAndValueDo: [:start :stop :attributes |
- attributes do: [:att |
- (att isMemberOf: TextFontChange) ifTrue: [
- conversions add: {att. start. stop}
- ]
- ]
- ].
- conversions do: [ :old |
- | newAttr |
- betterText removeAttribute: old first from: old second to: old third.
- newAttr := TextFontReference toFont: (fontForAll fontAt: old first fontNumber).
- newAttr fontNumber: old first fontNumber.
- betterText addAttribute: newAttr from: old second to: old third.
- ].
- ^betterText!
Item was removed:
- ----- Method: EToyChatMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- ""
- acceptOnCR := true.
- self listDirection: #topToBottom;
- layoutInset: 0;
- hResizing: #shrinkWrap;
- vResizing: #shrinkWrap;
- rubberBandCells: false;
- minWidth: 200;
- minHeight: 200;
- rebuild !
Item was removed:
- ----- Method: EToyChatMorph>>insetTheScrollbars (in category 'as yet unclassified') -----
- insetTheScrollbars
-
- self allMorphsDo: [ :each |
- (each isKindOf: PluggableTextMorph) ifTrue: [each retractable: false]
- ].!
Item was removed:
- ----- Method: EToyChatMorph>>ipAddress (in category 'as yet unclassified') -----
- ipAddress
-
- ^(fields at: #ipAddress) contents!
Item was removed:
- ----- Method: EToyChatMorph>>open (in category 'as yet unclassified') -----
- open
-
- ^self openIn: self currentWorld!
Item was removed:
- ----- Method: EToyChatMorph>>openIn: (in category 'as yet unclassified') -----
- openIn: aWorld
-
- "open an a chat window"
-
- aWorld ifNil: [^self].
- self
- position: 400 at 100;
- extent: 200 at 150;
- openInWorld: aWorld.!
Item was removed:
- ----- Method: EToyChatMorph>>rebuild (in category 'as yet unclassified') -----
- rebuild
- | r1 r2 |
-
- 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'.
- }.
- recipientForm ifNotNil: [
- r1 addMorphBack: recipientForm asMorph lock
- ].
- 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'; 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.
- ].
- sendingPane acceptOnCR: (acceptOnCR ifNil: [acceptOnCR := true])!
Item was removed:
- ----- Method: EToyChatMorph>>recipientForm: (in category 'as yet unclassified') -----
- recipientForm: aForm
-
- recipientForm := aForm.
- recipientForm ifNotNil: [recipientForm := recipientForm scaledToSize: 20 at 20].!
Item was removed:
- ----- Method: EToyChatMorph>>reportError: (in category 'as yet unclassified') -----
- reportError: aString
-
- receivingPane appendTextEtoy: (aString asText addAttribute: TextColor red), String cr.!
Item was removed:
- ----- Method: EToyChatMorph>>setIPAddress: (in category 'as yet unclassified') -----
- setIPAddress: aString
-
- (fields at: #ipAddress) contents: aString!
Item was removed:
- ----- Method: EToyChatMorph>>standardBorderColor (in category 'as yet unclassified') -----
- standardBorderColor
-
- ^Color darkGray!
Item was removed:
- ----- Method: EToyChatMorph>>startOfMessageFromMe (in category 'as yet unclassified') -----
- startOfMessageFromMe
-
- myForm ifNil: [
- myForm := EToySenderMorph pictureForIPAddress: NetNameResolver localAddressString.
- myForm ifNotNil: [
- myForm := myForm scaledToSize: 20 at 20
- ].
- ].
- myForm ifNil: [
- ^(Preferences defaultAuthorName asText allBold addAttribute: TextColor blue)
- ].
- ^(String value: 1) asText
- addAttribute: (TextAnchor new anchoredMorph: myForm);
- yourself
-
- !
Item was removed:
- ----- Method: EToyChatMorph>>toggleChoice: (in category 'as yet unclassified') -----
- toggleChoice: aSymbol
-
- aSymbol == #acceptOnCR ifTrue: [
- acceptOnCR := (acceptOnCR ifNil: [true]) not.
- sendingPane ifNotNil: [sendingPane acceptOnCR: acceptOnCR].
- ^self
- ].
-
- !
Item was removed:
- ----- Method: EToyChatMorph>>transmittedObjectCategory (in category 'as yet unclassified') -----
- transmittedObjectCategory
-
- ^EToyIncomingMessage typeKeyboardChat!
Item was removed:
- EToyCommunicatorMorph subclass: #EToyChatOrBadgeMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Nebraska-Morphic-Experimental'!
Item was removed:
- ----- Method: EToyChatOrBadgeMorph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
- includeInNewMorphMenu
- "Not to be instantiated from the menu"
- ^ self ~~ EToyChatOrBadgeMorph!
Item was removed:
- ----- Method: EToyCommunicatorMorph>>addGateKeeperMorphs (in category '*nebraska-*nebraska-Morphic-Collaborative') -----
- addGateKeeperMorphs
-
- | list currentTime choices |
-
- self setProperty: #gateKeeperCounterValue toValue: EToyGateKeeperMorph updateCounter.
- choices := #(
- (60 'm' 'in the last minute')
- (3600 'h' 'in the last hour')
- (86400 'd' 'in the last day')
- ).
- currentTime := Time totalSeconds.
- list := EToyGateKeeperMorph knownIPAddresses.
- list do: [ :each | | age row |
- age := each timeBetweenLastAccessAnd: currentTime.
- age := choices
- detect: [ :x | age <= x first]
- ifNone: [{0. '-'. (age // 86400) printString,'days ago'}].
- row := self addARow:
- (EToyIncomingMessage allTypes collect: [ :type |
- self toggleButtonFor: each attribute: type]
- ),
- {
-
- (self inAColumn: {
- (StringMorph contents: age second) lock.
- }) layoutInset: 2; hResizing: #shrinkWrap; setBalloonText: 'Last attempt was ',age third.
-
- (self inAColumn: {
- (StringMorph contents: each ipAddress) lock.
- }) layoutInset: 2; hResizing: #shrinkWrap.
-
- (self inAColumn: {
- (StringMorph contents: each latestUserName) lock.
- }) layoutInset: 2.
- }.
- row
- color: (Color r: 0.6 g: 0.8 b: 1.0);
- borderWidth: 1;
- borderColor: #raised;
- vResizing: #spaceFill;
- "on: #mouseUp send: #mouseUp:in: to: self;"
- setBalloonText: each fullInfoString
- ].!
Item was removed:
- ----- Method: EToyCommunicatorMorph>>transmitStreamedObject:as:to: (in category '*nebraska-*nebraska-Morphic-Collaborative') -----
- transmitStreamedObject: outData as: objectCategory to: anIPAddress
-
- EToyPeerToPeer transmitStreamedObject: outData as: objectCategory to: anIPAddress for: self!
Item was removed:
- ----- Method: EToyCommunicatorMorph>>transmitStreamedObject:to: (in category '*nebraska-*nebraska-Morphic-Collaborative') -----
- transmitStreamedObject: outData to: anIPAddress
-
- self transmitStreamedObject: outData as: self transmittedObjectCategory to: anIPAddress
- !
Item was removed:
- EToyCommunicatorMorph subclass: #EToyFridgeMorph
- instanceVariableNames: 'recipients incomingRow recipientRow updateCounter groupMode'
- classVariableNames: 'FridgeRecipients NewItems TheFridgeForm UpdateCounter'
- poolDictionaries: ''
- category: 'Nebraska-Morphic-Collaborative'!
-
- !EToyFridgeMorph commentStamp: '<historical>' prior: 0!
- EToyFridgeMorph new openInWorld!
Item was removed:
- ----- Method: EToyFridgeMorph class>>addRecipient: (in category 'as yet unclassified') -----
- addRecipient: aSenderMorph
-
- self fridgeRecipients do: [ :each |
- aSenderMorph ipAddress = each ipAddress ifTrue: [^self]
- ].
- self fridgeRecipients add: aSenderMorph.
- UpdateCounter := self updateCounter + 1
- !
Item was removed:
- ----- Method: EToyFridgeMorph class>>descriptionForPartsBin (in category 'parts bin') -----
- descriptionForPartsBin
-
- ^ self partName: 'Fridge'
- categories: #('Collaborative')
- documentation: 'A tool for sending objects to other Squeak users'!
Item was removed:
- ----- Method: EToyFridgeMorph class>>fridgeForm (in category 'as yet unclassified') -----
- fridgeForm
-
- | fridgeFileName |
-
- fridgeFileName := 'fridge.form'.
- TheFridgeForm ifNotNil: [^TheFridgeForm].
- (FileDirectory default fileExists: fridgeFileName) ifFalse: [^nil].
- ^TheFridgeForm := Form fromFileNamed: fridgeFileName.!
Item was removed:
- ----- Method: EToyFridgeMorph class>>fridgeRecipients (in category 'as yet unclassified') -----
- fridgeRecipients
-
- ^FridgeRecipients ifNil: [FridgeRecipients := OrderedCollection new]!
Item was removed:
- ----- Method: EToyFridgeMorph class>>newItem: (in category 'as yet unclassified') -----
- newItem: newMorph
-
- | theFridge fridgeWorld trialRect |
-
- theFridge := Project named: 'Fridge'.
- theFridge ifNil: [^self newItems add: newMorph].
- fridgeWorld := theFridge world.
- trialRect := fridgeWorld randomBoundsFor: newMorph.
- fridgeWorld
- addMorphFront: (newMorph position: trialRect topLeft);
- startSteppingSubmorphsOf: newMorph
- !
Item was removed:
- ----- Method: EToyFridgeMorph class>>newItems (in category 'as yet unclassified') -----
- newItems
-
- ^NewItems ifNil: [NewItems := OrderedCollection new]!
Item was removed:
- ----- Method: EToyFridgeMorph class>>removeRecipientWithIPAddress: (in category 'as yet unclassified') -----
- removeRecipientWithIPAddress: ipString
-
- FridgeRecipients := self fridgeRecipients reject: [ :each |
- ipString = each ipAddress
- ].
- UpdateCounter := self updateCounter + 1
- !
Item was removed:
- ----- Method: EToyFridgeMorph class>>updateCounter (in category 'as yet unclassified') -----
- updateCounter
-
- ^UpdateCounter ifNil: [0]!
Item was removed:
- ----- Method: EToyFridgeMorph>>acceptDroppingMorph:event: (in category 'layout') -----
- acceptDroppingMorph: morphToDrop event: evt
-
- | outData |
-
- (morphToDrop isKindOf: NewHandleMorph) ifTrue: [ "don't send these"
- ^morphToDrop rejectDropMorphEvent: evt
- ].
- self eToyRejectDropMorph: morphToDrop event: evt. "we will keep a copy"
- (morphToDrop isKindOf: EToySenderMorph) ifTrue: [
- self class addRecipient: morphToDrop.
- ^self rebuild
- ].
- self stopFlashing.
- "7 mar 2001 - remove #veryDeepCopy"
- outData := morphToDrop eToyStreamedRepresentationNotifying: self.
- self resetIndicator: #working.
- self class fridgeRecipients do: [ :each |
- self transmitStreamedObject: outData to: each ipAddress
- ].
-
- !
Item was removed:
- ----- Method: EToyFridgeMorph>>defaultBorderColor (in category 'initialization') -----
- defaultBorderColor
- "answer the default border color/fill style for the receiver"
- ^ #raised!
Item was removed:
- ----- Method: EToyFridgeMorph>>defaultBorderWidth (in category 'initialization') -----
- defaultBorderWidth
- "answer the default border width for the receiver"
- ^ 4!
Item was removed:
- ----- Method: EToyFridgeMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ Color paleRed!
Item was removed:
- ----- Method: EToyFridgeMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
-
- | f cache |
- f := self class fridgeForm ifNil: [^super drawOn: aCanvas].
- cache := Form extent: bounds extent depth: aCanvas depth.
- f
- displayInterpolatedIn: cache boundingBox truncated
- on: cache.
- cache replaceColor: Color black withColor: Color transparent.
- aCanvas
- translucentImage: cache
- at: bounds origin.
- !
Item was removed:
- ----- Method: EToyFridgeMorph>>getChoice: (in category 'as yet unclassified') -----
- getChoice: aString
-
- aString = 'group' ifTrue: [^groupMode ifNil: [true]].!
Item was removed:
- ----- 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';
- step
- }) hResizing: #shrinkWrap
- !
Item was removed:
- ----- Method: EToyFridgeMorph>>handlesMouseDown: (in category 'event handling') -----
- handlesMouseDown: globalEvt
-
- | localCursorPoint |
- localCursorPoint := self globalPointToLocal: globalEvt cursorPoint.
- groupMode ifFalse: [
- self allMorphsDo: [ :each |
- (each isKindOf: EToySenderMorph) ifTrue: [
- (each bounds containsPoint: localCursorPoint) ifTrue: [^false].
- ].
- ].
- ].
- ^true!
Item was removed:
- ----- Method: EToyFridgeMorph>>handlesMouseOver: (in category 'event handling') -----
- handlesMouseOver: globalEvt
-
- ^true!
Item was removed:
- ----- Method: EToyFridgeMorph>>handlesMouseOverDragging: (in category 'event handling') -----
- handlesMouseOverDragging: globalEvt
-
- ^true!
Item was removed:
- ----- Method: EToyFridgeMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- ""
- groupMode := true.
- self listDirection: #topToBottom;
- layoutInset: 10;
- hResizing: #shrinkWrap;
- vResizing: #shrinkWrap;
- setProperty: #normalBorderColor toValue: self borderColor;
- setProperty: #flashingColors toValue: {Color red. Color yellow};
- rebuild!
Item was removed:
- ----- Method: EToyFridgeMorph>>mouseDown: (in category 'event handling') -----
- mouseDown: localEvt
-
- self addMouseActionIndicatorsWidth: 15 color: (Color blue alpha: 0.7).
- !
Item was removed:
- ----- Method: EToyFridgeMorph>>mouseEnter: (in category 'event handling') -----
- mouseEnter: evt
-
- ^self mouseEnterEither: evt
- !
Item was removed:
- ----- Method: EToyFridgeMorph>>mouseEnterDragging: (in category 'event handling') -----
- mouseEnterDragging: evt
-
- ^self mouseEnterEither: evt
- !
Item was removed:
- ----- Method: EToyFridgeMorph>>mouseEnterEither: (in category 'as yet unclassified') -----
- mouseEnterEither: evt
-
- evt hand hasSubmorphs ifFalse: [
- ^self addMouseActionIndicatorsWidth: 10 color: (Color blue alpha: 0.3).
- ].
- (evt hand firstSubmorph isKindOf: EToySenderMorph) ifTrue: [
- ^self addMouseActionIndicatorsWidth: 10 color: (Color magenta alpha: 0.3).
- ].
- self addMouseActionIndicatorsWidth: 10 color: (Color green alpha: 0.3).
-
- !
Item was removed:
- ----- Method: EToyFridgeMorph>>mouseLeave: (in category 'event handling') -----
- mouseLeave: evt
-
- ^self mouseLeaveEither: evt
- !
Item was removed:
- ----- Method: EToyFridgeMorph>>mouseLeaveDragging: (in category 'event handling') -----
- mouseLeaveDragging: evt
-
- ^self mouseLeaveEither: evt
- !
Item was removed:
- ----- Method: EToyFridgeMorph>>mouseLeaveEither: (in category 'as yet unclassified') -----
- mouseLeaveEither: evt
-
- self deleteAnyMouseActionIndicators.
-
- !
Item was removed:
- ----- Method: EToyFridgeMorph>>mouseUp: (in category 'event handling') -----
- mouseUp: localEvt
-
- (self containsPoint: localEvt cursorPoint) ifFalse: [^self].
- Project enterIfThereOrFind: 'Fridge'!
Item was removed:
- ----- Method: EToyFridgeMorph>>noteRemovalOf: (in category 'as yet unclassified') -----
- noteRemovalOf: aSenderMorph
-
- self class removeRecipientWithIPAddress: aSenderMorph ipAddress!
Item was removed:
- ----- Method: EToyFridgeMorph>>rebuild (in category 'as yet unclassified') -----
- rebuild
-
- | row filler fudge people maxPerRow insetY |
-
- updateCounter := self class updateCounter.
- self removeAllMorphs.
- (self addARow: {
- filler := Morph new color: Color transparent; extent: 4 at 4.
- }) vResizing: #shrinkWrap.
- self addARow: {
- (StringMorph contents: 'the Fridge') lock.
- self groupToggleButton.
- }.
- 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 addMorphBack: (
- groupMode ifTrue: [
- (each userPicture scaledToSize: 35 at 35) asMorph lock
- ] ifFalse: [
- each veryDeepCopy killExistingChat
- ]
- )
- ].
- fullBounds := nil.
- self fullBounds.
- "htsBefore := submorphs collect: [ :each | each height]."
-
- 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].
- {htsBefore. htsAfter} explore."
-
- !
Item was removed:
- ----- Method: EToyFridgeMorph>>step (in category 'stepping and presenter') -----
- step
-
- super step.
- updateCounter = self class updateCounter ifFalse: [self rebuild].
- !
Item was removed:
- ----- Method: EToyFridgeMorph>>toggleChoice: (in category 'as yet unclassified') -----
- toggleChoice: aString
-
- updateCounter := nil. "force rebuild"
- aString = 'group' ifTrue: [^groupMode := (groupMode ifNil: [true]) not].
- !
Item was removed:
- ----- Method: EToyFridgeMorph>>transmittedObjectCategory (in category 'as yet unclassified') -----
- transmittedObjectCategory
-
- ^EToyIncomingMessage typeFridge!
Item was removed:
- ----- Method: EToyFridgeMorph>>trulyFlashIndicator: (in category 'as yet unclassified') -----
- trulyFlashIndicator: aSymbol
-
- | state |
-
- state := (self
- valueOfProperty: #fridgeFlashingState
- ifAbsent: [false]) not.
- self setProperty: #fridgeFlashingState toValue: state.
-
- self
- addMouseActionIndicatorsWidth: 15
- color: (Color green alpha: (state ifTrue: [0.3] ifFalse: [0.7])). Beeper beep.
- "self world displayWorldSafely."!
Item was removed:
- ----- Method: EToyFridgeMorph>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
- wantsDroppedMorph: aMorph event: evt
-
- ^true!
Item was removed:
- MorphicModel subclass: #EToyGateKeeperEntry
- instanceVariableNames: 'ipAddress accessAttempts lastTimes acceptableTypes latestUserName attempsDenied lastRequests'
- classVariableNames: 'KnownIPAddresses'
- poolDictionaries: ''
- category: 'Nebraska-Morphic-Experimental'!
Item was removed:
- ----- Method: EToyGateKeeperEntry class>>includeInNewMorphMenu (in category 'new-morph participation') -----
- includeInNewMorphMenu
- "Not to be instantiated from the menu"
- ^ false!
Item was removed:
- ----- Method: EToyGateKeeperEntry>>acceptableTypes (in category 'as yet unclassified') -----
- acceptableTypes
-
- ^acceptableTypes!
Item was removed:
- ----- Method: EToyGateKeeperEntry>>dateAndTimeStringFrom: (in category 'as yet unclassified') -----
- dateAndTimeStringFrom: totalSeconds
-
- | dateAndTime |
- dateAndTime := Time dateAndTimeFromSeconds: totalSeconds.
- ^dateAndTime first printString,' ',dateAndTime second printString!
Item was removed:
- ----- Method: EToyGateKeeperEntry>>fullInfoString (in category 'as yet unclassified') -----
- fullInfoString
-
- ^self latestUserName,
- ' at ',
- ipAddress ,
- ' attempts: ',
- accessAttempts printString,
- '/',
- attempsDenied printString,
- ' last: ',
- (self lastIncomingMessageTimeString)
-
- "acceptableTypes"
-
- !
Item was removed:
- ----- Method: EToyGateKeeperEntry>>getChoice: (in category 'as yet unclassified') -----
- getChoice: aString
-
- ^acceptableTypes includes: aString!
Item was removed:
- ----- Method: EToyGateKeeperEntry>>initialize (in category 'initialization') -----
- initialize
-
- self flag: #bob. "need to decide better initial types"
-
- super initialize.
- ipAddress := '???'.
- accessAttempts := attempsDenied := 0.
- lastRequests := OrderedCollection new.
- acceptableTypes := Set withAll: EToyIncomingMessage allTypes.
-
- !
Item was removed:
- ----- Method: EToyGateKeeperEntry>>ipAddress (in category 'as yet unclassified') -----
- ipAddress
-
- ^ipAddress!
Item was removed:
- ----- Method: EToyGateKeeperEntry>>ipAddress: (in category 'as yet unclassified') -----
- ipAddress: aString
-
- ipAddress := aString!
Item was removed:
- ----- Method: EToyGateKeeperEntry>>lastIncomingMessageTimeString (in category 'as yet unclassified') -----
- lastIncomingMessageTimeString
-
- lastRequests isEmpty ifTrue: [^'never'].
- ^self dateAndTimeStringFrom: lastRequests first first
- !
Item was removed:
- ----- Method: EToyGateKeeperEntry>>lastTimeChecked (in category 'as yet unclassified') -----
- lastTimeChecked
-
- ^self valueOfProperty: #lastTimeChecked
- !
Item was removed:
- ----- Method: EToyGateKeeperEntry>>lastTimeChecked: (in category 'as yet unclassified') -----
- lastTimeChecked: aDateAndTimeInSeconds
-
- self setProperty: #lastTimeChecked toValue: aDateAndTimeInSeconds
- !
Item was removed:
- ----- Method: EToyGateKeeperEntry>>lastTimeCheckedString (in category 'as yet unclassified') -----
- lastTimeCheckedString
-
- | statusTime |
- statusTime := self valueOfProperty: #lastTimeChecked ifAbsent: [^'none'].
- ^(self dateAndTimeStringFrom: statusTime)!
Item was removed:
- ----- Method: EToyGateKeeperEntry>>latestUserName (in category 'as yet unclassified') -----
- latestUserName
-
- ^latestUserName ifNil: ['???']!
Item was removed:
- ----- Method: EToyGateKeeperEntry>>latestUserName: (in category 'as yet unclassified') -----
- latestUserName: aString
-
- latestUserName := aString!
Item was removed:
- ----- Method: EToyGateKeeperEntry>>requestAccessOfType: (in category 'as yet unclassified') -----
- requestAccessOfType: aString
-
- | ok |
-
- accessAttempts := accessAttempts + 1.
- lastRequests addFirst: {Time totalSeconds. aString}.
- lastRequests size > 10 ifTrue: [
- lastRequests := lastRequests copyFrom: 1 to: 10.
- ].
- ok := (acceptableTypes includes: aString) or: [acceptableTypes includes: 'all'].
- ok ifFalse: [attempsDenied := attempsDenied + 1].
- ^ok!
Item was removed:
- ----- Method: EToyGateKeeperEntry>>statusReplyReceived: (in category 'as yet unclassified') -----
- statusReplyReceived: anArray
-
- self setProperty: #lastStatusReplyTime toValue: Time totalSeconds.
- self setProperty: #lastStatusReply toValue: anArray.!
Item was removed:
- ----- Method: EToyGateKeeperEntry>>statusReplyReceivedString (in category 'as yet unclassified') -----
- statusReplyReceivedString
-
- | statusTime |
- statusTime := self valueOfProperty: #lastStatusReplyTime ifAbsent: [^'none'].
- ^(self dateAndTimeStringFrom: statusTime),' accepts:
- ', (self valueOfProperty: #lastStatusReply) asArray printString!
Item was removed:
- ----- Method: EToyGateKeeperEntry>>timeBetweenLastAccessAnd: (in category 'as yet unclassified') -----
- timeBetweenLastAccessAnd: currentTime
-
- lastRequests isEmpty ifTrue: [^0].
- ^currentTime - lastRequests first first
- !
Item was removed:
- ----- Method: EToyGateKeeperEntry>>toggleChoice: (in category 'as yet unclassified') -----
- toggleChoice: aString
-
- (acceptableTypes includes: aString) ifTrue: [
- acceptableTypes remove: aString ifAbsent: []
- ] ifFalse: [
- acceptableTypes add: aString
- ].!
Item was removed:
- EToyCommunicatorMorph subclass: #EToyGateKeeperMorph
- instanceVariableNames: 'counter'
- classVariableNames: 'KnownIPAddresses UpdateCounter'
- poolDictionaries: ''
- category: 'Nebraska-Morphic-Experimental'!
-
- !EToyGateKeeperMorph commentStamp: '<historical>' prior: 0!
- EToyGateKeeperMorph new open
-
- "
- I am used to control the types of connections a user is willing to allow.
- "!
Item was removed:
- ----- Method: EToyGateKeeperMorph class>>acceptRequest:from:at: (in category 'as yet unclassified') -----
- acceptRequest: requestType from: senderName at: ipAddressString
-
- | entry |
-
- UpdateCounter := self updateCounter + 1.
- entry := self entryForIPAddress: ipAddressString.
- senderName isEmpty ifFalse: [entry latestUserName: senderName].
- ^entry requestAccessOfType: requestType!
Item was removed:
- ----- Method: EToyGateKeeperMorph class>>acceptableTypesFor: (in category 'as yet unclassified') -----
- acceptableTypesFor: ipAddressString
-
- ^(self knownIPAddresses at: ipAddressString ifAbsent: [^#()]) acceptableTypes!
Item was removed:
- ----- Method: EToyGateKeeperMorph class>>entryForIPAddress: (in category 'as yet unclassified') -----
- entryForIPAddress: ipAddressString
-
- | known entry |
-
- UpdateCounter := self updateCounter + 1.
- known := self knownIPAddresses.
- entry := known at: ipAddressString ifAbsentPut: [
- entry := EToyGateKeeperEntry new.
- entry ipAddress: ipAddressString.
- entry
- ].
- ^entry!
Item was removed:
- ----- Method: EToyGateKeeperMorph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
- includeInNewMorphMenu
- "Not to be instantiated from the menu"
- ^ false!
Item was removed:
- ----- Method: EToyGateKeeperMorph class>>knownIPAddresses (in category 'as yet unclassified') -----
- knownIPAddresses
-
- ^KnownIPAddresses ifNil: [KnownIPAddresses := Dictionary new]!
Item was removed:
- ----- Method: EToyGateKeeperMorph class>>updateCounter (in category 'as yet unclassified') -----
- updateCounter
-
- ^UpdateCounter ifNil: [UpdateCounter := 0]!
Item was removed:
- ----- Method: EToyGateKeeperMorph>>defaultBorderColor (in category 'initialization') -----
- defaultBorderColor
- "answer the default border color/fill style for the receiver"
- ^ #raised!
Item was removed:
- ----- Method: EToyGateKeeperMorph>>defaultBorderWidth (in category 'initialization') -----
- defaultBorderWidth
- "answer the default border width for the receiver"
- ^ 4!
Item was removed:
- ----- Method: EToyGateKeeperMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ Color lightGray!
Item was removed:
- ----- Method: EToyGateKeeperMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- ""
- self listDirection: #topToBottom;
- layoutInset: 4;
- hResizing: #spaceFill;
- vResizing: #spaceFill;
- useRoundedCorners;
- rebuild !
Item was removed:
- ----- Method: EToyGateKeeperMorph>>open (in category 'as yet unclassified') -----
- open
-
- self rebuild.
- self openInWorld.!
Item was removed:
- ----- Method: EToyGateKeeperMorph>>rebuild (in category 'as yet unclassified') -----
- rebuild
-
- self removeAllMorphs.
- self addGateKeeperMorphs.
- !
Item was removed:
- ----- Method: EToyGateKeeperMorph>>step (in category 'stepping and presenter') -----
- step
-
- (self valueOfProperty: #gateKeeperCounterValue) =
- EToyGateKeeperMorph updateCounter ifTrue: [^self].
- self rebuild.
- !
Item was removed:
- Object subclass: #EToyIncomingMessage
- instanceVariableNames: ''
- classVariableNames: 'MessageHandlers MessageTypes'
- poolDictionaries: ''
- category: 'Nebraska-Morphic-Experimental'!
Item was removed:
- ----- Method: EToyIncomingMessage class>>allTypes (in category 'message types') -----
- allTypes
-
- ^MessageTypes ifNil: [
- MessageTypes := {
- self typeKeyboardChat.
- self typeMorph.
- self typeFridge.
- self typeStatusRequest.
- self typeStatusReply.
- self typeSeeDesktop.
- self typeAudioChat.
- self typeAudioChatContinuous.
- self typeMultiChat.
- }
- ]
- !
Item was removed:
- ----- Method: EToyIncomingMessage class>>forType:send:to: (in category 'as yet unclassified') -----
- forType: aMessageType send: aSymbol to: anObject
-
- self messageHandlers at: aMessageType put: {aSymbol. anObject}!
Item was removed:
- ----- Method: EToyIncomingMessage class>>handleNewChatFrom:sentBy:ipAddress: (in category 'handlers') -----
- handleNewChatFrom: dataStream sentBy: senderName ipAddress: ipAddressString
-
- ^ EToyChatMorph
- chatFrom: ipAddressString
- name: senderName
- text: (self newObjectFromStream: dataStream).
- !
Item was removed:
- ----- Method: EToyIncomingMessage class>>handleNewFridgeMorphFrom:sentBy:ipAddress: (in category 'handlers') -----
- handleNewFridgeMorphFrom: dataStream sentBy: senderName ipAddress: ipAddressString
-
- | newObject |
-
- newObject := self newObjectFromStream: dataStream.
- newObject
- setProperty: #fridgeSender toValue: senderName;
- setProperty: #fridgeIPAddress toValue: ipAddressString;
- setProperty: #fridgeDate toValue: Time dateAndTimeNow.
- WorldState addDeferredUIMessage: [EToyFridgeMorph newItem: newObject].
- !
Item was removed:
- ----- Method: EToyIncomingMessage class>>handleNewMorphFrom:sentBy:ipAddress: (in category 'handlers') -----
- handleNewMorphFrom: dataStream sentBy: senderName ipAddress: ipAddressString
-
- | newObject thumbForm targetWorld |
-
- newObject := self newObjectFromStream: dataStream.
- EToyCommunicatorMorph playArrivalSound.
- targetWorld := self currentWorld.
- (EToyMorphsWelcomeMorph morphsWelcomeInWorld: targetWorld) ifTrue: [
- newObject position: (
- newObject
- valueOfProperty: #positionInOriginatingWorld
- ifAbsent: [(targetWorld randomBoundsFor: newObject) topLeft]
- ).
- WorldState addDeferredUIMessage: [
- newObject openInWorld: targetWorld.
- ].
- ^self
- ].
- thumbForm := newObject imageForm scaledToSize: 50 at 50.
- EToyListenerMorph addToGlobalIncomingQueue: {
- thumbForm. newObject. senderName. ipAddressString
- }.
- WorldState addDeferredUIMessage: [
- EToyListenerMorph ensureListenerInCurrentWorld
- ].
- !
Item was removed:
- ----- Method: EToyIncomingMessage class>>handleNewMultiChatFrom:sentBy:ipAddress: (in category 'handlers') -----
- handleNewMultiChatFrom: dataStream sentBy: senderName ipAddress: ipAddressString
-
- ^ EToyMultiChatMorph
- chatFrom: ipAddressString
- name: senderName
- text: (self newObjectFromStream: dataStream).
- !
Item was removed:
- ----- 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'.
- !
Item was removed:
- ----- Method: EToyIncomingMessage class>>handleNewStatusReplyFrom:sentBy:ipAddress: (in category 'handlers') -----
- handleNewStatusReplyFrom: dataStream sentBy: senderName ipAddress: ipAddressString
-
- (EToyGateKeeperMorph entryForIPAddress: ipAddressString) statusReplyReceived: (
- self newObjectFromStream: dataStream
- )
- !
Item was removed:
- ----- 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'.
- !
Item was removed:
- ----- Method: EToyIncomingMessage class>>initializeMessageHandlers (in category 'as yet unclassified') -----
- initializeMessageHandlers
-
- self
- forType: self typeMorph
- send: #handleNewMorphFrom:sentBy:ipAddress:
- to: self;
-
- forType: self typeFridge
- send: #handleNewFridgeMorphFrom:sentBy:ipAddress:
- to: self;
-
- forType: self typeKeyboardChat
- send: #handleNewChatFrom:sentBy:ipAddress:
- to: self;
-
- forType: self typeMultiChat
- send: #handleNewMultiChatFrom:sentBy:ipAddress:
- to: self;
-
- forType: self typeStatusRequest
- send: #handleNewStatusRequestFrom:sentBy:ipAddress:
- to: self;
-
- forType: self typeStatusReply
- send: #handleNewStatusReplyFrom:sentBy:ipAddress:
- to: self;
-
- forType: self typeSeeDesktop
- send: #handleNewSeeDesktopFrom:sentBy:ipAddress:
- to: self.
-
-
- !
Item was removed:
- ----- Method: EToyIncomingMessage class>>messageHandlers (in category 'as yet unclassified') -----
- messageHandlers
-
- ^MessageHandlers ifNil: [MessageHandlers := Dictionary new].!
Item was removed:
- ----- Method: EToyIncomingMessage class>>newObjectFromStream: (in category 'as yet unclassified') -----
- newObjectFromStream: dataStream
-
- | newObject |
-
- [newObject := SmartRefStream objectFromStreamedRepresentation: dataStream upToEnd.]
- on: ProgressInitiationException
- do: [ :ex |
- ex sendNotificationsTo: [ :min :max :curr |
- "self flashIndicator: #working."
- ].
- ].
- "self resetIndicator: #working."
- ^newObject
- !
Item was removed:
- ----- Method: EToyIncomingMessage class>>registerType: (in category 'message types') -----
- registerType: aMessageType
-
- MessageTypes := self allTypes copyWith: aMessageType!
Item was removed:
- ----- Method: EToyIncomingMessage class>>typeAudioChat (in category 'message types') -----
- typeAudioChat
-
- ^'audiochat'!
Item was removed:
- ----- Method: EToyIncomingMessage class>>typeAudioChatContinuous (in category 'message types') -----
- typeAudioChatContinuous
-
- ^'audiochat2'!
Item was removed:
- ----- Method: EToyIncomingMessage class>>typeFridge (in category 'message types') -----
- typeFridge
-
- ^'fridge'!
Item was removed:
- ----- Method: EToyIncomingMessage class>>typeKeyboardChat (in category 'message types') -----
- typeKeyboardChat
-
- ^'chat'!
Item was removed:
- ----- Method: EToyIncomingMessage class>>typeMorph (in category 'message types') -----
- typeMorph
-
- ^'morph'!
Item was removed:
- ----- Method: EToyIncomingMessage class>>typeMultiChat (in category 'message types') -----
- typeMultiChat
-
- ^'multichat'!
Item was removed:
- ----- Method: EToyIncomingMessage class>>typeSeeDesktop (in category 'message types') -----
- typeSeeDesktop
-
- ^'seedesktop'!
Item was removed:
- ----- Method: EToyIncomingMessage class>>typeStatusReply (in category 'message types') -----
- typeStatusReply
-
- ^'statusreply'!
Item was removed:
- ----- Method: EToyIncomingMessage class>>typeStatusRequest (in category 'message types') -----
- typeStatusRequest
-
- ^'statusrequest'!
Item was removed:
- ----- Method: EToyIncomingMessage class>>unregisterType: (in category 'message types') -----
- unregisterType: aMessageType
-
- MessageTypes := self allTypes copyWithout: aMessageType!
Item was removed:
- ----- Method: EToyIncomingMessage>>incomingMessgage:fromIPAddress: (in category 'as yet unclassified') -----
- incomingMessgage: dataStream fromIPAddress: ipAddress
-
- | nullChar messageType senderName selectorAndReceiver |
-
- nullChar := 0 asCharacter.
- messageType := dataStream upTo: nullChar.
- senderName := dataStream upTo: nullChar.
- (EToyGateKeeperMorph acceptRequest: messageType from: senderName at: ipAddress) ifFalse: [
- ^self
- ].
- selectorAndReceiver := self class messageHandlers at: messageType ifAbsent: [^self].
- ^selectorAndReceiver second
- perform: selectorAndReceiver first
- withArguments: {dataStream. senderName. ipAddress}
-
- !
Item was removed:
- EToyCommunicatorMorph subclass: #EToyListenerMorph
- instanceVariableNames: 'listener updateCounter'
- classVariableNames: 'GlobalIncomingQueue GlobalListener QueueSemaphore UpdateCounter WasListeningAtShutdown'
- poolDictionaries: ''
- category: 'Nebraska-Morphic-Collaborative'!
-
- !EToyListenerMorph commentStamp: '<historical>' prior: 0!
- EToyListenerMorph new open
- EToyListenerMorph startListening.
- EToyListenerMorph stopListening.
-
- "
- EToyListenerMorph listens for messgaes from other EToy communicators. You need one of these open to receive messages from elsewhere.
- - Received Morphs are shown in a list. Items can be grabbed (a copy) or deleted.
- - Chat messages are sent to an appropriate EToyChatMorph (created if necessary)
- "
-
- !
Item was removed:
- ----- Method: EToyListenerMorph class>>addToGlobalIncomingQueue: (in category 'as yet unclassified') -----
- addToGlobalIncomingQueue: aMorphTuple
-
- self critical: [
- self globalIncomingQueue add: aMorphTuple.
- self bumpUpdateCounter.
- ].!
Item was removed:
- ----- Method: EToyListenerMorph class>>bumpUpdateCounter (in category 'as yet unclassified') -----
- bumpUpdateCounter
-
- UpdateCounter := (UpdateCounter ifNil: [0]) + 1.
- !
Item was removed:
- ----- Method: EToyListenerMorph class>>commResult: (in category 'as yet unclassified') -----
- commResult: anArrayOfAssociations
-
- WorldState addDeferredUIMessage: [self commResultDeferred: anArrayOfAssociations].!
Item was removed:
- ----- 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.
- anArrayOfAssociations do: [ :each | aDictionary add: each].
-
- aDictionary at: #commFlash ifPresent: [ :ignore | ^self].
- m := aDictionary at: #message ifAbsent: [^self].
- m = 'OK' ifFalse: [^self].
- ipAddress := NetNameResolver stringFromAddress: (aDictionary at: #ipAddress).
-
- EToyIncomingMessage new
- incomingMessgage: (ReadStream on: (aDictionary at: #data))
- fromIPAddress: ipAddress
-
- !
Item was removed:
- ----- 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?') ifTrue: [
- self startListening
- ].
- ].
- !
Item was removed:
- ----- Method: EToyListenerMorph class>>critical: (in category 'as yet unclassified') -----
- critical: aBlock
-
- QueueSemaphore ifNil: [QueueSemaphore := Semaphore forMutualExclusion].
- ^QueueSemaphore critical: aBlock
- !
Item was removed:
- ----- Method: EToyListenerMorph class>>descriptionForPartsBin (in category 'parts bin') -----
- descriptionForPartsBin
-
- ^ self partName: 'Listener'
- categories: #('Collaborative')
- documentation: 'A tool for receiving things from other Squeak users'!
Item was removed:
- ----- Method: EToyListenerMorph class>>ensureListenerInCurrentWorld (in category 'as yet unclassified') -----
- ensureListenerInCurrentWorld
-
- | w |
- w := self currentWorld.
- EToyListenerMorph allInstances
- detect: [ :each | each world == w]
- ifNone: [EToyListenerMorph new open]!
Item was removed:
- ----- Method: EToyListenerMorph class>>flashIndicator: (in category 'as yet unclassified') -----
- flashIndicator: ignoredForNow!
Item was removed:
- ----- Method: EToyListenerMorph class>>globalIncomingQueue (in category 'as yet unclassified') -----
- globalIncomingQueue
-
- ^GlobalIncomingQueue ifNil: [GlobalIncomingQueue := OrderedCollection new].!
Item was removed:
- ----- Method: EToyListenerMorph class>>globalIncomingQueueCopy (in category 'as yet unclassified') -----
- globalIncomingQueueCopy
-
- ^self critical: [self globalIncomingQueue copy].
- !
Item was removed:
- ----- Method: EToyListenerMorph class>>initialize (in category 'class initialization') -----
- initialize
- "
- EToyListenerMorph initialize
- "
-
- Smalltalk addToStartUpList: self.
- Smalltalk addToShutDownList: self.
- !
Item was removed:
- ----- Method: EToyListenerMorph class>>isListening (in category 'as yet unclassified') -----
- isListening
-
- ^GlobalListener notNil
- !
Item was removed:
- ----- Method: EToyListenerMorph class>>makeListeningToggle: (in category 'as yet unclassified') -----
- makeListeningToggle: withEars
-
- | background c capExtent bgExtent earExtent earDeltaX earDeltaY botCent factor parts |
-
- factor := 2.
- bgExtent := (50 at 25) * factor.
- capExtent := (30 at 30) * factor.
- earExtent := (15 at 15) * factor.
- earDeltaX := capExtent x // 2.
- earDeltaY := capExtent y // 2.
- background := Form extent: bgExtent depth: 8.
- botCent := background boundingBox bottomCenter.
- c := background getCanvas.
- "c fillColor: Color white."
- parts := {
- (botCent - (capExtent // 2)) extent: capExtent.
- }.
- withEars ifTrue: [
- parts := parts , {
- (botCent - (earDeltaX @ earDeltaY) - (earExtent // 2)) extent: earExtent.
- (botCent - (earDeltaX negated @ earDeltaY) - (earExtent // 2)) extent: earExtent.
- }
- ].
- parts do: [ :each |
- c
- fillOval: each
- color: Color black
- borderWidth: 0
- borderColor: Color black.
- ].
- ^background
-
- "=====
- f2 := Form extent: 30 at 15 depth: 8.
- background displayInterpolatedOn: f2.
- f2 replaceColor: Color white withColor: Color transparent.
- ^f2
- ====="
-
-
- !
Item was removed:
- ----- Method: EToyListenerMorph class>>makeListeningToggleNew: (in category 'as yet unclassified') -----
- makeListeningToggleNew: activeMode
-
- | background c baseExtent bgExtent botCent factor len endPts base |
-
- factor := 2.
- bgExtent := (50 at 25) * factor.
- baseExtent := (15 at 15) * factor.
- background := Form extent: bgExtent depth: 8.
- botCent := background boundingBox bottomCenter.
- c := background getCanvas.
- "c fillColor: Color white."
- base := (botCent - (baseExtent // 2)) extent: baseExtent.
- c
- fillOval: base
- color: Color black
- borderWidth: 0
- borderColor: Color black.
- activeMode ifTrue: [
- len := background boundingBox height - 15.
- endPts := {botCent - (len at len). botCent - (len negated at len)}.
- endPts do: [ :each |
- c line: botCent to: each width: 2 color: Color black.
- ].
- endPts do: [ :each |
- #(4 8 12) do: [ :offset |
- c frameOval: (each - offset corner: each + offset) color: Color red
- ].
- ].
- ].
- "background asMorph openInWorld."
- ^background
-
-
- !
Item was removed:
- ----- Method: EToyListenerMorph class>>removeFromGlobalIncomingQueue: (in category 'as yet unclassified') -----
- removeFromGlobalIncomingQueue: theActualObject
-
- self critical: [
- GlobalIncomingQueue := self globalIncomingQueue reject: [ :each |
- each second == theActualObject
- ].
- self bumpUpdateCounter.
- ].!
Item was removed:
- ----- Method: EToyListenerMorph class>>resetIndicator: (in category 'as yet unclassified') -----
- resetIndicator: ignoredForNow!
Item was removed:
- ----- Method: EToyListenerMorph class>>shutDown: (in category 'system startup') -----
- shutDown: quitting
-
- WasListeningAtShutdown := GlobalListener notNil.
- self stopListening.
- !
Item was removed:
- ----- Method: EToyListenerMorph class>>startListening (in category 'as yet unclassified') -----
- startListening
-
- self stopListening.
- GlobalListener := EToyPeerToPeer new awaitDataFor: self.
- self bumpUpdateCounter.
-
- !
Item was removed:
- ----- Method: EToyListenerMorph class>>startUp: (in category 'system startup') -----
- startUp: resuming
-
- WasListeningAtShutdown == true ifTrue: [
- self startListening.
- ].
- !
Item was removed:
- ----- Method: EToyListenerMorph class>>stopListening (in category 'as yet unclassified') -----
- stopListening
- GlobalListener ifNotNil:
- [GlobalListener stopListening.
- GlobalListener := nil.
- self bumpUpdateCounter]
-
- "EToyListenerMorph stopListening"!
Item was removed:
- ----- Method: EToyListenerMorph class>>unload (in category 'class initialization') -----
- unload
- Smalltalk removeFromStartUpList: self.
- Smalltalk removeFromShutDownList: self.
- !
Item was removed:
- ----- Method: EToyListenerMorph>>addNewObject:thumbForm:sentBy:ipAddress: (in category 'as yet unclassified') -----
- addNewObject: newObject thumbForm: aForm sentBy: senderName ipAddress: ipAddressString
-
- | thumb row |
-
- thumb := aForm asMorph.
- thumb setProperty: #depictedObject toValue: newObject.
- row := self addARow: {
- thumb.
- self inAColumn: {
- StringMorph new contents: senderName; lock.
- StringMorph new contents: ipAddressString; lock.
- }
- }.
- true ifTrue: [ "simpler protocol"
- row on: #mouseUp send: #mouseUpEvent:for: to: self.
- ] ifFalse: [
- row on: #mouseDown send: #mouseDownEvent:for: to: self.
- ].
-
- !
Item was removed:
- ----- Method: EToyListenerMorph>>defaultBorderColor (in category 'initialization') -----
- defaultBorderColor
- "answer the default border color/fill style for the receiver"
- ^ Color blue!
Item was removed:
- ----- Method: EToyListenerMorph>>defaultBorderWidth (in category 'initialization') -----
- defaultBorderWidth
- "answer the default border width for the receiver"
- ^ 4!
Item was removed:
- ----- Method: EToyListenerMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ Color lightBlue!
Item was removed:
- ----- Method: EToyListenerMorph>>delete (in category 'submorphs-add/remove') -----
- delete
-
- listener ifNotNil: [listener stopListening. listener := nil].
- "for old instances that were locally listening"
- super delete.!
Item was removed:
- ----- Method: EToyListenerMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- ""
- self listDirection: #topToBottom;
- layoutInset: 4;
- rebuild !
Item was removed:
- ----- Method: EToyListenerMorph>>mouseDownEvent:for: (in category 'as yet unclassified') -----
- mouseDownEvent: event for: aMorph
- | menu depictedObject |
- depictedObject := aMorph firstSubmorph valueOfProperty: #depictedObject.
- menu := MenuMorph new.
- menu
- add: 'Grab' action: [event hand attachMorph: depictedObject veryDeepCopy];
- add: 'Delete'
- action:
- [self class removeFromGlobalIncomingQueue: depictedObject.
- self rebuild].
- menu title: 'Morph from ' , (aMorph submorphs second) firstSubmorph contents.
- menu invokeModal.!
Item was removed:
- ----- Method: EToyListenerMorph>>mouseUpEvent:for: (in category 'as yet unclassified') -----
- mouseUpEvent: event for: aMorph
-
- | depictedObject |
-
- depictedObject := aMorph firstSubmorph valueOfProperty: #depictedObject.
- event hand attachMorph: depictedObject.
- self class removeFromGlobalIncomingQueue: depictedObject.
- self rebuild.
- !
Item was removed:
- ----- Method: EToyListenerMorph>>rebuild (in category 'as yet unclassified') -----
- rebuild
-
- | earMorph |
- updateCounter := UpdateCounter.
- self removeAllMorphs.
- self addGateKeeperMorphs.
- GlobalListener ifNil: [
- 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'.
- earMorph on: #mouseUp send: #stopListening to: self.
- ].
- self addARow: {self inAColumn: {earMorph}}.
- self
- addARow: {
- 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 removed:
- ----- Method: EToyListenerMorph>>startListening (in category 'as yet unclassified') -----
- startListening
-
- self class startListening!
Item was removed:
- ----- Method: EToyListenerMorph>>step (in category 'stepping and presenter') -----
- step
-
- | needRebuild |
- super step.
- needRebuild := false.
- (self valueOfProperty: #gateKeeperCounterValue) =
- EToyGateKeeperMorph updateCounter ifFalse: [needRebuild := true].
- updateCounter = UpdateCounter ifFalse: [
- needRebuild := true.
- ].
- needRebuild ifTrue: [self rebuild].
- !
Item was removed:
- ----- Method: EToyListenerMorph>>stopListening (in category 'as yet unclassified') -----
- stopListening
-
- self class stopListening!
Item was removed:
- EToyCommunicatorMorph subclass: #EToyMorphsWelcomeMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Nebraska-Morphic-Collaborative'!
-
- !EToyMorphsWelcomeMorph commentStamp: '<historical>' prior: 0!
- EToyMorphsWelcomeMorph new openInWorld!
Item was removed:
- ----- Method: EToyMorphsWelcomeMorph class>>descriptionForPartsBin (in category 'parts bin') -----
- descriptionForPartsBin
-
- ^ self partName: 'Welcome'
- categories: #('Collaborative')
- documentation: 'A sign that you accept morphs dropped directly into your world'!
Item was removed:
- ----- Method: EToyMorphsWelcomeMorph class>>morphsWelcomeInWorld: (in category 'as yet unclassified') -----
- morphsWelcomeInWorld: aWorld
-
- ^self allInstances anySatisfy: [ :each | each world == aWorld]!
Item was removed:
- ----- Method: EToyMorphsWelcomeMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ Color yellow!
Item was removed:
- ----- Method: EToyMorphsWelcomeMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- | earMorph |
- super initialize.
- ""
-
- self layoutInset: 8 @ 8.
- "earMorph := (EToyListenerMorph makeListeningToggle: true)
- asMorph."
- 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'!
Item was removed:
- EToyChatMorph subclass: #EToyMultiChatMorph
- instanceVariableNames: 'targetIPAddresses'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Nebraska-Morphic-Collaborative'!
Item was removed:
- ----- Method: EToyMultiChatMorph class>>chatWindowForIP:name:picture:inWorld: (in category 'as yet unclassified') -----
- chatWindowForIP: ipAddress name: senderName picture: aForm inWorld: aWorld
-
- ^self allInstances
- detect: [ :x | x world == aWorld]
- ifNone: [
- EToyCommunicatorMorph playArrivalSound.
- self new open
- ].
-
- !
Item was removed:
- ----- Method: EToyMultiChatMorph class>>descriptionForPartsBin (in category 'parts bin') -----
- descriptionForPartsBin
-
- ^ self partName: 'Text chat+'
- categories: #('Collaborative')
- documentation: 'A tool for sending messages to several Squeak users at once'
- sampleImageForm: (Form
- extent: 25 at 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 at 0)!
Item was removed:
- ----- Method: EToyMultiChatMorph>>acceptDroppingMorph:event: (in category 'layout') -----
- acceptDroppingMorph: morphToDrop event: evt
-
- (morphToDrop isKindOf: EToySenderMorph) ifFalse: [
- ^morphToDrop rejectDropMorphEvent: evt.
- ].
- self eToyRejectDropMorph: morphToDrop event: evt. "we don't really want it"
- self updateIPAddressField: targetIPAddresses,{morphToDrop ipAddress}.
-
- !
Item was removed:
- ----- Method: EToyMultiChatMorph>>acceptTo:forMorph: (in category 'as yet unclassified') -----
- acceptTo: someText forMorph: aMorph
-
- | streamedMessage betterText |
-
- betterText := self improveText: someText forMorph: aMorph.
- streamedMessage := {targetIPAddresses. betterText} eToyStreamedRepresentationNotifying: self.
- targetIPAddresses do: [ :each |
- self
- transmitStreamedObject: streamedMessage
- to: each.
- ].
- aMorph setText: '' asText.
- self appendMessage:
- self startOfMessageFromMe,
- ' - ',
- betterText,
- String cr.
-
- ^true!
Item was removed:
- ----- Method: EToyMultiChatMorph>>chatFrom:name:text: (in category 'as yet unclassified') -----
- chatFrom: ipAddress name: senderName text: textPackage
-
- super chatFrom: ipAddress name: senderName text: textPackage second.
- self updateIPAddressField: (
- targetIPAddresses,textPackage first,{ipAddress}
- copyWithout: NetNameResolver localAddressString
- ).
- !
Item was removed:
- ----- 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 |
- targetIPAddresses do: [ :each | strm nextPutAll: each; cr].
- ].
- 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 ifNil: [^self].
- self updateIPAddressField: (answer findTokens: ' ',String cr).
-
- !
Item was removed:
- ----- Method: EToyMultiChatMorph>>initialize (in category 'initialization') -----
- initialize
-
- targetIPAddresses := OrderedCollection new.
- super initialize.
- bounds := 0 at 0 extent: 350 at 350.!
Item was removed:
- ----- Method: EToyMultiChatMorph>>rebuild (in category 'as yet unclassified') -----
- rebuild
- | r1 r2 |
-
- 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'.
- }.
- 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'; 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]).!
Item was removed:
- ----- Method: EToyMultiChatMorph>>standardBorderColor (in category 'as yet unclassified') -----
- standardBorderColor
-
- ^Color veryLightGray!
Item was removed:
- ----- Method: EToyMultiChatMorph>>transmittedObjectCategory (in category 'as yet unclassified') -----
- transmittedObjectCategory
-
- ^EToyIncomingMessage typeMultiChat!
Item was removed:
- ----- Method: EToyMultiChatMorph>>updateIPAddressField: (in category 'as yet unclassified') -----
- updateIPAddressField: newAddresses
-
- targetIPAddresses := (
- newAddresses copyWithout: NetNameResolver localAddressString
- ) asSet asArray sort.
-
- (fields at: #ipAddress) contents: targetIPAddresses size printString,' people'.!
Item was removed:
- ----- Method: EToyMultiChatMorph>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
- wantsDroppedMorph: aMorph event: evt
-
- (aMorph isKindOf: EToySenderMorph) ifFalse: [^false].
- (bounds containsPoint: evt cursorPoint) ifFalse: [^false].
- ^true.!
Item was removed:
- Object subclass: #EToyPeerToPeer
- instanceVariableNames: 'socket communicatorMorph process ipAddress connectionQueue dataQueue remoteSocketAddress leftOverData'
- classVariableNames: 'DEBUG PREVTICK'
- poolDictionaries: ''
- category: 'Nebraska-Network-EToy Communications'!
Item was removed:
- ----- Method: EToyPeerToPeer class>>eToyCommunicationsPort (in category 'as yet unclassified') -----
- eToyCommunicationsPort
-
- ^34151 "picked at random"!
Item was removed:
- ----- Method: EToyPeerToPeer class>>transmitStreamedObject:as:to:for: (in category 'as yet unclassified') -----
- transmitStreamedObject: outData as: objectCategory to: anIPAddress for: aCommunicator
-
- | null |
- null := String with: 0 asCharacter.
- self new
- sendSomeData: {
- objectCategory,null.
- Preferences defaultAuthorName,null.
- outData
- }
- to: anIPAddress
- for: aCommunicator
-
- !
Item was removed:
- ----- Method: EToyPeerToPeer>>awaitDataFor: (in category 'receiving') -----
- awaitDataFor: aCommunicatorMorph
-
- Socket initializeNetwork.
- connectionQueue := ConnectionQueue
- portNumber: self class eToyCommunicationsPort
- queueLength: 6.
- communicatorMorph := aCommunicatorMorph.
- process := [self doAwaitData] newProcess.
- process priority: Processor highIOPriority.
- process resume.
- !
Item was removed:
- ----- Method: EToyPeerToPeer>>doAwaitData (in category 'receiving') -----
- doAwaitData
-
- [
- socket := connectionQueue getConnectionOrNilLenient.
- socket ifNil: [
- (Delay forMilliseconds: 50) wait
- ] ifNotNil: [
- self class new receiveDataOn: socket for: communicatorMorph
- ]
- ] repeat
- !
Item was removed:
- ----- Method: EToyPeerToPeer>>doConnectForSend (in category 'sending') -----
- doConnectForSend
-
- | addr |
-
- addr := NetNameResolver addressForName: ipAddress.
- addr ifNil: [
- communicatorMorph commResult: {#message -> ('could not find ',ipAddress)}.
- ^false
- ].
- socket connectNonBlockingTo: addr port: self class eToyCommunicationsPort.
- [socket waitForConnectionFor: 15]
- on: ConnectionTimedOut
- do: [:ex |
- communicatorMorph commResult: {#message -> ('no connection to ',ipAddress,' (',
- (NetNameResolver stringFromAddress: addr),')')}.
- ^false].
- ^true
-
- !
Item was removed:
- ----- Method: EToyPeerToPeer>>doReceiveData (in category 'receiving') -----
- doReceiveData
-
- | answer |
-
- answer := [self doReceiveOneMessage]
- on: Error
- do: [ :ex |
- communicatorMorph commResult: {#message -> (ex description,' ',socket printString)}.
- ^false
- ].
- communicatorMorph commResult: {
- #message -> 'OK'.
- #data -> answer .
- #ipAddress -> remoteSocketAddress.
- }.
- ^answer size > 0
-
- !
Item was removed:
- ----- Method: EToyPeerToPeer>>doReceiveOneMessage (in category 'receiving') -----
- doReceiveOneMessage
-
- | awaitingLength i length answer |
-
- awaitingLength := true.
- answer := WriteStream on: String new.
- [awaitingLength] whileTrue: [
- leftOverData := leftOverData , socket receiveData.
- (i := leftOverData indexOf: $ ) > 0 ifTrue: [
- awaitingLength := false.
- length := (leftOverData first: i - 1) asNumber.
- answer nextPutAll: (leftOverData allButFirst: i).
- ].
- ].
- leftOverData := ''.
- [answer size < length] whileTrue: [
- answer nextPutAll: socket receiveData.
- communicatorMorph commResult: {#commFlash -> true}.
- ].
- answer := answer contents.
- answer size > length ifTrue: [
- leftOverData := answer allButFirst: length.
- answer := answer first: length
- ].
- ^answer
-
- !
Item was removed:
- ----- 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,' '.
- 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 removed:
- ----- Method: EToyPeerToPeer>>receiveDataOn:for: (in category 'receiving') -----
- receiveDataOn: aSocket for: aCommunicatorMorph
-
- socket := aSocket.
- remoteSocketAddress := socket remoteAddress.
- communicatorMorph := aCommunicatorMorph.
- process := [
- leftOverData := ''.
- [self doReceiveData] whileTrue.
- socket closeAndDestroy.
- ] newProcess.
- process priority: Processor highIOPriority.
- process resume.
- !
Item was removed:
- ----- Method: EToyPeerToPeer>>sendDataCautiously: (in category 'sending') -----
- sendDataCautiously: aStringOrByteArray
- "Send all of the data in the given array, even if it requires multiple calls to send it all. Return the number of bytes sent. Try not to send too much at once since this seemed to cause problems talking to a port on the same machine"
-
- | bytesSent bytesToSend count |
-
- bytesToSend := aStringOrByteArray size.
- bytesSent := 0.
- [bytesSent < bytesToSend] whileTrue: [
- count := socket
- sendSomeData: aStringOrByteArray
- startIndex: bytesSent + 1
- count: (bytesToSend - bytesSent min: 4000).
- bytesSent := bytesSent + count.
- communicatorMorph commResult: {#commFlash -> true}.
- (Delay forMilliseconds: 10) wait.
- ].
- ^ bytesSent
- !
Item was removed:
- ----- Method: EToyPeerToPeer>>sendSomeData:to:for: (in category 'sending') -----
- sendSomeData: arrayOfByteObjects to: anIPAddress for: aCommunicatorMorph
-
- dataQueue := self
- sendSomeData: arrayOfByteObjects
- to: anIPAddress
- for: aCommunicatorMorph
- multiple: false.
- dataQueue nextPut: nil. "only this message to send"
- !
Item was removed:
- ----- Method: EToyPeerToPeer>>sendSomeData:to:for:multiple: (in category 'sending') -----
- sendSomeData: arrayOfByteObjects to: anIPAddress for: aCommunicatorMorph multiple: aBoolean
-
- Socket initializeNetwork.
- socket := Socket newTCP.
- dataQueue := SharedQueue new.
- dataQueue nextPut: arrayOfByteObjects.
- communicatorMorph := aCommunicatorMorph.
- ipAddress := anIPAddress.
- process := [
- self doConnectForSend ifTrue: [
- [self doSendData] whileTrue.
- communicatorMorph commResult: {#message -> 'OK'}.
- socket closeAndDestroy.
- ].
- ] newProcess.
- process priority: Processor highIOPriority.
- process resume.
- ^dataQueue
- !
Item was removed:
- ----- Method: EToyPeerToPeer>>stopListening (in category 'receiving') -----
- stopListening
-
- process ifNotNil: [process terminate. process := nil].
- connectionQueue ifNotNil: [connectionQueue destroy. connectionQueue := nil].
-
- !
Item was removed:
- EToyChatOrBadgeMorph subclass: #EToySenderMorph
- instanceVariableNames: 'userPicture'
- classVariableNames: 'DEBUG'
- poolDictionaries: ''
- category: 'Nebraska-Morphic-Collaborative'!
-
- !EToySenderMorph commentStamp: '<historical>' prior: 0!
- EToySenderMorph
- new
- userName: 'Bob Arning'
- userPicture: nil
- userEmail: 'arning at charm.net'
- userIPAddress: '1.2.3.4';
- position: 200 at 200;
- open
- "
- EToySenderMorph represents another person to whom you wish to send things. Drop a morph on an EToySenderMorph and a copy of that morph is sent to the person represented. Currently only peer-to-peer communications are supported, but other options are planned.
- "!
Item was removed:
- ----- Method: EToySenderMorph class>>descriptionForPartsBin (in category 'parts bin') -----
(excessive size, no diff calculated)
Item was removed:
- ----- Method: EToySenderMorph class>>instanceForIP: (in category 'as yet unclassified') -----
- instanceForIP: ipAddress
-
- ^self allInstances detect: [ :x |
- x ipAddress = ipAddress
- ] ifNone: [nil]
- !
Item was removed:
- ----- Method: EToySenderMorph class>>instanceForIP:inWorld: (in category 'as yet unclassified') -----
- instanceForIP: ipAddress inWorld: aWorld
-
- ^self allInstances detect: [ :x |
- x world == aWorld and: [x ipAddress = ipAddress]
- ] ifNone: [nil]
- !
Item was removed:
- ----- Method: EToySenderMorph class>>nameForIPAddress: (in category 'as yet unclassified') -----
- nameForIPAddress: ipString
-
- | senderMorphs |
-
- senderMorphs := EToySenderMorph allInstances select: [ :x |
- x userName notNil and: [x ipAddress = ipString]
- ].
- senderMorphs isEmpty ifTrue: [^nil].
- ^senderMorphs first userName
-
- !
Item was removed:
- ----- Method: EToySenderMorph class>>pictureForIPAddress: (in category 'as yet unclassified') -----
- pictureForIPAddress: ipString
-
- | senderMorphs |
-
- senderMorphs := EToySenderMorph allInstances select: [ :x |
- x userPicture notNil and: [x ipAddress = ipString]
- ].
- senderMorphs isEmpty ifTrue: [^nil].
- ^senderMorphs first userPicture
-
- !
Item was removed:
- ----- Method: EToySenderMorph>>aboutToBeGrabbedBy: (in category 'dropping/grabbing') -----
- aboutToBeGrabbedBy: aHand
-
- | aFridge |
- super aboutToBeGrabbedBy: aHand.
- aFridge := self ownerThatIsA: EToyFridgeMorph.
- aFridge ifNil: [^self].
- aFridge noteRemovalOf: self.!
Item was removed:
- ----- Method: EToySenderMorph>>acceptDroppingMorph:event: (in category 'layout') -----
- acceptDroppingMorph: morphToDrop event: evt
-
- | myCopy outData |
-
- (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 setProperty: #positionInOriginatingWorld toValue: morphToDrop position.
- self stopFlashing.
-
- outData := myCopy eToyStreamedRepresentationNotifying: self.
- self resetIndicator: #working.
- self transmitStreamedObject: outData to: self ipAddress.
-
- !
Item was removed:
- ----- Method: EToySenderMorph>>checkOnAFriend (in category 'as yet unclassified') -----
- checkOnAFriend
-
- | gateKeeperEntry caption resp |
-
- 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 removed:
- ----- Method: EToySenderMorph>>currentBadgeVersion (in category 'as yet unclassified') -----
- currentBadgeVersion
-
- "enables on-the-fly updating of older morphs"
- ^10!
Item was removed:
- ----- Method: EToySenderMorph>>defaultBorderColor (in category 'initialization') -----
- defaultBorderColor
- "answer the default border color/fill style for the receiver"
- ^ Color magenta!
Item was removed:
- ----- Method: EToySenderMorph>>defaultBorderWidth (in category 'initialization') -----
- defaultBorderWidth
- "answer the default border width for the receiver"
- ^ 4!
Item was removed:
- ----- Method: EToySenderMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ Color lightMagenta!
Item was removed:
- ----- Method: EToySenderMorph>>establishDropZone: (in category 'as yet unclassified') -----
- establishDropZone: aMorph
-
- self setProperty: #specialDropZone toValue: aMorph.
- aMorph
- on: #mouseEnterDragging send: #mouseEnteredDZ to: self;
- on: #mouseLeaveDragging send: #mouseLeftDZ to: self;
- on: #mouseLeave send: #mouseLeftDZ to: self.
- !
Item was removed:
- ----- Method: EToySenderMorph>>fixOldVersion (in category 'as yet unclassified') -----
- fixOldVersion
-
- | uName uForm uEmail uIP |
- uName := self userName.
- uForm := userPicture ifNil: [
- (self
- findDeepSubmorphThat: [ :x | (x isKindOf: ImageMorph) or: [x isSketchMorph]]
- ifAbsent: [self halt]) form.
- ].
- uEmail := (fields at: #emailAddress) contents.
- uIP := self ipAddress.
- self
- userName: uName
- userPicture: (uForm scaledToSize: 61 at 53)
- userEmail: uEmail
- userIPAddress: uIP
- !
Item was removed:
- ----- Method: EToySenderMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- Socket initializeNetwork.
- "we may want our IP address"
- Preferences defaultAuthorName.
- "seems like a good place to insure we have a name"
- super initialize.
- ""
- self listDirection: #topToBottom;
- layoutInset: 4;
- setProperty: #normalBorderColor toValue: self borderColor;
- setProperty: #flashingColors toValue: {Color red. Color yellow}!
Item was removed:
- ----- Method: EToySenderMorph>>initializeToStandAlone (in category 'parts bin') -----
- initializeToStandAlone
-
- super initializeToStandAlone.
- self installModelIn: ActiveWorld.
- !
Item was removed:
- ----- Method: EToySenderMorph>>installModelIn: (in category 'debug and other') -----
- installModelIn: myWorld
-
- "if we get this far and nothing exists, make it up"
-
- userPicture ifNotNil: [^self].
- self
- userName: Preferences defaultAuthorName
- userPicture: nil
- userEmail: 'who at where.net'
- userIPAddress: NetNameResolver localAddressString
- !
Item was removed:
- ----- Method: EToySenderMorph>>ipAddress (in category 'as yet unclassified') -----
- ipAddress
-
- ^(fields at: #ipAddress) contents!
Item was removed:
- ----- Method: EToySenderMorph>>ipAddress: (in category 'as yet unclassified') -----
- ipAddress: aString
-
- ^(fields at: #ipAddress) contents: aString!
Item was removed:
- ----- Method: EToySenderMorph>>killExistingChat (in category 'as yet unclassified') -----
- killExistingChat
-
- | oldOne |
- self rubberBandCells: true. "disable growing"
- (oldOne := self valueOfProperty: #embeddedChatHolder) ifNotNil: [
- oldOne delete.
- self removeProperty: #embeddedChatHolder
- ].
-
- (oldOne := self valueOfProperty: #embeddedAudioChatHolder) ifNotNil: [
- oldOne delete.
- self removeProperty: #embeddedAudioChatHolder
- ].
-
- !
Item was removed:
- ----- Method: EToySenderMorph>>mouseEnteredDZ (in category 'as yet unclassified') -----
- mouseEnteredDZ
-
- | dz |
- dz := self valueOfProperty: #specialDropZone ifAbsent: [^self].
- dz color: Color blue.!
Item was removed:
- ----- Method: EToySenderMorph>>mouseLeftDZ (in category 'as yet unclassified') -----
- mouseLeftDZ
-
- | dz |
- dz := self valueOfProperty: #specialDropZone ifAbsent: [^self].
- dz color: Color transparent.!
Item was removed:
- ----- Method: EToySenderMorph>>sendStatusCheck (in category 'as yet unclassified') -----
- sendStatusCheck
-
- | null |
- null := String with: 0 asCharacter.
- EToyPeerToPeer new
- sendSomeData: {
- EToyIncomingMessage typeStatusRequest,null.
- Preferences defaultAuthorName,null.
- }
- to: self ipAddress
- for: self.
- !
Item was removed:
- ----- Method: EToySenderMorph>>sendStatusReply (in category 'as yet unclassified') -----
- sendStatusReply
-
- | null |
- null := String with: 0 asCharacter.
- EToyPeerToPeer new
- sendSomeData: {
- EToyIncomingMessage typeStatusReply,null.
- Preferences defaultAuthorName,null.
- ((EToyGateKeeperMorph acceptableTypesFor: self ipAddress)
- eToyStreamedRepresentationNotifying: self).
- }
- to: self ipAddress
- for: self.
- !
Item was removed:
- ----- Method: EToySenderMorph>>startAudioChat (in category 'as yet unclassified') -----
- startAudioChat
-
- self startAudioChat: true
- !
Item was removed:
- ----- Method: EToySenderMorph>>startAudioChat: (in category 'as yet unclassified') -----
- startAudioChat: toggleMode
- | chat r |
- (self valueOfProperty: #embeddedAudioChatHolder) ifNotNil:
- [toggleMode ifFalse: [^self].
- ^self killExistingChat].
- chat := AudioChatGUI new ipAddress: self ipAddress.
- (self ownerThatIsA: EToyFridgeMorph) isNil
- ifTrue:
- [chat
- removeConnectButton;
- vResizing: #shrinkWrap;
- hResizing: #shrinkWrap;
- borderWidth: 2. "we already know the connectee"
- r := (self addARow: {
- chat}) vResizing: #shrinkWrap.
- self world startSteppingSubmorphsOf: chat.
- self setProperty: #embeddedAudioChatHolder toValue: r.
- self
- hResizing: #shrinkWrap;
- vResizing: #shrinkWrap]
- ifFalse:
- [chat openInWorld: self world]!
Item was removed:
- ----- Method: EToySenderMorph>>startChat (in category 'as yet unclassified') -----
- startChat
-
- self startChat: true
- !
Item was removed:
- ----- Method: EToySenderMorph>>startChat: (in category 'as yet unclassified') -----
- startChat: toggleMode
-
- | chat r |
-
- (self valueOfProperty: #embeddedChatHolder) ifNotNil: [
- toggleMode ifFalse: [^self].
- ^self killExistingChat
- ].
- (EToyChatMorph doChatsInternalToBadge and:
- [(self ownerThatIsA: EToyFridgeMorph) isNil]) ifTrue: [
- chat := EToyChatMorph basicNew
- recipientForm: userPicture;
- initialize;
- setIPAddress: self ipAddress.
- chat
- vResizing: #spaceFill;
- hResizing: #spaceFill;
- borderWidth: 2;
- insetTheScrollbars.
- r := (self addARow: {chat}) vResizing: #spaceFill.
- self rubberBandCells: false. "enable growing"
- self height: 350. "an estimated guess for allowing shrinking as well as growing"
- self world startSteppingSubmorphsOf: chat.
- self setProperty: #embeddedChatHolder toValue: r.
- ] ifFalse: [
- chat := EToyChatMorph
- chatWindowForIP: self ipAddress
- name: self userName
- picture: userPicture
- inWorld: self world.
- chat owner addMorphFront: chat.
- ]
- !
Item was removed:
- ----- Method: EToySenderMorph>>startNebraskaClient (in category 'as yet unclassified') -----
- startNebraskaClient
-
-
- [
- [ | newMorph |
- newMorph := NetworkTerminalMorph connectTo: self ipAddress.
- WorldState addDeferredUIMessage: [newMorph openInStyle: #scaled].
- ]
- on: Error
- do: [ :ex |
- WorldState addDeferredUIMessage: [
- self inform: 'No connection to: '. self ipAddress,' (',ex printString,')'
- ]
- ].
- ] fork
- !
Item was removed:
- ----- Method: EToySenderMorph>>startTelemorphic (in category 'as yet unclassified') -----
- startTelemorphic
-
- self world
- connectRemoteUserWithName: self userName
- picture: (userPicture ifNotNil: [userPicture scaledToSize: 16 at 20])
- andIPAddress: self ipAddress
- !
Item was removed:
- ----- Method: EToySenderMorph>>step (in category 'stepping and presenter') -----
- step
-
- (self valueOfProperty: #currentBadgeVersion) = self currentBadgeVersion ifFalse: [
- self setProperty: #currentBadgeVersion toValue: self currentBadgeVersion.
- self fixOldVersion.
- Preferences defaultAuthorName. "seems like a good place to insure we have a name"
- ].
- super step.!
Item was removed:
- ----- Method: EToySenderMorph>>tellAFriend (in category 'as yet unclassified') -----
- tellAFriend
-
- self world project tellAFriend: (fields at: #emailAddress) contents
- !
Item was removed:
- ----- Method: EToySenderMorph>>transmitStreamedObject: (in category 'as yet unclassified') -----
- transmitStreamedObject: outData
-
- self transmitStreamedObject: outData to: self ipAddress
-
- !
Item was removed:
- ----- Method: EToySenderMorph>>transmittedObjectCategory (in category 'as yet unclassified') -----
- transmittedObjectCategory
-
- ^EToyIncomingMessage typeMorph!
Item was removed:
- ----- Method: EToySenderMorph>>userName (in category 'as yet unclassified') -----
- userName
-
- ^ (self
- findDeepSubmorphThat: [ :x | x isKindOf: StringMorph]
- ifAbsent: [^nil]) contents
- !
Item was removed:
- ----- 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: [
- (TextStyle default fontOfSize: 26) emphasized: 1; characterFormAt: $?
- ].
- userPicture := userPicture scaledToSize: 61 at 53.
- self killExistingChat.
- self removeAllMorphs.
- self useRoundedCorners.
- self
- addARow: {
- self inAColumn: {(StringMorph contents: aString) lock}
- }.
- 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'.
- self indicatorFieldNamed: #communicating color: Color green help: 'sending'.
- self buttonNamed: 'C' action: #startChat color: Color paleBlue
- help: 'Open a written chat with this person'.
- self buttonNamed: 'T' action: #startTelemorphic color: Color paleYellow
- help: 'Start telemorphic with this person'.
- self buttonNamed: '!!' action: #tellAFriend color: Color paleGreen
- help: 'Tell this person about the current project'.
- self buttonNamed: '?' action: #checkOnAFriend color: Color lightBrown
- 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)'.
- }.
- !
Item was removed:
- ----- Method: EToySenderMorph>>userPicture (in category 'as yet unclassified') -----
- userPicture
-
- ^userPicture!
Item was removed:
- ----- Method: EToySenderMorph>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
- wantsDroppedMorph: aMorph event: evt
-
- | dz |
- dz := self valueOfProperty: #specialDropZone ifAbsent: [^false].
- (dz bounds containsPoint: (evt cursorPoint)) ifFalse: [^false].
- ^true.!
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 added:
+ NebraskaChatOrBadgeMorph subclass: #NebraskaChatMorph
+ instanceVariableNames: 'listener receivingPane myForm recipientForm acceptOnCR sendingPane'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Nebraska-Morphs'!
+
+ !NebraskaChatMorph commentStamp: '<historical>' prior: 0!
+ EToyChatMorph new open setIPAddress: '1.2.3.4'
+
+ "
+ EToyChatMorph represents a chat session with another person. Type your message in the top text pane and press cmd-S.
+ "!
Item was added:
+ ----- Method: NebraskaChatMorph class>>chatFrom:name:text: (in category 'as yet unclassified') -----
+ chatFrom: ipAddress name: senderName text: text
+
+ | chatWindow |
+
+ chatWindow := self
+ chatWindowForIP: ipAddress
+ name: senderName
+ picture: (NebraskaSenderMorph pictureForIPAddress: ipAddress)
+ inWorld: self currentWorld.
+ chatWindow
+ chatFrom: ipAddress
+ name: senderName
+ text: text
+ !
Item was added:
+ ----- Method: NebraskaChatMorph 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 ifNotNil: [^existing].
+ makeANewOne := [
+ self new
+ recipientForm: aForm;
+ open;
+ setIPAddress: ipAddress
+ ].
+ NebraskaCommunicatorMorph playArrivalSound.
+ self doChatsInternalToBadge ifTrue: [
+ aSenderBadge := NebraskaSenderMorph instanceForIP: ipAddress inWorld: aWorld.
+ aSenderBadge ifNotNil: [
+ aSenderBadge startChat: false.
+ ^aSenderBadge
+ findDeepSubmorphThat: [ :x | x isKindOf: NebraskaChatMorph]
+ ifAbsent: makeANewOne
+ ].
+ aSenderBadge := NebraskaSenderMorph instanceForIP: ipAddress.
+ aSenderBadge ifNotNil: [
+ aSenderBadge := aSenderBadge veryDeepCopy.
+ aSenderBadge
+ killExistingChat;
+ openInWorld: aWorld;
+ startChat: false.
+ ^aSenderBadge
+ findDeepSubmorphThat: [ :x | x isKindOf: NebraskaChatMorph]
+ ifAbsent: makeANewOne
+ ].
+ (aSenderBadge := NebraskaSenderMorph new)
+ userName: senderName
+ userPicture: aForm
+ userEmail: 'unknown' translated
+ userIPAddress: ipAddress;
+ position: 200 at 200;
+ openInWorld: aWorld;
+ startChat: false.
+ ^aSenderBadge
+ findDeepSubmorphThat: [ :x | x isKindOf: NebraskaChatMorph]
+ ifAbsent: makeANewOne
+ ].
+ ^makeANewOne value.
+
+ !
Item was added:
+ ----- Method: NebraskaChatMorph class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+
+ ^ self partName: 'Text chat' translatedNoop
+ categories: #()
+ documentation: 'A tool for sending messages to other Squeak users' translatedNoop!
Item was added:
+ ----- Method: NebraskaChatMorph class>>doChatsInternalToBadge (in category 'as yet unclassified') -----
+ doChatsInternalToBadge
+
+ ^true!
Item was added:
+ ----- Method: NebraskaChatMorph class>>instanceForIP:inWorld: (in category 'as yet unclassified') -----
+ instanceForIP: ipAddress inWorld: aWorld
+
+ ^self allInstances detect: [ :x |
+ x world == aWorld and: [x ipAddress = ipAddress]
+ ] ifNone: [nil]
+
+ !
Item was added:
+ ----- Method: NebraskaChatMorph>>acceptTo:forMorph: (in category 'as yet unclassified') -----
+ acceptTo: someText forMorph: aMorph
+
+ | betterText |
+
+ betterText := self improveText: someText forMorph: aMorph.
+ self
+ transmitStreamedObject: (betterText eToyStreamedRepresentationNotifying: self)
+ to: self ipAddress.
+ aMorph setText: '' asText.
+ self appendMessage:
+ self startOfMessageFromMe,
+ ' - ',
+ betterText,
+ String cr.
+
+ ^true!
Item was added:
+ ----- Method: NebraskaChatMorph>>appendMessage: (in category 'as yet unclassified') -----
+ appendMessage: aText
+
+ receivingPane appendTextEtoy: aText.!
Item was added:
+ ----- Method: NebraskaChatMorph>>chatFrom:name:text: (in category 'as yet unclassified') -----
+ chatFrom: ipAddress name: senderName text: text
+
+ | initialText attrib |
+
+ recipientForm ifNil: [
+ initialText := senderName asText allBold.
+ ] ifNotNil: [
+ attrib := TextAnchor new anchoredMorph: recipientForm "asMorph".
+ initialText := (String value: 1) asText.
+ initialText addAttribute: attrib from: 1 to: 1.
+ ].
+ self appendMessage: initialText,' - ',text,String cr.
+ NebraskaCommunicatorMorph playArrivalSound.
+
+
+ !
Item was added:
+ ----- Method: NebraskaChatMorph>>defaultBorderColor (in category 'initialization') -----
+ defaultBorderColor
+ "answer the default border color/fill style for the receiver"
+ ^ self standardBorderColor!
Item was added:
+ ----- Method: NebraskaChatMorph>>defaultBorderWidth (in category 'initialization') -----
+ defaultBorderWidth
+ "answer the default border width for the receiver"
+ ^ 8!
Item was added:
+ ----- Method: NebraskaChatMorph>>defaultBounds (in category 'initialization') -----
+ defaultBounds
+ "answer the default bounds for the receiver"
+ ^ 400 @ 100 extent: 200 @ 150!
Item was added:
+ ----- Method: NebraskaChatMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ "answer the default color/fill style for the receiver"
+ ^ Color paleYellow!
Item was added:
+ ----- Method: NebraskaChatMorph>>getChoice: (in category 'as yet unclassified') -----
+ getChoice: aSymbol
+
+ aSymbol == #acceptOnCR ifTrue: [^acceptOnCR ifNil: [true]].
+ ^false.
+ !
Item was added:
+ ----- Method: NebraskaChatMorph>>improveText:forMorph: (in category 'as yet unclassified') -----
+ improveText: someText forMorph: aMorph
+
+ | betterText conversions fontForAll |
+
+ fontForAll := aMorph eToyGetMainFont.
+ betterText := someText veryDeepCopy.
+ conversions := OrderedCollection new.
+ betterText runs withStartStopAndValueDo: [:start :stop :attributes |
+ attributes do: [:att |
+ (att isMemberOf: TextFontChange) ifTrue: [
+ conversions add: {att. start. stop}
+ ]
+ ]
+ ].
+ conversions do: [ :old |
+ | newAttr |
+ betterText removeAttribute: old first from: old second to: old third.
+ newAttr := TextFontReference toFont: (fontForAll fontAt: old first fontNumber).
+ newAttr fontNumber: old first fontNumber.
+ betterText addAttribute: newAttr from: old second to: old third.
+ ].
+ ^betterText!
Item was added:
+ ----- Method: NebraskaChatMorph>>initialize (in category 'initialization') -----
+ initialize
+ "initialize the state of the receiver"
+ super initialize.
+ ""
+ acceptOnCR := true.
+ self listDirection: #topToBottom;
+ layoutInset: 0;
+ hResizing: #shrinkWrap;
+ vResizing: #shrinkWrap;
+ rubberBandCells: false;
+ minWidth: 200;
+ minHeight: 200;
+ rebuild !
Item was added:
+ ----- Method: NebraskaChatMorph>>insetTheScrollbars (in category 'as yet unclassified') -----
+ insetTheScrollbars
+
+ self allMorphsDo: [ :each |
+ (each isKindOf: PluggableTextMorph) ifTrue: [each retractable: false]
+ ].!
Item was added:
+ ----- Method: NebraskaChatMorph>>ipAddress (in category 'as yet unclassified') -----
+ ipAddress
+
+ ^(fields at: #ipAddress) contents!
Item was added:
+ ----- Method: NebraskaChatMorph>>open (in category 'as yet unclassified') -----
+ open
+
+ ^self openIn: self currentWorld!
Item was added:
+ ----- Method: NebraskaChatMorph>>openIn: (in category 'as yet unclassified') -----
+ openIn: aWorld
+
+ "open an a chat window"
+
+ aWorld ifNil: [^self].
+ self
+ position: 400 at 100;
+ extent: 200 at 150;
+ openInWorld: aWorld.!
Item was added:
+ ----- Method: NebraskaChatMorph>>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}.
+ self textEntryFieldNamed: #ipAddress with: ''
+ help: 'IP address for chat partner' translated.
+ }.
+ recipientForm ifNotNil: [
+ r1 addMorphBack: recipientForm asMorph lock
+ ].
+ 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
+ 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])!
Item was added:
+ ----- Method: NebraskaChatMorph>>recipientForm: (in category 'as yet unclassified') -----
+ recipientForm: aForm
+
+ recipientForm := aForm.
+ recipientForm ifNotNil: [recipientForm := recipientForm scaledToSize: 20 at 20].!
Item was added:
+ ----- Method: NebraskaChatMorph>>reportError: (in category 'as yet unclassified') -----
+ reportError: aString
+
+ receivingPane appendTextEtoy: (aString asText addAttribute: TextColor red), String cr.!
Item was added:
+ ----- Method: NebraskaChatMorph>>setIPAddress: (in category 'as yet unclassified') -----
+ setIPAddress: aString
+
+ (fields at: #ipAddress) contents: aString!
Item was added:
+ ----- Method: NebraskaChatMorph>>standardBorderColor (in category 'as yet unclassified') -----
+ standardBorderColor
+
+ ^Color darkGray!
Item was added:
+ ----- Method: NebraskaChatMorph>>startOfMessageFromMe (in category 'as yet unclassified') -----
+ startOfMessageFromMe
+
+ myForm ifNil: [
+ myForm := NebraskaSenderMorph pictureForIPAddress: NetNameResolver localAddressString.
+ myForm ifNotNil: [
+ myForm := myForm scaledToSize: 20 at 20
+ ].
+ ].
+ myForm ifNil: [
+ ^(Preferences defaultAuthorName asText allBold addAttribute: TextColor blue)
+ ].
+ ^(String value: 1) asText
+ addAttribute: (TextAnchor new anchoredMorph: myForm);
+ yourself
+
+ !
Item was added:
+ ----- Method: NebraskaChatMorph>>toggleChoice: (in category 'as yet unclassified') -----
+ toggleChoice: aSymbol
+
+ aSymbol == #acceptOnCR ifTrue: [
+ acceptOnCR := (acceptOnCR ifNil: [true]) not.
+ sendingPane ifNotNil: [sendingPane acceptOnCR: acceptOnCR].
+ ^self
+ ].
+
+ !
Item was added:
+ ----- Method: NebraskaChatMorph>>transmittedObjectCategory (in category 'as yet unclassified') -----
+ transmittedObjectCategory
+
+ ^NebraskaIncomingMessage typeKeyboardChat!
Item was added:
+ NebraskaCommunicatorMorph subclass: #NebraskaChatOrBadgeMorph
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Nebraska-Morphs'!
Item was added:
+ ----- Method: NebraskaChatOrBadgeMorph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ "Not to be instantiated from the menu"
+ ^ self ~~ NebraskaChatOrBadgeMorph!
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 := NebraskaSenderMorph pictureForIPAddress: remoteAddress.
- remoteAddress := connection remoteAddress.
- remoteAddress ifNotNil: [remoteAddress := NetNameResolver stringFromAddress: remoteAddress].
- userPicture := EToySenderMorph pictureForIPAddress: remoteAddress.
hand
+ userInitials: ((NebraskaSenderMorph nameForIPAddress: remoteAddress) ifNil: ['???'])
- userInitials: ((EToySenderMorph nameForIPAddress: remoteAddress) ifNil: ['???'])
andPicture: (userPicture ifNotNil: [userPicture scaledToSize: 16 at 20]).
encoder := CanvasEncoder on: aConnection.
canvas := RemoteCanvas
connection: encoder
clipRect: NebraskaServer extremelyBigRectangle
transform: MorphicTransform identity!
Item was added:
+ AlignmentMorphBob1 subclass: #NebraskaCommunicatorMorph
+ instanceVariableNames: 'fields resultQueue'
+ classVariableNames: 'LastFlashTime'
+ poolDictionaries: ''
+ category: 'Nebraska-Morphs'!
+
+ !NebraskaCommunicatorMorph commentStamp: '<historical>' prior: 0!
+ ====== find and report all instances =====
+ EToySenderMorph instanceReport
+
+
+ ====== zap a bunch of ipAddresses =====
+ EToySenderMorph allInstances do: [ :each |
+ each ipAddress = '11.11.11.11' ifTrue: [each ipAddress: 'whizzbang']
+ ].
+ ==================== now change one of the whizzbang's back to the right address=====
+ ====== delete the whizzbangs ======
+ EToySenderMorph allInstances do: [ :each |
+ each ipAddress = 'whizzbang' ifTrue: [each stopStepping; delete]
+ ].
+ !
Item was added:
+ ----- Method: NebraskaCommunicatorMorph class>>allForIPAddress: (in category 'as yet unclassified') -----
+ allForIPAddress: ipString "for cleaning up Alan's demo"
+ "
+ EToySenderMorph allForIPAddress: '1.2.3.4'
+ "
+ Smalltalk garbageCollect.
+ (self allInstances select: [ :each | each ipAddress = ipString]) explore!
Item was added:
+ ----- Method: NebraskaCommunicatorMorph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ "Not to be instantiated from the menu"
+ ^ self ~~ NebraskaCommunicatorMorph!
Item was added:
+ ----- Method: NebraskaCommunicatorMorph class>>instanceReport (in category 'as yet unclassified') -----
+ instanceReport "for cleaning up Alan's demo"
+ "
+ EToySenderMorph instanceReport
+ "
+ | answer resp |
+
+ Smalltalk garbageCollect.
+ answer _ self allInstances collect: [ :each |
+ {
+ each.
+ [each ipAddress] on: Error do: [ 'no ipAddress'].
+ each owner
+ ifNil: ['* no owner *']
+ ifNotNil: [each owner innocuousName,' ',each owner printString].
+ each world ifNil: ['-----no project-----'] ifNotNil: [each world project name].
+ }
+ ].
+ resp _ (PopUpMenu labels: 'IP Address\Project\Owner' translated withCRs) startUpWithCaption:
+ 'Sorted by' translated.
+ resp = 1 ifTrue: [
+ ^(answer asSortedCollection: [ :a :b | a second <= b second]) asArray explore
+ ].
+ resp = 2 ifTrue: [
+ ^(answer asSortedCollection: [ :a :b | a fourth <= b fourth]) asArray explore
+ ].
+ resp = 3 ifTrue: [
+ ^(answer asSortedCollection: [ :a :b | a third <= b third]) asArray explore
+ ].
+ answer explore!
Item was added:
+ ----- Method: NebraskaCommunicatorMorph class>>otherCleanup (in category 'as yet unclassified') -----
+ otherCleanup
+ ">>>
+ EToySenderMorph allInstances do: [ :each |
+ each ipAddress = '11.11.11.11' ifTrue: [each ipAddress: 'whizzbang']
+ ].
+ <<<"
+ "==================== now change one of the whizzbang's back to the right address====="
+ ">>>
+ EToySenderMorph allInstances do: [ :each |
+ each ipAddress = 'whizzbang' ifTrue: [each delete]
+ ].
+ <<<"
+ !
Item was added:
+ ----- Method: NebraskaCommunicatorMorph class>>playArrivalSound (in category 'as yet unclassified') -----
+ playArrivalSound
+ "Make a sound that something has arrived."
+
+ SoundService default playSoundNamedOrBeep: 'chirp'!
Item was added:
+ ----- Method: NebraskaCommunicatorMorph>>addGateKeeperMorphs (in category 'collaborative') -----
+ addGateKeeperMorphs
+
+ | list currentTime choices |
+
+ self setProperty: #gateKeeperCounterValue toValue: NebraskaGateKeeperMorph updateCounter.
+ choices := #(
+ (60 'm' 'in the last minute')
+ (3600 'h' 'in the last hour')
+ (86400 'd' 'in the last day')
+ ).
+ currentTime := Time totalSeconds.
+ list := NebraskaGateKeeperMorph knownIPAddresses.
+ list do: [ :each | | age row |
+ age := each timeBetweenLastAccessAnd: currentTime.
+ age := choices
+ detect: [ :x | age <= x first]
+ ifNone: [{0. '-'. (age // 86400) printString,'days ago'}].
+ row := self addARow:
+ (NebraskaIncomingMessage allTypes collect: [ :type |
+ self toggleButtonFor: each attribute: type]
+ ),
+ {
+
+ (self inAColumn: {
+ (StringMorph contents: age second) lock.
+ }) layoutInset: 2; hResizing: #shrinkWrap; setBalloonText: 'Last attempt was ',age third.
+
+ (self inAColumn: {
+ (StringMorph contents: each ipAddress) lock.
+ }) layoutInset: 2; hResizing: #shrinkWrap.
+
+ (self inAColumn: {
+ (StringMorph contents: each latestUserName) lock.
+ }) layoutInset: 2.
+ }.
+ row
+ color: (Color r: 0.6 g: 0.8 b: 1.0);
+ borderWidth: 1;
+ borderColor: #raised;
+ vResizing: #spaceFill;
+ "on: #mouseUp send: #mouseUp:in: to: self;"
+ setBalloonText: each fullInfoString
+ ].!
Item was added:
+ ----- Method: NebraskaCommunicatorMorph>>buttonNamed:action:color:help: (in category 'as yet unclassified') -----
+ buttonNamed: aString action: aSymbol color: aColor help: helpString
+
+ | f col |
+ f := SimpleButtonMorph new
+ target: self;
+ label: aString;
+ color: aColor;
+ borderColor: aColor muchDarker;
+ actionSelector: aSymbol;
+ setBalloonText: helpString.
+ self field: aSymbol is: f.
+ col := (self inAColumn: {f}) hResizing: #shrinkWrap.
+ ^col!
Item was added:
+ ----- Method: NebraskaCommunicatorMorph>>commResult: (in category 'as yet unclassified') -----
+ commResult: anArrayOfAssociations
+
+ | aDictionary |
+ aDictionary := Dictionary new.
+ anArrayOfAssociations do: [ :each | aDictionary add: each].
+ resultQueue nextPut: aDictionary!
Item was added:
+ ----- Method: NebraskaCommunicatorMorph>>delete (in category 'submorphs-add/remove') -----
+ delete
+
+ super delete.
+ self breakDependents!
Item was added:
+ ----- Method: NebraskaCommunicatorMorph>>editEvent:for: (in category 'as yet unclassified') -----
+ editEvent: anEvent for: aMorph
+
+ | answer |
+
+ (aMorph bounds containsPoint: anEvent cursorPoint) ifFalse: [^self].
+ answer := FillInTheBlankMorph
+ request: 'Enter a new ',aMorph balloonText
+ initialAnswer: aMorph contents.
+ answer isEmptyOrNil ifTrue: [^self].
+ aMorph contents: answer
+ !
Item was added:
+ ----- Method: NebraskaCommunicatorMorph>>field:is: (in category 'as yet unclassified') -----
+ field: fieldName is: anObject
+
+ fields at: fieldName put: anObject.
+ ^anObject!
Item was added:
+ ----- Method: NebraskaCommunicatorMorph>>flashIndicator: (in category 'as yet unclassified') -----
+ flashIndicator: aSymbol
+
+ | now |
+
+ now := Time millisecondClockValue.
+ (LastFlashTime notNil and: [(Time millisecondClockValue - now) abs < 500]) ifTrue: [^self].
+ LastFlashTime := now.
+ self trulyFlashIndicator: aSymbol
+ !
Item was added:
+ ----- Method: NebraskaCommunicatorMorph>>handleResult: (in category 'as yet unclassified') -----
+ handleResult: aDictionary
+
+ | m |
+
+ aDictionary at: #commFlash ifPresent: [ :ignore | ^self flashIndicator: #communicating].
+ self resetIndicator: #communicating.
+ m := aDictionary at: #message ifAbsent: ['unknown message'].
+ m = 'OK' ifTrue: [^self].
+ self reportError: m!
Item was added:
+ ----- Method: NebraskaCommunicatorMorph>>indicatorFieldNamed:color:help: (in category 'as yet unclassified') -----
+ indicatorFieldNamed: aSymbol color: aColor help: helpString
+
+ | f col |
+ f := EllipseMorph new
+ extent: 10 at 10;
+ color: aColor;
+ setBalloonText: helpString.
+ self field: aSymbol is: f.
+ col := (self inAColumn: {f}) hResizing: #shrinkWrap.
+ ^col!
Item was added:
+ ----- Method: NebraskaCommunicatorMorph>>initialize (in category 'initialization') -----
+ initialize
+ "initialize the state of the receiver"
+ super initialize.
+ ""
+ self vResizing: #shrinkWrap;
+ hResizing: #shrinkWrap.
+ resultQueue := SharedQueue new.
+ fields := Dictionary new.
+ self useRoundedCorners!
Item was added:
+ ----- Method: NebraskaCommunicatorMorph>>open (in category 'as yet unclassified') -----
+ open
+
+ self openInWorld!
Item was added:
+ ----- Method: NebraskaCommunicatorMorph>>reportError: (in category 'as yet unclassified') -----
+ reportError: aString
+
+ self inform: aString!
Item was added:
+ ----- Method: NebraskaCommunicatorMorph>>resetIndicator: (in category 'as yet unclassified') -----
+ resetIndicator: aSymbol
+
+ | indicator firstColor |
+ indicator := fields at: aSymbol ifAbsent: [^self].
+ firstColor := indicator
+ valueOfProperty: #firstColor
+ ifAbsent: [^self].
+ indicator color: firstColor.
+ self refreshWorld.
+ !
Item was added:
+ ----- Method: NebraskaCommunicatorMorph>>step (in category 'stepping and presenter') -----
+ step
+
+ | state |
+
+ [resultQueue isEmpty] whileFalse: [
+ self handleResult: resultQueue next
+ ].
+ (state := self valueOfProperty: #flashingState ifAbsent: [0]) > 0 ifTrue: [
+ self borderColor: (
+ (self valueOfProperty: #flashingColors ifAbsent: [{Color green. Color red}]) atWrap: state
+ ).
+ self setProperty: #flashingState toValue: state + 1
+ ].!
Item was added:
+ ----- Method: NebraskaCommunicatorMorph>>stepTime (in category 'testing') -----
+ stepTime
+
+ (self valueOfProperty: #flashingState ifAbsent: [0]) > 0 ifTrue: [
+ ^200
+ ] ifFalse: [
+ ^1000
+ ].!
Item was added:
+ ----- Method: NebraskaCommunicatorMorph>>stopFlashing (in category 'as yet unclassified') -----
+ stopFlashing
+
+ self setProperty: #flashingState toValue: 0.
+ self borderColor: (self valueOfProperty: #normalBorderColor ifAbsent: [Color blue]).
+ !
Item was added:
+ ----- Method: NebraskaCommunicatorMorph>>textEntryFieldNamed:with:help: (in category 'as yet unclassified') -----
+ textEntryFieldNamed: aSymbol with: aString help: helpString
+
+ | f col |
+ f _ (StringMorph new contents: aString; font: Preferences standardEToysFont; yourself)
+ setBalloonText: helpString;
+ on: #mouseUp send: #editEvent:for: to: self.
+ self field: aSymbol is: f.
+ col _ (self inAColumn: {f}) color: Color white; hResizing: #shrinkWrap.
+ ^col!
Item was added:
+ ----- Method: NebraskaCommunicatorMorph>>toggleButtonFor:attribute: (in category 'as yet unclassified') -----
+ toggleButtonFor: entry attribute: attribute
+
+ ^(self inAColumn: {
+ self
+ simpleToggleButtonFor: entry
+ attribute: attribute
+ help: 'Whether you want "',attribute,'" messages'
+ }) hResizing: #shrinkWrap
+ !
Item was added:
+ ----- Method: NebraskaCommunicatorMorph>>transmitStreamedObject:as:to: (in category 'collaborative') -----
+ transmitStreamedObject: outData as: objectCategory to: anIPAddress
+
+ NebraskaPeerToPeer transmitStreamedObject: outData as: objectCategory to: anIPAddress for: self!
Item was added:
+ ----- Method: NebraskaCommunicatorMorph>>transmitStreamedObject:to: (in category 'collaborative') -----
+ transmitStreamedObject: outData to: anIPAddress
+
+ self transmitStreamedObject: outData as: self transmittedObjectCategory to: anIPAddress
+ !
Item was added:
+ ----- Method: NebraskaCommunicatorMorph>>trulyFlashIndicator: (in category 'as yet unclassified') -----
+ trulyFlashIndicator: aSymbol
+
+ | indicator firstColor |
+
+ indicator := fields at: aSymbol ifAbsent: [^self].
+ firstColor := indicator
+ valueOfProperty: #firstColor
+ ifAbsent: [
+ indicator setProperty: #firstColor toValue: indicator color.
+ indicator color
+ ].
+ indicator color: (indicator color = firstColor ifTrue: [Color white] ifFalse: [firstColor]).
+ self refreshWorld.
+ !
Item was added:
+ ----- Method: NebraskaCommunicatorMorph>>wantsSteps (in category 'testing') -----
+ wantsSteps
+
+ ^true!
Item was added:
+ NebraskaCommunicatorMorph subclass: #NebraskaFridgeMorph
+ instanceVariableNames: 'recipients incomingRow recipientRow updateCounter groupMode'
+ classVariableNames: 'FridgeRecipients NewItems TheFridgeForm UpdateCounter'
+ poolDictionaries: ''
+ category: 'Nebraska-Morphs'!
+
+ !NebraskaFridgeMorph commentStamp: '<historical>' prior: 0!
+ EToyFridgeMorph new openInWorld!
Item was added:
+ ----- Method: NebraskaFridgeMorph class>>addRecipient: (in category 'as yet unclassified') -----
+ addRecipient: aSenderMorph
+
+ self fridgeRecipients do: [ :each |
+ aSenderMorph ipAddress = each ipAddress ifTrue: [^self]
+ ].
+ self fridgeRecipients add: aSenderMorph.
+ UpdateCounter := self updateCounter + 1
+ !
Item was added:
+ ----- Method: NebraskaFridgeMorph class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+
+ ^ self partName: 'Fridge' translatedNoop
+ categories: #()
+ documentation: 'A tool for sending objects to other Squeak users' translatedNoop!
Item was added:
+ ----- Method: NebraskaFridgeMorph class>>fridgeForm (in category 'as yet unclassified') -----
+ fridgeForm
+
+ | fridgeFileName |
+
+ fridgeFileName := 'fridge.form'.
+ TheFridgeForm ifNotNil: [^TheFridgeForm].
+ (FileDirectory default fileExists: fridgeFileName) ifFalse: [^nil].
+ ^TheFridgeForm := Form fromFileNamed: fridgeFileName.!
Item was added:
+ ----- Method: NebraskaFridgeMorph class>>fridgeRecipients (in category 'as yet unclassified') -----
+ fridgeRecipients
+
+ ^FridgeRecipients ifNil: [FridgeRecipients := OrderedCollection new]!
Item was added:
+ ----- Method: NebraskaFridgeMorph class>>newItem: (in category 'as yet unclassified') -----
+ newItem: newMorph
+
+ | theFridge fridgeWorld trialRect |
+
+ theFridge := Project named: 'Fridge'.
+ theFridge ifNil: [^self newItems add: newMorph].
+ fridgeWorld := theFridge world.
+ trialRect := fridgeWorld randomBoundsFor: newMorph.
+ fridgeWorld
+ addMorphFront: (newMorph position: trialRect topLeft);
+ startSteppingSubmorphsOf: newMorph
+ !
Item was added:
+ ----- Method: NebraskaFridgeMorph class>>newItems (in category 'as yet unclassified') -----
+ newItems
+
+ ^NewItems ifNil: [NewItems := OrderedCollection new]!
Item was added:
+ ----- Method: NebraskaFridgeMorph class>>removeRecipientWithIPAddress: (in category 'as yet unclassified') -----
+ removeRecipientWithIPAddress: ipString
+
+ FridgeRecipients := self fridgeRecipients reject: [ :each |
+ ipString = each ipAddress
+ ].
+ UpdateCounter := self updateCounter + 1
+ !
Item was added:
+ ----- Method: NebraskaFridgeMorph class>>updateCounter (in category 'as yet unclassified') -----
+ updateCounter
+
+ ^UpdateCounter ifNil: [0]!
Item was added:
+ ----- Method: NebraskaFridgeMorph>>acceptDroppingMorph:event: (in category 'layout') -----
+ acceptDroppingMorph: morphToDrop event: evt
+
+ | outData |
+
+ (morphToDrop isKindOf: NewHandleMorph) ifTrue: [ "don't send these"
+ ^morphToDrop rejectDropMorphEvent: evt
+ ].
+ self eToyRejectDropMorph: morphToDrop event: evt. "we will keep a copy"
+ (morphToDrop isKindOf: NebraskaSenderMorph) ifTrue: [
+ self class addRecipient: morphToDrop.
+ ^self rebuild
+ ].
+ self stopFlashing.
+ "7 mar 2001 - remove #veryDeepCopy"
+ outData := morphToDrop eToyStreamedRepresentationNotifying: self.
+ self resetIndicator: #working.
+ self class fridgeRecipients do: [ :each |
+ self transmitStreamedObject: outData to: each ipAddress
+ ].
+
+ !
Item was added:
+ ----- Method: NebraskaFridgeMorph>>defaultBorderColor (in category 'initialization') -----
+ defaultBorderColor
+ "answer the default border color/fill style for the receiver"
+ ^ #raised!
Item was added:
+ ----- Method: NebraskaFridgeMorph>>defaultBorderWidth (in category 'initialization') -----
+ defaultBorderWidth
+ "answer the default border width for the receiver"
+ ^ 4!
Item was added:
+ ----- Method: NebraskaFridgeMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ "answer the default color/fill style for the receiver"
+ ^ Color paleRed!
Item was added:
+ ----- Method: NebraskaFridgeMorph>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas
+
+ | f cache |
+ f := self class fridgeForm ifNil: [^super drawOn: aCanvas].
+ cache := Form extent: bounds extent depth: aCanvas depth.
+ f
+ displayInterpolatedIn: cache boundingBox truncated
+ on: cache.
+ cache replaceColor: Color black withColor: Color transparent.
+ aCanvas
+ translucentImage: cache
+ at: bounds origin.
+ !
Item was added:
+ ----- Method: NebraskaFridgeMorph>>getChoice: (in category 'as yet unclassified') -----
+ getChoice: aString
+
+ aString = 'group' ifTrue: [^groupMode ifNil: [true]].!
Item was added:
+ ----- Method: NebraskaFridgeMorph>>groupToggleButton (in category 'as yet unclassified') -----
+ groupToggleButton
+
+ ^(self inAColumn: {
+ (ThreePhaseButtonMorph checkBox)
+ target: self;
+ actionSelector: #toggleChoice:;
+ arguments: {'group'};
+ getSelector: #getChoice:;
+ setBalloonText: 'Changes between group mode and individuals' translated;
+ step
+ }) hResizing: #shrinkWrap
+ !
Item was added:
+ ----- Method: NebraskaFridgeMorph>>handlesMouseDown: (in category 'event handling') -----
+ handlesMouseDown: globalEvt
+
+ | localCursorPoint |
+ localCursorPoint := self globalPointToLocal: globalEvt cursorPoint.
+ groupMode ifFalse: [
+ self allMorphsDo: [ :each |
+ (each isKindOf: NebraskaSenderMorph) ifTrue: [
+ (each bounds containsPoint: localCursorPoint) ifTrue: [^false].
+ ].
+ ].
+ ].
+ ^true!
Item was added:
+ ----- Method: NebraskaFridgeMorph>>handlesMouseOver: (in category 'event handling') -----
+ handlesMouseOver: globalEvt
+
+ ^true!
Item was added:
+ ----- Method: NebraskaFridgeMorph>>handlesMouseOverDragging: (in category 'event handling') -----
+ handlesMouseOverDragging: globalEvt
+
+ ^true!
Item was added:
+ ----- Method: NebraskaFridgeMorph>>initialize (in category 'initialization') -----
+ initialize
+ "initialize the state of the receiver"
+ super initialize.
+ ""
+ groupMode := true.
+ self listDirection: #topToBottom;
+ layoutInset: 10;
+ hResizing: #shrinkWrap;
+ vResizing: #shrinkWrap;
+ setProperty: #normalBorderColor toValue: self borderColor;
+ setProperty: #flashingColors toValue: {Color red. Color yellow};
+ rebuild!
Item was added:
+ ----- Method: NebraskaFridgeMorph>>mouseDown: (in category 'event handling') -----
+ mouseDown: localEvt
+
+ self addMouseActionIndicatorsWidth: 15 color: (Color blue alpha: 0.7).
+ !
Item was added:
+ ----- Method: NebraskaFridgeMorph>>mouseEnter: (in category 'event handling') -----
+ mouseEnter: evt
+
+ ^self mouseEnterEither: evt
+ !
Item was added:
+ ----- Method: NebraskaFridgeMorph>>mouseEnterDragging: (in category 'event handling') -----
+ mouseEnterDragging: evt
+
+ ^self mouseEnterEither: evt
+ !
Item was added:
+ ----- Method: NebraskaFridgeMorph>>mouseEnterEither: (in category 'as yet unclassified') -----
+ mouseEnterEither: evt
+
+ evt hand hasSubmorphs ifFalse: [
+ ^self addMouseActionIndicatorsWidth: 10 color: (Color blue alpha: 0.3).
+ ].
+ (evt hand firstSubmorph isKindOf: NebraskaSenderMorph) ifTrue: [
+ ^self addMouseActionIndicatorsWidth: 10 color: (Color magenta alpha: 0.3).
+ ].
+ self addMouseActionIndicatorsWidth: 10 color: (Color green alpha: 0.3).
+
+ !
Item was added:
+ ----- Method: NebraskaFridgeMorph>>mouseLeave: (in category 'event handling') -----
+ mouseLeave: evt
+
+ ^self mouseLeaveEither: evt
+ !
Item was added:
+ ----- Method: NebraskaFridgeMorph>>mouseLeaveDragging: (in category 'event handling') -----
+ mouseLeaveDragging: evt
+
+ ^self mouseLeaveEither: evt
+ !
Item was added:
+ ----- Method: NebraskaFridgeMorph>>mouseLeaveEither: (in category 'as yet unclassified') -----
+ mouseLeaveEither: evt
+
+ self deleteAnyMouseActionIndicators.
+
+ !
Item was added:
+ ----- Method: NebraskaFridgeMorph>>mouseUp: (in category 'event handling') -----
+ mouseUp: localEvt
+
+ (self containsPoint: localEvt cursorPoint) ifFalse: [^self].
+ Project enterIfThereOrFind: 'Fridge'!
Item was added:
+ ----- Method: NebraskaFridgeMorph>>noteRemovalOf: (in category 'as yet unclassified') -----
+ noteRemovalOf: aSenderMorph
+
+ self class removeRecipientWithIPAddress: aSenderMorph ipAddress!
Item was added:
+ ----- Method: NebraskaFridgeMorph>>rebuild (in category 'as yet unclassified') -----
+ rebuild
+
+ | row filler fudge people maxPerRow insetY |
+
+ updateCounter := self class updateCounter.
+ self removeAllMorphs.
+ (self addARow: {
+ filler := Morph new color: Color transparent; extent: 4 at 4.
+ }) vResizing: #shrinkWrap.
+ self addARow: {
+ (StringMorph contents: 'the Fridge' translated) lock.
+ self groupToggleButton.
+ }.
+ 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 addMorphBack: (
+ groupMode ifTrue: [
+ (each userPicture scaledToSize: 35 at 35) asMorph lock
+ ] ifFalse: [
+ each veryDeepCopy killExistingChat
+ ]
+ )
+ ].
+ fullBounds := nil.
+ self fullBounds.
+ "htsBefore := submorphs collect: [ :each | each height]."
+
+ 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].
+ {htsBefore. htsAfter} explore."
+
+ !
Item was added:
+ ----- Method: NebraskaFridgeMorph>>step (in category 'stepping and presenter') -----
+ step
+
+ super step.
+ updateCounter = self class updateCounter ifFalse: [self rebuild].
+ !
Item was added:
+ ----- Method: NebraskaFridgeMorph>>toggleChoice: (in category 'as yet unclassified') -----
+ toggleChoice: aString
+
+ updateCounter := nil. "force rebuild"
+ aString = 'group' ifTrue: [^groupMode := (groupMode ifNil: [true]) not].
+ !
Item was added:
+ ----- Method: NebraskaFridgeMorph>>transmittedObjectCategory (in category 'as yet unclassified') -----
+ transmittedObjectCategory
+
+ ^NebraskaIncomingMessage typeFridge!
Item was added:
+ ----- Method: NebraskaFridgeMorph>>trulyFlashIndicator: (in category 'as yet unclassified') -----
+ trulyFlashIndicator: aSymbol
+
+ | state |
+
+ state := (self
+ valueOfProperty: #fridgeFlashingState
+ ifAbsent: [false]) not.
+ self setProperty: #fridgeFlashingState toValue: state.
+
+ self
+ addMouseActionIndicatorsWidth: 15
+ color: (Color green alpha: (state ifTrue: [0.3] ifFalse: [0.7])). Beeper beep.
+ "self world displayWorldSafely."!
Item was added:
+ ----- Method: NebraskaFridgeMorph>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
+ wantsDroppedMorph: aMorph event: evt
+
+ ^true!
Item was added:
+ MorphicModel subclass: #NebraskaGateKeeperEntry
+ instanceVariableNames: 'ipAddress accessAttempts lastTimes acceptableTypes latestUserName attempsDenied lastRequests'
+ classVariableNames: 'KnownIPAddresses'
+ poolDictionaries: ''
+ category: 'Nebraska-Morphs-Experimental'!
Item was added:
+ ----- Method: NebraskaGateKeeperEntry class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ "Not to be instantiated from the menu"
+ ^ false!
Item was added:
+ ----- Method: NebraskaGateKeeperEntry>>acceptableTypes (in category 'as yet unclassified') -----
+ acceptableTypes
+
+ ^acceptableTypes!
Item was added:
+ ----- Method: NebraskaGateKeeperEntry>>dateAndTimeStringFrom: (in category 'as yet unclassified') -----
+ dateAndTimeStringFrom: totalSeconds
+
+ | dateAndTime |
+ dateAndTime := Time dateAndTimeFromSeconds: totalSeconds.
+ ^dateAndTime first printString,' ',dateAndTime second printString!
Item was added:
+ ----- Method: NebraskaGateKeeperEntry>>fullInfoString (in category 'as yet unclassified') -----
+ fullInfoString
+
+ ^self latestUserName,
+ ' at ',
+ ipAddress ,
+ ' attempts: ',
+ accessAttempts printString,
+ '/',
+ attempsDenied printString,
+ ' last: ',
+ (self lastIncomingMessageTimeString)
+
+ "acceptableTypes"
+
+ !
Item was added:
+ ----- Method: NebraskaGateKeeperEntry>>getChoice: (in category 'as yet unclassified') -----
+ getChoice: aString
+
+ ^acceptableTypes includes: aString!
Item was added:
+ ----- Method: NebraskaGateKeeperEntry>>initialize (in category 'initialization') -----
+ initialize
+
+ self flag: #bob. "need to decide better initial types"
+
+ super initialize.
+ ipAddress := '???'.
+ accessAttempts := attempsDenied := 0.
+ lastRequests := OrderedCollection new.
+ acceptableTypes := Set withAll: NebraskaIncomingMessage allTypes.
+
+ !
Item was added:
+ ----- Method: NebraskaGateKeeperEntry>>ipAddress (in category 'as yet unclassified') -----
+ ipAddress
+
+ ^ipAddress!
Item was added:
+ ----- Method: NebraskaGateKeeperEntry>>ipAddress: (in category 'as yet unclassified') -----
+ ipAddress: aString
+
+ ipAddress := aString!
Item was added:
+ ----- Method: NebraskaGateKeeperEntry>>lastIncomingMessageTimeString (in category 'as yet unclassified') -----
+ lastIncomingMessageTimeString
+
+ lastRequests isEmpty ifTrue: [^'never'].
+ ^self dateAndTimeStringFrom: lastRequests first first
+ !
Item was added:
+ ----- Method: NebraskaGateKeeperEntry>>lastTimeChecked (in category 'as yet unclassified') -----
+ lastTimeChecked
+
+ ^self valueOfProperty: #lastTimeChecked
+ !
Item was added:
+ ----- Method: NebraskaGateKeeperEntry>>lastTimeChecked: (in category 'as yet unclassified') -----
+ lastTimeChecked: aDateAndTimeInSeconds
+
+ self setProperty: #lastTimeChecked toValue: aDateAndTimeInSeconds
+ !
Item was added:
+ ----- Method: NebraskaGateKeeperEntry>>lastTimeCheckedString (in category 'as yet unclassified') -----
+ lastTimeCheckedString
+
+ | statusTime |
+ statusTime := self valueOfProperty: #lastTimeChecked ifAbsent: [^'none'].
+ ^(self dateAndTimeStringFrom: statusTime)!
Item was added:
+ ----- Method: NebraskaGateKeeperEntry>>latestUserName (in category 'as yet unclassified') -----
+ latestUserName
+
+ ^latestUserName ifNil: ['???']!
Item was added:
+ ----- Method: NebraskaGateKeeperEntry>>latestUserName: (in category 'as yet unclassified') -----
+ latestUserName: aString
+
+ latestUserName := aString!
Item was added:
+ ----- Method: NebraskaGateKeeperEntry>>requestAccessOfType: (in category 'as yet unclassified') -----
+ requestAccessOfType: aString
+
+ | ok |
+
+ accessAttempts := accessAttempts + 1.
+ lastRequests addFirst: {Time totalSeconds. aString}.
+ lastRequests size > 10 ifTrue: [
+ lastRequests := lastRequests copyFrom: 1 to: 10.
+ ].
+ ok := (acceptableTypes includes: aString) or: [acceptableTypes includes: 'all'].
+ ok ifFalse: [attempsDenied := attempsDenied + 1].
+ ^ok!
Item was added:
+ ----- Method: NebraskaGateKeeperEntry>>statusReplyReceived: (in category 'as yet unclassified') -----
+ statusReplyReceived: anArray
+
+ self setProperty: #lastStatusReplyTime toValue: Time totalSeconds.
+ self setProperty: #lastStatusReply toValue: anArray.!
Item was added:
+ ----- Method: NebraskaGateKeeperEntry>>statusReplyReceivedString (in category 'as yet unclassified') -----
+ statusReplyReceivedString
+
+ | statusTime |
+ statusTime := self valueOfProperty: #lastStatusReplyTime ifAbsent: [^'none'].
+ ^(self dateAndTimeStringFrom: statusTime),' accepts:
+ ', (self valueOfProperty: #lastStatusReply) asArray printString!
Item was added:
+ ----- Method: NebraskaGateKeeperEntry>>timeBetweenLastAccessAnd: (in category 'as yet unclassified') -----
+ timeBetweenLastAccessAnd: currentTime
+
+ lastRequests isEmpty ifTrue: [^0].
+ ^currentTime - lastRequests first first
+ !
Item was added:
+ ----- Method: NebraskaGateKeeperEntry>>toggleChoice: (in category 'as yet unclassified') -----
+ toggleChoice: aString
+
+ (acceptableTypes includes: aString) ifTrue: [
+ acceptableTypes remove: aString ifAbsent: []
+ ] ifFalse: [
+ acceptableTypes add: aString
+ ].!
Item was added:
+ NebraskaCommunicatorMorph subclass: #NebraskaGateKeeperMorph
+ instanceVariableNames: 'counter'
+ classVariableNames: 'KnownIPAddresses UpdateCounter'
+ poolDictionaries: ''
+ category: 'Nebraska-Morphs-Experimental'!
+
+ !NebraskaGateKeeperMorph commentStamp: '<historical>' prior: 0!
+ EToyGateKeeperMorph new open
+
+ "
+ I am used to control the types of connections a user is willing to allow.
+ "!
Item was added:
+ ----- Method: NebraskaGateKeeperMorph class>>acceptRequest:from:at: (in category 'as yet unclassified') -----
+ acceptRequest: requestType from: senderName at: ipAddressString
+
+ | entry |
+
+ UpdateCounter := self updateCounter + 1.
+ entry := self entryForIPAddress: ipAddressString.
+ senderName isEmpty ifFalse: [entry latestUserName: senderName].
+ ^entry requestAccessOfType: requestType!
Item was added:
+ ----- Method: NebraskaGateKeeperMorph class>>acceptableTypesFor: (in category 'as yet unclassified') -----
+ acceptableTypesFor: ipAddressString
+
+ ^(self knownIPAddresses at: ipAddressString ifAbsent: [^#()]) acceptableTypes!
Item was added:
+ ----- Method: NebraskaGateKeeperMorph class>>entryForIPAddress: (in category 'as yet unclassified') -----
+ entryForIPAddress: ipAddressString
+
+ | known entry |
+
+ UpdateCounter := self updateCounter + 1.
+ known := self knownIPAddresses.
+ entry := known at: ipAddressString ifAbsentPut: [
+ entry := NebraskaGateKeeperEntry new.
+ entry ipAddress: ipAddressString.
+ entry
+ ].
+ ^entry!
Item was added:
+ ----- Method: NebraskaGateKeeperMorph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ "Not to be instantiated from the menu"
+ ^ false!
Item was added:
+ ----- Method: NebraskaGateKeeperMorph class>>knownIPAddresses (in category 'as yet unclassified') -----
+ knownIPAddresses
+
+ ^KnownIPAddresses ifNil: [KnownIPAddresses := Dictionary new]!
Item was added:
+ ----- Method: NebraskaGateKeeperMorph class>>updateCounter (in category 'as yet unclassified') -----
+ updateCounter
+
+ ^UpdateCounter ifNil: [UpdateCounter := 0]!
Item was added:
+ ----- Method: NebraskaGateKeeperMorph>>defaultBorderColor (in category 'initialization') -----
+ defaultBorderColor
+ "answer the default border color/fill style for the receiver"
+ ^ #raised!
Item was added:
+ ----- Method: NebraskaGateKeeperMorph>>defaultBorderWidth (in category 'initialization') -----
+ defaultBorderWidth
+ "answer the default border width for the receiver"
+ ^ 4!
Item was added:
+ ----- Method: NebraskaGateKeeperMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ "answer the default color/fill style for the receiver"
+ ^ Color lightGray!
Item was added:
+ ----- Method: NebraskaGateKeeperMorph>>initialize (in category 'initialization') -----
+ initialize
+ "initialize the state of the receiver"
+ super initialize.
+ ""
+ self listDirection: #topToBottom;
+ layoutInset: 4;
+ hResizing: #spaceFill;
+ vResizing: #spaceFill;
+ useRoundedCorners;
+ rebuild !
Item was added:
+ ----- Method: NebraskaGateKeeperMorph>>open (in category 'as yet unclassified') -----
+ open
+
+ self rebuild.
+ self openInWorld.!
Item was added:
+ ----- Method: NebraskaGateKeeperMorph>>rebuild (in category 'as yet unclassified') -----
+ rebuild
+
+ self removeAllMorphs.
+ self addGateKeeperMorphs.
+ !
Item was added:
+ ----- Method: NebraskaGateKeeperMorph>>step (in category 'stepping and presenter') -----
+ step
+
+ (self valueOfProperty: #gateKeeperCounterValue) =
+ NebraskaGateKeeperMorph updateCounter ifTrue: [^self].
+ self rebuild.
+ !
Item was added:
+ Object subclass: #NebraskaIncomingMessage
+ instanceVariableNames: ''
+ classVariableNames: 'MessageHandlers MessageTypes'
+ poolDictionaries: ''
+ category: 'Nebraska-Network-Communications'!
Item was added:
+ ----- Method: NebraskaIncomingMessage class>>allTypes (in category 'message types') -----
+ allTypes
+
+ ^MessageTypes ifNil: [
+ MessageTypes := {
+ self typeKeyboardChat.
+ self typeMorph.
+ self typeFridge.
+ self typeStatusRequest.
+ self typeStatusReply.
+ self typeSeeDesktop.
+ self typeMultiChat.
+ }
+ ]
+ !
Item was added:
+ ----- Method: NebraskaIncomingMessage class>>forType:send:to: (in category 'as yet unclassified') -----
+ forType: aMessageType send: aSymbol to: anObject
+
+ self messageHandlers at: aMessageType put: {aSymbol. anObject}!
Item was added:
+ ----- Method: NebraskaIncomingMessage class>>handleNewChatFrom:sentBy:ipAddress: (in category 'handlers') -----
+ handleNewChatFrom: dataStream sentBy: senderName ipAddress: ipAddressString
+
+ ^ NebraskaChatMorph
+ chatFrom: ipAddressString
+ name: senderName
+ text: (self newObjectFromStream: dataStream).
+ !
Item was added:
+ ----- Method: NebraskaIncomingMessage class>>handleNewFridgeMorphFrom:sentBy:ipAddress: (in category 'handlers') -----
+ handleNewFridgeMorphFrom: dataStream sentBy: senderName ipAddress: ipAddressString
+
+ | newObject |
+
+ newObject := self newObjectFromStream: dataStream.
+ newObject
+ setProperty: #fridgeSender toValue: senderName;
+ setProperty: #fridgeIPAddress toValue: ipAddressString;
+ setProperty: #fridgeDate toValue: Time dateAndTimeNow.
+ WorldState addDeferredUIMessage: [NebraskaFridgeMorph newItem: newObject].
+ !
Item was added:
+ ----- Method: NebraskaIncomingMessage class>>handleNewMorphFrom:sentBy:ipAddress: (in category 'handlers') -----
+ handleNewMorphFrom: dataStream sentBy: senderName ipAddress: ipAddressString
+
+ | newObject thumbForm targetWorld |
+
+ newObject := self newObjectFromStream: dataStream.
+ NebraskaCommunicatorMorph playArrivalSound.
+ targetWorld := self currentWorld.
+ (NebraskaMorphsWelcomeMorph 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 at 50.
+ Smalltalk at: #SugarListenerMorph ifPresent: [:c |
+ c addToGlobalIncomingQueue: {
+ thumbForm. newObject. senderName. ipAddressString
+ }.
+ WorldState addDeferredUIMessage: [
+ c ensureListenerInCurrentWorld
+ ].
+ ].!
Item was added:
+ ----- Method: NebraskaIncomingMessage class>>handleNewMultiChatFrom:sentBy:ipAddress: (in category 'handlers') -----
+ handleNewMultiChatFrom: dataStream sentBy: senderName ipAddress: ipAddressString
+
+ ^ NebraskaMultiChatMorph
+ chatFrom: ipAddressString
+ name: senderName
+ text: (self newObjectFromStream: dataStream).
+ !
Item was added:
+ ----- Method: NebraskaIncomingMessage class>>handleNewSeeDesktopFrom:sentBy:ipAddress: (in category 'handlers') -----
+ handleNewSeeDesktopFrom: dataStream sentBy: senderName ipAddress: ipAddressString
+
+ "more later"
+
+ ^ NebraskaChatMorph
+ chatFrom: ipAddressString
+ name: senderName
+ text: ipAddressString,' would like to see your desktop' translated.
+ !
Item was added:
+ ----- Method: NebraskaIncomingMessage class>>handleNewStatusReplyFrom:sentBy:ipAddress: (in category 'handlers') -----
+ handleNewStatusReplyFrom: dataStream sentBy: senderName ipAddress: ipAddressString
+
+ (NebraskaGateKeeperMorph entryForIPAddress: ipAddressString) statusReplyReceived: (
+ self newObjectFromStream: dataStream
+ )
+ !
Item was added:
+ ----- Method: NebraskaIncomingMessage class>>handleNewStatusRequestFrom:sentBy:ipAddress: (in category 'handlers') -----
+ handleNewStatusRequestFrom: dataStream sentBy: senderName ipAddress: ipAddressString
+
+ "more later"
+
+ ^ NebraskaChatMorph
+ chatFrom: ipAddressString
+ name: senderName
+ text: ipAddressString,' would like to know if you are available' translated.
+ !
Item was added:
+ ----- Method: NebraskaIncomingMessage class>>initializeMessageHandlers (in category 'as yet unclassified') -----
+ initializeMessageHandlers
+
+ self
+ forType: self typeMorph
+ send: #handleNewMorphFrom:sentBy:ipAddress:
+ to: self;
+
+ forType: self typeFridge
+ send: #handleNewFridgeMorphFrom:sentBy:ipAddress:
+ to: self;
+
+ forType: self typeKeyboardChat
+ send: #handleNewChatFrom:sentBy:ipAddress:
+ to: self;
+
+ forType: self typeMultiChat
+ send: #handleNewMultiChatFrom:sentBy:ipAddress:
+ to: self;
+
+ forType: self typeStatusRequest
+ send: #handleNewStatusRequestFrom:sentBy:ipAddress:
+ to: self;
+
+ forType: self typeStatusReply
+ send: #handleNewStatusReplyFrom:sentBy:ipAddress:
+ to: self;
+
+ forType: self typeSeeDesktop
+ send: #handleNewSeeDesktopFrom:sentBy:ipAddress:
+ to: self.
+
+
+ !
Item was added:
+ ----- Method: NebraskaIncomingMessage class>>messageHandlers (in category 'as yet unclassified') -----
+ messageHandlers
+
+ ^MessageHandlers ifNil: [MessageHandlers := Dictionary new].!
Item was added:
+ ----- Method: NebraskaIncomingMessage class>>newObjectFromStream: (in category 'as yet unclassified') -----
+ newObjectFromStream: dataStream
+
+ | newObject |
+
+ [newObject := SmartRefStream objectFromStreamedRepresentation: dataStream upToEnd.]
+ on: ProgressInitiationException
+ do: [ :ex |
+ ex sendNotificationsTo: [ :min :max :curr |
+ "self flashIndicator: #working."
+ ].
+ ].
+ "self resetIndicator: #working."
+ ^newObject
+ !
Item was added:
+ ----- Method: NebraskaIncomingMessage class>>registerType: (in category 'message types') -----
+ registerType: aMessageType
+
+ MessageTypes := self allTypes copyWith: aMessageType!
Item was added:
+ ----- Method: NebraskaIncomingMessage class>>typeAudioChat (in category 'message types') -----
+ typeAudioChat
+
+ ^'audiochat'!
Item was added:
+ ----- Method: NebraskaIncomingMessage class>>typeAudioChatContinuous (in category 'message types') -----
+ typeAudioChatContinuous
+
+ ^'audiochat2'!
Item was added:
+ ----- Method: NebraskaIncomingMessage class>>typeFridge (in category 'message types') -----
+ typeFridge
+
+ ^'fridge'!
Item was added:
+ ----- Method: NebraskaIncomingMessage class>>typeKeyboardChat (in category 'message types') -----
+ typeKeyboardChat
+
+ ^'chat'!
Item was added:
+ ----- Method: NebraskaIncomingMessage class>>typeMorph (in category 'message types') -----
+ typeMorph
+
+ ^'morph'!
Item was added:
+ ----- Method: NebraskaIncomingMessage class>>typeMultiChat (in category 'message types') -----
+ typeMultiChat
+
+ ^'multichat'!
Item was added:
+ ----- Method: NebraskaIncomingMessage class>>typeSeeDesktop (in category 'message types') -----
+ typeSeeDesktop
+
+ ^'seedesktop'!
Item was added:
+ ----- Method: NebraskaIncomingMessage class>>typeStatusReply (in category 'message types') -----
+ typeStatusReply
+
+ ^'statusreply'!
Item was added:
+ ----- Method: NebraskaIncomingMessage class>>typeStatusRequest (in category 'message types') -----
+ typeStatusRequest
+
+ ^'statusrequest'!
Item was added:
+ ----- Method: NebraskaIncomingMessage class>>unregisterType: (in category 'message types') -----
+ unregisterType: aMessageType
+
+ MessageTypes := self allTypes copyWithout: aMessageType!
Item was added:
+ ----- Method: NebraskaIncomingMessage>>incomingMessgage:fromIPAddress: (in category 'as yet unclassified') -----
+ incomingMessgage: dataStream fromIPAddress: ipAddress
+
+ | nullChar messageType senderName selectorAndReceiver |
+
+ nullChar := 0 asCharacter.
+ messageType := dataStream upTo: nullChar.
+ senderName := dataStream upTo: nullChar.
+ (NebraskaGateKeeperMorph acceptRequest: messageType from: senderName at: ipAddress) ifFalse: [
+ ^self
+ ].
+ selectorAndReceiver := self class messageHandlers at: messageType ifAbsent: [^self].
+ ^selectorAndReceiver second
+ perform: selectorAndReceiver first
+ withArguments: {dataStream. senderName. ipAddress}
+
+ !
Item was added:
+ NebraskaCommunicatorMorph subclass: #NebraskaListenerMorph
+ instanceVariableNames: 'listener updateCounter'
+ classVariableNames: 'GlobalIncomingQueue GlobalListener QueueSemaphore UpdateCounter WasListeningAtShutdown'
+ poolDictionaries: ''
+ category: 'Nebraska-Morphs'!
+
+ !NebraskaListenerMorph commentStamp: '<historical>' prior: 0!
+ EToyListenerMorph new open
+ EToyListenerMorph startListening.
+ EToyListenerMorph stopListening.
+
+ "
+ EToyListenerMorph listens for messgaes from other EToy communicators. You need one of these open to receive messages from elsewhere.
+ - Received Morphs are shown in a list. Items can be grabbed (a copy) or deleted.
+ - Chat messages are sent to an appropriate EToyChatMorph (created if necessary)
+ "
+
+ !
Item was added:
+ ----- Method: NebraskaListenerMorph class>>addToGlobalIncomingQueue: (in category 'as yet unclassified') -----
+ addToGlobalIncomingQueue: aMorphTuple
+
+ self critical: [
+ self globalIncomingQueue add: aMorphTuple.
+ self bumpUpdateCounter.
+ ].!
Item was added:
+ ----- Method: NebraskaListenerMorph class>>bumpUpdateCounter (in category 'as yet unclassified') -----
+ bumpUpdateCounter
+
+ UpdateCounter := (UpdateCounter ifNil: [0]) + 1.
+ !
Item was added:
+ ----- Method: NebraskaListenerMorph class>>commResult: (in category 'as yet unclassified') -----
+ commResult: anArrayOfAssociations
+
+ WorldState addDeferredUIMessage: [self commResultDeferred: anArrayOfAssociations].!
Item was added:
+ ----- Method: NebraskaListenerMorph 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.
+ anArrayOfAssociations do: [ :each | aDictionary add: each].
+
+ aDictionary at: #commFlash ifPresent: [ :ignore | ^self].
+ m := aDictionary at: #message ifAbsent: [^self].
+ m = 'OK' ifFalse: [^self].
+ ipAddress := aDictionary at: #ipAddress.
+
+ NebraskaIncomingMessage new
+ incomingMessgage: (ReadStream on: (aDictionary at: #data))
+ fromIPAddress: ipAddress
+
+ !
Item was added:
+ ----- Method: NebraskaListenerMorph 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: [
+ self startListening
+ ].
+ ].
+ !
Item was added:
+ ----- Method: NebraskaListenerMorph class>>critical: (in category 'as yet unclassified') -----
+ critical: aBlock
+
+ QueueSemaphore ifNil: [QueueSemaphore := Semaphore forMutualExclusion].
+ ^QueueSemaphore critical: aBlock
+ !
Item was added:
+ ----- Method: NebraskaListenerMorph class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ ^ self partName: 'Listener' translatedNoop
+ categories: #()
+ documentation: 'A tool for receiving things from other Squeak users' translatedNoop!
Item was added:
+ ----- Method: NebraskaListenerMorph class>>ensureListenerInCurrentWorld (in category 'as yet unclassified') -----
+ ensureListenerInCurrentWorld
+
+ | w |
+ w := self currentWorld.
+ NebraskaListenerMorph allInstances
+ detect: [ :each | each world == w]
+ ifNone: [NebraskaListenerMorph new open]!
Item was added:
+ ----- Method: NebraskaListenerMorph class>>flashIndicator: (in category 'as yet unclassified') -----
+ flashIndicator: ignoredForNow!
Item was added:
+ ----- Method: NebraskaListenerMorph class>>globalIncomingQueue (in category 'as yet unclassified') -----
+ globalIncomingQueue
+
+ ^GlobalIncomingQueue ifNil: [GlobalIncomingQueue := OrderedCollection new].!
Item was added:
+ ----- Method: NebraskaListenerMorph class>>globalIncomingQueueCopy (in category 'as yet unclassified') -----
+ globalIncomingQueueCopy
+
+ ^self critical: [self globalIncomingQueue copy].
+ !
Item was added:
+ ----- Method: NebraskaListenerMorph class>>initialize (in category 'class initialization') -----
+ initialize
+ "
+ EToyListenerMorph initialize
+ "
+
+ Smalltalk addToStartUpList: self.
+ Smalltalk addToShutDownList: self.
+ !
Item was added:
+ ----- Method: NebraskaListenerMorph class>>isListening (in category 'as yet unclassified') -----
+ isListening
+
+ ^GlobalListener notNil
+ !
Item was added:
+ ----- Method: NebraskaListenerMorph class>>listeningPort (in category 'as yet unclassified') -----
+ listeningPort
+
+ ^GlobalListener ifNotNil: [GlobalListener listeningPort]
+ !
Item was added:
+ ----- Method: NebraskaListenerMorph class>>makeListeningToggle: (in category 'as yet unclassified') -----
+ makeListeningToggle: withEars
+
+ | background c capExtent bgExtent earExtent earDeltaX earDeltaY botCent factor parts |
+
+ factor := 2.
+ bgExtent := (50 at 25) * factor.
+ capExtent := (30 at 30) * factor.
+ earExtent := (15 at 15) * factor.
+ earDeltaX := capExtent x // 2.
+ earDeltaY := capExtent y // 2.
+ background := Form extent: bgExtent depth: 8.
+ botCent := background boundingBox bottomCenter.
+ c := background getCanvas.
+ "c fillColor: Color white."
+ parts := {
+ (botCent - (capExtent // 2)) extent: capExtent.
+ }.
+ withEars ifTrue: [
+ parts := parts , {
+ (botCent - (earDeltaX @ earDeltaY) - (earExtent // 2)) extent: earExtent.
+ (botCent - (earDeltaX negated @ earDeltaY) - (earExtent // 2)) extent: earExtent.
+ }
+ ].
+ parts do: [ :each |
+ c
+ fillOval: each
+ color: Color black
+ borderWidth: 0
+ borderColor: Color black.
+ ].
+ ^background
+
+ "=====
+ f2 := Form extent: 30 at 15 depth: 8.
+ background displayInterpolatedOn: f2.
+ f2 replaceColor: Color white withColor: Color transparent.
+ ^f2
+ ====="
+
+
+ !
Item was added:
+ ----- Method: NebraskaListenerMorph class>>makeListeningToggleNew: (in category 'as yet unclassified') -----
+ makeListeningToggleNew: activeMode
+
+ | background c baseExtent bgExtent botCent factor len endPts base |
+
+ factor := 2.
+ bgExtent := (50 at 25) * factor.
+ baseExtent := (15 at 15) * factor.
+ background := Form extent: bgExtent depth: 8.
+ botCent := background boundingBox bottomCenter.
+ c := background getCanvas.
+ "c fillColor: Color white."
+ base := (botCent - (baseExtent // 2)) extent: baseExtent.
+ c
+ fillOval: base
+ color: Color black
+ borderWidth: 0
+ borderColor: Color black.
+ activeMode ifTrue: [
+ len := background boundingBox height - 15.
+ endPts := {botCent - (len at len). botCent - (len negated at len)}.
+ endPts do: [ :each |
+ c line: botCent to: each width: 2 color: Color black.
+ ].
+ endPts do: [ :each |
+ #(4 8 12) do: [ :offset |
+ c frameOval: (each - offset corner: each + offset) color: Color red
+ ].
+ ].
+ ].
+ "background asMorph openInWorld."
+ ^background
+
+
+ !
Item was added:
+ ----- Method: NebraskaListenerMorph class>>removeAllFromGlobalIncomingQueue (in category 'as yet unclassified') -----
+ removeAllFromGlobalIncomingQueue
+
+ self critical: [
+ GlobalIncomingQueue _ OrderedCollection new.
+ self bumpUpdateCounter.
+ ].!
Item was added:
+ ----- Method: NebraskaListenerMorph class>>removeFromGlobalIncomingQueue: (in category 'as yet unclassified') -----
+ removeFromGlobalIncomingQueue: theActualObject
+
+ self critical: [
+ GlobalIncomingQueue := self globalIncomingQueue reject: [ :each |
+ each second == theActualObject
+ ].
+ self bumpUpdateCounter.
+ ].!
Item was added:
+ ----- Method: NebraskaListenerMorph class>>resetIndicator: (in category 'as yet unclassified') -----
+ resetIndicator: ignoredForNow!
Item was added:
+ ----- Method: NebraskaListenerMorph class>>shutDown: (in category 'system startup') -----
+ shutDown: quitting
+
+ WasListeningAtShutdown := GlobalListener notNil.
+ self stopListening.
+ !
Item was added:
+ ----- Method: NebraskaListenerMorph class>>startListening (in category 'as yet unclassified') -----
+ startListening
+
+ self stopListening.
+ GlobalListener := NebraskaPeerToPeer new awaitDataFor: self.
+ self bumpUpdateCounter.
+
+ !
Item was added:
+ ----- Method: NebraskaListenerMorph class>>startUp: (in category 'system startup') -----
+ startUp: resuming
+
+ WasListeningAtShutdown == true ifTrue: [
+ self startListening.
+ ].
+ !
Item was added:
+ ----- Method: NebraskaListenerMorph class>>stopListening (in category 'as yet unclassified') -----
+ stopListening
+ GlobalListener ifNotNil:
+ [GlobalListener stopListening.
+ GlobalListener := nil.
+ self bumpUpdateCounter]
+
+ "EToyListenerMorph stopListening"!
Item was added:
+ ----- Method: NebraskaListenerMorph class>>unload (in category 'class initialization') -----
+ unload
+ Smalltalk removeFromStartUpList: self.
+ Smalltalk removeFromShutDownList: self.
+ !
Item was added:
+ ----- Method: NebraskaListenerMorph>>addNewObject:thumbForm:sentBy:ipAddress: (in category 'as yet unclassified') -----
+ addNewObject: newObject thumbForm: aForm sentBy: senderName ipAddress: ipAddressString
+
+ | thumb row |
+
+ thumb := aForm asMorph.
+ thumb setProperty: #depictedObject toValue: newObject.
+ row := self addARow: {
+ thumb.
+ self inAColumn: {
+ StringMorph new contents: senderName; lock.
+ StringMorph new contents: ipAddressString; lock.
+ }
+ }.
+ true ifTrue: [ "simpler protocol"
+ row on: #mouseUp send: #mouseUpEvent:for: to: self.
+ ] ifFalse: [
+ row on: #mouseDown send: #mouseDownEvent:for: to: self.
+ ].
+
+ !
Item was added:
+ ----- Method: NebraskaListenerMorph>>defaultBorderColor (in category 'initialization') -----
+ defaultBorderColor
+ "answer the default border color/fill style for the receiver"
+ ^ Color blue!
Item was added:
+ ----- Method: NebraskaListenerMorph>>defaultBorderWidth (in category 'initialization') -----
+ defaultBorderWidth
+ "answer the default border width for the receiver"
+ ^ 4!
Item was added:
+ ----- Method: NebraskaListenerMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ "answer the default color/fill style for the receiver"
+ ^ Color lightBlue!
Item was added:
+ ----- Method: NebraskaListenerMorph>>delete (in category 'submorphs-add/remove') -----
+ delete
+
+ listener ifNotNil: [listener stopListening. listener := nil].
+ "for old instances that were locally listening"
+ super delete.!
Item was added:
+ ----- Method: NebraskaListenerMorph>>initialize (in category 'initialization') -----
+ initialize
+ "initialize the state of the receiver"
+ super initialize.
+ ""
+ self listDirection: #topToBottom;
+ layoutInset: 4;
+ rebuild !
Item was added:
+ ----- Method: NebraskaListenerMorph>>listeningPort (in category 'as yet unclassified') -----
+ listeningPort
+ ^self class listeningPort!
Item was added:
+ ----- Method: NebraskaListenerMorph>>mouseDownEvent:for: (in category 'as yet unclassified') -----
+ mouseDownEvent: event for: aMorph
+ | menu selection depictedObject |
+ depictedObject := aMorph firstSubmorph valueOfProperty: #depictedObject.
+ menu := CustomMenu new.
+ menu
+ add: 'Grab' translated action: [event hand attachMorph: depictedObject veryDeepCopy];
+ add: 'Delete' translated
+ action:
+ [self class removeFromGlobalIncomingQueue: depictedObject.
+ self rebuild].
+ selection := menu build startUpCenteredWithCaption: 'Morph from ' translated
+ , (aMorph submorphs second) firstSubmorph contents.
+ selection ifNil: [^self].
+ selection value!
Item was added:
+ ----- Method: NebraskaListenerMorph>>mouseUpEvent:for: (in category 'as yet unclassified') -----
+ mouseUpEvent: event for: aMorph
+
+ | depictedObject |
+
+ depictedObject := aMorph firstSubmorph valueOfProperty: #depictedObject.
+ event hand attachMorph: depictedObject.
+ self class removeFromGlobalIncomingQueue: depictedObject.
+ self rebuild.
+ !
Item was added:
+ ----- Method: NebraskaListenerMorph>>rebuild (in category 'as yet unclassified') -----
+ rebuild
+
+ | earMorph |
+ updateCounter := UpdateCounter.
+ self removeAllMorphs.
+ self addGateKeeperMorphs.
+ GlobalListener ifNil: [
+ earMorph := (self class makeListeningToggleNew: false) asMorph.
+ earMorph setBalloonText: 'Click to START listening for messages' translated.
+ earMorph on: #mouseUp send: #startListening to: self.
+ ] ifNotNil: [
+ earMorph := (self class makeListeningToggleNew: true) asMorph.
+ earMorph setBalloonText: 'Click to STOP listening for messages' translated.
+ 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.
+ }.
+ "{thumbForm. newObject. senderName. ipAddressString}"
+ self class globalIncomingQueueCopy do: [ :each |
+ self
+ addNewObject: each second
+ thumbForm: each first
+ sentBy: each third
+ ipAddress: each fourth.
+ ].!
Item was added:
+ ----- Method: NebraskaListenerMorph>>startListening (in category 'as yet unclassified') -----
+ startListening
+
+ self class startListening!
Item was added:
+ ----- Method: NebraskaListenerMorph>>step (in category 'stepping and presenter') -----
+ step
+
+ | needRebuild |
+ super step.
+ needRebuild := false.
+ (self valueOfProperty: #gateKeeperCounterValue) =
+ NebraskaGateKeeperMorph updateCounter ifFalse: [needRebuild := true].
+ updateCounter = UpdateCounter ifFalse: [
+ needRebuild := true.
+ ].
+ needRebuild ifTrue: [self rebuild].
+ !
Item was added:
+ ----- Method: NebraskaListenerMorph>>stopListening (in category 'as yet unclassified') -----
+ stopListening
+
+ self class stopListening!
Item was added:
+ NebraskaCommunicatorMorph subclass: #NebraskaMorphsWelcomeMorph
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Nebraska-Morphs'!
+
+ !NebraskaMorphsWelcomeMorph commentStamp: '<historical>' prior: 0!
+ EToyMorphsWelcomeMorph new openInWorld!
Item was added:
+ ----- Method: NebraskaMorphsWelcomeMorph 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!
Item was added:
+ ----- Method: NebraskaMorphsWelcomeMorph class>>morphsWelcomeInWorld: (in category 'as yet unclassified') -----
+ morphsWelcomeInWorld: aWorld
+
+ ^self allInstances anySatisfy: [ :each | each world == aWorld]!
Item was added:
+ ----- Method: NebraskaMorphsWelcomeMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ "answer the default color/fill style for the receiver"
+ ^ Color yellow!
Item was added:
+ ----- Method: NebraskaMorphsWelcomeMorph>>initialize (in category 'initialization') -----
+ initialize
+ "initialize the state of the receiver"
+ | earMorph |
+ super initialize.
+ ""
+
+ self layoutInset: 8 @ 8.
+ "earMorph := (EToyListenerMorph makeListeningToggle: true)
+ asMorph."
+ 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!
Item was added:
+ NebraskaChatMorph subclass: #NebraskaMultiChatMorph
+ instanceVariableNames: 'targetIPAddresses'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Nebraska-Morphs'!
Item was added:
+ ----- Method: NebraskaMultiChatMorph class>>chatWindowForIP:name:picture:inWorld: (in category 'as yet unclassified') -----
+ chatWindowForIP: ipAddress name: senderName picture: aForm inWorld: aWorld
+
+ ^self allInstances
+ detect: [ :x | x world == aWorld]
+ ifNone: [
+ NebraskaCommunicatorMorph playArrivalSound.
+ self new open
+ ].
+
+ !
Item was added:
+ ----- Method: NebraskaMultiChatMorph 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
+ sampleImageForm: (Form
+ extent: 25 at 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 at 0)!
Item was added:
+ ----- Method: NebraskaMultiChatMorph>>acceptDroppingMorph:event: (in category 'layout') -----
+ acceptDroppingMorph: morphToDrop event: evt
+
+ (morphToDrop isKindOf: NebraskaSenderMorph) ifFalse: [
+ ^morphToDrop rejectDropMorphEvent: evt.
+ ].
+ self eToyRejectDropMorph: morphToDrop event: evt. "we don't really want it"
+ self updateIPAddressField: targetIPAddresses,{morphToDrop ipAddress}.
+
+ !
Item was added:
+ ----- Method: NebraskaMultiChatMorph>>acceptTo:forMorph: (in category 'as yet unclassified') -----
+ acceptTo: someText forMorph: aMorph
+
+ | streamedMessage betterText |
+
+ betterText := self improveText: someText forMorph: aMorph.
+ streamedMessage := {targetIPAddresses. betterText} eToyStreamedRepresentationNotifying: self.
+ targetIPAddresses do: [ :each |
+ self
+ transmitStreamedObject: streamedMessage
+ to: each.
+ ].
+ aMorph setText: '' asText.
+ self appendMessage:
+ self startOfMessageFromMe,
+ ' - ',
+ betterText,
+ String cr.
+
+ ^true!
Item was added:
+ ----- Method: NebraskaMultiChatMorph>>chatFrom:name:text: (in category 'as yet unclassified') -----
+ chatFrom: ipAddress name: senderName text: textPackage
+
+ super chatFrom: ipAddress name: senderName text: textPackage second.
+ self updateIPAddressField: (
+ targetIPAddresses,textPackage first,{ipAddress}
+ copyWithout: NetNameResolver localAddressString
+ ).
+ !
Item was added:
+ ----- Method: NebraskaMultiChatMorph>>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 |
+ targetIPAddresses do: [ :each | strm nextPutAll: each; cr].
+ ].
+ aFillInTheBlankMorph := FillInTheBlankMorph new
+ setQuery: 'Who are you chatting with?' translated
+ initialAnswer: initialText
+ answerHeight: 250
+ acceptOnCR: false.
+ aFillInTheBlankMorph responseUponCancel: nil.
+ self world addMorph: aFillInTheBlankMorph centeredNear: anEvent cursorPoint.
+ answer := aFillInTheBlankMorph getUserResponse.
+ answer ifNil: [^self].
+ self updateIPAddressField: (answer findTokens: ' ',String cr).
+
+ !
Item was added:
+ ----- Method: NebraskaMultiChatMorph>>initialize (in category 'initialization') -----
+ initialize
+
+ targetIPAddresses := OrderedCollection new.
+ super initialize.
+ bounds := 0 at 0 extent: 350 at 350.!
Item was added:
+ ----- Method: NebraskaMultiChatMorph>>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}.
+ self textEntryFieldNamed: #ipAddress with: ''
+ help: 'Click to edit participant list' translated.
+ }.
+ 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
+ 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]).!
Item was added:
+ ----- Method: NebraskaMultiChatMorph>>standardBorderColor (in category 'as yet unclassified') -----
+ standardBorderColor
+
+ ^Color veryLightGray!
Item was added:
+ ----- Method: NebraskaMultiChatMorph>>transmittedObjectCategory (in category 'as yet unclassified') -----
+ transmittedObjectCategory
+
+ ^NebraskaIncomingMessage typeMultiChat!
Item was added:
+ ----- Method: NebraskaMultiChatMorph>>updateIPAddressField: (in category 'as yet unclassified') -----
+ updateIPAddressField: newAddresses
+
+ targetIPAddresses := (
+ newAddresses copyWithout: NetNameResolver localAddressString
+ ) asSet asArray sort.
+
+ (fields at: #ipAddress) contents: targetIPAddresses size printString,' people'.!
Item was added:
+ ----- Method: NebraskaMultiChatMorph>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
+ wantsDroppedMorph: aMorph event: evt
+
+ (aMorph isKindOf: NebraskaSenderMorph) ifFalse: [^false].
+ (bounds containsPoint: evt cursorPoint) ifFalse: [^false].
+ ^true.!
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 added:
+ Object subclass: #NebraskaPeerToPeer
+ instanceVariableNames: 'socket communicatorMorph process ipAddress connectionQueue dataQueue remoteSocketAddress leftOverData'
+ classVariableNames: 'DEBUG PREVTICK'
+ poolDictionaries: ''
+ category: 'Nebraska-Network-Communications'!
Item was added:
+ ----- Method: NebraskaPeerToPeer class>>eToyCommunicationsPort (in category 'as yet unclassified') -----
+ eToyCommunicationsPort
+
+ ^34151 "picked at random"!
Item was added:
+ ----- Method: NebraskaPeerToPeer class>>eToyCommunicationsPorts (in category 'as yet unclassified') -----
+ eToyCommunicationsPorts
+ ^ 34151 to: 34159!
Item was added:
+ ----- Method: NebraskaPeerToPeer class>>transmitStreamedObject:as:to:for: (in category 'as yet unclassified') -----
+ transmitStreamedObject: outData as: objectCategory to: anIPAddress for: aCommunicator
+
+ | null |
+ null := String with: 0 asCharacter.
+ self new
+ sendSomeData: {
+ objectCategory,null.
+ Preferences defaultAuthorName,null.
+ outData
+ }
+ to: anIPAddress
+ for: aCommunicator
+
+ !
Item was added:
+ ----- Method: NebraskaPeerToPeer>>awaitDataFor: (in category 'receiving') -----
+ awaitDataFor: aCommunicatorMorph
+
+ Socket initializeNetwork.
+ connectionQueue := ConnectionQueue
+ portNumber: self class eToyCommunicationsPorts
+ queueLength: 6.
+ communicatorMorph := aCommunicatorMorph.
+ process := [self doAwaitData] newProcess.
+ process priority: Processor highIOPriority.
+ process resume.
+ !
Item was added:
+ ----- Method: NebraskaPeerToPeer>>doAwaitData (in category 'receiving') -----
+ doAwaitData
+
+ [
+ socket := connectionQueue getConnectionOrNilLenient.
+ socket ifNil: [
+ (Delay forMilliseconds: 50) wait
+ ] ifNotNil: [
+ self class new receiveDataOn: socket for: communicatorMorph
+ ]
+ ] repeat
+ !
Item was added:
+ ----- Method: NebraskaPeerToPeer>>doConnectForSend (in category 'sending') -----
+ doConnectForSend
+
+ | addr port |
+
+ addr := NetNameResolver addressForName: (ipAddress copyUpTo: $:).
+ 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.
+ [socket waitForConnectionFor: 15]
+ on: ConnectionTimedOut
+ do: [:ex |
+ communicatorMorph commResult: {#message -> ('no connection to ',ipAddress,' (',
+ ipAddress,')')}.
+ ^false].
+ ^true
+
+ !
Item was added:
+ ----- Method: NebraskaPeerToPeer>>doReceiveData (in category 'receiving') -----
+ doReceiveData
+
+ | answer |
+
+ answer := [self doReceiveOneMessage]
+ on: Error
+ do: [ :ex |
+ communicatorMorph commResult: {#message -> (ex description,' ',socket printString)}.
+ ^false
+ ].
+ communicatorMorph commResult: {
+ #message -> 'OK'.
+ #data -> answer .
+ #ipAddress -> remoteSocketAddress.
+ }.
+ ^answer size > 0
+
+ !
Item was added:
+ ----- Method: NebraskaPeerToPeer>>doReceiveOneMessage (in category 'receiving') -----
+ doReceiveOneMessage
+
+ | awaitingLength i length answer header |
+
+ 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.
+ answer nextPutAll: (leftOverData allButFirst: i).
+ ].
+ ].
+ leftOverData := ''.
+ [answer size < length] whileTrue: [
+ answer nextPutAll: socket receiveData.
+ communicatorMorph commResult: {#commFlash -> true}.
+ ].
+ answer := answer contents.
+ answer size > length ifTrue: [
+ leftOverData := answer allButFirst: length.
+ answer := answer first: length
+ ].
+ ^answer
+
+ !
Item was added:
+ ----- Method: NebraskaPeerToPeer>>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 do: [ :chunk | allTheData nextPutAll: chunk asString].
+ NebraskaDebug at: #peerBytesSent add: {totalLength}.
+ self sendDataCautiously: allTheData contents.
+ ^true
+
+ !
Item was added:
+ ----- Method: NebraskaPeerToPeer>>listeningPort (in category 'sending') -----
+ listeningPort
+ ^connectionQueue portNumberOrNil!
Item was added:
+ ----- Method: NebraskaPeerToPeer>>makeOptionalHeader (in category 'sending') -----
+ makeOptionalHeader
+ "Optional header format is '(key:value;key:value)' and it must not contain spaces. This is designed to be backwards-compatible with old receivers who receive a header as anything up to a space, but only actually use an initial size integer"
+
+ | args p t |
+ args := OrderedCollection new.
+
+ p := NebraskaListenerMorph listeningPort.
+ (p notNil and: [p ~= self class eToyCommunicationsPorts first])
+ ifTrue: [args add: 'port:', p asString].
+
+ t := (Smalltalk classNamed: 'SugarLauncher') ifNotNil: [:l | l current listeningTube].
+ t ifNotNil: [args add: 'tube:', t asString].
+
+ ^args isEmpty
+ ifTrue: ['']
+ ifFalse: [String streamContents: [:strm |
+ strm nextPut: $(.
+ args
+ do: [:arg | strm nextPutAll: arg]
+ separatedBy: [strm nextPut: $;].
+ strm nextPut: $)]].
+ !
Item was added:
+ ----- Method: NebraskaPeerToPeer>>parseOptionalHeader: (in category 'receiving') -----
+ parseOptionalHeader: aString
+ "header used to be just an integer, was extended to have optional parameters (see makeOptionalHeader)"
+
+ (((aString copyAfter: $() copyUpTo: $)) findTokens: $;) do: [:item |
+ (item beginsWith: 'port:')
+ ifTrue: [self receivedPort: (item copyAfter: $:)].
+ (item beginsWith: 'tube:')
+ ifTrue: [self receivedTube: (item copyAfter: $:)].]!
Item was added:
+ ----- Method: NebraskaPeerToPeer>>receiveDataOn:for: (in category 'receiving') -----
+ receiveDataOn: aSocket for: aCommunicatorMorph
+
+ socket := aSocket.
+ remoteSocketAddress := socket remoteSocketAddress hostNumber.
+ communicatorMorph := aCommunicatorMorph.
+ process := [
+ leftOverData := ''.
+ [self doReceiveData] whileTrue.
+ socket closeAndDestroy.
+ ] newProcess.
+ process priority: Processor highIOPriority.
+ process resume.
+ !
Item was added:
+ ----- Method: NebraskaPeerToPeer>>receivedPort: (in category 'receiving') -----
+ receivedPort: aString
+ (remoteSocketAddress includes: $:) ifFalse: [
+ remoteSocketAddress := remoteSocketAddress, ':', aString].!
Item was added:
+ ----- Method: NebraskaPeerToPeer>>receivedTube: (in category 'receiving') -----
+ receivedTube: aString
+ "Sender offers a tube for talking back. Get the tube's address."
+ | addr |
+ addr := (Smalltalk classNamed: 'SugarLauncher')
+ ifNotNil: [:l | l current socketAddressForTube: aString].
+ addr ifNotNil: [remoteSocketAddress := addr]!
Item was added:
+ ----- Method: NebraskaPeerToPeer>>sendDataCautiously: (in category 'sending') -----
+ sendDataCautiously: aStringOrByteArray
+ "Send all of the data in the given array, even if it requires multiple calls to send it all. Return the number of bytes sent. Try not to send too much at once since this seemed to cause problems talking to a port on the same machine"
+
+ | bytesSent bytesToSend count |
+
+ bytesToSend := aStringOrByteArray size.
+ bytesSent := 0.
+ [bytesSent < bytesToSend] whileTrue: [
+ count := socket
+ sendSomeData: aStringOrByteArray
+ startIndex: bytesSent + 1
+ count: (bytesToSend - bytesSent min: 4000).
+ bytesSent := bytesSent + count.
+ communicatorMorph commResult: {#commFlash -> true}.
+ (Delay forMilliseconds: 10) wait.
+ ].
+ ^ bytesSent
+ !
Item was added:
+ ----- Method: NebraskaPeerToPeer>>sendSomeData:to:for: (in category 'sending') -----
+ sendSomeData: arrayOfByteObjects to: anIPAddress for: aCommunicatorMorph
+
+ dataQueue := self
+ sendSomeData: arrayOfByteObjects
+ to: anIPAddress
+ for: aCommunicatorMorph
+ multiple: false.
+ dataQueue nextPut: nil. "only this message to send"
+ !
Item was added:
+ ----- Method: NebraskaPeerToPeer>>sendSomeData:to:for:multiple: (in category 'sending') -----
+ sendSomeData: arrayOfByteObjects to: anIPAddress for: aCommunicatorMorph multiple: aBoolean
+
+ Socket initializeNetwork.
+ socket := Socket newTCP.
+ dataQueue := SharedQueue new.
+ dataQueue nextPut: arrayOfByteObjects.
+ communicatorMorph := aCommunicatorMorph.
+ ipAddress := anIPAddress.
+ process := [
+ self doConnectForSend ifTrue: [
+ [self doSendData] whileTrue.
+ communicatorMorph commResult: {#message -> 'OK'}.
+ socket closeAndDestroy.
+ ].
+ ] newProcess.
+ process priority: Processor highIOPriority.
+ process resume.
+ ^dataQueue
+ !
Item was added:
+ ----- Method: NebraskaPeerToPeer>>stopListening (in category 'receiving') -----
+ stopListening
+
+ process ifNotNil: [process terminate. process := nil].
+ connectionQueue ifNotNil: [connectionQueue destroy. connectionQueue := nil].
+
+ !
Item was added:
+ NebraskaChatOrBadgeMorph subclass: #NebraskaSenderMorph
+ instanceVariableNames: 'userPicture'
+ classVariableNames: 'DEBUG'
+ poolDictionaries: ''
+ category: 'Nebraska-Morphs'!
+
+ !NebraskaSenderMorph commentStamp: '<historical>' prior: 0!
+ EToySenderMorph
+ new
+ userName: 'Bob Arning'
+ userPicture: nil
+ userEmail: 'arning at charm.net'
+ userIPAddress: '1.2.3.4';
+ position: 200 at 200;
+ open
+ "
+ EToySenderMorph represents another person to whom you wish to send things. Drop a morph on an EToySenderMorph and a copy of that morph is sent to the person represented. Currently only peer-to-peer communications are supported, but other options are planned.
+ "!
Item was added:
+ ----- Method: NebraskaSenderMorph class>>descriptionForPartsBin (in category 'parts bin') -----
(excessive size, no diff calculated)
Item was added:
+ ----- Method: NebraskaSenderMorph class>>instanceForIP: (in category 'as yet unclassified') -----
+ instanceForIP: ipAddress
+
+ ^self allInstances detect: [ :x |
+ x ipAddress = ipAddress
+ ] ifNone: [nil]
+ !
Item was added:
+ ----- Method: NebraskaSenderMorph class>>instanceForIP:inWorld: (in category 'as yet unclassified') -----
+ instanceForIP: ipAddress inWorld: aWorld
+
+ ^self allInstances detect: [ :x |
+ x world == aWorld and: [x ipAddress = ipAddress]
+ ] ifNone: [nil]
+ !
Item was added:
+ ----- Method: NebraskaSenderMorph class>>nameForIPAddress: (in category 'as yet unclassified') -----
+ nameForIPAddress: ipString
+
+ | senderMorphs |
+
+ senderMorphs := NebraskaSenderMorph allInstances select: [ :x |
+ x userName notNil and: [x ipAddress = ipString]
+ ].
+ senderMorphs isEmpty ifTrue: [^nil].
+ ^senderMorphs first userName
+
+ !
Item was added:
+ ----- Method: NebraskaSenderMorph class>>pictureForIPAddress: (in category 'as yet unclassified') -----
+ pictureForIPAddress: ipString
+
+ | senderMorphs |
+
+ senderMorphs := NebraskaSenderMorph allInstances select: [ :x |
+ x userPicture notNil and: [x ipAddress = ipString]
+ ].
+ senderMorphs isEmpty ifTrue: [^nil].
+ ^senderMorphs first userPicture
+
+ !
Item was added:
+ ----- Method: NebraskaSenderMorph>>aboutToBeGrabbedBy: (in category 'dropping/grabbing') -----
+ aboutToBeGrabbedBy: aHand
+
+ | aFridge |
+ super aboutToBeGrabbedBy: aHand.
+ aFridge := self ownerThatIsA: NebraskaFridgeMorph.
+ aFridge ifNil: [^self].
+ aFridge noteRemovalOf: self.!
Item was added:
+ ----- Method: NebraskaSenderMorph>>acceptDroppingMorph:event: (in category 'layout') -----
+ acceptDroppingMorph: morphToDrop event: evt
+
+ | myCopy outData |
+
+ (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 setProperty: #positionInOriginatingWorld toValue: morphToDrop position.
+ self stopFlashing.
+
+ outData := myCopy eToyStreamedRepresentationNotifying: self.
+ self resetIndicator: #working.
+ self transmitStreamedObject: outData to: self ipAddress.
+
+ !
Item was added:
+ ----- Method: NebraskaSenderMorph>>checkOnAFriend (in category 'as yet unclassified') -----
+ checkOnAFriend
+
+ | gateKeeperEntry caption choices resp |
+
+ gateKeeperEntry := NebraskaGateKeeperMorph 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.
+ resp = 1 ifTrue: [
+ gateKeeperEntry lastTimeChecked: Time totalSeconds.
+ self sendStatusCheck.
+ ].
+ resp = 2 ifTrue: [
+ self sendStatusReply.
+ ].
+ !
Item was added:
+ ----- Method: NebraskaSenderMorph>>currentBadgeVersion (in category 'as yet unclassified') -----
+ currentBadgeVersion
+
+ "enables on-the-fly updating of older morphs"
+ ^10!
Item was added:
+ ----- Method: NebraskaSenderMorph>>defaultBorderColor (in category 'initialization') -----
+ defaultBorderColor
+ "answer the default border color/fill style for the receiver"
+ ^ Color magenta!
Item was added:
+ ----- Method: NebraskaSenderMorph>>defaultBorderWidth (in category 'initialization') -----
+ defaultBorderWidth
+ "answer the default border width for the receiver"
+ ^ 4!
Item was added:
+ ----- Method: NebraskaSenderMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ "answer the default color/fill style for the receiver"
+ ^ Color lightMagenta!
Item was added:
+ ----- Method: NebraskaSenderMorph>>establishDropZone: (in category 'as yet unclassified') -----
+ establishDropZone: aMorph
+
+ self setProperty: #specialDropZone toValue: aMorph.
+ aMorph
+ on: #mouseEnterDragging send: #mouseEnteredDZ to: self;
+ on: #mouseLeaveDragging send: #mouseLeftDZ to: self;
+ on: #mouseLeave send: #mouseLeftDZ to: self.
+ !
Item was added:
+ ----- Method: NebraskaSenderMorph>>fixOldVersion (in category 'as yet unclassified') -----
+ fixOldVersion
+
+ | uName uForm uEmail uIP |
+ uName := self userName.
+ uForm := userPicture ifNil: [
+ (self
+ findDeepSubmorphThat: [ :x | (x isKindOf: ImageMorph) or: [x isSketchMorph]]
+ ifAbsent: [self halt]) form.
+ ].
+ uEmail := (fields at: #emailAddress) contents.
+ uIP := self ipAddress.
+ self
+ userName: uName
+ userPicture: (uForm scaledToSize: 61 at 53)
+ userEmail: uEmail
+ userIPAddress: uIP
+ !
Item was added:
+ ----- Method: NebraskaSenderMorph>>hideField: (in category 'as yet unclassified') -----
+ hideField: aFieldName
+ fields at: aFieldName ifPresent: [:m |
+ [m owner notNil and: [m owner submorphs size =1]]
+ whileTrue: [m := m owner].
+ m delete]!
Item was added:
+ ----- Method: NebraskaSenderMorph>>initialize (in category 'initialization') -----
+ initialize
+ "initialize the state of the receiver"
+ Socket initializeNetwork.
+ "we may want our IP address"
+ Preferences defaultAuthorName.
+ "seems like a good place to insure we have a name"
+ super initialize.
+ ""
+ self listDirection: #topToBottom;
+ layoutInset: 4;
+ setProperty: #normalBorderColor toValue: self borderColor;
+ setProperty: #flashingColors toValue: {Color red. Color yellow}!
Item was added:
+ ----- Method: NebraskaSenderMorph>>initializeToStandAlone (in category 'parts bin') -----
+ initializeToStandAlone
+
+ super initializeToStandAlone.
+ self installModelIn: ActiveWorld.
+ !
Item was added:
+ ----- Method: NebraskaSenderMorph>>installModelIn: (in category 'debug and other') -----
+ installModelIn: myWorld
+
+ "if we get this far and nothing exists, make it up"
+
+ userPicture ifNotNil: [^self].
+ self
+ userName: Preferences defaultAuthorName
+ userPicture: nil
+ userEmail: 'who at where.net'
+ userIPAddress: NetNameResolver localAddressString
+ !
Item was added:
+ ----- Method: NebraskaSenderMorph>>ipAddress (in category 'as yet unclassified') -----
+ ipAddress
+
+ ^(fields at: #ipAddress) contents!
Item was added:
+ ----- Method: NebraskaSenderMorph>>ipAddress: (in category 'as yet unclassified') -----
+ ipAddress: aString
+
+ ^(fields at: #ipAddress) contents: aString!
Item was added:
+ ----- Method: NebraskaSenderMorph>>killExistingChat (in category 'as yet unclassified') -----
+ killExistingChat
+
+ | oldOne |
+ self rubberBandCells: true. "disable growing"
+ (oldOne := self valueOfProperty: #embeddedChatHolder) ifNotNil: [
+ oldOne delete.
+ self removeProperty: #embeddedChatHolder
+ ].
+
+ (oldOne := self valueOfProperty: #embeddedAudioChatHolder) ifNotNil: [
+ oldOne delete.
+ self removeProperty: #embeddedAudioChatHolder
+ ].
+
+ !
Item was added:
+ ----- Method: NebraskaSenderMorph>>mouseEnteredDZ (in category 'as yet unclassified') -----
+ mouseEnteredDZ
+
+ | dz |
+ dz := self valueOfProperty: #specialDropZone ifAbsent: [^self].
+ dz color: Color blue.!
Item was added:
+ ----- Method: NebraskaSenderMorph>>mouseLeftDZ (in category 'as yet unclassified') -----
+ mouseLeftDZ
+
+ | dz |
+ dz := self valueOfProperty: #specialDropZone ifAbsent: [^self].
+ dz color: Color transparent.!
Item was added:
+ ----- Method: NebraskaSenderMorph>>sendStatusCheck (in category 'as yet unclassified') -----
+ sendStatusCheck
+
+ | null |
+ null := String with: 0 asCharacter.
+ NebraskaPeerToPeer new
+ sendSomeData: {
+ NebraskaIncomingMessage typeStatusRequest,null.
+ Preferences defaultAuthorName,null.
+ }
+ to: self ipAddress
+ for: self.
+ !
Item was added:
+ ----- Method: NebraskaSenderMorph>>sendStatusReply (in category 'as yet unclassified') -----
+ sendStatusReply
+
+ | null |
+ null := String with: 0 asCharacter.
+ NebraskaPeerToPeer new
+ sendSomeData: {
+ NebraskaIncomingMessage typeStatusReply,null.
+ Preferences defaultAuthorName,null.
+ ((NebraskaGateKeeperMorph acceptableTypesFor: self ipAddress)
+ eToyStreamedRepresentationNotifying: self).
+ }
+ to: self ipAddress
+ for: self.
+ !
Item was added:
+ ----- Method: NebraskaSenderMorph>>startAudioChat (in category 'as yet unclassified') -----
+ startAudioChat
+
+ self startAudioChat: true
+ !
Item was added:
+ ----- Method: NebraskaSenderMorph>>startAudioChat: (in category 'as yet unclassified') -----
+ startAudioChat: toggleMode
+ | chat r |
+ (self valueOfProperty: #embeddedAudioChatHolder) ifNotNil:
+ [toggleMode ifFalse: [^self].
+ ^self killExistingChat].
+ chat := AudioChatGUI new ipAddress: self ipAddress.
+ (self ownerThatIsA: NebraskaFridgeMorph) isNil
+ ifTrue:
+ [chat
+ removeConnectButton;
+ vResizing: #shrinkWrap;
+ hResizing: #shrinkWrap;
+ borderWidth: 2. "we already know the connectee"
+ r := (self addARow: {
+ chat}) vResizing: #shrinkWrap.
+ self world startSteppingSubmorphsOf: chat.
+ self setProperty: #embeddedAudioChatHolder toValue: r.
+ self
+ hResizing: #shrinkWrap;
+ vResizing: #shrinkWrap]
+ ifFalse:
+ [chat openInWorld: self world]!
Item was added:
+ ----- Method: NebraskaSenderMorph>>startChat (in category 'as yet unclassified') -----
+ startChat
+
+ self startChat: true
+ !
Item was added:
+ ----- Method: NebraskaSenderMorph>>startChat: (in category 'as yet unclassified') -----
+ startChat: toggleMode
+
+ | chat r |
+
+ (self valueOfProperty: #embeddedChatHolder) ifNotNil: [
+ toggleMode ifFalse: [^self].
+ ^self killExistingChat
+ ].
+ (NebraskaChatMorph doChatsInternalToBadge and:
+ [(self ownerThatIsA: NebraskaFridgeMorph) isNil]) ifTrue: [
+ chat := NebraskaChatMorph basicNew
+ recipientForm: userPicture;
+ initialize;
+ setIPAddress: self ipAddress.
+ chat
+ vResizing: #spaceFill;
+ hResizing: #spaceFill;
+ borderWidth: 2;
+ insetTheScrollbars.
+ r := (self addARow: {chat}) vResizing: #spaceFill.
+ self rubberBandCells: false. "enable growing"
+ self height: 350. "an estimated guess for allowing shrinking as well as growing"
+ self world startSteppingSubmorphsOf: chat.
+ self setProperty: #embeddedChatHolder toValue: r.
+ ] ifFalse: [
+ chat := NebraskaChatMorph
+ chatWindowForIP: self ipAddress
+ name: self userName
+ picture: userPicture
+ inWorld: self world.
+ chat owner addMorphFront: chat.
+ ]
+ !
Item was added:
+ ----- Method: NebraskaSenderMorph>>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.
+ ]
+ on: Error
+ do: [ :ex |
+ WorldState addDeferredUIMessage: [
+ self inform: 'No connection to: ' translated. self ipAddress,' (',ex printString,')'
+ ] fixTemps
+ ].
+ ] fork
+ !
Item was added:
+ ----- Method: NebraskaSenderMorph>>startTelemorphic (in category 'as yet unclassified') -----
+ startTelemorphic
+
+ self world
+ connectRemoteUserWithName: self userName
+ picture: (userPicture ifNotNil: [userPicture scaledToSize: 16 at 20])
+ andIPAddress: self ipAddress
+ !
Item was added:
+ ----- Method: NebraskaSenderMorph>>step (in category 'stepping and presenter') -----
+ step
+
+ (self valueOfProperty: #currentBadgeVersion) = self currentBadgeVersion ifFalse: [
+ self setProperty: #currentBadgeVersion toValue: self currentBadgeVersion.
+ self fixOldVersion.
+ Preferences defaultAuthorName. "seems like a good place to insure we have a name"
+ ].
+ super step.!
Item was added:
+ ----- Method: NebraskaSenderMorph>>tellAFriend (in category 'as yet unclassified') -----
+ tellAFriend
+
+ self world project tellAFriend: (fields at: #emailAddress) contents
+ !
Item was added:
+ ----- Method: NebraskaSenderMorph>>transmitStreamedObject: (in category 'as yet unclassified') -----
+ transmitStreamedObject: outData
+
+ self transmitStreamedObject: outData to: self ipAddress
+
+ !
Item was added:
+ ----- Method: NebraskaSenderMorph>>transmittedObjectCategory (in category 'as yet unclassified') -----
+ transmittedObjectCategory
+
+ ^NebraskaIncomingMessage typeMorph!
Item was added:
+ ----- Method: NebraskaSenderMorph>>userName (in category 'as yet unclassified') -----
+ userName
+
+ ^ (self
+ findDeepSubmorphThat: [ :x | x isKindOf: StringMorph]
+ ifAbsent: [^nil]) contents
+ !
Item was added:
+ ----- Method: NebraskaSenderMorph>>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: [
+ (TextStyle default fontOfSize: 26) emphasized: 1; characterFormAt: $?
+ ].
+ userPicture := userPicture scaledToSize: 61 at 53.
+ self killExistingChat.
+ self removeAllMorphs.
+ self useRoundedCorners.
+ self
+ addARow: {
+ self inAColumn: {(StringMorph contents: aString) lock}
+ }.
+ 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 buttonNamed: 'C' action: #startChat color: Color paleBlue
+ help: 'Open a written chat with this person' translated.
+ self buttonNamed: 'T' action: #startTelemorphic color: Color paleYellow
+ help: 'Start telemorphic with this person' translated.
+ self buttonNamed: '!!' action: #tellAFriend color: Color paleGreen
+ help: 'Tell this person about the current project' translated.
+ 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."
+ self buttonNamed: 'S' action: #startNebraskaClient color: Color white
+ help: 'See this person''s world (if he allows that)' translated.
+ }.
+ !
Item was added:
+ ----- Method: NebraskaSenderMorph>>userPicture (in category 'as yet unclassified') -----
+ userPicture
+
+ ^userPicture!
Item was added:
+ ----- Method: NebraskaSenderMorph>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
+ wantsDroppedMorph: aMorph event: evt
+
+ | dz |
+ dz := self valueOfProperty: #specialDropZone ifAbsent: [^false].
+ (dz bounds containsPoint: (evt cursorPoint)) ifFalse: [^false].
+ ^true.!
Item was added:
+ ----- Method: NebraskaServer class>>defaultPorts (in category 'as yet unclassified') -----
+ defaultPorts
+ ^ 9091 to: 9099!
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 added:
+ ----- Method: NebraskaServer>>listeningPort (in category 'accessing') -----
+ listeningPort
+ ^listenQueue portNumberOrNil!
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>>serveWorldButton (in category 'as yet unclassified') -----
serveWorldButton
| button |
+ button := SimpleButtonMorph new.
- button := ScriptableButton new.
button target: NebraskaServerMorph.
button actionSelector: #serveWorld.
button arguments: #().
button label: 'Share'.
button color: Color yellow.
^ button.
!
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.
self removeAllMorphs.
self setColorsAndBorder.
self updateCurrentStatusString.
toggle := SimpleHierarchicalListMorph new perform: (
fullDisplay ifTrue: [#expandedForm] ifFalse: [#notExpandedForm]
).
closeBox := SimpleButtonMorph new borderWidth: 0;
+ label: 'X' font: Preferences standardEToysButtonFont; color: Color transparent;
- label: 'X' font: Preferences standardButtonFont; color: Color transparent;
actionSelector: #delete; target: self; extent: 14 at 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 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 := ''.
] ifNotNil:[
currentStatusString :=
+ ' Nebraska: {1} clients' translated format: {self server numClients printString}.
- ' 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 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 setProperty: #positionInOriginatingWorld toValue: morphToDrop position.
outData := myCopy eToyStreamedRepresentationNotifying: nil.
null := String with: 0 asCharacter.
+ NebraskaPeerToPeer new
- EToyPeerToPeer new
sendSomeData: {
+ NebraskaIncomingMessage typeMorph,null.
- EToyIncomingMessage typeMorph,null.
Preferences defaultAuthorName,null.
outData
}
+ to: connection remoteSocketAddress hostNumber
- to: (NetNameResolver stringFromAddress: connection remoteAddress)
for: self.
!
Item was added:
+ ----- Method: StringSocket>>remoteSocketAddress (in category 'as yet unclassified') -----
+ remoteSocketAddress
+
+ ^ socket remoteSocketAddress!
More information about the Packages
mailing list