merge from leoservermod

front/index.js

@@ -0,0 +1,57 @@
+import L from 'leaflet';
+import 'leaflet/dist/leaflet.css';
+import * as marker from './marker.js';
+
+let bounds = [[0,0], [-3840, 3840]];
+
+let map = L.map('map', {
+  crs: L.CRS.Simple,
+  minZoom: -1,
+  maxZoom: 4
+});
+
+L.tileLayer('./maps/build/{z}/x{x}_y{y}.jpg', {
+  minZoom: -1,
+  maxZoom: 4,
+  minNativeZoom: 1,
+  maxNativeZoom: 3,
+  tileSize: 1000,
+  bounds: [[0,0], [-3840, 3840]]
+}).addTo(map);
+
+// let image = L.imageOverlay('./maps/Tanoa.png', bounds).addTo(map);
+map.fitBounds(bounds);
+
+let UNITS_POS_MARKER = [];
+
+function update_units_pos () {
+  let sideToType = {
+    "WEST": "blue",
+    "EAST": "red",
+    "GUER": "green",
+    "CIV": "purple"
+  };
+
+  fetch('/units-pos')
+    .then((response) => {
+      return response.json();
+    })
+    .then((units_pos_array) => {
+      for(let marker of UNITS_POS_MARKER) {
+	map.removeLayer(marker);
+      }
+      UNITS_POS_MARKER = [];
+
+      for(let u of units_pos_array) {
+	let pos_marker = marker.makeUnitPos(
+	  u.position,
+	  sideToType[u.side]
+	);
+	UNITS_POS_MARKER.push(pos_marker);
+	pos_marker.addTo(map);
+      }
+    });
+}
+
+setInterval(update_units_pos, 1000);
+

front/marker.js

@@ -0,0 +1,44 @@
+import L from 'leaflet';
+
+const icon_types = {
+  "blue": "blue.png",
+  "red": "red.png",
+  "green": "green.png",
+  "purple": "purple.png",
+  "loc_blue": "loc_blue.png",
+  "loc_red": "loc_red.png",
+  "loc_yellow": "loc_yellow.png"
+};
+
+function makeMarker(coord=[0, 0], icon='loc_blue', text='') {
+  let markerIcon = L.icon({
+    iconSize:     [30, 30],
+    iconAnchor:   [15, 15],
+    iconUrl: './marker/' + icon_types[icon]
+  });
+
+  let [x, y] = coord;
+  y = y/8 - (15360/8);
+  x = x/8;
+  let marker = L.marker(L.latLng(y, x), {icon: markerIcon});
+  // https://gis.stackexchange.com/questions/59571/how-to-add-text-only-labels-on-leaflet-map-with-no-icon
+  marker.bindTooltip(text, {permanent: true, offset: [15, 0]});
+  return marker;
+}
+
+function makeUnitPos(coord=[0, 0], icon='purple') {
+  let markerIcon = L.icon({
+    iconSize:     [16, 16],
+    iconAnchor:   [8, 8],
+    iconUrl: './marker/' + icon_types[icon]
+  });
+
+  let [x, y] = coord;
+  y = y/8 - (15360/8);
+  x = x/8;
+  let marker = L.marker(L.latLng(y, x), {icon: markerIcon});
+  return marker;
+}
+
+export {icon_types, makeMarker, makeUnitPos};
+

front/package.json

@@ -0,0 +1,22 @@
+{
+  "name": "leoservermod_frontend",
+  "version": "1.0.0",
+  "description": "",
+  "main": "index.js",
+  "scripts": {
+    "test": "echo \"Error: no test specified\" && exit 1"
+  },
+  "author": "",
+  "license": "MIT",
+  "devDependencies": {
+    "css-loader": "^3.4.2",
+    "style-loader": "^1.1.3",
+    "url-loader": "^3.0.0",
+    "webpack": "^4.41.6",
+    "webpack-cli": "^3.3.11"
+  },
+  "dependencies": {
+    "leaflet": "^1.6.0",
+    "leaflet.label": "^0.2.4"
+  }
+}

front/webpack.config.js

@@ -0,0 +1,19 @@
+const path = require('path');
+
+module.exports = {
+  entry: './index.js',
+  output: {
+    filename: 'index.js',
+    path: path.resolve(__dirname, '../static/'),
+  },
+  module: {
+    rules: [
+      { test: /\.css$/, loader: 'style-loader!css-loader' },
+      {
+        test: /\.png$/,
+        loader: 'url-loader',
+        query: { mimetype: 'image/png' }
+      }
+    ]
+  }
+};

server-lisp/server.lisp

@@ -0,0 +1,108 @@
+(ql:quickload :woo)
+(ql:quickload :clack)
+(ql:quickload :flexi-streams)
+(ql:quickload :file-types)
+(ql:quickload :cl-ppcre)
+(ql:quickload :cl-json)
+(load "utils.lisp")
+
+(defparameter +static-directory+ "~/arma3/static/")
+
+(defparameter +static-prefix+ "/static/")
+
+(defun route-ok (env)
+  (declare (ignore env))
+  '(200 (:content-type "text/plain")
+    ("ok!")))
+
+(defun route-not-found (&optional env)
+  (declare (ignore env))
+  '(404 (:content-type "text/plain") ("File not found")))
+
+(defun serve-static-file (env)
+  (let* ((request-path (getf env :request-uri))
+         (file-path (pathname (concatenate 'string
+                                           +static-directory+
+                                           (subseq request-path
+                                                   (length +static-prefix+))))))
+    ;(format t "file path: ~A~%" file-path)
+    (if (probe-file file-path)
+        (let ((mime-string
+               (let ((mime (file-types:file-mime file-path)))
+                 (format nil "~A/~A" (nth 0 mime) (nth 1 mime)))))
+          `(200 (:content-type ,mime-string) ,file-path))
+        (route-not-found))))
+
+(defparameter *marker-info*
+  '(("Terminal" "mil_start" "ColorRed" (14648.7 16756.7 0))
+    ("Small Island" "mil_objective" "ColorBlue" (8443.6 25118.3 0))
+    ("Molos Airfield" "mil_marker" "ColorGreen" (27096.1 24840.6 0))))
+
+(defun route-post-arma3-info (env)
+  (let* ((decoded-stream
+          (flex:make-flexi-stream (getf env :raw-body) :external-format :utf-8))
+         (body (read-string-stream decoded-stream)))
+    ;;(format t "~&post body:~A~%" body)
+    (let ((parsed (json:decode-json-from-string body)))
+      (setf *marker-info* (nth 0 parsed))
+      (setf *units-info* (nth 1 parsed)))
+      ;; (print parsed))
+    (route-ok nil)))
+
+(defparameter *units-info*
+  '(("WEST" (1000.0 1000.0 0.0))
+    ("EAST" (2222.0 1555.0 0.0))))
+
+(defun route-units-pos (env)
+  (declare (ignore env))
+  (let* ((tagged-units-pos
+          (mapcar (lambda (u)
+                    (destructuring-bind (side position) u
+                      `(("side" . ,side)
+                        ("position" . ,position))))
+                  *units-info*))
+         (json (json:encode-json-to-string tagged-units-pos)))
+    `(200 (:content-type "application/json")
+          (,json))))
+
+(defun dispatch (request-path dispatch-table)
+  ;; path: request url
+  ;; dispatch-table: '(matcher function)
+  ;;   * matcher: string or t
+  ;;   * function (env) => clack-response
+  (let (result)
+    (dolist (route dispatch-table)
+      (etypecase (car route)
+        (string (if (ppcre:scan (car route) request-path)
+                      (progn (setf result route)
+                             (return))))
+        (boolean (progn (setf result route)
+                        (return)))))
+    (nth 1 result)))
+
+(defparameter +dispatch-table+
+  `(("^/$" ,#'route-ok)
+    ("^/post-arma3-info$" ,#'route-post-arma3-info)
+    ("^/units-pos$" ,#'route-units-pos)
+    (,(concatenate 'string "^" +static-prefix+ ".*$") ,#'serve-static-file)
+    (nil ,#'route-not-found)))
+
+
+(defparameter *web-server*
+  (clack:clackup
+   (lambda (env)
+     (let ((route-function (dispatch (getf env :request-uri) +dispatch-table+)))
+       (format t "method:~A uri:~A route: ~A~%"
+               (getf env :request-method)
+               (getf env :request-uri)
+               route-function)
+       (funcall route-function env)))
+   :server :woo
+   :use-default-middlewares nil
+   :use-thread t
+   :port 5000
+   :address "0.0.0.0"))
+
+
+(if (find-package 'swank)
+    (clack:stop *web-server*))

server-lisp/utils.lisp

@@ -0,0 +1,44 @@
+(defun read-file-as-binary (file-path)
+  (with-open-file (stream file-path :element-type '(unsigned-byte 8))
+    (let ((buffer (make-array (file-length stream)
+                               :element-type '(unsigned-byte 8))))
+      (read-sequence buffer stream)
+      buffer)))
+
+(defun make-dynamic-string (&optional length)
+  (make-array length :adjustable t
+              :fill-pointer 0
+              :element-type 'character))
+;; (let ((s (make-dynamic-string)))
+;;   (vector-push-extend #\a s)
+;;   (vector-push-extend #\b s)
+;;   s)
+
+(defmacro mvb-let* (bindings &body body)
+  (let* ((exp (car bindings))
+         (vars (butlast exp))
+         (multi-val-exp (car (last exp)))
+         (rest-bindings (cdr bindings)))
+    (if rest-bindings
+        `(multiple-value-bind ,vars ,multi-val-exp
+           (mvb-let* ,rest-bindings ,@body))
+        `(multiple-value-bind ,vars ,multi-val-exp
+           ,@body))))
+;; (defun test-binding-0 ()
+;;   (values 1 2))
+;; (defun test-binding-1 ()
+;;   (values 1 2 3))
+;; (mvb-let* ((a b (test-binding-0))
+;;            (c d e (test-binding-1)))
+;;   (list a b c d e))
+
+(defun read-string-stream (stream)
+  (let* ((buffer (make-string 5))
+         (result-list '()))
+    (do ((read-count (read-sequence buffer stream)
+                     (read-sequence buffer stream)))
+        ((= read-count 0) nil)
+      (push (subseq buffer 0 read-count) result-list))
+    (format nil "~{~a~}" (reverse result-list))))
+;; (with-input-from-string (s "0123456789012")
+;;   (read-string-stream s))

static/index.html

@@ -0,0 +1,21 @@
+<!DOCTYPE html>
+<html>
+  <head>
+    <meta charset="utf-8">
+    <title>leoservermod</title>
+    <style>
+      #map {
+	  position: absolute;
+	  left: 0px;
+	  top: 0px;
+          width: 100%;
+          height: 100%;
+	  background: black;
+      }
+    </style>
+  </head>
+  <body>
+    <div id="map"></div>
+    <script src="./index.js"></script>
+  </body>
+</html>

static/maps/build/build.sh

@@ -0,0 +1,23 @@
+#!/bin/bash
+
+set -x
+
+convert ../Tanoa.png -resize '25%' x1.png
+convert ../Tanoa.png -resize '50%' x2.png
+cp ../Tanoa.png x3.png
+
+function tile_image {
+	local num=$1;
+	mkdir ${num};
+	convert x${num}.png -crop 1000x1000 \
+		-background none \
+		-gravity northwest -extent 1000x1000 \
+		-set filename:tile "x%[fx:floor(page.x/1000+0.1)]_y%[fx:floor(page.y/1000+0.1)]" \
+		-quality '85%' \
+		+repage  +adjoin \
+		"./${num}/%[filename:tile].jpg";
+}
+
+tile_image 1
+tile_image 2
+tile_image 3