with core; use core; package body core is ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ procedure configure is begin engine_configure; -- hexagon_grid_sprite := load_sprite ("./sprite/ui/hexagon_grid_tile.png", 1, 1); hexagon_fill_sprite := load_sprite ("./sprite/ui/hexagon_fill_tile.png", 1, 1); end configure; ------------------------------------------------------------------------------------------ procedure synchronize is begin global_time := global_time + 1; -- global_time := global_time mod (gameplay_framerate * animation_framerate); gameplay_time := global_time mod (gameplay_framerate); animation_time := global_time / (gameplay_framerate / animation_framerate); -- engine_synchronize; end synchronize; ------------------------------------------------------------------------------------------ procedure draw_state_box (x, y : in integer) is begin write ("Cursor X :" & integer'image (cursor_x), x, y + 0, 16#CCCCCC#); write ("Cursor Y :" & integer'image (cursor_y), x, y + 32, 16#CCCCCC#); write ("Cursor Mode :" & integer'image (cursor_mode), x, y + 64, 16#CCCCCC#); write ("Signal Code :" & signal_code'image (signal_code'val (signal_mode)), x, y + 96, 16#CCCCCC#); write ("Camera X :" & integer'image (camera.x), x, y + 128, 16#CCCCCC#); write ("Camera Y :" & integer'image (camera.y), x, y + 160, 16#CCCCCC#); write ("Global Time :" & integer'image (global_time), x, y + 192, 16#CCCCCC#); write ("Gameplay Time :" & integer'image (gameplay_time), x, y + 224, 16#CCCCCC#); write ("Animation Time :" & integer'image (animation_time), x, y + 256, 16#CCCCCC#); write ("Framerate :" & integer'image (framerate), x, y + 288, 16#CCCCCC#); end draw_state_box; ------------------------------------------------------------------------------------------ function flip_coin return integer is begin return (random_integer (0, 1)); end flip_coin; ------------------------------------------------------------------------------------------ function roll_dice return integer is begin return (random_integer (1, 6)); end roll_dice; ------------------------------------------------------------------------------------------ function by_chance (chance : in integer) return integer is begin return (random_integer (0, 100) mod chance); end by_chance; ------------------------------------------------------------------------------------------ function sigmoid (value : in boolean) return integer is begin return (if value then -1 else 1); end sigmoid; ------------------------------------------------------------------------------------------ function c_string (ada_string : string) return string is begin return (ada_string & character'val (0)); end c_string; ------------------------------------------------------------------------------------------ function clip (value, minimum, maximum : in integer) return integer is begin if value < minimum then return minimum; end if; if value > maximum then return maximum; end if; return value; end clip; ------------------------------------------------------------------------------------------ function load_sprite (file_path : in string; frames, states : in integer) return sprite is this : sprite; begin this.index := import_sprite (c_string (file_path)); this.width := sprite_width (this.index) / states; this.height := sprite_height (this.index) / frames; this.frames := frames; this.states := states; -- return this; end load_sprite; ------------------------------------------------------------------------------------------ procedure crop (data : in sprite; x, y, u, v, width, height : in integer) is begin render_sprite (data.index, x, y, u, v, width, height); end crop; ------------------------------------------------------------------------------------------ procedure view (data : in sprite; x, y, u, v, width, height : in integer) is --~crop_u, crop_v, crop_width, crop_height : integer; begin if x > u + width or y > v + height or x < u - data.width or y < v - data.height then return; end if; -- --~crop_width := data.width - (if x + data.width > u + width then (x + data.width) mod (u + width) else 0); --~crop_height := data.height - (if y + data.height > v + height then (y + data.height) mod (v + height) else 0); -- --~crop_u := (if x < u then data.width - u mod (x + data.width) else 0); --~crop_v := (if y < v then data.height - v mod (y + data.height) else 0); --~crop_u := (if x < u and x < u - data.width then data.width - (x + data.width) mod u else 0); --~crop_v := (if y < v and y < v - data.height then data.height - (y + data.height) mod v else 0); --~crop_u := data.width - (if x < u then (x + data.width) mod u else 0); --~crop_v := data.height - (if y < v then (y + data.height) mod v else 0); --~crop_u := data.width - (if x < u then u mod x else 0); --~crop_v := data.height - (if y < v then v mod y else 0); -- --~render_sprite (data.index, x, y, crop_u, crop_v, crop_width, crop_height); render_sprite (data.index, x, y, 0, 0, data.width, data.height); end view; ------------------------------------------------------------------------------------------ procedure draw (data : in sprite; x, y : in integer) is begin render_sprite (data.index, x, y, 0, 0, data.width, data.height); end draw; ------------------------------------------------------------------------------------------ procedure move (data : in sprite; x, y, frame, state : in integer) is begin render_sprite (data.index, x, y, state * data.width, (animation_time mod frame) * data.height, data.width, data.height); end move; ------------------------------------------------------------------------------------------ procedure line (origin, offset : in vector_2) is begin render_vector (origin.x, origin.y, origin.x + offset.x, origin.y + offset.y); end line; ------------------------------------------------------------------------------------------ procedure write (text : in string; x, y : in integer; colour : in integer := 16#CCCCCC#) is begin render_string (c_string (text), x, y, colour, false); end write; ------------------------------------------------------------------------------------------ procedure debug (text : in string) is begin put_line ("> " & text); end debug; ------------------------------------------------------------------------------------------ procedure hexagonal_grid (x, y, width, height : in integer; fill : in boolean) is crop_width : constant integer := width mod hexagon_grid_sprite.width; crop_height : constant integer := height mod hexagon_grid_sprite.height; use_sprite : constant sprite := (if fill then hexagon_fill_sprite else hexagon_grid_sprite); begin for move_y in 0 .. height / hexagon_grid_sprite.height - 1 loop for move_x in 0 .. width / hexagon_grid_sprite.width - 1 loop draw (use_sprite, x + move_x * hexagon_grid_sprite.width, y + move_y * hexagon_grid_sprite.height); end loop; -- crop (use_sprite, x + width - crop_width, y + move_y * hexagon_grid_sprite.height, 0, 0, crop_width, hexagon_grid_sprite.height); end loop; -- for move_x in 0 .. width / hexagon_grid_sprite.width - 1 loop crop (use_sprite, x + move_x * hexagon_grid_sprite.width, y + height - crop_height, 0, 0, hexagon_grid_sprite.width, crop_height); end loop; -- crop (use_sprite, x + width - crop_width, y + height - crop_height, 0, 0, crop_width, crop_height); end hexagonal_grid; ------------------------------------------------------------------------------------------ function lowercase (text : in string) return string is result : string (1 .. text'length); begin for index in text'range loop if text (index) in 'A' .. 'Z' then result (index) := character'val (character'pos (text (index)) + 32); else result (index) := text (index); end if; end loop; -- return result; end lowercase; ------------------------------------------------------------------------------------------ function uppercase (text : in string) return string is result : string (1 .. text'length); begin for index in text'range loop if text (index) in 'a' .. 'z' then result (index) := character'val (character'pos (text (index)) - 32); else result (index) := text (index); end if; end loop; -- return result; end uppercase; ------------------------------------------------------------------------------------------ procedure draw_central_grid (x, y, width, height : in integer) is begin render_vector (width / 2 + x, y, width / 2 + x, height + y); render_vector ( x, height / 2 + y, width + x, height / 2 + y); end draw_central_grid; ------------------------------------------------------------------------------------------ procedure draw_squared_grid (x, y, width, height : in integer) is --~offset_x : constant integer := x + base / 2 + (width mod base) / 2; --~offset_y : constant integer := y + base / 2 + (height mod base) / 2; --~crop_height : constant integer := ((height + base) / 2) mod base; --~crop_offset : constant integer := y - ((y + height) mod base) / 2; --~middle : constant vector_2 := (width / 2 + x, height / 2 + y); offset : constant vector_2 := (((width - base) / 2) mod base, ((height - base) / 2) mod base); repeat : constant vector_2 := (2 * (((width - base) / 2) / base) + 1, 2 * (((height - base) / 2) / base) + 1); --~blabla : constant integer := y + height - ((height - base) / 2) mod base; --~next : integer; begin --~for vertical in 0 .. width / base - 1 --~loop --~line ((offset_x + vertical * base, y), (0, crop_height)); --~end loop; --~-- --~for horizontal in 0 .. height / base - 1 --~loop --~line ((x, offset_y + horizontal * base), (width, 0)); --~-- --~for vertical in 0 .. width / base - 1 --~loop --~line ((offset_x + vertical * base - base / 2, crop_offset + 2 * base * (horizontal / 2) + base), (0, base)); --~line ((offset_x + vertical * base, crop_offset + 2 * base * (horizontal / 2)), (0, base)); --~end loop; --~end loop; --~-- --~for vertical in 0 .. width / base - 1 --~loop --~line ((offset_x + vertical * base, crop_offset + 2 * base * ((height / base) / 2)), (0, crop_height)); --~end loop; --~-- --~-- --~-- -- upper crop --~next := middle.x - base / 2; while next > x loop line ((next, y ), (0, ((height + base) / 2) mod base)); next := next - base; end loop; --~next := middle.x + base / 2; while next < x + width loop line ((next, y ), (0, ((height + base) / 2) mod base)); next := next + base; end loop; -- horizontal full for txen in 0 .. repeat.y loop line ((x, y + offset.y + txen * base), (width, 0)); end loop; for txen in 0 .. repeat.x loop line ((x + offset.x + txen * base, y), (0, height)); end loop; --~next := middle.y - base / 2; while next > y loop line ((x, next ), (width, 0 )); next := next - base; end loop; --~next := middle.y + base / 2; while next < y + height loop line ((x, next ), (width, 0 )); next := next + base; end loop; -- middle side --~next := middle.x - base / 2; while next > x loop line ((next, (height - base) / 2 + y), (0, base )); next := next - base; end loop; --~next := middle.x + base / 2; while next < x + width loop line ((next, (height - base) / 2 + y), (0, base )); next := next + base; end loop; -- lower crop --~next := (width - base) / 2 + x; while next > x loop line ((next, blabla ), (0, ((height + base) / 2) mod base)); next := next - base; end loop; --~next := (width + base) / 2 + x; while next < x + width loop line ((next, blabla ), (0, ((height + base) / 2) mod base)); next := next + base; end loop; --~next := (width - base) / 2 + x; while next > x loop line ((x, next), (width, 0)); next := next - base; end loop; --~next := (width + base) / 2 + x; while next < width loop line ((x, next), (width, 0)); next := next + base; end loop; end draw_squared_grid; ------------------------------------------------------------------------------------------ procedure draw_hexagon_grid (x, y, width, height : in integer) is begin render_vector (width / 2 + x, y, width / 2 + x, height + y); render_vector ( x, height / 2 + y, width + x, height / 2 + y); end draw_hexagon_grid; ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ end core;