program treasure_crypt; {ver 9.6} {started 9/3/2004 to 2/5/2004} {from 3/10/05 to 14/11/05} {21/03/06 to 19/04/06} {9/6/06 to 24/6/06} { FOR THE USER To compile, this requires the SVGA256.BGI in the BGI folder. Also run this program using Turbo Pascal's tpx.exe which is in the Bin folder, not the turbo.exe. The current folder must be the crypt folder or the folder where the crypt bgi files are, for the program to compile. (use 'Change Dir' in File menu) If you need any more help check http://www.fraserking.co.uk/faq.htm } { NOTES BEFORE UPLOADING remove weapons test in initialise and select_number tests search and remove test code change to 1P vs 1 CPU (init_startup) add intro } { CREATING ZIP FILE include SVGA256.BGI in the bgi folder remember to copy graphics folder & bgi files change memory settings in crypt icon (maybe not required) } { Error1: The graphics files are needed for crypt to run (not used) Error2: The SVGA256.BGI file is required for Crypt to run Error3: The files in the BGI folder are required for Crypt to run Error4: Items.dat needs to be in the same folder as Crypt.exe Error5: One of the files in the Graphics folder is missing When I use the SVGA256 file. I need to use the files in the BGI folder. Even when running the Crypt.exe file. I don't need to use the units bgi1.tpu and bgi2.tpu Required files to run Crypt.exe ------------------------------- items.dat hi_score.dat (file is not required because file is created if doesn't exists) SVGA256.BGI BGI folder Graphics folder Required files for compiling ---------------------------- items.dat hi_score.dat (file is not required because file is created if doesn't exists) SVGA256.BGI (in BGI folder) BGI folder (with bgi and chr files) Graphics folder BGI1.TPU (don't need these files now) BGI2.TPU } { when adding new graphics array, change in move_pics load_pcx the new command at start of main program the memory alloc at the start (load pcx section) if a player misses 3 turns then end the players game join display_item_gfx2 3 and 4 join move_pics2 and load_pcx2 and load_pcx3 comp: make comp avoid rooms its been retreated from comp: check room next to comp for characters or items enter players names if theres any errors check rnd_move_after_timeout and main_actions cpu_actions and the no. of retreats from same room BUGS ---- retreat & comp: sometimes player retreats when enemy team are not strong (maybe fixed) retreat & comp: if player loses the +1 bonus and if they go back to same room. only the attack and retreat will be shown. the comp will be trying to talk, but instead its retreating. (fixed and creates a bug with comp retreating from empty room) comp: sometimes the comp retreats from an empty room. this is to do with losing the bonus in the room and cpu_actions I still have to program when the user trys and retreats. An message should say something like "You can't retreat". Compare with the previous room. (done) Try doing this with comp. Sometimes this can happen with the comp. (still to do) demo comp: if the comp is trapped in a 1 player game or both comps are trapped in a 2 player game then they will keep bumping into the wall there's a bug in the edit weapons and when swaping items between moves edit weapons: the screen crashes when dropping an item in a room which has not been entered edit weapons: there's a bug when dropping a item in the 5th row of a column edit weapons: it doesn't let you drop items after a fight or talking to a character } { fix the enter_hi-score so when pressin escape takes you back to the menu still to fix the bug with secs. the one i need to press ctrl+enter before clearing the screen when the battle starts. copy the screen so i can have the game in the background when opening the sarc in the first screen. the gems are displayed in the first tile (roomitems) to fix the bug when the delay slows down, is by pressing ctrl_enter on source code screen. not when the game is playing } uses crt,graph,dos{,bgi1,bgi2}; const MAXITEMS = 24; PPLNUM = 10; MAXTEAM = 7; {max ppl in team} MAXWEAPONS = 5; MAXBOX = 6; ITEM_MIN = 11; ITEM_MAX = 20; MAXACTION = 10; LOOK = false; {comp has to be off} {both these const are tmp} TESTITEM = 18; {item to search for} PLAYER1 = {7}3; {the two first players} PLAYER2 = 1; MAX_HI_SCORE = 10; MENUDELAY = 10; {the amount of secs before the demo start, when on main menu} MAX_PLAYERS = 4; {used to declare the const and types at the start} ESC = #27; CR = #13; SP = #32; F1 = #59; F10 = #68; A_KEY = #97; LT = #75; RT = #77; UP = #72; DN = #80; BS = #8; SPC = ' '; {const are all false} tmptest : boolean = false; {tmp const} roomend : boolean = false; battlewon : boolean = false;{this is to test if mummy was defeated in sarc} no_of_players : byte = 2; {the number of players in 1 game} soundOnOff : byte = 1; {relates to options.soundNo. 1 for sound on, 0 for sound off} {to do with storing items in the rooms} roomCount : byte = 1; {this counter adds up with every new room} roomNo : byte = 0; {finds the number of the room} MAXROOMS = 50; {these variables are to do with pause} gameover : boolean = false; msgpause : integer = 1500; throttle : boolean = false; {tmp const} {these variables are to do with cpu} itemsmax : boolean = false; tmp3 : byte = 1; comp : boolean = false; {comp on and off} {these are used in clearing action text and clearing bottom text} { saveX : integer = 0; saveY : integer = 0;} clrtext : boolean = false; secs : shortint = 0; retreat : byte = 2; {1 - retreat, 2 - end turn, 3 - ends the retreat} escapeweb : boolean = true; {closes corners when web is in room} demo : boolean = false; gametype : byte = 0; {0 for demo...1 for game} x3 : byte = 1; {destination box in weapons box. saves the highlighter position after making move} y3 : byte = 1; {1} cBLUE = 94; {2} cGREEN = 44; {3} cCYAN = 49; {4} cRED = 56; {5} cMAGENTA = 85; {6} cBROWN = 54; {7} cLIGHTGRAY = 87; {8} cDARKGRAY = 34; {9} cLIGHTBLUE = 121; {10} cLIGHTGREEN = 117; {11} cLIGHTCYAN = 134; {12} cLIGHTRED = 150; {13} cLIGHTMAGENTA = 181; {14} cYELLOW = 209; {15} cWHITE = 255; {room colours} boxcol : byte = {14;}cYELLOW; outline : byte = {12}cLIGHTRED; {no other colors in room can be this colour} col1 : byte = {9}cLIGHTBLUE; col2 : byte = {3}cCYAN; col3 : byte = {13}cLIGHTMAGENTA; fx : byte = {9}cLIGHTBLUE; {table colours} table : byte = {11}cLIGHTCYAN; heading : byte = {10}cLIGHTGREEN; outline1 : byte = {3}cCYAN; title : byte = {9}cLIGHTBLUE; itemscol : byte = {4}cRED; kgcol : byte = {2}cGREEN; tablecur : byte = cBLUE; {battle colours} txt1 : byte = {11}cLIGHTCYAN; txt2 : byte = {12}cLIGHTRED; txt3 : byte = {10}cLIGHTGREEN; txt4 : byte = {11}cLIGHTCYAN; {other colours} bkcol : byte = 1;{cBLUE} {when changing background, use cBLUE} menucol : byte = {11}cLIGHTCYAN; msgcol : byte = {15}cWHITE; msgcol2 : byte = {15}cWHITE; intro1 : byte = {14}cYELLOW; intro2 : byte = {12}cLIGHTRED; cpuHighlight : byte = {12}cLIGHTRED; {menu colours} titlefill : byte = {14}cYELLOW; outline2 : byte = {12}cLIGHTRED; normal : byte = {7}cLIGHTGRAY; highlight : byte = {10}cLIGHTGREEN; optionscol : byte = {11}cLIGHTCYAN; {hi-score table} title1 : byte = {14}cYELLOW; heading1 : byte = {13}cLIGHTMAGENTA; {enter hi-score} highlight1 : byte = {10}cLIGHTGREEN; normal1 : byte = {9}cLIGHTBLUE; initials : byte = {11}cLIGHTCYAN; txt5 : byte = {3}cCYAN; {help page} textcol : byte = {9}cLIGHTBLUE; headingcol : byte = {10}cLIGHTGREEN; titlecol : byte = {11}cLIGHTCYAN; type itemsRec = {never changes. always use var in procedures to save memory} RECORD name : string[11]; str1,range, friend,host, weight,pts : byte; desc : string[20]; END; storeRec = RECORD strength : byte; box3 : byte; END; rulesRec = RECORD ppl,enemy, items1,sword, cross,potion, sarc,hostile, pickup : boolean; END; boxRec = RECORD no : byte; onlyppl : boolean; type1 : byte; enable1 : boolean; END; actionRec = RECORD act : string[12]; pos : byte; box2 : byte; type2 : byte; END; battleRec = RECORD str2, range2 : byte; leader1, leader2 : byte; usept : boolean; END; partyRec = RECORD num3, str3, range3 : byte; END; hi_scoreRec = RECORD position : byte; hiname : string[3]; hiscore : word; END; optionsRec = RECORD speedno, {options} timeNo, soundNo, demono, playersNo, {game options} typeNo, gameNo : byte; END; partyType = array[1..MAX_PLAYERS,1..MAXTEAM] of partyRec; itemsType = array[1..MAXITEMS] of itemsRec; boxesType = array[1..MAXBOX] of boxRec; weaponsType = array[1..MAX_PLAYERS,1..MAXTEAM,1..MAXWEAPONS] of byte; storeType = array[1..MAXTEAM] of storeRec; actionType = array[1..MAXACTION] of actionRec; battleType = array[1..2] of battleRec; hi_scoreType = array[1..MAX_HI_SCORE] of hi_scoreRec; namesType = array[1..5] of string[7]; scoreType = array[1..MAX_PLAYERS] of word; Pattern4Type = array[1..4] of PointType; Pattern8Type = array[1..8] of PointType; {scrMemType = array[1..4] of Pointer; scrSizeType = array[1..4] of Word;} const actnames : array[1..8] of string[12] = ('Attack','Talk To','Retreat','End Turn', 'Pickup','Use','Cut Web With','Open'); {104 bytes} {New,Old - i.e. in 2,4 numbers, 2 is Elf in new item.dat and 4 is Elf in old items.dat This also includes the ghost and skeleton swapped around} itemPos : array[1..2,1..9] of byte = ((1,2,3,4,5,6,7,8,9),(1,4,6,7,5,2,3,9,8)); {------------------------------------------------------} { OLD 1 Dwarf 2 Goblin 3 Adventurer 4 Elf 5 Sorceress 6 Wizard 7 Troll 8 Skeleton 9 Ghost 10 Mummy 11 Gems 12 Gold 13 Silver 14 MagicBow 15 MagicSword 16 MagicStaff 17 Helmet 18 Potion 19 Cross 20 Chest 21 Sarcophagus 22 Giant Web 23 Earthquake NEW 1 Dwarf 2 Elf 3 Wizard 4 Troll 5 Sorceress 6 Goblin 7 Adventurer 8 Ghost (both been swapped) 9 Skeleton 10 Mummy (same) 11 Chest (the next 4 has changed) 12 Gems 13 Gold 14 Silver 15 MagicSword (same) 16 MagicBow 17 Helmet (same) 18 Cross 19 MagicStaff 20 Potion 21 Sarcophagus (these 3 are the same) 22 Giant Web 23 Earthquake these are the following procedures i should use the Xpos+(scrX*MAXCOL) instead of the saveX move_line display_tiles display_connect_lines avoid_route_to_deadend test_if_comp_reaches_deadend comps_first_room_after_deadend display_block_corners } const S = 100; {size of each box ex. 50 x 50 pixels} MAXCOL = 6; {the number of rows and colums in 1 screen ex. 7 x 7} MAXROW = 3; STARTX = 4; {the square where the game starts} STARTY = 2; SCRMAX = 4; {the numbers of screens i.e. 3 x 3} {if edited, change setup_boxes} scrY : shortint = 0; {which screen the character is in} scrX : shortint = 0; GM_STARTS : byte = 185; {the gamemap starts after the weapons box} MAX_CORNERS = 4; DEADENDS = 10; {decrease for more deadends. To change the no. of rooms check rnd_numbers} (* GMsaveX : shortint = STARTX; {prevents to much use of Xpos+(scrX*MAXCOL)} GMsaveY : shortint = STARTY; {same with Ypos+(scrY*MAXROW)}*) setblock : boolean = false; {used with comp to avoid deadends} speed : word = 1000; P : byte = 0; {players turn. number can be 1,2,3 or 4} Xpos : byte = STARTX; {the number of the square ex. room 3,2 } Ypos : byte = STARTY; character_colour = cWHITE; highlight_colour = cBLUE; hall_colour = cLIGHTBLUE; room_colour = cLIGHTCYAN; border_colour = cYELLOW; {these following 3 are the borders} block_line_colour = cYELLOW; connect_colour = cYELLOW; {this is the default corners which are opened in each of the 7 type of squares. 0 means the corners are closed and display a block} corner_defaults : array[1..7,1..MAX_CORNERS] of byte = ((1,0,0,4),(0,2,3,0),(1,2,3,4),(0,0,3,4),(1,2,0,0),(0,2,0,4),(1,0,3,0)); {the positions of the patterns of the halls and room} LeftHallGfx: Pattern4Type = ((X: 0; Y: 40), (X: 40; Y: 0), (X: 100; Y: 60), (X: 60; Y: 100)); RightHallGfx: Pattern4Type = ((X: 0; Y: 60), (X: 40; Y: 100), (X: 100; Y: 40), (X: 60; Y: 0)); RoomGfx: Pattern8Type = ((X: 0; Y: 40), (X: 40; Y: 0), (X: 60; Y: 0), (X: 100; Y: 40),(X: 100; Y: 60), (X: 60; Y: 100), (X: 40; Y: 100), (X: 0; Y: 60)); TopCornerGfx: Pattern8Type = ((X: 0; Y: 60), (X: 40; Y: 100), (X: 50; Y: 90), (X: 60; Y: 100),(X: 100; Y: 60), (X: 50; Y: 0), (X: 0; Y: 60), (X: 0; Y: 60)); RightCornerGfx: Pattern8Type = ((X: 0; Y: 40), (X: 10; Y: 50), (X: 0; Y: 60), (X: 40; Y: 100),(X: 100; Y: 50), (X: 40; Y: 0), (X: 0; Y: 40), (X: 0; Y: 40)); LeftCornerGfx: Pattern8Type = ((X: 0; Y: 50), (X: 60; Y: 100), (X: 100; Y: 60), (X: 90; Y: 50),(X: 100; Y: 40), (X: 60; Y: 0), (X: 0; Y: 50), (X: 0; Y: 50)); BottomCornerGfx: Pattern8Type = ((X: 0; Y: 40), (X: 50; Y: 100), (X: 100; Y: 40), (X: 60; Y: 0),(X: 50; Y: 10), (X: 40; Y: 0), (X: 0; Y: 40), (X: 0; Y: 40)); {Connect Gfx: find these numbers using the current Xpos & Ypos} TopLeftConnectGfx: Pattern8Type = ((X: -40; Y: 0), (X: 0; Y: 40), (X: 40; Y: 0), (X: 0; Y: -40),(X: -40; Y: 0), (X: -40; Y: 0), (X: -40; Y: 0), (X: -40; Y: 0)); TopRightConnectGfx: Pattern8Type = ((X: 60; Y: 0), (X: 100; Y: 40), (X: 140; Y: 0), (X: 100; Y: -40),(X: 60; Y: 0), (X: 60; Y: 0), (X: 60; Y: 0), (X: 60; Y: 0)); BottomLeftConnectGfx: Pattern8Type = ((X: 0; Y: 60), (X: -40; Y: 100), (X: 0; Y: 140), (X: 40; Y: 100),(X: 0; Y: 60), (X: 0; Y: 60), (X: 0; Y: 60), (X: 0; Y: 60)); BottomRightConnectGfx: Pattern8Type = ((X: 60; Y: 100), (X: 100; Y: 140), (X: 140; Y: 100), (X: 100; Y: 60),(X: 60; Y: 100), (X: 60; Y: 100), (X: 60; Y: 100), (X: 60; Y: 100)); type cornerType = array[1..MAX_CORNERS] of boolean; partyNoType = array[1..MAX_PLAYERS] of byte; playersRec = {save players details before going onto next players turn} RECORD s_Xpos,s_Ypos : byte; s_saveX,s_saveY : shortint; s_scrX,s_scrY : shortint; s_savekey : char; s_saveroom : byte; s_savecorner : byte; s_setblock : boolean; s_savestep : byte; playerType : byte; {1 for human...2 for cpu} s_escapeweb : boolean; {if the giant web is open or close} END; playersType = array[1..MAX_PLAYERS] of playersRec; {add a counter in init_rooms to get values old gamemap size: variable values use scrmax=2 maxcol=13 maxrow=6 new gamemap size: 8 scrmax = 47k and 6 scrmax = 27k} gamemapRec = RECORD enable : boolean; {true or false. 1325 variables } type1 : byte; {hall 1..2, room 3, corners 4..7} limit : cornerType; {for the corners. 5300 variables} cpublock : cornerType; {for comp avoiding blocked corners} END; {limit array: if true then corners are opened and if false then corners are closed and block line is shown} roomItemsRec = RECORD storeXpos, storeYpos : shortint; itemNo : array[1..MAXBOX] of byte; roomEnable : boolean; trap : array[1..MAX_CORNERS] of byte; {0 - normal, 1 - earthquake, 99 - giant web} bonus1 : array[1..MAX_PLAYERS] of boolean; {stores which room have a +1 bonus. true: +1 bonus & false: +0 bonus} retreat1 : array[1..MAX_PLAYERS] of byte; {for comp. each room starts with 0 for each player} talk1 : array[1..MAX_PLAYERS] of byte; {how many times the comp talks to character in room} END; {array[-26..26,-12..12] = 1325 variables} gamemapType = array[MAXCOL*(-SCRMAX)..MAXCOL*SCRMAX,MAXROW*(-SCRMAX)..MAXROW*SCRMAX] of gamemapRec; roomItemsType = array[1..MAXROOMS] of roomItemsRec; {---------------------------------------------------------} const BufferLength = $FFFE; Done1 : boolean = false; type PcxType = Object Kenmerk, Versie: byte; Gecomprimeerd: boolean; BitsPerPixel: byte; Raam: Record Links, Boven, Rechts, Onder: word End; HorResolutie, VerResolutie: word; Colour: array[0..15] of Record Red, Green, Blue: byte End; Reserve: byte; AantalVlakken: byte; AantalBytesPerLine: word; PaletInformatie: word; ReserveArray: array[1..58] of byte; End; ArByte = array[0..$FFFE] of byte; (*max is FFFE and was 4444*) picType = array[0..50,0..75] of byte; {large items} gfxType = array[1..23] of ^picType; picType2 = array[0..30,0..44] of byte; {small items} gfxType2 = array[1..21] of ^picType2; picType3 = array[0..31,0..34] of byte; {main character} gfxType3 = array[1..6] of ^picType3; picType4 = array[0..163,0..113] of byte; {rooms, web & earthquake} gfxType4 = array[1..{14}6] of ^picType4; {only using pics 13 to 18} store1Type = array[0..75] of byte; {for other pcx pics} bigstoreType = array[0..1150] of ^store1Type; {86250} store2Type = array[0..113] of byte; {for bits.pcx} bigstoreType2 = array[0..652] of ^store2Type; {73676} {total 331542} var repeat1,marker,m, xx,yy,MaxX,MaxY :word; PCX :PCXType; {128 bytes} Buffer :^ArByte; {65535 bytes} { PCX_File :File;} BufSize :word; Regs :Registers; {768 bytes} Colour256 :array[0..255] of Record Red,Green,Blue :byte End; PaletNr,ID :byte; function cv(number : {integer}longint) : string; var tmpstr : string[10]; begin str(number,tmpstr); cv := tmpstr; end; procedure clrwin(x1,y1,x2,y2 : integer); begin if demo then exit; setviewport(x1,y1,x2,y2,false); clearviewport; SetViewPort(0, 0, GetMaxX, GetMaxY, True); end; procedure writeto( size : byte; font : byte; text : string; x,y : integer; colour : byte ); begin if demo then exit; SetTextStyle(font, HorizDir, size); setcolor(colour); outtextxy(x,y,text); end; function file_exists(filename : string) : boolean; var F : file; begin file_exists := false; assign(F,filename); {$I-} reset(F); {$I+} if IOResult = 0 then begin file_exists := true; close(F); end; end; procedure getkey( var key : char ); begin key := readkey; if key = #0 then key := readkey; end; procedure closegame; begin cleardevice; closegraph; halt; end; procedure game_halts(tmpstr : string); var wait : char; begin textcolor(black); clrscr; textcolor(10); {don't use cLIGHTGREEN} gotoxy(1,1); write(tmpstr); textcolor(12); gotoxy(1,2); write('Press any key to quit'); getkey(wait); halt; end; procedure game_halts_gfx_lib(tmpstr : string); var wait : char; begin writeto(1,6,tmpstr,1,1,{10}cLIGHTGREEN); writeto(1,6,'Press any key to quit',1,40,{12}cLIGHTRED); getkey(wait); closegame; end; procedure display_item( {temporary procedure, change the gfx4 and max} max : byte; width,height : word; var gfx2 : gfxType2 ); var a : byte; x,y : byte; begin for a := 1 to {max}21 do begin cleardevice; for x := 0 to width-1 do for y := 0 to height-1 do if gfx2[a]^[x,y] <> {181}{133}185 then putpixel(x+100,y+100,gfx2[a]^[x,y]); readkey; end; end; Procedure LoadBuffer(var PCX_File : file); Begin Done1 := Done1 or EOF(PCX_File); BlockRead(PCX_File, Buffer^, SizeOf(Buffer^), BufSize) End; Procedure Load256Colour(var PCX_File : file; type1 : byte); {for the parameter type1 1 - normal 2 - load back.pcx, used with load_pcx3 } Begin Seek(PCX_File, FileSize(PCX_File) - 769); ID := 0; BlockRead(PCX_File, ID, 1); If ID = 12 then With Regs do Begin BlockRead(PCX_File, Colour256, 768); {automatically sets the background colour} {to change background colour again. change Colour256[0] and run this procedure again} { Colour256[0].blue := bkcol;} For PaletNr := 0 to 255 do With Colour256[PaletNr] do Begin Red := Red shr 2; Green := Green shr 2; Blue := Blue shr 2 End; AX := $1012; BX := 0; CX := 256; ES := Seg(Colour256); DX := Ofs(Colour256); Intr($10, Regs) end; seek(PCX_File, SizeOf(PCX)); if type1 = 2 then close(PCX_File); end; Procedure Increment(var PCX_File : file); Begin If marker < BufferLength then Inc(marker) else Begin marker := 0; LoadBuffer(PCX_File); End; End; procedure display_item_gfx( {gfx, displays large items & characters in room box} itemNum : byte; {temporary to this procedure and relates to items.no} width, height : word; var gfx : gfxType; x1,y1 : word {the positions of the boxes} ); var x,y : byte; begin if demo then exit; for x := 0 to width-1 do for y := 0 to height-1 do if (gfx[itemNum]^[x,y] <> 181) and (gfx[itemNum]^[x,y] <> cLIGHTRED) then putpixel(x+x1,y+y1,gfx[itemNum]^[x,y]); end; procedure display_item_gfx2( {gfx2, displays small items & characters in room} itemNum : byte; width, height : word; var gfx2 : gfxType2; x1,y1 : {word}integer {the positions of the boxes} ); var x,y : byte; begin if demo then exit; for x := 0 to width-1 do for y := 0 to height-1 do {avoiding clightred fixes a big} if not (gfx2[itemNum]^[x,y] in [187,cLIGHTRED]) then putpixel(x+x1,y+y1,gfx2[itemNum]^[x,y]); end; procedure display_item_gfx4( {gfx4, displays room gfx, webs, quakes in room} {this procedure is used with load_pcx2 and move_pics2} itemNum : byte; width, height : word; var gfx4 : gfxType4; x1,y1 : {word}integer {the positions of the boxes} ); var x,y : byte; begin if demo then exit; for x := 0 to width-1 do for y := 1 to height-1 do {note the 1 fixes a display bug} if not (gfx4[itemNum]^[x,y] in [{187}185,cLIGHTRED,129]) then putpixel(x+x1,y+y1,gfx4[itemNum]^[x,y]); {avoiding clightred fixes a bug and 129 is a lightblue background colour. To find a colour number. Add a pause after the putpixel in this procedure} end; procedure display_character( {gfx3, displays main character. similar to display_item_gfx} num : byte; {step in character sequence} width,height : word; var gfx3 : gfxType3; movex,movey : word; {the positions of the boxes} Xpos,Ypos : byte; type1 : byte {0 for erase, 1 for draw} { dir : byte} ); var x,y,col : byte; begin if demo then exit; for x := 0 to width do for y := 0 to height do if gfx3[num]^[x,y] <> 133 then begin if type1 <> 0 then {type=0 for erase, type=1 for draw} col := gfx3[num]^[x,y] else col := getpixel((Xpos*S)-S+x+movex+34,(Ypos*S)-S+GM_STARTS+y+movey+24); {erase} putpixel((Xpos*S)-S+x+movex+35,(Ypos*S)-S+GM_STARTS+y+movey+25,col); end; end; procedure move_pics( {this moves each item to a new array} width : word; height : word; itemMax : byte; var gfx : gfxType; var gfx2 : gfxType2; var gfx3 : gfxType3; var bigstore : bigstoreType ); var itemX,a : byte; min,max : word; begin max := width; min := 0; itemX := 0; for a := 1 to itemMax do begin for xx := min to max do begin case itemMax of 6 : for yy := 0 to height do {character} gfx3[a]^[itemX,yy] := bigstore[xx]^[yy]; 21 : for yy := 0 to height do {small items} if a <= 9 then gfx2[itemPos[2,a]]^[itemX,yy] := bigstore[xx]^[yy] else gfx2[a]^[itemX,yy] := bigstore[xx]^[yy]; 23 : for yy := 0 to height do {large items} if a <= 9 then {sorts characters into correct order} gfx[itemPos[2,a]]^[itemX,yy] := bigstore[xx]^[yy] else gfx[a]^[itemX,yy] := bigstore[xx]^[yy]; end; inc(itemX); if itemX = width then begin itemX := 0; inc(max,width); inc(min,width); break end; end; end; end; procedure load_pcx( posx,posy : word; {position where picture starts} totalwidth : word; {the total width of pcx pic} width : word; {the size of each character or object} height : word; pcxname : string; itemMax : byte; {number of pictures} var gfx : gfxType; var gfx2 : gfxType2; var gfx3 : gfxType3 ); var bigstore : bigstoreType; a,b,c : word; PCX_File : File; begin {cleardevice; setcolor(10); outtextxy(10,30,cv(memavail)); readkey; halt;} for a := 0 to 1150 do new(bigstore[a]); for a := 0 to 1150 do for b := 0 to 75 do bigstore[a]^[b] := 0; for a := 1 to 23 do for b := 0 to 50 do for c := 0 to 75 do gfx[a]^[b,c] := 0; MaxX := (totalwidth+posx)-1; MaxY :=(height+posy)-1; Assign(PCX_File,pcxname +'.pcx'); {$I-} Reset(PCX_File, 1); {$I+} if IOresult <> 0 then game_halts_gfx_lib('Error5: One of the files in the Graphics folder is missing'); if ioresult =0 then Begin BlockRead(PCX_File, PCX, SizeOf(PCX)); GetMem(Buffer,BufferLength); Load256Colour(PCX_File,1); xx :=posx;yy :=posy;marker :=0; LoadBuffer(PCX_File); While not Done1 do Begin If Buffer^[marker] and $C0 = $C0 then Begin repeat1 := Buffer^[marker] - $C0; Increment(PCX_File); End else repeat1 := 1; For m := 1 to repeat1 do {displays pixel by pixel for each line} Begin If xx <= MaxX then {PutPixel(xx, yy, Buffer^[marker]);} bigstore[xx]^[yy] := Buffer^[marker]; Inc(xx); End; If xx >= pcx.AantalBytesPerLine +posx then Begin {displays each line} xx := posx; Inc(yy); If yy > MaxY then {tests for last line} Done1 := true; End; Increment(PCX_File); end; move_pics(width,height,itemMax,gfx,gfx2,gfx3,bigstore); freemem(Buffer,BufferLength); for a := 0 to 1150 do dispose(bigstore[a]); close(pcx_file); Done1 :=false; end; end; procedure move_pics2( width,height : word; var gfx4 : gfxType4; var bigstore : bigstoreType2; var itemNum : byte; itemMax : byte ); var a,itemX : byte; min,max : word; x,y : word; begin max := width; min := 0; itemX := 0; for a := 1 to 4 do begin inc(itemNum); for x := min to max do begin for y := 0 to height do gfx4[{a}itemNum]^[itemX,y] := bigstore[x]^[y]; inc(itemX); if itemX = width then begin itemX := 0; inc(max,width); inc(min,width); break end; end; if itemNum = itemMax{14} then {misses last 2 empty squares in bits.pcx} exit; end; end; procedure load_pcx2( posx,posy : word; totalwidth, totalheight : word; width : word; height : word; pcxname : string; itemMax : byte; var gfx4 : gfxType4 ); var bigstore : bigstoreType2; a,b,c,tmpY : word; itemNum : byte; PCX_File : File; begin for a := 0 to totalwidth do new(bigstore[a]); for a := 0 to totalwidth do for b := 0 to height do bigstore[a]^[b] := 0; for a := 1 to itemMax{14} do for b := 0 to width do for c := 0 to height do gfx4[a]^[b,c] := 0; MaxX := (totalwidth+posx)-1; MaxY :=(totalheight+posy)-1; Assign(PCX_File,pcxname +'.pcx'); {$I-} Reset(PCX_File, 1); {$I+} if IOresult <> 0 then game_halts_gfx_lib('Error5: One of the files in the Graphics folder is missing'); if ioresult =0 then Begin BlockRead(PCX_File, PCX, SizeOf(PCX)); GetMem(Buffer,BufferLength); Load256Colour(PCX_File,1); xx :=posx;yy :=posy;marker :=0; LoadBuffer(PCX_File); xx := 0; yy := 0; itemNum := 0; tmpY := 0; While not Done1 do Begin If Buffer^[marker] and $C0 = $C0 then Begin repeat1 := Buffer^[marker] - $C0; Increment(PCX_File); End else repeat1 := 1; For m := 1 to repeat1 do {displays pixel by pixel for each line} Begin If xx <= MaxX then {PutPixel(xx, yy, Buffer^[marker]);} bigstore[xx]^[yy] := Buffer^[marker]; Inc(xx); End; If xx >= pcx.AantalBytesPerLine +posx then Begin {displays each line} if (tmpY = 113) or (tmpY = 226) or (tmpY = 339) or (tmpY = 452) or (tmpY = 565) then begin if {tmpY <> 226} (tmpY <> 113) and (tmpY <> 226) and (tmpY <> 339) then {misses the 2nd row in bits.pcx} move_pics2(width,height,gfx4,bigstore,itemNum,itemMax); yy := 0; {bigstore variables} xx := 0; for a := 0 to totalwidth do for b := 0 to height do bigstore[a]^[b] := 0; if tmpY = {452}565 then break; end; xx := posx; Inc(yy); inc(tmpY); (* If {yy}tmpY > MaxY then {tests for last line} Done1 := true;*) End; Increment(PCX_File); end; { display_item(width,height,gfx4);} freemem(Buffer,BufferLength); for a := 0 to totalwidth do dispose(bigstore[a]); close(pcx_file); Done1 :=false; end; end; procedure load_pcx3(posx,posy,width,height :word;pcxname :string); {This loads the backgound pic back.pcx. Doesn't use much memory and displays the pic in this procedure. This does not have a move_pics procedure The back.pcx pic has been enlarged to 640 pixels in the jpg format and then converted to 256 pcx colour in the program embellish} var PCX_File,PCX_File2 : File; begin MaxX :=(width+posx)-1; MaxY :=(height+posy)-1; Assign(PCX_File,pcxname +'.pcx'); {$I-} Reset(PCX_File, 1); {$I+} { if IOresult <> 0 then (doesn't work) game_halts_gfx_lib('Error5: One of the files in the Graphics folder is missing');} Assign(PCX_File2,'graphics/all.pcx'); {loads this files palette} {$I-} Reset(PCX_File2, 1); {$I+} if ioresult =0 then Begin BlockRead(PCX_File, PCX, SizeOf(PCX)); GetMem(Buffer,BufferLength); Load256Colour(PCX_File2,2); {loads another pictures palette} xx :=posx; yy :=posy; Marker :=0; LoadBuffer(PCX_File); While not Done1 do Begin If Buffer^[Marker] and $C0 = $C0 then Begin repeat1 := Buffer^[Marker] - $C0; Increment(PCX_File); End else repeat1 := 1; For m := 1 to repeat1 do Begin {if these numbers change, do a test with a search over 30} If xx <= MaxX then if not (Buffer^[Marker] in [50,52,56,57,62]) then {fixes a small pixel bug} PutPixel(xx, yy, Buffer^[Marker]); Inc(xx); End; If xx >= pcx.AantalBytesPerLine + posx then Begin xx := posx; Inc(yy); If yy > MaxY then Done1 := true; End; Increment(PCX_File); end; freemem(Buffer,BufferLength); close(PCX_File); Done1 := false; end; end; procedure Setvideo{(screen :byte)}; var AutoDetect : pointer; GrMd,GrDr : integer; ErrCode : Integer; {$F+} {function DetectVGA0 : Integer; begin detectvga0 :=0;end; function DetectVGA1 : Integer; begin detectvga1 :=1;end;} function DetectVGA2 : Integer; begin detectvga2 :=2;end; {function DetectVGA3 : Integer; begin detectvga3 :=3;end; function DetectVGA4 : Integer; begin detectvga4 :=4;end;} {$F-} begin if not file_exists('BGI\EGAVGA.BGI') then game_halts('Error3: The files in the BGI folder are required for Crypt to run'); AutoDetect := @DetectVGA2; { case screen of 0:AutoDetect := @DetectVGA0; 1:AutoDetect := @DetectVGA1; 2:AutoDetect := @DetectVGA2; 3:AutoDetect := @DetectVGA3; 4:AutoDetect := @DetectVGA4; end;} GrDr := InstallUserDriver('SVGA256',AutoDetect); GrDr := Detect; InitGraph(GrDr,GrMd,'BGI'); {uses BGI folder in Crypt folder} ErrCode := GraphResult; if ErrCode <> grOk then game_halts('Error2: The SVGA256.BGI file is required for Crypt to run'); {the SVGA256 files opens the graphics library. I need the files in BGI folder, even when running crypt.exe} end; {-----------------------------------------------} function rnd_limits(min,max : word) : word; var rnd : word; begin repeat rnd := random(max+1); until rnd >= min; rnd_limits := rnd; end; procedure writexy( { font type 1 TriplexFont 2 SmallFont 3 SansSerifFont 4 GothicFont } size : byte; font : byte; text : string; row : integer; colour : byte ); var column : integer; begin if demo then exit; SetTextStyle(font, HorizDir, size); setcolor(colour); column := (GetMaxX - textwidth(text) + 1) div 2; outtextxy(column,row,text); end; procedure clr_keyboard_buffer; var key : char; begin while keypressed do key := readkey; while keypressed do key := readkey; end; procedure limits(var num : byte; min,max : byte; wraparound : boolean); begin if wraparound then if num < min then num := max else if num > max then num := min else; if num < min then num := min else if num > max then num := max; end; procedure takeaway_60secs(savesecs : word; var endsecs : word); {if secs are i.e. 56secs then the secs are changed to 6secs} begin if savesecs+MENUDELAY >= 60 then endsecs := savesecs-60+MENUDELAY {if secs are 50 and over and under 59} else endsecs := savesecs+MENUDELAY; {if secs are under 50} end; procedure throttle_speed(key : char); begin if comp then if key = F10 then begin throttle := not throttle; if not throttle then begin msgpause := 1500; speed := 1000; {the gamemap speed} end else begin msgpause := 1; {skips battle messages} speed := 250; end; end; end; procedure display_time; begin clrwin(340,0,385,26); writeto(3,1,'Time: '+cv(secs),270,-2,{11}cLIGHTCYAN); dec(secs); end; procedure quit_prompt( var ch : char ); begin nosound; {incase the escape is pressed during a battle} clrwin(270,0,385,26); {clears the time} writexy(2,1,'OK to quit Y/N?',1,{7}cLIGHTRED); repeat getkey(ch); until upcase(ch) in ['Y','N',#3]; clrwin(220,0,400,26); {clears the quit_prompt} display_time; if ch = #3 then { Ctrl-C } closegame; end; procedure exit_game_prompt( wait : char; var ch : char ); begin if demo then exit; {fixes bug when demo is on} if wait = ESC then begin if gametype = 1 then {no prompt message when escaping from demo} quit_prompt(ch); if (upcase(ch) = 'Y') or (gametype = 0) then {game quits} begin gameover := true; exit; end; end; if wait = #3 then { Ctrl-C } closegame; if upcase(wait) = {'P'}F1 then begin clrwin(270,0,385,26); {clears the time} nosound; {incase the pause is pressed during a battle} writexy(3,1,'Pause',-2,{7}cLIGHTRED); repeat until keypressed; clrwin(270,0,385,26); display_time; clr_keyboard_buffer; end; end; procedure display_time_readkey( { for inbetween the choice numbers in singles game. also used for the timeout. } var wait : char ); var ok : boolean; h,m,s,hund : word; savesecs : byte; begin gettime(h,m,s,hund); ok := false; repeat savesecs := s; gettime(h,m,s,hund); if (savesecs <> s) and (secs <> -1) then {tests if the second has changed} display_time; if (secs = -1) and not gameover then {timeout and secs are global variables} begin wait := #0;{uses the char #0 to prevent adding a parameter into this} secs := 0; {procedure. also used to turn comp on} exit; end; if keypressed then {when pressing number choices} begin getkey(wait); ok := true; end; until ok; end; procedure display_time_delay( { used for all the comp's pauses and during the battle in the singles game. this procedure also lets you display the time during delay command. } var wait : char; Tspeed : word ); var ok : boolean; h,m,s,hund : word; savesecs : byte; a : byte; ch : char; {temporary} begin if demo then exit; gettime(h,m,s,hund); ok := false; for a := 1 to Tspeed div 10 do begin savesecs := s; gettime(h,m,s,hund); if (savesecs <> s) and (secs <> -1) then {tests if the second has changed} display_time; delay(10); if keypressed then {when pressing number choices} begin getkey(wait); throttle_speed(wait); {for the throttle} exit_game_prompt(wait,ch); {test for F10, escape and pause} if gameover then exit; end; end; end; (*procedure open_graphics_library; var grDriver : Integer; grMode : Integer; ErrCode : Integer; begin { take out remarks. copy all graphics files and crypt.exe into same folder. then run crypt} grDriver := Detect; InitGraph(grDriver, grMode,'c:\progra~1\tp\bgi'); ErrCode := GraphResult; if ErrCode <> grOk then game_halts('Error1: The graphics files are needed for crypt to run'); end;*) {procedure check_keys(choices : string; var key : char); var i : byte; ok : boolean; begin ok := false; repeat getkey(key); key := upcase(key); for i := 1 to length(choices) do if choices[i] = key then ok := true; until ok; end;} procedure display_rectangle( {used with flashing_rectangles and start_battle} rect : Pattern4Type; col : byte ); begin if demo then exit; setcolor(col); {border colour} SetFillStyle(1, col); FillPoly(SizeOf(rect) div SizeOf(PointType), rect); end; procedure flashing_rectangles( coltype : byte ); const {flashing rectangles on battle screen} LeftRect: Pattern4Type = ((X: 0; Y: 145), (X: 0; Y: 480), (X: 85; Y: 480), (X: 85; Y: 145)); RightRect: Pattern4Type = ((X: 550; Y: 145), (X: 550; Y: 480), (X: 640; Y: 480), (X: 640; Y: 145)); TopRect: Pattern4Type = ((X: 86; Y: 145), (X: 86; Y: 160), (X: 549; Y: 160), (X: 549; Y: 145)); BottomRect: Pattern4Type = ((X: 86; Y: 460), (X: 86; Y: 480), (X: 549; Y: 480), (X: 549; Y: 460)); var rnd : byte; begin if demo then exit; if coltype = 1 then {after battle restores the background to blue} rnd := bkcol else repeat {random colours during battle} rnd := rnd_limits(1,{15}255); until rnd <> {4}cRED; display_rectangle(LeftRect,rnd); display_rectangle(RightRect,rnd); display_rectangle(TopRect,rnd); display_rectangle(BottomRect,rnd); end; {procedure save_screen( var scrMem : scrMemType; var scrSize : scrSizeType ); var a : byte; x1,x2 : word; begin for a := 1 to 4 do begin case a of 1 : x1 := 0; 2 : x1 := 181; 3 : x1 := 362; 4 : x1 := 542; end; if a = 4 then x2 := 639 else x2 := x1+180; scrSize[a] := 0; scrSize[a] := ImageSize(x1, 144, x2, 445); GetMem(scrMem[a], scrSize[a]); } { Allocate memory on heap } { GetImage(x1, 144, x2, 445, scrMem[a]^); end; end; procedure restore_screen( scrMem : scrMemType; scrSize : scrSizeType ); var a : byte; x1 : word; begin for a := 1 to 4 do begin case a of 1 : x1 := 0; 2 : x1 := 181; 3 : x1 := 362; 4 : x1 := 542; end; PutImage(x1, 144, scrMem[a]^, NormalPut); FreeMem(scrMem[a], scrSize[a]); end; end;} procedure clear_bottom_text; begin if demo then exit; { clrwin(50,420,610,479);} clrwin(50,445,600,479); end; procedure clr_main_area; begin if demo then exit; clrwin(0,144,GetMaxX,GetMaxY); {clears on start of battle} end; procedure clr_arrows; begin if demo then exit; clrwin(579,409,639,479); end; procedure getweaponsXY( { x,y : returns x and y of position numX,numY : postion of the box in weapons table team : true for player names and false for the items and weapons note. this is where it clears the box and where the text starts. it is not where the weapons box starts. to get where weapons box starts do x-5. To change postion of weapons box, change this procedure. To change the size of weapons box, change this procedure and display_weapons_box. } var x,y : integer; numX,numY : byte; team : boolean ); begin x := 6+(numX*91)-91; if team then y := 30 else y := 61+(numY*16)-16+1; end; procedure getboxXY( { x,y : returns the x and y of box num : number of box 1..6 note. To change position of boxes, I only have to change this procedure. To change the size of boxes, change this procedure and the display_boxes procedure. } var x,y : integer; num : byte ); begin x := 125*num+200-125+1; y := 183; inc(x,10*num); {spaces inbetween boxes} if num > 3 then begin inc(y,115); dec(x,405); end; end; procedure fill_window( linecol : byte; effect : byte; fillcol : byte; row : integer; column : integer ); begin if demo then exit; setcolor(linecol); SetFillStyle(effect, fillcol); floodfill(row,column,linecol); end; procedure display_marker( {edit weapons highlighter} colour : byte; tmpx,tmpy : byte {x3 and y3 are global} ); var x,y : integer; begin SetFillStyle(1,colour); getweaponsXY(x,y,tmpx,tmpy,false); floodfill(x+3,y+3,outline1); end; function findroom( roomItems : roomItemsType; tmpXpos, tmpYpos : byte ) : byte; var a : byte; begin for a := 1 to MAXROOMS do with roomItems[a] do if (tmpXpos+(scrX*MAXCOL) = storeXpos) and (tmpYpos+(scrY*MAXROW) = storeYpos) then begin findroom := a; {finds a enabled room} exit; end; findroom := roomCount; {new room entered} end; function calc_boxesNo( {works out the number of items in a room} roomItems : roomItemsType; num : byte ) : byte; var a : byte; begin for a := MAXBOX downto 1 do if roomItems[num].itemNo[a] <> MAXITEMS then begin calc_boxesNo := a; {the number of items in the room} break; end else calc_boxesNo := 0; {no items in room} end; procedure display_room_items( var gamemap : gamemapType; items : itemsType; roomItems : roomItemsType; tmpXpos, tmpYpos : byte; var gfx2 : gfxType2 ); const {the x & y positions of the items in the room} pos1 : array[1..12] of shortint = (25,-15, 49,-15, 25,45, 48,45, 5,20, 70,20); var count,e : byte; num : byte; tmp : byte; x1,y1 : integer; first : boolean; begin count := 0; num := findroom(roomItems,tmpXpos,tmpYpos); if calc_boxesNo(roomItems,num) = 0 then {no items in room} exit; for e := 1 to calc_boxesNo(roomItems,num) do {to number of items in room} begin tmp := roomItems[num].itemNo[e]; {gets item number} x1 := pos1[e+count]; { the x & y positions of the items in the room} y1 := pos1[e+count+1]; if (not (tmp in [22..23])) and (tmp <> MAXITEMS) then display_item_gfx2(tmp,29,44,gfx2,x1+(tmpXpos*S)-S,y1+(tmpYpos*S)-S+GM_STARTS); inc(count); end; end; procedure display_web_and_quake( roomItems : roomItemsType; var gfx4 : gfxType4; tmpXpos, tmpYpos : byte ); const pos1 : array[1..8] of integer = (-52,-62, 93,-63, -55,30, 90,40); {earth quake position} var tmp,e : byte; x1,y1 : integer; num : byte; first : boolean; begin num := findroom(roomItems,tmpXpos,tmpYpos); if calc_boxesNo(roomItems,num) = 0 then {no items in room} exit; first := true; for e := 1 to MAX_CORNERS do begin tmp := roomItems[num].trap[e]; {finds if corner is blocked} if tmp <> 0 then {runs code if corner has a web or quake} begin x1 := pos1[(e*2)-1]; {the x & y positions of blocked corner} y1 := pos1[e*2]; {corner between 1 and 4} case tmp of 1 : display_item_gfx4(5,163,113,gfx4,x1+(tmpXpos*S)-S-50,y1+(tmpYpos*S)-S+GM_STARTS); {earth quake} 99 : if first then {only displays this once} begin display_item_gfx4(4,163,113,gfx4,(tmpXpos*S)-S-30,(tmpYpos*S)-S+GM_STARTS-10); {giant web} first := false; {only displays the web once} end; end; end; end; end; procedure escape_giant_web( roomItems : roomItemsType; {don't add var} GMkey : char ); var tmp,tmpnum : byte; ch : char; {temporary char} begin { escapeweb true : character moves and runs code as normal false : character doesn't move and skips animation } escapeweb := true; {needs to set this before exit, in the next line} if not (GMkey in ['A','S']) then {only runs this when user presses the down keys} exit; tmpnum := findroom(roomItems,Xpos,Ypos); if roomItems[tmpnum].trap[3] = 99 then {checks 3rd corner for giant web} begin tmp := rnd_limits(1,2); {50% chance of escaping the web} if tmp = 1 then {character escapes web} escapeweb := true else begin {clear_bottom_text;} writexy(3,1,'Blocked exit, try again',445,msgcol); display_time_delay(ch,1000); clrtext := true; escapeweb := false; end; end; end; procedure initialise( var party : partyType; var partyNo : partyNoType; var weapons : weaponsType; var tiles : byte; var score : scoreType; options : optionsRec; no_of_players : byte; var GMfirst : byte; var savestep : byte ); var rnd,a,b,c : byte; begin cleardevice; (* for b := 1 to no_of_players do begin rnd := rnd_limits(1,{MAXTEAM}{options.levelno+2}1); for a := 1 to rnd do party[b,a].num3 := rnd_limits(1,MAXTEAM); partyNo[b] := rnd; end;*) for a := 1 to no_of_players do begin party[a,1].num3 := PLAYER1; party[a,2].num3 := PLAYER2; (* party[a,3].num3 := 1; {weapons box test} party[a,4].num3 := 2; party[a,5].num3 := 3; party[a,6].num3 := 4;*) partyNo[a] := 2{6}; end; gameover := false; for c := 1 to no_of_players do for a := 1 to MAXTEAM do for b := 1 to MAXWEAPONS do weapons[c,a,b] := MAXITEMS; {clears to item 24} {weapons box test} { weapons[1,1,1] := 20; weapons[1,1,2] := 18; weapons[1,1,3] := 15; weapons[1,3,1] := 13; weapons[1,4,1] := 14; weapons[1,5,1] := 15; weapons[1,3,2] := 16; weapons[1,5,2] := 12; weapons[1,5,3] := 12;} {restores to the tiles number in the options menu, each game} case no_of_players of 1 : tiles := 40; 2 : tiles := 50; 3 : tiles := 60; 4 : tiles := 70; end; for a := 1 to no_of_players do score[a] := 0; { saveX := 192; saveY := 330;} GMfirst := 0; P := 0; {starts with player 1} roomCount := 1; savestep := 1; {the position the character is at the start of game, either 1 or 4} {saves this to a global variable, to prevent passing the options record through the procedure, when making the sound} soundOnOff := options.soundNo; end; procedure clear_variables( var skip,once, twice, third, exit1, timeout : boolean; var battle : battleType ); begin {note some of these are global variables} skip := false; once := true; itemsmax := false; twice := false; third := true; tmp3 := 1; roomend := false; exit1 := false; timeout := false; battle[1].usept := false; {fixes +3 potion bug when starting a battle} retreat := 2; {set to end turn} end; procedure battle_sound( var wait : char ); var a : byte; begin if demo then exit; for a := 1 to 30 do begin flashing_rectangles(0); if soundOnOff = 1 then sound(240); if a <> 30 then display_time_delay(wait,50); {delay} nosound; if soundOnOff = 1 then sound(200); if a <> 30 then display_time_delay(wait,50); nosound; end; end; procedure menu_click_sound; {also makes sound when dropping item} begin if demo then exit; sound(240); delay(20); nosound; end; procedure character_walking_sound; begin if demo then exit; sound(220); delay(20); nosound; delay(20); end; procedure won_battle_sound(var wait : char); begin if demo then exit; sound(180); display_time_delay(wait,500); sound(220); display_time_delay(wait,500); nosound; end; procedure character_dead_sound(var wait : char); begin if demo then exit; sound(180); display_time_delay(wait,500); sound(140); display_time_delay(wait,500); nosound; end; procedure character_joined_sound(var wait : char); begin if demo then exit; sound(220); display_time_delay(wait,500); nosound; end; procedure item_too_heavy_sound; begin if demo then exit; sound(220); delay(100); nosound; end; procedure drop_item_error_sound; begin if demo then exit; sound(220); delay(100); nosound; end; procedure bump_into_wall_sound; begin if demo then exit; sound(220); delay(100); nosound; end; procedure make_rules( var rules : rulesRec; boxesNo : byte; var boxes : boxesType; weapons : weaponsType; partyNo : partyNoType ); var a,b : byte; begin with rules do begin ppl := false; enemy := false; items1 := false; hostile := false; pickup := false; sword := false; cross := false; sarc := false; potion := false; end; for a := 1 to boxesNo do {any of these items are in the room} with rules,boxes[a] do begin onlyppl := true; type1 := 0; case no of {item checked} 1..7 : type1 := 0; 8..10 : type1 := 9; 15 : type1 := 1; {sword} {18}20 : type1 := 2; {potion} {19}18 : type1 := 3; {cross} 21 : type1 := 4; {sarc} end; if no in [1..PPLNUM] then ppl := true; if no in [8..PPLNUM] then enemy := true; if no in [ITEM_MIN..ITEM_MAX+3] then begin items1 := true; onlyppl := false; end; end; for a := 1 to partyNo[P] do {item checked} for b := 1 to MAXWEAPONS do {tells when 1 of these items are in team} case weapons[P,a,b] of 15 : rules.sword := true; {18}20 : rules.potion := true; {19}19 : rules.cross := true; 21 : rules.sarc := true; end; end; procedure intro; var y,y1 : integer; loop : boolean; key : char; x,x1 : integer; stop : boolean; begin cleardevice; clr_keyboard_buffer; y := -20; y1 := 400; stop := false; loop := false; SetTextStyle(4, HorizDir, 8); x := (GetMaxX - textwidth('Crypt') + 1) div 2; x1 := (GetMaxX - textwidth('Treasure') + 1) div 2; repeat setcolor({14}intro1); outtextxy(x,y,'Crypt'); setcolor({12}intro2); outtextxy(x1,y1,'Treasure'); if keypressed then begin getkey(key); if key = #3 then { Ctrl-C only for testng } closegame; {for testing, add remarks when finished} if key = ESC then {only escape lets the user skip the menu} break; end; delay(300); if not stop then begin setcolor(bkcol); {when using a blue background, change this to 0} outtextxy(x,y,'Crypt'); outtextxy(x1,y1,'Treasure'); end else begin writeto(3,3,'By Fraser King',250,{315}305,{10}cLIGHTGREEN); delay(4000); break; end; if y = 200 then {for crypt text} y := 200 else inc(y,20); if y1 = 140 then begin y1 := 140; stop := true; end else dec(y1,20); {for treasure text} until loop; clr_keyboard_buffer; end; procedure setup_boxes( var boxesNo : byte; var boxes : boxesType; options : optionsRec; roomItems : roomItemsType ); var a,level : byte; miss : boolean; begin miss := false; if (Xpos = STARTX) and (Ypos = STARTY) {no items on first tile} and (scrX = 0) and (scrY = 0) then begin boxesNo := 0; miss := true; end; roomNo := findroom(roomItems,Xpos,Ypos); if not miss then if not roomItems[roomNo].roomEnable then begin {new room} {calcs the number of items in the room} {if scrX >= 0 then if scrX > scrY then level := scrX else if scrX < 0 then if scrX < scrY then level := scrX; if scrY >= 0 then if scrY > scrX then level := scrY else if scrY < 0 then if scrY < scrX then level := scrY; if level >= 0 then inc(level) else begin level := level+level end;} if (scrX = 4) or (scrY = 4) or (scrX = -4) or (scrY = -4) then level := 6 else if (scrX = 3) or (scrY = 3) or (scrX = -3) or (scrY = -3) then level := 4 else if (scrX = 2) or (scrY = 2) or (scrX = -2) or (scrY = -2) then level := 3 else if (scrX = 1) or (scrY = 1) or (scrX = -1) or (scrY = -1) then level := 2 else if (scrX = 0) or (scrY = 0) then level := 1; {level := 4;} {test} boxesNo := level; end else {room has already been entered} boxesNo := calc_boxesNo(roomItems,roomNo); for a := 1 to MAXBOX do with boxes[a] do if a <= boxesNo then enable1 := true else enable1 := false; end; procedure display_boxes; var a : byte; x,y : integer; begin if demo then exit; { setcolor(12);} setcolor(outline); SetLineStyle(SolidLn, 0, ThickWidth); SetFillStyle(1, boxcol); {sets to yellow} for a := 1 to MAXBOX do begin getboxXY(x,y,a); rectangle(x-1,y-1,x+125+1,y+100+1); floodfill(x+5,y+5,outline); {fills box with yellow} end; end; procedure display_weapons_box; var x,y : integer; a,b : byte; begin if demo then exit; setcolor(outline1); SetFillStyle(1,heading); SetLineStyle(SolidLn, 0, 3); for a := 1 to MAXTEAM do {display heading row} begin getweaponsXY(x,y,a,1,true); rectangle(x-5,y,x+90-5,y+32); floodfill(x+3,y+3,outline1); end; SetFillStyle(1,table); {display the 5 rows} for a := 1 to MAXTEAM do for b := 1 to MAXWEAPONS do begin getweaponsXY(x,y,a,b,false); rectangle(x-5,y,x+90-5,y+16); floodfill(x+3,y+3,outline1); end; end; procedure get_items( boxnum : byte; var boxes : boxesType; change : byte; rnd : boolean; var num : byte; var roomItems : roomItemsType; var gamemap : gamemapType ); var tmpnum : byte; tmpcorner : byte; count : byte; begin if change = 1 then {room already been entered} begin boxes[boxnum].no := roomItems[roomNo].itemNo[boxnum]; num := boxes[boxnum].no; {restores saved items} exit; end; if rnd then {calcs random items} if change = 0 then {new room} begin {num := rnd_limits(1,MAXITEMS-1)} tmpnum := rnd_limits(1,76); case tmpnum of {item checked, in old items.dat format} 1..4 : num := 1; {characters} 5..9 : num := 2; 10..14 : num := 3; 15..18 : num := 4; 19..20 : num := 5; 21..23 : num := 6; 24..26 : num := 7; 27..30 : num := 8; 31..34 : num := 9; 35..37 : num := 10; 38..39 : num := 11; {items} 40..46 : num := 12; 47..56 : num := 13; 57..57 : num := 14; 58..58 : num := 15; 59..59 : num := 16; 60..61 : num := 17; 62..64 : num := 18; 65..65 : num := 19; 66..66 : num := 20; 67..70 : num := 21; {other} 71..72 : num := 22; 73..76 : num := 23; end; (* if rnd_limits(1,2) = 1 then*) {num := 21;} {test} end else num := change; if rnd then begin {stores new item} boxes[boxnum].no := num; with roomItems[roomCount] do begin itemNo[boxnum] := num; {stores item in room box} if num = 22 then {giant web, closes bottom 2 corners} {item checked} begin trap[3] := 99; {these 2 are for roomItems} trap[4] := 99; {I don't really need this line} end; if num = 23 then {earth quake, closes 1 random corner} {item checked} with gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)] do begin count := 0; repeat inc(count); if count = 20 then {timeout if all the corners already have a quake, fixes a bug} exit; tmpcorner := rnd_limits(1,4); {random block corner, only used if num is 22 or 23} until (trap[tmpcorner] = 0) and limit[tmpcorner]; {repeats until corner has no web or quake and corner is open} limit[tmpcorner] := false; {closes corner} trap[tmpcorner] := 1; {blocks off the opposite corner in the next room} case tmpcorner of 1 : gamemap[Xpos+(scrX*MAXCOL)-1,Ypos+(scrY*MAXROW)-1].limit[4] := false; 2 : gamemap[Xpos+(scrX*MAXCOL)+1,Ypos+(scrY*MAXROW)-1].limit[3] := false; 3 : gamemap[Xpos+(scrX*MAXCOL)-1,Ypos+(scrY*MAXROW)+1].limit[2] := false; 4 : gamemap[Xpos+(scrX*MAXCOL)+1,Ypos+(scrY*MAXROW)+1].limit[1] := false; end; end; end; end else num := boxes[boxnum].no; { tmp := 10-(length(items[num].name) div 2);} end; procedure display_items( { works out the random items in room and displays them in there boxes. also stores all contents in boxes array. change variable is 10 for mummy, 12 for gems and 0 for the rest of items boxnum : is the number of box 1..6 change : 0 for random items. 10 for mummy. 12 for gems. Last 2 for sarc 1 for room has already been entered rnd : true for random. false for non random and used for after fight num : temp variable for item number } var items : itemsType; boxnum : byte; boxesNo : byte; var boxes : boxesType; change : byte; rnd : boolean; var roomItems : roomItemsType; var num : byte; var gamemap : gamemapType ); var x1,y1 : integer; tmp : byte; {not in use} txt : string[2]; begin if (Xpos = STARTX) and (Ypos = STARTY) {no items on first tile} and (scrX = 0) and (scrY = 0) then exit; getboxXY(x1,y1,boxnum); get_items(boxnum,boxes,change,rnd,num,roomItems,gamemap); with items[num] do case num of 1..PPLNUM : begin writeto(6,2,name,x1{+tmp}+3,y1,col1); writeto(5,2,'Friendly '+cv(friend)+'%',x1+3,y1+30,col2); writeto(5,2,'Hostile '+cv(host)+'%',x1+3,y1+50,col2); writeto(4,2,'Strength +'+cv(str1)+' Range +'+cv(range),x1+3,y1+80,col3); end; ITEM_MIN..{21}ITEM_MAX : begin writeto(6,2,name,x1{+tmp}+3,y1,col1); writeto(5,2,'Weight '+cv(weight)+'kg',x1+3,y1+30,col2); if num <> {20}11 then {checking for chest} txt := cv(pts) else txt := '?'; {item checked} writeto(5,2,'Points '+txt,x1+3,y1+50,col2); if desc <> '' then writeto(4,2,desc,x1+3,y1+80,col3); end else begin writeto(6,2,name,x1{+tmp}+3,y1,col1); if desc <> '' then writeto(4,2,desc,x1+3,y1+80,col3); end; end; end; (*procedure save_actions_xy( var items : itemsType; actionsNo : byte; action : actionType ); var a : byte; tmp : string[26]; {cut web with magicsword is the biggest} begin { saves the previous area of action text} SetTextStyle(2, HorizDir, 5); saveX := 0; for a := 1 to actionsNo do begin {biggest length of ie 1..Talk Elf} tmp := cv(a)+'..'+action[a].act+SPC+items[action[a].pos].name; if textwidth(tmp) > saveX then saveX := textwidth(tmp); end; saveY := 176+(actionsNo*20)+20-2; end; procedure clear_actions; begin clrwin(10,176+20,10+saveX,saveY); end;*) procedure display_actions( var items : itemsType; action : actionType; actionsNo : byte ); var a : byte; begin if demo then exit; {clear_actions;} {both lines have to be before display_actions} {save_actions_xy(items,actionsNo,action);} clrwin(2,183,200,325); setcolor({12}cLIGHTRED); SetLineStyle(SolidLn, 0, ThickWidth); rectangle(2,183,200,325); fill_window({12}cLIGHTRED,1,{4}cRED,197,322); for a := 1 to actionsNo do writeto(5,2,cv(a)+'..'+action[a].act+SPC+items[action[a].pos].name,5,{175}186+(a*20)-20,menucol); end; procedure display_enemy( var items : itemsType; var boxes : boxesType; boxesNo : byte; rnd : boolean; var roomItems : roomItemsType; var gfx : gfxType; var gamemap : gamemapType ); var a : byte; x1,y1 : integer; change : byte; tmp : boolean; {temporary to this procedure} num : byte; begin { clrwin(0,430,100,470); with roomItems[roomNo] do begin writeto(5,2,'X: '+cv(storeXpos),0,430,10); writeto(5,2,'Y: '+cv(storeYpos),0,440,10); writeto(5,2,'enable: '+cv(ord(roomenable)),0,450,10); for a := 1 to 6 do writeto(5,2,cv(itemNo[a]),0+(a*20)-20,460,10); end;} tmp := false; if rnd = true then if roomItems[roomNo].roomEnable then change := 1 {room already been entered} else begin change := 0; {new room} with roomItems[roomCount] do begin storeXpos := Xpos+(scrX*MAXCOL); storeYpos := Ypos+(scrY*MAXROW); { itemNo[boxnum] := num;} roomEnable := true; end; tmp := true; end; for a := 1 to MAXBOX do begin getboxXY(x1,y1,a); if boxes[a].enable1 then begin fill_window(outline,1,boxcol,x1+5,y1+5); display_items(items,a,boxesNo,boxes,{0}change,rnd,roomItems,num,gamemap); if boxes[a].no <> MAXITEMS then display_item_gfx(num,50,75,gfx,x1+75,y1+5); {display box item gfx} end else fill_window(outline,{fx}1,{boxcol}2,x1+5,y1+5); end; if {not roomItems[roomCount].roomEnable}tmp then inc(roomcount); end; procedure display_weapons( var items : itemsType; weapons : weaponsType; start : byte; end1 : byte ); var a,b : byte; x,y : integer; begin for a := start to end1 do for b := 1 to MAXWEAPONS do if weapons[P,a,b] <> MAXITEMS then begin getweaponsXY(x,y,a,b,false); writeto(5,2,items[weapons[P,a,b]].name,x,y,itemscol); end; end; procedure display_team( var items : itemsType; party : partyType; start : byte; end1 : byte ); var a : byte; x,y : integer; begin {5,2 1,0 1,4 1,5 1,6 2,6(1pixel out) } for a := start to end1 do with items[party[P,a].num3] do begin getweaponsXY(x,y,a,1,true); writeto(1,6,name,x,y-5,title); writeto(4,2,'Str+'+cv(str1)+SPC+'Range+'+cv(range),x,y+18,{title}{12}cLIGHTRED); end; end; procedure display_weight( var items : itemsType; weapons : weaponsType; party : partyType; start : byte; end1 : byte ); var a,b : byte; x,y : integer; total : byte; begin for a := start to end1 do begin total := 0; for b := 1 to MAXWEAPONS do begin inc(total,items[weapons[P,a,b]].weight); if weapons[P,a,b] = MAXITEMS then begin getweaponsXY(x,y,a,b,false); writeto(5,2,cv(items[party[P,a].num3].weight-total)+'kg',x,y,kgcol); break; end; end; end; end; procedure clear_team( start : byte; end1 : byte ); var x,y : integer; a : byte; begin for a := start to end1 do {bug: has to fill the top text and then fill} begin {the bottom text} getweaponsXY(x,y,a,1,true); fill_window(outline1,1,heading,x+30,y+20); fill_window(outline1,1,heading,x+2,y+3); end; end; procedure clear_weight( weapons : weaponsType; start : byte; end1 : byte ); var a,b : byte; x,y : integer; begin for a := start to end1 do for b := 1 to MAXWEAPONS do if weapons[P,a,b] = MAXITEMS then begin getweaponsXY(x,y,a,b,false); fill_window(outline1,1,table,x+5,y+5); break; {onto next char column} end; end; procedure clear_weapons( weapons : weaponsType; start : byte; end1 : byte ); var x,y : integer; a,b : byte; begin for a := start to end1 do for b := 1 to MAXWEAPONS do if weapons[P,a,b] <> MAXITEMS then begin getweaponsXY(x,y,a,b,false); fill_window(outline1,1,table,x+5,y+5); end; end; procedure clear_enemy( var boxes : boxesType; boxesNo : byte; var score : scoreType; var items : itemsType; var roomItems : roomItemsType ); var a : byte; begin for a := 1 to boxesNo do {clears enemy box when killed} with boxes[a] do if (no in [1..PPLNUM]) and enable1 then begin inc(score[P],items[no].str1+items[no].range); enable1 := false; roomItems[roomNo].itemNo[a] := MAXITEMS; end; end; procedure add_players( var items : itemsType; var partyNo : partyNoType; var party : partyType; boxes : boxesType; var boxesNo : byte; person : byte; var rules : rulesRec; weapons : weaponsType; var score : scoreType; var roomItems : roomItemsType ); var n : byte; x,y : integer; wait : char; begin if partyNo[P] = MAXTEAM then begin writexy(3,1,'Your party is full',445,msgcol); roomend := true; {makes the text 'end turn' appear} exit; end; for n := 1 to boxesNo do with boxes[n] do if (no = person) and enable1 then {adds person who your talking to} begin inc(partyNo[P]); party[P,partyNo[P]].num3 := person; roomItems[roomNo].itemNo[n] := MAXITEMS; display_team(items,party,partyNo[P],partyNo[P]); display_weight(items,weapons,party,partyNo[P],partyNo[P]); getboxXY(x,y,n); {clears first char from box} {fill_window(outline,fx,boxcol,x+5,y+5);} fill_window(outline,{fx}1,{boxcol}2,x+5,y+5); inc(score[P],20); enable1 := false; break; end; if partyNo[P] < MAXTEAM then for n := 1 to boxesNo do {add players and clears char box} with boxes[n] do if (no in [1..7]) and enable1 then begin if partyNo[P] {>}= MAXTEAM then break; inc(partyNo[P]); party[P,partyNo[P]].num3 := no; {stores boxes[n].no} enable1 := false; roomItems[roomNo].itemNo[n] := MAXITEMS; display_team(items,party,partyNo[P],partyNo[P]); display_weight(items,weapons,party,partyNo[P],partyNo[P]); inc(score[P],20); getboxXY(x,y,n); { fill_window(outline,fx,boxcol,x+5,y+5);} fill_window(outline,{fx}1,{boxcol}2,x+5,y+5); end; writexy(3,1,items[person].name+' has joined your team',445,msgcol); if soundOnOff = 1 then character_joined_sound(wait); if rules.items1 then rules.pickup := true else roomend := true; itemsmax := false; for n := 1 to MAX_PLAYERS do roomItems[findroom(roomItems,Xpos,Ypos)].talk1[n] := 99; {don't talk again} end; procedure start_battle( teamstr, enemystr : byte; bonus : shortint; battle : battleType {var scrMem : scrMemType; var scrSize : scrSizeType} ); const MiddleRect: Pattern4Type = ((X: 85; Y: 145), (X: 85; Y: 460), (X: 550; Y: 460), (X: 550; Y: 145)); var sign : string[2]; wait : char; x : integer; n : byte; rnd : byte; begin { save_screen(scrMem,scrSize);} clr_main_area; display_rectangle(MiddleRect,{4}cRED); writexy(6,10,cv(teamstr)+' v '+cv(enemystr),{160}145,txt1); writeto(6,2,'Strength',175,280,txt2); writeto(6,2,'Range',175,300,txt2); x := 280; for n := 1 to 2 do with battle[n] do begin writeto(7,2,cv(str2),x,280,txt3); writeto(7,2,cv(range2),x,300,txt3); x := 365; end; if bonus in [0,1] then sign := '+'+cv(bonus) else sign := cv(bonus); writexy(8,2,'Bonus '+sign,360,txt4); if battle[1].usept then writexy(8,2,'Potion +3',380,txt4); battle_sound(wait); flashing_rectangles(1); end; procedure drop_items_after_lose_life( weapons : weaponsType; var roomItems : roomItemsType; tmp : byte; var boxes : boxesType; var boxesNo : byte ); var num,a : byte; lastnum : byte; count : byte; begin num := calc_boxesNo(roomItems,roomNo); {find number of items in current room} for a := 1 to MAXWEAPONS do {finds the number of the last item on character} if weapons[P,tmp,a] = MAXITEMS then begin lastnum := a-1; break; end; if lastnum = 0 then {no items on character, fixes bug} exit; count := 0; if num < MAXBOX then {tests if the room is full of items} for a := num+1 to MAXBOX do {drops items in room} begin inc(count); roomItems[roomNo].itemNo[a] := weapons[P,tmp,count]; boxes[a].enable1 := true; {updates the screen} boxes[a].no := weapons[P,tmp,count]; inc(boxesNo); if count = lastnum then {tests for last item on character} break; end; end; procedure lose_life( var items : itemsType; var party : partyType; var partyNo : partyNoType; var weapons : weaponsType; var roomend : boolean; battle : battleType; var roomItems : roomItemsType; var boxes : boxesType; var boxesNo : byte ); var wait : char; a : byte; tmp : byte; begin tmp := rnd_limits(1,2); {kills one of the team leaders} with battle[1] do if tmp = 1 then tmp := leader1 else tmp := leader2; roomend := true; writexy({4}3,1,'Your '+items[party[P,tmp].num3].name+' has been killed',420,msgcol); if soundOnOff = 1 then character_dead_sound(wait); display_time_delay(wait,msgpause); {only for testing} {clears the highlighter in edit weapons} if x3 >= tmp then begin dec(x3); display_marker(table,x3,y3); {clears marker} end; clear_weight(weapons,tmp,partyNo[P]); clear_weapons(weapons,tmp,partyNo[P]); clear_team(tmp,partyNo[P]); drop_items_after_lose_life(weapons,roomItems,tmp,boxes,boxesNo); for a := tmp to partyNo[P] do begin party[P,a] := party[P,a+1]; {removes a player from team} weapons[P,a] := weapons[P,a+1]; {removes items from player} end; for a := 1 to MAXWEAPONS do weapons[P,partyNo[P],a] := MAXITEMS; dec(partyNo[P]); display_team(items,party,tmp,partyNo[P]); {updates the team list on weapons box} display_weapons(items,weapons,tmp,partyNo[P]); display_weight(items,weapons,party,tmp,partyNo[P]); roomItems[findroom(roomItems,Xpos,Ypos)].bonus1[P] := false; {sets bonus to 0 for this room and player} roomItems[findroom(roomItems,Xpos,Ypos)].talk1[P] := 99; {don't talk again} retreat := 3; {if its on, turn off retreat sequence. prevents the anim when player dies} end; procedure attack( { in : teamstr,enemystr out : party,partyNo,rules works out who wins fight with teamstr and enemystr and displays message who wins. if team loses then a player is lost. Always tells if its game over. } var items : itemsType; var partyNo : partyNoType; var party : partyType; teamstr, enemystr : byte; bonus : shortint; var rules : rulesRec; var boxesNo : byte; var boxes : boxesType; var weapons : weaponsType; battle : battleType; var score : scoreType; var roomItems : roomItemsType; var gfx : gfxType; var gamemap : gamemapType ); var rnd1, rnd2 : byte; wait : char; a,tmp : byte; ok : boolean; { scrMem : scrMemType; scrSize : scrSizeType;} begin if not roomItems[findroom(roomItems,Xpos,Ypos)].bonus1[P] then bonus := 0; {the player has lost the +1 bonus in this room} battlewon := false; start_battle(teamstr,enemystr,bonus,battle{,scrMem,scrSize}); if gameover then exit; if battle[1].usept then {adds potion str} inc(bonus,3); rnd1 := teamstr+bonus+rnd_limits(1,6); rnd2 := enemystr+rnd_limits(1,6); if rnd1 > rnd2 then {won the battle} begin writexy({4}3,1,'You have won the battle',420,msgcol); if rules.items1 then rules.pickup := true else roomend := true; clear_enemy(boxes,boxesNo,score,items,roomItems); battlewon := true; {roomItems[findroom(roomItems,Xpos,Ypos)].bonus1[P] := false;} {turns bonus off} for a := 1 to MAX_PLAYERS do roomItems[findroom(roomItems,Xpos,Ypos)].talk1[a] := 99; {don't talk again} if soundOnOff = 1 then won_battle_sound(wait); end; if rnd1 = rnd2 then {drew the battle} begin writexy({4}3,1,'The battle is a draw',420,msgcol); roomend := true; roomItems[findroom(roomItems,Xpos,Ypos)].bonus1[P] := false; {sets bonus to 0} roomItems[findroom(roomItems,Xpos,Ypos)].talk1[P] := 99; {don't talk again} end; if rnd1 < rnd2 then {lost the battle} begin lose_life(items,party,partyNo,weapons,roomend,battle,roomItems,boxes,boxesNo); {game over only happens when 1 player is left and tiles is not 0} ok := false; if no_of_players <> 1 then {checks 2,3 and 4 player games} begin tmp := 0; for a := 1 to no_of_players do if partyNo[a] = 0 then {adds all dead players} inc(tmp); if tmp = no_of_players-1 then ok := true; {game over} end else {checks 1 player game} if (partyNo[1] = 0) and (no_of_players = 1) then ok := true; if ok then begin delay(1500); clr_main_area; writexy(8,3,'GAME OVER',225,msgcol2); delay(4500); {using a delay to prevent speed up of timeout} gameover := true; exit; end; end; display_time_delay(wait,msgpause); if partyNo[P] = 0 then {prevents showing the boxes when losing last life} exit; if gameover then exit; clr_main_area; { restore_screen(scrMem,scrSize);} display_boxes; display_enemy(items,boxes,boxesNo,false,roomItems,gfx,gamemap); end; procedure talk( { in : person out : party, partyNo this lets you talk to the person in room and decides if there friendly, hostile or neutral. if there friendly all characters will join and if there hostile they will fight. } var items : itemsType; var partyNo : partyNoType; person : byte; var party : partyType; boxesNo : byte; var boxes : boxesType; var rules : rulesRec; weapons : weaponsType; var score : scoreType; var roomItems : roomItemsType ); var rnd : byte; action1 : byte; wait : char; {only testing} begin rnd := rnd_limits(1,100); with items[person] do if rnd in [1..friend] then {friendly} action1 := 1 else if rnd in [friend+1..friend+host+1] then {hostile} action1 := 2 else action1 := 3; {neutral} case action1 of {joined party} 1 : add_players(items,partyNo,party,boxes,boxesNo,person,rules,weapons,score,roomItems); 2 : begin writexy(3,1,items[person].name+' is hostile',445,msgcol); rules.hostile := true; end; 3 : begin writexy(3,1,items[person].name+' is neutral',445,msgcol); roomend := true; end; end; clrtext := true; end; procedure find_leaders( tmpPartyNo : byte; store : storeType; var n1,n2 : byte; onlyteam : boolean ); var a,b : byte; tmp : storeType; begin for a := 1 to tmpPartyNo do for b := a to tmpPartyNo do if store[a].strength > store[b].strength then begin tmp[a] := store[b]; store[b] := store[a]; store[a] := tmp[a]; end; {goes through sorted list and finds the 2 main fighters who are more to the right of weapons box. if there a 2 elf's for example and the main fighters are goblin and elf. The goblin could be a main fighters because of the weapons str.} if onlyteam then begin n1 := 1; for a := 1 to tmpPartyNo do with store[a] do if strength = store[tmpPartyNo].strength then if box3 > n1 then n1 := box3; if tmpPartyNo = 1 then begin n2 := n1; exit; end; n2 := 1; for a := 1 to tmpPartyNo do with store[a] do if strength = store[tmpPartyNo-1].strength then if n1 <> box3 then {does not include the first char} if box3 > n2 then n2 := box3; end else begin n1 := store[tmpPartyNo].box3; {top 2 highest enemy chars} n2 := store[tmpPartyNo-1].box3; end; end; procedure calc_fighters( { out: n1,n2 : byte postions of highest two party fighters in party range 1..7 } var items : itemsType; partyNo : partyNoType; party : partyType; weapons : weaponsType; var n1,n2 : byte ); var a,b : byte; store : storeType; begin for a := 1 to partyNo[P] do {calcs each players str + weapons str} with store[a] do {this is only temp} begin box3 := a; strength := 0; {item checked} inc(strength,items[party[P,a].num3].str1); if party[P,a].num3 in [1..4,7{1..2,4,6..7}] then {excluding wizard + sorceress} for b := 1 to MAXWEAPONS do if weapons[P,a,b] <> MAXITEMS then case weapons[P,a,b] of 15 : inc(strength,2); {magicsword} 17 : inc(strength); {helmet} end; end; find_leaders(partyNo[P],store,n1,n2,true); {finds 2 main fighters} end; procedure calc_enemy_str( var items : itemsType; boxesNo : byte; boxes : boxesType; var enemystr : byte; var battle : battleType ); var store : storeType; a : byte; Srange : byte; n1,n2 : byte; tmp1,tmp2 : byte; begin Srange := 0; for a := 1 to boxesNo do with items[boxes[a].no],store[a] do begin strength := str1; box3 := a; inc(Srange,range); end; find_leaders(boxesNo,store,n1,n2,false); with battle[2] do begin range2 := Srange; tmp1 := n1; tmp2 := n2; n1 := items[boxes[tmp1].no].str1; n2 := items[boxes[tmp2].no].str1; if boxesNo = 1 then begin str2 := n1; enemystr := n1+range2; end else begin str2 := n1+n2; enemystr := str2+range2; end; end; end; procedure calc_team_str( { out: teamstr and battle all players strength+range all weapons strength+range this procedure works out the first one. the calc_weapons_str1 works out the 2nd one. } var items : itemsType; partyNo : partyNoType; party : partyType; var teamstr : byte; var battle : battleType; weapons : weaponsType ); var n1,n2 : byte; Srange : byte; a : byte; begin calc_fighters(items,partyNo,party,weapons,n1,n2); Srange := 0; for a := 1 to partyNo[P] do {calcs teams range. excluding weapons range} inc(Srange,items[party[P,a].num3].range); with battle[1] do begin { clrwin(300,0,400,20); writeto(2,3,cv(n1)+SPC+cv(n2),300,0,9);} range2 := Srange; leader1 := n1; if partyNo[P] <> 1 then leader2 := n2 else leader2 := n1; n1 := items[party[P,leader1].num3].str1; {main fighters strength} n2 := items[party[P,leader2].num3].str1; if partyNo[P] = 1 then { calc str when only 1 person left } begin str2 := n1; {stores only str} teamstr := n1+range2; {stores str+range} end else begin str2 := n1+n2; teamstr := str2+range2; end; end; end; procedure type_of_speaker( boxesNo : byte; boxes : boxesType; var person : byte; num : byte ); var a : byte; tmp1, tmp2 : byte; begin if num = 9 then {checks for enemy or friendly char} begin tmp1 := 8; tmp2 := PPLNUM; end else begin tmp1 := 1; tmp2 := 7; end; person := 0; {picks the character to speak from order of items list} for a:= 1 to boxesNo do with boxes[a] do if (no in [tmp1..tmp2]) and enable1 then begin if no > person then person := no; {person here is old items.dat format} end; end; procedure choose_speaker( { 0 - adven, elf, troll etc 9 - mummy, ghosts etc} boxesNo : byte; boxes : boxesType; var person : byte; rules : rulesRec ); begin person := 0; if rules.ppl then {only lets characters speak including enemy} if rules.enemy then type_of_speaker(boxesNo,boxes,person,9) else type_of_speaker(boxesNo,boxes,person,0); end; procedure item_actions( boxes : boxesType; var action : actionType; var actionsNo : byte; boxesNo : byte); var a : byte; begin actionsNo := 0; for a := 1 to MAXBOX do with action[a] do begin act := ''; pos := 0; box2 := 0; type2 := 0; end; for a := 1 to boxesNo do with boxes[a] do if not onlyppl and enable1 and not (no in [21..23]) then begin inc(actionsNo); with action[actionsNo] do begin act := actnames[5]; pos := no; box2 := a; end; end; end; procedure weapon_actions( rules : rulesRec; var action : actionType; var actionsNo : byte; boxesNo : byte; boxes : boxesType; once : boolean ); var a : byte; tmp : array[1..4] of byte; sarcs : array[1..6] of byte; sarc_count : byte; begin sarc_count := 0; for a := 1 to 4 do tmp[a] := 0; for a := 1 to boxesNo do with boxes[a],rules do if enable1 then {item checked} begin if (no in [8,9]) and cross then {once} if not pickup then tmp[1] := a; if (no = 22) and sword then tmp[2] := a; if no = 21 then if {not once and }pickup or not ppl then { sarc } begin tmp[3] := a; inc(sarc_count); sarcs[sarc_count] := a; end; if potion then {once} if not pickup and ppl then {potion} tmp[4] := a; end; if tmp[1] <> 0 then begin inc(actionsNo); with action[actionsNo] do {cross} begin act := actnames[6]; pos := {19}18; box2 := tmp[1]; type2 := 3; end; end; if tmp[2] <> 0 then begin inc(actionsNo); with action[actionsNo] do {sword} begin act := actnames[7]; pos := 15; box2 := tmp[2]; type2 := 1; end; end; if tmp[3] <> 0 then for a := 1 to sarc_count do begin inc(actionsNo); with action[actionsNo] do {sarc} begin act := actnames[8]; pos := 21; box2 := sarcs[a]; type2 := 4; end; end; if tmp[4] <> 0 then begin inc(actionsNo); with action[actionsNo] do {potion} begin act := actnames[6]; pos := {18}20; box2 := tmp[4]; type2 := 2; end; end; end; procedure main_actions( var action : actionType; person : byte; var actionsNo : byte; roomItems : roomItemsType ); var n : byte; tmp : byte; begin {tests if the player has lost there +1 bonus for a room} if not roomItems[findroom(roomItems,Xpos,Ypos)].bonus1[P] then tmp := 1 {attack and retreat} else tmp := 2; {attack, talk and retreat} actionsNo := 0; for n := 1 to {2}tmp do begin inc(actionsNo); with action[n] do begin act := actnames[n]; pos := person; type2 := 0; {fixes bug} end; end; end; procedure endturn_actions( var actionsNo : byte; var action : actionType ); begin inc(actionsNo); with action[actionsNo] do begin act := actnames[4]; pos := MAXITEMS; end; end; procedure retreat_actions( var actionsNo : byte; var action : actionType ); begin inc(actionsNo); with action[actionsNo] do begin act := actnames[3]; pos := MAXITEMS; end; end; procedure reduce_actions( choice : byte; var actionsNo : byte; var action : actionType ); var a : byte; begin for a := choice to actionsNo do action[a] := action[a+1]; dec(actionsNo); end; procedure rnd_move_after_timeout( actionsNo : byte; var choice : byte; rules : rulesRec; var endnum : byte; action : actionType; var items : itemsType; var timeout : boolean ); begin if actionsNo = 1 then {if the only action is end turn} choice := 1 else if roomend then {if character is neutral and the actions attack and talk are still displayed} choice := actionsNo else if not rules.ppl and rules.items1 then {if no characters and only items} choice := 1 {starts at the first items} else choice := rnd_limits(1,2); {random attack or talk} endnum := actionsNo; comp := true; {activates computer, to finish of anything else in the room} timeout := true; writeto(5,2,cv(choice)+'..'+action[choice].act+SPC+items[action[choice].pos].name,5,186+(choice*20)-20,cpuHighlight); delay(300); end; procedure prevent_retreat( rules : rulesRec; var players : playersType; var key : char; actionsNo : byte ); var ch : char; {temporary} begin {retreat button has been pressed. retreat sequence step 2. loops the gamemap again with the same player (P)} if (key = chr(actionsNo+49-1)) and rules.ppl and (retreat <> 2) then {avoid when its end turn} begin {if the previous postion is the same as the current then this prevents a retreat} with players[P] do if (Xpos = s_saveX) and (scrX = s_scrX) and (Ypos = s_saveY) and (scrY = s_scrY) then begin {clear_bottom_text;} writexy(3,1,'You can''t retreat',445,msgcol); display_time_delay(ch,1000); clear_bottom_text; key := #1 {the #1 is to loop again and the user needs to attack or talk} end else retreat := 1; {retreats} end; end; procedure drop_items( var weapons : weaponsType; var roomItems : roomItemsType; x3,y3 : byte; var boxes : boxesType; var items : itemsType; party : partyType; roomtype : byte; rules : rulesRec; boxesNo : byte; var gamemap : gamemapType; var gfx : gfxType ); var num,a : byte; x1,y1 : integer; error : boolean; begin {errors are listed in ascending priority} num := calc_boxesNo(roomItems,roomNo); {find number of items in current room} error := false; if (Xpos = STARTX) and (Ypos = STARTY) {can't drop items on first tile} and (scrX = 0) and (scrY = 0) then error := true; if gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)].type1 <> 3 then {error if square is not a room} error := true; {error if there's ppl in the room} if {not rules.pickup}rules.ppl and {(roomtype = 3)}(gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)].type1 = 3) then error := true; if error then begin clear_bottom_text; writexy(3,1,'You are not allowed to drop items here',445,msgcol); drop_item_error_sound; clrtext := true; exit; end; if weapons[P,x3,y3] = MAXITEMS then {error if block is empty} begin drop_item_error_sound; exit; end; if num >= MAXBOX then {error, 6 items is the max for each room} begin drop_item_error_sound; exit; end; if num <= MAXBOX then begin clear_weight(weapons,x3,x3); {clears current cell} clear_weapons(weapons,x3,x3); roomItems[roomNo].itemNo[num+1] := weapons[P,x3,y3]; {updates room items on screen} boxes[num+1].no := weapons[P,x3,y3]; {updates boxes in room} (*weapons[P,x3,y3] := MAXITEMS; {updates weapons box}*) boxes[num+1].enable1 := true; for a := y3 to MAXWEAPONS do {sorts the source column} begin if weapons[P,x3,a] = MAXITEMS then break; weapons[P,x3,a] := weapons[P,x3,a+1]; end; (* weapons[P,{savex1}x3,MAXWEAPONS] := MAXITEMS; {source column}*) display_weapons(items,weapons,x3,x3); {displays text} display_weight(items,weapons,party,x3,x3); display_enemy(items,boxes,boxesNo,false,roomItems,gfx,gamemap); {displays new item in the box} menu_click_sound; end; end; procedure edit_weapons_highlight( {1st part of edit weapons} {used in select number and wait_for_move} savex1, savey1 : byte; var items : itemsType; weapons : weaponsType; party : partyType; partyNo : partyNoType; swap_item : boolean ); begin display_marker(tablecur,x3,y3); {display marker} if swap_item then {highlights box when return is pressed} display_marker(cLIGHTBLUE,savex1,savey1); display_weapons(items,weapons,1,partyNo[P]); {displays text} display_weight(items,weapons,party,1,partyNo[P]); end; procedure edit_weapons( {2nd part of edit weapons} {used in select number and wait_for_move} key : char; {also passes through GMkey} var weapons : weaponsType; var savex1, savey1 : byte; var items : itemsType; partyNo : partyNoType; party : partyType; var swap_item : boolean; var roomItems : roomItemsType; var boxes : boxesType; roomtype : byte; rules : rulesRec; {if not used in drop items then remove} boxesNo : byte; var gamemap : gamemapType; var gfx : gfxType ); var total : byte; a : byte; begin if not (upcase(key) in ['Q','W','A','S']) then {the if statement prevents clearing the box, during a move} display_marker(table,x3,y3); {clears marker} case upcase(key) of LT : dec(x3); RT : inc(x3); UP : dec(y3); DN : inc(y3); 'D' : drop_items(weapons,roomItems,x3,y3,boxes,items,party,roomtype,rules,boxesNo,gamemap,gfx); SP : if not swap_item and (weapons[P,x3,y3] <> MAXITEMS) then {first time} begin swap_item := true; savex1 := x3; {saves highlighted position} savey1 := y3; end else if swap_item then begin {already highlighted} total := 0; for a := 1 to MAXWEAPONS do {adds the weight of all items in 1 char} inc(total,items[weapons[P,x3,a]].weight); if (x3 = savex1) and (y3 = savey1) then {turns off highlight if pressed return on same square} begin display_marker(table,x3,y3); {clears marker} swap_item := false; end else if (total >= items[party[P,x3].num3].weight) and {checks weight against character} (items[weapons[P,savex1,savey1]].weight <> 0) then {check if weight or non-weight} begin if soundOnOff = 1 then item_too_heavy_sound; end else begin {character has enough space for item} swap_item := false; clear_weight(weapons,savex1,savex1); {clears previous cell} clear_weapons(weapons,savex1,savex1); clear_weight(weapons,x3,x3); {clears current cell} clear_weapons(weapons,x3,x3); for a := 1 to MAXWEAPONS do {find box in destination column} if weapons[P,x3,a] = MAXITEMS then begin weapons[P,x3,a] := weapons[P,savex1,savey1]; {swaps item} break; end; for a := savey1 to MAXWEAPONS do {sorts the source column} begin if weapons[P,savex1,a] = MAXITEMS then break; weapons[P,savex1,a] := weapons[P,savex1,a+1]; end; weapons[P,savex1,MAXWEAPONS] := MAXITEMS; {source column} end; end; end; limits(x3,1,partyNo[P],false); limits(y3,1,MAXWEAPONS,false); end; procedure select_number( actionsNo : byte; var choice : byte; var endnum : byte; var enemystr, teamstr : byte; var items : itemsType; var action : actionType; rules : rulesRec; var timeout : boolean; var players : playersType; var weapons : weaponsType; partyNo : partyNoType; party : partyType; var roomItems : roomItemsType; var boxes : boxesType; roomtype : byte; boxesNo : byte; var gamemap : gamemapType; var gfx : gfxType ); var key : char; start : char; ch : char; {edit weapons variables} savex1, savey1 : byte; {source box} swap_item : boolean; begin {This lets me hold down return on the single games and stops when a certain item is found. LOOK has to be true and set the item with TESTITEM. only for testing} { if LOOK and tmptest then begin writeto(5,2,'press A',550,1,cWHITE); sound(220); delay(100); nosound; repeat getkey(key) until key = A_KEY; clrwin(550,0,605,20); tmptest := false; end;} if roomend then {finds the start of actions, for the repeat loop below} start := chr(actionsNo+49-1) else start := '1'; clr_keyboard_buffer; savex1 := x3; {these 3 are used with edit weapons} savey1 := y3; swap_item := false; repeat edit_weapons_highlight(savex1,savey1,items,weapons,party,partyNo,swap_item); clr_keyboard_buffer; display_time_readkey(key); exit_game_prompt(key,ch); if upcase(ch) = 'N' then begin ch := #1; {if user presses No. The #1 is to keep in the loop} key := #1; end; if key = #0 then {if no key is pressed then sets key to #0} begin {to activate the comp} rnd_move_after_timeout(actionsNo,choice,rules,endnum,action,items,timeout); display_marker(table,x3,y3); {clears marker} break; end; {when using this fix the CR in the until loop below} (* if key = '0' then {pressing 0 increases the enemies str, for testing} inc(enemystr,15); if key = '9' then {pressing 0 increases the enemies str, for testing} inc(teamstr,15); if key = CR then {test, pressing RETURN in a room skips talking or attacking} roomend := true; {this also creates a bug when pressed more than once} *) prevent_retreat(rules,players,key,actionsNo); edit_weapons(key,weapons,savex1,savey1,items,partyNo,party,swap_item,roomItems,boxes,roomtype,rules,boxesNo,gamemap,gfx); until key in [start..chr(actionsNo+49-1){,CR}{test},ESC]; {prevents clearing this text when the move is taken} display_weapons(items,weapons,1,partyNo[P]{7}); display_weight(items,weapons,party,1,partyNo[P]{7}); if soundOnOff = 1 then menu_click_sound else if not demo then delay(20); if clrtext then begin clear_bottom_text; clrtext := false; end; if gameover then exit; if key <> #0 then begin endnum := actionsNo; choice := ord(key)-48; end; end; procedure cpu_use_weapons( var choice : byte; var action : actionType; var quit : boolean; var items : itemsType ); var wait : char; begin quit := false; if action[3].type2 in [1..4] then begin { the choice 3 is used with the sword,sarc and cross. if 2 or 3 of them appear then pressing number 3 would use then. this is because the way actions are removed} choice := 3; (*if (action[3].type2 = 2) and (person in [8..PPLNUM]) then {attack or retreat against ghost or mummy} begin if teamstr+3 >= enemystr then choice := 3 else begin action[3].type2 := 0; choice := 1; end; end;*) if {choice <> 1}action[3].type2 <> 2 then begin quit := true; writeto(5,2,cv(choice)+'..'+action[choice].act+SPC+items[action[choice].pos].name,5,186+(choice*20)-20,cpuHighlight); display_time_delay(wait,msgpause); if soundOnOff = 1 then menu_click_sound; exit; end else begin action[3].type2 := 0; choice := 1; end; end; end; procedure party_less_than_7_chars( var roomItems : roomItemsType; var choice : byte; person : byte; teamstr, enemystr : byte ); begin with roomItems[findroom(roomItems,Xpos,Ypos)] do if person in [1..7] then {talk} begin choice := 2; {always talks, no matter what talk1[P] is} if (talk1[P] <> 99) and (talk1[P] <> 98) then {talk} begin inc(talk1[P]); {old items.dat, item checked} case person of {the number of times the comp talks to the character} 1 : if talk1[P] >= 3 then talk1[P] := 98; {Dwarf} 2 : if talk1[P] >= 3 then talk1[P] := 98; {Goblin} 3 : if talk1[P] >= 4 then talk1[P] := 98; {Adventurer} 4 : if talk1[P] >= 4 then talk1[P] := 98; {Elf} 5 : if talk1[P] >= 3 then talk1[P] := 98; {Sorceress} 6 : if talk1[P] >= 4 then talk1[P] := 98; {Wizard} 7 : if talk1[P] >= 4 then talk1[P] := 98; {Troll} end; {while talking to ex. elf. if your team is stronger than the enemies team then the team will attack on the 4th try. if your team is weaker then you will leave the room after the 4th try} if talk1[P] = 98 then {no more talking, either attack or leave room} begin if teamstr{+5} >= enemystr then talk1[P] := 98 {stay and attack. loops the code and then runs the below code} else talk1[P] := 99; {leave room} end; end; if talk1[P] = 98 then {no more speaking and attack since your team is stronger} begin choice := 1; {attack} talk1[P] := 99; {leave room} end; end; end; procedure cpu_actions( var choice : byte; endnum : byte; person : byte; teamstr, enemystr : byte; partyNo : partyNoType; rules : rulesRec; var exit1 : boolean; var roomItems : roomItemsType ); begin if exit1 then exit; if (partyNo[P] = MAXTEAM) or {this is what happens when team has 7 chars} ((not roomItems[findroom(roomItems,Xpos,Ypos)].bonus1[P]) and rules.ppl) then {or when player has lost bonus for the room} begin if teamstr+5 >= enemystr then choice := 1 else begin if roomItems[findroom(roomItems,Xpos,Ypos)].retreat1[P] >= 1 then choice := 1 {retreated already so just attack} else begin choice := endnum; {clear_bottom_text;} clrtext := true; writexy(3,1,'Retreat',445,msgcol); retreat := 1; inc(roomItems[findroom(roomItems,Xpos,Ypos)].retreat1[P]); end; end; exit; end; party_less_than_7_chars(roomItems,choice,person,teamstr,enemystr); if person in [8..PPLNUM] then {attack or retreat against ghost or mummy} begin if teamstr+5 >= enemystr then choice := 1 {attack} else begin if roomItems[findroom(roomItems,Xpos,Ypos)].retreat1[P] >= 1 then choice := 1 {retreated once already so just attack} else begin choice := endnum; { clear_bottom_text;} clrtext := true; writexy(3,1,'Retreat',445,msgcol); retreat := 1; inc(roomItems[findroom(roomItems,Xpos,Ypos)].retreat1[P]); end; end; end; if not rules.items1 then {ends the room on next turn when no items} exit1 := true; end; procedure cpu_pickup_items( var choice : byte; endnum : byte; rules : rulesRec; var exit1 : boolean ); begin if {third}rules.pickup{ (not once)} or (not rules.ppl) then begin if tmp3 = 1 then choice := 1; if itemsmax then {if weapons full, then go onto next weapon} begin inc(tmp3); itemsmax := false; choice := tmp3; end; if (choice{+1} >= endnum) then {take +1 out} exit1 := true; {when all weapons are picked up then endturn} end; end; procedure computer_move( { this procedure does 1 item at a time and is looking for a number for choice. there is only the 1 pause and is similar to the pause in select number. exit1 tells comp to endturn next time around. when command choice := endnum happens, it ends the room straight away } actionsNo : byte; var choice : byte; var endnum : byte; person : byte; teamstr, enemystr : byte; partyNo : partyNoType; rules : rulesRec; var action : actionType; var exit1 : boolean; var items : itemsType; var roomItems : roomItemsType ); var wait : char; quit : boolean; begin endnum := actionsNo; if exit1 or roomend then {this is when comp is finished and will do endturn} begin choice := endnum; writeto(5,2,cv(choice)+'..'+action[choice].act+SPC+items[action[choice].pos].name,5,186+(choice*20)-20,cpuHighlight); display_time_delay(wait,msgpause); if soundOnOff = 1 then menu_click_sound; exit; end; cpu_use_weapons(choice,action,quit,items); if quit then exit; cpu_actions(choice,endnum,person,teamstr,enemystr,partyNo,rules,exit1,roomItems); cpu_pickup_items(choice,endnum,rules,exit1); {If I change the X and Y then change here rnd_move_after_timeout} writeto(5,2,cv(choice)+'..'+action[choice].act+SPC+items[action[choice].pos].name,5,{175}186+(choice*20)-20,cpuHighlight); display_time_delay(wait,msgpause); if soundOnOff = 1 then menu_click_sound; if clrtext then begin clear_bottom_text; clrtext := false; end; end; procedure check_non_weight_items( partyNo : partyNoType; var weapons : weaponsType; action : actionType; choice : byte; var errmsg : byte; var s,t : integer); var a,b : byte; begin {tests for spaces for items which don't weigh. these type of items can go into any box} errmsg := 1; for a := 1 to partyNo[P] do for b := 1 to MAXWEAPONS do if weapons[P,a,b] = MAXITEMS then begin weapons[P,a,b] := action[choice].pos; {stores weapon} errmsg := 0; s := a; t := b; exit; end; end; procedure check_weight_items( var items : itemsType; action : actionType; choice : byte; party : partyType; var weapons : weaponsType; partyNo : partyNoType; var errmsg : byte; var s,t : integer ); var total : integer; count : byte; a : byte; next : byte; ok : boolean; space : boolean; begin {tests for spaces for items which weigh ie gold silver chest} space := false; count := 0; {count through the 5 weapons rows} next := 1; {the next character} ok := false; errmsg := 0; repeat total := 0; for a := 1 to MAXWEAPONS do {adds the weight of all items in 1 char} inc(total,items[weapons[P,next,a]].weight); for a := 1 to MAXWEAPONS do if weapons[P,next,a] = MAXITEMS then space := true; if (total+items[action[choice].pos].weight > items[party[P,next].num3].weight) or (not space) then {tests if total is stronger than char weight} begin inc(next); count := 0; end else begin {available box in characters column} repeat inc(count); until weapons[P,next,count] = MAXITEMS; {finds an available box 4 item} weapons[P,next,count] := action[choice].pos; {stores weapon} s := next; t := count; ok := true; end; if next > partyNo[P] then {test goes onto next player} begin errmsg := 1; ok := true; end; until ok; end; procedure add_weapons( var items : itemsType; var weapons : weaponsType; var boxes : boxesType; var action : actionType; var actionsNo : byte; choice : byte; party : partyType; partyNo : partyNoType; var roomItems : roomItemsType ); var x,y,s,t : integer; errmsg : byte; begin clear_weight(weapons,1,partyNo[P]); if items[action[choice].pos].weight = 0 then check_non_weight_items(partyNo,weapons,action,choice,errmsg,s,t) else check_weight_items(items,action,choice,party,weapons,partyNo,errmsg,s,t); display_weight(items,weapons,party,1,partyNo[P]); if errmsg = 1 then begin writexy(3,1,'Item too heavy',445,msgcol); clrtext := true; itemsmax := true; { roomend := true;} end else begin getweaponsXY(x,y,s,t,false); {writes weapons to screen} writeto(5,2,items[weapons[P,s,t]].name,x,y,itemscol); boxes[action[choice].box2].enable1 := false; {clears item from box} roomItems[roomNo].itemNo[action[choice].box2] := MAXITEMS; getboxXY(x,y,action[choice].box2); { fill_window(outline,fx,boxcol,x+5,y+5);} fill_window(outline,{fx}0,{boxcol}2,x+5,y+5); reduce_actions(choice,actionsNo,action); end; end; procedure weapons_action_clear( { num1,num2 : 22 for webs. 8..9 for ghosts+skeletons} var boxes : boxesType; boxesNo : byte; num1, num2 : byte; var score : scoreType; var items : itemsType; var roomItems : roomItemsType ); var a : byte; x,y : integer; begin for a := 1 to boxesNo do {checks for all skeletons and webs to clear} with boxes[a] do if no in [num1,num2] then {item checked} begin getboxXY(x,y,a); {fill_window(outline,fx,boxcol,x+5,y+5);} fill_window(outline,{fx}1,{boxcol}2,x+5,y+5); if no in [8,9] then {item checked} inc(score[P],items[no].str1); no := MAXITEMS; {clears skeleton+ghosts+webs details from boxes attribs} enable1 := false; onlyppl := false; roomItems[roomNo].itemNo[a] := MAXITEMS; if num1 = 22 then {clears giant web} with roomItems[roomNo] do begin trap[3] := 0; {these 2 are for roomItems} trap[4] := 0; {I don't really need this line} end; end; end; (*procedure test_item(boxesNo : byte; boxes : boxesType); var a : byte; num : byte; begin num := 0; tmptest := false; for a := 1 to boxesNo do with boxes[a] do if no in [TESTITEM] then begin {inc(num); if num >= 3 then} tmptest := true; end; end;*) procedure enemy_hostile( var items : itemsType; var partyNo : partyNoType; var party : partyType; teamstr, enemystr : byte; var rules : rulesRec; var boxesNo : byte; var boxes : boxesType; var weapons : weaponsType; battle : battleType; var score : scoreType; var roomItems : roomItemsType; var gfx : gfxType; var gamemap : gamemapType ); var wait : char; begin if rules.hostile then begin display_time_delay(wait,msgpause); if gameover then exit; rules.hostile := false; attack ( items,partyNo,party,teamstr,enemystr,-1,rules,boxesNo,boxes,weapons, battle,score,roomItems,gfx,gamemap ); end; end; procedure enemy_details_after_cross( var items : itemsType; boxesNo : byte; boxes : boxesType; var person : byte; var rules : rulesRec; var third : boolean; var enemystr : byte; var battle : battleType ); var n : byte; tmp : boolean; begin { clear_actions;} tmp := false; for n := 1 to boxesNo do {after using cross, checks for only items} if boxes[n].onlyppl then tmp := true; if not tmp then {if only items then tells program theres only items} begin rules.ppl := false; rules.enemy := false; rules.pickup := true; exit; end; for n := 1 to boxesNo do {checks for mummy to speak to} { if boxes[n].enable1 then} if boxes[n].no = 10 then rules.enemy := true else rules.enemy := false; third := true; calc_enemy_str(items,boxesNo,boxes,enemystr,battle); if person <> 10 then choose_speaker(boxesNo,boxes,person,rules); end; procedure mummy_hostile( var items : itemsType; var partyNo : partyNoType; var party : partyType; teamstr : byte; var rules : rulesRec; var boxesNo : byte; var boxes : boxesType; action : actionType; choice : byte; actionsNo : byte; var weapons : weaponsType; battle : battleType; var score : scoreType; var roomItems : roomItemsType; var gfx : gfxType; var gamemap : gamemapType ); var x,y : integer; wait : char; tmp : byte; x1,y1 : integer; begin getboxXY(x,y,action[choice].box2); clrwin(x+2,y+2,x+124,y+99); fill_window(outline,1,boxcol,x+5,y+5); {clears box with yellow colour} {not item checked. the 10 has nothing to do with item number} display_items(items,action[choice].box2,boxesNo,boxes,10,false,roomItems,tmp,gamemap); getboxXY(x1,y1,action[choice].box2); {find x1 & y1 for the next line} display_item_gfx(10,50,75,gfx,x1+75,y1+5); {item checked} { clear_bottom_text;} writexy(3,1,'Mummy is hostile',445,msgcol); display_time_delay(wait,msgpause); if gameover then exit; with boxes[action[choice].box2] do {changes from sarc to mummy} begin onlyppl := true; type1 := 9; end; roomItems[roomNo].itemNo[action[choice].box2] := 10; {changes to mummy} with battle[2] do {sets str for the mummy} begin str2 := 7; range2 := 0; end; {if theres a character in the room with the sarc and the user wins the battle. the user will have a +1 bonus when fighting the mummy in the sarc. if the battle is lost then the +1 bonus is lost when fighting the mummy} attack ( items,partyno,party,teamstr,7,{0}1,rules,boxesNo,boxes,weapons,battle,score,roomItems,gfx,gamemap ); if gameover then exit; if battlewon then begin getboxXY(x,y,action[choice].box2); {shades box when defeating mummy} { fill_window(outline,fx,boxcol,x+5,y+5);} fill_window(outline,{fx}1,{boxcol}2,x+5,y+5); boxes[action[choice].box2].enable1 := false; battlewon := false; roomItems[roomNo].itemNo[action[choice].box2] := MAXITEMS; end; end; procedure pickup_gems( var items : itemsType; var boxes : boxesType; var twice : boolean; action : actionType; choice : byte; boxesNo : byte; var roomItems : roomItemsType; var gfx : gfxType; var gamemap : gamemapType ); var x,y : integer; tmp : byte; x1,y1 : integer; begin getboxXY(x,y,action[choice].box2); {clears box with yellow colour} clrwin(x+2,y+2,x+124,y+99); fill_window(outline,1,boxcol,x+5,y+5); {not item checked. the 12 has nothing to do with item number} display_items(items,action[choice].box2,boxesNo,boxes,12,false,roomItems,tmp,gamemap); getboxXY(x1,y1,action[choice].box2); {find x1 & y1 for the next line} display_item_gfx(12,50,75,gfx,x1+75,y1+5); {item checked. displays item in box} twice := false; with boxes[action[choice].box2] do {you dont have to clear actions} begin onlyppl := false; type1 := 0; no := {11}12; {turns to gems} {item checked} end; roomItems[roomNo].itemNo[action[choice].box2] := {11}12; end; procedure remove_potion( var items : itemsType; var weapons : weaponsType; partyNo : partyNoType; party : partyType ); var a,b,c : byte; begin for a := 1 to partyNo[P] do for b := 1 to MAXWEAPONS do if weapons[P,a,b] = {18}20 then {item checked} begin clear_weight(weapons,a,a); clear_weapons(weapons,a,a); for c := b to MAXWEAPONS do weapons[a,c] := weapons[a,c+1]; weapons[P,a,MAXWEAPONS] := MAXITEMS; display_weapons(items,weapons,a,a); display_weight(items,weapons,party,a,a); exit; end; end; procedure calc_weapons_str( { this procedure calcs all weapons str and range out: battle and teamstr wizards+sorceress only get the magicstaff and they dont get any other weapon. helmets+magicswords only work on main fighters. magicbows are range for the rest of party. excluding wizards+sorceress. 1-4 elf 5-6 wizard 7 troll 15 magicsword 16 magicbow 17 helmet 19 magicstaff } weapons : weaponsType; party : partyType; partyNo : partyNoType; var battle : battleType; var teamstr : byte ); var a,b : byte; n1,n2 : byte; begin if partyNo[P] = 1 then battle[1].leader2 := battle[1].leader1; for a := 1 to partyNo[P] do for b := 1 to MAXWEAPONS do if weapons[P,a,b] <> MAXITEMS then {item checked} begin n1 := 0; n2 := 0; {n1 is strength and n2 is range} if party[P,a].num3 in [5..6{3,5}] then {looking for wizard+sorceress} if weapons[P,a,b] = {16}19 then n2 := 2; {magicstaff} if party[P,a].num3 in [1..4,7{1..2,4,6..7}] then {apart from wizard+sorceress} begin if weapons[P,a,b] = {14}16 then {magicbow} n2 := 1; {looking in main leaders} if a in [battle[1].leader1,battle[1].leader2] then if weapons[P,a,b] in [15,17] then case weapons[P,a,b] of 15 : n1 := 2; {magicsword} 17 : n1 := 1; {helmet} end; end; with battle[1] do {adds all weapons str+range onto the party's} begin {str+range worked out on calc_team_str1} inc(str2,n1); inc(range2,n2); inc(teamstr,n1+n2); end; end; end; procedure init_hiscore( var hi_score : hi_scoreType ); var count : word; e,f : byte; begin count := 500; for e := 1 to MAX_HI_SCORE do with hi_score[e] do begin hiname := ' '; hiscore := 0; for f := 1 to 3 do hiname[f] := chr(65+e-1); hiscore := count; dec(count,50); position := e; end; end; procedure read_hi_score_from_disk( var hi_score : hi_scoreType ); var F : file of hi_scoreRec; i : byte; begin assign(F,'hi_score.dat'); {$I-} reset(F); {$I+} if IOresult <> 0 then init_hiscore(hi_score) else begin for i := 1 to MAX_HI_SCORE do read(F,hi_score[i]); close(F); end; end; procedure write_hi_score_to_disk( hi_score : hi_scoreType ); var F : file of hi_scoreRec; i : byte; begin assign(F,'hi_score.dat'); {$I-} rewrite(F); {$I+} for i := 1 to MAX_HI_SCORE do write(F,hi_score[i]); close(F); end; procedure clear_hi_score( var hi_score : hi_scoreType; menu : byte ); var a : byte; begin if menu = 0 then {only lets you clear hi-score on main menu} begin init_hiscore(hi_score); write_hi_score_to_disk(hi_score); for a := 1 to 5 do {flashes background} begin SetBkColor(rnd_limits(1,{7}255)); delay(20); end; setbkcolor(bkcol); end; end; procedure sort_hiscore( var hi_score : hi_scoreType ); var a,b : byte; tmp : hi_scoreType; begin for a := 1 to MAX_HI_SCORE do for b := a to MAX_HI_SCORE do if hi_score[a].hiscore < hi_score[b].hiscore then begin tmp[a] := hi_score[b]; hi_score[b] := hi_score[a]; hi_score[a] := tmp[a]; end; end; procedure enter_hiscore( var hi_score : hi_scoreType; score : scoreType; maxplayer : byte; players : playersType ); type listRec = RECORD x,y : word; END; const list : array [1..26] of listRec = ((x: 195; y: 95), (x: 218; y: 81), (x: 247; y: 65), (x: 278; y: 57), (x: 310; y: 55), (x: 343; y: 57), (x: 370; y: 67), (x: 402; y: 87), (x: 437; y: 115), (x: 450; y: 146), (x: 455; y: 190), (x: 457; y: 232), (x: 440; y: 277), (x: 410; y: 310), (x: 383; y: 332), (x: 350; y: 350), (x: 313; y: 353), (x: 276; y: 353), (x: 244; y: 343), (x: 213; y: 327), (x: 184; y: 298), (x: 164; y: 263), (x: 155; y: 225), (x: 158; y: 188), (x: 162; y: 152), (x: 177; y: 123)); var count,col : byte; key : char; a : byte; tmpstr : string;{[3]} position : byte; column : word; begin if (score[maxplayer] > hi_score[10].hiscore) {checks if highest scorer is in table} and (players[maxplayer].playerType <> 2) then {excludes all comp players} begin cleardevice; writexy(4,1,'Player '+cv(maxplayer)+' has a hi-score',0,{3}txt5); { writexy(4,1,'Please enter your name',0,3);} tmpstr := ''; position := 0; column := 0; { start := 250;} count := 1; repeat for a := 1 to 26 do {used circle(getmaxx div 2,getmaxy div 2,150);} with list[a] do begin if count = a then {highlights letter} col := {10}highlight1 else col := {9}normal1; writeto(4,8,chr(a+64),x,y,col); end; getkey(key); case key of LT : dec(count); RT : inc(count); CR : begin { 180 is where the letter X is and 455 is where letter K is. 276 is the length from letter X to letter K} {putpixel(180,220,7); putpixel(455,220,7);} SetTextStyle(8, HorizDir, 7); inc(position); {onto next letter} {clears previous letter} clrwin(column,175,column+(textwidth(tmpstr)),275); tmpstr := concat(tmpstr,chr(count+64)); column := (180+(276 div 2)) - (textwidth(tmpstr) div 2); writeto(7,8,tmpstr,column,175,{11}initials); if position >= 3 then {3 letters is the max} break; end; BS : if position >= 1 then begin SetTextStyle(8, HorizDir, 7); clrwin(column,175,column+(textwidth(tmpstr)),275); delete(tmpstr,position,1); column := (180+(276 div 2)) - (textwidth(tmpstr) div 2); writeto(7,8,tmpstr,column,175,{11}initials); dec(position); end; end; { clrwin(0,0,180,30); writeto(3,3,tmpstr,0,0,6);} limits(count,1,26,true); until key = ESC; if key <> ESC then delay(2000); with hi_score[10] do begin hiname := tmpstr; hiscore := score[maxplayer]; end; end; end; procedure display_hiscore( hi_score : hi_scoreType ); const X1 = 270; X2 = 350; Y1 = 150; var e,rnd : byte; ok : boolean; h,m,s,hund : word; savesecs : word; endsecs : word; first : boolean; key : char; begin gettime(h,m,s,hund); savesecs := s; takeaway_60secs(savesecs,endsecs); {finds end seconds} cleardevice; writexy(5,3,'Hi-Score Table',35,{14}title1); writeto(3,3,'Pos',X1-60,100,{13}heading1); writeto(3,3,'Name',X1,100,{13}heading1); writeto(3,3,'Score',X2,100,{13}heading1); first := true; ok := false; while not ok do begin for e := 1 to MAX_HI_SCORE do with hi_score[e] do begin rnd := rnd_limits({2}33,{15}255); writeto(2,3,cv(e)+'.',X1-60,Y1+(e*25)-25,{10}rnd); writeto(2,3,hiname,X1,Y1+(e*25)-25,{12}rnd); writeto(2,3,cv(hiscore),X2,Y1+(e*25)-25,{11}rnd); if not first then {displays the whole hi-score at the start} delay(100); end; first := false; gettime(h,m,s,hund); if s = endsecs then {quits the menu after 10secs} ok := true; if keypressed then begin getkey(key); if key = ESC then {pressing escape returns to the menu} ok := true; clr_keyboard_buffer; end; end; end; procedure display_menu_title; const list : array [1..13] of word = {1-8 for 'Treasure' and 9-13 for 'Crypt'} (195,226,264,310,335,364,401,428,237,283,314,347,392); var a : byte; m : shortint; begin cleardevice; for m := -11 to -9 do writexy(5,10,'Treasure',m,{12}outline2); for m := 54 to 56 do writexy(5,10,'Crypt',m,{12}outline2); SetFillStyle(1,{14}titlefill); for a := 1 to 8 do {fills treasure text} floodfill(list[a],49,outline2); for a := 9 to 13 do {crypt text} floodfill(list[a],112,outline2); end; procedure timer( var done : boolean; var row : byte ); var ok : boolean; h,m,s,hund : word; savesecs : word; endsecs : word; begin { done := false;} gettime(h,m,s,hund); savesecs := s; takeaway_60secs(savesecs,endsecs); {finds end seconds} ok := false; while not ok do begin gettime(h,m,s,hund); if s = endsecs then begin row := 0; {this will change to option 0} done := true; exit; end; if keypressed then begin done := false; exit; end; end; end; procedure init_startup( {before main menu} var options : optionsRec; var finish : boolean; var menucnt : byte ); begin nosound; setbkcolor(bkcol); {3,6,10,14} randomize; with options do begin {options menu} timeno := 60; speedno := 2; soundNo := 1; demono := 1; {game menu} playersNo := 2{1}; {i.e. 1,2,3 or 4 Player game} gameNo := 3; {1 for human...2 for comp...3 for mixed game} typeNo := 6; {i.e. 1P+1cpu} end; finish := false; menucnt := 0; end; procedure init_start_game( {on main menu and before actual game begins} var options : optionsRec; var row : byte; var done : boolean ); begin {some of these are global variables} secs := options.timeno; {next 3 variables are for the timeout} msgpause := 1500; comp := false; {set comp here. for when timeout uses comp} row := 1; retreat := 2; {end turn} done := false; demo := false; {demo is off and display is on} gametype := 1; {sets to game mode. 0 for demo, 1 for game} end; procedure display_options ( num,x : byte; options : optionsRec; menu : byte ); const OnOffTxt : array[0..1] of string[3] = ('Off','On'); SpeedTxt : array[1..3] of string[6] = ('Slow','Medium','Fast'); TypeTxt : array[1..3] of string[5] = ('Human','Cpu','Mixed'); GameTxt : array[1..7] of string[7] = ('3P+1CPU','2P+2CPU','1P+3CPU','2P+1CPU','1P+2CPU','1P+1CPU','1P+0CPU'); var col : byte; begin if (menu = 2) and (options.gameNo = 3) then col := optionscol else col := {8}cDARKGRAY; {grays the game option when not on mixed type} if (num = 3) and (menu = 2) then setcolor(col) else setcolor(optionscol); settextstyle(3,0,4); moveto(410-x,180+(num*45)-45); with options do case menu of 1 : case num of {options menu} 1 : outtext(SpeedTxt[speedno]); 2 : outtext(cv(timeno)+'secs'); 3 : outtext(OnOffTxt[soundno]); 4 : outtext(OnOffTxt[demono]); end; 2 : case num of 1 : outtext(cv(playersNo)+' Player'); 2 : outtext(TypeTxt[gameNo]); 3 : outtext(GameTxt[typeNo]); end; end; end; procedure main_menu( var row : byte; {row is the option in main menu} max : byte; {max number of options} menu_names : namesType; {the names of the options} var done : boolean; {done is when the main menu quits} var options : optionsRec; menu : byte; {0 for main menu...1 for options menu...2 game menu} var hi_score : hi_scoreType ); var key : char; size : byte; col,a : byte; tmp : byte; save : byte; x : byte; loop : boolean; Slimit, Elimit : byte; begin clrwin(260,180,412,460); size := 4; {font size} col := 9; loop := false; if menu in [1,2] then {when menu is options or game menu} begin row := 1; {starts off on the 1st row in the options menu} x := 70; {moves the options menu text to the right} for a := 1 to 4 do display_options(a,x,options,menu); end else begin x := 0; {keeps the main menu text in the centre} clr_keyboard_buffer; {only for the start of the main menu} end; repeat {clears smaller text} if (key = UP) or (key = DN) then clrwin(260-x,180+(row*45)-45,365-x,180+(row*45)-45+39); for a := 1 to max do begin if a = row then {makes text at cursor bigger} begin size := 5; {font size} col := highlight; tmp := 9; end else begin size := 4; col := normal; tmp := 0; end; setcolor(col); settextstyle(3,0,size); outtextxy(260-x,180+(a*45)-45-tmp,menu_names[a]); save := row; {saves previous row} end; if (menu = 0) and (options.demono = 1) then {only does the timer with main menu} timer(done,row); {waits for keypress} if done then break; getkey(key); { check_keys(UP+DN+LT+RT+CR+F1,key);} if (key = UP) or (key = DN) then begin clrwin(260-x,180+(save*45)-45,398-x,180+(save*45)-45+42);{clears large text} menu_click_sound; end; case key of F1 : clear_hi_score(hi_score,menu); CR : begin {only accepts pressing exit on the last row} if (menu in [1,2]) and (row = max) then break; if menu = 0 then {pressing escape at any point exits the main menu} break; end; UP : dec(row); DN : inc(row); LT : with options do case menu of 1 : case row of 1 : dec(speedno); 2 : dec(timeno,30); 3 : soundno := 1; 4 : demono := 1; end; 2 : case row of 1 : dec(playersNo); 2 : dec(gameNo); 3 : dec(typeNo); end; end; RT : with options do case menu of 1 : case row of 1 : inc(speedno); 2 : inc(timeno,30); 3 : soundno := 0; 4 : demono := 0; end; 2 : case row of 1 : inc(playersNo); 2 : inc(gameNo); 3 : inc(typeNo); end; end; end; if ((key = LT) or (key = RT)) and (menu in [1,2]) then begin {the options are cleared and displayed again, when the options are changed} case options.playersNo of {relates to GameTxt array and used in the limits below} 1 : begin Slimit := 7; Elimit := 7; end; 2 : {2 player mixed game} begin Slimit := 6; Elimit := 6; end; 3 : {3 player mixed game} begin Slimit := 4; Elimit := 5; end; 4 : begin Slimit := 1; Elimit := 3; end; end; if menu = 1 then begin limits(options.speedno,1,3,false); limits(options.timeno,30,120,false); end; if menu = 2 then begin limits(options.playersNo,1,4,false); limits(options.gameNo,1,3,false); limits(options.typeNo,Slimit,Elimit,false); end; if row in [1,2] then {clears and displays the game option (3rd row)} begin clrwin(410-x,180+(3*45)-45,520-x,180+(3*45)-45+39); display_options(3,x,options,menu); end; clrwin(410-x,180+(row*45)-45,538-x,180+(row*45)-45+39); display_options(row,x,options,menu); end; limits(row,1,max,false); {menu limits} until loop; clr_keyboard_buffer; if menu in [1,2] then {clears the options and game menu text} begin clrwin(190,180,476,400); row := menu+1; {highlights the options in the main menu} end; end; procedure setup_room( var items : itemsType; var rules : rulesRec; var boxesNo : byte; var boxes : boxesType; weapons : weaponsType; partyNo : partyNoType; party : partyType; var teamstr : byte; var enemystr : byte; var battle : battleType; var person : byte; var skip, once, twice, third, exit1, timeout : boolean; options : optionsRec; var roomItems : roomItemsType; var gfx : gfxType; var gamemap : gamemapType ); begin clr_arrows; display_boxes; clear_variables(skip,once,twice,third,exit1,timeout,battle); setup_boxes(boxesNo,boxes,options,roomItems); display_enemy(items,boxes,boxesNo,true,roomItems,gfx,gamemap); make_rules(rules,boxesNo,boxes,weapons,partyNo); calc_team_str(items,partyNo,party,teamstr,battle,weapons); calc_enemy_str(items,boxesNo,boxes,enemystr,battle); calc_weapons_str(weapons,party,partyNo,battle,teamstr); choose_speaker(boxesNo,boxes,person,rules); { test_item(boxesNo,boxes);} end; procedure make_actions( rules : rulesRec; var action : actionType; var actionsNo : byte; boxesNo : byte; boxes : boxesType; once : boolean; person : byte; var twice : boolean; var third : boolean; roomItems : roomItemsType ); begin if third and not rules.pickup and rules.ppl then {works out actions} begin main_actions(action,person,actionsNo,roomItems); weapon_actions(rules,action,actionsNo,boxesNo,boxes,once); if roomend then {last action is either retreat or end turn} begin retreat := 2; {end turn} third := false; {let it go through this code again} endturn_actions(actionsNo,action); end else begin {with the third, only runs this code once} retreat := 1; {retreat} retreat_actions(actionsNo,action); {start of the retreat sequence, step 1} end; end; if not twice and (rules.pickup or not rules.ppl) then begin item_actions(boxes,action,actionsNo,boxesNo); weapon_actions(rules,action,actionsNo,boxesNo,boxes,once); endturn_actions(actionsNo,action); retreat := 2; twice := true; {only runs this code once} end; end; procedure use_weapons( var items : itemsType; var partyNo : partyNoType; var party : partyType; var teamstr, enemystr : byte; var rules : rulesRec; var boxesNo : byte; var boxes : boxesType; var weapons : weaponsType; var battle : battleType; var person : byte; var third : boolean; var action : actionType; choice : byte; var actionsNo : byte; var twice : boolean; var score : scoreType; var roomItems : roomItemsType; var gfx : gfxType; var gamemap : gamemapType ); begin case action[choice].type2 of 1 : {sword} begin weapons_action_clear(boxes,boxesNo,22,22,score,items,roomItems); rules.sword := false; end; 2 : {potion} begin battle[1].usept := true; attack ( items,partyno,party,teamstr,enemystr,1, rules,boxesNo,boxes,weapons,battle,score,roomItems,gfx,gamemap ); if gameover then exit; remove_potion(items,weapons,partyNo,party); battle[1].usept := false; end; 3 : {cross} begin {item checked} weapons_action_clear(boxes,boxesNo,8,9,score,items,roomItems); enemy_details_after_cross(items,boxesNo,boxes,person,rules,third,enemystr,battle); end; 4 : {sarc} if rnd_limits(1,4) = 1 then begin calc_team_str(items,partyNo,party,teamstr,battle,weapons); calc_weapons_str(weapons,party,partyNo,battle,teamstr); mummy_hostile ( items,partyno,party,teamstr,rules,boxesNo,boxes, action,choice,actionsNo,weapons,battle,score,roomItems,gfx,gamemap ); if gameover then exit; end else pickup_gems(items,boxes,twice,action,choice,boxesNo,roomItems,gfx,gamemap); end; reduce_actions(choice,actionsNo,action); end; procedure attack_or_talk( var items : itemsType; var partyNo : partyNoType; var party : partyType; teamstr, enemystr : byte; var rules : rulesRec; var boxesNo : byte; var boxes : boxesType; var weapons : weaponsType; battle : battleType; person : byte; choice : byte; var once : boolean; var score : scoreType; var roomItems : roomItemsType; var gfx : gfxType; var gamemap : gamemapType ); begin case choice of 1 : attack ( items,partyNo,party,teamstr,enemystr,1,rules, boxesNo,boxes,weapons,battle,score,roomItems,gfx,gamemap ); 2 : talk ( items,partyNo,person,party,boxesNo,boxes,rules,weapons,score,roomItems ); end; if gameover then exit; enemy_hostile ( items,partyNo,party,teamstr,enemystr, rules,boxesNo,boxes,weapons,battle,score,roomItems,gfx,gamemap ); once := false; if gameover then {user presses escape and game exits} exit; end; procedure read_items( var items : itemsType ); var F : file of itemsRec; n : byte; wait : char; begin assign(F,'items.dat'); {$I-} reset(F); {$I+} if IOresult <> 0 then game_halts_gfx_lib('Error4: Items.dat needs to be in the same folder as Crypt.exe'); for n := 1 to MAXITEMS do begin if n <= 9 then {item checked} {the 9 is the characters, ghosts & skeletons} begin read(F,items[itemPos[2,n]]); {sorts characters into correct order} end else read(F,items[n]); { with items[n] do writeto(5,2,cv(n)+' '+name+' '+desc,0,1+(20*n)-20,cLIGHTGREEN);} end; close(F); { items[18].desc := 'Kills ghost&skeleton';} (* assign(F,'items2.dat'); {$I-} rewrite(F); {$I+} items2[1] := items[1]; items2[2] := items[4]; items2[3] := items[6]; items2[4] := items[7]; items2[5] := items[5]; items2[6] := items[2]; items2[7] := items[3]; items2[8] := items[9]; items2[9] := items[8]; items2[10] := items[10]; items2[11] := items[20]; items2[12] := items[11]; items2[13] := items[12]; items2[14] := items[13]; items2[15] := items[15]; items2[16] := items[14]; items2[17] := items[17]; items2[18] := items[19]; items2[19] := items[16]; items2[20] := items[18]; items2[21] := items[21]; items2[22] := items[22]; items2[23] := items[23]; for n := 1 to MAXITEMS do write(F,items2[n]); close(F);*) end; (*procedure write_items(items : itemsType); var F : file of itemsRec; n : byte; txt : text; begin assign(F,'items.dat'); reset(F); assign(txt,'c:\items.txt'); rewrite(txt); cleardevice; for n := 1 to MAXITEMS do begin if n <= 9 then {item checked} begin read(F,items[itemPos[2,n]]); end else read(F,items[n]); writeto(5,2,{txt,}cv(n)+' '+items[n].name,0,10+(n*20),100); end; close(txt); close(F); end;*) (*procedure Abort(Msg : string); begin Writeln(Msg, ': ', GraphErrorMsg(GraphResult)); Halt(1); end;*) (*procedure register_files; begin { Register all the drivers } { if RegisterBGIdriver(@EGAVGADriverProc) < 0 then Abort('EGA/VGA');} { Register all the fonts } if RegisterBGIfont(@GothicFontProc) < 0 then Abort('Gothic'); if RegisterBGIfont(@SansSerifFontProc) < 0 then Abort('SansSerif'); if RegisterBGIfont(@SmallFontProc) < 0 then Abort('Small'); if RegisterBGIfont(@TriplexFontProc) < 0 then Abort('Triplex'); if RegisterBGIfont(@ScriptFontProc) < 0 then Abort('Script'); if RegisterBGIfont(@BoldFontProc) < 0 then Abort('Bold'); {font 9} { if RegisterBGIfont(@EuropeanFontProc) < 0 then *this font is not uncluded* Abort('European');} if RegisterBGIfont(@SimplexFontProc) < 0 then Abort('Simplex'); if RegisterBGIfont(@ComplexFontProc) < 0 then Abort('Complex'); if RegisterBGIfont(@TriplexScriptFontProc) < 0 then Abort('TriplexScript'); end;*) procedure points_for_chest( var score : scoreType; var items : itemsType ); var e : byte; rnd : byte; begin for e := 1 to 3 do begin rnd := rnd_limits({11,13}12,14); {item checked} inc(score[P],items[rnd].pts); end; end; procedure find_highest_scorer( var maxplayer : byte; score : scoreType ); var max : word; a : byte; begin max := 0; maxplayer := 1; {if all players scores are 0 then player 1 wins} for a := 1 to no_of_players do {finds the player with highest score} if score[a] > max then begin max := score[a]; maxplayer := a; {saves the players number} end; end; procedure display_score( score : scoreType; partyNo : partyNoType; var maxplayer : byte; players : playersType ); var wait : char; a : byte; column : word; tmpstr : string; begin find_highest_scorer(maxplayer,score); cleardevice; for a := 1 to no_of_players do begin if players[a].playerType = 1 then tmpstr := 'Player ' else tmpstr := 'Cpu '; column := 100+(a*60)-60; writeto(3,1,tmpstr+cv(a)+': ',200,column,{9}cLIGHTBLUE); if partyNo[a] <> 0 then writeto(3,1,cv(score[a])+' pts',200,column+25,{10}cLIGHTGREEN) else {displays a hyphen when there's no score} writeto(3,1,'-',200,column+25,{10}cLIGHTGREEN); end; if players[maxplayer].playerType = 1 then {finds if winning player is comp or human} tmpstr := 'Player ' else tmpstr := 'Cpu '; writexy(3,1,tmpstr+cv(maxplayer)+' wins',360,{11}cLIGHTCYAN); if gametype = 0 then delay(5000) else begin writexy(2,1,'Press SPACE to continue',410,{12}cLIGHTRED); repeat getkey(wait); until wait = SP; clr_keyboard_buffer; end; end; procedure calc_score( { theres only a score when all tiles have been completed. otherwise score will be 0. 3 types of scoring ------------------ (1) all item pts added up, at end of game - chest : 3 random coins out of gems, gold, silver (2) attacking (i) killing enemy : the total stength+range of all char defeated - mummy after sarc - pts after cross (ii) drawing battle - no pts for this (3) talking - friendly char : 20 pts for each char friendly } var score : scoreType; weapons : weaponsType; var items : itemsType ); var a,b,c : byte; begin for c := 1 to no_of_players do for a := 1 to MAXTEAM do for b := 1 to MAXWEAPONS do {item checked} if weapons[c,a,b] <> MAXITEMS then begin inc(score[c],items[weapons[c,a,b]].pts); if weapons[c,a,b] = {20}11 then {looking for the chest} points_for_chest(score,items); end; end; procedure underline(txt : string; x1,y1 : integer); var x,y : word; begin x := textwidth(txt); y := textheight(txt); if x1 = 0 then { centre line } x1 := (GetMaxX-x+1) div 2; SetLineStyle(SolidLn, 0, 1); line(x1,y1+y+4,x1+x-3,y1+y+4); SetLineStyle(SolidLn, 0, ThickWidth); end; procedure intro_help( type1 : byte; {1 for start of game, 2 for help page in menu} var row : byte ); var wait : char; begin clr_keyboard_buffer; cleardevice; writexy(2,1,'Treasure Crypt controls',150,titlecol); underline('Treasure Crypt controls',0,150); writeto(5,2,'Menu',100,210,headingcol); underline('Menu',100,210); writeto(4,2,'Left,Right,Up,Down',100,230,textcol); writeto(4,2,'Enter - Select',100,245,textcol); { writeto(4,2,'F1 - Clears hi-score table',100,260,textcol);} writeto(5,2,'In-game',250,210,headingcol); underline('In-game',250,210); writeto(4,2,'Q,W,A,S - Move character',250,230,textcol); writeto(4,2,'Enter - Miss turn',250,245,textcol); writeto(4,2,'F1 - Pause',250,260,textcol); writeto(4,2,'Escape - Exit game',250,275,textcol); writeto(5,2,'Items box',425,210,headingcol); underline('Items box',425,210); writeto(4,2,'Left,Right,Up,Down',425,230,textcol); writeto(4,2,'Space - Swap Items',425,245,textcol); writeto(4,2,'D - Drop Items',425,260,textcol); writexy(4,2,'Pressing ESCAPE at any point takes you back to the main menu',315,cLIGHTRED); if type1 = 1 then begin writexy(1,1,'Press SPACE to continue',450,{9}cLIGHTBLUE); repeat getkey(wait); until wait = SP; end; if type1 = 2 then begin writexy(1,1,'Press any key',450,{9}cLIGHTBLUE); getkey(wait); clr_keyboard_buffer; cleardevice; display_menu_title; row := 4; end; end; procedure help_page1; var wait : char; begin cleardevice; writexy(2,1,'Treasure Crypt instructions',1,titlecol); underline('Treasure Crypt instructions',0,1); {text increments by 15 pixels} writeto(4,2,'The idea of the game is to reach tile 0 without losing all the',100,40,textcol); writeto(4,2,'characters in the team.',100,55,textcol); {main headings: 20 pixles before heading and 25 pixels after} writeto(5,2,'Teams',100,75,headingcol); underline('Teams',100,75); writeto(4,2,'There are two teams in the game. Your team are in the box at the top of',100,100,textcol); writeto(4,2,'the screen and the enemies team are in the yellow boxes. The teams are',100,115,textcol); writeto(4,2,'made up of characters and each character can hold a certain amount of',100,130,textcol); writeto(4,2,'items, depending on the weight of the items. Each team has 2 main fighters',100,145,textcol); writeto(4,2,'and the strongest fighter is the speaker of the team. These are the 2',100,160,textcol); writeto(4,2,'characters who have the highest str and range combined.',100,175,textcol); writeto(5,2,'Options',100,195,headingcol); underline('Options',100,195); writeto(4,2,'Each room you go through will have random enemy characters. To the left',100,220,textcol); writeto(4,2,'there a number of options to choose from.',100,235,textcol); {sub headings: 20 pixles before heading and 20 pixels after} writeto(4,2,'Talk Option',100,255,headingcol); underline('Talk Option',100,255); writeto(4,2,'Use Talk if the character your talking to has not got 0% friendly. Say your',100,275,textcol); writeto(4,2,'talking to the adventurer. He has 40% friendly and 20% hostile. So there''s',100,290,textcol); writeto(4,2,'a 40% chance he will join your team and there''s a 20% chance he will be',100,305,textcol); writeto(4,2,'hostile and attack.',100,320,textcol); writeto(4,2,'Attack Option',100,340,headingcol); underline('Attack Option',100,340); writeto(4,2,'Use Attack if the character has 0% friendly and your team are stronger',100,360,textcol); writeto(4,2,'than the enemies team. This will lead to the battle scene.',100,375,textcol); writeto(4,2,'Pick up Option',100,395,headingcol); underline('Pick up Option',100,395); writeto(4,2,'Picking up the items in the room will increase your teams strength and',100,415,textcol); writeto(4,2,'increase the score.',100,430,textcol); writexy(1,1,'Press any key',450,{9}cLIGHTBLUE); getkey(wait); end; procedure help_page2; var wait : char; begin cleardevice; writexy(2,1,'Treasure Crypt instructions',1,titlecol); underline('Treasure Crypt instructions',0,1); writeto(5,2,'Battle scene',100,40,headingcol); underline('Battle scene',100,40); writeto(4,2,'The battle scene is won by the team with the highest str and range',100,65,textcol); writeto(4,2,'combined, plus a random number of 6. The teams strength is worked out by',100,80,textcol); writeto(4,2,'the 2 main fighters str, all characters range and the strength of the',100,95,textcol); writeto(4,2,'weapons. If you lose a battle then one of the 2 main fighters are lost,',100,110,textcol); writeto(4,2,'including what items the fighter had. If you win a battle then Pick Up',100,125,textcol); writeto(4,2,'the items in the room.',100,140,textcol); writexy(1,1,'Press any key',450,{9}cLIGHTBLUE); getkey(wait); end; {-------------------------------------------------------} function rnd_numbers(num1,num2,num3,num4,no : byte) : byte; {takes four numbers and then picks one of the numbers. works with work_out_roomtype} var rnd,chance : byte; begin rnd := random(no)+1; case rnd of 1 : rnd_numbers := num1; 2 : rnd_numbers := num2; 3 : rnd_numbers := num3; 4 : rnd_numbers := num4; end; chance := rnd_limits(1,100); case chance of 1..49 : rnd_numbers := num2; {room} {25% chance the tile is a room} 49..62 : rnd_numbers := num3; {corner} {13% chance for corner} 63..75 : rnd_numbers := num4; {corner} {12% chance for corner} 76..100 : rnd_numbers := num1; {hall} {25% chance for hall} end; end; procedure move_pattern4( tmppattern : Pattern4Type; Xpos,Ypos : byte; col : byte ); var a : byte; begin if demo then exit; for a := 1 to 4 do {for patterns with only 4 size arrays} with tmppattern[a] do {moves the pattern to the Xpos and Ypos of the square} begin X := X+(Xpos*S)-S; Y := Y+(Ypos*S)-S+GM_STARTS; end; setcolor(col); {border colour, the same as the pattern colour below} SetFillStyle(1, col); FillPoly(SizeOf(tmppattern) div SizeOf(PointType), tmppattern); end; procedure move_pattern8( tmppattern : Pattern8Type; Xpos,Ypos : byte; col : byte ); var a : byte; begin if demo then exit; for a := 1 to 8 do with tmppattern[a] do {moves the pattern to the Xpos and Ypos of the square} begin X := X+(Xpos*S)-S; Y := Y+(Ypos*S)-S+GM_STARTS; end; setcolor(col); {border colour} SetFillStyle(1, col); FillPoly(SizeOf(tmppattern) div SizeOf(PointType), tmppattern); end; procedure convert_key_to_num( GMkey : char; var num : byte ); begin case GMkey of 'Q' : num := 1; 'W' : num := 2; 'A' : num := 3; 'S' : num := 4; CR : num := 5; end; end; procedure convert_num_to_key( num : byte; var GMkey : char ); begin case num of 1 : GMkey := 'Q'; 2 : GMkey := 'W'; 3 : GMkey := 'A'; 4 : GMkey := 'S'; 5 : GMkey := CR; end; end; procedure display_line( {used to display the arrows} x1,y1,x2,y2 : word; col,row : word ); begin if demo then exit; line(x1+col,y1+row,x2+col,y2+row); end; procedure display_single_arrow( num : byte; colour : byte ); begin if demo then exit; SetLineStyle(SolidLn, 0, 3); setcolor(colour); case num of 1 : begin display_line(0,0,20,20,580,410); {north west} display_line(0,0,20,0,580,410); display_line(0,0,0,20,580,410); end; 2 : begin display_line(0,20,20,0,615,410); {north east} display_line(20,0,0,0,615,410); display_line(20,0,20,20,615,410); end; 3 : begin display_line(0,20,20,0,580,445); {south west} display_line(0,0,0,20,580,445); display_line(0,20,20,20,580,445); end; 4 : begin display_line(0,0,20,20,615,445); {south east} display_line(20,20,0,20,615,445); display_line(20,20,20,0,615,445); end; 5 : circle(608,437,5); end; end; procedure display_arrows; var a : byte; begin for a := 1 to 5 do display_single_arrow(a,cLIGHTGREEN); end; procedure GMinitialise( var Xpos,Ypos : byte; var saveroom : byte; var savekey : char; var players : playersType; var GMfirst : byte ); var a : byte; begin if GMfirst <> 0 then {only runs this procedure on the very first move} exit; Xpos := STARTX; Ypos := STARTY; saveroom := 3; { savekey := 's';} scrY := 0; scrX := 0; setblock := false; speed := 1000; for a := 1 to no_of_players do with players[a] do begin s_Xpos := STARTX; s_Ypos := STARTY; s_saveX := {Xpos+(scrX*MAXCOL);}s_Xpos; s_saveY := {Ypos+(scrY*MAXROW);}s_Ypos; s_scrX := 0; s_scrY := 0; s_saveroom := 3; s_savekey := 'Q'; s_savecorner := 1; setblock := false; s_savestep := 1; {either 1 or 4} s_escapeweb := true; {web is open} end; end; procedure init_rooms( var gamemap : gamemapType; var roomItems : roomItemsType ); var a,b : shortint; c : byte; begin for a := MAXCOL*(-SCRMAX) to MAXCOL*SCRMAX do for b := MAXROW*(-SCRMAX) to MAXROW*SCRMAX do with gamemap[a,b] do begin enable := false; type1 := 0; for c := 1 to MAX_CORNERS do begin limit[c] := false; {false is closed corners} cpublock[c] := false; {false is open corners} end; { for c := 1 to MAXBOX+1 do box[c] := MAXITEMS;} end; for a := 1 to MAXROOMS do with roomItems[a] do begin storeXpos := 0; storeYpos := 0; roomEnable := false; for b := 1 to MAXBOX do itemNo[b] := MAXITEMS; for b := 1 to MAX_CORNERS do trap[b] := 0; {0 - normal, 1 - earthquake, 99 - giant web} for b := 1 to MAX_PLAYERS do begin bonus1[b] := true; {true for +1 bonus and false for +0 bonus. default is true} retreat1[b] := 0; {0 for normal, 1 for 1 retreat and no more} talk1[b] := 0; {the number can be 1 to 4, 0 for normal, 98 for stay and attack, 99 for don't talk again} end; end; end; procedure display_gamemap; var x,y : byte; begin setcolor(BROWN); SetTextStyle(2, 0, 4); for x := 1 to MAXCOL do begin outtextxy((x*S)-19,1+GM_STARTS,cv(x)); for y := 1 to MAXROW do begin outtextxy(1,(y*S)-19+GM_STARTS,cv(y)); rectangle((x*S)-S,(y*S)-S+GM_STARTS,(x*S),(y*S)+GM_STARTS); end; end; end; procedure move_line( var gamemap : gamemapType; x1,y1, x2,y2 : integer; Xpos,Ypos : byte; num : byte; {it always displays line when num is 0} col : byte ); begin if demo then exit; setcolor(col); if not gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)].limit[num] or (num = 0) then line(x1+(Xpos*S)-S,y1+(Ypos*S)-S+GM_STARTS,x2+(Xpos*S)-S,y2+(Ypos*S)-S+GM_STARTS); end; function opposite_corner( savecorner : byte ) : byte; begin case savecorner of 1 : opposite_corner := 4; 2 : opposite_corner := 3; 3 : opposite_corner := 2; 4 : opposite_corner := 1; end; end; procedure decrease_tiles( var tiles : byte; var gamemap : gamemapType; Xpos,Ypos : byte ); begin with gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)] do if not enable then dec(tiles); clrwin(590,0,639,26); writeto(3,1,'Tiles: '+cv(tiles),530,-2,msgcol2); end; procedure display_tiles( var tiles : byte ); begin clrwin(590,0,639,26); writeto(3,1,'Tiles: '+cv(tiles),530,-2,msgcol2); end; procedure work_out_roomtype( {the restrictions when moving through each room or hall. if the last move was north west and in a room then the next move has a choice of left hall and a room } var gamemap : gamemapType; savekey : char; saveroom : byte; {I should be using a var, but don't add it because it creates a bug} var roomtype : byte; GMfirst : byte ); begin if GMfirst <= no_of_players then {first square is always a room} begin roomtype := 3; gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)].type1 := roomtype; saveroom := roomtype; {saves previous room} exit; end; {savekey and saveroom are the previous squares and roomtype is for the current square} with gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)] do if not enable then begin if (savekey = 'Q') and ((saveroom in [1,3,5,7])) then {top left} roomtype := rnd_numbers(1,3,4,6,4); if (savekey = 'W') and ((saveroom in [2,3,5,6])) then {top right} roomtype := rnd_numbers(2,3,4,7,4); if (savekey = 'A') and ((saveroom in [2,3,4,7])) then {bottom left} roomtype := rnd_numbers(2,3,5,6,4); if (savekey = 'S') and ((saveroom in [1,3,4,6])) then {bottom right} roomtype := rnd_numbers(1,3,5,7,4); gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)].type1 := roomtype; saveroom := roomtype; {saves previous room} end else begin {if the room is already enabled then it gets the room type} roomtype := gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)].type1; saveroom := roomtype; {saves previous room} end; end; procedure work_out_open_corners( savecorner : byte; Xpos,Ypos : byte; var gamemap : gamemapType; roomtype : byte; GMfirst : byte ); var a : byte; begin if gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)].enable then exit; {1st and 2nd square has always 4 opened corners} if (GMfirst <= no_of_players*2) then begin for a := 1 to MAX_CORNERS do gamemap[Xpos,Ypos].limit[a] := true; exit; end; {the default corners which are all opened} for a := 1 to MAX_CORNERS do if corner_defaults[roomtype,a] <> 0 then gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)].limit[a] := true; {when you walk through a room, this prevents the 2nd room's entrance being blocked} for a := 1 to MAX_CORNERS do if opposite_corner(savecorner) = a then gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)].limit[a] := true; end; procedure left_hall(Xpos,Ypos : byte; var gamemap : gamemapType); begin move_pattern4(LeftHallGfx,Xpos,Ypos,hall_colour); move_line(gamemap,40,0,100,60,Xpos,Ypos,2,border_colour); {top diagonal line} move_line(gamemap,0,40,60,100,Xpos,Ypos,3,border_colour); {bottom diagonal line} end; procedure right_hall(Xpos,Ypos : byte; var gamemap : gamemapType); begin move_pattern4(RightHallGfx,Xpos,Ypos,hall_colour); move_line(gamemap,0,60,60,0,Xpos,Ypos,1,border_colour); {top diagonal line} move_line(gamemap,40,100,100,40,Xpos,Ypos,4,border_colour); {bottom diagonal line} end; procedure room(Xpos,Ypos : byte; var gamemap : gamemapType); begin if (Xpos = STARTX) and (Ypos = STARTY) and (scrX = 0) and (scrY = 0) then move_pattern8(RoomGfx,Xpos,Ypos,cLIGHTMAGENTA) {the 1st tile has a different pattern colour} else move_pattern8(RoomGfx,Xpos,Ypos,room_colour); move_line(gamemap,0,40,0,60,Xpos,Ypos,0,border_colour); {left} {sides of room} move_line(gamemap,100,40,100,60,Xpos,Ypos,0,border_colour); {right} move_line(gamemap,40,0,60,0,Xpos,Ypos,0,border_colour); {top} move_line(gamemap,40,100,60,100,Xpos,Ypos,0,border_colour); {bottom} end; procedure top_corner(Xpos,Ypos : byte; var gamemap : gamemapType); begin move_pattern8(TopCornerGfx,Xpos,Ypos,hall_colour); move_line(gamemap,0,60,50,0,Xpos,Ypos,1,border_colour); move_line(gamemap,50,0,100,60,Xpos,Ypos,2,border_colour); move_line(gamemap,40,100,50,90,Xpos,Ypos,0,border_colour); {small part} move_line(gamemap,50,90,60,100,Xpos,Ypos,0,border_colour); end; procedure bottom_corner(Xpos,Ypos : byte; var gamemap : gamemapType); begin move_pattern8(BottomCornerGfx,Xpos,Ypos,hall_colour); move_line(gamemap,0,40,50,100,Xpos,Ypos,3,border_colour); move_line(gamemap,50,100,100,40,Xpos,Ypos,4,border_colour); move_line(gamemap,40,0,50,10,Xpos,Ypos,0,border_colour); {small part} move_line(gamemap,50,10,60,0,Xpos,Ypos,0,border_colour); end; procedure left_corner(Xpos,Ypos : byte; var gamemap : gamemapType); begin move_pattern8(LeftCornerGfx,Xpos,Ypos,hall_colour); move_line(gamemap,0,50,60,0,Xpos,Ypos,1,border_colour); move_line(gamemap,0,50,60,100,Xpos,Ypos,3,border_colour); move_line(gamemap,100,40,90,50,Xpos,Ypos,0,border_colour); {small part} move_line(gamemap,100,60,90,50,Xpos,Ypos,0,border_colour); end; procedure right_corner(Xpos,Ypos : byte; var gamemap : gamemapType); begin move_pattern8(RightCornerGfx,Xpos,Ypos,hall_colour); move_line(gamemap,100,50,40,0,Xpos,Ypos,2,border_colour); move_line(gamemap,100,50,40,100,Xpos,Ypos,4,border_colour); move_line(gamemap,0,40,10,50,Xpos,Ypos,0,border_colour); {small part} move_line(gamemap,0,60,10,50,Xpos,Ypos,0,border_colour); end; procedure top_left_block(Xpos,Ypos : byte; var gamemap : gamemapType); begin move_line(gamemap,0,40,40,0,Xpos,Ypos,0,block_line_colour); {top left block corner} end; procedure top_right_block(Xpos,Ypos : byte; var gamemap : gamemapType); begin move_line(gamemap,60,0,100,40,Xpos,Ypos,0,block_line_colour); {top right block corner} end; procedure bottom_left_block(Xpos,Ypos : byte; var gamemap : gamemapType); begin move_line(gamemap,0,60,40,100,Xpos,Ypos,0,block_line_colour); {bottom left block corner} end; procedure bottom_right_block(Xpos,Ypos : byte; var gamemap : gamemapType); begin move_line(gamemap,60,100,100,60,Xpos,Ypos,0,block_line_colour); end; procedure TopLeftConnect(Xpos,Ypos : byte; var gamemap : gamemapType); begin move_pattern8(TopLeftConnectGfx,Xpos,Ypos,hall_colour); move_line(gamemap,0,60,40,100,Xpos,Ypos-1,0,connect_colour); {bottom left connect line} move_line(gamemap,60,0,100,40,Xpos-1,Ypos,0,connect_colour); {top right connect line} end; procedure TopRightConnect(Xpos,Ypos : byte; var gamemap : gamemapType); begin move_pattern8(TopRightConnectGfx,Xpos,Ypos,hall_colour); move_line(gamemap,60,100,100,60,Xpos,Ypos-1,0,connect_colour); {bottom right connect line} move_line(gamemap,0,40,40,0,Xpos+1,Ypos,0,connect_colour); {top left connect line} end; procedure BottomLeftConnect(Xpos,Ypos : byte; var gamemap : gamemapType); begin move_pattern8(BottomLeftConnectGfx,Xpos,Ypos,hall_colour); move_line(gamemap,60,100,100,60,Xpos-1,Ypos,0,connect_colour); {bottom right connect line} move_line(gamemap,0,40,40,0,Xpos,Ypos+1,0,connect_colour); {top left connect line} end; procedure BottomRightConnect(Xpos,Ypos : byte; var gamemap : gamemapType); begin move_pattern8(BottomRightConnectGfx,Xpos,Ypos,hall_colour); move_line(gamemap,60,0,100,40,Xpos,Ypos+1,0,connect_colour); {top right connect line} move_line(gamemap,0,60,40,100,Xpos+1,Ypos,0,connect_colour); {bottom left connect line} end; procedure display_graphics( var gamemap : gamemapType; roomtype : byte; Xpos,Ypos : byte ); begin if not gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)].enable then case roomtype of 1 : left_hall(Xpos,Ypos,gamemap); 2 : right_hall(Xpos,Ypos,gamemap); 3 : room(Xpos,Ypos,gamemap); 4 : top_corner(Xpos,Ypos,gamemap); 5 : bottom_corner(Xpos,Ypos,gamemap); 6 : left_corner(Xpos,Ypos,gamemap); 7 : right_corner(Xpos,Ypos,gamemap); end; end; procedure display_connect_lines( Xpos,Ypos : byte; roomtype : byte; var gamemap : gamemapType ); begin with gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)] do begin if not (roomtype in [2,4,6]) and limit[1] then TopLeftConnect(Xpos,Ypos,gamemap); if not (roomtype in [1,4,7]) and limit[2] then TopRightConnect(Xpos,Ypos,gamemap); if not (roomtype in [2,5,6]) and limit[3] then BottomLeftConnect(Xpos,Ypos,gamemap); if not (roomtype in [1,5,7]) and limit[4] then BottomRightConnect(Xpos,Ypos,gamemap); end; end; procedure save_room_details( var gamemap : gamemapType; roomtype : byte ); begin with gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)] do {saves current room or halls details} if not enable then begin enable := true; type1 := roomtype; {saves room type} end; end; function count_rnd( { takes in the limit or related corner array and adds all block corners or disabled next rooms. this function is used with calc_rnd. } var tmp1 : cornerType ) : byte; var a,count : byte; begin count := 0; for a := 1 to MAX_CORNERS do if not tmp1[a] then inc(count); count_rnd := count; end; function calc_rnd( tmparray : cornerType; savecorner : byte ) : byte; { takes in the limit or related corner array and works out a random number out of all open corners (limit = true) and enabled rooms. this function is used with count_rnd. } var tmp : byte; count : byte; begin count := 0; repeat inc(count); if count > 20 then begin tmp := opposite_corner(savecorner); break; end; tmp := rnd_limits(1,MAX_CORNERS); until (tmparray[tmp] <> false) {repeats til open corner} and (opposite_corner(savecorner) <> tmp); calc_rnd := tmp; end; function avoid_route_to_deadend( var gamemap : gamemapType; {var rnd : byte;} var store : cornerType; Xpos,Ypos : byte ) : boolean; var ok : boolean; a : byte; begin {the character is in the room with the route to the deadend} ok := false; with gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)] do begin store := limit; {stores default and random block corners} for a := 1 to MAX_CORNERS do if cpublock[a] then {checks if any corner in current room is blocked by cpu} begin store[a] := false; {adds new blocked corner} ok := true; {if theres 1 or more matches then the code below is run} end; end; avoid_route_to_deadend := ok; end; procedure calc_random_comp_move( var rnd : byte; enableS, openS : cornerType; Xpos,Ypos : byte; savecorner : byte; closeCornerNo : byte; var gamemap : gamemapType; GMfirst : byte; roomItems : roomItemsType ); var store : cornerType; begin {comp makes a move with the following rules. in ascending order} if GMfirst <= no_of_players then {random move at start on the 1st tile} rnd := rnd_limits(1,MAX_CORNERS) else if closeCornerNo = 4 then {when comp is in room with 4 blocked corners} rnd := 5 {presses return and stays on the same spot} else if roomItems[findroom(roomItems,Xpos,Ypos)].talk1[P] in [1..4,98] then rnd := 5 else {room has open corners and disable next rooms} if count_rnd(enableS) <> MAX_CORNERS then rnd := calc_rnd(enableS,savecorner) else if avoid_route_to_deadend(gamemap,{rnd,}store,Xpos,Ypos) then rnd := calc_rnd(store,savecorner) else {tests square for 3 deadends} if closeCornerNo = 3 then begin rnd := opposite_corner(savecorner); {goes opposite direction} setblock := true; {set to false when reaching first room after deadend} end else {chooses this if the room in front is enabled and a open corner to the room} if not enableS[savecorner] and openS[savecorner] then rnd := savecorner else {room has open corners and with no disable next rooms} if count_rnd(enableS) = MAX_CORNERS then rnd := calc_rnd(openS,savecorner);{finds rnd number out of open corners} end; procedure find_open_and_disabled_rooms_for_comp( var gamemap : gamemapType; savecorner : byte; var openS, enableS : cornerType ); var a : byte; begin for a := 1 to MAX_CORNERS do if gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)].limit[a] and (opposite_corner(savecorner) <> a) then begin openS[a] := true; {stores open corners} case a of {checks next rooms for disabled corners} 1 : if not gamemap[Xpos+(scrX*MAXCOL)-1,Ypos+(scrY*MAXROW)-1].enable then {top left} enableS[1] := true; {stores disabled next rooms} 2 : if not gamemap[Xpos+(scrX*MAXCOL)+1,Ypos+(scrY*MAXROW)-1].enable then {top right} enableS[2] := true; 3 : if not gamemap[Xpos+(scrX*MAXCOL)-1,Ypos+(scrY*MAXROW)+1].enable then {bottom left} enableS[3] := true; 4 : if not gamemap[Xpos+(scrX*MAXCOL)+1,Ypos+(scrY*MAXROW)+1].enable then {bottom right} enableS[4] := true; end; end; end; procedure test_if_comp_reaches_deadend( var closeCornerNo : byte; var gamemap : gamemapType; Xpos,Ypos : byte ); var a : byte; begin {if computer reaches a deadend then it comes back out the way it came in} closeCornerNo := 0; for a := 1 to MAX_CORNERS do if not gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)].limit[a] then inc(closeCornerNo); end; procedure comps_first_room_after_deadend( var gamemap : gamemapType; savecorner : byte; Xpos,Ypos : byte ); begin {after finding deadend, every room with 3 and less blocked corners are set to be avoided until a room with 1 blocked corner has been reached} with gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)] do begin if (type1 = 3) and setblock and (count_rnd(limit) <= {1}3) then cpublock[opposite_corner(savecorner)] := true; if (type1 = 3) and setblock and (count_rnd(limit) <= 1) then setblock := false; end; end; procedure display_block_corners( var gamemap : gamemapType; Xpos,Ypos : byte; roomtype : byte ); var a : byte; begin with gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)] do for a := 1 to MAX_CORNERS do {only corners which are already opened} if not limit[a] and (corner_defaults[roomtype,a] <> 0) then case a of 1 : top_left_block(Xpos,Ypos,gamemap); 2 : top_right_block(Xpos,Ypos,gamemap); 3 : bottom_left_block(Xpos,Ypos,gamemap); 4 : bottom_right_block(Xpos,Ypos,gamemap); end; end; procedure dislay_characters_after_clear_screen( players : playersType; partyNo : partyNoType; var gfx3 : gfxType3 ); var a : byte; col : byte; begin {displays characters on the current screen} for a := 1 to no_of_players do with players[a] do {the 'if scr' prevents the character disappearing} if (scrX = s_scrX) and (scrY = s_scrY) and (partyNo[a] <> 0) then {players still alive} begin (* if P = a then {highlights players turn} col := 5 else col := 15;*) display_character(s_savestep,30,33,gfx3,0,0,s_Xpos,s_Ypos,1); end; end; procedure display_screen( var gamemap : gamemapType; players : playersType; partyNo : partyNoType; var items : itemsType; var roomItems : roomItemsType; var gfx2 : gfxType2; var gfx3 : gfxType3; var gfx4 : gfxType4 ); var x,y : byte; begin if demo then exit; clr_main_area; load_pcx3(0,145,640,371,'graphics\back2'); display_arrows; { display_gamemap;} for x := 1 to MAXCOL do for y := 1 to MAXROW do with gamemap[x+(scrX*MAXCOL),y+(scrY*MAXROW)] do begin if enable then begin case type1 of 1 : left_hall(x,y,gamemap); 2 : right_hall(x,y,gamemap); 3 : room(x,y,gamemap); 4 : top_corner(x,y,gamemap); 5 : bottom_corner(x,y,gamemap); 6 : left_corner(x,y,gamemap); 7 : right_corner(x,y,gamemap); end; display_block_corners(gamemap,x,y,type1); display_connect_lines(x,y,type1,gamemap); if type1 = 3 then begin display_room_items(gamemap,items,roomItems,x,y,gfx2); display_web_and_quake(roomItems,gfx4,x,y); end; end; end; dislay_characters_after_clear_screen(players,partyNo,gfx3); end; procedure character_walks( var gfx2 : gfxType2; var gfx3 : gfxType3; var gfx4 : gfxType4; saveXpos, saveYpos : byte; savekey : char; var movex, movey : integer; start1, end1 : byte; var savestep : byte; {the position the character is at the start of game, either 1 or 4} hitwall : boolean; var GMkey : char; {just for the hitwall sound} items : itemsType; roomItems : roomItemsType; roomtype : byte; var gamemap : gamemaptype; Xpos,Ypos : byte; change : boolean; {passes TRUE in with retreat animation} saveroom : byte; type1 : byte {0 for normal animation, 1 for retreat animation} ); var dir,a : byte; step,pixel : byte; num : byte; wait : char; begin pixel := 10; if hitwall then {character hits wall or if earthquake happens when retreating} begin start1 := 1; end1 := 2; end; if type1 = 0 then {checks previous direction to display character in the same direction} convert_key_to_num(savekey,dir) {finds the direction the character is going} else begin {retreat} convert_key_to_num(savekey,dir); {finds the direction the character is going} dir := opposite_corner(dir); convert_num_to_key(dir,GMkey); {try this with savekey above} end; if dir in [1,3] then step := 0 {the walk sequence is at the start} else if dir in [2,4] then step := 3; if dir = 5 then {if user presses return then no character animation} exit; display_character(savestep,30,33,gfx3,0,0,saveXpos,saveYpos,0); {clears character from previous position} for a := start1 to end1 do begin if type1 = 0 then begin if (Ypos = MAXROW) and (change) and (a >= 6) then break; {fixes bug when character is at the top of screen and moving to the next screen} end else begin {retreat} change := true; {uses this with retreat animation} if (Ypos = {MAXROW}1) and (change) and (a >= 6) then break; end; case dir of 1 : {top left} begin dec(movex,pixel); dec(movey,pixel); end; 2 : {top right} begin inc(movex,pixel); dec(movey,pixel); end; 3 : {bottom left} begin dec(movex,pixel); inc(movey,pixel); end; 4 : {bottom right} begin inc(movex,pixel); inc(movey,pixel); end; end; if type1 = 1 then change := false; {uses this with retreat animation} {this refeshes the items and character graphics, when walking in the room} if (roomtype = 3){next room} and (not change) and (a >= 7) then {entering a room} begin num := findroom(roomItems,Xpos,Ypos);{Xpos & Ypos is for current room} if calc_boxesNo(roomItems,num) <> 0 then {no items in room} room(Xpos,Ypos,gamemap); display_room_items(gamemap,items,roomItems,Xpos,Ypos,gfx2); {displays items} display_web_and_quake(roomItems,gfx4,Xpos,Ypos); { readkey;} end; if (saveroom = 3){previous room} and (not change) and (a <= 4) then {leaving a room} begin num := findroom(roomItems,saveXpos,saveYpos);{saveXpos & saveYpos is for previous room} if calc_boxesNo(roomItems,num) <> 0 then {no items in room} room(saveXpos,saveYpos,gamemap); display_room_items(gamemap,items,roomItems,saveXpos,saveYpos,gfx2); display_web_and_quake(roomItems,gfx4,saveXpos,saveYpos); {readkey;} end; inc(step); {1,2,3 for left sequence and 4,5,6 for right} display_character(step,30,33,gfx3,movex,movey,saveXpos,saveYpos,1); {displays move} savestep := step; {this is to clear the character on the next move} display_time_delay(wait,{50}{200}100{175}); if soundOnOff = 1 then character_walking_sound else if not demo then delay(40); {replaces the sound delay} display_character(step,30,33,gfx3,movex,movey,saveXpos,saveYpos,0); {clears character} if dir in [2,4] then {repeats the walk sequence, 3 to 6 for left} if step = 6 then step := 3; if dir in [1,3] then {1 to 3 for left} if step = 3 then step := 0; end; if hitwall and (GMkey in ['Q','W','A','S']) then begin if soundOnOff = 1 then bump_into_wall_sound else if not demo then delay(100); {replaces the sound delay} end; nosound; end; procedure wait_for_move( var hitwall : boolean; var gamemap : gamemapType; Xpos,Ypos : byte; savecorner : byte; var GMkey : char; GMfirst : byte; var savekey : char; var roomItems : roomItemsType; var weapons : weaponsType; items : itemsType; party : partyType; partyNo : partyNoType; var boxes : boxesType; roomtype : byte; rules : rulesRec; boxesNo : byte; var gfx : gfxType ); var openS, enableS : cornerType; {stores open corners and disabled next rooms} a,rnd : byte; closeCornerNo : byte; ch : char; {edit weapons variables} savex1, savey1 : byte; {source box} total : byte; swap_item : boolean; begin { the following are procedures for working out deadends for comp - test_if_comp_reaches_deadend - comps_first_room_after_deadend In calc_random_comp_move theres - avoid_route_to_deadend - some other code } hitwall := true; if comp then {comp makes move} begin for a := 1 to MAX_CORNERS do begin openS[a] := false; enableS[a] := false; end; test_if_comp_reaches_deadend(closeCornerNo,gamemap{,savecorner},Xpos,Ypos); find_open_and_disabled_rooms_for_comp(gamemap,savecorner,openS,enableS); calc_random_comp_move(rnd,enableS,openS,Xpos,Ypos,savecorner,closeCornerNo,gamemap,GMfirst,roomItems); comps_first_room_after_deadend(gamemap,savecorner,Xpos,Ypos); convert_num_to_key(rnd,GMkey); if keypressed then begin getkey(ch); {test} if ch in ['Q','W','A','S',CR] then clr_keyboard_buffer {fixes bug when pressing control keys during comp play} else GMkey := ch; end; end else begin clr_keyboard_buffer; savex1 := x3; {these 3 are used with edit weapons} savey1 := y3; swap_item := false; repeat edit_weapons_highlight(savex1,savey1,items,weapons,party,partyNo,swap_item); {clr_keyboard_buffer;} display_time_readkey(GMkey); exit_game_prompt(GMkey,ch); {test for F10, escape and pause} if upcase(ch) = 'N' then begin ch := #1; {if user presses No. The #1 is to keep in the loop} GMkey := #1; end; if GMkey = #0 then {a random move is made when time reaches 0} begin {repeat} {loops until rnd is a open corner} rnd := rnd_limits(1,4); {until gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)].limit[rnd];} convert_num_to_key(rnd,GMkey); end; edit_weapons (GMkey,weapons,savex1,savey1,items,partyNo,party,swap_item,roomItems,boxes,roomtype,rules,boxesNo,gamemap,gfx); until upcase(GMkey) in ['Q','W','A','S',CR,ESC]; GMkey := upcase(GMkey); {clears on players first move} display_marker(table,x3,y3); {clears marker} {prevents clearing this text when the move is taken} display_weapons(items,weapons,1,partyNo[P]{7}); display_weight(items,weapons,party,1,partyNo[P]{7}); end; savekey := GMkey; {saves previous move using key pressed} end; procedure GM_make_move( var gamemap : gamemapType; GMkey : char; var Xpos,Ypos : byte; var savecorner : byte; var hitwall : boolean; var GMdone : boolean; var change : boolean ); begin change := false; with gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)] do case GMkey of 'Q' : {top left} if limit[1] then {prevents going right when hall is going left} begin if Ypos <= 1{4} then {character has walked to the end of screen} begin Ypos := MAXROW+1{}; dec(scrY); change := true; {makes the screen move} end; if Xpos <= 1 then begin Xpos := MAXCOL+1; dec(scrX); change := true; end; dec(Xpos); {moves to next room or hall} dec(Ypos); savecorner := 1; {saves the corner where you came from} hitwall := false; {avoid bumping into wall} end; 'W' : {top right} if limit[2] then {prevents going left when hall is going right} begin if Ypos <= 1{4} then begin Ypos := MAXROW+1{}; dec(scrY); change := true; end; if Xpos >= MAXCOL then begin Xpos := 0; inc(scrX); change := true; end; inc(Xpos); dec(Ypos); savecorner := 2; hitwall := false; end; 'A' : {bottom left} if limit[3] then {prevents going left when hall is going left} begin if Ypos >= MAXROW {-1} then begin Ypos := 0{3}; inc(scrY); change := true; end; if Xpos <= 1 then begin Xpos := MAXCOL+1; dec(scrX); change := true; end; inc(Ypos); dec(Xpos); savecorner := 3; hitwall := false; end; 'S' : {bottom right} if limit[4] then {prevents going right when hall is going right} begin if Ypos >= MAXROW {-1} then begin Ypos := 0{3}; inc(scrY); change := true; end; if Xpos >= MAXCOL then begin Xpos := 0; inc(scrX); change := true; end; inc(Ypos); inc(Xpos); savecorner := 4; hitwall := false; end; ESC : GMdone := true; {for end of program} end; end; procedure move_to_next_room( var gamemap : gamemapType; var Xpos,Ypos : byte; var savecorner : byte; var GMdone : boolean; var saveroom : byte; var savekey : char; var roomtype : byte; var GMkey : char; var tiles : byte; GMfirst : byte; var movex, movey : integer; var saveXpos, saveYpos : byte; var change : boolean; var hitwall : boolean; var gfx2 : gfxType2; var gfx3 : gfxType3; var gfx4 : gfxType4; var savestep : byte; items : itemsType; var roomItems : roomItemsType; {don't add var} var players_tmp : playersRec; players : playersType; var weapons : weaponsType; partyNo : partyNoType; party : partyType; var boxes : boxesType; rules : rulesRec; boxesNo : byte; var gfx : gfxType ); var num : byte; wait : char; begin saveXpos := Xpos; {saves this for character hitting wall} saveYpos := Ypos; players_tmp := players[P]; {stores this for retreating} movex := 0; {for moving character} movey := 0; display_character(savestep,30,33,gfx3,0,0,Xpos,Ypos,1); {displays character from previous position} (* display_test_results(gamemap,Xpos,Ypos); {test: the corners which are blocked}*) if comp then display_time_delay(wait,speed); if gameover then exit; wait_for_move (hitwall,gamemap,Xpos,Ypos,savecorner,GMkey,GMfirst,savekey,roomItems, weapons,items,party,partyNo,boxes,roomtype,rules,boxesNo,gfx); if gameover then exit; convert_key_to_num(GMkey,num); {the key pressed is used to display the arrow} display_single_arrow(num,cLIGHTMAGENTA); {displays highlighted arrow} escape_giant_web(roomItems,GMkey); if not escapeweb then {character stays still and misses animation} exit; GM_make_move(gamemap,GMkey,Xpos,Ypos,savecorner,hitwall,GMdone,change); decrease_tiles(tiles,gamemap,Xpos,Ypos); work_out_roomtype(gamemap,savekey,saveroom,roomtype,GMfirst); character_walks ( gfx2,gfx3,gfx4,saveXpos,saveYpos,savekey,movex,movey,1,5,savestep,hitwall, GMkey,items,roomItems,roomtype,gamemap,Xpos,Ypos,change,saveroom,0 ); display_tiles(tiles); if GMkey = CR then {if user misses turn} display_time_delay(wait,speed div 2); {pauses the comp character at the end of move} if gameover then {this line is not needed} exit; {clears 1 to 4 corners numbers. displays numbers in block_corners} { clrwin(600,140,635,155);} end; procedure block_corners( { blocks and displays the corner of the current square if the diagonal room's corner is blocked. the room has not been entered } var gamemap : gamemapType; roomtype : byte ); var a : byte; begin {sets the default block corners to false in limit array} for a := 1 to MAX_CORNERS do with gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)] do if not enable and (corner_defaults[roomtype,a] = 0) then limit[a] := false; if not gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)].enable then begin with gamemap[Xpos+(scrX*MAXCOL)-1,Ypos+(scrY*MAXROW)-1] do if enable then if limit[4] then gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)].limit[1] := true else gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)].limit[1] := false; with gamemap[Xpos+(scrX*MAXCOL)+1,Ypos+(scrY*MAXROW)-1] do if enable then if limit[3] then gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)].limit[2] := true else gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)].limit[2] := false; with gamemap[Xpos+(scrX*MAXCOL)-1,Ypos+(scrY*MAXROW)+1] do if enable then if limit[2] then gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)].limit[3] := true else gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)].limit[3] := false; with gamemap[Xpos+(scrX*MAXCOL)+1,Ypos+(scrY*MAXROW)+1] do if enable then if limit[1] then gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)].limit[4] := true else gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)].limit[4] := false; end; end; {procedure display_room_details( var gamemap : gamemapType ); var a,tmpx,tmpy : byte; begin} {displays if room is enabled, its type and the corners which are bocked} { with gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)] do begin clrwin(580,50,635,130); writeto(4,2,'Enable: '+cv(ord(enable)),580,50,10); writeto(4,2,'Type: '+cv(type1),580,70,10); tmpy := 0; tmpx := 0; for a := 1 to MAX_CORNERS do begin writeto(4,2,cv(ord(limit[a])),580+tmpx,90+tmpy,10); inc(tmpx,20); if a = 2 then begin tmpx := 0; tmpy := 20; end; end;} {clrwin(540,155,635,175);} {clears the above line} { writeto(4,2,'Scr: X: '+cv(scrX)+' Y: '+cv(scrY),540,155,10);} { clrwin(580,170,635,190); writeto(4,2,'X: '+cv(Xpos)+' Y: '+cv(Ypos),580,170,10);} { end; end;} procedure random_block_corners( var gamemap : gamemapType; savecorner : byte; var roomtype : byte; GMfirst : byte ); var a : byte; begin if GMfirst <= no_of_players*2 then exit; {avoids block corners on the 1st and 2nd tile} for a := 1 to MAX_CORNERS do with gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)] do if limit[a] and not enable then {works with the opened corners} if (corner_defaults[roomtype,a] <> 0) and (opposite_corner(savecorner) <> a) then if rnd_limits(0,DEADENDS) = 0 then limit[a] := false; end; procedure stores_player_info( var players : playersType; GMkey : char; savecorner : byte; roomtype : byte; Xpos,Ypos : byte; savestep : byte; saveXpos, saveYpos : byte ); begin with players[P] do begin s_Xpos := Xpos; s_Ypos := Ypos; s_scrX := scrX; s_scrY := scrY; s_saveX := {Xpos+(scrX*MAXCOL);}saveXpos; s_saveY := {Ypos+(scrY*MAXROW);}saveYpos; s_savekey := {save}GMkey; s_savecorner := savecorner; s_saveroom := roomtype; s_setblock := setblock; s_savestep := savestep; s_escapeweb := escapeweb; end; end; procedure restores_player_info( players : playersType; var Xpos,Ypos : byte; var savekey : char; var savecorner : byte; var saveroom : byte; var savestep : byte; var saveXpos, saveYpos : byte ); begin with players[P] do begin Xpos := s_Xpos; Ypos := s_Ypos; scrX := s_scrX; scrY := s_scrY; (* GMsaveX := {s_saveX;}Xpos+(scrX*MAXCOL); GMsaveY := {s_saveY;}Ypos+(scrY*MAXROW);*) saveXpos := s_saveX; saveYpos := s_saveY; savekey := s_savekey; savecorner := s_savecorner; saveroom := s_saveroom; setblock := s_setblock; savestep := s_savestep; escapeweb := s_escapeweb; end; end; (*procedure display_256_colours; {display after loading the palette for crypt graphics} var stepX,stepY,a,x,y : word; begin stepX := 10; stepY := 10; for a := 0 to 255 do begin writeto(3,2,cv(a),stepX-15,stepY,97); for x := 1 to 8 do for y := 1 to 8 do putpixel(stepX+x,stepY+y,a); inc(stepY,10); if a mod 32 = 0 then begin inc(stepX,40); stepY := 10; end; end; { readkey; halt;} cleardevice; writeto(5,2,'cBLUE',10,10,cBLUE); writeto(5,2,'cGREEN',10,30,cGREEN); writeto(5,2,'cCYAN',10,50,cCYAN); writeto(5,2,'cRED',10,70,cRED); writeto(5,2,'cMAGENTA',10,90,cMAGENTA); writeto(5,2,'cBROWN',10,110,cBROWN); writeto(5,2,'cLIGHTGRAY',10,130,cLIGHTGRAY); writeto(5,2,'cDARKGRAY',10,150,cDARKGRAY); writeto(5,2,'cLIGHTBLUE',10,170,cLIGHTBLUE); writeto(5,2,'cLIGHTGREEN',10,190,cLIGHTGREEN); writeto(5,2,'cLIGHTCYAN',10,210,cLIGHTCYAN); writeto(5,2,'cLIGHTRED',10,230,cLIGHTRED); writeto(5,2,'cLIGHTMAGENTA',10,250,cLIGHTMAGENTA); writeto(5,2,'cYELLOW',10,270,cYELLOW); writeto(5,2,'cWHITE',10,290,cWHITE); readkey; {for a := 1 to 15 do writeto(4,2,cv(a),500,300+(a*10),a); readkey;} end;*) procedure init_graphics( var gfx : gfxType; var gfx2 : gfxType2; var gfx3 : gfxType3; var gfx4 : gfxType4 ); var a : byte; begin for a := 1 to 23 do new(gfx[a]); for a := 1 to 21 do new(gfx2[a]); for a := 1 to 6 do new(gfx3[a]); for a := 1 to {14}6 do new(gfx4[a]); setvideo{(2)}; end; procedure close_graphics( var gfx : gfxType; var gfx2 : gfxType2; var gfx3 : gfxType3; var gfx4 : gfxType4 ); var a : byte; begin for a := 1 to 23 do dispose(gfx[a]); for a := 1 to 21 do dispose(gfx2[a]); for a := 1 to 6 do dispose(gfx3[a]); for a := 1 to {14}6 do dispose(gfx4[a]); end; procedure load_graphics( var gfx : gfxType; var gfx2 : gfxType2; var gfx3 : gfxType3; var gfx4 : gfxType4 ); begin load_pcx(0,0,630,30,44,'graphics\allmini',21,gfx,gfx2,gfx3); load_pcx(0,0,186,31,34,'graphics\knight',6,gfx,gfx2,gfx3); load_pcx2(0,0,652,565,163,113,'graphics\bits',6,gfx4); load_pcx(0,0,1150,50,75,'graphics\all',23,gfx,gfx2,gfx3); {163k in heap after this} { display_item(23,50,75,gfx);} { display_item(21,29,44,gfx2);} { display_item(6,30,33,gfx3);} (* display_item({14}6,163,113,gfx4);*) { halt;} end; procedure display_players_turn( partyNo : partyNoType; players : playersType ); begin if retreat = 1 then {keep the same P number and make it go through the gamemap and enter_game again} exit; repeat if P >= no_of_players then {next player's turn} P := 1 else inc(P); until partyNo[P] <> 0; {only uses players which are alive} if players[P].playerType = 1 then comp := false {human player this turn} else comp := true; clrwin(2,0,218,26); {clears players turns text} if players[P].playerType = 1 then writeto(3,1,'Player '+cv(P)+'''s turn',2,-2,cWHITE) else writeto(3,1,'Cpu '+cv(P)+'''s turn',2,-2,cWHITE); x3 := 1; {position of box in weapons box} y3 := 1; {resets after players turn ends} end; procedure test_until_characters_have_made_2_moves( {tests until all characters have made 2 moves at the start} var GMfirst : byte ); begin if GMfirst = no_of_players*2 then GMfirst := 99 else if GMfirst <> 99 then {stops counter when GMfirst = 99} inc(GMfirst); end; procedure setup_human_and_cpu_players( var no_of_players : byte; var players : playersType; options : optionsRec ); var a,tmp : byte; begin if gametype = 0 then {comp demo} begin no_of_players := rnd_limits(1,MAX_PLAYERS); for a := 1 to no_of_players do players[a].playerType := 2; {sets all players to cpu} exit; end else {players game} no_of_players := options.playersNo; {copies the current option number} with options do {gametype = 1} begin if gameNo in [1,2] then {init all players to human or cpu} for a := 1 to no_of_players do players[a].playerType := gameNo; if gameNo = 3 then {init players to a mix of human or cpu} begin case typeNo of {sets the amount of humans from the game mix} 1 : tmp := 3; 2 : tmp := 2; 3 : tmp := 1; 4 : tmp := 2; 5 : tmp := 1; 6 : tmp := 1; 7 : tmp := 1; end; for a := 1 to no_of_players do if a <= tmp then players[a].playerType := 1 {for human players} else players[a].playerType := 2; {for cpu players} end; end; end; procedure setup_first_room( var gamemap : gamemapType ); var a : byte; begin with gamemap[STARTX,STARTY] do begin enable := true; type1 := 3; for a := 1 to MAX_CORNERS do limit[a] := true; end; end; procedure start_and_stop_demo( var movesNo : byte; movesStart : byte; movesEnd : byte ); begin if gametype = 0 then begin inc(movesNo); if (movesNo = movesStart) and demo then {demo starts} begin demo := false; {turns display on} display_weapons_box; end; if movesNo = movesStart+movesEnd then {demo ends} begin gameover := true; {temporary uses gameover variable} exit; end; end; end; procedure setup_demo( var movesNo : byte; var movesStart : byte; var movesEnd : byte; var movesLoop : byte; tiles : byte ); begin if gametype = 0 then begin demo := false; {turns display on} writexy(4,1,'Loading',230,cLIGHTBLUE); demo := true; {turns display off} delay(1000); movesNo := 0; movesLoop := 1; movesEnd := rnd_limits(10,30){5}; if movesLoop >= 2 then movesStart := 1 else movesStart := rnd_limits(20,tiles); {movesStart is not in tiles format} end; end; procedure player_retreats( var gfx2 : gfxType2; var gfx3 : gfxType3; var gfx4 : gfxType4; var saveXpos, saveYpos : byte; savekey : char; var movex, movey : integer; start1, end1 : byte; var savestep : byte; {the position the character is at the start of game, either 1 or 4} hitwall : boolean; var GMkey : char; {just for the hitwall sound} items : itemsType; roomItems : roomItemsType; var roomtype : byte; var gamemap : gamemaptype; var Xpos,Ypos : byte; change : boolean; {passes TRUE in with retreat animation} saveroom : byte; type1 : byte; var savecorner : byte; var players_tmp : playersRec; var players : playersType; var quitGM : boolean; GMfirst : byte ); begin quitGM := false; if retreat = 1 then begin {retreat sequence, step 3} saveXpos := Xpos; {just to store these variables} saveYpos := Ypos; movex := 0; {for moving character} movey := 0; {step4, last step. ends the retreat sequence and sets to end turn. maybe still have to enter room.} retreat := 3; {number 3 ends the retreat} hitwall := false; {tests if corner is closed. Incase earthquake happens when retreating} if not gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)].limit[opposite_corner(savecorner)] then hitwall := true; if not hitwall then begin savecorner := opposite_corner(savecorner); {used when player reverses} players_tmp.s_savecorner := savecorner; end; character_walks {retreat animation} ( gfx2,gfx3,gfx4,saveXpos,saveYpos,savekey,movex,movey,1,10,savestep,hitwall, GMkey,items,roomItems,roomtype,gamemap,Xpos,Ypos,{change}true,saveroom,1 ); if not hitwall then begin players[P] := players_tmp; {updates new numbers} Xpos := players_tmp.s_Xpos; {updates this for enter_room} Ypos := players_tmp.s_Ypos; work_out_roomtype(gamemap,savekey,saveroom,roomtype,GMfirst); quitGM := true; {already made move, so go into room} end; end; end; procedure gamemap1( var roomtype : byte; var players : playersType; var tiles : byte; var GMfirst : byte; var gamemap : gamemapType; partyNo : partyNoType; items : itemsType; var roomItems : roomItemsType; var gfx2 : gfxType2; var gfx3 : gfxType3; var gfx4 : gfxType4; var savestep : byte; var players_tmp : playersRec; var weapons : weaponsType; party : partyType; var boxes : boxesType; rules : rulesRec; boxesNo : byte; var gfx : gfxType ); var GMdone : boolean; saveroom : byte; {saves previous room} savekey : char; {saves previous move} savecorner : byte; {prevents character walking back the way he came} GMkey : char; change : boolean; movex, movey : integer; {for moving character} saveXpos, saveYpos : byte; hitwall : boolean; quitGM : boolean; {just to exit procedure with the retreat} begin clr_main_area; GMinitialise(Xpos,Ypos,saveroom,savekey,players,GMfirst); display_arrows; test_until_characters_have_made_2_moves(GMfirst); restores_player_info(players,Xpos,Ypos,savekey,savecorner,saveroom,savestep,saveXpos,saveYpos); display_screen(gamemap,players,partyNo,items,roomItems,gfx2,gfx3,gfx4); player_retreats ( gfx2,gfx3,gfx4,saveXpos,saveYpos,savekey,movex,movey,1,10,savestep,hitwall, GMkey,items,roomItems,roomtype,gamemap,Xpos,Ypos,{change}true,saveroom,1, savecorner,players_tmp,players,quitGM,GMfirst ); if quitGM then {quits this procedure when retreat = 1 and is used with player_retreats} exit; move_to_next_room (gamemap,Xpos,Ypos,savecorner,GMdone,saveroom,savekey,roomtype,GMkey, tiles,GMfirst,movex,movey,saveXpos,saveYpos,change,hitwall,gfx2,gfx3, gfx4,savestep,items,roomItems,players_tmp,players,weapons,partyNo,party,boxes,rules,boxesNo,gfx); { work_out_roomtype(gamemap,savekey,saveroom,roomtype,GMfirst);} work_out_open_corners(savecorner,Xpos,Ypos,gamemap,roomtype,GMfirst); block_corners(gamemap,roomtype); random_block_corners(gamemap,savecorner,roomtype,GMfirst); { display_room_details(gamemap);} stores_player_info(players,GMkey,savecorner,roomtype,Xpos,Ypos,savestep,saveXpos,saveYpos); if not escapeweb then {if the player is trapped by the web then it exits} exit; if not change then begin display_block_corners(gamemap,Xpos,Ypos,roomtype); display_graphics(gamemap,roomtype,Xpos,Ypos); display_connect_lines(Xpos,Ypos,roomtype,gamemap); end; if not hitwall then character_walks ( gfx2,gfx3,gfx4,saveXpos,saveYpos,savekey,movex,movey,6,10,savestep,hitwall, GMkey,items,roomItems,roomtype,gamemap,Xpos,Ypos,change,saveroom,0 ); with gamemap[Xpos+(scrX*MAXCOL),Ypos+(scrY*MAXROW)] do {saves current room or halls details} if not enable then enable := true; end; procedure play_game( items : itemsType; var tiles : byte; var score : scoreType; var weapons : weaponsType; options : optionsRec; var partyNo : partyNoType; var players : playersType; gametype : byte; {global variable} var gfx : gfxType; var gfx2 : gfxType2; var gfx3 : gfxType3; var gfx4 : gfxType4 ); var {these variables are for the gamemap} party : partyType; {84 bytes} roomtype : byte; {hall, corners and room} GMfirst : byte; {player is still on the 1st or 2nd tile} gamemap : ^gamemapType; {3510, 13250, 29230, 51440 bytes for scrMax 1 to 4} roomItems : ^roomItemsType; {450 bytes for 50 rooms} savestep : byte; players_tmp : playersRec; {these variables are for the room} person : byte; {enter room variables} boxesNo : byte; boxes : boxesType; enemystr, teamstr : byte; skip : boolean; rules : rulesRec; action : actionType; {160 bytes} actionsNo, choice : byte; once, twice, third : boolean; endnum : byte; battle : battleType; exit1, timeout : boolean; {these variables are for the demo} movesNo : byte; {counts all the gamemap moves, for demo timeout} movesStart, movesEnd : byte; movesLoop : byte; ok1 : boolean; begin {cleardevice; setcolor(150); outtextxy(10,30,cv(sizeof(gamemapType))); readkey; halt;} new(gamemap); new(roomItems); repeat setup_human_and_cpu_players(no_of_players,players,options); initialise(party,partyNo,weapons,tiles,score,options,no_of_players,GMfirst,savestep); display_weapons_box; init_rooms(gamemap^,roomItems^); setup_first_room(gamemap^); setup_demo(movesNo,movesStart,movesEnd,movesLoop,tiles); repeat {main game starts} start_and_stop_demo(movesNo,movesStart,movesEnd); if (gametype = 0) and gameover then break; {ends the demo} clr_main_area; secs := options.timeno; {changes to 60secs for each player's turn} display_players_turn(partyNo,players); display_time; {display the time for 1 sec here to fix minor bug} display_tiles(tiles); display_team(items,party,1,partyNo[P]); {updates the team list on weapons box} display_weapons(items,weapons,1,partyNo[P]); display_weight(items,weapons,party,1,partyNo[P]); gamemap1 (roomtype,players,tiles,GMfirst,gamemap^,partyNo,items,roomItems^, gfx2,gfx3,gfx4,savestep,players_tmp,weapons,party,boxes,rules,boxesNo,gfx); if gameover then break; if retreat = 3 then {end of retreat sequence} retreat := 2 else if roomtype = 3 then {start of room} begin setup_room ( items,rules,boxesNo,boxes,weapons,partyNo,party,teamstr,enemystr, battle,person,skip,once,twice,third,exit1,timeout,options,roomItems^,gfx,gamemap^ ); {test} {rules.cross := true; rules.sword := true; rules.potion := true;} {change get_items as well} repeat make_actions (rules,action,actionsNo,boxesNo,boxes,once,person,twice,third,roomItems^); display_actions(items,action,actionsNo); if not comp then select_number (actionsNo,choice,endnum,enemystr,teamstr,items,action,rules, timeout,players,weapons,partyNo,party,roomItems^,boxes,roomtype,boxesNo,gamemap^,gfx) else computer_move(actionsNo,choice,endnum,person,teamstr,enemystr,partyNo,rules,action,exit1,items,roomItems^); if timeout then msgpause := 300; {speeds up the msgpause when timeout} if (endnum = choice) or gameover then break; if action[choice].type2 <> 0 then begin use_weapons ( items,partyNo,party,teamstr,enemystr,rules,boxesNo,boxes, weapons,battle,person,third,action,choice,actionsNo,twice,score,roomItems^,gfx,gamemap^ ); if gameover or (partyNo[P] = 0) then break; end else if rules.ppl and not rules.pickup and once then begin attack_or_talk ( items,partyNo,party,teamstr,enemystr,rules,boxesNo,boxes, weapons,battle,person,choice,once,score,roomItems^,gfx,gamemap^ ); if gameover or (partyNo[P] = 0) then break; end; if rules.pickup or not rules.ppl then if action[choice].pos in [ITEM_MIN..ITEM_MAX] then add_weapons ( items,weapons,boxes,action,actionsNo,choice,party,partyNo,roomItems^ ); until skip; {end of room} if gameover or (tiles = 1) then {exit}break; if timeout then {turns comp off and returns the speed back to normal} begin comp := false; msgpause := 1500; {sets to normal speed} timeout := false; end; end; if gameover then break; clear_weight(weapons,1,partyNo[P]); clear_weapons(weapons,1,partyNo[P]); clear_team(1,partyNo[P]); until tiles = 0; ok1 := true; {these 4 lines are for the demo} inc(movesLoop); if movesNo < movesStart then {game ended too quick. so trys game again} ok1 := false; { clrwin(0,300,50,320); writeto(5,2,'movesno: '+cv(movesNo),0,300,100); readkey;} until ok1; dispose(gamemap); dispose(roomItems); end; { start of main program } const menu_names : namesType = ('Play','Options','Game','Help','Exit'); options_names : namesType = ('Speed','Time','Sound','Demo','Exit'); game_names : namesType = ('Players','Type','Game','Exit',''); var items : ^itemsType; {936 bytes} hi_score : hi_scoreType; {70 bytes} tiles : byte; score : scoreType; weapons : ^weaponsType; {140 bytes} options : optionsRec; {7 bytes} row : byte; done : boolean; finish : boolean; partyNo : partyNoType; maxplayer : byte; menucnt : byte; players : playersType; {44 bytes} gfx : gfxType; gfx2 : gfxType2; gfx3 : gfxType3; gfx4 : gfxType4; begin { register_files;} { open_graphics_library;} new(items); new(weapons); init_graphics(gfx,gfx2,gfx3,gfx4); load_graphics(gfx,gfx2,gfx3,gfx4); read_items(items^); read_hi_score_from_disk(hi_score); init_startup(options,finish,menucnt); intro_help(1,row); repeat init_start_game(options,row,done); inc(menucnt); if not odd(menucnt) then {if number is 2,4,6} begin display_menu_title; repeat {menus} main_menu(row,5,menu_names,done,options,0,hi_score); case row of 1 : begin play_game(items^,tiles,score,weapons^,options,partyNo,players,1{gametype},gfx,gfx2,gfx3,gfx4); if not gameover{tiles = 0} then begin calc_score(score,weapons^,items^); display_score(score,partyNo,maxplayer,players{,1}); enter_hiscore(hi_score,score,maxplayer,players); write_hi_score_to_disk(hi_score); end; done := true; menucnt := 0; end; 2 : main_menu(row,5,options_names,done,options,1,hi_score); 3 : main_menu(row,4,game_names,done,options,2,hi_score); 4 : begin help_page1; help_page2; intro_help(2,row); end; 5 : begin dispose(items); dispose(weapons); close_graphics(gfx,gfx2,gfx3,gfx4); closegame; end; end; until done; {main menu ends} end; case menucnt of 1 : intro; 3 : begin sort_hiscore(hi_score); display_hiscore(hi_score); end; 5 : begin demo := true; gametype := 0; play_game(items^,tiles,score,weapons^,options,partyNo,players,gametype,gfx,gfx2,gfx3,gfx4); end; end; if menucnt > 6 then {starts at the beginning} menucnt := 0; until finish; {game quits} end. { end of main program }