/* Script de création d'une netlist AmiPCB */
/* Version 1.00 (4 novembre 2001) */
/* $VER: CAD2PCB.AmiCAD 1.00 (© R.Florac, 4/11/01) */

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

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

'VERSION(0)'
if result<2.09 then do
    if fr=1 then 'MESSAGE("Ce script nécessite'lf'AmiCAD 2.09 ou mieux")'
    else 'MESSAGE("This script requires'lf'AmiCAD 2.09 or better")'
    return -1
end

'OBJECTS'
nbo=result
if nbo=0 then do
    if fr=1 then 'MESSAGE("Chargez un schéma avant"+CHR(10)+"d''appeler ce script !")'
    else 'MESSAGE("Load a sheet before"+CHR(10)+"calling this script !")'
    return -1
end

'NETS'
if result=0 then do
    if fr=1 then 'MESSAGE("La netlist doit avoir été créée"+CHR(10)+"avant de lancer ce script !")'
    else 'MESSAGE("The netlist must be created"+CHR(10)+"before running this script !")'
    return -1
end

/* Comptage des fils de liaison */
'_I_=0:I=1:SECURITY(OBJECTS+1):WHILE(I<=OBJECTS,IF(TYPE(I)==FIL,_I_=_I_+1,0),I=I+1):_I_==ARRAYDIM(LABEL)-1'

if result~=1 then do
    if fr=1 then 'MESSAGE("La netlist ne correspond"+CHR(10)+"pas au schéma."+CHR(10)+"Elle doit être (re)compilée"+CHR(10)+"avant de lancer ce script")'
    else 'MESSAGE("The netlist doesn''t match"+CHR(10)+"the current document."+CHR(10)+"It must be (re)compiled"+CHR(10)+"before running this script")'
    return -1
end

call addlib("rexxdossupport.library",0,-30,2)
call 'ARexx/InitObjets.AmiCAD'

/* Vérification présence références composants */
'TITLE("Vérification des références..."):UNMARK(-1)'
do i=1 to nbo
    'FINDOBJ('i',COMPOSANT,-1,-1)'
    i=result
    if i=0 then leave
    'PARTNAME('i')'
    composant=result
    if composant=MASSE | composant=MASSE2 | composant=ALIMENTATION then iterate
    'GETREF('i')'
    if result=0 then do
	'MARK('i'):VISIBLE(COL('i')+WIDTH('i')/2,LINE('i')+HEIGHT('i')/2):MESSAGE("Le composant 'i' ne'lf'possède aucune référence'lf'son traitement est impossible")'
	return -1
    end
end

/* Chemin situant les clips AmiPCB */
'MASKPATH("")'
empreintes=result

'DEF NETTYPE(I)=IF(TYPE(I)==COMPOSANT,1,IF(TYPE(I)==INPUT,1,IF(TYPE(I)==OUTPUT,1,0)))'
'LOCK:UNMARK(-1):TITLE("Test affectation empreintes existantes...")'
me=0;ex=0
do i=1 to nbo
    'TYPE('i')==COMPOSANT'
    if result~=0 then do
	'PARTNAME('i')'
	composant=result
	if composant=MASSE | composant=MASSE2 | composant=ALIMENTATION then iterate
	'GETMASK('i')'
	if result='' then do
	    'MARK('i')'
	    me=me+1
	end
	else ex=ex+1
    end
end

if ex=0 then do
    'REQUEST("Aucune empreinte n''a'lf'été affectée aux composants'lf'Voulez-vous le faire maintenant ?")'
    if result~=1 then exit
end
if me>0 & ex>0 then do
    'TITLE(""):REQUEST("L''affectation des empreintes'lf'paraît n''avoir pas été effectuée'lf'pour les 'me' empreintes marquées'lf'Voulez-vous continuer ?")'
    if result~=1 then exit
end

em=0
if me>0 then do
    'TITLE("Affectation des empreintes aux composants")'
    /* Recherche des différents composants */
    do i=1 to nbo
	'UNMARK(-1):FINDOBJ('i',COMPOSANT,-1,-1)'
	i=result
	if i=0 then leave i
	'MARK('i'):IF(GETVAL('i'),MARK(GETVAL('i')),0):IF(GETREF('i'),MARK(GETREF('i')),0):PARTNAME('i')'
	composant=result
	if composant=MASSE | composant=MASSE2 | composant=ALIMENTATION then iterate
	'GETVAL('i')'
	valeur=result
	if valeur=0 then circuit=""
	else do
	    'READTEXT('valeur')'
	    circuit=result
	end
	'GETREF('i')'
	reference=result
	'READTEXT('reference')'
	reference=result
	empreinte = test_existence(reference)
	if empreinte~=""then do
	    'SETMASK('i',"'empreinte'")'
	    iterate
	end
	em=em+1
	'GETMASK('i')'
	empreinte=result
	if empreinte="" then do
	    'LIBRARY('i')'
	    lib=upper(FilePart(result))
	    ci=0
	    select
		when lib="SYMBOLES_ANALOGIQUES" then ci=1
		when lib="SYMBOLES_TTL" then ci=1
		when lib="SYMBOLES_CMOS" then ci=1
		when lib="SYMBOLES_COMPTEURS_TTL" then ci=1
		when lib="SYMBOLES_CIRCUITS_SPÉCIAUX" then ci=1
		when lib="SYMBOLES_MICRO" then ci=1
		otherwise nop
	    end
	    'VISIBLE(COL('i')+WIDTH('i')/2,LINE('i')+HEIGHT('i')/2)'
	    if empreinte="" then empreinte=empreinte_existante(composant,circuit)
	    if empreinte ~= "" then do
		if ci=1 then composant='circuit'
		path = PathPart(empreinte)
		empreinte = FilePart(empreinte)
		path = AddPart(empreintes,path)
		'REQFILE("Empreinte 'composant' 'circuit'","'path'","'empreinte'")'
	    end
	    else do
		path = empreintes
		if composant='RÉSISTANCE' then 'REQFILE("Empreinte RÉSISTANCE "+"'circuit'","'AddPart(path,"Résistances")'","'empreinte'")'
		else if ci=1 then 'REQFILE("Empreinte circuit 'circuit'","'AddPart(path,"Circuits")'","'empreinte'")'
		else if left(composant,12)='CONDENSATEUR' then 'REQFILE("Empreinte 'composant' "+"'circuit'","'AddPart(path,"Condensateurs")'","'empreinte'")'
		else if left(composant,5)='DIODE' then 'REQFILE("Empreinte 'composant' "+"'circuit'","'AddPart(path,"Diodes")'","'empreinte'")'
		else if left(composant,10)='TRANSISTOR' then 'REQFILE("Empreinte 'composant' "+"'circuit'","'AddPart(path,"Transistors")'","'empreinte'")'
		else 'REQFILE("Empreinte 'composant' "+"'circuit'","'path'","'empreinte'")'
	    end
	    empreinte=result
	    if empreinte="" then return -3
	    lib=FilePart(PathPart(empreinte))||'/'||FilePart(empreinte)
	end
	else lib=empreinte
	composant.em = composant
	empreinte.em = lib
	valeur.em = circuit
	nom.em = racine(reference)
	'SETMASK('i',"'lib'")'
	em=em+1
    end
end

/* Sauvegarde de la liste des empreintes */
'REQFILE("Fichier AmiPCB à créer ?", "RAM:", FILEPART("")+".AmiPCB")'
fichier=result
if fichier="" then return -3
if ~open(file, fichier, 'W') then do
    'MESSAGE("Erreur ouverture fichier"+CHR(10)+"Sauvegarde impossible")'
    return -3
end
'TITLE("Sauvegarde empreintes composants en cours...")'
writeln(file,'[AmiCAD2PCBMasks 1.0]')
do i=1 to em
    empreinte.i=''
end
em=0
do i=1 to nbo
    'O=FINDOBJ('i',COMPOSANT,-1,-1)'; i=result
    if result>0 then do
	'PARTNAME(O)'
	composant=result
	if composant=MASSE | composant=MASSE2 | composant=ALIMENTATION then iterate
	'GETREF(O)'
	reference=result
	'READTEXT('reference')'
	reference=result
	empreinte = test_existence(reference)
	if empreinte='' then do
	    'GETMASK(O)'
	    empreinte=result
	    if left(composant,17)='CONNECTEUR ENTRÉE' | left(composant,17)='CONNECTEUR SORTIE' then valeur=0
	    else do
		'GETVAL(O)'
		valeur=result
	    end
	    if valeur~=0 then do
		'READTEXT('valeur')'
		valeur=result
		writeln(file, racine(reference)||','||'"'||empreinte||'"'||','||'"'||valeur||'"')
	    end
	    else writeln(file, racine(reference)||','||'"'||empreinte||'"')
	    em=em+1
	    empreinte.em=empreinte
	    nom.em=reference
	end
    end
    else leave i
end

/* Création des listes d'équipotentielles */
'TITLE("Sauvegarde liste équipotentielles en cours..."):NETS'
nets=result
do n=0 to nets
    ligne.n=''
end
do i=1 to nbo
    'O=FINDOBJ('i',COMPOSANT,-1,-1)'; i=result
    if result>0 then do
	'PARTNAME(O)'
	if result~="MASSE" & result ~="MASSE2" & result~="ALIMENTATION" then do
	    'DEVPINS(O)'; j=result
	    do k=1 to j
		l = connexion_broche(i,k)
		if l>0 then do
		    'GETARRAY(EQUI,'l')'
		    n=result
		    if ligne.n='' then do
			'GETARRAY(LABEL,'n')'
			ligne.n=result||','
		    end
		    'READTEXT(GETREF(O))'
		    ligne.n=ligne.n||racine(result)
		    'PINNUM(O,'k')'
		    pin=result
		    if pin=0 then pin=k
		    ligne.n=ligne.n||'.'||pin||','
		end
	    end
	end
    end
    else leave i
end
writeln(file,'[Netlist]')
do i=0 to nets
    if ligne.i~="" then call writeln(file,ligne.i)
end
close(file)
'TITLE(""):MESSAGE("Sauvegarde terminée"):UNLOCK'
return 0

connexion_broche: procedure
    parse arg objet,broche
    'PINCOL(O='objet',B='broche')'; xj=result
    'PINLINE(O,B)'; yj=result
    'FINDOBJ(1,FIL,'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,JONCTION,'xj','yj')'         /* Il doit alors y avoir une jonction */
    if result>0 then return xl
    return 0

test_existence: procedure expose em nom. empreinte.
    parse arg ref
    do j=1 to em
	if ref=nom.j then return empreinte.j
	if racine(ref)=racine(nom.j) then return empreinte.j
    end
    return ""

racine: procedure
    parse arg ref
    p=verify(ref,'0123456789','M')
    if p>0 then do
	do while datatype(right(ref,1))~='NUM'
	    ref=left(ref,length(ref)-1)
	end
    end
    return translate(ref,'__',' .')

empreinte_existante: procedure expose em composant. empreinte. valeur.
    parse arg nom,valeur
    /* Test des composants par leur nom et leur valeur */
    do j=1 to em
	if nom=composant.j then do
	    if valeur=valeur.j then return empreinte.j
	end
    end
    /* Test des composants par leur nom */
    do j=1 to em
	if nom=composant.j then return empreinte.j
    end
    return ""

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

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