home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / MBUG / MBUG013.ARC / HUSTLE.PAS < prev    next >
Pascal/Delphi Source File  |  1979-12-31  |  11KB  |  424 lines
  1. program HUSTLE;
  2.  
  3. { Converted from hustle.mwb |o Turb Pascal
  4.    for the MicroBee, and further developed
  5.    with sound effects by Bob Burt, 30/1/85
  6.  
  7.   Demonstrates graphics and sound procedures
  8.            developed by Bob Burt
  9.  
  10.       Colour procedures added 29/6/85      }
  11.  
  12. var
  13.   high_score : integer;              {highest score                 }
  14.   count : integer;                   {loop counter                  }
  15.   x,y : integer;                     {coordinates for head on screen}
  16.   change_x,change_y : integer;       {direction of head             }
  17.   start_head : integer;              {start of head                 }
  18.   tail_end : integer;                {end of tail                   }
  19.   target : integer;                  {target position               }
  20.   x_tar,y_tar : integer;             {coordinates for target posn   }
  21.   dwell : integer;                   {target duration on screen     }
  22.   value : integer;                   {value of demolished target    }
  23.   total_targets : integer;           {number of targets hit         }
  24.   time : integer;                    {total time elapsed            }
  25.   game_over : boolean;               {game over flag                }
  26.   total_score : integer;             {total score for current game  }
  27.   rating : integer;                  {targets hit versus time       }
  28.   speed : byte;                      {speed of game                 }
  29.   head : integer;                    {absolute position of head     }
  30.   tail_lag : integer;                {lag in tail                   }
  31.   ch,reply : char;                   {instruction characters        }
  32.   g : array[0..800,0..1] of integer; {record of head/tail components}
  33.   s : byte;                          {variable to set/reset a dot   }
  34.   dotset : integer;                  {variable to get screen pos    }
  35.                                      {of dot to be pointed to       }
  36.   data : array[0..1,0..3] of byte;   {screen_table array            }
  37.   mask : byte;                       {mask for screen table         }
  38.   interval : integer;                {variables                     }
  39.   set_tone,up_down : byte;           {       used                   }
  40.   duration,duration2 : byte;         {          by                  }
  41.   one_many,timbre : byte;            {           sound              }
  42.   compare,counter : byte;            {               generator      }
  43.  
  44. {$I colinit.pro}
  45. {$I lores80.pro}
  46. {$I normal.pro }
  47. {$I draw2.pro  }
  48. {$I gensnd.pro }
  49. {$I initsnd.pro}
  50.  
  51. procedure run_into_something; forward;
  52.  
  53. procedure attention; forward;
  54.  
  55. procedure gobbled_up; forward;
  56.  
  57. procedure pop_up; forward;
  58.  
  59. procedure screen_table; forward;
  60.  
  61. procedure clear_col;
  62. var
  63. col_ram : integer;
  64. begin
  65.   port[8] := 78; {colour RAM on, RGB guns full}
  66.   for col_ram := $F800 to $FFFF do
  67.     mem[col_ram] := 2; {default green on black}
  68.   port[8] := 14; {PCG RAM on, RGB guns full}
  69.   gotoxy(78,23)
  70. end; {procedure clear_col}
  71.  
  72. procedure point(x,y : byte);
  73. begin
  74.   mem[addr(draw2)+98] := x;
  75.   mem[addr(draw2)+99] := y;
  76.   draw2
  77. end; {procedure point}
  78.  
  79. procedure sets(s : byte);
  80. begin
  81.   mem[addr(draw2)+100] := s
  82. end; {procedure sets}
  83.  
  84. procedure border;
  85. begin
  86.   sets(0);
  87.   for count := 1 to 158 do
  88.     begin
  89.       point(count,0);
  90.       point(count,63);
  91.       point(count,71)
  92.     end;
  93.   for count := 0 to 71 do
  94.     begin
  95.       point(0,count);
  96.       point(159,count)
  97.     end;
  98.   for count := 64 to 70 do
  99.     begin
  100.       point(23,count);
  101.       point(47,count);
  102.       point(73,count);
  103.       point(116,count)
  104.     end
  105. end; {procedure border}
  106.  
  107. procedure frame;
  108. begin
  109.   sets(0);
  110.   for count := 33 to 110 do
  111.     begin
  112.       point(count,15);
  113.       point(count,70)
  114.     end;
  115.   for count := 16 to 69 do
  116.     begin
  117.       point(33,count);
  118.       point(110,count)
  119.     end
  120. end; {procedure frame}
  121.  
  122. procedure play_game;
  123. begin
  124.   delay(speed);
  125.   if keypressed then
  126.   begin
  127.     read(kbd,ch);
  128.     if ((ch =',') or (ch = '<')) and (change_x <> 1) then
  129.       begin
  130.         change_x := -1;
  131.         change_y := 0
  132.       end
  133.     else
  134.     if ((ch = '.') or (ch = '>')) and (change_x <> -1) then
  135.       begin
  136.         change_x := 1;
  137.         change_y := 0
  138.       end
  139.     else
  140.     if ((ch = 'A') or (ch = 'a')) and (change_y <> 1) then
  141.       begin
  142.         change_x := 0;
  143.         change_y := -1
  144.       end
  145.     else
  146.     if ((ch = 'Z') or (ch = 'z')) and (change_y <> -1) then
  147.       begin
  148.         change_x := 0;
  149.         change_y := 1
  150.       end;
  151.   end; {keypressed}
  152.   x := x + change_x; y := y + change_y;
  153.   if start_head < 800 then
  154.     start_head := start_head + 1
  155.   else
  156.     begin
  157.       start_head := 0;
  158.       time := time + 800
  159.     end; {else}
  160.   if tail_lag >= 0 then
  161.   begin
  162.     if tail_end < 800 then
  163.       tail_end := tail_end + 1
  164.     else
  165.       tail_end := 0;
  166.     sets(1);
  167.     point(g[tail_end,0],g[tail_end,1])
  168.   end; {tail_lag >= 0}
  169.   if tail_lag < 0 then
  170.     tail_lag := tail_lag + 1;
  171.   dotset := (y div 3)*80 + (x div 2) - 4096;   {equivalent of 'point'}
  172.   mask := data[(x mod 2),(y mod 3)];           {         in          }
  173.   if mem[dotset] and mask = mask then          {  MicroWorld Basic   }
  174.     run_into_something;
  175.   if not game_over then
  176.   begin
  177.     sets(0); point(x,y);
  178.     g[start_head,0] := x; g[start_head,1] := y;
  179.     if dwell = 0 then
  180.     begin
  181.       x_tar := (target mod 80) + 1; y_tar := (target div 80) + 1;
  182.       gotoxy(x_tar,y_tar);
  183.       writeln(chr(128),chr(128),chr(128));
  184.       gotoxy(78,23);
  185.       dwell := -1;
  186.     end; {dwell = 0}
  187.     if dwell <= 0 then
  188.       begin
  189.         randomize;
  190.         if random >= 0.9 then
  191.         begin
  192.           repeat
  193.             target := random(21)*80 + random(80) - 4096
  194.           until (mem[target]=128)and(mem[target+1]=128)and(mem[target+2]=128);
  195.           pop_up;
  196.           mem[target] := 183;
  197.           mem[target+1] := 179;
  198.           mem[target+2] := 187;
  199.           target := target + 4096;
  200.           dwell := random(100) + 80
  201.         end {random}
  202.       end; {dwell <= 0}
  203.     if dwell > 0 then
  204.       dwell := dwell - 1
  205.   end {not game_over}
  206. end; {procedure play_game}
  207.  
  208. procedure run_into_something;
  209. begin
  210.   head := (y div 3)*80 + (x div 2);
  211.   game_over := not((head=target)or(head=target+1)or(head=target+2));
  212.   if not game_over then
  213.   begin
  214.     value := random(9) + 1;
  215.     total_score := total_score + value;
  216.     tail_lag := tail_lag - value*2;
  217.     total_targets := total_targets + 1;
  218.     rating := (total_targets)*1000 div (time + start_head);
  219.     gobbled_up;
  220.     dwell := -1;
  221.     x_tar := (target mod 80) + 1;
  222.     y_tar := (target div 80) + 1;
  223.     for count := 1 to 8 do
  224.       begin
  225.         gotoxy(x_tar,y_tar);
  226.         write(value,chr(128));
  227.         delay(100);
  228.         gotoxy(x_tar,y_tar);
  229.         write(chr(183),chr(179),chr(187))
  230.       end;
  231.     gotoxy(x_tar,y_tar);
  232.     write(chr(128),chr(128),chr(128));
  233.     gotoxy(8,23);
  234.     color(5,2,0);
  235.     write(((time + start_head) div 100) + 1);
  236.     gotoxy(20,23);
  237.     write(total_score);
  238.     gotoxy(33,23);
  239.     write(rating,' ');
  240.     if speed = 10 then speed := 20;
  241.     speed := speed - 1;
  242.     gotoxy(76,23);
  243.     write(speed,' ');
  244.     color(2,0,0);
  245.     gotoxy(78,23)
  246.   end {not game_over}
  247. end; {procedure run_into_something}
  248.  
  249. procedure end_of_game;
  250. begin
  251.   attention;
  252.   clear_col;
  253.   lores80;
  254.   frame;
  255.   gotoxy(28,9);
  256.   color(3,3,0);
  257.   write(' G A M E  O V E R ');
  258.   gotoxy(28,13);
  259.   color(4,6,0);
  260.   write('Your Score is : ');
  261.   color(6,4,0); write(' ',total_score);
  262.   if total_score > high_score then high_score := total_score;
  263.   gotoxy(27,16);
  264.   color(6,1,0);
  265.   write('Your Rating is : ');
  266.   color(6,6,0); write(' ',rating);
  267.   gotoxy(26,19);
  268.   color(7,2,0);
  269.   write('Highest Score is : ');
  270.   color(2,7,0); write(' ',high_score);
  271.   repeat
  272.     gotoxy(24,22);
  273.     color(2,5,0);
  274.     write('Do you want to play again?   ');
  275.     gotoxy(51,22);
  276.     attention;
  277.     color(5,2,0); read(reply);
  278.   until (reply='Y') or (reply='y') or (reply='N') or (reply='n');
  279.   gotoxy(78,23);
  280.   clear_col
  281. end; {procedure end_of_game}
  282.  
  283. procedure initialise;
  284. begin
  285.   x := 60; y := 24; {position of head on screen}
  286.   change_x := 1; change_y := 0;
  287.   start_head := 0; tail_end := 0;
  288.   head := 0; tail_lag := -3;
  289.   target := 0; dwell := -1;
  290.   value := 0; total_targets := 0;
  291.   time := 0; game_over := false;
  292.   total_score := 0; rating := 0;
  293.   speed := 25
  294. end; {procedure initialise}
  295.  
  296. procedure record_score;
  297. begin
  298.   gotoxy(3,23);
  299.   color(2,5,0);
  300.   write('Time');
  301.   gotoxy(14,23);
  302.   write('Score');
  303.   gotoxy(26,23);
  304.   write('Rating');
  305.   gotoxy(40,23);
  306.   write('High Score :');
  307.   color(5,2
  308.   ,0);
  309.   write(' ',high_score);
  310.   gotoxy(63,23);
  311.   color(2,5,0);
  312.   write('Speed Factor ');
  313.   color(2,0,0);
  314. end; {procedure record_score}
  315.  
  316. procedure hustle;
  317. begin
  318.   colinit; {initialise colour procedure}
  319.   set_tone := 200; up_down := 5;
  320.   duration := 1; duration2 := 0;
  321.   one_many := 32;
  322.   timbre := 65; compare := 0;
  323.   lowvideo;
  324.   color(4,0,0);
  325.   gotoxy(29,6); write(' H ');
  326.   initsnd; gensnd;
  327.   gotoxy(32,6); color(2,0,0); write(' U ');
  328.   initsnd; gensnd;
  329.   gotoxy(35,6); color(3,0,0); write(' S ');
  330.   initsnd; gensnd;
  331.   gotoxy(38,6); color(6,0,0); write(' T ');
  332.   initsnd; gensnd;
  333.   gotoxy(41,6); color(1,0,0); write(' L ');
  334.   initsnd; gensnd;
  335.   gotoxy(44,6); color(5,0,0); write(' E ');
  336.   normvideo;
  337.   gotoxy(26,10); color(3,3,0); write('To move UP     Press ');
  338.   lowvideo; write(' A '); normvideo;
  339.   gotoxy(26,12); color(4,6,0); write('To move DOWN   Press ');
  340.   lowvideo; write(' Z '); normvideo;
  341.   gotoxy(26,14); color(6,1,0); write('To move LEFT   Press ');
  342.   lowvideo; write(' < '); normvideo;
  343.   gotoxy(26,16); color(7,2,0); write('To move RIGHT  Press ');
  344.   lowvideo; write(' > '); normvideo;
  345.   screen_table;
  346.   gotoxy(24,19); color(2,5,0); write('Press any key to start game ');
  347.   repeat until keypressed;
  348.   gotoxy(78,23)
  349. end; {procedure hustle}
  350.  
  351. procedure attention;
  352. begin
  353.   up_down := 5; compare := 1;
  354.   for count := 1 to 20 do
  355.     begin
  356.       set_tone := count*2 + 5;
  357.       duration := 20 - (count div 2);
  358.       initsnd; gensnd;
  359.       delay(15)
  360.     end
  361. end; {procedure attention}
  362.  
  363. procedure gobbled_up;
  364. begin
  365.   set_tone := 60;
  366.   duration := 1;
  367.   for count := 1 to 3 do
  368.   begin
  369.     initsnd; gensnd;
  370.     delay(200)
  371.   end
  372. end; {procedure gobbled_up}
  373.  
  374. procedure pop_up;
  375. begin
  376.   set_tone := 80;
  377.   duration := 1;
  378.   initsnd; gensnd
  379. end; {procedure pop_up}
  380.  
  381. procedure screen_table;
  382. begin
  383.   mask := 1;
  384.   for y := 0 to 2 do
  385.     for x := 0 to 1 do
  386.       begin
  387.         data[x,y] := mask;
  388.         mask := mask*2
  389.       end
  390. end; {procedure screen_table}
  391.  
  392.  
  393.  
  394.  
  395. begin {main}
  396.   clrscr;
  397.   hustle;
  398.   clear_col;
  399.   high_score := 0;
  400.   repeat
  401.     initialise;
  402.     lores80;
  403.     border;
  404.     record_score;
  405.     repeat
  406.       play_game;
  407.     until game_over;
  408.     end_of_game
  409.   until (reply <> 'Y') and (reply <> 'y');
  410.   clrscr;
  411.   normal
  412. end. {main}
  413.  
  414.  
  415.  
  416.  
  417.  
  418.  
  419.  
  420.  
  421.  
  422.  
  423.  
  424.