source: project/release/5/string-utils/trunk/string-hexadecimal.scm

Last change on this file was 35834, checked in by Kon Lovett, 17 months ago

i had a reason

File size: 2.6 KB
Line 
1;;;; string-hexadecimal.scm  -*- Scheme -*-
2;;;; Kon Lovett, Jul '18
3;;;; Kon Lovett, Aug '17
4;;;; Kon Lovett, Aug '10
5
6(declare
7  (bound-to-procedure
8    ##sys#signal-hook
9    ##sys#make-string))
10
11(module string-hexadecimal
12
13(;export
14  string->hex *string->hex
15  hex->string *hex->string)
16
17(import scheme
18  (chicken base)
19  (chicken fixnum)
20  (chicken type)
21  (chicken foreign)
22  (chicken memory representation)
23  to-hex
24  (only type-checks check-natural-fixnum check-string))
25
26;;;
27
28(define-inline (fxzero? x)
29  (fx= 0 x) )
30
31;;;
32
33(define (check-subvector-indexes loc start end)
34  (unless
35    (fx<=
36      (check-natural-fixnum loc start 'start)
37      (check-natural-fixnum loc end 'end))
38    (##sys#signal-hook #:bounds-error loc "illegal subvector specification" start end) ) )
39
40;;
41
42(: string->hex (string #!optional fixnum (or boolean fixnum) --> string))
43;
44(define (string->hex str #!optional (start 0) (end #f))
45  (check-string 'string->hex str)
46  (let ((end (or end (number-of-bytes str))))
47    (check-subvector-indexes 'string->hex start end)
48    (*string->hex str start end) ) )
49
50(: hex->string (string #!optional fixnum --> string))
51;
52(define (hex->string str #!optional (start 0) (end #f))
53  (let ((len (number-of-bytes (check-string 'hex->string str))))
54    (unless (fxzero? (fxmod len 2))
55      (error 'hex->string "too few characters" str) )
56    (let ((end (or end len)))
57      (check-subvector-indexes 'hex->string start end)
58      (*hex->string str start end) ) ) )
59
60;;
61
62(: *string->hex (string fixnum fixnum --> string))
63;
64(define (*string->hex str start end)
65  (let ((len (fx- end start)))
66    (if (fxzero? len)
67      ""
68      (str_to_hex (##sys#make-string (fx* len 2)) str start len) ) ) )
69
70(: *hex->string (string fixnum fixnum --> string))
71;
72(define (*hex->string str start end)
73  (let ((len (fx- end start)))
74    (if (fxzero? len)
75      ""
76      (hex_to_str (##sys#make-string (fx/ len 2)) str start len) ) ) )
77
78#|
79(use
80  (only (srfi 1) drop drop-right)
81  (only (srfi 13) string-pad string-concatenate  reverse-list->string))
82
83(define (*string->hex str start end)
84  (let* ((ls (string->list str) )
85         (ls (drop ls start) )
86         (strlen (string-length str) )
87         (ls (drop-right ls (fx- strlen end)) ) )
88    (string-concatenate
89      (map
90        (lambda (c)
91          (string-pad (number->string (char->integer c) 16) 2 #\0))
92      ls)) ) )
93
94(define (*hex->string str)
95  (let ((len (string-length str)))
96    (let loop ((i 0) (ls '()))
97      (if (fx<= len i)
98        (reverse-list->string ls)
99        (let ((ni (fx+ i 2) ))
100          (loop ni (cons (integer->char (string->number (substring str i ni) 16)) ls)) ) ) ) ) )
101|#
102
103) ;module string-hexadecimal
Note: See TracBrowser for help on using the repository browser.