tclsh tschords.tcl -file DGBE-Fadd9.svg -chord Fadd9 -positions 3213 \
     -fingering RMIP -root R000 -nfrets 4 -width 200 -height 240 -tuning DGBE
tclsh tschords.tcl -file out.svg -chord Dsus4 -positions XX0233 \ 
      -fingering 000IRP -root 00R000 -nfrets 5 -width 200 -height 240 -tuning ""

#!/usr/bin/env tclsh
#  Created By    : Detlef Groth
#  Created       : Tue Jan 18 05:24:20 2022
#  Last Modified : <220119.0627>
#
#  Description         : Simple Chord chart generator for fretted instrruments
#        
#  Copyright (c) 2022 Detlef Groth.
# 
#  License: MIT
#  
##############################################################################

proc svgChord {argv} {
    array set args {
                    -file      out.svg
                    -tuning    EADGBE
                    -fingering 0RM0I0
                    -positions X32010
                    -root      0R00R0
                    -chord     Cmaj
                    -width     400
                    -height    480
                    -nfrets    6
                }
    array set args $argv
    set height $args(-height)
    set width $args(-width)
    set hmargin [expr  {$width/12}]
    set vmargin [expr  {$height/15}]
    set ystep [expr {$height/15}]
    set xstep [expr {($width-2*$hmargin+1)/([string length $args(-positions)]-1)}]    
    # not used yet
    if {$width<400} {
        set stroke1 6
        set stroke2 2
    }
    # scaling for font in dependence of given width
    set fsunit [expr {int((6*$width)/400)}]
    set cy 0 ;# currenty y position in chart
    set out [open $args(-file) w 0600]
    puts $out "<svg xmlns=\"http://www.w3.org/2000/svg\" version=\"1.1\" xmlns:xlink=\"http://www.w3.org/1999/xlink\" xmlns:svgjs=\"http://svgjs.com/svgjs\" preserveAspectRatio=\"xMidYMid meet\" viewBox=\"0 0 $width $height\">"
    # grey background
    puts $out "<rect width=\"100%\" height=\"100%\" fill=\"#eeeeee\"></rect>"
    # Display Chord on top
    if {$args(-chord) ne ""} {
        incr cy $ystep
        puts $out "<text x=\"[expr {$width/2}]\" y=\"$cy\" font-family=\"serif\" font-size=\"[expr {$fsunit*8}]\" text-anchor=\"middle\" dominant-baseline=\"central\" fill=\"#000000\">$args(-chord)</text>"    
    }
    incr cy $ystep
    # strings
    incr cy [expr {int($ystep*0.9)}]
    set ystart $cy
    # draw nut
    puts $out "<line x1=\"[expr {$hmargin-2}]\" y1=\"$cy\" x2=\"[expr {$width-$hmargin+2}]\" y2=\"$cy\" stroke-width=\"8\" stroke=\"#000000\"></line>"
    # available space
    if {$args(-tuning) ne ""} {
        set yrange [expr {$height-$vmargin*2-$cy}]
    } else {
        set yrange [expr {$height-$vmargin-$cy}]
    }
    # draw frets
    set ystep [expr {$yrange/$args(-nfrets)}]
    set x1 $hmargin
    set x2 [expr {$width-$hmargin}]
    for {set i 0} {$i < $args(-nfrets)} {incr i} {
        incr cy $ystep
        puts $out "<line x1=\"$x1\" y1=\"$cy\" x2=\"$x2\" y2=\"$cy\" stroke-width=\"3\" stroke=\"#000000\"></line>"
        set y1a $cy
        incr y1a [expr {int($ystep/2)}]
        set x1a [expr {$width/2}]
        if {$i in [list 1 3]} {
            # position markers
            if {$i == 1 || ($i == 3 && $args(-nfrets) > 4)} {
                puts $out "<text x=\"$x1a\" y=\"$y1a\" font-family=\"sans-serif\" font-size=\"[expr {$fsunit*8}]\" text-anchor=\"middle\" dominant-baseline=\"central\" fill=\"#000000\"> \u00D7</text>"
            }
        }
    }
    set yend $cy
    set x1 $hmargin
    # draw draw strings and fingerboard
    set notes [lrange [split [regsub -all {([A-Z])} $args(-tuning) ";\\1"] ";"] 1 end]
    for {set x 0} {$x < [string length $args(-positions)]} {incr x} {
        # draw strings
        puts $out "<line x1=\"$x1\" y1=\"$ystart\" x2=\"$x1\" y2=\"$yend\" stroke-width=\"3\" stroke=\"#000000\"></line>"
        set pos [string range $args(-positions) $x $x]
        # draw indicators above the nut
        if { $pos == "X"} {
            puts $out "<text x=\"$x1\" y=\"[expr {$ystart-0.35*$ystep}]\" font-family=\"sans-serif\" font-size=\"[expr {$fsunit*6}]\" text-anchor=\"middle\" dominant-baseline=\"central\" fill=\"#000000\">\u00D7</text>"
        } elseif { $pos == "0"} {
            puts $out "<circle r=\"[expr {$fsunit*1.7}]\" cx=\"$x1\" cy=\"[expr {$ystart-0.35*$ystep}]\" fill=\"white\" stroke-width=\"2\" stroke=\"black\"></circle>"   
        }
        # root note indicator
        set root [string range $args(-root) $x $x] 
        if {$root == "R"} {
            puts $out "<circle r=\"[expr {$fsunit*1.7}]\" cx=\"$x1\" cy=\"[expr {$ystart-0.35*$ystep}]\" fill=\"black\" stroke-width=\"2\" stroke=\"black\"></circle>"   
        }
        if {[llength $notes] >= $x} {
             set tun [lindex $notes $x]
             puts $out "<text x=\"$x1\" y=\"[expr {$yend+0.35*$ystep}]\" font-family=\"serif\" font-size=\"[expr {$fsunit*6}]\" text-anchor=\"middle\" dominant-baseline=\"central\" fill=\"#000000\">$tun</text>"
         }
        incr x1 $xstep
    }
    # draw fingerings
    set cx $hmargin
    set cy $ystart
    for {set y 0} {$y < $args(-nfrets)} {incr y} {
        for {set x 0} {$x < [string length $args(-positions)]} {incr x} {
            set pos [string range $args(-positions) $x $x]
            if {[expr {$y+1}] == $pos} {
                puts $out "<circle r=\"[expr {$fsunit*3}]\" cx=\"$cx\" cy=\"[expr {$cy+0.5*$ystep}]\" fill=\"black\" stroke-width=\"2\" stroke=\"black\"></circle>" 
                if {[string length $args(-fingering)] >= $x} {
                    set fing [string range $args(-fingering) $x $x]
                    puts $out "<text x=\"$cx\" y=\"[expr {$cy+0.51*$ystep}]\" font-family=\"sans-serif\" font-size=\"[expr {$fsunit*4}]\" text-anchor=\"middle\" dominant-baseline=\"central\" fill=\"#FFFFFF\">$fing</text>"
                }
            }
            incr cx $xstep
        }
        incr cy $ystep
        set cx $hmargin
    }

    puts $out "</svg>"
    close $out
}

if {[info exists argv] && [llength $argv] == 0} {
    puts "tschord.tcl - drawing chord diagrams for fretted instruments"
    puts "Author: Detlef Groth, Caputh-Schwielowsee, Germany"
    puts "License: MIT\n"
    puts "Usage: tschords.tcl -file file.svg -tuning EADGBE \
          -fingering 00MRI0 -positions x02210 -chord Am"
} else {
    svgChord $argv      
}