purebasic.info

PureBasic forum
Текущее время: Сб май 30, 2020 10:34 am

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




Начать новую тему Ответить на тему  [ Сообщений: 8 ] 
Автор Сообщение
 Заголовок сообщения: ST sound
СообщениеДобавлено: Чт окт 24, 2019 8:05 am 
Не в сети
профессор

Зарегистрирован: Сб апр 16, 2011 8:59 am
Сообщений: 264
Благодарил (а): 4 раз.
Поблагодарили: 2 раз.
Пункты репутации: 0
Нашел тут приличную библиотеку.

Вот только с графикой вышел косяк - хочу рисовать фон, а вышла щляпа.
Подскажите плиз.


Вложения:
play.rar [365.24 KiB]
Скачиваний: 67

_________________
Захотелось мартышки любви со слоном, тут она и лопнула
Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: ST sound
СообщениеДобавлено: Чт окт 24, 2019 8:54 am 
Не в сети
МОДЕРАТОР

Зарегистрирован: Вт дек 05, 2006 8:46 am
Сообщений: 6609
Благодарил (а): 34 раз.
Поблагодарили: 229 раз.
Пункты репутации: 61
egons писал(а):

Вот только с графикой вышел косяк - хочу рисовать фон, а вышла щляпа.

Что угодно можно рисовать, хоть так:
Код:
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
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
 
DeclareModule LinearlySpacedValue
 
  Declare.f Float(IncrementID.l, IncrementMax.l, MinValue.f, MaxValue.f)
 
EndDeclareModule
 
Module LinearlySpacedValue
 
  Procedure.f Float(IncrementID.l, IncrementMax.l, MinValue.f, MaxValue.f)
   
    ProcedureReturn ((MinValue) + ((MaxValue) - (MinValue)) * ((IncrementID) / (IncrementMax)))
  EndProcedure
 
EndModule
 
DeclareModule Snakes
 
  Declare AddInstance(P_ColorID.l, P_BallsMax.w)
  Declare Initialize(P_ScreenWidth.w, P_ScreenHeight.w, P_BallSize.w)
  Declare Reset()
  Declare Animate()
 
EndDeclareModule
 
Module Snakes
 
  #BALLS_MAX = 100
 
  Structure Ball
   
    SpriteID.l
    PosX.f
    PosY.f
   
  EndStructure
 
  Structure Secondary
   
    ScreenWidth.w
    ScreenHeight.w
    BallSize.w
   
  EndStructure
 
  Structure Instance
   
    HeadSpeed.f
    HeadAngle.f
    HeadPosX.f
    HeadPosY.f
    HeadMoveX.f
    HeadMoveY.f
    HeadRotation.f
    Distance.f
    Speed.f
    Angle.f
    ProximityCounter.l
    BallsDiameter.w
    BallsRadius.w
    BallsMax.w
    Balls.Ball[#BALLS_MAX]
   
  EndStructure
 
  Global Secondary.Secondary
  Global NewList Instances.Instance()
 
  Macro MoveBallPosition(BallA, BallB, P_Speed)
   
    BallA\PosX = BallA\PosX + (BallB\PosX - BallA\PosX) * P_Speed
    BallA\PosY = BallA\PosY + (BallB\PosY - BallA\PosY) * P_Speed
   
  EndMacro
 
  Procedure MakeBalls(SpriteID)
   
    PS = Secondary\BallSize
    Size = PS << 1
    COLORV = 0
   
    If CreateSprite(SpriteID, Size, Size)
     
      TransparentSpriteColor(SpriteID, 0)
     
      If StartDrawing(SpriteOutput(SpriteID))
       
        Box(0,0, Size, Size, 0)
        Cxy = PS
       
        For Radius = 0 To PS
         
          Select SpriteID
             
            Case 0
              Color = RGB(COLORV >> 1, COLORV >> 1, COLORV)
             
            Case 1
              Color = RGB(COLORV, COLORV >> 1, COLORV >> 1)
             
            Case 2
              Color = RGB(COLORV >> 1, COLORV, COLORV >> 1)
             
            Case 3
              Color = RGB(COLORV >> 1, COLORV, COLORV)
             
            Case 4
              Color = RGB(COLORV, COLORV >> 1, COLORV)
             
            Case 5
              Color = RGB(COLORV, COLORV, COLORV >> 1)
             
            Case 6
              Color = RGB(COLORV, COLORV, COLORV)
             
            Case 7
              Color = RGB(COLORV >> 1, COLORV >> 1, COLORV >> 1)
             
            Case 8
              Color = RGB(COLORV >> 2, COLORV >> 2, COLORV >> 2)
             
            Case 9
              Color = RGB(COLORV, COLORV >> 2, COLORV >> 2)
             
            Case 10
              Color = RGB(COLORV >> 2, COLORV, COLORV >> 2)
             
            Case 11
              Color = RGB(COLORV >> 2, COLORV >> 2, COLORV)
             
            Case 12
              Color = RGB(000, 000, COLORV)
             
            Case 13
              Color = RGB(000, COLORV, 000)
             
            Case 14
              Color = RGB(COLORV, 000, 000)
             
            Case 15
              Color = RGB(COLORV, COLORV, 000)
             
            Case 16
              Color = RGB(000, COLORV, COLORV)
             
            Case 17
              Color = RGB(COLORV, 000, COLORV)
             
            Case 18
              Color = RGB(000, COLORV >> 1, COLORV >> 1)  
             
            Case 19
              Color = RGB(COLORV, COLORV >> 1, 000)
             
          EndSelect
         
          Circle(Cxy, Cxy, PS - Radius, Color)
          COLORV = Int(LinearlySpacedValue::Float(Radius, PS, 0, 255))
         
        Next
       
        StopDrawing()
       
      EndIf
     
    EndIf
   
  EndProcedure
 
  Procedure AddInstance(P_ColorID.l, P_BallsMax.w)
   
    AddElement(Instances())
   
    Instances()\HeadSpeed = 10.0
    Instances()\HeadAngle = 0.0
    Instances()\HeadPosX = 0.0
    Instances()\HeadPosY = 0.0
    Instances()\HeadMoveX = 0.0
    Instances()\HeadMoveY = 0.0
    Instances()\HeadRotation = 2 * #PI / 120
    Instances()\Distance = 0.0
    Instances()\Speed = 0.20
    Instances()\Angle = 0.0
    Instances()\ProximityCounter = 0
    Instances()\BallsDiameter = Secondary\BallSize
    Instances()\BallsRadius = Secondary\BallSize >> 1
   
    If P_BallsMax > #BALLS_MAX
      P_BallsMax = #BALLS_MAX
    EndIf
   
    Instances()\BallsMax = P_BallsMax
   
    For BallsID = 0 To Instances()\BallsMax
      Instances()\Balls[BallsID]\SpriteID = P_ColorID
    Next
   
  EndProcedure
 
  Procedure Initialize(P_ScreenWidth.w, P_ScreenHeight.w, P_BallSize.w)
   
    Secondary\ScreenWidth = P_ScreenWidth
    Secondary\ScreenHeight = P_ScreenHeight
    Secondary\BallSize = P_BallSize
   
    For SpriteID = 0 To 19
      MakeBalls(SpriteID)
    Next
   
  EndProcedure
 
  Procedure Reset()
   
    ForEach Instances()
     
      Instances()\HeadSpeed = 0.0
      Instances()\HeadAngle = 0.0
      Instances()\HeadPosX = 0.0
      Instances()\HeadPosY = 0.0
      Instances()\HeadMoveX = 0.0
      Instances()\HeadMoveY = 0.0
      Instances()\HeadRotation = 0.0
      Instances()\Distance = 0.0
      Instances()\Speed = 0.0
      Instances()\Angle = 0.0
      Instances()\ProximityCounter = 0
      Instances()\BallsDiameter = 0
      Instances()\BallsRadius = 0
      Instances()\BallsMax = 0
     
      For BallsID = 0 To #BALLS_MAX - 1
        Instances()\Balls[BallsID]\SpriteID = 0
        Instances()\Balls[BallsID]\PosX = 0.0
        Instances()\Balls[BallsID]\PosY = 0.0
      Next
     
    Next
   
    FreeList(Instances())
   
    Secondary\ScreenWidth = 0
    Secondary\ScreenHeight = 0
   
    For SpriteID = 0 To 19
      If IsSprite(SpriteID)
        FreeSprite(SpriteID)
      EndIf
    Next
   
  EndProcedure
 
  Procedure Animate()
   
    ForEach Instances()
     
      ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
      ; Si on est arrivé, on va vers un autre point en aléatoire
     
      If Instances()\Distance < Instances()\HeadSpeed
        Instances()\HeadMoveX = Random(Secondary\ScreenWidth)
        Instances()\HeadMoveY = Random(Secondary\ScreenHeight)
      EndIf
     
      ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
      ; Si on arrive pas à atteindre le point au bout d'un moment, on dis qu'on l'a eu
     
      If Instances()\Distance < (Instances()\HeadSpeed * 40)
       
        Instances()\ProximityCounter = Instances()\ProximityCounter + 1
       
        If Instances()\ProximityCounter > 200
          Instances()\HeadMoveX = Random(Secondary\ScreenWidth)
          Instances()\HeadMoveY = Random(Secondary\ScreenHeight)
        EndIf
       
      Else
       
        Instances()\ProximityCounter = 0
       
      EndIf
     
      ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
      ; Distance entre la boule et le point visé
     
      X.f = Instances()\HeadMoveX - Instances()\HeadPosX
      Y.f = Instances()\HeadMoveY - Instances()\HeadPosY
      Instances()\Distance = Sqr(X*X + Y*Y)
     
      ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
      ; Angle entre la boule et le point visé
     
      If Instances()\HeadMoveX >= Instances()\HeadPosX And Instances()\HeadMoveY >= Instances()\HeadPosY ; entre 0 et Pi/2
        Instances()\Angle = ACos((Instances()\HeadMoveX - Instances()\HeadPosX) / Instances()\Distance)
      ElseIf Instances()\HeadMoveX >= Instances()\HeadPosX And Instances()\HeadMoveY <= Instances()\HeadPosY ; entre 0 et -Pi/2
        Instances()\Angle = -ACos((Instances()\HeadMoveX - Instances()\HeadPosX) / Instances()\Distance)
      ElseIf Instances()\HeadMoveX <= Instances()\HeadPosX And Instances()\HeadMoveY >= Instances()\HeadPosY ; entre Pi/2 et Pi
        Instances()\Angle = #PI - ACos((Instances()\HeadPosX - Instances()\HeadMoveX) / Instances()\Distance)
      Else ; entre -Pi/2 et -Pi
        Instances()\Angle = -#PI + ACos((Instances()\HeadPosX - Instances()\HeadMoveX) / Instances()\Distance)
      EndIf
     
      ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
      ; Si l'angle est plus grand que #Pi ou plus petit que -#Pi, on le ramene est -#pi et #pi
     
      If Instances()\HeadAngle > #PI
        Instances()\HeadAngle = Instances()\HeadAngle - 2*| style="color: #924B72;">#PI
      EndIf
      If Instances()\HeadAngle < -#PI
        Instances()\HeadAngle = Instances()\HeadAngle + 2*| style="color: #924B72;">#PI
      EndIf
     
      ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
      ; on regarde dans quel sens on doit faire évoluer l'angle
     
      If Instances()\HeadAngle >= Instances()\Angle
        If Instances()\HeadAngle - Instances()\Angle > #PI
          Instances()\HeadAngle = Instances()\HeadAngle + Instances()\HeadRotation
        Else
          Instances()\HeadAngle = Instances()\HeadAngle - Instances()\HeadRotation
        EndIf
      Else
        If Instances()\Angle - Instances()\HeadAngle > #PI
          Instances()\HeadAngle = Instances()\HeadAngle - Instances()\HeadRotation
        Else
          Instances()\HeadAngle = Instances()\HeadAngle + Instances()\HeadRotation
        EndIf
      EndIf
     
      ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
      ; On déplace suivant l'angle
     
      Instances()\HeadPosX = Instances()\HeadPosX + Cos(Instances()\HeadAngle) * Instances()\HeadSpeed
      Instances()\HeadPosY = Instances()\HeadPosY + Sin(Instances()\HeadAngle) * Instances()\HeadSpeed
     
      Instances()\Balls[00]\PosX = Instances()\HeadPosX - Instances()\BallsRadius
      Instances()\Balls[00]\PosY = Instances()\HeadPosY - Instances()\BallsRadius
     
      For BallsID = Instances()\BallsMax - 1 To 1 Step -1 ; Pour chaque boule
        MoveBallPosition(Instances()\Balls[BallsID], Instances()\Balls[BallsID-1], Instances()\Speed)
        DisplayTransparentSprite(Instances()\Balls[BallsID]\SpriteID, Instances()\Balls[BallsID]\PosX, Instances()\Balls[BallsID]\PosY)
      Next
     
      DisplayTransparentSprite(Instances()\Balls[00]\SpriteID, Instances()\Balls[00]\PosX, Instances()\Balls[00]\PosY)
     
    Next
   
  EndProcedure
 
EndModule
ImportC "winmm.lib"
EndImport
 
Import "StSoundLibrary_static.lib"
  ymMusicCreate()
  ymMusicLoadMemory(*p,*a,len.l)
  ymMusicSetLoopMode(*p,f.l)
  ymMusicSoundServerStart(*p)
  ymMusicPlay(*p)
  ymMusicSoundServerStop(*p)
  ymMusicDestroy(*p)
EndImport
 
*p=ymMusicCreate()
ymMusicLoadMemory(*p,?mus,?mus_e-?mus)
 
ymMusicSetLoopMode(*p,1);, pMusic, TRUE
If ymMusicSoundServerStart(*p);, pMusic
  ymMusicPlay(*p)             ;, pMusic
Else
  MessageRequester("error", "oops with sound", #PB_MessageRequester_Ok)
  End
EndIf
 
 
 
If InitSprite() <> 0 And InitKeyboard() <> 0
 
  ScreenW = 800
  ScreenH = 600
  hWnd=OpenWindow(0,(GetSystemMetrics_(#SM_CXSCREEN)-800)/2,(GetSystemMetrics_(#SM_CYSCREEN)-600)/2,800,600,"Snake Balls", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget )
  If OpenWindowedScreen(hWnd,0,0,800,600)
 
    Snakes::Initialize(ScreenW, ScreenH, 35) ; размер шаров
   
    For Index = 0 To 10
      Snakes::AddInstance(Random(19), Random(35, 15))
    Next
   
    Repeat
     
      ClearScreen($3AEBAC)  
           
      Snakes::Animate()
 
      FlipBuffers()
     
      ExamineKeyboard()
     
    Until KeyboardPushed(#PB_Key_All)
   
    Snakes::Reset()
    CloseScreen()
   
ymMusicSoundServerStop(*p);, pMusic
ymMusicDestroy(*p)        ;, pMusic
 
 
  EndIf
EndIf
DataSection
   
  mus:
 IncludeBinary "150mph.ym"
  mus_e:
EndDataSection
 


_________________
read-only ¯\_(ツ)_/¯


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: ST sound
СообщениеДобавлено: Чт окт 24, 2019 9:14 am 
Не в сети
профессор

Зарегистрирован: Сб апр 16, 2011 8:59 am
Сообщений: 264
Благодарил (а): 4 раз.
Поблагодарили: 2 раз.
Пункты репутации: 0
Слишком сложно. По идее создано 4 изображения с фоном tranparent. Смысл телодвижений - рисовать по черному фону, а не по шарикам.

_________________
Захотелось мартышки любви со слоном, тут она и лопнула


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: ST sound
СообщениеДобавлено: Чт окт 24, 2019 10:06 am 
Не в сети
МОДЕРАТОР

Зарегистрирован: Вт дек 05, 2006 8:46 am
Сообщений: 6609
Благодарил (а): 34 раз.
Поблагодарили: 229 раз.
Пункты репутации: 61
egons писал(а):
По идее создано 4 изображения с фоном tranparent.

RGBA работает только с 32 битным цветом.

_________________
read-only ¯\_(ツ)_/¯


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: ST sound
СообщениеДобавлено: Чт окт 24, 2019 10:12 am 
Не в сети
профессор

Зарегистрирован: Сб апр 16, 2011 8:59 am
Сообщений: 264
Благодарил (а): 4 раз.
Поблагодарили: 2 раз.
Пункты репутации: 0
я рисовал на картинках box RGBA(255,255,255,255) - не помогло.

буду думать.

_________________
Захотелось мартышки любви со слоном, тут она и лопнула


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: ST sound
СообщениеДобавлено: Чт окт 24, 2019 1:35 pm 
Не в сети
профессор

Зарегистрирован: Сб апр 16, 2011 8:59 am
Сообщений: 264
Благодарил (а): 4 раз.
Поблагодарили: 2 раз.
Пункты репутации: 0
Кажется, сделал. Только правильно ли?


Вложения:
dmo.zip [3.38 KiB]
Скачиваний: 57

_________________
Захотелось мартышки любви со слоном, тут она и лопнула
Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: ST sound
СообщениеДобавлено: Чт окт 24, 2019 1:41 pm 
Не в сети
МОДЕРАТОР

Зарегистрирован: Вт дек 05, 2006 8:46 am
Сообщений: 6609
Благодарил (а): 34 раз.
Поблагодарили: 229 раз.
Пункты репутации: 61
egons писал(а):
я рисовал на картинках box RGBA(255,255,255,255) - не помогло.

Картинка у тебя была создана как 24 битная
CreateImage(i,640,480,24,RGBA(255,255,255,255))
А теперь верно, 32 битная
CreateImage(i,640,480,32)

_________________
read-only ¯\_(ツ)_/¯


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: ST sound
СообщениеДобавлено: Чт окт 24, 2019 1:46 pm 
Не в сети
профессор

Зарегистрирован: Сб апр 16, 2011 8:59 am
Сообщений: 264
Благодарил (а): 4 раз.
Поблагодарили: 2 раз.
Пункты репутации: 0
Краткость- сестра таланта :roll:
спасибо, нашел заморочку

_________________
Захотелось мартышки любви со слоном, тут она и лопнула


Вернуться наверх
 Профиль  
 
Показать сообщения за:  Сортировать по:  
Начать новую тему Ответить на тему  [ Сообщений: 8 ] 

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


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

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


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

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