program that simulate moto race game

program MotoDemo;

{$G+,N+,E-,S-}

type TPoly=record
       X1,X2,X3,X4,Y1,Y2,Position: Longint;
       Length,Color,_TYPE: Byte;
     end;

     TBike=record
       X,Y,Jump,Road,HitPow: Integer;
       Speed,SpeedOVER,_FLS,_FLL: Integer;
       _FUEL,_FLB,Position: Longint;
       _SHIFT,_ANIMATE: Shortint;
       FuelOVER,FuelStopper,Collide: Byte;
     end;

     TByte=array[0..65534] of Byte;
     TLong=array[0..159] of Longint;

     _BIKE=^TBike;
     _BYTE=^TByte;
     _INT=^Integer;
     _LONG=^Longint;
     _TLONG=^TLong;

const View=1023;
      LapLen=32767;
      Sector=511;
      Bikes=24;
      Memory=300+Bikes;
      Select=1;
      Fuel=1000000;

      A=10;
      B=11;
      C=12;

      Characters: _BYTE=Ptr($F000,$FA6E);
      _TIMER: _LONG=Ptr($0000,$046C);
      _VIDEO: _BYTE=Ptr($A000,$0000);

      Transmission: array[0..6] of Integer=(48,64,96,112,128,144,256);
      Acceleration: array[0..6] of Integer=(128,96,64,48,24,16,8);

      ModelMoto: array[0..1151] of Byte=
      (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
       0,0,0,0,0,0,0,0,0,0,7,C,C,7,0,0,0,0,0,0,0,0,0,0,
       0,0,0,0,0,0,0,0,6,7,7,7,7,7,7,6,0,0,0,0,0,0,0,0,
       0,0,0,0,0,0,0,0,7,7,7,7,7,7,7,7,0,0,0,0,0,0,0,0,
       0,0,0,0,0,0,0,0,7,6,6,6,6,6,6,7,0,0,0,0,0,0,0,0,
       0,0,0,0,0,0,A,A,A,A,A,A,A,A,A,A,A,A,0,0,0,0,0,0,
       0,0,0,0,0,A,B,B,B,B,A,A,A,A,B,B,B,B,A,0,0,0,0,0,
       0,0,0,0,9,B,B,B,B,B,B,A,A,B,B,B,B,B,B,9,0,0,0,0,
       0,0,0,B,9,B,B,B,B,B,B,B,B,B,B,B,B,B,B,9,B,0,0,0,
       0,0,0,B,8,9,B,B,B,B,B,B,B,B,B,B,B,B,9,8,B,0,0,0,
       0,0,B,9,8,8,9,B,A,A,A,A,A,A,A,A,B,9,8,8,9,B,0,0,
       0,0,B,9,8,8,9,A,A,A,A,A,A,A,A,A,A,9,8,8,9,B,0,0,
       0,B,9,8,8,1,9,9,B,B,B,B,B,B,B,B,9,9,1,8,8,9,B,0,
       0,B,9,8,1,1,8,9,B,B,B,B,B,B,B,B,9,8,1,1,8,9,B,0,
       B,9,8,8,1,1,8,9,B,B,B,B,B,B,B,B,9,8,1,1,8,8,9,B,
       B,9,8,8,1,1,1,8,B,9,9,9,9,9,9,B,8,1,1,1,8,8,9,B,
       B,9,8,1,1,1,1,8,9,8,8,8,8,8,8,9,8,1,1,1,1,8,9,B,
       0,8,8,1,1,1,B,B,7,7,7,7,7,7,7,7,B,B,1,1,1,8,8,0,
       0,0,0,B,B,B,A,7,6,7,7,7,7,7,7,6,7,A,B,B,B,0,0,0,
       0,B,B,A,A,A,A,7,6,6,6,6,6,6,6,6,7,A,A,A,A,B,B,0,
       0,A,A,9,9,9,7,5,7,5,5,5,5,5,5,7,5,7,9,9,9,A,A,0,
       0,A,9,9,8,8,7,5,7,5,7,7,7,7,5,7,5,7,8,8,9,9,A,0,
       0,A,9,8,1,7,5,7,7,5,7,7,7,7,5,7,7,5,7,1,8,9,A,0,
       0,9,8,1,1,7,5,7,7,5,5,5,5,5,5,7,7,5,7,1,1,8,9,0,
       0,A,9,1,1,7,5,7,2,2,2,2,2,2,2,2,7,5,7,1,8,9,A,0,
       0,A,9,6,7,5,2,2,2,2,2,2,2,2,2,2,2,2,5,7,6,9,A,0,
       0,7,7,6,7,5,2,2,2,2,1,1,1,1,2,2,2,2,5,7,6,7,7,0,
       0,7,7,6,5,5,2,2,2,1,1,1,1,1,1,2,2,2,5,5,6,7,7,0,
       0,7,7,5,1,1,5,2,2,1,1,1,1,1,1,2,2,5,1,1,5,7,7,0,
       0,7,7,5,1,1,5,2,2,1,1,1,1,1,1,2,2,5,1,1,5,7,7,0,
       0,0,7,1,5,5,1,3,3,1,1,1,1,1,1,3,3,1,5,5,1,7,0,0,
       0,0,7,1,4,3,1,3,3,1,1,2,1,1,1,3,3,1,3,4,1,7,0,0,
       0,0,7,1,4,3,1,3,3,1,2,1,2,1,1,3,3,1,3,4,1,7,0,0,
       0,7,6,1,4,3,1,3,3,1,1,2,1,1,1,3,3,1,3,4,1,6,7,0,
       0,7,6,1,4,3,1,3,3,1,2,1,2,1,1,3,3,1,3,4,1,6,7,0,
       0,7,6,1,4,3,1,3,4,1,1,2,1,1,1,4,3,1,3,4,1,6,7,0,
       0,7,6,1,4,3,1,3,4,1,2,1,2,1,1,4,3,1,3,4,1,6,7,0,
       0,0,7,1,1,1,1,3,4,1,1,2,1,1,1,4,3,1,1,1,1,7,0,0,
       0,0,0,1,1,1,1,3,4,1,2,1,2,1,1,4,3,1,1,1,1,0,0,0,
       0,0,0,0,1,1,1,1,1,1,1,2,1,1,1,1,1,1,1,1,0,0,0,0,
       0,0,0,0,0,1,1,1,1,1,2,1,2,1,1,1,1,1,1,0,0,0,0,0,
       0,0,0,0,0,0,0,0,0,1,1,2,1,1,1,0,0,0,0,0,0,0,0,0,
       0,0,0,0,0,0,0,0,0,1,2,1,2,1,1,0,0,0,0,0,0,0,0,0,
       0,0,0,0,0,0,0,0,0,1,1,2,1,1,1,0,0,0,0,0,0,0,0,0,
       0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,
       0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,
       0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,
       0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0);

      Arbre: array[0..767] of Byte=
      (0,4,4,6,0,0,0,0,0,4,6,0,0,0,0,0,0,0,0,0,0,0,0,0,
       5,5,4,4,6,6,0,0,0,0,4,4,6,6,0,0,0,0,0,0,0,0,6,0,
       0,5,5,4,4,4,0,6,0,0,0,5,4,4,6,0,0,0,6,6,0,0,4,0,
       0,0,5,5,5,0,0,4,6,6,0,5,5,5,4,6,0,5,4,4,0,4,4,5,
       0,0,0,5,5,0,5,4,4,4,6,4,5,5,5,0,1,0,5,4,4,4,5,5,
       0,0,0,3,1,0,5,5,5,4,5,5,5,1,0,0,1,5,5,4,0,5,5,0,
       4,4,4,0,3,1,0,5,5,5,5,5,0,0,1,1,3,0,5,5,0,5,5,0,
       0,5,4,0,3,1,0,0,1,5,5,0,0,1,3,3,0,0,0,5,0,1,5,0,
       0,5,5,4,0,3,1,1,0,0,0,0,6,6,6,0,6,4,4,0,1,3,0,4,
       0,0,5,5,0,5,4,4,6,0,0,6,6,6,4,0,0,4,4,0,1,4,4,5,
       4,0,0,0,1,5,5,4,4,6,6,6,4,4,4,4,0,0,1,1,3,4,5,5,
       4,6,6,0,0,0,5,5,5,4,4,4,4,4,4,5,0,1,3,1,5,5,0,0,
       4,4,4,6,0,0,0,5,5,5,5,4,5,5,5,0,0,1,3,0,0,6,6,6,
       5,5,4,4,6,6,0,5,5,5,5,5,5,5,5,1,1,3,0,6,6,4,4,4,
       0,5,5,4,4,4,6,0,0,5,5,5,0,0,1,3,3,0,0,6,4,4,4,5,
       0,5,5,4,4,4,4,4,0,0,0,0,1,1,3,0,1,6,6,4,4,4,5,0,
       0,5,5,5,5,4,4,4,4,1,3,0,1,0,1,1,3,4,4,4,4,5,5,0,
       0,0,5,5,5,5,5,3,1,3,1,1,2,3,3,3,0,0,5,5,5,5,0,0,
       0,0,0,0,5,5,0,0,3,0,1,2,2,3,0,0,0,0,0,0,0,0,0,0,
       0,0,0,0,0,0,0,0,0,0,1,2,3,3,0,0,0,0,0,0,0,0,0,0,
       0,0,0,0,0,0,0,0,0,0,1,2,2,3,0,0,0,0,0,0,0,0,0,0,
       0,0,0,0,0,0,0,0,0,0,1,2,2,3,0,0,0,0,0,0,0,0,0,0,
       0,0,0,0,0,0,0,0,0,0,1,1,2,3,0,0,0,0,0,0,0,0,0,0,
       0,0,0,0,0,0,0,0,0,0,1,1,2,3,0,0,0,0,0,0,0,0,0,0,
       0,0,0,0,0,0,0,0,0,0,1,1,3,3,0,0,0,0,0,0,0,0,0,0,
       0,0,0,0,0,0,0,0,0,0,1,1,3,3,0,0,0,0,0,0,0,0,0,0,
       0,0,0,0,0,0,0,0,0,0,1,2,3,3,0,0,0,0,0,0,0,0,0,0,
       0,0,0,0,0,0,0,0,0,0,1,1,2,3,0,0,0,0,0,0,0,0,0,0,
       0,0,0,0,0,0,0,0,0,0,1,2,2,3,0,0,0,0,0,0,0,0,0,0,
       0,0,0,0,0,0,0,0,0,0,1,1,2,3,0,0,0,0,0,0,0,0,0,0,
       0,0,0,0,0,0,0,0,0,0,1,1,3,3,0,0,0,0,0,0,0,0,0,0,
       0,0,0,0,0,0,0,0,0,1,1,1,2,3,3,0,0,0,0,0,0,0,0,0);

      Barre: array[0..15] of Byte=
      (13,13,14,14,15,15,14,14,14,14,13,13,14,14,15,15);

var Screen: _BYTE;
    Ground: _BYTE;
    Panel: _BYTE;

    Moto: array[0..3] of _BYTE;

    RenderH: array[0..View] of Integer;
    RenderV: array[0..View] of Integer;

    Curves: array[0..Sector] of Integer;
    Mounts: array[0..Sector] of Integer;

    MemPoly: array[0..Memory] of TPoly;
    GetPoly: array[0..Memory] of TPoly;
    Biker: array[1..Bikes] of TBike;

    zSort: array[0..Memory] of Integer;
    iSort: array[0..Memory] of Integer;

    Left,Right: TLong;
    Visible: Integer;

procedure VGA; assembler;
asm
  mov ax,$13
  int $10
end;

procedure CloseVGA; assembler;
asm
  mov ax,$3
  int $10
end;

procedure MoveWord(var Source,Dest; Size: Word); assembler;
asm
  push ds
  lds si,Source
  les di,Dest
  mov cx,Size
  rep movsw
  pop ds
end;

procedure Fill(_OFF: Word; Color: Byte; Size: Word); assembler;
asm
  les di,Screen
  add di,_OFF
  mov cx,Size
  mov al,Color
  rep stosb
end;

procedure TileMove(_POS: Integer; var Source,Dest);
var _POSsrc,_POSdst,Count: Word;
begin
  for Count:=0 to 159 do
  begin
    _POSsrc:=Count shl 8;
    _POSdst:=Count*320;

    asm
      push ds
      lds si,Source
      les di,Dest
      add di,_POSdst
      mov bx,_POSsrc
      mov dx,_POS
      mov cx,320
     @COPY:
      and dx,255
      mov si,bx
      add si,dx
      lodsb
      stosb
      inc dx
      loop @COPY
      pop ds
    end;
  end;
end;

procedure OutByte(X,Y: Integer; Shade,Color: Byte; Value: Char);
var CntA,CntB,Offset: Word;
    Result: Byte;
begin
  for CntA:=0 to 7 do
  begin
    Result:=Characters^[Byte(Value)*8 +CntA];
    Offset:=(CntA+Y)*320 +X;
    for CntB:=0 to 3 do
      if (Result shl (CntB*2)) and 128 <>0 then
      begin
        Screen^[Offset+CntB+1]:=Shade;
        Screen^[Offset+CntB]:=Color;
      end;
  end;
end;

procedure RollByte(X,Y: Integer; Color: Byte; Value: Word);
var CntA,CntB,Offset: Word;
    Result: Byte;
begin
  for CntA:=0 to 7 do
  begin
    Result:=Characters^[384+(CntA+Value) mod 80];
    Offset:=(CntA+Y)*320 +X;
    for CntB:=0 to 3 do
      if (Result shl (CntB*2)) and 128 <>0 then
        Screen^[Offset+CntB]:=Color;
  end;
end;

procedure OutText(X,Y: Integer; Shade,Color: Byte; Text: string);
var Count: Integer;
begin
  for Count:=0 to Word(Text[0])-1 do
    OutByte(X+Count*8,Y,Shade,Color,Text[Count+1]);
end;

procedure RollCounter(X,Y: Integer; Value: Longint);
var TmpA,TmpB,_POS: Integer;
    Number: Longint;
begin
  Number:=1;
  _POS:=7;

  repeat
    TmpA:=(Value div Number) mod 80;

    if _POS<7 then
    begin
      TmpA:=(TmpA div 8)*8;
      if TmpB>72 then TmpA:=TmpA+TmpB-72;
    end;

    RollByte(X+_POS*8,Y,157-Byte(_POS=7),TmpA);

    TmpB:=TmpA;
    _POS:=_POS-1;
    Number:=Number*10;
  until _POS<0;
end;

procedure SwapNumber(X,Y: _LONG);
var Temp: Longint;
begin
  Temp:=X^;
  X^:=Y^;
  Y^:=Temp;
end;

procedure Poly(X1,X2,Y1,Y2: Longint; Dest: _TLONG);
var PolyH,PolyHA,PolyHeight: Single;
    Count: Word;
begin
  PolyHeight:=Y2-Y1;
  if PolyHeight<1 then PolyHeight:=1;

  PolyH:=X1;
  PolyHA:=(X2-X1) /PolyHeight;

  if Y1<0 then
  begin
    PolyH:=PolyH-(Y1*PolyHA);
    Y1:=0;
  end;
  if Y2>159 then Y2:=159;

  if Y1<=Y2 then
    for Count:=Word(Y1) to Word(Y2) do
    begin
      Dest^[Count]:=Trunc(PolyH);
      PolyH:=PolyH+PolyHA;
    end;
end;

procedure PolyColor(X1,X2,X3,X4,Y1,Y2: Longint; Color: Byte);

  procedure FillLine(X1,X2: Longint; Y: Word);
  begin
    if X1<0 then X1:=0;
    if X2>319 then X2:=319;

    if X1<=X2 then
      Fill(Y*320+Word(X1),Color,Word(X2-X1+1));
  end;

var Count: Word;
begin
  if Y2<Y1 then
  begin
    SwapNumber(@X1,@X2);
    SwapNumber(@X3,@X4);
    SwapNumber(@Y1,@Y2);
  end;

  Poly(X1,X2,Y1,Y2,@Left);
  Poly(X3,X4,Y1,Y2,@Right);

  if Y1<0 then Y1:=0;
  if Y2>159 then Y2:=159;

  if Y1<=Y2 then
    for Count:=Word(Y1) to Word(Y2) do
    begin
      if Left[Count]<=Right[Count] then
        FillLine(Left[Count],Right[Count],Count)
      else
        FillLine(Right[Count],Left[Count],Count);
    end;
end;

procedure PolyTexture(X1,X2,X3,X4,Y1,Y2: Longint;
                      Width,Height: Integer; Texture: _BYTE);

  procedure TextureLine(X1,X2: Longint; Y,Offset: Word);
  var TexH,TexHA,Count: Word;
      Color: Byte;
  begin
    TexH:=0;
    TexHA:=Width shl 8 div (1+X2-X1);

    if X1<0 then
    begin
      TexH:=TexH-(X1*TexHA);
      X1:=0;
    end;
    if X2>319 then X2:=319;

    if X1<=X2 then
      for Count:=Word(X1) to Word(X2) do
      begin
        Color:=Texture^[Offset+TexH shr 8];
        if Color <>0 then Screen^[Y+Count]:=Color;
        TexH:=TexH+TexHA;
      end;
  end;

var TexV,TexVA,Count: Word;
begin
  if Y2<Y1 then
  begin
    SwapNumber(@X1,@X2);
    SwapNumber(@X3,@X4);
    SwapNumber(@Y1,@Y2);
  end;

  Poly(X1,X2,Y1,Y2,@Left);
  Poly(X3,X4,Y1,Y2,@Right);

  TexV:=0;
  TexVA:=Height shl 8 div (1+Y2-Y1);

  if Y1<0 then
  begin
    TexV:=TexV-(Y1*TexVA);
    Y1:=0;
  end;
  if Y2>159 then Y2:=159;

  if Y1<=Y2 then
    for Count:=Word(Y1) to Word(Y2) do
    begin
      if Left[Count]<=Right[Count] then
        TextureLine(Left[Count],Right[Count],Count*320,
                    (TexV shr 8)*Width)
      else
        TextureLine(Right[Count],Left[Count],Count*320,
                    (TexV shr 8)*Width);

      TexV:=TexV+TexVA;
    end;
end;

procedure Calculation(X,Y,Position: Longint);
var _POS,Length,_SELECT: Longint;
    Count: Word;
begin
  for Count:=0 to Memory do
  begin
    GetPoly[Count].Length:=MemPoly[Count].Length;
    GetPoly[Count].Color:=MemPoly[Count].Color;
    GetPoly[Count]._TYPE:=MemPoly[Count]._TYPE;

    if GetPoly[Count]._TYPE in [1..3,8] then
      _SELECT:=View
    else
      _SELECT:=LapLen;

    _POS:=1+(MemPoly[Count].Position-Position) and _SELECT;

    if (_POS>16) and (_POS<View) then
    begin
      Length:=_POS-GetPoly[Count].Length;
      if Length<1 then Length:=1;

      GetPoly[Count].X1:=160+(X+MemPoly[Count].X1-RenderH[_POS])*64 div
_POS;
      GetPoly[Count].X2:=160+(X+MemPoly[Count].X2-RenderH[Length])*64 div
Length;
      GetPoly[Count].X3:=160+(X+MemPoly[Count].X3-RenderH[_POS])*64 div
_POS;
      GetPoly[Count].X4:=160+(X+MemPoly[Count].X4-RenderH[Length])*64 div
Length;
      GetPoly[Count].Y1:=80+(Y+MemPoly[Count].Y1-RenderV[_POS])*42 div _POS;
      GetPoly[Count].Y2:=80+(Y+MemPoly[Count].Y2-RenderV[Length])*42 div
Length;

      Visible:=Visible+1;
      zSort[Visible]:=_POS;
      iSort[Visible]:=Count;
    end;
  end;
end;

procedure Sort(Lo,Hi: Integer);
var X,Y,I,J: Integer;
begin
  I:=Lo;
  J:=Hi;
  X:=zSort[(Lo+Hi) div 2];
  repeat
    while X<zSort[I] do I:=I+1;
    while X>zSort[J] do J:=J-1;

    if I<=J then
    begin
      Y:=zSort[I];
      zSort[I]:=zSort[J];
      zSort[J]:=Y;
      Y:=iSort[I];
      iSort[I]:=iSort[J];
      iSort[J]:=Y;
      I:=I+1;
      J:=J-1;
    end;
  until I>J;

  if I<Hi then Sort(I,Hi);
  if J>Lo then Sort(Lo,J);
end;

procedure Show(X,Y,Position: Longint);
var Count: Integer;
begin
  Visible:=-1;

  Calculation(X,Y,Position);
  Sort(0,Visible);

  for Count:=0 to Visible do
    with GetPoly[iSort[Count]] do
      case _TYPE of
        1: PolyTexture(X1,X2,X3,X4,Y1,Y2,24,32,@Arbre);
        2: PolyTexture(X1,X2,X3,X4,Y1,Y2,16,1,@Barre);
        3: PolyTexture(X1,X2,X3,X4,Y1,Y2,1,16,@Barre);
        4..7: PolyTexture(X1,X2,X3,X4,Y1,Y2,24,48,Moto[_TYPE-4]);
        8..9: PolyColor(X1,X2,X3,X4,Y1,Y2,Color);
      end;
end;

procedure SectorCreate(Position: Longint);
var LongH,LongHA,LongV,LongVA: Longint;
    Index,Count: Word;
begin
  LongH:=0;
  LongHA:=0;
  LongV:=0;
  LongVA:=0;

  for Count:=0 to View do
  begin
    Index:=Word(Position+Count) shr 6 and Sector;

    RenderH[Count]:=Integer(LongH shr 13);
    RenderV[Count]:=Integer(LongV shr 14);

    LongH:=LongH+LongHA;
    LongV:=LongV+LongVA;

    LongHA:=LongHA+Curves[Index];
    LongVA:=LongVA+Mounts[Index];
  end;
end;

procedure ImageCreate(Bike: _BIKE; X,Y,Position: Longint);
begin
  SectorCreate((Bike^.Position-Position) and LapLen);
  TileMove(Bike^._FLB div 512,Ground^,Screen^);
  Show(Bike^.X+X,Bike^.Y+Y,(Bike^.Position-Position) and LapLen);
end;

procedure SetPolyBike(Bike: _BIKE; Index: Word);
begin
  MemPoly[300+Index].X1:=-12-Bike^.X-Bike^._ANIMATE;
  MemPoly[300+Index].X2:=-12-Bike^.X;
  MemPoly[300+Index].X3:=12-Bike^.X-Bike^._ANIMATE;
  MemPoly[300+Index].X4:=12-Bike^.X;
  MemPoly[300+Index].Y1:=-48-Bike^.Y;
  MemPoly[300+Index].Y2:=-Bike^.Y;
  MemPoly[300+Index].Position:=Bike^.Position and LapLen;
end;

function Curve(Position: Longint): Integer;
begin
  Curve:=Curves[Position shr 6 and Sector];
end;

function Mount(Position: Longint): Integer;
begin
  Mount:=Mounts[Position shr 6 and Sector];
end;

function Shift(Bike: _BIKE): Byte;
var Count,Value: Word;
begin
  Value:=0;

  for Count:=0 to 5 do
    if Bike^.Speed>Transmission[Count] then Value:=Value+1;

  Shift:=Value;
end;

function Range(Bike: _BIKE): Byte;
var Count,Value: Word;
begin
  Value:=Bikes;

  for Count:=1 to Bikes do
    if Bike^.Position>Biker[Count].Position then Value:=Value-1;

  Range:=Value;
end;

procedure SetSpeed(Bike: _BIKE);
var sA,sB: Integer;
begin
  sA:=Bike^.SpeedOVER;

  if Curve(Bike^.Position+128) div 24 <>0 then sA:=100;
  if Bike^.FuelOVER=1 then sA:=0;
  if (Bike^.FuelStopper=1) and (Bike^.X>-150) then sA:=32;

  sB:=Acceleration[Bike^._SHIFT];

  if Bike^.Speed>=sA then sB:=0;
  if Bike^.Speed>=sA+1 then sB:=-32;
  if Bike^.HitPow <>0 then sB:=-64;
  if Bike^.Y>0 then sB:=-16;

  Bike^._FLS:=(Bike^._FLS+sB) mod 100;
  Bike^._FLL:=(Bike^._FLL+Bike^.Speed) mod 16;

  Bike^.Speed:=Bike^.Speed+(Bike^._FLS+sB) div 100;
  if (Bike^.Speed<0) or (Bike^.Collide=1) then Bike^.Speed:=0;

  Bike^.Position:=Bike^.Position+(Bike^._FLL+Bike^.Speed) div 16;
end;

procedure SetFuel(Bike: _BIKE; Step: Longint);
begin
  Bike^._FUEL:=Bike^._FUEL+Step;

  if Bike^._FUEL<0 then
  begin
    Bike^._FUEL:=0;
    Bike^.FuelOVER:=1;
  end;

  if Bike^._FUEL>Fuel then
  begin
    Bike^._FUEL:=Fuel;
    Bike^.FuelOVER:=0;
  end;
end;

procedure TestCollision(Bike: _BIKE);
begin
  if Bike^.Y<=144 then
    if ( (Bike^.X+12>=200) and (Bike^.X-12<=212) ) or
       ( (Bike^.X+12>=-212) and (Bike^.X-12<=-200) ) then
      if (128-Bike^.Position) and 511 <12+Bike^.Speed div 16 then
        Bike^.Collide:=1;
end;

procedure TestJump(Bike: _BIKE; Jump,_SPEED: Longint);
begin
  if Bike^.Y<=0 then
  begin
    Bike^.Jump:=Round(Jump*Bike^.Speed /96);
    if Bike^.Jump>80 then Bike^.Y:=Bike^.Y+_SPEED;
  end
  else
  begin
    if Bike^.Y<Bike^.Jump then
      Bike^.Y:=Bike^.Y+_SPEED
    else
    begin
      Bike^.Jump:=0;
      Bike^.Y:=Bike^.Y-2;
    end;

    if (Bike^.Y <=0) or (Bike^.Collide=1) then Bike^.Y:=0;
  end;
end;

procedure SetAnimation(Bike: _BIKE; ANA,ANB: Integer);
var Speed: Integer;
begin
  if (Bike^.FuelOVER=1) and (Bike^.FuelStopper=0) then
    if Bike^.Speed <12 then ANA:=-164;

  if Bike^.HitPow <>0 then ANA:=Bike^.HitPow;
  if (Bike^.X>-150) and (Bike^.X<150) then Bike^.Collide:=0;

  Speed:=2*(1+Byte(Bike^.HitPow <>0));

  if Bike^.X<ANA then Bike^.X:=Bike^.X+Speed;
  if Bike^.X>ANA then Bike^.X:=Bike^.X-Speed;

  if abs(ANA-Bike^.X) >Speed then
    ANB:=ANA-Bike^.X
  else
    Bike^.HitPow:=0;

  if ANB<-8 then ANB:=-8;
  if ANB>8 then ANB:=8;

  if Bike^._ANIMATE<ANB then Bike^._ANIMATE:=Bike^._ANIMATE+1;
  if Bike^._ANIMATE>ANB then Bike^._ANIMATE:=Bike^._ANIMATE-1;
end;

procedure SetBiker(Bike: _BIKE; _TIME,Index: Word);
var _SPEED: Longint;
begin
  _SPEED:=Longint(Bike^.Speed)*Curve(Bike^.Position) div 4;
  Bike^._FLB:=(Bike^._FLB-_SPEED) and 262143;

  Bike^._SHIFT:=Shift(Bike);

  if _TIME=0 then
  begin
    SetFuel(Bike,-Longint(Bike^.Speed)*40 div Transmission[Bike^._SHIFT]);
    if (Bike^.FuelOVER=1) and (Bike^.Speed <=0) then SetFuel(Bike,800);

    SetAnimation(Bike,Bike^.Road+Curve(Bike^.Position),
                 Curve(Bike^.Position) div 4);
    TestJump(Bike,Mount(Bike^.Position)-Mount(Bike^.Position+128),
             1+Bike^.Speed div 96);
  end;

  TestCollision(Bike);
  SetPolyBike(Bike,Index);
end;

procedure DetectLength(BikeA,BikeB: _BIKE; ValRet: _INT);
begin
  if BikeA^.Speed>BikeB^.Speed then
    if (BikeB^.Position-BikeA^.Position) and LapLen
       <=28 +Longint(BikeA^.Speed-BikeB^.Speed)*4 then
    begin
      if BikeB^.X<=0 then
        BikeA^.Road:=60
      else
        BikeA^.Road:=-60;

      ValRet^:=1;
    end;
end;

procedure DetectInjury(BikeA,BikeB: _BIKE; ValRet: _INT);
begin
  if (BikeB^.Position-BikeA^.Position) and LapLen <=12 then
  begin
    if BikeA^.X<=BikeB^.X then
    begin
      BikeA^.HitPow:=BikeA^.X-50;
      BikeB^.HitPow:=BikeB^.HitPow+150;
    end
    else
    begin
      BikeA^.HitPow:=BikeA^.X+50;
      BikeB^.HitPow:=BikeB^.X-150;
    end;

    ValRet^:=1;
  end;
end;

procedure DetectStopper(BikeA,BikeB: _BIKE);
begin
  if (BikeB^.Position-BikeA^.Position) and LapLen <=32 then
    if (BikeB^.Speed<=0) and (BikeB^.FuelOVER=1) then
      BikeA^.FuelStopper:=1;
end;

procedure DetectCollide(BikeA,BikeB: _BIKE);
var Pow: Integer;
begin
  if BikeA^.Speed>BikeB^.Speed then
    if (BikeB^.Position-BikeA^.Position) and LapLen
       <=20 +(BikeA^.Speed-BikeB^.Speed) div 16 then
    begin
      Pow:=Trunc((BikeA^.Speed-BikeB^.Speed) /1.5);
      BikeA^.Speed:=BikeA^.Speed-Pow;
      BikeB^.Speed:=BikeB^.Speed+Pow+1;
    end;
end;

procedure DetectBiker(Bike: _BIKE; Index: Word);
var Count,RetA,RetB: Integer;
begin
  RetA:=0;
  RetB:=0;

  Bike^.FuelStopper:=0;

  for Count:=1 to Bikes do
    if Count <>Index then
    begin
      if Bike^.FuelOVER=1 then DetectStopper(Bike,@Biker[Count]);

      if (Bike^.X+12>=Biker[Count].X-12) and
         (Bike^.X-12<=Biker[Count].X+12) then
      begin
        if RetA=0 then DetectLength(Bike,@Biker[Count],@RetA);

        if (Bike^.Y+48>=Biker[Count].Y) and
           (Bike^.Y<=Biker[Count].Y+48) then
        begin
          if RetB=0 then DetectInjury(Bike,@Biker[Count],@RetB);
          DetectCollide(Bike,@Biker[Count]);
        end;
      end;
    end;
end;

procedure SetBikers;
var Count,_SELECT: Integer;
begin
  for Count:=1 to Bikes do
  begin
    _SELECT:=Count and 3;

    if Count=Select then _SELECT:=2;
    MemPoly[300+Count]._TYPE:=4+_SELECT;

    Biker[Count].X:=60-(Count and 1)*120;
    Biker[Count].Road:=Biker[Count].X;
    Biker[Count].Position:=(Count-1)*64;
    Biker[Count].SpeedOVER:=180+(_SELECT*4);
    Biker[Count]._FUEL:=Fuel;
  end;
end;

function WordStr(Value: Word): string;
var Number,Position: Word;
begin
  Number:=10000;
  Position:=1;

  repeat
    WordStr[Position]:=char(48 +(Value div Number) mod 10);
    Number:=Number div 10;
    if Value>=Number*10 then Position:=Position+1;
  until Number<1;

  WordStr[0]:=char(Position-1);
end;

procedure Bar(X,Y: Integer; Value,Style: Word);
var Count,Color: Integer;
begin
  if Integer(Value)<0 then Value:=0;
  if Value>41 then Value:=41;

  if Style=0 then
    Color:=155+(Value div 32)
  else
    Color:=155+((41-Value) div 32);

  for Count:=0 to 2 do
    Fill((Y+Count)*320+X,Color,Value);
end;

procedure Information(Bike: _BIKE);
var _RANGE: Byte;
    _SPEED: string;
begin
  MoveWord(Panel^,Screen^[160*320],6400);

  _RANGE:=Range(Bike);
  _SPEED:=WordStr(Bike^.Speed);

  OutText(66-Word(_SPEED[0])*8,181,150,155,_SPEED);
  OutText(12,166,157,150,WordStr(_RANGE)+'/'+WordStr(Bikes));
  OutText(118,166,157,150,'LAP '+WordStr(1+Bike^.Position div LapLen));

  OutText(74,181,157,150,'MPH');
  OutText(222,169,157,150,'FUEL');
  OutText(222,184,157,150,'TACH');

  Bar(261,171,Bike^._FUEL*41 div Fuel,1);
  Bar(261,186,Longint(Bike^.Speed)*41 div Transmission[Bike^._SHIFT],0);

  RollCounter(125,181,Round(Bike^.Position /228));

  if Bike^.FuelOVER=1 then
    if _TIMER^ and 7 >3 then
      OutText(126,150,150,157,'FUEL OVER');
end;

procedure Run;
var Count,_TIME: Word;
begin
  _TIME:=300;
  SetBikers;

  repeat
    for Count:=1 to Bikes do
      DetectBiker(@Biker[Count],Count);
    for Count:=1 to Bikes do
      if _TIME=0 then
        SetSpeed(@Biker[Count]);
    for Count:=1 to Bikes do
      SetBiker(@Biker[Count],_TIME,Count);

    ImageCreate(@Biker[Select],0,56,32);
    Information(@Biker[Select]);

    if _TIME>0 then _TIME:=_TIME-1;

    while Port[$3DA] and 8=0 do;
    MoveWord(Screen^,_VIDEO^,32000);
  until Port[$60]=1;
end;

procedure LapCreate;
var Count,Value: Integer;
begin
  Value:=0;

  for Count:=48 to Sector-48 do
  begin
    if Count and 7 =7 then Value:=-32+Random(64);
    Curves[Count]:=Value;
  end;

  Value:=0;

  for Count:=8 to Sector-8 do
  begin
    if Count and 3=3 then Value:=-32+Random(64);
    Mounts[Count]:=Value;
  end;
end;

procedure MemPolyCreate;

  procedure PolySet(X1,X2,X3,X4,Y1,Y2,Position: Longint;
                    Length,Color,_TYPE: Byte; Index: Word);
  begin
    MemPoly[Index].X1:=X1;
    MemPoly[Index].X2:=X2;
    MemPoly[Index].X3:=X3;
    MemPoly[Index].X4:=X4;
    MemPoly[Index].Y1:=Y1;
    MemPoly[Index].Y2:=Y2;
    MemPoly[Index].Position:=Position;
    MemPoly[Index].Length:=Length;
    MemPoly[Index].Color:=Color;
    MemPoly[Index]._TYPE:=_TYPE;
  end;

var Count: Integer;
begin
  for Count:=0 to 31 do
  begin
    PolySet(-15000,-15000,-140,-140,0,0,
            Count*32,32,1+Count and 1,8,Count);
    PolySet(-140,-140,-132,-132,0,0,
            Count*32,32,3,8,32+Count);
    PolySet(-132,-132,-128,-128,0,0,
            Count*32,32,6,8,64+Count);
    PolySet(-128,-128,128,128,0,0,
            Count*32,32,3,8,96+Count);
    PolySet(128,128,132,132,0,0,
            Count*32,32,6,8,128+Count);
    PolySet(132,132,140,140,0,0,
            Count*32,32,3,8,160+Count);
    PolySet(140,140,15000,15000,0,0,
            Count*32,32,1+Count and 1,8,192+Count);
  end;

  for Count:=0 to 15 do
    PolySet(-3,-3,3,3,0,0,
            Count*64-1,32,5,8,224+Count);

  for Count:=0 to 1 do
  begin
    PolySet(-384,-512,-224,-288,-192,0,
            360+Count*48,0,14-Count and 1,9,240+Count);
    PolySet(224,288,384,512,-192,0,
            360+Count*48,0,14-Count and 1,9,242+Count);
    PolySet(-304,-384,304,384,-256,-192,
            360+Count*48,0,14-Count and 1,9,244+Count);
  end;

  for Count:=0 to 3 do
  begin
    PolySet(-352,-352,-288,-288,-224,0,
            Count*256,0,0,1,246+Count);
    PolySet(288,288,352,352,-224,0,
            Count*256,0,0,1,250+Count);
  end;

  for Count:=0 to 1 do
  begin
    PolySet(-212,-212,-200,-200,-144,0,
            128+Count*512,0,0,2,254+Count);
    PolySet(200,200,212,212,-144,0,
            128+Count*512,0,0,2,256+Count);
    PolySet(-212,-212,212,212,-160,-144,
            128+Count*512,0,0,3,258+Count);
  end;
end;

procedure SpritesCreate;
var CntA,CntB: Integer;
begin
  for CntA:=0 to 767 do
    if Arbre[CntA] <>0 then
      Arbre[CntA]:=Arbre[CntA]+6;

  for CntB:=0 to 3 do
    for CntA:=0 to 1151 do
    begin
      Moto[CntB]^[CntA]:=ModelMoto[CntA];

      if ModelMoto[CntA] in [1..5,12] then
        Moto[CntB]^[CntA]:=ModelMoto[CntA]+19;
      if ModelMoto[CntA] in [6..11] then
        Moto[CntB]^[CntA]:=ModelMoto[CntA]+19+CntB*7;
    end;
end;

procedure SkyMapCreate;
var CntA,CntB: Integer;
    Smooth,Color: Word;
begin
  for CntA:=0 to 255 do
    for CntB:=0 to 255 do
    begin
      Color:=(CntB shr 1+Random(8)) and 127;
      Color:=Color xor (CntA+Random(8));
      Color:=Color mod 38;
      Screen^[CntA*256+CntB]:=Color;
    end;

  for CntA:=0 to 7 do
    for Smooth:=0 to 65535 do
    begin
      Color:=Screen^[Smooth-1];
      Color:=Color+Screen^[Smooth];
      Color:=Color+Screen^[Smooth+1];
      Color:=Color+Screen^[Smooth+256];
      Screen^[Smooth]:=Color shr 2;
    end;
end;

procedure GroundCreate;
var _POS,CntA,CntB,Color: Integer;
    LandBase,LandCode: Real;
begin
  for CntA:=0 to 79 do
    for CntB:=0 to 255 do
    begin
      if CntA>32 then
        Color:=(CntA-32) div 2
      else
        Color:=0;

      Ground^[CntA*256+CntB]:=96+Color;
    end;

  LandBase:=0;
  LandCode:=-24;

  for CntA:=0 to 255 do
  begin
    if CntA and 15=15 then LandCode:=-32+(Sqr(CntA) div 32);
    if CntA>144 then LandCode:=24;

    LandBase:=LandBase+(Sin(LandCode /32*Pi) /1.3);

    for CntB:=0 to 79 do
    begin
      _POS:=Round(LandBase)+79+CntB;
      Color:=Screen^[CntB*256+CntA] div 2;
      Color:=Round(Sin(CntA/112*Pi)*Sin(CntB/32*Pi)*Color)+8;

      if Color<0 then Color:=0;
      if Color>15 then Color:=15;

      if _POS<=79 then
        Ground^[_POS*256+CntA]:=80+Color;
    end;
  end;

  for CntA:=0 to 79 do
    for CntB:=0 to 255 do
    begin
      Color:=Ground^[CntA*256+CntB]-80;
      Color:=Color div 3;
      Ground^[(159-CntA)*256+CntB]:=128+Color;
    end;
end;

procedure PanelCreate;

  procedure FrameBox(X,Y,Width,Height: Integer; Style: Byte);
  var CntA,CntB,CntC: Integer;
      Color: Byte;
  begin
    for CntA:=0 to 3 do
      for CntB:=CntA to Height-CntA do
        for CntC:=CntA to Width-CntA do
        begin
          if Style=0 then
          begin
            Color:=150+CntA;
            Color:=Color+(CntB or CntC) div 2 and 1;
          end
          else
            Color:=153-CntA;

          Panel^[(Y+CntB)*320+X+CntC]:=Color;
        end;
  end;

begin
  FrameBox(0,0,319,39,0);
  FrameBox(12,15,56,18,1);
  FrameBox(118,15,73,18,1);
  FrameBox(256,6,50,12,1);
  FrameBox(256,21,50,12,1);
end;

procedure PaletteCreate;

  procedure Color(Index,Red,Green,Blue: Byte);
  begin
    Port[$3C8]:=Index;
    Port[$3C9]:=Red;
    Port[$3C9]:=Green;
    Port[$3C9]:=Blue;
  end;

var Count: Integer;
begin
  Color(1,10,20,0);
  Color(2,12,24,0);

  Color(3,10,12,14);
  Color(4,10,12,10);
  Color(5,48,36,12);
  Color(6,20,22,24);

  Color(7,32,32,28);
  Color(8,36,36,32);
  Color(9,40,40,36);

  Color(10,0,24,0);
  Color(11,0,20,0);
  Color(12,0,28,0);

  Color(13,24,24,32);
  Color(14,32,32,40);
  Color(15,40,40,48);

  Color(20,4,4,6);
  Color(21,12,12,14);
  Color(22,16,16,32);
  Color(23,32,32,48);
  Color(24,56,56,63);
  Color(31,60,60,63);

  Color(25,32,0,0);
  Color(26,48,0,0);
  Color(27,24,24,32);
  Color(28,32,32,40);
  Color(29,40,40,48);
  Color(30,48,48,56);

  Color(32,0,32,0);
  Color(33,16,48,16);
  Color(34,0,8,32);
  Color(35,0,16,40);
  Color(36,0,24,48);
  Color(37,0,32,56);

  Color(39,32,32,0);
  Color(40,48,48,0);
  Color(41,4,4,8);
  Color(42,12,12,16);
  Color(43,20,20,24);
  Color(44,28,28,32);

  Color(46,16,16,24);
  Color(47,32,32,40);
  Color(48,32,0,0);
  Color(49,40,8,0);
  Color(50,48,16,0);
  Color(51,56,24,0);

  for Count:=0 to 15 do
    Color(80+Count,Count*2,16+Count,8+Count);
  for Count:=0 to 31 do
    Color(96+Count,4+Count,Count,32);
  for Count:=0 to 15 do
    Color(128+Count,4+Count,8+Count,36);
  for Count:=0 to 4 do
    Color(150+Count,Count*4,Count*4,16);

  Color(155,0,48,0);
  Color(156,48,0,0);
  Color(157,48,50,52);
end;

procedure MemInitialize;
var Count: Integer;
begin
  GetMem(Screen,65535);
  GetMem(Ground,40960);
  GetMem(Panel,12800);

  for Count:=0 to 3 do
    GetMem(Moto[Count],1152);
end;

procedure MemFree;
var Count: Integer;
begin
  Dispose(Screen);
  Dispose(Ground);
  Dispose(Panel);

  for Count:=0 to 3 do
    Dispose(Moto[Count]);
end;

begin
  if MemAvail>192000 then
  begin
    Randomize;
    MemInitialize;
    LapCreate;
    MemPolyCreate;
    SpritesCreate;
    SkyMapCreate;
    GroundCreate;
    PanelCreate;
    VGA;
    PaletteCreate;
    Run;
    CloseVGA;
    MemFree;
    WriteLn('D,mo MOTOS - Chris(c) 2000');
  end
  else
    WriteLn('M,moire insuffisante pour continuer');
end.