::::::::::::::
APFEL.PAS
::::::::::::::
program Apfelmaennchen;
uses
  graph,crt;
type
  speichertyp=array[0..639] of byte;
var
  speicher:speichertyp;
  farbe,graphdriver,graphmode:integer;
  x,y:integer;
  betrag,xrech,yrech,xzwischen,yzwischen,xkurzzwischen:real;
   apfeldat:file of speichertyp;
begin
   assign(apfeldat,'c:\tp\private.pro\apfeldat');
   rewrite(apfeldat);
   close(apfeldat);
  graphdriver:=detect;
  initgraph(graphdriver,graphmode,'c:\tp');
      speicher[x]:=0;;
      y:=0;
      x:=0;
   repeat
    repeat
      speicher[x]:=0;
      xrech:=x/640-0.5;
      yrech:=y/480-1.5;
      xzwischen:=xrech;
      yzwischen:=yrech;
      repeat
      inc  (speicher[x]);
      xkurzzwischen:=xzwischen;
      xzwischen:=xzwischen*xzwischen-yzwischen*yzwischen+xrech*yrech;
      yzwischen:=1.5*yzwischen*xkurzzwischen+yrech*xrech;
      betrag:=sqrt(xzwischen*xzwischen+yzwischen*yzwischen);  {Algorithmus}
      until (betrag>2) or (speicher[x]=100);
      speicher[x]:=speicher[x]*5;
      case speicher[x] of
      1     :farbe:=0;
      2..5 :farbe:=1;
      6..10:farbe:=2;
      11..15:farbe:=3;
      16..20:farbe:=4;
      21..25:farbe:=5;
      26..30:farbe:=6;
      31..35:farbe:=7;
      36..40:farbe:=8;
      41..50:farbe:=9;
      51..60:farbe:=10;
      61..70:farbe:=11;
      71..80:farbe:=12;
      81..90:farbe:=13;
      91..99:farbe:=13;
      100   :farbe:=15;
      end;
      putpixel(x,y,farbe);
      inc(x,6);
      until (x>639) or (keypressed);
   assign(apfeldat,'c:\tp\private.pro\apfeldat');
   reset(apfeldat);
   seek(apfeldat,filesize(apfeldat));
   write(apfeldat,speicher);
   close(apfeldat);
   inc(y,5);
   x:=0;
     until (y>479) or (keypressed);
  repeat until keypressed;
  end.


::::::::::::::
FOURIERR.PAS
::::::::::::::
program Fourierreihen;

uses
 crt,
 mathe,
 privat,
 graph;
const
 aufl=939;
var
 l:real;
 f: array[0..aufl,0..2] of real;
 t,k,n,a:integer;
 punkt,tplot:longint;
 kstring,eingabe:string;
begin
 eingabe:='z';
 a:=1;
 l:=2*pi;
 grafitti350;
 for n:= 0 to aufl do f[n,0]:=(l-2*a)/l;
 setvisualpage(1);
 k:=1;
 repeat
  t:=0;
  f[k,2]:=-2*sin(k*a*2*pi/l)/k/pi;
  repeat
   f[t,1]:=f[t,0]+f[k,2]*cos(k*2*pi*(t*(640/(aufl+1)))/50/l);
   f[t,0]:=f[t,1];
   t:=t+1;
  until t>aufl;
  setactivepage (1);
  settextstyle(1,0,2);
  t:=0;
  tplot:=0;
  cleardevice;
  outtextxy(100,300,'i fr INFO oder S ...');
  repeat
   if abs(f[t,1])<2147486.47 then
   begin
    punkt:=round(f[t,1]*200);
    putpixel(tplot,-punkt+250,15);
   end;
   t:=t+1;
   tplot:=round(t*(640/(aufl+1)));
  until t>aufl;
  setactivepage(0);
  cleardevice;
  outtextxy(200,300,'z fr zurck oder S ...');
  settextstyle(4,0,50);
  str(k,kstring);
  outtextxy(200,20,kstring);
  K:=k+1;
  if keypressed then
   begin
    eingabe:=readkey;
    if eingabe='i' then setvisualpage(0);
    if eingabe='z' then setvisualpage(1);
   end;
  until  eingabe='s';
end.::::::::::::::
RUNGE_KU.PAS
::::::::::::::
program Runge_Kutta_test;
uses crt,graph,privat;

const  dt=pi/180{1/640};


var
    fasym,ci,cp,speed,betasoll,beta,beta1,bita,bita1,alpha,tz,
    abwintbeta,abwintbita,t,fx1,fy1,fx2,fy2,y_zwischen,y1_zwischen:real;
    n:integer;
    zeichen :char;
    anzeige :array[1..4] of string;
    beta_zeichen :string;

procedure anfangswerte;
begin;
 tz:=0;
 t:=0;
 beta:=0;
 bita:=0;
 beta1:=0;
 bita1:=0;
 abwintbeta:=0;
 abwintbita:=0;
 y_zwischen:=0;
 y1_zwischen:=1;
 fx1:=1500;
 fy1:=2300;
 fx2:=1500;
 fy2:=2300;
 beta_zeichen := 'beta';
end;


function abl2fct(cpfct,cifct,abwintfct,t,betafct,beta1fct: real):real;
begin
 abl2fct:=-betafct{-sin(t)};
end;

procedure rk2(rk2_c1,rk2_c2,abwint,x,h:real; var y,y1:real);
{berechnet aus y(x), y1(x) die neuen Werte y(x+h), y1(x+h)
 und benutzt die Funktion abl2fct zur
 Berechnung der 2. Ableitung
 Keine universelle RUNGE-KUTTA-Prozedur sondern spez. Prozedur
 fuer den Fall, dass in die Formel f. d. 2. Ableitung
 die Parameter rk2_c1,rk2_c2 und abwint eingehen.
 s.o., Def. v. abl2fct }
var k1,k2,k3,k4:real;
begin
k1 := abl2fct(rk2_c1,rk2_c2,abwint, x,y,y1)*h/2;
k2 := abl2fct(rk2_c1,rk2_c2,abwint, x+h/2, y+(y1+k1/2)*h/2, y1+k1)*h/2;
k3 := abl2fct(rk2_c1,rk2_c2,abwint, x+h/2, y+(y1+k1/2)*h/2, y1+k2)*h/2;
k4 := abl2fct(rk2_c1,rk2_c2,abwint, x+h,   y+(y1+k3)*h,     y1+2*k3)*h/2;
y := y + y1*h + (k1+k2+k3)*h/2;
y1 := y1 + (k1+2*(k2+k3)+k4)/3;
{y := y + y1*h;}
y_zwischen:=y;
y1_zwischen:=y1;
   end;

procedure graph_zeichnen;
begin
 putpixel(round(tz),round(200-50*y_zwischen),15);
 tz:=tz+1;
 t:=t+dt;
end;

begin
 anfangswerte;
 grafitti;
 repeat
  graph_zeichnen;
  rk2(1,1,1,t,dt,y_zwischen,y1_zwischen);
 until (keypressed) or (tz>=640);
 wait;
end.::::::::::::::
HAUFEN.PAS
::::::::::::::
unit haufen;

interface

uses crt,graph;


const   nzl = 30;
        nsp = 62;
        nla = (nzl-1)*nsp;
        x_abstand = 10;
        y_abstand = 15;
        zeichenbreite = 7;
        zeichenhoehe = 8;
        

type
      t_haufen = object
                  t_sim,
                  i_max,
                  j_max,
                  x_max,
                  y_max,
                  i_neu,
                  i_start,
                  j_start           : integer;
                  zufall            : integer;
                  i,j               : integer;
                  lawinengroesse    : integer;
                  g                 : array[0..nzl,0..nsp] of byte;
                  lawinenstatistik  : array[0..nla] of longint;
                  zeile_unveraendert: boolean;
                  procedure bildschirm_loeschen;
                  procedure anfangswerte;
                  procedure zustandsuebergang;
                  procedure zeitschritt;
                  procedure haufen_anzeigen;
                  procedure lawienen_statistik_anzeigen;
                  procedure init;
                 end;

function  skala_einteilung(maximum:real) : integer;
procedure wait;

var graphdriver,graphmode : integer;

implementation

function skala_einteilung(maximum:real) : integer;

var  stellen   : integer;

begin
 stellen:=0;
 while maximum>1 do
 begin
  maximum:=maximum/10;
  stellen:=stellen+1;
 end;
 maximum:=round(maximum);
 if maximum=0 then maximum:=5*exp(stellen*ln(10))/100
  else maximum:=exp(stellen*ln(10))/10;
 skala_einteilung:=round(maximum);
end;



procedure grafitti;
begin
 graphdriver:=detect;
 initgraph(graphdriver,graphmode,'c:\tp\bgi');
end;


procedure wait;

var zeichen : char;

begin
 zeichen:=readkey ;
 repeat until keypressed;
 zeichen:=readkey ;
end;

procedure t_haufen.bildschirm_loeschen;
begin
 cleardevice;
end;


procedure t_haufen.anfangswerte;

var schleife_1,
    schleife_2   :integer;

begin
 setfillstyle(0,0);
 for schleife_1 :=0 to nzl do
  for schleife_2 :=0 to nsp do
  begin
   g[schleife_1,schleife_2]:=0;
   if (schleife_1=nzl) or (schleife_2=nsp) then
    g[schleife_1,schleife_2]:=1;
  end;
 for schleife_1 :=0 to nla do lawinenstatistik[schleife_1]:=0;
 i_start:=0;  { positiv  gerade }
 j_start:=0;
 i_max:=trunc(getmaxy/y_abstand)-1;
 j_max:=trunc(getmaxx/x_abstand)-1;
 x_max:=i_max*y_abstand;
 y_max:=j_max*x_abstand;
 t_sim:=0;
 i_neu:=nzl;
end;

procedure t_haufen.zustandsuebergang;

var g_str      : string;
    x,y        : integer;
    einrueck   : integer;
    j_und_1    : integer;

begin
 j_und_1:=((j+1) mod (nsp+1));
 if (g[i,j]=0) and (g[i-1,j]>0) and (g[i-1,j_und_1]>0) then
 begin
  zeile_unveraendert:=false;
  g[i,j]:=2;
  g[i-1,j]:=g[i-1,j]-1;
  g[i-1,j_und_1]:=g[i-1,j_und_1]-1;
  if odd(i) then einrueck:=trunc(x_abstand/2) else einrueck:=0;
  x:=x_abstand*(j-j_start)+einrueck;
  x:=((x+trunc((i-i_start)/2)*x_abstand) mod (nsp*x_abstand+1));
  y:=y_abstand*(i-i_start);
  if (x>=0) and (x=0) and (y0 then
   begin
    str(g[i-1,j],g_str);
    outtextxy(x-trunc(x_abstand/2),y-y_abstand,g_str);
   end;
   if g[i-1,j_und_1]<>0 then
   begin
    str(g[i-1,j_und_1],g_str);
    outtextxy(x+trunc(x_abstand/2),y-y_abstand,g_str);
   end;
   line(trunc(x+zeichenbreite/2),y,trunc(x+(-x_abstand+zeichenbreite)/2),
        y-y_abstand+zeichenhoehe);
   line(trunc(x+zeichenbreite/2),y,trunc(x+(x_abstand+zeichenbreite)/2),
        y-y_abstand+zeichenhoehe);
  end;
 end;
end;


procedure t_haufen.zeitschritt;

var x,y        : integer;
    g_str      : string;

begin
 t_sim:=t_sim+1;
 lawinengroesse:=0;
 zufall:=random(nsp+1);
 j:=zufall;
 if g[0,j]<2 then
 begin
  g[0,j]:=g[0,j]+1;
  x:=x_abstand*(j-j_start);
  if (x>=0) and (x=nsp-1;
  if j=nsp-1 then
  begin
   j:=nsp;
   t_haufen.zustandsuebergang;
  end;
  i:=i+1;
 until (i=nzl+1) or (zeile_unveraendert);
 i_neu:=i-1;
 lawinenstatistik[lawinengroesse]:=lawinenstatistik[lawinengroesse]+1;
end;


procedure t_haufen.haufen_anzeigen;

var g_str      : string;
    einrueck   : integer;

begin
{ cleardevice;}
 i:=0;
 repeat;
  j:=0;
  repeat;
   str(g[i+i_start,(( ((j+j_start-trunc(i/2)) mod (nsp+1))+nsp+1)
         mod (nsp+1))],g_str);
   if odd(i) then einrueck:=trunc(x_abstand/2) else einrueck:=0;
{   setcolor(0);                               }
   bar(x_abstand*j+einrueck,y_abstand*i,
       x_abstand*(j+1)+einrueck,y_abstand*(i+1));
{   setcolor(15);  }
   if g_str<>'0'then outtextxy(x_abstand*j+einrueck,y_abstand*i,g_str);
   j:=j+1;
  until (j>j_max) or (j>nsp);
  i:=i+1;
 until (i>i_max) or (i>nzl) or (i>i_neu);
end;


procedure t_haufen.lawienen_statistik_anzeigen;

const  x_pos      = 30;
       y_pos      = 450;

var    x,y        : integer;
       skalen_teil : integer;
       skala_str  : string;
       skala_x,
       skala_y    : real;
       x_achsen_laenge,
       y_achsen_laenge      : integer;
       max_lawine           : integer;
       max_lawinenengroesse : integer;

begin
 cleardevice;
 x:=0;                                  { Skala bestimmen }
 max_lawine:=1;
 max_lawinenengroesse:=0;
 repeat
  x:=x+1;
  if lawinenstatistik[x] > max_lawine then max_lawine:=lawinenstatistik[x];
  if lawinenstatistik[x] > 0 then max_lawinenengroesse:=x;
 until x=nla;
 x_achsen_laenge:=getmaxx-50;
 y_achsen_laenge:=getmaxy-40;

 if (max_lawinenengroesse>1) and (max_lawine>1) then
  else outtextxy(300,200,'Lawinen zu klein');
 begin
  skala_x:=(x_achsen_laenge)/ln(max_lawinenengroesse);
  skala_y:=(y_achsen_laenge)/ln(max_lawine);

  skalen_teil:=skala_einteilung(ln(max_lawinenengroesse)); {x-Achse zeichnen}
  line(x_pos,y_pos,x_pos+x_achsen_laenge,y_pos);
  pieslice(x_pos+x_achsen_laenge+10,y_pos,160,200,10);
  outtextxy(300,470,'Lawinengroesse');
  x:=0;
  repeat
   line(round(x*skala_x+x_pos),y_pos+5,round(x*skala_x+x_pos),y_pos);
   str(x,skala_str);
   outtextxy(round(x*skala_x+x_pos),y_pos+10,skala_str);
   x:=x+round(skalen_teil);
  until x*skala_x>x_achsen_laenge;

  skalen_teil:=skala_einteilung(ln(max_lawine));   {y-Achse zeichnen}
  line(x_pos,y_pos,x_pos,y_pos-y_achsen_laenge);
  pieslice(x_pos,y_pos-y_achsen_laenge-10,250,290,10);
  SetTextStyle(DefaultFont, vertDir,1);
  outtextxy(10,200,'Lawinenzahl');
  SetTextStyle(DefaultFont, HorizDir,1);
  y:=0;
  repeat
   line(x_pos-5,round(-y*skala_y+y_pos),x_pos,round(-y*skala_y+y_pos));
   str(y,skala_str);
   outtextxy(x_pos-15,round(-y*skala_y+y_pos),skala_str);
   y:=y+round(skalen_teil);
  until y*skala_y>y_achsen_laenge;

  x:=0;
  repeat
   x:=x+1;
   putpixel(x_pos+round(ln(x)*skala_x),
            y_pos-round(ln(lawinenstatistik[x]+1)*skala_y),15);
  until x=max_lawinenengroesse;
 end;
 i_neu:=nzl;
end;

procedure t_haufen.init;
begin
 grafitti;
 t_haufen.anfangswerte;
end;

end.::::::::::::::
AUTOPILO.PAS
::::::::::::::
program autopilot;
uses Crt,Graph,gr2;

const theta =1;
      dt =0.1;
      rho =1;
      


var w1,w2:t_window; {zwei Fenster}
    fasym,ci,cp,speed,betasoll,beta,beta1,bita,bita1,alpha,
    abwintbita,t,fx1,fy1,fx2,fy2,y_zwischen,y1_zwischen:real;
    n:integer;
    zeichen :char;
    anzeige :array[1..4] of string;
    beta_zeichen :string;


procedure Graphik_initialisieren;
begin
 ingraf(5);                       {Graphik initialisieren}
 {"Welt"-Koordinatensysteme fr w1 u. w2 definieren:}
 w1.SetWorld(0,0,(GetMaxX div 2-3)*10,
            (GetMaxY-19)*10, {Ecken l.u, r.o.,Weltkkord.}
           3,9,GetMaxX div 2,GetMaxY-10); {Ecken, B.schirm}
 w2.SetWorld(0,0,(GetMaxX div 2-3)*10,(GetMaxY-19)*10,
           GetMaxX div 2+3,9,GetMaxX,GetMaxY-10);
 w1.clear; w2.clear; w2.frame;w1.frame;  {Loeschen, Rahmen zeichnen}
end;


procedure anfangswerte;
begin;
 t:=0;
 beta:=0;
 bita:=0;
 beta1:=0;
 bita1:=0;
 abwintbita:=0;
 y_zwischen:=0;
 y1_zwischen:=0;
 fx1:=1500;
 fy1:=2300;
 fx2:=1500;
 fy2:=2300;
 beta_zeichen := 'beta';
end;


procedure werte_einlesen;
begin
 clrscr;
 write('CP : ');readln(cp);
 write('CI : ');readln(ci);
 write('FASYM : ');readln(fasym);
 write('v : ');readln(speed);
 write('betasoll (beta=0) : ');readln(betasoll);
end;


procedure beta_soll_lesen;
begin
 outtextxy(10,470,'beta-soll? enter...  x..exit e..Eingabe  Pfeile..+-30ř ');
 Sound(220);        { Beep }
 Delay(200);        { For 200 ms }
 NoSound;           { Relief! }
 repeat until keypressed;
 zeichen:=readkey;
 if (zeichen<>'x') and (zeichen<>chr(13)) then
  begin
   if zeichen='e' then
   begin
    moveto(450,470);
    betasoll:=rgrafread;
    setcolor(0);
    moveto(450,470);
    for n:=1 to 10 do outtext(chr(219));
    setcolor(15);
   end
   else
   begin
    zeichen:=readkey;
    if zeichen= chr(77) then betasoll:=betasoll+30;
    if zeichen= chr(75) then betasoll:=betasoll-30;
   end;
   while betasoll>= 360 do betasoll:=betasoll-360;
  end;
end;


procedure beta_soll_anzeigen;
begin
 w1.DrawLinec(fx1,fy1,fx1+40*speed*sin(betasoll/180*pi)
            ,fy1+40*speed*cos(betasoll/180*pi),15,DottedLn);
 w2.DrawLinec(fx2,fy2,fx2+40*speed*sin(betasoll/180*pi)
            ,fy2+40*speed*cos(betasoll/180*pi),15,DottedLn);
end;


procedure beta_soll_wert_anzeigen;
begin
 beta_soll_anzeigen;
 setcolor(0);
 outtextxy(0,0,beta_zeichen+'-soll : '+anzeige[1]);
 setcolor(15);
 str(betasoll:3:0,anzeige[1]);
 outtextxy(0,0,beta_zeichen+'-soll : '+anzeige[1]);
end;

procedure werte_anzeigen;
begin
 setcolor(0);
 outtextxy(200,0,'t : '+anzeige[4]);
 w1.println(beta_zeichen+' '+anzeige[2]);
 w1.printreset;
 w2.println(beta_zeichen+' '+anzeige[3]);
 w2.printreset;
 setcolor(15);
 str(beta:3:0,anzeige[2]);
 str(bita:3:0,anzeige[3]);
 str(t:10:0,anzeige[4]);
 outtextxy(200,0,'t : '+anzeige[4]);
 w1.println(beta_zeichen+' '+anzeige[2]);
 w1.printreset;
 w2.println(beta_zeichen+' '+anzeige[3]);
 w2.printreset;
end;


procedure flugbahn_zeichnen;
begin
 w1.DrawLine(fx1,fy1,fx1+speed*sin(beta/180*pi),fy1+speed*cos(beta/180*pi));
 w2.DrawLine(fx2,fy2,fx2+speed*sin(bita/180*pi),fy2+speed*cos(bita/180*pi));
 fx1:=fx1+speed*sin(beta/180*pi);
 fy1:=fy1+speed*cos(beta/180*pi);
 fx2:=fx2+speed*sin(bita/180*pi);
 fy2:=fy2+speed*cos(bita/180*pi);
end;

            { Ab hier Rechnung ... }


function abl2fct(cpfct,cifct,abwintfct,t,betafct,beta1fct: real):real;
begin
 alpha:=-cpfct*(betafct-betasoll)-cifct*abwintfct;
 abl2fct:=(alpha-rho*beta1fct+fasym)/theta;
end;


procedure rk2(rk2_c1,rk2_c2,abwint,x,h:real; var y,y1:real);
{berechnet aus y(x), y1(x) die neuen Werte y(x+h), y1(x+h)
 und benutzt die Funktion abl2fct zur
 Berechnung der 2. Ableitung
 Keine universelle RUNGE-KUTTA-Prozedur sondern spez. Prozedur
 fuer den Fall, dass in die Formel f. d. 2. Ableitung
 die Parameter rk2_c1,rk2_c2 und abwint eingehen.
 s.o., Def. v. abl2fct }
var k1,k2,k3,k4:real;
begin
 k1 := abl2fct(rk2_c1,rk2_c2,abwint, x,y,y1)*h/2;
 k2 := abl2fct(rk2_c1,rk2_c2,abwint, x+h/2, y+(y1+k1/2)*h/2, y1+k1)*h/2;
 k3 := abl2fct(rk2_c1,rk2_c2,abwint, x+h/2, y+(y1+k1/2)*h/2, y1+k2)*h/2;
 k4 := abl2fct(rk2_c1,rk2_c2,abwint, x+h,   y+(y1+k3)*h,     y1+2*k3)*h/2;
 y := y + y1*h + (k1+k2+k3)*h/2;
 y1 := y1 + (k1+2*(k2+k3)+k4)/3;
 y_zwischen:=y;
 y1_zwischen:=y1;
 while y_zwischen>= 360 do y_zwischen:=y_zwischen-360;
end;


procedure flugbahn;
begin
 for n:= 1 to 40 do
 begin
  abwintbita:=abwintbita+(bita-betasoll)*dt;
  rk2(cp,0,0,t,dt,beta,beta1);
  beta:=y_zwischen;
  beta1:=y1_zwischen;
  rk2(cp,ci,abwintbita,t,dt,bita,bita1);
  bita:=y_zwischen;
  bita1:=y1_zwischen;
  t:=t+1;
  flugbahn_zeichnen;
 end;
end;

                                { Hauptprogramm }

begin
 anfangswerte;
 werte_einlesen;
 Graphik_initialisieren;
 werte_anzeigen;
repeat
 beta_soll_wert_anzeigen;
 flugbahn;
 werte_anzeigen;
 beta_soll_lesen;
until zeichen='x';
end.