'editor wall/ceil/bottom 3D Alpha 2
' 24 = 25 = 27 = 26 =
'$include:'saveimage.bi'
imgA
AS LONG 'aktivni tlacitko imgB
AS LONG 'neaktivni tlacitko
'pro SAVEMAP ----------------------------------
Identity
AS STRING * 5 'MAP2D, nebo MAP3D 5 B Nr_of_Textures
AS LONG 'pocet textur v souboru 4 B Nr_of_Vertexes
AS LONG 'pocet vrcholu v souboru 4 B DataStart
AS LONG 'dodatecny udaj o mistu v souboru, kde zacinaji data textur 4 B VertexStart
AS LONG 'dodatecny udaj o mistu v souboru, kde zacinaji data vrcholu 4 B
Flag
AS _UNSIGNED _BYTE 'typ, udavajici, jestli na mape v danem miste je zed, strop, podlaha, nebo stena a strop.... podle toho z ktereho pole zaznam pochazi
'upgrade 01u14-2ba
Height_From
AS SINGLE 'vyskova pozice - start Height_To
AS SINGLE 'vyskova pozice - konec u stropu a podlah v rovince to bude stejne
CONST SaveMap3D$
= "MAP3D" ' pro SAVEMAP konec----------------------------
'GridEndX a GridEndY bude mozne nastavit tlacitkem Grid, pote ulozit do INI souboru
DIM SHARED StartDrawX
, EndDrawX
, StartDrawy
, EndDrawy
, TextureIN
, GridXResolution
, GridYResolution
, GridRGB32Color~&
, GridVisibility
, GridShowComments
, GridCommentsTime
'urcujici promenne pro kresbu mrizky
'nove sdilene promenne ohledne doplnkoveho pole InfoPlus (IP):
DIM SHARED Img_Height_From
, Img_Height_To
, Img_Textures_per_Object
, Img_Texture_Effect
, Ceil_Height_From
, Ceil_Height_To
, Ceil_Textures_per_Object
, Ceil_Texture_Effect
, Floor_Height_From
, Floor_Height_To
, Floor_Textures_per_Object
, Floor_Texture_Effect
LoadINI
'PRINT GridXResolution, GridYResolution: SLEEP
REDIM SHARED Grid_img
(GridXResolution
, GridYResolution
) AS LONG 'puvodne pro cislo snimku, nevedomky pouzito pro zed. Cili pro zed, REDIM SHARED Grid_Ceil
(GridXResolution
, GridYResolution
) AS LONG 'cislo snimku pro strop REDIM SHARED Grid_Floor
(GridXResolution
, GridYResolution
) AS LONG 'cislo snimku pro podlahu
'doplnkova pole nesouci informace o vyskove pozici zdi/podlah/stropu, poctu textur na teleso a texturovem efektu
REDIM SHARED IP_Img
(GridXResolution
, GridYResolution
) AS InfoPlus
REDIM SHARED IP_Ceil
(GridXResolution
, GridYResolution
) AS InfoPlus
REDIM SHARED IP_Floor
(GridXResolution
, GridYResolution
) AS InfoPlus
'StartDrawX = 1
'StartDrawy = 1
'EndDrawX = 36
'EndDrawy = 35
Button(0).active = 0: Button(0).time = 0: Button(0).text = "Ok˙": Button(0).x = 612: Button(0).y = 580 'pro aktivaci nastav DIALOG na 2
Button(1).active = 0: Button(1).time = 0: Button(1).text = "Add Texture": Button(1).x = 945: Button(1).y = 680
Button(14).active = 0: Button(14).time = 0: Button(14).text = "Delete Texture": Button(14).x = 945: Button(14).y = 720
Button(6).active = 0: Button(6).time = 0: Button(6).text = "Add Object": Button(6).x = 885: Button(6).y = 680
Button(7).active = 0: Button(7).time = 0: Button(7).text = "Delete Object": Button(7).x = 885: Button(7).y = 720
Button(8).active = 0: Button(8).time = 0: Button(8).text = "Rotate Object": Button(8).x = 825: Button(8).y = 680
Button(2).active = 0: Button(2).time = 0: Button(2).text = "Wall Height": Button(2).x = 825: Button(2).y = 720
Button(3).active = 0: Button(3).time = 0: Button(3).text = "Load Map": Button(3).x = 765: Button(3).y = 680
Button(4).active = 0: Button(4).time = 0: Button(4).text = "Save Map": Button(4).x = 765: Button(4).y = 720
Button(5).active = 0: Button(5).time = 0: Button(5).text = "New Map": Button(5).x = 705: Button(5).y = 680
Button(9).active = 0: Button(9).time = 0: Button(9).text = "Set Grid": Button(9).x = 705: Button(9).y = 720
Button(10).active = 0: Button(10).time = 0: Button(10).text = "Draw Floor": Button(10).x = 645: Button(10).y = 680
Button(11).active = 0: Button(11).time = 0: Button(11).text = "Draw Ceiling": Button(11).x = 645: Button(11).y = 720
Button(12).active = 1: Button(12).time = 0: Button(12).text = "Draw Wall": Button(12).x = 585: Button(12).y = 680
Button(13).active = 0: Button(13).time = 0: Button(13).text = "Quit": Button(13).x = 585: Button(13).y = 720
Button(15).text = "Yes": Button(15).x = 412: Button(15).y = 380
Button(16).text = "No˙": Button(16).x = 480: Button(16).y = 380
'DIALOG = 1
Icony(1) = LOADICO("ico\left.ico", 3)
Icony(2) = LOADICO("ico\right.ico", 3)
Icony(3) = LOADICO("ico\up.ico", 3)
Icony(4) = LOADICO("ico\dn.ico", 3)
Icony(5) = LOADICO("ico\ot.ico", 4)
Icony(6) = LOADICO("ico\film.ico", 2)
'pro funkci Browse
Icony(7) = LOADICO("ico\invalid.ico", 7)
Icony(8) = LOADICO("ico\ko.ico", 1)
Icony(9) = LOADICO("ico\oke.ico", 1)
Icony(10) = LOADICO("ico\sup.ico", 7)
Icony(11) = LOADICO("ico\sdn.ico", 7)
TextureIN = Icony(6)
Icony(12) = ROTO(90)
'_CLEARCOLOR _RGB32(0, 0, 0), Icony(12)
TextureIN = 0
'Init_Screen
Create_Buttons 'vytvori tlacitka a jejich kresbu
'Texture(0).img = _LOADIMAGE("textures\a.jpg", 32)
'Texture(1).img = _LOADIMAGE("textures\a.jpg", 32)
'Texture(2).img = _LOADIMAGE("textures\a.jpg", 32)
'Texture(3).img = _LOADIMAGE("textures\a.jpg", 32)
'Texture(4).img = _LOADIMAGE("textures\dub.jpg", 32)
'Texture(5).img = _LOADIMAGE("textures\a.jpg", 32)
'Texture(6).img = _LOADIMAGE("textures\dub.jpg", 32)
'Texture(7).img = _LOADIMAGE("textures\a.jpg", 32)
'Texture(8).img = _LOADIMAGE("textures\dub.jpg", 32)
TextureStart = 0: TextureEnd = 6
'Grid_img(10, 10) = _SCREENIMAGE
'Grid_typ(10, 10) = 1
'Grid_rot(10, 10) = 45
' WHILE _MOUSEINPUT: WEND
Init_Screen
Init_Objects
IF k&
THEN KEYBOARDAGENT
= 1 ELSE KEYBOARDAGENT
= 0
New_Texture_Name$ = Browse("JPGBMPGIFPNG")
'odfiltrovat cesty
new_texture
= _LOADIMAGE(New_Texture_Name$
, 32) 'spusti program na prochazeni souboru na disku a umozni zvolit texturu Texture
(UBOUND(Texture
)).img
= new_texture
Texture
(UBOUND(Texture
)).path
= New_Texture_Name$
' CLS: PRINT Texture(UBOUND(Texture)).path: _DISPLAY: SLEEP
TextureStart
= UBOUND(Texture
) - 6: TextureEnd
= UBOUND(Texture
)
Reset_Mouse
CASE 2: Wall_Height: Reset_Mouse
CASE 3:
IF IS_EMPTY_GRID
THEN LOAD_MAP
(Browse
("MAP")) ELSE DialogW
"Save this MAP?", 5: LOAD_MAP
(Browse
("MAP")): Reset_Mouse
CASE 4: DialogW
"Save MAP as:", 2: Reset_Mouse
'SAVE_MAP ("testC.map") 'ulozeni mapy, dodelat dotaz na jmeno mapy, testy souborove pritomnosti a tak dale CASE 5: DialogW
"", 4: Reset_Mouse
'NEW MAP CASE 6: New_Object$
= Browse
("OBJ"): Reset_Mouse
'NewObject = LOADOBJECT (Browse("OBJ"))
CASE 9: SetGrid: Reset_Mouse
Button(10).active = 1: Button(11).active = 0: Button(12).active = 0: Reset_Mouse 'rozliseni musi resit Init_Screen
CASE 11 ' ceiling podlaha Button(11).active = 1: Button(10).active = 0: Button(12).active = 0: Reset_Mouse
Button(12).active = 1: Button(10).active = 0: Button(11).active = 0: Reset_Mouse
CASE 13: DialogW
"Save work and exit?", 1: Reset_Mouse
CASE 14: DELETE_TEXTURE: Reset_Mouse
'this is now developed
Max_Width = Max_Width + 10
IF FreeX
> Max_Width
THEN placeX
= X
+ 10 ELSE placeX
= X
- 10 - Max_Width
IF FreeY
> Max_Height
THEN placeY
= Y
+ 10:
ELSE placeY
= Y
- 10 - Max_Height
LINE (placeX
, placeY
)-(placeX
+ Max_Width
, placeY
+ Max_Height
), _RGB32(70, 70, 70), BF
LINE (placeX
, placeY
)-(placeX
+ Max_Width
, placeY
+ Max_Height
), _RGB32(155, 155, 155), B
LINE (placeX
+ 2, placeY
+ 2)-(placeX
+ Max_Width
- 2, placeY
+ Max_Height
- 2), _RGB32(155, 155, 155), B
by = placeY + 5
by = placeY + 5
L
= Max_Width
/ _FONTWIDTH - LEN(c
(W
)) - 1 'in graphic mode: (Max_Width - _PRINTWIDTH(c(W))) / _FONTWIDTH - 10 Reset_Mouse
Max_Width = Max_Width + 10
PRINT Max_Width
, Max_Height
'asi ok
'tedko: Kdyz neni dost mista od X vlevo, umisti komentar doprava. Pokud neni dost mista pro komentar nad Y, umisti ho pod Y.
FreeX
= _WIDTH - X
- Max_Width
- 10 ' kolik je volneho mista v ose x od x doprava FreeY
= _HEIGHT - Y
- Max_Height
- 10 ' kolik je volneho mista v ose y od y dolu
IF FreeX
> Max_Width
THEN placeX
= X
+ 10 ELSE placeX
= X
- 10 - Max_Width
IF FreeY
> Max_Height
THEN placeY
= Y
+ 10 ELSE placeY
= Y
- 10 - Max_Height
LINE (placeX
, placeY
)-(placeX
+ Max_Width
, placeY
+ Max_Height
), _RGB32(255, 255, 0), BF
LINE (placeX
, placeY
)-(placeX
+ Max_Width
, placeY
+ Max_Height
), _RGB32(127, 127, 127), B
LINE (placeX
+ 2, placeY
+ 2)-(placeX
+ Max_Width
- 2, placeY
+ Max_Height
- 2), _RGB32(127, 127, 127), B
_MAPTRIANGLE (0, 0)-(19, 0)-(19, 19), Yellow&
TO(placeX
+ (Max_Width
/ 2) - 30, placeY
+ Max_Height
)-(placeX
+ (Max_Width
/ 2) + 30, placeY
+ Max_Height
)-(X
, Y
) LINE (placeX
+ (Max_Width
/ 2) - 30, placeY
+ Max_Height
)-(X
, Y
), _RGB32(127, 127, 127) LINE (placeX
+ (Max_Width
/ 2) + 30, placeY
+ Max_Height
)-(X
, Y
), _RGB32(127, 127, 127)
_MAPTRIANGLE (0, 0)-(19, 0)-(19, 19), Yellow&
TO(placeX
+ (Max_Width
/ 2) - 30, placeY
)-(placeX
+ (Max_Width
/ 2) + 30, placeY
)-(X
, Y
) LINE (placeX
+ (Max_Width
/ 2) - 30, placeY
)-(X
, Y
), _RGB32(127, 127, 127) LINE (placeX
+ (Max_Width
/ 2) + 30, placeY
)-(X
, Y
), _RGB32(127, 127, 127)
'spocitam stred kazde vety a tam to napisu
PrintPosition
= (Max_Width
- _PRINTWIDTH(C
(PrintInfo
))) / 2
ch$
= MID$(C
(PrintInfo
), TextEdit
, 1)
LINE (198, 200)-(822, 568), _RGB32(70, 70, 70), BF
LINE (198, 200)-(822, 568), _RGB32(155, 155, 155), B
LINE (200, 202)-(820, 566), _RGB32(155, 155, 155), B
OldRoto = rotos
' IF Img_Textures_per_Object = 1 THEN aft$ = " object" ELSE aft$ = " objects"
_PRINTSTRING (230, 233), "Textures per 1 Object: " + STR$(Img_Textures_per_Object
) '-------------------------------------------------------------------------------------------------
'nastavovaci veticka pro nastaveni vysky zdi od do
'nastavovaci veticka pro nastaveni vysky zeme od do
'nastavovaci veticka pro nastaveni vysky stropu od do
'_PRINTSTRING (600, 233), "Apply texture filter:" 'efect, bude tu dalsi ROLLMENU
LINE (225, 465)-(395, 480), _RGB32(255, 255, 255), B
LINE (465, 465)-(635, 480), _RGB32(255, 255, 255), B
oke = LOADICO("ico/oke.ico", 1)
bck = LOADICO("ico/ko.ico", 1)
IF ONPOS
(_MOUSEX, _MOUSEY, 300, 500, 385, 530) THEN LINE (300, 500)-(385, 530), _RGBA32(170, 170, 170, 60), BF:
IF _MOUSEBUTTON(1) THEN SaveINI: complete
= 1 'OK LINE (300, 500)-(385, 530), _RGB32(255, 255, 255), B
LINE (640, 500)-(725, 530), _RGBA32(170, 170, 170, 60), BF
Img_Textures_per_Object = 1
Img_Height_From = -2
Img_Height_To = 2
Floor_Height_From = -2
Floor_Height_To = -2
Ceil_Height_From = 2
Ceil_Height_To = 2
rotos = 0
LINE (640, 500)-(725, 530), _RGB32(255, 255, 255), B
'upgrade pro copy styl (mozna doplnit i DELETE styl?)
copy_style(1) = "Rewrite ALL (walls, floors, objects, ceilings) in destination area"
copy_style(2) = "Rewrite JUST ACTIVE object (if is active button WALL, rewrite WALLs...)"
LINE (595, 220)-(750, 235), _RGBA32(127, 127, 127, 100), BF
Reset_Mouse
INSERT_SETUP = 0
'new software construction
Img_Textures_per_Object = Img_Textures_per_Object + DoubleArrow(450, 220)
Img_Height_From = Img_Height_From + DoubleArrow(450, 250)
Img_Height_To = Img_Height_To + DoubleArrow(450, 280)
Floor_Height_From = Floor_Height_From + DoubleArrow(450, 310)
Floor_Height_To = Floor_Height_To + DoubleArrow(450, 340)
Ceil_Height_From = Ceil_Height_From + DoubleArrow(450, 370)
Ceil_Height_To = Ceil_Height_To + DoubleArrow(450, 400)
rotos = rotos + DoubleArrow(450, 430)
NewTexture& = ROTO(rotos): OldRoto = rotos
LINE (225, 465)-(395, 480), _RGBA32(127, 127, 127, 100), BF
LINE (465, 465)-(635, 480), _RGBA32(127, 127, 127, 100), BF
Img_Textures_per_Object = 1
Img_Height_From = -2
Img_Height_To = 2
Floor_Height_From = -2
Floor_Height_To = -2
Ceil_Height_From = 2
Ceil_Height_To = 2
rotos = 0
NTN$ = GET_NEW_TEXTURE_NAME
Texture(u + 1).img = NewTexture&
Texture(u + 1).path = NTN$
'SteveMcNeil's saveimage utility 'older version, not JPG
res
= SaveImage
(Texture
(u
+ 1).path
, NewTexture&
, 0, 0, _WIDTH(NewTexture&
), _HEIGHT(NewTexture&
))
z$ = "Rotated_texture"
GET_NEW_TEXTURE_NAME$
= _CWD$ + "\textures\" + z$
+ STR$(nr
) + ".PNG" nr = nr + 1
CLS , 0 'for transparent background x = w / 2: y = h / 2
px(0) = -w \ 2: py(0) = -h \ 2: px(3) = w \ 2: py(3) = -h \ 2
px(1) = -w \ 2: py(1) = h \ 2: px(2) = w \ 2: py(2) = h \ 2
sinr
= SIN(angle
/ 57.2957795131): cosr
= COS(angle
/ 57.2957795131) x2 = (px(i) * cosr + sinr * py(i)) + x: y2 = (py(i) * cosr - px(i) * sinr) + y
px(i) = x2: py(i) = y2
_MAPTRIANGLE (0, 0)-(0, h
- 1)-(w
- 1, h
- 1), TextureIN
TO(px
(0), py
(0))-(px
(1), py
(1))-(px
(2), py
(2)), ROTO&
_MAPTRIANGLE (0, 0)-(w
- 1, 0)-(w
- 1, h
- 1), TextureIN
TO(px
(0), py
(0))-(px
(3), py
(3))-(px
(2), py
(2)), ROTO&
SUB DELETE_TEXTURE
'odstrani texturu ze seznamu textur. ' TextureIN je sdilena promenna vracejici cislo zvolene textury
'nejprve otestuju pole Grid(X,Y).img jestli tam je tato hodnota pouzita, pak oskenuju pole Texture(N).img, kde je tato hodnota pouzita, a tu smazu.
'podle testu funkce LOADIMAGE, dojde ke smazani jedine, konkretni ikony. Pokud je stejny obrazek nacten jako dalsi ikona, ma uz jine ID a zustane.
'test polr Grid:
' REDIM Tex(0) AS LONG
'zkusim jen rychlou opravu rozlisenim podle rezimu editoru, stim, ze toto funguje pro wall mode, tak jen udelam dalsi 2 kopie podle tlacitka podle jejich hodnoty .active
value = Grid_img(Gsx, Gsy)
swp(used).v1 = Gsx
swp(used).v2 = Gsy
used = used + 1
IF Texture
(scn
).img
= TextureIN
THEN DelRec
= scn:
EXIT FOR 'je mozna jen jedna shoda!
a1 = swp(EraseGrid).v1
a2 = swp(EraseGrid).v2
Grid_img(a1, a2) = 0: Grid_typ(a1, a2) = 0
value = Grid_Ceil(Gsx, Gsy)
swp(used).v1 = Gsx
swp(used).v2 = Gsy
used = used + 1
IF Texture
(scn
).img
= TextureIN
THEN DelRec
= scn:
EXIT FOR 'je mozna jen jedna shoda!
'vlastni vymaz
a1 = swp(EraseGrid).v1
a2 = swp(EraseGrid).v2
Grid_Ceil(a1, a2) = 0: Grid_typ(a1, a2) = 0 'bude chtit upgrade podle kombinace poli
_DELAY .3 'nutne, jinak na jedno kliknuti smazes osm az deset prdeli textur
value = Grid_Floor(Gsx, Gsy)
swp(used).v1 = Gsx
swp(used).v2 = Gsy
used = used + 1
'pole swp ted obsahuje indexy v1 a v2, kde se nachazi tato textura na mrizce. Velikost swp urcuje pocet vyskytu. OK
IF Texture
(scn
).img
= TextureIN
THEN DelRec
= scn:
EXIT FOR 'je mozna jen jedna shoda!
'vlastni vymaz
a1 = swp(EraseGrid).v1
a2 = swp(EraseGrid).v2
Grid_Floor(a1, a2) = 0: Grid_typ(a1, a2) = 0 'bude chtit upgrade podle kombinace poli
_DELAY .3 'nutne, jinak na jedno kliknuti smazes osm az deset prdeli textur
'test na pritomnost v ostatnich polich
test:
IF Grid_img
(scn1
, scn2
) = TextureIN
THEN Is_in_img
= 1 IF Grid_Floor
(scn1
, scn2
) = TextureIN
THEN Is_in_floor
= 1 IF Grid_Ceil
(scn1
, scn2
) = TextureIN
THEN Is_in_ceil
= 1
killimage:
Texture(DelRec).img = 0: Texture(DelRec).path = ""
i = 0
record = Texture(EraseNULL).img
NT(i) = record
Ntt(i) = Texture(EraseNULL).path
i = i + 1
Texture(reload).img = NT(reload)
Texture(reload).path = Ntt(reload)
PRINT "Zaznam: "; k;
"Hodnota ( spravne < 1): "; Texture
(k
).img
PRINT "Hodnota pro TextureStart: "; TextureStart
PRINT "Hodnota pro TextureEnd: "; TextureEnd
'pro ucely programu bude prochazet pouze slozku \Textures
'limited acces routine in this version
CASE "JPGBMPGIFPNG": path$
= _CWD$ + "\textures\*.*": text$
= "Select texture:": dir$
= "TEXTURES": path2$
= _CWD$ + "\textures\" CASE "OBJ": path$
= _CWD$ + "\obj\*.obj": text$
= "Select object:": dir$
= "OBJ": path2$
= _CWD$ + "\obj\" CASE "MAP": path$
= _CWD$ + "\map\*.map": text$
= "Select map:": dir$
= "MAP": path2$
= _CWD$ + "\map\"
LINE (222, 166)-(824, 568), _RGB32(70, 70, 70), BF
LINE (222, 166)-(824, 568), _RGB32(200, 200, 200), B
LINE (224, 168)-(822, 566), _RGB32(200, 200, 200), B
LINE (250, 210)-(500, 530), _RGB32(255, 255, 255), B
'ramecek pro nahled
LINE (550, 210)-(796, 530), _RGB32(255, 255, 255), B
'kontrola existence danych podadresaru
'vypis do swapovaciho souboru pres DIR
c$ = "dir *.* > __swap-.txt /B"
i = i + 1
' KILL "__swap-.txt"
PRINT "Fatal error: Can not creating swap file using DIR on ";
_CWD$;
" program line 952."
'filtrace podle masky v pripade, ze jde o textury - v budoucnu i filtrace souboru OBJ podle hlavicky souboru a souboru MAP podle hlavicky v souboru
i = 0
R(i) = rek(f)
i = i + 1
LINE (420, 533)-(500, 563), , B
LINE (420, 533)-(500, 563), _RGBA32(70, 70, 70, 200), BF
_PUTIMAGE (250, 533), Icony
(9) 'zelena fajfka ok LINE (260, 533)-(295, 563), _RGBA32(70, 70, 70, 190), BF
_PUTIMAGE (475, 210), Icony
(10) 'sipka nahoru LINE (475, 214)-(495, 230), _RGBA32(70, 70, 70, 190), BF
LINE (475, 510)-(495, 525), _RGBA32(70, 70, 70, 190), BF
LINE (475, 228)-(495, 510), _RGB32(127, 127, 127), BF
'sedy pruh mezi sipkami
PruhL = 30 'delka bileho ukazatele / pruhu mezi sipkami vpravo
PrepocetLS
= (480 - 228) / UBOUND(r
)
Sel = 0
sh_e = sh_s + 20
'startovni nastaveni
inmouse = 0
' LOCATE 1, 1: PRINT _MOUSEX, _MOUSEY: _DISPLAY
pruhStart = (Sel * PrepocetLS) + 228
LINE (480, pruhStart
)-(490, pruhStart
+ PruhL
), _RGB32(100, 100, 120), BF
'ty vole. Na prvni pokus. Nechapu.
beginmousey = 0
'podpora pro mys:
IF ONPOS
(_MOUSEX, _MOUSEY, 250, 220, 400, 530) THEN 'doplnek - vyber souboru v okne mysi' X2 ze 475 na 400
Sel = Sel + mwh
mwh = 0 'tato konstrukce je ok
LINE (420, 533)-(500, 563), , B
LINE (420, 533)-(500, 563), _RGBA32(255, 255, 255, 60), BF
LINE (250, 533)-(330, 563), , B
LINE (250, 533)-(330, 563), _RGBA32(255, 255, 255, 60), BF
mb1 = 0
Sel = Sel - 1
Sel = Sel + 1
IF UBOUND(r
) > 0 THEN 'pri prazdne slozce nic nedelej, ukonci prohlizec
IF mask$
= "JPGBMPGIFPNG" THEN
IF Sel
< sh_s
THEN sh_s
= sh_s
- 1 IF Sel
> sh_e
THEN sh_s
= sh_s
+ 1
sh_e = sh_s + 20
shw = -1
shw = shw + 1
IF Sel
= show
THEN 'reseni pro misto, kde je oznacena polozka
ven$ = R(show)
CASE "JPGBMPGIFPNG" 'PRO TEXTURY _PUTIMAGE (551, 211)-(795, 529), s&: Viewed
= 1 _PUTIMAGE (551, 211)-(795, 529), Icony
(7): Viewed
= 0 'pokud je neplatny format souboru
MapImage& = FAST_MAP_INFO(path2$ + R(Sel))
_PUTIMAGE (551, 211)-(795, 529), MapImage&: Viewed
= 1
ven$ = R(show)
Viewed = 0
IF MH.Identity
= "MAP3D" AND MH.Nr_of_Textures
THEN MAP_IS_SUPPORTED
= 1
IF Grid_img
(x
, y
) THEN Is_in_img
= 1 IF Grid_Floor
(x
, y
) THEN Is_in_floor
= 1 IF Grid_Ceil
(x
, y
) THEN Is_in_ceil
= 1
IF Is_in_img
= 0 AND Is_in_floor
= 0 AND Is_in_ceil
= 0 THEN WHOIS
= 0 IF Is_in_img
= 1 AND Is_in_floor
= 0 AND Is_in_ceil
= 0 THEN WHOIS
= 1 IF Is_in_img
= 0 AND Is_in_floor
= 1 AND Is_in_ceil
= 0 THEN WHOIS
= 2 IF Is_in_img
= 0 AND Is_in_floor
= 0 AND Is_in_ceil
= 1 THEN WHOIS
= 3 IF Is_in_img
= 1 AND Is_in_floor
= 1 AND Is_in_ceil
= 0 THEN WHOIS
= 12 IF Is_in_img
= 1 AND Is_in_floor
= 0 AND Is_in_ceil
= 1 THEN WHOIS
= 13 IF Is_in_img
= 0 AND Is_in_floor
= 1 AND Is_in_ceil
= 1 THEN WHOIS
= 23 IF Is_in_img
AND Is_in_floor
AND Is_in_ceil
THEN WHOIS
= 123
Grid_Obj(x, y) = 0
Grid_SND(x, y) = 0
Grid_SND(x, y) = SoundIN
DIALOG = 1
'512, 384
Init_Screen
LINE (398, 343)-(624, 424), _RGB32(155, 127, 127), BF
LINE (398, 343)-(624, 424), _RGB32(255, 255, 255), B
LINE (400, 345)-(622, 422), _RGB32(255, 255, 255), B
P = Place_Buttons
'SAVEMAP jeste neexistuje
from1 = 1
Message$ = "Save MAP as:"
GOTO savedialog
' skoci na dotaz na jmeno pod kterym to ma ulozit after:
' IF P = 16 THEN DIALOG = 0: EXIT DO
savedialog: 'small spaghetti block..... :-D
LINE (398, 343)-(624, 424), _RGB32(155, 127, 127), BF
LINE (398, 343)-(624, 424), _RGB32(255, 255, 255), B
LINE (400, 345)-(622, 422), _RGB32(255, 255, 255), B
'malba tlacitek 15 = yes, 16 = no
_PRINTSTRING (465, 355), Message
'spocitano na text "Save MAP as:"
CASE .21 TO .41: cursor$
= "/" CASE .42 TO .62: cursor$
= "|" CASE .63 TO .83: cursor$
= "\"
CursorPos
= LEN(Nam$
) * 8
Nam$ = Nam$ + i$
ONam$ = Nam$
Nam$ = Nam$ + ".MAP"
rnr = rnr + 1
Nam$
= ONam$
+ STR$(rnr
) + ".MAP"
SAVE_MAP (Nam$)
DIALOG = 0
icon = LOADICO("ico/warn.ico", 4)
LINE (398, 343)-(624, 424), _RGB32(255, 255, 255), B
LINE (400, 345)-(622, 422), _RGB32(255, 255, 255), B
DIALOG = 0
status = 0
icon = LOADICO("ico/ot.ico", 4)
LINE (398, 343)-(624, 424), _RGB32(255, 255, 255), B
LINE (400, 345)-(622, 422), _RGB32(255, 255, 255), B
status = 0
CLEARTEXTURES
CLEARGRID
gridtest:
'varovani, ze v polich Grid neco je, jestli to chces smazat
icon = LOADICO("ico/ot.ico", 4)
LINE (398, 343)-(624, 424), _RGB32(255, 255, 255), B
LINE (400, 345)-(622, 422), _RGB32(255, 255, 255), B
status = 0
icon = LOADICO("ico/ot.ico", 4)
LINE (398, 343)-(624, 424), _RGB32(255, 255, 255), B
LINE (400, 345)-(622, 422), _RGB32(255, 255, 255), B
status = 0
Message$ = "Save MAP as:"
beforeload:
status = 1
DIALOG = 0
Texture(w).img = 0
Grid_img(v, w) = -1
Grid_Ceil(v, w) = -1
Grid_Floor(v, w) = -1 'byly nuly, coz je odkaz na texture(0), teda asi
' Grid_Obj(v, w) = 0
Grid_typ(v, w) = 0
SUB Copy_contens_in_area
(Rxs
, Rys
, Rxe
, Rye
)
COPY_OR_INSERT_Right_click_menu(0) = Rxs
COPY_OR_INSERT_Right_click_menu(1) = Rys
COPY_OR_INSERT_Right_click_menu(2) = Rxe
COPY_OR_INSERT_Right_click_menu(3) = Rye
SUB Insert_contens_in_area
(Rx
, Ry
) IF COPY_OR_INSERT_Right_click_menu
(i
) = 0 THEN empty
= 1 ELSE empty
= 0 ' FOR copyY
= COPY_OR_INSERT_Right_click_menu
(1) TO COPY_OR_INSERT_Right_click_menu
(3) iX = 0
FOR copyX
= COPY_OR_INSERT_Right_click_menu
(0) TO COPY_OR_INSERT_Right_click_menu
(2) NewX = iX + Rx
iX = iX + 1
NewY = iY + Ry
'upgrade: kopie se budou vkladat do mapy v zavislosti na nastaveni. Budto individualne, tedy jen zed/podlaha/strop/objekt, nebo jako celek
SELECT CASE INSERT_SETUP
'0 = vse (puvodni), 1 = individualne
Grid_img(NewX, NewY) = Grid_img(copyX, copyY)
IP_Img(NewX, NewY) = IP_Img(copyX, copyY)
Grid_Ceil(NewX, NewY) = Grid_Ceil(copyX, copyY)
IP_Ceil(NewX, NewY) = IP_Img(copyX, copyY)
Grid_Floor(NewX, NewY) = Grid_Floor(copyX, copyY)
IP_Floor(NewX, NewY) = IP_Img(copyX, copyY)
Grid_typ(NewX, NewY) = Grid_typ(copyX, copyY)
Grid_Obj(NewX, NewY) = Grid_Obj(copyX, copyY)
CASE 1 'prepise se jen konkretni typ podle stiskleho tlacitka Grid_Floor(NewX, NewY) = Grid_Floor(copyX, copyY)
IP_Floor(NewX, NewY) = IP_Img(copyX, copyY)
Grid_Ceil(NewX, NewY) = Grid_Ceil(copyX, copyY)
IP_Ceil(NewX, NewY) = IP_Img(copyX, copyY)
Grid_img(NewX, NewY) = Grid_img(copyX, copyY)
IP_Img(NewX, NewY) = IP_Img(copyX, copyY)
Grid_Obj(NewX, NewY) = Grid_Obj(copyX, copyY)
Grid_typ(NewX, NewY) = Grid_typ(copyX, copyY)
iY = iY + 1
FUNCTION IS_EMPTY_GRID
'1 = ano, je prazdna mapa, 0 = ne, na mape neco je IS_EMPTY_GRID = 1
IF Grid_img
(v
, w
) OR Grid_Ceil
(v
, w
) OR Grid_Floor
(v
, w
) THEN IS_EMPTY_GRID
= 0 'docasne vyrazen grid OBJ
FUNCTION IS_EMPTY_TEXTURECACHE
'1 = ano, v poli textur nic neni, 1 = v poli textur neco je IS_EMPTY_TEXTURECACHE = 1
'reset mouseinputs from previous subs
'--------------------------------
LINE (923, 0)-(1023, 668), _RGB32(255, 255, 255), B
LINE (0, 668)-(1023, 767), _RGB32(255, 255, 255), B
TextureInit = TextureStart
'ikony foto textur
i = 95
FOR ShowTextures
= TextureStart
TO TextureEnd
IF Texture
(ShowTextures
).img
< -1 THEN 'pridano pri funkce DELETE TEXTURE
' PRINT Texture(ShowTextures).img, ShowTextures: _DISPLAY
_PUTIMAGE (950, i
)-(1000, i
+ 50), Texture
(ShowTextures
).img
i = i + 70
mwh = mwh + mwh
mwh = 0
IF TextureStart
> TextureSelected
THEN TextureStart
= TextureSelected
'-----------------------
LINE (950, 10)-(997, 57), _RGBA32(255, 255, 255, 60), BF
TextureSelected = TextureSelected - 1
IF TextureStart
> TextureSelected
THEN TextureStart
= TextureSelected
'posuv foto textur SIPKA DOLU
LINE (950, 610)-(997, 657), _RGBA32(255, 255, 255, 60), BF
TextureSelected = TextureSelected + 1
IF TextureEnd
< TextureSelected
THEN TextureEnd
= TextureSelected
'podpora ovladani fototextur z klavesnice
' kbd_agent$ = INKEY$
LINE (950, 610)-(997, 657), _RGBA32(255, 255, 255, 60), BF
TextureSelected = TextureSelected + 1
IF TextureEnd
< TextureSelected
THEN TextureEnd
= TextureSelected
LINE (950, 10)-(997, 57), _RGBA32(255, 255, 255, 60), BF
TextureSelected = TextureSelected - 1
IF TextureStart
> TextureSelected
THEN TextureStart
= TextureSelected
'upgrade - pridana podpora pro PGUP, PGDN, HOME a END home 71, end 79
TextureStart
= LBOUND(texture
) TextureSelected
= LBOUND(texture
)
TextureStart = TextureEnd - 6
TextureStart
= LBOUND(texture
) TextureSelected
= UBOUND(texture
)
TextureStart = TextureStart - 6
TextureEnd = TextureStart + 6
TextureSelected = TextureSelected - 6
TextureStart
= LBOUND(texture
) TextureSelected
= LBOUND(texture
) TextureEnd = TextureStart + 6
TextureStart = TextureStart + 6
TextureEnd = TextureStart + 6
TextureSelected = TextureSelected + 6
TextureSelected
= UBOUND(texture
) TextureStart = TextureEnd - 6
TextureStart
= LBOUND(Texture
)
CASE 87 TO 154: TextureSelected
= TextureStart
+ 0 CASE 157 TO 225: TextureSelected
= TextureStart
+ 1 CASE 229 TO 295: TextureSelected
= TextureStart
+ 2 CASE 299 TO 366: TextureSelected
= TextureStart
+ 3 CASE 368 TO 435: TextureSelected
= TextureStart
+ 4 CASE 440 TO 506: TextureSelected
= TextureStart
+ 5 CASE 509 TO 578: TextureSelected
= TextureStart
+ 6
TextureIN = Texture(TextureSelected).img 'pro vklad do mrizky
LINE (mx
, mY
)-(mx
+ 49, mY
+ 49), GridRGB32Color~&
, B
'............... 3.5 upgrade ................................
'nejrve vyber oblast, jako pri kliku levym tlacitkem, pak spust right clickmenu
'prepocet na souradnice pole:
RxS
= _CEIL((RightXstart
- 23) / 25) + StartDrawX
RyS
= _CEIL((RightYstart
- 18) / 25) + StartDrawy
RxE
= _CEIL((RightXend
- 23) / 25) + StartDrawX
RyE
= _CEIL((RightYend
- 18) / 25) + StartDrawy
e = 0
RightClick(1) = "Delete all in this area" ' OK
RightClick(2) = "Break current texture into this objects" ' OK
RightClick(3) = "Copy all in this area" ' OK
RightClick(4) = "Insert copyed contens to this area" ' OK
RightClick(5) = "Set WALL/CEILING/FLOOR height in this area"
RightClick(6) = "Flip textures in this area"
RightClick(7) = "Delete Objects in this area"
RightClick(8) = "Delete background sound in this area"
RightClick(9) = "Add background sound to this area"
CASE 1: Delete_All_in_area RxS
, RyS
, RxE
, RyE
CASE 2: Break_Texture_in_area RxS
, RyS
, RxE
, RyE
CASE 3: Copy_contens_in_area RxS
, RyS
, RxE
, RyE
CASE 4: Insert_contens_in_area RxS
, RyS
CASE 5: Set_Height_in_area RxS
, RyS
, RxE
, RyE
CASE 6: Flip_textures_in_area RxS
, RyS
, RxE
, RyE
CASE 7: Delete_Objects_in_area RxS
, RyS
, RxE
, RyE
CASE 8: Delete_Sounds_in_area RxS
, RyS
, RxE
, RyE
CASE 9: Add_Sound_to_area RxS
, RyS
, RxE
, RyE
'-------------------------------------------------------------------
' _DELAY .1
'doplnena podpora z klavesnice pokud je mys v tomto okne
IF EndDrawy
< UBOUND(grid_img
, 2) THEN StartDrawy
= StartDrawy
+ 1: EndDrawy
= StartDrawy
+ 35
StartDrawy = StartDrawy - 1: EndDrawy = StartDrawy + 35
StartDrawX = StartDrawX - 1: EndDrawX = StartDrawX + 36
IF EndDrawX
< UBOUND(grid_img
, 1) THEN StartDrawX
= StartDrawX
+ 1: EndDrawX
= StartDrawX
+ 36
IF _MOUSEX > memoryzex
AND EndDrawX
< UBOUND(grid_img
, 1) THEN StartDrawX
= StartDrawX
+ 1: EndDrawX
= StartDrawX
+ 36 'je to 25 sloupcu? IF _MOUSEX < memoryzex
THEN StartDrawX
= StartDrawX
- 1: EndDrawX
= StartDrawX
+ 36 'je to 25 sloupcu?
IF _MOUSEY > memoryzey
AND EndDrawy
< UBOUND(grid_img
, 2) THEN StartDrawy
= StartDrawy
+ 1: EndDrawy
= StartDrawy
+ 35 'je to 15 radku? 'dn IF _MOUSEY < memoryzey
THEN StartDrawy
= StartDrawy
- 1: EndDrawy
= StartDrawy
+ 35 'je to 15 radku? 'up
memoryzex = 0: memoryzey = 0
EndDrawX = StartDrawX + 36
EndDrawy = StartDrawy + 35
' END IF
'upgrade - hodnoty podle typu na miste: 1 = zed, 2 = floor, 3 = ceiling. 12 = zed + floor, 13 = zed + ceiling. 23 = floor + ceiling. 123 = zed, floor, ceiling
CASE 4: t$
= " Nerotovany objekt, " CASE 5: t$
= " Objekt rotovany o " + STR$(rot
) + "stupnu, " CASE 12: t$
= "Zed a strop, " CASE 13: t$
= "Zed a zem, " CASE 23: t$
= "Strop a zem, " CASE 123: t$
= "Zed, strop a zem, "
LS = LAYERS_SETUP
FOR dx
= StartDrawX
TO EndDrawX
FOR dy
= StartDrawy
TO EndDrawy
Kx = (dx * 25) + 23 - 25 - (25 * StartDrawX)
Ky = (dy * 25) + 18 - 25 - (25 * StartDrawy)
Height_From = Img_Height_From
Height_To = Img_Height_To
Textures_po = Img_Textures_per_Object
Texture_Effect = Img_Texture_Effect
IF Grid_img
(dx
, dy
) AND Grid_Floor
(dx
, dy
) OR Grid_img
(dx
, dy
) AND Grid_Ceil
(dx
, dy
) OR Grid_img
(dx
, dy
) AND Grid_Ceil
(dx
, dy
) OR Grid_Floor
(dx
, dy
) AND Grid_Ceil
(dx
, dy
) THEN alfa
= 0 ELSE alfa
= 50
_PUTIMAGE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), Grid_Floor
(dx
, dy
) LINE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), _RGBA32(0, 255, 0, alfa
), BF
_PUTIMAGE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), Grid_Ceil
(dx
, dy
) LINE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), _RGBA32(0, 0, 255, alfa
), BF
_PUTIMAGE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), Grid_img
(dx
, dy
) 'vlozi zdi
_PUTIMAGE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), Grid_img
(dx
, dy
) 'vlozi zdi
LINE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), _RGBA32(0, 255, 0, 128), BF
LINE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), _RGBA32(0, 0, 255, 128), BF
LINE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), _RGB32(255, 0, 0), BF
LINE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), _RGB32(255, 0, 0), BF
'-----
IF Button
(11).active
THEN ' rezim malovani stropu
Height_From = Ceil_Height_From
Height_To = Ceil_Height_To
Textures_po = Ceil_Textures_per_Object
Texture_Effect = Ceil_Texture_Effect
IF Grid_img
(dx
, dy
) AND Grid_Floor
(dx
, dy
) OR Grid_img
(dx
, dy
) AND Grid_Ceil
(dx
, dy
) OR Grid_img
(dx
, dy
) AND Grid_Ceil
(dx
, dy
) OR Grid_Floor
(dx
, dy
) AND Grid_Ceil
(dx
, dy
) THEN alfa
= 0 ELSE alfa
= 20 _PUTIMAGE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), Grid_img
(dx
, dy
) 'vlozi zdi LINE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), _RGBA32(255, 0, 0, alfa
), BF
_PUTIMAGE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), Grid_Floor
(dx
, dy
) 'vlozeni stropu LINE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), _RGBA32(0, 0, 255, alfa
), BF
_PUTIMAGE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), Grid_Ceil
(dx
, dy
) 'vlozeni podlah _PUTIMAGE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), Grid_Ceil
(dx
, dy
) 'vlozeni podlah LINE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), _RGBA32(0, 255, 0, 128), BF
LINE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), _RGBA32(0, 0, 255, 128), BF
LINE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), _RGB32(255, 0, 0), BF
LINE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), _RGB(0, 0, 255), BF
IF Button
(10).active
THEN ' podlaha bottom
Height_From = Floor_Height_From
Height_To = Floor_Height_To
Textures_po = Floor_Textures_per_Object
Texture_Effect = Floor_Texture_Effect
IF Grid_img
(dx
, dy
) AND Grid_Floor
(dx
, dy
) OR Grid_img
(dx
, dy
) AND Grid_Ceil
(dx
, dy
) OR Grid_img
(dx
, dy
) AND Grid_Ceil
(dx
, dy
) OR Grid_Floor
(dx
, dy
) AND Grid_Ceil
(dx
, dy
) THEN alfa
= 0 ELSE alfa
= 50
_PUTIMAGE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), Grid_img
(dx
, dy
) 'vlozi zdi LINE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), _RGBA32(255, 0, 0, alfa
), BF
_PUTIMAGE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), Grid_Ceil
(dx
, dy
) 'vlozeni podlah LINE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), _RGBA32(0, 255, 0, alfa
), BF
_PUTIMAGE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), Grid_Floor
(dx
, dy
) 'vlozeni stropu
_PUTIMAGE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), Grid_Floor
(dx
, dy
) 'vlozeni stropu
LINE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), _RGBA32(0, 255, 0, 128), BF
LINE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), _RGBA32(0, 0, 255, 128), BF
LINE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), _RGB32(255, 0, 0), BF
LINE (Kx
+ 1, Ky
+ 1)-(Kx
+ 23, Ky
+ 23), _RGB(0, 255, 0), BF
SHARED OldMouseX
, OldMouseY
, MemorizeTimer
Info_Array(1) = "texture nr:" + IS_Record(Px, Py) + " object type: " + t$
IF Texture_Effect
> 0 THEN TextureEfect$
= STR$(Texture_Effect
) ELSE TextureEfect$
= "NONE"
IMG_H_F$
= STR$(IP_Img
(Px
, Py
).Height_From
) IMG_H_T$
= STR$(IP_Img
(Px
, Py
).Height_To
) IF IP_Img
(Px
, Py
).Height_From
= IP_Img
(Px
, Py
).Height_To
THEN IMG_H_F$
= "UNUSED": IMG_H_T$
= "UNUSED"
CEIL_H_F$
= STR$(IP_Ceil
(Px
, Py
).Height_From
) CEIL_H_T$
= STR$(IP_Ceil
(Px
, Py
).Height_To
)
FLOOR_H_F$
= STR$(IP_Floor
(Px
, Py
).Height_From
) FLOOR_H_T$
= STR$(IP_Floor
(Px
, Py
).Height_To
)
Info_Array(2) = "WALL height from:" + IMG_H_F$ + " height to:" + IMG_H_T$
Info_Array(3) = "CEILING height from:" + CEIL_H_F$ + " height to:" + CEIL_H_T$
Info_Array(4) = "FLOOR height from:" + FLOOR_H_F$ + " height to:" + FLOOR_H_T$
Info_Array
(5) = "total place 1 texture over" + STR$(Textures_po
) + " objects" Info_Array(6) = "applied effect to texture: " + TextureEfect$
Info_Array(7) = "----------------------------------"
Info_Array(8) = "actual settings:"
Info_Array(9) = "----------------------------------"
Info_Array
(10) = "WALL height from: " + STR$(Img_Height_From
) + " to:" + STR$(Img_Height_To
) Info_Array
(11) = "FLOOR height from: " + STR$(Floor_Height_From
) + " to:" + STR$(Floor_Height_To
) Info_Array
(12) = "CEILING height from: " + STR$(Ceil_Height_From
) + " to:" + STR$(Ceil_Height_To
)
IF Button
(12).active
THEN atyp
= 1 'wall IF Button
(11).active
THEN atyp
= 2 'ceiling IF Button
(10).active
THEN atyp
= 3 'floor
Grid_img(Px, Py) = TextureIN: Grid_Ceil(Px, Py) = 0: Grid_Floor(Px, Py) = 0
IP_Img(Px, Py).Height_From = Img_Height_From
IP_Img(Px, Py).Height_To = Img_Height_To
IP_Img(Px, Py).TexturesPerObject = Img_Textures_per_Object
IP_Img(Px, Py).TextureEffect = Img_Texture_Effect
Grid_Ceil(Px, Py) = TextureIN: Grid_img(Px, Py) = 0
IP_Ceil(Px, Py).Height_From = Ceil_Height_From
IP_Ceil(Px, Py).Height_To = Ceil_Height_To
IP_Ceil(Px, Py).TexturesPerObject = Ceil_Textures_per_Object
IP_Ceil(Px, Py).TextureEffect = Ceil_Texture_Effect
Grid_Floor(Px, Py) = TextureIN: Grid_img(Px, Py) = 0
IP_Floor(Px, Py).Height_From = Floor_Height_From
IP_Floor(Px, Py).Height_To = Floor_Height_To
IP_Floor(Px, Py).TexturesPerObject = Floor_Textures_per_Object
IP_Floor(Px, Py).TextureEffect = Floor_Texture_Effect
Grid_typ(Px, Py) = WHOIS(Px, Py) 'atyp
startpX = Px
startpY = Py
writeit = 0
writeit = 1
IF Button
(12).active
THEN atyp
= 1 'wall IF Button
(11).active
THEN atyp
= 2 'ceiling IF Button
(10).active
THEN atyp
= 3 'floor
FOR ipy
= startpY
TO EndPY
FOR ipx
= startpX
TO EndPX
Grid_img(ipx, ipy) = TextureIN: Grid_Ceil(ipx, ipy) = 0: Grid_Floor(ipx, ipy) = 0
IP_Img(ipx, ipy).Height_From = Img_Height_From
IP_Img(ipx, ipy).Height_To = Img_Height_To
IP_Img(ipx, ipy).TexturesPerObject = Img_Textures_per_Object
IP_Img(ipx, ipy).TextureEffect = Img_Texture_Effect
Grid_Ceil(ipx, ipy) = TextureIN: Grid_img(ipx, ipy) = 0
IP_Ceil(ipx, ipy).Height_From = Ceil_Height_From
IP_Ceil(ipx, ipy).Height_To = Ceil_Height_To
IP_Ceil(ipx, ipy).TexturesPerObject = Ceil_Textures_per_Object
IP_Ceil(ipx, ipy).TextureEffect = Ceil_Texture_Effect
Grid_Floor(ipx, ipy) = TextureIN: Grid_img(ipx, ipy) = 0
IP_Floor(ipx, ipy).Height_From = Floor_Height_From
IP_Floor(ipx, ipy).Height_To = Floor_Height_To
IP_Floor(ipx, ipy).TexturesPerObject = Floor_Textures_per_Object
IP_Floor(ipx, ipy).TextureEffect = Floor_Texture_Effect
Grid_typ(ipx, ipy) = WHOIS(ipx, ipy) 'atyp
IF Button
(12).active
THEN Grid_img
(Px
, Py
) = 0: Grid_typ
(Px
, Py
) = WHOIS
(Px
, Py
) IF Button
(11).active
THEN Grid_Ceil
(Px
, Py
) = 0: Grid_typ
(Px
, Py
) = WHOIS
(Px
, Py
) IF Button
(10).active
THEN Grid_Floor
(Px
, Py
) = 0: Grid_typ
(Px
, Py
) = WHOIS
(Px
, Py
)
styles(1) = "Flip in X axis"
styles(2) = "Flip in Y axis"
styles(3) = "Flip on 180 degrees"
Reset_Mouse
IF Button
(12).active
THEN Atyp
= 1 'wall IF Button
(11).active
THEN Atyp
= 2 'ceiling IF Button
(10).active
THEN Atyp
= 3 'floor
CASE 3: image
= Grid_Floor
(x
, y
) CASE 2: image
= Grid_Ceil
(x
, y
) CASE 1: image
= Grid_img
(x
, y
)
imag = MEM_ROTO_90(image)
imag = MEM_ROTO_90(image)
imag = MEM_ROTO_90(image)
imag = MEM_ROTO_90(image)
SWP
(x
, y
) = _COPYIMAGE(ROTO90
, 32) ' ELSE SWP(y, x) = _COPYIMAGE(ROTO90, 32)
cx = rxe
Grid_img(cx, y) = SWP(x, y)
Grid_typ(cx, y) = WHOIS(cx, y)
cx = cx - 1
cx = rxe
Grid_Ceil(cx, y) = SWP(x, y)
Grid_typ(cx, y) = WHOIS(cx, y)
cx = cx - 1
cx = rxe
Grid_Floor(cx, y) = SWP(x, y)
Grid_typ(cx, y) = WHOIS(cx, y)
cx = cx - 1
cy = rye
Grid_img(x, cy) = SWP(x, y)
Grid_typ(x, cy) = WHOIS(x, cy)
cy = cy - 1
cy = rye
Grid_Ceil(x, cy) = SWP(x, y)
Grid_typ(x, cy) = WHOIS(x, cy)
cy = cy - 1
cy = rye
Grid_Floor(x, cy) = SWP(x, y)
Grid_typ(x, cy) = WHOIS(x, cy)
cy = cy - 1
cy = rye
cx = rxe
Grid_img(cx, cy) = SWP(x, y)
Grid_typ(cx, cy) = WHOIS(cx, cy)
cx = cx - 1
cy = cy - 1
cy = rye
cx = rxe
Grid_Ceil(cx, cy) = SWP(x, y)
Grid_typ(cx, cy) = WHOIS(cx, cy)
cx = cx - 1
cy = cy - 1
cy = rye
cx = rxe
Grid_Floor(cx, cy) = SWP(x, y)
Grid_typ(cx, cy) = WHOIS(cx, cy)
cx = cx - 1
cy = cy - 1
CASE 4 'rotace o 90 stupnu - jen opis
cy = rye
cx = rxe
SWP2(cx, y) = SWP(x, y)
cx = cx - 1
cy = cy - 1
wx = rxs
wy = rys
Grid_img(wx, wy) = SWP2(x, y)
'tento blocek mi trval 2 dny...
IF rxe
- rxs
<> rye
- rys
THEN wy
= wy
+ 1:
IF wy
> rxe
THEN wy
= rxs: wx
= wx
+ 1 wy
= wy
+ 1:
IF wy
> rye
THEN wy
= rys: wx
= wx
+ 1 '///////////////////////////////
' IF wx > rye THEN wx = rys
Grid_Ceil(x, y) = SWP(x, y)
Grid_typ(x, y) = WHOIS(x, y)
Grid_Floor(x, y) = SWP(x, y)
Grid_typ(x, y) = WHOIS(x, y)
DIM m
AS _MEM, m2
AS _MEM, m3
AS _MEM, k
AS _UNSIGNED LONG, k3
AS _UNSIGNED LONG, X
AS LONG, Y
AS LONG, R
AS _UNSIGNED _BYTE, G
AS _UNSIGNED _BYTE, B
AS _UNSIGNED _BYTE, A
AS _UNSIGNED _BYTE, nR
AS _UNSIGNED _BYTE, nG
AS _UNSIGNED _BYTE, nB
AS _UNSIGNED _BYTE ' m3 = _MEMIMAGE(0)
' _MEMGET m3, m3.OFFSET + (4 * (W - X + _WIDTH(img) * Y)), k3
nA = A / 2.55
nR = NColor(R3, R, nA)
nG = NColor(G3, G, nA)
nB = NColor(B3, B, nA)
' _MEMFREE m3
NColor = Background - ((Background - Foreground) / 100) * Alpha
IP_Img(Kx, Ky).Height_From = 0
IP_Img(Kx, Ky).Height_To = 0
IP_Floor(Kx, Ky).Height_From = 0
IP_Floor(Kx, Ky).Height_To = 0
IP_Ceil(Kx, Ky).Height_From = 0
IP_Ceil(Kx, Ky).Height_To = 0
Grid_img(Kx, Ky) = 0
Grid_Ceil(Kx, Ky) = 0
Grid_Floor(Kx, Ky) = 0
Grid_typ(Kx, Ky) = 0
Grid_Obj(Kx, Ky) = 0
LINE (198, 200)-(522, 568), _RGB32(70, 70, 70), BF
LINE (198, 200)-(522, 568), _RGB32(155, 155, 155), B
LINE (200, 202)-(520, 566), _RGB32(155, 155, 155), B
OldRoto = rotos
BLOCK_Img_Textures_per_Object = Img_Textures_per_Object
BLOCK_Img_Height_From = Img_Height_From
BLOCK_Img_Height_To = Img_Height_To
BLOCK_Floor_Height_From = Floor_Height_From
BLOCK_Floor_Height_To = Floor_Height_To
BLOCK_Ceil_Height_From = Ceil_Height_From
BLOCK_Ceil_Height_To = Ceil_Height_To
oke = LOADICO("ico/oke.ico", 1)
bck = LOADICO("ico/ko.ico", 1)
'-------------------------------------------------------------------------------------------------
'nastavovaci veticka pro nastaveni vysky zdi od do
'nastavovaci veticka pro nastaveni vysky zeme od do
'nastavovaci veticka pro nastaveni vysky stropu od do
BLOCK_Img_Textures_per_Object = BLOCK_Img_Textures_per_Object + DoubleArrow(450, 220)
BLOCK_Img_Height_From = BLOCK_Img_Height_From + DoubleArrow(450, 250)
BLOCK_Img_Height_To = BLOCK_Img_Height_To + DoubleArrow(450, 280)
BLOCK_Floor_Height_From = BLOCK_Floor_Height_From + DoubleArrow(450, 310)
BLOCK_Floor_Height_To = BLOCK_Floor_Height_To + DoubleArrow(450, 340)
BLOCK_Ceil_Height_From = BLOCK_Ceil_Height_From + DoubleArrow(450, 370)
BLOCK_Ceil_Height_To = BLOCK_Ceil_Height_To + DoubleArrow(450, 400)
LINE (230, 500)-(315, 530), _RGB32(255, 255, 255), B
IF ONPOS
(_MOUSEX, _MOUSEY, 230, 500, 315, 530) THEN LINE (230, 500)-(315, 530), _RGBA32(170, 170, 170, 60), BF:
IF _MOUSEBUTTON(1) THEN ok
= 1 'OK
LINE (400, 500)-(485, 530), _RGB32(255, 255, 255), B
IF ONPOS
(_MOUSEX, _MOUSEY, 400, 500, 485, 530) THEN LINE (400, 500)-(485, 530), _RGBA32(170, 170, 170, 60), BF:
IF _MOUSEBUTTON(1) THEN EXIT SUB
IP_Ceil(x, y).Height_From = BLOCK_Ceil_Height_From
IP_Ceil(x, y).Height_To = BLOCK_Ceil_Height_To
IP_Floor(x, y).Height_From = BLOCK_Floor_Height_From
IP_Floor(x, y).Height_To = BLOCK_Floor_Height_To
IP_Img(x, y).Height_From = BLOCK_Img_Height_From
IP_Img(x, y).Height_To = BLOCK_Img_Height_To
SUB Break_Texture_in_area
(Sx
AS INTEGER, Sy
AS INTEGER, Ex
AS INTEGER, Ey
AS INTEGER) 'vezme aktualni texturu, rozlozi ji na patricny pocet dilu, ulozi jako PNG a ty vlozi jako novou texturu a umisti do pole ' X - start Y - start X - end Y - end
' PRINT Sx, Sy, Ex, Ey
' SLEEP
'as LINE: (X start, Y start) - (X end, Y end)
IF Ex
= Sx
THEN divideX
= 1 ELSE divideX
= (Ex
- Sx
) + 1 IF Ey
= Sy
THEN divideY
= 1 ELSE divideY
= (Ey
- Sy
) + 1
NewWidth = NewWidth + 1
NewHeight = NewHeight + 1
Stexture
= _NEWIMAGE(NewWidth
, NewHeight
, 32)
width = NewWidth \ divideX
height = NewHeight \ divideY
oldu = u
' PRINT width, height: SLEEP
_PUTIMAGE (0, 0)-(width - 1, height
- 1), Stexture
, newTexture&
, (x
, y
)-(x
+ width - 1, y
+ height
- 1) Texture(u).path = GET_NEW_TEXTURE_NAME
Texture(u).img = newTexture&
res
= SaveImage
(Texture
(u
).path
, newTexture&
, 0, 0, _WIDTH(newTexture&
) - 1, _HEIGHT(newTexture&
) - 1) u = u + 1
IF Button
(12).active
THEN Atyp
= 1 'wall IF Button
(11).active
THEN Atyp
= 2 'ceiling IF Button
(10).active
THEN Atyp
= 3 'floor
StartTexture = oldu
x = 0: y = 0
CASE 1: Grid_img
(x
, y
) = Texture
(StartTexture
+ c
).img
CASE 2: Grid_Ceil
(x
, y
) = Texture
(StartTexture
+ c
).img
CASE 3: Grid_Floor
(x
, y
) = Texture
(StartTexture
+ c
).img
Grid_typ(x, y) = WHOIS(x, y)
StartTexture = StartTexture + 1
Reset_Mouse
IS_Record$ = ""
IF Texture
(a
).img
= Grid_img
(r1
, r2
) THEN IS_Record$
= STR$(a
) IF Texture
(a
).img
= Grid_Ceil
(r1
, r2
) THEN IS_Record$
= STR$(a
) IF Texture
(a
).img
= Grid_Floor
(r1
, r2
) THEN IS_Record$
= STR$(a
)
IF DIALOG
= 2 THEN ub
= 0: us
= 0 _PUTIMAGE (Button
(p
).x
, Button
(p
).y
), Button
(p
).imgA
_PUTIMAGE (Button
(p
).x
+ 1, Button
(p
).y
+ 1), Button
(p
).imgA
Place_Buttons = p
IF Button
(p
).active
= 0 THEN _PUTIMAGE (Button
(p
).x
, Button
(p
).y
), Button
(p
).imgB
IF Button
(p
).active
= 1 THEN _PUTIMAGE (Button
(p
).x
, Button
(p
).y
), Button
(p
).imgA
path$
= ENVIRON$("SYSTEMROOT") + "\fonts\arial.ttf"
text1$
= LEFT$(Button
(c
).text
, m
)
x1
= 8 + (40 / LEN(text1$
)) x2
= 8 + (40 / LEN(text2$
)) y1 = 10
y2 = 20
text1$
= RTRIM$(Button
(c
).text
) x1
= 8 + (40 / LEN(text1$
)) y1 = 15
x2 = 0: y2 = 0: text2$ = ""
file$ = "editor.ini"
'InfoPlus - Walls
'InfoPlus - Ceils
'InfoPlus - Floors
'Setup - copy style for rightclick / copy -> righclick / insert (0 = rewrite objects, walls, floors and ceilings, 1 = rewrite JUST SELECTED)
ELSE 'ini file not exists, so write it using default settings
PRINT #ff
, "Commented INI file: Program use byte positions 41++ to read on every row. Read not first row and read not first 40 characters on rows!" PRINT #ff
, "SET MAP X RESOLUTION:";
TAB(40);
"100" PRINT #ff
, "SET MAP Y RESOLUTION:";
TAB(40);
"100" PRINT #ff
, "SET MAP COLOR RGB32:";
TAB(40); klr$
PRINT #ff
, "SET MAP VISIBILITY:";
TAB(40);
"1" PRINT #ff
, "SHOW COMMENTS ON MAP:";
TAB(40);
"1" PRINT #ff
, "TIME BEFORE SHOW COMMENTS:";
TAB(40);
"2" PRINT #ff
, "LAYERS SETUP (0 TO 4):";
TAB(40);
"0" PRINT #ff
, "MOUSE DRAW SETTING (0 or 1):";
TAB(40);
"0"
PRINT #ff
, "Walls - Height From (-2 default):";
TAB(40);
"-2" PRINT #ff
, "Walls - Height To (2 default):";
TAB(40);
"2" PRINT #ff
, "Walls - Walls to 1 texture (1):";
TAB(40);
"1" PRINT #ff
, "Walls - texture effect (0 def):";
TAB(40);
"0"
PRINT #ff
, "Ceiling - Height From (2 default):";
TAB(40);
"2" PRINT #ff
, "Ceiling - Height To (2 default):";
TAB(40);
"2" PRINT #ff
, "Ceiling - Walls to 1 texture (1):";
TAB(40);
"1" PRINT #ff
, "Ceiling - texture effect (0 def):";
TAB(40);
"0"
PRINT #ff
, "Floors - Height From (-2 default):";
TAB(40);
"-2" PRINT #ff
, "Floors - Height To (-2 default):";
TAB(40);
"-2" PRINT #ff
, "Floors - Walls to 1 texture (1):";
TAB(40);
"1" PRINT #ff
, "Floors - texture effect (0 def):";
TAB(40);
"0"
PRINT #ff
, "Copy/Insert function setup: (0 or 1):";
TAB(40);
"1"
GridXResolution = 100
GridYResolution = 100
GridRGB32Color~&
= _RGB32(255, 255, 255) GridVisibility = 1
GridShowComments = 1
GridCommentsTime = 2
LAYERS_SETUP = 0
DRAW_MOUSE_SETUP = 0
Img_Height_From = -2
Img_Height_To = 2
Img_Textures_per_Object = 1
Img_Texture_Effect = 0
Ceil_Height_From = 2
Ceil_Height_To = 2
Ceil_Textures_per_Object = 1
Ceil_Texture_Effect = 0
Floor_Height_From = -2
Floor_Height_To = -2
Floor_Textures_per_Object = 1
Floor_Texture_Effect = 0
INSERT_SETUP = 1
'nacteni soucasne barvy mrizky
V = GridVisibility
GridWidth
= UBOUND(grid_img
, 1) GridHeight
= UBOUND(grid_img
, 2)
LINE (198, 200)-(822, 568), _RGB32(70, 70, 70), BF
LINE (198, 200)-(822, 568), _RGB32(155, 155, 155), B
LINE (200, 202)-(820, 566), _RGB32(155, 155, 155), B
plus = LOADICO("ico\plus.ico", 4)
minus = LOADICO("ico\minus.ico", 4)
ok = LOADICO("ico\ok.ico", 6)
oke = LOADICO("ico/oke.ico", 1)
bck = LOADICO("ico/ko.ico", 1)
' IF V THEN _PUTIMAGE (380, 328), ok
LINE (380, 330)-(395, 345), _RGB32(255, 255, 255), B
LINE (380, 370)-(420, 385), _RGB32(255, 255, 255), B
LINE (380, 410)-(420, 425), _RGB32(255, 255, 255), B
LINE (700, 330)-(715, 345), _RGB32(255, 255, 255), B
'upgrade: v014-2
' GridShowComments = 0
' IF GridShowComments THEN _PUTIMAGE (700, 328), ok
LINE (700, 370)-(740, 385), _RGB32(255, 255, 255), B
_PUTIMAGE (740, 360), DvojSipka
'pro nastaveni casu komentare IF GridShowComments
= 0 THEN LINE (500, 360)-(770, 395), _RGBA32(70, 70, 70, 210), BF
'umisteni dvoojsipek pro snizovani / zvysovani ciselnych hodnot
_PUTIMAGE (422, 360), DvojSipka
'width nastaveni _PUTIMAGE (422, 400), DvojSipka
'height nastaveni
comments = GridShowComments
commtime = GridCommentsTime
visible = GridVisibility
GridWidt = GridWidth
GridHeigh = GridHeight
OldResX = GridXResolution
OldResY = GridYResolution
ROLLMENU 385, 455 'UPGRADE 01U14-2
ROLLMENU_MOUSE 584, 415
'ovladani povoleni zobrazeni komentaru
LINE (700, 330)-(715, 345), _RGBA32(255, 255, 255, 70), BF
IF comments
= 0 THEN comments
= 1 ELSE comments
= 0
LINE (745, 365)-(754, 373), _RGB32(170, 170, 170), B
LINE (745, 381)-(754, 388), _RGB32(170, 170, 170), B
'drobny ctverecek
IF commtime
> 50 THEN commtime
= 50 IF commtime
< 0 THEN commtime
= 0
' LINE (700, 325)-(715, 345), _RGB32(70, 70, 70), BF
LINE (700, 330)-(715, 345), _RGB32(255, 255, 255), B
'tohle nejak poresit aby to neukazovalo tisiciny
LINE (702, 372)-(738, 384), _RGB32(70, 70, 70), BF
'kontrola delky casu a pripadne zkraceni:
cmt$ = __USING$(commtime / 10, 3)
LINE (700, 325)-(715, 345), _RGB32(70, 70, 70), BF
LINE (700, 330)-(715, 345), _RGBA32(255, 255, 255, 70), BF
LINE (700, 330)-(715, 345), _RGB32(255, 255, 255), B
LINE (500, 360)-(770, 395), _RGBA32(70, 70, 70, 210), BF
'ovladani nastaveni velikosti mapy
LINE (380, 330)-(395, 345), _RGBA32(255, 255, 255, 70), BF
'ovladani sipek pro velikost mapy WIDTH
LINE (426, 366)-(435, 373), _RGB32(170, 170, 170), B
LINE (426, 382)-(435, 389), _RGB32(170, 170, 170), B
IF GridWidt
< 10 THEN GridWidt
= 10 IF GridWidt
> 999 THEN GridWidt
= 999
LINE (383, 371)-(419, 384), _RGB32(70, 70, 70), BF
'ovladani sipek pro velikost mapy HEIGHT
LINE (426, 407)-(435, 414), _RGB32(170, 170, 170), B
LINE (426, 423)-(435, 430), _RGB32(170, 170, 170), B
IF GridHeigh
< 10 THEN GridHeigh
= 10 IF GridHeigh
> 999 THEN GridHeigh
= 999
LINE (382, 411)-(416, 423), _RGB32(70, 70, 70), BF
'ovladani Tahla R -
LINE (400, 240)-(415, 255), _RGBA32(170, 170, 170, 60), BF
'ovladani Tahla G -
LINE (400, 265)-(415, 280), _RGBA32(170, 170, 170, 60), BF
'ovladani Tahla B -
LINE (400, 290)-(415, 305), _RGBA32(170, 170, 170, 60), BF
'========
'ovladani Tahla R +
LINE (660, 240)-(675, 255), _RGBA32(170, 170, 170, 60), BF
'ovladani Tahla G +
LINE (660, 265)-(675, 280), _RGBA32(170, 170, 170, 60), BF
'ovladani Tahla B +
LINE (660, 290)-(675, 305), _RGBA32(170, 170, 170, 60), BF
'vykresleni tahel
posR = 430 + (215 * (R / 255))
posG = 430 + (215 * (G / 255))
posB = 430 + (215 * (B / 255))
LINE (posR
- 3, 244)-(posR
+ 3, 250), _RGB32(255, 0, 0), BF
LINE (posG
- 3, 270)-(posG
+ 3, 276), _RGB32(0, 255, 0), BF
LINE (posB
- 3, 294)-(posB
+ 3, 300), _RGB32(0, 0, 255), BF
'vklad konecnych tlacitek a moznosti uniku z klavesnice pres Esc
IF ONPOS
(_MOUSEX, _MOUSEY, 300, 500, 385, 530) THEN LINE (300, 500)-(385, 530), _RGBA32(170, 170, 170, 60), BF:
IF _MOUSEBUTTON(1) THEN EXIT DO LINE (300, 500)-(385, 530), _RGB32(255, 255, 255), B
IF ONPOS
(_MOUSEX, _MOUSEY, 640, 500, 725, 530) THEN LINE (640, 500)-(725, 530), _RGBA32(170, 170, 170, 60), BF:
IF _MOUSEBUTTON(1) THEN GOTO frimg
LINE (640, 500)-(725, 530), _RGB32(255, 255, 255), B
'Warning = 0
IF OldResX
> GridWidt
OR OldResY
> GridHeigh
THEN 'zmena pole na nizsi hodnoty, test, jestli je v tomto poli zaznam
is_subset(grid_img(), gridwidt, gridheigh) or_
is_subset(grid_ceil(), gridwidt, gridheigh) or_
is_subset
(grid_floor
(), gridwidt
, gridheigh
) then Warning
= 1
'-----------------------------------------------
' Warning = 1
'
' FOR testY = 1 TO OldResY
' FOR testX = 1 TO OldResX
' IF testY > GridHeigh OR testX > GridWidt THEN
' IF Grid_img(testX, testY) < 0 OR Grid_Ceil(testX, testY) < 0 OR Grid_Floor(testX, testY) < 0 THEN Warning = 1: GOTO hlaseni
' END IF
' NEXT testX, testY
' END IF
'-------------------------------------------------
' Warning = 1 'pro testovani!
hlaseni:
IF Warning
THEN 'dialog s varovanim. Dalsi cast = souhlas - ano, zmensit pole i se ztratou dat Warn = LOADICO("ico/warn.ico", 6)
' _CLEARCOLOR _RGB32(0, 0, 0), Warn
LINE (348, 300)-(648, 410), _RGB32(255, 255, 255), B
LINE (350, 302)-(646, 408), _RGB32(255, 255, 255), B
LINE (430, 378)-(500, 398), _RGB32(70, 70, 70), BF
LINE (550, 378)-(620, 398), _RGB32(70, 70, 70), BF
LINE (430, 378)-(500, 398), _RGB32(255, 255, 255), B
LINE (550, 378)-(620, 398), _RGB32(255, 255, 255), B
LINE (430, 378)-(500, 398), _RGBA32(255, 255, 255, 70), BF
LINE (550, 378)-(620, 398), _RGBA32(255, 255, 255, 70), BF
RESIZE_ARR2 Grid_img(), GridWidt, GridHeigh
RESIZE_ARR2 Grid_Ceil(), GridWidt, GridHeigh
RESIZE_ARR2 Grid_Floor(), GridWidt, GridHeigh
RESIZE_ARR2 Grid_Obj(), GridWidt, GridHeigh
RESIZE_ARR2 Grid_typ(), GridWidt, GridHeigh
RESIZE_INFOPLUS
GridXResolution = GridWidt
GridYResolution = GridHeigh
GridShowComments = comments
GridVisibility = visible
GridCommentsTime = commtime / 10
GridRGB32Color~&
= _RGB32(R
, G
, B
) SaveINI
frimg:
SUB RESIZE_INFOPLUS
'MOZNA TO BUDE DELAT BORDEL! POUZITO PRESERVE!
file$ = "editor.ini"
PRINT #ff
, "Commented INI file: Program use byte positions 41++ to read on every row. Read not first row and read not first 40 characters on rows!" PRINT #ff
, "SET MAP X RESOLUTION:";
TAB(40); GridXResolution
PRINT #ff
, "SET MAP Y RESOLUTION:";
TAB(40); GridYResolution
PRINT #ff
, "SET MAP COLOR RGB32:";
TAB(40);
STR$(GridRGB32Color~&
) PRINT #ff
, "SET MAP VISIBILITY:";
TAB(40); GridVisibility
PRINT #ff
, "SHOW COMMENTS ON MAP:";
TAB(40); GridShowComments
PRINT #ff
, "TIME BEFORE SHOW COMMENTS:";
TAB(40); GridCommentsTime
PRINT #ff
, "LAYERS SETTINGS (0 - 4):";
TAB(40); LAYERS_SETUP
PRINT #ff
, "MOUSE DRAW SETTING (0 or 1):";
TAB(40); DRAW_MOUSE_SETUP
PRINT #ff
, "Walls - Height From (-2 default):";
TAB(40); Img_Height_From
PRINT #ff
, "Walls - Height To (2 default):";
TAB(40); Img_Height_To
PRINT #ff
, "Walls - Walls to 1 texture (1):";
TAB(40); Img_Textures_per_Object
PRINT #ff
, "Walls - texture effect (0 def):";
TAB(40); Img_Texture_Effect
PRINT #ff
, "Ceiling - Height From (2 default):";
TAB(40); Ceil_Height_From
PRINT #ff
, "Ceiling - Height To (2 default):";
TAB(40); Ceil_Height_To
PRINT #ff
, "Ceiling - Walls to 1 texture (1):";
TAB(40); Ceil_Textures_per_Object
PRINT #ff
, "Ceiling - texture effect (0 def):";
TAB(40); Ceil_Texture_Effect
PRINT #ff
, "Floors - Height From (-2 default):";
TAB(40); Floor_Height_From
PRINT #ff
, "Floors - Height To (-2 default):";
TAB(40); Floor_Height_To
PRINT #ff
, "Floors - Walls to 1 texture (1):";
TAB(40); Floor_Textures_per_Object
PRINT #ff
, "Floors - texture effect (0 def):";
TAB(40); Floor_Texture_Effect
PRINT #ff
, "Copy/Insert function setup: (0 or 1):";
TAB(40); INSERT_SETUP
SUB RESIZE_ARR2
(Grid
() AS LONG, New_Ubound_A
AS LONG, New_Ubound_B
AS LONG) 'for 2 dimensional arrays, because _PRESERVE for 2D arrays is.......oh my god. aa = -1: bb = -1
IF aa
>= 0 AND bb
>= 0 THEN swp
(aa
, bb
) = Grid
(a
, b
)
Grid(a, b) = swp(a, b)
SUB SAVE_MAP
(filename
AS STRING) 'vytvori binarni MAP soubor
filename$
= _CWD$ + "\MAP\" + filename$
'uprava aby to ukladal do slozky MAP
'test, jestli pole textur vubec neco obsahuji:
' DIM Vertex(0) AS Vertex
id$ = "MAP3D"
'test poctu relevantnich zaznamu:
rec = 0
IF Grid_img
(a
, b
) THEN rec
= rec
+ 1 IF Grid_Floor
(a
, b
) THEN rec
= rec
+ 1 IF Grid_Ceil
(a
, b
) THEN rec
= rec
+ 1
s1 = 0
s1
= s1
+ LEN(REMOVE_PATH$
(Texture
(s
).path
)) s1 = s1 + 4 'pro velikost souboru LONG
s1 = s1 + 4 'pro velikost delky jmena typu LONG
totalSize = totalSize + siz(s)
MH.Identity = SaveMap3D$
MH.Nr_of_Textures
= UBOUND(texture
) + 1 'protoze zaznam cislo 0 pro texturu take obsahuje 1 texturu MH.Nr_of_Vertexes = rec
MH.DataStart = 21 + s1 'hlava ma 21 bytu
MH.VertexStart = MH.DataStart + totalSize
'----- Hlava je pripravena ---------- File header ready
NameLenght
= LEN(REMOVE_PATH
(Texture
(SaveNamesLenght
).path
)) 'ukladani velikosti souboru ' saving files sizes
FSize = siz(SaveNamesLenght)
'ukladani jmen souboru' saving files names
nam$
= SPACE$((LEN(REMOVE_PATH
(Texture
(SaveFilesNames
).path
)))) nam$ = REMOVE_PATH(Texture(SaveFilesNames).path)
'nasleduje zkopirovani binarnich dat textur 'copying files datas to MAP file
'zmena oproti verzi 01U13: Nasleduji dve hodnoty LONG udavajici vysku a sirku mapy, pote nasleduji 3 kopie map GRID v LONG, udavajici -1 = neni textura, nebo cislo textury
'save grid (map) size
W
= UBOUND(grid_img
, 1) 'je li sirka jednoho ctverce .5, nelze jinak
'nejprve zpracuju zdi. Toto pole umoznuje jednu texturu na jeden blok zdi v teto verzi.
'save walls infos
IF Grid_img
(RecordWallsX
, RecordWallsY
) THEN Texture_Nr = GET_TEXTURE_NR(Grid_img(RecordWallsX, RecordWallsY)) + 1 'cislo textury
' PRINT RecordWallsX, RecordWallsY: _DISPLAY: SLEEP
Texture_Nr = -1
've stejne smycce, protoze tato pole maji stejne velikosti, zpracuji i pole zemi (floor)
'save floors infos
IF Grid_Floor
(RecordFloorX
, RecordFloorY
) THEN Texture_Nr = GET_TEXTURE_NR(Grid_Floor(RecordFloorX, RecordFloorY)) + 1 'cislo textury
Texture_Nr = -1
'nakonec to same pro strop:
'save ceilings infos
IF Grid_Ceil
(RecordCeilX
, RecordCeilY
) THEN Texture_Nr = GET_TEXTURE_NR(Grid_Ceil(RecordCeilX, RecordCeilY)) + 1 'cislo textury
Texture_Nr = -1
'in future next areas: Sound infos, objects infos
ELSE DialogW
"MAP IS EMPTY!", 3
Tnr = Texture(x).img
SUB LOAD_MAP
(filename
AS STRING) 'load images as software textures + other infos ' DIM Vertex AS Vertex
IF RH.Identity
<> "MAP3D" THEN PRINT "Unsupported MAP format.":
EXIT SUB 'unsupported file format
PRINT "V souboru je:"; RH.Nr_of_Textures;
"textur" 'Nr Textures in file 4 B PRINT "V souboru je:"; RH.Nr_of_Vertexes;
"vrcholu" 'Nr Vertexes in file 4 B PRINT "Zacatek dat textur: "; RH.DataStart
'Data texture in file start offset 4 B PRINT "Zacatek dat vrcholu: "; RH.VertexStart
'Vertexes in file start offset 4 B
DIM FileNamesLenght
(RH.Nr_of_Textures
) AS LONG FOR R
= 1 TO RH.Nr_of_Textures
GET #ff
, , FileNamesLenght
(R
)
FOR R
= 1 TO RH.Nr_of_Textures
FOR R
= 1 TO RH.Nr_of_Textures
FileName
(R
) = SPACE$(FileNamesLenght
(R
))
SP$ = "TEXTURES\"
FOR R
= 1 TO RH.Nr_of_Textures
record$ = ""
REDIM Texture
(RH.Nr_of_Textures
- 1) AS Texture
FOR R
= 1 TO RH.Nr_of_Textures
Texture(R - 1).img = Sload(SP$ + FileName(R)) 'index udava poradi textury v souboru, pridano SP$
Texture(R - 1).path = SP$ + FileName(R)
Grid_img(Lx, Ly) = Texture(record& - 1).img
Grid_Floor(Lx, Ly) = Texture(record& - 1).img
Grid_Ceil(Lx, Ly) = Texture(record& - 1).img
T = WHOIS(Lx, Ly)
Grid_typ(Lx, Ly) = T
StartDrawX = 0: EndDrawX = 36
StartDrawy = 0: EndDrawy = 35
LINE (X
- 5, y
- 5)-(X
+ 355, y
+ 14), _RGB32(255, 255, 255), B
Roll(0) = "Show all layers. Separate it using ALPHA" 'to jak to je ted
Roll(1) = "Show actual layer only" ' ukaze jen vrstvu na kterou je preply, ostatni nezobrazi
Roll(2) = "Show actual layer, SPACE for show all" ' ukaze jen aktualni vrstvu, po stisku mezerniku i ostatni vrstvy
Roll(3) = "Don't show textures, use QUADS, all layers" 'misto textur pouzije LINE BF, zobrazi vsechny vrstvy
Roll(4) = "Don't show textures, use QUAD, one layer" 'misto textur pouzije LINE BF, vzdy jen aktualni vrstvu
LINE (X
, y
- 3)-(X
+ 8, y
+ 10), _RGBA32(127, 127, 127, 120), BF
Ypoz = y + (20 * LAYERS_SETUP)
LINE (X
- 3, Ypoz
- 5)-(X
+ 353, Ypoz
+ 15), _RGB32(200), B
LAYERS_SETUP = LAYERS_SETUP - 1
LAYERS_SETUP = LAYERS_SETUP + 1
LAYERS_SETUP = my
'vyjede roleta s nabidkou
activ = 0
LINE (X
- 5, y
- 5)-(X
+ 155, y
+ 14), _RGB32(255, 255, 255), B
Roll(0) = "Single squares" 'to jak to je ted
Roll(1) = "In blocks" ' malovat v blocich
LINE (X
, y
- 3)-(X
+ 8, y
+ 10), _RGBA32(127, 127, 127, 120), BF
Ypoz = y + (20 * DRAW_MOUSE_SETUP)
LINE (X
- 3, Ypoz
- 5)-(X
+ 153, Ypoz
+ 15), _RGB32(200), B
DRAW_MOUSE_SETUP = DRAW_MOUSE_SETUP - 1
DRAW_MOUSE_SETUP = DRAW_MOUSE_SETUP + 1
' LOCATE 1, 1: PRINT my
DRAW_MOUSE_SETUP = my
'vyjede roleta s nabidkou
activ = 0
' DIM Vertex AS Vertex
IF RH.Identity
<> "MAP3D" THEN PRINT "Unsupported MAP format.":
EXIT SUB 'unsupported file format
SEEK #ff
, RH.VertexStart
+ 1
FAST_MAP_INFO&
= _NEWIMAGE(W
* 5, H
* 5 + 70, 32) LINE (Lx
* 5, Ly
* 5)-(Lx
* 5 + 5, Ly
* 5 + 5), _RGB32(255), BF
LINE (Lx
* 5, Ly
* 5)-(Lx
* 5 + 5, Ly
* 5 + 5), _RGBA32(255, 0, 0, 50), BF
_PRINTSTRING (10, H
* 5 + 5), "Map contains" + STR$(RH.Nr_of_Textures
) + " textures." 'pocet textur v souboru 4 B _PRINTSTRING (10, H
* 5 + 25), "Map use" + STR$(RH.Nr_of_Vertexes
) + " objects." 'pocet vrcholu v souboru 4 B
FUNCTION IS_SUBSET
(array
() AS LONG, RangeAX
, RangeAY
) 'pokud pole obsahuje hodnotu v rozsahu od RangeAX, RangeAY do UBOUND1, UBOUND2, pak funkce vrati 1
'$include:'saveimage.bm'
'$include:'editor.bm'