Документ взят из кэша поисковой машины. Адрес оригинального документа : http://lnfm1.sai.msu.ru/~kupry/SOFTWARE/xlook.pro Дата изменения: Thu Jan 15 20:19:01 2004 Дата индексирования: Mon Oct 1 22:39:12 2012 Кодировка: Поисковые слова: m 8

PRO N_GAUSS,X,A,F,PDER
COMMON cary,pocetcar
ON_ERROR,2 ;Return to caller if an error occurs


n=pocetcar
;n=3
F=FLTARR(N_ELEMENTS(X))
G=FLTARR(N_ELEMENTS(X),n)
Z=FLTARR(N_ELEMENTS(X),n)
q=fltarr(N_ELEMENTS(X),n)
EZ=FLTARR(N_ELEMENTS(X),n)
for i=1,n do begin
if a(3*i-1) ne 0.0 then Z(*,i-1) = (X-A(3*i-2))/A(3*i-1) $;GET Z(*,i)
else z(*,i-1)=10

q(*,i-1)=z(*,i-1)&dd=where(abs(q(*,i-1))gt 13.2)&if(dd(0) ne -1) then q(dd,i-1)=13.2
EZ(*,i-1) = EXP(-q(*,i-1)^2/2.)
G(*,i-1)=A(3*i-3)*EZ(*,i-1)
F=F+G(*,i-1)
endfor

PDER = FLTARR(N_ELEMENTS(X),3*n) ;YES, MAKE ARRAY.
for i=1,n do begin
PDER(0,3*i-3) = EZ(*,i-1) ;COMPUTE PARTIALS
if a(3*i-1) ne 0. then PDER(0,3*i-2) = A(3*i-3) * EZ(*,i-1) * Z(*,i-1)/A(3*i-1)
PDER(0,3*i-1) = PDER(*,3*i-2) * Z(*,i-1)
endfor

RETURN
END

pro ggaus_event,event
COMMON knof,f4,s1
COMMON zacat,jeobr,jeobd,jeprof,jeprof2,integral,fil,klidnyprof
COMMON jedna,base,f1,f2,f3,e1,e2,position,im,prof1,prof2,okno1,$
okno2,okno3,image1,width,height,box,minx,miny,minnx,minny, $
old,o1,o2,prof3,Hpozice,ozn1,ozn2,ozn3,ozn4,r1,c1,cwidth,prof4
COMMON soub,slist,val,in,rezim
COMMON kolik,dalsi,pocet,vzdal1,vzdald
COMMON gau2,ggt1,ggt2,ggt3,ggdraw,ppos2,yy,hh1,hh2,hh3,ggbase1,ggbase,ggbase2
COMMON gau, pos2,gt1,gt2,gdraw,x,y,gbase
COMMON serie,cara
COMMON cary,pocetcar
widget_control,event.id,get_uvalue=uvalue
case uvalue of
'KONEC':begin
widget_control,base,sensitive=1
widget_control,event.top,/destroy
if dalsi lt pocet then begin
nahrat,'series',val(dalsi)
dalsi=dalsi+1
endif else begin
jeobr=0 & jeobd=0 & jeprof=0 & jeprof2=0 & integral=0 & klidnyprof=0


widget_control,f4,sensitive=1 & widget_control,s1,sensitive=0
widget_control,f1,sensitive=1 & widget_control,c1,sensitive=0

widget_control,im,get_value=vym & wset,vym & erase
widget_control,prof1,get_value=vym & wset,vym & erase
widget_control,prof2,get_value=vym & wset,vym & erase

endelse
end
'OK':begin

widget_control,ggt1,get_value=p1 & widget_control,ggt2,get_value=p2 ;peaks and halfwidth
widget_control,ggt3,get_value=p3 & widget_control,hh1,get_value=h1
widget_control,hh2,get_value=h2 & widget_control,hh3,get_value=h3

if (p1(0) ne 0) and (p2(0) ne 0) and (h1(0) ne 0) and (h2(0) ne 0) then begin

if (p3(0) ne 0) and (h3(0) ne 0) then pocetcar=3 else pocetcar=2
;if (p1(0) ne 0) and (p2(0) ne 0) and (p3(0) ne 0) and $
; (h1(0) ne 0) and (h2(0) ne 0) and (h3(0) ne 0) then begin ;pridat parametr pocet

widget_control,ggdraw,get_value=dr
widget_control,ggbase1,/destroy
widget_control,ggbase2,/destroy

gggbase=widget_base(ggbase,/row)
gggdraw=widget_draw(gggbase,xsize=400,ysize=400)

a=fltarr(3*pocetcar)
;a=fltarr(9) ;a=fltarr(3*n) ; parameters of gaussians ;pocet
a(0)=yy(fix(p1(0))) & a(1)=fix(p1(0)) & a(2)=abs(a(1)-fix(h1(0))) ;intenzita v peaku, x peaku, polosirka
a(3)=yy(fix(p2(0))) & a(4)=fix(p2(0)) & a(5)=abs(a(4)-fix(h2(0)))
if pocetcar eq 3 then begin
a(6)=yy(fix(p3(0))) & a(7)=fix(p3(0)) & a(8)=abs(a(7)-fix(h3(0)))
endif

case cara of
1:begin
wavelengths=[6560.555,6562.808,6564.206]
rozsah=[6560,6565]
end
2:begin
wavelengths=[4859.747,4861.342,4862.598]
rozsah=[4855,4865]
end
3:begin
wavelengths=[6560.555,6562.808,6564.206] ;dodelat
rozsah=[6560,6565]
end
endcase


wave=wavelengths(0:pocetcar-1)
;wave=wavelengths(0:3-1) ;pocet
; preparing weights for fit
weights1=replicate(1.0,n_elements(yy))
weights2=yy/max(yy)
;low_w=where( weights2 le 0.1) & weights2(low_w)=0.1
result_fit=curvefit(x,yy,weights2,a,sigma_a,$
function_name='N_GAUSS') ; curve fitting with weights
gg=fltarr(n_elements(x))
zz=fltarr(n_elements(x),pocetcar)
;zz=fltarr(n_elements(x),3) ;pocet

wset,dr
plot,x,yy,yrange=[0,max(yy)+0.5*max(yy)],xstyle=1,ystyle=1
for i=1,pocetcar do begin
;for i=1,3 do begin ;pocet
;for i=1,n do begin
a(3*i-1)=abs(a(3*i-1)) ;zde nic
zz(*,i-1)=(x-a(3*i-2))/a(3*i-1)
gg=a(3*i-3)*exp(-zz(*,i-1)^2/2)
oplot,x,gg,line=1 ; plotting individual gauss functions
endfor
oplot,x,result_fit,line=2,thick=2 ; plot the resulting fit

result_params=fltarr(2,pocetcar)
;result_params=fltarr(2,3) ; write positions of individual gaussians ;pocet
b=fltarr(pocetcar)
;b=fltarr(3) ; and wavelengths, respectively, to a file ;pocet

for i=1,pocetcar do b(i-1)=a(3*i-2)
;for i=1,3 do b(i-1)=a(3*i-2)
result_params(0,*)=b & result_params(1,*)=wave

output_file='wave_pos.gaus'
;strput,output_file,'.gaus',strpos(output_file,'.fts')
if dalsi eq 1 then openw,unit,output_file,/get_lun $
else openu,unit,output_file,/get_lun,/append
for i=0,pocetcar-1 do begin
;for i=0,3-1 do begin ;pocet
printf,unit, result_params(0,i),result_params(1,i)
endfor
free_lun,unit

if dalsi eq pocet then begin
xxl=fltarr(1000) & llam=fltarr(1000)
openr,unit,'wave_pos.gaus',/get_lun
i=0
while not eof(unit) do begin
readf,unit,xxx,lll
xxl(i)=xxx & llam(i)=lll & i=i+1
endwhile
free_lun,unit
xl=xxl(0:i-1) & lam=llam(0:i-1)
disp_coefs=svdfit(xl,lam,2)

dispdraw=widget_draw(gggbase,xsize=400,ysize=400)
widget_control,dispdraw,get_value=ddr & wset,ddr
point1=disp_coefs(1)*xl(0)+disp_coefs(0)
point2=disp_coefs(1)*xl(i-1)+disp_coefs(0)
plot,[xl(0),xl(i-1)],[point1,point2],yrange=rozsah
oplot,xl,lam,psym=2

openw,unit,'coef.dat',/get_lun
disp_coefs(0)=disp_coefs(0)-disp_coefs(1)*vzdal1
printf,unit,disp_coefs
free_lun,unit

filelab=widget_label(ggbase,value='The coefficients of dispersion have been writen to coef.dat')
konec=widget_button(ggbase,value='OK',uvalue='KONEC')
endif else begin
filelab=widget_label(ggbase,value='The results have been saved.')
konec=widget_button(ggbase,value='NEXT FILE',uvalue='KONEC')
endelse

endif else begin
chyba=widget_base()
chl=widget_label(chyba,value='Missing data')
widget_control,chyba,/realize
wait,2 & widget_control,chyba,/destroy
endelse
end
'CAN':begin
widget_control,event.top,/destroy
end
'DRAW':begin
coord=convert_coord(event.x,event.y,/device,/to_data) ;data coord.
iks=round(coord(0)) & ips=round(coord(1))
widget_control,ppos2,set_value=STRCOMPRESS('('+string(iks)+','+string(ips)+')',/rem)
end
endcase
end

pro gaus_event,event
COMMON gau, pos2,gt1,gt2,gdraw,x,y,gbase
COMMON gau2,ggt1,ggt2,ggt3,ggdraw,ppos2,yy,hh1,hh2,hh3,ggbase1,ggbase,ggbase2
COMMON serie,cara
widget_control,event.id,get_uvalue=uvalue
case uvalue of
'OK':begin
widget_control,gt1,get_value=gt11 & widget_control,gt2,get_value=gt22
if (fix(gt11(0)) ne 0) and (fix(gt22(0)) ne 0) then begin
widget_control,gbase,/destroy

case cara of
1:begin
napis1='6560.555'
napis2='6562.808'
napis3='6564.206'
end
2:begin
napis1='4859.747'
napis2='4861.342'
napis3='4862.598'
end
3:begin
napis1='6560.555'
napis2='6562.808'
napis3='6564.206' ;dodelat
end
endcase


ggbase=widget_base(/column)
ggbase2=widget_base(ggbase,/row)
ggdraw=widget_draw(ggbase2,xsize=400,ysize=400,/motion_events,uvalue='DRAW')
ggbase3=widget_base(ggbase2,/column)

lab=widget_label(ggbase3,value='Considered lines: '+napis1+', '+napis2+', '+napis3)
mezera=widget_base(ggbase3,ysize=20)
glab=widget_label(ggbase3,value='PEAK',/frame,/align_left)
ggt1=cw_field(ggbase3,title='1st x position')
ggt2=cw_field(ggbase3,title='2nd x position')
ggt3=cw_field(ggbase3,title='3rd x position')
hlab=widget_label(ggbase3,value='HALFWIDTH',/frame,/align_left)
hh1=cw_field(ggbase3,title='1st x position')
hh2=cw_field(ggbase3,title='2nd x position')
hh3=cw_field(ggbase3,title='3rd x position')
pos1=widget_label(ggbase3,value='POSITION',/frame,/align_left)
ppos2=widget_label(ggbase3,value='position',xsize=150)

ggbase1=widget_base(ggbase,/row)
gbut1=widget_button(ggbase1,value='OK',uvalue='OK')
gbut2=widget_button(ggbase1,value='CANCEL',uvalue='CAN')
widget_control,ggbase,/realize

kk=(y(fix(gt11(0)))-y(fix(gt22(0))))/(x(fix(gt11(0)))-x(fix(gt22(0))))
qq=y(fix(gt11(0)))- kk*x(fix(gt11(0)))
yy=(kk*x+qq)-y ; equalization?
neg_yy=where(yy lt 0) & yy(neg_yy)=0 ; negative points in equalized
; scan are put 0
widget_control,ggdraw,get_value=dr & wset,dr
plot,x,yy,yrange=[0,max(yy)+0.5*max(yy)],xstyle=1,ystyle=1
;obr=tvrd() & write_gif,'p2.gif',obr

xmanager,'ggaus',ggbase

endif else begin
chyba=widget_base()
chl=widget_label(chyba,value='Missing data')
widget_control,chyba,/realize
wait,2 & widget_control,chyba,/destroy
endelse

end
'CAN':begin
widget_control,event.top,/destroy
end

'DRAW':begin
coord=convert_coord(event.x,event.y,/device,/to_data) ;data coord.
iks=round(coord(0)) & ips=round(coord(1))
widget_control,pos2,set_value=STRCOMPRESS('('+string(iks)+','+string(ips)+')',/rem)
end
endcase
end

;--------------------------------------
pro gauss1,img,g_number
COMMON prof2,pole,profh,profw,profx,profy,prof,vysl
COMMON gau, pos2,gt1,gt2,gdraw,x,y,gbase
gbase=widget_base(/column)
gbase2=widget_base(gbase,/row)
gdraw=widget_draw(gbase2,xsize=400,ysize=400,/motion_events,uvalue='DRAW')
gbase3=widget_base(gbase2,/column)
glab=widget_label(gbase3,value='CONTINUUM LEVELS',/frame,/align_left)
gt1=cw_field(gbase3,title='1st x position')
gt2=cw_field(gbase3,title='2nd x position')
pos1=widget_label(gbase3,value='POSITION',/frame,/align_left)
pos2=widget_label(gbase3,value='position',xsize=150)
gbase1=widget_base(gbase,/row)
gbut1=widget_button(gbase1,value='OK',uvalue='OK')
gbut2=widget_button(gbase1,value='CANCEL',uvalue='CAN')
widget_control,gbase,/realize


x=img(*,0) & y=img(*,1) ;& n=g_number

c1=intarr(2) & c2=intarr(2) ; continuum equalization?

widget_control,gdraw,get_value=dr & wset,dr
plot,x,y,yrange=[0,max(y)+0.5*max(y)],xstyle=1,ystyle=1

;obr=tvrd() & write_gif,'p1.gif',obr
xmanager,'gaus',gbase

end
;-------------------------------------------------------------------------------------------------------
;-------------------------------------------------------------------------------------------------------

;-----------------rectangle---------------------------
PRO rectangle,xx,yy,sirka,vyska ;nakresli obdelnik
device,set_graphics=6
px=[xx,xx+sirka,xx+sirka,xx,xx]
py=[yy,yy,yy+vyska,yy+vyska,yy]
plots,px,py,/dev,thick=2,lines=0,color=!D.N_colors-1
empty
END

;-----------------quite profile (for integral and substract)----------
PRO spocitat,vyska,sirka,obrazek,xx,yy ;ulozeni chrom. profilu do vyslchrom
COMMON int1,vyslchrom,chrom
oblast=obrazek(xx:xx+sirka,yy:yy+vyska)
ips=make_array(sirka+1,value=0,/float)
for i=0,vyska-1 do ips=ips+oblast(*,i)
ips=ips/vyska
vyslchrom=ips
chrom=1
END

;--------------------profile---------------------------
PRO profile1,vyska,sirka,obrazek,xx,yy,co
COMMON prof2,pole,profh,profw,profx,profy,prof,vysl
COMMON zacat,jeobr,jeobd,jeprof,jeprof2,integral,fil,klidnyprof

oblast=obrazek(xx:xx+sirka,yy:yy+vyska) ;vybere oblast pro profil

if co eq 1 then begin ;1. profile
ips=make_array(sirka+1,value=0,/float)
for i=0,vyska-1 do ips=ips+oblast(*,i)
ips=ips/vyska
endif

if co eq 2 then begin ;2. profile
if fil ge 2 then ips=smooth(pole,fil) else ips=pole ;filtrovani

profh=vyska & profw=sirka & profx=xx & profy=yy & vysl=pole
;ulozeni vlastnosti profilu (pouzije se pri tvorbe profilu chrom. a pri write
jeprof2=1
endif

if co eq 3 then begin
if fil ge 2 then ips=smooth(vysl,fil) else ips=vysl ;replotting of 2nd profile (filtering)
endif

plot,ips
if co eq 1 then pole=ips ;ulozeni 1. profilu (used for plotting 2nd profile)
jeprof=1
END

;--------------------saving---------------------------
PRO uloz_event, event ;ulozeni pole p do souboru
COMMON jedna,base,f1,f2,f3,e1,e2,position,im,prof1,prof2,okno1,$
okno2,okno3,image1,width,height,box,minx,miny,minnx,minny,$
old,o1,o2,prof3,Hpozice,ozn1,ozn2,ozn3,ozn4,r1,c1,cwidth,prof4 ;procedura xlook
COMMON prof2,pole,profh,profw,profx,profy,prof,vysl ;procedura profile1
COMMON ulozeni,p,file,res
COMMON kalib,type2,aa,bb,cc,exist2
COMMON oblast,type1,w1,w2,w3,pos1,pos2,pos3,exist1,koef1,koef2,exist3,druhaexist,tretiexist
widget_control,event.id,get_uvalue=uvalue
case uvalue of
'NE': widget_control,widget_info(widget_info(event.id,/parent),/parent),/destroy
'ANO':begin
;--------------------writefits-----------------------
widget_control,file,get_value=soubor1
soubor=soubor1(0)
writefits,soubor+'.fts',p
;**************************
; openw,unit,soubor+'.dat',/get_lun
; for i=0,n_elements(p)/2-1 do printf,unit,p(i,0),p(i,1)
; free_lun,unit
;******************************
;---------------writing to tab.dat------------------
;soub=findfile('tab.dat',count=pocet)
;if pocet ne 0 then begin
openw,unit,'tab.dat',/get_lun
printf,unit,'width',profw
printf,unit,'height',profh
printf,unit,'x-pos',profx
printf,unit,'y-pos',profy
printf,unit,''
widget_control,prof4,get_value=integ1
printf,unit,'integral',float(integ1(0))
widget_control,prof3,get_value=integ2
if integ2(0) ne 'ratio' then printf,unit,'ratio of integrals',float(integ2(0))
printf,unit,''

if type2 eq 1 then begin
printf,unit,'calibration'
printf,unit,'a',aa
printf,unit,'b',bb
printf,unit,'c',cc
printf,unit,''
endif
if type1 eq 1 then begin
printf,unit,'dispersion curve'
printf,unit,'c1',res(0)
printf,unit,'c2',res(1)
endif
free_lun,unit
;endif

widget_control,widget_info(widget_info(event.id,/parent),/parent),/destroy

tab=widget_base(/column) ;400
zapsano=widget_label(tab,value='Profile has been saved as '+soubor+'.fts')
;if pocet ne 0 then $
zapsano2=widget_label(tab,value='Information about profile can be found in tab.dat.')
zap=widget_base(tab,/row)
widget_control,tab,/realize
wait,2
widget_control,tab,/destroy
end
endcase
END

;---------------------------region_event------------------------------
PRO region_event,event
COMMON oblast,type1,w1,w2,w3,pos1,pos2,pos3,exist1,koef1,koef2,exist3,druhaexist,tretiexist
COMMON inner,delka1,delka2,delka3,pix1,pix2,pix3,drop1,drop2,drop3,textkoef1,textkoef2
COMMON innerreg,pix,diskoef
widget_control,event.id,get_uvalue=uvalue
case uvalue of
'SLIT':begin
type1=0
widget_control,event.top,/destroy
druhaexist=0 & tretiexist=0
end
'LINE1':begin
type1=2 & tretiexist=1
if druhaexist eq 1 then widget_control,pix,/destroy
druhaexist=0
diskoef=widget_base(event.top,/column,/frame)
zesouboru=widget_button(diskoef,value='Extract the coefficients from *.cfs',uvalue='EXT')
zesouboru2=widget_button(diskoef,value='Extract the coefficients from coef.dat',uvalue='EXT2')
diskoef1=widget_base(diskoef,/row) & diskoef2=widget_base(diskoef,/row)
textkoef1=cw_field(diskoef1,title='c1')
textkoef2=cw_field(diskoef2,title='c2')
zavrit=widget_button(diskoef,value='OK',uvalue='CLOSE2')
if exist3 eq 1 then begin
widget_control,textkoef1,set_value=koef1
widget_control,textkoef2,set_value=koef2
endif
end
'LINE2':begin
if tretiexist eq 1 then widget_control,diskoef,/destroy
druhaexist=1 & tretiexist=0
pix=widget_base(event.top,/column,/frame)
nula=widget_base(pix,/row)
jedna=widget_base(pix,/row)
dva=widget_base(pix,/row)
tri=widget_base(pix,/row)
jedna1=widget_base(jedna,/row) & jedna2=widget_base(jedna,/row)
dva1=widget_base(dva,/row) & dva2=widget_base(dva,/row)
tri1=widget_base(tri,/row) & tri2=widget_base(tri,/row)

pix0=widget_label(nula,value='position',/align_left,xsize=170)
pix1=cw_field(jedna1,title=' ')
pix2=cw_field(dva1,title=' ')
pix3=cw_field(tri1,title=' ')

delka0=widget_label(nula,value='wavelength',/align_left)
delka1=cw_field(jedna2,title=' ')
delka2=cw_field(dva2,title=' ')
delka3=cw_field(tri2,title=' ')

drop1=widget_button(jedna2,value=' ',/menu)
dr12=widget_button(drop1,value='6562.808 H-alfa',uvalue='REST')
dr13=widget_button(drop1,value='6564.206 H2O',uvalue='REST')
dr14=widget_button(drop1,value='6560.555 H2O-SiI',uvalue='REST')
dr15=widget_button(drop1,value='6561.097 H2O',uvalue='REST')
drpom11=widget_button(drop1,value=' ',uvalue='DEL')
dr16=widget_button(drop1,value='8498.062 CaII',uvalue='REST')
dr17=widget_button(drop1,value='8496.994 FeI',uvalue='REST')
dr18=widget_button(drop1,value='8496.483 H2O',uvalue='REST')
drpom12=widget_button(drop1,value=' ',uvalue='DEL')
drop2=widget_button(dva2,value=' ',/menu)
dr22=widget_button(drop2,value='6562.808 H-alfa',uvalue='REST')
dr23=widget_button(drop2,value='6564.206 H2O',uvalue='REST')
dr24=widget_button(drop2,value='6560.555 H2O-SiI',uvalue='REST')
dr25=widget_button(drop2,value='6561.097 H2O',uvalue='REST')
drpom21=widget_button(drop2,value=' ',uvalue='DEL')
dr26=widget_button(drop2,value='8498.062 CaII',uvalue='REST')
dr27=widget_button(drop2,value='8496.994 FeI',uvalue='REST')
dr28=widget_button(drop2,value='8496.483 H2O',uvalue='REST')
drpom22=widget_button(drop2,value=' ',uvalue='DEL')
drop3=widget_button(tri2,value=' ',/menu)
dr32=widget_button(drop3,value='6562.808 H-alfa',uvalue='REST')
dr33=widget_button(drop3,value='6564.206 H2O',uvalue='REST')
dr34=widget_button(drop3,value='6560.555 H2O-SiI',uvalue='REST')
dr35=widget_button(drop3,value='6561.097 H2O',uvalue='REST')
drpom31=widget_button(drop3,value=' ',uvalue='DEL')
dr36=widget_button(drop3,value='8498.062 CaII',uvalue='REST')
dr37=widget_button(drop3,value='8496.994 FeI',uvalue='REST')
dr38=widget_button(drop3,value='8496.483 H2O',uvalue='REST')
drpom32=widget_button(drop3,value=' ',uvalue='DEL')

zavrit=widget_button(pix,value='OK',uvalue='CLOSE')

widget_control,drpom11,sensitive=0 & widget_control,drpom12,sensitive=0
widget_control,drpom21,sensitive=0 & widget_control,drpom22,sensitive=0
widget_control,drpom31,sensitive=0 & widget_control,drpom32,sensitive=0

if exist1 eq 1 then begin
widget_control,delka1,set_value=string(w1) & widget_control,delka2,set_value=w2
widget_control,delka3,set_value=w3
widget_control,pix1,set_value=string(pos1) & widget_control,pix2,set_value=pos2
widget_control,pix3,set_value=pos3
endif
end

'CLOSE':begin
widget_control,delka1,get_value=w1 & widget_control,delka2,get_value=w2
widget_control,delka3,get_value=w3
widget_control,pix1,get_value=pos1 & widget_control,pix2,get_value=pos2
widget_control,pix3,get_value=pos3
exist1=1 & type1=1
druhaexist=0 & tretiexist=0
widget_control,event.top,/destroy
end
'DEL':begin
end
'CLOSE2':begin
widget_control,textkoef1,get_value=koef1 & widget_control,textkoef2,get_value=koef2
widget_control,event.top,/destroy
exist3=1 & druhaexist=0 & tretiexist=0
end
'EXT2':begin
openr,unit,'coef.dat',/get_lun
k=fltarr(2)
readf,unit,k
free_lun,unit
widget_control,textkoef1,set_value=k(0)
widget_control,textkoef2,set_value=k(1)
end

'EXT':begin
cesta=pickfile(/read,filter='*.cfs')
openr,unit,cesta,/get_lun
akoef='' & bkoef='' & ckoef='' & c1koef='' & c2koef=''
readf,unit,akoef,bkoef,ckoef,c1koef,c2koef
free_lun,unit
c1koef=strmid(strcompress(c1koef),2,strlen(strcompress(c1koef))-2)
c2koef=strmid(strcompress(c2koef),2,strlen(strcompress(c2koef))-2)
ckoef=strmid(strcompress(ckoef),2,strlen(strcompress(ckoef))-2)
widget_control,textkoef1,set_value=c1koef
widget_control,textkoef2,set_value=c2koef
end
else: begin
widget_control,event.id,get_value=pom
widget_control,widget_info(widget_info(widget_info(event.id,/parent),/parent),/child),set_value=strmid(pom,0,8)
end


endcase
END

;-----------------------------calib_event---------------------------
PRO calib_event,event
COMMON kalib,type2,aa,bb,cc,exist2
COMMON inner2,c1,c2,c3
widget_control,event.id,get_uvalue=uvalue
case uvalue of
'NOCAL':begin
type2=0
widget_control,event.top,/destroy
end
'YESCAL':begin
koef=widget_base(event.top,/column,/frame)
zesouboru=widget_button(koef,value='Extract the coefficient from *.cfs',uvalue='EXT')
koef1=widget_base(koef,/row) & koef2=widget_base(koef,/row)
koef3=widget_base(koef,/row)
c1=cw_field(koef1,title='a') & c2=cw_field(koef2,title='b')
c3=cw_field(koef3,title='c')
but=widget_button(koef,value='OK',uvalue='CLOSE')
if exist2 eq 1 then begin
widget_control,c1,set_value=aa & widget_control,c2,set_value=bb & widget_control,c3,set_value=cc
endif
end
'EXT':begin
cesta=pickfile(/read,filter='*.cfs')
openr,unit,cesta,/get_lun
akoef='' & bkoef='' & ckoef=''
readf,unit,akoef,bkoef,ckoef
free_lun,unit
akoef=strmid(strcompress(akoef),2,strlen(strcompress(akoef))-2)
bkoef=strmid(strcompress(bkoef),2,strlen(strcompress(bkoef))-2)
ckoef=strmid(strcompress(ckoef),2,strlen(strcompress(ckoef))-2)
widget_control,c1,set_value=akoef & widget_control,c2,set_value=bkoef
widget_control,c3,set_value=ckoef
end
'CLOSE':begin
widget_control,c1,get_value=aa & widget_control,c2,get_value=bb & widget_control,c3,get_value=cc
exist2=1 & type2=1
widget_control,event.top,/destroy
end
endcase
END

;-------------------------saving of substract profile-------------------
pro docasne_event,event
COMMON zacat,jeobr,jeobd,jeprof,jeprof2,integral,fil,klidnyprof ;procedura xlook,profile1
COMMON rozdil,docasprof,docasx,docasnecw
widget_control,event.id,get_uvalue=uvalue
case uvalue of
'NE':begin
klidnyprof=0
widget_control,event.top,/destroy
end

'ANO':begin
emise=fltarr(n_elements(docasx),2)
emise(*,0)=docasx & emise(*,1)=docasprof
widget_control,docasnecw,get_value=soubor
writefits,soubor(0)+'.fts',emise
klidnyprof=0
widget_control,event.top,/destroy
end
endcase
end

;-------------------------store profile to variable kam-----------------------
PRO spocti,vyska,sirka,obrazek,xx,yy,kam ;ulozeni chrom. profilu do vyslchrom
oblast=obrazek(xx:xx+sirka,yy:yy+vyska)
ips=make_array(sirka+1,value=0,/float)
for i=0,vyska-1 do ips=ips+oblast(*,i)
ips=ips/vyska
kam=ips
END

;--------------------------make substract profile-----------------------------
pro position_event,event
COMMON foto2,rozmer
COMMON rozdil,docasprof,docasx,docasnecw
COMMON kalib,type2,aa,bb,cc,exist2
COMMON oblast,type1,w1,w2,w3,pos1,pos2,pos3,exist1,koef1,koef2,exist3,druhaexist,tretiexist
COMMON zacat,jeobr,jeobd,jeprof,jeprof2,integral,fil,klidnyprof ;procedura xlook,profile1
COMMON odecet,xroz1,xroz2,ypozice1,ypozice2,kolikprof
COMMON jedna,base,f1,f2,f3,e1,e2,position,im,prof1,prof2,okno1,$
okno2,okno3,image1,width,height,box,minx,miny,minnx,minny,$
old,o1,o2,prof3,Hpozice,ozn1,ozn2,ozn3,ozn4,r1,c1,cwidth,prof4 ;procedura xlook

widget_control,event.id,get_uvalue=uvalue
case uvalue of
'ANO':begin

widget_control,xroz1,get_value=xroz11 & widget_control,xroz2,get_value=xroz22
widget_control,ypozice1,get_value=ypos11 & widget_control,ypozice2,get_value=ypos22
widget_control,kolikprof,get_value=kolik2
widget_control,event.top,/destroy
ww1=float(w1(0)) & ww2=float(w2(0)) & ww3=float(w3(0))
ppos1=float(pos1(0)) & ppos2=float(pos2(0)) & ppos3=float(pos3(0))
aaa=float(aa(0)) & bbb=float(bb(0)) & ccc=float(cc(0))
kk1=float(koef1(0)) & kk2=float(koef2(0))

sxroz11=fix(xroz11(0)) & sxroz22=fix(xroz22(0)) & sypos11=fix(ypos11(0))
sypos22=fix(ypos22(0)) & skolik2=fix(kolik2(0))

if ((sxroz11 gt 0) and (sxroz22 gt 0) and (sypos11 gt 0) and (sypos22 gt 0) and (skolik2 gt 0) and $
(sxroz11 lt sxroz22) and (sxroz11 lt rozmer(1)) and (sxroz22 lt rozmer(1)) and (sypos11 lt rozmer(2)) and (sypos22 lt rozmer(2))) and $
(((type2 eq 0) or ((type2 eq 1) and (aaa ne 0) and (bbb ne 0) and (ccc ne 0))) $
and ((type1 eq 0) or ((type1 eq 2) and (kk1 ne 0) and (kk2 ne 0)) or $
((type1 eq 1) and (ww1 ne 0) and (ww2 ne 0) and (ppos1 ne 0) and (ppos2 ne 0)))) then begin

spocti,skolik2,sxroz22-sxroz11+1,image1,sxroz11,sypos11,docas1
spocti,skolik2,sxroz22-sxroz11+1,image1,sxroz11,sypos22,docas2

docasne=widget_base(/column) ;...obrazek emise a ulozeni do fts
docasnedraw=widget_draw(docasne,xsize=400,ysize=400)
docasnecw=cw_field(docasne,title=' ')
docasnebase=widget_base(docasne,/row)
docasnebut1=widget_button(docasnebase,value='SAVE',uvalue='ANO')
docasnebut2=widget_button(docasnebase,value='CANCEL',uvalue='NE')
widget_control,docasne,/realize
widget_control,docasnedraw,get_value=okno5
xmanager,'docasne',docasne


if (type2 eq 1) then begin
for i=0,n_elements(docas1)-1 do begin
docas1(i)=aaa*(docas1(i)^bbb)+ccc
docas2(i)=aaa*(docas2(i)^bbb)+ccc
endfor
endif

if fil ge 2 then docasprof=smooth(docas1-docas2,fil) else docasprof=docas1-docas2
docasx=findgen(n_elements(docas1))

if (type1 eq 1) then begin ;pokud line (disperzni krivka)
if (ww3 eq 0) or (ppos3 eq 0) then begin
pole1=make_array(2,/float) & pole2=make_array(2,/float)
endif else begin
pole1=make_array(3,/float) & pole2=make_array(3,/float)
pole1(2)=ppos3-sxroz11 & pole2(2)=ww3
endelse
pole1(0)=ppos1-sxroz11 & pole1(1)=ppos2-sxroz11
pole2(0)=ww1 & pole2(1)=ww2
res=poly_fit(pole1,pole2,1) ;vypocet disperzni krivky y=res(0)+res(1)*x
for i=0,n_elements(docas1)-1 do docasx(i)=res(0)+res(1)*(i) ;disperze
endif

if (type1 eq 2) then for i=0,n_elements(docas1)-1 do docasx(i)=kk1+kk2*(i)+kk2*sxroz11


wset,okno5 & plot,docasx,docasprof

endif else begin
chybabase=widget_base(/column)
chybalabel=widget_label(chybabase,value='Missing some data or data incorrect!')
widget_control,chybabase,/realize
wait,2 & widget_control,chybabase,/destroy
endelse
end
'NE':widge