#!/usr/bin/perl -w

# selcal -- generate ICAO SELCAL tones just like on HF aviation radio
# using xmms on Debian GNU/Linux.  Purpose of this program: impress
# guests, I suppose.

# Copyright       : http://www.fsf.org/copyleft/gpl.html
# Author          : Dan Jacobson -- http://jidanni.org/comm/radio/
# Created On      : Sat Oct  9 10:47:24 2004
# Last Modified By: Dan Jacobson
# Last Modified On: Wed Mar 23 09:36:55 2005
# Update Count    : 137

# Instructions: you MUST have an xmms running in the background first:
# $ xmms&
# Then you can do as many e.g.,
# $ selcal abcd
# as you like.  Otherwise one gets never ending tones, etc.

use strict;
my $prog = "xmms";
sub tone { #with rudimentary backwards logic die's
    die if system "$prog \"tone://" . (shift) . "\"";
    sleep 1;
    die if system "$prog -s";
}

# Obsessive validity checks for this mere family entertainment program:
die "$0: give one code" if $#ARGV;
die "$0: give four letters" if length $ARGV[0] != 4;
$_ = uc $ARGV[0];
my $valid = 'A-HJ-MP-S';
if (/[^$valid]/) { s/[$valid]//g; die "$0: invalid letters \"$_\"" }
# Caught below anyway:
# /(.)(.)(.)(.)/;
# if ( $1 eq $2 || $3 eq $4 ) { die "$0: identical letters within pairs" }

# compute tones needed
s/../$& /;
s/A/312.6;/;
s/B/346.7;/;
s/C/384.6;/;
s/D/426.6;/;
s/E/473.2;/;
s/F/524.8;/;
s/G/582.1;/;
s/H/645.7;/;
s/J/716.1;/;
s/K/794.3;/;
s/L/881.0;/;
s/M/977.2;/;
s/P/1083.9;/;
s/Q/1202.3;/;
s/R/1333.5;/;
s/S/1479.1;/;
die "$0: each letter must be different" if /[A-Z]/; #though
# http://www.arinc.com/frequency_management/selcal/selcal_ops.html
# says not that critical
/(.*) (.*)/;

# I was guessing ways to automate ensuring there is an xmms in the background,
# die if system "pidof $prog > /dev/null || { $prog& sleep 1;}";
# but that only worked on Debian.
# There is a /tmp/xmms_$USER.0 to test we see, but that is too complex.
# die if system "$prog& sleep 1"; # Still wasteful.

tone $1;
select( undef, undef, undef, 0.2 );
tone $2;

# Why must one need X windows to do this?
# Any other program that can play two tones at once?

# Maybe I could have used xmms-shell but I see no way there to
# play or pause for a given time.
# This is just a proof of concept program. It could be made many times
# smarter by an xmms pro. I wanted to use beep(1) but that could only
# play one tone at a time.
# This should all be done in one UNIX process.  I am a perl non-pro.

# Program guts were generated with
# LC_ALL=C w3m -dump http://www.wavecom.ch/onlinemanual/icaoselcal1.htm |
# perl -nlwe 'if(/RED/){s/\|//g;@F=split;print "s/$F[1]/$F[2];/;"}'
# but that page is/was gone now, 3/2005