; -*- Scheme -*-
;
; $Id: string37.scm,v 1.1 1998/03/16 07:59:51 foner Exp $

(require 'substring:replicate!)
(require 'substring:copy!)

;+doc
; procedure: substring:center-with-padding!
; arguments: source  source-start  source-end
;            padding padding-start padding-end
;            result  result-start  result-end
; signature: string x int x int x string x int x int x string x int x int
;         -> unspecified
; pre:       (and (not (eq? source result)) (not (eq? padding result))
;                 (<= 0 source-start source-end (string-length source))
;                 (<= 0 padding-start padding-end (string-length padding))
;                 (<= 0 result-start result-end (string-length result))
;                 (<= (- source-end source-start) (- result-end result-start)))
;
; Modifies the section (SUBSTRING RESULT RESULT-START RESULT-END) of
; RESULT so that the string (SUBSTRING SOURCE SOURCE-START SOURCE-END)
; is centered in it with the RESULT padded on either side with 
; (SUBSTRING PATTERN PATTERN-START PATTERN-END)
;
; The PADDING will be used such that when used on the left of the
; center it will be truncated on the right if a complete pattern
; cannot fit and when used on the right it will be truncated on the
; left.  The following example highlights this behaviour :-
;
; > (define r "pqrstuv")
; > (substring:center! "abc" 0 3 "bevan" 0 5 r 0 7)
; > r
; "beabcan"
;
; The choice of effect on truncation has been chosen for its symmetry
; rather than any particular need for this result.
;-doc

(define substring:center-with-padding!
  (lambda (s ss se p ps pe r rs re)
    (let ((rl (- re rs)) (sl (- se ss)))
      (let* ((lc (quotient (- rl sl) 2)) (rc (- rl (+ lc sl))))
	(substring:replicate! r rs (+ rs lc) p ps (min (+ ps lc) pe))
	(substring:copy! s ss se r (+ rs lc))
	(substring:replicate! r (- re rc) re p (max ps (- pe rc)) pe)))))

; eof
