(ns cc.journeyman.walkmap.stl
  "Utility functions dealing with stereolithography (STL) files. Not a stable API yet!"
  (:require [cc.journeyman.walkmap.ocean :refer [ocean?]]
            [cc.journeyman.walkmap.polygon :refer [centre gradient triangle?]]
            [cc.journeyman.walkmap.superstructure :refer [store]]
            [cc.journeyman.walkmap.tag :refer [tag]]
            [cc.journeyman.walkmap.utils :refer [kind-type truncate]]
            [cc.journeyman.walkmap.vertex :as v :refer [vertex]]
            [clojure.core.matrix :refer [set-current-implementation sub]]
            [clojure.java.io :refer [input-stream]]
            [clojure.string :as s]
            [me.raynes.fs :refer [base-name split-ext]]
            [org.clojars.smee.binary.core :as b]
            [taoensso.timbre :refer [debug]])
  (:import [clojure.lang Keyword]))

;; We want to use the `[vectorz](https://github.com/mikera/vectorz-clj)` 
;; implementation of core.matrix.
(set-current-implementation :vectorz)

(defn stl?
  "True if `o` is recogniseable as an STL structure. An STL structure must
  have a key `:facets`, whose value must be a sequence of polygons; and
  may have a key `:header` whose value should be a string, and/or a key
  `:count`, whose value should be a positive integer.

  If `verify-count?` is passed and is not `false`, verify that the value of
  the `:count` header is equal to the number of facets."
  ([o]
   (stl? o false))
  ([o verify-count?]
   (and
    (map? o)
    (:facets o)
    (every? triangle? (:facets o)) 
    (if (:header o) (string? (:header o)) true)
    (if (:count o) (integer? (:count o)) true)
    (or (nil? (:kind o)) (= (:kind o) :stl))
    (if verify-count? (= (:count o) (count (:facets o))) true))))

(def vect
  "A codec for vectors within a binary STL file."
  (b/ordered-map
   :x :float-le
   :y :float-le
   :z :float-le))

(def facet
  "A codec for a facet (triangle) within a binary STL file."
  (b/ordered-map
   :normal vect
   :vertices [vect vect vect]
   :abc :ushort-le))

(def binary-stl
  "A codec for binary STL files"
  (b/ordered-map
   :header (b/string "ISO-8859-1" :length 80) ;; for the time being we neither know nor care what's in this.
   :count :uint-le
   :facets (b/repeated facet)))

(defn vertex->array
  [v]
  [(:x v) (:y v) (or (:z v) 0)])

(defn surface-normal 
  "From https://www.khronos.org/opengl/wiki/Calculating_a_Surface_Normal
   ```
   Begin Function CalculateSurfaceNormal (Input Triangle) Returns Vector
  
   Set Vector U to (Triangle.p2 minus Triangle.p1)
   Set Vector V to (Triangle.p3 minus Triangle.p1)
  
   Set Normal.x to (multiply U.y by V.z) minus (multiply U.z by V.y)
   Set Normal.y to (multiply U.z by V.x) minus (multiply U.x by V.z)
   Set Normal.z to (multiply U.x by V.y) minus (multiply U.y by V.x)
  
   Returning Normal
  
   End Function
   ```"
  [triangle]
  (if (triangle? triangle)
    (let 
     [vertices (:vertices triangle)
      v1 (vertex->array (nth vertices 0))
      u (sub (vertex->array (nth vertices 1)) v1)
      v (sub (vertex->array (nth vertices 2)) v1)
      x (- (* (nth u 1)(nth v 2)) (* (nth u 2) (nth v 1)))
          y (- (* (nth u 2) (nth v 0)) (* (nth u 0) (nth v 2)))
          z (- (* (nth u 0) (nth v 1)) (* (nth u 1 (nth v 0))))]
      (debug (format "Calculating normal for triangle %s" triangle))
      (vertex x y z))
    (throw (IllegalArgumentException. 
            (format "Expected :triangle, found %s" (kind-type triangle))))))

(defn ensure-normal
  "Ensure this `triangle` has a normal vector/"
  [triangle]
  (if (triangle? triangle)
    (if (:normal triangle) triangle 
        (assoc triangle :normal (surface-normal triangle)))
    (throw (IllegalArgumentException. 
            (format "Expected :triangle, found %s" (kind-type triangle))))))

(defn canonicalise
  "Objects read in from STL won't have all the keys/values we need them to have.
  `o` may be a map (representing a facet or a vertex), or a sequence of such maps;
  if it isn't recognised it is at present just returned unchanged. `map-kind`, if
  passed, must be a keyword indicating the value represented by the `z` axis
  (defaults to `:height`). It is an error, and an exception will be thrown, if
  `map-kind` is not a keyword."
  ([o] (canonicalise o :height))
  ([o ^Keyword map-kind]
   (canonicalise o map-kind (v/vertex 1 1 1)))
  ([o ^Keyword map-kind scale-vertex]
   (when-not
    (keyword? map-kind)
     (throw (IllegalArgumentException.
             (truncate (str "Must be a keyword: " (or map-kind "nil")) 80))))
   (cond
     (and (coll? o) (not (map? o))) (map #(canonicalise % map-kind) o)
     ;; if it has :facets it's an STL structure, but it doesn't yet conform to `stl?`
     (:facets o) (assoc o
                        :kind :stl
                        :walkmap.id/id (or (:walkmap.id/id o) 
                                           (keyword (gensym "stl")))
                        :facets (canonicalise (:facets o) map-kind))
     ;; if it's a triangle it's almost a facet. All it needs now is a normal 
     ;; vector
     (triangle? o) (ensure-normal o)
     ;; if it has :vertices it's a polygon, but it may not yet conform to
     ;; `polygon?`
     (:vertices o) (let [f (gradient
                            (centre
                             (tag
                              (assoc o
                                     :walkmap.id/id (or
                                                     (:walkmap.id/id o)
                                                     (keyword (gensym "poly")))
                                     :kind :polygon
                                     :vertices (canonicalise
                                                (:vertices o)
                                                map-kind))
                              :facet map-kind)))]
                     (if (ocean? f)
                       (tag f :ocean :no-traversal)
                       f))
     ;; if it has a value for :x it's a vertex, but it may not yet conform
     ;; to `vertex?`; it should also be scaled using the scale-vertex, if any.
     (:x o) (let [c (v/canonicalise o)]
              (if (v/vertex? scale-vertex)
                (v/vertex* c scale-vertex)
                c))
     ;; shouldn't happen
     :else o)))

(defn decode-binary-stl
  "Parse a binary STL file from this `filename` and return an STL structure
  representing its contents. `map-kind`, if passed, must be a keyword
  or sequence of keywords indicating the semantic value represented by the `z`
  axis (defaults to `:height`).

  If `superstructure` is supplied and is a map, the generated STL structure
  will be stored in that superstructure, which will be returned.

  If `scale-vertex` is supplied, it must be a three dimensional vertex (i.e.
  the `:z` key must have a numeric value) representing the amount by which
  each of the vertices read from the STL will be scaled.

  It is an error, and an exception will be thrown, if `map-kind` is not a
  keyword or sequence of keywords.

  **NOTE** that we've no way of verifying that the input file is binary STL
  data, if it is not this will run but will return garbage."
  ([^String filename]
   (decode-binary-stl filename :height))
  ([^String filename ^Keyword map-kind]
   (decode-binary-stl filename map-kind nil))
  ([^String filename ^Keyword mapkind superstucture]
   (decode-binary-stl filename mapkind superstucture (v/vertex 1 1 1)))
  ([^String filename ^Keyword map-kind superstructure scale-vertex]
   (let [in (input-stream filename)
         stl (canonicalise (b/decode binary-stl in) map-kind scale-vertex)]
     (if
      (map? superstructure)
       (store stl superstructure)
       stl))))

(defn- vect->str [prefix v]
  (str prefix " " (:x v) " " (:y v) " " (:z v) "\n"))

(defn- facet2str [tri]
  (str
   (vect->str "facet normal" (:normal tri))
   "outer loop\n"
   (s/join
    (map
     #(vect->str "vertex" %)
     (:vertices tri)))
   "endloop\nendfacet\n"))

(defn stl->ascii
  "Return as a string an ASCII rendering of the `stl` structure."
  ([stl]
   (stl->ascii stl "unknown"))
  ([stl solidname]
   (str
    "solid "
    (or solidname
    (when (:header stl)(s/trim (:header stl))))
    "\n"
    (s/join
     (map
      facet2str
      (:facets stl)))
    "endsolid "
    solidname
    "\n")))

(defn write-ascii-stl
  "Write an `stl` structure as read by `decode-binary-stl` to this
  `filename` as ASCII encoded STL."
  ([filename stl]
   (let [b (base-name filename true)]
     (write-ascii-stl
      filename stl
      (subs b 0 (or (s/index-of b ".") (count b))))))
  ([filename stl solidname]
   (debug (format "Writing STL to '%s'; solid name is %s" filename solidname)) 
   (spit
    filename
    (stl->ascii stl solidname))))

(defn binary-stl-to-ascii
  "Convert the binary STL file indicated by `in-filename`, and write it to
  `out-filename`, if specified; otherwise, to a file with the same basename
  as `in-filename` but the extension `.ascii.stl`."
  ([in-filename]
   (let [[_ ext] (split-ext in-filename)]
     (binary-stl-to-ascii
      in-filename
      (str
       (subs
        in-filename
        0
        (or
         (s/last-index-of in-filename ".")
         (count in-filename)))
       ".ascii"
       ext))))
  ([in-filename out-filename]
   (write-ascii-stl out-filename (decode-binary-stl in-filename))))