{ HANS.PAS }
{ fuer alle CAOS-Versionen zugaenglich gemacht: ML-Soft 29.05.1994 }
{ beim Compilieren Endadresse 4000 angeben! }

PROGRAM hans;
CONST obar = 20;
      unar = 15;
      obsc = 27;
      unsc = 25;
      leib = 30;
      hals = 5;
      kopf = 8;
      gelenk = 2;
      x0 = 150;
      y0 = 100;
      gfarb = 6;
      back = 0;
      e = #27;
      i : ARRAY [1..10,1..4] OF INTEGER =
          ((160,90,180,18), {al}
           (160,90,180,18), {ar}
           ( 90,50,100,10), {bl}
           ( 90,50,100,10), {br}
           ( 90,60,120,12), {g}
           ( 40,10,100,24), {dl}
           ( 40,10,100,24), {dr}
           (120,10,350,68), {el}
           (120,10,350,68), {er}
           ( 90,45,135,18));{z}

VAR ra,z : INTEGER;

PROCEDURE cls;
BEGIN
  write (e,chr(84),chr($9C),chr($B7),chr(4),chr(0),
         chr(12),chr(5),chr(14),chr(15),e,chr(86),chr(12));
END;

PROCEDURE einf;
BEGIN
  write (e,chr(78),chr(lo(gfarb)),e,chr(79),chr(lo(back)),e,chr(67),chr(lo(gfarb)));
END;

PROCEDURE esc (x : BYTE);     { fuer CAOS ESC-0 bis ESC-9 }
BEGIN
  write (e,chr(86),e,e,chr(86),chr(x+$30));
END;

PROCEDURE line (xa,ya,xe,ye : REAL);
VAR x1,y1,x2,y2 : INTEGER;
BEGIN
  x1 := round (xa);
  y1 := round (ya);
  x2 := round (xe);
  y2 := round (ye);
  write (e,chr(68),chr(lo(x1)),chr(hi(x1)),chr(lo(y1)),
                   chr(lo(x2)),chr(hi(x2)),chr(lo(y2)));
END;

PROCEDURE circle (x,y,r : REAL);
VAR xx,yy,rr : INTEGER;
BEGIN
  xx := round (x);
  yy := round (y);
  rr := round (r);
  write (e,chr(69),chr(lo(xx)),chr(hi(xx)),chr(lo(yy)),chr(lo(rr)));
END;

PROCEDURE strich (xa,ya,xe,ye : REAL);
BEGIN
  line (xa,ya,xe,ye);
  circle (xa,ya,gelenk);
END;

FUNCTION co (wi : REAL) : REAL;
BEGIN
  co := cos (wi/180*pi);
END;

FUNCTION si (wi : REAL) : REAL;
BEGIN
  si := sin (wi/180*pi);
END;

FUNCTION tan (wi : REAL) : REAL;
BEGIN
  tan := si (wi) / co (wi);
END;

FUNCTION aco (x : REAL) : REAL;
BEGIN
  aco := (-arctan(x/sqrt(1-x*x))+pi/2)/pi*180;
END;

FUNCTION asi (x : REAL) : REAL;
BEGIN
  asi := arctan(x/sqrt(1-x*x))/pi*180;
END;

PROCEDURE zeichne;
VAR aa,al,bl,cl,ar,br,cr,ax,ay,bx,by,cx,cy,dx,dy,ex,ey,fx,fy,gx,gy,hx,hy,ix,iy,jx,jy,kx,ky,lx,ly : REAL;
BEGIN
  al := sqrt (obsc*obsc+unsc*unsc-2*obsc*unsc*co(i[1,1]));
  bl := i[3,1] - asi(obsc*si(i[1,1])/al);
  cl := al * si (bl);
  ar := sqrt (obsc*obsc+unsc*unsc-2*obsc*unsc*co(i[2,1]));
  br := i[4,1] - asi(obsc*si(i[2,1])/ar);
  cr := ar * si (br);
  cx := x0;
  IF cl > cr THEN
      cy := y0 + cl
             ELSE
      cy := y0 + cr;
  ey := cy - cl;
  dy := ey + unsc * si (i[3,1]);
  aa := cy - dy;
  dx := cx - sqrt (obsc*obsc-aa*aa);
  aa := dy - ey;
  aa := sqrt (unsc*unsc-aa*aa);
  IF i[3,1] > 90 THEN ex := dx + aa
                 ELSE ex := dx - aa;
  ay := cy - cr;
  by := ay + unsc * si (i[4,1]);
  aa := cy - by;
  bx := cx + sqrt (obsc*obsc-aa*aa);
  aa := by - ay;
  aa := sqrt (unsc*unsc-aa*aa);
  IF i[4,1] > 90 THEN ax := bx - aa
                 ELSE ax := bx + aa;
  fy := cy + leib * si (i[5,1]);
  fx := cx + leib * co (i[5,1]);
  gy := fy + hals * si (i[10,1]);
  gx := fx + hals * co (i[10,1]);
  aa := hals + kopf;
  hy := fy + aa * si (i[10,1]);
  hx := fx + aa * co (i[10,1]);
  aa := 90 - i[5,1] + i[6,1];
  kx := fx - obar * si (aa);
  ky := fy - obar * co (aa);
  aa := aa + i[8,1] - 90;
  lx := kx + unar * co (aa);
  ly := ky - unar * si (aa);
  aa := i[7,1] - 90 + i[5,1];
  ix := fx + obar * si (aa);
  iy := fy - obar * co (aa);
  aa := aa + i[9,1] - 90;
  jx := ix - unar * co (aa);
  jy := iy - unar * si (aa);
  strich (ex,ey,dx,dy);
  strich (dx,dy,cx,cy);
  strich (ax,ay,bx,by);
  strich (bx,by,cx,cy);
  strich (cx,cy,fx,fy);
  strich (fx,fy,gx,gy);
  circle (hx,hy,kopf);
  strich (lx,ly,kx,ky);
  strich (kx,ky,fx,fy);
  strich (jx,jy,ix,iy);
  strich (ix,iy,fx,fy);
  line (96,y0-gelenk,207,y0-gelenk);
END;

PROCEDURE veraendern (a : INTEGER);
VAR r : INTEGER;
BEGIN
  IF i[a,1] = i[a,2] THEN r := 1 + random (i[a,4])
                     ELSE
     IF i[a,1] = i[a,3] THEN r := - (1 + random (i[a,4]))
                        ELSE r := random (i[a,4]*2+1) - i[a,4];
  i [a,1] := i[a,1] + r;
  IF i[a,1] < i[a,2] THEN i[a,1] := i[a,2];
  IF i[a,1] > i[a,3] THEN i[a,1] := i[a,3];
END;

BEGIN
  clrscr;
  einf;
  line (0,y0-gelenk,319,y0-gelenk);
  esc (3);
  clrscr;
  einf;
  line (0,y0-gelenk,319,y0-gelenk);
  zeichne;
  esc (4);
  REPEAT
      FOR z := 1 TO 10 DO veraendern (z);
      cls;
      zeichne;
      esc (3);
      FOR z := 1 TO 10 DO veraendern (z);
      cls;
      zeichne;
      esc (4);
      ra := bios (1);
  UNTIL ra <> 0;
  esc (1);
END.