diff --git a/.gitea/workflows/build.yaml b/.gitea/workflows/build.yaml new file mode 100644 index 0000000..eaff5b6 --- /dev/null +++ b/.gitea/workflows/build.yaml @@ -0,0 +1,34 @@ +name: build +run-name: build +on: [push] + +jobs: + build: + runs-on: ubuntu-latest + container: + image: zapashcanon/gitea-ocaml-ci:latest + steps: + - name: checkout + uses: actions/checkout@v4 + - name: depext + run: | + opam install . --depext-only --with-test --with-doc --with-dev-setup -y + - name: setup + run: | + opam install . --deps-only --with-test --with-doc --with-dev-setup -y + - name: build + run: | + opam exec -- dune build @install + - name: test + run: | + opam exec -- dune runtest + - name: lint-doc + run: | + ODOC_WARN_ERROR=true opam exec -- dune build @doc 2> output.txt + $(exit $(wc -l output.txt | cut -d " " -f1)) + - name: lint-fmt + run: | + opam exec -- dune build @fmt || (echo "\n⚠️ please run \`dune fmt\` and try again" && exit 1) + - name: lint-fresh-opam-file + run: | + git diff --exit-code *.opam || (echo "⚠️ please run \`dune build\`, commit the changes to the opam file, and then try again" && exit 1) diff --git a/.ocamlformat b/.ocamlformat index f81fbf5..eb9f4e0 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,4 +1,4 @@ -version=0.23.0 +version=0.27.0 assignment-operator=end-line break-cases=fit break-fun-decl=wrap diff --git a/src/app.ml b/src/app.ml index d213823..2936611 100644 --- a/src/app.ml +++ b/src/app.ml @@ -19,22 +19,22 @@ let config_dir = | Some config_dir -> config_dir let config = - let filename = Filename.concat config_dir "config.scfg" in - if not @@ Sys.file_exists filename then - failwith - @@ Format.sprintf "configuration file `%s` does not exist, please create it" - filename; - Dream.log "config file: %s" filename; - match Scfg.Parse.from_file filename with - | Error e -> failwith e - | Ok config -> config + let filename = Fpath.add_seg config_dir "config.scfg" in + let filename_str = Fpath.to_string filename in + if not @@ Sys.file_exists filename_str then [] + else begin + Dream.log "config file: %s" filename_str; + match Scfg.Parse.from_file filename with + | Error (`Msg e) -> failwith e + | Ok config -> config + end let open_registration = match Scfg.Query.get_dir "open_registration" config with | None -> true | Some open_registration -> ( match Scfg.Query.get_param 0 open_registration with - | Error e -> failwith e + | Error (`Msg e) -> failwith e | Ok "true" -> true | Ok "false" -> false | Ok _unknown -> @@ -47,7 +47,7 @@ let port = | None -> 8080 | Some port -> ( match Scfg.Query.get_param 0 port with - | Error e -> failwith e + | Error (`Msg e) -> failwith e | Ok n -> ( try let n = int_of_string n in @@ -59,10 +59,14 @@ let port = let () = Dream.log "port: %d" port let hostname = + let default_hostname = Format.sprintf "localhost:%d" port in match Scfg.Query.get_dir "hostname" config with - | None -> Format.sprintf "localhost:%d" port + | None -> default_hostname | Some hostname -> - Result.fold ~error:failwith ~ok:Fun.id (Scfg.Query.get_param 0 hostname) + Result.fold + ~error:(fun (`Msg e) -> failwith e) + ~ok:Fun.id + (Scfg.Query.get_param 0 hostname) let () = Dream.log "hostname: %s" hostname @@ -71,24 +75,22 @@ let log = | None -> true | Some log -> ( match Scfg.Query.get_param 0 log with - | Error e -> failwith e + | Error (`Msg e) -> failwith e | Ok "true" -> true | Ok "false" -> false | Ok _unknown -> failwith "invalid `log` value in configuration file" ) let () = Dream.log "log: %b" log -let get_dirs name = - let dirs = Scfg.Query.get_dirs name config in - List.map - (fun dir -> - Result.fold ~error:failwith ~ok:Fun.id (Scfg.Query.get_param 0 dir) ) - dirs +let about = + let default_about = "Pellest is great !" in + match Scfg.Query.get_dir "about" config with + | None -> default_about + | Some about -> ( + match Scfg.Query.get_param 0 about with + | Error (`Msg e) -> failwith e + | Ok about -> about ) let random_state = Random.State.make_self_init () let () = Random.set_state random_state - -let about = - (* TODO read from about.txt *) - "This is pellest" diff --git a/src/asset.ml b/src/asset.ml new file mode 100644 index 0000000..f02f0d6 --- /dev/null +++ b/src/asset.ml @@ -0,0 +1,10 @@ +let loader _root path _request = + match Content.read ("assets/" ^ path) with + | None -> + Dream.empty `Not_Found + (* Template.err (`Bad_Request, "file doesn't exist") *) + | Some asset -> + (* TODO cache-control: ~headers:[ ("Cache-Control", "max-age=151200") ] *) + Dream.respond asset + +let get = Dream.static ~loader "" diff --git a/src/content/assets/css/leaflet.css b/src/content/assets/css/leaflet.css deleted file mode 100644 index 3385b5e..0000000 --- a/src/content/assets/css/leaflet.css +++ /dev/null @@ -1,640 +0,0 @@ -/* required styles */ - -.leaflet-pane, -.leaflet-tile, -.leaflet-marker-icon, -.leaflet-marker-shadow, -.leaflet-tile-container, -.leaflet-pane > svg, -.leaflet-pane > canvas, -.leaflet-zoom-box, -.leaflet-image-layer, -.leaflet-layer { - position: absolute; - left: 0; - top: 0; - } -.leaflet-container { - overflow: hidden; - } -.leaflet-tile, -.leaflet-marker-icon, -.leaflet-marker-shadow { - -webkit-user-select: none; - -moz-user-select: none; - user-select: none; - -webkit-user-drag: none; - } -/* Prevents IE11 from highlighting tiles in blue */ -.leaflet-tile::selection { - background: transparent; -} -/* Safari renders non-retina tile on retina better with this, but Chrome is worse */ -.leaflet-safari .leaflet-tile { - image-rendering: -webkit-optimize-contrast; - } -/* hack that prevents hw layers "stretching" when loading new tiles */ -.leaflet-safari .leaflet-tile-container { - width: 1600px; - height: 1600px; - -webkit-transform-origin: 0 0; - } -.leaflet-marker-icon, -.leaflet-marker-shadow { - display: block; - } -/* .leaflet-container svg: reset svg max-width decleration shipped in Joomla! (joomla.org) 3.x */ -/* .leaflet-container img: map is broken in FF if you have max-width: 100% on tiles */ -.leaflet-container .leaflet-overlay-pane svg, -.leaflet-container .leaflet-marker-pane img, -.leaflet-container .leaflet-shadow-pane img, -.leaflet-container .leaflet-tile-pane img, -.leaflet-container img.leaflet-image-layer, -.leaflet-container .leaflet-tile { - max-width: none !important; - max-height: none !important; - } - -.leaflet-container.leaflet-touch-zoom { - -ms-touch-action: pan-x pan-y; - touch-action: pan-x pan-y; - } -.leaflet-container.leaflet-touch-drag { - -ms-touch-action: pinch-zoom; - /* Fallback for FF which doesn't support pinch-zoom */ - touch-action: none; - touch-action: pinch-zoom; -} -.leaflet-container.leaflet-touch-drag.leaflet-touch-zoom { - -ms-touch-action: none; - touch-action: none; -} -.leaflet-container { - -webkit-tap-highlight-color: transparent; -} -.leaflet-container a { - -webkit-tap-highlight-color: rgba(51, 181, 229, 0.4); -} -.leaflet-tile { - filter: inherit; - visibility: hidden; - } -.leaflet-tile-loaded { - visibility: inherit; - } -.leaflet-zoom-box { - width: 0; - height: 0; - -moz-box-sizing: border-box; - box-sizing: border-box; - z-index: 800; - } -/* workaround for https://bugzilla.mozilla.org/show_bug.cgi?id=888319 */ -.leaflet-overlay-pane svg { - -moz-user-select: none; - } - -.leaflet-pane { z-index: 400; } - -.leaflet-tile-pane { z-index: 200; } -.leaflet-overlay-pane { z-index: 400; } -.leaflet-shadow-pane { z-index: 500; } -.leaflet-marker-pane { z-index: 600; } -.leaflet-tooltip-pane { z-index: 650; } -.leaflet-popup-pane { z-index: 700; } - -.leaflet-map-pane canvas { z-index: 100; } -.leaflet-map-pane svg { z-index: 200; } - -.leaflet-vml-shape { - width: 1px; - height: 1px; - } -.lvml { - behavior: url(#default#VML); - display: inline-block; - position: absolute; - } - - -/* control positioning */ - -.leaflet-control { - position: relative; - z-index: 800; - pointer-events: visiblePainted; /* IE 9-10 doesn't have auto */ - pointer-events: auto; - } -.leaflet-top, -.leaflet-bottom { - position: absolute; - z-index: 1000; - pointer-events: none; - } -.leaflet-top { - top: 0; - } -.leaflet-right { - right: 0; - } -.leaflet-bottom { - bottom: 0; - } -.leaflet-left { - left: 0; - } -.leaflet-control { - float: left; - clear: both; - } -.leaflet-right .leaflet-control { - float: right; - } -.leaflet-top .leaflet-control { - margin-top: 10px; - } -.leaflet-bottom .leaflet-control { - margin-bottom: 10px; - } -.leaflet-left .leaflet-control { - margin-left: 10px; - } -.leaflet-right .leaflet-control { - margin-right: 10px; - } - - -/* zoom and fade animations */ - -.leaflet-fade-anim .leaflet-tile { - will-change: opacity; - } -.leaflet-fade-anim .leaflet-popup { - opacity: 0; - -webkit-transition: opacity 0.2s linear; - -moz-transition: opacity 0.2s linear; - transition: opacity 0.2s linear; - } -.leaflet-fade-anim .leaflet-map-pane .leaflet-popup { - opacity: 1; - } -.leaflet-zoom-animated { - -webkit-transform-origin: 0 0; - -ms-transform-origin: 0 0; - transform-origin: 0 0; - } -.leaflet-zoom-anim .leaflet-zoom-animated { - will-change: transform; - } -.leaflet-zoom-anim .leaflet-zoom-animated { - -webkit-transition: -webkit-transform 0.25s cubic-bezier(0,0,0.25,1); - -moz-transition: -moz-transform 0.25s cubic-bezier(0,0,0.25,1); - transition: transform 0.25s cubic-bezier(0,0,0.25,1); - } -.leaflet-zoom-anim .leaflet-tile, -.leaflet-pan-anim .leaflet-tile { - -webkit-transition: none; - -moz-transition: none; - transition: none; - } - -.leaflet-zoom-anim .leaflet-zoom-hide { - visibility: hidden; - } - - -/* cursors */ - -.leaflet-interactive { - cursor: pointer; - } -.leaflet-grab { - cursor: -webkit-grab; - cursor: -moz-grab; - cursor: grab; - } -.leaflet-crosshair, -.leaflet-crosshair .leaflet-interactive { - cursor: crosshair; - } -.leaflet-popup-pane, -.leaflet-control { - cursor: auto; - } -.leaflet-dragging .leaflet-grab, -.leaflet-dragging .leaflet-grab .leaflet-interactive, -.leaflet-dragging .leaflet-marker-draggable { - cursor: move; - cursor: -webkit-grabbing; - cursor: -moz-grabbing; - cursor: grabbing; - } - -/* marker & overlays interactivity */ -.leaflet-marker-icon, -.leaflet-marker-shadow, -.leaflet-image-layer, -.leaflet-pane > svg path, -.leaflet-tile-container { - pointer-events: none; - } - -.leaflet-marker-icon.leaflet-interactive, -.leaflet-image-layer.leaflet-interactive, -.leaflet-pane > svg path.leaflet-interactive, -svg.leaflet-image-layer.leaflet-interactive path { - pointer-events: visiblePainted; /* IE 9-10 doesn't have auto */ - pointer-events: auto; - } - -/* visual tweaks */ - -.leaflet-container { - background: #ddd; - outline: 0; - } -.leaflet-container a { - color: #0078A8; - } -.leaflet-container a.leaflet-active { - outline: 2px solid orange; - } -.leaflet-zoom-box { - border: 2px dotted #38f; - background: rgba(255,255,255,0.5); - } - - -/* general typography */ -.leaflet-container { - font: 12px/1.5 "Helvetica Neue", Arial, Helvetica, sans-serif; - } - - -/* general toolbar styles */ - -.leaflet-bar { - box-shadow: 0 1px 5px rgba(0,0,0,0.65); - border-radius: 4px; - } -.leaflet-bar a, -.leaflet-bar a:hover { - background-color: #fff; - border-bottom: 1px solid #ccc; - width: 26px; - height: 26px; - line-height: 26px; - display: block; - text-align: center; - text-decoration: none; - color: black; - } -.leaflet-bar a, -.leaflet-control-layers-toggle { - background-position: 50% 50%; - background-repeat: no-repeat; - display: block; - } -.leaflet-bar a:hover { - background-color: #f4f4f4; - } -.leaflet-bar a:first-child { - border-top-left-radius: 4px; - border-top-right-radius: 4px; - } -.leaflet-bar a:last-child { - border-bottom-left-radius: 4px; - border-bottom-right-radius: 4px; - border-bottom: none; - } -.leaflet-bar a.leaflet-disabled { - cursor: default; - background-color: #f4f4f4; - color: #bbb; - } - -.leaflet-touch .leaflet-bar a { - width: 30px; - height: 30px; - line-height: 30px; - } -.leaflet-touch .leaflet-bar a:first-child { - border-top-left-radius: 2px; - border-top-right-radius: 2px; - } -.leaflet-touch .leaflet-bar a:last-child { - border-bottom-left-radius: 2px; - border-bottom-right-radius: 2px; - } - -/* zoom control */ - -.leaflet-control-zoom-in, -.leaflet-control-zoom-out { - font: bold 18px 'Lucida Console', Monaco, monospace; - text-indent: 1px; - } - -.leaflet-touch .leaflet-control-zoom-in, .leaflet-touch .leaflet-control-zoom-out { - font-size: 22px; - } - - -/* layers control */ - -.leaflet-control-layers { - box-shadow: 0 1px 5px rgba(0,0,0,0.4); - background: #fff; - border-radius: 5px; - } -.leaflet-control-layers-toggle { - background-image: url(/assets/img/layers.png); - width: 36px; - height: 36px; - } -.leaflet-retina .leaflet-control-layers-toggle { - background-image: url(/assets/img/layers-2x.png); - background-size: 26px 26px; - } -.leaflet-touch .leaflet-control-layers-toggle { - width: 44px; - height: 44px; - } -.leaflet-control-layers .leaflet-control-layers-list, -.leaflet-control-layers-expanded .leaflet-control-layers-toggle { - display: none; - } -.leaflet-control-layers-expanded .leaflet-control-layers-list { - display: block; - position: relative; - } -.leaflet-control-layers-expanded { - padding: 6px 10px 6px 6px; - color: #333; - background: #fff; - } -.leaflet-control-layers-scrollbar { - overflow-y: scroll; - overflow-x: hidden; - padding-right: 5px; - } -.leaflet-control-layers-selector { - margin-top: 2px; - position: relative; - top: 1px; - } -.leaflet-control-layers label { - display: block; - } -.leaflet-control-layers-separator { - height: 0; - border-top: 1px solid #ddd; - margin: 5px -10px 5px -6px; - } - -/* Default icon URLs */ -.leaflet-default-icon-path { - background-image: url(/assets/img/marker-icon.png); - } - - -/* attribution and scale controls */ - -.leaflet-container .leaflet-control-attribution { - background: #fff; - background: rgba(255, 255, 255, 0.7); - margin: 0; - } -.leaflet-control-attribution, -.leaflet-control-scale-line { - padding: 0 5px; - color: #333; - } -.leaflet-control-attribution a { - text-decoration: none; - } -.leaflet-control-attribution a:hover { - text-decoration: underline; - } -.leaflet-container .leaflet-control-attribution, -.leaflet-container .leaflet-control-scale { - font-size: 11px; - } -.leaflet-left .leaflet-control-scale { - margin-left: 5px; - } -.leaflet-bottom .leaflet-control-scale { - margin-bottom: 5px; - } -.leaflet-control-scale-line { - border: 2px solid #777; - border-top: none; - line-height: 1.1; - padding: 2px 5px 1px; - font-size: 11px; - white-space: nowrap; - overflow: hidden; - -moz-box-sizing: border-box; - box-sizing: border-box; - - background: #fff; - background: rgba(255, 255, 255, 0.5); - } -.leaflet-control-scale-line:not(:first-child) { - border-top: 2px solid #777; - border-bottom: none; - margin-top: -2px; - } -.leaflet-control-scale-line:not(:first-child):not(:last-child) { - border-bottom: 2px solid #777; - } - -.leaflet-touch .leaflet-control-attribution, -.leaflet-touch .leaflet-control-layers, -.leaflet-touch .leaflet-bar { - box-shadow: none; - } -.leaflet-touch .leaflet-control-layers, -.leaflet-touch .leaflet-bar { - border: 2px solid rgba(0,0,0,0.2); - background-clip: padding-box; - } - - -/* popup */ - -.leaflet-popup { - position: absolute; - text-align: center; - margin-bottom: 20px; - } -.leaflet-popup-content-wrapper { - padding: 1px; - text-align: left; - border-radius: 12px; - } -.leaflet-popup-content { - margin: 13px 19px; - line-height: 1.4; - } -.leaflet-popup-content p { - margin: 18px 0; - } -.leaflet-popup-tip-container { - width: 40px; - height: 20px; - position: absolute; - left: 50%; - margin-left: -20px; - overflow: hidden; - pointer-events: none; - } -.leaflet-popup-tip { - width: 17px; - height: 17px; - padding: 1px; - - margin: -10px auto 0; - - -webkit-transform: rotate(45deg); - -moz-transform: rotate(45deg); - -ms-transform: rotate(45deg); - transform: rotate(45deg); - } -.leaflet-popup-content-wrapper, -.leaflet-popup-tip { - background: white; - color: #333; - box-shadow: 0 3px 14px rgba(0,0,0,0.4); - } -.leaflet-container a.leaflet-popup-close-button { - position: absolute; - top: 0; - right: 0; - padding: 4px 4px 0 0; - border: none; - text-align: center; - width: 18px; - height: 14px; - font: 16px/14px Tahoma, Verdana, sans-serif; - color: #c3c3c3; - text-decoration: none; - font-weight: bold; - background: transparent; - } -.leaflet-container a.leaflet-popup-close-button:hover { - color: #999; - } -.leaflet-popup-scrolled { - overflow: auto; - border-bottom: 1px solid #ddd; - border-top: 1px solid #ddd; - } - -.leaflet-oldie .leaflet-popup-content-wrapper { - -ms-zoom: 1; - } -.leaflet-oldie .leaflet-popup-tip { - width: 24px; - margin: 0 auto; - - -ms-filter: "progid:DXImageTransform.Microsoft.Matrix(M11=0.70710678, M12=0.70710678, M21=-0.70710678, M22=0.70710678)"; - filter: progid:DXImageTransform.Microsoft.Matrix(M11=0.70710678, M12=0.70710678, M21=-0.70710678, M22=0.70710678); - } -.leaflet-oldie .leaflet-popup-tip-container { - margin-top: -1px; - } - -.leaflet-oldie .leaflet-control-zoom, -.leaflet-oldie .leaflet-control-layers, -.leaflet-oldie .leaflet-popup-content-wrapper, -.leaflet-oldie .leaflet-popup-tip { - border: 1px solid #999; - } - - -/* div icon */ - -.leaflet-div-icon { - background: #fff; - border: 1px solid #666; - } - - -/* Tooltip */ -/* Base styles for the element that has a tooltip */ -.leaflet-tooltip { - position: absolute; - padding: 6px; - background-color: #fff; - border: 1px solid #fff; - border-radius: 3px; - color: #222; - white-space: nowrap; - -webkit-user-select: none; - -moz-user-select: none; - -ms-user-select: none; - user-select: none; - pointer-events: none; - box-shadow: 0 1px 3px rgba(0,0,0,0.4); - } -.leaflet-tooltip.leaflet-clickable { - cursor: pointer; - pointer-events: auto; - } -.leaflet-tooltip-top:before, -.leaflet-tooltip-bottom:before, -.leaflet-tooltip-left:before, -.leaflet-tooltip-right:before { - position: absolute; - pointer-events: none; - border: 6px solid transparent; - background: transparent; - content: ""; - } - -/* Directions */ - -.leaflet-tooltip-bottom { - margin-top: 6px; -} -.leaflet-tooltip-top { - margin-top: -6px; -} -.leaflet-tooltip-bottom:before, -.leaflet-tooltip-top:before { - left: 50%; - margin-left: -6px; - } -.leaflet-tooltip-top:before { - bottom: 0; - margin-bottom: -12px; - border-top-color: #fff; - } -.leaflet-tooltip-bottom:before { - top: 0; - margin-top: -12px; - margin-left: -6px; - border-bottom-color: #fff; - } -.leaflet-tooltip-left { - margin-left: -6px; -} -.leaflet-tooltip-right { - margin-left: 6px; -} -.leaflet-tooltip-left:before, -.leaflet-tooltip-right:before { - top: 50%; - margin-top: -6px; - } -.leaflet-tooltip-left:before { - right: 0; - margin-right: -12px; - border-left-color: #fff; - } -.leaflet-tooltip-right:before { - left: 0; - margin-left: -12px; - border-right-color: #fff; - } diff --git a/src/content/assets/css/style.css b/src/content/assets/css/style.css index ac08288..7d57117 100644 --- a/src/content/assets/css/style.css +++ b/src/content/assets/css/style.css @@ -5,13 +5,17 @@ html { body { height: 100%; padding-top: 0rem; - color: #5a5a5a; - background-color: #e8eaf6; + color: #af8e6c; + background-color: #2f341f; line-height: 1.6; font-size: 18px; } -#page-title { +a { + color: #ec44ee +} + +h1 { text-align: center; } @@ -19,3 +23,7 @@ main { height: 100%; width: 100%; } + +.centered { + text-align: center; +} diff --git a/src/content/assets/img/favicon.png b/src/content/assets/img/favicon.png new file mode 100644 index 0000000..418307c Binary files /dev/null and b/src/content/assets/img/favicon.png differ diff --git a/src/content/assets/img/grass.png b/src/content/assets/img/grass.png new file mode 100644 index 0000000..31641ec Binary files /dev/null and b/src/content/assets/img/grass.png differ diff --git a/src/content/assets/img/layers-2x.png b/src/content/assets/img/layers-2x.png deleted file mode 100644 index 200c333..0000000 Binary files a/src/content/assets/img/layers-2x.png and /dev/null differ diff --git a/src/content/assets/img/layers.png b/src/content/assets/img/layers.png deleted file mode 100644 index 1a72e57..0000000 Binary files a/src/content/assets/img/layers.png and /dev/null differ diff --git a/src/content/assets/img/mana.png b/src/content/assets/img/mana.png new file mode 100644 index 0000000..34214c0 Binary files /dev/null and b/src/content/assets/img/mana.png differ diff --git a/src/content/assets/img/mana.xcf b/src/content/assets/img/mana.xcf new file mode 100644 index 0000000..4856ce6 Binary files /dev/null and b/src/content/assets/img/mana.xcf differ diff --git a/src/content/assets/img/marker-icon-2x.png b/src/content/assets/img/marker-icon-2x.png deleted file mode 100644 index 88f9e50..0000000 Binary files a/src/content/assets/img/marker-icon-2x.png and /dev/null differ diff --git a/src/content/assets/img/marker-icon.png b/src/content/assets/img/marker-icon.png deleted file mode 100644 index 950edf2..0000000 Binary files a/src/content/assets/img/marker-icon.png and /dev/null differ diff --git a/src/content/assets/img/marker-shadow.png b/src/content/assets/img/marker-shadow.png deleted file mode 100644 index 9fd2979..0000000 Binary files a/src/content/assets/img/marker-shadow.png and /dev/null differ diff --git a/src/content/assets/img/papy_down.png b/src/content/assets/img/papy_down.png new file mode 100644 index 0000000..2a1eb0c Binary files /dev/null and b/src/content/assets/img/papy_down.png differ diff --git a/src/content/assets/img/papy_left.png b/src/content/assets/img/papy_left.png new file mode 100644 index 0000000..571ebaa Binary files /dev/null and b/src/content/assets/img/papy_left.png differ diff --git a/src/content/assets/img/papy_right.png b/src/content/assets/img/papy_right.png new file mode 100644 index 0000000..3e12f37 Binary files /dev/null and b/src/content/assets/img/papy_right.png differ diff --git a/src/content/assets/img/papy_top.png b/src/content/assets/img/papy_top.png new file mode 100644 index 0000000..61698e4 Binary files /dev/null and b/src/content/assets/img/papy_top.png differ diff --git a/src/content/assets/img/papy_up.png b/src/content/assets/img/papy_up.png new file mode 100644 index 0000000..61698e4 Binary files /dev/null and b/src/content/assets/img/papy_up.png differ diff --git a/src/content/assets/img/tree0.png b/src/content/assets/img/tree0.png new file mode 100644 index 0000000..0ff7004 Binary files /dev/null and b/src/content/assets/img/tree0.png differ diff --git a/src/content/assets/img/tree1.png b/src/content/assets/img/tree1.png new file mode 100644 index 0000000..ed64a1a Binary files /dev/null and b/src/content/assets/img/tree1.png differ diff --git a/src/content/assets/img/water.png b/src/content/assets/img/water.png new file mode 100644 index 0000000..ebf821e Binary files /dev/null and b/src/content/assets/img/water.png differ diff --git a/src/content/assets/img/wheat.png b/src/content/assets/img/wheat.png new file mode 100644 index 0000000..c971f81 Binary files /dev/null and b/src/content/assets/img/wheat.png differ diff --git a/src/content/assets/js/dune b/src/content/assets/js/dune index 6e10df5..2883df4 100644 --- a/src/content/assets/js/dune +++ b/src/content/assets/js/dune @@ -1,8 +1,8 @@ (rule - (target client.js) + (target island_client.js) (deps - (file ../../../js/client.bc.js)) + (file ../../../island_client.bc.js)) (action (with-stdout-to %{target} - (cat ../../../js/client.bc.js)))) + (cat ../../../island_client.bc.js)))) diff --git a/src/db.ml b/src/db.ml index 41e9e97..deac35d 100644 --- a/src/db.ml +++ b/src/db.ml @@ -3,25 +3,38 @@ open Caqti_request.Infix let db_root = App.data_dir let () = - match Bos.OS.Dir.create (Fpath.v db_root) with - | Ok true -> Dream.log "created %s" db_root - | Ok false -> Dream.log "%s already exists" db_root + match Bos.OS.Dir.create db_root with + | Ok true -> Dream.log "created %s" (Fpath.to_string db_root) + | Ok false -> Dream.log "%s already exists" (Fpath.to_string db_root) | Error (`Msg _) -> - Dream.warning (fun log -> log "error when creating %s" db_root) + Dream.warning (fun log -> + log "error when creating %s" (Fpath.to_string db_root) ) -let db = Filename.concat db_root (App.App_id.application ^ ".db") +let db = Fpath.add_seg db_root (App.App_id.application ^ ".db") -let db_uri = Format.sprintf "sqlite3://%s" db +let db_uri = Format.sprintf "sqlite3://%s" (Fpath.to_string db) module Db = (val Caqti_blocking.connect (Uri.of_string db_uri) |> Caqti_blocking.or_fail) +let set_foreign_keys_on = Caqti_type.(unit ->. unit) "PRAGMA foreign_keys = ON" + +let create_dream_session = + Caqti_type.(unit ->. unit) + "CREATE TABLE IF NOT EXISTS dream_session (id TEXT PRIMARY KEY, label TEXT \ + NOT NULL, expires_at REAL NOT NULL, payload TEXT NOT NULL)" + let () = - let set_foreign_keys_on = - Caqti_type.(unit ->. unit) "PRAGMA foreign_keys = ON" + let exec_unsafe q v = + match Db.exec q v with + | Error e -> + Dream.error (fun log -> log "%s" (Caqti_error.show e)); + exit 1 + | Ok () -> () in - if Result.is_error (Db.exec set_foreign_keys_on ()) then - Dream.error (fun log -> log "can't set foreign_keys on") + exec_unsafe set_foreign_keys_on (); + exec_unsafe create_dream_session (); + () let () = let query = @@ -36,7 +49,10 @@ let () = exit 1 let unwrap_err = function - | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e)) + | Error e -> + Error + ( `Internal_Server_Error + , Format.sprintf "db error: %s" (Caqti_error.show e) ) | Ok _ as ok -> ok let exec q v = Db.exec q v |> unwrap_err diff --git a/src/dune b/src/dune index 8352fbb..b35e495 100644 --- a/src/dune +++ b/src/dune @@ -2,19 +2,21 @@ (name pellest) (modules app + asset content - pellest - util - template - home - register - login - user - syntax db - tyx_util) + home + island + login + logout + pellest + register + syntax + template + tyx_util + user + ws) (libraries - uuidm bos caqti caqti.blocking @@ -22,23 +24,36 @@ directories dream emile + shared fpath lambdasoup lwt safepass scfg - uri tyxml tyxml.functor - yojson) + uri + uuidm + unix) (preprocess (pps lwt_ppx))) +(executable + (name island_client) + (modules island_client ws_client) + (libraries js_of_ocaml brr shared) + (modes js)) + +(library + (name shared) + (modules log map network state time) + (libraries)) + (rule (target content.ml) (deps (source_tree content) - (file content/assets/js/client.js)) + island_client.bc.js) (action (with-stdout-to %{null} diff --git a/src/home.ml b/src/home.ml index 2b03752..d870dc7 100644 --- a/src/home.ml +++ b/src/home.ml @@ -1,11 +1,21 @@ open Tyxml.Html -let f _request = - let page_title = "Pellest is the best game ever!" in - let about = div [ txt App.about ] in - let link_to_register = - div [ a ~a:[ a_href "/register" ] [ txt "Register" ] ] +let get request = + let title = "Pellest is the best game ever!" in + let page = + if User.is_logged_in request then + let welcome = + div [ txt (Format.sprintf "welcome %s" (User.get_nick_unsafe request)) ] + in + let island = + div [ a ~a:[ a_href "/island" ] [ txt "🏝️ Go to your island !" ] ] + in + let logout = div [ a ~a:[ a_href "/logout" ] [ txt "Logout" ] ] in + [ welcome; island; logout ] + else + let about = div [ txt App.about ] in + let register = div [ a ~a:[ a_href "/register" ] [ txt "Register" ] ] in + let login = div [ a ~a:[ a_href "/login" ] [ txt "Login" ] ] in + [ about; login; register ] in - let link_to_login = div [ a ~a:[ a_href "/login" ] [ txt "Login" ] ] in - let page = div [ about; link_to_login; link_to_register ] in - Template.render ~page_title ~scripts:[] page + Template.render ~title ~scripts:[] (div page) diff --git a/src/island.ml b/src/island.ml new file mode 100644 index 0000000..013bfac --- /dev/null +++ b/src/island.ml @@ -0,0 +1,71 @@ +open Tyxml.Html +open Syntax + +let mk_img hidden name = + let a = [ a_id name ] in + img + ~src:(Format.sprintf "/assets/img/%s.png" name) + ~alt:name + ~a:(if hidden then a_hidden () :: a else a) + () + +let get request = + let** () = User.assert_logged request in + + let title = "Your island" in + + let topbar = + let mana_img = mk_img false "mana" in + let mana_lvl = span ~a:[ a_id "mana_lvl" ] [ txt "0" ] in + let wheat_img = mk_img false "wheat" in + let wheat_lvl = span ~a:[ a_id "wheat_lvl" ] [ txt "0" ] in + div + ~a:[ a_class [ "centered" ] ] + [ mana_img; mana_lvl; wheat_img; wheat_lvl ] + in + + let canvas = + div + ~a:[ a_class [ "centered" ] ] + [ canvas + ~a:[ a_id "canvas" ] + [ txt "please update your browser or enable javascript" ] + ] + in + + let canvas_images = + div + @@ List.map (mk_img true) + [ "grass" + ; "papy_left" + ; "papy_right" + ; "papy_down" + ; "papy_up" + ; "water" + ; "wheat" + ] + in + + let bottombar = + let medidate_button = + button ~a:[ a_id "medidate_button" ] [ txt "Medidate" ] + in + let plant_wheat_button = + button ~a:[ a_id "plant_wheat_button" ] [ txt "Plant wheat" ] + in + div ~a:[ a_class [ "centered" ] ] [ medidate_button; plant_wheat_button ] + in + + let page = div [ topbar; canvas; bottombar; canvas_images ] in + + let js = + script + ~a: + [ (*a_mime_type "text/javascript" ; *) + a_src "/assets/js/island_client.js" + ; a_defer () + ] + (txt "") + in + + Template.render ~title ~scripts:[ js ] page diff --git a/src/island_client.ml b/src/island_client.ml new file mode 100644 index 0000000..1f25a64 --- /dev/null +++ b/src/island_client.ml @@ -0,0 +1,300 @@ +open Brr +open Brr_io +open Brr_canvas +open Shared + +module G = struct + include Brr.G + + let request_animation_frame f = + (ignore : int -> unit) @@ Brr.G.request_animation_frame f +end + +let get_el id = + match Document.find_el_by_id G.document (Jstr.of_string id) with + | None -> Log.err "could not find element with id `%s`" id + | Some el -> el + +let tile_size = 40 + +let width = 875 + +let height = 675 + +let canvas = + let el = get_el "canvas" in + Canvas.of_el el + +let context = C2d.get_context canvas + +let tiles_per_w = + let n = width / tile_size in + if n mod 2 = 0 then n - 1 else n + +let tiles_per_h = + let n = height / tile_size in + if n mod 2 = 0 then n - 1 else n + +let orig_x = (width - (tiles_per_w * tile_size)) / 2 + +let orig_y = (height - (tiles_per_h * tile_size)) / 2 + +let grass = C2d.image_src_of_el (get_el "grass") + +let papy_left = C2d.image_src_of_el (get_el "papy_left") + +let papy_right = C2d.image_src_of_el (get_el "papy_right") + +let papy_down = C2d.image_src_of_el (get_el "papy_down") + +let papy_up = C2d.image_src_of_el (get_el "papy_up") + +let water = C2d.image_src_of_el (get_el "water") + +let wheat = C2d.image_src_of_el (get_el "wheat") + +let draw_canvas = + let offset_conv = + let m = float_of_int @@ (tile_size / 2) in + fun offset -> m *. offset + in + let papy_x = float_of_int (width - tile_size) /. 2. in + let papy_y = (float_of_int height /. 2.) -. (float_of_int tile_size *. 1.5) in + let half_tiles_per_w = tiles_per_w / 2 in + let half_tiles_per_h = tiles_per_h / 2 in + fun state -> + let open State in + (* TODO: it could be possible to optimize starting/ending index by looking at the offset *) + for x = -2 to tiles_per_w + 1 do + let map_x = x + state.player_pos.x - half_tiles_per_w in + let tile_x = + float_of_int ((x * tile_size) + orig_x) +. offset_conv state.offset_x + in + for y = -2 to tiles_per_h + 1 do + let map_y = y + state.player_pos.y - half_tiles_per_h in + let tile_y = + float_of_int ((y * tile_size) + orig_y) +. offset_conv state.offset_y + in + let tile_img = + match Map.get_tile_kind ~x:map_x ~y:map_y state.map with + | Grass -> grass + | Water -> water + | Black -> water + | Wheat -> wheat + in + C2d.draw_image context tile_img ~x:tile_x ~y:tile_y + done + done; + let papy = + match state.player_pos.dir with + | Left -> papy_left + | Right -> papy_right + | Down -> papy_down + | Up -> papy_up + in + C2d.draw_image context papy ~x:papy_x ~y:papy_y + +let draw_topbar state = + (* draw mana level *) + let mana_lvl = Jv.get Jv.global "mana_lvl" in + Jv.set mana_lvl "innerHTML" + (Jv.of_string @@ string_of_int state.Shared.State.mana); + (* draw wheat level *) + let wheat_lvl = Jv.get Jv.global "wheat_lvl" in + Jv.set wheat_lvl "innerHTML" (Jv.of_string @@ string_of_int state.wheat) + +(* queue for action to be done *) +let input_queue = Queue.create () + +(* queue for action' to apply to client state *) +let to_apply_queue : State.action' Queue.t = Queue.create () + +let send_action state = function + (* actions we don't need to send to the server *) + (* + | (State.Move_offset _ | Move _) as action -> begin + match State.check_action state action with + | Error e -> + (* TODO: display this in the window *) + Log.debug "invalid action: %s@\n" e + | Ok actions -> List.iter (fun a -> Queue.add a to_apply_queue) actions + end + *) + (* actions we want to send to the server *) + | (State.Move_offset _ | Move _ | Meditate | Plant_wheat) as action -> ( + match State.check_action state action with + | Error e -> + (* TODO: display this in the window *) + Log.debug "invalid action: %s@\n" e + | Ok _actions -> + Log.debug "sending action %a to server@\n" State.pp_action action; + Ws_client.send (Network.Action_msg action) ) + +module Kb : sig + (* this keeps an ordered sequence of unique values, + it's the responsability of the caller to make sure + the same element is not added twice ! *) + + type t = string + + val add : t -> unit + + val rm : t -> unit + + val get_last : unit -> t option +end = struct + type t = string + + let last = ref [] + + let add k = last := k :: !last + + let rm k = last := List.filter (( <> ) k) !last + + let get_last () = match !last with [] -> None | key :: _keys -> Some key +end + +let keypress_handler = + (* be careful to add in the correct array ! *) + let codes = Hashtbl.create 512 in + Array.iter + (fun code -> Hashtbl.add codes code ()) + [| "ArrowDown" + ; "ArrowLeft" + ; "ArrowRight" + ; "ArrowUp" + ; "KeyA" + ; "KeyD" + ; "KeyS" + ; "KeyW" + |]; + let keys = Hashtbl.create 512 in + Array.iter (fun key -> Hashtbl.add keys key ()) [| "m"; "p" |]; + (* TODO: I'm not sure the Hashtbl business is worth it. + Before, we were matching on values instead of calling Hashtbl.mem. + It should be better with Hashtbl but it wasn't benchmarked. *) + fun ~down -> + let f = if down then Kb.add else Kb.rm in + fun ev -> + let ev = Ev.as_type ev in + (* repeat is true if and only if an event as already been sent since the key has been pressed + in this case, it's already in the sequence so we just skip it, we know it'll eventually be + released on keydown before it can appears again *) + if not @@ Ev.Keyboard.repeat ev then + let code = Ev.Keyboard.code ev |> Jstr.to_string in + if Hashtbl.mem codes code then f code + else + let key = Ev.Keyboard.key ev |> Jstr.to_string in + if Hashtbl.mem keys key then f key + +let apply_last_key () = + let open State in + Kb.get_last () + |> Option.iter (fun code_or_key -> + let act = + (* when you add something here, don't forget to add the corresponding case in `keypress_handler` *) + match code_or_key with + | "KeyW" | "ArrowUp" -> Move_offset Up + | "KeyA" | "ArrowLeft" -> Move_offset Left + | "KeyS" | "ArrowDown" -> Move_offset Down + | "KeyD" | "ArrowRight" -> Move_offset Right + | "m" -> Meditate + | "p" -> Plant_wheat + | _ -> + (* if this happen, it means we're adding + bad values in `keypress_handler` + and that should be fixed *) + assert false + in + Queue.add act input_queue ) + +let render state = + draw_canvas state; + draw_topbar state + +let rec game_loop state last_auto_update timestamp = + render state; + let should_auto_update = + timestamp -. last_auto_update + >= Time.ms_to_float (Time.s_to_ms State.auto_update_rate) + in + + let last_auto_update = + if should_auto_update then timestamp else last_auto_update + in + apply_last_key (); + let state = + (* apply queue of actions *) + let state = Queue.fold State.perform_action state to_apply_queue in + Queue.clear to_apply_queue; + (* send input action to server *) + Queue.iter (send_action state) input_queue; + Queue.clear input_queue; + (* state auto update *) + if should_auto_update then State.auto_update state else state + in + G.request_animation_frame (game_loop state last_auto_update) + +let () = + (* init canvas *) + Canvas.set_w canvas width; + Canvas.set_h canvas height; + C2d.set_fill_style context (C2d.color (Jstr.v "#FF1188")); + C2d.fill_rect context ~x:0. ~y:0. ~w:(float_of_int width) + ~h:(float_of_int height); + + (* get state from server*) + let initial_state_fut = Ev.next Message.Ev.message Ws_client.ws_target in + + (* attach message listener to update state *) + Ws_client.on_update_state_message (fun server_msg -> + match server_msg with + | Full_state _state -> + (* TODO reset state to received state *) + Log.debug "received `Full_state` message@\n" + | Update_result res -> ( + match res with + | Error e -> Log.debug "received update result error: %s@\n" e + | Ok actions -> + List.iter (fun action -> Queue.add action to_apply_queue) actions ) ); + + (* bind keys *) + let _e : Ev.listener = + Ev.listen Ev.keydown + (keypress_handler ~down:true) + (Window.as_target G.window) + in + let _e : Ev.listener = + Ev.listen Ev.keyup + (keypress_handler ~down:false) + (Window.as_target G.window) + in + + (* bind buttons *) + let _e : Ev.listener = + let meditate_button = + Jv.get Jv.global "medidate_button" |> Ev.target_of_jv + in + Ev.listen Ev.click + (fun _ev -> Queue.add State.Meditate input_queue) + meditate_button + in + + let _e : Ev.listener = + let plant_wheat_button = + Jv.get Jv.global "plant_wheat_button" |> Ev.target_of_jv + in + Ev.listen Ev.click + (fun _ev -> Queue.add (State.Plant_wheat : State.action) input_queue) + plant_wheat_button + in + + Fut.await initial_state_fut (fun msg -> + match Ws_client.to_server_msg msg with + | Update_result _res_msg -> + Log.err + "invalid first server message received; received Update expected \ + Full_state" + | Full_state state -> + (* start game *) + G.request_animation_frame (game_loop state 0.) ) diff --git a/src/js/client.ml b/src/js/client.ml deleted file mode 100644 index e69de29..0000000 diff --git a/src/js/dune b/src/js/dune deleted file mode 100644 index c404ab0..0000000 --- a/src/js/dune +++ /dev/null @@ -1,10 +0,0 @@ -(executable - (name client) - (modules client) - (libraries brr utils) - (modes js)) - -(library - (name utils) - (modules utils) - (libraries brr)) diff --git a/src/js/geo.ml b/src/js/geo.ml deleted file mode 100644 index 476d102..0000000 --- a/src/js/geo.ml +++ /dev/null @@ -1,97 +0,0 @@ -open Utils -open Leaflet - -let map = - let options = Jv.obj [| ("zoomControl", Jv.of_bool false) |] in - Map.create_on ~options "map" - -let () = - let osm_layer = Layer.create_tile_osm None in - Layer.add_to map osm_layer - -let storage = Brr_io.Storage.local Brr.G.window - -let save_view () = - let latlng = Map.get_center map in - let zoom = Map.get_zoom map |> Jstr.of_int in - let lat = Latlng.lat latlng |> Jstr.of_float in - let lng = Latlng.lng latlng |> Jstr.of_float in - match Brr_io.Storage.set_item storage (Jstr.v "lat") lat with - | (exception Jv.Error _) | Error _ -> failwith "can't set latlng storage" - | Ok () -> ( - match Brr_io.Storage.set_item storage (Jstr.v "lng") lng with - | (exception Jv.Error _) | Error _ -> failwith "can't set latlng storage" - | Ok () -> ( - match Brr_io.Storage.set_item storage (Jstr.v "zoom") zoom with - | (exception Jv.Error _) | Error _ -> failwith "can't set zoom storage" - | Ok () -> () ) ) - -(* wrap Leaflet.Map.set_view to save last position to storage *) -let set_view latlng ~zoom = - log "set view wrapper@\n"; - (*we need to wrap coordinates so we don't drift into a parralel universe and lose track of markers :^) *) - (* todo: use `worldCopyJump` option on map creation *) - let wrapped_latlng = Map.wrap_latlng latlng map in - Map.set_view wrapped_latlng ~zoom map; - save_view () - -(* set map's view *) -(* try to set map's view to last position viewed by using web storage *) -let () = - log "setting view@\n"; - let lat = Brr_io.Storage.get_item storage (Jstr.v "lat") in - let lng = Brr_io.Storage.get_item storage (Jstr.v "lng") in - let zoom = Brr_io.Storage.get_item storage (Jstr.v "zoom") in - match (lat, lng, zoom) with - | Some lat, Some lng, Some zoom -> - let lat = Jstr.to_float lat in - let lng = Jstr.to_float lng in - let zoom = - match Jstr.to_int zoom with - | None -> failwith "view storage bug" - | Some zoom -> Some zoom - in - let latlng = Latlng.create lat lng in - set_view latlng ~zoom - | _ -> - let latlng = Latlng.create 51.505 (-0.09) in - set_view latlng ~zoom:(Some 13) - -let () = - log "add on (move/zoom)end event@\n"; - let on_moveend _event = - log "on moveend event@\n"; - save_view () - in - let on_zoomend _event = - log "on zoomend event@\n"; - save_view () - in - Map.on Event.Move_end on_moveend map; - Map.on Event.Zoom_end on_zoomend map - -let watch_geolocation f = - let open Brr_io.Geolocation in - log "geolocalize@\n"; - - let update_location geo = - log "update_location@\n"; - match geo with - | Error e -> - (* todo: popup error message for user *) - log "geolocation failure: %s@\n" @@ Jstr.to_string @@ Error.message e - | Ok geo -> - (* monitors geolocation update with f *) - f geo; - (* set view *) - let lat = Pos.latitude geo in - let lng = Pos.longitude geo in - let latlng = Latlng.create lat lng in - set_view latlng ~zoom:None - (* TODO update/make camel marker on the map *) - in - - (* watch l ~opts f monitors the position of l determined with opts by periodically calling f. Stop watching by calling unwatch with the returned identifier. *) - let l = of_navigator Brr.G.navigator in - let opts = opts ~high_accuracy:true () in - watch l ~opts update_location diff --git a/src/js/leaflet/leaflet.js b/src/js/leaflet/leaflet.js deleted file mode 100644 index 21f499c..0000000 --- a/src/js/leaflet/leaflet.js +++ /dev/null @@ -1,6 +0,0 @@ -/* @preserve - * Leaflet 1.7.1, a JS library for interactive maps. http://leafletjs.com - * (c) 2010-2019 Vladimir Agafonkin, (c) 2010-2011 CloudMade - */ -!function(t,i){"object"==typeof exports&&"undefined"!=typeof module?i(exports):"function"==typeof define&&define.amd?define(["exports"],i):i(t.L={})}(this,function(t){"use strict";function h(t){for(var i,e,n=1,o=arguments.length;n=this.min.x&&e.x<=this.max.x&&i.y>=this.min.y&&e.y<=this.max.y},intersects:function(t){t=O(t);var i=this.min,e=this.max,n=t.min,o=t.max,s=o.x>=i.x&&n.x<=e.x,r=o.y>=i.y&&n.y<=e.y;return s&&r},overlaps:function(t){t=O(t);var i=this.min,e=this.max,n=t.min,o=t.max,s=o.x>i.x&&n.xi.y&&n.y=n.lat&&e.lat<=o.lat&&i.lng>=n.lng&&e.lng<=o.lng},intersects:function(t){t=N(t);var i=this._southWest,e=this._northEast,n=t.getSouthWest(),o=t.getNorthEast(),s=o.lat>=i.lat&&n.lat<=e.lat,r=o.lng>=i.lng&&n.lng<=e.lng;return s&&r},overlaps:function(t){t=N(t);var i=this._southWest,e=this._northEast,n=t.getSouthWest(),o=t.getNorthEast(),s=o.lat>i.lat&&n.lati.lng&&n.lng';var i=t.firstChild;return i.style.behavior="url(#default#VML)",i&&"object"==typeof i.adj}catch(t){return!1}}();function kt(t){return 0<=navigator.userAgent.toLowerCase().indexOf(t)}var Bt={ie:tt,ielt9:it,edge:et,webkit:nt,android:ot,android23:st,androidStock:at,opera:ht,chrome:ut,gecko:lt,safari:ct,phantom:_t,opera12:dt,win:pt,ie3d:mt,webkit3d:ft,gecko3d:gt,any3d:vt,mobile:yt,mobileWebkit:xt,mobileWebkit3d:wt,msPointer:Pt,pointer:Lt,touch:bt,mobileOpera:Tt,mobileGecko:Mt,retina:zt,passiveEvents:Ct,canvas:St,svg:Zt,vml:Et},At=Pt?"MSPointerDown":"pointerdown",It=Pt?"MSPointerMove":"pointermove",Ot=Pt?"MSPointerUp":"pointerup",Rt=Pt?"MSPointerCancel":"pointercancel",Nt={},Dt=!1;function jt(t,i,e,n){function o(t){Ut(t,r)}var s,r,a,h,u,l,c,_;function d(t){t.pointerType===(t.MSPOINTER_TYPE_MOUSE||"mouse")&&0===t.buttons||Ut(t,h)}return"touchstart"===i?(u=t,l=e,c=n,_=p(function(t){t.MSPOINTER_TYPE_TOUCH&&t.pointerType===t.MSPOINTER_TYPE_TOUCH&&Ri(t),Ut(t,l)}),u["_leaflet_touchstart"+c]=_,u.addEventListener(At,_,!1),Dt||(document.addEventListener(At,Wt,!0),document.addEventListener(It,Ht,!0),document.addEventListener(Ot,Ft,!0),document.addEventListener(Rt,Ft,!0),Dt=!0)):"touchmove"===i?(h=e,(a=t)["_leaflet_touchmove"+n]=d,a.addEventListener(It,d,!1)):"touchend"===i&&(r=e,(s=t)["_leaflet_touchend"+n]=o,s.addEventListener(Ot,o,!1),s.addEventListener(Rt,o,!1)),this}function Wt(t){Nt[t.pointerId]=t}function Ht(t){Nt[t.pointerId]&&(Nt[t.pointerId]=t)}function Ft(t){delete Nt[t.pointerId]}function Ut(t,i){for(var e in t.touches=[],Nt)t.touches.push(Nt[e]);t.changedTouches=[t],i(t)}var Vt=Pt?"MSPointerDown":Lt?"pointerdown":"touchstart",qt=Pt?"MSPointerUp":Lt?"pointerup":"touchend",Gt="_leaflet_";var Kt,Yt,Xt,Jt,$t,Qt,ti=fi(["transform","webkitTransform","OTransform","MozTransform","msTransform"]),ii=fi(["webkitTransition","transition","OTransition","MozTransition","msTransition"]),ei="webkitTransition"===ii||"OTransition"===ii?ii+"End":"transitionend";function ni(t){return"string"==typeof t?document.getElementById(t):t}function oi(t,i){var e,n=t.style[i]||t.currentStyle&&t.currentStyle[i];return n&&"auto"!==n||!document.defaultView||(n=(e=document.defaultView.getComputedStyle(t,null))?e[i]:null),"auto"===n?null:n}function si(t,i,e){var n=document.createElement(t);return n.className=i||"",e&&e.appendChild(n),n}function ri(t){var i=t.parentNode;i&&i.removeChild(t)}function ai(t){for(;t.firstChild;)t.removeChild(t.firstChild)}function hi(t){var i=t.parentNode;i&&i.lastChild!==t&&i.appendChild(t)}function ui(t){var i=t.parentNode;i&&i.firstChild!==t&&i.insertBefore(t,i.firstChild)}function li(t,i){if(void 0!==t.classList)return t.classList.contains(i);var e=pi(t);return 0this.options.maxZoom)?this.setZoom(t):this},panInsideBounds:function(t,i){this._enforcingBounds=!0;var e=this.getCenter(),n=this._limitCenter(e,this._zoom,N(t));return e.equals(n)||this.panTo(n,i),this._enforcingBounds=!1,this},panInside:function(t,i){var e,n,o=A((i=i||{}).paddingTopLeft||i.padding||[0,0]),s=A(i.paddingBottomRight||i.padding||[0,0]),r=this.getCenter(),a=this.project(r),h=this.project(t),u=this.getPixelBounds(),l=u.getSize().divideBy(2),c=O([u.min.add(o),u.max.subtract(s)]);return c.contains(h)||(this._enforcingBounds=!0,e=a.subtract(h),n=A(h.x+e.x,h.y+e.y),(h.xc.max.x)&&(n.x=a.x-e.x,0c.max.y)&&(n.y=a.y-e.y,0=this.options.transform3DLimit&&this._resetView(this.getCenter(),this.getZoom())},_findEventTargets:function(t,i){for(var e,n=[],o="mouseout"===i||"mouseover"===i,s=t.target||t.srcElement,r=!1;s;){if((e=this._targets[m(s)])&&("click"===i||"preclick"===i)&&!t._simulated&&this._draggableMoved(e)){r=!0;break}if(e&&e.listens(i,!0)){if(o&&!Vi(s,t))break;if(n.push(e),o)break}if(s===this._container)break;s=s.parentNode}return n.length||r||o||!Vi(s,t)||(n=[this]),n},_handleDOMEvent:function(t){var i;this._loaded&&!Ui(t)&&("mousedown"!==(i=t.type)&&"keypress"!==i&&"keyup"!==i&&"keydown"!==i||Pi(t.target||t.srcElement),this._fireDOMEvent(t,i))},_mouseEvents:["click","dblclick","mouseover","mouseout","contextmenu"],_fireDOMEvent:function(t,i,e){var n;if("click"===t.type&&((n=h({},t)).type="preclick",this._fireDOMEvent(n,n.type,e)),!t._stopped&&(e=(e||[]).concat(this._findEventTargets(t,i))).length){var o=e[0];"contextmenu"===i&&o.listens(i,!0)&&Ri(t);var s,r={originalEvent:t};"keypress"!==t.type&&"keydown"!==t.type&&"keyup"!==t.type&&(s=o.getLatLng&&(!o._radius||o._radius<=10),r.containerPoint=s?this.latLngToContainerPoint(o.getLatLng()):this.mouseEventToContainerPoint(t),r.layerPoint=this.containerPointToLayerPoint(r.containerPoint),r.latlng=s?o.getLatLng():this.layerPointToLatLng(r.layerPoint));for(var a=0;athis.options.zoomAnimationThreshold)return!1;var n=this.getZoomScale(i),o=this._getCenterOffset(t)._divideBy(1-1/n);return!(!0!==e.animate&&!this.getSize().contains(o))&&(M(function(){this._moveStart(!0,!1)._animateZoom(t,i,!0)},this),!0)},_animateZoom:function(t,i,e,n){this._mapPane&&(e&&(this._animatingZoom=!0,this._animateToCenter=t,this._animateToZoom=i,ci(this._mapPane,"leaflet-zoom-anim")),this.fire("zoomanim",{center:t,zoom:i,noUpdate:n}),setTimeout(p(this._onZoomTransitionEnd,this),250))},_onZoomTransitionEnd:function(){this._animatingZoom&&(this._mapPane&&_i(this._mapPane,"leaflet-zoom-anim"),this._animatingZoom=!1,this._move(this._animateToCenter,this._animateToZoom),M(function(){this._moveEnd(!0)},this))}});function Yi(t){return new Xi(t)}var Xi=S.extend({options:{position:"topright"},initialize:function(t){c(this,t)},getPosition:function(){return this.options.position},setPosition:function(t){var i=this._map;return i&&i.removeControl(this),this.options.position=t,i&&i.addControl(this),this},getContainer:function(){return this._container},addTo:function(t){this.remove(),this._map=t;var i=this._container=this.onAdd(t),e=this.getPosition(),n=t._controlCorners[e];return ci(i,"leaflet-control"),-1!==e.indexOf("bottom")?n.insertBefore(i,n.firstChild):n.appendChild(i),this._map.on("unload",this.remove,this),this},remove:function(){return this._map&&(ri(this._container),this.onRemove&&this.onRemove(this._map),this._map.off("unload",this.remove,this),this._map=null),this},_refocusOnMap:function(t){this._map&&t&&0",n=document.createElement("div");return n.innerHTML=e,n.firstChild},_addItem:function(t){var i,e=document.createElement("label"),n=this._map.hasLayer(t.layer);t.overlay?((i=document.createElement("input")).type="checkbox",i.className="leaflet-control-layers-selector",i.defaultChecked=n):i=this._createRadioElement("leaflet-base-layers_"+m(this),n),this._layerControlInputs.push(i),i.layerId=m(t.layer),zi(i,"click",this._onInputClick,this);var o=document.createElement("span");o.innerHTML=" "+t.name;var s=document.createElement("div");return e.appendChild(s),s.appendChild(i),s.appendChild(o),(t.overlay?this._overlaysList:this._baseLayersList).appendChild(e),this._checkDisabledLayers(),e},_onInputClick:function(){var t,i,e=this._layerControlInputs,n=[],o=[];this._handlingClick=!0;for(var s=e.length-1;0<=s;s--)t=e[s],i=this._getLayer(t.layerId).layer,t.checked?n.push(i):t.checked||o.push(i);for(s=0;si.options.maxZoom},_expandIfNotCollapsed:function(){return this._map&&!this.options.collapsed&&this.expand(),this},_expand:function(){return this.expand()},_collapse:function(){return this.collapse()}}),$i=Xi.extend({options:{position:"topleft",zoomInText:"+",zoomInTitle:"Zoom in",zoomOutText:"−",zoomOutTitle:"Zoom out"},onAdd:function(t){var i="leaflet-control-zoom",e=si("div",i+" leaflet-bar"),n=this.options;return this._zoomInButton=this._createButton(n.zoomInText,n.zoomInTitle,i+"-in",e,this._zoomIn),this._zoomOutButton=this._createButton(n.zoomOutText,n.zoomOutTitle,i+"-out",e,this._zoomOut),this._updateDisabled(),t.on("zoomend zoomlevelschange",this._updateDisabled,this),e},onRemove:function(t){t.off("zoomend zoomlevelschange",this._updateDisabled,this)},disable:function(){return this._disabled=!0,this._updateDisabled(),this},enable:function(){return this._disabled=!1,this._updateDisabled(),this},_zoomIn:function(t){!this._disabled&&this._map._zoomthis._map.getMinZoom()&&this._map.zoomOut(this._map.options.zoomDelta*(t.shiftKey?3:1))},_createButton:function(t,i,e,n,o){var s=si("a",e,n);return s.innerHTML=t,s.href="#",s.title=i,s.setAttribute("role","button"),s.setAttribute("aria-label",i),Oi(s),zi(s,"click",Ni),zi(s,"click",o,this),zi(s,"click",this._refocusOnMap,this),s},_updateDisabled:function(){var t=this._map,i="leaflet-disabled";_i(this._zoomInButton,i),_i(this._zoomOutButton,i),!this._disabled&&t._zoom!==t.getMinZoom()||ci(this._zoomOutButton,i),!this._disabled&&t._zoom!==t.getMaxZoom()||ci(this._zoomInButton,i)}});Ki.mergeOptions({zoomControl:!0}),Ki.addInitHook(function(){this.options.zoomControl&&(this.zoomControl=new $i,this.addControl(this.zoomControl))});var Qi=Xi.extend({options:{position:"bottomleft",maxWidth:100,metric:!0,imperial:!0},onAdd:function(t){var i="leaflet-control-scale",e=si("div",i),n=this.options;return this._addScales(n,i+"-line",e),t.on(n.updateWhenIdle?"moveend":"move",this._update,this),t.whenReady(this._update,this),e},onRemove:function(t){t.off(this.options.updateWhenIdle?"moveend":"move",this._update,this)},_addScales:function(t,i,e){t.metric&&(this._mScale=si("div",i,e)),t.imperial&&(this._iScale=si("div",i,e))},_update:function(){var t=this._map,i=t.getSize().y/2,e=t.distance(t.containerPointToLatLng([0,i]),t.containerPointToLatLng([this.options.maxWidth,i]));this._updateScales(e)},_updateScales:function(t){this.options.metric&&t&&this._updateMetric(t),this.options.imperial&&t&&this._updateImperial(t)},_updateMetric:function(t){var i=this._getRoundNum(t),e=i<1e3?i+" m":i/1e3+" km";this._updateScale(this._mScale,e,i/t)},_updateImperial:function(t){var i,e,n,o=3.2808399*t;5280Leaflet'},initialize:function(t){c(this,t),this._attributions={}},onAdd:function(t){for(var i in(t.attributionControl=this)._container=si("div","leaflet-control-attribution"),Oi(this._container),t._layers)t._layers[i].getAttribution&&this.addAttribution(t._layers[i].getAttribution());return this._update(),this._container},setPrefix:function(t){return this.options.prefix=t,this._update(),this},addAttribution:function(t){return t&&(this._attributions[t]||(this._attributions[t]=0),this._attributions[t]++,this._update()),this},removeAttribution:function(t){return t&&this._attributions[t]&&(this._attributions[t]--,this._update()),this},_update:function(){if(this._map){var t=[];for(var i in this._attributions)this._attributions[i]&&t.push(i);var e=[];this.options.prefix&&e.push(this.options.prefix),t.length&&e.push(t.join(", ")),this._container.innerHTML=e.join(" | ")}}});Ki.mergeOptions({attributionControl:!0}),Ki.addInitHook(function(){this.options.attributionControl&&(new te).addTo(this)});Xi.Layers=Ji,Xi.Zoom=$i,Xi.Scale=Qi,Xi.Attribution=te,Yi.layers=function(t,i,e){return new Ji(t,i,e)},Yi.zoom=function(t){return new $i(t)},Yi.scale=function(t){return new Qi(t)},Yi.attribution=function(t){return new te(t)};var ie=S.extend({initialize:function(t){this._map=t},enable:function(){return this._enabled||(this._enabled=!0,this.addHooks()),this},disable:function(){return this._enabled&&(this._enabled=!1,this.removeHooks()),this},enabled:function(){return!!this._enabled}});ie.addTo=function(t,i){return t.addHandler(i,this),this};var ee,ne={Events:Z},oe=bt?"touchstart mousedown":"mousedown",se={mousedown:"mouseup",touchstart:"touchend",pointerdown:"touchend",MSPointerDown:"touchend"},re={mousedown:"mousemove",touchstart:"touchmove",pointerdown:"touchmove",MSPointerDown:"touchmove"},ae=E.extend({options:{clickTolerance:3},initialize:function(t,i,e,n){c(this,n),this._element=t,this._dragStartTarget=i||t,this._preventOutline=e},enable:function(){this._enabled||(zi(this._dragStartTarget,oe,this._onDown,this),this._enabled=!0)},disable:function(){this._enabled&&(ae._dragging===this&&this.finishDrag(),Si(this._dragStartTarget,oe,this._onDown,this),this._enabled=!1,this._moved=!1)},_onDown:function(t){var i,e;!t._simulated&&this._enabled&&(this._moved=!1,li(this._element,"leaflet-zoom-anim")||ae._dragging||t.shiftKey||1!==t.which&&1!==t.button&&!t.touches||((ae._dragging=this)._preventOutline&&Pi(this._element),xi(),Xt(),this._moving||(this.fire("down"),i=t.touches?t.touches[0]:t,e=bi(this._element),this._startPoint=new k(i.clientX,i.clientY),this._parentScale=Ti(e),zi(document,re[t.type],this._onMove,this),zi(document,se[t.type],this._onUp,this))))},_onMove:function(t){var i,e;!t._simulated&&this._enabled&&(t.touches&&1i&&(e.push(t[n]),o=n);oi.max.x&&(e|=2),t.yi.max.y&&(e|=8),e}function de(t,i,e,n){var o,s=i.x,r=i.y,a=e.x-s,h=e.y-r,u=a*a+h*h;return 0this._layersMaxZoom&&this.setZoom(this._layersMaxZoom),void 0===this.options.minZoom&&this._layersMinZoom&&this.getZoom()t.y!=n.y>t.y&&t.x<(n.x-e.x)*(t.y-e.y)/(n.y-e.y)+e.x&&(u=!u);return u||Oe.prototype._containsPoint.call(this,t,!0)}});var Ne=Ce.extend({initialize:function(t,i){c(this,i),this._layers={},t&&this.addData(t)},addData:function(t){var i,e,n,o=g(t)?t:t.features;if(o){for(i=0,e=o.length;iu.x&&(l=s.x+n-u.x+h.x),s.x-l-a.x<0&&(l=s.x-a.x),s.y+e+h.y>u.y&&(c=s.y+e-u.y+h.y),s.y-c-a.y<0&&(c=s.y-a.y),(l||c)&&t.fire("autopanstart").panBy([l,c]))},_onCloseButtonClick:function(t){this._close(),Ni(t)},_getAnchor:function(){return A(this._source&&this._source._getPopupAnchor?this._source._getPopupAnchor():[0,0])}});Ki.mergeOptions({closePopupOnClick:!0}),Ki.include({openPopup:function(t,i,e){return t instanceof tn||(t=new tn(e).setContent(t)),i&&t.setLatLng(i),this.hasLayer(t)?this:(this._popup&&this._popup.options.autoClose&&this.closePopup(),this._popup=t,this.addLayer(t))},closePopup:function(t){return t&&t!==this._popup||(t=this._popup,this._popup=null),t&&this.removeLayer(t),this}}),Me.include({bindPopup:function(t,i){return t instanceof tn?(c(t,i),(this._popup=t)._source=this):(this._popup&&!i||(this._popup=new tn(i,this)),this._popup.setContent(t)),this._popupHandlersAdded||(this.on({click:this._openPopup,keypress:this._onKeyPress,remove:this.closePopup,move:this._movePopup}),this._popupHandlersAdded=!0),this},unbindPopup:function(){return this._popup&&(this.off({click:this._openPopup,keypress:this._onKeyPress,remove:this.closePopup,move:this._movePopup}),this._popupHandlersAdded=!1,this._popup=null),this},openPopup:function(t,i){return this._popup&&this._map&&(i=this._popup._prepareOpen(this,t,i),this._map.openPopup(this._popup,i)),this},closePopup:function(){return this._popup&&this._popup._close(),this},togglePopup:function(t){return this._popup&&(this._popup._map?this.closePopup():this.openPopup(t)),this},isPopupOpen:function(){return!!this._popup&&this._popup.isOpen()},setPopupContent:function(t){return this._popup&&this._popup.setContent(t),this},getPopup:function(){return this._popup},_openPopup:function(t){var i=t.layer||t.target;this._popup&&this._map&&(Ni(t),i instanceof Be?this.openPopup(t.layer||t.target,t.latlng):this._map.hasLayer(this._popup)&&this._popup._source===i?this.closePopup():this.openPopup(i,t.latlng))},_movePopup:function(t){this._popup.setLatLng(t.latlng)},_onKeyPress:function(t){13===t.originalEvent.keyCode&&this._openPopup(t)}});var en=Qe.extend({options:{pane:"tooltipPane",offset:[0,0],direction:"auto",permanent:!1,sticky:!1,interactive:!1,opacity:.9},onAdd:function(t){Qe.prototype.onAdd.call(this,t),this.setOpacity(this.options.opacity),t.fire("tooltipopen",{tooltip:this}),this._source&&this._source.fire("tooltipopen",{tooltip:this},!0)},onRemove:function(t){Qe.prototype.onRemove.call(this,t),t.fire("tooltipclose",{tooltip:this}),this._source&&this._source.fire("tooltipclose",{tooltip:this},!0)},getEvents:function(){var t=Qe.prototype.getEvents.call(this);return bt&&!this.options.permanent&&(t.preclick=this._close),t},_close:function(){this._map&&this._map.closeTooltip(this)},_initLayout:function(){var t="leaflet-tooltip "+(this.options.className||"")+" leaflet-zoom-"+(this._zoomAnimated?"animated":"hide");this._contentNode=this._container=si("div",t)},_updateLayout:function(){},_adjustPan:function(){},_setPosition:function(t){var i,e=this._map,n=this._container,o=e.latLngToContainerPoint(e.getCenter()),s=e.layerPointToContainerPoint(t),r=this.options.direction,a=n.offsetWidth,h=n.offsetHeight,u=A(this.options.offset),l=this._getAnchor(),c="top"===r?(i=a/2,h):"bottom"===r?(i=a/2,0):(i="center"===r?a/2:"right"===r?0:"left"===r?a:s.xthis.options.maxZoom||nthis.options.maxZoom||void 0!==this.options.minZoom&&oe.max.x)||!i.wrapLat&&(t.ye.max.y))return!1}if(!this.options.bounds)return!0;var n=this._tileCoordsToBounds(t);return N(this.options.bounds).overlaps(n)},_keyToBounds:function(t){return this._tileCoordsToBounds(this._keyToTileCoords(t))},_tileCoordsToNwSe:function(t){var i=this._map,e=this.getTileSize(),n=t.scaleBy(e),o=n.add(e);return[i.unproject(n,t.z),i.unproject(o,t.z)]},_tileCoordsToBounds:function(t){var i=this._tileCoordsToNwSe(t),e=new R(i[0],i[1]);return this.options.noWrap||(e=this._map.wrapLatLngBounds(e)),e},_tileCoordsToKey:function(t){return t.x+":"+t.y+":"+t.z},_keyToTileCoords:function(t){var i=t.split(":"),e=new k(+i[0],+i[1]);return e.z=+i[2],e},_removeTile:function(t){var i=this._tiles[t];i&&(ri(i.el),delete this._tiles[t],this.fire("tileunload",{tile:i.el,coords:this._keyToTileCoords(t)}))},_initTile:function(t){ci(t,"leaflet-tile");var i=this.getTileSize();t.style.width=i.x+"px",t.style.height=i.y+"px",t.onselectstart=a,t.onmousemove=a,it&&this.options.opacity<1&&mi(t,this.options.opacity),ot&&!st&&(t.style.WebkitBackfaceVisibility="hidden")},_addTile:function(t,i){var e=this._getTilePos(t),n=this._tileCoordsToKey(t),o=this.createTile(this._wrapCoords(t),p(this._tileReady,this,t));this._initTile(o),this.createTile.length<2&&M(p(this._tileReady,this,t,null,o)),vi(o,e),this._tiles[n]={el:o,coords:t,current:!0},i.appendChild(o),this.fire("tileloadstart",{tile:o,coords:t})},_tileReady:function(t,i,e){i&&this.fire("tileerror",{error:i,tile:e,coords:t});var n=this._tileCoordsToKey(t);(e=this._tiles[n])&&(e.loaded=+new Date,this._map._fadeAnimated?(mi(e.el,0),z(this._fadeFrame),this._fadeFrame=M(this._updateOpacity,this)):(e.active=!0,this._pruneTiles()),i||(ci(e.el,"leaflet-tile-loaded"),this.fire("tileload",{tile:e.el,coords:t})),this._noTilesToLoad()&&(this._loading=!1,this.fire("load"),it||!this._map._fadeAnimated?M(this._pruneTiles,this):setTimeout(p(this._pruneTiles,this),250)))},_getTilePos:function(t){return t.scaleBy(this.getTileSize()).subtract(this._level.origin)},_wrapCoords:function(t){var i=new k(this._wrapX?o(t.x,this._wrapX):t.x,this._wrapY?o(t.y,this._wrapY):t.y);return i.z=t.z,i},_pxBoundsToTileRange:function(t){var i=this.getTileSize();return new I(t.min.unscaleBy(i).floor(),t.max.unscaleBy(i).ceil().subtract([1,1]))},_noTilesToLoad:function(){for(var t in this._tiles)if(!this._tiles[t].loaded)return!1;return!0}});var sn=on.extend({options:{minZoom:0,maxZoom:18,subdomains:"abc",errorTileUrl:"",zoomOffset:0,tms:!1,zoomReverse:!1,detectRetina:!1,crossOrigin:!1},initialize:function(t,i){this._url=t,(i=c(this,i)).detectRetina&&zt&&0')}}catch(t){return function(t){return document.createElement("<"+t+' xmlns="urn:schemas-microsoft.com:vml" class="lvml">')}}}(),_n={_initContainer:function(){this._container=si("div","leaflet-vml-container")},_update:function(){this._map._animatingZoom||(hn.prototype._update.call(this),this.fire("update"))},_initPath:function(t){var i=t._container=cn("shape");ci(i,"leaflet-vml-shape "+(this.options.className||"")),i.coordsize="1 1",t._path=cn("path"),i.appendChild(t._path),this._updateStyle(t),this._layers[m(t)]=t},_addPath:function(t){var i=t._container;this._container.appendChild(i),t.options.interactive&&t.addInteractiveTarget(i)},_removePath:function(t){var i=t._container;ri(i),t.removeInteractiveTarget(i),delete this._layers[m(t)]},_updateStyle:function(t){var i=t._stroke,e=t._fill,n=t.options,o=t._container;o.stroked=!!n.stroke,o.filled=!!n.fill,n.stroke?(i=i||(t._stroke=cn("stroke")),o.appendChild(i),i.weight=n.weight+"px",i.color=n.color,i.opacity=n.opacity,n.dashArray?i.dashStyle=g(n.dashArray)?n.dashArray.join(" "):n.dashArray.replace(/( *, *)/g," "):i.dashStyle="",i.endcap=n.lineCap.replace("butt","flat"),i.joinstyle=n.lineJoin):i&&(o.removeChild(i),t._stroke=null),n.fill?(e=e||(t._fill=cn("fill")),o.appendChild(e),e.color=n.fillColor||n.color,e.opacity=n.fillOpacity):e&&(o.removeChild(e),t._fill=null)},_updateCircle:function(t){var i=t._point.round(),e=Math.round(t._radius),n=Math.round(t._radiusY||e);this._setPath(t,t._empty()?"M0 0":"AL "+i.x+","+i.y+" "+e+","+n+" 0,23592600")},_setPath:function(t,i){t._path.v=i},_bringToFront:function(t){hi(t._container)},_bringToBack:function(t){ui(t._container)}},dn=Et?cn:J,pn=hn.extend({getEvents:function(){var t=hn.prototype.getEvents.call(this);return t.zoomstart=this._onZoomStart,t},_initContainer:function(){this._container=dn("svg"),this._container.setAttribute("pointer-events","none"),this._rootGroup=dn("g"),this._container.appendChild(this._rootGroup)},_destroyContainer:function(){ri(this._container),Si(this._container),delete this._container,delete this._rootGroup,delete this._svgSize},_onZoomStart:function(){this._update()},_update:function(){var t,i,e;this._map._animatingZoom&&this._bounds||(hn.prototype._update.call(this),i=(t=this._bounds).getSize(),e=this._container,this._svgSize&&this._svgSize.equals(i)||(this._svgSize=i,e.setAttribute("width",i.x),e.setAttribute("height",i.y)),vi(e,t.min),e.setAttribute("viewBox",[t.min.x,t.min.y,i.x,i.y].join(" ")),this.fire("update"))},_initPath:function(t){var i=t._path=dn("path");t.options.className&&ci(i,t.options.className),t.options.interactive&&ci(i,"leaflet-interactive"),this._updateStyle(t),this._layers[m(t)]=t},_addPath:function(t){this._rootGroup||this._initContainer(),this._rootGroup.appendChild(t._path),t.addInteractiveTarget(t._path)},_removePath:function(t){ri(t._path),t.removeInteractiveTarget(t._path),delete this._layers[m(t)]},_updatePath:function(t){t._project(),t._update()},_updateStyle:function(t){var i=t._path,e=t.options;i&&(e.stroke?(i.setAttribute("stroke",e.color),i.setAttribute("stroke-opacity",e.opacity),i.setAttribute("stroke-width",e.weight),i.setAttribute("stroke-linecap",e.lineCap),i.setAttribute("stroke-linejoin",e.lineJoin),e.dashArray?i.setAttribute("stroke-dasharray",e.dashArray):i.removeAttribute("stroke-dasharray"),e.dashOffset?i.setAttribute("stroke-dashoffset",e.dashOffset):i.removeAttribute("stroke-dashoffset")):i.setAttribute("stroke","none"),e.fill?(i.setAttribute("fill",e.fillColor||e.color),i.setAttribute("fill-opacity",e.fillOpacity),i.setAttribute("fill-rule",e.fillRule||"evenodd")):i.setAttribute("fill","none"))},_updatePoly:function(t,i){this._setPath(t,$(t._parts,i))},_updateCircle:function(t){var i=t._point,e=Math.max(Math.round(t._radius),1),n="a"+e+","+(Math.max(Math.round(t._radiusY),1)||e)+" 0 1,0 ",o=t._empty()?"M0 0":"M"+(i.x-e)+","+i.y+n+2*e+",0 "+n+2*-e+",0 ";this._setPath(t,o)},_setPath:function(t,i){t._path.setAttribute("d",i)},_bringToFront:function(t){hi(t._path)},_bringToBack:function(t){ui(t._path)}});function mn(t){return Zt||Et?new pn(t):null}Et&&pn.include(_n),Ki.include({getRenderer:function(t){var i=(i=t.options.renderer||this._getPaneRenderer(t.options.pane)||this.options.renderer||this._renderer)||(this._renderer=this._createRenderer());return this.hasLayer(i)||this.addLayer(i),i},_getPaneRenderer:function(t){if("overlayPane"===t||void 0===t)return!1;var i=this._paneRenderers[t];return void 0===i&&(i=this._createRenderer({pane:t}),this._paneRenderers[t]=i),i},_createRenderer:function(t){return this.options.preferCanvas&&ln(t)||mn(t)}});var fn=Re.extend({initialize:function(t,i){Re.prototype.initialize.call(this,this._boundsToLatLngs(t),i)},setBounds:function(t){return this.setLatLngs(this._boundsToLatLngs(t))},_boundsToLatLngs:function(t){return[(t=N(t)).getSouthWest(),t.getNorthWest(),t.getNorthEast(),t.getSouthEast()]}});pn.create=dn,pn.pointsToPath=$,Ne.geometryToLayer=De,Ne.coordsToLatLng=We,Ne.coordsToLatLngs=He,Ne.latLngToCoords=Fe,Ne.latLngsToCoords=Ue,Ne.getFeature=Ve,Ne.asFeature=qe,Ki.mergeOptions({boxZoom:!0});var gn=ie.extend({initialize:function(t){this._map=t,this._container=t._container,this._pane=t._panes.overlayPane,this._resetStateTimeout=0,t.on("unload",this._destroy,this)},addHooks:function(){zi(this._container,"mousedown",this._onMouseDown,this)},removeHooks:function(){Si(this._container,"mousedown",this._onMouseDown,this)},moved:function(){return this._moved},_destroy:function(){ri(this._pane),delete this._pane},_resetState:function(){this._resetStateTimeout=0,this._moved=!1},_clearDeferredResetState:function(){0!==this._resetStateTimeout&&(clearTimeout(this._resetStateTimeout),this._resetStateTimeout=0)},_onMouseDown:function(t){if(!t.shiftKey||1!==t.which&&1!==t.button)return!1;this._clearDeferredResetState(),this._resetState(),Xt(),xi(),this._startPoint=this._map.mouseEventToContainerPoint(t),zi(document,{contextmenu:Ni,mousemove:this._onMouseMove,mouseup:this._onMouseUp,keydown:this._onKeyDown},this)},_onMouseMove:function(t){this._moved||(this._moved=!0,this._box=si("div","leaflet-zoom-box",this._container),ci(this._container,"leaflet-crosshair"),this._map.fire("boxzoomstart")),this._point=this._map.mouseEventToContainerPoint(t);var i=new I(this._point,this._startPoint),e=i.getSize();vi(this._box,i.min),this._box.style.width=e.x+"px",this._box.style.height=e.y+"px"},_finish:function(){this._moved&&(ri(this._box),_i(this._container,"leaflet-crosshair")),Jt(),wi(),Si(document,{contextmenu:Ni,mousemove:this._onMouseMove,mouseup:this._onMouseUp,keydown:this._onKeyDown},this)},_onMouseUp:function(t){var i;1!==t.which&&1!==t.button||(this._finish(),this._moved&&(this._clearDeferredResetState(),this._resetStateTimeout=setTimeout(p(this._resetState,this),0),i=new R(this._map.containerPointToLatLng(this._startPoint),this._map.containerPointToLatLng(this._point)),this._map.fitBounds(i).fire("boxzoomend",{boxZoomBounds:i})))},_onKeyDown:function(t){27===t.keyCode&&this._finish()}});Ki.addInitHook("addHandler","boxZoom",gn),Ki.mergeOptions({doubleClickZoom:!0});var vn=ie.extend({addHooks:function(){this._map.on("dblclick",this._onDoubleClick,this)},removeHooks:function(){this._map.off("dblclick",this._onDoubleClick,this)},_onDoubleClick:function(t){var i=this._map,e=i.getZoom(),n=i.options.zoomDelta,o=t.originalEvent.shiftKey?e-n:e+n;"center"===i.options.doubleClickZoom?i.setZoom(o):i.setZoomAround(t.containerPoint,o)}});Ki.addInitHook("addHandler","doubleClickZoom",vn),Ki.mergeOptions({dragging:!0,inertia:!st,inertiaDeceleration:3400,inertiaMaxSpeed:1/0,easeLinearity:.2,worldCopyJump:!1,maxBoundsViscosity:0});var yn=ie.extend({addHooks:function(){var t;this._draggable||(t=this._map,this._draggable=new ae(t._mapPane,t._container),this._draggable.on({dragstart:this._onDragStart,drag:this._onDrag,dragend:this._onDragEnd},this),this._draggable.on("predrag",this._onPreDragLimit,this),t.options.worldCopyJump&&(this._draggable.on("predrag",this._onPreDragWrap,this),t.on("zoomend",this._onZoomEnd,this),t.whenReady(this._onZoomEnd,this))),ci(this._map._container,"leaflet-grab leaflet-touch-drag"),this._draggable.enable(),this._positions=[],this._times=[]},removeHooks:function(){_i(this._map._container,"leaflet-grab"),_i(this._map._container,"leaflet-touch-drag"),this._draggable.disable()},moved:function(){return this._draggable&&this._draggable._moved},moving:function(){return this._draggable&&this._draggable._moving},_onDragStart:function(){var t,i=this._map;i._stop(),this._map.options.maxBounds&&this._map.options.maxBoundsViscosity?(t=N(this._map.options.maxBounds),this._offsetLimit=O(this._map.latLngToContainerPoint(t.getNorthWest()).multiplyBy(-1),this._map.latLngToContainerPoint(t.getSouthEast()).multiplyBy(-1).add(this._map.getSize())),this._viscosity=Math.min(1,Math.max(0,this._map.options.maxBoundsViscosity))):this._offsetLimit=null,i.fire("movestart").fire("dragstart"),i.options.inertia&&(this._positions=[],this._times=[])},_onDrag:function(t){var i,e;this._map.options.inertia&&(i=this._lastTime=+new Date,e=this._lastPos=this._draggable._absPos||this._draggable._newPos,this._positions.push(e),this._times.push(i),this._prunePositions(i)),this._map.fire("move",t).fire("drag",t)},_prunePositions:function(t){for(;1i.max.x&&(t.x=this._viscousLimit(t.x,i.max.x)),t.y>i.max.y&&(t.y=this._viscousLimit(t.y,i.max.y)),this._draggable._newPos=this._draggable._startPos.add(t))},_onPreDragWrap:function(){var t=this._worldWidth,i=Math.round(t/2),e=this._initialWorldOffset,n=this._draggable._newPos.x,o=(n-i+e)%t+i-e,s=(n+i+e)%t-i-e,r=Math.abs(o+e)i.getMaxZoom()&&1 failwith (Format.sprintf "element `%s` not found" id) - | Some el -> el - -let add_event_to_class event name handler = - let el_list = El.find_by_class (Jstr.of_string name) in - List.iter (fun el -> Ev.listen event (handler el) (El.as_target el)) el_list diff --git a/src/log.ml b/src/log.ml new file mode 100644 index 0000000..12308c3 --- /dev/null +++ b/src/log.ml @@ -0,0 +1,9 @@ +let debug_on = ref true + +let debug_output = ref Format.std_formatter + +let debug t = + if !debug_on then Format.fprintf !debug_output t + else Format.ifprintf Format.err_formatter t + +let err f = Format.kasprintf failwith f diff --git a/src/login.ml b/src/login.ml index 2d594b1..3993ba2 100644 --- a/src/login.ml +++ b/src/login.ml @@ -1,16 +1,42 @@ open Tyxml.Html open Tyx_util +open Syntax + +let get request = + let** () = User.assert_not_logged request in + let title = "Pellest|Login" in + + let action = + match Dream.query request "redirect" with + | None -> "/login" + | Some r -> Format.sprintf "/login?redirect=%s" r + in -let f request = - (* todo page titles? *) - let page_title = "Pellest|Login" in let login = let submit = button ~a:[ a_id "submit_login" ] [ txt "submit" ] in - let login = make_input_text "login" in - let password = make_input_text "password" in - div - [ make_form request ~action:"/login" ~items:[ login; password; submit ] ] + let login = + input ~a:[ a_id "login"; a_name "login"; a_input_type `Text ] () + in + let password = + input ~a:[ a_id "password"; a_name "password"; a_input_type `Password ] () + in + div [ make_form request ~action ~items:[ login; password; submit ] ] in let text = div [ txt "login ~!" ] in let page = div [ text; login ] in - Template.render ~page_title ~scripts:[] page + Template.render ~title ~scripts:[] page + +let post request = + let** () = User.assert_not_logged request in + match%lwt Dream.form request with + | `Ok [ ("login", login); ("password", password) ] -> + let** () = User.login ~login ~password request in + let url = + match Dream.query request "redirect" with + | None -> "/" + | Some redirect -> Dream.from_percent_encoded redirect + in + Dream.respond ~status:`See_Other + ~headers:[ ("Location", url) ] + "Logged in: Happy pellesting!" + | _form -> Template.err (`Bad_Request, "invalid form") diff --git a/src/logout.ml b/src/logout.ml new file mode 100644 index 0000000..9beaf53 --- /dev/null +++ b/src/logout.ml @@ -0,0 +1,16 @@ +open Syntax + +let get request = + let** () = User.assert_logged request in + let title = "Logout" in + let%lwt () = Dream.invalidate_session request in + + match Dream.query request "redirect" with + | None -> + let page = Tyxml.Html.txt "logged out" in + Template.render ~title ~scripts:[] page + | Some redirect -> + let url = Dream.from_percent_encoded redirect in + Dream.respond ~status:`See_Other + ~headers:[ ("Location", url) ] + "Logged out: Happy nopellesting!" diff --git a/src/map.ml b/src/map.ml new file mode 100644 index 0000000..ecca65e --- /dev/null +++ b/src/map.ml @@ -0,0 +1,84 @@ +type dir = + | Left + | Right + | Down + | Up + +type background = + | Grass + | Water + | Black + | Wheat + +let pp_dir fmt dir = + let s = + match dir with + | Left -> "Left" + | Right -> "Right" + | Down -> "Down" + | Up -> "Up" + in + Format.pp_print_string fmt s + +let pp_background fmt b = + let s = + match b with + | Grass -> "Grass" + | Water -> "Water" + | Black -> "Black" + | Wheat -> "Wheat" + in + Format.pp_print_string fmt s + +type position = + { x : int + ; y : int + ; dir : dir + } + +let pp_position fmt p = + Format.fprintf fmt "(x = %d; y = %d; dir = %a)" p.x p.y pp_dir p.dir + +type t = + { tiles : background array array + ; width : int + ; height : int + } + +let init () = + let width = 100 in + let height = 90 in + let tiles = + Array.init width (fun _x -> + Array.init height (fun _y -> + if Random.int 1000 <= 42 then Water else Grass ) ) + in + { tiles; width; height } + +let get_tile_kind ~x ~y map = + try map.tiles.(x).(y) with Invalid_argument _ -> Black + +let count_wheat map = + Array.fold_left + (fun count a -> + let count' = + Array.fold_left + (fun count -> function + | Wheat -> succ count | Black | Grass | Water -> count ) + 0 a + in + count + count' ) + 0 map + +let check_move map ({ x; y; _ } as pos) movement_dir = + let x, y = + match movement_dir with + | Left -> (x - 1, y) + | Right -> (x + 1, y) + | Down -> (x, y + 1) + | Up -> (x, y - 1) + in + match get_tile_kind ~x ~y map with + | (Black | Water) as bg -> + Error (Format.asprintf "can't move on %a" pp_background bg) + | Grass | Wheat -> Ok { pos with x; y } diff --git a/src/network.ml b/src/network.ml new file mode 100644 index 0000000..83cd67f --- /dev/null +++ b/src/network.ml @@ -0,0 +1,11 @@ +let marshal o = Marshal.to_string o [] |> Format.sprintf "%S" + +let unmarshal o = + let s = Scanf.sscanf o "%S" (fun s -> s) in + Marshal.from_string s 0 + +type server_message = + | Full_state of State.t + | Update_result of (State.action' list, string) result + +type client_message = Action_msg of State.action diff --git a/src/pellest.ml b/src/pellest.ml index f2ba14a..19a5c9e 100644 --- a/src/pellest.ml +++ b/src/pellest.ml @@ -1,52 +1,41 @@ -open Util +let regularly_call_fun f v = + let () = Sys.set_signal Sys.sigalrm (Sys.Signal_handle (fun _ -> f ())) in + let (_ : Unix.interval_timer_status) = + Unix.setitimer Unix.ITIMER_REAL { Unix.it_interval = v; Unix.it_value = v } + in + () -let home_get request = Home.f request |> Dream.html +let update_offline_user_state () = + (* TODO *) + () -let register_get request = Register.f request |> Dream.html +let update_online_user_state () = + Hashtbl.filter_map_inplace + (fun _user_id state -> Some (Shared.State.auto_update state)) + User.state_ht -let login_get request = Login.f request |> Dream.html +let to_repeat () = + update_online_user_state (); + update_offline_user_state () -let login_post request = - match%lwt Dream.form request with - | `Ok [ ("login", login); ("password", password) ] -> ( - match User.login ~login ~password request with - | Error e -> render e - | Ok () -> - let url = - match Dream.query request "redirect" with - | None -> "/" - | Some redirect -> Dream.from_percent_encoded redirect - in - Dream.respond ~status:`See_Other - ~headers:[ ("Location", url) ] - "Logged in: Happy geo-posting!" ) - | form -> handle_invalid_form form - -let register_post request = - match%lwt Dream.form request with - | `Ok [ ("email", email); ("nick", nick); ("password", password) ] -> ( - match User.register ~email ~nick ~password with - | Error e -> render e - | Ok () -> - let res = - Result.fold ~error:Fun.id - ~ok:(fun _ -> "User created ! Welcome !") - (User.login ~login:nick ~password request) - in - render res ) - | form -> Util.handle_invalid_form form +let () = + regularly_call_fun to_repeat + (Shared.Time.s_to_float Shared.State.auto_update_rate) let () = let logger = if App.log then Dream.logger else Fun.id in - Dream.run ~port:App.port - ~error_handler:(Dream.error_template Util.error_template) - @@ logger @@ Dream.memory_sessions + Dream.run ~port:App.port @@ logger @@ Dream.sql_pool Db.db_uri + @@ Dream.sql_sessions ~lifetime:3600. @@ Dream.router Dream. - [ get "/assets/**" (Dream.static ~loader:Util.asset_loader "") - ; get "/" home_get - ; get "/login" login_get - ; post "/login" login_post - ; get "/register" register_get - ; post "/register" register_post + [ get "/assets/**" Asset.get + ; get "/" Home.get + ; get "/island" Island.get + ; get "/island/ws" (fun request -> + Dream.websocket @@ Ws.handle_client request ) + ; get "/login" Login.get + ; post "/login" Login.post + ; get "logout" Logout.get + ; get "/register" Register.get + ; post "/register" Register.post ] diff --git a/src/register.ml b/src/register.ml index f629fc0..700cb89 100644 --- a/src/register.ml +++ b/src/register.ml @@ -1,14 +1,19 @@ open Tyxml.Html open Tyx_util +open Syntax -let f request = - (* todo page titles? *) - let page_title = "Pellest|Register" in +let get request = + let** () = User.assert_not_logged request in + let title = "Pellest|Register" in let register = let submit = button ~a:[ a_id "submet_reginster" ] [ txt "submit" ] in - let nick = make_input_text "nick" in - let password = make_input_text "password" in - let email = make_input_text "email" in + let nick = input ~a:[ a_id "nick"; a_name "nick"; a_input_type `Text ] () in + let password = + input ~a:[ a_id "password"; a_name "password"; a_input_type `Password ] () + in + let email = + input ~a:[ a_id "email"; a_name "email"; a_input_type `Text ] () + in div [ make_form request ~action:"/register" ~items:[ nick; password; email; submit ] @@ -16,4 +21,14 @@ let f request = in let text = div [ txt "register a new pellestian ~!" ] in let page = div [ text; register ] in - Template.render ~page_title ~scripts:[] page + Template.render ~title ~scripts:[] page + +let post request = + let** () = User.assert_not_logged request in + match%lwt Dream.form request with + | `Ok [ ("email", email); ("nick", nick); ("password", password) ] -> + let** () = User.register ~email ~nick ~password in + let** () = User.login ~login:nick ~password request in + Template.render ~title:"Welcome !" ~scripts:[] + (Tyxml.Html.txt "User created ! Welcome !") + | _form -> Template.err (`Bad_Request, "invalid form") diff --git a/src/state.ml b/src/state.ml new file mode 100644 index 0000000..cc8af84 --- /dev/null +++ b/src/state.ml @@ -0,0 +1,156 @@ +module Offset : sig + val check_move : + x:float -> y:float -> Map.dir -> float * float * Map.dir Option.t +end = struct + let limit = 1. + + let step = 0.25 + + let check_move ~x ~y = function + | Map.Left -> + let x' = x +. step in + if x' >= limit then begin + let x' = ~-.limit in + (x', y, Some Map.Left) + end + else (x', y, None) + | Right -> + let x' = x -. step in + if x' <= ~-.limit then begin + let x' = limit in + (x', y, Some Right) + end + else (x', y, None) + | Down -> + let y' = y -. step in + if y' <= ~-.limit then begin + let y' = limit in + (x, y', Some Down) + end + else (x, y', None) + | Up -> + let y' = y +. step in + if y' >= limit then begin + let y' = ~-.limit in + (x, y', Some Up) + end + else (x, y', None) +end + +type t = + { map : Map.t + ; mana : int + ; wheat : int + ; player_pos : Map.position + ; offset_x : float + ; offset_y : float + } + +let init () = + { map = Map.init () + ; mana = 0 + ; wheat = 0 + ; player_pos = { x = 0; y = 0; dir = Down } + ; offset_x = 0. + ; offset_y = 0. + } + +type action = + | Meditate + (* TODO some action do not needs to be checked by server *) + | Move_offset of Map.dir + | Move of Map.dir + | Plant_wheat +(* TODO: we don't need dir so we should change the type of Map.position *) + +(* type for result of action send to the client by the server *) +type action' = + | Add_mana of int + | Set_player_position of Map.position + | Set_offset of float * float + | Plant_wheat of int * int + +let pp_action fmt = function + | Meditate -> Format.pp_print_string fmt "Meditate" + | Move_offset dir -> Format.fprintf fmt "Move_offset %a" Map.pp_dir dir + | Move dir -> Format.fprintf fmt "Move %a" Map.pp_dir dir + | Plant_wheat -> Format.fprintf fmt "Plant_wheat" + +let pp_action' fmt = function + | Add_mana n -> Format.fprintf fmt "Add_mana %d" n + | Set_player_position pos -> + Format.fprintf fmt "Set_player_position (%a)" Map.pp_position pos + | Set_offset (x, y) -> Format.fprintf fmt "Set_offset (%f, %f)" x y + | Plant_wheat (x, y) -> Format.fprintf fmt "Plant_wheat (%d, %d)" x y + +let plant_wheat_cost = 10 + +let rec check_action state = function + | Meditate -> + if state.mana < 99 then Ok [ Add_mana 1 ] else Error "maximum mana" + | Move dir -> ( + match Map.check_move state.map state.player_pos dir with + | Error _e as error -> error + | Ok pos -> Ok [ Set_player_position pos ] ) + | Move_offset dir -> + if dir <> state.player_pos.dir then + Ok [ Set_player_position { state.player_pos with dir } ] + else + let offset_x, offset_y, dir' = + Offset.check_move ~x:state.offset_x ~y:state.offset_y dir + in + let offset_action = + [ Set_player_position { state.player_pos with dir } + ; Set_offset (offset_x, offset_y) + ] + in + begin + match dir' with + | None -> Ok offset_action + | Some dir' -> begin + match check_action state (Move dir') with + | Error _e as e -> e + | Ok actions -> Ok (offset_action @ actions) + end + end + | Plant_wheat -> ( + let { Map.x; y; dir } = state.player_pos in + let x, y = + match dir with + | Down -> (x, y + 1) + | Left -> (x - 1, y) + | Right -> (x + 1, y) + | Up -> (x, y - 1) + in + match Map.get_tile_kind ~x ~y state.map with + | Map.Black -> Error "can't plant wheat in space !" + | Water -> Error "can't plant wheat in water !" + | Wheat -> Error "there's already some wheat there !" + | Grass -> + if state.mana >= plant_wheat_cost then Ok [ Plant_wheat (x, y) ] + else Error "not enough mana..." ) + +let perform_action state = function + | Add_mana n -> { state with mana = state.mana + n } + | Set_player_position player_pos -> { state with player_pos } + | Set_offset (offset_x, offset_y) -> { state with offset_x; offset_y } + | Plant_wheat (x, y) -> + state.map.tiles.(x).(y) <- Map.Wheat; + { state with mana = state.mana - plant_wheat_cost } + +let auto_update state = + let state = + match check_action state Meditate with + | Error _e -> state + | Ok actions -> List.fold_left perform_action state actions + in + let count_wheat = Map.count_wheat state.map.tiles in + { state with wheat = state.wheat + count_wheat } + +let auto_update_rate = Time.mk_s 1 + +let pp fmt { mana; wheat; player_pos; map; offset_x; offset_y } = + let bg = Map.get_tile_kind ~x:player_pos.x ~y:player_pos.y map in + Format.fprintf fmt + "mana = %d; wheat = %d; player_pos = %a; %a; offset_x = %f; offset_y = %f" + mana wheat Map.pp_position player_pos Map.pp_background bg offset_x offset_y diff --git a/src/syntax.ml b/src/syntax.ml index 62a0617..8b3cc40 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -1,12 +1,16 @@ -(* let bindings for early return when encountering an error *) -(* see https://ocaml.org/releases/4.13/htmlman/bindingops.html *) - let ( let* ) o f = Result.fold ~ok:f ~error:Result.error o -let unwrap_list f ids = - let l = List.map f ids in - let res = List.find_opt Result.is_error l in - match res with - | None -> Ok (List.map Result.get_ok l) - | Some (Ok _) -> assert false - | Some (Error _e as error) -> error +type extended_status = + [ Dream.status + | `See_Other_Redirect of (string * string) list + ] + +let ( let** ) o f = + match o with + | Error (kind, msg) -> begin + match kind with + | `See_Other_Redirect headers -> + Dream.respond ~status:`See_Other ~headers msg + | #Dream.status as status -> Template.err (status, msg) + end + | Ok v -> f v diff --git a/src/template.ml b/src/template.ml index 5ca3080..fa99a35 100644 --- a/src/template.ml +++ b/src/template.ml @@ -1,6 +1,6 @@ open Tyxml -let render ~page_title ~scripts content = +let generic ~page_title ~scripts content = let open Html in let head = head @@ -10,6 +10,13 @@ let render ~page_title ~scripts content = ] @ scripts ) in - let body = body [ main [ content ] ] in + let body = body [ main [ div [ content ] ] ] in let page = html head body in Format.asprintf "%a@." (pp ~indent:true ()) page + +let render ~title ~scripts content = + Dream.html @@ generic ~page_title:title ~scripts content + +let err (status, msg) = + let code = Dream.status_to_int status in + Dream.html ~code @@ generic ~page_title:"Error" ~scripts:[] (Html.txt msg) diff --git a/src/time.ml b/src/time.ml new file mode 100644 index 0000000..c96655d --- /dev/null +++ b/src/time.ml @@ -0,0 +1,27 @@ +include ( + struct + type s = int + + type ms = int + + let mk_s = Fun.id + + let s_to_float = float_of_int + + let s_to_ms s = 1000 * s + + let ms_to_float = float_of_int + end : + sig + type s + + type ms + + val mk_s : int -> s + + val s_to_float : s -> float + + val s_to_ms : s -> ms + + val ms_to_float : ms -> float + end ) diff --git a/src/tyx_util.ml b/src/tyx_util.ml index e516b4b..5a27465 100644 --- a/src/tyx_util.ml +++ b/src/tyx_util.ml @@ -1,7 +1,10 @@ open Tyxml.Html -let make_input_text id = input ~a:[ a_id id; a_name id; a_input_type `Text ] () +let csrf_tag request = + let open Tyxml.Html in + let token = Dream.csrf_token request in + input ~a:[ a_name "dream.csrf"; a_input_type `Hidden; a_value token ] () let make_form request ~action ~items = (* TODO labels ...? *) - form ~a:[ a_action action; a_method `Post ] (Util.csrf_tag request :: items) + form ~a:[ a_action action; a_method `Post ] (csrf_tag request :: items) diff --git a/src/user.ml b/src/user.ml index 1944b05..1ada3bd 100644 --- a/src/user.ml +++ b/src/user.ml @@ -32,37 +32,36 @@ module Q = struct let is_already_user = Db.find - @@ (tup2 string string ->! int) + @@ (t2 string string ->! int) "SELECT EXISTS(SELECT 1 FROM user WHERE nick=? OR email=?)" let upload_user = Db.exec - @@ (tup4 string string string string ->. unit) + @@ (t4 string string string string ->. unit) "INSERT INTO user VALUES (?, ?, ?, ?)" let list_nicks = Db.collect_list @@ (unit ->* string) "SELECT nick FROM user" let get_user = Db.find - @@ (string ->! tup4 string string string string) + @@ (string ->! t4 string string string string) "SELECT * FROM user WHERE user_id=?" let update_bio = Db.exec - @@ (tup2 string string ->. unit) "UPDATE user SET bio=? WHERE user_id=?" + @@ (t2 string string ->. unit) "UPDATE user SET bio=? WHERE user_id=?" let update_nick = Db.exec - @@ (tup2 string string ->. unit) "UPDATE user SET nick=? WHERE user_id=?" + @@ (t2 string string ->. unit) "UPDATE user SET nick=? WHERE user_id=?" let update_email = Db.exec - @@ (tup2 string string ->. unit) "UPDATE user SET email=? WHERE user_id=?" + @@ (t2 string string ->. unit) "UPDATE user SET email=? WHERE user_id=?" let update_password = Db.exec - @@ (tup2 string string ->. unit) - "UPDATE user SET password=? WHERE user_id=?" + @@ (t2 string string ->. unit) "UPDATE user SET password=? WHERE user_id=?" let get_email = Db.find @@ (string ->! string) "SELECT email FROM user WHERE user_id=?" @@ -71,11 +70,11 @@ module Q = struct Db.exec @@ (string ->. unit) "DELETE FROM user WHERE user_id=?" let upload_banished = - Db.exec @@ (tup2 string string ->. unit) "INSERT INTO banished VALUES (?,?)" + Db.exec @@ (t2 string string ->. unit) "INSERT INTO banished VALUES (?,?)" let get_banished = Db.find - @@ (tup2 string string ->! tup2 string string) + @@ (t2 string string ->! t2 string string) "SELECT * FROM banished WHERE nick=? OR email=?" end @@ -102,13 +101,15 @@ let login ~login ~password request = let try_password user_id = let* good_password = Q.get_password user_id in if Bcrypt.verify password (Bcrypt.hash_of_string good_password) then + (* TODO lwt + await them *) let _unit_lwt = Dream.invalidate_session request in - let _unit_lwt = Dream.put_session "user_id" user_id request in + let _unit_lwt = Dream.set_session_field request "user_id" user_id in let* nick = get_nick user_id in - let _unit_lwt = Dream.put_session "nick" nick request in + let _unit_lwt = Dream.set_session_field request "nick" nick in Ok () - else if is_banished login then Error "YOU ARE BANISHED" - else Error "wrong password" + else if is_banished login then Error (`Forbidden, "YOU ARE BANISHED") + else Error (`Forbidden, "wrong password") in let id_from_nick = get_id_from_nick login in @@ -120,7 +121,7 @@ let login ~login ~password request = List.iter (fun id -> if Result.is_ok @@ try_password id then raise Exit) user_id_list; - Error "invalid login" + Error (`Forbidden, "invalid login") with Exit -> Ok () let valid_nick nick = @@ -141,25 +142,28 @@ let register ~email ~nick ~password = let password = Bcrypt.hash password in let password = Bcrypt.string_of_hash password in - if not valid then Error "Something is wrong" + if not valid then Error (`Bad_Request, "invalid nick, email or password") else let* nb = Q.is_already_user (nick, email) in if nb = 0 then let user_id = Uuidm.to_string (Uuidm.v4_gen App.random_state ()) in Q.upload_user (user_id, nick, password, email) - else Error "nick or email already exists" + else Error (`Conflict, "nick or email already exists") let list () = let* users = Q.list_nicks () in Ok (Format.asprintf "
    %a
" (Format.pp_print_list (fun fmt -> function - | s -> Format.fprintf fmt {|
  • %s
    • |} s s ) - ) + | s -> Format.fprintf fmt {|
  • %s
    • |} s s )) users ) +let get_nick_unsafe request = Option.get @@ Dream.session_field request "nick" + +let is_logged_in request = Option.is_some @@ Dream.session_field request "nick" + let profile request = - match Dream.session "nick" request with + match Dream.session_field request "nick" with | None -> "not logged in" | Some nick -> Format.sprintf "Hello %s !" nick @@ -174,20 +178,20 @@ let delete_user user_id = Q.delete_user user_id let update_nick nick user_id = if valid_nick nick then if not (exist_nick nick) then Q.update_nick (nick, user_id) - else Error "nick already taken" - else Error "invalid nick" + else Error (`Conflict, "nick already taken") + else Error (`Bad_Request, "invalid nick") let update_email email user_id = if valid_email email then if not (exist_email email) then Q.update_email (email, user_id) - else Error "email already taken" - else Error "invalid email" + else Error (`Conflict, "email already taken") + else Error (`Bad_Request, "invalid email") let update_password password user_id = if valid_password password then let password = Bcrypt.hash password |> Bcrypt.string_of_hash in Q.update_password (password, user_id) - else Error "invalid password" + else Error (`Bad_Request, "invalid password") let public_profile user_id = let* user = get_user user_id in @@ -211,3 +215,35 @@ let public_profile user_id = user.nick user.nick in Ok user_info + +let assert_logged request = + if is_logged_in request then Ok () + else + let target = Dream.target request in + let redirect_url = + Format.sprintf "/login?redirect=%s" (Dream.to_percent_encoded target) + in + Error + ( `See_Other_Redirect [ ("Location", redirect_url) ] + , "you should be logged in" ) + +let assert_not_logged request = + if is_logged_in request then + (* redirect to the home page *) + Error + (`See_Other_Redirect [ ("Location", "/") ], "you shouldn't be logged in") + else Ok () + +(* TODO save states *) + +let state_ht : (string, Shared.State.t) Hashtbl.t = Hashtbl.create 1 + +let set_state = Hashtbl.replace state_ht + +let get_state user_id = + match Hashtbl.find_opt state_ht user_id with + | Some state -> Ok state + | None -> + let state = Shared.State.init () in + Hashtbl.replace state_ht user_id state; + Ok state diff --git a/src/util.ml b/src/util.ml deleted file mode 100644 index 36c635c..0000000 --- a/src/util.ml +++ /dev/null @@ -1,34 +0,0 @@ -let handle_invalid_form = function - | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" - | `Many_tokens _ | `Missing_token _ | `Invalid_token _ | `Wrong_session _ - | `Expired _ | `Wrong_content_type -> - Dream.empty `Bad_Request - -let asset_loader _root path _request = - match Content.read ("assets/" ^ path) with - | None -> Dream.empty `Not_Found - | Some asset -> - (* TODO cache-control: ~headers:[ ("Cache-Control", "max-age=151200") ] *) - Dream.respond asset - -let error_template _error _debug_info response = - let open Lwt.Syntax in - let status = Dream.status response in - let code = Dream.status_to_int status in - (*TODO improve: can't use template.elm.html because it needs "request" *) - let* body = Dream.body response in - let reason = - if String.equal "" body then Dream.status_to_string status else body - in - Dream.set_body response (Format.sprintf "%d: %s" code reason); - Lwt.return response - -let csrf_tag request = - let open Tyxml.Html in - let token = Dream.csrf_token request in - input ~a:[ a_name "dream.csrf"; a_input_type `Hidden; a_value token ] () - -let render s = - let open Tyxml.Html in - let page = div [ txt s ] in - Dream.html @@ Template.render ~page_title:"blblbl" ~scripts:[] page diff --git a/src/ws.ml b/src/ws.ml new file mode 100644 index 0000000..ee2cf30 --- /dev/null +++ b/src/ws.ml @@ -0,0 +1,52 @@ +open Lwt.Syntax +open Shared + +let get_state_unsafe user_id = + match User.get_state user_id with + | Error _e -> assert false + | Ok state -> state + +let handle_client request client = + match Dream.session_field request "user_id" with + | None -> Dream.log "User does not exists" |> Lwt.return + | Some user_id -> + (* send user island state for the first time *) + let state = get_state_unsafe user_id in + let* () = + Dream.send ~text_or_binary:`Text client + (Network.marshal (Network.Full_state state)) + in + + let rec loop () = + match%lwt Dream.receive client with + | None -> + (* TODO: backup everything to database *) + Dream.close_websocket client + | Some s -> + let state = get_state_unsafe user_id in + let (Network.Action_msg action : Network.client_message) = + Network.unmarshal s + in + Dream.log "checking action %a" State.pp_action action; + Dream.log "current state %a" State.pp state; + let res = + match State.check_action state action with + | Error msg as e -> + Dream.log "check_action error: %s" msg; + e + | Ok action' -> + Dream.log "check_action ok: %a" + (Format.pp_print_list + ~pp_sep:(fun fmt () -> Format.fprintf fmt " ; ") + State.pp_action' ) + action'; + let state = List.fold_left State.perform_action state action' in + User.set_state user_id state; + Ok action' + in + let* () = + Dream.send client (Network.marshal (Network.Update_result res)) + in + loop () + in + loop () diff --git a/src/ws_client.ml b/src/ws_client.ml new file mode 100644 index 0000000..05179c8 --- /dev/null +++ b/src/ws_client.ml @@ -0,0 +1,35 @@ +open Brr +open Brr_io +open Shared + +let ws = + let ws_url = + let location = Window.location G.window in + let host = Uri.host location |> Jstr.to_string in + let port = + Option.fold ~none:"" + ~some:(fun port -> Format.sprintf ":%d" port) + (Uri.port location) + in + let ws = if host = "localhost" then "ws" else "wss" in + Jstr.of_string @@ Format.sprintf "%s://%s%s/island/ws" ws host port + in + Websocket.create ws_url + +let ws_target = Websocket.as_target ws + +let on_event ws_event f = + let (_ : Ev.listener) = Ev.listen ws_event f ws_target in + () + +let to_server_msg ev = + let data = Message.Ev.data (Ev.as_type ev) |> Jstr.to_string in + let server_msg : Network.server_message = Network.unmarshal data in + server_msg + +let on_update_state_message f = + on_event Message.Ev.message (fun ev -> f (to_server_msg ev)) + +let send (msg : Network.client_message) = + let s = Jstr.of_string (Network.marshal msg) in + Websocket.send_string ws s