Added funky gui
This commit is contained in:
Claudio Maggioni
parent
0562b4b1b5
commit
0c80119f47
|
|
@ -0,0 +1,74 @@
|
|||
#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)
|
||||
143
main.rkt
143
main.rkt
|
|
@ -1,13 +1,27 @@
|
|||
;; The first three lines of this file were inserted by DrRacket. They record metadata
|
||||
;; about the language level of this file in a form that our tools can easily process.
|
||||
#reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname main) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f)))
|
||||
; 2018-11-21 - Made by Claudio Maggioni - Tommaso Rodolfo Masera
|
||||
#lang racket
|
||||
|
||||
; 2018-11-21 - Made by Claudio Maggioni - Tommaso Rodolfo Masera
|
||||
; easybf
|
||||
|
||||
(require racket/base)
|
||||
(require racket/struct)
|
||||
(require test-engine/racket-tests)
|
||||
(require 2htdp/batch-io)
|
||||
(require 2htdp/image)
|
||||
(require 2htdp/universe)
|
||||
|
||||
(provide main)
|
||||
(provide world)
|
||||
(provide world?)
|
||||
(provide world-tape)
|
||||
(provide world-dp)
|
||||
(provide world-output)
|
||||
(provide world-program)
|
||||
(provide world-ip)
|
||||
(provide execute)
|
||||
(provide string->program)
|
||||
(provide program->world)
|
||||
|
||||
; A Byte is an Int between 0 and 255
|
||||
; Interpretation: a byte in decimal notation.
|
||||
|
||||
|
|
@ -31,7 +45,7 @@
|
|||
; A InstructionPointer (IP) is a NonNegInt
|
||||
; Interpretation: a pointer to the instruction to execute.
|
||||
|
||||
; A World is a (make-world tape dp output program ip) where:
|
||||
; A World is a (world tape dp output program ip) where:
|
||||
; - tape: Tape
|
||||
; - dp: DataPointer
|
||||
; - tape-len: Nat
|
||||
|
|
@ -39,27 +53,39 @@
|
|||
; - program: Program
|
||||
; - ip: InstructionPointer
|
||||
; Interpretation: the current state of execution of a brainf*ck program.
|
||||
(define-struct world [tape dp tape-len output program ip])
|
||||
(struct world (tape dp tape-len output program ip)
|
||||
#:transparent
|
||||
#:methods gen:custom-write
|
||||
[(define write-proc
|
||||
(make-constructor-style-printer
|
||||
(lambda (w) 'world)
|
||||
(lambda (w) (list (world-tape w)
|
||||
(world-dp w)
|
||||
(world-tape-len w)
|
||||
(world-output w)
|
||||
(world-program w)
|
||||
(world-ip w)))))])
|
||||
|
||||
; Template function for World
|
||||
(define (fn-for-world w)
|
||||
(... (world-tape w)
|
||||
(world-dp w)
|
||||
(world-tape-len w)
|
||||
(world-output w)
|
||||
(world-program w)
|
||||
(world-ip w)))
|
||||
#;(define (fn-for-world w)
|
||||
#; (... (world-tape w)
|
||||
#; (world-dp w)
|
||||
#; (world-tape-len w)
|
||||
#; (world-output w)
|
||||
#; (world-program w)
|
||||
#; (world-ip w)))
|
||||
|
||||
; string->program: String -> Program
|
||||
; Given a string, returns a b(world-dp-len w)f program without
|
||||
; any invalid character
|
||||
(define (string->program s)
|
||||
(local [; valid-char: 1String -> Boolean
|
||||
(local [; valid-char: Char -> Boolean
|
||||
; Given a valid-char, returns #t if the character is a valid bf
|
||||
; instruction.
|
||||
(define (valid-char? s)
|
||||
(member? s '(">" "<" "+" "-" "," "." "[" "]")))]
|
||||
(implode (filter valid-char? (explode s)))))
|
||||
(ormap (lambda (x) (char=? s x))
|
||||
'(#\> #\< #\+ #\- #\, #\. #\[ #\])))]
|
||||
(list->string (filter valid-char? (string->list s)))))
|
||||
|
||||
; Tests for string->program
|
||||
(check-expect (string->program "hello") "")
|
||||
|
|
@ -88,10 +114,10 @@
|
|||
; program->world: Program -> World
|
||||
; Given a program, returns the corresponding initial world state.
|
||||
(define (program->world p)
|
||||
(make-world (cons 0 '()) 0 1 "" p 0))
|
||||
(world (cons 0 '()) 0 1 "" p 0))
|
||||
|
||||
; Tests for program->world
|
||||
(check-expect (program->world "[->+<]") (make-world (list 0) 0 1 "" "[->+<]" 0))
|
||||
(check-expect (program->world "[->+<]") (world (list 0) 0 1 "" "[->+<]" 0))
|
||||
|
||||
; tape-help: Tape DP (Byte -> Byte) -> Tape
|
||||
; Given a tape and a data pointer, returns the same tape with the data in the
|
||||
|
|
@ -107,7 +133,7 @@
|
|||
; exec-add1: World -> World
|
||||
; Given a world, returns a new world with the + instruction executed
|
||||
(define (exec-add1 w)
|
||||
(make-world (tape-help (world-tape w) (world-dp w) add1-byte)
|
||||
(world (tape-help (world-tape w) (world-dp w) add1-byte)
|
||||
(world-dp w)
|
||||
(world-tape-len w)
|
||||
(world-output w)
|
||||
|
|
@ -115,17 +141,17 @@
|
|||
(add1 (world-ip w))))
|
||||
|
||||
; Tests for exec-add1
|
||||
(check-expect (exec-add1 (make-world
|
||||
(check-expect (exec-add1 (world
|
||||
(list 1 2 3 4 5 6 7) 3 7 "" "+" 0))
|
||||
(make-world (list 1 2 3 5 5 6 7) 3 7 "" "+" 1))
|
||||
(check-expect (exec-add1 (make-world
|
||||
(world (list 1 2 3 5 5 6 7) 3 7 "" "+" 1))
|
||||
(check-expect (exec-add1 (world
|
||||
(list 255 1 2 3) 0 4 "" "+" 0))
|
||||
(make-world (list 0 1 2 3) 0 4 "" "+" 1))
|
||||
(world (list 0 1 2 3) 0 4 "" "+" 1))
|
||||
|
||||
; exec-sub1: World -> World
|
||||
; Given a world, returns a new world with the - instruction executed
|
||||
(define (exec-sub1 w)
|
||||
(make-world (tape-help (world-tape w) (world-dp w) sub1-byte)
|
||||
(world (tape-help (world-tape w) (world-dp w) sub1-byte)
|
||||
(world-dp w)
|
||||
(world-tape-len w)
|
||||
(world-output w)
|
||||
|
|
@ -133,19 +159,19 @@
|
|||
(add1 (world-ip w))))
|
||||
|
||||
; Tests for exec-sub1
|
||||
(check-expect (exec-sub1 (make-world
|
||||
(check-expect (exec-sub1 (world
|
||||
(list 1 2 3 4 5 6 7) 3 7 "" "-" 0))
|
||||
(make-world (list 1 2 3 3 5 6 7) 3 7 "" "-" 1))
|
||||
(check-expect (exec-sub1 (make-world
|
||||
(world (list 1 2 3 3 5 6 7) 3 7 "" "-" 1))
|
||||
(check-expect (exec-sub1 (world
|
||||
(list 0 1 2 3) 0 4 "" "-" 0))
|
||||
(make-world (list 255 1 2 3) 0 4 "" "-" 1))
|
||||
(world (list 255 1 2 3) 0 4 "" "-" 1))
|
||||
|
||||
; exec-tape-left: World -> World
|
||||
; Given a world, returns a new world with the < instruction executed
|
||||
(define (exec-tape-left w)
|
||||
(if (zero? (world-dp w))
|
||||
(error "Can't access negative tape positions")
|
||||
(make-world (world-tape w)
|
||||
(world (world-tape w)
|
||||
(sub1 (world-dp w))
|
||||
(world-tape-len w)
|
||||
(world-output w)
|
||||
|
|
@ -153,15 +179,15 @@
|
|||
(add1 (world-ip w)))))
|
||||
|
||||
; Tests for exec-tape-left
|
||||
(check-error (exec-tape-left (make-world (list 1 2 3) 0 3 "" "<" 0)))
|
||||
(check-expect (exec-tape-left (make-world (list 1 2 3) 2 3 "" "<" 0))
|
||||
(make-world (list 1 2 3) 1 3 "" "<" 1))
|
||||
(check-error (exec-tape-left (world (list 1 2 3) 0 3 "" "<" 0)))
|
||||
(check-expect (exec-tape-left (world (list 1 2 3) 2 3 "" "<" 0))
|
||||
(world (list 1 2 3) 1 3 "" "<" 1))
|
||||
|
||||
; exec-tape-right: World -> World
|
||||
; Given a world, returns a new world with the > instruction executed
|
||||
(define (exec-tape-right w)
|
||||
(local [(define end-of-tape (= (world-dp w) (sub1 (world-tape-len w))))]
|
||||
(make-world
|
||||
(world
|
||||
(if end-of-tape
|
||||
(append (world-tape w) (list 0))
|
||||
(world-tape w))
|
||||
|
|
@ -174,15 +200,15 @@
|
|||
(add1 (world-ip w)))))
|
||||
|
||||
; Tests for exec-tape-right
|
||||
(check-expect (exec-tape-right (make-world (list 1 2 3) 0 3 "" ">" 0))
|
||||
(make-world (list 1 2 3) 1 3 "" ">" 1))
|
||||
(check-expect (exec-tape-right (make-world (list 0 1 2) 2 3 "" ">" 0))
|
||||
(make-world (list 0 1 2 0) 3 4 "" ">" 1))
|
||||
(check-expect (exec-tape-right (world (list 1 2 3) 0 3 "" ">" 0))
|
||||
(world (list 1 2 3) 1 3 "" ">" 1))
|
||||
(check-expect (exec-tape-right (world (list 0 1 2) 2 3 "" ">" 0))
|
||||
(world (list 0 1 2 0) 3 4 "" ">" 1))
|
||||
|
||||
; exec-out: World -> World
|
||||
; Given a world, returns a new world with the . instruction executed
|
||||
(define (exec-out w)
|
||||
(make-world
|
||||
(world
|
||||
(world-tape w)
|
||||
(world-dp w)
|
||||
(world-tape-len w)
|
||||
|
|
@ -194,10 +220,10 @@
|
|||
(add1 (world-ip w))))
|
||||
|
||||
; Tests for exec-out
|
||||
(check-expect (exec-out (make-world (list 50) 0 1 "" ".[->+<]" 0))
|
||||
(make-world (list 50) 0 1 "2" ".[->+<]" 1))
|
||||
(check-expect (exec-out (make-world (list 65) 0 1 "" ".[->+<]" 0))
|
||||
(make-world (list 65) 0 1 "A" ".[->+<]" 1))
|
||||
(check-expect (exec-out (world (list 50) 0 1 "" ".[->+<]" 0))
|
||||
(world (list 50) 0 1 "2" ".[->+<]" 1))
|
||||
(check-expect (exec-out (world (list 65) 0 1 "" ".[->+<]" 0))
|
||||
(world (list 65) 0 1 "A" ".[->+<]" 1))
|
||||
|
||||
; char-at: String Nat -> 1String
|
||||
; Given a string and an index, returns the 1String at the position pointed by
|
||||
|
|
@ -231,7 +257,7 @@
|
|||
; Given a world, returns a new world with the [ instruction executed
|
||||
(define (exec-loop-start w)
|
||||
(local [(define jump (zero? (list-ref (world-tape w) (world-dp w))))]
|
||||
(make-world
|
||||
(world
|
||||
(world-tape w)
|
||||
(world-dp w)
|
||||
(world-tape-len w)
|
||||
|
|
@ -243,17 +269,17 @@
|
|||
|
||||
; Tests for exec-loop-start
|
||||
(check-expect (exec-loop-start
|
||||
(make-world '(0) 0 1 "" "[++--]++--+-[]" 0))
|
||||
(make-world '(0) 0 1 "" "[++--]++--+-[]" 6))
|
||||
(world '(0) 0 1 "" "[++--]++--+-[]" 0))
|
||||
(world '(0) 0 1 "" "[++--]++--+-[]" 6))
|
||||
(check-expect (exec-loop-start
|
||||
(make-world '(1) 0 1 "" "[++--]++--+-[]" 0))
|
||||
(make-world '(1) 0 1 "" "[++--]++--+-[]" 1))
|
||||
(world '(1) 0 1 "" "[++--]++--+-[]" 0))
|
||||
(world '(1) 0 1 "" "[++--]++--+-[]" 1))
|
||||
|
||||
; exec-loop-end: World -> World
|
||||
; Given a world, returns a new world with the ] instruction executed
|
||||
(define (exec-loop-end w)
|
||||
(local [(define jump (not (zero? (list-ref (world-tape w) (world-dp w)))))]
|
||||
(make-world
|
||||
(world
|
||||
(world-tape w)
|
||||
(world-dp w)
|
||||
(world-tape-len w)
|
||||
|
|
@ -265,11 +291,11 @@
|
|||
|
||||
; Tests for exec-loop-end
|
||||
(check-expect (exec-loop-end
|
||||
(make-world '(0) 0 1 "" "[++--]++--+-[]" 5))
|
||||
(make-world '(0) 0 1 "" "[++--]++--+-[]" 6))
|
||||
(world '(0) 0 1 "" "[++--]++--+-[]" 5))
|
||||
(world '(0) 0 1 "" "[++--]++--+-[]" 6))
|
||||
(check-expect (exec-loop-end
|
||||
(make-world '(1) 0 1 "" "[++--]++--+-[]" 5))
|
||||
(make-world '(1) 0 1 "" "[++--]++--+-[]" 1))
|
||||
(world '(1) 0 1 "" "[++--]++--+-[]" 5))
|
||||
(world '(1) 0 1 "" "[++--]++--+-[]" 1))
|
||||
|
||||
; execute: World -> World
|
||||
; Given an initial World state, returns the final World state executing the
|
||||
|
|
@ -287,15 +313,15 @@
|
|||
[(string=? inst "[") (exec-loop-start w)]
|
||||
[(string=? inst "]") (exec-loop-end w)]
|
||||
[(string=? inst ".") (exec-out w)]
|
||||
[(string=? inst ",") ...])))])))
|
||||
[(string=? inst ",") #f])))])))
|
||||
|
||||
; Tests for execute
|
||||
(check-expect (execute (make-world (list 0) 0 3 "" "" 0))
|
||||
(make-world (list 0) 0 3 "" "" 0))
|
||||
(check-expect (execute (world (list 0) 0 3 "" "" 0))
|
||||
(world (list 0) 0 3 "" "" 0))
|
||||
; assert that 5+2 to ASCII = "7" (WTF)
|
||||
(check-expect (execute (make-world (list 0) 0 1 ""
|
||||
(check-expect (execute (world (list 0) 0 1 ""
|
||||
"++>+++++[<+>-]++++++++[<++++++>-]<." 0))
|
||||
(make-world (list 55 0) 0 2 "7"
|
||||
(world (list 55 0) 0 2 "7"
|
||||
"++>+++++[<+>-]++++++++[<++++++>-]<." 35))
|
||||
|
||||
|
||||
|
|
@ -305,10 +331,11 @@
|
|||
(define (main file)
|
||||
(execute (program->world (string->program (read-file file)))))
|
||||
|
||||
(test)
|
||||
; TODO:
|
||||
; fix matching bracket bug
|
||||
; - big-bang:
|
||||
; - - - - - - inital state (make-world (list 0) 0 "" <program> 0)
|
||||
; - - - - - - inital state (world (list 0) 0 "" <program> 0)
|
||||
; - - - - - - on-tick fetch, decode, execute
|
||||
; - - - - - - on-key for ","
|
||||
; - - - - - - (on-mouse for stepper)
|
||||
|
|
|
|||
Loading…
Reference in New Issue