Initial commit at Tue Apr 25 08:36:02 EDT 2017 by tim on stravinsky

[xcircuit.git] / lib / tcl / sue_xc.tcl

#------------------------------------------
# sue_xc.tcl
#------------------------------------------
# This script should be sourced into
# XCircuit and provides the capability to 
# translate .sue files into XCircuit
# schematics.  This script works properly
# with XCircuit version 3.2.24 or newer.
#------------------------------------------
# The primary routine is "make_sue_all",
# which is a TCL procedure to be run from
# the XCircuit command line in the directory
# containing .sue format files.  Without
# options, it creates a single XCircuit
# PostScript output file "sue_gates.ps",
# containing all of the gate symbols and
# associated schematics in a single file.
#------------------------------------------
# Written by R. Timothy Edwards
# 8/23/04
# MultiGiG, Inc.
# Scotts Valley, CA
#------------------------------------------

global fscale
set fscale 1.6

#------------------------------------------------------------
# scale an {x y} list value from SUE units to XCircuit units
#------------------------------------------------------------

proc scale_coord {coord} {
   global fscale
   set x [lindex $coord 0]
   set y [lindex $coord 1]
   set newc [lreplace $coord 0 1 [expr {int($x * $fscale)}] \
        [expr {int(-$y * $fscale)}]]
   return $newc
}

#------------------------------------------------------------
# make and make_wire: create the schematic elements
#------------------------------------------------------------

proc make {type args} {
   global fscale

   if {[llength $args] == 1} {
      set args [lindex $args 0]
   }

   # default values
   set flipped {}
   set angle 0
   set width 1
   set length 1
   set name bad_element
   set origin {0 0}
   set instance_params {}

   foreach {key value} $args {
      switch -- $key {
         -orient {
            switch -- $value {
               RXY {
                 set angle 180
               }
               RX {
                 set flipped horizontal
               }
               RY {
                 set flipped vertical
                 set angle 180
               }
               R270 {
                 set angle 270
               }
               R90 {
                 set angle 90
               }
               R0 {
                 # do nothing
               }
            }
         }
         -W {
            set width $value
         }
         -L {
            set length $value
         }
         -origin {
            set origin $value
         }
         -name {
            set name $value
         }
         -text {
            set name $value
         }
         default {
            lappend instance_params [list [string range $key 1 end] $value]
         }
      }
   }

   set origin [scale_coord $origin]

   switch -- $type {
      pmos {
         set newgate [instance make pMOS $origin]
         # SUE pMOS is wider than xcircuit pMOS.
         set x1 [lindex $origin 0]
         set s1 [lreplace $origin 0 0 [expr {$x1 - 64}]]
         set s2 [lreplace $origin 0 0 [expr {$x1 - 96}]]
         set newpoly [polygon make 2 $s1 $s2]
         select $newgate
         parameter set width $width -forward
         parameter set length $length -forward
         select [list $newgate $newpoly]
         rotate $angle $origin
         if {$flipped != {}} {
            select [list $newgate $newpoly]
            flip $flipped $origin
         }
      }

      nmos {
         set newgate [instance make nMOS $origin]
         # SUE nMOS is wider than xcircuit nMOS.
         set x1 [lindex $origin 0]
         set s1 [lreplace $origin 0 0 [expr {$x1 - 64}]]
         set s2 [lreplace $origin 0 0 [expr {$x1 - 96}]]
         set newpoly [polygon make 2 $s1 $s2]
         select $newgate
         parameter set width $width -forward
         parameter set length $length -forward
         select [list $newgate $newpoly]
         rotate $angle $origin
         if {$flipped != {}} {
            select [list $newgate $newpoly]
            flip $flipped $origin
         }
      }

      input -
      output -
      name_net -
      name_net_s {
         set newtext [label make pin $name $origin]
         rotate $newtext $angle $origin
         if {$flipped != {}} {
            flip $newtext $flipped $origin
         }
      }

      global {
         set newtext [label make global $name $origin]
         rotate $newtext $angle $origin
         if {$flipped != {}} {
            flip $newtext $flipped $origin
         }
      }

      text {
         set newtext [list $name]
         while {[set rp [string first \n $newtext]] >= 0} {
            set newtext [string replace $newtext $rp $rp "\} \{return\} \{"]
            set rp [string first \n $newtext]
         }
         set newtext [label make normal $newtext $origin]
         rotate $newtext $angle $origin
         if {$flipped != {}} {
            flip $newtext $flipped $origin
         }
      }

      # Default behavior is to generate an object instance of the
      # given name.  This assumes that these are only objects that
      # have been defined in .sue files already.

      default {
         set newgate [instance make $type $origin]
         select $newgate
         rotate $angle $origin
         if {$flipped != {}} {
            select $newgate
            flip $flipped $origin
         }
         if {$instance_params != {}} {
            select $newgate
            foreach pair $instance_params {
               set key [lindex $pair 0]
               set value [lindex $pair 1]
               parameter set $key $value -forward
            }
            deselect
         }
      }
   }
   deselect
}

#------------------------------------------------------------
# Draw text on the schematic
#------------------------------------------------------------

proc make_text {args} {
   make text $args
}

#------------------------------------------------------------
# Draw a wire into the schematic
#------------------------------------------------------------

proc make_wire {x1 y1 x2 y2} {
   global fscale
   # Scale the origin from SUE units to XCircuit units
   set sx1 [expr {int($x1 * $fscale)}]
   set sy1 [expr {int(-$y1 * $fscale)}]
   set sx2 [expr {int($x2 * $fscale)}]
   set sy2 [expr {int(-$y2 * $fscale)}]
   polygon make 2 [list $sx1 $sy1] [list $sx2 $sy2]
}

proc make_line {args} {
   eval "make_wire $args"
}

#------------------------------------------------------------
# icon_*: create the symbol
#------------------------------------------------------------

#------------------------------------------------------------
# default parameters (deferred)
#------------------------------------------------------------

proc icon_setup {icon_args params} {
   global icon_params
   set icon_params [concat $icon_params $params]
}

#------------------------------------------------------------
# pins
#------------------------------------------------------------

proc icon_term {args} {
   set pintype "no_pin"
   set origin {0 0}
   set name "bad_pin_name"

   foreach {key value} $args {
      switch -- $key {
         -type {
            set pintype $value
         }
         -origin {
            set origin $value
         }
         -name {
            set name $value
         }
      }
   }
   set newtext [label make pin $name $origin]
}

#------------------------------------------------------------
# instance parameters and symbol text labels
#------------------------------------------------------------

proc icon_property {args} {

   set proptype {}
   set origin {0 0}
   set name "bad_parameter"

   foreach {key value} $args {
      switch -- $key {
         -origin {
            set origin $value
         }
         -name {
            set name $value
         }
         -type {
            set proptype $value
         }
         -size {
            # label size.  Ignore, for now.
         }
         -label {
            label make normal "$value" [scale_coord $origin]
         }
      }
   }
}
   
#------------------------------------------------------------
# Line drawing on the symbol
#------------------------------------------------------------

proc icon_line {args} {
   set coords {}
   set i 0
   foreach {x y} $args {
      set s [scale_coord [list $x $y]]
      lappend coords $s
      incr i
   }
   eval "polygon make $i $coords"
}

#------------------------------------------------------------
# Main routine:  Load the .sue file for the indicated
# gate.  Draw the schematic and the (user library) symbol,
# and associate them.
#------------------------------------------------------------

proc make_sue_gate {name} {
   global icon_params
   source ${name}.sue

   # Go to a new page unless the current one is empty
   while {[llength [object parts]] > 0} {
      set p [page]
      incr p
      while {[catch {page $p}]} {
         page make
      }
   }

   # Evaluate the symbol.  Generate the symbol in xcircuit.
   # Then clear the page to make the schematic
   set icon_params {}
   eval "ICON_${name}"
   set hlist [object parts]
   object make $name $hlist
   set hlist [object parts]
   push $hlist
   foreach pair $icon_params {
      set key [lindex $pair 0]
      set value [lindex $pair 1]
      switch -- $key {
         origin -
         orient {
            # Do nothing for now.  These are library instance values
            # in xcircuit, and could be set as such.
         }
         default {
            parameter make substring $key [list $value]
         }
      }
   }
   pop
   delete $hlist

   eval "SCHEMATIC_${name}"
   wm withdraw .select
   schematic associate $name
   zoom view
}
 
#------------------------------------------------------------
# Top-level routine:  Find all the .sue files in the
# current directory and generate a library from them
#------------------------------------------------------------

proc make_all_sue {{name sue_gates}} {
   set files [glob \*.sue]
   foreach i $files {
      set filename [file tail [file root $i]]
      make_sue_gate $filename
      page filename $name
      page orientation 90
      page encapsulation full
      page fit true
      if {[page scale] > 1.0} {
         page fit false
         page scale 1.0
      }
   }
}