diff --git a/Dockerfile b/Dockerfile new file mode 100644 index 0000000..f9586a5 --- /dev/null +++ b/Dockerfile @@ -0,0 +1,13 @@ +# syntax=docker/dockerfile:1 +FROM erlang:25.0.4 + +LABEL author="Fabien Lamarche-Filion" + +EXPOSE 8080 + +ENV ERL_AFLAGS="-enable-feature all" + +RUN useradd -ms /bin/bash warp +WORKDIR /warp +USER warp +CMD bash diff --git a/README.md b/README.md index 7233950..2c16381 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ warp ===== -`warp` is a real time economic simulator that represents an arbitrary large 3d galaxy. +`warp` (working title) is a real time economic simulator that represents an arbitrary large 3d galaxy. Very WIP. @@ -10,7 +10,7 @@ Dependencies: erlang 25.0.4 or docker. Build ----- Erlang: - $ rebar3 compile + $ rebar3 as dev compile Docker: Build docker image: @@ -18,6 +18,15 @@ Build Run docker with a bind on your local directory: $ docker container run -it -v $(pwd):/warp:rw warp:dev + (or run `./dev.sh) Compile from within the container: $ rebar3 compile + +Run +----- + running `./dev.sh` will start the development Docker image + and expose port 8080. + + Start the application with + $ rebar3 shell diff --git a/dev.sh b/dev.sh new file mode 100755 index 0000000..f1d680a --- /dev/null +++ b/dev.sh @@ -0,0 +1,2 @@ +#!/bin/bash +docker container run -it --publish 8080:8080 -v $(pwd):/warp:rw warp:dev diff --git a/include/warp.hrl b/include/warp.hrl new file mode 100644 index 0000000..4d85b67 --- /dev/null +++ b/include/warp.hrl @@ -0,0 +1,6 @@ +-ifndef(WARP_HEADER). +-define(WARP_HEADER, defined). + +-type coord() :: {integer(), integer(), integer()}. + +-endif. diff --git a/rebar.config b/rebar.config new file mode 100644 index 0000000..4ae9e43 --- /dev/null +++ b/rebar.config @@ -0,0 +1,42 @@ +{erl_opts, [debug_info]}. +{deps, [ + observer_cli, + {cowboy, ".*", + {git, "https://github.com/extend/cowboy.git", {tag, "2.9.0"}}}, + {jiffy, ".*", + {git, "https://github.com/davisp/jiffy.git", {tag, "1.1.1"}}} +]}. + +{plugins, [ + {gradualizer, + {git, "https://github.com/josefs/Gradualizer.git", {tag, "0.1.3"}}}, + erlfmt +]}. + +{erlfmt, [ + write, + {files, "{src,include,test}/**/*.{hrl,erl}"} +]}. + +{gradualizer_opts, [ + {i, "./include"}, + {print_file, true} +]}. + +{profiles, [ + {dev, [ + {provider_hooks, [ + {pre, [ + {compile, fmt} + ]}, + {post, [ + {compile, {default, gradualizer}} + ]} + ]} + ]} +]}. + +{shell, [ + % {config, "config/sys.config"}, + {apps, [warp]} +]}. diff --git a/src/http_character_lookup_handler.erl b/src/http_character_lookup_handler.erl new file mode 100644 index 0000000..55d1ea8 --- /dev/null +++ b/src/http_character_lookup_handler.erl @@ -0,0 +1,22 @@ +-module(http_character_lookup_handler). + +-behaviour(cowboy_handler). + +-export([init/2]). + +init(Req0, State) -> + Req = + case cowboy_req:binding(character_id, Req0, undefined) of + undefined -> + cowboy_req:reply(400, #{}, <<>>, Req0); + Id -> + case warp_character_server:lookup(Id) of + {error, _} -> + cowboy_req:reply(204, #{}, <<>>, Req0); + {ok, CharacterPid} -> + {ok, CharacterState} = warp_character:get_state(CharacterPid), + StateJson = utils:ensure_binary(jiffy:encode(CharacterState)), + cowboy_req:reply(200, #{}, <>, Req0) + end + end, + {ok, Req, State}. diff --git a/src/http_character_spawn_handler.erl b/src/http_character_spawn_handler.erl new file mode 100644 index 0000000..36105a0 --- /dev/null +++ b/src/http_character_spawn_handler.erl @@ -0,0 +1,21 @@ +-module(http_character_spawn_handler). + +-behaviour(cowboy_handler). + +-export([init/2]). + +init(Req0, State) -> + Req = + case cowboy_req:binding(character_id, Req0, undefined) of + undefined -> + cowboy_req:reply(400, #{}, <<>>, Req0); + ID -> + case warp_character_server:lookup(ID) of + {error, character_not_found} -> + warp_character_server:spawn_character(ID), + cowboy_req:reply(200, #{}, <<>>, Req0); + {ok, _CharacterPid} -> + cowboy_req:reply(304, #{}, <<>>, Req0) + end + end, + {ok, Req, State}. diff --git a/src/http_ship_move_handler.erl b/src/http_ship_move_handler.erl new file mode 100644 index 0000000..b5684d3 --- /dev/null +++ b/src/http_ship_move_handler.erl @@ -0,0 +1,26 @@ +-module(http_ship_move_handler). +-include("warp.hrl"). +-include("ship.hrl"). + +-behaviour(cowboy_handler). + +-export([init/2]). + +init(Req0, State) -> + % EEEEWWW. TODO: anything but that, really. This needs to be properly validated + MoveCoord = { + binary_to_integer(cowboy_req:binding(x, Req0, undefined)), + binary_to_integer(cowboy_req:binding(y, Req0, undefined)), + binary_to_integer(cowboy_req:binding(z, Req0, undefined)) + }, + ShipId = cowboy_req:binding(ship_id, Req0, undefined), + + {ok, ShipPid} = warp_ship_server:lookup(ShipId), + #ship_state{position = StartCoord} = warp_ship:get_state(ShipPid), + {ok, Distance} = warp_ship:move_to(ShipPid, MoveCoord), + Message = io_lib:format("You moved ~p space units from ~p to ~p\n", [ + Distance, StartCoord, MoveCoord + ]), + MessageBin = list_to_binary(lists:flatten(Message)), + Req = cowboy_req:reply(200, #{}, <>, Req0), + {ok, Req, State}. diff --git a/src/http_ship_spawn_handler.erl b/src/http_ship_spawn_handler.erl new file mode 100644 index 0000000..2f13c67 --- /dev/null +++ b/src/http_ship_spawn_handler.erl @@ -0,0 +1,10 @@ +-module(http_ship_spawn_handler). + +-behaviour(cowboy_handler). + +-export([init/2]). + +init(Req, State) -> + Id = warp_ship_server:spawn_ship(), + cowboy_req:reply(200, #{}, <>, Req), + {ok, Req, State}. diff --git a/src/http_space_object_lookup_handler.erl b/src/http_space_object_lookup_handler.erl new file mode 100644 index 0000000..9ce08ee --- /dev/null +++ b/src/http_space_object_lookup_handler.erl @@ -0,0 +1,23 @@ +-module(http_space_object_lookup_handler). + +-behaviour(cowboy_handler). + +-export([init/2]). + +init(Req0, State) -> + % EEEEWWW. TODO: anything but that, really. This needs to be properly validated + Coords = { + binary_to_integer(cowboy_req:binding(x, Req0, undefined)), + binary_to_integer(cowboy_req:binding(y, Req0, undefined)), + binary_to_integer(cowboy_req:binding(z, Req0, undefined)) + }, + Req = + case warp_space_object_server:lookup(Coords) of + {error, _} -> + cowboy_req:reply(204, #{}, <<>>, Req0); + {ok, SpaceObjectPid} -> + {ok, SpaceObjectState} = warp_space_object:get_state(SpaceObjectPid), + StateJson = utils:ensure_binary(jiffy:encode(SpaceObjectState)), + cowboy_req:reply(200, #{}, <>, Req0) + end, + {ok, Req, State}. diff --git a/src/http_space_object_scan_handler.erl b/src/http_space_object_scan_handler.erl new file mode 100644 index 0000000..e5867b7 --- /dev/null +++ b/src/http_space_object_scan_handler.erl @@ -0,0 +1,44 @@ +-module(http_space_object_scan_handler). + +-behaviour(cowboy_handler). + +-export([init/2]). + +init(Req0, State) -> + % EEEEWWW. TODO: anything but that, really. This needs to be properly validated + Coord = { + binary_to_integer(cowboy_req:binding(x, Req0, undefined)), + binary_to_integer(cowboy_req:binding(y, Req0, undefined)), + binary_to_integer(cowboy_req:binding(z, Req0, undefined)) + }, + Radius = binary_to_integer(cowboy_req:binding(r, Req0, undefined)), + + SpaceObjects = scan(Coord, Radius), + BinaryCoordsSpaceObjects = [ + << + (integer_to_binary(X))/binary, + "/", + (integer_to_binary(Y))/binary, + "/", + (integer_to_binary(Z))/binary, + "\n" + >> + || {{X, Y, Z}, _Pid} <- SpaceObjects + ], + Req = cowboy_req:reply(200, #{}, BinaryCoordsSpaceObjects, Req0), + {ok, Req, State}. + +% private functions +% TODO: obviously, this needs to be a sphere, not a cube +scan(Coord, Radius) -> + %% Xs = lists:seq(X - Radius, X + Radius), + %% Ys = lists:seq(Y - Radius, Y + Radius), + %% Zs = lists:seq(Z - Radius, Z + Radius), + % Look at me I erlang good herp derp + %% AllCoords = [{X1, Y1, Z1} || X1 <- Xs, Y1 <- Ys, Z1 <- Zs], + %% Results = [{Coord, warp_space_object_server:lookup(Coord)} || Coord <- AllCoords], + %% FilteredResults = [{Coord, Pid} || {Coord, {ok, Pid}} <- Results]. + {ok, Results} = warp_space_object_server:get_sphere(Coord, Radius), + Results. + +%[warp_space_object:get_state(Pid) || {_, Pid} <- Results]. diff --git a/src/kd_tree.erl b/src/kd_tree.erl new file mode 100644 index 0000000..91f3b79 --- /dev/null +++ b/src/kd_tree.erl @@ -0,0 +1,304 @@ +-module(kd_tree). + +% TODO: implement https://opendsa-server.cs.vt.edu/ODSA/Books/CS3/html/KDtree.html + +-export([new/0, insert/3, get_box/0, get_sphere/3, lookup/2, delete/2]). +-export([fold/3, foreach/2]). + +-record(node, { + key = undefined :: undefined | {integer(), integer(), integer()}, + % TODO: specify a better type for value + value = undefined :: undefined | term(), + left_node = none :: none | #node{}, + right_node = none :: none | #node{} +}). + +-type tree() :: #node{} | none. +-type key() :: {integer(), integer(), integer()} | undefined. + +-define(CYCLE_LIST, [x, y, z]). + +new() -> + none. + +-spec insert(key(), term(), tree()) -> tree(). +insert({X, Y, Z} = Key, Value, Tree) when + is_integer(X) andalso is_integer(Y) andalso is_integer(Z) +-> + insert(Key, Value, Tree, ?CYCLE_LIST). + +%% inserting into an empty tree sets the key and value for the first node +insert(Key, Value, none, _CycleList) -> + #node{key = Key, value = Value}; +insert(Key, Value, Tree, []) -> + insert(Key, Value, Tree, ?CYCLE_LIST); +insert({X, Y, Z}, _Value, #node{key = {X, Y, Z}}, _CycleList) -> + % TODO: maybe not crash when key exists? + error(<<"Key already exists">>); +insert({X, _Y, _Z} = Key, Value, #node{key = {TreeX, _, _}, left_node = LeftNode} = Tree, [ + x | CycleList +]) when + X < TreeX +-> + Tree#node{left_node = insert(Key, Value, LeftNode, CycleList)}; +insert(Key, Value, #node{right_node = RightNode} = Tree, [x | CycleList]) -> + Tree#node{right_node = insert(Key, Value, RightNode, CycleList)}; +insert({_X, Y, _Z} = Key, Value, #node{key = {_, TreeY, _}, left_node = LeftNode} = Tree, [ + y | CycleList +]) when + Y < TreeY +-> + Tree#node{left_node = insert(Key, Value, LeftNode, CycleList)}; +insert(Key, Value, #node{right_node = RightNode} = Tree, [y | CycleList]) -> + Tree#node{right_node = insert(Key, Value, RightNode, CycleList)}; +insert({_X, _Y, Z} = Key, Value, #node{key = {_, _, TreeZ}, left_node = LeftNode} = Tree, [ + z | CycleList +]) when + Z < TreeZ +-> + Tree#node{left_node = insert(Key, Value, LeftNode, CycleList)}; +insert(Key, Value, #node{right_node = RightNode} = Tree, [z | CycleList]) -> + Tree#node{right_node = insert(Key, Value, RightNode, CycleList)}. + +-spec lookup(key(), tree()) -> term(). +lookup({X, Y, Z} = Key, Tree) when is_integer(X) andalso is_integer(Y) andalso is_integer(Z) -> + case lookup(Key, Tree, ?CYCLE_LIST) of + #node{key = Key, value = Value} -> + {ok, Value}; + Err -> + Err + end. + +lookup(_Key, none, _CycleList) -> + {error, key_not_found}; +lookup(Key, #node{key = Key} = SubTree, _CycleList) -> + SubTree; +lookup(Key, Tree, []) -> + lookup(Key, Tree, ?CYCLE_LIST); +lookup({X, _Y, _Z} = Key, #node{key = {TreeX, _, _}, left_node = LeftNode} = _Tree, [x | CycleList]) when + X < TreeX +-> + lookup(Key, LeftNode, CycleList); +lookup(Key, #node{right_node = RightNode} = _Tree, [x | CycleList]) -> + lookup(Key, RightNode, CycleList); +lookup({_X, Y, _Z} = Key, #node{key = {_, TreeY, _}, left_node = LeftNode} = _Tree, [y | CycleList]) when + Y < TreeY +-> + lookup(Key, LeftNode, CycleList); +lookup(Key, #node{right_node = RightNode} = _Tree, [y | CycleList]) -> + lookup(Key, RightNode, CycleList); +lookup({_X, _Y, Z} = Key, #node{key = {_, _, TreeZ}, left_node = LeftNode} = _Tree, [z | CycleList]) when + Z < TreeZ +-> + lookup(Key, LeftNode, CycleList); +lookup(Key, #node{right_node = RightNode} = _Tree, [z | CycleList]) -> + lookup(Key, RightNode, CycleList). + +% TODO: taking all the leftover nodes after deletion and reinserting them is a bit gross, and I'm not even +% doing it right. I should do proper substitution instead. +-spec delete(key(), tree()) -> tree(). +delete({X, Y, Z} = Key, Tree) when is_integer(X) andalso is_integer(Y) andalso is_integer(Z) -> + #node{left_node = LeftCutBranch, right_node = RightCutBranch} = lookup(Key, Tree, ?CYCLE_LIST), + NewTree = delete(Key, Tree, ?CYCLE_LIST), + NewTree1 = fold( + fun(FunKey, Value, Acc) -> + insert(FunKey, Value, Acc) + end, + NewTree, + LeftCutBranch + ), + fold( + fun(FunKey, Value, Acc) -> + insert(FunKey, Value, Acc) + end, + NewTree1, + RightCutBranch + ). + +delete(_Key, none, _CycleList) -> + none; +delete(Key, Tree, []) -> + delete(Key, Tree, ?CYCLE_LIST); +delete({X, Y, Z}, #node{key = {X, Y, Z}}, _CycleList) -> + none; +delete({X, _Y, _Z} = Key, #node{key = {TreeX, _, _}, left_node = LeftNode} = Tree, [x | CycleList]) when + X < TreeX +-> + Tree#node{left_node = delete(Key, LeftNode, CycleList)}; +delete(Key, #node{right_node = RightNode} = Tree, [x | CycleList]) -> + Tree#node{right_node = delete(Key, RightNode, CycleList)}; +delete({_X, Y, _Z} = Key, #node{key = {_, TreeY, _}, left_node = LeftNode} = Tree, [y | CycleList]) when + Y < TreeY +-> + Tree#node{left_node = delete(Key, LeftNode, CycleList)}; +delete(Key, #node{right_node = RightNode} = Tree, [y | CycleList]) -> + Tree#node{right_node = delete(Key, RightNode, CycleList)}; +delete({_X, _Y, Z} = Key, #node{key = {_, _, TreeZ}, left_node = LeftNode} = Tree, [z | CycleList]) when + Z < TreeZ +-> + Tree#node{left_node = delete(Key, LeftNode, CycleList)}; +delete(Key, #node{right_node = RightNode} = Tree, [z | CycleList]) -> + Tree#node{right_node = delete(Key, RightNode, CycleList)}. + +% TODO: make these tail recursive +-spec fold(fun((key(), Value :: term(), FunAcc :: term()) -> term()), Acc :: term(), tree()) -> + term(). +% fold expects a 3 argument function that takes Key, Value and Acc, and returns an updated Acc. +fold(_Fun, Acc, none) -> + Acc; +fold( + Fun, Acc, #node{key = Key, value = Value, left_node = LeftNode, right_node = RightNode} = _Tree +) -> + Acc2 = Fun(Key, Value, Acc), + Acc3 = fold(Fun, Acc2, LeftNode), + fold(Fun, Acc3, RightNode). + +-spec foreach(fun((key(), Value :: term()) -> term()), tree()) -> ok. +foreach(_Fun, none) -> + ok; +foreach(Fun, #node{key = Key, value = Value, left_node = LeftNode, right_node = RightNode} = _Tree) -> + Fun(Key, Value), + foreach(Fun, LeftNode), + foreach(Fun, RightNode). + +% TODO: find an API that makes some sort of sense to represent a box +get_box() -> + ok. + +% TODO: cut the corners of the cube into a sphere +get_sphere({X, Y, Z} = Key, Radius, Tree) when + is_integer(X) andalso + is_integer(Y) andalso is_integer(Z) andalso is_integer(Radius) andalso Radius >= 0 +-> + get_cube(Key, Radius, Tree, ?CYCLE_LIST, []). + +get_cube(_Key, _Radius, none, _CycleList, Acc) -> + Acc; +get_cube(Key, Radius, Tree, [], Acc) -> + get_cube(Key, Radius, Tree, ?CYCLE_LIST, Acc); +get_cube( + {X, _Y, _Z} = Key, + Radius, + #node{key = {TreeX, _, _}, left_node = LeftNode} = _Tree, + [x | CycleList], + Acc +) when + TreeX > X + Radius +-> + get_cube(Key, Radius, LeftNode, CycleList, Acc); +get_cube( + {X, _Y, _Z} = Key, + Radius, + #node{key = {TreeX, _, _}, right_node = RightNode} = _Tree, + [x | CycleList], + Acc +) when + TreeX < X - Radius +-> + get_cube(Key, Radius, RightNode, CycleList, Acc); +get_cube( + {_X, Y, Z} = Key, + Radius, + #node{ + key = {_, TreeY, TreeZ} = NodeKey, + value = Value, + left_node = LeftNode, + right_node = RightNode + } = _Tree, + [x | CycleList], + Acc +) when + Y =< TreeY + Radius andalso + Y >= TreeY - Radius andalso Z =< TreeZ + Radius andalso Z >= TreeZ - Radius +-> + Acc1 = get_cube(Key, Radius, LeftNode, CycleList, [{NodeKey, Value} | Acc]), + get_cube(Key, Radius, RightNode, CycleList, Acc1); +get_cube( + Key, Radius, #node{left_node = LeftNode, right_node = RightNode} = _Tree, [x | CycleList], Acc +) -> + Acc1 = get_cube(Key, Radius, LeftNode, CycleList, Acc), + get_cube(Key, Radius, RightNode, CycleList, Acc1); +get_cube( + {_X, Y, _Z} = Key, + Radius, + #node{key = {_, TreeY, _}, left_node = LeftNode} = _Tree, + [y | CycleList], + Acc +) when + TreeY > Y + Radius +-> + get_cube(Key, Radius, LeftNode, CycleList, Acc); +get_cube( + {_X, Y, _Z} = Key, + Radius, + #node{key = {_, TreeY, _}, right_node = RightNode} = _Tree, + [y | CycleList], + Acc +) when + TreeY < Y - Radius +-> + get_cube(Key, Radius, RightNode, CycleList, Acc); +get_cube( + {X, _Y, Z} = Key, + Radius, + #node{ + key = {TreeX, _, TreeZ} = NodeKey, + value = Value, + left_node = LeftNode, + right_node = RightNode + } = _Tree, + [y | CycleList], + Acc +) when + X =< TreeX + Radius andalso + X >= TreeX - Radius andalso Z =< TreeZ + Radius andalso Z >= TreeZ - Radius +-> + Acc1 = get_cube(Key, Radius, LeftNode, CycleList, [{NodeKey, Value} | Acc]), + get_cube(Key, Radius, RightNode, CycleList, Acc1); +get_cube( + Key, Radius, #node{left_node = LeftNode, right_node = RightNode} = _Tree, [y | CycleList], Acc +) -> + Acc1 = get_cube(Key, Radius, LeftNode, CycleList, Acc), + get_cube(Key, Radius, RightNode, CycleList, Acc1); +get_cube( + {_X, _Y, Z} = Key, + Radius, + #node{key = {_, _, TreeZ}, left_node = LeftNode} = _Tree, + [z | CycleList], + Acc +) when + TreeZ > Z + Radius +-> + get_cube(Key, Radius, LeftNode, CycleList, Acc); +get_cube( + {_X, _Y, Z} = Key, + Radius, + #node{key = {_, _, TreeZ}, right_node = RightNode} = _Tree, + [z | CycleList], + Acc +) when + TreeZ < Z - Radius +-> + get_cube(Key, Radius, RightNode, CycleList, Acc); +get_cube( + {X, Y, _Z} = Key, + Radius, + #node{ + key = {TreeX, TreeY, _} = NodeKey, + value = Value, + left_node = LeftNode, + right_node = RightNode + } = _Tree, + [z | CycleList], + Acc +) when + X =< TreeX + Radius andalso + X >= TreeX - Radius andalso Y =< TreeY + Radius andalso Y >= TreeY - Radius +-> + Acc1 = get_cube(Key, Radius, LeftNode, CycleList, [{NodeKey, Value} | Acc]), + get_cube(Key, Radius, RightNode, CycleList, Acc1); +get_cube( + Key, Radius, #node{left_node = LeftNode, right_node = RightNode} = _Tree, [z | CycleList], Acc +) -> + Acc1 = get_cube(Key, Radius, LeftNode, CycleList, Acc), + get_cube(Key, Radius, RightNode, CycleList, Acc1). diff --git a/src/utils.erl b/src/utils.erl new file mode 100644 index 0000000..7a0fd63 --- /dev/null +++ b/src/utils.erl @@ -0,0 +1,9 @@ +-module(utils). + +-export([ensure_binary/1]). + +-spec ensure_binary(term()) -> binary(). +ensure_binary(Val) when is_binary(Val) -> + Val; +ensure_binary(Val) -> + error(io_lib:format("Expected binary, got: ~p", [Val])). diff --git a/src/warp.app.src b/src/warp.app.src new file mode 100644 index 0000000..a8dba79 --- /dev/null +++ b/src/warp.app.src @@ -0,0 +1,16 @@ +{application, warp, + [{description, "A simulated galactic economy"}, + {vsn, "0.1.0"}, + {registered, []}, + {mod, {warp_app, []}}, + {applications, + [kernel, + stdlib, + cowboy + ]}, + {env,[]}, + {modules, []}, + + {licenses, ["Apache 2.0"]}, + {links, []} + ]}. diff --git a/src/warp_app.erl b/src/warp_app.erl new file mode 100644 index 0000000..65087ad --- /dev/null +++ b/src/warp_app.erl @@ -0,0 +1,35 @@ +%%%------------------------------------------------------------------- +%% @doc warp public API +%% @end +%%%------------------------------------------------------------------- + +-module(warp_app). + +-behaviour(application). + +-export([start/2, stop/1]). + +start(_StartType, _StartArgs) -> + % todo: define an API that makes some sort of sense + % seriously that /x/y/z is probably literally illegal + Dispatch = cowboy_router:compile([ + {'_', [ + {"/space_objects/:x/:y/:z", http_space_object_lookup_handler, []}, + {"/space_objects/scan/:x/:y/:z/:r", http_space_object_scan_handler, []}, + {"/characters/:character_id", http_character_lookup_handler, []}, + {"/characters/spawn/:character_id", http_character_spawn_handler, []}, + {"/ship/spawn", http_ship_spawn_handler, []}, + {"/ship/:ship_id/move_to/:x/:y/:z", http_ship_move_handler, []}, + {"/ship/:ship_id/scan", http_ship_scan_handler, []} + ]} + ]), + % todo: configurable port + {ok, _} = cowboy:start_clear(warp_http_listener, [{port, 8080}], #{ + env => #{dispatch => Dispatch} + }), + warp_sup:start_link(). + +stop(_State) -> + ok. + +%% internal functions diff --git a/src/warp_character.erl b/src/warp_character.erl new file mode 100644 index 0000000..bb594a3 --- /dev/null +++ b/src/warp_character.erl @@ -0,0 +1,60 @@ +-module(warp_character). + +-behaviour(gen_server). + +-export([init/1, handle_cast/2, handle_call/3, handle_info/2, terminate/2, code_change/3]). +-export([spawn/1, get_state/1]). + +%% todo: use a regular record as private state, and provide +%% subset of that as a map or proplist via get_state (or get_status) + +%% todo: this needs to be supervised by something!!! + +%% -record(state, {id :: binary(), +%% time_of_birth :: non_neg_integer(), +%% current_task :: atom(), +%% leader :: none | binary(), +%% followers :: [binary()], +%% resources :: []}). + +% todo: manage arguments a bit better than that + +% todo: have a character "constructor" that generate +% the character ID based on things (origin? time?) + +% todo: have a character "constructor" that uses pre-established +% parameters (to allow for storage of characters and respawning of their +% processes) +init([CharacterId]) -> + InitialState = #{ + id => CharacterId, + time_of_birth => erlang:system_time(), + current_task => idling, + leader => none, + followers => [], + resources => [] + }, + {ok, InitialState}. + +handle_cast(_, State) -> + {noreply, State}. + +handle_call(get_state, _From, State) -> + {reply, {ok, State}, State}; +handle_call(_, _From, State) -> + {reply, {error, undefined_call}, State}. + +handle_info(_, State) -> + {noreply, State}. + +terminate(_Reason, _State) -> + ok. + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +spawn(CharacterId) -> + gen_server:start(?MODULE, [CharacterId], []). + +get_state(CharacterPid) -> + gen_server:call(CharacterPid, get_state). diff --git a/src/warp_character_server.erl b/src/warp_character_server.erl new file mode 100644 index 0000000..2e48798 --- /dev/null +++ b/src/warp_character_server.erl @@ -0,0 +1,58 @@ +-module(warp_character_server). + +-behaviour(gen_server). + +-export([init/1, handle_cast/2, handle_call/3, handle_info/2, terminate/2, code_change/3]). +-export([start_link/0]). +-export([lookup/1, spawn_character/1]). + +-record(state, {characters :: [{binary(), pid()}]}). + +start_link() -> + gen_server:start_link({local, ?MODULE}, ?MODULE, [], []). + +% gen_server callbacks +init(_) -> + InitialState = #state{characters = []}, + {ok, InitialState}. + +handle_cast({spawn, CharacterID}, #state{characters = Characters} = State) when + is_binary(CharacterID) +-> + CharacterPid = warp_character:spawn(CharacterID), + {noreply, State#state{characters = [{CharacterID, CharacterPid} | Characters]}}; +handle_cast(_, State) -> + {noreply, State}. + +handle_call({lookup, CharacterID}, _From, #state{characters = Characters} = State) when + is_binary(CharacterID) +-> + case proplists:get_value(CharacterID, Characters, undefined) of + undefined -> + % error atom feels weird here, especially when checked at spawning time + {reply, {error, character_not_found}, State}; + {ok, _CharacterPid} = Res -> + {reply, Res, State} + end; +handle_call({lookup, _}, _From, State) -> + {reply, {error, invalid_character_id}, State}; +handle_call(_, _From, State) -> + {reply, {error, undefined_call}, State}. + +handle_info(_, State) -> + {noreply, State}. + +terminate(_Reason, _State) -> + ok. + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +% public functions +-spec lookup(binary()) -> undefined | {ok, pid()}. +lookup(CharacterID) -> + gen_server:call(?MODULE, {lookup, CharacterID}). + +-spec spawn_character(binary()) -> ok. +spawn_character(CharacterID) -> + gen_server:cast(?MODULE, {spawn, CharacterID}). diff --git a/src/warp_ship.erl b/src/warp_ship.erl new file mode 100644 index 0000000..fbd9aa0 --- /dev/null +++ b/src/warp_ship.erl @@ -0,0 +1,45 @@ +-module(warp_ship). + +-include("warp.hrl"). +-include("ship.hrl"). + +-behaviour(gen_server). + +-export([init/1, handle_cast/2, handle_call/3, handle_info/2, terminate/2, code_change/3]). +-export([spawn/2, get_state/1, move_to/2, scan/0]). + +init([Id, Position]) -> + InitialState = #ship_state{id = Id, position = Position}, + {ok, InitialState}. + +handle_cast(_, State) -> + {noreply, State}. + +handle_call(get_state, _From, State) -> + {reply, State, State}; +handle_call({move_to, {X0, Y0, Z0} = Coord}, _From, #ship_state{position = {X1, Y1, Z1}} = State) -> + Distance = math:sqrt(math:pow((X1 - X0), 2) + math:pow((Y1 - Y0), 2) + math:pow((Z1 - Z0), 2)), + {reply, {ok, Distance}, State#ship_state{position = Coord}}; +handle_call(_, _From, State) -> + {reply, {error, undefined_call}, State}. + +handle_info(_, State) -> + {noreply, State}. + +terminate(_Reason, _State) -> + ok. + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +spawn(Id, Position) -> + gen_server:start(?MODULE, [Id, Position], []). + +get_state(ShipPid) -> + gen_server:call(ShipPid, get_state). + +move_to(ShipPid, Coord) -> + gen_server:call(ShipPid, {move_to, Coord}). + +scan() -> + ok. diff --git a/src/warp_ship_server.erl b/src/warp_ship_server.erl new file mode 100644 index 0000000..c6b58e6 --- /dev/null +++ b/src/warp_ship_server.erl @@ -0,0 +1,60 @@ +-module(warp_ship_server). +-include("warp.hrl"). +-include("names.hrl"). + +-export([init/1, handle_cast/2, handle_call/3, handle_info/2, terminate/2, code_change/3]). +-export([start_link/0]). +-export([lookup/1, spawn_ship/0]). + +-record(state, {ships :: term()}). + +start_link() -> + gen_server:start_link({local, ?MODULE}, ?MODULE, [], []). + +init(_) -> + {ok, #state{ships = []}}. + +handle_cast({spawn, Id, Position}, #state{ships = Ships} = State) -> + {ok, Pid} = warp_ship:spawn(Id, Position), + {noreply, State#state{ships = [{Id, Pid} | Ships]}}; +handle_cast(_, State) -> + {noreply, State}. + +handle_call({lookup, ShipId}, _From, #state{ships = Ships} = State) -> + {ShipId, Pid} = proplists:lookup(ShipId, Ships), + {reply, {ok, Pid}, State}; +handle_call(_, _From, State) -> + {reply, {error, undefined_call}, State}. + +handle_info(_, State) -> + {noreply, State}. + +terminate(_Reason, _State) -> + ok. + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +spawn_ship() -> + Id = generate_id(), + Pos = generate_position(), + gen_server:cast(?MODULE, {spawn, Id, Pos}), + Id. + +lookup(Id) -> + gen_server:call(?MODULE, {lookup, Id}). + +% TODO: ensure uniqueness +generate_id() -> + case length(?NUMBERS) of + N when N > 0 -> + <<"SHIP_", (lists:nth(rand:uniform(N), ?NUMBERS))/binary, "-", + (lists:nth(rand:uniform(N), ?NUMBERS))/binary, "-", + (lists:nth(rand:uniform(N), ?NUMBERS))/binary, "-", + (lists:nth(rand:uniform(N), ?NUMBERS))/binary>>; + _ -> + error(<<"Invalid NUMBERS list">>) + end. + +generate_position() -> + {50, 50, 50}. diff --git a/src/warp_space_object.erl b/src/warp_space_object.erl new file mode 100644 index 0000000..ca20e73 --- /dev/null +++ b/src/warp_space_object.erl @@ -0,0 +1,63 @@ +-module(warp_space_object). +-include("names.hrl"). + +-behaviour(gen_server). + +-export([init/1, handle_cast/2, handle_call/3, handle_info/2, terminate/2, code_change/3]). +-export([spawn/1, get_state/1]). + +%% TODO: have these names come from ingesting config files + +-record(state, { + name :: binary(), + type :: planet | asteroid | starbase, + affiliation :: none | binary(), + position :: {non_neg_integer(), non_neg_integer(), non_neg_integer()}, + resources :: [] +}). + +%% Yeah I can't keep doing that kind of argument nonsense, I need to clean my stuff up ASAP +init([Position]) -> + {Letter, Name} = + case {length(?LETTERS), length(?NAMES)} of + {N, M} when N > 0 andalso M > 0 -> + {lists:nth(rand:uniform(N), ?LETTERS), lists:nth(rand:uniform(M), ?NAMES)}; + _ -> + error(<<"Invalid LETTERS or NAMES list">>) + end, + InitialState = #state{ + name = <>, + type = planet, + affiliation = none, + position = Position, + resources = [] + }, + {ok, InitialState}. + +handle_cast(_, State) -> + {noreply, State}. + +handle_call( + get_state, + _From, + #state{name = Name, type = Type, affiliation = Affiliation, resources = Res} = State +) -> + StateMap = #{name => Name, type => Type, affiliation => Affiliation, resources => Res}, + {reply, {ok, StateMap}, State}; +handle_call(_, _From, State) -> + {reply, {error, undefined_call}, State}. + +handle_info(_, State) -> + {noreply, State}. + +terminate(_Reason, _State) -> + ok. + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +spawn(Position) -> + gen_server:start(?MODULE, [Position], []). + +get_state(SpaceObjectPid) -> + gen_server:call(SpaceObjectPid, get_state). diff --git a/src/warp_space_object_server.erl b/src/warp_space_object_server.erl new file mode 100644 index 0000000..b4685de --- /dev/null +++ b/src/warp_space_object_server.erl @@ -0,0 +1,81 @@ +-module(warp_space_object_server). + +-behaviour(gen_server). + +-export([init/1, handle_cast/2, handle_call/3, handle_info/2, terminate/2, code_change/3]). +-export([start_link/0]). +-export([lookup/1, get_sphere/2]). + +-record(state, {space_objects :: term()}). + +start_link() -> + gen_server:start_link({local, ?MODULE}, ?MODULE, [], []). + +% gen_server callbacks +init(_) -> + EmptyWorld = kd_tree:new(), + InitialState = #state{space_objects = EmptyWorld}, + self() ! populate, + {ok, InitialState}. + +handle_cast(_, State) -> + {noreply, State}. + +handle_call({lookup, {_, _, _} = Pos}, _From, #state{space_objects = SpaceObjects} = State) -> + case kd_tree:lookup(Pos, SpaceObjects) of + {error, key_not_found} -> + % error atom feels weird here, especially when checked at spawning time + {reply, {error, space_object_not_found}, State}; + {ok, SpaceObjectPid} -> + {reply, {ok, SpaceObjectPid}, State} + end; +handle_call({get_sphere, Coord, Radius}, _From, #state{space_objects = SpaceObjects} = State) -> + Results = kd_tree:get_sphere(Coord, Radius, SpaceObjects), + {reply, {ok, Results}, State}; +handle_call({lookup, _}, _From, State) -> + {reply, {error, invalid_character_id}, State}; +handle_call(_, _From, State) -> + {reply, {error, undefined_call}, State}. + +handle_info(populate, State) -> + SpaceObjects = populate(45000), + {noreply, State#state{space_objects = SpaceObjects}}; +handle_info(_, State) -> + {noreply, State}. + +terminate(_Reason, _State) -> + ok. + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +% public functions +lookup(SpaceObjectPosition) -> + gen_server:call(?MODULE, {lookup, SpaceObjectPosition}). + +get_sphere(Coord, Radius) -> + gen_server:call(?MODULE, {get_sphere, Coord, Radius}). + +% private functions +populate(N) -> + populate(N, kd_tree:new()). + +% TODO: have parameters for the size of the universe +% TODO: avoid duplicates +populate(0, Tree) -> + Tree; +populate(N, Tree) -> + try + Coord = {rand:uniform(200) - 100, rand:uniform(200) - 100, rand:uniform(200) - 100}, + {ok, Pid} = warp_space_object:spawn(Coord), + Info = warp_space_object:get_state(Pid), + %io:format("Space object created: ~p~n", [Info]), + NewTree = kd_tree:insert(Coord, Pid, Tree) + of + _ -> + populate(N - 1, NewTree) + catch + % just retry when there is already something there + _:_ -> + populate(N, Tree) + end. diff --git a/src/warp_sup.erl b/src/warp_sup.erl new file mode 100644 index 0000000..3bb519e --- /dev/null +++ b/src/warp_sup.erl @@ -0,0 +1,56 @@ +%%%------------------------------------------------------------------- +%% @doc warp top level supervisor. +%% @end +%%%------------------------------------------------------------------- + +-module(warp_sup). + +-behaviour(supervisor). + +-export([start_link/0]). +-export([init/1]). + +-define(SERVER, ?MODULE). + +start_link() -> + supervisor:start_link({local, ?SERVER}, ?MODULE, []). + +%% sup_flags() = #{strategy => strategy(), % optional +%% intensity => non_neg_integer(), % optional +%% period => pos_integer()} % optional +%% child_spec() = #{id => child_id(), % mandatory +%% start => mfargs(), % mandatory +%% restart => restart(), % optional +%% shutdown => shutdown(), % optional +%% type => worker(), % optional +%% modules => modules()} % optional +init([]) -> + SupFlags = #{strategy => one_for_all, intensity => 0, period => 1}, + CharacterServer = #{ + id => warp_character_server, + start => {warp_character_server, start_link, []}, + shutdown => 2000, + restart => permanent, + type => worker, + modules => [warp_character_server] + }, + SpaceObjectServer = #{ + id => warp_space_object_server, + start => {warp_space_object_server, start_link, []}, + shutdown => 2000, + restart => permanent, + type => worker, + modules => [warp_space_object_server] + }, + ShipServer = #{ + id => warp_ship_server, + start => {warp_ship_server, start_link, []}, + shutdown => 2000, + restart => permanent, + type => worker, + modules => [warp_ship_server] + }, + ChildSpecs = [CharacterServer, SpaceObjectServer, ShipServer], + {ok, {SupFlags, ChildSpecs}}. + +%% internal functions