# klattgrid_simulator.praat
# djmw 20091103, 20110222, 20120221

delim$ =";"
debug = 0
precision = 1e-6
fs = 88200
label_is_procedure$ = "^^"
space$ = " "
upArrow$ = "\^|"
upArrow_regex$ = "\\\^\|"
downArrow$ = "\_|"
downArrow_regex$ = "\\_\|"

color_parameter$ = "Blue"
color_normal$ = "Black"

draw_background = 0
control$ = "source"

buttons = 0
klattgrid = 0
sound = 0
sound_background = 0
sound_played = 0

spectrum = 0
spectrum_background = 0
spectrum_calculation = 1
minimum_frequency = 0
maximum_frequency = 5000
minimum_power = -20
maximum_power = 90

nparameters = 12
demo demoWindowTitle ("KlattGrid simulator")

call init

# simulate click on model
irow = Search column... type model
Set numeric value...  irow clicked 1
call model irow

call buttons_draw

while demoWaitForInput()
  if demoClicked()
    call buttons_checkClickedIn
    call actions
    if not sound_played
      demo Erase all
      call buttons_draw
    endif
    sound_played = 0
  endif
endwhile

procedure init
  buttons = Create Table with column names... buttons 0 
  ... type vpx1 vpx2 vpy1 vpy2 x1 x2 y1 y2 nbuttons ibutton label_id label size mark xon clicked
  bo$ = "Object_'buttons'"
  fade_in = 0.005
  fade_out = 0.005
  xmin = 0
  xmax = 0.1
  ymin = -1
  ymax = 1
  klattgrid = Create KlattGrid... kg xmin xmax 2 1 1 1 0 0 1
  call interface_definitions
endproc

procedure actions
  select buttons
  .irow = Search column... clicked 1
  if .irow > 0

     .label_id$ = 'bo$'$[.irow, "label_id"]
     .type$ = 'bo$'$[.irow, "type"]

     call debug actions: clicked on '.type$' '.label_id$'; 'playable_as_sound' 'function_and_spectrum'

     if index (.type$, "parameter") > 0
       call parameter_change .irow
     elsif .type$ = "xrange" or .type$ = "yrange"
       call scale_range '.type$' '.label_id$'
     elsif .type$ = "background"
       call background .irow
     elsif .type$ = "control"
       call control .irow
     elsif .type$ = "play"
       call play
     elsif .type$ = "spectrum"
       call spectrum_options
     elsif .type$ = "model"
       call model .irow
     endif 
  endif
endproc

procedure play
  select sound
  .s = Copy... fifo
  Fade in... All xmin fade_in y
  Fade out... All xmax -fade_out y
  Play
#  Remove
  sound_played = 1
endproc

procedure control .irow
  control$ = 'bo$'$[.irow, "label_id"]
endproc

procedure background .irow
  draw_background = not draw_background
  if sound_background > 0
    select sound_background
    Remove
    sound_background = 0
  endif
  if spectrum_background > 0
    select spectrum_background
    Remove
    spectrum_background = 0
  endif
  if draw_background 
    select sound
    sound_background = Copy... bg
    spectrum_background = To Spectrum... spectrum_calculation
  endif
  call buttons_set_one_mark background 1 draw_background
endproc

procedure get_parameter_names
  call get_items 'parameters$'
  nparameters = get_items.nitems
  if nparameters = 0
    exit get_parameters: No parameters
  endif
  labels_parameter$ = ""
  for .i to nparameters
    .p2$ = get_items.item'.i'$
    call parse_two '.p2$'
    parm'.i'_i$ = parse_two.p1$
    parm'.i'_f$ = parse_two.p2$
    labels_parameter$ = labels_parameter$ + parm'.i'_i$ + ";"
  endfor
  .nparp1 = nparameters + 1
  parm'.nparp1'_i$ = "x"
  parm'.nparp1'_f$ = "x"
  delim$ = ";"
endproc

procedure get_parameter_initial_values
  call get_items 'parameter_initial_values$'
  .nitems = get_items.nitems
  if .nitems < nparameters
    exit set_initial_values: not enough initial values
  endif
  for .i to nparameters
    .pt$ = get_items.item'.i'$
    call parse_two '.pt$'   
    .val$ = parse_two.p1$
    .parmi$ = parm'.i'_i$
    '.parmi$' = '.val$'
    .step$ = parse_two.p2$
    .step = '.step$'
    if parse_two.not_present = 2
      .step /= 10
      if .step = 0
        .step = 0.1
      endif
    endif
    .upstep$ = parm'.i'_i$ + "_upstep"
    '.upstep$' = .step
     .downstep$ = parm'.i'_i$ + "_downstep"
    '.downstep$' = .step
    .multiplier$ = parm'.i'_i$ + "_multiplier"
    '.multiplier$' = -1
    call debug get_parameter_initial_values: '.i' '.upstep$' '.step'
  endfor
endproc

procedure parameter_change_options .irow
  if nparameters > 0
    # find current values: parameter and step_size
    .ibutton = 'bo$'[.irow, "ibutton"]

    call buttons_findFirst parameter
    .irow_par = buttons_findFirst.irow
    .label_id$ = 'bo$'$[.irow_par+.ibutton-1, "label_id"]
    .parmi$ = parm'.ibutton'_i$
    .parmi = '.parmi$'

    .parmi_upstep$ = .parmi$ + "_upstep"
    .parmi_upstep = '.parmi_upstep$'
    .parmi_downstep$ = .parmi$ + "_downstep"

    call debug get_parameter_step_size: '.label$'
    beginPause ("Parameter change options")
      comment ("Parameter '.parmi$'")
      real ("Value", "'.parmi'")
      positive ("Step_size", "'.parmi_upstep'")
    .clicked = endPause ("Cancel", "OK", 2, 1)
    if .clicked = 2
      '.parmi$' = value
      '.parmi_upstep$' = step_size
      '.parmi_downstep$' = step_size
    endif
  endif
endproc

procedure parameter_change .irow
  function_query = 0
  .label$ = 'bo$'$[.irow, "label"]
  .ibutton = 'bo$'[.irow, "ibutton"]
  .update = 1
  if  startsWith (.label$, upArrow$)
    .formula$ = replace$ (.label$, upArrow$, "+", 1)
  elsif startsWith (.label$, downArrow$)
    .formula$ = replace$ (.label$, downArrow$, "-", 1)
  elsif startsWith (.label$, "*")
    .formula$ = .label$
  else
    .update = 0
  endif
  if demoShiftKeyPressed ()
    call parameter_change_options .irow
    .update = 0
  endif
  if .update
    call buttons_findFirst parameter
    .irow_par = buttons_findFirst.irow
     .parameter$ = 'bo$'$[.irow_par+.ibutton-1, "label_id"]
    '.parameter$' = '.parameter$''.formula$'
  endif
  call buttons_set_one_mark_xon parameter .ibutton
  call buttons_set_one_mark_xon parameter_value .ibutton
endproc

procedure draw_parameter_upstep_label .irow .vpx1 .vpx2 .vpy1 .vpy2
  demo Select inner viewport... .vpx1 .vpx2 .vpy1 .vpy2
  demo Axes... .vpx1 .vpx2 .vpy1 .vpy2
  demo 'color_parameter$'
  demo Draw rounded rectangle... .vpx1 .vpx2 .vpy1 .vpy2 3
  .ibutton = 'bo$'[.irow, "ibutton"]
  call buttons_findFirst parameter
  .irow_par = buttons_findFirst.irow
  .parm$ = 'bo$'$[.irow_par+.ibutton-1, "label_id"]
  .parm$ = .parm$ + "_upstep"
  .val = '.parm$'
  .label$ = "'upArrow$' '.val'"
  Set string value... .irow label '.label$'
  demo 'color_normal$'
  demo Text... (.vpx1+.vpx2)/2 Centre (.vpy1+.vpy2)/2 Half '.label$'
endproc

procedure draw_parameter_downstep_label .irow .vpx1 .vpx2 .vpy1 .vpy2
  demo Select inner viewport... .vpx1 .vpx2 .vpy1 .vpy2
  demo Axes... .vpx1 .vpx2 .vpy1 .vpy2
  demo 'color_parameter$'
  demo Draw rounded rectangle... .vpx1 .vpx2 .vpy1 .vpy2 3
  .ibutton = 'bo$'[.irow, "ibutton"]
  call buttons_findFirst parameter
  .irow_par = buttons_findFirst.irow
  .parm$ = 'bo$'$[.irow_par+.ibutton-1, "label_id"]
  .parm$ = .parm$ + "_downstep"
  .val = '.parm$'
  .label$ = "'downArrow$' '.val'"
  Set string value... .irow label '.label$'
  # find parameter[.ibutton]
  demo 'color_normal$'
  demo Text... (.vpx1+.vpx2)/2 Centre (.vpy1+.vpy2)/2 Half '.label$'
endproc

procedure draw_parameter_value_label .irow .vpx1 .vpx2 .vpy1 .vpy2
  demo Select inner viewport... .vpx1 .vpx2 .vpy1 .vpy2
  demo Axes... .vpx1 .vpx2 .vpy1 .vpy2
  .ibutton = 'bo$'[.irow, "ibutton"]
  .parmi$ = parm'.ibutton'_i$ 
  .parmi = '.parmi$'
  if abs(.parmi) < precision
    .parmi = 0
  endif
  .parmif$ = fixed$ (.parmi, 2)
  demo 'color_parameter$'
  demo Draw rounded rectangle... .vpx1 .vpx2 .vpy1 .vpy2 3
  .label$ = "= " + .parmif$
  Set string value... .irow label '.label$'
  .color$ = color_normal$
  if 'bo$'[.irow, "mark"]
    .color$ = color_parameter$
  endif
  demo '.color$'
  demo Text... .vpx1 Left (.vpy1+.vpy2)/2 Half  '.label$'
  demo 'color_normal$'
endproc

procedure interface_data
#  button_types$ = "control;parameter;parameter_upstep;parameter_downstep;parameter_value;spectrum;play;"

  button_types$ = "parameter;parameter_upstep;parameter_downstep;parameter_value;play;sound;spectrum;background;control;model;"

  .vpx1_parameter = 60
  .vpx2_parameter = .vpx1_parameter + 10
  .vpy1_parameter = 40
  .vpy2_parameter = 99


  .vpx1_play = 70
  .vpx2_play = .vpx1_play + 10
  .vpy2_play = .vpy1_parameter - 10
  .vpy1_play = .vpy2_play - 4

  .vpx1_sound = 0
  .vpx2_sound = 60
  .vpy1_sound = 60
  .vpy2_sound = 99
  .vpx1_spectrum = .vpx1_sound
  .vpx2_spectrum = .vpx2_sound
  .vpy1_spectrum = 10
  .vpy2_spectrum = 60

  .vpx1_background = .vpx1_spectrum
  .vpx2_background = .vpx1_background + 10
  .vpy2_background = .vpy1_spectrum - 3
  .vpy1_background = 3

  .vpx2_model = 99
  .vpx1_model = .vpx2_model - 10
  .vpy1_model = .vpy1_background
  .vpy2_model = .vpy2_background

  .vpx1_control = .vpx2_background + 5
  .vpx2_control = .vpx2_spectrum
  .vpy2_control = .vpy2_background
  .vpy1_control = .vpy1_background

  vp_parameter$ = "'.vpx1_parameter' '.vpx2_parameter' '.vpy1_parameter' '.vpy2_parameter'"
  nparameters = 21
  size_parameter$ = "14"
  layout_parameter$ = "1 'nparameters' 3 100 1"
  one_mark_parameter$ = "1 1"
  marks_parameter$ = ""
  parameters$ = "voicingAmp;pitch;flutter;power1;power2;doublePulsing;openPhase;collisionPhase;aspiration;breathiness;spectralTilt;f1;b1;f2;b2;deltaF1;deltaB1;nasalF1;nasalB1;nasalAntiF1;nasalAntiB1;"
  call get_parameter_names
  parameter_initial_values$ = "90:5;100:10;0:0.1;2:1;3:1;0:0.1;0.6:0.1;0:0.01;0:10;0:10;0:5;800:50;80:10;1200:50;80:10;0:100;0:50;200:50;50:50;200:50;50:50;50;"
  call get_parameter_initial_values
  
  .vpx1_parameter_value = .vpx2_parameter + 1
  .vpx2_parameter_value = .vpx1_parameter_value + 8
  labels_parameter_value$ = ""
  for .i to nparameters
    labels_parameter_value$ = labels_parameter_value$ + "^^draw_parameter_value_label;"
  endfor
  size_parameter_value$ = "14"
  vp_parameter_value$ = "'.vpx1_parameter_value' '.vpx2_parameter_value' '.vpy1_parameter' '.vpy2_parameter'"
  layout_parameter_value$ = "1 'nparameters' 3 100 1"
  one_mark_parameter_value$ = "1 1"
  marks_parameter_value$ = ""

  .vpx1_parameter_upstep = .vpx2_parameter_value + 1
  .vpx2_parameter_upstep = .vpx1_parameter_upstep + 8
  vp_parameter_upstep$ = "'.vpx1_parameter_upstep' '.vpx2_parameter_upstep' '.vpy1_parameter' '.vpy2_parameter'"
  labels_parameter_upstep$ = ""
  for .i to nparameters
    labels_parameter_upstep$ = labels_parameter_upstep$ + "^^draw_parameter_upstep_label;"
  endfor
  size_parameter_upstep$ = size_parameter$
  layout_parameter_upstep$ = "1 'nparameters' 3 100 0"
  one_mark_parameter_upstep$ = "1 1"
  marks_parameter_upstep$ = ""

  .vpx1_parameter_downstep = .vpx2_parameter_upstep + 1
  .vpx2_parameter_downstep = .vpx1_parameter_downstep + 8
  vp_parameter_downstep$ = "'.vpx1_parameter_downstep' '.vpx2_parameter_downstep' '.vpy1_parameter' '.vpy2_parameter'"
  labels_parameter_downstep$ = ""
  for .i to nparameters
    labels_parameter_downstep$ = labels_parameter_downstep$ + "^^draw_parameter_downstep_label;"
  endfor
  size_parameter_downstep$ = size_parameter$
  layout_parameter_downstep$ = "1 'nparameters' 3 100 0"
  one_mark_parameter_downstep$ = "1 1"
  marks_parameter_downstep$ = ""

  vp_play$ = "'.vpx1_play' '.vpx2_play' '.vpy1_play' '.vpy2_play'"
  labels_play$ = "Play;"
  layout_play$ = "1 1 100 100 0"
  size_play$ = "16"
  one_mark_play$ = ""
  marks_play$ = ""


  vp_sound$ = "'.vpx1_sound' '.vpx2_sound' '.vpy1_sound' '.vpy2_sound'"
  labels_sound$ = "^^sound_draw;"
  layout_sound$ = "1 1 100 100 0"
  size_sound$ = "14"
  one_mark_sound$ = ""
  marks_sound$ = ""

  vp_spectrum$ = "'.vpx1_spectrum' '.vpx2_spectrum' '.vpy1_spectrum' '.vpy2_spectrum'"
  labels_spectrum$ = "^^spectrum_draw;"
  layout_spectrum$ = "1 1 100 100 0"
  size_spectrum$ = "14"
  one_mark_spectrum$ = ""
  marks_spectrum$ = ""

  vp_background$ = "'.vpx1_background' '.vpx2_background' '.vpy1_background' '.vpy2_background'"
  labels_background$ = "background;"
  layout_background$ = "1 1 5 100 0"
  size_background$ = "14"
  one_mark_background$ = ""
  marks_background$ = ""

  vp_model$ = "'.vpx1_model' '.vpx2_model' '.vpy1_model' '.vpy2_model'"
  labels_model$ = "model;"
  layout_model$ = "1 1 5 100 0"
  size_model$ = "14"
  one_mark_model$ = ""
  marks_model$ = ""

  vp_control$ ="'.vpx1_control' '.vpx2_control' '.vpy1_control' '.vpy2_control'"
  labels_control$ = "source;deriv;sound;"
  layout_control$ = "3 1 5 100 1"
  size_control$ = "16"
  one_mark_control$ = "1 1"
  marks_control$ = ""
  
endproc

procedure check_limits .name$ .min$ .max$
  if .min$ <> "n"
    if '.name$' < '.min$'
      '.name$' = '.min$'
    endif
  endif
  if .max$ <> "n"
    if '.name$' > '.max$'
      '.name$' = '.max$'
    endif
  endif
endproc

procedure klattgrid_set_values

  call check_limits pitch 10 n
  call check_limits flutter 0 1
  call check_limits power1 1 n
  call check_limits power2 'power1'+1 n
  call check_limits openPhase 0.05 1
  call check_limits collisionPhase 0 1
  call check_limits doublePulsing 0 1
  call check_limits spectralTilt 0 n
  call check_limits f1 10 n
  call check_limits b1 1 n
  call check_limits f2 10 n
  call check_limits b2 1 n
  call check_limits deltaF1 0 n
  call check_limits deltaB1 0 n
  call check_limits nasalF1 10 n
  call check_limits nasalB1 1 n
  call check_limits nasalAntiF1 10 n
  call check_limits nasalAntiB1 1 n

  select klattgrid
  xmid = (xmax+xmin)/2
  Remove voicing amplitude points... xmin xmax
  Add voicing amplitude point... xmid voicingAmp
  Remove pitch points... xmin xmax
  Add pitch point... xmid pitch
  Remove flutter points... xmin xmax
  Add flutter point... xmid flutter
  Remove power1 points... xmin xmax
  Add power1 point... xmid power1
  Remove power2 points... xmin xmax
  Add power2 point... xmid power2
  Remove open phase points... xmin xmax
  Add open phase point... xmid openPhase
  Remove collision phase points... xmin xmax
  Add collision phase point... xmid collisionPhase
  Remove double pulsing points... xmin xmax
  Add double pulsing point... xmid doublePulsing
  Remove spectral tilt points... xmin xmax
  Add spectral tilt point... xmid spectralTilt
  Remove aspiration amplitude points... xmin xmax
  Add aspiration amplitude point... xmid aspiration
  Remove breathiness amplitude points... xmin xmax
  Add breathiness amplitude point... xmid breathiness

  Remove oral formant frequency points... 1 xmin xmax
  Add oral formant frequency point... 1 xmid f1
  Remove oral formant bandwidth points... 1 xmin xmax
  Add oral formant bandwidth point... 1 xmid b1

  Remove oral formant frequency points... 2 xmin xmax
  Add oral formant frequency point... 2 xmid f2
  Remove oral formant bandwidth points... 2 xmin xmax
  Add oral formant bandwidth point... 2 xmid b2
    
  Remove delta formant frequency points... 1 xmin xmax
  Add delta formant frequency point... 1 xmid deltaF1
  Remove delta formant bandwidth points... 1 xmin xmax
  Add delta formant bandwidth point... 1 xmid deltaB1

  Remove nasal formant frequency points... 1 xmin xmax
  Add nasal formant frequency point... 1 xmid nasalF1
  Remove nasal formant bandwidth points... 1 xmin xmax
  Add nasal formant bandwidth point... 1 xmid nasalB1

  Remove nasal antiformant frequency points... 1 xmin xmax
  Add nasal antiformant frequency point... 1 xmid nasalAntiF1
  Remove nasal antiformant bandwidth points... 1 xmin xmax
  Add nasal antiformant bandwidth point... 1 xmid nasalAntiB1
  
endproc

procedure sound_draw .irow .vpx1 .vpx2 .vpy1 .vpy2
  demo Font size... 'size_sound$'
  demo Select outer viewport... .vpx1 .vpx2 .vpy1 .vpy2
  demo Axes... xmin xmax ymin ymax
  call klattgrid_set_values
  if sound_background > 0
    demo 'color_normal$'
    select sound_background
    demo Draw... xmin xmax ymin ymax n Curve
  endif
  if sound > 0
    select sound
    Remove
    select klattgrid
  endif
  if control$ = "deriv"
    sound = To Sound (phonation)... fs 1 1 1 1 1 "Powers in tiers" 1 1 1
  elsif control$ = "source"
    sound = To Sound (phonation)... fs 1 1 1 1 1 "Powers in tiers" 0 1 1
  elsif control$ = "sound"
    sound = To Sound
  endif
  demo 'color_parameter$'
  demo Draw... xmin xmax ymin ymax y Curve
endproc

procedure spectrum_draw .irow .vpx1 .vpx2 .vpy1 .vpy2
  demo Font size... 'size_sound$'
  demo Select outer viewport... .vpx1 .vpx2 .vpy1 .vpy2
  demo Axes... minimum_frequency maximum_frequency minimum_power maximum_power
  if spectrum_background > 0
    select spectrum_background
    demo 'color_normal$'
    .df = pitch / 2
    demo Draw... minimum_frequency+.df maximum_frequency+.df minimum_power+20 maximum_power+20 n
  endif
  if spectrum > 0
    select spectrum
    Remove
  endif
  select sound
  spectrum = To Spectrum... spectrum_calculation
  demo 'color_parameter$'
  demo Draw... minimum_frequency maximum_frequency minimum_power maximum_power y
  demo Marks bottom every... 1 500 y y y
endproc

procedure spectrum_options
  call debug spectrum_options
  if demoShiftKeyPressed ()
    beginPause ("Spectrum display options")
      real ("Minimum_frequency", minimum_frequency)
      real ("Maximum_frequency", maximum_frequency)
      real ("Minimum_power", minimum_power)
      real ("Maximum_power", maximum_power)
      optionMenu ("Spectrum_calculation", spectrum_calculation)
        option ("DFT")
        option ("FFT")
    .clicked = endPause ("Cancel", "OK", 2, 1)
    if .clicked = 2
      if minimum_frequency >= maximum_frequency
         minimum_frequency = 0
         maximum_frequency = 2000
      endif
      if minimum_power >= maximum_power
         minimum_power = 0
         maximum_power = 100
      endif
    endif
    call debug spectrum_options '.clicked' 'minimum_frequency' 'maximum_frequency' 'minimum_power' 'maximum_power'
  endif
endproc

procedure interface_definitions
  call interface_data
  call get_items 'button_types$'
  .ntypes = get_items.nitems
  for .i to .ntypes
    .type'.i'$ = get_items.item'.i'$
  endfor
  for .i to .ntypes
    .type$ = .type'.i'$
    .vp$ = vp_'.type$'$
    .labels$ = labels_'.type$'$
    .size$ = size_'.type$'$
    .layout$ = layout_'.type$'$
    call debug '.type$'; '.vp$'; '.layout$'; '.size$'; '.labels$'
    call  buttons_init_positions '.type$' '.vp$' '.layout$'
    call buttons_init_labels '.type$' '.size$' '.labels$'
    if one_mark_'.type$'$ <> ""
      .one_mark$ = one_mark_'.type$'$
      call buttons_set_one_mark '.type$' '.one_mark$'
    endif
    if marks_'.type$'$ <> ""
      .marks$ = marks_'.type$'$
      call buttons_set_marks '.type$' '.marks$'
    endif
  endfor
endproc

procedure buttons_init_positions .type$ .vpx1 .vpx2 .vpy1 .vpy2 .nx .ny .sx .sy .xon
  select buttons
  .nbuttons = .nx * .ny
  .dx = (.vpx2 - .vpx1) / ((1 + .sx) * .nx - 1)
  .dy = (.vpy2 - .vpy1) / ((1 + .sy) * .ny - 1)
  .bw = .sx * .dx
  .bh = .sy * .dy
  call debug '.type$' nx='.nx' ny='.ny' sx='.sx' sy='.sy' dx='.dx' dy='.dy' bw='.bw' bh='.bh'
  .ibutton = 1
  for .i to .ny
    for .j to .nx
      .x1 = .vpx1 + (.j - 1) * (1 + .sx) * .dx
      .x2 = .x1 + .bw
      .y2 = .vpy2 - (.i - 1) * (1 + .sy) * .dy
      .y1 = .y2 - .bh
      Append row
      .irow = Get number of rows
      Set string value...  .irow type '.type$'
      Set numeric value... .irow vpx1 .vpx1
      Set numeric value... .irow vpx2 .vpx2
      Set numeric value... .irow vpy1 .vpy1
      Set numeric value... .irow vpy2 .vpy2
      Set numeric value... .irow x1 .x1
      Set numeric value... .irow x2 .x2
      Set numeric value... .irow y1 .y1
      Set numeric value... .irow y2 .y2
      Set numeric value... .irow nbuttons .nbuttons
      Set numeric value... .irow ibutton .ibutton
      Set numeric value... .irow mark 0
      Set numeric value... .irow xon .xon
      Set numeric value... .irow clicked 0
      .ibutton += 1
    endfor
  endfor
endproc

procedure buttons_init_labels .type$ .size .labels$
  call buttons_findFirst '.type$'
  .irow = buttons_findFirst.irow
  if .irow = 0
     exit Type "'.type$'" not found.
  endif
  .nbuttons = 'bo$'[.irow, "nbuttons"]
  call get_items '.labels$'
  .nitems = get_items.nitems
  if .nitems <> .nbuttons
    exit Not enough labels for '.type$'
  endif
  for .i to .nbuttons
    .label$ = get_items.item'.i'$
    call parse_two '.label$'
    Set string value... .irow label 'parse_two.p2$'
    Set string value... .irow label_id 'parse_two.p1$'
    Set numeric value... .irow size .size
    .irow += 1
  endfor
endproc

procedure buttons_checkClickedIn
  select buttons
  .nrows = Get number of rows
  for .irow to .nrows
    demo Select inner viewport... 'bo$'[.irow,"vpx1"] 'bo$'[.irow,"vpx2"] 'bo$'[.irow,"vpy1"] 'bo$'[.irow,"vpy2"]
    demo Axes... 'bo$'[.irow,"vpx1"] 'bo$'[.irow,"vpx2"] 'bo$'[.irow,"vpy1"] 'bo$'[.irow,"vpy2"]
    Set numeric value... .irow clicked 0
    if demoClickedIn ('bo$'[.irow,"x1"], 'bo$'[.irow,"x2"], 'bo$'[.irow,"y1"], 'bo$'[.irow,"y2"])
      .type$ = 'bo$'$[.irow,"type"]
      .ibutton = 'bo$'[.irow,"ibutton"]
      .label_id$ = 'bo$'$[.irow,"label_id"]
      if 'bo$'[.irow,"xon"] <> 0
        call buttons_set_one_mark_xon '.type$' .ibutton
      endif
      Set numeric value... .irow clicked 1
    endif
  endfor  
endproc

# draw all the buttons
# if label_id matches ^^proc then call procedure proc for drawing

procedure buttons_draw
  select buttons
  .nrows = Get number of rows
  for .irow to .nrows
     select buttons
    .x1 = 'bo$'[.irow, "x1"]
    .x2 = 'bo$'[.irow, "x2"]
    .y1 = 'bo$'[.irow, "y1"]
    .y2 = 'bo$'[.irow, "y2"]
    .label_id$ = 'bo$'$[.irow,"label_id"]
    if index (.label_id$, label_is_procedure$) = 1
      .proc$ = replace$ (.label_id$, label_is_procedure$, "", 1)
      call '.proc$' .irow .x1 .x2 .y1 .y2
    else
      call one_button_draw .irow .x1 .x2 .y1 .y2
    endif
  endfor
endproc

procedure one_button_draw .irow .vpx1 .vpx2 .vpy1 .vpy2
  demo Select inner viewport... .vpx1 .vpx2 .vpy1 .vpy2
  demo Axes... .vpx1 .vpx2 .vpy1 .vpy2
  demo 'color_parameter$'
  demo Draw rounded rectangle... .vpx1 .vpx2 .vpy1 .vpy2 3
  if 'bo$'[.irow, "mark"] = 0
     demo 'color_normal$'
     demo Line width... 2
  endif
  .label$ = 'bo$'$[.irow, "label"]
  demo Font size... 'bo$'[.irow, "size"]
  demo Text... (.vpx1+.vpx2)/2 Centre (.vpy1+.vpy2)/2 Half '.label$'
  demo Line width... 1
  demo Font size... 18
endproc

# find index of first row for button type

procedure buttons_findFirst .type$
  select buttons
  .nrows = Get number of rows
  .irow = 0
  repeat
     .irow += 1 
  until  .irow > .nrows || 'bo$'$[.irow, "type"] = .type$
  if .irow > .nrows
    .irow = 0
  endif  
endproc

# Set one button value for type

procedure buttons_set_one_mark .type$ .index .value
  call buttons_findFirst '.type$'
  .irow = buttons_findFirst.irow
  if .irow = 0
     exit Type "'.type$'" not found.
  endif
  if .index > 'bo$'[.irow, "nbuttons"]
    exit Index '.index' larger than number of buttons for "'.type$'"
  endif
  Set numeric value... .irow+.index-1 mark .value
endproc

# Set an exclusive button for type

procedure buttons_set_one_mark_xon .type$ .index
  call buttons_set_marks '.type$' 0
  call buttons_set_one_mark '.type$' .index 1
endproc

procedure buttons_set_marks .type$ .value
  call buttons_findFirst '.type$'
  .irow = buttons_findFirst.irow
  if .irow = 0
     exit Type "'.type$'" not found.
  endif
  .nbuttons = 'bo$'[.irow,"nbuttons" ]
  for .i from .irow to .irow + .nbuttons - 1
    Set numeric value... .i mark .value
  endfor
endproc

procedure parse_two .s$
  .length = length (.s$)
  .colon = index (.s$, ":")
  if .colon = 0
    .not_present = 2
    .p1$ = .s$
    .p2$ = .s$
  elsif .colon = 1
    .not_present = 1
    .p2$ = right$ (.s$, .length - .colon)
    .p1$ = .p2$
  else
    .not_present = 0
    .p1$ = left$ (.s$, .colon - 1)
    .p2$ = right$ (.s$, .length - .colon)
  endif 
endproc

# get items form a list where elements are separated with delim$
# Sets up local variables .nitems, .item1$, .item2$, ... .item'.nitems$'$ etc 
# not re-entrant. Always get items immediately after call

procedure get_items .s$
  .nitems = 0
  repeat
    .dpos = index_regex (.s$, delim$)
    call debug get_items: '.dpos' "'.s$'"
    if .dpos > 0
      .nitems += 1
      .item$ = left$ (.s$, .dpos - 1)
      .item'.nitems'$ = .item$
      .s$ = replace$ (.s$,  .item$, "", 1)
      # strings may have \f \t etc. but no ;
      .s$ = replace_regex$ (.s$, "'delim$'", "", 1)
    endif
  until .dpos = 0
endproc

# saves some typing 
procedure debug .string$
  if debug
    printline '.string$'
  endif
endproc

procedure model .irow
  if 'bo$'[.irow, "clicked"] = 1
    .fontsize = 'size_sound$'
    demo Font size... .fontsize
    demo Select outer viewport... 10 100 0 90
    demo Axes... 0 1 0 1
    .kg = Create KlattGrid... kg 0 1 6 1 1 6  1 1 1
    demo Erase all
    demo Draw synthesizer... Cascade
  #  demo Teal
    demo Blue
    demo Dotted line
    .dx = 0.01
    .dy = 0.01
    demo Draw rectangle... -0.01 0.3 0.67 1.01
    demo Text special... 0.3-.dx right 1.01-.dy top Times .fontsize 0 1
    demo Draw rectangle... 0.31 0.4265 0.75 1.01

    .x1 = 0
    .y1 = 0.5
    .dy2 = 0.1
    demo Text special... .x1 left .y1-0*.dy2 half Times .fontsize 0 1 - Source
    demo Text special... .x1 left .y1-1*.dy2 half Times .fontsize 0 2 - Filter
    demo Text special... .x1 left .y1-2*.dy2 half Times .fontsize 0 3 - Coupling
    demo Text special... .x1 left .y1-3*.dy2 half Times .fontsize 0 4 - Fricatives

    demo Text special... 0.4265-.dx right 1.01-.dy top Times .fontsize 0 3
    demo Draw rectangle... 0.431 0.85 0.75 1.01
    demo Text special... 0.85-.dx right 1.01-.dy top Times .fontsize 0 2
    demo Draw rectangle... 0.31 0.85 -0.01 0.72
    demo Text special... 0.85-.dx right 0.72-.dy top Times .fontsize 0 4
    demo Solid line
    demo Select outer viewport... 0 100 90 100
    demo Text special... 0.5 centre 0.5 half Times 20 0 KlattGrid source-filter model
    Remove
    demoWaitForInput()
    demo Erase all
  endif
endproc