'From Croqtober of 11 November 2005 [latest update: #126] on 10 January 2006 at 10:56:29 pm'! Smalltalk renameClassNamed: #SlaveForVDesktopTablet as: #RfbServerServerClient! Object subclass: #RfbServerServerClient instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Croquet-Atlanta'! !RfbServerServerClient commentStamp: 'strick 1/10/2006 20:31' prior: 0! RFBServerServerClient is the squeak client object that makes HTTP requests to the RFBServerServer, which allocates RFB servers for the sake of VDesktopTablet. ! TestCase subclass: #RfbServerServerClientTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Croquet-Atlanta'! !CroquetObjects class methodsFor: 'objects' stamp: 'strick 1/9/2006 19:11'! makeDesktop: urlString | z | " FileDirectory deleteFilePath: 'home.c3d.'. HedgemineMorph new openInWorld " " ^ self makeRFBViewer: urlString. TODO: later restore the VDesktopTablet intermediary.********** " z := VDesktopTablet new initialize. z modelUrl: urlString. ^ z ! ! !CroquetObjects class methodsFor: 'objects' stamp: 'strick 1/10/2006 08:05'! makeRFBViewer: relativePath | tm pageExtent teaWorld world morph client hostAddr hostPort socket | " FileDirectory deleteFilePath: 'home.c3d.'. HedgemineMorph new openInWorld " pageExtent := 640@480. tm _ TMorphic new initializeOpaque: true extent: pageExtent. teaWorld _ TMorphMonitor new initializeWithWorld: nil extent: pageExtent. teaWorld eventsTo: tm. world := teaWorld world. hostAddr := NetNameResolver addressFromString: '127.0.0.1'. hostPort := 5901. client := RFBClient new. client target: teaWorld. "????" morph := client asMorph. world addMorph: morph. socket _ RFBClientSocket newTCP. [ socket connectTo: hostAddr port: hostPort. client connectTo: socket ] on: Error do:[:ex| ex return]. client isConnected ifFalse:[ socket ifNotNil:[socket destroy]. Transcript cr; show: 'RFB Client failed to connect.'; endEntry. ^Smalltalk beep]. morph bounds: world bounds. morph visible: true. ^tm. ! ! !CroquetObjects class methodsFor: 'objects' stamp: 'strick 1/9/2006 15:57'! makeWebPage: url extent: pageExtent "Create a TMorphic containing nothing but a web page. Hack scamper not to show up - it's just *way* to ugly." | world scamper window page tm teaWorld | tm _ TMorphic new initializeOpaque: true extent: pageExtent. teaWorld _ TMorphMonitor new initializeWithWorld: nil extent: pageExtent. teaWorld eventsTo: tm. world := teaWorld world. scamper := Scamper new. window := scamper morphicWindow. world addMorph: window. page := window findA: WebPageMorph. "heh, heh" world addMorphFront: page. page bounds: world bounds. window visible: false. scamper jumpToUrl: url asUrl. ^tm ! ! !RfbServerServerClient methodsFor: 'as yet unclassified' stamp: 'strick 1/10/2006 22:32'! echo: stuff " for testing upness " | request reply | request := '/echo?what=', stuff encodeForHTTP. reply := self httpGetWithPath: request. ^ (self getAnswersFromXml: reply) first! ! !RfbServerServerClient methodsFor: 'as yet unclassified' stamp: 'strick 1/10/2006 22:18'! getAnswersFromXml: xml | errorList answerList | errorList := self getDataFromXml: xml withTag: #error. (errorList size > 0) ifTrue: [ self error: (errorList inject: 'request failed' into: [ :z :e | z, ' : ', e ]) ]. answerList := self getDataFromXml: xml withTag: #answer. (answerList size = 1) ifFalse: [ self error: 'request failed' ]. ^ answerList ! ! !RfbServerServerClient methodsFor: 'as yet unclassified' stamp: 'strick 1/10/2006 22:06'! getDataFromXml: someXml withTag: aTag | z document | z := OrderedCollection new. document := XMLDOMParser parseDocumentFrom: (ReadStream on: someXml). document tagsNamed: aTag do: [:x | z add: x characterData ]. ^ z! ! !RfbServerServerClient methodsFor: 'as yet unclassified' stamp: 'strick 1/10/2006 20:44'! httpGetWithAbsoluteUrl: anAbsoluteUrl " self new httpGetWithAbsoluteUrl: 'http://google.com/' " ^ (Url absoluteFromText: anAbsoluteUrl) retrieveContents content! ! !RfbServerServerClient methodsFor: 'as yet unclassified' stamp: 'strick 1/10/2006 21:58'! httpGetWithPath: aPath "aPath is of form /verb?query=stuff self new httpGetWithPath: '/echo?wish= " | absoluteUrl | aPath first = $/ ifFalse: [ self error: 'aPath should begin with /' ]. absoluteUrl := 'http://', self httpServerHostAddress, ':', self httpServerPortNumber asString, aPath. ^ self httpGetWithAbsoluteUrl: absoluteUrl ! ! !RfbServerServerClient methodsFor: 'as yet unclassified' stamp: 'strick 1/10/2006 21:21'! httpServerHostAddress "EDIT THIS METHOD to find the HTTP server address" ^ '127.0.0.1'! ! !RfbServerServerClient methodsFor: 'as yet unclassified' stamp: 'strick 1/10/2006 20:34'! httpServerPortNumber "EDIT THIS METHOD to find the HTTP server port. The suggested default is 5899, one less than 5900, where the RFB servers ports normally begin" ^ 5899! ! !RfbServerServerClient methodsFor: 'as yet unclassified' stamp: 'strick 1/10/2006 22:27'! launchServerForDocumentUrl: aDocumentUrl objectId: anId | request reply | request := '/launch?id=', anId encodeForHTTP, '&url=', aDocumentUrl encodeForHTTP. reply := self httpGetWithPath: request. ^ (self getAnswersFromXml: reply) first! ! !RfbServerServerClient methodsFor: 'as yet unclassified' stamp: 'strick 1/10/2006 22:22'! listServers | request reply | request := '/list'. reply := self httpGetWithPath: request. ^ self getAnswersFromXml: reply! ! !RfbServerServerClient methodsFor: 'as yet unclassified' stamp: 'strick 1/10/2006 22:27'! shutdownAllServers | request reply | request := '/shutdown'. reply := self httpGetWithPath: request. self getAnswersFromXml: reply! ! !RfbServerServerClientTest methodsFor: 'as yet unclassified' stamp: 'strick 1/10/2006 22:36'! testEcho " self new testEcho " | answer x | "The /echo verb should echo back the query stuff in some manner." x := 'pb&j=peanutButter+Jelly'. answer := RfbServerServerClient new echo: x. self assert: ( x = answer ). ^ #ok! ! !VObject methodsFor: 'actions' stamp: 'strick 1/10/2006 15:22'! addChess self positionNewObject: CroquetObjects makeChess.! ! !VObject methodsFor: 'actions' stamp: 'hrs 12/21/2005 09:11'! addText self positionNewObject: VText new.! ! !VComponent methodsFor: 'events' stamp: 'strick 1/10/2006 15:18'! handleCharacter: c | d p | c = $c "cube" ifTrue: [^ self addCube]. c = $d "dragger" ifTrue: [ "I'm not sure we need persistent draggers. Modal, non-replicated EditBoxes in the View may be sufficent." p _ self parent. p removeChild: self. (self isKindOf: VDragger) ifTrue: [ d _ self contents. d localTransform: self localTransform. d objectOwner: d. p addChild: d. ] ifFalse: [ d _ VDragger new. p addChild: d. d contents: self. ]. ^self. ]. c = $i "import" ifTrue: [^ self addImport.]. c = $f "import" ifTrue: [^ self addImportFromFile.]. c = $l "light" ifTrue: [self error: '', c, ' not implemented yet.']. c = $m "microphone" ifTrue: [self error: '', c, ' not implemented yet.']. c = $M ifTrue: [^ self addMirror]. c = $r "room" ifTrue: [^ self addRoom]. c = $t "text" ifTrue: [^ self addText]. c = $w "world" ifTrue: [^self addWorld.]. c = $v "video" ifTrue: [^ self addWebcam.]. c = $x "chess" ifTrue: [ ^ self addChess ] ! ! !VDesktopTablet methodsFor: 'accessing' stamp: 'strick 1/9/2006 18:19'! modelUrl: aUrlNameString "This should, in general, bring up the appropriate application through VNC. However, I think we broke VNC somewhere along the way. Maybe with the materials changes? But we can still handle web pages (sort of) using Squeak's Scamper browser and Flash using Squeak's flash player." | on morphic | url _ aUrlNameString asUrl. self flag: #FIXME. "TWindow gets confused when we try to set contents: in the wrong state. It would be better to fix this properly rather than use this kludge." on _ self primitiveGeometry contentsOn. on ifTrue: [self primitiveGeometry primitiveCloseContents]. true ifTrue: [ "************ RFB" morphic := CroquetObjects makeRFBViewer: aUrlNameString. ] ifFalse: [ "*************** Flash & Scamper " (url path last asUppercase endsWith: '.SWF') ifTrue: [morphic _ CroquetObjects makeFlashMorphicFromStream: url retrieveContents contentStream extent: 720@480.] ifFalse: [morphic _ CroquetObjects makeWebPage: url extent: 720@480]. ]. "morphic inspect." self primitiveGeometry contents: morphic. on ifTrue: [self primitiveGeometry primitiveOpenContents]. ! ! !VDesktopTablet methodsFor: 'accessing' stamp: 'strick 1/10/2006 08:00'! url: aUrl url _ aUrl. model ifNil: [self modelUrl: aUrl] ifNotNil: [ self error: 'TODO:strick thinks model is never set for this object....'. model future url: aUrl asString ].! ! RfbServerServerClient removeSelector: #httpGetAbsoluteUrl:! RfbServerServerClient removeSelector: #httpGetPath:! RfbServerServerClient removeSelector: #httpServerHost! RfbServerServerClient removeSelector: #httpServerPort! RfbServerServerClient removeSelector: #launchServerForDocumentUrl:! RfbServerServerClient removeSelector: #parseXmlAndReturnAnswers:! RfbServerServerClient removeSelector: #serverHost!