#!/bin/sh
#\
exec ${GOOD_ROOT_DIR}/bin/vr_scene $0 $*

VR_position { 0 0 18 }
VR_msg {Welcome in front of Ekki's (virtual) house. You should enjoy the view from the balcony.}

proc XMODE {} {
    # 1  wireframe
    # 2  filled
    # 3  + glass parts
    # 4  +
    # 5  + interior
    return 1
}

if {[XMODE] > 1} {AttributeObject -fillstyle 1}

##########################################################################
# materials:

set WINDOW {{1.0 1.0 1.0} {0.1 0.1 0.4} {0.2 0.2 0.2} {0 0 0} 0.8 1.1 1 ""}
set MESSING {{0.2 0.2 0.2} {0.2 0.2 0.2} {1 1 0} {0 0 0} 0 1 1 ""}

##########################################################################

Tcl_Primitive XLamp {} {} Name String {Creates a new {ARG 1 Lamp}.} {
    global MESSING XLamps
    if [catch {set XLamps}] {set XLamps $THIS} { set XLamps [concat $XLamps $THIS]}
    $THIS -surface $MESSING
    Cylinder $THIS.c 0.05 4
    $THIS.c -father $THIS -translate { 0 2 0}
    $THIS.c -rotate {-1.57 0 0 }
    Cylinder $THIS.cc 0.05 1
    $THIS.cc -father $THIS -translate { 0 4 0.5}
    Cone $THIS.co 0.4 0.4
    $THIS.co -father $THIS -translate { 0 4 1} 
    $THIS.co -rotate {1.57 0 0 } -open
    Sphere $THIS.sp 0.15
    $THIS.sp -father $THIS.co -translate {0 0 0.3} -diffuse {1 1 1} -transmission 1 
    PointLight $THIS.pl
    $THIS.pl -color {0.4 0.4 0.2}
}

Tcl_Method XLamp -updateLamp {} {} {Update lamp position.} {
    set mat [$THIS.sp -get_worldMatrix]
    $THIS.pl -origin "[lindex $mat 3] [lindex $mat 7] [lindex $mat 11]"
}

Tcl_Method XLamp -get_lamp {} {} {Return light source.} {
    return $THIS.pl
}

##########################################################################

Tcl_Primitive Door {} angle Door String {Creates a {ARG 1 Door}.} {
    $THIS -diffuse { .6 0.4 0} 
    Quader $THIS.1 1 2 0.05
    $THIS.1 -father $THIS -translate { 0.5 0 0}
    Cylinder $THIS.2 0.05 0.1
    $THIS.2 -father $THIS -diffuse {1 1 1}  -translate { 0.85 0 0}

    set $THIS->angle 0
    $THIS -open [set $THIS->angle 0]
}

Tcl_Method Door -open newAngle Double {Open the door with a certain {ARG 1 Angle} in radiants. 0 means that the door is closed.} {
    $THIS -rotate "0 [set $THIS->angle] 0"
    set $THIS->angle $newAngle
    $THIS -rotate "0 -[set $THIS->angle] 0"
} 

Tcl_Method Door -close {} {} {Close the door.} {
    $THIS -open 0
} 

##########################################################################

Tcl_Primitive Table {} {} Name String {Creates a {ARG 1 Table}.} {
    $THIS -diffuse {0 0 1} -translate { 0 -0.2 0}
    Cylinder $THIS.c 0.5 0.05
    $THIS.c -father $THIS -translate { 0 0.925 0} -diffuse {0.2 0.2 0.8} \
	    -specular { 0.3 0.3 0.3} -transmission 1 -refraction 1.33
    Cylinder $THIS.c1 0.02 0.7
    $THIS.c1 -father $THIS -translate { 0.2 0.55 0.2}
    Cylinder $THIS.c2 0.02 0.7
    $THIS.c2 -father $THIS -translate { -0.2 0.55 0.2}
    Cylinder $THIS.c3 0.02 0.7
    $THIS.c3 -father $THIS -translate { 0.2 0.55 -0.2}
    Cylinder $THIS.c4 0.02 0.7
    $THIS.c4 -father $THIS -translate { -0.2 0.55 -0.2}
    foreach c [$THIS -get_children] { $c -rotate { -1.571 0 0} }
}

##########################################################################

Tcl_Primitive Armchair {} {} Name String {Creates an {ARG 1 Armchair}.} {
    Quader $THIS.q 1 0.4 1
    $THIS.q -father $THIS -diffuse { 0.1 0.1 0.1} -translate { 0 0.2 0}
    Quader $THIS.qq 1 0.3 1
    $THIS.qq -father $THIS.q -diffuse { 0.9 0.7 0.3} -translate { 0 0.3 0}
    Cylinder $THIS.cqq 0.15 1
    $THIS.cqq -father $THIS.qq -translate { -0.5 0 0}
    [Top $THIS.tqq] -father $THIS.qq -translate {0.5 0 0}
    $THIS.tqq -rotate {0 0 1}
    Quader $THIS.qqq 0.6 0.3 1
    $THIS.qqq -father $THIS.tqq -translate { 0.3 0 0}
    Cylinder $THIS.cqqq 0.15 1
    $THIS.cqqq -father $THIS.qqq -translate { -0.3 0 0}
    Cylinder $THIS.ccqqq 0.15 1
    $THIS.ccqqq -father $THIS.qqq -translate { 0.3 0 0}
}

##########################################################################

Tcl_Primitive Sit {} {} Sit String {Creates a {ARG 1 Sit}.} {
    $THIS -diffuse {0 1 0}
    Cylinder $THIS.c 0.2 0.05
    $THIS.c -father $THIS -translate { 0 0.7 0} 
    $THIS.c -rotate { -1.571 0 0}
    Quader $THIS.q 0.4 0.6 0.05
    $THIS.q -father $THIS -translate { 0 1 0.2} 
    $THIS.q -rotate { 0.1 0 0}
    Cylinder $THIS.c2 0.02 0.7
    $THIS.c2 -father $THIS -translate { 0 0.35 0} 
    $THIS.c2 -rotate { -1.571 0 0}
}

##########################################################################

Tcl_Primitive StairCase {} {} Name String {Creates a new {ARG 1 Staircase}.} {
    global MESSING
    $THIS -diffuse { 0.7 0.4 0}
    Cylinder $THIS.cy 0.02 3.4
    $THIS.cy -father $THIS -surface MESSING 
    $THIS.cy -rotate {-1.57 0 0}
    $THIS.cy -translate {0 0 1.7}
    Sphere $THIS.sp 0.04
    $THIS.sp -father $THIS -surface MESSING -translate { 0 3.4 0}
    
    set cnt 10
    for { set i 0} { $i <= $cnt} { incr i} {
	set fac [expr $i/$cnt.0]
	Top $THIS.t$i
	$THIS.t$i -father $THIS -rotate "0 [expr $fac*3.14] 0"
	Quader $THIS.q$i 0.9 0.05 0.2
	$THIS.q$i -father $THIS.t$i -translate "0.5 [expr $fac * 2.5] 0"  
    }
}

##########################################################################

Tcl_Primitive SitGroup {} {} Name String {Creates a new {ARG 1 Group} of sits and a table.} {
	
    # table:
    Table $THIS.ta
    $THIS.ta -father $THIS 

    # sits:
    Sit $THIS.sit1
    $THIS.sit1 -father $THIS -translate {1 0 0}
    $THIS.sit1 -rotate { 0 1.7 0}
    Sit $THIS.sit2
    $THIS.sit2 -father $THIS -translate {-0.8 0 0.2}
    $THIS.sit2 -rotate { 0 -1.5 0}
    Sit $THIS.sit3
    $THIS.sit3 -father $THIS -translate {0 0 -1}
    $THIS.sit3 -rotate { 0 -3 0}
    Sit $THIS.sit4
    $THIS.sit4 -father $THIS -translate {0 0 1}
}

##########################################################################

Tcl_Primitive Block {} {} {Name Width} {String Double} {{ARG 1 Name}.} {
    [Quader $THIS.q $Width 2.5 0.2] -father $THIS 
    $THIS.q -translate { 0 0 -0.1}
}

##########################################################################

Tcl_Primitive SpecialBlock {} {} {Name Width} {String Double} {{ARG 1 Name}.} {
    global WINDOW
    [Quader $THIS.qt $Width 0.3 0.2] -father $THIS -translate { 0 1.1 -0.1} 
    if {[XMODE] > 2 } {
	[Quader $THIS.qw $Width 1.8 0.2] -father $THIS -surface $WINDOW
	$THIS.qw -transmission 0.4 -specular {0.2 0.2 0.5} -translate { 0 0.1 -0.1} 
    }
    [Quader $THIS.qb $Width 0.5 0.2] -father $THIS -diffuse {0.2 0.31}
    $THIS.qb -translate { 0 -1 -0.1}
}

##########################################################################
   
Tcl_Primitive DoorBlock {} {} {Name Width} {String Double} {{ARG 1 Name}.} {
    [Quader $THIS.q $Width 2.5 0.2] -father $THIS
    $THIS.q -translate { 0 0 -0.1}
}

##########################################################################

Tcl_Primitive WindowBlock {} {} {Name Width WindowWidth} {String Double Double} {{ARG 1 Name}.} {
    global WINDOW 
    set W2 [expr $Width/2]
    set WW2 [expr $WindowWidth/2]
    set WW $WindowWidth
    set NW2 [expr $W2-$WW2]
    Quader $THIS.ql $NW2 2.5 0.2
    $THIS.ql -father $THIS -translate "[expr -$W2+$NW2*0.5] 0 -0.1"
    Quader $THIS.qt $WW 1 0.2
    $THIS.qt -father $THIS -translate "0 -0.75 -0.1"
    if {[XMODE] > 2 } {
	Quader $THIS.w $WW 1.1 0.05
	$THIS.w -father $THIS -translate "0 0.30 -0.1" -surface $WINDOW
    }
    Quader $THIS.ww $WW 0.1 0.3
    $THIS.ww -father $THIS -translate "0 -0.2 -0.1" -diffuse {0.6 0.3 0.2}
    
    Quader $THIS.qb $WW 0.4 0.2
    $THIS.qb -father $THIS -translate "0 1.05 -0.1"
    Quader $THIS.qr $NW2 2.5 0.2
    $THIS.qr -father $THIS -translate "[expr $W2-$NW2*0.5] 0 -0.1"
}

##########################################################################

Tcl_Primitive StackBlock {} {} {Name Width} {String Double} {{ARG 1 Name}.} {
    global WINDOW 
    set W2 [expr $Width/2]
    set WW2 0.5
    set WW 1
    set NW2 [expr $W2-$WW2]
    Quader $THIS.ql $NW2 2.5 0.2
    $THIS.ql -father $THIS -translate "[expr -$W2+$NW2*0.5] 0 -0.1"
    Quader $THIS.qt $WW 0.4 0.2
    $THIS.qt -father $THIS -translate "0 1.05 -0.1"
    if {[XMODE] > 2 } {
	Quader $THIS.w $WW 0.4 0.05 
	$THIS.w -father $THIS -translate "0 0.65 -0.1" -surface $WINDOW
    }
    Quader $THIS.qb $WW 1.7 0.2
    $THIS.qb -father $THIS -translate "0 -0.4 -0.1"
    Quader $THIS.qr $NW2 2.5 0.2
    $THIS.qr -father $THIS -translate "[expr $W2-$NW2*0.5] 0 -0.1"
}

##########################################################################

Tcl_Primitive Door2 {} {angle right} {Name Flag} {String Integer} {{ARG 1 Name}.} {
    global WINDOW
    global MESSING

    Cylinder $THIS.c 0.03 2
    $THIS.c -father $THIS -surface $MESSING -rotate {-1.57 0 0}
    $THIS.c -translate {0 0 -0.25}

    Quader $THIS.q 1.5 2 0.05
    $THIS.q -father $THIS -surface $WINDOW
    if $Flag { $THIS.q -translate { -0.75 -0.25 0}} else { $THIS.q -translate { 0.75 -0.25 0}}

    Sphere $THIS.q.s 0.05
    $THIS.q.s -father $THIS.q -surface $MESSING 
    set d 0.5
    if $Flag {set d -$d}
    $THIS.q.s -translate "$d -0.1 0"
    Cylinder $THIS.q.c 0.05 0.95
    $THIS.q.c -father $THIS.q.s -translate {0 0 0.475}
    $THIS.q.s -rotate {-1.571 0 0}
    set r 2.12
    if !$Flag {set r -$r}
    $THIS.q.s -rotate "0 $r 0"
    Sphere $THIS.q.s2 0.05
    $THIS.q.s2 -father $THIS.q -surface $MESSING 
    set d 0.3
    if !$Flag {set d -$d}
    $THIS.q.s2 -translate "$d -0.6 0"
    set $THIS->angle 0
    set $THIS->right $Flag
    $THIS -open [set $THIS->angle 0]
}

Tcl_Method Door2 -open newAngle Double {Open the door with a certain {ARG 1 Angle} in radiants. 0 means that the door is closed.} {
    if [set $THIS->right] {
	$THIS -rotate "0 -[set $THIS->angle] 0" } {
	    $THIS -rotate "0 [set $THIS->angle] 0"} 
    set $THIS->angle $newAngle
    if [set $THIS->right] {
	$THIS -rotate "0 [set $THIS->angle] 0" } {
	    $THIS -rotate "0 -[set $THIS->angle] 0" }
} 

Tcl_Method Door2 -close {} {} {Close the door.} {
    $THIS -open 0
} 

##########################################################################

Tcl_Primitive MainDoorBlock {} angle Name String {{ARG 1 Name}.} {
    # width of this block is 3 
    Quader $THIS.q 3 0.5 0.2
    $THIS.q -father $THIS -translate {0 1 -0.1}

    if {[XMODE] > 2 } {
	Door2 $THIS.left 0
	$THIS.left -father $THIS -translate {-1.5 0 0}
	Door2 $THIS.right 1
	$THIS.right -father $THIS -translate {1.5 0 0}
    }
    set $THIS->angle 0

    Quader $THIS.q1 3.1 0.2 0.2
    $THIS.q1 -father $THIS -translate {0 -1.35 0.08}
    Quader $THIS.q2 3.1 0.2 0.2
    $THIS.q2 -father $THIS.q1 -translate {0 -0.2 0.2}
    Quader $THIS.q21 3 0.2 0.2
    $THIS.q21 -father $THIS.q1 -translate {0 -0.2 0}
    Quader $THIS.q3 3.1 0.2 0.2
    $THIS.q3 -father $THIS.q1 -translate {0 -0.4 0.4}
    Quader $THIS.q31 3 0.2 0.4
    $THIS.q31 -father $THIS.q1 -translate {0 -0.4 0.1}
    Quader $THIS.q4 3.1 0.2 0.2
    $THIS.q4 -father $THIS.q1 -translate {0 -0.6 0.6}
    Quader $THIS.q41 3 0.2 0.6
    $THIS.q41 -father $THIS.q1 -translate {0 -0.6 0.2}
    Quader $THIS.q5 3.1 0.6 0.2
    $THIS.q5 -father $THIS.q1 -translate {0 -1 0.8}
    Quader $THIS.q51 3 0.6 0.8
    $THIS.q51 -father $THIS.q1 -translate {0 -1 0.3}
}

Tcl_Method MainDoorBlock -open newAngle Double {Open the door with a certain {ARG 1 Angle} in radiants. 0 means that the door is closed.} {
    if {[XMODE] > 2 } {
	$THIS.left -open $newAngle
	$THIS.right -open $newAngle
	set $THIS->angle $newAngle
    }
} 

##########################################################################

Tcl_Primitive DoorBlock {} {} {Name Width} {String Double} {{ARG 1 Name}.} {
    set W2 [expr $Width/2]
    set WW2 0.5
    set WW 1
    set NW2 [expr $W2-$WW2]
    Quader $THIS.ql $NW2 2.5 0.2
    $THIS.ql -father $THIS -translate "[expr -$W2+$NW2*0.5] 0 -0.1"
    Quader $THIS.qt $WW 0.5 0.2
    $THIS.qt -father $THIS -translate "0 1 -0.1"
    Door $THIS.dr
    $THIS.dr -father $THIS -translate { -0.5 -0.2 0}
    Quader $THIS.qr $NW2 2.5 0.2
    $THIS.qr -father $THIS -translate "[expr $W2-$NW2*0.5] 0 -0.1"
}

Tcl_Method DoorBlock -get_door {} {} {Get the door.} { return $THIS.dr }

##########################################################################
# stages:

Tcl_Primitive ZeroStage {} {} Name String {{ARG 1 Name}.} {
    $THIS -translate { 0 -1.25 0} -diffuse { 0.3 0.3 0} 
    # ground:
    Quader $THIS.gr 10 0.1 8
    $THIS.gr -father $THIS -translate { 0 -1.25 0}
    
    ### starting at -z axes in clock direction:
    # back side:
    Block $THIS.b1 6
    $THIS.b1 -father $THIS -translate {-2 0 -4}
    $THIS.b1 -rotate { 0 3.14 0}
    StackBlock $THIS.b1.1 4 
    $THIS.b1.1 -father $THIS -translate {3 0 -4}
    $THIS.b1.1 -rotate { 0 3.14 0}
    # right side:
    StackBlock $THIS.b2 8 
    $THIS.b2 -father $THIS -translate {5 0 0}
    $THIS.b2 -rotate {0 1.571 0}
    # front side: 
    Block $THIS.b3 1
    $THIS.b3 -father $THIS -translate {4.5 0 4} 
#    GarageDoorBlock $THIS.b4 
#    $THIS.b4 -father $THIS -translate {2.5 0 4}
    Block $THIS.b5 6
    $THIS.b5 -father $THIS -translate {-2 0 4} 
    StackBlock $THIS.b7 2 
    $THIS.b7 -father $THIS -translate {-4 0 4}
    #right side:
    Block $THIS.b8 8
    $THIS.b8 -father $THIS -translate {-5 0 0}
    $THIS.b8 -rotate {0 -1.571 0}
    
    if {[XMODE] > 4} {
	StairCase $THIS.stc
	$THIS.stc -father $THIS -translate {-0.5 -1.20 -2.5}
    }
}

Tcl_Primitive FirstStage {} {} Name String {{ARG 1 Name}.} {
    $THIS -translate { 0 1.25 0} -diffuse { 1  1 1}

    # ground:
    [Top $THIS.gr] -father $THIS 
    Quader $THIS.gr.q1 5.5 0.1 7.8
    $THIS.gr.q1 -father $THIS.gr -translate {2.25 -1.25 0} 
    Quader $THIS.gr.q2 1 0.1 6.3
    $THIS.gr.q2 -father $THIS.gr -translate {-1 -1.25 0.75}
    Quader $THIS.gr.q3 3.5 0.1 7.8
    $THIS.gr.q3 -father $THIS.gr -translate {-3.25 -1.25 0}

    ### starting at -z axes in clock direction:
    # back side:
    Block $THIS.b1 6
    $THIS.b1 -father $THIS -translate {-2 0 -4}
    $THIS.b1 -rotate { 0 3.14 0}
    WindowBlock $THIS.b1.1 4 2
    $THIS.b1.1 -father $THIS -translate {3 0 -4}
    $THIS.b1.1 -rotate { 0 3.14 0}
    # right side:
    WindowBlock $THIS.b2 4 2
    $THIS.b2 -father $THIS -translate {5 0 -2}
    $THIS.b2 -rotate {0 1.571 0}
    WindowBlock $THIS.b3 4 2
    $THIS.b3 -father $THIS -translate {5 0 2}
    $THIS.b3 -rotate {0 1.571 0}
    # front side: 
    WindowBlock $THIS.b4 4 2.8
    $THIS.b4 -father $THIS -translate {3 0 4}
    Block $THIS.b5 1
    $THIS.b5 -father $THIS -translate {0.5 0 4} 
    [MainDoorBlock $THIS.b6] -open 1
    $THIS.b6 -father $THIS -translate {-1.5 0 4}
    WindowBlock $THIS.b7 2 1.2
    $THIS.b7 -father $THIS -translate {-4 0 4}
    #right side:
    Block $THIS.b8 2
    $THIS.b8 -father $THIS -translate {-5 0 3}
    $THIS.b8 -rotate {0 -1.571 0}
    SpecialBlock $THIS.b9 5
    $THIS.b9 -father $THIS -translate {-5 0 -0.5}
    $THIS.b9 -rotate {0 -1.571 0}
    Block $THIS.b10 1
    $THIS.b10 -father $THIS -translate {-5 0 -3.5}
    $THIS.b10 -rotate {0 -1.571 0}
    
    ### room 1 (back right) ###
    [[DoorBlock $THIS.xb1 4] -get_door ] -open 1
    
    $THIS.xb1 -father $THIS -translate {3 0 0.1}
    Block $THIS.xb2 4
    $THIS.xb2 -father $THIS -translate {1 0 -1.9}
    $THIS.xb2 -rotate { 0 1.571 0 }

    if {[XMODE] > 4} {
	SitGroup $THIS.grp
	$THIS.grp -father $THIS -translate { 2.5 -1.25 -1.8}
    }

    Sphere $THIS.r1.la 0.2
    $THIS.r1.la -father $THIS -translate { 3 1 -2} -transmission 1
    PointLight $THIS.r1.lamp
    $THIS.r1.lamp -color {0.5 0.5 0}
    
    ### room 2 (front right) ###
    [[DoorBlock $THIS.xb3 4] -get_door ] -open 1.5
    $THIS.xb3 -father $THIS -translate {0.8 0 1.98}
    $THIS.xb3 -rotate { 0 -1.571 0 }

    ### big room (left) ####

    if {[XMODE] > 4} {
	[Armchair $THIS.arm1] -father $THIS -translate { -3.2 -1.25 -2.2}
	$THIS.arm1 -rotate {0 0.9 0}
	[Armchair $THIS.arm2] -father $THIS -translate { -2.3 -1.25 -0.7}
	$THIS.arm2 -rotate {0 -0.17 0}
	[Armchair $THIS.arm3] -father $THIS -translate { -3.2 -1.25 0.3}
	$THIS.arm3 -rotate {0 -0.75 0}
	[Table $THIS.armta] -father $THIS -translate {-4.1 -1.25 -0.7}
	StairCase $THIS.stc
	$THIS.stc -father $THIS -translate {-0.5 -1.20 -2.5}
    }
    
    Sphere $THIS.rbig.la 0.2
    $THIS.rbig.la -father $THIS -translate { -4.1 1 -0.7} -transmission 1
    PointLight $THIS.rbig.lamp
    $THIS.rbig.lamp -color {0.5 0.5 0}
}

Tcl_Primitive SecondStage {} {} Name String {{ARG 1 Name}.} {
    global WINDOW
    global MESSING

    $THIS -translate { 0 3.75 0} -diffuse { 1 1 1}
    # ground:
    [Top $THIS.gr] -father $THIS 
    Quader $THIS.gr.q1 5.5 0.1 7.8
    $THIS.gr.q1 -father $THIS.gr -translate {2.25 -1.25 0}
    Quader $THIS.gr.q2 1 0.1 6.3
    $THIS.gr.q2 -father $THIS.gr -translate {-1 -1.25 0.75}
    Quader $THIS.gr.q3 3.5 0.1 7.8
    $THIS.gr.q3 -father $THIS.gr -translate {-3.25 -1.25 0}
    Quader $THIS.gr.q4 5.2 0.1 1
    $THIS.gr.q4 -father $THIS.gr -translate { -1.5 -1.25 4.4}

    # roof:
    set arc 0.3
    set wi 5.5
    Quader $THIS.rf1 11 0.1 $wi
    $THIS.rf1 -father $THIS -translate "0 1.7 [expr 0.5*$wi*[cos $arc]]"
    $THIS.rf1 -rotate "$arc 0 0" -ambient {0.5 0.6 0} -diffuse {0.5 0.6 0}
    Quader $THIS.rf2 11 0.1 $wi
    $THIS.rf2 -father $THIS -translate "0 1.7 -[expr 0.5*$wi*[cos $arc]]"
    $THIS.rf2 -rotate "-$arc 0 0" -ambient {0.5 0.6 0} -diffuse {0.5 0.6 0}

    set hg [expr 2.5-[sin $arc]*(2.5-$wi*0.5)] 
    #### near left room (balcony) 6x6

    Polygon $THIS.p0 5 "{-5 0 -3.95}  {-5 $hg -3.95} {-5 [expr $hg+4*[sin $arc]] 0}  {-5 $hg 3.95}  {-5 0 3.95}" {} {}
    $THIS.p0 -translate { 0 -1.3 0} -gnormal {-1 0 0} -father $THIS

    Polygon $THIS.p0i 5 "{-4.8 0 -3.95} {-4.8 0 3.95} {-4.8 $hg 3.95} {-4.8 [expr $hg+4*[sin $arc]] 0} {-4.8 $hg -3.95}" {} {}
    $THIS.p0i -translate { 0 -1.3 0} -gnormal {1 0 0} -father $THIS
    Quader $THIS.q0 1 $hg 0.2
    $THIS.q0 -father $THIS -translate "-4.5 0 3.9"
 
    # balcony:

    Quader $THIS.bal.w 5 0.5 0.2
    $THIS.bal.w -father $THIS -translate "-1.5 [expr $hg-1.55] 3.9" 

    [Top $THIS.bal] -father $THIS.gr.q4

    if {[XMODE] > 4} {
	global env
	OFFPolygon $THIS.bal.pl $env(GOOD_ROOT_DIR)/off/plant
	$THIS.bal.pl -father $THIS.bal -scale {0.1 0.2 0.1} -translate { -17 0 2}
    }

    Sphere $THIS.bal.la 0.2
    $THIS.bal.la -father $THIS.bal -translate { 0 2 0} -transmission 1
    Cone  $THIS.bal.co 0.3 0.3
    $THIS.bal.co -father $THIS.bal.la -surface $MESSING -open -rotate {1.57 0 0}
    $THIS.bal.co -translate {0 0 -0.3}
    PointLight $THIS.bal.lamp
    $THIS.bal.lamp -color {0.5 0.5 0}

    if {[XMODE] > 2} {
	Quader $THIS.bal.c 4.9 0.9 0.05
	$THIS.bal.c -father $THIS.bal -translate {0 0.5 0.5} -surface $WINDOW
	
	Cylinder $THIS.bal.cc 0.05 5.2
	$THIS.bal.cc -father $THIS.bal -translate {0 1.05 0.5} -surface $MESSING
	$THIS.bal.cc -rotate {0 1.57 0}
	
	Quader $THIS.bal.c1 0.05 0.9 1
	$THIS.bal.c1 -father $THIS.bal -translate {-2.55 0.5 0} -surface $WINDOW
	
	Cylinder $THIS.bal.cc1 0.05 1
	$THIS.bal.cc1 -father $THIS.bal -translate {-2.55 1.05 0} -surface $MESSING
	
	Cylinder $THIS.bal.cx1 0.05 1
	$THIS.bal.cx1 -father $THIS.bal -rotate {-1.57 0 0} -surface $MESSING
	$THIS.bal.cx1 -translate {-2.55 -0.5 0.5}
	
	Quader $THIS.bal.c2 0.05 0.9 1
	$THIS.bal.c2 -father $THIS.bal -translate {2.55 0.5 0} -surface $WINDOW
	
	Cylinder $THIS.bal.cc2 0.05 1
	$THIS.bal.cc2 -father $THIS.bal -translate {2.55 1.05 0} -surface $MESSING
	
	Cylinder $THIS.bal.cx2 0.05 1
	$THIS.bal.cx2 -father $THIS.bal -rotate {-1.57 0 0} -surface $MESSING
	$THIS.bal.cx2 -translate {2.55 -0.5 0.5}
    }

    ### yet another lamp

    Sphere $THIS.la.la 0.2
    $THIS.la.la -father $THIS -translate { 0 2 0} -transmission 1
    Cone  $THIS.la.co 0.3 0.3
    $THIS.la.co -father $THIS.la.la -surface $MESSING -open -rotate {1.57 0 0}
    $THIS.la.co -translate {0 0 -0.3}
    PointLight $THIS.la.lamp
    $THIS.la.lamp -color {0.5 0.5 0}

    ### a sit group
    if {[XMODE] > 4} {
	SitGroup $THIS.grp
	$THIS.grp -father $THIS -translate { -2 -1.25 3.2}
    }

    #### near right room 4x6
    Quader $THIS.q1 4 $hg 0.2
    $THIS.q1 -father $THIS -translate "3 0 3.9"

    Polygon $THIS.p1 5 "{5 0 -3.95} {5 0 3.95} {5 $hg 3.95} {5 [expr $hg+4*[sin $arc]] 0} {5 $hg -3.95}" {} {}
    $THIS.p1 -translate { 0 -1.3 0} -gnormal {1 0 0} -father $THIS

    Polygon $THIS.p1i 5 "{4.8 0 -3.95} {4.8 $hg -3.95} {4.8 [expr $hg+4*[sin $arc]] 0} {4.8 $hg 3.95}  {4.8 0 3.95}" {} {}
    
    $THIS.p1i -translate { 0 -1.3 0} -gnormal {-1 0 0} -father $THIS
    
    Quader $THIS.qb 10 $hg 0.2
    $THIS.qb -father $THIS -translate {0 0 -3.9}

    Quader $THIS.es 0.5 4.5 0.5
    $THIS.es -father $THIS -ambient {0 0 0} -diffuse {0 0 0} -translate {1.5 1 2}
}

##########################################################################

Tcl_Primitive House {} {} Name String {Creates a new {ARG 1 House}.} {
    $THIS -translate { 0 1 0} -diffuse {0.9 0.9 0.7}
    [ZeroStage $THIS.zst] -father $THIS
    [FirstStage $THIS.st1] -father $THIS
    [SecondStage $THIS.st2] -father $THIS
}

Tcl_Method House -get_lamps {} {} {Return lamps primitives of the house. The related light object has an additional mp on the end of the name.} {
    return "$THIS.st1.r1.la $THIS.st1.rbig.la $THIS.st2.bal.la $THIS.st2.la.la"
} 

Tcl_Method House -updateLamps {} {} {Update lamp positions} {
    # the following stuff only uses the translation terms
    catch  {
	foreach la [$THIS -get_lamps] { 
		set mat [$la -get_worldMatrix]
		set mp mp
		$la$mp -origin "[lindex $mat 3] [lindex $mat 7] [lindex $mat 11]"
	    }
    }    
}

##########################################################################

sc -insert [AmbientLight al] 
al -color { 0 0 0.2}

sc -insert [House h]
catch { foreach l [h -get_lamps] {set mp mp; sc -insert $l$mp} }

[XLamp la0] -translate {-13 0 7}
sc -insert la0 [la0 -get_lamp]
[XLamp la1] -translate {-4 0 7}
sc -insert la1 [la1 -get_lamp]
[XLamp la2] -translate {5 0 7}
sc -insert la2 [la2 -get_lamp]
[XLamp la3] -translate {14 0 7}
sc -insert la3 [la3 -get_lamp]

Top ground
sc -insert ground
ground -translate {0 -0.2 -17} -diffuse { 0.2 1 0.2} -ambient { 0.2 1 0.2}

## using a quader as ground:
Quader ground.g 60 0.4 60 
ground.g -father ground 

## or a fractal:
#ground -rotate { 1.57 0 0} 
#OFFPolygon ground.g $env(GOOD_ROOT_DIR)/off/fractal1
#set b [ground.g -get_bounds]
#set wx [expr -[lindex $b 0]+[lindex $b 1]]
#set wy [expr -[lindex $b 2]+[lindex $b 3]]
#set wz [expr -[lindex $b 4]+[lindex $b 5]]
#ground.g -scale "[expr 60/$wx] [expr 60/$wy] [expr 0.4/$wz]" -father ground

sc -insert [Quader street 4 0.2 1000]
street -diffuse {0.5 0.5 0.5} -translate {0 0 10}
street -rotate {0 -1.571 0}
Quader streetl 0.2 0.2 1000
streetl -father street -diffuse {1 1 1} -translate {2.1 0 0}
Quader streetr 0.2 0.2 1000
streetr -father street -diffuse {1 1 1} -translate {-2.1 0 0}
Quader walk 6 0.9 1000
walk -father street -diffuse {0.7 0.6 0.2} -translate { 0 -0.4 0}

##########################################################################

sc -insert [PointLight moon]
moon -origin { -5 25 5} -color { 0.2 0.2 1}

##########################################################################

h -update
# update the WC positions of the lights:
h -updateLamps
foreach l $XLamps {$l -updateLamp}


