; In TCL, load this file with
;   source test.tcl
;
; Then run these predicates to build circuitry:
;   makefacet
;   makehier
;
; And run this predicate to list the objects in a subarea of the current facet:
;   listarea

proc makefacet {} {
   # create a facet called "tran-contact" in the current library
   set myfacet [newnodeproto tran-contact [curlib]]

   # get "S-Transistor" and "Metal-1-Polysilicon-Con" primitives
   set tran [getnodeproto S-Transistor]
   set contact [getnodeproto Metal-1-Polysilicon-Con]

   # get default sizes of these primitives
   set tlowx [getval $tran lowx]
   set thighx [getval $tran highx]
   set tlowy [getval $tran lowy]
   set thighy [getval $tran highy]
   set clowx [getval $contact lowx]
   set chighx [getval $contact highx]
   set clowy [getval $contact lowy]
   set chighy [getval $contact highy]

   # get pointer to Polysilicon arc and its default width
   set arctype [getarcproto Polysilicon]
   set width [getval $arctype nominalwidth]

   # create the transistor and the contact to its left
   set c1 [newnodeinst $contact $clowx $chighx $clowy $chighy 0 0 $myfacet]
   set t1 [newnodeinst $tran [expr $tlowx+40000] [expr $thighx+40000] $tlowy $thighy 0 0 $myfacet]

   # get the transistor's left port coordinates
   set tport [getportproto $tran s-trans-poly-left]
   set tpos [portposition $t1 $tport]

   # get the contacts's only port coordinates
   set cport [getval $contact firstportproto]
   set cpos [portposition $c1 $cport]

   # run a wire between the primitives
   newarcinst $arctype $width 0 $t1 $tport [lindex $tpos 0] [lindex $tpos 1] $c1 $cport [lindex $cpos 0] [lindex $cpos 1] $myfacet

   # create ports
   newportproto $myfacet $t1 [getportproto $tran s-trans-diff-top] topdiff
   newportproto $myfacet $t1 [getportproto $tran s-trans-diff-bottom] botdiff

   # return the facet
   return $myfacet
}

proc makehier {} {
   # create a facet called "two-trans"
   set higherfacet [newnodeproto two-trans [curlib]]

   # get pointer to the "tran-contact" facet
   set tc [getnodeproto tran-contact]

   # get size of this facet
   set lowx [getval $tc lowx]
   set highx [getval $tc highx]
   set lowy [getval $tc lowy]
   set highy [getval $tc highy]

   # create the two facet instances, one above the other
   set o1 [newnodeinst $tc $lowx $highx $lowy $highy 0 0 $higherfacet]
   set o2 [newnodeinst $tc $lowx $highx [expr $lowy+70000] [expr $highy+70000] 0 0 $higherfacet]

   # get pointer to S-Active arc and its default width
   set darctype [getarcproto S-Active]
   set dwidth [getval $darctype nominalwidth]

   # get the bottom facet's top port
   set lowport [getportproto $tc topdiff]
   set lowpos [portposition $o1 $lowport]

   # get the top facet's bottom port
   set highport [getportproto $tc botdiff]
   set highpos [portposition $o2 $highport]

   # run a wire between the primitives
   newarcinst $darctype $dwidth 0 $o1 $lowport [lindex $lowpos 0] [lindex $lowpos 1] $o2 $highport [lindex $highpos 0] [lindex $highpos 1] $higherfacet
}

proc listnodes {} {
   set myfacet [getval [curlib] curnodeproto]
   for { set node [getval $myfacet firstnodeinst] } { [string c $node #nodeinst-1] != 0 } { set node [getval $node nextnodeinst] } {
      puts stdout [format "Found %s node" [describenode $node]]
   }
}

proc listarcs {} {
   set myfacet [getval [curlib] curnodeproto]
   for { set arc [getval $myfacet firstarcinst] } { [string c $arc #arcinst-1] != 0 } { set arc [getval $arc nextarcinst] } {
      puts stdout [format "Found %s arc" [getval [getval $arc proto] protoname]]
   }
}

proc listarea {} {
   set myfacet [getval [curlib] curnodeproto]
   set key [initsearch -10000 50000 -15000 15000 $myfacet]
   for { set object [nextobject $key] } { [string c $object #geom-1] != 0 } { set object [nextobject $key] } {
      set type [getval $object entrytype]
      if { $type == 1 } {
         puts stdout [format "Found %s node" [describenode [getval $object entryaddr]]]
      } else {
         puts stdout [format "Found %s arc" [getval [getval [getval $object entryaddr] proto] protoname]]
      }
   }
}

proc describenode node {
   set proto [getval $node proto]
   if { [getval $proto index] == 0} {
      return [getval [getval $proto cell] cellname]
   }
   return [getval $proto primname]
}

proc nmostransistorsize {} {
    set path [gettraversalpath]
    set len [llength $path]
    if { $len <= 0 } {
	return "nmos2/2"
    }
    set last [lindex $path [expr $len-1]]
    set size [getval $last transistorsize]
    return [concat nmos$size]
}
