home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / mbug / mbug086.arc / HUSTLE.LBR / PLAY.IZ / PLAY.I
Text File  |  1979-12-31  |  4KB  |  172 lines
  1. procedure erase_target;
  2.  
  3. begin
  4. with target do
  5.   begin
  6.   redraw(x-1,y,x+1,y);
  7.   redraw(x-1,y+1,x+1,y+1);
  8.   redraw(x-1,y-1,x+1,y-1);
  9.   end;
  10. end;  (* erase_target *)
  11.  
  12.  
  13. procedure moveplayer;
  14.  
  15. var
  16.   c :char;
  17.  
  18.   procedure hit_something;
  19.  
  20.   var
  21.     value :byte;
  22.  
  23.     function istarget :boolean;
  24.  
  25.     begin
  26.     with player do with tail do with target do
  27.       if ((head.y in [y-1,y+1]) and (head.x >= x-1) and (head.x <= x+1)) or
  28.          ((head.x in [x-1,x+1]) and (head.y >= y-1) and (head.y <= y+1))
  29.         then istarget := true
  30.         else istarget := false;
  31.     end;  (* istarget *)
  32.  
  33.   begin  (* hit_something *)
  34.   gameover := not istarget;
  35.   if not gameover
  36.     then with player do
  37.            begin
  38.            value := random(9)+1;
  39.            score := score + value;
  40.            tail.tail_lag := tail.tail_lag - value * 2;
  41.            target_total := target_total + 1;
  42.            rating := (target_total*1000) div (elapsedtime + tail.headstart);
  43.            target.dwell := -1;
  44.            erase_target;
  45.            gobble_sound;
  46.            end;
  47.   end;  (* hit_something *)
  48.  
  49. begin  (* moveplayer *)
  50. with player do with tail do
  51.   begin
  52.   if keypressed
  53.     then begin
  54.          read(kbd,c);
  55.          if c in ['Q','q'] then
  56.            begin
  57.            diry := 1;
  58.            dirx := 0;
  59.            end
  60.          else
  61.            if c in ['A','a'] then
  62.              begin
  63.              diry := -1;
  64.              dirx := 0;
  65.              end
  66.            else
  67.              if c in ['['] then
  68.                begin
  69.                dirx := -1;
  70.                diry := 0;
  71.                end
  72.              else
  73.                if c in [']'] then
  74.                  begin
  75.                  dirx := 1;
  76.                  diry := 0;
  77.                  end;
  78.          end;
  79.   with head do
  80.     begin
  81.     x := x + dirx;
  82.     y := y + diry;
  83.     end;
  84.   if headstart < maxtail_len
  85.     then headstart := headstart + 1
  86.     else begin
  87.          headstart := 1;
  88.          elapsedtime := elapsedtime + maxtail_len;
  89.          end;
  90.   if tail_lag >= 0
  91.     then begin
  92.          if tailend < maxtail_len
  93.            then tailend := tailend + 1
  94.            else tailend := 1;
  95.          with component [tailend] do replot(x,y);
  96.          end;
  97.   if tail_lag < 0
  98.     then tail_lag := tail_lag + 1;
  99.   with head do if pixthere(x,y) then hit_something;
  100.   if not gameover
  101.     then begin
  102.          with head do plot(x,y);
  103.          component [headstart] := head;
  104.          end;
  105.   end; (* with player *)
  106. end;  (* moveplayer *)
  107.  
  108.  
  109. procedure set_target;
  110.  
  111.   function target_drawn :boolean;
  112.   (* Attempt to draw target at new coordinates. *)
  113.  
  114.   var
  115.     x1,x2,y1,y2,dy,dx :byte;
  116.     clear :boolean;
  117.  
  118.   begin
  119.   clear := true;
  120.   with target do
  121.     if (x in [1,158]) or (y in [1,70])  (* would target be off screen? *)
  122.       then clear := false
  123.       else begin
  124.            x1 := x - 1;
  125.            x2 := x + 1;
  126.            y1 := y - 1;
  127.            y2 := y + 1;
  128.            end;
  129.   if clear
  130.     then begin     (* test if target would overdraw something *)
  131.          dy := y1;
  132.          while (dy <= y2) and clear do
  133.            begin
  134.            dx := x1;
  135.            while (dx <= x2) and clear do
  136.              begin
  137.              clear := not pixthere(dx,dy);
  138.              dx := dx + 1;
  139.              end;
  140.            dy := dy + 1;
  141.            end;
  142.          end;
  143.   if clear
  144.     then begin
  145.          draw(x1,y1,x1,y2); (* draw vertical lines *)
  146.          draw(x2,y1,x2,y2);
  147.          draw(x1,y1,x2,y1); (* draw horizontal lines *)
  148.          draw(x1,y2,x2,y2);
  149.          end;
  150.   target_drawn := clear;
  151.   end;  (* target_drawn *)
  152.  
  153. begin  (* set_target *)
  154. with target do
  155.   begin
  156.   if dwell = 0
  157.     then erase_target;
  158.   if dwell <= 0
  159.     then if random > 0.9
  160.            then begin
  161.                 repeat
  162.                   x := 1 + random(158);
  163.                   y := 1 + random(70);
  164.                 until target_drawn;
  165.                 dwell := random(100) + 80;
  166.                 popup_sound;
  167.                 end;
  168.   if dwell > 0
  169.     then dwell := dwell - 1;
  170.   end;
  171. end;  (* set_target *)
  172.