Bert Freudenberg uploaded a new version of Nebraska to project The Trunk:
http://source.squeak.org/trunk/Nebraska-bf.39.mcz ==================== Summary ==================== Name: Nebraska-bf.39 Author: bf Time: 8 December 2014, 1:56:52.004 am UUID: 0be115a5-ca25-41f7-b9e6-43c091a0f21b Ancestors: Nebraska-ul.38 Restore timestamps lost in assignment conversion. =============== Diff against Nebraska-ul.38 =============== Item was changed: ----- Method: AlertMorph>>color: (in category 'accessing') ----- color: aColor super color: aColor. onColor := aColor.! Item was changed: ----- Method: AlertMorph>>socketOwner: (in category 'as yet unclassified') ----- socketOwner: aChatGUI socketOwner := aChatGUI.! Item was changed: ----- Method: AlertMorph>>step (in category 'stepping and presenter') ----- step super step. offColor ifNil: [offColor := self onColor mixed: 0.5 with: Color black]. socketOwner objectsInQueue = 0 ifTrue: [ color = offColor ifFalse: [super color: offColor]. ] ifFalse: [ super color: (color = onColor ifTrue: [offColor] ifFalse: [onColor]). ]. ! Item was changed: ----- Method: AudioChatGUI class>>debugLog: (in category 'as yet unclassified') ----- debugLog: x " AudioChatGUI debugLog: nil AudioChatGUI debugLog: OrderedCollection new DebugLog LiveMessages NewAudioMessages PlayOnArrival " DebugLog := x. ! Item was changed: ----- Method: AudioChatGUI class>>handleNewAudioChat2From:sentBy:ipAddress: (in category 'as yet unclassified') ----- handleNewAudioChat2From: dataStream sentBy: senderName ipAddress: ipAddressString | newSound seqSound compressed | compressed := self newCompressedSoundFrom: dataStream. newSound := compressed asSound. "-------an experiment to try newSound adjustVolumeTo: 7.0 overMSecs: 10 --------" DebugLog ifNotNil: [ DebugLog add: {compressed. newSound}. ]. LiveMessages ifNil: [LiveMessages := Dictionary new]. seqSound := LiveMessages at: ipAddressString ifAbsentPut: [SequentialSound new]. seqSound isPlaying ifTrue: [ seqSound add: newSound; pruneFinishedSounds. ] ifFalse: [ seqSound initialize; add: newSound. ]. seqSound isPlaying ifFalse: [seqSound play].! Item was changed: ----- Method: AudioChatGUI class>>handleNewAudioChatFrom:sentBy:ipAddress: (in category 'as yet unclassified') ----- handleNewAudioChatFrom: dataStream sentBy: senderName ipAddress: ipAddressString | compressed | compressed := self newCompressedSoundFrom: dataStream. DebugLog ifNotNil: [ DebugLog add: {compressed}. ]. self newAudioMessages nextPut: compressed. self playOnArrival ifTrue: [self playNextAudioMessage]. ! Item was changed: ----- Method: AudioChatGUI class>>newAudioMessages (in category 'as yet unclassified') ----- newAudioMessages ^NewAudioMessages ifNil: [NewAudioMessages := SharedQueue new].! Item was changed: ----- Method: AudioChatGUI class>>newCompressedSoundFrom: (in category 'as yet unclassified') ----- newCompressedSoundFrom: dataStream | samplingRate | samplingRate := (dataStream upTo: 0 asCharacter) asNumber. ^CompressedSoundData new withEToySound: dataStream upToEnd samplingRate: samplingRate. ! Item was changed: ----- Method: AudioChatGUI class>>playOnArrival (in category 'as yet unclassified') ----- playOnArrival ^PlayOnArrival ifNil: [PlayOnArrival := false]! Item was changed: ----- Method: AudioChatGUI>>handsFreeTalking (in category 'sending') ----- handsFreeTalking ^handsFreeTalking ifNil: [handsFreeTalking := false].! Item was changed: ----- Method: AudioChatGUI>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" transmitWhileRecording := false. handsFreeTalking := false. mycodec := GSMCodec new. myrecorder := ChatNotes new. mytargetip := ''. self start2. self changeTalkButtonLabel! Item was changed: ----- Method: AudioChatGUI>>ipAddress: (in category 'initialization') ----- ipAddress: aString mytargetip := aString! Item was changed: ----- Method: AudioChatGUI>>messageWaitingAlertIndicator (in category 'initialization') ----- messageWaitingAlertIndicator | messageCounter | myalert := AlertMorph new socketOwner: self. messageCounter := UpdatingStringMorph on: self selector: #objectsInQueue. myalert addMorph: messageCounter. messageCounter contents: '0'; color: Color white. messageCounter align: messageCounter center with: myalert center. myalert setBalloonText: 'New messages indicator. This will flash and show the number of messages when there are messages that you haven''t listened to. You can click here to play the next message.'. myalert on: #mouseUp send: #playNextMessage to: self. ^myalert! Item was changed: ----- Method: AudioChatGUI>>record (in category 'sending') ----- record queueForMultipleSends := nil. myrecorder record.! Item was changed: ----- Method: AudioChatGUI>>removeConnectButton (in category 'stuff') ----- removeConnectButton theConnectButton ifNotNil: [ theConnectButton delete. theConnectButton := nil. ].! 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. EToyPeerToPeer new sendSomeData: { 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>>sendAnyCompletedSounds (in category 'sending') ----- sendAnyCompletedSounds | soundsSoFar firstCompleteSound | myrecorder isRecording ifFalse: [^self]. mytargetip isEmpty ifTrue: [^self]. soundsSoFar := myrecorder recorder recordedSound ifNil: [^self]. firstCompleteSound := soundsSoFar removeFirstCompleteSoundOrNil ifNil: [^self]. self sendOneOfMany: firstCompleteSound.! Item was changed: ----- Method: AudioChatGUI>>start (in category 'stepping and presenter') ----- start | myUpdatingText playButton myOpenConnectionButton myStopButton window | " --- old system window version --- " Socket initializeNetwork. myrecorder initialize. window := (SystemWindow labelled: 'iSCREAM') model: self. myalert := AlertMorph new. myalert socketOwner: self. window addMorph: myalert frame: (0.35@0.4 corner: 0.5@0.7). (playButton := self playButton) center: 200@300. window addMorph: playButton frame: (0.5@0.4 corner: 1.0@0.7). (myOpenConnectionButton := self connectButton) center: 250@300. window addMorph: myOpenConnectionButton frame: (0.5@0 corner: 1.0@0.4). (myStopButton := self recordAndStopButton) center: 300@300. window addMorph: myStopButton frame: (0.5@0.7 corner: 1.0@1.0). myUpdatingText := UpdatingStringMorph on: self selector: #objectsInQueue. window addMorph: myUpdatingText frame: (0.41@0.75 corner: 0.45@0.95). "myUserList init."! Item was changed: ----- Method: AudioChatGUI>>start2 (in category 'initialization') ----- start2 Socket initializeNetwork. myrecorder initialize. self addARow: { self inAColumn: { ( self inARow: { self inAColumn: {self toggleForSendWhileTalking}. self inAColumn: {self toggleForHandsFreeTalking}. self inAColumn: {self toggleForPlayOnArrival}. } ) hResizing: #shrinkWrap. self inARow: { self talkBacklogIndicator. self messageWaitingAlertIndicator. }. }. self inAColumn: { theConnectButton := self connectButton. self playButton. theTalkButton := self talkButton. }. }. ! Item was changed: ----- Method: AudioChatGUI>>step (in category 'stepping and presenter') ----- step | now | super step. self transmitWhileRecording ifTrue: [self sendAnyCompletedSounds]. self handsFreeTalking & myrecorder isRecording ifTrue: [ now := Time millisecondClockValue. ((handsFreeTalkingFlashTime ifNil: [0]) - now) abs > 200 ifTrue: [ theTalkButton color: ( theTalkButton color = self buttonColor ifTrue: [Color white] ifFalse: [self buttonColor] ). handsFreeTalkingFlashTime := now. ]. ]. self class playOnArrival ifTrue: [self playNextMessage]. "myrecorder ifNotNil: [ myrecorder recorder samplingRate printString ,' ', SoundPlayer samplingRate printString,' ' displayAt: 0@0 ]."! Item was changed: ----- Method: AudioChatGUI>>toggleChoice: (in category 'stuff') ----- toggleChoice: aSymbol aSymbol == #playOnArrival ifTrue: [ ^PlayOnArrival := self class playOnArrival not ]. aSymbol == #transmitWhileRecording ifTrue: [ transmitWhileRecording := self transmitWhileRecording not. self changeTalkButtonLabel. ^transmitWhileRecording ]. aSymbol == #handsFreeTalking ifTrue: [ handsFreeTalking := self handsFreeTalking not. self changeTalkButtonLabel. ^handsFreeTalking ]. ! Item was changed: ----- Method: AudioChatGUI>>transmitWhileRecording (in category 'sending') ----- transmitWhileRecording ^transmitWhileRecording ifNil: [transmitWhileRecording := false]! Item was changed: ----- Method: BufferedCanvas>>checkIfTimeToDisplay (in category 'as yet unclassified') ----- checkIfTimeToDisplay remote backlog > 0 ifTrue: [^self]. "why bother if network full?" dirtyRect ifNil: [^self]. self sendDeltas. lastTick := Time millisecondClockValue. ! Item was changed: ----- Method: BufferedCanvas>>connection:clipRect:transform:remoteCanvas: (in category 'as yet unclassified') ----- connection: connection clipRect: newClipRect transform: transform remoteCanvas: remoteCanvas remote := remoteCanvas. lastTick := 0. ! Item was changed: ----- Method: BufferedCanvas>>forceToScreen: (in category 'other') ----- forceToScreen: rect mirrorOfScreen ifNil: [ mirrorOfScreen := (previousVersion ifNil: [Display]) deepCopy. ]. mirrorOfScreen copy: rect from: rect origin in: Display rule: Form over. dirtyRect := dirtyRect ifNil: [rect] ifNotNil: [dirtyRect merge: rect]. ! Item was changed: ----- Method: BufferedCanvas>>sendDeltas (in category 'as yet unclassified') ----- sendDeltas " NebraskaDebug showStats: #sendDeltas " | t deltas dirtyFraction | previousVersion ifNil: [ previousVersion := Display deepCopy. remote image: previousVersion at: 0@0 sourceRect: previousVersion boundingBox rule: Form paint. ^remote forceToScreen: previousVersion boundingBox. ]. dirtyRect ifNil: [^self]. t := Time millisecondClockValue. dirtyFraction := dirtyRect area / previousVersion boundingBox area roundTo: 0.0001. deltas := mirrorOfScreen deltaFrom: (previousVersion copy: dirtyRect) at: dirtyRect origin. previousVersion := mirrorOfScreen. mirrorOfScreen := nil. remote image: deltas at: dirtyRect origin sourceRect: deltas boundingBox rule: Form reverse; forceToScreen: dirtyRect. t := Time millisecondClockValue - t. NebraskaDebug at: #sendDeltas add: {t. dirtyFraction. deltas boundingBox}. dirtyRect := nil. ! 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 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: CanvasDecoder class>>reinitialize (in category 'class initialization') ----- reinitialize "CanvasDecoder reinitialize" "Set up my cache and decode table, removing old contents." CachedForms := nil. DecodeTable := nil. self initialize. ! Item was changed: ----- Method: CanvasDecoder>>connection: (in category 'network') ----- connection: aStringSocket "set this terminal to talk over the given socket" connection := aStringSocket! Item was changed: ----- Method: CanvasDecoder>>drawLine: (in category 'decoding') ----- drawLine: command | verb pt1Enc pt2Enc widthEnc colorEnc pt1 pt2 width color | verb := command first. pt1Enc := command second. pt2Enc := command third. widthEnc := command fourth. colorEnc := command fifth. "" pt1 := self class decodePoint: pt1Enc. pt2 := self class decodePoint: pt2Enc. width := self class decodeInteger: widthEnc. color := self class decodeColor: colorEnc. "" self drawCommand: [:c | c line: pt1 to: pt2 width: width color: color]! Item was changed: ----- Method: CanvasDecoder>>drawOval: (in category 'decoding') ----- drawOval: command | verb rectEnc colorEnc borderWidthEnc borderColorEnc rect color borderWidth borderColor | verb := command first. rectEnc := command second. colorEnc := command third. borderWidthEnc := command fourth. borderColorEnc := command fifth. "" rect := self class decodeRectangle: rectEnc. color := self class decodeColor: colorEnc. borderWidth := self class decodeInteger: borderWidthEnc. borderColor := self class decodeColor: borderColorEnc. "" self drawCommand: [:c | c fillOval: rect color: color borderWidth: borderWidth borderColor: borderColor]! Item was changed: ----- Method: CanvasDecoder>>drawRect: (in category 'decoding') ----- drawRect: command | verb rectEnc fillColorEnc borderWidthEnc borderColorEnc rect fillColor borderWidth borderColor | verb := command first. rectEnc := command second. fillColorEnc := command third. borderWidthEnc := command fourth. borderColorEnc := command fifth. "" rect := self class decodeRectangle: rectEnc. fillColor := self class decodeColor: fillColorEnc. borderWidth := self class decodeInteger: borderWidthEnc. borderColor := self class decodeColor: borderColorEnc. "" self drawCommand: [:c | c frameAndFillRectangle: rect fillColor: fillColor borderWidth: borderWidth borderColor: borderColor]! Item was changed: ----- Method: CanvasDecoder>>showSpaceUsed (in category 'decoding') ----- showSpaceUsed | total | CachedForms ifNil: [^self]. total := 0. CachedForms do: [ :each | each ifNotNil: [ total := total + (each depth * each width * each height // 8). ]. ]. (total // 1024) printString,' ', (Smalltalk garbageCollectMost // 1024) printString,' ' displayAt: 0@0! Item was changed: ----- Method: CanvasEncoder class>>at:count: (in category 'as yet unclassified') ----- at: anIndex count: anInteger SimpleCounters ifNil: [(SimpleCounters := Array new: 10) atAllPut: 0]. SimpleCounters at: anIndex put: (SimpleCounters at: anIndex) + anInteger.! Item was changed: ----- Method: CanvasEncoder class>>beginStats (in category 'as yet unclassified') ----- beginStats SentTypesAndSizes := Dictionary new.! Item was changed: ----- Method: CanvasEncoder class>>clearTestVars (in category 'as yet unclassified') ----- clearTestVars " CanvasEncoder clearTestVars " SimpleCounters := nil ! Item was changed: ----- Method: CanvasEncoder class>>encodeImage: (in category 'encoding') ----- encodeImage: form | t answer | form ifNil: [^'']. t := Time millisecondsToRun: [answer := form encodeForRemoteCanvas]. form boundingBox area > 5000 ifTrue: [ NebraskaDebug at: #FormEncodeTimes add: {t. form extent. answer size} ]. ^answer "HandMorph>>restoreSavedPatchOn: is one culprit here" ! Item was changed: ----- Method: CanvasEncoder class>>killStats (in category 'as yet unclassified') ----- killStats SentTypesAndSizes := nil! Item was changed: ----- Method: CanvasEncoder class>>nameForCode: (in category 'as yet unclassified') ----- nameForCode: aStringOrChar | ch | ch := (aStringOrChar isString) ifTrue: [aStringOrChar first] ifFalse: [aStringOrChar]. ch == self codeBalloonOval ifTrue: [^'balloon oval']. ch == self codeBalloonRect ifTrue: [^'balloon rectangle']. ch == self codeClip ifTrue: [^'clip']. ch == self codeExtentDepth ifTrue: [^'codeExtentDepth']. ch == self codeFont ifTrue: [^'codeFont']. ch == self codeTTCFont ifTrue: [^'codeTTCFont']. ch == self codeForce ifTrue: [^'codeForce']. ch == self codeImage ifTrue: [^'codeImage']. ch == self codeLine ifTrue: [^'codeLine']. ch == self codeOval ifTrue: [^'codeOval']. ch == self codePoly ifTrue: [^'codePoly']. ch == self codeRect ifTrue: [^'codeRect']. ch == self codeReleaseCache ifTrue: [^'codeReleaseCache']. ch == self codeStencil ifTrue: [^'codeStencil']. ch == self codeText ifTrue: [^'codeText']. ch == self codeTransform ifTrue: [^'codeTransform']. ch == self codeInfiniteFill ifTrue: [^'codeInfiniteFill']. ch == self codeShadowColor ifTrue: [^'shadowColor']. ^'????' ! Item was changed: ----- Method: CanvasEncoder>>cachingEnabled: (in category 'drawing') ----- cachingEnabled: aBoolean (cachingEnabled := aBoolean) ifFalse: [ cachedObjects := nil. ]. ! Item was changed: ----- Method: CanvasEncoder>>connection: (in category 'connection') ----- connection: aStringSocket "set this connection to talk over the given socket" cachingEnabled := true. connection := aStringSocket! Item was changed: ----- Method: CanvasEncoder>>convertToCurrentVersion:refStream: (in category 'objects from disk') ----- convertToCurrentVersion: varDict refStream: smartRefStrm cachingEnabled ifNil: [cachingEnabled := true]. ^super convertToCurrentVersion: varDict refStream: smartRefStrm. ! Item was changed: ----- Method: CanvasEncoder>>disconnect (in category 'connection') ----- disconnect connection ifNotNil: [ connection destroy. connection := nil. ].! Item was changed: ----- Method: CanvasEncoder>>image:at:sourceRect:rule:cacheID:newToCache: (in category 'drawing') ----- image: aFormOrNil at: aPoint sourceRect: sourceRect rule: rule cacheID: cacheID newToCache: newToCache | t destRect d2 | destRect := aPoint extent: sourceRect extent. d2 := (lastTransform invertBoundsRect: destRect) expandBy: 1. (d2 intersects: lastClipRect) ifFalse: [ ^NebraskaDebug at: #bigImageSkipped add: {lastClipRect. d2}. ]. t := Time millisecondsToRun: [ self sendCommand: { String with: CanvasEncoder codeImage. self class encodeImage: aFormOrNil. self class encodePoint: aPoint. self class encodeRectangle: sourceRect. self class encodeInteger: rule. self class encodeInteger: cacheID. self class encodeInteger: (newToCache ifTrue: [1] ifFalse: [0]). }. ]. (aFormOrNil notNil and: [aFormOrNil boundingBox area > 10000]) ifTrue: [ NebraskaDebug at: #bigImage add: {lastClipRect. aPoint. sourceRect extent. t. cacheID. newToCache}. ]. ! 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 isTTCFont ifTrue: [code := CanvasEncoder codeTTCFont]. self sendCommand: { String with: code. self class encodeInteger: index. self class encodeFont: aFont }. ! Item was changed: ----- Method: CanvasEncoder>>testRectangleFillTiming (in category 'drawing') ----- testRectangleFillTiming | r fillColor borderWidth borderColor t | " CanvasEncoder new testRectangleFillTiming " r := 100@100 extent: 300@300. fillColor := Color blue. borderWidth := 1. borderColor := Color red. t := Time millisecondsToRun: [ 1000 timesRepeat: [ { String with: CanvasEncoder codeRect. self class encodeRectangle: r. self class encodeColor: fillColor. self class encodeInteger: borderWidth. self class encodeColor: borderColor } ]. ]. t inspect.! Item was changed: ----- Method: CanvasEncoder>>updateTransform:andClipRect: (in category 'clipping and transforming') ----- updateTransform: aTransform andClipRect: aClipRect "sets the given transform and clip rectangle, if they aren't already the ones being used" aTransform = lastTransform ifFalse: [ self setTransform: aTransform. lastTransform := aTransform ]. aClipRect = lastClipRect ifFalse: [ self setClipRect: aClipRect. lastClipRect := aClipRect. ].! Item was changed: ----- Method: ChatButtonMorph>>actionDownSelector: (in category 'accessing') ----- actionDownSelector: aSymbolOrString (nil = aSymbolOrString or: ['nil' = aSymbolOrString or: [aSymbolOrString isEmpty]]) ifTrue: [^actionDownSelector := nil]. actionDownSelector := aSymbolOrString asSymbol.! Item was changed: ----- Method: ChatButtonMorph>>actionUpSelector: (in category 'accessing') ----- actionUpSelector: aSymbolOrString (nil = aSymbolOrString or: ['nil' = aSymbolOrString or: [aSymbolOrString isEmpty]]) ifTrue: [^ actionUpSelector := nil]. actionUpSelector := aSymbolOrString asSymbol.! Item was changed: ----- Method: ChatButtonMorph>>labelDown: (in category 'accessing') ----- labelDown: aString labelDown := aString.! Item was changed: ----- Method: ChatButtonMorph>>labelUp: (in category 'accessing') ----- labelUp: aString labelUp := aString! Item was changed: ----- Method: ChatButtonMorph>>mouseDown: (in category 'event handling') ----- mouseDown: evt oldColor := self fillStyle. self label: labelDown. self doButtonDownAction. ! Item was changed: ----- Method: ChatNotes>>deleteSelection (in category 'file i/o') ----- deleteSelection "Delete the selection in the list" | dir | notesIndex <= 0 ifTrue: [^self]. dir := self audioDirectory. dir deleteFileNamed: ((notes at: notesIndex), 'name') ifAbsent: []. dir deleteFileNamed: ((notes at: notesIndex), 'aiff') ifAbsent: []. names removeAt: notesIndex. notes removeAt: notesIndex. self notesListIndex: 0. self changed: #notesList. self changed: #name.! Item was changed: ----- Method: ChatNotes>>getNextName (in category 'file i/o') ----- getNextName "Return the next name available. All names are of the form '#.name' and '#.aiff'." | dir num | dir := self audioDirectory. num := 1. [dir fileExists: (num asString, '.name')] whileTrue: [num := num + 1]. ^(num asString, '.')! Item was changed: ----- Method: ChatNotes>>initialize (in category 'initialization') ----- initialize self loadNotes. notesIndex := 0. recorder := ChatRecorder new. recorder initialize.! Item was changed: ----- Method: ChatNotes>>isPlaying (in category 'testing') ----- isPlaying ^isPlaying ifNil: [isPlaying := false]! Item was changed: ----- Method: ChatNotes>>isPlaying: (in category 'testing') ----- isPlaying: aBoolean isPlaying = aBoolean ifTrue: [^self]. isPlaying := aBoolean. self changed: #isPlaying ! Item was changed: ----- Method: ChatNotes>>isRecording (in category 'testing') ----- isRecording ^isRecording ifNil: [isRecording := false]! Item was changed: ----- Method: ChatNotes>>isRecording: (in category 'testing') ----- isRecording: aBoolean isRecording = aBoolean ifTrue: [^self]. isRecording := aBoolean. self changed: #isRecording ! Item was changed: ----- Method: ChatNotes>>isSaving (in category 'testing') ----- isSaving ^isSaving ifNil: [isSaving := false]! Item was changed: ----- Method: ChatNotes>>isSaving: (in category 'testing') ----- isSaving: aBoolean isSaving = aBoolean ifTrue: [^self]. isSaving := aBoolean. self changed: #isSaving! Item was changed: ----- Method: ChatNotes>>loadNotes (in category 'initialization') ----- loadNotes "Load notes from the files" | dir | names := OrderedCollection new. notes := OrderedCollection new. (FileDirectory default directoryExists: 'audio') ifFalse: [^self]. dir := self audioDirectory. dir fileNames do: [:fname | (fname endsWith: '.name') ifTrue: [ names add: ((dir fileNamed: fname) contentsOfEntireFile). notes add: (fname copyFrom: 1 to: (fname size - 4))]].! Item was changed: ----- Method: ChatNotes>>name (in category 'accessing') ----- name ^name ifNil: [name := '']! Item was changed: ----- Method: ChatNotes>>name: (in category 'accessing') ----- name: aString name := aString. self changed: #name.! Item was changed: ----- Method: ChatNotes>>notesListIndex (in category 'accessing') ----- notesListIndex ^notesIndex ifNil: [notesIndex := 0]! Item was changed: ----- Method: ChatNotes>>notesListIndex: (in category 'accessing') ----- notesListIndex: index notesIndex := index = notesIndex ifTrue: [0] ifFalse: [index]. self name: (self notesList at: notesIndex ifAbsent: ['']). self changed: #notesListIndex.! Item was changed: ----- Method: ChatNotes>>openAsMorph (in category 'initialization') ----- openAsMorph | window aColor recordButton stopButton playButton saveButton | window := (SystemWindow labelled: 'Audio Notes') model: self. window addMorph: ( (PluggableListMorph on: self list: #notesList selected: #notesListIndex changeSelected: #notesListIndex: menu: #notesMenu: ) autoDeselect: false) frame: (0@0 corner: 0.5@1.0). nameTextMorph := PluggableTextMorph on: self text: #name accept: nil. nameTextMorph askBeforeDiscardingEdits: false. window addMorph: nameTextMorph frame: (0.5@0 corner: 1.0@0.4). aColor := Color colorFrom: self defaultBackgroundColor. (recordButton := PluggableButtonMorph on: self getState: #isRecording action: #record) label: 'record'; askBeforeChanging: true; color: aColor; onColor: aColor darker offColor: aColor. window addMorph: recordButton frame: (0.5@0.4 corner: 0.75@0.7). (stopButton := PluggableButtonMorph on: self getState: #isStopped action: #stop) label: 'stop'; askBeforeChanging: true; color: aColor; onColor: aColor darker offColor: aColor. window addMorph: stopButton frame: (0.75@0.4 corner: 1.0@0.7). (playButton := PluggableButtonMorph on: self getState: #isPlaying action: #play) label: 'play'; askBeforeChanging: true; color: aColor; onColor: aColor darker offColor: aColor. window addMorph: playButton frame: (0.5@0.7 corner: 0.75@1.0). (saveButton := PluggableButtonMorph on: self getState: #isSaving action: #save) label: 'save'; askBeforeChanging: true; color: aColor; onColor: aColor darker offColor: aColor. window addMorph: saveButton frame: (0.75@0.7 corner: 1.0@1.0). window openInWorld.! Item was changed: ----- Method: ChatNotes>>play (in category 'file i/o') ----- play | separator | self isPlaying: true. notesIndex = 0 ifTrue: [ recorder pause. recorder playback. self isPlaying: false. ^self ]. separator := FileDirectory pathNameDelimiter asString. sound := (AIFFFileReader new readFromFile: ( FileDirectory default pathName, separator, 'audio', separator, (notes at: notesIndex), 'aiff')) sound. [ sound playAndWaitUntilDone. self isPlaying: false ] fork! Item was changed: ----- Method: ChatNotes>>record (in category 'button commands') ----- record self isRecording: true. notesIndex = 0 ifFalse: [self notesListIndex: 0]. sound := nil. recorder clearRecordedSound. recorder resumeRecording.! Item was changed: ----- Method: ChatNotes>>saveName (in category 'file i/o') ----- saveName "Save the name to the '.name' file." | dir file | self name: self textMorphString. dir := self audioDirectory. file := (notes at: notesIndex), 'name'. (dir fileExists: file) ifTrue: [dir deleteFileNamed: file]. file := dir newFileNamed: file. file nextPutAll: name. file close. names at: notesIndex put: name. self changed: #notesList.! Item was changed: ----- Method: ChatNotes>>saveSound (in category 'file i/o') ----- saveSound "Move the sound from the recorder to the files." | fname file | recorder recordedSound ifNil: [^self]. self isSaving: true. fname := self getNextName. "Create .name file" file := self audioDirectory newFileNamed: (fname, 'name'). file nextPutAll: self textMorphString. file close. "Create .aiff file" file := (self audioDirectory newFileNamed: (fname, 'aiff')) binary. self storeAIFFOnFile: file. file close. "Add to names and notes" names add: self textMorphString. notes add: fname. self changed: #notesList. self notesListIndex: (notes size). "Clear Recorder" recorder := SoundRecorder new. "Stop Button" self isSaving: false! Item was changed: ----- Method: ChatRecorder>>initialize (in category 'as yet unclassified') ----- initialize "setting a higher desired recording rate seemed to fix certain powerbook problems. I'm still trying to understand it all, but there it is for now" super initialize. samplingRate := 44100. ! Item was changed: ----- Method: ChatRecorder>>pause (in category 'as yet unclassified') ----- pause "Go into pause mode. The record level continues to be updated, but no sound is recorded." paused := true. ((currentBuffer ~~ nil) and: [nextIndex > 1]) ifTrue: [self emitPartialBuffer. self allocateBuffer]. soundPlaying ifNotNil: [ soundPlaying pause. soundPlaying := nil]. self stopRecording. "Preferences canRecordWhilePlaying ifFalse: [self stopRecording]." ! Item was changed: ----- Method: ChatRecorder>>playback (in category 'as yet unclassified') ----- playback "Playback the sound that has been recorded." self pause. soundPlaying := self recordedSound ifNil: [^self]. soundPlaying play. ! Item was changed: ----- Method: ChatRecorder>>recordedSound: (in category 'accessing') ----- recordedSound: aSound self clearRecordedSound. recordedSound := aSound.! Item was changed: ----- Method: ChatRecorder>>resumeRecording (in category 'as yet unclassified') ----- resumeRecording "Continue recording from the point at which it was last paused." self startRecording. paused := false. ! Item was changed: ----- Method: ColorForm>>encodeForRemoteCanvas (in category '*nebraska-*nebraska-Morphic-Remote') ----- encodeForRemoteCanvas "encode into a bitstream for use with RemoteCanvas." | colorsToSend | colorsToSend := self colors. ^String streamContents: [ :str | str nextPut: $C; "indicates color form" nextPutAll: colorsToSend size printString; nextPut: $,. colorsToSend do: [ :each | str nextPutAll: each encodeForRemoteCanvas ]. str nextPutAll: super encodeForRemoteCanvas ]. ! Item was changed: ----- Method: DisplayTransform class>>fromRemoteCanvasEncoding: (in category '*nebraska-instance creation') ----- fromRemoteCanvasEncoding: encoded | type | "decode a transform from the given encoded string" type := (ReadStream on: encoded) upTo: $,. type = 'Morphic' ifTrue: [ ^MorphicTransform fromRemoteCanvasEncoding: encoded ]. type = 'Matrix' ifTrue: [ ^MatrixTransform2x3 fromRemoteCanvasEncoding: encoded ]. type = 'Composite' ifTrue: [ ^CompositeTransform fromRemoteCanvasEncoding: encoded ]. ^self error: 'invalid transform encoding'! Item was changed: ----- 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 changed: ----- Method: EToyChatMorph class>>chatWindowForIP:name:picture:inWorld: (in category 'as yet unclassified') ----- chatWindowForIP: ipAddress name: senderName picture: aForm inWorld: aWorld | makeANewOne aSenderBadge existing | existing := self instanceForIP: ipAddress inWorld: aWorld. existing 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@200; openInWorld: aWorld; startChat: false. ^aSenderBadge findDeepSubmorphThat: [ :x | x isKindOf: EToyChatMorph] ifAbsent: makeANewOne ]. ^makeANewOne value. ! Item was changed: ----- 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 changed: ----- 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 changed: ----- 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 changed: ----- 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 changed: ----- Method: EToyChatMorph>>recipientForm: (in category 'as yet unclassified') ----- recipientForm: aForm recipientForm := aForm. recipientForm ifNotNil: [recipientForm := recipientForm scaledToSize: 20@20].! Item was changed: ----- Method: EToyChatMorph>>startOfMessageFromMe (in category 'as yet unclassified') ----- startOfMessageFromMe myForm ifNil: [ myForm := EToySenderMorph pictureForIPAddress: NetNameResolver localAddressString. myForm ifNotNil: [ myForm := myForm scaledToSize: 20@20 ]. ]. myForm ifNil: [ ^(Preferences defaultAuthorName asText allBold addAttribute: TextColor blue) ]. ^(String value: 1) asText addAttribute: (TextAnchor new anchoredMorph: myForm); yourself ! Item was changed: ----- 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 changed: ----- 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 changed: ----- 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 changed: ----- Method: EToyFridgeMorph class>>fridgeRecipients (in category 'as yet unclassified') ----- fridgeRecipients ^FridgeRecipients ifNil: [FridgeRecipients := OrderedCollection new]! Item was changed: ----- 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 changed: ----- Method: EToyFridgeMorph class>>newItems (in category 'as yet unclassified') ----- newItems ^NewItems ifNil: [NewItems := OrderedCollection new]! Item was changed: ----- 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 changed: ----- 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 changed: ----- 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 changed: ----- 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 changed: ----- 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 changed: ----- 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@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@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 changed: ----- Method: EToyFridgeMorph>>toggleChoice: (in category 'as yet unclassified') ----- toggleChoice: aString updateCounter := nil. "force rebuild" aString = 'group' ifTrue: [^groupMode := (groupMode ifNil: [true]) not]. ! Item was changed: ----- 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 changed: ----- Method: EToyGateKeeperEntry>>dateAndTimeStringFrom: (in category 'as yet unclassified') ----- dateAndTimeStringFrom: totalSeconds | dateAndTime | dateAndTime := Time dateAndTimeFromSeconds: totalSeconds. ^dateAndTime first printString,' ',dateAndTime second printString! Item was changed: ----- 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 changed: ----- Method: EToyGateKeeperEntry>>ipAddress: (in category 'as yet unclassified') ----- ipAddress: aString ipAddress := aString! Item was changed: ----- Method: EToyGateKeeperEntry>>lastTimeCheckedString (in category 'as yet unclassified') ----- lastTimeCheckedString | statusTime | statusTime := self valueOfProperty: #lastTimeChecked ifAbsent: [^'none']. ^(self dateAndTimeStringFrom: statusTime)! Item was changed: ----- Method: EToyGateKeeperEntry>>latestUserName: (in category 'as yet unclassified') ----- latestUserName: aString latestUserName := aString! Item was changed: ----- 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 changed: ----- 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 changed: ----- 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 changed: ----- 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 changed: ----- Method: EToyGateKeeperMorph class>>knownIPAddresses (in category 'as yet unclassified') ----- knownIPAddresses ^KnownIPAddresses ifNil: [KnownIPAddresses := Dictionary new]! Item was changed: ----- Method: EToyGateKeeperMorph class>>updateCounter (in category 'as yet unclassified') ----- updateCounter ^UpdateCounter ifNil: [UpdateCounter := 0]! Item was changed: ----- 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 changed: ----- Method: EToyIncomingMessage class>>messageHandlers (in category 'as yet unclassified') ----- messageHandlers ^MessageHandlers ifNil: [MessageHandlers := Dictionary new].! Item was changed: ----- 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 changed: ----- Method: EToyIncomingMessage class>>registerType: (in category 'message types') ----- registerType: aMessageType MessageTypes := self allTypes copyWith: aMessageType! Item was changed: ----- Method: EToyIncomingMessage class>>unregisterType: (in category 'message types') ----- unregisterType: aMessageType MessageTypes := self allTypes copyWithout: aMessageType! Item was changed: ----- 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 changed: ----- Method: EToyListenerMorph class>>bumpUpdateCounter (in category 'as yet unclassified') ----- bumpUpdateCounter UpdateCounter := (UpdateCounter ifNil: [0]) + 1. ! Item was changed: ----- Method: EToyListenerMorph class>>commResultDeferred: (in category 'as yet unclassified') ----- commResultDeferred: anArrayOfAssociations | m ipAddress aDictionary | "to be run as part of the UI process in case user interaction is required" aDictionary := Dictionary new. 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 changed: ----- Method: EToyListenerMorph class>>critical: (in category 'as yet unclassified') ----- critical: aBlock QueueSemaphore ifNil: [QueueSemaphore := Semaphore forMutualExclusion]. ^QueueSemaphore critical: aBlock ! Item was changed: ----- 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 changed: ----- Method: EToyListenerMorph class>>globalIncomingQueue (in category 'as yet unclassified') ----- globalIncomingQueue ^GlobalIncomingQueue ifNil: [GlobalIncomingQueue := OrderedCollection new].! Item was changed: ----- 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@25) * factor. capExtent := (30@30) * factor. earExtent := (15@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@15 depth: 8. background displayInterpolatedOn: f2. f2 replaceColor: Color white withColor: Color transparent. ^f2 =====" ! Item was changed: ----- Method: EToyListenerMorph class>>makeListeningToggleNew: (in category 'as yet unclassified') ----- makeListeningToggleNew: activeMode | background c baseExtent bgExtent botCent factor len endPts base | factor := 2. bgExtent := (50@25) * factor. baseExtent := (15@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@len). botCent - (len negated@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 changed: ----- 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 changed: ----- Method: EToyListenerMorph class>>shutDown: (in category 'system startup') ----- shutDown: quitting WasListeningAtShutdown := GlobalListener notNil. self stopListening. ! Item was changed: ----- Method: EToyListenerMorph class>>startListening (in category 'as yet unclassified') ----- startListening self stopListening. GlobalListener := EToyPeerToPeer new awaitDataFor: self. self bumpUpdateCounter. ! Item was changed: ----- Method: EToyListenerMorph class>>stopListening (in category 'as yet unclassified') ----- stopListening GlobalListener ifNotNil: [GlobalListener stopListening. GlobalListener := nil. self bumpUpdateCounter] "EToyListenerMorph stopListening"! Item was changed: ----- 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 changed: ----- 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 changed: ----- 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 changed: ----- 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 changed: ----- 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 changed: ----- Method: EToyMorphsWelcomeMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" | earMorph | super initialize. "" self layoutInset: 8 @ 8. "earMorph := (EToyListenerMorph makeListeningToggle: true) 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 changed: ----- 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 changed: ----- Method: EToyMultiChatMorph>>editEvent:for: (in category 'as yet unclassified') ----- editEvent: anEvent for: aMorph | answer initialText aFillInTheBlankMorph | (aMorph bounds containsPoint: anEvent cursorPoint) ifFalse: [^self]. initialText := String streamContents: [ :strm | 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 changed: ----- Method: EToyMultiChatMorph>>initialize (in category 'initialization') ----- initialize targetIPAddresses := OrderedCollection new. super initialize. bounds := 0@0 extent: 350@350.! Item was changed: ----- Method: EToyMultiChatMorph>>rebuild (in category 'as yet unclassified') ----- rebuild | r1 r2 | r1 := self addARow: { self simpleToggleButtonFor: self attribute: #acceptOnCR help: 'Send with Return?'. 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 changed: ----- 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 changed: ----- 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 changed: ----- 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 changed: ----- 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 changed: ----- Method: EToyPeerToPeer>>doSendData (in category 'sending') ----- doSendData | totalLength myData allTheData | myData := dataQueue next ifNil: [socket sendData: '0 '. ^false]. totalLength := (myData collect: [ :x | x size]) sum. socket sendData: totalLength printString,' '. allTheData := WriteStream on: (String new: totalLength). myData do: [ :chunk | allTheData nextPutAll: chunk asString]. NebraskaDebug at: #peerBytesSent add: {totalLength}. self sendDataCautiously: allTheData contents. ^true ! Item was changed: ----- Method: EToyPeerToPeer>>receiveDataOn:for: (in category 'receiving') ----- receiveDataOn: aSocket for: aCommunicatorMorph socket := aSocket. remoteSocketAddress := socket remoteAddress. communicatorMorph := aCommunicatorMorph. process := [ leftOverData := ''. [self doReceiveData] whileTrue. socket closeAndDestroy. ] newProcess. process priority: Processor highIOPriority. process resume. ! Item was changed: ----- 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 changed: ----- 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 changed: ----- 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 changed: ----- Method: EToyPeerToPeer>>stopListening (in category 'receiving') ----- stopListening process ifNotNil: [process terminate. process := nil]. connectionQueue ifNotNil: [connectionQueue destroy. connectionQueue := nil]. ! Item was changed: ----- 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 changed: ----- 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 changed: ----- 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 changed: ----- 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 changed: ----- 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@53) userEmail: uEmail userIPAddress: uIP ! Item was changed: ----- 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 changed: ----- Method: EToySenderMorph>>mouseEnteredDZ (in category 'as yet unclassified') ----- mouseEnteredDZ | dz | dz := self valueOfProperty: #specialDropZone ifAbsent: [^self]. dz color: Color blue.! Item was changed: ----- Method: EToySenderMorph>>mouseLeftDZ (in category 'as yet unclassified') ----- mouseLeftDZ | dz | dz := self valueOfProperty: #specialDropZone ifAbsent: [^self]. dz color: Color transparent.! Item was changed: ----- 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 changed: ----- 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 changed: ----- 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 changed: ----- Method: EToySenderMorph>>userName:userPicture:userEmail:userIPAddress: (in category 'as yet unclassified') ----- userName: aString userPicture: aFormOrNil userEmail: emailString userIPAddress: ipString | dropZoneRow | self setProperty: #currentBadgeVersion toValue: self currentBadgeVersion. userPicture := aFormOrNil ifNil: [ (TextStyle default fontOfSize: 26) emphasized: 1; characterFormAt: $? ]. userPicture := userPicture scaledToSize: 61@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 changed: ----- 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: Form>>deltaFrom: (in category '*nebraska-encoding') ----- deltaFrom: previousForm | newForm | newForm := previousForm deepCopy. (BitBlt destForm: newForm sourceForm: self fillColor: nil combinationRule: Form reverse destOrigin: 0@0 sourceOrigin: 0@0 extent: self extent clipRect: self boundingBox) copyBits. ^newForm! Item was changed: ----- Method: Form>>deltaFrom:at: (in category '*nebraska-encoding') ----- deltaFrom: smallerForm at: offsetInMe | newForm | newForm := smallerForm deepCopy. (BitBlt destForm: newForm sourceForm: self fillColor: nil combinationRule: Form reverse destOrigin: 0@0 sourceOrigin: offsetInMe extent: smallerForm extent clipRect: newForm boundingBox) copyBits. ^newForm! Item was changed: ----- Method: LoopbackStringSocket class>>clearStats (in category 'as yet unclassified') ----- clearStats WRITESTRINGSIZES := nil! Item was changed: ----- Method: LoopbackStringSocket>>destroy (in category 'as yet unclassified') ----- destroy associate := inArrays := outArrays := nil.! Item was changed: ----- Method: MatrixTransform2x3 class>>fromRemoteCanvasEncoding: (in category '*nebraska-instance creation') ----- fromRemoteCanvasEncoding: encoded "DisplayTransform fromRemoteCanvasEncoding: 'Matrix,1065353216,0,1137541120,0,1065353216,1131610112,'" | nums transform encodedNums | "split the numbers up" encodedNums := encoded findTokens: ','. "remove the initial 'Matrix' specification" encodedNums := encodedNums asOrderedCollection. encodedNums removeFirst. "parse the numbers" nums := encodedNums collect: [ :enum | Integer readFromString: enum ]. "create an instance" transform := self new. "plug in the numbers" nums doWithIndex: [ :num :i | transform basicAt: i put: num ]. ^transform! Item was changed: ----- Method: NebraskaClient>>convertToBuffered (in category 'initialization') ----- convertToBuffered canvas purgeOutputQueue. canvas := canvas asBufferedCanvas.! Item was changed: ----- Method: NebraskaClient>>destroy (in category 'initialization') ----- destroy hand ifNotNil:[hand world ifNotNil:[hand world removeHand: hand]]. connection ifNotNil:[connection destroy]. encoder := canvas := hand := connection := nil.! Item was changed: ----- Method: NebraskaDebug class>>at:add: (in category 'as yet unclassified') ----- at: queueName add: anArray | now | DEBUG ifNil: [ queueName == #sketchZZZ ifFalse: [^self]. "Details := OrderedCollection new." self beginStats. ]. (Details notNil and: [Details size < 20]) ifTrue: [ Details add: thisContext longStack ]. now := Time millisecondClockValue. DEBUG add: {now},anArray,{queueName}. ! Item was changed: ----- Method: NebraskaDebug class>>beginStats (in category 'as yet unclassified') ----- beginStats DEBUG := OrderedCollection new! Item was changed: ----- Method: NebraskaDebug class>>killStats (in category 'as yet unclassified') ----- killStats DEBUG := nil. ! Item was changed: ----- Method: NebraskaDebug class>>showAndClearStats: (in category 'as yet unclassified') ----- showAndClearStats: queueName DEBUG ifNil: [^Beeper beep]. self showStats: queueName from: DEBUG. DEBUG := nil.! Item was changed: ----- Method: NebraskaDebug class>>stopAndShowAll (in category 'as yet unclassified') ----- stopAndShowAll | prev | self halt. "not updated to new format" prev := DEBUG. DEBUG := nil. prev ifNil: [^Beeper beep]. prev keysAndValuesDo: [ :k :v | self showStats: k from: v ].! Item was changed: ----- Method: NebraskaNavigationMorph>>nebraskaBorder: (in category 'as yet unclassified') ----- nebraskaBorder: aNebraskaBorder nebraskaBorder := aNebraskaBorder! Item was changed: ----- Method: NebraskaNavigationMorph>>nebraskaTerminal: (in category 'as yet unclassified') ----- nebraskaTerminal: aNebraskaTerminal nebraskaTerminal := aNebraskaTerminal! Item was changed: ----- Method: NebraskaNavigationMorph>>positionVertically (in category 'as yet unclassified') ----- positionVertically | w | w := self world ifNil: [^self]. self top < w top ifTrue: [self top: w top]. self bottom > w bottom ifTrue: [self bottom: w bottom].! Item was changed: ----- Method: NebraskaServer class>>serveWorld:onPort: (in category 'instance creation') ----- serveWorld: aWorld onPort: aPortNumber | server | Utilities authorName. "since we will need it later" server := self newForWorld: aWorld. server startListeningOnPort: aPortNumber. ^server "server acceptNullConnection" "server acceptPhonyConnection." ! Item was changed: ----- Method: NebraskaServer>>acceptNullConnection (in category 'networking') ----- acceptNullConnection | twins | twins := LoopbackStringSocket newPair. self addClientFromConnection: twins first. (NullTerminalMorph new connection: twins second) openInWorld. ! Item was changed: ----- Method: NebraskaServer>>acceptPhonyConnection (in category 'networking') ----- acceptPhonyConnection | twins | twins := LoopbackStringSocket newPair. self addClientFromConnection: twins first. (NetworkTerminalMorph new connection: twins second) inspect "openInWorld". ! Item was changed: ----- Method: NebraskaServer>>initializeForWorld: (in category 'initialization') ----- initializeForWorld: aWorld world := aWorld. clients := IdentitySet new. self extent: world extent depth: Display depth. aWorld remoteServer: self.! Item was changed: ----- Method: NebraskaServerMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" fullDisplay := false. lastFullUpdateTime := 0. self listDirection: #topToBottom; hResizing: #shrinkWrap; vResizing: #shrinkWrap! 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 standardButtonFont; color: Color transparent; actionSelector: #delete; target: self; extent: 14@14; 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' }. }. 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>>step (in category 'stepping and presenter') ----- step | now | self server ifNil: [ ^self ]. self server step. now := Time millisecondClockValue. (now - lastFullUpdateTime) abs > 5000 ifTrue: [ lastFullUpdateTime := now. (previousBacklog = self server backlog and: [self server clients = previousClients]) ifFalse: [ previousClients := self server clients copy. self rebuild ] ]. ! Item was changed: ----- Method: NebraskaServerMorph>>toggleFull (in category 'initialization') ----- toggleFull fullDisplay := fullDisplay not. self rebuild. ! Item was changed: ----- Method: NebraskaServerMorph>>updateCurrentStatusString (in category 'drawing') ----- updateCurrentStatusString self server ifNil:[ currentStatusString := '<Nebraska not active>' translated. currentBacklogString := ''. ] ifNotNil:[ currentStatusString := ' Nebraska: ' translated, self server numClients printString, ' clients' translated. currentBacklogString := 'backlog: ' translated, ((previousBacklog := self server backlog) // 1024) printString,'k' ]. ! Item was changed: ----- Method: NetworkTerminalBorderMorph>>toggleFullView (in category 'as yet unclassified') ----- toggleFullView "Toggle the full view for network terminal" | fullExtent priorExtent | fullExtent := self worldIEnclose extent + (2 * self borderWidth). priorExtent := self valueOfProperty: #priorExtent. priorExtent ifNil:[ self setProperty: #priorExtent toValue: self extent. self extent: fullExtent. self position: self position + self borderWidth asPoint negated. ] ifNotNil:[ self removeProperty: #priorExtent. self extent: priorExtent. self position: (self position max: 0@0). ].! Item was changed: ----- Method: NetworkTerminalMorph class>>connectTo:port: (in category 'instance creation') ----- connectTo: serverHost port: serverPort | stringSock | stringSock := self socketConnectedTo: serverHost port: serverPort. ^self new connection: stringSock ! Item was changed: ----- Method: NetworkTerminalMorph class>>openAndConnectTo:port: (in category 'instance creation') ----- openAndConnectTo: serverHost port: serverPort | stringSock me | stringSock := self socketConnectedTo: serverHost port: serverPort. me := self new connection: stringSock. ^me openInStyle: #naked ! 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' ]. ^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. EToyPeerToPeer new sendSomeData: { EToyIncomingMessage typeMorph,null. Preferences defaultAuthorName,null. outData } to: (NetNameResolver stringFromAddress: connection remoteAddress) for: self. ! Item was changed: ----- Method: NetworkTerminalMorph>>forceToFront: (in category 'drawing') ----- forceToFront: aRegion | highQuality | "force the given region from the drawing form onto the background form" highQuality := false. "highQuality is slower" self updateBackgroundForm. backgroundForm copy: aRegion from: aRegion topLeft in: decoder drawingForm rule: Form over. self invalidRect: ( highQuality ifTrue: [ bounds ] ifFalse: [ (aRegion expandBy: 4) translateBy: bounds topLeft "try to remove gribblys" ] ) ! Item was changed: ----- Method: NetworkTerminalMorph>>initialize (in category 'initialization') ----- initialize super initialize. backgroundForm := ( (StringMorph contents: '......' font: (TextStyle default fontOfSize: 24)) color: Color white ) imageForm. bounds := backgroundForm boundingBox. ! Item was changed: ----- Method: NetworkTerminalMorph>>openScaled (in category 'initialization') ----- openScaled | window tm | window := NetworkTerminalBorderMorph new minWidth: 100; minHeight: 100; borderWidth: 8; borderColor: Color orange; bounds: (0@0 extent: Display extent * 3 // 4). tm := BOBTransformationMorph new. tm useRegularWarpBlt: true. "try to reduce memory used" window addMorphBack: tm. tm addMorph: self. window openInWorld. NebraskaNavigationMorph new nebraskaBorder: window; nebraskaTerminal: self; openInWorld.! Item was changed: ----- Method: NetworkTerminalMorph>>updateBackgroundForm (in category 'drawing') ----- updateBackgroundForm "make sure that our background form matches what the server has most recently requested" | drawingForm | drawingForm := decoder drawingForm. (drawingForm extent = backgroundForm extent and: [ drawingForm depth = backgroundForm depth ]) ifTrue: [ "they match just fine" ^self ]. backgroundForm := drawingForm deepCopy. "need copy to capture the moment" self extent: backgroundForm extent.! Item was changed: ----- Method: NullTerminalMorph>>extent: (in category 'geometry') ----- extent: newExtent | aPoint | aPoint := 50@50. bounds extent = aPoint ifFalse: [ self changed. bounds := bounds topLeft extent: aPoint. self layoutChanged. self changed ]. eventEncoder sendViewExtent: newExtent! Item was changed: ----- Method: ObjectSocket>>destroy (in category 'as yet unclassified') ----- destroy socket destroy. socket := nil.! Item was changed: ----- Method: RemoteCanvas>>asBufferedCanvas (in category 'initialization') ----- asBufferedCanvas | bufferedCanvas | bufferedCanvas := BufferedCanvas new. connection cachingEnabled: false. bufferedCanvas connection: connection clipRect: NebraskaServer extremelyBigRectangle transform: MorphicTransform identity remoteCanvas: self. ^bufferedCanvas! Item was changed: ----- Method: RemoteCanvas>>clipBy:during: (in category 'drawing-support') ----- clipBy: aRectangle during: aBlock | newCanvas newR | "Set a clipping rectangle active only during the execution of aBlock." newR := transform localBoundsToGlobal: aRectangle. newCanvas := RemoteCanvas connection: connection clipRect: (outerClipRect intersect: newR) transform: transform. newCanvas privateShadowColor: shadowColor. aBlock value: newCanvas. connection shadowColor: shadowColor.! Item was changed: ----- Method: RemoteCanvas>>paragraph:bounds:color: (in category 'drawing') ----- paragraph: paragraph bounds: bounds color: c | scanner | scanner := CanvasCharacterScanner new. scanner canvas: self; text: paragraph text textStyle: paragraph textStyle; textColor: c; defaultTextColor: c. paragraph displayOn: self using: scanner at: bounds topLeft. ! Item was changed: ----- Method: RemoteCanvas>>privateShadowColor: (in category 'drawing-support') ----- privateShadowColor: x shadowColor := x. ! Item was changed: ----- Method: RemoteCanvas>>shadowColor: (in category 'accessing') ----- shadowColor: x connection shadowColor: (shadowColor := x). ! Item was changed: ----- Method: RemoteControlledHandMorph>>nebraskaClient: (in category 'initialization') ----- nebraskaClient: aNebraskaClient nebraskaClient := aNebraskaClient! Item was changed: ----- Method: StringSocket class>>clearRatesSeen (in category 'as yet unclassified') ----- clearRatesSeen " StringSocket clearRatesSeen " MaxRatesSeen := nil ! Item was changed: ----- Method: StringSocket class>>compareFiles (in category 'as yet unclassified') ----- compareFiles " StringSocket compareFiles " | data1 data2 | data1 := (FileStream fileNamed: 'Macintosh HD:bob:nebraska test:58984048.1') contentsOfEntireFile. data2 := (FileStream fileNamed: 'BobsG3:squeak:dsqueak:DSqueak2.7 folder:58795431.3') contentsOfEntireFile. 1 to: (data1 size min: data2 size) do: [ :i | (data1 at: i) = (data2 at: i) ifFalse: [self halt]. ]. ! Item was changed: ----- Method: StringSocket>>addToOutBuf: (in category 'private-IO') ----- addToOutBuf: arrayToWrite | size newAlloc | size := self spaceToEncode: arrayToWrite. newAlloc := size * 2 max: 8000. "gives us room to grow" outBuf ifNil: [ outBuf := String new: newAlloc. outBufIndex := 1. ]. outBuf size - outBufIndex + 1 < size ifTrue: [ outBuf := outBuf , (String new: newAlloc). ]. CanvasEncoder at: 1 count: arrayToWrite size + 1. outBuf putInteger32: arrayToWrite size at: outBufIndex. outBufIndex := outBufIndex + 4. arrayToWrite do: [ :each | outBuf putInteger32: each size at: outBufIndex. outBufIndex := outBufIndex + 4. outBuf replaceFrom: outBufIndex to: outBufIndex + each size - 1 with: each startingAt: 1. outBufIndex := outBufIndex + each size. ]. ^size! Item was changed: ----- Method: StringSocket>>destroy (in category 'as yet unclassified') ----- destroy socketWriterProcess ifNotNil: [socketWriterProcess terminate. socketWriterProcess := nil]. outputQueue := nil. bytesInOutputQueue := 0. socket ifNotNil: [socket destroy. socket := nil.]. ! Item was changed: ----- Method: StringSocket>>inBufNext: (in category 'private-IO') ----- inBufNext: anInteger | answer | answer := inBuf copyFrom: inBufIndex to: inBufIndex + anInteger - 1. inBufIndex := inBufIndex + anInteger. ^answer! Item was changed: ----- Method: StringSocket>>initialize: (in category 'as yet unclassified') ----- initialize: aSocket transmissionError := false. super initialize: aSocket. outputQueue := SharedQueue new. extraUnsentBytes := bytesInOutputQueue := 0. socketWriterProcess := [ [self transmitQueueNext] whileTrue. socketWriterProcess := nil. outputQueue := nil. bytesInOutputQueue := 0. ] forkAt: Processor lowIOPriority.! Item was changed: ----- Method: StringSocket>>processOutput (in category 'private-IO') ----- processOutput | arrayToWrite size bytesSent timeStartSending t itemsSent now timeSlot bucketAgeInMS bytesThisSlot | outBufIndex := 1. itemsSent := bytesSent := 0. timeStartSending := Time millisecondClockValue. [outObjects isEmpty not and: [self isConnected]] whileTrue: [ arrayToWrite := outObjects removeFirst. size := self addToOutBuf: arrayToWrite. bytesSent := bytesSent + size. itemsSent := itemsSent + 1. outBufIndex > 10000 ifTrue: [self queueOutBufContents]. ]. outBufIndex > 1 ifTrue: [self queueOutBufContents]. bytesSent > 0 ifTrue: [ MaxRatesSeen ifNil: [MaxRatesSeen := Dictionary new]. now := Time millisecondClockValue. t := now - timeStartSending. timeSlot := now // 10000. "ten second buckets" bucketAgeInMS := now \\ 10. bytesThisSlot := (MaxRatesSeen at: timeSlot ifAbsent: [0]) + bytesSent. MaxRatesSeen at: timeSlot put: bytesThisSlot. NebraskaDebug at: #SendReceiveStats add: {'put'. bytesSent. t. itemsSent. bytesThisSlot // (bucketAgeInMS max: 100)}. ]. ! Item was changed: ----- Method: StringSocket>>queueOutBufContents (in category 'private-IO') ----- queueOutBufContents bytesInOutputQueue := bytesInOutputQueue + outBufIndex - 1. outputQueue nextPut: {outBuf. outBufIndex - 1}. NebraskaDebug at: #queuedbufferSizes add: {outBufIndex - 1}. outBufIndex := 1. outBuf := String new: 11000. ! Item was changed: ----- Method: StringSocket>>sendDataCautiously:bytesToSend: (in category 'private-IO') ----- sendDataCautiously: aStringOrByteArray bytesToSend: bytesToSend "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 count | bytesSent := 0. [bytesSent < bytesToSend] whileTrue: [ extraUnsentBytes := bytesToSend - bytesSent. count := socket sendSomeData: aStringOrByteArray startIndex: bytesSent + 1 count: (bytesToSend - bytesSent min: 6000). bytesSent := bytesSent + count. (Delay forMilliseconds: 1) wait. ]. extraUnsentBytes := 0. ^ bytesSent ! Item was changed: ----- Method: StringSocket>>shrinkInBuf (in category 'private-IO') ----- shrinkInBuf inBuf ifNil: [^self]. inBufLastIndex < inBufIndex ifTrue: [ inBufLastIndex := 0. inBufIndex := 1. inBuf size > 20000 ifTrue: [inBuf := nil]. "if really big, kill it" ^self ]. inBuf := inBuf copyFrom: inBufIndex to: inBufLastIndex. inBufLastIndex := inBuf size. inBufIndex := 1. ! Item was changed: ----- Method: StringSocket>>transmitQueueNext (in category 'private-IO') ----- transmitQueueNext | bufTuple | bufTuple := outputQueue next. bytesInOutputQueue := bytesInOutputQueue - bufTuple second max: 0. [ self sendDataCautiously: bufTuple first bytesToSend: bufTuple second. ] on: Error do: [ :ex | transmissionError := true. ]. ^transmissionError not ! Item was changed: ----- Method: StringSocket>>tryForString (in category 'private-IO') ----- tryForString "try to grab an actual string" self inBufSize >= nextStringSize ifFalse: [^false]. stringsForNextArray at: (stringCounter := stringCounter + 1) put: (self inBufNext: nextStringSize) asString. stringCounter = numStringsInNextArray ifTrue: [ "we have finished another array!!" inObjects addLast: stringsForNextArray. stringCounter := stringsForNextArray := numStringsInNextArray := nextStringSize := nil. ] ifFalse: [ "still need more strings for this array" nextStringSize := nil. ]. ^true ! |
Free forum by Nabble | Edit this page |