Frusta

Check-in [d3a03866d2]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:0.1 - several cleanups
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:d3a03866d23f0d6a353a1833b2ebd5124021764f
User & Date: rmelton 2014-03-02 02:08:07
Context
2014-03-13
19:38
release 0.1 check-in: 69fdb64b72 user: rmelton tags: trunk
2014-03-02
02:08
0.1 - several cleanups check-in: d3a03866d2 user: rmelton tags: trunk
2014-01-06
05:17
fixed machine/exercise output check-in: c8eec67efd user: rmelton tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to kits/Canvas3d/pkgIndex.tcl.

20
21
22
23
24
25
26



27
28





29
30
31
32
33
34
35
        default {error "ERROR: I do not have an sqlite3 library for the linux '$::tcl_platform(machine)' machine"}
      }
      # ugh, runing a 32-bit on a 64-machine is broken...  (assume 32 for now)
      load [file join {@} libCanvas3d1.0.so] Canvas3d
      source [file join {@} c3dshapes.tcl]
    }
    Win* {



      load [file join {@} Canvas3d10.dll] Canvas3d
      source [file join {@} c3dshapes.tcl]





    }
    Darwin {
      load [file join {@} libCanvas3d1.0.dylib] Canvas3d
      source [file join {@} c3dshapes.tcl]
    }
    default {
      error "ERROR: I do not have a canvas3d library for the '$::tcl_platform(os)' platform"







>
>
>
|
|
>
>
>
>
>







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
        default {error "ERROR: I do not have an sqlite3 library for the linux '$::tcl_platform(machine)' machine"}
      }
      # ugh, runing a 32-bit on a 64-machine is broken...  (assume 32 for now)
      load [file join {@} libCanvas3d1.0.so] Canvas3d
      source [file join {@} c3dshapes.tcl]
    }
    Win* {
      ## depends on wether this is a 32-bit tcl or a 64-bit tcl
      switch -glob -- $::tcl_platform(machine) {
        intel {
          load [file join {@} Canvas3d10.dll] Canvas3d
          source [file join {@} c3dshapes.tcl]
        }
        amd64 {
          error "need 64-bit version of canvas3s for windows"
        }
      }
    }
    Darwin {
      load [file join {@} libCanvas3d1.0.dylib] Canvas3d
      source [file join {@} c3dshapes.tcl]
    }
    default {
      error "ERROR: I do not have a canvas3d library for the '$::tcl_platform(os)' platform"

Changes to lib/gcode/gcode_0.1.tcl.

31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
...
332
333
334
335
336
337
338







339
340
341
342
343
344
345
...
477
478
479
480
481
482
483

484

485

486
487
488
489
490
491
492
493
...
498
499
500
501
502
503
504












505
506
507
508
509
510
511
...
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
...
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
      set new(X) $cfg(X)
      set new(Y) $cfg(Y)
      set new(Z) $cfg(Z)
      set new(E) $cfg(E)
      while {[llength $args] > 0} {
        set args [lassign $args cmd]
        switch -regexp -matchvar matchvar -- $cmd {
          {X(-?[[:digit:]]+(\.[[:digit:]]+)?)} {
            set new(X) [expr {$cfg(scale)*[lindex $matchvar 1]+($cfg(relP) ? $cfg(X) : 0)}]
            #puts stderr "X $matchvar"
          }
          {Y(-?[[:digit:]]+(\.[[:digit:]]+)?)} {
            set new(Y) [expr {$cfg(scale)*[lindex $matchvar 1]+($cfg(relP) ? $cfg(Y) : 0)}]
            #puts stderr "Y $matchvar"
          }
          {Z(-?[[:digit:]]+(\.[[:digit:]]+)?)} {
            #puts stderr "Z '[lindex $matchvar 1]' $matchvar"
            set new(Z) [expr {$cfg(scale)*[lindex $matchvar 1]+($cfg(relP) ? $cfg(Z) : 0)}]
          }
          {F(-?[[:digit:]]+(\.[[:digit:]]+)?)} {
            #puts stderr "F $matchvar"
          }
          {E(-?[[:digit:]]+(\.[[:digit:]]+)?)} {
................................................................................
      variable cfg
      set cfg(relP) 1
    }
    proc G92 {args} { ;## use relative extrusion
      variable cfg
      set cfg(relE) 1
    }








    proc M0 {args} {;## STOP
    }
    proc M1 {args} {;## sleep
    }
    proc M3 {args} {;##  Spindle On, Clockwise (CNC specific)
      #The spindle is turned on with a speed of 4000 RPM.
................................................................................

    proc M130 {args} {;## ????
    }
    proc M140 {args} {;## ????
    }
    proc M190 {args} {;## ????
    }



    proc unknown {args} {

      error "GCODE unknown error args=$args"
    }


    variable cfg
    proc _init_ {} {
      variable cfg
      lassign {0 0 0 0} cfg(X) cfg(Y) cfg(Z) cfg(E)
................................................................................
    }
    proc _publish_ {name} {
      variable pathList
      variable cfg
      Geom::NewObject $name {} $pathList [list 1 $cfg(layerNum)]
      set pathList {}
    }












  }

  proc ParseAscii {fp args} {
    while {[llength $args] > 0} {
      set args [lassign $args cmd]
      switch -- $cmd {
        -defaultName {set args [lassign $args defaultName]}
................................................................................
      gcodeParseInterp eval [list rename $command ""]
    }
    foreach cmd [info commands [namespace current]::geom::*] {
      set cmdName [namespace tail $cmd]
      interp alias gcodeParseInterp $cmdName {} [namespace current]::geom::$cmdName
    }
    geom::_init_
    gcodeParseInterp eval [string map {";" ";#"} $lines]
    if {[info exists defaultName]} {
      geom::_publish_ $defaultName
    } else {
      geom::_publish_ gcode
    }
    interp delete gcodeParseInterp
  }
................................................................................
      set cArgs {}
      while {[llength $args] > 0 && [string match "-*" [lindex $arg 0]]} {
        set args [lassign $args cmd]
        switch -- $cmd {
          default {error "gcode::write::Init bad cmd=$cmd"}
        }
      }
      Puts [format "\#\# frusta version = %s" $::cfg(frustaVersion)]
      Puts [format "\#\# http://chiselapp.com/user/seadevil/repository/frusta"]
      Puts [format "\#\# seadevil (R. Melton) 2013"]
      Puts G21 ;# set units to mm
      Puts G90 ;# set to absolute positioning
    }
    proc Home {args} {
      set cArgs {}
      while {[llength $args] > 0 && [string match "-*" [lindex $args 0]]} {
        set args [lassign $args cmd]







|



|



|







 







>
>
>
>
>
>
>







 







>
|
>

>
|







 







>
>
>
>
>
>
>
>
>
>
>
>







 







|







 







|
|
|







31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
...
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
...
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
...
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
...
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
...
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
      set new(X) $cfg(X)
      set new(Y) $cfg(Y)
      set new(Z) $cfg(Z)
      set new(E) $cfg(E)
      while {[llength $args] > 0} {
        set args [lassign $args cmd]
        switch -regexp -matchvar matchvar -- $cmd {
          {X\+?(-?[[:digit:]]+(\.[[:digit:]]+)?)} {
            set new(X) [expr {$cfg(scale)*[lindex $matchvar 1]+($cfg(relP) ? $cfg(X) : 0)}]
            #puts stderr "X $matchvar"
          }
          {Y\+?(-?[[:digit:]]+(\.[[:digit:]]+)?)} {
            set new(Y) [expr {$cfg(scale)*[lindex $matchvar 1]+($cfg(relP) ? $cfg(Y) : 0)}]
            #puts stderr "Y $matchvar"
          }
          {Z\+?(-?[[:digit:]]+(\.[[:digit:]]+)?)} {
            #puts stderr "Z '[lindex $matchvar 1]' $matchvar"
            set new(Z) [expr {$cfg(scale)*[lindex $matchvar 1]+($cfg(relP) ? $cfg(Z) : 0)}]
          }
          {F(-?[[:digit:]]+(\.[[:digit:]]+)?)} {
            #puts stderr "F $matchvar"
          }
          {E(-?[[:digit:]]+(\.[[:digit:]]+)?)} {
................................................................................
      variable cfg
      set cfg(relP) 1
    }
    proc G92 {args} { ;## use relative extrusion
      variable cfg
      set cfg(relE) 1
    }

    proc T0 {args} {;## use extruder #0
    }
    proc T1 {args} {;## use extruder #1
    }
    proc T2 {args} {;## use extruder #2
    }

    proc M0 {args} {;## STOP
    }
    proc M1 {args} {;## sleep
    }
    proc M3 {args} {;##  Spindle On, Clockwise (CNC specific)
      #The spindle is turned on with a speed of 4000 RPM.
................................................................................

    proc M130 {args} {;## ????
    }
    proc M140 {args} {;## ????
    }
    proc M190 {args} {;## ????
    }
    proc M220 {args} {;## set percentage speed rate
    }

    proc unknown {args} {
      variable lineCount
      error "GCODE unknown error line=$lineCount args=$args"
    }


    variable cfg
    proc _init_ {} {
      variable cfg
      lassign {0 0 0 0} cfg(X) cfg(Y) cfg(Z) cfg(E)
................................................................................
    }
    proc _publish_ {name} {
      variable pathList
      variable cfg
      Geom::NewObject $name {} $pathList [list 1 $cfg(layerNum)]
      set pathList {}
    }

    variable lineCount 0
    proc _eval_ {args} {
      variable lineCount
      set lineCount 0
      foreach line [split [join $args " "] "\n"] {
        incr lineCount
        if {[catch eval $line]} {
          puts stderr "Error parsing gcode, line=$lineCount : $line\n"
        }
      }
    }
  }

  proc ParseAscii {fp args} {
    while {[llength $args] > 0} {
      set args [lassign $args cmd]
      switch -- $cmd {
        -defaultName {set args [lassign $args defaultName]}
................................................................................
      gcodeParseInterp eval [list rename $command ""]
    }
    foreach cmd [info commands [namespace current]::geom::*] {
      set cmdName [namespace tail $cmd]
      interp alias gcodeParseInterp $cmdName {} [namespace current]::geom::$cmdName
    }
    geom::_init_
    gcodeParseInterp eval _eval_ [string map {";" ";#"} $lines]
    if {[info exists defaultName]} {
      geom::_publish_ $defaultName
    } else {
      geom::_publish_ gcode
    }
    interp delete gcodeParseInterp
  }
................................................................................
      set cArgs {}
      while {[llength $args] > 0 && [string match "-*" [lindex $arg 0]]} {
        set args [lassign $args cmd]
        switch -- $cmd {
          default {error "gcode::write::Init bad cmd=$cmd"}
        }
      }
      Puts [format ";; frusta version = %s" $::cfg(frustaVersion)]
      Puts [format ";; http://chiselapp.com/user/seadevil/repository/frusta"]
      Puts [format ";; seadevil (R. Melton) 2013"]
      Puts G21 ;# set units to mm
      Puts G90 ;# set to absolute positioning
    }
    proc Home {args} {
      set cArgs {}
      while {[llength $args] > 0 && [string match "-*" [lindex $args 0]]} {
        set args [lassign $args cmd]

Changes to lib/gui/gui_0.1.tcl.

8
9
10
11
12
13
14

15
16
17
18
19
20
21
...
146
147
148
149
150
151
152






























153
154
155
156
157
158
159
160
161
162
163
        Exit
      }
    }

    Menu::Bar .menu {
      {File -menu {
        {command -label "About..." -command gui::About}

        separator
        {command -label "Read STL..." -command {
          set cfg(stlFileName) [tk_getOpenFile -filetypes {
            {{STL Files}    {.stl}        }
            {{Text Files}   {.txt}        }
            {{All Files}    *             }
          }]
................................................................................

  proc About {} {
    tk_messageBox \
        -type ok\
        -title "About Frusta/Frustum"\
        -message "Frusta version $::cfg(frustaVersion)"\
        -detail "$::cfg(frustaAbout)"






























  }
}

package provide frusta::gui 0.1


## Local Variables:
## mode: tcl
## tcl-indent-level: 2
## indent-tabs-mode: nil
## End:







>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>











8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
...
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
        Exit
      }
    }

    Menu::Bar .menu {
      {File -menu {
        {command -label "About..." -command gui::About}
        {command -label "About2..." -command gui::About2}
        separator
        {command -label "Read STL..." -command {
          set cfg(stlFileName) [tk_getOpenFile -filetypes {
            {{STL Files}    {.stl}        }
            {{Text Files}   {.txt}        }
            {{All Files}    *             }
          }]
................................................................................

  proc About {} {
    tk_messageBox \
        -type ok\
        -title "About Frusta/Frustum"\
        -message "Frusta version $::cfg(frustaVersion)"\
        -detail "$::cfg(frustaAbout)"
  }

  proc About2 {} {
    log::Puts -bgblue -white -- "System Information"
    log::Puts -bgblue -white -- "info globals = [info globals]"
    log::Puts -bgblue -white -- "info library = [info library]"
    log::Puts -bgblue -white -- "info nameofexecutable = [info nameofexecutable]"
    #log::Puts -bgblue -white -- "info version = [info version]"
    #log::Puts -bgblue -white -- "info patchlevel = [info patchlevel]"
    #log::Puts -bgblue -white -- "info sharedlibextension  = [info sharedlibextension ]"
    #log::Puts -bgblue -white -- "info  = [info ]"
    foreach scalar {auto_path errorCode errorInfo tcl_library tcl_patchLevel tcl_pkgPathtcl_precision tcl_rcFileName tcl_traceCompile tcl_traceExec tcl_wordchars tcl_nonwordchars tcl_version argc argv argv0 tcl_interactive} {
      if {[info exists ::$scalar]} {
        log::Puts -bggreen -white -- "::$scalar = [set ::$scalar]"
      } else {
        log::Puts -bggreen -white -- "::$scalar - UNDEFINED"
      }
    }
    foreach env {HOME TCL_LIBRARY TCLLIBPATH TCL_TZ TZ LC_ALL LC_MESSAGES LANG TCL_INTERP_DEBUG_FRAME} {
      if {[info exists ::env($env)]} {
        log::Puts -bggreen -white -- "::env($env) = [set ::env($env)]"
      } else {
        log::Puts -bggreen -white -- "::env($env) - UNDEFINED"
      }
    }
    foreach v [array names ::tcl_platform] {
      log::Puts -bggreen -white -- "::tcl_platform($v) = [set ::tcl_platform($v)]"
    }


  }
}

package provide frusta::gui 0.1


## Local Variables:
## mode: tcl
## tcl-indent-level: 2
## indent-tabs-mode: nil
## End:

Changes to lib/logging.tcl.

155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
...
209
210
211
212
213
214
215






























216
217
218
219
220
221
222
    grid $w.top -sticky w
    grid [label $w.lab -text "Log"] -sticky ew
    text $w.txt -xscrollcommand "$w.sbx set" -yscrollcommand "$w.sby set"
    ttk::scrollbar $w.sby -command "$w.txt yview" -orient vertical
    ttk::scrollbar $w.sbx -command "$w.txt xview" -orient horizontal
    grid $w.txt $w.sby -sticky nsew
    grid $w.sbx        -sticky ew
    grid rowconfigure $w 1 -weight 1
    grid columnconfigure $w 0 -weight 1
    set logWin $w.txt

    eval {# fix fonts in a better way...
      #catch {$logWin config -font "Monospace"}
      $logWin config -font "TkFixedFont"
      #catch {$logWin config -font "size 9"}
................................................................................
    set tags {}
    while {[string match "-*" [lindex $args 0]]} {
      set args [lassign $args option]
      switch -- $option {
        -tag       {set args [lassign $args tags]}
        --         {break}
        -nonewline {set eol {}}






























        default    {error "gui::Log::Puts bad option=$option"}
      }
    }
    set msg [join $args ""]
    #puts stderr "msg=$msg tags=$tags"
    variable logWin
    if {[info exists logWin]} {







|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
...
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
    grid $w.top -sticky w
    grid [label $w.lab -text "Log"] -sticky ew
    text $w.txt -xscrollcommand "$w.sbx set" -yscrollcommand "$w.sby set"
    ttk::scrollbar $w.sby -command "$w.txt yview" -orient vertical
    ttk::scrollbar $w.sbx -command "$w.txt xview" -orient horizontal
    grid $w.txt $w.sby -sticky nsew
    grid $w.sbx        -sticky ew
    grid rowconfigure $w 2 -weight 1
    grid columnconfigure $w 0 -weight 1
    set logWin $w.txt

    eval {# fix fonts in a better way...
      #catch {$logWin config -font "Monospace"}
      $logWin config -font "TkFixedFont"
      #catch {$logWin config -font "size 9"}
................................................................................
    set tags {}
    while {[string match "-*" [lindex $args 0]]} {
      set args [lassign $args option]
      switch -- $option {
        -tag       {set args [lassign $args tags]}
        --         {break}
        -nonewline {set eol {}}
        -bold        -
        -ul          -
        -blink       -
        -inverse     -
        -black       -
        -red         -
        -green       -
        -yellow      -
        -orange      -
        -blue        -
        -magenta     -
        -cyan        -
        -white       -
        -bgblack     -
        -bgred       -
        -bggreen     -
        -bgyellow    -
        -bgorange    -
        -bgblue      -
        -bgmagenta   -
        -bgcyan      -
        -bgwhite     -
        -ired        -
        -igreen      -
        -iyellow     -
        -iblue       -
        -imagenta    -
        -icyan       -
        -iwhite      -
        "ANSI STUFF" {lappend ansi $option; lappend tags -tag $option}
        default    {error "gui::Log::Puts bad option=$option"}
      }
    }
    set msg [join $args ""]
    #puts stderr "msg=$msg tags=$tags"
    variable logWin
    if {[info exists logWin]} {