Added run input box to gui with 'consuming' input

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)))
+     (send EDITOR get-flattened-text)))
-   done (lambda (callback) (callback 50))))
+   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-value "")
-  (send run-output set-field-background run-col)
+  (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-value out)
-     (send run-output set-field-background end-col))))
+     (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,21 +146,47 @@
 (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]))
+; Populate menu bar
-(define m-file (new menu% [label "File"] [parent mb]))
+(define MB (new menu-bar% [parent F]))
-(define m-edit (new menu% [label "Edit"] [parent mb]))
+(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%
@@ -140,9 +194,9 @@
        [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 EDITOR set-max-undo-history 100)
-(send c set-editor editor)
+(send C set-editor EDITOR)
-(send f show #t)
+(send F show #t)