[Fpga-synth] Try out spartan3e projects, questions

Wed Jul 9 18:19:34 CEST 2008

Some work later, I´ve made a fully working Tcl/Tk sound editor for the
GateManPoly design, pasted to the bottom of this email, and it is
usable on all machines which can run tcl, and is easily adaptable.

I´ve added NoteOff midi receiving, which now appears to work (I had a
small keyboard which would have only stuck notes on the synth) to the
picoblaze assembly code, see my addition to my web page about the project:

    http://www.theover.org/Fpgasynth

Kind regards,

    Theo Verelst
    theover at tiscali.nl
    http://www.theover.org

------------------------------------------------------------------------------------------------------------

####################################################################################
#                                  GateManEdit 
            #
####################################################################################
##
## By Ir. Theo Verelst, http://www.theover.org
##
## All parameters of the Gatemanpoly FPGA synthesizer get a slider on a 
Tk window
## This isn´t always the best of course, and there are some cases where 
I don´t
## know what the intended paramter range exactly is, and there are cases 
like the
## Filter Q factor where the slider sense is wrong.
##
## The whole setup works, in my case over a 9600 USB serial connection, and
## parameter changes are sent to the synth immedeately, which is cool.
## Also a test note is sent with each slider motion.
##
## After typing a parameter value in an edit box, press Return to send 
the change
## to the synth board
##
####################################################################################

  # this shows the console window to see output and type Tcl/Tk commands 
at startup,
  # close it in the console with : console hide, or comment it out here 
by putting
  # a hash in front of it.
  console show

  # on Unix, this requires an extra procedurefile, the com port is 
called different, too
  # See http://wiki.tcl.tk/786  and http://wiki.tcl.tk/447 , on Redhat 
e.g. : /dev/ttyS0
  # the unchanged FPGA program IO rate is: 115200

  # open the serial port acting as MIDI
  # (fill in MOC5 and 9600 as you need)
  set fh [open COM5: RDWR]
  fconfigure $fh -blocking 0 -mode 9600,n,8,1 -translation binary 
-buffering full

  # write a hex code to the serial port
  #
  proc w h {
     global fh
     foreach c [split $h] {
        puts -nonewline $fh [binary format H* $c]
     }
     flush $fh
  }

  # every parameter change plays a nonoverlapping test note when playnote!=0
  set playnote 0

  # write system exclusive decimal encoded byte with submessage codes n1,n2
  # and send a test note on, which stops after 1.6 Sec, or with a new 
slider move
  #
  proc wse {n1 n2 h} {
   global fh np playnote
   foreach c [split [list F0 7F 02 00 $n1 $n2 [format "%02x" $h] F7]] {
     puts -nonewline $fh [binary format H* $c]
   }
   flush $fh
   if { $playnote != 0} {
     if {$np != 0} { after cancel $np ; w { 90 3C 00 } ; set np 0 }
     w { 90 3C 20 } ; set np [after 1600 {  w { 90 3C 00 } ; set np 0}]
   }
  }

  # 14 bits are assumed here
  proc wse2b {n1 n2 n3 h} {
   global fh np playnote
   set hi [expr $h>>7] ; set lo [expr $h&127]
puts [format "%02x" $hi],[format "%02x" $lo]
   foreach c [split [list F0 7F 02 00 $n1 $n2 [format "%02x" $hi] F7]] {
     puts -nonewline $fh [binary format H* $c]
   }
   foreach c [split [list F0 7F 02 00 $n1 $n3 [format "%02x" $lo] F7]] {
     puts -nonewline $fh [binary format H* $c]
   }
   flush $fh
   if { $playnote != 0} {
     if {$np != 0} { after cancel $np ; w { 90 3C 00 } ; set np 0 }
     w { 90 3C 20 } ; set np [after 1600 {  w { 90 3C 00 } ; set np 0}]
   }
  }

  # create a new frame with a slider which sends a certain message when 
moved
  # and a label with the slider associated MIDI parameter name, and
  # an editable entry with connected numerical value (over a global 
variable name)
  proc newparfr {name n1 n2 max} {
    frame .f1.$name
    pack .f1.$name -side left -fill y -expand y
    scale .f1.$name.sl -from $max -to 0 -length 256 -var $name -showvalue 0
    pack .f1.$name.sl -side top -expand y -fill both -anchor center
    .f1.$name.sl conf -command  "wse $n1 $n2 "

    label .f1.$name.l -text $name -justify center
    pack .f1.$name.l -side bottom -expand n -fill x -anchor center

    # An entry to see and change slider values
    entry .f1.$name.e -text $name -justify center -textvar $name 
-justify r -width 3
    pack .f1.$name.e -side bottom -expand n -fill x -anchor center
    # (this bind get evaluated once to send the actual command when 
Return is pressed)
    bind .f1.$name.e <Key-Return> "wse $n1 $n2 \$$name"
  }

  # idem for 14 bit messages
  #
  proc newparfr2b {name n1 n2 n3 max} {
    frame .f2.$name
    pack .f2.$name -side left -fill y -expand y
    scale .f2.$name.sl -from $max -to 0 -length 256 -var $name -showvalue 0
    pack .f2.$name.sl -side top -expand y -fill both -anchor center
    .f2.$name.sl conf -command  "wse2b $n1 $n2 $n3 "

    label .f2.$name.l -text $name -justify center
    pack .f2.$name.l -side bottom -expand n -fill x -anchor center

    entry .f2.$name.e -text $name -justify center -textvar $name 
-justify r -width 5
    pack .f2.$name.e -side bottom -expand n -fill x -anchor center
    # the dollars are quoted because of repeated evaluation
    bind .f2.$name.e <Key-Return> "wse2b $n1 $n2 $n3 \$$name"
  }

  # Initialize the noteplay after id variable
  set np 0

  # the first frame, so that we can make some major screen groups
  frame .f1
  pack .f1 -side top -expand y -fill both
  frame .f2
  pack .f2 -side top -expand y -fill both
  frame .f3
  pack .f3 -side top -expand y -fill both

  # commands to create various sliders ( name of slider and subwidget, 
msb,lsb midi, max value)
  newparfr wavf1 00 2C 3
  newparfr wavf2 00 2D 3
  newparfr wavf3 00 2E 3
  newparfr wavf4 00 2F 3
  newparfr tune1 00 00 64
  newparfr tune2 00 01 64
  newparfr tune3 00 02 64
  newparfr tune4 00 03 64

  newparfr trans 01 10 64
  newparfr davol 01 60 16
  newparfr nfbw1 00 20 31
  newparfr nfbw2 00 21 31
  newparfr nfbw3 00 22 31
  newparfr nfbw4 00 23 31
  newparfr nboo1 00 30 15
  newparfr nboo2 00 31 15
  newparfr nboo3 00 32 15
  newparfr nboo4 00 33 15

  newparfr pwms1 00 24 127
  newparfr pwms2 00 25 127
  newparfr pwms3 00 26 127
  newparfr pwms4 00 27 127
  newparfr pwso1 00 28 3
  newparfr pwso2 00 28 3
  newparfr pwso3 00 28 3
  newparfr pwso4 00 28 3

  # commands to create various sliders ( name of slider and subwidget, 
msb,lsb 1, 2 midi,
  # max value) , second row in main UI window:
  newparfr2b fine1 00 04 08 16383
  newparfr2b fine2 00 05 09 16383
  newparfr2b fine3 00 06 0A 16383
  newparfr2b fine4 00 07 0B 16383

  newparfr2b ovol1 00 0C 10 16383
  newparfr2b ovol2 00 0D 11 16383
  newparfr2b ovol3 00 0E 12 16383
  newparfr2b ovol4 00 0F 13 16383

  newparfr2b nml1 00 18 1C 16383
  newparfr2b nml2 00 19 1D 16383
  newparfr2b nml3 00 1A 1E 16383
  newparfr2b nml4 00 1B 1F 16383

  newparfr2b fatt 01 20 21 16383
  newparfr2b fdec 01 22 23 16383
  newparfr2b fsus 01 24 25 16383
  newparfr2b frel 01 26 27 16383
  newparfr2b fq 01 50 51 16383

  newparfr2b aatt 01 30 31 16383
  newparfr2b adec 01 32 33 16383
  newparfr2b asus 01 34 35 16383
  newparfr2b arel 01 36 37 16383

# Default settings
# 7 bits
set wavf1 2
set wavf2 2
set wavf3 2
set wavf4 2
set tune1 36
set tune2 0
set tune3 12
set tune4 24
set trans 0
set davol 8
set nfbw1 7
set nfbw2 4
set nfbw3 4
set nfbw4 2
set nboo1 3
set nboo2 4
set nboo3 7
set nboo4 9
set pwms1 48
set pwms2 37
set pwms3 36
set pwms4 37
set pwso1 0
set pwso2 1
set pwso3 2
set pwso4 3
# 14 bits
set fine1 8192
set fine2 6363
set fine3 9801
set fine4 10313
set ovol1 10093
set ovol2 9874
set ovol3 12214
set ovol4 9947
set nml1 4608
set nml2 8411
set nml3 5997
set nml4 8484
set fatt 5193
set fdec 20
set fsus 3364
set frel 73
set fq 6363
set aatt 16164
set adec 73
set asus 10386
set arel 73

button .f3.bpars -text  "Show all parameters"
pack .f3.bpars -side left -fill y -expand y
.f3.bpars conf -command {
  # print a list of reloadable parameter values in the console
  foreach i [winfo children .f1] { set t [$i.sl cget -var] ; puts "set 
$t [set $t]" }
  foreach i [winfo children .f2] { set t [$i.sl cget -var] ; puts "set 
$t [set $t]" }
}

button .f3.bsend -text  "Send All Midi"
pack .f3.bsend -side left -fill y -expand y

.f3.bsend conf -command {
global playnote
  set playnote 0
  # update all synth parameters.
  # for all frame 1 subframe names:
  foreach i [winfo children .f1] {
    # get the slider associated variable name
    set t [$i.sl cget -var] ;
    # Send slider associated change command
    eval "[.f1.$t.sl cget -command] [.f1.$t.sl get]"
  }
  # idem for UI (invisible) frame 2
  foreach i [winfo children .f2] {
    set t [$i.sl cget -var] ;
    eval "[.f2.$t.sl cget -command] [.f2.$t.sl get]"
  }
  update
  set playnote 1
}

update
set playnote 1
puts "Startup done, no parameter change sent yet."