[bb] Create seamless texture function by elias_t [ 1+ years ago ]

[BlitzBot]

Title : Create seamless texture function
Author : elias_t
Posted : 1+ years ago

Description : This is the "create seamless texture function".
I made this following the tutorial and code samples by Paul Bourke.
<a href="http://astronomy.swin.edu.au/~pbourke/" target="_blank">http://astronomy.swin.edu.au/~pbourke/[/url]

The image doesn't have to be square.

[ updated: added 2 new Linear methods]

Code :

Code: BlitzBasic

1. ;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
2. ;
3. ; Seamless texture generation Function
4. ;
5. ; by elias_t
6. ;
7. ; Created after a tutorial by Paul Bourke.
8. ;
9. ; updated to make the linear methods work better.
10. ;
11. ;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
12.  
13.  
14. ;example
15. Graphics 640,480,32,2
16.  
17. img=LoadImage("your_image.bmp");your image here
18.  
19.  
20. ;0=Radial   method
21. ;1=Linear 1 method
22. ;2=Linear 2 method
23.  
24.  
25. seamless=make_seamless(img,0)
26.  
27.  
28. SaveImage (seamless,"seamless.bmp")
29.  
30. TileImage seamless,0,0
31.  
32. ;DrawImage seamless,0,0
33.  
34. Flip
35.  
36. WaitKey()
37.  
38. End
39.  
40.  
41.  
42.  
43.  
44.  
45.  
46.  
47.  
48. ;*************************************************************************
49.  
50. ;needed arrays
51. Dim image(0,0,0) , diagonal(0,0,0) , tile(0,0,0) , mask(0,0)
52.  
53.  
54.  
55. ;img=image handle
56. ;masktype= [0=Radial , 1=Linear] method
57.  
58. Function make_seamless(img,masktype)
59.  
60.  
61. Local a1#,a2#,d#
62.  
63. ;protect masktype
64. masktype=Abs(masktype)
65. If masktype>2 Then masktype=2
66.  
67. ;find largest side of the image
68. x=ImageWidth(img)
69. y=ImageHeight(img)
70.  
71. ;and resize the image to become square
72. If x<>y
73. If x>y Then N=x
74. If y>x Then N=y
75. ResizeImage img,N,N
76. EndIf
77.  
78. If x=y Then N=x
79.  
80. Dim image(N,N,2)
81. Dim diagonal(N,N,2)
82. Dim tile(N,N,2)
83. Dim mask(N,N)
84.  
85.  
86.  
87. LockBuffer (ImageBuffer(img))
88.  
89.         For j=0 To N-1
90.                
91.                 For i=0 To N-1
92.                
93.                 rgb=ReadPixelFast(j,i,ImageBuffer(img))
94.  
95.                 image(i,j,0) = (rgb Shr 16 And $ff)
96.                 image(i,j,1) = (rgb Shr 8 And $ff)
97.                 image(i,j,2) = (rgb And $ff)
98.  
99.         diagonal ( (i+N/2) Mod N , (j+N/2) Mod N ,0) = image(i,j,0)
100.                 diagonal ( (i+N/2) Mod N , (j+N/2) Mod N ,1) = image(i,j,1)
101.                 diagonal ( (i+N/2) Mod N , (j+N/2) Mod N ,2) = image(i,j,2)
102.  
103.                 Next
104.  
105.         Next
106.  
107.  
108. UnlockBuffer (ImageBuffer(img))
109.  
110.  
111. ;try to make your own masktypes here
112.  
113. ;Create the mask
114.    For i=0 To N/2-1
115.  
116.       For j=0 To N/2-1
117.  
118.                 Select masktype
119.  
120.                 Case 0;RADIAL
121.                         d = Sqr((i-N/2)*(i-N/2) +  (j-N/2)*(j-N/2)) / (N/2)
122.            
123.                 Case 1;LINEAR 1
124.                         If (N/2-i)< (N/2-j)
125.                         d=Sqr((j-N/2)*(j-N/2))/(N/2)
126.                         EndIf
127.                        
128.                         If (N/2-i)>= (N/2-j)
129.                         d=Sqr((i-N/2)*(i-N/2) ) /(N/2)
130.                         EndIf
131.  
132.  
133.                 Case 2;LINEAR 2
134.                         If (N/2-i)<(N/2-j)
135.                         d=Sqr((j-N)*(j-N) +  (i-N)*(i-N)) / (1.13*N)
136.                         EndIf
137.                        
138.                         If (N/2-i)>=(N/2-j)
139.                         d=Sqr((i-N)*(i-N) +  (j-N)*(j-N)) / (1.13*N)
140.                         EndIf
141.  
142.                        
143.                 End Select
144.                
145.  
146.          ;Scale d To range from 1 To 255
147.  
148.          d = 255 - (255 * d)
149.          If (d < 1) Then d = 1
150.          If (d > 255) Then d = 255
151.  
152.  
153.          ;Form the mask in Each quadrant
154.  
155.          mask (i     , j    ) = d
156.          mask (i     , N-1-j) = d
157.          mask (N-1-i , j    ) = d
158.          mask (N-1-i , N-1-j) = d
159.  
160.  
161.                 Next
162.                
163.         Next
164.  
165.  
166.  
167. ;Create the tile
168.         For j=0 To N-1
169.        
170.                 For i=0 To N-1
171.  
172.                 a1 = mask(i,j)
173.                 a2 = mask( (i+N/2) Mod N , (j+N/2) Mod N )
174.                 tile(i,j,0) = a1*image(i,j,0)/(a1+a2) + a2*diagonal(i,j,0)/(a1+a2)
175.                 tile(i,j,1) = a1*image(i,j,1)/(a1+a2) + a2*diagonal(i,j,1)/(a1+a2)
176.                 tile(i,j,2) = a1*image(i,j,2)/(a1+a2) + a2*diagonal(i,j,2)/(a1+a2)
177.                
178.                 Next
179.                
180.         Next
181.  
182.  
183. ;create the new tileable image
184.  
185. img2=CreateImage(N,N)
186.  
187. LockBuffer (ImageBuffer(img2))
188.  
189.    For j=0 To N-1
190.  
191.       For i=0 To N-1
192.                
193.                 rgb=(tile(i,j,0) Shl 16) + (tile(i,j,1) Shl 8) + tile(i,j,2)
194.                 WritePixelFast j,i,rgb,ImageBuffer(img2)
195.  
196.                 Next
197.                
198.         Next
199.  
200. UnlockBuffer (ImageBuffer(img2))
201.  
202. Dim image(0,0,0) , diagonal(0,0,0) , tile(0,0,0) , mask(0,0)
203.  
204. ;if it wasn't a square image, resize it back to the original scale
205. If x<>y Then ResizeImage img2,x,y
206.  
207. Return img2
208.  
209. End Function

Comments :


Yo! Wazzup?(Posted 1+ years ago)

 THANK YOU SO MUCH. I was actually going to consider buying a seamless texture thing, lol. Ah, the beautiness of the public domain