#!/usr/bin/env scheme-script
#!r6rs

(import
  (rnrs)
  (fs fatfs)
  (fs fatfs port-device)
  (fs fatfs private compat))

(define (usage)
  (display "mformat -i IMAGE [-v LABEL] [-N SERIAL]\n")
  (display "\n")
  (display "-i <image>  FAT image file to format\n")
  (display "-v <label>  volume label (max 11 characters)\n")
  (display "-N <serial> volume serial number (decimal or 0xHEX)\n")
  (display "-h          print this help\n"))

(define (parse-serial s)
  (let* ((hex? (and (fx>=? (string-length s) 2)
                    (char=? (string-ref s 0) #\0)
                    (memv (string-ref s 1) '(#\x #\X))))
         (n (if hex?
                (string->number (substring s 2 (string-length s)) 16)
                (or (string->number s 10)
                    (string->number s 16)))))
    (unless (and n (integer? n) (<= 0 n #xffffffff))
      (error 'mformat "Invalid volume serial number" s))
    n))

(define img-path #f)
(define volume-label #f)
(define volume-id #f)

(let loop-args ((args (cdr (command-line))))
  (unless (null? args)
    (let ((arg (car args))
          (rest (cdr args)))
      (cond
        ((or (equal? arg "-h") (equal? arg "--help"))
         (usage)
         (exit 0))
        ((equal? arg "-i")
         (when (null? rest)
           (display "mformat: -i argument missing a value\n")
           (exit 1))
         (set! img-path (car rest))
         (loop-args (cdr rest)))
        ((equal? arg "-v")
         (when (null? rest)
           (display "mformat: -v argument missing a value\n")
           (exit 1))
         (set! volume-label (car rest))
         (loop-args (cdr rest)))
        ((equal? arg "-N")
         (when (null? rest)
           (display "mformat: -N argument missing a value\n")
           (exit 1))
         (set! volume-id (parse-serial (car rest)))
         (loop-args (cdr rest)))
        (else
         (display "mformat: unknown argument: ")
         (display arg)
         (newline)
         (usage)
         (exit 1))))))

(unless img-path
  (usage)
  (exit 1))

(unless (file-exists? img-path)
  (display "mformat: image file does not exist: ")
  (display img-path)
  (newline)
  (exit 1))

(define sector-size 512)
(define fat (make-fatfs (open-file-fatfs-device img-path sector-size)
                        '(fat16 fat32)
                        (fxdiv (file-size img-path) sector-size)))
(create-fatfs! fat volume-label volume-id)
(close-fatfs fat)
