(module slides_for-syntax racket
(provide amkhlv/formula-syntax)
(define (amkhlv/formula-syntax #:autoalign-formula-prefix auto-prefix
#:manual-formula-prefix formula-prefix
#:display-math-prefix display-math-prefix
#:size-change-notation size-change-id
#:size-increase-notation size-increase-id
#:size-restore-notation size-restore-id
stx)
(let* (
[calc-align (lambda (s) `(+ (bystro-manual-base-alignment amkhlv/conf) ,s))]
[calc-size (lambda (s) `(+ (bystro-formula-size amkhlv/conf) ,(* 2 s)))]
[auto `(define ,(string->symbol auto-prefix)
(lambda u (amkhlv/formula #:use-depth #t (apply string-append u))))]
[disp `(define ( ,(string->symbol display-math-prefix)
#:label (lbl #f)
#:size (n (bystro-formula-size amkhlv/conf))
. x)
(amkhlv/equation #:label lbl #:size n x))]
[old-formula-size (string->unreadable-symbol "oldfsize")]
[old-autoalign-adjust (string->unreadable-symbol "old-aa-adjust")]
[oldsz `(define ,old-formula-size (bystro-formula-size amkhlv/conf))]
[oldaa `(define ,old-autoalign-adjust (bystro-autoalign-adjust amkhlv/conf))]
[ch-sz `(define (,(string->symbol size-change-id) (i #f) (aaadj #f))
(if i (begin
(set! ,old-formula-size (bystro-formula-size amkhlv/conf))
(set-bystro-formula-size! amkhlv/conf i)
(when aaadj (begin
(set! ,old-autoalign-adjust
(bystro-autoalign-adjust amkhlv/conf))
(set-bystro-autoalign-adjust! amkhlv/conf aaadj))))
(begin
(set-bystro-formula-size! amkhlv/conf ,old-formula-size)
(set-bystro-autoalign-adjust! amkhlv/conf ,old-autoalign-adjust)
)))]
[inc-sz `(define (,(string->symbol size-increase-id) i (aaadj #f))
(set! ,old-formula-size (bystro-formula-size amkhlv/conf))
(set-bystro-formula-size! amkhlv/conf (+ (bystro-formula-size amkhlv/conf) i))
(when aaadj
(begin (set! ,old-autoalign-adjust
(bystro-autoalign-adjust amkhlv/conf))
(set-bystro-autoalign-adjust! amkhlv/conf aaadj))))]
[rs-sz `(define (,(string->symbol size-restore-id))
(set-bystro-formula-size! amkhlv/conf ,old-formula-size)
(set-bystro-autoalign-adjust! amkhlv/conf ,old-autoalign-adjust)
)]
[l `(define (,(string->symbol formula-prefix) . u)
(amkhlv/formula #:align ,(calc-align 0)
(apply string-append u)))]
[l+ (lambda (m)
`(define
(,(string->symbol (format "~a+~a" formula-prefix m)) . u)
(amkhlv/formula #:align ,(calc-align m)
(apply string-append u))))]
[l- (lambda (m)
`(define
(,(string->symbol (format "~a-~a" formula-prefix m)) . u)
(amkhlv/formula #:align ,(calc-align (- m))
(apply string-append u))))]
[l++ (lambda (m z)
`(define
(,(string->symbol (format "~a+~a+~a" formula-prefix m z)) . u)
(amkhlv/formula #:align ,(calc-align m)
#:size ,(calc-size z)
(apply string-append u))))]
[l+- (lambda (m z)
`(define
(,(string->symbol (format "~a+~a-~a" formula-prefix m z)) . u)
(amkhlv/formula #:align ,(calc-align m)
#:size ,(calc-size (- z))
(apply string-append u))))]
[l-+ (lambda (m z)
`(define
(,(string->symbol (format "~a-~a+~a" formula-prefix m z)) . u)
(amkhlv/formula #:align ,(calc-align (- m))
#:size ,(calc-size z)
(apply string-append u))))]
[l-- (lambda (m z)
`(define
(,(string->symbol (format "~a-~a-~a" formula-prefix m z)) . u)
(amkhlv/formula #:align ,(calc-align (- m))
#:size ,(calc-size (- z))
(apply string-append u))))]
[rangelist (build-list 11 [lambda (x) (+ x 1)])]
[rangelist0 (build-list 12 values)]
[def-list+ (for/list ([i rangelist0]) (l+ i))]
[def-list- (for/list ([i rangelist0]) (l- i))]
[def-list++ (apply append (for/list ([i rangelist0])
(for/list ([z (build-list 9 [lambda (x) (+ x 1)])])
(l++ i z))))]
[def-list+- (apply append (for/list ([i rangelist0])
(for/list ([z (build-list 9 [lambda (x) (+ x 1)])])
(l+- i z))))]
[def-list-+ (apply append (for/list ([i rangelist0])
(for/list ([z (build-list 9 [lambda (x) (+ x 1)])])
(l-+ i z))))]
[def-list-- (apply append (for/list ([i rangelist0])
(for/list ([z (build-list 9 [lambda (x) (+ x 1)])])
(l-- i z))))]
)
(syntax-case stx ()
[(_ x) (datum->syntax
#'x
(append (list 'begin auto disp oldsz oldaa ch-sz inc-sz rs-sz l)
def-list+ def-list-
def-list++ def-list+- def-list-+ def-list--
)
#'x #'x #'x)])
)
)
)