Documentation Source Text

canvas .c -bg white
pack .c -side top -fill both -expand 1
wm withdraw .

# Graphs:
#
set all_graphs {
  alter-table-stmt {
    stack
       {line ALTER TABLE {opt {line database-name .}} table-name}
       {tailbranch
          {line RENAME TO new-table-name}
          {line ADD {opt COLUMN} column-def}
       }
  }
  X-create-table-stmt-1 {
    stack
       {line CREATE {or {} TEMP TEMPORARY} TABLE}
       {opt {line IF NOT EXISTS}}
       {line {opt {line database-name .}} table-name}
       {tailbranch
          {line ( {loop column-def ,} {loop {} {, table-constraint}} )}
          {line AS select-stmt}
       }
  }
  create-table-stmt {
    stack
       {line CREATE {or {} TEMP TEMPORARY} TABLE {opt {line IF NOT EXISTS}}}
       {line {opt {line database-name .}} table-name
          {tailbranch
            {line ( {loop column-def ,} {loop {} {, table-constraint}} )}
            {line AS select-stmt}
          }
       }
  }
  column-def {
    line column-name {or type-name nil} {loop {} column-constraint}
  }
  type-name {
     line {loop name {}} {or {}
        {line ( number )}
        {line ( number , number )}
     }
  }
  X-column-def-c {
    line column-name {or
        {}
        {line type-name}
        {line type-name ( number )}
        {line type-name ( number , number )}
    } {loop {} column-constraint}
  }
  X-column-def-b {
    line column-name {opt
        {line type-name 
            {opt
               {line ( number {opt {line , number}} )}
            }
        }
    } {loop {} column-constraint}
  }
  column-constraint {
    stack
      {opt {line CONSTRAINT name}}
      {or
         {line PRIMARY KEY conflict-clause {opt AUTOINCREMENT}}
         {line NOT NULL conflict-clause}
         {line UNIQUE conflict-clause}
         {line CHECK ( expr )}
         {line DEFAULT {or value {line ( expr )}}}
         {line COLLATE collation-name}
         {line foreign-key-clause}

      }
  }
  table-constraint {
     stack
       {opt {line CONSTRAINT name}}
       {or
          {line {or {line PRIMARY KEY} UNIQUE}
                ( column-list ) conflict-clause}
          {line CHECK ( expr )}
          {line FOREIGN KEY ( column-list ) foreign-key-clause }
       }
  }
  foreign-key-clause {
      stack 
        {line REFERENCES foreign-table {opt {line ( column-list )}}}
        {toploop
           {or
              {line ON {or DELETE UPDATE INSERT}
                       {or {line SET NULL} {line SET DEFAULT}
                           CASCADE RESTRICT
                       }
              }
              {line MATCH name}
              nil
           }
           {}
        }
        {or
          {line {opt NOT} DEFERRABLE 
             {or 
                {}
                {line INITIALLY DEFERRED}
                {line INITIALLY IMMEDIATE}
             }
          }
          nil
        }
  }
  X-foreign-key-action {
      or
         {line MATCH name}
         {line ON {or DELETE UPDATE INSERT}
                  {or {line SET NULL} {line SET DEFAULT}
                      CASCADE RESTRICT
                  }
         }
  }
  X-foreign-key-deferment {
     line {opt NOT} DEFERRABLE 
          {or 
              {}
              {line INITIALLY DEFERRED}
              {line INITIALLY IMMEDIATE}
          }
  }
  conflict-clause {
    opt {line ON CONFLICT {or ROLLBACK ABORT FAIL IGNORE REPLACE}}
  }
}

# Draw the button bar
#
set bn 0
foreach {name graph} $all_graphs {
  incr bn
  set b .bb.b$bn
  button $b -text $name -command [list draw_graph $name $graph]
  pack $b -side top -fill x -expand 1
}
incr bn
set b .bb.b$bn
button $b -text Everything -command {draw_all_graphs}
pack $b -side top -fill x -expand 1

set tagcnt 0                      ;# tag counter
set font1 {Helvetica 16 bold}     ;# default token font
set font2 {Helvetica 15}          ;# default variable font
set RADIUS 13                     ;# default turn radius
set DPI 80                        ;# dots per inch

# Draw a bubble containing $txt. 
#
proc draw_bubble {txt} {
  global tagcnt
  incr tagcnt
  set tag x$tagcnt
  if {$txt=="nil"} {
    return [list $tag 0 0]
  }
  if {[regexp {^[a-z]} $txt]} {
    set font $::font2
    set istoken 0
  } else {
    set font $::font1
    set istoken 1
  }

      set back_y [expr {$btm + $sep + 1}]
      .c move $t $enter_x $enter_y
      set e2 [expr {$exit_x + $sep}]
      .c create line $exit_x $exit_y $e2 $exit_y \
            -width 2 -tags $tag
      draw_right_turnback $tag $e2 $exit_y $back_y
      set e3 [expr {$enter_x-$sep}]
      set emid [expr {($e2+$e3)/2}]
      .c create line $e2 $back_y $emid $back_y \
                 -width 2 -tags $tag -arrow last
      .c create line $emid $back_y $e3 $back_y \
                 -width 2 -tags $tag
      set r2 [expr {($enter_y - $back_y)/2.0}]
      draw_left_turnback $tag $e3 $back_y $enter_y
      .c create line $e3 $enter_y $enter_x $enter_y \
                 -arrow last -width 2 -tags $tag
      set exit_x [expr {$enter_x + $exx}]
      set exit_y [expr {$enter_y + $exy}]
    }
    .c addtag $tag withtag $t
    .c dtag $t $t
    set btm [lindex [.c bbox $tag] 3]
  }
  set width [lindex [.c bbox $tag] 2]
  return [list $tag $exit_x $exit_y]
}

proc draw_loop {forward back} {
  global tagcnt
  incr tagcnt
  set tag x$tagcnt
  set sep $::RADIUS
  set vsep [expr {$sep/2}]

  foreach {ft fexx fexy} [draw_diagram $forward] break
  foreach {fx0 fy0 fx1 fy1} [.c bbox $ft] break
  set fw [expr {$fx1-$fx0}]
  foreach {bt bexx bexy} [draw_backwards_line $back] break
  foreach {bx0 by0 bx1 by1} [.c bbox $bt] break
  set bw [expr {$bx1-$bx0}]
  set dy [expr {$fy1 - $by0 + $vsep}]
  .c move $bt 0 $dy
  set biny $dy
  set bexy [expr {$dy+$bexy}]
  set by0 [expr {$dy+$by0}]
  set by1 [expr {$dy+$by1}]

  if {$fw>$bw} {
    set dx [expr {($fw-$bw)/2}]
    .c move $bt $dx 0
    set bexx [expr {$dx+$bexx}]
    .c create line 0 $biny $dx $biny -width 2 -tags $bt
    .c create line $bexx $bexy $fx1 $bexy -width 2 -tags $bt -arrow first
    set mxx $fexx
  } elseif {$bw>$fw} {
    set dx [expr {($bw-$fw)/2}]
    .c move $ft $dx 0
    set fexx [expr {$dx+$fexx}]
    .c create line 0 0 $dx $fexy -width 2 -tags $ft
    .c create line $fexx $fexy $bx1 $fexy -width 2 -tags $ft
    set mxx $bexx
  }
  .c addtag $tag withtag $bt
  .c addtag $tag withtag $ft
  .c dtag $bt $bt
  .c dtag $ft $ft
  .c move $tag $sep 0
  set mxx [expr {$mxx+$sep}]
  .c create line 0 0 $sep 0 -width 2 -tags $tag
  draw_left_turnback $tag $sep 0 $biny
  draw_right_turnback $tag $mxx $fexy $bexy
  foreach {x0 y0 x1 y1} [.c bbox $tag] break
  .c create line $mxx $fexy $x1 $fexy -width 2 -tags $tag
  return [list $tag $x1 $fexy]
}

proc draw_toploop {forward back} {
  global tagcnt
  incr tagcnt
  set tag x$tagcnt
  set sep $::RADIUS
  set vsep [expr {$sep/2}]

  foreach {ft fexx fexy} [draw_diagram $forward] break
  foreach {fx0 fy0 fx1 fy1} [.c bbox $ft] break
  set fw [expr {$fx1-$fx0}]
  foreach {bt bexx bexy} [draw_backwards_line $back] break
  foreach {bx0 by0 bx1 by1} [.c bbox $bt] break
  set bw [expr {$bx1-$bx0}]
  set dy [expr {-($by1 - $fy0 + $vsep)}]
  .c move $bt 0 $dy
  set biny $dy
  set bexy [expr {$dy+$bexy}]
  set by0 [expr {$dy+$by0}]
  set by1 [expr {$dy+$by1}]

  if {$fw>$bw} {
    set dx [expr {($fw-$bw)/2}]
    .c move $bt $dx 0
    set bexx [expr {$dx+$bexx}]
    .c create line 0 $biny $dx $biny -width 2 -tags $bt
    .c create line $bexx $bexy $fx1 $bexy -width 2 -tags $bt -arrow first
    set mxx $fexx
  } elseif {$bw>$fw} {
    set dx [expr {($bw-$fw)/2}]
    .c move $ft $dx 0
    set fexx [expr {$dx+$fexx}]
    .c create line 0 0 $dx $fexy -width 2 -tags $ft
    .c create line $fexx $fexy $bx1 $fexy -width 2 -tags $ft
    set mxx $bexx
  }
  .c addtag $tag withtag $bt
  .c addtag $tag withtag $ft
  .c dtag $bt $bt
  .c dtag $ft $ft
  .c move $tag $sep 0
  set mxx [expr {$mxx+$sep}]

  }
  if {$cmd=="stack"} {
    return [draw_stack [lrange $spec 1 end]]
  }
  if {$cmd=="loop"} {
    return [draw_loop [lindex $spec 1] [lindex $spec 2]]
  }
  if {$cmd=="toploop"} {
    return [draw_toploop [lindex $spec 1] [lindex $spec 2]]
  }
  if {$cmd=="or"} {
    return [draw_or [lrange $spec 1 end]]
  }
  if {$cmd=="opt"} {
    return [draw_or [list {} [lindex $spec 1]]]
  }
  if {$cmd=="tailbranch"} {

  .c config -width $x1 -height $y1
  update
  .c postscript -file $name.ps -width $x1 -height $y1
  global DPI
  exec convert -density ${DPI}x$DPI -antialias $name.ps $name.gif
  exec xv $name.gif &
}

proc draw_all_graphs {} {
  global all_graphs
  foreach {name graph} $all_graphs {
    if {[regexp {^X-} $name]} continue
    draw_graph $name $graph
  }
  wm withdraw .
}