Inline LDraw Files
Recursively replace LDraw part references with part contents, thereby reducing the model to primitives.
This is a Tcl prototype. It works, but lacks proper configuration options and other niceties. It is also incredibly slow.
Happily, a robust C implementation is feasible.
#!/usr/bin/tclsh
proc Main {} {
global parts contents model env
array set parts {}
array set contents {}
array set model {}
# Index LDraw directory structure.
if {[catch {IndexLDraw $env(LDRAWDIR)} err]} {
puts stderr "Could not index LDraw directory: $err"
exit 1
}
# Index unofficial LDraw directory structure, if present.
if {[file isdirectory [file join $env(LDRAWDIR) "Unofficial"]]} {
if {[catch {IndexLDraw [file join $env(LDRAWDIR) "Unofficial"]} err]} {
puts stderr "Could not index Unofficial LDraw directory: $err"
exit 1
}
}
# Parse the input (possibly as an MPD)
set submodels [MPD [read -nonewline stdin]]
if {([llength $submodels] > 1) && ([lindex $submodels 0] eq "")} {
set mainModel [lindex $submodels 1]
} else {
set mainModel [lindex $submodels 0]
}
# Inline the model
Inline [list model $mainModel] 7 {0 0 0 1 0 0 0 1 0 0 0 1} 1
}
proc Transform { x y z dx dy dz a b c d e f g h i } {
return [list \
[expr {($a * $x) + ($b * $y) + ($c * $z) + ($dx)}] \
[expr {($d * $x) + ($e * $y) + ($f * $z) + ($dy)}] \
[expr {($g * $x) + ($h * $y) + ($i * $z) + ($dz)}]]
}
proc Product { x1 y1 z1 a1 b1 c1 d1 e1 f1 g1 h1 i1 x2 y2 z2 a2 b2 c2 d2 e2 f2 g2 h2 i2 } {
return [list \
[expr {($a1 * $x2) + ($b1 * $y2) + ($c1 * $z2) + $x1}] \
[expr {($d1 * $x2) + ($e1 * $y2) + ($f1 * $z2) + $y1}] \
[expr {($g1 * $x2) + ($h1 * $y2) + ($i1 * $z2) + $z1}] \
[expr {($a1 * $a2) + ($b1 * $d2) + ($c1 * $g2)}] \
[expr {($a1 * $b2) + ($b1 * $e2) + ($c1 * $h2)}] \
[expr {($a1 * $c2) + ($b1 * $f2) + ($c1 * $i2)}] \
[expr {($d1 * $a2) + ($e1 * $d2) + ($f1 * $g2)}] \
[expr {($d1 * $b2) + ($e1 * $e2) + ($f1 * $h2)}] \
[expr {($d1 * $c2) + ($e1 * $f2) + ($f1 * $i2)}] \
[expr {($g1 * $a2) + ($h1 * $d2) + ($i1 * $g2)}] \
[expr {($g1 * $b2) + ($h1 * $e2) + ($i1 * $h2)}] \
[expr {($g1 * $c2) + ($h1 * $f2) + ($i1 * $i2)}]]
}
proc Inline { ref parentcolor transform in_mpd } {
global model contents
set arr [lindex $ref 0]
set key [lindex $ref 1]
foreach line [set ${arr}($key)] {
if {[regexp {^\s*0\s+} $line]} {
# comment
#puts $line
} elseif {[scan $line " 1 %d %f %f %f %f %f %f %f %f %f %f %f %f %s" \
color dx dy dz a b c d e f g h i part] == 14} {
# part reference
if {$color == 16} {
set color $parentcolor
}
if {$in_mpd && [info exists model($part)]} {
# if this part exists as an MPD submodel, use it
Inline [list model $part] $color \
[eval Product $transform $dx $dy $dz $a $b $c $d $e $f $g $h $i] 1
} else {
# otherwise, use a part from the library
if {[catch {PartsRetrieve $part} partref]} {
puts stderr $partref
} else {
Inline $partref $color \
[eval Product $transform $dx $dy $dz $a $b $c $d $e $f $g $h $i] 0
}
}
} elseif {[scan $line " 2 %d %f %f %f %f %f %f " \
color x1 y1 z1 x2 y2 z2] == 7} {
# line
if {$color == 16} {
set color $parentcolor
}
puts [eval {format "2 %d %f %f %f %f %f %f" $color} \
[eval {Transform $x1 $y1 $z1} $transform] \
[eval {Transform $x2 $y2 $z2} $transform]]
} elseif {[scan $line " 3 %d %f %f %f %f %f %f %f %f %f " \
color x1 y1 z1 x2 y2 z2 x3 y3 z3] == 10} {
# triangle
if {$color == 16} {
set color $parentcolor
}
puts [eval {format "3 %d %f %f %f %f %f %f %f %f %f" $color} \
[eval {Transform $x1 $y1 $z1} $transform] \
[eval {Transform $x2 $y2 $z2} $transform] \
[eval {Transform $x3 $y3 $z3} $transform]]
} elseif {[scan $line " 4 %d %f %f %f %f %f %f %f %f %f %f %f %f " \
color x1 y1 z1 x2 y2 z2 x3 y3 z3 x4 y4 z4] == 13} {
# quadrilateral
if {$color == 16} {
set color $parentcolor
}
puts [eval {format "4 %d %f %f %f %f %f %f %f %f %f %f %f %f" $color} \
[eval {Transform $x1 $y1 $z1} $transform] \
[eval {Transform $x2 $y2 $z2} $transform] \
[eval {Transform $x3 $y3 $z3} $transform] \
[eval {Transform $x4 $y4 $z4} $transform]]
} elseif {[scan $line " 5 %d %f %f %f %f %f %f %f %f %f %f %f %f " \
color x1 y1 z1 x2 y2 z2 x3 y3 z3 x4 y4 z4] == 13} {
# conditional line
if {$color == 16} {
set color $parentcolor
}
puts [eval {format "5 %d %f %f %f %f %f %f %f %f %f %f %f %f" $color} \
[eval {Transform $x1 $y1 $z1} $transform] \
[eval {Transform $x2 $y2 $z2} $transform] \
[eval {Transform $x3 $y3 $z3} $transform] \
[eval {Transform $x4 $y4 $z4} $transform]]
} else {
# unrecognized statement
#puts $line
}
}
}
proc IndexDir { path {prefix ""} } {
global parts
if {![file isdirectory $path]} {
return -code error "No such directory: $path"
}
foreach match [glob -nocomplain -join $path *.{dat,DAT}] {
set parts([string tolower [format "%s%s" $prefix [file tail $match]]]) $match
}
}
proc IndexLDraw { path } {
IndexDir [file join $path "parts"]
IndexDir [file join $path "parts" "s"] "s\\"
IndexDir [file join $path "p"]
IndexDir [file join $path "p" "48"] "48\\"
}
proc PartsRetrieve { part } {
global parts contents
set part [string tolower $part]
if {[info exists contents($part)]} {
return [list contents $part]
} elseif {[info exists parts($part)]} {
if {[catch {open $parts($part)} f]} {
return -code error "Cannot open part file: $f"
}
set contents($part) [split [read -nonewline $f] \n]
close $f
return [list contents $part]
} else {
return -code error "Part not recognized: $part"
}
}
proc MPD { input } {
global model
set submodels {}
set name {}
foreach line [split $input \n] {
# if this input line marks the beginning of a submodel, set name accordingly
# also, or if this is the end of a submodel, skip to the next line
if {[regexp {^\s*0\s+(?:FILE|file)\s+(\S+)\s*$} $line match name]
|| [regexp {^\s*0\s+(?:NOFILE|nofile)\s*$} $line]} {
continue
}
# gets tested each line; could test in regexp block above,
# as long as we handle anonymous submodel somehow
if {[lsearch $submodels $name] == -1} {
lappend submodels $name
}
# otherwise, append this line to the current submodel
lappend model($name) $line
}
return $submodels
}
#fconfigure stdout -translation crlf
Main