summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/source/latex/otibet/convnum.scm
blob: defb6542b0d797cba0f242cbfb36c4b0453822ea (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
;;
;; numconv.scm
;; (c) Norbert Preining 1997
;; This file is part of the otibet-package.
;;
;; Converting hex <-> dec <-> oct values
;; hex, oct are STRINGS!!!
;; dec is INTEGER
;;
;; Provides:
;;    (dec->hex INTEGER) -> STRING
;;    (dec->oct INTEGER) -> STRING
;;    (hex->dec STRING) -> INTEGER
;;    (oct->dec STRING) -> INTEGER
;;    (oct->hex STRING) -> STRING
;;    (hex->oct STRING) -> STRING
;;
;; Comment: Not very effective, just a quick hack.
;;
(define (number->hex-digit n)
  (if (and (integer? n) (> n -1) (< n 16))
      (if (< n 10)
	  (string (integer->char (+ n (char->integer #\0))))
	  (string (integer->char (+ n (char->integer #\A) -10))))
      (error 'number->hex-digit 
	     "Argument ~a not a integer or out of range!" n)))

(define (hex-digit->number h)
  (let ((n (- (char->integer (string-ref h 0)) 65)))
    (if (< n 0)
	(+ n 17)
	(+ n 10))))

(define (number->oct-digit n)
  (if (and (integer? n) (> n -1) (< n 8))
      (string (integer->char (+ n (char->integer #\0))))
      (error 'number->oct-digit 
	     "Argument ~a not a integer or out of range!" n)))

(define (oct-digit->number h)
  (- (char->integer (string-ref h 0)) (char->integer #\0)))

(define (dec->hex n)
  (if (= n 0)
      ""
      (letrec ((rem (modulo n 16))
	       (rval (/ (- n rem) 16)))
	(string-append (dec->hex rval) (number->hex-digit rem)))))

(define (hex-list->dec x)
  (if (= (length x) 0)
      0
      (+ (* 16 (hex-list->dec (cdr x))) 
	 (hex-digit->number (string (car x))))))

(define (hex->dec x)
  (hex-list->dec (reverse (string->list x))))

(define (dec->oct n)
  (if (= n 0)
      ""
      (letrec ((rem (modulo n 8))
	       (rval (/ (- n rem) 8)))
	(string-append (dec->oct rval) (number->oct-digit rem)))))

(define (oct-list->dec x)
  (if (= (length x) 0)
      0
      (+ (* 8 (oct-list->dec (cdr x))) 
	 (oct-digit->number (string (car x))))))

(define (oct->dec x)
  (oct-list->dec (reverse (string->list x))))

(define (hex->oct x)
  (dec->oct (hex->dec x)))

(define (oct->hex x)
  (dec->hex (oct->dec x)))