/* Script permettant d'ajouter un arc à deux lignes qui
   se croisent avec un angle droit.
   Version 1.00: 20 octobre 2001
   Version 1.01: 2 décembre 2001 (localisation anglais)
   Version 1.02, 03-Feb-2002, German localization by A. Greve
     You can now pass an argument to this script, containing
     the radius (in 1/1000mm) for the rounding. If the value
     is not numeric, not integer, or < 1, the value will be
     set to 2540 (= 2,54mm).
   Version 1.03, 14-Apr-2002, by A. Greve
     If You pass "-1" as an argument to this script, a requester
     appears where You can select one out of 16 predefined
     roundings between 0,635 and 10,16mm (1/40" steps). If You
     select the topmost entry ("Enter manually" in English) from
     this list, a numeric requester appears where You can enter
     a numeric value for the rounding. A value <= 0 will cancel
     this input like the "Cancel" button does.

   $VER: Arrondir.AmiPCB 1.03, © R.Florac 02-Apr-2002
*******************************************************/

PARSE ARG radius
IF VERIFY(radius,"-0123456789") > 0 THEN radius = 2540
IF radius < 1 THEN DO
    IF radius ~= -1 THEN radius = 2540
END

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'()

'FINDOBJ(0,-TRACK,-1,-1)'
l1=result
'FINDOBJ('l1',-TRACK,-1,-1)'
l2=result
if l1<1 | l2<1 then do
    select
	when fr=1 then 'MESSAGE("Sélectionner les deux lignes'lf'dont l''angle doit être arrondi'lf'avant d''appeler ce script.")'
	when fr=2 then 'MESSAGE("Wählen Sie die beiden Linien, deren'lf'gemeinsamer Winkel gerundet werden soll,'lf'vor dem Aufruf dieses Skripts.")'
	otherwise      'MESSAGE("Select the two lines'lf'whose common angle must be rounded'lf'before calling this script.")'
    end
    exit
end

'COORDS('l1')'
parse var result x0 ',' y0 ',' x1 ',' y1
'COORDS('l2')'
parse var result x2 ',' y2 ',' x3 ',' y3
if x0=x2 & y0=y2 then do
    a=test_angle(x0,x1,x2,x3,y0,y1,y2,y3)
    if a=-1 then signal no_rightangle
    xc=x0
    yc=y0
end
else if x0=x3 & y0=y3 then do
    a=test_angle(x0,x1,x2,x3,y0,y1,y2,y3)
    if a=-1 then signal no_rightangle
    xc=x0
    yc=y0
end
else if x1=x2 & y1=y2 then do
    a=test_angle(x0,x1,x2,x3,y0,y1,y2,y3)
    if a=-1 then signal no_rightangle
    xc=x1
    yc=y1
end
else if x1=x3 & y1=y3 then do
    a=test_angle(x0,x1,x2,x3,y0,y1,y2,y3)
    if a=-1 then signal no_rightangle
    xc=x1
    yc=y1
end
else do
    select
	when fr=1 then 'MESSAGE("Les deux lignes n''ont'lf'pas de point commun.'lf'Il est impossible d''arrondir l''angle")'
	when fr=2 then 'MESSAGE("Die beiden Linien haben keinen gemeinsamen Punkt.'lf'Es ist nicht möglich, einen Winkel zu runden.")'
	otherwise      'MESSAGE("The two lines don''t'lf'have a common point.'lf'It''s impossible to round any angle")'
    end
    exit
end

IF radius = -1 THEN DO
    SELECT
	WHEN fr=1 THEN DO
	    msg = "Quelle de rayon ?"
	    msgx = "Entrez manuelle"
	    msgy = "Entrez un nombre"
	END
	WHEN fr=2 THEN DO
	    msg = "Welcher Radius ?"
	    msgx = "Manuelle Eingabe"
	    msgy = "Zahl eingeben"
	END
	OTHERWISE DO
	    msg = "Which radius ?"
	    msgx = "Enter manually"
	    msgy = "Enter a number"
	END
    END
    msgy = msgy||' > 0'||lf||' (2540 = 2,54mm)'
    msg0  = msgx
    msg1  = " 0,635 mm  -  0,025 in."; g.1 =    635
    msg2  = " 1,270 mm  -  0,050 in."; g.2 =   1270
    msg3  = " 1,905 mm  -  0,075 in."; g.3 =   1905
    msg4  = " 2,540 mm  -  0,100 in."; g.4 =   2540
    msg5  = " 3,175 mm  -  0,125 in."; g.5 =   3175
    msg6  = " 3,810 mm  -  0,150 in."; g.6 =   3810
    msg7  = " 4,445 mm  -  0,175 in."; g.7 =   4445
    msg8  = " 5,080 mm  -  0,200 in."; g.8 =   5080
    msg9  = " 5,715 mm  -  0,225 in."; g.9 =   5715
    msg10 = " 6,350 mm  -  0,250 in."; g.10 =  6350
    msg11 = " 6,985 mm  -  0,275 in."; g.11 =  6985
    msg12 = " 7,620 mm  -  0,300 in."; g.12 =  7620
    msg13 = " 8,255 mm  -  0,325 in."; g.13 =  8255
    msg14 = " 8,890 mm  -  0,350 in."; g.14 =  8890
    msg15 = " 9,525 mm  -  0,375 in."; g.15 =  9525
    msg16 = "10,160 mm  -  0,400 in."; g.16 = 10160
    'REQLIST("'msg'","'msg0'","'msg1'","'msg2'","'msg3'","'msg4'","'msg5'","'msg6'","'msg7'","'msg8'","'msg9'","'msg10'","'msg11'","'msg12'","'msg13'","'msg14'","'msg15'","'msg16'")'
    c = RESULT
    IF c < 1 THEN EXIT    /* Cancelled */
    IF c = 1 THEN DO
	'REQNUM("'msgy'",0,"VALIDE")'
	IF valide = 1 THEN DO
	    manualin = RESULT
	    IF manualin > 0 THEN radius = manualin
	    ELSE EXIT
	END
	ELSE EXIT
    END
    ELSE DO
	c = c - 1
	radius = g.c
    END
END

xmini=min(x0,x1,x2,x3)
xmaxi=max(x0,x1,x2,x3)
ymini=min(y0,y1,y2,y3)
ymaxi=max(y0,y1,y2,y3)
'SAVEALL:SETWIDTH(0,SETWIDTH('l1',-1)):SETSIDE(0,SETSIDE('l1',0)):DELETE('l1'):DELETE('l2')'
if xc=xmini then do
    if yc=ymini then do
	'ARC('xc'+'radius','yc'+'radius','radius','radius',3):DRAW('xc','yc'+'radius','xc','ymaxi'):DRAW('xc'+'radius','yc','xmaxi','yc')'
	exit
    end
    'ARC('xc'+'radius','yc'-'radius','radius','radius',2):DRAW('xc','yc'-'radius','xc','ymini'):DRAW('xc'+'radius','yc','xmaxi','yc')'
    exit
end
if yc=ymini then do
    'ARC('xc'-'radius','yc'+'radius','radius','radius',0):DRAW('xc'-'radius','yc','xmini','yc'):DRAW('xc','yc'+'radius','xc','ymaxi')'
    exit
end
'ARC('xc'-'radius','yc'-'radius','radius','radius',1):DRAW('xc'-'radius','yc','xmini','yc'):DRAW('xc','yc'-'radius','xc','ymini')'
exit

test_angle:
    parse arg x0,x1,x2,x3,y0,y1,y2,y3
    if x0=x1 & y2=y3 then return 1
    if y0=y1 & x2=x3 then return 2
    return -1

no_rightangle:
    select
	when fr=1 then 'MESSAGE("Les deux lignes ne'lf'forment pas un angle droit.'lf'Il est impossible d''arrondir l''angle")'
	when fr=2 then 'MESSAGE("Die beiden Linien haben keinen 90°-Winkel.'lf'Es ist nicht möglich, den Winkel zu runden.")'
	otherwise      'MESSAGE("The two lines don''t'lf'do an angle of 90°.'lf'It''s impossible to round the angle")'
    end
    exit

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

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