MapTriangle (3D) demos
#5
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 Smile 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 Smile 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



   


Attached Files
.zip   textures.zip (Size: 800.06 KB / Downloads: 19)


Reply


Messages In This Thread
MapTriangle (3D) demos - by Petr - 03-21-2023, 03:58 PM
RE: MapTriangle (3D) demos - by Petr - 03-21-2023, 05:47 PM
RE: MapTriangle (3D) demos - by mnrvovrfc - 03-24-2023, 04:33 AM
RE: MapTriangle (3D) demos - by bplus - 03-24-2023, 05:16 AM
RE: MapTriangle (3D) demos - by Petr - 03-24-2023, 10:58 PM
RE: MapTriangle (3D) demos - by mnrvovrfc - 03-24-2023, 11:32 PM
RE: MapTriangle (3D) demos - by bplus - 03-24-2023, 11:54 PM
RE: MapTriangle (3D) demos - by Petr - 03-26-2023, 04:53 PM
RE: MapTriangle (3D) demos - by MasterGy - 03-28-2023, 05:05 PM
RE: MapTriangle (3D) demos - by Petr - 03-28-2023, 07:42 PM



Users browsing this thread: 4 Guest(s)