EventManager
subclass: #GEDemo
instanceVariableNames: ' ge div id '
,' windowWidth windowHeight '
,' initCallback failureCallback '
,' options selector '
,' heading tilt range '
classVariableNames: ' Current ' poolDictionaries: ''
category: 'EarthDemo'!
Object
subclass: #GoogleEarths
instanceVariableNames: ' '
category: 'EarthDemo'!
! GoogleEarths class methodsFor: 'demo' !
open
" Run the demostration set. "
GEDemo run! !
#( default jsBalloon eventGlobe
groundAltitude groundOverlay
dancers fetchBadKML fetchGoodKML parseKml
screenOverlay frameOverlay streaming
sun sky
) do: [:selector|
GEDemo class
implement: selector
comment: 'Open a demo instance of the receiver doing selector.'
as: '^self openDemo: #' ,selector
category: #demo
]!
! GEDemo class methodsFor: 'demostration' !
run
" Run the demostration set. "
self openGUI; next! !
! GEDemo class methodsFor: 'GUI' !
openGUI
" Open the GUI for demostration. "
self initializeGUI: [:div| self addGUIButtonsTo: div ]
in: DOM document! !
! GEDemo class methodsFor: 'GUI' !
initializeGUI: action in: document
" Private - Initialize the GUI elements for demostration. "
| play u8 |
play := document @ #playground.
u8 := self tools.
(play notNil and: [ u8 notNil ]) ifTrue: [
document body
removeChild: play handle;
insert: play handle before: u8 handle
] ifFalse: [
play isNil ifTrue: [
play := document createElement: #div.
play id: #playground.
play style width: '100%'.
document body
insert: play handle
before: (document body childNodeAt: 1) handle.
].
].
action evaluateWith: play.
self hideTools.! !
! GEDemo class methodsFor: 'GUI' !
addGUIButtonsTo: toolbar
" Add the action buttons to toolbar. "
| last linkFor |
linkFor := [:tuple|
last := tuple first.
'' ,(tuple last = #default
ifTrue: [#open]
ifFalse: [tuple last])
,' '
].
toolbar innerHTML: (
#( 'Actions' ) ,self actions
,#( 'Demos' ) ,self demos
inject: ''
into: [:total :each|
total , (each isString ifTrue: [ last := each. '
' ,each ,' ' ] ifFalse: [
(last = each first ifTrue: [' '] ifFalse: [ ' ' ,each first asString ,': ' ])
, (linkFor value: each)
])
])! !
! GEDemo class methodsFor: 'GUI' !
actions
" Private - Return all the tool actions in the receiver. "
^#( next previous showTools hideTools ) collect: [:each| Array with: self with: each ]! !
! GEDemo class methodsFor: 'GUI' !
showTools
" Private - Show the u8 tool (if present). "
| u8 |
u8 := self tools.
(u8 notNil and: [ u8 style notNil ]) ifTrue: [
u8 style display: #block
]! !
! GEDemo class methodsFor: 'GUI' !
hideTools
" Private - Hide the u8 tool (if present). "
| u8 |
u8 := self tools.
(u8 notNil and: [ u8 style notNil ]) ifTrue: [
u8 style display: #none
]! !
! GEDemo class methodsFor: 'private' !
tools
" Private - Return the tools div (or nil). "
^DOM document @ #u8! !
! GEDemo class methodsFor: 'demostration' !
next
" Open the next demo. "
| tuple |
tuple := self nextDemoIn: self demos stream.
^tuple first perform: tuple last! !
! GEDemo class methodsFor: 'demostration' !
previous
" Open the previous demo. "
| tuple |
tuple := self nextDemoIn: self demos reversed stream.
^tuple first perform: tuple last! !
! GEDemo class methodsFor: 'demostration' !
demos
" Private - Return all the available demos in the receiver. "
| local |
^self withAllSubclasses
inject: #()
into: [:total :cls|
local := cls class selectors sorted select: [:each| (cls class >> each) category = #demo ].
(local includes: #default) ifFalse: [ local := #( default ) ,local ].
total ,(local collect: [:msg| Array with: cls with: msg ])
]! !
! GEDemo class methodsFor: 'demostration' !
nextDemoIn: stream
" Private - Return the next demo to run from demos in stream. "
| cls selector |
stream atEnd ifTrue: [ ^Array with: self with: #default ].
self current isNil ifTrue: [ ^stream peek ].
cls := self current class.
selector := self current selector.
[ stream peek first = cls ] whileFalse: [ stream next ].
[ stream peek last = selector ] whileFalse: [ stream next ].
stream next.
stream atEnd ifTrue: [ stream position: 0 ].
^stream next! !
! GEDemo class methodsFor: 'demostration' !
open
" Open the demo. "
^self openDemo: #default! !
! GEDemo class methodsFor: 'demostration' !
openDemo: selector
" Open the demo specified by selector.
Note: the current instance will be closed if it is still opened.
"
self current notNil ifTrue: [ self current close ].
self new openDemo: selector! !
! GEDemo class methodsFor: 'events' !
constructEventsTriggered
" Return the events that the instance of the receiver can trigger. "
^#( aboutToOpen opened
needsDocument needsContainer needsId
needsOptions needsWindowExtent
aboutToClose closed
#initialize:
)! !
! GEDemo class methodsFor: 'demostration' !
host
" Private - Return the URL of the hosting folder. "
^'http://u8.smalltalking.net/profile/aleReimondo/Google/'! !
! GEDemo class methodsFor: 'accessing' !
current
^Current! !
! GEDemo class methodsFor: 'accessing' !
current: anInstance
Current := anInstance! !
! GEDemo class methodsFor: 'accessing' !
databases
" Private - Return the valid database (sphere) names. "
^#( earth mars moon )! !
GEDemo databases do: [:sphere|
GEDemo class
implement: sphere
comment: 'Open a demo instance of the receiver on this database.'
as: '^self openDemo: #' ,sphere
category: "(sphere = #earth ifTrue: [ #sample ] ifFalse: [ #demo ])"#spheres.
GEDemo
implement: sphere
comment: 'Set the receiver to use this sphere database.'
as: '^self sphere: ' ,sphere printString
category: #demo.
]!
(GEDemo class >> #mars) category: #demo!
! GEDemo methodsFor: 'gui' !
default
" Set the receiver to this mode. "
^self! !
! GEDemo methodsFor: 'gui' !
close
" Close the receiver. "
self isOpen ifFalse: [ ^self ].
self triggerEvent: #aboutToClose.
self releaseResources.
self triggerEvent: #closed.! !
! GEDemo methodsFor: 'demostration' !
openDemo: aSelector
" Open the receiver in the HTML document. "
selector := aSelector.
self print: 'Running ' ,self class name ,' class>>#' ,selector.
(self respondsTo: selector) ifTrue: [ self perform: selector ].
self open.
self class current: self.! !
! GEDemo methodsFor: 'gui' !
open
" Open the receiver in the HTML document. "
GoogleEarth onLoad: [:earth|
self triggerEvent: #aboutToOpen.
self basicOpen: earth.
]! !
! GEDemo methodsFor: 'private' !
basicOpen: earth
" Private - Open the receiver in the HTML document in the context of earth application. "
earth
createInstance: self id
init: self initCallback
failure: self failureCallback
options: self options json! !
! GEDemo methodsFor: 'gui-embedding' !
container
" Private - Return the container of the receiver. "
^self triggerEvent: #needsContainer ifNotHandled: [
self defaultContainer
]! !
! GEDemo methodsFor: 'gui-embedding' !
document
" Private - Return the documentof the receiver. "
^self triggerEvent: #needsDocument ifNotHandled: [
DOM document
]! !
! GEDemo methodsFor: 'gui-embedding' !
defaultContainer
" Private - Return a default container of the receiver. "
| aDocument anId first |
aDocument := self document.
anId := self triggerEvent: #needsId ifNotHandled: [ #map3d ].
div := aDocument @ anId.
div isNil ifTrue: [
div := aDocument createElement: #div.
div id: anId.
div style width: self windowWidth; height: self windowHeight.
first := aDocument body childNodeAt: 1.
aDocument body
insert: div handle
before: first handle.
].
^div! !
! GEDemo methodsFor: 'initialize' !
initialize: plugin
" Private - Initialize the receiver's interface. "
heading := 133.
tilt := 54.
range := 504.
ge := plugin.
self
triggerEvent: #initialize:
withArguments: (Array with: ge)
ifNotHandled: [ self initializePlugin: plugin ].! !
! GEDemo methodsFor: 'initialize' !
initializePlugin: plugin
" Private - Initialize the GEPlugin interface. "
plugin window visibility: true.
self initializeNavigationControl: plugin.! !
! GEDemo methodsFor: 'initialize' !
initializeNavigationControl: plugin
" Private - Initialize navigation control. "
plugin navigationControl visibility: plugin visibilityAuto! !
! GEDemo methodsFor: 'query' !
isOpen
" Return true if the receiver is open. "
^ge notNil! !
! GEDemo methodsFor: 'accessing' !
selector
" Private - Return the demo selector. "
^selector! !
! GEDemo methodsFor: 'accessing' !
ge
" Private - Return the GEPlugin in use. "
ge isNil ifTrue: [ self open ].
^ge! !
! GEDemo methodsFor: 'accessing' !
id
" Return the id to use to embedd GEPlugin. "
id isNil ifTrue: [ id := self container id ].
^id! !
! GEDemo methodsFor: 'release' !
releaseResources
" Private - Release the resources allocated by the receiver. "
div notNil ifTrue: [
div innerHTML: ''.
div parentNode removeChild: div handle.
div := nil.
].
ge release. ge := nil.! !
! GEDemo methodsFor: 'defaults' !
defaultWindowWidth
^'100%'! !
! GEDemo methodsFor: 'defaults' !
defaultWindowHeight
^'500px'! !
! GEDemo methodsFor: 'accessing' !
windowWidth
" Return the width of GEPlugin window. "
windowWidth notNil ifTrue: [ ^windowWidth ].
self triggerEvent: #needsWindowExtent.
windowWidth notNil ifTrue: [ ^windowWidth ].
^windowWidth := self defaultWindowWidth! !
! GEDemo methodsFor: 'accessing' !
windowHeight
" Return the height of GEPlugin window. "
windowHeight notNil ifTrue: [ ^windowHeight ].
self triggerEvent: #needsWindowExtent.
windowHeight notNil ifTrue: [ ^windowHeight ].
^windowHeight := self defaultWindowHeight! !
! GEDemo methodsFor: 'accessing' !
id: anId
" Set the id to use to embedd GEPlugin. "
id := anId! !
! GEDemo methodsFor: 'accessing' !
options: optionsSet
" Set the options of the receiver. "
options := optionsSet! !
! GEDemo methodsFor: 'accessing' !
options
" Return the options of the receiver. "
options isNil ifTrue: [
self triggerEvent: #needsOptions
].
^options! !
! GEDemo methodsFor: 'accessing' !
optionAt: key put: aValue
" Set the option of the receiver. "
self options isNil ifTrue: [ ^self options: key -> aValue ].
(self options isAssociation
ifTrue: [ Array with: self options ]
ifFalse: [ self options ]
) do: [:each|
each key = key ifTrue: [ ^each value: aValue ].
].
self options: self options , (key -> aValue) ! !
! GEDemo methodsFor: 'accessing' !
initCallback
" Return the initCallback. "
initCallback isNil ifTrue: [ initCallback := [:plugin| self initialize: GEPlugin @ plugin; opened ] ].
^initCallback! !
! GEDemo methodsFor: 'accessing' !
initCallback: aOneArgumentBlock
" Set the initCallback. "
initCallback := aOneArgumentBlock! !
! GEDemo methodsFor: 'accessing' !
failureCallback
" Return the failureCallback. "
failureCallback isNil ifTrue: [ failureCallback := [:object| ] ].
^failureCallback! !
! GEDemo methodsFor: 'accessing' !
failureCallback: aOneArgumentBlock
" Set the failureCallback. "
failureCallback := aOneArgumentBlock! !
! GEDemo methodsFor: 'private' !
opened
" Private - The receiver has just open. "
self triggerEvent: #opened! !
! GEDemo methodsFor: 'location' !
latitude: x longitude: y altitude: altitude
" Position the view at point coordinates on the ground. "
^self
latitude: x longitude: y
altitude: altitude
mode: ge altitudeAbsolute! !
! GEDemo methodsFor: 'location' !
latitude: x longitude: y
" Position the view at point coordinates on the ground. "
^self latitude: x longitude: y altitude: 0! !
! GEDemo methodsFor: 'location' !
latitude: x longitude: y
heading: aHeading tilt: aTilt range: aRange
" Position the view at point coordinates on the ground. "
^self
latitude: x longitude: y
altitude: 0 mode: ge altitudeAbsolute
heading: aHeading tilt: aTilt range: aRange! !
! GEDemo methodsFor: 'location' !
latitude: x longitude: y
altitude: altitude mode: altitudeMode
heading: aHeading tilt: aTilt range: aRange
" Position the view at point coordinates on the ground. "
| look |
look := self ge createLookAt.
look
latitude: x + 0 longitude: y + 0
altitude: altitude altitudeMode: altitudeMode
heading: aHeading tilt: aTilt range: aRange.
ge view abstractView: look.! !
! GEDemo methodsFor: 'location' !
latitude: x longitude: y altitude: altitude mode: altitudeMode
" Position the view at point coordinates on the ground. "
^self
latitude: x longitude: y
altitude: altitude mode: altitudeMode
heading: heading tilt: tilt range: range! !
! GEDemo methodsFor: 'location' !
coordinates
" Return the point at current location. "
| lookAt |
lookAt := self ge view copyAsLookAt: self ge altitudeRelativeToGround.
^Array
with: lookAt latitude
with: lookAt longitude
with: lookAt altitude! !
! GEDemo methodsFor: 'location' !
location
" Return the point at current location. "
| lookAt |
lookAt := self ge view copyAsLookAt: self ge altitudeRelativeToGround.
^lookAt latitude @ lookAt longitude! !
! GEDemo methodsFor: 'places' !
homeLocation
" Private - Return the home location. "
^-34.60419479365684 @ -58.38094756414077! !
! GEDemo methodsFor: 'motion' !
goHome
" Place the GE view at home address. "
self goto: self homeLocation! !
! GEDemo methodsFor: 'motion' !
goto: position
" Place GE view at aPoint on ground in current sphere. "
| latitude longitude altitude |
position isNil ifTrue: [ ^self goHome ].
position isArray ifTrue: [
latitude := position first.
longitude := position second.
altitude := position size > 2
ifTrue: [ position third ]
ifFalse: [ 0 ].
] ifFalse: [ "point assumed"
latitude := position x.
longitude := position y.
altitude := 0.
].
^self
latitude: latitude
longitude: longitude
altitude: altitude! !
! GEDemo methodsFor: 'motion' !
moveBy: aPoint
" Place GE view at relative point on ground in current sphere. "
self goto: self location + aPoint! !
! GEDemo methodsFor: 'placemarks' !
addPlacemark: iconName at: location
" Add a new placemark feature at location (aPoint). "
| result |
result := self ge
makePlacemarkAt: location x + 0 longitude: location y + 0
altitude: 0 altitudeMode: ge altitudeClampToGround
iconName: iconName.
ge addFeature: result.
^result! !
! GEDemo methodsFor: 'accessing' !
lookAt
" Return the view's lookAt position relative to ground. "
^self ge view copyAsLookAt: ge altitudeRelativeToGround! !
! GEDemo methodsFor: 'accessing' !
databaseURL: anURL
" Set the option of the receiver to use database at anURL. "
self optionAt: #database put: anURL! !
! GEDemo methodsFor: 'accessing' !
database: databaseName
" Set the option database (sphere) of the receiver. "
self databaseURL: 'http://khmdb.google.com/?db=' ,databaseName! !
! GEDemo methodsFor: 'notification' !
show: text feature: feature maxWidth: maxWidth
" Show the text to the user, as a balloon bound to feature. "
| balloon |
text isNil ifTrue: [ ^self closeBalloon ].
balloon := self ge createHtmlStringBalloon.
feature notNil ifTrue: [ balloon feature: feature ].
maxWidth notNil ifTrue: [ balloon maxWidth: maxWidth ].
balloon contents: (self demoContents: text).
ge balloon: balloon! !
! GEDemo methodsFor: 'private' !
logoImage
" Private - Return the HTML text to be shown to the user. "
^' '! !
! GEDemo methodsFor: 'private' !
smallLogoImage
" Private - Return the HTML text to be shown to the user. "
^' '! !
! GEDemo methodsFor: 'private' !
demoContents: text
" Private - Return the HTML text to be shown to the user. "
text first = $- ifTrue: [ ^text ].
^self logoImage ,' ' ,text! !
! GEDemo methodsFor: 'notification' !
show: text feature: feature
" Show the text to the user, as a balloon bound to feature. "
^self show: text feature: feature maxWidth: 500! !
! GEDemo methodsFor: 'notification' !
show: text
" Show the text to the user, as a balloon bound to feature. "
^self show: text feature: nil! !
! GEDemo methodsFor: 'notification' !
closeBalloon
" Close the balloon (if currently shown). "
self ge balloon: nil json! !
! GEDemo methodsFor: 'layers' !
enableLayers: layerNames in: plugin
" Enable the layers in plugin. "
layerNames do: [:each|
plugin layerRoot
enableLayerById: (plugin perform: #layer ,each)
]! !
! GEDemo methodsFor: 'layers' !
enableLayers: layerNames
" Enable the layers. "
^self enableLayers: layerNames in: self ge! !
! GEDemo methodsFor: 'layers' !
enableBuildings
" Enable the buildings layers. "
^self enableLayers: #( #Terrain #Buildings #Borders #Roads )! !
! GEDemo methodsFor: 'layers' !
toggleBuildings
" Toggle the buildings layer. "
| buildings |
buildings := self ge layerRoot getLayerById: self ge layerBuildings.
(buildings isNil or: [ buildings visibility not ])
ifTrue: [ ^self enableBuildings ].
buildings visibility: buildings visibility not.! !
! GEDemo methodsFor: #demo !
sphere: aSphereName
" Set the receiver with selected sphere database. "
(self class databases includes: aSphereName) ifFalse: [
^self error: 'Invalid database name: ',aSphereName
].
self database: aSphereName.! !
! GEDemo methodsFor: #demo !
jsBalloon
" Open a balloon with an anchor to javascript code. "
self when: #opened do: [
self show: '-- Click on globe to show baloon --'.
self goHome.
self ge globe when: #click: do: [:event|
self show: 'Press this link '
,' to toggle buildings and return to home/obelisk (via callback to S8).'
,'Note: The executed action is a Smalltalk expression with source coded in the link.'
,' Browse ' ,self class name,'>>#jsBaloon to see implementation details'
]
]! !
! GEDemo methodsFor: #demo !
jsBalloonClicked
" Open a balloon with an anchor to javascript code. "
self toggleBuildings; goHome! !
! GEDemo methodsFor: #demo !
eventGlobe
" Open a balloon with information about click events on globe and window. "
| report stream result event |
report := [:evt|
event := KmlMouseEvent @ evt.
event preventDefault.
stream := ' ' stream.
#( "#(target type) #(currentTarget type)"
button clientX clientY screenX screenY
latitude longitude altitude didHitGlobe
altKey shiftKey "timeStamp"
) do: [:what|
result := what isArray ifTrue: [
what inject: event into: [:current :each|
current perform: each
]
] ifFalse: [ event perform: what ].
stream nextPutAll: ' ' ,what ,'=' ,result
].
"[ #alert: stream contents ] valueDeferred."
self print: stream contents.
].
self when: #opened do: [
self ge globe when: #click: do: report.
self ge window when: #click: do: report.
]! !
! GEDemo methodsFor: #demo !
worldPlaces
" Return a collection of relevant places in Earth. "
^#(
#( -37.47370 -71.41346 20000 )
#( 36.20839 -112.45803 8500 )
#( 0.37520 -16.72441 7000 )
#( 28.61267 83.87135 7000 )
#( 31.47474 35.50399 1500 )
#( -28.87033 137.61853 15000 )
#( -89.83505 -162.80556 )
#( -34.47355 -57.85085 50)
) copy! !
! GEDemo methodsFor: #demo !
groundAltitude
" Report ground altitude at cursor location. "
| report event altitude places aPlace gotoNext |
places := self worldPlaces.
report := [:evt|
event := KmlMouseEvent @ evt.
"event preventDefault."
"self show: "
(DOM document getElementById: #result) value: (
(event didHitGlobe and: [
altitude := self ge globe
groundAltitude: event latitude
lon: event longitude.
altitude notNil
])
ifTrue: [ 'Altitude at lat: ',(event latitude #toFixed: 5)
,' long: ',(event longitude #toFixed: 5)
,' is: ',(altitude #toFixed: 2) ,' meters' ]
ifFalse: [ 'Move the cursor over globe. Click to goto next place.' ]).
].
gotoNext := [:evt|
evt notNil ifTrue: [ evt preventDefault ].
places isEmpty ifTrue: [ places := self worldPlaces ].
aPlace := places removeFirst.
self
latitude: aPlace first
longitude: aPlace second
heading: 0 tilt: 0
range: aPlace last
].
self when: #opened do: [
self enableLayers: #( #Terrain #Borders #Roads ).
self ge window when: #mousemove: do: report.
self ge globe when: #click: do: gotoNext.
gotoNext value: nil.
]! !
! GEDemo methodsFor: 'overlay' !
overlayResources
" Private - Return the collection of overlay resources. "
^#( #( 'http://www.alereimondo.com/images/header.jpg' 9 30 )
#( 'http://u8.smalltalking.net/imgs/u8logo3.png' 8 8 )
#( 'http://www.smalltalking.net/images/frontLogo.png' 12 11 )
#( 'http://www.google.com/intl/en_ALL/images/logo.gif' 15 27 )
)! !
! GEDemo methodsFor: #demo !
groundOverlay
" Spin the world and place overlays on ground. "
| stamp images delta scale count |
images := self overlayResources.
count := 0.
scale := 9000.
delta := 0.003 @ 0.
stamp := [ | current overlay center |
center := self coordinates.
center := Array
with: center first - delta x
with: center second + delta y.
self
latitude: center first
longitude: center second
heading: 0 tilt: 0 range: 8600.
current := images addLast: images removeFirst.
overlay := self ge createGroundOverlay.
overlay icon: (self ge createIcon href: current first; yourself).
overlay latLonBox: (self ge createLatLonBox
box: center first - (current second / scale)
south: center first + (current second / scale)
east: center second + (current third / scale)
west: center second - (current third / scale)
rotation: 0;
yourself).
self ge addFeature: overlay.
count := count + 1.
count < 7
ifTrue: [ stamp valueDeferred: 1000 ]
ifFalse: [
self
latitude: center first + (delta x * 4)
longitude: center second
heading: 0 tilt: 10 range: 7500.
]
].
self when: #opened do: [
self enableLayers: #( #Terrain #Borders #Roads ).
self latitude: -23 longitude: -65
heading: 0 tilt: 0 range: 8600.
stamp valueDeferred: 3000.
]! !
! GEDemo methodsFor: #demo !
fetchBadKML
" Try to fetch an invalid KML file and report the problem. "
| completionCallback url |
url := self class host ,'invalidModel.kml'.
completionCallback := [:object|
object isNil ifTrue: [
[ # #alert: 'Bad or missing KML file at ' ,url ] valueDeferred: 0
]
].
self when: #opened do: [
self enableLayers: #( #Terrain #Borders #Roads ).
GoogleEarth new
fetchKml: self ge url: url
onLoad: completionCallback.
]! !
! GEDemo methodsFor: #demo !
withModel: url do: aBlock ifFailed: failureBlock
" Fetch the model at url and evaluate aBlock. "
| completionCallback |
completionCallback := [:object|
[ object isNil
ifTrue: [ failureBlock valueDeferred: 0 ]
ifFalse: [ aBlock value: KmlObject @ object ]
] on: Error do: [:ex| self print: ex; print: ex stack ]
].
GoogleEarth new
fetchKml: self ge url: url
onLoad: completionCallback.! !
! GEDemo methodsFor: #demo !
dancers
" Fetch the tango model ,add to GE and set view to see dancers. "
self when: #opened do: [
self enableBuildings.
self withModel: self class host ,'tango.kmz'
do: [:object|
self ge addFeature: object.
self
latitude: -34.57144
longitude: -58.41674
heading: 27 tilt: 35 range: 17.
] ifFailed: [
# #alert: 'Bad or missing KML file'
]
]! !
! GEDemo methodsFor: #demo !
fetchGoodKML
" Fetch the model ,add to GE and set view. "
self when: #opened do: [
self withModel: 'http://sketchup.google.com/3dwarehouse/download?mid=28b27372e2016cca82bddec656c63017&rtyp=k2'
do: [:object|
self ge addFeature: object.
self
latitude: 37.77955
longitude: -122.4173
heading: 90 tilt: 70 range: 300.
] ifFailed: [
# #alert: 'Bad or missing KML file'
]
]! !
! GEDemo methodsFor: #demo !
parseKml
" Parse a KML string literal (to build a KmoObject) and place the resulting model on moon. "
| kml object |
kml := '' ,
'' ,
' ' ,
' aPentagon ' ,
' ' ,
' 1 ' ,
' relativeToGround ' ,
' ' ,
' ' ,
' ' ,
' -77.05788457660967,38.87253259892824,100 ' ,
' -77.05465973756702,38.87291016281703,100 ' ,
' -77.05315536854791,38.87053267794386,100 ' ,
' -77.05552622493516,38.868757801256,100 ' ,
' -77.05844056290393,38.86996206506943,100 ' ,
' -77.05788457660967,38.87253259892824,100' ,
' ' ,
' ' ,
' ' ,
' ' ,
' ' ,
' ' ,
' -77.05668055019126,38.87154239798456,100 ' ,
' -77.05542625960818,38.87167890344077,100 ' ,
' -77.05485125901024,38.87076535397792,100 ' ,
' -77.05577677433152,38.87008686581446,100 ' ,
' -77.05691162017543,38.87054446963351,100 ' ,
' -77.05668055019126,38.87154239798456,100' ,
' ' ,
' ' ,
' ' ,
' ' ,
' ' ,
' '.
"self database: #moon."
self when: #opened do: [
object := self ge parseKml: kml.
self ge addFeature: object.
self
latitude: 38.871
longitude: -77.0556
heading: 0 tilt: 45 range: 884.
]! !
! GEDemo methodsFor: #demo !
screenOverlay
" Stamp overlays on screen. "
| overlay xy scale random |
scale := 10. random := Random new.
self when: #opened do: [
self enableLayers: #( #Terrain #Borders #Roads ).
self goHome.
self overlayResources reverseDo: [:each|
overlay := self ge createScreenOverlay.
overlay icon: (self ge createIcon
href: each first; yourself).
xy := overlay overlayXY.
xy xUnits: self ge unitsFraction; x: 0.5.
xy yUnits: self ge unitsFraction; y: 0.5.
xy := overlay screenXY.
xy xUnits: self ge unitsFraction; x: random next.
xy yUnits: self ge unitsFraction; y: random next.
xy := overlay rotationXY.
xy xUnits: self ge unitsFraction; x: 0.5.
xy yUnits: self ge unitsFraction; y: 0.5.
xy := overlay size.
xy xUnits: self ge unitsPixels; x: each third * scale.
xy yUnits: self ge unitsPixels; y: each second * scale.
overlay rotation: random next * 360.
self ge addFeature: overlay.
].
]! !
! GEDemo methodsFor: #demo !
frameOverlay
" Stamp a frame overlay on screen. "
| overlay xy |
windowWidth := self windowHeight.
self when: #opened do: [
overlay := self ge createScreenOverlay.
overlay icon: (self ge createIcon
href: 'http://earth-api-samples.googlecode.com/svn/trunk/examples/static/frame.png';
yourself).
xy := overlay screenXY.
xy xUnits: self ge unitsPixels; x: 0.
xy yUnits: self ge unitsPixels; y: 0.
xy := overlay overlayXY.
xy xUnits: self ge unitsPixels; x: 0.
xy yUnits: self ge unitsPixels; y: 0.
xy := overlay size.
xy xUnits: self ge unitsFraction; x: 1.
xy yUnits: self ge unitsFraction; y: 1.
self ge addFeature: overlay.
self enableLayers: #( #Terrain #Borders #Roads ).
self
latitude: -30 longitude: -65
heading: 180 tilt: 0
range: 10667264
]! !
! GEDemo methodsFor: #demo !
sky
" Go to sky mode and travel to andromeda galaxy. "
| backup lookAt |
self when: #opened do: [
backup := self ge options flyToSpeed.
self ge options
mapType: self ge mapTypeSky;
flyToSpeed: 0.2.
[ lookAt := self ge view copyAsLookAt: self ge altitudeRelativeToGround.
lookAt set: 41.28509187215
longitude: -169.2448684551622
altitude: 0 altitudeMode: self ge altitudeRelativeToGround
heading: 262.87 tilt: 0
range: 162401.
"lookAt set: -59.65189337195337
longitude: -18.799770300376053
altitude: 0 altitudeMode: self ge altitudeRelativeToGround
heading: 0 tilt: 0
range: 36817."
self ge view abstractView: lookAt.
self ge options flyToSpeed: backup.
] valueDeferred: 1000.
]! !
! GEDemo methodsFor: #demo !
streaming
" Report data streaming percent. "
| result report |
result := DOM document getElementById: #result.
report := [
result value: self ge streamingPercent asString ,'% data received.'.
self ge streamingPercent = 100 ifFalse: [ report valueDeferred: 100 ].
].
self when: #opened do: [
self enableBuildings.
self latitude: 50.09
longitude: 14.405
heading: 110
tilt: 50
range: 700.
report valueDeferred: 100.
]! !
! GEDemo methodsFor: #demo !
sun
" Toggle sun (dusk/dawn) visibility. "
| enabled toggle |
enabled := false.
toggle := [:evt|
enabled := enabled not.
self ge sun visibility: enabled.
].
self when: #opened do: [
self ge globe when: #click: do: toggle.
self show: '-- Click on globe to toggle dusk/dawn --'.
]! !
GEDemo
subclass: #HitTestDemo
instanceVariableNames: ' globe placemarks '
category: 'EarthDemo'!
! HitTestDemo methodsFor: 'accessing' !
globe
^globe! !
! HitTestDemo methodsFor: 'accessing' !
placemarks
^placemarks! !
! HitTestDemo methodsFor: 'initialize' !
initializePlugin: plugin
" Private - Initialize the GEPlugin interface. "
super initializePlugin: plugin.
self enableBuildings; goHome.
globe := ge globe.
placemarks := Array new.
globe when: #click: do: [:event| self click: KmlMouseEvent @ event ] ! !
! HitTestDemo methodsFor: 'event' !
click: event
" Private - Process the click event. "
| test |
event button ~= 0 ifTrue: [ ^self ].
ge removeFeatures: placemarks.
placemarks := #().
#( #Globe #Terrain #Buildings ) do: [:mode|
test := ge view
hitTest: event clientX xUnits: ge unitsPixels
y: event clientY yUnits: ge unitsPixels
mode: (ge perform: #hitTest ,mode).
test notNil ifTrue: [
placemarks add: (
ge makePlacemarkAt: test latitude
longitude: test longitude
altitude: test altitude
altitudeMode: ge altitudeAbsolute
iconName: mode first
)
].
].
placemarks notEmpty ifTrue: [
self
show: 'Hit test on globe, terrain and buildings'
feature: placemarks first
].
ge addFeatures: placemarks.! !
! HitTestDemo methodsFor: 'release' !
releaseResources
" Private - Release the resources allocated by the receiver. "
globe release.
globe := nil.
^super releaseResources! !
GEDemo
subclass: #GEMarkDemo
instanceVariableNames: ' place placemark '
category: 'EarthDemo'!
! GEMarkDemo methodsFor: 'accessing' !
place
" Return the place location used for this demo. "
place isNil ifTrue: [
place := -34.6042 @ -58.38095
].
^place! !
! GEMarkDemo methodsFor: 'accessing' !
place: aPoint
" Set the place location used for this demo. "
place := aPoint! !
! GEMarkDemo methodsFor: 'accessing' !
placemark
" Return the placemark used for this demo. "
^placemark! !
! GEMarkDemo methodsFor: 'accessing' !
placemark: aPlacemark
" Set the placemark used for this demo. "
placemark := aPlacemark! !
! GEMarkDemo methodsFor: 'initialize' !
initializePlugin: plugin
" Private - Initialize the GEPlugin interface. "
super initializePlugin: plugin.
placemark := self addPlacemark: self iconName at: self place.
self placemarkName notNil ifTrue: [ placemark name: self placemarkName ].
self initializePlacemark.
self goto: self place.! !
! GEMarkDemo methodsFor: 'initialize' !
initializePlacemark
" Private - Initialize the GEPlugin interface. "
placemark when: #click: do: [:event| self placemarkClicked: event ].! !
! GEMarkDemo methodsFor: 'accessing' !
placemarkName
" Return the placemarkName of the receiver (or nil to leave blank). "
^'Click here!!'! !
! GEMarkDemo methodsFor: 'click' !
placemarkClicked: event
" The placemark link has been clicked. "
event preventDefault.
self placemarkClicked! !
! GEMarkDemo methodsFor: 'click' !
placemarkClicked
" The placemark link has been clicked. "
self show: '
Placemark clicked'! !
! GEMarkDemo methodsFor: 'accessing' !
iconName
" Return the name of placemark's icon. "
^'red-circle'! !
GEMarkDemo
subclass: #GESWFDemo
instanceVariableNames: ' '
category: 'EarthDemo'!
! GESWFDemo methodsFor: 'initialize' !
loadSWFSupport
" Private - Load flash support. "
DOM document
load: #( 'https://ajax.googleapis.com/ajax/libs/swfobject/2.1/swfobject.js' )
onLoad: [ self print: 'SWF support loaded.' ]! !
! GESWFDemo methodsFor: 'initialize' !
initializePlugin: plugin
" Private - Initialize the GEPlugin interface. "
super initializePlugin: plugin.
Smalltalk
jsObjectAt: #swfobject
ifAbsent: [ self loadSWFSupport ].! !
! GESWFDemo methodsFor: 'accessing' !
iconName
" Return the name of placemark's icon. "
^'purple-stars'! !
! GESWFDemo methodsFor: 'accessing' !
videoTitle
^'Buenos Aires'! !
! GESWFDemo methodsFor: 'accessing' !
videoId
^#yrzuP3XDlfo ! !
! GESWFDemo methodsFor: 'click'!
placemarkClicked
" The placemark link has been clicked. "
| swf |
swf := Smalltalk jsObjectAt: #swfobject ifAbsent: [
self show: 'Missing swfobject module. Try again later.'.
^self loadSWFSupport
].
self show:
''
,'
' ,self videoTitle ,' '
,'
loading video ...
'
,'
'.
[ self loadPlayer: swf ] evaluateDeferred! !
! GESWFDemo methodsFor: 'private' !
demoContents: text
" Private - Return the HTML text to be shown to the user. "
^self smallLogoImage ,text
,'aleReimondo.com '! !
! GESWFDemo methodsFor: 'playing' !
loadPlayer: swf
" Private - Embedd the Flash player. "
| params atts container |
container := DOM document getElementById: #swfContainer.
container isNil ifTrue: [
^self print: 'DIV element to host video not found.'
].
"container style display: #block."
container innerHTML: 'Embedding flash video...'.
params := #allowScriptAccess -> #always.
atts := #id -> #ytPlayer.
[ swf #embedSWF:
'http://www.youtube.com/v/' ,self videoId
,'&enablejsapi=1&playerapiid=player1&autoplay=1'
with: #swfContainer
with: '400' with: '295' with: '8'
with: nil json with: nil json
with: params json with: atts json.
] on: Error do: [:ex| self print: 'Error ' ,ex; print: ex stack ].! !
GEMarkDemo
subclass: #GETubeDemo
instanceVariableNames: ' '
category: 'EarthDemo'!
! GETubeDemo methodsFor: 'accessing' !
placemarkName
" Return the placemarkName of the receiver (or nil to leave blank). "
^'Click for a YouTube video!!'! !
! GETubeDemo methodsFor: 'click' !
placemarkClicked
" The placemark link has been clicked. "
self show:
' '
,' '
,' '! !
! GETubeDemo methodsFor: 'private' !
demoContents: text
" Private - Return the HTML text to be shown to the user. "
^'
Create your own world with Smalltalk!! '
,text
,'Join us at u8.smalltalking.net and/or our skype meetings.'
,'aleReimondo.com '! !
GEDemo
subclass: #BatchDemo
instanceVariableNames: ' placemark times start '
category: 'EarthDemo'!
! BatchDemo methodsFor: 'initialize' !
initializePlugin: plugin
" Private - Initialize the GEPlugin interface. "
super initializePlugin: plugin.
self enableLayers: #( #Borders #Roads ).
times := #( 0 0 ).
self when: #opened do: [
self print: 'Processing will start in 3 seconds'.
[
self
timeUnbatched;
timeBatched
] valueDeferred: 3000
].! !
! BatchDemo methodsFor: 'batch' !
timeBatched
" Execute the run operations in batched mode. "
self print: 'Running "batched" mode...'.
start := DateTime now.
self ge executeBatch: [ "this block will be executed synchronous"
self run.
times at: 2 put: DateTime now - start.
self print: '---Computation complete---'.
self reportResults
]! !
! BatchDemo methodsFor: 'batch' !
timeUnbatched
" Execute the run operations in normal mode. "
self print: 'Running "normal" mode...'.
start := DateTime now.
self run.
times at: 1 put: DateTime now - start.! !
! BatchDemo methodsFor: 'report' !
reportResults
" Report the results of measurements. "
self print: 'Execution time of normal operation =', times first asString ,'ms.'.
self print: 'Execution time of batch operation =', times last asString ,'ms.'.
self show:
'
Execution time of normal operation =', times first asString ,'ms.'
,' Execution time of batch operation =', times last asString ,'ms.'
! !
! BatchDemo methodsFor: 'running' !
run
" Execute the long computation action. "
| lookAt line coordinates latitude longitude |
placemark notNil ifTrue: [ self ge removeFeature: placemark ].
placemark := self ge createPlacemark.
line := ge createLineString.
line tessellate: true.
lookAt := self ge view copyAsLookAt: ge altitudeRelativeToGround.
latitude := lookAt latitude. longitude := lookAt longitude.
coordinates := line coordinates.
0 to: 1000 do: [:i|
coordinates
pushLatLngAlt: (i / 10) cos * i / 10 + latitude
longitude: (i / 10) sin * i / 10 + longitude
altitude: 0
].
placemark geometry: line.
self ge addFeature: placemark! !
GEDemo
subclass: #MovingCameraDemo
instanceVariableNames: ' tour backup '
category: 'EarthDemo'!
! MovingCameraDemo methodsFor: 'initialize' !
initializePlugin: plugin
" Private - Initialize the GEPlugin interface. "
super initializePlugin: plugin.
backup := self ge options flyToSpeed.
self enableLayers: #( #Borders #Roads ).
self goHome.
self when: #opened do: [
[ self start ] valueDeferred: 2000
].! !
! MovingCameraDemo methodsFor: 'visiting' !
start
" Start a new round tour. "
tour := nil.
self moveTheCamera! !
! MovingCameraDemo methodsFor: 'accessing' !
tourSites
" Return the tour sites. "
^#(
#( 'River Plate' -34.54526967884564 -58.449750105988024)
#( 'Tigre' -34.422510589456735 -58.58083270575137 )
#( 'Parque Centenario' -34.60643674780765 -58.43548229301413 )
#( 'Obelisk' homeLocation )
" #( #Zero 0 0 5000 ) "
)! !
! MovingCameraDemo methodsFor: 'accessing' !
tour
" Return the tour. "
tour isNil ifTrue: [ tour := self tourSites copy ].
^tour! !
! MovingCameraDemo methodsFor: 'accessing' !
nextLocation
" Return the next site to visit. "
| tuple |
self tour isEmpty ifTrue: [ ^nil ].
tuple := self tour removeFirst.
self show: 'City Tour to ' ,tuple first ,' '.
tuple last isNumber ifFalse: [ ^self perform: tuple last ].
^tuple copyFrom: 2 to: tuple size! !
! MovingCameraDemo methodsFor: 'tour' !
moveTheCamera
" Move the camera doing next tour steps. "
| walk destination steps |
self ge options flyToSpeed: self ge speedTeleport.
destination := self nextLocation.
destination isNil ifTrue: [
self print: 'Tour complete'.
self ge options flyToSpeed: backup.
^self goHome
].
steps := self pointsFrom: self location to: destination.
walk := [
steps notEmpty ifTrue: [
self goto: steps removeFirst.
walk valueDeferred: 50.
] ifFalse: [
[ self moveTheCamera ] valueDeferred: 2000
]
].
walk valueDeferred: 50! !
! MovingCameraDemo methodsFor: 'steping' !
steps
" Return the number of steps in tour. "
^40! !
! MovingCameraDemo methodsFor: 'tour' !
pointsFrom: origin to: target
" Returns the points to walk between origin and destination. "
| steps delta destination altitudes initial |
steps := self steps.
target isArray ifTrue: [
initial := self coordinates.
altitudes := (0 to: steps) collect: [:i|
target last - initial last * i / steps + initial last
].
altitudes := altitudes stream.
destination := target first @ target second.
] ifFalse: [
destination := target.
].
delta := destination - origin / steps.
^(0 to: steps) collect: [:i| | current |
current := delta * i + origin.
Array with: current x with: current y with:
(altitudes isNil ifTrue: [ 0 ] ifFalse: [ altitudes next ])
]! !
! MovingCameraDemo methodsFor: 'private' !
demoContents: text
" Private - Return the HTML text to be shown to the user. "
| epilogue |
epilogue := self tour isEmpty
ifTrue: [ '
Click here to run again . ' ]
ifFalse: [ 'Next Visit: ' ,self tour first first,' ' ].
^self smallLogoImage ,text ,epilogue! !
GEMarkDemo
subclass: #GEDragMeDemo
instanceVariableNames: ' target dragged '
category: 'EarthDemo'!
! GEDragMeDemo methodsFor: 'initialize' !
initializePlacemark
" Private - Initialize the GEPlugin interface. "
dragged := false.
self ge globe
when: #mousedown: do: [:event| self mouseDown: KmlMouseEvent @ event ];
when: #mousemove: do: [:event| self mouseMove: KmlMouseEvent @ event ];
when: #mouseup: do: [:event| self mouseUp: KmlMouseEvent @ event ];
yourself! !
! GEDragMeDemo methodsFor: 'accessing' !
placemarkName
" Return the placemarkName of the receiver (or nil to leave blank). "
^'Drag Me!!'! !
! GEDragMeDemo methodsFor: 'drag' !
mouseDown: event
" Process the event. "
| object |
object := event targetObject.
((object isKindOf: KmlPlacemark) and: [
(object geometryObject isKindOf: KmlPoint)
]) ifTrue: [
"event preventDefault."
target := object.
dragged := false.
]! !
! GEDragMeDemo methodsFor: 'drag' !
mouseMove: event
" Process the event. "
target notNil ifTrue: [
event preventDefault.
target geometryObject
latitude: event latitude;
longitude: event longitude.
dragged := true.
]! !
! GEDragMeDemo methodsFor: 'drag' !
mouseUp: event
" Process the event. "
target notNil ifTrue: [
dragged ifTrue: [ event preventDefault ].
target := nil.
dragged := false.
]! !
GEDemo
subclass: #GEx2Demo
instanceVariableNames:
' top geSlave divSlave slaveOptions slaveAction '
,' laMaster laSlave camMaster camSlave '
category: 'EarthDemo'!
#( chinaSyndrome
) do: [:selector|
GEx2Demo class
implement: selector
comment: 'Open a demo instance of the receiver doing selector.'
as: '^self openDemo: #' ,selector
category: #demo
]!
! GEDemo class methodsFor: 'events' !
constructEventsTriggered
" Return the events that the instance of the receiver can trigger. "
^#( slaveOpened
needsSlaveOptions
#initializeSlave:
#bindSlave:to:
bindSlave
initializeSlaveAction
) ,super constructEventsTriggered! !
! GEx2Demo methodsFor: 'release' !
releaseResources
" Private - Release the resources allocated by the receiver. "
divSlave notNil ifTrue: [
divSlave innerHTML: ''.
divSlave parentNode removeChild: divSlave handle.
divSlave := nil.
].
top notNil ifTrue: [
top innerHTML: ''.
top parentNode removeChild: top handle.
top := nil.
].
geSlave release. geSlave := nil.
^super releaseResources! !
! GEx2Demo methodsFor: 'private' !
basicOpen: earth
" Private - Open the receiver in the HTML document in the context of earth application. "
super basicOpen: earth.
earth
createInstance: divSlave id
init: [:plugin| self initializeSlave: GEPlugin @ plugin; slaveOpened ]
failure: self failureCallback
options: self slaveOptions json! !
! GEx2Demo methodsFor: 'private' !
slaveOpened
" Private - The receiver has just open slave. "
self triggerEvent: #slaveOpened! !
! GEx2Demo methodsFor: 'accessing' !
geSlave
" Private - Return the slave GEPlugin in use. "
^geSlave! !
! GEx2Demo methodsFor: 'defaults' !
defaultWindowWidth
^self defaultWindowHeight! !
! GEx2Demo methodsFor: 'initialize' !
initializeSlave: plugin
" Private - Initialize the receiver's interface for slave view. "
geSlave := plugin.
self
triggerEvent: #initializeSlave:
withArguments: (Array with: geSlave)
ifNotHandled: [ self initializeSlavePlugin: plugin ].
laMaster := ge createLookAt.
laSlave := geSlave createLookAt.
camMaster := ge createCamera.
camSlave := geSlave createCamera.
self enableLayers: #( #Terrain #Borders #Roads ).
self enableLayers: #( #Terrain #Borders #Roads ) in: geSlave.
self triggerEvent: #bindSlave:to:
withArguments: (Array with: ge with: geSlave)
ifNotHandled: [ self bindSlave ]! !
! GEx2Demo methodsFor: 'initialize' !
initializeSlavePlugin: plugin
" Private - Initialize the GEPlugin interface. "
plugin window visibility: true.
self initializeNavigationControl: plugin.! !
! GEx2Demo methodsFor: 'accessing' !
slaveOptions: optionsSet
" Set the options of the receiver. "
slaveOptions := optionsSet! !
! GEx2Demo methodsFor: 'accessing' !
slaveOptions
" Return the options of the receiver. "
slaveOptions isNil ifTrue: [
self triggerEvent: #needsSlaveOptions
].
^slaveOptions! !
! GEx2Demo methodsFor: 'accessing' !
divSlave: aDiv
" Set the div to host slave plugin instance. "
divSlave := aDiv! !
! GEx2Demo methodsFor: 'gui-embedding' !
defaultContainer
" Private - Return a default container of the receiver. "
| aDocument anId slaveId first cell |
aDocument := self document.
anId := self triggerEvent: #needsId ifNotHandled: [ #map3d ].
slaveId := anId , #Slave.
div := aDocument @ anId.
divSlave := aDocument @ slaveId.
div isNil ifTrue: [
divSlave notNil ifTrue: [ ^super defaultContainer ].
cell := [:i|
'
',
''
,'
'
].
top := aDocument createElement: #div.
top innerHTML: ''
,(cell value: anId)
,(cell value: slaveId)
,'
'.
first := aDocument body childNodeAt: 1.
aDocument body
insert: top handle
before: first handle.
div := aDocument @ anId.
divSlave := aDocument @ slaveId.
].
^div! !
! GEx2Demo methodsFor: 'binding' !
bindSlave
" Bind the slave plugin to master plugin. "
self geSlave options flyToSpeed: self geSlave speedTeleport.
self triggerEvent: #bindSlave ifNotHandled: [
self ge view when: #viewchange do: self slaveAction.
[ self goHome ] valueDeferred: 3000.
].! !
! GEx2Demo methodsFor: 'accessing' !
slaveAction
" Return the (sync)slave action. "
slaveAction isNil ifTrue: [ self initializeSlaveAction ].
^slaveAction! !
! GEx2Demo methodsFor: 'accessing' !
slaveAction: anAction
" Set the (sync)slave action. "
slaveAction := anAction! !
! GEx2Demo methodsFor: 'initialize' !
initializeSlaveAction
" Private - Initialize the (sync)slave action. "
| slaveSelector |
slaveSelector := #slave
, selector first asUppercase
,(selector copyFrom: 2 to: selector size).
(self respondsTo: slaveSelector) ifFalse: [
slaveSelector := #slaveDefault
].
self slaveAction: [ self perform: slaveSelector ]! !
! GEx2Demo methodsFor: 'sync' !
slaveDefault
" Perform slave sync action.
Default action is to make slave follow master.
"
laMaster := ge view copyAsLookAt: ge altitudeRelativeToGround.
laSlave
set: laMaster latitude
longitude: laMaster longitude
altitude: laMaster altitude
altitudeMode: laMaster altitudeMode
heading: laMaster heading
tilt: laMaster tilt
range: laMaster range.
geSlave view abstractView: laSlave.! !
! GEx2Demo methodsFor: 'sync' !
slaveChinaSyndrome
" Perform slave sync action.
Default action is to make slave follow master.
"
laMaster := ge view copyAsLookAt: ge altitudeRelativeToGround.
laSlave
set: laMaster latitude negated
longitude: laMaster longitude + 180 \\ 360
altitude: laMaster altitude
altitudeMode: laMaster altitudeMode
heading: laMaster heading
tilt: laMaster tilt
range: laMaster range.
geSlave view abstractView: laSlave.! !