jp.wikiwiki.aiou.CalibreARDB

Last-modified: 2026-01-18 (日) 23:02:41

Calibre DRC の ASCII データベースファイルを扱うためのユーティリティ。

; ==============================================================================
; jp_wikiwiki_aiou_CalibreARDB_parse
; @Version(20191011b)
; ==============================================================================
;
; returns <AsciiResultsDatabase>-formatted datum.
;
; <AsciiResultsDatabase> ::
;   Table
;     {
;     "topCellName" : <String>,
;     "databasePrecision" : <Float>,
;     "drcResults" : List [<DrcResult>, ...]
;     }
;
; <DrcResult> ::
;   Table
;     {
;     "ruleCheckName"           : <String>,
;     "currentDrcResultsCount"  : <Integer:non-negative>,
;     "originalDrcResultsCount" : <Integer:non-negative>,
;     "dateTimeStamp"           : <String:/YYYY-MM-DDThh:mm:ss/>, ;; ISO8601 format
;     "checkTextLineCount"      : <Integer:non-negative>,
;     "checkTextLines"          : List [<String>, ...],
;     "figs"                    : List [<Fig>, ...]
;     }
;
; <Fig> ::
;   Table
;     {
;     "figType"             : (<Symbol:e> | <Symbol:p>),
;     "ordinals"            : <Integer:non-negative>,
;     "properties"          : List [<String>, ...],
;     "coordinateDataCount" : <Integer:non-negative>,
;     "coordinateData"      : <CoordinateData>
;     }
;
; <CoordinateData> ::
;   List
;     [
;     <Float:represents-X-value>,
;     <Float:represents-Y-value>
;     ]
;
; ==============================================================================
;
(define (jp_wikiwiki_aiou_CalibreARDB_parse asciiResultsDatabasePath @key (convertDimension nil))
  (let ((in (infile asciiResultsDatabasePath)))
    (and (portp in)
      (let ((ardb (makeTable (gensym))) (convertDenominator 1) (line 'unbound))
        (prog1 ardb
          (when (stringp (gets line in))
            (apply
              (lambda (topCellName databasePrecision @rest _)
                (setq databasePrecision (atof databasePrecision))
                (setarray ardb "topCellName" topCellName)
                (setarray ardb "databasePrecision" databasePrecision)
                (when convertDimension
                  (setq convertDenominator databasePrecision)
                  (setarray ardb "databasePrecision" 1.0)))
              (parseString line " \n"))
            (setarray ardb "drcResults"
              (let ((drcResults (tconc nil 'unbound)))
                (while (stringp (gets line in))
                  (let ((drcResult (makeTable (gensym))))
                    (apply
                      (lambda (ruleCheckName @rest _)
                        (setarray drcResult "ruleCheckName" ruleCheckName))
                      (parseString line " \n"))
                    (when (stringp (gets line in))
                      (apply
                        (lambda (currentDrcResultsCount originalDrcResultsCount checkTextLineCount MMM DD hh mm ss YYYY @rest _)
                          (setq currentDrcResultsCount (atoi currentDrcResultsCount))
                          (setq originalDrcResultsCount (atoi originalDrcResultsCount))
                          (setq checkTextLineCount (atoi checkTextLineCount))
                          (setarray drcResult "currentDrcResultsCount" currentDrcResultsCount)
                          (setarray drcResult "originalDrcResultsCount" originalDrcResultsCount)
                          (setarray drcResult "checkTextLineCount" checkTextLineCount)
                          (setarray drcResult "dateTimeStamp"
                            (lsprintf "%s-%s-%sT%s:%s:%s"
                              YYYY
                              (caseq (stringToSymbol MMM)
                                ((Jan) "01") ((Feb) "02") ((Mar) "03") ((Apr) "04")
                                ((May) "05") ((Jun) "06") ((Jul) "07") ((Aug) "08")
                                ((Sep) "09") ((Oct) "10") ((Nov) "11") ((Dec) "12"))
                              DD
                              hh
                              mm
                              ss))
                          (let ((el currentDrcResultsCount) (cl checkTextLineCount))
                            (setarray drcResult "checkTextLines"
                              (let ((checkTextLinesBuffer (tconc nil 'unbound)))
                                (while (and (plusp (postdecrement cl)) (stringp (gets line in)))
                                  (tconc checkTextLinesBuffer (substring line 1 (sub1 (strlen line)))))
                                (cdar checkTextLinesBuffer)))
                            (setarray drcResult "figs"
                              (let ((figsBuffer (tconc nil 'unbound)))
                                (while (and (plusp (postdecrement el)) (stringp (gets line in)))
                                  (tconc figsBuffer
                                    (apply
                                      (lambda (figType ordinals coordinateDataCount @rest _)
                                        (let ((fig (makeTable (gensym))))
                                          (setq ordinals (atoi ordinals))
                                          (setq coordinateDataCount (atoi coordinateDataCount))
                                          (setarray fig "figType" (stringToSymbol figType))
                                          (setarray fig "ordinals" ordinals)
                                          (setarray fig "properties"
                                            (let ((properties (tconc nil 'unbound)))
                                              (while (and (stringp (gets line in)) (rexMatchp "^[A-Za-z]" line))
                                                (tconc properties (substring line 1 (sub1 (strlen line)))))
                                              (cdar properties)))
                                          (setarray fig "coordinateDataCount" coordinateDataCount)
                                          (setarray fig "coordinateData"
                                            (case figType
                                              (("e")
                                                (let ((coordinateData (tconc nil 'unbound)) (pl coordinateDataCount))
                                                  (predecrement pl)
                                                  (apply
                                                    (lambda (x1 y1 x2 y2 @rest _)
                                                      (setq x1 (quotient (atof x1) convertDenominator))
                                                      (setq y1 (quotient (atof y1) convertDenominator))
                                                      (setq x2 (quotient (atof x2) convertDenominator))
                                                      (setq y2 (quotient (atof y2) convertDenominator))
                                                      (tconc coordinateData
                                                        (list (range x1 y1) (range x2 y2))))
                                                    (parseString line " \n"))
                                                  (while (and (plusp (postdecrement pl)) (stringp (gets line in)))
                                                    (apply
                                                      (lambda (x1 y1 x2 y2 @rest _)
                                                        (setq x1 (quotient (atof x1) convertDenominator))
                                                        (setq y1 (quotient (atof y1) convertDenominator))
                                                        (setq x2 (quotient (atof x2) convertDenominator))
                                                        (setq y2 (quotient (atof y2) convertDenominator))
                                                        (tconc coordinateData
                                                          (list (range x1 y1) (range x2 y2))))
                                                      (parseString line " \n")))
                                                  (cdar coordinateData)))
                                              (("p")
                                                (let ((coordinateData (tconc nil 'unbound)) (pl coordinateDataCount))
                                                  (predecrement pl)
                                                  (tconc coordinateData
                                                    (apply
                                                      (lambda (x y @rest _)
                                                        (setq x (quotient (atof x) convertDenominator))
                                                        (setq y (quotient (atof y) convertDenominator))
                                                        (range x y))
                                                      (parseString line " \n")))
                                                  (while (and (plusp (postdecrement pl)) (stringp (gets line in)))
                                                    (tconc coordinateData
                                                      (apply
                                                        (lambda (x y @rest _)
                                                          (setq x (quotient (atof x) convertDenominator))
                                                          (setq y (quotient (atof y) convertDenominator))
                                                          (range x y))
                                                        (parseString line " \n"))))
                                                  (cdar coordinateData)))))
                                          fig))
                                      (parseString line " \n"))))
                                (cdar figsBuffer)))))
                        (parseString line ": \n")))
                    (tconc drcResults drcResult)))
                (cdar drcResults))))
          (close in))))))
;
; ==============================================================================
; [EOF]