{
Ice Queen - Main program
Copyright (C) 2001 Angelo Bertolli
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
Angelo Bertolli
<abertoll@hotmail.com>
}
program IceQueen;
uses crt, graph, graphio;
const
version = 'v2.1';
{--------------------------------------------------------------------------}
function D(dnum:integer):integer; begin d:=random(dnum)+1; end;
{The value of d(dnum) is returned as a random number between 1 and dnum.}
{--------------------------------------------------------------------------}
function DROLL(diceroll:dicerecord):integer;
{Returns the value of dice rolled based on dicerecord format (#d#+#).}
var
sum : integer;
loop : integer;
begin
sum:=0;
for loop:=1 to diceroll.rollnum do
sum:=sum + (d(diceroll.dicetype));
sum:=sum + diceroll.bonus;
if (sum<0) then
sum:=0;
droll:=sum;
end;
{---------------------------------------------------------------------------}
procedure drawmaptile(xpos,ypos:integer;themap:matrix);
var
xpix : integer;
ypix : integer;
tilenum : integer;
filename : stringtype;
begin
xpix:=41;
ypix:=41;
xpix:=xpix + ((xpos - 1) * 20); {tile size = 20}
ypix:=ypix + ((ypos - 1) * 20);
tilenum:=themap[xpos,ypos];
case tilenum of
1:filename:='town.ln1';
2:filename:='cave.ln1';
3:filename:='grass.ln1';
4:filename:='hill.ln1';
5:filename:='mountain.ln1';
6:filename:='road.ln1';
7:filename:='swamp.ln1';
8:filename:='desert.ln1';
9:filename:='whitemt.ln1';
10:filename:='castle.ln1';
11:filename:='snow.ln1';
12:filename:='inn.ln1';
13:filename:='ground.ln1';
14:filename:='dgt.ln1';
15:filename:='dww.ln1';
16:filename:='dnw.ln1';
17:filename:='dew.ln1';
18:filename:='dsw.ln1';
19:filename:='dnwc.ln1';
20:filename:='dnsw.ln1';
21:filename:='dsec.ln1';
22:filename:='dnec.ln1';
23:filename:='dswc.ln1';
24:filename:='deww.ln1';
25:filename:='dna.ln1';
26:filename:='dea.ln1';
27:filename:='dwa.ln1';
28:filename:='dsa.ln1';
29:filename:='blank.ln1';
else
filename:='blank.ln1';
end;
drawpicturebyline(xpix,ypix,filename);
end;
{---------------------------------------------------------------------------}
procedure drawitem(xpos,ypos:integer;theitem:item);
var
filename : stringtype;
begin
case theitem of
sword:filename:='sword.ln1';
shield:filename:='shield.ln1';
axe:filename:='axe.ln1';
bluepotion:filename:='potion1.ln1';
redpotion:filename:='potion2.ln1';
greenpotion:filename:='potion3.ln1';
chainmail:filename:='chain.ln1';
platemail:filename:='plate.ln1';
dagger:filename:='dagger.ln1';
club:filename:='club.ln1';
staff:filename:='staff.ln1';
hammer:filename:='hammer.ln1';
magicsword:filename:='magicswd.ln1';
magicshield:filename:='magicshl.ln1';
flamewand:filename:='flamewnd.ln1';
else
filename:='blank.ln1';
end;{case}
drawpicturebyline(xpos,ypos,filename);
end;
{Title and Main Menu Functions and Procedures}
{--------------------------------------------------------------------------}
procedure titlescreen;
{Ice Queen title screen}
begin
settextstyle(gothic,horizontal,6);
setcolor(blue);
outtextxy(143,383,'The Ice Queen');
setcolor(white);
outtextxy(140,380,'The Ice Queen');
settextstyle(default,horizontal,2);
drawpicturebyline(120,10,'tcastle.ln1');
settextstyle(default,horizontal,1);
setcolor(lightgray);
prompt;
end;
{---------------------------------------------------------------------------}
procedure introduction;
{Write the introduction to the screen.}
begin
cleardevice;
homecursor(x,y);
settextstyle(sanseri,horizontal,2);
setcolor(lightblue);
writefile(y,'001.txt');
prompt;
end;
{---------------------------------------------------------------------------}
procedure credits;
{Write the credits to the screen.}
begin
cleardevice;
settextstyle(sanseri,horizontal,2);
drawpicturebyline(80,60,'credits.ln1');
setcolor(white);
prompt;
{
cleardevice;
setcolor(white);
homecursor(x,y);
writefile(y,'003.txt');
prompt;
}
end;
{---------------------------------------------------------------------------}
procedure menuscreen;
{Header for the main menu.}
begin
cleardevice;
homecursor(x,y);
settextstyle(triplex,horizontal,5);
setcolor(lightgray);
graphwriteln(x,y,' The Ice Queen');
graphwriteln(x,y,'');
settextstyle(default,horizontal,1);
setcolor(lightmagenta);
graphwriteln(x,y,' Welcome');
graphwriteln(x,y,' Please make your selection.');
settextstyle(default,horizontal,3);
drawpicturebyline(60,225,cfg.leftpic);
drawpicturebyline(460,240,cfg.rightpic);
end;
{---------------------------------------------------------------------------}
procedure startgame(var player:playerrecord);
{Starts you off by creating a character.}
var
tempstring : stringtype;
begin
settextstyle(default,horizontal,2);
repeat
cleardevice;
homecursor(x,y);
setcolor(blue);
graphwriteln(x,y,' CREATE YOUR CHARACTER');
graphwriteln(x,y,'');
setcolor(white);
with player do
begin
graphwrite(x,y,'Enter name: ');
graphread(x,y,tempstring);
name:=tempstring;
if (name='') then
begin
graphwrite(x,y,'Landon');
name:='Landon';
end;
graphwriteln(x,y,'');
graphwriteln(x,y,'');
graphwrite(x,y,'Sex (M/F) ');
repeat
sex:=readarrowkey;
until (sex in ['m','M','f','F']);
outtextxy(x,y,sex);
if (sex in ['m','M']) then
drawpicturebyline(x+200,y,'mplayer.ln1')
else
drawpicturebyline(x+200,y,'fplayer.ln1');
setcolor(white);
level:=1;
experience:=0;
endurancemax:=8;
strength:=d(6)+d(6)+d(6);
dexterity:=d(6)+d(6)+d(6);
coins:=(d(6)+d(6)+d(6)) * 10;
graphwriteln(x,y,'');
graphwriteln(x,y,'');
str(endurancemax,tempstring);
if(endurancemax>=10)then
tempstring:=' ' + tempstring
else
tempstring:=' ' + tempstring;
tempstring:=' Endurance:' + tempstring;
graphwriteln(x,y,tempstring);
endurance:=endurancemax;
graphwriteln(x,y,'');
str(strength,tempstring);
if(strength>=10)then
tempstring:=' ' + tempstring
else
tempstring:=' ' + tempstring;
tempstring:=' Strength:' + tempstring;
graphwriteln(x,y,tempstring);
str(dexterity,tempstring);
if(dexterity>=10)then
tempstring:=' ' + tempstring
else
tempstring:=' ' + tempstring;
tempstring:=' Dexterity:' + tempstring;
graphwriteln(x,y,tempstring);
graphwriteln(x,y,'');
str(coins,tempstring);
tempstring:=' Coins: ' + tempstring;
graphwriteln(x,y,tempstring);
if (sex in ['m','M']) then
picfile:='mplayer.ln1'
else
picfile:='fplayer.ln1';
numitems:=0;
numspells:=0;
stages:=[];
charges:=0;
chargemax:=0;
end;
graphwriteln(x,y,'');
graphwriteln(x,y,'');
graphwriteln(x,y,'');
graphwriteln(x,y,' Keep this character (Y/N)');
repeat
ans:=readarrowkey;
until(ans in ['y','Y','n','N']);
until (ans in ['y','Y']);
end;
{---------------------------------------------------------------------------}
procedure loadgame(var player:playerrecord);
var
dosname : stringtype;
done : boolean;
pasfile : file of playerrecord;
begin
done:=false;
repeat
cleardevice;
homecursor(x,y);
setcolor(lightgray);
settextstyle(sanseri,horizontal,3);
graphwriteln(x,y,'[default: '+cfg.savegame+']');
graphwriteln(x,y,'');
settextstyle(sanseri,horizontal,4);
graphwrite(x,y,'Enter File Name: ');
setcolor(lightblue);
graphread(x,y,dosname);
if (dosname='') then
dosname:=cfg.savegame;
settextstyle(sanseri,horizontal,5);
graphwriteln(x,y,'');
graphwriteln(x,y,'');
setcolor(lightgray);
if exist(dosname) then
begin
graphwriteln(x,y,'Loading...');
assign(pasfile,dosname);
reset(pasfile);
read(pasfile,player);
close(pasfile);
done:=true;
end
else
begin
setcolor(red);
graphwriteln(x,y,' Sorry, file does not exist.');
settextstyle(sanseri,horizontal,3);
setcolor(lightgray);
x:=10;
y:=300;
graphwriteln(x,y,' (L)oad or (S)tart');
repeat
ans:=readarrowkey;
until (ans in ['l','L','s','S']);
if (ans in ['s','S']) then
begin
startgame(player);
done:=true;
end;
end;
until done;
end;
{---------------------------------------------------------------------------}
procedure mainmenu;
begin
repeat
menuscreen;
ans:='C';
repeat
settextstyle(small,horizontal,10);
setcolor(lightblue);
outtextxy(160,150,'Introduction');
outtextxy(220,200,'Credits');
outtextxy(240,250,'Start');
outtextxy(250,300,'Load');
outtextxy(250,350,'Quit');
setcolor(white);
case ans of
'I':outtextxy(160,150,'Introduction');
'C':outtextxy(220,200,'Credits');
'S':outtextxy(240,250,'Start');
'L':outtextxy(250,300,'Load');
'Q':outtextxy(250,350,'Quit');
end;
ch:=readarrowkey;
case ch of
'8':case ans of
'I':ans:='Q';
'C':ans:='I';
'S':ans:='C';
'L':ans:='S';
'Q':ans:='L';
end;
'2':case ans of
'I':ans:='C';
'C':ans:='S';
'S':ans:='L';
'L':ans:='Q';
'Q':ans:='I';
end;
end;
if (ch=#13) and (ans in ['I','C']) then
begin
case ans of
'I':introduction;
'C':credits;
end;
menuscreen;
end;
if (ch in ['i','I','C','c'])then
begin
case ch of
'I','i':introduction;
'C','c':credits;
end;
menuscreen;
end;
until ((ch=#13) and (ans in ['S','L','Q'])) or
(ch in ['s','S','l','L','q','Q']);
if (ch in ['s','S','l','L','q','Q']) then
ans:=ch;
case ans of
'S','s':begin
startgame(player);
exit;
end;
'L','l':begin
loadgame(player);
exit;
end;
'Q','q':begin
closegraph;
halt;
end;
end;
until FALSE;
end;
{Functions that return the names of items and spells given the enum type.}
{---------------------------------------------------------------------------}
function itemstring(theitem:item):stringtype;
begin
case theitem of
sword :itemstring:='sword';
shield :itemstring:='shield';
axe :itemstring:='axe';
bluepotion :itemstring:='blue potion';
redpotion :itemstring:='red potion';
greenpotion :itemstring:='green potion';
chainmail :itemstring:='chain mail';
platemail :itemstring:='plate mail';
dagger :itemstring:='dagger';
club :itemstring:='club';
staff :itemstring:='staff';
hammer :itemstring:='hammer';
magicsword :itemstring:='magic sword';
magicshield :itemstring:='magic shield';
flamewand :itemstring:='flame wand';
end;{case}
end;
{---------------------------------------------------------------------------}
function spellstring(thespell:spell):stringtype;
begin
case thespell of
icestorm :spellstring:='ice storm';
fireblast :spellstring:='fire blast';
web :spellstring:='web';
callwild :spellstring:='call wild';
heal :spellstring:='heal';
courage :spellstring:='courage';
freeze :spellstring:='freeze';
obliterate :spellstring:='obliterate';
icicle :spellstring:='icicle';
power :spellstring:='power';
shatter :spellstring:='shatter';
glacier :spellstring:='glacier';
dragonbreath :spellstring:='dragon breath';
resistfire :spellstring:='resist fire';
resistcold :spellstring:='resist cold';
end;{case}
end;
{Calc Stats, View Stats, and Drop Item Procedures}
{---------------------------------------------------------------------------}
procedure calcstats(var player:playerrecord);
{Calculates the player stats based on level, xp, etc. and returns it.}
type
itemset = set of item;
var
tempset : itemset;
tempinteger : integer;
count : integer;
begin
with player do
begin
if(level=1)and(experience>=2000)then
begin
level:=level + 1;
tempinteger:=d(8);
endurancemax:=endurancemax+tempinteger;
endurance:=endurance+tempinteger;
end;
if(level=2)and(experience>=4000)then
begin
level:=level + 1;
tempinteger:=d(8);
endurancemax:=endurancemax+tempinteger;
endurance:=endurance+tempinteger;
end;
if(level=3)and(experience>=8000)then
begin
level:=level + 1;
tempinteger:=d(8);
endurancemax:=endurancemax+tempinteger;
endurance:=endurance+tempinteger;
end;
if(level=4)and(experience>=16000)then
begin
level:=level + 1;
tempinteger:=d(8);
endurancemax:=endurancemax+tempinteger;
endurance:=endurance+tempinteger;
end;
if(level=5)and(experience>=32000)then
begin
level:=level + 1;
tempinteger:=d(8);
endurancemax:=endurancemax+tempinteger;
endurance:=endurance+tempinteger;
end;
if(level=6)and(experience>=64000)then
begin
level:=level + 1;
tempinteger:=d(8);
endurancemax:=endurancemax+tempinteger;
endurance:=endurance+tempinteger;
end;
if(level=7)and(experience>=120000)then
begin
level:=level + 1;
tempinteger:=d(8);
endurancemax:=endurancemax+tempinteger;
endurance:=endurance+tempinteger;
end;
if(level=8)and(experience>=240000)then
begin
level:=level + 1;
tempinteger:=d(8);
endurancemax:=endurancemax+tempinteger;
endurance:=endurance+tempinteger;
end;
if(level=9)and(experience>=360000)then
begin
level:=level + 1;
tempinteger:=d(8);
endurancemax:=endurancemax+tempinteger;
endurance:=endurance+tempinteger;
end;
if(level=10)and(experience>=480000)then
begin
level:=level + 1;
tempinteger:=d(8);
endurancemax:=endurancemax+tempinteger;
endurance:=endurance+tempinteger;
end;
if(level=11)and(experience>=600000)then
begin
level:=level + 1;
tempinteger:=d(8);
endurancemax:=endurancemax+tempinteger;
endurance:=endurance+tempinteger;
end;
case level of
1..3:savingthrow:=16;
4..6:savingthrow:=14;
7..9:savingthrow:=12;
else
savingthrow:=10;
end;{case}
case level of
1..3:thac0:=19;
4..6:thac0:=17;
7..9:thac0:=15;
else
thac0:=13;
end;{case}
case strength of
1:thac0:=thac0+5;
2:thac0:=thac0+4;
3:thac0:=thac0+3;
4..5:thac0:=thac0+2;
6..8:thac0:=thac0+1;
13..15:thac0:=thac0-1;
16..17:thac0:=thac0-2;
18:thac0:=thac0-3;
19:thac0:=thac0-4;
20:thac0:=thac0-5;
end;{case}
tempset:=[];
for count:=1 to numitems do
tempset:=tempset + [item[count]];
armorclass:=9;
if(magicshield in tempset)then
armorclass:=armorclass-4
else
if(shield in tempset)then
armorclass:=armorclass-1;
if(platemail in tempset)then
armorclass:=armorclass-6
else
if(chainmail in tempset)then
armorclass:=armorclass-4;
case dexterity of
1:armorclass:=armorclass+5;
2:armorclass:=armorclass+4;
3:armorclass:=armorclass+3;
4..5:armorclass:=armorclass+2;
6..8:armorclass:=armorclass+1;
13..15:armorclass:=armorclass-1;
16..17:armorclass:=armorclass-2;
18:armorclass:=armorclass-3;
19:armorclass:=armorclass-4;
20:armorclass:=armorclass-5;
end;{case}
damage.rollnum:=1;
damage.dicetype:=2;
damage.bonus:=0;
if (club in tempset)or(dagger in tempset) then
damage.dicetype:=4;
if (hammer in tempset)or(staff in tempset) then
damage.dicetype:=6;
if (axe in tempset)or(sword in tempset) then
damage.dicetype:=8;
if(magicsword in tempset)then
begin
damage.dicetype:=8;
damage.bonus:=3;
if not(flamewand in tempset)then
thac0:=thac0-3;
end;
if (flamewand in tempset) then
begin
damage.rollnum:=6;
damage.dicetype:=6;
damage.bonus:=0;
end;
if not(flamewand in tempset) then
case strength of
1:damage.bonus:=damage.bonus-5;
2:damage.bonus:=damage.bonus-4;
3:damage.bonus:=damage.bonus-3;
4..5:damage.bonus:=damage.bonus-2;
6..8:damage.bonus:=damage.bonus-1;
13..15:damage.bonus:=damage.bonus+1;
16..17:damage.bonus:=damage.bonus+2;
18:damage.bonus:=damage.bonus+3;
19:damage.bonus:=damage.bonus+4;
20:damage.bonus:=damage.bonus+5;
end;{case}
end;
end;
{---------------------------------------------------------------------------}
procedure dropitem(var player:playerrecord);
var
tempstring : stringtype;
tempinteger : integer;
tempcode : integer;
count : integer;
begin
cleardevice;
homecursor(x,y);
settextstyle(sanseri,horizontal,3);
with player do
if (numitems>0) then
begin
setcolor(lightblue);
graphwriteln(x,y,' ITEMS');
setcolor(white);
for count:=1 to numitems do
begin
str(count,tempstring);
tempstring:=tempstring + '. ' + itemstring(item[count]);
graphwriteln(x,y,tempstring);
end;
graphwriteln(x,y,'Drop which one?');
str(numitems,tempstring);
repeat
ans:=readarrowkey;
until (ans in ['1'..tempstring[1]]);
graphwriteln(x,y,'');
val(ans,tempinteger,tempcode);
tempstring:=itemstring(item[tempinteger]);
graphwrite(x,y,tempstring);
graphwriteln(x,y,' will be gone forever. Drop? (y/n)');
drawitem(280,(numitems+7)*textheight('M'),item[tempinteger]);
repeat
ans:=readarrowkey;
until(ans in ['y','Y','n','N']);
if (ans in ['y','Y']) then
begin
for count:=tempinteger to (numitems-1) do
item[count]:=item[count+1];
numitems:=numitems - 1;
end;
end;
end;
{---------------------------------------------------------------------------}
procedure graphwritelncol1(var x,y:integer;gstring:stringtype);
begin
x:=col1;
graphwriteln(x,y,gstring);
end;
{---------------------------------------------------------------------------}
procedure graphwritelncol2(var x,y:integer;gstring:stringtype);
begin
x:=col2;
graphwriteln(x,y,gstring);
end;
{---------------------------------------------------------------------------}
procedure graphwritelncol3(var x,y:integer;gstring:stringtype);
begin
x:=col3;
graphwriteln(x,y,gstring);
end;
{---------------------------------------------------------------------------}
procedure viewstats(var player:playerrecord);
var
tempstring : stringtype;
count : integer;
score : integer;
totalscore : integer;
stageloop : stage;
s2 : stringtype;
begin
repeat
cleardevice;
calcstats(player);
with player do
begin
drawpicturebyline(20,20,picfile);
settextstyle(triplex,horizontal,4);
setcolor(white);
x:=240;
y:=25;
graphwriteln(x,y,name);
graphwriteln(x,y,'');
settextstyle(sanseri,horizontal,2);
x:=200;
str(level,tempstring);
tempstring:='level: ' + tempstring;
graphwrite(x,y,tempstring);
graphwrite(x,y,' ');
if (sex in ['m','M']) then
graphwriteln(x,y,'male')
else
graphwriteln(x,y,'female');
y:=140;
graphwriteln(x,y,'');
setcolor(lightred);
str(endurance,tempstring);
tempstring:='Endurance: ' + tempstring;
graphwrite(x,y,tempstring);
str(endurancemax,tempstring);
tempstring:='/' + tempstring;
graphwriteln(x,y,tempstring);
graphwriteln(x,y,'');
setcolor(lightgray);
str(armorclass,tempstring);
tempstring:='Armor Class: ' + tempstring;
graphwritelncol1(x,y,tempstring);
str(thac0,tempstring);
tempstring:='To Hit Roll: ' + tempstring;
graphwritelncol1(x,y,tempstring);
str(strength,tempstring);
tempstring:='Strength: ' + tempstring;
graphwritelncol1(x,y,tempstring);
str(dexterity,tempstring);
tempstring:='Dexterity: ' + tempstring;
graphwritelncol1(x,y,tempstring);
str(savingthrow,tempstring);
tempstring:='Saving Throw: ' + tempstring;
graphwritelncol1(x,y,tempstring);
x:=col1;
graphwrite(x,y,'Damage: ');
str(damage.rollnum,tempstring);
tempstring:=tempstring + 'd';
graphwrite(x,y,tempstring);
str(damage.dicetype,tempstring);
graphwrite(x,y,tempstring);
str(damage.bonus,tempstring);
if (damage.bonus>0) then
begin
tempstring:='+' + tempstring;
graphwrite(x,y,tempstring);
end;
if (damage.bonus<0) then
graphwrite(x,y,tempstring);
str(experience,tempstring);
graphwriteln(x,y,'');
tempstring:='Experience: ' + tempstring;
graphwritelncol1(x,y,tempstring);
score:=0;
totalscore:=0;
for stageloop:=ring to endgame do
begin
totalscore:=totalscore+1;
if (stageloop in stages) then
score:=score+1;
end;
score:=(score*100) DIV totalscore;
str(score,tempstring);
tempstring:='Score: ' + tempstring + '%';
graphwritelncol1(x,y,tempstring);
graphwriteln(x,y,'');
setcolor(yellow);
str(coins,tempstring);
tempstring:='Coins: ' + tempstring;
graphwritelncol1(x,y,tempstring);
y:=140;
graphwriteln(x,y,'');
setcolor(lightblue);
for count:=1 to numitems do
begin
tempstring:=itemstring(item[count]);
graphwritelncol2(x,y,tempstring);
end;
y:=140;
graphwriteln(x,y,'');
setcolor(lightmagenta);
for count:=1 to numspells do
begin
tempstring:=spellstring(spell[count]);
graphwritelncol3(x,y,tempstring);
end;
if (ring in stages) then
begin
settextstyle(sanseri,horizontal,1);
graphwritelncol3(x,y,'');
str(charges,tempstring);
tempstring:='Ring Charges: ' + tempstring;
str(chargemax,s2);
tempstring:=tempstring + '/' + s2;
graphwritelncol3(x,y,tempstring);
end;
end;
setcolor(lightgreen);
settextstyle(triplex,horizontal,3);
y:=420;
x:=320 - (textwidth('(D)rop or (E)xit') DIV 2);
graphwriteln(x,y,'(D)rop or (E)xit');
repeat
ans:=readarrowkey;
until (ans in ['d','D','e','E']);
case ans of
'd','D':dropitem(player);
'e','E':exit;
end;{case}
until FALSE
end;
{---------------------------------------------------------------------------}
procedure died;
{The player dies. Halts the game.}
begin
cleardevice;
setcolor(darkgray);
settextstyle(gothic,horizontal,6);
outtextxy(1,80,' You have died...');
settextstyle(sanseri,horizontal,8);
repeat
setcolor(d(15));
outtextxy(1,240,' GAME OVER');
until keypressed;
ch:=readarrowkey;
closegraph;
halt;
end;
{Combat Functions and Procedures}
{---------------------------------------------------------------------------}
procedure rollmonsters(var monster:monsterlist;nummonsters:integer;
monsterfile:stringtype);
var
pasfile : file of monsterrecord;
count : integer;
tempmonster : monsterrecord;
begin
if not(exist(monsterfile)) then
exit;
assign(pasfile,monsterfile);
reset(pasfile);
read(pasfile,tempmonster);
close(pasfile);
for count:=1 to nummonsters do
begin
monster[count]:=tempmonster;
with monster[count] do
begin
endurancemax:=0;
for loop:=1 to hitdice do
endurancemax:=endurancemax + d(8);
if (hpbonus<0) and (endurancemax<(hpbonus*-1)) then
endurancemax:=1
else
endurancemax:=endurancemax + hpbonus;
if (endurancemax<=0) then
endurancemax:=1;
endurance:=endurancemax;
xpvalue:=(monster[count].xpvalue*xpmultiplier)
+ (endurance DIV 2);
coins:=droll(treasure);
end;
end;
end;
{---------------------------------------------------------------------------}
procedure combatmenuprompt;
begin
y:=450;
settextstyle(default,horizontal,1);
graphwriteln(x,y,' <press space>');
ch:=readarrowkey;
end;
{---------------------------------------------------------------------------}
procedure clearcombatmenu;
begin
setcolor(blue);
setfillstyle(solidfill,blue);
bar(40,300,200,460);
setcolor(lightblue);
rectangle(40,300,200,460);
setcolor(lightcyan);
end;
{---------------------------------------------------------------------------}
procedure combatstats(player:playerrecord);
var
tempstring : stringtype;
hitbar : word;
begin
setcolor(blue);
setfillstyle(solidfill,blue);
bar(420,300,600,460);
setcolor(lightblue);
rectangle(420,300,600,460);
setcolor(lightcyan);
calcstats(player);
x:=510 - (textwidth(player.name) DIV 2);
y:=300;
outtextxy(x,y,player.name);
graphwriteln(x,y,'');
x:=440;
str(player.level,tempstring);
tempstring:='Level: ' + tempstring;
graphwriteln(x,y,tempstring);
x:=440;
str(player.endurance,tempstring);
tempstring:='HP: ' + tempstring + '/';
graphwrite(x,y,tempstring);
str(player.endurancemax,tempstring);
graphwriteln(x,y,tempstring);
setcolor(lightgray);
line(438,366,541,366);
line(438,366,438,371);
setcolor(black);
line(439,367,541,367);
line(439,370,541,370);
line(439,367,439,370);
line(541,367,541,370);
hitbar:=(player.endurance*100) DIV player.endurancemax;
case hitbar of
0..20:setcolor(red);
21..50:setcolor(yellow);
else
setcolor(green);
end; {case}
line(440,368,440+hitbar,368);
line(440,369,440+hitbar,369);
setcolor(black);
line(441+hitbar,368,540,368);
line(441+hitbar,369,540,369);
setcolor(lightcyan);
x:=440;
y:=y+15;
str(player.armorclass,tempstring);
tempstring:='AC: ' + tempstring;
graphwriteln(x,y,tempstring);
x:=440;
str(player.thac0,tempstring);
tempstring:='THAC0: ' + tempstring;
graphwriteln(x,y,tempstring);
x:=440;
graphwrite(x,y,'Dmg: ');
str(player.damage.rollnum,tempstring);
tempstring:=tempstring + 'd';
graphwrite(x,y,tempstring);
str(player.damage.dicetype,tempstring);
graphwrite(x,y,tempstring);
if (player.damage.bonus<>0) then
begin
str(player.damage.bonus,tempstring);
if (player.damage.bonus>0) then
tempstring:='+' + tempstring;
graphwrite(x,y,tempstring);
end;
graphwriteln(x,y,'');
x:=440;
str(player.savingthrow,tempstring);
tempstring:='Save: ' + tempstring;
graphwriteln(x,y,tempstring);
end;
{---------------------------------------------------------------------------}
procedure combatscreen(player:playerrecord;nummonsters:integer;
monster:monsterlist);
var
row1width : integer;
row2width : integer;
tempstring : stringtype;
begin
cleardevice;
settextstyle(default,horizontal,1);
{draw the monsters & write names}
row1width:=(nummonsters * 120) + ((nummonsters - 1) * spacing);
if (row1width>(480 + (3 * spacing))) then
row1width:=480 + (3 * spacing);
row2width:=((nummonsters - 4) * 120) + ((nummonsters - 5) * spacing);
x:=(getmaxx DIV 2) - (row1width DIV 2);
y:=0;
if (nummonsters<=1) then
begin
drawpicturebyline(x,y,monster[nummonsters].picfile);
setcolor(lightgray);
tempstring:=monster[nummonsters].name;
outtextxy(x+60-(textwidth(tempstring) DIV 2),y+120,tempstring);
x:=x+120+spacing;
end;
if (nummonsters<=4)and(nummonsters>1) then
for loop:=1 to nummonsters do
begin
drawpicturebyline(x,y,monster[loop].picfile);
setcolor(lightgray);
str(loop,tempstring);
tempstring:=tempstring + '.' + monster[loop].name;
outtextxy(x+60-(textwidth(tempstring) DIV 2),y+120,tempstring);
x:=x+120+spacing;
end;
if (nummonsters>4) then
begin
for loop:=1 to 4 do
begin
drawpicturebyline(x,y,monster[loop].picfile);
setcolor(lightgray);
str(loop,tempstring);
tempstring:=tempstring + '.' + monster[loop].name;
outtextxy(x+60-(textwidth(tempstring) DIV 2),y+120,tempstring);
x:=x+120+spacing;
end;
x:=(getmaxx DIV 2) - (row2width DIV 2);
y:=120 + spacing;
for loop:=5 to nummonsters do
begin
drawpicturebyline(x,y,monster[loop].picfile);
setcolor(lightgray);
str(loop,tempstring);
tempstring:=tempstring + '.' + monster[loop].name;
outtextxy(x+60-(textwidth(tempstring) DIV 2),y+120,tempstring);
x:=x+120+spacing;
end;
end;
settextstyle(sanseri,horizontal,1);
clearcombatmenu; {Create the combat menu window on the left}
combatstats(player); {Create the combat stats window on the right}
x:=(640 DIV 2) - 60; {Draw the player in the center}
y:=340;
drawpicturebyline(x,y,player.picfile);
end;
{---------------------------------------------------------------------------}
procedure attackmonster(var player:playerrecord;var themonster:monsterrecord;
themonstereffect:effectrecord);
var
dmg : integer;
s : stringtype;
flame : boolean;
loop : integer;
ac : integer;
hitroll : integer;
begin
clearcombatmenu;
settextstyle(sanseri,horizontal,1);
y:=300;
graphwriteln(x,y,'');
ac:=themonster.armorclass;
if (themonstereffect.glacier) and (ac>4) then
ac:=4;
hitroll:=d(20);
if ((hitroll>=(player.thac0-ac))and(hitroll>1))or(hitroll=20) then
begin
graphwriteln(x,y,'');
graphwriteln(x,y,' You hit!');
graphwriteln(x,y,'');
dmg:=droll(player.damage);
if (dmg<1) then
dmg:=1;
flame:=false;
for loop:=1 to player.numitems do
if (player.item[loop]=flamewand) then
flame:=true;
if (flame) and (themonstereffect.resistfire) then
dmg:=(dmg DIV 2)+1;
str(dmg,s);
s:='('+s+')';
x:=120-(textwidth(s) DIV 2);
graphwriteln(x,y,s);
if (dmg>themonster.endurance) then
themonster.endurance:=0
else
themonster.endurance:=themonster.endurance-dmg;
if (themonster.endurance=0) then
begin
x:=120-(textwidth('KILLED') DIV 2);
graphwriteln(x,y,'KILLED');
end;
end
else
begin
graphwriteln(x,y,'');
graphwriteln(x,y,'');
graphwriteln(x,y,' You missed');
end;
end;
{---------------------------------------------------------------------------}
procedure remove(var numitems:byte;var item:itemarray;loc:integer);
var
count : integer;
begin
for count:=loc to (numitems-1) do
item[count]:=item[count+1];
numitems:=numitems-1;
end;
{---------------------------------------------------------------------------}
procedure combatuse(var player:playerrecord;itemnum:integer;
var playereffect:effectrecord);
begin
y:=360;
case player.item[itemnum] of
sword..axe:begin
graphwriteln(x,y,' Not usable.');
end;
chainmail..flamewand:begin
graphwriteln(x,y,' Not usable.');
end;
bluepotion:begin
if not(playereffect.blue) then
begin
graphwriteln(x,y,' You become faster');
graphwriteln(x,y,' and stronger.');
player.strength:=player.strength+d(4);
if (player.strength>20) then
player.strength:=20;
player.dexterity:=player.dexterity+d(4);
if (player.dexterity>20) then
player.dexterity:=20;
remove(player.numitems,player.item,itemnum);
playereffect.blue:=true;
end
else
begin
graphwriteln(x,y,' It has no effect.');
end;
end;
redpotion:begin
graphwriteln(x,y,' Healing soothes you.');
player.endurance:=player.endurance+d(6)+1;
if (player.endurance>player.endurancemax) then
player.endurance:=player.endurancemax;
remove(player.numitems,player.item,itemnum);
end;
greenpotion:begin
graphwriteln(x,y,' You feel POWER');
graphwriteln(x,y,' surging');
graphwriteln(x,y,' through your body!');
player.endurance:=player.endurancemax;
player.strength:=20;
player.dexterity:=20;
remove(player.numitems,player.item,itemnum);
end;
end;
end;
{---------------------------------------------------------------------------}
procedure combatcast(var player:playerrecord;spellnum:integer;
var nummonsters:integer;var monster:monsterlist;
var playereffect:effectrecord;var monstereffect:effectlist);
var
damagetype : stringtype;
dmgroll : dicerecord;
originaldmg : integer;
dmg : integer;
count : integer;
tempstring : stringtype;
tempint : integer;
errcode : integer;
thespell : spell;
powerroll : integer;
monsterchart : chartrecord;
pasfile : file of chartrecord;
theroll : integer;
val1 : integer;
val2 : integer;
monsterfile : stringtype;
newmonster : monsterlist;
numnewmonster : integer;
saveroll : integer;
begin
thespell:=player.spell[spellnum];
damagetype:='';
y:=360;
case thespell of
icestorm:begin
damagetype:='cold';
dmgroll.rollnum:=player.level;
if (dmgroll.rollnum>20) then
dmgroll.rollnum:=20;
dmgroll.dicetype:=6;
dmgroll.bonus:=0;
dmg:=droll(dmgroll);
end;
fireblast:begin
damagetype:='fire';
dmgroll.rollnum:=(((player.level-1) DIV 5)*2)+1;
dmgroll.dicetype:=6;
dmgroll.bonus:=dmgroll.rollnum;
dmg:=droll(dmgroll);
end;
web,freeze:begin
graphwriteln(x,y,' You make your foes');
graphwriteln(x,y,' easier to hit.');
for loop:=1 to nummonsters do
begin
monster[loop].armorclass:=monster[loop].armorclass+2;
if (monster[loop].armorclass>9) then
monster[loop].armorclass:=9;
end;
end;
callwild,shatter:begin
graphwriteln(x,y,' Not a battle spell');
end;
heal:begin
graphwriteln(x,y,' Healing soothes you.');
player.endurance:=player.endurance+d(6)+1;
if (player.endurance>player.endurancemax) then
player.endurance:=player.endurancemax;
settextstyle(sanseri,horizontal,1);
combatstats(player);
settextstyle(default,horizontal,1);
end;
courage:begin
if not(playereffect.courage) then
begin
graphwriteln(x,y,' You become braver.');
player.strength:=player.strength+d(4)+1;
if (player.strength>20) then
player.strength:=20;
player.dexterity:=player.dexterity+d(4)+1;
if (player.dexterity>20) then
player.dexterity:=20;
end
else
graphwriteln(x,y,' It has no effect.');
playereffect.courage:=true;
end;
obliterate:begin
y:=320;
graphwriteln(x,y,' Select a target:');
graphwriteln(x,y,'');
for count:=1 to nummonsters do
begin
str(count,tempstring);
ch:=tempstring[1];
tempstring:=' ';
tempstring:=tempstring + ch + ') ';
tempstring:=tempstring + monster[count].name;
graphwriteln(x,y,tempstring);
end;
repeat
ans:=readarrowkey;
until (ans in ['1'..ch]);
val(ans,tempint,errcode);
clearcombatmenu;
y:=360;
graphwrite(x,y,' You ');
setcolor(magenta);
graphwrite(x,y,'OBLITERATE');
setcolor(lightcyan);
graphwriteln(x,y,' the');
x:=120-(textwidth(monster[tempint].name) DIV 2);
graphwriteln(x,y,monster[tempint].name);
monster[tempint].endurance:=0;
end;
icicle:begin
damagetype:='cold';
dmgroll.rollnum:=(((player.level-1) DIV 5)*2)+1;
dmgroll.dicetype:=6;
dmgroll.bonus:=dmgroll.rollnum;
dmg:=droll(dmgroll);
end;
power:begin
powerroll:=d(20);
case powerroll of
1..4:begin
graphwriteln(x,y,' You don''t think');
graphwriteln(x,y,' anything happened.');
end;
5:begin
graphwriteln(x,y,' Roland appears');
graphwriteln(x,y,' and punches you!');
dmg:=d(4);
if (player.endurance<dmg) then
player.endurance:=0
else
player.endurance:=player.endurance-dmg;
end;
6..7:begin
graphwriteln(x,y,' You levitate for');
graphwriteln(x,y,' a moment.');
end;
8..9:begin
graphwriteln(x,y,' You hear jesters');
graphwriteln(x,y,' laughing at you.');
end;
10..11:begin
graphwriteln(x,y,' Thousands of');
graphwriteln(x,y,' butterflies appear');
graphwriteln(x,y,' out of thin air.');
end;
12..14:begin
graphwriteln(x,y,' You are kissed by a');
graphwriteln(x,y,' faerie.');
player.endurance:=player.endurance+d(2);
if (player.endurance>player.endurancemax) then
player.endurance:=player.endurancemax;
end;
15..16:begin
graphwriteln(x,y,' Your left hand turns');
graphwriteln(x,y,' into a claw.');
player.strength:=player.strength+1;
if (player.strength>20) then
player.strength:=20;
end;
17..18:begin
graphwriteln(x,y,' A voice says,');
graphwriteln(x,y,' "watch yourself"');
player.dexterity:=player.dexterity+1;
if (player.dexterity>20) then
player.dexterity:=20;
end;
19:begin
if (nummonsters=8) then
begin
graphwriteln(x,y,' You hear a');
graphwriteln(x,y,' rumbling noise');
end
else
begin
{------roll monster-----}
if not(exist(cfg.wildchart)) then
exit;
assign(pasfile,cfg.wildchart);
reset(pasfile);
read(pasfile,monsterchart);
close(pasfile);
with monsterchart do
begin
theroll:=droll(diceroll);
for count:=1 to 20 do
begin
val1:=value[count,1];
val2:=value[count,2];
if (theroll in [val1..val2]) then
begin
monsterfile:=filename[count];
numnewmonster:=1;
end;
end;
end;
rollmonsters(newmonster,numnewmonster,monsterfile);
{-----------------------}
nummonsters:=nummonsters+1;
monster[nummonsters]:=newmonster[1];
tempstring:=monster[nummonsters].name;
tempstring:=capitalize(tempstring);
x:=120-(textwidth(tempstring) DIV 2);
graphwriteln(x,y,tempstring);
graphwriteln(x,y,'');
tempstring:='appears';
x:=120-(textwidth(tempstring) DIV 2);
graphwriteln(x,y,tempstring);
end;
end;
20:begin
y:=310;
graphwriteln(x,y,' WHOA! MEGADAMAGE!');
graphwriteln(x,y,'');
dmgroll.rollnum:=6;
dmgroll.dicetype:=6;
dmgroll.bonus:=6;
dmg:=droll(dmgroll);
thespell:=fireblast;
case d(6) of
2:damagetype:='fire';
3:begin
damagetype:='cold';
thespell:=icicle;
end;
4:damagetype:='meteor';
5:damagetype:='acid';
6:damagetype:='poison';
else
damagetype:='lightning';
end;
end;
else
begin
graphwriteln(x,y,' You don''t think');
graphwriteln(x,y,' anything happened.');
end;
end;
end;
glacier:begin
if not(playereffect.glacier) then
begin
graphwriteln(x,y,' You''re skin takes');
graphwriteln(x,y,' on a blue hue.');
graphwriteln(x,y,'');