Author Topic: MAPTRIANGLE in 3D  (Read 26025 times)

0 Members and 1 Guest are viewing this topic.

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Re: MAPTRIANGLE in 3D
« Reply #30 on: February 03, 2019, 08:10:33 am »
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.

You're not done when it works, you're done when it's right.

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: MAPTRIANGLE in 3D
« Reply #31 on: February 03, 2019, 04:13:08 pm »
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
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: MAPTRIANGLE in 3D
« Reply #32 on: February 04, 2019, 08:02:00 am »
Fantastic work Petr! I could even see ping-pong game being played on computer!
Again,.... great job! :D
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: MAPTRIANGLE in 3D
« Reply #33 on: February 04, 2019, 03:57:22 pm »
Thank you all for positive feedback! I very much appreciate it!

Offline Petr

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

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: MAPTRIANGLE in 3D
« Reply #35 on: February 12, 2019, 04:52:05 pm »
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.
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: MAPTRIANGLE in 3D
« Reply #36 on: February 12, 2019, 05:39:49 pm »
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.

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Re: MAPTRIANGLE in 3D
« Reply #37 on: February 12, 2019, 06:00:38 pm »
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!
« Last Edit: February 12, 2019, 06:01:57 pm by STxAxTIC »
You're not done when it works, you're done when it's right.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: MAPTRIANGLE in 3D
« Reply #38 on: February 12, 2019, 06:34:29 pm »
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.

https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: MAPTRIANGLE in 3D
« Reply #39 on: February 12, 2019, 06:42:34 pm »
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.  ;)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Re: MAPTRIANGLE in 3D
« Reply #40 on: February 12, 2019, 06:55:16 pm »
... 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.

« Last Edit: February 12, 2019, 07:10:32 pm by STxAxTIC »
You're not done when it works, you're done when it's right.

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: MAPTRIANGLE in 3D
« Reply #41 on: February 17, 2019, 04:04:17 am »
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.
objects.jpg
* objects.jpg (Filesize: 488 KB, Dimensions: 1680x1050, Views: 250)
« Last Edit: February 17, 2019, 04:15:36 am by Petr »

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: MAPTRIANGLE in 3D
« Reply #42 on: February 19, 2019, 01:03:00 am »
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.  ;)



https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: MAPTRIANGLE in 3D
« Reply #43 on: March 21, 2019, 05:25:25 pm »
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.
Work on Maze.jpg
* Work on Maze.jpg (Filesize: 843.99 KB, Dimensions: 1680x1050, Views: 282)

Offline Petr

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

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

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


* 3DMEaP.zip (Filesize: 7.36 MB, Downloads: 157)