/* Remplacement d'une empreinte par une autre *********
   Version 1.00: 21 octobre 2001
   Version 1.01: 2 décembre 2001 (localisation anglais)
   Version 1.02: 1er janvier 2002 (correction bug placement, améliorations...)
   Version 1.03: 6 janvier 2001 (correction bug liaison entre pastilles du composant remplacé)
   Version 1.04, 03-Feb-2002, German localization by A. Greve
   $VER: Replace.AmiPCB 1.04, © R.Florac, 3-Feb-2002
******************************************************/

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

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

lf='0a'x
fr = 'ARexx/InitVars.AmiPCB'()

'FIRSTSEL'
o=result
if o<1 then do
    select
	when fr=1 then 'MESSAGE("Sélectionnez d''abord'lf'l''empreinte à remplacer !")'
	when fr=2 then 'MESSAGE("Wählen sie die zu'lf'ersetzende Komponente vor'lf'dem Aufruf dieses Skripts")'
	otherwise      'MESSAGE("Select the component'lf'to replace'lf'before calling this script")'
    end
    exit
end
'GROUP('o')'
groupe=result
if groupe=0 then do
    select
	when fr=1 then 'MESSAGE("Vous devez sélectionner'lf'une empreinte avant'lf'd''appeler ce script !")'
	when fr=2 then 'MESSAGE("Sie müssen eine Komponente vor'lf'dem Aufruf dieses Skripts wählen !")'
	otherwise      'MESSAGE("You must select a'lf'component before'lf'calling this script !")'
    end
    exit
end
ref=""; val=""; np=0
do while o>0
    'TYPE('o')==PASTILLE'
    if result=1 then do
	'PADNUM('o',-1)'
	p=result
	pin.np=p
	i=np-1
	do while i>=0
	    if pin.i=p then do
		select
		    when fr=1 then 'MESSAGE("Plusieurs pastilles'lf'possèdent le numéro 'p'.'lf'Traitement impossible")'
		    when fr=2 then 'MESSAGE("Mehrere Pads haben'lf'die Nummer 'p'.'lf'Operation unmöglich")'
		    otherwise	   'MESSAGE("Several pads have'lf'number 'p'.'lf'Operation impossible")'
		end
		exit
	    end
	    i=i-1
	end
	'COL('o')'
	x.np=result
	'LINE('o')'
	y.np=result
	call save_nets(o,pin.np)
	np=np+1
    end
    else do
	'TYPE('o')==REFERENCE'
	if result=1 then do
	    'READTEXT('o')'
	    ref=result
	    'COL('o')'
	    xref=result
	    'LINE('o')'
	    yref=result
	    'GETPOS('o')'
	    posref=result
	    'HSCALE('o')'
	    href=result
	    'VSCALE('o')'
	    vref=result
	end
	else do
	    'TYPE('o')==VALEUR'
	    if result=1 then do
		'READTEXT('o')'
		val=result
		'COL('o')'
		xval=result
		'LINE('o')'
		yval=result
		'GETPOS('o')'
		posval=result
		'HSCALE('o')'
		hval=result
		'VSCALE('o')'
		vval=result
	    end
	end
    end
    'GROUP('o')'
    if result~=groupe then do
	select
	    when fr=1 then 'MESSAGE("Sélectionnez une seule empreinte'lf'avant d''appeler ce script !")'
	    when fr=2 then 'MESSAGE("Wählen Sie nur eine einzige Komponente'lf'vor dem aufruf dieses Skripts !")'
	    otherwise	   'MESSAGE("Select only one component'lf'before calling this script !")'
	end
	exit
    end
    'NEXTSEL('o')'
    o=result
end
select
    when fr=1 then 'REQFILE("Sélectionnez une empreinte",CLIPPATH(""),"")'
    when fr=2 then 'REQFILE("Wählen Sie eine Maske",CLIPPATH(""),"")'
    otherwise	   'REQFILE("Select a mask",CLIPPATH(""),"")'
end
clip=result
if clip="" then exit
'LOADCLIP(5,"'clip'"):SAVEALL:DELETE(0):PASTE(5,1500,1500)'
/* Traitement composant simple (une seule pastille) */
if np=1 then do
    o=get_pad(pin.0)
    if o=0 then do
	select
	    when fr=1 then 'SELECT("Le nouveau composant n''a pas de'lf'pastille avec le même numéro,'lf'choisissez une action","Continuer","Renuméroter","Arrêter")'
	    when fr=2 then 'SELECT("Die neue Komponente enthält'lf'kein Pad mit der gleichen Nummer,'lf'wählen sie eine Aktion","Weiter","Umnummerieren","Abbrechen")'
	    otherwise	   'SELECT("The new component has no'lf'pad with the same number,'lf'choose an action","Continue","Renumber","Cancel")'
	end
	action=result
	if action=2 then do
	    'FINDOBJ(0,-PASTILLE,-1,-1)'
	    o=result
	    if o>0 then 'PADNUM('o','pin.0')'
	    action=1
	end
	if action~=1 then exit
    end
    'FINDOBJ(0,-PASTILLE,-1,-1)'
    o=result
    if o>0 then 'MOVE(0,'x.0'-COL('o'),'y.0'-LINE('o'))'
    pin=pin.0
    do while net.pin.0>0
	i=net.pin.0
	'SETLABEL(NET('o','net.pin.i'),"'net.pin.i.label'")'
	net.pin.0=net.pin.0-1
    end
    if ref~="" then do
	'FINDOBJ(0,-REFERENCE,-1,-1)'
	o=result
	if o>0 then 'SETTEXT('o',"'ref'")'
    end
    if val~="" then do
	'FINDOBJ(0,-VALEUR,-1,-1)'
	o=result
	if o>0 then 'SETTEXT('o',"'val'")'
    end
    exit
end
/* Traitement composant comportant plusieurs pastilles */
p=np
do while p>0
    p=p-1
    pin=pin.p
    if get_pad(pin)=0 then do
	if net.pin.0>0 then do
	    select
		when fr=1 then 'MESSAGE("Pastille 'pin.p' non trouvée'lf'Utilisez le menu restaurer'lf'pour annuler l''opération")'
		when fr=2 then 'MESSAGE("Pad 'pin.p' nicht gefunden.'lf'Benutzen Sie das Menü'lf'Bearbeiten / Rückgängig machen,'lf'um die Aktion abzubrechen.")'
		otherwise      'MESSAGE("Pad 'pin.p' not found'lf'Use the Undo menu'lf'to cancel the operation")'
	    end
	    exit
	end
    end
end
/* Recherche du sens de placement */
call get_positions
/* Pastilles sur la même colonne ? */
if (y1=y2 & y.0=y.1) then do
    if (x1<x2 & x.0>x.1) | (x1>x2 & x.0<x.1)  then do
	'SYMMETRY(-GROUP(FIRSTSEL),-1)'
	call get_positions
    end
end
else if (x1~=x2 & x.0=x.1) | (x1=x2 & x.0~=x.1) then do
    'ROTATE(-GROUP(FIRSTSEL),1)'
    call get_positions
end
/* Pastilles sur la même ligne ? */
else if (y1~=y2 & y.0=y.1) | (y1=y2 & y.0~=y.1) then do
    'ROTATE(-GROUP(FIRSTSEL),1)'
    call get_positions
end
if (y1=y2 & y.0=y.1) then do
    if (x1<x2 & x.0>x.1) | (x1>x2 & x.0<x.1)  then do
	'SYMMETRY(-GROUP(FIRSTSEL),-1)'
	call get_positions
    end
end
if (x1=x2 & x.0=x.1) then do
    if (y1<y2 & y.0>y.1) | (y1>y2 & y.0<y.1)  then do
	'ROTATE(-GROUP(FIRSTSEL),1):ROTATE(-GROUP(FIRSTSEL),1)'
	call get_positions
    end
end
'MOVE(0,'x.0'-COL('p1'),'y.0'-LINE('p1'))'
if ref~='' then do
    'FINDOBJ(0,-REFERENCE,-1,-1)'
    o=result
    if o>0 then do
	'SETTEXT('o',"'ref'")'
	'SETSCALE('o','href','vref')'
	'IF(SGN(GETPOS('o'))<>SGN('posref'),SYMMETRY('o',-1),0)'
	'WHILE(ABS(GETPOS('o'))<>ABS('posref'),ROTATE('o',1))'
	'MOVE('o','xref'-COL('o'),'yref'-LINE('o'))'
    end
end
if val~='' then do
    'FINDOBJ(0,-VALEUR,-1,-1)'
    o=result
    if o>0 then do
	'SETTEXT('o',"'val'")'
	'SETSCALE('o','hval','vval')'
	'IF(SGN(GETPOS('o'))<>SGN('posval'),SYMMETRY('o',-1),0)'
	'WHILE(ABS(GETPOS('o'))<>ABS('posval'),ROTATE('o',1))'
	'MOVE('o','xval'-COL('o'),'yval'-LINE('o'))'
    end
end
else do
    'FINDOBJ(0,-VALEUR,-1,-1)'
    o=result
    if o>0 then 'DELETE('o')'
end

i=0
do while i<np
    pin=pin.i
    o=get_pad(pin)
    do while net.pin.0>0
	j=net.pin.0
	if net.pin.j<0 then do
	    o2=get_pad(-net.pin.j)
	    'SETLABEL(NET('o','o2'),"'net.pin.j.label'")'
	end
	else do
	    'SETLABEL(NET('o','net.pin.j'),"'net.pin.j.label'")'
	end
	net.pin.0=net.pin.0-1
    end
    i=i+1
end
exit


get_positions:
    p1=get_pad(pin.0)
    'COL('p1')'
    x1=result
    'LINE('p1')'
    y1=result
    p2=get_pad(pin.1)
    'COL('p2')'
    x2=result
    'LINE('p2')'
    y2=result
    return

get_pad: procedure
    parse arg pin
    'FINDOBJ(0,-PASTILLE,-1,-1)'
    p=result
    do while p>0
	'PADNUM('p',-1)'
	if result=pin then return p
	'FINDOBJ('p',-PASTILLE,-1,-1)'
	p=result
    end
    return 0

save_nets: procedure expose net.
    parse arg pad,pin
    'GETNET('pad',0)'
    nets=result
    net.pin.0=nets
    do while nets>0
	'GETPAD(GETNET('pad','nets'),0)'
	p=result
	if p=pad then do
	    'GETPAD(GETNET('pad','nets'),1)'
	    p=result
	end
	'TEST('p')'
	if result=1 then do
	    'PADNUM('p',-1)'
	    p=-result
	end
	net.pin.nets=p
	'GETLABEL(GETNET('pad','nets'))'
	net.pin.nets.label=result
	nets=nets-1
    end
    return

/* Traitement des erreurs, interruption du programme */
syntax:
erreur=RC
Call 'ARexx/_Syntax.rexx'(fr,'Replace.AmiPCB',SIGL,erreur)
exit

error:
Call 'ARexx/_Error.rexx'(fr,'Replace.AmiPCB',SIGL)
exit