Version 1 of gidrw

Updated 2003-12-22 05:45:07

2003-12-21 VI A weekend project to get my daughter started on programming. She loves drawing, so this is something for her to play around with, on a Tk Canvas.

Edit in text box, then press Ctrl-R to run. Other file menu items are hopefully obvious.


 package require Tk
 package require BWidget

 namespace eval ::gidrw {}

 proc ::gidrw::run {} {
    .c delete all
    .c configure -background white
    uplevel #0 [.t get 1.0 end]
 }

 proc ::gidrw::save {{new 0}} {
    set types {
        {{gidrw format} {.gid}}
        {{all files} {*}}
    }
    if {$::gidrw::filename == "" || $new == 1} {
        set fn [tk_getSaveFile -title "Save GIDRW File" \
                    -filetypes $types -defaultextension gid]
        if {$fn == ""} return
    } else {
        set fn $::gidrw::filename
    }
    set t [.t get 1.0 end]
    set fo [::open $fn w]
    puts -nonewline $fo $t
    close $fo
 }

 proc ::gidrw::checksaved {} {
    set t [string trim [.t get 1.0 end]]
    if {$t == ""} {return 1}
    if {$t != $::gidrw::s} {
        puts "<$t> <$::gidrw::s>"
        set answer [tk_messageBox \
                        -message "Do you want to save changes?" \
                        -type yesnocancel -icon warning -default yes]
        switch $answer {
            yes { return ::gidrw::save}
            no { return 1 }
            cancel { return 0 }
        }
    }
    return 1
 }

 proc ::gidrw::new {} {
    ::gidrw::checksaved
    set ::gidrw::filename ""
    .t delete 1.0 end
    ::gidrw::run
 }


 proc ::gidrw::open {} {
    if ![::gidrw::checksaved] return
    set types {
        {{gidrw format} {.gid}}
        {{all files} {*}}
    }
    set fn [tk_getOpenFile -title "Open GIDRW File" \
                -filetypes $types -defaultextension gid]
    if {$fn == "" } return
    set ::gidrw::filename $fn
    .t delete 1.0 end
    set fi [::open $fn]
    set ::gidrw::s [string trim [read $fi]]
    close $fi
    .t insert end $::gidrw::s
    ::gidrw::run
 }


 proc ::gidrw::build_gui {} {

    MainFrame .main -menu {
        &File {} {} 0 {
            {command
                "&Open" {} "Open Existing gidrw file" {Ctrl o}
                -command ::gidrw::open
            }
            {command
                "&Save" {} "Save gidrw File" {Ctrl s} 
                -command ::gidrw::save
            }
            {command
                "Save &As" {} "Save under a different name" {Ctrl a} 
                -command "::gidrw::save 1"
            }
            {command
                "&New" {} "Start with a new blank gidrw" {Ctrl n} 
                -command ::gidrw::new
            }
            {command
                "E&xit" {} "Exit gidrw" {Alt x} 
                -command exit
            }
            {command
            "&Run" {} "Run Program" {Ctrl r} -command ::gidrw::run
            }
        }
    }

    pack .main -expand 1 -fill both

    PanedWindow .pane -side left -pad 0
    pack .pane -in [.main getframe] -expand 1 -fill both
    .pane add

    ScrolledWindow .cw -auto both -scrollbar both
    pack .cw -in [.pane getframe 0] -expand 1 -fill both -side top
    canvas .c -width 800 -height 500
    .cw setwidget .c

    .pane add

    ScrolledWindow .sw -auto both -scrollbar both
    pack .sw -in [.pane getframe 1] -expand 1 -fill both -side top

    text .t -height 5
    .sw setwidget .t
 }


 ::gidrw::build_gui
 ::gidrw::new