/* Ajout des références aux composants du type sélectionné ou spécifié
   © R.Florac, Chez Corbin, 2 juin 1998, v1.00
   Version 1.02, 1er juillet 1998: ajout TEST_CIRCUIT pour marquer tous les composants (oubli)
   Version 1.03, 16 mars 1999: modification fonction ASKTEXT
   Version 1.04, 13 avril 2000: adaptation version 2.05
   Version 1.05, 16 avril 2000: ajout init ROTATE, SYMMETRY, SETSCALE.
				Amélioration placement références nouvelles.
   Version 1.06, 11 novembre 2000: localisation anglais/français
   $VER: Référencer.AmiCAD 1.06 (© R.Florac, 11/11/2000) */

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

if fr=1 then 'SELECT("Type de composant à référencer"+CHR(10)+"Résistances"+CHR(10)+"Condensateurs"+CHR(10)+"Diodes"+CHR(10)+"Transistors"+CHR(10)+"Circuits intégrés"+CHR(10)+"Tous les composants"+CHR(10)+"Composants spécifiés")'
else 'SELECT("Component type to reference"+CHR(10)+"Resistances"+CHR(10)+"Capacitors"+CHR(10)+"Diodes"+CHR(10)+"Transistors"+CHR(10)+"Integrated circuits"+CHR(10)+"All the components"+CHR(10)+"Specified components")'
choix=result
select
    when choix=1 then do
	reference='R'
	type="Rés#?"
	end
    when choix=2 then do
	reference='C'
	type="Cond#?"
	end
    when choix=3 then do
	reference='D'
	type="Diod#?"
	end
    when choix=4 then do
	reference='Q'
	type="Transist#?"
	end
    when choix=5 then do
	reference="CI"
	type=1
	'DEF TEST_CIRCUIT(N)=IF((TYPE(N)==1) & (TEST(N)==1),1,0)'
	end
    when choix=6 then do
	'SAVEALL'
	call marquer_composant('R',"Rés#?",-1)
	call marquer_composant('C',"Cond#?",-1)
	call marquer_composant('D',"Diod#?",-1)
	call marquer_composant('Q',"Transist#?",-1)
	'DEF TEST_CIRCUIT(N)=IF((TYPE(N)==1) & (TEST(N)==1),1,0)'       /*  v1.02 */
	call marquer_composant('CI',1,-1)
	exit
	end
    when choix=7 then do
	if fr=1 then 'ASKTEXT("Quel est le nom des"+CHR(10)+"composants à référencer?"+CHR(10)+"Vous pouvez utiliser"+CHR(10)+"les jokers(#?) pour"+CHR(10)+"étendre la sélection","")'
	else 'ASKTEXT("What is the name of the"+CHR(10)+"components to reference?"+CHR(10)+"You can use jokers(#?) to"+CHR(10)+"extend the selection","")'
	type=result
	if type='' then exit
	if fr=1 then 'ASKTEXT("Quelle est la référence"+CHR(10)+"à donner à ces composants?","")'
	else 'ASKTEXT("What is the reference"+CHR(10)+"to give to these components?","")'
	reference=result
	if reference='' then exit
	end
    otherwise exit
end
'N=FIRSTSEL'; obj=result
if obj>0 then do
    if fr=1 then 'REQUEST("Voulez-vous marquer"+CHR(10)+"uniquement les"+CHR(10)+"objets sélectionnés?")'
    else 'REQUEST("Do-you want to reference"+CHR(10)+"only the"+CHR(10)+"selected objects?")'
    choix=result
end
else choix=0
'SAVEALL'
call marquer_composant(reference,type,choix)
exit

marquer_composant: procedure
    parse arg reference,type,selection
    if selection<=0 then do
	/* Annulation du marquage éventuel */
	'UNMARK(-1)'
	/* Marquage et comptage des éléments à référencer */
	if type=1 then 'SECURITY(OBJECTS+10):I=0:N=1:WHILE(N<=OBJECTS,IF(TYPE(N)==1,IF(GETDEVS(PARTNAME(N))>0,MARK(N):I=I+1,0),0),N=N+1):I'
	else 'SECURITY(OBJECTS+10):N=0:I=0:WHILE(I=IF(I+1<=OBJECTS,FINDPART(I+1,"'type'"),0),MARK(I):N=N+1):N'
	n=result
    end
    else do
	/* Comptage des éléments déjà marqués */
	if type=1 then 'SECURITY(OBJECTS+10):I=0:N=FIRSTSEL:WHILE(N,IF(TYPE(N)==1,I=I+1,UNMARK(N)),N=NEXTSEL(N)):I'
	else 'SECURITY(OBJECTS+10):I=0:WHILE(N,N=FINDPART(N,"'type'"):IF(N>0,IF(TEST(N)>0,I=I+1,0):N=N+1,0)):I'
	n=result
    end
    if n=0 then do
	if selection>=0 then do
	    if fr=1 then 'MESSAGE("Il n''y a aucun"+CHR(10)+"objet de ce type")'
	    else 'MESSAGE("There is no"+CHR(10)+"object of this type")'
	    exit
	end
	else return
    end

    /* Test des références, ajout éventuel */
    call test_references(type,reference)
    objet=selection_objet(1,type)
    do i=1 to n
	'GETREF('objet')'; ref=result
	if ref=0 then call ajouter_reference(objet,reference)
	else do
	    'READTEXT('ref')'
	    j=right(result,length(result)-length(reference))
	    if j~="" then do
		ref.i=1
	    end
	end
	if i<n then objet=selection_objet(objet+1,type)
    end

    /* Écriture des références */
    objet=selection_objet(1,type)
    numref=0
    do i=1 to n
	if ref.i~=1 then do
	    numref=numref+1
	    do while val.numref=1
		numref=numref+1
	    end
	    'R=GETREF('objet'):SETTEXT(R,READTEXT(R)+"'numref'"):GETDEVS(PARTNAME('objet'))'
	    if result>1 then do
		'SETTEXT(R,READTEXT(R)+CHR(READDEV('objet')+64))'
	    end
	end
	if i<n then do
	    objet=selection_objet(objet+1,type)
	end
    end
    return
end

ajouter_reference: procedure
    parse arg obj,reference
    'GETPOS('obj')'
    p=result
    if p=1 | p=3 then do
	'GETVAL('obj')'; c=result
	if c~=0 then do
	    'COL('c')'
	    c=result
	end
	else do
	    'COL('obj')+WIDTH('obj')+5'; c=result
	end
	'LINE('obj')+HEIGHT('obj')/2'; l=result
    end
    else do
	'COL('obj')+WIDTH('obj')/2-TXWIDTH("'reference'")'; c=result
	'LINE('obj')'; l=result
    end
    'LINKREF('obj',WRITE("'reference'",'c','l'))'
    return
end

selection_objet: procedure
    parse arg obj,type
    if type=1 then do
	'R='obj':WHILE(TEST_CIRCUIT(R)<1,R=NEXTSEL(R)):R'
    end
    else do
	'R=FINDPART('obj',"'type'"):WHILE(TEST(R)==0,R=FINDPART(R+1,"'type'")):R'
    end
    return result
end

/* Procédure testant et marquant les références déjà existantes */
test_references: procedure expose val.
    parse arg type,reference
    obj=1
    'ROTATE(0,0):SETSCALE(0,100,100):SYMMETRY(0,0):OBJECTS';objets=result
    do while obj<=objets
	if type=1 then do
	    'RO='obj':WHILE(IF(RO>0,TYPE(RO)<>1,0),RO=NEXTSEL(RO)):RO'; obj=result
	end
	else do
	    'FINDPART('obj',"'type'")'; obj=result
	end
	if obj=0 then leave
	'GETREF('obj')'; ref=result
	if ref>0 then do
	    'READTEXT('ref')'
	    j=right(result,length(result)-length(reference))
	    if j~="" then do
		'VAL("'j'")'; j=result
		val.j=1
	    end
	end
	obj=obj+1
    end
    return
end

/* Traitement des erreurs, interruption du programme */
syntax:
erreur=RC
if fr=1 then 'MESSAGE("Script Référencer.AmiCAD"+CHR(10)+"Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
else 'MESSAGE("Référencer.AmiCAD script"+CHR(10)+"Syntax error"+CHR(10)+"in line 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
exit

error:
if fr=1 then 'MESSAGE("Script Référencer.AmiCAD"+CHR(10)+"Erreur en ligne 'SIGL'")'
else 'MESSAGE("Référencer.AmiCAD script"+CHR(10)+"Error in line 'SIGL'")'
exit