MapTriangle (3D) demos

[Petr]

I'm going through old discs, a lot of my work doesn't work due to the need to fix many functions (it was written in QB64 1.3 where the functions were taken incorrectly - but the programs took this into account), I will gradually add ONLY things directly related to _MAPTRIANGLE in the 3D version to this thread.

The first thing I managed to bring to life, it's even in a video on my youtube channel, is a demonstration of how to project some movement into the hardware layer used by _MapTriangle 3D.

Here is a program that, on the Software layer, projects a 3D hardware layer on which the circle runs.


Tested in QB64PE 3.6.0

Code: (Select All)

Screen _NewImage(1024, 768, 32)
im& = _ScreenImage
img& = _CopyImage(im&, 33)
_FreeImage im&
SX0 = 0: SY0 = 0: SX1 = 0: SY1 = _Height: sx2 = _Width: sy2 = 0: sx3 = _Width: sy3 = _Height
DX0 = -2: DY0 = 2: DX1 = -2: DY1 = -2: DX2 = 2: DY2 = 2: DX3 = 2: DY3 = -2

'    SX0             SX2                                                                    y
'    dx0                                   X left = -   right = +                 - x      -z       +x
'                                          Y dole = -   nahore = +                         -y
'                                          Z vzadu = max - 10, normalne ale -1
'    SX1             SX3
tt = .01: t = .1
Do
    e& = ell&
    While _MouseInput: Wend
    Mx = _MouseX: My = _MouseY
    StredX = Mx
    t = t + tt: If t > _Pi(2) Or t < -_Pi(2) Then tt = tt * -1
    RR = Sin(t) - 4
    SS = Cos(t) - 10
    R = -Sin(t) * -2
    s = -Cos(t) * 2

    _MapTriangle (SX0, SY0)-(sx3, sy3)-(SX1, SY1), e& To(DX0 * R, DY0 * s, RR)-(DX3 * R, DY3 * s, SS)-(DX1 * R, DY1 * s, RR), 0, _Smooth
    _MapTriangle (SX0, SY0)-(sx3, sy3)-(sx2, sy2), e& To(DX0 * R, DY0 * s, RR)-(DX3 * R, DY3 * s, SS)-(DX2 * R, DY2 * s, SS), 0, _Smooth
    _Display
    _Limit 30
Loop



Function ell&
    Shared vx, vy, Mxx, Myy
    Locate 1, 1: Print "This is Software Screen."
    V& = _NewImage(1024, 768, 32)
    _Dest V&
    W = 1024: H = 768
    If Mxx = 0 Then Mxx = 10: Myy = 10
    vx = vx + Mxx: If vx > W Or vx < 0 Then Mxx = Mxx * -1
    vy = vy + Myy: If vy > H Or vy < 0 Then Myy = Myy * -1
    Cls , _RGB32(1, 55, 132)
    _PrintMode _KeepBackground
    Locate 11, 30: Print "This is Hardware Screen"
    For d = 0 To _Pi / 2 Step .2
        Line (vx - Sin(d) * 50, vy - Cos(d) * 50)-(vx + Sin(d) * 50, vy + Cos(d) * 50), , BF
    Next d
    _Dest 0
    ell& = _CopyImage(V&, 33)
    _FreeImage V&
End Function

Lets look the start and end of the ell& function. For each progression (!) a new software screen must be created, copied as a static hardware texture (33) and applied to the 3D environment. This solution is very CPU intensive and completely stupid. But it would be far more reasonable, in the case of the same animation running round and round, to take the individual frames of the animation, copy them as hardware images into the array, and then just paste the individual frames. This does not load the processor almost at all.

   

[Petr]

This is my unfinished level editor for a 3D world. Of course MapTriangle 3D is used. Inserting objects is not applied, or rather it is, but in a different version that successfully plays hide and seek with me and still wins. Here you can use the editor to create a map and then walk around it. If I find a higher version I will add it here, but this is not my priority at the moment. I vaguely remember having a version with sound somewhere, but where is it? That is a question.

For trying done maps, run 3dm.exe mapname  (without extension.map, program load it from \map directory. If map not exists, just black screen is view, none error message occur). When is program runnig, is mouse locked in middle on the screen, its need, because in time, when is program written, MOUSEMOVEMENTX and MOUSEMOVEMENTY dont work as expected and program calculate then move in this own way.

I'm not really going to try to fix it, the source code is so old I'd break more than fix it.

How create own map.


Before waste your time, I'll first say that I seriously don't remember if this particular version somehow filtered the number of vertices in the array to display, it certainly won't be a fast or reliable method. This is a development version, but then something happened and development stopped.

So there you have the editor. You can load existing files. MAP and edit it. Or create own. Textures are image files, you can easily add your own images to them.

Start the editor. An empty grid will pop up. It can be moved using the arrows on the keyboard, you are not limited to this section in any case. Let's start with the floor. So let's load the floor texture first, shall we?


To familiarize yourself with it, I recommend first setting the display in a grid, the default is - well, it's just a development version - stupid. Click on Set Grid.

In the Layers mode section, choose Don't show textures, use Quads, all layers, or use that version with SetAlpha.

Click on Add Texture. A list of images is loaded. Choose one, click on it and it will be added to the list of textures on the right. Now click the Draw Floor button at the bottom. You create a floor by marking cells in the grid with the left mouse button. You can also use the left-click, hold, drag, and release method. Mark some cells. Once you have that, click on Add Texture and choose a texture for the ceiling. Click on the file name, the texture will be added to the right texture list. At the bottom of the editor, click on DrawCeiling. At that moment, the textures of the floor disappear, you paint the ceiling. Label the cells as in the previous case. If you mix up a texture, simply click on another one on the right and insert it in Draw Ceiling mode over the one you mixed up. Click Add Texture again and select a texture for the wall. Click on Draw Wall. Mark the perimeter so that the thickness is just o one cell. Now if you switch to Draw Ceiling or Draw Floor you will see where the ceiling and floor intersect with the wall.





The lower part of the filmstrip is intended for objects, but this is not applied in this version. Here it is only possible to build the walls, ceiling and floor. If the image is transparent, the texture will also be transparent. The number of textures is not limited. MAP files contain images of the textures you will use.

The attached ZIP file contains: EXE files compiled in the original version of QB64 1.3 and also EXE files compiled in QB64PE. Of course, the BAS source codes are included, so you can compile it yourself. Also there are some maps and image files. Also ICO files, the Editor needs them for its work.


   

[mnrvovrfc]

This is very impressive. It would have taken me the rest of my life to come up with something like this. It would give somebody else an idea for YACWOD (yet another clone of Wolfenstein or Doom).

[bplus]

Yes, so glad Petr dumped his last signature ;-))

[Petr]

Thank you for your feedback. Once upon a time, on a now defunct forum, there was a thread about "show where you program". Someone sent a photo of the workbench and stuff... but I thought. After all, they write - where YOU PROGRAM. Well, I'll program it for them I used my brand new and first (uncompressed) file packer at the time and of course MapTriangle 3D. When BPlus sees it, it will definitely remember. I remember his question - oh man, so many cabinets, so much storage space? So - the answer is - that room is smaller, I misjudged it when programming, so I just filled it with those cabinets In the program, one of my first ones, there is only one room where I actually programmed at the time. The program needs a PMF file (predecessor of my new PMF2 format) to work, I am attaching it here packed in a zip file. The file contains the necessary textures for MapTriangle. Up/down movement is not implanted, movement is via keyboard arrows. While writing this program, I really practiced moving in space. The numbers in DATA are coordinates in space for individual textures.

Code: (Select All)

Dim Shared lX, lY, rXx, rY, mX, mY, ballX As Integer, ballY As Integer, m&, leftplr, rightplr
m& = _NewImage(320, 240, 32)
lX = 10: lY = 10: rXx = 310: rY = 10
ballX = 160: ballY = 10: mY = -1: If Rnd * 10 > 5 Then mX = 1 Else mX = -1
Dim Shared dub As Long, aluminium As Long



Print "Loading textures..."
ExtractPMF ("textures.pmf")

aluminium& = Hload("alum.jpg")
podl& = Hload("plovoucka.jpg")
str& = strop&
tokno& = okno&
dvere& = spajz_dvere&
lednice& = Hload("lednice2.jpg")
orech& = Hload("dekor orech.jpg")
orechsv& = Zesvetli("dekor orech.jpg", orechsv&)
polstr& = Hload("polstr.jpg")
dub& = Hload("dub.jpg")
tdub& = Ztmav("dub.jpg", tdub&)
pc& = SHload("pccs.png")


kbd& = SHload("kbd.jpg")
mys& = SHload("mys.jpg")
woof& = SHload("repro.png")
speak& = Hload("speaker.jpg")
dlazba& = Hload("obklad.jpg")
dlazba2& = Hload("obklad 2.jpg")
sporakcelo = Hload("sporak-celo.jpg")
sporakvrch = Hload("sporak-vrch.jpg")
mikro& = SHload("mikro2.jpg")


Dim O As _Float
Dim Shared N
Screen _NewImage(800, 600, 32)
_FullScreen

CX = 0: CY = 0: CZ = -1 '
N = 1116 'used quads (also this room contains 2232 triangles)


Type V
    X As Single '                                                                  source X points in standard view
    Y As Single '                                                                  source Y points in standard view
    Z As Single '                                                                  not use yet
    pi As Single '                                                                 start draw position on radius
    piH As Single '
    Radius As Single '                                                             radius (every point use own, but if is CX and CY in middle, are all the same)
    RadiusH As Single
    wX As Single '                                                                 working coordinates
    wY As Single
    wZ As Single

    T As Long '                                                                    texture number for current triangle
    Tm As Single '                                                                 texture multiplicier. 1 for one.
End Type


Dim Shared v(1 To N) As V

'         A          B        C         D
Data -10,-2,-5,-10,-2,10,10,-2,-5,10,-2,10: ' floor coordinates
Data -10,2,-5,-10,2,10,10,2,-5,10,2,10: '     roof coordinates
Data -10,-2,-5,-10,-2,10,-10,2,-5,-10,2,10: ' wall + window
Data -5,-2,8,-10,-2,8,-5,2,8,-10,2,8
'refrigerator
Data -5,-2,8,-5,-2.1,10,-5,2.1,8,-5,2,10
Data -5,-3,10,10,-3,10,-5,3,10,10,3,10
Data -4.8,-2,8,-3,-2,8,-4.8,1,8,-3,1,8
Data -5,1,8,-3,1,8,-5,1,10,-3,1,10
Data -3,1,8,-3,1,10,-3,-2,8,-3,-2,10
Data -4.8,1,8,-4.8,1,10,-4.8,-2,8,-4.8,-2,10
'bench
Data -2.8,-1.5,8,-2.8,-1.5,9,-2.8,-2,8,-2.8,-2,9
Data -2.7,-1.5,8,-2.7,-1.5,9,-2.7,-2,8,-2.7,-2,9
Data 0.8,-1.5,8,0.8,-1.5,9,0.8,-2,8,0.8,-2,9
Data 0.7,-1.5,8,0.7,-1.5,9,0.7,-2,8,0.7,-2,9
Data 0.7,-1.5,8,0.8,-1.5,8,.7,-2,8,0.8,-2,8
Data -2.7,-1.5,8,-2.8,-1.5,8,-2.7,-2,8,-2.8,-2,8
Data 2,-1.5,8,-3.0,-1.5,8,2,-1.5,10.5,-3.0,-1.5,10.5
Data 4.39,-1.5,9.5,-3,-1.5,9.5,4.39,0,10,-3,0,10
Data 1.9,-1.5,10,4.4,-1.5,10,1.9,-1.5,3,4.4,-1.5,3
Data 3.9,-1.5,10,3.9,-1.5,3,4.4,0,10,4.4,0,3
Data 1.9,-1.5,8,3.9,-1.5,8,1.9,-2,8,3.9,-2,8
Data 1.9,-1.5,7.9,3.9,-1.5,7.9,1.9,-2,7.9,3.9,-2,7.9
Data 1.9,-1.5,8,1.9,-1.5,7.9,1.9,-2,8,1.9,-2,7.9
Data 1.9,-2,3,4.4,-2,3,1.9,-1.5,3,4.4,-1.5,3
Data 1.9,-2,3.1,4.4,-2,3.1,1.9,-1.5,3.1,4.4,-1.5,3.1
Data 4.4,-2,3.1,4.4,-2,3,4.4,-1.5,3.1,4.4,-1.5,3
Data 1.9,-2,3.1,1.9,-2,3,1.9,-1.5,3.1,1.9,-1.5,3
Data 3.9,-1.5,3,4.4,-1.5,3,4.4,0,3,4.4,0,3
Data 4.4,-2,10,4.4,-2,3,4.4,0,10,4.4,0,3
Data 1.5,-2,7.5,1.7,-2,7.5,1.5,-1,7.5,1.7,-1,7.5
Data 1.5,-2,7.3,1.7,-2,7.3,1.5,-1,7.3,1.7,-1,7.3
Data 1.5,-2,7.3,1.5,-1,7.3,1.5,-2,7.5,1.5,-1,7.5
Data 1.7,-2,7.3,1.7,-1,7.3,1.7,-2,7.5,1.7,-1,7.5
Data -2,-2,7.5,-2.2,-2,7.5,-2,-1,7.5,-2.2,-1,7.5
Data -2,-2,7.3,-2.2,-2,7.3,-2,-1,7.3,-2.2,-1,7.3
Data -2,-2,7.3,-2,-1,7.3,-2,-2,7.5,-2,-1,7.5
Data -2.2,-2,7.3,-2.2,-1,7.3,-2.2,-2,7.5,-2.2,-1,7.5
Data 1.5,-2,3.5,1.7,-2,3.5,1.5,-1,3.5,1.7,-1,3.5
Data 1.5,-2,3.7,1.7,-2,3.7,1.5,-1,3.7,1.7,-1,3.7
Data 1.5,-2,3.7,1.5,-1,3.7,1.5,-2,3.5,1.5,-1,3.5
Data 1.7,-2,3.7,1.7,-1,3.7,1.7,-2,3.5,1.7,-1,3.5
Data -2,-2,3.5,-2.2,-2,3.5,-2,-1,3.5,-2.2,-1,3.5
Data -2,-2,3.7,-2.2,-2,3.7,-2,-1,3.7,-2.2,-1,3.7
Data -2,-2,3.7,-2,-1,3.7,-2,-2,3.5,-2,-1,3.5
Data -2.2,-2,3.7,-2.2,-1,3.7,-2.2,-2,3.5,-2.2,-1,3.5
Data 1.5,-1,3.5,-2,-1,3.5,1.5,-1.1,3.5,-2,-1.1,3.5
Data 1.5,-1,7.5,-2,-1,7.5,1.5,-1.1,7.5,-2,-1.1,7.5
Data 1.7,-1,3.5,1.7,-1,7.5,1.7,-1.1,3.5,1.7,-1.1,7.5
Data -2.2,-1,3.5,-2.2,-1,7.5,-2.2,-1.1,3.5,-2.2,-1.1,7.5
'desk
Data 1.8,-1,3.4,-2.3,-1,3.4,1.8,-1,7.6,-2.3,-1,7.6
Data 1.8,-.9,3.4,-2.3,-.9,3.4,1.8,-.9,7.6,-2.3,-.9,7.6
Data 1.8,-.9,3.4,-2.3,-.9,3.4,1.8,-1,3.4,-2.3,-1,3.4
Data 1.8,-.9,7.6,-2.3,-.9,7.6,1.8,-1,7.6,-2.3,-1,7.6
Data 1.8,-.9,3.4,1.8,-1,3.4,1.8,-.9,7.6,1.8,-1,7.6
Data -2.3,-.9,3.4,-2.3,-1,3.4,-2.3,-.9,7.6,-2.3,-1,7.6
'chair
Data .3,-2,3.9,.4,-2,3.9,.3,-1.5,3.9,.4,-1.5,3.9
Data .3,-2,3.8,.4,-2,3.8,.3,-1.5,3.8,.4,-1.5,3.8
Data .3,-2,3.8,.3,-2,3.9,.3,-1.5,3.8,.3,-1.5,3.9
Data .4,-2,3.8,.4,-2,3.9,.4,-1.5,3.8,.4,-1.5,3.9
Data -.7,-2,3.9,-.8,-2,3.9,-.7,-1.5,3.9,-.8,-1.5,3.9
Data -.7,-2,3.8,-.8,-2,3.8,-.7,-1.5,3.8,-.8,-1.5,3.8
Data -.7,-2,3.8,-.7,-2,3.9,-.7,-1.5,3.8,-.7,-1.5,3.9
Data -.8,-2,3.8,-.8,-2,3.9,-.8,-1.5,3.8,-.8,-1.5,3.9
Data .3,-2,3,.4,-2,3,.3,-1.5,3,.4,-1.5,3
Data .3,-2,3.1,.4,-2,3.1,.3,-1.5,3.1,.4,-1.5,3.1
Data .3,-2,3.1,.3,-2,3,.3,-1.5,3.1,.3,-1.5,3
Data .4,-2,3.1,.4,-2,3,.4,-1.5,3.1,.4,-1.5,3
Data -.7,-2,3,-.8,-2,3,-.7,-1.5,3,-.8,-1.5,3
Data -.7,-2,3.1,-.8,-2,3.1,-.7,-1.5,3.1,-.8,-1.5,3.1
Data -.7,-2,3.1,-.7,-2,3,-.7,-1.5,3.1,-.7,-1.5,3
Data -.8,-2,3.1,-.8,-2,3,-.8,-1.5,3.1,-.8,-1.5,3
Data .5,-1.5,4.1,-.9,-1.5,4.1,.5,-1.5,2.9,-.9,-1.5,2.9
Data .5,-1.4,4.1,-.9,-1.4,4.1,.5,-1.4,2.9,-.9,-1.4,2.9
Data .5,-1.5,4.1,-.9,-1.5,4.1,.5,-1.4,4.1,-.9,-1.4,4.1
Data .5,-1.5,2.9,-.9,-1.5,2.9,.5,-1.4,2.9,-.9,-1.4,2.9
Data -.9,-1.5,2.9,-.9,-1.4,2.9,-.9,-1.5,4.1,-.9,-1.4,4.1
Data .5,-1.5,2.9,.5,-1.4,2.9,.5,-1.5,4.1,.5,-1.4,4.1
Data -.9,-1.5,2.9,.5,-1.5,2.9,-.9,0,2.7,.5,0,2.7
Data -.9,-1.5,3,.5,-1.5,3,-.9,0,2.8,.5,0,2.8
Data -.9,-1.5,2.9,-.9,-1.5,3,-.9,0,2.7,-.9,0,2.8
Data -.9,0,2.9,.5,0,2.9,-.9,0,2.7,.5,0,2.7
Data .5,-1.5,2.9,.5,-1.5,3,.5,0,2.7,.5,0,2.8

'chair 2
Data -1.3,-2,4.9,-1.4,-2,4.9,-1.3,-1.5,4.9,-1.4,-1.5,4.9
Data -1.3,-2,4.8,-1.4,-2,4.8,-1.3,-1.5,4.8,-1.4,-1.5,4.8
Data -1.3,-2,4.8,-1.3,-2,4.9,-1.3,-1.5,4.8,-1.3,-1.5,4.9
Data -1.4,-2,4.8,-1.4,-2,4.9,-1.4,-1.5,4.8,-1.4,-1.5,4.9
Data -1.3,-2,5.9,-1.4,-2,5.9,-1.3,-1.5,5.9,-1.4,-1.5,5.9
Data -1.3,-2,5.8,-1.4,-2,5.8,-1.3,-1.5,5.8,-1.4,-1.5,5.8
Data -1.3,-2,5.8,-1.3,-2,5.9,-1.3,-1.5,5.8,-1.3,-1.5,5.9
Data -1.4,-2,5.8,-1.4,-2,5.9,-1.4,-1.5,5.8,-1.4,-1.5,5.9
Data -2.3,-2,4.9,-2.4,-2,4.9,-2.3,-1.5,4.9,-2.4,-1.5,4.9
Data -2.3,-2,4.8,-2.4,-2,4.8,-2.3,-1.5,4.8,-2.4,-1.5,4.8
Data -2.3,-2,4.8,-2.3,-2,4.9,-2.3,-1.5,4.8,-2.3,-1.5,4.9
Data -2.4,-2,4.8,-2.4,-2,4.9,-2.4,-1.5,4.8,-2.4,-1.5,4.9
Data -2.3,-2,5.9,-2.4,-2,5.9,-2.3,-1.5,5.9,-2.4,-1.5,5.9
Data -2.3,-2,5.8,-2.4,-2,5.8,-2.3,-1.5,5.8,-2.4,-1.5,5.8
Data -2.3,-2,5.8,-2.3,-2,5.9,-2.3,-1.5,5.8,-2.3,-1.5,5.9
Data -2.4,-2,5.8,-2.4,-2,5.9,-2.4,-1.5,5.8,-2.4,-1.5,5.9
Data -1.2,-1.5,4.7,-2.5,-1.5,4.7,-1.2,-1.5,6,-2.5,-1.5,6
Data -1.2,-1.4,4.7,-2.5,-1.4,4.7,-1.2,-1.4,6,-2.5,-1.4,6
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
Data -1.2,-1.5,6,-2.5,-1.5,6,-1.2,-1.4,6,-2.5,-1.4,6
Data -1.2,-1.5,4.7,-1.2,-1.4,4.7,-1.2,-1.5,6,-1.2,-1.4,6
Data -2.5,-1.5,4.7,-2.5,-1.4,4.7,-2.5,-1.5,6,-2.5,-1.4,6
Data -2.3,-1.5,4.7,-2.3,-1.5,6,-2.5,0,4.7,-2.5,0,6
Data -2.4,-1.5,4.7,-2.4,-1.5,6,-2.6,0,4.7,-2.6,0,6
Data -2.3,-1.5,4.7,-2.5,-1.5,4.7,-2.5,0,4.7,-2.7,0,4.7
Data -2.3,-1.5,6,-2.5,-1.5,6,-2.5,0,6,-2.7,0,6
'here is wall at the computer
Data 10,-2,-5,10,-2,0,10,2.1,-5,10,2.1,0
Data 10,-2,5,10,-2,0,10,2,5,10,2,0
Data 10,-2,10,10,-2,5,10,2.1,10,10,2.1,5
'here is the PC table
Data 10,-2,8,9.8,-2,8,10,-.7,8,9.8,-.7,8
Data 9.8,-2,8,9.8,-.7,8,9.8,-2,10,9.8,-.7,10
Data 4.4,-2,8,4.6,-2,8,4.4,-.7,8,4.6,-.7,8
Data 4.6,-2,8,4.6,-.7,8,4.6,-2,10,4.6,-.7,10
Data 9.8,-.7,9.8,4.6,-.7,9.8,9.8,-1.5,9.8,4.6,-1.5,9.8
Data 9.8,-1.5,9.8,4.6,-1.5,9.8,9.8,-1.5,10,4.6,-1.5,10
Data 7.5,-2,8,7.7,-2,8,7.5,-.7,8,7.7,-.7,8
Data 7.5,-2,8,7.5,-.7,8,7.5,-2,9.8,7.5,-.7,9.8
Data 7.7,-2,8,7.7,-.7,8,7.7,-2,9.8,7.7,-.7,9.8
Data 9.8,-2,8.3,7.5,-2,8.3,9.8,-1.8,8.3,7.5,-1.8,8.3
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
Data 9.8,-1.2,8.1,7.5,-1.2,8.1,9.8,-.9,8.1,7.5,-.9,8.1
Data 9.8,-1.75,8.1,7.5,-1.75,8.1,9.8,-1.75,9,7.5,-1.75,9
Data 9.8,-1.2,8.1,7.5,-1.2,8.1,9.8,-1.2,9,7.5,-1.2,9
Data 9.8,-.9,8.1,7.5,-.9,8.1,9.8,-.9,9,7.5,-.9,9
Data 9.8,-2,9.8,7.5,-2,9.8,9.8,-.7,9.8,7.5,-.7,9.8
Data 10,-.7,7.9,4.4,-.7,7.9,10,-.5,7.9,4.4,-.5,7.9
Data 10,-.7,7.9,4.4,-.7,7.9,10,-.7,10,4.4,-.7,10
Data 10,-.5,7.9,4.4,-.5,7.9,10,-.5,10,4.4,-.5,10
'compputer
Data 5,-2,8,5,-2,8.5,5,-1.5,8,5,-1.5,8.5
Data 5,-1.5,8,5,-1.5,8.5,4.7,-1.5,8,4.7,-1.5,8.5
Data 4.7,-2,8,4.7,-2,8.5,4.7,-1.5,8,4.7,-1.5,8.5
Data 4.7,-2,8,5,-2,8,4.7,-1.5,8,5,-1.5,8
'monitor
Data 9.7,-.3,8.5,7.7,-.3,9.6,9.7,1,8.5,7.7,1,9.6
Data 9.7,-.3,8.6,9.7,1,8.6,7.7,-.3,9.7,7.7,1,9.7
Data 7.7,-.3,9.6,7.7,1,9.6,7.7,-.3,9.7,7.7,1,9.7
Data 9.7,-.3,8.6,9.7,-.5,8.6,7.7,-.3,9.7,7.7,-.5,9.7
Data 9.2,-.49,8.6,8.2,-.49,8.6,9.2,-.49,10,8.2,-.49,10
'keyboard
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
Data 5.3,-.45,7.9,5,-.45,7.9,5.3,-.39,8,5,-.39,8: 'mouse - as keyboard
'subwoofer
Data 7.4,-2,9.8,7.4,-2,9,7.4,-1.5,9.8,7.4,-1.5,9
Data 7,-2,9.8,7,-2,9,7,-1.5,9.8,7,-1.5,9
Data 7.4,-2,9.8,7,-2,9.8,7.4,-1.5,9.8,7,-1.5,9.8
Data 7.4,-1.5,9.8,7,-1.5,9.8,7.4,-1.5,9,7,-1.5,9
Data 7.4,-2,9,7,-2,9,7.4,-1.5,9,7,-1.5,9
'speaker right
Data 4.7,-.5,10,4.7,0,10,4.7,-.5,9.7,4.7,0,9.7
Data 4.41,-.5,10,4.41,0,10,4.41,-.5,9.7,4.41,0,9.7
Data 4.41,0,10,4.41,0,9.7,4.7,0,10,4.7,0,9.7
Data 4.7,-.5,9.7,4.41,-.5,9.7,4.7,0,9.7,4.41,0,9.7
'speaker left
Data 6.7,-.5,10,6.7,0,10,6.7,-.5,9.7,6.7,0,9.7
Data 6.41,-.5,10,6.41,0,10,6.41,-.5,9.7,6.41,0,9.7
Data 6.41,0,10,6.41,0,9.7,6.7,0,10,6.7,0,9.7
Data 6.7,-.5,9.7,6.41,-.5,9.7,6.7,0,9.7,6.41,0,9.7

'wall with kitchen unit, again walls with doors first
Data 10,-2,-5,5,-2,-5,10,2,-5,5,2,-5
Data -10,-2,-4.99,7,-2,-4.99,-10,1,-4.99,7,1,-4.99
Data -10,2,-4.99,7,2,-4.99,-10,1,-4.99,7,1,-4.99
Data 5,-2,-3.5,7,-2,-3.5,5,-0.5,-3.5,7,-0.5,-3.5
Data 5,-.5,-3.5,7,-.5,-3.5,5,-.5,-4.9,7,-.5,-4.9
Data 5,-2,-3.5,5,-.5,-3.5,5,-2,-4.9,5,-.5,-4.9
Data 7,-2,-3.5,7,-.5,-3.5,7,-2,-4.9,7,-.5,-4.9
Data 5,-2,-4.9,7,-2,-4.9,5,-0.5,-4.9,7,-0.5,-4.9

'gas cooker
Data 4.9,-2,-4.9,4.9,-.5,-4.9,4.9,-2,-3.5,4.9,-.5,-3.5
Data 4.9,-.5,-3.4,-2.99,-.5,-3.4,4.9,-.5,-4.9,-2.99,-.5,-4.9
Data 4.9,-.6,-3.4,-2.99,-.6,-3.4,4.9,-.6,-4.9,-2.99,-.6,-4.9
Data 4.9,-.6,-3.4,-2.99,-.6,-3.4,4.9,-.5,-3.4,-2.99,-.5,-3.4
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
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
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
Data 4.9,.6,-3.7,-9.99,.6,-3.7,4.9,.6,-4.9,-9.99,.6,-4.9
Data 4.9,.7,-3.7,-9.99,.7,-3.7,4.9,.7,-4.9,-9.99,.7,-4.9
Data 4.9,.7,-3.7,-9.99,.7,-3.7,4.9,.6,-3.7,-9.99,.6,-3.7
Data 4.9,-2,-3.5,4.9,-.5,-3.5,4.8,-2,-3.5,4.8,-.5,-3.5
Data 4.9,1.7,-3.7,4.9,.6,-3.7,4.9,1.7,-4.9,4.9,.6,-4.9
Data 4.9,1.7,-3.7,4.9,.6,-3.7,4.8,1.7,-3.7,4.8,.6,-3.7
Data 1.9,1.7,-3.7,1.9,.6,-3.7,1.8,1.7,-3.7,1.8,.6,-3.7
Data 1.9,-2,-3.7,1.9,-.6,-3.7,1.8,-2,-3.7,1.8,-.6,-3.7
Data 2.9,1.7,-3.7,2.9,.6,-3.7,2.8,1.7,-3.7,2.8,.6,-3.7
Data 2.9,-2,-3.7,2.9,-.6,-3.7,2.8,-2,-3.7,2.8,-.6,-3.7
Data 3.9,1.7,-3.7,3.9,.6,-3.7,3.8,1.7,-3.7,3.8,.6,-3.7
Data 3.9,-2,-3.7,3.9,-.6,-3.7,3.8,-2,-3.7,3.8,-.6,-3.7
Data 0.9,1.7,-3.7,0.9,.6,-3.7,0.8,1.7,-3.7,0.8,.6,-3.7
Data 0.9,-2,-3.7,0.9,-.6,-3.7,0.8,-2,-3.7,0.8,-.6,-3.7
Data -5.9,1.7,-3.7,-5.9,.6,-3.7,-5.8,1.7,-3.7,-5.8,.6,-3.7
Data -5.9,-2,-3.7,-5.9,-.6,-3.7,-5.8,-2,-3.7,-5.8,-.6,-3.7
Data -1.9,1.7,-3.7,-1.9,.6,-3.7,-1.8,1.7,-3.7,-1.8,.6,-3.7
Data -1.9,-2,-3.7,-1.9,-.6,-3.7,-1.8,-2,-3.7,-1.8,-.6,-3.7
Data -2.9,1.7,-3.7,-2.9,.6,-3.7,-2.8,1.7,-3.7,-2.8,.6,-3.7
Data -2.9,-2,-3.7,-2.9,-.6,-3.7,-2.8,-2,-3.7,-2.8,-.6,-3.7
Data -3.9,1.7,-3.7,-3.9,.6,-3.7,-3.8,1.7,-3.7,-3.8,.6,-3.7
Data -3.9,-2,-3.7,-3.9,-.6,-3.7,-3.8,-2,-3.7,-3.8,-.6,-3.7
Data -4.9,1.7,-3.7,-4.9,.6,-3.7,-4.8,1.7,-3.7,-4.8,.6,-3.7
Data -4.9,-2,-3.7,-4.9,-.6,-3.7,-4.8,-2,-3.7,-4.8,-.6,-3.7
Data -0.9,1.7,-3.7,-0.9,.6,-3.7,-0.8,1.7,-3.7,-0.8,.6,-3.7
Data -0.9,-2,-3.7,-0.9,-.6,-3.7,-0.8,-2,-3.7,-0.8,-.6,-3.7
Data -5.9,1.7,-3.7,-5.9,.6,-3.7,-5.8,1.7,-3.7,-5.8,.6,-3.7
Data -5.9,-2,-3.7,-5.9,-.6,-3.7,-5.8,-2,-3.7,-5.8,-.6,-3.7
Data -6.9,1.7,-3.7,-6.9,.6,-3.7,-6.8,1.7,-3.7,-6.8,.6,-3.7
Data -6.9,-2,-3.7,-6.9,-.6,-3.7,-6.8,-2,-3.7,-6.8,-.6,-3.7
Data -9.99,-.5,-3.4,-3.7,-.5,-3.4,-9.99,-.5,-4.9,-3.7,-.5,-4.9
Data -9.99,-.6,-3.4,-3.7,-.6,-3.4,-9.99,-.6,-4.9,-3.7,-.6,-4.9
Data -9.99,-.6,-3.4,-3.7,-.6,-3.4,-9.99,-.5,-3.4,-3.7,-.5,-3.4
Data -3.7,-.6,-3.4,-2.99,-.6,-3.4,-3.7,-.5,-3.4,-2.99,-.5,-3.4
Data -3.7,-.5,-3.4,-2.99,-.5,-3.4,-3.7,-.5,-3.75,-2.99,-.5,-3.75
Data -3.7,-.5,-4.7,-2.99,-.5,-4.7,-3.7,-.5,-4.9,-2.99,-.5,-4.9
'SINK:
Data -3.7,-.5,-3.75,-2.99,-.5,-3.75,-3.7,-.9,-3.75,-2.99,-.9,-3.75
Data -3.7,-.5,-4.7,-2.99,-.5,-4.7,-3.7,-.9,-4.7,-2.99,-.9,-4.7
Data -3.7,-.5,-3.75,-3.7,-.5,-4.7,-3.7,-.9,-3.75,-3.7,-.9,-4.7
Data -2.99,-.5,-3.75,-2.99,-.5,-4.7,-2.99,-.9,-3.75,-2.99,-.9,-4.7
Data -3.7,-.9,-3.75,-3.7,-.9,-4.7,-2.99,-.9,-3.75,-2.99,-.9,-4.7


Data -3.2,-.1,-4.89,-3.5,-.1,-4.89,-3.2,-.1,-4.69,-3.5,-.1,-4.69
Data -3.2,-.2,-4.89,-3.5,-.2,-4.89,-3.2,-.2,-4.69,-3.5,-.2,-4.69
Data -3.2,-.1,-4.69,-3.5,-.1,-4.69,-3.2,-.2,-4.69,-3.5,-.2,-4.69
Data -3.2,-.1,-4.69,-3.2,-.2,-4.69,-3.2,-.1,-4.89,-3.2,-.2,-4.89
Data -3.5,-.1,-4.69,-3.5,-.2,-4.69,-3.5,-.1,-4.89,-3.5,-.2,-4.89

Data -10.1,-2,-4.9,4.9,-2,-4.9,-10.1,-.49,-4.9,4.9,-.49,-4.9
Data -10.1,-1.99,-5,4.9,-1.99,-5,-10.1,-1.99,-3.7,4.9,-1.99,-3.7
Data -10.1,.8,-4.9,4.9,.8,-4.9,-10.1,1.6,-4.9,4.9,1.6,-4.9
'cabinet doors
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
Data 1.85,-1.9,-3.71,1.85,-0.6,-3.71,2.8,-1.9,-3.71,2.8,-.6,-3.71
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
Data 2.85,-1.9,-3.71,2.85,-0.6,-3.71,3.8,-1.9,-3.7,3.8,-.6,-3.71
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
Data 3.85,-1.9,-3.71,3.85,-0.6,-3.71,4.8,-1.9,-3.71,4.8,-.6,-3.71
Data .85,1.55,-3.71,.85,0.6,-3.71,1.8,1.55,-3.71,1.8,0.6,-3.71
Data .85,-1.9,-3.71,.85,-0.6,-3.71,1.8,-1.9,-3.71,1.8,-.6,-3.71
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
Data -1.85,-1.9,-3.71,-1.85,-0.6,-3.71,-2.8,-1.9,-3.71,-2.8,-.6,-3.71
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
Data -2.85,-1.9,-3.71,-2.85,-0.6,-3.71,-3.8,-1.9,-3.7,-3.8,-.6,-3.71
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
Data -3.85,-1.9,-3.71,-3.85,-0.6,-3.71,-4.8,-1.9,-3.71,-4.8,-.6,-3.71
Data -.85,1.55,-3.71,-.85,0.6,-3.71,-1.8,1.55,-3.71,-1.8,0.6,-3.71
Data -.85,-1.9,-3.71,-.85,-0.6,-3.71,-1.8,-1.9,-3.71,-1.8,-.6,-3.71
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
Data -4.85,-1.9,-3.71,-4.85,-0.6,-3.71,-5.8,-1.9,-3.7,-5.8,-.6,-3.71
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
Data -5.85,-1.9,-3.71,-5.85,-0.6,-3.71,-6.8,-1.9,-3.71,-6.8,-.6,-3.71
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
Data -6.85,-1.9,-3.71,-6.85,-0.6,-3.71,-7.8,-1.9,-3.71,-7.8,-.6,-3.71
Data -9.98,-2,-5,-9.98,1,-5,-9.98,-2,0,-9.98,1,0
Data -9.97,-0.5,-3.4,-8.47,-.5,-3.4,-9.97,-0.5,0,-8.47,-.5,0
Data -9.97,-0.6,-3.4,-8.47,-.6,-3.4,-9.97,-0.6,0,-8.47,-.6,0
Data -9.97,.6,-3.7,-8.77,.6,-3.7,-9.97,.6,0,-8.77,.6,0
Data -9.97,.7,-3.7,-8.77,.7,-3.7,-9.97,.7,0,-8.77,.7,0
Data -9.97,1.6,-3.7,-8.77,1.6,-3.7,-9.97,1.6,0,-8.77,1.6,0
Data -9.97,1.7,-3.7,-8.77,1.7,-3.7,-9.97,1.7,0,-8.77,1.7,0
Data -9.97,-2,0,-8.77,-2,0,-9.97,-0.6,0,-8.77,-0.6,0
Data -9.97,1.6,0,-8.77,1.6,0,-9.97,0.7,0,-8.77,0.7,0
Data -9.97,-2,-.2,-8.77,-2,-.2,-9.97,-0.6,-.2,-8.77,-0.6,-.2
Data -9.97,1.6,-.2,-8.77,1.6,-.2,-9.97,0.7,-.2,-8.77,0.7,-.2
Data -9.97,1.7,0,-8.77,1.7,0,-9.97,1.6,0,-8.77,1.6,0
Data -9.97,-.5,0,-8.47,-.5,0,-9.97,-.6,0,-8.47,-.6,0
Data -9.97,.6,0,-8.77,.6,0,-9.97,.7,0,-8.77,.7,0
Data -8.77,1.7,0,-8.77,1.6,0,-8.77,1.7,-3.7,-8.77,1.6,-3.7
Data -8.47,-.5,0,-8.47,-.6,0,-8.47,-0.5,-3.7,-8.47,-0.6,-3.7
Data -8.77,.7,0,-8.77,.6,0,-8.77,.7,-3.7,-8.77,.6,-3.7
Data -8.77,-2,0,-8.77,-.6,0,-8.77,-2,-0.2,-8.77,-.6,-0.2
Data -8.77,1.6,0,-8.77,.7,0,-8.77,1.6,-0.2,-8.77,.7,-0.2
Data -8.77,-2,-1.9,-8.77,-.6,-1.9,-8.77,-2,-2,-8.77,-.6,-2
Data -8.77,1.6,-1.9,-8.77,.7,-1.9,-8.77,1.6,-2,-8.77,.7,-2
Data -8.77,-1.99,0,-9.97,-1.99,0,-8.77,-1.99,-3.7,-9.97,-1.99,-3.7
Data -9.97,-2,0,-9.97,-2,-4.9,-9.97,-.5,0,-9.97,-.5,-4.9
Data -9.97,1.6,0,-9.97,1.6,-4.9,-9.97,.6,0,-9.97,.6,-4.9
Data -8.77,-2,-3.7,-8.77,-.6,-3.7,-8.77,-2,-3.6,-8.77,-.6,-3.6
Data -8.77,1.6,-3.7,-8.77,.7,-3.7,-8.77,1.6,-3.6,-8.77,.7,-3.6

Data -8.77,-1.9,-2,-8.77,-.6,-2,-8.77,-1.9,-3.6,-8.77,-.6,-3.6
Data -8.77,1.6,-2,-8.77,.7,-2,-8.77,1.6,-3.6,-8.77,.7,-3.6

Data -8.77,-1.9,-.2,-8.77,-.6,-.2,-8.77,-1.9,-1.9,-8.77,-.6,-1.9
Data -8.77,1.6,-.2,-8.77,.7,-.2,-8.77,1.6,-1.9,-8.77,.7,-1.9: 'glased doors
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
Data -7.85,-1.9,-3.71,-7.85,-0.6,-3.71,-8.8,-1.9,-3.71,-8.8,-.6,-3.71
Data .85,1.55,-3.71,.85,0.6,-3.71,-.85,1.55,-3.71,-.85,0.6,-3.71
Data .85,-1.9,-3.71,.85,-0.6,-3.71,-.85,-1.9,-3.71,-.85,-.6,-3.71

'microwave

Data -9,-.5,-4.1,-8,-.5,-4.1,-9,0,-4.1,-8,0,-4.1
Data -9,-.5,-4.9,-8,-.5,-4.9,-9,0,-4.9,-8,0,-4.9
Data -9,0,-4.1,-8,0,-4.1,-9,0,-4.9,-8,0,-4.9
Data -9,0,-4.1,-9,-.5,-4.1,-9,0,-4.9,-9,-.5,-4.9
Data -8,0,-4.1,-8,-.5,-4.1,-8,0,-4.9,-8,-.5,-4.9



For r = 1 To N
    Read v(r).X, v(r).Y, v(r).Z 'all is placed on the same Y = the same floor
Next r

Set_texture podl&, 1, 4, 15 'set image img as texture for bottom  (triangles 1 to 4)
Set_texture str&, 5, 8, 3
Set_texture tokno&, 9, 12, 1
Set_texture dvere&, 13, 16, 1
w& = white&
Set_texture wh&, 17, 20, 1
Set_texture w&, 21, 24, 1 'wall at pc

Set_texture lednice&, 25, 28, 1
Set_texture w&, 29, 32, 1
Sw& = Swhite&
Set_texture Sw&, 33, 36, 1
Set_texture Sw&, 37, 40, 1
Set_texture orech&, 41, 44, 10
Set_texture orech&, 45, 48, 10

Set_texture orech&, 49, 52, 10
Set_texture orech&, 53, 56, 10
Set_texture orech&, 57, 60, 10
Set_texture orech&, 61, 64, 10
Set_texture polstr&, 65, 68, 3

Set_texture polstr&, 69, 72, 3
Set_texture polstr&, 73, 76, 3
Set_texture polstr&, 77, 80, 3
Set_texture orech&, 81, 84, 10
Set_texture orech&, 85, 88, 10
Set_texture orech&, 89, 92, 10
Set_texture orech&, 93, 96, 3
Set_texture orech&, 97, 100, 3
Set_texture orech&, 101, 104, 1
Set_texture orech&, 105, 108, 1
Set_texture orech&, 109, 112, 1
Set_texture orech&, 113, 116, 7

Set_texture orech&, 117, 120, 1
Set_texture orech&, 121, 204, 2
Set_texture orechsv&, 205, 220, 1
Set_texture orech&, 221, 292, 1

Set_texture orechsv&, 293, 308, 1
Set_texture orech&, 309, 316, 1
Set_texture orechsv&, 317, 328, 1
Set_texture orech&, 329, 400, 1
Set_texture orechsv&, 401, 416, 1
Set_texture orech&, 417, 424, 1
Set_texture orechsv&, 425, 432, 1

'po upgradu
Set_texture w&, 433, 437, 1 'wall

Set_texture dvere&, 437, 440, 1

Set_texture w&, 441, 444, 1

Set_texture dub&, 445, 453, 1 'pc desk
Set_texture tdub&, 454, 462, 1 'pc desk back
Set_texture dub&, 463, 480, 1
Set_texture tdub&, 481, 484, 1
Set_texture dub&, 485, 492, 1
Set_texture tdub&, 493, 512, 1
Set_texture dub&, 513, 520, 1

B& = Black&
Set_texture B&, 521, 524, 1D
sB& = SBlack&

Set_texture sB&, 525, 528, 1

Set_texture B&, 529, 532, 1
Set_texture pc&, 533, 536, 1

Set_texture sB&, 537, 540, 1 'MONITOR
Set_texture B&, 541, 548, 1 'MONITOR
N& = Noha&
Set_texture N&, 549, 552, 1 'MONITOR
Set_texture B&, 553, 556, 1
Set_texture kbd&, 557, 560, 1 'keyboard
Set_texture mys&, 561, 564, 1 'keyboard
Set_texture B&, 565, 576, 1 'woof
Set_texture sB&, 577, 580, 1 'subwoofer
Set_texture woof&, 581, 584, 1 'subwoofer
Set_texture B&, 585, 596, 1 'speakers
Set_texture speak&, 597, 600, 1
Set_texture B&, 601, 612, 1
Set_texture speak&, 613, 616, 1
'strana s linkou
Set_texture dvere&, 617, 620, 1 'doors
Set_texture dlazba&, 621, 624, 10
Set_texture w&, 625, 628, 1
Set_texture sporakcelo, 629, 632, 1
Set_texture sporakvrch, 633, 636, 1
Set_texture w&, 637, 648, 1
Set_texture dub&, 649, 652, 1
Set_texture tdub&, 653, 656, 5
Set_texture dub&, 657, 676, 5
Set_texture tdub&, 677, 680, 5
Set_texture dub&, 681, 796, 5
Set_texture tdub&, 797, 800, 5
Set_texture dub&, 801, 809, 5
Set_texture dub&, 809, 812, 5
Set_texture tdub&, 813, 816, 5
Set_texture tdub&, 817, 820, 5
Si& = Silver&
Set_texture Si&, 821, 836, 1
SiC& = SilverC&
Set_texture SiC&, 837, 840, 1
SiB& = SilverB&
Set_texture SiB&, 841, 860, 1
Set_texture dub&, 861, 872, 1
Set_texture tdub&, 873, 960, 1
Set_texture dlazba2&, 961, 964, 10
Set_texture tdub&, 965, 1004, 1
Set_texture dub&, 1005, 1064, 1
Set_texture tdub&, 1065, 1076, 1
Glass& = Sklo&
Set_texture Glass&, 1077, 1080, 1
Set_texture tdub&, 1081, 1096, 1
Set_texture mikro&, 1097, 1100, 1
Set_texture sB&, 1101, 1116, 1


valec -1, -.8, 4.7, -.6, 10, sB& ' vase
valec 6, -.5, 9, -.35, 10, Si&
valec -3.35, -.2, -4.8, -.3, 40, sB& 'water pipe
Zvalec -3.35, -.3, -4.8, -4.1, 40, sB& 'water pipe
valec -3.35, -.29, -4.1, -.4, 40, sB& 'water pipe

'this three vase are in cabinet with glased door
talir -9.1, .8, -1.45
talir -9.1, .8, -1.05
talir -9.1, .8, -.65

'cabinet handles
madlo -7.9, .8, -3.6
madlo -7.45, .8, -3.6
madlo -7.9, -.8, -3.4
madlo -7.45, -.8, -3.4

madlo -6, -.8, -3.4
madlo -5.45, -.8, -3.4
madlo -6, .8, -3.6
madlo -5.45, .8, -3.6

madlo -4.1, -.8, -3.4
madlo -3.45, -.8, -3.4
madlo -4.1, .8, -3.6
madlo -3.45, .8, -3.6

madlo -2.2, -.8, -3.4
madlo -1.45, -.8, -3.4
madlo -2.2, .8, -3.6
madlo -1.45, .8, -3.6

madlo -.3, -.8, -3.4
madlo -.3, .8, -3.6
madlo 1, -.8, -3.4
madlo 1, .8, -3.6
madlo 2, -.8, -3.4
madlo 2, .8, -3.6
madlo 3, -.8, -3.4
madlo 3, .8, -3.6
madlo 4, -.8, -3.4
madlo 4, .8, -3.6
madlo 8.5, -1, 7.9
madlo 8.5, -1.3, 7.9
Zmadlo -8.77, .8, -1
Zmadlo -8.77, .8, -2.75
Zmadlo -8.77, -.8, -1
Zmadlo -8.77, -.8, -2.75

minRadius = 1000

Do
    i$ = InKey$
    start = 0
    For r = 1 To N
        LenX = v(r).X - CX
        LenY = v(r).Y - CY
        LenZ = v(r).Z - CZ

        radius = Sqr(LenX ^ 2 + LenZ ^ 2)
        If minRadius < .4 Then minRadius = 1000
        If minRadius > radius Then minRadius = radius
        radiusH = Sqr(LenY ^ 2 + LenZ ^ 2)
        v(r).Radius = radius
        v(r).RadiusH = radiusH
        v(r).pi = JK!(CX, CZ, v(r).X, v(r).Z, radius)
        v(r).piH = JK!(CY, CZ, v(r).Y, v(r).Z, radiusH)
    Next r
    If Abs(rot) > _Pi(2) Then rot = 0
    oldposZ = posZ
    oldposX = posX
    Select Case i$
        Case Chr$(0) + Chr$(72): posZ = posZ + Cos(rot) / 2: posX = posX + -Sin(rot) / 2: posy = posy + -Sin(roth) / 2 'up
        Case Chr$(0) + Chr$(80): posZ = posZ - Cos(rot) / 2: posX = posX - -Sin(rot) / 2: posy = posy - -Sin(roth) / 2 'dn
        Case Chr$(0) + Chr$(75): rot = rot - .05
        Case Chr$(0) + Chr$(77): rot = rot + .05
        Case Chr$(27): Destructor ("textures.pmf"): System
    End Select

    '------------------------------
    If posZ > 3 Then posZ = 3
    If posZ < -7 Then posZ = -7
    If posX < -7 Then posX = -7
    If posX > 7 Then posX = 7


    Select Case posX
        Case -7 To -5: If posZ < -7 Then posX = oldposX: posZ = oldposZ
        Case -5 To 3: If posZ < -2 Then posX = oldposX: posZ = oldposZ
        Case 3 To 6: If posZ < -7 Then posX = oldposX: posZ = oldposZ
    End Select
    '-----------------------------
    CZ = -posZ
    CX = -posX
    CY = -posy

    For r = 1 To N
        x = CX + Sin(rot + v(r).pi) * v(r).Radius
        y = CY + Sin(roth + v(r).piH) * v(r).RadiusH
        z = CZ + Cos(rot + v(r).pi) * v(r).Radius
        v(r).wX = x + posX
        v(r).wY = y + posy
        v(r).wZ = z + posZ
    Next r
    minigame
    m33& = _CopyImage(m&, 33)
    Set_texture m33&, 537, 540, 1

    For zz = 1 To N Step 4
        If v(zz).T Then
            img& = v(zz).T
            w = _Width(img&)
            h = _Height(img&)
            num = v(zz).Tm
            If num = 0 Then num = 1
            _MapTriangle (0, h * num)-(w * num, h * num)-(0, 0), img& To(v(zz).wX, v(zz).wY, v(zz).wZ)-(v(zz + 1).wX, v(zz + 1).wY, v(zz + 1).wZ)-(v(zz + 2).wX, v(zz + 2).wY, v(zz + 2).wZ), 0, _Smooth
            _MapTriangle (w * num, h * num)-(0, 0)-(w * num, 0), img& To(v(zz + 1).wX, v(zz + 1).wY, v(zz + 1).wZ)-(v(zz + 2).wX, v(zz + 2).wY, v(zz + 2).wZ)-(v(zz + 3).wX, v(zz + 3).wY, v(zz + 3).wZ), 0, _Smooth
        End If
    Next zz

    Rem    infobox posx, posy, posz, rot, minradius

    _Display
    _FreeImage m33&
    _Limit 30
Loop


Sub INFOBOX (posx, posy, posz, rot, u)
    nfo& = _NewImage(640, 480, 32)
    W = 639: H = 479: X = -.5: Y = 0: Z = -1
    de = _Dest
    _Dest nfo&
    Color _RGB32(22, 61, 78)
    _PrintMode _KeepBackground
    Print "INFOBOX:"
    Print "Position X: "; posx
    Print "Position Y: "; posy
    Print "Position Z: "; posz
    Print "Angle: "; Abs(_R2D(rot))
    Print u

    _ClearColor _RGB32(0, 0, 0)
    _Dest de
    hnfo& = _CopyImage(nfo&, 33)
    _FreeImage nfo&
    _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)
    _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)

    _FreeImage hnfo&
End Sub




Sub madlo (x, y, z)
    tt = UBound(v) + 1
    ReDim _Preserve v(1 To tt - 1 + 12) As V
    N = N + 12
    If Sgn(x) >= 0 Then x2 = x + .2 Else x2 = x - .2
    If Sgn(y) >= 0 Then y2 = y + .05 Else y2 = y - .05
    If Sgn(z) < 0 Then z2 = z - .1 Else z2 = z + .1

    v(tt).X = x
    v(tt).Y = y
    v(tt).Z = z

    v(tt + 1).X = x
    v(tt + 1).Y = y2
    v(tt + 1).Z = z

    v(tt + 2).X = x2
    v(tt + 2).Y = y
    v(tt + 2).Z = z

    v(tt + 3).X = x2
    v(tt + 3).Y = y2
    v(tt + 3).Z = z

    '------------

    v(tt + 4).X = x
    v(tt + 4).Y = y
    v(tt + 4).Z = z

    v(tt + 5).X = x
    v(tt + 5).Y = y2
    v(tt + 5).Z = z

    v(tt + 6).X = x
    v(tt + 6).Y = y
    v(tt + 6).Z = z2

    v(tt + 7).X = x
    v(tt + 7).Y = y2
    v(tt + 7).Z = z2

    '------------

    v(tt + 8).X = x2
    v(tt + 8).Y = y
    v(tt + 8).Z = z

    v(tt + 9).X = x2
    v(tt + 9).Y = y2
    v(tt + 9).Z = z

    v(tt + 10).X = x2
    v(tt + 10).Y = y
    v(tt + 10).Z = z2

    v(tt + 11).X = x2
    v(tt + 11).Y = y2
    v(tt + 11).Z = z2

    Set_texture aluminium&, tt - 1, tt + 11, 1

End Sub


Sub Zmadlo (x, y, z)
    tt = UBound(v) + 1
    ReDim _Preserve v(1 To tt - 1 + 12) As V
    N = N + 12

    If Sgn(z) <= 0 Then z2 = z - .2 Else z2 = z + .2
    If Sgn(y) >= 0 Then y2 = y + .05 Else y2 = y - .05
    If Sgn(x) <= 0 Then x2 = x + .1 Else x2 = x - .1

    'predni obdelnik
    v(tt).X = x2
    v(tt).Y = y
    v(tt).Z = z

    v(tt + 1).X = x2
    v(tt + 1).Y = y2
    v(tt + 1).Z = z

    v(tt + 2).X = x2
    v(tt + 2).Y = y
    v(tt + 2).Z = z2

    v(tt + 3).X = x2
    v(tt + 3).Y = y2
    v(tt + 3).Z = z2

    '------------

    v(tt + 4).X = x
    v(tt + 4).Y = y2
    v(tt + 4).Z = z

    v(tt + 5).X = x2
    v(tt + 5).Y = y2
    v(tt + 5).Z = z

    v(tt + 6).X = x
    v(tt + 6).Y = y
    v(tt + 6).Z = z

    v(tt + 7).X = x2
    v(tt + 7).Y = y
    v(tt + 7).Z = z

    '------------

    v(tt + 8).X = x
    v(tt + 8).Y = y2
    v(tt + 8).Z = z2

    v(tt + 9).X = x2
    v(tt + 9).Y = y2
    v(tt + 9).Z = z2

    v(tt + 10).X = x
    v(tt + 10).Y = y
    v(tt + 10).Z = z2

    v(tt + 11).X = x2
    v(tt + 11).Y = y
    v(tt + 11).Z = z2

    Set_texture aluminium&, tt - 1, tt + 11, 1
End Sub

Sub Set_texture (num, start, eend, much)
    For s = start To eend
        v(s).T = num
        v(s).Tm = much
    Next s
End Sub


Function Hload& (fileName As String)
    h& = _LoadImage(fileName$, 32)
    hhh& = _CopyImage(h&, 33)
    Hload& = hhh&
    _FreeImage h&
End Function


Function SHload& (fileName As String)
    h& = _LoadImage(fileName$, 32)
    _SetAlpha 0, _RGB32(255, 255, 255) To _RGB32(200, 200, 200), h&
    hh& = _CopyImage(h&, 33)
    SHload& = hh&
    _FreeImage h&
End Function

Function strop&
    lamp& = _LoadImage("bodovka mala.jpg", 32)
    stro& = _NewImage(1024, 768, 32)
    de = _Dest
    _Dest stro&
    Cls , _RGB32(255, 255, 255)
    rX = 1024 / 4
    rY = 768 / 3
    For x = rX To 1024 - rX Step rX
        For y = rY To 768 - rY Step rY
            _PutImage (rX, rY), lamp&, stro&
    Next y, x
    _Dest de
    _FreeImage lamp&
    stroH = _CopyImage(stro&, 33)
    strop& = stroH
End Function

Function okno&
    ok& = _LoadImage("okn.jpg", 32)
    topco& = _LoadImage("topco.jpg", 32)
    okn& = _NewImage(1024, 512, 32)
    de = _Dest
    _Dest okn&
    Cls , _RGB32(250, 245, 255)
    _PutImage (512 - 150, 206 - 132), ok&, okn&

    _PutImage (380, 370), topco&, okn&
    _Dest de
    _FreeImage ok&
    _FreeImage topco&
    okn& = _CopyImage(okn&, 33)
    okno& = okn&
End Function

Function white&

    whit& = _NewImage(100, 100, 32)
    de = _Dest
    _Dest whit&
    Cls , _RGB32(250, 240, 250)
    _Dest de
    wh& = _CopyImage(whit&, 33)
    white& = wh&
    _FreeImage whit&

End Function

Function Swhite&

    whit& = _NewImage(100, 100, 32)
    de = _Dest
    _Dest whit&
    Cls , _RGB32(255, 255, 255)
    _Dest de
    whitH& = _CopyImage(whit&, 33)
    Swhite& = whitH&
    _FreeImage whit&

End Function


Function Braun&

    brau& = _NewImage(100, 100, 32)
    de = _Dest
    _Dest brau&
    Cls , _RGB32(111, 17, 39)
    _Dest de
    brauH& = _CopyImage(brau&, 33)
    Braun& = brauH&
    _FreeImage brau&

End Function


Function Black&

    blk& = _NewImage(100, 100, 32)
    de = _Dest
    _Dest blk&
    Cls , _RGB32(6, 17, 28)
    _Dest de
    blkH = _CopyImage(blk&, 33)
    Black& = blkH
    _FreeImage blk&

End Function

Function SBlack&

    blk& = _NewImage(100, 100, 32)
    de = _Dest
    _Dest blk&
    Cls , _RGB32(33, 28, 28)
    _Dest de
    blkH = _CopyImage(blk&, 33)
    SBlack& = blkH
    _FreeImage blk&

End Function

Function Silver&

    blk& = _NewImage(100, 100, 32)
    de = _Dest
    _Dest blk&
    e = 127 / 100
    For l = 0 To 99
        Line (0, l)-(99, l), _RGB32(255 - f, 255 - f, 255 - f)
        f = f + e
    Next l
    _Dest de
    blkH = _CopyImage(blk&, 33)
    Silver& = blkH
    _FreeImage blk&

End Function

Function SilverB&

    blk& = _NewImage(100, 100, 32)
    de = _Dest
    _Dest blk&
    e = 127 / 50
    For l = 0 To 50
        Line (l, l)-(100 - l, 100 - l), _RGB32(127 + f, 127 + f, 127 + f), B
        f = f + e
    Next l
    _Dest de
    blkH = _CopyImage(blk&, 33)
    SilverB& = blkH
    _FreeImage blk&

End Function


Function SilverC&

    blk& = _NewImage(100, 100, 32)
    de = _Dest
    _Dest blk&
    e = 127 / 50
    For l = 0 To 50
        Line (l, l)-(100 - l, 100 - l), _RGB32(255 - f, 255 - f, 255 - f), B
        f = f + e
    Next l
    _Dest de
    blkH = _CopyImage(blk&, 33)
    SilverC& = blkH
    _FreeImage blk&

End Function


Function spajz_dvere&
    dv& = _LoadImage("dvere.jpg", 32) '192 x 426
    de = _Dest
    spajz_dvere32& = _NewImage(640, 480, 32)
    _Dest spajz_dvere32&
    Cls , _RGB32(241, 244, 251)
    _PutImage (140, 54), dv&
    _Dest de
    spajz_dver& = _CopyImage(spajz_dvere32&, 33)
    spajz_dvere& = spajz_dver&
    _FreeImage spajz_dvere32&
End Function

Function Zesvetli& (file As String, o As Long)

    t& = _LoadImage(file$, 32)
    If o& < -1 Then _FreeImage o&
    w = _Width(t&)
    h = _Height(t&)
    zesvetli32& = _NewImage(w, h, 32)
    de = _Dest
    _Dest zesvetli32&
    _PutImage , t&, zesvetli32&

    Line (0, 0)-(w - 1, h - 1), _RGBA32(255, 255, 255, 30), BF
    _Dest de

    o& = _CopyImage(zesvetli32&, 33)
    Zesvetli& = o&
    _FreeImage t&
    _FreeImage zesvetli32&
End Function

Function Ztmav& (file As String, o&)
    t& = _LoadImage(file$, 32)
    If o& < -1 Then _FreeImage o&
    w = _Width(t&)
    h = _Height(t&)
    ztmav32& = _NewImage(w, h, 32)
    de = _Dest
    _Dest ztmav32&
    _PutImage , t&, ztmav32&
    Line (0, 0)-(w - 1, h - 1), _RGBA32(0, 0, 0, 30), BF
    _Dest de

    o& = _CopyImage(ztmav32&, 33)
    Ztmav& = o&
    _FreeImage t&
    _FreeImage ztmav32&
End Function

Function Noha&

    de = _Dest
    noh& = _NewImage(100, 100, 32)
    _Dest noh&
    Line (0, 40)-(100, 60), _RGB32(0, 22, 32), BF
    _ClearColor _RGB32(0, 0, 0), noh&
    _Dest de
    NohaH& = _CopyImage(noh&, 33)
    Noha& = NohaH&
    _FreeImage noh&

End Function

Function Noha2&

    de = _Dest
    noh& = _NewImage(100, 100, 32)
    _Dest noh&
    Line (30, 30)-(70, 70), _RGB32(0, 2, 12), BF
    _ClearColor _RGB32(0, 0, 0), noh&
    _Dest de
    Noha2H& = _CopyImage(noh&, 33)
    Noha2& = Noha2H&
    _FreeImage noh&

End Function


Function JK! (cx, cy, px, py, R) ' based on binary circle definition
    LenX = cx - px
    LenY = cy - py
    jR = 1 / R

    jX = LenX * jR
    jY = LenY * jR

    sinusAlfa = jX
    Alfa = Abs(_Asin(sinusAlfa))

    Q = 1
    If px >= cx And py <= cy Then Q = 1 ' select angle to quadrant
    If px >= cx And py <= cy Then Q = 2
    If px <= cx And py <= cy Then Q = 3
    If px <= cx And py >= cy Then Q = 4
    Select Case Q
        Case 1: alfaB = Alfa
        Case 2: alfaB = _Pi / 2 + (_Pi / 2 - Alfa)
        Case 3: alfaB = _Pi + Alfa
        Case 4: alfaB = _Pi(1.5) + (_Pi / 2 - Alfa)
    End Select
    JK! = alfaB
End Function

Sub valec (xs, ys, zs, ye, R, t&)
    tt = UBound(v) + 1
    polomer = R
    ReDim _Preserve v(1 To tt - 1 + 64) As V
    polo = _Pi(2) / 16
    N = N + 64

    For s = 0 To _Pi(2) Step polo
        ott = tt
        v(tt).X = xs + Sin(s) / polomer
        v(tt).Y = ys
        v(tt).Z = zs + Cos(s) / polomer
        tt = tt + 1
        v(tt).X = xs + Sin(s) / polomer
        v(tt).Y = ye
        v(tt).Z = zs + Cos(s) / polomer
        tt = tt + 1
        v(tt).X = xs + Sin(s + polo) / polomer
        v(tt).Y = ys
        v(tt).Z = zs + Cos(s + polo) / polomer
        tt = tt + 1
        v(tt).X = xs + Sin(s + polo) / polomer
        v(tt).Y = ye
        v(tt).Z = zs + Cos(s + polo) / polomer
        Set_texture t&, ott, tt, 1
        tt = tt + 1
    Next
End Sub

Sub Zvalec (xs, ys, zs, ze, R, t&)
    tt = UBound(v) + 1
    polomer = R

    ReDim _Preserve v(1 To tt - 1 + 64) As V

    polo = _Pi(2) / 16
    N = N + 64

    For s = 0 To _Pi(2) Step polo
        ott = tt
        v(tt).X = xs + Sin(s) / polomer
        v(tt).Y = ys + Cos(s) / polomer
        v(tt).Z = zs
        tt = tt + 1
        v(tt).X = xs + Sin(s) / polomer
        v(tt).Y = ys + Cos(s) / polomer
        v(tt).Z = ze
        tt = tt + 1
        v(tt).X = xs + Sin(s + polo) / polomer
        v(tt).Y = ys + Cos(s + polo) / polomer
        v(tt).Z = zs
        tt = tt + 1
        v(tt).X = xs + Sin(s + polo) / polomer
        v(tt).Y = ys + Cos(s + polo) / polomer
        v(tt).Z = ze
        Set_texture t&, ott, tt, 1
        tt = tt + 1
    Next
End Sub

Sub talir (x, y, z)
    radius0 = 0
    radius1 = .05
    radius2 = .1
    radius3 = .2
    ys = -Abs(y)
    ye = y - .1
    ys2 = ye
    ye2 = y + .2

    tt = UBound(v) + 1
    ReDim _Preserve v(1 To tt - 1 + 64) As V '16 a 16
    polo = _Pi(2) / 16
    N = N + 64

    For s = 0 To _Pi(2) Step polo
        ott = tt
        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)
        v(tt).Y = ys2
        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)
        tt = tt + 1
        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)
        v(tt).Y = ye2
        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)
        tt = tt + 1
        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)
        v(tt).Y = ys2
        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)
        tt = tt + 1
        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)
        v(tt).Y = ye2
        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)
        tt = tt + 1
        Set_texture SilverC&, ott, tt - 1, 1
    Next
End Sub

Function Sklo&

    de = _Dest
    skl = _NewImage(150, 100, 32)
    _Dest skl
    alfa = 127 / 25
    a = 120
    For x = 1 To 50
        a = a - alfa
        Line (0, x)-(150, x), _RGBA32(127, 127, 127, a)
    Next x

    For x = 50 To 100
        a = a + alfa
        Line (0, x)-(150, x), _RGBA32(127, 127, 127, a)
    Next x
    _Dest de

    SklH& = _CopyImage(skl, 33)
    Sklo& = SklH&
    _FreeImage skl

End Function

Sub minigame
    de = _Dest
    _Dest m&
    Cls , _RGB32(127, 120, 120)
    If ballX > 160 Then
        If rY + 25 < ballY Then rY = rY + 1 Else rY = rY - 1
        If ballX > (rXx - 10) Then
            If ballY > rY And ballY < rY + 50 Then mX = mX * -1
        End If
    End If

    If ballX < 160 Then
        If lY + 25 < ballY Then lY = lY + 1 Else lY = lY - 1
        If ballX < 20 Then

            If ballY > lY And ballY < lY + 50 Then mX = mX * -1

        End If
    End If

    ballX = ballX + mX
    ballY = ballY + mY

    If ballX > 315 Then mX = mX * -1: rightplr = rightplr + 1: ballX = ballX + mX + Sin(_Atan2(ballY, ballX))
    If ballX < 5 Then mX = mX * -1: leftplr = leftplr + 1: ballY = ballY + mY + Cos(_Atan2(ballY, ballX))

    If ballY > 235 Then mY = mY * -1 - _Atan2(ballY, ballX) / 2: ballY = ballY + mY
    If ballY < 5 Then mY = mY * -1 + _Atan2(ballY, ballX) / 2: ballY = ballY + mY


    If ballY >= lY And ballY <= lY + 60 And ballX <= 10 Then mY = mY * -1: ballY = ballY + mY - _Atan2(ballY, ballX)
    If ballY >= rY And ballY <= rY + 60 And ballX >= 300 Then mY = mY * -1: ballY = ballY + mY + _Acos(_Atan2(ballY, ballX))

    If lY > 180 Then lY = 180
    If lY < 10 Then lY = 10
    If rY > 180 Then rY = 180
    If rY < 10 Then rY = 10

    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)
    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)

    If Abs(mX) > 2 Then mX = mX / 2
    If Abs(mY) > 2 Then mY = mY / 2


    If ballX > 157 And ballX < 163 Then
        If ballY > 60 And ballY < 180 Then mX = mX * -1
        If ballY = 64 Or ballY = 180 Then mY = mY * -1
    End If
    Line (ballX - 2, ballY - 2)-(ballX + 2, ballY + 2), , B
    Line (3, 3)-(317, 237), , B
    Line (lX, lY)-(lX + 10, lY + 50), , B
    Line (rXx, rY)-(rXx - 10, rY + 50), , B
    Line (160, 60)-(160, 180)
    _PrintMode _KeepBackground
    popis = _PrintWidth(Str$(leftplr) + " - " + Str$(rightplr))

    _PrintString (160 - popis / 2, 5), Str$(leftplr) + " - " + Str$(rightplr)
    _Dest de
End Sub

Sub ExtractPMF (Vystup As String) ' here insert PMF file name for extracting files
    If _FileExists(Vystup) Then
        Print "Extracting files from "; Vystup$
        Type head
            identity As String * 16
            much As Long
        End Type
        Dim head As head
        e = FreeFile
        Open Vystup$ For Binary As #e
        Get #e, , head
        If head.identity = "Petr's MultiFile" Then Print "Head PASS" Else Print "Head Failure": Sleep 3: End
        Print "Total records in file:"; head.much
        Dim starts(head.much) As Long

        For celek = 1 To head.much
            Get #e, , starts(celek)
        Next

        Seek #e, 21 + head.much * 4 ' start DATA area
        For total = 1 To head.much
            If total = 1 Then velikost& = starts(1) - (21 + head.much * 4) Else velikost& = starts(total) - starts(total - 1)
            record$ = Space$(velikost&)
            Get #e, , record$
            i = FreeFile
            jmeno$ = "$Ext" + LTrim$(Str$(total))
            Open jmeno$ For Output As #i: Close #i: Open jmeno$ For Binary As #i
            Put #i, , record$
            Close #i
        Next total

        Dim NamesLenght(head.much) As Integer
        For NameIt = 1 To head.much
            Get #e, , NamesLenght(NameIt)
        Next NameIt

        Close #i
        For Name2 = 1 To head.much
            s$ = Space$(NamesLenght(Name2))
            Get #e, , s$
            jm$ = "$Ext" + LTrim$(Str$(Name2))
            erh:
            If _FileExists(s$) Then
                'Beep: Input "Warnig! Extracted file the same name already exists!!!! (O)verwrite, (R)ename or (E)xit? "; er$
                er$ = "o"
                Select Case LCase$(er$)
                    Case "o": Kill s$: Name jm$ As s$
                    Case "r": Input "Input new name"; s$: GoTo erh
                    Case "e": System
                End Select
            Else
                Name jm$ As s$
            End If
        Next Name2
        Close #e
        Print "All ok."
    Else
        Print "File "; Vystup$; " not found.": End
    End If
End Sub

Sub Destructor (vystup As String) 'delete files created by ExtractPMF
    Type head2
        identity As String * 16
        much As Long
    End Type
    If InStr(1, LCase$(vystup$), ".pmf") Then Else vystup$ = vystup$ + ".PMF"
    If _FileExists(vystup$) Then
        Close
        Dim head As head2
        e = FreeFile
        Open vystup$ For Binary As #e
        Get #e, , head
        Dim starts(head.much) As Long

        For celek = 1 To head.much
            Get #e, , starts(celek)
        Next

        Seek #e, starts(head.much) ' start DATA area
        Dim NamesLenght(head.much) As Integer
        For NameIt = 1 To head.much
            Get #e, , NamesLenght(NameIt)
        Next NameIt
        For Name2 = 1 To head.much
            s$ = Space$(NamesLenght(Name2))
            Get #e, , s$
            If _FileExists(s$) Then Kill s$
        Next Name2
        Close #e
    Else
        Print "Specified file not found": Sleep 3
    End If
End Sub

   

[mnrvovrfc]

+1 for the Ping-Pong game going on in that large screen!

[bplus]

Yes!!! and I remember the Christmas one.

[Petr]

The following example (3D) doesn't work quite well, so if anyone can fix it, I'd greatly appreciate it. First, a 2D program that, using the normal LINE command, shows the intention that the 3D program was supposed to carry out (how many times is it better to model it in 2D first, it is better to orientate yourself later, when it is in 3D)

Code: (Select All)

Screen _NewImage(1024, 768, 256)
krok = _Pi / 400 'sine draw 200 pixels before and 200 pixels after mouseX

Do
    While _MouseInput: Wend
    mx = _MouseX

    If x > 1024 Then x = 0
    x = x + 10

    If x < mx - 200 Or x > mx + 200 Then
        y1 = 350
        y2 = 350
        If mx > 200 Then sinP = 0 Else sinP = (200 - mx) * krok
    Else
        y1 = 350 + Sin(sinP) * 250
        y2 = 350 + Sin(sinP + krok * 10) * 250
        sinP = sinP + krok * 10
    End If
    Line (x, 0)-(x + 10, 767), 0, BF
    Line (x, y1)-(x + 10, y2)
Loop

Move the mouse in the X-axis. The deflection shows the intended intention. Just turn it around in your head as if the downward deflection is the direction in the Z axis, into the distance. This is the intended deformation of the image - zooming in the form of a wave (relative to the mouse) or zooming out, it doesn't matter, it's just a sign.

The 3D implementation follows, but it works - incorrectly. First, you need to be aware of the limitations of hardware images. It depends on your computer's graphics card, my computer is just weak, so I had to split the image into 2500 hardware images. These are then rendered. It is necessary to recalculate the mouse coordinates and there is a problem. 3D Maptriangle is not very suitable for normal 2D rendering, notice after launch that the mouse reacts across the width of the screen, but the 3D view is rendered depending on the distance. Try it yourself by changing the Z-axis coordinates on lines 41, 42 and 46, 47, just change the number -4 to another negative number. A negative number indicates the distance in depth, a positive number would mean that the object is in front of the monitor (behind your back) and therefore will not be rendered.

Move the mouse over the image in the X-axis, a wave will be formed with the image, as the intention showed in the previous case - but not quite accurate. And that is the question. Why is the wave not accurate?

Code: (Select All)

S = _ScreenImage
dW = Fix(_DesktopWidth / 50)
dH = Fix(_DesktopHeight / 50)

Screen _NewImage(_DesktopWidth, _DesktopHeight, 32)

Dim T(49, 49) As Long
For y = 0 To 49
    For x = 0 To 49
        V = _NewImage(dW, dH, 32)
        _PutImage (0, 0), S, V, (x * dW - 1, y * dH - 1)-(x * dW + dW - 1, y * dH + dH - 1)
        T(x, y) = _CopyImage(V, 33)
        _FreeImage V
    Next x
Next y
'above we converting screen image to small hardware images, 50 in X axis, 50 in Y axis, total 2500 textures


'let set 3DX from -3 to 3:
X3Dstp = 6 / 50 ' step for 3D drawing in X (we are here in OpenGL coordinate system)
krok = _Pi / 10 ' step for SINUS, it draws depth in this example

'let set 3DY from -3 to 3:
Y3Dstp = 6 / 50 ' step for Y drawing for 3D

x3d = -3 'default values
Y3D = -3

Do
    For yy = 0 To 49 'both FOR loops are here use for array T, not for drawing!
        SinP = 0
        For xx = 0 To 49
            While _MouseInput: Wend

            mxo = -_DesktopWidth / 2 + _MouseX 'because MapTriangle 3D use Open GL coordinate system, mouse coordinates must be recalculated
            mx = mxo / 6 / 50

            x3d = x3d + X3Dstp '                Variable for drawing in X axis

            If x3d < mx - X3Dstp * 5 Or x3d > mx + X3Dstp * 5 Then 'condition for mouse effect
                Z = -4
                Z2 = -4
                If mx < X3Dstp * 5 Then SinP = 0 Else SinP = (X3Dstp * 5 - mx) * krok
                If mx > X3Dstp * 5 Then SinP = 0 Else SinP = (X3Dstp * 5 + mx) * krok
            Else
                Z = -4 + Sin(SinP) / 2
                Z2 = -4 + Sin(SinP + krok) / 2
                SinP = SinP + krok
            End If

            _MapTriangle (0, dH)-(dW, dH)-(0, 0), T(xx, 49 - yy) To(x3d, Y3D, Z)-(x3d + X3Dstp, Y3D, Z2)-(x3d, Y3D + Y3Dstp, Z), 0 'draw hardware images to screen (note the swapping of coordinates, as OpenGL renders in reverse)
            _MapTriangle (dW, dH)-(0, 0)-(dW, 0), T(xx, 49 - yy) To(x3d + X3Dstp, Y3D, Z2)-(x3d, Y3D + Y3Dstp, Z)-(x3d + X3Dstp, Y3D + Y3Dstp, Z2), 0

        Next xx
        x3d = -3 '           reset X3D variable used for drawing to default value
        Y3D = Y3D + Y3Dstp '  Y3D is used for drawing in 3D
    Next yy
    Y3D = -3 '                reset Y3D to default value
    _Display '                show it all
    _Limit 20
Loop

[MasterGy]

I tried the kitchen! love it ! it has a very good atmosphere and everything is realistic. congrats!!! continue !

[Petr]

Glad you like it MasterGy.

Here, in the depths of the harddrive, I found my Christmas post for 2020, which BPlus writes about above. I had to modify some functions for QB64PE. This source code is... somewhat larger. It uses the method of packaging files into the source code using Base64. Besides the animation of Santa and the song in the background, Mr. SmcNeill, it's really not Russian, there is an attempt to program everything displayed in this program. Even the parody about the fire in the fireplace, which was not successful at all. It loads first - it takes longer because I wrote both a Base64 decoder and a Base64 encoder over strings at the time and that's actually slower than AND, AndyA wrote a faster version of the Base64 decoder, I don't know if it's on the forum?

Santa comes to the house on a sleigh (drawn in painting) and then the program switches to 3D, that's why it's in this thread and there it's already been done in the form of rotating the camera in the room, movement is not allowed at all, it was only intended as a short video.

Remember one thing: Real good audio speaker is BIG audio speaker (you can see it at the end this program) 

EDIT:

I wanted to add the source code here in the source code window, but the result was that this post appeared to be completely empty, so I had to delete it and create a new one here. So I am attaching the program packed to ZIP file (it only contains the BAS file, which could not be inserted here).