Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/GAMETP20.ZIP/RSAMPLE.PAS

Pascal/Delphi Source File | 1992-11-07 | 33.6 KB | 1,370 lines

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

{ RSQUID ver 1.5 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
           DSOUND.TPU
           JOYSTICK.TPU
           LIMEMS.TPU
           FLICS.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  }
{                                                                  }
{  If you have any questions about the code, or help explain, send }
{ me e-mail at:                                                    }
{        [e-mail]                                  }
{                                                                  }
{ Changes from 1.0:                                                }
{    Uses GameTP20 units.                                          }
{    ■ Allows use with joysticks                                   }
{    ■ Uses Sound Blaster compatible cards. In this example the    }
{       sounds are stored in EMS because of the sprites.  If you   }
{       have more than 600k of free space, you can probably store  }
{       it in the heap space.  Change the line in the SETUP        }
{       procedure:                                                 }
{         sounds[d] := new(PEMSsound,init(path+sndname[d]));       }
{       to:                                                        }
{         sounds[d] := new(Psound,init(path+sndname[d]));          }
{    ■ Plays the actual FLS (FLI with sound) introduction          }
{    ■ Shots bounce off girls. (No harm to them!)  ;>              }
{    ■ Detail level 'D' shows fast mode.  No paralax scroll. No    }
{       transparent maps. ( Can make it even faster )              }
{       note: You can use a different GEO file for not transparent.}
{         i.e. look at the walk platforms. (The look bad where the }
{              black is showing.  Create a similar GEO that is a   }
{              complete filled box as a walk platform              }
{    ■ Uses GMP files from GEOMAKER.                               }
{        see procedure loadGMP                                     }
{    ■ The TCycle modifications allows for background to scroll    }
{       up and down.                                               }

Uses Crt,VgaKern,MiscFunc,KeyBoard,Imaging,Gmorph,Beffects,OopObjs,Flics,Dsound,Joystick;

type
  soundtype = (shoot,explode,fried,girl_hit);

const
  sndname : array[soundtype] of string =
            ('ghit.voc','expl.voc','fried.voc','ric1.voc');
  path    = '';
  gmx     = 100;
  gmy     = 50;
  smx     = gmx shl 4-1;
  smy     = gmy shl 4-1;
  joydo   : byte = 0;
  speed   : boolean = true;
  speedw  : boolean = false;
  firew   : boolean = false;
  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;var item:pobjs):boolean;virtual;
          end;
  pgirl = ^tgirl;
  tgirl = object(tshot)
            goup,godown : boolean;
            constructor init;
            procedure calcitemobject; virtual;
            function checkhit(hx,hy:integer;var item:pobjs):boolean;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;var item:pobjs):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;
  ip            : array[1..9] of boolean;
  sounds        : array[soundtype] of PEMSsound;
  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;
  jcx,jcy,
  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;
var
  d : soundtype;
begin
  for d := shoot to girl_hit do
    dispose(sounds[d],done);
  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 boolean(mapcolor)
          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
  fsetcolors(zdc);
  loadpcx(path+'rsqud.pcx');
  fadein(200,zdc,rgb256);
  leavelast := true;
  fli_play(path+'rsqud.fls',8,1,false);
end;


procedure searchjoystick;
begin
  if not joythere
    then exit;
  if joy1there
    then joydo := 1
    else joydo := 2;
  writeln;
  write('Use Joystick? (Y/N)');
  repeat until ch in ['Y','N'];
  if ch='N'
    then
      begin
        joydo := 0;
        exit;
      end;
  writeln;
  writeln('Move joystick ',joydo,' to bottom-right and press button 1');
  repeat
    setstick(joydo);
  until button1[joydo];
  jcx := stickx[joydo];
  jcy := sticky[joydo];
  writeln('Move joystick ',joydo,' to top-left position and press button 2');
  repeat
    setstick(joydo);
  until button2[joydo];
  jcx := (jcx-stickx[joydo])div 3;
  jcy := (jcy-sticky[joydo])div 3;
  if jcx=0                        { Avoid Divison by zero error }
    then jcx := 1;
  if jcy=0
    then jcy := 1;
end;


procedure loadGMP(f:string);
var
  mapsize,
  spx,spy : word;  { Geo sprite width,height }
  wpx,wpy : word;  { Map Size }
  fil     : file;
begin
  assign(fil,f);
  reset(fil,1);
  blockread(fil,spx,sizeof(word)); blockread(fil,spy,sizeof(word));
  blockread(fil,wpx,sizeof(word)); blockread(fil,wpy,sizeof(word));
  mapsize := wpx*wpy;
  blockread(fil,map,mapsize);
  geo_count := 0;
  while not eof(fil) do  { load VSP sprites at end of file }
    begin
      getmem(gpic[geo_count],buffsize(spx,spy));
      blockread(fil,gpic[geo_count]^,buffsize(spx,spy));
      inc(geo_count);
    end;
  close(fil);
end;


procedure setup;
var
  d   : soundtype;
begin
  clrscr;
  writeln('Scott D. Ramsay presents:');
  writeln;
  writeln('R-SQUID v1.5 (unfinished, always will be)');
  writeln;
  writeln('This is a quick-and-dirty example of various effects PC''s can do.');
  writeln(' This "puppy", is going to be slow on lower-end PC''s because I''m');
  writeln('pushing the computer to the limits.  Transparent tile maps and wavering');
  writeln('backgrounds will slow things down. You''ll need at least 600k of');
  writeln('free ram.  VGA display, and EMS memory for sound (For sound you also');
  writeln('need a Sound Blaster compatible card).  A 16mhz machine or faster is');
  writeln('recommended. (16mhz might be too slow for your liking)');
  writeln(' Use the "D" key during play to remove details for faster play.');
  writeln;
  write('Press a key.');
  clearbuffer;
  repeat until ch<>#1;
  clearbuffer;
  clrscr;
  writeln;
  writeln('Controls :');
  writeln(' Joystick       -   (If available) Move Dude');
  writeln('   button 1     -   Fire shots');
  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('   D            -   Toggle detail level, (fast/slow)');
  writeln('   P            -   Pause screen');
  writeln('   A            -   Add a nake');
  writeln('   S            -   Add a simmer');
  writeln('  -/+           -   Adjust brightness');
  writeln('  ESC           -   Quit');
  writeln;
  write('Press a key.');
  clearbuffer;
  repeat until ch<>#1;
  clearbuffer;
  if not ScardSetup(0,0)
    then writeln('Sound card not found');
  searchjoystick;
  openmode(3); randomize;
  titlepage;
  oldexit := exitproc; exitproc := @cleanup;
  loadvsp(path+'drols.vsp',drols);
  loadvsp(path+'girls.vsp',girls);
  loadvsp(path+'nakes.vsp',nakes);
  loadvsp(path+'simmers.vsp',simmers);
  loadvsp(path+'rsmisc.vsp',rsmisc);
  loadGMP(path+'rsquid.gmp');
  loadvsp(path+'dr2.vsp',nummo);
  loadcolors(path+'rsquid.pal',dac,255);
  for d := shoot to girl_hit do
    sounds[d] := new(PEMSsound,init(path+sndname[d]));
  fadeout(50,zdc,rgb256);
  setpageactive(3);
  loadpcx(path+'fire.pcx');
  setpageactive(1);
  loadpcx(path+'dash.pcx');
  fadein(60,zdc,dac);
end;


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


procedure setparms;
var
  d : integer;
  p : plist;
begin
  MyCycle := new(PMyCycle,init(34,22));
  MyCycle^.cyc_x := 13; MyCycle^.cyc_y := 20;
  MyCycle^.from_x:= 0; MyCycle^.from_y:= 20;
  MyCycle^.cyc_height := 128; MyCycle^.cyc_width := 320;
  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;
  for d := 1 to 10 do
    addnake;
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 := boolean(d);
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 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;
  if ScardHere
    then Scard_pause;
  repeat dit; until ch<>'P';
  repeat dit; until (ch='P') and not funct;
  repeat dit; until ch<>'P';
  if ScardHere
    then Scard_resume;
  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='D') and not speedw
    then
      begin
        speed := not speed;
        speedw := true;
      end
    else
      if (ch<>'D') and speedw
        then speedw := false;
  case ch of
    'A' : addnake;
    'S' : addsimmers;
  end;
end;


function sgn(h:integer):integer;
begin
  if h<0
    then sgn := -1
    else
      if h>0
        then sgn := 1
        else sgn := 0;
end;


procedure setIPkeys;
const
  jl : array[1..9,0..1] of shortint =
       ((-1,1),(0,1),(1,1),(-1,0),(0,0),
        (1,0),(-1,-1),(0,-1),(1,-1));
var
  d,jx,jy : integer;
begin
  fillchar(ip,sizeof(ip),false);
  firew := false;
  if space
    then firew := true;
  for d := 1 to 9 do
    if np[d,2]
      then ip[d] := true;
  if boolean(joydo)
    then
      begin
        setstick(joydo);
        jx := stickx[joydo] div jcx-1;
        jy := sticky[joydo] div jcy-1;
        for d := 1 to 9 do
          if (jx=jl[d,0]) and (jy=jl[d,1])
            then ip[d] := true;
        if button1[joydo]
          then firew := true;
      end;
end;


procedure getkey;
var
  up,ovx,ovy : integer;
  detwait    : boolean;
begin
  with player do
    begin
      clearbuffer; up := 0; detwait := false;
      repeat
        setIPkeys;
        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 ip[7] or ip[4] or ip[1]
                        then
                          begin
                            drx := 1; safe := 0;
                            turn := true;
                          end
                        else
                      if ip[9] or ip[6] or ip[3]
                        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 ip[7] or ip[4] or ip[1]
                            then flip := (flip+1)mod 16;
                          if ip[9] or ip[6] or ip[3]
                            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 ip[9] or ip[6] or ip[3]
                            then flip := (flip+1)mod 16;
                          if ip[7] or ip[4] or ip[1]
                            then
                              begin
                                flip := 0; vdx :=0;
                                drx := 1; turn := true;
                              end;
                        end;
              end;
              ovy := vy; ovx := vx;
              if (ip[7] or ip[8] or ip[9]) and elevat(vx,vy)
                then
                  begin
                    dec(vy);
                    up := -1;
                    vx := (vx+8) shr 4 shl 4;
                  end
                else
                  if (ip[1] or ip[2] or ip[3]) and elevat(vx,vy+1)
                    then
                      begin
                        inc(vy);
                        vx := (vx+8) shr 4 shl 4;
                        up := 1;
                      end;
              if (vx>0) and (ip[7] or ip[4] or ip[1])
                then dec(vdx,1)
                else
                  if (vx<smx) and (ip[9] or ip[6] or ip[3])
                    then inc(vdx,1)
                    else zero(vdx);
              if firew and boolean(drx) and (lvls[2]>0)
                then
                  begin
                    sounds[shoot]^.play;
                    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 (ip[7] or ip[8] or ip[9])
                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;item:pobjs) : 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,item);
      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,@self)
        then add2kill_list(kill,powner);
end;


function tshot.checkhit(hx,hy:integer;var item:pobjs):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 boolean(ndx);
  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 := true; 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;


function tgirl.checkhit(hx,hy:integer;var item:pobjs):boolean;
begin
  if range(hx,hy,nx,ny,nx+12,ny+24)
    then
      begin
        sounds[girl_hit]^.play;
        pshot(item)^.ndx := -pshot(item)^.ndx;
        pshot(item)^.ndy := random(15)-7;
      end;
  checkhit := false;
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 boolean(ndx)
            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-60,vx+140,vy+60)
      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 boolean(ndx);
  ndy := 0; overshow := false;
  flp := 0; trn := false;
  if ndx<0
    then nrx := -1
    else nrx := 1;
end;


function tnake.checkhit(hx,hy:integer;var item:pobjs):boolean;
begin
  if not explo and range(hx,hy,nx,ny,nx+12,ny+24)
    then
      begin
        sounds[explode]^.play;
        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-60,vx+140,vy+60)
      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;
                sounds[fried]^.play;
                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-60,vx+140,vy+60)
      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;
                sounds[fried]^.play;
                flip := 0;
              end;
        end;
end;

(**) { TMyCycle methods }

procedure TMyCycle.cycle_move;
begin
  cyclex := player.vx div 6;
  cycley := (player.vy div 6) mod cyc_height;
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
      begin
        if speed
          then fbitdraw(x,y,gpic[geonum-1]^)
          else fastwput(x,y,gpic[geonum-1]^);
      end;
end;


procedure TMyMorph.pre_map;
begin
  strobe;
  setpageActive(2);
  if speed
    then
      begin
        MyCycle^.docycle(3,2,2);
        drawitems(false);
        drawperson;
      end
    else fastwmatte(13,20,172+128,179-32,pages[3]^,pages[2]^);
end;


procedure TMyMorph.post_map;
begin
  if not speed
    then
      begin
        drawitems(false);
        drawperson;
      end;
  drawitems(true);
end;


begin
  setup;
  setparms;
  printscore;
  getkey;
end.