Umiestnenie súboru www.TrSek.com/cover/benkovic/bezier.pas
{ BEZIER.PAS                                                        }
{ Program na zobrazenie bezierovych kriviek.                        }
{                                                                   }
{ Datum:02.07.1994                             http://www.trsek.com }

uses crt;
{ Define Test}
{ Define Lines}

const step=0.01;
      krokt= 1/10;
      p    = 0.5*0.35;      {malo by p> 0.5*0.25}
      f=14;

      sirkaw = 200;
      vyskaw = 200;

      BerierSt = 4;

      MaxX2 = 376 div 2;
      MaxY2 = 282 div 2;

      stx = 0;
      sty = 17;


const sirka=MaxX2*2;

var X1st,X2st,X3st,X4st,Y1st,Y2st,Y3st,Y4st,XSst,YSst:integer;
    c:char;
    Xd,Yd,PX1,PX2,PX3,PY1,PY2,PY3:integer;
    PSeg:word;
    a:real;
    tria:byte;

PROCEDURE DLine(x1,y1,x2,y2:word; colorka:byte); Assembler;

asm
{$I-}
{$R-}

  push ds

  mov  ax,PSeg
  mov  ds,ax

  mov  bx,x1
  mov  ax,y1
  mov  dx,x2
  mov  cx,y2

  cmp  bx,dx           {v bx musi byt mensie z x1,x2}
  jl   @Mensie

@Vacsie:               {ak tam nie je, treba to opravit}

  xchg bx,dx           {treba vymenit bx a dx (x1,x2)}
  xchg ax,cx           {treba vymenit ax a cx (y1,y2)}

@Mensie:               {Ak je vsechno OK, alebo bolo = x1<x2; y1<y2?}

  push dx
  push dx              {dx bude pouzite na deltax }
  push ax

  mov  dx,sirka/4      {ajtak ho to znuluje}
  mul  dx              {ax = ax*320    = y1*320}

  mov  dx,bx
  shr  dx,1
  shr  dx,1
  add  ax,dx
  mov  di,ax           {di := y1*320+x1}

@Dal:
  pop  ax              {ax = y1}
  pop  dx              {dx = x2}

  sub  dx,bx           {** dx = deltax := x_koncove(=dx) - x(=bx)}

  cmp  ax,cx           {do ax dame abs(ax-cx) preto treba vediet co je vacsie}
  pushf
  jg   @Vacsie2

@Mensie2:              {ax je mensie; y1<y2 => abs(y1-y2) = y2-y1}
  xchg ax,cx           {sub  cx,ax;    mov  ax,cx}

@Vacsie2:              {y1>y2 => abs(y1-y2) = y1-y2}
  sub  ax,cx

  cmp  dx,ax
  jl   @PodmePoY       {** if deltax < deltay then jump            }
                       {                      else Ok              }

{************************************************************************}
                       {  mov  si,offset @IncDec+2}
  popf
  jg   @Vacsie22

@Mensie22:
  mov  word ptr [cs:@IncDec+2], Sirka / 4  {treba prestavit na dec(Y)}
  jmp  @Dalej

@Vacsie22:
  mov  word ptr [cs:@IncDec+2], -Sirka / 4  {treba prestavit na dec(Y)}

@Dalej:                {** v ax je hodnota ax = deltay = abs(y1-y2)}
                       {** v dx je hodnota dx = deltax = abs(x1-x2)}

  shl  ax,1            {** v ax je deltay = zbytocne, preto dame ax=konst1=2*deltay}
  mov  word ptr [cs:@Konst1+2],ax      {Ok}

  sub  ax,dx           {ax=predikce na chvilu=2*deltay-deltax; pre mna aj zaporne(?)}
  mov  cx,ax           {cx=predikce na dlhodlbo=ax}
  sub  ax,dx           {ax=konst2, lebo=2*deltay-deltax-deltax=2*(deltay-deltax)}
  mov  word ptr [cs:@Konst2+2],ax      {Ok}

  {opakovanie: V   ax = konst2 = zbytocne = uvolnene pre plain(?), ktory pixel}
             { x1  bx = x1 = mensie x = zvacsovanie}
             { pr  cx = predikce zvacsovanie}
             { V   dx = deltax = treba uvolnit pre porty}
             { !   di = kam bachnut pixel}
  mov  ah,00010001b
  mov  dx,cx
  mov  cx,bx
  and  cx,00000011b
  shl  ah,cl
  mov  cx,dx
  pop  si    { x2  si = x2 = vacsie x}

  mov  al,02h
  mov  dx,03c4h
  out  dx,ax

  mov  al,colorka
  mov  byte ptr [ds:di],al

  push bp
{hlavny cyklus}
@Hlavny:
  cmp  bx,si
  je   @DostBolo

    shl  ah,1
    jnc  @Rotuj
    mov  ah,00010001b
    inc  di                     {incni di ak prerotoval plainsy}
@Rotuj:

    inc  bx
    test cx,1000000000000000b   {if predikce<0 }
    jz   @Vacsie3  {if not je = preco by jedla = 0 = nie je = je tam 0}

@Konst1:
      add  cx,1234h    {predikce:=predikce+konst1 => konst1 sa meni-modifikuje}
      jmp  @Pixelaz

@Vacsie3:
@IncDec:
      db   81h,0C7h  {add di,...}
      dw   Sirka/4   {modifikovany 320 ak od 0 na vacsie=4 a 8 qvdr.; -320 ak z vacsieho mensie 0,0 je vlavo hore}
@Konst2:
      add  cx,1234h     {predikce:=predikce+konst2 => konst2 sa meni-modifikuje}

@Pixelaz:
    mov  bp,ax
    mov  al,02h
    out  dx,ax
    mov  ax,bp
    mov  byte ptr [ds:di],al
  jmp  @Hlavny

@DostBolo:
  pop  bp
  pop  ds

  jmp  @ShitPascalRet

{**************************************************************************}

@PodmePoY:

  popf
  jle  @JeMensi

@JeVacsi:     {ide zdola hore do ax, ktore je vacsie}
  add  ax,cx  {ax = y1-y2 +y2 = y1}
  xchg ax,cx  {vymen y1,y2}

  push dx
  push ax                         {treba zmenit aj di, huraaa v bx je x2}

  add  bx,dx                      {v dx je roziel => x1+(x2-x1)=x2}
  mov  si,bx                      {x1}

  mov  dx,Sirka/4      {ajtak ho to znuluje}
  mul  dx              {ax = ax*320    = y1*320}

  mov  dx,bx
  shr  dx,1
  shr  dx,1
  add  ax,dx
  mov  di,ax           {di := y1*320+x1}

  pop  ax
  pop  dx

  mov  word ptr [cs:@ShiftY],0ECD0h  {treba prestavit na shr ah,1}
  mov  byte ptr [cs:@MaskaY+1],10001000b  {treba prestavit na shr di,1}
  mov  byte ptr [cs:@IncDecY],4Fh  {treba prestavit inc di}
  jmp  @Dalejsi

@JeMensi:     {ciara ide zhora dole od 0, +320 preto ide doprava, hore sort}
  add  ax,cx  {ax = y1-y2 +y2 = y1}
  xchg ax,cx
  mov  si,bx
  mov  word ptr [cs:@ShiftY],0E4D0h  {treba prestavit na shr ah,1}
  mov  byte ptr [cs:@MaskaY+1],00010001b  {treba prestavit na shr di,1}
  mov  byte ptr [cs:@IncDecY],47h  {treba prestavit inc di}

@Dalejsi:
  pop  bx     {treba popnut x2 ..., (bx je nedolezite bolo tam x1)}
  push cx     {a dat tam y2  =>   pojde do si, do vacsieho }
  mov  bx,ax  {bx - od neho sa pojde, +320 ... az do <-\- push cx do cx=y2}

{povodna rutinka:}

  sub  ax,cx           {do ax treba dat cx-ax = -(ax-cx)}
  neg  ax   
                       {** v ax je hodnota ax = deltay = abs(y1-y2)}
                       {** v dx je hodnota dx = deltax = abs(x1-x2)}

  shl  dx,1            {** v dx je deltax = zbytocne, preto dame dx=konst1=2*deltax}
  mov  word ptr [cs:@Konst1Y+2],dx      {Ok}

  sub  dx,ax           {dx=predikce na chvilu=2*deltax-deltay; pre mna aj zaporne(?)}
  mov  cx,dx           {cx=predikce na dlhodlbo=dx}
  sub  dx,ax           {dx=konst2, lebo=2*deltax-deltay -deltay=2*(deltax-deltay)}
  mov  word ptr [cs:@Konst2Y+2],dx      {Ok}

  {opakovanie: V   ax = deltax = zbytocne = uvolnene pre plain(?), ktory pixel}
             { x1  bx = y1 = mensie y = zvacsovanie}
             { pr  cx = predikce zvacsovanie}
             { V   dx = konst2 = zbytocne =  treba uvolnit pre porty}
             { !   di = kam bachnut pixel}
  mov  ah,00010001b
  mov  dx,cx
  mov  cx,si
  and  cx,00000011b
  shl  ah,cl            {zisti masku plainsy}
  mov  cx,dx

  pop  si    { y2  si = y2 = vacsie y}
  mov  dx,03c4h
  mov  al,02h
  out  dx,ax

  mov al,colorka
  mov [ds:di],al

  push bp

{hlavny cyklus}
@HlavnyY:
  cmp  bx,si
  je   @DostBoloY

    inc  bx
    add  di,Sirka /4
    test cx,1000000000000000b   {if predikce<0 }
    jz   @Vacsie3Y  {if not je = preco by jedla = 0 = nie je = je tam 0}

@Konst1Y:
      add  cx,1234h    {predikce:=predikce+konst1 => konst1 sa meni-modifikuje}
      jmp  @PixelazY

@Vacsie3Y:
@ShiftY:
      shl  ah,1
      jnc  @Konst2Y
@MaskaY:
      mov  ah,00010001b
@IncDecY:
      inc  di  {add  di,1234h modifikovany 1 ak od 0 na vacsie; -1 ak z vacsieho mensie 0,0 je vlavo hore}

@Konst2Y:
      add  cx,1234h    {predikce:=predikce+konst2 => konst2 sa meni-modifikuje}

@PixelazY:

    mov  bp,ax
    mov  al,02h
    out  dx,ax
    mov  ax,bp
    mov  byte ptr [ds:di],al
  jmp  @HlavnyY

@DostBoloY:
  pop  bp
  pop  ds

@ShitPascalRet:
    
{$I+}
{$R+}
end;



PROCEDURE XMode; Assembler;
asm
                push bp
                push ds

                mov dx, 0a000h
            mov es, dx
            xor di, di
            xor ax, ax
            mov cx, 8000h
            rep stosw


                mov  ax,cs
                mov  ds,ax

            mov  ax,13h
            int  10h

        mov  dx,3c4h
        mov  ax,2101h
        out  dx,ax

                mov  dx,03c4h
            mov  ax,0604h
            out  dx,ax               { disable chain4 mode                   }
            mov  ax,0100h
            out  dx,ax               { synchronous reset while setting Misc  }
                          {  Output for safety, even though clock }
                             {  unchanged                            }
            mov  si,offset @X376Y282
            lodsb
            mov  dx,03c2h
            out  dx,al               { select the dot clock and Horiz        }
                         {  scanning rate                        }
            mov  dx,03c4h
            mov  ax,0300h
            out  dx,ax               { undo reset (restart sequencer)        }

             mov  dx,03d4h            { reprogram the CRT Controller          }
            mov  al,11h              { VSync End reg contains register write }
            out  dx,al               { protect bit                           }
            inc  dx                  { CRT Controller Data register          }
            in   al,dx               { get current VSync End register setting}
            and  al,07fh             { remove write protect on various       }
            out  dx,al               { CRTC registers                        }
            dec  dx                  { CRT Controller Index                  }
            cld
                xor  ch,ch
            lodsb
            mov  cl,al

@@SetCRTParmsLoop:
        lodsw                    { get the next CRT Index/Data pair      }
        out  dx,ax               { set the next CRT Index/Data pair      }
        loop @@SetCRTParmsLoop

            { clear all of display memory           }

                mov  dx,03c4h
                mov  ax,0f02h
                out  dx,ax               { enable writes to all four planes      }

                mov  ax,0a000h           { now clear all display memory, 8 pixels}
                mov  es,ax               { at a time                             }
                xor  di,di               { point ES:DI to display memory         }
                xor  ax,ax               { clear to zero-value pixels            }
                mov  cx,8000h            { # of words in display memory          }
                rep  stosw

                mov  dx,3c4h
        mov  ax,0101h
        out  dx,ax

                pop  ds
                pop  bp

        ret
@X376Y282:
    db      0e7h
    db      18
    dw      06e00h  { horz total                    }
    dw      05d01h  { horz displayed                }
    dw      05e02h  { start horz blanking           }
    dw      09103h  { end horz blanking             }
    dw      06204h  { start h sync                  }
    dw      08f05h  { {nd h sync                    }
    dw      06206h  { vertical total                }
    dw      0f007h  { overflow                      }
    dw      06109h  { cell height                   }
    dw      0310fh  {                               }
    dw      03710h  { v sync start                  }
    dw      08911h  { v sync end and protect cr0-cr7}
    dw      03312h  { vertical displayed            }
    dw      02f13h  { offset                        }
    dw      00014h  { turn off dword mode           }
    dw      03c15h  { v blank start                 }
    dw      05c16h  { v blank end                   }
    dw      0e317h  { turn on byte mode             }

@X360Y480:
            DB      0e7h
            DB      17
            DW      06b00h  { horz total                    }
            DW      05901h  { horz displayed                }
            DW      05a02h  { start horz blanking           }
            DW      08e03h  { end horz blanking             }
            DW      05e04h  { start h sync                  }
            DW      08a05h  { end h sync                    }
            DW      00d06h  { vertical total                }
            DW      03e07h  { overflow                      }
            DW      04009h  { cell height                   }
            DW      0ea10h  { v sync start                  }
            DW      0ac11h  { v sync end and protect cr0-cr7}
            DW      0df12h  { vertical displayed            }
            DW      02d13h  { offset                        }
            DW      00014h  { turn off         DWord mode   }
            DW      0e715h  { v blank start                 }
            DW      00616h  { v blank end                   }
            DW      0e317h  { turn on byte mode             }
end;

PROCEDURE XMode2; assembler;
asm
        mov ax, 2101h
    mov dx, 3c4h
    out dx, ax
    mov ax, 13h
    int 10h
    mov dx, 3c4h
    mov ax, 604h            {spristupnenie nad 64k image memory}
    out dx, ax

    mov ax, 0f02h           {zapis do 00001111 = vsetkych bit plains}
    out dx, ax

    mov dx, 0a000h
    mov es, dx
    xor di, di
    xor ax, ax
    mov cx, 8000h
    rep stosw               {vynulovanie pamate 4 plainsy}

    mov dx, 3d4h
    mov ax, 14h             {0014h }
    out dx, ax

    mov ax, 0e317h
        out dx, ax          { potialto}

        mov ax, 2813h
        out dx, ax

        mov ax, 0109h
        out dx, ax
end;

PROCEDURE PutPixel(x,y,color:integer); assembler;
asm
  mov  ax,PSeg
  mov  es,ax
  mov  dx,03c4h
  mov  cx,x
  and  cx,00000011b
  mov  ah,1
  shl  ah,cl
  mov  al,02
  out  dx,ax

  mov  ax,y
  mov  cx,Sirka/4
  mul  cx
  mov  di,ax

  mov  ax,x
  shr  ax,1
  shr  ax,1
  add  di,ax
  mov  ax,color
  stosb
end;

PROCEDURE Berier(X1,Y1,X2,Y2,X3,Y3:integer;st:integer);
begin
  if st=0 then
  begin
    {$IfDef Lines}
      DLine(X1 shr 1+(X1 and 1),Y1 shr 1+(Y1 and 1),X3 shr 1+(X3 and 1),Y3 shr 1+(Y3 and 1),f);
    {$Else}
      PutPixel(X1 shr 1+(X1 and 1),Y1 shr 1+(Y1 and 1),f);
      PutPixel(X3 shr 1+(X3 and 1),Y3 shr 1+(Y3 and 1),f);
    {$EndIf}
    exit;
  end;
  PX1:=((((X1+X3) shr 1)+X2) shr 1); PX1:=PX1 shr 1+(PX1 and 1);
  PY1:=((((Y1+Y3) shr 1)+Y2) shr 1); PY1:=PY1 shr 1+(PY1 and 1);
  PutPixel(PX1,PY1,f);

  PX1:=X1;                              PY1:=Y1;
  PX2:=(X1+X2) shr 1;                   PY2:=(Y1+Y2) shr 1;
  PX3:=((((X1+X3) shr 1)+X2) shr 1);    PY3:=((((Y1+Y3) shr 1)+Y2) shr 1);
  Berier(PX1,PY1,PX2,PY2,PX3,PY3,st-1);

  PX1:=((((X1+X3) shr 1)+X2) shr 1);    PY1:=((((Y1+Y3) shr 1)+Y2) shr 1);
  PX2:=(X2+X3) shr 1;                   PY2:=(Y2+Y3) shr 1;
  PX3:=X3;  PY3:=Y3;
  Berier(PX1,PY1,PX2,PY2,PX3,PY3,st-1);
end;


PROCEDURE Bezier(X1,Y1,X2,Y2,X3,Y3:integer);
var t:real;
    X,Y:integer;
begin
  t:=0;
  repeat
    X:=round(X1+t*(2*X2-2*X1)+t*t*(X1+X3-2*X2));
    Y:=round(Y1+t*(2*Y2-2*Y1)+t*t*(Y1+Y3-2*Y2));
    PutPixel(X,Y,15);

    t:=t+step;
  until t>=1;
end;

PROCEDURE Triangel(X1z,Y1z,X2z,Y2z,X3z,Y3z:integer);
var XN,YN,X1,X2,X3,Y1,Y2,Y3,Xd1,Yd1,Xd2,Yd2:integer;
    X1p,X2p,X3p,Y1p,Y2p,Y3p:integer;
    X1p2,X2p2,X3p2,Y1p2,Y2p2,Y3p2:integer;
    X,Y:integer;
    c:char;
    t2:real;
begin

  X1:=X1z; X2:=X2z; X3:=X3z;
  Y1:=Y1z; Y2:=Y2z; Y3:=Y3z;

  Xd1:=X2;  Yd1:=Y2;  Xd2:=(X1+X3) div 2;  Yd2:=(Y1+Y3) div 2;

{$IfDef AllLines}
  Line(X1,Y1,round(Xd2+(Xd1-Xd2)*1),round(Yd2+(Yd1-Yd2)*1));
  Line(round(Xd2+(Xd1-Xd2)*1),round(Yd2+(Yd1-Yd2)*1),X3,Y3);
  Line(Xd1,Yd1,Xd2,Yd2);
{$EndIf}

  DLine(X1,Y1,X3,Y3,15);

  X1p:=X1;  X3p:=X3;
  Y1p:=Y1;  Y3p:=Y3;

  t2:=krokt;

{ X2p:=round(Xd2+(Xd1-Xd2)*t2);
  Y2p:=round(Yd2+(Yd1-Yd2)*t2); }

  X2p:=round( (X1p+X3p)/2 + 2*((Xd1-Xd2)*t2-((X1p+X3p)/2-Xd2)));
  Y2p:=round( (Y1p+Y3p)/2 + 2*((Yd1-Yd2)*t2-((Y1p+Y3p)/2-Yd2)));

  while t2-krokt<=1 do
  begin
{$IfDef Test}
     if tria=1 then
     asm
       mov  dx,03c0h
       mov  al,11h+32
       out  dx,al
       mov  al,12
       out  dx,al
     End;
{$EndIf}
    Berier(X1p shl 1,Y1p shl 1,X2p shl 1,Y2p shl 1,X3p shl 1,Y3p shl 1,BerierSt);
    {Bezier(X1p,Y1p,X2p,Y2p,X3p,Y3p);}
{$IfDef Test}
     if tria=1 then
     asm
       mov  dx,03c0h
       mov  al,11h+32
       out  dx,al
       mov  al,15
       out  dx,al
     End;
{$EndIf}
    t2:=t2+krokt;

    X1p2:=round(X1p+p*(2*X2p-2*X1p)+p*p*(X1p+X3p-2*X2p));
    Y1p2:=round(Y1p+p*(2*Y2p-2*Y1p)+p*p*(Y1p+Y3p-2*Y2p));

    X3p2:=round(X1p+(1-p)*(2*X2p-2*X1p)+(1-p)*(1-p)*(X1p+X3p-2*X2p));
    Y3p2:=round(Y1p+(1-p)*(2*Y2p-2*Y1p)+(1-p)*(1-p)*(Y1p+Y3p-2*Y2p));

    X2p2:=round( (X1p2+X3p2)/2 + 2*((Xd1-Xd2)*t2-((X1p2+X3p2)/2-Xd2)));
    Y2p2:=round( (Y1p2+Y3p2)/2 + 2*((Yd1-Yd2)*t2-((Y1p2+Y3p2)/2-Yd2)));


    X1p:=X1p2;  X2p:=X2p2;  X3p:=X3p2;
    Y1p:=Y1p2;  Y2p:=Y2p2;  Y3p:=Y3p2;

  end;


end;

 {  4 --- 3

    |     |
    |     |

    1 --- 2  }


begin
  XMode;

  randomize;

  X1st:=Maxx2-sirkaw div 2;  X2st:=X1st+sirkaw;   X3st:=X2st;  X4st:=X1st;
  Y3st:=Maxy2-vyskaw div 2;   Y4st:=Y3st;  Y1st:=Y3st+vyskaw;  Y2st:=Y1st;

  XSSt:=X1st+random(round((X2st-X1st)*0.3))+round((X2st-X1st)*((1-0.3)/2));
  YSSt:=Y4st+random(round((Y1st-Y3st)*0.3))+round((Y1st-Y3st)*((1-0.3)/2));

  PSeg:=$0a000;

  Yd:=round((X2st-X1st)*0.25);
  Xd:=+stx;  {Yd:=+sty;}

  a:=0;

  repeat

    asm
      mov cx,PSeg
      and cx,$0fff
      shl cx,1
      shl cx,1
      shl cx,1
      shl cx,1
      mov dx,3d4h
      mov al,0ch
      mov ah,ch
      out dx,ax
      mov al,0dh
      mov ah,cl
      out dx,ax

      mov dx,03dah
@Retrace: in al,dx
      test al,08h
      jnz  @Retrace
@NoRetrace: in al,dx
      test al,08h
      jz  @NoRetrace
    end;


    PSeg:=PSeg xor $800;

    asm
       mov  dx,03c4h
       mov  ax,0f02h
       out  dx,ax               { enable writes to all four planes      }

       mov  ax,PSeg             { now clear all display memory, 8 pixels}
       mov  es,ax               { at a time                             }
       xor  di,di               { point ES:DI to display memory         }
       xor  ax,ax               { clear to zero-value pixels            }
       mov  cx,3500h            { # of words in display memory          }
       rep  stosw
    end;

    XSSt:=(X1st+X2st) shr 1 + round(cos(a)*Yd);
    YSSt:=(Y1st+Y3st) shr 1 + round(sin(a)*Yd);

    Yd:=Yd+Xd;
    If Yd>=(X2st-X1st)*0.25 then Xd:=-stx;
    if Yd<=Xd then Xd:=stx;

    a:=a+2*pi/30;

    {
    XSSt:=XSSt+Xd;
    YSSt:=YSSt+Yd;

    If XSSt<=X1st+round((X2st-X1st)*((1-0.5)/2)) then Xd:=stx;
    If YSSt<=Y4st+round((Y1st-Y3st)*((1-0.5)/2)) then Yd:=sty;
    If XSSt>=X1st+round((X2st-X1st)*0.5)+round((X2st-X1st)*((1-0.5)/2)) then Xd:=-stx;
    If YSSt>=Y4st+round((Y1st-Y3st)*0.5)+round((Y1st-Y3st)*((1-0.5)/2)) then Yd:=-sty;
    }

    tria:=1;
{$IfDef Test}
    asm
       mov dx,03dah
@Retrace: in al,dx
      test al,08h
      jz  @Retrace
@NoRetrace: in al,dx
      test al,08h
      jnz  @NoRetrace

       mov  dx,03c0h
       mov  al,11h+32
       out  dx,al
       mov  al,15
       out  dx,al
    End;
{$EndIf}
    Triangel(X1st,Y1st,XSst,YSst,X2st,Y2st);
{$IfDef Test}
    asm
       mov  dx,03c0h
       mov  al,11h+32
       out  dx,al
       mov  al,0
       out  dx,al
    End;
    tria:=0;
{$EndIf}


    Triangel(X2st,Y2st,XSst,YSst,X3st,Y3st);
    Triangel(X3st,Y3st,XSst,YSst,X4st,Y4st);
    Triangel(X4st,Y4st,XSst,YSst,X1st,Y1st);

  until keypressed;

  c:=readkey;
end.
Copyrigth by Zdeno Sekerak 2007, http://www.trsek.com