108 lines
No EOL
3.1 KiB
Racket
108 lines
No EOL
3.1 KiB
Racket
#lang br/quicklang
|
|
(require racket/dict)
|
|
(require racket/match)
|
|
(namespace-require/copy 'racket/base) ; must be added for the currect namespace
|
|
|
|
(define-macro (init-defs)
|
|
#'(begin
|
|
'()))
|
|
|
|
(define paperwidth 2480)
|
|
(define paperheight 3508)
|
|
(define frame-list '())
|
|
(define main-style
|
|
(make-hash '(["font-family" . "FreeSerif"]
|
|
["font-family-CJK" . "Noto Sans CJK TC"]
|
|
["font-size" . 12]
|
|
["font-weight" . "regular"]
|
|
["font-style" . "normal"])))
|
|
|
|
(define main-frame
|
|
(make-hash '(["type" . "frame"]
|
|
["id" . "main"]
|
|
["content" . #f]
|
|
["style" . main-style]
|
|
["x". 1800]
|
|
["y". 3200]
|
|
["width". 1800]
|
|
["height" . 3200]
|
|
["skip-to-footnote". 80])
|
|
))
|
|
(set! frame-list (cons main-frame frame-list))
|
|
(define (hd2 cont)
|
|
(make-hash `(["type" . "hbox"]
|
|
["id" . ""]
|
|
["content" . ,cont]
|
|
["style" . ["style" . ,(make-hash '(["font-family" . "FreeSerif"]
|
|
["font-family-CJK" . "Noto Sans CJK TC"]
|
|
["font-size" . 15]
|
|
["font-weight" . "regular"]
|
|
["font-style" . "normal"]))]]
|
|
["x". #f]
|
|
["y". #f]
|
|
["width". #f]
|
|
["height" . #f]
|
|
)
|
|
))
|
|
|
|
(define (maintext cont)
|
|
(match cont
|
|
[`(mixed-series ,(list `newline a ...)) (mixed-series a)]
|
|
[_ cont]))
|
|
|
|
|
|
|
|
|
|
[define ns (current-namespace)]
|
|
|
|
(struct put-chars ([ch #:mutable]) #:transparent) ; flow of chars to be put
|
|
(struct mixed-series ([item #:mutable]) #:transparent) ; series of mixed item
|
|
|
|
|
|
(provide (matching-identifiers-out #rx"^u-" (all-defined-out)))
|
|
(define-macro (u-id ID)
|
|
#'(string->symbol ID))
|
|
|
|
|
|
|
|
|
|
(define-macro (u-number NUM)
|
|
#'(number->string NUM))
|
|
(define-macro-cases u-atom
|
|
[(u-atom (u-number NUM)) #'(put-chars (number->string NUM))]
|
|
[(u-atom "\n") #''newline]
|
|
[(u-atom HD_CHAR TL_CHAR ...) #'(put-chars (foldr string-append "" `(HD_CHAR TL_CHAR ...)))]
|
|
[(u-atom X) #'X])
|
|
|
|
(define-macro (u-converting-num NUM...)
|
|
#'(string->number NUM...))
|
|
|
|
(define-macro-cases u-expr
|
|
[(u-expr (u-atom (u-id ID))) #'(string->symbol ID)]
|
|
[(u-expr (put-chars X)) #'(put-chars X)]
|
|
[(u-expr (u-atom ITEM)) #'ITEM]
|
|
[(u-expr (u-series SERIES ...)) #'(begin (mixed-series `(,SERIES ...)))]
|
|
[(u-expr (u-converting-num (u-number NUM))) #'NUM]
|
|
[(u-expr X) #'X])
|
|
|
|
(define-macro-cases u-sexp
|
|
[(u-sexp (u-expr (u-atom (u-id "set"))) (u-expr (u-atom (u-id X))) Y)
|
|
#'(let ((tmp (string->symbol X))) (namespace-set-variable-value! tmp Y #f ns #f))]
|
|
[(u-sexp (u-expr (u-atom (u-id "maintext"))) X ...) #'(maintext X ...)]
|
|
[(u-sexp (u-expr (u-atom (u-id "hd2"))) X) #'(hd2 X)]
|
|
;[(u-sexp X Y) #'[X Y]]
|
|
[(u-sexp REQ OPT ...)
|
|
#'(begin (display (memq 'maintext (namespace-mapped-symbols ns)))
|
|
|
|
((eval REQ ns) (eval OPT ... ns)))])
|
|
|
|
(define-macro (u-module-begin (u-program LINE ...))
|
|
#'(#%module-begin
|
|
(init-defs)
|
|
LINE ...))
|
|
|
|
|
|
|
|
|
|
(provide (rename-out [u-module-begin #%module-begin]))
|
|
(provide maintext) |