158 lines
No EOL
4.8 KiB
Racket
158 lines
No EOL
4.8 KiB
Racket
#lang racket/gui
|
|
|
|
(require "interpreter.rkt"
|
|
framework
|
|
racket/set)
|
|
|
|
; The editor width in pixels
|
|
(define EDITOR-WIDTH 600)
|
|
(define EDITOR-HEIGHT 600)
|
|
|
|
; The frame racket/gui base object for the editor
|
|
(define f (new frame%
|
|
[label "DrBrainf*ck"]
|
|
[width EDITOR-WIDTH]
|
|
[height EDITOR-HEIGHT]))
|
|
|
|
; execute-content: () -> ProgState
|
|
; Returns the last state of execution of the program loaded in the editor
|
|
(define (execute-content)
|
|
(execute
|
|
(program->prog-state
|
|
(string->program
|
|
(send editor get-flattened-text)))))
|
|
|
|
; run-program: Button ControlEvent -> Nothing
|
|
; Given a button and an event, runs the program currently loaded in the editor.
|
|
(define (run-program button event)
|
|
; empty output text and set color to running
|
|
(send run-output set-value "")
|
|
(send run-output set-field-background run-col)
|
|
|
|
; run the program
|
|
(define out (prog-state-output (execute-content)))
|
|
|
|
; set output and change color to ended
|
|
(send run-output set-value out)
|
|
(send run-output set-field-background end-col))
|
|
|
|
; Definition of the run button widget
|
|
(define run-btn (new button% [parent f]
|
|
[label "Run"]
|
|
; Callback procedure for a button click:
|
|
[callback run-program]))
|
|
|
|
; Definition of the editor canves
|
|
(define c (new editor-canvas% [parent f]))
|
|
|
|
; Definition of editor text object.
|
|
(define text-pro% (text:line-numbers-mixin
|
|
(editor:standard-style-list-mixin
|
|
(color:text-mixin
|
|
(text:basic-mixin
|
|
(editor:basic-mixin text%))))))
|
|
(define editor (new text-pro%))
|
|
|
|
; Show line numbers in editor
|
|
(send editor show-line-numbers! #t)
|
|
|
|
; A BFToken is one of:
|
|
; - 'comment
|
|
; - 'instruction
|
|
; - 'shift
|
|
; - 'loop
|
|
; Interp: category of a bf program token
|
|
|
|
; A BFStyle is one of:
|
|
; - "Comment"
|
|
; - "Instruction"
|
|
; - "Shift"
|
|
; - "Loop"
|
|
; Interp: name of the style for a bf program token
|
|
|
|
; bf-token->bf-style: BFToken -> BFStyle
|
|
; Given a BFToken, returns the corresponding BFStyle.
|
|
(define (bf-token->bf-style token)
|
|
(cond [(symbol=? token 'comment) "Comment"]
|
|
[(symbol=? token 'loop) "Loop"]
|
|
[(symbol=? token 'shift) "Shift"]
|
|
[(symbol=? token 'instruction) "Instruction"]))
|
|
|
|
; bf-lexer: InputPort -> (values 1String BFToken #f Option<Nat> Option<Nat>)
|
|
; Given an input port, returns the BFToken of the instruction pointed by the
|
|
; port.
|
|
(define (bf-lexer port)
|
|
(define-values (_ __ pos) (port-next-location port))
|
|
(define c (read-char port))
|
|
(cond [(eof-object? c) (values c 'eof #f #f #f)]
|
|
[else
|
|
(define 1str (string c))
|
|
(define bf-token
|
|
(cond [(set-member? (set "+" "-" "," ".") 1str) 'instruction]
|
|
[(set-member? (set "<" ">") 1str) 'shift]
|
|
[(set-member? (set "[" "]") 1str) 'loop]
|
|
[else 'comment]))
|
|
(values 1str bf-token #f (+ pos) (+ pos 1))]))
|
|
|
|
; Syntax highlighting for brainf*ck[(symbol=? token 'loop) "Loop"]
|
|
(send editor start-colorer bf-token->bf-style bf-lexer '())
|
|
|
|
; Define basic style for instructions (+ - , .)
|
|
(define delta (make-object style-delta%))
|
|
(send delta set-delta-foreground "blue")
|
|
(editor:set-standard-style-list-delta "Instruction" delta)
|
|
|
|
; Define style for shifting operations (< >)
|
|
(send delta set-delta-foreground "red")
|
|
(editor:set-standard-style-list-delta "Shift" delta)
|
|
|
|
; Define basic style for looping instructions ([ ])
|
|
(send delta set-delta-foreground "forestgreen")
|
|
(editor:set-standard-style-list-delta "Loop" delta)
|
|
|
|
; Define style of comments
|
|
(send delta set-delta-foreground "orange")
|
|
(editor:set-standard-style-list-delta "Comment" delta)
|
|
|
|
; Running output color
|
|
(define run-col (make-object color% 250 250 200))
|
|
|
|
; Output completed color
|
|
(define end-col (make-object color% 200 250 200))
|
|
|
|
(define mb (new menu-bar% [parent f]))
|
|
(define m-file (new menu% [label "File"] [parent mb]))
|
|
(define m-edit (new menu% [label "Edit"] [parent mb]))
|
|
|
|
; The run output text object
|
|
(define run-output (new text-field%
|
|
[style (list 'multiple 'vertical-label)]
|
|
[label "Execution output:"]
|
|
[parent f]))
|
|
|
|
(define mi-open
|
|
(new menu-item%
|
|
[label "Open"]
|
|
[parent m-file]
|
|
[callback
|
|
(lambda (i e)
|
|
(define path (get-file #f f))
|
|
(when path
|
|
(send editor load-file path 'text)))]
|
|
[shortcut #\o]
|
|
[shortcut-prefix '(ctl)]))
|
|
|
|
(define mi-save
|
|
(new menu-item%
|
|
[label "Save"]
|
|
[parent m-file]
|
|
[callback
|
|
(lambda (i e)
|
|
(send editor save-file #f 'text))]
|
|
[shortcut #\s]
|
|
[shortcut-prefix '(ctl)]))
|
|
|
|
(append-editor-operation-menu-items m-edit #f)
|
|
(send editor set-max-undo-history 100)
|
|
(send c set-editor editor)
|
|
(send f show #t) |