FUNCTION CW_FloatParam_Event,Event Event.id=Widget_Info(Event.id,/parent) return,Event END PRO CW_FloatParam_SET,id,value widget_control,widget_info(id,/child),get_uvalue=info valuet=float(value) if finite(info.minmax[0]) then valuet >= info.minmax[0] if finite(info.minmax[1]) then valuet <= info.minmax[1] widget_control,info.text,set_value=strtrim(valuet,2) END FUNCTION CW_FloatParam_GET,id widget_control,widget_info(id,/child),get_uvalue=info widget_control,info.text,get_value=value return,float(value) END FUNCTION CW_FloatParam, Parent, COLUMN=Column, ROW=Row, FRAME=Frame, TITLE=Title, UVALUE=UValue, VALUE=Value, $ RETURN_EVENTS=ReturnEvents, ALL_EVENTS=AllEvents, kbrd_focus_events=kbrd_focus_events, NOEDIT=NoEdit, $ XSIZE=XSize, YSIZE=YSize,Minimum=minimum,Maximum=maximum if n_elements(minimum) eq 0 then minimum=!values.f_nan if n_elements(maximum) eq 0 then maximum=!values.f_nan MinMax=[float(minimum[0]),float(maximum[0])] Base=WIDGET_BASE(Parent, ROW=Row, COLUMN=Column, UVALUE=UValue, $ PRO_SET_VALUE='CW_FloatParam_SET', $ FUNC_GET_VALUE='CW_FloatParam_GET', $ FRAME=Frame) if strlen(Title) gt 0 then Label=WIDGET_LABEL(Base, VALUE=Title) Text=WIDGET_TEXT(Base, XSIZE=XSize, YSIZE=YSize, $ ALL_EVENTS=AllEvents, Event_Func='CW_FloatParam_Event',$ EDITABLE=keyword_set(NoEdit) eq 0, kbrd_focus_events=kbrd_focus_events) Widget_Control,Widget_Info(Base,/child),set_uvalue={Text:Text,MinMax:MinMax} Widget_Control,Base,Set_Value=Value return,Base END FUNCTION ReplicateVector,values,n ;nova versao!!!! res=make_array(total(n,/double),type=size(values,/type),/nozero) k=0l for i=0l,n_elements(values)-1 do begin if n[i] eq 0 then continue res[k:k+n[i]-1]=values[i] k+=n[i] endfor return,res END FUNCTION Cramer2,A,B DetermA=DETERM(A,/Double,/Check) n=(size(A))[1] res=dblarr(n) for i=0l,n-1 do begin temp=A[i,*] A[i,*]=B res[i]=DETERM(A,/Double,/Check)/DetermA A[i,*]=temp endfor return,res END FUNCTION ACORR,x,lag,series=series n=n_elements(x) if n_elements(series) eq 0 then series=bytarr(n) nvalues=long(total(~finite(x,/nan))) nLag=n_elements(lag) res=replicate(!values.f_nan,nLag) xt=x-(total(x,/nan)/nvalues) ;Compute Autocovariance. M=abs(lag) nLag <= n_elements(xt) for k=0l,nLag-1 do begin xt2=[[xt[0:n-1-M[k]]],[xt[M[k]:*]]] temp=where(series[0:n-1-M[k]] eq series[M[k]:*]) if temp[0] eq -1 then break xt2=xt2[temp,*] res[k]=total(xt2[*,0]*xt2[*,1],/nan) endfor return,res/total(xt^2,/nan) end FUNCTION PNT_POLYLINE,P0,L0,PL=PL,D=D ;P0 (2 x 1) point ;L0 (2 x n) polyline ;PL (2 x 1) point on segment iseg ;return iseg n=n_elements(L0)/2 lv = float(L0[*,1:*] - L0) l = sqrt(total(lv*lv,1)) lv = lv / (replicate(1,2)#l) ;Normal to line t = - (-total(lv * (p0#replicate(1,n-1)),1) + total(L0[*,0:n-2] * lv,1))/(total(lv * lv,1)) pl = (replicate(1,2)#t) * lv + L0[*,0:n-2] ;Closest point on line out = (t lt 0) or (t gt l) ;Within interval? iseg=where(out eq 0) d=-1 if iseg[0] ne -1 then begin d=min(sqrt(total(((p0#replicate(1,n_elements(iseg))) - pl[*,iseg])^2,1)),i) iseg=iseg[i] endif else temp=temporary(pl) return,iseg[0] END PRO Cw_Counter_Set,Base,Value Widget_Control,Widget_Info(Base,/Child),Get_Uvalue=info info.Value=(Value > info.MinMax[0]) < info.MinMax[1] Widget_Control,Widget_Info(Base,/Child),Set_Uvalue=info Widget_Control,info.Field,Set_Value=strcompress(info.value,/rem) ;,Set_Text_Select=[0,1000] END FUNCTION Cw_Counter_Get,Base Widget_Control,Widget_Info(Base,/Child),Get_Uvalue=info return,info.value END FUNCTION Cw_Counter_Event,Event Widget_Control,Event.id,Get_Uvalue=Base Widget_Control,Base,Get_Uvalue=info if (Event.id eq info.Button[0]) or (Event.id eq info.Button[1]) then begin if Event.id eq info.Button[0] then info.value++ else info.value-- info.value >= info.MinMax[0] info.value <= info.MinMax[1] endif else begin Widget_Control,Event.id,Get_Value=temp info.value=(long(temp) > info.MinMax[0]) < info.MinMax[1] endelse Widget_Control,info.Field,Set_Value=strcompress(info.value,/rem),/Input_Focus ;,Set_Text_Select=[0,1000] Widget_Control,Base,Set_Uvalue=info return,{CW_COUNTER,ID:info.ID,TOP:info.Top,HANDLER:info.Handler,Value:info.value} END FUNCTION Cw_Counter,Parent,Editable=Editable,Xsize=Xsize,Frame=Frame,Title=Title,Minimum=Minimum,Maximum=Maximum,Value=Value,Uvalue=Uvalue if n_elements(Minimum) eq 0 then Minimum=-2147483647l if n_elements(Maximum) eq 0 then Maximum=2147483647l if n_elements(Value) eq 0 then Value=0l BaseP=Widget_Base(Parent,Pro_Set_Value='Cw_Counter_Set',Func_Get_Value='Cw_Counter_Get',Uvalue=Uvalue) Base=Widget_Base(BaseP,Frame=Frame,/Row) if n_elements(Title) then Label=Widget_Label(Base,Value=Title) Field=Widget_Text(Base,Xsize=Xsize,Editable=Editable,Event_Func='Cw_Counter_Event',Uvalue=Base,Value=strcompress(Value,/rem)) Base2=Widget_Base(Base,Ysize=26) Bplus=Widget_Button(Base2,Value='+',Xsize=13,Ysize=13,Event_Func='Cw_Counter_Event',Uvalue=Base) Bminus=Widget_Button(Base2,Value='-',Xsize=13,Ysize=13,Event_Func='Cw_Counter_Event',Yoffset=13,Uvalue=Base) Top=Base while Widget_Info(Top,/Parent) ne 0 do Top=Widget_Info(Top,/Parent) Widget_Control,Base,Set_Uvalue={Top:Top,Handler:Parent,ID:BaseP,Value:Value,Field:Field,Button:[Bplus,Bminus],MinMax:[Minimum,Maximum]} return,BaseP END PRO CW_FIELD2_SET,Base,Value Widget_Control,Base,Get_Uvalue=uvalue Widget_Control,uvalue.Field,Set_Value=fix(Value) if uvalue.Slider ne -1 then Widget_Control,uvalue.Slider,Set_Value=Value uvalue.Value=Value Widget_Control,Base,Set_Uvalue=uvalue END FUNCTION CW_FIELD2_GET,Base Widget_Control,Base,Get_Uvalue=uvalue return,uvalue.Value END FUNCTION CW_FIELD2_EVENT,Event Widget_Control,Event.Handler,get_uvalue=uvalue Case Event.id of uvalue.Field:begin uvalue.Value=(Event.Value > uvalue.min) < uvalue.max end uvalue.Slider:begin uvalue.Value=Event.Value end EndCase Widget_Control,uvalue.Field,Set_Value=uvalue.Value if uvalue.Slider ne -1 then Widget_Control,uvalue.Slider,Set_Value=uvalue.Value Widget_Control,Event.Handler,set_uvalue=uvalue return,{ID:Event.Handler,TOP:Event.Top,HANDLER:0L,VALUE:uvalue.Value} END FUNCTION CW_Field2,Parent,min=minimum,max=maximum,xsize=xsize,frame=frame,title=title,value=value,integer=integer,float=float,noslider=noslider Base=WIDGET_BASE(Parent,/Row,EVENT_FUNC='CW_FIELD2_EVENT',PRO_SET_VALUE='CW_FIELD2_SET',FUNC_GET_VALUE='CW_FIELD2_GET',FRAME=Frame) Field=Cw_Field(Base,integer=integer,float=float,Value=value,/Row,title=title,xsize=xsize,/return_events) noslider=keyword_set(noslider) if noslider ne 0 then Slider=-1l else $ Slider=Widget_Slider(Base,min=minimum,max=maximum,/Vert,/Suppr,Ysize=30,/drag) Widget_Control,Base,Set_Uvalue={Field:Field,Slider:Slider,Min:minimum[0],Max:maximum[0],Value:value[0]} return,Base END FUNCTION color_choose,color_input,cancel=cancelb,rgb=rgb cancelb=0b if keyword_set(rgb) then begin rcolor=(color_input[0] > 0) < 255 gcolor=(color_input[1] > 0) < 255 bcolor=(color_input[2] > 0) < 255 color=rcolor+gcolor*256l+bcolor*65536l endif else begin color=(color_input > 0) < 16777215l rcolor=color mod 256 temp=(color-rcolor)/256 gcolor=temp mod 256 bcolor=temp/256 endelse color_convert,rcolor,gcolor,bcolor,hcolor,lcolor,scolor,/rgb_hls hcolor=fix(hcolor) scolor=fix(scolor*255) lcolor=fix(lcolor*255) Base=Widget_Base(/Column,Title='Colors') Base1=Widget_Base(Base,/Row,/Frame) dsize=250 D1=Widget_Draw(Base1,Xsize=dsize,Ysize=dsize,Retain=2,/Button_Events) Label=Widget_Label(Base1,Value=' ') D2=Widget_Draw(Base1,Xsize=dsize/10,Ysize=dsize,Retain=2,/Button_Events) Base2=Widget_Base(Base,/Row,/Frame) Base2B=Widget_Base(Base2,/Column) RW=CW_Field2(Base2B,min=0,max=255,xsize=3,title='R ',Value=rcolor,/Integer) GW=CW_Field2(Base2B,min=0,max=255,xsize=3,title='G ',Value=gcolor,/Integer) BW=CW_Field2(Base2B,min=0,max=255,xsize=3,title='B ',Value=bcolor,/Integer) Base2C=Widget_Base(Base2,/Column) HW=CW_Field2(Base2C,min=0,max=255,xsize=3,title='H ',Value=hcolor,/Integer) SW=CW_Field2(Base2C,min=0,max=255,xsize=3,title='S ',Value=scolor,/Integer) LW=CW_Field2(Base2C,min=0,max=255,xsize=3,title='L ',Value=lcolor,/Integer) Base2C=Widget_Base(Base2,/Column) D3=Widget_Draw(Base2C,Xsize=55,Ysize=55,Retain=2) D4=Widget_Draw(Base2C,Xsize=55,Ysize=55,Retain=2) Base3=Widget_Base(Base,/Row,/Frame) OK=Widget_Button(Base3,Value='OK',Xsize=70) Cancel=Widget_Button(Base3,Value='Cancel',Xsize=70) Widget_Control,Base,/Realize hue=((findgen(dsize)/(dsize-1))#replicate(1,dsize))*360 sat=transpose(hue)/360 lum=replicate(.5,dsize,dsize) color_convert,hue,lum,sat,r,g,b,/hls_rgb Widget_Control,D1,Get_Value=w1 Wset,w1 tv,[[[r]],[[g]],[[b]]],true=3,order=0 lum2=(findgen(dsize)/(dsize-1))##replicate(1,dsize/10) Widget_Control,D2,Get_Value=w2 Widget_Control,D3,Get_Value=w3 Widget_Control,D4,Get_Value=w4 cruzx=[-10,-1,-1,1,1,10,10,1,1,-1,-1,-10,-10] cruzy=[1,1,10,10,1,1,-1,-1,-10,-10,-1,-1,1] sel=bytarr(3) temp=abs(hue[*,0]-fix(hcolor)) sel[0]=(where(temp eq min(temp)))[0] temp=abs(sat[0,*]-scolor/255.) sel[1]=(where(temp eq min(temp)))[0] temp=abs(lum2[0,*]-lcolor/255.) sel[2]=(where(temp eq min(temp)))[0] colorsel=color Wset,w3 Erase,color While Widget_Info(Base,/Valid_Id) eq 1 do begin Wset,w1 plots,cruzx+sel[0],cruzy+sel[1],color=0,/device hue2=replicate(hue[sel[0],sel[1]],dsize/10,dsize) sat2=replicate(sat[sel[0],sel[1]],dsize/10,dsize) Wset,w2 color_convert,hue2,lum2,sat2,r2,g2,b2,/hls_rgb tv,[[[r2]],[[g2]],[[b2]]],true=3,order=0 plots,[0,dsize/10],[sel[2],sel[2]],color=0,/device,thick=3 Wset,w4 colorsel=r2[0,sel[2]]+(g2[0,sel[2]]+b2[0,sel[2]]*256l)*256l Erase,colorsel Event=Widget_Event(Base,bad_id=bad_id) ;gera eventos das widgets if (Event.id eq OK) or (Event.id eq Cancel) or (bad_id ne 0) then begin cancelb=bad_id ne 0 if cancelb then return,color_input Widget_Control,Base,/Destroy cancelb=Event.id eq Cancel if cancelb then colorsel=color if keyword_set(rgb) then begin rcolor=colorsel mod 256 temp=(colorsel-rcolor)/256 gcolor=temp mod 256 bcolor=temp/256 colorsel=byte([rcolor,gcolor,bcolor]) endif return,colorsel endif Case Event.id of D1:begin if Event.Press eq 0 then break wset,w1 tv,[[[r]],[[g]],[[b]]],true=3,order=0 sel=[Event.x,Event.y,124] ;sel[2]] end D2:begin if Event.Press eq 0 then break sel[2]=Event.y end Else:begin if (Event.id eq RW) or (Event.id eq GW) or (Event.id eq BW) then begin Widget_Control,RW,Get_Value=rwt Widget_Control,GW,Get_Value=gwt Widget_Control,BW,Get_Value=bwt color_convert,rwt,gwt,bwt,hcolor,lcolor,scolor,/rgb_hls hcolor=fix(hcolor) scolor=round(scolor*255) lcolor=round(lcolor*255) Widget_Control,HW,Set_Value=hcolor Widget_Control,SW,Set_Value=scolor Widget_Control,LW,Set_Value=lcolor endif else begin Widget_Control,HW,Get_Value=hcolor Widget_Control,SW,Get_Value=scolor Widget_Control,LW,Get_Value=lcolor color_convert,hcolor,lcolor/255.,scolor/255.,rwt,gwt,bwt,/hls_rgb Widget_Control,RW,Set_Value=rwt Widget_Control,GW,Set_Value=gwt Widget_Control,BW,Set_Value=bwt endelse temp=abs(hue[*,0]-fix(hcolor)) sel[0]=(where(temp eq min(temp)))[0] temp=abs(sat[0,*]-scolor/255.) sel[1]=(where(temp eq min(temp)))[0] temp=abs(lum2[0,*]-lcolor/255.) sel[2]=(where(temp eq min(temp)))[0] wset,w1 tv,[[[r]],[[g]],[[b]]],true=3,order=0 end EndCase if (Event.id eq D1) or (Event.id eq D2) then begin Widget_Control,RW,Set_Value=r2[0,sel[2]] Widget_Control,GW,Set_Value=g2[0,sel[2]] Widget_Control,BW,Set_Value=b2[0,sel[2]] Widget_Control,HW,Set_Value=hue2[0,sel[2]] Widget_Control,SW,Set_Value=round(sat2[0,sel[2]]*255) Widget_Control,LW,Set_Value=round(lum2[0,sel[2]]*255) endif wset,w2 tv,[[[r2]],[[g2]],[[b2]]],true=3,order=0 EndWhile END FUNCTION registra,quadro,dado dado2=double(dado) x=[[1d,1,1,1],[transpose(quadro[0,0:3])],[transpose(quadro[1,0:3])]] x=transpose([[x],[x[*,1]*x[*,2]]]) y=transpose([0d,1,1,0]) b=invert(transpose(x)##x)##(transpose(x)##y) polig2=double(quadro) polig2[0,*]=b[0]+b[1]*quadro[0,*]+b[2]*quadro[1,*]+$ b[3]*quadro[0,*]*quadro[1,*] dado2[0,*]=b[0]+b[1]*dado[0,*]+b[2]*dado[1,*]+$ b[3]*dado[0,*]*dado[1,*] y=transpose([0d,0,1,1]) b=invert(transpose(x)##x)##(transpose(x)##y) polig2[1,*]=b[0]+b[1]*quadro[0,*]+b[2]*quadro[1,*]+$ b[3]*quadro[0,*]*quadro[1,*] dado2[1,*]=b[0]+b[1]*dado[0,*]+b[2]*dado[1,*]+$ b[3]*dado[0,*]*dado[1,*] return,dado2 end FUNCTION acorr_exp,Lc COMMON acorr_exp_common,lagc,acorrc erro=total((acorrc-exp(-sqrt(2)*lagc/Lc[0]))^2) for i=1l,n_elements(Lc)-1 do erro=[erro,total((acorrc-exp(-sqrt(2)*lagc/Lc[i]))^2)] return,erro END PRO Roughness_Sensitive,Sensitive=Sensitive,Layer=Layer,Reference=Reference,Profiles=Profiles,Tendency=Tendency,Analysis=Analysis COMMON Roughness_COMMON,info,infodata,coefs if n_elements(info) eq 0 then return if n_elements(Sensitive) eq 0 then Sensitive=1 if keyword_set(Sensitive) then begin Widget_Control,info.Control.RefBox.Height,Get_UValue=hbox Widget_Control,info.Control.RefBox.Width,Get_UValue=wbox flag=hbox[infodata.i] gt 0 if flag ne 0 then flag=wbox[infodata.i] gt 0 Widget_Control,info.Control.Prof.id,Get_Uvalue=profs if flag ne 0 then begin if n_elements(profs) ne 0 then flag=(where(profs.layer eq infodata.i))[0] ne -1 else flag=0 endif ; Widget_Control,info.Control.Analysis.Refresh,Sensitive=((min([hbox,wbox]) gt 0) and (n_elements(profs) ne 0)) if keyword_set(Layer) then begin Widget_Control,info.Control.Layer,/Sensitive Widget_Control,info.Control.Delete,Sensitive=n_elements(infodata.fileimg) gt 1 endif if keyword_set(Reference) then begin Widget_Control,info.Control.RefBox.id,/Sensitive Widget_Control,info.Control.RefBox.height,/Sensitive Widget_Control,info.Control.RefBox.width,/Sensitive Widget_Control,info.Control.RefBox.savepic,Sensitive=(hbox[infodata.i] < wbox[infodata.i]) gt 0 endif if keyword_set(Profiles) then begin Widget_Control,info.Control.Prof.id,Sensitive=1 Widget_Control,info.Control.Prof.Operprof,Sensitive=0 Widget_Control,info.Control.Prof.Operpoint,Sensitive=0 endif if keyword_set(Tendency) then begin Widget_Control,info.Control.Tendency.angle,Sensitive=flag Widget_Control,info.Control.Tendency.estimate,Sensitive=flag endif if keyword_set(Analysis) then begin Widget_Control,info.Control.Analysis.horsampl,/Sensitive Widget_Control,info.Control.Analysis.rms,/Sensitive Widget_Control,info.Control.Analysis.rmsdetails,Get_Uvalue=temp Widget_Control,info.Control.Analysis.rmsdetails,Sensitive=n_elements(temp) ne 0 Widget_Control,info.Control.Analysis.lc,/Sensitive Widget_Control,info.Control.Analysis.lcdetails,Get_Uvalue=temp Widget_Control,info.Control.Analysis.lcdetails,Sensitive=n_elements(temp) ne 0 flag=n_elements(profs) ne 0 if flag ne 0 then flag=min([hbox[profs.layer],wbox[profs.layer]]) gt 0 Widget_Control,info.Control.Analysis.refresh,Sensitive=flag endif endif else begin if keyword_set(Layer) then begin Widget_Control,info.Control.Layer,Sensitive=0 Widget_Control,info.Control.Delete,Sensitive=0 endif if keyword_set(Reference) then begin Widget_Control,info.Control.RefBox.id,Sensitive=0 Widget_Control,info.Control.RefBox.height,Sensitive=0 Widget_Control,info.Control.RefBox.width,Sensitive=0 Widget_Control,info.Control.RefBox.savepic,Sensitive=0 endif if keyword_set(Profiles) then begin Widget_Control,info.Control.Prof.id,Sensitive=0 Widget_Control,info.Control.Prof.Operprof,Sensitive=0 Widget_Control,info.Control.Prof.Operpoint,Sensitive=0 endif if keyword_set(Tendency) then begin Widget_Control,info.Control.Tendency.angle,Sensitive=0 Widget_Control,info.Control.Tendency.estimate,Sensitive=0 ;,Get_Uvalue=temp ; if Widget_Info(temp,/Valid) then Widget_Control,temp,/Destroy endif if keyword_set(Analysis) then begin Widget_Control,info.Control.Analysis.horsampl,Sensitive=0 Widget_Control,info.Control.Analysis.rms,Sensitive=0 Widget_Control,info.Control.Analysis.rmsdetails,Sensitive=0 Widget_Control,info.Control.Analysis.lc,Sensitive=0 Widget_Control,info.Control.Analysis.lcdetails,Sensitive=0 Widget_Control,info.Control.Analysis.refresh,Sensitive=0 endif endelse END PRO Roughness_Save,file COMMON Roughness_COMMON,info,infodata,coefs if n_elements(file) eq 0 then begin if infodata.fileprd ne '' then file=infodata.fileprd file=Dialog_PickFile(/Write,Filter=['*.prd'],get_path=path,/overwrite,file=file) if file eq '' then return cd,path if strupcase(strmid(file,3,/rev)) ne '.PRD' then begin file=file+'.prd' res=File_Info(file) if res.exists ne 0 then begin res=Dialog_Message([file+' already exists.','Do you want to replace it?'],/Cancel,Title='Please Select a File for Writing') if res ne 'OK' then returns endif endif infodata.fileprd=file endif openw,fid,file,/get_lun printf,fid,n_elements(infodata.fileimg) Widget_Control,info.Control.RefBox.id,Get_Uvalue=xybox Widget_Control,info.Control.RefBox.Height,Get_UValue=hbox Widget_Control,info.Control.RefBox.Width,Get_UValue=wbox Widget_Control,info.Control.Prof.id,Get_Uvalue=profs Widget_Control,info.Control.Tendency.Angle,Get_Uvalue=angle Widget_Control,info.Control.Analysis.HorSampl,Get_Value=horsampl Widget_Control,info.Control.Analysis.RMS,Get_Value=RMS Widget_Control,info.Control.Analysis.Lc,Get_Value=Lc for k=0l,n_elements(infodata.fileimg)-1 do begin printf,fid,infodata.fileimg[k] printf,fid,xybox[*,*,k] printf,fid,hbox[k] printf,fid,wbox[k] if n_elements(profs) ne 0 then begin psel=where(profs.layer eq k) if psel[0] ne -1 then begin printf,fid,n_elements(psel) temp=[0,long(total(profs.npts,/cum))] for i=0l,n_elements(psel)-1 do begin printf,fid,profs.npts[psel[i]] printf,fid,profs.xy[*,temp[psel[i]]:temp[psel[i]+1]-1] endfor endif else printf,fid,0 endif else printf,fid,0 printf,fid,angle[k] endfor printf,fid,horsampl printf,fid,RMS printf,fid,Lc free_lun,fid END PRO Roughness_Kill,Base COMMON Roughness_COMMON,info,infodata,coefs Widget_Control,Base,Get_Uvalue=Baset if Widget_Info(Baset,/Valid) then Widget_Control,Baset,/Destroy ; if n_elements(infodata) ne 0 then begin ; if infodata.saved eq 0 then begin ; res=Dialog_Message(['In memory data have changed.','Do you want to save the changes?'],/Question) ; if res eq 'Yes' then Roughness_Save ; endif ; temp=temporary(infodata) ; endif if n_elements(infodata) ne 0 then temp=temporary(infodata) if n_elements(info) ne 0 then temp=temporary(info) END FUNCTION Roughness_LoadImage,fileimg img=Read_Image(fileimg,r,g,b) if img[0] eq -1 then begin res=Dialog_Message('erro ao abrir arquivo!',/Error) return,-1 endif if (size(img,/n_dim) eq 2) and (n_elements(r) ne 0) then begin stop endif return,transpose(temporary(img),[1,2,0]) END PRO Roughness_View,Base COMMON Roughness_COMMON,info,infodata,coefs geom=Widget_Info(info.Main.Draw,/Geometry) temp=long(([geom.xsize,geom.ysize]/info.Control.factor) > 3) if (temp[0] ge infodata.ns[infodata.i]) or (temp[1] ge infodata.nl[infodata.i]) then begin temp[0] <= (infodata.ns[infodata.i]-1) temp[1] <= (infodata.nl[infodata.i]-1) Widget_Control,info.Main.Draw,Xsize=temp[0],Ysize=temp[1] endif box=(infodata.pcentral[*,infodata.i]-temp/2) > 0 ; stop box=[box[0],box[0]+temp[0],box[1],box[1]+temp[1]] temp=box[1]-infodata.ns[infodata.i]+1 if temp gt 0 then box[0:1]-=temp temp=box[3]-infodata.nl[infodata.i]+1 if temp gt 0 then box[2:3]-=temp infodata.pcentral[*,infodata.i]=[box[0]+box[1],box[2]+box[3]]/2 ; Widget_Control,Base,Set_Uvalue=info Widget_Control,info.Main.Draw,Get_Value=win,Set_Uvalue=box Wset,win imgscroll=Roughness_LoadImage(infodata.fileimg[infodata.i]) img=imgscroll[box[0]:box[1],box[2]:box[3],*] if info.Control.Factor gt 1 then img=congrid(img,geom.xsize,geom.ysize,3) tv,img,true=3 plot,[0],[0],xrange=box[0:1]+[0,1],yrange=box[2:3]+[0,1],xmargin=[0,0],ymargin=[0,0],/noerase,/nodata,xstyle=5,ystyle=5 ;,color=255 ; plot,[0],[0],xrange=box[0:1]+[0,1],yrange=box[[3,2]]+[1,0],xmargin=[0,0],ymargin=[0,0],/noerase,/nodata,xstyle=5,ystyle=5,color=255 Widget_Control,info.Control.RefBox.id,Get_Uvalue=xybox oplot,xybox[0,[0,1,2,3,0],infodata.i],xybox[1,[0,1,2,3,0],infodata.i],color=([info.prop.box,info.prop.edit])[info.Control.RefBox.Status],thick=info.prop.thick Widget_Control,info.Control.Prof.id,Get_Uvalue=profs if n_elements(profs) ne 0 then begin temp=[0,long(total(profs.npts,/cum))] for i=0l,n_elements(temp)-2 do if profs.layer[i] eq infodata.i then oplot,[profs.xy[0,temp[i]:temp[i+1]-1]],[profs.xy[1,temp[i]:temp[i+1]-1]],color=info.prop.prof,thick=info.prop.thick endif Widget_Control,info.Control.Prof.OperProf,Get_Uvalue=profst if n_elements(profst) ne 0 then begin if profst.npts gt 1 then oplot,[profst.xy[0,*]],[profst.xy[1,*]],color=info.prop.edit,thick=info.prop.thick endif Widget_Control,info.Scroll.Draw,Get_Value=win Wset,win geoms=Widget_Info(info.Scroll.Draw,/Geometry) imgscroll=congrid(imgscroll,geoms.xsize,geoms.ysize,3) tv,imgscroll,true=3 plot,box[[0,1,1,0,0]],box[[2,2,3,3,2]],xrange=[0,infodata.ns[infodata.i]],yrange=[0,infodata.nl[infodata.i]],xmargin=[0,0],ymargin=[0,0],/noerase,xstyle=5,ystyle=5,color=info.prop.viswin oplot,xybox[0,[0,1,2,3,0],infodata.i],xybox[1,[0,1,2,3,0],infodata.i],color=([info.prop.box,info.prop.edit])[info.Control.RefBox.Status] if n_elements(profs) ne 0 then begin temp=[0,long(total(profs.npts,/cum))] for i=0l,n_elements(temp)-2 do if profs.layer[i] eq infodata.i then oplot,[profs.xy[0,temp[i]:temp[i+1]-1]],[profs.xy[1,temp[i]:temp[i+1]-1]],color=info.prop.prof endif if n_elements(profst) ne 0 then begin if profst.npts gt 1 then oplot,[profst.xy[0,*]],[profst.xy[1,*]],color=info.prop.edit endif END ;PRO Roughness_Correction,x,y,xout,yout,layer=layer,refresh_coefs=refresh_coefs,xy=xy PRO Roughness_Correction,x,y,xout,yout,refresh_coefs=refresh_coefs,xy=xy,layer=layer,inverse=inverse COMMON Roughness_COMMON,info,infodata,coefs if keyword_set(refresh_coefs) then begin if n_elements(layer) eq 0 then layer=lindgen(n_elements(infodata.fileimg)) nlayers=n_elements(layer) ; coefs=dblarr(8,nlayers) Widget_Control,info.Control.RefBox.id,Get_Uvalue=xybox Widget_Control,info.Control.RefBox.Height,Get_UValue=h Widget_Control,info.Control.RefBox.Width,Get_UValue=w for i=0l,nlayers-1 do begin if (h[layer[i]] < w[layer[i]]) gt 0 then begin B=[0d,w[layer[i]],w[layer[i]],0,0,0,h[layer[i]],h[layer[i]]] A=dblarr(8,8) A[0:1,0:3]=xybox[*,*,layer[i]] A[2,0:3]=1 A[6:7,1:2]=-w[layer[i]]*xybox[*,1:2,layer[i]] A[3:4,4:7]=xybox[*,*,layer[i]] A[5,4:7]=1 A[6:7,6:7]=-h[layer[i]]*xybox[*,2:3,layer[i]] ; if determ(A,/check) ne 0 then coefst=CRAMER(A,B,/double,zero=zero) else coefst=[1,0,0,0,1,0,0,0d] coefst=Cramer2(A,B) coefs[*,layer[i]]=coefst endif else coefs[*,layer[i]]=[1,0,0,0,1,0,0,0d] endfor endif if n_elements(x) eq 0 then return if n_elements(layer) eq 0 then layer=0l if keyword_set(xy) then begin xt=x[0,*] yt=x[1,*] endif else begin xt=x ;[*] yt=y ;[*] endelse coefst=[coefs[*,layer[0]],1] if keyword_set(inverse) then begin temp=reform(coefst,3,3) temp=invert(temp,/double) coefst=temp[0:8] endif ; xout=transpose((coefst[0]*xt+coefst[1]*yt+coefst[2])/(coefst[6]*xt+coefst[7]*yt+1)) ; yout=transpose((coefst[3]*xt+coefst[4]*yt+coefst[5])/(coefst[6]*xt+coefst[7]*yt+1)) xout=(coefst[0]*xt+coefst[1]*yt+coefst[2])/(coefst[6]*xt+coefst[7]*yt+coefst[8]) yout=(coefst[3]*xt+coefst[4]*yt+coefst[5])/(coefst[6]*xt+coefst[7]*yt+coefst[8]) if keyword_set(xy) then y=transpose([[temporary(xout[*])],[temporary(yout[*])]]) END PRO Roughness_Tendency_Kill,Base Roughness_Sensitive,/Sensitive,/Layer,/Reference,/Profiles,/Tendency,/Analysis END PRO Roughness_Tendency_Event,Event refresh=0 Widget_Control,Event.Top,Get_UValue=info if (Event.id eq info.OK) or (Event.id eq info.Cancel) then begin if Event.id eq info.OK then begin Widget_Control,info.Angle,Get_Value=angle Roughness_Event,{Top:info.mainbase,id:info.mainangle,value:angle} endif Widget_Control,Event.Top,/Destroy endif Case Event.id of Event.Top:begin ; stop end info.Draw1:begin if Event.release eq 0 then return Widget_Control,info.Draw1,Get_Value=win1 Wset,win1 plot,[0],[0],xrange=[0,info.dx*n_elements(info.y)-1],yrange=[min(info.y,/nan),max(info.y,/nan)],/xstyle,/ystyle,/noerase,/nodata,ytitle='original' xy=(Convert_Coord(Event.x,Event.y,/Device,/To_Data))[0:1] ; print,xy dx=xy[0]-info.dx*(n_elements(info.y)-1)/2 if dx ne 0 then angle=atan(xy[1]/dx)*!radeg else angle=0. Widget_Control,info.Angle,Set_Value=angle refresh=1 end info.Angle:begin Event.Value mod=360 if (abs(Event.Value) eq 90) or (abs(Event.Value) eq 270) then Event.Value=0 Widget_Control,info.Angle,Set_Value=Event.Value refresh=1 end info.Best:begin Widget_Control,info.Draw1,Get_Value=win1 Wset,win1 plot,[0],[0],xrange=[0,info.dx*n_elements(info.y)-1],yrange=[min(info.y,/nan),max(info.y,/nan)],/xstyle,/ystyle,/noerase,/nodata,ytitle='original' x=info.dx*findgen(n_elements(info.y)) temp=where(finite(info.y)) x=x[temp] y=info.y[temp] b=(regress(x,y,correlation=r))[0] a=-b*total(x)/n_elements(x) ; a=-b*(n_elements(info.y)-1)/2 yestim=a+b*x oplot,x,yestim,color=65000l pvalue=fltarr(1000) for i=0l,999 do pvalue[i]=correlate(x,y[sort(randomu(seed,n_elements(y)))]) pvalue=total(pvalue le r[0])/1000 if pvalue gt .5 then pvalue=1-pvalue Text=['Angle (degrees) ='+string(atan(b)*!radeg),'correlation ='+string(r),'P-value ='+string(pvalue)] Text=[Text,'','Do you accept this correction?'] Widget_Control,info.Draw1,/input_focus res=Dialog_Message(Text,/Question,Title='Defining Best Correction') if res eq 'Yes' then begin angle=atan(b)*!radeg Widget_Control,info.Angle,Set_Value=angle endif refresh=1 end info.Zero:begin Widget_Control,info.Angle,Set_Value=0. refresh=1 end else:if widget_info(Event.Top,/Valid) then refresh=1 EndCase if refresh ne 0 then begin y=info.y y-=(total(y,/nan)/total(finite(y))) x=info.dx*lindgen(n_elements(y)) Widget_Control,info.Angle,Get_Value=angle angle/=!radeg b=tan(angle) a=-b*total(x)/n_elements(x) yestim=a+b*x Widget_Control,info.Draw1,Get_Value=win1 Widget_Control,info.Draw2,Get_Value=win2 Wset,win1 plot,x,y,/xstyle,/ystyle,ytitle='original' oplot,x,yestim,color=255 Wset,win2 plot,x,y-yestim,/xstyle,/ystyle,ytitle='corrected' endif END PRO Roughness_RMS_Kill,Base Roughness_Sensitive,/Sensitive,/Layer,/Reference,/Profiles,/Tendency,/Analysis END PRO Roughness_RMS_Event,Event COMMON Roughness_COMMON,info,infodata,coefs refresh=0 BaseTop=Event.Top Widget_Control,Event.Top,Get_UValue=informs if Event.id eq informs.Cancel then begin Widget_Control,Event.Top,/Destroy return endif icolor=(where(informs.colors eq Event.id))[0] if icolor ne -1 then begin if Event.Release eq 0 then return Widget_Control,informs.colors[icolor],Get_Uvalue=color colort=color_choose(color) if colort eq color then return Widget_Control,informs.colors[icolor],Set_Uvalue=colort refresh=1 endif else begin Case Event.id of Event.Top:begin ; stop end informs.prop:begin Widget_Control,info.Control.Analysis.HorSampl,Get_Value=dx Widget_Control,info.Control.Analysis.RMSdetails,Get_UValue=xmaxmax xmaxmax=dx*max(xmaxmax.npts) BaseProp=Widget_Base(/Column,Title='RMS Property') BaseA=Widget_Base(BaseProp,/Column,/Frame) Baset=Widget_Base(BaseA,/Row) temp=Widget_Label(Baset,Value='Background: ') ColorB=Widget_Draw(Baset,Xsize=30,Ysize=30,Retain=2,/Button_Events) Baset=Widget_Base(BaseA,/Row) temp=Widget_Label(Baset,Value='Foreground: ') ColorF=Widget_Draw(Baset,Xsize=30,Ysize=30,Retain=2,/Button_Events) Thickt=Cw_Field(BaseA,/Floating,/Return_Events,/Row,Title='Line Thickness',Value=informs.thick,Xsize=8) Baset=Widget_Base(BaseA,/Row) Xmint=Cw_Field(Baset,/Floating,/Return_Events,/Row,Title='Xmin:',Value=informs.xrange[0],Xsize=8) Xmaxt=Cw_Field(Baset,/Floating,/Return_Events,/Row,Title='Xmax:',Value=informs.xrange[1],Xsize=8) Baset=Widget_Base(BaseA,/Row) Ymint=Cw_Field(Baset,/Floating,/Return_Events,/Row,Title='Ymin:',Value=informs.yrange[0],Xsize=8) Ymaxt=Cw_Field(Baset,/Floating,/Return_Events,/Row,Title='Ymax:',Value=informs.yrange[1],Xsize=8) BaseB=Widget_Base(BaseProp,/Row,/Frame) OKt=Widget_Button(BaseB,Value='OK',Xsize=70) Cancelt=Widget_Button(BaseB,Value='Cancel',Xsize=70) Widget_Control,BaseProp,/Realize Widget_Control,ColorB,Get_Value=winB Widget_Control,ColorF,Get_Value=winF background=informs.background foreground=informs.foreground thick=informs.thick xmin=informs.xrange[0] xmax=informs.xrange[1] ymin=informs.yrange[0] ymax=informs.yrange[1] Wset,winB erase,background Wset,winF erase,foreground while Widget_Info(BaseProp,/Valid) do begin Event=Widget_Event(BaseProp,bad_id=bad_id) if bad_id ne 0 then break case Event.id of Cancelt:Widget_Control,BaseProp,/Destroy OKt:begin Widget_Control,BaseProp,/Destroy informs.background=background informs.foreground=foreground informs.thick=thick informs.xrange=[xmin,xmax] informs.yrange=[ymin,ymax] Widget_Control,BaseTop,Set_UValue=informs refresh=1 end ColorB:begin if Event.Release eq 0 then break background=color_choose(background) Wset,winB erase,background end ColorF:begin if Event.Release eq 0 then break foreground=color_choose(foreground) Wset,winF erase,foreground end Thickt:begin thick=Event.Value > 1 Widget_Control,Thickt,Set_Value=thick end Xmint:begin xmin=(Event.Value < (xmax-dx)) > 0 Widget_Control,Xmint,Set_Value=xmin end Xmaxt:begin xmax=(Event.Value > (xmin+dx)) < xmaxmax Widget_Control,Xmaxt,Set_Value=xmax end Ymint:begin ymin=Event.Value if ymin ge ymax then ymin=ymax-1 Widget_Control,Ymint,Set_Value=ymin end Ymaxt:begin ymax=Event.Value if ymax le ymin then ymax=ymin+1 Widget_Control,Ymaxt,Set_Value=ymax end Else:;nothing endcase endwhile end else:if widget_info(Event.Top,/Valid) then refresh=1 EndCase endelse if refresh ne 0 then begin Widget_Control,info.Control.Analysis.RMSdetails,Get_UValue=profcorr Widget_Control,info.Control.Analysis.HorSampl,Get_Value=dx RMS=fltarr(n_elements(profcorr.npts)) for i=0l,n_elements(infodata.fileimg)-1 do begin Widget_Control,informs.colors[i],Get_Value=win,Get_Uvalue=color if (where(profcorr.layer eq i))[0] eq -1 then begin Widget_Control,informs.sels[i],Set_Value=0 Widget_Control,informs.colors[i],Draw_Button_Events=0 color=0l endif Wset,win erase,color endfor Widget_Control,informs.Draw,Get_Value=win Wset,win if informs.xrange[1] le informs.xrange[0] then begin informs.xrange[1]=(dx*max(profcorr.npts)) > (informs.xrange[0]+dx) Widget_Control,BaseTop,Set_UValue=informs endif if informs.yrange[1] le informs.yrange[0] then begin informs.yrange=[min(profcorr.ycorr,/nan),max(profcorr.ycorr,/nan)] Widget_Control,BaseTop,Set_UValue=informs endif plot,[0],[0],xrange=informs.xrange,yrange=informs.yrange,/xstyle,/ystyle,ytitle='H (cm)',background=informs.background,color=informs.foreground temp=[0,long(total(profcorr.npts,/cum))] Text=['Individual RMS',''] for i=0l,n_elements(profcorr.npts)-1 do begin Text=[Text,infodata.sname[i]] Widget_Control,informs.sels[i],Get_Value=sel Widget_Control,informs.colors[i],Get_Uvalue=color if sel[0] ne 0 then oplot,dx*findgen(profcorr.npts[i]),profcorr.ycorr[temp[i]:temp[i+1]-1],color=color,thick=informs.thick RMS[i]=stddev(profcorr.ycorr[temp[i]:temp[i+1]-1],/nan) Text=[Text,'RMS(cm) = '+strcompress(RMS[i]),''] endfor if n_elements(profcorr.npts) gt 1 then begin Text=[Text,'______________________________'] Text=[Text,'','General RMS(cm) = '+strcompress(stddev(profcorr.ycorr,/nan))] endif Widget_Control,informs.Text,Set_Value=Text endif END PRO Roughness_Auto_Kill,Base Roughness_Sensitive,/Sensitive,/Layer,/Reference,/Profiles,/Tendency,/Analysis END PRO Roughness_Auto_Event,Event COMMON Roughness_COMMON,info,infodata,coefs refresh=0 BaseTop=Event.Top Widget_Control,Event.Top,Get_UValue=infoauto if Event.id eq infoauto.Cancel then begin Widget_Control,Event.Top,/Destroy return endif icolor=(where(infoauto.colors eq Event.id))[0] if icolor ne -1 then begin if Event.Release eq 0 then return Widget_Control,infoauto.colors[icolor],Get_Uvalue=color colort=color_choose(color) if colort eq color then return Widget_Control,infoauto.colors[icolor],Set_Uvalue=colort refresh=1 endif else begin Case Event.id of Event.Top:begin ; stop end infoauto.prop:begin Widget_Control,info.Control.Analysis.HorSampl,Get_Value=dx Widget_Control,info.Control.Analysis.Lcdetails,Get_UValue=xmaxmax xmaxmax=dx*(n_elements(xmaxmax)-1) BaseProp=Widget_Base(/Column,Title='Autocorrelation Property') BaseA=Widget_Base(BaseProp,/Column,/Frame) Baset=Widget_Base(BaseA,/Row) temp=Widget_Label(Baset,Value='Background: ') ColorB=Widget_Draw(Baset,Xsize=30,Ysize=30,Retain=2,/Button_Events) Baset=Widget_Base(BaseA,/Row) temp=Widget_Label(Baset,Value='Foreground: ') ColorF=Widget_Draw(Baset,Xsize=30,Ysize=30,Retain=2,/Button_Events) Thickt=Cw_Field(BaseA,/Floating,/Return_Events,/Row,Title='Line Thickness',Value=infoauto.thick,Xsize=8) Baset=Widget_Base(BaseA,/Row) Xmint=Cw_Field(Baset,/Floating,/Return_Events,/Row,Title='Xmin:',Value=infoauto.xrange[0],Xsize=8) Xmaxt=Cw_Field(Baset,/Floating,/Return_Events,/Row,Title='Xmax:',Value=infoauto.xrange[1],Xsize=8) Baset=Widget_Base(BaseA,/Row) Ymint=Cw_Field(Baset,/Floating,/Return_Events,/Row,Title='Ymin:',Value=infoauto.yrange[0],Xsize=8) Ymaxt=Cw_Field(Baset,/Floating,/Return_Events,/Row,Title='Ymax:',Value=infoauto.yrange[1],Xsize=8) BaseB=Widget_Base(BaseProp,/Row,/Frame) OKt=Widget_Button(BaseB,Value='OK',Xsize=70) Cancelt=Widget_Button(BaseB,Value='Cancel',Xsize=70) Widget_Control,BaseProp,/Realize Widget_Control,ColorB,Get_Value=winB Widget_Control,ColorF,Get_Value=winF background=infoauto.background foreground=infoauto.foreground thick=infoauto.thick xmin=infoauto.xrange[0] xmax=infoauto.xrange[1] ymin=infoauto.yrange[0] ymax=infoauto.yrange[1] Wset,winB erase,background Wset,winF erase,foreground while Widget_Info(BaseProp,/Valid) do begin Event=Widget_Event(BaseProp,bad_id=bad_id) if bad_id ne 0 then break case Event.id of Cancelt:Widget_Control,BaseProp,/Destroy OKt:begin Widget_Control,BaseProp,/Destroy infoauto.background=background infoauto.foreground=foreground infoauto.thick=thick infoauto.xrange=[xmin,xmax] infoauto.yrange=[ymin,ymax] Widget_Control,BaseTop,Set_UValue=infoauto refresh=1 end ColorB:begin if Event.Release eq 0 then break background=color_choose(background) Wset,winB erase,background end ColorF:begin if Event.Release eq 0 then break foreground=color_choose(foreground) Wset,winF erase,foreground end Thickt:begin thick=Event.Value > 1 Widget_Control,Thickt,Set_Value=thick end Xmint:begin xmin=(Event.Value < (xmax-dx)) > 0 Widget_Control,Xmint,Set_Value=xmin end Xmaxt:begin xmax=(Event.Value > (xmin+dx)) < xmaxmax Widget_Control,Xmaxt,Set_Value=xmax end Ymint:begin ymin=Event.Value > (-1) if ymin ge ymax then ymin=-1. Widget_Control,Ymint,Set_Value=ymin end Ymaxt:begin ymax=Event.Value < 1 if ymax le ymin then ymax=1. Widget_Control,Ymaxt,Set_Value=ymax end Else:;nothing endcase endwhile end else:if widget_info(Event.Top,/Valid) then refresh=1 EndCase endelse if refresh ne 0 then begin Widget_Control,info.Control.Analysis.RMSdetails,Get_UValue=profcorr Widget_Control,info.Control.Analysis.Lcdetails,Get_UValue=Auto Widget_Control,info.Control.Analysis.HorSampl,Get_Value=dx Lc=fltarr(n_elements(profcorr.npts)) for i=0l,n_elements(infodata.fileimg)-1 do begin Widget_Control,infoauto.colors[i],Get_Value=win,Get_Uvalue=color if (where(profcorr.layer eq i))[0] eq -1 then begin Widget_Control,infoauto.sels[i],Set_Value=0 Widget_Control,infoauto.colors[i],Draw_Button_Events=0 color=0l endif Wset,win erase,color endfor if n_elements(infodata.fileimg) gt 1 then begin Widget_Control,infoauto.colors[n_elements(infodata.fileimg)],Get_Value=win,Get_Uvalue=color Wset,win erase,color endif Widget_Control,infoauto.Draw,Get_Value=win Wset,win lags=dx*findgen(n_elements(auto)) if infoauto.xrange[1] le infoauto.xrange[0] then begin infoauto.xrange[1]=max(lags) > (infoauto.xrange[0]+dx) Widget_Control,BaseTop,Set_UValue=infoauto endif if infoauto.yrange[1] le infoauto.yrange[0] then begin infoauto.yrange=[-1,1.] Widget_Control,BaseTop,Set_UValue=infoauto endif plot,[0,max(lags)],[0,0],xrange=infoauto.xrange,yrange=infoauto.yrange,/xstyle,/ystyle,ytitle='Correlation',xtitle='Lag (cm)',background=infoauto.background,color=infoauto.foreground oplot,[0,max(lags)],[exp(-1),exp(-1)],linestyle=2,color=infoauto.foreground ; plot,lags,auto,yrange=[-1,1],/xstyle,/ystyle,ytitle='Correlation',xtitle='Lag (cm)' temp=[0,long(total(profcorr.npts,/cum))] Text=['Individual Lc',''] for i=0l,n_elements(profcorr.npts)-1 do begin Text=[Text,infodata.sname[i]] Widget_Control,infoauto.sels[i],Get_Value=sel Widget_Control,infoauto.colors[i],Get_Uvalue=color acorr_corr=acorr(profcorr.ycorr[temp[i]:temp[i+1]-1],lindgen((n_elements(lags)))) if sel[0] ne 0 then oplot,lags,acorr_corr,color=color,thick=infoauto.thick temp2=where(finite(acorr_corr)) temp2=temp2[min(where(acorr_corr[temp2] lt exp(-1)))] if temp2 ne -1 then Lc[i]=((exp(-1)-acorr_corr[temp2-1])/(acorr_corr[temp2]-acorr_corr[temp2-1])+temp2-1)*dx Text=[Text,'Lc(cm) = '+strcompress(Lc[i],/rem),''] endfor if n_elements(infodata.fileimg) eq 1 then igen=0 else igen=n_elements(infodata.fileimg) Widget_Control,infoauto.sels[igen],Get_Value=sel Widget_Control,infoauto.colors[igen],Get_Uvalue=color if sel[0] ne 0 then oplot,lags,auto,color=color,thick=infoauto.thick if n_elements(infodata.fileimg) gt 1 then begin Widget_Control,info.Control.Analysis.Lc,Get_Value=Lc Text=[Text,'______________________________'] Text=[Text,'','General Lc(cm) = '+strcompress(Lc,/rem)] endif Widget_Control,infoauto.Text,Set_Value=Text endif END PRO Roughness_Event,Event COMMON Roughness_COMMON,info,infodata,coefs if Tag_Names(Event,/Structure_Name) eq 'WIDGET_KILL_REQUEST' then begin if infodata.saved eq 0 then begin res=Dialog_Message(['Some @data@ have changed.','Do you want to save the changes?'],/Question,/Cancel) if res eq 'Cancel' then return if res eq 'Yes' then begin Roughness_Save endif endif infodata.saved=1 Widget_Control,Event.Top,/Destroy return endif ; Widget_Control,Event.Top,Get_Uvalue=Base ; if size(Base,/Type) eq 8 then begin ; info=Base ; Base=Event.Top ; endif else Widget_Control,Base,Get_Uvalue=info refresh=0 ; refresh_info=0 ; refresh_exec=0 Case Event.id of info.menu.loaddata:begin file=Dialog_PickFile(/Read,Filter=['*.prd'],/Must_Exist,get_path=path) if file eq '' then return cd,path Widget_Control,Event.Top,/destroy Roughness,file return end info.menu.loadpicture:begin file=Dialog_PickFile(/Read,Filter=['*.bmp','*.jpg','*.png','*.tif'],/Must_Exist,get_path=path) if file eq '' then return if n_elements(path) eq 0 then path=strmid(file,0,strlen(file)-strlen((reverse([strsplit(file,path_sep(),/extract)]))[0])) cd,path if Query_Image(file,dimensions=temp) eq 0 then begin print,'nao foi possivel abrir a imagem...' return endif xyboxt=[[0,0.],[temp[0],0],[temp[0],temp[1]],[0,temp[1]]] infodata={i:n_elements(infodata.fileimg),fileprd:infodata.fileprd,fileimg:[infodata.fileimg,file],sname:[infodata.sname,strmid(file,strlen(path))],ns:[infodata.ns,temp[0]],nl:[infodata.nl,temp[1]],pcentral:[[infodata.pcentral],[[0,0l]]],saved:0b} Widget_Control,info.Control.Zoom,Get_Uvalue=zoom Widget_Control,info.Control.Layer,Get_Uvalue=dsize Widget_Control,info.Control.RefBox.id,Get_Uvalue=xybox Widget_Control,info.Control.RefBox.Height,Get_UValue=hbox Widget_Control,info.Control.RefBox.Width,Get_UValue=wbox Widget_Control,info.Control.Tendency.Angle,Get_Uvalue=angle Widget_Control,info.Control.Zoom,Set_Uvalue=[zoom,1] Widget_Control,info.Control.Layer,Set_Uvalue=[[dsize],[400 < temp[0],400 < temp[1]]] Widget_Control,info.Control.RefBox.id,Set_Uvalue=[[[xybox]],[[xyboxt]]] Widget_Control,info.Control.RefBox.Height,Set_UValue=[hbox,0] Widget_Control,info.Control.RefBox.Width,Set_UValue=[wbox,0] Widget_Control,info.Control.Tendency.Angle,Set_Uvalue=[angle,0] Widget_Control,info.Control.Layer,Set_Value=infodata.sname,Set_Combobox_Select=infodata.i Widget_Control,info.Control.Delete,/Sensitive Roughness_Event,{Top:Event.Top,id:info.Control.Layer,Index:infodata.i} coefs=[[coefs],[fltarr(8)]] return end info.menu.savedata:begin Roughness_Save infodata.saved=1 end info.menu.prop:begin BaseProp=Widget_Base(/Column,Title='Roughness Properties') BaseA=Widget_Base(BaseProp,/Column,/Frame) Baset=Widget_Base(BaseA,/Row) temp=Widget_Label(Baset,Value='View Window: ') ColorV=Widget_Draw(Baset,Xsize=30,Ysize=30,Retain=2,/Button_Events) Baset=Widget_Base(BaseA,/Row) temp=Widget_Label(Baset,Value='Box Line: ') ColorB=Widget_Draw(Baset,Xsize=30,Ysize=30,Retain=2,/Button_Events) Baset=Widget_Base(BaseA,/Row) temp=Widget_Label(Baset,Value='Profile Line: ') ColorP=Widget_Draw(Baset,Xsize=30,Ysize=30,Retain=2,/Button_Events) Baset=Widget_Base(BaseA,/Row) temp=Widget_Label(Baset,Value='Edit Line: ') ColorE=Widget_Draw(Baset,Xsize=30,Ysize=30,Retain=2,/Button_Events) Thickt=Cw_Field(BaseA,/Floating,/Return_Events,/Row,Title='Line Thickness',Value=info.prop.thick,Xsize=8) BaseB=Widget_Base(BaseProp,/Row,/Frame) OKt=Widget_Button(BaseB,Value='OK',Xsize=70) Cancelt=Widget_Button(BaseB,Value='Cancel',Xsize=70) Widget_Control,BaseProp,/Realize Widget_Control,ColorV,Get_Value=winV Widget_Control,ColorB,Get_Value=winB Widget_Control,ColorP,Get_Value=winP Widget_Control,ColorE,Get_Value=winE vcolor=info.prop.viswin bcolor=info.prop.box pcolor=info.prop.prof ecolor=info.prop.edit thick=info.prop.thick Wset,winV erase,vcolor Wset,winB erase,bcolor Wset,winP erase,pcolor Wset,winE erase,ecolor while Widget_Info(BaseProp,/Valid) do begin Event=Widget_Event(BaseProp,bad_id=bad_id) if bad_id ne 0 then break case Event.id of Cancelt:Widget_Control,BaseProp,/Destroy OKt:begin Widget_Control,BaseProp,/Destroy info.prop.viswin=vcolor info.prop.box=bcolor info.prop.prof=pcolor info.prop.edit=ecolor info.prop.thick=thick refresh=1 end ColorV:begin if Event.Release eq 0 then break vcolor=color_choose(vcolor) Wset,winV erase,vcolor end ColorB:begin if Event.Release eq 0 then break bcolor=color_choose(bcolor) Wset,winB erase,bcolor end ColorP:begin if Event.Release eq 0 then break pcolor=color_choose(pcolor) Wset,winP erase,pcolor end ColorE:begin if Event.Release eq 0 then break ecolor=color_choose(ecolor) Wset,winE erase,ecolor end Thickt:begin thick=Event.Value > 1. Widget_Control,Thickt,Set_Value=thick end Else:;nothing endcase endwhile end info.menu.exit:begin temp={WIDGET_KILL_REQUEST} temp.id=info.Main.id temp.top=info.Main.id Roughness_Event,temp end info.menu.stop:stop info.Scroll.id:begin temp=(infodata.ns[infodata.i]/(Event.X-6.)) > (infodata.nl[infodata.i]/(Event.Y-6.)) ;> 1 temp=round([infodata.ns[infodata.i]/temp,infodata.nl[infodata.i]/temp]) Widget_Control,info.Scroll.Draw,Xsize=temp[0],Ysize=temp[1] refresh=1 ; if Ptr_Valid(info.Scroll.pimg) then Ptr_Free,info.Scroll.pimg end Event.Top: begin Widget_Control,info.Main.Draw,Get_Uvalue=box Xsize=((Event.X-6)/info.Control.factor) < infodata.ns[infodata.i] box[1]=box[0]+Xsize-1 if box[1] ge infodata.ns[infodata.i] then box[0:1]-=(box[1]-infodata.ns[infodata.i]+1) Xsize=box[1]-box[0]+1 Ysize=((Event.Y-6)/info.Control.factor) < infodata.nl[infodata.i] box[3]=box[2]+Ysize-1 if box[3] ge infodata.nl[infodata.i] then box[2:3]-=(box[3]-infodata.nl[infodata.i]+1) Ysize=box[3]-box[2]+1 Widget_Control,info.Main.Draw,Xsize=Xsize*info.Control.factor,Ysize=Ysize*info.Control.factor Widget_Control,info.Control.Layer,Get_Uvalue=dsize dsize[*,infodata.i]=[Xsize*info.Control.factor,Ysize*info.Control.factor] Widget_Control,info.Control.Layer,Set_Uvalue=dsize ; Roughness_View,Event.Top refresh=1 end info.Scroll.Draw:begin if Event.release eq 0 then return Widget_Control,info.Main.Draw,Get_Uvalue=box temp=Widget_Info(info.Scroll.Draw,/geometry) temp=round([infodata.ns[infodata.i]*(Event.x/temp.xsize),infodata.nl[infodata.i]*(Event.y/temp.ysize)]) box[0:1]+=round((temp[0]-round((box[0]+box[1])/2.))) box[2:3]+=round((temp[1]-round((box[2]+box[3])/2.))) if box[0] lt 0 then box[0:1]+=abs(box[0]) if box[2] lt 0 then box[2:3]+=abs(box[2]) temp=infodata.ns[infodata.i]-box[1]-1 if temp lt 0 then box[0:1]-=abs(temp) temp=infodata.nl[infodata.i]-box[3]-1 if temp lt 0 then box[2:3]-=abs(temp) infodata.pcentral[*,infodata.i]=[box[0]+box[1],box[2]+box[3]]/2 ; refresh_info=1 refresh=1 end info.Main.Draw: begin Widget_Control,info.Main.Draw,Get_Uvalue=box temp=Widget_Info(info.Main.Draw,/geometry) x=box[0]+Event.x*(box[1]-box[0]+1)/float(temp.xsize) y=box[2]+Event.y*(box[3]-box[2]+1)/float(temp.ysize) if Event.press ne 0 then begin Widget_Control,info.Control.Prof.OperPoint,Set_Uvalue=[x,y] break endif Status=info.Control.Prof.Status Case 1 of Status ne 0: begin Case Status/10 of 0: begin ;edit selected/new profile Widget_Control,info.Control.Prof.OperProf,Sensitive=0 Widget_Control,info.Control.Prof.OperPoint,/Sensitive end 1: begin ;select profile Widget_Control,info.Control.Prof.id,Get_Uvalue=profs,/no_copy if n_elements(profs.npts) gt 1 then begin ; temp=lonarr(profs.npts[0]) ; for i=1l,n_elements(profs.npts)-1 do temp=[temp,replicate(i,profs.npts[i])] temp=replicate(profs.layer[0] eq infodata.i? 0 : -1,profs.npts[0]) for i=1l,n_elements(profs.npts)-1 do temp=[temp,replicate(profs.layer[i] eq infodata.i? i : -1,profs.npts[i])] i=temp[sort((profs.xy[0,*]-x)^2+(profs.xy[1,*]-y)^2)] i=i[min(where(i ge 0))] Widget_Control,info.Control.Prof.id,Set_Uvalue={layer:profs.layer[where(lindgen(n_elements(profs.npts)) ne i)],npts:profs.npts[where(lindgen(n_elements(profs.npts)) ne i)],xy:profs.xy[*,where(temp ne i)]} profs={layer:infodata.i,npts:profs.npts[i],xy:profs.xy[*,where(temp eq i)]} endif Widget_Control,info.Control.Prof.OperProf,Set_Uvalue=profs,/no_copy,Set_ComboBox_Select=0,Sensitive=0 Widget_Control,info.Control.Prof.OperPoint,/Sensitive info.Control.Prof.Status=info.Control.Prof.Status mod 10 Status=0 refresh=1 ; refresh_info=1 end 2: begin ;delete profile Widget_Control,info.Control.Prof.id,Get_Uvalue=profs,/no_copy if n_elements(profs.npts) gt 1 then begin ; temp=lonarr(profs.npts[0]) ; for i=1l,n_elements(profs.npts)-1 do temp=[temp,replicate(i,profs.npts[i])] temp=replicate(profs.layer[0] eq infodata.i? 0 : -1,profs.npts[0]) for i=1l,n_elements(profs.npts)-1 do temp=[temp,replicate(profs.layer[i] eq infodata.i? i : -1,profs.npts[i])] i=temp[sort((profs.xy[0,*]-x)^2+(profs.xy[1,*]-y)^2)] i=i[min(where(i ge 0))] Widget_Control,info.Control.Prof.id,Set_Uvalue={layer:profs.layer[where(lindgen(n_elements(profs.layer)) ne i)],npts:profs.npts[where(lindgen(n_elements(profs.npts)) ne i)],xy:profs.xy[*,where(temp ne i)]} endif Widget_Control,info.Control.Prof.OperProf,Set_ComboBox_Select=0,Sensitive=0 Widget_Control,info.Control.Prof.OperPoint,Sensitive=0,Set_ComboBox_Select=0 Widget_Control,info.Control.Prof.id,Set_Value='Edit' Widget_Control,info.Control.Layer,/Sensitive Widget_Control,info.Control.RefBox.id,/Sensitive info.Control.Prof.Status=0 Status=0 refresh=1 ; refresh_info=1 Roughness_Sensitive,/Sensitive,/Layer,/Reference,/Profiles,/Tendency,/Analysis ; refresh_exec=1 end EndCase Case Status mod 10 of 1:begin ;add point Widget_Control,info.Control.Prof.OperPoint,Get_Uvalue=xy Widget_Control,info.Control.Prof.OperProf,Get_Uvalue=profst,/no_copy if profst.npts ne 0 then begin xyt=profst.xy if profst.npts eq 1 then begin if profst.xy[0,0] lt x then xyt=[[xyt],[x,y]] else xyt=[[x,y],[xyt]] endif else begin i=pnt_polyline(xy,xyt,d=d) ; print,i,d if (i lt 0) or (d gt 5) then begin if total((xyt[*,0]-xy)^2) lt total((xyt[*,n_elements(xyt)/2-1]-xy)^2) then xyt=[[x,y],[xyt]] else xyt=[[xyt],[x,y]] endif else begin xyt=[[xyt[*,0:i]],[x,y],[xyt[*,i+1:*]]] endelse endelse profst={layer:infodata.i,npts:profst.npts+1,xy:xyt} endif else profst={layer:infodata.i,npts:1l,xy:[x,y]} Widget_Control,info.Control.Prof.OperProf,Set_Uvalue=profst,/no_copy refresh=1 ; refresh_exec=1 infodata.saved=0 end 2:begin ;move point Widget_Control,info.Control.Prof.OperPoint,Get_Uvalue=xy Widget_Control,info.Control.Prof.OperProf,Get_Uvalue=profst,/no_copy i=(sort((profst.xy[0,*]-xy[0])^2+(profst.xy[1,*]-xy[1])^2))[0] profst.xy[*,i]=[x,y] Widget_Control,info.Control.Prof.OperProf,Set_Uvalue=profst,/no_copy refresh=1 infodata.saved=0 end 3:begin ;delete point Widget_Control,info.Control.Prof.OperProf,Get_Uvalue=profst,/no_copy if profst.npts gt 1 then begin i=(sort((profst.xy[0,*]-x)^2+(profst.xy[1,*]-y)^2))[0] profst={layer:infodata.i,npts:profst.npts-1,xy:profst.xy[*,where(lindgen(profst.npts) ne i)]} endif else profst={layer:infodata.i,npts:0l} Widget_Control,info.Control.Prof.OperProf,Set_Uvalue=profst,/no_copy refresh=1 ; refresh_exec=1 infodata.saved=0 end else:;nothing EndCase end info.Control.RefBox.Status: begin Widget_Control,info.Control.Prof.OperPoint,Get_Uvalue=xy Widget_Control,info.Control.RefBox.id,Get_Uvalue=xybox i=(sort((xybox[0,*,infodata.i]-xy[0])^2+(xybox[1,*,infodata.i]-xy[1])^2))[0] xybox[*,i,infodata.i]=[x,y] Widget_Control,info.Control.RefBox.id,Set_Uvalue=xybox ; print,xy,x,y refresh=1 end Else:;nothing EndCase ; help,Event ; refresh_press=Event.press ne 0 ; refresh_value=1 end info.Control.Zoom: begin Widget_Control,info.Control.Zoom,Get_Uvalue=temp temp[infodata.i]=Event.Value Widget_Control,info.Control.Zoom,Set_Uvalue=temp info.Control.Factor=Event.Value ; refresh_info=1 refresh=1 end info.Control.Layer: begin infodata.i=Event.Index Widget_Control,info.Control.Zoom,Get_Uvalue=temp info.Control.Factor=temp[infodata.i] Widget_Control,info.Control.Zoom,Set_Value=info.Control.Factor Widget_Control,info.Control.RefBox.Height,Get_UValue=hbox Widget_Control,info.Control.RefBox.Height,Set_Value=hbox[infodata.i] Widget_Control,info.Control.RefBox.Width,Get_UValue=wbox Widget_Control,info.Control.RefBox.Width,Set_Value=wbox[infodata.i] Widget_Control,info.Control.Tendency.Angle,Get_UValue=angle Widget_Control,info.Control.Tendency.Angle,Set_Value=angle[infodata.i] Widget_Control,info.Control.Layer,Get_Uvalue=dsize dsize=dsize[*,infodata.i] ; stop ; dsize=[400 < infodata.ns[infodata.i],400 < infodata.nl[infodata.i]] Widget_Control,info.Main.id,Tlb_Set_Title='Profile Picture ('+infodata.sname[infodata.i]+')' Widget_Control,info.Main.Draw,Xsize=dsize[0],Ysize=dsize[1] temp=infodata.ns[infodata.i] > infodata.nl[infodata.i] dimsS=round([250.*infodata.ns[infodata.i]/temp,250.*infodata.nl[infodata.i]/temp]) Widget_Control,info.Scroll.Draw,Xsize=dimsS[0],Ysize=dimsS[1] refresh=1 Roughness_Sensitive,/Sensitive,/Layer,/Reference,/Profiles,/Tendency,/Analysis ; refresh_exec=1 end info.Control.Delete: begin lsel=where(lindgen(n_elements(infodata.fileimg)) ne infodata.i) infodata={i:infodata.i < (n_elements(infodata.fileimg)-2),fileimg:infodata.fileimg[lsel],sname:infodata.sname[lsel],ns:infodata.ns[lsel],nl:infodata.nl[lsel],pcentral:infodata.pcentral[*,lsel],saved:0b} coefs=coefs[*,lsel] Widget_Control,info.Control.Delete,Sensitive=n_elements(infodata.fileimg) gt 1 Widget_Control,info.Control.Zoom,Get_Uvalue=zoom Widget_Control,info.Control.Layer,Get_Uvalue=dsize Widget_Control,info.Control.RefBox.id,Get_Uvalue=xybox Widget_Control,info.Control.RefBox.Height,Get_UValue=hbox Widget_Control,info.Control.RefBox.Width,Get_UValue=wbox Widget_Control,info.Control.Tendency.Angle,Get_Uvalue=angle Widget_Control,info.Control.Zoom,Set_Uvalue=zoom[lsel] Widget_Control,info.Control.Layer,Set_Uvalue=dsize[*,lsel] Widget_Control,info.Control.RefBox.id,Set_Uvalue=xybox[*,*,lsel] Widget_Control,info.Control.RefBox.Height,Set_UValue=hbox[lsel] Widget_Control,info.Control.RefBox.Width,Set_UValue=wbox[lsel] Widget_Control,info.Control.Tendency.Angle,Set_Uvalue=angle[lsel] Widget_Control,info.Control.Layer,Set_Value=infodata.sname,Set_Combobox_Select=infodata.i Roughness_Event,{Top:Event.Top,id:info.Control.Layer,Index:infodata.i} return end info.Control.RefBox.id: begin if info.Control.RefBox.Status eq 0 then begin info.Control.RefBox.Status=1 Widget_Control,info.Control.RefBox.id,Set_Value='Done' Roughness_Sensitive,Sensitive=0,/Layer,/Profiles,/Tendency,/Analysis Widget_Control,info.Control.RefBox.height,Sensitive=0 Widget_Control,info.Control.RefBox.width,Sensitive=0 ; Widget_Control,info.Control.Layer,Sensitive=0 ; Widget_Control,info.Control.Prof.id,Sensitive=0 endif else begin info.Control.RefBox.Status=0 Widget_Control,info.Control.RefBox.id,Set_Value='Modify Box' Roughness_Sensitive,/Sensitive,/Layer,/Reference,/Profiles,/Tendency,/Analysis ; Widget_Control,info.Control.Layer,/Sensitive ; Widget_Control,info.Control.Prof.id,/Sensitive ; refresh_exec=1 infodata.saved=0 endelse ; refresh_info=1 refresh=1 end info.Control.RefBox.Height: begin if size(event,/sname) eq 'WIDGET_KBRD_FOCUS' then begin if event.enter ne 0 then return endif Widget_Control,event.id,Get_Value=value ; Event.Value >= 0 Widget_Control,info.Control.RefBox.Height,Get_UValue=hbox hbox[infodata.i]=Value Widget_Control,info.Control.RefBox.Height,Set_Value=Value,Set_Uvalue=hbox Roughness_Sensitive,/Sensitive,/Layer,/Reference,/Profiles,/Tendency,/Analysis ; refresh_exec=1 infodata.saved=0 end info.Control.RefBox.Width: begin if size(event,/sname) eq 'WIDGET_KBRD_FOCUS' then begin if event.enter ne 0 then return endif Widget_Control,event.id,Get_Value=value ; Event.Value >= 0 Widget_Control,info.Control.RefBox.Width,Get_UValue=wbox wbox[infodata.i]=Value Widget_Control,info.Control.RefBox.Width,Set_Value=Value,Set_Uvalue=wbox Roughness_Sensitive,/Sensitive,/Layer,/Reference,/Profiles,/Tendency,/Analysis ; refresh_exec=1 infodata.saved=0 end info.Control.RefBox.SavePic:begin x=[0d,infodata.ns[infodata.i]-1,infodata.ns[infodata.i]-1,0] y=[0d,0,infodata.nl[infodata.i]-1,infodata.nl[infodata.i]-1] Roughness_Correction,/refresh_coefs,layer=infodata.i Roughness_Correction,transpose([[x],[y]]),xycorr,/xy,layer=infodata.i xret=transpose(xycorr[0,*]) xret=[min(xret),max(xret)] yret=transpose(xycorr[1,*]) yret=[min(yret),max(yret)] prop=(xret[1]-xret[0])/(yret[1]-yret[0]) nst=round(700*prop) nlt=700l BaseTop=Event.Top Base=Widget_Base(/Column,Title='Saving Corrected Picture') BaseA=Widget_Base(Base,/Row) Label=Widget_Label(BaseA,Value='File:') FileName=Widget_Text(BaseA,Xsize=20) FileB=Widget_Button(BaseA,Value='Choose',Xsize=70) BaseB=Widget_Base(Base,/Row) Nsb=Cw_Field(BaseB,/Integer,/Return_Events,/Row,Title='Samples: ',Value=nst,Xsize=8) Nlb=Cw_Field(BaseB,/Integer,/Return_Events,/Row,Title='Lines: ',Value=nlt,Xsize=8) BaseC=Widget_Base(Base,/Row,/Frame) Previewt=Widget_Button(BaseC,Value='Preview',Xsize=70) OKt=Widget_Button(BaseC,Value='OK',Xsize=70,Sensitive=0) Cancelt=Widget_Button(BaseC,Value='Cancel',Xsize=70) Widget_Control,Base,/Realize while Widget_Info(Base,/Valid) do begin flag=0 Event=Widget_Event(Base,bad_id=bad_id) if bad_id ne 0 then break case Event.id of FileB:begin file=Dialog_PickFile(/Write,Filter=['*.jpg'],/Overwrite,get_path=path) if file ne '' then begin if strupcase(strmid(file,3,/rev)) ne '.JPG' then file=file+'.jpg' Widget_Control,FileName,Set_Value=file Widget_Control,Okt,/Sensitive endif end Nsb:begin nst=Event.Value > 100 nlt=round(nst/prop) if nlt lt 100 then begin nlt=100 nst=round(nlt*prop) endif Widget_Control,Nsb,Set_Value=nst Widget_Control,Nlb,Set_Value=nlt end Nlb:begin nlt=Event.Value > 100 nst=round(nlt*prop) if nst lt 100 then begin nst=100 nlt=round(nst/prop) endif Widget_Control,Nsb,Set_Value=nst Widget_Control,Nlb,Set_Value=nlt end Previewt: flag=1 OKt:begin Widget_Control,FileName,Get_Value=file ; Widget_Control,Base,/Destroy flag=2 end Cancelt:Widget_Control,Base,/Destroy Else:;nothing endcase if flag ne 0 then begin if flag eq 1 then window,0,xsize=700,ysize=round(700/prop),title='Preview' imgres=bytarr(nst,nlt,3) yres=lindgen(nst,nlt) xres=(yres mod nst)/(nst-1d) yres=(yres/nst)/(nlt-1d) xres*=(xret[1]-xret[0]) xres+=xret[0] yres*=(yret[1]-yret[0]) yres+=yret[0] Roughness_Correction,temporary(xres),temporary(yres),xrest,yrest,layer=infodata.i,/inverse temp=where((xrest ge 0) and (xrest lt (infodata.ns[infodata.i]-1)) and (yrest ge 0) and (yrest lt (infodata.nl[infodata.i]-1))) xrest=xrest[temp] yrest=yrest[temp] xrest2=long(xrest) yrest2=long(yrest) xrest-=xrest2 yrest-=yrest2 img=Roughness_LoadImage(infodata.fileimg[infodata.i]) for i=0l,2 do begin z1=float(img[xrest2+yrest2*infodata.ns[infodata.i]+infodata.ns[infodata.i]*infodata.nl[infodata.i]*i]) z2=float(img[xrest2+(yrest2+1)*infodata.ns[infodata.i]+infodata.ns[infodata.i]*infodata.nl[infodata.i]*i]) z3=float(img[(xrest2+1)+yrest2*infodata.ns[infodata.i]+infodata.ns[infodata.i]*infodata.nl[infodata.i]*i]) z4=float(img[(xrest2+1)+(yrest2+1)*infodata.ns[infodata.i]+infodata.ns[infodata.i]*infodata.nl[infodata.i]*i]) imgrest=bytarr(nst,nlt) imgrest[temp]=round(xrest*yrest*(z4-z3-z2+z1)+xrest*(z3-z1)+yrest*(z2-z1)+z1) imgres[*,*,i]=imgrest endfor ;stop ; xrest=round(temporary(xrest)) ; yrest=round(temporary(yrest)) ; img=Roughness_LoadImage(infodata.fileimg[infodata.i]) ; imgrest=bytarr(nst,nlt) ; imgrest[temp]=img[xrest[temp]+yrest[temp]*infodata.ns[infodata.i]] ; imgres[*,*,0]=imgrest ; imgrest[temp]=img[xrest[temp]+yrest[temp]*infodata.ns[infodata.i]+infodata.ns[infodata.i]*infodata.nl[infodata.i]] ; imgres[*,*,1]=imgrest ; imgrest[temp]=img[xrest[temp]+yrest[temp]*infodata.ns[infodata.i]+2*infodata.ns[infodata.i]*infodata.nl[infodata.i]] ; imgres[*,*,2]=imgrest if flag eq 2 then begin write_jpeg,file[0],imgres,true=3 Widget_Control,Base,/Destroy endif else tv,congrid(imgres,700,round(700/prop),3),true=3 endif endwhile device,window_state=temp if temp[0] ne 0 then wdelete,0 end info.Control.Prof.id: begin if info.Control.Prof.Status eq 0 then begin info.Control.Prof.Status=1 Widget_Control,info.Control.Prof.id,Set_Value='Done' Roughness_Sensitive,Sensitive=0,/Layer,/Reference,/Tendency,/Analysis Widget_Control,info.Control.Prof.OperProf,/Sensitive,Set_Uvalue={layer:infodata.i,npts:0l},Set_ComboBox_Select=0 ; Widget_Control,info.Control.Layer,Sensitive=0 ; Widget_Control,info.Control.RefBox.id,Sensitive=0 endif else begin info.Control.Prof.Status=0 Widget_Control,info.Control.Prof.id,Set_Value='Edit',Get_Uvalue=profs Widget_Control,info.Control.Prof.OperProf,Sensitive=0,Get_Uvalue=profst,/no_copy,Set_ComboBox_Select=0 Widget_Control,info.Control.Prof.OperPoint,Sensitive=0,Set_ComboBox_Select=0 Roughness_Sensitive,/Sensitive,/Layer,/Reference,/Tendency,/Analysis ; Widget_Control,info.Control.Layer,/Sensitive ; Widget_Control,info.Control.RefBox.id,/Sensitive ; refresh_exec=1 if profst.npts gt 1 then begin if profst.xy[0,0] gt profst.xy[0,profst.npts-1] then profst.xy=reverse(profst.xy,2) if n_elements(profs) eq 0 then profs=profst else profs={layer:[profs.layer,profst.layer],npts:[profs.npts,profst.npts],xy:[[profs.xy],[profst.xy]]} Widget_Control,info.Control.Prof.id,Set_Uvalue=profs refresh=1 endif endelse infodata.saved=0 ; refresh_info=1 end info.Control.Prof.OperProf:begin Widget_Control,info.Control.Prof.id,Get_Uvalue=profs if n_elements(profs) eq 0 then begin Widget_Control,info.Control.Prof.OperProf,Set_ComboBox_Select=0 break endif if (where(profs.layer eq infodata.i))[0] eq -1 then begin Widget_Control,info.Control.Prof.OperProf,Set_ComboBox_Select=0 break endif info.Control.Prof.Status=10*Event.Index+(info.Control.Prof.Status mod 10) Widget_Control,info.Control.Prof.OperPoint,Sensitive=info.Control.Prof.Status/10 eq 0,Set_ComboBox_Select=0 ; refresh_info=1 end info.Control.Prof.OperPoint:begin info.Control.Prof.Status=10*(info.Control.Prof.Status/10)+Event.Index+1 ; refresh_info=1 end info.Control.Tendency.Angle:begin Event.Value mod=360 if (abs(Event.Value) eq 90) or (abs(Event.Value) eq 270) then Event.Value=0 Widget_Control,info.Control.Tendency.Angle,Get_UValue=angle angle[infodata.i]=Event.Value Widget_Control,info.Control.Tendency.Angle,Set_Value=Event.Value,Set_Uvalue=angle infodata.saved=0 end info.Control.Tendency.Estimate:begin Roughness_Sensitive,Sensitive=0,/Layer,/Reference,/Profile,/Tendency,/Analysis Widget_Control,info.Control.Prof.id,Get_Uvalue=profs temp=[0,long(total(profs.npts,/cum))] temp2=where(profs.layer eq infodata.i) temp=transpose([[temp[temp2]],[temp[temp2+1]]]) xy=profs.xy[*,temp[0]:temp[1]-1] for i=2l,n_elements(temp)-1,2 do xy=[[xy],[profs.xy[*,temp[i]:temp[i+1]-1]]] npts=profs.npts[temp2] Roughness_Correction,/refresh_coefs,layer=infodata.i Roughness_Correction,temporary(xy),xycorr,/xy,layer=infodata.i xycorr[0,*]-=min(xycorr[0,*]) ipts=[0,long(total(npts,/cum))] Widget_Control,info.Control.Analysis.HorSampl,Get_Value=dx n=long(max(xycorr[0,*])/dx)+1 yres=replicate(!values.f_nan,n) yres[0]=xycorr[1,0] for i=1l,n-1 do begin for j=0l,n_elements(ipts)-2 do begin xt=xycorr[0,ipts[j]:ipts[j+1]-1] yt=xycorr[1,ipts[j]:ipts[j+1]-1] temp=xt le (i*dx) if max(temp) eq 0 then continue if min(temp) eq 1 then continue temp=where((temp eq 1) and (shift(temp,-1) eq 0)) yres[i]=max([yres[i],(i*dx-xt[temp])*(yt[temp+1]-yt[temp])/(xt[temp+1]-xt[temp])+yt[temp]],/nan) endfor endfor yres-=(total(yres,/nan)/total(finite(yres))) Widget_Control,info.Control.Tendency.Angle,Get_UValue=angle Base=Widget_Base(/Column,Title='Tendency Correction ('+infodata.sname[infodata.i]+')',/Tlb_Size_Events,Group_Leader=info.Main.id,Kill_Notify='Roughness_Tendency_Kill') Draw1=Widget_Draw(Base,Xsize=700,Ysize=200,Retain=2,/Button,/Frame) Draw2=Widget_Draw(Base,Xsize=700,Ysize=200,Retain=2,/Frame) BaseA=Widget_Base(Base,/Row,/Frame) Angle=Cw_Field(BaseA,/Floating,/Return_Events,/Row,Title='Angle (degrees): ',Value=angle[infodata.i],Xsize=8) Best=Widget_Button(BaseA,Value='Best',Xsize=70) Zero=Widget_Button(BaseA,Value='Zero',Xsize=70) BaseB=Widget_Base(Base,/Row,/Frame) OK=Widget_Button(BaseB,Value='OK',Xsize=70) Cancel=Widget_Button(BaseB,Value='Cancel',Xsize=70) Widget_Control,Base,/Realize,Set_Uvalue={Draw1:Draw1,Draw2:Draw2,Angle:Angle,Best:Best,Zero:Zero,OK:OK,Cancel:Cancel,y:yres,MainBase:Event.Top,MainAngle:info.Control.Tendency.Angle,dx:dx} ; Widget_Control,info.Control.Tendency.Estimate,Set_UValue=Base Xmanager,'Roughness_Tendency',Base,/No_Block Roughness_Tendency_Event,{Top:Base,id:-1l} end info.Control.Analysis.HorSampl:begin if Event.Value le 0 then Event.Value=.5 Widget_Control,info.Control.Analysis.HorSampl,Set_Value=Event.Value Widget_Control,info.Control.Analysis.rmsdetails,Get_Uvalue=temp,/no_copy,sensitive=0 Widget_Control,info.Control.Analysis.lcdetails,Get_Uvalue=temp,/no_copy,sensitive=0 end info.Control.Analysis.RMSdetails:begin Roughness_Sensitive,Sensitive=0,/Layer,/Reference,/Profile,/Tendency,/Analysis color=[255,255*256l,255* 256l * 256l] color=[color[0],color[0]+color[1],color[1],color[1]+color[2],color[2],color[0]+color[2],color[0]+color[1]+color[2]] Base=Widget_Base(/Column,Title='RMS',/Tlb_Size_Events,Group_Leader=info.Main.id,Kill_Notify='Roughness_RMS_Kill',Mbar=bar) menuf=Widget_Button(bar,Value='File',/Menu) menus=Widget_Button(menuf,Value='Export to ASCII') menuprop=Widget_Button(menuf,Value='Properties') menuexit=Widget_Button(menuf,Value='Exit',/Separator) BaseA=Widget_Base(Base,/Row,/Frame) Draw=Widget_Draw(BaseA,Xsize=500,Ysize=400,Retain=2) BaseA1=Widget_Base(BaseA,/Column,/Frame,/Scroll) label=Widget_Label(BaseA1,Value='Picture') sels=lonarr(n_elements(infodata.fileimg)) colors=lonarr(n_elements(infodata.fileimg)) for i=0l,n_elements(infodata.fileimg)-1 do begin Baset=Widget_Base(BaseA1,/Row) colors[i]=Widget_Draw(Baset,Xsize=30,Ysize=30,Retain=2,/Button_Events,Uvalue=color[i mod n_elements(color)]) sels[i]=Cw_BGroup(Baset,[infodata.sname[i]],/NonExclusive,/Row,Set_Value=1) endfor Text=Widget_Text(BaseA,/Scroll,Xsize=30) ; BaseB=Widget_Base(Base,/Row,/Frame) ; Cancel=Widget_Button(BaseB,Value='Cancel',Xsize=70) Widget_Control,Base,/Realize,Set_Uvalue={export:menus,prop:menuprop,Cancel:menuexit,Draw:Draw,sels:sels,colors:colors,Text:Text,background:0l,foreground:16777215l,thick:1.,xrange:[0,0.],yrange:[0,0.]} Xmanager,'Roughness_RMS',Base,/No_Block Roughness_RMS_Event,{Top:Base,id:-1l} end info.Control.Analysis.Lcdetails:begin Roughness_Sensitive,Sensitive=0,/Layer,/Reference,/Profile,/Tendency,/Analysis color=[255,255*256l,255* 256l * 256l] color=[color[0],color[0]+color[1],color[1],color[1]+color[2],color[2],color[0]+color[2],color[0]+color[1]+color[2]] Base=Widget_Base(/Column,Title='Autocorrelation function',/Tlb_Size_Events,Group_Leader=info.Main.id,Kill_Notify='Roughness_Auto_Kill',Mbar=bar) menuf=Widget_Button(bar,Value='File',/Menu) menus=Widget_Button(menuf,Value='Export to ASCII') menuprop=Widget_Button(menuf,Value='Properties') menuexit=Widget_Button(menuf,Value='Exit',/Separator) BaseA=Widget_Base(Base,/Row,/Frame) Draw=Widget_Draw(BaseA,Xsize=500,Ysize=400,Retain=2) BaseA1=Widget_Base(BaseA,/Column,/Frame,/Scroll) label=Widget_Label(BaseA1,Value='Picture') sels=lonarr(n_elements(infodata.fileimg)+(n_elements(infodata.fileimg) gt 1)) colors=lonarr(n_elements(infodata.fileimg)+(n_elements(infodata.fileimg) gt 1)) for i=0l,n_elements(infodata.fileimg)-1 do begin Baset=Widget_Base(BaseA1,/Row) colors[i]=Widget_Draw(Baset,Xsize=30,Ysize=30,Retain=2,/Button_Events,Uvalue=color[i mod n_elements(color)]) sels[i]=Cw_BGroup(Baset,[infodata.sname[i]],/NonExclusive,/Row,Set_Value=1) endfor if n_elements(infodata.fileimg) gt 1 then begin Baset=Widget_Base(BaseA1,/Row) colors[n_elements(infodata.fileimg)]=Widget_Draw(Baset,Xsize=30,Ysize=30,Retain=2,/Button_Events,Uvalue=16777215l) sels[n_elements(infodata.fileimg)]=Cw_BGroup(Baset,['General'],/NonExclusive,/Row,Set_Value=1) endif else Widget_Control,colors[0],Set_Uvalue=16777215l Text=Widget_Text(BaseA,/Scroll,Xsize=30) ; BaseB=Widget_Base(Base,/Row,/Frame) ; Cancel=Widget_Button(BaseB,Value='Cancel',Xsize=70) Widget_Control,Base,/Realize,Set_Uvalue={export:menus,prop:menuprop,Cancel:menuexit,Draw:Draw,sels:sels,colors:colors,Text:Text,background:0l,foreground:16777215l,thick:1.,xrange:[0,0.],yrange:[-1,1.]} Xmanager,'Roughness_Auto',Base,/No_Block Roughness_Auto_Event,{Top:Base,id:-1l} end info.Control.Analysis.Refresh:begin Widget_Control,info.Control.Prof.id,Get_Uvalue=profs Widget_Control,info.Control.Tendency.Angle,Get_UValue=angle angle/=!radeg b=tan(angle) ipts=[0,long(total(profs.npts,/cum))] Roughness_Correction,/refresh_coefs ycorr=0. nptscorr=0l layercorr=0l for i=0l,n_elements(infodata.fileimg)-1 do begin temp=where(profs.layer eq i) if temp[0] eq -1 then continue temp=transpose([[ipts[temp]],[ipts[temp+1]]]) xy=profs.xy[*,temp[0]:temp[1]-1] for j=2l,n_elements(temp)-1,2 do xy=[[xy],[profs.xy[*,temp[j]:temp[j+1]-1]]] npts=transpose([temp[1,*]-temp[0,*]]) Roughness_Correction,temporary(xy),xycorr,/xy,layer=i xycorr[0,*]-=min(xycorr[0,*]) iptst=[0,long(total(npts,/cum))] Widget_Control,info.Control.Analysis.HorSampl,Get_Value=dx n=long(max(xycorr[0,*])/dx)+1 yres=replicate(!values.f_nan,n) yres[0]=xycorr[1,0] for k=1l,n-1 do begin for j=0l,n_elements(iptst)-2 do begin xt=xycorr[0,iptst[j]:iptst[j+1]-1] yt=xycorr[1,iptst[j]:iptst[j+1]-1] temp=xt le (k*dx) if max(temp) eq 0 then continue if min(temp) eq 1 then continue temp=where((temp eq 1) and (shift(temp,-1) eq 0)) yres[k]=max([yres[k],(k*dx-xt[temp])*(yt[temp+1]-yt[temp])/(xt[temp+1]-xt[temp])+yt[temp]],/nan) endfor endfor yres-=(total(yres,/nan)/total(finite(yres))) xres=dx*lindgen(n_elements(yres)) a=-b[i]*total(xres)/n_elements(xres) yestim=a+b[i]*xres layercorr=[layercorr,i] nptscorr=[nptscorr,n_elements(yres)] ycorr=[ycorr,yres-yestim] endfor layercorr=layercorr[1:*] nptscorr=nptscorr[1:*] ycorr=ycorr[1:*] rms=stddev(ycorr,/nan) Widget_Control,info.Control.Analysis.rms,Set_Value=rms Widget_Control,info.Control.Analysis.RMSdetails,Set_UValue={layer:layercorr,npts:nptscorr,ycorr:ycorr},/Sensitive acorr_corr=acorr(ycorr,lindgen((n_elements(ycorr)-20) > 5),series=replicatevector(lindgen(n_elements(nptscorr)),nptscorr)) acorr_corr=acorr_corr[0:max(where(finite(acorr_corr)))] Widget_Control,info.Control.Analysis.Lcdetails,Set_UValue=acorr_corr,/Sensitive temp=min(where(acorr_corr lt exp(-1))) Lc=0. if temp ne -1 then Lc=((exp(-1)-acorr_corr[temp-1])/(acorr_corr[temp]-acorr_corr[temp-1])+temp-1)*dx Widget_Control,info.Control.Analysis.Lc,Set_Value=Lc refresh=1 Roughness_Sensitive,/Sensitive,/Analysis ; refresh_exec=1 end ; info.Control.Exec:begin ; stop ; Widget_Control,info.Control.RefBox.id,Get_Uvalue=xybox ; Widget_Control,info.Control.RefBox.Height,Get_Value=h ; Widget_Control,info.Control.RefBox.Width,Get_Value=w ; Widget_Control,info.Control.Prof.id,Get_Uvalue=profs ; B=[0d,w,w,0,0,0,h,h] ; A=dblarr(8,8) ; A[0:1,0:3]=xybox ; A[2,0:3]=1 ; A[6:7,1:2]=-w*xybox[*,1:2] ; A[3:4,4:7]=xybox ; A[5,4:7]=1 ; A[6:7,6:7]=-h*xybox[*,2:3] ; coefs=CRAMER(A,B,/double) ; xret=(coefs[0]*[0d,infodata.ns[infodata.i],infodata.ns[infodata.i],0,0]+coefs[1]*[0d,0,infodata.nl[infodata.i],infodata.nl[infodata.i],0]+coefs[2])/(coefs[6]*[0d,infodata.ns[infodata.i],$ ; infodata.ns[infodata.i],0,0]+coefs[7]*[0d,0,infodata.nl[infodata.i],infodata.nl[infodata.i],0]+1) ; yret=(coefs[3]*[0d,infodata.ns[infodata.i],infodata.ns[infodata.i],0,0]+coefs[4]*[0d,0,infodata.nl[infodata.i],infodata.nl[infodata.i],0]+coefs[5])/(coefs[6]*[0d,infodata.ns[infodata.i],$ ; infodata.ns[infodata.i],0,0]+coefs[7]*[0d,0,infodata.nl[infodata.i],infodata.nl[infodata.i],0]+1) ; xbox=(coefs[0]*xybox[0,*]+coefs[1]*xybox[1,*]+coefs[2])/(coefs[6]*xybox[0,*]+coefs[7]*xybox[1,*]+1) ; ybox=(coefs[3]*xybox[0,*]+coefs[4]*xybox[1,*]+coefs[5])/(coefs[6]*xybox[0,*]+coefs[7]*xybox[1,*]+1) ; x=transpose((coefs[0]*profs.xy[0,*]+coefs[1]*profs.xy[1,*]+coefs[2])/(coefs[6]*profs.xy[0,*]+coefs[7]*profs.xy[1,*]+1)) ; y=transpose((coefs[3]*profs.xy[0,*]+coefs[4]*profs.xy[1,*]+coefs[5])/(coefs[6]*profs.xy[0,*]+coefs[7]*profs.xy[1,*]+1)) ; ipts=[0,long(total(profs.npts,/cum))] ; prop=(max(xret)-min(xret))/(max(yret)-min(yret)) ; nst=round(700*prop) ; nlt=700l ; window,0,xsize=nst,ysize=nlt,retain=2 ; plot,xret,yret,xmargin=[0,0],ymargin=[0,0],xstyle=5,ystyle=5,/noerase ; oplot,[transpose(xbox),xbox[0]],[transpose(ybox),ybox[0]],color=255 * 256l * 256l ; for i=0l,n_elements(ipts)-2 do oplot,[x[ipts[i]:ipts[i+1]-1]],[y[ipts[i]:ipts[i+1]-1]],color=255l ; b1=(regress(x,y,const=b0,correlation=r))[0] ; pvalue=fltarr(1000) ; for i=0l,999 do pvalue[i]=correlate(x,y[sort(randomu(seed,n_elements(y)))]) ; pvalue=total(pvalue le r[0])/1000 ; temp=[min(xret),max(xret)] ; oplot,temp,b0+b1*temp,color=65000 ; Text=['Tendency Analysis (Z = b0 + b1X)',''] ; Text=[Text,'b0 ='+string(b0),'b1 ='+string(b1),'r ='+string(r),'P-value ='+string(pvalue)] ; Text=[Text,'','Do you want to continue correcting the profile?'] ; wset,0 ; res=Dialog_Message(Text,/Question,Title='Profile Correction') ; if res eq 'Yes' then y-=(b0+b1*x) else y-=(total(y)/n_elements(y)) ; x-=min(x) ; dx=.5 ; n=long(max(x)/dx)+1 ; yres=replicate(!values.f_nan,n) ; yres[0]=y[0] ; for i=1l,n-1 do begin ; for j=0l,n_elements(ipts)-2 do begin ; xt=[x[ipts[j]:ipts[j+1]-1]] ; yt=[y[ipts[j]:ipts[j+1]-1]] ; temp=xt le (i*dx) ; if max(temp) eq 0 then continue ; if min(temp) eq 1 then continue ; temp=where((temp eq 1) and (shift(temp,-1) eq 0)) ; yres[i]=max((i*dx-xt[temp])*(yt[temp+1]-yt[temp])/(xt[temp+1]-xt[temp])+yt[temp]) ; endfor ; endfor ; print,'RMS:',stddev(yres,/nan),' cm' ; acorr_res=acorr(yres,lindgen((n_elements(yres)-20) > 5)) ; temp=min(where(acorr_res lt 0)) ; if temp gt 1 then acorr_res=acorr_res[0:temp-1] ; temp=min(where(acorr_res lt exp(-1))) ; window,1 ; plot,dx*findgen(n_elements(acorr_res)),acorr_res,xtitle='Lag (cm)',ytitle='auto correlation' ; oplot,[0,dx*n_elements(acorr_res)],[exp(-1),exp(-1)],color=255 ; if temp ne -1 then begin ; Lc=((exp(-1)-acorr_res[temp-1])/(acorr_res[temp]-acorr_res[temp-1])+temp-1)*dx ; print,'Lc:',Lc,' cm' ; oplot,[Lc,Lc],[0,1],color=65000 ; xyouts,Lc,.4,'Lc' ; endif else begin ; print,'nao foi possivel calcular Lc' ; endelse ; prop=(max(xret)-min(xret))/(max(yret)-min(yret)) ; nst=round(700*prop) ; nlt=700l ; window,0,xsize=nst,ysize=nlt ; imgres=bytarr(nst,nlt,3) ; yres=lindgen(infodata.ns,infodata.nl) ; xres=yres mod infodata.ns ; yres=yres/infodata.ns ; xrest=(round(((coefs[0]*xres+coefs[1]*yres+coefs[2])/(coefs[6]*xres+coefs[7]*yres+1)-min(xret))/(max(xret)-min(xret))*nst) < (nst-1)) > 0 ; yrest=(round(((coefs[3]*xres+coefs[4]*yres+coefs[5])/(coefs[6]*xres+coefs[7]*yres+1)-min(yret))/(max(yret)-min(yret))*nlt) < (nlt-1)) > 0 ; for i=0l,infodata.ns-1 do for j=0l,infodata.nl-1 do imgres[xrest[i,j],yrest[i,j],*]=info.img[i,j,*] ; tv,imgres,true=3 ; plot,xret,yret,xmargin=[0,0],ymargin=[0,0],xstyle=5,ystyle=5,/noerase ; oplot,[transpose(xbox),xbox[0]],[transpose(ybox),ybox[0]],color=255 * 256l * 256l ; for i=0l,n_elements(temp)-2 do oplot,[x[temp[i]:temp[i+1]-1]],[y[temp[i]:temp[i+1]-1]],color=255l ; stop ; end Else:begin ; info.Control.RefRetStatus=(where(info.Control.RefRet eq Event.id))[0]+1 ; refresh_info=1 end EndCase ; if refresh_info ne 0 then Widget_Control,Base,Set_Uvalue=info if refresh ne 0 then Roughness_View,Base refresh_exec=0 ;apagar depois !!!!!!!!!!!!!!!!!!!!!!!! if refresh_exec ne 0 then begin Widget_Control,info.Control.RefBox.Height,Get_UValue=hbox Widget_Control,info.Control.RefBox.Width,Get_UValue=wbox flag=hbox[infodata.i] gt 0 if flag ne 0 then flag=wbox[infodata.i] gt 0 Widget_Control,info.Control.Prof.id,Get_Uvalue=profs if flag ne 0 then begin if n_elements(profs) ne 0 then flag=(where(profs.layer eq infodata.i))[0] ne -1 else flag=0 endif Widget_Control,info.Control.Tendency.Angle,Sensitive=flag Widget_Control,info.Control.Tendency.Estimate,Sensitive=flag Widget_Control,info.Control.Analysis.Refresh,Sensitive=((min([hbox,wbox]) gt 0) and (n_elements(profs) ne 0)) ; Widget_Control,info.Control.Analysis.RMSdetails,Get_Uvalue=temp ; Widget_Control,info.Control.Analysis.RMSdetails,Sensitive=n_elements(temp) ne 0 ; Widget_Control,info.Control.Analysis.Lcdetails,Get_Uvalue=temp ; Widget_Control,info.Control.Analysis.Lcdetails,Sensitive=n_elements(temp) ne 0 endif END PRO Roughness,file COMMON Roughness_COMMON,info,infodata,coefs if n_elements(info) ne 0 then return fileprd='' sname='' hbox=0. wbox=0. ns=0l nl=0l angle=0. horsampl=.5 rms=0. Lc=0. if n_elements(file) eq 0 then file=Dialog_PickFile(/Read,Filter=['*.prd','*.bmp','*.jpg','*.png','*.tif'],/Must_Exist,get_path=path) if file eq '' then return if n_elements(path) eq 0 then path=strmid(file,0,strlen(file)-strlen((reverse([strsplit(file,path_sep(),/extract)]))[0])) cd,path if strupcase(strmid(file,3,/rev)) eq '.PRD' then begin fileprd=file openr,fid,file,/get_lun nimg=0l readf,fid,nimg fileimg=strarr(nimg) path=strarr(nimg) sname=strarr(nimg) ns=lonarr(nimg) nl=lonarr(nimg) fileimgt='' xybox=fltarr(2,4,nimg) xyboxt=fltarr(2,4) hbox=fltarr(nimg) wbox=fltarr(nimg) hboxt=0. wboxt=0. nprof=0l nptst=0l angle=fltarr(nimg) anglet=0. for k=0l,nimg-1 do begin readf,fid,fileimgt fileimg[k]=fileimgt path[k]=strmid(fileimgt,0,strlen(fileimgt)-strlen((reverse([strsplit(fileimgt,path_sep(),/extract)]))[0])) readf,fid,xyboxt xybox[*,*,k]=xyboxt readf,fid,hboxt,wboxt hbox[k]=hboxt wbox[k]=wboxt readf,fid,nprof if nprof ne 0 then begin readf,fid,nptst xyt=fltarr(2,nptst) readf,fid,xyt if n_elements(npts) eq 0 then npts=nptst else npts=[npts,nptst] if n_elements(xy) eq 0 then xy=xyt else xy=[[xy],[xyt]] if n_elements(layer) eq 0 then layer=k else layer=[layer,k] endif for i=1l,nprof-1 do begin readf,fid,nptst xyt=fltarr(2,nptst) readf,fid,xyt npts=[npts,nptst] xy=[[xy],[xyt]] layer=[layer,k] endfor readf,fid,anglet angle[k]=anglet endfor readf,fid,horsampl readf,fid,RMS readf,fid,Lc free_lun,fid endif else fileimg=file for k=0l,n_elements(fileimg)-1 do begin sname[k]=strmid(fileimg[k],strlen(path[k])) if Query_Image(fileimg[k],dimensions=temp) eq 0 then begin print,'nao foi possivel abrir a imagem...' ; stop return endif ns[k]=temp[0] nl[k]=temp[1] endfor coefs=fltarr(8,n_elements(fileimg)) if n_elements(xybox) eq 0 then xybox=[[0,0.],[ns[0],0],[ns[0],nl[0]],[0,nl[0]]] dsize=transpose([[400 < ns],[400 < nl]]) Base=Widget_Base(/Column,Title='Profile Picture ('+sname[0]+')',/Tlb_Size_Events,/Tlb_Kill_Request_Events) Draw=Widget_Draw(Base,Xsize=dsize[0],Ysize=dsize[1],Retain=2,/Button) Widget_Control,Base,/Realize Widget_Control,Base,Tlb_Get_Offset=boffset,Tlb_Get_Size=bsize BaseS=Widget_Base(/Column,Title='Scroll',Group_Leader=Base,Uvalue=Base,Kill_Notify='Roughness_Kill',/Tlb_Size_Events,/Tlb_Kill_Request_Events) temp=ns[0] > nl[0] dimsS=round([250.*ns[0]/temp,250.*nl[0]/temp]) DrawS=Widget_Draw(BaseS,Xsize=dimsS[0],Ysize=dimsS[1],Retain=2,/Button) Widget_Control,BaseS,/Realize Widget_Control,BaseS,Tlb_Set_Xoffset=boffset[0],Tlb_Set_Yoffset=boffset[1]+bsize[1]+40 BaseControl=Widget_Base(/Column,Title='Control Panel',Group_Leader=Base,Uvalue=Base,Kill_Notify='Roughness_Kill',Mbar=bar,/Tlb_Kill_Request_Events) menuf=Widget_Button(bar,Value='File',/Menu) menui=Widget_Button(menuf,Value='Load',/Menu) menuidata=Widget_Button(menui,Value='New Profile Data') menuipic=Widget_Button(menui,Value='Add Picture') menus=Widget_Button(menuf,Value='Save',/Menu) menusdata=Widget_Button(menus,Value='Profile Data') menuprop=Widget_Button(menuf,Value='Properties') menuexit=Widget_Button(menuf,Value='Exit',/Separator) menut=Widget_Button(bar,Value='Test',/Menu) menustop=Widget_Button(menut,Value='Stop') Base2=Widget_Base(BaseControl,/Column,/Frame) Zoom=Cw_Counter(Base2,/Editable,Xsize=3,Title='Zoom 1:',Minimum=1,Value=1,Uvalue=replicate(1,n_elements(fileimg))) Base2A=Widget_Base(Base2,/Row,/Frame) Label=Widget_Label(Base2A,Value='Picture:') Base2A1=Widget_Base(Base2A,/Row) Pic=Widget_ComboBox(Base2A1,Value=sname,Uvalue=dsize) DelPic=Widget_Button(Base2A1,Value='Delete',Sensitive=n_elements(fileimg) gt 1) Base2B=Widget_Base(Base2,/Column,/Frame) Label=Widget_Label(Base2B,Value='Reference Box',/Align_Left) Base2B1=Widget_Base(Base2B,/Row) ; if n_elements(xybox) eq 0 then xybox=[[0,0.],[ns,0],[ns,nl],[0,nl]] RB=Widget_Button(Base2B1,Value='Modify Box',Uvalue=xybox) Base2B2=Widget_Base(Base2B,/Row) Height=CW_FloatParam(Base2B2,/Row,Title='Height (cm): ',Value=hbox[0],Xsize=8,/kbrd_focus_events,minimum=0,Uvalue=hbox) ; Height=Cw_Field(Base2B2,/Floating,/Return_Events,/Row,Title='Height (cm): ',Value=hbox[0],Xsize=8,Uvalue=hbox) Base2B3=Widget_Base(Base2B,/Row) Width=CW_FloatParam(Base2B3,/Row,Title='Width (cm): ',Value=wbox[0],Xsize=8,/kbrd_focus_events,minimum=0,Uvalue=wbox) ; Width=Cw_Field(Base2B3,/Floating,/Return_Events,/Row,Title='Width (cm): ',Value=wbox[0],Xsize=8,Uvalue=wbox) Base2B4=Widget_Base(Base2B,/Row) SavePic=Widget_Button(Base2B4,Value='Save Picture',Sensitive=(hbox[0] < wbox[0]) gt 0) Base2C=Widget_Base(Base2,/Column,/Frame) Label=Widget_Label(Base2C,Value='Profiles',/Align_Left) Base2C1=Widget_Base(Base2C,/Row) NewProf=Widget_Button(Base2C1,Value='Edit',Xsize=70) OperProf=Widget_Combobox(Base2C1,Value=['Edit profile','Select profile','Delete profile'],Sensitive=0) OperPoint=Widget_Combobox(Base2C1,Value=['Add point','Move point','Delete point'],Sensitive=0) Base2D=Widget_Base(Base2,/Column,/Frame) Label=Widget_Label(Base2D,Value='Tendency Correction',/Align_Left) Base2D1=Widget_Base(Base2D,/Row) flag=((hbox[0] < wbox[0]) gt 0) and (n_elements(xy) ne 0) if flag ne 0 then flag=(where(layer eq 0))[0] ne -1 Angle=Cw_Field(Base2D1,/Floating,/Return_Events,/Row,Title='Angle (degrees): ',Value=angle[0],Xsize=8,Uvalue=angle) Widget_Control,Angle,Sensitive=flag Estim=Widget_Button(Base2D1,Value='Estimate',Sensitive=flag) Base3=Widget_Base(BaseControl,/Column,/Frame) Label=Widget_Label(Base3,Value='Roughness Analysis',/Align_Left) Sampl=Cw_Field(Base3,/Floating,/Return_Events,/Row,Title='Horizontal Resampling (cm): ',Value=horsampl,Xsize=8) Base3A=Widget_Base(Base3,/Row) RMS=Cw_Field(Base3A,/Floating,/Noedit,/Row,Title='RMS (cm): ',Value=RMS,Xsize=8) RMSd=Widget_Button(Base3A,Value='Details',Xsize=70,Sensitive=0) Base3B=Widget_Base(Base3,/Row) Lc=Cw_Field(Base3B,/Floating,/Noedit,/Row,Title='Lc (cm): ',Value=Lc,Xsize=8) Lcd=Widget_Button(Base3B,Value='Details',Xsize=70,Sensitive=0) Base3C=Widget_Base(Base3,/Row) Refresh=Widget_Button(Base3C,Value='Refresh',Xsize=70,Sensitive=(min([hbox,wbox]) gt 0) and (n_elements(xy) ne 0)) Widget_Control,BaseControl,/Realize Widget_Control,BaseControl,Tlb_Set_Xoffset=boffset[0]+bsize[0]+8,Tlb_Set_Yoffset=boffset[1] infodata={i:0l,fileprd:fileprd,fileimg:fileimg,sname:sname,ns:ns,nl:nl,pcentral:lonarr(2,n_elements(fileimg)),saved:1b} info={Main:{id:Base,Draw:Draw},Scroll:{id:BaseS,Draw:DrawS},$ Control:{id:BaseControl,Zoom:Zoom,factor:1l,layer:Pic,delete:delPic,RefBox:{id:RB,Height:Height,Width:Width,SavePic:SavePic,Status:0b},Prof:{id:NewProf,OperProf:OperProf,OperPoint:OperPoint,Status:0b},Tendency:{Angle:Angle,Estimate:Estim},$ Analysis:{HorSampl:Sampl,RMS:RMS,RMSdetails:RMSd,Lc:Lc,Lcdetails:Lcd,Refresh:Refresh}},$ menu:{loaddata:menuidata,loadpicture:menuipic,savedata:menusdata,prop:menuprop,exit:menuexit,stop:menustop},$ prop:{box:16711680l,prof:255l,edit:65535l,viswin:255l,thick:1.}} if n_elements(xy) ne 0 then Widget_Control,NewProf,Set_Uvalue={layer:layer,npts:npts,xy:xy} Roughness_View,Base Xmanager,'Roughness',Base,/No_Block Xmanager,'Roughness',BaseS,/No_Block Xmanager,'Roughness',BaseControl,/No_Block END PRO junta_prd filein=Dialog_PickFile(/Read,Filter=['*.prd'],get_path=path,/Must_Exist,/Multiple_Files) if filein[0] eq '' then return cd,path fileout=Dialog_PickFile(/Write,Filter=['*.prd'],get_path=path,/Overwrite) if fileout eq '' then return cd,path file='' box=fltarr(2,4) hbox=0. wbox=0. nprof=0l npts=0l openw,fidout,fileout,/get_lun printf,fidout,n_elements(filein) for i=0l,n_elements(filein)-1 do begin openr,fid,filein[i],/get_lun readf,fid,file,box,hbox,wbox,nprof printf,fidout,file printf,fidout,box printf,fidout,hbox printf,fidout,wbox printf,fidout,nprof for j=0l,nprof-1 do begin readf,fid,npts printf,fidout,npts xy=fltarr(2,npts) readf,fid,xy printf,fidout,xy endfor free_lun,fid printf,fidout,0. endfor printf,fidout,.5 printf,fidout,0. printf,fidout,0. free_lun,fidout print,'fim' END PRO DAT2PRD filein=Dialog_PickFile(/Read,Filter=['*.dat'],get_path=path,/Must_Exist) if filein[0] eq '' then return cd,path filejpg=Dialog_PickFile(/Read,Filter=['*.jpg'],get_path=path,/Must_Exist) if filejpg[0] eq '' then return fileout=Dialog_PickFile(/Write,Filter=['*.prd'],get_path=path,/Overwrite) if fileout eq '' then return cd,path file='' box=fltarr(2,4) hbox=0. wbox=0. nprof=0l npts=0l openw,fidout,fileout,/get_lun printf,fidout,1l printf,fidout,filejpg openr,fid,filein,/get_lun readf,fid,wbox,hbox readf,fid,nprof ;descartar readf,fid,npts ;descartar readf,fid,box readf,fid,npts xy=fltarr(2,npts) readf,fid,xy printf,fidout,box printf,fidout,hbox printf,fidout,wbox printf,fidout,1l printf,fidout,npts printf,fidout,xy free_lun,fid printf,fidout,0. printf,fidout,.5 printf,fidout,0. printf,fidout,0. free_lun,fidout print,'fim' END