diff --git a/gui.rkt b/gui.rkt index 27d3316..7088a53 100644 --- a/gui.rkt +++ b/gui.rkt @@ -4,7 +4,8 @@ (require "interpreter.rkt" framework racket/set - racket/block) + racket/block + rackunit) ; The editor width in pixels (define EDITOR-WIDTH 600) @@ -46,6 +47,9 @@ (define init (program->prog-state (string->program (send EDITOR get-flattened-text)))) + ; Put initial ProgState in step-stack + (set! step-stack (cons init '())) + ; Execute step (execute-instr init after-run on-input)] [(cons? step-stack) (execute-instr (first step-stack) after-run on-input)])) @@ -112,7 +116,6 @@ ; run the step (fun-to-run (lambda (ps) - (print step-stack) (update-state-gui ps) (send RUN-OUTPUT set-field-background in-done-col)))) @@ -131,6 +134,7 @@ (new horizontal-panel% [parent F] [min-height 50] + [alignment (list 'center 'center)] [stretchable-height #f])) ; Definition of the run button widget @@ -138,14 +142,18 @@ [label "Run"] ; Callback procedure for a button click: [callback run-program])) -(define BSTEP-BTN (new button% [parent BUTTON-PANEL] - [label "Step Back"] - ; Callback procedure for a button click: - [callback run-step])) +(define STEP-BACK-BTN (new button% [parent BUTTON-PANEL] + [label "Step Back"] + ; Callback procedure for a button click: + [callback run-step])) (define STEP-BTN (new button% [parent BUTTON-PANEL] - [label "Step Fwd"] - ; Callback procedure for a button click: - [callback run-step])) + [label "Step Fwd"] + ; Callback procedure for a button click: + [callback run-step])) +(define STEP-STOP-BTN (new button% [parent BUTTON-PANEL] + [label "Stop Step"] + ; Callback procedure for a button click: + [callback (lambda (_ __) (set! step-stack '()))])) ; Definition of the editor canves (define C (new editor-canvas% [parent F])) @@ -168,6 +176,13 @@ ; - 'loop ; Interp: category of a bf program token +; Template for BFToken +#; (define (fn-for-bf-token t) +#; (cond [(symbol=? t 'comment) ...] +#; [(symbol=? t 'instruction) ...] +#; [(symbol=? t 'shift) ...] +#; [(symbol=? t 'loop) ...])) + ; A BFStyle is one of: ; - "Comment" ; - "Instruction" @@ -175,6 +190,13 @@ ; - "Loop" ; Interp: name of the style for a bf program token +; Template for BFToken +#; (define (fn-for-bf-style t) +#; (cond [(string=? t "Comment") ...] +#; [(string=? t "Instruction") ...] +#; [(string=? t "Shift") ...] +#; [(string=? t "Loop") ...])) + ; bf-token->bf-style: BFToken -> BFStyle ; Given a BFToken, returns the corresponding BFStyle. (define (bf-token->bf-style token) @@ -183,6 +205,12 @@ [(symbol=? token 'shift) "Shift"] [(symbol=? token 'instruction) "Instruction"])) +; Tests for bf-token->bf-style +(check-equal? (bf-token->bf-style 'comment) "Comment") +(check-equal? (bf-token->bf-style 'loop) "Loop") +(check-equal? (bf-token->bf-style 'shift) "Shift") +(check-equal? (bf-token->bf-style 'instruction) "Instruction") + ; bf-lexer: InputPort -> (values 1String BFToken #f Option Option) ; Given an input port, returns the BFToken of the instruction pointed by the ; port. @@ -197,26 +225,64 @@ [(set-member? (set "<" ">") 1str) 'shift] [(set-member? (set "[" "]") 1str) 'loop] [else 'comment])) - (values 1str bf-token #f (+ pos) (+ pos 1))])) + (values 1str bf-token #f pos (+ pos 1))])) -; Syntax highlighting for brainf*ck +; Tests from bf-lexer +(begin + (let ([program-port (open-input-string "+--+++Comment[]")]) + (define-values (a b c d e) (bf-lexer program-port)) + (check-equal? a "+") + (check-equal? b 'instruction) + (check-equal? c #f) + (check-equal? d 1) + (check-equal? e 2))) +(begin + (let ([program-port (open-input-string "--")]) + (define-values (a b c d e) (bf-lexer program-port)) + (check-equal? a "-") + (check-equal? b 'instruction) + (check-equal? c #f) + (check-equal? d 1) + (check-equal? e 2))) +(begin + (let ([program-port (open-input-string "Comments!")]) + (define-values (a b c d e) (bf-lexer program-port)) + (check-equal? a "C") + (check-equal? b 'comment) + (check-equal? c #f) + (check-equal? d 1) + (check-equal? e 2))) +(begin + (let ([program-port (open-input-string "Car<>")]) + ; Use the input port three times to use bf-lexer on the "<" char + (let-values ([(_ __ ___) (port-next-location program-port)]) (void)) + (let-values ([(_ __ ___) (port-next-location program-port)]) (void)) + (let-values ([(_ __ ___) (port-next-location program-port)]) (void)) + (define-values (a b c d e) (bf-lexer program-port)) + (check-equal? a "C") + (check-equal? b 'comment) + (check-equal? c #f) + (check-equal? d 1) + (check-equal? e 2))) + +; Enable syntax highlighting for brainf*ck (with lexer) (send EDITOR start-colorer bf-token->bf-style bf-lexer '()) -; Define basic style for instructions (+ - , .) +; Define style for instructions (+ - , .) (define delta (make-object style-delta%)) -(send delta set-delta-foreground "blue") +(void (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") +(void (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") +; Define style for looping instructions ([ ]) +(void (send delta set-delta-foreground "forestgreen")) (editor:set-standard-style-list-delta "Loop" delta) ; Define style of comments -(send delta set-delta-foreground "orange") +(void (send delta set-delta-foreground "orange")) (editor:set-standard-style-list-delta "Comment" delta) ; Input done color @@ -228,11 +294,6 @@ ; Output completed color (define end-col (make-object color% 200 250 200)) -; 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 tape panel (define tape-panel (new horizontal-panel% @@ -257,7 +318,7 @@ (send c set-canvas-background (if hl end-col run-col)) (send dc draw-text (send c get-label) 12.5 10) (send dc draw-text content 12.5 30))])) - + ; make-tape-cells: ProgState -> _ ; Given a ProgState, empties the data tape inspector and creates the ; corresponding cells as canvasas in the tape inspector. @@ -296,10 +357,18 @@ [label "Execution output:"] [parent F])) -(define mi-open +; Populate menu bar +(define MB (new menu-bar% [parent F])) + +; Create "File" and "Edit" menu "lists" +(define FILE-MENU (new menu% [label "File"] [parent MB])) +(define EDIT-MENU (new menu% [label "Edit"] [parent MB])) + +; Menu element for opening a new file +(define MENU-OPEN (new menu-item% [label "Open"] - [parent m-file] + [parent FILE-MENU] [callback (lambda (i e) (define path (get-file #f F)) @@ -307,18 +376,24 @@ (send EDITOR load-file path 'text)))] [shortcut #\o] [shortcut-prefix '(ctl)])) - -(define mi-save + +; Menu element for saving the current file +(define MENU-SAVE (new menu-item% [label "Save"] - [parent m-file] + [parent FILE-MENU] [callback (lambda (i e) (send EDITOR save-file #f 'text))] [shortcut #\s] [shortcut-prefix '(ctl)])) - -(append-editor-operation-menu-items m-edit #f) + +; Add default menu elements to "edit" menu +(append-editor-operation-menu-items EDIT-MENU #f) + +; Set max undo history for editor (send EDITOR set-max-undo-history 100) + +; Init editor (send C set-editor EDITOR) (send F show #t)