Topic: Parse a string at space_chr by a specified max length

[David Bethel]

Greetings;

In vanilla autolisp, I'm revisiting a simple string parser

I'm supplied with very long ( 400-500 ) character lines of text.  I'm trying to parse so that neither the 1st or last character is a space and that new string be a shorter than the maximum specified length

Code: [Select]


(setq s1 "how now brown cow how have you been this week? how about next week")

;;;SPACE PLACEMENT RETURN LIST WITH THE OVERALL (streln) LAST
(setq sl  '(4 8 14 18 22 27 31 36 41 47 51 57 62 67))


;;With a specified max of 25 characters, this is list I am trying to achieve in a substr friendly format
;(substr_start_chr . substr_strlen)
(setq pl '((1 . 21) (23 . 28) (52 . 16)))


 ;the end result
(foreach p pl
  (terpri)
  (princ (substr s1 (car p) (cdr p))))


how now brown cow how
have you been this week? how
about next week



My present efforts have not been successful or pretty.

Any ideas ?  TIA  -David

[Lee Mac]

Here's an old function of mine, but I'm guessing that you want it in Vanilla only:

Code - Auto/Visual Lisp: [Select]

1. ;; String Wrap  -  Lee Mac
2. ;; Breaks a string at spaces (if possible) into a list of substrings of a specified length or less.
3. ;; str - [str] String to wrap to a specific length
4. ;; len - [int] Maximum length of each substring
5.  
6. (defun LM:stringwrap ( str len / pos )
7.     (if (< len (strlen str))
8.         (cons
9.             (substr str 1
10.                 (cond
11.                     (   (setq pos (vl-string-position 32 (substr str 1 len) nil t)))
12.                     (   (setq pos (1- len)) len)
13.                 )
14.             )
15.             (LM:stringwrap (substr str (+ 2 pos)) len)
16.         )
17.         (list str)
18.     )
19. )

Code - Auto/Visual Lisp: [Select]

1. _$ (setq s1 "how now brown cow how have you been this week? how about next week")
2. "how now brown cow how have you been this week? how about next week"
3. _$ (LM:stringwrap s1 25)
4. ("how now brown cow how" "have you been this week?" "how about next week")

[Lee Mac]

Here's a really quickly written Vanilla function:

Code - Auto/Visual Lisp: [Select]

1. (defun stringwrap ( str len / tmp )
2.     (while (wcmatch str " *")
3.         (setq str (substr str 2))
4.     )
5.     (if (< len (strlen str))
6.         (progn
7.             (if (wcmatch (setq tmp (substr str 1 len)) "* *")
8.                 (progn
9.                     (while (not (wcmatch tmp "* "))
10.                         (setq tmp (substr tmp 1 (1- (strlen tmp))))
11.                     )
12.                     (while (wcmatch tmp "* ")
13.                         (setq tmp (substr tmp 1 (1- (strlen tmp))))
14.                     )
15.                 )
16.             )
17.             (cons tmp (stringwrap (substr str (1+ (strlen tmp))) len))
18.         )
19.         (list str)
20.     )
21. )

Code - Auto/Visual Lisp: [Select]

1. _$ (setq s1 "how now brown cow how have you been this week? how about next week")
2. "how now brown cow how have you been this week? how about next week"
3. _$ (stringwrap s1 25)
4. ("how now brown cow how" "have you been this week?" "how about next week")

[reltro]

I may misunderstood something, but here is mine for "pretty printing"

Code - Auto/Visual Lisp: [Select]

1. (defun test(s1 maxL / s1 char tmp words maxL txt)
2.     (setq s1 (vl-string->list (strcat s1 " ")))
3.    
4.     (while s1
5.         (setq char (car s1))
6.         (setq s1 (cdr s1))
7.        
8.         (cond
9.             ((or (= char 32) (= char 13) (= char 9))
10.                 (setq words (cons (reverse tmp) words))
11.                 (setq tmp nil)
12.             )
13.             ('default
14.                 (setq tmp (cons char tmp))
15.             )
16.         )
17.     )
18.     (setq s1
19.         (mapcar
20.             '(lambda (a / )
21.                 (apply 'strcat (mapcar 'chr a))
22.             )
23.             (reverse words)
24.         )
25.     )
26.    
27.     (while s1
28.         (setq txt
29.             (cons
30.                 (    (lambda ( / L wordLen break thisLine i w Out)
31.                         (setq L 0)
32.                         (while (and (not break) s1)
33.                             (setq wordLen (strlen (setq w (strcat " " (car s1)))))
34.                             (cond
35.                                 ((>= (+ L wordLen) maxL)
36.                                     (setq break 'T)
37.                                 )
38.                                 ('default
39.                                     (setq thisLine (cons w thisLine))
40.                                     (setq s1 (cdr s1))
41.                                     (setq L (+ L wordLen))
42.                                 )
43.                             )
44.                         )
45.                         (setq thisLine (reverse thisLine))
46.                         (setq thisLine
47.                             (cons
48.                                 (substr (car thisLine) 2)
49.                                 (cdr thisLine)
50.                             )
51.                         )
52.                            
53.                         (setq i 0)
54.                         (repeat (- maxL L)
55.                             (if (= i (1- (length thisLine)))
56.                                 (setq i 0)
57.                             )
58.                            
59.                             (setq thisLine
60.                                 (    (lambda (E n / S)
61.                                         (if n
62.                                             (progn
63.                                                 (repeat i
64.                                                     (setq S (cons (car E) S))
65.                                                     (setq E (cdr E))
66.                                                 )
67.                                                 (append
68.                                                     (reverse S)
69.                                                     (cons (strcat n " ") (cdr E))
70.                                                 )
71.                                             )
72.                                             E
73.                                         )
74.                                     )
75.                                     thisLine
76.                                     (nth i thisLine)
77.                                 )
78.                             )
79.                             (setq i (1+ i))
80.                         )
81.                         (setq Out (apply 'strcat thisLine))
82.                         (setq Out
83.                             (if (= (substr Out (strlen Out)) " ")
84.                                 (substr Out 1 (1- (strlen Out)))
85.                                 Out
86.                             )
87.                         )
88.                         (strcat Out "\n")
89.                     )
90.                 )
91.                 txt
92.             )
93.         )
94.     )
95.     (apply 'strcat (reverse txt))
96. )
97.  
98.  

Code: [Select]

(progn
     (princ (test "how now brown cow how have you been this week? how about next week" 25))
     (princ)
)


Code: [Select]

how  now  brown  cow how
have   you   been   this
week?   how  about  next
week

reltro

[David Bethel]

Here's a really quickly written Vanilla function:

Code - Auto/Visual Lisp: [Select]

1. _$ (setq s1 "how now brown cow how have you been this week? how about next week")
2. "how now brown cow how have you been this week? how about next week"
3. _$ (stringwrap s1 10)
4.  
5. [/quote]
6.  
7.  
8. Lee,  Thanks  This close but not quite there.   Maxs out at 9 characters, not 10.
9.  
10. -Ddavid

[Lee Mac]

David,

Called with (stringwrap s1 10) the function will break at the closest space within 10 characters, i.e. for your string:

10th -----v
"how now brown cow how have you been this week? how about next week"
        ^----- String broken here

[CAB]

Late to the party.

http://www.theswamp.org/index.php?topic=19520.0

[David Bethel]

Thanks for inputs.  It has me going in the right direction.

Lee, I'm trying have a maximum of nn charcaters per line.  I think I can modify yours to get there.

CAB,reltro   Ssorry but I don't have access to vl_ calls.

-David

[David Bethel]

Here's what I have so far (Vanilla AutoLisp )

Code: [Select]


;;;PARSE A STRING BY MAX CHARACTERS
(defun parse (ps x / c b l i cl tl sl)
 (setq c 1 tl (strlen ps))
 (repeat tl
   (cond ((< tl x)
          (setq cl (list (1+ tl) 0)))
         ((= c 1)
          (setq cl '(0)
                 b x
                 l 1))
         ((and (= c tl)
               (> c b)
               (/= l (car cl)))
          (setq cl (cons l cl)
                cl (cons (1+ tl) cl)))
         ((= c tl)
          (setq cl (cons (1+ tl) cl)))
         ((and (= " " (substr ps c 1))
               (< c b))
          (setq l c))
         ((and (= " " (substr ps c 1))
               (>= c b))
          (setq cl (cons l cl)
                 b (+ l x)
                 l c)))
   (setq c (1+ c)))

 (setq cl (reverse cl))

 (setq i 0)
 (repeat (1- (length cl))
         (setq sl (cons (substr ps (1+ (nth i cl))
                                   (- (nth (1+ i) cl) (nth i cl) 1)) sl))
         (setq i (1+ i)))
 (reverse sl))


Code: [Select]

;;;PARSE AND PRINT AN ASCII TEXT FILE
(defun c:ascparse (/ file tsz ul rf nl mx)

  (while (not file)
         (setq file (getfiled "ASCII Text File to Print" "" "" 2)))

  (initget 6)
  (setq tsz (getdist (strcat "\nText Size <" (rtos (getvar "TEXTSIZE") 2 2)">:  ")))
  (or tsz (setq tsz (getvar "TEXTSIZE")))
  (setvar "TEXTSIZE" tsz)

  (initget 1)
  (setq ul (getpoint "\nStart Point:   "))

  (setq mx (getint "\nMaximum Characters Per Line <80>:   "))
  (or mx (setq mx 80))

  (setq rf (open file "r"))
  (while (setq nl (read-line rf))
         (if (= nl "")
             (setq ul (list (car ul) (- (cadr ul) (* tsz 1.75)) 0))
             (progn
               (foreach l (parse nl mx)
                  (entmake (list (cons 0 "TEXT")
                                 (cons 1 l)
                                 (cons 6 "BYLAYER")
                                 (cons 7 (getvar "TEXTSTYLE"))
                                 (cons 8 (getvar "CLAYER"))
                                 (cons 10 ul)
                                 (cons 11 ul)
                                 (cons 39 0.0)
                                 (cons 40 tsz)
                                 (cons 41 1.0)
                                 (cons 50 0.0)
                                 (cons 51 0.0)
                                 (cons 62 1)
                                 (cons 71 0)
                                 (cons 72 0)
                                 (cons 73 0)
                                 (cons 210 (list 0 0 1))))
                  (setq ul (list (car ul) (- (cadr ul) (* tsz 1.75)) 0))))))
 (close rf)
 (prin1))

I've tried to think of most scenarios but I'm sure the bugs will raise their ugly heads.  Thanks again!  -Davifd

[CAB]

Ah you let one little vl- spoil the party?

Not sure it was even necessary. Try this:

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 (list tmp (substr str (1+ ptr))))
    (setq tmp (cons tmp (StrWrap (substr str (1+ ptr)) MaxLen SpBrk)))
  )
  tmp
)


(defun c:Test ( / text )
    (setq text
        "how now brown cow how have you been this week? how about next week"
    )
   
    (foreach width '( 25 40 50 60 )
   
        (princ (strcat "Using width " (itoa width) ":\n\n"))
       
        (foreach item (StrWrap text width t)
            (princ (strcat item "\n"))           
        )
       
        (princ "\n\n")
   
    )

    (princ)

)

[David Bethel]

Ah you let one little vl- spoil the party?

Yep ,  sorry

This 1 works wells although I have been able to dissect it yet <g>

Thanks!   -David

[Lee Mac]

Lee, I'm trying have a maximum of nn charcaters per line.  I think I can modify yours to get there.

This is what I thought you were aiming for - though, if your posted function is the desired result, then maybe I still do not quite understand what you are looking for since:

_$ (setq s1 "how now brown cow how have you been this week? how about next week")
"how now brown cow how have you been this week? how about next week"

_$ (parse s1 10)
("how now" "brown" "cow how" "have you" "been" "this" "week?" "how""about" "next week")

_$ (stringwrap s1 10)
("how now" "brown cow" "how have" "you been" "this" "week? how" "about" "next week")

[David Bethel]

Lee, I'm trying have a maximum of nn charcaters per line.  I think I can modify yours to get there.

This is what I thought you were aiming for - though, if your posted function is the desired result, then maybe I still do not quite understand what you are looking for since:

_$ (stringwrap s1 10)
("how now" "brown cow" "how have" "you been" "this" "week? how" "about" "next week")

I saw this in a couple of the returns.  My guess it that break placement is being increased as (+ len len) when it should be (+ last_break_space  len )
ie for (stringwrap s1 10 ), if the break space is at 14, the next should be less then character 24 ( 10 characters long )

Hoe that make sense. 


I'm still tinkering with mine.  Still with limited success.  -David

[Lee Mac]

I see - try this David:

Code: [Select]

(defun stringwrap ( str lim / itm len lst rtn tmp )
    (repeat (strlen str)
        (setq lst (cons (ascii str) lst)
              str (substr str 2)
        )
    )
    (setq lst
        (read
            (strcat "(\""
                (apply 'strcat
                    (mapcar 'chr
                        (apply 'append
                            (subst '(92 92) '(92)
                                (subst '(34 34) '(32)
                                    (mapcar 'list (reverse lst))
                                )
                            )
                        )
                    )
                )
                "\")"
            )
        )
    )
    (while lst
        (setq tmp (car lst)
              lst (cdr lst)
              len (strlen tmp)
        )
        (while
            (and
                (setq itm (car lst))
                (<= (setq len (+ 1 len (strlen itm))) lim)
            )
            (setq tmp (strcat tmp " " itm)
                  lst (cdr lst)
            )
        )
        (setq rtn (cons tmp rtn))
    )
    (reverse rtn)
)

Code: [Select]

_$ (stringwrap s1 10)
("how now" "brown cow" "how have" "you been" "this week?" "how about" "next week")

[David Bethel]

I see - try this David:

Ah Ha ! this 1 I can dissect and understand.  You are making a list of the word strings and the limiting the number of characters for the return list.  I would have thought the double \\ and "" would not have to be dealt with but I hadn't tested.

I was using the space characters as place holders.

Thanks!  -David