strick@forth:~/rez2021a/v1$ cat lap-r1.tcl
# ==> models/demo1.txt <==
# models,demo1,12345001,12345004,.

# ==> objects/12345001.txt <==
# objects,12345001,local,<120,200,100>,color,<1,0,0>,temp,1,.

# ==> objects/12345002.txt <==
# objects,12345002,local,<120,202,100>,color,<0,1,0>,temp,1,.

# ==> objects/12345003.txt <==
# objects,12345003,local,<120,204,100>,color,<0,0,1>,temp,1,.

proc with {var body} {
  upvar 1 $var v
  set saved $v
  uplevel 1 $body
  set v $saved
}
proc setm {vars xx} {
  set vars [string map {{,} { }} $vars]
  foreach var $vars x $xx {
    upvar 1 $var a
    set a $x
  }
}
proc count {var n body} {
  upvar 1 $var i
  for {set i 0} {$i < $n} {incr i} {
    # puts stderr "count: $var=$i $body\n"
    uplevel 1 $body
  }
}
proc triple_expr t {
  setm a,b,c [string map {{,} { }} $t]
  list [uplevel 1 expr $a] [uplevel 1 expr $b] [uplevel 1 expr $c]
}

proc +pos {triple body} {
  global POS
  with POS {
    setm a,b,c [triple_expr $triple]
    setm x,y,z [triple_expr $POS]
    set POS [list [expr {$a+$x}] [expr {$b+$y}] [expr {$c+$z}]]
    uplevel 1 $body
  }
}
proc *scale {triple body} {
  global SCALE
  with SCALE {
    setm a,b,c [triple_expr $triple]
    setm x,y,z [triple_expr $SCALE]
    set SCALE [list [expr {$a*$x}] [expr {$b*$y}] [expr {$c*$z}]]
    uplevel 1 $body
  }
}
proc =color {triple body} {
  global COLOR
  with COLOR {
    set COLOR [triple_expr $triple]
    uplevel 1 $body
  }
}
proc vec triple {
  setm a,b,c [triple_expr $triple]
  return "<$a,$b,$c>"
}
proc vec+ {p q} {
  setm a,b,c [triple_expr $p]
  setm x,y,z [triple_expr $q]
  return [triple_expr $a+$x,$b+$y,$c+$z]
}
proc box args {
  set temp 0
  foreach a $args {
    switch $a {
      -temp {set temp 1}
    }
  }
  global POS SCALE ROT COLOR CORNER
  # emit "temp,$temp,local,[vec $POS],scale,[vec $SCALE],euler,[vec $ROT],color,[vec $COLOR],."
  emit "temp,$temp,global,[vec [vec+ $CORNER $POS]],scale,[vec $SCALE],euler,[vec $ROT],color,[vec $COLOR],."
}
proc emit params {
  global ID
  incr ID
  set fd [open "objects/$ID.txt" w]
  puts $fd "objects,$ID,$params"
  puts stderr ">> objects,$ID,$params"
  close $fd
}
proc finish {model} {
  global GROUP ID
  set fd [open "models/$model.txt" w]
  puts $fd "models,$model,[expr {1+$GROUP}],[expr {1+$ID}]"
  puts stderr ">> models,$model,[expr {1+$GROUP}],[expr {1+$ID}]"
  close $fd
  unset GROUP ID
}

set Corner(Agirus)   [triple_expr 258048,261632+256,0]
set Corner(Pini)     [triple_expr 258048,261632,0]
set Corner(Pawpaw)   [triple_expr 258304,261632,0]
set Corner(Lappet)   [triple_expr 258048,261888,0]

set CORNER $Corner(Lappet)
set MODEL "lap-r1"
set GROUP 12349000
set ID $GROUP
set POS 0,0,0
set SCALE 1,1,1
set ROT 0,0,0
set COLOR .3,.3,.6
set YAW 0
set PITCH 0
set TEMP 1
set DEG_TO_RAD 0.017453292519943295

proc at xyz { global POS
  set POS [triple_expr $xyz]
}
proc yaw y { global YAW DEG_TO_RAD
  fincr YAW [expr {$DEG_TO_RAD*$y}]
}
proc x {n args} {
  count j $n {
    uplevel 1 $args
  }
}
proc fincr {var x} {
  upvar 1 $var z
  set z [expr {$z + $x}]
}
proc rail {d} { global YAW TEMP POS CORNER SCALE ROT COLOR Corner
  set ux [expr {cos($YAW)}]
  set uy [expr {sin($YAW)}]
  setm x,y,z [triple_expr $POS]
  fincr x [expr {0.5 * $ux * $d}]
  fincr y [expr {0.5 * $uy * $d}]

  set dest [vec+ $CORNER $x,$y,$z]
  setm dx,dy,dz $dest
  set dest_str [vec $dest]
  set intermediate ""
  setm pinix,piniy,piniz $Corner(Pini)
  if {$dy < $piniy + 50} {
    set intermediate "global,[vec [vec+ $Corner(Pini) 240,50,111]],"
  }
  emit "temp,$TEMP,${intermediate}global,$dest_str,scale,<$d,3,0.1>,euler,<0,0,$YAW>,color,[vec $COLOR],name,Guide,."
  fincr x [expr {0.5 * $ux * $d}]
  fincr y [expr {0.5 * $uy * $d}]
  set POS [triple_expr $x,$y,$z]
}

at 60,120,98.5
yaw 90
x 10 rail 10
count k 9 { yaw -10 ; rail 5 }
x 4 rail 10
count k 9 { yaw -10 ; rail 5 }
x 38 rail 10
count k 9 { yaw +10 ; rail 5 }
x 4 rail 9
count k 9 { yaw -10 ; rail 5 }
x 30 rail 10
finish $MODEL