; 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/squaregeocities.com/soho
(to report bad content: archivehelp @ gmail)
|
|
|
|
|