(setq hasMilliSecs (/= (getvar "MILLISECS") nil))
(setvar "LOGFILEMODE" 0)
(vl-load-com)

(if (and (not vle-stringp) (findfile "vle-extension.lsp")) (load "vle-extension.lsp"))

;;##############################################################
;;##################### Application Code #######################
;;##############################################################

;; | ----------------------------------------------------------------------------
;; | C:SortedPoly
;; | ----------------------------------------------------------------------------
;; | Function : Draw a polyline by connecting points in sorted X or Y direction
;; | Author   : Rakesh Rao, (C) Four Dimension Technologies, Bangalore
;; |
;; | Arguments:
;; | Action   : Draw polylines, by joining points sorted along X or Y directions
;; | Updated  : May 21, 2008
;; | ----------------------------------------------------------------------------
;; |
;; | slightly adopted for benchmarking purposes by Torsten Moses
;; |
(defun c:SortedPoly ( / 3D cnt ename entl flag OS pt PtLst SortDir ss ssl tmp vlist X Y Z )

  (if (not #SortedPoly)
    (setq #SortedPoly
      (list
         "+Y"                                      ; [0] Sort Direction (+X/+Y/-X/-Y)
         (list 3 "POINT,INSERT,TEXT" "*" "" "256") ; [1] Current object selection
         1.0                                       ; Dummy Real
         1                                         ; Dummy Integer
      )
    )
  )

  (setq ss (ssget "ALL" (list (cons 0 "POINT,INSERT,TEXT"))))

  (if ss
    (progn

      (setq OS (getvar "OSMODE"))
      (setvar "OSMODE" 0)
      (setq
        SortDir (nth 0 #SortedPoly)
        ssl     (sslength ss)
        cnt     0
        tmp     (strcat " of " (itoa ssl))
        PtLst  '()
        3D      nil
      )

      (princ "\n")
      (repeat ssl
        (setq
          ename (ssname ss cnt)
          entl  (entget ename)
          pt    (LI_item 10 entl)
          X     (car pt)
          Y     (cadr pt)
          Z     (caddr pt)
          cnt   (1+ cnt)
        )
        (if (not (zerop Z)) (setq 3D T))

        (cond
          ((member SortDir (list "+X" "-X"))
           (setq PtLst (cons (list X pt) PtLst))
          )
          ((member SortDir (list "+Y" "-Y"))
           (setq PtLst (cons (list Y pt) PtLst))
          )
        )
        (princ (strcat "\rPre-Processing objects ... " (itoa cnt) tmp "  "))
      )
      
      (princ "\nNow sorting objects, please wait ...")
      (setq #Verbose nil)
      (if (member SortDir (list "-X" "-Y"))
        (setq PtLst (l_ssort PtLst 0 '<))
        (setq PtLst (l_ssort PtLst 0 '>))
      )
      (setq #Verbose nil)
      
      (setq vlist (mapcar 'cadr PtLst))
      
      (if 3D
        (setq flag 8)
        (setq flag 0)
      )

      (princ "\nNow creating Polyline, please wait ...")
      (PL_mk_pl vlist flag 0.0)
      (princ "\n\n")
      
      (setvar "OSMODE" OS)
    )
  )

  (princ)
)

;;; l_ssort
;;;
;;; Modified Shell Sort of List of Lists
;;; Parameters   llist ->  list of lists
;;;              key   ->  element in inner lists to sort by
;;;             method ->  '> for ascending or '< for descending
;;;
;;; Returns  ->  Sorted list of lists
;;;
;;; Note: This custom shell sort algorithm will handle multiple
;;;       occurrences of any items. The sort will continue looping
;;;       when partition size is 1 until no swaps occur.
;;;
(defun l_ssort (llist key method /
                                   number_items       partition_size
                                   number_partitions  first_index
                                   last_index         unsorted
                                   count              ptr_lst
                                   sorted_list        i            j
                                   t1                 t2
                                   useLT              useGT        matched
               )

  (setq useLT NIL useGT NIL)
  (if (= method '<)
    (setq useLT t)
    (setq useGT t)
  )

  (if (and llist key)
    (progn
      (setq number_items (length llist)
            partition_size number_items
            ptr_lst nil                  ;pointer list
            count 0
            unsorted T                   ;assume list is not sorted
      )

      (if #Verbose (princ "\nBuilding point list..."))
      (while (< count number_items)
        (setq
          ptr_lst (append ptr_lst (list count)) ;built pointer list
          count (1+ count)
        )
      )
      (if #Verbose (princ "done."))

      ;;------------------------------------------------------------------

      (while unsorted

        (setq partition_size (fix (/ (1+ partition_size) 2))
              number_partitions (fix (/ number_items partition_size))
        )

        (if #Verbose
          (princ (strcat "\nNumber of partitions = " (itoa number_partitions) "                 \n"))
        )

        (if (= partition_size 1)
          (setq unsorted nil)       ;assume list is sorted
        )

        (if (/= (rem number_items partition_size) 0)
          (setq number_partitions (1+ number_partitions))
        )
        (setq first_index 0
              i 1
        )
        (while (< i number_partitions)
          (if #Verbose
            (princ (strcat "\r" (itoa i) " --> " (itoa number_partitions) "                 "))
          )
          (setq last_index (+ first_index partition_size))

          (if (> last_index (- number_items partition_size))
            (setq last_index (- number_items partition_size))
          )

          ; loop thru and test (j) to (j+offset) in pointer list

          (setq j first_index)
          (while (< j last_index)

            (setq matched nil)
            (if (and useLT 
                     (< (nth key (nth (nth j ptr_lst) llist))
                        (nth key (nth
                         (nth (+ j partition_size) ptr_lst) llist)
                        )
                     )
                )
              (setq matched t)
            )
            (if (and useGT
                     (> (nth key (nth (nth j ptr_lst) llist))
                        (nth key (nth
                         (nth (+ j partition_size) ptr_lst) llist)
                        )
                     )
                )
              (setq matched t)
            )

            (if matched
              ; then swap items in pointer list
              (setq t1 (nth j ptr_lst)
                    t2 (nth (+ j partition_size) ptr_lst)
                    ptr_lst (subst t2 -1
                              (subst t1 t2
                                (subst -1 t1 ptr_lst)
                              )
                            )
                    unsorted T
              ) ;setq
            ) ;if

            (setq j (1+ j))

          ) ;while j

          (setq first_index (+ first_index partition_size)
                i (1+ i)
          )

        ) ;while i


      ) ;while unsorted

      ;;------------------------------------------------------------------
      ;; Build new list using sorted pointers

      (setq count 0 sorted_list nil)
      (while (< count number_items)
        (setq sorted_list
          (append sorted_list        ;build updated list
            (list
              (nth
                (nth count ptr_lst)  ;pointer
                llist
              )
            )
          )
          count (1+ count)
        ) ;setq
      ) ;while

      sorted_list                          ;return sorted list
    ) ;progn

    ;else
    nil
  ) ;if

) ;defun

;; | ---------------------------------------------------------------------------
;; | LI_item
;; | ---------------------------------------------------------------------------
;; | Function : Returns the first occurence of a DXF dotted pair from a list
;; | Argument : 'n'     - The DXF code to check
;; |            'alist' - The List to check
;; | Returns  : The value of the DXF dotted pair, if it exists else returns nil
;; | Update   : December 26, 1998
;; | e-mail   : rakesh.rao@4d-technologies.com 
;; | Web      : www.4d-technologies.com
;; | ---------------------------------------------------------------------------

(defun LI_item (n alist)
  (cdr (assoc n alist))
)

;; | --------------------------------------------------------------------------------------
;; | PL_mk_pl
;; | --------------------------------------------------------------------------------------
;; | Function : Given a list, draw a POLYLINE or LWPOLYLINE using the entmake function
;; | Arguments:
;; |            'vlist'  - List of points from which to create polyline.
;; |            'flag'   - POLYLINE or LWPOLYLINE flag (DXF Code 70)
;; |            'Width'  - Width of the polyline.
;; | Action   : Creates a POLYLINE or LWPOLYLINE from the list supplied with the specified
;; |            flag and Width.
;; |            If the flag has an '8' bit in it, a POLYLINE object is created else
;; |            if the '8' bit is absent, a POLYLINE or LWPOLYLINE object is created
;; |            depending on whether the PLINETYPE variable is 0 or 1 respectively.
;; | Updated  : March 24, 1998
;; | e-mail   : rakesh.rao@4d-technologies.com 
;; | Web      : www.4d-technologies.com
;; | --------------------------------------------------------------------------------------

(defun PL_mk_pl ( vlist flag Width / Elev VFlag pt entl LWPoly Lst len )
  (if (not (zerop (logand flag 8)))
    (setq
      Elev 0.0 Width 0.0
      LWPoly nil
    )
    (progn
      (if (member (getvar "PLINETYPE") (list 1 2))
        (setq LWPoly T)
        (setq LWPoly nil)
      )
      (setq Elev (caddr (nth 0 vlist)))
    )
  )
  
  (if LWPoly
    (progn
      (setq Lst '())
      (foreach pt vlist
      	(setq
      	  Lst (cons (list 10 (car pt) (cadr pt)) Lst)
      	  Lst (cons (cons 40 Width) Lst)
      	  Lst (cons (cons 41 Width) Lst)
      	)
      )
      (setq
        len (length vlist)
        Lst (reverse Lst)
        Lst (cons (cons 38 Elev) Lst)
        Lst (cons (cons 70 flag) Lst)
        Lst (cons (cons 90 len) Lst)
        Lst (cons (cons 100 "AcDbPolyline") Lst)
        Lst (cons (cons 100 "AcDbEntity") Lst)
        Lst (cons (cons 0 "LWPOLYLINE") Lst)
      )
      (entmake Lst)
    )
    (progn
      (setq entl (list
                   (cons 0 "POLYLINE")
                   (cons 66 1)
                   (list 10 0.0 0.0 Elev)
                   (cons 40 Width)
                   (cons 41 Width)
                   (cons 70 flag)
                 )
      )
      (entmake entl)
      
      (setq VFlag 0)
      (if (not (zerop (logand flag 8)))
        (setq VFlag (+ VFlag 32))
      )
      
      (if (not (zerop (logand flag 32)))
        (setq VFlag (+ VFlag 64))
      )
      
      (if (not (zerop (logand flag 64)))
        (setq VFlag (+ VFlag 128))
      )
      
      (foreach pt vlist
        (if (not (zerop (logand flag 8)))
          (setq Elev (caddr pt))
        )
        (setq entl (list
                     (cons 0 "VERTEX")
                     (list 10 (car pt) (cadr pt) (caddr pt))
                     (cons 70 VFlag)
                   )
        )
        (entmake entl)
      )
      (entmake (list (cons 0 "SEQEND")))
    )
  )
  (entlast)
)

;;###################################################### 
;;###################################################### 
;;###################################################### 

(defun t_app_sortedpoly ( count fptr / time1 time2 bDwgLoaded dwgFile )

  (princ "\n* Application Benchmark : Sorted Polyline\n")

  ;;------- Preparations --------
  (setq bDwgLoaded nil)
  (command "_erase" "_all" "")
  (setq dwgFile (findfile "Benches\\User\\App-SortedPoly.dwg"))
  (if dwgFile
    (progn
      (command "_insert" (strcat "*" dwgFile) "0,0,0" 1.0 0.0)
      (command "_zoom" "_e")
      (setq bDwgLoaded (ssget "ALL"))
    )
  )
  ;;-----------------------------

  ;;---- run the application ---- 1. original version
  (setq time1 (getvar "MILLISECS"))
  (if (not time1) (setq time1 (getvar "TDUSRTIMER")))
  (if (not time1) (setq time1 0.0))

  (if bDwgLoaded   ;; only if test drawing is inserted
    (c:SortedPoly)
  )

  (setq time2 (getvar "MILLISECS"))
  (if (not time2) (setq time2 (getvar "TDUSRTIMER")))
  (if (not time2) (setq time2 0.0))
  ;;-------- CleanUp ------------
  (setq bDwgLoaded nil)
  (command "_erase" "_all" "")

  ;;-----------------------------
  (setq bench$seconds (if hasMilliSecs (* 0.001 (- time2 time1)) (* 86400.0 (- time2 time1))))
  (princ (strcat "* APP SortedPoly : " (rtos bench$seconds 2 3) "\n"))
  (if fptr
    (princ (strcat "* APP SortedPoly : " (rtos bench$seconds 2 3) "\n") fptr)
  )
  bench$seconds
)

;; to increase/decrease the number of bench loops : > 1 increase < 1 decrease
(if (not $benchcyclesfactor) (setq $benchcyclesfactor 1))

;; to run this loaded test manually
(defun C:Run ()
  (setvar "cmdecho" 0)
  (print)
  (t_app_sortedpoly (* 1 $benchcyclesfactor) nil)
  (setvar "cmdecho" 1)
  (princ)
)
