Using PROJ from ClojureCLR on .NET 8 for fun and profit (at your own risk, no implied warranty etc)

proj.cljr

;; Using proj from ClojureCLR on .NET 8 for fun and profit (at your own risk, no implied warranty etc)
;;
;; Inspired by https://ericsink.com/entries/native_library.html
;; Tested on Ubuntu 22.04 with libproj-dev 8.2.1
;
;<Project Sdk="Microsoft.NET.Sdk">
;  <PropertyGroup>
;    <OutputType>Exe</OutputType>
;    <TargetFramework>net8.0</TargetFramework>
;    <ImplicitUsings>enable</ImplicitUsings>
;  </PropertyGroup>
;  <ItemGroup>
;    <PackageReference Include="Clojure" Version="1.12.0-alpha8" />
;    <PackageReference Include="clojure.tools.nrepl" Version="0.1.0-alpha1" />
;  </ItemGroup>
;</Project>

(ns example.proj
    (:use clojure.repl clojure.pprint)
    (:require [clojure.clr.io :as io]
              [clojure.string :as string])
    (:import [System.Collections IList ICollection IEnumerable IEnumerator]
             [System.Reflection BindingFlags FieldInfo AssemblyName TypeAttributes]
             [System.Reflection FieldAttributes MethodAttributes MethodImplAttributes]
             [System.Reflection.Emit OpCodes AssemblyBuilder AssemblyBuilderAccess]
             [System.Reflection CallingConventions Emit.CustomAttributeBuilder]
             [System.Runtime.InteropServices NativeLibrary Marshal]
             [System.Runtime.InteropServices MarshalAsAttribute UnmanagedType]))


(defn invalid-op [tb interface method return-type parameter-types]
  (let [exCtorInfo (.GetConstructor InvalidOperationException Type/EmptyTypes)
        mb         (.DefineMethod tb (name method)
                                  (enum-or MethodAttributes/Virtual MethodAttributes/HideBySig MethodAttributes/Public)
                                  return-type
                                  (into-array Type parameter-types))
        il         (.GetILGenerator mb)]
    (.Emit il OpCodes/Newobj exCtorInfo)
    (.Emit il OpCodes/Throw)
    (.DefineMethodOverride tb mb (.GetMethod interface (name method) (into-array Type parameter-types)))
    nil))

(def counter (atom 0))

(defn make-struct-type
  "Generate a subclass of ValueType with attributes to facilitate interop as well as methods to implement
   IList for convenient use from Clojure. Basically a fixed size array wrapped in a struct e.g. PJ_COORD."
  [element-type n]
  (let [assemblyName                (new AssemblyName (format "Dynamic%d" (swap! counter inc)))
        assemblyBuilder             (AssemblyBuilder/DefineDynamicAssembly assemblyName AssemblyBuilderAccess/Run)
        module                      (.DefineDynamicModule assemblyBuilder "DynamicTypeModule")
        tb                          (.DefineType module
                                                 (format "%s%d-%s" (.Name element-type) n (Guid/NewGuid))
                                                 (enum-or TypeAttributes/Public TypeAttributes/SequentialLayout)
                                                 ValueType)

        ;; create field which is to hold array value
        field-name                  "Value"
        field-type                  (Type/GetType (String/Concat (.FullName element-type) "[]") true false)
        fb                          (.DefineField tb field-name field-type FieldAttributes/Public)
        cinfo                       (.GetConstructor MarshalAsAttribute (into-array Type [UnmanagedType]))
        cab                         (new CustomAttributeBuilder cinfo (object-array [UnmanagedType/ByValArray])
                                      (into-array FieldInfo [(.GetField MarshalAsAttribute "SizeConst")])
                                      (object-array [(int n)]))
        _                           (.SetCustomAttribute fb cab)

        ;; constructor (testing only!)
        objCtor                     (.GetConstructor Object Type/EmptyTypes)
        mb                          (.DefineConstructor tb
                                                        (enum-or MethodAttributes/RTSpecialName MethodAttributes/HideBySig MethodAttributes/Public)
                                                        CallingConventions/Standard
                                                        (into-array Type [field-type]))
        il                          (.GetILGenerator mb)
        _                           (.Emit il OpCodes/Ldarg_0)
        _                           (.Emit il OpCodes/Call objCtor)
        _                           (.Emit il OpCodes/Ldarg_0)
        _                           (.Emit il OpCodes/Ldarg_1)
        _                           (.Emit il OpCodes/Stfld fb)
        _                           (.Emit il OpCodes/Ret)

        ;; proxy calls to GetEnumerator onto field's GetEnumerator method
        _                           (.AddInterfaceImplementation tb IEnumerable)

        mb                          (.DefineMethod tb "GetEnumerator"
                                                   (enum-or MethodAttributes/Virtual MethodAttributes/HideBySig MethodAttributes/Public)
                                                   IEnumerator
                                                   Type/EmptyTypes)
        il                          (.GetILGenerator mb)
        _                           (.Emit il OpCodes/Ldarg_0)
        _                           (.Emit il OpCodes/Ldfld fb)
        _                           (.Emit il OpCodes/Call (.GetMethod field-type "GetEnumerator"))
        _                           (.Emit il OpCodes/Ret)
        _                           (.DefineMethodOverride tb mb (.GetMethod IEnumerable "GetEnumerator"))

        ;; proxy ICollection onto field
        _                           (.AddInterfaceImplementation tb ICollection)
        mb                          (.DefineMethod tb "CopyTo"
                                                   (enum-or MethodAttributes/Virtual MethodAttributes/HideBySig MethodAttributes/Public)
                                                   Void
                                                   (into-array Type [Array Int32]))
        il                          (.GetILGenerator mb)
        _                           (.Emit il OpCodes/Ldarg_0)
        _                           (.Emit il OpCodes/Ldfld fb)
        _                           (.Emit il OpCodes/Ldarg_1)
        _                           (.Emit il OpCodes/Ldarg_2)
        _                           (.Emit il OpCodes/Call (.GetMethod field-type "CopyTo" (into-array Type [Array Int32])))
        ;_                           (.Emit il OpCodes/Ret)
        _                           (.DefineMethodOverride tb mb (.GetMethod ICollection "CopyTo"))

        mb                          (.DefineMethod tb "get_Count"
                                                   (enum-or MethodAttributes/Virtual MethodAttributes/HideBySig MethodAttributes/Public)
                                                   Int32
                                                   Type/EmptyTypes)
        il                          (.GetILGenerator mb)
        _                           (.Emit il OpCodes/Ldarg_0)
        _                           (.Emit il OpCodes/Ldfld fb)
        _                           (.Emit il OpCodes/Call (.GetMethod field-type "get_Length")) ;; hmm, why not get_Count here?
        _                           (.Emit il OpCodes/Ret)
        _                           (.DefineMethodOverride tb mb (.GetMethod ICollection "get_Count"))

        mb                          (.DefineMethod tb "get_IsSynchronized"
                                                   (enum-or MethodAttributes/Virtual MethodAttributes/HideBySig MethodAttributes/Public)
                                                   Boolean
                                                   Type/EmptyTypes)
        il                          (.GetILGenerator mb)
        _                           (.Emit il OpCodes/Ldarg_0)
        _                           (.Emit il OpCodes/Ldfld fb)
        _                           (.Emit il OpCodes/Call (.GetMethod field-type "get_IsSynchronized"))
        _                           (.Emit il OpCodes/Ret)
        _                           (.DefineMethodOverride tb mb (.GetMethod ICollection "get_IsSynchronized"))

        mb                          (.DefineMethod tb "get_SyncRoot"
                                                   (enum-or MethodAttributes/Virtual MethodAttributes/HideBySig MethodAttributes/Public)
                                                   Object
                                                   Type/EmptyTypes)
        il                          (.GetILGenerator mb)
        _                           (.Emit il OpCodes/Ldarg_0)
        _                           (.Emit il OpCodes/Ldfld fb)
        _                           (.Emit il OpCodes/Call (.GetMethod field-type "get_SyncRoot"))
        _                           (.Emit il OpCodes/Ret)
        _                           (.DefineMethodOverride tb mb (.GetMethod ICollection "get_SyncRoot"))

        ;  ICollection
        ;  (CopyTo [this arr offset]
        ;     (dotimes [i cnt]
        ;       (aset arr (+ i offset) (.nth this i))))
        ;          
        ;  (get_Count [_] cnt)
        ;  (get_IsSynchronized [_] true)
        ;  (get_SyncRoot [this] this)

        ;; proxy IList onto field
        _                           (.AddInterfaceImplementation tb IList)
        mb                          (.DefineMethod tb "get_Item"
                                                   (enum-or MethodAttributes/Virtual MethodAttributes/HideBySig MethodAttributes/Public)
                                                   Object
                                                   (into-array Type [Int32]))
        il                          (.GetILGenerator mb)
        _                           (.Emit il OpCodes/Ldarg_0)
        _                           (.Emit il OpCodes/Ldfld fb)
        _                           (.Emit il OpCodes/Ldarg_1)
        _                           (.Emit il OpCodes/Call (.GetMethod field-type "GetValue" (into-array Type [Int32])))
        _                           (.Emit il OpCodes/Ret)
        _                           (.DefineMethodOverride tb mb (.GetMethod IList "get_Item" (into-array Type [Int32])))

        mb                          (.DefineMethod tb "get_IsReadOnly"
                                                   (enum-or MethodAttributes/Virtual MethodAttributes/HideBySig MethodAttributes/Public)
                                                   Boolean
                                                   Type/EmptyTypes)
        il                          (.GetILGenerator mb)
        _                           (.Emit il OpCodes/Ldarg_0)
        _                           (.Emit il OpCodes/Ldfld fb)
        _                           (.Emit il OpCodes/Call (.GetMethod field-type "get_IsReadOnly"))
        _                           (.Emit il OpCodes/Ret)
        _                           (.DefineMethodOverride tb mb (.GetMethod IList "get_IsReadOnly"))

        mb                          (.DefineMethod tb "get_IsFixedSize"
                                                   (enum-or MethodAttributes/Virtual MethodAttributes/HideBySig MethodAttributes/Public)
                                                   Boolean
                                                   Type/EmptyTypes)
        il                          (.GetILGenerator mb)
        _                           (.Emit il OpCodes/Ldarg_0)
        _                           (.Emit il OpCodes/Ldfld fb)
        _                           (.Emit il OpCodes/Call (.GetMethod field-type "get_IsFixedSize"))
        _                           (.Emit il OpCodes/Ret)
        _                           (.DefineMethodOverride tb mb (.GetMethod IList "get_IsFixedSize"))

        _                           (invalid-op tb IList 'Add Int32 [Object])
        _                           (invalid-op tb IList 'Clear Void [])
        _                           (invalid-op tb IList 'Remove Void [Object])
        ;_                           (invalid-op tb IList 'get_Item Object [Int32])
        _                           (invalid-op tb IList 'set_Item Void [Int32 Object])
        _                           (invalid-op tb IList 'Insert Void [Int32 Object])
        ;_                           (invalid-op tb IList 'IndexOf Int32 [Object Int32 Int32])
        ;_                           (invalid-op tb IList 'IndexOf Int32 [Object Int32])
        _                           (invalid-op tb IList 'IndexOf Int32 [Object])
        _                           (invalid-op tb IList 'Contains Boolean [Object])
        _                           (invalid-op tb IList 'RemoveAt Void [Int32])

        ;  IList
        ;  (Add [_ v] (throw (InvalidOperationException.)))
        ;  (Clear [_] (throw (InvalidOperationException.)))
        ;  (Insert [_ i v] (throw (InvalidOperationException.)))
        ;  (Remove [_ v] (throw (InvalidOperationException.)))
        ;  (RemoveAt [_ i] (throw (InvalidOperationException.)))
        ;  (Contains [this o] (boolean (some #(= % o) this)))
        ;  (IndexOf [this o]
        ;    (loop [i (int 0)]
        ;      (cond
        ;        (== i (.-Length (.-Item s))) -1
        ;        (= o (aget (.-Item s) i)) i
        ;        :else (recur (inc i)))))
        ;  (get_IsFixedSize [_] true)
        ;  (get_Item [this i] (aget (.-Item s) i))
        ;  (set_Item [_ i v] (throw (InvalidOperationException.)))
        ]
    (.CreateType tb)))

(def delegate-type-factory
  (let [assemblyName    (new AssemblyName (format "%s-Delegates" (str *ns*)))
        assemblyBuilder (AssemblyBuilder/DefineDynamicAssembly assemblyName AssemblyBuilderAccess/RunAndCollect)
        module          (.DefineDynamicModule assemblyBuilder "DynamicTypeModule")]
    (fn [returnType parameterTypes]
      (let [tb           (.DefineType module
                                      (format "DynamicDelegate-%s" (Guid/NewGuid))
                                      (enum-or TypeAttributes/Public TypeAttributes/Sealed)
                                      MulticastDelegate)
            ctr          (.DefineConstructor tb
                                             (enum-or MethodAttributes/RTSpecialName MethodAttributes/HideBySig MethodAttributes/Public)
                                             CallingConventions/Standard
                                             (into-array Type [Object IntPtr]))
            _            (.SetImplementationFlags ctr
                                                  (enum-or MethodImplAttributes/Runtime MethodImplAttributes/Managed))
            invokeMethod (.DefineMethod tb "Invoke"
                                        (enum-or MethodAttributes/Virtual MethodAttributes/HideBySig MethodAttributes/Public)
                                        returnType
                                        parameterTypes)
            _            (.SetImplementationFlags invokeMethod
                                                  (enum-or MethodImplAttributes/Runtime MethodImplAttributes/Managed))]
        (.CreateType tb)))))

(def libs
  {"proj_"
   {:instance (NativeLibrary/Load "/usr/lib/x86_64-linux-gnu/libproj.so")   ; Linux
              #_(NativeLibrary/Load "/usr/local/lib/libproj.dylib")         ; macOS
              #_(NativeLibrary/Load "C:\\OSGeo4W\\bin\\proj_8_2.dll")       ; Windows
    :success  0
    :errors
    {1024 ["PROJ_ERR_INVALID_OP"
           "other/unspecified error related to coordinate operation initialization"]
     1025 ["PROJ_ERR_INVALID_OP_WRONG_SYNTAX"
           "invalid pipeline structure, missing +proj argument, etc"]
     1026 ["PROJ_ERR_INVALID_OP_MISSING_ARG"
           "missing required operation parameter"]
     1027 ["PROJ_ERR_INVALID_OP_ILLEGAL_ARG_VALUE"
           "one of the operation parameter has an illegal value"]
     1028 ["PROJ_ERR_INVALID_OP_MUTUALLY_EXCLUSIVE_ARGS" "mutually exclusive arguments"]
     1029 ["PROJ_ERR_INVALID_OP_FILE_NOT_FOUND_OR_INVALID"
           "file not found (particular case of PROJ_ERR_INVALID_OP_ILLEGAL_ARG_VALUE)"]
     4096 ["PROJ_ERR_OTHER" ""]}}})

(defn delegate-for-function-pointer
  [export types]
  (Marshal/GetDelegateForFunctionPointer
   export
   (delegate-type-factory (last types) (into-array Type (butlast types)))))

(defn zero?' [z]
  (cond (instance? IntPtr z) (= IntPtr/Zero z)
        (instance? IConvertible z) (zero? z)
        :default false))

(defn make-fn [{:keys [function-name arg-types return-type failure zero-means-success?]}]
  {:pre [(vector? arg-types)]}
  (let [prefix  (cond (string/starts-with? function-name "proj_") "proj_"
                      :default                                    (throw (new ArgumentException "no library found")))
        library (get-in libs [prefix :instance])
        export  (NativeLibrary/GetExport library function-name)
        types   (conj arg-types (or return-type IntPtr))]
    (fn [& args]
      (let [delegate (delegate-for-function-pointer export types) ;; TODO: cache this? something weird happening with GC
            _        (assert (not (nil? delegate)))
            ret      (case (count args)
                           0 (.Invoke delegate)
                           1 (.Invoke delegate (nth args 0))
                           2 (.Invoke delegate (nth args 0) (nth args 1))
                           3 (.Invoke delegate (nth args 0) (nth args 1) (nth args 2))
                           4 (.Invoke delegate (nth args 0) (nth args 1) (nth args 2) (nth args 3))
                           5 (.Invoke delegate (nth args 0) (nth args 1) (nth args 2) (nth args 3) (nth args 4)))]
        (cond (and (zero?' ret) zero-means-success?)       true
              (and (zero?' ret) (not zero-means-success?)) (throw (new Exception (format "%s returned zero" function-name)))
              ;; TODO: use proj_context_errno(ctx)
              (and (not (zero?' ret)) zero-means-success?) (throw
                                                             (new Exception
                                                               (apply format "%s %d %s %s" function-name ret (get-in libs [prefix :errors ret] [nil nil]))))
              (nil? return-type)                           nil
              :else                                        ret)))))

(def proj_context_create
  (make-fn
   {:function-name "proj_context_create" :arg-types [] :return-type IntPtr}))

(def proj_create
  (make-fn
   {:function-name "proj_create"
    :arg-types     [IntPtr String]
    :return-type   IntPtr}))

(def proj_as_wkt
  (make-fn
   {:function-name "proj_as_wkt"
    :arg-types     [IntPtr IntPtr Int32 IntPtr]
    :return-type   IntPtr}))

(def proj_crs_get_geodetic_crs
  (make-fn
   {:function-name "proj_crs_get_geodetic_crs"
    :arg-types     [IntPtr, IntPtr]
    :return-type   IntPtr}))

(def proj_create_crs_to_crs
  (make-fn
   {:function-name "proj_create_crs_to_crs"
    :arg-types     [IntPtr, String, String, IntPtr]
    :return-type   IntPtr}))

(def proj_create_crs_to_crs_from_pj
  (make-fn
   {:function-name "proj_create_crs_to_crs_from_pj"
    :arg-types     [IntPtr, IntPtr, IntPtr, IntPtr, String]
    :return-type   IntPtr}))

(def Coord (make-struct-type Double 4))

(def proj_coord
  (make-fn
   {:function-name "proj_coord"
    :arg-types     [Double, Double, Double, Double]
    :return-type   Coord}))

(def proj_trans
  (make-fn
   {:function-name "proj_trans"
    :arg-types     [IntPtr, Int32, Coord]
    :return-type   Coord}))

(def proj_destroy
  (make-fn
   {:function-name       "proj_destroy"
    :arg-types           [IntPtr]
    :return-type         IntPtr
    :zero-means-success? true}))

(def proj_context_destroy
  (make-fn
   {:function-name       "proj_context_destroy"
    :arg-types           [IntPtr]
    :return-type         IntPtr
    :zero-means-success? true}))

(def PJ_WKT2_2019 (int 2))
(def PJ_FWD (int 1))
(def PJ_INV (int -1))
(def HUGE_VAL Double/PositiveInfinity)

;; todo : implement something like (with-open ...) for IntPtr -> proj_destroy
(defn convert [to params]
  (let [{:keys [lat lon h x y z srs]} (merge {:srs "EPSG:4326"} params)
        _                             (case srs
                                            "EPSG:4326" (assert (and (some? lat) (some? lon)))
                                            "EPSG:4979" (assert (and (some? lat) (some? lon) (some? h)))
                                            "EPSG:4978" (assert (and (some? x) (some? y) (some? z))))
        C                             (proj_context_create)
        P                             (proj_create_crs_to_crs C srs to IntPtr/Zero)
        c_in                          (case srs
                                            "EPSG:4326" (proj_coord lat lon 0.0 HUGE_VAL)
                                            "EPSG:4979" (proj_coord lat lon h HUGE_VAL)
                                            "EPSG:4978" (proj_coord x y z HUGE_VAL))
        c_out                         (proj_trans P PJ_FWD c_in)]
    (case to
          "EPSG:4326" {:lat (nth c_out 0) :lon (nth c_out 1)}
          "EPSG:4979" {:lat (nth c_out 0) :lon (nth c_out 1) :h (nth c_out 2)}
          "EPSG:4978" {:x (nth c_out 0) :y (nth c_out 1) :z (nth c_out 2)})))

(comment

(convert "EPSG:4326" (assoc (convert "EPSG:4978" {:lon 12.0 :lat 55.0}) :srs "EPSG:4978"))
 
(prefer-method print-method ICollection ValueType)

;; port of example from proj quick start guide
;; https://proj.org/en/9.3/development/quickstart.html

(def C (proj_context_create))
(def P (proj_create C "+proj=utm +zone=32 +datum=WGS84 +type=crs"))

(def G (proj_crs_get_geodetic_crs C P))
(def G2P (proj_create_crs_to_crs_from_pj C G P IntPtr/Zero nil))

(zipmap [:lat :lon] (proj_trans G2P PJ_INV (proj_trans G2P PJ_FWD (proj_coord 12.0 55.0 0.0 HUGE_VAL))))

;; Copenhagen
(def c_in (proj_coord 12.0 55.0 0.0 HUGE_VAL))
(def result1 (proj_trans G2P PJ_FWD c_in))
(def result2 (proj_trans G2P PJ_INV result1))

(proj_destroy P)
(proj_destroy G)
(proj_destroy G2P)

(proj_context_destroy C)

(def C (proj_context_create))

(def P3857
  (proj_create C "+proj=merc +a=6378137 +b=6378137 +lat_ts=0 +lon_0=0 +x_0=0 +y_0=0 +k=1 +units=m +nadgrids=@null +wktext +no_defs +type=crs"))
(def P4326 (proj_create C "+proj=longlat +datum=WGS84 +no_defs +type=crs"))
(def P4978 (proj_create C "+proj=geocent +datum=WGS84 +units=m +no_defs +type=crs"))
(def P4979 (proj_create C "+proj=longlat +datum=WGS84 +no_defs +type=crs"))

;(def G (proj_crs_get_geodetic_crs C P))
(def ToECEF (proj_create_crs_to_crs_from_pj C P4979 P4978 IntPtr/Zero nil))
(def ToECEF (proj_create_crs_to_crs C "EPSG:4979" "EPSG:4978" IntPtr/Zero))

;(def From4326To3857 (proj_create_crs_to_crs C "EPSG:4326" "EPSG:3857" IntPtr/Zero))
(def From4326To3857
  (proj_create_crs_to_crs_from_pj C P4326 P3857 IntPtr/Zero nil))


(-> (proj_as_wkt C P4978 PJ_WKT2_2019 IntPtr/Zero) Marshal/PtrToStringAnsi println)


;PJ_AREA PROJ_DLL *proj_area_create(void);
;void PROJ_DLL proj_area_set_bbox(PJ_AREA *area,
;                                 double west_lon_degree,
;                                 double south_lat_degree,
;                                 double east_lon_degree,
;                                 double north_lat_degree);
;void PROJ_DLL proj_area_destroy(PJ_AREA* area);

(def proj_area_create
  (make-fn
   {:function-name "proj_area_create"
    :arg-types     []
    :return-type   IntPtr}))

(def proj_area_set_bbox
  (make-fn
   {:function-name "proj_area_set_bbox"
    :arg-types     [IntPtr, Double, Double, Double, Double]
    :return-type   nil}))

(def proj_area_destroy
  (make-fn
   {:function-name       "proj_area_destroy"
    :arg-types           [IntPtr]
    :return-type         nil
    :zero-means-success? true}))

(def A (proj_area_create))

(proj_area_set_bbox A 1.0 2.0 3.0 4.0)

(proj_area_destroy A)

(type A)


;; alternatively: PJ PROJ_DLL *proj_create_crs_to_crs(PJ_CONTEXT *ctx, const char *source_crs, const char *target_crs, PJ_AREA *area);

;; Copenhagen
(def c_in (proj_coord 12.0 55.0 0.0 HUGE_VAL))

;; Kokomo IN (coffee and donuts) tile 20/273406/395091
(def c_in (proj_coord -86.13334604281705 40.49210021094248 0.0 HUGE_VAL))

(def result
  (proj_trans From4326To3857 #_ToECEF PJ_FWD c_in))

(defn from-4326-to-3857 [{:keys [lat lon]}]
  (let [c_in   (proj_coord lon lat 0.0 HUGE_VAL)
        c_out (proj_trans From4326To3857 PJ_FWD c_in)]
    {:x (nth c_out 0) :y (nth c_out 1)}))

(from-4326-to-3857 {:lat 55.0 :lon 12.0})

(proj_destroy P)
(proj_destroy G)
(proj_destroy G2P)

(proj_context_destroy C)

)

To install PROJ on Windows, use the OSGeo4W 64 bit installer custom install and choose proj82-runtime . It will get deps for you.