ref: 1e9612c4e55535ffc097e5d44c1b5509ee894e4c
parent: 032f6a6361e18b6f47e9e8fe5d8267c43bd6b2dd
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Tue May 28 05:26:21 EDT 2024
reformat the code
--- /dev/null
+++ b/fmt.sh
@@ -1,0 +1,2 @@
+#!/bin/sh
+raco fmt --width 120 --indent 2 -i *.rkt
--- a/otf.rkt
+++ b/otf.rkt
@@ -8,16 +8,12 @@
(define cmplxs '())
(define (indent x lst)
- (let ([ind (make-string x #\tab)])
- (map (λ (str) (string-append ind str)) lst)))
+ (let ([ind (make-string x #\tab)]) (map (λ (str) (string-append ind str)) lst)))
(define (format-lines lst)
(string-join (append lst '("")) "\n"))-(define-generics code
- (gen-h code)
- (gen-c code)
- (c-type code))
+(define-generics code (gen-h code) (gen-c code) (c-type code))
(define-struct type (name bits c parse)
#:transparent
@@ -48,9 +44,13 @@
(define (gen-h a)
(list (~a (super-c-type (field-type a)) " *" (field-name a) ";")))
(define (gen-c a)
- (list (~a "if(read_array(ctx, &v->" (field-name a) ", "
- "read_" (super-c-type (field-type a)) ", "
- "v->" (fieldarr-count a) ") < 0){")+ (list (~a "if(read_array(ctx, &v->"
+ (field-name a)
+ ", read_"
+ (super-c-type (field-type a))
+ ", v->"
+ (fieldarr-count a)
+ ") < 0){")(~a "\twerror(\"%s: %r\", \"" (field-name a) "\");")
(~a "\tgoto err;")
(~a "}")))])
@@ -60,74 +60,68 @@
#:methods gen:code
[(define/generic super-gen-h gen-h)
(define/generic super-gen-c gen-c)
- (define (gen-h c) (flatten (append
- (list (~a "typedef struct " (cmplx-name c) " " (cmplx-name c) ";")
- (~a "struct " (cmplx-name c) " {"))- (indent 1 (flatten (map super-gen-h (cmplx-fields c))))
- (list (~a "};")
- (~a "int read_" (cmplx-name c) "(Ctx *ctx, " (cmplx-name c) " *v);")))))
- (define (gen-c c) (flatten (append
- (list (~a "int")
- (~a "read_" (cmplx-name c) "(Ctx *ctx, " (cmplx-name c) " *v)")
- (~a "{"))- (indent 1 (flatten (map super-gen-c (cmplx-fields c))))
- (list (~a "\treturn 0;")
- (~a "err:")
- (~a "\twerrstr(\"%s: %r\", \"" (cmplx-name c) "\");")
- (~a "\treturn -1;")
- (~a "}")))))
- (define (c-type c) (cmplx-name c))])
+ (define (gen-h c)
+ (flatten (append (list (~a "typedef struct " (cmplx-name c) " " (cmplx-name c) ";")
+ (~a "struct " (cmplx-name c) " {"))+ (indent 1 (flatten (map super-gen-h (cmplx-fields c))))
+ (list (~a "};") (~a "int read_" (cmplx-name c) "(Ctx *ctx, " (cmplx-name c) " *v);")))))
+ (define (gen-c c)
+ (flatten (append (list (~a "int") (~a "read_" (cmplx-name c) "(Ctx *ctx, " (cmplx-name c) " *v)") (~a "{"))+ (indent 1 (flatten (map super-gen-c (cmplx-fields c))))
+ (list (~a "\treturn 0;")
+ (~a "err:")
+ (~a "\twerrstr(\"%s: %r\", \"" (cmplx-name c) "\");")
+ (~a "\treturn -1;")
+ (~a "}")))))
+ (define (c-type c)
+ (cmplx-name c))])
(define (autoparse bits ctype)
- (λ (b index)
+ (λ (b [index 0])
(letrec ([f (λ (index shift)
- (let ([x (- shift 8)])
- (~a "("ctype")"b"["index"]<<"x (if (positive? x)- (~a " | " (f (add1 index) x))
- ""))))])
- (~a "("(f index bits)")"))))+ (let* ([x (- shift 8)] [next (if (positive? x) (~a " | " (f (add1 index) x)) "")])
+ (~a "(" ctype ")" b "[" index "]<<" x next)))])+ (~a "(" (f index bits) ")"))))(define-syntax mktype
(syntax-rules ()
- [(_ typ bits c) (begin
+ [(_ typ bits c)
+ (begin
(define typ (make-type `typ bits `c (autoparse bits `c)))
(set! types (append types (list typ))))]
- [(_ typ bits c parse) (begin
+ [(_ typ bits c parse)
+ (begin
(define typ (make-type `typ bits `typ parse))
(set! types (append types (list typ))))]))
(define-syntax mkcmplx
(syntax-rules ()
- [(_ typ fields tag) (begin
+ [(_ typ fields tag)
+ (begin
(define typ (make-cmplx `typ fields tag))
(set! cmplxs (append cmplxs (list typ))))]
- [(_ typ fields) (begin
+ [(_ typ fields)
+ (begin
(define typ (make-cmplx `typ fields ""))
(set! cmplxs (append cmplxs (list typ))))]))
(define-syntax mkfields
(syntax-rules ()
- [(_ (type name [count]))
- (list (fieldarr type `name `count))]
+ [(_ (type name [count])) (list (fieldarr type `name `count))]
[(_ (type name))
- (list (field type `name))]
- [(_ x y ...)
- (append (mkfields x) (mkfields y ...))]))
+ (list (field type
+ `name))]
+ [(_ x y ...) (append (mkfields x) (mkfields y ...))]))
(define (c-typedef? s)
(string-prefix? s "typedef"))
(define (format f)
- (string-join
- (append
- (list "/* this file is generated. do not modify. */\n\n")
- (map (λ (c) (format-lines
- (filter c-typedef? (f c)))) cmplxs)
- (map (λ (c) (format-lines
- (filter (negate c-typedef?) (f c)))) cmplxs)
- (map (λ (t) (format-lines
- (f t))) types))
- ""))
+ (string-join (append (list "/* this file is generated. do not modify. */\n\n")
+ (map (λ (c) (format-lines (filter c-typedef? (f c)))) cmplxs)
+ (map (λ (c) (format-lines (filter (negate c-typedef?) (f c)))) cmplxs)
+ (map (λ (t) (format-lines (f t))) types))
+ ""))
(mktype uint8 8 u8int)
(mktype int8 8 s8int)
@@ -144,59 +138,46 @@
(mktype Offset24 24 u32int)
(mktype Offset32 32 u32int)
(mktype Version16Dot16 32 u32int)
-(mktype Fixed 32 float
- (λ (b index)
- (~a ((type-parse int32) b index) "/65536.0f")))
-(mktype F2DOT14 16 float
- (λ (b index)
- (let ([x (~a ((type-parse int16) b index))])
- (~a "("x">>14)+("x"&((1<<14)-1))/16384.0"))))+(mktype Fixed 32 float (λ (b index) (~a ((type-parse int32) b index) "/65536.0f")))
+(mktype F2DOT14
+ 16
+ float
+ (λ (b index) (let ([x (~a ((type-parse int16) b index))]) (~a "(" x ">>14)+(" x "&((1<<14)-1))/16384.0"))))-(mkcmplx TableRecord
- (mkfields {Tag tableTag}- {uint32 checksum}- {Offset32 offset}- {uint32 length}))+(mkcmplx TableRecord (mkfields {Tag tableTag} {uint32 checksum} {Offset32 offset} {uint32 length}))(mkcmplx TableDirectory
- (mkfields {uint32 sfntVersion}- {uint16 numTables}- {uint16 searchRange}- {uint16 entrySelector}- {uint16 rangeShift}- {TableRecord tableRecords [numTables]}))+ (mkfields {uint32 sfntVersion}+ {uint16 numTables}+ {uint16 searchRange}+ {uint16 entrySelector}+ {uint16 rangeShift}+ {TableRecord tableRecords [numTables]}))-(mkcmplx EncodingRecord
- (mkfields {uint16 platformID}- {uint16 encodingID}- {Offset32 subtableOffset}))+(mkcmplx EncodingRecord (mkfields {uint16 platformID} {uint16 encodingID} {Offset32 subtableOffset}))-(mkcmplx TableCmap
- (mkfields {uint16 version}- {uint16 numTables}- {EncodingRecord encodingRecords [numTables]})- "cmap")
+(mkcmplx TableCmap (mkfields {uint16 version} {uint16 numTables} {EncodingRecord encodingRecords [numTables]}) "cmap")(mkcmplx TableHead
- (mkfields {uint16 majorVersion}- {uint16 minorVersion}- {Fixed fontRevision}- {uint32 checksumAdjustment}- {uint32 magicNumber}- {uint16 flags}- {uint16 unitsPerEm}- {LONGDATETIME created}- {LONGDATETIME modified}- {int16 xMin}- {int16 yMin}- {int16 xMax}- {int16 yMax}- {uint16 macStyle}- {uint16 lowestRecPPEM}- {int16 fontDirectionHint}- {int16 indexToLocFormat}- {int16 glyphDataFormat})- "head")
+ (mkfields {uint16 majorVersion}+ {uint16 minorVersion}+ {Fixed fontRevision}+ {uint32 checksumAdjustment}+ {uint32 magicNumber}+ {uint16 flags}+ {uint16 unitsPerEm}+ {LONGDATETIME created}+ {LONGDATETIME modified}+ {int16 xMin}+ {int16 yMin}+ {int16 xMax}+ {int16 yMax}+ {uint16 macStyle}+ {uint16 lowestRecPPEM}+ {int16 fontDirectionHint}+ {int16 indexToLocFormat}+ {int16 glyphDataFormat})+ "head")
(printf (format gen-h))
(printf (format gen-c))
--
⑨