add some function and some parser mapping
This commit is contained in:
parent
754c05fa50
commit
943fb6565d
3 changed files with 93 additions and 16 deletions
96
expander.rkt
96
expander.rkt
|
@ -1,40 +1,108 @@
|
|||
#lang br/quicklang
|
||||
(namespace-require 'racket/base) ; must be added for the currect namespace
|
||||
(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 paperwidth #f)
|
||||
(define paperheight #f)
|
||||
(define (set x y) (set! x y))
|
||||
(define (add x y) (+ x y))
|
||||
|
||||
|
||||
[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-atom ITEM...)
|
||||
#'ITEM...)
|
||||
(define-macro (u-number NUM...)
|
||||
#'(number->string NUM...))
|
||||
|
||||
|
||||
(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"))) X Y) #'(set! X Y)]
|
||||
[(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 ...)
|
||||
#'(let ([head REQ]
|
||||
(namespace (current-namespace)))
|
||||
(namespace-variable-value head namespace) 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)
|
|
@ -1,10 +1,12 @@
|
|||
#lang br
|
||||
(require uahgi2/parser uahgi2/tokenizer brag/support)
|
||||
(define str #<<Here
|
||||
{@display|996}
|
||||
{@set|@paperwidth|`2100}
|
||||
{@display|@paperwidth}
|
||||
{@set|@paperheight|`2970}
|
||||
{@set|@textsize|`12.3}
|
||||
{@maintext@@
|
||||
{@maintext|
|
||||
{@hd2|我是貓 I'm a cat}天地人123
|
||||
}
|
||||
Here
|
||||
|
|
9
test.rkt
9
test.rkt
|
@ -1,2 +1,9 @@
|
|||
#lang uahgi2
|
||||
{@display|210|100}
|
||||
{@display|996}
|
||||
{@set|@paperwidth|`2100}
|
||||
{@display|@paperwidth}
|
||||
{@set|@paperheight|`2970}
|
||||
{@set|@textsize|`12.3}
|
||||
{@maintext|
|
||||
{@hd2|我是貓 I'm a cat}天地人123我是貓
|
||||
}
|
Loading…
Reference in a new issue