diff --git a/source/core.adb b/source/core.adb index be4ddb2..fced265 100644 --- a/source/core.adb +++ b/source/core.adb @@ -38,11 +38,7 @@ package body core is ------------------------------------------------------------------------------------------ procedure terminal (colour : in terminal_colour := white; - effect : in terminal_effect := normal) is - format : string := character'val (27) & "[" & character'val (terminal_effect'pos (effect) + 48) & ";3" & character'val (terminal_colour'pos (colour) + 48) & "m"; - begin - put (format); - end terminal; + effect : in terminal_effect := normal); ------------------------------------------------------------------------------------------ @@ -573,4 +569,13 @@ package body core is ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ + procedure terminal (colour : in terminal_colour := white; + effect : in terminal_effect := normal) is + format : string := character'val (27) & "[" & character'val (terminal_effect'pos (effect) + 48) & ";3" & character'val (terminal_colour'pos (colour) + 48) & "m"; + begin + put (format); + end terminal; + +------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ + end core; diff --git a/source/main.adb b/source/main.adb index d96f43f..b0498cd 100644 --- a/source/main.adb +++ b/source/main.adb @@ -427,7 +427,7 @@ begin -- for index in resource.enumeration loop ui.draw_icon (resource.icon (index), resource.description (index).text.all, (preview_width - 6 * core.icon * resource.count) / 2 + (6 * core.icon) * resource.enumeration'pos (index), core.base); - ui.draw_frame (resource.description (index).text.all, (preview_width - 6 * core.icon * resource.count) / 2 + (6 * core.icon) * resource.enumeration'pos (index) + core.icon, core.base, 6 * core.icon, core.icon); + ui.draw_frame (resource.description (index).text.all, (preview_width - 6 * core.icon * resource.count) / 2 + (6 * core.icon) * resource.enumeration'pos (index) + core.icon, core.base, 5 * core.icon, core.icon); -- ui.write (text => world.map.chads (1).resources (index).value'image & " /" & world.map.chads (1).resources (index).limit'image, x => (preview_width - 6 * core.icon * resource.count) / 2 + (6 * core.icon) * resource.enumeration'pos (index) + core.icon - 1, diff --git a/source/ui.adb b/source/ui.adb index e45f3da..8f8978f 100644 --- a/source/ui.adb +++ b/source/ui.adb @@ -84,76 +84,14 @@ package body ui is x : in integer := 0; y : in integer := 0; width : in integer := 0; - height : in integer := 0) is - begin - core.draw (sprite (active, index), x, y, 0, 0, width, height, factor => 1); - end draw; + height : in integer := 0); - ------------------------------------------------------------------------------------------ + procedure draw_horizontally (index : in element; x, y, width : in integer; action : core.pointer := core.idle_skip'access; tint : in core.colour := (others => 255)); + procedure draw_vertically (index : in element; x, y, height : in integer; action : core.pointer := core.idle_skip'access; tint : in core.colour := (others => 255)); - procedure draw_horizontally (index : in element; x, y, width : in integer; action : core.pointer := core.idle_skip'access; tint : in core.colour := (others => 255)) is - begin - core.draw_horizontally (sprite (active, index), x, y, width, 1, tint); - end draw_horizontally; + procedure draw_background (index : in element; x, y, width, height : in integer; action : core.pointer := core.idle_skip'access); - ------------------------------------------------------------------------------------------ - - procedure draw_vertically (index : in element; x, y, height : in integer; action : core.pointer := core.idle_skip'access; tint : in core.colour := (others => 255)) is - begin - core.draw_vertically (sprite (active, index), x, y, height, 1, tint); - end draw_vertically; - - ------------------------------------------------------------------------------------------ - - procedure draw_background (index : in element; x, y, width, height : in integer; action : core.pointer := core.idle_skip'access) is - base_width : integer := sprite (active, index).width; - base_height : integer := sprite (active, index).height; - crop_width : integer := width mod base_width; - crop_height : integer := height mod base_height; - begin - for move_y in 0 .. height / base_height - 1 loop - for move_x in 0 .. width / base_width - 1 loop - draw (index, x + move_x * base_width, y + move_y * base_height); - end loop; - -- - if width mod base_width > 0 then - draw (index, x + width - crop_width, y + move_y * base_height, crop_width, base_height); - end if; - end loop; - -- - for move_x in 0 .. width / base_width - 1 loop - if height mod base_height > 0 then - draw (index, x + move_x * base_width, y + height - crop_height, base_width, crop_height); - end if; - end loop; - -- - if width mod base_width > 0 and height mod base_height > 0 then - draw (index, x + width - crop_width, y + height - crop_height, crop_width, crop_height); - end if; - end draw_background; - - ------------------------------------------------------------------------------------------ - - procedure draw_popup_box is - width : constant integer := 320; - height : constant integer := core.icon; - middle : constant integer := sprite (active, text_middle).width; - offset : constant integer := 16; - begin - draw_background (text_middle, core.cursor.x + middle + offset, core.cursor.y + middle + offset, width - 2 * middle, height - 2 * middle); - -- - draw_horizontally (text_upper, core.cursor.x + middle + offset, core.cursor.y + offset, width - 2 * middle); - draw_horizontally (text_lower, core.cursor.x + middle + offset, core.cursor.y + height - middle + offset, width - 2 * middle); - draw_vertically (text_left, core.cursor.x + offset, core.cursor.y + middle + offset, height - 2 * middle); - draw_vertically (text_right, core.cursor.x + width - middle + offset, core.cursor.y + middle + offset, height - 2 * middle); - -- - draw (text_upper_left, core.cursor.x + offset, core.cursor.y + offset); - draw (text_upper_right, core.cursor.x + width - middle + offset, core.cursor.y + offset); - draw (text_lower_left, core.cursor.x + offset, core.cursor.y + height - middle + offset); - draw (text_lower_right, core.cursor.x + width - middle + offset, core.cursor.y + height - middle + offset); - -- - ui.write (core.read_text_box, core.cursor.x + 4 + offset, core.cursor.y + 6 + offset); - end draw_popup_box; + procedure draw_popup_box; ------------------------------------------------------------------------------------------ @@ -657,4 +595,81 @@ package body ui is ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ + procedure draw (index : in element := none; + x : in integer := 0; + y : in integer := 0; + width : in integer := 0; + height : in integer := 0) is + begin + core.draw (sprite (active, index), x, y, 0, 0, width, height, factor => 1); + end draw; + + ------------------------------------------------------------------------------------------ + + procedure draw_horizontally (index : in element; x, y, width : in integer; action : core.pointer := core.idle_skip'access; tint : in core.colour := (others => 255)) is + begin + core.draw_horizontally (sprite (active, index), x, y, width, 1, tint); + end draw_horizontally; + + ------------------------------------------------------------------------------------------ + + procedure draw_vertically (index : in element; x, y, height : in integer; action : core.pointer := core.idle_skip'access; tint : in core.colour := (others => 255)) is + begin + core.draw_vertically (sprite (active, index), x, y, height, 1, tint); + end draw_vertically; + + ------------------------------------------------------------------------------------------ + + procedure draw_background (index : in element; x, y, width, height : in integer; action : core.pointer := core.idle_skip'access) is + base_width : integer := sprite (active, index).width; + base_height : integer := sprite (active, index).height; + crop_width : integer := width mod base_width; + crop_height : integer := height mod base_height; + begin + for move_y in 0 .. height / base_height - 1 loop + for move_x in 0 .. width / base_width - 1 loop + draw (index, x + move_x * base_width, y + move_y * base_height); + end loop; + -- + if width mod base_width > 0 then + draw (index, x + width - crop_width, y + move_y * base_height, crop_width, base_height); + end if; + end loop; + -- + for move_x in 0 .. width / base_width - 1 loop + if height mod base_height > 0 then + draw (index, x + move_x * base_width, y + height - crop_height, base_width, crop_height); + end if; + end loop; + -- + if width mod base_width > 0 and height mod base_height > 0 then + draw (index, x + width - crop_width, y + height - crop_height, crop_width, crop_height); + end if; + end draw_background; + + ------------------------------------------------------------------------------------------ + + procedure draw_popup_box is + width : constant integer := 320; + height : constant integer := core.icon; + middle : constant integer := sprite (active, text_middle).width; + offset : constant integer := 16; + begin + draw_background (text_middle, core.cursor.x + middle + offset, core.cursor.y + middle + offset, width - 2 * middle, height - 2 * middle); + -- + draw_horizontally (text_upper, core.cursor.x + middle + offset, core.cursor.y + offset, width - 2 * middle); + draw_horizontally (text_lower, core.cursor.x + middle + offset, core.cursor.y + height - middle + offset, width - 2 * middle); + draw_vertically (text_left, core.cursor.x + offset, core.cursor.y + middle + offset, height - 2 * middle); + draw_vertically (text_right, core.cursor.x + width - middle + offset, core.cursor.y + middle + offset, height - 2 * middle); + -- + draw (text_upper_left, core.cursor.x + offset, core.cursor.y + offset); + draw (text_upper_right, core.cursor.x + width - middle + offset, core.cursor.y + offset); + draw (text_lower_left, core.cursor.x + offset, core.cursor.y + height - middle + offset); + draw (text_lower_right, core.cursor.x + width - middle + offset, core.cursor.y + height - middle + offset); + -- + ui.write (core.read_text_box, core.cursor.x + 4 + offset, core.cursor.y + 6 + offset); + end draw_popup_box; + +------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ + end ui; diff --git a/source/world.adb b/source/world.adb index 2245b32..2c94ac0 100644 --- a/source/world.adb +++ b/source/world.adb @@ -64,6 +64,608 @@ package body world is ------------------------------------------------------------------------------------------ + procedure generate_lake (x, y : in integer; size : in natural); + + procedure compute_world_visibility_grid (offset : in core.vector); + procedure compute_world_frame (offset : in core.vector); + + procedure draw_tiles (offset, view_from, view_to : in core.vector); + procedure draw_landmarks (offset, view_from, view_to : in core.vector); + procedure draw_locations (offset, view_from, view_to : in core.vector); + procedure draw_constructions (offset, view_from, view_to : in core.vector); + procedure draw_equipments (offset, view_from, view_to : in core.vector); + procedure draw_units (offset, view_from, view_to : in core.vector); + procedure draw_alternative (offset, view_from, view_to : in core.vector); + + procedure compute_earth_to_water_transition; + +------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ + + procedure configure is + begin + core.echo (core.comment, "Configuring world components..."); + -- + for index in biome loop + tiles (index) := core.import_sprite (core.folder & "/game/world/terrain/" & core.lowercase (index'image) & ".png", 4, 1); + end loop; + -- + dark := core.import_sprite (core.folder & "/game/world/dark.png", 1, 1); + border_upper := core.import_sprite (core.folder & "/game/world/frame/border_upper.png", 1, 1); + border_lower := core.import_sprite (core.folder & "/game/world/frame/border_lower.png", 1, 1); + border_left := core.import_sprite (core.folder & "/game/world/frame/border_left.png", 1, 1); + border_right := core.import_sprite (core.folder & "/game/world/frame/border_right.png", 1, 1); + corner_upper_left := core.import_sprite (core.folder & "/game/world/frame/corner_upper_left.png", 1, 1); + corner_upper_right := core.import_sprite (core.folder & "/game/world/frame/corner_upper_right.png", 1, 1); + corner_lower_left := core.import_sprite (core.folder & "/game/world/frame/corner_lower_left.png", 1, 1); + corner_lower_right := core.import_sprite (core.folder & "/game/world/frame/corner_lower_right.png", 1, 1); + arrow_target := core.import_sprite (core.folder & "/game/world/arrow/target.png", 1, 1); + arrow_upper := core.import_sprite (core.folder & "/game/world/arrow/upper.png", 1, 1); + arrow_lower := core.import_sprite (core.folder & "/game/world/arrow/lower.png", 1, 1); + arrow_left := core.import_sprite (core.folder & "/game/world/arrow/left.png", 1, 1); + arrow_right := core.import_sprite (core.folder & "/game/world/arrow/right.png", 1, 1); + arrow_upper_left := core.import_sprite (core.folder & "/game/world/arrow/upper_left.png", 1, 1); + arrow_upper_right := core.import_sprite (core.folder & "/game/world/arrow/upper_right.png", 1, 1); + arrow_lower_left := core.import_sprite (core.folder & "/game/world/arrow/lower_left.png", 1, 1); + arrow_lower_right := core.import_sprite (core.folder & "/game/world/arrow/lower_right.png", 1, 1); + -- + for index in landmark_index loop + landmarks (index) := core.import_sprite (file_path => core.folder & "/game/world/landmark/" & core.lowercase (index'image) & ".png", + frames => landmark_description (index).frames, + states => 1); + end loop; + -- + for index in location_index loop + locations (index) := core.import_sprite (file_path => core.folder & "/game/world/location/" & core.lowercase (index'image) & ".png", + frames => location_description (index).frames, + states => location_description (index).states); + end loop; + end configure; + + ------------------------------------------------------------------------------------------ + + procedure make (index : in biome; width, height, chad_limit : in natural) is + begin + core.echo (core.comment, "-- Procedurally generating new map..."); + -- + core.echo (core.comment, "-- -- Map type : " & index'image); + core.echo (core.comment, "-- -- Map width :" & width'image); + core.echo (core.comment, "-- -- Map height :" & height'image); + core.echo (core.comment, "-- -- Landmark count :" & landmark_limit'image); + -- + map.kind := index; + map.width := width; + map.height := height; + map.chad_limit := chad_limit; + map.chad_count := 0; + -- + map.tiles := new integer_matrix (0 .. map.width - 1, 0 .. map.height - 1); + map.clips := new boolean_matrix (0 .. map.width - 1, 0 .. map.height - 1); + map.views := new boolean_matrix (0 .. map.width - 1, 0 .. map.height - 1); + map.landmarks := new entity_array (1 .. landmark_limit); + map.locations := new entity_array (1 .. location_limit); + map.constructions := new entity_array (1 .. construction_limit); + map.equipments := new entity_array (1 .. equipment_limit); + map.units := new entity_array (1 .. unit_limit); + map.chads := new chad.informations (1 .. map.chad_limit); + -- + for x in 0 .. width - 1 loop + for y in 0 .. height - 1 loop + map.tiles (x, y) := (if core.random (0, 17) > 3 then core.random (0, 5) else core.random (0, 17)); + map.clips (x, y) := false; + map.views (x, y) := false; + end loop; + end loop; + -- + for this in 1 .. lake_count loop + generate_lake (x => core.random (23, map.width - 23), + y => core.random (23, map.height - 23), + size => core.random (7, 19)); + end loop; + -- + compute_earth_to_water_transition; + -- + for x in 0 .. width - 1 loop + for y in 0 .. height - 1 loop + if map.tiles (x, y) > 17 then + map.clips (x, y) := true; + end if; + end loop; + end loop; + -- + for index in 1 .. landmark_limit loop + map.landmarks (index).index := core.random (0, landmark_count - 1); + map.landmarks (index).state := 0; + <> + map.landmarks (index).x := core.random (6, map.width - 6); + map.landmarks (index).y := core.random (6, map.height - 6); + -- + if map.clips (map.landmarks (index).x, map.landmarks (index).y) then + goto repeat_landmark_generation; + end if; + -- + if landmark_description (landmark_index'val (map.landmarks (index).index)).clip then + declare reach_x : constant natural := landmarks (landmark_index'val (map.landmarks (index).index)).width / core.base; + reach_y : constant natural := landmarks (landmark_index'val (map.landmarks (index).index)).height / core.base; + begin + for x in 0 .. reach_x - 1 loop + for y in 0 .. reach_y - 1 loop + map.clips (map.landmarks (index).x + x, map.landmarks (index).y + y) := true; + end loop; + end loop; + end; + end if; + end loop; + -- + for index in 1 .. location_limit loop + map.locations (index).index := core.random (0, location_count - 1); + map.locations (index).state := 0; + <> + map.locations (index).x := core.random (6, map.width - 6); + map.locations (index).y := core.random (6, map.height - 6); + -- + if map.clips (map.locations (index).x, map.locations (index).y) then + goto repeat_location_generation; + end if; + -- + if location_description (location_index'val (map.locations (index).index)).clip then + declare reach_x : constant natural := locations (location_index'val (map.locations (index).index)).width / core.base; + reach_y : constant natural := locations (location_index'val (map.locations (index).index)).height / core.base; + begin + for x in 0 .. reach_x - 1 loop + for y in 0 .. reach_y - 1 loop + map.clips (map.locations (index).x + x, map.locations (index).y + y) := true; + end loop; + end loop; + end; + end if; + end loop; + -- + for index in 1 .. construction_limit loop + map.constructions (index).index := core.random (0, construction.count - 1); + map.constructions (index).state := 0; + <> + map.constructions (index).x := core.random (6, map.width - 6); + map.constructions (index).y := core.random (6, map.height - 6); + -- + if map.clips (map.constructions (index).x, map.constructions (index).y) then + goto repeat_construction_generation; + end if; + -- + declare reach_x : constant natural := construction.sprite (construction.enumeration'val (map.constructions (index).index)).width / core.base; + reach_y : constant natural := construction.sprite (construction.enumeration'val (map.constructions (index).index)).height / core.base; + begin + for x in 0 .. reach_x - 1 loop + for y in 0 .. reach_y - 1 loop + map.clips (map.constructions (index).x + x, map.constructions (index).y + y) := true; + end loop; + end loop; + end; + end loop; + -- + for index in 1 .. equipment_limit loop + map.equipments (index).index := core.random (0, equipment.count - 1); + map.equipments (index).state := 0; + <> + map.equipments (index).x := core.random (0, map.width - 1); + map.equipments (index).y := core.random (0, map.height - 1); + -- + if map.clips (map.equipments (index).x, map.equipments (index).y) then + goto repeat_equipment_generation; + end if; + end loop; + -- + for index in 1 .. unit_limit loop + map.units (index).index := core.random (0, unit.count - 1); + map.units (index).state := 0; + <> + map.units (index).x := core.random (0, map.width - 1); + map.units (index).y := core.random (0, map.height - 1); + -- + if map.clips (map.units (index).x, map.units (index).y) then + goto repeat_unit_generation; + end if; + -- + map.clips (map.units (index).x, map.units (index).y) := true; + end loop; + -- + core.echo (core.success, "Finished procedurally generating new map."); + end make; + + ------------------------------------------------------------------------------------------ + + procedure save (file_name : in string) is + procedure save_entity (here : in core.io.file_type; data : in entity_description) is + begin + core.io.write (here, data.index); + core.io.write (here, data.state); + core.io.write (here, data.x); + core.io.write (here, data.y); + end save_entity; + -- + file : core.io.file_type; + begin + core.io.create (file, core.io.out_file, core.folder & "/map/" & file_name); + -- + core.io.write (file, biome'pos (map.kind)); + core.io.write (file, map.width); + core.io.write (file, map.height); + core.io.write (file, map.chad_count); + core.io.write (file, map.chad_limit); + -- + for x in 0 .. map.width - 1 loop + for y in 0 .. map.height - 1 loop + core.io.write (file, map.tiles (x, y)); + core.io.write (file, boolean'pos (map.clips (x, y))); + core.io.write (file, boolean'pos (map.views (x, y))); + end loop; + end loop; + -- + for index in 1 .. landmark_limit loop save_entity (file, map.landmarks (index)); end loop; + for index in 1 .. location_limit loop save_entity (file, map.locations (index)); end loop; + for index in 1 .. construction_limit loop save_entity (file, map.constructions (index)); end loop; + for index in 1 .. equipment_limit loop save_entity (file, map.equipments (index)); end loop; + for index in 1 .. unit_limit loop save_entity (file, map.units (index)); end loop; + -- + core.io.write (file, chad.enumeration'pos (map.chads (1).index)); + core.io.write (file, core.animation'pos (map.chads (1).state)); + core.io.write (file, map.chads (1).x); + core.io.write (file, map.chads (1).y); + -- + core.save_point (file, map.chads (1).health); + core.save_point (file, map.chads (1).mana); + core.save_point (file, map.chads (1).movement); + -- + for index in attribute.enumeration loop core.save_point (file, map.chads (1).attributes (index)); end loop; + for index in skill.enumeration loop core.save_point (file, map.chads (1).skills (index)); end loop; + for index in resource.enumeration loop core.save_point (file, map.chads (1).resources (index)); end loop; + for index in material.enumeration loop core.save_point (file, map.chads (1).materials (index)); end loop; + -- + for index in equipment.slot loop + core.io.write (file, equipment.enumeration'pos (map.chads (1).equipments (index))); + end loop; + -- + core.io.write (file, map.chads (1).item_count); + -- + if map.chads (1).item_count > 0 then + for index in 0 .. map.chads (1).item_count - 1 loop + core.io.write (file, equipment.enumeration'pos (map.chads (1).items (index))); + end loop; + end if; + -- + core.io.close (file); + -- + core.echo (core.success, "Saved current map as '" & file_name & "'."); + -- + core.dash; + end save; + + ------------------------------------------------------------------------------------------ + + procedure load (file_name : in string) is + procedure load_entity (here : in core.io.file_type; data : out entity_description) is + begin + core.io.read (here, data.index); + core.io.read (here, data.state); + core.io.read (here, data.x); + core.io.read (here, data.y); + end load_entity; + -- + file : core.io.file_type; + this : integer; + begin + core.io.open (file, core.io.in_file, core.folder & "/map/" & file_name); + -- + core.io.read (file, this); map.kind := biome'val (this); + core.io.read (file, map.width); + core.io.read (file, map.height); + core.io.read (file, map.chad_count); + core.io.read (file, map.chad_limit); + -- + for x in 0 .. map.width - 1 loop + for y in 0 .. map.height - 1 loop + core.io.read (file, map.tiles (x, y)); + core.io.read (file, this); map.clips (x, y) := boolean'val (this); + core.io.read (file, this); map.views (x, y) := boolean'val (this); + end loop; + end loop; + -- + for index in 1 .. landmark_limit loop load_entity (file, map.landmarks (index)); end loop; + for index in 1 .. location_limit loop load_entity (file, map.locations (index)); end loop; + for index in 1 .. construction_limit loop load_entity (file, map.constructions (index)); end loop; + for index in 1 .. equipment_limit loop load_entity (file, map.equipments (index)); end loop; + for index in 1 .. unit_limit loop load_entity (file, map.units (index)); end loop; + -- + core.io.read (file, this); map.chads (1).index := chad.enumeration'val (this); + core.io.read (file, this); map.chads (1).state := core.animation'val (this); + core.io.read (file, map.chads (1).x); + core.io.read (file, map.chads (1).y); + -- + core.load_point (file, map.chads (1).health); + core.load_point (file, map.chads (1).mana); + core.load_point (file, map.chads (1).movement); + -- + for index in attribute.enumeration loop core.load_point (file, map.chads (1).attributes (index)); end loop; + for index in skill.enumeration loop core.load_point (file, map.chads (1).skills (index)); end loop; + for index in resource.enumeration loop core.load_point (file, map.chads (1).resources (index)); end loop; + for index in material.enumeration loop core.load_point (file, map.chads (1).materials (index)); end loop; + -- + for index in equipment.slot loop + core.io.read (file, this); map.chads (1).equipments (index) := equipment.enumeration'val (this); + end loop; + -- + core.io.read (file, map.chads (1).item_count); + -- + if map.chads (1).item_count > 0 then + for index in 0 .. map.chads (1).item_count - 1 loop + core.io.read (file, this); map.chads (1).items (index) := equipment.enumeration'val (this); + end loop; + end if; + -- + core.io.close (file); + -- + core.echo (core.success, "Loaded map from file '" & file_name & "'."); + -- + core.dash; + end load; + + ------------------------------------------------------------------------------------------ + + procedure draw is + offset : core.vector := ((core.window_width - core.base) / 2, (core.window_height - core.base) / 2); + 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); + view_to : core.vector := (core.window_width / core.base / core.zoom, core.window_height / core.base / core.zoom); + -- + time : float := 0.0; + begin + time := core.time; + -- + drawn_tiles := 0; + drawn_views := 0; + drawn_landmarks := 0; + drawn_locations := 0; + drawn_constructions := 0; + drawn_equipments := 0; + drawn_units := 0; + -- + core.clip (view_from.x, 0, map.width - 1); + core.clip (view_from.y, 0, map.height - 1); + core.clip (view_to.x, 0, map.width - 1); + core.clip (view_to.y, 0, map.height - 1); + -- + compute_world_visibility_grid (offset); + compute_world_frame (offset); + -- + draw_tiles (offset, view_from, view_to); + draw_landmarks (offset, view_from, view_to); + draw_locations (offset, view_from, view_to); + draw_constructions (offset, view_from, view_to); + draw_equipments (offset, view_from, view_to); + draw_units (offset, view_from, view_to); + -- + draw_alternative (offset, view_from, view_to); + -- + draw_world_timer := natural (1_000_000.0 * (core.time - time)); + end draw; + + ------------------------------------------------------------------------------------------ + + procedure draw_performance_box is + width : constant integer := 640; + height : constant integer := 8 * 15 + 2 * core.icon; + x : constant integer := core.center_x (width); + y : constant integer := core.center_y (height); + begin + ui.draw_text_box (x, y, width, height); + -- + ui.write ("draw_tiles_timer :" & draw_tiles_timer'image, x + 3 * core.icon, y + core.icon + 0 * 15, size => 15, code => true); + ui.write ("draw_views_timer :" & draw_views_timer'image, x + 3 * core.icon, y + core.icon + 1 * 15, size => 15, code => true); + ui.write ("draw_landmarks_timer :" & draw_landmarks_timer'image, x + 3 * core.icon, y + core.icon + 2 * 15, size => 15, code => true); + ui.write ("draw_locations_timer :" & draw_locations_timer'image, x + 3 * core.icon, y + core.icon + 3 * 15, size => 15, code => true); + ui.write ("draw_constructions_timer :" & draw_constructions_timer'image, x + 3 * core.icon, y + core.icon + 4 * 15, size => 15, code => true); + ui.write ("draw_equipments_timer :" & draw_equipments_timer'image, x + 3 * core.icon, y + core.icon + 5 * 15, size => 15, code => true); + ui.write ("draw_units_timer :" & draw_units_timer'image, x + 3 * core.icon, y + core.icon + 6 * 15, size => 15, code => true); + ui.write ("draw_world_timer :" & draw_world_timer'image, x + 3 * core.icon, y + core.icon + 7 * 15, size => 15, code => true); + -- + ui.write (drawn_tiles'image, x + core.icon, y + core.icon + 0 * 15, size => 15, code => true, tint => (255, 0, 0, 255)); + ui.write (drawn_views'image, x + core.icon, y + core.icon + 1 * 15, size => 15, code => true, tint => (255, 0, 0, 255)); + ui.write (drawn_landmarks'image, x + core.icon, y + core.icon + 2 * 15, size => 15, code => true, tint => (255, 0, 0, 255)); + ui.write (drawn_locations'image, x + core.icon, y + core.icon + 3 * 15, size => 15, code => true, tint => (255, 0, 0, 255)); + ui.write (drawn_constructions'image, x + core.icon, y + core.icon + 4 * 15, size => 15, code => true, tint => (255, 0, 0, 255)); + ui.write (drawn_equipments'image, x + core.icon, y + core.icon + 5 * 15, size => 15, code => true, tint => (255, 0, 0, 255)); + ui.write (drawn_units'image, x + core.icon, y + core.icon + 6 * 15, size => 15, code => true, tint => (255, 0, 0, 255)); + end draw_performance_box; + + ------------------------------------------------------------------------------------------ + + procedure mapshot (file_path : in string) is + begin + if not map_is_revealed then + core.echo (core.warning, "You need to reveal entire map in order to make a mapshot."); + -- + return; + end if; + -- + core.create_image (map.width * core.base, map.height * core.base); + -- + for vertical in 0 .. map.height - 1 loop + for horizontal in 0 .. map.width - 1 loop + core.render_image (data => tiles (map.kind), + x => horizontal * core.base, + y => vertical * core.base, + u => core.base * map.tiles (horizontal, vertical), + v => 0, + width => core.base, + height => core.base); + end loop; + end loop; + -- + for index in 1 .. landmark_limit loop + core.render_image (data => landmarks (landmark_index'val (map.landmarks (index).index)), + x => map.landmarks (index).x * core.base, + y => map.landmarks (index).y * core.base, + u => 0, + v => 0, + width => landmarks (landmark_index'val (map.landmarks (index).index)).width, + height => landmarks (landmark_index'val (map.landmarks (index).index)).height); + end loop; + -- + for index in 1 .. location_limit loop + core.render_image (data => locations (location_index'val (map.locations (index).index)), + x => map.locations (index).x * core.base, + y => map.locations (index).y * core.base, + u => 0, + v => 0, + width => locations (location_index'val (map.locations (index).index)).width, + height => locations (location_index'val (map.locations (index).index)).height); + end loop; + -- + for index in 1 .. construction_limit loop + core.render_image (data => construction.sprite (construction.enumeration'val (map.constructions (index).index)), + x => map.constructions (index).x * core.base, + y => map.constructions (index).y * core.base, + u => 0, + v => 0, + width => construction.sprite (construction.enumeration'val (map.constructions (index).index)).width, + height => construction.sprite (construction.enumeration'val (map.constructions (index).index)).height); + end loop; + -- + for index in 1 .. equipment_limit loop + core.render_image (data => equipment.sprite (equipment.enumeration'val (map.equipments (index).index)), + x => map.equipments (index).x * core.base, + y => map.equipments (index).y * core.base, + u => 0, + v => 0, + width => equipment.sprite (equipment.enumeration'val (map.equipments (index).index)).width, + height => equipment.sprite (equipment.enumeration'val (map.equipments (index).index)).height); + end loop; + -- + core.export_image (file_path); + -- + core.echo (core.success, "Exported current world mapshot."); + -- + core.dash; + end mapshot; + + ------------------------------------------------------------------------------------------ + + function map_is_revealed return boolean is + begin + for x in 0 .. map.width - 1 loop + for y in 0 .. map.height - 1 loop + if map.views (x, y) = false then + return false; + end if; + end loop; + end loop; + -- + return true; + end map_is_revealed; + + ------------------------------------------------------------------------------------------ + + procedure add_chad (data : in chad.information) is + begin + core.echo_when (map.chad_count = map.chad_limit, core.failure, "Can't add new chad, limit reached."); + core.increment (map.chad_count); + -- + map.chads (map.chad_count) := data; + end add_chad; + + ------------------------------------------------------------------------------------------ + + procedure resource_cheat_1 is begin core.increment (map.chads (1).resources (resource.gold).value, 20); end resource_cheat_1; + procedure resource_cheat_2 is begin core.increment (map.chads (1).resources (resource.wood).value, 10); end resource_cheat_2; + procedure resource_cheat_3 is begin core.increment (map.chads (1).resources (resource.stone).value, 10); end resource_cheat_3; + procedure resource_cheat_4 is begin core.increment (map.chads (1).resources (resource.metal).value, 10); end resource_cheat_4; + procedure resource_cheat_5 is begin core.increment (map.chads (1).resources (resource.leather).value, 10); end resource_cheat_5; + procedure resource_cheat_6 is begin core.increment (map.chads (1).resources (resource.gem).value, 10); end resource_cheat_6; + + ------------------------------------------------------------------------------------------ + + procedure reveal_map is + begin + for x in 0 .. map.width - 1 loop + for y in 0 .. map.height - 1 loop + map.views (x, y) := true; + end loop; + end loop; + end reveal_map; + + ------------------------------------------------------------------------------------------ + + procedure restore_points is + begin + map.chads (1).health.value := map.chads (1).health.limit; + map.chads (1).mana.value := map.chads (1).mana.limit; + map.chads (1).movement.value := map.chads (1).movement.limit; + end restore_points; + + ------------------------------------------------------------------------------------------ + + procedure player_up is + begin + if map.chads (1).movement.value = 0 then return; end if; + core.decrement (map.chads (1).y); + core.clip (map.chads (1).y, 0, map.height - 1); + map.chads (1).movement := map.chads (1).movement - 1; + if map.clips (map.chads (1).x, map.chads (1).y) then + core.increment (map.chads (1).y); + if map.chads (1).movement.value > 0 then + map.chads (1).movement := map.chads (1).movement + 1; + end if; + end if; + end player_up; + + ------------------------------------------------------------------------------------------ + + procedure player_down is + begin + if map.chads (1).movement.value = 0 then return; end if; + core.increment (map.chads (1).y); + core.clip (map.chads (1).y, 0, map.height - 1); + map.chads (1).movement := map.chads (1).movement - 1; + if map.clips (map.chads (1).x, map.chads (1).y) then + core.decrement (map.chads (1).y); + if map.chads (1).movement.value > 0 then + map.chads (1).movement := map.chads (1).movement + 1; + end if; + end if; + end player_down; + + ------------------------------------------------------------------------------------------ + + procedure player_left is + begin + if map.chads (1).movement.value = 0 then return; end if; + core.decrement (map.chads (1).x); + core.clip (map.chads (1).x, 0, map.width - 1); + map.chads (1).movement := map.chads (1).movement - 1; + if map.clips (map.chads (1).x, map.chads (1).y) then + core.increment (map.chads (1).x); + if map.chads (1).movement.value > 0 then + map.chads (1).movement := map.chads (1).movement + 1; + end if; + end if; + end player_left; + + ------------------------------------------------------------------------------------------ + + procedure player_right is + begin + if map.chads (1).movement.value = 0 then return; end if; + core.increment (map.chads (1).x); + core.clip (map.chads (1).x, 0, map.width - 1); + map.chads (1).movement := map.chads (1).movement - 1; + if map.clips (map.chads (1).x, map.chads (1).y) then + core.decrement (map.chads (1).x); + if map.chads (1).movement.value > 0 then + map.chads (1).movement := map.chads (1).movement + 1; + end if; + end if; + end player_right; + +------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ + procedure generate_lake (x, y : in integer; size : in natural) is starts, length : integer; begin @@ -463,7 +1065,7 @@ package body world is ------------------------------------------------------------------------------------------ - procedure compute_world_darkened_grid (offset, view_from, view_to : in core.vector) is + procedure draw_alternative (offset, view_from, view_to : in core.vector) is time : float := 0.0; begin time := core.time; @@ -485,7 +1087,7 @@ package body world is end loop; -- draw_views_timer := natural (1_000_000.0 * (core.time - time)); - end compute_world_darkened_grid; + end draw_alternative; ------------------------------------------------------------------------------------------ @@ -517,591 +1119,6 @@ package body world is end loop; end compute_earth_to_water_transition; - ------------------------------------------------------------------------------------------ - - procedure configure is - begin - core.echo (core.comment, "Configuring world components..."); - -- - for index in biome loop - tiles (index) := core.import_sprite (core.folder & "/game/world/terrain/" & core.lowercase (index'image) & ".png", 4, 1); - end loop; - -- - dark := core.import_sprite (core.folder & "/game/world/dark.png", 1, 1); - border_upper := core.import_sprite (core.folder & "/game/world/frame/border_upper.png", 1, 1); - border_lower := core.import_sprite (core.folder & "/game/world/frame/border_lower.png", 1, 1); - border_left := core.import_sprite (core.folder & "/game/world/frame/border_left.png", 1, 1); - border_right := core.import_sprite (core.folder & "/game/world/frame/border_right.png", 1, 1); - corner_upper_left := core.import_sprite (core.folder & "/game/world/frame/corner_upper_left.png", 1, 1); - corner_upper_right := core.import_sprite (core.folder & "/game/world/frame/corner_upper_right.png", 1, 1); - corner_lower_left := core.import_sprite (core.folder & "/game/world/frame/corner_lower_left.png", 1, 1); - corner_lower_right := core.import_sprite (core.folder & "/game/world/frame/corner_lower_right.png", 1, 1); - arrow_target := core.import_sprite (core.folder & "/game/world/arrow/target.png", 1, 1); - arrow_upper := core.import_sprite (core.folder & "/game/world/arrow/upper.png", 1, 1); - arrow_lower := core.import_sprite (core.folder & "/game/world/arrow/lower.png", 1, 1); - arrow_left := core.import_sprite (core.folder & "/game/world/arrow/left.png", 1, 1); - arrow_right := core.import_sprite (core.folder & "/game/world/arrow/right.png", 1, 1); - arrow_upper_left := core.import_sprite (core.folder & "/game/world/arrow/upper_left.png", 1, 1); - arrow_upper_right := core.import_sprite (core.folder & "/game/world/arrow/upper_right.png", 1, 1); - arrow_lower_left := core.import_sprite (core.folder & "/game/world/arrow/lower_left.png", 1, 1); - arrow_lower_right := core.import_sprite (core.folder & "/game/world/arrow/lower_right.png", 1, 1); - -- - for index in landmark_index loop - landmarks (index) := core.import_sprite (file_path => core.folder & "/game/world/landmark/" & core.lowercase (index'image) & ".png", - frames => landmark_description (index).frames, - states => 1); - end loop; - -- - for index in location_index loop - locations (index) := core.import_sprite (file_path => core.folder & "/game/world/location/" & core.lowercase (index'image) & ".png", - frames => location_description (index).frames, - states => location_description (index).states); - end loop; - end configure; - - ------------------------------------------------------------------------------------------ - - procedure make (index : in biome; width, height, chad_limit : in natural) is - begin - core.echo (core.comment, "-- Procedurally generating new map..."); - -- - core.echo (core.comment, "-- -- Map type : " & index'image); - core.echo (core.comment, "-- -- Map width :" & width'image); - core.echo (core.comment, "-- -- Map height :" & height'image); - core.echo (core.comment, "-- -- Landmark count :" & landmark_limit'image); - -- - map.kind := index; - map.width := width; - map.height := height; - map.chad_limit := chad_limit; - map.chad_count := 0; - -- - map.tiles := new integer_matrix (0 .. map.width - 1, 0 .. map.height - 1); - map.clips := new boolean_matrix (0 .. map.width - 1, 0 .. map.height - 1); - map.views := new boolean_matrix (0 .. map.width - 1, 0 .. map.height - 1); - map.landmarks := new entity_array (1 .. landmark_limit); - map.locations := new entity_array (1 .. location_limit); - map.constructions := new entity_array (1 .. construction_limit); - map.equipments := new entity_array (1 .. equipment_limit); - map.units := new entity_array (1 .. unit_limit); - map.chads := new chad.informations (1 .. map.chad_limit); - -- - for x in 0 .. width - 1 loop - for y in 0 .. height - 1 loop - map.tiles (x, y) := (if core.random (0, 17) > 3 then core.random (0, 5) else core.random (0, 17)); - map.clips (x, y) := false; - map.views (x, y) := false; - end loop; - end loop; - -- - for this in 1 .. lake_count loop - generate_lake (x => core.random (23, map.width - 23), - y => core.random (23, map.height - 23), - size => core.random (7, 19)); - end loop; - -- - compute_earth_to_water_transition; - -- - for x in 0 .. width - 1 loop - for y in 0 .. height - 1 loop - if map.tiles (x, y) > 17 then - map.clips (x, y) := true; - end if; - end loop; - end loop; - -- - for index in 1 .. landmark_limit loop - map.landmarks (index).index := core.random (0, landmark_count - 1); - map.landmarks (index).state := 0; - <> - map.landmarks (index).x := core.random (6, map.width - 6); - map.landmarks (index).y := core.random (6, map.height - 6); - -- - if map.clips (map.landmarks (index).x, map.landmarks (index).y) then - goto repeat_landmark_generation; - end if; - -- - if landmark_description (landmark_index'val (map.landmarks (index).index)).clip then - declare reach_x : constant natural := landmarks (landmark_index'val (map.landmarks (index).index)).width / core.base; - reach_y : constant natural := landmarks (landmark_index'val (map.landmarks (index).index)).height / core.base; - begin - for x in 0 .. reach_x - 1 loop - for y in 0 .. reach_y - 1 loop - map.clips (map.landmarks (index).x + x, map.landmarks (index).y + y) := true; - end loop; - end loop; - end; - end if; - end loop; - -- - for index in 1 .. location_limit loop - map.locations (index).index := core.random (0, location_count - 1); - map.locations (index).state := 0; - <> - map.locations (index).x := core.random (6, map.width - 6); - map.locations (index).y := core.random (6, map.height - 6); - -- - if map.clips (map.locations (index).x, map.locations (index).y) then - goto repeat_location_generation; - end if; - -- - if location_description (location_index'val (map.locations (index).index)).clip then - declare reach_x : constant natural := locations (location_index'val (map.locations (index).index)).width / core.base; - reach_y : constant natural := locations (location_index'val (map.locations (index).index)).height / core.base; - begin - for x in 0 .. reach_x - 1 loop - for y in 0 .. reach_y - 1 loop - map.clips (map.locations (index).x + x, map.locations (index).y + y) := true; - end loop; - end loop; - end; - end if; - end loop; - -- - for index in 1 .. construction_limit loop - map.constructions (index).index := core.random (0, construction.count - 1); - map.constructions (index).state := 0; - <> - map.constructions (index).x := core.random (6, map.width - 6); - map.constructions (index).y := core.random (6, map.height - 6); - -- - if map.clips (map.constructions (index).x, map.constructions (index).y) then - goto repeat_construction_generation; - end if; - -- - declare reach_x : constant natural := construction.sprite (construction.enumeration'val (map.constructions (index).index)).width / core.base; - reach_y : constant natural := construction.sprite (construction.enumeration'val (map.constructions (index).index)).height / core.base; - begin - for x in 0 .. reach_x - 1 loop - for y in 0 .. reach_y - 1 loop - map.clips (map.constructions (index).x + x, map.constructions (index).y + y) := true; - end loop; - end loop; - end; - end loop; - -- - for index in 1 .. equipment_limit loop - map.equipments (index).index := core.random (0, equipment.count - 1); - map.equipments (index).state := 0; - <> - map.equipments (index).x := core.random (0, map.width - 1); - map.equipments (index).y := core.random (0, map.height - 1); - -- - if map.clips (map.equipments (index).x, map.equipments (index).y) then - goto repeat_equipment_generation; - end if; - end loop; - -- - for index in 1 .. unit_limit loop - map.units (index).index := core.random (0, unit.count - 1); - map.units (index).state := 0; - <> - map.units (index).x := core.random (0, map.width - 1); - map.units (index).y := core.random (0, map.height - 1); - -- - if map.clips (map.units (index).x, map.units (index).y) then - goto repeat_unit_generation; - end if; - -- - map.clips (map.units (index).x, map.units (index).y) := true; - end loop; - -- - core.echo (core.success, "Finished procedurally generating new map."); - end make; - - ------------------------------------------------------------------------------------------ - - procedure save (file_name : in string) is - procedure save_entity (here : in core.io.file_type; data : in entity_description) is - begin - core.io.write (here, data.index); - core.io.write (here, data.state); - core.io.write (here, data.x); - core.io.write (here, data.y); - end save_entity; - -- - file : core.io.file_type; - begin - core.io.create (file, core.io.out_file, core.folder & "/map/" & file_name); - -- - core.io.write (file, biome'pos (map.kind)); - core.io.write (file, map.width); - core.io.write (file, map.height); - core.io.write (file, map.chad_count); - core.io.write (file, map.chad_limit); - -- - for x in 0 .. map.width - 1 loop - for y in 0 .. map.height - 1 loop - core.io.write (file, map.tiles (x, y)); - core.io.write (file, boolean'pos (map.clips (x, y))); - core.io.write (file, boolean'pos (map.views (x, y))); - end loop; - end loop; - -- - for index in 1 .. landmark_limit loop save_entity (file, map.landmarks (index)); end loop; - for index in 1 .. location_limit loop save_entity (file, map.locations (index)); end loop; - for index in 1 .. construction_limit loop save_entity (file, map.constructions (index)); end loop; - for index in 1 .. equipment_limit loop save_entity (file, map.equipments (index)); end loop; - for index in 1 .. unit_limit loop save_entity (file, map.units (index)); end loop; - -- - core.io.write (file, chad.enumeration'pos (map.chads (1).index)); - core.io.write (file, core.animation'pos (map.chads (1).state)); - core.io.write (file, map.chads (1).x); - core.io.write (file, map.chads (1).y); - -- - core.save_point (file, map.chads (1).health); - core.save_point (file, map.chads (1).mana); - core.save_point (file, map.chads (1).movement); - -- - for index in attribute.enumeration loop core.save_point (file, map.chads (1).attributes (index)); end loop; - for index in skill.enumeration loop core.save_point (file, map.chads (1).skills (index)); end loop; - for index in resource.enumeration loop core.save_point (file, map.chads (1).resources (index)); end loop; - for index in material.enumeration loop core.save_point (file, map.chads (1).materials (index)); end loop; - -- - for index in equipment.slot loop - core.io.write (file, equipment.enumeration'pos (map.chads (1).equipments (index))); - end loop; - -- - core.io.write (file, map.chads (1).item_count); - -- - if map.chads (1).item_count > 0 then - for index in 0 .. map.chads (1).item_count - 1 loop - core.io.write (file, equipment.enumeration'pos (map.chads (1).items (index))); - end loop; - end if; - -- - core.io.close (file); - -- - core.echo (core.success, "Saved current map as '" & file_name & "'."); - -- - core.dash; - end save; - - ------------------------------------------------------------------------------------------ - - procedure load (file_name : in string) is - procedure load_entity (here : in core.io.file_type; data : out entity_description) is - begin - core.io.read (here, data.index); - core.io.read (here, data.state); - core.io.read (here, data.x); - core.io.read (here, data.y); - end load_entity; - -- - file : core.io.file_type; - this : integer; - begin - core.io.open (file, core.io.in_file, core.folder & "/map/" & file_name); - -- - core.io.read (file, this); map.kind := biome'val (this); - core.io.read (file, map.width); - core.io.read (file, map.height); - core.io.read (file, map.chad_count); - core.io.read (file, map.chad_limit); - -- - for x in 0 .. map.width - 1 loop - for y in 0 .. map.height - 1 loop - core.io.read (file, map.tiles (x, y)); - core.io.read (file, this); map.clips (x, y) := boolean'val (this); - core.io.read (file, this); map.views (x, y) := boolean'val (this); - end loop; - end loop; - -- - for index in 1 .. landmark_limit loop load_entity (file, map.landmarks (index)); end loop; - for index in 1 .. location_limit loop load_entity (file, map.locations (index)); end loop; - for index in 1 .. construction_limit loop load_entity (file, map.constructions (index)); end loop; - for index in 1 .. equipment_limit loop load_entity (file, map.equipments (index)); end loop; - for index in 1 .. unit_limit loop load_entity (file, map.units (index)); end loop; - -- - core.io.read (file, this); map.chads (1).index := chad.enumeration'val (this); - core.io.read (file, this); map.chads (1).state := core.animation'val (this); - core.io.read (file, map.chads (1).x); - core.io.read (file, map.chads (1).y); - -- - core.load_point (file, map.chads (1).health); - core.load_point (file, map.chads (1).mana); - core.load_point (file, map.chads (1).movement); - -- - for index in attribute.enumeration loop core.load_point (file, map.chads (1).attributes (index)); end loop; - for index in skill.enumeration loop core.load_point (file, map.chads (1).skills (index)); end loop; - for index in resource.enumeration loop core.load_point (file, map.chads (1).resources (index)); end loop; - for index in material.enumeration loop core.load_point (file, map.chads (1).materials (index)); end loop; - -- - for index in equipment.slot loop - core.io.read (file, this); map.chads (1).equipments (index) := equipment.enumeration'val (this); - end loop; - -- - core.io.read (file, map.chads (1).item_count); - -- - if map.chads (1).item_count > 0 then - for index in 0 .. map.chads (1).item_count - 1 loop - core.io.read (file, this); map.chads (1).items (index) := equipment.enumeration'val (this); - end loop; - end if; - -- - core.io.close (file); - -- - core.echo (core.success, "Loaded map from file '" & file_name & "'."); - -- - core.dash; - end load; - - ------------------------------------------------------------------------------------------ - - procedure draw is - offset : core.vector := ((core.window_width - core.base) / 2, (core.window_height - core.base) / 2); - 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); - view_to : core.vector := (core.window_width / core.base / core.zoom, core.window_height / core.base / core.zoom); - -- - time : float := 0.0; - begin - time := core.time; - -- - drawn_tiles := 0; - drawn_views := 0; - drawn_landmarks := 0; - drawn_locations := 0; - drawn_constructions := 0; - drawn_equipments := 0; - drawn_units := 0; - -- - core.clip (view_from.x, 0, map.width - 1); - core.clip (view_from.y, 0, map.height - 1); - core.clip (view_to.x, 0, map.width - 1); - core.clip (view_to.y, 0, map.height - 1); - -- - compute_world_visibility_grid (offset); - compute_world_frame (offset); - -- - draw_tiles (offset, view_from, view_to); - draw_landmarks (offset, view_from, view_to); - draw_locations (offset, view_from, view_to); - draw_constructions (offset, view_from, view_to); - draw_equipments (offset, view_from, view_to); - draw_units (offset, view_from, view_to); - -- - compute_world_darkened_grid (offset, view_from, view_to); - -- - draw_world_timer := natural (1_000_000.0 * (core.time - time)); - end draw; - - ------------------------------------------------------------------------------------------ - - procedure draw_performance_box is - width : constant integer := 640; - height : constant integer := 8 * 15 + 2 * core.icon; - x : constant integer := core.center_x (width); - y : constant integer := core.center_y (height); - begin - ui.draw_text_box (x, y, width, height); - -- - ui.write ("draw_tiles_timer :" & draw_tiles_timer'image, x + 3 * core.icon, y + core.icon + 0 * 15, size => 15, code => true); - ui.write ("draw_views_timer :" & draw_views_timer'image, x + 3 * core.icon, y + core.icon + 1 * 15, size => 15, code => true); - ui.write ("draw_landmarks_timer :" & draw_landmarks_timer'image, x + 3 * core.icon, y + core.icon + 2 * 15, size => 15, code => true); - ui.write ("draw_locations_timer :" & draw_locations_timer'image, x + 3 * core.icon, y + core.icon + 3 * 15, size => 15, code => true); - ui.write ("draw_constructions_timer :" & draw_constructions_timer'image, x + 3 * core.icon, y + core.icon + 4 * 15, size => 15, code => true); - ui.write ("draw_equipments_timer :" & draw_equipments_timer'image, x + 3 * core.icon, y + core.icon + 5 * 15, size => 15, code => true); - ui.write ("draw_units_timer :" & draw_units_timer'image, x + 3 * core.icon, y + core.icon + 6 * 15, size => 15, code => true); - ui.write ("draw_world_timer :" & draw_world_timer'image, x + 3 * core.icon, y + core.icon + 7 * 15, size => 15, code => true); - -- - ui.write (drawn_tiles'image, x + core.icon, y + core.icon + 0 * 15, size => 15, code => true, tint => (255, 0, 0, 255)); - ui.write (drawn_views'image, x + core.icon, y + core.icon + 1 * 15, size => 15, code => true, tint => (255, 0, 0, 255)); - ui.write (drawn_landmarks'image, x + core.icon, y + core.icon + 2 * 15, size => 15, code => true, tint => (255, 0, 0, 255)); - ui.write (drawn_locations'image, x + core.icon, y + core.icon + 3 * 15, size => 15, code => true, tint => (255, 0, 0, 255)); - ui.write (drawn_constructions'image, x + core.icon, y + core.icon + 4 * 15, size => 15, code => true, tint => (255, 0, 0, 255)); - ui.write (drawn_equipments'image, x + core.icon, y + core.icon + 5 * 15, size => 15, code => true, tint => (255, 0, 0, 255)); - ui.write (drawn_units'image, x + core.icon, y + core.icon + 6 * 15, size => 15, code => true, tint => (255, 0, 0, 255)); - end draw_performance_box; - - ------------------------------------------------------------------------------------------ - - procedure mapshot (file_path : in string) is - begin - if not map_is_revealed then - core.echo (core.warning, "You need to reveal entire map in order to make a mapshot."); - -- - return; - end if; - -- - core.create_image (map.width * core.base, map.height * core.base); - -- - for vertical in 0 .. map.height - 1 loop - for horizontal in 0 .. map.width - 1 loop - core.render_image (data => tiles (map.kind), - x => horizontal * core.base, - y => vertical * core.base, - u => core.base * map.tiles (horizontal, vertical), - v => 0, - width => core.base, - height => core.base); - end loop; - end loop; - -- - for index in 1 .. landmark_limit loop - core.render_image (data => landmarks (landmark_index'val (map.landmarks (index).index)), - x => map.landmarks (index).x * core.base, - y => map.landmarks (index).y * core.base, - u => 0, - v => 0, - width => landmarks (landmark_index'val (map.landmarks (index).index)).width, - height => landmarks (landmark_index'val (map.landmarks (index).index)).height); - end loop; - -- - for index in 1 .. location_limit loop - core.render_image (data => locations (location_index'val (map.locations (index).index)), - x => map.locations (index).x * core.base, - y => map.locations (index).y * core.base, - u => 0, - v => 0, - width => locations (location_index'val (map.locations (index).index)).width, - height => locations (location_index'val (map.locations (index).index)).height); - end loop; - -- - for index in 1 .. construction_limit loop - core.render_image (data => construction.sprite (construction.enumeration'val (map.constructions (index).index)), - x => map.constructions (index).x * core.base, - y => map.constructions (index).y * core.base, - u => 0, - v => 0, - width => construction.sprite (construction.enumeration'val (map.constructions (index).index)).width, - height => construction.sprite (construction.enumeration'val (map.constructions (index).index)).height); - end loop; - -- - for index in 1 .. equipment_limit loop - core.render_image (data => equipment.sprite (equipment.enumeration'val (map.equipments (index).index)), - x => map.equipments (index).x * core.base, - y => map.equipments (index).y * core.base, - u => 0, - v => 0, - width => equipment.sprite (equipment.enumeration'val (map.equipments (index).index)).width, - height => equipment.sprite (equipment.enumeration'val (map.equipments (index).index)).height); - end loop; - -- - core.export_image (file_path); - -- - core.echo (core.success, "Exported current world mapshot."); - -- - core.dash; - end mapshot; - - ------------------------------------------------------------------------------------------ - - function map_is_revealed return boolean is - begin - for x in 0 .. map.width - 1 loop - for y in 0 .. map.height - 1 loop - if map.views (x, y) = false then - return false; - end if; - end loop; - end loop; - -- - return true; - end map_is_revealed; - - ------------------------------------------------------------------------------------------ - - procedure add_chad (data : in chad.information) is - begin - core.echo_when (map.chad_count = map.chad_limit, core.failure, "Can't add new chad, limit reached."); - core.increment (map.chad_count); - -- - map.chads (map.chad_count) := data; - end add_chad; - - ------------------------------------------------------------------------------------------ - - procedure resource_cheat_1 is begin core.increment (map.chads (1).resources (resource.gold).value, 20); end resource_cheat_1; - procedure resource_cheat_2 is begin core.increment (map.chads (1).resources (resource.wood).value, 10); end resource_cheat_2; - procedure resource_cheat_3 is begin core.increment (map.chads (1).resources (resource.stone).value, 10); end resource_cheat_3; - procedure resource_cheat_4 is begin core.increment (map.chads (1).resources (resource.metal).value, 10); end resource_cheat_4; - procedure resource_cheat_5 is begin core.increment (map.chads (1).resources (resource.leather).value, 10); end resource_cheat_5; - procedure resource_cheat_6 is begin core.increment (map.chads (1).resources (resource.gem).value, 10); end resource_cheat_6; - - ------------------------------------------------------------------------------------------ - - procedure reveal_map is - begin - for x in 0 .. map.width - 1 loop - for y in 0 .. map.height - 1 loop - map.views (x, y) := true; - end loop; - end loop; - end reveal_map; - - ------------------------------------------------------------------------------------------ - - procedure restore_points is - begin - map.chads (1).health.value := map.chads (1).health.limit; - map.chads (1).mana.value := map.chads (1).mana.limit; - map.chads (1).movement.value := map.chads (1).movement.limit; - end restore_points; - - ------------------------------------------------------------------------------------------ - - procedure player_up is - begin - if map.chads (1).movement.value = 0 then return; end if; - core.decrement (map.chads (1).y); - core.clip (map.chads (1).y, 0, map.height - 1); - map.chads (1).movement := map.chads (1).movement - 1; - if map.clips (map.chads (1).x, map.chads (1).y) then - core.increment (map.chads (1).y); - if map.chads (1).movement.value > 0 then - map.chads (1).movement := map.chads (1).movement + 1; - end if; - end if; - end player_up; - - ------------------------------------------------------------------------------------------ - - procedure player_down is - begin - if map.chads (1).movement.value = 0 then return; end if; - core.increment (map.chads (1).y); - core.clip (map.chads (1).y, 0, map.height - 1); - map.chads (1).movement := map.chads (1).movement - 1; - if map.clips (map.chads (1).x, map.chads (1).y) then - core.decrement (map.chads (1).y); - if map.chads (1).movement.value > 0 then - map.chads (1).movement := map.chads (1).movement + 1; - end if; - end if; - end player_down; - - ------------------------------------------------------------------------------------------ - - procedure player_left is - begin - if map.chads (1).movement.value = 0 then return; end if; - core.decrement (map.chads (1).x); - core.clip (map.chads (1).x, 0, map.width - 1); - map.chads (1).movement := map.chads (1).movement - 1; - if map.clips (map.chads (1).x, map.chads (1).y) then - core.increment (map.chads (1).x); - if map.chads (1).movement.value > 0 then - map.chads (1).movement := map.chads (1).movement + 1; - end if; - end if; - end player_left; - - ------------------------------------------------------------------------------------------ - - procedure player_right is - begin - if map.chads (1).movement.value = 0 then return; end if; - core.increment (map.chads (1).x); - core.clip (map.chads (1).x, 0, map.width - 1); - map.chads (1).movement := map.chads (1).movement - 1; - if map.clips (map.chads (1).x, map.chads (1).y) then - core.decrement (map.chads (1).x); - if map.chads (1).movement.value > 0 then - map.chads (1).movement := map.chads (1).movement + 1; - end if; - end if; - end player_right; - ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ end world;