1 REM 11/21/93
2 REM A GW BASIC program to access Sky Catalogue,
3 REM Volume 1, Second Edition.
4 REM Copyright (c) 1991 Sky Publishing Corporation
5 REM 49 Bay State Road, Cambridge, Massachusetts 02138
6 REM program version 1.02
7 REM this program displays only some of the information contained in
8 REM the catalogue, however all of the data is saved in a text file
9 CLS : REM clear screen
10 PRINT:print "Sky Catalogue 2000.0, Volume 1"
20 PRINT "Second Edition"
22 PRINT
22 PRINT "Copyright (c) 1991 Sky Publishing Corporation"
23 print
24 PRINT "This example program saves all catalogue data of selected stars in"
26 PRINT "a text file.  However, only a fraction of this data is displayed."
27 print"(program ver. 1.02)"
28 PRINT: INPUT "Press the <ENTER> key to continue";z$
29 CLS : REM clear screen
30 REM *************************************************
35 REM access catalogue
60 GOSUB 1530
70 CLS : REM clear screen
90 PRINT: PRINT
100 PRINT "This program finds all stars within a selected window of sky."
110 PRINT
120 PRINT "Your options:"
130 PRINT "(1) List stars with physical data"
140 PRINT "(2) List stars with names (if any)"
150 PRINT "(3) Exit
160 PRINT
162 CLOSE#3 : REM if open, close output file
170 INPUT "Choice";Q$: Q=VAL(Q$)
180 IF Q<1 OR Q>3 THEN 170
190 IF Q<>INT(Q) THEN 170
200 IF Q=3 THEN 1730
210 IF Q=1 OR Q=2 THEN GOSUB 270
220 REM
230 INPUT "Finished... Press <ENTER> to return to the menu";Q$
240 GOTO 70
250 REM
260 REM
270 REM  FIND STARS WITHIN A SELECTED WINDOW
271 CLS : REM clear screen
272 PRINT:INPUT"Would you like this data to be stored in a text file (y/n)";re$
274 IF re$="y" OR re$="Y" THEN GOSUB 1763 : REM open outfile
280 REM
290 CLS : REM clear screen
300 INPUT "Desired Right Ascension (Hrs, Min, Sec)";h,M,s
310 IF h<0 OR h>=24 THEN 300
320 IF M<0 OR M>=60 THEN 300
330 IF s<0 OR s>=60 THEN 300
340 H0=h+M/60+s/3600: IF H0>=24 THEN H0=H0-24: REM R.A. IN HOURS
350 REM
360 INPUT "Declination (Deg, Min, Sec)";D5$,M1,S1
370 s=1: IF LEFT$(D5$,1)="-" THEN s=-1
380 D1=ABS(VAL(D5$))
390 IF D1>90 THEN 360
400 IF M1<0 OR M1>=60 THEN 360
410 IF S1<0 OR S1>=60 THEN 360
420 IF D1=90 AND (M1>0 OR S1>0) THEN 360
430 D0=s*(D1+M1/60+S1/3600): REM DECLINATION IN DEGREES
440 INPUT "Window diameter (Deg)";w$
450 w=VAL(w$): IF w<=0 THEN 440
460 IF w<.05 THEN w=.05
470 IF w>10 THEN PRINT "Too big (must not exceed 10 degrees)": GOTO 440
472 IF re$="y" OR re$="Y" THEN GOSUB 1770: REM write beginning info
480 WR=w/2: REM WINDOW RADIUS IN DEGREES
490 DH=SIN(WR*DR)/COS(D0*DR)
500 SD=SIN(D0*DR): CD=COS(D0*DR)
510 PC=0: IF DH>1 THEN H1=0: H2=23.9999: PC=1: GOTO 560
520 DH=ATN(DH/SQR(1-DH*DH))/(DR*15)
530 H1=H0-DH: IF H1<0 THEN H1=H1+24: REM STARTING R.A.
540 H2=H0+DH: IF H2>=24 THEN H2=H2-24: REM ENDING R.A.
550 REM
560 h=INT(H1): M1=60*(H1-h): M=INT(M1): s=60*(M1-M)
570 GOSUB 1180: C1$=C0$
580 h=INT(H2): M1=60*(H2-h): M=INT(M1): s=60*(M1-M)
590 GOSUB 1180: C2$=C0$
600 C0$=C1$: GOSUB 1340
610 k=-1: t=0: CLS: GOSUB 1280
620 k=k+1: IF k<18 THEN 650
630 PRINT:INPUT "Hit <ENTER> key for more.  Ready";Q$
640 k=0: CLS: GOSUB 1280
650 GET#1,i: C3$=A$
660 IF PC=1 AND i=I9 THEN 890
670 IF C2$>=C1$ AND C3$>C2$ THEN 890
680 IF C2$<C1$ AND C3$>C2$ AND C3$<"1159599" THEN 890
690 D8$=LEFT$(d$,3): M8$=MID$(d$,4,2): S8$=RIGHT$(d$,2)
700 s=1: IF LEFT$(D8$,1)="-" OR MID$(D8$,2,1)="-" THEN s=-1
710 d=s*(ABS(VAL(D8$))+VAL(M8$)/60+VAL(S8$)/3600)
720 IF ABS(d-D0)<=WR THEN 760: REM OBJECT IS IN ROUGHLY THE RIGHT
730 REM                             RANGE OF R.A. AND DEC.
740 i=i+1: IF i>I9 THEN i=i-I9
750 GOTO 650
760 REM    IS THE OBJECT REALLY WITHIN ANGULAR DISTANCE WR?
770 H6$=LEFT$(A$,2): M6$=MID$(A$,3,2): S6$=MID$(A$,5,3)
780 h=VAL(H6$)+VAL(M6$)/60+VAL(S6$)/36000!: REM s6$ is in 10ths of a sec.
790 CS=SIN(d*DR)*SD+COS(d*DR)*CD*COS((h-H0)*15*DR)
800 IF CS>1 THEN CS=1
810 SP=ATN(SQR(1-CS*CS)/CS)/DR: REM  SP=SEPARATION IN DEGREES
820 IF SP>WR THEN 740
840 GOSUB 930: t=t+1
850 i=i+1: IF i>I9 THEN i=i-I9
860 GOTO 620
870 REM
880 REM
890 IF t=0 THEN PRINT "No stars found": PRINT
900 PRINT
910 RETURN
920 REM
930 REM   PRINT A LINE OF DATA
940 REM
950 s5$=SA$: T5$=t$: R5$=RV$
960 A5$=LEFT$(A$,2)+" "+MID$(A$,3,2)+" "+MID$(A$,5,2)+"."+RIGHT$(A$,1)
970 D5$=LEFT$(d$,3)+" "+MID$(d$,4,2)+" "+RIGHT$(d$,2)
980 A6$=LEFT$(A1$,2)+"."+RIGHT$(A1$,3): IF A6$="  .   " THEN A6$="      "
990 D6$=LEFT$(D1$,2)+"."+RIGHT$(D1$,2): IF D6$="  .  " THEN D6$="     "
1000 V5$=LEFT$(v$,2)+"."+RIGHT$(v$,2)
1010 B5$=LEFT$(BV$,2)+"."+RIGHT$(BV$,2): IF B5$="  .  " THEN B5$="     "
1020 P5$=P$+" ": P1$=RIGHT$(P5$,2): P2$=""
1030 IF P1$="h " THEN P2$="mx"
1040 IF P1$="l " THEN P2$="mn"
1050 IF P1$="c " THEN P2$="ts"
1060 IF P2$<>"" THEN P5$=LEFT$(P5$,4)+P2$
1061 REM go to subroutine "decode" to decode other information
1062 REM CD2$ contains the coded information
1063 IF CD2$ <>" " THEN GOSUB 1792 : REM decode subroutine
1064 REM only some of the information is printed on the screen
1090 PRINT s5$;"  ";A5$;"  ";D5$;"  ";
1091 IF Q=2 THEN GOSUB 1842 :REM search for name
1092 IF Q=1 THEN PRINT A6$;" ";D6$;
1100 PRINT "  ";V5$;" ";
1101 IF Q=1 THEN PRINT " ";B5$;"  ";
1102 IF Q=1 THEN PRINT T5$
1103 IF Q=2 THEN PRINT " "; datastring$
1104 IF re$="y" OR re$="Y" THEN GOSUB 1777 :REM stick data in file
1105 ce2$=""
1106 datastring$=""
1160 RETURN
1170 REM
1180 REM EXPRESS R.A. AS A STRING
1190 REM  -- ENTER WITH H,M,S; EXIT WITH C0$
1200 REM
1210 PH$=MID$(STR$(100+h),3,2)
1220 PM$=MID$(STR$(100+M),3,2)
1230 PS$=MID$(STR$(1000+s*10),3,3)
1240 C0$=PH$+PM$+PS$
1250 IF LEFT$(C0$,1)="0" THEN C0$=" "+RIGHT$(C0$,6)
1260 RETURN
1270 REM
1280 REM  SELECT AND DISPLAY PROPER HEADING
1290 REM
1300 IF Q=1 THEN PRINT H1$: PRINT H2$: GOTO 1320
1310 PRINT H3$: PRINT H4$: REM  Heading for names
1320 RETURN
1330 REM
1340 REM SEEK SUBROUTINE -- ENTER WITH C0$; EXIT WITH I SET TO
1350 REM       THE RECORD NUMBER JUST BEFORE THE DESIRED R.A.
1360 REM
1370 I0=1: I9=50071!
1380 i=INT(I9/2): REM START IN MIDDLE OF FILE
1390 d=i
1400 d=INT(d/2)
1410 IF d=0 THEN 1460
1420 GET#1,i: P9$=A$
1430 s=1: IF P9$>C0$ THEN s=-1
1440 i=i+s*d
1450 GOTO 1400
1460 REM
1470 IF i=I9 THEN 1500
1480 IF A$<C0$ THEN i=i+1: GET#1,i: GOTO 1470
1490 i=i-1: IF i>0 THEN GET#1,i
1500 IF A$>=C0$ AND i>1 THEN 1490
1510 RETURN
1520 REM
1530 REM      OPEN FILES AND SET UP HEADING
1540 REM
1550 DR=3.14159265#/180: REM DEGREES TO RADIANS
1560 s$=CHR$(34): REM Symbol for arc seconds (")
1570 H1$=" SAO       R.A.        Dec.     PM(a)  PM(d)"
1580 H1$=H1$+"   V    B-V   Sp   " :REM RV  Dist
1590 H2$="         h  m  s      o  '  "+s$+"    s      "+s$
1600 REM H2$=H2$+"                     km/s  pc"
1610 H3$=" SAO       R.A.        Dec.      V         Star name(s)"
1620  REM H4$="         h  m  s      o  '  "+s$
1621 REM ***************************************************
1622 REM  open data files and set field sizes and variables
1630 f1$="SKYCAT.DAT"
1635 OPEN "R",1,f1$,107
1637 FIELD 1,7 AS hd$, 6 AS SA$,12 AS NA$, 7 AS A$,7 AS d$,5 AS A1$
1638 FIELD 1, 44 AS x$, 4 AS D1$,4 AS v$, 3 AS CD1$, 4 AS BV$, 3 AS mv$
1639 FIELD 1, 62 AS x$, 16 AS t$,4 AS RV$,5 AS P$, 5 AS ad$, 4 AS af$
1640 FIELD 1, 96 AS x$, 3 AS n2$, 4 AS hr$, 3 AS mt$, 1 AS CD2$
1670 REM
1680 F2$="NAMES.DAT"
1690 OPEN "R",2,F2$,49
1700 FIELD 2, 7 AS rt$, 7 AS dn$, 17 AS cn$, 9 AS vn$, 9 AS cm$
1710 RETURN
1720 REM
1721 REM ***********************************************
1730 REM   EXIT
1740 CLOSE : REM close all open files
1741 input"Would you like to return to DOS (y/n)";ques2$
1742 if ques2$="y" then system
1760 END : REM end of program
1761 REM *****************************************************
1762 REM subroutines for open out file, decode, write beginning info, write to file
1763 PRINT : REM open outfile
1764 input "Enter file name for data"; li$
1766 IF li$ ="" THEN PRINT "No file selected ": GOTO 70
1767 OPEN li$ FOR OUTPUT AS #3 :REM open a sequential file for the data
1768 RETURN
1770 REM : write RA, Dec., and window size to the data out file
1771 PRINT #3, "Right Ascension (hours, min, sec)= ";h;M;s
1772 PRINT #3, "Declination (degrees, min, sec)=  ";D5$;M1;S1
1773 PRINT #3, "Window diameter (degrees)= ";w$
1774 PRINT #3,"" : REM print a blank line
1775 RETURN
1777 rem subroutine stickinfile
1778 rah$=LEFT$(A$,2): mah$=MID$(A$,3,2):sah$=MID$(A$,5,2): sah2$=RIGHT$(A$,1)
1779 fra$=rah$+"h "+mah$+"' "+sah$+"."+sah2$+sym$: ddec$=LEFT$(D$,3):mdec$=MID$(D$,4,2):sdec$=RIGHT$(D$,2)
1780 fdec$=ddec$+"d "+mdec$+"' "+sdec$+sym$:dv$=LEFT$(v$,2)+"."+RIGHT$(v$,2)+"  ":dbv$=LEFT$(BV$,2)+"."+RIGHT$(BV$,2)+"  ":davm$=  LEFT$(mv$,2)+"."+RIGHT$(mv$,1)
1781 IF mv$="   " THEN davm$="    "
1782 da1$=LEFT$(A1$,2)+"."+RIGHT$(A1$,3): dd1$=LEFT$(D1$,2)+"."+RIGHT$(D1$,2)
1783 PRINT #3, "RA= "; fra$; " Dec= "; fdec$: PRINT #3, "HD= ";hd$; " SAO= "; sa$; " Flamsteed/Bayer/const.= "; NA$
1784 PRINT #3,  "HR= "; hr$, "ADS= "; ad$: PRINT #3, "":PRINT #3, "v mag= "; dv$;  " b-v= ";dbv$;: PRINT #3, " M= "; davm$; " spectral type= ";t$
1785 PRINT #3,"proper motion (RA)= ";da1$ " proper motion (Dec)= "; dd1$: PRINT #3,  "distance= ";P$; "     mult flag= "; mt$;" radial velocity= "; RV$
1786 IF Q=1 THEN PRINT #3, "common name, var, member= ";n2$
1787 PRINT #3, "ADS suffix= "; af$;  "visual mag code= "; CD1$:PRINT #3, "other encoded information= ";ce2$
1788 IF Q=2 THEN PRINT #3, "name and member information= ";datastring$
1789 PRINT #3, "" :PRINT #3, "":PRINT #3, "":PRINT #3, "":datastring$="":RETURN
1790 REM
1792 REM subroutine to decode data from the last field
1793 ce2$="":CZ1$="":CZ2$="":CZ3$="":CZ4$="":CZ5$="":CZ6$="":CZ7$=""
1794 REM the last variable for each star stored in the catalogue contains encoded
1795 REM information to save space in this catalogue
1796 REM this information is stored as an ASCII number converted from a binary number
1797 REM convert from ASCII
1799 numbervalue=ASC(CD2$)
1800 REM subtract 32 from the numbervalue
1805 number=numbervalue-32
1810 REM convert number to binary
1811   t=number
1812   bit1$="1"
1813   bit0$="0"
1814  mask=1
1815  b$=""
1816 FOR i%=0 TO 6
1817 IF mask AND t THEN b$=bit1$+b$ ELSE b$=bit0$+b$
1818    mask=mask*2
1819  NEXT
1820 REM From the binary representation it is possible to decode the information.
1821 REM The first two MSBs of the byte indicate if there is an 'a' or 'b' in the RA
1822 REM and Dec field, if so, the accuracy of the position is less.
1823 REM if the first two bits are '00', then there is no loss in accuracy
1824 REM if the first two bits are '01', then there is an 'a' in the field
1825 REM if the first two bits are '10', then there is a 'b' in the field
1826 REM a '11' is not allowed in the two MSB place
1827 REM if there is a '1' in the 3rd MSB then there is a question in V
1828 REM if there is a '1' in the 4th MSB then there is a question in B-V
1829 REM if there is a '1' in the 5th MSB then the star may be a var in RV
1830 REM if there is a '1' in the 6th MSB then there is question about the RV
1831 REM if there is a '1' in the LSB then there are notes about this star in the back
1832 REM of the Sky Catalogue Volume 1, Second Edition book
1833 IF LEFT$(b$,2)="01" THEN CZ1$= "RA and Dec position not accurate to 'a' "
1834 IF LEFT$(b$,2)="10" THEN CZ2$= "RA and Dec position not accurate to 'b' "
1835 IF MID$(b$,3,1)="1" THEN CZ3$= " question in v,   "
1836 IF MID$(b$,4,1)="1" THEN CZ4$= " question in the b-v,  "
1837 IF MID$(b$,5,1)="1" THEN CZ5$= " var in radial vel,   "
1838 IF MID$(b$,6,1)="1" THEN CZ6$= " question in the radial vel,   "
1839 IF MID$(b$,7,1)="1" THEN CZ7$= " notes in the back of the book "
1840 ce2$=CZ1$+CZ2$+CZ3$+CZ4$+CZ5$+CZ6$+CZ7$
1841 RETURN
1842 REM searchname subroutine to check and search for common name etc.
1845 REM check to see if there should be data in the names file
1846 IF n2$="   " THEN RETURN : REM return if there is no common name etc.
1847 REM setup search
1848 kt%=0 : REM counter for search loop
1849 total%=2598 : REM total number of records in the name file
1850 kt%=1
1851 GET #2, kt%
1852 testa$=rt$+dn$
1853 test2$=A$+d$
1854 WHILE kt%<=total% AND testa$ <>test2$
1855 GET #2, kt%
1856 testa$=rt$+dn$
1857 kt%=kt%+1
1858 WEND
1859 datastring$= cn$ +" "+" "+vn$+" "+cm$
1860 RETURN
1865 REM **********************************************
1866 REM end of subroutines