;;;
;;;--- How to save Lisp values with drawing? ---
;;;
;;;
;;;We have two possibilities in R14 -- dictionaries
;;;and EED, extended entity data. Both provide us with
;;;a means of storing information in a DWG persistently.
;;;We can store a series of code pairs in EED, as usual,
;;;only the codes are 1000, 1040 etc. BUT -- in a real
;;;Lisp programs we often have variables that are a *lists*
;;;of data, and in Lisp a list is actually a tree in that it
;;;can contain another list and so on.
;;;
;;;So how can we store lists in EED (or in Xrecords to be
;;;put into dictionary)? We must have some way to encode it
;;;into the possible code groups, and later to decode it back
;;;while retrieving the info.
;;;
;;;Both EED and Xrecords are very similar in that, and in both
;;;cases we must use this en/decoding.
;;;
;;;How can we do that? We need to use some special marker
;;;to mark a beginning/ending of a lists. Let's use LB
;;;as a List Begin marker and LE as a list end.
;;;
;;;This all means that we need to find a way to convert e.g.
;;; (1 (2 (3 "4") 5)) into
;;; LB 1 LB 2 LB 3 "4" LE 5 LE LE
;;;and vice versa. In other words, we want to find
;;;the conversion between Lisp tree-like lists
;;;and this special one-dimentional list representation.
;;;
;;;For that we can use something similar to that RE-LIST
;;;function that I have posted several times in its various
;;;modifications.
;;;
;;;Let's use here "{" as LB and "}" as LE.
;;;
;;;RE-LIST is decoding a list back into its original LISP form
;;;and may be done like this:
;;;
;;;; all functions here are (C.) 1997 by Vladimir Nesterovsky,
;;;; please keep this notice intact

(defun re-list ( lst / tok )
 (re-list-aux))

(defun re-list-aux()
 (cond
  ((atom lst) lst)
  ((/= "}" (setq tok (pop 'lst)))
   (cons (if (= "{" tok) (re-list-aux) tok)
         (re-list-aux)))))

;;;{ I'm using here a general utility POP function
;;;  which is stripping first element off the list,
;;;  returning its value:
 (defun pop(a / b)
   (setq b (eval a))
   (set a  (cdr b))
   (car b))
;;;}

;;;Its counterpart, EN-LIST, is for encoding:

(defun en-list ( lst )
  (cond
   ((null lst) lst)
   ((atom lst) (list lst))
   ((cons "{"    ;; add the markers around the list!
      (reverse
        (cons "}"
          (reverse
            (apply 'append  ;; open the lists
              (mapcar 'en-list lst) ;; recursion!
      ))))))))

;;;Both don't deal with dotted pairs for simplicity.
;;;
;;;{A word of caution -- both functions may be memory hungry
;;; as being recursive, which can lead to problems when using big
;;; lists, like Autolisp stack overflow etc. I heard that every
;;; recursive function can be done iteratively, so if you have
;;; a very big lists in your application, you may need to try
;;; to prove this theorem in this case. :) }
;;;
;;;Now we've seen this encoding/decoding in action and can do
;;;any alterations suitable for EED or Xrecords (the actual codes
;;;for EED are different and long integers must be encoded as
;;;reals and converted to integers back on decoding).
;;;Here's a function for Xrecord encoding,
;;;making code groups automatically:
;;;
(defun x-enlist ( lst )  ;; encode!
  (cond
   ((null lst) lst)
   ((atom lst)           ;; automatic code groups
     (cond
      ((= 'REAL (type lst))
        (list (cons 40 lst)))
      ((= 'INT (type lst))
        (list (cons 71 lst)))
      ((= 'STR (type lst))
        (list (cons  1 lst)))
      (T nil)))
   ((and (cdr lst) (atom (cdr lst)))
      (list lst))      ;; pass dotted pair AS IS -- must be valid!!
   ((and (= (length lst) 3)
         (apply 'and (mapcar 'numberp lst)))
     (list (cons 10 lst)))
   ((cons '(2 . "{")
     (reverse
      (cons '(2 . "}")
       (reverse
        (apply 'append
         (mapcar 'x-enlist lst) ))))))))


(defun x-relist ( lst / tok )  ;; decode it!
 (car (x-relist-aux)))

(defun x-relist-aux()
 (cond
  ((null lst) nil)
  ((not (equal '(2 . "}") (setq tok (pop 'lst))))
   (cons (if (equal '(2 . "{") tok)
           (x-relist-aux)
           (cdr tok)
           )
         (x-relist-aux)))))

;;;I have posted the file SAVEDATA.LSP on my home page
;;;with all these functions and maybe I'll add later EED
;;;functions with special handling of 1070 and 1071 code
;;;groups. The handling of long strings can be done just
;;;as easily via the use of special code 1001 for text
;;;parts (the short string is encoded under 1000 for EED).
;;;
;;;
;;;The rest is just plain dictionary functions for R14:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; dictionary functions for R14
;; POSSIBLE IMPROVEMENTS: support trees of dictionaries
;;      now: all custom dictionaries are under the Root.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Get Dictionary Object Name From Root Dictionary
(defun dict-name ( name / d0 d ) ;; name As string
  (if (Setq d0 (namedobjdict)
            d  (dictsearch d0 name))
    (cdr (assoc -1 d))))

;; Remove Dictionary <Name> From Root Dictionary
(defun dict-remove ( name / d0 ) ;; name As string
  (if (dictsearch (Setq d0 (namedobjdict)) name)
    (dictremove d0 name))
  )

;; Make A New Empty Dictionary; Reset Existing.
(defun dict-new ( name / d0 ) ;; name As string
  (if (dictsearch (Setq d0 (namedobjdict)) name)
    (dictremove d0 name))
  (dictadd d0 name
      (entmakex '((0 . "DICTIONARY")(100 . "AcDbDictionary")))))

;; List A Dictionary As Pairs {Name . Object Name}
(defun dict-list ( dname / d nl )
  ;; dname As object name or string else ROOT
  (cond
    ((and (Setq d (cond
                    ((= 'ENAME (type dname))
                      dname)
                    ((= 'STR (type dname))
                      (dict-name dname))
                    (T (namedobjdict))))
          (Setq d (entget d)))
      (while (setq d (member (assoc 3 d) d))
        (if (= 350 (caadr d))
          (setq nl (cons (cons (cdar d) (cdadr d)) nl)))
        (setq d (cdr d)))
      (reverse nl))))

;; Get Raw <Name> Dictionary Data for <Key>
(defun dict-getrawdata ( name key / d ) ;; name and key As strings
  (if (setq d (dict-name name))
   (dictsearch d key)))

;; Clear The <Key> From Dictionary <Name>
(defun dict-clear ( name key / d) ;; name and key As strings
  (if (setq d (dict-name name))
    (dictremove d key)))

;;;;;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~;;;;;;;
;;;;;;; The two working functions: ;;;;;;;
;;;;;;;____________________________;;;;;;;

;; Get A <Key> Value From Dictionary <Name>
(defun dict-get ( name key ) ;; name and key As strings
  (x-relist                  ;; decode the data!
    (cdr (member '(100 . "AcDbXrecord")
		 (dict-getrawdata name key)))))

;; Put A <Val>ue Into <Name> Dictionary Under <Key>
(defun dict-put ( name key val ) ;; three arguments As strings
  (dict-clear name key) ;;  clear the old value under this Key
  (dictadd
    (cond ((dict-name name)) ((dict-new name)) )
    key
    (entmakex
      (cons '(0 . "XRECORD")
        (cons '(100 . "AcDbXrecord")
          (x-enlist val)))) )) ;; encode the data!
;;
;; POSSIBLE IMPROVEMENTS:
;;    implement dict-append ( APPEND PREPEND )
;;;;;;;;;;;;;;;;;;;;;;;

;;;Sample use:
;;;
;;;(dict-put "mydict" "mykey" '(1 (2 ("3" (44.4) (5.5 6.6 7.7) 8)) 999999))
;;;(dict-get "mydict" "mykey")
;;;;;;;;;;-------;;;;;;;
;;;
;;;So here we have developed a set of functions
;;;that let us store and retrieve an arbitrary values
;;;of *any* structure persistently with the DWG
;;;(with a possible exception of dotted pairs).
;;;
;;;In fact it may be easily altered to store even *functions*
;;;with the DWG as functions are _lists_ in AutoLISP and all
;;;that's left to do is to define some special code for string
;;;converted symbols to be stored in Xrecord, e.g. 3, and just
;;;use SYM2STR and READ in the en/decoding functions.
;;;
;;;Another simple addition may be to use these en/re-list
;;;approach and build function to store arbitrary data
;;;in EED, extended entity data. Apart from obvious changes
;;;to code groups used it'll be necessary to deal with long/real
;;;values translation and big strings, but that can be done with
;;;just a few modifications.
;;;
(SETQ OLDREGAPP REGAPP)
(DEFUN MYREGAPP (APNAME /)
  (IF (MEMBER APNAME
              (LIST "AECBASE"
                    "AEC_DISPREPCONFIG_DATA"
                    "AEC_DISPREPSET_DATA"
                    "CIVIL_DRAFT"
                    "CIVIL_LINE_TABLE"
                    "CIVIL_CURVE_TABLE"
                    "CIVIL_SPIRAL_TABLE"
                    "AVE_RENDER"
                    "AVE_ENTITY_MATERIAL"
                    "AVE_FINISH"
                    "AVE_MATERIAL"
                    "AVE_GLOBAL"
                    "SDI_XSECTIONS"
                    "ADCADD_ZZ"
                    "SDSK_PMN"
                    "SDSK_POINT"
                    "DCA_FIGURE_XENT"
                    "SDI_PROFILE"
                    "SVPLINE"
                    "DCA_DTM_FAULTS"
                    "CGSURVEY_FOR_AUTOCAD8003671157"
                    "EGPT_EPOD"
                    "RAK"
                    "AEC_DWGVARSSETUP_DATA"
                    "DCO15"
                    "ADE"
                    "AD_FM_JUNK"
                    "ASG_DLPD500_LINK_HANDLE"
                    "ASG_DLPD500_TIMBERLINE_IMPORT"
                    "ASG_DLPD500_CORE_TAGS"
                    "ASG_DLPD500_TL_NONCAD_VAR"
                    "ASG_DLPD500_PE_INFO"
                    "ASG_DLPD500_WIOT"
                    "SDI_SETUP"
                    "ABNSLEADERTOOLS"
                    "EGPT_LCAD"
                    "EGPT_LCAD_AI_POC_SYMBOL"
                    "EGPT_LCAD_AI_HEAD_SYMBOL"
                    "EGPT_LCAD_AI_VALVE_SYMBOL"
                    "EGPT_LCAD_AI_FITTING_SYMBOL"
                    "EGPT_LCAD_AI_EMITTER_SYMBOL"
                    "EGPT_LCAD_AI_EQUIPMENT_SYMBOL"
                    "EGPT_LCAD_AI_PIPE_LEG"
                    "EGPT_LCAD_AI_WIRE_LEG"
                    "EGPT_LCAD_AI_DRIP_LEG"
                    "BNS_SPRHATCH"
                    "BNS_SELSET"
                    "DCA_PIPEWKS_C_PLAN"
                    "ER_DAYLIGHT"
                    "DCA_PIPEWKS_F_PLAN"
                    "DCA_PIPEWKS_C_PROF"
                    "DCA_PIPEWKS_C_PROF_LINES"
                    "DCA_PIPEWKS_HYDRAULIC_GRADE"
                    "DCA_PIPEWKS_F_PROF"
                    "DCA_PIPEWKS_C_XSEC"
                    "DCA_PIPEWKS_F_XSEC"
                    "ESRI"
                    "TEC_SETUP_4076602552"
                    "ADE_PROJECTION"
                    "AEC_ROUNDTRIP_15"
                    "AEC_DISPREPSET_DATA"
                    "PROSURV_V1_0_7047874131"
                    "CONTENTBLOCKICON"
                    "ALIGNMENT_DB_APP"
                    "AECBASE"
                    "AEC_DISPREPCONFIG_DATA"
              ) ;_ end of LIST
      ) ;_ end of MEMBER
    (PRINC (STRCAT "\nRegistering of\"" APNAME "\" is not allowed! "))
    (OLDREGAPP APNAME)
  ) ;_ end of IF
  (PRINC)
) ;_ end of DEFUN
(SETQ REGAPP MYREGAPP)


(PRINC)
;|«Visual LISP© Format Options»
(120 2 15 2 T "end of " 100 9 2 0 nil nil nil T T)
;*** DO NOT add text below the comment! ***|;