;*********************************************************************
; EXPLOITATION GRAPHIQUE IDL                                         *
; --------------------------                                         *
;            DEVELOPPEMENT D'UNE GRILLE POTENTIELLE                  *
;                                                                    *
;                  - visualisation de la grille                      *
;                  - generation d'un postcript                       *
;                                                                    *
;                                                                    *
;*********************************************************************
; by Jean-Jacques SIBILLA                                            *
; - version en IDL le 28/09/2006                                     *
; - version 22/11/2007 (ordre des mouvements)                        *
; - version 28/08/2009 correction de la numerotation de la grille    * 
;                                                                    *
;                             Institut de Physique du Globe de Paris *
;                             Tel : 01.44.27.21.87                   *
;                             E-mail : sibilla@ipgp.jussieu.fr       *
;*********************************************************************
;======================================!
; Function lix :                       ! 
; extraction de ex caracteres          !
; d'un nombre en fonction de sa valeur !
;======================================!
function lix,val
if(abs(val) lt       1.0D) then ex=4
if(abs(val) lt       0.1D) then ex=5
if(abs(val) lt      0.01D) then ex=5
if(abs(val) lt     0.001D) then ex=6
if(abs(val) lt    0.0001D) then ex=7
if(abs(val) lt   0.00001D) then ex=8
if(abs(val) eq       0.0D) then ex=4
if(abs(val) ge       1.0D) then ex=4
if(abs(val) ge      10.0D) then ex=5
if(abs(val) ge     100.0D) then ex=6
if(abs(val) ge    1000.0D) then ex=6
if(abs(val) ge   10000.0D) then ex=5
if(abs(val) ge  100000.0D) then ex=6 
if(abs(val) ge 1000000.0D) then ex=7
if(val lt 0.0D) then ex=ex+1 ; pour le caractere '-'
return, ex   
end 
;======================================!
; Function format :                    !
; formate le nombre val sous forme     !
; editable                             !
;======================================!
function format,val
vals=fix(val)  ; conversion en simple precision
ts_brut=strtrim(vals,2)
epos=strpos(ts_brut,'e')
if(epos ne -1) then begin
  if(vals ge 0) then begin
  ts_fin=strmid(ts_brut,0,3)
  endif else begin
  ts_fin=strmid(ts_brut,0,4)
  endelse
  ts_fin=ts_fin+'E'+strmid(ts_brut,epos+1,strlen(ts_brut)-epos-1)
endif
if(epos eq -1) then begin
  ts_fin=strmid(ts_brut,0,lix(val))
endif
return, ts_fin
end

;****************************************!
; LECTURE d'un fichier de donnees        !
; du type TOPOLOGIE                      !
;****************************************!
pro lecture_topologie,Nom_fic=Nom_fic,ni,xi,yi,$
                          nbn,connectx,connecty,O

openr,lun,Nom_fic,/GET_LUN
;-----------------------------!
; lecture du nombre de points !
;-----------------------------!
readf,lun,nbn
;===============================================!
; lecture des n coordonnees x,y de la topologie !
;===============================================!
;-----------------!
; initialisations !
;-----------------!
ni=intarr(nbn)
xi=intarr(nbn)
yi=intarr(nbn)
connectx=intarr(nbn,8,2)
connecty=intarr(nbn,8,2)
O=intarr(nbn,8,2)
;-----------------!
for i=0,nbn-1 do begin
    readf,lun,n & n=fix(n)
    readf,lun,x,y
    ni[i]=n
    xi[i]=fix(x)
    yi[i]=fix(y)
    for j=0,7 do begin
        readf,lun,it & it=fix(it)
        for k=0,1 do begin
            readf,lun,indic,xit,yit
            indic=fix(indic)
            xit=fix(xit) & yit=fix(yit)
            O[i,j,k]=indic
            connectx[i,j,k]=xit
            connecty[i,j,k]=yit
        endfor
    endfor
endfor

return
end


pro grille_potentielle

;****************************************!
; LECTURE DES DONNEES                    !
;****************************************!
;========================================!
; lecture du fichier topologie           !
;========================================!
Lecture_Topologie,Nom_fic='Fichier_Grille.dat',$
                          ni,xi,yi,$
                          nbn,connectx,connecty,O
;=======================================!
; parametrage de la fenetre d'affichage !
;=======================================!
device,DECOMPOSED=0
loadct,34  ; chargement de la palette Rainbow
NBC=!d.table_size-5
BLANC =NBC+1
NOIR  =NBC+2
ROUGE =NBC+3
VERT  =NBC+4
tvlct,255,255,255,BLANC   ; chargement du blanc a l'index NBC+1
tvlct,0,0,0,NOIR          ; chargement du noir  a l'index NBC+2
tvlct,255,0,0,ROUGE       ; chargement du rouge a l'index NBC+3
tvlct,0,255,0,VERT        ; chargement du vert  a l'index NBC+4
!p.background=BLANC       ; background en blanc

;********************************************************!
; GENERATION DE L'IMAGE en Window 1  :                   !
; espace en deux plots horizontaux de 450 pixels chacun  !
;********************************************************!
titre='Grille Potentielle generee'
window,0,TITLE=titre,Xpos=0,ypos=1000,Xsize=900,Ysize=750
wset,0
erase,color=BLANC
;*********************************!
; Affichage des parametres        !
;*********************************!
;---------------------------------!
; 1. Affichage du nombre de noeuds!
;    de la grille potentielle     !
;---------------------------------!
CNB=format(nbn)
lb=strlen(CNB)
for k=1,4-lb do begin  ; on complete CNB a 4 avec des '0' 
    CNB='0'+CNB 
endfor
xyouts,090/1000.,(1000-60)/1000.,$
       'Nombre de Noeuds : '+ CNB,$
       /NORMAL,COLOR=NOIR,CHARSIZE=1.5
;********!
;        !
; plot 1 !
;        !
;********!
;=============================!
; sinon ca ne marche pas !!!  !
;=============================!
x0=fltarr(2) & y0=fltarr(2) 
x0[0:1]=[min(xi),max(xi)]  
y0[0:1]=[min(yi),max(yi)]  
plot,x0,y0,COLOR=noir,/NOERASE,/NODATA
;===========================================!
; extraction des facettes des binomes       !
;===========================================!
for i=0,nbn-1 do begin
for j=0,7 do begin
;----------------!
;plot facette j  !
;----------------!
    indic1=O[i,j,0]
    if(indic1 eq 1) then begin
      x1= connectx[i,j,0]
      y1= connecty[i,j,0]
    endif
    indic2=O[i,j,1]
    if(indic2 eq 1) then begin
      x2= connectx[i,j,1]
      y2= connecty[i,j,1]
    endif
    if((indic1 eq 1) and (indic2 eq 1)) then begin
      x_coord=[x1,x2]
      y_coord=[y1,y2]
      plots,x_coord,y_coord,$
            COLOR=NOIR,/DATA
    endif
endfor
endfor
;=========================================!
; Points de la grille                     !
;=========================================!
plots,xi,yi,psym=7,symsize=1.2,COLOR=NOIR,$
     /DATA
;=========================================!
; Points initiaux de la grille en rouge   !
;=========================================!
xp=xi[0:35]
yp=yi[0:35]
plots,xp,yp,psym=7,symsize=1.2,COLOR=ROUGE,$
     /DATA
;=========================================!
; numerotation des points de la grille    !
; par ordre de construction               !
;=========================================! 
for k=0,nbn-1 do begin
if(k le 35) then begin
   ni[k]=0
endif else begin
   ni[k]=ni[k]
endelse
xyouts,xi[k],yi[k],format(ni[k]),$
      /DATA,COLOR=NOIR,CHARSIZE=1.3
endfor
;=========================================!
cursor,a,b,/DOWN
;*****************************************!
; Set plotting to PostScript              !
;*****************************************!
SET_PLOT,'PS'
; Set the filename:
DEVICE,FILENAME='autogrille.ps',$
       BITS_PER_PIXEL=8,$
       /COLOR,$
       yoffset=8,xoffset=0,$
       xsize=21,ysize=21
;*********************************!
; Affichage des parametres ps     !
;*********************************!
;---------------------------------!
; 1. Affichage du nombre de noeuds!
;    de la grille potentielle     !
;---------------------------------!
CNB=format(nbn)  
lb=strlen(CNB)
for k=1,4-lb do begin  ; on complete CNB a 4 avec des '0' 
    CNB='0'+CNB 
endfor
xyouts,090/1000.,(1000-60)/1000.,$
       'Nombre de Noeuds : '+ CNB,$
       /NORMAL,COLOR=NOIR,CHARSIZE=1.5
;***********!
;           !
; plot 1 ps !
;           !
;***********!
;=============================!
; sinon ca ne marche pas !!!  !
;=============================!
x0=fltarr(2) & y0=fltarr(2) 
x0[0:1]=[min(xi),max(xi)]  
y0[0:1]=[min(yi),max(yi)]  
plot,x0,y0,COLOR=noir,/NOERASE,/NODATA
;===========================================!
; extraction des facette des binomes        !
;===========================================!
for i=0,nbn-1 do begin
for j=0,7 do begin
;----------------!
;plot facette j  !
;----------------!
    indic1=O[i,j,0]
    if(indic1 eq 1) then begin
      x1= connectx[i,j,0]
      y1= connecty[i,j,0]
    endif
    indic2=O[i,j,1]
    if(indic2 eq 1) then begin
      x2= connectx[i,j,1]
      y2= connecty[i,j,1]
    endif
    if((indic1 eq 1) and (indic2 eq 1)) then begin
      x_coord=[x1,x2]
      y_coord=[y1,y2]
      plots,x_coord,y_coord,$
            COLOR=NOIR,/DATA
    endif
endfor
endfor
;=========================================!
; Points de la grille                     !
;=========================================!
plots,xi,yi,psym=7,symsize=1.2,COLOR=NOIR,$
     /DATA
;=========================================!
; Points initiaux de la grille en rouge   !
;=========================================!
xp=xi[0:35]
yp=yi[0:35]
plots,xp,yp,psym=7,symsize=1.2,COLOR=ROUGE,$
     /DATA
;=========================================!
; numerotation des points de la grille    !
; par ordre de construction               !
;=========================================! 
for k=0,nbn-1 do begin
xyouts,xi[k],yi[k],format(ni[k]),$
      /DATA,COLOR=NOIR,CHARSIZE=1.0
endfor
;=========================================!
DEVICE, /CLOSE_FILE
end