Turbo Toolbox/Turbo_Toolbox.iso/1988/03/feldline.pas

Pascal/Delphi Source File | 1988-01-06 | 9.7 KB | 319 lines

(* ----------------------------------------------------------------------- *)
(*                              FELDLINE.PAS                               *)

PROGRAM Feldlinien;

CONST Pi     = 3.1415627;
      e0     = 8.85E-12;
      anzahl = 100;
      xmax   = 639;
      ymax   = 199;

TYPE point = RECORD  x,y :REAL;  END;

VAR maus_x,maus_y,anz_p,anz_n    :INTEGER;
    maus_l,maus_r,maus_b,abbruch :BOOLEAN;
    plus,minus,temp              :ARRAY [0..anzahl] OF point;
    minus_p                      :ARRAY [0..anzahl] OF BOOLEAN;
    er,q,fak,fx,fy,f,vektor,l    :REAL;
    anz_lad                      :INTEGER;

(*$i GRAPH.P *)                         (* wird von Turbo Pascal benoetigt *)

(* ----------------------------------------------------------------------- *)
(*                      Ermittlung der neuen Cursorposition                *)

PROCEDURE Maus;

VAR puffer :ARRAY [1..8,1..8] OF BYTE;
    taste  :CHAR;

BEGIN
  taste := ' ';  maus_l := FALSE;  maus_r := FALSE;  maus_b := FALSE;
  WHILE NOT (taste IN ['.','-',',']) DO BEGIN
    IF maus_x < 0 THEN maus_x  := 0;
    IF maus_x > 632 THEN maus_x  := 632;
    IF maus_y < 0 THEN maus_y := 0;
    IF maus_y > 192 THEN maus_y := 192;
                        (* Bildschirminhalt unter Cursor in Puffer sichern *)
    getpic(puffer,maus_x,maus_y,maus_x+7,maus_y+7);
                                      (* ... und Cursor als Pfeil zeichnen *)
    draw(maus_x,maus_y+7,maus_x+7,maus_y,1);
    draw(maus_x+7,maus_y+1,maus_x+3,maus_y+2,1);
    draw(maus_x+6,maus_y+1,maus_x+7,maus_y+2,1);
    WHILE NOT KeyPressed DO;                     (* auf Tastendruck warten *)
    WHILE KeyPressed DO Read (Kbd,taste);         (* Tastaturpuffer leeren *)
                              (* alten Bildschirminhalt wieder herstellen: *)
    putpic(puffer,maus_x,maus_y+7);
    CASE UpCase(taste) OF              (* "UpCase" liefert Grossbuchstaben *)
      'F': maus_x := maus_x + 1;
      'G': maus_x := maus_x + 16;
      'S': maus_x := maus_x - 1;
      'A': maus_x := maus_x - 16;
      'E': maus_y := maus_y - 1;
      '4': maus_y := maus_y - 8;
      'C': maus_y := maus_y + 1;
      'X': maus_y := maus_y + 8;
      ELSE;
    END;
  END;
  IF taste = '.' THEN maus_l := TRUE
  ELSE IF taste = '-' THEN maus_r := TRUE
  ELSE IF taste = ',' THEN maus_b := TRUE;
END;

(* ----------------------------------------------------------------------- *)
(*                         zeichnet Kreis mit r = 4                        *)

PROCEDURE Kreis (mx,my :INTEGER);

CONST r  =  4;

VAR alpha     :REAL;
    x,y,ax,ay :INTEGER;

BEGIN
  ax := mx-2*r;  ay := my;  alpha := -Pi;
  WHILE alpha <= Pi DO BEGIN
    x := mx+Trunc(2*r*Sin(alpha));
    y := my+Trunc(r*Cos(alpha));
    draw(ax,ay,x,y,1);
    ax := x;  ay := y;
    alpha := alpha+Pi/4;
  END;
END;

(* ----------------------------------------------------------------------- *)
(*                         zeichnet positive Ladung                        *)

PROCEDURE Dr_Plus (mx,my :INTEGER);

BEGIN
  Kreis(mx,my);
  draw(mx-2,my,mx+2,my,1);
  draw(mx,my-1,mx,my+1,1);
END;

(*                         zeichnet negative Ladung                        *)

PROCEDURE Dr_Minus (mx,my :INTEGER);

BEGIN
  Kreis(mx,my);
  draw(mx-2,my,mx+2,my,1);
END;

(* ----------------------------------------------------------------------- *)
(*                           Bedienungsanleitung                           *)

PROCEDURE Erklaerung;

BEGIN
  ClrScr;                                           (* Bildschirm loeschen *)
  WriteLn('***************************************',
          '***************************************');
  WriteLn;
  WriteLn('      F e l d l i n i e n  1.0       ',
          '(C) 1988  Michael Smy & PASCAL INT.');
  WriteLn;
  WriteLn('***************************************',
          '***************************************');
  WriteLn;
  WriteLn('Dieses Programm stellt die Feldlinien eines',
          ' elektrischen Feldes dar. Es können');
  WriteLn('beliebig viele positive und negative Ladungen',
          ' mit einem Graphik-Cursor eingege-');
  WriteLn('ben  werden. Dieser wird folgendermaßen bedient:');
  WriteLn;
  WriteLn('                                      4 - schnell nach oben');
  WriteLn;
  WriteLn('                                      e - langsam nach oben');
  WriteLn;
  WriteLn('           schnell nach links - a   s   f   g -',
          ' schnell nach rechts');
  WriteLn('                langsam nach links /     \ langsam nach rechts');
  WriteLn('                                      c - langsam nach unten');
  WriteLn;
  WriteLn('                                      x - langsam nach oben');
  WriteLn;
  WriteLn('"." ergibt eine positive Ladung, "-" eine negative.');
  WriteLn('"," beendet die eingabe und leitet die Berechnung ein.');
  WriteLn;
  Write('Dielektrizitätszahl des Mediums (Luft: 1)  ? ');  ReadLn(er);
  WriteLn;
  Write('Gewünschte Ladung einer Einzelladung in Cb ? ');  ReadLn(q);
  q := q*q;
  WriteLn;
  Write('Grundlänge des zu berechnenden Kraftvektor ? ');  ReadLn(vektor);
  WriteLn;
  REPEAT
    Write('Wieviele Probeladungen sollen pro Ladung abgeschickt werden ? ');
    ReadLn(anz_lad);
  UNTIL anz_lad >= 1;
  IF 4 * Pi * e0 * er = 0 THEN Erklaerung ELSE fak := q/(4*Pi*e0*er);
END;

(* ----------------------------------------------------------------------- *)
(*                      Eingabe der Ladungsverteilung                      *)

PROCEDURE eingabe;

BEGIN
  hires;                                       (* Graphik-Modus aktivieren *)
  anz_p := 0;  anz_n := 0;
  Maus;
  WHILE NOT maus_b DO BEGIN
    IF maus_l THEN BEGIN
      Dr_Plus(maus_x+7,maus_y);
      plus[anz_p].x := maus_x+7;
      plus[anz_p].y := maus_y;
      anz_p := anz_p+1;
    END
    ELSE IF maus_r THEN BEGIN
      Dr_Minus(maus_x+7,maus_y);
      minus[anz_n].x := maus_x+7;
      minus[anz_n].y := maus_y;
      minus_p[anz_n] := FALSE;
      anz_n := anz_n+1;
    END;
    Maus;
  END;
  anz_p := anz_p-1;
  anz_n := anz_n-1;
END;

(* ----------------------------------------------------------------------- *)
(*                      Berechnung der Kraft auf Ladung                    *)

PROCEDURE kraft (positiv: BOOLEAN; p: point);

VAR r,r3,h_x,h_y :REAL;
    iii          :INTEGER;

BEGIN
  fx := 0;  fy := 0;
  FOR iii := 0 TO anz_p DO BEGIN
    h_x := plus[iii].x-p.x;  h_y := plus[iii].y-p.y;
    r := Sqrt(h_x*h_x+h_y*h_y);  r3 := r*r*r;
    IF r <> 0 THEN
      IF positiv THEN BEGIN
        fx := fx-fak*h_x/r3;  fy := fy-fak*h_y/r3;
      END
      ELSE BEGIN
        fx := fx-fak*h_x/r3;  fy := fy-fak*h_y/r3;
      END;
    IF NOT positiv THEN
      IF r <= vektor THEN abbruch := TRUE;
  END;
  FOR iii := 0 TO anz_n DO BEGIN
    h_x := minus[iii].x-p.x;  h_y := minus[iii].y-p.y;
    r := Sqrt(h_x*h_x+h_y*h_y);  r3 := r*r*r;
    IF r <> 0 THEN
      IF positiv THEN BEGIN
        fx := fx+fak*h_x/r3;  fy := fy+fak*h_y/r3;
      END
      ELSE BEGIN
        fx := fx-fak*h_x/r3;  fy := fy-fak*h_y/r3;
      END;
    IF positiv THEN
      IF r <= l THEN BEGIN
        abbruch := TRUE;
        minus_p[iii] := TRUE;
      END;
  END;
  f := Sqrt(fx*fx+fy*fy);
END;

(* ----------------------------------------------------------------------- *)
(*                   Zeichnen einer Linie von p1 nach p2                   *)
PROCEDURE Line (p1,p2: point);

BEGIN
  draw(Trunc(p1.x),Trunc(p1.y),Trunc(p2.x),Trunc(p2.y),1);
END;

(* ----------------------------------------------------------------------- *)
(*                    Zeichnen des Wegs einer Probeladung                  *)

PROCEDURE zeichne (posneg: BOOLEAN; start :point);

VAR i          :INTEGER;
    pr,vor,alt :point;
    f_alt      :REAL;

BEGIN
  l := vektor;
  pr.x := start.x;
  pr.y := start.y;
  WHILE (pr.x >= 0) AND (pr.x <= xmax) AND (pr.y >= 0) AND (pr.y <= ymax)
  AND NOT abbruch DO BEGIN
    kraft(posneg,pr);
    IF f < 1E-9 THEN pr.x := -1
    ELSE BEGIN
      vor.x := pr.x+fx*l/2/f;
      vor.y := pr.y+fy*l/2/f;
      f_alt := f;
      kraft(posneg,vor);
      IF f < 1E-9 THEN pr.x := -1
      ELSE BEGIN
        alt.x := pr.x+fx*l/f;
        alt.y := pr.y+fy*l/f;
        Line(pr,alt);
        pr.x := alt.x;  pr.y := alt.y;
        IF f <> f_alt THEN l := vektor*1e8*l/2/abs(f-f_alt)
        ELSE l := vektor*2;
        IF l < vektor/2 THEN l := vektor/2;
        IF l > vektor*2 THEN l := vektor*2;
      END;
    END;
  END;
END;

(* ----------------------------------------------------------------------- *)
(*                  Berechnen und Zeichnen der Feldlinien                  *)

PROCEDURE berechnung;

VAR i,ii    :INTEGER;
    pr,alt  :point;
    sal,cal :REAL;
    poslad  :BOOLEAN;

  PROCEDURE rechne;
  BEGIN
    kraft(poslad,plus[i]);
    IF f <> 0 THEN BEGIN
      alt.x := fx*5/f;
      alt.y := fy*5/f;
      FOR ii := 1 TO anz_lad DO BEGIN
        abbruch := FALSE;
        pr.x := temp[i].x+alt.x;  pr.y := temp[i].y+alt.y;
        zeichne(poslad,pr);
        pr.x := alt.x*cal-alt.y*sal;
        pr.y := alt.x*sal+alt.y*cal;
        alt.x := pr.x;
        alt.y := pr.y;
      END;
    END;
  END;

BEGIN
  sal := Sin(2*Pi/anz_lad);  cal := Cos(2*Pi/anz_lad);
  temp := plus;              poslad := TRUE;
  FOR i := 0 TO anz_p DO rechne;
  temp := minus;             poslad := FALSE;
  FOR i := 0  TO anz_n DO
    IF NOT(minus_p[i]) THEN rechne;
END;

(* ----------------------------------------------------------------------- *)

BEGIN (* Feldlinien *)
  maus_x := 319;  maus_y := 99;
  Erklaerung;
  eingabe;
  berechnung;
  WHILE NOT KeyPressed DO;                       (* auf Tastendruck warten *)
  textmode;
END.