{ etpro.pas (C) Kenrou Adachi, 1993-2004 }

program etpro(input, output);

uses  graphics;

var
    x, y, xx, yy : array[1..40] of real;

{$I a:\work\turbo\etude\fun.pas}

procedure inputdata(var a, b, eps : real; var m, l :integer);
begin
    writeln('ｘ軸の範囲[-a,a]とｙ軸の範囲[-b,b]を入力して下さい。');
    write(' a = ? ');
    readln(a);
    write(' b = ? ');
    readln(b);
    writeln('精度の限界値 eps(=0.01~0.1)を入力して下さい。 ');
    write('eps= ? ');
    readln(eps);
    writeln('描画の回数を入力して下さい。');
    write(' n = ? ');
    readln(m);
    writeln('計算の回数 count を入力して下さい。');
    write('count= ? ');
    readln(l)
end;

procedure axes;
begin
    setcolor(BLUE);
    line(0, 200, 640, 200);
    line(320, 0, 320, 400)
end;

procedure process(var a, b, eps, h : real; e :real);
var
     j : integer;
     x0, y0, r0, x1, y1, r1, wx0, wy0, wx1, wy1 : real;
     u, v, u1, v1, q, q_h : real;
begin
    for j := 1 to 40 do
    begin
        x0 := x[j];
        y0 := y[j];
        if (abs(x0) <= 2.0 * a) and (abs(y0) <= 2.0 * b) then
        begin
            r0 := sqrt(x0 * x0 + y0 * y0);
            if (r0 >= h) then
            begin
                u := fx(x0, y0, r0);
                v := gy(x0, y0, r0);
                q := sqrt(u * u + v * v);
                if (q >= eps) then
                begin
                    q_h := h / q;
                    x1 := x0 + 0.5 * e * u * q_h;
                    y1 := y0 + 0.5 * e * v * q_h;
                    r1:= sqrt(x1 * x1 + y1 * y1);
                    u1 := fx(x1, y1, r1);
                    v1 := gy(x1, y1, r1);
                    x[j] := x0 + e * u1 * q_h;
                    y[j] := y0 + e * v1 * q_h;
                    wx0 := 320.0 * x0 / a;
                    wy0 := 200.0 * y0 / b;
                    wx1 := 320.0 * x[j] / a;
                    wy1 := 200.0 * y[j] / b;
                    line(round(wx0 + 320.0), round(200.0 - wy0),
                         round(wx1 + 320.0), round(200.0 - wy1))
                end
            end
        end
    end
end;


procedure drawing(a, b, eps, h : real; l : integer);
var j, count : integer;
    rnd, e1, e2, e : real;
begin
    randomize;
    j := 0;
    e1 := -1.0;
    while (e1 <= 0.9) do
    begin
        e2 := -1.0;
        while (e2 <= 0.9) do
        begin
            rnd := random;
            xx[j] := a * (e1 + 0.25 * rnd);
            rnd := random;
            yy[j] :=b *(e2 + 0.4 * rnd);
            e2 := e2 + 0.4;
            j := j + 1
        end;
        e1 := e1 + 0.25
    end;
    e := 1.0;
    repeat
        for j := 1 to 40 do
        begin
            x[j] := xx[j];
            y[j] := yy[j]
        end;

        if (e > 0) then
            setcolor(GREEN)
        else
            setcolor(RED);

        for count := 1 to l do
        begin
            process(a, b, eps, h, e);
        end;
        e := -e;
    until (e > 0)
end;


  { main }

var
    a, b, eps, h : real;
    m, l, n      : integer;
begin
    cleartextscreen;
    inputdata(a, b, eps, m, l);
    ginit;
    h := sqrt((a / 320.0) * (a / 320.0) +( b / 200.0) * (b / 200.0));
    axes;
    for n := 1 to m do
    begin
        drawing(a, b, eps, h, l);
    end;
    writeln('終了しました。');
    writeln('任意のキーを押して下さい。');
    readln
end.