Artifact
b7b8dd758e875e446d797b8430a998315f37ab2a:
- File
sdl2/parse-sdl-json.ss
— part of check-in
[242c211156]
at
2018-01-08 17:10:50
on branch trunk
— Initial SDL_Mixer support
(user:
ovenpasta@users.noreply.github.com
size: 7518)
0000: 3b 3b 0a 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 ;;.;; Copyright
0010: 32 30 31 36 20 41 6c 64 6f 20 4e 69 63 6f 6c 61 2016 Aldo Nicola
0020: 73 20 42 72 75 6e 6f 0a 3b 3b 0a 3b 3b 20 4c 69 s Bruno.;;.;; Li
0030: 63 65 6e 73 65 64 20 75 6e 64 65 72 20 74 68 65 censed under the
0040: 20 41 70 61 63 68 65 20 4c 69 63 65 6e 73 65 2c Apache License,
0050: 20 56 65 72 73 69 6f 6e 20 32 2e 30 20 28 74 68 Version 2.0 (th
0060: 65 20 22 4c 69 63 65 6e 73 65 22 29 3b 0a 3b 3b e "License");.;;
0070: 20 79 6f 75 20 6d 61 79 20 6e 6f 74 20 75 73 65 you may not use
0080: 20 74 68 69 73 20 66 69 6c 65 20 65 78 63 65 70 this file excep
0090: 74 20 69 6e 20 63 6f 6d 70 6c 69 61 6e 63 65 20 t in compliance
00a0: 77 69 74 68 20 74 68 65 20 4c 69 63 65 6e 73 65 with the License
00b0: 2e 0a 3b 3b 20 59 6f 75 20 6d 61 79 20 6f 62 74 ..;; You may obt
00c0: 61 69 6e 20 61 20 63 6f 70 79 20 6f 66 20 74 68 ain a copy of th
00d0: 65 20 4c 69 63 65 6e 73 65 20 61 74 0a 3b 3b 0a e License at.;;.
00e0: 3b 3b 20 20 20 20 20 68 74 74 70 3a 2f 2f 77 77 ;; http://ww
00f0: 77 2e 61 70 61 63 68 65 2e 6f 72 67 2f 6c 69 63 w.apache.org/lic
0100: 65 6e 73 65 73 2f 4c 49 43 45 4e 53 45 2d 32 2e enses/LICENSE-2.
0110: 30 0a 3b 3b 0a 3b 3b 20 55 6e 6c 65 73 73 20 72 0.;;.;; Unless r
0120: 65 71 75 69 72 65 64 20 62 79 20 61 70 70 6c 69 equired by appli
0130: 63 61 62 6c 65 20 6c 61 77 20 6f 72 20 61 67 72 cable law or agr
0140: 65 65 64 20 74 6f 20 69 6e 20 77 72 69 74 69 6e eed to in writin
0150: 67 2c 20 73 6f 66 74 77 61 72 65 0a 3b 3b 20 64 g, software.;; d
0160: 69 73 74 72 69 62 75 74 65 64 20 75 6e 64 65 72 istributed under
0170: 20 74 68 65 20 4c 69 63 65 6e 73 65 20 69 73 20 the License is
0180: 64 69 73 74 72 69 62 75 74 65 64 20 6f 6e 20 61 distributed on a
0190: 6e 20 22 41 53 20 49 53 22 20 42 41 53 49 53 2c n "AS IS" BASIS,
01a0: 0a 3b 3b 20 57 49 54 48 4f 55 54 20 57 41 52 52 .;; WITHOUT WARR
01b0: 41 4e 54 49 45 53 20 4f 52 20 43 4f 4e 44 49 54 ANTIES OR CONDIT
01c0: 49 4f 4e 53 20 4f 46 20 41 4e 59 20 4b 49 4e 44 IONS OF ANY KIND
01d0: 2c 20 65 69 74 68 65 72 20 65 78 70 72 65 73 73 , either express
01e0: 20 6f 72 20 69 6d 70 6c 69 65 64 2e 0a 3b 3b 20 or implied..;;
01f0: 53 65 65 20 74 68 65 20 4c 69 63 65 6e 73 65 20 See the License
0200: 66 6f 72 20 74 68 65 20 73 70 65 63 69 66 69 63 for the specific
0210: 20 6c 61 6e 67 75 61 67 65 20 67 6f 76 65 72 6e language govern
0220: 69 6e 67 20 70 65 72 6d 69 73 73 69 6f 6e 73 20 ing permissions
0230: 61 6e 64 0a 3b 3b 20 6c 69 6d 69 74 61 74 69 6f and.;; limitatio
0240: 6e 73 20 75 6e 64 65 72 20 74 68 65 20 4c 69 63 ns under the Lic
0250: 65 6e 73 65 2e 0a 28 6c 69 62 72 61 72 79 2d 64 ense..(library-d
0260: 69 72 65 63 74 6f 72 69 65 73 20 22 7e 2f 74 68 irectories "~/th
0270: 75 6e 64 65 72 63 68 65 7a 22 29 0a 28 69 6d 70 underchez").(imp
0280: 6f 72 74 20 28 73 63 68 65 6d 65 29 0a 09 28 6a ort (scheme)..(j
0290: 73 6f 6e 29 29 0a 0a 28 69 6d 70 6f 72 74 20 28 son))..(import (
02a0: 6f 6e 6c 79 20 28 74 68 75 6e 64 65 72 2d 75 74 only (thunder-ut
02b0: 69 6c 73 29 20 73 74 72 69 6e 67 2d 72 65 70 6c ils) string-repl
02c0: 61 63 65 20 73 74 72 69 6e 67 2d 73 70 6c 69 74 ace string-split
02d0: 29 20 0a 09 28 6f 6e 6c 79 20 28 73 72 66 69 20 ) ..(only (srfi
02e0: 73 31 33 20 73 74 72 69 6e 67 73 29 20 73 74 72 s13 strings) str
02f0: 69 6e 67 2d 64 72 6f 70 20 73 74 72 69 6e 67 2d ing-drop string-
0300: 64 6f 77 6e 63 61 73 65 20 73 74 72 69 6e 67 2d downcase string-
0310: 70 72 65 66 69 78 3f 20 73 74 72 69 6e 67 2d 73 prefix? string-s
0320: 75 66 66 69 78 3f 20 73 74 72 69 6e 67 2d 64 65 uffix? string-de
0330: 6c 65 74 65 29 0a 09 28 6f 6e 6c 79 20 28 73 72 lete)..(only (sr
0340: 66 69 20 73 31 20 6c 69 73 74 73 29 20 66 6f 6c fi s1 lists) fol
0350: 64 29 0a 09 28 73 72 66 69 20 73 31 34 20 63 68 d)..(srfi s14 ch
0360: 61 72 2d 73 65 74 73 29 29 0a 0a 28 64 65 66 69 ar-sets))..(defi
0370: 6e 65 20 28 61 6e 74 69 2d 63 61 6d 65 6c 20 78 ne (anti-camel x
0380: 29 0a 20 20 28 6c 65 74 2a 20 28 5b 78 20 28 73 ). (let* ([x (s
0390: 74 72 69 6e 67 2d 72 65 70 6c 61 63 65 20 78 20 tring-replace x
03a0: 23 5c 5f 20 23 5c 2d 29 5d 0a 09 20 5b 6c 65 6e #\_ #\-)].. [len
03b0: 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 (string-length
03c0: 78 29 5d 0a 09 20 5b 66 20 28 6c 61 6d 62 64 61 x)].. [f (lambda
03d0: 20 28 73 20 6c 65 6e 29 0a 09 20 20 20 20 20 20 (s len)..
03e0: 28 6c 69 73 74 2d 3e 73 74 72 69 6e 67 0a 09 20 (list->string..
03f0: 20 20 20 20 20 20 28 72 65 76 65 72 73 65 0a 09 (reverse..
0400: 09 28 66 6f 6c 64 20 28 6c 61 6d 62 64 61 20 28 .(fold (lambda (
0410: 69 20 61 63 63 29 20 0a 09 09 09 28 6c 65 74 20 i acc) ....(let
0420: 28 5b 61 20 28 73 74 72 69 6e 67 2d 72 65 66 20 ([a (string-ref
0430: 73 20 69 29 5d 20 0a 09 09 09 20 20 20 20 20 20 s i)] ....
0440: 5b 6e 65 78 74 20 28 69 66 20 28 3c 20 28 2b 20 [next (if (< (+
0450: 31 20 69 29 20 6c 65 6e 29 20 28 73 74 72 69 6e 1 i) len) (strin
0460: 67 2d 72 65 66 20 73 20 28 2b 20 31 20 69 29 29 g-ref s (+ 1 i))
0470: 20 23 66 29 5d 0a 09 09 09 20 20 20 20 20 20 5b #f)].... [
0480: 70 72 65 76 20 28 69 66 20 28 3e 20 69 20 30 29 prev (if (> i 0)
0490: 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 20 28 (string-ref s (
04a0: 2d 20 69 20 31 29 29 20 23 66 29 5d 29 0a 09 09 - i 1)) #f)])...
04b0: 09 20 20 28 69 66 20 28 61 6e 64 20 28 63 68 61 . (if (and (cha
04c0: 72 2d 75 70 70 65 72 2d 63 61 73 65 3f 20 61 29 r-upper-case? a)
04d0: 20 20 6e 65 78 74 20 70 72 65 76 0a 09 09 09 09 next prev.....
04e0: 20 20 20 28 6e 6f 74 20 0a 09 09 09 09 20 20 20 (not .....
04f0: 20 28 6f 72 20 28 63 68 61 72 3d 3f 20 61 20 23 (or (char=? a #
0500: 5c 2d 29 20 28 63 68 61 72 3d 3f 20 70 72 65 76 \-) (char=? prev
0510: 20 23 5c 2d 29 20 28 63 68 61 72 3d 3f 20 6e 65 #\-) (char=? ne
0520: 78 74 20 23 5c 2d 29 0a 09 09 09 09 09 28 61 6e xt #\-)......(an
0530: 64 20 28 63 68 61 72 2d 75 70 70 65 72 2d 63 61 d (char-upper-ca
0540: 73 65 3f 20 6e 65 78 74 29 20 28 63 68 61 72 2d se? next) (char-
0550: 75 70 70 65 72 2d 63 61 73 65 3f 20 70 72 65 76 upper-case? prev
0560: 29 29 29 29 29 0a 09 09 09 20 20 20 20 20 20 28 ))))).... (
0570: 63 6f 6e 73 20 28 63 68 61 72 2d 64 6f 77 6e 63 cons (char-downc
0580: 61 73 65 20 61 29 20 28 63 6f 6e 73 20 23 5c 2d ase a) (cons #\-
0590: 20 61 63 63 29 29 0a 09 09 09 20 20 20 20 20 20 acc))....
05a0: 28 63 6f 6e 73 20 28 63 68 61 72 2d 64 6f 77 6e (cons (char-down
05b0: 63 61 73 65 20 61 29 20 61 63 63 29 29 29 29 20 case a) acc))))
05c0: 27 28 29 20 28 69 6f 74 61 20 6c 65 6e 29 29 29 '() (iota len)))
05d0: 29 29 5d 29 0a 20 20 20 20 28 64 65 66 69 6e 65 ))]). (define
05e0: 20 74 62 6c 20 27 28 28 22 53 44 4c 2d 52 57 6f tbl '(("SDL-RWo
05f0: 70 73 22 20 22 73 64 6c 2d 72 77 2d 6f 70 73 22 ps" "sdl-rw-ops"
0600: 29 0a 09 09 20 20 28 22 55 44 50 70 61 63 6b 65 )... ("UDPpacke
0610: 74 22 20 22 75 64 70 2d 70 61 63 6b 65 74 22 29 t" "udp-packet")
0620: 20 28 22 54 43 50 73 6f 63 6b 65 74 22 20 22 74 ("TCPsocket" "t
0630: 63 70 2d 73 6f 63 6b 65 74 22 29 0a 09 09 20 20 cp-socket")...
0640: 28 22 49 50 61 64 64 72 65 73 73 22 20 22 69 70 ("IPaddress" "ip
0650: 2d 61 64 64 72 65 73 73 22 29 20 28 22 55 44 50 -address") ("UDP
0660: 73 6f 63 6b 65 74 22 20 22 75 64 70 2d 73 6f 63 socket" "udp-soc
0670: 6b 65 74 22 29 29 29 0a 20 20 20 20 28 63 6f 6e ket"))). (con
0680: 64 0a 20 20 20 20 20 5b 28 73 74 72 69 6e 67 2d d. [(string-
0690: 70 72 65 66 69 78 3f 20 22 53 44 4c 2d 47 4c 2d prefix? "SDL-GL-
06a0: 22 20 78 29 0a 20 20 20 20 20 20 28 73 74 72 69 " x). (stri
06b0: 6e 67 2d 61 70 70 65 6e 64 20 22 73 64 6c 2d 67 ng-append "sdl-g
06c0: 6c 2d 22 20 28 66 20 28 73 74 72 69 6e 67 2d 64 l-" (f (string-d
06d0: 72 6f 70 20 78 20 37 29 20 28 2d 20 6c 65 6e 20 rop x 7) (- len
06e0: 37 29 29 29 5d 0a 20 20 20 20 20 5b 28 73 74 72 7)))]. [(str
06f0: 69 6e 67 2d 70 72 65 66 69 78 3f 20 22 53 44 4c ing-prefix? "SDL
0700: 2d 47 4c 22 20 78 29 0a 20 20 20 20 20 20 28 73 -GL" x). (s
0710: 74 72 69 6e 67 2d 61 70 70 65 6e 64 20 22 73 64 tring-append "sd
0720: 6c 2d 67 6c 2d 22 20 28 66 20 28 73 74 72 69 6e l-gl-" (f (strin
0730: 67 2d 64 72 6f 70 20 78 20 36 29 20 28 2d 20 6c g-drop x 6) (- l
0740: 65 6e 20 36 29 29 29 5d 0a 20 20 20 20 20 5b 28 en 6)))]. [(
0750: 61 73 73 6f 63 20 78 20 74 62 6c 29 20 3d 3e 20 assoc x tbl) =>
0760: 28 6c 61 6d 62 64 61 20 28 79 29 20 28 63 61 64 (lambda (y) (cad
0770: 72 20 79 29 29 5d 0a 20 20 20 20 20 5b 65 6c 73 r y))]. [els
0780: 65 20 28 66 20 78 20 6c 65 6e 29 5d 29 29 29 0a e (f x len)]))).
0790: 0a 28 64 65 66 69 6e 65 20 28 61 64 64 2d 74 20 .(define (add-t
07a0: 78 29 0a 20 20 28 6c 65 74 20 28 5b 78 64 20 28 x). (let ([xd (
07b0: 73 74 72 69 6e 67 2d 64 6f 77 6e 63 61 73 65 20 string-downcase
07c0: 78 29 5d 29 0a 20 20 20 20 28 69 66 20 28 61 6e x)]). (if (an
07d0: 64 20 28 73 74 72 69 6e 67 2d 70 72 65 66 69 78 d (string-prefix
07e0: 3f 20 22 73 64 6c 2d 22 20 78 64 29 20 0a 09 20 ? "sdl-" xd) ..
07f0: 20 20 20 20 28 6e 6f 74 20 20 28 6f 72 20 28 73 (not (or (s
0800: 74 72 69 6e 67 2d 73 75 66 66 69 78 3f 20 22 2a tring-suffix? "*
0810: 22 20 78 29 20 28 73 74 72 69 6e 67 2d 73 75 66 " x) (string-suf
0820: 66 69 78 3f 20 22 2d 74 22 20 78 29 29 29 29 0a fix? "-t" x)))).
0830: 09 28 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 20 .(string-append
0840: 78 20 22 2d 74 22 29 0a 09 78 29 29 29 0a 0a 28 x "-t")..x)))..(
0850: 64 65 66 69 6e 65 20 28 61 64 64 2d 2a 20 78 29 define (add-* x)
0860: 0a 20 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e . (string-appen
0870: 64 20 78 20 22 2a 22 29 29 0a 20 0a 28 64 65 66 d x "*")). .(def
0880: 69 6e 65 20 28 64 65 63 6f 64 65 2d 74 79 70 65 ine (decode-type
0890: 20 74 29 0a 20 20 28 69 66 20 74 0a 20 20 20 20 t). (if t.
08a0: 20 20 28 6c 65 74 2d 6a 73 6f 6e 2d 6f 62 6a 65 (let-json-obje
08b0: 63 74 20 74 20 28 74 61 67 20 74 79 70 65 29 0a ct t (tag type).
08c0: 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 5b .. (let ([
08d0: 74 61 67 2a 20 28 69 66 20 28 73 74 72 69 6e 67 tag* (if (string
08e0: 3f 20 74 61 67 29 20 28 73 74 72 69 6e 67 2d 3e ? tag) (string->
08f0: 73 79 6d 62 6f 6c 20 74 61 67 29 20 74 61 67 29 symbol tag) tag)
0900: 5d 29 0a 09 09 09 20 28 63 61 73 65 20 74 61 67 ]).... (case tag
0910: 2a 0a 09 09 09 20 20 20 5b 3a 66 75 6e 63 74 69 *.... [:functi
0920: 6f 6e 2d 70 6f 69 6e 74 65 72 20 27 76 6f 69 64 on-pointer 'void
0930: 2a 5d 0a 09 09 09 20 20 20 5b 3a 69 6e 74 20 27 *].... [:int '
0940: 69 6e 74 5d 0a 09 09 09 20 20 20 5b 3a 75 6e 73 int].... [:uns
0950: 69 67 6e 65 64 2d 69 6e 74 20 27 75 6e 73 69 67 igned-int 'unsig
0960: 6e 65 64 2d 69 6e 74 5d 0a 09 09 09 20 20 20 5b ned-int].... [
0970: 3a 75 6e 73 69 67 6e 65 64 2d 6c 6f 6e 67 2d 6c :unsigned-long-l
0980: 6f 6e 67 20 27 75 6e 73 69 67 6e 65 64 2d 6c 6f ong 'unsigned-lo
0990: 6e 67 2d 6c 6f 6e 67 5d 0a 09 09 09 20 20 20 5b ng-long].... [
09a0: 3a 75 6e 73 69 67 6e 65 64 2d 6c 6f 6e 67 20 27 :unsigned-long '
09b0: 75 6e 73 69 67 6e 65 64 2d 6c 6f 6e 67 5d 0a 09 unsigned-long]..
09c0: 09 09 20 20 20 5b 3a 6c 6f 6e 67 20 27 6c 6f 6e .. [:long 'lon
09d0: 67 5d 0a 09 09 09 20 20 20 5b 3a 64 6f 75 62 6c g].... [:doubl
09e0: 65 20 27 64 6f 75 62 6c 65 5d 0a 09 09 09 20 20 e 'double]....
09f0: 20 5b 3a 6c 6f 6e 67 2d 64 6f 75 62 6c 65 20 27 [:long-double '
0a00: 6c 6f 6e 67 2d 64 6f 75 62 6c 65 5d 0a 09 09 09 long-double]....
0a10: 20 20 20 5b 3a 66 6c 6f 61 74 20 27 66 6c 6f 61 [:float 'floa
0a20: 74 5d 0a 09 09 09 20 20 20 5b 3a 70 6f 69 6e 74 t].... [:point
0a30: 65 72 20 28 6c 65 74 20 28 5b 70 74 20 28 64 65 er (let ([pt (de
0a40: 63 6f 64 65 2d 74 79 70 65 20 74 79 70 65 29 5d code-type type)]
0a50: 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 63 61 )..... (ca
0a60: 73 65 20 70 74 0a 09 09 09 09 09 20 28 63 68 61 se pt...... (cha
0a70: 72 20 27 73 74 72 69 6e 67 29 0a 09 09 09 09 09 r 'string)......
0a80: 20 28 73 74 72 69 6e 67 20 27 76 6f 69 64 2a 29 (string 'void*)
0a90: 0a 09 09 09 09 09 20 28 76 6f 69 64 20 27 76 6f ...... (void 'vo
0aa0: 69 64 2a 29 0a 09 09 09 09 09 20 28 65 6c 73 65 id*)...... (else
0ab0: 0a 09 09 09 09 09 20 20 28 69 66 20 28 61 6e 64 ...... (if (and
0ac0: 20 28 70 61 69 72 3f 20 70 74 20 29 20 28 65 71 (pair? pt ) (eq
0ad0: 3f 20 28 63 61 72 20 70 74 29 20 27 2a 29 29 0a ? (car pt) '*)).
0ae0: 09 09 09 09 09 20 20 20 20 20 20 70 74 20 3b 3b ..... pt ;;
0af0: 20 44 4f 55 42 4c 45 20 53 54 41 52 20 53 45 45 DOUBLE STAR SEE
0b00: 4d 53 20 4e 4f 54 20 53 55 50 50 4f 52 54 45 44 MS NOT SUPPORTED
0b10: 20 4f 4e 20 43 48 45 5a 0a 09 09 09 09 09 20 20 ON CHEZ......
0b20: 20 20 20 20 60 28 2a 20 2c 70 74 29 29 0a 09 09 `(* ,pt))...
0b30: 09 09 09 20 20 23 3b 28 73 74 72 69 6e 67 2d 3e ... #;(string->
0b40: 73 79 6d 62 6f 6c 20 0a 09 09 09 09 09 20 20 20 symbol ......
0b50: 28 61 64 64 2d 2a 0a 09 09 09 09 09 20 20 20 20 (add-*......
0b60: 28 73 79 6d 62 6f 6c 2d 3e 73 74 72 69 6e 67 20 (symbol->string
0b70: 70 74 29 29 29 29 29 29 5d 0a 09 09 09 20 20 20 pt))))))]....
0b80: 5b 3a 76 6f 69 64 20 27 76 6f 69 64 5d 0a 09 09 [:void 'void]...
0b90: 09 20 20 20 5b 3a 63 68 61 72 20 27 63 68 61 72 . [:char 'char
0ba0: 5d 0a 09 09 09 20 20 20 5b 65 6c 73 65 20 28 69 ].... [else (i
0bb0: 66 20 28 73 79 6d 62 6f 6c 3f 20 74 61 67 2a 29 f (symbol? tag*)
0bc0: 0a 09 09 09 09 20 20 20 20 20 28 73 74 72 69 6e ..... (strin
0bd0: 67 2d 3e 73 79 6d 62 6f 6c 20 0a 09 09 09 09 20 g->symbol .....
0be0: 20 20 20 20 20 28 61 64 64 2d 74 0a 09 09 09 09 (add-t.....
0bf0: 20 20 20 20 20 20 20 28 61 6e 74 69 2d 63 61 6d (anti-cam
0c00: 65 6c 20 0a 09 09 09 09 09 28 73 79 6d 62 6f 6c el ......(symbol
0c10: 2d 3e 73 74 72 69 6e 67 20 74 61 67 2a 29 29 29 ->string tag*)))
0c20: 29 0a 09 09 09 09 20 20 20 20 20 74 61 67 2a 29 )..... tag*)
0c30: 5d 29 29 29 0a 20 20 20 20 20 20 23 66 29 29 0a ]))). #f)).
0c40: 28 64 65 66 69 6e 65 20 28 64 65 63 6f 64 65 2d (define (decode-
0c50: 70 61 72 61 6d 20 70 20 6e 29 0a 20 20 28 6c 65 param p n). (le
0c60: 74 2d 6a 73 6f 6e 2d 6f 62 6a 65 63 74 20 70 20 t-json-object p
0c70: 28 74 61 67 20 6e 61 6d 65 20 74 79 70 65 29 0a (tag name type).
0c80: 09 09 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f .. (if (equal?
0c90: 20 6e 61 6d 65 20 22 22 29 20 0a 09 09 20 20 20 name "") ...
0ca0: 20 20 20 20 28 6c 69 73 74 20 28 73 74 72 69 6e (list (strin
0cb0: 67 2d 61 70 70 65 6e 64 20 22 61 72 67 2d 22 20 g-append "arg-"
0cc0: 28 6e 75 6d 62 65 72 2d 3e 73 74 72 69 6e 67 20 (number->string
0cd0: 6e 29 29 20 28 64 65 63 6f 64 65 2d 74 79 70 65 n)) (decode-type
0ce0: 20 74 79 70 65 29 29 0a 09 09 20 20 20 20 20 20 type))...
0cf0: 20 28 6c 69 73 74 20 6e 61 6d 65 20 28 64 65 63 (list name (dec
0d00: 6f 64 65 2d 74 79 70 65 20 74 79 70 65 29 29 29 ode-type type)))
0d10: 29 29 0a 0a 28 64 65 66 69 6e 65 20 62 6c 61 63 ))..(define blac
0d20: 6b 6c 69 73 74 20 27 28 73 64 6c 2d 6a 6f 79 73 klist '(sdl-joys
0d30: 74 69 63 6b 2d 69 6e 73 74 61 6e 63 65 2d 69 64 tick-instance-id
0d40: 20 0a 09 09 20 20 20 20 73 64 6c 2d 6a 6f 79 73 ... sdl-joys
0d50: 74 69 63 6b 2d 67 65 74 2d 64 65 76 69 63 65 2d tick-get-device-
0d60: 67 75 69 64 0a 09 09 20 20 20 20 73 64 6c 2d 6a guid... sdl-j
0d70: 6f 79 73 74 69 63 6b 2d 67 65 74 2d 67 75 69 64 oystick-get-guid
0d80: 20 0a 09 09 20 20 20 20 73 64 6c 2d 6a 6f 79 73 ... sdl-joys
0d90: 74 69 63 6b 2d 67 65 74 2d 67 75 69 64 2d 73 74 tick-get-guid-st
0da0: 72 69 6e 67 20 0a 09 09 20 20 20 20 73 64 6c 2d ring ... sdl-
0db0: 6a 6f 79 73 74 69 63 6b 2d 67 65 74 2d 67 75 69 joystick-get-gui
0dc0: 64 2d 66 72 6f 6d 2d 73 74 72 69 6e 67 0a 09 09 d-from-string...
0dd0: 20 20 20 20 73 64 6c 2d 67 61 6d 65 2d 63 6f 6e sdl-game-con
0de0: 74 72 6f 6c 6c 65 72 2d 6d 61 70 70 69 6e 67 2d troller-mapping-
0df0: 66 6f 72 2d 67 75 69 64 29 29 0a 0a 28 69 6d 70 for-guid))..(imp
0e00: 6f 72 74 20 28 6f 6e 6c 79 20 28 73 72 66 69 20 ort (only (srfi
0e10: 73 31 33 20 73 74 72 69 6e 67 73 29 20 73 74 72 s13 strings) str
0e20: 69 6e 67 2d 63 6f 6e 74 61 69 6e 73 29 29 0a 28 ing-contains)).(
0e30: 64 65 66 69 6e 65 20 28 70 61 72 73 65 2d 6a 73 define (parse-js
0e40: 6f 6e 2d 66 75 6e 63 74 69 6f 6e 20 78 20 6d 29 on-function x m)
0e50: 0a 20 20 28 6c 65 74 2d 6a 73 6f 6e 2d 6f 62 6a . (let-json-obj
0e60: 65 63 74 20 78 20 28 74 61 67 20 6e 61 6d 65 20 ect x (tag name
0e70: 6c 6f 63 61 74 69 6f 6e 20 72 65 74 75 72 6e 2d location return-
0e80: 74 79 70 65 20 70 61 72 61 6d 65 74 65 72 73 29 type parameters)
0e90: 20 0a 09 09 20 20 20 28 69 66 20 28 61 6e 64 20 ... (if (and
0ea0: 28 6f 72 20 28 73 74 72 69 6e 67 2d 63 6f 6e 74 (or (string-cont
0eb0: 61 69 6e 73 20 6c 6f 63 61 74 69 6f 6e 20 6d 29 ains location m)
0ec0: 20 0a 09 09 09 09 28 61 6e 64 20 28 65 71 75 61 .....(and (equa
0ed0: 6c 3f 20 22 73 64 6c 22 20 6d 29 20 28 73 74 72 l? "sdl" m) (str
0ee0: 69 6e 67 2d 63 6f 6e 74 61 69 6e 73 20 6c 6f 63 ing-contains loc
0ef0: 61 74 69 6f 6e 20 22 53 44 4c 2e 68 22 29 29 29 ation "SDL.h")))
0f00: 0a 09 09 09 20 20 20 20 28 65 71 75 61 6c 3f 20 .... (equal?
0f10: 74 61 67 20 22 66 75 6e 63 74 69 6f 6e 22 29 0a tag "function").
0f20: 09 09 09 20 20 20 20 28 6f 72 20 28 73 74 72 69 ... (or (stri
0f30: 6e 67 2d 70 72 65 66 69 78 3f 20 22 53 44 4c 5f ng-prefix? "SDL_
0f40: 22 20 6e 61 6d 65 29 0a 09 09 09 09 28 73 74 72 " name).....(str
0f50: 69 6e 67 2d 70 72 65 66 69 78 3f 20 22 53 44 4c ing-prefix? "SDL
0f60: 4e 65 74 5f 22 20 6e 61 6d 65 29 0a 09 09 09 09 Net_" name).....
0f70: 28 73 74 72 69 6e 67 2d 70 72 65 66 69 78 3f 20 (string-prefix?
0f80: 22 49 4d 47 5f 22 20 6e 61 6d 65 29 0a 09 09 09 "IMG_" name)....
0f90: 09 28 73 74 72 69 6e 67 2d 70 72 65 66 69 78 3f .(string-prefix?
0fa0: 20 22 53 54 54 46 5f 22 20 6e 61 6d 65 29 0a 09 "STTF_" name)..
0fb0: 09 09 09 28 73 74 72 69 6e 67 2d 70 72 65 66 69 ...(string-prefi
0fc0: 78 3f 20 22 54 54 46 5f 22 20 6e 61 6d 65 29 29 x? "TTF_" name))
0fd0: 29 0a 09 09 20 20 20 20 20 20 20 28 63 6f 6e 64 )... (cond
0fe0: 0a 09 09 09 5b 28 6d 65 6d 71 20 28 73 74 72 69 ....[(memq (stri
0ff0: 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 61 6e 74 69 ng->symbol (anti
1000: 2d 63 61 6d 65 6c 20 6e 61 6d 65 29 29 20 62 6c -camel name)) bl
1010: 61 63 6b 6c 69 73 74 29 0a 09 09 09 20 28 70 72 acklist).... (pr
1020: 69 6e 74 66 20 22 3b 3b 62 6c 61 63 6b 6c 69 73 intf ";;blacklis
1030: 74 65 64 20 70 72 6f 62 61 62 6c 79 20 62 65 63 ted probably bec
1040: 61 75 73 65 20 69 74 20 75 73 65 73 20 61 20 73 ause it uses a s
1050: 74 72 75 63 74 20 61 73 20 76 61 6c 75 65 2e 5c truct as value.\
1060: 6e 28 64 65 66 69 6e 65 20 7e 64 20 23 66 29 5c n(define ~d #f)\
1070: 6e 22 20 28 61 6e 74 69 2d 63 61 6d 65 6c 20 6e n" (anti-camel n
1080: 61 6d 65 29 29 5d 0a 09 09 09 5b 65 6c 73 65 0a ame))]....[else.
1090: 09 09 09 20 20 20 28 70 72 69 6e 74 66 20 22 28 ... (printf "(
10a0: 64 65 66 69 6e 65 2d 73 64 6c 2d 66 75 6e 63 20 define-sdl-func
10b0: 7e 64 20 7e 64 20 7e 64 20 5c 22 7e 64 5c 22 29 ~d ~d ~d \"~d\")
10c0: 5c 6e 22 0a 09 09 09 09 20 20 20 28 64 65 63 6f \n"..... (deco
10d0: 64 65 2d 74 79 70 65 20 72 65 74 75 72 6e 2d 74 de-type return-t
10e0: 79 70 65 29 20 0a 09 09 09 09 20 20 20 28 63 61 ype) ..... (ca
10f0: 73 65 20 6e 61 6d 65 0a 09 09 09 09 20 20 20 20 se name.....
1100: 20 28 22 53 44 4c 5f 6c 6f 67 22 20 22 73 64 6c ("SDL_log" "sdl
1110: 2d 6c 6f 67 6e 22 29 0a 09 09 09 09 20 20 20 20 -logn").....
1120: 20 28 65 6c 73 65 20 28 61 6e 74 69 2d 63 61 6d (else (anti-cam
1130: 65 6c 20 6e 61 6d 65 29 29 29 0a 09 09 09 09 20 el name))).....
1140: 20 20 0a 09 09 09 09 20 20 20 28 6d 61 70 20 28 ..... (map (
1150: 6c 61 6d 62 64 61 20 28 70 20 6e 29 20 28 64 65 lambda (p n) (de
1160: 63 6f 64 65 2d 70 61 72 61 6d 20 70 20 6e 29 29 code-param p n))
1170: 20 0a 09 09 09 09 09 28 76 65 63 74 6f 72 2d 3e ......(vector->
1180: 6c 69 73 74 20 70 61 72 61 6d 65 74 65 72 73 29 list parameters)
1190: 20 0a 09 09 09 09 09 28 69 6f 74 61 20 28 76 65 ......(iota (ve
11a0: 63 74 6f 72 2d 6c 65 6e 67 74 68 20 70 61 72 61 ctor-length para
11b0: 6d 65 74 65 72 73 29 29 29 0a 09 09 09 09 20 20 meters))).....
11c0: 20 6e 61 6d 65 29 5d 29 29 29 29 0a 0a 28 64 65 name)]))))..(de
11d0: 66 69 6e 65 20 73 64 6c 32 2d 6d 6f 64 75 6c 65 fine sdl2-module
11e0: 73 2d 66 75 6e 63 0a 20 20 27 28 61 73 73 65 72 s-func. '(asser
11f0: 74 20 61 74 6f 6d 69 63 20 61 75 64 69 6f 20 63 t atomic audio c
1200: 6c 69 70 62 6f 61 72 64 0a 20 20 20 20 63 70 75 lipboard. cpu
1210: 69 6e 66 6f 20 65 6e 64 69 61 6e 20 65 72 72 6f info endian erro
1220: 72 20 65 76 65 6e 74 73 20 0a 20 20 20 20 66 69 r events . fi
1230: 6c 65 73 79 73 74 65 6d 20 68 69 6e 74 73 20 6a lesystem hints j
1240: 6f 79 73 74 69 63 6b 0a 20 20 20 20 6b 65 79 62 oystick. keyb
1250: 6f 61 72 64 20 6c 6f 61 64 73 6f 20 6c 6f 67 20 oard loadso log
1260: 6d 61 69 6e 20 6d 65 73 73 61 67 65 62 6f 78 0a main messagebox.
1270: 20 20 20 20 6d 6f 75 73 65 20 6d 75 74 65 78 20 mouse mutex
1280: 70 69 78 65 6c 73 20 70 6c 61 74 66 6f 72 6d 20 pixels platform
1290: 70 6f 77 65 72 0a 20 20 20 20 72 65 63 74 20 72 power. rect r
12a0: 65 6e 64 65 72 20 72 77 6f 70 73 20 73 75 72 66 ender rwops surf
12b0: 61 63 65 20 73 79 73 74 65 6d 0a 20 20 20 20 74 ace system. t
12c0: 68 72 65 61 64 20 74 69 6d 65 72 20 74 6f 75 63 hread timer touc
12d0: 68 20 76 65 72 73 69 6f 6e 20 76 69 64 65 6f 20 h version video
12e0: 67 61 6d 65 63 6f 6e 74 72 6f 6c 6c 65 72 20 67 gamecontroller g
12f0: 65 73 74 75 72 65 20 73 64 6c 29 29 0a 0a 28 64 esture sdl))..(d
1300: 65 66 69 6e 65 20 73 64 6c 2d 6a 73 6f 6e 2d 74 efine sdl-json-t
1310: 65 78 74 20 28 72 65 61 64 2d 66 69 6c 65 20 22 ext (read-file "
1320: 73 64 6c 32 2e 6a 73 6f 6e 22 29 29 0a 28 64 65 sdl2.json")).(de
1330: 66 69 6e 65 20 73 64 6c 2d 6a 73 6f 6e 20 28 73 fine sdl-json (s
1340: 74 72 69 6e 67 2d 3e 6a 73 6f 6e 20 73 64 6c 2d tring->json sdl-
1350: 6a 73 6f 6e 2d 74 65 78 74 29 29 0a 0a 28 77 69 json-text))..(wi
1360: 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c th-output-to-fil
1370: 65 20 22 73 64 6c 32 2e 73 65 78 70 22 20 28 6c e "sdl2.sexp" (l
1380: 61 6d 62 64 61 20 28 29 20 28 70 72 65 74 74 79 ambda () (pretty
1390: 2d 70 72 69 6e 74 20 73 64 6c 2d 6a 73 6f 6e 29 -print sdl-json)
13a0: 29 20 27 74 72 75 6e 63 61 74 65 29 0a 0a 28 66 ) 'truncate)..(f
13b0: 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 or-each (lambda
13c0: 28 6d 29 20 0a 09 20 20 20 20 28 77 69 74 68 2d (m) .. (with-
13d0: 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c 65 20 28 output-to-file (
13e0: 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 20 6d 20 string-append m
13f0: 22 2d 66 75 6e 63 74 69 6f 6e 73 2e 73 73 22 29 "-functions.ss")
1400: 0a 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 .. (lambda
1410: 28 29 20 0a 09 09 28 76 65 63 74 6f 72 2d 66 6f () ...(vector-fo
1420: 72 2d 65 61 63 68 20 0a 09 09 20 28 6c 61 6d 62 r-each ... (lamb
1430: 64 61 20 28 78 29 20 0a 09 09 20 20 20 28 70 61 da (x) ... (pa
1440: 72 73 65 2d 6a 73 6f 6e 2d 66 75 6e 63 74 69 6f rse-json-functio
1450: 6e 20 78 20 6d 29 29 0a 09 09 20 73 64 6c 2d 6a n x m))... sdl-j
1460: 73 6f 6e 29 29 0a 09 20 20 20 20 20 20 27 74 72 son)).. 'tr
1470: 75 6e 63 61 74 65 29 29 20 28 6d 61 70 20 73 79 uncate)) (map sy
1480: 6d 62 6f 6c 2d 3e 73 74 72 69 6e 67 20 73 64 6c mbol->string sdl
1490: 32 2d 6d 6f 64 75 6c 65 73 2d 66 75 6e 63 29 29 2-modules-func))
14a0: 0a 0a 28 64 65 66 69 6e 65 20 73 64 6c 6e 65 74 ..(define sdlnet
14b0: 2d 6a 73 6f 6e 2d 74 65 78 74 20 28 72 65 61 64 -json-text (read
14c0: 2d 66 69 6c 65 20 22 73 64 6c 32 2d 6e 65 74 2e -file "sdl2-net.
14d0: 6a 73 6f 6e 22 29 29 0a 28 64 65 66 69 6e 65 20 json")).(define
14e0: 73 64 6c 6e 65 74 2d 6a 73 6f 6e 20 28 73 74 72 sdlnet-json (str
14f0: 69 6e 67 2d 3e 6a 73 6f 6e 20 73 64 6c 6e 65 74 ing->json sdlnet
1500: 2d 6a 73 6f 6e 2d 74 65 78 74 29 29 0a 0a 28 77 -json-text))..(w
1510: 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 ith-output-to-fi
1520: 6c 65 20 22 73 64 6c 32 2d 6e 65 74 2e 73 65 78 le "sdl2-net.sex
1530: 70 22 20 28 6c 61 6d 62 64 61 20 28 29 20 28 70 p" (lambda () (p
1540: 72 65 74 74 79 2d 70 72 69 6e 74 20 73 64 6c 6e retty-print sdln
1550: 65 74 2d 6a 73 6f 6e 29 29 20 27 74 72 75 6e 63 et-json)) 'trunc
1560: 61 74 65 29 0a 0a 28 66 6f 72 2d 65 61 63 68 20 ate)..(for-each
1570: 28 6c 61 6d 62 64 61 20 28 6d 29 20 0a 09 20 20 (lambda (m) ..
1580: 20 20 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 (with-output-t
1590: 6f 2d 66 69 6c 65 20 28 73 74 72 69 6e 67 2d 61 o-file (string-a
15a0: 70 70 65 6e 64 20 6d 20 22 2d 66 75 6e 63 74 69 ppend m "-functi
15b0: 6f 6e 73 2e 73 73 22 29 0a 09 20 20 20 20 20 20 ons.ss")..
15c0: 28 6c 61 6d 62 64 61 20 28 29 20 0a 09 09 28 76 (lambda () ...(v
15d0: 65 63 74 6f 72 2d 66 6f 72 2d 65 61 63 68 20 0a ector-for-each .
15e0: 09 09 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 .. (lambda (x)..
15f0: 09 20 20 20 28 70 61 72 73 65 2d 6a 73 6f 6e 2d . (parse-json-
1600: 66 75 6e 63 74 69 6f 6e 20 78 20 6d 29 29 0a 09 function x m))..
1610: 09 20 73 64 6c 6e 65 74 2d 6a 73 6f 6e 29 29 0a . sdlnet-json)).
1620: 09 20 20 20 20 20 20 27 74 72 75 6e 63 61 74 65 . 'truncate
1630: 29 29 20 27 28 22 6e 65 74 22 29 29 0a 0a 28 64 )) '("net"))..(d
1640: 65 66 69 6e 65 20 73 64 6c 69 6d 61 67 65 2d 6a efine sdlimage-j
1650: 73 6f 6e 2d 74 65 78 74 20 28 72 65 61 64 2d 66 son-text (read-f
1660: 69 6c 65 20 22 73 64 6c 32 2d 69 6d 61 67 65 2e ile "sdl2-image.
1670: 6a 73 6f 6e 22 29 29 0a 28 64 65 66 69 6e 65 20 json")).(define
1680: 73 64 6c 69 6d 61 67 65 2d 6a 73 6f 6e 20 28 73 sdlimage-json (s
1690: 74 72 69 6e 67 2d 3e 6a 73 6f 6e 20 73 64 6c 69 tring->json sdli
16a0: 6d 61 67 65 2d 6a 73 6f 6e 2d 74 65 78 74 29 29 mage-json-text))
16b0: 0a 0a 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 ..(with-output-t
16c0: 6f 2d 66 69 6c 65 20 22 73 64 6c 32 2d 69 6d 61 o-file "sdl2-ima
16d0: 67 65 2e 73 65 78 70 22 20 28 6c 61 6d 62 64 61 ge.sexp" (lambda
16e0: 20 28 29 20 28 70 72 65 74 74 79 2d 70 72 69 6e () (pretty-prin
16f0: 74 20 73 64 6c 69 6d 61 67 65 2d 6a 73 6f 6e 29 t sdlimage-json)
1700: 29 0a 09 09 20 20 20 20 20 27 74 72 75 6e 63 61 )... 'trunca
1710: 74 65 29 0a 0a 28 66 6f 72 2d 65 61 63 68 20 28 te)..(for-each (
1720: 6c 61 6d 62 64 61 20 28 6d 29 0a 09 20 20 20 20 lambda (m)..
1730: 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d (with-output-to-
1740: 66 69 6c 65 20 28 73 74 72 69 6e 67 2d 61 70 70 file (string-app
1750: 65 6e 64 20 6d 20 22 2d 66 75 6e 63 74 69 6f 6e end m "-function
1760: 73 2e 73 73 22 29 0a 09 20 20 20 20 20 20 28 6c s.ss").. (l
1770: 61 6d 62 64 61 20 28 29 0a 09 09 20 20 28 76 65 ambda ()... (ve
1780: 63 74 6f 72 2d 66 6f 72 2d 65 61 63 68 0a 09 09 ctor-for-each...
1790: 20 20 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 (lambda (x)..
17a0: 09 20 20 20 20 20 28 70 61 72 73 65 2d 6a 73 6f . (parse-jso
17b0: 6e 2d 66 75 6e 63 74 69 6f 6e 20 78 20 6d 29 29 n-function x m))
17c0: 0a 09 09 20 20 20 73 64 6c 69 6d 61 67 65 2d 6a ... sdlimage-j
17d0: 73 6f 6e 29 29 0a 09 20 20 20 20 20 20 27 74 72 son)).. 'tr
17e0: 75 6e 63 61 74 65 29 29 20 27 28 22 69 6d 61 67 uncate)) '("imag
17f0: 65 22 29 29 0a 0a 0a 28 64 65 66 69 6e 65 20 73 e"))...(define s
1800: 64 6c 74 74 66 73 2d 6a 73 6f 6e 2d 74 65 78 74 dlttfs-json-text
1810: 20 28 72 65 61 64 2d 66 69 6c 65 20 22 74 74 66 (read-file "ttf
1820: 2d 73 68 69 6d 2e 6a 73 6f 6e 22 29 29 0a 28 64 -shim.json")).(d
1830: 65 66 69 6e 65 20 73 64 6c 74 74 66 73 2d 6a 73 efine sdlttfs-js
1840: 6f 6e 20 28 73 74 72 69 6e 67 2d 3e 6a 73 6f 6e on (string->json
1850: 20 73 64 6c 74 74 66 73 2d 6a 73 6f 6e 2d 74 65 sdlttfs-json-te
1860: 78 74 29 29 0a 0a 28 77 69 74 68 2d 6f 75 74 70 xt))..(with-outp
1870: 75 74 2d 74 6f 2d 66 69 6c 65 20 22 74 74 66 2d ut-to-file "ttf-
1880: 73 68 69 6d 2e 73 65 78 70 22 20 28 6c 61 6d 62 shim.sexp" (lamb
1890: 64 61 20 28 29 20 28 70 72 65 74 74 79 2d 70 72 da () (pretty-pr
18a0: 69 6e 74 20 73 64 6c 74 74 66 73 2d 6a 73 6f 6e int sdlttfs-json
18b0: 29 29 0a 09 09 20 20 20 20 20 27 74 72 75 6e 63 ))... 'trunc
18c0: 61 74 65 29 0a 0a 28 66 6f 72 2d 65 61 63 68 20 ate)..(for-each
18d0: 28 6c 61 6d 62 64 61 20 28 6d 29 0a 09 20 20 20 (lambda (m)..
18e0: 20 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f (with-output-to
18f0: 2d 66 69 6c 65 20 28 73 74 72 69 6e 67 2d 61 70 -file (string-ap
1900: 70 65 6e 64 20 6d 20 22 2d 66 75 6e 63 74 69 6f pend m "-functio
1910: 6e 73 2e 73 73 22 29 0a 09 20 20 20 20 20 20 28 ns.ss").. (
1920: 6c 61 6d 62 64 61 20 28 29 0a 09 09 20 20 28 76 lambda ()... (v
1930: 65 63 74 6f 72 2d 66 6f 72 2d 65 61 63 68 0a 09 ector-for-each..
1940: 09 20 20 20 28 6c 61 6d 62 64 61 20 28 78 29 0a . (lambda (x).
1950: 09 09 20 20 20 20 20 28 70 61 72 73 65 2d 6a 73 .. (parse-js
1960: 6f 6e 2d 66 75 6e 63 74 69 6f 6e 20 78 20 6d 29 on-function x m)
1970: 29 0a 09 09 20 20 20 73 64 6c 74 74 66 73 2d 6a )... sdlttfs-j
1980: 73 6f 6e 29 29 0a 09 20 20 20 20 20 20 27 74 72 son)).. 'tr
1990: 75 6e 63 61 74 65 29 29 20 27 28 22 73 74 74 66 uncate)) '("sttf
19a0: 22 29 29 0a 0a 28 64 65 66 69 6e 65 20 73 64 6c "))..(define sdl
19b0: 74 74 66 2d 6a 73 6f 6e 2d 74 65 78 74 20 28 72 ttf-json-text (r
19c0: 65 61 64 2d 66 69 6c 65 20 22 73 64 6c 32 2d 74 ead-file "sdl2-t
19d0: 74 66 2e 6a 73 6f 6e 22 29 29 0a 28 64 65 66 69 tf.json")).(defi
19e0: 6e 65 20 73 64 6c 74 74 66 2d 6a 73 6f 6e 20 28 ne sdlttf-json (
19f0: 73 74 72 69 6e 67 2d 3e 6a 73 6f 6e 20 73 64 6c string->json sdl
1a00: 74 74 66 2d 6a 73 6f 6e 2d 74 65 78 74 29 29 0a ttf-json-text)).
1a10: 0a 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f .(with-output-to
1a20: 2d 66 69 6c 65 20 22 73 64 6c 32 2d 74 74 66 2d -file "sdl2-ttf-
1a30: 72 65 61 6c 2e 73 65 78 70 22 20 28 6c 61 6d 62 real.sexp" (lamb
1a40: 64 61 20 28 29 20 28 70 72 65 74 74 79 2d 70 72 da () (pretty-pr
1a50: 69 6e 74 20 73 64 6c 74 74 66 2d 6a 73 6f 6e 29 int sdlttf-json)
1a60: 29 0a 09 09 20 20 20 20 20 27 74 72 75 6e 63 61 )... 'trunca
1a70: 74 65 29 0a 0a 28 66 6f 72 2d 65 61 63 68 20 28 te)..(for-each (
1a80: 6c 61 6d 62 64 61 20 28 6d 29 0a 09 20 20 20 20 lambda (m)..
1a90: 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d (with-output-to-
1aa0: 66 69 6c 65 20 28 73 74 72 69 6e 67 2d 61 70 70 file (string-app
1ab0: 65 6e 64 20 6d 20 22 2d 66 75 6e 63 74 69 6f 6e end m "-function
1ac0: 73 2e 73 73 22 29 0a 09 20 20 20 20 20 20 28 6c s.ss").. (l
1ad0: 61 6d 62 64 61 20 28 29 0a 09 09 20 20 28 76 65 ambda ()... (ve
1ae0: 63 74 6f 72 2d 66 6f 72 2d 65 61 63 68 0a 09 09 ctor-for-each...
1af0: 20 20 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 (lambda (x)..
1b00: 09 20 20 20 20 20 28 70 61 72 73 65 2d 6a 73 6f . (parse-jso
1b10: 6e 2d 66 75 6e 63 74 69 6f 6e 20 78 20 6d 29 29 n-function x m))
1b20: 0a 09 09 20 20 20 73 64 6c 74 74 66 2d 6a 73 6f ... sdlttf-jso
1b30: 6e 29 29 0a 09 20 20 20 20 20 20 27 74 72 75 6e n)).. 'trun
1b40: 63 61 74 65 29 29 20 27 28 22 74 74 66 22 29 29 cate)) '("ttf"))
1b50: 0a 0a 3b 3b 3b 3b 54 4f 44 4f 20 53 65 72 69 6f ..;;;;TODO Serio
1b60: 75 73 6c 79 20 74 68 69 73 20 73 68 6f 75 6c 64 usly this should
1b70: 20 62 65 20 6f 6e 65 20 66 75 6e 63 74 69 6f 6e be one function
1b80: 20 62 65 63 61 75 73 65 20 74 68 69 73 0a 3b 3b because this.;;
1b90: 3b 3b 69 73 20 61 20 70 61 69 6e 20 69 6e 20 74 ;;is a pain in t
1ba0: 68 65 20 62 75 74 74 0a 0a 28 64 65 66 69 6e 65 he butt..(define
1bb0: 20 73 64 6c 6d 69 78 65 72 2d 6a 73 6f 6e 2d 74 sdlmixer-json-t
1bc0: 65 78 74 20 28 72 65 61 64 2d 66 69 6c 65 20 22 ext (read-file "
1bd0: 73 64 6c 32 2d 6d 69 78 65 72 2e 6a 73 6f 6e 22 sdl2-mixer.json"
1be0: 29 29 0a 28 64 65 66 69 6e 65 20 73 64 6c 6d 69 )).(define sdlmi
1bf0: 78 65 72 2d 6a 73 6f 6e 20 28 73 74 72 69 6e 67 xer-json (string
1c00: 2d 3e 6a 73 6f 6e 20 73 64 6c 6d 69 78 65 72 2d ->json sdlmixer-
1c10: 6a 73 6f 6e 2d 74 65 78 74 29 29 0a 0a 28 77 69 json-text))..(wi
1c20: 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c th-output-to-fil
1c30: 65 20 22 73 64 6c 32 2d 6d 69 78 65 72 2e 73 65 e "sdl2-mixer.se
1c40: 78 70 22 20 28 6c 61 6d 62 64 61 20 28 29 20 28 xp" (lambda () (
1c50: 70 72 65 74 74 79 2d 70 72 69 6e 74 20 73 64 6c pretty-print sdl
1c60: 6d 69 78 65 72 2d 6a 73 6f 6e 29 29 0a 09 09 20 mixer-json))...
1c70: 20 20 20 20 27 74 72 75 6e 63 61 74 65 29 0a 0a 'truncate)..
1c80: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
1c90: 61 20 28 6d 29 0a 09 20 20 20 20 28 77 69 74 68 a (m).. (with
1ca0: 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c 65 20 -output-to-file
1cb0: 28 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 20 6d (string-append m
1cc0: 20 22 2d 66 75 6e 63 74 69 6f 6e 73 2e 73 73 22 "-functions.ss"
1cd0: 29 0a 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 ).. (lambda
1ce0: 20 28 29 0a 09 09 20 20 28 76 65 63 74 6f 72 2d ()... (vector-
1cf0: 66 6f 72 2d 65 61 63 68 0a 09 09 20 20 20 28 6c for-each... (l
1d00: 61 6d 62 64 61 20 28 78 29 0a 09 09 20 20 20 20 ambda (x)...
1d10: 20 28 70 61 72 73 65 2d 6a 73 6f 6e 2d 66 75 6e (parse-json-fun
1d20: 63 74 69 6f 6e 20 78 20 6d 29 29 0a 09 09 20 20 ction x m))...
1d30: 20 73 64 6c 6d 69 78 65 72 2d 6a 73 6f 6e 29 29 sdlmixer-json))
1d40: 0a 09 20 20 20 20 20 20 27 74 72 75 6e 63 61 74 .. 'truncat
1d50: 65 29 29 20 27 28 22 6d 69 78 22 29 29 0a e)) '("mix")).