Fix bytevector->hex-string.
[guile-toxcore.git] / tox / util.scm
CommitLineData
da3f0655
DT
1;;; guile-toxcore
2;;; Copyright © 2014 David Thompson <davet@gnu.org>
3;;;
4;;; guile-toxcore is free software: you can redistribute it and/or modify it
5;;; under the terms of the GNU General Public License as published by the Free
6;;; Software Foundation, either version 3 of the License, or (at your option)
7;;; any later version.
8;;;
9;;; guile-toxcore is distributed in the hope that it will be useful, but
10;;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
11;;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
12;;; for more details.
13;;;
14;;; You should have received a copy of the GNU General Public License
15;;; along with this program. If not, see
16;;; <http://www.gnu.org/licenses/>.
17
18;;; Commentary:
19;;
20;; Utility procedures.
21;;
22;;; Code:
23
24(define-module (tox util)
14834866 25 #:use-module (ice-9 format)
55d7df48 26 #:use-module (rnrs bytevectors)
b4769a82 27 #:use-module (system foreign)
ac7c56dd
DT
28 #:export (boolean->number
29 one?
30 define-enumeration
0f217ea1 31 hex-string->bytevector bytevector->hex-string
b4769a82 32 utf8-pointer->string
e51538cd 33 bytevector-slice
80af0489 34 false-if-negative false-if-zero
8c7f7521 35 htons))
da3f0655
DT
36
37(define (boolean->number true?)
4ac21813 38 "Return 1 if TRUE? is #t, 0 otherwise."
da3f0655 39 (if true? 1 0))
40bfbc18
DT
40
41(define (one? n)
42 "Return #t if N is equal to 1, #f otherwise."
43 (= n 1))
c44605bc
DT
44
45;; Borrowed from guile-opengl
46(define-syntax-rule (define-enumeration enumerator (name value) ...)
47 (define-syntax enumerator
48 (lambda (x)
49 (syntax-case x ()
50 ((_)
51 #''(name ...))
52 ((_ enum) (number? (syntax->datum #'enum))
53 #'enum)
54 ((_ enum)
55 (or (assq-ref '((name . value) ...)
56 (syntax->datum #'enum))
57 (syntax-violation 'enumerator "invalid enumerated value"
58 #'enum)))))))
ac7c56dd
DT
59
60(define (hex-string->bytevector str)
bf649d86
DT
61 "Return a newly allocated bytevector containing the binary representation of
62the hexadecimal encoded string STR. The length of STR must be even."
ac7c56dd
DT
63 (define (read-byte start)
64 (string->number
65 (string-append "#x" (substring str start (+ start 2)))))
66
67 (let* ((size (/ (string-length str) 2))
68 (bv (make-bytevector size)))
69 (let loop ((i 0))
70 (when (< i size)
71 (bytevector-u8-set! bv i (read-byte (* i 2)))
72 (loop (1+ i))))
73 bv))
abe7dead 74
0f217ea1
DT
75(define (bytevector->hex-string bv)
76 "Return a newly allocated string containing the hexadecimal representation
77of the contents of the bytevector BV."
78 (string-upcase
79 (string-concatenate
80 (map (lambda (n)
047e4ccd 81 (format #f "~2,'0x" n))
0f217ea1
DT
82 (bytevector->u8-list bv)))))
83
b4769a82
DT
84(define (utf8-pointer->string pointer length)
85 "Return a newly allocated string containing the characters within the UTF-8
86encoded foreign POINTER of LENGTH bytes."
87 (utf8->string (pointer->bytevector pointer length)))
88
e51538cd
DT
89(define (bytevector-slice bv begin end)
90 "Return a newly allocated bytevector containing the contents of BV from the
91index BEGIN, inclusive, to the index END, exclusive."
92 (let ((ret (make-bytevector (- end begin))))
93 (let loop ((i begin))
94 (when (< i end)
95 (u8vector-set! ret (- i begin) (u8vector-ref bv i))
96 (loop (1+ i))))
97 ret))
98
abe7dead
DT
99(define (false-if-negative n)
100 "Return #f is N is negative, or N otherwise."
101 (if (negative? n) #f n))
8c7f7521 102
80af0489
DT
103(define (false-if-zero n)
104 "Return #f is N is zero, or N otherwise."
105 (if (zero? n) #f n))
106
8c7f7521
DT
107;; The htons available in Guile has been deprecated as of version 2.0.11.
108(define (htons n)
109 "Converts the unsigned short integer N from host byte order to network byte
110order. N is assumed to be a positive integer in the range [0, 65535]."
111 (logand (logior (ash n 8) (ash n -8)) #xffff))