1: ================================================================================
2:
3: Smalltalk.KSU defineClass: #ClickEarth
4: superclass: #{UI.ApplicationModel}
5: indexedType: #none
6: private: false
7: instanceVariableNames: 'pictureOfEarth longitudeField latitudeField virefinderOfEarth '
8: classInstanceVariableNames: ''
9: imports: ''
10: category: 'KSU-Template'
11:
12: ================================================================================
13:
14: KSU.ClickEarth method for 'accessing'
15:
16: bodyOfEarth
17:
18: | aBlock |
19: aBlock :=
20: [| xyPointsAndSphere xyPoints aCompoundObject aTexture |
21: xyPointsAndSphere := JunOpenGL3dObject
22: xyPointsAndSphere: 10
23: radius: 1
24: longitude: 360
25: latitude: 180.
26: xyPoints := xyPointsAndSphere first collect: [:aPoint | aPoint x , (1 - aPoint y)].
27: aCompoundObject := xyPointsAndSphere last.
28: aCompoundObject paint: ColorValue white.
29: aTexture := JunOpenGLTexture image: JunOpenGLTexture imageEarth3.
30: aTexture
31: linear: true;
32: repeat: true.
33: aTexture coordinates: xyPoints.
34: aCompoundObject texture: aTexture.
35: aCompoundObject name: 'earth'.
36: aCompoundObject yourself].
37: ^aBlock value
38:
39: ------------------------------------------------------------
40:
41: KSU.ClickEarth method for 'actions'
42:
43: clicked: thePoint
44:
45: | aController aSensor |
46: (aController := self controllerAt: #imageOfEarth) ifNil: [^nil].
47: aSensor := aController sensor.
48: JunCursors crossCursor showWhile:
49: [| aPoint anImage aBoolean |
50: aPoint := thePoint.
51: anImage := self pictureOfEarth.
52: aBoolean := true.
53: [aBoolean] whileTrue:
54: [aPoint := (aPoint x \\ anImage width) @ (aPoint y \\ anImage height).
55: aPoint y = 0 ifTrue: [aPoint := aPoint x @ JunGeometry accuracy].
56: self
57: updateLongitudeField: aPoint;
58: updateLatitudeField: aPoint;
59: updateViewfinderOfEarth: aPoint.
60: aPoint := aSensor cursorPoint.
61: aBoolean := aSensor shiftDown]]
62:
63: ------------------------------------------------------------
64:
65: KSU.ClickEarth method for 'initialize-release'
66:
67: initialize
68:
69: super initialize.
70: pictureOfEarth := nil.
71: pictureOfEarth := nil.
72: longitudeField := nil.
73: latitudeField := nil.
74: virefinderOfEarth := nil.
75: ^self
76:
77: ------------------------------------------------------------
78:
79: KSU.ClickEarth method for 'aspects'
80:
81: latitudeField
82:
83: latitudeField ifNil: [latitudeField := String new asValue].
84: ^latitudeField
85:
86: ------------------------------------------------------------
87:
88: KSU.ClickEarth method for 'aspects'
89:
90: longitudeField
91:
92: longitudeField ifNil: [longitudeField := String new asValue].
93: ^longitudeField
94:
95: ------------------------------------------------------------
96:
97: KSU.ClickEarth method for 'interface closing'
98:
99: noticeOfWindowClose: aWindow
100:
101: super noticeOfWindowClose: aWindow.
102: self viewfinderOfEarth closeRequest
103:
104: ------------------------------------------------------------
105:
106: KSU.ClickEarth method for 'accessing'
107:
108: pictureOfEarth
109:
110: pictureOfEarth
111: ifNil:
112: [self builder
113: ifNotNil:
114: [:aBuilder |
115: (aBuilder componentAt: #imageOfEarth)
116: ifNotNil:
117: [:aWrapper |
118: aWrapper widget
119: ifNotNil: [:aView | pictureOfEarth := aView visual]]].
120: pictureOfEarth ifNil: [pictureOfEarth := self class imageOfEarth]].
121: ^pictureOfEarth
122:
123: ------------------------------------------------------------
124:
125: KSU.ClickEarth method for 'interface opening'
126:
127: postOpenWith: aBuilder
128:
129: super postOpenWith: aBuilder.
130: self
131: pictureOfEarth;
132: viewEarth;
133: clicked: self pictureOfEarth bounds center
134:
135: ------------------------------------------------------------
136:
137: KSU.ClickEarth method for 'private'
138:
139: updateLatitudeField: aPoint
140:
141: | anImage aStream halfHeight aValue aString |
142: anImage := self pictureOfEarth.
143: aStream := String new writeStream.
144: halfHeight := anImage height / 2.
145: aValue := aPoint y.
146: aValue <= halfHeight
147: ifTrue:
148: [aValue := (halfHeight - aValue) / halfHeight * 90.
149: aStream nextPutAll: '北緯']
150: ifFalse:
151: [aValue := (aValue - halfHeight) / halfHeight * 90.
152: aStream nextPutAll: '南緯'].
153: aStream
154: nextPutAll: aValue asInteger printString;
155: nextPutAll: '度';
156: nextPutAll: ((aValue - aValue asInteger) * 60) asInteger printString;
157: nextPutAll: '分'.
158: aString := aStream contents.
159: self latitudeField value: aString
160:
161: ------------------------------------------------------------
162:
163: KSU.ClickEarth method for 'private'
164:
165: updateLongitudeField: aPoint
166:
167: | anImage aStream halfWidth aValue aString |
168: anImage := self pictureOfEarth.
169: aStream := String new writeStream.
170: halfWidth := anImage width / 2.
171: aValue := aPoint x.
172: aValue <= halfWidth
173: ifTrue:
174: [aValue := aValue / halfWidth * 180.
175: aStream nextPutAll: '東経']
176: ifFalse:
177: [aValue := (halfWidth - (aValue - halfWidth)) / halfWidth * 180.
178: aStream nextPutAll: '西経'].
179: aStream
180: nextPutAll: aValue asInteger printString;
181: nextPutAll: '度';
182: nextPutAll: ((aValue - aValue asInteger) * 60) asInteger printString;
183: nextPutAll: '分'.
184: aString := aStream contents.
185: self longitudeField value: aString
186:
187: ------------------------------------------------------------
188:
189: KSU.ClickEarth method for 'private'
190:
191: updateViewfinderOfEarth: aPoint
192:
193: | aViewfinder anImage longitudeValue latitudeValue aBlock eyeBeam projectionTable |
194: (aViewfinder := self viewfinderOfEarth) ifNil: [^nil].
195: anImage := self pictureOfEarth.
196: longitudeValue := aPoint x / anImage width * 360.
197: latitudeValue := aPoint y / anImage height * 180.
198: aBlock :=
199: [:longitude :latitude |
200: | aTransformation |
201: aTransformation := Jun3dTransformation unity.
202: aTransformation := aTransformation
203: product: (Jun3dTransformation rotateY: (JunAngle degrees: latitude)).
204: aTransformation := aTransformation
205: product: (Jun3dTransformation rotateZ: (JunAngle degrees: longitude)).
206: aTransformation yourself].
207: eyeBeam := (0 , 0 , 0 to: 0 , 0 , (aViewfinder eyePoint distance: aViewfinder sightPoint))
208: transform: (aBlock value: longitudeValue value: latitudeValue).
209: projectionTable := aViewfinder projectionTable.
210: projectionTable
211: at: #sightPoint put: eyeBeam first;
212: at: #eyePoint put: eyeBeam last;
213: at: #upVector put: 0 , 0 , 1.
214: aViewfinder projectionTable: projectionTable
215:
216: ------------------------------------------------------------
217:
218: KSU.ClickEarth method for 'menu messages'
219:
220: viewEarth
221:
222: self viewfinderOfEarth
223: ifNotNil:
224: [:aViewfinder |
225: | aBuilder aWindow |
226: (((aBuilder := aViewfinder builder) notNil
227: and: [(aWindow := aBuilder window) notNil])
228: and: [aWindow isOpen])
229: ifTrue:
230: [aWindow isCollapsed ifTrue: [aWindow expand].
231: aWindow raise]
232: ifFalse:
233: [| aWrapper aView |
234: (((aBuilder := self builder) notNil
235: and: [(aWrapper := aBuilder componentAt: #imageOfEarth) notNil])
236: and: [(aView := aWrapper widget) notNil])
237: ifTrue:
238: [| aBox aRectangle |
239: aBox := aView topComponent displayBox.
240: aRectangle := aViewfinder class windowBounds.
241: aRectangle := aRectangle align: aRectangle bottomLeft with: aBox bottomRight.
242: aViewfinder openAt: aRectangle origin]
243: ifFalse: [aViewfinder open]]]
244:
245: ------------------------------------------------------------
246:
247: KSU.ClickEarth method for 'accessing'
248:
249: viewfinderOfEarth
250:
251: virefinderOfEarth
252: ifNil: [virefinderOfEarth := #{Jun.JunOpenGLDisplayModel} value displayObject: self bodyOfEarth].
253: ^virefinderOfEarth
254:
255: ================================================================================
256:
257: KSU.ClickEarth class
258: instanceVariableNames: ''
259:
260: ================================================================================
261:
262: KSU.ClickEarth class method for 'examples'
263:
264: example1
265: "KSU.ClickEarth example1."
266:
267: | anApplication |
268: anApplication := KSU.ClickEarth new.
269: anApplication open.
270: ^anApplication
271:
272: ------------------------------------------------------------
273:
274: KSU.ClickEarth class method for 'resources'
275:
276: imageOfEarth
277:
278: ^JunOpenGLTexture imageEarth3
279:
280: ------------------------------------------------------------
281:
282: KSU.ClickEarth class method for 'resources'
283:
284: menuBar
285: "Tools.MenuEditor new openOnClass: self andSelector: #menuBar"
286:
287: <resource: #menu>
288: ^#(#{UI.Menu} #(
289: #(#{UI.MenuItem}
290: #rawLabel: 'ファイル'
291: #submenu: #(#{UI.Menu} #(
292: #(#{UI.MenuItem}
293: #rawLabel: '地球'
294: #value: #viewEarth )
295: #(#{UI.MenuItem}
296: #rawLabel: '終了'
297: #value: #closeRequest ) ) #(1 1 ) nil ) ) ) #(1 ) nil ) decodeAsLiteralArray
298:
299: ------------------------------------------------------------
300:
301: KSU.ClickEarth class method for 'interface specs'
302:
303: windowSpec
304: "Tools.UIPainter new openOnClass: self andSelector: #windowSpec"
305:
306: <resource: #canvas>
307: ^#(#{UI.FullSpec}
308: #window:
309: #(#{UI.WindowSpec}
310: #label: '地球をクリック'
311: #min: #(#{Core.Point} 512 320 )
312: #max: #(#{Core.Point} 512 320 )
313: #bounds: #(#{Graphics.Rectangle} 1024 560 1536 880 )
314: #flags: 4
315: #menu: #menuBar )
316: #component:
317: #(#{UI.SpecCollection}
318: #collection: #(
319: #(#{UI.MappedClickWidgetSpec}
320: #layout: #(#{Graphics.Rectangle} 0 0 512 256 )
321: #name: #imageOfEarth
322: #flags: 0
323: #visualSelector: #imageOfEarth
324: #defaultClickSelector:
325: #clicked: )
326: #(#{UI.LabelSpec}
327: #layout: #(#{Core.Point} 48 265 )
328: #name: #longitudeLabel
329: #label: '経度：' )
330: #(#{UI.LabelSpec}
331: #layout: #(#{Core.Point} 264 265 )
332: #name: #latitudeLabel
333: #label: '緯度：' )
334: #(#{UI.InputFieldSpec}
335: #layout: #(#{Graphics.Rectangle} 96 265 208 288 )
336: #name: #longitudeField
337: #colors:
338: #(#{UI.LookPreferences}
339: #setBackgroundColor: #(#{Graphics.ColorValue} 6143 8191 7167 ) )
340: #model: #longitudeField
341: #isReadOnly: true
342: #type: #string )
343: #(#{UI.InputFieldSpec}
344: #layout: #(#{Graphics.Rectangle} 312 265 424 288 )
345: #name: #latitudeField
346: #colors:
347: #(#{UI.LookPreferences}
348: #setBackgroundColor: #(#{Graphics.ColorValue} 8191 7167 6143 ) )
349: #model: #latitudeField
350: #isReadOnly: true ) ) ) )
351:
352: ================================================================================
This document was generated by KSU.TextDoclet on 2012/11/10 at 09:47:58.