DECLARE SUB REFLECT (THTA!, M2!, MS!, B2!, BS!, X2!, X1!, Y2!, Y1!)
10 REM PROGRAM STANHALO
20 REM THIS PROGRAM AIMS A BEAM AT A ROTATING HEXAGONAL ICE CRYSTAL
30 REM TO SHOW PATH OF RAYS FOR THE 22ø HALO   CHOOSE INITIAL BEAM
40 REM ICE CRYSTAL IS INSCRIBED IN A CIRCLE (NORMAL TO RAY)
50 REM STARTED 18 JUNE 92 - VERSION 22 JUNE 92
100 XC = 320: YC = 200: RC = 100
110 PI = 3.141593: DRC = PI / 180
120 NRF = 1.31: REM INDEX OF REFRACTION OF ICE
130 DYR1 = .55 * RC: YR1 = YC - DYR1: REM LATER DYR1/RC = RND
140 XR0 = 10: XRF = 600
HUE = 2
190 CLS : SCREEN 12
200 FOR I = 31 TO 60
REM ****************************
FOR DYR1 = 0 TO .95 * RC STEP .05 * RC
YR1 = YC - DYR1
CTR = 1
HUE = 2

REM *****************************
210 FOR J = 1 TO 6
220 THTA(J) = I * DRC + (J - 1) * PI / 3 + .0001
230 X(J) = XC - RC * COS(THTA(J)): Y(J) = YC - RC * SIN(THTA(J))
290 NEXT J
300 FOR J = 1 TO 5: REM CRYSTAL OUTLINES
310 LINE (X(J), Y(J))-(X(J + 1), Y(J + 1))
320 M(J) = (Y(J + 1) - Y(J)) / (X(J + 1) - X(J))
330 B(J) = Y(J) - M(J) * X(J)
350 NEXT J
360 M(6) = (Y(1) - Y(6)) / (X(1) - X(6))
370 B(6) = Y(6) - M(6) * X(6)
380 LINE (X(6), Y(6))-(X(1), Y(1))
390 IF YR1 < Y(2) THEN LINE (XR0, YR1)-(600, YR1), HUE: GOTO 1940
400 IF YR1 < Y(1) THEN CH1 = 1 ELSE CH1 = 6
410 XR1 = (YR1 - B(CH1)) / M(CH1)
420 I1 = THTA(CH1) + PI / 6
470 LINE (XR0, YR1)-(XR1, YR1), 2
490 Q1 = SIN(I1) / NRF
500 R1 = ATN(Q1 / SQR(1 - Q1 ^ 2))
510 IF CH1 = 1 THEN THR2 = I1 - R1: HUE = 11
520 IF CH1 <> 1 THEN THR2 = I1 - R1 - 2 * PI: HUE = 9
530 CH2 = 3
540 MR2 = TAN(THR2)
550 BR2 = YR1 - MR2 * XR1
560 XR2 = (B(CH2) - BR2) / (MR2 - M(CH2))
570 YR2 = MR2 * XR2 + BR2
580 IF YR2 < Y(3) THEN CH2 = 2
585 IF YR2 > Y(4) THEN CH2 = 4
590 XR2 = (B(CH2) - BR2) / (MR2 - M(CH2))
600 YR2 = MR2 * XR2 + BR2
610 LINE (XR1, YR1)-(XR2, YR2), HUE
700 REM IF CH1 = 1 AND CH2 = 2 GOTO 1940
710 R2 = THR2 - (THTA(CH2) - 5 * PI / 6)
730 Q2 = NRF * SIN(R2)
IF ABS(CH2 - CH1) = 3 THEN HUE = 2 ELSE HUE = 4
735 IF ABS(Q2) < 1 THEN
740 I2 = ATN(Q2 / SQR(1 - Q2 ^ 2))
750 THR3 = THR2 + I2 - R2
760 XR3 = XRF: CH3 = 0
775 ELSE
HUE = 14
780 THR3 = THR2 + PI - 2 * R2
790 CH3 = CH2 + 1
795 END IF
799 REM PRINT THR3 / DRC
800 MR3 = TAN(THR3)
810 BR3 = YR2 - MR3 * XR2
820 IF CH3 > 0 THEN XR3 = (B(CH3) - BR3) / (MR3 - M(CH3))
830 YR3 = MR3 * XR3 + BR3
840 LINE (XR2, YR2)-(XR3, YR3), HUE
845 IF ABS(Q2) >= 1 THEN
850 CH4 = CH3 + 1
860 R3 = 2 * PI / 3 - R2
870 THR4 = THR3 + PI - 2 * R3
880 MR4 = TAN(THR4)
890 BR4 = YR3 - MR4 * XR3
900 XR4 = (B(CH4) - BR4) / (MR4 - M(CH4))
905 IF XR4 < X(CH4 + 1) THEN CH4 = CH3 + 2
910 XR4 = (B(CH4) - BR4) / (MR4 - M(CH4))
920 YR4 = MR4 * XR4 + BR4
930 HUE = 13
950 LINE (XR3, YR3)-(XR4, YR4), HUE
955 IF CH4 = CH3 + 1 THEN
960 R4 = 2 * PI / 3 - R3: CH5 = CH4 + 1: HUE = 12
970 THR5 = THR4 + PI - 2 * R4
980 CALL REFLECT(THR5, MR5, M(CH5), BR5, B(CH5), XR5, XR4, YR5, YR4)
985 IF XR5 < X(CH5 + 1) THEN
990 CH5 = CH4 + 2
995 IF CH5 > 6 THEN CH5 = CH5 - 6
1000 XR5 = (B(CH5) - BR5) / (MR5 - M(CH5))
1010 YR5 = MR5 * XR5 + BR5
1015 END IF
1030 LINE (XR4, YR4)-(XR5, YR5), HUE
1035 END IF

1095 END IF
1940 NEXT DYR1
1942 WHILE INKEY$ = "": WEND
1950 CLS
1990 NEXT I

1200 SUB REFLECT (THTA, M2, MS, B2, BS, X2, X1, Y2, Y1)
1230 M2 = TAN(THTA)
1240 B2 = Y1 - M2 * X1
1250 X2 = (BS - B2) / (M2 - MS)
1290 Y2 = M2 * X2 + B2

END SUB