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
|
#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 ns (current-namespace)]
|
||||||
(define (add x y) (+ x y))
|
|
||||||
|
(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)))
|
(provide (matching-identifiers-out #rx"^u-" (all-defined-out)))
|
||||||
(define-macro (u-id ID)
|
(define-macro (u-id ID)
|
||||||
#'(string->symbol ID))
|
#'(string->symbol ID))
|
||||||
|
|
||||||
|
|
||||||
(define-macro (u-atom ITEM...)
|
|
||||||
#'ITEM...)
|
|
||||||
(define-macro (u-number NUM...)
|
(define-macro (u-number NUM)
|
||||||
#'(number->string 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...)
|
(define-macro (u-converting-num NUM...)
|
||||||
#'(string->number NUM...))
|
#'(string->number NUM...))
|
||||||
|
|
||||||
(define-macro-cases u-expr
|
(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-atom ITEM)) #'ITEM]
|
||||||
|
[(u-expr (u-series SERIES ...)) #'(begin (mixed-series `(,SERIES ...)))]
|
||||||
[(u-expr (u-converting-num (u-number NUM))) #'NUM]
|
[(u-expr (u-converting-num (u-number NUM))) #'NUM]
|
||||||
[(u-expr X) #'X])
|
[(u-expr X) #'X])
|
||||||
|
|
||||||
(define-macro-cases u-sexp
|
(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 X Y) #'[X Y]]
|
||||||
[(u-sexp REQ OPT ...)
|
[(u-sexp REQ OPT ...)
|
||||||
#'(let ([head REQ]
|
#'(begin (display (memq 'maintext (namespace-mapped-symbols ns)))
|
||||||
(namespace (current-namespace)))
|
|
||||||
(namespace-variable-value head namespace) OPT ...)]
|
((eval REQ ns) (eval OPT ... ns)))])
|
||||||
)
|
|
||||||
|
|
||||||
(define-macro (u-module-begin (u-program LINE ...))
|
(define-macro (u-module-begin (u-program LINE ...))
|
||||||
#'(#%module-begin
|
#'(#%module-begin
|
||||||
|
(init-defs)
|
||||||
LINE ...))
|
LINE ...))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(provide (rename-out [u-module-begin #%module-begin]))
|
(provide (rename-out [u-module-begin #%module-begin]))
|
||||||
|
(provide maintext)
|
|
@ -1,10 +1,12 @@
|
||||||
#lang br
|
#lang br
|
||||||
(require uahgi2/parser uahgi2/tokenizer brag/support)
|
(require uahgi2/parser uahgi2/tokenizer brag/support)
|
||||||
(define str #<<Here
|
(define str #<<Here
|
||||||
|
{@display|996}
|
||||||
{@set|@paperwidth|`2100}
|
{@set|@paperwidth|`2100}
|
||||||
|
{@display|@paperwidth}
|
||||||
{@set|@paperheight|`2970}
|
{@set|@paperheight|`2970}
|
||||||
{@set|@textsize|`12.3}
|
{@set|@textsize|`12.3}
|
||||||
{@maintext@@
|
{@maintext|
|
||||||
{@hd2|我是貓 I'm a cat}天地人123
|
{@hd2|我是貓 I'm a cat}天地人123
|
||||||
}
|
}
|
||||||
Here
|
Here
|
||||||
|
|
9
test.rkt
9
test.rkt
|
@ -1,2 +1,9 @@
|
||||||
#lang uahgi2
|
#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