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.