]> (define debug (external-procedure "UNREGISTERED::James Clark//Procedure::debug")) (declare-characteristic page-number-format "UNREGISTERED::James Clark//Characteristic::page-number-format" "1") (declare-characteristic page-number-restart? "UNREGISTERED::James Clark//Characteristic::page-number-restart?" #f) (declare-characteristic superscript-height "UNREGISTERED::Jamed Clark//Characteristic::superscript-height" 0pt) (define *header-string* "ISO 9084:2000(F)") (define *footer-string* "© ISO 2000 - Tous droits réservés") (define-unit lines 11.5pt) (declare-initial-value font-family-name "Helvetica") (declare-initial-value font-size 9.85pt) (declare-initial-value line-spacing 1lines) (define *page-width* 595pt) (define *page-height* 842pt) (default (empty-sosofo)) (define (init-page-header) (make sequence line-thickness: 2pt (make rule) (make paragraph space-before: .5lines space-after: 1lines font-size: 11pt font-weight: 'bold quadding: 'end (literal *header-string*)) (make rule))) (define (header-para #!optional (pos 'start)) (make paragraph font-size: 11pt font-weight: 'bold quadding: pos (literal *header-string*))) (define (front-page-header) (header-para 'end)) (define (back-page-header) (header-para)) (define (footer-obj-list) (list (make sequence font-size: 8pt (literal *footer-string*)) (make leader (literal " ")) (page-number-sosofo))) (define (front-page-footer) (make paragraph (apply sosofo-append (footer-obj-list)))) (define (back-page-footer) (make paragraph (apply sosofo-append (reverse (footer-obj-list))))) (define-page-model _INIT-PM-1_ (filling-direction 'top-to-bottom) (width *page-width*) (height *page-height*) (region (x-origin 49pt) (y-origin 70pt) (width 510pt) (height 746pt) (flow body) (header (width 510pt) (height 43pt) (generate (init-page-header)))) (region (x-origin 49pt) (y-origin 22pt) (width 510pt) (height 14pt) (footer (width 510pt) (height 14pt) (generate (front-page-footer)))) ) (define-page-model _FRONT-PM-1_ (filling-direction 'top-to-bottom) (width *page-width*) (height *page-height*) (region (x-origin 49pt) (y-origin 70pt) (width 510pt) (height 746pt) (flow body) (header (width 510pt) (height 43pt) (generate (front-page-header)))) (region (x-origin 49pt) (y-origin 22pt) (width 510pt) (height 14pt) (footer (width 510pt) (height 14pt) (generate (front-page-footer)))) ) (define-page-model _BACK-PM-1_ (filling-direction 'top-to-bottom) (width *page-width*) (height *page-height*) (region (x-origin 36pt) (y-origin 70pt) (width 510pt) (height 746pt) (flow body) (header (width 510pt) (height 43pt) (generate (back-page-header)))) (region (x-origin 36pt) (y-origin 22pt) (width 510pt) (height 14pt) (footer (width 510pt) (height 14pt) (generate (back-page-footer)))) ) (define-page-model _BLANK_ (filling-direction 'top-to-bottom) (width *page-width*) (height *page-height*) (region (x-origin 49pt) (y-origin 70pt) (width 510pt) (height 746pt) (flow dummy)) ) (define *bold-style* (style font-weight: 'bold)) (define *italic-style* (style font-posture: 'italic)) (element STANDARD (make sequence language: (string->symbol (attribute-string "LANGUAGE")) (make page-sequence repeat-page-models: '(_FRONT-PM-1_ _BACK-PM-1_) page-number-format: "i" force-last-page: 'back blank-back-page-model: _BLANK_ (sosofo-label (process-matching-children "TOC" "FOREWORD" "INTRO") 'body)) (make page-sequence initial-page-models: '(_INIT-PM-1_) repeat-page-models: '(_BACK-PM-1_ _FRONT-PM-1_) page-number-restart?: #t (sosofo-label (process-matching-children "BODY" "ANNEXN" "ANNEXI" "ANNEXBL") 'body)) )) (define (contents? snl) (or (match-element? '("SCOPE" "HT") snl) (match-element? '("REFS" "HT") snl) (match-element? '("BODY" "H1" "HT") snl) (match-element? '("ANNEXN" "HT") snl) (match-element? '("ANNEXI" "HT") snl) (match-element? '("ANNEXBL" "HT") snl) )) (element TOC (make display-group (with-mode contents-mode (process-node-list (current-node))) (with-mode contents-mode (process-node-list (node-list-filter contents? (subtree (parent))))) )) (mode contents-mode (element TOC (make paragraph space-before: 65pt space-after: 1.2lines (make sequence font-size: 13.5pt use: *bold-style* (literal "Sommaire")) (make leader (literal " ")) (literal "Page"))) ) (element FOREWORD (make display-group space-before: 65pt break-before: 'page)) (element INTRO (make display-group space-before: 65pt break-before: 'page)) (element HT (let ((gtext (inherited-attribute-string "GTEXT"))) (make paragraph font-size: 12pt font-weight: 'bold ; keep-with-next?: #t space-before: 2lines space-after: 1lines (literal gtext) (process-children)))) (element (FOREWORD HT) (make paragraph font-size: 13pt space-after: 15pt font-weight: 'bold)) (element (INTRO HT) (make paragraph font-size: 13pt space-after: 15pt font-weight: 'bold)) (mode contents-mode (element HT (let ((gtext (inherited-attribute-string "GTEXT"))) (make paragraph last-line-quadding: 'justify line-spacing: 1.5lines (if gtext (make line-field field-width: 35pt (literal gtext)) (empty-sosofo)) (process-children) (make leader (literal ".")) (literal " ") (current-node-page-number-sosofo))))) (define *default-para-style* (style quadding: 'justify start-indent: (inherited-start-indent) first-line-start-indent: 0pt hyphenate?: #t)) (element P (make paragraph use: *default-para-style* space-after: 1lines)) (element HP (let ((format (attribute-string "FORMAT"))) (make sequence use: (case format (("BOLD") *bold-style*) (("ITALIC") *italic-style*) (("BOLDIT") (merge-style *bold-style* *italic-style*)))))) (element EXTDOC (process-children)) (element BODY (process-children)) (element SCOPE (make display-group space-before: 13lines (process-children) )) (element WARNING (make paragraph use: (merge-style *default-para-style* *bold-style*) space-before: 1lines (literal "AVERTISSEMENT - ") (process-children))) (element REFS (make display-group)) (element RL (make display-group)) (element RLENTRY (make paragraph use: *default-para-style* space-before: 1lines)) (element TAIL (process-children)) (element H1 (make display-group)) (element XREF (let* ((gtext (attribute-string "GTEXT")) (ssf (if gtext (literal gtext) (process-children))) (format (attribute-string "FORMAT"))) (case format (("#") ssf) (("tablenote #") (make superscript font-size: (* (inherited-font-size) (/ 2 3)) superscript-height: 5pt ssf)) (else ssf)))) (element TABLE (make display-group keep: #t ;keep-with-previous?: #t space-before: 1lines (process-matching-children "TGROUP"))) (element TABTITLE (let ((gtext (attribute-string "GTEXT"))) (make paragraph quadding: 'center (literal gtext " - ") (process-children) ))) (element TGROUP (make table (process-matching-children "COLSPEC") (make table-row use: *bold-style* (make table-cell cell-after-row-margin: 7pt n-columns-spanned: (string->number (attribute-string "COLS")) (process-node-list (select-elements (children (parent)) "TABTITLE")))) (process-matching-children "THEAD") (process-matching-children "TBODY") )) (element COLSPEC (let* ((val (attribute-string "COLWIDTH")) (colwidth (if val (let loop ((pos 0) (str "")) (cond ((>= pos (string-length val)) (string->number str)) ((or (char=? #\digit-zero (string-ref val pos)) (char=? #\digit-one (string-ref val pos)) (char=? #\digit-two (string-ref val pos)) (char=? #\digit-three (string-ref val pos)) (char=? #\digit-four (string-ref val pos)) (char=? #\digit-five (string-ref val pos)) (char=? #\digit-six (string-ref val pos)) (char=? #\digit-seven (string-ref val pos)) (char=? #\digit-eight (string-ref val pos)) (char=? #\digit-nine (string-ref val pos))) (loop (+ pos 1) (string-append str (substring val pos (+ pos 1))))) (else (string->number str)))) 1))) (make table-column width: (table-unit colwidth)))) (element THEAD (process-children)) (element TBODY (process-children)) (element (THEAD ROW) (make table-row use: *bold-style*)) (element ROW (make table-row)) (define (bold-border) (make table-border line-thickness: 1pt)) (define (border) (make table-border line-thickness: .5pt)) (define (non-border) (make table-border line-thickness: 0pt border-present?: #f)) (element ENTRY (let* ((valign (case (attribute-string "VALIGN") (("TOP") 'start) (("MIDDLE") 'center) (("BOTTOM") 'end) (else 'start))) (align (case (attribute-string "ALIGN") (("LEFT") 'start) (("CENTER") 'center) (("RIGHT") 'end) (else 'start))) (namest (string->number (or (attribute-string "NAMEST") "1"))) (nameend (string->number (or (attribute-string "NAMEEND") "1"))) (colsep (attribute-string "COLSEP")) (rowsep (attribute-string "ROWSEP")) (irowsep (inherited-element-attribute-string "ROW" "ROWSEP")) (col-border (case colsep (("0" #f) #f) (else (border)))) (row-border (case rowsep (("0" #f) (case irowsep (("0" #f) #f) (else (border)))) (else (border)))) (colname (attribute-string "COLNAME"))) (make table-cell column-number: (or (and colname (string->number colname)) namest) cell-before-column-border: (if (first-sibling? (current-node)) (bold-border) col-border) cell-after-column-border: (if (last-sibling? (current-node)) (bold-border) col-border) cell-before-row-border: (if (first-sibling? (parent)) (bold-border) row-border) cell-after-row-border: (if (last-sibling? (parent)) (bold-border) row-border) cell-before-column-margin: 1pt cell-after-column-margin: 1pt cell-after-row-margin: 5pt cell-row-alignment: valign n-rows-spanned: (+ 1 (string->number (or (attribute-string "MOREROWS") "0"))) n-columns-spanned: (+ 1 (- nameend namest)) (make paragraph quadding: align)))) (element FORMULA (make sequence (process-matching-children "MATHART"))) (element MATHART (let* ((entity-name (attribute-string "ENTITY")) (notation-name (entity-notation entity-name))) (make external-graphic min-leading: 1lines display?: (case (attribute-string "POSITION") (("INLINE") #f) (else #t)) scale: 'max-uniform position-point-y: (string->number (attribute-string "BLOFFSET")) max-height: (string->number (attribute-string "HEIGHT")) max-width: (string->number (attribute-string "WIDTH")) entity-system-id: (entity-generated-system-id entity-name) notation-system-id: notation-name))) (element SUPERSCRIPT (make superscript font-size: (* (inherited-font-size) (/ 2 3)) superscript-height: 5pt)) (element TABNOTE (let ((gtext (attribute-string "GTEXT"))) (make paragraph (make superscript font-size: (* (inherited-font-size) (/ 2 3)) superscript-height: 5pt (literal gtext)) (process-children)))) (element H2 (make display-group)) (element H3 (make display-group)) (element H4 (make display-group)) (element UL (make display-group)) (element LI (let ((gtext (attribute-string "GTEXT"))) (make paragraph start-indent: (+ (inherited-start-indent) 15pt) first-line-start-indent: -15pt space-before: 1lines (make line-field field-width: 15pt (literal gtext)) (process-children)))) (element OL (make display-group)) (element DFORMULA (let ((gtext (attribute-string "GTEXT"))) (make table keep: #t space-before: 1lines space-after: (if (last-sibling? (current-node)) 1lines 0pt) cell-before-column-border: #f cell-after-column-border: #f cell-before-row-border: #f cell-after-row-border: #f (make table-column width: (table-unit 9)) (make table-column width: (table-unit 1)) (make table-row start-indent: 0pt cell-row-alignment: 'center (make table-cell (process-matching-children "MATHART")) (make table-cell (make paragraph line-spacing: (* 6.85pt 0.785) quadding: 'end (literal (or gtext "")))) )))) (element (DFORMULA MATHART) (let* ((entity-name (attribute-string "ENTITY")) (notation-name (entity-notation entity-name))) (make external-graphic min-leading: 1lines display?: #t scale: 'max-uniform max-height: (string->number (attribute-string "HEIGHT")) max-width: (string->number (attribute-string "WIDTH")) entity-system-id: (entity-generated-system-id entity-name) notation-system-id: notation-name))) (define (annex) (make display-group break-before: 'page)) (define (annexht) (let* ((status (inherited-attribute-string "STATUS")) (gtext (inherited-attribute-string "GTEXT"))) (make display-group quadding: 'center font-size: 13.5pt (make paragraph space-before: 1lines use: *bold-style* (literal (or gtext ""))) (make paragraph font-size: 12pt line-spacing: 16pt (literal "(" status ")")) (make paragraph space-before: 2lines space-after: 1lines use: *bold-style* )))) (element ANNEXN (annex)) (element (ANNEXN HT) (annexht)) (element ANNEXI (annex)) (element (ANNEXI HT) (annexht)) (element ANNEXBL (annex)) (element (ANNEXBL HT) (make paragraph space-before: 1lines quadding: 'center font-size: 13.5pt use: *bold-style*)) (element FIGURE (make display-group keep: 'page space-before: 2lines (process-matching-children "FIGBODY") (process-matching-children "FIGTITLE"))) (element FIGTITLE (let* ((gtext (attribute-string "GTEXT"))) (make paragraph use: *bold-style* quadding: 'center space-before: 5pt (if gtext (literal gtext " - ") (empty-sosofo)) (process-children)))) (element FIGBODY (let ((cols (string->number (or (inherited-element-attribute-string "FIGURE" "COLS") "1")))) (make table (let loop ((i cols) (foc (make table-column width: (table-unit 1)))) (if (< 0 i) (empty-sosofo) (sosofo-append foc (loop (- i 1) foc)))) (process-children)))) (element FIGROW (make table-row)) (element FIGCELL (let* ((colnum (attribute-string "COLNUM"))) (make table-cell column-number: (string->number colnum) quadding: 'center))) (element ARTWORK (let* ((entity-name (attribute-string "ENTITY")) (notation-name (entity-notation entity-name))) (make external-graphic display-alignment: 'center min-leading: 1lines display?: #t scale: 'max-uniform max-height: (string->number (attribute-string "HEIGHT")) max-width: (string->number (attribute-string "WIDTH")) entity-system-id: (entity-generated-system-id entity-name) notation-system-id: notation-name))) (element SUBF (process-children)) (element SUBFTIT (let ((colnum (inherited-element-attribute-string "FIGCELL" "COLNUM"))) (make paragraph use: *bold-style* space-before: 5pt quadding: 'center (if colnum (literal (format-number (string->number colnum) "a") ") ") (empty-sosofo)) (process-children)) )) (element DL (make display-group)) (define dtw 35pt) (element DLENTRY (make paragraph space-before: 1lines first-line-start-indent: (- dtw) start-indent: (+ (inherited-start-indent) dtw))) (element DT (make line-field field-width: dtw)) (element DD (process-children)) (element XMP (let ((gtext (attribute-string "GTEXT"))) (make display-group space-before: 1lines (literal gtext) (process-children)))) (element BL (make display-group)) (define blw 20pt) (element BLENTRY (let ((gtext (attribute-string "GTEXT"))) (make paragraph start-indent: blw first-line-start-indent: (- blw) space-before: 1lines (make line-field field-width: blw (literal gtext)) (process-children))))