buildxindices.pl
上传用户:center1979
上传日期:2022-07-26
资源大小:50633k
文件大小:2k
源码类别:

OpenGL

开发平台:

Visual C++

  1. #!/usr/bin/perl
  2. # buildcrossidx.pl by Andrew Tribick
  3. # version 1.0 - 2008-08-26
  4. open XIDS, '<', 'crossids.txt';
  5. @HDtoHIP  = ();
  6. @HDlevels = ();
  7. @SAOtoHIP = ();
  8. while($curLine = <XIDS>) {
  9. chomp $curLine;
  10. # get Hipparcos designation
  11. $HIP = '';
  12. $HIP = $2 if($curLine =~ m/(^|:)HIP ([0-9]+)(:|$)/);
  13. next if($HIP eq ''); # ignore entries which are not Hipparcos stars
  14. @dList = split(/:/, $curLine);
  15. for($i = 0; $i <= $#dList; $i++) {
  16. # no component identifiers on SAO designations - makes things easy...
  17. $SAOtoHIP{$1} = $HIP if($dList[$i] =~ m/^SAO ([0-9]+)$/);
  18. # only use HD designations with component identifiers A,J or none
  19. if($dList[$i] =~ m/^HD ([0-9]+)([AJ]?)$/) {
  20. $HDnum = $1;
  21. $Level = HDlevel($2);
  22. if(!exists($HDtoHIP{$HDnum})) {
  23. # if this HD number is not already assigned, add it to list
  24. $HDtoHIP{$HDnum}  = $HIP;
  25. $HDlevels{$HDnum} = $Level;
  26. } elsif($Level > $HDlevels{$HDnum}) {
  27. # otherwise we prefer A over none over J.
  28. $HDtoHIP{$HDnum}  = $HIP;
  29. $HDlevels{$HDnum} = $Level;
  30. }
  31. }
  32. }
  33. }
  34. close XIDS;
  35. # write out HD index file
  36. open HDX,  '>', 'hdxindex.dat';
  37. binmode HDX;
  38. print HDX pack('a8S', 'CELINDEX', 0x0100);
  39. foreach $HD (sort { $a <=> $b } keys %HDtoHIP) {
  40. print HDX pack('LL', $HD, $HDtoHIP{$HD});
  41. }
  42. close HDX;
  43. # write out SAO index file
  44. open SAOX, '>', 'saoxindex.dat';
  45. binmode SAOX;
  46. print SAOX pack('a8S', 'CELINDEX', 0x0100);
  47. foreach $SAO (sort { $a <=> $b } keys %SAOtoHIP) {
  48. print SAOX pack('LL', $SAO, $SAOtoHIP{$SAO});
  49. }
  50. close SAOX;
  51. # ---END OF MAIN PROGRAM---
  52. sub HDlevel {
  53. # return a score based on component identifier
  54. my $d = shift;
  55. return 0 if($d eq 'J');
  56. return 1 if($d eq '');
  57. return 2 if($d eq 'A');
  58. return -999;
  59. }