pro suncalc_cleanup,x

common suncalc_EXC,a,ID,Factor

WIDGET_CONTROL,/hour

	if ID.Save then begin

	CASE !version.OS OF

'windows':	Delim='\'

'Win32':	Delim='\'

ELSE:		Delim='/'

	ENDCASE

openw,Lun,getenv('results')+Delim+ID.Filename, /get_lun
printf,Lun,ID.Results
free_lun,Lun
	endif

		if ID.group_leader ne 0L then begin
if WIDGET_INFO(ID.group_leader,/valid) then $
	WIDGET_CONTROL,ID.group_leader,/show
		endif


!P=a.P
a=(ID=0)

	end

	function suncalc_text,SUN

return, $
["Position angle = "+string(SUN.Dp*!radeg,format="(F6.2)"), $
"Radius = "+string(SUN.R*!radeg*60,format="(F6.2)")+"'", $
"Centre's latitude = "+string(SUN.B0*!radeg,format="(F6.2)"), $
"Centre's Carring. long. = "+string(SUN.Karr*!radeg,format="(F6.1)"), $
"Hour angle = "+string(SUN.H*!radeg,format="(F6.2)"), $
"Declination = "+string(SUN.Decl*!radeg,format="(F6.2)"), $
"Culmination = "+smh(SUN.Tcul*3600d0,/ms)]

	end

	pro suncalc_convert,x

common suncalc_EXC,a,ID,Factor

Centre=[1,1]*0.5*!d.x_vsize

p=convert_coord(x(0),x(1),/dev,/to_data)

Rect=string(2.*(x-Centre)(0)/a.R,2.*(x-Centre)(1)/a.R, $
	format="(F5.2,',   ',F5.2)")

WIDGET_CONTROL,ID.Coord,set_val=Rect

WIDGET_CONTROL,ID.Rect,set_val=Rect

;radius=sqrt(((2.*(x-Centre)(0)/a.R)^2+(2.*(x-Centre)(1)/a.R)^2))


radius=2./a.R*sqrt(((x-Centre)(0))^2+((x-Centre)(1))^2)


if radius lt 1 then Dist=asin(radius)*!radeg else Dist=90.
Dist=string(Dist,format="(F5.2)")+' deg'
WIDGET_CONTROL,ID.Dist,set_val=Dist

if a.map eq 0 then return

	if p(0) lt 0 then dirX='E' else dirX='W'
	if p(1) lt 0 then dirY='S' else dirY='N'

Helio=string(dirX,abs(p(0)),dirY,abs(p(1)),format="(A1,F4.1,',   ',A1,F4.1)")
WIDGET_CONTROL,ID.Helio,set_val=Helio

		if n_tags(a) gt 6 then begin
Klong=p(0)+a.SUN.Karr*!radeg
Klong=(Klong+360*(Klong lt 0)) mod 360
Carr=string(Klong,p(1),format="(F5.1,',   ',F5.1)")
WIDGET_CONTROL,ID.Carr,set_val=Carr
		endif

Helio=strcompress(Helio,/rem)
Carr=strcompress(Carr,/rem)
Rect=strcompress(Rect,/rem)
Dist=strcompress(Dist)

text=string(' ',format= $
"(a1,'"+a.Date+"',T12,'"+a.Time+"',T26,'"+Helio+"',T39,'"+Carr+"',T52,'"+Rect+"',T65,'"+Dist+"')")

ID.number=ID.number+1

ID={win:ID.win,Carr:ID.Carr,Helio:ID.Helio,Rect:ID.Rect,Dist:ID.Dist, $
	Date:ID.Date,Time:ID.Time,View:ID.View,Coord:ID.Coord,Data:ID.Data, $
	linestyle:ID.linestyle,color:ID.color, group_leader:ID.group_leader, $
	Text:ID.Text, Save_button:ID.Save_button, $
	Save:ID.Save, Filename:ID.Filename, number:ID.number,  $
	Name:ID.Name, Results:[ID.Results,text]}

	end


	pro suncalc_event,ev

common suncalc_EXC,a,ID,Factor

Centre=[1,1]*0.5*!d.x_vsize

	if ev.id eq ID.View then begin

if ev.press then a.press=1
if ev.release then a.press=0

Window_set,ID.win,scale=a.Sc

p=convert_coord(ev.x,ev.y,/dev,/to_data)

WIDGET_CONTROL,ID.Coord,set_val= $
	string(2.*(ev.x-Centre(0))/a.R,2.*(ev.y-Centre(1))/a.R, $
		format="(F5.2,',   ',F5.2)")
x=[ev.x,ev.y]

	if a.press then suncalc_convert,x

return
	endif

WIDGET_CONTROL,ev.id,GET_UVALUE = wuv

	CASE wuv OF

"DONE":		WIDGET_CONTROL,ev.top,/DESTROY

"Date":		begin
WIDGET_CONTROL,ev.id,get_value=temp
	a.Date=strtrim(strcompress(temp(0)),2)

	CASE !version.OS OF

'windows':	Delim='\'

'Win32':	Delim='\'

ELSE:		Delim='/'

	ENDCASE

Name=getenv('astr_data')+Delim+'sol'+strmid(a.Date,6,2)+'.dat'

if (findfile(Name))(0) eq '' then begin
WIDGET_CONTROL,ev.id,set_value='incorrect'
return
endif


WIDGET_CONTROL,ev.id,set_value=a.Date,/hour
if n_tags(a) gt 6 then SUN=a.SUN
	if a.time ne '' then begin
suneph,a.date,a.time,SUN

WIDGET_CONTROL,ID.Data,set_val=suncalc_text(SUN)

map_set,SUN.B0*180/!Pi,0,0,/ortho,/nobor,/grid,/lab, $
	glinestyle=ID.linestyle,Xmar=[0,0],Ymar=[0,0], $
		latdel=10,londel=10,col=ID.color

plotline,-tan(SUN.Dp),[1,1]*0.5*!d.x_vsize,lines=ID.linestyle,/dev

plots,[1,1]/2.*!d.x_vsize,[0,!d.x_vsize], $
	/dev,linestyle=ID.linestyle,col=ID.color
plots,[0,!d.x_vsize],!d.x_vsize/2.*[1,1], $
	/dev,linestyle=ID.linestyle,col=ID.color

Scale,temp,/mem

a={P:a.P,Date:a.Date,time:a.time,R:a.R,SUN:SUN,press:a.press, $
	map:1, Sc:temp}

empty

	endif

WIDGET_CONTROL,ID.Time,/input
		end

"Time":		begin

WIDGET_CONTROL,ev.id,get_value=temp
	a.time=strtrim(strcompress(temp(0)),2)
WIDGET_CONTROL,ev.id,set_value=a.time,/hour

if n_tags(a) gt 6 then SUN=a.SUN
	if a.date ne '' then begin
suneph,a.date,a.time,SUN

WIDGET_CONTROL,ID.Data,set_val=suncalc_text(SUN)

	if not(a.map) then begin

map_set,SUN.B0*180/!Pi,0,0,/ortho,/nobor,/grid,/lab, $
	glinestyle=ID.linestyle,Xmar=[0,0],Ymar=[0,0], $
		latdel=10,londel=10,col=ID.color

plotline,-tan(SUN.Dp),[1,1]*0.5*!d.x_vsize,lines=ID.linestyle,/dev

plots,[1,1]*!d.x_vsize/2.,[0,!d.x_vsize], $
	/dev,linestyle=ID.linestyle,col=ID.color
plots,[0,!d.x_vsize],!d.x_vsize/2.*[1,1], $
	/dev,linestyle=ID.linestyle,col=ID.color
Scale,temp,/mem
a.Sc=temp

	endif

a={P:a.P,Date:a.Date,time:a.time,R:a.R,SUN:SUN,press:a.press, $
	map:1, Sc:a.Sc}

empty
	endif
WIDGET_CONTROL,ID.Date,/input
		end

"Helio":	begin
	WIDGET_CONTROL,ev.id,GET_V=b

if (b(0) eq '') and n_elements(b) gt 1 then b=b(1:*)

b=strlowcase(strcompress(b(0),/rem))

i1=strpos(b,',')
i2=strlen(b)

lon=float(strmid(b, 1, i1-1))
lat=float(strmid(b, i1+2, i2-i1-2))

lonsign=strmid(b,0,1)
latsign=strmid(b,i1+1,1)

if lonsign eq 'e' or lonsign eq '-' then lon=-lon
if latsign eq 's' or latsign eq '-' then lat=-lat

Coord=convert_coord(lon,lat,/to_dev,/data)

	if Coord(0) le !d.x_vsize and Coord(1) le !d.x_vsize then begin
Window_set,ID.win,scale=a.Sc
tvcrs,lon,lat,/data
suncalc_convert,Coord
	endif else begin
WIDGET_CONTROL,/hour
xwarning, 'These coordinates are not allowed'
	endelse

	end

"Carr":	if n_tags(a) lt 7 then begin
WIDGET_CONTROL,/hour
xwarning, 'First of all please enter date and time'
return
	endif else begin

	WIDGET_CONTROL,ev.id,GET_V=b

if (b(0) eq '') and n_elements(b) gt 1 then b=b(1:*)

b=strlowcase(strcompress(b(0),/rem))

i1=strpos(b,',')
i2=strlen(b)

lon=float(strmid(b, 0, i1))-a.SUN.Karr*!radeg
lat=float(strmid(b, i1+1, i2-i1))

Coord=convert_coord(lon,lat,/to_dev,/data)

	if Coord(0) le a.R and Coord(1) le a.R then begin
Window_set,ID.win,scale=a.Sc
tvcrs,lon,lat,/data
suncalc_convert,Coord
	endif else begin
WIDGET_CONTROL,/hour
xwarning, 'These coordinates are not allowed'
	endelse

	endelse


"Rect":		begin

	WIDGET_CONTROL,ev.id,GET_V=b

if (b(0) eq '') and n_elements(b) gt 1 then b=b(1:*)

b=strlowcase(strcompress(b(0),/rem))

i1=strpos(b,',')
i2=strlen(b)

x=float(strmid(b, 0, i1))
y=float(strmid(b, i1+1, i2-i1))

	if (x^2+y^2) le 1 then begin

x=x*a.R/2.+Centre(0)
y=y*a.R/2.+Centre(1)

Window_set,ID.win,scale=a.Sc
tvcrs,x,y,/dev
suncalc_convert,[x,y]

	endif else begin

WIDGET_CONTROL,/hour
xwarning, 'These coordinates are not allowed'

	endelse

		end

"Clear":		begin
WIDGET_CONTROL,ID.Coord,set_val=''
WIDGET_CONTROL,ID.Rect,set_val=''
WIDGET_CONTROL,ID.Helio,set_val=''
WIDGET_CONTROL,ID.Carr,set_val=''
WIDGET_CONTROL,ID.Dist,set_val=''

		end

"Save":	begin
ID.Save=ev.select

if ID.Save then Name=ID.Filename else Name=''
WIDGET_CONTROL,ID.Name,set_val=Name
	end

"List":	begin
WIDGET_CONTROL,/hourglass
xtext,text=ID.Results
	end

"Name":		begin
WIDGET_CONTROL,ID.Name,get_val=temp
ID.Filename=temp(0)
		end

ELSE:

	ENDCASE


	end


	pro suncalc,group_leader=group_leader,SUN=SUN, $
modal=modal,Date,Time

common suncalc_EXC,a,ID,Factor


if xregistered('suncalc') then return


if n_elements(group_leader) le 0 then group_leader=0L
if n_elements(modal) le 0 then modal=0
if n_params() eq 2 then suneph,Date,Time,SUN
if n_elements(Date) le 0 then Date=''
if n_elements(Time) le 0 then Time=''

	CASE !version.OS OF

'windows':	Factor=1.

'Win32':	Factor=1.

ELSE:		Factor=1.04

	ENDCASE


	WIDGET_CONTROL,/hour
M=strlowcase(findfile('vga_drv.rcg'))
	if equiv(M,'') then M=1 else begin
openr,lun,'vga_drv.rcg',/get_lun
readf,lun,M
free_lun,lun
	endelse		;M=0 for L-310 else M=1 (to plot lines with various styles)


ID={win:0L,Carr:0L,Helio:0L,Rect:0L,Dist:0L, $
	Date:0L,Time:0L,View:0L,Coord:0L,Data:0L, $
	linestyle:M,color:100B, group_leader:group_leader,Text:'', $
	Save_button:0L, Save:1, Filename:'', number:0L, Results:strarr(4),Name:0L}

device,get_screen_size=screen

R=0.7*screen(1)

Ax={Axes, x:{!Axis}, y:{!Axis}, z:{!Axis}, map:!Map}


if n_elements(SUN) le 0 then $
	a={P:!P,Date:Date,Time:Time,R:R,press:0,map:0, Sc:Ax} $
	else a={P:!P,Date:Date,Time:Time,R:R,press:0,map:0,SUN:SUN, Sc:Ax}

Ax=0

!P.color=0
!P.background=255b

Mainbase=widget_base(/colu, tit='Coordinates on the Sun', $
	group_leader=group_leader)

Menubase=widget_base(Mainbase,/row)

XPdMenu,	['"DONE"	DONE',	$
		'"List"		List',	$
		'"Clear"		Clear'], Menubase

Savebase=widget_base(Menubase,/row,/nonexcl,/frame)

Save_button=widget_button(Savebase,val='Save results',uval='Save')

ID.Filename=newfilename(filter='*.lst',model='coord', path=getenv('results'))

label=WIDGET_LABEL(Menubase,val='File: ')

ID.Name=WIDGET_Text(Menubase,val=ID.Filename,/edit,uval='Name')

WIDGET_CONTROL,Save_button,/set_but

base1=widget_base(Mainbase,/row)
label=WIDGET_LABEL(base1,val='          Date   ')
ID.Date=WIDGET_TEXT(base1,xsi=15,/fra,/edit,uval='Date')
label=WIDGET_LABEL(base1,val='          Time   ')
ID.Time=WIDGET_TEXT(base1,xsi=15,/fra,/edit,uval='Time')
label=WIDGET_LABEL(base1,val=' UT')

Rowbase=widget_base(Mainbase,/row)
Columnbase=widget_base(Rowbase,/colu)

base1=widget_base(Columnbase,/row)
ID.Helio=WIDGET_TEXT(base1,xsi=15,/fra,/edit,uval='Helio')
label=WIDGET_LABEL(base1,val='Heliographical')

base1=widget_base(Columnbase,/row)
ID.Carr=WIDGET_TEXT(base1,xsi=15,/fra,/edit,uval='Carr')
label=WIDGET_LABEL(base1,val="Carrington's")

base1=widget_base(Columnbase,/row)
ID.Rect=WIDGET_TEXT(base1,xsi=15,/fra,/edit,uval='Rect')
label=WIDGET_LABEL(base1,val='Rectangular')

base1=widget_base(Columnbase,/row)
ID.Dist=WIDGET_TEXT(base1,xsi=15,/fra,uval=' ')
label=WIDGET_LABEL(base1,val='Distance')

label=WIDGET_LABEL(Columnbase,val='Data (degree)')
ID.Data=WIDGET_TEXT(Columnbase,xsi=33,/fra, $
	uval=' ',ysize=7)

Drawbase=widget_base(Rowbase,/colu)

ID.View=widget_draw(Drawbase,xsi=R*Factor,ysi=R*Factor,/button,/motion, retain=2)
ID.Coord=WIDGET_LABEL(Drawbase,val='                        ')

WIDGET_CONTROL,Mainbase,/REALIZE,/HOUR

WIDGET_CONTROL,ID.View,GET_VALUE=temp
ID.Win=temp

wset,ID.win

if n_elements(SUN) le 0 then $
	draw_circle,[1,1]*!d.x_vsize*0.5,R*0.5, /axes else begin

WIDGET_CONTROL,ID.Data,set_val=suncalc_text(SUN),/hour

map_set,SUN.B0*180/!Pi,0,0,/ortho,/nobor,/grid,/lab, $
	glinestyle=ID.linestyle,Xmar=[0,0],Ymar=[0,0], $
		latdel=10,londel=10,col=ID.color

plotline,-tan(SUN.Dp),[1,1]*!d.x_vsize*0.5,lines=ID.linestyle,/dev

plots,[1,1]*0.5*!d.x_vsize,[0,!d.x_vsize], $
	/dev,linestyle=ID.linestyle,col=ID.color
plots,[0,!d.x_vsize],[1,1]*0.5*!d.x_vsize, $
	/dev,linestyle=ID.linestyle,col=ID.color

Scale,temp,/mem
a.Sc=temp

a.map=1

WIDGET_CONTROL,ID.Time,set_val=SUN.Time
WIDGET_CONTROL,ID.Date,set_val=SUN.Date

	endelse

WIDGET_CONTROL,ID.Date,/input,/hour

empty

text0=string(' ',format="(a1,T10,'Coordinates issued by the program SUNCALC')")
text1=string(' ',format= $
	"(a1,T5,'Date',T15,'Time',T25,'Helio',T39,'Carringt.',T50,'Rect. Norm.',T65,'Ang. dist.')")

ID.Results=[text0,'',text1,'']

xmanager,'suncalc',Mainbase,cleanup='suncalc_cleanup',modal=modal
end