This page was created by the IDL library routine
mk_html_help. For more information on
this routine, refer to the IDL Online Help Navigator
or type:
? mk_html_help
at the IDL command line prompt.
Last modified: 13.07.2004
NAME:
gen_schw
pro gen_schw,prae,na,param,head,feat,anf,_EXTRA=disp,NEW=new,EXTENSION=ext
if not keyword_set(ext) then ext='cel'
anz=get_num(na,prae,new=new)-1
case strupcase(ext) of
'CEL': bild=read_dtp(na)
'TIF': bild=tiff_read(na)
else: message,'Not supported file type'
endcase
if anf lt anz then ifeat=fltarr(256) else ifeat=feat(anz)
n_schw,na,bild,param,ifeat,_EXTRA=disp,ERG_CH=erg_ch,EXTENSION=ext
ifeat(0)=float(anz+1)
feat(anz) = ifeat
ihead=lonarr(256) & ihead(*)=head(0)
if ihead(0) le anz then begin
ihead(0)=anz+1
head(0) = ihead
end
print,erg_ch,na,byte(feat(1,anz))
end
(See /IDL/pro_src/RODENA/pro_neu/rod/gen_schw.pro)
NAME:
n_schw
pro n_schw,na,bild,param,ifeat,MASK=mask,DISPLAY=disp,ERG_CH=erg_ch, $
EXTENSION=ext
if not keyword_set(mask) then mask=0
if not keyword_set(ext) then ext='cel'
if keyword_set(disp) then begin
tv,bytarr(256,384),0,0 & !p.multi=[1,1,3,0,0] & tv,bild,0
endif
erg_ch='*'
case param.thre.thsv of
1: begin ; My simple threshold
hi=histogram(bild)
ifeat(1)=float(round(s_thr(hi, $
param.thre.thss,param.thre.thsa,param.thre.thsf, $
display=disp)))
ifeat(2)=ifeat(1)
ifeat(6)=0. & ifeat(7)=0.
fail=0 & binb=0
end
2: begin ; Gaussian threshold
hi=histogram(bild)
ifeat(1)=float(round(g_thr(hi, $
param.thre.thsf, smooth=param.thre.thss, $
display=disp)))
ifeat(2)=ifeat(1)
ifeat(6)=0. & ifeat(7)=0.
fail=0 & binb=0
end
3: begin ; Gaussian threshold and cluster
hi=histogram(bild)
ifeat(1)=float(round(g_thr(hi, $
param.thre.thsf, smooth=param.thre.thss, $
display=disp)))
ifeat(2)=ifeat(1)
ifeat(6)=0. & ifeat(7)=0.
bina=ns_clust(b2fl(smooth(bild,3)),2,1,1)
binb=fill(fer(select(bina,64,64)))
fail=0
end
-1: begin
para=fltarr(9) & para(*)=-1. & para(5)=100.
erge=fltarr(11) & erge(*)=0.
binb=0
ifeat(1)=float(d_thr(bild,255,para,erge))
if ifeat(1) gt 0. then begin
erg_ch=' '
print,format='($," ")'
ifeat(2)=ifeat(1)
ifeat(6)=erge(5)& ifeat(7)=erge(3)
ifeat(8)=erge(1)& ifeat(9)=erge(2)
ifeat(10)=erge(3)& ifeat(11)=erge(4)
ifeat(12)=erge(0)
fail=0
Manchmal erfuellt der Startpunkt der gefundenen Maske nicht die
Schwellbedingung, anscheinend ein Fehler in D_THR. In diesem Fall
veraendere ich das Bild.
if bild(ifeat(6),ifeat(7)) gt ifeat(1) then $
bild(ifeat(6),ifeat(7))=ifeat(1)
endif else begin
ifeat(2)=0.
ifeat(6)=0. & ifeat(7)=0.
hi=histogram(bild)
ifeat(1)=float(round(s_thr(hi, $
param.thre.thss,param.thre.thsa,param.thre.thsf, $
display=disp)))
if param.thre.thsr then begin
erg_ch='*'
print,format='($,"*")'
binb=byte(bild le byte(ifeat(1)))
endif else begin
erg_ch='C'
print,format='($,"C")'
bina=ns_clust(b2fl(smooth(bild,3)),2,1,1)
binb=fill(fer(select(bina,64,64)))
endelse
if keyword_set(disp) then tvscl,binb,1
fail=1
endelse
end
-2: begin
para=fltarr(9) & para(*)=-1. & para(5)=100.
erge=fltarr(11) & erge(*)=0.
binb=0
ifeat(1)=float(d_thr_n(bild,para,erge,/inv))
if ifeat(1) gt 0. then begin
erg_ch=' '
print,format='($," ")'
ifeat(2)=ifeat(1)
ifeat(6)=erge(0)& ifeat(7)=erge(1)
ifeat(4)=erge(4)
fail=0
Manchmal erfuellt der Startpunkt der gefundenen Maske nicht die
Schwellbedingung, anscheinend ein Fehler in D_THR. In diesem Fall
veraendere ich das Bild.
if bild(ifeat(6),ifeat(7)) gt ifeat(1) then $
bild(ifeat(6),ifeat(7))=ifeat(1)
endif else begin
ifeat(2)=0.
ifeat(6)=0. & ifeat(7)=0.
hi=histogram(bild)
ifeat(1)=float(round(s_thr(hi, $
param.thre.thss,param.thre.thsa,param.thre.thsf, $
display=disp)))
if param.thre.thsr then begin
erg_ch='*'
print,format='($,"*")'
binb=byte(bild le byte(ifeat(1)))
endif else begin
erg_ch='C'
print,format='($,"C")'
bina=ns_clust(b2fl(smooth(bild,3)),2,1,1)
binb=fill(fer(select(bina,64,64)))
endelse
if keyword_set(disp) then tvscl,binb,1
fail=1
endelse
end
else:message,'Threshold method not defined'
end
if param.thre.thsm or keyword_set(mask) then begin
Bildmaske mit abspeichern
if (ifeat(2) ne 0.) and not fail and typeof(binb,/dim) eq 0 then $
binb=gen_mask(bild,ifeat(1),ifeat(6),ifeat(7)) $
else if not param.thre.thsr then begin
bina=zerleg(binb,/water)
binb=fer(select(bina,64,64))
endif
if keyword_set(disp) then tvscl,binb,1
update_dtp,na,long(ifeat(1)),binb,MASK=mask,EXTENSION=ext
endif else begin
Nur Schwelle in Kopf abspeichern
binb=bild le byte(ifeat(1))
update_dtp,na,long(ifeat(1)),EXTENSION=ext
end
if keyword_set(disp) then tvscl,binb,1
end
(See /IDL/pro_src/RODENA/pro_neu/rod/n_schw.pro)
NAME:
READ_DTP
PURPOSE:
Reads a DTP-Image file and returns the image
buffer (byte array)
CATEGORY:
INPUT/OUTPUT of images
CALLING SEQUENCE:
Result = READ_DTP( name )
INPUTS:
Name: Full qualified image file name (string)
OUTPUTS:
Result: Array of image (byte)
KEYWORDS:
KOPF: Variable will contain the header information
MASK: Hint for reading additionally Mask image
extension and plane of mask (default="cem.0")
BMASK: Contains the mask image if it exists
EXTENSION: image file extension (default='cel')
MSKONLY: read only separate mask file
EXAMPLE:
Bild = READ_DTP('/usr/users/iliad/nviss/test1/bild/sincos.cel')
MODIFICATION HISTORY:
Written by: K. Rodenacker, 20.7.93.
Modified 19.7.95
FUNCTION read_dtp, name, kopf=kopf, mask=mask, bmask=bmask, $
EXTENSION=ext, MSKONLY=maskonly
if not keyword_set(ext) then ext='cel'
bild=0
if not keyword_set(maskonly) then begin
if !version.arch eq 'vax' then OPENR,u,name,/get_lun,default='.'+ext $
else OPENR,u,name,/get_lun
a=BYTARR(512)
READU,u,a
b=where(a eq 0) & sb=size(b)
c=a
if sb(0) ne 0 then c(b)=32 ; Set binary zeros with spaces
if a(0) lt 65B or a(0) gt 68B then $
print,name,' Header corrupted !'
kopf=STRING(c)
sp=FIX(STRING(a(22:24)))
zl=FIX(STRING(a(25:27)))
if sp eq 0 or zl eq 0 then begin ; Trial to get image size if
fs=fstat(u) ; header is corrupted
sp=long(sqrt(fs.size - fs.cur_ptr))
zl=sp
print,name,' Image size from file size !'
endif
bild=bytarr(sp,zl,/NOZERO)
READU,u,bild
FREE_LUN,u
endif
bmask=0
if keyword_set(mask) then begin
if type(mask) eq 2 then imsk='cem.'+string(mask-1) else imsk=mask
staa=str_sep(imsk,'.')
exte=strlowcase(staa(0))
if (size(staa))(1) lt 2 then plan=0 else plan=long(staa(1))
name2=strlowcase(name)
name2=strmid(name2,0,strpos(name2,strlowcase(ext),rstrpos(name2,'.')))+exte
na=findfile(name2,cou=cna)
if cna ne 0 then begin
bmask=(read_dtp(name2,kopf=ko2) and byte(2^plan)) gt 0b
if keyword_set(maskonly) then kopf=ko2
endif
endif
RETURN,bild
END
(See /IDL/pro_src/RODENA/pro_neu/rod/read_dtp.pro)
NAME: READ_PIC PURPOSE: Reads an ILIAD PIC-File and creates and loads an array of appropriate type and size CATEGORY: Input/Output CALLING SEQUENCE: Result = READ_PIC(Name, HEAD=head, /PVC) INPUTS: Name: Name of ILIAD Pic File OUTPUTS: Result: array with data KEYWORDS: HEAD: File head lonarr(12) PVC: Reads into Structure VC_FEATURE SIDE EFFECTS: Opens, reads and closes the file. MODIFICATION HISTORY: Written by: K.Rodencker, 14.10.93 Modified: 1.12.94
(See /IDL/pro_src/RODENA/pro_neu/rod/read_pic.pro)
NAME:
READ_S_ASCII
PURPOSE:
Reads data from an ASCII file into a string array.
CATEGORY:
Input/Output.
CALLING SEQUENCE:
Result = READ_S_ASCII( FILNAM )
INPUTS:
FILNAM
Char. value, the name of the data file.
OPTIONAL INPUT PARAMETERS:
None.
OUTPUTS:
Returns the data lines in a string array.
COMMON BLOCKS:
None.
SIDE EFFECTS:
None.
RESTRICTIONS:
None.
PROCEDURE:
Straightforward.
MODIFICATION HISTORY:
Modified 02-AUG-1993 by Karsten Rodenacker from Mati Meron.
(See /IDL/pro_src/RODENA/pro_neu/rod/read_s_ascii.pro)
NAME:
sp_runl
function sp_runl,ip,id,ng,nr
sip=size(ip)
if n_params() lt 4 then nr=max(sip(1:2))
if n_params() lt 3 then ng=256
if n_params() lt 2 then id=0
inr=long(nr)
ing=long(ng)
iip=long(ip)
mx=lonarr(ng,nr)
iid=long(id)
case !version.os of
'IRIX':i=call_external(filepath('rod_share.so', $
root=!idl_basiss, subd=['rod',!version.os]), $
'c_runl', iip,sip(1),sip(2),mx, ing, inr, iid)
'hp-ux':i=call_external(filepath('rod_share.so', $
root=!idl_basiss, subd=['rod',!version.os]), $
'c_runl', iip,sip(1),sip(2),mx, ing, inr, iid)
'vms': i=call_external('rod_share', $
'c_runl', iip,sip(1),sip(2),mx, ing, inr, iid, $
default=filepath('rod_share.exe', $
root=!idl_basiss, subd=['rod',!version.os]))
'Win32':i=call_external(filepath('rod_share.dll', $
root=!idl_basiss, subd=['rod',!version.os]), $
'c_runl', iip,sip(1),sip(2),mx, ing, inr, iid)
else:mx(*,*)=0l
endcase
return,mx
end
(See /IDL/pro_src/RODENA/pro_neu/rod/sp_runl.pro)
NAME:
update_dtp
PURPOSE:
Updates a DTP-image file with a threshold Thresh in the header (74-79)
and a binary image Binb in bit 0 if this parameter is set.
With keyword MASK the binary image is updated or written in a
separate file.
CATEGORY:
I/O
CALLING SEQUENCE:
update_dtp, Name, Thresh[, Binb], MASK="cem.0",
KOPF=kopf, DIA1=c, DIA2=c
MODIFICATION HISTORY:
Written by: K. Rodenacker, 22, Nov 1993.
Modified: 19, July 1995
Modified: 7, Nov 1995
pro update_dtp,name,thr,binb, MASK=mask, KOPF=kopf, DIA1=dia1, DIA2=dia2, $
EXTENSION=ext
if not keyword_set(ext) then ext='cel'
if keyword_set(mask) then begin
if type(mask) eq 2 then imsk='cem.'+string(mask-1,format="(I1.1)") $
else imsk=mask
staa=str_sep(imsk,'.')
exte=strlowcase(staa(0))
No level number given default level 0
if (size(staa))(1) lt 2 then plan=0 else plan=long(staa(1))
name2=extr_name(name,prefix=pre)
name2=pre+name2+'.'+exte
endif else mask=0
if (ext eq 'cel') or (ext eq 'CEL') then begin
openu,du,/get_lun,name
iko=assoc(du,bytarr(512))
head=byte(iko(0))
fsp=FIX(STRING(head(22:24)))
fzl=FIX(STRING(head(25:27)))
Update der Schwelle im Kopf wenn thr vorhanden
if n_params() gt 1 then head=byte(string(iko(0:73,0))+ $
string(format='(2I3.3)',thr,thr)+string(iko(80:511,0)))
if keyword_set(dia1) then head(47)=byte(strmid(dia1,0,1))
if keyword_set(dia2) then head(48)=byte(strmid(dia2,0,1))
iko(0)=head
kopf=string(head)
Update des Binaerbildes wenn Parameter binb vorhanden
if n_params() gt 2 then begin
sz = SIZE(binb)
if sz(0) ne 2 THEN MESSAGE,'Image array not 2-dim.!'
Vergleich der Bildgroessen
isp=sz(1)
izl=sz(2)
if isp ne fsp or izl ne fzl then $
message,'Images to be updated differ in size !'
if not keyword_set(mask) then begin
ins Graubild hinein, Ebene 0
rl=512
duf=fstat(du)
unter VMS steht in rec_len etwas drin
if duf.rec_len ne 0 then rl=1
ib=assoc(du,bytarr(isp,izl),rl)
ib(0)=(ib(0) and 254B) or (binb and 1B)
close,du
endif else begin
in separates Maskenbild
close,du
iib=(binb gt 0b)*255B and byte(2^plan)
na=findfile(name2,cou=cna)
if cna ne 0 then begin
wenn bereits vorhanden
openu,du,name2
rl=512
duf=fstat(du)
wenn VMS steht in rec_len etwas drin
if duf.rec_len ne 0 then rl=1
ib=assoc(du,bytarr(isp,izl),rl)
ib(0)=(ib(0) and (255b-byte(2^plan))) or iib
close,du
endif else write_dtp,name2,iib
endelse
endif
close,du
free_lun,du
endif else begin
if mask eq 0 then message,'Non-DTP file only with separate mask file'
if n_params() gt 2 then begin
sz = SIZE(binb)
if sz(0) ne 2 THEN MESSAGE,'Image array not 2-dim.!'
isp=sz(1)
izl=sz(2)
iib=(binb gt 0b)*255B and byte(2^plan)
na=findfile(name2,cou=cna)
if cna ne 0 then begin
wenn bereits vorhanden
openu,du,name2,/get_lun
rl=512
duf=fstat(du)
wenn VMS steht in rec_len etwas drin
if duf.rec_len ne 0 then rl=1
ib=assoc(du,bytarr(isp,izl),rl)
ib(0)=(ib(0) and (255b-byte(2^plan))) or iib
free_lun,du
endif else write_dtp,name2,iib,KOPF=head
endif
endelse
end
(See /IDL/pro_src/RODENA/pro_neu/rod/update_dtp.pro)