Collection of Hack-Phreak Scene Programs/cleanhpvac.zip/cleanhpvac/PINBSRC.ZIP/FLIPPER2.PAS

Pascal/Delphi Source File | 1996-02-02 | 37KB | 1,156 lines

{ FLIPPER2.PAS   - (c) Ansgar Scherp, Joachim Gelhaus
  All rights reserved / vt'95

  1 Parameter = as FLIPPER1.PAS

  }

{$M 65520,0,655360}
{$P+,G+}
uses dos,crt,soundkit,audiotpu;

const N1 = ' PCS-PINBALL  - Version 1.1 written by A.Scherp and J.Gelhaus ';
      N2 = ' (c)opyrights reserved by PC Spiel and vIRTUAL tECHNOLOGIES GbR';

const
      Bits       : array[0..9] of byte = (128,64,32,16,8,4,2,1,0,0);
      VSeg       : word = $A000;
      speedmaxy  : byte = 100;

      tnr  : char = '2';

      ArmBreiteLinks : byte = 56;
      ArmHoeheLinks  : byte = 48;
      ArmXLinks      : word = 79+5;
      ArmYLinks      : word = 400+135+14;

      ArmBreiteRechts : byte = 56;
      ArmHoeheRechts  : byte = 48;
      ArmXRechts      : word = 159-4;
      ArmYRechts      : word = 400+135+14;

      FederBreite     : word = 8;
      FederX          : word = 302;

      no         : boolean = false;
      yes        : boolean = true;
      rahmen     : byte = 255;
      arm        : byte = 128;

const snd1 = 1;
      snd2 = 2;
      snd3 = 3;
      snd4 = 4;
      snd5 = 5;
      snd6 = 6;
      snd7 = 7;
      snd8 = 8;
      snd9 = 9;
      snd10 = 10;
      snd11 = 11;
      snd12 = 12;
      snd13 = 13;
      snd14 = 14;

      SetSprite_VGAADR : array[0..6] of word = (258,514,1026,2050,258,514,1026);
      GetSprite_VGAADR : array[0..6] of word = ($4,$104,$204,$304,$04,$104,$204);

      MaxBalls = 4;


{*** TYPE ******************************************************************}

type ttableground1=array[0..319,0..199] of byte;
type ttableground2=array[0..319,200..399] of byte;
type ttableground3=array[0..319,400..599] of byte;
type reihe = array[1..15360] of byte;



var  OldHeapLimit: pointer;
     OldHeapSize : Longint;

     ledseg,
     armlinksseg,armrechtsseg,
     armlinks_mskseg,armrechts_mskseg,
     ballseg,
     groundseg,
     ballspriteseg,
     undergroundseg,
     tablegroundseg,federseg:word;

     led_display,
     ball,
     ground,
     ball_sprite,
     underground,
     tableground,feder:pointer;
     arm_links           : ^reihe;
     arm_rechts          : ^reihe;

     arm_links_msk       : ^reihe;
     arm_rechts_msk      : ^reihe;


     tableground1:^ttableground1;
     tableground2:^ttableground2;
     tableground3:^ttableground3;

     ch:char;

     led_hoehe:byte;
     led_color_1, led_color_2:byte;
     led_funktion, led_parameter,led_timer,led_x,led_Y,led_status:word;
     led_anzeige_text:string;
     led_f_status_1,led_f_status_2:byte;

     Fseg,Fofs : word;

     Fdata : array[1..4096] of byte;

     arm_links_status, arm_rechts_status:byte;
     arm_links_old_status, arm_rechts_old_status:byte;


     ballx,bally,bx_old,by_old:integer;

     ballspeed_y,ballspeed_x:integer;


     ran255:array[0..255] of byte;
     ran255z:byte;

     l1,l2,r1,r2,u1,u2,o1,o2 : byte;

     fu,fo,fl,fr,fm : byte;
     fh : byte;

     kraft : integer;

     overscan, highres : boolean;

     UseSound  : boolean;
     sounds:array[1..14] of pointer;
     soundlength:array[1..14] of word;

     score:array [1..6] of longint;

     StartPow  : word ;

     NormalPos : integer;
     CurrentPos : integer;

     path : string;

     MAXfarbe: byte;

     OldFileMode : byte;

     VideoMode : char;

     bende  : boolean;

     pal : array[0..255] of record
             r : byte;
             g : byte;
             b : byte;
           end;

     ruetteln : byte;

     FederY : word;
     FederHoehe : word;

     hilfsb:byte;


{*** TABLE2 *************************************************************** }

     RAT : array[24..26] of byte; {R, A, T}
     PHASER : array[233..238] of byte; {P, H, A, S, E, R}
     RL : boolean; {RELAUNCH}
     PFEIL : byte; {2x,4x,6x}
     Felder1 : byte; {5k,3k,1k top left}
     Felder2 : byte; {500,1000,1500}
     Felder3 : byte; {10.000,20.000,30.000,50.000}
     Locked : byte; { 0 - > no Ball locked // 1 - > Ball locked //
                      2 - > locked ball already released!!! }
     Counter : Byte;

     Balls    : array[1..6] of integer;
     MaxPlayer   : byte;
     ActPlayer : byte;

const TischGrad : byte = 2;
var   grad : byte;

procedure calc_page_pos_of_ballpos; forward;
procedure display(t : string); forward;
procedure check_flipper_arms; forward;
procedure analyse_arms; forward;
procedure senk_arms; forward;
procedure move_ball; forward;
procedure IncScore(points:word); forward;


{*** FONTS **************************************************************** }
{$F+}
procedure font; external;
{$L FONTS\thin8X8.OBJ}
{$F-}

{*** INCLUDEN ************************************************************* }
{$I _RANDOM .PAS} {short random number list}
{$I _VIDEO  .PAS} {all video functions // // and arm_draw}
{$I _LOADPRC.PAS}
{I _GRAPH  .PAS} {ball and ground draw routines Kann weg:-) }
{$I _LEDANZ .PAS} {all routines for the led}
{$I _AUTODRA.PAS} {procedure for automatic-draw // chose the right plane}
{$I _KEYS   .PAS}
{$I _SOUND2 .PAS} {soundkit}
{$I _INI_CLO.PAS} {init_all & close}
{I _INTEGRI.PAS} {check for integrity // read volumelabel of cd-rom}
{$I _CDPLAYR.PAS} {audio-cd-player-routines}
{$I _TISCH2 .PAS}

procedure senk_arms;
  var t : byte;
begin
  for t := 5 downto 0 do begin
       if arm_rechts_status>1 then dec(arm_rechts_status);
       if arm_links_status>1 then dec(arm_links_status);
       Check_Flipper_Arms;
       arm_links_old_status:=arm_links_status;
       arm_rechts_old_status:=arm_rechts_status;
     end;
  draw_ground_auto;
end;

procedure move_left;
  var alt : byte;
      a : word;
begin
  alt := led_funktion;
  led_anzeige_6_init;
  for a := 0 to 80 do begin led_anzeige; retrace; end;
  led_funktion := alt;
end;

procedure IncScore(points:word);
begin
 score[actplayer] := score[actplayer] + points;
 led_anzeige_5_init(0,0,'Score'+IntToStr1(score[actplayer])+
                        ' Ball '+inttostr(balls[ActPlayer]));
end;

procedure display(t : string);
  var a : byte;
      z : string[20];
begin
 z := '                     ';
 for a := 1 to length(t) do z[a + 10 - length(t) div 2 ] := t[a];
 led_anzeige_5_init(0,0,z);
end;

procedure Check_Ball; forward;

procedure move_ball;
begin
  draw_ground_auto; get_ground_auto; draw_ball_auto;
  bx_old:=ballx; by_old:=bally;
end;

procedure calc_page_pos_of_ballpos;
var y2:word; {longint;}
begin
  {y2:=bally-100;}
  asm mov ax, bally; sub ax, 100; mov y2, ax; end;
{  if y2<1 then y2:=1;} if y2 > 1000 then y2 := 1;
  if y2>421 then y2:=421;
  { y2:=y2+48;}
  asm mov ax,y2; add ax,48; mov y2,ax; end;
  if HighRes then if y2> 270 then y2 := 270;
  {80*y2}
  asm mov ax,y2; mov bx,80; mul bx; mov y2,ax; end;
  setaddress(y2);
end;

procedure Check_Flipper_Arms;

begin
  {check if left flipper-arm is moved}
  if arm_links_old_status<>arm_links_status then
    if (bally+16>armYlinks) and (bally<armYlinks+armHoeheLinks) and
       (ballx+16>armXlinks) and (ballx<armXlinks+armBreitelinks) then begin
        draw_ground_auto;{}
        draw_arm_links;
        get_ground_auto;{}
        draw_ball_auto;
      end else draw_arm_links;
  {check if right flipper-arm is moved}
if (arm_rechts_old_status<>arm_rechts_status) then
    if (bally+16>armYrechts) and (bally<armYrechts+armHoeherechts) and
       (ballx+16>armXrechts) and (ballx<armXrechts+armBreiterechts) then begin
        draw_ground_auto;
        draw_arm_rechts;
        get_ground_auto;
        draw_ball_auto;
      end else draw_arm_rechts;
end;

procedure analyse_arms;
 var w : byte;
begin
  if abs(ballspeed_x) > 4 then w := 0 else w := 3;

  if (fo > 0) and (ballspeed_y < 0) then begin
      ballspeed_y := abs(ballspeed_y);
      kraft := 0;
      exit;
    end;
  if ballx < 142{152} then begin
    if arm_links_old_status < arm_links_status then begin
        draw_arm_links;
        Check_Ball;
        ballspeed_y := - abs(Ballx+4 - ArmXLinks);
      if ballspeed_y < - 50 then ballspeed_y := -50;
        bally := bally + ballspeed_y;
        kraft := abs(ballspeed_y)-10;
        case arm_links_status of
          1 : inc(ballspeed_x,7+random(4)); {5/2}
          2 : inc(ballspeed_x,5+random(4));
          4 : dec(ballspeed_x,5+random(4));
          5 : dec(ballspeed_x,7+random(4));
        end;
      end else begin
        case arm_links_status of
          1 : inc(ballspeed_x,(abs(ballspeed_y)+w) div 4);
          2 : inc(ballspeed_x,(abs(ballspeed_y)+w) div 4);
          4 : dec(ballspeed_x,(abs(ballspeed_y)+w) div 4);
          5 : dec(ballspeed_x,(abs(ballspeed_y)+w) div 4);
        end;
        inc(ballspeed_y,2);
      end;
  end else
    if arm_rechts_old_status < arm_rechts_status then begin
        draw_arm_rechts;
        Check_Ball;
        kraft := 50;
        ballspeed_y := - abs(ArmBreiteRechts - (Ballx+4{+8} - ArmXRechts));
       if ballspeed_y < - 50 then ballspeed_y := -50;
        bally := bally + ballspeed_y;
        kraft := abs(ballspeed_y)-10;
      case arm_rechts_status of
        1 : dec(ballspeed_x,7+random(4));
        2 : dec(ballspeed_x,5+random(4));
        4 : inc(ballspeed_x,5+random(4));
        5 : inc(ballspeed_x,7+random(4));
      end;
    end else begin
        case arm_rechts_status of
          1 : dec(ballspeed_x,(abs(ballspeed_y)+w) div 4);
          2 : dec(ballspeed_x,(abs(ballspeed_y)+w) div 4);
          4 : inc(ballspeed_x,(abs(ballspeed_y)+w) div 4);
          5 : inc(ballspeed_x,(abs(ballspeed_y)+w) div 4);
        end;
        inc(ballspeed_y,2);
      end;
  fl := 0; fr := 0; fu := 0; fo := 0;
end;

{ *** EVENTS ***************************************************************}

procedure analyse_crash;
var fg,a,b,c,d,w:byte;
begin
  if fr>0 then fg:=fr;
  if fl>0 then fg:=fl;
  if fo>0 then fg:=fo;
  if fu>0 then fg:=fu;
  case fg of
    254 : begin
            incscore(100);
            if ballspeed_y > 0 then ballspeed_x := abs(ballspeed_y)
                               else ballspeed_x := -abs(ballspeed_y);
            if ballspeed_x > 0 then ballspeed_y := abs(ballspeed_x) div 2
                                        + random(5)
                               else ballspeed_y := -abs(ballspeed_x) div 2;
            play(snd14);
          end;
     253 : begin
          { ballspeed_x := ballspeed_x - 10;}
            if abs(ballspeed_x) > 4 then w := 0 else w := 1;
            dec(ballspeed_x,(abs(ballspeed_y)+w) div 4);
            inc(ballspeed_y,2);
          end;
    252 : begin
           {ballspeed_x := ballspeed_x + 10;}
            if abs(ballspeed_x) > 4 then w := 0 else w := 1;
            inc(ballspeed_x,(abs(ballspeed_y)+w) div 4);
            inc(ballspeed_y,2);
          end;
    250,251 : begin
            if ballx < 160 then begin
                if RL then begin
                    play(snd12);
                    ballspeed_y := -30-random(15);
                    inc(ballspeed_x,6);
                    kraft := 100;
                  end
               end else if RL then begin
                            play(snd12);
                            ballspeed_y := -30-random(15);
                            inc(ballspeed_x,4+random(3));
                            kraft := 100;
                          end;
          end;
    249 : begin
            incscore(100);
            if ballspeed_y < 0 then ballspeed_x := abs(ballspeed_y)
                               else ballspeed_x := -abs(ballspeed_y);
            if ballspeed_x < 0 then ballspeed_y := abs(ballspeed_x) div 2
                               else ballspeed_y := -abs(ballspeed_x) div 2;
            play(snd14);
          end;
    248 : begin
            incscore(100);
            ballspeed_y := ballspeed_y div 2;
            dec(ballspeed_x,ballspeed_y);
            play(snd1);
          end;
    247 : begin
          play(snd4);
          HilfsProc2;
          counter := 10; set_rgb_color(247,60,30,20);
          end;
    246 : begin
          play(snd4);
          HilfsProc2;
          counter := 10; set_rgb_color(246,60,30,20);
          end;
    245 : begin
          play(snd4);
          HilfsProc2;
          counter := 10; set_rgb_color(245,60,30,20);
          end;
    244 : begin
          play(snd4);
          HilfsProc2;
          counter := 10; set_rgb_color(244,60,30,20);
          end;
    243 : begin
          incscore(50);
          {if ballspeed_x < 0 then ballspeed_x := -15;
          if ballspeed_x > 0 then ballspeed_x := 15;}
          if ballspeed_x < 0 then ballspeed_x := -8-random(4);
          if ballspeed_x > 0 then ballspeed_x := 8+random(4);
          if ballspeed_y < 0 then ballspeed_y := -8-random(4);
          if ballspeed_y > 0 then ballspeed_y := 8+random(4);
          if ballx < 160 then begin
              counter := 10; set_rgb_color(96,60,30,20); play(snd3);
            end else begin
              counter := 10; set_rgb_color(97,60,30,20); play(snd13);
              end;
       end;
    242 : begin
           display('>-BALL-<>-LOST-<');
           play(snd9);
           repeat led_anzeige; until led_status=0;
           senk_arms;
           asm cli end;
           delay(1000);
           move_left;
           {LOCKED BALL RELEASEN WHEN EXISTANCE}
           if locked = 1 then begin
               display('RELEASE LOCKED BALL!');

               repeat led_anzeige; until led_status = 0;
               draw_ground_auto;
               delay(1000);
               move_left;
               init_ball_values;
               for a := 99 to 101 do
                   set_rgb_color(a,pal[a].r,pal[a].g,pal[a].b);
               PFEIL := 0;
               locked := 0;
               exit;
             end;

           {RAT-Bonus}
           if (RAT[24] = 1) and (RAT[25] = 1) and (RAT[26] =1) then begin
                display('RAT-BONUS: 50000');
                repeat led_anzeige; until led_status = 0;
                delay(500);
                move_left;
                inc(score[actplayer],50000);
              end;

           {phaser bonus}
           if felder3 > 0 then begin
                display('PHASER - BONUS');
                repeat led_anzeige; until led_status=0;
                delay(1000);
                inc(score[actplayer],felder3*10000);
                display('< < < '+inttostr(felder3*10000)+' > > >');
                repeat led_anzeige; until led_status=0;
                delay(1000);
                move_left;
              end;

           {Rampen-Bonus}
           if felder1 > 0 then begin
               display('RAMP-HIT : 25000');
               inc(score[actplayer],25000);
               repeat led_anzeige; until led_status=0;
               delay(1000);
               move_left;
             end;

           {death-bonus}
           if felder2 > 0 then begin
                display('DEATH BONUS '+inttostr(felder2*500)+'x5');
                repeat led_anzeige; until led_status=0;
                inc(score[actplayer],felder2*500*5);
                delay(1000);
                move_left;
              end;

           {total}
           display('Total '+inttostr(score[actplayer]));
           repeat led_anzeige; until led_status = 0;
           delay(1000);
           move_left;

           inc(balls[Actplayer]);
           if balls[actplayer] = MaxBalls then begin
                 display('* G A M E  O V E R *');
                 repeat led_anzeige; until led_status = 0;
                 delay(1000);
                 bende := true;
               end;
           inc(actplayer);
           if actplayer > Maxplayer then actplayer := 1;
           if balls[actplayer] < MaxBalls then
             if MaxPlayer > 1 then
              begin
                display('Next Player '+inttostr(actplayer));
                repeat led_anzeige; until led_status=0;
                delay(1000);
                move_left;
                display('Ball '+inttostr(balls[actplayer]));
                repeat led_anzeige; until led_status=0;
                delay(1000);
                move_left;
                bende := false;
              end;
           init_ball_values;
           init_tisch2;
           for a := 0 to 250 do begin
                CTRL_Shift_Keys;
                arm_links_old_status:=arm_links_status;
                arm_rechts_old_status:=arm_rechts_status;
                Check_Flipper_Arms;
              end;
            senk_arms;
          end;

    241 : begin
            dec(ballx,2); ballspeed_x := -1;
            ballspeed_y := abs(ballspeed_y);
          end;

    240 : begin
            {if ballspeed_x < 4 then inc(ballspeed_x,3);}
            ballspeed_x := 4;
           { play(snd1);}
            inc(ballx);
            dec(ballspeed_y);
          end;
    233..238 : begin
        if phaser[fg] = 0 then begin
            play(snd11);
            phaser[fg] := 1;
            set_rgb_color(238-fg+109,50,30,20);
            inc(ballspeed_x,20);
            inc(score[actplayer],1000);

            if (phaser[233] = 1)and(phaser[234] = 1)and(phaser[235] = 1)and
               (phaser[236] = 1)and(phaser[237] = 1)and(phaser[238] = 1)then
               begin
                case Felder3 of
                  0 : begin
                        felder3 := 1;
                        display('>>> 10000  BONUS <<<');
                        repeat led_anzeige; until led_status = 0;
                        inc(score[actplayer],10000);
                        set_rgb_color(105,60,30,20);
                      end;
                  1 : begin
                        felder3 := 2;
                        display('>>> 20000  BONUS <<<');
                        repeat led_anzeige; until led_status = 0;
                        inc(score[actplayer],20000);
                        set_rgb_color(106,60,30,20);
                      end;
                  2 : begin
                        felder3 := 3;
                        display('>>> 30000  BONUS <<<');
                        repeat led_anzeige; until led_status = 0;
                        inc(score[actplayer],30000);
                        set_rgb_color(107,60,30,20);
                      end;
                  3 : begin
                        felder3 := 5;
                        display('>>> 50000  BONUS <<<');
                        repeat led_anzeige; until led_status = 0;
                        inc(score[actplayer],50000);
                        set_rgb_color(108,60,30,20);
                      end;
                  end;
                if Felder3 < 5 then begin
                    for fg := 109 to 114 do
                        set_rgb_color(fg,pal[fg].r,pal[fg].g,pal[fg].b);
                    PHASER[233] := 0; PHASER[234] := 0; PHASER[235] := 0;
                    PHASER[236] := 0; PHASER[237] := 0; PHASER[238] := 0;
                  end;
                end;
          end;
      end;
  end;
end;

{ *** AREAS *************************************************************** }

procedure analyse_boden;
var fg:byte;
    h1,h2 :  byte;
begin
  case fm of
       1 : begin
             play(snd7);
             display('Sure Shot 25000');
             repeat led_anzeige; until led_status = 0;
             draw_ground_auto;
             repeat
               inc(bally,2);
               calc_page_pos_of_ballpos; retrace;
             until bally > 320;
             ballx := 5;
             ballspeed_x := 0; ballspeed_y := 0; kraft := 0;
             delay(350);
             inc(score[actplayer],25000);
           end;
       2 : begin
             inc(ballspeed_y,4);
           end;
       3 : begin
             play(snd7);
             case pfeil of
               0 : begin
                     pfeil := 2;
                     set_rgb_color(99,63,20,0);
                   end;
               2 : begin
                     pfeil := 4;
                     set_rgb_color(100,63,20,0);
                   end;
               4 : begin
                     pfeil := 6;
                     set_rgb_color(101,63,20,0);
                   end;
               6 : begin
                     if locked = 0 then begin
                         locked := 1;
                         display('BALL LOCKED!');
                         repeat led_anzeige; until led_status = 0;
                         draw_ground_auto;
                         delay(1000);
                         init_ball_values;
                         exit;
                       end;
                     display('BALL ALREADY LOCKED!');
                         repeat led_anzeige; until led_status = 0;
                         delay(500);
                   end;
             end;
             inc(score[actplayer],pfeil*2000);
             display('Lock door : '+inttostr(pfeil)+'x2000');
             repeat led_anzeige; until led_status = 0;
             delay(1000);
           end;
       5 : begin
             display('KILL THE RAT!');
           end;
       6 : begin
             play(snd7);
             h1 := MAXFarbe;
             MAXFarbe := 209;
             display('RAMP BONUS:');
             play(snd12);
             repeat led_anzeige; until led_status = 0;
             delay(500);
             draw_ground_auto;
             delay(1000);
             case felder1 of
               0 : begin
                     set_rgb_color(95, 63,20,0);
                     felder1 := 1;
                   end;
               1 : begin
                     set_rgb_color(94, 63,20,0);
                     felder1 := 3;
                   end;
               3 : begin
                     set_rgb_color(93, 63,20,0);
                     felder1 := 5;
                   end;
             end;
             display('-._ '+inttostr(felder1)+'000 * 5 _.-');
             repeat led_anzeige; until led_status = 0;
             play(snd11);
             ballx := 15; bally := 106;
             inc(score[actplayer],felder1*1000*5);
             ballspeed_x := 0; ballspeed_y := 0;
             for bally := bally to 136 do begin
                 retrace; move_ball;
                 calc_page_pos_of_ballpos; {readkey;}
               end;
             for bally := bally to 145 do begin
                 retrace; move_ball;
                 calc_page_pos_of_ballpos; {readkey;}
                 inc(ballx);
               end;
             for bally := bally to 223+random(3) do begin
                 retrace; move_ball;
                 calc_page_pos_of_ballpos; {readkey;}
                 if bally mod 6 = 0 then inc(ballx) else inc(ballx,2);
               end;
             repeat
               retrace; move_ball;
               calc_page_pos_of_ballpos; {readkey;}
               inc(bally,2);
             until bally > 250;
             draw_ground_auto;
             delay(500);
             MAXFarbe := h1;
             {zufall}
             h1 := random(4)+13;
             ballspeed_y := 0;
             ballspeed_x := 0;
             case h1 of
               13 : begin
                      ballx := 170; bally := 233;
                      ballspeed_y := -random(15)-15;
                    end;
               14 : begin
                      ballx := 189; bally := 250;
                      ballspeed_x := random(15)+15;
                    end;
               15 : begin
                      ballx := 170; bally := 269;
                      ballspeed_y := random(15)+15;
                    end;
               16 : begin
                      ballx := 151; bally := 250;
                      ballspeed_x := -random(15)-15;
                    end;
             end;
           end;
       7 : begin
             display('NO RAMP!');
           end;
       8 : begin
             play(snd7);
             display('RAT HOLE 3000');
             repeat led_anzeige; until led_status = 0;
             draw_ground_auto;
             inc(score[actplayer],3000);
             for bally := bally downto 40 do begin
                 retrace; calc_page_pos_of_ballpos; end;
             HilfsProc1;
           end;
     10 : begin
            if ballspeed_y > 0 then begin
                play(snd10);
                rl := not rl;
                if rl then set_rgb_color(115,pal[115].r,pal[115].g,pal[115].b)
                      else set_rgb_color(115,20,10,10);
                if rl then display('RELAUNCH ON!')
                      else display('RELAUNCH OFF!');
              end;
            if felder2 < 3 then begin
                inc(felder2);
                display('DEATH BONUS '+inttostr(felder2*500));
                set_rgb_color(102+felder2-1,20,30,60);
              end;
          end;
     11 : begin
            play(snd10);
            if ballspeed_y < 0 then begin
                ballspeed_y := ballspeed_y div 4;
                ballspeed_x := 8;
              end;
          end;
       12 : begin
              if balls[actplayer] < maxballs then display('>Hit SPACE to start<');
            end;
      13..16 : begin
                 repeat h1 := random(4)+13; until h1 <> fm;
                 {delay(150);}
                 draw_ground_auto;
                 delay(400);
                 ballspeed_y := 0;
                 ballspeed_x := 0;
                 case h1 of
                   13 : begin
                          ballx := 170; bally := 233;
                          ballspeed_y := -random(15)-15;
                        end;
                   14 : begin
                          ballx := 189; bally := 250;
                          ballspeed_x := random(15)+15;
                        end;
                   15 : begin
                          ballx := 170; bally := 269;
                          ballspeed_y := random(15)+15;
                        end;
                   16 : begin
                          ballx := 151; bally := 250;
                          ballspeed_x := -random(15)-15;
                        end;
                 end;
                 move_ball;
                 {delay(500);}
                 inc(score[actplayer],1000);
                 play(snd1);
           end;
      17 : begin
            {inc(ballspeed_x);}
           end;
      23 : begin
             dec(ballspeed_x);
           end;
      24..26 : begin
          if ballspeed_y < 0 then exit;
          play(snd10);
          if RAT[fm] = 0 then begin
              set_rgb_color(fm-24+90,63,20,0);
              RAT[fm] := 1;
              inc(score[actplayer],1000);
            end;
          if (rat[24] = 0) or (rat[25] = 0) or (rat[26] = 0) then
            display('RAT is incomplete') else begin
                display('RAT is COMPLETE!');
                inc(score[actplayer],10000);
              end;
        end;
  end;
end;

function gettablepixel(x,y:word):byte;
begin
  if y<200 then gettablepixel:=tableground1^[x,y]
    else if y<400 then gettablepixel:=tableground2^[x,y]
        else if y < 600 then gettablepixel:=tableground3^[x,y];
end;

procedure check_ball_oben;
var x,y,z:integer;
    contact:boolean;
begin
  y:=bally;
  contact:=false;
  repeat                         {gut}
    {0&16 / 1&15 / 2&14 / 3&13 / 4&12 / 5&11 / 6&10 / 7&9 / 8&8}
    for x:=ballx+ 4 to ballx+12 do begin
        if gettablepixel(x,y)>127 then begin
           contact:=true;
           if x <= ballx+8 then inc(o1) else inc(o2);
           fo := gettablepixeL(x,y);
         end;
      end;
    dec(y);
  until (y<=bally+ballspeed_y div 2) or (contact);
  inc(y); bally:=y;
end;

procedure check_ball_unten;
var x,y,z:integer;
    contact:boolean;
begin
  y:=bally;
  contact:=false;
  repeat
    for x:=ballx+ 4 to ballx+12 do
    begin
      if gettablepixel(x,y+14)>127 then begin
          contact:=true;
          if x <= ballx+8 then inc(u1) else inc(u2);
          fu := gettablepixeL(x,y+14);
        end;
    end;
    inc(y);
  until (y>=bally+ballspeed_y div 2) or (contact);
  dec(y); bally:=y;
end;

procedure check_ball_links;
var x,y,z:integer;
    contact:boolean;
begin
  x:=ballx;
  contact:=false;
  repeat
    for y:=bally+ 4 to bally+12 do
    begin
      if gettablepixel(x,y)>127 then begin
          contact:=true;
          if y <= bally+8 then inc(l1) else inc(l2);
          fl :=  gettablepixeL(x,y);
        end;
    end;
    dec(x);
    if (x<0) then begin x:=0; contact:=true; end;
  until (x<=ballx+ballspeed_x div 2) or (contact);
  inc(x); ballx:=x;
end;

procedure check_ball_rechts;
var x,y,z:integer;
    contact:boolean;
begin
  x:=ballx;
  contact:=false;
  repeat
    for y:=bally+ 4 to bally+12 do
    begin
      if gettablepixel(x+14,y)>127 then begin
          contact:=true;
          if y <= bally+8 then inc(r1) else inc(r2);
          fr :=  gettablepixeL(x,y+14);
        end;
    end;
    inc(x);
    if (x>304) then begin x:=304; contact:=true; end;

  until (x>=ballx+ballspeed_x div 2) or (contact);
  dec(x); ballx:=x;
end;

procedure Check_Ball;
begin
  o1 := 0; o2 := 0; u1 := 0; u2 := 0;
  l1 := 0; l2 := 0; r1 := 0; r2 := 0;

  fu := 0; fo := 0; fl := 0; fr := 0;

  if ballspeed_y < 0 then begin
      check_ball_oben;
      if (o1 + o2 > 0) then begin
          dec(kraft);
          if kraft < 0 then
           ballspeed_y := -(ballspeed_y{+abs(ballspeed_y)div 2) div 4}div 2);
        end;
      if (o1 > 0) and (o2 = 0) then if ballspeed_x < 4 then inc(ballspeed_x);
      if (o1 = 0) and (o2 > 0) then if ballspeed_x > -4 then dec(ballspeed_x);
    end;
  if ballspeed_y >= 0 then begin
      check_ball_unten;
      if (u1 + u2 > 0) then begin
          ballspeed_y := -(ballspeed_y{+abs(ballspeed_y)div 2) div 4}div 2);
          kraft := abs(ballspeed_y div 2);
        end;                                         {4}
      if (u1 > 0) and (u2 = 0) then if ballspeed_x < 4 then
          begin if random > 0.3 then inc(ballspeed_x) else inc(ballx); end;
      if (u1 = 0) and (u2 > 0) then if ballspeed_x > -4 then
          begin if random > 0.3 then dec(ballspeed_x) else dec(ballx); end;
    end;
  if ballspeed_x <= 0 then begin
      check_ball_links;
      if (l1 + l2 > 0) then begin
          ballspeed_x := abs((ballspeed_x+abs(ballspeed_y)div 3) div 4){+1};
          {if ballspeed_x < 4 then inc(ballspeed_x,2);}
        end;
      if (l1 > 0) and (l2 = 0) then inc(ballspeed_y);
      if (l1 = 0) and (l2 > 0) then dec(ballspeed_y);
    end;
  if ballspeed_x >= 0 then begin
      check_ball_rechts;
      if (r1 + r2 > 0) then begin
          ballspeed_x := -((ballspeed_x+abs(ballspeed_y)div 2) div 4){-1};
          {if ballspeed_x > -4 then dec(ballspeed_x,2);}
        end;
      if (r1 > 0) and (r2 = 0) then inc(ballspeed_y);
      if (r1 = 0) and (r2 > 0) then dec(ballspeed_y);
    end;

  if (l2 > 0) and (l1 = 0) then
      if (u1 > 0) or (u2=0) then if ballspeed_x <= 0 then begin
              inc(ballspeed_y); inc(ballspeed_x); end;
  if (r2 > 0) and (r1 = 0) then
      if (u1 = 0) and (u2>0) then if ballspeed_x >= 0 then
          begin inc(ballspeed_y); dec(ballspeed_x); end;

  if (l1 > 0) and (l2 = 0) then
      if (o1 > 0) or (o2=0) then if ballspeed_x >= 0 then begin
              {inc(bally);} dec(ballx); end;
  if (r1 > 0) and (r2 = 0) then
      if (o1 = 0) and (o2>0) then if ballspeed_x <= 0 then begin
              {inc(bally);} inc(ballx); end;

{}  if grad = TischGrad then grad := 0
                      else begin inc(ballspeed_y); inc(grad); end; {}
{  inc(ballspeed_y); {}
  if ballspeed_y > speedmaxy then ballspeed_y := speedmaxy;

end;

  var a,b,c,d : byte;

begin
  asm cli end;
  checkbreak := false;
  if (paramcount <> 1) or (length(paramstr(1)) <> 3) then halt(0);
  {detect soundblaster and initialize the values}
  textcolor(black);
  textbackground(black);
  detect_soundblaster;

  Init_All;
  Init_Tisch2;

  repeat

    keyboard; ch := upcase(CH);
    case ch of
      'K' : begin
              ballspeed_y := ballspeed_y - 10;
              ballspeed_x := ballspeed_x - 6 + random(12);
              inc(ruetteln);
              display('DER '+inttostr(ruetteln)+'.RÜTTLER!');
              if ruetteln = 5 then begin
                  bende := true;
                  display('T I L T !');
                end;
              repeat led_anzeige; until led_status = 0;
              delay(200);
            end;
      'P' : StartCDPlayer;
      'Q',#27 :
          if NormalPos =  CurrentPos then begin
              Display('Are you a coward ?');
              repeat led_anzeige; until led_status = 0;
              repeat keyboard; ch := upcase(ch);
              until (ch = 'Y') or (ch = 'N') or (ch = 'Z');
              case ch of
                'N' : begin
                    bende := false;
                    Display('No!');
                    repeat led_anzeige; until led_status = 0;
                  end;
                'Y','Z' : begin
                    bende := true;
                    Display('Yes!');
                    repeat led_anzeige; until led_status = 0;
                  end;
              end;
          end;
      ' ' : if (fm = 12) and (normalpos = currentpos) and (balls[actplayer] < MaxBalls)then begin
                display('Release to start!');
                repeat led_anzeige; until led_status = 0;
                StartPow := 0;
                repeat
                  if startpow < 75 then begin
                      inc(startpow,2);
                      FederY:=400+205+startpow div 5;
                      FederHoehe:=40-startpow div 5;
                      retrace;
                      Set_Feder;
                      move_ball;
                    end else play(snd1);
                  if keypressed then readkey;
                  Check_Flipper_Arms;
                until port[$60] <> 57;

                repeat
                  dec(FederY,2);
                  if FederHoehe<39 then inc(FederHoehe,2);
                  Set_Feder;
                  retrace;
                until FederY<=400+205;
                Ballspeed_y := -StartPow div 4 - 30 - 19; kraft := 90;
                display('GET THE SPACE-RAT');
                repeat led_anzeige; until led_status = 0;
              end;
    end;
    {get extended key}
    CTRL_Shift_Keys;
    {arms}
    Check_Flipper_Arms;
    {calc_new_ball_pos // check border etc. // main proc}
    Check_Ball;
    {if (fr=arm) or (fl=arm) or (fu=arm) or (fo=arm) or
       (fm=arm) or (fh=arm) then analyse_arms;}
    asm
      mov al,arm;  cmp al,fr; jz @analyse;
      mov al,arm;  cmp al,fl; jz @analyse;
      mov al,arm;  cmp al,fu; jz @analyse;
      mov al,arm;  cmp al,fo; jz @analyse;
      mov al,arm;  cmp al,fm; jz @analyse;
      mov al,arm;  cmp al,fh; jz @analyse;
      jmp @ende
    @analyse: call analyse_arms
    @ende:
    end;

    arm_links_old_status:=arm_links_status;
    arm_rechts_old_status:=arm_rechts_status;

    {final check routine}
    if CurrentPos > NormalPos then begin
        if (ballx = bx_old) and (bally = by_old) then retrace;
        dec(CurrentPos); SetLineComp(CurrentPos);
      end;
    if (ballx <> bx_old) or (bally <> by_old) then begin
         retrace;

        {set ball}
        calc_page_pos_of_ballpos;
        move_ball;
        {}
        if bally > 581 then fu := 242;
        if (fr>0) or (fl>0) or (fu>0) or (fo>0) then analyse_crash;
        if bende then break;
        fh := gettablepixel(ballx+8,bally+8);
        if fh <> fm then begin
            if (fh>0) and (fh<128) then begin fm := fh; analyse_boden; end
                      else if fh = 0 then fm := 0;
          end;
      end;
     asm cli end;

    led_anzeige;

    case counter of
       0 : begin end;
       1 : begin
             for a := 96 to 98 do
                 set_rgb_color(a,pal[a].r,pal[a].g,pal[a].b);
             for a := 116 to 119 do
                 set_rgb_color(a,pal[a].r,pal[a].g,pal[a].b);
             dec(counter);
           end;
       else dec(counter);
    end;
  until bende = true;

  for b := 0 to 63 do
    for a := 0 to 255 do begin
        if pal[a].r > 0 then dec(pal[a].r);
        if pal[a].g > 0 then dec(pal[a].g);
        if pal[a].b > 0 then dec(pal[a].b);
        set_rgb_color(a,pal[a].r,pal[a].g,pal[a].b);
      end;
  Close_All;
  asm sti end;
end.