Version 7 of A little Morse trainer

Updated 2002-08-27 09:55:32

http://mini.net/files/Morser.jpg


Richard Suchenwirth 2002-08-25 - This weekend fun project makes the computer understand Morse code entered on the left mouse button, when over the "brass" knob at top left. Below, you can adjust some timing thresholds, and see the decoded dah-dit pattern and the resulting text on a sort of "ticker tape". Clear the output with the "C" button. The "?" button opens a help field with the complete alphabet, or closes it again if you know it by heart.

 package require Tk
 array set morse {
    .- A .-.- \u00C4 -... B -.-. C -.. D . E ..-. F --. G .... H .. I
    .--- J -.- K .-.. L -- M -. N --- O ---. \u00D6 .--. P --.- Q .-. R
    ... S - T ..- U ..-- \u00DC ...- V .-- W -..- X -.-- Y --.. Z
    ----- 0 .---- 1 ..--- 2 ...-- 3 ....- 4 ..... 5 -.... 6 --... 7
    ---.. 8 ----. 9 / " "
 }
 option add *Button -padx 0
 proc ui {} {
    global timevec morse
    set font {Courier 10}
    canvas .c -height 58 -relief sunken -borderwidth 1
    .c create oval 5 5 55 55 -fill gold2 -outline gold3 -width 2 -tag key
    .c create text 70 2 -text "Morse Trainer" -anchor nw \
        -font {Times 24 {bold italic}}
    .c create text 70 38 -anchor nw -text \
        "Click the brass button to morse - have fun with Tcl/Tk!" 
    .c bind key <1> {compute; %W move current 2 2}
    .c bind key <ButtonRelease-1> {compute; %W move current -2 -2}
    grid .c - -sticky news
    frame .f
    label .f.lon -text On:
    entry .f.on  -textvar ::th_on -width 4
    label .f.loff -text Off:
    entry .f.off -textvar ::th_off -width 4
    label .f.lgap -text Gap:
    entry .f.gap -textvar ::th_gap -width 4
    eval pack [winfo children .f] -side left
    grid .f -
    button .clear -text C -command init
    label .info1 -textvar ::info1 -width 40 -font $font \
        -anchor e
    grid .clear .info1 -sticky news
    button .help -text ? -command {help .help}
    label .info2 -textvar ::info2 -bg white -width 40 -anchor e -font $font
    grid .help .info2 -sticky news
    label .h -textvar ::help -font $font -relief sunken -bg lightyellow
    set tmp {}
    foreach {mors char} [array get morse] {
        lappend tmp [list $char $mors]
    }
    foreach {1 2 3 4 5} [lsort $tmp] {
        foreach i {1 2 3 4 5} {
            append ::help "[set $i]\t"
        }
        append ::help \n
    }
    grid columnconfigure . 1 -weight 1
    init
 }
 proc help {w} {
    if {[$w cget -text]=="?"} {
        grid .h - -sticky news
        $w config -text !
    } else {
        grid forget .h
        $w config -text ?
    }
 }
 proc init {} {
    set ::info1 {}; set ::info2 {}; set ::timevec {}; set ::t 0
    set ::th_on 200
    set ::th_off 200
    set ::th_gap 9
 }
 # Times for an on/off signal are measured here, and appended to timevec
 proc compute {} {
    global t timevec
    global th_on th_off th_gap
    set now [clock clicks -milliseconds]
    if {$t} {lappend timevec [expr {$now - $t}]}
    set t $now
    set res ""
    foreach {on off} $timevec {
        if {$on>$th_on} {
            append res -
        } else {
            append res .
        }
        if {$off > $th_off}    {append res " "}
        if {$off > $th_off * $th_gap} {append res "/ "}
    }
    set ::info1 $res
    set ::info2 [morsedecode $res]
 }
 # This maps "..." to "s", etc.
 proc morsedecode string {
    global morse
    set res ""
    foreach part $string {
        if {[info exists morse($part)]} {
            append res $morse($part)
        } else {append res "?"}
    }
    set res
 }
 ui
 bind . <Escape> {exec wish $argv0 &; exit}

To make it beep in traditional morse code style while the mouse is held down over the "knob" using Snack, you can append this to the code:

 package require snack
 set cs [snack::sound -rate 22050]
 set playing 0
 set filter [snack::filter generator 1000 30000 0.0 sine]
 proc toggle_beep {} {
   global cs playing filter
   if {$playing} {
     $cs stop
   } else {
     $cs play -filter $filter
   }
   set playing [expr {!$playing}]
 }
 rename compute _compute
 proc compute {} {
   toggle_beep
   _compute
 } ;# FW

Arts and crafts of Tcl-Tk programming