Posted to osm@bynets by andrewsh at Thu Apr 15 07:26:49 GMT 2010view raw

  1. package require tdom
  2.  
  3. if {[catch {package require know}]} {
  4. proc know {cond body} {
  5. if {![info complete $body]} {error "incomplete command(s) $body"}
  6. proc ::unknown {args} [string map [list @c@ $cond @b@ $body] {
  7. if {![catch {expr {@c@}} res eo] && $res} {
  8. return [eval {@b@}]
  9. }
  10. }][info body ::unknown]
  11. } ;# RS
  12. }
  13.  
  14. # node:
  15. # attrs
  16. # lat
  17. # lon
  18. # version
  19. # ...
  20. # tags
  21. # tag value
  22. # tag value
  23. # ...
  24.  
  25. # way:
  26. # attrs
  27. # version
  28. # changeset
  29. # ...
  30. # nodes
  31. # (list)
  32. # ref
  33. # tags
  34. # tag value
  35. # tag value
  36. # ...
  37.  
  38. # relation:
  39. # attrs
  40. # version
  41. # changeset
  42. # ...
  43. # members
  44. # (list)
  45. # ref
  46. # type
  47. # role
  48. # tags
  49. # tag value
  50. # tag value
  51. # ...
  52.  
  53. namespace eval osm::parser {
  54. variable tagstack {}
  55. variable parser
  56. variable nodes
  57. variable ways
  58. variable relations
  59. variable changesets
  60. variable id {}
  61.  
  62. set parser [xml::parser]
  63.  
  64. proc hs {name attlist} {
  65. variable tagstack
  66. variable id
  67. variable nodes
  68. variable ways
  69. variable relations
  70. # puts "hs: $tagstack"
  71. switch $name {
  72. node -
  73. way -
  74. relation {
  75. # puts "id, $name"
  76. set id [dict get $attlist id]
  77. set [set name]s($id) [dict create attrs [dict remove $attlist]]
  78. }
  79. tag {
  80. set type [lindex $tagstack end]
  81. # puts "tag, $type"
  82. switch $type {
  83. node -
  84. way -
  85. relation {
  86. # puts "dict set [set type]s($id) tags [dict get $attlist k] [dict get $attlist v]"
  87. dict set [set type]s($id) tags [dict get $attlist k] [dict get $attlist v]
  88. }
  89. default {puts $type}
  90. }
  91. }
  92. }
  93. lappend tagstack $name
  94. }
  95.  
  96. proc he name {
  97. variable tagstack
  98. set tagstack [lreplace $tagstack[set tagstack ""] end end]
  99. }
  100.  
  101. $parser configure -elementstartcommand hs -elementendcommand he
  102.  
  103. proc parse xml {
  104. variable parser
  105. $parser parse $xml
  106. }
  107.  
  108. proc unknown args {
  109. puts "unknown called: $args"
  110. }
  111. }
  112.  
  113. set f [open /media/ntfs/q/minsk.osm r]
  114. set xml [read $f]
  115. close $f
  116. osm::parser::parse $xml
  117.  
  118.  

Comments

Posted by andrewsh at Thu Apr 15 07:28:18 GMT 2010 [text] [code]

ehm, why do I need "know"? that's not needed here!