;;; SPDX-License-Identifier: GPL-3.0-or-later
;;; SPDX-FileCopyrightText: Copyright © 2012-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>

#lang racket/base

;; Pretty hex dump output of a Bytes.

(provide dump-bytes!
	 dump-bytes->string
	 pretty-bytes)

(require (only-in bitsyntax bit-string->bytes))
(require (only-in file/sha1 bytes->hex-string))

(define (pretty-bytes bs)
  (bytes->hex-string (bit-string->bytes bs)))

;; Exact Exact -> String
;; Returns the "0"-padded, width-digit hex representation of n
(define (hex width n)
  (define s (number->string n 16))
  (define slen (string-length s))
  (cond
   ((< slen width) (string-append (make-string (- width slen) #\0) s))
   ((= slen width) s)
   ((> slen width) (substring s 0 width))))

;; Bytes Exact -> Void
;; Prints a pretty hex/ASCII dump of bs on (current-output-port).
(define (dump-bytes! bs0 [requested-count #f] #:base [baseaddr 0])
  (define bs (bit-string->bytes bs0))
  (define count (if requested-count (min requested-count (bytes-length bs)) (bytes-length bs)))
  (define clipped (subbytes bs 0 count))
  (define (dump-hex i)
    (if (< i count)
	(display (hex 2 (bytes-ref clipped i)))
	(display "  "))
    (display #\space))
  (define (dump-char i)
    (if (< i count)
	(let ((ch (bytes-ref clipped i)))
	  (if (<= 32 ch 127)
	      (display (integer->char ch))
	      (display #\.)))
	(display #\space)))
  (define (for-each-between f low high)
    (do ((i low (+ i 1)))
	((= i high))
      (f i)))
  (define (dump-line i)
    (display (hex 8 (+ i baseaddr)))
    (display #\space)
    (for-each-between dump-hex i (+ i 8))
    (display ": ")
    (for-each-between dump-hex (+ i 8) (+ i 16))
    (display #\space)
    (for-each-between dump-char i (+ i 8))
    (display " : ")
    (for-each-between dump-char (+ i 8) (+ i 16))
    (newline))
  (do ((i 0 (+ i 16)))
      ((>= i count))
    (dump-line i)))

(define (dump-bytes->string bs [requested-count #f] #:base [baseaddr 0])
  (define s (open-output-string))
  (parameterize ((current-output-port s))
    (dump-bytes! bs requested-count #:base baseaddr))
  (get-output-string s))