74 lines
2 KiB
Racket
74 lines
2 KiB
Racket
|
#lang racket/gui
|
||
|
|
|
||
|
|
(require "main.rkt")
|
||
|
|
|
||
|
|
; 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: -> World
|
||
|
|
; Returns the last state of execution of the program loaded in the editor
|
||
|
|
(define (execute-content)
|
||
|
|
(execute
|
||
|
|
(program->world
|
||
|
|
(string->program
|
||
|
|
(send t get-flattened-text)))))
|
||
|
|
|
||
|
|
; The run button
|
||
|
|
(define button (new button% [parent f]
|
||
|
|
[label "Run"]
|
||
|
|
; Callback procedure for a button click:
|
||
|
|
[callback (lambda (button event)
|
||
|
|
(send
|
||
|
|
output set-label
|
||
|
|
(world-output (execute-content))))]))
|
||
|
|
|
||
|
|
(define c (new editor-canvas% [parent f]))
|
||
|
|
|
||
|
|
; The editor text object
|
||
|
|
(define t (new text%))
|
||
|
|
|
||
|
|
; Change font to monospace
|
||
|
|
(define style-delta (make-object style-delta% 'change-family 'modern))
|
||
|
|
(send t change-style style-delta)
|
||
|
|
|
||
|
|
(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]))
|
||
|
|
|
||
|
|
; Make a static text message in the frame
|
||
|
|
(define output (new message% [parent f]
|
||
|
|
[label "Click run to get output"]))
|
||
|
|
|
||
|
|
(define mi-open
|
||
|
|
(new menu-item%
|
||
|
|
[label "Open"]
|
||
|
|
[parent m-file]
|
||
|
|
[callback
|
||
|
|
(lambda (i e)
|
||
|
|
(define path (get-file #f f))
|
||
|
|
(when path
|
||
|
|
(send t 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 t save-file #f 'text))]
|
||
|
|
[shortcut #\s]
|
||
|
|
[shortcut-prefix '(ctl)]))
|
||
|
|
|
||
|
|
(append-editor-operation-menu-items m-edit #f)
|
||
|
|
(send t set-max-undo-history 100)
|
||
|
|
(send c set-editor t)
|
||
|
|
(send f show #t)
|