Форум программистов, компьютерный форум, киберфорум
Наши страницы
Basic
Войти
Регистрация
Восстановить пароль
 
Pro_grammer
Модератор
6213 / 2300 / 449
Регистрация: 24.04.2011
Сообщений: 4,116
Записей в блоге: 10
1

FreeBasic круги на воде

09.05.2018, 22:54. Просмотров 382. Ответов 5
Метки нет (Все метки)

Очень интересный код имитирующий распространение кругов на воде.
Описание алгоритма тут
Что меня удивило, обычно когда идет речь о построении окружности, то программист сразу думает о синусах и косинусах.
А тут вообще ни какой геометрии-тригонометрии. Просто массив, который изменяется по определённому закону.
Вообще всё это удивительная магия математики. Скорость распространения волн ни как не зависит от их кол-ва. Можно нащёлкать мышкой столько, на сколько хватит терпения. И каждая волна будет распространятся по своему закону, расширяясь и отражаясь от стен, но проходя сквозь другие волны.
В общем рекомендую полюбоваться (код для FB, в FBE Windows GUI) :
Название: 1234m.gif
Просмотров: 44

Размер: 192.3 Кб



QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
ScreenRes 600, 400
 
DIM i AS INTEGER,k AS INTEGER,j AS INTEGER
DIM TestMouse AS INTEGER, MouseX AS INTEGER, MouseY AS INTEGER,Buttons AS INTEGER
DIM Colors AS INTEGER
DIM AS INTEGER X = 600
DIM AS INTEGER Y = 400
DIM AS DOUBLE Dampening = 0.995
DIM Buffer(X*2-1,Y-1) AS DOUBLE
 PRINT "Right buttion - Exit"
 PRINT "Left buttion - Start "
 SLEEP 2000
 
DO UNTIL Buttons=2
    
    TestMouse=GetMouse(MouseX,MouseY,,Buttons)
IF Buttons=1 THEN
     Buffer(MouseX,MouseY)=20
EndIf   
 
    FOR k = 1 TO X-2
            i=k+X
            FOR j=1 TO Y-2
              Buffer(i,j)=((Buffer(k-1,j)+Buffer(k+1,j)+Buffer(k,j-1)+Buffer(k,j+1))*0.5-Buffer(i,j))*Dampening           
            NEXT
    NEXT
         
          FOR i = 1 TO X-2
            k=i+X
            FOR j=1 TO Y-2
              Buffer(i,j)=((Buffer(k-1,j)+Buffer(k+1,j)+Buffer(k,j-1)+Buffer(k,j+1))*0.5-Buffer(i,j))*Dampening   
                 Colors = INT(Buffer(i,j)*10)         
              PSET(i,j),RGB(Colors,Colors,Colors)
            NEXT
          NEXT
LOOP 
 
 SLEEP 300
Есть аналогичный код на PureBasic с оф. английского форума.
2
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
09.05.2018, 22:54
Ответы с готовыми решениями:

нужно написать вот такую программу: круги на воде
Очень нужна помощь, помогите пожалуйста: нужно написать вот такую программу: Круги на воде.Экран...

FreeBASIC
Заметил, что уже имеющиеся на форуме темы в разделах: - QBasic - Visual Basic - VBA - Pure...

FreeBASIC и сети
Здравствуй, форум. Всё дело в том, что есть одни сетевые функции, и для этих функций Я решил...

Графика FreeBasic
Приветствую всех cyber-форумчан!:) Несмотря на наличие графического треда в младшем разделе,...

Немного о FreeBasic
Чаще всего при начальном использовании какого-то языка , люди стараются выбрать простую,...

5
Quiet Snow
4416 / 1313 / 378
Регистрация: 25.04.2010
Сообщений: 3,413
11.05.2018, 13:43 2
Pro_grammer, спасибо за интересную прогу. Принцип бы поподробнее.
0
Pro_grammer
Модератор
6213 / 2300 / 449
Регистрация: 24.04.2011
Сообщений: 4,116
Записей в блоге: 10
11.05.2018, 16:54  [ТС] 3
Цитата Сообщение от Quiet Snow Посмотреть сообщение
Принцип бы поподробнее.
Quiet Snow, матрицы. Мы все живем в матрице, и круги на воде там уже кем то запрограммированы.
А если серьёзно, то я сам всего лишь прочитал гугло-перевод той статьи, ссылка на которую есть в первом сообщении, конкретно ни чего не понял, в частности, почему именно круги, а не скажем квадраты или звездочки, и решил, что это магия.
0
Quiet Snow
4416 / 1313 / 378
Регистрация: 25.04.2010
Сообщений: 3,413
11.05.2018, 18:31 4
Pro_grammer, я понял только одно, что основано оно на сглаживании с ядром в
виде матрицы из коэф-тов, а эмулировнаие идёт за счёт "контроля объёма воды", т.е.
в массиве мы имеем высоту водной поверхности. Довольно упрощённая эмуляция.
На вид прикольно. Попробовал цвета в порядок привести, т.е. динамический диапазон.
Надо изучить как оно работает. Мне нужны такие штуки.

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
DIM ix2 AS INTEGER, ix AS INTEGER, iy AS INTEGER
DIM TestMouse AS INTEGER, MouseX AS INTEGER, MouseY AS INTEGER,Buttons AS INTEGER
DIM Cv AS BYTE
DIM AS INTEGER X = 320
DIM AS INTEGER Y = 200
DIM AS DOUBLE Dampening = 0.995
DIM Bf(X * 2 - 1,Y - 1) AS DOUBLE
 PRINT "Right buttion - Exit"
 PRINT "Left buttion - Start "
 'SLEEP 2000
 
SCREENRES X, Y, 32, 2
SCREENSET 1, 0
DO
    
    TestMouse = GetMouse(MouseX,MouseY,,Buttons)
IF Buttons = 1 THEN
     Bf(MouseX,MouseY) = 1
ENDIF   
 
FOR ix = 1 TO X - 2
   ix2 = ix + X
   FOR iy = 1 TO Y - 2
   Bf(ix2, iy) = ((Bf(ix - 1, iy) + Bf(ix + 1, iy) + Bf(ix, iy - 1) + Bf(ix, iy + 1)) * 0.5 - Bf(ix2, iy)) * Dampening           
   NEXT
NEXT
         
FOR ix = 1 TO X - 2
   ix2 = ix + X
   FOR iy = 1 TO Y - 2
   Bf(ix, iy) = ((Bf(ix2 - 1, iy) + Bf(ix2 + 1, iy) + Bf(ix2, iy - 1) + Bf(ix2, iy + 1)) * 0.5 - Bf(ix, iy)) * Dampening           
     Cv = CBYTE((Bf(ix2, iy) + .38) * 110 )
     PSET(ix, iy), RGB(Cv, Cv, Cv)
   NEXT
NEXT
 FLIP
LOOP UNTIL INKEY = CHR(27)
1
Pro_grammer
Модератор
6213 / 2300 / 449
Регистрация: 24.04.2011
Сообщений: 4,116
Записей в блоге: 10
11.05.2018, 20:51  [ТС] 5
Цитата Сообщение от Quiet Snow Посмотреть сообщение
Попробовал цвета в порядок привести
Замечательно! Если ЛКМ не отпускать, и двигать, то как пальцем по воде провести!
0
Замабувараев
349 / 356 / 93
Регистрация: 18.12.2014
Сообщений: 722
Записей в блоге: 1
14.05.2018, 07:33 6
Цитата Сообщение от Pro_grammer Посмотреть сообщение
ScreenRes 600, 400
Хах.
0
14.05.2018, 07:33
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
14.05.2018, 07:33

Осваиваю (ем) FreeBasic
Решил больше не тянуть, а приступить сегодня. Если тема будет актуальна - возможно модераторы...

Задача на графику в FreeBASIC
Помогите с задача по графике в FreeBASIC Построить совокупность n равных отрезков, центры которых...

Синтаксические особенности FreeBasic
По совету Stabud создаю тему, в которой будем обсуждать семантику и синтаксис диалекта FreeBasic....


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
6
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.
Рейтинг@Mail.ru