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