Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/GAMETP.ZIP/SAMPLE.ZIP/RSAMPLE.PAS

Pascal/Delphi Source File | 1992-10-30 | 27.8 KB | 1,163 lines

Program RSquid;
{$X+ }
{$M 38467,0,655360 }

{ RSQUID Copyright 1992 by Scott D. Ramsay }

{ Requires Turbo Pascal 6.0 and units:
           VGAKERN.TPU
           MISCFUNC.TPU
           KEYBOARD.TPU
           IMAGING.TPU
           GMORPH.TPU
           BEFFECTS.TPU
           OOPOBJS.TPU                                             }
{                                                                  }
{ I really don't feel like commenting this program.  Hopefully     }
{ most of the functions and procedures are self explanatory.       }
{  I know it's sloppy coding, but I've tried to use all the        }
{ functions and I'm not out to win an award.                       }
{  The Game pretty much covers almost all aspects of game program  }
{ except, for sound. (If you think this code is hacky, My          }
{ SoundBlaster code is terrible. ) But it actually works.  I'm     }
{ programming the card directly.  (Plug.) The unit will be ready   }
{ soon it will allow for two digitized voices played at once.      }
{ I.E. One background music, the other game SFX,  I don't like     }
{ programming the FM chip, (Besides I don't have any programs to   }
{ create any ROL,CMF,MID files).                                   }
{  If you have any questions about the code, or help explain, send }
{ me e-mail at:                                                    }
{        [e-mail]                                 }
{                                                                  }
{  As an exersise "I sound like a teacher :( ", incorporate the    }
{ joystick unit into the program.                                  }
{  As you can see, this program uses a lot of sprites, Look at the }
{ SETUP procedure.                                                 }

Uses Crt,VgaKern,MiscFunc,KeyBoard,Imaging,Gmorph,Beffects,OopObjs;

const
  path    = '';
  gmx     = 100;
  gmy     = 50;
  smx     = gmx shl 4-1;
  smy     = gmy shl 4-1;
  lvlbc   : array[0..5] of byte =
            (186,80,233,239,222,208);

type
  data1 = record
            safe,flip,
            vdx,vdy,guys,
            vx,vy,drx    : integer;
            lvls         : array[0..2] of integer;
            score        : longint;
            turn,blown   : boolean;
          end;
  pshot= ^tshot;
  tshot = object(tobjs)
            ndx,ndy  : integer;
            constructor init;
            procedure drawitemobject;virtual;
            procedure calcitemobject;virtual;
            function checkhit(hx,hy:integer):boolean;virtual;
          end;
  pgirl = ^tgirl;
  tgirl = object(tshot)
            goup,godown : boolean;
            constructor init;
            procedure calcitemobject; virtual;
            procedure drawitemobject;virtual;
            procedure checkplayertouch; virtual;
          end;
  pclod = ^tclod;
  tclod = object(tshot)
            constructor init;
            procedure calcitemobject; virtual;
            procedure drawitemobject;virtual;
          end;
  pnake = ^tnake;
  tnake = object(tshot)
            trn : boolean;
            constructor init;
            procedure drawitemobject;virtual;
            function checkhit(hx,hy:integer):boolean;virtual;
            procedure calcitemobject;virtual;
            procedure checkplayertouch;virtual;
          end;
  psimm = ^tsimm;
  tsimm = object(tnake)
            constructor init;
            procedure drawitemobject;virtual;
            procedure checkplayertouch;virtual;
          end;
  PMyCycle = ^TMyCycle;
  TMyCycle = object(Tcycle)
               procedure cycle_move; virtual;
             end;
  PMyMorph = ^TMyMorph;
  TMyMorph = object(TMorph)
               function geomap(x,y:integer):integer;virtual;
               procedure placegeo(x,y,geonum:integer;var geos);virtual;
               procedure pre_map; virtual;
               procedure post_map; virtual;
             end;

var
  drols,girls   : array[0..48] of pointer;
  nakes         : array[0..116] of pointer;
  simmers       : array[0..15] of pointer;
  rsmisc        : array[0..17] of pointer;
  gwmp,gpic,
  nummo         : array[0..30] of pointer;
  kill          : pkill;
  nkbeg,nkend   : plist;
  player        : data1;
  map           : array[0..gmy-1,0..gmx-1] of byte;
  girls_out     : integer;
  blv           : shortint;
  paused,warp   : boolean;
  canchk        : word;
  stx,geo_count,
  ovx,ovy,gx,gy : integer;
  oldexit       : pointer;
  dac           : RGBlist;
  MyCycle       : PMyCycle;
  MyMorph       : PMyMorph;

procedure pause_ptr;external; { A VSP file using BINOBJ.EXE }
{$l paused.obj }

procedure cleanup;far;
begin
  closemode;
  exitproc := oldexit;
end;


procedure drawstatus(h:integer);
var
  xp : integer;
begin
  setpageactive(1);
  xp := h shl 1+h+73;
  with player do
    begin
      if lvls[h]<22
        then
          begin
            if lvls[h]<1
              then bar(xp,156,xp+1,178,lvlbc[h shl 1])
              else bar(xp,156,xp+1,177-lvls[h],lvlbc[h shl 1]);
          end;
      if lvls[h]>0
        then bar(xp,178-lvls[h],xp+1,178,lvlbc[h shl 1+1]);
    end;
  setpageactive(2);
end;


procedure page1stuff;
var
  p : plist;
  d : integer;
begin
  setpageactive(2);
  bar(14,155,63,178,0);
  p := nkbeg;
  while p<>nil do
    with p^.item^ do
      begin
        if mapcolor<>0
          then pset(14+nx shr 4 shr 1,155+ny shr 4 shr 1,mapcolor);
        p := p^.next;
      end;
  with player do
    pset(14+vx shr 4 shr 1,155+vy shr 4 shr 1,$c0);
  fastwmatte(14,155,63,178,pages[2]^,pages[1]^);
  for d := 0 to 2 do
    drawstatus(d);
end;


procedure update;
var
  p : pointer;
begin
  if paused
    then
      begin
        p := @pause_ptr; setpageactive(2);
        fastput(98,64,p^);
      end;
  fastwmatte(13,20,172+128,179-32,pages[2]^,pages[1]^);
  page1stuff;
end;


procedure ifix(var a:integer;min,max:integer);
begin
  if a<min
    then a := min
    else
      if a>max
        then a := max;
end;


procedure drawperson;
var
  nx,ny : integer;
begin
  with player do
    begin
      nx := 148; ny := 85-16;
      if safe>0
        then
          begin
            dec(nx,ord(safe<30)*random(4));
            dec(ny,ord(safe<75)*random(2)-ord(safe<30)*random(4));
          end;
      if blown
        then fbitdraw(nx,ny+4,rsmisc[2+flip]^)
        else
          case drx of
            0 : if safe>0
                  then fbitdraw(nx,ny+8,rsmisc[1]^)
                  else fbitdraw(nx,ny,drols[flip]^);
            1 : if turn
                  then fbitdraw(nx,ny,drols[flip]^)
                  else fbitdraw(nx,ny,drols[32+flip]^);
           -1 : if turn
                  then fbitdraw(nx,ny,drols[flip]^)
                  else fbitdraw(nx,ny,drols[16+flip]^);
          end;
    end;
end;


procedure drawitems(over:boolean);
var
  p : plist;
begin
  p := nkbeg;
  while p<>nil do
    begin
      if (p^.item^.overshow=over)
        then p^.item^.drawitemobject;
      p := p^.next;
    end;
end;


procedure strobe;
const
{ This is a hack procedure.  I didn't feel like doing the calcuation for CLC }
  clc : array[0..30] of byte =
        (15,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15);
var
  d : integer;
begin
  setpageactive(1);
  stx := (stx+5) mod 286;
  line(14,14,299,14,0);
  for d := 0 to 30 do
    pset((stx+d) mod 286+14,14,176+clc[d]);
end;


procedure titlepage;
begin
  loadpcx(path+'rtitle.pcx');
  fadein(200,zdc,rgb256);
  clearbuffer;
  repeat until ch<>#1;          { Notice there is nothing in the repeat until }
                                { I took over the Keyboard int }
  clearbuffer;
  fadeout(50,zdc,rgb256);
end;


procedure setup;
var
  fil : file;
begin
  writeln('Scott Ramsay presents:');
  writeln('R-SQUID (unfinished, always will be)');
  writeln;
  writeln('This is a quick-and-dirty example of various effects PC ');
  writeln('can do.  ');
  writeln('Controls :');
  writeln(' Arrows         -   Move Dude');
  writeln('                    up    = jump, up elevators');
  writeln('                    down  = down elevators');
  writeln('                    right = take a guess');
  writeln('                    left  = -(right)');
  writeln(' SPACE          -   Fire shots');
  writeln('   P            -   Pause screen');
  writeln('   A            -   Add a nake');
  writeln('   S            -   Add a simmer');
  writeln('  -/+           -   Adjust brightness');
  writeln('  ESC           -   Quit');
  clearbuffer;
  repeat until ch<>#1;
  clearbuffer;
  openmode(3); randomize;
  oldexit := exitproc; exitproc := @cleanup;
  loadvsp(path+'drols.vsp',drols); fsetcolors(zdc);
  loadvsp(path+'girls.vsp',girls);
  loadvsp(path+'nakes.vsp',nakes);
  loadvsp(path+'simmers.vsp',simmers);
  loadvsp(path+'rsmisc.vsp',rsmisc);
  loadvsp(path+'rsquid.geo',gpic); geo_count := vspcnt;
  loadvsp(path+'dr2.vsp',nummo);
  loadcolors(path+'rsquid.pal',dac,255);
  assign(fil,path+'rsquid.map'); reset(fil,1);
  blockread(fil,map,filesize(fil)); close(fil);
  setpageactive(3);
  loadpcx(path+'fire.pcx');
  setpageactive(1);
  titlepage;
  loadpcx(path+'dash.pcx');
  fadein(60,zdc,dac);
end;


procedure setparms;
var
  d : integer;
  p : plist;
begin
  MyCycle := new(PMyCycle,init(34,12));
  MyMorph := new(PMyMorph,init(gmx,gmy,19,9,13,20));
  warp := true; stx := 0; girls_out := 5;
  kill := nil; paused := false; blv := 0;
  nkbeg := nil; nkend := nil;
  with player do
    begin
      lvls[0] := 16; lvls[1] := 10; lvls[2] := 22;
      vx := 44; vy := 55; flip := 7; score := 0;
      ovx := vx; ovy := vy; vdx := 0; vdy := 0; guys := 3;
      drx := 0; turn := false; safe := 100; blown := false
    end;
  for d := 1 to 20 do
    begin
      new(p);
      p^.item := new(pclod,init);
      addp(nkbeg,nkend,p);
    end;
  for d := 1 to girls_out do
    begin
      new(p);
      p^.item := new(pgirl,init);
      addp(nkbeg,nkend,p);
    end;
end;


procedure printscore;
var
  s : string;
  d : byte;
begin
  s := lz(player.score,8);
  setpageactive(1);
  for d := 0 to length(s)-1 do
    fastput(d*21+130,158,nummo[ord(s[d+1])-ord('0')]^);
  setpageactive(2);
end;


function elevat(vx,vy:integer):boolean;
var
  cx,cy : integer;
  d     : byte;
begin
  d := 0;
  cx := (vx) shr 4; cy := (vy+15) shr 4;
  if map[cy,cx] in [9,10]
    then d := 1;
  cx := (vx+9) shr 4; cy := (vy+15) shr 4;
  if map[cy,cx] in [9,10]
    then inc(d);
  elevat := (d<>0);
end;


function canfall(vx,vy:integer): boolean;
var
  cx,cy : integer;
  d     : byte;
begin
  d := 0;
  cx := (vx) shr 4; cy := (vy+16) shr 4;
  canchk := map[cy,cx];
  if not (map[cy,cx] in [1,3,6,8])
    then d := 1;
  cx := (vx+9) shr 4; cy := (vy+16) shr 4;
  if not (map[cy,cx] in [1,3,6,8])
    then inc(d);
  canchk := (canchk shl 8) or map[cy,cx];
  canfall := (d=2);
end;


function canwalk(vx,vy:integer): boolean;
var
  cx,cy : integer;
  d     : byte;
begin
  d := 0;
  cx := (vx) shr 4; cy := (vy+16) shr 4;
  canchk := map[cy,cx];
  if map[cy,cx] in [1,3,5,6,8,10]
    then d := 1;
  cx := (vx+9) shr 4; cy := (vy+16) shr 4;
  if map[cy,cx] in [1,3,5,6,8,10]
    then inc(d);
  canchk := (canchk shl 8) or map[cy,cx];
  canwalk := (d=2);
end;


procedure zero(var valu:integer);
begin
  if valu<0
    then inc(valu)
    else
      if valu>0
        then dec(valu);
end;


procedure calcitems;
var
  p : plist;
begin
  p := nkbeg;
  while p<>nil do
    begin
      p^.item^.calcitemobject;
      p := p^.next;
    end;
end;


procedure addfire;
var
  p : plist;
begin
  new(p);
  p^.item := new(pshot,init);
  p^.item^.powner := p;
  addp(nkbeg,nkend,p);
end;


procedure addsimmers;
var
  p : plist;
begin
  new(p);
  p^.item := new(psimm,init);
  p^.item^.powner := p;
  addp(nkbeg,nkend,p);
end;


procedure addnake;
var
  p : plist;
begin
  new(p);
  p^.item := new(pnake,init);
  p^.item^.powner := p;
  addp(nkbeg,nkend,p);
end;


procedure finc(var i:byte;a:shortint);
begin
  if i+a<0
    then i := 0
    else
      if i+a>63
        then i := 63
        else inc(i,a);
end;


procedure brightcheck;
var
  temp : RGBlist;
  d    : integer;
begin
  if plus and (blv<20)
    then
      begin
        inc(blv);
        temp := dac;
        for d := 0 to 255 do
          with temp[d] do
            begin
              finc(red,blv);
              finc(green,blv);
              finc(blue,blv);
            end;
        fsetcolors(temp);
      end;
  if minus and (blv>-20)
    then
      begin
        dec(blv);
        temp := dac;
        for d := 0 to 255 do
          with temp[d] do
            begin
              finc(red,blv);
              finc(green,blv);
              finc(blue,blv);
            end;
        fsetcolors(temp);
      end;
end;


procedure pause;
  procedure dit;
  begin
    MyCycle^.docycle(3,2,2);
    update; strobe;
    brightcheck;
  end;
begin
  paused := true;
  repeat dit; until ch<>'P';
  repeat dit; until (ch='P') and not funct;
  repeat dit; until ch<>'P';
  paused := false;
  setpageactive(2);
end;


procedure checkotherkeys(var detwait:boolean);
var
  temp : RGBlist;
  d    : integer;
begin
  if (ch='P') and not funct
    then pause;
  brightcheck;
  if ch='A'
    then addnake;
  if ch='S'
    then addsimmers;
end;


procedure getkey;
var
  up,ovx,ovy : integer;
  detwait    : boolean;
begin
  with player do
    begin
      clearbuffer; up := 0; detwait := false;
      repeat
        checkotherkeys(detwait);
        if blown
          then
            begin
              inc(flip);
              if flip=15
                then
                  begin
                    blown := false;
                    lvls[0] := 16;
                    lvls[1] := 10;
                    lvls[2] := 22;
                    safe := 100;
                    flip := 7;
                    drx := 0;
                    dec(guys);
                    {if guys=0 (**)
                      then gameover; }
                  end;
              zero(vdx);
            end
          else
            begin
              case drx of
                0 : begin
                      if safe>0
                        then dec(safe);
                      if np[7,2] or np[4,2] or np[1,2]
                        then
                          begin
                            drx := 1; safe := 0;
                            turn := true;
                          end
                        else
                      if np[9,2] or np[6,2] or np[3,2]
                        then
                          begin
                            drx := -1; safe := 0;
                            turn := true;
                          end;
                    end;
                1 : if turn
                      then
                        if flip<14
                          then inc(flip,2)
                          else turn := false
                      else
                        begin
                          if np[7,2] or np[4,2] or np[1,2]
                            then flip := (flip+1)mod 16;
                          if np[9,2] or np[6,2] or np[3,2]
                            then
                              begin
                                flip := 15; vdx := 0;
                                drx := -1; turn := true;
                              end;
                        end;
               -1 : if turn
                      then
                        if flip>1
                          then dec(flip,2)
                          else turn := false
                      else
                        begin
                          if np[9,2] or np[6,2] or np[3,2]
                            then flip := (flip+1)mod 16;
                          if np[7,2] or np[4,2] or np[1,2]
                            then
                              begin
                                flip := 0; vdx :=0;
                                drx := 1; turn := true;
                              end;
                        end;
              end;
              ovy := vy; ovx := vx;
              if (np[7,2] or np[8,2] or np[9,2]) and elevat(vx,vy)
                then
                  begin
                    dec(vy);
                    up := -1;
                    vx := (vx+8) shr 4 shl 4;
                  end
                else
                  if (np[1,2] or np[2,2] or np[3,2]) and elevat(vx,vy+1)
                    then
                      begin
                        inc(vy);
                        vx := (vx+8) shr 4 shl 4;
                        up := 1;
                      end;
              if (vx>0) and (np[7,2] or np[4,2] or np[1,2])
                then dec(vdx,1)
                else
                  if (vx<smx) and (np[9,2] or np[6,2] or np[3,2])
                    then inc(vdx,1)
                    else zero(vdx);
              if space and (drx<>0) and (lvls[2]>0)
                then
                  begin
                    addfire;
                    dec(lvls[2],2);
                  end
                else
                  if (lvls[2]<22) and (random<0.2)
                    then inc(lvls[2]);
            end;
        ifix(vdx,-10,10);
        if canfall(vx,vy)
          then
            begin
              if elevat(vx,vy) and (up=-1)
                then
                  begin
                    dec(vy);
                    vy := vy shr 4 shl 4;
                    vdy := 0;
                  end
                else
                  if (up=1) or ((up=0) and ((hi(canchk)<>10) or (lo(canchk)<>10)))
                    then
                      begin
                        inc(vdy,3);
                        if vdy>15
                          then vdy := 15;
                      end
                    else up := 0;
            end
          else
            begin
              vy := vy shr 4 shl 4;
              vdy := 0; up := 0;
              if not blown and (np[7,2] or np[8,2] or np[9,2])
                then vdy := -abs(vdx);
            end;
        inc(vx,vdx); inc(vy,vdy);
        if vx<16
          then vx := ovx
          else if vx>(gmx-2) shl 4
                 then vx := ovx;
        calcitems;
        MyMorph^.drawmap(vx,vy,gpic);
        update;
        cleankill_list(kill,nkbeg,nkend);
      until esc;
    end;
end;


function checkallhit(hx,hy:integer) : boolean;
var
  p   : plist;
  did : boolean;
begin
  p := nkbeg; did := false;
  while (p<>nil) and not did do
    begin
      if p^.item^.id    { shots don't affect eachother (id=0) }
        then did := p^.item^.checkhit(hx,hy);
      p := p^.next;
    end;
  checkallhit := did;
end;


(**) { tshot Methods }

constructor tshot.init;
begin
  nx := player.vx+8; ny := player.vy; explo := false;
  ndy := 0; ndx := -12*player.drx; id := false;
  nrx := -player.drx; mapcolor := $fb; pointage := 0;
  flp := 0; timeo := 15; overshow := false;
end;


procedure tshot.drawitemobject;
begin
  with player do
    if range(nx,ny,vx-150,vy-80,vx+140,vy+80)
      then fbitdraw(153+(nx-vx),84+(ny-vy),rsmisc[17]^);
end;


procedure tshot.calcitemobject;
var
  p : plist;
begin
  if random<0.8
    then
      if (nrx<0) and (ndx>-15)
        then dec(ndx)
        else
         if (nrx>0) and (ndx<15)
           then inc(ndx);
  inc(nx,ndx); inc(ny,ndy); dec(timeo);
  if timeo=0
    then add2kill_list(kill,powner)
    else
      if checkallhit(nx,ny)
        then add2kill_list(kill,powner);
end;


function tshot.checkhit(hx,hy:integer):boolean;
begin
  checkhit := false;
end;

(**) { Tclod Methods }

constructor tclod.init;
begin
  mapcolor := 0; id := false;
  overshow := true;
  nx := random(gmx shl 4);
  ny := random((gmy-6) shl 4);
  repeat
    ndx := random(7)-3;
  until ndx<>0;
  ndy := 0;
end;


procedure tclod.drawitemobject;
begin
  with player do
    if range(nx,ny,vx-150,vy-90,vx+130,vy+80)
      then fbitdraw(153+(nx-vx),89+(ny-vy),rsmisc[0]^);
end;


procedure tclod.calcitemobject;
var
  p : plist;
begin
  inc(nx,ndx); inc(ny,ndy);
  if nx<-300
    then nx := gmx shl 4+300
    else
      if nx>gmx shl 4+300
        then nx := -300;
end;

(**) { Tgirl Methods }

constructor tgirl.init;
begin
  mapcolor := 163; id := false; goup := false;
  overshow := false; flp := 0; godown := false;
  with player do
    repeat
      nx := random(gmx shl 4);
      ny := random((gmy-4) shl 4);
    until canwalk(nx,ny) and not range(nx,ny,vx-150,vy-90,vx+130,vy+80);
  if random<0.4
    then ndx := -4
    else ndx := 4;
  ndy := 0; nrx := ndx;
end;


procedure tgirl.checkplayertouch;
var
  dir : integer;
begin
  with player do
    if not boolean(safe) and not blown and range(nx+9,ny,vx-40,vy,vx+80,vy+10)
      then
        begin
          if ndx<>0
            then nrx := ndx;
          dir := (nx-vx);
          if dir<-10
            then ndx := 4
            else
              if dir>10
                then ndx := -4
                else ndx := 0;
        end
      else
        if ndx=0
          then ndx := nrx;
end;


procedure tgirl.calcitemobject;
var
  ox,oy,b : integer;
begin
  ox := nx; oy := ny;
  if canfall(nx,ny)
    then
      begin
        if ndy<16
          then inc(ndy);
      end
    else
      begin
        ndy := 0;
        ny := ny shr 4 shl 4;
      end;
  inc(nx,ndx); inc(ny,ndy);
  if (nx<16) or (nx>(gmx-2)shl 4)
    then
      begin
        nx := ox;
        ndx := -ndx;
      end;
  if not canwalk(nx,ny) and canwalk(ox,oy) and (random<0.4)
    then
      begin
        nx := ox;
        ndx := -ndx;
      end;
  if not goup and not godown
    then flp := (flp+1)mod 16;
end;


procedure tgirl.drawitemobject;
begin
  with player do
    if range(nx,ny,vx-160,vy-80,vx+140,vy+80)
      then
        if ndx<0
          then fbitdraw(153+(nx-vx),68+(ny-vy),girls[flp]^)
          else
        if ndx>0
          then fbitdraw(153+(nx-vx),68+(ny-vy),girls[flp+16]^)
          else
        if (nx<vx)
          then fbitdraw(153+(nx-vx),68+(ny-vy),girls[16]^)
          else fbitdraw(153+(nx-vx),68+(ny-vy),girls[0]^);
end;


(**) { Tnake Methods }

constructor tnake.init;
begin
  repeat
    nx := random(gmx shl 4);
    ny := random(gmy-3) shl 4;
  until canwalk(nx,ny); pointage := 125;
  mapcolor := 99; id := true; explo := false;
  repeat
    ndx := random(11)-5;
  until ndx<>0;
  ndy := 0; overshow := false;
  flp := 0; trn := false;
  if ndx<0
    then nrx := -1
    else nrx := 1;
end;


function tnake.checkhit(hx,hy:integer):boolean;
begin
  if not explo and range(hx,hy,nx,ny,nx+12,ny+24)
    then
      begin
        explo := true; flp := 0;
        if player.vx<nx
          then nrx := -1
          else nrx := 1;
        checkhit := true;
        inc(player.score,pointage);
        printscore;
      end
    else checkhit := false;
end;


procedure tnake.drawitemobject;
begin
  with player do
    if range(nx,ny,vx-150,vy-80,vx+140,vy+80)
      then
        if explo
          then
            if ndx<0
              then
                if nrx<0
                  then fbitdraw(153+(nx-vx),72+(ny-vy),nakes[100+flp]^)
                  else fbitdraw(153+(nx-vx),72+(ny-vy),nakes[83+flp]^)
              else
                if nrx<0
                  then fbitdraw(153+(nx-vx),72+(ny-vy),nakes[66+flp]^)
                  else fbitdraw(153+(nx-vx),72+(ny-vy),nakes[49+flp]^)
          else
            if trn
              then fbitdraw(153+(nx-vx),72+(ny-vy),nakes[flp+32]^)
              else
                if ndx<0
                  then fbitdraw(153+(nx-vx),72+(ny-vy),nakes[flp+16]^)
                  else fbitdraw(153+(nx-vx),72+(ny-vy),nakes[flp]^);
end;


procedure tnake.checkplayertouch;
begin
  with player do
    if not boolean(safe) and not blown and range(vx+9,vy+14,nx,ny,nx+24,ny+30)
      then
        begin
          vdx := ndx; vdy := ndy;
          if nrx=drx
            then
              begin
                drx := -drx;
                if drx<0
                  then flip := 15
                  else flip := 0;
                turn := true;
              end;
          if lvls[0]>0
            then dec(lvls[0],1);
          if lvls[0]=0
            then
              begin
                blown := true;
                flip := 0;
              end;
        end;
end;


procedure tnake.calcitemobject;
var
  ox,oy : integer;
begin
  ox := nx; oy := ny;
  if not explo
    then
      begin
        inc(nx,ndx);
        inc(ny,ndy);
      end;
  if nx<16
    then nx := (gmx-2) shl 4
    else
      if nx>(gmx-2)shl 4
        then nx := 16;
  if not canwalk(nx,ny)
    then
      begin
        nx := ox; ndx := -ndx;
        trn := true;
        nrx := -nrx;
        if nrx<0
          then flp := 15
          else flp := 0;
      end;
  if not explo
    then checkplayertouch;
  if explo
    then
      begin
        inc(flp);
        if flp=15
          then add2kill_list(kill,powner)
      end
    else
     if trn
       then
         if nrx>0
           then
             begin
               inc(flp);
               if flp=15
                 then trn := false;
             end
           else
             begin
               dec(flp);
               if flp=0
                 then trn := false;
             end
       else flp := (flp+1) mod 16;
end;

(**) { Tsimm methods }

constructor tsimm.init;
begin
  repeat
    nx := random(gmx shl 4);
    ny := random(gmy-3) shl 4;
  until canwalk(nx,ny); pointage := 275;
  mapcolor := 0; id := true; explo := false;
  ndx := 5;
  nrx := 1;
  if random<0.4
    then
      begin
        ndx := -5;
        nrx := -1;
      end;
  ndy := 0; overshow := false;
  flp := 0; trn := false;
end;


procedure tsimm.drawitemobject;
begin
  with player do
    if range(nx,ny,vx-150,vy-80,vx+140,vy+80)
      then
        if explo
          then
            begin
            end
          else
            if trn
              then fbitdraw(153+(nx-vx),77+(ny-vy),simmers[flp]^)
              else
                if ndx<0
                  then fbitdraw(153+(nx-vx),77+(ny-vy),simmers[0]^)
                  else fbitdraw(153+(nx-vx),77+(ny-vy),simmers[15]^);
end;


procedure tsimm.checkplayertouch;
begin
  with player do
    if not boolean(safe) and not blown and range(vx+9,vy+14,nx,ny,nx+24,ny+30)
      then
        begin
          vdx := ndx; vdy := ndy;
          if nrx=drx
            then
              begin
                drx := -drx;
                if drx<0
                  then flip := 15
                  else flip := 0;
                turn := true;
              end;
          if lvls[0]>0
            then dec(lvls[0],1);
          if lvls[0]=0
            then
              begin
                blown := true;
                flip := 0;
              end;
        end;
end;

(**) { TMyCycle methods }

procedure TMyCycle.cycle_move;
begin
  if player.vdx<0
    then cyclex := (cyclex+319-(abs(player.vdx) shr 1))mod 320
    else
      if player.vdx>0
        then cyclex := (cyclex+(player.vdx shr 1))mod 320;
end;

(**) { TMyMorph methods }

function TMyMorph.geomap(x,y:integer):integer;
begin
  geomap := map[y,x];
end;


procedure TMyMorph.placegeo(x,y,geonum:integer;var geos);
begin
  if geonum in [1..geo_count]
    then fbitdraw(x,y,gpic[geonum-1]^);
end;


procedure TMyMorph.pre_map;
begin
  strobe;
  setpageActive(2);
  MyCycle^.docycle(3,2,2);
  drawitems(false);
  drawperson;
end;


procedure TMyMorph.post_map;
begin
  drawitems(true);
end;


begin
  setup;
  setparms;
  printscore;
  getkey;
end.