#lang racket/base
;; Copyright Neil Van Dyke.  See file "info.rkt".

(require (for-syntax racket/base)
         ;; (for-template scribble/base)
         scribble/base
         scribble/manual)

(define-for-syntax (%format-roomba-protos-stx protos-stx)
  (let ((protos (syntax->datum protos-stx)))
    (if (eq? 'all protos)
        #'(italic "all")
        #`(elem #,@(let loop ((this-proto (car protos))
                              (rest-protos (cdr protos)))
                     #`(#,(case this-proto
                            ((sci) #'(tech "SCI"))
                            ((roi) #'(tech "ROI"))
                            ((coi) #'(tech "COI"))
                            (else (error 'def-roomba-packet
                                         "invalid protocol ~S"
                                         this-proto)))
                        #,@(if (null? rest-protos)
                               #'()
                               #`(", " #,@(loop (car rest-protos)
                                                (cdr rest-protos))))))))))

(provide def-roomba-group-packets)
(define-syntax (def-roomba-group-packets stx)
  (syntax-case stx ()
    ((_ ROW0 ...)
     #`(nested #:style 'inset
               (tabular #:sep (hspace 2)
                        (list (list (bold "Packet Code")
                                    (bold "Contains Packets")
                                    (bold "Protocols"))
                              #,@(map (lambda (row-stx)
                                        (syntax-case row-stx ()
                                          ((CODE RANGE PROTOS)
                                           #`(list (bold (racket CODE))
                                                   RANGE
                                                   #,(%format-roomba-protos-stx #'PROTOS)))))
                                      (syntax->list #'(ROW0 ...)))))))))

(provide def-roomba-packet)
(define-syntax (def-roomba-packet stx)
  (syntax-case stx ()
    ((_ CODE PROTOS ((SYM TYPE) ...))
     #`(tabular #:style 'boxed
                #:sep   (hspace 2)
                (list (list (nonbreaking (elem "Packet Code: "
                                               (bold (racket CODE))
                                               (hspace 4)
                                               "Protocols: "
                                               #,(%format-roomba-protos-stx #'PROTOS)))

                            'cont)
                      (list (nonbreaking (racket SYM))
                            (racket TYPE))
                      ...)))))