home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib38b.dsk / RAINBOW.bas < prev    next >
BASIC Source File  |  2023-02-26  |  4KB  |  114 lines

  1. 10  REM  *******************************
  2. 20  REM  * RAINBOW                     *
  3. 30  REM  * BY WHITNEY HARRIS           *
  4. 40  REM  * COPYRIGHT(C) 1990           *
  5. 50  REM  * MINDCRAFT PUBL. CORP.       *
  6. 60  REM  * CONCORD, MA 01742           *
  7. 70  REM  *******************************
  8. 80  TEXT : HOME : POKE 49168,0: PRINT  CHR$(17)
  9. 90  HTAB 4: PRINT "RAINBOW BY WHITNEY HARRIS": HTAB 2: PRINT "COPYRIGHT(C) 1990 MINDCRAFT PUBL. CORP.": VTAB 6
  10. 100  PRINT "TYPE 1 THEN (RETURN) FOR FIRST PLOT. "
  11. 110  PRINT "TYPE 2 THEN (RETURN) FOR SECOND PLOT. ": PRINT 
  12. 120  PRINT "TYPE ESCAPE TO QUIT. ": PRINT 
  13. 130  VTAB 22: HTAB 10: PRINT "ENTER NUMBER";
  14. 140  GET Q$:Q =  VAL(Q$)
  15. 150  IF Q = 1  THEN 210
  16. 160  IF Q = 2  THEN 990
  17. 170  IF Q$ =  CHR$(27)  THEN  HOME : END 
  18. 180  GOTO 1140
  19. 190  REM  *******************************
  20. 200  REM  PLOT #1, "WHITE LIGHT"
  21. 210  GOSUB 270
  22. 220  GOTO 440
  23. 230  REM  *******************************
  24. 240  REM  SUBROUTINE TO PLOT A CIRCLE
  25. 250  REM  IN POLAR COORDINATES.  N IS
  26. 260  REM  NUMBER OF POINTS.  R IS RADIUS.
  27. 270  HOME : HGR2 : HCOLOR= 3
  28. 280  LET PI = 3.14159:F = 1.15
  29. 290  LET X0 = 190:Y0 = 70
  30. 300  LET N = 500:R = 70
  31. 310  LET S = 2 *PI/N
  32. 320  REM   LOOP TO INCREASE ANGLE,
  33. 330  REM  THEN CHANGE TO CARTESIAN
  34. 340  REM  COORDINATES AND PLOT.
  35. 350  FOR A = 0 TO 2 *PI  STEP S
  36. 360  IF  PEEK(49152) = 155  THEN 80
  37. 370  LET X = R * COS(A):Y = R * SIN(A)
  38. 380  HPLOT X0 +F *X,Y0 -Y
  39. 390  NEXT A
  40. 400  RETURN 
  41. 410  REM *******************************
  42. 420  REM        SNELL'S  LAW
  43. 430  REM   SIN(I)/SIN(R) = REFRACTION INDEX = U
  44. 440  LET U = 1.333
  45. 450  REM *******************************
  46. 460  REM  LOOP BASED ON POINTS OF INCIDENCE
  47. 470  FOR SY = Y0 -5 TO 1  STEP  -4
  48. 480  IF  PEEK(49152) = 155  THEN 80
  49. 490  GOSUB 570
  50. 500  GOSUB 660
  51. 510  NEXT SY
  52. 520  HPLOT 154,186 TO 260,186
  53. 530  GET Q$: IF Q$ =  CHR$(27)  THEN 80
  54. 540  GOTO 530
  55. 550  REM *******************************
  56. 560  REM   SUBROUTINE TO PLOT INCOMING RAY
  57. 570  HCOLOR= 3
  58. 580  LET YA = Y0 -SY
  59. 590  LET XA =  - SQR(R ^2 -YA ^2)
  60. 600  LET SX = X0 +F *XA
  61. 610  REM  PLOT INCOMING RAY
  62. 620  HPLOT 0,SY TO SX,SY
  63. 630  RETURN 
  64. 640  REM ******************************* 
  65. 650  REM   SUBROUTINE TO TRACE RAY THROUGH RAINDROP.
  66. 660  LET SI = YA/R:SR = SI/U
  67. 670  DEF  FN ASN(X) =  ATN(X/ SQR( -X *X +1))
  68. 680  LET IANGLE =  FN ASN(SI)
  69. 690  LET RANGLE =  FN ASN(SR)
  70. 700  LET BANGLE = 2 *RANGLE -IANGLE
  71. 710  LET XB = R * COS(BANGLE)
  72. 720  LET YB = R * SIN(BANGLE)
  73. 730  REM   PLOT SEGMENT FROM POINT OF
  74. 740  REM  INCIDENCE TO POINT OF REFLECTION
  75. 750  HPLOT X0 +F *XA,Y0 -YA TO X0 +F *XB,Y0 -YB
  76. 760  REM  FIND POINT OF EMERGENCE
  77. 770  LET CANGLE = 4 *RANGLE -IANGLE -PI
  78. 780  LET XC = R * COS(CANGLE)
  79. 790  LET YC = R * SIN(CANGLE)
  80. 800  REM   PLOT SEGMENT FROM POINT OF REFLECTION
  81. 810  REM   TO POINT OF EMERGENCE.
  82. 820  HPLOT X0 +F *XB,Y0 -YB TO X0 +F *XC,Y0 -YC
  83. 830  REM  SLOPE OF OUTGOING RAY.
  84. 840  LET M =  TAN(CANGLE -IANGLE)
  85. 850  REM  LOOP TO CALCULATE EQUATION
  86. 860  REM  OF RAY, THEN PLOT IT.
  87. 870  LET X = XC
  88. 880  LET Y = M *(X -XC) +YC
  89. 890  REM  CONDITION TO TERMINATE RAY.
  90. 900  IF X ^2 +Y ^2 >120 ^2  THEN 950
  91. 910  HPLOT X0 +F *X,Y0 -Y
  92. 920  IF  PEEK(49152) = 155  THEN 80
  93. 930  LET X = X -1
  94. 940  GOTO 880
  95. 950  RETURN 
  96. 960  REM *******************************
  97. 970  REM  PLOT #2, REFRACTION OF COLORS
  98. 980  REM ******************************* 
  99. 990  GOSUB 270
  100. 1000  LET SY = 5
  101. 1010  GOSUB 570
  102. 1020  RESTORE 
  103. 1030  FOR N = 1 TO 4
  104. 1040  IF  PEEK(49152) = 155  THEN 80
  105. 1050  READ H,INDEX
  106. 1060  HCOLOR= H:U = INDEX
  107. 1070  GOSUB 660
  108. 1080  NEXT N
  109. 1090  GET Q$: IF Q$ =  CHR$(27)  THEN 80
  110. 1100  GOTO 1090
  111. 1110  REM *******COLOR CODES*******
  112. 1120  REM  ORANGE=5,GREEN=1,BLUE=6,VIOLET=2
  113. 1130  DATA    5,1.29,1,1.31,6,1.33,2,1.35  
  114. 1140  END