home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / c / comp1188.zip / STARS.BAS < prev    next >
BASIC Source File  |  1988-08-05  |  9KB  |  207 lines
  1. 5 KEY OFF:SCREEN 1,0:CLS:DEFINT A-Z:COLOR 0,1
  2. 40 P!=3.14159:RD!=P!/180:MY=92:MX=139:X2!=MX*100/127:COL=3
  3. 50 DIM SX(150),SY(150),SM(200),MO(12),C$(35),CS(35),ET(12),MT(12),B%(35)
  4. 100 FOR I=1 TO 12:READ ET(I),MT(I):NEXT
  5. 110 FOR I=1 TO 12:READ MO(I):NEXT
  6. 120 QZ=0
  7. 130 GOSUB 560:LOCATE ,18:PRINT"STARS":XM=10
  8. 140 LOCATE 5,1:Z$=""
  9. 150 PRINT"1 SIMULATION":PRINT"2 CONSTELLATION STUDY"
  10. 160 PRINT"3 CONSTELLATION STUDY WITH QUIZ":PRINT"Q QUIT"
  11. 170 Z$=INKEY$:IF Z$="" THEN 170 ELSE AA=VAL(Z$)
  12. 180 IF Z$="Q" OR Z$="q" THEN END
  13. 190 IF Z$=CHR$(13) THEN AA=2
  14. 200 ON AA GOTO 210,250,250
  15. 205 GOTO 170
  16. 210 M$="HOURLY OR MONTHLY (H OR M)":M1$="H":M2$="M":DF$="H":GOSUB 1571:A$=Z$
  17. 220 IF A$="H" THEN HB=1:DM=0:GOTO 250
  18. 230 IF A$="M" THEN HB=0:DM=1:GOTO 250
  19. 240 GOTO 210
  20. 250 GOSUB 1200:GOSUB 600
  21. 260 IS=0:LB$="COMPUTING":CX=29:CY=23:GOSUB 850
  22. 270 READ RA!:IF RA!>0 THEN 320
  23. 280 IF RA!=0 THEN 400
  24. 285 IF AA>1 AND IS>0 THEN DELAY(2):COL=3:IS=PIS ELSE 290
  25. 287 MG=SM(IS):X=SX(IS):Y=SY(IS):IF MG=0 THEN 290
  26. 288 IF MG<5 THEN GOSUB 780
  27. 289 IS=IS+1:GOTO 287
  28. 290 PIS=IS:READ LB$:CI=RA!*-1:X=949:BH=0:IF LA!>.5 AND CI=20 THEN 400
  29. 300 CX=29:CY=24:GOSUB 850
  30. 310 SM(IS)=6:SX(IS)=CI:IS=IS+1:C$(CI)=LB$:GOTO 370
  31. 320 IF SM(IS)<5 THEN X=SX(IS):Y=SY(IS):MG=SM(IS):COL=0:GOSUB 780:COL=3:BH=0
  32. 325 IF AA<>1 THEN COL=1
  33. 330 READ DC!,MG:IF BH=1 THEN MG=5:GOTO 360
  34. 340 GOSUB 1440:IF AL!<0 THEN MG=5:BH=1:GOTO 360
  35. 350 GOSUB 880:GOSUB 780
  36. 360 SX(IS)=X:SY(IS)=Y:SM(IS)=MG:IS=IS+1:SM(IS)=0
  37. 370 IF ASC(LEFT$(INKEY$+" ",1))=27 THEN GOSUB 510:GOTO 130
  38. 390 GOTO 270
  39. 400 SM(IS)=255:IF AA=4 THEN AA=1
  40. 410 GOSUB 520:IF A$<>" " THEN GOSUB 510:GOTO 130
  41. 420 ON AA GOTO 430,500,910
  42. 430 A2!=A2!+HB:IF A2!>24 THEN A2!=A2!-24:DD=DD+1:JD!=JD!+1
  43. 440 MM=MM+DM:IF MM>12 THEN MM=1
  44. 445 IF DM>0 THEN DD=D1:IF DD>MO(MM) THEN DD=MO(MM)
  45. 450 IF DD>MO(MM) THEN DD=DD-MO(MM):MM=MM+1:IF MM>12 THEN MM=1
  46. 460 IF DD>MO(MM) THEN 450
  47. 470 TM!=INT(A2!)+AN!/60
  48. 480 GOSUB 510:GOSUB 1432
  49. 490 GOSUB 1330:GOSUB 650:GOTO 260
  50. 500 GOSUB 510:GOTO 130
  51. 510 RESTORE 1620:RETURN
  52. 520 LB$="SPACE BAR":CX=29:CY=23:GOSUB 850
  53. 530 LB$="TO CONTINUE":CX=28:CY=24:GOSUB 850
  54. 540 A$="":WHILE A$<>" " AND ASC(LEFT$(A$+" ",1))<>27:A$=INKEY$:WEND:LB$=" ":GOSUB 850:RETURN
  55. 560 CLS:RETURN
  56. 580 PSET(X0+8,Y0+8),COL
  57. 590 RETURN
  58. 600 CLS
  59. 620 FOR I=1 TO 180 STEP 2:X0=MX*SIN(2*I*RD!)+MX+8:Y0=MY*COS(2*I*RD!)+MY+8:PSET(X0,Y0),2:NEXT
  60. 630 LOCATE 1,19:PRINT"N":LOCATE 13,1:PRINT"E";:LOCATE ,37:PRINT"W";
  61. 640 LOCATE 25,19:PRINT"S";
  62. 650 LB$=" ":IF TM!>MT(MM) AND TM!<ET(MM) THEN COLOR 1 ELSE COLOR 0
  63. 670 LOCATE 2,29:PRINT"           ";:LOCATE ,29:PRINT"DATE: ";RIGHT$(STR$(MM),LEN(STR$(MM))-1);"/";RIGHT$(STR$(DD),LEN(STR$(DD))-1)
  64. 672 A4=INT(A2!):IF A4=12 THEN TD$="NOON":GOTO 690
  65. 674 IF A4=24 THEN TD$="MID":A4=12:GOTO 690
  66. 680 A4=INT(A2!):TD$="AM":IF A4>=12 THEN TD$="PM":IF A4>12 THEN A4=A4-12
  67. 690 LOCATE ,30:PRINT"         ";:LOCATE ,31:PRINT STR$(A4)" ";TD$
  68. 700 A4=INT(AN!)
  69. 710 LOCATE 23,2:PRINT"LATITUDE":PRINT"      ";:LOCATE ,5:PRINT LA$;
  70. 720 RETURN
  71. 730 IS=0
  72. 740 MG=SM(IS):X=SX(IS):Y=SY(IS):IF MG=255 THEN RETURN
  73. 750 IF X=0 THEN 770
  74. 760 GOSUB 780
  75. 770 IS=IS+1:GOTO 740
  76. 780 ON MG GOTO 790,820,830,830,840,840
  77. 790 X0=X:Y0=Y+1:GOSUB 580:X0=X+1:Y0=Y:GOSUB 580:X0=X+2:Y0=Y:GOSUB 580
  78. 800 X0=X+3:Y0=Y+1:GOSUB 580
  79. 810 X0=X+1:Y0=Y+2:GOSUB 580:X0=X+2:Y0=Y+2:GOSUB 580
  80. 820 X0=X+1:Y0=Y+1:GOSUB 580
  81. 830 X0=X+2:Y0=Y+1:GOSUB 580
  82. 840 RETURN
  83. 850 LOCATE CY,CX:PRINT SPACE$(40-CX);:LOCATE ,CX:PRINT LB$;:RETURN
  84. 880 AZ!=2*P!-AZ!:Q!=SIN(P!/4-AL!/2)/COS(P!/4-AL!/2)
  85. 890 X=INT((X2!*Q!*SIN(AZ!)+X2!)*1.27)
  86. 900 Y=MY-INT(MY*Q!*COS(AZ!))-1:RETURN
  87. 910 IS=1:GOSUB 600:LB$="SORTING":CX=29:CY=23:GOSUB 850
  88. 920 I=0
  89. 930 BH=0
  90. 940 IF SM(I)=255 THEN CS(IS)=0:GOTO 1010
  91. 950 CS(IS)=SX(I)
  92. 960 IF SM(I+1)>5 THEN I=I+1:GOTO 940
  93. 970 I=I+1:IF SM(I)=5 THEN BH=1
  94. 980 IF SM(I)<6 THEN 970
  95. 990 IF BH=0 THEN IS=IS+1
  96. 1000 GOTO 930
  97. 1010 NC=IS-1
  98. 1020 FOR I=1 TO NC:B%(I)=I:NEXT
  99. 1030 FOR J=1 TO 5:FOR K=1 TO NC:L=B%(INT(RND*NC+1)):T9=B%(K):B%(K)=B%(L)
  100. 1040 B%(L)=T9:NEXT K,J
  101. 1050 FOR KS=1 TO NC:COL=1:GOSUB 1191
  102. 1110 LB$="NAME":CX=29:CY=23:GOSUB 850
  103. 1120 LB$="":CX=28:CY=24:GOSUB 850:G$="":PRINT">";
  104. 1121 K$="":WHILE K$="":K$=UCASE$(INKEY$):WEND:GLEN=LEN(G$):IF K$=CHR$(13) THEN GOTO 1130
  105. 1122 IF GLEN<11 AND ((K$>="A" AND K$<="Z") OR K$=" ") THEN G$=G$+K$:LOCATE ,29+GLEN:PRINT K$;:GOTO 1125
  106. 1123 IF GLEN>0 AND (K$=CHR$(8) OR K$=CHR$(29)) THEN G$=LEFT$(G$,GLEN-1):LOCATE ,29+GLEN-1:PRINT" ";
  107. 1125 GOTO 1121
  108. 1130 IF G$=C$(CS(JS)) THEN LB$="CORRECT":CX=29:CY=23:GOSUB 850:QZ=QZ+1:GOTO 1150
  109. 1140 LB$=C$(CS(JS)):CY=24:GOSUB 850
  110. 1150 DELAY(1):COL=3:GOSUB 1191:NEXT
  111. 1160 LINE (8,66)-(285,86),,B
  112. 1170 LOCATE 10,3
  113. 1180 PRINT"YOU ANSWERED";QZ;"CORRECT OUT OF";LEFT$(STR$(NC),3):QZ=0
  114. 1190 GOSUB 510:GOSUB 520:GOTO 130
  115. 1191 IS=0:BH=0:JS=B%(KS)
  116. 1192 MG=SM(IS):X=SX(IS):Y=SY(IS):IF MG=255 THEN 1197
  117. 1193 IF MG=6 THEN CN=X:GOTO 1196
  118. 1194 IF CN=CS(JS) THEN BH=1:GOSUB 780
  119. 1195 IF CN<>CS(JS) AND BH=1 THEN 1197
  120. 1196 IS=IS+1:GOTO 1192
  121. 1197 RETURN
  122. 1200 IF AA=4 THEN PRINT"STARTING ";
  123. 1210 XM=XM+2:PRINT:PRINT"DATE AND TIME OF SKY DISPLAY"
  124. 1220 PRINT:M$="MONTH (1-12)":M1=1:M2=12:DF$="1":GOSUB 1580:MM=INT(VAL(Z$))
  125. 1230 M$="DAY (1-"+STR$(MO(MM))+")":M1=1:M2=MO(MM):DF$="1":GOSUB 1580:DD=INT(VAL(Z$))
  126. 1240 GOSUB 1432:D1=DD
  127. 1260 A2!=0:AN!=0:M$="HOUR (1-12)":M1=1:M2=12:DF$="9":GOSUB 1580:A2!=VAL(Z$):B$=" "
  128. 1265 A2!=INT(A2!)
  129. 1270 M$=" AM OR PM":M1$="AM":M2$="PM":DF$="PM":GOSUB 1571:B$=Z$
  130. 1280 IF B$="PM" AND A2!<>12 THEN A2!=A2!+12
  131. 1285 IF B$="AM" AND A2!=12 THEN A2!=24
  132. 1290 TM!=A2!:AN!=(TM!-INT(TM!))*60
  133. 1300 M$="LATITUDE":M1=-90:M2=90:DF$="40":GOSUB 1580:LA!=VAL(Z$):LA$=Z$
  134. 1310 IF LA!=0 THEN LA$="0"
  135. 1320 LA!=LA!*RD!
  136. 1330 FD!=TM!/24+.5:IF FD!=>1 THEN FD!=FD!-1:JD!=JD!+1
  137. 1340 DA=DA+FD!:D3=JD!-2451545!
  138. 1350 T3!=D3/36525!:T1=INT(T3!)
  139. 1360 T2!=(JD!-T1*36525!-2451544.5#)/36525!
  140. 1370 S3!=24110.54841#+184.812866#*T1+8640184.812866#*T2!+.093104*T3!*T3!
  141. 1380 S3!=(S3!-.0000062*T3!*T3!*T3!)/86400!:S3!=24*(S3!-INT(S3!)+(FD!-.5)*1.002737909#)
  142. 1390 IF S3!<0 THEN S3!=S3!+24
  143. 1400 IF S3!>24 THEN S3!=S3!-24
  144. 1410 H3=INT(S3!):M3=INT(60*(S3!-H3))
  145. 1420 TG!=H3+M3/60
  146. 1430 RETURN
  147. 1432 JD!=2446429.5#:DA=DD:IF MM>1 THEN FOR I=1 TO MM-1:DA=DA+MO(I):NEXT
  148. 1434 JD!=JD!+DA:RETURN
  149. 1440 DC!=DC!*RD!:RA!=RA!*15*RD!
  150. 1450 T5!=TG!*15*RD!-RA!
  151. 1460 S1!=SIN(LA!)*SIN(DC!)+COS(LA!)*COS(DC!)*COS(T5!)
  152. 1470 C1!=1-S1!*S1!
  153. 1480 IF C1!>0 THEN C1!=SQR(C1!)
  154. 1490 IF C1!<=0 THEN AL!=SGN(S1!)*P!/2:GOTO 1510
  155. 1500 AL!=ATN(S1!/C1!)
  156. 1510 C2!=COS(LA!)*SIN(DC!)-SIN(LA!)*COS(DC!)*COS(T5!)
  157. 1520 S2!=-COS(DC!)*SIN(T5!)
  158. 1530 IF C2!=0 THEN AZ!=SGN(S2!)*P!/2:GOTO 1560
  159. 1540 AZ!=ATN(S2!/C2!)
  160. 1550 IF C2!<0 THEN AZ!=AZ!+P!
  161. 1560 IF AZ!<0 THEN AZ!=AZ!+2*P!
  162. 1570 RETURN
  163. 1571 XM=XM+1:Q$=""
  164. 1572 LOCATE XM:PRINT"                                      ":LOCATE XM:PRINT M$;:INPUT Q$:IF Q$="" THEN Z$=DF$:GOTO 1575
  165. 1573 Z$="":FOR I=1 TO LEN(Q$):TE$=MID$(Q$,I,1):IF TE$>="a" AND TE$<="z" THEN Z$=Z$+CHR$(ASC(TE$)-32) ELSE Z$=Z$+TE$
  166. 1574 NEXT
  167. 1575 IF Z$<>M1$ AND Z$<>M2$ THEN 1572
  168. 1576 RETURN
  169. 1580 XM=XM+1:Z$=""
  170. 1582 LOCATE XM:PRINT"                                      ":LOCATE XM:PRINT M$;:INPUT Z$:IF Z$="" THEN Z$=DF$
  171. 1584 IF VAL(Z$)=0 AND Z$<>"0" THEN 1582
  172. 1590 IF VAL(Z$)<M1 OR VAL(Z$)>M2 THEN 1582
  173. 1592 RETURN
  174. 1600 DATA 19,6,19,6,20,5,21,4,21,3,22,3,21,3,20,4,20,4,19,5,18,5,18,6
  175. 1610 DATA 31,28,31,30,31,30,31,31,30,31,30,31
  176. 1620 DATA -1,"POLARIS",2,89,2
  177. 1630 DATA -2,"BIG DIPPER"
  178. 1640 DATA 11,57,2,11,63,2,11.8,54,2,12.2,58,3,12.9,57,2,13.4,55,2,13.7,50,2
  179. 1650 DATA -3,"ARCTURUS",14.3,19.5,1
  180. 1660 DATA -4,"VIRGO",13.4,-11,1,12.6,-1,3,12.9,3,3,13,11,3
  181. 1670 DATA -5,"PEGASUS",0.2,15,3,23,14,2,23,28,2,.1,29,2
  182. 1680 DATA -6,"AURIGA",5.2,46,1,5.9,45,2,5.9,37,2,4.9,33,3,5.4,29,2
  183. 1690 DATA -7,"ORION",5.9,8,1,5.4,7,2,5.75,-2,2,5.6,-1,2,5.45,0,2
  184. 1700 DATA 5.6,-5.5,4,5.2,-8.5,1,5.8,-10,2
  185. 1710 DATA -8,"VEGA",18.6,39,1,-9,"CYGNUS"
  186. 1720 DATA 20.7,45,1,20.3,40,2,19.7,45,3,20.75,34,2,19.5,28,3,19.9,35,4
  187. 1730 DATA -10,"CANIS MAJOR",6.7,-17,1,6.4,-18,2
  188. 1740 DATA -11,"AQUILA",19.8,9,1,19.1,13.5,3,20.1,-1,3,19.4,3,3,19.1,-5,3
  189. 1750 DATA -12,"SCORPIUS",16.5,-26,1,16,-20,2,15.9,-22,2,15.9,-26,3
  190. 1760 DATA 17.6,-43,2,16.7,-34,2,17.6,-37,2,16.7,-38,3,17.2,-43,3
  191. 1770 DATA -13,"CASSIOPEIA",1.9,63.5,4,1.4,60,3,0.9,60.5,2,0.6,56,2,0.1,59,2
  192. 1780 DATA -14,"TAURUS",4.6,16,1,4.2,15,4,4.4,19,3
  193. 1790 DATA -15,"CANIS MINOR",7.6,6,1,7.4,9,3
  194. 1800 DATA -16,"GEMINI",7.5,32,1,7.7,28,1,6.7,25,3,6.6,16,2,6.3,22,3
  195. 1810 DATA -17,"LEO"
  196. 1820 DATA 10.1,12.5,1,10.1,17,3,10.3,20,2,10.3,24,3,9.8,26,4,9.7,24,3
  197. 1830 DATA 11.2,21,2,11.2,16,3,11.8,15,2
  198. 1840 DATA -18,"SAGITTARIUS",18.3,-30,3,18,-30.5,3,18.4,-25,3,18.9,-26,2,19,-30,2
  199. 1850 DATA 18.7,-27,3,19.1,-28,3,18.3,-34.5,2
  200. 1860 DATA -19,"FOMALHAUT",22.9,-30,1
  201. 1870 DATA -20,"CARINA",6.4,-52,1
  202. 1880 DATA 8.4,-59,2,9.2,-59,2,9.2,-69,2,9.8,-65,3
  203. 1890 DATA -21,"VELA",8.2,-47,2,8.6,-54,2,9.1,-43,2,9.3,-55,2
  204. 1900 DATA -22,"CRUX",12.1,-58,2,12.4,-63,1,12.5,-56,1,12.8,-59,1
  205. 1910 DATA -23,"CENTAURUS",14.6,-61,1,14,-60,1
  206. 1920 DATA -24,"ACHERNAR",1.6,-58,1,0
  207.