/* $VER: SaveNets 1.00e (© R.Florac, 09-08-98) */

options results

signal on error
signal on syntax

j=1; nets=1;
'DEF NEXTJUNCTION(O)=OO=O:WHILE(IF(OO>0,TYPE(OO)<>7,0),IF(OO<OBJECTS(-1),OO=OO+1,OO=0)):OO'
'UNMARK(-1):LOCK(-1):OBJECTS(-1)'; objets=result

equi.=-1
label.=""

'TITLE("Reading labels...")'
do i=1 to objets
    'TYPE(O='i')'
    if result=4 | result=12 | result=11 then do
	'ABS(FINDLINE(1,COL(O),LINE(O)))'; j=result
	if j>0 then do
	    'READTEXT(O)'; label=result
	    if datatype(label,"w") then label.label="LABEL_DÉJÀ_UTILISÉ"
	end
    end
end

'TITLE("Testing nets...")'
i=1
do while i>0
    'OO=FINDOBJ('i',2,-1,-1)'; i=result
    if result>0 then do
	'TEST(OO)'
	if result=0 then do
	    do while label.nets~=""
		nets=nets+1
	    end
	    label.nets=nets
	    equi.i=nets
	    'COORDS(OO)'
	    parse var result x0','y0','x1','y1
	    call test_ligne(x0,y0,nets,objets)
	    call test_ligne(x1,y1,nets,objets)
	end
	if i=objets then i=0
	else i=i+1
    end
end

'TITLE("Testing junctions...")'
i=1
do while i>0
    'I=FINDOBJ('i',7,-1,-1)'; i=result
    if i>0 then do
	'MARK(I):L1=ABS(FINDLINE(1,COL(I),LINE(I)))'; l1=result
	if l1>0 & l1<objets then do
	    j=l1+1
	    do while j>0
		'J=ABS(FINDLINE('j',COL(I),LINE(I)))'; j=result
		if j>0 then do
		    if equi.j~=equi.l1 then do
			call changer_labels(l1,j)
		    end
		    if j=objets then j=0
		    else j=j+1
		end
	    end
	end
	if i=objets then i=0
	else i=i+1
    end
end

'TITLE("Looking for labels and connectors...")'
do i=1 to objets
    'TYPE(O='i')'
    if result=4 | result=12 | result=11 then do
	'ABS(FINDLINE(1,COL(O),LINE(O)))'; j=result
	if j>0 then do
	    net=equi.j
	    'READTEXT(O)'; label=result
	    label.net=label
	end
    end
end

'TITLE("Looking for powers...")'
do i=1 to objets
    'FINDPART('i',"POWER SUPPLY")'; i=result
    if i>0 then do
	j=connexion_broche(i,1)
	if j>0 then do
	    net=equi.j
	    'READTEXT(GETVAL('i'))'; label=result
	    label.net=label
	end
    end
    else leave
end

'TITLE("Testing redundances...")'
do i=1 to nets
    do j=i+1 to nets
	if label.j~="" then do
	    if label.i=label.j then do
		do k=1 to objets
		    if equi.k=j then equi.k=i
		end
		label.j=""
	    end
	end
    end
end

'TITLE("Looking for grounds...")'
do i=1 to objets
    'FINDPART('i',"GROUND")'; i=result
    if i>0 then do
	j=connexion_broche(i,1)
	if j>0 then do
	    equi.0=0; label.0=0
	    call changer_labels(0,j)
	end
    end
    else leave
end

do until c=0
    'TITLE("Setting netlist ended"):SELECT("Choose an action"+CHR(10)+"Look for nets"+CHR(10)+"Check netlist"+CHR(10)+"Save netlist"+CHR(10)+"Abort script")'
    select
	when result=1 then call visu_equi
	when result=2 then call controler_netlist
	when result=3 then call sauver_netlist
	otherwise c=0
    end
end
exit

visu_equi:
    'TITLE("Looking for nets"):UNMARK(-1)'
    do i=0 to nets
	if label.i ~= "LABEL_DÉJÀ_UTILISÉ" & label.i ~= "" then do
	    do j=1 to objets
		if equi.j=i then 'MARK('j')'
	    end
	    'SELECT("Net 'label.i'"+CHR(10)+"Abort"+CHR(10)+"Continue"+CHR(10)+"Save netlist"+CHR(10)+"Check netlist")'
	    if result <= 1 then return
	    if result = 3 then do
		call sauver_netlist
		exit
	    end
	    if result = 4 then do
		call controler_netlist
		leave
	    end
	    'UNMARK(-1)'
	end
    end
    return

test_ligne: procedure expose equi.
    parse arg x0,y0,n,nbo
    o=1
    do until o=0
	'X=FINDOBJ('o',2,'x0','y0')'; o=result
	if o>0 then do
	    'IF(TEST(X),"",MARK(X):COORDS(X))'
	    if result~="" then do
		parse var result x1','y1','x2','y2
		equi.o=n
		if x0=x1 & y0=y1 then call test_ligne(x2,y2,n,nbo)
		else call test_ligne(x1,y1,n,nbo)
	    end
	    if o=nbo then o=0
	    else o=o+1
	end
    end
    return

changer_labels: procedure expose equi. objets label.
    parse arg o1,o2
    if datatype(equi.o2,'w') then do
	e=equi.o2
	label.e=""
	do i=1 to objets
	    if equi.i=e then equi.i=equi.o1
	end
	return o1
    end
    else do
	e=equi.o1
	label.e=""
	do i=1 to objets
	    if equi.i=e then equi.i=equi.o2
	end
	return o2
    end
    return

test_jonction: procedure expose equi.
    parse arg xj,yj,n,objets
    obj=1
    do while obj>0
	'X=ABS(FINDLINE('obj','xj','yj'))'; obj=result
	if obj>0 then do
	    if equi.obj=n then return 1
	    if obj=objets then return 0
	    obj=obj+1
	end
    end
    return 0

controler_netlist:
    'TITLE("Checking netlist...")'
    i=1
    do while i>0
	'O=FINDOBJ('i',1,-1,-1)'; i=result
	if i>0 then do
	    'PARTNAME(O)'
	    if result~="ALIMENTATION" & result ~="MASSE" then do
		'IF(GETREF(O),READTEXT(GETREF(O)),PARTNAME(O)+"?")'
		ligne=translate(result,"_"," ")||' '
		'DEVPINS(O)'; j=result
		do k=1 to j
		    l=connexion_broche(i,k)
		    if l>0 then do
			net=equi.l
			ligne=ligne||label.net||' '
		    end
		    else ligne=ligne||"-1"||' '
		end
		'IF(GETVAL(O),READTEXT(GETVAL(O)),PARTNAME(O))'
		ligne=ligne||result
		'UNMARK(-1):MARK(O):SELECT("'ligne'"+CHR(10)+"Continue"+CHR(10)+"Abort")'
		if result~=1 then return
	    end
	    if i=objets then leave
	    i=i+1
	end
    end
    'TITLE("")'
return

sauver_netlist:
    'TITLE(""):REQFILE("Netlist file to create","Spice")'
    fichier=result
    if fichier="" then return
    'TITLE("Saving netlist...")'
    if ~open(file, fichier, 'W') then return
    'FILEPART("")'
    writeln(file,result)
    'DATE(1)+" à "+TIME(1)'
    writeln(file,"* Created by AmiCAD, on "||result||" *")
    do i=1 to objets
	'O=FINDOBJ('i',1,-1,-1)'; i=result
	if result>0 then do
	    'PARTNAME(O)'
	    if result~="POWER SUPPLY" & result ~="GROUND" then do
		'IF(GETREF(O),READTEXT(GETREF(O)),PARTNAME(O)+"?")'
		ligne=translate(result,"_"," ")||' '
		'DEVPINS(O)'; j=result
		do k=1 to j
		    l=connexion_broche(i,k)
		    if l>0 then do
			net=equi.l
			ligne=ligne||label.net||' '
		    end
		    else ligne=ligne||"-1"||' '
		end
		'IF(GETVAL(O),READTEXT(GETVAL(O)),PARTNAME(O))'
		ligne=ligne||result
		call writeln(file, ligne)
	    end
	end
	else leave i
    end
    analyse=""
    do i=1 to objets
	'FINDOBJ('i',4,-1,-1)'; i=result
	if i>0 then do
	    'READTEXT('i')'; t=result
	    if left(t,10)=".ANALYSE: " then do
		analyse=right(t,length(t)-10)
	    end
	end
	else leave
    end
    if analyse="" then do
	'SELECT("Type of''analyse to do"+CHR(10)+"AC"+CHR(10)+"DC"+CHR(10)+"Transient")'
	select
	    when result=1 then do
		'SELECT("Type of variation"+CHR(10)+"Decade"+CHR(10)+"Octave"+CHR(10)+"Linear")'
		select
		    when result=1 then do
			f="DEC "; v="by decade"
		    end
		    when result=2 then do
			f="OCT "; v="by octave"
		    end
		    when result=3 then do
			f="LIN "; v="de test"
		    end
		    otherwise do
			close(file)
			return
		    end
		end
		'ASK("Number of points 'v'?")'
		f=f||result
		'ASK("What''s the begining frequency?")'
		f=f||" "||result
		'ASK("What''s the ending frequency?")'
		analyse="AC "||f||' '||result
	    end
	    when result=2 then do
		'ASK("What''s the source name to be swept?")'
		f=result
		'ASK("What''s the start value?")'
		f=f||' '||result
		'ASK("What''s the ending value?")'
		f=f||' '||result
		'ASK("What''s the increment value?")'
		analyse="DC "||f||' '||result
	    end
	    when result=3 then do
		'ASK("Time of simulation?")'; temps=result
		'ASK("Simulation step?")'; pas=result
		'ASK("Time to begin simulation?")'; d=result
		analyse="tran "||pas||" "||temps||" "||d
	    end
	    otherwise
		return
	end
    end
    if analyse~="" then writeln(file,"."||analyse)
    writeln(file,".END")
    close(file)
    'MESSAGE("Saving ended"):TITLE("")'
return

connexion_broche: procedure
    parse arg objet,broche
    'PINCOL(O='objet',B='broche')'; xj=result
    'PINLINE(O,B)'; yj=result
    'FINDOBJ(1,2,'xj','yj')'; xl=result
    if xl>0 then return xl
    'FINDLINE(1,'xj','yj')'; xl=result
    if xl<=0 then return 0
    'FINDOBJ(1,7,'xj','yj')'
    if result>0 then return xl
    return 0

syntax:
erreur=RC
'MESSAGE("Script SaveNets.AmiCAD:"+CHR(10)+"Syntax error"+CHR(10)+"in line 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
exit

error:
'MESSAGE("Script SaveNets.AmiCAD:"+CHR(10)+"Erreur in line 'SIGL'")'
exit