vfd.pl

Tested on Windows XP with Active Perl

  1. use Net::Telnet ();

  2. use Win32::SerialPort; # on Windows

  3. use Term::ReadKey;

  4.  

  5. sub openPort($);

  6. sub closePort($);

  7. sub trim($);

  8.  

  9. # === General settings ===

  10. $DEVICE = "COM2";  # on Windows                                      

  11. $host = "g7rau.demon.co.uk";

  12. $port = 7374;

  13. $callsign = "xx0xx";   # <----------------- Please setup your callsign !

  14. $login_pattern = "\/\.\*login\:\.\*\$\/";

  15. $dxc_nohere_cmd = "unset/here"; # dxspider

  16. $spot_show_time = 4;

  17. $vfd_type = "ibm"; # dsp800,ibm,epson,firich

  18.  

  19. # === DSP800 setup ===

  20. $vfd_init{dsp800} = "";

  21. $vfd_home1{dsp800} = pack("H*","0401503117");

  22. $vfd_home2{dsp800} = pack("H*","0401504517");

  23. $vfd_clear{dsp800} = pack("H*","040143315817");

  24.  

  25. # === IBM setup ===

  26. # 0x15=slahed zero 0x16=O

  27. $vfd_init{ibm} = pack("H*","0001111403157088C8A89888700003167088888888887000");

  28. $vfd_home1{ibm} = pack("H*","1000");

  29. $vfd_home2{ibm} = pack("H*","1014");

  30. $vfd_clear{ibm} = pack("H*","202020202020202020202020202020202020202020202020202020202020202020202020202020201000");

  31.  

  32. # === Epson setup ===

  33. $vfd_init{epson} = pack("H*","1F011B40");

  34. $vfd_home1{epson} = pack("H*","1F240101");

  35. $vfd_home2{epson} = pack("H*","1F240102");

  36. $vfd_clear{epson} = pack("H*","0C");

  37.  

  38. # === Firich/CD5220 ===

  39. $vfd_init{firich} = pack("H*","1B111B40");

  40. $vfd_home1{firich} = pack("H*","1B6C0101");

  41. $vfd_home2{firich} = pack("H*","1B6C0102");

  42. $vfd_clear{firich} = pack("H*","0C");

  43.  

  44. my $serial = openPort($DEVICE);

  45.  

  46. #init VFD

  47. $serial->write($vfd_init{$vfd_type});

  48.  

  49. #login DX Cluster

  50. $serial->write($vfd_clear{$vfd_type});

  51. $serial->write("Connecting..");

  52. $serial->write($host.":".$port);

  53.  

  54. $t = new Net::Telnet;

  55. $t->open(Host => $host, Port=> $port);

  56.  

  57. $t->waitfor($login_pattern);

  58.  

  59. $serial->write($vfd_clear{$vfd_type});

  60. $serial->write("Login..");

  61. $serial->write($vfd_home2{$vfd_type});

  62. $serial->write($callsign);

  63.  

  64. $t->print($callsign);

  65. sleep(5);

  66.  

  67. $serial->write($vfd_clear{$vfd_type});

  68. $serial->write("Set NOHERE");

  69. $t->print($dxc_nohere_cmd);

  70. sleep(1);

  71.  

  72. ReadMode 'raw';  

  73. while("q" ne ReadKey(-1)) {

  74.    $line = $t->getline(Timeout=>900);

  75.  

  76.    if (substr($line,0,2) eq "DX") {

  77.       $spotter_pfx = substr $line,6,2;

  78.       $spotter = trim(substr $line,6,7);      

  79.       $qrg = trim(substr $line,14,8);

  80.       $dx = trim(substr $line,24,15);        

  81.       $comment = substr $line,39,20;

  82.  

  83.       #print to console      

  84.       print $qrg." ".$spotter." ".$dx." ".$comment."\n";

  85.      

  86.       $top_line = $qrg." ".$spotter_pfx." ".$dx;

  87.  

  88.       if ($vfd_type eq "ibm") {

  89.           $top_line =~ tr/[0,O]/[\x15,\x16]/;

  90.           $comment =~ tr/[0,O]/[\x15,\x16]/;

  91.       }

  92.      

  93.       #print to VFD

  94.       $serial->write($vfd_clear{$vfd_type});

  95.       $serial->write($top_line);

  96.       $serial->write($vfd_home2{$vfd_type});

  97.       $serial->write($comment);

  98.            

  99.       sleep($spot_show_time);

  100.   }      

  101. }

  102.  

  103. $serial->write($vfd_clear{$vfd_type});

  104. $serial->write("==End==");

  105. closePort($serial);

  106. exit;

  107.  

  108. sub openPort($)

  109. {

  110.         my ($device) = @_;

  111.  

  112.         #my $serial = Device::SerialPort->new ($device, 1); # on UNIX

  113.         my $serial = Win32::SerialPort->new ($device, 1); # on Windows

  114.         die "Can't open serial port $serial: $^E\n" unless ($serial);

  115.  

  116.         $serial->user_msg(1);

  117.         $serial->databits(8);

  118.         $serial->baudrate(9600);

  119.         $serial->parity("none");

  120.         $serial->stopbits(1);

  121.         #$serial->handshake("rts");

  122.         $serial->handshake("none");

  123.         $serial->write_settings || undef $serial;

  124.  

  125.   return $serial;

  126. }

  127.  

  128. sub closePort($)

  129. {

  130.         my ($serial) = @_;

  131.         $serial->close();

  132. }

  133.  

  134. sub trim($) {

  135.         my $string = shift;

  136.         $string =~ s/^\s+//;

  137.         $string =~ s/\s+$//;

  138.         return $string;

  139. }