« previous next »
Pages: [1]   Go Down

Author Topic: Next one Music Visualizer  (Read 1292 times)

0 Members and 1 Guest are viewing this topic.

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
Next one Music Visualizer
« on: March 12, 2022, 12:49:01 pm »
Hi. This program try generate terrain (not smooth) using music file.

Do not forget overwriting your sound file name on row 17 in this source code.

Code: QB64: [Select]
  2. Texture = NewImage(255, 255, 32)
  3. Dest Texture
  4. Cls , &HFFFF0000
  5. For diY = 0 To 100
  6.     Line (diY + 20, diY + 20)-(235 - diY, 235 - diY), RGB32(diY, 0, 0), B
  8. Dest 0
  9. Dim As Long SND, Position, FillCachem, HT
  10. Dim As Float IL, IR, IntensityLeft, IntensityRight
  11. Dim As MEM L, R
  12. Dim As Unsigned Byte Rc, Gc, Bc
  13. ReDim LightsL(10) As Unsigned Byte
  14. ReDim LightsR(10) As Unsigned Byte
  15. Dim M3D(90, 90) As Single
  16. Dim M2D(90, 90) As Single
  17. SND = SndOpen("bb.mp3") '            <-----------------  insert here your sound file name!
  18. VOL = 10
  19. SndVol SND, VOL / 20
  20. L = MemSound(SND, 1)
  21. R = MemSound(SND, 2)
  22. DW = DesktopWidth
  23. DH = DesktopHeight
  24. HT = CopyImage(Texture, 33)
  25. FreeImage Texture
  26. Screen NewImage(DW, DH, 32)
  27. FullScreen
  28. SndPlay SND
  29. Do Until Position >= L.SIZE - 8192
  30.     ShiftIt = 89
  31.     Do Until ShiftIt < 0
  32.         For rows = 0 To 90
  33.             Swap M3D(rows, ShiftIt), M3D(rows, ShiftIt + 1)
  34.             Swap M2D(rows, ShiftIt), M2D(rows, ShiftIt + 1)
  35.         Next
  36.         ShiftIt = ShiftIt - 1
  37.     Loop
  38.     Depth = 0
  39.     Do Until Depth = 90000
  40.         If Depth + Position > L.SIZE Then End
  41.         M3D(ra, 0) = MemGet(L, L.OFFSET + Position + Depth, Integer) / 32768 * 1.7
  42.         M2D(ra, 0) = MemGet(R, R.OFFSET + Position + Depth, Integer) / 32768 * 1.7
  43.         Depth = Depth + 1000
  44.         ra = ra + 1
  45.     Loop
  46.     ra = 0
  47.     For Z = 0 To 89
  48.         For X = 0 To 89
  49.             HX = -45 + X
  50.             HX2 = HX + 1
  51.             HZ = -89 + Z
  52.             HZ2 = HZ + 1
  53.             HY1 = -3 + M3D(X, Z): HY2 = -3 + M3D(X + 1, Z): HY3 = -3 + M3D(X, Z + 1): HY4 = -3 + M3D(X + 1, Z + 1)
  54.             HY11 = 3 - M2D(X, Z): HY12 = 3 - M2D(X + 1, Z): HY13 = 3 - M2D(X, Z + 1): HY14 = 3 - M2D(X + 1, Z + 1)
  55.             MapTriangle (0, 0)-(255, 0)-(0, 255), HT To(HX, HY1, HZ)-(HX2, HY2, HZ)-(HX, HY3, HZ2), 0, Smooth
  56.             MapTriangle (255, 0)-(0, 255)-(255, 255), HT To(HX2, HY2, HZ)-(HX, HY3, HZ2)-(HX2, HY4, HZ2), 0, Smooth
  57.             MapTriangle (0, 0)-(255, 0)-(0, 255), HT To(HX, HY11, HZ)-(HX2, HY12, HZ)-(HX, HY13, HZ2), 0, Smooth
  58.             MapTriangle (255, 0)-(0, 255)-(255, 255), HT To(HX2, HY12, HZ)-(HX, HY13, HZ2)-(HX2, HY14, HZ2), 0, Smooth
  59.     Next X, Z
  60.  
  61.     '----------------------------------------------------------------------------------------------------------- CIRCLES --------------------------------------------------------------
  62.     FillCache = 0
  63.     IntensityLeft = 0
  64.     IntensityRight = 0
  65.     Do Until FillCache = 8192
  66.         IntensityLeft = IntensityLeft + Abs(MemGet(L, L.OFFSET + Position + FillCache, Integer) / 32768)
  67.         IntensityRight = IntensityRight + Abs(MemGet(R, R.OFFSET + Position + FillCache, Integer) / 32768)
  68.         FillCache = FillCache + 2
  69.     Loop
  70.     IL = IntensityLeft / 2 '                                                                   recalc values as decimal
  71.     IR = IntensityRight / 2
  72.     ReDim LightsL(10) As Unsigned Byte
  73.     ReDim LightsR(10) As Unsigned Byte
  74.     CLL = 0
  75.     Do Until IL <= 0
  76.         If IL > 28 Then LightsL(CLL) = 255 Else LightsL(CLL) = IL * 8
  77.         IL = IL - 28
  78.         CLL = CLL + 1
  79.         MAX CLL, 10
  80.     Loop
  81.     CLR = 0
  82.     Do Until IR <= 0
  83.         If IR > 28 Then LightsR(CLR) = 255 Else LightsR(CLR) = IR * 8
  84.         IR = IR - 28
  85.         CLR = CLR + 1
  86.         MAX CLR, 10
  87.     Loop
  88.     IL = 0
  89.     IR = 0
  90.     For DL = 0 To 10
  91.         Select Case DL
  92.             Case 0 TO 5
  93.                 Rc = 0: Gc = 255: Bc = 0
  94.             Case 6 TO 8
  95.                 Rc = 255: Gc = 255: Bc = 0
  96.             Case Is > 8
  97.                 Rc = 255: Gc = 0: Bc = 0
  98.         End Select
  99.         CircleFill Width / 2 - 50 - DL * 80, Height / 2, 30, &HFF000000
  100.         CircleFill Width / 2 - 50 - DL * 80, Height / 2, 30, RGBA32(Rc, Gc, Bc, LightsL(DL))
  101.         CircleFill Width / 2 + 50 + DL * 80, Height / 2, 30, &HFF000000
  102.         CircleFill Width / 2 + 50 + DL * 80, Height / 2, 30, RGBA32(Rc, Gc, Bc, LightsR(DL))
  103.     Next
  104.     Display
  105.     Limit 50
  106.     Position = SndGetPos(SND) * SndRate * 2
  108.  
  110.  
  111. Sub MAX (Value, mv)
  112.     If Value > mv Then Value = mv
  114.  
  115. Sub CircleFill (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
  116.     ' CX = center x coordinate
  117.     ' CY = center y coordinate
  118.     '  R = radius
  119.     '  C = fill color
  120.     Dim Radius As Integer, RadiusError As Integer
  121.     Dim X As Integer, Y As Integer
  122.     Radius = Abs(R)
  123.     RadiusError = -Radius
  124.     X = Radius
  125.     Y = 0
  126.     If Radius = 0 Then PSet (CX, CY), C: Exit Sub
  127.     Line (CX - X, CY)-(CX + X, CY), C, BF
  128.     While X > Y
  129.         RadiusError = RadiusError + Y * 2 + 1
  130.         If RadiusError >= 0 Then
  131.             If X <> Y + 1 Then
  132.                 Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  133.                 Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  134.             End If
  135.             X = X - 1
  136.             RadiusError = RadiusError - X * 2
  137.         End If
  138.         Y = Y + 1
  139.         Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  140.         Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  141.     Wend
  143.  
« Last Edit: March 12, 2022, 01:07:40 pm by Petr »
Logged

Offline johnno56

  • Forum Resident
  • Posts: 1270
  • Live long and prosper.
Re: Next one Music Visualizer
« Reply #1 on: March 14, 2022, 03:43:47 am »
Very cool indeed! Well done!
Logged
Logic is the beginning of wisdom.

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
Re: Next one Music Visualizer
« Reply #2 on: March 16, 2022, 01:04:37 pm »
@johnno56

Thank you for trying it. I am glad, that you like it!
Logged

Offline SierraKen

  • Forum Resident
  • Posts: 1454
Re: Next one Music Visualizer
« Reply #3 on: March 16, 2022, 07:01:18 pm »
Incredible Petr! There was something similar to this a year or 2 ago on here that I was messing with on songs, but it wasn't terrain. Good work! I'm going to have to learn how you made the terrain  without the music. Thank you!
Logged

Offline OldMoses

  • Seasoned Forum Regular
  • Posts: 469
Re: Next one Music Visualizer
« Reply #4 on: March 18, 2022, 03:38:34 pm »
That's an amazing effect. I ran a mp3 song through it and noticed the amplitude of the terrain suddenly increased significantly while the sound remained relatively the same. Must have been picking up something subtle in the encoding...
Logged

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
Re: Next one Music Visualizer
« Reply #5 on: March 19, 2022, 05:59:34 am »
Quote from: OldMoses on March 18, 2022, 03:38:34 pm
That's an amazing effect. I ran a mp3 song through it and noticed the amplitude of the terrain suddenly increased significantly while the sound remained relatively the same. Must have been picking up something subtle in the encoding...

Yes, this is because it is used to visualize the line every 8192th audio sample. Then the line is moved one step closer in the Z axis (it has a higher coordinate number, the nearest visible one is -1, 0 is no longer invisible and 1 is basically in front of the monitor). For a finer display, I had each sample drawn, it's this source code, the edit is on line 39. Still, not every sample will be rendered now. Why?
In order to render virtually every sound sample, you must first determine in how many frames per second the program will run.
Suppose you set 50 frames per second for smooth graphics. For sound, this means 44100 (SNDRATE) / 50 samples per second, that is 882 samples. But that also means overwriting 882 values in memory 50 times per second.
In this program, this is solved by not tracking exactly where you ended up rendering. Simply take the current position of the sound and load more samples from it. Therefore, it can easily happen that some samples simply fall out before the whole thing is rendered.
  Under line 61, the program solves normal 2D graphics for blinking background circles.

This source code try use "every" sample:

Code: QB64: [Select]
  2. 'sky texture
  3. Texture2 = NewImage(255, 255, 32)
  4. Dest Texture2
  5. For diY = 0 To 100
  6.     Line (diY + 20, diY + 20)-(235 - diY, 235 - diY), RGBA32(67, 100, 255 - diY, 255 - diY), B
  7.     Circle (127, 127), 100 + diY, RGBA32(155 - diY, diY / 2, 20 + diY, 155 - diY)
  9. 'earth texture
  10. Texture = NewImage(255, 255, 32)
  11. Dest Texture
  12. Cls , &HFFFF0000
  13. For diY = 0 To 100
  14.     Line (diY + 20, diY + 20)-(235 - diY, 235 - diY), RGB32(diY, 0, 0), B
  16. Dest 0
  17. Dim As Long SND, Position, FillCachem, HT
  18. Dim As Float IL, IR, IntensityLeft, IntensityRight
  19. Dim As MEM L, R
  20. Dim As Unsigned Byte Rc, Gc, Bc
  21. ReDim LightsL(10) As Unsigned Byte
  22. ReDim LightsR(10) As Unsigned Byte
  23. Dim M3D(90, 90) As Single
  24. Dim M2D(90, 90) As Single
  25. SND = SndOpen("bb.mp3") '            <-----------------  insert here your sound file name!
  26. VOL = 10
  27. SndVol SND, VOL / 20
  28. L = MemSound(SND, 1)
  29. R = MemSound(SND, 2)
  30. DW = DesktopWidth
  31. DH = DesktopHeight
  32. HT = CopyImage(Texture, 33)
  33. HT2 = CopyImage(Texture2, 33)
  34. FreeImage Texture
  35. Screen NewImage(DW, DH, 32)
  36. FullScreen
  37. SndPlay SND
  38. Do Until Position >= L.SIZE - 882 'CHANGED
  39.     ShiftIt = 89
  40.     Do Until ShiftIt < 0
  41.         For rows = 0 To 90
  42.             Swap M3D(rows, ShiftIt), M3D(rows, ShiftIt + 1)
  43.             Swap M2D(rows, ShiftIt), M2D(rows, ShiftIt + 1)
  44.         Next
  45.         ShiftIt = ShiftIt - 1
  46.     Loop
  47.     Depth = 0
  48.     Do Until Depth = 180 '                              This fill 3D visualisation in X axis. One sample is long 2 bytes, one row is 90 points long. This fill 90 points.
  49.         If Depth + Position > L.SIZE Then End
  50.         M3D(ra, 0) = MemGet(L, L.OFFSET + Position + Depth, Integer) / 32768 * 1.7
  51.         M2D(ra, 0) = MemGet(R, R.OFFSET + Position + Depth, Integer) / 32768 * 1.7
  52.         Depth = Depth + 2 '                            This is byte counter and now use all samples not every 8192th as in previous case (first source code in this thread)
  53.         ra = ra + 1
  54.     Loop
  55.     ra = 0
  56.     For Z = 0 To 89
  57.         For X = 0 To 89
  58.             HX = -45 + X
  59.             HX2 = HX + 1
  60.             HZ = -89 + Z
  61.             HZ2 = HZ + 1
  62.             HY1 = -3 + M3D(X, Z): HY2 = -3 + M3D(X + 1, Z): HY3 = -3 + M3D(X, Z + 1): HY4 = -3 + M3D(X + 1, Z + 1)
  63.             HY11 = 3 - M2D(X, Z): HY12 = 3 - M2D(X + 1, Z): HY13 = 3 - M2D(X, Z + 1): HY14 = 3 - M2D(X + 1, Z + 1)
  64.             MapTriangle (0, 0)-(255, 0)-(0, 255), HT To(HX, HY1, HZ)-(HX2, HY2, HZ)-(HX, HY3, HZ2), 0, Smooth
  65.             MapTriangle (255, 0)-(0, 255)-(255, 255), HT To(HX2, HY2, HZ)-(HX, HY3, HZ2)-(HX2, HY4, HZ2), 0, Smooth
  66.             MapTriangle (0, 0)-(255, 0)-(0, 255), HT2 To(HX, HY11, HZ)-(HX2, HY12, HZ)-(HX, HY13, HZ2), 0, Smooth
  67.             MapTriangle (255, 0)-(0, 255)-(255, 255), HT2 To(HX2, HY12, HZ)-(HX, HY13, HZ2)-(HX2, HY14, HZ2), 0, Smooth
  68.     Next X, Z
  69.  
  70.     '----------------------------------------------------------------------------------------------------------- CIRCLES --------------------------------------------------------------
  71.     FillCache = 0
  72.     IntensityLeft = 0
  73.     IntensityRight = 0
  74.     Do Until FillCache = 882
  75.         IntensityLeft = IntensityLeft + Abs(MemGet(L, L.OFFSET + Position + FillCache, Integer) / 32768)
  76.         IntensityRight = IntensityRight + Abs(MemGet(R, R.OFFSET + Position + FillCache, Integer) / 32768)
  77.         FillCache = FillCache + 2
  78.     Loop
  79.     IL = IntensityLeft / 2 '                                                                   recalc values as decimal
  80.     IR = IntensityRight / 2
  81.     ReDim LightsL(10) As Unsigned Byte
  82.     ReDim LightsR(10) As Unsigned Byte
  83.     CLL = 0
  84.     Do Until IL <= 0
  85.         If IL > 4.41 Then LightsL(CLL) = 255 Else LightsL(CLL) = IL * 57
  86.         IL = IL - 4.41
  87.         CLL = CLL + 1
  88.         MAX CLL, 10
  89.     Loop
  90.     CLR = 0
  91.     Do Until IR <= 0
  92.         If IR > 4.41 Then LightsR(CLR) = 255 Else LightsR(CLR) = IR * 57
  93.         IR = IR - 4.41
  94.         CLR = CLR + 1
  95.         MAX CLR, 10
  96.     Loop
  97.     IL = 0
  98.     IR = 0
  99.     For DL = 0 To 10
  100.         Select Case DL
  101.             Case 0 TO 5
  102.                 Rc = 0: Gc = 255: Bc = 0
  103.             Case 6 TO 8
  104.                 Rc = 255: Gc = 255: Bc = 0
  105.             Case Is > 8
  106.                 Rc = 255: Gc = 0: Bc = 0
  107.         End Select
  108.         CircleFill Width / 2 - 50 - DL * 80, Height / 2, 30, &HFF000000
  109.         CircleFill Width / 2 - 50 - DL * 80, Height / 2, 30, RGBA32(Rc, Gc, Bc, LightsL(DL))
  110.         CircleFill Width / 2 + 50 + DL * 80, Height / 2, 30, &HFF000000
  111.         CircleFill Width / 2 + 50 + DL * 80, Height / 2, 30, RGBA32(Rc, Gc, Bc, LightsR(DL))
  112.     Next
  113.     Display
  114.     Limit 50
  115.     Position = SndGetPos(SND) * SndRate * 2
  117.  
  119.  
  120. Sub MAX (Value, mv)
  121.     If Value > mv Then Value = mv
  123.  
  124. Sub CircleFill (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
  125.     ' CX = center x coordinate
  126.     ' CY = center y coordinate
  127.     '  R = radius
  128.     '  C = fill color
  129.     Dim Radius As Integer, RadiusError As Integer
  130.     Dim X As Integer, Y As Integer
  131.     Radius = Abs(R)
  132.     RadiusError = -Radius
  133.     X = Radius
  134.     Y = 0
  135.     If Radius = 0 Then PSet (CX, CY), C: Exit Sub
  136.     Line (CX - X, CY)-(CX + X, CY), C, BF
  137.     While X > Y
  138.         RadiusError = RadiusError + Y * 2 + 1
  139.         If RadiusError >= 0 Then
  140.             If X <> Y + 1 Then
  141.                 Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  142.                 Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  143.             End If
  144.             X = X - 1
  145.             RadiusError = RadiusError - X * 2
  146.         End If
  147.         Y = Y + 1
  148.         Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  149.         Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  150.     Wend
  152.  

Due to the adjustment, I also had to adjust the rendering of the circles. This brought a noticeable increase in speed (not so many shades are used anymore, only about 5 for the color intensity of the circle)
« Last Edit: March 19, 2022, 06:16:44 am by Petr »
Logged
Pages: [1]   Go Up
« previous next »