Artifact 8d9b45751feee9c5fa053b870fceb5e9be56e8ab:
- File qrencode.sls — part of check-in [7182389a97] at 2018-12-09 17:58:12 on branch trunk — added library qrencode (user: aldo size: 1321)
0000: 0a 28 6c 69 62 72 61 72 79 20 28 71 72 65 6e 63 .(library (qrenc 0010: 6f 64 65 29 0a 20 20 28 65 78 70 6f 72 74 20 71 ode). (export q 0020: 72 2d 65 6e 63 6f 64 65 2d 73 74 72 69 6e 67 2d r-encode-string- 0030: 38 62 69 74 0a 09 20 20 71 72 2d 65 6e 63 6f 64 8bit.. qr-encod 0040: 65 2d 69 6e 69 74 0a 09 20 20 71 72 2d 65 6e 63 e-init.. qr-enc 0050: 6f 64 65 2d 6d 6f 64 65 0a 09 20 20 71 72 2d 65 ode-mode.. qr-e 0060: 63 2d 6c 65 76 65 6c 0a 09 20 20 71 72 63 6f 64 c-level.. qrcod 0070: 65 2d 77 69 64 74 68 0a 09 20 20 71 72 63 6f 64 e-width.. qrcod 0080: 65 2d 76 65 72 73 69 6f 6e 0a 09 20 20 71 72 63 e-version.. qrc 0090: 6f 64 65 2d 64 61 74 61 0a 09 20 20 71 72 63 6f ode-data.. qrco 00a0: 64 65 2d 64 61 74 61 2d 72 65 66 0a 09 20 20 51 de-data-ref.. Q 00b0: 52 63 6f 64 65 29 0a 20 20 28 69 6d 70 6f 72 74 Rcode). (import 00c0: 20 28 63 68 65 7a 73 63 68 65 6d 65 29 20 28 66 (chezscheme) (f 00d0: 66 69 2d 75 74 69 6c 73 29 29 0a 20 20 0a 20 20 fi-utils)). . 00e0: 28 64 65 66 69 6e 65 2d 65 6e 75 6d 65 72 61 74 (define-enumerat 00f0: 69 6f 6e 2a 20 71 72 2d 65 63 2d 6c 65 76 65 6c ion* qr-ec-level 0100: 20 28 4c 20 4d 20 51 20 48 29 29 0a 20 20 0a 20 (L M Q H)). . 0110: 20 28 64 65 66 69 6e 65 2d 66 6c 61 67 73 20 71 (define-flags q 0120: 72 2d 65 6e 63 6f 64 65 2d 6d 6f 64 65 0a 20 20 r-encode-mode. 0130: 20 20 28 6e 75 6c 20 2d 31 29 20 28 6e 75 6d 20 (nul -1) (num 0140: 30 29 20 28 61 6e 20 31 29 20 28 62 69 74 38 20 0) (an 1) (bit8 0150: 32 29 20 28 6b 61 6e 6a 69 20 33 29 20 28 73 74 2) (kanji 3) (st 0160: 72 75 63 74 75 72 65 20 34 29 20 28 65 63 69 20 ructure 4) (eci 0170: 35 29 20 28 66 6e 63 31 66 69 72 73 74 20 36 29 5) (fnc1first 6) 0180: 20 28 66 6e 63 31 73 65 63 6f 6e 64 20 37 29 29 (fnc1second 7)) 0190: 0a 20 20 20 20 0a 20 20 28 64 65 66 69 6e 65 2d . . (define- 01a0: 66 74 79 70 65 20 51 52 63 6f 64 65 20 28 73 74 ftype QRcode (st 01b0: 72 75 63 74 20 28 76 65 72 73 69 6f 6e 20 69 6e ruct (version in 01c0: 74 29 20 28 77 69 64 74 68 20 69 6e 74 29 20 28 t) (width int) ( 01d0: 64 61 74 61 20 28 2a 20 75 6e 73 69 67 6e 65 64 data (* unsigned 01e0: 2d 38 29 29 29 29 0a 0a 20 20 28 64 65 66 69 6e -8)))).. (defin 01f0: 65 20 28 71 72 2d 65 6e 63 6f 64 65 2d 69 6e 69 e (qr-encode-ini 0200: 74 29 0a 20 20 20 20 28 6c 6f 61 64 2d 73 68 61 t). (load-sha 0210: 72 65 64 2d 6f 62 6a 65 63 74 20 22 6c 69 62 71 red-object "libq 0220: 72 65 6e 63 6f 64 65 2e 73 6f 22 29 29 0a 0a 20 rencode.so")).. 0230: 20 28 64 65 66 69 6e 65 20 28 71 72 2d 65 6e 63 (define (qr-enc 0240: 6f 64 65 2d 73 74 72 69 6e 67 2d 38 62 69 74 20 ode-string-8bit 0250: 73 74 72 20 76 65 72 73 69 6f 6e 20 6c 65 76 65 str version leve 0260: 6c 29 0a 20 20 20 20 28 28 66 6f 72 65 69 67 6e l). ((foreign 0270: 2d 70 72 6f 63 65 64 75 72 65 20 22 51 52 63 6f -procedure "QRco 0280: 64 65 5f 65 6e 63 6f 64 65 53 74 72 69 6e 67 38 de_encodeString8 0290: 62 69 74 22 20 28 73 74 72 69 6e 67 20 69 6e 74 bit" (string int 02a0: 20 69 6e 74 29 20 28 2a 20 51 52 63 6f 64 65 29 int) (* QRcode) 02b0: 29 0a 20 20 20 20 20 73 74 72 20 76 65 72 73 69 ). str versi 02c0: 6f 6e 20 28 71 72 2d 65 63 2d 6c 65 76 65 6c 20 on (qr-ec-level 02d0: 6c 65 76 65 6c 29 29 29 0a 20 20 0a 20 20 28 64 level))). . (d 02e0: 65 66 69 6e 65 20 28 71 72 63 6f 64 65 2d 77 69 efine (qrcode-wi 02f0: 64 74 68 20 71 72 63 6f 64 65 29 0a 20 20 20 20 dth qrcode). 0300: 28 66 74 79 70 65 2d 72 65 66 20 51 52 63 6f 64 (ftype-ref QRcod 0310: 65 20 28 77 69 64 74 68 29 20 71 72 63 6f 64 65 e (width) qrcode 0320: 29 29 0a 0a 20 20 28 64 65 66 69 6e 65 20 28 71 )).. (define (q 0330: 72 63 6f 64 65 2d 76 65 72 73 69 6f 6e 20 71 72 rcode-version qr 0340: 63 6f 64 65 29 0a 20 20 20 20 28 66 74 79 70 65 code). (ftype 0350: 2d 72 65 66 20 51 52 63 6f 64 65 20 28 76 65 72 -ref QRcode (ver 0360: 73 69 6f 6e 29 20 71 72 63 6f 64 65 29 29 0a 0a sion) qrcode)).. 0370: 20 20 28 64 65 66 69 6e 65 20 28 71 72 63 6f 64 (define (qrcod 0380: 65 2d 64 61 74 61 20 71 72 63 6f 64 65 29 0a 20 e-data qrcode). 0390: 20 20 20 28 66 74 79 70 65 2d 72 65 66 20 51 52 (ftype-ref QR 03a0: 63 6f 64 65 20 28 64 61 74 61 29 20 71 72 63 6f code (data) qrco 03b0: 64 65 29 29 0a 0a 20 20 28 64 65 66 69 6e 65 20 de)).. (define 03c0: 28 71 72 63 6f 64 65 2d 64 61 74 61 2d 72 65 66 (qrcode-data-ref 03d0: 20 71 72 63 6f 64 65 20 69 6e 64 65 78 29 0a 20 qrcode index). 03e0: 20 20 20 28 66 74 79 70 65 2d 72 65 66 20 51 52 (ftype-ref QR 03f0: 63 6f 64 65 20 28 64 61 74 61 20 69 6e 64 65 78 code (data index 0400: 29 20 71 72 63 6f 64 65 29 29 29 0a 0a 0a 3b 20 ) qrcode)))...; 0410: 45 58 41 4d 50 4c 45 0a 23 3b 28 6c 65 74 2a 20 EXAMPLE.#;(let* 0420: 28 5b 78 20 28 71 72 2d 65 6e 63 6f 64 65 2d 73 ([x (qr-encode-s 0430: 74 72 69 6e 67 2d 38 62 69 74 20 22 43 68 65 7a tring-8bit "Chez 0440: 20 53 63 68 65 6d 65 22 20 31 20 27 51 29 5d 0a Scheme" 1 'Q)]. 0450: 20 20 20 20 20 20 20 5b 77 20 28 71 72 63 6f 64 [w (qrcod 0460: 65 2d 77 69 64 74 68 20 78 29 5d 29 0a 20 20 28 e-width x)]). ( 0470: 66 6f 72 2d 65 61 63 68 0a 20 20 20 28 6c 61 6d for-each. (lam 0480: 62 64 61 20 28 69 29 0a 20 20 20 20 20 28 77 68 bda (i). (wh 0490: 65 6e 20 28 3d 20 30 20 28 72 65 6d 61 69 6e 64 en (= 0 (remaind 04a0: 65 72 20 69 20 77 29 29 20 28 6e 65 77 6c 69 6e er i w)) (newlin 04b0: 65 29 29 0a 20 20 20 20 20 28 69 66 20 28 3d 20 e)). (if (= 04c0: 31 20 28 62 69 74 77 69 73 65 2d 61 6e 64 20 31 1 (bitwise-and 1 04d0: 20 28 71 72 63 6f 64 65 2d 64 61 74 61 2d 72 65 (qrcode-data-re 04e0: 66 20 78 20 69 29 29 29 0a 09 20 28 64 69 73 70 f x i))).. (disp 04f0: 6c 61 79 20 22 5c 78 32 35 38 38 3b 22 29 0a 09 lay "\x2588;").. 0500: 20 28 64 69 73 70 6c 61 79 20 22 20 22 29 29 29 (display " "))) 0510: 0a 20 20 20 28 69 6f 74 61 20 28 65 78 70 74 20 . (iota (expt 0520: 77 20 32 29 29 29 29 0a 0a w 2))))..