Ooops
March 01, 2021, 10:10:51 PM

Author Topic: [bb] Sand texture map generator by Nebula [ 1+ years ago ]  (Read 414 times)

Offline BlitzBot

  • Jr. Member
  • **
  • Posts: 1
[bb] Sand texture map generator by Nebula [ 1+ years ago ]
« on: June 29, 2017, 12:28:39 AM »
Title : Sand texture map generator
Author : Nebula
Posted : 1+ years ago

Description : Creates screens with sand like colors. Per cursor key pres a new sand pattern is created. These raw drawings would look great behind title screens if you fix them up.

Code :
Code: BlitzBasic
  1. ;
  2. ;
  3. ;
  4. ;
  5. ;
  6. Graphics 640,480,16,2
  7. SetBuffer BackBuffer()
  8. ;
  9. Global bbuffer = CreateImage(GraphicsWidth(),GraphicsHeight())
  10. ;
  11. Type bmap      
  12.         Field map
  13. End Type
  14. ;
  15. SeedRnd MilliSecs()
  16. Global n# , nn#
  17. Global uy  = 245
  18. Global ly  = 245
  19. Global n2# = 360/2
  20. Global n3# = 284
  21. Global ax  = GraphicsWidth()
  22. ;
  23. Dim clock360(5000)
  24. For i=0 To 5000 : clock360(i) = Rand(360) : Next
  25. ;
  26. Dim sy(600,1);x1,x2
  27. ;
  28. setscanline()
  29. ;
  30. While KeyDown( 1 ) = False
  31.         Cls
  32.         ;
  33.         ms = MilliSecs()
  34.         For i=0 To 10
  35.                 r=255-i*5
  36.                 g=255-i*9
  37.                 b=255-i*12
  38.                 tex Rand(-100,100)*i,Rand(-i*15,300-(i*10)),r,g,b;
  39. ;               q1 = q1 + 5
  40. ;               q2 = q2 + 5
  41. ;               q3 = q3 + 5
  42.         Next
  43.         ;
  44.         Color 255,255,255
  45.         Text GraphicsWidth()-120,0,MilliSecs()-ms
  46.         ;
  47.         Flip
  48.         WaitKey
  49.         ;
  50.         ;Delay 100
  51.         ;Color 0,0,0 : Rect 0,0,100,50,True : Color 255,255,255
  52.         ;Text 0,0,outval$
  53.         ;Text 0,20,n2
  54.         ;
  55.         ;
  56.         Flip
  57. Wend
  58. End
  59. ;
  60. Function tex(x,y,r,g,b)
  61.         SetBuffer ImageBuffer(bbuffer)
  62.         Cls
  63.         makeredsurface ;100,100
  64.         connectscanline r,g,b
  65.         im.bmap = New bmap
  66.         immap = CreateImage(256,256)
  67.         GrabImage immap,0,0
  68.         SetBuffer BackBuffer()
  69.         For i=0 To 4
  70.                 DrawImage immap,Rand(400)+x,Rand(200)+y
  71.         Next
  72. End Function
  73.  
  74. ;
  75. Function makeredsurface(nx=0,ny=0)
  76. ;n# , nn#
  77. setscanline
  78.  
  79. SeedRnd MilliSecs()
  80. uy  = 245
  81. ly  = 245
  82. n2# = 360/2
  83. n3# = 284
  84. ax  = GraphicsWidth()
  85. n=Rand(0,350)
  86. While KeyDown(1) = False
  87.         If n < 359 Then
  88.         n = n + 1 : n2 = n2 + 4.1
  89.         If n3 < 359 Then n3 = n3 + 1 Else n3=clock360(cnt+100)
  90.         If n2>360 Then n2 = clock360(cnt+400)
  91.         nn = nn + .1
  92.         Else
  93. ;       Flip
  94.         Return
  95.         End If
  96.         ;
  97.         ax = (Cos(n) * 90)                     
  98.         ay = ((Sin(n3) * (50 )))
  99.         tx = ( ax )
  100.         ty = ( ay ) + ( Cos(n2)*Rand(1,12) )
  101.         ;      
  102.         If ty < uy Then
  103.                 touch = 1  : uy = ty :
  104.  
  105.                 mrect(tx,uy,2,ly-uy,0)
  106.                 uy = 96
  107.                 ly = 96
  108.         End If
  109.         If ty > ly Then
  110.                 touch = -1 : ly = ty :
  111.                 mrect(tx,(ly-uy+20),2,ly-uy,1)
  112.                 uy = 96
  113.                 ly = 96
  114.         End If
  115.         cnt=cnt+1
  116. Wend
  117.  
  118. End Function
  119.  
  120. ;
  121. Function mrect(x1,y1,w1,h1#,tp)
  122.         Local w#,h#,x#,y#
  123.  
  124.         y1=y1+100
  125.         x1=x1+100
  126.  
  127.         x = (x1*3/2)
  128.         y = (y1*2/2)
  129.         w = (((w1*Rand(2,36))/2)*2)
  130.         h = 2
  131.         x=x/2.4;1.5
  132.         y=(y*1)+32;2
  133.         w=w*1;3
  134.         h=h*1;3
  135.        
  136.         If x < sy(y,0) Then sy(y,0) = x
  137.         If x+w+28 < sy(y,1) Then sy(y,1) = x+w
  138. End Function
  139.  
  140. Function connectscanline(ar#,ag#,ab#)
  141.                 ;
  142.                 Local mm#[16201]
  143.                 Local n#
  144.                 ;
  145.                 For i=0 To 16200
  146.                         mm[i] = 255-n
  147.                         n = n +.01566
  148.                 Next
  149.                 n=0
  150.                 g=ag;20
  151.                 b=ab;10
  152.                 LockBuffer ImageBuffer(bbuffer)
  153.                 For nx=-4 To 4
  154.                 For ny=-4 To 4         
  155.                 For i=1 To 200 
  156.                         Color ar-mm[n],ag-mm[n],ab-mm[n]
  157.                        
  158.                         If sy(i,0) < 250 Then
  159.  
  160.                         WritePixelFast sy(i,0)+nx*Rand(10)+32,i+ny*Rand(10),getrgb(ColorRed(),ColorGreen(),ColorBlue())
  161.                         WritePixelFast sy(i,1)+nx*Rand(10)+32,i+ny*Rand(10),getrgb(ColorRed(),ColorGreen(),ColorBlue())
  162.  
  163.  
  164.                         End If
  165.                         n = n + 1
  166.                 Next
  167.                 Next
  168.                 Next
  169.                 UnlockBuffer ImageBuffer(bbuffer)
  170.         ;
  171. End Function
  172.  
  173. Function setscanline()
  174.         For i=0 To GraphicsHeight()
  175.                 sy(i,0) = GraphicsWidth()/2
  176.                 sy(i,1) = GraphicsWidth()/2
  177.         Next
  178. End Function
  179.  
  180. Function makescanline()
  181.         Color 100,0,0
  182.         For i=1 To GraphicsHeight()
  183.                 If sy(i,1) <> sy(i+1,1)
  184.                         Rect sy(i,0),i,sy(i,1),1               
  185.                 End If
  186.         Next
  187. End Function
  188.  
  189. ;Standard functions for converting colour to RGB values, for WritePixelFast and ReadPixelFast
  190. Function GetRGB(r,g,b)
  191.         Return b Or (g Shl 8) Or (r Shl 16)
  192. End Function
  193.  
  194. Function GetR(rgb)
  195.     Return rgb Shr 16 And %11111111
  196. End Function
  197.  
  198. Function GetG(rgb)
  199.         Return rgb Shr 8 And %11111111
  200. End Function
  201.  
  202. Function GetB(rgb)
  203.         Return rgb And %11111111
  204. End Function


Comments : none...

 

SimplePortal 2.3.6 © 2008-2014, SimplePortal