program Dibujar;
uses Teclado, crt, Graph, dos;

{ Programa para mostrar capacidades graficas
  Autor: John Coppens }

type
  Direcciones = (_N, _NE, _E, _SE, _S, _SO, _O, _NO);
  Figuras = (_Circ, _Rect, _RectR);
  Desplaz = record
    dX,
    dY: integer;
    Hor,
    Ver: Direcciones;
  end;
  Tamano = record
    tX, tY: integer;
  end;

const
  Paso = 2;
  rCirc = 50;                 { Radio del circulo }
  hRect = 35; vRect = 55;     { Tamanos del rectangulo }
  Diag: boolean = false;      { Habilita movimientos diagonales }
  Auto: boolean = false;      { Permite cambio automatico de colores }
  Anim: boolean = false;      { Inicia la animacion }
  Color: integer = White;
  Mode: integer = CopyPut;    { Modo de escritura }
  Fig: Figuras = _Circ;       { La figura activa en este momento }
  Veloc: integer = 30;        { Velocidad }
  UltDir: Direcciones = _N;
  Ang: real = 0;   dAng: real = 0.02;

  { Arreglo contiene la definicion de cada direccion, y
    ademas, la direccion a tomar cuando rebota contra un marco
    horizontal o vertical }
  Movim: array [Direcciones] of Desplaz =
    ((dX:  0; dY: -1; Hor: _S;  Ver: _S),    { norte }
     (dX: +1; dY: -1; Hor: _SE; Ver: _NO),   { noreste }
     (dX: +1; dY:  0; Hor: _O;  Ver: _O),    { este }
     (dX: +1; dY: +1; Hor: _NE; Ver: _SO),   { sureste }
     (dX:  0; dY: +1; Hor: _N;  Ver: _N),    { sur }
     (dX: -1; dY: +1; Hor: _NO; Ver: _SE),   { suroeste }
     (dX: -1; dY:  0; Hor: _E;  Ver: _E),    { oeste }
     (dX: -1; dY: -1; Hor: _SO; Ver: _NE));  { noroeste }

  Tam: array [_Circ.._RectR] of Tamano =
    ((tX: rCirc; tY: rCirc),
     (tX: hRect; tY: vRect),
     (tX: hRect; tY: vRect));  { Ojo, aqui los tamanos cambian dinamicamente}

var
  Car: char;
  X, Y, Xant, Yant: integer;
  ErrCode,
  GrD, GrM: integer;

{ Dib realiza el trabajo de realmente dibujar la figura }

procedure Dib;
  procedure RectRot;
  begin
    MoveTo(X + round(hRect * cos(Ang)), Y + round(vRect * sin(Ang)));
    LineTo(X - round(vRect * sin(Ang)), Y + round(hRect * cos(Ang)));
    LineTo(X - round(hRect * cos(Ang)), Y - round(vRect * sin(Ang)));
    LineTo(X + round(vRect * sin(Ang)), Y - round(hRect * cos(Ang)));
    LineTo(X + round(hRect * cos(Ang)), Y + round(vRect * sin(Ang)));
  end;
begin
  SetWriteMode(Mode);
  SetColor(Color);
  case Fig of
    _Circ:  Circle(X, Y, rCirc);
    _Rect:  Rectangle(X - hRect, Y - vRect,
                      X + hRect, Y + vRect);
    _RectR: begin
              RectRot;
              Ang := Ang + dAng;
            end;
  end;
end;

{ Mover intenta de realizar los movimientos en la direccion pedida.
  Si no es posible, intenta de cambiar en la direccion apropiada.
  Eso unicamente tiene resultado si el programa esta en modo animado }

procedure Mover(Dir: Direcciones);
var
  prX, prY: integer;
begin
  UltDir := Dir;
  prX := Paso*Movim[Dir].dX;
  prY := Paso*Movim[Dir].dY;
  { Choques horizontales? }
       if ((X + prX - Tam[Fig].tX) < 0) or         { choque izquierda }
          ((X + prX + Tam[Fig].tX) > GetMaxX) then { choque derecha }
          UltDir := Movim[Dir].Ver
  { Choques verticales? }
  else if ((Y + prY - Tam[Fig].tY) < 0) or         { choque arriba }
          ((Y + prY + Tam[Fig].tY) > GetMaxY) then { choque abajo }
          UltDir := Movim[Dir].Hor;
  X := X + prX;
  Y := Y + prY;
end;

{ Animacion hace la tarea aludidad. Espera un cierto tiempo, luego
  mueve automaticamente }

procedure Animacion;
begin
  delay(Veloc);
  Mover(UltDir);
end;

{ En cambio, manual, decodifica teclas, y realizas movimiento paso a
  paso. Ademas tiene la tarea de decodificar los comandos. }

procedure Manual;
begin
  Car := GetKey;
  Xant := X; Yant := Y;
  case Car of
    CsrArr: if Diag then Mover(_NE) else Mover(_N);
    CsrAba: if Diag then Mover(_SO) else Mover(_S);
    CsrIzq: if Diag then Mover(_NO) else Mover(_O);
    CsrDer: if Diag then Mover(_SE) else Mover(_E);
    'a': Anim := false;      'A': Anim := true;
    'd': Diag := false;      'D': Diag := true;
    'c': Auto := false;      'C': Auto := true;
    'x': Mode := CopyPut;    'X': Mode := XorPut;
    '0'..'9': Veloc := 10*(ord(Car) - ord('0'));
     F1: Fig := _Circ;        F2: Fig := _Rect;
     F3: Fig := _RectR;
  end;
end;

begin
  GrD := VGA; GrM := VGAHi;
  InitGraph(GrD, GrM, '\tp7\bgi');
  ErrCode := GraphResult;
  if ErrCode <> GrOk then begin
    writeln('Hubo problemas: ', GraphErrorMsg(ErrCode));
    halt(1);
  end;
  X := GetMaxX div 2; Y := GetMaxY div 2;
  Dib;
  repeat
    if Anim then
      if Keypressed then
        Manual
      else
        Animacion
    else
      Manual;
    if Auto then
      Color := (Color + 1) mod (GetMaxColor + 1);
    Dib;
  until Car = chr(27);
  CloseGraph;
end.