Coverage report: /home/ellis/.stash/quicklisp/dists/ultralisp/software/cl-babel-babel-20240610131823/src/enc-cp437.lisp

KindCoveredAll%
expression06 0.0
branch00nil
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
2
 ;;;
3
 ;;; enc-cp437.lisp --- Implementation of the IBM Code Page 437
4
 ;;;
5
 ;;; Copyright (C) 2020, Nicolas Hafner  <shinmera@tymoon.eu>
6
 ;;;
7
 ;;; Permission is hereby granted, free of charge, to any person
8
 ;;; obtaining a copy of this software and associated documentation
9
 ;;; files (the "Software"), to deal in the Software without
10
 ;;; restriction, including without limitation the rights to use, copy,
11
 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies
12
 ;;; of the Software, and to permit persons to whom the Software is
13
 ;;; furnished to do so, subject to the following conditions:
14
 ;;;
15
 ;;; The above copyright notice and this permission notice shall be
16
 ;;; included in all copies or substantial portions of the Software.
17
 ;;;
18
 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
19
 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
20
 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
21
 ;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
22
 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
23
 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
24
 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
25
 ;;; DEALINGS IN THE SOFTWARE.
26
 
27
 (in-package #:babel-encodings)
28
 
29
 (define-character-encoding :cp437
30
     "An 8-bit, fixed-width character encoding from IBM."
31
   :aliases '(:oem-us :oem-437 :pc-8 :dos-latin-us)
32
   :literal-char-code-limit #xFF)
33
 
34
 (define-constant +cp437-to-unicode+
35
     #(#x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007
36
       #x0008 #x0009 #x000a #x000b #x000c #x000d #x000e #x000f
37
       #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017
38
       #x0018 #x0019 #x001a #x001b #x001c #x001d #x001e #x001f
39
       #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027
40
       #x0028 #x0029 #x002a #x002b #x002c #x002d #x002e #x002f
41
       #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037
42
       #x0038 #x0039 #x003a #x003b #x003c #x003d #x003e #x003f
43
       #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047
44
       #x0048 #x0049 #x004a #x004b #x004c #x004d #x004e #x004f
45
       #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057
46
       #x0058 #x0059 #x005a #x005b #x005c #x005d #x005e #x005f
47
       #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067
48
       #x0068 #x0069 #x006a #x006b #x006c #x006d #x006e #x006f
49
       #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077
50
       #x0078 #x0079 #x007a #x007b #x007c #x007d #x007e #x007f
51
       #x00c7 #x00fc #x00e9 #x00e2 #x00e4 #x00e0 #x00e5 #x00e7
52
       #x00ea #x00eb #x00e8 #x00ef #x00ee #x00ec #x00c4 #x00c5
53
       #x00c9 #x00e6 #x00c6 #x00f4 #x00f6 #x00f2 #x00fb #x00f9
54
       #x00ff #x00d6 #x00dc #x00a2 #x00a3 #x00a5 #x20a7 #x0192
55
       #x00e1 #x00ed #x00f3 #x00fa #x00f1 #x00d1 #x00aa #x00ba
56
       #x00bf #x2310 #x00ac #x00bd #x00bc #x00a1 #x00ab #x00bb
57
       #x2591 #x2592 #x2593 #x2502 #x2524 #x2561 #x2562 #x2556
58
       #x2555 #x2563 #x2551 #x2557 #x255d #x255c #x255b #x2510
59
       #x2514 #x2534 #x252c #x251c #x2500 #x253c #x255e #x255f
60
       #x255a #x2554 #x2569 #x2566 #x2560 #x2550 #x256c #x2567
61
       #x2568 #x2564 #x2565 #x2559 #x2558 #x2552 #x2553 #x256b
62
       #x256a #x2518 #x250c #x2588 #x2584 #x258c #x2590 #x2580
63
       #x03b1 #x00df #x0393 #x03c0 #x03a3 #x03c3 #x00b5 #x03c4
64
       #x03a6 #x0398 #x03a9 #x03b4 #x221e #x03c6 #x03b5 #x2229
65
       #x2261 #x00b1 #x2265 #x2264 #x2320 #x2321 #x00f7 #x2248
66
       #x00b0 #x2219 #x00b7 #x221a #x207f #x00b2 #x25a0 #x00a0)
67
   :test #'equalp)
68
 
69
 (define-unibyte-decoder :cp437 (octet)
70
   (svref +cp437-to-unicode+ octet))
71
 
72
 (define-unibyte-encoder :cp437 (code)
73
   (if (<= code 127)
74
       code
75
       ;; Adjacent code point groups are too small and too many to be
76
       ;; worth tabulating this, so we just use a case.
77
       (case code
78
         (#xA0 #xFF)
79
         (#xA1 #xAD)
80
         (#xA2 #x9B)
81
         (#xA3 #x9C)
82
         (#xA5 #x9D)
83
         (#xAA #xA6)
84
         (#xAB #xAE)
85
         (#xAC #xAA)
86
         (#xB0 #xF8)
87
         (#xB1 #xF1)
88
         (#xB2 #xFD)
89
         (#xB5 #xE6)
90
         (#xB7 #xFA)
91
         (#xBA #xA7)
92
         (#xBB #xAF)
93
         (#xBC #xAC)
94
         (#xBD #xAB)
95
         (#xBF #xA8)
96
         (#xC4 #x8E)
97
         (#xC5 #x8F)
98
         (#xC6 #x92)
99
         (#xC7 #x80)
100
         (#xC9 #x90)
101
         (#xD1 #xA5)
102
         (#xD6 #x99)
103
         (#xDC #x9A)
104
         (#xDF #xE1)
105
         (#xE0 #x85)
106
         (#xE1 #xA0)
107
         (#xE2 #x83)
108
         (#xE4 #x84)
109
         (#xE5 #x86)
110
         (#xE6 #x91)
111
         (#xE7 #x87)
112
         (#xE8 #x8A)
113
         (#xE9 #x82)
114
         (#xEA #x88)
115
         (#xEB #x89)
116
         (#xEC #x8D)
117
         (#xED #xA1)
118
         (#xEE #x8C)
119
         (#xEF #x8B)
120
         (#xF1 #xA4)
121
         (#xF2 #x95)
122
         (#xF3 #xA2)
123
         (#xF4 #x93)
124
         (#xF6 #x94)
125
         (#xF7 #xF6)
126
         (#xF9 #x97)
127
         (#xFA #xA3)
128
         (#xFB #x96)
129
         (#xFC #x81)
130
         (#xFF #x98)
131
         (#x192 #x9F)
132
         (#x393 #xE2)
133
         (#x398 #xE9)
134
         (#x3A3 #xE4)
135
         (#x3A6 #xE8)
136
         (#x3A9 #xEA)
137
         (#x3B1 #xE0)
138
         (#x3B4 #xEB)
139
         (#x3B5 #xEE)
140
         (#x3C0 #xE3)
141
         (#x3C3 #xE5)
142
         (#x3C4 #xE7)
143
         (#x3C6 #xED)
144
         (#x207F #xFC)
145
         (#x20A7 #x9E)
146
         (#x2219 #xF9)
147
         (#x221A #xFB)
148
         (#x221E #xEC)
149
         (#x2229 #xEF)
150
         (#x2248 #xF7)
151
         (#x2261 #xF0)
152
         (#x2264 #xF3)
153
         (#x2265 #xF2)
154
         (#x2310 #xA9)
155
         (#x2320 #xF4)
156
         (#x2321 #xF5)
157
         (#x2500 #xC4)
158
         (#x2502 #xB3)
159
         (#x250C #xDA)
160
         (#x2510 #xBF)
161
         (#x2514 #xC0)
162
         (#x2518 #xD9)
163
         (#x251C #xC3)
164
         (#x2524 #xB4)
165
         (#x252C #xC2)
166
         (#x2534 #xC1)
167
         (#x253C #xC5)
168
         (#x2550 #xCD)
169
         (#x2551 #xBA)
170
         (#x2552 #xD5)
171
         (#x2553 #xD6)
172
         (#x2554 #xC9)
173
         (#x2555 #xB8)
174
         (#x2556 #xB7)
175
         (#x2557 #xBB)
176
         (#x2558 #xD4)
177
         (#x2559 #xD3)
178
         (#x255A #xC8)
179
         (#x255B #xBE)
180
         (#x255C #xBD)
181
         (#x255D #xBC)
182
         (#x255E #xC6)
183
         (#x255F #xC7)
184
         (#x2560 #xCC)
185
         (#x2561 #xB5)
186
         (#x2562 #xB6)
187
         (#x2563 #xB9)
188
         (#x2564 #xD1)
189
         (#x2565 #xD2)
190
         (#x2566 #xCB)
191
         (#x2567 #xCF)
192
         (#x2568 #xD0)
193
         (#x2569 #xCA)
194
         (#x256A #xD8)
195
         (#x256B #xD7)
196
         (#x256C #xCE)
197
         (#x2580 #xDF)
198
         (#x2584 #xDC)
199
         (#x2588 #xDB)
200
         (#x258C #xDD)
201
         (#x2590 #xDE)
202
         (#x2591 #xB0)
203
         (#x2592 #xB1)
204
         (#x2593 #xB2)
205
         (#x25A0 #xFE)
206
         (t (handle-error)))))