New fca style (#149)

* new latex fca style output format

* removed whitespaces

* Added doc string

src/main/clojure/conexp/gui/draw/control/file_exporter.clj

@@ -29,12 +29,16 @@
         jpg-filter (FileNameExtensionFilter. "JPEG Files" (into-array ["jpg" "jpeg"])),
         gif-filter (FileNameExtensionFilter. "GIF Files"  (into-array ["gif"])),
         tikz-filter (FileNameExtensionFilter. "TIKZ Files" (into-array ["tikz"]))
+        json-filter (FileNameExtensionFilter. "JSON Files" (into-array ["json"]))
+        fca-filter (FileNameExtensionFilter. "FCA Files" (into-array ["fca"]))
         layout-filter (FileNameExtensionFilter. "Layout Files" (into-array ["layout"]))
         png-filter (FileNameExtensionFilter. "PNG Files"  (into-array ["png"]))]
     (doto fc
       (.addChoosableFileFilter jpg-filter)
       (.addChoosableFileFilter gif-filter)
       (.addChoosableFileFilter tikz-filter)
+      (.addChoosableFileFilter json-filter)
+      (.addChoosableFileFilter fca-filter)
       (.addChoosableFileFilter layout-filter)
       (.addChoosableFileFilter png-filter))
     (listen save-button :action
@@ -45,6 +49,8 @@
                     (with-swing-error-msg frame "Error while saving"
                       (case (get-file-extension file)
                         "tikz" (write-layout :tikz (get-layout-from-scene scn) (.getAbsolutePath file))
+                        "json" (write-layout :json (get-layout-from-scene scn) (.getAbsolutePath file))
+                        "fca" (write-layout :fca-style (get-layout-from-scene scn) (.getAbsolutePath file))
                         "layout" (write-layout :simple (get-layout-from-scene scn) (.getAbsolutePath file))
                         (save-image scn file (get-file-extension file))))))))))
   nil)

src/main/clojure/conexp/io/latex.clj

@@ -93,6 +93,7 @@
 ;;; Layouts
 
 (declare layout->tikz)
+(declare layout->fca-style)
 
 (extend-type conexp.layouts.base.Layout
   LaTeX
@@ -102,8 +103,66 @@
    ([this choice]
       (case choice
         :tikz (layout->tikz this)
+        :fca-style (layout->fca-style this)
         true  (illegal-argument "Unsupported latex format " choice " for layouts.")))))
 
+(defn- layout->fca-style
+  "Latex output format for the new fca package at https://github.com/keinstein/latex-fca"
+  [layout]
+  (let [vertex-pos      (positions layout),
+        sorted-vertices (sort #(let [[x_1 y_1] (vertex-pos %1),
+                                     [x_2 y_2] (vertex-pos %2)]
+                                 (or (< y_1 y_2)
+                                     (and (= y_1 y_2)
+                                          (< x_1 x_2))))
+                              (nodes layout)),
+        vertex-idx      (into {}
+                              (map-indexed (fn [i v] [v i])
+                                           sorted-vertices)),
+        value-fn #(if (nil? ((valuations layout) %))
+                    "" ((valuations layout) %))]
+    (with-out-str
+     (println "{\\unitlength 1mm")
+      (println "\\tikzset{concept/.style={/tikz/semithick, /tikz/shape=circle, inner sep=1pt, outer sep=0pt, draw=black!80,")
+      (println "                         fill=white, radius=1.5mm},%")
+      (println "         relation/.style={/tikz/-,/tikz/thick,color=black!80,line width=1.5pt},")
+      (println "         valuation/.style={color=red,label distance=3pt}")
+      (println "}")
+      (println "\\begin{tikzpicture}[scale=1]")
+      (println "\\begin{diagram}")
+      ;; concepts
+      (doseq [v sorted-vertices]
+        (let [idx (vertex-idx v)
+              [x y] (vertex-pos v)]
+          (println (str"\\Node[/tikz/concept](" idx ")("x", "y")"))))
+      ;; relation
+      (doseq [[v w] (connections layout)]
+        (let [vidx (vertex-idx v)
+              widx (vertex-idx w)]          
+          (println (str "\\Edge[/tikz/relation](" vidx ")("widx")"))))
+      ;; attribute labels
+      (doseq [v sorted-vertices]
+        (let [idx (vertex-idx v)
+              ann (annotation layout)
+              [u _] (map tex-escape (ann v))]
+          (if-not (= "" u)
+            (println (str "\\centerAttbox("idx"){" u "}")) ) ))
+      ;; object labels
+      (doseq [v sorted-vertices]
+        (let [idx (vertex-idx v)
+              ann (annotation layout)
+              [_ l] (map tex-escape (ann v))]
+          (if-not (= "" l)
+            (println (str "\\centerObjbox("idx"){" l "}")) ) ))
+      ;; valuations 
+      (doseq [v sorted-vertices]
+        (let [val (value-fn v)
+              idx (vertex-idx v)]
+          (if (not= "" val)
+            (println (str"\\node[/tikz/valuation] [right of="idx"] {"val"};")))))
+      (println "\\end{diagram}")
+      (println "\\end{tikzpicture}}") ) ))
+
 (defn- layout->tikz [layout]
   (let [vertex-pos      (positions layout),
         sorted-vertices (sort #(let [[x_1 y_1] (vertex-pos %1),

src/main/clojure/conexp/io/layouts.clj

@@ -164,7 +164,8 @@
 
 (define-layout-output-format :fca-style
   [layout file]
-  (unsupported-operation "Output in :fca-style is not yet supported."))
+  (with-out-writer file
+    (println (latex layout :fca-style))))
 
 ;; Json helpers