;; $Id: dbprocdr.dsl 0.89 1997/08/05 19:07:13 nwalsh Exp $

;; ============================= PROCEDURES =============================

(define (PROCSTEP ilvl)
  (if (> ilvl 1) 2.0em 1.8em))

(define ($hierarch-number-format$ depth)
  (case (modulo depth 5)
    ((1) "1")
    ((2) "a")
    ((3) "i")
    ((4) "A")
    (else "I")))

(define ($hierarch-number$ nd seperator)
  (if (equal? (gi nd) "STEP")
      (string-append
       (format-number
	(child-number nd) 
	($hierarch-number-format$ ($proc-step-depth$ nd)))
       seperator)
      ""))

(define ($proc-step-depth$ nd)
  (let loop ((step nd) (depth 0))
    (if (equal? (gi step) "PROCEDURE")
	depth
	(loop (parent step) 
	      (if (equal? (gi step) "STEP")
		  (+ depth 1)
		  depth)))))

(define ($proc-step-number$ nd)
  (let* ((step (if (equal? (gi nd) "STEP") nd (parent nd)))
	 (str ($hierarch-number$ step "")))
    (string-append str (gentext-label-title-sep "STEP"))))

(define ($proc-step-xref-number$ nd)
  (let loop ((step nd) (str "") (first #t))
    (if (equal? (gi step) "PROCEDURE")
	str
	(loop (parent step) 
	      (if (equal? (gi step) "STEP")
		  (string-append 
		   ($hierarch-number$ step
				      (if first
					  ""
					  (gentext-intra-label-sep "STEP")))
		   str)
		  str)
	      (if (equal? (gi step) "STEP")
		  #f
		  first)))))
 
(element PROCEDURE ($list$))
(element (PROCEDURE TITLE) ($lowtitle$ 2))

(element SUBSTEPS
  (make display-group
	space-before: %para-sep%
	space-after: %para-sep%
	start-indent: (+ (inherited-start-indent) (PROCSTEP 2))))

(element (STEP PARA)
  (let ((ilevel 
	 (length (hierarchical-number-recursive "STEP"))))
    (if (= (child-number) 1)
	(make paragraph
	      use: para-style
	      space-before: %para-sep%
	      start-indent: (+ (inherited-start-indent)
			       (PROCSTEP ilevel))
	      first-line-start-indent: (- (PROCSTEP ilevel))
	      (make line-field
		    field-width: (PROCSTEP ilevel)
		    (literal
		     ($proc-step-number$ (current-node))))
	      (make sequence
		    first-line-start-indent: 0pt
		    (process-children-trim)))
    (make paragraph
	  use: para-style
	  space-before: %para-sep%
	  start-indent: (+ (inherited-start-indent) (PROCSTEP ilevel))
	  (process-children-trim)))))