/* Importation d'une netlist créée par AmiCAD */
/* Version 1.00, 23 Août 2001 (localisation français/anglais) */
/* Version 1.01, 29 Octobre 2001 (comptage nouveaux objets) */
/* Version 1.02, 1er décembre 2001 (German localization by A. Greve) */
/* Version 1.03, 6 avril 2002 (Correction message (lf) en cas d'erreur) */
/* $VER: ImportAmiCADNetlist 1.03 (© R.Florac, 6/04/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
'INIT(P,O,I,G)'

fr = 'ARexx/InitVars.AmiPCB'()

select
    when fr=1 then 'REQFILE("Netlist AmiCAD à importer ?","RAM:","")'
    when fr=2 then 'REQFILE("Zu importierende AmiCAD Netzliste ?","RAM:","")'
    otherwise	   'REQFILE("AmiCAD netlist to import ?","RAM:","")'
end
fichier=result
if fichier='' then exit

if ~open(file, fichier, 'R') then do
    select
	when fr=1 then 'MESSAGE("Erreur ouverture fichier.'lf'Opération impossible.")'
	when fr=2 then 'MESSAGE("Fehler beim Öffnen der Datei.'lf'Operation nicht möglich.")'
	otherwise      'MESSAGE("Error opening file.'lf'Operation impossible.")'
    end
    exit
end

'SETGRID(0)/CURSTEP(0)'
grid=result

ligne=readln(file)
if ligne~='[AmiCAD2PCBMasks 1.0]' then do
    select
	when fr=1 then 'MESSAGE("Format fichier incorrect")'
	when fr=2 then 'MESSAGE("Falsches Dateiformat")'
	otherwise      'MESSAGE("Incorrect file format")'
    end
    close(file)
    exit
end

'IF(FINDOBJ(0,NET,-1,-1)==0,FINDOBJ(0,HIDDEN_NET,-1,-1),1)'
if result>0 then do
    select
	when fr=1 then 'REQUEST("Le document contient déjà'lf'un ou plusieurs réseaux'lf'Si vous continuez les nouveaux'lf'réseaux seront ajoutés aux'lf'réseaux existants.'lf'Il est peut-être préférable'lf'de les supprimer avant de'lf'placer les nouvelles liaisons.'lf'Utilisez le script'lf'DeleteNets pour cela.'lf'Voulez-vous continuer ?")'
	when fr=2 then 'REQUEST("Das Dokument enthält bereits mindestens ein Netz.'lf'Wenn Sie weiter machen, werden die neuen Netze'lf'zu den bestehenden hinzu gefügt.'lf'Möglicherweise ist es besser, die vorhandenen'lf'Netze vor dem Import der neuen zu löschen.'lf'Verwenden Sie hierzu das Skript DeleteNets.AmiPCB.'lf'Möchten Sie trotzdem weiter machen ?")'
	otherwise      'REQUEST("The document already have'lf'one or more nets'lf'If you continue the new'lf'nets will be added to'lf'the existing nets.'lf'Perhaps it would be better'lf'to delete them before'lf'importing the new ones.'lf'Use the script'lf'DeleteNets for that.'lf'Do-you want to continue ?")'
    end
    if result ~= 1 then exit
end

xp=grid;yp=grid;hp=0
'LOCK:SECURITY(OBJECTS*2):WWIDTH'
xmax=result

/* Lecture des empreintes nécessaires */
select
    when fr=1 then 'TITLE("Lecture et placement des empreintes...")'
    when fr=2 then 'TITLE("Lese Masken ein...")'
    otherwise	   'TITLE("Reading masks...")'
end
newcomps=0
do while ligne~='[Netlist]'
    ligne=readln(file)
    if ligne~='[Netlist]' then do
	parse value ligne with ref ',' '"' lib '"' ',' '"' valeur '"'
	if groupe(ref)=0 then do
	    'LOADCLIP(5,CLIPPATH("")+"/'lib'")'
	    nc=result
	    'WIDTH(-5)'
	    if result + xp >= xmax then do
		xp=grid
		yp=yp+hp+grid
		hp=0
	    end
	    'PASTE(5,'xp','yp')'
	    if result~=nc then do
		select
		    when fr=1 then 'MESSAGE("Positionnement composant impossible.'lf'Utilisez un document de'lf'plus grande taille.")'
		    when fr=2 then 'MESSAGE("Platzierung der Komponente nicht möglich.'lf'Verwenden sie ein größeres Dokument.")'
		    otherwise	   'MESSAGE("Placement of component impossible.'lf'Use a larger document.")'
		end
		close(file)
		'UNLOCK'
		exit
	    end
	    newcomps=newcomps+1
	    'IF(O=FINDOBJ(0,-REFERENCE,-1,-1),SETTEXT(O,"'ref'"),0):O'
	    if result=0 then do
		'SETSIDE(0,4):IF(O=WRITE("'ref'",'xp','yp'),GROUP('n',O):SETREF(O),0)'
		if result=0 then 'SETSIDE(0,4):IF(O=WRITE("'ref'",'xp','yp+grid'),GROUP('n',O):SETREF(O),0)'
	    end
	    if valeur ~= "" then do
		'FINDOBJ(0,-VALUE,-1,-1)'
		i=result
		if i>0 then 'SETTEXT('i',"'valeur'")'
		else do
		    'SETSIDE(0,4):IF(O=WRITE("'valeur'",'xp','yp'),GROUP('n',O):SETVAL(O),0)'
		    if result=0 then 'SETSIDE(0,4):IF(O=WRITE("'valeur'",'xp','yp+grid'),GROUP('n',O):SETVAL(O),0)'
		end
	    end
	    'WIDTH(0)'
	    xp=xp+((result%grid)*grid)+grid
	    'HEIGHT(0)'
	    h=(result%grid)*grid
	    if h>hp then hp=h
	end
	'UNMARK(0)'
    end
end
select
    when fr=1 then 'TITLE("Lecture de la netlist en cours...")'
    when fr=2 then 'TITLE("Lese Netzliste ein...")'
    otherwise	   'TITLE("Reading netlist...")'
end
newnets=0
do forever
    ligne=readln(file)
    if ligne~='' then do
	parse value ligne with net ',' pins
	parse value pins with ref '.' pin ',' pins
	do while pins~="" /* pos(',',pins)>0 */
	    parse value pins with ref2 '.' pin2 ',' pins
	    n=newnet(ref,pin,ref2,pin2)
	    'SETLABEL('n',"'net'")'
	    newnets=newnets+1
	    pin=pin2
	    ref=ref2
	end
    end
    else leave
end
select
    when fr=1 then 'MESSAGE("Importation terminée'lf''newcomps' composants placés'lf''newnets' liaisons réseaux trouvées")'
    when fr=2 then 'MESSAGE("Import beendet'lf''newcomps' Komponenten platziert'lf''newnets' Netze gefunden")'
    otherwise	   'MESSAGE("Importation ended'lf''newcomps' components placed'lf''newnets' nets found")'
end
close(file)
'UNLOCK'
exit

newnet: procedure expose fr lf
    parse arg ref1,pin1,ref2,pin2
    g1 = groupe(ref1)
    if g1=0 then do
	select
	    when fr=1 then 'MESSAGE("Groupe référence 'ref1||lf'non trouvé")'
	    when fr=2 then 'MESSAGE("Referenzgruppe 'ref1||lf'nicht gefunden")'
	    otherwise	   'MESSAGE("Reference group 'ref1||lf'not found")'
	end
	'UNLOCK'
	exit
    end
    p1 = pad(g1,pin1)
    if p1=0 then do
	select
	    when fr=1 then 'MESSAGE("Numéro de broche non trouvé:'lf'Composant 'ref1' broche 'pin1'")'
	    when fr=2 then 'MESSAGE("Pinnummer nicht gefunden:'lf'Komponente 'ref1' Pin 'pin1'")'
	    otherwise	   'MESSAGE("Pin number not found:'lf'Component 'ref1' pin 'pin1'")'
	end
	'UNLOCK'
	exit
    end
    g2 = groupe(ref2)
    if g2=0 then do
	select
	    when fr=1 then 'MESSAGE("Groupe référence 'ref2||lf'non trouvé")'
	    when fr=2 then 'MESSAGE("Referenzgruppe 'ref2||lf'nicht gefunden")'
	    otherwise	   'MESSAGE("Reference group 'ref2||lf'not found")'
	end
	'UNLOCK'
	exit
    end
    p2 = pad(g2,pin2)
    if p2=0 then do
	select
	    when fr=1 then 'MESSAGE("Numéro de broche non trouvé:'lf'Composant 'ref2' broche 'pin2'")'
	    when fr=2 then 'MESSAGE("Pinnummer nicht gefunden:'lf'Komponente 'ref2' Pin 'pin2'")'
	    otherwise	   'MESSAGE("Pin number not found:'lf'Component 'ref2' pin 'pin2'")'
	end
	'UNLOCK'
	exit
    end
    'NET('p1','p2')'
    return result

groupe: procedure expose fr
    parse arg ref
    'G=0:I=FINDOBJ(0,REFERENCE,-1,-1):WHILE(I>0,IF(READTEXT(I)=="'ref'",J=I:I=0:G=GROUP(J),I=FINDOBJ(I,REFERENCE,-1,-1))):G'
    return result

pad: procedure expose fr
    parse arg groupe,pin
    'P=0:I=FINDOBJ(0,PAD,-1,-1):WHILE(I>0,IF(GROUP(I)=='groupe',IF(PADNUM(I,-1)=='pin',P=I:I=0,I=FINDOBJ(I,PAD,-1,-1)),I=FINDOBJ(I,PAD,-1,-1))):P'
    return result

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

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