#!/usr/bin/perl -w

# Released under the Gnu Public License. Just a reminder that the GPL protects
# me if you fry your monitor. You are unlikely to do this though unless you
# get too ambitious in your hsync selection. enjoy !  
# // Donovan Rebbechi

# GLOBAL VARIABLES
@ARGS=();			# variable containing command line options
@USER_INPUT=(0,0,"",0);		# array consisting of user input : hsync, vsync, res, dotclock.
@MODELINE=();		# modeline used
$HSP=0;			# Horizontal sync pulse (micro-seconds)
$VSP=0;			# Vertical sync pulse (micro-seconds)
$HP_START=0;		# Start of horizontal pulse, same as MODELINE[3]
$VP_START=0;		# "	"    vertical	" 	"	"MODELINE[6]	
$HP_WIDTH=0;		# Width of horizontal pulse in clock ticks
$VP_WIDTH=0;		# Width of vertical sync pulse in vertical ticks
$IDEAL_HSP=0;		# preferred value for horizontal sync pulse  width (microseconds) 
$IDEAL_VSP=5;		# "	"	"	" (vertical sync pulse(in lines)) - 1
$MAX_VSYNC=80;		# warn the user if they ask for more than this
$MIN_VSYNC=60;		# warn the user if they ask for less than this


# these can all be passed from the command line. 
# they are later used as arguments to the getModeline subroutine

$RES="b";			# a~640x480, b~800x600, c~1024x768, 
				# d~1280x1024 e~1600x1200
@NUMERIC_RES=(); 		# kludgy temporary variable. 
$VSYNC=0;
$HSYNC=0;
$CLOCK=0;

# END GLOBAL VARIABLES

# COMMAND LINE OPTIONS (as yet non functional) 

$VERBOSE=1;			# boolean determines whether we should talk a lot.
$INTERACTIVE=1;		# boolean -- are we in interactive mode ? 

# END COMMAND LINE OPTIONS

# SOME CONSTANTS


$ABS_MIN_HSP=0.85;	# as portion of ideal hsync pulse, the least acceptable
				# pulse width.
$ABS_MIN_VSP=0.85;		# ditto, for vsync pulse
$MIN_HFP=16;		# Minimum Horizontal front/back porches (in ticks)
$MIN_HBP=32;
$MIN_VFP=3;			# Minimum Vertical front/back porches (vert.ticks)
$MIN_VBP=3;
# these constants just used in new algorithm
$HFL_QUOTIENT=1.25;	# Ratio between horizontal frame length and horizontal res
$VFL_QUOTIENT=1.05;	# Same but for vertical frame length
$REL_HSP_WIDTH=0.1;	# (horizontal sync pulse width) / (horizontal frame length )
$REL_HFRONT_PORCH_WIDTH=0.2; 	# portion of surplus space given to horizontal front porch
					# after the horizontal sync pulse time and frame length
					# have been set. 
$REL_VFRONT_PORCH_WIDTH=0.1;	# same but for vertical.
# END CONSTANTS

@ARGS=&getOpts();

# print STDERR "INTERACTIVE $ARGS[0]\nVERBOSE $ARGS[1]\nGEOMETRY $ARGS[2]\nVSYNC $ARGS[3]\nHSYNC $ARGS[4]\nCLOCK $ARGS[5]\n";

$INTERACTIVE=$ARGS[0];
$VERBOSE=$ARGS[1];
$RES=$ARGS[2];
$VSYNC=$ARGS[3];
$HSYNC=$ARGS[4];
$CLOCK=$ARGS[5];
	
@NUMERIC_RES=&getRes($RES); 

$ERROR_FLAG = 0;
if ($INTERACTIVE == 0 ) { 
	if ($HSYNC == 0){ 
	$HSYNC=( $NUMERIC_RES[1]*$VFL_QUOTIENT*$VSYNC);
	$HSYNC=(int ($HSYNC) /1000 ); 	#round to one decimal place
	}
	if ($CLOCK == 0 ){
	$CLOCK=&round( $HSYNC*($NUMERIC_RES[0]*$HFL_QUOTIENT)/1000,2 ) ;  
	}
# 	print STDERR  "hsync $HSYNC\nvsync $VSYNC\nres $RES\nclock $CLOCK\n" ; exit 0;
	@MODELINE=getModeline( $HSYNC, $VSYNC, $RES, $CLOCK ) ;


}


if ($INTERACTIVE == 1 ) { @USER_INPUT = &getUserInput; 
				  @MODELINE   = &getModeline(@USER_INPUT);
				  $VSYNC=$USER_INPUT[1];
				  $HSYNC=$USER_INPUT[0];
				}
if ($VERBOSE == 1 ){
	&testVsync;
}

$ERROR_FLAG = pop (@MODELINE);
if ( $ERROR_FLAG == 2 ) {
	print "# bad modeline\n";
	print "# don't use this mode unless you really know what you're doing\n";
	print "# Vsync $VSYNC Hsync $HSYNC\n#";
	}
if ( $ERROR_FLAG == 1 ) {
	print "# this modeline is mildly unsatisfactory: use with caution \n" ;
	print "# Vsync $VSYNC Hsync $HSYNC\n#";
}
if ( $ERROR_FLAG == 0 ) {
	print "# succesfully generated modeline\n";
	print "# Vsync $VSYNC Hsync $HSYNC\n";
}
if ( $ERROR_FLAG != 9 && $ERROR_FLAG !=3 ) {
	print "Modeline ";
	print "\"$NUMERIC_RES[0]x$NUMERIC_RES[1]\" ";
	foreach $X (@MODELINE){ print "$X ";}
	print "\n";
}

exit 0;


######################  getOpts SUBROUTINE

sub getOpts {
my($INTERACTIVE)=1;
my($VERBOSE)=1;
my($VSYNC)=0;
my($HSYNC)=0;
my($CLOCK)=0;
my($GEOMETRY)="";
my($RES)="";
local($arg)="";

while ( $#ARGV >= 0 ){
$arg=shift(@ARGV);
if (  $arg !~ /^-([gvhcQ]|-hsync|-vsync|-clock|-quiet|-geometry)$/ ){
	&badexit(9);
	}
# print "Start of loop: arg is $arg\n";

# test for --verbose command option (or -v)

if ( $arg eq "-Q" || $arg eq "--quiet" ){
	if ( $VERBOSE == 0 ) { 
	&badexit(1);
	} else {
	$VERBOSE = 0;
	}
}

# test for geometry

if ( $arg eq "-g" || $arg eq "--geometry" ){ 
# print "found -g or --geometry \n"; print '$#ARGV=';print "$#ARGV\n";
	if ( $#ARGV >= 0 && $GEOMETRY eq ""  ) {
	$arg = shift(@ARGV);
		  if ( $arg !~ /^(640x480|800x600|1024x768|1280x1024|1600x1200)$/ ) { 
		  &badexit(2); 
		  } 	
	$GEOMETRY=$arg;
	} 
	else { &badexit(4); }
	}


# test for all options that take numerical arguments

$VSYNC=&readarg($arg,"-v","--vsync",$VSYNC);
$HSYNC=&readarg($arg,"-h","--hsync",$HSYNC);
$CLOCK=&readarg($arg,"-c","--clock",$CLOCK);
}

if ( $VSYNC eq "0" && !( $HSYNC eq "0"  ) ){ &badexit(5); }
if ( $HSYNC eq "0" && !( $CLOCK eq "0"  ) ){ &badexit(6); }
if ( $VSYNC eq "0" && !( $GEOMETRY eq "") ) { &badexit(7); }

if ( $VSYNC eq "0" ) { 
	$INTERACTIVE = 1; 
	} else {
	$INTERACTIVE = 0;
	}
if ( $GEOMETRY eq "" ) { $RES = "b" ; }
if ( $GEOMETRY eq "640x480" ){ $RES = "a" ;}
if ( $GEOMETRY eq "800x600" ){ $RES = "b" ;}
if ( $GEOMETRY eq "1024x768" ){ $RES = "c" ;}
if ( $GEOMETRY eq "1280x1024" ){ $RES = "d" ;}
if ( $GEOMETRY eq "1600x1200" ){ $RES = "e" ;}

return ( $INTERACTIVE, $VERBOSE, $RES, $VSYNC , $HSYNC , $CLOCK );
}

################### END getOpts ########################

######### Other subroutines used by getOpts

sub readarg {
local ($argu)=0;
if ( $_[0] eq $_[1] || $_[0] eq $_[2] ){ 
# print "found $_[1] or $_[2] \n"; print '$#ARGV=';print "$#ARGV\n";
	if ( $#ARGV >= 0 && $_[3] eq "0"  ) {
	$argu = shift(@ARGV);
		  if ( $argu !~ /^[0-9]*(\.[0-9]*)?/ ) { 
		  &badexit(2); 
		  } 	
		  if ( $argu eq "0" ){ &badexit(3); }		
	return $argu;
	} 
	else { &badexit(4); }
	}
	else { return $_[3]; }
}

sub badexit {
if ( $_[0] == 9 ) { print STDERR " illegal option $arg\n"; }
print STDERR "usage:\n";
print STDERR "modeline [-Q|--quiet] [(-v|--vsync) vsync [(-h|--hsync) hsync [(-c|--clock) clock]]] [[-g|--geometry] (640x480|800x600|1024x768|1280x1024|1600x1200)] \n";
print STDERR "exit $_[0]\n";
exit $_[0];
}

############### END subroutines used by getOpts

sub getUserInput {
local ($HSYNC) = 0;
local ($VSYNC) = 0;
local ($RES) = "a";
local ($CLOCK) = 0;
local @NUMERIC_RES = (0,0);

do {	
	if ( $RES !~ /^[aAbBcCdDeE]$/ ){ print STDERR "bad input. try again\n" ;}
	print STDERR "choose resolution: \n(a) 640x480 \n";
	print STDERR "(b) 800x600 \n(c) 1024x768 \n(d) 1280x1024\n(e) 1600x1200\n";
	chomp($RES=<>);
	} until ( $RES =~ /^[aAbBcCdDeE]$/ );

do { 
	if (! &isNum($VSYNC)){ 
	print STDERR "$VSYNC isn't a positive number. Try again\n"; 
	} 
	print STDERR "enter vsync in hz\n" ;
	chomp($VSYNC=<>);
	} until ( &isNum($VSYNC) );
&testVsync;
	@NUMERIC_RES = &getRes($RES);
	$HSYNC=($NUMERIC_RES[1]*$VFL_QUOTIENT*$VSYNC);
	$HSYNC=(int ($HSYNC) /1000 ); 	#round to one decimal place
do {	
	if (! &isNum($HSYNC)){ print STDERR "$HSYNC isn't a positive number. Try again\n"; }
	  print STDERR "enter hsync in khz (recommend $HSYNC )\n" ;
	  chomp($HSYNC=<>);
	} until ( &isNum($HSYNC) );
	


	$CLOCK=&round( $HSYNC*($NUMERIC_RES[0]*$HFL_QUOTIENT)/1000,2 );  
do {
	if (! &isNum($CLOCK)){print STDERR "$CLOCK isn't a positive number. Try again\n"; }
	  print STDERR "enter dotclock (MHZ) (Recommend $CLOCK)\n";
	  chomp($CLOCK=<>);
	  } until ( &isNum($CLOCK) );	 

 return ( $HSYNC, $VSYNC, $RES, $CLOCK );
}

# getModeline is the main subroutine. 
# it takes hsync, vsync, resolution, and dotclock as input

sub getModeline { 

local @MODELINE = (0,0,0,0,0,0,0,0,0);
local @NUMERIC_RES = (0,0);

local ($HSYNC) = $_[0] ;
local ($VSYNC) = $_[1] ;
local ($RES) = $_[2] ;
local ($CLOCK) = $_[3];

local ($ERROR_FLAG1) = 0;
local ($ERROR_FLAG2) = 0;

local ($HP_START) = 0;	# the first tick of the horizontal sync pulse
local ($VP_START) = 0;	# the first "vertical tick" of the vsync pulse (6th no. in modeline)
local ($HP_WIDTH) = 0;	# width of hsync pulse
local ($VP_WIDTH) = 0;	# ditto for vsync pulse
local ($HSP) = 0;		# horizontal sync pulse width (microseconds)
local ($VSP) = 0;		# vertical sync pulse width (microseconds)

if 	(! 
	( 
		isNum($_[0]) && 
		isNum($_[1]) && 
		$_[2] =~ /^[aAbBcCdDeE]$/ 
		&& isNum($_[3]) 
	)
	) { 
		return ( @MODELINE, 9 ) ;
		} # bad input => bad exit status (exit 9 ) 

@NUMERIC_RES = getRes($RES);

@MODELINE=( $CLOCK, $NUMERIC_RES[0], 0,0,0, $NUMERIC_RES[1],0,0,0 );


$MODELINE[4] = 1000*$CLOCK/$HSYNC;
$MODELINE[4] = 8*int($MODELINE[4]/8); # convert to an integer divisible by 8
$MODELINE[8] = int(1000000*$CLOCK/($MODELINE[4]*$VSYNC)); 

$VSP = $HSYNC*($MODELINE[8]-$MODELINE[5]-$MIN_VBP-$MIN_VFP)*$MODELINE[4]/$CLOCK/1000 ;  
if ( $VERBOSE == 1) { 
print STDERR "Max possible vertical sync pulse (micro-seconds) :" ; 
print STDERR &round($VSP,2);
print STDERR "\n";
}
$ERROR_FLAG1 = &testVsyncPulse($VSP) ;

$HSP = ($MODELINE[4]-$MODELINE[1]-$MIN_HBP-$MIN_HFP)/$CLOCK;
if ( $VERBOSE == 1) {
print STDERR "Max possible horizontal sync pulse (micro-seconds): ";
print STDERR &round($HSP,2);
print STDERR "\n" ;
} 

$IDEAL_HSP = (1000/$HSYNC) * $REL_HSP_WIDTH ;
if ( $VERBOSE == 1){
print STDERR "preferred HSP is ";
print STDERR &round($IDEAL_HSP,2);
print STDERR "\n"; 
}

$ERROR_FLAG2 = &testHsyncPulse($HSP, $IDEAL_HSP) ;

$ERROR_FLAG1 = $ERROR_FLAG2 = ($ERROR_FLAG1 > $ERROR_FLAG2) ? $ERROR_FLAG1 : $ERROR_FLAG2; 


if ( $HSP > $IDEAL_HSP ) { $HSP = $IDEAL_HSP; }	# Use preferred sync pulses
if ( $VSP > $IDEAL_VSP ) { $VSP = $IDEAL_VSP; }	# if possible

$HP_WIDTH = $HSP*$CLOCK;

$VP_WIDTH = $VSP;

$HP_START = 8*int(
		($MODELINE[1] + 
		$MIN_HFP + 
			(
			$MODELINE[4]
			-$MODELINE[1]  
			-$MIN_HFP
			-$MIN_HBP
			-$HP_WIDTH 
			)*$REL_HFRONT_PORCH_WIDTH  	
		)/8
		);

$VP_START = int( 
			$MODELINE[5] + 
			$MIN_VFP + 
			(
				( $MODELINE[8]-$MODELINE[5] ) 
			-$MIN_VFP-$MIN_VBP-$VP_WIDTH 
			)
		*$REL_VFRONT_PORCH_WIDTH) ;  

$MODELINE[2] = $HP_START;
$MODELINE[3] = 8*int ( ($HP_START + $HP_WIDTH ) / 8 );

$MODELINE[6] = $VP_START;
$MODELINE[7] = $VP_START + int($VP_WIDTH);

return ( @MODELINE, $ERROR_FLAG1);		
}
# END getModeline

sub isNum { return ( $_[0] =~ /^[0-9]*(\.[0-9]*)?$/ ); }

sub round { return  ( ( int (  10 ** $_[1] * $_[0]))  /  ( 10 ** $_[1])) ; }



sub getRes { 
	# print '$_[0] is ';
	# print "$_[0]\n";
	if ( $_[0] =~ /^[aA]$/ ) {
	return ( 640, 480 );
	}
	if ( $_[0] =~ /^[bB]$/ ) {
	return ( 800, 600 );
	}
	if ( $_[0] =~ /^[cC]$/ ) {
	return ( 1024, 768 ) ;
	}
	if ( $_[0] =~ /^[dD]$/ ) {
	return ( 1280, 1024 );
	}
	if ( $_[0] =~ /^[eE]$/ ) {
	return ( 1600, 1200 );
	}
	if ( $_[0] !~ /^[aAbBcCdDeE]$/ ) {
	print STDERR "error: getRes gave bad output\n";
	return 0;
	}
	}

sub testVsyncPulse {
# First, test the maximum available sync pulses and write diagnostic messages.

if ( $_[0] < 0 ) {
	if ( $VERBOSE == 1 ) {
		print STDERR "Sorry, I can't write you a modeline with a negative \n";
		print STDERR "vertical sync pulse\n";
		print STDERR "To fix it, try one of the following:\n";
		print STDERR "(a) Increase the Hsync\n";
		print STDERR "(b) Decrease the Vsync\n";
		}
	return 3;	# very bad exit status: no modeline
		}

if ( $_[0] < $ABS_MIN_VSP*$IDEAL_VSP ) {
	if ( $VERBOSE == 1 ) {
		print STDERR "this is way too short - aim for at least $IDEAL_VSP \n";
		print STDERR "To fix it, try one of the following:\n";
		print STDERR "(a) Increase the Hsync\n";
		print STDERR "(b) Decrease the Vsync\n";
		print STDERR "I'll write you a modeline anyway, but it won't be too hot\n";
		}
	return 2;	# bad exit: can write a modeline but it's not very safe
		}
if ( $_[0] < $IDEAL_VSP ) { 
	if ( $VERBOSE == 1 ) {
		print STDERR "this is on the short side ( $IDEAL_VSP or more would be ";
		print STDERR "better), but passible. \n";
		print STDERR "To improve it, try one of the following:\n";
		print STDERR "(a) Increase the HSync\n";
		print STDERR "(b) Decrease the VSync\n";
			}
	return 1;	# the modeline is suboptimal but maybe usable.
	}
return 0;
}


sub testHsyncPulse {
# First, test the maximum available sync pulses and write diagnostic messages.

if ( $_[0] < 0 ) {
	if ( $VERBOSE == 1 ) {
		print STDERR "Sorry, I can't write you a modeline with a negative \n";
		print STDERR "horizontal sync pulse\n";
			}
	return 3;	# very bad exit status: no modeline
	}

if ( $_[0] < $ABS_MIN_HSP*$_[1] ) {
	if ( $VERBOSE == 1 ) {
		print STDERR "this is way too short - aim for at least $_[1] \n";
		print STDERR "To fix it, try one of the following:\n";
		print STDERR "(a) try a higher dotclock\n";
		print STDERR "(b) try a lower hsync\n";
		print STDERR "I'll write you a modeline anyway, but it won't be too hot\n";
		}
	return 2;	# bad exit: can write a modeline but it's not very safe
	}
if ( $_[0] < $_[1] ) { 
	if ( $VERBOSE == 1 ) {
		print STDERR "this is on the short side ($_[1] or more would be better)";
		print STDERR ", but passible. ";
		print STDERR "To improve it, try one of the following:\n";
		print STDERR "(a) try a higher dotclock\n";
		print STDERR "(b) try a lower hsync\n";
		}
	return 1;	# the modeline is suboptimal but maybe usable.
	}
return 0;
}

sub testVsync{
if ( $VSYNC > $MAX_VSYNC ){ 
print STDERR "Warning: this refresh rate is greater than ",$MAX_VSYNC,"hz. \n";
print STDERR "This requires a high performance monitor. \n";
print STDERR "Check your monitor documentation or consider using \n";
print STDERR "something in the ",$MIN_VSYNC,"-" ,$MAX_VSYNC,"hz range\n\n" ;
}
if ( $VSYNC < $MIN_VSYNC ){ 
print STDERR "Warning: this refresh rate is less than ", $MIN_VSYNC,"hz. \n";
print STDERR "This will not be fun to look at. \n";
print STDERR "Consider using something in the ",$MIN_VSYNC,"hz - ";
print STDERR $MAX_VSYNC, "hz range. \n\n";
}
}