#!/bin/sh

# \
  exec /usr/local/bin/wish8.4 "$0" "$@"

source progressbar.tcl

proc ini_var {} {
 global var estat llista_paraules_curtes
    set var(index)  0
    set var(seccio_anterior) "ant"
    set var(seccio_actual)   "unknown"
    set var(link_actual) 0

    set llista_paraules_curtes [list \
                                cut \
				.cnd .mat .prb .uni .sym .bas .tcl .geo \
				acis ACIS \
				fill FILL \
				arc \
				BMP bmp\
				Clip clip \
				HTML html \
				copy Copy \
				cuts cut \
				data Data \
				draw Draw\
				dxf DXF \
				Edit edit \
				file \
				GiD \
				gif GIF \
				help HELP Help \
				hole \
				id ID \
				iges IGES \
				iso Iso ISO \
				JPG Jpg jpg jpeg \
				line \
				List list \
				mesh Mesh \
				move Move \
				New Open \
				Pan pan \
				PS EPS eps \
				save Save \
				sets set \
				STL stl \
				TCL tcl \
				TIFF tiff \
				Undo \
				unit \
				VDA vda \
				View view \
				VRML \
				type ]


    set var(path) "./gid_manual"


}




proc main {nomfitxer} {
global var arbre 
    ini_var
    set fitxer [open $nomfitxer r] 
    seek $fitxer 0 start
    set var(tam_fitxer) [file size $nomfitxer]
 
    set var(index) 0

    set HTML_file [read $fitxer $var(tam_fitxer)]
    close $fitxer

    while {$var(index) < [expr $var(tam_fitxer)-1] } {
         set tag [analitzar_tag $HTML_file]
         tractar_tag $tag $HTML_file 
     }
}




#
#  Llegeix el seguent TAG des de la posició $var(index)
#    



proc analitzar_tag {HTML_file} {
global var
   set aux [llegir_caracter $HTML_file]
   while {$var(index) < $var(tam_fitxer) &&  [string match $aux <] == 0} { 
     set aux [llegir_caracter $HTML_file]
   }
   

   set tag [llegir_opcio $HTML_file]
   return $tag
}





#
#  La funcio tractar_tag distribueix les tasques en funció
#  de si s'ha llegit un tag
#    


proc tractar_tag {tag file} {
    global var estat

  switch -exact -- $tag { 

    H1      {obtenir_seccio 1 $file}
    H2      {obtenir_seccio 2 $file}
    H3      {obtenir_seccio 3 $file}
    H4      {obtenir_seccio 4 $file}
 
    LI      {obtenir_paraules $file}     

    P       {obtenir_paraules $file}

    UL      { }

   /UL      { }
   A        { }
   PRE      { } 
   BODY     { }
   IMG      { }
   HEAD     { }
   TITLE    { }
   default  {if {$var(seccio_actual) != "error"} {obtenir_paraules $file} }

  }

}

proc obtenir_paraules {HTML_file} {
global var file_out
set paraula ""

set var(index) [expr $var(index) + 1]
  set aux [llegir_caracter $HTML_file]
     while  {[string match $aux <] == 0 && $var(index) < $var(tam_fitxer)}  {
          while  {[string match $aux " "] == 0 && [string match $aux <] == 0 && [string match $aux "\n"] == 0 && $var(index) < $var(tam_fitxer)}  {
             if {$aux!= {.} && $aux!= {,} && $aux!= {:}} {append paraula $aux}
             set aux [llegir_caracter $HTML_file]     
          }

       if {[comprovar $paraula]==1 && $var(seccio_actual)!= "unknown"} {
		if  {$var(seccio_actual) == $var(seccio_anterior)} {
 		    set seccio "="
 		}   else { set seccio $var(seccio_actual) 
                           set var(seccio_anterior) $var(seccio_actual)}

     	     puts $file_out "$paraula\t$seccio\t$var(num_fitxer)#$var(link_actual)"

       }
      if {[string match $aux <] == 0} {set aux [llegir_caracter $HTML_file]   }
      set paraula ""
     }

   if {$var(index)>0} {set var(index) [expr $var(index) - 1]}  
}




proc comprovar {paraula} {
global llista_paraules_curtes
set i 0
set no_trobat 0

if {[string length $paraula]>4} {
    return 1
   } else {
       while {$i < [llength $llista_paraules_curtes] && $no_trobat==0} {
         if {$paraula == [lindex $llista_paraules_curtes $i]} {set trobat 1
                                #tkMessageBox -message $paraula
                                                               return 1     }
         set i [expr $i+1]
       } 
       if {$no_trobat==0 || $paraula==""} {return 0}
  }
     
}


proc escriure_disc {paraula} {

puts $file_out $paraula  

}



proc obtenir_seccio {tag HTML_file} {
global var

set var(link_actual) ""
set var(seccio_actual) ""

     set aux [llegir_caracter $HTML_file]
     while  {[string match $aux =] == 0 && $var(index) < $var(tam_fitxer)}  {
      set aux [llegir_caracter $HTML_file]
     }

    set var(index) [expr $var(index)+1]
    set aux [llegir_caracter $HTML_file]
    while  {[string match $aux {"}] == 0 && $var(index) < $var(tam_fitxer)}  {
#" para los colorines
      append var(link_actual) $aux  
      set aux [llegir_caracter $HTML_file]
     }


    while  {[string match $aux >] == 0 && $var(index) < $var(tam_fitxer)}  {
      set aux [llegir_caracter $HTML_file]
     } 


    set aux [llegir_caracter $HTML_file]
    while  {[string match $aux <] == 0 && $var(index) < $var(tam_fitxer)}  {
      append var(seccio_actual) $aux  
      set aux [llegir_caracter $HTML_file]
    }

   if {[regexp {SEC(([0-9]*)*)} $var(link_actual) tot num_link]} {
       set var(link_actual) $num_link }



#puts $var(seccio_actual)
#puts $var(link_actual)

   if {$var(index)>0} {set var(index) [expr $var(index) -1]}  

}





#
#  get_link i get_title obtenen el link i el nom del link
#  respectivament, del contingut de $HTML_file des de la 
#  posició $var(index)
#    


proc get_link {HTML_file} {
global var estat



  set aux [llegir_caracter $HTML_file]
  while {[string match $aux =] == 0 && $var(index) < $var(tam_fitxer)} {
     set aux [llegir_caracter $HTML_file]
  }

  set var(index)  [expr $var(index) +1]


   if {$var(index) >= $var(tam_fitxer)} {
    set link -1
   } else {
     set aux [llegir_caracter $HTML_file]
     while  {[string match $aux \"] == 0 && $var(index) < $var(tam_fitxer)}  {
      append link $aux  
      set aux [llegir_caracter $HTML_file]
     }
   }
   set var(index)  [expr $var(index) +1]

   return $link 
} 


proc get_title {HTML_file} {
global var

   if {$var(index) >= $var(tam_fitxer)} {
    set title -1
   } else {
     set aux [llegir_caracter $HTML_file]
     while  {[string match $aux <] == 0 && $var(index) < $var(tam_fitxer)}  {
      append title $aux  
      set aux [llegir_caracter $HTML_file]
     }
   }
   set var(index)  [expr $var(index) +3]
   return $title 



}






#
#  llegir_opcio serveix per a llegir un tag del fitxer contingut
#  a $HTML_file des de la posició $var(index)
#    


proc llegir_opcio {HTML_file} {
global var


   if {$var(index) >= $var(tam_fitxer)} {
    set opcio -1
   } else {
     set aux [llegir_caracter $HTML_file]
     while  {[string match $aux { }] == 1 } {set aux [llegir_caracter $HTML_file]}
     while  {[string match $aux =] == 0 && [string match $aux >] == 0 && [string match $aux { }] == 0 && $var(index) < $var(tam_fitxer)}  {
      append opcio $aux  
      set aux [llegir_caracter $HTML_file]
     }
   
   }
   if {$var(index)>0} {set var(index) [expr $var(index) -1]}  
   return [string toupper $opcio]
}



#
#  llegir_caracter retorna un caracter del fitxer contingut 
#  a la varialbe $HTML_file. S'actualitza la posicio de 
#  lectura incrementant $var(index).


proc llegir_caracter {HTML_file}  {
global var

set var(index) [expr $var(index) +1]
return [string index $HTML_file $var(index)]
}


proc wait_win {} {
    global progreso
    
    #toplevel .wait 
    frame .wait
    text .wait.t -height 8 -width 35 
    
    .wait.t tag configure estil -font {Arial 16 bold} -foreground mediumblue
    .wait.t insert end "\n \n \n"
    .wait.t insert end "Please wait ... " estil
    pack .wait.t -side top -padx 2m -pady 2m 
    
    ::progressbar::progressbar .wait.pb -variable progreso -width 200
    pack .wait.pb -side top -padx 2m -pady 2m 
    
    set progreso 0
    
    pack .wait
    #wm overrideredirect . 1
    wm geometry .  +300+200
}


proc actualiza_progreso { parcial total} {
    global progreso

    set progreso [ expr int( 0.5 + 100.0 * $parcial / $total)]
}


#----------------------------------------------------------------------------
#----------------------------------------------------------------------------
#----------------------------------------------------------------------------
#----------------------------------------------------------------------------
#----------------------------------------------------------------------------
#----------------------------------------------------------------------------


global file_out var llista_paraules_curtes
set file_out [open out.txt { RDWR CREAT } ] 
wait_win 
update
ini_var

set lst [glob {gid_[0-9]*html}]
set n [ llength $lst]
for { set i 0} { $i < $n} { incr i} {
    set archivo [ lindex $lst $i]
    if {$archivo != "fitxers.tcl"}   {
	set var(nom_fitxer) $archivo
	if {[regexp {gid_([0-9]*).html} $var(nom_fitxer) tot num]} {
	    set var(num_fitxer) $num
	    main $archivo
	} else {}
    }
    actualiza_progreso [ expr $i + 1] $n
    update
    update idletasks
}
close $file_out 


#-----------------------------------------------------------------------
#-----------------------------------------------------------------------
#-----------------------------------------------------------------------


set file [open out.txt r ] 
set file_out [open filtrat.txt { RDWR CREAT } ] 
set file_err [open error_paraules.txt { RDWR CREAT } ] 

    set linea [gets $file] 

     while { $linea != "" } { 
       if {[regexp "(.*)\t(.*)\t(.*)" $linea {} paraula capitol link] } {
           if {$capitol != "="} {puts $file_out $linea}
           if {$capitol == "="} {
               
    	   if { [regexp {&} $paraula] || [regexp {/} $paraula] || [regexp {[(]} $paraula] \
   	        || [regexp {[>]} $linea] || [regexp {[=]} $paraula] || [regexp {[<]} $linea] || [regexp {[)]} $paraula] || [regexp {["]} $paraula] || [regexp {[#]} $paraula] \
   	        || [regexp {[$]} $paraula] || [regexp {[']} $paraula] || [regexp {[%]} $paraula] \
                || $paraula == "other" || $paraula == "without" || $paraula == "their" || $paraula == "means" \
                || $paraula == "similar"  || $paraula == "about" || $paraula == "doing"  || $paraula == "before" \
                || $paraula == "follow" || $paraula == "according" || $paraula == "extra"} {
	#" para los colorines
   	       puts $file_err $linea} else {puts $file_out $linea}

               }
        }
        set linea [gets $file]
     }
  
close $file_out
close $file




#-----------------------------------------------------------------------
#-----------------------------------------------------------------------
#-----------------------------------------------------------------------


set file [open filtrat.txt r ] 
set file_out [open fitxer_final.txt { RDWR CREAT } ] 
set file_err [open rebutjats.txt { RDWR CREAT } ] 

    set linea [gets $file] 

     while { $linea != "" } { 

        if {[regexp {(([a-z,A_Z]*[-]*)*)(.*)} $linea tot paraula a info]} {
          
            if {[info exists array($paraula)] == 0} {
                lappend array($paraula) $info
                puts $file_out $linea
	    }  else {
              if {[lsearch -exact $array($paraula) $info]==-1} {
                lappend array($paraula) $info
                puts $file_out $linea
              } else { puts $file_err $linea} }
         }

     set linea [gets $file] 
     }

close $file_err
close $file_out
close $file


#destroy .wait
tk_messageBox -message " ---> Done! bye"
exit

