; $Id: globerot.pro,v 1.1 1993/04/02 19:57:52 idl Exp $

pro world_ct
common colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr
r_orig = bytarr(256)
g_orig = r_orig
b_orig = r_orig

; Define interpolation points:  (elevation in meters, r, g, b)
; be sure elevation of 1st element is -5000 (data value 0), and last is
; 5240 (data value 256).
c = fltarr(256, 3)
p = [	[ -5000, 64, 64, 64], $		;Dark Gray at 0
	[ -4900, 0, 0, 128], $		;Dim blue
	[ -1500, 0, 0, 255], $		;Bright blue
	[ -40, 192, 192, 255], $
	[ 0, 64, 192, 64], $		;Med green
	[ 250, 150, 150, 75], $		;Dim Yellow
	[ 1000, 200, 200, 100], $	;Brighter yellow
	[ 4000, 255, 255, 255], $	;White
	[ 5240, 255, 255, 255]]		;To white

n = n_elements(p)/4
for i=0,n-2 do begin		;Intervals
	s0 = (p(0,i)+5000) / 40	;Color index
	s1 = (p(0,i+1)+5000) / 40
	m = s1 - s0 > 1
	for j=0,2 do begin	;Each color
		s = float(p(j+1,i+1) - p(j+1,i)) / m
		c(s0, j) = findgen(m) * s + p(j+1,i)
		endfor
	endfor
r_orig = byte(c(*,0))
g_orig = byte(c(*,1))
b_orig = byte(c(*,2))
r_curr = r_orig
g_curr = g_orig
b_curr = b_orig
tvlct,r_orig, g_orig, b_orig
end


PRO GLOBE1, fact, samp, wsize, nframes, polar_axis, lshading, esample, $
	    sea_level, ssample, wnum, group, ANIMATE=animate

common globe1_pars, b, e, old_samp, p, old_sea_level, old_fact, lat, lon, $
	x, y, z, rmax, nlon, nlat

;  Tunable parameters:
;fact = 125.			;Altitude Exaggeration factor
;samp = 2			;Sample every N degrees....
radius = 6371 * 1000.		;Earth radius in meters
;wsize = 384			;Animation window size
;nframes = 18			;# of frames to animate
;polar_axis = 22.5		;Rotation of north pole towards viewer (degs)
;lshading = 0			; 1 for light source shading, 0 for altitude
;Esample = 0			; 1 to sample elevations, 0 to average
;Ssample = 1			;Shading sampling:
;			0 for averaging
;			1 for sampling
;			2 for neighborhood maximum (preserves low land areas)
;remove_ocean = 0		;1 to set ocean floors to sea-level


; help, fact, samp, wsize, nframes, polar_axis, lshading, esample, sea_level, ssample, wnum

IF lshading THEN LOADCT,3, /SILENT ELSE WORLD_CT
tvlct, 100,100,100, 0	;gray background
while (180 mod samp) ne 0 do samp = samp + 1	;Even multiple


if n_elements(old_sea_level) le 0 then old_sea_level = -1
if n_elements(old_samp) le 0 then old_samp = -1

if (n_elements(b) le 1) or (sea_level ne old_sea_level) then begin
	print,'reading'
	c = bytarr(360, 360, /noz)
	openr, unit, /GET_LUN, filepath('worldelv.dat', sub='images')
	readu, unit, c 
	free_lun, unit
	b = c > byte((sea_level/40+124) > 1)	;Removes ocean floors
	e = 40 * b - 5000		;Elev in meters
	old_sea_level = sea_level
	old_fact = -1
	endif



if samp ne old_samp then begin
	print,'sampling'
	old_samp = samp
	slat = 2 * samp * Lindgen(180/samp)  ;Latitude subscripts
	slon = samp * Lindgen(360/samp)	;Longitude subscripts also = degrees
	lat = !dtor * (slat / 2. - 90)	;To degrees...
	lon = !dtor * slon
	nlat = n_elements(lat)
	nlon = n_elements(lon)
	lat = replicate(1, nlon) # lat	;To (nlon by nlat) arrays
	lon = lon # replicate(1, nlat)
	old_fact = -1
; Make polygon-vertex index table.  4 elems/triangle, 2 triangles/cell
	p = lonarr(4, 2 * nlon * (nlat-1) - 2 * nlon)
	j = 0L
	for ilat = 0, nlat-2 do for ilon = 0, nlon-1 do begin
		i0 = ilon + nlon * ilat		;Linear Index  (lower lt)
		i1 = i0 + 1			;Lower rt
		if ilon eq (nlon-1) then i1 = i1 - nlon
		i2 = i0 + nlon			;Upper lt
		i3 = i1 + nlon			;Upper rt
		if ilat ne 0 then begin	;Don't duplicate triangles @ south pole
			p(0, j) = [ 3, i0, i1, i3]
			j = j + 1
			endif
		if ilat ne (nlat-2) then begin	;Don't dup @ north pole
			p(0,j) = [ 3, i0, i3, i2]
			j = j + 1
			endif
		endfor		;ilat
endif

if fact ne old_fact then begin
	print,'xyz'
	old_fact = fact
	r = radius + rebin(e, nlon, nlat, SAMPLE = Esample) * fact ;Radius
	x = sin(lon) * cos(lat) * r			;To cartesian coords
	z = cos(lon) * cos(lat) * r
	y = sin(lat) * r
	rmax = max(r) * 1.05
	endif

!x.s = [rmax, 1.] / (2 * rmax)	;Set scaling -rmax to + rmax
!y.s = !x.s
!z.s = !x.s
half = [ .5, .5, .5]
t3d, /reset, tr = -half, rotate = [polar_axis, 0, 0]
t3d, tr = half


if lshading eq 0 then case ssample of	;Altitude shading?
0 : shades = rebin(b, nlon, nlat)	;average Shading for altitude
1 :  shades = rebin(b, nlon, nlat, /SAMPLE)	;Shading for altitude
2: BEGIN ; Option: Shading set to maximum elevation
	shades = bytarr(nlon, nlat, /nozer)	;Shading using neighborhood max
	t0 = systime(1)
	for ilat = 0, nlat-1 do begin
		b0 = b(*, ilat * samp * 2 : (ilat+1) * samp * 2 -1)
		for ilon=0,nlon-1 do begin
		  j = ilon * samp
		  shades(ilon, ilat) = max(b0(j: j + samp -1))
		  endfor
		endfor
	print,systime(1)-t0, ' seconds sampling'
  ENDCASE
ENDCASE

IF KEYWORD_SET(animate) THEN BEGIN
	xinteranimate, set = [ wsize, wsize, nframes ], /SHOWLOAD
	t0 = systime(1)
	for i=0, nframes -1 do begin
		if lshading then tv, polyshade(x, y, z, p, /t3d) $
		else tv, polyshade(x, y, z, p, /t3d, shades = shades)
		xyouts, 10, 10, strtrim(i * 360 / nframes,2), chars=2, /dev
		xinteranimate, frame = i, window = !d.window
		t3d, tr = -half, ro = [ -polar_axis, 0, 0]
		t3d, ro = [ 0, 360. / nframes, 0]
		t3d, ro = [ polar_axis, 0, 0]
		t3d, tr = half
	endfor
print, systime(1)-t0, ' seconds'
xinteranimate, 15, group = group
ENDIF ELSE BEGIN
	 wset, wnum
	 IF lshading THEN TV, POLYSHADE(x, y, z, p, /t3d) $
         ELSE TV, POLYSHADE(x, y, z, p, /t3d, SHADES = shades)
ENDELSE
END


PRO READ_PANELS, fact, samp, wsize, nframes, polar_axis, $
                       sea_level

COMMON glober_block, lonsamp, rotangle, width, height, numframes, $
		     wnum, sea, source, scale, light_source

WIDGET_CONTROL, scale, GET_VALUE=fact
WIDGET_CONTROL, lonsamp, GET_VALUE=samp
WIDGET_CONTROL, rotangle, GET_VALUE=polar_axis
WIDGET_CONTROL, width, GET_VALUE=wsize
wsize = fix(wsize(0))
WIDGET_CONTROL, numframes, GET_VALUE=nframes
WIDGET_CONTROL, sea, GET_VALUE=sea_level

fact=fact(0)
polar_axis=polar_axis(0)
wsize=wsize(0)
nframes=nframes(0)
sea_level=sea_level(0)

END


PRO GLOBEROT_EVENT, EVENT
;THIS IS THE GLOBEROT EVENT HANDLER

;COMMON BLOCK
;

COMMON glober_block, lonsamp, rotangle, width, height, numframes, $
		     wnum, sea, source, scale, light_source
common globe1_pars, b, e, old_samp, p, old_sea_level, old_fact, lat, lon, $
	x, y, z, rmax, nlon, nlat

WIDGET_CONTROL, event.top, /HOURGLASS
WIDGET_CONTROL, event.id, GET_UVALUE = eventval 
CASE eventval OF
	"JUNK": junk = 0
	"ELEV": light_source = 0
	"LIGHT": light_source = 1
      "CREATE":	BEGIN
		if XRegistered("XInterAnimate") then RETURN
		READ_PANELS, fact, samp, wsize, nframes, polar_axis, $
			     sea_level
		esample=1
		ssample=1
		GLOBE1, fact, samp, wsize, nframes, polar_axis, light_source, $
			esample, sea_level, ssample, wnum, /ANIMATE, event.top
		END

	"HELP": BEGIN 
		;If HELP is pressed, display the help file.
		XDISPLAYFILE, FILEPATH('worldrthelp.txt', $
			SUBDIR = ['lib','xdemo','examples']), $
			GROUP=event.top, TITLE='World Rotation Tool Help'
		END ;Help case

      "UPDATE":	BEGIN
		WSET, wnum
                READ_PANELS, fact, samp, wsize, nframes, polar_axis, $
                             sea_level
                esample=0
                ssample=1
		GLOBE1, fact, samp, wsize, nframes, polar_axis, light_source, $
			esample, sea_level, ssample, wnum
 		END

	"DONE": BEGIN
		WIDGET_CONTROL, event.top, /DESTROY	;If 'Done' is pressed,
							;destroy all widgets
							;and return to IDL.
		;Clean up our common
		x = 0 & y = 0 & e = 0 & b = 0  & old_samp = -1
		lat = 0 & lon = 0
		ENDCASE
	  ELSE: donothing=0	;If nothing is pressed, don't do anything.

	ENDCASE

END



; !!! MAKE THE ACTUAL WIDGETS !!!

PRO globerot, GROUP = GROUP

; COMMON BLOCK
COMMON glober_block, lonsamp, rotangle, width, height, numframes, $
		     wnum, sea, source, scale, light_source

; Only one copy of WORLDROT can run at a time due to the COMMON block.
; Check for other copies and do nothing if WORLDROT is already running:

IF(XRegistered("worldrot") NE 0) THEN RETURN

wlevel = ROUTINE_NAMES(/LEVEL)		;Current level

;MAIN WIDGET BASE
base = WIDGET_BASE(TITLE='Globe Viewer', /ROW)

;WORLD ROTATION TOOL HAS 3 MAIN COLUMNS
lcol = WIDGET_BASE(base, /FRAME, /COLUMN)	;Left column.
rcol = WIDGET_BASE(base, /FRAME, /COLUMN)	;Right column.

;LEFT COLUMN IS THE EXCLUSIVE MENU OF PROJECTION TYPES, BUTTONS, AND OPTIONS
lpad = WIDGET_BASE(lcol, /FRAME, /ROW)
;The buttons:

spin = 		[				$
		[000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B],			$
		[000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B],			$
		[000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B],			$
		[000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B],			$
		[000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B],			$
		[000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B],			$
		[000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B],			$
		[000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B],			$
		[000B, 000B, 000B, 000B, 000B, 000B, 000B, 048B, 000B, 000B],			$
		[000B, 000B, 000B, 000B, 000B, 000B, 000B, 240B, 000B, 000B],			$
		[000B, 000B, 000B, 000B, 000B, 000B, 000B, 240B, 003B, 000B],			$
		[153B, 057B, 207B, 231B, 231B, 207B, 127B, 254B, 015B, 000B],			$
		[153B, 057B, 207B, 231B, 231B, 207B, 127B, 254B, 063B, 000B],			$
		[153B, 057B, 207B, 231B, 231B, 207B, 127B, 254B, 255B, 000B],			$
		[153B, 057B, 207B, 231B, 231B, 207B, 127B, 254B, 255B, 003B],			$
		[153B, 057B, 207B, 231B, 231B, 207B, 127B, 254B, 255B, 015B],			$
		[153B, 057B, 207B, 231B, 231B, 207B, 127B, 254B, 255B, 031B],			$
		[153B, 057B, 207B, 231B, 231B, 207B, 127B, 254B, 255B, 063B],			$
		[153B, 057B, 207B, 231B, 231B, 207B, 127B, 254B, 255B, 063B],			$
		[153B, 057B, 207B, 231B, 231B, 207B, 127B, 254B, 255B, 015B],			$
		[153B, 057B, 207B, 231B, 231B, 207B, 127B, 254B, 255B, 003B],			$
		[153B, 057B, 207B, 231B, 231B, 207B, 127B, 254B, 255B, 000B],			$
		[153B, 057B, 207B, 231B, 231B, 207B, 127B, 254B, 063B, 000B],			$
		[153B, 057B, 207B, 231B, 231B, 207B, 127B, 254B, 031B, 000B],			$
		[153B, 057B, 207B, 231B, 231B, 207B, 127B, 254B, 007B, 000B],			$
		[000B, 000B, 000B, 000B, 000B, 000B, 000B, 240B, 001B, 000B],			$
		[000B, 000B, 000B, 000B, 000B, 000B, 000B, 112B, 000B, 000B],			$
		[252B, 249B, 099B, 134B, 129B, 249B, 007B, 048B, 000B, 000B],			$
		[252B, 249B, 103B, 142B, 129B, 249B, 007B, 000B, 000B, 000B],			$
		[006B, 024B, 102B, 142B, 129B, 193B, 000B, 000B, 000B, 000B],			$
		[006B, 024B, 102B, 158B, 129B, 193B, 000B, 000B, 000B, 000B],			$
		[006B, 024B, 102B, 150B, 129B, 193B, 000B, 000B, 000B, 000B],			$
		[124B, 248B, 099B, 182B, 129B, 193B, 000B, 000B, 000B, 000B],			$
		[248B, 248B, 099B, 166B, 129B, 193B, 000B, 000B, 000B, 000B],			$
		[128B, 025B, 096B, 230B, 129B, 193B, 000B, 000B, 000B, 000B],			$
		[128B, 025B, 096B, 198B, 129B, 193B, 000B, 000B, 000B, 000B],			$
		[128B, 025B, 096B, 198B, 129B, 193B, 000B, 000B, 000B, 000B],			$
		[254B, 024B, 096B, 134B, 129B, 193B, 000B, 000B, 000B, 000B],			$
		[254B, 024B, 096B, 134B, 129B, 193B, 000B, 000B, 000B, 000B],			$
		[000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B, 000B]			$
		]

dne = WIDGET_BUTTON(lpad, VALUE = 'Done', UVALUE = 'DONE')

; Make the cool bitmap SPIN IT button if Motif, if Open Look, don't bother:
version = widget_info(/version)
IF (VERSION.STYLE EQ 'OPEN LOOK') THEN $
cna = WIDGET_BUTTON(lpad, VALUE = 'Spin World', UVALUE = 'CREATE') $
ELSE $
cna = WIDGET_BUTTON(lpad, VALUE = spin, UVALUE = 'CREATE')

help = WIDGET_BUTTON(lpad, VALUE = 'Help', UVALUE = 'HELP')


junk = widget_base(lcol, /row)
junk1 = widget_label(junk, value='Shading:')
junk = widget_base(junk, /exclusive, /row)
junk1 = widget_button(junk, value='Elevation', /NO_REL, uvalue='ELEV')
widget_control, junk1, /SET_BUTTON
junk1 = widget_button(junk, value='Light-source', /NO_REL, uvalue='LIGHT')
light_source = 0


;The Lon/Lat Sampling slider:
mcol2 = WIDGET_BASE(lcol, /FRAME, /COLUMN)
lonsamp = WIDGET_SLIDER(mcol2, TITLE = 'Lon/Lat Sampling', MINIMUM=1, $
			MAXIMUM=10, VALUE = 3, $
			UVALUE='lonsamp', XSIZE = 192)

;The 'Rotation of North' slider:
rotangle = WIDGET_SLIDER(mcol2, TITLE = 'Rotation of North', $
			 MINIMUM = -90, MAXIMUM = 90, VALUE = 0, $
			 UVALUE = 'rotslider', XSIZE = 192)

scale = WIDGET_SLIDER(mcol2, TITLE='Altitude Exaggeration Factor:', MIN=1, $
	MAX=200, VALUE=75, UVALUE='scaleslider')

sea = WIDGET_SLIDER(mcol2, TITLE='Lowest elevation (meters)', $
		MINIMUM=-5000, MAXIMUM=1000, $
		VALUE=-5000, UVALUE='seaslider')

;RIGHT COLUMN HAS SLIDER AND BUTTONS
samplebase = WIDGET_BASE(rcol, /COLUMN, /FRAME)
junk   = WIDGET_LABEL(samplebase, VALUE="Sample Globe")
window = WIDGET_DRAW(samplebase, xsize=200, ysize=200)
update = WIDGET_BUTTON(samplebase, VALUE="Update Globe", UVALUE='UPDATE')  

;The 'Animation Window Size' fields:
junk = widget_base(rcol, /row, /frame)
junk1 = widget_label(junk, value='Animation window size:')
width = widget_text(junk, xsize=5, ysize=1, /edit, value=['256'],$
	uvalue = 'JUNK')

;The 'Number of Frames' slider:
numframes = WIDGET_SLIDER(rcol, TITLE = 'Number of Frames', $
                          MAXIMUM=50, MINIMUM=2, VALUE=10, /FRAME, $
		 	  UVALUE = 'frameslider')

;REALIZE THE WIDGETS:
WIDGET_CONTROL, base, /REALIZE

;Get the window number:
WIDGET_CONTROL, window, GET_VALUE = wnum

;HAND THINGS OFF TO THE X MANAGER:
XMANAGER, 'globerot', base, GROUP_LEADER = GROUP

END