home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / PINBSRC.ZIP / FLIPPER1.PAS < prev    next >
Pascal/Delphi Source File  |  1996-02-02  |  32KB  |  1,005 lines
  1. { FLIPPER1.PAS   - (c) Ansgar Scherp, Joachim Gelhaus
  2.   All rights reserved / vt'95
  3.  
  4.   1 Parameter = 'abc'
  5.  
  6.   a = 1-4  ->> set overscan on/off and highres. on/off
  7.   b = 1-2  ->> 1 = SB-Sound   2 = No Sound
  8.   c = 1-6  ->> Players
  9.  
  10.   }
  11.  
  12. {$M 65520,0,655360}
  13. {$P+,G+}
  14. uses dos,crt,soundkit,audiotpu;
  15.  
  16. const N1 = ' PCS-PINBALL  - Version 1.1 written by A.Scherp and J.Gelhaus ';
  17.       N2 = ' (c)opyrights reserved by PC Spiel and vIRTUAL tECHNOLOGIES GbR';
  18.  
  19. const {LabelName  : string[9] = 'SPECIAL27';}
  20.       Bits       : array[0..9] of byte = (128,64,32,16,8,4,2,1,0,0);
  21.       VSeg       : word = $A000;
  22.       speedmaxy  : byte = 100; {max. bally-speed. (( 45}
  23.  
  24.       tnr  : char = '1'; {tablenr}
  25.  
  26.       ArmBreiteLinks : byte = 56;
  27.       ArmHoeheLinks  : byte = 48;
  28.       ArmXLinks      : word = 79;
  29.       ArmYLinks      : word = 400+135;
  30.  
  31.       ArmBreiteRechts : byte = 56;
  32.       ArmHoeheRechts  : byte = 48;
  33.       ArmXRechts      : word = 159;
  34.       ArmYRechts      : word = 400+135;
  35.  
  36.       FederBreite     : word = 8;
  37.       FederX          : word = 302;
  38.  
  39.       no         : boolean = false;
  40.       yes        : boolean = true;
  41.       rahmen     : byte = 255;
  42.       arm        : byte = 128;
  43.  
  44. const snd1 = 1;
  45.       snd2 = 2;
  46.       snd3 = 3;
  47.       snd4 = 4;
  48.       snd5 = 5;
  49.       snd6 = 6;
  50.       snd7 = 7;
  51.       snd8 = 8;
  52.  
  53.       SetSprite_VGAADR : array[0..6] of word = (258,514,1026,2050,258,514,1026);
  54.       GetSprite_VGAADR : array[0..6] of word = ($4,$104,$204,$304,$04,$104,$204);
  55.  
  56.       MaxBalls = 4;
  57.  
  58.  
  59. {typedeclaration for the mask}
  60. type ttableground1=array[0..319,0..199] of byte;
  61. type ttableground2=array[0..319,200..399] of byte;
  62. type ttableground3=array[0..319,400..599] of byte;
  63. type reihe = array[1..15360] of byte;
  64.  
  65.  
  66.  
  67. var  OldHeapLimit: pointer;
  68.      OldHeapSize : Longint;
  69.  
  70.      ledseg,
  71.      armlinksseg,armrechtsseg,
  72.      armlinks_mskseg,armrechts_mskseg,
  73.      ballseg,
  74.      groundseg,
  75.      ballspriteseg,
  76.      undergroundseg,
  77.      tablegroundseg,federseg:word;
  78.  
  79.      led_display,
  80.      ball,
  81.      ground,
  82.      ball_sprite,
  83.      underground,
  84.      tableground,feder:pointer;
  85.      arm_links           : ^reihe;
  86.      arm_rechts          : ^reihe;
  87.  
  88.      arm_links_msk       : ^reihe;
  89.      arm_rechts_msk      : ^reihe;
  90.  
  91.  
  92.      tableground1:^ttableground1;
  93.      tableground2:^ttableground2;
  94.      tableground3:^ttableground3;
  95.  
  96.      ch:char;
  97.  
  98.      led_hoehe:byte;
  99.      led_color_1, led_color_2:byte;
  100.      led_funktion, led_parameter,led_timer,led_x,led_Y,led_status:word;
  101.      led_anzeige_text:string;
  102.      led_f_status_1,led_f_status_2:byte;
  103.  
  104.      {SEG und OFS of the FONT}
  105.      Fseg,Fofs : word;
  106.      Fdata : array[1..4096] of byte;
  107.  
  108.      arm_links_status, arm_rechts_status:byte;
  109.      arm_links_old_status, arm_rechts_old_status:byte;
  110.  
  111.      {BALL X and Y Coordinates }
  112.      ballx,bally,bx_old,by_old:integer;
  113.      {x und y - speed}
  114.      ballspeed_y,ballspeed_x:integer;
  115.  
  116.      {a few randoms}
  117.      ran255:array[0..255] of byte;
  118.      ran255z:byte;
  119.  
  120.      {counter for the ball-gravitiy left, right, up,down}
  121.      l1,l2,r1,r2,u1,u2,o1,o2 : byte;
  122.      fu,fo,fl,fr,fm : byte;
  123.      fh : byte;
  124.  
  125.      kraft : integer;
  126.  
  127.      overscan, highres : boolean;
  128.  
  129.      UseSound  : boolean;
  130.      sounds:array[1..10] of pointer;   { Samples}
  131.      soundlength:array[1..10] of word;
  132.  
  133.      score:array [1..6] of longint;
  134.  
  135.      StartPow  : word ;
  136.  
  137.      NormalPos : integer;
  138.      CurrentPos : integer;
  139.  
  140.      path : string;
  141.  
  142.      MAXfarbe: byte;
  143.  
  144.      OldFileMode : byte;
  145.  
  146.      VideoMode : char;
  147.  
  148.      bende  : boolean; {ende -> true }
  149.  
  150.      pal : array[0..255] of record { palette }
  151.              r : byte;
  152.              g : byte;
  153.              b : byte;
  154.            end;
  155.  
  156.      ruetteln : byte;
  157.  
  158.      FederY : word;
  159.      FederHoehe : word;
  160.  
  161.      hilfsb:byte;
  162.  
  163.  
  164. {*** TABLE1  ************************************************************** }
  165.  
  166.      Kurven:word;
  167.      Lichter1 : array[250..252] of byte;
  168.      Lichter2 : array[247..249] of byte;
  169.      Lichter3 : array[244..246] of byte;
  170.      Licht4   : byte;
  171.      PushUp   : boolean;
  172.      Bonus    : byte;
  173.      Balls    : array[1..6] of integer;
  174.      MaxPlayer   : byte;
  175.      ActPlayer : byte;
  176.      PCSspe : array[1..3] of byte;
  177.      special : byte;
  178.      temp : byte;
  179.      BumpCount : Byte;
  180.  
  181. procedure calc_page_pos_of_ballpos; forward;
  182. procedure display(t : string); forward;
  183. procedure check_flipper_arms; forward;
  184. procedure analyse_arms; forward;
  185. procedure senk_arms; forward;
  186.  
  187. {*** FONTS ***************************************************************** }
  188. {$F+}
  189. procedure font; external;
  190. {$L FONTS\BLCKSNSF.OBJ}
  191. {$F-}
  192.  
  193. {*** INCLUDEN ************************************************************** }
  194. {$I _RANDOM .PAS} {short random number list}
  195. {$I _VIDEO  .PAS} {all video functions // // and arm_draw}
  196. {$I _LOADPRC.PAS} {all loadingroutines}
  197. {$I _LEDANZ .PAS} {all routines for the led}
  198. {$I _AUTODRA.PAS} {procedure for automatic-draw // chose the right plane}
  199. {$I _KEYS   .PAS}
  200. {$I _SOUND1 .PAS} {soundkit}
  201. {$I _INI_CLO.PAS} {init_all & close}
  202. {I _INTEGRI.PAS} {check for integrity // read volumelabel of cd-rom}
  203. {$I _CDPLAYR.PAS} {audio-cd-player-routines}
  204. {$I _TISCH1 .PAS}
  205.  
  206. procedure senk_arms;
  207.   var t : byte;
  208. begin
  209.   for t := 5 downto 0 do begin
  210.        if arm_rechts_status>1 then dec(arm_rechts_status);
  211.        if arm_links_status>1 then dec(arm_links_status);
  212.        Check_Flipper_Arms;
  213.        arm_links_old_status:=arm_links_status;
  214.        arm_rechts_old_status:=arm_rechts_status;
  215.      end;
  216.   draw_ground_auto;
  217. end;
  218.  
  219. procedure do_fire_stuff;
  220. begin
  221.   if random > 0.60 then begin
  222.       if temp < 6 then begin
  223.           inc(temp);
  224.           display('Temperature is');
  225.           repeat led_anzeige; until led_status = 0;
  226.           delay(1500);
  227.           display(':-) DECREASING (-:');
  228.           repeat led_anzeige; until led_status = 0;
  229.           delay(1500);
  230.         end
  231.     end else
  232.       if temp > 0 then begin
  233.            dec(temp);
  234.            display('Temperature is');
  235.            repeat led_anzeige; until led_status = 0;
  236.            delay(1500);
  237.            display(':-(  RISING  )-:');
  238.            repeat led_anzeige; until led_status = 0;
  239.            delay(1500);
  240.          end;
  241.   thermo(temp);
  242. end;
  243.  
  244. procedure move_left;
  245.   var alt : byte;
  246.       a : word;
  247. begin
  248.   alt := led_funktion;
  249.   led_anzeige_6_init;
  250.   for a := 0 to 80 do begin led_anzeige; retrace; end;
  251.   led_funktion := alt;
  252. end;
  253.  
  254. procedure IncScore(points:word);
  255. begin
  256.  score[actplayer] := score[actplayer] + points;
  257.  led_anzeige_5_init(0,0,'Score'+IntToStr1(score[actplayer])+
  258.                         ' Ball '+inttostr(balls[ActPlayer]));
  259. end;
  260.  
  261. procedure display(t : string);
  262.   var a : byte;
  263.       z : string[20];
  264. begin
  265.  z := '                     ';
  266.  for a := 1 to length(t) do z[a + 10 - length(t) div 2 ] := t[a];
  267.  led_anzeige_5_init(0,0,z);
  268. end;
  269.  
  270. procedure Check_Ball; forward;
  271.  
  272. procedure move_ball;
  273. begin
  274.   draw_ground_auto; get_ground_auto; draw_ball_auto;
  275.   bx_old:=ballx; by_old:=bally;
  276. end;
  277.  
  278. procedure calc_page_pos_of_ballpos;
  279. var y2:word; {longint;}
  280. begin
  281.   {y2:=bally-100;}
  282.   asm mov ax, bally; sub ax, 100; mov y2, ax; end;
  283. {  if y2<1 then y2:=1;} if y2 > 1000 then y2 := 1;
  284.   if y2>421 then y2:=421;
  285.   { y2:=y2+48;}
  286.   asm mov ax,y2; add ax,48; mov y2,ax; end;
  287.   if HighRes then if y2> 270 then y2 := 270;
  288.   {80*y2}
  289.   asm mov ax,y2; mov bx,80; mul bx; mov y2,ax; end;
  290.   setaddress(y2);
  291. end;
  292.  
  293. procedure Check_Flipper_Arms;
  294.  
  295. begin
  296.   {check if left flipper-arm is moved}
  297.   if arm_links_old_status<>arm_links_status then
  298.     if (bally+16>armYlinks) and (bally<armYlinks+armHoeheLinks) and
  299.        (ballx+16>armXlinks) and (ballx<armXlinks+armBreitelinks) then begin
  300.         draw_ground_auto;{}
  301.         draw_arm_links;
  302.         get_ground_auto;{}
  303.         draw_ball_auto;
  304.       end else draw_arm_links;
  305.   {check if right flipper-arm is moved}
  306. if (arm_rechts_old_status<>arm_rechts_status) then
  307.     if (bally+16>armYrechts) and (bally<armYrechts+armHoeherechts) and
  308.        (ballx+16>armXrechts) and (ballx<armXrechts+armBreiterechts) then begin
  309.         draw_ground_auto;
  310.         draw_arm_rechts;
  311.         get_ground_auto;
  312.         draw_ball_auto;
  313.       end else draw_arm_rechts;
  314. end;
  315.  
  316. procedure analyse_arms;
  317. begin
  318.   if (fo > 0) and (ballspeed_y < 0) then begin
  319.       ballspeed_y := abs(ballspeed_y);
  320.       kraft := 0;
  321.       exit;
  322.     end;
  323.   if ballx < 142{152} then begin
  324.     if arm_links_old_status < arm_links_status then begin
  325.         draw_arm_links;
  326.         Check_Ball;
  327.         ballspeed_y := - abs(Ballx+4 - ArmXLinks);
  328.       if ballspeed_y < - 50 then ballspeed_y := -50;
  329.         bally := bally + ballspeed_y;
  330.         kraft := abs(ballspeed_y);
  331.         case arm_links_status of
  332.           1 : inc(ballspeed_x,7+random(4));
  333.           2 : inc(ballspeed_x,5+random(4));
  334.           4 : dec(ballspeed_x,5+random(4));
  335.           5 : dec(ballspeed_x,7+random(4));
  336.         end;
  337.       end else
  338.         case arm_links_status of
  339.           1 : inc(ballspeed_x,abs(ballspeed_y) div 4);
  340.           2 : inc(ballspeed_x,abs(ballspeed_y) div 4);
  341.           4 : dec(ballspeed_x,abs(ballspeed_y) div 4);
  342.           5 : dec(ballspeed_x,abs(ballspeed_y) div 4);
  343.         end;
  344.   end else
  345.     if arm_rechts_old_status < arm_rechts_status then begin
  346.         draw_arm_rechts;
  347.         Check_Ball;
  348.         kraft := 50;
  349.         ballspeed_y := - abs(ArmBreiteRechts - (Ballx+4{+8} - ArmXRechts));
  350.        if ballspeed_y < - 50 then ballspeed_y := -50;
  351.         bally := bally + ballspeed_y;
  352.         kraft := abs(ballspeed_y);
  353.       case arm_rechts_status of
  354.         1 : dec(ballspeed_x,7+random(4));
  355.         2 : dec(ballspeed_x,5+random(4));
  356.         4 : inc(ballspeed_x,5+random(4));
  357.         5 : inc(ballspeed_x,7+random(4));
  358.       end;
  359.     end else
  360.         case arm_rechts_status of
  361.           1 : dec(ballspeed_x,abs(ballspeed_y) div 4);
  362.           2 : dec(ballspeed_x,abs(ballspeed_y) div 4);
  363.           4 : inc(ballspeed_x,abs(ballspeed_y) div 4);
  364.           5 : inc(ballspeed_x,abs(ballspeed_y) div 4);
  365.         end;
  366.   fl := 0; fr := 0; fu := 0; fo := 0;
  367. end;
  368.  
  369. { *** EVENTS ***************************************************************}
  370.  
  371. procedure analyse_crash;
  372. var fg,a,b,c,d:byte;
  373. begin
  374.   if fr>0 then fg:=fr;
  375.   if fl>0 then fg:=fl;
  376.   if fo>0 then fg:=fo;
  377.   if fu>0 then fg:=fu;
  378.   case fg of
  379.     254 : begin
  380.             play(snd2); incscore(100);
  381.             if ballspeed_x <= 0 then ballspeed_x := -10;
  382.             if ballspeed_x > 0 then ballspeed_x := 10;
  383.             dec(ballspeed_y,4); kraft := 10;
  384.           end;
  385.     253 : begin
  386.             if bally < 300 then begin
  387.                 b := random(20)+40;
  388.                 c := random(10)+50;
  389.                 d := random(10)+40;
  390.                 for a := 240 to 248 do set_rgb_color(a,b,c,d);
  391.               end;
  392.           retrace;
  393.           play(snd7); incscore(50);
  394.           if ballspeed_x < 0 then ballspeed_x := -8-random(4);
  395.           if ballspeed_x > 0 then ballspeed_x := 8+random(4);
  396.           if ballspeed_y < 0 then ballspeed_y := -8-random(4);
  397.           if ballspeed_y > 0 then ballspeed_y := 8+random(4);
  398.           BumpCount := 7;
  399.            kraft := kraft div 2;
  400.         end;
  401.     250,251,252 : begin
  402.                     PLAY(snd4);
  403.                     Lichter1[fg] := 1;
  404.                     set_rgb_color(fg-250+53,40,20,50);
  405.                     display('Light '+inttostr(fg-249)+' turned on!');
  406.                     if (lichter1[250] = 1) and (lichter1[251]=1) and
  407.                        (lichter1[252] = 1) then begin
  408.                          display('COMPLETE BONUS 9999!');
  409.                          inc(score[actplayer],9999);
  410.                          repeat led_anzeige; until led_status = 0;
  411.                          lichter1[250] := 0;
  412.                          lichter1[251] := 0;
  413.                          lichter1[252] := 0;
  414.                          set_rgb_color(53,pal[53].r,pal[53].g,pal[53].b);
  415.                          set_rgb_color(54,pal[54].r,pal[54].g,pal[54].b);
  416.                          set_rgb_color(55,pal[55].r,pal[55].g,pal[55].b);
  417.                        end;
  418.                   end;
  419.     249,248,247 : begin
  420.                     Lichter2[fg] := 1;
  421.                     Inc(Score[actplayer],100);
  422.                     display('Spot '+inttostr(fg-246)+' touched!');
  423.                   end;
  424.     246,245,244 : begin
  425.                     PLAY(snd5);
  426.                     Lichter3[fg] := 1;
  427.                     inc(score[actplayer],1000);
  428.                   end;
  429.     243 : begin
  430.  
  431.           play(snd3);  inc(score[actplayer],50);
  432.           if ballspeed_x < 0 then ballspeed_x := -15;
  433.           if ballspeed_x > 0 then ballspeed_x := 15;
  434.        end;
  435.     242 : begin
  436.           display('Yuppieeee...');
  437.           play(snd6);
  438.           inc(score[actplayer],500);
  439.           ballspeed_y := -80-random(100);
  440.           ballx:=8;
  441.           kraft:=240;
  442.           ballspeed_x := 3;
  443.         end;
  444.     241 : begin
  445.            display(')-: ball  lost :-(');
  446.            repeat led_anzeige; until led_status=0;
  447.            senk_arms;
  448.            asm cli end;
  449.            delay(1000);
  450.            move_left;
  451.            display('B O N U S');
  452.            repeat led_anzeige; until led_status=0;
  453.            delay(1000);
  454.            move_left;
  455.  
  456.            {1000xball}
  457.            Display('Balls 1000 x '+InttoStr(balls[actplayer]));
  458.            repeat led_anzeige; until led_status = 0;
  459.            inc(score[Actplayer],balls[actplayer]*1000);
  460.            delay(500);
  461.            move_left;
  462.  
  463.            {10000x}
  464.            if kurven > 0 then begin
  465.                for kurven := kurven downto 1 do begin
  466.                   Display('Loop 10000 x '+InttoStr(Kurven));
  467.                   repeat led_anzeige; until led_status = 0;
  468.                   inc(score[Actplayer],kurven*10000);
  469.                   delay(500);
  470.                end;
  471.                move_left;
  472.              end;
  473.  
  474.            {PCS special}
  475.            if (PCSspe[1] = 1) and (PCSspe[2] = 1) and (PCSspe[3] =1)
  476.                and (special =1 ) then begin
  477.                    display('PCSspecial full!');
  478.                    repeat led_anzeige; until led_status = 0;
  479.                    delay(500);
  480.                    move_left;
  481.                    inc(score[actplayer],100000);
  482.                    display('>>> 100000 <<<');
  483.                    repeat led_anzeige; until led_status = 0;
  484.                    delay(500);
  485.                    move_left;
  486.                 end;
  487.  
  488.            {total}
  489.            display('Total '+inttostr(score[actplayer]));
  490.            repeat led_anzeige; until led_status = 0;
  491.            delay(1000);
  492.            move_left;
  493.  
  494.            inc(balls[Actplayer]);
  495.            if balls[actplayer] = MaxBalls then begin
  496.                  display('> G A M E  O V E R <');
  497.                  repeat led_anzeige; until led_status = 0;
  498.                  delay(1000);
  499.                  bende := true;
  500.                end;
  501.            inc(actplayer);
  502.            if actplayer > Maxplayer then actplayer := 1;
  503.            if balls[actplayer] < MaxBalls then
  504.              if MaxPlayer > 1 then
  505.               begin
  506.                 display('Next Player '+inttostr(actplayer));
  507.                 repeat led_anzeige; until led_status=0;
  508.                 delay(1000);
  509.                 move_left;
  510.                 display('Ball '+inttostr(balls[actplayer]));
  511.                 repeat led_anzeige; until led_status=0;
  512.                 delay(1000);
  513.                 move_left;
  514.                 bende := false;
  515.               end;
  516.            init_ball_values;
  517.            init_tisch1;
  518.            for a := 0 to 250 do begin
  519.                 CTRL_Shift_Keys;
  520.                 arm_links_old_status:=arm_links_status;
  521.                 arm_rechts_old_status:=arm_rechts_status;
  522.                 Check_Flipper_Arms;
  523.               end;
  524.             senk_arms;
  525.           end;
  526.     239 : begin
  527.             senk_arms;
  528.             asm cli end;
  529.             ballx := 23; bally := 411; move_ball;
  530.             inc(score[actplayer],10000);
  531.             ballspeed_y := random(15) + 15;
  532.             ballspeed_x := random(10) + 20;
  533.             display('PREPARE');
  534.             repeat led_anzeige; until led_status = 0;
  535.             delay(500);
  536.             display('FOR');
  537.             repeat led_anzeige; until led_status = 0;
  538.             delay(500);
  539.             display('BATTLE...');
  540.             repeat led_anzeige; until led_status = 0;
  541.             delay(500);
  542.             display('NOW!');
  543.             repeat led_anzeige; until led_status = 0;
  544.             if random > 0.7 then begin
  545.                 delay(700);
  546.                 display('NO! WAIT...');
  547.                 ballspeed_x := 0;
  548.                 ballspeed_y := 0;
  549.                 repeat led_anzeige; until led_status = 0;
  550.                 delay(1200);
  551.                 do_fire_stuff;
  552.               end;
  553.           end;
  554.     238 : begin
  555.             ballx := 102; bally := 74; move_ball;
  556.             do_fire_stuff;
  557.             ballspeed_y := - random(15) - 15;
  558.             ballspeed_x := - random(15) - 15;
  559.           end;
  560.     237 : begin
  561.             if ballx < 160 then begin
  562.                 if PushUp then begin
  563.                     ballspeed_y := -30-random(15);
  564.                     inc(ballspeed_x,4);
  565.                     kraft := 100;
  566.                   end
  567.                end else if PushUp then begin
  568.                             ballspeed_y := -30-random(15);
  569.                             dec(ballspeed_x,4);
  570.                             kraft := 100;
  571.                           end;
  572.           end;
  573.     236 : begin
  574.             ballspeed_x := ballspeed_x + ballspeed_y div 4;
  575.           end;
  576.   end;
  577. end;
  578.  
  579. { *** ARREAS *************************************************************** }
  580.  
  581. procedure analyse_boden;
  582. var fg:byte;
  583.     h1,h2 :  byte;
  584. begin
  585.   case fm of
  586.        1,2,3 : begin
  587.              Set_RGB_color(fm,100,100,0);
  588.              PCSspe[fm] := 1;
  589.              incscore(75);
  590.              if (PCSspe[1] = 1) and (PCSspe[2] = 1) and (PCSspe[3] =1)
  591.                 and (special =1 ) then begin
  592.                    display('*** PCS  special ***');
  593.                    inc(score[actplayer],10000);
  594.                 end;
  595.            end;
  596.        4 : begin
  597.              incscore(1000);
  598.            end;
  599.        5 : begin
  600.              senk_arms;
  601.              asm cli end;
  602.              play(snd7);
  603.              display('WORM-HOLE:');
  604.              repeat led_anzeige; until led_status = 0;
  605.              delay(500);
  606.              move_left;
  607.              h2 := random(4);
  608.              for h1 := 8 to random(15)+15 do begin
  609.                  inc(h2);
  610.                  if h2 > 3 then h2 := 0;
  611.                  case h2 of
  612.                    0 : display('ACCESS PERMITTED');
  613.                    1 : display('Icy-Bonus 10000');
  614.                    2 : display('ACCESS DENIED!');
  615.                    3 : display('25000 Bonus');
  616.                  end;
  617.                  repeat led_anzeige; until led_status = 0;
  618.                  play(snd4);
  619.                  delay(h1*7);
  620.                end;
  621.              case h2 of
  622.                0 : begin
  623.                      repeat
  624.                        retrace;
  625.                        calc_page_pos_of_ballpos;
  626.                        dec(bally,2);
  627.                      until bally < 85;
  628.                      ballx:=160;
  629.                      bally:=85;
  630.                      display('Bonus 150000');
  631.                      inc(score[actplayer],150000);
  632.                      repeat led_anzeige; until led_status = 0;
  633.                      delay(500);
  634.                    end;
  635.                1 : inc(score[actplayer],10000);
  636.                3 : inc(score[actplayer],25000);
  637.              end;
  638.              ballspeed_x := -2;
  639.            end;
  640.        6 : begin
  641.              ballspeed_y := ballspeed_y + random(6) - 3;
  642.              ballspeed_x := ballspeed_x + random(6) - 3;
  643.              display('ICE SLIDDERING...!');
  644.            end;
  645.        7 : begin
  646.              ballspeed_y := ballspeed_y + random(6) - 3;
  647.              ballspeed_x := ballspeed_x + random(6) - 3;
  648.              display('WARNING: slippery!');
  649.            end;
  650.        8 : begin
  651.              incscore(300);
  652.              if ballspeed_x > 0 then begin
  653.                 inc(Kurven);
  654.                 Display('Loops : '+InttoStr(Kurven));
  655.                 inc(score[Actplayer],kurven*1000);
  656.                 if kurven = 11 then begin
  657.                     dec(balls[actplayer]);
  658.                     display('/ Loop-Bonus Ball \');
  659.                     delay(1500);
  660.                     repeat led_anzeige; until led_status = 0;
  661.                   end;
  662.               end else begin
  663.                 Display('Wrong way, dude!');
  664.                 repeat led_anzeige; until led_status = 0;
  665.               end;
  666.            end;
  667.        9 : begin
  668.              incscore(800);
  669.            end;
  670.        10 : begin
  671.               ballspeed_y := ballspeed_y + random(6) - 3;
  672.               ballspeed_x := ballspeed_x + random(6) - 3;
  673.               display('ICE SLIDDERING...!');
  674.             end;
  675.        11 : begin
  676.              incscore(75);
  677.              if (PCSspe[1] = 1) and (PCSspe[2] = 1) and (PCSspe[3] =1) then
  678.                 begin Set_RGB_color(fm,100,100,0); special := 1;
  679.                    display('*** PCS  special ***');
  680.                    inc(score[actplayer],10000);
  681.                 end else
  682.                 display('PCS is incomplete!');
  683.            end;
  684.        12 : begin
  685.               if balls[actplayer] < maxballs then display('>Hit SPACE to start<');
  686.             end;
  687.        13 : begin
  688.               incscore(1000);
  689.               play(snd4);
  690.             end;
  691.   end;
  692. end;
  693.  
  694. function gettablepixel(x,y:word):byte;
  695. begin
  696.   if y<200 then gettablepixel:=tableground1^[x,y]
  697.     else if y<400 then gettablepixel:=tableground2^[x,y]
  698.         else if y < 600 then gettablepixel:=tableground3^[x,y];
  699. end;
  700.  
  701. procedure check_ball_oben;
  702. var x,y,z:integer;
  703.     contact:boolean;
  704. begin
  705.   y:=bally;
  706.   contact:=false;
  707.   repeat
  708.     {0&16 / 1&15 / 2&14 / 3&13 / 4&12 / 5&11 / 6&10 / 7&9 / 8&8}
  709.     for x:=ballx+ 4 to ballx+12 do begin
  710.         if gettablepixel(x,y)>127 then begin
  711.            contact:=true;
  712.            if x <= ballx+8 then inc(o1) else inc(o2);
  713.            fo := gettablepixeL(x,y);
  714.          end;
  715.       end;
  716.     dec(y);
  717.   until (y<=bally+ballspeed_y div 2) or (contact);
  718.   inc(y); bally:=y;
  719. end;
  720.  
  721. procedure check_ball_unten;
  722. var x,y,z:integer;
  723.     contact:boolean;
  724. begin
  725.   y:=bally;
  726.   contact:=false;
  727.   repeat
  728.     for x:=ballx+ 4 to ballx+12 do
  729.     begin
  730.       if gettablepixel(x,y+14)>127 then begin
  731.           contact:=true;
  732.           if x <= ballx+8 then inc(u1) else inc(u2);
  733.           fu := gettablepixeL(x,y+14);
  734.         end;
  735.     end;
  736.     inc(y);
  737.   until (y>=bally+ballspeed_y div 2) or (contact);
  738.   dec(y); bally:=y;
  739. end;
  740.  
  741. procedure check_ball_links;
  742. var x,y,z:integer;
  743.     contact:boolean;
  744. begin
  745.   x:=ballx;
  746.   contact:=false;
  747.   repeat
  748.     for y:=bally+ 4 to bally+12 do
  749.     begin
  750.       if gettablepixel(x,y)>127 then begin
  751.           contact:=true;
  752.           if y <= bally+8 then inc(l1) else inc(l2);
  753.           fl :=  gettablepixeL(x,y);
  754.         end;
  755.     end;
  756.     dec(x);
  757.     if (x<0) then begin x:=0; contact:=true; end;
  758.   until (x<=ballx+ballspeed_x div 2) or (contact);
  759.   inc(x); ballx:=x;
  760. end;
  761.  
  762. procedure check_ball_rechts;
  763. var x,y,z:integer;
  764.     contact:boolean;
  765. begin
  766.   x:=ballx;
  767.   contact:=false;
  768.   repeat
  769.     for y:=bally+ 4 to bally+12 do
  770.     begin
  771.       if gettablepixel(x+14,y)>127 then begin
  772.           contact:=true;
  773.           if y <= bally+8 then inc(r1) else inc(r2);
  774.           fr :=  gettablepixeL(x,y+14);
  775.         end;
  776.     end;
  777.     inc(x);
  778.     if (x>304) then begin x:=304; contact:=true; end;
  779.  
  780.   until (x>=ballx+ballspeed_x div 2) or (contact);
  781.   dec(x); ballx:=x;
  782. end;
  783.  
  784. procedure Check_Ball;
  785. begin
  786.   o1 := 0; o2 := 0; u1 := 0; u2 := 0;
  787.   l1 := 0; l2 := 0; r1 := 0; r2 := 0;
  788.  
  789.   fu := 0; fo := 0; fl := 0; fr := 0;
  790.   if ballspeed_y < 0 then begin
  791.       check_ball_oben;
  792.       if (o1 + o2 > 0) then begin
  793.           dec(kraft);
  794.           if kraft < 0 then
  795.            ballspeed_y := -(ballspeed_y{+abs(ballspeed_y)div 2) div 4}div 2);
  796.         end;
  797.       if (o1 > 0) and (o2 = 0) then if ballspeed_x < 4 then inc(ballspeed_x);
  798.       if (o1 = 0) and (o2 > 0) then if ballspeed_x > -4 then dec(ballspeed_x);
  799.     end;
  800.   if ballspeed_y >= 0 then begin
  801.       check_ball_unten;
  802.       if (u1 + u2 > 0) then begin
  803.           ballspeed_y := -(ballspeed_y{+abs(ballspeed_y)div 2) div 4}div 2);
  804.           kraft := abs(ballspeed_y div 2);
  805.         end;                                         {4}
  806.       if (u1 > 0) and (u2 = 0) then if ballspeed_x < 4 then
  807.           begin if random > 0.3 then inc(ballspeed_x) else inc(ballx); end;
  808.       if (u1 = 0) and (u2 > 0) then if ballspeed_x > -4 then
  809.           begin if random > 0.3 then dec(ballspeed_x) else dec(ballx); end;
  810.     end;
  811.   if ballspeed_x <= 0 then begin
  812.       check_ball_links;
  813.       if (l1 + l2 > 0) then begin
  814.           ballspeed_x := abs((ballspeed_x+abs(ballspeed_y)div 3) div 4){+1};
  815.           {if ballspeed_x < 4 then inc(ballspeed_x,2);}
  816.         end;
  817.       if (l1 > 0) and (l2 = 0) then inc(ballspeed_y);
  818.       if (l1 = 0) and (l2 > 0) then dec(ballspeed_y);
  819.     end;
  820.   if ballspeed_x >= 0 then begin
  821.       check_ball_rechts;
  822.       if (r1 + r2 > 0) then begin
  823.           ballspeed_x := -((ballspeed_x+abs(ballspeed_y)div 2) div 4){-1};
  824.           {if ballspeed_x > -4 then dec(ballspeed_x,2);}
  825.         end;
  826.       if (r1 > 0) and (r2 = 0) then inc(ballspeed_y);
  827.       if (r1 = 0) and (r2 > 0) then dec(ballspeed_y);
  828.     end;
  829.  
  830.  
  831.   if (l2 > 0) and (l1 = 0) then
  832.       if (u1 > 0) or (u2=0) then if ballspeed_x <= 0 then begin
  833.               inc(ballspeed_y); inc(ballspeed_x); end;
  834.   if (r2 > 0) and (r1 = 0) then
  835.       if (u1 = 0) and (u2>0) then if ballspeed_x >= 0 then
  836.           begin inc(ballspeed_y); dec(ballspeed_x); end;
  837.  
  838.   if (l1 > 0) and (l2 = 0) then
  839.       if (o1 > 0) or (o2=0) then if ballspeed_x >= 0 then begin
  840.               {inc(bally);} dec(ballx); end;
  841.   if (r1 > 0) and (r2 = 0) then
  842.       if (o1 = 0) and (o2>0) then if ballspeed_x <= 0 then begin
  843.               {inc(bally);} inc(ballx); end;
  844.  
  845. {  if kraft < 0 then } inc(ballspeed_y);
  846.   if ballspeed_y > speedmaxy then ballspeed_y := speedmaxy;
  847.  
  848. end;
  849.  
  850.   var a,b,c,d : byte;
  851.  
  852. begin
  853.   asm cli end;
  854.   checkbreak := false;
  855.   if (paramcount <> 1) or (length(paramstr(1)) <> 3) then halt(0);
  856.   {search for right cd-rom // canceld here!}
  857.   {CheckCDROM;}
  858.   {detect soundblaster and initialize the values}
  859.   textcolor(black);
  860.   textbackground(black);
  861.   detect_soundblaster;
  862.   {initialise}
  863.   Init_All;
  864.   Init_Tisch1;
  865.  
  866.   FederY:=400+205+startpow div 5;
  867.   FederHoehe:=40-startpow div 5;
  868.   Set_Feder;
  869.   move_ball;
  870.  
  871.   {main-loop}
  872.   repeat
  873.     {get key}
  874.     keyboard; ch := upcase(CH);
  875.     case ch of
  876.       'K' : begin
  877.               ballspeed_y := ballspeed_y - 10;
  878.               ballspeed_x := ballspeed_x - 6 + random(12);
  879.               inc(ruetteln);
  880.               display('DER '+inttostr(ruetteln)+'.RÜTTLER!');
  881.               if ruetteln = 5 then begin
  882.                   bende := true;
  883.                   display('T I L T !');
  884.                 end;
  885.               repeat led_anzeige; until led_status = 0;
  886.               delay(200);
  887.             end;
  888.       'P' : StartCDPlayer;
  889.       'Q',#27 :
  890.           if NormalPos =  CurrentPos then begin
  891.               Display('Really quit ?');
  892.               repeat led_anzeige; until led_status = 0;
  893.               repeat keyboard; ch := upcase(ch);
  894.               until (ch = 'Y') or (ch = 'N') or (ch = 'Z');
  895.               case ch of
  896.                 'N' : begin
  897.                     bende := false;
  898.                     Display('No!');
  899.                     repeat led_anzeige; until led_status = 0;
  900.                   end;
  901.                 'Y','Z' : begin
  902.                     bende := true;
  903.                     Display('Yes!');
  904.                     repeat led_anzeige; until led_status = 0;
  905.                   end;
  906.               end;
  907.           end;
  908.       ' ' : if (fm = 12) and (normalpos = currentpos) and (balls[actplayer] < MaxBalls)then begin
  909.                 display('Release to start!');
  910.                 repeat led_anzeige; until led_status = 0;
  911.                 StartPow := 0;
  912.                 repeat
  913.                   if startpow < 75 then begin
  914.                       inc(startpow,2);
  915.                       FederY:=400+205+startpow div 5;
  916.                       FederHoehe:=40-startpow div 5;
  917.                       retrace;
  918.                       Set_Feder;
  919.                       move_ball;
  920.                     end else play(snd1);
  921.                   if keypressed then readkey;
  922.                   Check_Flipper_Arms;
  923.                 until port[$60] <> 57;
  924.  
  925.                 repeat
  926.                   dec(FederY,2);
  927.                   if FederHoehe<40 then inc(FederHoehe,2)
  928.                                    else federhoehe := 40;
  929.                   Set_Feder;
  930.                   move_ball;
  931.                   retrace;
  932.                 until FederY<=400+205;
  933.                 Ballspeed_y := -StartPow; kraft := 200;
  934.                 display(#24+' GO FOR THE ICE '+#24);
  935.                 repeat led_anzeige; until led_status = 0;
  936.               end;
  937.     end;
  938.     {get extended key}
  939.     CTRL_Shift_Keys;
  940.     {arms}
  941.     Check_Flipper_Arms;
  942.     {calc_new_ball_pos // check border etc. // main proc}
  943.     Check_Ball;
  944.     {if (fr=arm) or (fl=arm) or (fu=arm) or (fo=arm) or
  945.        (fm=arm) or (fh=arm) then analyse_arms;}
  946.     asm
  947.       mov al,arm;  cmp al,fr; jz @analyse;
  948.       mov al,arm;  cmp al,fl; jz @analyse;
  949.       mov al,arm;  cmp al,fu; jz @analyse;
  950.       mov al,arm;  cmp al,fo; jz @analyse;
  951.       mov al,arm;  cmp al,fm; jz @analyse;
  952.       mov al,arm;  cmp al,fh; jz @analyse;
  953.       jmp @ende
  954.     @analyse: call analyse_arms
  955.     @ende:
  956.     end;
  957.     arm_links_old_status:=arm_links_status;
  958.     arm_rechts_old_status:=arm_rechts_status;
  959.     {final check routine}
  960.     if CurrentPos > NormalPos then begin
  961.         if (ballx = bx_old) and (bally = by_old) then retrace;
  962.         dec(CurrentPos); SetLineComp(CurrentPos);
  963.       end;
  964.     if (ballx <> bx_old) or (bally <> by_old) then begin
  965.          retrace;
  966.         {set ball}
  967.         calc_page_pos_of_ballpos;
  968.         move_ball;
  969.         {}
  970.         if (fr>0) or (fl>0) or (fu>0) or (fo>0) then analyse_crash;
  971.         if bende then break;
  972.         fh := gettablepixel(ballx+8,bally+8);
  973.         if fh <> fm then begin
  974.             if (fh>0) and (fh<128) then begin fm := fh; analyse_boden; end
  975.                       else if fh = 0 then fm := 0;
  976.           end;
  977.       end;
  978.      asm cli end;
  979.  
  980.     led_anzeige;
  981.  
  982.     case BumpCount of
  983.       0 : begin end;
  984.       1 : begin
  985.             for a := 240 to 248 do
  986.                 set_rgb_color(a,pal[a].r,pal[a].g,pal[a].b);
  987.             BumpCount := 0;
  988.           end;
  989.       else  dec(BumpCount)
  990.     end;
  991.     {fireflacker}
  992.                  if (PushUp = true) then flameflacker;
  993.   until bende = true;
  994.   {}
  995.   for b := 0 to 63 do
  996.     for a := 0 to 255 do begin
  997.         if pal[a].r > 0 then dec(pal[a].r);
  998.         if pal[a].g > 0 then dec(pal[a].g);
  999.         if pal[a].b > 0 then dec(pal[a].b);
  1000.         set_rgb_color(a,pal[a].r,pal[a].g,pal[a].b);
  1001.       end;
  1002.   Close_All;
  1003.   asm sti end;
  1004.   halt(1);
  1005. end.