File Coverage

blib/lib/NexStarCtl.pm
Criterion Covered Total %
statement 27 712 3.7
branch 0 368 0.0
condition 0 104 0.0
subroutine 9 70 12.8
pod 50 60 83.3
total 86 1314 6.5


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             ########################################################
4             # NexStarCtl - NexStar control library
5             #
6             #
7             # (c)2013-2016 by Rumen G.Bogdanovski
8             ########################################################
9              
10             =head1 NAME
11              
12             NexStarCtl - API to control NexStar compatible telescopes
13              
14             =head1 SYNOPSIS
15              
16             use NexStarCtl;
17            
18             my $port = open_telescope_port("/dev/XXX");
19             if (!defined $port) {
20             print "Can not open communication port.\n";
21             exit;
22             }
23            
24             # check if the mount is aligned
25             if (tc_check_align($port)) {
26             print "The telescope is aligned.\n";
27             } else {
28             print "The telescope is not aligned.\n";
29             }
30            
31             # Read the stored coordinates of the location
32             my ($lon,$lat) = tc_get_location_str($port);
33             if (! defined($lon)) {
34             print "Telescope did not respond\n";
35             close_telescope_port($port);
36             exit;
37             }
38             print "Location coordinates:\n LON=$lon\n LAT=$lat\n";
39              
40             my ($date,$time,$tz,$dst) = tc_get_time_str($port);
41             # ...
42             # Do some other stuff
43             # ...
44            
45             close_telescope_port($port);
46              
47             =head1 DESCRIPTION
48              
49             This module implements the serial commands supported by the Celestron NexStar hand control (HC) and SkyWatcher/Orion SynScan HC.
50             This applies to the Celestron: NexStar GPS, NexStar GPS-SA, NexStar iSeries, NexStar SE Series, NexStar GT, CPC, SLT, Advanced-VX,
51             Advanced-GT, CGE, CGEM etc. SkyWatcher: EQ5, HEQ5, EQ6 (Pro), AZ-EQ5 GT, AZ-EQ6 GT, EQ8 etc. and the corresponding Orion mounts.
52              
53             Communication to the hand control is 9600 bits/sec, no parity and one stop bit via the RS-232 port on the base of the
54             hand control.
55              
56             Communication can be established over TCP/IP if nexbridge is running on the computer connected to the telescope.
57              
58             For extended example how to use this perl module look in to the distribution folder for nexstarctl/nexstarctl.pl.
59             This program is a complete console tool to control NexStar telescopes based on NexStarCtl module.
60              
61             NOTE: For SkyWatcher/Orion mounts it is highly recommended to enforce protocol version checking (see enforce_protocol_version()) as
62             the AUX commands are not supported or may behave erratically.
63              
64             =cut
65              
66             package NexStarCtl;
67              
68 1     1   13727 use POSIX;
  1         4720  
  1         3  
69 1     1   2169 use Time::Local;
  1         1162  
  1         51  
70 1     1   397 use IO::Socket::INET;
  1         14667  
  1         4  
71 1     1   330 use strict;
  1         1  
  1         20  
72 1     1   3 use Exporter;
  1         1  
  1         72  
73              
74             if ($^O eq "MSWin32") {
75             eval "use Win32::SerialPort"; die $@ if $@;
76             } else {
77 1     1   767 eval "use Device::SerialPort"; die $@ if $@;
  1         10377  
  1         32  
78             }
79              
80             use constant {
81 1         166 VER_1_2 => 0x10200,
82             VER_1_6 => 0x10600,
83             VER_2_2 => 0x20200,
84             VER_2_3 => 0x20300,
85             VER_3_1 => 0x30100,
86             VER_4_10 => 0x40A00,
87             VER_4_37_8 => 0x042508,
88             # All protocol versions
89             VER_AUX => 0xFFFFFF,
90             # Auto detect version by HC
91             VER_AUTO => 0x0,
92              
93             # Protocol vendors
94             VNDR_CELESTRON => 0x1,
95             VNDR_SKYWATCHER => 0x2,
96             VNDR_ALL_SUPPORTED => 0x3, # VNDR_CELESTRON | VNDR_SKYWATCHER
97              
98             # version manipulation
99             RELEASE_MASK => 0xFF0000,
100             REVISION_MASK => 0x00FF00,
101             PATCH_MASK => 0x0000FF
102 1     1   23 };
  1         1  
103              
104              
105             my $is_tcp = 0;
106             my $proto_version = VER_AUX;
107             my $mount_vendor = VNDR_ALL_SUPPORTED;
108              
109             # There is no way to tell SkyWatcher from Celestron. Unfortunately both share the
110             # same IDs and some Celestron mounts have RTC wile SW does not. That is why the user
111             # should decide. Set use_rtc to 1 to enable using the RTC on the mounts that have RTC.
112             our $use_rtc = 0;
113              
114             # 0 => no error
115             # -5 => unsupported command
116             our $error = 0;
117              
118 1     1   4 use constant TIMEOUT => 4;
  1         1  
  1         126  
119              
120             our @ISA = qw(Exporter);
121             our @EXPORT = qw(
122             VERSION
123              
124             use_rtc
125             error
126             VER_1_2 VER_1_6 VER_2_2 VER_2_3
127             VER_3_1 VER_4_10 VER_4_37_8 VER_AUX VER_AUTO
128              
129             VNDR_CELESTRON VNDR_SKYWATCHER
130              
131             DEG2RAD RAD2DEG
132             notnum precess round
133             d2hms d2dms d2dm dms2d hms2d
134             dd2nex dd2pnex nex2dd pnex2dd
135              
136             get_model_name
137              
138             open_telescope_port
139             close_telescope_port
140             read_telescope
141             enforce_protocol_version
142             guess_mount_vendor
143             enforce_vendor_protocol
144              
145             tc_pass_through_cmd
146             tc_check_align tc_get_orientation
147             tc_goto_rade tc_goto_rade_p
148             tc_goto_azalt tc_goto_azalt_p
149             tc_get_rade tc_get_rade_p
150             tc_get_azalt tc_get_azalt_p
151             tc_sync_rade tc_sync_rade_p
152             tc_goto_in_progress tc_goto_cancel
153             tc_get_model
154             tc_get_version
155             tc_echo
156             tc_get_location tc_get_location_str
157             tc_get_time tc_get_time_str
158             tc_set_time tc_set_location
159             tc_get_tracking_mode tc_set_tracking_mode
160             tc_slew_variable tc_slew_fixed
161             tc_get_autoguide_rate tc_set_autoguide_rate
162             tc_get_backlash tc_set_backlash
163              
164             TC_TRACK_OFF
165             TC_TRACK_ALT_AZ
166             TC_TRACK_EQ_NORTH
167             TC_TRACK_EQ_SOUTH
168             TC_TRACK_EQ
169             TC_TRACK_EQ_PEC
170              
171             TC_DIR_POSITIVE
172             TC_DIR_NEGATIVE
173              
174             TC_AXIS_RA_AZM
175             TC_AXIS_DE_ALT
176             );
177              
178             our $VERSION = "0.15";
179              
180             use constant {
181 1         4904 NX_TC_TRACK_OFF => 0,
182             NX_TC_TRACK_ALT_AZ => 1,
183             NX_TC_TRACK_EQ_NORTH => 2,
184             NX_TC_TRACK_EQ_SOUTH => 3,
185              
186             SW_TC_TRACK_OFF => 0,
187             SW_TC_TRACK_ALT_AZ => 1,
188             SW_TC_TRACK_EQ => 2,
189             SW_TC_TRACK_EQ_PEC => 3,
190              
191             TC_TRACK_OFF => 0,
192             TC_TRACK_ALT_AZ => 1,
193             TC_TRACK_EQ_NORTH => 2,
194             TC_TRACK_EQ_SOUTH => 3,
195             TC_TRACK_EQ => 4,
196             TC_TRACK_EQ_PEC => 5,
197            
198             TC_DIR_POSITIVE => 1,
199             TC_DIR_NEGATIVE => 0,
200            
201             TC_AXIS_RA_AZM => 1,
202             TC_AXIS_DE_ALT => 0,
203            
204             _TC_DIR_POSITIVE => 6,
205             _TC_DIR_NEGATIVE => 7,
206            
207             _TC_AXIS_RA_AZM => 16,
208             _TC_AXIS_DE_ALT => 17,
209              
210             DEG2RAD => 3.1415926535897932384626433832795/180.0,
211             RAD2DEG => 180.0/3.1415926535897932384626433832795
212 1     1   3 };
  1         1  
213              
214             my %mounts = (
215             &VNDR_CELESTRON => {
216             1 => "NexStar GPS Series",
217             3 => "NexStar i-Series",
218             4 => "NexStar i-Series SE",
219             5 => "CGE",
220             6 => "Advanced GT",
221             7 => "SLT",
222             9 => "CPC",
223             10 => "GT",
224             11 => "NexStar 4/5 SE",
225             12 => "NexStar 6/8 SE",
226             14 => "CGEM",
227             20 => "Advanced VX",
228             22 => "Nexstar Evolution"},
229             &VNDR_SKYWATCHER => {
230             0 => "EQ6 Series",
231             1 => "HEQ5 Series",
232             2 => "EQ5 Series",
233             3 => "EQ3 Series",
234             4 => "EQ8 Series",
235             5 => "AZ-EQ6 Series",
236             6 => "AZ-EQ5 Series",
237             160 => "AllView Series",
238             ( map { $_ => "AZ Series" } (128..143)),
239             ( map { $_ => "DOB Series" } (144..159))
240              
241             }
242             );
243              
244             sub release_before($) {
245 0     0 0   my ($release) = @_;
246              
247 0 0         if ((($proto_version & RELEASE_MASK) >> 16) < $release) {
248 0           $error = -5;
249             } else {
250 0           $error = 0;
251             }
252              
253 0           return $error;
254             }
255              
256             sub revision_before($) {
257 0     0 0   my ($revision) = @_;
258              
259 0 0         if ((($proto_version & REVISION_MASK) >> 8) < $revision) {
260 0           $error = -5;
261             } else {
262 0           $error = 0;
263             }
264              
265 0           return $error;
266             }
267              
268             sub patch_before($) {
269 0     0 0   my ($patch) = @_;
270              
271 0 0         if (($proto_version & PATCH_MASK) < $patch) {
272 0           $error = -5;
273             } else {
274 0           $error = 0;
275             }
276              
277 0           return $error;
278             }
279              
280             sub version_before($) {
281 0     0 0   my ($version) = @_;
282              
283 0 0         if ($proto_version < $version) {
284 0           $error = -5;
285             } else {
286 0           $error = 0;
287             }
288              
289 0           return $error;
290             }
291              
292             sub vendor_not($) {
293 0     0 0   my ($vendor) = @_;
294              
295 0 0         if ($mount_vendor == $vendor) {
296 0           $error = 0;
297             } else {
298 0           $error = -5;
299             }
300              
301 0           return $error;
302             }
303              
304             sub vendor_is($) {
305 0     0 0   my ($vendor) = @_;
306              
307 0 0         if ($mount_vendor == $vendor) {
308 0           return 1;
309             } else {
310 0           return 0;
311             }
312             }
313              
314             =head1 TELESCOPE COMMUNICATION
315              
316             =over 8
317              
318             =item open_telescope_port(port_name)
319              
320             Opens a communication port to the telescope by name (like "/dev/ttyUSB0") and
321             returns it to be used in other functions. If the port_name has "tcp://" prefix
322             the rest of the string is interpreted as an IP address and port where to connect to
323             (like "tcp://localhost:9999"). In case of error undef is returned.
324              
325             NOTE: To be used with TCP you need to run nexbridge on the remote computer.
326              
327             =cut
328             sub open_telescope_port($) {
329 0     0 1   my ($portname) = @_;
330              
331 0           my $port;
332              
333 0 0         if ($portname =~ /^tcp:\/\//) {
334 0           $portname =~ s/^tcp:\/\///;
335 0           $is_tcp=1;
336             } else {
337 0           $is_tcp=0;
338             }
339              
340 0 0         if ($is_tcp) {
341 0 0         my $port = new IO::Socket::INET(
342             PeerHost => $portname,
343             Proto => 'tcp'
344             ) or return undef;
345 0           return $port;
346             }
347              
348 0 0         if ($^O eq "MSWin32") {
349 0           $port = new Win32::SerialPort($portname);
350             } else {
351 0           $port = new Device::SerialPort($portname);
352             }
353 0 0         if (! defined $port) {return undef;}
  0            
354             #$port->debug(1);
355 0           $port->baudrate(9600);
356 0           $port->parity("none");
357 0           $port->databits(8);
358 0           $port->stopbits(1);
359 0           $port->datatype('raw');
360 0           $port->write_settings;
361 0           $port->read_char_time(0); # don't wait for each character
362 0           $port->read_const_time(TIMEOUT*1000);
363              
364 0           $mount_vendor = guess_mount_vendor($port);
365 0 0         if (! defined $mount_vendor) {
366 0           $port->close();
367 0           return undef;
368             }
369              
370 0           return $port;
371             }
372              
373              
374             # For internal library use only!
375             sub read_byte($) {
376 0     0 0   my ($port) = @_;
377              
378 0           my ($byte, $count, $char);
379              
380 0 0         if ($is_tcp == 0) {
381 0           ($count,$char)=$port->read(1);
382             } else {
383 0           eval {
384 0     0     local $SIG{ALRM} = sub { die "TimeOut" };
  0            
385 0           alarm TIMEOUT;
386 0           $count=$port->read($char,1);
387 0           alarm 0;
388             };
389 0 0 0       if ($@ and $@ !~ /TimeOut/) {
390 0           return undef;
391             }
392             }
393 0           return ($count,$char);
394             }
395              
396              
397             =item read_telescope(port, len)
398             =item read_telescope(port, len , vl)
399              
400             Reads data from the telescope. On error or in case less than len bytes are read undef is returned.
401             If "vl" is true the function will return success if "#" is read before the len bytes are read.
402              
403             =cut
404             sub read_telescope {
405 0     0 1   my ($port,$len,$vl) = @_;
406 0           my $response;
407             my $char;
408 0           my $count;
409 0           my $total=0;
410 0           do {
411 0           ($count,$char)=read_byte($port);
412 0 0         if ($count == 0) { return undef; }
  0            
413 0           $total += $count;
414 0           $response .= $char;
415 0 0 0       if (($vl) and ($char eq "#")) {
416 0           return $response;
417             }
418             } while ($total < $len);
419              
420             # if the last byte is not '#', this means that the device did
421             # not respond and the next byte should be '#' (hopefully)
422 0 0         if ($char ne "#") {
423 0           ($count,$char)=read_byte($port);
424 0           return undef;
425             }
426 0           return $response;
427             }
428              
429             =item write_telescope(port, data)
430              
431             Writes data to the telescope and the result of write is returned.
432              
433             =cut
434             sub write_telescope($$) {
435 0     0 1   my ($port, $data) = @_;
436              
437 0           return $port->write($data);
438             }
439              
440             =item close_telescope_port(port)
441              
442             Closes the communication port to the telescope.
443              
444             =cut
445              
446             sub close_telescope_port($) {
447 0     0 1   my ($port) = @_;
448              
449 0           $port->close;
450 0           undef $port;
451             }
452              
453             =item enforce_protocol_version(port, ver)
454              
455             Enforce protocol minimal version checking. If a specific command is not supported by the firmware version given
456             in ver, the corresponding tc_*() call will fail as unsupported and return undef (in this case $NexStarCtl::error
457             will be set to -5). If version is VER_AUX, version enforcement
458             is disabled and all commands are enabled but some may fail, because they may not be supported by the current hand controller
459             firmware. To avoid this use VER_AUTO (or omit it) to set the version to the value reported by the currently connected hand
460             controller. By default protocol version enforcement is disabled and the unsupported commands will either timeout
461             or return erratic results. Because of this, calling enforce_protocol_version() with VER_AUTO or no ver parameter right after
462             open_telescope_port() is highly recommended. The predefined versions are: VER_1_2, VER_1_6, VER_2_2, VER_2_3, VER_3_1, VER_4_10 and VER_4_37_8.
463              
464             NOTE: The non-documented (AUX) commands are available only when the enforcement is disabled.
465              
466             =cut
467              
468             sub enforce_protocol_version {
469 0     0 1   my ($port, $ver) = @_;
470              
471 0 0 0       if ((defined $ver) and ($ver != 0)) {
472 0           $proto_version = $ver;
473 0           return 1;
474             }
475 0           my ($major,$minor,$subminor) = tc_get_version($port);
476 0 0         if (!defined $major) { return undef; }
  0            
477 0           $proto_version = ($major << 16) + ($minor << 8) + $subminor;
478 0           return 1;
479             }
480              
481             =item guess_mount_vendor(port)
482              
483             This function guesses the manufacturer of the mount by a slight difference in the protocol. The firmware version command returns 2 bytes for Celestron mounts and 6 bytes for SkyWatcher mounts (since version 4.37.8). On success the guessed value is returned (VNDR_CELESTRON or VNDR_SKYWATCHER). On error undef is returned.
484              
485             NOTE: SkyWather mounts with firmware before 4.37.8 will be threated as Celestron in this case enforce_vendor_protocol() can be used.
486             =cut
487              
488             sub guess_mount_vendor {
489 0     0 1   my ($port) = @_;
490 0 0         return undef if version_before(VER_1_2);
491              
492 0           $port->write("V");
493 0           my $response = read_telescope($port, 7, 1);
494              
495 0 0         return undef unless (defined $response);
496              
497 0 0         if (length($response) == 3) {
    0          
498 0           return VNDR_CELESTRON;
499             } elsif (length($response) == 7) {
500 0           return VNDR_SKYWATCHER;
501             } else {
502 0           return undef;
503             }
504             }
505              
506             =item enforce_vendor_protocol(vendor)
507              
508             This function enforces protocol of the specified vendor to be used overriding the guessed one.
509             Valid vendor IDs are VNDR_CELESTRON and VNDR_SKYWATCHER. This way the commands not supported
510             by the vendor version of the protocol will fail and $NexStarCtl::error will be set to -5.
511             On success the vendor ID is returned otherwise it returns undef.
512              
513             =cut
514              
515             sub enforce_vendor_protocol($) {
516 0     0 1   my ($vendor) = @_;
517              
518 0 0         if (!(VNDR_ALL_SUPPORTED & $vendor)) {
519 0           return undef;
520             }
521              
522 0           $mount_vendor = $vendor;
523             }
524              
525             #
526             # Telescope Commands
527             #
528              
529             =back
530              
531             =head1 TELESCOPE COMMANDS
532              
533             =over 8
534              
535             =item tc_check_align(port)
536              
537             If the telescope is aligned 1 is returned else 0 is returned. If no response received,
538             undef is returned.
539              
540             =cut
541             sub tc_check_align($) {
542 0     0 1   my ($port) = @_;
543              
544 0 0         return undef if version_before(VER_1_2);
545              
546 0           $port->write("J");
547 0           my $response = read_telescope($port,2);
548 0 0         if (defined $response) {
549 0           return ord(substr($response, 0, 1));
550             } else {
551 0           return undef;
552             }
553             }
554              
555             =item tc_get_orientation(port)
556              
557             Get the telescope orientation. "E" or "W" is returned for East and West respectively. If no response received,
558             undef is returned.
559              
560             =cut
561             sub tc_get_orientation($) {
562 0     0 1   my ($port) = @_;
563              
564 0 0         return undef if vendor_not(VNDR_SKYWATCHER);
565 0 0         return undef if release_before(3);
566 0 0         return undef if revision_before(37);
567              
568 0           $port->write("p");
569 0           my $response = read_telescope($port,2);
570 0 0         if (defined $response) {
571 0           return substr($response, 0, 1);
572             } else {
573 0           return undef;
574             }
575             }
576              
577             =item tc_goto_rade(port, ra, de)
578              
579             =item tc_goto_rade_p(port, ra, de)
580              
581             Slew the telescope to RA/DEC coordinates ra, de (in decimal degrees).
582             Function tc_goto_rade_p uses precise GOTO.
583             If RA is not in [0;360] function returns -1. If DEC is not in [-90;90] -2 is returned.
584             If no response received, undef is returned.
585              
586             =cut
587             sub tc_goto_rade {
588 0     0 1   my ($port, $ra, $de, $precise) = @_;
589 0 0 0       if (($ra < 0) or ($ra > 360)) {
590 0           return -1;
591             }
592 0 0 0       if (($de < -90) or ($de > 90)) {
593 0           return -2;
594             }
595 0           my $nex;
596 0 0 0       if((defined $precise) and ($precise =! 0)) {
597 0 0         return undef if version_before(VER_1_6);
598 0           $nex=dd2pnex($ra, $de);
599 0           $port->write("r".$nex);
600             } else {
601 0 0         return undef if version_before(VER_1_2);
602 0           $nex=dd2nex($ra, $de);
603 0           $port->write("R".$nex);
604             }
605 0           my $response = read_telescope($port,1);
606 0 0         if (defined $response) {
607 0           return 1;
608             } else {
609 0           return undef;
610             }
611             }
612              
613             sub tc_goto_rade_p {
614 0     0 1   return tc_goto_rade(@_, 1);
615             }
616              
617             =item tc_goto_azalt(port, az, alt)
618              
619             =item tc_goto_azalt_p(port, az, alt)
620              
621             Slew the telescope to AZ/ALT coordinates az, alt (in decimal degrees). Function tc_goto_azalt_p uses precise GOTO.
622             If AZ is not in [0;360] function returns -1. If ALT is not in [-90;90] -2 is returned.
623             If no response received, undef is returned.
624              
625             =cut
626             sub tc_goto_azalt {
627 0     0 1   my ($port, $az, $alt, $precise) = @_;
628 0 0 0       if (($az < 0) or ($az > 360)) {
629 0           return -1;
630             }
631 0 0 0       if (($alt < -90) or ($alt > 90)) {
632 0           return -2;
633             }
634 0           my $nex;
635 0 0 0       if((defined $precise) and ($precise =! 0)) {
636 0 0         return undef if version_before(VER_2_2);
637 0           $nex=dd2pnex($az, $alt);
638 0           $port->write("b".$nex);
639             } else {
640 0 0         return undef if version_before(VER_1_2);
641 0           $nex=dd2nex($az, $alt);
642 0           $port->write("B".$nex);
643             }
644 0           my $response = read_telescope($port,1);
645 0 0         if (defined $response) {
646 0           return 1;
647             } else {
648 0           return undef;
649             }
650             }
651              
652             sub tc_goto_azalt_p {
653 0     0 1   return tc_goto_azalt(@_, 1);
654             }
655              
656             =item tc_get_rade(port)
657              
658             =item tc_get_rade_p(port)
659              
660             Returns the the current telescope RA/DEC coordinates ra, de (in decimal degrees). Function
661             tc_get_rade_p uses precise GET. If no response received, undef is returned.
662              
663             =cut
664             sub tc_get_rade {
665 0     0 1   my ($port, $precise) = @_;
666            
667 0           my $ra;
668             my $de;
669            
670 0 0 0       if((defined $precise) and ($precise =! 0)) {
671 0 0         return undef if version_before(VER_1_6);
672 0           $port->write("e");
673 0           my $response = read_telescope($port, 18);
674 0 0         if (! defined $response) {
675 0           return undef;
676             }
677 0           ($ra,$de) = pnex2dd($response);
678             } else {
679 0 0         return undef if version_before(VER_1_2);
680 0           $port->write("E");
681 0           my $response = read_telescope($port, 10);
682 0 0         if (! defined $response) {
683 0           return undef;
684             }
685 0           ($ra,$de) = nex2dd($response);
686             }
687            
688 0           return ($ra, $de);
689             }
690              
691             sub tc_get_rade_p {
692 0     0 1   return tc_get_rade(@_, 1);
693             }
694              
695             =item tc_get_azalt(port)
696              
697             =item tc_get_azalt_p(port)
698              
699             Returns the the currents telescope AZ/ALT coordinates az, alt (in decimal degrees). Function
700             tc_get_azalt_p uses precise GET. If no response received, undef is returned.
701              
702             =cut
703             sub tc_get_azalt {
704 0     0 1   my ($port, $precise) = @_;
705            
706 0           my $az;
707             my $alt;
708            
709 0 0 0       if((defined $precise) and ($precise =! 0)) {
710 0 0         return undef if version_before(VER_2_2);
711 0           $port->write("z");
712 0           my $response = read_telescope($port, 18);
713 0 0         if (! defined $response) {
714 0           return undef;
715             }
716 0           ($az,$alt) = pnex2dd($response);
717             } else {
718 0 0         return undef if version_before(VER_1_2);
719 0           $port->write("Z");
720 0           my $response = read_telescope($port, 10);
721 0 0         if (! defined $response) {
722 0           return undef;
723             }
724 0           ($az,$alt) = nex2dd($response);
725             }
726            
727 0           return ($az, $alt);
728             }
729              
730             sub tc_get_azalt_p {
731 0     0 1   return tc_get_azalt(@_, 1);
732             }
733              
734             =item tc_sync_rade(port, ra, de)
735              
736             =item tc_sync_rade_p(port, ra, de)
737              
738             Syncs the telescope to RA/DEC coordinates ra, de (in decimal degrees). Function tc_sync_rade_p uses precise sync.
739             If RA is not in [0;360] function returns -1. If DEC is not in [-90;90] -2 is returned.
740             If no response received, undef is returned.
741              
742             =cut
743             sub tc_sync_rade {
744 0     0 1   my ($port, $ra, $de, $precise) = @_;
745              
746 0 0         if(vendor_is(VNDR_SKYWATCHER)) {
747 0 0         return undef if release_before(3);
748 0 0         return undef if revision_before(37);
749             } else {
750 0 0         return undef if version_before(VER_4_10);
751             }
752              
753 0 0 0       if (($ra < 0) or ($ra > 360)) {
754 0           return -1;
755             }
756 0 0 0       if (($de < -90) or ($de > 90)) {
757 0           return -2;
758             }
759 0           my $nex;
760 0 0 0       if((defined $precise) and ($precise =! 0)) {
761 0           $nex=dd2pnex($ra, $de);
762 0           $port->write("s".$nex);
763             } else {
764 0           $nex=dd2nex($ra, $de);
765 0           $port->write("S".$nex);
766             }
767 0           my $response = read_telescope($port, 1);
768 0 0         if (defined $response) {
769 0           return 1;
770             } else {
771 0           return undef;
772             }
773             }
774              
775             sub tc_sync_rade_p {
776 0     0 1   return tc_sync_rade(@_, 1);
777             }
778              
779             =item tc_goto_in_progress(port)
780              
781             Returns 1 if GOTO is in progress else 0 is returned. If no response received, undef is returned.
782              
783             =cut
784             sub tc_goto_in_progress($) {
785 0     0 1   my ($port) = @_;
786              
787 0 0         return undef if version_before(VER_1_2);
788              
789 0           $port->write("L");
790 0           my $response = read_telescope($port, 2);
791 0 0         if (defined $response) {
792 0           return substr($response, 0, 1);
793             } else {
794 0           return undef;
795             }
796             }
797              
798             =item tc_goto_cancel(port)
799              
800             Cancels the GOTO operation. On success 1 is returned. If no response received, undef is returned.
801              
802             =cut
803             sub tc_goto_cancel($) {
804 0     0 1   my ($port) = @_;
805              
806 0 0         return undef if version_before(VER_1_2);
807            
808 0           $port->write("M");
809 0           my $response = read_telescope($port, 1);
810 0 0         if (defined $response) {
811 0           return 1;
812             } else {
813 0           return undef;
814             }
815             }
816              
817             =item tc_echo(port, char)
818              
819             Checks the communication with the telescope. This function sends char to the telescope and
820             returns the echo received. If no response received, undef is returned.
821              
822             =cut
823             sub tc_echo($$) {
824 0     0 1   my ($port, $char) = @_;
825              
826 0 0         return undef if version_before(VER_1_2);
827              
828 0           $port->write("K".substr($char, 0, 1));
829 0           my $response = read_telescope($port, 2);
830 0 0         if (defined $response) {
831 0           return substr($response, 0, 1);
832             } else {
833 0           return undef;
834             }
835             }
836              
837             =item tc_get_model(port)
838              
839             This function returns the mount model as a number. See CELESTRON documentation.
840             If no response received, undef is returned.
841              
842             =cut
843             sub tc_get_model($) {
844 0     0 1   my ($port) = @_;
845              
846 0 0         return undef if version_before(VER_2_2);
847              
848 0           $port->write("m");
849 0           my $response = read_telescope($port, 2);
850 0 0         if (defined $response) {
851 0           return ord(substr($response, 0, 1));
852             } else {
853 0           return undef;
854             }
855             }
856              
857             =item tc_get_version(port)
858              
859             This function returns the mount version as a strng or as major and minor numbers in array context See CELESTRON documentation.
860             If no response received, undef is returned.
861              
862             =cut
863             sub tc_get_version($) {
864 0     0 1   my ($port) = @_;
865              
866 0 0         return undef if version_before(VER_1_2);
867              
868 0           $port->write("V");
869 0           my $response = read_telescope($port, 7, 1);
870 0 0         if (defined $response) {
871 0 0         if (length($response) == 3) {
    0          
872 0 0         return wantarray ? (ord(substr($response, 0, 1)),ord(substr($response, 1, 1)))
873             : ord(substr($response, 0, 1)).".".ord(substr($response, 1, 1));
874             } elsif (length($response) == 7) {
875 0 0         return wantarray ? (hex(substr($response, 0, 2)),hex(substr($response, 2, 2)),hex(substr($response, 4, 2)))
876             : hex(substr($response, 0, 2)).".".hex(substr($response, 2, 2)).".".hex(substr($response, 4, 2));
877             }
878             }
879              
880 0           return undef;
881             }
882              
883              
884             =item tc_get_location(port)
885              
886             This function returns the stored location coordinates lon, lat in decimal degrees.
887             Negative longitude is WEST. Negative latitude is SOUTH.
888             If no response received, undef is returned.
889              
890             =item tc_get_location_str(port)
891              
892             This function returns the stored location coordinates lon and lat as strings.
893             If no response received, undef is returned.
894              
895             =cut
896             sub tc_get_location {
897 0     0 1   my ($port,$str) = @_;
898              
899 0 0         return undef if version_before(VER_2_3);
900              
901 0           $port->write("w");
902 0           my $response = read_telescope($port, 9);
903 0 0         if (! defined $response) {
904 0           return undef;
905             }
906            
907 0           my $latd=ord(substr($response, 0, 1));
908 0           my $latm=ord(substr($response, 1, 1));
909 0           my $lats=ord(substr($response, 2, 1));
910 0           my $lato=ord(substr($response, 3, 1));
911 0           my $lond=ord(substr($response, 4, 1));
912 0           my $lonm=ord(substr($response, 5, 1));
913 0           my $lons=ord(substr($response, 6, 1));
914 0           my $lono=ord(substr($response, 7, 1));
915              
916 0           my $lon;
917             my $lat;
918 0 0 0       if((defined $str) and ($str =! 0)) {
919 0           $lat=sprintf("%d %02d'%02d\"N",$latd,$latm,$lats);
920 0           $lon=sprintf("%d %02d'%02d\"E",$lond,$lonm,$lons);
921 0 0         if ($lato) {
922 0           $lat =~ s/N$/S/;
923             }
924 0 0         if ($lono) {
925 0           $lon =~ s/E$/W/;
926             }
927             } else {
928 0           $lat=($latd + $latm/60.0 + $lats/3600.0);
929 0           $lon=($lond + $lonm/60.0 + $lons/3600.0);
930 0 0         if ($lato) {
931 0           $lat *= -1;
932             }
933 0 0         if ($lono) {
934 0           $lon *= -1;
935             }
936             }
937 0           return ($lon, $lat);
938             }
939              
940             sub tc_get_location_str {
941 0     0 1   return tc_get_location(@_, 1);
942             }
943              
944             =item tc_set_location(port,lon,lat)
945              
946             This function sets the location coordinates lon, lat in decimal degrees.
947             Negative longitude is WEST. Negative latitude is SOUTH.
948             If the coordinates are invalid -1 is returned.
949             If no response received, undef is returned.
950              
951             =cut
952             sub tc_set_location {
953 0     0 1   my ($port,$lon,$lat) = @_;
954 0           my $issouth = 0;
955 0           my $iswest = 0;
956              
957 0 0         return undef if version_before(VER_2_3);
958            
959 0 0         if ($lon < 0) {
960 0           $lon *= -1;
961 0           $iswest = 1;
962             }
963 0 0         if ($lat < 0) {
964 0           $lat *= -1;
965 0           $issouth = 1;
966             }
967              
968 0 0 0       if (($lat > 90) or ($lon > 180)) {
969 0           return -1;
970             }
971            
972 0           my ($lond,$lonm,$lons) = d2dms2($lon);
973 0           my ($latd,$latm,$lats) = d2dms2($lat);
974              
975 0           $port->write("W");
976 0           $port->write(chr($latd));
977 0           $port->write(chr($latm));
978 0           $port->write(chr($lats));
979 0           $port->write(chr($issouth));
980 0           $port->write(chr($lond));
981 0           $port->write(chr($lonm));
982 0           $port->write(chr($lons));
983 0           $port->write(chr($iswest));
984              
985 0           my $response = read_telescope($port, 1);
986 0 0         if (defined $response) {
987 0           return 1;
988             } else {
989 0           return undef;
990             }
991             }
992              
993             =item tc_get_time(port)
994              
995             This function returns the stored time (in Unix time format), timezone (in hours) and daylight saving time(0|1).
996             If no response received, undef is returned.
997              
998             =item tc_get_time_str(port)
999              
1000             This function returns the stored date, time (as strings), timezone (in hours) and daylight saving time(0|1).
1001             If no response received, undef is returned.
1002              
1003             =cut
1004              
1005             sub tc_get_time {
1006 0     0 1   my ($port,$str) = @_;
1007              
1008 0 0         return undef if version_before(VER_2_3);
1009              
1010 0           $port->write("h");
1011 0           my $response = read_telescope($port, 9);
1012 0 0         if (! defined $response) {
1013 0           return undef;
1014             }
1015            
1016 0           my $h=ord(substr($response, 0, 1));
1017 0           my $m=ord(substr($response, 1, 1));
1018 0           my $s=ord(substr($response, 2, 1));
1019 0           my $mon=ord(substr($response, 3, 1));
1020 0           my $day=ord(substr($response, 4, 1));
1021 0           my $year=ord(substr($response, 5, 1))+2000;
1022 0           my $tz=ord(substr($response, 6, 1));
1023 0 0         $tz -= 256 if ($tz > 12);
1024 0           my $dst=ord(substr($response, 7, 1));
1025            
1026 0 0 0       if((defined $str) and ($str =! 0)) {
1027 0           my $time=sprintf("%2d:%02d:%02d",$h,$m,$s);
1028 0           my $date=sprintf("%02d-%02d-%04d",$day,$mon,$year);
1029 0           return ($date,$time, $tz, $dst);
1030             } else {
1031 0           my $time = timelocal($s,$m,$h,$day,$mon-1,$year);
1032 0           return ($time, $tz, $dst);
1033             }
1034             }
1035              
1036             sub tc_get_time_str {
1037 0     0 1   return tc_get_time(@_, 1);
1038             }
1039              
1040             =item tc_set_time(port, time, timezone, daylightsaving)
1041              
1042             This function sets the time (in Unix time format), timezone (in hours) and daylight saving time(0|1).
1043             On success 1 is returned.
1044             If no response received, undef is returned. If the mount is known to have RTC
1045             (currently only CGE and AdvancedVX) and NexStarCtl::use_rtc is defined and != 0 (default is 0), the date/time is
1046             set to the RTC too.
1047              
1048             NOTE: Do not set NexStarCtl::use_rtc if the mount is SkyWatcher otherwise tc_set_time() may fail.
1049              
1050             =cut
1051             sub tc_set_time {
1052 0     0 1   my ($port, $time, $tz, $dst) = @_;
1053              
1054 0 0         return undef if version_before(VER_2_3);
1055              
1056 0           my $timezone = $tz;
1057 0 0         $tz += 256 if ($tz < 0);
1058              
1059 0 0 0       if ((defined $dst) and ($dst != 0)) {
1060 0           $dst=1;
1061             } else {
1062 0           $dst=0;
1063             }
1064              
1065 0           my ($s,$m,$h,$day,$mon,$year,$wday,$yday,$isdst) = localtime($time);
1066              
1067 0           $port->write("H");
1068 0           $port->write(chr($h));
1069 0           $port->write(chr($m));
1070 0           $port->write(chr($s));
1071 0           $port->write(chr($mon+1));
1072 0           $port->write(chr($day));
1073             # $year is actual_year-1900
1074             # here is required actual_year-2000
1075             # so we need $year-100
1076 0           $port->write(chr($year-100));
1077 0           $port->write(chr($tz));
1078 0           $port->write(chr($dst));
1079              
1080 0           my $response = read_telescope($port, 1);
1081 0 0         if (! defined $response) {
1082 0           return undef;
1083             }
1084              
1085             # return success if the RTC is not used
1086 0 0 0       if (($use_rtc == 0) or ($use_rtc == undef)) {
1087 0           return 1;
1088             }
1089              
1090 0           my $model = tc_get_model($port);
1091             # If the mount has RTC set date/time to RTC too
1092             # I only know CGE(5) and AdvancedVX(20) to have RTC
1093 0 0 0       if (($model == 5) or ($model == 20)) {
1094             # RTC expects UT, convert localtime to UT
1095 0           my ($s,$m,$h,$day,$mon,$year,$wday,$yday,$isdst) = localtime($time - (($timezone + $dst) * 3600));
1096              
1097             # Set year
1098 0           my $response = tc_pass_through_cmd($port, 3, 178, 132,
1099             int(($year + 1900) / 256),
1100             int(($year + 1900) % 256), 0, 0);
1101 0 0         if (! defined $response) {
1102 0           return undef;
1103             }
1104              
1105             # Set month and day
1106 0           my $response = tc_pass_through_cmd($port, 3, 178, 131, $mon+1, $day, 0, 0);
1107 0 0         if (! defined $response) {
1108 0           return undef;
1109             }
1110              
1111             # Set time
1112 0           my $response = tc_pass_through_cmd($port, 4, 178, 179, $h, $m, $s, 0);
1113 0 0         if (! defined $response) {
1114 0           return undef;
1115             }
1116             }
1117 0           return 1;
1118             }
1119              
1120             =item tc_get_tracking_mode(port)
1121              
1122             Reads the tracking mode of the mount and returns one of the folowing:
1123             TC_TRACK_OFF, TC_TRACK_ALT_AZ, TC_TRACK_EQ_NORTH (Celestron only), TC_TRACK_EQ_SOUTH (Celestron only),
1124             TC_TRACK_EQ (SkyWatcher only) and TC_TRACK_EQ_PEC (Sky-Watcher only).
1125             If no response received, undef is returned.
1126              
1127             =cut
1128             sub tc_get_tracking_mode($) {
1129 0     0 1   my ($port) = @_;
1130 0           my $mode;
1131              
1132 0 0         return undef if version_before(VER_2_3);
1133              
1134 0           $port->write("t");
1135 0           my $response = read_telescope($port, 2);
1136 0 0         if (defined $response) {
1137 0           $mode = ord(substr($response, 0, 1));
1138             } else {
1139 0           return undef;
1140             }
1141              
1142             # Sky-Watcher mount
1143 0 0         if(vendor_is(VNDR_SKYWATCHER)) {
1144 0 0         if ($mode == SW_TC_TRACK_OFF) {
    0          
    0          
    0          
1145 0           return TC_TRACK_OFF;
1146              
1147             } elsif ($mode == SW_TC_TRACK_ALT_AZ) {
1148 0           return TC_TRACK_ALT_AZ;
1149              
1150             } elsif ($mode == SW_TC_TRACK_EQ) {
1151 0           return TC_TRACK_EQ;
1152              
1153             } elsif ($mode == SW_TC_TRACK_EQ_PEC) {
1154 0           return TC_TRACK_EQ_PEC;
1155             }
1156             # Celestron mount
1157             } else {
1158 0 0         if ($mode == NX_TC_TRACK_OFF) {
    0          
    0          
    0          
1159 0           return TC_TRACK_OFF;
1160              
1161             } elsif ($mode == NX_TC_TRACK_ALT_AZ) {
1162 0           return TC_TRACK_ALT_AZ;
1163              
1164             } elsif ($mode == NX_TC_TRACK_EQ_NORTH) {
1165 0           return TC_TRACK_EQ_NORTH;
1166              
1167             } elsif ($mode == NX_TC_TRACK_EQ_SOUTH) {
1168 0           return TC_TRACK_EQ_SOUTH;
1169             }
1170             }
1171 0           return undef;
1172             }
1173              
1174             =item tc_set_tracking_mode(port, mode)
1175              
1176             Sets the tracking mode of the mount to one of the folowing:
1177             TC_TRACK_OFF, TC_TRACK_ALT_AZ, TC_TRACK_EQ_NORTH, TC_TRACK_EQ_SOUTH, TC_TRACK_EQ and TC_TRACK_EQ_PEC.
1178             For Sky-Watcher TC_TRACK_EQ_NORTH, TC_TRACK_EQ_SOUTH and TC_TRACK_EQ do the same thing. For Celestron
1179             TC_TRACK_EQ is interpreted as TC_TRACK_EQ_NORTH or TC_TRACK_EQ_SOUTH depending on the geographic latitude
1180             of the location (Northern or Southern hemisphere). If the mode is not one of the listed -1 is returned.
1181             If no response received, undef is returned.
1182              
1183             =cut
1184             sub tc_set_tracking_mode($$) {
1185 0     0 1   my ($port,$mode) = @_;
1186 0           my $_mode;
1187              
1188 0 0         return undef if version_before(VER_1_6);
1189              
1190             # Sky-Watcher mount
1191 0 0         if(vendor_is(VNDR_SKYWATCHER)) {
1192 0 0 0       if ($mode == TC_TRACK_OFF) {
    0 0        
    0          
    0          
1193 0           $_mode = TC_TRACK_OFF;
1194              
1195             } elsif ($mode == TC_TRACK_ALT_AZ) {
1196 0           $_mode = SW_TC_TRACK_ALT_AZ;
1197              
1198             } elsif (($mode == TC_TRACK_EQ) or
1199             ($mode == TC_TRACK_EQ_NORTH) or
1200             ($mode == TC_TRACK_EQ_SOUTH)) {
1201 0           $_mode = SW_TC_TRACK_EQ;
1202              
1203             } elsif ($mode == TC_TRACK_EQ_PEC) {
1204 0           $_mode = SW_TC_TRACK_EQ_PEC;
1205              
1206             } else {
1207 0           return -1;
1208             }
1209              
1210             # Celestron mount
1211             } else {
1212 0 0         if ($mode == TC_TRACK_OFF) {
    0          
    0          
    0          
    0          
    0          
1213 0           $_mode = NX_TC_TRACK_OFF;
1214              
1215             } elsif ($mode == TC_TRACK_ALT_AZ) {
1216 0           $_mode = NX_TC_TRACK_ALT_AZ;
1217              
1218             } elsif ($mode == TC_TRACK_EQ_NORTH) {
1219 0           $_mode = NX_TC_TRACK_EQ_NORTH;
1220              
1221             } elsif ($mode == TC_TRACK_EQ_SOUTH) {
1222 0           $_mode = NX_TC_TRACK_EQ_SOUTH;
1223              
1224             } elsif ($mode == TC_TRACK_EQ) {
1225 0           my (undef, $lat) = tc_get_location($port);
1226 0 0         if (!defined $lat) {
1227 0           return -1;
1228             }
1229 0 0         if ($lat < 0) {
1230 0           $_mode = NX_TC_TRACK_EQ_SOUTH;
1231             } else {
1232 0           $_mode = NX_TC_TRACK_EQ_NORTH;
1233             }
1234              
1235             } elsif ($mode == TC_TRACK_EQ_PEC) {
1236             # unsupported on Celestron
1237 0           $error = -5;
1238 0           return undef;
1239              
1240             } else {
1241 0           return -1;
1242             }
1243             }
1244              
1245 0           $port->write("T");
1246 0           $port->write(chr($_mode));
1247 0           my $response = read_telescope($port, 1);
1248 0 0         if (defined $response) {
1249 0           return 1;
1250             } else {
1251 0           return undef;
1252             }
1253             }
1254              
1255             =item tc_slew_fixed(port, axis, direction, rate)
1256              
1257             Move the telescope the telescope around a specified axis in a given direction with fixed rate.
1258              
1259             Accepted values for axis are TC_AXIS_RA_AZM and TC_AXIS_DE_ALT. Direction can accept values
1260             TC_DIR_POSITIVE and TC_DIR_NEGATIVE. Rate is from 0 to 9. Where 0 stops slewing and 9 is
1261             the fastest speed.
1262              
1263             On success 1 is returned. If rate is out of range -1 is returned.
1264             If no response received, undef is returned.
1265              
1266             =cut
1267             sub tc_slew_fixed {
1268 0     0 1   my ($port,$axis,$direction,$rate) = @_;
1269              
1270 0 0         if(vendor_is(VNDR_SKYWATCHER)) {
1271 0 0         return undef if release_before(3);
1272 0 0         return undef if revision_before(1);
1273             } else {
1274 0 0         return undef if version_before(VER_1_6);
1275             }
1276            
1277 0 0         if ($axis>0) {
1278 0           $axis = _TC_AXIS_RA_AZM;
1279             } else {
1280 0           $axis = _TC_AXIS_DE_ALT;
1281             }
1282              
1283 0 0         if ($direction > 0) {
1284 0           $direction = _TC_DIR_POSITIVE + 30;
1285             } else {
1286 0           $direction = _TC_DIR_NEGATIVE + 30;
1287             }
1288            
1289 0 0 0       if (($rate < 0) or ($rate > 9)) {
1290 0           return -1;
1291             }
1292 0           $rate = int($rate);
1293              
1294 0           my $response = tc_pass_through_cmd($port, 2, $axis, $direction, $rate, 0, 0, 0);
1295 0 0         if (defined $response) {
1296 0           return 1;
1297             } else {
1298 0           return undef;
1299             }
1300             }
1301              
1302             =item tc_slew_variable(port, axis, direction, rate)
1303              
1304             Move the telescope the telescope around a specified axis in a given direction with specified rate.
1305              
1306             Accepted values for axis are TC_AXIS_RA_AZM and TC_AXIS_DE_ALT. Direction can accept values
1307             TC_DIR_POSITIVE and TC_DIR_NEGATIVE. Rate is the speed in arcsec/sec. For example 3600
1308             represents 1degree/sec.
1309              
1310             On success 1 is returned. If no response received, undef is returned.
1311              
1312             =cut
1313             sub tc_slew_variable {
1314 0     0 1   my ($port,$axis,$direction,$rate) = @_;
1315              
1316 0 0         if(vendor_is(VNDR_SKYWATCHER)) {
1317 0 0         return undef if release_before(3);
1318 0 0         return undef if revision_before(1);
1319             } else {
1320 0 0         return undef if version_before(VER_1_6);
1321             }
1322              
1323 0 0         if ($axis>0) {
1324 0           $axis = _TC_AXIS_RA_AZM;
1325             } else {
1326 0           $axis = _TC_AXIS_DE_ALT;
1327             }
1328              
1329 0 0         if ($direction > 0) {
1330 0           $direction = _TC_DIR_POSITIVE;
1331             } else {
1332 0           $direction = _TC_DIR_NEGATIVE;
1333             }
1334            
1335 0           $rate = int(4*$rate);
1336 0           my $rateH = int($rate / 256);
1337 0           my $rateL = $rate % 256;
1338             #print "RATEf : $rateH $rateL\n";
1339              
1340 0           my $response = tc_pass_through_cmd($port, 3, $axis, $direction, $rateH, $rateL, 0, 0);
1341 0 0         if (defined $response) {
1342 0           return 1;
1343             } else {
1344 0           return undef;
1345             }
1346             }
1347              
1348             =item get_model_name(model_id)
1349              
1350             Return the name of the mount by the id from tc_get_model().
1351             If the mount is not known undef is returned.
1352              
1353             =cut
1354              
1355             sub get_model_name($) {
1356 0     0 1   my ($model_id) = @_;
1357 0           return $mounts{$mount_vendor}{$model_id};
1358             }
1359              
1360             =back
1361              
1362             =head1 AUX COMMANDS
1363              
1364             The following commands are not officially documented by Celestron. Please note that these
1365             commands are reverse engineered and may not work exactly as expected.
1366              
1367             =over 8
1368              
1369             =item tc_get_autoguide_rate(port, axis)
1370              
1371             Get autoguide rate for the given axis in percents of the sidereal rate.
1372              
1373             Accepted values for axis are TC_AXIS_RA_AZM and TC_AXIS_DE_ALT.
1374              
1375             On success current value of autoguide rate is returned in the range [0-99].
1376             If no response received, undef is returned.
1377             =cut
1378             sub tc_get_autoguide_rate($$) {
1379 0     0 1   my ($port,$axis) = @_;
1380              
1381 0 0         return undef if version_before(VER_AUX);
1382              
1383 0 0         if ($axis > 0) {
1384 0           $axis = _TC_AXIS_RA_AZM;
1385             } else {
1386 0           $axis = _TC_AXIS_DE_ALT;
1387             }
1388              
1389             # Get autoguide rate (0x47)
1390 0           my $response = tc_pass_through_cmd($port, 1, $axis, 0x47, 0, 0, 0, 1);
1391 0 0         if (defined $response) {
1392 0           my $rate = ord(substr($response, 0, 1));
1393 0           return int(100 * $rate / 256);
1394             } else {
1395 0           return undef;
1396             }
1397             }
1398              
1399             =item tc_set_autoguide_rate(port, axis, rate)
1400              
1401             Set autoguide rate for the given axis in percents of the sidereal rate.
1402              
1403             Accepted values for axis are TC_AXIS_RA_AZM and TC_AXIS_DE_ALT.
1404             Rate must be in the range [0-99].
1405              
1406             On success 1 is returned. If rate is out of range -1 is returned.
1407             If no response received, undef is returned.
1408             =cut
1409             sub tc_set_autoguide_rate($$$) {
1410 0     0 1   my ($port,$axis,$rate) = @_;
1411              
1412 0 0         return undef if version_before(VER_AUX);
1413              
1414 0 0         if ($axis > 0) {
1415 0           $axis = _TC_AXIS_RA_AZM;
1416             } else {
1417 0           $axis = _TC_AXIS_DE_ALT;
1418             }
1419              
1420             # $rate should be [0%-99%]
1421 0           my $rate = int($rate);
1422 0 0 0       if (($rate < 0) or ($rate > 99)) {
1423 0           return -1;
1424             }
1425              
1426             # This is wired, but is done to match as good as
1427             # possible the values given by the HC
1428 0           my$rrate;
1429 0 0         if ($rate == 0) {
    0          
1430 0           $rrate = 0;
1431             } elsif ($rate == 99) {
1432 0           $rrate = 255;
1433             } else {
1434 0           $rrate = int((256 * $rate / 100) + 1);
1435             }
1436              
1437             # Set autoguide rate (0x46)
1438 0           my $response = tc_pass_through_cmd($port, 2, $axis, 0x46, $rrate, 0, 0, 0);
1439 0 0         if (defined $response) {
1440 0           return 1;
1441             } else {
1442 0           return undef;
1443             }
1444             }
1445              
1446             =item tc_get_backlash(port, axis, direction)
1447              
1448             Get anti-backlash values for the specified axis in a given direction.
1449              
1450             Accepted values for axis are TC_AXIS_RA_AZM and TC_AXIS_DE_ALT. Direction
1451             can accept values TC_DIR_POSITIVE and TC_DIR_NEGATIVE.
1452              
1453             On success current value of backlash is returned in the range [0-99].
1454             If no response received, undef is returned.
1455             =cut
1456             sub tc_get_backlash($$$) {
1457 0     0 1   my ($port,$axis,$direction) = @_;
1458              
1459 0 0         return undef if vendor_not(VNDR_CELESTRON);
1460 0 0         return undef if version_before(VER_AUX);
1461              
1462 0 0         if ($axis > 0) {
1463 0           $axis = _TC_AXIS_RA_AZM;
1464             } else {
1465 0           $axis = _TC_AXIS_DE_ALT;
1466             }
1467              
1468 0 0         if ($direction > 0) {
1469 0           $direction = 0x40; # Get positive backlash
1470             } else {
1471 0           $direction = 0x41; # Get negative backlash
1472             }
1473              
1474 0           my $response = tc_pass_through_cmd($port, 1, $axis, $direction, 0, 0, 0, 1);
1475 0 0         if (defined $response) {
1476 0           return ord(substr($response, 0, 1));
1477             } else {
1478 0           return undef;
1479             }
1480             }
1481              
1482             =item tc_set_backlash(port, axis, direction, backlash)
1483              
1484             Set anti-backlash values for the specified axis in a given direction.
1485              
1486             Accepted values for axis are TC_AXIS_RA_AZM and TC_AXIS_DE_ALT. Direction can accept
1487             values TC_DIR_POSITIVE and TC_DIR_NEGATIVE. Backlash must be in the range [0-99].
1488              
1489             On success 1 is returned. If backlash is out of range -1 is returned.
1490             If no response received, undef is returned.
1491             =cut
1492             sub tc_set_backlash($$$$) {
1493 0     0 1   my ($port,$axis,$direction,$backlash) = @_;
1494              
1495 0 0         return undef if vendor_not(VNDR_CELESTRON);
1496 0 0         return undef if version_before(VER_AUX);
1497              
1498 0 0         if ($axis > 0) {
1499 0           $axis = _TC_AXIS_RA_AZM;
1500             } else {
1501 0           $axis = _TC_AXIS_DE_ALT;
1502             }
1503              
1504 0 0         if ($direction > 0) {
1505 0           $direction = 0x10; # Set positive backlash
1506             } else {
1507 0           $direction = 0x11; # Set negative backlash
1508             }
1509              
1510 0           my $backlash = int($backlash);
1511 0 0 0       if (($backlash < 0) or ($backlash > 99)) {
1512 0           return -1;
1513             }
1514              
1515 0           my $response = tc_pass_through_cmd($port, 2, $axis, $direction, $backlash, 0, 0, 0);
1516 0 0         if (defined $response) {
1517 0           return 1;
1518             } else {
1519 0           return undef;
1520             }
1521             }
1522              
1523             =item tc_pass_through_cmd(port, msg_len, dest_id, cmd_id, data1, data2, data3, res_len)
1524              
1525             Send a pass through command to a specific device. This function is meant for an internal
1526             library use and should not be used, unless you know exactly what you are doing.
1527             Calling this function with wrong parameters can be dangerous and can break the telescope!
1528              
1529             =cut
1530             sub tc_pass_through_cmd($$$$$$$$) {
1531 0     0 1   my ($port, $msg_len, $dest_id, $cmd_id, $data1, $data2, $data3, $res_len) = @_;
1532              
1533 0           $port->write("P");
1534 0           $port->write(chr($msg_len));
1535 0           $port->write(chr($dest_id));
1536 0           $port->write(chr($cmd_id));
1537 0           $port->write(chr($data1));
1538 0           $port->write(chr($data2));
1539 0           $port->write(chr($data3));
1540 0           $port->write(chr($res_len));
1541              
1542             # we should read $res_len + 1 byes to accomodate '#' at the end
1543 0           return read_telescope($port, $res_len + 1);
1544             }
1545              
1546             =back
1547              
1548             =head1 UTILITY FUNCTIONS
1549              
1550             =over 8
1551              
1552             =item notnum(n)
1553              
1554             If "n" is a real number returns 0 else it returns 1.
1555              
1556             =cut
1557             sub notnum($)
1558 0     0 1   { my ($num) = @_;
1559 0 0         if ($num=~ /^[-+]?\d+\.?\d*$/) {return 0;}
  0            
1560 0           else {return 1;}
1561             }
1562              
1563              
1564             =item precess(ra0, dec0, equinox0, equinox1)
1565              
1566             Precesses coordinates ra0 and dec0 from equinox0 to equinox1 and returns the calculated ra1 and dec1.
1567             Where ra and dec should be in decimal degrees and equinox should be in years (and fraction of the year).
1568              
1569             =cut
1570             sub precess(@)
1571             {
1572 0     0 1   my ($ra0,$de0,$eq0,$eq1)=@_;
1573 0           my ($cosd,$ra,$dec,
1574             $A,$B,$C,
1575             $x0,$y0,$z0,
1576             $x1,$y1,$z1,
1577             $ST,$T,$sec2rad);
1578 0           my @rot;
1579              
1580 0           my ($sinA,$sinB,$sinC,$cosA,$cosB,$cosC,$sind);
1581              
1582 0           my ($ra1,$de1);
1583              
1584 0           $ra = $ra0*DEG2RAD;
1585 0           $dec = $de0*DEG2RAD;
1586              
1587 0           $cosd = cos($dec);
1588              
1589 0           $x0=$cosd*cos($ra);
1590 0           $y0=$cosd*sin($ra);
1591 0           $z0=sin($dec);
1592              
1593 0           $ST=($eq0-2000.0)*0.001;
1594 0           $T=($eq1-$eq0)*0.001;
1595              
1596 0           $sec2rad=(DEG2RAD)/3600.0;
1597 0           $A=$sec2rad*$T*(23062.181+$ST*(139.656+0.0139*$ST)+$T*
1598             (30.188-0.344*$ST+17.998*$T));
1599 0           $B=$sec2rad*$T*$T*(79.280+0.410*$ST+0.205*$T)+$A;
1600 0           $C=$sec2rad*$T*(20043.109-$ST*(85.33+0.217*$ST)+$T*
1601             (-42.665-0.217*$ST-41.833*$T));
1602              
1603 0           $sinA=sin($A); $sinB=sin($B); $sinC=sin($C);
  0            
  0            
1604 0           $cosA=cos($A); $cosB=cos($B); $cosC=cos($C);
  0            
  0            
1605              
1606 0           $rot[0][0]=$cosA*$cosB*$cosC-$sinA*$sinB;
1607 0           $rot[0][1]=(-1)*$sinA*$cosB*$cosC-$cosA*$sinB;
1608 0           $rot[0][2]=(-1)*$sinC*$cosB;
1609              
1610 0           $rot[1][0]=$cosA*$cosC*$sinB+$sinA*$cosB;
1611 0           $rot[1][1]=(-1)*$sinA*$cosC*$sinB+$cosA*$cosB;
1612 0           $rot[1][2]=(-1)*$sinB*$sinC;
1613              
1614 0           $rot[2][0]=$cosA*$sinC;
1615 0           $rot[2][1]=(-1)*$sinA*$sinC;
1616 0           $rot[2][2]=$cosC;
1617            
1618 0           $x1=$rot[0][0]*$x0+$rot[0][1]*$y0+$rot[0][2]*$z0;
1619 0           $y1=$rot[1][0]*$x0+$rot[1][1]*$y0+$rot[1][2]*$z0;
1620 0           $z1=$rot[2][0]*$x0+$rot[2][1]*$y0+$rot[2][2]*$z0;
1621              
1622 0 0         if ($x1==0) {
1623 0 0         if ($y1 > 0) { $ra1=90.0;}
  0            
1624 0           else { $ra1=270.0;}
1625             }
1626 0           else {$ra1=atan2($y1,$x1)*RAD2DEG;}
1627 0 0         if($ra1<0) { $ra1+=360;}
  0            
1628              
1629 0           $de1=RAD2DEG*atan2($z1,sqrt(1-$z1*$z1));
1630              
1631 0           return ($ra1,$de1);
1632             }
1633              
1634             ########################################################
1635             ######## Mathematics
1636             ########################################################
1637              
1638             =item round(n)
1639              
1640             Returns the rounded number n.
1641              
1642             =cut
1643             sub round($){
1644 0     0 1   my($num)=@_;
1645 0           my ($retval);
1646 0 0         if (($num - floor($num)) < 0.5) { $retval = floor($num); }
  0            
1647 0           else { $retval = floor($num) + 1; }
1648 0           return $retval;
1649             }
1650              
1651              
1652             =item d2hms(deg)
1653              
1654             Converts deg (in decimal degrees) to string in hours, minutes and seconds notion (like "12h 10m 44s").
1655              
1656             =cut
1657             sub d2hms($) # Looks OK! :)
1658             {
1659 0     0 1   my ($ra)=@_;
1660              
1661 0           $ra=$ra/15;
1662 0           my $hr=int($ra*3600+0.5);
1663 0           my $hour=int($hr/3600);
1664 0           my $f=int($hr%3600);
1665 0           my $min=int($f/60);
1666 0           my $sec=int($f%60);
1667 0           my $ra_str = sprintf "%02dh %02dm %02ds", $hour,$min,$sec;
1668 0           return $ra_str;
1669             }
1670              
1671             =item d2dms(deg)
1672              
1673             Converts deg (in decimal degrees) to string in degrees, minutes and seconds notion
1674             (like "33:20:44").
1675              
1676             =cut
1677             sub d2dms($) # Looks OK! :)
1678             {
1679 0     0 1   my ($ang)=@_;
1680 0 0         if ($ang >= 0) {
1681 0           my $a=int($ang*3600+0.5);
1682 0           my $deg=int($a/3600);
1683 0           my $f=int($a%3600);
1684 0           my $min=int($f/60);
1685 0           my $sec=int($f%60);
1686 0           my $ang_str=sprintf "%02d:%02d:%02d",$deg,$min,$sec;
1687 0           return $ang_str;
1688             } else {
1689 0           $ang*=-1;
1690 0           my $a=int($ang*3600+0.5);
1691 0           my $deg=int($a/3600);
1692 0           my $f=int($a%3600);
1693 0           my $min=int($f/60);
1694 0           my $sec=int($f%60);
1695 0           my $ang_str=sprintf "-%02d:%02d:%02d",$deg,$min,$sec;
1696 0           return $ang_str;
1697             }
1698             }
1699            
1700             sub d2dms2($) {
1701 0     0 0   my ($ang)=@_;
1702 0 0         if ($ang >= 0) {
1703 0           my $a=int($ang*3600+0.5);
1704 0           my $deg=int($a/3600);
1705 0           my $f=int($a%3600);
1706 0           my $min=int($f/60);
1707 0           my $sec=int($f%60);
1708 0           return ($deg,$min,$sec);
1709             } else {
1710 0           $ang*=-1;
1711 0           my $a=int($ang*3600+0.5);
1712 0           my $deg=int($a/3600);
1713 0           my $f=int($a%3600);
1714 0           my $min=int($f/60);
1715 0           my $sec=int($f%60);
1716 0           return (-1*$deg,$min,$sec);
1717             }
1718             }
1719              
1720             =item d2dms(deg)
1721              
1722             converts deg (in decimal degrees) to string in degrees and minutes notion (like "33:20").
1723              
1724             =cut
1725             sub d2dm($)
1726             {
1727 0     0 0   my ($ang)=@_;
1728 0           my $a=int($ang*3600+0.5);
1729 0           my $deg=int($a/3600);
1730 0           my $f=int($a%3600);
1731 0           my $min=int($f/60);
1732 0           my $ang_str=sprintf "%02d:%02d",$deg,$min;
1733 0           return $ang_str;
1734             }
1735              
1736             =item dms2d(string)
1737              
1738             converts string of the format "dd:mm:ss" to decimal degrees. If the string format
1739             is invalid format, undef is returned.
1740              
1741             =cut
1742             sub dms2d($)
1743             {
1744 0     0 1   my ($angle)=@_;
1745            
1746 0           my (@dms)=split(/:/,$angle);
1747 0 0 0       if (@dms>3 or $angle eq "") {
1748 0           return undef;
1749             }
1750            
1751 0 0         if (!($dms[0]=~ /^[+-]?\d+$/)) {
1752 0           return undef;
1753             }
1754 0 0 0       if ($dms[1]<0 or $dms[1]>59 or $dms[1]=~/[\D]/) {
      0        
1755 0           return undef;
1756             }
1757 0 0 0       if ($dms[2]<0 or $dms[2]>59 or $dms[2]=~/[\D]/) {
      0        
1758 0           return undef;
1759             }
1760            
1761 0 0         if ($dms[0]=~ /^-/) {
1762 0           return ($dms[0]-$dms[1]/60-$dms[2]/3600);
1763             } else {
1764 0           return ($dms[0]+$dms[1]/60+$dms[2]/3600);
1765             }
1766             }
1767              
1768             =item hms2d(string)
1769              
1770             Converts string of the format "hh:mm:ss" to decimal degrees. If the string format
1771             is invalid format, undef is returned.
1772              
1773             =cut
1774             sub hms2d($)
1775             {
1776 0     0 1   my ($hours)=@_;
1777            
1778 0           my (@hms)=split(/:/,$hours);
1779 0 0 0       if (@hms>3 or $hours eq "") {
1780 0           return undef;
1781             }
1782            
1783 0 0 0       if ($hms[0]<0 or $hms[0]>23 or $hms[0]=~/[\D]/) {
      0        
1784 0           return undef;
1785             }
1786 0 0 0       if ($hms[1]<0 or $hms[1]>59 or $hms[1]=~/[\D]/) {
      0        
1787 0           return undef;
1788             }
1789 0 0 0       if ($hms[2]<0 or $hms[2]>59 or $hms[2]=~/[\D]/) {
      0        
1790 0           return undef;
1791             }
1792            
1793 0           return (($hms[0]+$hms[1]/60+$hms[2]/3600)*15);
1794             }
1795              
1796             ###############################################
1797             # NexStar coordinate conversion
1798             ###############################################
1799              
1800             =item nex2dd(string)
1801              
1802             Converts NexStar hexadecimal coordinate string (in fraction of a revolution) of
1803             the format "34AB,12CE" to two decimal degree coordinates.
1804              
1805             =cut
1806             sub nex2dd ($){
1807 0     0 1   my ($nexres) = @_;
1808 0           my $d1_factor = hex(substr($nexres, 0, 4)) / 65536;
1809 0           my $d2_factor = hex(substr($nexres, 5, 4)) / 65536;
1810 0           my $d1 = 360 * $d1_factor;
1811 0           my $d2 = 360 * $d2_factor;
1812              
1813             # bring $d2 in [-90,+90] range
1814             # use 90.00001 to fix some float errors
1815             # that lead +90 to be converted to -270
1816 0 0         $d2 = $d2 + 360 if ($d2 < -90.0002);
1817 0 0         $d2 = $d2 - 360 if ($d2 > 90.0002);
1818              
1819 0           return($d1, $d2);
1820             }
1821              
1822             =item pnex2dd(string)
1823              
1824             Converts precision NexStar hexadecimal coordinate string (in fraction of a revolution)
1825             of the format "12AB0500,40000500" to two decimal degree coordinates.
1826              
1827             =cut
1828             sub pnex2dd ($){
1829 0     0 1   my ($nexres) = @_;
1830 0           my $d1_factor = hex(substr($nexres, 0, 8)) / 0xffffffff;
1831 0           my $d2_factor = hex(substr($nexres, 9, 8)) / 0xffffffff;
1832 0           my $d1 = 360 * $d1_factor;
1833 0           my $d2 = 360 * $d2_factor;
1834              
1835             # bring $d2 in [-90,+90] range
1836             # use 90.00001 to fix some float errors
1837             # that lead +90 to be converted to -270
1838 0 0         $d2 = $d2 + 360 if ($d2 < -90.0002);
1839 0 0         $d2 = $d2 - 360 if ($d2 > 90.0002);
1840              
1841 0           return($d1, $d2);
1842             }
1843              
1844              
1845             =item dd2nex(deg1,deg2)
1846              
1847             Converts coordinates deg1 and deg2 (in decimal degrees) to NexStar hexadecimal coordinate
1848             string (in fraction of a revolution) of the format "34AB,12CE".
1849              
1850             =cut
1851             sub dd2nex ($$) {
1852 0     0 1   my ($d1, $d2) = @_;
1853              
1854             # bring $d1,$d2 in the range [0-360]
1855 0           $d1 = $d1 - 360 * int($d1/360);
1856 0           $d2 = $d2 - 360 * int($d2/360);
1857 0 0         $d1 = $d1 + 360 if ($d1 < 0);
1858 0 0         $d2 = $d2 + 360 if ($d2 < 0);
1859              
1860 0           my $d2_factor = $d2 / 360;
1861 0           my $d1_factor = $d1 / 360;
1862              
1863 0           my $nex1 = int($d1_factor*65536);
1864 0           my $nex2 = int($d2_factor*65536);
1865              
1866 0           return sprintf("%04X,%04X", $nex1,$nex2);
1867             }
1868              
1869             =item dd2nex(deg1,deg2)
1870              
1871             Converts coordinates deg1 and deg2 (in decimal degrees) to precise NexStar hexadecimal
1872             coordinate string (in fraction of a revolution) of the format "12AB0500,40000500".
1873              
1874             =cut
1875             sub dd2pnex ($$) {
1876 0     0 0   my ($d1, $d2) = @_;
1877              
1878             # bring $d1,$d2 in the range [0-360]
1879 0           $d1 = $d1 - 360 * int($d1/360);
1880 0           $d2 = $d2 - 360 * int($d2/360);
1881 0 0         $d1 = $d1 + 360 if ($d1 < 0);
1882 0 0         $d2 = $d2 + 360 if ($d2 < 0);
1883              
1884 0           my $d2_factor = $d2 / 360;
1885 0           my $d1_factor = $d1 / 360;
1886              
1887 0           my $nex1 = int($d1_factor*0xffffffff);
1888 0           my $nex2 = int($d2_factor*0xffffffff);
1889              
1890 0           return sprintf("%08X,%08X", $nex1,$nex2);
1891             }
1892              
1893             =back
1894              
1895             =head1 SEE ALSO
1896              
1897             For more information about the NexStar commands please refer to the original
1898             protocol specification described here:
1899             http://www.celestron.com/c3/images/files/downloads/1154108406_nexstarcommprot.pdf
1900              
1901             The undocumented commands are described here:
1902             http://www.paquettefamily.ca/nexstar/NexStar_AUX_Commands_10.pdf
1903              
1904             =head1 AUTHOR
1905              
1906             Rumen Bogdanovski, Erumen@skyarchive.orgE
1907              
1908             =head1 COPYRIGHT AND LICENSE
1909              
1910             Copyright (C) 2013-2014 by Rumen Bogdanovski
1911              
1912             This library is free software; you can redistribute it and/or modify
1913             it under the same terms as Perl itself, either Perl version 5.12.4 or,
1914             at your option, any later version of Perl 5 you may have available.
1915              
1916             =cut
1917              
1918             1;