#! perl

# Check command line arguments (none required)
if ( $ARGV[1] ) {
	Syntax();
}

# Create temporary DEBUG script
$dbg = "D 0:417\nQ\n";
open( DBGSCR, "> keylocks.dbg" ) || die( "Cannot open temporary DEBUG script: $!" );
print DBGSCR $dbg;
close DBGSCR;

# Run DEBUG script and filter output;
`debug.exe < keylocks.dbg` =~ /\s{10}(\d\d)\-\d\d/;
#eval "\$keylocks = 0x".$1;
$keylocks = ( hex "0x".$1 ) & 0x70;

$capslock   = ( $keylocks & 0x40 ) / 0x40;
$numlock    = ( $keylocks & 0x20 ) / 0x20;
$scrolllock = ( $keylocks & 0x10 ) / 0x10;

$msg_caps   = ( ( uc $ARGV[0] ne "N" and uc $ARGV[0] ne "S" ) ? "CapsLock=$capslock\n"     : "" );
$msg_num    = ( ( uc $ARGV[0] ne "C" and uc $ARGV[0] ne "S" ) ? "NumLock=$numlock\n"       : "" );
$msg_scroll = ( ( uc $ARGV[0] ne "C" and uc $ARGV[0] ne "N" ) ? "ScrollLock=$scrolllock\n" : "" );
print $msg_caps.$msg_num.$msg_scroll;

if ( $ARGV[0] ) {
	$keylocks = ( ( uc $ARGV[0] ne "N" and uc $ARGV[0] ne "S" ) ? $capslock   : $keylocks );
	$keylocks = ( ( uc $ARGV[0] ne "C" and uc $ARGV[0] ne "S" ) ? $numlock    : $keylocks );
	$keylocks = ( ( uc $ARGV[0] ne "C" and uc $ARGV[0] ne "N" ) ? $scrolllock : $keylocks );
}

# Delete temporary DEBUG script
`DEL keylocks.dbg >NUL 2>&1`;

# Return code is the key locks status
exit $keylocks;


sub Syntax {
	print "\nKeyLocks.pl,  Version 1.00 for DOS, Windows & OS/2\n",
	      "Returns the status of the CapsLock, NumLock and ScrollLock keys\n\n",
	      "Usage:  KEYLOCKS.PL  [ C | N | S ]\n\n",
	      "Where:  C is for CapsLock status, N for NumLock, and S for ScrollLock.\n",
	      "        By default the status for all three is displayed.\n\n",
	      "Notes:  Depending on the optional command line argument, either the status of\n",
	      "        the requested key lock or that of all key locks is displayed on screen,\n",
	      "        and the return code will either be the status of the requested key lock\n",
	      "        (0=OFF, 1=ON) or a combination of the three (OFF=0, CapsLock ON=64,\n",
	      "        NumLock ON=32, and ScrollLock ON=16, all added together).\n",
	      "        This script uses the DEBUG command to read the keyboard status.\n\n",
	      "Written by Rob van der Woude\n",
	      "http://www.robvanderwoude.com\n";
	exit;
}