только имя. ничего, кроме имени.
программы для бесика:

Солнцеворот
читать дальше
Соул'ют(доработать)
читать дальше

Комментарии
25.05.2011 в 19:16

только имя. ничего, кроме имени.
Соул'ют (доработанный)
SCREEN 12
RANDOMIZE TIMER
n = 1500
g = 10
k = .1
DIM v(n), xs(n), ys(n), x(n), y(n) AS INTEGER
DIM a(n) AS DOUBLE
t = 0
FOR i = 1 TO n
xs(i) = x(i)
ys(i) = y(i)
a(i) = (RND(1) * 628) / 100 + 1
v(i) = RND(1) * 40 + 1
NEXT i

WHILE INKEY$ = ""


FOR i = 1 TO n
xs(i) = x(i)
ys(i) = y(i)
x(i) = v(i) * t * COS(a(i))
y(i) = v(i) * t * SIN(a(i)) + (g * t ^ 2 / 2)
NEXT i


FOR i = 1 TO n
PSET (a + xs(i), b + ys(i)), 0
NEXT i

FOR i = 1 TO n
PSET (a + x(i), b + y(i)), c
NEXT i


IF t > 4 THEN
FOR i = 1 TO n
PSET (a + x(i), b + y(i)), 0
NEXT i

t = 0
a = RND(1) * 600 + 1
b = RND(1) * 393 + 1
c = RND(1) * 14 + 1

END IF
t = t + .1
WEND
Соул'ют(с подпрогами)

DECLARE SUB NSCHALO ()
DECLARE SUB ZNACH (t!)
DECLARE SUB SOUL (a!, b!, c!)
SCREEN 12
RANDOMIZE TIMER
CONST n = 2500
CONST g = 10
CONST k = .1
DIM SHARED v(n), xs(n), ys(n), x(n), y(n) AS INTEGER
DIM SHARED a(n) AS DOUBLE
t = 0
CALL NSCHALO

a = RND(1) * 600 + 1
b = RND(1) * 393 + 1

WHILE INKEY$ = ""
CALL ZNACH(t)
CALL SOUL(a, b, c)
IF t > 4 THEN
FOR i = 1 TO n
PSET (a + x(i), b + y(i)), 0
NEXT i
t = 0
a = RND(1) * 600 + 1
b = RND(1) * 393 + 1
c = RND(1) * 14 + 1
END IF
t = t + .1
WEND


SUB LASTIK

IF t > 4 THEN
FOR i = 1 TO n
PSET (a + x(i), b + y(i)), 0
NEXT i
t = 0
a = RND(1) * 600 + 1
b = RND(1) * 393 + 1
c = RND(1) * 14 + 1

END IF

END SUB

SUB NSCHALO

FOR i = 1 TO n
xs(i) = x(i)
ys(i) = y(i)
a(i) = (RND(1) * 628) / 100 + 1
v(i) = RND(1) * 40 + 1
NEXT i

END SUB

SUB SOUL (a, b, c)

FOR i = 1 TO n
PSET (a + xs(i), b + ys(i)), 0
NEXT i

FOR i = 1 TO n
PSET (a + x(i), b + y(i)), c
NEXT i

END SUB

SUB ZNACH (t)

FOR i = 1 TO n
xs(i) = x(i)
ys(i) = y(i)
x(i) = v(i) * t * COS(a(i))
y(i) = v(i) * t * SIN(a(i)) + (g * t ^ 2 / 2)
NEXT i

END SUB
25.05.2011 в 19:18

только имя. ничего, кроме имени.
поля для МБ

DECLARE SUB OutM ()
DECLARE SUB Pole ()
DECLARE FUNCTION Test! (x!, y!, dx!, dy!, F AS INTEGER)
DECLARE SUB PutKor (x!, y!, dx!, dy!, F AS INTEGER)
CLS
CONST N = 11
DATA 4,3,3,2,2,1,1,1,1
DIM SHARED A(N, N) AS INTEGER
RANDOMIZE TIMER
Pole
OutM

SUB OutM
SCREEN 12
k = 23
Nk = N * k + 2
xN = 23: yN = 13
FOR i = 1 TO N - 1
FOR j = 1 TO N - 1
' PRINT A(i, j);
IF A(i, j) = 5 THEN A(i, j) = 0
IF A(i, j) > 0 AND A(i, j) < 5 THEN A(i, j) = 2
LINE (xN + k * i, yN + k * j)-(xN + k * i + k, yN + k * j + k), A(i, j), BF
NEXT j
' PRINT
NEXT i
FOR i = 1 TO N
LINE (xN + i * k, yN + k)-(xN + i * k, yN + k + (N - 1) * k)
LINE (xN + k, yN + i * k)-(xN + k + (N - 1) * k, yN + i * k)
NEXT i
LOCATE 2, 7: PRINT "A B C D E F G H K L"
FOR i = 1 TO 10
PRINT i
NEXT i
END SUB

SUB Pole
DIM x, y, dx, dy, k, c, F AS INTEGER

FOR k = 1 TO 9
READ F
1 :
c = INT(RND(1) * 4 + 1)
IF c = 1 THEN dx = 1: dy = 0
IF c = 2 THEN dx = -1: dy = 0
IF c = 3 THEN dx = 0: dy = -1
IF c = 4 THEN dx = 0: dy = 1
x = INT(RND(1) * N)
y = INT(RND(1) * N)
'PRINT "=>"; c, dx; dy
IF Test(x, y, dx, dy, F) = 1 THEN CALL PutKor(x, y, dx, dy, F) ELSE GOTO 1
NEXT k
END SUB

SUB PutKor (x, y, dx, dy, F AS INTEGER)
FOR i = 1 TO F
z = x + i * dx: k = y + i * dy: A(z, k) = F
NEXT i
FOR y = 1 TO N - 1
FOR x = 1 TO N - 1
IF A(y, x) = F THEN
'<
IF A(y - 1, x) = 0 THEN A(y - 1, x) = 5
IF A(y + 1, x) = 0 THEN A(y + 1, x) = 5
IF A(y, x + 1) = 0 THEN A(y, x + 1) = 5
IF A(y, x - 1) = 0 THEN A(y, x - 1) = 5
IF A(y - 1, x - 1) = 0 THEN A(y - 1, x - 1) = 5
IF A(y - 1, x + 1) = 0 THEN A(y - 1, x + 1) = 5
IF A(y + 1, x + 1) = 0 THEN A(y + 1, x + 1) = 5
IF A(y + 1, x - 1) = 0 THEN A(y + 1, x - 1) = 5
END IF
NEXT x
NEXT y
END SUB

FUNCTION Test (x, y, dx, dy, F AS INTEGER)
Test = 0: t = 0
' kraya
IF (x + F * dx) > 0 AND x + F * dx < N AND (y + F * dy) > 0 AND y + F * dy < N THEN t = 1
' drugie korabli
IF t = 1 THEN
FOR i = 1 TO F
IF A(x + i * dx, y + i * dy) <> 0 THEN t = 0
NEXT i
END IF
Test = t
END FUNCTION
25.05.2011 в 19:19

только имя. ничего, кроме имени.
пдпроги пишутся через SUB ИМЯ

Расширенная форма

Редактировать

Подписаться на новые комментарии
Получать уведомления о новых комментариях на E-mail