purebasic.info

PureBasic forum
Текущее время: Ср апр 25, 2018 3:55 pm

Часовой пояс: UTC + 3 часа




Начать новую тему Ответить на тему  [ Сообщений: 33 ]  На страницу 1, 2, 3  След.
Автор Сообщение
 Заголовок сообщения: Генерация текстур
СообщениеДобавлено: Вс ноя 18, 2007 2:01 pm 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Сб авг 18, 2007 6:26 pm
Сообщений: 605
Откуда: Северодвинск/Питер
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Ну что, коллеги, вот мы сделали первые шаги к созданию демки!!! (Я, к сожалению, практически ничего не делал, так как занят был :( )
Однако, если мы наконец решимся написать нормальную трёхмерную демку целой командой, понадобятся текстуры. В настоящее время я написал следующие алгоритмы:
    *Фрактал "плазма"-облака, туманности, огонь.
    *Монохроматичный фрактал-планета.
    *Специфическая "сетка"-фрактал. Пойдет для нефоторелистичного фона или как фильтр для камеры.

    *Фильтр Blur.
    *Фильтр Rotate(для разворота обычной картинки, не S3D...)


Сейчас подрихтую алгоритмы и выложу. Присоединяйтесь, нам это понадобится!!! ;)

Думаю, нам не помешают алгоритмы для генерации эффектов типа бликов объектива и звёзд. :roll:


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пн ноя 19, 2007 10:53 pm 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Сб авг 18, 2007 6:26 pm
Сообщений: 605
Откуда: Северодвинск/Питер
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Вот версия, жаль, ещё сыровата....
Код:
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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
 
Global Dim Pixels.l(3000,3000)
 
Procedure Sign()
  Select Random(1)
  Case 0
    ProcedureReturn -1
  Case 1
    ProcedureReturn 1
  EndSelect
EndProcedure
 
Procedure BlendColor(Color1.l, Color2.l,Alpha)
ProcedureReturn RGB((255-Alpha)*|!REG3XP3!>Red(Color1)/255+Alpha*|!REG3XP3!>Red(Color2)/255,(255-Alpha)*|!REG3XP3!>Green(Color1)/255+Alpha*|!REG3XP3!>Green(Color2)/255,(255-Alpha)*|!REG3XP3!>Blue(Color1)/255+Alpha*|!REG3XP3!>Blue(Color2)/255)
EndProcedure
 
Procedure SubDivide(size)
Dim Pixels2.l(size*2,size*2)
 
For i=0 To size-1
For j=0 To size-1
Pixels2(i*2,j*2)=pixels(i,j)
Next
Next
 
For i=0 To size*2-1
For j=0 To size*2-1
pixels(i,j)=Pixels2(i,j)
Next
Next
 
EndProcedure
 
Procedure MultiColor(NumOfColors,RndFactor.l,Color1.l,Color2.l=0,Color3.l=0,Color4.l=0)
If RndFactor<0:RndFactor=0:EndIf
Color1_R=Red(Color1)+Red(RndFactor)*NumOfColors/2-Random(Red(RndFactor)*NumOfColors):If Color1_R>255:Color1_R=255:EndIf:If Color1_R<0:Color1_R=0:EndIf
Color1_G=Green(Color1)+Green(RndFactor)*NumOfColors/2-Random(Green(RndFactor)*NumOfColors):If Color1_G>255:Color1_G=255:EndIf:If Color1_G<0:Color1_G=0:EndIf
Color1_B=Blue(Color1)+Blue(RndFactor)*NumOfColors/2-Random(Blue(RndFactor)*NumOfColors):If Color1_B>255:Color1_B=255:EndIf:If Color1_B<0:Color1_B=0:EndIf
 
Color2_R=Red(Color2)+Red(RndFactor)*NumOfColors/2-Random(Red(RndFactor)*NumOfColors):If Color2_R>255:Color2_R=255:EndIf:If Color2_R<0:Color2_R=0:EndIf
Color2_G=Green(Color2)+Green(RndFactor)*NumOfColors/2-Random(Green(RndFactor)*NumOfColors):If Color2_G>255:Color2_G=255:EndIf:If Color2_G<0:Color2_G=0:EndIf
Color2_B=Blue(Color2)+Blue(RndFactor)*NumOfColors/2-Random(Blue(RndFactor)*NumOfColors):If Color2_B>255:Color2_B=255:EndIf:If Color2_B<0:Color2_B=0:EndIf
 
Color3_R=Red(Color3)+Red(RndFactor)*NumOfColors/2-Random(Red(RndFactor)*NumOfColors):If Color3_R>255:Color3_R=255:EndIf:If Color3_R<0:Color3_R=0:EndIf
Color3_G=Green(Color3)+Green(RndFactor)*NumOfColors/2-Random(Green(RndFactor)*NumOfColors):If Color3_G>255:Color3_G=255:EndIf:If Color3_G<0:Color3_G=0:EndIf
Color3_B=Blue(Color3)+Blue(RndFactor)*NumOfColors/2-Random(Blue(RndFactor)*NumOfColors):If Color3_B>255:Color3_B=255:EndIf:If Color3_B<0:Color3_B=0:EndIf
 
Color4_R=Red(Color4)+Red(RndFactor)*NumOfColors/2-Random(Red(RndFactor)*NumOfColors):If Color4_R>255:Color4_R=255:EndIf:If Color4_R<0:Color4_R=0:EndIf
Color4_G=Green(Color4)+Green(RndFactor)*NumOfColors/2-Random(Green(RndFactor)*NumOfColors):If Color4_G>255:Color4_G=255:EndIf:If Color4_G<0:Color4_G=0:EndIf
Color4_B=Blue(Color4)+Blue(RndFactor)*NumOfColors/2-Random(Blue(RndFactor)*NumOfColors):If Color4_B>255:Color4_B=255:EndIf:If Color4_B<0:Color4_B=0:EndIf
 
Select NumOfColors
Case 1:ProcedureReturn RGB(Color1_R,Color1_G,Color1_B)
Case 2:ProcedureReturn RGB((Color1_R+Color2_R)/2,(Color1_G+Color2_G)/2,(Color1_B+Color2_B)/2)
Case 3:ProcedureReturn RGB((Color1_R+Color2_R+Color3_R)/3,(Color1_G+Color2_G+Color3_G)/3,(Color1_B+Color2_B+Color3_B)/3)
Case 4:ProcedureReturn RGB((Color1_R+Color2_R+Color3_R+Color4_R)/4,(Color1_G+Color2_G+Color3_G+Color4_G)/4,(Color1_B+Color2_B+Color3_B+Color4_B)/4)
EndSelect
EndProcedure
 
Procedure Fractal_Plasma(Iterations,UnSoften=1)
Size=2:For X=0 To Size-1:For Y=0 To Size-1:Pixels(X,Y)=RGB(Random(255),Random(255),Random(255)):Next:Next
;Size=2:Pixels(0,0)=RGB(128,128,128):Pixels(0,1)=RGB(0,0,255):Pixels(1,0)=RGB(0,0,255):Pixels(1,1)=RGB(255,255,255)
 
For C=1 To Iterations
  SubDivide(Size):Size*2-1
  For i=0 To size-1
   For j=0 To size-1
 
      If i % 2=0 And j % 2 <>0:Pixels(i,j)=MultiColor(2,RGB(UnSoften*|!REG3XP3!>Sqr((Iterations-C)),UnSoften*|!REG3XP3!>Sqr((Iterations-C)),UnSoften*|!REG3XP3!>Sqr((Iterations-C))),Pixels(i,j-1),Pixels(i,j+1)):EndIf
      If i % 2<>0 And j % 2 =0:Pixels(i,j)=MultiColor(2,RGB(UnSoften*|!REG3XP3!>Sqr((Iterations-C)),UnSoften*|!REG3XP3!>Sqr((Iterations-C)),UnSoften*|!REG3XP3!>Sqr((Iterations-C))),Pixels(i-1,j),Pixels(i+1,j)):EndIf
      If i % 2<>0 And j % 2 <>0:Pixels(i,j)=MultiColor(4,RGB(UnSoften*|!REG3XP3!>Sqr((Iterations-C)),UnSoften*|!REG3XP3!>Sqr((Iterations-C)),UnSoften*|!REG3XP3!>Sqr((Iterations-C))),Pixels(i-1,j-1),Pixels(i-1,j+1),Pixels(i+1,j-1),Pixels(i+1,j+1)):EndIf
 
   Next
  Next
 
Next
ProcedureReturn Size
EndProcedure
 
Procedure Fractal_simple(Iterations)
Size=2:For X=0 To 1:For Y=0 To 1:Pixels(X,Y)=RGB(Random(255),Random(255),Random(255)):Next:Next
 
For C=1 To Iterations
  SubDivide(Size):Size*2-1
  For i=0 To size-1
   For j=0 To size-1
 
    If Pixels(i,j)=0 ;And (i % 2=0 Or j % 2=0)
      If i % 2=0 And j % 2 <>0:kx=0:ky=sign():EndIf
      If i % 2<>0 And j % 2 =0:kx=Sign():ky=0:EndIf
      If i % 2<>0 And j % 2 <>0:kx=sign():ky=sign():EndIf
     
      ;If i=0 And kx<0:kx=Abs(kx):EndIf:If j=0 And ky<0:ky=Abs(ky):EndIf
     
      Pixels(i,j)=pixels(i+kx,j+ky)
    EndIf
 
   Next
  Next
 
Next
ProcedureReturn Size
EndProcedure
 
Procedure Fractal_Grid(Iterations)
Size=2:For X=0 To 1:For Y=0 To 1:Pixels(X,Y)=RGB(Random(255),Random(255),Random(255)):Next:Next
 
For C=1 To Iterations
  SubDivide(Size):Size*2-1
  For i=0 To size-1
   For j=0 To size-1
 
    If Pixels(i,j)=0 ;And (i % 2=0 Or j % 2=0)
      If i % 2=0 And j % 2 <>0:Pixels(i,j)=BlendColor(pixels(i,j-1),pixels(i,j+1),128):EndIf
      If i % 2<>0 And j % 2 =0:Pixels(i,j)=BlendColor(pixels(i-1,j),pixels(i+1,j),128):EndIf
      If i % 2<>0 And j % 2 <>0:Pixels(i,j)=BlendColor(BlendColor(pixels(i,j-1),pixels(i,j+1),128),BlendColor(pixels(i-1,j),pixels(i+1,j),128),128):EndIf
     
      If i=0 And kx<0:kx=Abs(kx):EndIf:If j=0 And ky<0:ky=Abs(ky):EndIf
     
    EndIf
 
   Next
  Next
 
Next
ProcedureReturn Size
EndProcedure
 
Procedure SaveToSprite(SpriteNumber,Size,Mode=0)
CreateSprite(SpriteNumber,Size,Size,Mode)
 
StartDrawing(SpriteOutput(SpriteNumber))
Buffer=DrawingBuffer()
Pitch=DrawingBufferPitch()
*line.pixel
For J=0 To Size-1
*line=Buffer+Pitch*J
  For I=0 To Size-1
    *Line\Pixel=Pixels(I,J)
    *Line+4
  Next
Next
StopDrawing()
 
StopDrawing()
 
EndProcedure
 



Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пн ноя 19, 2007 11:07 pm 
Не в сети
GameC@Soft
Аватар пользователя

Зарегистрирован: Сб сен 22, 2007 12:45 pm
Сообщений: 1085
Откуда: Я из лесу вышел, и сразу зашел, в босоножках дырявых и взлядом ночным.
Благодарил (а): 1 раз.
Поблагодарили: 2 раз.
Пункты репутации: 0
Что то я не въеду

при компиляции
Цитата:
*line.pixel


выдаёт ошибку
Цитата:
structure not found: pixel

_________________
"Самый большой глюк в PureBasic - это твоя голова...." (с) Артем
Мой сайт: http://feelzone.org.ua/


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пн ноя 19, 2007 11:56 pm 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Пн ноя 27, 2006 2:43 pm
Сообщений: 931
Откуда: Санкт-Петербург
Благодарил (а): 1 раз.
Поблагодарили: 12 раз.
Пункты репутации: 15
то же самое :(
надо объявить структуру pixel


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Вт ноя 20, 2007 6:19 am 
Не в сети
МОДЕРАТОР

Зарегистрирован: Вт дек 05, 2006 8:46 am
Сообщений: 6246
Благодарил (а): 17 раз.
Поблагодарили: 182 раз.
Пункты репутации: 48
Это что - прикол такой? Структура

Код:
1
2
3
4
Structure Pixel
  Pixel.l
EndStructure
 


Не решает проблемы - этот код просто набор процедур без управляющего кода. Уж если выдал людям код, то надо хоть как то обьяснить его работу...


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Вт ноя 20, 2007 10:46 am 
Не в сети
GameC@Soft
Аватар пользователя

Зарегистрирован: Сб сен 22, 2007 12:45 pm
Сообщений: 1085
Откуда: Я из лесу вышел, и сразу зашел, в босоножках дырявых и взлядом ночным.
Благодарил (а): 1 раз.
Поблагодарили: 2 раз.
Пункты репутации: 0
All_Creater Пожалуйста вышли нормальный код, и пример как использовать, а то что-то совсем ничего не поеятно...

Кстати, я тут процедуры делаю специально под интро, теперь можно получь патч к файлу в памяти... )
Можно загрузить movie таким образом loadmoviememory(#file,buffer,size)
и проигать после этого.. НО простите, что не совсем по теме

_________________
"Самый большой глюк в PureBasic - это твоя голова...." (с) Артем
Мой сайт: http://feelzone.org.ua/


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Ср ноя 21, 2007 2:19 pm 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Сб авг 18, 2007 6:26 pm
Сообщений: 605
Откуда: Северодвинск/Питер
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Хм...

Ну, первое: Всё правильно. Надо написать структуру Pixel(это я взялиз примера DirectScreenDrawing)... А код да, просто набор процедур.

Кратка справка:

Subdivide переписывает массив Pixels так,чтобы появлялись "пустоты":
Исходный массив:
123
456
789
Результат subdivide(размер_массива):
10203
00000
40506
00000
70809
Вот...

Fractal_Plasma(кол-во сабдивайдов,резкость переходов)
Забивает в массив Pixels цвета... Возвращает размер.

Fractal_Simple и fractal_grid аналогично работают.

Ну, и SaveToSprite записывает в спрайт массив pixels размера Size*Size... Получается текстура....


Последний раз редактировалось All_Creater Ср ноя 21, 2007 8:35 pm, всего редактировалось 1 раз.

Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Ср ноя 21, 2007 2:29 pm 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Сб авг 18, 2007 6:26 pm
Сообщений: 605
Откуда: Северодвинск/Питер
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Эх, народ, вот вам пример... И поправленная версия одновременно... ;)

Код:
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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
Global Dim Pixels.l(3000,3000) 
 
Procedure Sign()
  Select Random(1)
  Case 0
    ProcedureReturn -1
  Case 1
    ProcedureReturn 1
  EndSelect
EndProcedure
 
Procedure BlendColor(Color1.l, Color2.l,Alpha)
ProcedureReturn RGB((255-Alpha)*|!REG3XP3!>Red(Color1)/255+Alpha*|!REG3XP3!>Red(Color2)/255,(255-Alpha)*|!REG3XP3!>Green(Color1)/255+Alpha*|!REG3XP3!>Green(Color2)/255,(255-Alpha)*|!REG3XP3!>Blue(Color1)/255+Alpha*|!REG3XP3!>Blue(Color2)/255)
EndProcedure
 
Procedure SubDivide(size)
Dim Pixels2.l(size*2,size*2)
 
For i=0 To size-1
For j=0 To size-1
Pixels2(i*2,j*2)=pixels(i,j)
Next
Next
 
For i=0 To size*2-1
For j=0 To size*2-1
pixels(i,j)=Pixels2(i,j)
Next
Next
 
EndProcedure
 
Procedure MultiColor(NumOfColors,RndFactor.l,Color1.l,Color2.l=0,Color3.l=0,Color4.l=0)
If RndFactor<0:RndFactor=0:EndIf
Color1_R=Red(Color1)+Red(RndFactor)*NumOfColors/2-Random(Red(RndFactor)*NumOfColors):If Color1_R>255:Color1_R=255:EndIf:If Color1_R<0:Color1_R=0:EndIf
Color1_G=Green(Color1)+Green(RndFactor)*NumOfColors/2-Random(Green(RndFactor)*NumOfColors):If Color1_G>255:Color1_G=255:EndIf:If Color1_G<0:Color1_G=0:EndIf
Color1_B=Blue(Color1)+Blue(RndFactor)*NumOfColors/2-Random(Blue(RndFactor)*NumOfColors):If Color1_B>255:Color1_B=255:EndIf:If Color1_B<0:Color1_B=0:EndIf
 
Color2_R=Red(Color2)+Red(RndFactor)*NumOfColors/2-Random(Red(RndFactor)*NumOfColors):If Color2_R>255:Color2_R=255:EndIf:If Color2_R<0:Color2_R=0:EndIf
Color2_G=Green(Color2)+Green(RndFactor)*NumOfColors/2-Random(Green(RndFactor)*NumOfColors):If Color2_G>255:Color2_G=255:EndIf:If Color2_G<0:Color2_G=0:EndIf
Color2_B=Blue(Color2)+Blue(RndFactor)*NumOfColors/2-Random(Blue(RndFactor)*NumOfColors):If Color2_B>255:Color2_B=255:EndIf:If Color2_B<0:Color2_B=0:EndIf
 
Color3_R=Red(Color3)+Red(RndFactor)*NumOfColors/2-Random(Red(RndFactor)*NumOfColors):If Color3_R>255:Color3_R=255:EndIf:If Color3_R<0:Color3_R=0:EndIf
Color3_G=Green(Color3)+Green(RndFactor)*NumOfColors/2-Random(Green(RndFactor)*NumOfColors):If Color3_G>255:Color3_G=255:EndIf:If Color3_G<0:Color3_G=0:EndIf
Color3_B=Blue(Color3)+Blue(RndFactor)*NumOfColors/2-Random(Blue(RndFactor)*NumOfColors):If Color3_B>255:Color3_B=255:EndIf:If Color3_B<0:Color3_B=0:EndIf
 
Color4_R=Red(Color4)+Red(RndFactor)*NumOfColors/2-Random(Red(RndFactor)*NumOfColors):If Color4_R>255:Color4_R=255:EndIf:If Color4_R<0:Color4_R=0:EndIf
Color4_G=Green(Color4)+Green(RndFactor)*NumOfColors/2-Random(Green(RndFactor)*NumOfColors):If Color4_G>255:Color4_G=255:EndIf:If Color4_G<0:Color4_G=0:EndIf
Color4_B=Blue(Color4)+Blue(RndFactor)*NumOfColors/2-Random(Blue(RndFactor)*NumOfColors):If Color4_B>255:Color4_B=255:EndIf:If Color4_B<0:Color4_B=0:EndIf
 
Select NumOfColors
Case 1:ProcedureReturn RGB(Color1_R,Color1_G,Color1_B)
Case 2:ProcedureReturn RGB((Color1_R+Color2_R)/2,(Color1_G+Color2_G)/2,(Color1_B+Color2_B)/2)
Case 3:ProcedureReturn RGB((Color1_R+Color2_R+Color3_R)/3,(Color1_G+Color2_G+Color3_G)/3,(Color1_B+Color2_B+Color3_B)/3)
Case 4:ProcedureReturn RGB((Color1_R+Color2_R+Color3_R+Color4_R)/4,(Color1_G+Color2_G+Color3_G+Color4_G)/4,(Color1_B+Color2_B+Color3_B+Color4_B)/4)
EndSelect
EndProcedure
 
Procedure Fractal_Plasma(Iterations,UnSoften=1)
Size=2:For X=0 To Size-1:For Y=0 To Size-1:Pixels(X,Y)=RGB(Random(255),Random(255),Random(255)):Next:Next
;Size=2:Pixels(0,0)=RGB(128,128,128):Pixels(0,1)=RGB(0,0,255):Pixels(1,0)=RGB(0,0,255):Pixels(1,1)=RGB(255,255,255)
 
For C=1 To Iterations
  SubDivide(Size):Size*2-1
  For i=0 To size-1
   For j=0 To size-1
 
      If i % 2=0 And j % 2 <>0:Pixels(i,j)=MultiColor(2,RGB(UnSoften*|!REG3XP3!>Sqr((Iterations-C)),UnSoften*|!REG3XP3!>Sqr((Iterations-C)),UnSoften*|!REG3XP3!>Sqr((Iterations-C))),Pixels(i,j-1),Pixels(i,j+1)):EndIf
      If i % 2<>0 And j % 2 =0:Pixels(i,j)=MultiColor(2,RGB(UnSoften*|!REG3XP3!>Sqr((Iterations-C)),UnSoften*|!REG3XP3!>Sqr((Iterations-C)),UnSoften*|!REG3XP3!>Sqr((Iterations-C))),Pixels(i-1,j),Pixels(i+1,j)):EndIf
      If i % 2<>0 And j % 2 <>0:Pixels(i,j)=MultiColor(4,RGB(UnSoften*|!REG3XP3!>Sqr((Iterations-C)),UnSoften*|!REG3XP3!>Sqr((Iterations-C)),UnSoften*|!REG3XP3!>Sqr((Iterations-C))),Pixels(i-1,j-1),Pixels(i-1,j+1),Pixels(i+1,j-1),Pixels(i+1,j+1)):EndIf
 
   Next
  Next
 
Next
ProcedureReturn Size
EndProcedure
 
Procedure Fractal_simple(Iterations)
Size=2:For X=0 To 1:For Y=0 To 1:Pixels(X,Y)=RGB(Random(255),Random(255),Random(255)):Next:Next
 
For C=1 To Iterations
  SubDivide(Size):Size*2-1
  For i=0 To size-1
   For j=0 To size-1
 
    If Pixels(i,j)=0 ;And (i % 2=0 Or j % 2=0)
      If i % 2=0 And j % 2 <>0:kx=0:ky=sign():EndIf
      If i % 2<>0 And j % 2 =0:kx=Sign():ky=0:EndIf
      If i % 2<>0 And j % 2 <>0:kx=sign():ky=sign():EndIf
     
      ;If i=0 And kx<0:kx=Abs(kx):EndIf:If j=0 And ky<0:ky=Abs(ky):EndIf
     
      Pixels(i,j)=pixels(i+kx,j+ky)
    EndIf
 
   Next
  Next
 
Next
ProcedureReturn Size
EndProcedure
 
Procedure Fractal_Grid(Iterations)
 
Size=2:For X=0 To 1:For Y=0 To 1:Pixels(X,Y)=RGB(Random(255),Random(255),Random(255)):Next:Next
 
For C=1 To Iterations
  SubDivide(Size):Size*2-1
  For i=0 To size-1
   For j=0 To size-1
 
    If Pixels(i,j)=0 ;And (i % 2=0 Or j % 2=0)
      If i % 2=0 And j % 2 <>0:Pixels(i,j)=BlendColor(pixels(i,j-1),pixels(i,j+1),128):EndIf
      If i % 2<>0 And j % 2 =0:Pixels(i,j)=BlendColor(pixels(i-1,j),pixels(i+1,j),128):EndIf
      If i % 2<>0 And j % 2 <>0:Pixels(i,j)=BlendColor(BlendColor(pixels(i,j-1),pixels(i,j+1),128),BlendColor(pixels(i-1,j),pixels(i+1,j),128),128):EndIf
     
      If i=0 And kx<0:kx=Abs(kx):EndIf:If j=0 And ky<0:ky=Abs(ky):EndIf
     
    EndIf
 
   Next
  Next
 
Next
ProcedureReturn Size
EndProcedure
 
Structure Pixel
Pixel.l
EndStructure
 
Procedure SaveToSprite(SpriteNumber,Size,Mode=0)
 
 
CreateSprite(SpriteNumber,Size,Size,Mode)
 
StartDrawing(SpriteOutput(SpriteNumber))
Buffer=DrawingBuffer()
Pitch=DrawingBufferPitch()
*line.pixel
For J=0 To Size-1
*line=Buffer+Pitch*J
  For I=0 To Size-1
    *Line\Pixel=Pixels(I,J)
    *Line+4
  Next
Next
StopDrawing()
 
EndProcedure
 
 
InitSprite()
InitKeyboard()
 
OpenScreen(1024,768,32,"")
 
SaveToSprite(0,Fractal_Grid(10),#PB_Sprite_Texture)
 
SaveToSprite(10,Fractal_Plasma(8,2),#PB_Sprite_Texture)
SaveToSprite(11,Fractal_Plasma(8,4),#PB_Sprite_Texture)
SaveToSprite(12,Fractal_Plasma(8,6),#PB_Sprite_Texture)
SaveToSprite(13,Fractal_Plasma(8,8),#PB_Sprite_Texture)
 
Repeat
ClearScreen(0)
ExamineKeyboard()
 
DisplaySprite(0,0,0)
 
DisplaySprite(10,0,0)
DisplaySprite(11,300,0)
DisplaySprite(12,0,300)
DisplaySprite(13,300,300)
 
FlipBuffers()
Until KeyboardReleased(#PB_Key_All)



Если что, не забудьте,что предварительно фрактал пишется в массив. И только потом сохраняется в спрайт... Ессно, вместо SpriteOutput() в SaveToSprite'е мона применить что угодно...


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Ср ноя 21, 2007 2:44 pm 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Сб авг 18, 2007 6:26 pm
Сообщений: 605
Откуда: Северодвинск/Питер
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
kvitaliy писал(а):
Это что - прикол такой? Структура

Код:
1
2
3
4
Structure Pixel
  Pixel.l
EndStructure
 


Не решает проблемы - этот код просто набор процедур без управляющего кода. Уж если выдал людям код, то надо хоть как то обьяснить его работу...


Не, это не прикол. Хотя выглядит абсурдно, согласен. Структура из одной переменной :) А вообще ведь я скопировал ЭТО у разрабов. Видимо, по другому нельзя... А может, они просто сделали так для наглядности...


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Чт ноя 22, 2007 12:44 pm 
Не в сети
GameC@Soft
Аватар пользователя

Зарегистрирован: Сб сен 22, 2007 12:45 pm
Сообщений: 1085
Откуда: Я из лесу вышел, и сразу зашел, в босоножках дырявых и взлядом ночным.
Благодарил (а): 1 раз.
Поблагодарили: 2 раз.
Пункты репутации: 0
Медленно работет коллега
2,26 Ггерц 512 оператива 128 видио - это мои параметры, строило около 3 сек.
Надо оптимизировать

_________________
"Самый большой глюк в PureBasic - это твоя голова...." (с) Артем
Мой сайт: http://feelzone.org.ua/


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Чт ноя 22, 2007 7:16 pm 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Сб авг 18, 2007 6:26 pm
Сообщений: 605
Откуда: Северодвинск/Питер
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Артём писал(а):
Медленно работет коллега
2,26 Ггерц 512 оператива 128 видио - это мои параметры, строило около 3 сек.
Надо оптимизировать

Коллега, вынужден не согласиться. ;) Не забывай, что генерация фрактала - довольно сложная процедура... Хотя не могу отрицать, что оптимизировать можно. :roll:

Интересно, что заставка-"плазма"-работает быстро. Но я ГОТОВ СПОРИТЬ, что интерполяция выполняется DirectXом(ну или OGL, что более вероятно). Думаю, они выполняют пару итераций аналогичного алгоритма и просто очень сильно увеличивают результат. Моё мнение обусловлено тем, что нет заставок, которые генерируют "облачную" пламу. А мы генерируем текстуру... Что ж поделать... 8)


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пт ноя 23, 2007 10:23 am 
Не в сети
GameC@Soft
Аватар пользователя

Зарегистрирован: Сб сен 22, 2007 12:45 pm
Сообщений: 1085
Откуда: Я из лесу вышел, и сразу зашел, в босоножках дырявых и взлядом ночным.
Благодарил (а): 1 раз.
Поблагодарили: 2 раз.
Пункты репутации: 0
Но, так как это будет последующая текстура, то проблем я думаю не должно быть

_________________
"Самый большой глюк в PureBasic - это твоя голова...." (с) Артем
Мой сайт: http://feelzone.org.ua/


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Сб ноя 24, 2007 9:47 am 
Не в сети
GameC@Soft
Аватар пользователя

Зарегистрирован: Сб сен 22, 2007 12:45 pm
Сообщений: 1085
Откуда: Я из лесу вышел, и сразу зашел, в босоножках дырявых и взлядом ночным.
Благодарил (а): 1 раз.
Поблагодарили: 2 раз.
Пункты репутации: 0
Хм..., что я задумал...

Код:
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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
InitSprite()
InitKeyboard()
InitMouse()
 
OpenScreen(1024,768,32,"))")
 
Structure flare
x.w
y.w
sx.f
sy.f
color.l
cc.l
life.l
EndStructure
Global sxx
Global NewList flare.flare()
 
Procedure addflare(x,y,sx,sy)
AddElement(flare())
 
flare()\x=x
flare()\y=y
flare()\sx=sx
flare()\sy=sy
flare()\cc=cc
flare()\life=60
flare()\color=color
 
EndProcedure
 
MouseLocate(300,300)
Repeat
FlipBuffers()
ClearScreen(0)
ExamineMouse()
ExamineKeyboard()
 
Select Random(2)
Case 1
sx=-1
Case 0
sx=1
Case 2
sx=0
EndSelect
 
addflare(MouseX(),MouseY(),sx,1)
 
StartDrawing(ScreenOutput())
ResetList(flare())
While NextElement(flare())
Plot(flare()\x,flare()\y,flare()\color)
flare()\x+flare()\sx
flare()\y-flare()\sy
flare()\life-1
If mode=0
flare()\cc+5
EndIf
If mode=1
flare()\cc-5
EndIf
If flare()\cc=250
mode=1
EndIf
If flare()\cc=-250
mode=0
EndIf
flare()\color=RGB(flare()\cc,-flare()\cc,-flare()\cc)
If flare()\life=0
DeleteElement(flare())
EndIf
Wend
StopDrawing()
 
Until KeyboardPushed(#PB_Key_Escape)
End



Подправьте цвет!!! Пожалуйста
синеватый-светлокрасный-переход в красный-желтый-в светложелтый

_________________
"Самый большой глюк в PureBasic - это твоя голова...." (с) Артем
Мой сайт: http://feelzone.org.ua/


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Сб ноя 24, 2007 12:00 pm 
Не в сети
GameC@Soft
Аватар пользователя

Зарегистрирован: Сб сен 22, 2007 12:45 pm
Сообщений: 1085
Откуда: Я из лесу вышел, и сразу зашел, в босоножках дырявых и взлядом ночным.
Благодарил (а): 1 раз.
Поблагодарили: 2 раз.
Пункты репутации: 0
Вот подправил...

Код:
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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
InitSprite()
InitKeyboard()
InitMouse()
 
OpenScreen(1024,768,32,"))")
 
Structure flare
x.w
y.w
sx.f
sy.f
color.l
cc.l
mode.l
r.l
g.l
b.l
life.l
EndStructure
Global sxx
Global NewList flare.flare()
 
Procedure addflare(x,y,sx,sy,life)
AddElement(flare())
 
flare()\x=x
flare()\y=y
flare()\sx=sx
flare()\sy=sy
flare()\cc=cc
flare()\mode=mode
flare()\r=r
flare()\g=g
flare()\b=b
flare()\life=life
flare()\color=color
 
EndProcedure
 
MouseLocate(300,300)
Repeat
FlipBuffers()
ClearScreen(0)
ExamineMouse()
ExamineKeyboard()
 
Select Random(2)
Case 1
sy=1
EndSelect
x=MouseDeltaX()
y=MouseDeltaY()
xx+x
yy+y
addflare(xx+1,yy,sx,sy,Random(60))
addflare(xx-1,yy,sx,sy,Random(60))
addflare(xx,yy+1,sx,sy,Random(60))
 
 
 
 
StartDrawing(ScreenOutput())
ResetList(flare())
While NextElement(flare())
LineXY(flare()\x,flare()\y,flare()\x,flare()\y,flare()\color)
flare()\x+flare()\sx
flare()\y-flare()\sy
flare()\life-1
 
If flare()\mode=0
flare()\r=200
EndIf
If flare()\mode=1
flare()\g=100
EndIf
If flare()\mode=2
flare()\b=200
EndIf
 
 
 
If flare()\cc=0
flare()\mode=0
EndIf
If flare()\cc=Random(20)
flare()\mode=1
EndIf
If flare()\cc=Random(40)
flare()\mode=2
EndIf
 
flare()\cc+1
If flare()\cc=255
flare()\cc=0
EndIf
 
flare()\color=RGB(flare()\r,flare()\g,0)
 
If flare()\life<=0
DeleteElement(flare())
EndIf
 
Wend
StopDrawing()
 
Until KeyboardPushed(#PB_Key_Escape)
End


_________________
"Самый большой глюк в PureBasic - это твоя голова...." (с) Артем
Мой сайт: http://feelzone.org.ua/


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Сб ноя 24, 2007 3:42 pm 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Сб авг 18, 2007 6:26 pm
Сообщений: 605
Откуда: Северодвинск/Питер
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
НУ, прикольная идея. Имхо, если это будет на десктопе, то точно классно получится. Но, Артём, опять ты не совсем в тему отправил ;) Тута - текстуры. А эффекты-отдельный разговор :)

_________________
http://www.youtube.com/watch?v=XHosLhPEN3k


Вернуться наверх
 Профиль  
 
Показать сообщения за:  Сортировать по:  
Начать новую тему Ответить на тему  [ Сообщений: 33 ]  На страницу 1, 2, 3  След.

Часовой пояс: UTC + 3 часа


Кто сейчас на форуме

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Перейти:  
Создано на основе phpBB® Forum Software © phpBB Group (блог о phpBB)
Сборка создана CMSart Studio
Русская поддержка phpBB