2.7 Листинг программы

'ИСХОДНЫЕ ДАННЫЕ

DATA 22,18,565,129,562,58,245,279, 97,81,183,387,3

READ XD, YD, XE, YE, XF, YF, XG, YG, XH, YH, XI, YI

READ NV

'КООРДИНАТЫ ВЕРШИН

CALL LINES(XD, YD, XE, YE, XH, YH, XI, YI, X1, Y1)

CALL LINES(XD, YD, XE, YE, XF, YF, XG, YG, X2, Y2)

CALL LINES(XF, YF, XG, YG, XH, YH, XI, YI, X3, Y3)

SCREEN 12

VIEW (0, 0)-(479, 479)

WINDOW (0, 0)-(500, 500)

PRINT USING "A: ###;###"; X1; Y1

PRINT USING "B: ###;###"; X2; Y2

PRINT USING "C: ###;###"; X3; Y3

LINE (X1, Y1)-(X2, Y2)

LINE (X2, Y2)-(X3, Y3)

LINE (X1, Y1)-(X3, Y3)

'ВЫЧИСЛЕНИЕ ПЛОЩАДИ ТРЕУГОЛЬНИКА

X(1) = X1: Y(1) = Y1

X(2) = X3: Y(2) = Y3

X(3) = X2: Y(3) = Y2

X(4) = X1: Y(4) = Y1

CALL STREUG(X(), Y(), S)

A = SQR((X1 - X2) ^ 2 + (Y1 - Y2) ^ 2)

B = SQR((X3 - X2) ^ 2 + (Y3 - Y2) ^ 2)

C = SQR((X3 - X1) ^ 2 + (Y3 - Y1) ^ 2)

P = (A + B + C) / 2

RO = S / P

'****************************************************************

'ОПРЕДЕЛЕНИЕ КООРДИНАТ ЦЕНТРА 1 ОКРУЖНОСТИ

XC = X(1)

YC = Y(1)

R = 50

A = X(1): B = X(1) + R

CALL BISECT(XC, YC, R, X(1), Y(1), X(2), Y(2), A, B, XP1, YP1, 1, 1)

A = X(1): B = X(1) + R

CALL BISECT(XC, YC, R, X(1), Y(1), X(3), Y(3), A, B, XP2, YP2, 1, 1)

X = (XP1 + XP2) / 2

Y = (YP1 + YP2) / 2

K1 = (Y(1) - Y) / (X(1) - X)

B1 = Y - K1 * X

XC = X(3)

YC = Y(3)

R = 50

A = X(3) - R: B = X(3)

CALL BISECT(XC, YC, R, X(3), Y(3), X(2), Y(2), A, B, XP1, YP1, 2, 1)

A = X(3) - R: B = X(3)

CALL BISECT(XC, YC, R, X(1), Y(1), X(3), Y(3), A, B, XP2, YP2, 1, -1)

X = (XP1 + XP2) / 2

Y = (YP1 + YP2) / 2

K2 = (Y(3) - Y) / (X(3) - X)

B2 = Y - K2 * X

XC = (B2 - B1) / (K1 - K2) ' КООРДИНАТЫ ЦЕНТРА

YC = K1 * XC + B1

'*****************************************************************

'ВТОРАЯ ОКРУЖНОСТЬ

K3 = (Y(2) - YC) / (X(2) - XC)

B3 = YC - K3 * XC

H = .01

SELECT CASE NV

CASE 1

A = X(1)

B = XC

KB = K1

BB = B1

X1 = X(1)

Y1 = Y(1)

X2 = X(2)

Y2 = Y(2)

CASE 2

A = X(2)

B = XC

KB = K3

BB = B3

X1 = X(1)

Y1 = Y(1)

X2 = X(2)

Y2 = Y(2)

CASE 3

A = XC

B = X(3)

KB = K2

BB = B2

X1 = X(3)

Y1 = Y(3)

X2 = X(2)

Y2 = Y(2)

END SELECT

FOR XC1 = A TO B STEP H

YC1 = KB * XC1 + BB

R1 = FLP(X1, Y1, X2, Y2, XC1, YC1)

'РАССТОЯНИЕ ДО ОКРУЖНОСТИ

LL = SQR((XC - XC1) ^ 2 + (YC - YC1) ^ 2) - RO

IF ABS(LL - R1) < .1 THEN EXIT FOR

NEXT XC1

'*****************************************************************

'ШТРИХОВКА

CALL HATCH(X(), Y())

CIRCLE (XC, YC), RO

CIRCLE (XC1, YC1), R1

PRINT USING "R1=###"; RO

PRINT USING "XC1=### YC1=###"; XC; YC

PRINT USING "R2=###"; R1

PRINT USING "XC2=### YC2=###"; XC1; YC1

SF = S - 3.14159 * RO ^ 2 - 3.14159 * R1 ^ 2

PRINT USING "S=#####"; SF

END

'*****************************************************************

SUB BISECT (XC, YC, R, X1, Y1, X2, Y2, A, B, XP, YP, Z, S)

'МЕТОД БИСЕКЦИЙ ДЛЯ ОПРЕДЕЛЕНИЯ КООРДИНАТЫ

'ТОЧКИ ПЕРЕСЕЧЕНИЯ ПРЯМОЙ И ОКРУЖНОСТИ

'*****************************************************************

K1 = (Y2 - Y1) / (X2 - X1)

B1 = Y1 - K1 * X1

DO

X11 = (A + B) / 2

Y11 = K1 * X11 + B1

Y12 = YC + S * SQR(R ^ 2 - (X11 - XC) ^ 2)

IF Z = 1 THEN

IF Y11 > Y12 THEN B = X11

IF Y11 < Y12 THEN A = X11

ELSE

IF Y11 > Y12 THEN A = X11

IF Y11 < Y12 THEN B = X11

END IF

LOOP UNTIL ABS(Y11 - Y12) < .001

XP = (A + B) / 2

YP = K1 * XP + B1

END SUB

FUNCTION FLP (X1, Y1, X2, Y2, X3, Y3)

' ОПРЕДЕЛЕНИЕ РАССТОЯНИЯ

'*****************************************************************

STATIC K, B, K1, B1, A1, A2, Y0

K = (Y2 - Y1) / (X2 - X1)

B = Y1 - K * X1

K1 = -1 / K

B1 = Y3 - K1 * X3

XT = (B1 - B) / (K - K1)

YT = K * XT + B

FLP = SQR((XT - X3) ^ 2 + (YT - Y3) ^ 2)

END FUNCTION

'*****************************************************************

SUB HATCH (X(), Y())

' ПРОЦЕДУРА ШТРИХОВКИ ТРЕУГОЛЬНИКА

' ЗАДАННОГО МАССИВАМИ КООРДИНАТ ВЕРШИН X,Y

'****************************************************************

X(4) = X(1)

Y(4) = Y(1)

DIM XP(2), YP(2)

X1 = -200: Y1 = 0: X2 = -100: Y2 = 470: L = 10

DO 'ЦИКЛ ШТРИХОВКИ

K = (Y2 - Y1) / (X2 - X1)'КОЭФФИЦИЕНТЫ БАЗОВОЙ ПРЯМОЙ

B = Y1 - K * X1

N = 0'ЧИСЛО ТОЧЕК ПЕРЕСЕЧЕНИЯ

FOR I = 1 TO 3

K1 = (Y(I + 1) - Y(I)) / (X(I + 1) - X(I))

B1 = Y(I) - K1 * X(I)

IF K1 <> K THEN 'ПЕРЕСЕЧЕНИЕ ЕСТЬ

IF X(I) > X(I + 1) THEN

MIN = X(I + 1)'КРАЙНИЕ ТОЧКИ ИНТЕРВАЛА

MAX = X(I)

ELSE

MIN = X(I)

MAX = X(I + 1)

END IF

XA = MIN'ИНТЕРВАЛ ДЛЯ МЕТОДА БИСЕКЦИЙ

XB = MAX

J = 0'ЧИСЛО ИТЕРАЦИЙ

DO

X0 = (XA + XB) / 2'СЕРЕДИНА

Y11 = K * X0 + B

Y12 = K1 * X0 + B1

IF Y11 > Y12 THEN XB = X0 ELSE XA = X0

J = J + 1

LOOP UNTIL ABS(Y11 - Y12) < .001 OR J = 100

IF J <> 100 THEN 'ПЕРЕСЕЧЕНИЕ В ПРЕДЕЛАХ ВИДИМОЙ ЧАСТИ

IF X0 >= MIN AND X0 <= MAX THEN

N = N + 1

XP(N) = X0 'ЗАПОМНИТЬ

YP(N) = K * XP(N) + B

END IF

END IF

END IF

NEXT I

IF N = 2 THEN

LINE (XP(1), YP(1))-(XP(2), YP(2)), 7

END IF

X1 = X1 + L'ПЕРЕДВИНУТЬ БАЗОВУЮ ПРЯМУЮ

X2 = X2 + L

LOOP UNTIL X1 > 640

END SUB

'*****************************************************************

SUB LINES (X1, Y1, X2, Y2, X3, Y3, X4, Y4, XP, YP)

UA = ((X4 - X3) * (Y1 - Y3) - (Y4 - Y3) * (X1 - X3)) / ((Y4 - Y3) * (X2 - X1) - (X4 - X3) * (Y2 - Y1))

XP = X1 + UA * (X2 - X1)

YP = Y1 + UA * (Y2 - Y1)

END SUB

'*****************************************************************

SUB STREUG (X(), Y(), S)

' ПОДПРОГРАММА ОПРЕДЕЛЕНИЯ ПЛОЩАДИ ТРЕУГОЛЬНИКА МЕТОДОМ ТРАПЕЦИЙ

' X,Y - КООРДИНАТЫ ВЕРШИН ТРЕУГОЛЬНИКА

' S- ПЛОЩАДЬ ТРЕУГОЛЬНИКА

'*****************************************************************

S = 0

FOR I = 1 TO 3

IF X(I) <= X(I + 1) THEN A = X(I): B = X(I + 1): Z = 1

IF X(I) > X(I + 1) THEN B = X(I): A = X(I + 1): Z = -1

N = 1000

H = (B - A) / N

S1 = 0

X = A

X1 = A + H

K11 = (Y(I + 1) - Y(I)) / (X(I + 1) - X(I))

B11 = Y(I) - K11 * X(I)

WHILE X <= B

F1 = K11 * X + B11

F2 = K11 * X1 + B11

S1 = S1 + H * (F1 + F2) / 2

X = X1

X1 = X1 + H

WEND

S = S + Z * S1

NEXT I

END SUB