home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib29b.dsk / SUNRISE.SUNSET.bas < prev    next >
BASIC Source File  |  2023-02-26  |  10KB  |  203 lines
  1. 10  REM **********************
  2. 20  REM *   SUNRISE.SUNSET   *
  3. 30  REM * BY MICHAEL BAKICH  *
  4. 40  REM * COPYRIGHT (C) 1986 *
  5. 50  REM * BY MICROSPARC, INC *
  6. 60  REM * CONCORD, MA  01742 *
  7. 70  REM **********************
  8. 80  GOTO 310
  9. 90 X1$ =  STR$(X)
  10. 100 X$ = ""
  11. 110 XL =  LEN(X1$)
  12. 120 X1 = 0
  13. 130  FOR K = 1 TO XL
  14. 140 X2$ =  MID$ (X1$,K,1)
  15. 150  IF X2$ = "."  THEN X2$ = ":":X1 = XL -K
  16. 160 X$ = X$ +X2$
  17. 170  NEXT K
  18. 180  IF X1 = 2 GOTO 230
  19. 190  IF X1 = 0  THEN X$ = X$ +":"
  20. 200  FOR K = 1 TO 2 -X1
  21. 210 X$ = X$ +"0"
  22. 220  NEXT K
  23. 230  RETURN 
  24. 240 X1 =  SGN(X)
  25. 250 X2 =  ABS(X)
  26. 260 X3 =  INT(X2)
  27. 270 X4 =  INT((X2 - INT(X2)) *60 +.5)
  28. 280  IF X4 > = 60  THEN X3 = X3 +1:X4 = X4 -60: GOTO 280
  29. 290 X = X1 *(X3 +X4/100)
  30. 300  RETURN 
  31. 310  ONERR  GOTO 2030
  32. 320 PI = 3.1415926536
  33. 330  DEF  FN A(X) = X *PI/180: DEF  FN B(X) = X *180/PI: DEF  FN C(X) = PI/2 - ATN(X/ SQR(1 -X *X)): DEF  FN D(X) =  ATN(X/ SQR(1 -X *X))
  34. 340  DIM A(13),B$(12),L(50),AL(50),NU(50)
  35. 350  FOR I = 1 TO 12: READ A(I),B$(I): NEXT I
  36. 360  FOR I = 1 TO 50: READ L(I): NEXT 
  37. 370  FOR I = 1 TO 50: READ AL(I): NEXT 
  38. 380  FOR I = 1 TO 50: READ NU(I): NEXT 
  39. 390 PD$ = ".": FOR I = 1 TO 30:PX$ = PX$ +PD$: NEXT I
  40. 400 D$ =  CHR$(4):PS = 1
  41. 410  HOME : VTAB 8: HTAB 6: PRINT "S U N R I S E / S U N S E T": VTAB 10: HTAB 11: PRINT "BY MICHAEL BAKICH": VTAB 12: PRINT "** COPYRIGHT 1986 BY MICROSPARC, INC **"
  42. 420  VTAB 23: PRINT "PRESS <RETURN> TO CONTINUE";: GET Z$: PRINT 
  43. 430 G$ = "N":S8 = 0: FOR S = 1 TO 7:B = 49152 +256 *S:C =  INT( PEEK(B +12)/16 +1) *( PEEK(B +5) + PEEK(B +7) = 80):C = C *(C <11): IF C = 9  THEN S8 = S:S = 7
  44. 440  NEXT S: IF S8  THEN  PRINT D$"PR#"S8:G$ = "Y"
  45. 450  HOME : VTAB 1: PRINT "ENTER THE FOLLOWING:"
  46. 460  PRINT "--------------------":UE = 0: REM ^ 20 DASHES
  47. 470  VTAB 5: HTAB 1: CALL  -958:P = PP: PRINT "LATITUDE   (RANGE: -60 TO 60)....."P;
  48. 480  HTAB 35: INPUT "";P$: ON P$ = "" GOTO 490:P =  VAL(P$)
  49. 490  VTAB 5: HTAB 35: PRINT P: ON P >60  OR P < -60 GOTO 470:PP = P
  50. 500  VTAB 7: HTAB 1: CALL  -958:L = LL: PRINT "LONGITUDE  (RANGE: -180 TO 180)...";L;
  51. 510  HTAB 35: INPUT "";L$: ON L$ = "" GOTO 520:L =  VAL(L$)
  52. 520  VTAB 7: HTAB 35: PRINT L: ON L < -180  OR L >180 GOTO 500:LL = L
  53. 530 P =  FN A(P):L = L/15 - INT(L/15)
  54. 540  VTAB 9: HTAB 1: CALL  -958: PRINT "STARTING MONTH (RANGE: 1 TO 12)...";:M1 = M1 +(M1 = 0): PRINT M1;
  55. 550  HTAB 35: INPUT "";M1$: ON M1$ = "" GOTO 560:M1 =  VAL(M1$)
  56. 560  VTAB 9: HTAB 35: PRINT M1: IF M1 <1  OR M1 >12  OR M1 < > INT(M1) GOTO 540
  57. 570  VTAB 11: HTAB 1: CALL  -958: PRINT "ENDING MONTH (RANGE: ";M1;" TO 12).....";:M2 = M2 *(M2 > = M1) +M1 *(M2 <M1): HTAB 35: PRINT M2;
  58. 580  HTAB 35: INPUT "";M2$: ON M2$ = "" GOTO 590:M2 =  VAL(M2$)
  59. 590  VTAB 11: HTAB 35: PRINT M2: IF M2 <M1  OR M2 >12  OR M2 < > INT(M2) GOTO 570
  60. 600  GOSUB 1810
  61. 610  VTAB 15: HTAB 1: PRINT "PRINTOUT FROM SLOT "PS" (Y/N)........N"; CHR$(8);: GET H$: REM  8 PERIODS
  62. 620  IF H$ =  CHR$(121)  THEN H$ = "Y"
  63. 630  IF H$ =  CHR$(110)  OR H$ =  CHR$(13)  THEN H$ = "N"
  64. 640  IF H$ = "Y"  THEN  VTAB 15: HTAB 9: PRINT  LEFT$(PX$,26);"YES": GOTO 670
  65. 650  IF H$ < >"N"  THEN 610
  66. 660  VTAB 15: HTAB 9: PRINT  LEFT$(PX$,26);"NO"
  67. 670  VTAB 5: HTAB 9: PRINT  LEFT$(PX$,26);PP: VTAB 7: HTAB 10: PRINT  LEFT$(PX$,25);LL
  68. 680  VTAB 13: HTAB 5: PRINT PX$;YR
  69. 690  VTAB 9: HTAB 15: PRINT  LEFT$(PX$,20); LEFT$(B$(M1),3): VTAB 11: HTAB 13: PRINT  LEFT$(PX$,22); LEFT$(B$(M2),3)
  70. 700  VTAB 2: HTAB 1: CALL  -868: VTAB 1: HTAB 1: PRINT "DATA HAS BEEN ENTERED AS FOLLOWS:"
  71. 710  VTAB 20: HTAB 1: PRINT "DEPRESS: A TO ACCEPT DATA": VTAB 21: HTAB 10: PRINT "R TO REENTER DATA"
  72. 720  VTAB 23: HTAB 27: PRINT "...";: GET A$: PRINT : IF A$ = "R"  OR A$ =  CHR$(114)  THEN 450
  73. 730  IF A$ < >"A"  AND A$ < > CHR$(97)  THEN 720
  74. 740  IF H$ = "Y"  THEN 770
  75. 750  IF G$ = "N"  THEN 770
  76. 760  PRINT : PRINT D$;"PR#"S8
  77. 770 N =  FN A(.985647):EP =  FN A(23.441754)
  78. 780 A(13) = 365
  79. 790  IF YR < >4 * INT(YR/4) GOTO 810
  80. 800  FOR I = 3 TO 13:A(I) = A(I) +1: NEXT I
  81. 810  FOR J = M1 TO M2
  82. 820  HOME : PRINT  CHR$(12): VTAB 1
  83. 830  IF G$ = "N"  AND H$ = "N"  THEN 970
  84. 840  IF H$ = "N"  THEN 860
  85. 850  PRINT D$;"PR#"PS: PRINT  CHR$(9)"80N"
  86. 860  PRINT  TAB( 40 - LEN(B$(J))/2);B$(J);" ";YR
  87. 870  PRINT 
  88. 880 DS$ = "": IF J >3  AND J <11  THEN DS$ = "ADD ONE HOUR IF DAYLIGHT SAVINGS TIME IS IN EFFECT."
  89. 890  PRINT : PRINT DS$: PRINT 
  90. 900  PRINT "           MORNING                      EVENING    LENGTH     EQUATION"
  91. 910  REM  # OF SPACES IN ABOVE LINE = 11/22/4/5
  92. 920  PRINT "           TWILIGHT                     TWILIGHT   OF         OF"
  93. 930  REM  # OF SPACES IN ABOVE LINE = 11/21/3/9
  94. 940  PRINT "    DAY    BEGINS    SUNRISE   SUNSET   ENDS       TWILIGHT   TIME       DAY"
  95. 950  REM  # OF SPACES IN ABOVE LINE = 4/4/4/3/3/7/3/7
  96. 960  GOTO 1060
  97. 970  IF H$ = "N"  THEN 990
  98. 980  PRINT D$;"PR#"PS: PRINT  CHR$(9)"80N"
  99. 990  PRINT  TAB( 20 - LEN(B$(J))/2);B$(J);" ";YR
  100. 1000  PRINT 
  101. 1010 DS$ = "": IF J >3  AND J <11  THEN DS$ = "ADD ONE HOUR IF DST IS IN EFFECT."
  102. 1020  PRINT : PRINT DS$: PRINT 
  103. 1030  PRINT  TAB( 5);"MORNING"; TAB( 29);"EVENING"
  104. 1040  PRINT  TAB( 5);"TWILIGHT"; TAB( 29);"TWILIGHT"
  105. 1050  PRINT "DAY"; TAB( 5);"BEGINS"; TAB( 14);"SUNRISE"; TAB( 22);"SUNSET"; TAB( 29);"ENDS"; TAB( 38);"DAY";
  106. 1060  PRINT 
  107. 1070  FOR I = 1 TO A(J +1) -A(J)
  108. 1080 LA = (I +A(J)) *N +LX
  109. 1090 DE =  FN D( SIN(EP) * SIN(LA))
  110. 1100 E =  -105.3 * SIN(LA) +596.2 * SIN(2 *LA) +4.3 * SIN(3 *LA) -12.7 * SIN(4 *LA) -429.2 * COS(LA) -2.1 * COS(2 *LA) +19.3 * COS(3 *LA)
  111. 1110 HS =  FN C(( COS( FN A(90 +5/6)) - SIN(P) * SIN(DE))/( COS(P) * COS(DE)))
  112. 1120 YY = ( COS( FN A(108)) - SIN(P) * SIN(DE))/( COS(P) * COS(DE))
  113. 1130  IF  ABS(YY) >1  THEN YY = 0:HT = 0: GOTO 1150
  114. 1140 HT =  FN C(YY)
  115. 1150 HS =  FN B(HS)/15
  116. 1160 HT =  FN B(HT)/15
  117. 1170 SR = 12 -HS -E/3600 +L
  118. 1180 SS = 12 +HS -E/3600 +L
  119. 1190 TR = 12 -HT -E/3600 +L
  120. 1200 TS = 12 +HT -E/3600 +L
  121. 1210 TL =  ABS(HS -HT)
  122. 1220 E = E/60
  123. 1230  IF G$ = "N"  AND H$ = "N"  THEN 1250
  124. 1240  PRINT  LEFT$("     ",4 +(I <10));: REM 5 SPACES
  125. 1250  PRINT I;
  126. 1260  IF HT = 0  THEN X$ = " N/A ": GOTO 1290
  127. 1270 X = TR: GOSUB 240: GOSUB 90
  128. 1280  IF TR <1  THEN X$ = "0" +X$
  129. 1290  IF G$ = "N"  AND H$ = "N"  THEN 1320
  130. 1300  PRINT  LEFT$("      ",5 +(TR <10));X$;: REM 6 SPACES
  131. 1310  GOTO 1330
  132. 1320  PRINT  TAB( 5);X$;
  133. 1330 X = SR: GOSUB 240: GOSUB 90
  134. 1340  IF G$ = "N"  AND H$ = "N"  THEN 1370
  135. 1350  PRINT  LEFT$("      ",5 +(SR <10));X$;: REM 6 SPACES
  136. 1360  GOTO 1380
  137. 1370  PRINT  TAB( 14);X$;
  138. 1380 X = SS: GOSUB 240: GOSUB 90
  139. 1390  IF G$ = "N"  AND H$ = "N"  THEN 1420
  140. 1400  PRINT  LEFT$("      ",5 +(SS <10));X$;: REM 6 SPACES
  141. 1410  GOTO 1430
  142. 1420  PRINT  TAB( 22);X$;
  143. 1430  IF HT = 0  THEN X$ = " N/A ": GOTO 1480
  144. 1440  IF TS >24  THEN TS = TS -24
  145. 1450 X = TS: GOSUB 240: GOSUB 90
  146. 1460  IF HT = 0  THEN X$ = " N/A ": GOTO 1480
  147. 1470  IF TS <1  THEN X$ = "00" +X$
  148. 1480  IF G$ = "N"  AND H$ = "N"  THEN 1510
  149. 1490  PRINT  LEFT$("     ",4 +(TS <10));X$;: REM 5 SPACES
  150. 1500  GOTO 1530
  151. 1510  PRINT  TAB( 29);X$;
  152. 1520  IF G$ = "N"  AND H$ = "N"  THEN 1640
  153. 1530  IF HT = 0  THEN X$ = " N/A ": GOTO 1550
  154. 1540 X = TL: GOSUB 240: GOSUB 90
  155. 1550  PRINT  LEFT$("      ",5 +(TL <10));X$;: REM 6 SPACES
  156. 1560 X = E: GOSUB 240: GOSUB 90:UE = 0
  157. 1570  IF  LEFT$(X$,1) = "-"  THEN X$ =  RIGHT$(X$, LEN(X$) -1):UE = 1
  158. 1580  IF X3 <10  THEN X$ = "0" +X$
  159. 1590  IF X3 = 0  THEN X$ = "0" +X$
  160. 1600  IF UE = 1  THEN X$ = "-" +X$
  161. 1610  PRINT  LEFT$("        ",8 -(E <0));X$;: REM 8 SPACES
  162. 1620  PRINT "     ";I: REM 5 SPACES
  163. 1630  GOTO 1650
  164. 1640  PRINT  TAB( 38);I
  165. 1650  IF H$ = "Y"  THEN 1710
  166. 1660  IF I/11 < > INT(I/11)  THEN 1710
  167. 1670  VTAB 22: PRINT "<RETURN> TO CONTINUE, <ESC> TO STOP";: POKE  -16368,0: WAIT  -16384,128: IF  PEEK( -16384) = 155  THEN I = A(J +1) -A(J): NEXT I:J = M2: GOTO 1750
  168. 1680  VTAB 9: HTAB 1
  169. 1690  IF G$ = "Y"  THEN  PRINT  CHR$(11): GOTO 1710
  170. 1700  CALL  -958: VTAB 10: HTAB 1
  171. 1710  NEXT I
  172. 1720  IF H$ = "Y"  THEN 1750
  173. 1730  IF I < >32  AND I < >29  AND I < >30  THEN 1750
  174. 1740  VTAB 22: POKE  -16368,0: PRINT "<RETURN> TO CONTINUE, <ESC> TO STOP";: WAIT  -16384,128: IF  PEEK( -16384) = 155  THEN J = M2
  175. 1750  NEXT J
  176. 1760  IF H$ = "Y"  THEN  PRINT D$"PR#"S8
  177. 1770  PRINT : POKE  -16368,0: PRINT "ANOTHER (Y/N)? ";: GET A$: PRINT 
  178. 1780  IF A$ < >"N"  AND A$ < > CHR$(110)  THEN 450
  179. 1790  END 
  180. 1800  DATA  0,JANUARY,31,FEBRUARY,59,MARCH,90,APRIL,120,MAY,151,JUNE,181,JULY,212,AUGUST,243,SEPTEMBER,273,OCTOBER,304,NOVEMBER,334,DECEMBER
  181. 1810  VTAB 13: HTAB 1: PRINT "YEAR..............";YR;: REM 14 PERIODS
  182. 1820  HTAB 19: INPUT "";YR$: ON YR$ = "" GOTO 1830:YR =  VAL(YR$)
  183. 1830  VTAB 13: HTAB 19: PRINT YR: ON YR < -4000  OR YR >2800 GOTO 1810:C = 0: IF YR <0  THEN C =  -.75
  184. 1840 B = 2 - INT(YR/100) + INT( INT(YR/100)/4): IF YR <1583  THEN B = 0
  185. 1850 JD =  INT(365.25 *YR +C) +428.4014 +1720994.5 +B
  186. 1860 U = (JD -2451545)/3652500
  187. 1870 XT = 0
  188. 1880  FOR I = 1 TO 50
  189. 1890 XX = L(I) * SIN(AL(I) +NU(I) *U)
  190. 1900 XT = XT +XX
  191. 1910  NEXT I
  192. 1920 LX = 4.9353929 +62833.196168 *U +XT *.0000001: REM 6 ZEROS
  193. 1930  RETURN 
  194. 1940  DATA  403406,195207,119433,112392,3891,2819,1721,0,660,350,334,314,268,242,234,158,132,129,114,99,93,86,78,72,68
  195. 1950  DATA  64,46,38,37,32,29,28,27,27,25,24,21,21,20,18,17,14,13,13,13,12,10,10,10,10
  196. 1960  DATA  4.721964,5.937458,1.115589,5.781616,5.5474,1.512,4.1897,1.163,5.415,4.315,4.553,5.198,5.989,2.911,1.423,.061
  197. 1970  DATA  2.317,3.193,2.828,.52,4.65,4.35,2.75,4.5,3.23,1.22,.14,3.44,4.37,1.14,2.84,5.96,5.09,1.72,2.56,1.92,.09,5.98
  198. 1980  DATA  4.03,4.27,.79,4.24,2.01,2.65,4.98,.93,2.21,3.59,1.5,2.55
  199. 1990  DATA  1.621043,62830.348067,62830.821524,62829.634302,125660.5691,125660.9845,62832.4766,.813,125659.31,57533.85
  200. 2000  DATA  -33.931,777137.715,78604.191,5.412,39302.098,-34.861,115067.698,15774.337,5296.67,58849.27,5296.11,-3980.7
  201. 2010  DATA  52237.69,55076.47,261.08,15773.85,188491.03,-7756.55,264.89,117906.27,55075.75,-7961.39,188489.81,2132.19
  202. 2020  DATA  109771.03,54868.56,25443.93,-55731.43,60697.74,2132.79,109771.63,-7752.82,188491.91,207.81,29424.63,-7.99,46941.14,-68.29,21463.25,157208.4
  203. 2030  POKE 216,0: CALL  -3288: HOME : PRINT  CHR$(21): VTAB 12: PRINT "ERROR " PEEK(222)" IN LINE " PEEK(218) +256 * PEEK(219)"."