/* Importation d'un texte dans une zone rectangulaire
   26 avril 1998: version 1.00
   3 Février 1999: version 1.01 (correction bug guillemets + gestion ligne)
   21 février 1999: version 1.02 (modif appel REQFILE)
   5 Janvier 2000: version 1.03 (utilisation GETZONE, traitement coupure lignes trop longues)
   13 avril 2000: version 1.04 (adaptation version 205)
   $VER: ImportTexte 1.04 (© R.Florac, 13 avril 2000)
   Bug: ne gère pas les échelles et le mode placement courants */

options results

signal on error
signal on syntax

xg=-1; xd=0; yh=0; yb=0
'FIRSTSEL'; obj=result
if obj>0 then do
    'TYPE('obj')'
    if result=22 then do
	'NEXTSEL('obj')'
	if result=0 then do
	    'COORDS('obj')';
	    PARSE VAR result x0 ',' y0 ',' x1 ',' y1
	    xg=minima(x0,x1); xd=maxima(x0,x1)
	    yh=minima(y0,y1); yb=maxima(y0,y1)
	end
    end
end

if xg=-1 then do
    'GETZONE("Dessinez la zone où placer le texte")'
    z=result
    if z="" then exit
    PARSE VAR z x0 ',' y0 ',' x1 ',' y1
    xg=minima(x0,x1); xd=maxima(x0,x1)
    yh=minima(y0,y1); yb=maxima(y0,y1)
end

'REQFILE("Nom du fichier texte?", "Travail:texte/ASCII", "")'; fichier=result
y0=yh
if fichier ~= "" then do
    if open(file, fichier, 'R') then do
	y0=y0+10
	'SAVEALL'
	do while ~eof(file)
	    ligne=readln(file)
	    if ligne ~= "" then do
		ligne=translate(ligne,"        ",'09'x)
		ligne=doublage_guillemets(ligne)
		t=words(ligne)
		p=1
		n=t
		if t=1 then do	    /* il y a un seul mot à écrire */
		    'WRITE("'ligne'",'xg','y0')'
		    call ligne_suivante
		end
		else
		do while p<=t
		    mot=subword(ligne,p,n)
		    'TXWIDTH("'mot'")'
		    l=result
		    if l>=xd-xg then do
			n=n-1
		    end
		    else do
			'WRITE("'mot'",'xg','y0')'
			call ligne_suivante
			p=p+n
			n=t-n
		    end
		end
	    end
	end
	close(file)
    end
end
exit

ligne_suivante:
    y0=y0+10
    if y0>=yb then do
	'MESSAGE("Zone trop petite pour"+CHR(10)+"placer tout le texte")'
	close(file)
	exit
    return

minima: procedure
    parse arg v1,v2
    if v1<v2 then return v1
    return v2
end

maxima: procedure
    parse arg v1,v2
    if v1>v2 then return v1
    return v2
end

doublage_guillemets: procedure
    parse arg chaine
    t=''
    do i=1 to length(chaine)
	c = substr(chaine,i,1)
	if c='"' then c=c||'"'
	t=t||c
    end
    return t

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

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