/* Élaboration d'une netlist */
/* $VER: SaveNets 1.0 (© R.Florac, 14-07-98) */
/* Ne teste que les lignes horizontales ou verticales (pour les intersections) */

options results     /* indispensable pour récupérer le résultat des macros */

signal on error     /* pour l'interception des erreurs */
signal on syntax

/* Test des liaisons */
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
/* Tableaux de données:
equi: une donnée par élément, donne l'indice de l'équipotentielle à laquelle est liée une ligne
label: une donnée par équipotentielle, donne son nom */
equi.=-1
label.=""

'TITLE("Lecture des 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 do      /* signale les labels numériques existants */
		label.label="LABEL_DÉJÀ_UTILISÉ"
	    end
	end
    end
end

'TITLE("Analyse des liaisons...")'
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)'            /* Marquage du fil */
	    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("Analyse des jonctions...")'
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("Recherche des labels et des connecteurs...")'
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("Recherche des alimentations...")'
do i=1 to objets
    'FINDPART('i',"ALIMENTATION")'; 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("Test redondances...")'
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("Recherche des masses...")'
do i=1 to objets
    'FINDPART('i',"MASSE")'; 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("Établissement équipotentielles terminé"):SELECT("Choisissez une action"+CHR(10)+"Visualiser les équipotentielles"+CHR(10)+"Contrôler la netlist"+CHR(10)+"Sauver la netlist"+CHR(10)+"Abandonner ce 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("Vérification équipotentielles"):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("Équipotentielle 'label.i'"+CHR(10)+"Abandonner"+CHR(10)+"Continuer"+CHR(10)+"Sauver netlist"+CHR(10)+"Contrôler 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("Contrôle 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)+"Continuer"+CHR(10)+"Abandonner")'
		if result~=1 then return
	    end
	    if i=objets then leave
	    i=i+1
	end
    end
    'TITLE("")'
return

sauver_netlist:
    'TITLE(""):REQFILE("Fichier netlist à créer","Spice")'
    fichier=result
    if fichier="" then return
    'TITLE("Sauvegarde netlist...")'
    if ~open(file, fichier, 'W') then return
    'FILEPART("")'
    writeln(file,result)
    'DATE(1)+" à "+TIME(1)'
    writeln(file,"* Créé par AmiCAD, le "||result||" *")
    do i=1 to objets
	'O=FINDOBJ('i',1,-1,-1)'; i=result
	if result>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
		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 d''analyse à effectuer"+CHR(10)+"AC"+CHR(10)+"DC"+CHR(10)+"Transient")'
	select
	    when result=1 then do
		'SELECT("Type de variation"+CHR(10)+"Décade"+CHR(10)+"Octave"+CHR(10)+"Linéaire")'
		select
		    when result=1 then do
			f="DEC "; v="par décade"
		    end
		    when result=2 then do
			f="OCT "; v="par octave"
		    end
		    when result=3 then do
			f="LIN "; v="de test"
		    end
		    otherwise do
			close(file)
			return
		    end
		end
		'ASK("Nombre de points 'v'?")'
		f=f||result
		'ASK("Quelle est la fréquence de début?")'
		f=f||" "||result
		'ASK("Quelle est la fréquence de fin?")'
		analyse="AC "||f||' '||result
	    end
	    when result=2 then do
		'ASK("Quel est le nom du générateur à faire varier.")'
		f=result
		'ASK("Quelle est la valeur de départ?")'
		f=f||' '||result
		'ASK("Quelle est la valeur finale.")'
		f=f||' '||result
		'ASK("Quel est l''incrément?")'
		analyse="DC "||f||' '||result
	    end
	    when result=3 then do
		'ASK("Temps de simulation?")'; temps=result
		'ASK("Pas de simulation?")'; pas=result
		'ASK("Temps de début de la 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("Sauvegarde terminée")'
    '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     /* Il y a t'il une ligne qui part de la broche? */
    if xl>0 then return xl
    'FINDLINE(1,'xj','yj')'; xl=result      /* Il y a peut être une ligne qui passe sur la broche... */
    if xl<=0 then return 0
    'FINDOBJ(1,7,'xj','yj')'                /* Il doit alors y avoir une jonction */
    if result>0 then return xl
    return 0

/* Traitement des erreurs, interruption du programme */
syntax:
erreur=RC
'MESSAGE("Script SaveNets.AmiCAD"+CHR(10)+"Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
exit

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