This Text file is old! In a 🏛️Museum, an unsorted archive of (user-)pages. (Saved from Geocities in Oct-2009. The archival story: oocities.org)
--------------------------------------- (To 🚫report any bad content: archivehelp @ gmail.com)
>

; fillline1.scm - wrapping text into fixed length lines
; (based on code in "Haskell - The Craft of Functional Programming - Simon Thompson")

(define (getword l)
    (cond 
       ((null? l) '())
       ((char-whitespace? (car l)) '())
       (else (cons (car l) (getword (cdr l))) )))

(define (getword2 l)
   (list->string (getword (string->list l))))  

(define (dropword l)
    (cond 
       ((null? l) '())
       ((char-whitespace? (car l)) l)
       (else (dropword (cdr l)) )))

(define (dropword2 l)
   (list->string (dropword (string->list l))))

(define (dropspace l)
    (cond 
       ((null? l) '())
       ((char-whitespace? (car l)) (dropspace (cdr l)))
       (else l)))

(define (dropspace2 l)
   (list->string (dropspace (string->list l))))

; for char lists
(define (test-with-string f l)
      (list->string (apply f (list (string->list l)))))

; a version for lists of char lists
(define (test-with-string-2 f l)
      (map list->string (apply f (list (string->list l)))))

(define (split l)
    (cond 
       ((null? l) '())
       (else (cons (getword l) (split (dropspace (dropword l)))))))

(define (splitwords l)
   (split (dropspace l)))  

(define (newlen words len)
  (- len (+ 1 (string-length (car words)))))

(define (restofline words len)
  (getline (newlen words len) (cdr words)))

(define (getline2 len words)
    (cond 
       ((null? words) '())
       ((<= (string-length (car words)) len) (cons (car words) (restofline words len))) 
       (else '())))   

(define (getline len words)
    (letrec
       ((newlen        
          (lambda (words len)
             (- len (+ 1 (string-length (car words))))))
        (restofline 
           (lambda (words len)
              (getline2 (newlen words len) (cdr words))))
        (getline2 
           (lambda (len words)
              (cond 
                 ((null? words) '())
                 ((<= (string-length (car words)) len) 
                  (cons (car words) (restofline words len))) 
                 (else '()))))) 
   (getline2 len words)))      
      
; Dropping the first line from a list of words.

(define (dropline len words)
    (letrec
       ((newlen        
          (lambda (words len)
             (- len (+ 1 (string-length (car words))))))
        (restofline 
           (lambda (words len)
              (dropline2 (newlen words len) (cdr words))))
        (dropline2 
           (lambda (len words)
              (cond 
                 ((null? words) '())
                 ((<= (string-length (car words)) len) 
                  (restofline words len)) 
                 (else words))))) 
   (dropline2 len words)))      

(define (splitlines len words)
    (cond 
       ((null? words) '())
       (else (cons (getline len words) (splitlines len (dropline len words))))))

(define (fill text)
   (splitlines 35 (test-with-string-2 splitwords text)))  

(define (joinlines lines)
  (letrec
     ((joinlines2
       (lambda (line)
          (cond 
             ((null? line) "")
             ((pair? line) (string-append (car line) " " (joinlines2 (cdr line)))) 
             (else line))))
      (joinlines1
       (lambda (lines)
          (cond 
             ((null? lines) "")
             (else 
                (string-append 
                   (joinlines2 (car lines)) 
                   (string #\newline) 
                   (joinlines1 (cdr lines))))))))   
   (joinlines1 lines)))        

;---------------------------------------------------------------------
; test:

(equal? (getword2 " boo") "")
(equal? (getword2 "cat dog") "cat")
(equal? (dropword2 "cat dog") " dog")
(equal? (dropspace2 " dog") "dog")
(test-with-string getword " boo")
(test-with-string getword "cat dog")
(test-with-string dropword "cat dog")
(test-with-string dropspace " dog")
(test-with-string-2 split "dog cat")
(test-with-string-2 splitwords "   dog cat")
(getline 20 '("Mary" "Poppins" "looks" "like" "Sally"))
(dropline 20 '("Mary" "Poppins" "looks" "like" "Sally"))

(define line1 "The heat bloomed     in December as the   carnival  season kicked into gear.")
(define line2 "The heat bloomed     in December as the   carnival  season kicked into gear. Nearly helpless with sun and glare, I avoided Rio's brilliant sidewalks and glittering beaches, panting in dark   corners  and waiting out the inverted southern summer.")
;(test-with-string-2 splitwords line1)
;(getline 35 (test-with-string-2 splitwords line1))
;(fill line1)
(joinlines (fill line2))









Text file Source (historic): geocities.com/soho/square/3472

geocities.com/soho/square
geocities.com/soho

(to report bad content: archivehelp @ gmail)