/* Sélection d'une netlist */
/* Version 1.00 (14-07-98) */
/* Version 1.01 (13/01/99)  Modif test clic liaison */
/* Version 1.02 (6/9/99)    Ajout UNLOCK */
/* Version 1.03 (14/04/00)  Adaptation version 2.05 */
/* Version 1.04 (11/11/00)  Localisation anglais/français */
/* Version 1.05 (06/12/00)  Ajout traitement masses et alimentations multiples */
/* $VER: SelectNat.AmiCAD 1.05 (© R.Florac, 06/12/2000) */
/* Ne recherche pas les labels multiples */
/* Ne teste que les lignes horizontales ou verticales */

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

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

'LANGUAGE'
if result="français.language" then fr=1
else fr=0

'FIRSTSEL'; i=result
if result~=0 then do
    'NEXTSEL(FIRSTSEL)'
    if result~=0 then i=0
end

if i=0 then do
    if fr=1 then 'PICKOBJ("Cliquez sur la liaison à tester")'
    else 'PICKOBJ("Click on a net")'
    i=result
end

if i<=0 then exit
'OBJECTS'
objets=result
'LOCK:TYPE(O='i')'
if result=2 then 'UNMARK(-1)'
else do
    if fr=1 then 'MESSAGE("Sélection incorrecte"):UNLOCK'
    else 'MESSAGE("Bad selection"):UNLOCK'
    exit
end

label=test_liaison(i)
if label='0' then do
    if fr=1 then 'TITLE("Recherche autres masses...")'
    else 'TITLE("Looking for other grounds...")'
    do i=1 to objets
	'FINDPART('i',"MASSE")'
	j=result
	if j=0 then do
	    'FINDPART('i',"MASSE2")'
	    j=result
	end
	if j>0 then do
	    'TEST('j')'
	    if result=0 then do
		k=connexion_broche(j,1)
		if k>0 then do
		    'MARK('j')'
		    call test_liaison(k)
		end
	    end
	end
	else leave i
	i=j
    end
end
else if label~="" then do
    if fr=1 then 'TITLE("Recherche autres alimentations...")'
    else 'TITLE("Looking for other powers...")'
    do i=1 to objets
	'FINDPART('i',"ALIMENTATION")'
	j=result
	if j>0 then do
	    'TEST('j')'
	    if result=0 then do
		'_V_=GETVAL('j')'
		if result=0 then '_V_=GETREF('j')'
		if result>0 then do
		    'READTEXT(_V_)'
		    if result=label then do
			k=connexion_broche(j,1)
			if k>0 then do
			    'MARK('j',_V_)'
			    call test_liaison(k)
			end
		    end
		end
	    end
	end
	else leave i
	i=j
    end
end
'TITLE("")'
if label="" then do
    if fr=1 then label="non nommée"
    else label="unnamed"
end
if fr=1 then 'MESSAGE("Équipotentielle 'label'")'
else 'MESSAGE("Net 'label'")'
'UNLOCK'
exit

/* Procédure principale (recherche des liaisons appartenant à un réseau) */
test_liaison: procedure expose net. fr
    parse arg i
    /* Test des liaisons */
    j=1; nets=0; net.0=""
    if fr=1 then 'TITLE("Lecture des liaisons en cours..."):OBJECTS'
    else 'TITLE("Reading nets..."):OBJECTS'
    objets=result

    /* Initialisation de l'appartenance des objets à une équipotentielle */
    net.=-1

    'COORDS(O='i')'         /* Marquage du fil */
    parse var result x0','y0','x1','y1
    call test_ligne(x0,y0,objets)
    call test_ligne(x1,y1,objets)

    if fr=1 then 'TITLE("Test des jonctions...")'
    else 'TITLE("Checking junctions...")'
    m=1
    do while m>0
	m=0
	i=1
	do while i>0
	    'OO=FINDOBJ('i',7,-1,-1)'; i=result
	    if i>0 then do
		'TEST(OO)'
		if result=0 then do
		    'COL(OO)'; x0=result
		    'LINE(OO)'; y0=result
		    n=test_jonction(x0,y0,objets)
		    if n=1 then do	/* la jonction appartient au net */
		       'MARK(OO)'
			call marquer_ligne(x0,y0,objets)
			m=1
		    end
		end
		if i=objets then i=0
		else i=i+1
	    end
	end
    end

    if fr=1 then 'TITLE("Recherche des masses...")'
    else 'TITLE("Searching grounds...")'
    label=""
    do i=1 to objets
	'O=FINDPART('i',"MASSE")'; i=result
	if i>0 then do
	    j=connexion_broche(i,1)
	    if j>0 then do
		'TEST('j')'
		if result=1 then do
		    'MARK('i')'
		    label=0
		    leave i
		end
	    end
	    i=i+1
	end
	else leave
    end

    if label="" then do
	if fr=1 then 'TITLE("Recherche des labels...")'
	else 'TITLE("Searching 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
		    'TEST('j')'
		    if result=1 then do
			'READTEXT(O)'; label=result; leave i
		    end
		end
	    end
	end
    end

    if label="" then do
	if fr=1 then 'TITLE("Recherche des alimentations...")'
	else 'TITLE("Searching powers...")'
	do i=1 to objets
	    'O=FINDPART('i',"ALIMENTATION")'; i=result
	    if i>0 then do
		j=connexion_broche(i,1)
		if j>0 then do
		    'TEST('j')'
		    if result=1 then do
			'_V_=GETVAL(O)'
			if result=0 then '_V_=GETREF(O)'
			if result~=0 then  do
			    'MARK(O):MARK(_V_):READTEXT(_V_)'; label=result; leave i
			end
		    end
		end
		i=i+1
	    end
	    else leave
	end
    end
    return label

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

marquer_ligne: procedure expose net.
    parse arg x0,y0,objets
    o=1
    do until o=0
	'X=ABS(FINDLINE('o','x0','y0'))'; o=result
	if o>0 then do
	    'IF(TEST(X),0,MARK(X):COORDS(X))'
	    if result~=0 then do
		net.o=1
		parse var result xl','yl','x1','y1
		call test_ligne(xl,yl,objets)
		call test_ligne(x1,y1,objets)
	    end
	    if o=objets then return
	    o=o+1
	end
    end
    return

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

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
if fr=1 then 'MESSAGE("Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'"):UNLOCK'
else 'MESSAGE("Syntax error"+CHR(10)+"in line 'SIGL'"+CHR(10)+"'errortext(erreur)'"):UNLOCK'
exit

error:
if fr=1 then 'MESSAGE("Erreur en ligne 'SIGL'"):UNLOCK'
else 'MESSAGE("Error in line 'SIGL'"):UNLOCK'
exit