Author Topic: Break a string at a given length.  (Read 2078 times)

0 Members and 1 Guest are viewing this topic.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Break a string at a given length.
« on: October 21, 2007, 02:45:41 PM »
Seems like we did the exercise before but I could not find it.

Any improvements of this function?


Code: [Select]
;;  CAB  10.21.2007
;;  Break String at MaxLen
;;  Return a list of strings broken to Max Length
;;  If SpBrk is true back up the the previous space.
(defun StrWrap (str MaxLen SpBrk / tmp)
  (setq ptr MaxLen)
  (if (and SpBrk (> (strlen str) MaxLen))
    (while (and (not (zerop ptr)) (/= (substr str ptr 1) " "))
      (setq ptr (1- ptr)))
  )
  (and (zerop ptr) (setq ptr MaxLen)) ; no space char
  (setq tmp (substr str 1 ptr))
  (if (< (- (strlen str) (strlen tmp)) MaxLen)
    (setq tmp (vl-remove "" (list tmp (substr str (1+ ptr)))))
    (setq tmp (cons tmp (StrWrap (substr str (1+ ptr)) MaxLen SpBrk)))
  )
  tmp
)



Code: [Select]
(defun c:test (/ ts n)
  ;;  Break at space
  (foreach ts (list "abcd efghi jklmn pqrst uvwxyz"
                    "abcdefghijklmnpqrstuvwxyz"
              )
    (setq n 8)
    (repeat 20
      (print n)
      (prin1 (StrWrap ts n t))
      (setq n (1+ n))
    )
    (print)
  )
  ;;  Break exact
  (foreach ts (list "abcd efghi jklmn pqrst uvwxyz"
                    "abcdefghijklmnpqrstuvwxyz"
              )
    (setq n 8)
    (repeat 20
      (print n)
      (prin1 (StrWrap ts n nil))
      (setq n (1+ n))
    )
    (print)
  )

  (princ)
)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Break a string at a given length.
« Reply #1 on: October 21, 2007, 06:45:28 PM »
Found the previous topic, finally: http://www.theswamp.org/index.php?topic=16736.0
Though I was miss remembering I had seen it. 8-)
So here is another test routine:
Code: [Select]
(defun c:Test ( / text )
    (setq text
        (strcat       
            "I want to create a DCL UI that has a description "
            "box that shows information created from a text file. "
            "In short the text file will be descriptions of a "
            "series of LISP Routines I have. What I would like "
            "to be able to do is have the description word wrap "
            "within the \"list box\" that I have created. Is word "
            "wrapping possible in DCL? What am I missing? Thanks, "
            "Dan."
        )
    )
   
    (foreach width '( 40 50 60 70 80 )
   
        (princ (strcat "Using width " (itoa width) ":\n\n"))
       
        (foreach item (StrWrap text width t)
            (princ (strcat item "\n"))           
        )
       
        (princ "\n\n")
   
    )

    (princ)

)
« Last Edit: October 21, 2007, 06:46:39 PM by CAB »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Break a string at a given length.
« Reply #2 on: October 22, 2007, 08:47:20 AM »
Cooked up this non-recursive version.

Code: [Select]
;;  CAB  10.22.2007
;;  Break String at MaxLen
;;  Return a list of strings broken to Max Length
;;  If SpBrk is true back up the the previous space.
(defun StrWrap2 (str MaxLen SpBrk / alist plast pf pl strlist)
  (setq alist (vl-string->list str)
        pf    1
        plast (length alist)
  )
  (while (< pf plast)
    (setq pl (1- (+ pf maxlen)))
    (if SpBrk
      (while (and (> pl pf) (/= (nth pl alist) 32))
        (setq pl (1- pl))
      )
      (setq pl (1- pl))
    )
    (and (= pf pl) (setq pl (- (+ pf maxlen)2)))
    (setq strlist (cons (substr str pf (+(- pl pf)2)) strlist)
          pf      (+ pl 2)
    )
    (if (< (- plast pf) maxlen)
      (setq strlist (cons (substr str pf) strlist)
            pf      plast
      )
    )
  )
  (reverse strlist)
)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.