;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                               for CoCreate SolidDesigner
;;  Description:
;;      QR-Code to Workplane / to Model Face
;;
;;  Reference  : https://ww3.cad.de/foren/ubb/Forum92/HTML/001038.shtml
;;             : https://qrplanet.com/qr-code-generator-svg
;;  Docu       : https://support.ptc.com/help/creo_elements_direct/...
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Filename   : cadde-92-001038.lsp
;;  Version    : 1.0 initial-version by der_Wolfgang
;;  Created    : Fri Dec 13 17:25:00 CET 2024
;;  Modified   : Tue Dec 17 21:26:01 CET 2024
;;  Author     : der_Wolfgang@forum@cad.de
;;  Download   : cad.de
;;  SD-Version : developed with PE80
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package :cadde-wt)
(use-package :oli)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; learning reading SVG / XML
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; recursivly called!
(defun dump-svg-children (elem &optional parent-names)
  (let (a-name a-attr-key attribs)
    (dolist (a-elem (sd-xml-element-get-children elem))
      (setq a-name (sd-xml-element-get-name a-elem))
      (format T "~&path: [~A/~A]" (sd-pathlist-to-pathname parent-names) a-name) ;; just a logical output!
      (setq attribs (sd-xml-element-get-attributes a-elem))
      (when attribs (format T " ATTR=>"))
      (dolist (a-attr-key attribs)
        (setq a-attr-val (sd-xml-element-get-attribute a-elem a-attr-key))
        ;(format T "~&  attr-key: ~S value: ~S~%" a-attr-key a-attr-val)
        (format T " | key: ~S = ~S" a-attr-key a-attr-val) ;; alle als einzeiler
        )
      (format T "~&")
      (dump-svg-children a-elem (append parent-names (list a-name)))
      )
  )) ;; end let+defun
;(trace dump-svg-children)

(defun dump-svg (svg-file wp)
  (sd-xml-clear-cache)
  (let* ((svg-document (sd-xml-read-file svg-file))
         (svg-root (sd-xml-document-get-root svg-document))
         (a-name (sd-xml-element-get-name svg-root))
        )
    (format T "~&root-name: ~S~%" a-name)
    (dump-svg-children svg-root (list "/" a-name)) ;; sd-pathlist-to-pathname braucht den "/"  unbedingt!!
    (sd-xml-clear-cache)
  )) ;; end let+defun
(trace dump-svg)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; reading with filling some variables on the fly
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; these functions do not a full conversion of SVG to Workplane geometry!
;;   it picks out of a certain SVG file delivered by a free online service
;;   different information and draw geometry to extrude a QR code as solid 3D Part
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(let (overall-size dot-size dot-positions)

(defun svg-clear-cache ()
  (setq overall-rect nil dot-size nil dot-positions nil))

(defun qrc-make-key (str)
  "clear a string to make a well formed key word  (just normal characters only)"
  (PERS:MAKE-KEYWORD (sd-string-replace str ":" "-"))
  )

(defun make-2d-pnt (plist x y)
  (make-gpnt2d :x (sd-read-from-string (getf plist x))
               :y (sd-read-from-string (getf plist y))
               )
  )

(defun qrc-collect-svg-children-data (elem &optional parent-names)
  (let (a-name a-attr-key attribs svg-path svg-attr)
    (dolist (a-elem (sd-xml-element-get-children elem))
      (setq a-name (sd-xml-element-get-name a-elem))
      (setq svg-path (sd-pathlist-to-pathname (append parent-names (list a-name))))
      ;;; (format T "~&path: [~A]" svg-path) ;; just a logical output!
      (setq attribs (sd-xml-element-get-attributes a-elem)
            svg-attr nil)

      ;;; (when attribs (format T " ATTR=>"))
      (dolist (a-attr-key attribs)
        (setq a-attr-val (sd-xml-element-get-attribute a-elem a-attr-key))
        ;;; (format T " | key: ~S = ~S" a-attr-key a-attr-val) ;; alle als einzeiler
        (push a-attr-val svg-attr)
        (push (qrc-make-key a-attr-key) svg-attr)
        )
      ;;; (format T "~&")
      (unless (equal svg-path "/svg/g/use")
       (format T "~& path: ~S : attribs ~S~%" svg-path svg-attr) ; path and values of ONE attr
       )
      (cond
        ((equal svg-path "/svg/rect")
          (setq overall-rect svg-attr))
        ((equal svg-path "/svg/defs/rect")
          (setq dot-size svg-attr))
        ((equal svg-path "/svg/g/use")
          (push (make-2d-pnt svg-attr :x :y) dot-positions))
        (T
          (format T "~& UNUSED: path: ~S : attribs ~S~%" svg-path svg-attr) ; path and values of ONE attr
          )
        ) ;; end cond
      (qrc-collect-svg-children-data a-elem (append parent-names (list a-name)))
      )
  )) ;; end let+defun
;(trace dump-svg-children)

(defun qrc-svg-to-geo (svg-file wp)
  ;;
  (let (svg-document
        svg-root
        a-attr-val
        root-name
        elem-name
        min-gap
        dot-w+h
        )
(untrace make-gpnt2d rectangle)
    (svg-clear-cache)
    (sd-xml-clear-cache)
    (setf svg-document (sd-xml-read-file svg-file))
    (setf svg-root (sd-xml-document-select-element svg-document "/svg/g")) ;; DAT WILL Einfach nicht!!
    (format T "~&root-name: ~S~%" (setq root-name (sd-xml-element-get-name svg-root)))

    (setf svg-root (sd-xml-document-get-root svg-document))
    (format T "~&root-name: ~S~%" (setq root-name (sd-xml-element-get-name svg-root)))
    (qrc-collect-svg-children-data svg-root (list "/" root-name)) ;; sd-pathlist-to-pathname braucht den "/"  unbedingt!!
    (sd-xml-clear-cache)

    (trace rectangle pull extrude merge_2d delete_2d)
    (if (and (sel_item-p wp) (sd-inq-workplane-p wp))
      (current_wp wp)
      (create_workplane :new)
      )
    (setf has-geo #|sd-inq-empty-wp-p|#    ;; get_selection ratatata
                  (elan::CHECK_PROFILE_REPORT_CLOSEDNESS_GS
                    (elan::sel_item-item (sd-inq-curr-wp))
                    (geo::INQUIRE-SYSTEM-RESOLUTION) :allow_open t))
    (when has-geo (sd-call-cmds (delete_2d :all_2d)))

    #|
    (pprint overall-rect)
    (pprint dot-size)
    (pprint (car dot-positions))
    (pprint (subseq dot-positions 0 10))
    (pprint (length dot-positions))
    |#
    (create_part) ;; POC code ist manchmal brutal!

    (rectangle (make-2d-pnt overall-rect :x :y)
               (make-2d-pnt overall-rect :width :height)
               )
               
    (extrude :wp (sd-inq-curr-wp) :type :DISTANCE_TYPE :keep_profile :NO :DISTANCE +5) ;; ne grundplatte
    ;; beim QR code Scannen auf'm Bildschrirm was schwierig, deswegen mal schwarzes part und weisse gund fläche
    (set_part_color (sd-inq-curr-part) :color 0 :done) 
    (set_face_color 100,100,0 :color 16777215 :done)

    (setq min-gap 0.01,0.01) ;; gut wäre evtl 10 + geo res!
    (setq dot-w+h (make-2d-pnt dot-size :width :height))
    (dolist (a-dot dot-positions) ;; UHH das muss EIN aufruf von rectangle werden. ..
      ;(rectangle a-dot (sd-vec-add a-dot dot-w+h))
      (rectangle (sd-vec-add a-dot min-gap)
                 (sd-vec-subtract (sd-vec-add a-dot dot-w+h) min-gap))
      )
    ;; 'Overlapping loops are not allowed.   (Error 291)'  using resolution 1.0E-6 mm ;; uppps
    (merge_2d :edge_2d :current_wp :complete_boxing :all_2d) ;; der funktioniert nicht immer ganz oder so?
    ;; interactive ist das okay.
    
    (uic_flip_vp (sd-inq-current-vp)) ;; hehe .  das ist ein dreher drin. deswegen auch +-5 andersrum

    (extrude :wp (sd-inq-curr-wp) :type :DISTANCE_TYPE :DISTANCE -5)  ;; das QR code muster

    ;; und mit der Pullerei .   geht die rätselei los!

    ;(pull :sel_part (sd-inq-curr-part) :wp (sd-inq-curr-wp)
    ;      :operation :automatic
    ;      :linear_pull
    ;      :type :distance_type
    ;      :distance 5
    ;      :keep_wp :no)
    ;
    ;(pull :linear_pull :selection_focus_profiles :keep_wp :yes :keep_profile :YES :distance 5)

    (setq pull-args (append
                      (list :sel_part (sd-inq-curr-part) :wp (sd-inq-curr-wp)
                            :keep_wp :yes :keep_profile :YES :distance 5
                            :selected_profiles :clear :add
                            )
                      (mapcar '(lambda(a-dot) (sd-vec-add a-dot 2,2)) dot-positions) ;; select middle of all the small squares
                      (list :select_done)
                      ))
    ;(apply 'pull pull-args) ;; das ist vielleicht besser.  Vielleicht mal mit gap==0 und ohne den Merge probieren!

    ;; complete  pull :init_from_preselect (get-profile-data-from-preselect) :linear_pull :selection_focus_profiles :keep_wp :yes :keep_profile :YES
    ;; :distance
    ;; :selection_focus_profiles
    ;; :sel_part :start "/p001" :select_done
    ;; :wp ;; "/w001"
    ;; :selected_profiles  :all_3d :select_done
    ;; :operation :AUTOMATIC
    ;; :linear_pull :distance
    ;; :type :DISTANCE_TYPE
    ;; :distance 5
    ;; complete
    ;; preselect

  )) ;; end let+defun

(trace qrc-svg-to-geo)
;(trace qrc-collect-svg-children-data)
(untrace sd-xml-read-file sd-xml-document-select-element)
(untrace sd-xml-element-get-children)

) ;; end global let

;(qrc-svg-to-geo "//wolfgang/net/wo-auch-immer/cadde-92-001038.qr-seele-auf-cad-d.svg" "wp")
;(pprint (sd-xml-get-root-name "//wolfgang/net/wo-auch-immer/cadde-92-001038.qr-seele-auf-cad-d.svg")) => "svg"  ;; das wissen wir schon :giggle:
;(dump-svg "//wolfgang/net/wo-auch-immer/cadde-92-001038.qr-seele-auf-cad-d.svg" "wp")

(sd-defdialog 'QR_CODE_to_Workplane
  :toolbox-button :force
  :variables
  '(
    (zip_file
      :value-type :filename                ;; filing options
      :direction :input                    ;; filing options
      :initialPattern "qrplanet*.zip"      ;; filing options
      :initialDirectory (sd-inq-temp-dir)  ;; filing options
      :proposals '()
      :persistent-data-storage T   ;; keep user entered value of proposals across osdm session
      :auto-add-proposal t
      :proposals-order :new-input-at-top ;:sorted
      :initial-optional T
      )
    (gen_svg_url
      :push-button (sd-display-url "https://qrplanet.com/qr-code-generator-svg")
      )
    ("create and download to the ZIP file name")
    (extract_svg
      :push-action (if (probe-file zip_file)
                     (sd-set-variable-status 'svg_file :value (qrc-get-svg-from-zip (car zip_file)))
                     (sd-display-alert (format nil "zip file not found [~S]" (car zip_file)))
                     )
      )
 ;  owner-of-workplane ..
 ;  wpname
    (svg_file
      :value-type :filename                ;; filing options
      :direction :input                    ;; filing options
      :initialPattern "qrplanet*.svg"      ;; filing options
      :initialDirectory (sd-inq-temp-dir)  ;; filing options
      :proposals '()
      :persistent-data-storage T   ;; keep user entered value of proposals across osdm session
      :auto-add-proposal t
      :proposals-order :new-input-at-top ;:sorted
      :initial-optional T
      )
    ) ;; end variables

 ;  :ok-action-precond (if prob-file zip-file :ok :error)   ;; evtl file date auch checken
 ;  :ok-action
 ;   (let ((svg-file (qrc-get-svg-from-zip zip-file)))
 ;     (when svg-file (qrc-svg-to-workplane svg-file wpname))
 ;     )
  :ok-action
  '(progn
     (sd-call-cmds (qrc-svg-to-geo (car svg_file) "wp"))
    ) ;; end ok-action
  ) ;; end dialog