QB64.org Forum

Active Forums => Programs => Topic started by: Cobalt on November 28, 2021, 02:03:25 pm

Title: World Explorer BETA
Post by: Cobalt on November 28, 2021, 02:03:25 pm

The counter part of the World Builder program. A quick Demo of how the maps created with the World Builder program are used.

The Explore-able area is limited to roughly 16x16 for this quick demo. Still some slight hiccups with the layering effect.

Arrow Keys move the player
Space bar interacts with a few areas on screen.

I hope to include the addition of Interactive areas on the screen to be create-able within the World Builder program itself. but as for now they are hard coded in the World Explorer program and will show up even in other maps at the moment.

Sample Map included, but you can make one with the latest World Builder program, to try your own map you must simply change line 49 to the name of your map.

Code: QB64: [Select]

1. TYPE World_Tiles
2.  Id AS INTEGER 'ground
3.  Deco AS INTEGER 'decorations(trees\bushes\ect)
4.  Lay3 AS INTEGER 'a third layer of map tiles
5.  Walkable AS _BYTE 'can player walk on this tile?
6. END TYPE
7.  
8. TYPE Player_Data
9.  World_X AS _UNSIGNED INTEGER 'world size is 0-65535 tiles^2 (4,294,967,295 tiles total)
10.  World_Y AS _UNSIGNED INTEGER
11.  Local_X AS INTEGER
12.  Local_Y AS INTEGER
13.  Direction AS _BYTE
14.  Frame AS _BYTE
15. END TYPE
16.  
17. SCREEN _NEWIMAGE(840, 640, 32)
18. _TITLE "World Explorer V1.0"
19. _SCREENMOVE 10, 10
20.  
21. CONST Key_Right = 19712, Key_Left = 19200, Key_Up = 18432, Key_Down = 20480
22. CONST Key_Space = 32, Key_Enter = 13
23. CONST Down = 0, Left = 1, Right = 2, Up = 3, InterAct = 4
24. CONST TRUE = -1, FALSE = NOT TRUE
25.  
26. DIM SHARED Layer(16) AS LONG, World(255, 255) AS World_Tiles
27. DIM SHARED P AS Player_Data, Yo%%
28.  
29. Layer(0) = _DISPLAY
30. Layer(1) = _NEWIMAGE(840, 640, 32) 'composite layer
31. 'Layer(2) = _LOADIMAGE("linear_tiles.bmp", 32) 'world tiles
32. Layer(3) = _NEWIMAGE(840, 640, 32)
33. 'Layer(4) = _LOADIMAGE("Character3.bmp", 32) 'world tiles
34. Layer(5) = _NEWIMAGE(840, 640, 32)
35.  
36. MFI_Loader "WorldExplorer.MFI"
37.  
38. _CLEARCOLOR _RGB32(0), Layer(2)
39. _CLEARCOLOR _RGB32(0), Layer(3)
40. _CLEARCOLOR _RGB32(0), Layer(5)
41. _CLEARCOLOR _RGB32(43, 133, 133), Layer(4)
42. _PRINTMODE _KEEPBACKGROUND , Layer(3)
43. _PRINTMODE _KEEPBACKGROUND , Layer(1)
44. P.World_X = 0
45. P.World_Y = 0
46. P.Local_X = 32
47. P.Local_Y = 32
48.  
49. Load_it "take2"
50.  
51. Draw_World_Area
52.  
53.  
54. DO
55.  SELECT CASE Get_Input
56.   CASE Down
57.    Moving%% = TRUE
58.    P.Direction = Down
59.    IF P.Local_Y < 600 THEN P.Local_Y = P.Local_Y + 1
60.    IF Collision_World THEN P.Local_Y = P.Local_Y - 1
61.   CASE Left
62.    Moving%% = TRUE
63.    P.Direction = Left
64.    IF P.Local_X > 2 THEN P.Local_X = P.Local_X - 1
65.    IF Collision_World THEN P.Local_X = P.Local_X + 1
66.   CASE Right
67.    Moving%% = TRUE
68.    P.Direction = Right
69.    IF P.Local_X < 600 THEN P.Local_X = P.Local_X + 1
70.    IF Collision_World THEN P.Local_X = P.Local_X - 1
71.   CASE Up
72.    Moving%% = TRUE
73.    P.Direction = Up
74.    IF P.Local_Y > 2 THEN P.Local_Y = P.Local_Y - 1
75.    IF Collision_World THEN P.Local_Y = P.Local_Y + 1
76.   CASE InterAct
77.    _DELAY .1
78.    InterActions
79.   CASE ELSE
80.    P.Frame = 0
81.    Moving%% = FALSE
82.  END SELECT
83.  IF Moving%% THEN Animate_Character
84.  
85.  _PUTIMAGE , Layer(3), Layer(1)
86.  Draw_Character 0, 0, P.Frame
87.  _PUTIMAGE , Layer(5), Layer(1)
88.  _PUTIMAGE , Layer(1), Layer(0)
89.  ClearLayer Layer(1)
90.  _LIMIT 60
91.  IF INKEY$ = CHR$(27) THEN ExitFlag%% = -1
92. LOOP UNTIL ExitFlag%%
93.  
94. SUB Animate_Character
95.  STATIC Frame%%
96.  Frame%% = Frame%% + 1
97.  IF Frame%% = 15 THEN P.Frame = P.Frame + 1: Frame%% = 0
98.  IF P.Frame = 4 THEN P.Frame = 0
99. END SUB
100.  
101. SUB Draw_World_Area
102.  FOR Y%% = 0 TO 19
103.   FOR X%% = 0 TO 19
104.    Draw_Sprite X%%, Y%%, World(P.World_X + X%%, P.World_Y + Y%%).Id
105.    IF World(P.World_X + X%%, P.World_Y + Y%%).Deco THEN
106.     Draw_Deco_Sprite X%%, Y%%, World(P.World_X + X%%, P.World_Y + Y%%).Deco, Layer(3)
107.    END IF
108.    IF World(P.World_X + X%%, P.World_Y + Y%%).Lay3 THEN
109.     Draw_Deco_Sprite X%%, Y%%, World(P.World_X + X%%, P.World_Y + Y%%).Lay3, Layer(5)
110.    END IF
111.   NEXT X%%
112.  NEXT Y%%
113. END SUB
114.  
115. SUB Draw_Sprite (X%%, Y%%, id%)
116.  _PUTIMAGE (X%% * 32, Y%% * 32), Layer(2), Layer(3), (0 + id% * 32, 0)-STEP(31, 31)
117. END SUB
118.  
119. SUB Draw_Deco_Sprite (x%%, y%%, id%, L&)
120.  _PUTIMAGE (x%% * 32, y%% * 32), Layer(2), L&, (0 + id% * 32, 0)-STEP(31, 31)
121. END SUB
122.  
123. SUB Load_it (File$)
124.  F = FREEFILE
125.  IF File$ = "" THEN File$ = "Defualt"
126.  File$ = LTRIM$(RTRIM$(File$)) 'no spaces allowed
127.   IF _FILEEXISTS(File$+".MAP") = FALSE THEN PRINT File$ + ".MAP is missing.": END
128.  OPEN File$ + ".MAP" FOR BINARY AS #F 'Save
129.  GET #F, , World()
130.  CLOSE #F
131. END SUB
132.  
133. SUB Draw_Character (x%%, y%%, id%)
134.  _PUTIMAGE (P.Local_X + x%% * 32, P.Local_Y + y%% * 32), Layer(4), Layer(1), (0 + id% * 32, 0 + 48 * P.Direction)-STEP(30, 47)
135. END SUB
136.  
137. FUNCTION Get_Input%% ()
138.  Result%% = TRUE '-1 for no input
139.  ' IF _KEYDOWN(ESC_Key) THEN Result%% = ESC
140.  IF _KEYDOWN(Key_Up) THEN Result%% = Up
141.  IF _KEYDOWN(Key_Down) THEN Result%% = Down
142.  IF _KEYDOWN(Key_Left) THEN Result%% = Left
143.  IF _KEYDOWN(Key_Right) THEN Result%% = Right
144.  IF _KEYDOWN(Key_Space) THEN Result%% = InterAct
145.  Get_Input%% = Result%%
146. END FUNCTION
147.  
148. SUB ClearLayer (L&)
149.  _DEST L&
150.  CLS
151.  _DEST _DISPLAY
152. END SUB
153.  
154. SUB ClearLayerTrans (L&)
155.  _DEST L&
156.  CLS , 0
157.  _DEST _DISPLAY
158. END SUB
159.  
160. FUNCTION Collision_World%%
161.  Result%% = TRUE
162.  SELECT CASE P.Direction 'adjust collision detection point based on direction of travel
163.   CASE Down
164.    Yo%% = 1
165.   CASE Up
166.    Yo%% = 1
167.   CASE Left
168.    Yo%% = 1
169.   CASE Right
170.    Yo%% = 1
171.  END SELECT
172.  IF World(Tile(P.Local_X + 16), Tile(P.Local_Y + 0) + Yo%%).Walkable THEN Result%% = FALSE
173.  
174.  _PUTIMAGE (650, 100)-STEP(63, 16), Layer(1), Layer(3), (700, 500)-STEP(32, 16)
175.  _PRINTSTRING (650, 100), STR$(Tile(P.Local_X + 16)) + STR$(Tile(P.Local_Y) + Yo%%), Layer(3)
176.  Collision_World = Result%%
177. END FUNCTION
178.  
179. FUNCTION Tile% (value%)
180.  Result% = value% \ 32
181.  Tile = Result%
182. END FUNCTION
183.  
184. SUB InterActions
185.  SELECT CASE P.Direction
186.   CASE Up
187.    IF Tile(P.Local_X + 16) = 1 AND Tile(P.Local_Y) - 1 + Yo%% = 6 THEN 'sign post
188.     tmp& = _COPYIMAGE(Layer(0))
189.     _KEYCLEAR
190.     _DEST Layer(1)
191.     DO
192.      _PUTIMAGE , tmp&, Layer(1)
193.      LINE (P.Local_X + 32, P.Local_Y + 16)-STEP(191, 40), _RGBA32(112, 32, 192, 144), BF
194.      _PRINTSTRING (P.Local_X + 42, P.Local_Y + 26), "This is a sign post.", Layer(1)
195.      _PUTIMAGE , Layer(1), Layer(0)
196.      _LIMIT 60
197.      IF Get_Input <> TRUE THEN ExitFlag%% = TRUE
198.     LOOP UNTIL ExitFlag%%
199.     _KEYCLEAR
200.     _FREEIMAGE tmp&
201.     _DEST Layer(0)
202.    END IF
203.  
204.    IF Tile(P.Local_X + 16) = 1 AND Tile(P.Local_Y) - 1 + Yo%% = 13 THEN 'Grave Stone
205.     tmp& = _COPYIMAGE(Layer(0))
206.     _KEYCLEAR
207.     _DEST Layer(1)
208.     DO
209.      _PUTIMAGE , tmp&, Layer(1)
210.      LINE (P.Local_X + 32, P.Local_Y + 16)-STEP(191, 48), _RGBA32(112, 32, 192, 144), BF
211.      _PRINTSTRING (P.Local_X + 42, P.Local_Y + 26), "Here lies: Cobalt", Layer(1)
212.      _PRINTSTRING (P.Local_X + 42, P.Local_Y + 42), "33AE - 121AE", Layer(1)
213.      _PUTIMAGE , Layer(1), Layer(0)
214.      _LIMIT 60
215.      IF Get_Input <> TRUE THEN ExitFlag%% = TRUE
216.     LOOP UNTIL ExitFlag%%
217.     _KEYCLEAR
218.     _FREEIMAGE tmp&
219.     _DEST Layer(0)
220.    END IF
221.  
222.    IF Tile(P.Local_X + 16) = 7 AND Tile(P.Local_Y) - 1 + Yo%% = 11 THEN 'Front door
223.     tmp& = _COPYIMAGE(Layer(0))
224.     _KEYCLEAR
225.     _DEST Layer(1)
226.     DO
227.      _PUTIMAGE , tmp&, Layer(1)
228.      LINE (P.Local_X + 32, P.Local_Y + 16)-STEP(191, 48), _RGBA32(112, 32, 192, 144), BF
229.      _PRINTSTRING (P.Local_X + 42, P.Local_Y + 26), "'Knock Knock...'", Layer(1)
230.      _PRINTSTRING (P.Local_X + 42, P.Local_Y + 42), "There is no answer.", Layer(1)
231.      _PUTIMAGE , Layer(1), Layer(0)
232.      _LIMIT 60
233.      IF Get_Input <> TRUE THEN ExitFlag%% = TRUE
234.     LOOP UNTIL ExitFlag%%
235.     _KEYCLEAR
236.     _FREEIMAGE tmp&
237.     _DEST Layer(0)
238.    END IF
239.  
240.    IF Tile(P.Local_X + 16) = 6 AND Tile(P.Local_Y) - 1 + Yo%% = 4 THEN 'Well
241.     tmp& = _COPYIMAGE(Layer(0))
242.     _KEYCLEAR
243.     _DEST Layer(1)
244.     DO
245.      _PUTIMAGE , tmp&, Layer(1)
246.      LINE (P.Local_X + 32, P.Local_Y + 16)-STEP(191, 48), _RGBA32(112, 32, 192, 144), BF
247.      _PRINTSTRING (P.Local_X + 42, P.Local_Y + 26), "It is a well.", Layer(1)
248.      _PRINTSTRING (P.Local_X + 42, P.Local_Y + 42), "Wow it is deep!", Layer(1)
249.      _PUTIMAGE , Layer(1), Layer(0)
250.      _LIMIT 60
251.      IF Get_Input <> TRUE THEN ExitFlag%% = TRUE
252.     LOOP UNTIL ExitFlag%%
253.     _KEYCLEAR
254.     _FREEIMAGE tmp&
255.     _DEST Layer(0)
256.    END IF
257.  
258.  END SELECT
259. END SUB
260.  
261. SUB MFI_Loader (FN$)
262.  DIM Size(128) AS LONG, FOffset(128) AS LONG
263.   IF _FILEEXISTS(FN$) = FALSE THEN PRINT FN$ + " is missing. This file needs downloaded": END
264.  OPEN FN$ FOR BINARY AS #1
265.  GET #1, , c~%% 'retrieve number of files
266.  FOR I~%% = 1 TO c~%%
267.   GET #1, , FOffset(I~%%)
268.   GET #1, , Size(I~%%)
269.   FOffset&(I~%%) = FOffset&(I~%%) + 1
270.  NEXT I~%%
271.  
272.  Layer(2) = LoadGFX(FOffset(1), Size(1)) 'tiles
273.  Layer(4) = LoadGFX(FOffset(2), Size(2)) 'characters
274.  
275.  CLOSE #1
276.  IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
277. END SUB
278.  
279. FUNCTION LoadGFX& (Foff&, Size&)
280.  IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
281.  OPEN "temp.dat" FOR BINARY AS #3
282.  dat$ = SPACE$(Size&)
283.  GET #1, Foff&, dat$
284.  PUT #3, , dat$
285.  CLOSE #3
286.  LoadGFX& = _LOADIMAGE("temp.dat", 32)
287. END FUNCTION
288.  

Text Only | Text with Attachments