/* Sélection d'une netlist */
/* $VER: NetList 1.0 (© R.Florac, 14-07-98) */
/* 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

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

if i=0 then do
    'PICKOBJ("Cliquez sur la liaison à tester")'
    i=result
end

if i=0 then exit

/* Test des liaisons */
j=1; nets=0; net.0=""
'TITLE("Lecture des liaisons en cours..."):LOCK(-1):OBJECTS(-1)'; objets=result

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

'TYPE(O='i')'
if result=2 then do
    'UNMARK(-1):TEST(O)'
    if result=0 then do
	'COORDS(O)'             /* Marquage du fil */
	parse var result x0','y0','x1','y1
	call test_ligne(x0,y0,objets)
	call test_ligne(x1,y1,objets)
    end
end
else do
    'MESSAGE("Sélection incorrecte")'
    exit
end

'TITLE("Test des jonctions...")'
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

'TITLE("Recherche des masses...")'
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
		label=0
		leave i
	    end
	end
	i=i+1
    end
    else leave
end

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

if label="" then do
    'TITLE("Recherche des alimentations...")'
    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
		    'READTEXT(GETVAL(O))'; label=result; leave i
		end
	    end
	    i=i+1
	end
	else leave
    end
end

'TITLE("")'
if label~="" then 'MESSAGE("Équipotentielle 'label'")'
exit

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
'MESSAGE("Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
exit

error:
'MESSAGE("Erreur en ligne 'SIGL'")'
exit