#lang scheme
(require scribble/core
         scribble/decode)

(provide new-counter
         counter-target
         counter-ref
         counter-collect-value)

(define-struct counter ([n #:mutable] name target-wrap ref-wrap))

(define (new-counter name
                     #:target-wrap [target-wrap (lambda (c s) c)]
                     #:ref-wrap [ref-wrap (lambda (c s) c)])
  (make-counter 0 name target-wrap ref-wrap))

(define (counter-target counter tag label . content)
  (let ([content (decode-content content)])
    (define c
      (make-target-element
       #f
       (list
        (make-collect-element
         #f
         (list
          (make-delayed-element
           (lambda (renderer part ri)
             (let ([n (resolve-get part ri `(counter (,(counter-name counter) ,tag "value")))])
               (let ([l (cons (format "~a" n) content)])
                 (if label
                     (list* label 'nbsp l)
                     l))))
           (lambda () (if label
                          (list* label 'nbsp "N" content)
                          (cons "N" content)))
           (lambda () (if label
                          (list* label 'nbsp "N" content)
                          (cons "N" content)))))
         (lambda (ci)
           (let ([n (add1 (counter-n counter))])
             (set-counter-n! counter n)
             (collect-put! ci `(counter (,(counter-name counter) ,tag "value")) n)))))
       `(counter (,(counter-name counter) ,tag))))
    (if (counter-target-wrap counter)
        ((counter-target-wrap counter)
         c
         (format "t:~a" (t-encode (list 'counter (list (counter-name counter) tag)))))
        c)))

(define (t-encode s)
  (string-append*
   (map (lambda (c)
          (cond
            [(and (or (char-alphabetic? c) (char-numeric? c))
                  ((char->integer c) . < . 128))
             (string c)]
            [(char=? c #\space) "_"]
            [else (format "x~x" (char->integer c))]))
        (string->list (format "~s" s)))))

(define (counter-ref counter tag label)
  (let ([n (make-delayed-element
            (lambda (renderer part ri)
              (let ([n (resolve-get part ri `(counter (,(counter-name counter) ,tag "value")))])
                (if (counter-ref-wrap counter)
                    (let ([id (format "t:~a" (t-encode (list 'counter (list (counter-name counter) tag))))])
                      ((counter-ref-wrap counter)
                       (format "~a" n) 
                       id))
                    (list (format "~a" n)))))
            (lambda () (if label
                           (list label 'nbsp "N")
                           (list "N")))
            (lambda () (if label
                           (list label 'nbsp "N")
                           (list "N"))))])
    (make-link-element
     #f
     (if label
         (list
          label
          'nbsp
          n)
         n)
     `(counter (,(counter-name counter) ,tag)))))

(define (counter-collect-value counter)
  (counter-n counter))