From bda3d9d4262d3200e67fd365ecf788abd05c9861 Mon Sep 17 00:00:00 2001 From: Stefan Frederik Date: Sat, 29 May 2021 00:45:01 +0200 Subject: [PATCH] Added new feature "Make schematic and symbol from selected components" with command "xschem make_sch_from_sel" and function make_schematic(..) added proc make_symbol_lcc and make_symbol_lcc.awk sch and sym components to specially process dash in prop_ptr. --- src/Makefile.in | 2 +- src/draw.c | 9 +- src/make_sym_lcc.awk | 381 ++ src/psprint.c | 8 +- src/save.c | 69 +- src/scheduler.c | 33 +- src/xschem.h | 1 + src/xschem.tcl | 8611 +++++++++++++++++++++--------------------- 8 files changed, 4793 insertions(+), 4321 deletions(-) create mode 100644 src/make_sym_lcc.awk diff --git a/src/Makefile.in b/src/Makefile.in index 39a90f58..b8cf969a 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -11,7 +11,7 @@ put /local/src { # list all files that need to be installed in "$(XSHAREDIR)" put /local/install_shares { keys.help xschem.help xschem.tcl break.awk convert_to_verilog2001.awk - flatten.awk flatten_tedax.awk flatten_savenodes.awk make_sym.awk symgen.awk order_labels.awk + flatten.awk flatten_tedax.awk flatten_savenodes.awk make_sym.awk make_sym_lcc.awk symgen.awk order_labels.awk sort_labels.awk spice.awk tedax.awk verilog.awk vhdl.awk hspice_backannotate.tcl add_custom_menu.tcl change_index.tcl resources.tcl xschemrc ngspice_backannotate.tcl rawtovcd gschemtoxschem.awk } diff --git a/src/draw.c b/src/draw.c index 9b880fc5..2f1f0554 100644 --- a/src/draw.c +++ b/src/draw.c @@ -359,6 +359,7 @@ void draw_symbol(int what,int c, int n,int layer,short tmp_flip, short rot, #if HAS_CAIRO==1 char *textfont; #endif + int dashprop=0, dash=0; if(xctx->inst[n].ptr == -1) return; if( (layer != PINLAYER && !enable_layer[layer]) ) return; @@ -369,6 +370,7 @@ void draw_symbol(int what,int c, int n,int layer,short tmp_flip, short rot, } else { hide = 0; } + dashprop = atoi(get_tok_value(xctx->inst[n].prop_ptr, "dash", 0)); type = (xctx->inst[n].ptr+ xctx->sym)->type; if(layer==0) { x1=X_TO_SCREEN(xctx->inst[n].x1+xoffset); /* 20150729 added xoffset, yoffset */ @@ -419,13 +421,16 @@ void draw_symbol(int what,int c, int n,int layer,short tmp_flip, short rot, for(j=0;j< symptr->lines[layer];j++) { line = (symptr->line[layer])[j]; + dash = line.dash; + if (line.dash == 0 && dashprop > 0 && layer==4) + dash = dashprop; ROTATION(rot, flip, 0.0,0.0,line.x1,line.y1,x1,y1); ROTATION(rot, flip, 0.0,0.0,line.x2,line.y2,x2,y2); ORDER(x1,y1,x2,y2); if(line.bus) - drawline(c,THICK, x0+x1, y0+y1, x0+x2, y0+y2, line.dash); + drawline(c,THICK, x0+x1, y0+y1, x0+x2, y0+y2, dash); else - drawline(c,what, x0+x1, y0+y1, x0+x2, y0+y2, line.dash); + drawline(c,what, x0+x1, y0+y1, x0+x2, y0+y2, dash); } for(j=0;j< symptr->polygons[layer];j++) { diff --git a/src/make_sym_lcc.awk b/src/make_sym_lcc.awk new file mode 100644 index 00000000..3fbd9150 --- /dev/null +++ b/src/make_sym_lcc.awk @@ -0,0 +1,381 @@ +#!/usr/bin/awk -f +# +# File: make_sym_lcc.awk +# +# This file is part of XSCHEM, +# a schematic capture and Spice/Vhdl/Verilog netlisting tool for circuit +# simulation. +# Copyright (C) 1998-2020 Stefan Frederik Schippers +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA +# + +BEGIN{ + width=150 +} + +FNR == 1 { + if (_filename_ != "") endfile(_filename_) + _filename_ = FILENAME + beginfile(FILENAME) +} + +END { endfile(_filename_) } + + +function beginfile(f) +{ + sym=name=f + sub(/^.*\//,"",name) + name_ext=name + sub(/\.sch.*$/,"",name) + sub(/\.sch.*$/,".sym",sym) + print "**** symbol-izing: " sym " ****" + template="" ; start=0 + while((getline symline 0) { + if(symline ~ /^[GK] \{/ ) start=1 + if(start) template=template symline "\n" + if(symline ~ /\} *$/) start=0 + } + close(sym) + + + size=2.5 + space=20 + lwidth=20 + textdist=5 + labsize=0.2 + titlesize=0.3 + text_voffset=10 + lab_voffset=4 + ip=op=n_pin=n_p=n_l=0 + print "v {xschem version=2.9.8 file_version=1.2}" > sym + if(template=="") { + printf "%s", "K {type=subcircuit\nformat=\"@name @pinlist @symname\"\n" >sym + printf "%s\n", "template=\"name=x1\"" >sym + printf "%s", "}\n" >sym + } + else print template >sym +} + + +/^C \{.*generic_pin(\.sym)?\}/{ + get_end_line() + process_line() + type_pin[n_pin]=generic_type + dir_pin[n_pin]="generic" + x_pin[n_pin] = $3+0 # y coordinate of pin 20140519 + y_pin[n_pin] = $4+0 # y coordinate of pin 20140519 + rotation_pin[n_pin] = $5+0 # y coordinate of pin 20140519 + flip_pin[n_pin] = $6+0 # y coordinate of pin 20140519 + index_pin[n_pin] = n_pin # one level indirection for sorting pins 20140519 + value_pin[n_pin]=value + label_pin[n_pin] = pin_label + props_pin[n_pin] = rest_of_props() + n_pin++ + ip++ +} + +/^[LP] /{ + get_end_line() + process_box_line() + box[n_p]=$0 + n_p++ +} + +/^C \{.*ipin(\.sym)?\}/{ + get_end_line() + process_line() + type_pin[n_pin]=sig_type + verilog_pin[n_pin]=verilog_type + dir_pin[n_pin]="ipin" + x_pin[n_pin] = $3+0 # y coordinate of pin 20140519 + y_pin[n_pin] = $4+0 # y coordinate of pin 20140519 + rotation_pin[n_pin] = $5+0 # y coordinate of pin 20140519 + flip_pin[n_pin] = $6+0 # y coordinate of pin 20140519 + index_pin[n_pin] = n_pin # one level indirection 20140519 + value_pin[n_pin]=value + label_pin[n_pin] = pin_label + props_pin[n_pin] = rest_of_props() + n_pin++ + ip++ +} + +$0 ~ /^C \{.*opin(\.sym)?\}/ && $0 !~ /^C \{.*iopin(\.sym)?\}/ { + get_end_line() + process_line() + type_pin[n_pin]=sig_type + verilog_pin[n_pin]=verilog_type + dir_pin[n_pin]="opin" + x_pin[n_pin] = $3+0 # y coordinate of pin 20140519 + y_pin[n_pin] = $4+0 # y coordinate of pin 20140519 + rotation_pin[n_pin] = $5+0 # y coordinate of pin 20140519 + flip_pin[n_pin] = $6+0 # y coordinate of pin 20140519 + index_pin[n_pin] = n_pin # one level indirection 20140519 + value_pin[n_pin]=value + label_pin[n_pin] = pin_label + props_pin[n_pin] = rest_of_props() + n_pin++ + op++ +} + +/^C \{.*iopin(\.sym)?\}/{ + print "iopin" + get_end_line() + process_line() + type_pin[n_pin]=sig_type + verilog_pin[n_pin]=verilog_type + dir_pin[n_pin]="iopin" + x_pin[n_pin] = $3+0 # y coordinate of pin 20140519 + y_pin[n_pin] = $4+0 # y coordinate of pin 20140519 + rotation_pin[n_pin] = $5+0 # y coordinate of pin 20140519 + flip_pin[n_pin] = $6+0 # y coordinate of pin 20140519 + index_pin[n_pin] = n_pin # one level indirection 20140519 + value_pin[n_pin]=value + label_pin[n_pin] = pin_label + props_pin[n_pin] = rest_of_props() + n_pin++ + op++ +} + +function rest_of_props() +{ + sub(/^C \{[^}]+\}.*\{/,"") + sub(/\}[ \t]*$/, "") + sub(/verilog_type[ \t]*=[ \t]*[^ \t]+[ \t]?/, "") + sub(/sig_type[ \t]*=[ \t]*[^ \t]+[ \t]?/, "") + sub(/lab[ \t]*=[ \t]*[^ \t]+[ \t]?/, "") + sub(/value[ \t]*=[ \t]*[^ \t]+[ \t]?/, "") + sub(/^[ \t]*$/, "") + return $0 +} + +function process_line() +{ + print "process_line" + sig_type="" #20070726 # "std_logic" + verilog_type= "" # 20070726 "wire" #09112003 + pin_label="" + value="" + generic_type="" + + if($0 ~ /^.*lab=/) + { + pin_label=$0 + sub(/^.*lab=/,"",pin_label) + sub(/[ }].*$/,"",pin_label) + } + + if($0 ~ /^.*verilog_type=/) #09112003 + { + verilog_type=$0 + sub(/^.*verilog_type=/,"",verilog_type) + sub(/[}].*$/,"",verilog_type) + sub(/ $/,"",verilog_type) + } + + if($0 ~ /^.*sig_type=/) + { + sig_type=$0 + sub(/^.*sig_type=/,"",sig_type) + sub(/[ }].*$/,"",sig_type) + } + + if($0 ~ /^.*generic_type=/) + { + generic_type=$0 + sub(/^.*generic_type=/,"",generic_type) + sub(/[}].*$/,"",generic_type) + sub(/[a-zA-Z0-9]+=.*$/,"",generic_type) #03062002, allow spaces + print "------------------------" $0 "-->" generic_type + } + + if($0 ~ /^.*value=/) + { + value=$0 + if(value ~ /value="/) + { + sub(/^.*value="/,"",value) + value= "\"" substr(value,1, match(value, /[^\\]"/) ) "\"" + } + else + { + sub(/^.*value=/,"",value) + sub(/[ }].*$/,"",value) + } + } + #print "process_line: returning:" $0 + # print "process_line: pin_label=" pin_label " verilog_type=" verilog_type +} + +function process_box_line() +{ + print "process_box_line" + + if($0 ~ /^.*dash=/) + { + sub(/dash=[0-9]/,"dash=0") + } + print "process_box_line: returning:" $0 + # print "process_line: pin_label=" pin_label " verilog_type=" verilog_type +} + +## join lines like this: +## C {ipin.sym} ........ {lab=xxx +## verilog_type=reg} +function get_end_line() +{ + print "get_end_line" + while($0 !~ /\}[ \t]*$/) { + a=$0 + getline + $0 = a " " $0 + } +} + +function endfile(f) { + + n=ip;if(op>n) n=op + if(n==0) n=1 + m=(n-1)/2 + y=-m*space + x=-width + + box_minx=box_maxx=box_miny=box_maxy=0 + for(ii=0;iisym + awk split(box[ii],a," "); + box_type=a[1] + if (box_type=="P") + { + box_num_vertices = a[3] + for (j=0;j a[4+j]) box_minx=a[4+j] + if (box_maxx==0 || box_maxx < a[4+j]) box_maxx=a[4+j] + if (box_miny==0 || box_miny > a[4+j+1]) box_miny=a[4+j+1] + if (box_maxy==0 || box_maxy < a[4+j+1]) box_maxy=a[4+j+1] + } + print "(" box_minx "," box_miny ") and (" box_maxx "," box_maxy ")" + } + if (box_type=="L") + { + if (box_minx==0 || box_minx > a[3]) box_minx=a[3] + if (box_maxx==0 || box_maxx < a[3]) box_maxx=a[3] + if (box_minx==0 || box_minx > a[5]) box_minx=a[5] + if (box_maxx==0 || box_maxx < a[5]) box_maxx=a[5] + if (box_miny==0 || box_miny > a[4]) box_miny=a[4] + if (box_maxy==0 || box_maxy < a[4]) box_maxy=a[4] + if (box_miny==0 || box_miny > a[6]) box_miny=a[6] + if (box_maxy==0 || box_maxy < a[6]) box_maxy=a[6] + #print "(" box_minx "," box_miny ") and (" box_maxx "," box_maxy ")" + } + } + + #print "Final: (" box_minx "," box_miny ") and (" box_maxx "," box_maxy ")" + + #print "T {@symname}" ,(box_maxx+box_minx)/2, (box_maxy+box_miny)/2,0,0, + # titlesize, titlesize, "{}" >sym + print "T {@symname}",box_minx-lwidth+5, box_miny-text_voffset,0,0,labsize, labsize,"{}" >sym + print "T {@name}",box_maxx-lwidth+5, box_miny-text_voffset,0,0,labsize, labsize,"{}" >sym + + for(ii=0;iisym + if(value !="") printf "value=" value " " >sym + printf props_pin[i] > sym + printf "}\n" >sym + x = get_text_x(label_pin[i], x_pin[i], y_pin[i], box_minx, box_maxx, box_miny, box_maxy) + y = get_text_y(label_pin[i], x_pin[i], y_pin[i], box_minx, box_maxx, box_miny, box_maxy) + print "T {" label_pin[i] "}",x,y,0,0,labsize, labsize, "{}" >sym + } + if(dir=="ipin") + { + printf "B 5 " (x_pin[i]-size) " " (y_pin[i]-size) " " (x_pin[i]+size) " " (y_pin[i]+size) \ + " {name=" label_pin[i] vhdt vert " dir=in " >sym + if(value !="") printf "value=" value " " >sym + printf props_pin[i] > sym + printf "}\n" >sym + x = get_text_x(label_pin[i], x_pin[i], y_pin[i], box_minx, box_maxx, box_miny, box_maxy) + y = get_text_y(label_pin[i], x_pin[i], y_pin[i], box_minx, box_maxx, box_miny, box_maxy) + print "T {" label_pin[i] "}",x,y,0,0,labsize, labsize, "{}" >sym + } + if(dir=="opin") + { + printf "B 5 " (x_pin[i]-size) " " (y_pin[i]-size) " " (x_pin[i]+size) " " (y_pin[i]+size) \ + " {name=" label_pin[i] vhdt vert " dir=out " >sym + if(value !="") printf "value=" value " " >sym + printf props_pin[i] > sym + printf "}\n" >sym + x = get_text_x(label_pin[i], x_pin[i], y_pin[i], box_minx, box_maxx, box_miny, box_maxy) + y = get_text_y(label_pin[i], x_pin[i], y_pin[i], box_minx, box_maxx, box_miny, box_maxy) + print "T {" label_pin[i] "}",x,y,0,0,labsize, labsize, "{}" >sym + } + if(dir=="iopin") + { + printf "B 5 " (x_pin[i]-size) " " (y_pin[i]-size) " " (x_pin[i]+size) " " (y_pin[i]+size) \ + " {name=" label_pin[i] vhdt vert " dir=inout " >sym + if(value !="") printf "value=" value " " >sym + printf props_pin[i] > sym + printf "}\n" >sym + x = get_text_x(label_pin[i], x_pin[i], y_pin[i], box_minx, box_maxx, box_miny, box_maxy) + y = get_text_y(label_pin[i], x_pin[i], y_pin[i], box_minx, box_maxx, box_miny, box_maxy) + print "T {" label_pin[i] "}",x,y,0,0,labsize, labsize, "{}" >sym + } + } + close(sym) +} + +function get_text_x(str, x, y, box_minx, box_maxx, box_miny, box_maxy) +{ + len = length(str) + if (x == box_minx) # On the left hand side + { + return(x+lwidth+textdist) + } + if (x == box_maxx) # On the right hand side + { + return(x-len-lwidth-textdist) + } + # In between left and right + return(x) +} + +function get_text_y(str, x, y, box_minx, box_maxx, box_miny, box_maxy) +{ + if (y == box_miny) # On the top line + { + return(y+lwidth+textdist) + } + if (y == box_maxy) # On the bottom line + { + return(y-lwidth-textdist) + } + return(y-lab_voffset) +} \ No newline at end of file diff --git a/src/psprint.c b/src/psprint.c index 38a7239d..1287c650 100644 --- a/src/psprint.c +++ b/src/psprint.c @@ -497,6 +497,7 @@ static void ps_draw_symbol(int n,int layer, short tmp_flip, short rot, double xo xPoly polygon; xSymbol *symptr; char *textfont; + int dashprop=0, dash = 0; if(xctx->inst[n].ptr == -1) return; if( (layer != PINLAYER && !enable_layer[layer]) ) return; @@ -521,7 +522,7 @@ static void ps_draw_symbol(int n,int layer, short tmp_flip, short rot, double xo dbg(1, "draw_symbol(): skippinginst %d\n", n); return; } - + dashprop = atoi(get_tok_value(xctx->inst[n].prop_ptr, "dash", 0)); flip = xctx->inst[n].flip; if(tmp_flip) flip = !flip; rot = (xctx->inst[n].rot + rot ) & 0x3; @@ -532,10 +533,13 @@ static void ps_draw_symbol(int n,int layer, short tmp_flip, short rot, double xo for(j=0;j< (xctx->inst[n].ptr+ xctx->sym)->lines[layer];j++) { line = ((xctx->inst[n].ptr+ xctx->sym)->line[layer])[j]; + dash = line.dash; + if (line.dash == 0 && dashprop > 0 && layer==4) + dash = dashprop; ROTATION(rot, flip, 0.0,0.0,line.x1,line.y1,x1,y1); ROTATION(rot, flip, 0.0,0.0,line.x2,line.y2,x2,y2); ORDER(x1,y1,x2,y2); - ps_drawline(layer, x0+x1, y0+y1, x0+x2, y0+y2, line.dash); + ps_drawline(layer, x0+x1, y0+y1, x0+x2, y0+y2, dash); } for(j=0;j< (xctx->inst[n].ptr+ xctx->sym)->polygons[layer];j++) { diff --git a/src/save.c b/src/save.c index a9d6ddf7..fafd722c 100644 --- a/src/save.c +++ b/src/save.c @@ -276,7 +276,7 @@ void save_embedded_symbol(xSymbol *s, FILE *fd) } } -void save_inst(FILE *fd) +void save_inst(FILE *fd, int select_only) { int i, oldversion; xInstance *ptr; @@ -287,6 +287,7 @@ void save_inst(FILE *fd) for(i=0;isymbols;i++) xctx->sym[i].flags &=~EMBEDDED; for(i=0;iinstances;i++) { + if (select_only && ptr[i].sel != SELECTED) continue; fputs("C ", fd); if(oldversion) { my_strdup(57, &tmp, add_ext(ptr[i].name, ".sym")); @@ -307,7 +308,7 @@ void save_inst(FILE *fd) } } -void save_wire(FILE *fd) +void save_wire(FILE *fd, int select_only) { int i; xWire *ptr; @@ -315,19 +316,21 @@ void save_wire(FILE *fd) ptr=xctx->wire; for(i=0;iwires;i++) { + if (select_only && ptr[i].sel != SELECTED) continue; fprintf(fd, "N %.16g %.16g %.16g %.16g ",ptr[i].x1, ptr[i].y1, ptr[i].x2, ptr[i].y2); save_ascii_string(ptr[i].prop_ptr,fd, 1); } } -void save_text(FILE *fd) +void save_text(FILE *fd, int select_only) { int i; xText *ptr; ptr=xctx->text; for(i=0;itexts;i++) { + if (select_only && ptr[i].sel != SELECTED) continue; fprintf(fd, "T "); save_ascii_string(ptr[i].txt_ptr,fd, 0); fprintf(fd, " %.16g %.16g %hd %hd %.16g %.16g ", @@ -337,7 +340,7 @@ void save_text(FILE *fd) } } -void save_polygon(FILE *fd) +void save_polygon(FILE *fd, int select_only) { int c, i, j; xPoly *ptr; @@ -346,6 +349,7 @@ void save_polygon(FILE *fd) ptr=xctx->poly[c]; for(i=0;ipolygons[c];i++) { + if (select_only && ptr[i].sel != SELECTED) continue; fprintf(fd, "P %d %d ", c,ptr[i].points); for(j=0;jarc[c]; for(i=0;iarcs[c];i++) { + if (select_only && ptr[i].sel != SELECTED) continue; fprintf(fd, "A %d %.16g %.16g %.16g %.16g %.16g ", c,ptr[i].x, ptr[i].y,ptr[i].r, ptr[i].a, ptr[i].b); save_ascii_string(ptr[i].prop_ptr,fd, 1); @@ -371,7 +376,7 @@ void save_arc(FILE *fd) } } -void save_box(FILE *fd) +void save_box(FILE *fd, int select_only) { int c, i; xRect *ptr; @@ -380,6 +385,7 @@ void save_box(FILE *fd) ptr=xctx->rect[c]; for(i=0;irects[c];i++) { + if (select_only && ptr[i].sel != SELECTED) continue; fprintf(fd, "B %d %.16g %.16g %.16g %.16g ", c,ptr[i].x1, ptr[i].y1,ptr[i].x2, ptr[i].y2); save_ascii_string(ptr[i].prop_ptr,fd, 1); @@ -387,7 +393,7 @@ void save_box(FILE *fd) } } -void save_line(FILE *fd) +void save_line(FILE *fd, int select_only) { int c, i; xLine *ptr; @@ -396,6 +402,7 @@ void save_line(FILE *fd) ptr=xctx->line[c]; for(i=0;ilines[c];i++) { + if (select_only && ptr[i].sel != SELECTED) continue; fprintf(fd, "L %d %.16g %.16g %.16g %.16g ", c,ptr[i].x1, ptr[i].y1,ptr[i].x2, ptr[i].y2 ); save_ascii_string(ptr[i].prop_ptr,fd, 1); @@ -447,13 +454,13 @@ void write_xschem_file(FILE *fd) fprintf(fd, "E "); save_ascii_string(xctx->schtedaxprop,fd, 1); - save_line(fd); - save_box(fd); - save_arc(fd); - save_polygon(fd); - save_text(fd); - save_wire(fd); - save_inst(fd); + save_line(fd, 0); + save_box(fd, 0); + save_arc(fd, 0); + save_polygon(fd, 0); + save_text(fd, 0); + save_wire(fd, 0); + save_inst(fd, 0); } static void load_text(FILE *fd) @@ -917,6 +924,40 @@ void make_symbol(void) } +void make_schematic(const char *schname) +{ + FILE *fd=NULL; + rebuild_selected_array(); + if (!xctx->lastsel) return; + if (!(fd = fopen(schname, "w"))) + { + fprintf(errfp, "make_schematic(): problems opening file %s \n", schname); + tcleval("alert_ {file opening for write failed!} {}"); + return; + } + fprintf(fd, "v {xschem version=%s file_version=%s}\n", XSCHEM_VERSION, XSCHEM_FILE_VERSION); + fprintf(fd, "G {}"); + fputc('\n', fd); + fprintf(fd, "V {}"); + fputc('\n', fd); + fprintf(fd, "E {}"); + fputc('\n', fd); + fprintf(fd, "S {}"); + fputc('\n', fd); + fprintf(fd, "K {type=subcircuit\nformat=\"@name @pinlist @symname\"\n"); + fprintf(fd, "%s\n", "template=\"name=x1\""); + fprintf(fd, "%s", "}\n"); + fputc('\n', fd); + save_line(fd, 1); + save_box(fd, 1); + save_arc(fd, 1); + save_polygon(fd, 1); + save_text(fd, 1); + save_wire(fd, 1); + save_inst(fd, 1); + fclose(fd); +} + /* ALWAYS call with absolute path in schname!!! */ int save_schematic(const char *schname) /* 20171020 added return value */ { diff --git a/src/scheduler.c b/src/scheduler.c index fcc21aee..f9939678 100644 --- a/src/scheduler.c +++ b/src/scheduler.c @@ -1048,6 +1048,8 @@ int xschem(ClientData clientdata, Tcl_Interp *interp, int argc, const char * arg printf(" place new symbol, asking filename\n"); printf(" xschem make_symbol\n"); printf(" make symbol view from current schematic\n"); + printf(" xschem make_sch_from_sel\n"); + printf(" make schematic view from selected components\n"); printf(" xschem place_text\n"); printf(" place new text\n"); printf(" xschem debug n\n"); @@ -1476,7 +1478,36 @@ int xschem(ClientData clientdata, Tcl_Interp *interp, int argc, const char * arg } Tcl_ResetResult(interp); } - + + else if (!strcmp(argv[1], "make_sch_from_sel")) + { + char filename[PATH_MAX]=""; + cmd_found = 1; + my_snprintf(name, S(name), "save_file_dialog {Save file} .sch.sym INITIALLOADDIR"); + tcleval(name); + my_strncpy(filename, tclresult(), S(filename)); + if (!strcmp(filename, xctx->sch[xctx->currsch])) { + if (has_x) + tcleval("tk_messageBox -type ok -message {Cannot overwrite current schematic}"); + } + else if (strlen(filename)) { + make_schematic(filename); + delete(); + place_symbol(-1, filename, 0, 0, 0, 0, NULL, 4, 1); + if (has_x) + { + my_snprintf(name, S(name), "tk_messageBox -type okcancel -message {do you want to make symbol view for %s ?}", filename); + tcleval(name); + } + if (!has_x || !strcmp(tclresult(), "ok")) { + my_snprintf(name, S(name), "make_symbol_lcc {%s}", filename); + dbg(1, "make_symbol_lcc(): making symbol: name=%s\n", filename); + tcleval(name); + } + } + Tcl_ResetResult(interp); + } + else if(!strcmp(argv[1],"merge")) { cmd_found = 1; diff --git a/src/xschem.h b/src/xschem.h index 8a525d95..a84db82a 100644 --- a/src/xschem.h +++ b/src/xschem.h @@ -873,6 +873,7 @@ extern const char *rel_sym_path(const char *s); extern const char *abs_sym_path(const char *s, const char *ext); extern const char *add_ext(const char *f, const char *ext); extern void make_symbol(void); +extern void make_schematic(const char *schname); extern const char *get_sym_template(char *s, char *extra); /* bit0: invoke change_linewidth(), bit1: centered zoom */ extern void zoom_full(int draw, int sel, int flags, double shrink); diff --git a/src/xschem.tcl b/src/xschem.tcl index 9798ad72..e3099bcf 100644 --- a/src/xschem.tcl +++ b/src/xschem.tcl @@ -1,4301 +1,4310 @@ -# -# File: xschem.tcl -# -# This file is part of XSCHEM, -# a schematic capture and Spice/Vhdl/Verilog netlisting tool for circuit -# simulation. -# Copyright (C) 1998-2020 Stefan Frederik Schippers -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - - -### for tclreadline: disable customcompleters -proc completer { text start end line } { return {}} - -### -### set var with $val if var Not existing -### -proc set_ne { var val } { - upvar #0 $var v - if { ![ info exists v ] } { - set v $val - } -} - -### -### Tk procedures -### -# execute service function -proc execute_fileevent {id} { - global execute_pipe execute_data execute_cmd simulate_oldbg - global execute_status execute_callback - append execute_data($id) [read $execute_pipe($id) 1024] - if {[eof $execute_pipe($id)]} { - fileevent $execute_pipe($id) readable "" - # setting pipe to blocking before closing allows to see if pipeline failed - # do not ask status for processes that close stdout/stderr, as eof might - # occur before process ends and following close blocks until process terminates. - fconfigure $execute_pipe($id) -blocking 1 - set status 0 - - if { [ info tclversion] > 8.4} { - set catch_return [eval catch [ list {close $execute_pipe($id)} err options] ] - } else { - set catch_return [eval catch [ list {close $execute_pipe($id)} err] ] - } - if {$catch_return} { - if { [ info tclversion] > 8.4} { - set details [dict get $options -errorcode] - if {[lindex $details 0] eq "CHILDSTATUS"} { - set status [lindex $details 2] - viewdata "Failed: $execute_cmd($id)\nstderr:\n$err\ndata:\n$execute_data($id)" ro - } else { - set status 1 - if {$execute_status($id) } { - viewdata "Completed: $execute_cmd($id)\nstderr:\n$err\ndata:\n$execute_data($id)" ro - } - } - } else { - set status 1 - if {$execute_status($id) } { - viewdata "Completed: $execute_cmd($id)\nstderr:\n$err\ndata:\n$execute_data($id)" ro - } - } - } - if { $status == 0 } { - if {$execute_status($id) } { - viewdata "Completed: $execute_cmd($id)\ndata:\n$execute_data($id)" ro - } - } - if { [info exists execute_callback($id)] } { eval $execute_callback($id); unset execute_callback($id) } - unset execute_pipe($id) - unset execute_data($id) - unset execute_status($id) - unset execute_cmd($id) - } -} - - -proc execute_wait {status args} { - global execute_pipe - set id [eval execute $status $args] - if {$id == -1} { - return -1 - } - xschem set semaphore [expr {[xschem get semaphore] +1}] - vwait execute_pipe($id) - xschem set semaphore [expr {[xschem get semaphore] -1}] - return $id -} - -# equivalent to the 'exec' tcl function but keeps the event loop -# responding, so widgets get updated properly -# while waiting for process to end. -proc execute {status args} { - global execute_id execute_status - global execute_data - global execute_cmd - global execute_pipe - if {![info exists execute_id]} { - set execute_id 0 - } else { - incr execute_id - } - set id $execute_id - if { [catch {open "|$args" r} err] } { - puts stderr "Proc execute error: $err" - return -1 - } else { - set pipe $err - } - set execute_status($id) $status - set execute_pipe($id) $pipe - set execute_cmd($id) $args - set execute_data($id) "" - fconfigure $pipe -blocking 0 - fileevent $pipe readable "execute_fileevent $id" - return $id -} - -proc netlist {source_file show netlist_file} { - global XSCHEM_SHAREDIR flat_netlist hspice_netlist netlist_dir - global verilog_2001 netlist_type tcl_debug - - simuldir - if {$tcl_debug <= -1} { puts "netlist: source_file=$source_file, netlist_type=$netlist_type" } - if {$netlist_type eq {spice}} { - if { $hspice_netlist == 1 } { - set simulator {-hspice} - } else { - set simulator {} - } - if { [sim_is_xyce] } { - set xyce {-xyce} - } else { - set xyce {} - } - if {$flat_netlist==0} { - eval exec {awk -f ${XSCHEM_SHAREDIR}/spice.awk -- $simulator $xyce $source_file | \ - awk -f ${XSCHEM_SHAREDIR}/break.awk | \ - awk -f ${XSCHEM_SHAREDIR}/flatten_savenodes.awk -- $simulator $xyce \ - > $netlist_dir/$netlist_file} - } else { - eval exec {awk -f ${XSCHEM_SHAREDIR}/spice.awk -- $simulator $xyce $source_file | \ - awk -f ${XSCHEM_SHAREDIR}/flatten.awk | awk -f ${XSCHEM_SHAREDIR}/break.awk > $netlist_dir/$netlist_file} - } - if ![string compare $show "show"] { - textwindow $netlist_dir/$netlist_file - } - } - if {$netlist_type eq {vhdl}} { - eval exec {awk -f $XSCHEM_SHAREDIR/vhdl.awk $source_file > $netlist_dir/$netlist_file} - if ![string compare $show "show"] { - textwindow $netlist_dir/$netlist_file - } - } - if {$netlist_type eq {tedax}} { - if {[catch {eval exec {awk -f $XSCHEM_SHAREDIR/tedax.awk $source_file | awk -f $XSCHEM_SHAREDIR/flatten_tedax.awk \ - > $netlist_dir/$netlist_file} } err] } { - puts stderr "tEDAx errors: $err" - } - if ![string compare $show "show"] { - textwindow $netlist_dir/$netlist_file - } - } - if {$netlist_type eq {verilog}} { - eval exec {awk -f ${XSCHEM_SHAREDIR}/verilog.awk $source_file \ - > $netlist_dir/$netlist_file} - - # 20140409 - if { $verilog_2001==1 } { - set vv [pid] - eval exec {awk -f ${XSCHEM_SHAREDIR}/convert_to_verilog2001.awk $netlist_dir/$netlist_file > $netlist_dir/${netlist_file}$vv} - eval exec {mv $netlist_dir/${netlist_file}$vv $netlist_dir/$netlist_file} - } - if ![string compare $show "show"] { - textwindow "$netlist_dir/$netlist_file" - } - } - return {} -} - -# 20161121 -proc convert_to_pdf {filename dest} { - global to_pdf - # puts "convert_to_pdf: $filename --> $dest" - if { [regexp -nocase {\.pdf$} $dest] } { - set pdffile [file rootname $filename].pdf - set cmd "exec $to_pdf $filename $pdffile" - if {$::OS == "Windows"} { - set cmd "exec $to_pdf $pdffile $filename" - } - if { ![catch $cmd msg] } { - file rename -force $pdffile $dest - # ps2pdf succeeded, so remove original .ps file - if { ![xschem get debug_var] } { - file delete $filename - } - } else { - puts stderr "problems converting postscript to pdf: $msg" - } - } else { - file rename -force $filename $dest - } -} - -# 20161121 -proc convert_to_png {filename dest} { - global to_png tcl_debug - # puts "---> $to_png $filename $destfile" - set cmd "exec $to_png $filename png:$dest" - if {$::OS == "Windows"} { - set cmd "exec $to_png $dest $filename" - } - if { ![catch $cmd msg] } { - # conversion succeeded, so remove original .xpm file - if { ![xschem get debug_var] } { - file delete $filename - } - } else { - puts stderr "problems converting xpm to png: $msg" - } -} - -# always specify Shift- modifier for capital letters -# see tk 'man keysyms' for key names -# example format for s, d: Control-Alt-Key-asterisk -# Control-Shift-Key-A -# Alt-Key-c -# ButtonPress-4 -# -proc key_binding { s d } { - regsub {.*-} $d {} key - - - switch $key { - Insert { set keysym 65379 } - Escape { set keysym 65307 } - Return { set keysym 65293 } - Delete { set keysym 65535 } - F1 { set keysym 65470 } - F2 { set keysym 65471 } - F3 { set keysym 65472 } - F4 { set keysym 65473 } - F5 { set keysym 65474 } - F6 { set keysym 65475 } - F7 { set keysym 65476 } - F8 { set keysym 65477 } - F9 { set keysym 65478 } - F10 { set keysym 65479 } - F11 { set keysym 65480 } - F12 { set keysym 65481 } - BackSpace { set keysym 65288 } - default { set keysym [scan "$key" %c] } - } - set state 0 - # not found any portable way to get modifier constants ... - if { [regexp {(Mod1|Alt)-} $d] } { set state [expr $state +8] } - if { [regexp Control- $d] } { set state [expr $state +4] } - if { [regexp Shift- $d] } { set state [expr $state +1] } - if { [regexp ButtonPress-1 $d] } { set state [expr $state +0x100] } - if { [regexp ButtonPress-2 $d] } { set state [expr $state +0x200] } - if { [regexp ButtonPress-3 $d] } { set state [expr $state +0x400] } - # puts "$state $key <${s}>" - if {[regexp ButtonPress- $d]} { - bind .drw "<${s}>" "xschem callback %T %x %y 0 $key 0 $state" - } else { - if {![string compare $d {} ] } { - # puts "bind .drw <${s}> {}" - bind .drw "<${s}>" {} - } else { - # puts "bind .drw <${s}> xschem callback %T %x %y $keysym 0 0 $state" - bind .drw "<${s}>" "xschem callback %T %x %y $keysym 0 0 $state" - } - } - -} - -proc edit_file {filename} { - - global editor - # since $editor can be an executable with options (gvim -f) I *need* to use eval - eval execute 0 $editor $filename - return {} -} - -# ============================================================ -# SIMULATION CONTROL -# ============================================================ - -# ============================================================ -# SIMCONF -# ============================================================ - -## $N : netlist file full path (/home/schippes/simulations/opamp.spice) -## $n : netlist file full path with extension chopped (/home/schippes/simulations/opamp) -## $s : schematic name (opamp) -## $d : netlist directory -## -## Other global vars: -## netlist_dir -## netlist_type -## computerfarm -## terminal -proc save_sim_defaults {f} { - global sim netlist_dir netlist_type computerfarm terminal - - set a [catch {open $f w} fd] - if { $a } { - puts "save_sim_defaults: error opening file $f: $fd" - return - } - puts $fd {# set the list of tools known to xschem} - puts $fd {# Note that no spaces are allowed around commas in array keys} - puts $fd "set sim(tool_list) {$sim(tool_list)}" - puts $fd {} - foreach tool $sim(tool_list) { - puts $fd "#Specify the number of configured $tool tools." - puts $fd "set sim($tool,n) $sim($tool,n) ;# number of configured $tool tools" - puts $fd "# Specify the default $tool tool to use (first=0)" - puts $fd "set sim($tool,default) $sim($tool,default) ;# default $tool tool to launch" - puts $fd {} - for {set i 0} {$i < $sim($tool,n)} { incr i} { - puts $fd "# specify tool command (cmd), name (name), if tool must run\ - in foreground and if exit status must be reported" - puts $fd "set sim($tool,$i,cmd) {$sim($tool,$i,cmd)}" - puts $fd "set sim($tool,$i,name) {$sim($tool,$i,name)}" - puts $fd "set sim($tool,$i,fg) $sim($tool,$i,fg)" - puts $fd "set sim($tool,$i,st) $sim($tool,$i,st)" - puts $fd {} - } - puts $fd {} - } - close $fd -} - - -proc update_recent_file {f} { - global recentfile - set old $recentfile - set recentfile {} - lappend recentfile $f - foreach i $old { - if {[abs_sym_path $i] ne [abs_sym_path $f]} { - lappend recentfile [abs_sym_path $i] - } - } - # tcl8.4 errors if using lreplace past the last element - if { [llength $recentfile] > 10 } { - set recentfile [lreplace $recentfile 10 end] - } - write_recent_file - if { [info exists ::has_x] } setup_recent_menu -} - -proc write_recent_file {} { - global recentfile USER_CONF_DIR - - set a [catch {open $USER_CONF_DIR/recent_files w} fd] - if { $a } { - puts "write_recent_file: error opening file $f: $fd" - return - } - puts $fd "set recentfile {$recentfile}" - close $fd -} - -proc setup_recent_menu {} { - global recentfile - .menubar.file.menu.recent delete 0 9 - set i 0 - if { [info exists recentfile] } { - foreach i $recentfile { - .menubar.file.menu.recent add command \ - -command "xschem load {$i}" \ - -label [file tail $i] - } - } -} - -proc sim_is_xyce {} { - global sim - - set_sim_defaults - - if { [info exists sim(spice,default)] } { - set idx $sim(spice,default) - if { [regexp {[xX]yce} $sim(spice,$idx,cmd)] } { - return 1 - } - } - return 0 -} - - -proc set_sim_defaults {} { - ### spice - global sim terminal USER_CONF_DIR has_x - - set failure 0 - if { [info exists has_x] && [winfo exists .sim] } { - foreach tool $sim(tool_list) { - for {set i 0} {$i < $sim($tool,n)} { incr i} { - set sim($tool,$i,cmd) [.sim.topf.f.scrl.center.$tool.r.$i.cmd get 1.0 {end - 1 chars}] - } - } - } - if { ![info exists sim] } { - if { [file exists ${USER_CONF_DIR}/simrc] } { - # get conf from simrc - if { [catch {source ${USER_CONF_DIR}/simrc} err]} { - puts "Problems opening simrc file: $err" - if {[info exists has_x]} { - tk_messageBox -message "Problems opening simrc file: $err" -icon warning -parent . -type ok - } - set failure 1 - } - } - } - if {![info exists sim] || $failure} { - if {[info exists sim]} {unset sim} - # no simrc, set a reasonable default - set sim(tool_list) {spice spicewave verilog verilogwave vhdl vhdlwave} - if {$::OS == "Windows"} { - set_ne sim(spice,0,cmd) {ngspice -i "$N" -a} - } else { - set_ne sim(spice,0,cmd) {$terminal -e 'ngspice -i "$N" -a || sh'} - } - set_ne sim(spice,0,name) {Ngspice} - set_ne sim(spice,0,fg) 0 - set_ne sim(spice,0,st) 0 - - set_ne sim(spice,1,cmd) {ngspice -b -r "$n.raw" -o "$n.out" "$N"} - set_ne sim(spice,1,name) {Ngspice batch} - set_ne sim(spice,1,fg) 0 - set_ne sim(spice,1,st) 1 - - set_ne sim(spice,2,cmd) {Xyce "$N" -r "$n.raw"} - set_ne sim(spice,2,name) {Xyce batch} - set_ne sim(spice,2,fg) 0 - set_ne sim(spice,2,st) 1 - - # number of configured spice simulators, and default one - set_ne sim(spice,n) 3 - set_ne sim(spice,default) 0 - - ### spice wave view - set_ne sim(spicewave,0,cmd) {gaw "$n.raw" } - set_ne sim(spicewave,0,name) {Gaw viewer} - set_ne sim(spicewave,0,fg) 0 - set_ne sim(spicewave,0,st) 0 - - set_ne sim(spicewave,1,cmd) {echo load "$n.raw" > .spiceinit - $terminal -e ngspice - rm .spiceinit} - set_ne sim(spicewave,1,name) {Ngpice Viewer} - set_ne sim(spicewave,1,fg) 0 - set_ne sim(spicewave,1,st) 0 - - set_ne sim(spicewave,2,cmd) {rawtovcd -v 1.5 "$n.raw" > "$n.vcd" && gtkwave "$n.vcd" "$n.sav" 2>/dev/null} - set_ne sim(spicewave,2,name) {Rawtovcd} - set_ne sim(spicewave,2,fg) 0 - set_ne sim(spicewave,2,st) 0 - # number of configured spice wave viewers, and default one - set_ne sim(spicewave,n) 3 - set_ne sim(spicewave,default) 0 - - ### verilog - set_ne sim(verilog,0,cmd) {iverilog -o .verilog_object -g2012 "$N" && vvp .verilog_object} - set_ne sim(verilog,0,name) {Icarus verilog} - set_ne sim(verilog,0,fg) 0 - set_ne sim(verilog,0,st) 1 - # number of configured verilog simulators, and default one - set_ne sim(verilog,n) 1 - set_ne sim(verilog,default) 0 - - ### verilog wave view - set_ne sim(verilogwave,0,cmd) {gtkwave dumpfile.vcd "$N.sav" 2>/dev/null} - set_ne sim(verilogwave,0,name) {Gtkwave} - set_ne sim(verilogwave,0,fg) 0 - set_ne sim(verilogwave,0,st) 0 - # number of configured verilog wave viewers, and default one - set_ne sim(verilogwave,n) 1 - set_ne sim(verilogwave,default) 0 - - ### vhdl - set_ne sim(vhdl,0,cmd) {ghdl -c --ieee=synopsys -fexplicit "$N" -r "$s" --wave="$n.ghw"} - set_ne sim(vhdl,0,name) {Ghdl} - set_ne sim(vhdl,0,fg) 0 - set_ne sim(vhdl,0,st) 1 - # number of configured vhdl simulators, and default one - set_ne sim(vhdl,n) 1 - set_ne sim(vhdl,default) 0 - - ### vhdl wave view - set_ne sim(vhdlwave,0,cmd) {gtkwave "$n.ghw" "$N.sav" 2>/dev/null} - set_ne sim(vhdlwave,0,name) {Gtkwave} - set_ne sim(vhdlwave,0,fg) 0 - set_ne sim(vhdlwave,0,st) 0 - # number of configured vhdl wave viewers, and default one - set_ne sim(vhdlwave,n) 1 - set_ne sim(vhdlwave,default) 0 - } -} - -proc simconf_yview { args } { - global simconf_vpos - # puts "simconf_yview: $args" - set_ne simconf_vpos 0 - if {[lindex $args 0] eq {place}} { - place .sim.topf.f.scrl -in .sim.topf.f -x 0 -y 0 -relwidth 1 - update - } - set ht [winfo height .sim.topf.f] - set hs [winfo height .sim.topf.f.scrl] - # puts "ht=$ht hs=$hs" - set frac [expr {double($ht)/$hs}] - if { [lindex $args 0] eq {scroll}} { - set simconf_vpos [expr $simconf_vpos + [lindex $args 1] *(1.0/$frac)/5] - } elseif { [lindex $args 0] eq {moveto}} { - set simconf_vpos [lindex $args 1] - } - if { $simconf_vpos < 0.0 } { set simconf_vpos 0.0} - if { $simconf_vpos > 1.0-$frac } { set simconf_vpos [expr 1.0 - $frac]} - .sim.topf.vs set $simconf_vpos [expr $simconf_vpos + $frac] - place .sim.topf.f.scrl -in .sim.topf.f -x 0 -y [expr -$hs * $simconf_vpos] -relwidth 1 -} - -proc simconf {} { - global sim USER_CONF_DIR simconf_default_geometry - - catch { destroy .sim } - set_sim_defaults - toplevel .sim -class dialog - wm title .sim {Simulation Configuration} - wm geometry .sim 700x340 - frame .sim.topf - frame .sim.topf.f - frame .sim.topf.f.scrl - scrollbar .sim.topf.vs -command {simconf_yview} - pack .sim.topf.f -fill both -expand yes -side left - pack .sim.topf.vs -fill y -expand yes - frame .sim.topf.f.scrl.top - frame .sim.topf.f.scrl.center - frame .sim.bottom - pack .sim.topf.f.scrl.top -fill x - pack .sim.topf.f.scrl.center -fill both -expand yes - set bg(0) {#dddddd} - set bg(1) {#aaaaaa} - set toggle 0 - foreach tool $sim(tool_list) { - frame .sim.topf.f.scrl.center.$tool - label .sim.topf.f.scrl.center.$tool.l -width 12 -text $tool -bg $bg($toggle) - frame .sim.topf.f.scrl.center.$tool.r - pack .sim.topf.f.scrl.center.$tool -fill both -expand yes - pack .sim.topf.f.scrl.center.$tool.l -fill y -side left - pack .sim.topf.f.scrl.center.$tool.r -fill both -expand yes - for {set i 0} { $i < $sim($tool,n)} {incr i} { - frame .sim.topf.f.scrl.center.$tool.r.$i - pack .sim.topf.f.scrl.center.$tool.r.$i -fill x -expand yes - entry .sim.topf.f.scrl.center.$tool.r.$i.lab -textvariable sim($tool,$i,name) -width 15 -bg $bg($toggle) - radiobutton .sim.topf.f.scrl.center.$tool.r.$i.radio -bg $bg($toggle) \ - -variable sim($tool,default) -value $i - text .sim.topf.f.scrl.center.$tool.r.$i.cmd -width 20 -height 3 -wrap none -bg $bg($toggle) - .sim.topf.f.scrl.center.$tool.r.$i.cmd insert 1.0 $sim($tool,$i,cmd) - checkbutton .sim.topf.f.scrl.center.$tool.r.$i.fg -text Fg -variable sim($tool,$i,fg) -bg $bg($toggle) - checkbutton .sim.topf.f.scrl.center.$tool.r.$i.st -text Status -variable sim($tool,$i,st) -bg $bg($toggle) - - pack .sim.topf.f.scrl.center.$tool.r.$i.lab -side left -fill y - pack .sim.topf.f.scrl.center.$tool.r.$i.radio -side left -fill y - pack .sim.topf.f.scrl.center.$tool.r.$i.cmd -side left -fill x -expand yes - pack .sim.topf.f.scrl.center.$tool.r.$i.fg -side left -fill y - pack .sim.topf.f.scrl.center.$tool.r.$i.st -side left -fill y - } - incr toggle - set toggle [expr {$toggle %2}] - } - button .sim.bottom.cancel -text Cancel -command {destroy .sim} - button .sim.bottom.help -text Help -command { - set h {The following variables are defined and will get substituted by -XSCHEM before sending commands to the shell: - - - N: complete filename of netlist for current netlisting mode - (example: /home/schippes/.xschem/simulations/opamp.spice for spice) - (example: /home/schippes/.xschem/simulations/opamp.v for verilog) - - n: complete filename of netlist as above but without extension - (example: /home/schippes/.xschem/simulations/opamp) - - S: full pathname of schematic being used (example: - /home/schippes/.xschem/xschem_library/opamp.sch) - - s: name of schematic being used (example: opamp) - - d: simulation directory (example: /home/schippes/.xschem/simulations) - - terminal: terminal to be used for applications that need to be - executed in terminal (example: $terminal -e ngspice -i "$N" -a) -If for a given tool there are multiple rows then the radiobutton -tells which one will be called by xschem. -Variables should be used with the usual substitution character $: $n, $N, etc. -Foreground checkbutton tells xschem to wait for child process to finish. -Status checkbutton tells xschem to report a status dialog (stdout, stderr, -exit status) when process finishes. -Any changes made in the command or tool name entries will be saved in -~/.xschem/simrc when 'Save Configuration' button is pressed. -If no ~/.xschem/simrc is present then a bare minumum skeleton setup is presented. -To reset to default just delete the ~/.xschem/simrc file manually. - } - viewdata $h ro - } - button .sim.bottom.ok -text {Accept and Save Configuration} -command { - foreach tool $sim(tool_list) { - for {set i 0} { $i < $sim($tool,n)} {incr i} { - set sim($tool,$i,cmd) [.sim.topf.f.scrl.center.$tool.r.$i.cmd get 1.0 {end - 1 chars}] - } - } - # destroy .sim - save_sim_defaults ${USER_CONF_DIR}/simrc - # puts "saving simrc" - } - button .sim.bottom.close -text {Accept and Close} -command { - set_sim_defaults - destroy .sim - } - wm protocol .sim WM_DELETE_WINDOW { set_sim_defaults; destroy .sim } - pack .sim.bottom.cancel -side left -anchor w - pack .sim.bottom.help -side left - #foreach tool $sim(tool_list) { - # button .sim.bottom.add${tool} -text +${tool} -command " - # simconf_add $tool - # destroy .sim - # save_sim_defaults ${USER_CONF_DIR}/simrc - ## simconf - # " - # pack .sim.bottom.add${tool} -side left - #} - pack .sim.bottom.ok -side right -anchor e - pack .sim.bottom.close -side right - pack .sim.topf -fill both -expand yes - pack .sim.bottom -fill x - if { [info exists simconf_default_geometry]} { - wm geometry .sim "${simconf_default_geometry}" - } - - bind .sim.topf.f {simconf_yview} - bind .sim { - set simconf_default_geometry [wm geometry .sim] - } - bind .sim { simconf_yview scroll -0.2} - bind .sim { simconf_yview scroll 0.2} - simconf_yview place - set maxsize [expr [winfo height .sim.topf.f.scrl] + [winfo height .sim.bottom]] - wm maxsize .sim 9999 $maxsize - # tkwait window .sim -} - -proc simconf_add {tool} { - global sim - set n $sim($tool,n) - set sim($tool,$n,cmd) {} - set sim($tool,$n,name) {} - set sim($tool,$n,fg) 0 - set sim($tool,$n,st) 0 - incr sim($tool,n) -} - -proc xschem_getdata {sock} { - global xschem_server_getdata - if {[eof $sock] || [catch {gets $sock xschem_server_getdata(line,$sock)}]} { - close $sock - puts "Close $xschem_server_getdata(addr,$sock)" - unset xschem_server_getdata(addr,$sock) - unset xschem_server_getdata(line,$sock) - unset xschem_server_getdata(res,$sock) - } else { - puts "tcp--> $xschem_server_getdata(line,$sock)" - # xschem command must be executed at global scope... - uplevel #0 [list catch $xschem_server_getdata(line,$sock) xschem_server_getdata(res,$sock)] - puts $sock "$xschem_server_getdata(res,$sock)" - } -} - -proc xschem_server {sock addr port} { - global xschem_server_getdata - puts "Accept $sock from $addr port $port" - fconfigure $sock -buffering line - set xschem_server_getdata(addr,$sock) [list $addr $port] - fileevent $sock readable [list xschem_getdata $sock] -} - -## given a path (x1.x2.m4) descend into x1.x2 and return m4 whether m4 found or not -proc descend_hierarchy {path {redraw 1}} { - xschem set no_draw 1 - # return to top level if not already there - while { [xschem get currsch] } { xschem go_back } - # recursively descend into sub-schematics - while { [regexp {\.} $path] } { - xschem unselect_all - set inst $path - regsub {\..*} $inst {} inst ;# take 1st path component: xlev1[3].xlev2.m3 -> xlev1[3] - regsub {[^.]+\.} $path {} path ;# take remaining path: xlev1[3].xlev2.m3 -> xlev2.m3 - xschem search exact 1 name $inst - # handle vector instances: xlev1[3:0] -> xlev1[3],xlev1[2],xlev1[1],xlev1[0] - # descend into the right one - set inst_list [split [lindex [xschem expandlabel [lindex [xschem selected_set] 0 ] ] 0] {,}] - set instnum [expr [lsearch -exact $inst_list $inst] + 1] - xschem descend $instnum - } - xschem set no_draw 0 - if {$redraw} {xschem redraw} - return $path -} - -## given a hierarchical instname name (x1.xamp.m1) go down in the hierarchy and -## select the specified instance (m1). -## this search assumes it is given from the top of hierarchy -proc select_inst {fullinst {redraw 1 } } { - xschem set no_draw 1 - set inst [descend_hierarchy $fullinst 0] - set res [xschem select instance $inst] - # if nothing found return to top - if {!$res} { - while { [xschem get currsch] } { xschem go_back } - } - xschem set no_draw 0 - if {$redraw} {xschem redraw} - if {$res} {return $inst} else { return {} } -} - -proc pin_label {} { - if { [file exists [abs_sym_path devices/lab_pin.sym]] } { - return {devices/lab_pin.sym} - } - return {lab_pin.sym} -} - -## given a hierarchical net name x1.xamp.netname go down in the hierarchy and -## highlight the specified net. -## this search assumes it is given from the top of hierarchy -proc probe_net {fullnet {redraw 1} } { - xschem set no_draw 1 - set net [descend_hierarchy $fullnet 0] - set res [xschem hilight_netname $net] - if {$res==0 && [regexp {^net[0-9]+$} $net]} { - set net \#$net - set res [xschem hilight_netname $net] - } - if {!$res} { - while { [xschem get currsch] } { xschem go_back } - } - xschem set no_draw 0 - if {$redraw} {xschem redraw} - if {$res} {return $net} else { return {} } -} - -# backannotate newnet to be connected to specified hierarchical instance name and pin. -# places a label close to the instance pin to be re-routed. -# actual reconnect is human assisted! -proc reroute_inst {fullinst pinattr pinval newnet} { - if { [regexp {\.} $fullinst] } { set hier 1 } else { set hier 0 } - set res [descend_hierarchy $fullinst 0] - if {$res ne {} } { - set coord [xschem instance_pin_coord $res $pinattr $pinval] - if { $coord eq {} } { - while { [xschem get currsch] } { xschem go_back } - return 0 - } - set pinname [lindex $coord 0] - set x [expr [lindex $coord 1] - 10 ] - set y [expr [lindex $coord 2] - 10 ] - set oldnet [xschem instance_net $res $pinname] - - regsub {.*\.} $newnet {} newnet - if { $oldnet eq $newnet } { - while { [xschem get currsch] } { xschem go_back } - puts "Warning: netlist patch already done? " - return 0 - } - - xschem instance [pin_label] $x $y 0 0 [list name=l1 lab=$newnet] - xschem hilight_netname $newnet - xschem select instance $res - xschem hilight_netname $oldnet - if {$hier} { xschem save} ;# save so we can process other reroute_inst without beink asked to save. - xschem redraw - return 1 - } - return 0 -} - -## put $new net labels close to pins on all elements connected to $old -proc reroute_net {old new} { - xschem push_undo - xschem set no_undo 1 - xschem unhilight - probe_net $old - set old_nopath [regsub {.*\.} $old {}] - set new_nopath [regsub {.*\.} $new {}] - set devlist [xschem instances_to_net $old_nopath] - foreach i $devlist { - set instname [lindex $i 0] - set x [expr [lindex $i 2] - 10] - set y [expr [lindex $i 3] - 10] - xschem instance [pin_label] $x $y 0 0 [list name=l1 lab=$new_nopath] - xschem select instance $instname - } - xschem hilight_netname $new_nopath - xschem set no_undo 0 -} - -proc simulate {{callback {}}} { - ## $N : netlist file full path (/home/schippes/simulations/opamp.spice) - ## $n : netlist file full path with extension chopped (/home/schippes/simulations/opamp) - ## $s : schematic name (opamp) - ## $S : schematic name full path (/home/schippes/.xschem/xschem_library/opamp.sch) - ## $d : netlist directory - - global netlist_dir netlist_type computerfarm terminal sim - global execute_callback XSCHEM_SHAREDIR has_x - - simuldir - set_sim_defaults - if { [select_netlist_dir 0] ne {}} { - set d ${netlist_dir} - set tool $netlist_type - set S [xschem get schname] - set s [file tail [file rootname $S]] - set n ${netlist_dir}/${s} - if {$tool eq {verilog}} { - set N ${n}.v - } else { - set N ${n}.${tool} - } - if { ![info exists sim($tool,default)] } { - if { $has_x} {alert_ "Warning: simulator for $tool is not configured"} - puts "Warning: simulator for $tool is not configured" - return - } - set def $sim($tool,default) - set fg $sim($tool,$def,fg) - set st $sim($tool,$def,st) - if {$fg} { - set fg {execute_wait} - } else { - set fg {execute} - } - set cmd [subst $sim($tool,$def,cmd)] - if {$::OS == "Windows"} { - # $cmd cannot be surrounded by {} as exec will change forward slash to backward slash - eval exec $cmd - } else { - set id [$fg $st sh -c "cd $netlist_dir; $cmd"] - set execute_callback($id) $callback - if {$fg eq {execute_wait}} { - eval $execute_callback($id); unset execute_callback($id) - } - } - } -} - -proc gaw_echoline {} { - global gaw_fd - gets $gaw_fd line - if {[eof $gaw_fd]} { - puts "finishing connection from gaw" - close $gaw_fd - unset gaw_fd - } else { - # generate a variable event we can vwait for - set gaw_fd $gaw_fd - } - puts "gaw -> $line" -} - -proc gaw_setup_tcp {} { - global gaw_fd gaw_tcp_address netlist_dir has_x - - simuldir - set s [file tail [file rootname [xschem get schname 0]]] - - if { ![info exists gaw_fd] && [catch {eval socket $gaw_tcp_address} gaw_fd] } { - puts "Problems opening socket to gaw on address $gaw_tcp_address" - unset gaw_fd - if {[info exists has_x]} { - tk_messageBox -type ok -title {Tcp socket error} \ - -message [concat "Problems opening socket to gaw on address $gaw_tcp_address. " \ - "Ensure the following line is present uncommented in ~/.gaw/gawrc: up_listenPort = 2020." \ - "If you recently closed gaw the port may be in a TIME_WAIT state for a minute or so ." \ - "Close gaw, Wait a minute or two, then send waves to gaw again."] - } - return - } - chan configure $gaw_fd -blocking 1 -buffering line -encoding binary -translation binary - fileevent $gaw_fd readable gaw_echoline - puts $gaw_fd "table_set $s.raw" -} - -proc gaw_cmd {cmd} { - global gaw_fd gaw_tcp_address netlist_dir has_x - - simuldir - if { ![info exists gaw_fd] && [catch {eval socket $gaw_tcp_address} gaw_fd] } { - puts "Problems opening socket to gaw on address $gaw_tcp_address" - unset gaw_fd - if {[info exists has_x]} { - tk_messageBox -type ok -title {Tcp socket error} \ - -message [concat "Problems opening socket to gaw on address $gaw_tcp_address. " \ - "If you recently closed gaw the port may be in a TIME_WAIT state for a minute or so ." \ - "Close gaw, Wait a minute or two, then send waves to gaw again."] - } - return - } - chan configure $gaw_fd -blocking 0 -buffering line -encoding binary -translation binary - puts $gaw_fd "$cmd" - set n [regexp -all \n $cmd] - incr n - puts "gaw command lines: $n" - fileevent $gaw_fd readable gaw_echoline - while { $n} { - #timeout for abnormal deadlocks - set wd [after 10000 set gaw_fd stalled] - vwait gaw_fd - if { $gaw_fd ne {stalled} } { - after cancel $wd - } else { - puts "timeout waiting for gaw response.." - break - } - incr n -1 - } - close $gaw_fd - unset gaw_fd -} - -proc waves {} { - ## $N : netlist file full path (/home/schippes/simulations/opamp.spice) - ## $n : netlist file full path with extension chopped (/home/schippes/simulations/opamp) - ## $s : schematic name (opamp) - ## $S : schematic name full path (/home/schippes/.xschem/xschem_library/opamp.sch) - ## $d : netlist directory - - global netlist_dir netlist_type computerfarm terminal sim XSCHEM_SHAREDIR has_x - - simuldir - set_sim_defaults - if { [select_netlist_dir 0] ne {}} { - set d ${netlist_dir} - set tool ${netlist_type} - set S [xschem get schname] - set s [file tail [file rootname $S]] - set n ${netlist_dir}/${s} - if {$tool eq {verilog}} { - set N ${n}.v - } else { - set N ${n}.${tool} - } - set tool ${tool}wave - if { ![info exists sim($tool,default)] } { - if { $has_x} {alert_ "Warning: viewer for $tool is not configured"} - puts "Warning: viewer for $tool is not configured" - return - } - set def $sim($tool,default) - set fg $sim($tool,$def,fg) - set st $sim($tool,$def,st) - if {$fg} { - set fg {execute_wait} - } else { - set fg {execute} - } - set cmd [subst $sim($tool,$def,cmd)] - $fg $st sh -c "cd $netlist_dir; $cmd" - } -} -# ============================================================ - -proc utile_translate {schname} { - global netlist_dir netlist_type tcl_debug XSCHEM_SHAREDIR - global utile_gui_path utile_cmd_path - - simuldir - set tmpname [file rootname "$schname"] - eval exec {sh -c "cd \"$netlist_dir\"; \ - XSCHEM_SHAREDIR=\"$XSCHEM_SHAREDIR\" \"$utile_cmd_path\" stimuli.$tmpname"} -} - -proc utile_gui {schname} { - global netlist_dir netlist_type tcl_debug XSCHEM_SHAREDIR - global utile_gui_path utile_cmd_path - - simuldir - set tmpname [file rootname "$schname"] - eval exec {sh -c "cd \"$netlist_dir\"; \ - XSCHEM_SHAREDIR=\"$XSCHEM_SHAREDIR\" \"$utile_gui_path\" stimuli.$tmpname"} & -} - -proc utile_edit {schname} { - global netlist_dir netlist_type tcl_debug editor XSCHEM_SHAREDIR - global utile_gui_path utile_cmd_path - - simuldir - set tmpname [file rootname "$schname"] - execute 0 sh -c "cd \"$netlist_dir\" && $editor stimuli.$tmpname && \ - XSCHEM_SHAREDIR=\"$XSCHEM_SHAREDIR\" \"$utile_cmd_path\" stimuli.$tmpname" -} - -proc get_shell { curpath } { - global netlist_dir netlist_type tcl_debug - global terminal - - simuldir - execute 0 sh -c "cd $curpath && $terminal" -} - -proc edit_netlist {schname } { - global netlist_dir netlist_type tcl_debug - global editor terminal - - simuldir - set tmpname [file rootname "$schname"] - - if { [regexp vim $editor] } { set ftype "-c \":set filetype=$netlist_type\"" } else { set ftype {} } - if { [select_netlist_dir 0] ne "" } { - # puts "edit_netlist: \"$editor $ftype ${schname}.v\" \"$netlist_dir\" bg" - if { $netlist_type=="verilog" } { - execute 0 sh -c "cd $netlist_dir && $editor $ftype \"${tmpname}.v\"" - } elseif { $netlist_type=="spice" } { - if {$::OS == "Windows"} { - set cmd "$editor \"$netlist_dir/${tmpname}.spice\"" - eval exec $cmd - } else { - execute 0 sh -c "cd $netlist_dir && $editor $ftype \"${tmpname}.spice\"" - } - } elseif { $netlist_type=="tedax" } { - if {$::OS == "Windows"} { - set cmd "$editor \"$netlist_dir/${tmpname}.tdx\"" - eval exec $cmd - } else { - execute 0 sh -c "cd $netlist_dir && $editor $ftype \"${tmpname}.tdx\"" - } - } elseif { $netlist_type=="vhdl" } { - if {$::OS == "Windows"} { - set cmd "$editor \"$netlist_dir/${tmpname}.vhdl\"" - eval exec $cmd - } else { - execute 0 sh -c "cd $netlist_dir && $editor $ftype \"${tmpname}.vhdl\"" - } - } - } - return {} -} - - -# 20180926 -# global_initdir should be set to: -# INITIALLOADDIR for load -# INITIALINSTDIR for instance placement -# ext: .sch or .sym or .sch.sym or .sym.sch -# -proc save_file_dialog { msg ext global_initdir {initialfile {}} {overwrt 1} } { - upvar #0 $global_initdir initdir - set temp $initdir - if { $initialfile ne {}} { - set initialdir [file dirname $initialfile] - set initialfile [file tail $initialfile] - } else { - set initialdir $initdir - set initialfile {} - } - set initdir $initialdir - - set r [load_file_dialog $msg $ext $global_initdir $initialfile 0 $overwrt] - - - set initdir $temp - return $r -} - -proc is_xschem_file {f} { - set a [catch {open "$f" r} fd] - set ret 0 - set score 0 - set instances 0 - if {$a} { - puts stderr "Can not open file $f" - } else { - while { [gets $fd line] >=0 } { - if { [regexp {^[TKGVSE] \{} $line] } { incr score } - if { [regexp {^[BL] +[0-9]+ +[-0-9.eE]+ +[-0-9.eE]+ +[-0-9.eE]+ +[-0-9.eE]+ +\{} $line] } {incr score} - if { [regexp {^N +[-0-9.eE]+ +[-0-9.eE]+ +[-0-9.eE]+ +[-0-9.eE]+ +\{} $line] } {incr score} - if { [regexp {^C +\{[^{}]+\} +[-0-9.eE]+ +[-0-9.eE]+ +[0-3]+ +[0-3]+ +\{} $line] } {incr instances; incr score} - if { [regexp "^v\[ \t\]+\{xschem\[ \t\]+version\[ \t\]*=.*\[ \t\]+file_version\[ \t\]*=" $line] } { - set ret 1 - } - } - if { $score > 6 } { set ret 1} ;# Heuristic decision :-) - if { $ret } { - if { $instances} { - set ret SCHEMATIC - } else { - set ret SYMBOL - } - } - close $fd - } - # puts "score=$score" - return $ret -} - -proc list_dirs {pathlist } { - global list_dirs_selected_dir INITIALINSTDIR - toplevel .list -class dialog - wm title .list {Select Library:} - wm protocol .list WM_DELETE_WINDOW { set list_dirs_selected_dir {} } - set X [expr {[winfo pointerx .list] - 30}] - set Y [expr {[winfo pointery .list] - 25}] - if { $::wm_fix } { tkwait visibility .list } - wm geometry .list "+$X+$Y" - - set x 0 - set dir {} - label .list.title \ - -text "Choose path to start from. You can navigate anywhere\n with the file selector from there \n" \ - -background {#77dddd} - pack .list.title -fill x -side top - foreach elem $pathlist { - frame .list.${x} - label .list.${x}.l -text [expr {$x+1}] -width 4 - button .list.${x}.b -text $elem -command "set list_dirs_selected_dir $elem" - pack .list.${x}.l -side left - pack .list.${x}.b -side left -fill x -expand yes - pack .list.${x} -side top -fill x - incr x - } - frame .list.${x} - label .list.${x}.l -text [expr {$x+1}] -width 4 - button .list.${x}.b -text {Last used dir} -command "set list_dirs_selected_dir $INITIALINSTDIR" - pack .list.${x}.l -side left - pack .list.${x}.b -side left -fill x -expand yes - pack .list.${x} -side top -fill x - frame .list.but - button .list.but.cancel -text Cancel -command {set list_dirs_selected_dir {} } - - pack .list.but.cancel -side bottom - pack .list.but -fill x -side top - vwait list_dirs_selected_dir - destroy .list - return $list_dirs_selected_dir -} - - -proc myload_set_colors1 {} { - global myload_files1 dircolor - for {set i 0} { $i< [.dialog.l.paneleft.list index end] } { incr i} { - set name "[lindex $myload_files1 $i]" - .dialog.l.paneleft.list itemconfigure $i -foreground black -selectforeground black - foreach j [array names dircolor] { - set pattern $j - set color $dircolor($j) - if { [regexp $pattern $name] } { - .dialog.l.paneleft.list itemconfigure $i -foreground $color -selectforeground $color - } - } - } -} - -proc myload_set_colors2 {} { - global myload_index1 myload_files2 dircolor - set dir1 [abs_sym_path [.dialog.l.paneleft.list get $myload_index1]] - for {set i 0} { $i< [.dialog.l.paneright.list index end] } { incr i} { - set name "$dir1/[lindex $myload_files2 $i]" - if {[ file isdirectory $name]} { - .dialog.l.paneright.list itemconfigure $i -foreground blue - foreach j [array names dircolor] { - set pattern $j - set color $dircolor($j) - if { [regexp $pattern $name] } { - .dialog.l.paneright.list itemconfigure $i -foreground $color -selectforeground $color - } - } - - } else { - .dialog.l.paneright.list itemconfigure $i -foreground black - } - } -} - -proc myload_set_home {dir} { - global pathlist myload_files1 myload_index1 - - set curr_dirname [xschem get current_dirname] - .dialog.l.paneleft.list selection clear 0 end - if { $dir eq {.}} { set dir $curr_dirname} - # puts "set home: dir=$dir, pathlist=$pathlist" - set pl {} - foreach path_elem $pathlist { - if { ![string compare $path_elem .]} { - set path_elem $curr_dirname - } - lappend pl $path_elem - } - set i [lsearch -exact $pl $dir] - if { $i>=0 } { - set myload_files1 $pathlist - update - myload_set_colors1 - .dialog.l.paneleft.list xview moveto 1 - set myload_index1 $i - .dialog.l.paneleft.list selection set $myload_index1 - } else { - set myload_files1 [list $dir] - update - myload_set_colors1 - .dialog.l.paneleft.list xview moveto 1 - set myload_index1 0 - .dialog.l.paneleft.list selection set 0 - } -} - -proc setglob {dir} { - global globfilter myload_files2 - set myload_files2 [lsort [glob -nocomplain -directory $dir -tails -type d .* *]] - if { $globfilter eq {*}} { - set myload_files2 ${myload_files2}\ [lsort [glob -nocomplain -directory $dir -tails -type {f} .* $globfilter]] - } else { - set myload_files2 ${myload_files2}\ [lsort [glob -nocomplain -directory $dir -tails -type {f} $globfilter]] - } -} - -proc load_file_dialog_mkdir {dir} { - global myload_dir1 - if { $dir ne {} } { - file mkdir "${myload_dir1}/$dir" - setglob ${myload_dir1} - myload_set_colors2 - } -} - -proc load_file_dialog {{msg {}} {ext {}} {global_initdir {INITIALINSTDIR}} {initialfile {}} - {loadfile {1}} {confirm_overwrt {1}}} { - global myload_index1 myload_files2 myload_files1 myload_retval myload_dir1 pathlist - global myload_default_geometry myload_sash_pos myload_yview tcl_version globfilter myload_dirs2 - # return value - set myload_retval {} - upvar #0 $global_initdir initdir - if { [winfo exists .dialog] } return - toplevel .dialog -class dialog - wm title .dialog $msg - set_ne myload_index1 0 - if { ![info exists myload_files1]} { - set myload_files1 $pathlist - set myload_index1 0 - } - set_ne myload_files2 {} - - - panedwindow .dialog.l -orient horizontal - - frame .dialog.l.paneleft - if {$tcl_version > 8.5} { set just {-justify right}} else {set just {}} - eval [subst {listbox .dialog.l.paneleft.list -listvariable myload_files1 -width 20 -height 12 $just \ - -yscrollcommand ".dialog.l.paneleft.yscroll set" -selectmode browse \ - -xscrollcommand ".dialog.l.paneleft.xscroll set" -exportselection 0}] - myload_set_colors1 - scrollbar .dialog.l.paneleft.yscroll -command ".dialog.l.paneleft.list yview" - scrollbar .dialog.l.paneleft.xscroll -command ".dialog.l.paneleft.list xview" -orient horiz - pack .dialog.l.paneleft.yscroll -side right -fill y - pack .dialog.l.paneleft.xscroll -side bottom -fill x - pack .dialog.l.paneleft.list -fill both -expand true - bind .dialog.l.paneleft.list <> { - # bind .dialog.l.paneright.pre {} - # .dialog.l.paneright.pre configure -background white - set myload_sel [.dialog.l.paneleft.list curselection] - if { $myload_sel ne {} } { - set myload_dir1 [abs_sym_path [.dialog.l.paneleft.list get $myload_sel]] - set myload_index1 $myload_sel - setglob $myload_dir1 - myload_set_colors2 - } - } - - frame .dialog.l.paneright - frame .dialog.l.paneright.pre -background white -width 200 -height 200 - listbox .dialog.l.paneright.list -listvariable myload_files2 -width 20 -height 12\ - -yscrollcommand ".dialog.l.paneright.yscroll set" -selectmode browswe \ - -xscrollcommand ".dialog.l.paneright.xscroll set" -exportselection 0 - scrollbar .dialog.l.paneright.yscroll -command ".dialog.l.paneright.list yview" - scrollbar .dialog.l.paneright.xscroll -command ".dialog.l.paneright.list xview" -orient horiz - pack .dialog.l.paneright.pre -side bottom -anchor s -fill x - pack .dialog.l.paneright.yscroll -side right -fill y - pack .dialog.l.paneright.xscroll -side bottom -fill x - pack .dialog.l.paneright.list -side bottom -fill both -expand true - - .dialog.l add .dialog.l.paneleft -minsize 40 - .dialog.l add .dialog.l.paneright -minsize 40 - # .dialog.l paneconfigure .dialog.l.paneleft -stretch always - # .dialog.l paneconfigure .dialog.l.paneright -stretch always - frame .dialog.buttons - frame .dialog.buttons_bot - button .dialog.buttons_bot.ok -width 5 -text OK \ - -command { set myload_retval [.dialog.buttons_bot.entry get]; destroy .dialog} - button .dialog.buttons_bot.cancel -width 5 -text Cancel -command {set myload_retval {}; destroy .dialog} - button .dialog.buttons.home -width 5 -text {Home} -command { - bind .dialog.l.paneright.pre {} - .dialog.l.paneright.pre configure -background white - set myload_files1 $pathlist - update - myload_set_colors1 - .dialog.l.paneleft.list xview moveto 1 - set myload_index1 0 - set myload_dir1 [abs_sym_path [.dialog.l.paneleft.list get $myload_index1]] - setglob $myload_dir1 - myload_set_colors2 - .dialog.l.paneleft.list selection clear 0 end - .dialog.l.paneright.list selection clear 0 end - .dialog.l.paneleft.list selection set $myload_index1 - } - label .dialog.buttons_bot.label -text {File:} - entry .dialog.buttons_bot.entry - if { $initialfile ne {} } { - .dialog.buttons_bot.entry insert 0 $initialfile - } - radiobutton .dialog.buttons_bot.all -text All -variable globfilter -value {*} \ - -command { setglob $myload_dir1 } - radiobutton .dialog.buttons_bot.sym -text .sym -variable globfilter -value {*.sym} \ - -command { setglob $myload_dir1 } - radiobutton .dialog.buttons_bot.sch -text .sch -variable globfilter -value {*.sch} \ - -command { setglob $myload_dir1 } - button .dialog.buttons.up -width 5 -text Up -command { - bind .dialog.l.paneright.pre {} - .dialog.l.paneright.pre configure -background white - set d [file dirname $myload_dir1] - if { [file isdirectory $d]} { - myload_set_home $d - setglob $d - myload_set_colors2 - set myload_dir1 $d - } - } - label .dialog.buttons.mkdirlab -text { New dir: } - entry .dialog.buttons.newdir -width 16 - button .dialog.buttons.mkdir -width 5 -text Create -command { - load_file_dialog_mkdir [.dialog.buttons.newdir get] - } - button .dialog.buttons.rmdir -width 5 -text Delete -command { - if { [.dialog.buttons.newdir get] ne {} } { - file delete "${myload_dir1}/[.dialog.buttons.newdir get]" - setglob ${myload_dir1} - myload_set_colors2 - } - } - button .dialog.buttons.pwd -text {Current file dir} -command { - bind .dialog.l.paneright.pre {} - .dialog.l.paneright.pre configure -background white - set d [xschem get current_dirname] - if { [file isdirectory $d]} { - myload_set_home $d - setglob $d - myload_set_colors2 - set myload_dir1 $d - } - } - pack .dialog.buttons.home .dialog.buttons.up .dialog.buttons.pwd -side left - pack .dialog.buttons.mkdirlab -side left - pack .dialog.buttons.newdir -expand true -fill x -side left - pack .dialog.buttons.rmdir .dialog.buttons.mkdir -side right - pack .dialog.buttons_bot.ok .dialog.buttons_bot.cancel .dialog.buttons_bot.label -side left - pack .dialog.buttons_bot.entry -side left -fill x -expand true - pack .dialog.buttons_bot.all .dialog.buttons_bot.sym .dialog.buttons_bot.sch -side left - pack .dialog.l -expand true -fill both - pack .dialog.buttons -side top -fill x - pack .dialog.buttons_bot -side top -fill x - if { [info exists myload_default_geometry]} { - wm geometry .dialog "${myload_default_geometry}" - } - myload_set_home $initdir - bind .dialog { - set myload_retval [.dialog.buttons_bot.entry get] - if {$myload_retval ne {} } { - destroy .dialog - } - } - bind .dialog.l.paneright.list { - set myload_retval [.dialog.buttons_bot.entry get] - if {$myload_retval ne {} && ![file isdirectory "$myload_dir1/[.dialog.l.paneright.list get $myload_sel]"]} { - bind .dialog.l.paneright.pre {} - destroy .dialog - } - } - bind .dialog { set myload_retval {}; destroy .dialog} - - ### update - if { [ info exists myload_sash_pos] } { - eval .dialog.l sash mark 0 [.dialog.l sash coord 0] - eval .dialog.l sash dragto 0 [subst $myload_sash_pos] - } - ### update - .dialog.l.paneleft.list xview moveto 1 - bind .dialog { - set myload_sash_pos [.dialog.l sash coord 0] - set myload_default_geometry [wm geometry .dialog] - .dialog.l.paneleft.list xview moveto 1 - # regsub {\+.*} $myload_default_geometry {} myload_default_geometry - } - - bind .dialog.l.paneright.yscroll { - set myload_yview [.dialog.l.paneright.list yview] - } - - xschem preview_window create .dialog.l.paneright.pre {} - set myload_dir1 [abs_sym_path [.dialog.l.paneleft.list get $myload_index1]] - setglob $myload_dir1 - myload_set_colors2 - - bind .dialog.l.paneright.list { - set myload_yview [.dialog.l.paneright.list yview] - } - bind .dialog.l.paneright.list <> { - set myload_yview [.dialog.l.paneright.list yview] - set myload_sel [.dialog.l.paneright.list curselection] - if { $myload_sel ne {} } { - set myload_dir1 [abs_sym_path [.dialog.l.paneleft.list get $myload_index1]] - set myload_dir2 [.dialog.l.paneright.list get $myload_sel] - if {$myload_dir2 eq {..}} { - set myload_d [file dirname $myload_dir1] - } elseif { $myload_dir2 eq {.} } { - set myload_d $myload_dir1 - } else { - if {$::OS == "Windows"} { - if {[regexp {^[A-Za-z]\:/$} $myload_dir1]} { - set myload_d "$myload_dir1$myload_dir2" - } else { - set myload_d "$myload_dir1/$myload_dir2" - } - } else { - if {$myload_dir1 eq "/"} { - set myload_d "$myload_dir1$myload_dir2" - } else { - set myload_d "$myload_dir1/$myload_dir2" - } - } - } - if { [file isdirectory $myload_d]} { - bind .dialog.l.paneright.pre {} - .dialog.l.paneright.pre configure -background white - myload_set_home $myload_d - setglob $myload_d - myload_set_colors2 - set myload_dir1 $myload_d - # .dialog.buttons_bot.entry delete 0 end - } else { - .dialog.buttons_bot.entry delete 0 end - .dialog.buttons_bot.entry insert 0 $myload_dir2 - set t [is_xschem_file $myload_dir1/$myload_dir2] - if { $t ne {0} } { - ### update - if { [winfo exists .dialog] } { - .dialog.l.paneright.pre configure -background {} - xschem preview_window draw .dialog.l.paneright.pre "$myload_dir1/$myload_dir2" - bind .dialog.l.paneright.pre { - xschem preview_window draw .dialog.l.paneright.pre "$myload_dir1/$myload_dir2" - } - } - } else { - bind .dialog.l.paneright.pre {} - .dialog.l.paneright.pre configure -background white - } - # puts "xschem preview_window draw .dialog.l.paneright.pre \"$myload_dir1/$myload_dir2\"" - } - } - } - if { [ info exists myload_yview]} { - .dialog.l.paneright.list yview moveto [lindex $myload_yview 0] - } - tkwait window .dialog - xschem preview_window destroy {} {} - set initdir "$myload_dir1" - if { $myload_retval ne {}} { - if {![file exists "$myload_dir1/$myload_retval"] } { - return "$myload_dir1/$myload_retval" - } - if { $loadfile == 0 } { - if {[file exists "$myload_dir1/$myload_retval"]} { - if {$confirm_overwrt == 1 } { - set answer [tk_messageBox -message "Overwrite $myload_dir1/${myload_retval}?" \ - -icon warning -parent . -type okcancel] - } else { - set answer ok - } - if {$answer eq {ok}} { - return "$myload_dir1/$myload_retval" - } else { - return {} - } - } - } - set t [is_xschem_file "$myload_dir1/$myload_retval"] - if { $t eq {0} } { - set answer [ - tk_messageBox -message "$myload_dir1/$myload_retval does not seem to be an xschem file...\nContinue?" \ - -icon warning -parent . -type yesno] - if { $answer eq "no"} { - set myload_retval {} - return {} - } else { - return "$myload_dir1/$myload_retval" - } - } elseif { $t ne {SYMBOL} && ($ext eq {.sym}) } { - set answer [ - tk_messageBox -message "$myload_dir1/$myload_retval does not seem to be a SYMBOL file...\nContinue?" \ - -icon warning -parent . -type yesno] - if { $answer eq "no"} { - set myload_retval {} - return {} - } else { - return "$myload_dir1/$myload_retval" - } - } else { - return "$myload_dir1/$myload_retval" - } - } else { - return {} - } -} - -# get last n path components: example , n=1 --> /aaa/bbb/ccc/ddd.sch -> ccc/ddd.sch -proc get_cell {s n } { - set slist [file split $s] - set l [llength $slist] - if { $n >= $l } {set n [expr {$l - 1}]} - set p {} - for {set i [expr {$l-1-$n}]} {$i < $l} { incr i } { - append p [lindex $slist $i] - if {$i < $l - 1} { - append p {/} - } - } - return $p -} - -# chop last n path components from s -proc path_head {s n } { - set slist [file split $s] - set l [llength $slist] - if { $n < 0 } { set n 0 } - set p {} - for {set i 0} {$i < [expr {$l - $n}]} { incr i } { - append p [lindex $slist $i] - if {$i < $l -$n- 1 && ([lindex $slist $i] ne {/})} { - append p {/} - } - } - return $p -} - - -proc delete_files { dir } { - if { [ info tclversion] >=8.4} { - set x [tk_getOpenFile -title "DELETE FILES" -multiple 1 -initialdir [file dirname $dir] ] - } else { - set x [tk_getOpenFile -title "DELETE FILES" -initialdir [file dirname $dir] ] - } - foreach i $x { - file delete $i - } -} - -proc create_pins {} { - global env retval USER_CONF_DIR - global filetmp - - set retval [ read_data_nonewline $filetmp ] - regsub -all {<} $retval {[} retval - regsub -all {>} $retval {]} retval - set lines [split $retval \n] - if { [file exists [abs_sym_path devices/ipin.sym]] } { - set indirect 1 - } else { - set indirect 0 - } - # viewdata $retval - set pcnt 0 - set y 0 - set fd [open $USER_CONF_DIR/.clipboard.sch "w"] - foreach i $lines { - if {$indirect} { - puts $fd "C \{[rel_sym_path devices/[lindex $i 1].sym]\} 0 [set y [expr $y-20]] \ - 0 0 \{ name=p[incr pcnt] lab=[lindex $i 0] \}" - } else { - puts $fd "C \{[rel_sym_path [lindex $i 1].sym]\} 0 [set y [expr $y-20]] \ - 0 0 \{ name=p[incr pcnt] lab=[lindex $i 0] \}" - } - } - close $fd - xschem merge $USER_CONF_DIR/.clipboard.sch -} - -proc rectorder {x1 y1 x2 y2} { - if {$x2 < $x1} {set tmp $x1; set x1 $x2; set x2 $tmp} - if {$y2 < $y1} {set tmp $y1; set y1 $y2; set y2 $tmp} - return [list $x1 $y1 $x2 $y2] -} - -proc order {x1 y1 x2 y2} { - if {$x2 < $x1} {set tmp $x1; set x1 $x2; set x2 $tmp; set tmp $y1; set y1 $y2; set y2 $tmp - } elseif {$x2==$x1 && $y2<$y1} {set tmp $y1; set y1 $y2; set y2 $tmp} - return [list $x1 $y1 $x2 $y2] -} - -proc rotation {x0 y0 x y rot flip} { - set tmp [expr {$flip? 2*$x0-$x : $x}] - if {$rot==0} {set rx $tmp; set ry $y } - if {$rot==1} {set rx [expr {$x0 - $y +$y0}]; set ry [expr {$y0+$tmp-$x0}]} - if {$rot==2} {set rx [expr {2*$x0-$tmp}]; set ry [expr {2*$y0-$y}]} - if {$rot==3} {set rx [expr {$x0+$y-$y0}]; set ry [expr {$y0-$tmp+$x0}]} - return [list $rx $ry] -} - -proc schpins_to_sympins {} { - global env USER_CONF_DIR - set pinhsize 2.5 - set first 1 - xschem copy - set clipboard [read_data_nonewline $USER_CONF_DIR/.clipboard.sch] - set lines [split $clipboard \n] - set fd [open $USER_CONF_DIR/.clipboard.sch "w"] - foreach i $lines { - set ii [split [regexp -all -inline {\S+} $i]] - if {[regexp {^C \{.*(i|o|io)pin} $i ]} { - if {[regexp {ipin} [lindex $ii 1]]} { set dir in } - if {[regexp {opin} [lindex $ii 1]]} { set dir out } - if {[regexp {iopin} [lindex $ii 1]]} { set dir inout } - set rot [lindex $ii 4] - set flip [lindex $ii 5] - while {1} { - if { [regexp {lab=} $i] } { - regsub {^.*lab=} $i {} lab - regsub {[\} ].*} $lab {} lab - } - if { [regexp {\}} $i]} { break} - } - set x0 [lindex $ii 2] - set y0 [lindex $ii 3] - if {$first} { - puts $fd "G { $x0 $y0 } " - set first 0 - } - set pinx1 [expr {$x0-$pinhsize}] - set pinx2 [expr {$x0+$pinhsize}] - set piny1 [expr {$y0-$pinhsize}] - set piny2 [expr {$y0+$pinhsize}] - if {![string compare $dir "out"] || ![string compare $dir "inout"] } { - set linex1 [expr {$x0-20}] - set liney1 $y0 - set linex2 $x0 - set liney2 $y0 - set textx0 [expr {$x0-25}] - set texty0 [expr {$y0-4}] - set textflip [expr {!$flip}] - } else { - set linex1 [expr {$x0+20}] - set liney1 $y0 - set linex2 $x0 - set liney2 $y0 - set textx0 [expr {$x0+25}] - set texty0 [expr {$y0-4}] - set textflip [expr {$flip}] - } - lassign [rotation $x0 $y0 $linex1 $liney1 $rot $flip] linex1 liney1 - lassign [rotation $x0 $y0 $linex2 $liney2 $rot $flip] linex2 liney2 - lassign [order $linex1 $liney1 $linex2 $liney2] linex1 liney1 linex2 liney2 - lassign [rotation $x0 $y0 $textx0 $texty0 $rot $flip] textx0 texty0 - puts $fd "B 5 $pinx1 $piny1 $pinx2 $piny2 \{name=$lab dir=$dir\}" - puts $fd "L 4 $linex1 $liney1 $linex2 $liney2 \{\}" - puts $fd "T \{$lab\} $textx0 $texty0 $rot $textflip 0.2 0.2 \{\}" - } - } - close $fd - xschem paste -} - - -proc add_lab_no_prefix {} { - global env retval USER_CONF_DIR - global filetmp - - if { [file exists [abs_sym_path devices/ipin.sym]] } { - set indirect 1 - } else { - set indirect 0 - } - set retval [ read_data_nonewline $filetmp ] - regsub -all {<} $retval {[} retval - regsub -all {>} $retval {]} retval - set lines [split $retval \n] - # viewdata $retval - set pcnt 0 - set y 0 - set fd [open $USER_CONF_DIR/.clipboard.sch "w"] - foreach i $lines { - if {$indirect} { - puts $fd "C \{devices/lab_pin.sym\} 0 [set y [expr {$y+20}]] \ - 0 0 \{ name=p[incr pcnt] verilog_type=wire lab=[lindex $i 0] \}" - } else { - puts $fd "C \{lab_pin.sym\} 0 [set y [expr {$y+20}]] \ - 0 0 \{ name=p[incr pcnt] verilog_type=wire lab=[lindex $i 0] \}" - } - } - close $fd - xschem merge $USER_CONF_DIR/.clipboard.sch -} - -proc add_lab_prefix {} { - global env retval USER_CONF_DIR - global filetmp - - if { [file exists [abs_sym_path devices/ipin.sym]] } { - set indirect 1 - } else { - set indirect 0 - } - set retval [ read_data_nonewline $filetmp ] - regsub -all {<} $retval {[} retval - regsub -all {>} $retval {]} retval - set lines [split $retval \n] - # viewdata $retval - set pcnt 0 - set y 0 - set fd [open $USER_CONF_DIR/.clipboard.sch "w"] - foreach i $lines { - if {$indirect} { - puts $fd "C \{devices/lab_pin.sym\} 0 [set y [expr {$y+20}]] \ - 0 0 \{ name=p[incr pcnt] verilog_type=reg lab=i[lindex $i 0] \}" - } else { - puts $fd "C \{lab_pin.sym\} 0 [set y [expr {$y+20}]] \ - 0 0 \{ name=p[incr pcnt] verilog_type=reg lab=i[lindex $i 0] \}" - } - } - close $fd - xschem merge $USER_CONF_DIR/.clipboard.sch -} - -proc make_symbol {name} { - global XSCHEM_SHAREDIR symbol_width - set name [abs_sym_path $name ] - # puts "make_symbol{}, executing: ${XSCHEM_SHAREDIR}/make_sym.awk $symbol_width ${name}" - eval exec {awk -f ${XSCHEM_SHAREDIR}/make_sym.awk $symbol_width $name} - return {} -} - -# create simulation dir 'simulation/' under current schematic directory -proc simuldir {} { - global netlist_dir local_netlist_dir - if { $local_netlist_dir == 1 } { - set simdir [xschem get current_dirname]/simulation - file mkdir $simdir - set netlist_dir $simdir - xschem set_netlist_dir $netlist_dir - return $netlist_dir - } - return {} -} - -# -# force==0: force creation of $netlist_dir (if not empty) -# if netlist_dir empty and no dir given prompt user -# else set netlist_dir to dir -# -# force==1: if no dir given prompt user -# else set netlist_dir to dir -# -proc select_netlist_dir { force {dir {} }} { - global netlist_dir env - - if { ( $force == 0 ) && ( $netlist_dir ne {} ) } { - if {![file exist $netlist_dir]} { - file mkdir $netlist_dir - } - regsub {^~/} $netlist_dir ${env(HOME)}/ netlist_dir - xschem set_netlist_dir $netlist_dir - return $netlist_dir - } - if { $dir eq {} } { - if { $netlist_dir ne {} } { - set initdir $netlist_dir - } else { - if {$::OS == "Windows"} { - set initdir $env(windir) - } else { - set initdir [pwd] - } - } - # 20140409 do not change netlist_dir if user Cancels action - set new_dir [tk_chooseDirectory -initialdir $initdir -parent . -title {Select netlist DIR} -mustexist false] - } else { - set new_dir $dir - } - - if {$new_dir ne {} } { - if {![file exist $new_dir]} { - file mkdir $new_dir - } - set netlist_dir $new_dir - } - regsub {^~/} $netlist_dir ${env(HOME)}/ netlist_dir - xschem set_netlist_dir $netlist_dir - return $netlist_dir -} - - -proc enter_text {textlabel {preserve_disabled disabled}} { - global retval rcode has_cairo preserve_unchanged_attrs - set rcode {} - toplevel .dialog -class Dialog - wm title .dialog {Enter text} - - set X [expr {[winfo pointerx .dialog] - 30}] - set Y [expr {[winfo pointery .dialog] - 25}] - - # 20100203 - if { $::wm_fix } { tkwait visibility .dialog } - wm geometry .dialog "+$X+$Y" - frame .dialog.f1 - label .dialog.f1.txtlab -text $textlabel - text .dialog.txt -width 100 -height 12 - .dialog.txt delete 1.0 end - .dialog.txt insert 1.0 $retval - checkbutton .dialog.f1.l1 -text "preserve unchanged props" -variable preserve_unchanged_attrs \ - -state $preserve_disabled - pack .dialog.f1 -side top -fill x ;# -expand yes - pack .dialog.f1.l1 -side left - pack .dialog.f1.txtlab -side left -expand yes -fill x - - pack .dialog.txt -side top -fill both -expand yes - frame .dialog.edit - frame .dialog.edit.lab - frame .dialog.edit.entries - pack .dialog.edit.lab -side left - pack .dialog.edit.entries -side left -fill x -expand yes - pack .dialog.edit -side top -fill x - if {$has_cairo } { - entry .dialog.edit.entries.hsize -relief sunken -textvariable vsize -width 20 - } else { - entry .dialog.edit.entries.hsize -relief sunken -textvariable hsize -width 20 - } - entry .dialog.edit.entries.vsize -relief sunken -textvariable vsize -width 20 - entry .dialog.edit.entries.props -relief sunken -textvariable props -width 20 - pack .dialog.edit.entries.hsize .dialog.edit.entries.vsize \ - .dialog.edit.entries.props -side top -fill x -expand yes - label .dialog.edit.lab.hlab -text "hsize:" - label .dialog.edit.lab.vlab -text "vsize:" - label .dialog.edit.lab.proplab -text "props:" - pack .dialog.edit.lab.hlab .dialog.edit.lab.vlab \ - .dialog.edit.lab.proplab -side top - frame .dialog.buttons - button .dialog.buttons.ok -text "OK" -command \ - { - set retval [.dialog.txt get 1.0 {end - 1 chars}] - if {$has_cairo} { - set hsize $vsize - } - set rcode {ok} - destroy .dialog - } - button .dialog.buttons.cancel -text "Cancel" -command \ - { - set retval {} - set rcode {} - destroy .dialog - } - button .dialog.buttons.b3 -text "Load" -command \ - { - global INITIALTEXTDIR - if { ![info exists INITIALTEXTDIR] } { set INITIALTEXTDIR [xschem get current_dirname] } - set a [tk_getOpenFile -parent .dialog -initialdir $INITIALTEXTDIR ] - if [string compare $a ""] { - set INITIALTEXTDIR [file dirname $a] - read_data_window .dialog.txt $a - } - } - button .dialog.buttons.b4 -text "Del" -command \ - { - .dialog.txt delete 1.0 end - } - pack .dialog.buttons.ok -side left -fill x -expand yes - pack .dialog.buttons.cancel -side left -fill x -expand yes - pack .dialog.buttons.b3 -side left -fill x -expand yes - pack .dialog.buttons.b4 -side left -fill x -expand yes - pack .dialog.buttons -side bottom -fill x - bind .dialog { - if ![string compare $retval [.dialog.txt get 1.0 {end - 1 chars}]] { - .dialog.buttons.cancel invoke - } - } - bind .dialog {.dialog.buttons.ok invoke} - #grab set .dialog - tkwait window .dialog - return $retval -} - -# evaluate a tcl command from GUI -proc tclcmd {} { - global tclcmd_txt - catch {destroy .tclcmd} - toplevel .tclcmd -class dialog - label .tclcmd.txtlab -text {Enter TCL expression:} - label .tclcmd.result -text {Result:} - text .tclcmd.t -width 100 -height 8 - text .tclcmd.r -width 100 -height 6 -yscrollcommand ".tclcmd.yscroll set" - scrollbar .tclcmd.yscroll -command ".tclcmd.r yview" - .tclcmd.t insert 1.0 $tclcmd_txt - - frame .tclcmd.b - button .tclcmd.b.close -text Close -command { - set tclcmd_txt [.tclcmd.t get 1.0 end] - destroy .tclcmd - } - button .tclcmd.b.ok -text Evaluate -command { - set tclcmd_txt [.tclcmd.t get 1.0 end] - set res [eval $tclcmd_txt] - .tclcmd.r delete 1.0 end - .tclcmd.r insert 1.0 $res - } - pack .tclcmd.txtlab -side top -fill x - pack .tclcmd.t -side top -fill both -expand yes - pack .tclcmd.result -side top -fill x - pack .tclcmd.b -side bottom -fill x - pack .tclcmd.yscroll -side right -fill y - pack .tclcmd.r -side top -fill both -expand yes - pack .tclcmd.b.ok -side left -expand yes -fill x - pack .tclcmd.b.close -side left -expand yes -fill x -} - -proc select_layers {} { - global dark_colorscheme colors enable_layer - toplevel .sl -class dialog - if { $dark_colorscheme == 1 } { - set txt_color black - } else { - set txt_color white - } - set j 0 - set f 0 - frame .sl.f0 - frame .sl.f1 - pack .sl.f0 .sl.f1 -side top -fill x - button .sl.f1.ok -text OK -command { destroy .sl} - pack .sl.f1.ok -side left -expand yes -fill x - frame .sl.f0.f$f - pack .sl.f0.f$f -side left -fill y - foreach i $colors { - if { $dark_colorscheme == 1 } { - set ind_bg white - } else { - set ind_bg black - } - if { $j == [xschem get pinlayer] } { - set laylab [format %2d $j]-PIN - set layfg $txt_color - } elseif { $j == [xschem get wirelayer] } { - set laylab [format %2d $j]-WIRE - set layfg $txt_color - } elseif { $j == [xschem get textlayer] } { - set laylab [format %2d $j]-TEXT - set layfg $txt_color - } elseif { $j == [xschem get backlayer] } { - set laylab [format %2d $j]-BG - if { $dark_colorscheme == 1 } { - set layfg white - set ind_bg black - } else { - set layfg black - set ind_bg white - } - } elseif { $j == [xschem get gridlayer] } { - set laylab [format %2d $j]-GRID - set layfg $txt_color - } else { - set laylab "[format %2d $j] " - set layfg $txt_color - } - - checkbutton .sl.f0.f$f.cb$j -text $laylab -variable enable_layer($j) -activeforeground $layfg \ - -selectcolor $ind_bg -anchor w -foreground $layfg -background $i -activebackground $i \ - -command { - xschem enable_layers - } - pack .sl.f0.f$f.cb$j -side top -fill x - incr j - if { [expr {$j%10}] == 0 } { - incr f - frame .sl.f0.f$f - pack .sl.f0.f$f -side left -fill y - } - } - tkwait window .sl -} - -proc color_dim {} { - toplevel .dim -class dialog - wm title .dim {Dim colors} - checkbutton .dim.bg -text {Dim background} -variable dim_background - scale .dim.scale -digits 2 -label {Dim factor} -length 256 \ - -showvalue 1 -command {xschem color_dim} -orient horizontal \ - -from -5 -to 5 -resolution 0.1 - button .dim.ok -text OK -command {destroy .dim} - .dim.scale set [xschem get dim] - pack .dim.scale - pack .dim.bg -side left - pack .dim.ok -side right -anchor e -} -proc about {} { - if [winfo exists .about] { - bind .about.link {} - bind .about.link2 {} - destroy .about - } - toplevel .about -class dialog - wm title .about {About XSCHEM} - label .about.xschem -text "[xschem get version]" -font {Sans 24 bold} - label .about.descr -text "Schematic editor / netlister for VHDL, Verilog, SPICE, tEDAx" - button .about.link -text {http://repo.hu/projects/xschem} -font Underline-Font -fg blue -relief flat - button .about.link2 -text {https://github.com/StefanSchippers/xschem} -font Underline-Font -fg blue -relief flat - button .about.link3 -text {Online XSCHEM Manual} -font Underline-Font -fg blue -relief flat - label .about.copyright -text "\n Copyright 1998-2020 Stefan Schippers (stefan.schippers@gmail.com) \n - This is free software; see the source for copying conditions. There is NO warranty; - not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE\n" - button .about.close -text Close -command {destroy .about} -font {Sans 18} - pack .about.xschem - pack .about.link - pack .about.link2 - pack .about.link3 - pack .about.descr - pack .about.copyright - pack .about.close - bind .about.link { execute 0 xdg-open http://repo.hu/projects/xschem} - bind .about.link2 { execute 0 xdg-open https://github.com/StefanSchippers/xschem} - bind .about.link3 { execute 0 xdg-open http://repo.hu/projects/xschem/index.html} -} - -proc property_search {} { - global search_value search_found - global search_exact - global search_select - global custom_token - - set search_found 0 - while { !$search_found} { - if { [winfo exists .dialog] } return - toplevel .dialog -class Dialog - wm title .dialog {Search} - if { ![info exists X] } { - set X [expr {[winfo pointerx .dialog] - 60}] - set Y [expr {[winfo pointery .dialog] - 35}] - } - wm geometry .dialog "+$X+$Y" - frame .dialog.custom - label .dialog.custom.l -text "Token" - entry .dialog.custom.e -width 32 - .dialog.custom.e insert 0 $custom_token - pack .dialog.custom.e .dialog.custom.l -side right - frame .dialog.val - label .dialog.val.l -text "Value" - entry .dialog.val.e -width 32 - .dialog.val.e insert 0 $search_value - pack .dialog.val.e .dialog.val.l -side right - frame .dialog.but - button .dialog.but.ok -text OK -command { - set search_value [.dialog.val.e get] - set custom_token [.dialog.custom.e get] - if {$tcl_debug<=-1} { puts stderr "|$custom_token|" } - set token $custom_token - if { $search_exact==1 } { - set search_found [xschem searchmenu exact $search_select $token $search_value] - } else { - set search_found [xschem searchmenu regex $search_select $token $search_value] - } - destroy .dialog - } - button .dialog.but.cancel -text Cancel -command { set search_found 1; destroy .dialog } - - # Window doesn't support regular expression, has to be exact match for now - if {$::OS == "Windows"} { - set search_exact 1 - checkbutton .dialog.but.sub -text Exact_search -variable search_exact -state disable - } else { - checkbutton .dialog.but.sub -text Exact_search -variable search_exact - } - radiobutton .dialog.but.nosel -text {Highlight} -variable search_select -value 0 - radiobutton .dialog.but.sel -text {Select} -variable search_select -value 1 - # 20171211 added unselect - radiobutton .dialog.but.unsel -text {Unselect} -variable search_select -value -1 - pack .dialog.but.ok -anchor w -side left - pack .dialog.but.sub -side left - pack .dialog.but.nosel -side left - pack .dialog.but.sel -side left - pack .dialog.but.unsel -side left - pack .dialog.but.cancel -anchor e - pack .dialog.custom -anchor e - pack .dialog.val -anchor e - pack .dialog.but -expand yes -fill x - focus .dialog - bind .dialog {.dialog.but.cancel invoke} - bind .dialog {.dialog.but.ok invoke} - bind .dialog {.dialog.but.ok invoke} - grab set .dialog - tkwait window .dialog - } - return {} -} - -#20171029 -# allows to call TCL hooks from 'format' strings during netlisting -# example of symbol spice format definition: -# format="@name @pinlist @symname @tcleval(