/* $VER: TestNets 1.00e (© R.Florac, 9 août 1998) */

options results

signal on error
signal on syntax

c=1
'SAVEALL(-1):UNMARK(-1):OBJECTS(-1)'; objets=result
'DEF UNMARKCOMP(O)=IF(GETREF(O),UNMARK(GETREF(O)),0):IF(GETVAL(O),UNMARK(GETVAL(O)),0):UNMARK(O)'

modifs=0; eliminations=0; errrefs=0; errvals=0; errconx=0; doublets=0
c="Check sheet"||'0a'x||"1- Check references "||'0a'x||"2- Check values"||'0a'x||"3- Check connexions"||'0a'x||"4- Check nets"||'0a'x||"5- Check superpositions"||'0a'x
c=c||"6- Chain all"||'0a'x||"7- Abort"
'SELECT("'c'")'
c=result
select
    when c=1 then call test_refs
    when c=2 then call test_valeurs
    when c=3 then call test_connexions
    when c=4 then call test_liaisons
    when c=5 then call test_doublets
    when c=6 then do
	call test_doublets
	call test_refs
	call test_valeurs
	call test_connexions
	call test_liaisons
    end
    otherwise exit
end
call afficher_erreurs
exit

test_refs:
    'LOCK(-1):TITLE("Checking references...")'
    do i=1 to objets
	'TYPE(O='i')'
	if result=1 then do
	    'PARTNAME(O)'
	    if result~="POWER SUPPLY" & result ~="GROUND" then do
		'GETREF(O)'
		if result=0 then do
		    'MARK(O):REQUEST("Warning: object 'i'"+CHR(10)+"("+PARTNAME(O)+")"+CHR(10)+"located in "+STR(COL(O))+" "+STR(LINE(O))+CHR(10)+"have no reference"+CHR(10)+"Do you want to continue?")'
		    if result<1 then do
			'UNLOCK(-1)'
			return
		    end
		    'UNMARKCOMP(O)'
		    errrefs=errrefs+1
		end
	    end
	end
    end
    'UNLOCK(-1)'
return

test_valeurs:
    'LOCK(-1):TITLE("Checking values..."):UNMARK(-1)'
    do i=1 to objets
	'TYPE(O='i')'
	if result=1 then do
	    'PARTNAME(O)'
	    if result~="POWER SUPPLY" & result ~="GROUND" then do
		'GETVAL(O)'
		if result=0 then do
		    'MARK(O):REQUEST("Warning: object 'i'"+CHR(10)+"("+PARTNAME(O)+")"+CHR(10)+"located in "+STR(COL(O))+" "+STR(LINE(O))+CHR(10)+"have no value"+CHR(10)+"Do you want to continue?")'
		    if result<1 then do
			'UNLOCK(-1)'
			return
		    end
		    'UNMARKCOMP(O)'
		    errvals=errvals+1
		end
	    end
	end
    end
    'UNLOCK(-1)'
return

test_doublets:
    'LOCK(-1):TITLE("Checking superpositions..."):UNMARK(-1)'
    i=1
    do while i>0
	'O=FINDOBJ('i',1,-1,-1)'; i=result
	if i>0 then do
	    'N=FINDOBJ('i+1',1,COL(O),LINE(O))'; j=result
	    if j>0 then do
		'IF(PARTNAME(O)==PARTNAME(N),IF(GETREF(N),DELETE(GETREF(N)),0):IF(GETVAL(N),DELETE(GETVAL(N)),0):DELETE(N):MARK(O),0):OBJECTS(-1)'; objets=result
		doublets=doublets+1
	    end
	    if i>=objets-1 then i=0
	    else i=i+1
	end
    end
    i=1
    do while i>0
	'O=FINDOBJ('i',1,-1,-1)'; i=result
	if i>0 then do
	    'GETREF(O)'; r=result
	    if r>0 then do
		'D=FINDREF('i+1',READTEXT(GETREF(O)))'; d=result
		if d>0 then do
		    'MARK(O,D):MESSAGE("Warning: reference"+CHR(10)+READTEXT(GETREF(O))+CHR(10)+"is used twice!")'
		end
	    end
	    if i>=objets-1 then i=0
	    else i=i+1
	end
    end
    'UNLOCK(-1)'
return

test_connexions:
    'LOCK(-1):TITLE("Checking junctions to components..."):UNMARK(-1)'
    i=1
    do while i>0
	'O=FINDOBJ('i',1,-1,-1)'; i=result
	if i>0 then do
	    'PARTNAME(O)'
	    'DEVPINS(O)'; j=result
	    do k=1 to j
		if connexion_broche(i,k)=0 then do
		    'MARK(O):REQUEST("Warning object 'i'"+CHR(10)+"("+PARTNAME(O)+")"+CHR(10)+"located in "+STR(COL(O))+" "+STR(LINE(O))+CHR(10)+"have his pin "+STR(IF(PINNUM(O,'k'),PINNUM(O,'k'),'k'))+" not connected"+CHR(10)+"Do you want to continue?")'
		    if result<1 then do
			'UNLOCK(-1)'
			return
		    end
		    'UNMARKCOMP(O)'
		    errconx=errconx+1
		end
	    end
	    if i=objets then leave
	    i=i+1
	end
    end
    'UNLOCK(-1)'
return

test_liaisons:
    'LOCK(-1):TITLE("Looking for unused lines...")'
    i=1
    do while i>0
	'O=FINDOBJ('i',2,-1,-1)'; i=result
	if i>0 then do
	    'IF((COL(O)==ENDCOL(O))&(LINE(O)==ENDLINE(O)),DELETE(O),0)'
	    if result>0 then do
		objets=result
		eliminations=eliminations+1
	    end
	    else if i<objets then do
		'IF(COL(O)==ENDCOL(O),1,IF(LINE(O)==ENDLINE(O),2,0))'
		if result=1 then do
		    l=i+1
		    do while l>0
			'L=FINDOBJ('l',2,COL(O),-1)'; l=result
			if l>0 then do
			    'IF(COL(L)==ENDCOL(L),COORDS(O)+","+COORDS(L),"")'
			    if result~="" then do
				parse var result x0','y0','x1','y1','x2','y2','x3','y3
				y4=min(y0,y1)
				y5=max(y0,y1)
				y6=min(y2,y3)
				y7=max(y2,y3)
				if y4<y7 & y5>y6 then call modifier_lignes(x0,min(y4,y6),x0,max(y5,y7))
				else if y4=y7 then do
				    'FINDOBJ(1,7,'x0','y4')'
				    if result=0 then call modifier_lignes(x0,y6,x0,y5)
				end
				else if y5=y6 then do
				    'FINDOBJ(1,7,'x0','y5')'
				    if result=0 then call modifier_lignes(x0,y4,x0,y7)
				end
			    end
			end
			if l>0 then do
			    if l>=objets then l=0
			    else l=l+1
			end
		    end
		end
		else if result=2 then do
		    l=i+1
		    do while l>0
			'L=FINDOBJ('l',2,-1,LINE(O))'; l=result
			if l>0 then do
			    'IF(LINE(L)==ENDLINE(L),COORDS(O)+","+COORDS(L),"")'
			    if result~="" then do
				parse var result x0','y0','x1','y1','x2','y2','x3','y3
				x4=min(x0,x1)
				x5=max(x0,x1)
				x6=min(x2,x3)
				x7=max(x2,x3)
				if x4<x7 & x5>x6 then call modifier_lignes(min(x4,x6),y0,max(x5,x7),y0)
				else if x4=x7 then do
				    'FINDOBJ(1,7,'x4','y0')'
				    if result=0 then call modifier_lignes(x6,y0,x5,y0)
				end
				else if x5=x6 then do
				    'FINDOBJ(1,7,'x5','y0')'
				    if result=0 then call modifier_lignes(x4,y0,x7,y0)
				end
			    end
			end
			if l>0 then do
			    if l>=objets then l=0
			    else l=l+1
			end
		    end
		end
	    end
	    if i>=objets-1 then i=0
	    else i=i+1
	end
	else leave
    end
    'UNLOCK(-1)'
return

afficher_erreurs:
    if eliminations=0 & modifs=0 & errrefs=0 & errvals=0 & errconx=0 & doublets=0 then 'MESSAGE("Checking ended"+CHR(10)+"No error found")'
    else do
	t=""
	if eliminations>0 then t=eliminations||" unused lines deleted"
	if modifs>0 then do
	    if t~="" then t=t||'0a'x||modifs||" modified lines"
	    else t=modifs||" modified lines"
	end
	if errrefs>0 then do
	    if t~="" then t=t||'0a'x||errrefs||" missing references"
	    else t=errrefs||" missing references"
	end
	if errvals>0 then do
	    if t~="" then t=t||'0a'x||errvals||" missing values"
	    else t=errvals||" missing values"
	end
	if errconx>0 then do
	    if t~="" then t=t||'0a'x||errconx||" missing connexions"
	    else t=errconx||" missing connexions"
	end
	if doublets>0 then do
	    if t~="" then t=t||'0a'x||doublets||" deleted objects"
	    else t=doublets||" deleted objects"
	end
	'MESSAGE("'t'")'
    end
    return

modifier_lignes:
    parse arg xd,yd,xf,yf
    'DRAWMODE(1):DELETE(L):DELETE(O):MARK(DRAW('xd','yd','xf','yf'))'
    objets=objets-1
    i=0; l=0
    modifs=modifs+1
    return

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
    if xl>0 then return xl
    'FINDLINE(1,'xj','yj')'; xl=result
    if xl<=0 then return 0
    'FINDOBJ(1,7,'xj','yj')'
    if result>0 then return xl
    return 0

min: procedure
    parse arg v1,v2
    if v1<v2 then return v1
    return v2

max: procedure
    parse arg v1,v2
    if v1>v2 then return v1
    return v2

syntax:
erreur=RC
'MESSAGE("Script TestNets.AmiCAD"+CHR(10)+"Syntax error"+CHR(10)+"in line 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
exit

error:
'MESSAGE("Script TestNets.AmiCAD"+CHR(10)+"Error in line 'SIGL'")'
exit