;;;; string-hexadecimal.scm  -*- Scheme -*-
;;;; Kon Lovett, Jul '18
;;;; Kon Lovett, Aug '17
;;;; Kon Lovett, Aug '10

(declare
  (bound-to-procedure ##sys#signal-hook ##sys#make-string))

(module string-hexadecimal

(;export
  string->hex *string->hex
  hex->string *hex->string)

(import scheme)
(import (chicken base))
(import (chicken type))
(import (chicken foreign))
(import (only (chicken memory representation) number-of-bytes))
(import to-hex)
(import (only (check-errors sys) check-fixnum check-string
  check-exact-unsigned-integer))

(define-inline (check-natural-fixnum loc obj)
  (check-exact-unsigned-integer loc (check-fixnum loc obj)) )

(define-type start-index fixnum)
(define-type end-index fixnum)

(: string->hex (string #!optional start-index (or false end-index) -> string))
(: hex->string (string #!optional start-index (or false end-index) -> string))

(: *string->hex (string start-index end-index -> string))
(: *hex->string (string start-index end-index -> string))

;;

(define (check-subvector-indexes loc start end)
  ;NOTE use of `sys' checks introduces ambiguity
  (unless (<= (check-natural-fixnum loc start) (check-natural-fixnum loc end))
    (##sys#signal-hook #:bounds-error loc "illegal subvector specification" start end) ) )

;;

(define (string->hex str #!optional (start 0) (end #f))
  (let* ((len (number-of-bytes (check-string 'string->hex str)))
         (end (or end len)) )
    (check-subvector-indexes 'string->hex start len)
    (check-subvector-indexes 'string->hex start end)
    (check-subvector-indexes 'string->hex end len)
    (*string->hex str start end) ) )

(define (hex->string str #!optional (start 0) (end #f))
  (let* ((len (number-of-bytes (check-string 'hex->string str)))
         (end (or end len)) )
    (unless (and (even? start) (even? end))
      (error 'hex->string "too few characters" str start end) )
    (check-subvector-indexes 'hex->string start len)
    (check-subvector-indexes 'hex->string start end)
    (check-subvector-indexes 'hex->string end len)
    (*hex->string str start end) ) )

;;

(define (*string->hex str start end)
  (let ((len (- end start)))
    (if (zero? len) ""
        (str_to_hex (##sys#make-string (* len 2)) str start len) ) ) )

(define (*hex->string str start end)
  (let ((len (- end start)))
    (if (zero? len) ""
        (hex_to_str (##sys#make-string (quotient len 2)) str start len) ) ) )

#|
(import
  (only (srfi 1) drop drop-right)
  (only (srfi 13) string-pad string-concatenate  reverse-list->string))

(define (XXXXXXX ch)
  (string-pad (number->string (char->integer ch) 16) 2 #\0) )

(define (*string->hex str start end)
  (let* ((ls (string->list str))
         (ls (drop ls start))
         (strlen (string-length str))
         (ls (drop-right ls (- strlen end))) )
    (string-concatenate
      (map (lambda (c) (string-pad (number->string (char->integer c) 16) 2 #\0))
      ls)) ) )

(define (*hex->string str)
  (let ((len (string-length str)))
    (let loop ((i 0) (ls '()))
      (if (<= len i)
          (reverse-list->string ls)
          (let ((ni (+ i 2)))
            (loop ni (cons (integer->char (string->number (substring str i ni) 16)) ls)) ) ) ) ) )
|#

) ;module string-hexadecimal