From 41ff0577d719984e697e558f56855e00cbdb44c0 Mon Sep 17 00:00:00 2001 From: Claudio Maggioni Date: Wed, 5 Dec 2018 16:25:29 +0100 Subject: [PATCH] Added run input box to gui with 'consuming' input --- gui.rkt | 110 +++++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 82 insertions(+), 28 deletions(-) diff --git a/gui.rkt b/gui.rkt index 7bb6565..0d4e28c 100644 --- a/gui.rkt +++ b/gui.rkt @@ -2,52 +2,80 @@ (require "interpreter.rkt" framework - racket/set) + racket/set + racket/block) ; 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% +(define F (new frame% [label "DrBrainf*ck"] [width EDITOR-WIDTH] [height EDITOR-HEIGHT])) -; execute-content: ((ProgState) -> Any) -> ProgState +; execute-content: ((ProgState) -> _) -> _ ; Given a callback, calls the callback with the last state of execution of the ; program loaded in the editor (define (execute-content done) (execute (program->prog-state (string->program - (send editor get-flattened-text))) - done (lambda (callback) (callback 50)))) + (send EDITOR get-flattened-text))) + done on-input)) + +; on-input: (Byte -> _) -> _ +; Given a a callback to resume execution, sets up the run input area (callback +; included). +(define (on-input callback) + (send RUN-INPUT set-field-background run-col) + (if (non-empty-string? (send RUN-INPUT get-value)) + (on-input-done callback) + (set! input-done-cb (lambda (_ __) (on-input-done callback))))) + +; on-input-done: (Byte -> _) -> _ +; Given a callback to resume execution, fetches the first character from +; `RUN-INPUT` "consuming" it and resumes execution. +(define (on-input-done callback) + (define old-str (send RUN-INPUT get-value)) + ; Continue only if there is input + (if (non-empty-string? old-str) + (block + ; Disable input callback + (set! input-done-cb (lambda (_ __) (void))) + ; Pick first char from run input "consuming" it + (define in (string-ref old-str 0)) + (define new-str (substring old-str 1)) + (send RUN-INPUT set-value new-str) + ; Remove waiting color from run-input + (send RUN-INPUT set-field-background in-done-col) + ; Resume execution + (callback (char->integer in))) + (void))) ; 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) - + (send RUN-OUTPUT set-value "") + (send RUN-OUTPUT set-field-background run-col) ; run the program (execute-content (lambda (ps) (define out (prog-state-output ps)) - ; set output and change color to ended - (send run-output set-value out) - (send run-output set-field-background end-col)))) + (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] +(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])) +(define C (new editor-canvas% [parent F])) ; Definition of editor text object. (define text-pro% (text:line-numbers-mixin @@ -55,10 +83,10 @@ (color:text-mixin (text:basic-mixin (editor:basic-mixin text%)))))) -(define editor (new text-pro%)) +(define EDITOR (new text-pro%)) ; Show line numbers in editor -(send editor show-line-numbers! #t) +(send EDITOR show-line-numbers! #t) ; A BFToken is one of: ; - 'comment @@ -99,7 +127,7 @@ (values 1str bf-token #f (+ pos) (+ pos 1))])) ; Syntax highlighting for brainf*ck -(send editor start-colorer bf-token->bf-style bf-lexer '()) +(send EDITOR start-colorer bf-token->bf-style bf-lexer '()) ; Define basic style for instructions (+ - , .) (define delta (make-object style-delta%)) @@ -118,31 +146,57 @@ (send delta set-delta-foreground "orange") (editor:set-standard-style-list-delta "Comment" delta) +; Input done color +(define in-done-col (make-object color% 255 255 255)) + ; 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])) +; Populate menu bar +(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 input horizontal panel +(define input-panel + (new horizontal-panel% + [parent F] + [min-height 50] + [stretchable-height #f])) + +; Input needed in program execution +(define RUN-INPUT (new text-field% + [label "Execution input:"] + [parent input-panel])) + +; The input done callback (defaults to nothing) +; Type: (Button Event) -> _ +(define input-done-cb (lambda (ev) (void))) + +; Definition of the run button widget +(define INPUT-DONE-BTN (new button% + [parent input-panel] + [label "Confirm"] + [callback (lambda (btn ev) (input-done-cb btn ev))])) ; The run output text object -(define run-output (new text-field% +(define RUN-OUTPUT (new text-field% [style (list 'multiple 'vertical-label)] [label "Execution output:"] - [parent f])) - + [parent F])) + (define mi-open (new menu-item% [label "Open"] [parent m-file] [callback (lambda (i e) - (define path (get-file #f f)) + (define path (get-file #f F)) (when path - (send editor load-file path 'text)))] + (send EDITOR load-file path 'text)))] [shortcut #\o] [shortcut-prefix '(ctl)])) @@ -152,11 +206,11 @@ [parent m-file] [callback (lambda (i e) - (send editor save-file #f 'text))] + (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) \ No newline at end of file +(send EDITOR set-max-undo-history 100) +(send C set-editor EDITOR) +(send F show #t) \ No newline at end of file