Documentation Source Text

Check-in [461cf70bbf]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Continuing work on the syntax bubble-diagram generator.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 461cf70bbfa2336fd23e0d438064ce5b985cb586
User & Date: drh 2008-09-29 20:21:33
Context
2008-09-29
20:57
Continuing work on the syntax bubble-diagram generator. check-in: effc38b25c user: drh tags: trunk
20:21
Continuing work on the syntax bubble-diagram generator. check-in: 461cf70bbf user: drh tags: trunk
17:12
Add a prototype to a syntax bubble diagram generator script. check-in: 5f5eb0d82d user: drh tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to art/syntax/bubble-generator.tcl.

1
2
3
4
5
6
7


8
9

10









































































11
12
13
14
15
16
17
18
19
20
21
..
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
...
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
...
336
337
338
339
340
341
342

















































343
344
345
346
347
348
349
...
358
359
360
361
362
363
364
365

366


367
368
369
370
371
372
373
374
375
376
377
378













379
380
#!/bin/wish
#
# Run this wish script to generate syntax bubble diagrams from
# text descriptions.
#

# A canvas to draw on.


canvas .c -width 1000 -height 600
pack .c -fill both -expand 1











































































set tagcnt 0                      ;# tag counter
set font1 {Helvetica 18 bold}     ;# default token font
set font2 {Helvetica 18 italic}   ;# default variable font
set RADIUS 21                     ;# default turn radius


# Draw a right-hand turn around.  Approximately a ")"
#
proc draw_right_turnback {tag x y0 y1} {
  global RADIUS
  if {$y0 + 2*$RADIUS < $y1} {
................................................................................
  incr tagcnt
  set tag x$tagcnt
  if {[regexp {^[a-z]} $txt]} {
    set font $::font2
  } else {
    set font $::font1
  }
  set id1 [.c create text 0 0 -anchor w -text $txt -font $font -tags $tag]
  foreach {x0 y0 x1 y1} [.c bbox $id1] break
  set h [expr {$y1-$y0+4}]
  set rad [expr {($h+1)/2}]
  set top [expr {$y0-4}]
  set btm [expr {$y1+2}]
  set left [expr {$x0+4}]
  set right [expr {$x1-4}]
  if {$left>$right} {
    set left [expr {($x0+$x1)/2}]
    set right $left
  }
  .c create arc [expr {$left-$rad}] $top [expr {$left+$rad}] $btm \
       -width 2 -start 90 -extent 180 -style arc -tags $tag
  .c create arc [expr {$right-$rad}] $top [expr {$right+$rad}] $btm \
................................................................................
    set m($i) [set mx [draw_diagram $term]]
    set tx [lindex $mx 0]
    foreach {x0 y0 x1 y1} [.c bbox $tx] break
    set w [expr {$x1-$x0}]
    if {$w>$mxw} {set mxw $w}
    incr i
  }
  set mxw [expr {$mxw+10}]        ;# extra space for arrowheads

  set x0 0                        ;# entry x
  set x1 $sep                     ;# decender 
  set x2 [expr {$sep*2}]          ;# start of choice
  set x3 [expr {$mxw+$x2}]        ;# end of choice
  set x4 [expr {$x3+$sep}]        ;# accender
  set x5 [expr {$x4+$sep}]        ;# exit x
................................................................................
      set btm [expr {$ty1+$dy}]
    }
    .c addtag $tag withtag $t
    .c dtag $t $t
  }
  return [list $tag $x5 $exy]   
}


















































proc draw_diagram {spec} {
  set n [llength $spec]
  if {$n==1} {
    return [draw_bubble $spec]
  }
  if {$n==0} {
................................................................................
  }
  if {$cmd=="loop"} {
    return [draw_loop [lindex $spec 1] [lindex $spec 2]]
  }
  if {$cmd=="or"} {
    return [draw_or [lrange $spec 1 end]]
  }
  error "unknown operator: $cmd"

}



draw_diagram {line
  {stack
     {line CREATE {or {} TEMP TEMPORARY} TABLE}
     {or {} {line IF NOT EXISTS}}
     {line {or {} {line database-name .}} table-name}
     {or 
        {line ( {loop column ,} {loop {} {, constraint}} )}
        {line AS select}
     }
  }
  {}













}
.c move all 20 20






|
>
>
|
|
>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

|
|
|







 







|

|

|
|
|
|







 







|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|
>
|
>
>
|
<
<
<
|
<
<
<
<
|
|
<
>
>
>
>
>
>
>
>
>
>
>
>
>

<
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
...
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
...
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
...
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
...
483
484
485
486
487
488
489
490
491
492
493
494
495



496




497
498

499
500
501
502
503
504
505
506
507
508
509
510
511
512

#!/bin/wish
#
# Run this wish script to generate syntax bubble diagrams from
# text descriptions.
#

# Top-level displays
#
toplevel .bb
canvas .c -bg white
pack .c -side top -fill both -expand 1
wm withdraw .

# Graphs:
#
set all_graphs {
  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 {} {, constraint}} )}
          {line AS select}
       }
  }
  create-table-stmt-long {
    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 {} {, constraint}} )}
            {line AS select}
          }
       }
  }
  column-def {
    line column-name {or
        {}
        {line type-name}
        {line type-name ( number )}
        {line type-name ( number , number )}
    } {loop {} column-constraint}
  }
  column-def-b {
    line column-name {opt
        {line type-name 
            {opt
               {line ( number {opt {line , number}} )}
            }
        }
    } {loop {} column-constraint}
  }
  column-constraint {
    line
      {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}
      }
  }
  constraint {
     or
       {line {or {line PRIMARY KEY} UNIQUE}
             ( column-list ) conflict-clause}
       {line CHECK ( expr )}
  }
  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
}

set tagcnt 0                      ;# tag counter
set font1 {Helvetica 16 bold}     ;# default token font
set font2 {Helvetica 15 italic}   ;# default variable font
set RADIUS 13                     ;# default turn radius


# Draw a right-hand turn around.  Approximately a ")"
#
proc draw_right_turnback {tag x y0 y1} {
  global RADIUS
  if {$y0 + 2*$RADIUS < $y1} {
................................................................................
  incr tagcnt
  set tag x$tagcnt
  if {[regexp {^[a-z]} $txt]} {
    set font $::font2
  } else {
    set font $::font1
  }
  set id1 [.c create text 0 0 -anchor c -text $txt -font $font -tags $tag]
  foreach {x0 y0 x1 y1} [.c bbox $id1] break
  set h [expr {$y1-$y0+2}]
  set rad [expr {($h+1)/2}]
  set top [expr {$y0-2}]
  set btm [expr {$y1}]
  set left [expr {$x0+2}]
  set right [expr {$x1-2}]
  if {$left>$right} {
    set left [expr {($x0+$x1)/2}]
    set right $left
  }
  .c create arc [expr {$left-$rad}] $top [expr {$left+$rad}] $btm \
       -width 2 -start 90 -extent 180 -style arc -tags $tag
  .c create arc [expr {$right-$rad}] $top [expr {$right+$rad}] $btm \
................................................................................
    set m($i) [set mx [draw_diagram $term]]
    set tx [lindex $mx 0]
    foreach {x0 y0 x1 y1} [.c bbox $tx] break
    set w [expr {$x1-$x0}]
    if {$w>$mxw} {set mxw $w}
    incr i
  }
  set mxw [expr {$mxw+20}]        ;# extra space for arrowheads

  set x0 0                        ;# entry x
  set x1 $sep                     ;# decender 
  set x2 [expr {$sep*2}]          ;# start of choice
  set x3 [expr {$mxw+$x2}]        ;# end of choice
  set x4 [expr {$x3+$sep}]        ;# accender
  set x5 [expr {$x4+$sep}]        ;# exit x
................................................................................
      set btm [expr {$ty1+$dy}]
    }
    .c addtag $tag withtag $t
    .c dtag $t $t
  }
  return [list $tag $x5 $exy]   
}

proc draw_tail_branch {lx} {
  global tagcnt
  incr tagcnt
  set tag x$tagcnt
  set sep $::RADIUS
  set vsep [expr {$sep/2}]
  set n [llength $lx]
  set i 0
  foreach term $lx {
    set m($i) [set mx [draw_diagram $term]]
    incr i
  }

  set x0 0                        ;# entry x
  set x1 $sep                     ;# decender 
  set x2 [expr {$sep*2}]          ;# start of choice

  for {set i 0} {$i<$n} {incr i} {
    foreach {t texx texy} $m($i) break
    foreach {tx0 ty0 tx1 ty1} [.c bbox $t] break
    set dx [expr {$x2+10}]
    .c move $t $dx 0
    foreach {tx0 ty0 tx1 ty1} [.c bbox $t] break
    if {$i==0} {
      .c create line 0 0 $dx 0 -width 2 -tags $tag -arrow last
      .c create arc -$sep 0 $sep [expr {$sep*2}] \
         -width 2 -start 90 -extent -90 -tags $tag -style arc
      set btm $ty1
    } else {
      set dy [expr {$btm - $ty0 + $vsep}]
      if {$dy<2*$sep} {set dy [expr {2*$sep}]}
      .c move $t 0 $dy
      if {$dx>$x2} {
        .c create line $x2 $dy $dx $dy -width 2 -tags $tag -arrow last
      }
      set y1 [expr {$dy-2*$sep}]
      .c create arc $x1 $y1 [expr {$x1+2*$sep}] $dy \
          -width 2 -start 180 -extent 90 -style arc -tags $tag
      if {$i==$n-1} {
        .c create line $x1 [expr {$dy-$sep}] $x1 $sep -width 2 -tags $tag
      }
      set btm [expr {$ty1+$dy}]
    }
    .c addtag $tag withtag $t
    .c dtag $t $t
  }
  return [list $tag 0 0]
}

proc draw_diagram {spec} {
  set n [llength $spec]
  if {$n==1} {
    return [draw_bubble $spec]
  }
  if {$n==0} {
................................................................................
  }
  if {$cmd=="loop"} {
    return [draw_loop [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"} {
    return [draw_tail_branch [lrange $spec 1 end]]
  }



  error "unknown operator: $cmd"




}


proc draw_graph {name spec} {
  .c delete all
  wm deiconify .
  wm title . $name
  draw_diagram $spec
  foreach {x0 y0 x1 y1} [.c bbox all] break
  .c move all [expr {-$x0}] [expr {-$y0}]
  foreach {x0 y0 x1 y1} [.c bbox all] break
  .c config -width $x1 -height $y1
  update
  .c postscript -file $name.ps -width $x1 -height $y1
  exec convert -density 72x72 -antialias $name.ps $name.gif
  exec xv $name.gif &
}