#!/bin/perl

# PerlScript IDL documentation generator.
# Author: 
#   Antonio Santiago
#
# Description:
#   The IDL comments must be written between ';+' and ';-':
#   ;+ ----------
#   ; Your comment
#   ;- ----------
#

use strict;
use warnings;
use English;

my $filename;
my $b_close_tag = 0;

my @comment_tags = (
		    'CLASSNAME', 
		    'NAME', 
		    'AUTHOR', 
		    'PURPOSE', 
		    'DESCRIPTION', 
		    'METHODS', 
		    'MODIFICATION HISTORY', 
		    'HISTORY', 
		    'PARAMETERS', 
		    'EXTRA PARAMETERS', 
		    'KEYWORD PARAMETERS', 
		    'NOTE');    

my @idl_label = (
                'AND',
                'NOT',
                'OR',
                'XOR',
                'EQ',
                'GT',
                'LT',
                'LE',
                'GE',
                'NE',
                'MOD',
                'PRO',
                'FUNCTION',
		'RETURN',
                'IF',
                'THEN',
                'ELSE',
                'ENDIF',
                'BEGIN',
                'END',
                'ENDELSE',
                'CASE',
                'OF',
                'ENDCASE',
                'SWITCH',
                'ENDSWITCH',
                'FOR',
                'DO',
                'ENDFOR',
                'REPEAT',
                'UNTIL',
                'ENDREP',
                'BREAK',
                'CONTINUE',
                'GOTO',
                'COMPILE_OPT',
                'FORWARD_FUNCTION',
                'COMMON',
		'_EXTRA',
		'_REF_EXTRA'
		 );

my @idl_keyword = (
                'AXIS',
                'BEEP',
                'BLAS_AXPY',
                'BREAKPOINT',
                'BYTEORDER',
                'CATCH',
                'CD',
                'CHOLDC',
                'CLOSE',
                'COLOR_CONVERT',
                'CONSTRAINED_MIN',
                'CONTOUR',
                'COPY_LUN',
                'CPU',
                'CURSOR',
                'DDE_EXECUTE',
                'DECODE_GIF',
                'DECODE_PACKBITS',
                'DEFINE_KEY',
                'DEFINE_MSGBLK',
                'DEFSYSV',
                'DELVAR',
                'DEVICE',
                'DLM_LOAD',
                'DLM_REGISTER',
                'DRAW_ROI',
                'DUMP',
                'EMPTY',
                'ENABLE_SYSRTN',
                'ENCODE_GIF',
                'ERASE',
                'EXIT',
                'FILE_CHMOD',
                'FILE_COPY',
                'FILE_DELETE',
                'FILE_MKDIR',
                'FILE_MOVE',
                'FLUSH',
                'FORRD',
                'FORWRT',
                'FREE_LUN',
                'FWIDENT_ACQUIRE',
                'FWIDENT_GC',
                'FWIDENT_RELEASE',
                'GET_LUN',
                'GRID_INPUT',
                'HANDLE_FREE',
                'HANDLE_MOVE',
                'HANDLE_VALUE',
                'HEAP_FREE',
                'HEAP_GC',
                'HEAP_NOSAVE',
                'HELP',
                'IDLFWSAVEABLERESTOREARRAY',
                'IMAGE_STATISTICS',
                'INTERVAL_VOLUME',
                'ISOCONTOUR',
                'ISOSURFACE',
                'JOURNAL',
                'LA_CHOLDC',
                'LA_LUDC',
                'LA_SVD',
                'LA_TRIDC',
                'LA_TRIQL',
                'LA_TRIRED',
                'LINKIMAGE',
                'LUBKSB',
                'LUDC',
                'LUDCMP',
                'MAKE_DLL',
                'MAP_CLIP_SET',
                'MAP_PROJ_GCTP_FORINIT',
                'MAP_PROJ_GCTP_REVINIT',
                'MESSAGE',
                'MPROVE',
                'MRQMIN',
                'NR__SVDFIT',
                'NR_CHOLDC',
                'NR_DFPMIN',
                'NR_POWELL',
                'NR_TQLI',
                'NR_TRED2',
                'OBJ_DESTROY',
                'ON_ERROR',
                'ONLINE_HELP',
                'OPENR',
                'OPENU',
                'OPENW',
                'OPLOT',
                'OUTP',
                'OUTPW',
                'PARTICLE_TRACE',
                'PATH_CACHE',
                'PLOT',
                'PLOT_IO',
                'PLOT_OI',
                'PLOT_OO',
                'PLOTS',
                'POINT_LUN',
                'POLYFILL',
                'POWELL',
                'PRINT',
                'PRINTF',
                'PROFILER',
                'PTR_FREE',
                'QHULL',
                'QUERY_EVENT_MASK',
                'READ',
                'READ_JPEG',
                'READF',
                'READS',
                'READU',
                'REGISTER_CURSOR',
                'REPLICATE_INPLACE',
                'RESOLVE_ROUTINE',
                'RESTORE',
                'RIEMANN',
                'SAVE',
                'SET_PLOT',
                'SET_SHADING',
                'SETENV',
                'SHADE_SURF',
                'SHADE_VOLUME',
                'SHMMAP',
                'SHMUNMAP',
                'SKIP_LUN',
                'SOCKET',
                'SPAWN',
                'STRPUT',
                'STRUCT_ASSIGN',
                'STRUCT_HIDE',
                'SURFACE',
                'SVBKSB',
                'SVD',
                'SVDC',
                'TQLI',
                'TRED2',
                'TRIANGULATE',
                'TRIDAG',
                'TRIQL',
                'TRIQL_NOVEC',
                'TRIRED',
                'TRUNCATE_LUN',
                'TV',
                'TVCRS',
                'TVDELETE',
                'TVLCT',
                'TVRDC',
                'TVSCL',
                'TVSET',
                'TVSHOW',
                'TVWINDOW',
                'USERSYM',
                'WAIT',
                'WDELETE',
                'WIDGET_CONTROL',
                'WIDGET_DISPLAYCONTEXTMENU',
                'WIDGET_OLH',
                'WIDGET_PROCESS_EVENTS',
                'WIDGET_SET_RESOURCE',
                'WINDOW',
                'WRITE_JPEG',
                'WRITE_PNG',
                'WRITE_TIFF',
                'WRITEU',
                'WSET',
                'WSHOW',
                'XYOUTS',
                'ZROOTS'
		   );

my @idl_function = (
                'ABS',
                'ACOS',
                'ALOG',
                'ALOG10',
                'ARG_PRESENT',
                'ARRAY_EQUAL',
                'ASIN',
                'ASSOC',
                'ATAN',
                'BESELI',
                'BESELJ',
                'BESELK',
                'BESELY',
                'BINDGEN',
                'BROYDEN',
                'BYTARR',
                'BYTE',
                'BYTSCL',
                'CALL_EXTERNAL',
                'CALL_VMS',
                'CEIL',
                'CHECK_MATH',
                'CHOLSOL',
                'CINDGEN',
                'COLOR_QUAN',
                'COMPLEX',
                'COMPLEXARR',
                'COMPUTE_MESH_NORMALS',
                'CONJ',
                'CONVERT_COORD',
                'CONVOL',
                'COS',
                'COSH',
                'CREATE_STRUCT',
                'DB_EXISTS',
                'DBLARR',
                'DCINDGEN',
                'DCOMPLEX',
                'DCOMPLEXARR',
                'DIAG_MATRIX',
                'DIALOG_DBCONNECT',
                'DIALOG_MESSAGE',
                'DIALOG_PICKFILE',
                'DIALOG_PRINTERSETUP',
                'DIALOG_PRINTJOB',
                'DILATE',
                'DINDGEN',
                'DOUBLE',
                'ELMHES',
                'ERF',
                'ERFC',
                'ERFCX',
                'ERODE',
                'ERRORF',
                'EXECUTE',
                'EXP',
                'EXPAND_PATH',
                'EXPINT',
                'FFT',
                'FFTOOLKIT_INFO',
                'FILE_BASENAME',
                'FILE_DIRNAME',
                'FILE_EXPAND_PATH',
                'FILE_INFO',
                'FILE_LINES',
                'FILE_SAME',
                'FILE_SEARCH',
                'FILE_TEST',
                'FINDFILE',
                'FINDGEN',
                'FINITE',
                'FIX',
                'FLOAT',
                'FLOOR',
                'FLTARR',
                'FORMAT_AXIS_VALUES',
                'FSTAT',
                'FULSTR',
                'FZ_ROOTS',
                'GAUSSINT',
                'GET_DRIVE_LIST',
                'GET_FWIDENT',
                'GET_KBRD',
                'GET_LOGIN_INFO',
                'GETENV',
                'GRID3',
                'GRID_TPS',
                'GRIDDATA',
                'HISTOGRAM',
                'HOUGH',
                'HQR',
                'IDL_IGAMMA',
                'IDL_VALIDNAME',
                'IMAGINARY',
                'INDGEN',
                'INP',
                'INPW',
                'INTARR',
                'INTERPOLATE',
                'INVERT',
                'IPTOOLKIT_INFO',
                'ISADXF',
                'ISHFT',
                'KEYWORD_SET',
                'LON64ARR',
                'LONARR',
                'LONG',
                'LONG64',
                'LSODE',
                'LUMPROVE',
                'LUSOL',
                'MACHAR',
                'MAKE_ARRAY',
                'MAKE_EVENT_MASK',
                'MAP_PROJ_FORWARD',
                'MAP_PROJ_INVERSE',
                'MATRIX_MULTIPLY',
                'MAX',
                'MEDIAN',
                'MEMORY',
                'MESH_CLIP',
                'MESH_DECIMATE',
                'MESH_ISSOLID',
                'MESH_MERGE',
                'MESH_NUMTRIANGLES',
                'MESH_SMOOTH',
                'MESH_SURFACEAREA',
                'MESH_VALIDATE',
                'MESH_VOLUME',
                'MIN',
                'MORPH_DISTANCE',
                'N_ELEMENTS',
                'N_PARAMS',
                'N_TAGS',
                'OBJ_CLASS',
                'OBJ_HASMETHOD',
                'OBJ_ISA',
                'OBJ_NEW',
                'OBJ_VALID',
                'OBJARR',
                'POLY_2D',
                'POLYFILLV',
                'POLYSHADE',
                'PRODUCT',
                'PTR_NEW',
                'PTR_VALID',
                'PTRARR',
                'QUERY_JPEG',
                'QUERY_PNG',
                'QUERY_TIFF',
                'RADON',
                'RANDOMN',
                'RANDOMU',
                'READ_PNG',
                'READ_TIFF',
                'REBIN',
                'RECALL_COMMANDS',
                'REFORM',
                'REPLICATE',
                'ROTATE',
                'ROUND',
                'ROUTINE_INFO',
                'ROUTINE_NAMES',
                'SHIFT',
                'SHMDEBUG',
                'SHMVAR',
                'SIMPLEX',
                'SIN',
                'SINDGEN',
                'SINH',
                'SIZE',
                'SMOOTH',
                'SOBEL',
                'SORT',
                'SPL_INIT',
                'SPL_INTERP',
                'SPRSAB',
                'SPRSAX',
                'SPRSIN',
                'SPRSTP',
                'SQRT',
                'STRARR',
                'STRCMP',
                'STRCOMPRESS',
                'STREGEX',
                'STRING',
                'STRJOIN',
                'STRLEN',
                'STRLOWCASE',
                'STRMATCH',
                'STRMESSAGE',
                'STRMID',
                'STRPOS',
                'STRTOK',
                'STRTRIM',
                'STRUPCASE',
                'SVSOL',
                'SYSTIME',
                'TAG_NAMES',
                'TAN',
                'TANH',
                'TEMPORARY',
                'TETRA_CLIP',
                'TETRA_SURFACE',
                'TETRA_VOLUME',
                'THIN',
                'TOTAL',
                'TRANSPOSE',
                'TRIGRID',
                'TRISOL',
                'TVRD',
                'UINDGEN',
                'UINT',
                'UINTARR',
                'UL64INDGEN',
                'ULINDGEN',
                'ULON64ARR',
                'ULONARR',
                'ULONG',
                'ULONG64',
                'VALUE_LOCATE',
                'VAX_FLOAT',
                'VOIGT',
                'VOXEL_PROJ',
                'W32_GETSYSCOLOR',
                'WATERSHED',
                'WHERE',
                'WIDGET_ACTIVEX',
                'WIDGET_BASE',
                'WIDGET_BUTTON',
                'WIDGET_COMBOBOX',
                'WIDGET_DRAW',
                'WIDGET_DROPLIST',
                'WIDGET_EVENT',
                'WIDGET_GET_RESOURCE',
                'WIDGET_INFO',
                'WIDGET_LABEL',
                'WIDGET_LIST',
                'WIDGET_MESSAGE',
                'WIDGET_PROPERTYSHEET',
                'WIDGET_SLIDER',
                'WIDGET_STUB',
                'WIDGET_TAB',
                'WIDGET_TABLE',
                'WIDGET_TEXT',
                'WIDGET_TREE',
                'WMENU',
                'WTN',
                'WV_DWT',
                'WV_PWT'
		   );


#Para cada fichero PRO especificado generamos su documentacion
foreach $filename (@ARGV){
    if( $filename =~ /(.+)\.pro$/){
     
	my $newfile = $1.".html";
	#Creamos ficheros entrada y salida
	open FILE_IN, "< $filename" or die "Couldn't open `$filename'";
	open FILE_OUT, "> $newfile" or die "Couldn't open `$newfile'";
	
	my $file_out = \*FILE_OUT;
	my $b_comment = 0;
	my $b_code = 0;
	my $line;
	my $code_num=0;

	head($file_out, $filename);
	
	while($line=<FILE_IN>){          
	    #Comprobamos su es la linea de inicio de un comentario
	    if($line =~ /^;\+/){ 
		$b_comment = 1; 
		$b_code = 0;
		print $file_out '</code></div></div>'; #Cerramos seccion de codigo		
		print $file_out '<div class="comment">'; #Abrimos seccion commentarios
		next; 
	    }

	    #Comprobamos si es la linea de finalizacion de un comentario
	    if($line =~ /^;\-$/){ 
		$b_comment = 0; 
		$b_code = 1;
		#Cerramos tag en caso de haber alguno abierto
		if( $b_close_tag == 1 ){ 
		    print $file_out '</div>'; 
		    $b_close_tag = 0; 
		}
		print $file_out '</div>'; #Cerramos seccion comentarios
		print $file_out '<div class="code"><a href="#" onClick="changeVisibility(\'code_'.$code_num.'\');">+Code:</a></br><div class="code_text" id="code_'.$code_num.'"><code>'; #Abrimos seccion codigo 
		$code_num++;
		next; 
	    }
	    
	    #Si estamos dentro de una descripcion
	    if($b_comment == 1){ 
		$line =~ s/^;//; #Eliminamos ';' inicial

		parse_comment($file_out, $line);
	    }
	       
	    #Si estamos dentro del codigo
	    if($b_code == 1){ 
		parse_idl($file_out, $line); 
	    }
	}	    	    
	
	#Finalizamos documento
	if( $b_code == 1){
	    $b_code = 0; 
	    print $file_out '</code></div></div>'; #Cerramos seccion de codigo
	}
	if( $b_comment == 1){
	    $b_comment = 0;
	    print $file_out '</div>'; #Cerramos seccion comentarios
	}

	final($file_out);
    }
    
    close FILE_OUT;
    close FILE_IN;
}

#Comprueba si un tag es correcto (definido y dentro del hash de tags).
sub correct_tag {

    my $tag = shift;
    my $key;

    if( defined($tag) ){
	$tag =~ s/(\s|\:)//; #Eliminamos espacios y ':'.
	foreach $key (@comment_tags){	
	    if( $tag =~ /$key/ ) { return 1}		
	}
    }
   
    return 0;
}

#Parse las cabeceras de comentarios
sub parse_comment {

    my $file_out = shift;
    my $line = shift;
    my ($tag, $rest);

    if( $line =~ /^\s+$/){ return; } #Miramos que nosea una linea vacia

    $line =~ /^\s*(.*?)\:(.*)/;
    
    if ( correct_tag($1) == 1 ) {

	$tag = $1;	
	$tag =~ s/(\:)//; #Eliminamos espacios y ':'.
	$rest = $2;

	if( $tag =~ 'NAME'){
	    if( $b_close_tag == 1 ){ print $file_out '</div>'; $b_close_tag = 0; }
	    print $file_out '<div class="tag_name">';
	    print $file_out "<b>$tag:</b>";
	    $b_close_tag = 1;
	}
	elsif( $tag eq 'AUTHOR'){
	    if( $b_close_tag == 1 ){ print $file_out '</div>'; $b_close_tag = 0; }
	    print $file_out '<div class="tag_author">';
	    print $file_out "<b>$tag:</b>";
	    $b_close_tag = 1;
	}
	elsif( $tag eq 'MODIFICATION HISTORY'){
	    if( $b_close_tag == 1 ){ print $file_out '</div>'; $b_close_tag = 0; }
	    print $file_out '<div class="tag_history">';
	    print $file_out "<b>$tag:</b>";
	    $b_close_tag = 1;
	}
	elsif( $tag eq 'HISTORY'){
	    if( $b_close_tag == 1 ){ print $file_out '</div>'; $b_close_tag = 0; }
	    print $file_out '<div class="tag_history">';
	    print $file_out "<b>$tag:</b>";
	    $b_close_tag = 1;
	}
	elsif( $tag =~ 'PARAMETERS'){
	    if( $b_close_tag == 1 ){ print $file_out '</div>'; $b_close_tag = 0; }
	    print $file_out '<div class="tag_parameters">';
	    print $file_out "<b>$tag:</b>";
	    $b_close_tag = 1;
	}
	elsif( $tag eq 'PURPOSE'){
	    if( $b_close_tag == 1 ){ print $file_out '</div>'; $b_close_tag = 0; }
	    print $file_out '<div class="tag_description">';
	    print $file_out "<b>$tag:</b>";
	    $b_close_tag = 1;
	}
	elsif( $tag eq 'DESCRIPTION'){
	    if( $b_close_tag == 1 ){ print $file_out '</div>'; $b_close_tag = 0; }
	    print $file_out '<div class="tag_description">';
	    print $file_out "<b>$tag:</b>";
	    $b_close_tag = 1;
	}
	elsif( $tag eq 'METHODS'){
	    if( $b_close_tag == 1 ){ print $file_out '</div>'; $b_close_tag = 0; }
	    print $file_out '<div class="tag_methods">';
	    print $file_out "<b>$tag:</b>";
	    $b_close_tag = 1;
	}
	else{
	    if( $b_close_tag == 1 ){ print $file_out '</div>'; $b_close_tag = 0; }
	    print $file_out "<b>$tag:</b>";
	}

	$rest =~ s/ /\&nbsp\;/g; #Substituimos espacios en blanco
	print $file_out $rest;
	print $file_out "</br>";
    }
    else {
	$line =~ s/\t/&nbsp;&nbsp;&nbsp;&nbsp;/g;
	$line =~ s/ /&nbsp;/g; #Substituimos espacios en blanco
	$line =~ s/\<(.*?)\>/\<a href="mailto:$1"\>&lt;$1&gt;\<\/a\>/g;

	print $file_out $line."</br>";
    }       
}

#Parsea el contenido de codio realzando las instrucciones IDL
sub parse_idl{

    my $file_out = shift;
    my $line = shift;
    my $tag;

    if( $line =~ /^\s*\;/ ){ 
	#Es un comentario. No hacemos nada
	$line = "<i><b>".$line."</b></i>";
    }
    else{
	#Es codigo IDL
	if( $line =~ /(.+)(\;.*)/ ){ $line = $1; }

	#Miramos si es un label
	foreach $tag (@idl_label){
	    $line =~ s/\b$tag\b/\<b\>$tag\<\/b\>/ig;
	}

	#Miramos si es un keyword
	foreach $tag (@idl_keyword){
	    $line =~ s/\b$tag\b/\<b\>$tag\<\/b\>/ig;
	}

	#Miramos si es un function
	foreach $tag (@idl_function){
	    $line =~ s/\b$tag\(\b/\<b\>$tag\<\/b\>\(/ig;
	}

	if(defined($2)){ $line = $line."<i><b>".$2."</b></i>"; }
    }

    $line =~ s/ /&nbsp;/g; #Substituimos espacios en blanco

    print $file_out $line."</br>";
}


#Escribe el codigo HTML de inicio de documento
sub head {

    my $file_out = shift;
    my $filename = shift;

    print $file_out '<html>'."\n";
    print $file_out '<head>'."\n";
    print $file_out '<title>GRAHI Documentation Project (GDP): '.$filename.'</title>'."\n";
	
    print $file_out '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />'."\n";
    print $file_out '<meta name="author" content="Antonio Santiago" />'."\n";
    print $file_out '<meta name="generator" content="PerlScript IDL documentation generator" />'."\n";
    print $file_out '<link rel="stylesheet" type="text/css" href="style.css">'."\n";

    print $file_out '<script language="javascript" type="text/javascript">'."\n";
    print $file_out 'function changeVisibility(elemId){'."\n";
    print $file_out 'var elem = document.getElementById(elemId).style;'."\n";
    print $file_out 'if(elem.display==\'block\') elem.display=\'none\';'."\n";
    print $file_out 'else elem.display=\'block\';'."\n";
    print $file_out '}'."\n";
    print $file_out '</script>'."\n";

    print $file_out '</head>'."\n";

    print $file_out '<body>'."\n";

    print $file_out '<div class="head">GRAHI Documentation Project (GDP)</div>';
    print $file_out '<div class="descrip">Filename: <b>'.$filename.'</b></div>'."\n";
}

#Finaliza el documento HTML
sub final {

    my $file_out = shift;

    print $file_out '<div class="final">&middot; Created by the PerlScript documentation generator for IDL &middot; <br> &middot; <i>'. localtime().'</i> &middot;</div>';
    print $file_out '</body>';
    print $file_out '</html>';
}

