652 lines
23 KiB
Racket
652 lines
23 KiB
Racket
#lang racket
|
||
;;; Instructions:
|
||
|
||
;; 1. Use ctrl+m to insert a math box
|
||
;; 2. Write an infix expression in the math box. Evaluate with enter. [Use shift+enter to insert line breaks]
|
||
;; 3. E.g. write plot[sin] to draw a graph of sine.
|
||
|
||
;; Examples:
|
||
;; x_min[-pi]; x_max[pi];
|
||
;; y_min[-pi]; y_max[pi];
|
||
;; map[ (λk.plot[(λx.cos[x+k*pi/4])]),
|
||
;; {-4,-3,-2,-1,0,1,2,3,4}]; "done"
|
||
|
||
;;
|
||
;; TODO
|
||
;;
|
||
;; Editor: Bold and italic used more than once should toggle.
|
||
;; Editor: Text size.
|
||
;; Editor: Save and load.
|
||
;; Editor: When inserting part copied from MathBox, automatically insert new MathBox.
|
||
;; Editor: Keybindings for λ α β γ δ ε ∆ Λ works in MathBox. Should work outside too.
|
||
;; (Partially done. β and bold clashes) More greek letters?
|
||
;; Parser: Extend f(x):=expr syntax to 2 or more variables.
|
||
;; Evaluation: Get syntax-location from math-text%
|
||
;; Keymaps: Insertion of greek, and, mathematical characters.
|
||
;; Maxima: Maxima backend. See send-lisp-command and receive-list in maxima.rkt.
|
||
;; Yacas: ?
|
||
;; LaTeX:
|
||
;; PlotCanvas: Add status icons in upper, left corner. Add zooms.
|
||
;; Plot: Error message for the case plot[not-a-function] (partially done - 0 is plotted)
|
||
;; MathBox: When to remove old evaluation result?
|
||
;; NSolve: Root polishing algorithms. See GSL.
|
||
;; Snips: Right-click menu: Options such output on/off.
|
||
;; Snips: Represent equations, integrals etc with small graphs ala Wolfram Alpha.
|
||
;; Educational: Recognize standard equations and offer step by step solutions.
|
||
|
||
;; DONE
|
||
;;
|
||
;; MathBox: Evaluating an expression with an error, removes previous result.
|
||
;; MathBox: Enter evaluates. Shift+enter inserts newline.
|
||
;; Parser: plot[function[sin]] Handle parsing of ]] better
|
||
;; Parser: Declare variable: The operator := now expands to define
|
||
;; Parser: f(x):=expr now defines one variable functions
|
||
;; Parser: Handle - in names. _ is converted to -
|
||
;; Editor: Keybinding for bold and italic work.
|
||
;; Editor: Keybindings for λ α β γ δ ε ∆ Λ.
|
||
;; Editor: Gets focus right after start.
|
||
;; Plot: Parameters x-min, x-max, y-min, y-max for plot window.
|
||
;; Plot: Function/macro plot[...] introduced.
|
||
;; Plot: Added plot-horizontal-line and plot-vertical-line.
|
||
;; Plot: Remove old plots when reevaluating math boxes.
|
||
;; Plot: Different colors are used, when the user doesn't specify a color.
|
||
;; NSolve: Implemented bisection and Brent.
|
||
;; Snips: Right-click menu: Evaluation options such output on/off.
|
||
;; Errors: Errors and warnings can be signaled with user-error and user-warning
|
||
;; PlotCanvas: Add "copy plot as image".
|
||
|
||
|
||
;; IDEAS
|
||
|
||
;; Behaviour when dragging parabolas and lines.
|
||
;; http://www.geogebra.org/forum/viewtopic.php?f=22&t=27113
|
||
;; Write API for MathType.
|
||
;; Support copy-paste with MathML ?
|
||
|
||
(require racket/gui framework
|
||
(except-in plot plot points)
|
||
(prefix-in plot: plot)
|
||
"../infix/main.rkt"
|
||
"../infix/parser.rkt"
|
||
(planet williams/science/math)
|
||
"../numeric/root-finding.rkt"
|
||
"../utils/clipboard.rkt")
|
||
|
||
;;;
|
||
;;; NUMERICAL
|
||
;;;
|
||
|
||
(define (nsolve f lower upper)
|
||
(define max-iterations 150)
|
||
(define eps-rel double-epsilon)
|
||
(define eps-abs double-epsilon)
|
||
(define safe-f (λ (x) (if (inexact? x) (f x) (f (->inexact x)))))
|
||
|
||
|
||
(with-handlers ([exn:fail? (λ (e) (user-error (exn-message e)))]
|
||
[(λ (x) #t) (λ (e) (user-error "internal error: nsolve"))])
|
||
(find-root brent-solver safe-f (->inexact lower) (->inexact upper) eps-abs eps-rel 150)))
|
||
|
||
(define (->inexact x)
|
||
(if (exact? x) (exact->inexact x) x))
|
||
|
||
;;;
|
||
;;; GLOBAL VARIABLES
|
||
;;;
|
||
|
||
(define all-math-texts '())
|
||
(define all-renderers '())
|
||
|
||
(define-syntax (add-renderer! stx)
|
||
(syntax-case stx ()
|
||
[(_ expr) #'(set! all-renderers (append all-renderers (list expr)))]))
|
||
|
||
|
||
;;;
|
||
;;; PLOTTING
|
||
;;;
|
||
|
||
(define x-min (make-parameter -10.0))
|
||
(define x-max (make-parameter +10.0))
|
||
(define y-min (make-parameter -10.0))
|
||
(define y-max (make-parameter +10.0))
|
||
(define x-label (make-parameter #f))
|
||
(define y-label (make-parameter #f))
|
||
|
||
(define plot-color (make-parameter 0))
|
||
(define (next-plot-color) (plot-color (add1 (plot-color))))
|
||
|
||
(define (plot-function
|
||
f [x-min #f] [x-max #f] [y-min #f] [y-max #f]
|
||
[color (begin (next-plot-color) (plot-color))]
|
||
[width (line-width)]
|
||
[style (line-style)] [alpha (line-alpha)]
|
||
[label #f] [samples (line-samples)])
|
||
(define (ensure-number-function f)
|
||
(lambda (x)
|
||
(let ([v (f x)])
|
||
(if (number? v) v 0))))
|
||
(add-renderer! (function (ensure-number-function f) x-min x-max
|
||
#:y-min y-min #:y-max y-max
|
||
#:samples samples #:color color
|
||
#:width width #:style style
|
||
#:alpha alpha #:label label)))
|
||
|
||
#;(function f
|
||
[ x-min
|
||
x-max
|
||
#:y-min y-min
|
||
#:y-max y-max
|
||
#:samples samples
|
||
#:color color
|
||
#:width width
|
||
#:style style
|
||
#:alpha alpha
|
||
#:label label])
|
||
|
||
#;(lines vs
|
||
[ #:x-min x-min
|
||
#:x-max x-max
|
||
#:y-min y-min
|
||
#:y-max y-max
|
||
#:color color
|
||
#:width width
|
||
#:style style
|
||
#:alpha alpha
|
||
#:label label])
|
||
|
||
; given points in ps, draws points and connect them with line segments
|
||
(define (plot-lines
|
||
ps [x-min #f] [x-max #f] [y-min #f] [y-max #f]
|
||
[color (line-color)] [width (line-width)]
|
||
[style (line-style)] [alpha (line-alpha)]
|
||
[label #f])
|
||
(let ([vs (map (λ (p) (vector (first p) (second p))) ps)])
|
||
(add-renderer! (lines vs
|
||
#:x-min x-min #:x-max x-max
|
||
#:y-min y-min #:y-max y-max
|
||
#:color color
|
||
#:width width #:style style
|
||
#:alpha alpha #:label label))))
|
||
|
||
(define (plot-vertical-line x0
|
||
[color (line-color)] [width (line-width)]
|
||
[style (line-style)] [alpha (line-alpha)]
|
||
[label #f])
|
||
(plot-lines (list (list x0 (y-min)) (list x0 (y-max)))
|
||
(x-min) (x-max) (y-min) (y-max)
|
||
color width style alpha label))
|
||
|
||
(define (plot-horizontal-line y0
|
||
[color (line-color)] [width (line-width)]
|
||
[style (line-style)] [alpha (line-alpha)]
|
||
[label #f])
|
||
(plot-lines (list (list (x-min) y0) (list (x-max) y0))
|
||
(x-min) (x-max) (y-min) (y-max)
|
||
color width style alpha label))
|
||
|
||
(define (plot-equation f1 f2 solutions
|
||
[x-min #f] [x-max #f] [y-min #f] [y-max #f]
|
||
[color1 (line-color)] [color2 (add1 (line-color))] [width (line-width)]
|
||
[style (line-style)] [alpha (line-alpha)]
|
||
[label #f] [samples (line-samples)])
|
||
(plot-function f1 x-min x-max y-min y-max color1 width style alpha label samples)
|
||
(plot-function f2 x-min x-max y-min y-max color2 width style alpha label samples)
|
||
(for ([x0 (in-list solutions)])
|
||
(let ([y0 (f1 x0)])
|
||
(plot-arrow (list x0 y0) (list x0 0) #:color "black"))))
|
||
|
||
(define (plot-arrow p1 p2 #:color [color (line-color)])
|
||
; Note: Arrow size depends on distance from p1 p2
|
||
; Introduce fixed size?
|
||
(match-define (list x1 y1) p1)
|
||
(match-define (list x2 y2) p2)
|
||
(define dx (- x2 x1))
|
||
(define dy (- y2 y1))
|
||
(define angle (if (and (zero? dy) (zero? dx)) 0 (atan dy dx)))
|
||
(define dist (sqrt (+ (sqr dx) (sqr dy))))
|
||
(define head-r (* 2/5 dist))
|
||
(define head-angle (* 1/6 pi))
|
||
(define dx1 (* (cos (+ angle head-angle)) head-r))
|
||
(define dy1 (* (sin (+ angle head-angle)) head-r))
|
||
(define dx2 (* (cos (- angle head-angle)) head-r))
|
||
(define dy2 (* (sin (- angle head-angle)) head-r))
|
||
(parameterize ([line-color color])
|
||
(plot-lines (list (list x1 y1) (list x2 y2)))
|
||
(plot-lines (list (list x2 y2) (list (- x2 dx1) (- y2 dy1))))
|
||
(plot-lines (list (list x2 y2) (list (- x2 dx2) (- y2 dy2))))))
|
||
|
||
(define-syntax (plot stx)
|
||
(syntax-case stx ()
|
||
[(_ expr)
|
||
#'(plot-function expr) ]
|
||
[(_ expr id)
|
||
#'(plot-function (λ (id) expr))]
|
||
[(_ expr id from to)
|
||
#'(plot-function (λ (id) expr) from to)]
|
||
; TODO: signal error
|
||
))
|
||
|
||
|
||
(define (plot-point-label x y [label #f] [color "black"] [size 10])
|
||
(add-renderer! (point-label (vector x y) label #:color color #:size size)))
|
||
|
||
(define (plot-function-label f x [label #f] [color "black"] [size 10])
|
||
(add-renderer! (function-label f x label #:color color #:size size)))
|
||
|
||
|
||
|
||
#;(function-label
|
||
f x
|
||
[label
|
||
#:color color
|
||
#:size size
|
||
#:family family
|
||
#:anchor anchor
|
||
#:angle angle
|
||
#:point-color point-color
|
||
#:point-fill-color point-fill-color
|
||
#:point-size point-size
|
||
#:point-line-width point-line-width
|
||
#:point-sym point-sym
|
||
#:alpha alpha])
|
||
|
||
|
||
(define (points ps)
|
||
(define (to-vector p)
|
||
(cond [(and (list? p) (= (length p) 2))
|
||
(apply vector p)]
|
||
[else (error 'points "list of length 2 expected, got ~a" p)]))
|
||
(set! all-renderers (cons (plot:points (map to-vector ps)) all-renderers))
|
||
"done")
|
||
|
||
|
||
(define math-text%
|
||
(class* text% ()
|
||
(inherit get-text
|
||
get-start-position
|
||
select-all
|
||
delete
|
||
insert
|
||
set-position
|
||
change-style)
|
||
(super-new)
|
||
(set! all-math-texts (append all-math-texts (list this)))
|
||
|
||
; Activation/Deactivation of evaluation of the math box
|
||
(define is-active? #t) ; #t will
|
||
(define/public (active?) is-active?)
|
||
(define/public (activate) (set! is-active? #t))
|
||
(define/public (deactivate) (set! is-active? #f))
|
||
|
||
(define/override (copy-self)
|
||
(let ([ed (new math-text%)])
|
||
(send ed insert (get-text))
|
||
ed))
|
||
|
||
(define/public (evaluate)
|
||
(let* ([expr (remove-old-evaluation-result (get-text))]
|
||
[val (if is-active? (evaluate-expr expr) #f)]
|
||
[pos (get-start-position)])
|
||
(if val
|
||
(begin
|
||
; normal evaluation
|
||
(select-all)
|
||
(delete)
|
||
(insert expr)
|
||
(change-style red-delta)
|
||
(insert " => ")
|
||
(insert val)
|
||
(when pos
|
||
(set-position pos))
|
||
(send plot-canvas refresh))
|
||
(begin
|
||
; error in expression
|
||
(select-all)
|
||
(delete)
|
||
(insert expr)))))))
|
||
|
||
(define (new-math-snip)
|
||
(let* ([editor (new math-text%)]
|
||
[math-snip (new math-editor-snip% [editor editor])]
|
||
[keymap (send editor get-keymap)])
|
||
(send editor set-max-undo-history 1024)
|
||
; (send math-snip set-style (send text-editor get-style))
|
||
(send editor change-style (let ([∆ (new style-delta%)]) (send ∆ set-delta 'change-size 20) ∆))
|
||
(install-math-snip-keymap math-snip)
|
||
|
||
math-snip))
|
||
|
||
(define math-editor-snip%
|
||
(class* (editor-snip:decorated-mixin editor-snip%) ()
|
||
(inherit get-editor border-visible?
|
||
get-margin get-inset
|
||
get-min-width get-max-width
|
||
get-min-height get-max-height)
|
||
(super-new)
|
||
|
||
(define/override (copy)
|
||
(let* ([math-snip (new math-editor-snip%)]
|
||
[editor (send (get-editor) copy-self)])
|
||
(send math-snip set-editor editor)
|
||
(send editor set-max-undo-history 1024)
|
||
(install-math-snip-keymap math-snip)
|
||
math-snip))
|
||
|
||
(define math-box-menu (new popup-menu% [title "Popupmenu"]))
|
||
(define mi (new menu-item% [label "Deactivate"] [parent math-box-menu]
|
||
[callback (λ (r e)
|
||
(let ([ed (send this get-editor)])
|
||
(if (send ed active?)
|
||
(begin
|
||
(send ed deactivate)
|
||
(send ed evaluate) ; In order to remove old evaluation result
|
||
(send mi set-label "Activate"))
|
||
(begin
|
||
(send ed activate)
|
||
(send mi set-label "Deactivate")))))]))
|
||
|
||
(define/override (on-event dc x y editorx editory ev)
|
||
(if (eq? (send ev get-event-type) 'right-up)
|
||
(send (send this get-admin) popup-menu math-box-menu this
|
||
(- (send ev get-x) editorx) (- (send ev get-y) editory))
|
||
(super on-event dc x y editorx editory ev)))
|
||
|
||
(define/override (get-corner-bitmap)
|
||
(let ([bitmap (make-object bitmap% 15 15)])
|
||
(send (new bitmap-dc% [bitmap bitmap]) draw-text "$" 0 0)
|
||
bitmap))
|
||
(define/override (get-position)
|
||
'left-top)
|
||
))
|
||
|
||
|
||
(define my-text%
|
||
(class* text% ()
|
||
(inherit)
|
||
(super-new)))
|
||
|
||
(define show-x-axis #t)
|
||
(define show-y-axis #t)
|
||
(define show-grid #f)
|
||
|
||
(define-syntax (toggle! stx)
|
||
(syntax-case stx () [(_ id) #'(set! id (not id))]))
|
||
|
||
(define plot-canvas-menu (new popup-menu% [title "Popupmenu"]))
|
||
(new menu-item% [label "Delete all plots"] [parent plot-canvas-menu]
|
||
[callback (λ (r e) (set! all-renderers '()) (send plot-canvas refresh))])
|
||
(define show-hide-menu (new menu% [label "Show/hide"] [parent plot-canvas-menu]))
|
||
(new menu-item% [label "x-axis"] [parent show-hide-menu]
|
||
[callback (λ (r e) (toggle! show-x-axis) (send plot-canvas refresh))])
|
||
(new menu-item% [label "y-axis"] [parent show-hide-menu]
|
||
[callback (λ (r e) (toggle! show-y-axis) (send plot-canvas refresh))])
|
||
(new menu-item% [label "grid"] [parent show-hide-menu]
|
||
[callback (λ (r e) (toggle! show-grid) (send plot-canvas refresh))])
|
||
(new menu-item% [label "Copy as image"] [parent plot-canvas-menu]
|
||
[callback
|
||
(λ (r e)
|
||
(set-clipboard-bitmap
|
||
(let* ([bm (send plot-canvas make-bitmap (send plot-canvas get-width) (send plot-canvas get-height))]
|
||
[dc (new bitmap-dc% [bitmap bm])])
|
||
(draw-plot dc)
|
||
bm)))])
|
||
|
||
|
||
(define plot-canvas%
|
||
(class* canvas% ()
|
||
(super-new)
|
||
(define/override (on-event ev)
|
||
(if (eq? (send ev get-event-type) 'right-up)
|
||
(send plot-canvas popup-menu plot-canvas-menu
|
||
(send ev get-x)
|
||
(send ev get-y))
|
||
(super on-event ev)))))
|
||
|
||
;;;
|
||
;;;
|
||
;;;
|
||
|
||
|
||
(define frame (new frame% [label "Racket CAS"] [width 400] [height 400]))
|
||
(define vertical-panel (new vertical-panel% [parent frame] [stretchable-height #f]))
|
||
(define evaluate-all-button (new button% [parent vertical-panel] [label "Evaluate All"]
|
||
[callback
|
||
(λ (r e)
|
||
(set! all-renderers '())
|
||
(send plot-canvas refresh)
|
||
(for-each (λ (m) (send m evaluate)) all-math-texts)
|
||
(send plot-canvas refresh))]))
|
||
|
||
(define horizontal-panel (new panel:horizontal-dragable% [parent frame]))
|
||
|
||
(define canvas (new editor-canvas% [parent horizontal-panel] [min-width 200] [min-height 200] [vert-margin 10] [horiz-margin 10]))
|
||
(define text-editor (new my-text% ))
|
||
(send text-editor set-max-undo-history 1024)
|
||
(send canvas set-editor text-editor)
|
||
(send text-editor set-styles-sticky #t)
|
||
(send text-editor change-style (let ([∆ (new style-delta%)]) (send ∆ set-delta 'change-size 20) ∆))
|
||
(send text-editor set-caret-owner #f 'global)
|
||
|
||
(define (list-if p . more)
|
||
(if p more '()))
|
||
|
||
(define (draw-plot dc)
|
||
(let ()
|
||
(send dc suspend-flush)
|
||
(plot/dc (append (list-if show-x-axis (x-axis) )
|
||
(list-if show-y-axis (y-axis) )
|
||
(list-if show-grid (x-tick-lines) (y-tick-lines))
|
||
all-renderers)
|
||
dc
|
||
0 0
|
||
(send plot-canvas get-width)
|
||
(send plot-canvas get-height)
|
||
#:x-min (x-min)
|
||
#:x-max (x-max)
|
||
#:x-label (x-label)
|
||
#:y-min (y-min)
|
||
#:y-max (x-max)
|
||
#:y-label (y-label)
|
||
#:title #f)
|
||
(send dc resume-flush)))
|
||
|
||
(define plot-canvas
|
||
(new plot-canvas% [parent horizontal-panel]
|
||
[min-width 200] [min-height 200] [vert-margin 10] [horiz-margin 10]
|
||
[paint-callback (λ (c dc) (draw-plot dc))]))
|
||
|
||
|
||
(define status-panel (new horizontal-panel% [parent frame] [stretchable-height #f] [alignment '(left center)]))
|
||
(define status-message (new message% [parent status-panel] [label "Status:"] [auto-resize #t]))
|
||
|
||
(define menu-bar (new menu-bar% [parent frame]))
|
||
(define menu-edit (new menu% [label "Edit"] [parent menu-bar]))
|
||
(define menu-font (new menu% [label "Font"] [parent menu-bar]))
|
||
(append-editor-operation-menu-items menu-edit #f)
|
||
(append-editor-font-menu-items menu-font)
|
||
|
||
|
||
(application:current-app-name "Racket CAS") ; Appears in help menu
|
||
|
||
|
||
|
||
(define (make-color-delta color)
|
||
(send (make-object style-delta%) set-delta-foreground color))
|
||
|
||
(define red-delta (make-color-delta (make-object color% "red")))
|
||
(define blue-delta (make-color-delta (make-object color% "blue")))
|
||
|
||
(define (remove-old-evaluation-result str)
|
||
(let ([m (regexp-match #rx"(.*) =>.*" str)])
|
||
(if m (second m) str)))
|
||
|
||
(define (evaluate-expr str)
|
||
(with-handlers
|
||
([(λ (e) #t)
|
||
(λ (e) (begin
|
||
(display e) (newline)
|
||
(send status-message set-label
|
||
(format "eval: invalid expression, got ~a" str))
|
||
#f))])
|
||
(format "~a"
|
||
(eval-syntax
|
||
(parse-expression
|
||
(datum->syntax #'here str
|
||
(list 'src-name 1 0 1 (string-length str)))
|
||
(open-input-string str))))))
|
||
|
||
(define (register-greek keymap)
|
||
(define (register name char shortcuts)
|
||
(let ([insert-name (string-append "insert-" name)])
|
||
(send keymap add-function insert-name
|
||
(λ (ed e) (send ed insert char)))
|
||
(for ([shortcut shortcuts])
|
||
(send keymap map-function shortcut insert-name))))
|
||
(register "lambda" #\λ '("d:\\" "c:\\"))
|
||
(register "Lambda" #\Λ '("c:L"))
|
||
(register "alpha" #\α '("c:a"))
|
||
(register "beta" #\β '("c:b")) ; TODO: Taken by bold
|
||
(register "gamma" #\γ '("c:g"))
|
||
(register "delta" #\δ '("c:d"))
|
||
(register "epsilon" #\ε '("c:e"))
|
||
(register "rho" #\ρ '("c:r"))
|
||
(register "Gamma" #\Γ '("c:G"))
|
||
(register "Delta" #\∆ '("c:D")))
|
||
|
||
(define (install-math-snip-keymap math-snip)
|
||
(let ([keymap (send (send math-snip get-editor) get-keymap)])
|
||
|
||
(send keymap add-function "evaluate-math"
|
||
(λ (ed e) (send ed evaluate)))
|
||
(send keymap add-function "left-willing-to-leave"
|
||
(λ (ed e)
|
||
(let ([pos (send ed get-start-position)])
|
||
(if (= pos 0)
|
||
(begin
|
||
(send text-editor set-caret-owner #f)
|
||
(send text-editor set-position
|
||
(send text-editor get-snip-position math-snip)))
|
||
(send ed move-position 'left)))))
|
||
(send keymap add-function "right-willing-to-leave"
|
||
(λ (ed e)
|
||
(let ([pos (send ed get-start-position)])
|
||
(if (= pos (send ed last-position))
|
||
(begin
|
||
(send text-editor set-caret-owner #f)
|
||
(send text-editor set-position
|
||
(+ 1 (send text-editor get-snip-position math-snip))))
|
||
(send ed move-position 'right)))))
|
||
(send keymap add-function "newline"
|
||
(λ (ed e) (send ed insert #\newline)))
|
||
|
||
(register-greek keymap)
|
||
|
||
|
||
(send keymap map-function "s:enter" "newline")
|
||
(send keymap map-function "enter" "evaluate-math")
|
||
(send keymap map-function "~s:left" "left-willing-to-leave")
|
||
(send keymap map-function "~s:right" "right-willing-to-leave")))
|
||
|
||
|
||
|
||
;;;
|
||
;;; KEYBINDINGS FOR THE DOCUMENT EDITOR
|
||
;;;
|
||
|
||
(define keymap (send text-editor get-keymap))
|
||
(register-greek keymap)
|
||
|
||
;(add-editor-keymap-functions keymap)
|
||
;(add-text-keymap-functions keymap)
|
||
|
||
(send keymap add-function "insert-math"
|
||
(λ (in e)
|
||
; get the current selection, if any,
|
||
(let ([start (box #f)] [end (box #f)])
|
||
(send in get-position start end)
|
||
(let ([selected-text
|
||
(if (and (unbox start) (unbox end))
|
||
(send in get-text (unbox start) (unbox end))
|
||
#f)]
|
||
; make a new math-snip, and insert the selected text
|
||
[math-snip (new-math-snip)])
|
||
(send text-editor insert math-snip)
|
||
(send text-editor set-caret-owner math-snip 'display)
|
||
(when selected-text
|
||
(send (send math-snip get-editor) insert selected-text))))))
|
||
|
||
(send keymap add-function "left-willing-to-enter-math-snip"
|
||
(λ (in e)
|
||
; left: if the position before the caret is a math-editor, enter it
|
||
(let* ([pos (send in get-start-position)]
|
||
[snip-pos (box #f)]
|
||
[snip (send in find-snip pos 'before-or-none snip-pos)])
|
||
(if (and snip (is-a? snip math-editor-snip%))
|
||
(begin
|
||
(send in set-caret-owner snip)
|
||
(let ([ed (send snip get-editor)])
|
||
(send ed set-position (send ed last-position))))
|
||
(send in move-position 'left)))))
|
||
|
||
(send keymap add-function "right-willing-to-enter-math-snip"
|
||
(λ (in e)
|
||
; right: if the position after the caret is a math-editor, enter it
|
||
(let* ([pos (send in get-start-position)]
|
||
[snip-pos (box #f)]
|
||
[snip (send in find-snip pos 'after-or-none snip-pos)])
|
||
(if (and snip
|
||
(is-a? snip editor-snip%)
|
||
(is-a? (send snip get-editor) math-text%))
|
||
(begin
|
||
(send in set-caret-owner snip)
|
||
(let ([ed (send snip get-editor)])
|
||
(send ed set-position 0)))
|
||
(send in move-position 'right)))))
|
||
(send keymap add-function "bold"
|
||
(λ (in e)
|
||
; TODO: twice => toggle
|
||
(send text-editor change-style
|
||
(make-object style-delta% 'change-weight 'bold))))
|
||
(send keymap add-function "italic"
|
||
(λ (in e)
|
||
; TODO: twice => toggle
|
||
(send text-editor change-style
|
||
(make-object style-delta% 'change-style 'italic))))
|
||
|
||
|
||
(send keymap map-function "c:m" "insert-math")
|
||
(send keymap map-function "d:m" "insert-math") ; OS X cmd
|
||
(send keymap map-function "~s:left" "left-willing-to-enter-math-snip")
|
||
(send keymap map-function "~s:right" "right-willing-to-enter-math-snip")
|
||
(send keymap map-function "c:b" "bold") ; Win ctrl
|
||
(send keymap map-function "d:b" "bold") ; OS X cmd
|
||
(send keymap map-function "c:i" "italic") ; Win ctrl
|
||
(send keymap map-function "d:i" "italic") ; OS X cmd
|
||
|
||
;;;
|
||
;;; ERRORS AND WARNINGS
|
||
;;;
|
||
|
||
(define (user-error text)
|
||
(let ([msg (format "ERROR: ~a" text)])
|
||
(send status-message set-label msg)
|
||
msg))
|
||
|
||
(define (user-warning text)
|
||
(let ([msg (format "WARNING: ~a" text)])
|
||
(send status-message set-label msg)
|
||
msg))
|
||
|
||
;;;
|
||
;;; BIG BANG
|
||
;;;
|
||
|
||
; (send frame create-status-line)
|
||
; (send frame set-status-text "Ready")
|
||
(send frame maximize #t)
|
||
(send frame show #t)
|
||
|
||
; (graphical-read-eval-print-loop)
|
||
|