MAPTRIANGLE in 3D

[STxAxTIC]

A lovely response Petr with plenty of details! I have read it all carefully and ran the example programs. Thanks for taking the time to explain your process to me, and god willing, everyone else too. I'll be watching your posts about 3D more carefully for now on! Seems like you're on a positive track, and I wish you well in hitting all the milestones.

[Pete]

I love reading this stuff, even if I only understand about half of it, which is 180 degrees from not understanding any of it at all. I'm waiting for 3D golf simulation or better yet, a holograph. You'll need to be able to calculate the off-monitor coordinates for that, because I have a nasty slice! How does a golfer compensate for a nasty slice? Pair up with a nasty hooker... but I digress. Anyway, of all things, 3D golf would probably bore the heck out of you guys, but it is interesting to me. There is a lot of mathematical calculations that go into quality golf simulators, which can sell for 80,000 with the best video, launch monitors and software included. Prior to golf simulators, flight simulators and the animations used to make Star Wars, not a fan, btw... were probably some of the earliest 3D code examples I can recall. To be able to even scratch the surface with this stuff wasn't all that possible in QB, but it appears QB64 has some promising potential.

Anyway, great work, very interesting and I'm happy you have such a keen interest in developing more complex  routines with your abilities.

Pete

[Ashish]

Fantastic work Petr! I could even see ping-pong game being played on computer!
Again,.... great job! :D

[Petr]

Thank you all for positive feedback! I very much appreciate it!

[Petr]

Hi. This source code enjoys improved controls, so you can look up and down and do sidestep. Controls is differ slightly from the previous program, use the mouse or A, Z  to navigate, use the up and down arrows, and the left and right arrows for sidestep.

The principle of up and down view control is such that the view in the X and Z axis is first calculated, as in the previous program, but unlike the previous program, this calculation is not displayed, but this calculated Z value for each point is recalculated to the new Z in relation to Y according to the angle of rotation to the ceiling or to the floor. In the program it is marked with comments. Use the same PMF file to try. Next time, I'll try do another room as in my imagination.

Quit program using ESC.

Code: QB64: [Select]

1.  
2. DIM SHARED lX, lY, rXx, rY, mX, mY, ballX AS INTEGER, ballY AS INTEGER, m&, leftplr, rightplr
3. m& = _NEWIMAGE(320, 240, 32)
4. lX = 10: lY = 10: rXx = 310: rY = 10
5. ballX = 160: ballY = 10: mY = -1: IF RND * 10 > 5 THEN mX = 1 ELSE mX = -1
6.  
7.  
8.  
9. DIM SHARED dub AS LONG, aluminium AS LONG
10.  
11. PRINT "Loading textures..."
12. ExtractPMF ("textures.pmf")
13.  
14. aluminium& = Hload("alum.jpg")
15. podl& = Hload("plovoucka.jpg")
16. str& = strop&
17. tokno& = okno&
18. dvere& = spajz_dvere&
19. lednice& = Hload("lednice2.jpg")
20. orech& = Hload("dekor orech.jpg")
21. orechsv& = Zesvetli("dekor orech.jpg")
22. polstr& = Hload("polstr.jpg")
23. dub& = Hload("dub.jpg")
24. tdub& = Ztmav("dub.jpg")
25. pc& = SHload("pccs.png")
26. kbd& = SHload("kbd.jpg")
27. mys& = SHload("mys.jpg")
28. woof& = SHload("repro.png")
29. speak& = Hload("speaker.jpg")
30. dlazba& = Hload("obklad.jpg")
31. dlazba2& = Hload("obklad 2.jpg")
32. sporakcelo = Hload("sporak-celo.jpg")
33. sporakvrch = Hload("sporak-vrch.jpg")
34. mikro& = SHload("mikro2.jpg")
35.  
36. DIM SHARED N
37. SCREEN _NEWIMAGE(_DESKTOPWIDTH, _DESKTOPHEIGHT, 32)
38.  
39. CX = 0: CY = 0: CZ = -1 '                                                          rotation center point - CAMERA
40. N = 1116 '432 pri modernizaci do JK!
41.  
42.  
43. TYPE V
44.     X AS SINGLE '                                                                  source X points in standard view
45.     Y AS SINGLE '                                                                  source Y points in standard view
46.     Z AS SINGLE '                                                                  not use yet
47.     pi AS SINGLE '                                                                 start draw position on radius
48.     piH AS SINGLE '                                                                pi for point on circle circuit position for look up / dn
49.     Radius AS SINGLE '                                                             radius (every point use own, but if is CX and CY in middle, are all the same)
50.     RadiusH AS SINGLE '                                                            radius floor / ceiling
51.     wX AS SINGLE '                                                                 working coordinates X
52.     wY AS SINGLE '                                                                 Y axis
53.     wZ AS SINGLE '                                                                 first Z. Used for view in previous program
54.     wZ2 AS SINGLE '                                                                second Z calculated from wZ
55.     T AS LONG '                                                                    texture number for current triangle
56.     Tm AS SINGLE '                                                                 texture multiplicier. 1 for one.
57. END TYPE
58.  
59.  
60. DIM SHARED v(1 TO N) AS V
61. DIM SHARED OldMouseX AS INTEGER, OldMouseY AS INTEGER
62. WHILE _MOUSEINPUT: WEND
63. _FULLSCREEN
64. _MOUSEMOVE _DESKTOPWIDTH / 2, _DESKTOPHEIGHT / 2
65. OldMouseX = _DESKTOPWIDTH / 2
66. OldMouseY = _DESKTOPHEIGHT / 2
67.  
68.  
69. '         A          B        C         D
70. DATA -10,-2,-5,-10,-2,10,10,-2,-5,10,-2,10: ' floor coordinates
71. DATA -10,2,-5,-10,2,10,10,2,-5,10,2,10: '     roof coordinates
72. DATA -10,-2,-5,-10,-2,10,-10,2,-5,-10,2,10: ' wall + window
73. DATA -5,-2,8,-10,-2,8,-5,2,8,-10,2,8
74. 'refrigerator
75. DATA -5,-2,8,-5,-2.1,10,-5,2.1,8,-5,2,10
76. DATA -5,-3,10,10,-3,10,-5,3,10,10,3,10
77. DATA -4.8,-2,8,-3,-2,8,-4.8,1,8,-3,1,8
78. DATA -5,1,8,-3,1,8,-5,1,10,-3,1,10
79. DATA -3,1,8,-3,1,10,-3,-2,8,-3,-2,10
80. DATA -4.8,1,8,-4.8,1,10,-4.8,-2,8,-4.8,-2,10
81. 'bench
82. DATA -2.8,-1.5,8,-2.8,-1.5,9,-2.8,-2,8,-2.8,-2,9
83. DATA -2.7,-1.5,8,-2.7,-1.5,9,-2.7,-2,8,-2.7,-2,9
84. DATA 0.8,-1.5,8,0.8,-1.5,9,0.8,-2,8,0.8,-2,9
85. DATA 0.7,-1.5,8,0.7,-1.5,9,0.7,-2,8,0.7,-2,9
86. DATA 0.7,-1.5,8,0.8,-1.5,8,.7,-2,8,0.8,-2,8
87. DATA -2.7,-1.5,8,-2.8,-1.5,8,-2.7,-2,8,-2.8,-2,8
88. DATA 2,-1.5,8,-3.0,-1.5,8,2,-1.5,10.5,-3.0,-1.5,10.5
89. DATA 4.39,-1.5,9.5,-3,-1.5,9.5,4.39,0,10,-3,0,10
90. DATA 1.9,-1.5,10,4.4,-1.5,10,1.9,-1.5,3,4.4,-1.5,3
91. DATA 3.9,-1.5,10,3.9,-1.5,3,4.4,0,10,4.4,0,3
92. DATA 1.9,-1.5,8,3.9,-1.5,8,1.9,-2,8,3.9,-2,8
93. DATA 1.9,-1.5,7.9,3.9,-1.5,7.9,1.9,-2,7.9,3.9,-2,7.9
94. DATA 1.9,-1.5,8,1.9,-1.5,7.9,1.9,-2,8,1.9,-2,7.9
95. DATA 1.9,-2,3,4.4,-2,3,1.9,-1.5,3,4.4,-1.5,3
96. DATA 1.9,-2,3.1,4.4,-2,3.1,1.9,-1.5,3.1,4.4,-1.5,3.1
97. DATA 4.4,-2,3.1,4.4,-2,3,4.4,-1.5,3.1,4.4,-1.5,3
98. DATA 1.9,-2,3.1,1.9,-2,3,1.9,-1.5,3.1,1.9,-1.5,3
99. DATA 3.9,-1.5,3,4.4,-1.5,3,4.4,0,3,4.4,0,3
100. DATA 4.4,-2,10,4.4,-2,3,4.4,0,10,4.4,0,3
101. DATA 1.5,-2,7.5,1.7,-2,7.5,1.5,-1,7.5,1.7,-1,7.5
102. DATA 1.5,-2,7.3,1.7,-2,7.3,1.5,-1,7.3,1.7,-1,7.3
103. DATA 1.5,-2,7.3,1.5,-1,7.3,1.5,-2,7.5,1.5,-1,7.5
104. DATA 1.7,-2,7.3,1.7,-1,7.3,1.7,-2,7.5,1.7,-1,7.5
105. DATA -2,-2,7.5,-2.2,-2,7.5,-2,-1,7.5,-2.2,-1,7.5
106. DATA -2,-2,7.3,-2.2,-2,7.3,-2,-1,7.3,-2.2,-1,7.3
107. DATA -2,-2,7.3,-2,-1,7.3,-2,-2,7.5,-2,-1,7.5
108. DATA -2.2,-2,7.3,-2.2,-1,7.3,-2.2,-2,7.5,-2.2,-1,7.5
109. DATA 1.5,-2,3.5,1.7,-2,3.5,1.5,-1,3.5,1.7,-1,3.5
110. DATA 1.5,-2,3.7,1.7,-2,3.7,1.5,-1,3.7,1.7,-1,3.7
111. DATA 1.5,-2,3.7,1.5,-1,3.7,1.5,-2,3.5,1.5,-1,3.5
112. DATA 1.7,-2,3.7,1.7,-1,3.7,1.7,-2,3.5,1.7,-1,3.5
113. DATA -2,-2,3.5,-2.2,-2,3.5,-2,-1,3.5,-2.2,-1,3.5
114. DATA -2,-2,3.7,-2.2,-2,3.7,-2,-1,3.7,-2.2,-1,3.7
115. DATA -2,-2,3.7,-2,-1,3.7,-2,-2,3.5,-2,-1,3.5
116. DATA -2.2,-2,3.7,-2.2,-1,3.7,-2.2,-2,3.5,-2.2,-1,3.5
117. DATA 1.5,-1,3.5,-2,-1,3.5,1.5,-1.1,3.5,-2,-1.1,3.5
118. DATA 1.5,-1,7.5,-2,-1,7.5,1.5,-1.1,7.5,-2,-1.1,7.5
119. DATA 1.7,-1,3.5,1.7,-1,7.5,1.7,-1.1,3.5,1.7,-1.1,7.5
120. DATA -2.2,-1,3.5,-2.2,-1,7.5,-2.2,-1.1,3.5,-2.2,-1.1,7.5
121. 'desk
122. DATA 1.8,-1,3.4,-2.3,-1,3.4,1.8,-1,7.6,-2.3,-1,7.6
123. DATA 1.8,-.9,3.4,-2.3,-.9,3.4,1.8,-.9,7.6,-2.3,-.9,7.6
124. DATA 1.8,-.9,3.4,-2.3,-.9,3.4,1.8,-1,3.4,-2.3,-1,3.4
125. DATA 1.8,-.9,7.6,-2.3,-.9,7.6,1.8,-1,7.6,-2.3,-1,7.6
126. DATA 1.8,-.9,3.4,1.8,-1,3.4,1.8,-.9,7.6,1.8,-1,7.6
127. DATA -2.3,-.9,3.4,-2.3,-1,3.4,-2.3,-.9,7.6,-2.3,-1,7.6
128. 'chair
129. DATA .3,-2,3.9,.4,-2,3.9,.3,-1.5,3.9,.4,-1.5,3.9
130. DATA .3,-2,3.8,.4,-2,3.8,.3,-1.5,3.8,.4,-1.5,3.8
131. DATA .3,-2,3.8,.3,-2,3.9,.3,-1.5,3.8,.3,-1.5,3.9
132. DATA .4,-2,3.8,.4,-2,3.9,.4,-1.5,3.8,.4,-1.5,3.9
133. DATA -.7,-2,3.9,-.8,-2,3.9,-.7,-1.5,3.9,-.8,-1.5,3.9
134. DATA -.7,-2,3.8,-.8,-2,3.8,-.7,-1.5,3.8,-.8,-1.5,3.8
135. DATA -.7,-2,3.8,-.7,-2,3.9,-.7,-1.5,3.8,-.7,-1.5,3.9
136. DATA -.8,-2,3.8,-.8,-2,3.9,-.8,-1.5,3.8,-.8,-1.5,3.9
137. DATA .3,-2,3,.4,-2,3,.3,-1.5,3,.4,-1.5,3
138. DATA .3,-2,3.1,.4,-2,3.1,.3,-1.5,3.1,.4,-1.5,3.1
139. DATA .3,-2,3.1,.3,-2,3,.3,-1.5,3.1,.3,-1.5,3
140. DATA .4,-2,3.1,.4,-2,3,.4,-1.5,3.1,.4,-1.5,3
141. DATA -.7,-2,3,-.8,-2,3,-.7,-1.5,3,-.8,-1.5,3
142. DATA -.7,-2,3.1,-.8,-2,3.1,-.7,-1.5,3.1,-.8,-1.5,3.1
143. DATA -.7,-2,3.1,-.7,-2,3,-.7,-1.5,3.1,-.7,-1.5,3
144. DATA -.8,-2,3.1,-.8,-2,3,-.8,-1.5,3.1,-.8,-1.5,3
145. DATA .5,-1.5,4.1,-.9,-1.5,4.1,.5,-1.5,2.9,-.9,-1.5,2.9
146. DATA .5,-1.4,4.1,-.9,-1.4,4.1,.5,-1.4,2.9,-.9,-1.4,2.9
147. DATA .5,-1.5,4.1,-.9,-1.5,4.1,.5,-1.4,4.1,-.9,-1.4,4.1
148. DATA .5,-1.5,2.9,-.9,-1.5,2.9,.5,-1.4,2.9,-.9,-1.4,2.9
149. DATA -.9,-1.5,2.9,-.9,-1.4,2.9,-.9,-1.5,4.1,-.9,-1.4,4.1
150. DATA .5,-1.5,2.9,.5,-1.4,2.9,.5,-1.5,4.1,.5,-1.4,4.1
151. DATA -.9,-1.5,2.9,.5,-1.5,2.9,-.9,0,2.7,.5,0,2.7
152. DATA -.9,-1.5,3,.5,-1.5,3,-.9,0,2.8,.5,0,2.8
153. DATA -.9,-1.5,2.9,-.9,-1.5,3,-.9,0,2.7,-.9,0,2.8
154. DATA -.9,0,2.9,.5,0,2.9,-.9,0,2.7,.5,0,2.7
155. DATA .5,-1.5,2.9,.5,-1.5,3,.5,0,2.7,.5,0,2.8
156.  
157. 'chair 2
158. DATA -1.3,-2,4.9,-1.4,-2,4.9,-1.3,-1.5,4.9,-1.4,-1.5,4.9
159. DATA -1.3,-2,4.8,-1.4,-2,4.8,-1.3,-1.5,4.8,-1.4,-1.5,4.8
160. DATA -1.3,-2,4.8,-1.3,-2,4.9,-1.3,-1.5,4.8,-1.3,-1.5,4.9
161. DATA -1.4,-2,4.8,-1.4,-2,4.9,-1.4,-1.5,4.8,-1.4,-1.5,4.9
162. DATA -1.3,-2,5.9,-1.4,-2,5.9,-1.3,-1.5,5.9,-1.4,-1.5,5.9
163. DATA -1.3,-2,5.8,-1.4,-2,5.8,-1.3,-1.5,5.8,-1.4,-1.5,5.8
164. DATA -1.3,-2,5.8,-1.3,-2,5.9,-1.3,-1.5,5.8,-1.3,-1.5,5.9
165. DATA -1.4,-2,5.8,-1.4,-2,5.9,-1.4,-1.5,5.8,-1.4,-1.5,5.9
166. DATA -2.3,-2,4.9,-2.4,-2,4.9,-2.3,-1.5,4.9,-2.4,-1.5,4.9
167. DATA -2.3,-2,4.8,-2.4,-2,4.8,-2.3,-1.5,4.8,-2.4,-1.5,4.8
168. DATA -2.3,-2,4.8,-2.3,-2,4.9,-2.3,-1.5,4.8,-2.3,-1.5,4.9
169. DATA -2.4,-2,4.8,-2.4,-2,4.9,-2.4,-1.5,4.8,-2.4,-1.5,4.9
170. DATA -2.3,-2,5.9,-2.4,-2,5.9,-2.3,-1.5,5.9,-2.4,-1.5,5.9
171. DATA -2.3,-2,5.8,-2.4,-2,5.8,-2.3,-1.5,5.8,-2.4,-1.5,5.8
172. DATA -2.3,-2,5.8,-2.3,-2,5.9,-2.3,-1.5,5.8,-2.3,-1.5,5.9
173. DATA -2.4,-2,5.8,-2.4,-2,5.9,-2.4,-1.5,5.8,-2.4,-1.5,5.9
174. DATA -1.2,-1.5,4.7,-2.5,-1.5,4.7,-1.2,-1.5,6,-2.5,-1.5,6
175. DATA -1.2,-1.4,4.7,-2.5,-1.4,4.7,-1.2,-1.4,6,-2.5,-1.4,6
176. DATA -1.2,-1.5,4.7,-2.5,-1.5,4.7,-1.2,-1.4,4.7,-2.5,-1.4,4.7
177. DATA -1.2,-1.5,6,-2.5,-1.5,6,-1.2,-1.4,6,-2.5,-1.4,6
178. DATA -1.2,-1.5,4.7,-1.2,-1.4,4.7,-1.2,-1.5,6,-1.2,-1.4,6
179. DATA -2.5,-1.5,4.7,-2.5,-1.4,4.7,-2.5,-1.5,6,-2.5,-1.4,6
180. DATA -2.3,-1.5,4.7,-2.3,-1.5,6,-2.5,0,4.7,-2.5,0,6
181. DATA -2.4,-1.5,4.7,-2.4,-1.5,6,-2.6,0,4.7,-2.6,0,6
182. DATA -2.3,-1.5,4.7,-2.5,-1.5,4.7,-2.5,0,4.7,-2.7,0,4.7
183. DATA -2.3,-1.5,6,-2.5,-1.5,6,-2.5,0,6,-2.7,0,6
184. 'here is wall at the computer
185. DATA 10,-2,-5,10,-2,0,10,2.1,-5,10,2.1,0
186. DATA 10,-2,5,10,-2,0,10,2,5,10,2,0
187. DATA 10,-2,10,10,-2,5,10,2.1,10,10,2.1,5
188. 'here is the PC table
189. DATA 10,-2,8,9.8,-2,8,10,-.7,8,9.8,-.7,8
190. DATA 9.8,-2,8,9.8,-.7,8,9.8,-2,10,9.8,-.7,10
191. DATA 4.4,-2,8,4.6,-2,8,4.4,-.7,8,4.6,-.7,8
192. DATA 4.6,-2,8,4.6,-.7,8,4.6,-2,10,4.6,-.7,10
193. DATA 9.8,-.7,9.8,4.6,-.7,9.8,9.8,-1.5,9.8,4.6,-1.5,9.8
194. DATA 9.8,-1.5,9.8,4.6,-1.5,9.8,9.8,-1.5,10,4.6,-1.5,10
195. DATA 7.5,-2,8,7.7,-2,8,7.5,-.7,8,7.7,-.7,8
196. DATA 7.5,-2,8,7.5,-.7,8,7.5,-2,9.8,7.5,-.7,9.8
197. DATA 7.7,-2,8,7.7,-.7,8,7.7,-2,9.8,7.7,-.7,9.8
198. DATA 9.8,-2,8.3,7.5,-2,8.3,9.8,-1.8,8.3,7.5,-1.8,8.3
199. DATA 9.8,-1.75,8.1,7.5,-1.75,8.1,9.8,-1.25,8.1,7.5,-1.25,8.1
200. DATA 9.8,-1.2,8.1,7.5,-1.2,8.1,9.8,-.9,8.1,7.5,-.9,8.1
201. DATA 9.8,-1.75,8.1,7.5,-1.75,8.1,9.8,-1.75,9,7.5,-1.75,9
202. DATA 9.8,-1.2,8.1,7.5,-1.2,8.1,9.8,-1.2,9,7.5,-1.2,9
203. DATA 9.8,-.9,8.1,7.5,-.9,8.1,9.8,-.9,9,7.5,-.9,9
204. DATA 9.8,-2,9.8,7.5,-2,9.8,9.8,-.7,9.8,7.5,-.7,9.8
205. DATA 10,-.7,7.9,4.4,-.7,7.9,10,-.5,7.9,4.4,-.5,7.9
206. DATA 10,-.7,7.9,4.4,-.7,7.9,10,-.7,10,4.4,-.7,10
207. DATA 10,-.5,7.9,4.4,-.5,7.9,10,-.5,10,4.4,-.5,10
208. 'compputer
209. DATA 5,-2,8,5,-2,8.5,5,-1.5,8,5,-1.5,8.5
210. DATA 5,-1.5,8,5,-1.5,8.5,4.7,-1.5,8,4.7,-1.5,8.5
211. DATA 4.7,-2,8,4.7,-2,8.5,4.7,-1.5,8,4.7,-1.5,8.5
212. DATA 4.7,-2,8,5,-2,8,4.7,-1.5,8,5,-1.5,8
213. 'monitor
214. DATA 9.7,-.3,8.5,7.7,-.3,9.6,9.7,1,8.5,7.7,1,9.6
215. DATA 9.7,-.3,8.6,9.7,1,8.6,7.7,-.3,9.7,7.7,1,9.7
216. DATA 7.7,-.3,9.6,7.7,1,9.6,7.7,-.3,9.7,7.7,1,9.7
217. DATA 9.7,-.3,8.6,9.7,-.5,8.6,7.7,-.3,9.7,7.7,-.5,9.7
218. DATA 9.2,-.49,8.6,8.2,-.49,8.6,9.2,-.49,10,8.2,-.49,10
219. 'keyboard
220. DATA 6.5,-.45,7.9,5.7,-.45,7.9,6.5,-.39,8.2,5.7,-.39,8.2: 'just shifted in space a 2D texture, not really 3D
221. DATA 5.3,-.45,7.9,5,-.45,7.9,5.3,-.39,8,5,-.39,8: 'mouse - as keyboard
222. 'subwoofer
223. DATA 7.4,-2,9.8,7.4,-2,9,7.4,-1.5,9.8,7.4,-1.5,9
224. DATA 7,-2,9.8,7,-2,9,7,-1.5,9.8,7,-1.5,9
225. DATA 7.4,-2,9.8,7,-2,9.8,7.4,-1.5,9.8,7,-1.5,9.8
226. DATA 7.4,-1.5,9.8,7,-1.5,9.8,7.4,-1.5,9,7,-1.5,9
227. DATA 7.4,-2,9,7,-2,9,7.4,-1.5,9,7,-1.5,9
228. 'speaker right
229. DATA 4.7,-.5,10,4.7,0,10,4.7,-.5,9.7,4.7,0,9.7
230. DATA 4.41,-.5,10,4.41,0,10,4.41,-.5,9.7,4.41,0,9.7
231. DATA 4.41,0,10,4.41,0,9.7,4.7,0,10,4.7,0,9.7
232. DATA 4.7,-.5,9.7,4.41,-.5,9.7,4.7,0,9.7,4.41,0,9.7
233. 'speaker left
234. DATA 6.7,-.5,10,6.7,0,10,6.7,-.5,9.7,6.7,0,9.7
235. DATA 6.41,-.5,10,6.41,0,10,6.41,-.5,9.7,6.41,0,9.7
236. DATA 6.41,0,10,6.41,0,9.7,6.7,0,10,6.7,0,9.7
237. DATA 6.7,-.5,9.7,6.41,-.5,9.7,6.7,0,9.7,6.41,0,9.7
238.  
239. 'wall with kitchen unit, again walls with doors first
240. DATA 10,-2,-5,5,-2,-5,10,2,-5,5,2,-5
241. DATA -10,-2,-4.99,7,-2,-4.99,-10,1,-4.99,7,1,-4.99
242. DATA -10,2,-4.99,7,2,-4.99,-10,1,-4.99,7,1,-4.99
243. DATA 5,-2,-3.5,7,-2,-3.5,5,-0.5,-3.5,7,-0.5,-3.5
244. DATA 5,-.5,-3.5,7,-.5,-3.5,5,-.5,-4.9,7,-.5,-4.9
245. DATA 5,-2,-3.5,5,-.5,-3.5,5,-2,-4.9,5,-.5,-4.9
246. DATA 7,-2,-3.5,7,-.5,-3.5,7,-2,-4.9,7,-.5,-4.9
247. DATA 5,-2,-4.9,7,-2,-4.9,5,-0.5,-4.9,7,-0.5,-4.9
248.  
249. 'gas cooker
250. DATA 4.9,-2,-4.9,4.9,-.5,-4.9,4.9,-2,-3.5,4.9,-.5,-3.5
251. DATA 4.9,-.5,-3.4,-2.99,-.5,-3.4,4.9,-.5,-4.9,-2.99,-.5,-4.9
252. DATA 4.9,-.6,-3.4,-2.99,-.6,-3.4,4.9,-.6,-4.9,-2.99,-.6,-4.9
253. DATA 4.9,-.6,-3.4,-2.99,-.6,-3.4,4.9,-.5,-3.4,-2.99,-.5,-3.4
254. DATA 4.9,1.6,-3.7,-9.99,1.6,-3.7,4.9,1.6,-4.9,-9.99,1.6,-4.9
255. DATA 4.9,1.7,-3.7,-9.99,1.7,-3.7,4.9,1.7,-4.9,-9.99,1.7,-4.9
256. DATA 4.9,1.7,-3.7,-9.99,1.7,-3.7,4.9,1.6,-3.7,-9.99,1.6,-3.7
257. DATA 4.9,.6,-3.7,-9.99,.6,-3.7,4.9,.6,-4.9,-9.99,.6,-4.9
258. DATA 4.9,.7,-3.7,-9.99,.7,-3.7,4.9,.7,-4.9,-9.99,.7,-4.9
259. DATA 4.9,.7,-3.7,-9.99,.7,-3.7,4.9,.6,-3.7,-9.99,.6,-3.7
260. DATA 4.9,-2,-3.5,4.9,-.5,-3.5,4.8,-2,-3.5,4.8,-.5,-3.5
261. DATA 4.9,1.7,-3.7,4.9,.6,-3.7,4.9,1.7,-4.9,4.9,.6,-4.9
262. DATA 4.9,1.7,-3.7,4.9,.6,-3.7,4.8,1.7,-3.7,4.8,.6,-3.7
263. DATA 1.9,1.7,-3.7,1.9,.6,-3.7,1.8,1.7,-3.7,1.8,.6,-3.7
264. DATA 1.9,-2,-3.7,1.9,-.6,-3.7,1.8,-2,-3.7,1.8,-.6,-3.7
265. DATA 2.9,1.7,-3.7,2.9,.6,-3.7,2.8,1.7,-3.7,2.8,.6,-3.7
266. DATA 2.9,-2,-3.7,2.9,-.6,-3.7,2.8,-2,-3.7,2.8,-.6,-3.7
267. DATA 3.9,1.7,-3.7,3.9,.6,-3.7,3.8,1.7,-3.7,3.8,.6,-3.7
268. DATA 3.9,-2,-3.7,3.9,-.6,-3.7,3.8,-2,-3.7,3.8,-.6,-3.7
269. DATA 0.9,1.7,-3.7,0.9,.6,-3.7,0.8,1.7,-3.7,0.8,.6,-3.7
270. DATA 0.9,-2,-3.7,0.9,-.6,-3.7,0.8,-2,-3.7,0.8,-.6,-3.7
271. DATA -5.9,1.7,-3.7,-5.9,.6,-3.7,-5.8,1.7,-3.7,-5.8,.6,-3.7
272. DATA -5.9,-2,-3.7,-5.9,-.6,-3.7,-5.8,-2,-3.7,-5.8,-.6,-3.7
273. DATA -1.9,1.7,-3.7,-1.9,.6,-3.7,-1.8,1.7,-3.7,-1.8,.6,-3.7
274. DATA -1.9,-2,-3.7,-1.9,-.6,-3.7,-1.8,-2,-3.7,-1.8,-.6,-3.7
275. DATA -2.9,1.7,-3.7,-2.9,.6,-3.7,-2.8,1.7,-3.7,-2.8,.6,-3.7
276. DATA -2.9,-2,-3.7,-2.9,-.6,-3.7,-2.8,-2,-3.7,-2.8,-.6,-3.7
277. DATA -3.9,1.7,-3.7,-3.9,.6,-3.7,-3.8,1.7,-3.7,-3.8,.6,-3.7
278. DATA -3.9,-2,-3.7,-3.9,-.6,-3.7,-3.8,-2,-3.7,-3.8,-.6,-3.7
279. DATA -4.9,1.7,-3.7,-4.9,.6,-3.7,-4.8,1.7,-3.7,-4.8,.6,-3.7
280. DATA -4.9,-2,-3.7,-4.9,-.6,-3.7,-4.8,-2,-3.7,-4.8,-.6,-3.7
281. DATA -0.9,1.7,-3.7,-0.9,.6,-3.7,-0.8,1.7,-3.7,-0.8,.6,-3.7
282. DATA -0.9,-2,-3.7,-0.9,-.6,-3.7,-0.8,-2,-3.7,-0.8,-.6,-3.7
283. DATA -5.9,1.7,-3.7,-5.9,.6,-3.7,-5.8,1.7,-3.7,-5.8,.6,-3.7
284. DATA -5.9,-2,-3.7,-5.9,-.6,-3.7,-5.8,-2,-3.7,-5.8,-.6,-3.7
285. DATA -6.9,1.7,-3.7,-6.9,.6,-3.7,-6.8,1.7,-3.7,-6.8,.6,-3.7
286. DATA -6.9,-2,-3.7,-6.9,-.6,-3.7,-6.8,-2,-3.7,-6.8,-.6,-3.7
287. DATA -9.99,-.5,-3.4,-3.7,-.5,-3.4,-9.99,-.5,-4.9,-3.7,-.5,-4.9
288. DATA -9.99,-.6,-3.4,-3.7,-.6,-3.4,-9.99,-.6,-4.9,-3.7,-.6,-4.9
289. DATA -9.99,-.6,-3.4,-3.7,-.6,-3.4,-9.99,-.5,-3.4,-3.7,-.5,-3.4
290. DATA -3.7,-.6,-3.4,-2.99,-.6,-3.4,-3.7,-.5,-3.4,-2.99,-.5,-3.4
291. DATA -3.7,-.5,-3.4,-2.99,-.5,-3.4,-3.7,-.5,-3.75,-2.99,-.5,-3.75
292. DATA -3.7,-.5,-4.7,-2.99,-.5,-4.7,-3.7,-.5,-4.9,-2.99,-.5,-4.9
293. 'SINK:
294. DATA -3.7,-.5,-3.75,-2.99,-.5,-3.75,-3.7,-.9,-3.75,-2.99,-.9,-3.75
295. DATA -3.7,-.5,-4.7,-2.99,-.5,-4.7,-3.7,-.9,-4.7,-2.99,-.9,-4.7
296. DATA -3.7,-.5,-3.75,-3.7,-.5,-4.7,-3.7,-.9,-3.75,-3.7,-.9,-4.7
297. DATA -2.99,-.5,-3.75,-2.99,-.5,-4.7,-2.99,-.9,-3.75,-2.99,-.9,-4.7
298. DATA -3.7,-.9,-3.75,-3.7,-.9,-4.7,-2.99,-.9,-3.75,-2.99,-.9,-4.7
299.  
300.  
301. DATA -3.2,-.1,-4.89,-3.5,-.1,-4.89,-3.2,-.1,-4.69,-3.5,-.1,-4.69
302. DATA -3.2,-.2,-4.89,-3.5,-.2,-4.89,-3.2,-.2,-4.69,-3.5,-.2,-4.69
303. DATA -3.2,-.1,-4.69,-3.5,-.1,-4.69,-3.2,-.2,-4.69,-3.5,-.2,-4.69
304. DATA -3.2,-.1,-4.69,-3.2,-.2,-4.69,-3.2,-.1,-4.89,-3.2,-.2,-4.89
305. DATA -3.5,-.1,-4.69,-3.5,-.2,-4.69,-3.5,-.1,-4.89,-3.5,-.2,-4.89
306.  
307. DATA -10.1,-2,-4.9,4.9,-2,-4.9,-10.1,-.49,-4.9,4.9,-.49,-4.9
308. DATA -10.1,-1.99,-5,4.9,-1.99,-5,-10.1,-1.99,-3.7,4.9,-1.99,-3.7
309. DATA -10.1,.8,-4.9,4.9,.8,-4.9,-10.1,1.6,-4.9,4.9,1.6,-4.9
310. 'cabinet doors
311. DATA 1.85,1.55,-3.71,1.85,0.6,-3.71,2.8,1.55,-3.71,2.8,0.6,-3.71
312. DATA 1.85,-1.9,-3.71,1.85,-0.6,-3.71,2.8,-1.9,-3.71,2.8,-.6,-3.71
313. DATA 2.85,1.55,-3.71,2.85,0.6,-3.71,3.8,1.55,-3.71,3.8,0.6,-3.71
314. DATA 2.85,-1.9,-3.71,2.85,-0.6,-3.71,3.8,-1.9,-3.7,3.8,-.6,-3.71
315. DATA 3.85,1.55,-3.71,3.85,0.6,-3.71,4.8,1.55,-3.71,4.8,0.6,-3.71
316. DATA 3.85,-1.9,-3.71,3.85,-0.6,-3.71,4.8,-1.9,-3.71,4.8,-.6,-3.71
317. DATA .85,1.55,-3.71,.85,0.6,-3.71,1.8,1.55,-3.71,1.8,0.6,-3.71
318. DATA .85,-1.9,-3.71,.85,-0.6,-3.71,1.8,-1.9,-3.71,1.8,-.6,-3.71
319. DATA -1.85,1.55,-3.71,-1.85,0.6,-3.71,-2.8,1.55,-3.71,-2.8,0.6,-3.71
320. DATA -1.85,-1.9,-3.71,-1.85,-0.6,-3.71,-2.8,-1.9,-3.71,-2.8,-.6,-3.71
321. DATA -2.85,1.55,-3.71,-2.85,0.6,-3.71,-3.8,1.55,-3.71,-3.8,0.6,-3.71
322. DATA -2.85,-1.9,-3.71,-2.85,-0.6,-3.71,-3.8,-1.9,-3.7,-3.8,-.6,-3.71
323. DATA -3.85,1.55,-3.71,-3.85,0.6,-3.71,-4.8,1.55,-3.71,-4.8,0.6,-3.71
324. DATA -3.85,-1.9,-3.71,-3.85,-0.6,-3.71,-4.8,-1.9,-3.71,-4.8,-.6,-3.71
325. DATA -.85,1.55,-3.71,-.85,0.6,-3.71,-1.8,1.55,-3.71,-1.8,0.6,-3.71
326. DATA -.85,-1.9,-3.71,-.85,-0.6,-3.71,-1.8,-1.9,-3.71,-1.8,-.6,-3.71
327. DATA -4.85,1.55,-3.71,-4.85,0.6,-3.71,-5.8,1.55,-3.71,-5.8,0.6,-3.71
328. DATA -4.85,-1.9,-3.71,-4.85,-0.6,-3.71,-5.8,-1.9,-3.7,-5.8,-.6,-3.71
329. DATA -5.85,1.55,-3.71,-5.85,0.6,-3.71,-6.8,1.55,-3.71,-6.8,0.6,-3.71
330. DATA -5.85,-1.9,-3.71,-5.85,-0.6,-3.71,-6.8,-1.9,-3.71,-6.8,-.6,-3.71
331. DATA -6.85,1.55,-3.71,-6.85,0.6,-3.71,-7.8,1.55,-3.71,-7.8,0.6,-3.71
332. DATA -6.85,-1.9,-3.71,-6.85,-0.6,-3.71,-7.8,-1.9,-3.71,-7.8,-.6,-3.71
333. DATA -9.98,-2,-5,-9.98,1,-5,-9.98,-2,0,-9.98,1,0
334. DATA -9.97,-0.5,-3.4,-8.47,-.5,-3.4,-9.97,-0.5,0,-8.47,-.5,0
335. DATA -9.97,-0.6,-3.4,-8.47,-.6,-3.4,-9.97,-0.6,0,-8.47,-.6,0
336. DATA -9.97,.6,-3.7,-8.77,.6,-3.7,-9.97,.6,0,-8.77,.6,0
337. DATA -9.97,.7,-3.7,-8.77,.7,-3.7,-9.97,.7,0,-8.77,.7,0
338. DATA -9.97,1.6,-3.7,-8.77,1.6,-3.7,-9.97,1.6,0,-8.77,1.6,0
339. DATA -9.97,1.7,-3.7,-8.77,1.7,-3.7,-9.97,1.7,0,-8.77,1.7,0
340. DATA -9.97,-2,0,-8.77,-2,0,-9.97,-0.6,0,-8.77,-0.6,0
341. DATA -9.97,1.6,0,-8.77,1.6,0,-9.97,0.7,0,-8.77,0.7,0
342. DATA -9.97,-2,-.2,-8.77,-2,-.2,-9.97,-0.6,-.2,-8.77,-0.6,-.2
343. DATA -9.97,1.6,-.2,-8.77,1.6,-.2,-9.97,0.7,-.2,-8.77,0.7,-.2
344. DATA -9.97,1.7,0,-8.77,1.7,0,-9.97,1.6,0,-8.77,1.6,0
345. DATA -9.97,-.5,0,-8.47,-.5,0,-9.97,-.6,0,-8.47,-.6,0
346. DATA -9.97,.6,0,-8.77,.6,0,-9.97,.7,0,-8.77,.7,0
347. DATA -8.77,1.7,0,-8.77,1.6,0,-8.77,1.7,-3.7,-8.77,1.6,-3.7
348. DATA -8.47,-.5,0,-8.47,-.6,0,-8.47,-0.5,-3.7,-8.47,-0.6,-3.7
349. DATA -8.77,.7,0,-8.77,.6,0,-8.77,.7,-3.7,-8.77,.6,-3.7
350. DATA -8.77,-2,0,-8.77,-.6,0,-8.77,-2,-0.2,-8.77,-.6,-0.2
351. DATA -8.77,1.6,0,-8.77,.7,0,-8.77,1.6,-0.2,-8.77,.7,-0.2
352. DATA -8.77,-2,-1.9,-8.77,-.6,-1.9,-8.77,-2,-2,-8.77,-.6,-2
353. DATA -8.77,1.6,-1.9,-8.77,.7,-1.9,-8.77,1.6,-2,-8.77,.7,-2
354. DATA -8.77,-1.99,0,-9.97,-1.99,0,-8.77,-1.99,-3.7,-9.97,-1.99,-3.7
355. DATA -9.97,-2,0,-9.97,-2,-4.9,-9.97,-.5,0,-9.97,-.5,-4.9
356. DATA -9.97,1.6,0,-9.97,1.6,-4.9,-9.97,.6,0,-9.97,.6,-4.9
357. DATA -8.77,-2,-3.7,-8.77,-.6,-3.7,-8.77,-2,-3.6,-8.77,-.6,-3.6
358. DATA -8.77,1.6,-3.7,-8.77,.7,-3.7,-8.77,1.6,-3.6,-8.77,.7,-3.6
359.  
360. DATA -8.77,-1.9,-2,-8.77,-.6,-2,-8.77,-1.9,-3.6,-8.77,-.6,-3.6
361. DATA -8.77,1.6,-2,-8.77,.7,-2,-8.77,1.6,-3.6,-8.77,.7,-3.6
362.  
363. DATA -8.77,-1.9,-.2,-8.77,-.6,-.2,-8.77,-1.9,-1.9,-8.77,-.6,-1.9
364. DATA -8.77,1.6,-.2,-8.77,.7,-.2,-8.77,1.6,-1.9,-8.77,.7,-1.9: 'glased doors
365. DATA -7.85,1.55,-3.71,-7.85,0.6,-3.71,-8.8,1.55,-3.71,-8.8,0.6,-3.71
366. DATA -7.85,-1.9,-3.71,-7.85,-0.6,-3.71,-8.8,-1.9,-3.71,-8.8,-.6,-3.71
367. DATA .85,1.55,-3.71,.85,0.6,-3.71,-.85,1.55,-3.71,-.85,0.6,-3.71
368. DATA .85,-1.9,-3.71,.85,-0.6,-3.71,-.85,-1.9,-3.71,-.85,-.6,-3.71
369.  
370. 'microwave
371.  
372. DATA -9,-.5,-4.1,-8,-.5,-4.1,-9,0,-4.1,-8,0,-4.1
373. DATA -9,-.5,-4.9,-8,-.5,-4.9,-9,0,-4.9,-8,0,-4.9
374. DATA -9,0,-4.1,-8,0,-4.1,-9,0,-4.9,-8,0,-4.9
375. DATA -9,0,-4.1,-9,-.5,-4.1,-9,0,-4.9,-9,-.5,-4.9
376. DATA -8,0,-4.1,-8,-.5,-4.1,-8,0,-4.9,-8,-.5,-4.9
377.  
378.  
379.  
380.  
381.  
382. FOR r = 1 TO N
383.     READ v(r).X, v(r).Y, v(r).Z 'all is placed on the same Y = the same floor
384. NEXT r
385.  
386. Set_texture podl&, 1, 4, 15 'set image img as texture for bottom  (triangles 1 to 4)
387. Set_texture str&, 5, 8, 3
388. Set_texture tokno&, 9, 12, 1
389. Set_texture dvere&, 13, 16, 1
390. Set_texture white&, 17, 20, 1
391. Set_texture white&, 21, 24, 1
392. Set_texture lednice&, 25, 28, 1
393. Set_texture white&, 29, 32, 1
394. Set_texture Swhite&, 33, 36, 1
395. Set_texture Swhite&, 37, 40, 1
396. Set_texture orech&, 41, 44, 10
397. Set_texture orech&, 45, 48, 10
398.  
399. Set_texture orech&, 49, 52, 10
400. Set_texture orech&, 53, 56, 10
401. Set_texture orech&, 57, 60, 10
402. Set_texture orech&, 61, 64, 10
403. Set_texture polstr&, 65, 68, 3
404.  
405. Set_texture polstr&, 69, 72, 3
406. Set_texture polstr&, 73, 76, 3
407. Set_texture polstr&, 77, 80, 3
408. Set_texture orech&, 81, 84, 10
409. Set_texture orech&, 85, 88, 10
410. Set_texture orech&, 89, 92, 10
411. Set_texture orech&, 93, 96, 3
412. Set_texture orech&, 97, 100, 3
413. Set_texture orech&, 101, 104, 1
414. Set_texture orech&, 105, 108, 1
415. Set_texture orech&, 109, 112, 1
416. Set_texture orech&, 113, 116, 7
417.  
418. Set_texture orech&, 117, 120, 1
419. Set_texture orech&, 121, 204, 2
420. Set_texture orechsv&, 205, 220, 1
421. Set_texture orech&, 221, 292, 1
422.  
423. Set_texture orechsv&, 293, 308, 1
424. Set_texture orech&, 309, 316, 1
425. Set_texture orechsv&, 317, 328, 1
426. Set_texture orech&, 329, 400, 1
427. Set_texture orechsv&, 401, 416, 1
428. Set_texture orech&, 417, 424, 1
429. Set_texture orechsv&, 425, 432, 1
430. 'po upgradu
431. Set_texture white&, 433, 437, 1
432. Set_texture dvere&, 437, 440, 1
433. Set_texture white&, 441, 444, 1
434. Set_texture dub&, 445, 453, 1
435. Set_texture tdub&, 454, 462, 1
436. Set_texture dub&, 463, 480, 1
437. Set_texture tdub&, 481, 484, 1
438. Set_texture dub&, 485, 492, 1
439. Set_texture tdub&, 493, 512, 1
440. Set_texture dub&, 513, 520, 1
441. Set_texture Black&, 521, 524, 1
442. Set_texture SBlack&, 525, 528, 1
443. Set_texture Black&, 529, 532, 1
444. Set_texture pc&, 533, 536, 1
445. Set_texture SBlack&, 537, 540, 1 'MONITOR
446. Set_texture Black&, 541, 548, 1 'MONITOR
447. Set_texture Noha&, 549, 552, 1 'MONITOR
448. Set_texture Black&, 553, 556, 1
449. Set_texture kbd&, 557, 560, 1 'keyboard
450. Set_texture mys&, 561, 564, 1 'keyboard
451. Set_texture Black, 565, 576, 1 'woof
452. Set_texture SBlack, 577, 580, 1 'woof
453. Set_texture woof&, 581, 584, 1 'woof
454. Set_texture Black, 585, 596, 1
455. Set_texture speak&, 597, 600, 1
456. Set_texture Black, 601, 612, 1
457. Set_texture speak&, 613, 616, 1
458. 'strana s linkou
459. Set_texture dvere&, 617, 620, 1
460. Set_texture dlazba&, 621, 624, 10
461. Set_texture white&, 625, 628, 1
462. Set_texture sporakcelo, 629, 632, 1
463. Set_texture sporakvrch, 633, 636, 1
464. Set_texture white&, 637, 648, 1
465. Set_texture dub&, 649, 652, 1
466. Set_texture tdub&, 653, 656, 5
467. Set_texture dub&, 657, 676, 5
468. Set_texture tdub&, 677, 680, 5
469. Set_texture dub&, 681, 796, 5
470. Set_texture tdub&, 797, 800, 5
471. Set_texture dub&, 801, 809, 5
472. Set_texture dub&, 809, 812, 5
473. Set_texture tdub&, 813, 816, 5
474. Set_texture tdub&, 817, 820, 5
475. Set_texture Silver&, 821, 836, 1
476. Set_texture SilverC&, 837, 840, 1
477. Set_texture SilverB&, 841, 860, 1
478. Set_texture dub&, 861, 872, 1
479. Set_texture tdub&, 873, 960, 1
480. Set_texture dlazba2&, 961, 964, 10
481. Set_texture tdub&, 965, 1004, 1
482. Set_texture dub&, 1005, 1064, 1
483. Set_texture tdub&, 1065, 1076, 1
484. Set_texture Sklo&, 1077, 1080, 1
485. Set_texture tdub&, 1081, 1096, 1
486. Set_texture mikro&, 1097, 1100, 1
487. Set_texture SilverB&, 1101, 1116, 1
488.  
489. valec -1, -.8, 4.7, -.6, 10, SilverB&
490. valec 6, -.5, 9, -.35, 10, Silver&
491. valec -3.35, -.2, -4.8, -.3, 40, SilverB&
492. Zvalec -3.35, -.3, -4.8, -4.1, 40, SilverB&
493. valec -3.35, -.29, -4.1, -.4, 40, SilverB&
494.  
495.  
496. talir -9.1, .8, -1.45
497. talir -9.1, .8, -1.05
498. talir -9.1, .8, -.65
499.  
500. madlo -7.9, .8, -3.6
501. madlo -7.45, .8, -3.6
502. madlo -7.9, -.8, -3.4
503. madlo -7.45, -.8, -3.4
504.  
505. madlo -6, -.8, -3.4
506. madlo -5.45, -.8, -3.4
507. madlo -6, .8, -3.6
508. madlo -5.45, .8, -3.6
509.  
510. madlo -4.1, -.8, -3.4
511. madlo -3.45, -.8, -3.4
512. madlo -4.1, .8, -3.6
513. madlo -3.45, .8, -3.6
514.  
515. madlo -2.2, -.8, -3.4
516. madlo -1.45, -.8, -3.4
517. madlo -2.2, .8, -3.6
518. madlo -1.45, .8, -3.6
519.  
520. madlo -.3, -.8, -3.4
521. madlo -.3, .8, -3.6
522.  
523. madlo 1, -.8, -3.4
524. madlo 1, .8, -3.6
525.  
526. madlo 2, -.8, -3.4
527. madlo 2, .8, -3.6
528.  
529. madlo 3, -.8, -3.4
530. madlo 3, .8, -3.6
531.  
532. madlo 4, -.8, -3.4
533. madlo 4, .8, -3.6
534.  
535. madlo 8.5, -1, 7.9
536. madlo 8.5, -1.3, 7.9
537.  
538. Zmadlo -8.77, .8, -1 'glases doors
539. Zmadlo -8.77, .8, -2.75
540.  
541. Zmadlo -8.77, -.8, -1
542. Zmadlo -8.77, -.8, -2.75
543.  
544.  
545. minRadius = 1000
546. start = 1
547. _MOUSEHIDE
548.  
549. DO
550.  
551.  
552.     WHILE _MOUSEINPUT: WEND
553.     i$ = INKEY$
554.  
555.     FOR r = 1 TO N
556.         LenX = v(r).X - CX '                                                           calculate line lenght between CX and X - point (X1, X2...)
557.         LenY = v(r).Y - CY
558.         LenZ = v(r).Z - CZ '                                                           calculate line lenght between CY (center Y) and Y - point
559.  
560.         radius = SQR(LenX ^ 2 + LenZ ^ 2) '                                            calculate radius using Pythagoras
561.         IF minRadius < .4 THEN minRadius = 1000
562.         IF minRadius > radius THEN minRadius = radius
563.         radiusH = SQR(LenY ^ 2 + LenZ ^ 2)
564.         v(r).Radius = radius
565.         v(r).RadiusH = radiusH
566.  
567.         v(r).pi = JK!(CX, CZ, v(r).X, v(r).Z, radius) ' point on circle calculation based on binary circle    https://matematika.cz/jednotkova-kruznice,  this is for X / Z rotation
568.     NEXT r
569.  
570.     IF ABS(rot) > _PI(2) THEN rot = 0
571.  
572.     oldposZ = posZ
573.     oldposX = posX
574.  
575.  
576.  
577.  
578.     'upgrade: add mouse support!
579.     rot = rot + MOUSEMOVEMENTX / 30 '                                                      rot is move rotation X / Z
580.     roth = roth + MOUSEMOVEMENTY / 30 '
581.  
582.     IF roth > _PI / 2 THEN roth = _PI / 2 '                                                roth is rotation for Y / Z (look up and down)
583.     IF roth < -_PI / 2 THEN roth = -_PI / 2
584.  
585.  
586.     SELECT CASE i$
587.         CASE CHR$(0) + CHR$(72): posZ = posZ + COS(rot) / 2: posX = posX + -SIN(rot) / 2
588.         CASE CHR$(0) + CHR$(80): posZ = posZ - COS(rot) / 2: posX = posX - -SIN(rot) / 2
589.         CASE CHR$(0) + CHR$(77): posZ = posZ + COS(rot + _PI / 2): posX = posX - SIN(rot + _PI / 2) ' sidestep
590.         CASE CHR$(0) + CHR$(75): posZ = posZ - COS(rot + _PI / 2): posX = posX + SIN(rot + _PI / 2) ' sidestep
591.  
592.         CASE "A", "a" '                look up/dn from keyboard
593.             roth = roth - .02
594.  
595.         CASE "Z", "z":
596.             roth = roth + .02
597.  
598.         CASE CHR$(27): Destructor ("textures.pmf"): SYSTEM
599.     END SELECT
600.     IF _EXIT THEN Destructor ("textures.pmf")
601.  
602.  
603.     'primitive collision detection
604.     IF posZ > 3 THEN posZ = 3
605.     IF posZ < -7 THEN posZ = -7
606.     IF posX < -7 THEN posX = -7
607.     IF posX > 7 THEN posX = 7
608.  
609.  
610.     SELECT CASE posX
611.         CASE -7 TO -5: IF posZ < -7 THEN posX = oldposX: posZ = oldposZ
612.         CASE -5 TO 3: IF posZ < -2 THEN posX = oldposX: posZ = oldposZ
613.         CASE 3 TO 6: IF posZ < -7 THEN posX = oldposX: posZ = oldposZ
614.     END SELECT
615.     '-----------------------------
616.  
617.     IF _MOUSEBUTTON(1) THEN rot = rot - .02
618.     IF _MOUSEBUTTON(2) THEN rot = rot + .02
619.  
620.     CZ = -posZ 'This is very important. Note that you do not actually turn the camera in space, but you turn the space for camera.
621.     CX = -posX
622.     CY = -posY
623.  
624.     FOR r = 1 TO N 'STEP 1: FIRST rotate space for move (Z / X rotation)
625.         x = CX + SIN(rot + v(r).pi) * v(r).Radius
626.         Z = CZ + COS(rot + v(r).pi) * v(r).Radius
627.  
628.  
629.         v(r).wX = x + posX
630.         v(r).wZ = Z '                   posZ is add later, after Z / Y calculation
631.         v(r).wY = v(r).Y + posY
632.  
633.  
634.         'STEP 2: rotate space for look to UP / DOWN (Z / Y) BUT USE CORRECT COORDINATES CALCULATED IN STEP 1 FOR ROTATION Z / X as in this program:
635.  
636.  
637.         LenY2 = v(r).Y - CY
638.         LenZ2 = v(r).wZ - CZ
639.  
640.         radiusH = SQR(LenY2 ^ 2 + LenZ2 ^ 2)
641.         v(r).RadiusH = radiusH
642.  
643.         v(r).piH = JK!(CY, CZ, v(r).Y, v(r).wZ, radiusH) 'As you see here, JK! use previous calculated rotated coordinate wZ (working Z coordinate)
644.  
645.         z2 = CZ + COS(roth + v(r).piH) * v(r).RadiusH ' CX, CY, CZ is CAMERA. RadiusH is radius for point between floor and ceiling
646.         y2 = CY + SIN(roth + v(r).piH) * v(r).RadiusH
647.  
648.         v(r).wY = y2 + posY
649.         v(r).wZ2 = z2 + posZ
650.  
651.     NEXT r
652.     i$ = ""
653.  
654.     minigame
655.     m33& = _COPYIMAGE(m&, 33)
656.     Set_texture m33&, 537, 540, 1 'MONITOR
657.  
658.  
659.     REM INFOBOX posX, posY, posZ, rot, minRadius
660.  
661.  
662.     FOR zz = 1 TO N STEP 4
663.         IF v(zz).T THEN
664.             img& = v(zz).T
665.             w = _WIDTH(img&)
666.             h = _HEIGHT(img&)
667.             num = v(zz).Tm
668.             IF num = 0 THEN num = 1
669.             _MAPTRIANGLE (0, h * num)-(w * num, h * num)-(0, 0), img& TO(v(zz).wX, v(zz).wY, v(zz).wZ2)-(v(zz + 1).wX, v(zz + 1).wY, v(zz + 1).wZ2)-(v(zz + 2).wX, v(zz + 2).wY, v(zz + 2).wZ2), 0, _SMOOTH
670.             _MAPTRIANGLE (w * num, h * num)-(0, 0)-(w * num, 0), img& TO(v(zz + 1).wX, v(zz + 1).wY, v(zz + 1).wZ2)-(v(zz + 2).wX, v(zz + 2).wY, v(zz + 2).wZ2)-(v(zz + 3).wX, v(zz + 3).wY, v(zz + 3).wZ2), 0, _SMOOTH
671.         END IF
672.     NEXT zz
673.  
674.     _DISPLAY
675.     _FREEIMAGE m33&
676.     _LIMIT 50
677. LOOP
678.  
679.  
680. SUB INFOBOX (posx, posy, posz, rot, u)
681.     nfo& = _NEWIMAGE(640, 480, 32)
682.     W = 639: H = 479: X = -.5: Y = 0: Z = -1
683.     de = _DEST
684.     _DEST nfo&
685.     COLOR _RGB32(22, 61, 78)
686.     _PRINTMODE _KEEPBACKGROUND
687.     PRINT "INFOBOX:"
688.     PRINT "Position X: "; posx
689.     PRINT "Position Y: "; posy
690.     PRINT "Position Z: "; posz
691.     PRINT "Angle: "; ABS(_R2D(rot))
692.     PRINT u
693.  
694.     _CLEARCOLOR _RGB32(0, 0, 0)
695.     _DEST de
696.     hnfo& = _COPYIMAGE(nfo&, 33)
697.     _FREEIMAGE nfo&
698.     _MAPTRIANGLE (0, 0)-(W, 0)-(0, H), hnfo& TO(-2 + X, 2 + Y, -2 + Z)-(2 + X, 2 + Y, -2 + Z)-(-2 + X, -2 + Y, -2 + Z)
699.     _MAPTRIANGLE (W, 0)-(0, H)-(W, H), hnfo& TO(2 + X, 2 + Y, -2 + Z)-(-2 + X, -2 + Y, -2 + Z)-(2 + X, -2 + Y, -2 + Z)
700.     _FREEIMAGE hnfo&
701. END SUB
702.  
703.  
704.  
705.  
706. SUB madlo (x, y, z)
707.     tt = UBOUND(v) + 1
708.  
709.     REDIM _PRESERVE v(1 TO tt - 1 + 12) AS V
710.     N = N + 12
711.     IF SGN(x) >= 0 THEN x2 = x + .2 ELSE x2 = x - .2
712.     IF SGN(y) >= 0 THEN y2 = y + .05 ELSE y2 = y - .05
713.     IF SGN(z) < 0 THEN z2 = z - .1 ELSE z2 = z + .1
714.  
715.  
716.     v(tt).X = x
717.     v(tt).Y = y
718.     v(tt).Z = z
719.  
720.     v(tt + 1).X = x
721.     v(tt + 1).Y = y2
722.     v(tt + 1).Z = z
723.  
724.     v(tt + 2).X = x2
725.     v(tt + 2).Y = y
726.     v(tt + 2).Z = z
727.  
728.     v(tt + 3).X = x2
729.     v(tt + 3).Y = y2
730.     v(tt + 3).Z = z
731.  
732.     '------------
733.  
734.     v(tt + 4).X = x
735.     v(tt + 4).Y = y
736.     v(tt + 4).Z = z
737.  
738.     v(tt + 5).X = x
739.     v(tt + 5).Y = y2
740.     v(tt + 5).Z = z
741.  
742.     v(tt + 6).X = x
743.     v(tt + 6).Y = y
744.     v(tt + 6).Z = z2
745.  
746.     v(tt + 7).X = x
747.     v(tt + 7).Y = y2
748.     v(tt + 7).Z = z2
749.  
750.     '------------
751.  
752.     v(tt + 8).X = x2
753.     v(tt + 8).Y = y
754.     v(tt + 8).Z = z
755.  
756.     v(tt + 9).X = x2
757.     v(tt + 9).Y = y2
758.     v(tt + 9).Z = z
759.  
760.     v(tt + 10).X = x2
761.     v(tt + 10).Y = y
762.     v(tt + 10).Z = z2
763.  
764.     v(tt + 11).X = x2
765.     v(tt + 11).Y = y2
766.     v(tt + 11).Z = z2
767.  
768.  
769.     Set_texture aluminium&, tt - 1, tt + 11, 1
770.  
771. END SUB
772.  
773.  
774. SUB Zmadlo (x, y, z)
775.     'X udava hloubku, Z udava sirku
776.     '  x    y   z       x      y2 z         x2   y   z2          x2    y2   z2
777.     'DATA -8.77, 1.7, 0,    -8.77, 1.6, 0,     -8.77,1.7, -3.7,     - 8.77, 1.6, -3.7
778.  
779.  
780.     tt = UBOUND(v) + 1
781.  
782.     REDIM _PRESERVE v(1 TO tt - 1 + 12) AS V '16 a 16
783.     N = N + 12
784.     'zapisu zkusebne jeden CTVEREC
785.  
786.     IF SGN(z) <= 0 THEN z2 = z - .2 ELSE z2 = z + .2 'sirka
787.     IF SGN(y) >= 0 THEN y2 = y + .05 ELSE y2 = y - .05
788.     IF SGN(x) <= 0 THEN x2 = x + .1 ELSE x2 = x - .1 'hloubka
789.  
790.  
791.     'predni obdelnik
792.     v(tt).X = x2
793.     v(tt).Y = y
794.     v(tt).Z = z
795.  
796.     v(tt + 1).X = x2
797.     v(tt + 1).Y = y2
798.     v(tt + 1).Z = z
799.  
800.     v(tt + 2).X = x2
801.     v(tt + 2).Y = y
802.     v(tt + 2).Z = z2
803.  
804.     v(tt + 3).X = x2
805.     v(tt + 3).Y = y2
806.     v(tt + 3).Z = z2
807.  
808.     '------------
809.  
810.     v(tt + 4).X = x
811.     v(tt + 4).Y = y2
812.     v(tt + 4).Z = z
813.  
814.     v(tt + 5).X = x2
815.     v(tt + 5).Y = y2
816.     v(tt + 5).Z = z
817.  
818.     v(tt + 6).X = x
819.     v(tt + 6).Y = y
820.     v(tt + 6).Z = z
821.  
822.     v(tt + 7).X = x2
823.     v(tt + 7).Y = y
824.     v(tt + 7).Z = z
825.  
826.     '------------
827.  
828.     v(tt + 8).X = x
829.     v(tt + 8).Y = y2
830.     v(tt + 8).Z = z2
831.  
832.     v(tt + 9).X = x2
833.     v(tt + 9).Y = y2
834.     v(tt + 9).Z = z2
835.  
836.     v(tt + 10).X = x
837.     v(tt + 10).Y = y
838.     v(tt + 10).Z = z2
839.  
840.     v(tt + 11).X = x2
841.     v(tt + 11).Y = y
842.     v(tt + 11).Z = z2
843.  
844.     Set_texture aluminium&, tt - 1, tt + 11, 1
845. END SUB
846.  
847. SUB Set_texture (num, start, eend, much)
848.     FOR s = start TO eend
849.         v(s).T = num
850.         v(s).Tm = much
851.     NEXT s
852. END SUB
853.  
854. FUNCTION Hload& (fileName AS STRING)
855.     h& = _LOADIMAGE(fileName$, 32)
856.     '    PRINT h&: SLEEP
857.     ' _setalpha 0, _rgb32(255,255,255) to _rgb32 (250,250,250), h&
858.     Hload& = _COPYIMAGE(h&, 33)
859.     _FREEIMAGE h&
860. END FUNCTION
861.  
862. FUNCTION SHload& (fileName AS STRING)
863.     h& = _LOADIMAGE(fileName$, 32)
864.     _SETALPHA 0, _RGB32(255, 255, 255) TO _RGB32(200, 200, 200), h&
865.     SHload& = _COPYIMAGE(h&, 33)
866.     _FREEIMAGE h&
867. END FUNCTION
868.  
869. FUNCTION strop&
870.     lamp& = _LOADIMAGE("bodovka mala.jpg", 32)
871.     strop& = _NEWIMAGE(1024, 768, 32)
872.     de = _DEST
873.     _DEST strop&
874.     CLS , _RGB32(255, 255, 255)
875.     rX = 1024 / 4
876.     rY = 768 / 3
877.     FOR x = rX TO 1024 - rX STEP rX
878.         FOR y = rY TO 768 - rY STEP rY
879.             _PUTIMAGE (rX, rY), lamp&, strop&
880.     NEXT y, x
881.     _DEST de
882.     _FREEIMAGE lamp&
883.     strop& = _COPYIMAGE(strop&, 33)
884. END FUNCTION
885.  
886. FUNCTION okno&
887.     ok& = _LOADIMAGE("okn.jpg", 32)
888.     topco& = _LOADIMAGE("topco.jpg", 32)
889.     okno& = _NEWIMAGE(1024, 512, 32)
890.     de = _DEST
891.     _DEST okno&
892.     CLS , _RGB32(250, 245, 255)
893.     _PUTIMAGE (512 - 150, 206 - 132), ok&, okno& '300x265
894.  
895.     _PUTIMAGE (380, 370), topco&, okno&
896.     _DEST de
897.     _FREEIMAGE ok&
898.     _FREEIMAGE topco&
899.     okno& = _COPYIMAGE(okno&, 33)
900. END FUNCTION
901.  
902. FUNCTION white&
903.     IF white& = 0 THEN
904.         whit& = _NEWIMAGE(100, 100, 32)
905.         de = _DEST
906.         _DEST whit&
907.         CLS , _RGB32(250, 240, 250)
908.         _DEST de
909.         white& = _COPYIMAGE(whit&, 33)
910.         _FREEIMAGE whit&
911.     END IF
912. END FUNCTION
913.  
914. FUNCTION Swhite&
915.     IF Swhite& = 0 THEN
916.         whit& = _NEWIMAGE(100, 100, 32)
917.         de = _DEST
918.         _DEST whit&
919.         CLS , _RGB32(255, 255, 255)
920.         _DEST de
921.         Swhite& = _COPYIMAGE(whit&, 33)
922.         _FREEIMAGE whit&
923.     END IF
924. END FUNCTION
925.  
926.  
927. FUNCTION Braun&
928.     IF Braun& = 0 THEN
929.         brau& = _NEWIMAGE(100, 100, 32)
930.         de = _DEST
931.         _DEST brau&
932.         CLS , _RGB32(111, 17, 39)
933.         _DEST de
934.         Braun& = _COPYIMAGE(brau&, 33)
935.         _FREEIMAGE brau&
936.     END IF
937. END FUNCTION
938.  
939.  
940. FUNCTION Black&
941.     IF Black& = 0 THEN
942.         blk& = _NEWIMAGE(100, 100, 32)
943.         de = _DEST
944.         _DEST blk&
945.         CLS , _RGB32(6, 17, 28)
946.         _DEST de
947.         Black& = _COPYIMAGE(blk&, 33)
948.         _FREEIMAGE blk&
949.     END IF
950. END FUNCTION
951.  
952. FUNCTION SBlack&
953.     IF SBlack& = 0 THEN
954.         blk& = _NEWIMAGE(100, 100, 32)
955.         de = _DEST
956.         _DEST blk&
957.         CLS , _RGB32(33, 28, 28)
958.         _DEST de
959.         SBlack& = _COPYIMAGE(blk&, 33)
960.         _FREEIMAGE blk&
961.     END IF
962. END FUNCTION
963.  
964. FUNCTION Silver&
965.     IF Silver& = 0 THEN
966.         blk& = _NEWIMAGE(100, 100, 32)
967.         de = _DEST
968.         _DEST blk&
969.         e = 127 / 100
970.         FOR l = 0 TO 99
971.             LINE (0, l)-(99, l), _RGB32(255 - f, 255 - f, 255 - f)
972.             f = f + e
973.         NEXT l
974.         _DEST de
975.         Silver& = _COPYIMAGE(blk&, 33)
976.         _FREEIMAGE blk&
977.     END IF
978. END FUNCTION
979.  
980. FUNCTION SilverB&
981.     IF SilverB& = 0 THEN
982.         blk& = _NEWIMAGE(100, 100, 32)
983.         de = _DEST
984.         _DEST blk&
985.         e = 127 / 50
986.         FOR l = 0 TO 50
987.             LINE (l, l)-(100 - l, 100 - l), _RGB32(127 + f, 127 + f, 127 + f), B
988.             f = f + e
989.         NEXT l
990.         _DEST de
991.         SilverB& = _COPYIMAGE(blk&, 33)
992.         _FREEIMAGE blk&
993.     END IF
994. END FUNCTION
995.  
996.  
997. FUNCTION SilverC&
998.     IF SilverC& = 0 THEN
999.         blk& = _NEWIMAGE(100, 100, 32)
1000.         de = _DEST
1001.         _DEST blk&
1002.         e = 127 / 50
1003.         FOR l = 0 TO 50
1004.             LINE (l, l)-(100 - l, 100 - l), _RGB32(255 - f, 255 - f, 255 - f), B
1005.             f = f + e
1006.         NEXT l
1007.         _DEST de
1008.         SilverC& = _COPYIMAGE(blk&, 33)
1009.         _FREEIMAGE blk&
1010.     END IF
1011. END FUNCTION
1012.  
1013.  
1014. FUNCTION spajz_dvere&
1015.     dv& = _LOADIMAGE("dvere.jpg", 32) '192 x 426
1016.     de = _DEST
1017.     spajz_dvere32& = _NEWIMAGE(640, 480, 32)
1018.     _DEST spajz_dvere32&
1019.     CLS , _RGB32(241, 244, 251)
1020.     _PUTIMAGE (140, 54), dv&
1021.     _DEST de
1022.     spajz_dvere& = _COPYIMAGE(spajz_dvere32&, 33)
1023.     _FREEIMAGE spajz_dvere32&
1024. END FUNCTION
1025.  
1026. FUNCTION Zesvetli& (file AS STRING)
1027.     t& = _LOADIMAGE(file$, 32)
1028.     IF Zesvetli& < -1 THEN _FREEIMAGE Zesvetli&
1029.     w = _WIDTH(t&)
1030.     h = _HEIGHT(t&)
1031.     zesvetli32& = _NEWIMAGE(w, h, 32)
1032.     de = _DEST
1033.     _DEST zesvetli32&
1034.     _PUTIMAGE , t&, zesvetli32&
1035.     LINE (0, 0)-(w - 1, h - 1), _RGBA32(255, 255, 255, 30), BF
1036.     _DEST de
1037.  
1038.     Zesvetli& = _COPYIMAGE(zesvetli32&, 33)
1039.     _FREEIMAGE t&
1040.     _FREEIMAGE zesvetli32&
1041. END FUNCTION
1042.  
1043. FUNCTION Ztmav& (file AS STRING)
1044.     t& = _LOADIMAGE(file$, 32)
1045.     IF Ztmav& < -1 THEN _FREEIMAGE Ztmav&
1046.     w = _WIDTH(t&)
1047.     h = _HEIGHT(t&)
1048.     ztmav32& = _NEWIMAGE(w, h, 32)
1049.     de = _DEST
1050.     _DEST ztmav32&
1051.     _PUTIMAGE , t&, ztmav32&
1052.     LINE (0, 0)-(w - 1, h - 1), _RGBA32(0, 0, 0, 30), BF
1053.     _DEST de
1054.  
1055.     Ztmav& = _COPYIMAGE(ztmav32&, 33)
1056.     _FREEIMAGE t&
1057.     _FREEIMAGE ztmav32&
1058. END FUNCTION
1059.  
1060. FUNCTION Noha&
1061.     IF Noha& = 0 THEN
1062.         de = _DEST
1063.         noh& = _NEWIMAGE(100, 100, 32)
1064.         _DEST noh&
1065.         LINE (0, 40)-(100, 60), _RGB32(0, 22, 32), BF
1066.         _CLEARCOLOR _RGB32(0, 0, 0), noh&
1067.         _DEST de
1068.         Noha& = _COPYIMAGE(noh&, 33)
1069.         _FREEIMAGE noh&
1070.     END IF
1071. END FUNCTION
1072.  
1073. FUNCTION Noha2&
1074.     IF Noha2& = 0 THEN
1075.         de = _DEST
1076.         noh& = _NEWIMAGE(100, 100, 32)
1077.         _DEST noh&
1078.         LINE (30, 30)-(70, 70), _RGB32(0, 2, 12), BF
1079.         _CLEARCOLOR _RGB32(0, 0, 0), noh&
1080.         _DEST de
1081.         Noha2& = _COPYIMAGE(noh&, 33)
1082.         _FREEIMAGE noh&
1083.     END IF
1084. END FUNCTION
1085.  
1086.  
1087.  
1088.  
1089.  
1090. FUNCTION JK! (cx, cy, px, py, R)
1091.     '  podle definice jednotkove kruznice musim nejprve hodnoty prevest na rozsah od -1 do 1 pro x i pro y.
1092.     '  R urcuje velikost kruznice, cili jR bude 1/R
1093.     LenX = cx - px
1094.     LenY = cy - py
1095.     jR = 1 / R
1096.  
1097.     jX = LenX * jR
1098.     jY = LenY * jR
1099.  
1100.     sinusAlfa = jX
1101.     Alfa = ABS(_ASIN(sinusAlfa))
1102.  
1103.     Q = 1
1104.     IF px >= cx AND py <= cy THEN Q = 1 ' select angle to quadrant
1105.     IF px >= cx AND py <= cy THEN Q = 2
1106.     IF px <= cx AND py <= cy THEN Q = 3
1107.     IF px <= cx AND py >= cy THEN Q = 4
1108.     SELECT CASE Q
1109.         CASE 1: alfaB = Alfa
1110.         CASE 2: alfaB = _PI / 2 + (_PI / 2 - Alfa)
1111.         CASE 3: alfaB = _PI + Alfa
1112.         CASE 4: alfaB = _PI(1.5) + (_PI / 2 - Alfa)
1113.     END SELECT
1114.     JK! = alfaB
1115. END FUNCTION
1116.  
1117. SUB valec (xs, ys, zs, ye, R, t&) 'start x, y, z, konec x, y, z, polomer, textura
1118.  
1119.     tt = UBOUND(v) + 1
1120.     polomer = R
1121.  
1122.     REDIM _PRESERVE v(1 TO tt - 1 + 64) AS V '16 a 16
1123.  
1124.     polo = _PI(2) / 16
1125.     N = N + 64
1126.  
1127.     FOR s = 0 TO _PI(2) STEP polo
1128.         ott = tt
1129.         v(tt).X = xs + SIN(s) / polomer
1130.         v(tt).Y = ys
1131.         v(tt).Z = zs + COS(s) / polomer
1132.         tt = tt + 1
1133.         v(tt).X = xs + SIN(s) / polomer
1134.         v(tt).Y = ye
1135.         v(tt).Z = zs + COS(s) / polomer
1136.         tt = tt + 1
1137.         v(tt).X = xs + SIN(s + polo) / polomer
1138.         v(tt).Y = ys
1139.         v(tt).Z = zs + COS(s + polo) / polomer
1140.         tt = tt + 1
1141.         v(tt).X = xs + SIN(s + polo) / polomer
1142.         v(tt).Y = ye
1143.         v(tt).Z = zs + COS(s + polo) / polomer
1144.         Set_texture t&, ott, tt, 1
1145.         tt = tt + 1
1146.     NEXT
1147. END SUB
1148.  
1149. SUB Zvalec (xs, ys, zs, ze, R, t&) 'start x, y, z, konec x, y, z, polomer, textura
1150.     tt = UBOUND(v) + 1
1151.     polomer = R
1152.  
1153.     REDIM _PRESERVE v(1 TO tt - 1 + 64) AS V '16 a 16
1154.  
1155.     polo = _PI(2) / 16
1156.     N = N + 64
1157.  
1158.     FOR s = 0 TO _PI(2) STEP polo
1159.         ott = tt
1160.         v(tt).X = xs + SIN(s) / polomer
1161.         v(tt).Y = ys + COS(s) / polomer
1162.         v(tt).Z = zs
1163.         tt = tt + 1
1164.         v(tt).X = xs + SIN(s) / polomer
1165.         v(tt).Y = ys + COS(s) / polomer
1166.         v(tt).Z = ze
1167.         tt = tt + 1
1168.         v(tt).X = xs + SIN(s + polo) / polomer
1169.         v(tt).Y = ys + COS(s + polo) / polomer
1170.         v(tt).Z = zs
1171.         tt = tt + 1
1172.         v(tt).X = xs + SIN(s + polo) / polomer
1173.         v(tt).Y = ys + COS(s + polo) / polomer
1174.         v(tt).Z = ze
1175.         Set_texture t&, ott, tt, 1
1176.         tt = tt + 1
1177.     NEXT
1178. END SUB
1179.  
1180.  
1181.  
1182.  
1183.  
1184.  
1185. SUB talir (x, y, z)
1186.  
1187.     radius0 = 0
1188.     radius1 = .05
1189.     radius2 = .1
1190.     radius3 = .2
1191.     ys = -ABS(y) 'puvodni zs bude ys
1192.     ye = y - .1
1193.     ys2 = ye
1194.     ye2 = y + .2
1195.  
1196.     tt = UBOUND(v) + 1
1197.     '32 zaznamu pro jeden obvod kruhu (16 * 2 body) jeden radius, dalsich 32 druhy, dalsich 32 treti (ten se opakuje jako druhy) a 32 ctvrty.
1198.  
1199.     REDIM _PRESERVE v(1 TO tt - 1 + 64) AS V '16 a 16
1200.  
1201.     polo = _PI(2) / 16
1202.     N = N + 64
1203.  
1204.     FOR s = 0 TO _PI(2) STEP polo
1205.         ott = tt
1206.         IF SGN(x) >= 0 THEN v(tt).X = x + (SIN(s) * radius2 + SIN(s) * radius0) ELSE v(tt).X = x - (SIN(s) * radius2 - SIN(s) * radius0)
1207.         v(tt).Y = ys2
1208.         IF SGN(z) >= 0 THEN v(tt).Z = z + (COS(s) * radius2 + COS(s) * radius0) ELSE v(tt).Z = z - (COS(s) * radius2 - COS(s) * radius0)
1209.         tt = tt + 1
1210.         IF SGN(x) >= 0 THEN v(tt).X = x + (SIN(s) * radius3 + SIN(s) * radius1) ELSE v(tt).X = x - (SIN(s) * radius3 - SIN(s) * radius1)
1211.         v(tt).Y = ye2
1212.         IF SGN(z) >= 0 THEN v(tt).Z = z + (COS(s) * radius3 + COS(s) * radius1) ELSE v(tt).Z = z - (COS(s) * radius3 - COS(s) * radius1)
1213.         tt = tt + 1
1214.         IF SGN(x) >= 0 THEN v(tt).X = x + (SIN(s + polo) * radius2 + SIN(s + polo) * radius0) ELSE v(tt).X = x - (SIN(s + polo) * radius2 - SIN(s + polo) * radius0)
1215.         v(tt).Y = ys2
1216.         IF SGN(z) >= 0 THEN v(tt).Z = z + (COS(s + polo) * radius2 + COS(s + polo) * radius0) ELSE v(tt).Z = z - (COS(s + polo) * radius2 - COS(s + polo) * radius0)
1217.         tt = tt + 1
1218.         IF SGN(x) >= 0 THEN v(tt).X = x + (SIN(s + polo) * radius3 + SIN(s + polo) * radius1) ELSE v(tt).X = x - (SIN(s + polo) * radius3 - SIN(s + polo) * radius1)
1219.         v(tt).Y = ye2
1220.         IF SGN(z) >= 0 THEN v(tt).Z = z + (COS(s + polo) * radius3 + COS(s + polo) * radius1) ELSE v(tt).Z = z - (COS(s + polo) * radius3 - COS(s + polo) * radius1)
1221.         tt = tt + 1
1222.         Set_texture SilverC&, ott, tt - 1, 1
1223.     NEXT
1224. END SUB
1225.  
1226.  
1227.  
1228.  
1229.  
1230.  
1231.  
1232.  
1233.  
1234. FUNCTION Sklo&
1235.     IF Sklo& = 0 THEN
1236.         de = _DEST
1237.         skl = _NEWIMAGE(150, 100, 32)
1238.         _DEST skl
1239.         alfa = 127 / 25
1240.         a = 120
1241.         FOR x = 1 TO 50
1242.             a = a - alfa
1243.             LINE (0, x)-(150, x), _RGBA32(127, 127, 127, a)
1244.         NEXT x
1245.  
1246.         FOR x = 50 TO 100
1247.             a = a + alfa
1248.             LINE (0, x)-(150, x), _RGBA32(127, 127, 127, a)
1249.         NEXT x
1250.         _DEST de
1251.         Sklo& = _COPYIMAGE(skl, 33)
1252.         _FREEIMAGE skl
1253.     END IF
1254. END FUNCTION
1255.  
1256. SUB minigame
1257.     de = _DEST
1258.     _DEST m&
1259.     CLS , _RGB32(127, 120, 120)
1260.  
1261.  
1262.     IF ballX > 160 THEN
1263.         IF rY + 25 < ballY THEN rY = rY + 1 ELSE rY = rY - 1
1264.         IF ballX > (rXx - 10) THEN
1265.             IF ballY > rY AND ballY < rY + 50 THEN mX = mX * -1
1266.         END IF
1267.     END IF
1268.  
1269.     IF ballX < 160 THEN
1270.         IF lY + 25 < ballY THEN lY = lY + 1 ELSE lY = lY - 1
1271.         IF ballX < 20 THEN
1272.  
1273.             IF ballY > lY AND ballY < lY + 50 THEN mX = mX * -1
1274.  
1275.         END IF
1276.     END IF
1277.  
1278.     ballX = ballX + mX
1279.     ballY = ballY + mY
1280.  
1281.     IF ballX > 315 THEN mX = mX * -1: rightplr = rightplr + 1: ballX = ballX + mX + SIN(_ATAN2(ballY, ballX))
1282.     IF ballX < 5 THEN mX = mX * -1: leftplr = leftplr + 1: ballY = ballY + mY + COS(_ATAN2(ballY, ballX))
1283.  
1284.     IF ballY > 235 THEN mY = mY * -1 - _ATAN2(ballY, ballX) / 2: ballY = ballY + mY
1285.     IF ballY < 5 THEN mY = mY * -1 + _ATAN2(ballY, ballX) / 2: ballY = ballY + mY
1286.  
1287.     'boky tahel - odrazy Y:
1288.     IF ballY >= lY AND ballY <= lY + 60 AND ballX <= 10 THEN mY = mY * -1: ballY = ballY + mY - _ATAN2(ballY, ballX)
1289.     IF ballY >= rY AND ballY <= rY + 60 AND ballX >= 300 THEN mY = mY * -1: ballY = ballY + mY + _ACOS(_ATAN2(ballY, ballX))
1290.  
1291.  
1292.  
1293.  
1294.     IF lY > 180 THEN lY = 180
1295.     IF lY < 10 THEN lY = 10
1296.     IF rY > 180 THEN rY = 180
1297.     IF rY < 10 THEN rY = 10
1298.  
1299.     IF ballX - 2 > lX AND ballX + 2 < lX + 10 AND ballY - 2 >= lY AND ballY + 2 <= lY + 50 THEN COLOR _RGB32(255, 0, 0): _PRINTSTRING (130, 112), "ERROR!!!!": COLOR _RGB32(255, 255, 255)
1300.     IF ballX - 2 > rX - 10 AND ballX + 2 < rX AND ballY - 2 >= rY AND ballY + 2 <= rY + 50 THEN COLOR _RGB32(255, 0, 0): _PRINTSTRING (130, 112), "ERROR!!!!": COLOR _RGB32(255, 255, 255)
1301.  
1302.     IF ABS(mX) > 2 THEN mX = mX / 2
1303.     IF ABS(mY) > 2 THEN mY = mY / 2
1304.  
1305.  
1306.     IF ballX > 157 AND ballX < 163 THEN
1307.         IF ballY > 60 AND ballY < 180 THEN mX = mX * -1
1308.         IF ballY = 64 OR ballY = 180 THEN mY = mY * -1
1309.     END IF
1310.  
1311.  
1312.  
1313.     LINE (ballX - 2, ballY - 2)-(ballX + 2, ballY + 2), , B
1314.  
1315.     LINE (3, 3)-(317, 237), , B
1316.     LINE (lX, lY)-(lX + 10, lY + 50), , B
1317.     LINE (rXx, rY)-(rXx - 10, rY + 50), , B
1318.     LINE (160, 60)-(160, 180)
1319.     _PRINTMODE _KEEPBACKGROUND
1320.     popis = _PRINTWIDTH(STR$(leftplr) + " - " + STR$(rightplr))
1321.  
1322.     _PRINTSTRING (160 - popis / 2, 5), STR$(leftplr) + " - " + STR$(rightplr)
1323.     _DEST de
1324. END SUB
1325.  
1326. FUNCTION MOUSEMOVEMENTX
1327.     SELECT CASE OldMouseX
1328.         CASE IS > _MOUSEX: MOUSEMOVEMENTX = -1: _MOUSEMOVE OldMouseX, OldMouseY '= _MOUSEX
1329.         CASE IS < _MOUSEX: MOUSEMOVEMENTX = 1: _MOUSEMOVE OldMouseX, OldMouseY '= _MOUSEX
1330.         CASE ELSE: MOUSEMOVEMENTX = 0
1331.     END SELECT
1332. END FUNCTION
1333.  
1334. FUNCTION MOUSEMOVEMENTY
1335.     SELECT CASE OldMouseY
1336.         CASE IS > _MOUSEY: MOUSEMOVEMENTY = -1: _MOUSEMOVE OldMouseX, OldMouseY ' = _MOUSEY
1337.         CASE IS < _MOUSEY: MOUSEMOVEMENTY = 1: _MOUSEMOVE OldMouseX, OldMouseY '= _MOUSEY
1338.         CASE ELSE: MOUSEMOVEMENTY = 0
1339.     END SELECT
1340. END FUNCTION
1341.  
1342.  
1343. SUB ExtractPMF (Vystup AS STRING) ' here insert PMF file name for extracting files
1344.     IF _FILEEXISTS(Vystup) THEN
1345.         PRINT "Extracting files from "; Vystup$
1346.         TYPE head
1347.             identity AS STRING * 16
1348.             much AS LONG
1349.         END TYPE
1350.         DIM head AS head
1351.         e = FREEFILE
1352.         OPEN Vystup$ FOR BINARY AS #e
1353.         GET #e, , head
1354.         IF head.identity = "Petr's MultiFile" THEN PRINT "Head PASS" ELSE PRINT "Head Failure": SLEEP 3: END
1355.         PRINT "Total records in file:"; head.much
1356.         DIM starts(head.much) AS LONG
1357.  
1358.         FOR celek = 1 TO head.much
1359.             GET #e, , starts(celek)
1360.         NEXT
1361.  
1362.         SEEK #e, 21 + head.much * 4 ' start DATA area
1363.         FOR total = 1 TO head.much
1364.             IF total = 1 THEN velikost& = starts(1) - (21 + head.much * 4) ELSE velikost& = starts(total) - starts(total - 1)
1365.             record$ = SPACE$(velikost&)
1366.             GET #e, , record$
1367.             i = FREEFILE
1368.             jmeno$ = "$Ext" + LTRIM$(STR$(total))
1369.             OPEN jmeno$ FOR OUTPUT AS #i: CLOSE #i: OPEN jmeno$ FOR BINARY AS #i
1370.             PUT #i, , record$
1371.             CLOSE #i
1372.         NEXT total
1373.  
1374.         DIM NamesLenght(head.much) AS INTEGER
1375.         FOR NameIt = 1 TO head.much
1376.             GET #e, , NamesLenght(NameIt)
1377.         NEXT NameIt
1378.  
1379.         CLOSE #i
1380.         FOR Name2 = 1 TO head.much
1381.             s$ = SPACE$(NamesLenght(Name2))
1382.             GET #e, , s$
1383.             jm$ = "$Ext" + LTRIM$(STR$(Name2))
1384.             erh:
1385.             IF _FILEEXISTS(s$) THEN
1386.                 BEEP: INPUT "Warnig! Extracted file the same name already exists!!!! (O)verwrite, (R)ename or (E)xit? "; er$
1387.                 SELECT CASE LCASE$(er$)
1388.                     CASE "o": KILL s$: NAME jm$ AS s$
1389.                     CASE "r": INPUT "Input new name"; s$: GOTO erh
1390.                     CASE "e": SYSTEM
1391.                 END SELECT
1392.             ELSE
1393.                 NAME jm$ AS s$
1394.             END IF
1395.         NEXT Name2
1396.         CLOSE #e
1397.         PRINT "All ok."
1398.     ELSE
1399.         PRINT "File "; Vystup$; " not found.": END
1400.     END IF
1401. END SUB
1402.  
1403. SUB Destructor (vystup AS STRING) 'delete files created by ExtractPMF
1404.     TYPE head2
1405.         identity AS STRING * 16
1406.         much AS LONG
1407.     END TYPE
1408.     IF INSTR(1, LCASE$(vystup$), ".pmf") THEN ELSE vystup$ = vystup$ + ".PMF"
1409.     IF _FILEEXISTS(vystup$) THEN
1410.         CLOSE
1411.         DIM head AS head2
1412.         e = FREEFILE
1413.         OPEN vystup$ FOR BINARY AS #e
1414.         GET #e, , head
1415.         DIM starts(head.much) AS LONG
1416.  
1417.         FOR celek = 1 TO head.much
1418.             GET #e, , starts(celek)
1419.         NEXT
1420.  
1421.         SEEK #e, starts(head.much) ' start DATA area
1422.         DIM NamesLenght(head.much) AS INTEGER
1423.         FOR NameIt = 1 TO head.much
1424.             GET #e, , NamesLenght(NameIt)
1425.         NEXT NameIt
1426.         FOR Name2 = 1 TO head.much
1427.             s$ = SPACE$(NamesLenght(Name2))
1428.             GET #e, , s$
1429.             IF _FILEEXISTS(s$) THEN KILL s$
1430.         NEXT Name2
1431.         CLOSE #e
1432.     ELSE
1433.         PRINT "Specified file not found": SLEEP 3
1434.     END IF
1435. END SUB
1436.  

[SMcNeill]

Here’s a question Petr: How hard would it be for you to whip up a Wizardry/Bard’s Tale style demo with MAPTRIANGLE?

A few images for you:

https://www.macgamestore.com/images_screenshots/wizardry-6-7-27156.jpg
https://lparchive.org/Wizardry-6/Update%20105/12-Update104-030.png
https://r.mprd.se/media/images/36327-Wizardry_VI_-_Kindan_no_Mafude_(Japan)_%5BEn_by_TiCo_v0.30b%5D_(~Wizardry_-_Bane_of_the_Cosmic_Forge)_(Incomplete)-1459637082.png

Seems to me that MAPTRIANGLE should easily be able to handle drawing such type of maps.

[Petr]

Hi Steve. What exactly do you mean? Would not there be a video on youtube? I do not know this game at all. Would you like to make some such corridors, even with the edges? Of course it could be done, but i would tried it first. Those characters would probably have been textured in 2D and just rotated to the player, as were the enemies in Wolfenstein. But before i try this, I have one thing I want to do in my head now, but using objects (I'll just call the cube subprogram and not the triangles) to make my work much easier. I also want to try this in a large space to verify the correctness of my supposition for the limitation of the processed elements according to distance as we have talked about with STxAxTIC. All this to verify the speed of the calculations, if my solution will be usable.

[STxAxTIC]

Hey Petr,

Looking better and better! I think Steve is basically asking for a game engine with a map having corridors and different kinds of spaces. You're totally right about the characters probably being 2D projections (in those screenshots) that would have to rotate as the player moved around. They called this 2.5D in the past - somewhere between 2D and 3D. I think they finally stopped doing this and went to full 3D around the time of the Quake and Unreal engines - 1997/8 to pick a year.

It's a hell of a task to cross the barrier of a 3D demo living in just one room, versus having a whole world with thousands of elements. The "art" of skipping most of the level data and only dealing with the things in view of the player is a wonderful application of vectors and geometry. Clearly you can't cram the whole level through the main loop on each iteration - to solve this for Sanctum I created a linked list to track visible elements (I think the code can explain this better than my words in a way.)

Anyway, keep up the awesome work. We're all watching this one!

[SMcNeill]

https://m.youtube.com/watch?v=JJvSDLA6z1g — Here’s a video of the old style game.

Years ago, it all started with Wizardry 1, and these awesome graphics: http://104.236.151.57/wp-content/uploads/2017/10/wizardry1-pc98-01.png. (All done basically with LINE statements.)

Over time, the maps evolved to include colors and bricks and such: https://www.myabandonware.com/media/screenshots/w/wizardry-gold-40n/wizardry-gold_8.gif


If you want to play test the old games, try a version over at myabandonware.com: https://www.myabandonware.com/search/q/Wizardry+

https://www.myabandonware.com/game/wizardry-bane-of-the-cosmic-forge-12k

Just a few simple textures drawn/placed properly could probably reproduce those 2D maps in a semi-3D perspective as they have.  I just always break my head anymore trying to sort out where/how to position everything properly, and would love a demo, if you feel like producing one sometime.

[SMcNeill]

Hey Petr,

Looking better and better! I think Steve is basically asking for a game engine with a map having corridors and different kinds of spaces. You're totally right about the characters probably being 2D projections (in those screenshots) that would have to rotate as the player moved around. They called this 2.5D in the past - somewhere between 2D and 3D.

In the old wizardry/bard tale games, the characters never actually appeared on the maps, until encountered.  All you saw was the navigatable rooms/hallways/doors and such.   Walk on a tile with a monster and PRESTO!!  It basically overlayed in front of the screen as in the images.

I’m just thinking the style might be fun to use for a maze-making type game.  ;)

[STxAxTIC]

... Dude no kidding! This guy's youtube video is so compelling I want to try this game. Granted, he's bitching a lot while playing, but still...

I'm thinking that the best way to recreate this kind of experience is with a nice raycaster. Basically a standard Wolfenstein engine... I bet there are a few ready-to-ship raycasters floating around... either in our legacy Samples package, or out there online. I honestly think that kind of engine is best for this kind of game...

EDIT Layer a sprite library in there and you've got the graphics done.

[Petr]

Steve, I'm going to try something to do with your request. Prepare map in 2D (just image - something as schematic draw for corridors). I do not understand the video very much, spoken English is no longer my strong side. Of course, a DOOM-style game can be done right now, just add the _DISPLAYORDER _HARDWARE, _SOFTWARE before my program loop and then add   command in the 2D with standard QB64 commands like _PUTIMAGE and LINE for the lower information box and life just before the _DIPLAY statement.  I have some progress in rotation of objects and objects themselves, but I will post it when it works completely reliably.

[SMcNeill]

Steve, I'm going to try something to do with your request. Prepare map in 2D (just image - something as schematic draw for corridors). I do not understand the video very much, spoken English is no longer my strong side. Of course, a DOOM-style game can be done right now, just add the _DISPLAYORDER _HARDWARE, _SOFTWARE before my program loop and then add   command in the 2D with standard QB64 commands like _PUTIMAGE and LINE for the lower information box and life just before the _DIPLAY statement.  I have some progress in rotation of objects and objects themselves, but I will post it when it works completely reliably.

Here's a little flash-game demo of the style game, Petr: https://classicreload.com/3d-maze.html  It might help highlight the idea behind the process for you, where we turn a 2D map into a semi--3D representation of that map.  ;)

Back in the early DOS days, these type games used to be drawn using nothing more than LINE statements and a little perspective math.  It seems to me that where these wall and floor "cells" are, we should be able to use MAPTRIANGLE in QB64 to place images to create these areas for us, so we could have brick walls and sand floors (for example), rather than the limitations placed by LINE/PRINT patterns. 

If you need a map to use with it, just head over to https://donjon.bin.sh/d20/dungeon/  Click the CONSTRUCT button to create a map, and then with the DOWNLOAD: TSV Map, you can download a simple text file with a TAB Separated Value Map which can be easily used for generating X/Y coordinates from.  ;)

[Petr]

Hi. There was not much time, but I was already doing a lot of work on the maze editor. It's not quite done yet, I'm still working on it. Information for you: How many peaks are enough to even hardware-accelerated command brake the computer to the 80286 processor level? Well, it's about 90,000 points (30,000 triangles). That's too little. But I'm working on it. I want to write an OpenGL maze engine out of MAPTRIANGLE. Respectively - first MAPTRIANGLE engine and then OpenGL. I attach a screenshot of the program, an unfinished editor is running in the foreground, it currently has 3 layers but I want 5 layers. Why? Let yourself be surprised.

[Petr]

Hi.

After a very long time, I decided to release a development version of the editor and of course a development version of the 3D corridor viewer. First, let me say a few words about operating the corridor editor. Since this is a development version, please do not pay attention to the bottom film strip, it is there for objects, but as you know, the object editor is just writing. There's nothing better, than to write down a lot programs in the same time...
So to operate the program. On the right is the film strip from top to bottom. This is a strip of textures. All images that QB64 supports can be textured.
To add a texture, click the Add Texture button. The program reads textures in the textures folder (I didn't want to deal with browsing the disk, because the program is already big enough). After selecting the texture, click the Draw Floor button. Now, clicking on the grid will paint the floor. Square by square. That's stupid, isn't it? Yeah, it's stupid! So click the Set Grid button to activate one of the setup windows. From the Mouse Mode menu, select In Blocks. Click DONE. Next time you do not need to set it, the program will write it down immediately. Return to the grid, Press the left mouse button, keep pressed, and drag to paint the area where the floor texture will be placed. It would take a wall, wouldn't it?
And preferably with a different texture! Click Add Texture, select a texture, then mark it in the area of ​​the film strip (there will be a yellow rectangle around it), then click Draw Wall and in the same way click and drag to paint the walls. In the same way, paint ceilings by clicking Draw Ceiling.
Important warning. If you drag an area where you already have a wall or floor while painting the ceiling, it will be deleted and there will only be the ceiling. This is a mistake, so paint the ceiling from wall to wall to achieve the expected result.
You're thinking. Yeah. I have a full grid. How do I shift it? I want a bigger map! Use the arrow keys to move the grid. Are you at the end and want an even bigger map? Yes! Click the Set Grid button, click the double arrow to set the map width and map height.
Are you annoyed about info window what a particular cell contains? Turn it off or set the time delay in Set Grid! You can also set the grid color in Set Grid. You can also turn off the grid completely here.
Don't you like how textures are displayed? Select one of the methods in Set Grid / Layers Mode.
Do you want to open the map you created earlier? Click Load Map (but the map must be in the Map subfolder). Click Save Map to save the map.
Have you lost the texture you have on a map and would like to use it again on another map? First, upload the map that contains the texture. Then exit the program. Go to the Swap folder. Here are all the textures that were used on the map. Find your texture and move it to the textures folder. The texture will now be available for each map you create.

The program also allows to divide one texture into several map cells. This is currently valid for ceilings and floors, because for the walls I decided to solve this in the form of objects, but their editor is just writing. So how to do it. Load the texture, right-click and drag over the texture area to release. The right mouse button menu will pop up. Choose Break Current Texture into this objects. Attention! The program copies the original texture to the required number of parts (creating new images that together make up the original) without damaging the original. These new images are automatically added to the texture strip. This operation dramatically increases the size of the map file!
Therefore, the program allows (sometimes with errors that do not cause the program to crash) to copy areas on the map. Again, this applies to ceilings and floors. Select the area to copy with the right mouse button. Select Copy All in this Area from the Copy menu. Then navigate to the first area located at the top left of the area you want to copy, right-click and select Insert Copyed contens to this area. It is copied in the map field without adding any other textures, using the same ones as in the source area.
For other right-click menus:
 Delete All in this Area - deletes everything in the selected area.
Set Wall / Ceiling / Floor height is for editing the corridor above another corridor or under another corridor. The current program, which reads the map but still can not and all the corridors render the same plane.
Flip textures in this area - if you select an area, it will offer you to flip the textures in that area, or if you just right-click, this applies to flip textures in a particular cell.
Delete and ADD sound to this area - This is not yet implanted (there is no record in the MAP file) and even the map-browsing program cannot do it yet, it will be added when the object editor is finished.
The Rotate Object, Delete Object, Add Object buttons also do not work for the same reason. If there is no object editor, there is nothing to insert or rotate ....

Wall Height button. So far, it offers a lot without any effect. Most of the features that are offered there are not synchronized with either the map saving or the map browsing program. This is another debt that I have to complete.




Editor source code: (Both source codes + compiled EXE files and all needed files are also in attached ZIP file)

Code: QB64: [Select]

1. 'editor wall/ceil/bottom 3D Alpha 2
2.  
3. SCREEN _NEWIMAGE(1024, 768, 32)
4. '   24 =     25 =     27 =   26 = 
5. '$include:'saveimage.bi'
6. TYPE Button
7.     active AS _BYTE
8.     time AS _BYTE
9.     text AS STRING * 14
10.     x AS INTEGER
11.     y AS INTEGER
12.     imgA AS LONG 'aktivni tlacitko
13.     imgB AS LONG 'neaktivni tlacitko
14. END TYPE
15.  
16. TYPE Texture
17.     img AS LONG
18.     path AS STRING
19. END TYPE
20.  
21.  
22. 'pro SAVEMAP ----------------------------------
23. TYPE MAP_HEAD
24.     Identity AS STRING * 5 'MAP2D, nebo MAP3D                                                     5 B
25.     Nr_of_Textures AS LONG 'pocet textur v souboru                                                4 B
26.     Nr_of_Vertexes AS LONG 'pocet vrcholu v souboru                                               4 B
27.     DataStart AS LONG 'dodatecny udaj o mistu v souboru, kde zacinaji data textur                 4 B
28.     VertexStart AS LONG 'dodatecny udaj o mistu v souboru, kde zacinaji data vrcholu              4 B
29. END TYPE
30.  
31.  
32. TYPE Vertex
33.     Flag AS _UNSIGNED _BYTE 'typ, udavajici, jestli na mape v danem miste je zed, strop, podlaha, nebo stena a strop....  podle toho z ktereho pole zaznam pochazi
34.     X1 AS SINGLE
35.     Y1 AS SINGLE
36.     Z1 AS SINGLE
37.     X2 AS SINGLE
38.     Y2 AS SINGLE
39.     Z2 AS SINGLE
40.     X3 AS SINGLE
41.     Y3 AS SINGLE
42.     Z3 AS SINGLE
43.     X4 AS SINGLE
44.     Y4 AS SINGLE
45.     Z4 AS SINGLE
46.     Texture_Nr AS LONG
47. END TYPE
48.  
49.  
50. 'upgrade 01u14-2ba
51. TYPE InfoPlus
52.     Height_From AS SINGLE 'vyskova pozice - start
53.     Height_To AS SINGLE 'vyskova pozice - konec  u stropu a podlah v rovince to bude stejne
54.     TexturesPerObject AS _UNSIGNED _BYTE ' pocet teles, pres ktere je jedna textura
55.     TextureEffect AS _UNSIGNED _BYTE 'cislo efektu pro texturu
56. END TYPE
57.  
58.  
59. CONST SaveMap3D$ = "MAP3D"
60. ' pro SAVEMAP konec----------------------------
61.  
62.  
63.  
64.  
65. 'GridEndX a GridEndY bude mozne nastavit tlacitkem Grid, pote ulozit do INI souboru
66.  
67.  
68. DIM SHARED StartDrawX, EndDrawX, StartDrawy, EndDrawy, TextureIN, GridXResolution, GridYResolution, GridRGB32Color~&, GridVisibility, GridShowComments, GridCommentsTime 'urcujici promenne pro kresbu mrizky
69.  
70. 'nove sdilene promenne ohledne doplnkoveho pole InfoPlus (IP):
71. DIM SHARED Img_Height_From, Img_Height_To, Img_Textures_per_Object, Img_Texture_Effect, Ceil_Height_From, Ceil_Height_To, Ceil_Textures_per_Object, Ceil_Texture_Effect, Floor_Height_From, Floor_Height_To, Floor_Textures_per_Object, Floor_Texture_Effect
72. DIM SHARED ObjectIN, INSERT_SETUP
73.  
74. LoadINI
75.  
76. 'PRINT GridXResolution, GridYResolution: SLEEP
77.  
78. REDIM SHARED Grid_img(GridXResolution, GridYResolution) AS LONG 'puvodne pro cislo snimku, nevedomky pouzito pro zed. Cili pro zed,
79. REDIM SHARED Grid_Ceil(GridXResolution, GridYResolution) AS LONG 'cislo snimku pro strop
80. REDIM SHARED Grid_Floor(GridXResolution, GridYResolution) AS LONG 'cislo snimku pro podlahu
81. REDIM SHARED Grid_Obj(GridXResolution, GridYResolution) AS LONG 'cislo objektu
82. REDIM SHARED Grid_typ(GridXResolution, GridYResolution) AS LONG
83. REDIM SHARED Grid_SND(GridXResolution, GridYResolution) AS LONG
84.  
85.  
86. 'doplnkova pole nesouci informace o vyskove pozici zdi/podlah/stropu, poctu textur na teleso a texturovem efektu
87. REDIM SHARED IP_Img(GridXResolution, GridYResolution) AS InfoPlus
88. REDIM SHARED IP_Ceil(GridXResolution, GridYResolution) AS InfoPlus
89. REDIM SHARED IP_Floor(GridXResolution, GridYResolution) AS InfoPlus
90.  
91.  
92. REDIM SHARED Texture(0) AS Texture
93. DIM SHARED Button(16) AS Button
94. DIM SHARED COPY_OR_INSERT_Right_click_menu(3) AS _UNSIGNED INTEGER
95. DIM SHARED Icony(12) AS LONG, DIALOG AS _BYTE, TextureStart AS INTEGER, TextureEnd AS INTEGER, TextureSelected AS INTEGER, LAYERS_SETUP AS INTEGER, KEYBOARDAGENT AS LONG, DRAW_MOUSE_SETUP, MemorizeTimer
96. MemorizeTimer = TIMER
97. 'StartDrawX = 1
98. 'StartDrawy = 1
99. 'EndDrawX = 36
100. 'EndDrawy = 35
101.  
102.  
103.  
104.  
105. Button(0).active = 0: Button(0).time = 0: Button(0).text = "Ok˙": Button(0).x = 612: Button(0).y = 580 'pro aktivaci nastav DIALOG na 2
106. Button(1).active = 0: Button(1).time = 0: Button(1).text = "Add Texture": Button(1).x = 945: Button(1).y = 680
107. Button(14).active = 0: Button(14).time = 0: Button(14).text = "Delete Texture": Button(14).x = 945: Button(14).y = 720
108. Button(6).active = 0: Button(6).time = 0: Button(6).text = "Add Object": Button(6).x = 885: Button(6).y = 680
109. Button(7).active = 0: Button(7).time = 0: Button(7).text = "Delete Object": Button(7).x = 885: Button(7).y = 720
110. Button(8).active = 0: Button(8).time = 0: Button(8).text = "Rotate Object": Button(8).x = 825: Button(8).y = 680
111. Button(2).active = 0: Button(2).time = 0: Button(2).text = "Wall Height": Button(2).x = 825: Button(2).y = 720
112. Button(3).active = 0: Button(3).time = 0: Button(3).text = "Load Map": Button(3).x = 765: Button(3).y = 680
113. Button(4).active = 0: Button(4).time = 0: Button(4).text = "Save Map": Button(4).x = 765: Button(4).y = 720
114. Button(5).active = 0: Button(5).time = 0: Button(5).text = "New Map": Button(5).x = 705: Button(5).y = 680
115. Button(9).active = 0: Button(9).time = 0: Button(9).text = "Set Grid": Button(9).x = 705: Button(9).y = 720
116. Button(10).active = 0: Button(10).time = 0: Button(10).text = "Draw Floor": Button(10).x = 645: Button(10).y = 680
117. Button(11).active = 0: Button(11).time = 0: Button(11).text = "Draw Ceiling": Button(11).x = 645: Button(11).y = 720
118. Button(12).active = 1: Button(12).time = 0: Button(12).text = "Draw Wall": Button(12).x = 585: Button(12).y = 680
119. Button(13).active = 0: Button(13).time = 0: Button(13).text = "Quit": Button(13).x = 585: Button(13).y = 720
120. Button(15).text = "Yes": Button(15).x = 412: Button(15).y = 380
121. Button(16).text = "No˙": Button(16).x = 480: Button(16).y = 380
122. 'DIALOG = 1
123.  
124.  
125.  
126. Icony(1) = LOADICO("ico\left.ico", 3)
127. Icony(2) = LOADICO("ico\right.ico", 3)
128. Icony(3) = LOADICO("ico\up.ico", 3)
129. Icony(4) = LOADICO("ico\dn.ico", 3)
130. Icony(5) = LOADICO("ico\ot.ico", 4)
131. Icony(6) = LOADICO("ico\film.ico", 2)
132.  
133. 'pro funkci Browse
134. Icony(7) = LOADICO("ico\invalid.ico", 7)
135. Icony(8) = LOADICO("ico\ko.ico", 1)
136. Icony(9) = LOADICO("ico\oke.ico", 1)
137. Icony(10) = LOADICO("ico\sup.ico", 7)
138. Icony(11) = LOADICO("ico\sdn.ico", 7)
139. TextureIN = Icony(6)
140. Icony(12) = ROTO(90)
141. '_CLEARCOLOR _RGB32(0, 0, 0), Icony(12)
142. TextureIN = 0
143.  
144.  
145. 'Init_Screen
146. Create_Buttons 'vytvori tlacitka a jejich kresbu
147. 'Texture(0).img = _LOADIMAGE("textures\a.jpg", 32)
148. 'Texture(1).img = _LOADIMAGE("textures\a.jpg", 32)
149. 'Texture(2).img = _LOADIMAGE("textures\a.jpg", 32)
150. 'Texture(3).img = _LOADIMAGE("textures\a.jpg", 32)
151. 'Texture(4).img = _LOADIMAGE("textures\dub.jpg", 32)
152. 'Texture(5).img = _LOADIMAGE("textures\a.jpg", 32)
153. 'Texture(6).img = _LOADIMAGE("textures\dub.jpg", 32)
154. 'Texture(7).img = _LOADIMAGE("textures\a.jpg", 32)
155. 'Texture(8).img = _LOADIMAGE("textures\dub.jpg", 32)
156.  
157. TextureStart = 0: TextureEnd = 6
158. 'Grid_img(10, 10) = _SCREENIMAGE
159. 'Grid_typ(10, 10) = 1
160. 'Grid_rot(10, 10) = 45
161.  
162. DO
163.  
164.     '  WHILE _MOUSEINPUT: WEND
165.  
166.     Init_Screen
167.     Init_Objects
168.  
169.  
170.  
171.     k& = _KEYDOWN(32)
172.     IF k& THEN KEYBOARDAGENT = 1 ELSE KEYBOARDAGENT = 0
173.  
174.  
175.  
176.     SELECT CASE Place_Buttons
177.         CASE 1
178.             New_Texture_Name$ = Browse("JPGBMPGIFPNG")
179.             'odfiltrovat cesty
180.  
181.  
182.  
183.             new_texture = _LOADIMAGE(New_Texture_Name$, 32) 'spusti program na prochazeni souboru na disku a umozni zvolit texturu
184.             IF new_texture < -1 THEN
185.                 IF Texture(0).img < -1 THEN REDIM _PRESERVE Texture(UBOUND(Texture) + 1) AS Texture
186.                 Texture(UBOUND(Texture)).img = new_texture
187.                 Texture(UBOUND(Texture)).path = New_Texture_Name$
188.  
189.                 '                CLS: PRINT Texture(UBOUND(Texture)).path: _DISPLAY: SLEEP
190.  
191.                 TextureStart = UBOUND(Texture) - 6: TextureEnd = UBOUND(Texture)
192.  
193.             END IF
194.             Reset_Mouse
195.  
196.         CASE 2: Wall_Height: Reset_Mouse
197.  
198.         CASE 3: IF IS_EMPTY_GRID THEN LOAD_MAP (Browse("MAP")) ELSE DialogW "Save this MAP?", 5: LOAD_MAP (Browse("MAP")): Reset_Mouse
199.         CASE 4: DialogW "Save MAP as:", 2: Reset_Mouse 'SAVE_MAP ("testC.map") 'ulozeni mapy, dodelat dotaz na jmeno mapy, testy souborove pritomnosti a tak dale
200.         CASE 5: DialogW "", 4: Reset_Mouse 'NEW MAP
201.         CASE 6: New_Object$ = Browse("OBJ"): Reset_Mouse 'NewObject = LOADOBJECT (Browse("OBJ"))
202.  
203.         CASE 9: SetGrid: Reset_Mouse
204.         CASE 10 'floor strop
205.             Button(10).active = 1: Button(11).active = 0: Button(12).active = 0: Reset_Mouse 'rozliseni musi resit Init_Screen
206.  
207.  
208.         CASE 11 ' ceiling podlaha
209.             Button(11).active = 1: Button(10).active = 0: Button(12).active = 0: Reset_Mouse
210.  
211.  
212.         CASE 12 'wall zed
213.             Button(12).active = 1: Button(10).active = 0: Button(11).active = 0: Reset_Mouse
214.  
215.         CASE 13: DialogW "Save work and exit?", 1: Reset_Mouse
216.         CASE 14: DELETE_TEXTURE: Reset_Mouse
217.  
218.  
219.         CASE 15:
220.  
221.         CASE 16: DIALOG = 0
222.     END SELECT
223.  
224.     _DISPLAY
225.     PCOPY _DISPLAY, 10
226.     _LIMIT 20
227. LOOP
228.  
229.  
230.  
231.  
232. SUB Init_Objects
233.     'this is now developed
234.  
235.  
236.  
237.  
238.     FOR pas = 63 TO 428 STEP 73
239.         _PUTIMAGE (pas, 670), Icony(12)
240.     NEXT pas
241.  
242.  
243.  
244.  
245. END SUB
246.  
247. FUNCTION RightClickMenu (c() AS STRING, X AS INTEGER, Y AS INTEGER) 'vrati -1 pro Esc, jinak 1 az ubound pole
248.     PCOPY 10, _DISPLAY
249.     _FONT 16
250.     FOR Search_Max_Width = LBOUND(c) TO UBOUND(c)
251.         IF Max_Width < _PRINTWIDTH(c(Search_Max_Width)) THEN Max_Width = _PRINTWIDTH(c(Search_Max_Width))
252.     NEXT
253.  
254.     Max_Height = (_FONTHEIGHT * UBOUND(c)) + 10
255.     Max_Width = Max_Width + 10
256.  
257.  
258.     FreeX = _WIDTH - X - 10
259.     FreeY = _HEIGHT - Y - 10
260.     IF FreeX > Max_Width THEN placeX = X + 10 ELSE placeX = X - 10 - Max_Width
261.     IF FreeY > Max_Height THEN placeY = Y + 10: ELSE placeY = Y - 10 - Max_Height
262.     LINE (placeX, placeY)-(placeX + Max_Width, placeY + Max_Height), _RGB32(70, 70, 70), BF
263.     LINE (placeX, placeY)-(placeX + Max_Width, placeY + Max_Height), _RGB32(155, 155, 155), B
264.     LINE (placeX + 2, placeY + 2)-(placeX + Max_Width - 2, placeY + Max_Height - 2), _RGB32(155, 155, 155), B
265.     by = placeY + 5
266.     _PRINTMODE _FILLBACKGROUND
267.     sel = LBOUND(c)
268.     REM _MOUSEMOVE placeX, placeY
269.     DO UNTIL RightClickMenu OR _KEYHIT = 27
270.         DO WHILE _MOUSEINPUT
271.             sel = sel + _MOUSEWHEEL
272.         LOOP
273.         by = placeY + 5
274.         FOR W = LBOUND(C) TO UBOUND(c)
275.             L = Max_Width / _FONTWIDTH - LEN(c(W)) - 1 'in graphic mode: (Max_Width - _PRINTWIDTH(c(W))) / _FONTWIDTH - 10
276.             Text$ = c(W) + STRING$(L, " ")
277.             IF _MOUSEX >= placeX AND _MOUSEX <= placeX + Max_Width THEN
278.                 IF _MOUSEY >= placeY AND _MOUSEY <= placeY + Max_Height THEN
279.                     sel = _CEIL((_MOUSEY - placeY) / 16)
280.                 END IF
281.             END IF
282.             IF sel > UBOUND(c) THEN sel = UBOUND(c)
283.             IF sel < LBOUND(c) THEN sel = LBOUND(c)
284.             IF W = sel THEN COLOR _RGB32(255, 255, 0), _RGB32(0, 0, 255) ELSE COLOR _RGB32(255), _RGB32(70, 70, 70)
285.             _PRINTSTRING (placeX + 7, by), Text$
286.             by = by + _FONTHEIGHT
287.             IF _MOUSEBUTTON(1) THEN RightClickMenu = sel: EXIT FOR
288.             i$ = INKEY$
289.             SELECT CASE i$
290.                 CASE CHR$(0) + CHR$(72): sel = sel - 1
291.                 CASE CHR$(0) + CHR$(80): sel = sel + 1
292.                 CASE CHR$(13): RightClickMenu = sel: EXIT FOR
293.                 CASE CHR$(27): RightClickMenu = -1: EXIT DO
294.             END SELECT
295.         NEXT
296.         _DISPLAY
297.     LOOP
298.     Reset_Mouse
299. END FUNCTION
300.  
301.  
302.  
303.  
304.  
305. SUB Comment_Window (C() AS STRING, X AS INTEGER, Y AS INTEGER)
306.     IF TextureIN >= -1 THEN EXIT SUB
307.     Yellow& = _NEWIMAGE(20, 20, 32)
308.     a = _DEST
309.     _DEST Yellow&
310.     CLS , _RGB32(255, 255, 0)
311.     _DEST a
312.  
313.     _FONT 8
314.     FOR Search_Max_Width = LBOUND(c) TO UBOUND(c)
315.         IF Max_Width < _PRINTWIDTH(C(Search_Max_Width)) THEN Max_Width = _PRINTWIDTH(C(Search_Max_Width))
316.     NEXT
317.     Max_Height = (_FONTHEIGHT * UBOUND(c)) + 10
318.     Max_Width = Max_Width + 10
319.  
320.     PRINT Max_Width, Max_Height 'asi ok
321.  
322.     'tedko: Kdyz neni dost mista od X vlevo, umisti komentar doprava. Pokud neni dost mista pro komentar nad Y, umisti ho pod Y.
323.  
324.     FreeX = _WIDTH - X - Max_Width - 10 '     kolik je volneho mista v ose x od x doprava
325.     FreeY = _HEIGHT - Y - Max_Height - 10 '    kolik je volneho mista v ose y od y dolu
326.  
327.     IF FreeX > Max_Width THEN placeX = X + 10 ELSE placeX = X - 10 - Max_Width
328.     IF FreeY > Max_Height THEN placeY = Y + 10 ELSE placeY = Y - 10 - Max_Height
329.     LINE (placeX, placeY)-(placeX + Max_Width, placeY + Max_Height), _RGB32(255, 255, 0), BF
330.     LINE (placeX, placeY)-(placeX + Max_Width, placeY + Max_Height), _RGB32(127, 127, 127), B
331.     LINE (placeX + 2, placeY + 2)-(placeX + Max_Width - 2, placeY + Max_Height - 2), _RGB32(127, 127, 127), B
332.  
333.     IF placeY < Y THEN
334.         _MAPTRIANGLE (0, 0)-(19, 0)-(19, 19), Yellow& TO(placeX + (Max_Width / 2) - 30, placeY + Max_Height)-(placeX + (Max_Width / 2) + 30, placeY + Max_Height)-(X, Y)
335.         LINE (placeX + (Max_Width / 2) - 30, placeY + Max_Height)-(X, Y), _RGB32(127, 127, 127)
336.         LINE (placeX + (Max_Width / 2) + 30, placeY + Max_Height)-(X, Y), _RGB32(127, 127, 127)
337.     END IF
338.  
339.     IF placeY > Y THEN
340.         _MAPTRIANGLE (0, 0)-(19, 0)-(19, 19), Yellow& TO(placeX + (Max_Width / 2) - 30, placeY)-(placeX + (Max_Width / 2) + 30, placeY)-(X, Y)
341.         LINE (placeX + (Max_Width / 2) - 30, placeY)-(X, Y), _RGB32(127, 127, 127)
342.         LINE (placeX + (Max_Width / 2) + 30, placeY)-(X, Y), _RGB32(127, 127, 127)
343.     END IF
344.  
345.     'spocitam stred kazde vety a tam to napisu
346.     _PRINTMODE _KEEPBACKGROUND
347.     COLOR _RGB32(0, 0, 0)
348.     FOR PrintInfo = LBOUND(c) TO UBOUND(c)
349.         PrintPosition = (Max_Width - _PRINTWIDTH(C(PrintInfo))) / 2
350.  
351.         FOR TextEdit = 1 TO LEN(C(PrintInfo))
352.             COLOR _RGB32(0, 0, 0)
353.             ch$ = MID$(C(PrintInfo), TextEdit, 1)
354.             IF ch$ = UCASE$(ch$) AND ch$ <> ":" THEN COLOR _RGB32(255, 0, 0)
355.             IF ASC(ch$) >= 48 AND ASC(ch$) <= 57 THEN COLOR _RGB32(6, 44, 255)
356.             _PRINTSTRING ((8 * TextEdit) - 8 + placeX + PrintPosition, placeY + _FONTHEIGHT * PrintInfo - 1), ch$
357.         NEXT
358.     NEXT
359.  
360.     _FREEIMAGE Yellow&
361. END SUB
362.  
363.  
364. SUB Wall_Height
365.  
366.     LINE (198, 200)-(822, 568), _RGB32(70, 70, 70), BF
367.     LINE (198, 200)-(822, 568), _RGB32(155, 155, 155), B
368.     LINE (200, 202)-(820, 566), _RGB32(155, 155, 155), B
369.     _FONT 8
370.     _PRINTMODE _KEEPBACKGROUND
371.     _PRINTSTRING (450, 205), "Height Setup"
372.     LINE (200, 215)-(820, 215), _RGB32(155, 155, 155)
373.     DvojSipka = _LOADIMAGE("ico/dvojsipka.bmp", 32)
374.     _CLEARCOLOR _RGB32(255, 255, 255), DvojSipka
375.     PCOPY _DISPLAY, 9
376.     OldRoto = rotos
377.     DO
378.         PCOPY 9, _DISPLAY
379.         WHILE _MOUSEINPUT: WEND
380.         _PUTIMAGE (450, 220), DvojSipka
381.         '        IF Img_Textures_per_Object = 1 THEN aft$ = " object" ELSE aft$ = " objects"
382.         _PRINTSTRING (230, 233), "Textures per 1 Object: " + STR$(Img_Textures_per_Object)
383.         '-------------------------------------------------------------------------------------------------
384.         'nastavovaci veticka pro nastaveni vysky zdi od do
385.         _PRINTSTRING (230, 263), "Set WALL height from: " + LTRIM$(STR$(Img_Height_From))
386.         _PRINTSTRING (230, 293), "Set WALL height to: " + LTRIM$(STR$(Img_Height_To))
387.         _PUTIMAGE (450, 250), DvojSipka: _PUTIMAGE (450, 280), DvojSipka
388.  
389.  
390.         'nastavovaci veticka pro nastaveni vysky zeme od do
391.         _PRINTSTRING (230, 323), "Set FLOOR height from: " + LTRIM$(STR$(Floor_Height_From))
392.         _PRINTSTRING (230, 353), "Set FLOOR height to: " + LTRIM$(STR$(Floor_Height_To))
393.         _PUTIMAGE (450, 310), DvojSipka: _PUTIMAGE (450, 340), DvojSipka
394.  
395.  
396.         'nastavovaci veticka pro nastaveni vysky stropu od do
397.         _PRINTSTRING (230, 383), "Set CEILING height from: " + LTRIM$(STR$(Ceil_Height_From))
398.         _PRINTSTRING (230, 413), "Set CEILING height to: " + LTRIM$(STR$(Ceil_Height_To))
399.         _PUTIMAGE (450, 370), DvojSipka: _PUTIMAGE (450, 400), DvojSipka
400.  
401.  
402.         _PRINTSTRING (230, 443), "Rotate texture angle: " + STR$(rotos) '+ "            degrees"
403.         IF rotos > 360 THEN rotos = 0
404.  
405.  
406.         _PUTIMAGE (450, 430), DvojSipka
407.  
408.         _PRINTSTRING (230, 470), "View rotated texture"
409.  
410.         '_PRINTSTRING (600, 233), "Apply texture filter:" 'efect, bude tu dalsi ROLLMENU
411.  
412.  
413.  
414.         _PRINTSTRING (470, 470), "Reset all to default"
415.  
416.         LINE (225, 465)-(395, 480), _RGB32(255, 255, 255), B
417.         LINE (465, 465)-(635, 480), _RGB32(255, 255, 255), B
418.  
419.  
420.         oke = LOADICO("ico/oke.ico", 1)
421.         bck = LOADICO("ico/ko.ico", 1)
422.         _CLEARCOLOR 0, oke
423.         _CLEARCOLOR 0, bck
424.  
425.  
426.         IF ONPOS(_MOUSEX, _MOUSEY, 300, 500, 385, 530) THEN LINE (300, 500)-(385, 530), _RGBA32(170, 170, 170, 60), BF: IF _MOUSEBUTTON(1) THEN SaveINI: complete = 1 'OK
427.         LINE (300, 500)-(385, 530), _RGB32(255, 255, 255), B
428.         _PUTIMAGE (300, 500), oke
429.         _PRINTSTRING (333, 513), "Done"
430.  
431.         IF ONPOS(_MOUSEX, _MOUSEY, 640, 500, 725, 530) THEN
432.             LINE (640, 500)-(725, 530), _RGBA32(170, 170, 170, 60), BF
433.             IF _MOUSEBUTTON(1) THEN '             BACK
434.                 Img_Textures_per_Object = 1
435.                 Img_Height_From = -2
436.                 Img_Height_To = 2
437.                 Floor_Height_From = -2
438.                 Floor_Height_To = -2
439.                 Ceil_Height_From = 2
440.                 Ceil_Height_To = 2
441.                 rotos = 0
442.                 EXIT SUB
443.             END IF
444.         END IF
445.  
446.         LINE (640, 500)-(725, 530), _RGB32(255, 255, 255), B
447.         _PUTIMAGE (640, 500), bck
448.         _PRINTSTRING (673, 513), "Back"
449.  
450.  
451.  
452.  
453.         'upgrade pro copy styl (mozna doplnit i DELETE styl?)
454.         REDIM copy_style(1 TO 2) AS STRING
455.         copy_style(1) = "Rewrite ALL (walls, floors, objects, ceilings) in destination area"
456.         copy_style(2) = "Rewrite JUST ACTIVE object (if is active button WALL, rewrite WALLs...)"
457.  
458.  
459.         _PRINTSTRING (600, 225), " Insert/Copy setup"
460.         LINE (595, 220)-(750, 235), _RGB32(255), B
461.         IF ONPOS(_MOUSEX, _MOUSEY, 595, 200, 750, 235) THEN
462.             LINE (595, 220)-(750, 235), _RGBA32(127, 127, 127, 100), BF
463.             IF _MOUSEBUTTON(1) THEN
464.                 PCOPY 0, 10
465.                 Reset_Mouse
466.                 INSERT_SETUP = 0
467.  
468.                 DO UNTIL INSERT_SETUP > 0
469.                     INSERT_SETUP = RightClickMenu(copy_style(), _MOUSEX, _MOUSEY)
470.                 LOOP
471.                 _FONT 8
472.                 COLOR _RGB32(255), _RGB32(70)
473.             END IF
474.         END IF
475.  
476.  
477.         'new software construction
478.  
479.         Img_Textures_per_Object = Img_Textures_per_Object + DoubleArrow(450, 220)
480.         Img_Height_From = Img_Height_From + DoubleArrow(450, 250)
481.         Img_Height_To = Img_Height_To + DoubleArrow(450, 280)
482.         Floor_Height_From = Floor_Height_From + DoubleArrow(450, 310)
483.         Floor_Height_To = Floor_Height_To + DoubleArrow(450, 340)
484.         Ceil_Height_From = Ceil_Height_From + DoubleArrow(450, 370)
485.         Ceil_Height_To = Ceil_Height_To + DoubleArrow(450, 400)
486.         rotos = rotos + DoubleArrow(450, 430)
487.  
488.         IF TextureIN < -1 THEN
489.             IF OldRoto <> rotos THEN
490.                 IF NewTexture& < -1 THEN _FREEIMAGE NewTexture&
491.                 NewTexture& = ROTO(rotos): OldRoto = rotos
492.             END IF
493.         END IF
494.  
495.  
496.  
497.         IF ONPOS(_MOUSEX, _MOUSEY, 225, 465, 395, 480) THEN
498.             LINE (225, 465)-(395, 480), _RGBA32(127, 127, 127, 100), BF
499.             IF _MOUSEBUTTON(1) THEN
500.                 IF NewTexture& < -1 THEN
501.                     _PUTIMAGE (0, 0)-(_WIDTH, _HEIGHT), NewTexture&: _DISPLAY: SLEEP 2
502.                 END IF
503.             END IF
504.         END IF
505.  
506.  
507.         IF ONPOS(_MOUSEX, _MOUSEY, 465, 465, 635, 480) THEN
508.             LINE (465, 465)-(635, 480), _RGBA32(127, 127, 127, 100), BF
509.             IF _MOUSEBUTTON(1) THEN
510.                 Img_Textures_per_Object = 1
511.                 Img_Height_From = -2
512.                 Img_Height_To = 2
513.                 Floor_Height_From = -2
514.                 Floor_Height_To = -2
515.                 Ceil_Height_From = 2
516.                 Ceil_Height_To = 2
517.                 rotos = 0
518.             END IF
519.         END IF
520.  
521.  
522.         _DISPLAY
523.     LOOP UNTIL INKEY$ = CHR$(27) OR complete
524.  
525.     IF NewTexture& < -1 THEN
526.         u = UBOUND(texture)
527.         REDIM _PRESERVE Texture(u + 1) AS Texture
528.         NTN$ = GET_NEW_TEXTURE_NAME
529.         Texture(u + 1).img = NewTexture&
530.         Texture(u + 1).path = NTN$
531.  
532.         'SteveMcNeil's saveimage utility 'older version, not JPG
533.         res = SaveImage(Texture(u + 1).path, NewTexture&, 0, 0, _WIDTH(NewTexture&), _HEIGHT(NewTexture&))
534.     END IF
535.  
536.  
537.  
538. END SUB
539.  
540. FUNCTION GET_NEW_TEXTURE_NAME$
541.     z$ = "Rotated_texture"
542.     DO
543.         GET_NEW_TEXTURE_NAME$ = _CWD$ + "\textures\" + z$ + STR$(nr) + ".PNG"
544.         nr = nr + 1
545.     LOOP UNTIL _FILEEXISTS(GET_NEW_TEXTURE_NAME$) = 0
546. END FUNCTION
547.  
548.  
549. FUNCTION ROTO& (angle AS SINGLE) 'modified ROTOZOOM
550.     actual = _DEST
551.     ROTO& = _NEWIMAGE(_WIDTH(TextureIN), _HEIGHT(TextureIN), 32)
552.     _DEST ROTO&
553.     CLS , 0 'for transparent background
554.     _DEST actual
555.     DIM px(3) AS INTEGER, py(3) AS INTEGER, w AS INTEGER, h AS INTEGER
556.     DIM sinr AS SINGLE, cosr AS SINGLE, i AS _BYTE
557.     w = _WIDTH(TextureIN): h = _HEIGHT(TextureIN)
558.     x = w / 2: y = h / 2
559.     px(0) = -w \ 2: py(0) = -h \ 2: px(3) = w \ 2: py(3) = -h \ 2
560.     px(1) = -w \ 2: py(1) = h \ 2: px(2) = w \ 2: py(2) = h \ 2
561.     sinr = SIN(angle / 57.2957795131): cosr = COS(angle / 57.2957795131)
562.     FOR i = 0 TO 3
563.         x2 = (px(i) * cosr + sinr * py(i)) + x: y2 = (py(i) * cosr - px(i) * sinr) + y
564.         px(i) = x2: py(i) = y2
565.     NEXT
566.     _MAPTRIANGLE (0, 0)-(0, h - 1)-(w - 1, h - 1), TextureIN TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2)), ROTO&
567.     _MAPTRIANGLE (0, 0)-(w - 1, 0)-(w - 1, h - 1), TextureIN TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2)), ROTO&
568. END SUB
569.  
570.  
571. FUNCTION DoubleArrow (x AS INTEGER, y AS INTEGER) 'just for calling "DvojSipka"
572.     IF _MOUSEX >= x AND _MOUSEX < x + 21 AND _MOUSEY >= y + 3 AND _MOUSEY < y + 32 THEN '21x36 is image size
573.         IF _MOUSEY < y + 18 THEN LINE (x, y + 3)-(x + 21, y + 15), _RGBA32(127, 127, 127, 100), BF
574.         IF _MOUSEY > y + 18 THEN LINE (x, y + 20)-(x + 21, y + 32), _RGBA32(127, 127, 127, 100), BF
575.  
576.         IF _MOUSEBUTTON(1) = -1 THEN
577.             IF _MOUSEY < y + 18 THEN DoubleArrow = 1: _DELAY .1
578.             IF _MOUSEY > y + 18 THEN DoubleArrow = -1: _DELAY .1
579.         END IF
580.     END IF
581.  
582. END FUNCTION
583.  
584.  
585. SUB DELETE_TEXTURE 'odstrani texturu ze seznamu textur.
586.     ' TextureIN je sdilena promenna vracejici cislo zvolene textury
587.  
588.     'nejprve otestuju pole Grid(X,Y).img jestli tam je tato hodnota pouzita, pak oskenuju pole Texture(N).img, kde je tato hodnota pouzita, a tu smazu.
589.     'podle testu funkce LOADIMAGE, dojde ke smazani jedine, konkretni ikony. Pokud je stejny obrazek nacten jako dalsi ikona, ma uz jine ID a zustane.
590.  
591.     'test polr Grid:
592.     TYPE swap
593.         v1 AS LONG
594.         v2 AS LONG
595.     END TYPE
596.  
597.     REDIM swp(0) AS swap
598.     '   REDIM Tex(0) AS LONG
599.     'zkusim jen rychlou opravu rozlisenim podle rezimu editoru, stim, ze toto funguje pro wall mode, tak jen udelam dalsi 2 kopie podle tlacitka podle jejich hodnoty .active
600.  
601.  
602.     IF Button(12).active THEN
603.  
604.         FOR Gsx = LBOUND(grid_img, 1) TO UBOUND(grid_img, 1)
605.             FOR Gsy = LBOUND(grid_img, 2) TO UBOUND(grid_img, 2)
606.                 value = Grid_img(Gsx, Gsy)
607.                 IF value = TextureIN THEN
608.                     REDIM _PRESERVE swp(used) AS swap
609.                     swp(used).v1 = Gsx
610.                     swp(used).v2 = Gsy
611.                     used = used + 1
612.                 END IF
613.         NEXT Gsy, Gsx
614.  
615.  
616.  
617.         FOR scn = LBOUND(Texture) TO UBOUND(Texture)
618.             IF Texture(scn).img = TextureIN THEN DelRec = scn: EXIT FOR 'je mozna jen jedna shoda!
619.         NEXT
620.  
621.         FOR EraseGrid = LBOUND(swp) TO UBOUND(swp)
622.             a1 = swp(EraseGrid).v1
623.             a2 = swp(EraseGrid).v2
624.             Grid_img(a1, a2) = 0: Grid_typ(a1, a2) = 0
625.         NEXT
626.         ERASE swp
627.         _DELAY .3
628.         GOTO test
629.     END IF
630.  
631.     IF Button(11).active THEN
632.  
633.         FOR Gsx = LBOUND(Grid_Ceil, 1) TO UBOUND(Grid_Ceil, 1)
634.             FOR Gsy = LBOUND(Grid_Ceil, 2) TO UBOUND(Grid_Ceil, 2)
635.                 value = Grid_Ceil(Gsx, Gsy)
636.                 IF value = TextureIN THEN
637.                     REDIM _PRESERVE swp(used) AS swap
638.                     swp(used).v1 = Gsx
639.                     swp(used).v2 = Gsy
640.                     used = used + 1
641.                 END IF
642.         NEXT Gsy, Gsx
643.  
644.  
645.         FOR scn = LBOUND(Texture) TO UBOUND(Texture)
646.             IF Texture(scn).img = TextureIN THEN DelRec = scn: EXIT FOR 'je mozna jen jedna shoda!
647.         NEXT
648.  
649.         'vlastni vymaz
650.         FOR EraseGrid = LBOUND(swp) TO UBOUND(swp)
651.             a1 = swp(EraseGrid).v1
652.             a2 = swp(EraseGrid).v2
653.             Grid_Ceil(a1, a2) = 0: Grid_typ(a1, a2) = 0 'bude chtit upgrade podle kombinace poli
654.         NEXT
655.         ERASE swp
656.  
657.         _DELAY .3 'nutne, jinak na jedno kliknuti smazes osm az deset prdeli textur
658.         GOTO test
659.     END IF
660.  
661.  
662.     IF Button(10).active THEN
663.         FOR Gsx = LBOUND(Grid_Floor, 1) TO UBOUND(Grid_Floor, 1)
664.             FOR Gsy = LBOUND(Grid_Floor, 2) TO UBOUND(Grid_Floor, 2)
665.                 value = Grid_Floor(Gsx, Gsy)
666.                 IF value = TextureIN THEN
667.                     REDIM _PRESERVE swp(used) AS swap
668.                     swp(used).v1 = Gsx
669.                     swp(used).v2 = Gsy
670.                     used = used + 1
671.                 END IF
672.         NEXT Gsy, Gsx
673.  
674.         'pole swp ted obsahuje indexy v1 a v2, kde se nachazi tato textura na mrizce. Velikost swp urcuje pocet vyskytu. OK
675.  
676.         FOR scn = LBOUND(Texture) TO UBOUND(Texture)
677.             IF Texture(scn).img = TextureIN THEN DelRec = scn: EXIT FOR 'je mozna jen jedna shoda!
678.         NEXT
679.  
680.         'vlastni vymaz
681.         FOR EraseGrid = LBOUND(swp) TO UBOUND(swp)
682.             a1 = swp(EraseGrid).v1
683.             a2 = swp(EraseGrid).v2
684.             Grid_Floor(a1, a2) = 0: Grid_typ(a1, a2) = 0 'bude chtit upgrade podle kombinace poli
685.         NEXT
686.         ERASE swp
687.         _DELAY .3 'nutne, jinak na jedno kliknuti smazes osm az deset prdeli textur
688.         GOTO test
689.     END IF
690.  
691.  
692.     'test na pritomnost v ostatnich polich
693.     test:
694.     FOR scn1 = LBOUND(grid_img, 1) TO UBOUND(grid_img, 1)
695.         FOR scn2 = LBOUND(grid_img, 2) TO UBOUND(grid_img, 2)
696.             IF Grid_img(scn1, scn2) = TextureIN THEN Is_in_img = 1
697.             IF Grid_Floor(scn1, scn2) = TextureIN THEN Is_in_floor = 1
698.             IF Grid_Ceil(scn1, scn2) = TextureIN THEN Is_in_ceil = 1
699.     NEXT: NEXT
700.  
701.     IF Button(10).active AND Is_in_ceil = 0 AND Is_in_img = 0 THEN GOTO killimage ELSE EXIT SUB 'floor
702.     IF Button(11).active AND Is_in_img = 0 AND Is_in_floor = 0 THEN GOTO killimage ELSE EXIT SUB 'ceil
703.     IF Button(12).active AND Is_in_ceil = 0 AND Is_in_floor = 0 THEN GOTO killimage ELSE EXIT SUB 'wall
704.  
705.  
706.     killimage:
707.  
708.  
709.     IF Texture(DelRec).img < -1 THEN _FREEIMAGE Texture(DelRec).img
710.     Texture(DelRec).img = 0: Texture(DelRec).path = ""
711.  
712.     i = 0
713.     REDIM NT(0) AS LONG
714.     REDIM Ntt(0) AS STRING
715.     FOR EraseNULL = LBOUND(Texture) TO UBOUND(Texture)
716.         record = Texture(EraseNULL).img
717.         IF record < -1 THEN
718.             REDIM _PRESERVE NT(i) AS LONG
719.             REDIM _PRESERVE Ntt(i) AS STRING
720.             NT(i) = record
721.             Ntt(i) = Texture(EraseNULL).path
722.             i = i + 1
723.         END IF
724.     NEXT
725.  
726.     REDIM Texture(UBOUND(nt)) AS Texture
727.     FOR reload = LBOUND(nt) TO UBOUND(nt)
728.         Texture(reload).img = NT(reload)
729.         Texture(reload).path = Ntt(reload)
730.     NEXT reload
731.  
732.     ERASE NT
733.     ERASE Ntt
734.     EXIT SUB
735.  
736.     CLS
737.     PRINT "pocet prvku pole texture:"; UBOUND(Texture)
738.     FOR k = LBOUND(Texture) TO UBOUND(Texture)
739.         PRINT "Zaznam: "; k; "Hodnota ( spravne < 1): "; Texture(k).img
740.     NEXT k
741.     PRINT "Hodnota pro TextureStart: "; TextureStart
742.     PRINT "Hodnota pro TextureEnd: "; TextureEnd
743.     _DISPLAY
744.     SLEEP
745.  
746.  
747.  
748.  
749. END SUB
750.  
751. FUNCTION Browse$ (mask AS STRING)
752.     'pro ucely programu bude prochazet pouze slozku \Textures
753.  
754.     'limited acces routine in this version
755.     SELECT CASE mask$
756.         CASE "JPGBMPGIFPNG": path$ = _CWD$ + "\textures\*.*": text$ = "Select texture:": dir$ = "TEXTURES": path2$ = _CWD$ + "\textures\"
757.         CASE "OBJ": path$ = _CWD$ + "\obj\*.obj": text$ = "Select object:": dir$ = "OBJ": path2$ = _CWD$ + "\obj\"
758.         CASE "MAP": path$ = _CWD$ + "\map\*.map": text$ = "Select map:": dir$ = "MAP": path2$ = _CWD$ + "\map\"
759.     END SELECT
760.  
761.     LINE (222, 166)-(824, 568), _RGB32(70, 70, 70), BF
762.     LINE (222, 166)-(824, 568), _RGB32(200, 200, 200), B
763.     LINE (224, 168)-(822, 566), _RGB32(200, 200, 200), B
764.  
765.  
766.     _PRINTMODE _KEEPBACKGROUND
767.     _PRINTSTRING (250 + _PRINTWIDTH(text$) / 2, 190), text$
768.     _PRINTSTRING (643, 190), "Preview: "
769.  
770.     LINE (250, 210)-(500, 530), _RGB32(255, 255, 255), B
771.  
772.     'ramecek pro nahled
773.     LINE (550, 210)-(796, 530), _RGB32(255, 255, 255), B
774.  
775.  
776.  
777.  
778.  
779.     'kontrola existence danych podadresaru
780.  
781.     IF _DIREXISTS(_CWD$ + "\" + dir$) = 0 THEN MKDIR dir$
782.     CHDIR dir$
783.  
784.     'vypis do swapovaciho souboru pres DIR
785.     IF _FILEEXISTS("__swap-.txt") THEN KILL "__swap-.txt"
786.     c$ = "dir *.* > __swap-.txt  /B"
787.  
788.     SHELL _HIDE c$
789.     IF _FILEEXISTS("__swap-.txt") THEN
790.         REDIM rek(0) AS STRING
791.         f = FREEFILE
792.         OPEN "__swap-.txt" FOR INPUT AS #f
793.         DO UNTIL EOF(f)
794.             LINE INPUT #f, rek(i)
795.             REDIM _PRESERVE rek(UBOUND(rek) + 1) AS STRING
796.             i = i + 1
797.         LOOP
798.         CLOSE #f
799.         '    KILL "__swap-.txt"
800.     ELSE
801.         SCREEN 0
802.         PRINT "Fatal error: Can not creating swap file using DIR on "; _CWD$; " program line 952."
803.         _DISPLAY
804.         SLEEP 3
805.         SYSTEM
806.     END IF
807.     CHDIR ".."
808.  
809.     'filtrace podle masky v pripade, ze jde o textury - v budoucnu i filtrace souboru OBJ podle hlavicky souboru a souboru MAP podle hlavicky v souboru
810.     i = 0
811.     REDIM R(0) AS STRING
812.     FOR masc = 1 TO LEN(mask) STEP 3
813.         m$ = MID$(mask, masc, 3)
814.         FOR f = LBOUND(rek) TO UBOUND(rek)
815.             IF UCASE$(RIGHT$(rek(f), 3)) = m$ THEN
816.                 R(i) = rek(f)
817.                 REDIM _PRESERVE R(UBOUND(r) + 1) AS STRING
818.                 i = i + 1
819.             END IF
820.     NEXT f, masc
821.     ERASE rek
822.  
823.     rr = UBOUND(r)
824.     IF rr > 1 THEN rr = rr - 1
825.  
826.     REDIM _PRESERVE R(rr) AS STRING
827.  
828.  
829.     _CLEARCOLOR 0, Icony(8)
830.     _FONT 16
831.     _PRINTSTRING (455, 543), "Back"
832.     LINE (420, 533)-(500, 563), , B
833.     _PUTIMAGE (420, 533), Icony(8)
834.     LINE (420, 533)-(500, 563), _RGBA32(70, 70, 70, 200), BF
835.  
836.  
837.     _CLEARCOLOR 0, Icony(9)
838.     _PUTIMAGE (250, 533), Icony(9) 'zelena fajfka ok
839.     LINE (260, 533)-(295, 563), _RGBA32(70, 70, 70, 190), BF
840.  
841.  
842.     _CLEARCOLOR 0, Icony(10)
843.     _PUTIMAGE (475, 210), Icony(10) 'sipka nahoru
844.     LINE (475, 214)-(495, 230), _RGBA32(70, 70, 70, 190), BF
845.  
846.  
847.     _CLEARCOLOR 0, Icony(11)
848.     _PUTIMAGE (475, 510), Icony(11) 'sipka dolu
849.     LINE (475, 510)-(495, 525), _RGBA32(70, 70, 70, 190), BF
850.  
851.     LINE (475, 228)-(495, 510), _RGB32(127, 127, 127), BF 'sedy pruh mezi sipkami
852.  
853.     PruhL = 30 'delka bileho ukazatele / pruhu mezi sipkami vpravo
854.     PrepocetLS = (480 - 228) / UBOUND(r)
855.  
856.  
857.     Sel = 0
858.     sh_s = LBOUND(R)
859.     sh_e = sh_s + 20
860.     IF sh_e > UBOUND(R) THEN sh_e = UBOUND(R)
861.     'startovni nastaveni
862.     PCOPY _DISPLAY, 1
863.     DO
864.         PCOPY 1, _DISPLAY
865.         inmouse = 0
866.         DO WHILE _MOUSEINPUT: mwh = mwh + _MOUSEWHEEL: inmouse = 1: LOOP
867.         i$ = INKEY$
868.  
869.  
870.         '        LOCATE 1, 1: PRINT _MOUSEX, _MOUSEY: _DISPLAY
871.         pruhStart = (Sel * PrepocetLS) + 228
872.         LINE (480, pruhStart)-(490, pruhStart + PruhL), _RGB32(100, 100, 120), BF 'ty vole. Na prvni pokus. Nechapu.
873.         IF ONPOS(_MOUSEX, _MOUSEY, 480, pruhStart, 490, pruhStart + PruhL) THEN
874.  
875.             IF beginmousey = 0 THEN beginmousey = _MOUSEY
876.             IF _MOUSEBUTTON(1) THEN
877.                 IF _MOUSEY < beginmousey THEN i$ = CHR$(0) + CHR$(72)
878.                 IF _MOUSEY > beginmousey THEN i$ = CHR$(0) + CHR$(80)
879.  
880.             END IF
881.         ELSE
882.             beginmousey = 0
883.         END IF
884.  
885.         'podpora pro mys:
886.         IF inmouse THEN
887.             IF ONPOS(_MOUSEX, _MOUSEY, 250, 220, 400, 530) THEN 'doplnek - vyber souboru v okne mysi' X2 ze 475 na 400
888.  
889.                 Sel = sh_s + _CEIL((_MOUSEY - 222) / 16)
890.                 IF _MOUSEBUTTON(1) THEN i$ = CHR$(13)
891.             END IF
892.         END IF
893.  
894.         mb1 = _MOUSEBUTTON(1)
895.  
896.         Sel = Sel + mwh
897.         mwh = 0 'tato konstrukce je ok
898.  
899.         _FONT 16
900.         COLOR _RGB32(255, 255, 255)
901.  
902.         _PRINTSTRING (455, 543), "Back"
903.         LINE (420, 533)-(500, 563), , B
904.         IF ONPOS(_MOUSEX, _MOUSEY, 420, 533, 500, 563) THEN
905.             _PUTIMAGE (420, 533), Icony(8)
906.             LINE (420, 533)-(500, 563), _RGBA32(255, 255, 255, 60), BF
907.             IF mb1 THEN i$ = CHR$(27)
908.         END IF
909.  
910.         _PRINTSTRING (285, 543), "  Ok"
911.         LINE (250, 533)-(330, 563), , B
912.         IF ONPOS(_MOUSEX, _MOUSEY, 250, 533, 330, 563) THEN
913.             _PUTIMAGE (250, 533), Icony(9)
914.             LINE (250, 533)-(330, 563), _RGBA32(255, 255, 255, 60), BF
915.             IF mb1 THEN i$ = CHR$(13)
916.         END IF
917.  
918.         _FONT 8
919.         IF ONPOS(_MOUSEX, _MOUSEY, 475, 214, 495, 230) THEN
920.             _PUTIMAGE (475, 210), Icony(10)
921.             IF mb1 THEN i$ = CHR$(0) + CHR$(72)
922.         END IF
923.  
924.         IF ONPOS(_MOUSEX, _MOUSEY, 475, 510, 495, 525) THEN
925.             _PUTIMAGE (475, 510), Icony(11)
926.             IF mb1 THEN i$ = CHR$(0) + CHR$(80)
927.         END IF
928.         IF mb1 THEN
929.             mb1 = 0
930.             _DELAY .1
931.         END IF
932.  
933.         SELECT CASE i$
934.             CASE CHR$(0) + CHR$(72) ' up
935.                 Sel = Sel - 1
936.             CASE CHR$(0) + CHR$(80) 'dn
937.                 Sel = Sel + 1
938.             CASE CHR$(13)
939.  
940.                 IF UBOUND(r) > 0 THEN 'pri prazdne slozce nic nedelej, ukonci prohlizec
941.  
942.                     IF mask$ = "JPGBMPGIFPNG" THEN
943.                         pokus = _LOADIMAGE(path2$ + R(Sel), 32)
944.                         IF pokus < -1 THEN Browse$ = _CWD$ + "\textures\" + R(Sel): _FREEIMAGE pokus: EXIT FUNCTION
945.                     END IF
946.                     IF mask$ = "MAP" AND MAP_IS_SUPPORTED(_CWD$ + "\map\" + R(Sel)) THEN Browse$ = _CWD$ + "\map\" + R(Sel): EXIT FUNCTION
947.                 ELSE
948.                     EXIT SUB
949.                 END IF
950.  
951.             CASE CHR$(27)
952.                 Browse$ = "": EXIT FUNCTION
953.         END SELECT
954.  
955.         IF Sel < sh_s THEN sh_s = sh_s - 1
956.         IF Sel < LBOUND(R) THEN Sel = LBOUND(R)
957.         IF Sel > sh_e THEN sh_s = sh_s + 1
958.         IF Sel > UBOUND(R) THEN Sel = UBOUND(R)
959.  
960.         IF sh_s > UBOUND(R) - 20 THEN sh_s = UBOUND(R) - 20
961.         IF sh_s < LBOUND(R) THEN sh_s = LBOUND(R)
962.         sh_e = sh_s + 20
963.         IF sh_e > UBOUND(R) THEN sh_e = UBOUND(R)
964.  
965.  
966.         shw = -1
967.         FOR show = sh_s TO sh_e
968.             shw = shw + 1
969.             IF Sel = show THEN 'reseni pro misto, kde je oznacena polozka
970.                 COLOR _RGB32(255, 255, 0)
971.  
972.                 ven$ = R(show)
973.                 IF LEN(ven$) > 28 THEN ven$ = LEFT$(ven$, 25) + "..."
974.                 _PRINTSTRING (250, 220 + (shw * 15)), ven$
975.  
976.                 IF Viewed = 0 THEN
977.  
978.  
979.                     SELECT CASE mask$
980.                         CASE "JPGBMPGIFPNG" 'PRO TEXTURY
981.                             s& = _LOADIMAGE(path2$ + R(Sel))
982.                             IF s& < -1 THEN
983.                                 _PUTIMAGE (551, 211)-(795, 529), s&: Viewed = 1
984.                             ELSE
985.                                 _PUTIMAGE (551, 211)-(795, 529), Icony(7): Viewed = 0 'pokud je neplatny format souboru
986.                             END IF
987.  
988.                         CASE "MAP"
989.                             MapImage& = FAST_MAP_INFO(path2$ + R(Sel))
990.                             _PUTIMAGE (551, 211)-(795, 529), MapImage&: Viewed = 1
991.  
992.  
993.  
994.                     END SELECT
995.  
996.  
997.  
998.  
999.                 END IF
1000.  
1001.             ELSE COLOR _RGB32(255, 255, 255) 'reseni pro otatni polozky
1002.  
1003.                 ven$ = R(show)
1004.                 IF LEN(ven$) > 28 THEN ven$ = LEFT$(ven$, 25) + "..."
1005.                 _PRINTSTRING (250, 220 + (shw * 15)), ven$
1006.  
1007.                 IF Viewed THEN
1008.                     Viewed = 0
1009.                     SELECT CASE mask$
1010.                         CASE "JPGBMPGIFPNG"
1011.                             _FREEIMAGE s&
1012.                         CASE "MAP"
1013.                             _FREEIMAGE MapImage&
1014.                     END SELECT
1015.                 END IF
1016.             END IF
1017.         NEXT show
1018.         _DISPLAY
1019.         _LIMIT 50
1020.     LOOP
1021.  
1022.  
1023. END FUNCTION
1024.  
1025. FUNCTION MAP_IS_SUPPORTED (pathmap AS STRING) '1 = is, 0 = unsupported
1026.     IF _FILEEXISTS(pathmap) THEN
1027.         REDIM MH AS MAP_HEAD
1028.         g = FREEFILE
1029.         OPEN pathmap FOR BINARY AS #g
1030.         GET #g, , MH
1031.         IF MH.Identity = "MAP3D" AND MH.Nr_of_Textures THEN MAP_IS_SUPPORTED = 1
1032.         CLOSE #g
1033.     END IF
1034. END FUNCTION
1035.  
1036.  
1037.  
1038.  
1039.  
1040.  
1041. FUNCTION ONPOS (x, y, x1, y1, x2, y2)
1042.     IF x > x1 AND x < x2 AND y > y1 AND y < y2 THEN ONPOS = 1
1043. END FUNCTION
1044.  
1045.  
1046. FUNCTION WHOIS (x, y)
1047.  
1048.  
1049.     IF Grid_img(x, y) THEN Is_in_img = 1
1050.     IF Grid_Floor(x, y) THEN Is_in_floor = 1
1051.     IF Grid_Ceil(x, y) THEN Is_in_ceil = 1
1052.  
1053.     IF Is_in_img = 0 AND Is_in_floor = 0 AND Is_in_ceil = 0 THEN WHOIS = 0
1054.     IF Is_in_img = 1 AND Is_in_floor = 0 AND Is_in_ceil = 0 THEN WHOIS = 1
1055.     IF Is_in_img = 0 AND Is_in_floor = 1 AND Is_in_ceil = 0 THEN WHOIS = 2
1056.     IF Is_in_img = 0 AND Is_in_floor = 0 AND Is_in_ceil = 1 THEN WHOIS = 3
1057.     IF Is_in_img = 1 AND Is_in_floor = 1 AND Is_in_ceil = 0 THEN WHOIS = 12
1058.     IF Is_in_img = 1 AND Is_in_floor = 0 AND Is_in_ceil = 1 THEN WHOIS = 13
1059.     IF Is_in_img = 0 AND Is_in_floor = 1 AND Is_in_ceil = 1 THEN WHOIS = 23
1060.     IF Is_in_img AND Is_in_floor AND Is_in_ceil THEN WHOIS = 123
1061.  
1062. END FUNCTION
1063.  
1064.  
1065. SUB Delete_Objects_in_area (sx AS INTEGER, sy AS INTEGER, ex AS INTEGER, ey AS INTEGER)
1066.     IF sx < ex THEN SWAP sx, ex
1067.     IF sy < ey THEN SWAP sy, ey
1068.     FOR y = sy TO ey
1069.         FOR x = sx TO ex
1070.             Grid_Obj(x, y) = 0
1071.     NEXT x, y
1072. END SUB
1073.  
1074. SUB Delete_Sounds_in_area (sx AS INTEGER, sy AS INTEGER, ex AS INTEGER, ey AS INTEGER)
1075.     IF sx < ex THEN SWAP sx, ex
1076.     IF sy < ey THEN SWAP sy, ey
1077.     FOR y = sy TO ey
1078.         FOR x = sx TO ex
1079.             Grid_SND(x, y) = 0
1080.     NEXT x, y
1081. END SUB
1082.  
1083.  
1084. SUB Add_Sound_to_area (sx AS INTEGER, sy AS INTEGER, ex AS INTEGER, ey AS INTEGER) 'dodatecne se musi doplnit jak to ma prehrat.
1085.     IF SoundIN THEN
1086.         FOR y = sy TO ey
1087.             FOR x = sx TO ex
1088.                 Grid_SND(x, y) = SoundIN
1089.         NEXT x, y
1090.     END IF
1091. END SUB
1092.  
1093. SUB DialogW (Message AS STRING, ID)
1094.     DIALOG = 1
1095.     PCOPY _DISPLAY, 1
1096.     DO
1097.         '512, 384
1098.  
1099.         Init_Screen
1100.         PCOPY 1, _DISPLAY
1101.         WHILE _MOUSEINPUT: WEND
1102.  
1103.         SELECT CASE ID
1104.             CASE 1
1105.                 LINE (398, 343)-(624, 424), _RGB32(155, 127, 127), BF
1106.                 LINE (398, 343)-(624, 424), _RGB32(255, 255, 255), B
1107.                 LINE (400, 345)-(622, 422), _RGB32(255, 255, 255), B
1108.                 _PRINTMODE _KEEPBACKGROUND
1109.                 stred = 112 - _PRINTWIDTH(Message) / 2
1110.                 _PRINTSTRING (400 + stred, 360), Message
1111.                 P = Place_Buttons
1112.                 _CLEARCOLOR 0, Icony(5)
1113.                 _PUTIMAGE (570, 380), Icony(5)
1114.                 IF P = 16 THEN GOTO after
1115.                 IF P = 15 THEN
1116.  
1117.                     'SAVEMAP jeste neexistuje
1118.                     from1 = 1
1119.                     Message$ = "Save MAP as:"
1120.                     GOTO savedialog ' skoci na dotaz na jmeno pod kterym to ma ulozit
1121.                     after:
1122.                     FOR ers = 1 TO 16
1123.                         _FREEIMAGE Button(ers).imgA
1124.                         _FREEIMAGE Button(ers).imgB
1125.                         IF ers <= UBOUND(Icony) THEN _FREEIMAGE Icony(ers)
1126.                     NEXT ers
1127.                     SYSTEM
1128.                 END IF
1129.                 ' IF P = 16 THEN DIALOG = 0: EXIT DO
1130.  
1131.             CASE 2
1132.                 savedialog: 'small spaghetti block..... :-D
1133.  
1134.  
1135.                 LINE (398, 343)-(624, 424), _RGB32(155, 127, 127), BF
1136.                 LINE (398, 343)-(624, 424), _RGB32(255, 255, 255), B
1137.                 LINE (400, 345)-(622, 422), _RGB32(255, 255, 255), B
1138.                 LINE (398, 370)-(624, 370), _RGB32(255, 255, 255)
1139.                 LINE (398, 390)-(624, 390), _RGB32(255, 255, 255)
1140.  
1141.  
1142.                 'malba tlacitek 15 = yes, 16 = no
1143.  
1144.                 _PUTIMAGE (420, 388), Button(15).imgB
1145.                 _PUTIMAGE (545, 388), Button(16).imgB
1146.  
1147.  
1148.                 _PRINTMODE _KEEPBACKGROUND
1149.                 _PRINTSTRING (465, 355), Message 'spocitano na text "Save MAP as:"
1150.                 DIM Nam AS STRING
1151.  
1152.  
1153.  
1154.                 DO UNTIL LEN(Nam$)
1155.                     WHILE _MOUSEINPUT: WEND
1156.                     IF _MOUSEX >= 398 AND _MOUSEX <= 624 AND _MOUSEY >= 370 AND _MOUSEY <= 390 THEN
1157.                         _MOUSESHOW "text" 'jsi v prostoru textoveho pole
1158.                         IF _MOUSEBUTTON(1) THEN
1159.                             _MOUSESHOW "default"
1160.                             _KEYCLEAR
1161.                             T = TIMER
1162.                             PCOPY _DISPLAY, 5
1163.                             DO UNTIL i$ = CHR$(13) AND LEN(Nam$)
1164.                                 PCOPY 5, _DISPLAY
1165.                                 WHILE _MOUSEINPUT: WEND
1166.                                 IF ONPOS(_MOUSEX, _MOUSEY, 420, 388, 470, 418) THEN
1167.                                     _PUTIMAGE (420, 388), Button(15).imgA
1168.                                     IF _MOUSEBUTTON(1) THEN
1169.  
1170.                                         IF LEN(Nam$) THEN EXIT DO
1171.                                     END IF
1172.                                 END IF 'doplnit imgB
1173.  
1174.                                 IF ONPOS(_MOUSEX, _MOUSEY, 545, 388, 595, 418) THEN
1175.                                     _PUTIMAGE (545, 388), Button(16).imgA
1176.                                     IF _MOUSEBUTTON(1) THEN DIALOG = 0: EXIT SUB
1177.                                 END IF
1178.  
1179.  
1180.                                 SELECT CASE TIMER - T
1181.                                     CASE 0 TO .2: cursor$ = "-"
1182.                                     CASE .21 TO .41: cursor$ = "/"
1183.                                     CASE .42 TO .62: cursor$ = "|"
1184.                                     CASE .63 TO .83: cursor$ = "\"
1185.                                     CASE IS > .84: T = TIMER
1186.                                 END SELECT
1187.  
1188.  
1189.  
1190.  
1191.  
1192.                                 IF LEN(Nam$) > 25 THEN Nam$ = LEFT$(Nam$, 25)
1193.                                 CursorPos = LEN(Nam$) * 8
1194.                                 _PRINTMODE _FILLBACKGROUND
1195.                                 COLOR _RGB32(255), _RGB32(125, 127, 127)
1196.                                 _PRINTSTRING (410, 378), Nam$ + cursor$
1197.  
1198.                                 i$ = INKEY$
1199.                                 IF LEN(i$) THEN
1200.                                     SELECT CASE ASC(i$)
1201.                                         CASE 32 TO 126
1202.                                             Nam$ = Nam$ + i$
1203.                                         CASE 8
1204.                                             Nam$ = LEFT$(Nam$, LEN(Nam$) - 1)
1205.                                     END SELECT
1206.                                 END IF
1207.                                 _DISPLAY
1208.                             LOOP
1209.                         END IF
1210.  
1211.                     ELSE _MOUSESHOW "default"
1212.                     END IF
1213.                     _DISPLAY
1214.                 LOOP
1215.                 ONam$ = Nam$
1216.                 Nam$ = Nam$ + ".MAP"
1217.  
1218.  
1219.                 DO WHILE _FILEEXISTS(Nam$) = -1
1220.                     rnr = rnr + 1
1221.                     Nam$ = ONam$ + STR$(rnr) + ".MAP"
1222.                 LOOP
1223.  
1224.                 SAVE_MAP (Nam$)
1225.  
1226.                 IF from1 THEN GOTO after
1227.                 DIALOG = 0
1228.                 EXIT SUB
1229.  
1230.             CASE 3
1231.  
1232.                 icon = LOADICO("ico/warn.ico", 4)
1233.                 _CLEARCOLOR 0, icon
1234.                 LINE (398, 343)-(624, 424), _RGB32(255, 0, 0), BF
1235.                 LINE (398, 343)-(624, 424), _RGB32(255, 255, 255), B
1236.                 LINE (400, 345)-(622, 422), _RGB32(255, 255, 255), B
1237.                 _PRINTMODE _FILLBACKGROUND
1238.                 COLOR _RGB32(255), _RGB32(255, 0, 0)
1239.  
1240.                 _PRINTSTRING (500, 360), "Map is empty!"
1241.                 _PUTIMAGE (420, 370), icon
1242.                 _PUTIMAGE (500, 380), Button(0).imgB
1243.                 PCOPY _DISPLAY, 5
1244.  
1245.                 DO UNTIL status
1246.                     PCOPY 5, _DISPLAY
1247.                     WHILE _MOUSEINPUT: WEND
1248.                     IF ONPOS(_MOUSEX, _MOUSEY, 500, 390, 550, 420) THEN
1249.                         _PUTIMAGE (500, 380), Button(0).imgA
1250.                         IF _MOUSEBUTTON(1) THEN status = 1
1251.                     END IF
1252.                     _DISPLAY
1253.                 LOOP
1254.                 _FREEIMAGE icon
1255.                 EXIT SUB
1256.  
1257.             CASE 4 'New Map
1258.                 DIALOG = 0
1259.  
1260.  
1261.                 status = 0
1262.                 IF IS_EMPTY_TEXTURECACHE THEN
1263.                     GOTO gridtest
1264.  
1265.  
1266.                 ELSE
1267.  
1268.                     icon = LOADICO("ico/ot.ico", 4)
1269.                     _CLEARCOLOR 0, icon
1270.                     LINE (398, 343)-(624, 424), _RGB32(255, 0, 0), BF
1271.                     LINE (398, 343)-(624, 424), _RGB32(255, 255, 255), B
1272.                     LINE (400, 345)-(622, 422), _RGB32(255, 255, 255), B
1273.                     _PRINTMODE _FILLBACKGROUND
1274.                     COLOR _RGB32(255), _RGB32(255, 0, 0)
1275.                     _PRINTSTRING (425, 360), "Clear texture list?"
1276.                     _PUTIMAGE (420, 380), icon
1277.  
1278.  
1279.                     _PUTIMAGE (460, 385), Button(15).imgB
1280.                     _PUTIMAGE (545, 385), Button(16).imgB
1281.  
1282.  
1283.  
1284.                     PCOPY _DISPLAY, 5
1285.                     status = 0
1286.                     DO UNTIL status
1287.                         PCOPY 5, _DISPLAY
1288.                         WHILE _MOUSEINPUT: WEND
1289.                         IF ONPOS(_MOUSEX, _MOUSEY, 460, 385, 550, 420) THEN
1290.                             _PUTIMAGE (460, 385), Button(15).imgA
1291.                             IF _MOUSEBUTTON(1) THEN
1292.                                 CLEARTEXTURES
1293.                                 CLEARGRID
1294.                                 EXIT SUB
1295.                             END IF
1296.                         END IF
1297.  
1298.                         IF ONPOS(_MOUSEX, _MOUSEY, 545, 385, 645, 420) THEN
1299.                             _PUTIMAGE (545, 385), Button(16).imgA
1300.                             IF _MOUSEBUTTON(1) THEN GOTO gridtest 'status = 1
1301.                         END IF
1302.  
1303.                         _DISPLAY
1304.                     LOOP
1305.  
1306.                 END IF
1307.  
1308.  
1309.  
1310.  
1311.  
1312.  
1313.  
1314.                 gridtest:
1315.                 _DELAY .5
1316.                 IF IS_EMPTY_GRID = 0 THEN
1317.                     'varovani, ze v polich Grid neco je, jestli to chces smazat
1318.  
1319.                     icon = LOADICO("ico/ot.ico", 4)
1320.                     _CLEARCOLOR 0, icon
1321.                     LINE (398, 343)-(624, 424), _RGB32(255, 0, 0), BF
1322.                     LINE (398, 343)-(624, 424), _RGB32(255, 255, 255), B
1323.                     LINE (400, 345)-(622, 422), _RGB32(255, 255, 255), B
1324.                     _PRINTMODE _FILLBACKGROUND
1325.                     COLOR _RGB32(255), _RGB32(255, 0, 0)
1326.                     _PRINTSTRING (430, 360), "Delete all MAP data?"
1327.                     _PUTIMAGE (420, 380), icon
1328.  
1329.  
1330.                     _PUTIMAGE (460, 385), Button(15).imgB
1331.                     _PUTIMAGE (545, 385), Button(16).imgB
1332.  
1333.  
1334.  
1335.                     PCOPY _DISPLAY, 5
1336.                     status = 0
1337.                     DO UNTIL status
1338.                         PCOPY 5, _DISPLAY
1339.                         WHILE _MOUSEINPUT: WEND
1340.                         IF ONPOS(_MOUSEX, _MOUSEY, 460, 385, 550, 420) THEN
1341.                             _PUTIMAGE (460, 385), Button(15).imgA
1342.                             IF _MOUSEBUTTON(1) THEN CLEARGRID: status = 1
1343.                         END IF
1344.  
1345.  
1346.                         IF ONPOS(_MOUSEX, _MOUSEY, 545, 385, 645, 420) THEN
1347.                             _PUTIMAGE (545, 385), Button(16).imgA
1348.                             IF _MOUSEBUTTON(1) THEN status = 1
1349.                         END IF
1350.  
1351.                         _DISPLAY
1352.                     LOOP
1353.                     _FREEIMAGE icon
1354.                     EXIT SUB
1355.                 ELSE
1356.                     EXIT SUB
1357.                 END IF
1358.  
1359.             CASE 5
1360.  
1361.  
1362.                 icon = LOADICO("ico/ot.ico", 4)
1363.                 _CLEARCOLOR 0, icon
1364.                 LINE (398, 343)-(624, 424), _RGB32(255, 0, 0), BF
1365.                 LINE (398, 343)-(624, 424), _RGB32(255, 255, 255), B
1366.                 LINE (400, 345)-(622, 422), _RGB32(255, 255, 255), B
1367.                 _PRINTMODE _FILLBACKGROUND
1368.                 COLOR _RGB32(255), _RGB32(255, 0, 0)
1369.                 _PRINTSTRING (430, 360), Message$
1370.                 _PUTIMAGE (420, 380), icon
1371.  
1372.  
1373.                 _PUTIMAGE (460, 385), Button(15).imgB
1374.                 _PUTIMAGE (545, 385), Button(16).imgB
1375.  
1376.  
1377.  
1378.                 PCOPY _DISPLAY, 5
1379.                 status = 0
1380.                 DO UNTIL status
1381.                     PCOPY 5, _DISPLAY
1382.                     WHILE _MOUSEINPUT: WEND
1383.                     IF ONPOS(_MOUSEX, _MOUSEY, 460, 385, 550, 420) THEN 'save
1384.                         _PUTIMAGE (460, 385), Button(15).imgA
1385.                         IF _MOUSEBUTTON(1) THEN
1386.                             Message$ = "Save MAP as:"
1387.                             GOTO savedialog
1388.                             beforeload:
1389.  
1390.                             status = 1
1391.                         END IF
1392.                     END IF
1393.  
1394.  
1395.                     IF ONPOS(_MOUSEX, _MOUSEY, 545, 385, 645, 420) THEN 'no
1396.                         _PUTIMAGE (545, 385), Button(16).imgA
1397.                         IF _MOUSEBUTTON(1) THEN status = 1
1398.                     END IF
1399.  
1400.                     _DISPLAY
1401.                 LOOP
1402.                 _FREEIMAGE icon
1403.                 DIALOG = 0
1404.                 EXIT SUB
1405.         END SELECT
1406.  
1407.         _LIMIT 60
1408.         _DISPLAY
1409.     LOOP
1410.  
1411. END SUB
1412.  
1413.  
1414.  
1415.  
1416. SUB CLEARTEXTURES
1417.     FOR w = LBOUND(Texture) TO UBOUND(Texture)
1418.         IF Texture(w).img < -1 THEN
1419.             _FREEIMAGE Texture(w).img
1420.             Texture(w).img = 0
1421.         END IF
1422.     NEXT
1423.     REDIM Texture(0) AS Texture
1424. END SUB
1425.  
1426.  
1427.  
1428. SUB CLEARGRID
1429.     FOR v = LBOUND(grid_img, 1) TO UBOUND(grid_img, 1)
1430.         FOR w = LBOUND(grid_img, 2) TO UBOUND(grid_img, 2)
1431.             Grid_img(v, w) = -1
1432.             Grid_Ceil(v, w) = -1
1433.             Grid_Floor(v, w) = -1 'byly nuly, coz je odkaz na texture(0), teda asi
1434.             '            Grid_Obj(v, w) = 0
1435.             Grid_typ(v, w) = 0
1436.     NEXT w, v
1437. END SUB
1438.  
1439.  
1440. SUB Copy_contens_in_area (Rxs, Rys, Rxe, Rye)
1441.  
1442.  
1443.     IF Rxs > Rxe THEN SWAP Rxs, Rxe
1444.     IF Rys > Rye THEN SWAP Rys, Rye
1445.  
1446.     COPY_OR_INSERT_Right_click_menu(0) = Rxs
1447.     COPY_OR_INSERT_Right_click_menu(1) = Rys
1448.     COPY_OR_INSERT_Right_click_menu(2) = Rxe
1449.     COPY_OR_INSERT_Right_click_menu(3) = Rye
1450. END SUB
1451.  
1452.  
1453. SUB Insert_contens_in_area (Rx, Ry)
1454.     FOR i = 0 TO 3
1455.         IF COPY_OR_INSERT_Right_click_menu(i) = 0 THEN empty = 1 ELSE empty = 0 '
1456.     NEXT i
1457.     IF empty THEN
1458.         EXIT SUB
1459.     ELSE
1460.         FOR copyY = COPY_OR_INSERT_Right_click_menu(1) TO COPY_OR_INSERT_Right_click_menu(3)
1461.             iX = 0
1462.             FOR copyX = COPY_OR_INSERT_Right_click_menu(0) TO COPY_OR_INSERT_Right_click_menu(2)
1463.                 NewX = iX + Rx
1464.                 iX = iX + 1
1465.                 NewY = iY + Ry
1466.                 IF NewX > UBOUND(grid_img, 1) THEN NewX = UBOUND(grid_img, 1)
1467.                 IF NewY > UBOUND(grid_img, 2) THEN NewY = UBOUND(grid_img, 2)
1468.  
1469.                 'upgrade: kopie se budou vkladat do mapy v zavislosti na nastaveni. Budto individualne, tedy jen zed/podlaha/strop/objekt, nebo jako celek
1470.                 SELECT CASE INSERT_SETUP '0 = vse (puvodni), 1 = individualne
1471.  
1472.                     CASE 0 'vse se prepise
1473.                         Grid_img(NewX, NewY) = Grid_img(copyX, copyY)
1474.                         IP_Img(NewX, NewY) = IP_Img(copyX, copyY)
1475.  
1476.  
1477.                         Grid_Ceil(NewX, NewY) = Grid_Ceil(copyX, copyY)
1478.                         IP_Ceil(NewX, NewY) = IP_Img(copyX, copyY)
1479.  
1480.  
1481.                         Grid_Floor(NewX, NewY) = Grid_Floor(copyX, copyY)
1482.                         IP_Floor(NewX, NewY) = IP_Img(copyX, copyY)
1483.  
1484.  
1485.                         Grid_typ(NewX, NewY) = Grid_typ(copyX, copyY)
1486.                         Grid_Obj(NewX, NewY) = Grid_Obj(copyX, copyY)
1487.  
1488.                     CASE 1 'prepise se jen konkretni typ podle stiskleho tlacitka
1489.                         IF Button(10).active THEN
1490.                             Grid_Floor(NewX, NewY) = Grid_Floor(copyX, copyY)
1491.                             IP_Floor(NewX, NewY) = IP_Img(copyX, copyY)
1492.                         END IF
1493.  
1494.                         IF Button(11).active THEN
1495.                             Grid_Ceil(NewX, NewY) = Grid_Ceil(copyX, copyY)
1496.                             IP_Ceil(NewX, NewY) = IP_Img(copyX, copyY)
1497.                         END IF
1498.  
1499.                         IF Button(12).active THEN
1500.                             Grid_img(NewX, NewY) = Grid_img(copyX, copyY)
1501.                             IP_Img(NewX, NewY) = IP_Img(copyX, copyY)
1502.                         END IF
1503.  
1504.                         IF ObjectIN THEN
1505.                             Grid_Obj(NewX, NewY) = Grid_Obj(copyX, copyY)
1506.                         END IF
1507.                         Grid_typ(NewX, NewY) = Grid_typ(copyX, copyY)
1508.                 END SELECT
1509.  
1510.             NEXT copyX
1511.             iY = iY + 1
1512.         NEXT copyY
1513.     END IF
1514. END SUB
1515.  
1516.  
1517.  
1518.  
1519. FUNCTION IS_EMPTY_GRID '1 = ano, je prazdna mapa, 0 = ne, na mape neco je
1520.     IS_EMPTY_GRID = 1
1521.     FOR v = LBOUND(grid_img, 1) TO UBOUND(grid_img, 1)
1522.         FOR w = LBOUND(grid_img, 2) TO UBOUND(grid_img, 2)
1523.             IF Grid_img(v, w) OR Grid_Ceil(v, w) OR Grid_Floor(v, w) THEN IS_EMPTY_GRID = 0 'docasne vyrazen grid OBJ
1524.     NEXT w, v
1525. END FUNCTION
1526.  
1527. FUNCTION IS_EMPTY_TEXTURECACHE '1 = ano, v poli textur nic neni, 1 = v poli textur neco je
1528.     IS_EMPTY_TEXTURECACHE = 1
1529.     FOR w = LBOUND(Texture) TO UBOUND(Texture)
1530.         IF Texture(w).img < -1 THEN IS_EMPTY_TEXTURECACHE = 0: EXIT FUNCTION
1531.     NEXT
1532. END FUNCTION
1533.  
1534. SUB Reset_Mouse
1535.     'reset mouseinputs from previous subs
1536.     DO UNTIL _MOUSEBUTTON(1) = 0
1537.         WHILE _MOUSEINPUT: WEND
1538.     LOOP
1539.     '--------------------------------
1540. END SUB
1541.  
1542.  
1543. SUB Init_Screen
1544.  
1545.     CLS , _RGB32(95, 95, 95)
1546.     LINE (0, 668)-(1023, 767), _RGB32(70, 70, 70), BF
1547.  
1548.  
1549.     LINE (923, 0)-(1023, 767), _RGB32(70, 70, 70), BF
1550.     LINE (923, 0)-(1023, 668), _RGB32(255, 255, 255), B
1551.     LINE (0, 668)-(1023, 767), _RGB32(255, 255, 255), B
1552.  
1553.     _PUTIMAGE (10, 700), Icony(1) 'sipka vlevo
1554.     _PUTIMAGE (510, 700), Icony(2) ' vpravo
1555.     _PUTIMAGE (950, 10), Icony(3) 'nahoru
1556.     _PUTIMAGE (950, 610), Icony(4) 'dolu
1557.  
1558.  
1559.  
1560.  
1561.  
1562.     TextureInit = TextureStart
1563.     FOR pas = 85 TO 505 STEP 70
1564.         _PUTIMAGE (927, pas), Icony(6)
1565.     NEXT pas
1566.  
1567.     'ikony foto textur
1568.     i = 95
1569.  
1570.     IF TextureStart < LBOUND(Texture) THEN TextureStart = LBOUND(Texture)
1571.     IF TextureEnd > UBOUND(Texture) THEN TextureEnd = UBOUND(Texture)
1572.  
1573.  
1574.     FOR ShowTextures = TextureStart TO TextureEnd
1575.         IF Texture(ShowTextures).img < -1 THEN 'pridano pri funkce DELETE TEXTURE
1576.  
1577.             '            PRINT Texture(ShowTextures).img, ShowTextures: _DISPLAY
1578.  
1579.             _PUTIMAGE (950, i)-(1000, i + 50), Texture(ShowTextures).img
1580.             _PRINTMODE _KEEPBACKGROUND
1581.             _PRINTSTRING (930, i), STR$(ShowTextures)
1582.  
1583.             i = i + 70
1584.         END IF '                                 pridano
1585.     NEXT
1586.  
1587.     DO WHILE _MOUSEINPUT: mwh = mwh + _MOUSEWHEEL: LOOP
1588.     mwh = mwh + mwh
1589.  
1590.     kbd_agent$ = INKEY$
1591.     IF SGN(mwh) > 0 THEN kbd_agent$ = CHR$(0) + CHR$(80)
1592.     IF SGN(mwh) < 0 THEN kbd_agent$ = CHR$(0) + CHR$(72)
1593.     mwh = 0
1594.  
1595.  
1596.     IF TextureSelected < LBOUND(Texture) THEN TextureSelected = LBOUND(Texture)
1597.     IF TextureStart > TextureSelected THEN TextureStart = TextureSelected
1598.     IF TextureStart + 6 < UBOUND(Texture) THEN TextureEnd = TextureStart + 6 ELSE TextureEnd = UBOUND(Texture)
1599.     '-----------------------
1600.  
1601.     IF _MOUSEX > 950 AND _MOUSEX < 997 AND _MOUSEY > 10 AND _MOUSEY < 57 THEN
1602.  
1603.         IF _MOUSEBUTTON(1) = 0 THEN LINE (950, 10)-(997, 57), _RGBA32(255, 255, 255, 60), BF
1604.         IF _MOUSEBUTTON(1) THEN
1605.             _PUTIMAGE (951, 11), Icony(3) 'nahoru
1606.             LINE (950, 10)-(997, 57), _RGBA32(255, 255, 255, 60), BF
1607.             TextureSelected = TextureSelected - 1
1608.             IF TextureSelected < LBOUND(Texture) THEN TextureSelected = LBOUND(Texture)
1609.             IF TextureStart > TextureSelected THEN TextureStart = TextureSelected
1610.             IF TextureStart + 6 < UBOUND(Texture) THEN TextureEnd = TextureStart + 6 ELSE TextureEnd = UBOUND(Texture)
1611.             _DELAY .1
1612.         END IF
1613.     END IF
1614.  
1615.     'posuv foto textur SIPKA DOLU
1616.  
1617.     IF _MOUSEX > 950 AND _MOUSEX < 997 AND _MOUSEY > 610 AND _MOUSEY < 657 THEN
1618.         IF _MOUSEBUTTON(1) = 0 THEN LINE (950, 610)-(997, 657), _RGBA32(255, 255, 255, 60), BF
1619.         IF _MOUSEBUTTON(1) THEN
1620.             _PUTIMAGE (951, 611), Icony(4) 'dolu
1621.             LINE (950, 610)-(997, 657), _RGBA32(255, 255, 255, 60), BF
1622.             TextureSelected = TextureSelected + 1
1623.             IF TextureSelected > UBOUND(Texture) THEN TextureSelected = UBOUND(Texture)
1624.             IF TextureEnd < TextureSelected THEN TextureEnd = TextureSelected
1625.             IF TextureEnd - 6 > LBOUND(Texture) THEN TextureStart = TextureEnd - 6 ELSE TextureStart = LBOUND(Texture)
1626.             _DELAY .1
1627.         END IF
1628.     END IF
1629.  
1630.  
1631.  
1632.     'podpora ovladani fototextur z klavesnice
1633.     IF _MOUSEX > 950 AND _MOUSEX < 997 AND _MOUSEY > 10 AND _MOUSEY < 657 THEN
1634.         '        kbd_agent$ = INKEY$
1635.         SELECT CASE kbd_agent$
1636.             CASE CHR$(0) + CHR$(80) 'dolu
1637.                 _PUTIMAGE (951, 611), Icony(4) 'dolu
1638.                 LINE (950, 610)-(997, 657), _RGBA32(255, 255, 255, 60), BF
1639.                 TextureSelected = TextureSelected + 1
1640.                 IF TextureSelected > UBOUND(Texture) THEN TextureSelected = UBOUND(Texture)
1641.                 IF TextureEnd < TextureSelected THEN TextureEnd = TextureSelected
1642.                 IF TextureEnd - 6 > LBOUND(Texture) THEN TextureStart = TextureEnd - 6 ELSE TextureStart = LBOUND(Texture)
1643.  
1644.  
1645.             CASE CHR$(0) + CHR$(72) 'nahoru
1646.                 _PUTIMAGE (951, 11), Icony(3) 'nahoru
1647.                 LINE (950, 10)-(997, 57), _RGBA32(255, 255, 255, 60), BF
1648.                 TextureSelected = TextureSelected - 1
1649.                 IF TextureSelected < LBOUND(Texture) THEN TextureSelected = LBOUND(Texture)
1650.                 IF TextureStart > TextureSelected THEN TextureStart = TextureSelected
1651.                 IF TextureStart + 6 < UBOUND(Texture) THEN TextureEnd = TextureStart + 6 ELSE TextureEnd = UBOUND(Texture)
1652.  
1653.                 'upgrade - pridana podpora pro PGUP, PGDN, HOME a END       home 71, end 79
1654.             CASE CHR$(0) + CHR$(71) 'home
1655.                 TextureStart = LBOUND(texture)
1656.                 IF UBOUND(texture) > TextureStart + 6 THEN TextureEnd = TextureStart + 6 ELSE TextureEnd = UBOUND(texture)
1657.                 TextureSelected = LBOUND(texture)
1658.  
1659.             CASE CHR$(0) + CHR$(79) 'end
1660.                 IF UBOUND(texture) > 6 THEN
1661.                     TextureEnd = UBOUND(texture)
1662.                     TextureStart = TextureEnd - 6
1663.                 ELSE TextureEnd = UBOUND(texture)
1664.                     TextureStart = LBOUND(texture)
1665.                 END IF
1666.                 TextureSelected = UBOUND(texture)
1667.  
1668.             CASE CHR$(0) + CHR$(73) 'pgup
1669.                 IF TextureStart - 6 > LBOUND(texture) THEN
1670.                     TextureStart = TextureStart - 6
1671.                     TextureEnd = TextureStart + 6
1672.                     TextureSelected = TextureSelected - 6
1673.                 ELSE
1674.                     TextureStart = LBOUND(texture)
1675.                     TextureSelected = LBOUND(texture)
1676.                     IF UBOUND(texture) > 6 THEN
1677.                         TextureEnd = TextureStart + 6
1678.                     ELSE
1679.                         TextureEnd = UBOUND(texture)
1680.                     END IF
1681.                 END IF
1682.  
1683.             CASE CHR$(0) + CHR$(81) 'pgdn
1684.                 IF TextureEnd + 6 < UBOUND(texture) THEN
1685.                     TextureStart = TextureStart + 6
1686.                     TextureEnd = TextureStart + 6
1687.                     TextureSelected = TextureSelected + 6
1688.                 ELSE
1689.                     TextureEnd = UBOUND(texture)
1690.                     TextureSelected = UBOUND(texture)
1691.                     IF UBOUND(texture) > 6 THEN
1692.                         TextureStart = TextureEnd - 6
1693.                     ELSE
1694.                         TextureStart = LBOUND(Texture)
1695.                     END IF
1696.                 END IF
1697.         END SELECT
1698.     END IF
1699.  
1700.     SHARED TextureIN
1701.  
1702.     IF _MOUSEX > 929 AND _MOUSEX < 1020 AND _MOUSEBUTTON(1) THEN
1703.         SELECT CASE _MOUSEY
1704.             CASE 87 TO 154: TextureSelected = TextureStart + 0
1705.             CASE 157 TO 225: TextureSelected = TextureStart + 1
1706.             CASE 229 TO 295: TextureSelected = TextureStart + 2
1707.             CASE 299 TO 366: TextureSelected = TextureStart + 3
1708.             CASE 368 TO 435: TextureSelected = TextureStart + 4
1709.             CASE 440 TO 506: TextureSelected = TextureStart + 5
1710.             CASE 509 TO 578: TextureSelected = TextureStart + 6
1711.         END SELECT
1712.     END IF
1713.  
1714.     IF TextureSelected > UBOUND(Texture) THEN TextureSelected = UBOUND(Texture)
1715.     TextureIN = Texture(TextureSelected).img 'pro vklad do mrizky
1716.  
1717.  
1718.     SELECT CASE TextureSelected - TextureStart
1719.         CASE 0: LINE (929, 87)-(1020, 154), _RGB32(255, 255, 0), B
1720.         CASE 1: LINE (929, 157)-(1020, 225), _RGB32(255, 255, 0), B
1721.         CASE 2: LINE (929, 229)-(1020, 295), _RGB32(255, 255, 0), B
1722.         CASE 3: LINE (929, 299)-(1020, 366), _RGB32(255, 255, 0), B
1723.         CASE 4: LINE (929, 368)-(1020, 435), _RGB32(255, 255, 0), B
1724.         CASE 5: LINE (929, 440)-(1020, 506), _RGB32(255, 255, 0), B
1725.         CASE 6: LINE (929, 509)-(1020, 578), _RGB32(255, 255, 0), B
1726.     END SELECT
1727.  
1728.  
1729.     IF GridVisibility THEN
1730.         FOR mY = 18 TO 618 STEP 25
1731.             FOR mx = 23 TO 873 STEP 25
1732.                 LINE (mx, mY)-(mx + 49, mY + 49), GridRGB32Color~&, B
1733.         NEXT mx, mY
1734.     END IF
1735.  
1736.  
1737.     IF _MOUSEX > 23 AND _MOUSEX < 920 AND _MOUSEY > 18 AND _MOUSEY < 666 THEN
1738.         SHARED memoryzex, memoryzey
1739.  
1740.         kbd_agent$ = INKEY$
1741.  
1742.         '...............   3.5 upgrade ................................
1743.         IF _MOUSEBUTTON(2) THEN
1744.             'nejrve vyber oblast, jako pri kliku levym tlacitkem, pak spust right clickmenu
1745.             RightXstart = _MOUSEX
1746.             RightYstart = _MOUSEY
1747.             DO UNTIL _MOUSEBUTTON(2) = 0
1748.                 WHILE _MOUSEINPUT: WEND
1749.                 PCOPY 10, _DISPLAY
1750.                 IF _MOUSEX > 23 AND _MOUSEX < 920 AND _MOUSEY > 18 AND _MOUSEY < 666 THEN
1751.                     LINE (RightXstart, RightYstart)-(_MOUSEX, _MOUSEY), , B
1752.                 END IF
1753.                 _DISPLAY
1754.             LOOP
1755.             RightXend = _MOUSEX
1756.             RightYend = _MOUSEY
1757.  
1758.             'prepocet na souradnice pole:
1759.  
1760.             RxS = _CEIL((RightXstart - 23) / 25) + StartDrawX
1761.             RyS = _CEIL((RightYstart - 18) / 25) + StartDrawy
1762.             RxE = _CEIL((RightXend - 23) / 25) + StartDrawX
1763.             RyE = _CEIL((RightYend - 18) / 25) + StartDrawy
1764.  
1765.             e = 0
1766.             REDIM RightClick(1 TO 9) AS STRING
1767.             RightClick(1) = "Delete all in this area" '                    OK
1768.             RightClick(2) = "Break current texture into this objects" '    OK
1769.             RightClick(3) = "Copy all in this area" '                      OK
1770.             RightClick(4) = "Insert copyed contens to this area" '         OK
1771.             RightClick(5) = "Set WALL/CEILING/FLOOR height in this area"
1772.             RightClick(6) = "Flip textures in this area"
1773.             RightClick(7) = "Delete Objects in this area"
1774.             RightClick(8) = "Delete background sound in this area"
1775.             RightClick(9) = "Add background sound to this area"
1776.  
1777.             DO UNTIL e
1778.                 e = RightClickMenu(RightClick(), _MOUSEX, _MOUSEY)
1779.             LOOP
1780.  
1781.  
1782.             SELECT CASE e
1783.                 CASE -1: Reset_Mouse: EXIT SUB ' aborted
1784.                 CASE 1: Delete_All_in_area RxS, RyS, RxE, RyE
1785.                 CASE 2: Break_Texture_in_area RxS, RyS, RxE, RyE
1786.                 CASE 3: Copy_contens_in_area RxS, RyS, RxE, RyE
1787.                 CASE 4: Insert_contens_in_area RxS, RyS
1788.                 CASE 5: Set_Height_in_area RxS, RyS, RxE, RyE
1789.                 CASE 6: Flip_textures_in_area RxS, RyS, RxE, RyE
1790.                 CASE 7: Delete_Objects_in_area RxS, RyS, RxE, RyE
1791.                 CASE 8: Delete_Sounds_in_area RxS, RyS, RxE, RyE
1792.                 CASE 9: Add_Sound_to_area RxS, RyS, RxE, RyE
1793.  
1794.             END SELECT
1795.         END IF
1796.         '-------------------------------------------------------------------
1797.  
1798.         IF LEN(kbd_agent$) THEN
1799.  
1800.             ' _DELAY .1
1801.             IF memoryzex = 0 THEN memoryzex = _MOUSEX: memoryzey = _MOUSEY
1802.  
1803.             'doplnena podpora z klavesnice pokud je mys v tomto okne
1804.             SELECT CASE kbd_agent$
1805.                 CASE CHR$(0) + CHR$(80) 'dolu
1806.                     IF EndDrawy < UBOUND(grid_img, 2) THEN StartDrawy = StartDrawy + 1: EndDrawy = StartDrawy + 35
1807.  
1808.                 CASE CHR$(0) + CHR$(72) 'nahoru
1809.                     StartDrawy = StartDrawy - 1: EndDrawy = StartDrawy + 35
1810.  
1811.                 CASE CHR$(0) + CHR$(75) ' lft
1812.                     StartDrawX = StartDrawX - 1: EndDrawX = StartDrawX + 36
1813.  
1814.                 CASE CHR$(0) + CHR$(77) 'rght
1815.                     IF EndDrawX < UBOUND(grid_img, 1) THEN StartDrawX = StartDrawX + 1: EndDrawX = StartDrawX + 36
1816.             END SELECT
1817.             _KEYCLEAR
1818.  
1819.  
1820.  
1821.  
1822.             IF _MOUSEX > memoryzex AND EndDrawX < UBOUND(grid_img, 1) THEN StartDrawX = StartDrawX + 1: EndDrawX = StartDrawX + 36 'je to 25 sloupcu?
1823.             IF _MOUSEX < memoryzex THEN StartDrawX = StartDrawX - 1: EndDrawX = StartDrawX + 36 'je to 25 sloupcu?
1824.  
1825.             IF _MOUSEY > memoryzey AND EndDrawy < UBOUND(grid_img, 2) THEN StartDrawy = StartDrawy + 1: EndDrawy = StartDrawy + 35 'je to 15 radku? 'dn
1826.             IF _MOUSEY < memoryzey THEN StartDrawy = StartDrawy - 1: EndDrawy = StartDrawy + 35 'je to 15 radku?                                       'up
1827.  
1828.  
1829.  
1830.  
1831.         ELSE
1832.             memoryzex = 0: memoryzey = 0
1833.         END IF
1834.     END IF
1835.  
1836.     IF StartDrawX > UBOUND(grid_img, 1) THEN StartDrawX = UBOUND(grid_img, 1)
1837.     IF StartDrawX < LBOUND(grid_img, 1) THEN StartDrawX = LBOUND(grid_img, 1)
1838.     IF StartDrawy > UBOUND(grid_img, 2) THEN StartDrawy = UBOUND(grid_img, 2)
1839.     IF StartDrawy < LBOUND(grid_img, 2) THEN StartDrawy = LBOUND(grid_img, 2)
1840.  
1841.     EndDrawX = StartDrawX + 36
1842.     EndDrawy = StartDrawy + 35
1843.  
1844.     IF EndDrawX > UBOUND(grid_img, 1) THEN EndDrawX = UBOUND(grid_img, 1)
1845.     IF EndDrawy > UBOUND(grid_img, 2) THEN EndDrawy = UBOUND(grid_img, 2)
1846.  
1847.  
1848.  
1849.     '  END IF
1850.  
1851.     Px = _CEIL((_MOUSEX - 23) / 25) + StartDrawX
1852.     Py = _CEIL((_MOUSEY - 18) / 25) + StartDrawy
1853.  
1854.     IF Px > UBOUND(Grid_typ, 1) THEN Px = UBOUND(Grid_typ, 1)
1855.     IF Py > UBOUND(Grid_typ, 2) THEN Py = UBOUND(Grid_typ, 2)
1856.  
1857.     _PRINTMODE _FILLBACKGROUND
1858.     _FONT 8
1859.  
1860.     SELECT CASE Grid_typ(Px, Py)
1861.         'upgrade - hodnoty podle typu na miste: 1 = zed, 2 = floor, 3 = ceiling.   12 = zed + floor, 13 = zed + ceiling. 23 = floor + ceiling.  123 = zed, floor, ceiling
1862.         CASE 1: t$ = " Zed, "
1863.         CASE 2: t$ = " Zem, "
1864.         CASE 3: t$ = " Strop, "
1865.         CASE 4: t$ = " Nerotovany objekt, "
1866.         CASE 5: t$ = " Objekt rotovany o " + STR$(rot) + "stupnu, "
1867.         CASE 12: t$ = "Zed a strop, "
1868.         CASE 13: t$ = "Zed a zem, "
1869.         CASE 23: t$ = "Strop a zem, "
1870.         CASE 123: t$ = "Zed, strop a zem, "
1871.     END SELECT
1872.  
1873.     LS = LAYERS_SETUP
1874.  
1875.     IF LAYERS_SETUP = 2 THEN
1876.         IF KEYBOARDAGENT THEN LS = 0 ELSE LS = 1
1877.     END IF
1878.  
1879.  
1880.     FOR dx = StartDrawX TO EndDrawX
1881.         FOR dy = StartDrawy TO EndDrawy
1882.  
1883.             Kx = (dx * 25) + 23 - 25 - (25 * StartDrawX)
1884.             Ky = (dy * 25) + 18 - 25 - (25 * StartDrawy)
1885.  
1886.             IF Kx < 922 AND Ky < 666 THEN
1887.  
1888.                 IF Button(12).active THEN
1889.  
1890.                     Height_From = Img_Height_From
1891.                     Height_To = Img_Height_To
1892.                     Textures_po = Img_Textures_per_Object
1893.                     Texture_Effect = Img_Texture_Effect
1894.  
1895.                     SELECT CASE LS
1896.                         CASE 0
1897.                             IF Grid_img(dx, dy) AND Grid_Floor(dx, dy) OR Grid_img(dx, dy) AND Grid_Ceil(dx, dy) OR Grid_img(dx, dy) AND Grid_Ceil(dx, dy) OR Grid_Floor(dx, dy) AND Grid_Ceil(dx, dy) THEN alfa = 0 ELSE alfa = 50
1898.  
1899.                             IF Grid_Floor(dx, dy) < -1 AND Kx > -2 AND Ky > -7 THEN
1900.                                 _PUTIMAGE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), Grid_Floor(dx, dy)
1901.                                 LINE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), _RGBA32(0, 255, 0, alfa), BF
1902.                             END IF
1903.  
1904.                             IF Grid_Ceil(dx, dy) < -1 AND Kx > -2 AND Ky > -7 THEN
1905.                                 _PUTIMAGE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), Grid_Ceil(dx, dy)
1906.                                 LINE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), _RGBA32(0, 0, 255, alfa), BF
1907.                             END IF
1908.  
1909.                             IF Grid_img(dx, dy) < -1 AND Kx > -2 AND Ky > -7 THEN
1910.                                 _PUTIMAGE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), Grid_img(dx, dy) 'vlozi zdi
1911.                             END IF
1912.  
1913.                         CASE 1
1914.                             IF Grid_img(dx, dy) < -1 AND Kx > -2 AND Ky > -7 THEN
1915.                                 _PUTIMAGE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), Grid_img(dx, dy) 'vlozi zdi
1916.                             END IF
1917.  
1918.                         CASE 3
1919.                             IF Grid_Floor(dx, dy) < -1 AND Kx > -2 AND Ky > -7 THEN
1920.                                 LINE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), _RGBA32(0, 255, 0, 128), BF
1921.                             END IF
1922.  
1923.                             IF Grid_Ceil(dx, dy) < -1 AND Kx > -2 AND Ky > -7 THEN
1924.                                 LINE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), _RGBA32(0, 0, 255, 128), BF
1925.                             END IF
1926.  
1927.                             IF Grid_img(dx, dy) < -1 AND Kx > -2 AND Ky > -7 THEN
1928.                                 LINE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), _RGB32(255, 0, 0), BF
1929.                             END IF
1930.  
1931.                         CASE 4
1932.                             IF Grid_img(dx, dy) < -1 AND Kx > -2 AND Ky > -7 THEN
1933.                                 LINE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), _RGB32(255, 0, 0), BF
1934.                             END IF
1935.                     END SELECT
1936.                 END IF
1937.                 '-----
1938.  
1939.                 IF Button(11).active THEN ' rezim malovani stropu
1940.  
1941.                     Height_From = Ceil_Height_From
1942.                     Height_To = Ceil_Height_To
1943.                     Textures_po = Ceil_Textures_per_Object
1944.                     Texture_Effect = Ceil_Texture_Effect
1945.  
1946.  
1947.                     SELECT CASE LS
1948.                         CASE 0
1949.  
1950.                             IF Grid_img(dx, dy) AND Grid_Floor(dx, dy) OR Grid_img(dx, dy) AND Grid_Ceil(dx, dy) OR Grid_img(dx, dy) AND Grid_Ceil(dx, dy) OR Grid_Floor(dx, dy) AND Grid_Ceil(dx, dy) THEN alfa = 0 ELSE alfa = 20
1951.                             IF Grid_img(dx, dy) < -1 AND Kx > -2 AND Ky > -7 THEN
1952.                                 _PUTIMAGE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), Grid_img(dx, dy) 'vlozi zdi
1953.                                 LINE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), _RGBA32(255, 0, 0, alfa), BF
1954.                             END IF
1955.  
1956.                             IF Grid_Floor(dx, dy) < -1 AND Kx > -2 AND Ky > -7 THEN
1957.                                 _PUTIMAGE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), Grid_Floor(dx, dy) 'vlozeni stropu
1958.                                 LINE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), _RGBA32(0, 0, 255, alfa), BF
1959.                             END IF
1960.  
1961.                             IF Grid_Ceil(dx, dy) < -1 AND Kx > -2 AND Ky > -7 THEN
1962.                                 _PUTIMAGE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), Grid_Ceil(dx, dy) 'vlozeni podlah
1963.                             END IF
1964.                         CASE 1
1965.                             IF Grid_Ceil(dx, dy) < -1 AND Kx > -2 AND Ky > -7 THEN
1966.                                 _PUTIMAGE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), Grid_Ceil(dx, dy) 'vlozeni podlah
1967.                             END IF
1968.                         CASE 3
1969.                             IF Grid_Floor(dx, dy) < -1 AND Kx > -2 AND Ky > -7 THEN
1970.                                 LINE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), _RGBA32(0, 255, 0, 128), BF
1971.                             END IF
1972.  
1973.                             IF Grid_Ceil(dx, dy) < -1 AND Kx > -2 AND Ky > -7 THEN
1974.                                 LINE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), _RGBA32(0, 0, 255, 128), BF
1975.                             END IF
1976.  
1977.                             IF Grid_img(dx, dy) < -1 AND Kx > -2 AND Ky > -7 THEN
1978.                                 LINE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), _RGB32(255, 0, 0), BF
1979.                             END IF
1980.                         CASE 4
1981.                             IF Grid_Ceil(dx, dy) < -1 AND Kx > -2 AND Ky > -7 THEN
1982.                                 LINE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), _RGB(0, 0, 255), BF
1983.                             END IF
1984.                     END SELECT
1985.                 END IF
1986.  
1987.  
1988.                 IF Button(10).active THEN ' podlaha   bottom
1989.  
1990.                     Height_From = Floor_Height_From
1991.                     Height_To = Floor_Height_To
1992.                     Textures_po = Floor_Textures_per_Object
1993.                     Texture_Effect = Floor_Texture_Effect
1994.  
1995.  
1996.                     SELECT CASE LS
1997.                         CASE 0
1998.                             IF Grid_img(dx, dy) AND Grid_Floor(dx, dy) OR Grid_img(dx, dy) AND Grid_Ceil(dx, dy) OR Grid_img(dx, dy) AND Grid_Ceil(dx, dy) OR Grid_Floor(dx, dy) AND Grid_Ceil(dx, dy) THEN alfa = 0 ELSE alfa = 50
1999.  
2000.  
2001.                             IF Grid_img(dx, dy) < -1 AND Kx > -2 AND Ky > -7 THEN
2002.                                 _PUTIMAGE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), Grid_img(dx, dy) 'vlozi zdi
2003.                                 LINE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), _RGBA32(255, 0, 0, alfa), BF
2004.                             END IF
2005.  
2006.  
2007.                             IF Grid_Ceil(dx, dy) < -1 AND Kx > -2 AND Ky > -7 THEN
2008.                                 _PUTIMAGE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), Grid_Ceil(dx, dy) 'vlozeni podlah
2009.                                 LINE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), _RGBA32(0, 255, 0, alfa), BF
2010.                             END IF
2011.  
2012.                             IF Grid_Floor(dx, dy) < -1 AND Kx > -2 AND Ky > -7 THEN
2013.                                 _PUTIMAGE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), Grid_Floor(dx, dy) 'vlozeni stropu
2014.                             END IF
2015.  
2016.  
2017.                         CASE 1
2018.                             IF Grid_Floor(dx, dy) < -1 AND Kx > -2 AND Ky > -7 THEN
2019.                                 _PUTIMAGE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), Grid_Floor(dx, dy) 'vlozeni stropu
2020.                             END IF
2021.  
2022.                         CASE 3
2023.                             IF Grid_Floor(dx, dy) < -1 AND Kx > -2 AND Ky > -7 THEN
2024.                                 LINE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), _RGBA32(0, 255, 0, 128), BF
2025.                             END IF
2026.  
2027.                             IF Grid_Ceil(dx, dy) < -1 AND Kx > -2 AND Ky > -7 THEN
2028.                                 LINE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), _RGBA32(0, 0, 255, 128), BF
2029.                             END IF
2030.  
2031.                             IF Grid_img(dx, dy) < -1 AND Kx > -2 AND Ky > -7 THEN
2032.                                 LINE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), _RGB32(255, 0, 0), BF
2033.                             END IF
2034.                         CASE 4
2035.                             IF Grid_Floor(dx, dy) < -1 AND Kx > -2 AND Ky > -7 THEN
2036.                                 LINE (Kx + 1, Ky + 1)-(Kx + 23, Ky + 23), _RGB(0, 255, 0), BF
2037.                             END IF
2038.                     END SELECT
2039.                 END IF
2040.             END IF
2041.     NEXT dy, dx
2042.  
2043.  
2044.     IF _MOUSEX > 23 AND _MOUSEX < 920 AND _MOUSEY > 18 AND _MOUSEY < 666 THEN
2045.         SHARED OldMouseX, OldMouseY, MemorizeTimer
2046.  
2047.  
2048.         REDIM Info_Array(1 TO 12) AS STRING
2049.         Info_Array(1) = "texture nr:" + IS_Record(Px, Py) + " object type: " + t$
2050.  
2051.         IF Texture_Effect > 0 THEN TextureEfect$ = STR$(Texture_Effect) ELSE TextureEfect$ = "NONE"
2052.  
2053.  
2054.         IMG_H_F$ = STR$(IP_Img(Px, Py).Height_From)
2055.         IMG_H_T$ = STR$(IP_Img(Px, Py).Height_To)
2056.         IF IP_Img(Px, Py).Height_From = IP_Img(Px, Py).Height_To THEN IMG_H_F$ = "UNUSED": IMG_H_T$ = "UNUSED"
2057.  
2058.         CEIL_H_F$ = STR$(IP_Ceil(Px, Py).Height_From)
2059.         CEIL_H_T$ = STR$(IP_Ceil(Px, Py).Height_To)
2060.  
2061.         FLOOR_H_F$ = STR$(IP_Floor(Px, Py).Height_From)
2062.         FLOOR_H_T$ = STR$(IP_Floor(Px, Py).Height_To)
2063.  
2064.  
2065.  
2066.         Info_Array(2) = "WALL height from:" + IMG_H_F$ + " height to:" + IMG_H_T$
2067.         Info_Array(3) = "CEILING height from:" + CEIL_H_F$ + " height to:" + CEIL_H_T$
2068.         Info_Array(4) = "FLOOR height from:" + FLOOR_H_F$ + " height to:" + FLOOR_H_T$
2069.  
2070.         Info_Array(5) = "total place 1 texture over" + STR$(Textures_po) + " objects"
2071.         Info_Array(6) = "applied effect to texture: " + TextureEfect$
2072.         Info_Array(7) = "----------------------------------"
2073.         Info_Array(8) = "actual settings:"
2074.         Info_Array(9) = "----------------------------------"
2075.         Info_Array(10) = "WALL height from: " + STR$(Img_Height_From) + " to:" + STR$(Img_Height_To)
2076.         Info_Array(11) = "FLOOR height from: " + STR$(Floor_Height_From) + " to:" + STR$(Floor_Height_To)
2077.         Info_Array(12) = "CEILING height from: " + STR$(Ceil_Height_From) + " to:" + STR$(Ceil_Height_To)
2078.  
2079.  
2080.         IF OldMouseX <> _MOUSEX OR OldMouseY <> _MOUSEY THEN OldMouseX = _MOUSEX: OldMouseY = _MOUSEY
2081.  
2082.         IF _MOUSEINPUT THEN MemorizeTimer = TIMER
2083.         IF TIMER > MemorizeTimer + GridCommentsTime AND GridShowComments THEN
2084.             COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 0)
2085.             IF LEN(t$) > 0 THEN Comment_Window Info_Array$(), _MOUSEX, _MOUSEY
2086.             COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
2087.         END IF
2088.  
2089.         IF _MOUSEBUTTON(1) AND TextureIN THEN
2090.             SELECT CASE DRAW_MOUSE_SETUP
2091.                 CASE 0
2092.                     IF Button(12).active THEN atyp = 1 'wall
2093.                     IF Button(11).active THEN atyp = 2 'ceiling
2094.                     IF Button(10).active THEN atyp = 3 'floor
2095.  
2096.                     SELECT CASE atyp
2097.                         CASE 1:
2098.                             Grid_img(Px, Py) = TextureIN: Grid_Ceil(Px, Py) = 0: Grid_Floor(Px, Py) = 0
2099.                             IP_Img(Px, Py).Height_From = Img_Height_From
2100.                             IP_Img(Px, Py).Height_To = Img_Height_To
2101.                             IP_Img(Px, Py).TexturesPerObject = Img_Textures_per_Object
2102.                             IP_Img(Px, Py).TextureEffect = Img_Texture_Effect
2103.  
2104.                         CASE 2:
2105.                             Grid_Ceil(Px, Py) = TextureIN: Grid_img(Px, Py) = 0
2106.                             IP_Ceil(Px, Py).Height_From = Ceil_Height_From
2107.                             IP_Ceil(Px, Py).Height_To = Ceil_Height_To
2108.                             IP_Ceil(Px, Py).TexturesPerObject = Ceil_Textures_per_Object
2109.                             IP_Ceil(Px, Py).TextureEffect = Ceil_Texture_Effect
2110.  
2111.                         CASE 3:
2112.                             Grid_Floor(Px, Py) = TextureIN: Grid_img(Px, Py) = 0
2113.                             IP_Floor(Px, Py).Height_From = Floor_Height_From
2114.                             IP_Floor(Px, Py).Height_To = Floor_Height_To
2115.                             IP_Floor(Px, Py).TexturesPerObject = Floor_Textures_per_Object
2116.                             IP_Floor(Px, Py).TextureEffect = Floor_Texture_Effect
2117.  
2118.                     END SELECT
2119.  
2120.                     Grid_typ(Px, Py) = WHOIS(Px, Py) 'atyp
2121.  
2122.                 CASE 1
2123.  
2124.                     startX = _MOUSEX
2125.                     startY = _MOUSEY
2126.                     startpX = Px
2127.                     startpY = Py
2128.                     writeit = 0
2129.                     DO UNTIL _MOUSEBUTTON(1) = 0
2130.                         writeit = 1
2131.                         WHILE _MOUSEINPUT: WEND
2132.                         IF _MOUSEX > 23 AND _MOUSEX < 920 AND _MOUSEY > 18 AND _MOUSEY < 666 THEN
2133.                             EndPX = _CEIL((_MOUSEX - 23) / 25) + StartDrawX
2134.                             EndPY = _CEIL((_MOUSEY - 18) / 25) + StartDrawy
2135.  
2136.                             PCOPY 10, _DISPLAY
2137.                             IF TextureIN < -1 THEN LINE (startX, startY)-(_MOUSEX, _MOUSEY), _RGB32(255, 255, 255), B
2138.                         END IF
2139.                         _DISPLAY
2140.                     LOOP
2141.  
2142.                     IF Button(12).active THEN atyp = 1 'wall
2143.                     IF Button(11).active THEN atyp = 2 'ceiling
2144.                     IF Button(10).active THEN atyp = 3 'floor
2145.  
2146.                     IF startpX > EndPX THEN SWAP startpX, EndPX
2147.                     IF startpY > EndPY THEN SWAP startpY, EndPY
2148.  
2149.  
2150.                     IF writeit THEN
2151.                         FOR ipy = startpY TO EndPY
2152.                             FOR ipx = startpX TO EndPX
2153.  
2154.                                 SELECT CASE atyp
2155.                                     CASE 1:
2156.                                         Grid_img(ipx, ipy) = TextureIN: Grid_Ceil(ipx, ipy) = 0: Grid_Floor(ipx, ipy) = 0
2157.                                         IP_Img(ipx, ipy).Height_From = Img_Height_From
2158.                                         IP_Img(ipx, ipy).Height_To = Img_Height_To
2159.                                         IP_Img(ipx, ipy).TexturesPerObject = Img_Textures_per_Object
2160.                                         IP_Img(ipx, ipy).TextureEffect = Img_Texture_Effect
2161.  
2162.                                     CASE 2:
2163.                                         Grid_Ceil(ipx, ipy) = TextureIN: Grid_img(ipx, ipy) = 0
2164.                                         IP_Ceil(ipx, ipy).Height_From = Ceil_Height_From
2165.                                         IP_Ceil(ipx, ipy).Height_To = Ceil_Height_To
2166.                                         IP_Ceil(ipx, ipy).TexturesPerObject = Ceil_Textures_per_Object
2167.                                         IP_Ceil(ipx, ipy).TextureEffect = Ceil_Texture_Effect
2168.  
2169.                                     CASE 3:
2170.                                         Grid_Floor(ipx, ipy) = TextureIN: Grid_img(ipx, ipy) = 0
2171.                                         IP_Floor(ipx, ipy).Height_From = Floor_Height_From
2172.                                         IP_Floor(ipx, ipy).Height_To = Floor_Height_To
2173.                                         IP_Floor(ipx, ipy).TexturesPerObject = Floor_Textures_per_Object
2174.                                         IP_Floor(ipx, ipy).TextureEffect = Floor_Texture_Effect
2175.                                 END SELECT
2176.  
2177.                                 Grid_typ(ipx, ipy) = WHOIS(ipx, ipy) 'atyp
2178.                         NEXT ipx, ipy
2179.                     END IF
2180.             END SELECT
2181.         END IF
2182.  
2183.         IF _MOUSEBUTTON(3) THEN
2184.             IF Button(12).active THEN Grid_img(Px, Py) = 0: Grid_typ(Px, Py) = WHOIS(Px, Py)
2185.             IF Button(11).active THEN Grid_Ceil(Px, Py) = 0: Grid_typ(Px, Py) = WHOIS(Px, Py)
2186.             IF Button(10).active THEN Grid_Floor(Px, Py) = 0: Grid_typ(Px, Py) = WHOIS(Px, Py)
2187.         END IF
2188.     END IF
2189.  
2190.     IF _MOUSEX < 23 OR _MOUSEX > 920 OR _MOUSEY < 18 OR _MOUSEY > 666 THEN
2191.     END IF
2192. END SUB
2193.  
2194.  
2195. SUB Flip_textures_in_area (rxs AS INTEGER, rys AS INTEGER, rxe AS INTEGER, rye AS INTEGER) 'zatim funkcni jen pro styly 1,2,3
2196.  
2197.     PCOPY 0, 10
2198.  
2199.     REDIM styles(1 TO 3) AS STRING
2200.     styles(1) = "Flip in X axis"
2201.     styles(2) = "Flip in Y axis"
2202.     styles(3) = "Flip on 180 degrees"
2203.  
2204.     Reset_Mouse
2205.     DO UNTIL style > 0
2206.         style = RightClickMenu(styles(), _MOUSEX, _MOUSEY)
2207.     LOOP
2208.     COLOR _RGB32(255), _RGB32(70)
2209.  
2210.  
2211.     REDIM SWP(rxs TO rxe, rys TO rye) AS LONG
2212.  
2213.     IF Button(12).active THEN Atyp = 1 'wall
2214.     IF Button(11).active THEN Atyp = 2 'ceiling
2215.     IF Button(10).active THEN Atyp = 3 'floor
2216.  
2217.     FOR y = rys TO rye
2218.         FOR x = rxs TO rxe
2219.             SELECT CASE Atyp
2220.                 CASE 3: image = Grid_Floor(x, y)
2221.                 CASE 2: image = Grid_Ceil(x, y)
2222.                 CASE 1: image = Grid_img(x, y)
2223.             END SELECT
2224.  
2225.  
2226.             IF image < -1 AND style > 0 THEN
2227.                 W = _WIDTH(image) - 1: H = _HEIGHT(image) - 1
2228.                 IF style > 3 THEN SWAP W, H
2229.  
2230.                 ROTO90 = _NEWIMAGE(W + 1, H + 1, 32)
2231.                 SELECT CASE style
2232.                     CASE 0:
2233.                         _PUTIMAGE , image, ROTO90
2234.                     CASE 1:
2235.                         _PUTIMAGE , image, ROTO90, (W, 0)-(0, H)
2236.                     CASE 2:
2237.                         _PUTIMAGE , image, ROTO90, (0, H)-(W, 0)
2238.                     CASE 3:
2239.                         _PUTIMAGE , image, ROTO90, (W, H)-(0, 0)
2240.  
2241.                     CASE 4:
2242.                         imag = MEM_ROTO_90(image)
2243.                         _PUTIMAGE , imag, ROTO90
2244.                         _FREEIMAGE imag
2245.  
2246.                     CASE 5:
2247.                         imag = MEM_ROTO_90(image)
2248.                         _PUTIMAGE , imag, ROTO90, (0, H)-(W, 0)
2249.                         _FREEIMAGE imag
2250.  
2251.                     CASE 6:
2252.                         imag = MEM_ROTO_90(image)
2253.                         _PUTIMAGE , imag, ROTO90, (W, 0)-(0, H)
2254.                         _FREEIMAGE imag
2255.  
2256.  
2257.                     CASE 7:
2258.                         imag = MEM_ROTO_90(image)
2259.                         _PUTIMAGE , imag, ROTO90, (W, H)-(0, 0)
2260.                         _FREEIMAGE imag
2261.                 END SELECT
2262.  
2263.                 SWP(x, y) = _COPYIMAGE(ROTO90, 32) ' ELSE SWP(y, x) = _COPYIMAGE(ROTO90, 32)
2264.                 _FREEIMAGE ROTO90
2265.             END IF
2266.         NEXT x
2267.     NEXT y
2268.  
2269.  
2270.     SELECT CASE style
2271.         CASE 1
2272.             SELECT CASE Atyp
2273.                 CASE 1
2274.                     FOR y = rys TO rye
2275.                         cx = rxe
2276.                         FOR x = rxs TO rxe
2277.                             Grid_img(cx, y) = SWP(x, y)
2278.                             Grid_typ(cx, y) = WHOIS(cx, y)
2279.                             cx = cx - 1
2280.                         NEXT x
2281.                     NEXT y
2282.                     ERASE SWP
2283.  
2284.                 CASE 2
2285.                     FOR y = rys TO rye
2286.                         cx = rxe
2287.                         FOR x = rxs TO rxe
2288.                             Grid_Ceil(cx, y) = SWP(x, y)
2289.                             Grid_typ(cx, y) = WHOIS(cx, y)
2290.                             cx = cx - 1
2291.                         NEXT x
2292.                     NEXT y
2293.                     ERASE SWP
2294.  
2295.                 CASE 3
2296.                     FOR y = rys TO rye
2297.                         cx = rxe
2298.                         FOR x = rxs TO rxe
2299.                             Grid_Floor(cx, y) = SWP(x, y)
2300.                             Grid_typ(cx, y) = WHOIS(cx, y)
2301.                             cx = cx - 1
2302.                         NEXT x
2303.                     NEXT y
2304.                     ERASE SWP
2305.             END SELECT
2306.  
2307.  
2308.         CASE 2
2309.             SELECT CASE Atyp
2310.                 CASE 1
2311.                     cy = rye
2312.                     FOR y = rys TO rye
2313.                         FOR x = rxs TO rxe
2314.                             Grid_img(x, cy) = SWP(x, y)
2315.                             Grid_typ(x, cy) = WHOIS(x, cy)
2316.                         NEXT x
2317.                         cy = cy - 1
2318.                     NEXT y
2319.                     ERASE SWP
2320.  
2321.                 CASE 2
2322.                     cy = rye
2323.                     FOR y = rys TO rye
2324.                         FOR x = rxs TO rxe
2325.                             Grid_Ceil(x, cy) = SWP(x, y)
2326.                             Grid_typ(x, cy) = WHOIS(x, cy)
2327.                         NEXT x
2328.                         cy = cy - 1
2329.                     NEXT y
2330.                     ERASE SWP
2331.  
2332.                 CASE 3
2333.                     cy = rye
2334.                     FOR y = rys TO rye
2335.                         FOR x = rxs TO rxe
2336.                             Grid_Floor(x, cy) = SWP(x, y)
2337.                             Grid_typ(x, cy) = WHOIS(x, cy)
2338.                         NEXT x
2339.                         cy = cy - 1
2340.                     NEXT y
2341.                     ERASE SWP
2342.             END SELECT
2343.  
2344.  
2345.         CASE 3
2346.             SELECT CASE Atyp
2347.                 CASE 1
2348.                     cy = rye
2349.                     FOR y = rys TO rye
2350.                         cx = rxe
2351.                         FOR x = rxs TO rxe
2352.  
2353.                             Grid_img(cx, cy) = SWP(x, y)
2354.                             Grid_typ(cx, cy) = WHOIS(cx, cy)
2355.                             cx = cx - 1
2356.                         NEXT x
2357.                         cy = cy - 1
2358.                     NEXT y
2359.                     ERASE SWP
2360.  
2361.                 CASE 2
2362.  
2363.                     cy = rye
2364.                     FOR y = rys TO rye
2365.                         cx = rxe
2366.                         FOR x = rxs TO rxe
2367.  
2368.                             Grid_Ceil(cx, cy) = SWP(x, y)
2369.                             Grid_typ(cx, cy) = WHOIS(cx, cy)
2370.                             cx = cx - 1
2371.                         NEXT x
2372.                         cy = cy - 1
2373.                     NEXT y
2374.                     ERASE SWP
2375.  
2376.                 CASE 3
2377.                     cy = rye
2378.                     FOR y = rys TO rye
2379.                         cx = rxe
2380.                         FOR x = rxs TO rxe
2381.                             Grid_Floor(cx, cy) = SWP(x, y)
2382.                             Grid_typ(cx, cy) = WHOIS(cx, cy)
2383.                             cx = cx - 1
2384.                         NEXT x
2385.                         cy = cy - 1
2386.                     NEXT y
2387.                     ERASE SWP
2388.             END SELECT
2389.  
2390.  
2391.         CASE 4 'rotace o 90 stupnu - jen opis
2392.  
2393.             SELECT CASE Atyp
2394.                 CASE 1
2395.                     cy = rye
2396.                     REDIM SWP2(rxs TO rxe, rys TO rye) AS LONG
2397.                     FOR y = rys TO rye
2398.                         cx = rxe
2399.                         FOR x = rxs TO rxe
2400.                             SWP2(cx, y) = SWP(x, y)
2401.                             cx = cx - 1
2402.                         NEXT x
2403.                         cy = cy - 1
2404.                     NEXT y
2405.                     ERASE SWP
2406.  
2407.                     wx = rxs
2408.                     wy = rys
2409.  
2410.                     FOR y = rys TO rye
2411.                         FOR x = rxs TO rxe
2412.                             Grid_img(wx, wy) = SWP2(x, y)
2413.  
2414.                             'tento blocek mi trval 2 dny...
2415.                             IF rxe - rxs <> rye - rys THEN
2416.                                 wy = wy + 1: IF wy > rxe THEN wy = rxs: wx = wx + 1
2417.                             ELSE
2418.                                 wy = wy + 1: IF wy > rye THEN wy = rys: wx = wx + 1
2419.                             END IF
2420.                             '///////////////////////////////
2421.  
2422.                             ' IF wx > rye THEN wx = rys
2423.                         NEXT x
2424.                     NEXT y
2425.                     ERASE SWP2
2426.  
2427.                 CASE 2
2428.                     FOR y = rys TO rye
2429.                         FOR x = rxs TO rxe
2430.                             Grid_Ceil(x, y) = SWP(x, y)
2431.                             Grid_typ(x, y) = WHOIS(x, y)
2432.                         NEXT x
2433.                     NEXT y
2434.                     ERASE SWP
2435.  
2436.                 CASE 3
2437.                     FOR y = rys TO rye
2438.                         FOR x = rxs TO rxe
2439.                             Grid_Floor(x, y) = SWP(x, y)
2440.                             Grid_typ(x, y) = WHOIS(x, y)
2441.                         NEXT x
2442.                     NEXT y
2443.                     ERASE SWP
2444.             END SELECT
2445.     END SELECT
2446. END SUB
2447.  
2448. FUNCTION MEM_ROTO_90 (img AS LONG)
2449.     DIM W AS LONG, H AS LONG
2450.     W = _WIDTH(img)
2451.     H = _HEIGHT(img)
2452.     MEM_ROTO_90 = _NEWIMAGE(H, W, 32)
2453.     DIM m AS _MEM, m2 AS _MEM, m3 AS _MEM, k AS _UNSIGNED LONG, k3 AS _UNSIGNED LONG, X AS LONG, Y AS LONG, R AS _UNSIGNED _BYTE, G AS _UNSIGNED _BYTE, B AS _UNSIGNED _BYTE, A AS _UNSIGNED _BYTE, nR AS _UNSIGNED _BYTE, nG AS _UNSIGNED _BYTE, nB AS _UNSIGNED _BYTE
2454.     m = _MEMIMAGE(img)
2455.     m2 = _MEMIMAGE(MEM_ROTO_90)
2456.     '  m3 = _MEMIMAGE(0)
2457.     FOR Y = 0 TO H - 1
2458.         FOR X = W - 1 TO 1 STEP -1
2459.             _MEMGET m, m.OFFSET + (4 * (W - X + _WIDTH(img) * Y)), k
2460.             '         _MEMGET m3, m3.OFFSET + (4 * (W - X + _WIDTH(img) * Y)), k3
2461.  
2462.             R = _RED32(k)
2463.             G = _GREEN32(k)
2464.             B = _BLUE32(k)
2465.             A = _ALPHA32(k)
2466.             nA = A / 2.55
2467.  
2468.             R3 = _RED32(k3)
2469.             G3 = _GREEN32(k3)
2470.             B3 = _BLUE32(k3)
2471.  
2472.             nR = NColor(R3, R, nA)
2473.             nG = NColor(G3, G, nA)
2474.             nB = NColor(B3, B, nA)
2475.  
2476.             k = _RGBA32(nR, nG, nB, 255)
2477.  
2478.             _MEMPUT m2, m2.OFFSET + (4 * (Y + _WIDTH(MEM_ROTO_90) * X)), k
2479.     NEXT X, Y
2480.     _MEMFREE m
2481.     _MEMFREE m2
2482.     '  _MEMFREE m3
2483. END FUNCTION
2484.  
2485. FUNCTION NColor~& (Background AS _UNSIGNED _BYTE, Foreground AS _UNSIGNED _BYTE, Alpha AS SINGLE)
2486.     NColor = Background - ((Background - Foreground) / 100) * Alpha
2487. END FUNCTION
2488.  
2489.  
2490. SUB Delete_All_in_area (sX AS INTEGER, sY AS INTEGER, eX AS INTEGER, eY AS INTEGER) 'smaze uplne vsechno v dane oblasti
2491.     IF eY < sY THEN SWAP sY, eY
2492.     IF eX < sX THEN SWAP sX, eX
2493.  
2494.     FOR Ky = sY TO eY
2495.         FOR Kx = sX TO eX
2496.             IP_Img(Kx, Ky).Height_From = 0
2497.             IP_Img(Kx, Ky).Height_To = 0
2498.             IP_Floor(Kx, Ky).Height_From = 0
2499.             IP_Floor(Kx, Ky).Height_To = 0
2500.             IP_Ceil(Kx, Ky).Height_From = 0
2501.             IP_Ceil(Kx, Ky).Height_To = 0
2502.  
2503.             Grid_img(Kx, Ky) = 0
2504.             Grid_Ceil(Kx, Ky) = 0
2505.             Grid_Floor(Kx, Ky) = 0
2506.             Grid_typ(Kx, Ky) = 0
2507.             Grid_Obj(Kx, Ky) = 0
2508.     NEXT Kx, Ky
2509. END SUB
2510.  
2511.  
2512. SUB Set_Height_in_area (rxs AS INTEGER, rys AS INTEGER, rxe AS INTEGER, rye AS INTEGER) 'zmeni zaznam v polich IP, bez ohledu na zvoleny rezim, proste podle tveho nastaveni v tomto SUB
2513.  
2514.     PCOPY 10, _DISPLAY
2515.     COLOR _RGB32(255)
2516.     LINE (198, 200)-(522, 568), _RGB32(70, 70, 70), BF
2517.     LINE (198, 200)-(522, 568), _RGB32(155, 155, 155), B
2518.     LINE (200, 202)-(520, 566), _RGB32(155, 155, 155), B
2519.     _FONT 8
2520.     _PRINTMODE _KEEPBACKGROUND
2521.     _PRINTSTRING (290, 205), "BLOCK Height Setup"
2522.     LINE (200, 215)-(520, 215), _RGB32(155, 155, 155)
2523.     DvojSipka = _LOADIMAGE("ico/dvojsipka.bmp", 32)
2524.     _CLEARCOLOR _RGB32(255, 255, 255), DvojSipka
2525.     PCOPY _DISPLAY, 9
2526.     OldRoto = rotos
2527.  
2528.     BLOCK_Img_Textures_per_Object = Img_Textures_per_Object
2529.     BLOCK_Img_Height_From = Img_Height_From
2530.     BLOCK_Img_Height_To = Img_Height_To
2531.     BLOCK_Floor_Height_From = Floor_Height_From
2532.     BLOCK_Floor_Height_To = Floor_Height_To
2533.     BLOCK_Ceil_Height_From = Ceil_Height_From
2534.     BLOCK_Ceil_Height_To = Ceil_Height_To
2535.  
2536.     oke = LOADICO("ico/oke.ico", 1)
2537.     bck = LOADICO("ico/ko.ico", 1)
2538.     _CLEARCOLOR 0, oke
2539.     _CLEARCOLOR 0, bck
2540.  
2541.     DO
2542.         PCOPY 9, _DISPLAY
2543.         WHILE _MOUSEINPUT: WEND
2544.         '-------------------------------------------------------------------------------------------------
2545.         'nastavovaci veticka pro nastaveni vysky zdi od do
2546.         _PRINTSTRING (230, 263), "Set WALL height from: " + LTRIM$(STR$(BLOCK_Img_Height_From))
2547.         _PRINTSTRING (230, 293), "Set WALL height to: " + LTRIM$(STR$(BLOCK_Img_Height_To))
2548.         _PUTIMAGE (450, 250), DvojSipka: _PUTIMAGE (450, 280), DvojSipka
2549.  
2550.  
2551.         'nastavovaci veticka pro nastaveni vysky zeme od do
2552.         _PRINTSTRING (230, 323), "Set FLOOR height from: " + LTRIM$(STR$(BLOCK_Floor_Height_From))
2553.         _PRINTSTRING (230, 353), "Set FLOOR height to: " + LTRIM$(STR$(BLOCK_Floor_Height_To))
2554.         _PUTIMAGE (450, 310), DvojSipka: _PUTIMAGE (450, 340), DvojSipka
2555.  
2556.  
2557.         'nastavovaci veticka pro nastaveni vysky stropu od do
2558.         _PRINTSTRING (230, 383), "Set CEILING height from: " + LTRIM$(STR$(BLOCK_Ceil_Height_From))
2559.         _PRINTSTRING (230, 413), "Set CEILING height to: " + LTRIM$(STR$(BLOCK_Ceil_Height_To))
2560.         _PUTIMAGE (450, 370), DvojSipka: _PUTIMAGE (450, 400), DvojSipka
2561.         COLOR _RGB32(255, 0, 0)
2562.         _PRINTSTRING (230, 450), "WALL coordinates only are used"
2563.         _PRINTSTRING (250, 460), "for collision detections!"
2564.         COLOR _RGB32(255)
2565.  
2566.         BLOCK_Img_Textures_per_Object = BLOCK_Img_Textures_per_Object + DoubleArrow(450, 220)
2567.         BLOCK_Img_Height_From = BLOCK_Img_Height_From + DoubleArrow(450, 250)
2568.         BLOCK_Img_Height_To = BLOCK_Img_Height_To + DoubleArrow(450, 280)
2569.         BLOCK_Floor_Height_From = BLOCK_Floor_Height_From + DoubleArrow(450, 310)
2570.         BLOCK_Floor_Height_To = BLOCK_Floor_Height_To + DoubleArrow(450, 340)
2571.         BLOCK_Ceil_Height_From = BLOCK_Ceil_Height_From + DoubleArrow(450, 370)
2572.         BLOCK_Ceil_Height_To = BLOCK_Ceil_Height_To + DoubleArrow(450, 400)
2573.  
2574.         LINE (230, 500)-(315, 530), _RGB32(255, 255, 255), B
2575.         _PUTIMAGE (230, 500), oke
2576.         _PRINTSTRING (263, 513), "Done"
2577.         IF ONPOS(_MOUSEX, _MOUSEY, 230, 500, 315, 530) THEN LINE (230, 500)-(315, 530), _RGBA32(170, 170, 170, 60), BF: IF _MOUSEBUTTON(1) THEN ok = 1 'OK
2578.  
2579.  
2580.         LINE (400, 500)-(485, 530), _RGB32(255, 255, 255), B
2581.         _PUTIMAGE (400, 500), bck
2582.         _PRINTSTRING (433, 513), "Back"
2583.         IF ONPOS(_MOUSEX, _MOUSEY, 400, 500, 485, 530) THEN LINE (400, 500)-(485, 530), _RGBA32(170, 170, 170, 60), BF: IF _MOUSEBUTTON(1) THEN EXIT SUB
2584.         _DISPLAY
2585.     LOOP UNTIL ok
2586.  
2587.     FOR y = rys TO rye
2588.         FOR x = rxs TO rxe
2589.             IP_Ceil(x, y).Height_From = BLOCK_Ceil_Height_From
2590.             IP_Ceil(x, y).Height_To = BLOCK_Ceil_Height_To
2591.             IP_Floor(x, y).Height_From = BLOCK_Floor_Height_From
2592.             IP_Floor(x, y).Height_To = BLOCK_Floor_Height_To
2593.             IP_Img(x, y).Height_From = BLOCK_Img_Height_From
2594.             IP_Img(x, y).Height_To = BLOCK_Img_Height_To
2595.     NEXT x, y
2596.     _FREEIMAGE oke
2597.     _FREEIMAGE bck
2598. END SUB
2599.  
2600. SUB Break_Texture_in_area (Sx AS INTEGER, Sy AS INTEGER, Ex AS INTEGER, Ey AS INTEGER) 'vezme aktualni texturu, rozlozi ji na patricny pocet dilu, ulozi jako PNG a ty vlozi jako novou texturu a umisti do pole
2601.     '                          X - start       Y - start       X - end        Y - end
2602.     _AUTODISPLAY
2603.     IF Ey < Sy THEN SWAP Ey, Sy
2604.     IF Ex < Sx THEN SWAP Ex, Sx
2605.  
2606.     '    PRINT Sx, Sy, Ex, Ey
2607.     '    SLEEP
2608.     IF TextureIN > -2 THEN EXIT SUB
2609.     'as LINE:                  (X start, Y start)      -         (X end, Y end)
2610.  
2611.     IF Ex = Sx THEN divideX = 1 ELSE divideX = (Ex - Sx) + 1
2612.     IF Ey = Sy THEN divideY = 1 ELSE divideY = (Ey - Sy) + 1
2613.  
2614.  
2615.     NewWidth = _WIDTH(TextureIN)
2616.     NewHeight = _HEIGHT(TextureIN)
2617.  
2618.     DO UNTIL NewWidth MOD divideX = 0
2619.         NewWidth = NewWidth + 1
2620.     LOOP
2621.  
2622.     DO UNTIL NewHeight MOD divideY = 0
2623.         NewHeight = NewHeight + 1
2624.     LOOP
2625.  
2626.     Stexture = _NEWIMAGE(NewWidth, NewHeight, 32)
2627.     _PUTIMAGE , TextureIN, Stexture
2628.  
2629.     width = NewWidth \ divideX
2630.     height = NewHeight \ divideY
2631.  
2632.     DIM u AS LONG, StartTexture AS LONG
2633.     u = UBOUND(texture) + 1
2634.     oldu = u
2635.     '    PRINT width, height: SLEEP
2636.  
2637.  
2638.     FOR y = 1 TO NewHeight - 1 STEP height
2639.         FOR x = 1 TO NewWidth - 1 STEP width
2640.             newTexture& = _NEWIMAGE(width, height, 32)
2641.             _PUTIMAGE (0, 0)-(width - 1, height - 1), Stexture, newTexture&, (x, y)-(x + width - 1, y + height - 1)
2642.             REDIM _PRESERVE Texture(u) AS Texture
2643.             Texture(u).path = GET_NEW_TEXTURE_NAME
2644.             Texture(u).img = newTexture&
2645.             res = SaveImage(Texture(u).path, newTexture&, 0, 0, _WIDTH(newTexture&) - 1, _HEIGHT(newTexture&) - 1)
2646.             u = u + 1
2647.     NEXT x, y
2648.  
2649.     IF Button(12).active THEN Atyp = 1 'wall
2650.     IF Button(11).active THEN Atyp = 2 'ceiling
2651.     IF Button(10).active THEN Atyp = 3 'floor
2652.  
2653.     StartTexture = oldu
2654.  
2655.     x = 0: y = 0
2656.  
2657.     FOR y = Sy TO Ey
2658.         FOR x = Sx TO Ex
2659.  
2660.             SELECT CASE Atyp
2661.  
2662.                 CASE 1: Grid_img(x, y) = Texture(StartTexture + c).img
2663.                 CASE 2: Grid_Ceil(x, y) = Texture(StartTexture + c).img
2664.                 CASE 3: Grid_Floor(x, y) = Texture(StartTexture + c).img
2665.             END SELECT
2666.             Grid_typ(x, y) = WHOIS(x, y)
2667.             StartTexture = StartTexture + 1
2668.     NEXT x, y
2669.     _FREEIMAGE Stexture
2670.     Reset_Mouse
2671. END SUB
2672.  
2673.  
2674. FUNCTION IS_Record$ (r1 AS LONG, r2 AS LONG)
2675.     REDIM a AS LONG
2676.     IS_Record$ = ""
2677.  
2678.  
2679.     FOR a = LBOUND(Texture) TO UBOUND(Texture)
2680.         IF Button(12).active THEN
2681.             IF Texture(a).img = Grid_img(r1, r2) THEN IS_Record$ = STR$(a)
2682.         END IF
2683.         IF Button(11).active THEN
2684.             IF Texture(a).img = Grid_Ceil(r1, r2) THEN IS_Record$ = STR$(a)
2685.         END IF
2686.         IF Button(10).active THEN
2687.             IF Texture(a).img = Grid_Floor(r1, r2) THEN IS_Record$ = STR$(a)
2688.         END IF
2689.     NEXT a
2690. END FUNCTION
2691.  
2692.  
2693. FUNCTION Place_Buttons
2694.  
2695.     IF DIALOG = 0 THEN ub = UBOUND(button) - 2: us = LBOUND(button) + 1 ELSE ub = UBOUND(button): us = UBOUND(button) - 1
2696.     IF DIALOG = 2 THEN ub = 0: us = 0
2697.     FOR p = us TO ub
2698.         IF _MOUSEX > Button(p).x AND _MOUSEX < Button(p).x + 52 AND _MOUSEY > Button(p).y AND _MOUSEY < Button(p).y + 33 THEN
2699.             IF _MOUSEBUTTON(1) = 0 THEN
2700.                 _PUTIMAGE (Button(p).x, Button(p).y), Button(p).imgA
2701.             ELSE
2702.                 _PUTIMAGE (Button(p).x + 1, Button(p).y + 1), Button(p).imgA
2703.                 Place_Buttons = p
2704.             END IF
2705.         ELSE
2706.             IF Button(p).active = 0 THEN _PUTIMAGE (Button(p).x, Button(p).y), Button(p).imgB
2707.         END IF
2708.  
2709.         IF Button(p).active = 1 THEN _PUTIMAGE (Button(p).x, Button(p).y), Button(p).imgA
2710.     NEXT p
2711. END FUNCTION
2712.  
2713. SUB Create_Buttons
2714.     SHARED font
2715.     path$ = ENVIRON$("SYSTEMROOT") + "\fonts\arial.ttf"
2716.     IF _FILEEXISTS(path$) = 0 THEN path$ = "arial.ttf"
2717.     font = _LOADFONT(path$, 9, "BOLD")
2718.     prd = _DEST
2719.     oldfont = _FONT
2720.  
2721.     FOR c = LBOUND(button) TO UBOUND(button)
2722.  
2723.         m = INSTR(1, LTRIM$(RTRIM$(Button(c).text)), CHR$(32))
2724.         D = LEN(LTRIM$(RTRIM$(Button(c).text)))
2725.         IF m AND D >= 6 THEN
2726.             text1$ = LEFT$(Button(c).text, m)
2727.             text2$ = RIGHT$(RTRIM$(Button(c).text), D - m)
2728.  
2729.             x1 = 8 + (40 / LEN(text1$))
2730.             x2 = 8 + (40 / LEN(text2$))
2731.             y1 = 10
2732.             y2 = 20
2733.         ELSE
2734.             text1$ = RTRIM$(Button(c).text)
2735.             x1 = 8 + (40 / LEN(text1$))
2736.             y1 = 15
2737.             x2 = 0: y2 = 0: text2$ = ""
2738.         END IF
2739.  
2740.  
2741.         Button(c).imgA = _NEWIMAGE(52, 33, 32)
2742.         _DEST Button(c).imgA
2743.         _FONT font
2744.         LINE (7, 7)-(49, 29), _RGB32(227, 227, 127), B
2745.         LINE (8, 8)-(48, 28), _RGB32(127, 127, 127), BF
2746.         _PRINTMODE _KEEPBACKGROUND
2747.         _PRINTSTRING (x1, y1), text1$
2748.         IF LEN(text2$) THEN _PRINTSTRING (x2, y2), text2$
2749.  
2750.         Button(c).imgB = _NEWIMAGE(52, 33, 32)
2751.         _DEST Button(c).imgB
2752.         _FONT font
2753.         LINE (7, 7)-(49, 29), _RGB32(137, 137, 137), B
2754.         LINE (8, 8)-(48, 28), _RGB32(107, 107, 107), BF
2755.         _PRINTMODE _KEEPBACKGROUND
2756.         COLOR _RGB32(1, 1, 1)
2757.         _PRINTSTRING (x1, y1), text1$
2758.         IF LEN(text2$) THEN _PRINTSTRING (x2, y2), text2$
2759.         COLOR _RGB32(255, 255, 255)
2760.     NEXT c
2761.  
2762.     _DEST prd
2763.     _FONT oldfont
2764.  
2765. END SUB
2766.  
2767.  
2768. SUB LoadINI
2769.     file$ = "editor.ini"
2770.  
2771.     DIM row(22) AS STRING
2772.  
2773.  
2774.     IF _FILEEXISTS(file$) THEN
2775.         ff = FREEFILE
2776.         OPEN file$ FOR INPUT AS #ff
2777.         FOR r = 1 TO 22
2778.             IF NOT EOF(ff) THEN
2779.                 LINE INPUT #ff, row(r)
2780.             END IF
2781.         NEXT r
2782.  
2783.         GridXResolution = VAL(_TRIM$(MID$(row(2), 40)))
2784.         GridYResolution = VAL(_TRIM$(MID$(row(3), 40)))
2785.         GridRGB32Color~& = VAL(_TRIM$(MID$(row(4), 40)))
2786.         GridVisibility = VAL(_TRIM$(MID$(row(5), 40)))
2787.         GridShowComments = VAL(_TRIM$(MID$(row(6), 40)))
2788.         GridCommentsTime = VAL(_TRIM$(MID$(row(7), 40)))
2789.         LAYERS_SETUP = VAL(_TRIM$(MID$(row(8), 40)))
2790.         DRAW_MOUSE_SETUP = VAL(_TRIM$(MID$(row(9), 40)))
2791.  
2792.         'InfoPlus  - Walls
2793.  
2794.         Img_Height_From = VAL(_TRIM$(MID$(row(10), 40)))
2795.         Img_Height_To = VAL(_TRIM$(MID$(row(11), 40)))
2796.         Img_Textures_per_Object = VAL(_TRIM$(MID$(row(12), 40)))
2797.         Img_Texture_Effect = VAL(_TRIM$(MID$(row(13), 40)))
2798.  
2799.         'InfoPlus - Ceils
2800.  
2801.         Ceil_Height_From = VAL(_TRIM$(MID$(row(14), 40)))
2802.         Ceil_Height_To = VAL(_TRIM$(MID$(row(15), 40)))
2803.         Ceil_Textures_per_Object = VAL(_TRIM$(MID$(row(16), 40)))
2804.         Ceil_Texture_Effect = VAL(_TRIM$(MID$(row(17), 40)))
2805.  
2806.         'InfoPlus - Floors
2807.  
2808.         Floor_Height_From = VAL(_TRIM$(MID$(row(18), 40)))
2809.         Floor_Height_To = VAL(_TRIM$(MID$(row(19), 40)))
2810.         Floor_Textures_per_Object = VAL(_TRIM$(MID$(row(20), 40)))
2811.         Floor_Texture_Effect = VAL(_TRIM$(MID$(row(21), 40)))
2812.  
2813.         'Setup - copy style for rightclick / copy  -> righclick / insert  (0 = rewrite objects, walls, floors and ceilings, 1 = rewrite JUST SELECTED)
2814.         INSERT_SETUP = VAL(_TRIM$(MID$(row(22), 40)))
2815.  
2816.  
2817.     ELSE 'ini file not exists, so write it using default settings
2818.         DIM klr AS _UNSIGNED LONG
2819.         klr = _RGB32(255, 255, 255)
2820.         klr$ = STR$(klr)
2821.  
2822.         ff = FREEFILE
2823.         OPEN file$ FOR OUTPUT AS #ff
2824.         PRINT #ff, "Commented INI file: Program use byte positions 41++ to read on every row. Read not first row and read not first 40 characters on rows!"
2825.         PRINT #ff, "SET MAP X RESOLUTION:"; TAB(40); "100"
2826.         PRINT #ff, "SET MAP Y RESOLUTION:"; TAB(40); "100"
2827.         PRINT #ff, "SET MAP COLOR RGB32:"; TAB(40); klr$
2828.         PRINT #ff, "SET MAP VISIBILITY:"; TAB(40); "1"
2829.         PRINT #ff, "SHOW COMMENTS ON MAP:"; TAB(40); "1"
2830.         PRINT #ff, "TIME BEFORE SHOW COMMENTS:"; TAB(40); "2"
2831.         PRINT #ff, "LAYERS SETUP (0 TO 4):"; TAB(40); "0"
2832.         PRINT #ff, "MOUSE DRAW SETTING (0 or 1):"; TAB(40); "0"
2833.  
2834.         PRINT #ff, "Walls - Height From (-2 default):"; TAB(40); "-2"
2835.         PRINT #ff, "Walls - Height To (2 default):"; TAB(40); "2"
2836.         PRINT #ff, "Walls - Walls to 1 texture (1):"; TAB(40); "1"
2837.         PRINT #ff, "Walls - texture effect (0 def):"; TAB(40); "0"
2838.  
2839.         PRINT #ff, "Ceiling - Height From (2 default):"; TAB(40); "2"
2840.         PRINT #ff, "Ceiling - Height To (2 default):"; TAB(40); "2"
2841.         PRINT #ff, "Ceiling - Walls to 1 texture (1):"; TAB(40); "1"
2842.         PRINT #ff, "Ceiling - texture effect (0 def):"; TAB(40); "0"
2843.  
2844.         PRINT #ff, "Floors - Height From (-2 default):"; TAB(40); "-2"
2845.         PRINT #ff, "Floors - Height To (-2 default):"; TAB(40); "-2"
2846.         PRINT #ff, "Floors - Walls to 1 texture (1):"; TAB(40); "1"
2847.         PRINT #ff, "Floors - texture effect (0 def):"; TAB(40); "0"
2848.  
2849.         PRINT #ff, "Copy/Insert function setup: (0 or 1):"; TAB(40); "1"
2850.  
2851.         GridXResolution = 100
2852.         GridYResolution = 100
2853.         GridRGB32Color~& = _RGB32(255, 255, 255)
2854.         GridVisibility = 1
2855.         GridShowComments = 1
2856.         GridCommentsTime = 2
2857.         LAYERS_SETUP = 0
2858.         DRAW_MOUSE_SETUP = 0
2859.  
2860.         Img_Height_From = -2
2861.         Img_Height_To = 2
2862.         Img_Textures_per_Object = 1
2863.         Img_Texture_Effect = 0
2864.         Ceil_Height_From = 2
2865.         Ceil_Height_To = 2
2866.         Ceil_Textures_per_Object = 1
2867.         Ceil_Texture_Effect = 0
2868.         Floor_Height_From = -2
2869.         Floor_Height_To = -2
2870.         Floor_Textures_per_Object = 1
2871.         Floor_Texture_Effect = 0
2872.         INSERT_SETUP = 1
2873.     END IF
2874.  
2875.  
2876. END SUB
2877.  
2878.  
2879. SUB SetGrid
2880.  
2881.     PCOPY _DISPLAY, 2
2882.  
2883.     'nacteni soucasne barvy mrizky
2884.     R = _RED32(GridRGB32Color~&)
2885.     G = _GREEN32(GridRGB32Color~&)
2886.     B = _BLUE32(GridRGB32Color~&)
2887.     V = GridVisibility
2888.     GridWidth = UBOUND(grid_img, 1)
2889.     GridHeight = UBOUND(grid_img, 2)
2890.  
2891.     LINE (198, 200)-(822, 568), _RGB32(70, 70, 70), BF
2892.     LINE (198, 200)-(822, 568), _RGB32(155, 155, 155), B
2893.     LINE (200, 202)-(820, 566), _RGB32(155, 155, 155), B
2894.     _FONT 8
2895.     _PRINTMODE _KEEPBACKGROUND
2896.     _PRINTSTRING (480, 205), "Grid Setup"
2897.     plus = LOADICO("ico\plus.ico", 4)
2898.     minus = LOADICO("ico\minus.ico", 4)
2899.     ok = LOADICO("ico\ok.ico", 6)
2900.     DvojSipka = _LOADIMAGE("ico/dvojsipka.bmp", 32)
2901.     oke = LOADICO("ico/oke.ico", 1)
2902.     bck = LOADICO("ico/ko.ico", 1)
2903.  
2904.  
2905.     _CLEARCOLOR 0, oke
2906.     _CLEARCOLOR 0, bck
2907.  
2908.     _CLEARCOLOR _RGB32(255, 255, 255), DvojSipka
2909.     _CLEARCOLOR 0, ok
2910.     _PRINTSTRING (220, 245), "Grid Color Setup:   R"
2911.     _PRINTSTRING (220, 270), "                    G"
2912.     _PRINTSTRING (220, 295), "                    B"
2913.  
2914.     _PUTIMAGE (400, 240), minus
2915.     _PUTIMAGE (660, 240), plus
2916.     _PUTIMAGE (400, 265), minus
2917.     _PUTIMAGE (660, 265), plus
2918.     _PUTIMAGE (400, 290), minus
2919.     _PUTIMAGE (660, 290), plus
2920.     LINE (700, 245)-(750, 295), _RGB32(R, G, B), BF
2921.  
2922.     _PRINTSTRING (220, 335), "       Show Grid:"
2923.     '    IF V THEN _PUTIMAGE (380, 328), ok
2924.     LINE (380, 330)-(395, 345), _RGB32(255, 255, 255), B
2925.  
2926.     _PRINTSTRING (220, 375), "Grid (MAP) width:   " + STR$(GridWidth)
2927.     LINE (380, 370)-(420, 385), _RGB32(255, 255, 255), B
2928.  
2929.     _PRINTSTRING (210, 415), "Grid (MAP) height:   " + STR$(GridHeight)
2930.     LINE (380, 410)-(420, 425), _RGB32(255, 255, 255), B
2931.  
2932.  
2933.     _PRINTSTRING (565, 335), "Show comments:"
2934.     IF GridShowComments THEN _PUTIMAGE (700, 328), ok
2935.     LINE (700, 330)-(715, 345), _RGB32(255, 255, 255), B
2936.  
2937.     'upgrade: v014-2
2938.  
2939.     LINE (465, 400)-(780, 400), _RGB32(127, 127, 200)
2940.     _PRINTSTRING (257, 455), "Layers mode:"
2941.     _PRINTSTRING (484, 415), "Mouse mode:"
2942.  
2943.  
2944.  
2945.  
2946.     '    GridShowComments = 0
2947.     _PRINTSTRING (510, 375), "Time before comments:"
2948.     '    IF GridShowComments THEN _PUTIMAGE (700, 328), ok
2949.     LINE (700, 370)-(740, 385), _RGB32(255, 255, 255), B
2950.     _PUTIMAGE (740, 360), DvojSipka 'pro nastaveni casu komentare
2951.     IF GridShowComments = 0 THEN LINE (500, 360)-(770, 395), _RGBA32(70, 70, 70, 210), BF
2952.  
2953.     'umisteni dvoojsipek pro snizovani / zvysovani ciselnych hodnot
2954.     _PUTIMAGE (422, 360), DvojSipka 'width nastaveni
2955.     _PUTIMAGE (422, 400), DvojSipka 'height nastaveni
2956.  
2957.     PCOPY _DISPLAY, 1
2958.     comments = GridShowComments
2959.     commtime = GridCommentsTime
2960.     visible = GridVisibility
2961.     GridWidt = GridWidth
2962.     GridHeigh = GridHeight
2963.  
2964.     OldResX = GridXResolution
2965.     OldResY = GridYResolution
2966.  
2967.     DO
2968.         PCOPY 1, _DISPLAY
2969.         WHILE _MOUSEINPUT: WEND
2970.         ROLLMENU 385, 455 'UPGRADE 01U14-2
2971.         ROLLMENU_MOUSE 584, 415
2972.  
2973.  
2974.         'ovladani povoleni zobrazeni komentaru
2975.         IF ONPOS(_MOUSEX, _MOUSEY, 700, 330, 715, 345) THEN 'show comments ctverecek
2976.             LINE (700, 330)-(715, 345), _RGBA32(255, 255, 255, 70), BF
2977.  
2978.             IF _MOUSEBUTTON(1) THEN
2979.                 IF comments = 0 THEN comments = 1 ELSE comments = 0
2980.                 _DELAY .2
2981.             END IF
2982.  
2983.         END IF
2984.  
2985.         IF comments THEN
2986.             IF ONPOS(_MOUSEX, _MOUSEY, 745, 365, 754, 373) THEN
2987.                 LINE (745, 365)-(754, 373), _RGB32(170, 170, 170), B
2988.                 IF _MOUSEBUTTON(1) THEN commtime = commtime + 1: _DELAY .2
2989.             END IF
2990.  
2991.  
2992.             IF ONPOS(_MOUSEX, _MOUSEY, 745, 381, 754, 388) THEN
2993.                 LINE (745, 381)-(754, 388), _RGB32(170, 170, 170), B 'drobny ctverecek
2994.                 IF _MOUSEBUTTON(1) THEN commtime = commtime - 1: _DELAY .2
2995.             END IF
2996.  
2997.             IF commtime > 50 THEN commtime = 50
2998.             IF commtime < 0 THEN commtime = 0
2999.  
3000.             COLOR , _RGB32(70, 70, 70)
3001.             '  LINE (700, 325)-(715, 345), _RGB32(70, 70, 70), BF
3002.             LINE (700, 330)-(715, 345), _RGB32(255, 255, 255), B
3003.  
3004.  
3005.             'tohle nejak poresit aby to neukazovalo tisiciny
3006.  
3007.             LINE (702, 372)-(738, 384), _RGB32(70, 70, 70), BF
3008.  
3009.             'kontrola delky casu a pripadne zkraceni:
3010.             cmt$ = __USING$(commtime / 10, 3)
3011.             _PRINTSTRING (710, 375), cmt$
3012.  
3013.             _PUTIMAGE (700, 328), ok
3014.         ELSE
3015.             LINE (700, 325)-(715, 345), _RGB32(70, 70, 70), BF
3016.             LINE (700, 330)-(715, 345), _RGBA32(255, 255, 255, 70), BF
3017.             LINE (700, 330)-(715, 345), _RGB32(255, 255, 255), B
3018.             LINE (500, 360)-(770, 395), _RGBA32(70, 70, 70, 210), BF
3019.         END IF
3020.  
3021.  
3022.         'ovladani nastaveni velikosti mapy
3023.         IF ONPOS(_MOUSEX, _MOUSEY, 380, 330, 395, 345) THEN
3024.             LINE (380, 330)-(395, 345), _RGBA32(255, 255, 255, 70), BF
3025.  
3026.             IF _MOUSEBUTTON(1) THEN
3027.                 IF visible = 0 THEN visible = 1 ELSE visible = 0
3028.                 _DELAY .2
3029.             END IF
3030.         END IF
3031.  
3032.         IF visible THEN
3033.             _PUTIMAGE (380, 328), ok
3034.         END IF
3035.  
3036.  
3037.         'ovladani sipek pro velikost mapy WIDTH
3038.         IF ONPOS(_MOUSEX, _MOUSEY, 426, 366, 435, 373) THEN
3039.             LINE (426, 366)-(435, 373), _RGB32(170, 170, 170), B
3040.             IF _MOUSEBUTTON(1) THEN GridWidt = GridWidt + 1: _DELAY .02
3041.         END IF
3042.  
3043.         IF ONPOS(_MOUSEX, _MOUSEY, 426, 382, 435, 389) THEN
3044.             LINE (426, 382)-(435, 389), _RGB32(170, 170, 170), B
3045.             IF _MOUSEBUTTON(1) THEN GridWidt = GridWidt - 1: _DELAY .02
3046.         END IF
3047.  
3048.         IF GridWidt < 10 THEN GridWidt = 10
3049.         IF GridWidt > 999 THEN GridWidt = 999
3050.  
3051.         LINE (383, 371)-(419, 384), _RGB32(70, 70, 70), BF
3052.         _PRINTSTRING (220, 375), "Grid (MAP) width:   " + STR$(GridWidt)
3053.  
3054.  
3055.         'ovladani sipek pro velikost mapy HEIGHT
3056.         IF ONPOS(_MOUSEX, _MOUSEY, 426, 407, 435, 414) THEN
3057.             LINE (426, 407)-(435, 414), _RGB32(170, 170, 170), B
3058.             IF _MOUSEBUTTON(1) THEN GridHeigh = GridHeigh + 1: _DELAY .02
3059.         END IF
3060.  
3061.         IF ONPOS(_MOUSEX, _MOUSEY, 426, 423, 435, 430) THEN
3062.             LINE (426, 423)-(435, 430), _RGB32(170, 170, 170), B
3063.             IF _MOUSEBUTTON(1) THEN GridHeigh = GridHeigh - 1: _DELAY .02
3064.         END IF
3065.  
3066.         IF GridHeigh < 10 THEN GridHeigh = 10
3067.         IF GridHeigh > 999 THEN GridHeigh = 999
3068.  
3069.         LINE (382, 411)-(416, 423), _RGB32(70, 70, 70), BF
3070.         _PRINTSTRING (210, 415), "Grid (MAP) height:   " + STR$(GridHeigh)
3071.  
3072.         'ovladani Tahla R -
3073.         IF ONPOS(_MOUSEX, _MOUSEY, 400, 240, 415, 255) THEN
3074.             LINE (400, 240)-(415, 255), _RGBA32(170, 170, 170, 60), BF
3075.             IF _MOUSEBUTTON(1) THEN R = R - 1: _DELAY .02
3076.         END IF
3077.         IF R < 0 THEN R = 0
3078.         IF R > 255 THEN R = 255
3079.  
3080.         'ovladani Tahla G -
3081.         IF ONPOS(_MOUSEX, _MOUSEY, 400, 265, 415, 280) THEN
3082.             LINE (400, 265)-(415, 280), _RGBA32(170, 170, 170, 60), BF
3083.             IF _MOUSEBUTTON(1) THEN G = G - 1: _DELAY .02
3084.         END IF
3085.         IF G < 0 THEN G = 0
3086.         IF G > 255 THEN G = 255
3087.  
3088.         'ovladani Tahla B -
3089.         IF ONPOS(_MOUSEX, _MOUSEY, 400, 290, 415, 305) THEN
3090.             LINE (400, 290)-(415, 305), _RGBA32(170, 170, 170, 60), BF
3091.             IF _MOUSEBUTTON(1) THEN B = B - 1: _DELAY .02
3092.         END IF
3093.         IF B < 0 THEN B = 0
3094.         IF B > 255 THEN B = 255
3095.  
3096.         '========
3097.         'ovladani Tahla R +
3098.         IF ONPOS(_MOUSEX, _MOUSEY, 660, 240, 675, 255) THEN
3099.             LINE (660, 240)-(675, 255), _RGBA32(170, 170, 170, 60), BF
3100.             IF _MOUSEBUTTON(1) THEN R = R + 1: _DELAY .02
3101.         END IF
3102.         IF R < 0 THEN R = 0
3103.         IF R > 255 THEN R = 255
3104.  
3105.         'ovladani Tahla G +
3106.         IF ONPOS(_MOUSEX, _MOUSEY, 660, 265, 675, 280) THEN
3107.             LINE (660, 265)-(675, 280), _RGBA32(170, 170, 170, 60), BF
3108.             IF _MOUSEBUTTON(1) THEN G = G + 1: _DELAY .02
3109.         END IF
3110.         IF G < 0 THEN G = 0
3111.         IF G > 255 THEN G = 255
3112.  
3113.         'ovladani Tahla B +
3114.         IF ONPOS(_MOUSEX, _MOUSEY, 660, 290, 675, 305) THEN
3115.             LINE (660, 290)-(675, 305), _RGBA32(170, 170, 170, 60), BF
3116.             IF _MOUSEBUTTON(1) THEN B = B + 1: _DELAY .02
3117.         END IF
3118.         IF B < 0 THEN B = 0
3119.         IF B > 255 THEN B = 255
3120.  
3121.  
3122.         'vykresleni tahel
3123.         LINE (430, 297)-(645, 297), _RGB32(0, 0, 255)
3124.         LINE (430, 273)-(645, 273), _RGB32(0, 255, 0)
3125.         LINE (430, 247)-(645, 247), _RGB32(255, 0, 0)
3126.  
3127.         posR = 430 + (215 * (R / 255))
3128.         posG = 430 + (215 * (G / 255))
3129.         posB = 430 + (215 * (B / 255))
3130.  
3131.  
3132.         LINE (posR - 3, 244)-(posR + 3, 250), _RGB32(255, 0, 0), BF
3133.         LINE (posG - 3, 270)-(posG + 3, 276), _RGB32(0, 255, 0), BF
3134.         LINE (posB - 3, 294)-(posB + 3, 300), _RGB32(0, 0, 255), BF
3135.         LINE (700, 245)-(750, 295), _RGB32(R, G, B), BF
3136.  
3137.         'vklad konecnych tlacitek a moznosti uniku z klavesnice pres Esc
3138.  
3139.         inky$ = INKEY$
3140.         IF inky$ = CHR$(27) THEN GOTO frimg
3141.  
3142.  
3143.         IF ONPOS(_MOUSEX, _MOUSEY, 300, 500, 385, 530) THEN LINE (300, 500)-(385, 530), _RGBA32(170, 170, 170, 60), BF: IF _MOUSEBUTTON(1) THEN EXIT DO
3144.         LINE (300, 500)-(385, 530), _RGB32(255, 255, 255), B
3145.         _PUTIMAGE (300, 500), oke
3146.         _PRINTSTRING (333, 513), "Done"
3147.  
3148.  
3149.  
3150.  
3151.  
3152.  
3153.         IF ONPOS(_MOUSEX, _MOUSEY, 640, 500, 725, 530) THEN LINE (640, 500)-(725, 530), _RGBA32(170, 170, 170, 60), BF: IF _MOUSEBUTTON(1) THEN GOTO frimg
3154.         LINE (640, 500)-(725, 530), _RGB32(255, 255, 255), B
3155.         _PUTIMAGE (640, 500), bck
3156.         _PRINTSTRING (673, 513), "Back"
3157.  
3158.  
3159.  
3160.         REM        LOCATE 1, 1: PRINT _MOUSEX, _MOUSEY
3161.         PCOPY _DISPLAY, 2
3162.         _DISPLAY
3163.     LOOP
3164.  
3165.  
3166.     'Warning = 0
3167.     IF OldResX > GridWidt OR OldResY > GridHeigh THEN 'zmena pole na nizsi hodnoty, test, jestli je v tomto poli zaznam
3168.         SOUND 450, .1
3169.  
3170.  
3171.     IF _
3172.        is_subset(grid_img(), gridwidt, gridheigh) or_
3173.        is_subset(grid_ceil(), gridwidt, gridheigh) or_
3174.        is_subset(grid_floor(), gridwidt, gridheigh) then Warning = 1
3175.     END IF
3176.  
3177.     '-----------------------------------------------
3178.     '        Warning = 1
3179.     '
3180.     '       FOR testY = 1 TO OldResY
3181.     '           FOR testX = 1 TO OldResX
3182.     '               IF testY > GridHeigh OR testX > GridWidt THEN
3183.     '                   IF Grid_img(testX, testY) < 0 OR Grid_Ceil(testX, testY) < 0 OR Grid_Floor(testX, testY) < 0 THEN Warning = 1: GOTO hlaseni
3184.     '               END IF
3185.     '       NEXT testX, testY
3186.     '   END IF
3187.     '-------------------------------------------------
3188.  
3189.  
3190.     '    Warning = 1 'pro testovani!
3191.     hlaseni:
3192.     IF Warning THEN 'dialog s varovanim. Dalsi cast = souhlas - ano, zmensit pole i se ztratou dat
3193.         PCOPY 2, _DISPLAY
3194.         Warn = LOADICO("ico/warn.ico", 6)
3195.         '        _CLEARCOLOR _RGB32(0, 0, 0), Warn
3196.         _CLEARCOLOR 0, Warn
3197.         LINE (348, 300)-(648, 410), _RGB32(255, 0, 0), BF
3198.         LINE (348, 300)-(648, 410), _RGB32(255, 255, 255), B
3199.         LINE (350, 302)-(646, 408), _RGB32(255, 255, 255), B
3200.         _PUTIMAGE (370, 320), Warn
3201.         _PRINTSTRING (430, 310), "Warning:"
3202.         _PRINTSTRING (430, 330), "Some objects, walls, ceil-"
3203.         _PRINTSTRING (430, 340), "ings or floors are in area"
3204.         _PRINTSTRING (430, 350), "now set as out of map.    "
3205.         _PRINTSTRING (430, 360), "This delete it. Continue? "
3206.         LINE (430, 378)-(500, 398), _RGB32(70, 70, 70), BF
3207.         LINE (550, 378)-(620, 398), _RGB32(70, 70, 70), BF
3208.         LINE (430, 378)-(500, 398), _RGB32(255, 255, 255), B
3209.         LINE (550, 378)-(620, 398), _RGB32(255, 255, 255), B
3210.  
3211.  
3212.         _PUTIMAGE (430, 373), oke: _PUTIMAGE (550, 373), bck
3213.         _PRINTSTRING (430, 386), "     Yes            No"
3214.         PCOPY _DISPLAY, 2
3215.         DO
3216.             PCOPY 2, _DISPLAY
3217.             i$ = INKEY$
3218.             IF i$ = CHR$(27) THEN _FREEIMAGE Warn: GOTO frimg 'esc abortuje vse
3219.             IF i$ = CHR$(13) THEN EXIT DO '     enter potvrdi vse
3220.             WHILE _MOUSEINPUT: WEND
3221.             _PRINTMODE _FILLBACKGROUND
3222.             LOCATE 1, 1: PRINT _MOUSEX, _MOUSEY
3223.             IF ONPOS(_MOUSEX, _MOUSEY, 430, 378, 500, 398) THEN
3224.                 LINE (430, 378)-(500, 398), _RGBA32(255, 255, 255, 70), BF
3225.                 IF _MOUSEBUTTON(1) THEN EXIT DO
3226.             END IF
3227.  
3228.             IF ONPOS(_MOUSEX, _MOUSEY, 550, 378, 620, 398) THEN
3229.                 LINE (550, 378)-(620, 398), _RGBA32(255, 255, 255, 70), BF
3230.                 IF _MOUSEBUTTON(1) THEN _FREEIMAGE Warn: GOTO frimg
3231.             END IF
3232.             _DISPLAY
3233.         LOOP
3234.     END IF
3235.  
3236.  
3237.     RESIZE_ARR2 Grid_img(), GridWidt, GridHeigh
3238.     RESIZE_ARR2 Grid_Ceil(), GridWidt, GridHeigh
3239.     RESIZE_ARR2 Grid_Floor(), GridWidt, GridHeigh
3240.     RESIZE_ARR2 Grid_Obj(), GridWidt, GridHeigh
3241.     RESIZE_ARR2 Grid_typ(), GridWidt, GridHeigh
3242.     RESIZE_INFOPLUS
3243.  
3244.  
3245.     GridXResolution = GridWidt
3246.     GridYResolution = GridHeigh
3247.     GridShowComments = comments
3248.     GridVisibility = visible
3249.     GridCommentsTime = commtime / 10
3250.     GridRGB32Color~& = _RGB32(R, G, B)
3251.     SaveINI
3252.  
3253.     frimg:
3254.     _FREEIMAGE plus
3255.     _FREEIMAGE minus
3256.     _FREEIMAGE ok
3257.     _FREEIMAGE DvojSipka
3258.     _FREEIMAGE oke
3259.     _FREEIMAGE bck
3260. END SUB
3261.  
3262. FUNCTION __USING$ (Value AS SINGLE, lenght AS INTEGER)
3263.     IF LEFT$(STR$(Value), 2) = " ." THEN Value$ = "0" + _TRIM$(STR$(Value)) ELSE Value$ = _TRIM$(STR$(Value))
3264.     IF LEN(Value$) >= lenght THEN __USING$ = LEFT$(Value$, lenght) ELSE __USING$ = Value$ + STRING$(lenght - LEN(Value$), "0")
3265.     IF INSTR(1, Value$, ".") = 0 AND LEN(Value$) < lenght THEN __USING$ = Value$ + _TRIM$(".") + STRING$(lenght - LEN(Value$) - 1, "0")
3266. END FUNCTION
3267.  
3268.  
3269. SUB RESIZE_INFOPLUS 'MOZNA TO BUDE DELAT BORDEL! POUZITO PRESERVE!
3270.  
3271.     REDIM _PRESERVE IP_Img(UBOUND(grid_img, 1), UBOUND(grid_img, 2)) AS InfoPlus
3272.     REDIM _PRESERVE IP_Ceil(UBOUND(grid_img, 1), UBOUND(grid_img, 2)) AS InfoPlus
3273.     REDIM _PRESERVE IP_Floor(UBOUND(grid_img, 1), UBOUND(grid_img, 2)) AS InfoPlus
3274.  
3275. END SUB
3276.  
3277.  
3278. SUB SaveINI
3279.     file$ = "editor.ini"
3280.     ff = FREEFILE
3281.     OPEN file$ FOR OUTPUT AS #ff
3282.     PRINT #ff, "Commented INI file: Program use byte positions 41++ to read on every row. Read not first row and read not first 40 characters on rows!"
3283.     PRINT #ff, "SET MAP X RESOLUTION:"; TAB(40); GridXResolution
3284.     PRINT #ff, "SET MAP Y RESOLUTION:"; TAB(40); GridYResolution
3285.     PRINT #ff, "SET MAP COLOR RGB32:"; TAB(40); STR$(GridRGB32Color~&)
3286.     PRINT #ff, "SET MAP VISIBILITY:"; TAB(40); GridVisibility
3287.     PRINT #ff, "SHOW COMMENTS ON MAP:"; TAB(40); GridShowComments
3288.     PRINT #ff, "TIME BEFORE SHOW COMMENTS:"; TAB(40); GridCommentsTime
3289.     PRINT #ff, "LAYERS SETTINGS (0 - 4):"; TAB(40); LAYERS_SETUP
3290.     PRINT #ff, "MOUSE DRAW SETTING (0 or 1):"; TAB(40); DRAW_MOUSE_SETUP
3291.  
3292.     PRINT #ff, "Walls - Height From (-2 default):"; TAB(40); Img_Height_From
3293.     PRINT #ff, "Walls - Height To (2 default):"; TAB(40); Img_Height_To
3294.     PRINT #ff, "Walls - Walls to 1 texture (1):"; TAB(40); Img_Textures_per_Object
3295.     PRINT #ff, "Walls - texture effect (0 def):"; TAB(40); Img_Texture_Effect
3296.  
3297.     PRINT #ff, "Ceiling - Height From (2 default):"; TAB(40); Ceil_Height_From
3298.     PRINT #ff, "Ceiling - Height To (2 default):"; TAB(40); Ceil_Height_To
3299.     PRINT #ff, "Ceiling - Walls to 1 texture (1):"; TAB(40); Ceil_Textures_per_Object
3300.     PRINT #ff, "Ceiling - texture effect (0 def):"; TAB(40); Ceil_Texture_Effect
3301.  
3302.     PRINT #ff, "Floors - Height From (-2 default):"; TAB(40); Floor_Height_From
3303.     PRINT #ff, "Floors - Height To (-2 default):"; TAB(40); Floor_Height_To
3304.     PRINT #ff, "Floors - Walls to 1 texture (1):"; TAB(40); Floor_Textures_per_Object
3305.     PRINT #ff, "Floors - texture effect (0 def):"; TAB(40); Floor_Texture_Effect
3306.     PRINT #ff, "Copy/Insert function setup: (0 or 1):"; TAB(40); INSERT_SETUP
3307.  
3308.     CLOSE #ff
3309. END SUB
3310.  
3311. SUB RESIZE_ARR2 (Grid() AS LONG, New_Ubound_A AS LONG, New_Ubound_B AS LONG) 'for 2 dimensional arrays, because _PRESERVE for 2D arrays is.......oh my god.
3312.     DIM swp(New_Ubound_A, New_Ubound_B) AS LONG
3313.     FOR a = LBOUND(grid, 1) TO UBOUND(grid, 1)
3314.         FOR b = LBOUND(grid, 2) TO UBOUND(grid, 2)
3315.             aa = -1: bb = -1
3316.             IF a <= UBOUND(swp, 1) THEN aa = a
3317.             IF b <= UBOUND(swp, 2) THEN bb = b
3318.             IF aa >= 0 AND bb >= 0 THEN swp(aa, bb) = Grid(a, b)
3319.     NEXT b, a
3320.  
3321.     REDIM Grid(New_Ubound_A, New_Ubound_B) AS LONG
3322.     FOR a = LBOUND(swp, 1) TO UBOUND(swp, 1)
3323.         FOR b = LBOUND(swp, 2) TO UBOUND(swp, 2)
3324.             Grid(a, b) = swp(a, b)
3325.     NEXT b, a
3326.     ERASE swp
3327. END SUB
3328.  
3329. SUB SAVE_MAP (filename AS STRING) 'vytvori binarni MAP soubor
3330.  
3331.  
3332.  
3333.     filename$ = _CWD$ + "\MAP\" + filename$ 'uprava aby to ukladal do slozky MAP
3334.  
3335.     'test, jestli pole textur vubec neco obsahuji:
3336.     FOR testTextures = LBOUND(texture) TO UBOUND(texture)
3337.         IF Texture(testTextures).img < -1 THEN pass = 1: EXIT FOR ELSE pass = 0
3338.     NEXT testTextures
3339.  
3340.     IF pass THEN
3341.         DIM MH AS MAP_HEAD
3342.         '       DIM Vertex(0) AS Vertex
3343.         id$ = "MAP3D"
3344.  
3345.         'test poctu relevantnich zaznamu:
3346.         rec = 0
3347.         FOR a = LBOUND(grid_img, 1) TO UBOUND(grid_img, 1)
3348.             FOR b = LBOUND(grid_img, 2) TO UBOUND(grid_img, 2)
3349.                 IF Grid_img(a, b) THEN rec = rec + 1
3350.                 IF Grid_Floor(a, b) THEN rec = rec + 1
3351.                 IF Grid_Ceil(a, b) THEN rec = rec + 1
3352.         NEXT b, a
3353.  
3354.         s1 = 0
3355.  
3356.         DIM siz(UBOUND(texture)) AS LONG, totalSize AS LONG
3357.         FOR s = LBOUND(texture) TO UBOUND(texture)
3358.             s1 = s1 + LEN(REMOVE_PATH$(Texture(s).path))
3359.             s1 = s1 + 4 'pro velikost souboru LONG
3360.             s1 = s1 + 4 'pro velikost delky jmena typu LONG
3361.             ff2 = FREEFILE
3362.  
3363.             OPEN Texture(s).path FOR BINARY AS #ff2
3364.             siz(s) = LOF(ff2)
3365.             CLOSE #ff2
3366.             totalSize = totalSize + siz(s)
3367.         NEXT s
3368.  
3369.  
3370.         MH.Identity = SaveMap3D$
3371.         MH.Nr_of_Textures = UBOUND(texture) + 1 'protoze zaznam cislo 0 pro texturu take obsahuje 1 texturu
3372.         MH.Nr_of_Vertexes = rec
3373.         MH.DataStart = 21 + s1 'hlava ma 21 bytu
3374.         MH.VertexStart = MH.DataStart + totalSize
3375.         '----- Hlava je pripravena ---------- File header ready
3376.  
3377.         ff = FREEFILE
3378.         OPEN filename$ FOR OUTPUT AS #ff: CLOSE #ff
3379.         OPEN filename$ FOR BINARY AS #ff
3380.         PUT #ff, , MH
3381.  
3382.         DIM NameLenght AS LONG
3383.         FOR SaveNamesLenght = LBOUND(texture) TO UBOUND(texture)
3384.             NameLenght = LEN(REMOVE_PATH(Texture(SaveNamesLenght).path))
3385.             PUT #ff, , NameLenght
3386.         NEXT
3387.         'ukladani velikosti souboru ' saving files sizes
3388.         DIM FSize AS LONG
3389.         FOR SaveNamesLenght = LBOUND(texture) TO UBOUND(texture)
3390.             FSize = siz(SaveNamesLenght)
3391.             PUT #ff, , FSize
3392.         NEXT
3393.  
3394.         'ukladani jmen souboru'  saving files names
3395.         FOR SaveFilesNames = LBOUND(texture) TO UBOUND(texture)
3396.             nam$ = SPACE$((LEN(REMOVE_PATH(Texture(SaveFilesNames).path))))
3397.             nam$ = REMOVE_PATH(Texture(SaveFilesNames).path)
3398.             PUT #ff, , nam$
3399.         NEXT SaveFilesNames
3400.  
3401.         'nasleduje zkopirovani binarnich dat textur 'copying files datas to MAP file
3402.         FOR Copy_Binary_Texture_Data = LBOUND(siz) TO UBOUND(siz)
3403.             ff2 = FREEFILE
3404.             OPEN Texture(Copy_Binary_Texture_Data).path FOR BINARY AS #ff2
3405.             fbd$ = SPACE$(LOF(ff2))
3406.             GET #ff2, , fbd$
3407.             CLOSE #ff2
3408.             PUT #ff, , fbd$
3409.         NEXT
3410.  
3411.  
3412.         'zmena oproti verzi 01U13: Nasleduji dve hodnoty LONG udavajici vysku a sirku mapy, pote nasleduji 3 kopie map GRID v LONG, udavajici -1 = neni textura, nebo cislo textury
3413.  
3414.         'save grid (map) size
3415.         DIM W AS LONG, H AS LONG, Texture_Nr AS LONG
3416.  
3417.         W = UBOUND(grid_img, 1) 'je li sirka jednoho ctverce .5, nelze jinak
3418.         H = UBOUND(grid_img, 2)
3419.  
3420.         PUT #ff, , W
3421.         PUT #ff, , H
3422.  
3423.         'nejprve zpracuju zdi. Toto pole umoznuje jednu texturu na jeden blok zdi v teto verzi.
3424.         'save walls infos
3425.  
3426.         FOR RecordWallsY = LBOUND(grid_img, 2) TO UBOUND(grid_img, 2) - 1
3427.             FOR RecordWallsX = LBOUND(grid_img, 1) TO UBOUND(grid_img, 1) - 1
3428.                 IF Grid_img(RecordWallsX, RecordWallsY) THEN
3429.                     Texture_Nr = GET_TEXTURE_NR(Grid_img(RecordWallsX, RecordWallsY)) + 1 'cislo textury
3430.                     '     PRINT RecordWallsX, RecordWallsY: _DISPLAY: SLEEP
3431.                 ELSE
3432.                     Texture_Nr = -1
3433.                 END IF
3434.                 PUT #ff, , Texture_Nr
3435.             NEXT
3436.         NEXT
3437.  
3438.  
3439.  
3440.         've stejne smycce, protoze tato pole maji stejne velikosti, zpracuji i pole zemi (floor)
3441.         'save floors infos
3442.  
3443.         FOR RecordFloorY = LBOUND(grid_floor, 2) TO UBOUND(grid_floor, 2) - 1
3444.             FOR RecordFloorX = LBOUND(grid_floor, 1) TO UBOUND(grid_floor, 1) - 1
3445.                 IF Grid_Floor(RecordFloorX, RecordFloorY) THEN
3446.                     Texture_Nr = GET_TEXTURE_NR(Grid_Floor(RecordFloorX, RecordFloorY)) + 1 'cislo textury
3447.                 ELSE
3448.                     Texture_Nr = -1
3449.                 END IF
3450.                 PUT #ff, , Texture_Nr
3451.             NEXT
3452.         NEXT
3453.         'nakonec to same pro strop:
3454.         'save ceilings infos
3455.  
3456.         FOR RecordCeilY = LBOUND(grid_ceil, 2) TO UBOUND(grid_ceil, 2) - 1
3457.             FOR RecordCeilX = LBOUND(grid_ceil, 1) TO UBOUND(grid_ceil, 1) - 1
3458.                 IF Grid_Ceil(RecordCeilX, RecordCeilY) THEN
3459.                     Texture_Nr = GET_TEXTURE_NR(Grid_Ceil(RecordCeilX, RecordCeilY)) + 1 'cislo textury
3460.                 ELSE
3461.                     Texture_Nr = -1
3462.                 END IF
3463.                 PUT #ff, , Texture_Nr
3464.             NEXT
3465.         NEXT
3466.  
3467.  
3468.         'in future next areas: Sound infos, objects infos
3469.  
3470.  
3471.     ELSE DialogW "MAP IS EMPTY!", 3
3472.  
3473.     END IF
3474. END SUB
3475.  
3476. FUNCTION GET_TEXTURE_NR (rec AS LONG)
3477.     FOR x = LBOUND(texture) TO UBOUND(texture)
3478.         Tnr = Texture(x).img
3479.         IF Tnr = rec THEN GET_TEXTURE_NR = x: EXIT FUNCTION
3480.     NEXT
3481. END FUNCTION
3482.  
3483. FUNCTION REMOVE_PATH$ (path$)
3484.     REMOVE_PATH$ = MID$(path$, _INSTRREV(path$, "\") + 1)
3485. END FUNCTION
3486.  
3487. FUNCTION Sload& (fileName AS STRING)
3488.     Sload& = _LOADIMAGE(fileName$, 32)
3489. END FUNCTION
3490.  
3491.  
3492.  
3493. SUB LOAD_MAP (filename AS STRING) 'load images as software textures + other infos
3494.     IF _FILEEXISTS(filename) THEN
3495.         DIM RH AS MAP_HEAD
3496.         '        DIM Vertex AS Vertex
3497.  
3498.         ff = FREEFILE
3499.         OPEN filename$ FOR BINARY AS #ff
3500.         GET #ff, , RH
3501.         IF RH.Identity <> "MAP3D" THEN PRINT "Unsupported MAP format.": EXIT SUB 'unsupported file format
3502.  
3503.         PRINT "V souboru je:"; RH.Nr_of_Textures; "textur" 'Nr Textures in file                   4 B
3504.         PRINT "V souboru je:"; RH.Nr_of_Vertexes; "vrcholu" 'Nr Vertexes in file                  4 B
3505.         PRINT "Zacatek dat textur: "; RH.DataStart 'Data texture in file start offset             4 B
3506.         PRINT "Zacatek dat vrcholu: "; RH.VertexStart 'Vertexes in file start offset              4 B
3507.  
3508.         _DISPLAY
3509.  
3510.  
3511.         DIM FileNamesLenght(RH.Nr_of_Textures) AS LONG
3512.         FOR R = 1 TO RH.Nr_of_Textures
3513.             GET #ff, , FileNamesLenght(R)
3514.         NEXT R
3515.  
3516.  
3517.         DIM FileSize(RH.Nr_of_Textures) AS LONG
3518.         FOR R = 1 TO RH.Nr_of_Textures
3519.             GET #ff, , FileSize(R)
3520.         NEXT R
3521.  
3522.  
3523.         DIM FileName(RH.Nr_of_Textures) AS STRING
3524.         FOR R = 1 TO RH.Nr_of_Textures
3525.             FileName(R) = SPACE$(FileNamesLenght(R))
3526.             GET #ff, , FileName(R)
3527.         NEXT R
3528.  
3529.         SP$ = "TEXTURES\"
3530.  
3531.         IF _DIREXISTS("TEXTURES") = 0 THEN MKDIR "TEXTURES"
3532.  
3533.         FOR R = 1 TO RH.Nr_of_Textures
3534.             ff2 = FREEFILE
3535.             OPEN SP$ + FileName(R) FOR OUTPUT AS #ff2 'doplneno SP$
3536.             CLOSE #ff2
3537.             OPEN SP$ + FileName(R) FOR BINARY AS #ff2
3538.             record$ = SPACE$(FileSize(R))
3539.             GET #ff, , record$
3540.             PUT #ff2, , record$
3541.             record$ = ""
3542.             CLOSE #ff2
3543.         NEXT R
3544.  
3545.         REDIM Texture(RH.Nr_of_Textures - 1) AS Texture
3546.  
3547.         FOR R = 1 TO RH.Nr_of_Textures
3548.             Texture(R - 1).img = Sload(SP$ + FileName(R)) 'index udava poradi textury v souboru, pridano SP$
3549.             Texture(R - 1).path = SP$ + FileName(R)
3550.         NEXT R
3551.  
3552.  
3553.         DIM W AS LONG, H AS LONG
3554.         GET #ff, , W
3555.         GET #ff, , H
3556.  
3557.  
3558.         REDIM Grid_img(W, H) AS LONG
3559.         REDIM Grid_Floor(W, H) AS LONG
3560.         REDIM Grid_Ceil(W, H) AS LONG
3561.         REDIM Grid_typ(W, H) AS LONG
3562.  
3563.         FOR Ly = 0 TO H - 1
3564.             FOR Lx = 0 TO W - 1
3565.                 GET #ff, , record&
3566.                 IF record& > -1 THEN
3567.                     Grid_img(Lx, Ly) = Texture(record& - 1).img
3568.                 END IF
3569.         NEXT Lx, Ly
3570.  
3571.         FOR Ly = 0 TO H - 1
3572.             FOR Lx = 0 TO W - 1
3573.                 GET #ff, , record&
3574.                 IF record& > -1 THEN
3575.                     Grid_Floor(Lx, Ly) = Texture(record& - 1).img
3576.                 END IF
3577.         NEXT Lx, Ly
3578.  
3579.  
3580.         FOR Ly = 0 TO H - 1
3581.             FOR Lx = 0 TO W - 1
3582.                 GET #ff, , record&
3583.                 IF record& > -1 THEN
3584.                     Grid_Ceil(Lx, Ly) = Texture(record& - 1).img
3585.                 END IF
3586.         NEXT Lx, Ly
3587.         CLOSE #ff
3588.  
3589.         FOR Ly = 0 TO H - 1
3590.             FOR Lx = 0 TO W - 1
3591.                 T = WHOIS(Lx, Ly)
3592.                 Grid_typ(Lx, Ly) = T
3593.         NEXT Lx, Ly
3594.  
3595.  
3596.     ELSE 'file not found
3597.         EXIT SUB
3598.     END IF
3599.  
3600.  
3601.     StartDrawX = 0: EndDrawX = 36
3602.     StartDrawy = 0: EndDrawy = 35
3603. END SUB
3604.  
3605.  
3606. SUB ROLLMENU (X AS INTEGER, y AS INTEGER)
3607.     WHILE _MOUSEINPUT: WEND
3608.  
3609.     _PRINTSTRING (X, y), CHR$(31)
3610.     LINE (X - 5, y - 5)-(X + 355, y + 14), _RGB32(255, 255, 255), B
3611.  
3612.     REDIM Roll(4) AS STRING
3613.     Roll(0) = "Show all layers. Separate it using ALPHA" 'to jak to je ted
3614.     Roll(1) = "Show actual layer only" '                 ukaze jen vrstvu na kterou je preply, ostatni nezobrazi
3615.     Roll(2) = "Show actual layer, SPACE for show all" '  ukaze jen aktualni vrstvu, po stisku mezerniku i ostatni vrstvy
3616.     Roll(3) = "Don't show textures, use QUADS, all layers" 'misto textur pouzije LINE BF, zobrazi vsechny vrstvy
3617.     Roll(4) = "Don't show textures, use QUAD, one layer" 'misto textur pouzije LINE BF, vzdy jen aktualni vrstvu
3618.     _PRINTSTRING (X + 20, y), Roll(LAYERS_SETUP)
3619.  
3620.     IF ONPOS(_MOUSEX, _MOUSEY, X - 10, y - 10, X + 10, y + 10) THEN
3621.  
3622.         LINE (X, y - 3)-(X + 8, y + 10), _RGBA32(127, 127, 127, 120), BF
3623.  
3624.         IF _MOUSEBUTTON(1) THEN
3625.             DIM my AS INTEGER
3626.             _KEYCLEAR
3627.             _DELAY .3
3628.             DO
3629.                 PCOPY 2, _DISPLAY
3630.                 LINE (X - 5, y - 10)-(X + 356, y + (20 * (UBOUND(roll) + 1))), _BACKGROUNDCOLOR, BF
3631.                 LINE (X - 5, y - 10)-(X + 356, y + (20 * (UBOUND(roll) + 1))), _RGB32(255), B
3632.                 Ypoz = y + (20 * LAYERS_SETUP)
3633.                 LINE (X - 3, Ypoz - 5)-(X + 353, Ypoz + 15), _RGB32(200), B
3634.                 i$ = INKEY$
3635.                 SELECT CASE i$
3636.                     CASE CHR$(0) + CHR$(72) ' up
3637.                         LAYERS_SETUP = LAYERS_SETUP - 1
3638.                     CASE CHR$(0) + CHR$(80) 'dn
3639.                         LAYERS_SETUP = LAYERS_SETUP + 1
3640.                 END SELECT
3641.                 IF LAYERS_SETUP < LBOUND(roll) THEN LAYERS_SETUP = UBOUND(roll)
3642.                 IF LAYERS_SETUP > UBOUND(roll) THEN LAYERS_SETUP = LBOUND(roll)
3643.                 FOR s = LBOUND(roll) TO UBOUND(roll)
3644.                     _PRINTSTRING (X + 20, y + (20 * s)), Roll(s)
3645.                 NEXT
3646.                 WHILE _MOUSEINPUT: WEND
3647.                 my = _CEIL(_MOUSEY - y - 5) / 20
3648.                 IF ONPOS(_MOUSEX, _MOUSEY, X - 5, y - 5, X + 365, y + 90) THEN
3649.                     LOCATE 1, 1: PRINT my
3650.                     LAYERS_SETUP = my
3651.                     IF _MOUSEBUTTON(1) THEN MouseSel = 1
3652.                 END IF
3653.  
3654.                 REM   _PRINTSTRING (X + 20, y), Roll(LAYERS_SETUP)
3655.  
3656.                 'vyjede roleta s nabidkou
3657.  
3658.                 _DISPLAY
3659.                 _LIMIT 50
3660.             LOOP UNTIL i$ = CHR$(13) OR MouseSel = 1
3661.         END IF
3662.  
3663.     ELSE
3664.         activ = 0
3665.     END IF
3666. END SUB
3667.  
3668. SUB ROLLMENU_MOUSE (X AS INTEGER, y AS INTEGER)
3669.     WHILE _MOUSEINPUT: WEND
3670.  
3671.     _PRINTSTRING (X, y), CHR$(31)
3672.     LINE (X - 5, y - 5)-(X + 155, y + 14), _RGB32(255, 255, 255), B
3673.  
3674.     REDIM Roll(1) AS STRING
3675.     Roll(0) = "Single squares" 'to jak to je ted
3676.     Roll(1) = "In blocks" '          malovat v blocich
3677.     _PRINTSTRING (X + 20, y), Roll(DRAW_MOUSE_SETUP)
3678.  
3679.     IF ONPOS(_MOUSEX, _MOUSEY, X - 10, y - 10, X + 10, y + 10) THEN
3680.  
3681.         LINE (X, y - 3)-(X + 8, y + 10), _RGBA32(127, 127, 127, 120), BF
3682.  
3683.         IF _MOUSEBUTTON(1) THEN
3684.             DIM my AS INTEGER
3685.             _KEYCLEAR
3686.             _DELAY .3
3687.             DO
3688.                 PCOPY 2, _DISPLAY
3689.                 LINE (X - 5, y - 10)-(X + 156, y + (20 * (UBOUND(roll) + 1))), _BACKGROUNDCOLOR, BF
3690.                 LINE (X - 5, y - 10)-(X + 156, y + (20 * (UBOUND(roll) + 1))), _RGB32(255), B
3691.                 Ypoz = y + (20 * DRAW_MOUSE_SETUP)
3692.                 LINE (X - 3, Ypoz - 5)-(X + 153, Ypoz + 15), _RGB32(200), B
3693.                 i$ = INKEY$
3694.                 SELECT CASE i$
3695.                     CASE CHR$(0) + CHR$(72) ' up
3696.                         DRAW_MOUSE_SETUP = DRAW_MOUSE_SETUP - 1
3697.                     CASE CHR$(0) + CHR$(80) 'dn
3698.                         DRAW_MOUSE_SETUP = DRAW_MOUSE_SETUP + 1
3699.                 END SELECT
3700.                 IF DRAW_MOUSE_SETUP < LBOUND(roll) THEN DRAW_MOUSE_SETUP = UBOUND(roll)
3701.                 IF DRAW_MOUSE_SETUP > UBOUND(roll) THEN DRAW_MOUSE_SETUP = LBOUND(roll)
3702.                 FOR s = LBOUND(roll) TO UBOUND(roll)
3703.                     _PRINTSTRING (X + 20, y + (20 * s)), Roll(s)
3704.                 NEXT
3705.                 WHILE _MOUSEINPUT: WEND
3706.                 my = _CEIL(_MOUSEY - y - 5) / 20
3707.                 IF ONPOS(_MOUSEX, _MOUSEY, X - 5, y - 5, X + 165, y + 90) THEN
3708.                     '                    LOCATE 1, 1: PRINT my
3709.                     DRAW_MOUSE_SETUP = my
3710.                     IF _MOUSEBUTTON(1) THEN MouseSel = 1
3711.                 END IF
3712.  
3713.                 REM   _PRINTSTRING (X + 20, y), Roll(LAYERS_SETUP)
3714.  
3715.                 'vyjede roleta s nabidkou
3716.  
3717.                 _DISPLAY
3718.                 _LIMIT 50
3719.             LOOP UNTIL i$ = CHR$(13) OR MouseSel = 1
3720.         END IF
3721.  
3722.     ELSE
3723.         activ = 0
3724.     END IF
3725. END SUB
3726.  
3727.  
3728. FUNCTION FAST_MAP_INFO& (MAP_File_Name AS STRING)
3729.     IF _FILEEXISTS(MAP_File_Name) THEN
3730.         DIM RH AS MAP_HEAD
3731.         '        DIM Vertex AS Vertex
3732.  
3733.         ff = FREEFILE
3734.         OPEN MAP_File_Name$ FOR BINARY AS #ff
3735.         GET #ff, , RH
3736.         IF RH.Identity <> "MAP3D" THEN PRINT "Unsupported MAP format.": EXIT SUB 'unsupported file format
3737.  
3738.  
3739.         SEEK #ff, RH.VertexStart + 1
3740.  
3741.         DIM W AS LONG, H AS LONG
3742.         GET #ff, , W
3743.         GET #ff, , H
3744.  
3745.         FAST_MAP_INFO& = _NEWIMAGE(W * 5, H * 5 + 70, 32)
3746.         pred = _DEST
3747.         _DEST FAST_MAP_INFO&
3748.         FOR Lx = 1 TO W
3749.             FOR Ly = 1 TO H
3750.                 GET #ff, , record&
3751.                 IF record& > -1 THEN
3752.                     LINE (Lx * 5, Ly * 5)-(Lx * 5 + 5, Ly * 5 + 5), _RGB32(255), BF
3753.                 END IF
3754.         NEXT Ly, Lx
3755.  
3756.  
3757.  
3758.         FOR Lx = 1 TO W
3759.             FOR Ly = 1 TO H
3760.                 GET #ff, , record&
3761.                 IF record& > -1 THEN
3762.                     IF POINT(Lx, Ly) <> _RGB32(255) THEN LINE (Lx * 5, Ly * 5)-(Lx * 5 + 5, Ly * 5 + 5), _RGB32(255, 255, 0), BF
3763.                 END IF
3764.         NEXT Ly, Lx
3765.  
3766.  
3767.         FOR Lx = 1 TO W
3768.             FOR Ly = 1 TO H
3769.                 GET #ff, , record&
3770.                 IF record& > -1 THEN
3771.                     LINE (Lx * 5, Ly * 5)-(Lx * 5 + 5, Ly * 5 + 5), _RGBA32(255, 0, 0, 50), BF
3772.                 END IF
3773.         NEXT Ly, Lx
3774.  
3775.         _PRINTMODE _KEEPBACKGROUND
3776.         COLOR _RGB32(100, 255, 255)
3777.  
3778.         _PRINTSTRING (10, H * 5 + 5), "Map contains" + STR$(RH.Nr_of_Textures) + " textures." 'pocet textur v souboru                                                4 B
3779.         _PRINTSTRING (10, H * 5 + 25), "Map use" + STR$(RH.Nr_of_Vertexes) + " objects." 'pocet vrcholu v souboru                                               4 B
3780.         _PRINTSTRING (10, H * 5 + 45), "MAP size:" + STR$(LOF(ff)) + " bytes."
3781.  
3782.  
3783.         _DEST pred
3784.     END IF
3785. END FUNCTION
3786.  
3787. FUNCTION IS_SUBSET (array() AS LONG, RangeAX, RangeAY) 'pokud pole obsahuje hodnotu v rozsahu od RangeAX, RangeAY do UBOUND1, UBOUND2, pak funkce vrati 1
3788.     MaxX = UBOUND(array, 1)
3789.     MaxY = UBOUND(array, 2)
3790.     MinX = LBOUND(array, 1)
3791.     MinY = LBOUND(array, 2)
3792.     IF RangeAX > MaxX OR RangeAY > MaxY THEN EXIT FUNCTION
3793.     IF RangeAX < MinX OR RangeAY < MinY THEN EXIT FUNCTION
3794.     FOR ty = RangeAY TO MaxY
3795.         FOR Tx = RangeAX TO MaxX
3796.             IF array(Tx, ty) THEN IS_SUBSET = 1: EXIT FUNCTION
3797.     NEXT Tx, ty
3798. END FUNCTION
3799.  
3800. '$include:'saveimage.bm'
3801. '$include:'editor.bm'
3802.  

And now a few words about the program to browse created maps. The command$ is used for simple operation. Just pass the map name (without the path) as a program parameter. For example, if you name the program 3DM and want to load the Demo000.map, type 3DM.EXE Demo000 and confirm. Navigate with the mouse and the arrow keys on the keyboard.

I left the opportunity to shoot a camera in the X, Y axis using S, X, for people who would like to write a flight simulator under this engine.

The program is also awaiting a huge upgrade - after reading the map, the future version will eliminate a number of elements on the map. In this form, as it is, it is very demanding for the computer, but this version so as it is, would easily allow the shooter to shoot anything. Including walls. A slight adjustment would be enough.


Program for browsing map in 3D (is also in ZIP file)

Code: QB64: [Select]

1.  
2. 'FOR SAVEMAP ----------------------------------
3. TYPE MAP_HEAD
4.     Identity AS STRING * 5
5.     Nr_of_Textures AS LONG
6.     Nr_of_Vertexes AS LONG
7.     DataStart AS LONG
8.     VertexStart AS LONG
9. END TYPE
10.  
11.  
12. TYPE Vertex
13.     Flag AS _UNSIGNED _BYTE
14.     X1 AS SINGLE
15.     Y1 AS SINGLE
16.     Z1 AS SINGLE
17.     X2 AS SINGLE
18.     Y2 AS SINGLE
19.     Z2 AS SINGLE
20.     X3 AS SINGLE
21.     Y3 AS SINGLE
22.     Z3 AS SINGLE
23.     X4 AS SINGLE
24.     Y4 AS SINGLE
25.     Z4 AS SINGLE
26.     Texture_Nr AS LONG
27. END TYPE
28.  
29.  
30.  
31.  
32. TYPE Object
33.  
34.     X AS SINGLE
35.     Y AS SINGLE
36.     Z AS SINGLE
37.  
38.     s AS LONG 'start record
39.     e AS LONG 'end record
40.     radius AS SINGLE
41.     radiusZ AS SINGLE
42.     PI AS SINGLE
43. END TYPE
44.  
45. TYPE mini
46.     L AS LONG
47.     Nr AS LONG
48. END TYPE
49.  
50. TYPE coordinates
51.     Xs AS LONG
52.     Ys AS LONG
53.     Xe AS LONG
54.     Ye AS LONG
55.     S AS LONG
56.     K AS LONG
57. END TYPE
58.  
59.  
60.  
61.  
62.  
63. REDIM SHARED ZDI(0) AS coordinates
64. REDIM SHARED MP(0) AS mini
65. REDIM SHARED OBJECT(0) AS Object
66.  
67.  
68. CONST CUBE = 1
69. CONST ZEM = 2
70. CONST ZED = 3
71. CONST ZIDLE = 4
72. CONST DOHLEDNOST = 60
73. CONST DRUNKMODE = 0 ' :-D Try set to 1, if you study this source
74.  
75.  
76.  
77.  
78. lX = 10: lY = 10: rXx = 310: rY = 10
79. ballX = 160: ballY = 10: mY = -1: IF RND * 10 > 5 THEN mX = 1 ELSE mX = -1
80. DIM SHARED dub AS LONG, aluminium AS LONG, radius AS DOUBLE
81.  
82. DIM SHARED RedColor AS LONG
83.  
84. tokno& = white
85. RedColor = RED
86.  
87.  
88.  
89.  
90. REDIM SHARED ColisMap(0, 0) AS LONG
91. DIM SHARED N
92. SCREEN _NEWIMAGE(_DESKTOPWIDTH, _DESKTOPHEIGHT, 32)
93.  
94. CX = 0: CY = 0: CZ = -1 '                                                          rotation center point - CAMERA
95.  
96.  
97.  
98. TYPE V
99.     X AS SINGLE '                                                                  source X points in standard view
100.     Y AS SINGLE '                                                                  source Y points in standard view
101.     Z AS SINGLE '                                                                  not use yet
102.     pi AS SINGLE '                                                                 start draw position on radius
103.     piH AS SINGLE '                                                                pi for point on circle circuit position for look up / dn
104.     piX AS SINGLE
105.     Radius AS SINGLE '                                                             radius (every point use own, but if is CX and CY in middle, are all the same)
106.     RadiusH AS SINGLE '                                                            radius floor / ceiling
107.     RadiusX AS SINGLE
108.     wX AS SINGLE '                                                                 working coordinates X
109.     wY AS SINGLE '                                                                 Y axis
110.     wZ AS SINGLE '                                                                 first Z. Used for view in previous program
111.     wZ2 AS SINGLE '                                                                second Z calculated from wZ
112.     T AS LONG '                                                                    texture number for current triangle
113.     Tm AS SINGLE '                                                                 texture multiplicier. 1 for one.
114. END TYPE
115.  
116. N = 0
117. DIM SHARED v(N) AS V
118. REDIM SHARED v2(0) AS V
119.  
120. DIM SHARED OldMouseX AS INTEGER, OldMouseY AS INTEGER
121. WHILE _MOUSEINPUT: WEND
122. _FULLSCREEN
123. _MOUSEMOVE _DESKTOPWIDTH / 2, _DESKTOPHEIGHT / 2
124. OldMouseX = _DESKTOPWIDTH / 2
125. OldMouseY = _DESKTOPHEIGHT / 2
126.  
127. _MOUSEHIDE
128.  
129.  
130. IF COMMAND$ <> "" THEN
131.     IF LCASE$(RIGHT$(COMMAND$, 4)) = ".map" THEN LOAD_MAP "map/" + COMMAND$ ELSE LOAD_MAP "map/" + COMMAND$ + ".map"
132. ELSE LOAD_MAP "map/demo000.map"
133. END IF
134.  
135.  
136. 'pro nacteni textur objektu pouzij PMF rozbalene do podslozky TEXTURES
137. REM kostka = NEWOBJECT(CUBE, 12, 0, 14)
138. REM zidle0 = NEWOBJECT(ZIDLE, 12, 0, 14)
139. REM zidle1 = NEWOBJECT(ZIDLE, 40, 1, 25)
140. REM zidle2 = NEWOBJECT(ZIDLE, 76, 0, 11)
141. REM XZ_ROTATE zidle2, 5
142.  
143. _DISPLAYORDER _HARDWARE , _SOFTWARE
144.  
145. 'on map start positions (PosY = 0)
146. posX = -5
147. posZ = -5
148.  
149.  
150. DO
151.  
152.     REM    room1Vol = VolumeAgent(12, 10, CX, CZ, 50)
153.     REM    _SNDVOL sount&, room1Vol
154.  
155.     REM IF room1Vol = 0 THEN _SNDVOL sount&, VolumeAgent(42, 20, CX, CZ, 50)
156.  
157.     IF DRUNKMODE THEN
158.         LOOPCOUNT = LOOPCOUNT + 1
159.         IF LOOPCOUNT MOD 2 = 0 THEN Select_Visible: LOOPCOUNT = 0
160.     ELSE
161.         Select_Visible
162.         IF Start = 0 THEN Find_Walls ZDI(): Start = 1
163.     END IF
164.  
165.  
166.     FOR r = LBOUND(v2) TO UBOUND(v2)
167.         LenX = v2(r).X - CX '                                                           calculate line lenght between CX and X - point (X1, X2...)
168.         LenY = v2(r).Y - CY
169.         LenZ = v2(r).Z - CZ '                                                           calculate line lenght between CY (center Y) and Y - point
170.  
171.         radius = SQR(LenX ^ 2 + LenZ ^ 2) '                                            calculate radius using Pythagoras
172.         radiusH = SQR(LenY ^ 2 + LenZ ^ 2)
173.         v2(r).Radius = radius
174.         v2(r).RadiusH = radiusH
175.         IF v2(r).pi = 0 THEN v2(r).pi = JK(CX, CZ, v2(r).X, v2(r).Z, radius) ' point on circle calculation based on binary circle    https://matematika.cz/jednotkova-kruznice,  this is for X / Z rotation
176.     NEXT r
177.  
178.     IF ABS(rot) > _PI(2) THEN rot = 0
179.  
180.     oldposZ = posZ
181.     oldposX = posX
182.  
183.  
184.  
185.  
186.     'upgrade: add mouse support!
187.     WHILE _MOUSEINPUT: WEND
188.     rot = rot + MOUSEMOVEMENTX / 20 '                                                      rot is move rotation X / Z
189.     roth = roth + MOUSEMOVEMENTY / 20 '
190.  
191.     IF roth > _PI / 3 THEN roth = _PI / 3 '                                                roth is rotation for Y / Z (look up and down)
192.     IF roth < -_PI / 3 THEN roth = -_PI / 3
193.  
194.  
195.     i$ = INKEY$
196.     SELECT CASE i$
197.         CASE CHR$(0) + CHR$(72): posZ = posZ + COS(rot) / 2: posX = posX - SIN(rot) / 2
198.         CASE CHR$(0) + CHR$(80): posZ = posZ - COS(rot) / 2: posX = posX + SIN(rot) / 2
199.         CASE CHR$(0) + CHR$(77): posZ = posZ + COS(rot + _PI / 2): posX = posX - SIN(rot + _PI / 2) ' sidestep
200.         CASE CHR$(0) + CHR$(75): posZ = posZ - COS(rot + _PI / 2): posX = posX + SIN(rot + _PI / 2) ' sidestep
201.  
202.         CASE "A", "a" '                look up/dn from keyboard
203.             roth = roth - .02
204.         CASE "Z", "z":
205.             roth = roth + .02
206.         CASE "S", "s": rotX = rotX - .02 ' rotace v ose X/Y
207.         CASE "X", "x": rotX = rotX + .02
208.         CASE CHR$(27): SYSTEM 'Destructor ("textures.pmf"): SYSTEM
209.     END SELECT
210.     IF _EXIT THEN SYSTEM 'Destructor ("textures.pmf")
211.     _KEYCLEAR
212.  
213.     'nova detekce kolize:
214.  
215.     'tohle na zdi necham, to funguje. Doplnim jeste nejakou obdelnikovou detekci pro konkretni objekty volane metodou NEWOBJECT
216.     IF ABS(posX) <> posX THEN
217.         IF ABS(posZ) <> posZ THEN
218.  
219.  
220.             IF oldposX > posX THEN xm = -.7
221.             IF oldposX < posX THEN xm = .7
222.             IF oldposZ > posZ THEN zm = -.7
223.             IF oldposZ < posZ THEN zm = .7
224.             ppx = _CEIL(ABS(posX + xm))
225.             ppy = _CEIL(ABS(posZ + zm))
226.  
227.  
228.             IF ppx > MAP_WIDTH THEN ppx = MAP_WIDTH: posX = oldposX
229.             IF ppy > MAP_HEIGHT THEN ppy = MAP_HEIGHT: posZ = oldposZ
230.  
231.  
232.  
233.             IF ColisMap(ppx, ppy) THEN posX = oldposX: posZ = oldposZ
234.         END IF
235.     END IF
236.  
237.     ggggg:
238.  
239.     IF _MOUSEBUTTON(1) THEN rot = rot - .02
240.     IF _MOUSEBUTTON(2) THEN rot = rot + .02
241.  
242.     CZ = -posZ 'This is very important. Note that you do not actually turn the camera in space, but you turn the space for camera.
243.     CX = -posX
244.     CY = -posy
245.  
246.  
247.     ' LOCATE 1, 1: PRINT MOUSEMOVEMENTX, MOUSEMOVEMENTY
248.  
249.     FOR r = LBOUND(v2) TO UBOUND(v2)
250.  
251.         x = CX + SIN(rot + v2(r).pi) * v2(r).Radius
252.         Z = CZ + COS(rot + v2(r).pi) * v2(r).Radius
253.         v2(r).wX = x + posX
254.         v2(r).wZ = Z '                   posZ is add later, after Z / Y calculation
255.         v2(r).wY = v2(r).Y + posy
256.  
257.  
258.         'STEP 2: rotate space for look to UP / DOWN (Z / Y) BUT USE CORRECT COORDINATES CALCULATED IN STEP 1 FOR ROTATION Z / X as in this program:
259.  
260.  
261.         LenY2 = v2(r).Y - CY
262.         LenZ2 = v2(r).wZ - CZ
263.  
264.         radiusH = SQR(LenY2 ^ 2 + LenZ2 ^ 2)
265.         v2(r).RadiusH = radiusH
266.         IF v2(r).piH = 0 THEN v2(r).piH = JK(CY, CZ, v2(r).Y, v2(r).wZ, radiusH) 'As you see here, JK! use previous calculated rotated coordinate wZ (working Z coordinate)
267.         z2 = CZ + COS(roth + v2(r).piH) * v2(r).RadiusH ' CX, CY, CZ is CAMERA. RadiusH is radius for point between floor and ceiling
268.         y2 = CY + SIN(roth + v2(r).piH) * v2(r).RadiusH
269.  
270.         'povolit, pokud je rotace jen Y/Z a X/Z
271.         v2(r).wY = y2 ' + posY      zakazano kvuli rotaci X/Y dal, jinak to povol a zakaz rotaci X/Y
272.         v2(r).wZ2 = z2 + posZ
273.  
274.         'extra - rotace X/Y (pro letecke simulatory napriklad):
275.  
276.         LenX3 = (v2(r).wX - posX) - CX
277.         LenY3 = v2(r).wY - CY
278.         radiusX = SQR(LenX3 ^ 2 + LenY3 ^ 2)
279.         v2(r).RadiusX = radiusX
280.         IF v2(r).piX = 0 THEN v2(r).piX = JK(CX, CY, (v2(r).wX - posX), (v2(r).wY), radiusX)
281.         x3 = CX + SIN(rotX + v2(r).piX) * v2(r).RadiusX
282.         y3 = CY + COS(rotX + v2(r).piX) * v2(r).RadiusX
283.  
284.         v2(r).wY = y3 + posy
285.         v2(r).wX = x3 + posX
286.         noX:
287.     NEXT r
288.     i$ = ""
289.  
290.  
291.     FOR zz = LBOUND(v2) + 1 TO UBOUND(v2) - 4 STEP 4
292.         IF v2(zz).T THEN
293.  
294.             img& = v2(zz).T
295.             w = _WIDTH(img&)
296.             h = _HEIGHT(img&)
297.             num = v2(zz).Tm
298.             IF num = 0 THEN num = 1
299.             _MAPTRIANGLE (0, h * num)-(w * num, h * num)-(0, 0), img& TO(v2(zz).wX, v2(zz).wY, v2(zz).wZ2)-(v2(zz + 1).wX, v2(zz + 1).wY, v2(zz + 1).wZ2)-(v2(zz + 2).wX, v2(zz + 2).wY, v2(zz + 2).wZ2), 0, _SMOOTHSHRUNK
300.             _MAPTRIANGLE (w * num, h * num)-(0, 0)-(w * num, 0), img& TO(v2(zz + 1).wX, v2(zz + 1).wY, v2(zz + 1).wZ2)-(v2(zz + 2).wX, v2(zz + 2).wY, v2(zz + 2).wZ2)-(v2(zz + 3).wX, v2(zz + 3).wY, v2(zz + 3).wZ2), 0, _SMOOTHSHRUNK
301.         END IF
302.     NEXT zz
303.  
304.  
305.     LINE (0, _DESKTOPHEIGHT)-(_DESKTOPWIDTH, _DESKTOPHEIGHT - 100), _RGB32(50, 50, 0), BF
306.  
307.  
308.     _DISPLAY
309. LOOP
310.  
311.  
312.  
313. SUB Select_Visible
314.     SHARED posX, posy, posZ, CX, CZ, rot, SEEZ
315.     i = 0: REDIM v2(0) AS V: j = 0
316.     T = TIMER
317.     REDIM V3(0) AS V
318.     REDIM MP(0) AS mini, v3 AS LONG
319.     DIM J AS LONG, I2 AS LONG, F AS LONG, DELTA AS LONG, mpi AS LONG, LenghtControl AS LONG ', LenX AS SINGLE, LenZ AS SINGLE, Lx AS SINGLE, L AS SINGLE, pi AS SINGLE, rCX AS LONG, rCZ AS LONG
320.  
321.     FOR F = LBOUND(object) + 1 TO UBOUND(object)
322.         LenX = OBJECT(F).X - CX
323.         LenZ = OBJECT(F).Z - CZ
324.         Lx = LenX * 1.7
325.         L = SQR(LenX ^ 2 + LenZ ^ 2)
326.         pi = JK!(CX, CZ, OBJECT(F).X, OBJECT(F).Z, L)
327.         rCX = OBJECT(F).X + SIN(rot + pi) * L
328.         rCZ = OBJECT(F).Z + COS(rot + pi) * L
329.  
330.         IF SQR((Lx * Lx) + (LenZ * LenZ)) < DOHLEDNOST THEN 'kruhova detekce
331.             i3 = UBOUND(v2)
332.             DELTA = OBJECT(F).e - OBJECT(F).s + 1
333.             IF DELTA > 1 THEN
334.                 IF OBJECT(F).Z >= rCZ - 1 THEN
335.                     IF ABS(OBJECT(F).X - rCX) < DOHLEDNOST / 3 THEN
336.                         work = 1
337.                         IF work THEN
338.                             REDIM _PRESERVE v2(i3 + DELTA) AS V
339.  
340.                             J = (UBOUND(v2) - DELTA) + 1
341.                             Vzd = SQR(LenX * LenX + LenZ * LenZ)
342.  
343.                             REDIM _PRESERVE MP(mpi) AS mini
344.                             MP(mpi).Nr = F
345.                             MP(mpi).L = Vzd
346.                             mpi = mpi + 1
347.                             sh = 0
348.  
349.                             FOR I2 = OBJECT(F).s TO OBJECT(F).e
350.                                 v2(J).X = v(I2).X
351.                                 v2(J).Y = v(I2).Y
352.                                 v2(J).Z = v(I2).Z
353.                                 v2(J).pi = v(I2).pi
354.                                 v2(J).piH = v(I2).piH
355.                                 v2(J).piX = v(I2).piX
356.                                 v2(J).Radius = v(I2).Radius
357.                                 v2(J).RadiusH = v(I2).RadiusH
358.                                 v2(J).RadiusX = v(I2).RadiusX
359.                                 v2(J).wX = v(I2).wX
360.                                 v2(J).wY = v(I2).wY
361.                                 v2(J).wZ = v(I2).wZ
362.                                 v2(J).wZ2 = v(I2).wZ2
363.                                 v2(J).T = v(I2).T
364.                                 v2(J).Tm = v(I2).Tm
365.                                 J = J + 1
366.                             NEXT ' i2
367.  
368.                         END IF
369.                         skp:
370.                         u = u + 1
371.                     ELSE
372.                         unused = unused + 1
373.  
374.                     END IF
375.                 ELSE unused = unused + 1
376.  
377.  
378.                 END IF
379.             END IF
380.         END IF
381.     NEXT F
382.     LOCATE 2
383.     dofiltruj
384. END SUB
385.  
386.  
387.  
388.  
389.  
390. SUB dofiltruj
391.     EXIT SUB
392.     DIM A AS LONG, B AS LONG, I2 AS LONG, J AS LONG
393.     FOR A = LBOUND(mp) TO UBOUND(mp)
394.         PosZ = OBJECT(MP(A).Nr).Z
395.         Posx = OBJECT(MP(A).Nr).X
396.         L = MP(A).L
397.  
398.         pass = 0
399.         FOR B = LBOUND(mp) TO UBOUND(mp)
400.             PosZ2 = OBJECT(MP(B).Nr).Z
401.             Posx2 = OBJECT(MP(B).Nr).X
402.             LL = MP(B).L
403.  
404.             IF PosZ = PosZ2 AND Posx = Posx2 THEN
405.                 IF L <= LL THEN pass = A
406.             END IF
407.         NEXT B
408.  
409.         IF pass THEN
410.             FOR I2 = OBJECT(MP(pass).Nr).s TO OBJECT(MP(pass).Nr).e
411.                 J = J + 1
412.                 REDIM _PRESERVE v2(J) AS V
413.                 v2(J).X = v(I2).X
414.                 v2(J).Y = v(I2).Y
415.                 v2(J).Z = v(I2).Z
416.                 v2(J).pi = v(I2).pi
417.                 v2(J).piH = v(I2).piH
418.                 v2(J).piX = v(I2).piX
419.                 v2(J).Radius = v(I2).Radius
420.                 v2(J).RadiusH = v(I2).RadiusH
421.                 v2(J).RadiusX = v(I2).RadiusX
422.                 v2(J).wX = v(I2).wX
423.                 v2(J).wY = v(I2).wY
424.                 v2(J).wZ = v(I2).wZ
425.                 v2(J).wZ2 = v(I2).wZ2
426.                 v2(J).T = v(I2).T
427.                 v2(J).Tm = v(I2).Tm
428.             NEXT ' i2
429.         END IF
430.  
431.     NEXT A
432.     LOCATE 1, 1
433. END SUB
434.  
435.  
436. SUB Set_texture (num, start, eend, much)
437.     FOR s = start TO eend
438.         v(s).T = num
439.         v(s).Tm = much
440.     NEXT s
441. END SUB
442.  
443. FUNCTION Hload& (fileName AS STRING)
444.     h& = _LOADIMAGE(fileName$, 32)
445.     Hload& = _COPYIMAGE(h&, 33)
446.     _FREEIMAGE h&
447. END FUNCTION
448.  
449. FUNCTION SHload& (fileName AS STRING)
450.     h& = _LOADIMAGE(fileName$, 32)
451.     _SETALPHA 0, _RGB32(255, 255, 255) TO _RGB32(200, 200, 200), h&
452.     SHload& = _COPYIMAGE(h&, 33)
453.     _FREEIMAGE h&
454. END FUNCTION
455.  
456.  
457.  
458. FUNCTION JK! (cx, cy, px, py, R!)
459.     LenX! = cx - px
460.     LenY! = cy - py
461.     jR! = 1 / R!
462.  
463.     jX! = LenX! * jR!
464.     jY! = LenY! * jR!
465.  
466.     sinusAlfa! = jX!
467.     Alfa! = ABS(_ASIN(sinusAlfa!))
468.  
469.     Q = 1
470.     IF px >= cx AND py >= cy THEN Q = 1 ' select angle to quadrant
471.     IF px >= cx AND py <= cy THEN Q = 2
472.     IF px <= cx AND py <= cy THEN Q = 3
473.     IF px <= cx AND py >= cy THEN Q = 4
474.     SELECT CASE Q
475.         CASE 1: alfaB! = Alfa!
476.         CASE 2: alfaB! = _PI / 2 + (_PI / 2 - Alfa!)
477.         CASE 3: alfaB! = _PI + Alfa!
478.         CASE 4: alfaB! = _PI(1.5) + (_PI / 2 - Alfa!)
479.     END SELECT
480.     JK! = alfaB!
481.     IF JK! = 0 THEN BEEP
482. END FUNCTION
483.  
484.  
485. FUNCTION MOUSEMOVEMENTX
486.     SELECT CASE OldMouseX
487.         CASE IS > _MOUSEX: MOUSEMOVEMENTX = -1: _MOUSEMOVE OldMouseX, OldMouseY '= _MOUSEX
488.         CASE IS < _MOUSEX: MOUSEMOVEMENTX = 1: _MOUSEMOVE OldMouseX, OldMouseY '= _MOUSEX
489.         CASE ELSE: MOUSEMOVEMENTX = 0
490.     END SELECT
491. END FUNCTION
492.  
493. FUNCTION MOUSEMOVEMENTY
494.     SELECT CASE OldMouseY
495.         CASE IS > _MOUSEY: MOUSEMOVEMENTY = -1: _MOUSEMOVE OldMouseX, OldMouseY ' = _MOUSEY
496.         CASE IS < _MOUSEY: MOUSEMOVEMENTY = 1: _MOUSEMOVE OldMouseX, OldMouseY '= _MOUSEY
497.         CASE ELSE: MOUSEMOVEMENTY = 0
498.     END SELECT
499. END FUNCTION
500.  
501.  
502.  
503. SUB O_WALL (x, z, texture AS LONG, Wall_Typ)
504.     i = UBOUND(v)
505.     'pridam to jako objekt do pole objektu (modernizce 1B)
506.  
507.     SELECT CASE Wall_Typ 'urceni poctu vrcholu podle typu zdi
508.         CASE 1: Vr = 16 'samostatny blok zdi
509.         CASE 2, 3, 4, 5: Vr = 12
510.         CASE 6, 7: Vr = 8
511.         CASE 8: EXIT SUB
512.     END SELECT
513.  
514.     io = UBOUND(object) + 1
515.     REDIM _PRESERVE OBJECT(io) AS Object
516.     OBJECT(io).s = i + 1
517.     OBJECT(io).e = i + Vr
518.     OBJECT(io).X = x
519.     OBJECT(io).Y = 0
520.     OBJECT(io).Z = z '
521.     OBJECT(io).radius = SQR(0.5 ^ 2 + 0.5 ^ 2)
522.  
523.  
524.  
525.     REDIM _PRESERVE v(i + 16) AS V
526.     SELECT CASE Wall_Typ
527.         CASE 1
528.  
529.             v(i + 1).X = -.5 + x
530.             v(i + 1).Y = -2
531.             v(i + 1).Z = .5 + z
532.  
533.             v(i + 2).X = .5 + x
534.             v(i + 2).Y = -2
535.             v(i + 2).Z = .5 + z
536.  
537.             v(i + 3).X = -.5 + x
538.             v(i + 3).Y = 2
539.             v(i + 3).Z = .5 + z
540.  
541.             v(i + 4).X = .5 + x
542.             v(i + 4).Y = 2
543.             v(i + 4).Z = .5 + z
544.  
545.  
546.             'zadni stena
547.             v(i + 5).X = -.5 + x
548.             v(i + 5).Y = -2
549.             v(i + 5).Z = z - .5
550.  
551.             v(i + 6).X = .5 + x
552.             v(i + 6).Y = -2
553.             v(i + 6).Z = z - .5
554.  
555.             v(i + 7).X = -.5 + x
556.             v(i + 7).Y = 2
557.             v(i + 7).Z = z - .5
558.  
559.             v(i + 8).X = .5 + x
560.             v(i + 8).Y = 2
561.             v(i + 8).Z = z - .5
562.  
563.             'levy bok
564.             v(i + 9).X = .5 + x
565.             v(i + 9).Y = -2
566.             v(i + 9).Z = z + .5
567.  
568.             v(i + 10).X = .5 + x
569.             v(i + 10).Y = -2
570.             v(i + 10).Z = z - .5
571.  
572.             v(i + 11).X = .5 + x
573.             v(i + 11).Y = 2
574.             v(i + 11).Z = z + .5
575.  
576.             v(i + 12).X = .5 + x
577.             v(i + 12).Y = 2
578.             v(i + 12).Z = z - .5
579.  
580.             'pravy bok
581.             v(i + 13).X = -.5 + x
582.             v(i + 13).Y = -2
583.             v(i + 13).Z = z + .5
584.  
585.             v(i + 14).X = -.5 + x
586.             v(i + 14).Y = -2
587.             v(i + 14).Z = z - .5
588.  
589.             v(i + 15).X = -.5 + x
590.             v(i + 15).Y = 2
591.             v(i + 15).Z = z + .5
592.  
593.             v(i + 16).X = -.5 + x
594.             v(i + 16).Y = 2
595.             v(i + 16).Z = z - .5
596.  
597.         CASE 2 'ok!
598.  
599.             'predni stena
600.             v(i + 1).X = .5 + x
601.             v(i + 1).Y = -2
602.             v(i + 1).Z = .5 + z
603.  
604.             v(i + 2).X = -.5 + x
605.             v(i + 2).Y = -2
606.             v(i + 2).Z = .5 + z
607.  
608.             v(i + 3).X = .5 + x
609.             v(i + 3).Y = 2
610.             v(i + 3).Z = .5 + z
611.  
612.             v(i + 4).X = -.5 + x
613.             v(i + 4).Y = 2
614.             v(i + 4).Z = .5 + z
615.  
616.  
617.             'zadni stena
618.             v(i + 5).X = .5 + x
619.             v(i + 5).Y = -2
620.             v(i + 5).Z = z - .5
621.  
622.             v(i + 6).X = -.5 + x
623.             v(i + 6).Y = -2
624.             v(i + 6).Z = z - .5
625.  
626.             v(i + 7).X = .5 + x
627.             v(i + 7).Y = 2
628.             v(i + 7).Z = z - .5
629.  
630.             v(i + 8).X = -.5 + x
631.             v(i + 8).Y = 2
632.             v(i + 8).Z = z - .5
633.  
634.             'levy bok asi
635.             v(i + 9).X = .5 + x
636.             v(i + 9).Y = -2
637.             v(i + 9).Z = z + .5
638.  
639.             v(i + 10).X = .5 + x
640.             v(i + 10).Y = -2
641.             v(i + 10).Z = z - .5
642.  
643.             v(i + 11).X = .5 + x
644.             v(i + 11).Y = 2
645.             v(i + 11).Z = z + .5
646.  
647.             v(i + 12).X = .5 + x
648.             v(i + 12).Y = 2
649.             v(i + 12).Z = z - .5
650.  
651.  
652.         CASE 3
653.  
654.  
655.             v(i + 1).X = .5 + x
656.             v(i + 1).Y = -2
657.             v(i + 1).Z = z + .5
658.  
659.             v(i + 2).X = .5 + x
660.             v(i + 2).Y = -2
661.             v(i + 2).Z = z - .5
662.  
663.             v(i + 3).X = .5 + x
664.             v(i + 3).Y = 2
665.             v(i + 3).Z = z + .5
666.  
667.             v(i + 4).X = .5 + x
668.             v(i + 4).Y = 2
669.             v(i + 4).Z = z - .5
670.  
671.             'pravy bok
672.             v(i + 5).X = -.5 + x
673.             v(i + 5).Y = -2
674.             v(i + 5).Z = z + .5
675.  
676.             v(i + 6).X = -.5 + x
677.             v(i + 6).Y = -2
678.             v(i + 6).Z = z - .5
679.  
680.             v(i + 7).X = -.5 + x
681.             v(i + 7).Y = 2
682.             v(i + 7).Z = z + .5
683.  
684.             v(i + 8).X = -.5 + x
685.             v(i + 8).Y = 2
686.             v(i + 8).Z = z - .5
687.  
688.             'predni stena
689.             v(i + 9).X = .5 + x
690.             v(i + 9).Y = -2
691.             v(i + 9).Z = .5 + z
692.  
693.             v(i + 10).X = -.5 + x
694.             v(i + 10).Y = -2
695.             v(i + 10).Z = .5 + z
696.  
697.             v(i + 11).X = .5 + x
698.             v(i + 11).Y = 2
699.             v(i + 11).Z = .5 + z
700.  
701.             v(i + 12).X = -.5 + x
702.             v(i + 12).Y = 2
703.             v(i + 12).Z = .5 + z
704.  
705.  
706.         CASE 4
707.  
708.             v(i + 1).X = .5 + x
709.             v(i + 1).Y = -2
710.             v(i + 1).Z = .5 + z
711.  
712.             v(i + 2).X = -.5 + x
713.             v(i + 2).Y = -2
714.             v(i + 2).Z = .5 + z
715.  
716.             v(i + 3).X = .5 + x
717.             v(i + 3).Y = 2
718.             v(i + 3).Z = .5 + z
719.  
720.             v(i + 4).X = -.5 + x
721.             v(i + 4).Y = 2
722.             v(i + 4).Z = .5 + z
723.  
724.  
725.             'zadni stena
726.             v(i + 5).X = .5 + x
727.             v(i + 5).Y = -2
728.             v(i + 5).Z = z - .5
729.  
730.             v(i + 6).X = -.5 + x
731.             v(i + 6).Y = -2
732.             v(i + 6).Z = z - .5
733.  
734.             v(i + 7).X = .5 + x
735.             v(i + 7).Y = 2
736.             v(i + 7).Z = z - .5
737.  
738.             v(i + 8).X = -.5 + x
739.             v(i + 8).Y = 2
740.             v(i + 8).Z = z - .5
741.  
742.             'pravy bok
743.             v(i + 9).X = -.5 + x
744.             v(i + 9).Y = -2
745.             v(i + 9).Z = z + .5
746.  
747.             v(i + 10).X = -.5 + x
748.             v(i + 10).Y = -2
749.             v(i + 10).Z = z - .5
750.  
751.             v(i + 11).X = -.5 + x
752.             v(i + 11).Y = 2
753.             v(i + 11).Z = z + .5
754.  
755.             v(i + 12).X = -.5 + x
756.             v(i + 12).Y = 2
757.             v(i + 12).Z = z - .5
758.  
759.         CASE 5
760.  
761.             v(i + 1).X = .5 + x
762.             v(i + 1).Y = -2
763.             v(i + 1).Z = z + .5
764.  
765.             v(i + 2).X = .5 + x
766.             v(i + 2).Y = -2
767.             v(i + 2).Z = z - .5
768.  
769.             v(i + 3).X = .5 + x
770.             v(i + 3).Y = 2
771.             v(i + 3).Z = z + .5
772.  
773.             v(i + 4).X = .5 + x
774.             v(i + 4).Y = 2
775.             v(i + 4).Z = z - .5
776.  
777.             'pravy bok
778.             v(i + 5).X = -.5 + x
779.             v(i + 5).Y = -2
780.             v(i + 5).Z = z + .5
781.  
782.             v(i + 6).X = -.5 + x
783.             v(i + 6).Y = -2
784.             v(i + 6).Z = z - .5
785.  
786.             v(i + 7).X = -.5 + x
787.             v(i + 7).Y = 2
788.             v(i + 7).Z = z + .5
789.  
790.             v(i + 8).X = -.5 + x
791.             v(i + 8).Y = 2
792.             v(i + 8).Z = z - .5
793.  
794.             'zadni stena
795.             v(i + 9).X = .5 + x
796.             v(i + 9).Y = -2
797.             v(i + 9).Z = z - .5
798.  
799.             v(i + 10).X = -.5 + x
800.             v(i + 10).Y = -2
801.             v(i + 10).Z = z - .5
802.  
803.             v(i + 11).X = .5 + x
804.             v(i + 11).Y = 2
805.             v(i + 11).Z = z - .5
806.  
807.             v(i + 12).X = -.5 + x
808.             v(i + 12).Y = 2
809.             v(i + 12).Z = z - .5
810.  
811.  
812.  
813.  
814.  
815.  
816.  
817.  
818.  
819.         CASE 6
820.             'texturovani opraveno
821.             'levy bok
822.             v(i + 1).X = .5 + x
823.             v(i + 1).Y = -2
824.             v(i + 1).Z = z + .5
825.  
826.             v(i + 2).X = .5 + x
827.             v(i + 2).Y = -2
828.             v(i + 2).Z = z - .5
829.  
830.             v(i + 3).X = .5 + x
831.             v(i + 3).Y = 2
832.             v(i + 3).Z = z + .5
833.  
834.             v(i + 4).X = .5 + x
835.             v(i + 4).Y = 2
836.             v(i + 4).Z = z - .5
837.  
838.             'pravy bok
839.             v(i + 5).X = -.5 + x
840.             v(i + 5).Y = -2
841.             v(i + 5).Z = z + .5
842.  
843.             v(i + 6).X = -.5 + x
844.             v(i + 6).Y = -2
845.             v(i + 6).Z = z - .5
846.  
847.             v(i + 7).X = -.5 + x
848.             v(i + 7).Y = 2
849.             v(i + 7).Z = z + .5
850.  
851.             v(i + 8).X = -.5 + x
852.             v(i + 8).Y = 2
853.             v(i + 8).Z = z - .5
854.  
855.  
856.  
857.  
858.  
859.         CASE 7 'testovano, ok
860.             'asi predek
861.  
862.             v(i + 1).X = .5 + x
863.             v(i + 1).Y = -2
864.             v(i + 1).Z = .5 + z
865.  
866.             v(i + 2).X = -.5 + x
867.             v(i + 2).Y = -2
868.             v(i + 2).Z = .5 + z
869.  
870.             v(i + 3).X = .5 + x
871.             v(i + 3).Y = 2
872.             v(i + 3).Z = .5 + z
873.  
874.             v(i + 4).X = -.5 + x
875.             v(i + 4).Y = 2
876.             v(i + 4).Z = .5 + z
877.  
878.  
879.             'zadni stena
880.             v(i + 5).X = .5 + x
881.             v(i + 5).Y = -2
882.             v(i + 5).Z = z - .5
883.  
884.             v(i + 6).X = -.5 + x
885.             v(i + 6).Y = -2
886.             v(i + 6).Z = z - .5
887.  
888.             v(i + 7).X = .5 + x
889.             v(i + 7).Y = 2
890.             v(i + 7).Z = z - .5
891.  
892.             v(i + 8).X = -.5 + x
893.             v(i + 8).Y = 2
894.             v(i + 8).Z = z - .5
895.  
896.  
897.  
898.     END SELECT
899.  
900.     Set_texture texture&, i + 1, i + 16, 1
901.     N = N + 16
902. END SUB
903.  
904.  
905. SUB O_FLOOR (x, z, texture AS LONG)
906.     i = UBOUND(v)
907.  
908.     'pridat jako objekt
909.     io = UBOUND(object) + 1
910.     REDIM _PRESERVE OBJECT(io) AS Object
911.     OBJECT(io).s = i + 1 '         startovni pozice v poli V
912.     OBJECT(io).e = i + 4 '         koncova pozice v poli V
913.     OBJECT(io).X = x '             pozice podlahove krychle
914.     OBJECT(io).Y = y
915.     OBJECT(io).Z = z '
916.     OBJECT(io).radius = SQR(0.5 ^ 2 + 0.5 ^ 2)
917.     REDIM _PRESERVE v(i + 4) AS V
918.     'dno
919.  
920.     v(i + 1).X = -.5 + x
921.     v(i + 1).Y = -2
922.     v(i + 1).Z = z + .5
923.  
924.     v(i + 2).X = .5 + x
925.     v(i + 2).Y = -2
926.     v(i + 2).Z = z + .5
927.  
928.     v(i + 3).X = -.5 + x
929.     v(i + 3).Y = -2
930.     v(i + 3).Z = z - .5
931.  
932.     v(i + 4).X = .5 + x
933.     v(i + 4).Y = -2
934.     v(i + 4).Z = z - .5
935.  
936.     Set_texture texture&, i + 1, i + 4, 1
937.     N = N + 4
938. END SUB
939.  
940. SUB O_CEILING (x, z, texture AS LONG)
941.     i = UBOUND(v)
942.  
943.     'pridat jako objekt
944.     io = UBOUND(object) + 1
945.     REDIM _PRESERVE OBJECT(io) AS Object
946.     OBJECT(io).s = i + 1 '         startovni pozice v poli V
947.     OBJECT(io).e = i + 4 '         koncova pozice v poli V
948.     OBJECT(io).X = x '             pozice podlahove krychle
949.     OBJECT(io).Y = y
950.     OBJECT(io).Z = z '
951.     OBJECT(io).radius = SQR(0.5 ^ 2 + 0.5 ^ 2)
952.  
953.     REDIM _PRESERVE v(i + 4) AS V
954.     'dno
955.  
956.     v(i + 1).X = .5 + x
957.     v(i + 1).Y = 2
958.     v(i + 1).Z = z + .5
959.  
960.     v(i + 2).X = -.5 + x
961.     v(i + 2).Y = 2
962.     v(i + 2).Z = z + .5
963.  
964.     v(i + 3).X = .5 + x
965.     v(i + 3).Y = 2
966.     v(i + 3).Z = z - .5
967.  
968.     v(i + 4).X = -.5 + x
969.     v(i + 4).Y = 2
970.     v(i + 4).Z = z - .5
971.  
972.     Set_texture texture&, i + 1, i + 4, 1
973.     N = N + 4
974. END SUB
975.  
976.  
977. SUB XY_ROTATE (object_nr AS LONG, angle)
978.     start = OBJECT(object_nr).s
979.     eend = OBJECT(object_nr).e
980.     x = OBJECT(object_nr).X
981.     y = OBJECT(object_nr).Y
982.     z = OBJECT(object_nr).Z
983.  
984.     radius = OBJECT(object_nr).radius 'SQR((v(start).X - x) ^ 2 + (v(start).Y - y) ^ 2)
985.  
986.  
987.  
988.     FOR rot = start TO eend
989.         s = JK(x, y, v(rot).X, (v(rot).Y), radius)
990.         v(rot).X = x + (SIN(angle + s) * radius)
991.         v(rot).Y = y + (COS(angle + s) * radius)
992.     NEXT rot
993. END SUB
994.  
995. SUB XZ_ROTATE (object_nr AS LONG, angle)
996.     start = OBJECT(object_nr).s
997.     eend = OBJECT(object_nr).e
998.     x = OBJECT(object_nr).X
999.     y = OBJECT(object_nr).Y
1000.     z = OBJECT(object_nr).Z
1001.     radius = OBJECT(object_nr).radius
1002.     FOR rot = start TO eend
1003.         s = JK(x, z, v(rot).X, (v(rot).Z), radius)
1004.         v(rot).X = x + (SIN(angle + s) * radius)
1005.         v(rot).Z = z + (COS(angle + s) * radius)
1006.     NEXT rot
1007. END SUB
1008.  
1009. SUB YZ_ROTATE (object_nr AS LONG, angle)
1010.     start = OBJECT(object_nr).s
1011.     eend = OBJECT(object_nr).e
1012.     x = OBJECT(object_nr).X
1013.     y = OBJECT(object_nr).Y
1014.     z = OBJECT(object_nr).Z
1015.     radius = OBJECT(object_nr).radius
1016.     FOR rot = start TO eend
1017.         s = JK(y, z, v(rot).Y, (v(rot).Z), radius)
1018.         v(rot).Y = y + (SIN(angle + s) * radius)
1019.         v(rot).Z = z + (COS(angle + s) * radius)
1020.     NEXT rot
1021. END SUB
1022.  
1023. FUNCTION IS_VISIBLE (object_nr)
1024.     SHARED posZ, posX
1025.     lenx = ABS(posX) - ABS(OBJECT(object_nr).X)
1026.     lenZ = ABS(posZ) - ABS(OBJECT(object_nr).Z)
1027.     IF SQR((lenx ^ 2) + (lenZ ^ 2)) < DOHLEDNOST THEN IS_VISIBLE = 1 ELSE IS_VISIBLE = 0
1028. END FUNCTION
1029.  
1030.  
1031. SUB WALLZ (x1 AS SINGLE, y1 AS SINGLE, z1 AS SINGLE, x2 AS SINGLE, y2 AS SINGLE, z2 AS SINGLE)
1032.     SHARED dlazba&
1033.     i = UBOUND(v)
1034.     REDIM _PRESERVE v(i + 24) AS V
1035.     'predni stena
1036.  
1037.     v(i + 1).X = x1
1038.     v(i + 1).Y = y1
1039.     v(i + 1).Z = z1
1040.  
1041.     v(i + 2).X = x2
1042.     v(i + 2).Y = y1
1043.     v(i + 2).Z = z1
1044.  
1045.     v(i + 3).X = x1
1046.     v(i + 3).Y = y2
1047.     v(i + 3).Z = z1
1048.  
1049.     v(i + 4).X = x2
1050.     v(i + 4).Y = y2
1051.     v(i + 4).Z = z1
1052.  
1053.  
1054.     'zadni stena
1055.     v(i + 5).X = x1
1056.     v(i + 5).Y = y1
1057.     v(i + 5).Z = z2
1058.  
1059.     v(i + 6).X = x2
1060.     v(i + 6).Y = y1
1061.     v(i + 6).Z = z2
1062.  
1063.     v(i + 7).X = x1
1064.     v(i + 7).Y = y2
1065.     v(i + 7).Z = z2
1066.  
1067.     v(i + 8).X = x2
1068.     v(i + 8).Y = y2
1069.     v(i + 8).Z = z2
1070.  
1071.     'dno - spoj zdi v podlaze
1072.  
1073.     v(i + 9).X = x1
1074.     v(i + 9).Y = y1
1075.     v(i + 9).Z = z1
1076.  
1077.     v(i + 10).X = x2
1078.     v(i + 10).Y = y1
1079.     v(i + 10).Z = z1
1080.  
1081.     v(i + 11).X = x1
1082.     v(i + 11).Y = y1
1083.     v(i + 11).Z = z2
1084.  
1085.     v(i + 12).X = x2
1086.     v(i + 12).Y = y1
1087.     v(i + 12).Z = z2
1088.  
1089.     'vrch - horni spoj zdi
1090.  
1091.     v(i + 13).X = x1
1092.     v(i + 13).Y = y2
1093.     v(i + 13).Z = z1
1094.  
1095.     v(i + 14).X = x2
1096.     v(i + 14).Y = y2
1097.     v(i + 14).Z = z1
1098.  
1099.     v(i + 15).X = x1
1100.     v(i + 15).Y = y2
1101.     v(i + 15).Z = z2
1102.  
1103.     v(i + 16).X = x2
1104.     v(i + 16).Y = y2
1105.     v(i + 16).Z = z2
1106.  
1107.     'levy bok
1108.     v(i + 17).X = x2
1109.     v(i + 17).Y = y1
1110.     v(i + 17).Z = z1
1111.  
1112.     v(i + 18).X = x2
1113.     v(i + 18).Y = y1
1114.     v(i + 18).Z = z2
1115.  
1116.     v(i + 19).X = x2
1117.     v(i + 19).Y = y2
1118.     v(i + 19).Z = z1
1119.  
1120.     v(i + 20).X = x2
1121.     v(i + 20).Y = y2
1122.     v(i + 20).Z = z2
1123.  
1124.     'pravy bok
1125.     v(i + 21).X = x1
1126.     v(i + 21).Y = y1
1127.     v(i + 21).Z = z1
1128.  
1129.     v(i + 22).X = x1
1130.     v(i + 22).Y = y1
1131.     v(i + 22).Z = z2
1132.  
1133.     v(i + 23).X = x1
1134.     v(i + 23).Y = y2
1135.     v(i + 23).Z = z1
1136.  
1137.     v(i + 24).X = x1
1138.     v(i + 24).Y = y2
1139.     v(i + 24).Z = z2
1140.  
1141.  
1142.  
1143.     N = N + 24
1144.     Set_texture dlazba&, i + 1, i + 24, 10
1145.  
1146. END SUB
1147.  
1148.  
1149. SUB LOAD_MAP (filename AS STRING)
1150.     IF _FILEEXISTS(filename) THEN
1151.         DIM RH AS MAP_HEAD
1152.         DIM Vertex AS Vertex
1153.  
1154.         ff = FREEFILE
1155.         OPEN filename$ FOR BINARY AS #ff
1156.         GET #ff, , RH
1157.         IF RH.Identity <> "MAP3D" THEN EXIT SUB 'unsupported file format
1158.         DIM FileNamesLenght(RH.Nr_of_Textures) AS LONG
1159.         FOR R = 1 TO RH.Nr_of_Textures
1160.             GET #ff, , FileNamesLenght(R)
1161.         NEXT R
1162.  
1163.  
1164.         DIM FileSize(RH.Nr_of_Textures) AS LONG
1165.         FOR R = 1 TO RH.Nr_of_Textures
1166.             GET #ff, , FileSize(R)
1167.         NEXT R
1168.  
1169.  
1170.         DIM FileName(RH.Nr_of_Textures) AS STRING
1171.         FOR R = 1 TO RH.Nr_of_Textures
1172.             FileName(R) = SPACE$(FileNamesLenght(R))
1173.             GET #ff, , FileName(R)
1174.         NEXT R
1175.  
1176.         SP$ = "SWAPP\"
1177.  
1178.         IF _DIREXISTS("SWAPP") = 0 THEN MKDIR "SWAPP"
1179.  
1180.         FOR R = 1 TO RH.Nr_of_Textures
1181.             ff2 = FREEFILE
1182.  
1183.             OPEN SP$ + FileName(R) FOR OUTPUT AS #ff2
1184.             CLOSE #ff2
1185.             OPEN SP$ + FileName(R) FOR BINARY AS #ff2
1186.             record$ = SPACE$(FileSize(R))
1187.             GET #ff, , record$
1188.             PUT #ff2, , record$
1189.             record$ = ""
1190.             CLOSE #ff2
1191.         NEXT R
1192.  
1193.         REDIM textures(RH.Nr_of_Textures) AS LONG
1194.  
1195.         FOR R = 1 TO RH.Nr_of_Textures
1196.             textures(R) = Hload(SP$ + FileName(R)) 'index udava poradi textury v souboru, pridano SP$
1197.         NEXT R
1198.  
1199.         DIM W AS LONG, H AS LONG
1200.         GET #ff, , W
1201.         GET #ff, , H
1202.  
1203.         SHARED MAP_WIDTH, MAP_HEIGHT
1204.         MAP_WIDTH = W
1205.         MAP_HEIGHT = H
1206.  
1207.         REDIM ColisMap(W, H) AS LONG
1208.         FOR Ly = 0 TO H - 1
1209.             FOR Lx = 0 TO W - 1
1210.  
1211.                 GET #ff, , record&
1212.                 IF record& > -1 THEN
1213.                     REDIM _PRESERVE recs(reci) AS LONG
1214.                     recs(reci) = record&
1215.                     reci = reci + 1
1216.                     ColisMap(Lx, Ly) = 1
1217.                 END IF
1218.         NEXT Lx, Ly
1219.  
1220.         reci = 0
1221.         FOR Ly = 0 TO H - 1
1222.             FOR Lx = 0 TO W - 1
1223.                 IF ColisMap(Lx, Ly) THEN
1224.                     O_WALL Lx, Ly, textures(recs(reci)), WALL_TYPE(ColisMap(), Lx, Ly)
1225.                     reci = reci + 1
1226.                 END IF
1227.         NEXT Lx, Ly
1228.         ERASE recs
1229.  
1230.         FOR Ly = 0 TO H - 1
1231.             FOR Lx = 0 TO W - 1
1232.                 GET #ff, , record&
1233.                 IF record& > -1 THEN
1234.                     '   PRINT Lx, Ly
1235.                     IF ColisMap(Lx, Ly) = 0 THEN
1236.                         O_FLOOR Lx, Ly, textures(record&)
1237.                         'SLEEP
1238.                     END IF
1239.                 END IF
1240.         NEXT Lx, Ly
1241.  
1242.  
1243.         FOR Ly = 0 TO H - 1
1244.             FOR Lx = 0 TO W - 1
1245.                 GET #ff, , record&
1246.                 IF record& > -1 THEN
1247.                     '   PRINT Lx, Ly
1248.                     IF ColisMap(Lx, Ly) = 0 THEN
1249.                         O_CEILING Lx, Ly, textures(record&)
1250.                         '                    SLEEP
1251.                     END IF
1252.                 END IF
1253.         NEXT Lx, Ly
1254.         CLOSE #ff
1255.     ELSE 'file not found
1256.         EXIT SUB
1257.     END IF
1258. END SUB
1259.  
1260. FUNCTION RED&
1261.     R = _NEWIMAGE(100, 100, 32)
1262.     C = _DEST
1263.     _DEST R
1264.     CLS , _RGBA32(255, 0, 0, 90)
1265.     _DEST C
1266.     RED& = _COPYIMAGE(R, 33)
1267.     _FREEIMAGE R
1268. END FUNCTION
1269.  
1270.  
1271. FUNCTION TYP! (from AS SINGLE, tto AS SINGLE, value AS SINGLE)
1272.     '   tto = tto + 1
1273.     tto = tto * 1000
1274.     from = from * 1000
1275.     value = value * 1000
1276.  
1277.     IF value < tto AND value > from THEN TYP! = value / 1000: EXIT FUNCTION
1278.     IF value > tto THEN TYP! = (value MOD tto) / 1000: EXIT FUNCTION
1279.     IF value < from THEN TYP! = (tto - ABS(value MOD tto)) / 1000: EXIT FUNCTION
1280.  
1281. END FUNCTION
1282.  
1283.  
1284. SUB zapisV
1285.     OPEN "PoleV.txt" FOR OUTPUT AS #1
1286.     FOR W = LBOUND(object) TO UBOUND(object)
1287.         PRINT #1, OBJECT(W).X; ","; OBJECT(W).Y; ","; OBJECT(W).Z; OBJECT(W).s; OBJECT(W).e
1288.     NEXT
1289.     CLOSE #1
1290. END SUB
1291.  
1292.  
1293. FUNCTION WALL_TYPE (W( x , y) AS LONG, Xp AS INTEGER, Yp AS INTEGER)
1294.     Xmin = LBOUND(W, 1)
1295.     Xmax = UBOUND(w, 1)
1296.     Ymin = LBOUND(w, 2)
1297.     Ymax = UBOUND(W, 2)
1298.  
1299.     'v mistech, kde je soused se nezapisuji vrcholy pro texturovani
1300.  
1301.     IF Xp > Xmin AND Xmax > Xp + 1 AND Yp > Ymin AND Ymax > Yp + 1 THEN
1302.         IF W(Xp + 1, Yp) = 0 AND W(Xp - 1, Yp) = 0 AND W(Xp, Yp + 1) = 0 AND W(Xp, Yp - 1) = 0 THEN WALL_TYPE = 1 'prazdno okolo ze vsech stran.
1303.         IF W(Xp + 1, Yp) = 0 AND W(Xp - 1, Yp) = 1 AND W(Xp, Yp + 1) = 0 AND W(Xp, Yp - 1) = 0 THEN WALL_TYPE = 2 'vlevo je soused
1304.         IF W(Xp + 1, Yp) = 0 AND W(Xp - 1, Yp) = 0 AND W(Xp, Yp + 1) = 0 AND W(Xp, Yp - 1) = 1 THEN WALL_TYPE = 3 'nahore je soused
1305.         IF W(Xp + 1, Yp) = 1 AND W(Xp - 1, Yp) = 0 AND W(Xp, Yp + 1) = 0 AND W(Xp, Yp - 1) = 0 THEN WALL_TYPE = 4 'vpravo je soused
1306.         IF W(Xp + 1, Yp) = 0 AND W(Xp - 1, Yp) = 0 AND W(Xp, Yp + 1) = 1 AND W(Xp, Yp - 1) = 0 THEN WALL_TYPE = 5 'dole je soused
1307.         IF W(Xp + 1, Yp) = 0 AND W(Xp - 1, Yp) = 0 AND W(Xp, Yp + 1) = 1 AND W(Xp, Yp - 1) = 1 THEN WALL_TYPE = 6 'nahore i dole je soused
1308.         IF W(Xp + 1, Yp) = 1 AND W(Xp - 1, Yp) = 1 AND W(Xp, Yp + 1) = 0 AND W(Xp, Yp - 1) = 0 THEN WALL_TYPE = 7 'vlevo a vpravo je soused
1309.         IF W(Xp + 1, Yp) = 1 AND W(Xp - 1, Yp) = 1 AND W(Xp, Yp + 1) = 1 AND W(Xp, Yp - 1) = 1 THEN WALL_TYPE = 8 'sousedi vsude okolo. Netexturovat.
1310.     END IF
1311.  
1312.     IF WALL_TYPE = 0 THEN WALL_TYPE = 1
1313. END FUNCTION
1314.  
1315. SUB Find_Walls (C() AS coordinates)
1316.     DIM x AS LONG, y AS LONG, i AS LONG, Start AS LONG, te AS LONG
1317.     't = TIMER
1318.     U1 = UBOUND(ColisMap, 1)
1319.     U2 = UBOUND(ColisMap, 2)
1320.  
1321.  
1322.     FOR y = 1 TO U2
1323.         FOR x = 1 TO U1
1324.             IF ColisMap(x, y) AND Start = 0 THEN Start = 1: C(i).Xs = x: C(i).Ys = y
1325.             IF ColisMap(x, y) = 0 AND Start = 1 THEN
1326.                 Start = 0
1327.                 IF x - C(i).Xs > 1 THEN
1328.                     C(i).Xe = x - 1: C(i).Ye = y: i = i + 1: REDIM _PRESERVE C(i) AS coordinates
1329.                 ELSE
1330.                     C(i).Xs = 0
1331.                 END IF
1332.             END IF
1333.         NEXT x
1334.     NEXT y
1335.  
1336.     FOR x = 1 TO U1
1337.         FOR y = 1 TO U2
1338.             IF ColisMap(x, y) AND Start = 0 THEN Start = 1: C(i).Ys = y: C(i).Xs = x
1339.             IF ColisMap(x, y) = 0 AND Start = 1 THEN
1340.                 Start = 0
1341.                 IF y - C(i).Ys > 1 THEN
1342.                     C(i).Ye = y - 1: C(i).Xe = x: i = i + 1: REDIM _PRESERVE C(i) AS coordinates
1343.                 ELSE
1344.                     C(i).Ys = 0
1345.                 END IF
1346.             END IF
1347.         NEXT y
1348.     NEXT x
1349.  
1350.     FOR H = LBOUND(object) TO UBOUND(object)
1351.         FOR i = LBOUND(c) TO UBOUND(c)
1352.             IF OBJECT(H).X = C(i).Xs AND OBJECT(H).Z = C(i).Ys THEN C(i).S = H
1353.             IF OBJECT(H).X = C(i).Xe AND OBJECT(H).Z = C(i).Ye THEN C(i).K = H
1354.     NEXT i, H
1355. END SUB
1356.  
1357.  
1358.  
1359. FUNCTION VolumeAgent (centerX AS SINGLE, centerZ AS SINGLE, CamX, CamZ, Lenght AS SINGLE) 'vrati hlasitost v danem okruhu podle vzdalenosti
1360.     Lx = CamX - centerX
1361.     Lz = CamZ - centerZ
1362.     act = SQR((Lx ^ 2) + (Lz ^ 2))
1363.     IF Lenght >= act THEN
1364.         PSET (CamX, CamZ)
1365.         VolumeAgent = (Lenght - act) / (Lenght)
1366.     END IF
1367. END FUNCTION
1368.  
1369. FUNCTION Wall_Distance (i AS LONG)
1370.     SHARED CX, CY, CZ
1371.     Wall_Distance = 100
1372.     IF ZDI(i).Xs <= CX AND ZDI(i).Xe >= CX OR ZDI(i).Ys <= CZ AND ZDI(i).Ye >= CZ THEN
1373.         Wall_Distance = SQR((CX - ZDI(i).Xs) ^ 2 + (CZ - ZDI(i).Ys) ^ 2)
1374.     END IF
1375. END FUNCTION
1376.  

Thank Steve McNeill for his SaveImage. Is used in editor.