Prototype game engine for Heroes of Might & Magic, featuring a gameplay plot-twist...
Du kannst nicht mehr als 25 Themen auswählen Themen müssen entweder mit einem Buchstaben oder einer Ziffer beginnen. Sie können Bindestriche („-“) enthalten und bis zu 35 Zeichen lang sein.

1004 Zeilen
46KB

  1. -- Copyright (c) 2024 - Ognjen 'xolatile' Milan Robovic
  2. --
  3. -- GNU General Public Licence (version 3 or later)
  4. with core, ui, attribute, skill, resource, equipment, unit, construction, chad, effect;
  5. use type core.cursor_code;
  6. use type core.point;
  7. package body world is
  8. ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
  9. view_reach : constant integer := 96;
  10. lake_count : constant natural := 6;
  11. landmark_limit : constant integer := 480;
  12. location_limit : constant integer := 240;
  13. construction_limit : constant natural := 120;
  14. equipment_limit : constant natural := 300;
  15. unit_limit : constant natural := 60;
  16. tiles : array (biome) of core.sprite;
  17. target : core.vector := (-1, -1);
  18. dark : core.sprite;
  19. border_upper : core.sprite;
  20. border_lower : core.sprite;
  21. border_left : core.sprite;
  22. border_right : core.sprite;
  23. corner_upper_left : core.sprite;
  24. corner_upper_right : core.sprite;
  25. corner_lower_left : core.sprite;
  26. corner_lower_right : core.sprite;
  27. arrow_target : core.sprite;
  28. arrow_upper : core.sprite;
  29. arrow_lower : core.sprite;
  30. arrow_left : core.sprite;
  31. arrow_right : core.sprite;
  32. arrow_upper_left : core.sprite;
  33. arrow_upper_right : core.sprite;
  34. arrow_lower_left : core.sprite;
  35. arrow_lower_right : core.sprite;
  36. draw_tiles_timer : natural := 0;
  37. draw_views_timer : natural := 0;
  38. draw_landmarks_timer : natural := 0;
  39. draw_locations_timer : natural := 0;
  40. draw_constructions_timer : natural := 0;
  41. draw_equipments_timer : natural := 0;
  42. draw_units_timer : natural := 0;
  43. draw_world_timer : natural := 0;
  44. drawn_tiles : natural := 0;
  45. drawn_views : natural := 0;
  46. drawn_landmarks : natural := 0;
  47. drawn_locations : natural := 0;
  48. drawn_constructions : natural := 0;
  49. drawn_equipments : natural := 0;
  50. drawn_units : natural := 0;
  51. ------------------------------------------------------------------------------------------
  52. procedure generate_lake (x, y : in integer; size : in natural) is
  53. starts, length : integer;
  54. begin
  55. for offset_x in -size / 2 .. size / 2 loop
  56. starts := core.random (0, abs offset_x);
  57. length := core.random (size / 2, size - starts);
  58. --
  59. for repeat in 0 .. 1 loop
  60. for offset_y in starts .. starts + length loop
  61. map.tiles (x + 2 * offset_x + repeat, y + offset_y) := core.random (18, 23);
  62. end loop;
  63. end loop;
  64. end loop;
  65. end generate_lake;
  66. ------------------------------------------------------------------------------------------
  67. procedure draw_tiles (offset, view_from, view_to : in core.vector) is
  68. time : float := 0.0;
  69. step : core.vector := core.camera;
  70. size : constant integer := core.base * core.zoom;
  71. hits : natural := 0;
  72. begin
  73. time := core.time;
  74. --
  75. for vertical in view_from.y .. view_from.y + view_to.y loop
  76. exit when vertical > map.height - 1;
  77. --
  78. for horizontal in view_from.x .. view_from.x + view_to.x loop
  79. exit when horizontal > map.width - 1;
  80. --
  81. if map.views (horizontal, vertical) then
  82. core.draw (data => tiles (map.kind),
  83. x => offset.x + (horizontal - core.camera.x) * size,
  84. y => offset.y + (vertical - core.camera.y) * size,
  85. u => core.base * map.tiles (horizontal, vertical),
  86. v => core.base * (core.animation_time mod tiles (map.kind).frames),
  87. width => core.base,
  88. height => core.base,
  89. ignore => true);
  90. --
  91. core.increment (drawn_tiles);
  92. --
  93. if core.cursor_inside (x => offset.x + (horizontal - core.camera.x) * size,
  94. y => offset.y + (vertical - core.camera.y) * size,
  95. width => size,
  96. height => size)
  97. and core.cursor_mode = core.cursor_left
  98. and not ui.prioritize then
  99. target.x := horizontal;
  100. target.y := vertical;
  101. core.cursor_mode := core.cursor_none;
  102. end if;
  103. --
  104. if core.cursor_inside (x => offset.x + (target.x - core.camera.x) * size,
  105. y => offset.y + (target.y - core.camera.y) * size,
  106. width => size,
  107. height => size)
  108. and core.cursor_mode = core.cursor_left
  109. and not ui.prioritize then
  110. world.map.chads (1).x := horizontal + 1;
  111. world.map.chads (1).y := vertical;
  112. end if;
  113. end if;
  114. end loop;
  115. end loop;
  116. --
  117. if target /= (-1, -1) then
  118. step := core.camera;
  119. hits := 0;
  120. --
  121. core.draw (data => arrow_target,
  122. x => offset.x + (target.x - core.camera.x) * size,
  123. y => offset.y + (target.y - core.camera.y) * size,
  124. factor => core.zoom);
  125. --
  126. loop
  127. exit when (step.x = target.x - 1 and step.y = target.y - 1) or (hits = 6);
  128. --
  129. if step.x < target.x and step.y < target.y then
  130. core.draw (arrow_lower_right, offset.x + (step.x + 1 - core.camera.x) * size, offset.y + (step.y + 1 - core.camera.y) * size, factor => core.zoom);
  131. step.x := step.x + 1;
  132. step.y := step.y + 1;
  133. elsif step.x > target.x and step.y < target.y then
  134. core.draw (arrow_lower_left, offset.x + (step.x - 1 - core.camera.x) * size, offset.y + (step.y + 1 - core.camera.y) * size, factor => core.zoom);
  135. step.x := step.x - 1;
  136. step.y := step.y + 1;
  137. elsif step.x = target.x and step.y < target.y then
  138. core.draw (arrow_lower, offset.x + (step.x - core.camera.x) * size, offset.y + (step.y + 1 - core.camera.y) * size, factor => core.zoom);
  139. step.y := step.y + 1;
  140. elsif step.x < target.x and step.y = target.y then
  141. core.draw (arrow_right, offset.x + (step.x + 1 - core.camera.x) * size, offset.y + (step.y - core.camera.y) * size, factor => core.zoom);
  142. step.x := step.x + 1;
  143. elsif step.x > target.x and step.y = target.y then
  144. core.draw (arrow_left, offset.x + (step.x - 1 - core.camera.x) * size, offset.y + (step.y - core.camera.y) * size, factor => core.zoom);
  145. step.x := step.x - 1;
  146. elsif step.x < target.x and step.y > target.y then
  147. core.draw (arrow_upper_right, offset.x + (step.x + 1 - core.camera.x) * size, offset.y + (step.y - 1 - core.camera.y) * size, factor => core.zoom);
  148. step.x := step.x + 1;
  149. step.y := step.y - 1;
  150. elsif step.x > target.x and step.y > target.y then
  151. core.draw (arrow_upper_left, offset.x + (step.x - 1 - core.camera.x) * size, offset.y + (step.y - 1 - core.camera.y) * size, factor => core.zoom);
  152. step.x := step.x - 1;
  153. step.y := step.y - 1;
  154. elsif step.x = target.x and step.y > target.y then
  155. core.draw (arrow_upper, offset.x + (step.x - core.camera.x) * size, offset.y + (step.y - 1 - core.camera.y) * size, factor => core.zoom);
  156. step.y := step.y - 1;
  157. end if;
  158. --
  159. hits := hits + 1;
  160. end loop;
  161. end if;
  162. --
  163. draw_tiles_timer := natural (1_000_000.0 * (core.time - time));
  164. end draw_tiles;
  165. ------------------------------------------------------------------------------------------
  166. procedure compute_world_visibility_grid (offset : in core.vector) is
  167. begin
  168. for vertical in 0 .. map.height - 1 loop
  169. exit when offset.y + (vertical - core.camera.y) * core.base * core.zoom > core.window_height;
  170. --
  171. for horizontal in 0 .. map.width - 1 loop
  172. exit when offset.x + (horizontal - core.camera.x) * core.base * core.zoom > core.window_width;
  173. --
  174. if not ((horizontal - core.camera.x) ** 2 + (vertical - core.camera.y) ** 2 > view_reach * 2) then
  175. map.views (horizontal, vertical) := true;
  176. end if;
  177. end loop;
  178. end loop;
  179. end compute_world_visibility_grid;
  180. ------------------------------------------------------------------------------------------
  181. procedure compute_world_frame (offset : in core.vector) is
  182. x : constant integer := core.base * core.zoom * (-1 - core.camera.x) + offset.x;
  183. y : constant integer := core.base * core.zoom * (-1 - core.camera.y) + offset.y;
  184. width : constant integer := core.base * core.zoom * (map.width + 2);
  185. height : constant integer := core.base * core.zoom * (map.height + 2);
  186. begin
  187. core.draw_horizontally (border_upper, x + core.base * core.zoom, y, width - 2 * core.base * core.zoom, core.zoom);
  188. core.draw_horizontally (border_lower, x + core.base * core.zoom, y - core.base * core.zoom + height, width - 2 * core.base * core.zoom, core.zoom);
  189. core.draw_vertically (border_left, x, y + core.base * core.zoom, height - 2 * core.base * core.zoom, core.zoom);
  190. core.draw_vertically (border_right, x - core.base * core.zoom + width, y + core.base * core.zoom, height - 2 * core.base * core.zoom, core.zoom);
  191. --
  192. core.draw (corner_upper_left, x, y, factor => core.zoom);
  193. core.draw (corner_upper_right, x - core.base * core.zoom + width, y, factor => core.zoom);
  194. core.draw (corner_lower_left, x, y - core.base * core.zoom + height, factor => core.zoom);
  195. core.draw (corner_lower_right, x - core.base * core.zoom + width, y - core.base * core.zoom + height, factor => core.zoom);
  196. end compute_world_frame;
  197. ------------------------------------------------------------------------------------------
  198. procedure draw_landmarks (offset, view_from, view_to : in core.vector) is
  199. time : float := 0.0;
  200. begin
  201. time := core.time;
  202. --
  203. for index in 1 .. landmark_limit loop
  204. if map.views (map.landmarks (index).x, map.landmarks (index).y)
  205. and map.landmarks (index).x > view_from.x and map.landmarks (index).x < view_from.x + view_to.x
  206. and map.landmarks (index).y > view_from.y and map.landmarks (index).y < view_from.y + view_to.y then
  207. core.draw (data => landmarks (landmark_index'val (map.landmarks (index).index)),
  208. x => offset.x + (map.landmarks (index).x - core.camera.x) * core.base * core.zoom,
  209. y => offset.y + (map.landmarks (index).y - core.camera.y) * core.base * core.zoom);
  210. --
  211. core.increment (drawn_landmarks);
  212. --
  213. if core.cursor_inside (x => offset.x + (map.landmarks (index).x - core.camera.x) * core.base * core.zoom,
  214. y => offset.y + (map.landmarks (index).y - core.camera.y) * core.base * core.zoom,
  215. width => landmarks (landmark_index'val (map.landmarks (index).index)).width,
  216. height => landmarks (landmark_index'val (map.landmarks (index).index)).height)
  217. and core.cursor_mode = core.cursor_middle
  218. and not ui.prioritize then
  219. core.write_text_box (landmark_description (landmark_index'val (map.landmarks (index).index)).name);
  220. end if;
  221. end if;
  222. end loop;
  223. --
  224. draw_landmarks_timer := natural (1_000_000.0 * (core.time - time));
  225. end draw_landmarks;
  226. ------------------------------------------------------------------------------------------
  227. procedure draw_locations (offset, view_from, view_to : in core.vector) is
  228. time : float := 0.0;
  229. sprite : core.sprite;
  230. begin
  231. time := core.time;
  232. --
  233. for index in 1 .. location_limit loop
  234. if map.views (map.locations (index).x, map.locations (index).y)
  235. and map.locations (index).x > view_from.x and map.locations (index).x < view_from.x + view_to.x
  236. and map.locations (index).y > view_from.y and map.locations (index).y < view_from.y + view_to.y then
  237. core.draw (data => locations (location_index'val (map.locations (index).index)),
  238. x => offset.x + (map.locations (index).x - core.camera.x) * core.base * core.zoom,
  239. y => offset.y + (map.locations (index).y - core.camera.y) * core.base * core.zoom,
  240. state => core.animation'val (map.locations (index).state));
  241. --
  242. core.increment (drawn_locations);
  243. --
  244. if core.cursor_inside (x => offset.x + (map.locations (index).x - core.camera.x) * core.base * core.zoom,
  245. y => offset.y + (map.locations (index).y - core.camera.y) * core.base * core.zoom,
  246. width => locations (location_index'val (map.locations (index).index)).width,
  247. height => locations (location_index'val (map.locations (index).index)).height)
  248. and core.cursor_mode = core.cursor_middle
  249. and not ui.prioritize then
  250. core.write_text_box (location_description (location_index'val (map.locations (index).index)).name);
  251. end if;
  252. end if;
  253. --
  254. if map.locations (index).state = 1 and core.animation_time = 0 then
  255. map.locations (index).state := 2;
  256. end if;
  257. --
  258. if core.camera.x > map.locations (index).x - 2
  259. and core.camera.x < map.locations (index).x + 1 + locations (location_index'val (map.locations (index).index)).width / core.base
  260. and core.camera.y > map.locations (index).y - 2
  261. and core.camera.y < map.locations (index).y + 1 + locations (location_index'val (map.locations (index).index)).height / core.base
  262. and map.locations (index).state = 0
  263. and core.signal_code'pos (core.signal_mode) = core.signal_code'pos (core.signal_e)
  264. and not ui.prioritize then
  265. effect.apply (location_description (location_index'val (map.locations (index).index)).evoke);
  266. --
  267. map.locations (index).state := 1;
  268. end if;
  269. end loop;
  270. --
  271. draw_locations_timer := natural (1_000_000.0 * (core.time - time));
  272. end draw_locations;
  273. ------------------------------------------------------------------------------------------
  274. procedure draw_constructions (offset, view_from, view_to : in core.vector) is
  275. time : float := 0.0;
  276. x : integer := 0;
  277. y : integer := 0;
  278. --
  279. this : construction.enumeration;
  280. begin
  281. time := core.time;
  282. --
  283. for index in 1 .. construction_limit loop
  284. if map.views (map.constructions (index).x, map.constructions (index).y)
  285. and map.constructions (index).x > view_from.x and map.constructions (index).x < view_from.x + view_to.x
  286. and map.constructions (index).y > view_from.y and map.constructions (index).y < view_from.y + view_to.y then
  287. x := offset.x + (map.constructions (index).x - core.camera.x) * core.base * core.zoom;
  288. y := offset.y + (map.constructions (index).y - core.camera.y) * core.base * core.zoom;
  289. this := construction.enumeration'val (map.constructions (index).index);
  290. --
  291. core.draw (construction.sprite (this), x, y);
  292. --
  293. if core.cursor_inside (x, y, construction.sprite (this).width, construction.sprite (this).height)
  294. and core.cursor_mode = core.cursor_middle
  295. and not ui.prioritize then
  296. core.write_text_box (-(construction.description (this).name));
  297. end if;
  298. --
  299. core.increment (drawn_constructions);
  300. end if;
  301. end loop;
  302. --
  303. draw_constructions_timer := natural (1_000_000.0 * (core.time - time));
  304. end draw_constructions;
  305. ------------------------------------------------------------------------------------------
  306. procedure draw_equipments (offset, view_from, view_to : in core.vector) is
  307. time : float := 0.0;
  308. x : integer := 0;
  309. y : integer := 0;
  310. --
  311. this : equipment.enumeration;
  312. begin
  313. time := core.time;
  314. --
  315. for index in 1 .. equipment_limit loop
  316. if map.views (map.equipments (index).x, map.equipments (index).y)
  317. and map.equipments (index).x > view_from.x and map.equipments (index).x < view_from.x + view_to.x
  318. and map.equipments (index).y > view_from.y and map.equipments (index).y < view_from.y + view_to.y then
  319. x := offset.x + (map.equipments (index).x - core.camera.x) * core.base * core.zoom;
  320. y := offset.y + (map.equipments (index).y - core.camera.y) * core.base * core.zoom;
  321. this := equipment.enumeration'val (map.equipments (index).index);
  322. --
  323. core.draw (equipment.sprite (this), x, y, state => core.idle);
  324. --
  325. if core.cursor_inside (x, y, equipment.sprite (this).width, equipment.sprite (this).height)
  326. and core.cursor_mode = core.cursor_middle
  327. and equipment.enumeration'pos (this) /= equipment.enumeration'pos (equipment.none)
  328. and not ui.prioritize then
  329. core.write_text_box (-(equipment.description (this).name));
  330. end if;
  331. --
  332. core.increment (drawn_equipments);
  333. end if;
  334. --
  335. if map.equipments (index).x = core.camera.x
  336. and map.equipments (index).y = core.camera.y
  337. and core.signal_code'pos (core.signal_mode) = core.signal_code'pos (core.signal_e) then
  338. if chad.take_equipment_item (map.chads (1), equipment.enumeration'val (map.equipments (index).index)) then
  339. map.equipments (index).index := equipment.enumeration'pos (equipment.none);
  340. end if;
  341. end if;
  342. end loop;
  343. --
  344. draw_equipments_timer := natural (1_000_000.0 * (core.time - time));
  345. end draw_equipments;
  346. ------------------------------------------------------------------------------------------
  347. procedure draw_units (offset, view_from, view_to : in core.vector) is
  348. time : float := 0.0;
  349. begin
  350. time := core.time;
  351. --
  352. for index in 1 .. unit_limit loop
  353. if map.views (map.units (index).x, map.units (index).y)
  354. and map.units (index).x > view_from.x and map.units (index).x < view_from.x + view_to.x
  355. and map.units (index).y > view_from.y and map.units (index).y < view_from.y + view_to.y then
  356. unit.draw (unit.enumeration'val (map.units (index).index),
  357. core.animation'val (map.units (index).state),
  358. offset.x + (map.units (index).x - core.camera.x) * core.base * core.zoom,
  359. offset.y + (map.units (index).y - core.camera.y) * core.base * core.zoom);
  360. --
  361. core.increment (drawn_units);
  362. end if;
  363. end loop;
  364. --
  365. for index in 1 .. map.chad_count loop
  366. if map.views (map.chads (index).x, map.chads (index).y) then
  367. chad.draw (map.chads (index),
  368. offset.x + (map.chads (index).x - core.camera.x) * core.base * core.zoom,
  369. offset.y + (map.chads (index).y - core.camera.y) * core.base * core.zoom);
  370. --
  371. core.increment (drawn_units);
  372. end if;
  373. end loop;
  374. --
  375. draw_units_timer := natural (1_000_000.0 * (core.time - time));
  376. end draw_units;
  377. ------------------------------------------------------------------------------------------
  378. procedure compute_world_darkened_grid (offset, view_from, view_to : in core.vector) is
  379. time : float := 0.0;
  380. begin
  381. time := core.time;
  382. --
  383. for vertical in view_from.y .. view_from.y + view_to.y loop
  384. exit when vertical > map.height - 1;
  385. --
  386. for horizontal in view_from.x .. view_from.x + view_to.x loop
  387. exit when horizontal > map.width - 1;
  388. --
  389. if (horizontal - core.camera.x) ** 2 + (vertical - core.camera.y) ** 2 > view_reach then
  390. core.draw (data => dark,
  391. x => offset.x + (horizontal - core.camera.x) * core.base * core.zoom,
  392. y => offset.y + (vertical - core.camera.y) * core.base * core.zoom);
  393. --
  394. core.increment (drawn_views);
  395. end if;
  396. end loop;
  397. end loop;
  398. --
  399. draw_views_timer := natural (1_000_000.0 * (core.time - time));
  400. end compute_world_darkened_grid;
  401. ------------------------------------------------------------------------------------------
  402. procedure compute_earth_to_water_transition is
  403. matrix : array (0 .. 1, 0 .. 1) of natural;
  404. begin
  405. for x in 1 .. map.width - 2 loop
  406. for y in 1 .. map.height - 2 loop
  407. matrix (0, 0) := boolean'pos (map.tiles (x - 1, y - 1) not in 18 .. 23);
  408. matrix (1, 0) := boolean'pos (map.tiles (x, y - 1) not in 18 .. 23);
  409. matrix (0, 1) := boolean'pos (map.tiles (x - 1, y ) not in 18 .. 23);
  410. matrix (1, 1) := boolean'pos (map.tiles (x, y ) not in 18 .. 23);
  411. --
  412. if map.tiles (x, y) not in 18 .. 23 and map.tiles (x, y + 1) in 18 .. 23 then map.tiles (x, y ) := 24; end if;
  413. if map.tiles (x, y) in 18 .. 23 and map.tiles (x, y + 1) not in 18 .. 23 then map.tiles (x, y + 1) := 25; end if;
  414. if map.tiles (x, y) not in 18 .. 23 and map.tiles (x + 1, y ) in 18 .. 23 then map.tiles (x, y ) := 26; end if;
  415. if map.tiles (x, y) in 18 .. 23 and map.tiles (x + 1, y ) not in 18 .. 23 then map.tiles (x + 1, y ) := 27; end if;
  416. --
  417. if matrix = ((1, 1), (1, 0)) then map.tiles (x - 1, y - 1) := 28;
  418. elsif matrix = ((1, 0), (1, 1)) then map.tiles (x, y - 1) := 29;
  419. elsif matrix = ((1, 1), (0, 1)) then map.tiles (x - 1, y ) := 30;
  420. elsif matrix = ((0, 1), (1, 1)) then map.tiles (x, y ) := 31;
  421. elsif matrix = ((0, 0), (0, 1)) then map.tiles (x, y ) := 32;
  422. elsif matrix = ((0, 1), (0, 0)) then map.tiles (x - 1, y ) := 33;
  423. elsif matrix = ((0, 0), (1, 0)) then map.tiles (x, y - 1) := 34;
  424. elsif matrix = ((1, 0), (0, 0)) then map.tiles (x - 1, y - 1) := 35;
  425. end if;
  426. end loop;
  427. end loop;
  428. end compute_earth_to_water_transition;
  429. ------------------------------------------------------------------------------------------
  430. procedure configure is
  431. begin
  432. core.echo (core.comment, "Configuring world components...");
  433. --
  434. for index in biome loop
  435. tiles (index) := core.import_sprite (core.folder & "/game/world/terrain/" & core.lowercase (index'image) & ".png", 4, 1);
  436. end loop;
  437. --
  438. dark := core.import_sprite (core.folder & "/game/world/dark.png", 1, 1);
  439. border_upper := core.import_sprite (core.folder & "/game/world/frame/border_upper.png", 1, 1);
  440. border_lower := core.import_sprite (core.folder & "/game/world/frame/border_lower.png", 1, 1);
  441. border_left := core.import_sprite (core.folder & "/game/world/frame/border_left.png", 1, 1);
  442. border_right := core.import_sprite (core.folder & "/game/world/frame/border_right.png", 1, 1);
  443. corner_upper_left := core.import_sprite (core.folder & "/game/world/frame/corner_upper_left.png", 1, 1);
  444. corner_upper_right := core.import_sprite (core.folder & "/game/world/frame/corner_upper_right.png", 1, 1);
  445. corner_lower_left := core.import_sprite (core.folder & "/game/world/frame/corner_lower_left.png", 1, 1);
  446. corner_lower_right := core.import_sprite (core.folder & "/game/world/frame/corner_lower_right.png", 1, 1);
  447. arrow_target := core.import_sprite (core.folder & "/game/world/arrow/target.png", 1, 1);
  448. arrow_upper := core.import_sprite (core.folder & "/game/world/arrow/upper.png", 1, 1);
  449. arrow_lower := core.import_sprite (core.folder & "/game/world/arrow/lower.png", 1, 1);
  450. arrow_left := core.import_sprite (core.folder & "/game/world/arrow/left.png", 1, 1);
  451. arrow_right := core.import_sprite (core.folder & "/game/world/arrow/right.png", 1, 1);
  452. arrow_upper_left := core.import_sprite (core.folder & "/game/world/arrow/upper_left.png", 1, 1);
  453. arrow_upper_right := core.import_sprite (core.folder & "/game/world/arrow/upper_right.png", 1, 1);
  454. arrow_lower_left := core.import_sprite (core.folder & "/game/world/arrow/lower_left.png", 1, 1);
  455. arrow_lower_right := core.import_sprite (core.folder & "/game/world/arrow/lower_right.png", 1, 1);
  456. --
  457. for index in landmark_index loop
  458. landmarks (index) := core.import_sprite (file_path => core.folder & "/game/world/landmark/" & core.lowercase (index'image) & ".png",
  459. frames => landmark_description (index).frames,
  460. states => 1);
  461. end loop;
  462. --
  463. for index in location_index loop
  464. locations (index) := core.import_sprite (file_path => core.folder & "/game/world/location/" & core.lowercase (index'image) & ".png",
  465. frames => location_description (index).frames,
  466. states => location_description (index).states);
  467. end loop;
  468. end configure;
  469. ------------------------------------------------------------------------------------------
  470. procedure make (index : in biome; width, height, chad_limit : in natural) is
  471. begin
  472. core.echo (core.comment, "-- Procedurally generating new map...");
  473. --
  474. core.echo (core.comment, "-- -- Map type : " & index'image);
  475. core.echo (core.comment, "-- -- Map width :" & width'image);
  476. core.echo (core.comment, "-- -- Map height :" & height'image);
  477. core.echo (core.comment, "-- -- Landmark count :" & landmark_limit'image);
  478. --
  479. map.kind := index;
  480. map.width := width;
  481. map.height := height;
  482. map.chad_limit := chad_limit;
  483. map.chad_count := 0;
  484. --
  485. map.tiles := new integer_matrix (0 .. map.width - 1, 0 .. map.height - 1);
  486. map.clips := new boolean_matrix (0 .. map.width - 1, 0 .. map.height - 1);
  487. map.views := new boolean_matrix (0 .. map.width - 1, 0 .. map.height - 1);
  488. map.landmarks := new entity_array (1 .. landmark_limit);
  489. map.locations := new entity_array (1 .. location_limit);
  490. map.constructions := new entity_array (1 .. construction_limit);
  491. map.equipments := new entity_array (1 .. equipment_limit);
  492. map.units := new entity_array (1 .. unit_limit);
  493. map.chads := new chad.informations (1 .. map.chad_limit);
  494. --
  495. for x in 0 .. width - 1 loop
  496. for y in 0 .. height - 1 loop
  497. map.tiles (x, y) := (if core.random (0, 17) > 3 then core.random (0, 5) else core.random (0, 17));
  498. map.clips (x, y) := false;
  499. map.views (x, y) := false;
  500. end loop;
  501. end loop;
  502. --
  503. for this in 1 .. lake_count loop
  504. generate_lake (x => core.random (23, map.width - 23),
  505. y => core.random (23, map.height - 23),
  506. size => core.random (7, 19));
  507. end loop;
  508. --
  509. compute_earth_to_water_transition;
  510. --
  511. for x in 0 .. width - 1 loop
  512. for y in 0 .. height - 1 loop
  513. if map.tiles (x, y) > 17 then
  514. map.clips (x, y) := true;
  515. end if;
  516. end loop;
  517. end loop;
  518. --
  519. for index in 1 .. landmark_limit loop
  520. map.landmarks (index).index := core.random (0, landmark_count - 1);
  521. map.landmarks (index).state := 0;
  522. <<repeat_landmark_generation>>
  523. map.landmarks (index).x := core.random (6, map.width - 6);
  524. map.landmarks (index).y := core.random (6, map.height - 6);
  525. --
  526. if map.clips (map.landmarks (index).x, map.landmarks (index).y) then
  527. goto repeat_landmark_generation;
  528. end if;
  529. --
  530. if landmark_description (landmark_index'val (map.landmarks (index).index)).clip then
  531. declare reach_x : constant natural := landmarks (landmark_index'val (map.landmarks (index).index)).width / core.base;
  532. reach_y : constant natural := landmarks (landmark_index'val (map.landmarks (index).index)).height / core.base;
  533. begin
  534. for x in 0 .. reach_x - 1 loop
  535. for y in 0 .. reach_y - 1 loop
  536. map.clips (map.landmarks (index).x + x, map.landmarks (index).y + y) := true;
  537. end loop;
  538. end loop;
  539. end;
  540. end if;
  541. end loop;
  542. --
  543. for index in 1 .. location_limit loop
  544. map.locations (index).index := core.random (0, location_count - 1);
  545. map.locations (index).state := 0;
  546. <<repeat_location_generation>>
  547. map.locations (index).x := core.random (6, map.width - 6);
  548. map.locations (index).y := core.random (6, map.height - 6);
  549. --
  550. if map.clips (map.locations (index).x, map.locations (index).y) then
  551. goto repeat_location_generation;
  552. end if;
  553. --
  554. if location_description (location_index'val (map.locations (index).index)).clip then
  555. declare reach_x : constant natural := locations (location_index'val (map.locations (index).index)).width / core.base;
  556. reach_y : constant natural := locations (location_index'val (map.locations (index).index)).height / core.base;
  557. begin
  558. for x in 0 .. reach_x - 1 loop
  559. for y in 0 .. reach_y - 1 loop
  560. map.clips (map.locations (index).x + x, map.locations (index).y + y) := true;
  561. end loop;
  562. end loop;
  563. end;
  564. end if;
  565. end loop;
  566. --
  567. for index in 1 .. construction_limit loop
  568. map.constructions (index).index := core.random (0, construction.count - 1);
  569. map.constructions (index).state := 0;
  570. <<repeat_construction_generation>>
  571. map.constructions (index).x := core.random (6, map.width - 6);
  572. map.constructions (index).y := core.random (6, map.height - 6);
  573. --
  574. if map.clips (map.constructions (index).x, map.constructions (index).y) then
  575. goto repeat_construction_generation;
  576. end if;
  577. --
  578. declare reach_x : constant natural := construction.sprite (construction.enumeration'val (map.constructions (index).index)).width / core.base;
  579. reach_y : constant natural := construction.sprite (construction.enumeration'val (map.constructions (index).index)).height / core.base;
  580. begin
  581. for x in 0 .. reach_x - 1 loop
  582. for y in 0 .. reach_y - 1 loop
  583. map.clips (map.constructions (index).x + x, map.constructions (index).y + y) := true;
  584. end loop;
  585. end loop;
  586. end;
  587. end loop;
  588. --
  589. for index in 1 .. equipment_limit loop
  590. map.equipments (index).index := core.random (0, equipment.count - 1);
  591. map.equipments (index).state := 0;
  592. <<repeat_equipment_generation>>
  593. map.equipments (index).x := core.random (0, map.width - 1);
  594. map.equipments (index).y := core.random (0, map.height - 1);
  595. --
  596. if map.clips (map.equipments (index).x, map.equipments (index).y) then
  597. goto repeat_equipment_generation;
  598. end if;
  599. end loop;
  600. --
  601. for index in 1 .. unit_limit loop
  602. map.units (index).index := core.random (0, unit.count - 1);
  603. map.units (index).state := 0;
  604. <<repeat_unit_generation>>
  605. map.units (index).x := core.random (0, map.width - 1);
  606. map.units (index).y := core.random (0, map.height - 1);
  607. --
  608. if map.clips (map.units (index).x, map.units (index).y) then
  609. goto repeat_unit_generation;
  610. end if;
  611. --
  612. map.clips (map.units (index).x, map.units (index).y) := true;
  613. end loop;
  614. --
  615. core.echo (core.success, "Finished procedurally generating new map.");
  616. end make;
  617. ------------------------------------------------------------------------------------------
  618. procedure save (file_name : in string) is
  619. procedure save_entity (here : in core.io.file_type; data : in entity_description) is
  620. begin
  621. core.io.write (here, data.index);
  622. core.io.write (here, data.state);
  623. core.io.write (here, data.x);
  624. core.io.write (here, data.y);
  625. end save_entity;
  626. --
  627. file : core.io.file_type;
  628. begin
  629. core.io.create (file, core.io.out_file, core.folder & "/map/" & file_name);
  630. --
  631. core.io.write (file, biome'pos (map.kind));
  632. core.io.write (file, map.width);
  633. core.io.write (file, map.height);
  634. core.io.write (file, map.chad_count);
  635. core.io.write (file, map.chad_limit);
  636. --
  637. for x in 0 .. map.width - 1 loop
  638. for y in 0 .. map.height - 1 loop
  639. core.io.write (file, map.tiles (x, y));
  640. core.io.write (file, boolean'pos (map.clips (x, y)));
  641. core.io.write (file, boolean'pos (map.views (x, y)));
  642. end loop;
  643. end loop;
  644. --
  645. for index in 1 .. landmark_limit loop save_entity (file, map.landmarks (index)); end loop;
  646. for index in 1 .. location_limit loop save_entity (file, map.locations (index)); end loop;
  647. for index in 1 .. construction_limit loop save_entity (file, map.constructions (index)); end loop;
  648. for index in 1 .. equipment_limit loop save_entity (file, map.equipments (index)); end loop;
  649. for index in 1 .. unit_limit loop save_entity (file, map.units (index)); end loop;
  650. --
  651. chad.save_value (file, map.chads (1));
  652. --
  653. core.io.close (file);
  654. --
  655. core.echo (core.success, "Saved current map as '" & file_name & "'.");
  656. --
  657. core.dash;
  658. end save;
  659. ------------------------------------------------------------------------------------------
  660. procedure load (file_name : in string) is
  661. procedure load_entity (here : in core.io.file_type; data : out entity_description) is
  662. begin
  663. core.io.read (here, data.index);
  664. core.io.read (here, data.state);
  665. core.io.read (here, data.x);
  666. core.io.read (here, data.y);
  667. end load_entity;
  668. --
  669. file : core.io.file_type;
  670. this : integer;
  671. begin
  672. core.io.open (file, core.io.in_file, core.folder & "/map/" & file_name);
  673. --
  674. core.io.read (file, this); map.kind := biome'val (this);
  675. core.io.read (file, map.width);
  676. core.io.read (file, map.height);
  677. core.io.read (file, map.chad_count);
  678. core.io.read (file, map.chad_limit);
  679. --
  680. for x in 0 .. map.width - 1 loop
  681. for y in 0 .. map.height - 1 loop
  682. core.io.read (file, map.tiles (x, y));
  683. core.io.read (file, this); map.clips (x, y) := boolean'val (this);
  684. core.io.read (file, this); map.views (x, y) := boolean'val (this);
  685. end loop;
  686. end loop;
  687. --
  688. for index in 1 .. landmark_limit loop load_entity (file, map.landmarks (index)); end loop;
  689. for index in 1 .. location_limit loop load_entity (file, map.locations (index)); end loop;
  690. for index in 1 .. construction_limit loop load_entity (file, map.constructions (index)); end loop;
  691. for index in 1 .. equipment_limit loop load_entity (file, map.equipments (index)); end loop;
  692. for index in 1 .. unit_limit loop load_entity (file, map.units (index)); end loop;
  693. --
  694. chad.load_value (file, map.chads (1));
  695. --
  696. core.io.close (file);
  697. --
  698. core.echo (core.success, "Loaded map from file '" & file_name & "'.");
  699. --
  700. core.dash;
  701. end load;
  702. ------------------------------------------------------------------------------------------
  703. procedure draw is
  704. offset : core.vector := ((core.window_width - core.base) / 2, (core.window_height - core.base) / 2);
  705. view_from : core.vector := (core.camera.x - core.window_width / core.base / core.zoom / 2, core.camera.y - core.window_height / core.base / core.zoom / 2);
  706. view_to : core.vector := (core.window_width / core.base / core.zoom, core.window_height / core.base / core.zoom);
  707. --
  708. time : float := 0.0;
  709. begin
  710. time := core.time;
  711. --
  712. drawn_tiles := 0;
  713. drawn_views := 0;
  714. drawn_landmarks := 0;
  715. drawn_locations := 0;
  716. drawn_constructions := 0;
  717. drawn_equipments := 0;
  718. drawn_units := 0;
  719. --
  720. core.clip (view_from.x, 0, map.width - 1);
  721. core.clip (view_from.y, 0, map.height - 1);
  722. core.clip (view_to.x, 0, map.width - 1);
  723. core.clip (view_to.y, 0, map.height - 1);
  724. --
  725. compute_world_visibility_grid (offset);
  726. compute_world_frame (offset);
  727. --
  728. draw_tiles (offset, view_from, view_to);
  729. draw_landmarks (offset, view_from, view_to);
  730. draw_locations (offset, view_from, view_to);
  731. draw_constructions (offset, view_from, view_to);
  732. draw_equipments (offset, view_from, view_to);
  733. draw_units (offset, view_from, view_to);
  734. --
  735. compute_world_darkened_grid (offset, view_from, view_to);
  736. --
  737. draw_world_timer := natural (1_000_000.0 * (core.time - time));
  738. end draw;
  739. ------------------------------------------------------------------------------------------
  740. procedure draw_performance_box is
  741. width : constant integer := 640;
  742. height : constant integer := 8 * 15 + 2 * core.icon;
  743. x : constant integer := core.center_x (width);
  744. y : constant integer := core.center_y (height);
  745. begin
  746. ui.draw_text_box (x, y, width, height);
  747. --
  748. ui.write ("draw_tiles_timer :" & draw_tiles_timer'image, x + 3 * core.icon, y + core.icon + 0 * 15, size => 15, code => true);
  749. ui.write ("draw_views_timer :" & draw_views_timer'image, x + 3 * core.icon, y + core.icon + 1 * 15, size => 15, code => true);
  750. ui.write ("draw_landmarks_timer :" & draw_landmarks_timer'image, x + 3 * core.icon, y + core.icon + 2 * 15, size => 15, code => true);
  751. ui.write ("draw_locations_timer :" & draw_locations_timer'image, x + 3 * core.icon, y + core.icon + 3 * 15, size => 15, code => true);
  752. ui.write ("draw_constructions_timer :" & draw_constructions_timer'image, x + 3 * core.icon, y + core.icon + 4 * 15, size => 15, code => true);
  753. ui.write ("draw_equipments_timer :" & draw_equipments_timer'image, x + 3 * core.icon, y + core.icon + 5 * 15, size => 15, code => true);
  754. ui.write ("draw_units_timer :" & draw_units_timer'image, x + 3 * core.icon, y + core.icon + 6 * 15, size => 15, code => true);
  755. ui.write ("draw_world_timer :" & draw_world_timer'image, x + 3 * core.icon, y + core.icon + 7 * 15, size => 15, code => true);
  756. --
  757. ui.write (drawn_tiles'image, x + core.icon, y + core.icon + 0 * 15, size => 15, code => true, tint => (255, 0, 0, 255));
  758. ui.write (drawn_views'image, x + core.icon, y + core.icon + 1 * 15, size => 15, code => true, tint => (255, 0, 0, 255));
  759. ui.write (drawn_landmarks'image, x + core.icon, y + core.icon + 2 * 15, size => 15, code => true, tint => (255, 0, 0, 255));
  760. ui.write (drawn_locations'image, x + core.icon, y + core.icon + 3 * 15, size => 15, code => true, tint => (255, 0, 0, 255));
  761. ui.write (drawn_constructions'image, x + core.icon, y + core.icon + 4 * 15, size => 15, code => true, tint => (255, 0, 0, 255));
  762. ui.write (drawn_equipments'image, x + core.icon, y + core.icon + 5 * 15, size => 15, code => true, tint => (255, 0, 0, 255));
  763. ui.write (drawn_units'image, x + core.icon, y + core.icon + 6 * 15, size => 15, code => true, tint => (255, 0, 0, 255));
  764. end draw_performance_box;
  765. ------------------------------------------------------------------------------------------
  766. procedure mapshot (file_path : in string) is
  767. begin
  768. if not map_is_revealed then
  769. core.echo (core.warning, "You need to reveal entire map in order to make a mapshot.");
  770. --
  771. return;
  772. end if;
  773. --
  774. core.create_image (map.width * core.base, map.height * core.base);
  775. --
  776. for vertical in 0 .. map.height - 1 loop
  777. for horizontal in 0 .. map.width - 1 loop
  778. core.render_image (data => tiles (map.kind),
  779. x => horizontal * core.base,
  780. y => vertical * core.base,
  781. u => core.base * map.tiles (horizontal, vertical),
  782. v => 0,
  783. width => core.base,
  784. height => core.base);
  785. end loop;
  786. end loop;
  787. --
  788. for index in 1 .. landmark_limit loop
  789. core.render_image (data => landmarks (landmark_index'val (map.landmarks (index).index)),
  790. x => map.landmarks (index).x * core.base,
  791. y => map.landmarks (index).y * core.base,
  792. u => 0,
  793. v => 0,
  794. width => landmarks (landmark_index'val (map.landmarks (index).index)).width,
  795. height => landmarks (landmark_index'val (map.landmarks (index).index)).height);
  796. end loop;
  797. --
  798. for index in 1 .. location_limit loop
  799. core.render_image (data => locations (location_index'val (map.locations (index).index)),
  800. x => map.locations (index).x * core.base,
  801. y => map.locations (index).y * core.base,
  802. u => 0,
  803. v => 0,
  804. width => locations (location_index'val (map.locations (index).index)).width,
  805. height => locations (location_index'val (map.locations (index).index)).height);
  806. end loop;
  807. --
  808. for index in 1 .. construction_limit loop
  809. core.render_image (data => construction.sprite (construction.enumeration'val (map.constructions (index).index)),
  810. x => map.constructions (index).x * core.base,
  811. y => map.constructions (index).y * core.base,
  812. u => 0,
  813. v => 0,
  814. width => construction.sprite (construction.enumeration'val (map.constructions (index).index)).width,
  815. height => construction.sprite (construction.enumeration'val (map.constructions (index).index)).height);
  816. end loop;
  817. --
  818. for index in 1 .. equipment_limit loop
  819. core.render_image (data => equipment.sprite (equipment.enumeration'val (map.equipments (index).index)),
  820. x => map.equipments (index).x * core.base,
  821. y => map.equipments (index).y * core.base,
  822. u => 0,
  823. v => 0,
  824. width => equipment.sprite (equipment.enumeration'val (map.equipments (index).index)).width,
  825. height => equipment.sprite (equipment.enumeration'val (map.equipments (index).index)).height);
  826. end loop;
  827. --
  828. core.export_image (file_path);
  829. --
  830. core.echo (core.success, "Exported current world mapshot.");
  831. --
  832. core.dash;
  833. end mapshot;
  834. ------------------------------------------------------------------------------------------
  835. function map_is_revealed return boolean is
  836. begin
  837. for x in 0 .. map.width - 1 loop
  838. for y in 0 .. map.height - 1 loop
  839. if map.views (x, y) = false then
  840. return false;
  841. end if;
  842. end loop;
  843. end loop;
  844. --
  845. return true;
  846. end map_is_revealed;
  847. ------------------------------------------------------------------------------------------
  848. procedure add_chad (data : in chad.information) is
  849. begin
  850. core.echo_when (map.chad_count = map.chad_limit, core.failure, "Can't add new chad, limit reached.");
  851. core.increment (map.chad_count);
  852. --
  853. map.chads (map.chad_count) := data;
  854. end add_chad;
  855. ------------------------------------------------------------------------------------------
  856. procedure resource_cheat_1 is begin core.increment (map.chads (1).resources (resource.gold).value, 20); end resource_cheat_1;
  857. procedure resource_cheat_2 is begin core.increment (map.chads (1).resources (resource.wood).value, 10); end resource_cheat_2;
  858. procedure resource_cheat_3 is begin core.increment (map.chads (1).resources (resource.stone).value, 10); end resource_cheat_3;
  859. procedure resource_cheat_4 is begin core.increment (map.chads (1).resources (resource.metal).value, 10); end resource_cheat_4;
  860. procedure resource_cheat_5 is begin core.increment (map.chads (1).resources (resource.leather).value, 10); end resource_cheat_5;
  861. procedure resource_cheat_6 is begin core.increment (map.chads (1).resources (resource.gem).value, 10); end resource_cheat_6;
  862. ------------------------------------------------------------------------------------------
  863. procedure reveal_map is
  864. begin
  865. for x in 0 .. map.width - 1 loop
  866. for y in 0 .. map.height - 1 loop
  867. map.views (x, y) := true;
  868. end loop;
  869. end loop;
  870. end reveal_map;
  871. ------------------------------------------------------------------------------------------
  872. procedure restore_points is
  873. begin
  874. map.chads (1).health.value := map.chads (1).health.limit;
  875. map.chads (1).mana.value := map.chads (1).mana.limit;
  876. map.chads (1).movement.value := map.chads (1).movement.limit;
  877. end restore_points;
  878. ------------------------------------------------------------------------------------------
  879. procedure player_up is
  880. begin
  881. if map.chads (1).movement.value = 0 then return; end if;
  882. core.decrement (map.chads (1).y);
  883. core.clip (map.chads (1).y, 0, map.height - 1);
  884. map.chads (1).movement := map.chads (1).movement - 1;
  885. if map.clips (map.chads (1).x, map.chads (1).y) then
  886. core.increment (map.chads (1).y);
  887. if map.chads (1).movement.value > 0 then
  888. map.chads (1).movement := map.chads (1).movement + 1;
  889. end if;
  890. end if;
  891. end player_up;
  892. ------------------------------------------------------------------------------------------
  893. procedure player_down is
  894. begin
  895. if map.chads (1).movement.value = 0 then return; end if;
  896. core.increment (map.chads (1).y);
  897. core.clip (map.chads (1).y, 0, map.height - 1);
  898. map.chads (1).movement := map.chads (1).movement - 1;
  899. if map.clips (map.chads (1).x, map.chads (1).y) then
  900. core.decrement (map.chads (1).y);
  901. if map.chads (1).movement.value > 0 then
  902. map.chads (1).movement := map.chads (1).movement + 1;
  903. end if;
  904. end if;
  905. end player_down;
  906. ------------------------------------------------------------------------------------------
  907. procedure player_left is
  908. begin
  909. if map.chads (1).movement.value = 0 then return; end if;
  910. core.decrement (map.chads (1).x);
  911. core.clip (map.chads (1).x, 0, map.width - 1);
  912. map.chads (1).movement := map.chads (1).movement - 1;
  913. if map.clips (map.chads (1).x, map.chads (1).y) then
  914. core.increment (map.chads (1).x);
  915. if map.chads (1).movement.value > 0 then
  916. map.chads (1).movement := map.chads (1).movement + 1;
  917. end if;
  918. end if;
  919. end player_left;
  920. ------------------------------------------------------------------------------------------
  921. procedure player_right is
  922. begin
  923. if map.chads (1).movement.value = 0 then return; end if;
  924. core.increment (map.chads (1).x);
  925. core.clip (map.chads (1).x, 0, map.width - 1);
  926. map.chads (1).movement := map.chads (1).movement - 1;
  927. if map.clips (map.chads (1).x, map.chads (1).y) then
  928. core.decrement (map.chads (1).x);
  929. if map.chads (1).movement.value > 0 then
  930. map.chads (1).movement := map.chads (1).movement + 1;
  931. end if;
  932. end if;
  933. end player_right;
  934. ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
  935. end world;