├── source ├── moria.env ├── macro │ ├── minmax.mar │ ├── randint.mar │ ├── bitpos.mar │ ├── maxmin.mar │ ├── randrep.mar │ ├── distance.mar │ ├── insert.mar │ └── putqio.mar ├── include │ ├── staffs.inc │ ├── wands.inc │ ├── prayer.inc │ ├── eat.inc │ ├── magic.inc │ ├── desc.inc │ ├── potions.inc │ ├── help.inc │ ├── constants.inc │ ├── store1.inc │ ├── variables.inc │ ├── death.inc │ ├── types.inc │ ├── wizard.inc │ ├── scrolls.inc │ ├── create.inc │ ├── io.inc │ └── save.inc ├── moria.pas └── termdef.pas ├── execute └── moriahlp.hlb ├── doc ├── aaareadme.1st └── install.rno ├── vms4.txt ├── README.md └── aaareadme.1st /source/moria.env: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dungeons-of-moria/vms-moria/HEAD/source/moria.env -------------------------------------------------------------------------------- /execute/moriahlp.hlb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dungeons-of-moria/vms-moria/HEAD/execute/moriahlp.hlb -------------------------------------------------------------------------------- /doc/aaareadme.1st: -------------------------------------------------------------------------------- 1 | MORIA DOCUMENTATION NOTES V 4.5 2 | 3 | Be advised, this documentation has not kept pace with the Moria game. You 4 | will find most of the charts are out of date, and should be modified to 5 | reflect the actual values in the game. Most of the command descriptions, 6 | and game overviews are still essentially correct. 7 | -------------------------------------------------------------------------------- /source/macro/minmax.mar: -------------------------------------------------------------------------------- 1 | ; 2 | ; Robert Koeneke 3 | ; September 1, 1984 4 | ; MORIA subroutine 5 | ; Macro function for : 6 | ; 7 | ; MIN( MAX( y , x ) + 1 , z ) 8 | ; 9 | .title MINMAX Returns the min of a max and a number. 10 | .ident /minmax/ 11 | .psect misc1$code,pic,con,rel,lcl,shr,exe,rd,nowrt,2 12 | .entry minmax,^M<> 13 | movl 4(ap),r0 14 | movl 8(ap),r1 15 | cmpl r0,r1 16 | bgeq 1$ 17 | movl r1,r0 18 | 1$: incl r0 19 | cmpl r0,12(ap) 20 | bgtr 2$ 21 | ret 22 | 2$: movl 12(ap),r0 23 | ret 24 | .end 25 | -------------------------------------------------------------------------------- /source/macro/randint.mar: -------------------------------------------------------------------------------- 1 | ; 2 | ; Macro function for : 3 | ; 4 | ; y := RANDINT(x) where y receives an integer 5 | ; 1 <= y <= x 6 | ; 7 | ; Seed is a global variable declared in PASCAL main. 8 | ; 9 | .title randint Uniform random number generator 10 | .ident /randint/ 11 | .psect misc1$code,pic,con,rel,lcl,shr,exe,rd,nowrt,2 12 | .entry randint,^M<> 13 | mull2 #16807,seed 14 | bicl2 #^X80000000,seed 15 | subl3 #1,seed,r0 16 | emul r0,4(ap),#0,r0 17 | ediv #2147483647,r0,r0,r1 18 | addl2 #1,r0 19 | ret 20 | .end 21 | 22 | -------------------------------------------------------------------------------- /source/macro/bitpos.mar: -------------------------------------------------------------------------------- 1 | ; 2 | ; Robert Koeneke 3 | ; September 1, 1984 4 | ; MORIA subroutine 5 | ; Macro function for : 6 | ; 7 | ; y := bitpos(x) 8 | ; Locate first set bit in x and return that position 9 | ; in y. 10 | ; Clear bit in x. 11 | ; 12 | .title BIT_POS Return location of next bit 13 | .ident /bit_pos/ 14 | .psect misc1$code,pic,con,rel,lcl,shr,exe,rd,nowrt,2 15 | .entry bit_pos,^M<> 16 | ffs #0,#32,@4(ap),r0 17 | beql 2$ 18 | bbsc r0,@4(ap),1$ 19 | 1$: incl r0 20 | ret 21 | 2$: clrl r0 22 | ret 23 | .end 24 | -------------------------------------------------------------------------------- /source/macro/maxmin.mar: -------------------------------------------------------------------------------- 1 | ; 2 | ; Robert Koeneke 3 | ; September 1, 1984 4 | ; MORIA subroutine 5 | ; Macro function for : 6 | ; 7 | ; MAX( MIN( x , y ) - 1 , z ) 8 | ; Arguments in order x, y, z 9 | ; 10 | .title MAXMIN Retruns the max of a min and number. 11 | .ident /maxmin/ 12 | .psect misc1$code,pic,con,rel,lcl,shr,exe,rd,nowrt,2 13 | .entry maxmin,^M<> 14 | movl 4(ap),r0 15 | movl 8(ap),r1 16 | cmpl r1,r0 17 | bgeq 1$ 18 | movl r1,r0 19 | 1$: decl r0 20 | cmpl 12(ap),r0 21 | bgtr 2$ 22 | ret 23 | 2$: movl 12(ap),r0 24 | ret 25 | .end 26 | -------------------------------------------------------------------------------- /source/macro/randrep.mar: -------------------------------------------------------------------------------- 1 | ; 2 | ; Macro function for : 3 | ; 4 | ; For i := 1 to y do sum := sum + randint(x) 5 | ; where RANDINT returns random integer 1 <= r <= x 6 | ; 7 | ; Seed is a global variable declared in PASCAL main 8 | ; 9 | .title RAND_REP 10 | .ident /rand_rep/ 11 | .psect misc1$code,pic,con,rel,lcl,shr,exe,rd,nowrt,2 12 | .entry rand_rep,^M 13 | movl 4(ap),r4 14 | cmpl r4,#0 15 | bleq 2$ 16 | movl #0,r0 17 | 1$: mull2 #16807,seed 18 | bicl2 #^X80000000,seed 19 | subl3 #1,seed,r2 20 | emul r2,8(ap),#0,r2 21 | ediv #2147483647,r2,r2,r3 22 | addl r2,r0 23 | sobgtr r4,1$ 24 | addl 4(ap),r0 25 | ret 26 | 2$: movl #0,r0 27 | ret 28 | .end 29 | 30 | -------------------------------------------------------------------------------- /source/macro/distance.mar: -------------------------------------------------------------------------------- 1 | ; 2 | ; Programmer: RAK V4.3 3 | ; Macro function for : 4 | ; 5 | ; dis := distance(y1,x1,y2,x2) 6 | ; 7 | ; Distance returned is only an approximation based on : 8 | ; 9 | ; dy = abs(y1-y2) 10 | ; dx = abs(x1-x2) 11 | ; 12 | ; distance = 2*(dy+dx) - MIN(dy,dx) 13 | ; ---------------------- 14 | ; 2 15 | ; 16 | .title DISTANCE Integer distance between two points 17 | .ident /distance/ 18 | .psect misc1$code,pic,con,rel,lcl,shr,exe,rd,nowrt,2 19 | .entry distance,^M<> 20 | subl3 4(ap),12(ap),r0 21 | bgeq 1$ 22 | mnegl r0,r0 23 | 1$: subl3 8(ap),16(ap),r1 24 | bgeq 2$ 25 | mnegl r1,r1 26 | 2$: cmpl r0,r1 27 | bgeq 3$ 28 | addl2 r1,r1 29 | brb 4$ 30 | 3$: addl2 r0,r0 31 | 4$: addl2 r1,r0 32 | ashl #-1,r0,r0 33 | ret 34 | .end 35 | -------------------------------------------------------------------------------- /vms4.txt: -------------------------------------------------------------------------------- 1 | 2 | In VMS 4.0 the following device driver bug is fixed: 3 | 4 | VAX/VMS Systems Dispatch, March 1985; AD-L034A-24 5 | Page 26 6 | Process hangs in LEF wait state 7 | 8 | This bug was a problem in MORIA. It was fixed by pausing just 9 | before requesting input via QIO. If you are running VMS 4.0 or 10 | greater, you should remove these pauses from IO.INC. Comments 11 | showing what code should be removed are placed just before each 12 | affected section. You may search for 'VMS 4.0' to locate all 13 | of these sections. 14 | 15 | In addition, you should remove comments around a single line of 16 | code in MORIA.INC. This line causes the player to hibernate 17 | one second for every twenty turns of resting performed, which 18 | keeps a resting player from eating up the system's CPU. Again 19 | there is a comment just before the affected line. 20 | 21 | 22 | -SYSRK- 23 | -------------------------------------------------------------------------------- /source/macro/insert.mar: -------------------------------------------------------------------------------- 1 | ; Robert Koeneke 2 | ; 09-20-84 3 | ; Module : 4 | ; Insert - Searches for match string and replaces 5 | ; a match with a replacement string. 6 | ; No checking is done. 7 | ; 8 | .title INSERT_STR Insert a string 9 | .ident /insert_str/ 10 | .psect misc1$code,pic,con,rel,lcl,shr,exe,rd,nowrt,2 11 | .entry INSERT_STR,^M 12 | movl 4(ap),r4 ; Address of source string 13 | movl 8(ap),r5 ; Address of match string 14 | matchc (r5),2(r5),(r4),2(r4) ; Look for match 15 | bneq 1$ ; No match? 16 | movl r3,r6 ; Save for second MOVC 17 | movzwl (r5),r0 ; Length of match string 18 | subl2 r0,r6 ; Dest for second MOVC 19 | subw3 (r5),@12(ap),r1 ; rep_len - mtc_len 20 | cvtwl r1,r1 ; Convert to longword 21 | addw r1,(r4) ; Zap length of source 22 | addl2 r3,r1 ; R1=Move to, R3=Move from 23 | movc3 r2,(r3),(r1) ; Adjust source string 24 | movl 12(ap),r0 ; Address of replace string 25 | movc3 (r0),2(r0),(r6) ; Put replace string into source 26 | 1$: ret 27 | .end 28 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # VMS Moria 4.8 2 | 3 | _The Dungeons of Moria_ is a single player dungeon simulation originally 4 | written by Robert Alan Koeneke and first released in 1983 (although Koeneke 5 | wrote a VMS Basic version of Moria the year before in 1982). Moria has 6 | inspired many other games including _Angband_ and perhaps the most famous 7 | roguelike of all, _Diablo_! 8 | 9 | This repository contains the original VMS Pascal source code as written 10 | by Robert Alan Koeneke, and assistant programmers Jimmey Wayne Todd and 11 | Gary D. McAdoo. 12 | 13 | Want to play Moria? 14 | 15 | Most people do not have access to a machine capable of running VMS. Luckily, 16 | Moria was rewritten in the C language a few years later and released as 17 | Umoria. Recently it was made available for the 18 | [Windows and macOS platforms](https://github.com/dungeons-of-moria/umoria). 19 | 20 | 21 | ## Summary 22 | 23 | The game of MORIA is a single player dungeon simulation. A player may choose 24 | from a number of races and classes when creating their character, and then 25 | 'run' that character over a period of days, weeks, even months; attempting to 26 | win the game by defeating the Balrog which lurks in the deeper levels. The 27 | player will begin their adventure on the town level where they may acquire 28 | supplies, weapons, armor, and magical devices by bartering with various shop 29 | owners. After preparing for their adventure, the player can descend into the 30 | dungeons of MORIA, where fantastic adventures await their coming! 31 | 32 | 33 | _If you have any other version of VMS Moria than 4.43 and 4.8, then please get 34 | in touch so we can add that code to this repository._ 35 | -------------------------------------------------------------------------------- /source/macro/putqio.mar: -------------------------------------------------------------------------------- 1 | ; PUTQIO - contains two related functions, PUT_BUFFER and PUT_QIO. 2 | ; PUT_BUFFER accepts an (row,col) cursor address, and a 3 | ; string. Cursor positioning characters are added into 4 | ; the buffer in front of the string. Buffer dumps if it 5 | ; becomes too full. 6 | ; PUT_QIO performs the buffer dump operation. It can be 7 | ; called externally, or by PUT_BUFFER. 8 | ; 9 | ; 10 | ; Globals used: (Declared in MORIA pascal code) 11 | ; cursor_r: array of 24 strings (6 bytes) 12 | ; curlen_r: length of each row string 13 | ; cursor_c: array of 80 strings (6 bytes) 14 | ; curlen_c: length of each col string 15 | ; cursor_l: Total length of row and col 16 | ; row_first: Boolean (1,0) 17 | ; 1 - Row,Col format 18 | ; 0 - Col,Row format 19 | ; 20 | ; Registers: 21 | ; R0 Used by MOVC 22 | ; R1 Used by MOVC 23 | ; R2 Used by MOVC 24 | ; R3 Used by MOVC 25 | ; R4 Used by MOVC 26 | ; R5 Used by MOVC 27 | ; 28 | ; This IO routine does no index checking. 29 | ; 30 | .title PUT_QIO Build and dump IO buffer\ 31 | .ident /put_qio/ 32 | .psect IOBUF$DATA 33 | ; 34 | IO$_WRITEVBLK: .long 48 ; See STARLET ($IODEF) 35 | out_buf: .blkb 1024 ; Size in bytes of buffer 36 | out_len: .long 0 ; Current length of buffer 37 | ; 38 | ; 39 | .psect IO$CODE,pic,con,rel,lcl,shr,exe,rd,nowrt,2 40 | .entry PUT_BUFFER,^M 41 | ; 42 | movab out_buf,r3 ; Address of output buffer. 43 | addl2 out_len,r3 ; Buffer may be partially full. 44 | cmpl row_first,#0 ; Test for row first 45 | bgtr 1$ ; Branch to row,col format 46 | ; Col,Row format 47 | mull3 #12,12(ap),r1 ; (8 bytes * index) for col. 48 | movab cursor_c-10[r1],r1 ; Address of needed col coord. 49 | movc3 curlen_c,(r1),(r3) ; Move col cursor characters. 50 | mull3 #12,8(ap),r1 ; (8 bytes * index) for row. 51 | movab cursor_r-10[r1],r1 ; Address of needed row coord. 52 | movc3 curlen_r,(r1),(r3) ; Move row cursor characters. 53 | brb 2$ ; Branch to copy string 54 | 1$: ; Row,Col format 55 | mull3 #12,8(ap),r1 ; (8 bytes * index) for row. 56 | movab cursor_r-10[r1],r1 ; Address of needed row coord. 57 | movc3 curlen_r,(r1),(r3) ; Move row cursor characters. 58 | mull3 #12,12(ap),r1 ; (8 bytes * index) for col. 59 | movab cursor_c-10[r1],r1 ; Address of needed col coord. 60 | movc3 curlen_c,(r1),(r3) ; Move col cursor characters. 61 | 2$: ; Copy String 62 | tstw @4(ap) ; No string? 63 | beql 3$ ; No move needed. 64 | movl 4(ap),r1 ; Move address of string arg. 65 | movc3 @4(ap),2(r1),(r3) ; Move string arg into output buff. 66 | 3$: 67 | addw3 cursor_l,@4(ap),r1 ; Total length of new output 68 | addw2 r1,out_len ; Total length of saved output 69 | cmpw out_len,#900 ; Buffer getting full? 70 | bgtr DUMP_QIO ; Output the buffer... 71 | ret ; return from PUT_BUFFER 72 | ; 73 | ; PUT_QIO entry point 74 | PUT_QIO:: 75 | .word 0 76 | ; 77 | DUMP_QIO: 78 | $QIOW_S EFN=#6, - ; Unique event flag 79 | CHAN=channel, - ; Output the buffer 80 | FUNC=IO$_WRITEVBLK, - ; Write virtual block 81 | P1=out_buf, - ; Address of buffer 82 | P2=out_len ; Buffers current length 83 | ; 84 | movw #0,out_len ; Clear buffer; 85 | ret ; Return from PUT_QIO 86 | ; 87 | .end 88 | -------------------------------------------------------------------------------- /source/include/staffs.inc: -------------------------------------------------------------------------------- 1 | { Use a staff... -RAK- } 2 | [psect(misc2$code)] procedure use; 3 | var 4 | i1 : unsigned; 5 | i2,i3,item_val,chance : integer; 6 | out_val : vtype; 7 | redraw,ident : boolean; 8 | begin 9 | reset_flag := true; 10 | if (inven_ctr > 0) then 11 | begin 12 | if (find_range([55],i2,i3)) then 13 | begin 14 | redraw := false; 15 | if (get_item(item_val,'Use which staff?',redraw,i2,i3)) then 16 | with inventory[item_val] do 17 | begin 18 | if (redraw) then draw_cave; 19 | reset_flag := false; 20 | with py.misc do 21 | chance := save + lev + int_adj - level - 5; 22 | if (py.flags.confused > 0) then 23 | chance := trunc(chance/2.0); 24 | if (chance < 0) then chance := 0; 25 | if (randint(chance) < use_device) then 26 | msg_print('You failed to use the staff properly.') 27 | else if (p1 > 0) then 28 | begin 29 | i1 := flags; 30 | ident := false; 31 | p1 := p1 - 1; 32 | while (i1 > 0) do 33 | begin 34 | i2 := bit_pos(i1); 35 | { Staffs... } 36 | case (i2) of 37 | 1 : ident := light_area(char_row,char_col); 38 | 2 : ident := detect_sdoor; 39 | 3 : ident := detect_trap; 40 | 4 : ident := detect_treasure; 41 | 5 : ident := detect_object; 42 | 6 : begin 43 | teleport(100); 44 | ident := true; 45 | end; 46 | 7 : ident := earthquake; 47 | 8 : begin 48 | for i3 := 1 to randint(4) do 49 | begin 50 | y := char_row; 51 | x := char_col; 52 | summon_monster(y,x,false); 53 | end; 54 | ident := true; 55 | end; 56 | 9 : ident := genocide; 57 | 10 : ident := destroy_area(char_row,char_col); 58 | 11 : ident := starlite(char_row,char_col); 59 | 12 : ident := speed_monsters(+1); 60 | 13 : ident := speed_monsters(-1); 61 | 14 : ident := sleep_monsters2; 62 | 15 : ident := hp_player(randint(8),'a staff.'); 63 | 16 : ident := detect_invisible; 64 | 17 : begin 65 | py.flags.fast := py.flags.fast + randint(30) + 15; 66 | ident := true; 67 | end; 68 | 18 : begin 69 | py.flags.slow := py.flags.slow + randint(30) + 15; 70 | ident := true; 71 | end; 72 | 19 : ident := mass_poly; 73 | 20 : if (remove_curse) then 74 | begin 75 | msg_print('The staff glows blue for a moment...'); 76 | ident := true; 77 | end; 78 | 21 : ident := detect_evil; 79 | 22 : if ((cure_blindness) or (cure_poison) or (cure_confusion)) then 80 | ident := true; 81 | 23 : ident := dispell_creature(%X'0004',60); 82 | 24 : ident := mass_genocide; 83 | 25 : ident := unlight_area(char_row,char_col); 84 | otherwise ; 85 | end; 86 | { End of staff actions... } 87 | end; 88 | if (ident) then 89 | identify(inventory[item_val]); 90 | if (flags <> 0) then 91 | with py.misc do 92 | begin 93 | exp := exp + round(level/lev); 94 | prt_experience; 95 | end; 96 | desc_charges(item_val); 97 | end 98 | end 99 | else 100 | if (redraw) then draw_cave; 101 | end 102 | else 103 | msg_print('You are not carrying any staffs.'); 104 | end 105 | else 106 | msg_print('But you are not carrying anything.'); 107 | end; 108 | -------------------------------------------------------------------------------- /source/include/wands.inc: -------------------------------------------------------------------------------- 1 | { Wands for the aiming... } 2 | [psect(misc2$code)] procedure aim; 3 | var 4 | i1 : unsigned; 5 | i2,i3,i4,chance : integer; 6 | dir,item_val : integer; 7 | dumy,y_dumy,x_dumy : integer; 8 | out_val : vtype; 9 | redraw,ident : boolean; 10 | begin 11 | redraw := false; 12 | reset_flag := true; 13 | if (inven_ctr > 0) then 14 | begin 15 | if (find_range([65],i2,i3)) then 16 | begin 17 | if (get_item(item_val,'Aim which wand?',redraw,i2,i3)) then 18 | with inventory[item_val] do 19 | begin 20 | if (redraw) then draw_cave; 21 | reset_flag := false; 22 | redraw := false; 23 | y_dumy := char_row; 24 | x_dumy := char_col; 25 | if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then 26 | begin 27 | if (py.flags.confused > 0) then 28 | begin 29 | msg_print('You are confused...'); 30 | repeat 31 | dir := randint(9); 32 | until(dir <> 5); 33 | end; 34 | i1 := flags; 35 | ident := false; 36 | with py.misc do 37 | chance := save + lev + int_adj - level; 38 | if (py.flags.confused > 0) then 39 | chance := trunc(chance/2.0); 40 | if (chance < 0) then chance := 0; 41 | if (randint(chance) < use_device) then 42 | msg_print('You failed to use the wand properly.') 43 | else if (p1 > 0) then 44 | begin 45 | p1 := p1 - 1; 46 | while (i1 > 0) do 47 | begin 48 | i2 := bit_pos(i1); 49 | i3 := char_row; 50 | i4 := char_col; 51 | { Wands } 52 | case (i2) of 53 | 1 : begin 54 | msg_print('A line of blue shimmering light appears.'); 55 | light_line(dir,char_row,char_col); 56 | ident := true; 57 | end; 58 | 2 : begin 59 | fire_bolt(1,dir,i3,i4,damroll('3d8'),'Lightning Bolt'); 60 | ident := true; 61 | end; 62 | 3 : begin 63 | fire_bolt(4,dir,i3,i4,damroll('4d8'),'Frost Bolt'); 64 | ident := true; 65 | end; 66 | 4 : begin 67 | fire_bolt(5,dir,i3,i4,damroll('6d8'),'Fire Bolt'); 68 | ident := true; 69 | end; 70 | 5 : ident := wall_to_mud(dir,i3,i4); 71 | 6 : ident := poly_monster(dir,i3,i4); 72 | 7 : ident := hp_monster(dir,i3,i4,-damroll('4d6')); 73 | 8 : ident := speed_monster(dir,i3,i4,1); 74 | 9 : ident := speed_monster(dir,i3,i4,-1); 75 | 10 : ident := confuse_monster(dir,i3,i4); 76 | 11 : ident := sleep_monster(dir,i3,i4); 77 | 12 : ident := drain_life(dir,i3,i4); 78 | 13 : ident := td_destroy2(dir,i3,i4); 79 | 14 : begin 80 | fire_bolt(0,dir,i3,i4,damroll('2d6'),'Magic Missile'); 81 | ident := true; 82 | end; 83 | 15 : ident := build_wall(dir,i3,i4); 84 | 16 : ident := clone_monster(dir,i3,i4); 85 | 17 : ident := teleport_monster(dir,i3,i4); 86 | 18 : ident := disarm_all(dir,i3,i4); 87 | 19 : begin 88 | fire_ball(1,dir,i3,i4,24,'Lightning Ball'); 89 | ident := true; 90 | end; 91 | 20 : begin 92 | fire_ball(4,dir,i3,i4,32,'Cold Ball'); 93 | ident := true; 94 | end; 95 | 21 : begin 96 | fire_ball(5,dir,i3,i4,48,'Fire Ball'); 97 | ident := true; 98 | end; 99 | 22 : begin 100 | fire_ball(2,dir,i3,i4,8,'Stinking Cloud'); 101 | ident := true; 102 | end; 103 | 23 : begin 104 | fire_ball(3,dir,i3,i4,40,'Acid Ball'); 105 | ident := true; 106 | end; 107 | 24 : i1 := 2**(randint(24) - 1); 108 | otherwise ; 109 | end; 110 | { End of Wands... } 111 | end; 112 | if (ident) then 113 | identify(inventory[item_val]); 114 | if (flags <> 0) then 115 | with py.misc do 116 | begin 117 | exp := exp + round(level/lev); 118 | prt_experience; 119 | end; 120 | desc_charges(item_val); 121 | end 122 | end 123 | end 124 | end 125 | else 126 | msg_print('You are not carrying any wands.'); 127 | end 128 | else 129 | msg_print('But you are not carrying anything.'); 130 | if (redraw) then draw_cave; 131 | end; 132 | -------------------------------------------------------------------------------- /source/include/prayer.inc: -------------------------------------------------------------------------------- 1 | { Pray like HELL... -RAK- } 2 | [psect(misc2$code)] procedure pray; 3 | var 4 | i1,i2,item_val,dir : integer; 5 | choice,chance : integer; 6 | dumy,y_dumy,x_dumy : integer; 7 | redraw : boolean; 8 | begin 9 | reset_flag := true; 10 | if (py.flags.blind > 0) then 11 | msg_print('You can''t see to read your prayer!') 12 | else if (no_light) then 13 | msg_print('You have no light to read by.') 14 | else if (py.flags.confused > 0) then 15 | msg_print('You are too confused...') 16 | else if (class[py.misc.pclass].pspell) then 17 | if (inven_ctr > 0) then 18 | begin 19 | if (find_range([91],i1,i2)) then 20 | begin 21 | redraw := false; 22 | if (get_item(item_val,'Use which Holy Book?', 23 | redraw,i1,i2)) then 24 | begin 25 | if (cast_spell('Recite which prayer?',item_val, 26 | choice,chance,redraw)) then 27 | with magic_spell[py.misc.pclass,choice] do 28 | begin 29 | reset_flag := false; 30 | if (randint(100) < chance) then 31 | msg_print('You lost your concentration!') 32 | else 33 | begin 34 | y_dumy := char_row; 35 | x_dumy := char_col; 36 | { Prayers... } 37 | case choice of 38 | 1 : detect_evil; 39 | 2 : hp_player(damroll('3d3'),'a prayer.'); 40 | 3 : bless(randint(12)+12); 41 | 4 : remove_fear; 42 | 5 : light_area(char_row,char_col); 43 | 6 : detect_trap; 44 | 7 : detect_sdoor; 45 | 8 : slow_poison; 46 | 9 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then 47 | confuse_monster(dir,char_row,char_col); 48 | 10 : teleport(py.misc.lev*3); 49 | 11 : hp_player(damroll('4d4'),'a prayer.'); 50 | 12 : bless(randint(24)+24); 51 | 13 : sleep_monsters1(char_row,char_col); 52 | 14 : create_food; 53 | 15 : for i1 := 1 to inven_max-1 do 54 | with inventory[i1] do 55 | flags := uand(flags,%X'7FFFFFFF'); 56 | 16 : with py.flags do 57 | begin 58 | resist_heat := resist_heat + randint(10) + 10; 59 | resist_cold := resist_cold + randint(10) + 10; 60 | end; 61 | 17 : cure_poison; 62 | 18 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then 63 | fire_ball(6,dir,char_row,char_col, 64 | damroll('3d6')+py.misc.lev,'Black Sphere'); 65 | 19 : hp_player(damroll('8d4'),'a prayer.'); 66 | 20 : detect_inv2(randint(24)+24); 67 | 21 : protect_evil; 68 | 22 : earthquake; 69 | 23 : map_area; 70 | 24 : hp_player(damroll('16d4'),'a prayer.'); 71 | 25 : turn_undead; 72 | 26 : bless(randint(48)+48); 73 | 27 : dispell_creature(%X'0008',3*py.misc.lev); 74 | 28 : hp_player(200,'a prayer.'); 75 | 29 : dispell_creature(%X'0004',3*py.misc.lev); 76 | 30 : warding_glyph; 77 | 31 : begin 78 | dispell_creature(%X'0004',4*py.misc.lev); 79 | cure_confusion; 80 | remove_fear; 81 | cure_poison; 82 | cure_blindness; 83 | hp_player(1000,'a prayer.'); 84 | end; 85 | otherwise ; 86 | end; 87 | { End of prayers... } 88 | if (not(reset_flag)) then 89 | with py.misc do 90 | begin 91 | exp := exp + sexp; 92 | prt_experience; 93 | sexp := 0; 94 | end 95 | end; 96 | with py.misc do 97 | if (not(reset_flag)) then 98 | begin 99 | if (smana > cmana) then 100 | begin 101 | msg_print('You faint from fatigue!'); 102 | py.flags.paralysis := 103 | randint(5*trunc(smana-cmana)); 104 | cmana := 0; 105 | if (randint(3) = 1) then 106 | begin 107 | msg_print('You have damaged your health!'); 108 | py.stat.ccon := de_statp(py.stat.ccon); 109 | prt_constitution; 110 | end; 111 | end 112 | else 113 | cmana := cmana - smana; 114 | prt_cmana; 115 | end 116 | end 117 | end 118 | else 119 | if (redraw) then draw_cave; 120 | end 121 | else 122 | msg_print('But you are not carrying any Holy Books!'); 123 | end 124 | else 125 | msg_print('But you are not carrying any Holy Books!') 126 | else 127 | msg_print('Pray hard enough and your prayers may be answered.'); 128 | end; 129 | -------------------------------------------------------------------------------- /source/include/eat.inc: -------------------------------------------------------------------------------- 1 | { Eat some food... -RAK- } 2 | [psect(misc2$code)] procedure eat; 3 | var 4 | i1 : unsigned; 5 | i2,i3,item_val : integer; 6 | out_val : vtype; 7 | redraw,ident : boolean; 8 | begin 9 | reset_flag := true; 10 | if (inven_ctr > 0) then 11 | begin 12 | if (find_range([80],i2,i3)) then 13 | begin 14 | redraw := false; 15 | if (get_item(item_val,'Eat what?',redraw,i2,i3)) then 16 | with inventory[item_val] do 17 | begin 18 | if (redraw) then draw_cave; 19 | reset_flag := false; 20 | i1 := flags; 21 | ident := false; 22 | while (i1 > 0) do 23 | begin 24 | i2 := bit_pos(i1); 25 | { Foods } 26 | case (i2) of 27 | 1 : with py.flags do 28 | begin 29 | poisoned := poisoned + randint(10) + level; 30 | ident := true; 31 | end; 32 | 2 : with py.flags do 33 | begin 34 | blind := blind + randint(250) + 10*level + 100; 35 | draw_cave; 36 | msg_print('A veil of darkness surrounds you.'); 37 | ident := true; 38 | end; 39 | 3 : with py.flags do 40 | begin 41 | afraid := afraid + randint(10) + level; 42 | msg_print('You feel terrified!'); 43 | ident := true; 44 | end; 45 | 4 : with py.flags do 46 | begin 47 | confused := confused + randint(10) + level; 48 | msg_print('You feel drugged.'); 49 | end; 50 | 5 : with py.flags do 51 | image := image + randint(200) + 25*level + 200; 52 | 6 : ident := cure_poison; 53 | 7 : ident := cure_blindness; 54 | 8 : with py.flags do 55 | if (afraid > 1) then 56 | begin 57 | afraid := 1; 58 | ident := true; 59 | end; 60 | 9 : ident := cure_confusion; 61 | 10 : ident := lose_str; 62 | 11 : ident := lose_con; 63 | 12 : ident := lose_int; 64 | 13 : ident := lose_wis; 65 | 14 : ident := lose_dex; 66 | 15 : ident := lose_chr; 67 | 16 : with py.stat do 68 | if (str > cstr) then 69 | begin 70 | cstr := str; 71 | msg_print('You feel your strength returning.'); 72 | prt_strength; 73 | ident := true; 74 | end; 75 | 17 : with py.stat do 76 | if (con > ccon) then 77 | begin 78 | ccon := con; 79 | msg_print('You feel your health returning.'); 80 | prt_constitution; 81 | ident := true; 82 | end; 83 | 18 : with py.stat do 84 | if (py.stat.int > cint) then 85 | begin 86 | cint := py.stat.int; 87 | msg_print('Your head spins a moment.'); 88 | prt_intelligence; 89 | ident := true; 90 | end; 91 | 19 : with py.stat do 92 | if (wis > cwis) then 93 | begin 94 | cwis := wis; 95 | msg_print('You feel your wisdom returning.'); 96 | prt_wisdom; 97 | ident := true; 98 | end; 99 | 20 : with py.stat do 100 | if (dex > cdex) then 101 | begin 102 | cdex := dex; 103 | msg_print('You more dexteritous.'); 104 | prt_dexterity; 105 | ident := true; 106 | end; 107 | 21 : with py.stat do 108 | if (chr > cchr) then 109 | begin 110 | cchr := chr; 111 | msg_print('Your skins starts itching.'); 112 | prt_charisma; 113 | ident := true; 114 | end; 115 | 22 : ident := hp_player(randint(3),'poisoness food.'); 116 | 23 : ident := hp_player(randint(6),'poisoness food.'); 117 | 24 : ident := hp_player(randint(12),'poisoness food.'); 118 | 25 : ident := hp_player(damroll('3d6'),'poisoness food.'); 119 | 26 : ident := hp_player(damroll('3d12'),'poisoness food.'); 120 | 27 : ident := hp_player(-randint(4),'poisoness food.'); 121 | 28 : ident := hp_player(-randint(8),'poisoness food.'); 122 | 29 : ident := hp_player(-damroll('2d8'),'poisoness food.'); 123 | 30 : ident := hp_player(-damroll('3d8'),'poisoness food.'); 124 | 31 : with py.misc do 125 | begin 126 | mhp := mhp - 1; 127 | if (mhp < chp) then 128 | chp := mhp; 129 | take_hit(1,'poisoness food.'); 130 | prt_mhp; 131 | prt_chp; 132 | ident := true; 133 | end; 134 | otherwise ; 135 | end; 136 | { End of food actions... } 137 | end; 138 | if (ident) then 139 | identify(inventory[item_val]); 140 | if (flags <> 0) then 141 | with py.misc do 142 | begin 143 | exp := exp + round(level/lev); 144 | prt_experience; 145 | end; 146 | add_food(p1); 147 | py.flags.status := uand(%X'FFFFFFFC',py.flags.status); 148 | prt_hunger; 149 | desc_remain(item_val); 150 | inven_destroy(item_val); 151 | end 152 | else 153 | if (redraw) then draw_cave; 154 | end 155 | else 156 | msg_print('You are not carrying any food.'); 157 | end 158 | else 159 | msg_print('But you are not carrying anything.'); 160 | end; 161 | -------------------------------------------------------------------------------- /source/include/magic.inc: -------------------------------------------------------------------------------- 1 | { Throw a magic spell -RAK- } 2 | [psect(misc2$code)] procedure cast; 3 | var 4 | i1,i2,item_val,dir : integer; 5 | choice,chance : integer; 6 | dumy,y_dumy,x_dumy : integer; 7 | redraw : boolean; 8 | begin 9 | reset_flag := true; 10 | if (py.flags.blind > 0) then 11 | msg_print('You can''t see to read your spell book!') 12 | else if (no_light) then 13 | msg_print('You have no light to read by.') 14 | else if (py.flags.confused > 0) then 15 | msg_print('You are too confused...') 16 | else if (class[py.misc.pclass].mspell) then 17 | if (inven_ctr > 0) then 18 | begin 19 | if (find_range([90],i1,i2)) then 20 | begin 21 | redraw := false; 22 | if (get_item(item_val,'Use which spell-book?', 23 | redraw,i1,i2)) then 24 | begin 25 | if (cast_spell('Cast which spell?',item_val, 26 | choice,chance,redraw)) then 27 | with magic_spell[py.misc.pclass,choice] do 28 | begin 29 | reset_flag := false; 30 | if (randint(100) < chance) then 31 | msg_print('You failed to get the spell off!') 32 | else 33 | begin 34 | y_dumy := char_row; 35 | x_dumy := char_col; 36 | { Spells... } 37 | case choice of 38 | 1 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then 39 | fire_bolt(0,dir,char_row,char_col, 40 | damroll('2d6')+1,'Magic Missile'); 41 | 2 : detect_monsters; 42 | 3 : teleport(10); 43 | 4 : light_area(char_row,char_col); 44 | 5 : hp_player(damroll('4d4'),'a magic spell.'); 45 | 6 : begin 46 | detect_sdoor; 47 | detect_trap; 48 | end; 49 | 7 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then 50 | fire_ball(2,dir,char_row,char_col,9,'Stinking Cloud'); 51 | 8 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then 52 | confuse_monster(dir,char_row,char_col); 53 | 9 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then 54 | fire_bolt(1,dir,char_row,char_col, 55 | damroll('3d8')+1,'Lightning Bolt'); 56 | 10 : td_destroy; 57 | 11 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then 58 | sleep_monster(dir,char_row,char_col); 59 | 12 : cure_poison; 60 | 13 : teleport(py.misc.lev*5); 61 | 14 : for i1 := 23 to inven_max-1 do 62 | with inventory[i1] do 63 | flags := uand(flags,%X'7FFFFFFF'); 64 | 15 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then 65 | fire_bolt(4,dir,char_row,char_col, 66 | damroll('4d8')+1,'Frost Bolt'); 67 | 16 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then 68 | wall_to_mud(dir,char_row,char_col); 69 | 17 : create_food; 70 | 18 : recharge(20); 71 | 19 : sleep_monsters1(char_row,char_col); 72 | 20 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then 73 | poly_monster(dir,char_row,char_col); 74 | 21 : ident_spell; 75 | 22 : sleep_monsters2; 76 | 23 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then 77 | fire_bolt(5,dir,char_row,char_col, 78 | damroll('6d8')+1,'Fire Bolt'); 79 | 24 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then 80 | speed_monster(dir,char_row,char_col,-1); 81 | 25 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then 82 | fire_ball(4,dir,char_row,char_col,33,'Frost Ball'); 83 | 26 : recharge(50); 84 | 27 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then 85 | teleport_monster(dir,char_row,char_col); 86 | 28 : with py.flags do 87 | fast := fast + randint(20) + py.misc.lev; 88 | 29 : if (get_dir('Which direction?',dir,dumy,y_dumy,x_dumy)) then 89 | fire_ball(5,dir,char_row,char_col,49,'Fire Ball'); 90 | 30 : destroy_area(char_row,char_col); 91 | 31 : genocide; 92 | otherwise ; 93 | end; 94 | { End of spells... } 95 | if (not(reset_flag)) then 96 | with py.misc do 97 | begin 98 | exp := exp + sexp; 99 | prt_experience; 100 | sexp := 0; 101 | end 102 | end; 103 | with py.misc do 104 | if (not(reset_flag)) then 105 | begin 106 | if (smana > cmana) then 107 | begin 108 | msg_print('You faint from the effort!'); 109 | py.flags.paralysis := 110 | randint(5*trunc(smana-cmana)); 111 | cmana := 0; 112 | if (randint(3) = 1) then 113 | begin 114 | msg_print('You have damaged your health!'); 115 | py.stat.ccon := de_statp(py.stat.ccon); 116 | prt_constitution; 117 | end; 118 | end 119 | else 120 | cmana := cmana - smana; 121 | prt_cmana; 122 | end 123 | end 124 | end 125 | else 126 | if (redraw) then draw_cave; 127 | end 128 | else 129 | msg_print('But you are not carrying any spell-books!'); 130 | end 131 | else 132 | msg_print('But you are not carrying any spell-books!') 133 | else 134 | msg_print('You can''t cast spells!'); 135 | end; 136 | -------------------------------------------------------------------------------- /source/moria.pas: -------------------------------------------------------------------------------- 1 | { Moria Version 4.8 COPYRIGHT (c) Robert Alan Koeneke } 2 | { Public Domain } 3 | { } 4 | { I lovingly dedicate this game to hackers and adventurers } 5 | { everywhere... } 6 | { } 7 | { } 8 | { Designer and Programmer : Robert Alan Koeneke } 9 | { University of Oklahoma } 10 | { } 11 | { Assitant Programmers : Jimmey Wayne Todd } 12 | { University of Oklahoma } 13 | { } 14 | { Gary D. McAdoo } 15 | { University of Oklahoma } 16 | { } 17 | { Moria may be copied and modified freely as long as the above } 18 | { credits are retained. No one who-so-ever may sell or market } 19 | { this software in any form without the expressed written consent } 20 | { of the author Robert Alan Koeneke. } 21 | { } 22 | [environment('moria.env')] program moria(input,output); 23 | 24 | { Globals -RAK- } 25 | %INCLUDE 'MOR_INCLUDE:CONSTANTS.INC' 26 | %INCLUDE 'MOR_INCLUDE:TYPES.INC' 27 | %INCLUDE 'MOR_INCLUDE:VARIABLES.INC' 28 | %INCLUDE 'MOR_INCLUDE:VALUES.INC' 29 | 30 | { Libraries of routines -RAK- } 31 | %INCLUDE 'MOR_INCLUDE:IO.INC' 32 | %INCLUDE 'MOR_INCLUDE:MISC.INC' 33 | %INCLUDE 'MOR_INCLUDE:DEATH.INC' 34 | %INCLUDE 'MOR_INCLUDE:HELP.INC' 35 | %INCLUDE 'MOR_INCLUDE:DESC.INC' 36 | %INCLUDE 'MOR_INCLUDE:FILES.INC' 37 | %INCLUDE 'MOR_INCLUDE:STORE1.INC' 38 | %INCLUDE 'MOR_INCLUDE:SAVE.INC' 39 | %INCLUDE 'MOR_INCLUDE:CREATE.INC' 40 | %INCLUDE 'MOR_INCLUDE:GENERATE.INC' 41 | %INCLUDE 'MOR_INCLUDE:MORIA.INC' 42 | 43 | 44 | { TERMDEF is external so that new terminals can be defined-RAK- } 45 | { wihtout recompiling the entire source. } 46 | [external] procedure termdef; 47 | external; 48 | 49 | { Initialize, restore, and get the ball rolling... -RAK- } 50 | begin 51 | 52 | { SYSPRV stays off except when needed... } 53 | priv_switch(0); 54 | 55 | { Check the terminal type and see if it is supported} 56 | termdef; 57 | 58 | { Get the directory location of the image } 59 | get_paths; 60 | 61 | { Setup pause time for IO } 62 | setup_io_pause; 63 | 64 | { Some neccesary initializations } 65 | msg_line := 1; 66 | quart_height := trunc(screen_height/4); 67 | quart_width := trunc(screen_width /4); 68 | dun_level := 0; 69 | 70 | { Init an IO channel for QIO } 71 | init_channel; 72 | 73 | { Grab a random seed from the clock } 74 | seed := get_seed; 75 | 76 | { Sort the objects by level } 77 | sort_objects; 78 | 79 | { Init monster and treasure levels for allocate } 80 | init_m_level; 81 | init_t_level; 82 | 83 | { Init the store inventories } 84 | store_init; 85 | if (cost_adj <> 1.00) then price_adjust; 86 | 87 | { Build the secret wizard and god passwords } 88 | bpswd; 89 | 90 | { Check operating hours } 91 | { If not wizard then No_Control_Y } 92 | get_foreign(finam); 93 | 94 | { Check or create hours.dat, print message } 95 | intro(finam); 96 | 97 | { Generate a character, or retrieve old one... } 98 | if (length(finam) > 0) then 99 | begin { Retrieve character } 100 | generate := get_char(finam); 101 | change_name; 102 | magic_init(randes_seed); 103 | end 104 | else 105 | begin { Create character } 106 | create_character; 107 | char_inven_init; 108 | if (class[py.misc.pclass].mspell) then 109 | begin { Magic realm } 110 | learn_spell(msg_flag); 111 | gain_mana(int_adj); 112 | end 113 | else if (class[py.misc.pclass].pspell) then 114 | begin { Clerical realm} 115 | learn_prayer; 116 | gain_mana(wis_adj); 117 | end; 118 | py.misc.cmana := py.misc.mana; 119 | randes_seed := seed; { Description seed } 120 | town_seed := seed; { Town generation seed } 121 | magic_init(randes_seed); 122 | generate := true; 123 | end; 124 | 125 | { Begin the game } 126 | with py.misc do { This determines the maximum player level } 127 | player_max_exp := trunc(player_exp[max_player_level-1]*expfact); 128 | clear(1,1); 129 | prt_stat_block; 130 | 131 | { Loop till dead, or exit } 132 | repeat 133 | if (generate) then generate_cave; { New level } 134 | dungeon; { Dungeon logic } 135 | generate := true; 136 | until (death); 137 | upon_death; { Character gets buried } 138 | end. 139 | -------------------------------------------------------------------------------- /source/termdef.pas: -------------------------------------------------------------------------------- 1 | [inherit('moria.env')] module a; 2 | { TERMDEF : uses the values returned by SYS$GETDVI to set up the proper} 3 | { addressing codes. New terminals can be added, or existing ones } 4 | { changed wihtout re-compiling the main source. You can use } 5 | { compile.com by specifying: } 6 | { $ cterm :== @DISK_NAME:[FILE_PATH]compile termdef } 7 | [global] procedure termdef; 8 | type 9 | term_type = packed array [1..3] of char; 10 | dvi_type = record 11 | item_len : wordint; 12 | item_code : wordint; 13 | buff_add : ^integer; 14 | len_add : ^integer; 15 | end_item : integer; 16 | end; 17 | var 18 | dvi_buff : dvi_type; 19 | i1 : integer; 20 | tmp_str : varying[10] of char; 21 | tmp : char; 22 | escape : char; 23 | 24 | [external(SYS$GETDVI)] function get_dvi ( 25 | efn : integer := %immed 0; 26 | chan : integer := %immed 0; 27 | %stdescr terminal : term_type; 28 | %ref itmlst : dvi_type; 29 | isob : integer := %immed 0; 30 | astadr : integer := %immed 0; 31 | astprm : integer := %immed 0; 32 | undefined : integer := %immed 0 33 | ) : integer; 34 | external; 35 | 36 | begin 37 | escape := chr(27); 38 | with dvi_buff do 39 | begin 40 | item_len := 4; 41 | item_code := 6; 42 | new(buff_add); 43 | new(len_add); 44 | end_item := 0; 45 | end; 46 | get_dvi(terminal:='TT:',itmlst:=dvi_buff); 47 | { Add new terminals in this case statement. The case number is } 48 | { returned by SYS$GETVI. Terminals are either row then col, or } 49 | { col then row. } 50 | { ROW_FIRST should be true if the row is given first. } 51 | { CURSOR_ERL is the sequence for erase-to-end-of-line. } 52 | { CURSOR_ERP is the sequence for erase-to-end-of-page. } 53 | { CURLEN_R is the length of the ROW portion of cursor address } 54 | { CURLEN_C is the length of the COL portion of cursor address } 55 | { CURLEN_L is CURLEN_R + CURLEN_C } 56 | { CURSOR_R is the ROW cursor portion characters } 57 | { CURSOR_C is the COL cursor portion characters } 58 | case dvi_buff.buff_add^ of 59 | 17 : { ADM-3A (/FT2) } 60 | begin 61 | row_first := true; { Sequence is row,col } 62 | cursor_erl := chr(24); 63 | cursor_erp := chr(23); 64 | curlen_r := 3; 65 | curlen_c := 1; 66 | cursor_l := 4; 67 | for i1 := 1 to 24 do 68 | begin 69 | tmp := chr(i1+31); { Row char} 70 | cursor_r[i1] := escape + '=' + tmp; { Row part} 71 | end; 72 | for i1 := 1 to 80 do 73 | begin 74 | tmp := chr(i1+31); { Col char} 75 | cursor_c[i1] := tmp; { Col part} 76 | end; 77 | end; 78 | 18 : { ADDS100 (/FT3) } 79 | begin 80 | row_first := true; { Sequence is row,col } 81 | cursor_erl := escape + 'K'; 82 | cursor_erp := escape + 'k'; 83 | curlen_r := 3; 84 | curlen_c := 1; 85 | cursor_l := 4; 86 | for i1 := 1 to 24 do 87 | begin 88 | tmp := chr(i1+31); { Row char} 89 | cursor_r[i1] := escape + 'Y' + tmp; { Row part} 90 | end; 91 | for i1 := 1 to 80 do 92 | begin 93 | tmp := chr(i1+31); { Col char} 94 | cursor_c[i1] := tmp; { Col part} 95 | end; 96 | end; 97 | 19 : { IBM3101 (/FT4) } 98 | begin 99 | row_first := true; { Sequence is row,col } 100 | cursor_erl := escape + 'I'; 101 | cursor_erp := escape + 'J'; 102 | curlen_r := 3; 103 | curlen_c := 1; 104 | cursor_l := 4; 105 | for i1 := 1 to 24 do 106 | begin 107 | tmp := chr(i1+39); { Row char} 108 | cursor_r[i1] := escape + 'Y' + tmp; { Row part} 109 | end; 110 | for i1 := 1 to 80 do 111 | begin 112 | tmp := chr(i1+39); { Col char} 113 | cursor_c[i1] := tmp; { Col part} 114 | end; 115 | end; 116 | 16 : { Teleray 10 (/FT1) } 117 | begin 118 | row_first := true; { Sequence is row,col } 119 | cursor_erl := escape + 'K'; 120 | cursor_erp := escape + 'J'; 121 | curlen_r := 3; 122 | curlen_c := 1; 123 | cursor_l := 4; 124 | for i1 := 1 to 24 do 125 | begin 126 | tmp := chr(i1+31); { Row char} 127 | cursor_r[i1] := escape + 'Y' + tmp; { Row part} 128 | end; 129 | for i1 := 1 to 80 do 130 | begin 131 | tmp := chr(i1+31); { Col char} 132 | cursor_c[i1] := tmp; { Col part} 133 | end; 134 | end; 135 | 64 : { VT52 (/VT52) } 136 | begin 137 | row_first := true; { Sequence is row,col } 138 | cursor_erl := escape + 'K'; 139 | cursor_erp := escape + 'J'; 140 | curlen_r := 3; 141 | curlen_c := 1; 142 | cursor_l := 4; 143 | for i1 := 1 to 24 do 144 | begin 145 | tmp := chr(i1+31); { Row char} 146 | cursor_r[i1] := escape + 'Y' + tmp; { Row part} 147 | end; 148 | for i1 := 1 to 80 do 149 | begin 150 | tmp := chr(i1+31); { Col char} 151 | cursor_c[i1] := tmp; { Col part} 152 | end; 153 | end; 154 | 96,110: { VT100 and ANSI X3.64 standard (/VT100) } 155 | { VT200 series terminals } 156 | { Note that the row and column strings must always } 157 | { of the same length } 158 | begin 159 | row_first := true; { Sequence is row,col } 160 | cursor_erl := escape + '[K'; 161 | cursor_erp := escape + '[J'; 162 | curlen_r := 4; 163 | curlen_c := 4; 164 | cursor_l := 8; 165 | for i1 := 1 to 24 do 166 | begin 167 | writev(tmp_str,'00',i1:1); { Row chars} 168 | tmp_str := substr(tmp_str,length(tmp_str)-1,2); 169 | cursor_r[i1] := escape + '[' + tmp_str; { Row part } 170 | end; 171 | for i1 := 1 to 80 do 172 | begin 173 | writev(tmp_str,'00',i1:1); { Col chars} 174 | tmp_str := substr(tmp_str,length(tmp_str)-1,2); 175 | cursor_c[i1] := ';' + tmp_str + 'H'; { Col part } 176 | end; 177 | end; 178 | otherwise 179 | begin 180 | writeln('*** ERROR : Terminal not supported ***'); 181 | writeln('See TERMDEF.PAS for definning new terminals.'); 182 | writeln('*** Terminals supported:'); 183 | writeln(' VT52 Set Terminal/VT52'); 184 | writeln(' VT100 Set Terminal/VT100'); 185 | writeln(' Teleray 10 Set Terminal/FT1'); 186 | writeln(' ADM-3A Set Terminal/FT2'); 187 | writeln(' ADDS100 Set Terminal/FT3'); 188 | writeln(' IBM3101 Set Terminal/FT4'); 189 | writeln; 190 | exit; 191 | end; 192 | end; 193 | end; 194 | end. 195 | -------------------------------------------------------------------------------- /source/include/desc.inc: -------------------------------------------------------------------------------- 1 | { Object descriptor routines } 2 | 3 | { Randomize colors, woods, and metals } 4 | [psect(setup$code)] procedure randes; 5 | var 6 | i1,i2 : integer; 7 | tmp : vtype; 8 | begin 9 | for i1 := 1 to max_colors do 10 | begin 11 | i2 := randint(max_colors); 12 | tmp := colors[i1]; 13 | colors[i1] := colors[i2]; 14 | colors[i2] := tmp; 15 | end; 16 | for i1 := 1 to max_woods do 17 | begin 18 | i2 := randint(max_woods); 19 | tmp := woods[i1]; 20 | woods[i1] := woods[i2]; 21 | woods[i2] := tmp; 22 | end; 23 | for i1 := 1 to max_metals do 24 | begin 25 | i2 := randint(max_metals); 26 | tmp := metals[i1]; 27 | metals[i1] := metals[i2]; 28 | metals[i2] := tmp; 29 | end; 30 | for i1 := 1 to max_rocks do 31 | begin 32 | i2 := randint(max_rocks); 33 | tmp := rocks[i1]; 34 | rocks[i1] := rocks[i2]; 35 | rocks[i2] := tmp; 36 | end; 37 | for i1 := 1 to max_amulets do 38 | begin 39 | i2 := randint(max_amulets); 40 | tmp := amulets[i1]; 41 | amulets[i1] := amulets[i2]; 42 | amulets[i2] := tmp; 43 | end; 44 | for i1 := 1 to max_mush do 45 | begin 46 | i2 := randint(max_mush); 47 | tmp := mushrooms[i1]; 48 | mushrooms[i1] := mushrooms[i2]; 49 | mushrooms[i2] := tmp; 50 | end; 51 | end; 52 | 53 | 54 | { Return random title } 55 | [psect(setup$code)] procedure rantitle ( 56 | var title : varying[a] of char 57 | ); 58 | var 59 | i1,i2,i3 : integer; 60 | begin 61 | i3 := randint(2) + 1; 62 | title := 'Titled "'; 63 | for i1 := 1 to i3 do 64 | begin 65 | for i2 := 1 to randint(2) do 66 | title := title + syllables[randint(max_syllables)]; 67 | if (i1 <> i3) then title := title + ' '; 68 | end; 69 | title := title + '"'; 70 | end; 71 | 72 | 73 | { Initialize all Potions, wands, staves, scrolls, ect... } 74 | [psect(setup$code)] procedure magic_init(random_seed : unsigned); 75 | var 76 | i1,tmpv : integer; 77 | tmps : vtype; 78 | begin 79 | seed := random_seed; 80 | randes; 81 | for i1 := 1 to max_objects do 82 | begin 83 | tmpv := int(uand(%X'FF',object_list[i1].subval)); 84 | case object_list[i1].tval of 85 | 75,76 : if (tmpv <= max_colors) then 86 | insert_str(object_list[i1].name,'%C',colors[tmpv]); 87 | 70,71 : begin 88 | rantitle(tmps); 89 | insert_str(object_list[i1].name,'%T',tmps); 90 | end; 91 | 45 : if (tmpv <= max_colors) then 92 | insert_str(object_list[i1].name,'%R',rocks[tmpv]); 93 | 40 : if (tmpv <= max_rocks) then 94 | insert_str(object_list[i1].name,'%A',amulets[tmpv]); 95 | 65 : if (tmpv <= max_amulets) then 96 | insert_str(object_list[i1].name,'%M',metals[tmpv]); 97 | 55 : if (tmpv <= max_woods) then 98 | insert_str(object_list[i1].name,'%W',woods[tmpv]); 99 | 80 : if (tmpv <= max_mush) then 100 | insert_str(object_list[i1].name,'%M',mushrooms[tmpv]); 101 | 60 : {if (tmpv <= max_rods) then 102 | insert_str(object_list[i1].name,'%D',rods[tmpv])}; 103 | otherwise ; 104 | end 105 | end 106 | end; 107 | 108 | 109 | { Remove 'Secret' symbol for identity of object } 110 | [psect(misc1$code)] procedure known1 ( 111 | var object_str : varying[a] of char 112 | ); 113 | var 114 | pos,olen : integer; 115 | str1,str2 : vtype; 116 | begin 117 | pos := index(object_str,'|'); 118 | if (pos > 0) then 119 | begin 120 | olen := length(object_str); 121 | str1 := substr(object_str,1,pos-1); 122 | str2 := substr(object_str,pos+1,olen-pos); 123 | writev(object_str,str1,str2); 124 | end; 125 | end; 126 | 127 | 128 | { Remove 'Secret' symbol for identity of pluses } 129 | [psect(misc1$code)] procedure known2 ( 130 | var object_str : varying[a] of char 131 | ); 132 | var 133 | pos,olen : integer; 134 | str1,str2 : vtype; 135 | begin 136 | pos := index(object_str,'^'); 137 | if (pos > 0) then 138 | begin 139 | olen := length(object_str); 140 | str1 := substr(object_str,1,pos-1); 141 | str2 := substr(object_str,pos+1,olen-pos); 142 | writev(object_str,str1,str2); 143 | end; 144 | end; 145 | 146 | 147 | { Return string without quoted portion } 148 | [psect(misc1$code)] procedure unquote ( 149 | var object_str : varying[a] of char 150 | ); 151 | var 152 | pos0,pos1,pos2,olen : integer; 153 | str1,str2 : vtype; 154 | begin 155 | pos0 := index(object_str,'"'); 156 | if (pos0 > 0) then 157 | begin 158 | pos1 := index(object_str,'~'); 159 | pos2 := index(object_str,'|'); 160 | olen := length(object_str); 161 | str1 := substr(object_str,1,pos1); 162 | str2 := substr(object_str,pos2+1,olen-pos2); 163 | writev(object_str,str1,str2); 164 | end 165 | end; 166 | 167 | 168 | 169 | { Somethings been identified } 170 | [psect(misc1$code)] procedure identify(item : treasure_type); 171 | var 172 | i1,x1,x2 : integer; 173 | begin 174 | x1 := item.tval; 175 | x2 := item.subval; 176 | if (index(item.name,'|') > 0) then 177 | begin 178 | for i1 := 1 to max_talloc do 179 | with t_list[i1] do 180 | if ((tval = x1) and (subval = x2)) then 181 | begin 182 | unquote(name); 183 | known1(name); 184 | end; 185 | for i1 := 1 to inven_max do 186 | with inventory[i1] do 187 | if ((tval = x1) and (subval = x2)) then 188 | begin 189 | unquote(name); 190 | known1(name); 191 | end; 192 | i1 := 0; 193 | repeat 194 | i1 := i1 + 1; 195 | with object_list[i1] do 196 | if ((tval = x1) and (subval = x2)) then 197 | if (index(name,'%T') > 0) then 198 | begin 199 | insert_str(name,' %T|',''); 200 | object_ident[i1] := true; 201 | end 202 | else 203 | begin 204 | unquote(name); 205 | known1(name); 206 | object_ident[i1] := true; 207 | end; 208 | until (i1 = max_objects); 209 | end; 210 | end; 211 | 212 | 213 | { Returns a description of item for inventory } 214 | [psect(misc1$code)] procedure objdes( 215 | var out_val : varying[a] of char; 216 | ptr : integer; 217 | pref : boolean); 218 | var 219 | pos : integer; 220 | tmp_val : vtype; 221 | begin 222 | with inventory[ptr] do 223 | begin 224 | tmp_val := name; 225 | pos := index(tmp_val,'|'); 226 | if (pos > 0) then 227 | tmp_val := substr(tmp_val,1,pos-1); 228 | pos := index(tmp_val,'^'); 229 | if (pos > 0) then 230 | tmp_val := substr(tmp_val,1,pos-1); 231 | if (not(pref)) then 232 | begin 233 | pos := index(tmp_val,' ('); 234 | if (pos > 0) then 235 | tmp_val := substr(tmp_val,1,pos-1); 236 | end; 237 | insert_num(tmp_val,'%P1',p1,true); 238 | insert_num(tmp_val,'%P2',tohit,true); 239 | insert_num(tmp_val,'%P3',todam,true); 240 | insert_num(tmp_val,'%P4',toac,true); 241 | insert_num(tmp_val,'%P5',p1,false); 242 | insert_num(tmp_val,'%P6',ac,false); 243 | if (number <> 1) then 244 | begin 245 | insert_str(tmp_val,'ch~','ches'); 246 | insert_str(tmp_val,'~','s'); 247 | end 248 | else 249 | insert_str(tmp_val,'~',''); 250 | if (pref) then 251 | begin 252 | if (index(tmp_val,'&') > 0) then 253 | begin 254 | insert_str(tmp_val,'&',''); 255 | if (number > 1) then 256 | writev(out_val,number:1,tmp_val) 257 | else if (number < 1) then 258 | writev(out_val,'no more',tmp_val) 259 | else if (tmp_val[2] in vowel_set) then 260 | writev(out_val,'an',tmp_val) 261 | else 262 | writev(out_val,'a',tmp_val); 263 | end 264 | else 265 | out_val := tmp_val; 266 | out_val := out_val + '.'; 267 | end 268 | else 269 | begin 270 | insert_str(tmp_val,'& ',''); 271 | out_val := tmp_val; 272 | end; 273 | end 274 | end; 275 | -------------------------------------------------------------------------------- /source/include/potions.inc: -------------------------------------------------------------------------------- 1 | { Potions for the quaffing -RAK- } 2 | [psect(misc2$code)] procedure quaff; 3 | var 4 | i1 : unsigned; 5 | i2,i3,i4,i5,item_val : integer; 6 | out_val : vtype; 7 | redraw,ident : boolean; 8 | begin 9 | reset_flag := true; 10 | if (inven_ctr > 0) then 11 | begin 12 | if (find_range([75,76],i2,i3)) then 13 | begin 14 | redraw := false; 15 | if (get_item(item_val,'Quaff which potion?',redraw,i2,i3)) then 16 | with inventory[item_val] do 17 | begin 18 | if (redraw) then draw_cave; 19 | reset_flag := false; 20 | i1 := flags; 21 | ident := false; 22 | while (i1 > 0) do 23 | begin 24 | i2 := bit_pos(i1); 25 | if (tval = 76) then i2 := i2 + 31; 26 | { Potions } 27 | case (i2) of 28 | 1 : with py.stat do 29 | begin 30 | cstr := in_statp(cstr); 31 | if (cstr > str) then 32 | str := cstr; 33 | msg_print('Wow! What bulging muscles!'); 34 | prt_strength; 35 | ident := true; 36 | end; 37 | 2 : ident := lose_str; 38 | 3 : with py.stat do 39 | begin 40 | cstr := str; 41 | msg_print('You feel warm all over.'); 42 | prt_strength; 43 | ident := true; 44 | end; 45 | 4 : with py.stat do 46 | begin 47 | cint := in_statp(cint); 48 | if (cint > py.stat.int) then 49 | py.stat.int := cint; 50 | msg_print('Aren''t you brilliant!'); 51 | prt_intelligence; 52 | ident := true; 53 | end; 54 | 5 : begin 55 | msg_print('This potion tastes very dull.'); 56 | ident := lose_int; 57 | end; 58 | 6 : with py.stat do 59 | begin 60 | cint := py.stat.int; 61 | msg_print('You have have a warm feeling.'); 62 | prt_intelligence; 63 | ident := true; 64 | end; 65 | 7 : with py.stat do 66 | begin 67 | cwis := in_statp(cwis); 68 | if (cwis > wis) then 69 | wis := cwis; 70 | msg_print('You suddenly have a profound thought!'); 71 | prt_wisdom; 72 | ident := true; 73 | end; 74 | 8 : ident := lose_wis; 75 | 9 : with py.stat do 76 | if (cwis < wis) then 77 | begin 78 | cwis := wis; 79 | msg_print('You feel your wisdom returning.'); 80 | prt_wisdom; 81 | ident := true; 82 | end; 83 | 10 : with py.stat do 84 | begin 85 | cchr := in_statp(cchr); 86 | if (cchr > chr) then 87 | chr := cchr; 88 | msg_print('Gee, ain''t you cute!'); 89 | prt_charisma; 90 | ident := true; 91 | end; 92 | 11 : ident := lose_chr; 93 | 12 : with py.stat do 94 | if (cchr < chr) then 95 | begin 96 | cchr := chr; 97 | msg_print('You feel your looks returning.'); 98 | prt_charisma; 99 | ident := true; 100 | end; 101 | 13 : ident := hp_player(damroll('2d7'),'a potion.'); 102 | 14 : ident := hp_player(damroll('4d7'),'a potion.'); 103 | 15 : ident := hp_player(damroll('6d7'),'a potion.'); 104 | 16 : ident := hp_player(1000,'a potion.'); 105 | 17 : with py.misc do 106 | begin 107 | py.stat.ccon := in_statp(py.stat.ccon); 108 | if (py.stat.ccon > py.stat.con) then 109 | py.stat.con := py.stat.ccon; 110 | mhp := mhp + 1; 111 | chp := chp + mhp; 112 | msg_print('You feel tingly for a moment.'); 113 | prt_mhp; 114 | prt_chp; 115 | prt_constitution; 116 | ident := true; 117 | end; 118 | 18 : with py.misc do 119 | begin 120 | i5 := (exp div 2) + 10; 121 | if (i5 > 100000) then i5 := 100000; 122 | exp := exp + i5; 123 | msg_print('You feel more experienced.'); 124 | prt_experience; 125 | ident := true; 126 | end; 127 | 19 : with py.flags do 128 | if (not (py.flags.free_act)) then 129 | begin 130 | msg_print('You fall asleep.'); 131 | py.flags.paralysis := py.flags.paralysis + 132 | randint(4) + 4; 133 | ident := true; 134 | end; 135 | 20 : with py.flags do 136 | begin 137 | msg_print('You are covered by a veil of darkness.'); 138 | blind := blind + randint(100) + 100; 139 | ident := true; 140 | end; 141 | 21 : with py.flags do 142 | begin 143 | msg_print('Hey! This is good stuff! * Hick! *'); 144 | confused := confused + randint(20) + 12; 145 | ident := true; 146 | end; 147 | 22 : with py.flags do 148 | begin 149 | msg_print('You feel very sick.'); 150 | poisoned := poisoned + randint(15) + 10; 151 | ident := true; 152 | end; 153 | 23 : begin 154 | py.flags.fast := py.flags.fast + randint(25) + 15; 155 | ident := true; 156 | end; 157 | 24 : begin 158 | py.flags.slow := py.flags.slow + randint(25) + 15; 159 | ident := true; 160 | end; 161 | 25 : ident := detect_monsters; 162 | 26 : with py.stat do 163 | begin 164 | cdex := in_statp(cdex); 165 | if (cdex > dex) then 166 | dex := cdex; 167 | msg_print('You feel more limber!'); 168 | prt_dexterity; 169 | ident := true; 170 | end; 171 | 27 : with py.stat do 172 | if (cdex < dex) then 173 | begin 174 | cdex := dex; 175 | msg_print('You feel less clumsy.'); 176 | prt_dexterity; 177 | ident := true; 178 | end; 179 | 28 : with py.stat do 180 | if (ccon < con) then 181 | begin 182 | ccon := con; 183 | msg_print('You feel your health returning!'); 184 | prt_constitution; 185 | ident := true; 186 | end; 187 | 29 : cure_blindness; 188 | 30 : cure_confusion; 189 | 31 : cure_poison; 190 | 32 : with py.misc do 191 | with class[pclass] do 192 | if (mspell) then 193 | begin 194 | ident := learn_spell(redraw); 195 | if (redraw) then draw_cave; 196 | end 197 | else if (pspell) then 198 | ident := learn_prayer; 199 | 33 : begin 200 | msg_print('You feel your memories fade...'); 201 | msg_print(''); 202 | i4 := trunc(py.misc.exp/5.0); 203 | lose_exp(randint(i4)+i4); 204 | ident := true; 205 | end; 206 | 34 : with py.flags do 207 | begin 208 | poisoned := 0; 209 | if (food > 150) then food := 150; 210 | paralysis := 4; 211 | msg_print('The potion makes you vomit!'); 212 | ident := true; 213 | end; 214 | 35 : begin 215 | py.flags.invuln := py.flags.invuln + randint(10) + 10; 216 | ident := true; 217 | end; 218 | 36 : begin 219 | py.flags.hero := py.flags.hero + randint(25) + 25; 220 | ident := true; 221 | end; 222 | 37 : begin 223 | py.flags.shero := py.flags.shero + randint(25) + 25; 224 | ident := true; 225 | end; 226 | 38 : ident := remove_fear; 227 | 39 : ident := restore_level; 228 | 40 : with py.flags do 229 | resist_heat := resist_heat + randint(10) + 10; 230 | 41 : with py.flags do 231 | resist_cold := resist_cold + randint(10) + 10; 232 | 42 : detect_inv2(randint(12)+12); 233 | 43 : ident := slow_poison; 234 | 44 : ident := cure_poison; 235 | 45 : with py.misc do 236 | if (cmana < mana) then 237 | begin 238 | cmana := mana; 239 | ident := true; 240 | msg_print('Your feel your head clear...'); 241 | end; 242 | 46 : with py.flags do 243 | begin 244 | tim_infra := tim_infra + 100 + randint(100); 245 | ident := true; 246 | msg_print('Your eyes begin to tingle.'); 247 | end; 248 | 47 : ; 249 | 48 : ; 250 | 49 : ; 251 | 50 : ; 252 | 51 : ; 253 | 52 : ; 254 | 53 : ; 255 | 54 : ; 256 | 55 : ; 257 | 56 : ; 258 | 57 : ; 259 | 58 : ; 260 | 59 : ; 261 | 60 : ; 262 | 61 : ; 263 | 62 : ; 264 | otherwise ; 265 | end; 266 | { End of Potions... } 267 | end; 268 | if (ident) then 269 | identify(inventory[item_val]); 270 | if (flags <> 0) then 271 | begin 272 | with py.misc do 273 | exp := exp + round(level/lev); 274 | prt_experience; 275 | end; 276 | add_food(p1); 277 | desc_remain(item_val); 278 | inven_destroy(item_val); 279 | end 280 | else 281 | if (redraw) then draw_cave; 282 | end 283 | else 284 | msg_print('You are not carrying any potions.'); 285 | end 286 | else 287 | msg_print('But you are not carrying anything.'); 288 | end; 289 | -------------------------------------------------------------------------------- /doc/install.rno: -------------------------------------------------------------------------------- 1 | .page size 60,80 2 | .layout 1,2 3 | .ebo 4 | .eov 5 | .eun 6 | .fl bold 7 | .fl underline 8 | .fl accept 9 | .first title 10 | .title ^*The Dungeons of Moria - COPYRIGHT (c) Robert Alan Koeneke\* 11 | .lm 10 12 | .rm 75 13 | .page 14 | .hl 1 ^&Disclaimer\& 15 | .p 16 | Moria is intended for Public Domain, and may not be sold or marketed 17 | IN ANY FORM 18 | without the permision and written consent from the author Robert Alan Koeneke. 19 | I retain all copyrights to this program, in either the original or modified 20 | forms, and no violation, deletion, or change of the copyright notice is 21 | allowed. Futhermore, I will have 22 | no liability or responsibilty to any user with respect to loss or 23 | damage caused directly or indirectly by this program. 24 | .page 25 | .hl 1 ^&Introduction\& 26 | .p 27 | MORIA is a huge dungeon simulation game written mainly in VAX-11 PASCAL, 28 | encompasing about 22,000 lines of code. 29 | A single executable file is all that is needed 30 | to bring up MORIA for the first time, although a MORIA help library must 31 | be present in order to use the internal help options. 32 | .p 33 | In addition to the PASCAL source code, several macro functions and procedures 34 | are present which must be linked into the moria object library. These macro 35 | routines are primarily used for greatly improved speed on IO and execution. 36 | .hl 1 ^&The distribution package\& 37 | .p 38 | This distribution package contains many files organized into certain 39 | directories. The directory structure is as follows: 40 | .lt 41 | 42 | +--------------------+ 43 | |Main MORIA directory| 44 | | Build.com | 45 | +--------------------+ 46 | / | \ 47 | / | \ 48 | +--------------------+ +--------------------+ +--------------------+ 49 | | DOC - Documentation| | SOURCE - .PAS files| | EXECUTE - Binaries | 50 | | source | | | | and data | 51 | +--------------------+ +--------------------+ +--------------------+ 52 | / \ 53 | / \ 54 | +--------------------+ +--------------------+ 55 | | MACRO - source & | | INCLUDE - Pascal | 56 | | library | | include files| 57 | +--------------------+ +--------------------+ 58 | 59 | .el 60 | .p 61 | A ready to run Moria is found in EXECUTE.DIR, along with all needed data 62 | files and the Moria help library. You may execute BUILD.COM to rebuild 63 | Moria if needed. Examine BUILD.COM closely and you will notice that it 64 | will allow you to rebuild certain sections of Moria or re-link it, if 65 | the proper parameter is used. 66 | .p 67 | Documentation source can be found in the directory DOC.DIR. MORIA.HLP 68 | is used to build the help library. MORIA.RNO is used for the manual 69 | which can be printed off. 70 | .p 71 | The source directory, SOURCE.DIR, contains only MORIA.PAS and TERMDEF.PAS. 72 | Most of the guts to Moria can be found in the directory INCLUDE.DIR, which 73 | contains all of the include files used by MORIA.PAS. MACRO.DIR contains 74 | several macro routines, whose objects are stored in MORIALIB.OLB, an object 75 | module library. 76 | .hl 1 ^&Installation\& 77 | .p 78 | Because of the size of MORIA when running, it is suggested that it be installed 79 | shared. MORIA can be installed with SYSPRV so that all data files can 80 | be kept locked up to all but system. MORIA turns off SYSPRV automatically 81 | unless accessing it's own data files, so that no breach in system security 82 | is possible. Also, the game itself should be read protected, allowing only 83 | EXECUTE access, so that it can not propagate within a system. 84 | .lt 85 | 86 | 87 | Installed without SYSPRV /open/shared 88 | Executable protection MORIA.EXE (s:re,o:re,g:re,w:re) 89 | 90 | Installed with SYSPRV /priv=sysprv/open/shared 91 | Executable protection MORIA.EXE (s:re,o:e,g:e,w:e) 92 | 93 | 94 | .el 95 | .p 96 | When MORIA is first executed, it looks for certain data files in the same 97 | directory as the executable. If they are not found, they are created with 98 | default values and the game exits. The local MORIA WIZARD should edit 99 | these files for site specific information and running hours. 100 | .p 101 | Four data 102 | files are created and maintained by MORIA. MORIA.DAT contains a startup 103 | message and MORIA news, and can be used to tell MORIAvites about changes 104 | in playing times and such. HOURS.DAT contains a reject message and the 105 | normal operating hours for the game. Note that the only part of this file 106 | important to the game is the lines containing hours, and that text may be 107 | added before and/or after these lines. 108 | MORIATOP.DAT will contain the 109 | top twenty scores. MORIACHR.DAT contains an entry for each living, saved 110 | character, thus disallowing players to bring back dead characters. 111 | .p 112 | A fifth file is needed if you want to use the internal help 113 | command within MORIA. This is the MORIAHLP.HLB help library, which must 114 | be located in the same directory as the other data files. 115 | .p 116 | The suggested protection for these files is as follows: 117 | .lt 118 | 119 | With SYSPRV Without SYSPRV 120 | MORIA.DAT (s:rw,o,g,w) (s:rw,o:r,g:r,w:r) 121 | HOURS.DAT (s:rw,o,g,w) (s:rw,o:r,g:r,w:r) 122 | MORIATOP.DAT (s:rw,o:r,g:r,w:r) (s:rw,o:rw,g:rw,w:rw) 123 | MORIACHR.DAT (s:rw,o,g,w) (s:rw,o:rw,g:rw,w:rw) 124 | MORIAHLP.HLB (s:r,o:r,g:r,w:r) (s:r,o:r,g:r,w:r) 125 | 126 | .el 127 | It is suggested that a special directory be set aside for MORIA game 128 | and data files, so that they may be easily protected and maintained. 129 | Note that the data files must be in the same directory as the executable. 130 | .p 131 | Characters may be saved in MORIA, and later restored. To save a character 132 | use -Z and supply a filename. The character will be encrypted 133 | so that no tampering will be allowed. To restore a character, set up a moria 134 | foreign command and supply the saved-character filename as an argument. 135 | .lt 136 | 137 | Set up a MORIA foreign run command : $ moria :== $user1:[moria]moria 138 | Restore character : $ moria save_filename 139 | 140 | .el 141 | .page 142 | .hl 1 ^&Notes\& 143 | .hl 2 The IO bug... 144 | .p 145 | When Moria was run at high baud rates (9600 and above), the game would 146 | come to a screeching halt and the process would have to be killed. I 147 | suspected that I had screwed up on my use of QIO. But after tromping 148 | through the code and writing several test programs, I have come to 149 | the conclusion that a problem exists in the device driver. 150 | In order to "get around" this bug, I pause the process a small amount 151 | of time before issuing a QIO read command. This seems to allow the 152 | device driver to perform what ever duty needs doing, and no hang ups 153 | occur. If you should experience a problem with the game going into 154 | permanent LEF's, try increasing the pause time a bit. 155 | .hl 2 Hibernating the game... 156 | .p 157 | At certain places in the game, I have included code to hibernate for 158 | brief periods. Many of these were taken out with the addition of 159 | the pause before each INKEY, but some still exist. 160 | These are included to keep Moria "system friendly". My philosophy 161 | has been that a well written game should not eat the CPU up alive. 162 | If you wish to differ, these pauses can be removed to speed up the 163 | game, but you should not remove the pauses before INKEY unless you 164 | are running the game at baud rates less than 9600. 165 | .hl 2 A vision of the FUTURE... 166 | .p 167 | With the 4.0 version of Moria, I had finally "finished" all I had 168 | originally set out to do. Moria 1.1 which was released as an executable 169 | was actually an incomplete game. 170 | .p 171 | Around May, 1986, I expect to release a Moria Version 5.0 (or there abouts). 172 | This version may have some (or all) of the following: 173 | .lt 174 | 175 | Altars 176 | Artifacts 177 | New creatures 178 | New objects 179 | Regeneration for monsters (slower than the player of course) 180 | Water passages, rooms, etc. 181 | 182 | .el 183 | .p 184 | In addition, I expect much of my code will be better documented and 185 | more carefully written. I may even tackle the "Town level" code... 186 | .page 187 | -------------------------------------------------------------------------------- /source/include/help.inc: -------------------------------------------------------------------------------- 1 | [psect(misc2$code)] procedure ident_char; 2 | var 3 | command : char; 4 | begin 5 | if (get_com('Enter character to be identified :',command)) then 6 | case command of 7 | ' ' : prt(' - An open pit.',1,1); 8 | '!' : prt('! - A potion.',1,1); 9 | '"' : prt('" - An amulet, periapt, or necklace.',1,1); 10 | '#' : prt('# - A stone wall.',1,1); 11 | '$' : prt('$ - Treasure.',1,1); 12 | {'%' : prt('% - Not used.',1,1);} 13 | '&' : prt('& - Treasure chest.',1,1); 14 | '''': prt(''' - An open door.',1,1); 15 | '(' : prt('( - Soft armor.',1,1); 16 | ')' : prt(') - A shield.',1,1); 17 | '*' : prt('* - Gems.',1,1); 18 | '+' : prt('+ - A closed door.',1,1); 19 | ',' : prt(', - Food or mushroom patch.',1,1); 20 | '-' : prt('- - A wand',1,1); 21 | '.' : prt('. - Floor.',1,1); 22 | '/' : prt('/ - A pole weapon.',1,1); 23 | {'0' : prt('0 - Not used.',1,1);} 24 | '1' : prt('1 - Entrance to General Store.',1,1); 25 | '2' : prt('2 - Entrance to Armory.',1,1); 26 | '3' : prt('3 - Entrance to Weaponsmith.',1,1); 27 | '4' : prt('4 - Entrance to Temple.',1,1); 28 | '5' : prt('5 - Entrance to Alchemy shop.',1,1); 29 | '6' : prt('6 - Entrance to Magic-Users store.',1,1); 30 | {'7' : prt('7 - Not used.',1,1);} 31 | {'8' : prt('8 - Not used.',1,1);} 32 | {'9' : prt('9 - Not used.',1,1);} 33 | ':' : prt(': - Rubble.',1,1); 34 | ';' : prt('; - A loose rock.',1,1); 35 | '<' : prt('< - An up staircase.',1,1); 36 | '=' : prt('= - A ring.',1,1); 37 | '>' : prt('> - A down staircase.',1,1); 38 | '?' : prt('? - A scroll.',1,1); 39 | '@' : prt(py.misc.name,1,1); 40 | 'A' : prt('A - Giant Ant Lion.',1,1); 41 | 'B' : prt('B - The Balrog.',1,1); 42 | 'C' : prt('C - Gelentanious Cube.',1,1); 43 | 'D' : prt('D - An Ancient Dragon (Beware).',1,1); 44 | 'E' : prt('E - Elemental.',1,1); 45 | 'F' : prt('F - Giant Fly.',1,1); 46 | 'G' : prt('G - Ghost.',1,1); 47 | 'H' : prt('H - Hobgoblin.',1,1); 48 | 'I' : prt('I - Invisible Stalker.',1,1); 49 | 'J' : prt('J - Jelly.',1,1); 50 | 'K' : prt('K - Killer Beetle.',1,1); 51 | 'L' : prt('L - Lich.',1,1); 52 | 'M' : prt('M - Mummy.',1,1); 53 | {'N' : prt('N - Not used.',1,1);} 54 | 'O' : prt('O - Ooze.',1,1); 55 | 'P' : prt('P - Giant humanoid.',1,1); 56 | 'Q' : prt('Q - Quylthulg (Pulsing Flesh Mound).',1,1); 57 | 'R' : prt('R - Reptile.',1,1); 58 | 'S' : prt('S - Giant Scorpion.',1,1); 59 | 'T' : prt('T - Troll.',1,1); 60 | 'U' : prt('U - Umber Hulk.',1,1); 61 | 'V' : prt('V - Vampire.',1,1); 62 | 'W' : prt('W - Wight or Wraith.',1,1); 63 | 'X' : prt('X - Xorn.',1,1); 64 | 'Y' : prt('Y - Yeti.',1,1); 65 | {'Z' : prt('Z - Not used.',1,1);} 66 | '[' : prt('[ - Hard armor.',1,1); 67 | '\' : prt('\ - A hafted weapon.',1,1); 68 | ']' : prt('] - Misc. armor.',1,1); 69 | '^' : prt('^ - A trap.',1,1); 70 | '_' : prt('_ - A staff.',1,1); 71 | {'`' : prt('` - Not used.',1,1);} 72 | 'a' : prt('a - Giant Ant.',1,1); 73 | 'b' : prt('b - Giant Bat.',1,1); 74 | 'c' : prt('c - Giant Centipede.',1,1); 75 | 'd' : prt('d - Dragon.',1,1); 76 | 'e' : prt('e - Floating Eye.',1,1); 77 | 'f' : prt('f - Giant Frog',1,1); 78 | 'g' : prt('g - Golem.',1,1); 79 | 'h' : prt('h - Harpy.',1,1); 80 | 'i' : prt('i - Icky Thing.',1,1); 81 | 'j' : prt('j - Jackal.',1,1); 82 | 'k' : prt('k - Kobold.',1,1); 83 | 'l' : prt('l - Giant Lice.',1,1); 84 | 'm' : prt('m - Mold.',1,1); 85 | 'n' : prt('n - Naga.',1,1); 86 | 'o' : prt('o - Orc or Ogre.',1,1); 87 | 'p' : prt('p - Person (Humanoid).',1,1); 88 | 'q' : prt('q - Quasit.',1,1); 89 | 'r' : prt('r - Rodent.',1,1); 90 | 's' : prt('s - Skeleton.',1,1); 91 | 't' : prt('t - Gaint tick.',1,1); 92 | {'u' : prt('u - Not used.',1,1);} 93 | {'v' : prt('v - Not used.',1,1);} 94 | 'w' : prt('w - Worm(s).',1,1); 95 | {'x' : prt('x - Not used.',1,1);} 96 | 'y' : prt('y - Yeek.',1,1); 97 | 'z' : prt('z - Zombie.',1,1); 98 | '{' : prt('{ - Arrow, bolt, or bullet.',1,1); 99 | '|' : prt('| - A sword or dagger.',1,1); 100 | '}' : prt('} - Bow, crossbow, or sling.',1,1); 101 | '~' : prt('~ - Miscellaneous item.',1,1); 102 | otherwise prt('Not Used.',1,1); 103 | end 104 | end; 105 | 106 | 107 | { Help for available commands } 108 | [psect(misc2$code)] procedure help; 109 | begin 110 | clear(1,1); 111 | prt('B Bash (object/creature)| q Quaff a potion.',1,1); 112 | prt('C Display character. | r Read a scroll.',2,1); 113 | prt('D Disarm a trap/chest. | s Search for hidden doors.',3,1); 114 | prt('E Eat some food. | t Take off an item.',4,1); 115 | prt('F Fill lamp with oil. | u Use a staff.',5,1); 116 | prt('L Current location. | v Version and credits.',6,1); 117 | prt('P Print map. | w Wear/Wield an item.',7,1); 118 | prt('R Rest for a period. | x Exchange weapon.',8,1); 119 | prt('S Search Mode. | / Identify a character.',9,1); 120 | prt('T Tunnel. | ? Display this panel.',10,1); 121 | prt('a Aim and fire a wand. |',11,1); 122 | prt('b Browse a book. | ^M Repeat the last message.',12,1); 123 | prt('c Close a door. | ^R Redraw the screen.',13,1); 124 | prt('d Drop an item. | ^Y Quit the game.',14,1); 125 | prt('e Equipment list. | ^Z Save character and quit.',15,1); 126 | prt('f Fire/Throw an item. | $ Shell out of game.',16,1); 127 | prt('h Help on key commands. |',17,1); 128 | prt('i Inventory list. | < Go up an up-staircase.',18,1); 129 | prt('j Jam a door with spike.| > Go down a down-staircase.',19,1); 130 | prt('l Look given direction. | . Move in direction.',20,1); 131 | prt('m Cast a magic spell. | Movement: 7 8 9',21,1); 132 | prt('o Open a door/chest. | 4 6 5 = Rest',22,1); 133 | prt('p Read a prayer. | 1 2 3',23,1); 134 | pause(24); 135 | draw_cave; 136 | end; 137 | 138 | 139 | 140 | { Help for available wizard commands } 141 | [psect(wizard$code)] procedure wizard_help; 142 | begin 143 | clear(1,1); 144 | if (wizard2) then 145 | begin 146 | prt('^A - Remove Curse and Cure all maladies.',1,1); 147 | prt('^B - Print random objects sample.',2,1); 148 | prt('^D - Down/Up n levels.',3,1); 149 | prt('^E - Change character.',4,1); 150 | prt('^F - Delete monsters.',5,1); 151 | prt('^G - Allocate treasures.',6,1); 152 | prt('^H - Wizard Help.',7,1); 153 | prt('^I - Identify.',8,1); 154 | prt('^J - Gain experience.',9,1); 155 | prt('^K - Summon monster.',10,1); 156 | prt('^L - Wizard light.',11,1); 157 | prt('^N - Print monster dictionary.',12,1); 158 | prt('^P - Wizard password on/off.',13,1); 159 | prt('^T - Teleport player.',14,1); 160 | prt('^V - Restore lost character.',15,1); 161 | prt('^W - Create any object *CAN CAUSE FATAL ERROR*',16,1); 162 | end 163 | else 164 | begin 165 | prt('^A - Remove Curse and Cure all maladies.',1,1); 166 | prt('^B - Print random objects sample.',2,1); 167 | prt('^D - Down/Up n levels.',3,1); 168 | prt('^H - Wizard Help.',4,1); 169 | prt('^I - Identify.',5,1); 170 | prt('^L - Wizard light.',6,1); 171 | prt('^N - Print monster dictionary.',7,1); 172 | prt('^P - Wizard password on/off.',8,1); 173 | prt('^T - Teleport player.',9,1); 174 | prt('^V - Restore lost character.',10,1); 175 | end; 176 | pause(24); 177 | draw_cave; 178 | end; 179 | 180 | 181 | 182 | { Spawn a process to use HELP utility on the MORIA help library -RAK-} 183 | [psect(misc2$code)] procedure moria_help(help_level : vtype); 184 | var 185 | dcl_command : varying [120] of char; 186 | flag_bits : unsigned; 187 | 188 | { Spawn a shell and execute DCL command -RAK- } 189 | [external(LIB$SPAWN)] function dcl( 190 | %DESCR command : varying [a] of char; 191 | dum2 : integer := %immed 0; 192 | dum3 : integer := %immed 0; 193 | %REF flags : unsigned; 194 | dum5 : integer := %immed 0; 195 | dum6 : integer := %immed 0; 196 | dum7 : integer := %immed 0; 197 | dum8 : integer := %immed 0; 198 | dum9 : integer := %immed 0; 199 | dum10 : integer := %immed 0 ) : integer; 200 | external; 201 | 202 | begin 203 | flag_bits := %X'00000006'; 204 | prt('[Entering Moria Help Library, Use ^Z to resume game]',1,1); 205 | put_qio; 206 | dcl_command := 'HELP/PAGE/NOLIBLIST/LIBRARY='+MORIA_HLP; 207 | dcl_command := dcl_command + ' ' + help_level; 208 | dcl(dcl_command,flags:=flag_bits); 209 | end; 210 | -------------------------------------------------------------------------------- /source/include/constants.inc: -------------------------------------------------------------------------------- 1 | const 2 | {Note to the Wizard: } 3 | { Tweaking these constants can *GREATLY* change the game. } 4 | { Two years of constant tuning have generated these } 5 | { values. Minor adjustments are encouraged, but you must } 6 | { be very careful not to unbalance the game. Moria was } 7 | { meant to be challenging, not a give away. Many } 8 | { adjustments can cause the game to act strangely, or even} 9 | { cause errors. } 10 | 11 | { Current version number of Moria } 12 | cur_version = 4.8; 13 | 14 | { QIOW constants, see $IODEF in STARLET.MLB } 15 | IO$_WRITEVBLK = %B'0000000000110000'; { 48D, 0030H } 16 | IO$_TTYREADALL= %B'0000000000111010'; { 58D, 003AH } 17 | IO$M_NOECHO = %B'0000000001000000'; { 64D, 0040H } 18 | IO$M_NOWAIT = %B'0000000010000000'; { 128D, 0080H } 19 | IO$M_PURGE = %B'0000100000000000'; {2048D, 0800H } 20 | IO$MOR_OUTPUT = IO$_WRITEVBLK; 21 | IO$MOR_INPUT = IO$_TTYREADALL + IO$M_NOECHO; 22 | IO$MOR_DELAY = IO$MOR_INPUT + IO$M_NOWAIT; 23 | IO$MOR_IPURGE = IO$MOR_DELAY + IO$M_PURGE; 24 | 25 | { IO bug exists at high baud rates (baud >= 9600). This bug } 26 | { is believed to be in the device driver. It can be avoided by } 27 | { hibernating the process a small amount of time before perform-} 28 | { ing a QIOW read operation. -RAK- } 29 | { This constant no longer used after VMS 4.0 } 30 | IO$MOR_IOPAUSE= 5; { x/100 seconds of sleep before inkey } 31 | 32 | { Encryption constants } 33 | { Note: These numbers were pulled from the air, and can be } 34 | { changed. If changed, characters produced from other } 35 | { versions will fail to restore. } 36 | encrypt_seed1 = 1175191; 37 | encrypt_seed2 = 997551771; 38 | 39 | { Dungeon size parameters } 40 | max_height = 66; { Multiple of 11; >= 22 } 41 | max_width = 198; { Multiple of 33; >= 66 } 42 | screen_height = 22; 43 | screen_width = 66; 44 | 45 | { Output dungeon section sizes } 46 | outpage_height= 44; { 44 lines of dungeon per section } 47 | outpage_width = 99; { 100 columns of dungeon per section } 48 | 49 | { Dungeon generation values } 50 | { Note: The entire design of dungeon can be changed by only } 51 | { slight adjustments here. } 52 | dun_tun_rnd = 36; { Random direction (4 is min) } 53 | dun_tun_chg = 70; { Chance of changing direction (99 max) } 54 | dun_tun_fnd = 12; { Distance for auto find to kick in } 55 | dun_tun_con = 15; { Chance of extra tunneling } 56 | dun_roo_mea = 32; { Mean of # of rooms, standard dev=2 } 57 | dun_tun_pen = 25; { % chance of room doors } 58 | dun_tun_jct = 15; { % chance of doors at tunnel junctons } 59 | dun_str_den = 5; { Density of streamers } 60 | dun_str_rng = 2; { Width of streamers } 61 | dun_str_mag = 3; { Number of magma streamers } 62 | dun_str_mc = 95; { 1/x chance of treasure per magma } 63 | dun_str_qua = 2; { Number of quartz streamers } 64 | dun_str_qc = 55; { 1/x chance of treasure per quartz } 65 | dun_unusual = 300; { Level/x chance of unusual room } 66 | 67 | { Store constants } 68 | max_owners = 18; { Number of owners to choose from } 69 | max_stores = 6; { Number of different stores } 70 | store_inven_max = 24; { Max number of discrete objs in inven } 71 | store$choices = 26; { Number of items to choice stock from } 72 | store$max_inven = 20; { Max diff objs in stock before auto sell} 73 | store$min_inven = 14; { Min diff objs in stock before auto buy} 74 | store$turn_around= 3; { Amount of buying and selling normally } 75 | inven_init_max = 105; { Size of store init array } 76 | cost_adj = 1.00; { Adjust prices for buying and selling } 77 | 78 | { Treasure constants } 79 | inven_max = 35; { Size of inventory array(Do not change)} 80 | max_obj_level = 50; { Maximum level of magic in dungeon } 81 | obj_great = 20; { 1/n Chance of item being a Great Item } 82 | max_objects = 344; { Number of objects for universe } 83 | max_gold = 18; { Number of different types of gold } 84 | max_talloc = 225; { Max objects per level } 85 | treas_room_alloc = 7; { Amount of objects for rooms } 86 | treas_any_alloc = 2; { Amount of objects for corridors } 87 | treas_gold_alloc = 2; { Amount of gold (and gems) } 88 | 89 | { Magic Treasure Generation constants } 90 | { Note: Number of special objects, and degree of enchantments } 91 | { can be adjusted here. } 92 | obj_std_adj = 1.25; { Adjust STD per level } 93 | obj_std_min = 7; { Minimum STD } 94 | obj_town_level = 7; { Town object generation level } 95 | obj_base_magic = 15; { Base amount of magic } 96 | obj_base_max = 70; { Max amount of magic } 97 | obj_div_special = 6; { magic_chance/# = special magic } 98 | obj_div_cursed = 1.3; { magic_chance/# = cursed items } 99 | 100 | { Constants describing limits of certain objects } 101 | obj$lamp_max =15000; { Maximum amount that lamp can be filled} 102 | obj$bolt_range = 18; { Maximum range of bolts and balls } 103 | obj$rune_prot = 3000; { Rune of protection resistance } 104 | 105 | { Creature contants } 106 | max_creatures = 279; { Number of creatures defined for univ } 107 | max_malloc = 100 + 1;{ Max that can be allocated } 108 | max_malloc_chance= 160; { 1/x chance of new monster each round } 109 | max_mons_level = 40; { Maximum level of creatures } 110 | max_sight = 20; { Maximum dis a creature can be seen } 111 | max_spell_dis = 20; { Maximum dis creat. spell can be cast } 112 | max_mon_mult = 75; { Maximum reproductions on a level } 113 | mon_mult_adj = 7; { High value slows multiplication } 114 | mon_nasty = 50; { Dun_level/x chance of high level creat} 115 | min_malloc_level = 14; { Minimum number of monsters/level } 116 | min_malloc_td = 4; { Number of people on town level (day) } 117 | min_malloc_tn = 8; { Number of people on town level (night)} 118 | win_mon_tot = 2; { Total number of "win" creatures } 119 | win_mon_appear = 50; { Level where winning creatures begin } 120 | mon$summon_adj = 2; { Adjust level of summoned creatures } 121 | mon$drain_life = 2; { Percent of player exp drained per hit } 122 | 123 | { Trap constants } 124 | max_trapa = 18; { Number of defined traps } 125 | max_trapb = 19; { Includes secret doors } 126 | 127 | { Descriptive constants } 128 | max_colors = 67; { Used with potions } 129 | max_mush = 29; { Used with mushrooms } 130 | max_woods = 41; { Used with staffs } 131 | max_metals = 31; { Used with wands } 132 | max_rocks = 52; { Used with rings } 133 | max_amulets = 39; { Used with amulets } 134 | max_syllables = 153; { Used with scrolls } 135 | 136 | { Player constants } 137 | max_player_level = 40; { Maximum possible character level } 138 | max_races = 8; { Number of defined races } 139 | max_class = 6; { Number of defined classes } 140 | use_device = 3; { x> Harder devices x< Easier devices } 141 | max_background = 128; { Number of types of histories for univ } 142 | player_food_full =10000;{ Getting full } 143 | player_food_max =15000;{ Maximum food value, beyond is wasted } 144 | player_food_faint= 300;{ Character begins fainting } 145 | player_food_weak = 1000;{ Warn player that he is getting very low} 146 | player_food_alert= 2000;{ Warn player that he is getting low } 147 | player$regen_faint = 0.0005; { Regen factor when fainting } 148 | player$regen_weak = 0.0015; { Regen factor when weak } 149 | player$regen_normal = 0.0030; { Regen factor when full } 150 | player$regen_hpbase = 0.0220; { Min amount hp regen } 151 | player$regen_mnbase = 0.0080; { Min amount mana regen } 152 | player_weight_cap= 130; { "#"*(1/10 pounds) per strength point } 153 | player_exit_pause= 6; { Pause time before player can re-roll } 154 | 155 | { Base to hit constants } 156 | bth_lev_adj = 3; { Adjust BTH per level } 157 | bth_plus_adj = 3; { Adjust BTH per plus-to-hit } 158 | bth_hit = 12; { Automatic hit; 1/bth_hit } 159 | 160 | { Misc } 161 | null = chr(0); 162 | -------------------------------------------------------------------------------- /source/include/store1.inc: -------------------------------------------------------------------------------- 1 | { Returns the value for any given object -RAK- } 2 | [psect(store$code)] function item_value(item : treasure_type) : integer; 3 | 4 | function search_list(x1,x2 : integer) : integer; 5 | var 6 | i1,i2 : integer; 7 | begin 8 | i1 := 0; 9 | i2 := 0; 10 | repeat 11 | i1 := i1 + 1; 12 | with object_list[i1] do 13 | if ((tval = x1) and (subval = x2)) then 14 | i2 := cost; 15 | until ((i1 = max_objects) or (i2 > 0)); 16 | search_list := i2; 17 | end; 18 | 19 | begin 20 | with item do 21 | begin 22 | item_value := cost; 23 | if (tval in [20,21,22,23,30,31,32,33,34,35,36]) then 24 | begin { Weapons and armor } 25 | if (index(name,'^') > 0) then 26 | item_value := search_list(tval,subval)*number 27 | else if (tval in [20,21,22,23]) then 28 | begin 29 | if (tohit < 0) then 30 | item_value := 0 31 | else if (todam < 0) then 32 | item_value := 0 33 | else if (toac < 0) then 34 | item_value := 0 35 | else 36 | item_value := (cost+(tohit+todam+toac)*100)*number; 37 | end 38 | else 39 | begin 40 | if (toac < 0) then 41 | item_value := 0 42 | else 43 | item_value := (cost+toac*100)*number; 44 | end; 45 | end 46 | else if (tval in [10,11,12,13]) then 47 | begin { Ammo } 48 | if (index(name,'^') > 0) then 49 | item_value := search_list(tval,1)*number 50 | else 51 | begin 52 | if (tohit < 0) then 53 | item_value := 0 54 | else if (todam < 0) then 55 | item_value := 0 56 | else if (toac < 0) then 57 | item_value := 0 58 | else 59 | item_value := (cost+(tohit+todam+toac)*10)*number; 60 | end; 61 | end 62 | else if (tval in [70,71,75,76,80]) then 63 | begin { Potions, Scrolls, and Food } 64 | if (index(name,'|') > 0) then 65 | case tval of 66 | 70,71 : item_value := 20; 67 | 75,76 : item_value := 20; 68 | 80 : item_value := 1; 69 | otherwise ; 70 | end 71 | end 72 | else if (tval in [40,45]) then 73 | begin { Rings and amulets } 74 | if (index(name,'|') > 0) then 75 | case tval of 76 | 40 : item_value := 45; 77 | 45 : item_value := 45; 78 | otherwise ; 79 | end 80 | else if (index(name,'^') > 0) then 81 | item_value := abs(cost); 82 | end 83 | else if (tval in [55,60,65]) then 84 | begin { Wands rods, and staffs} 85 | if (index(name,'|') > 0) then 86 | case tval of 87 | 55 : item_value := 70; 88 | 60 : item_value := 60; 89 | 65 : item_value := 50; 90 | otherwise ; 91 | end 92 | else if (index(name,'^') = 0) then 93 | begin 94 | item_value := cost + trunc(cost/20.0)*p1; 95 | end; 96 | end; 97 | end; 98 | end; 99 | 100 | 101 | { Asking price for an item -RAK- } 102 | [psect(store$code)] function sell_price (snum : integer; 103 | var max_sell,min_sell : integer; 104 | item : treasure_type 105 | ) : integer; 106 | var 107 | i1 : integer; 108 | begin 109 | with store[snum] do 110 | begin 111 | i1 := item_value(item); 112 | if (item.cost > 0) then 113 | begin 114 | i1 := i1 + 115 | trunc(i1*rgold_adj[owners[owner].owner_race,py.misc.prace]); 116 | if (i1 < 1) then i1 := 1; 117 | max_sell := trunc(i1*(1+owners[owner].max_inflate)); 118 | min_sell := trunc(i1*(1+owners[owner].min_inflate)); 119 | if (min_sell > max_sell) then min_sell := max_sell; 120 | sell_price := i1; 121 | end 122 | else 123 | begin 124 | max_sell := 0; 125 | min_sell := 0; 126 | sell_price := 0; 127 | end; 128 | end; 129 | end; 130 | 131 | 132 | { Check to see if he will be carrying too many objects -RAK- } 133 | [psect(store$code)] function store_check_num(store_num : integer) : boolean; 134 | var 135 | item_num,i1 : integer; 136 | flag : boolean; 137 | begin 138 | store_check_num := false; 139 | with store[store_num] do 140 | if (store_ctr < store_inven_max) then 141 | store_check_num := true 142 | else if ((inventory[inven_max].subval > 255) and 143 | (inventory[inven_max].subval < 512)) then 144 | for i1 := 1 to store_ctr do 145 | with store_inven[i1].sitem do 146 | if (tval = inventory[inven_max].tval) then 147 | if (subval = inventory[inven_max].subval) then 148 | store_check_num := true; 149 | end; 150 | 151 | 152 | { Add the item in INVEN_MAX to stores inventory. -RAK- } 153 | [psect(store$code)] procedure store_carry( store_num : integer; 154 | var ipos : integer); 155 | var 156 | item_num,item_val : integer; 157 | typ,subt,icost,dummy : integer; 158 | flag : boolean; 159 | 160 | { Insert INVEN_MAX at given location } 161 | procedure insert(store_num,pos,icost : integer); 162 | var 163 | i1 : integer; 164 | begin 165 | with store[store_num] do 166 | begin 167 | for i1 := store_ctr downto pos do 168 | store_inven[i1+1] := store_inven[i1]; 169 | store_inven[pos].sitem := inventory[inven_max]; 170 | store_inven[pos].scost := -icost; 171 | store_ctr := store_ctr + 1; 172 | end; 173 | end; 174 | 175 | { Store_carry routine } 176 | begin 177 | ipos := 0; 178 | identify(inventory[inven_max]); 179 | known2(inventory[inven_max].name); 180 | sell_price(store_num,icost,dummy,inventory[inven_max]); 181 | if (icost > 0) then 182 | begin 183 | with inventory[inven_max] do 184 | with store[store_num] do 185 | begin 186 | item_val := 0; 187 | item_num := number; 188 | flag := false; 189 | typ := tval; 190 | subt := subval; 191 | repeat 192 | item_val := item_val + 1; 193 | with store_inven[item_val].sitem do 194 | if (typ = tval) then 195 | begin 196 | if (subt = subval) then{ Adds to other item } 197 | if (subt > 255) then 198 | begin 199 | if (number < 24) then 200 | number := number + item_num; 201 | flag := true; 202 | end 203 | end 204 | else if (typ > tval) then 205 | begin { Insert into list } 206 | insert(store_num,item_val,icost); 207 | flag := true; 208 | ipos := item_val; 209 | end; 210 | until ((item_val >= store_ctr) or (flag)); 211 | if (not(flag)) then { Becomes last item in list } 212 | begin 213 | insert(store_num,store_ctr+1,icost); 214 | ipos := store_ctr; 215 | end; 216 | end; 217 | end; 218 | end; 219 | 220 | 221 | 222 | { Destroy an item in the stores inventory. Note that if } 223 | { 'one_of' is false, an entire slot is destroyed -RAK- } 224 | [psect(store$code)] procedure store_destroy( 225 | store_num,item_val : integer; 226 | one_of : boolean); 227 | var 228 | i2 : integer; 229 | begin 230 | with store[store_num] do 231 | begin 232 | inventory[inven_max] := store_inven[item_val].sitem; 233 | with store_inven[item_val].sitem do 234 | begin 235 | if ((number > 1) and (subval < 512) and (one_of)) then 236 | begin 237 | number := number - 1; 238 | inventory[inven_max].number := 1; 239 | end 240 | else 241 | begin 242 | for i2 := item_val to store_ctr-1 do 243 | store_inven[i2] := store_inven[i2+1]; 244 | store_inven[store_ctr].sitem := blank_treasure; 245 | store_inven[store_ctr].scost := 0; 246 | store_ctr := store_ctr - 1; 247 | end; 248 | end 249 | end; 250 | end; 251 | 252 | 253 | 254 | { Initializes the stores with owners -RAK- } 255 | [psect(setup$code)] procedure store_init; 256 | var 257 | i1,i2,i3 : integer; 258 | begin 259 | i1 := max_owners div max_stores; 260 | for i2 := 1 to max_stores do 261 | with store[i2] do 262 | begin 263 | owner := max_stores*(randint(i1)-1) + i2; 264 | insult_cur := 0; 265 | store_open := 0; 266 | store_ctr := 0; 267 | for i3 := 1 to store_inven_max do 268 | begin 269 | store_inven[i3].sitem := blank_treasure; 270 | store_inven[i3].scost := 0; 271 | end; 272 | end; 273 | end; 274 | 275 | 276 | { Creates an item and inserts it into store's inven -RAK- } 277 | [psect(store$code)] procedure store_create(store_num : integer); 278 | var 279 | i1,tries,cur_pos,dummy : integer; 280 | begin 281 | tries := 0; 282 | popt(cur_pos); 283 | with store[store_num] do 284 | repeat 285 | i1 := store_choice[store_num,randint(store$choices)]; 286 | t_list[cur_pos] := inventory_init[i1]; 287 | magic_treasure(cur_pos,obj_town_level); 288 | inventory[inven_max] := t_list[cur_pos]; 289 | if (store_check_num(store_num)) then 290 | with t_list[cur_pos] do 291 | if (cost > 0) then { Item must be good } 292 | if (cost < owners[owner].max_cost) then 293 | begin 294 | store_carry(store_num,dummy); 295 | tries := 10; 296 | end; 297 | tries := tries + 1; 298 | until(tries > 3); 299 | pusht(cur_pos); 300 | end; 301 | 302 | 303 | { Initialize and up-keep the store's inventory. -RAK- } 304 | [psect(store$code)] procedure store_maint; 305 | var 306 | i1,i2,dummy : integer; 307 | begin 308 | for i1 := 1 to max_stores do 309 | with store[i1] do 310 | begin 311 | insult_cur := 0; 312 | if (store_ctr > store$max_inven) then 313 | for i2 := 1 to (store_ctr-store$max_inven+2) do 314 | store_destroy(i1,randint(store_ctr),false) 315 | else if (store_ctr < store$min_inven) then 316 | begin 317 | for i2 := 1 to (store$min_inven-store_ctr+2) do 318 | store_create(i1); 319 | end 320 | else 321 | begin 322 | for i2 := 1 to (1+randint(store$turn_around)) do 323 | store_destroy(i1,randint(store_ctr),true); 324 | for i2 := 1 to (1+randint(store$turn_around)) do 325 | store_create(i1); 326 | end; 327 | end; 328 | end; 329 | -------------------------------------------------------------------------------- /source/include/variables.inc: -------------------------------------------------------------------------------- 1 | var 2 | player_max_exp : [psect(player$data)] 3 | integer; { Max exp possible } 4 | seed : [psect(player$data),global] 5 | unsigned; { Contains seed # } 6 | randes_seed : [psect(setup$data)] 7 | unsigned; { For encoding colors } 8 | town_seed : [psect(generate$data)] 9 | unsigned; { Seed for town genera} 10 | channel : [psect(io$data),global] 11 | integer; { I/O channel # } 12 | io$bin_pause : [psect(io$data)] 13 | quad_type; { I/O pause time } 14 | cur_height,cur_width : [psect(player$data)] 15 | integer; { Cur dungeon size } 16 | dun_level : [psect(player$data)] 17 | integer; { Cur dungeon level } 18 | missle_ctr : [psect(player$data)] 19 | integer; { Counter for missles } 20 | msg_line : [psect(player$data)] 21 | integer; { Contains message txt} 22 | msg_flag : [psect(player$data)] 23 | boolean; { Set with first msg } 24 | old_msg : [psect(player$data)] 25 | vtype; { Last message } 26 | generate : [psect(setup$data)] 27 | boolean; { Generate next level } 28 | death : [psect(player$data)] 29 | boolean; { True if died } 30 | died_from : [psect(player$data)] 31 | vtype; { What killed him } 32 | find_flag : [psect(player$data)] 33 | boolean; { Used in MORIA } 34 | reset_flag : [psect(player$data)] 35 | boolean; { Used in MORIA } 36 | cave_flag : [psect(player$data)] 37 | boolean; { Used in GET_PANEL } 38 | light_flag : [psect(player$data)] 39 | boolean; { Used in MOVE_LIGHT } 40 | redraw : [psect(player$data)] 41 | boolean; { For redraw screen } 42 | stat_column : [psect(player$data)] 43 | integer; { Column for stats } 44 | print_stat : [psect(player$data)] 45 | unsigned; { Flag for stats } 46 | turn : [psect(player$data)] 47 | integer; { Cur trun of game } 48 | wizard1 : [psect(player$data)] 49 | boolean; { Wizard flag } 50 | wizard2 : [psect(player$data)] 51 | boolean; { Wizard flag } 52 | used_line : [psect(player$data)] 53 | array [2..23] of boolean; 54 | password1 : [psect(setup$data)] 55 | packed array [1..12] of char; 56 | password2 : [psect(setup$data)] 57 | packed array [1..12] of char; 58 | wdata : [psect(setup$data)] 59 | array [1..2,0..12] of unsigned; 60 | days : [psect(setup$data)] 61 | array [1..7] of vtype; 62 | closing_flag : [psect(player$data)] 63 | integer; { Used for closing } 64 | 65 | { Bit testing array } 66 | bit_array : [psect(player$data)] 67 | array [1..32] of unsigned; 68 | 69 | { External file names; are all located in directory with image } 70 | MORIA_HOU : [psect(setup$data)] vtype; 71 | MORIA_MOR : [psect(setup$data)] vtype; 72 | MORIA_MAS : [psect(setup$data)] vtype; 73 | MORIA_TOP : [psect(setup$data)] vtype; 74 | MORIA_HLP : [psect(setup$data)] vtype; 75 | 76 | { Following are calculated from max dungeon sizes } 77 | max_panel_rows,max_panel_cols : [psect(player$data)] integer; 78 | quart_height,quart_width : [psect(player$data)] integer; 79 | panel_row,panel_col : [psect(player$data)] integer; 80 | panel_row_min,panel_row_max : [psect(player$data)] integer; 81 | panel_col_min,panel_col_max : [psect(player$data)] integer; 82 | panel_col_prt,panel_row_prt : [psect(player$data)] integer; 83 | 84 | { Following are all floor definitions } 85 | cave : [psect(moria$data)] 86 | array [1..max_height] of row_floor; 87 | blank_floor : [psect(generate$data)] cave_type; 88 | dopen_floor : [psect(generate$data)] floor_type; 89 | lopen_floor : [psect(generate$data)] floor_type; 90 | corr_floor1 : [psect(generate$data)] floor_type; 91 | corr_floor2 : [psect(generate$data)] floor_type; 92 | corr_floor3 : [psect(generate$data)] floor_type; 93 | corr_floor4 : [psect(generate$data)] floor_type; 94 | rock_wall1 : [psect(generate$data)] floor_type; 95 | rock_wall2 : [psect(generate$data)] floor_type; 96 | rock_wall3 : [psect(generate$data)] floor_type; 97 | boundry_wall : [psect(generate$data)] floor_type; 98 | 99 | { Following are set definitions } 100 | floor_set : [psect(moria$data)] obj_set; 101 | wall_set : [psect(moria$data)] obj_set; 102 | pwall_set : [psect(moria$data)] obj_set; 103 | corr_set : [psect(moria$data)] obj_set; 104 | trap_set : [psect(moria$data)] obj_set; 105 | light_set : [psect(moria$data)] obj_set; 106 | 107 | { Following are player variables } 108 | py : [psect(player$data)] player_type; 109 | player_title : [psect(player$data)] 110 | array [1..max_class] of 111 | array [1..max_player_level] of btype; 112 | player_exp : [psect(player$data)] 113 | array [1..max_player_level] of integer; 114 | acc_exp : [psect(player$data)] 115 | real; { Accumulator for fractional exp} 116 | bare_hands : [psect(player$data)] 117 | dtype; 118 | char_row : [psect(player$data)] integer; 119 | char_col : [psect(player$data)] integer; 120 | com_val : [psect(player$data)] integer; 121 | pclass : [psect(player$data)] integer; 122 | sex_type : [psect(player$data)] vtype; 123 | race : [psect(create$data)] 124 | array [1..max_races] of race_type; 125 | background : [psect(create$data)] 126 | array [1..max_background] of background_type; 127 | rgold_adj : [psect(store$data)] 128 | array [1..max_races] of 129 | array [1..max_races] of real; 130 | class : [psect(create$data)] 131 | array [1..max_class] of class_type; 132 | magic_spell : [psect(player$data)] 133 | array [1..max_class] of 134 | array [1..31] of spell_type; 135 | mush : [psect(setup$data)] treasure_type; 136 | player_init : [psect(create$data)] 137 | array [1..max_class] of 138 | array [1..5] of byteint; 139 | total_winner : [psect(setup$data)] boolean; 140 | 141 | { Following are store definitions } 142 | owners : [psect(store$data)] 143 | array [1..max_owners] of owner_type; 144 | store : [psect(store$data)] 145 | array [1..max_stores] of store_type; 146 | store_door : [psect(generate$data)] 147 | array [1..max_stores] of treasure_type; 148 | store_choice : [psect(store$data)] 149 | array [1..max_stores] of 150 | array [1..store$choices] of integer; 151 | store_buy : [psect(store$data)] 152 | array [1..max_stores] of obj_set; 153 | 154 | { Following are treasure arrays and variables } 155 | object_list : [psect(moria$data)] 156 | array [1..max_objects] of treasure_type; 157 | object_ident : [psect(moria$data)] 158 | array [1..max_objects] of boolean; 159 | t_level : [psect(moria$data)] 160 | array [0..max_obj_level] of integer; 161 | gold_list : [psect(moria$data)] 162 | array [1..max_gold] of treasure_type; 163 | t_list : [psect(moria$data)] 164 | array [1..max_talloc] of treasure_type; 165 | inventory : [psect(player$data)] 166 | array [1..inven_max] of treasure_type; 167 | inventory_init : [psect(setup$data)] 168 | array [1..inven_init_max] of treasure_type; 169 | blank_treasure : [psect(moria$data)] treasure_type; 170 | inven_ctr : [psect(player$data)] 171 | integer; { Total different obj's } 172 | inven_weight : [psect(player$data)] 173 | integer; { Cur carried weight } 174 | equip_ctr : [psect(player$data)] 175 | integer; { Cur equipment ctr } 176 | tcptr : [psect(moria$data)] 177 | integer; { Cur treasure heap ptr } 178 | 179 | { Following are feature objects defined for dungeon } 180 | trap_lista : [psect(generate$data)] 181 | array [1..max_trapa] of treasure_type; 182 | trap_listb : [psect(generate$data)] 183 | array [1..max_trapb] of treasure_type; 184 | scare_monster : [psect(generate$data)] 185 | treasure_type; { Special trap } 186 | rubble : [psect(generate$data)] 187 | treasure_type; 188 | door_list : [psect(generate$data)] 189 | array [1..3] of treasure_type; 190 | up_stair : [psect(generate$data)] 191 | treasure_type; 192 | down_stair : [psect(generate$data)] 193 | treasure_type; 194 | 195 | { Following are creature arrays and variables } 196 | c_list : [psect(moria$data)] 197 | array [1..max_creatures] of creature_type; 198 | m_list : [psect(moria$data)] 199 | array [1..max_malloc] of monster_type; 200 | m_level : [psect(generate$data)] 201 | array [0..max_mons_level] of integer; 202 | blank_monster : [psect(generate$data)] 203 | monster_type; { Blank monster values } 204 | muptr : [psect(generate$data)] 205 | integer; { Cur used monster ptr } 206 | mfptr : [psect(generate$data)] 207 | integer; { Cur free monster ptr } 208 | mon_tot_mult : [psect(moria$data)] 209 | integer; { # of repro's of creature } 210 | 211 | { Following are arrays for descriptive pieces } 212 | colors : [psect(setup$data)] 213 | array [1..max_colors] of atype; 214 | mushrooms : [psect(setup$data)] 215 | array [1..max_mush] of atype; 216 | woods : [psect(setup$data)] 217 | array [1..max_woods] of atype; 218 | metals : [psect(setup$data)] 219 | array [1..max_metals] of atype; 220 | rocks : [psect(setup$data)] 221 | array [1..max_rocks] of atype; 222 | amulets : [psect(setup$data)] 223 | array [1..max_amulets] of atype; 224 | syllables : [psect(setup$data)] 225 | array [1..max_syllables] of dtype; 226 | vowel_set : [psect(moria$data)] 227 | char_set; 228 | 229 | { Following are variables for the Save Character Routines } 230 | finam : [psect(save$data)] 231 | vtype; 232 | key_rec : [psect(save$data)] 233 | key_type; 234 | 235 | { Cursor variables, used for cursor positioning } 236 | cursor_r : [psect(io$data),global] 237 | array [1..24] of varying[10] of char; 238 | curlen_r : [psect(io$data),global] integer; 239 | cursor_c : [psect(io$data),global] 240 | array [1..80] of varying[10] of char; 241 | curlen_c : [psect(io$data),global] integer; 242 | cursor_l : [psect(io$data),global] integer; 243 | row_first : [psect(io$data),global] boolean; 244 | cursor_erl : [psect(io$data),global] varying[10] of char; 245 | cursor_erp : [psect(io$data),global] varying[10] of char; 246 | -------------------------------------------------------------------------------- /source/include/death.inc: -------------------------------------------------------------------------------- 1 | { Handles the gravestone and top-twenty routines -RAK- } 2 | [psect(death$code)] procedure upon_death; 3 | type 4 | word = 0..65535; 5 | recj = record 6 | unameinfo : packed record 7 | unamelen : word; 8 | jpi$_username : word; 9 | end; 10 | ptr_uname : ^usernam; 11 | ptr_unamelen : ^integer; 12 | endlist : integer 13 | end; 14 | usernam = packed array [1..12] of char; 15 | 16 | 17 | { function returns the players USERNAME -JWT- } 18 | function get_username : usernam; 19 | var 20 | user : usernam; 21 | icode : integer; 22 | jpirec : recj; 23 | 24 | { calls GETJPI routine to return the USERNAME -JWT- } 25 | function sys$getjpi (%immed p1 : integer; 26 | %immed p2 : integer; 27 | %immed p3 : integer; 28 | var itmlst : recj; 29 | %immed p4 : integer; 30 | %immed p5 : integer; 31 | %immed p6 : integer) : integer; 32 | external; 33 | 34 | begin 35 | with jpirec do 36 | begin 37 | unameinfo.unamelen := 12; 38 | unameinfo.jpi$_username := %x202; 39 | new (ptr_uname); 40 | ptr_uname^ := ' '; 41 | new (ptr_unamelen); 42 | ptr_unamelen^ := 0; 43 | endlist := 0 44 | end; 45 | icode := SYS$GETJPI (0,0,0,jpirec,0,0,0); 46 | if not odd(icode) then 47 | begin 48 | writeln('Error in GETJPI process'); 49 | halt 50 | end 51 | else 52 | get_username := jpirec.ptr_uname^ 53 | end; 54 | 55 | 56 | 57 | { Centers a string within a 31 character string -JWT- } 58 | function fill_str (p1 : vtype) : vtype; 59 | var 60 | s1 : vtype; 61 | i1 : integer; 62 | begin 63 | s1 := ''; 64 | i1 := trunc(length(p1) / 2); 65 | fill_str := substr(pad(s1,' ',15-i1) + pad(p1,' ',31),1,31); 66 | end; 67 | 68 | 69 | { Prints a line to the screen efficiently -RAK- } 70 | procedure dprint(str : vtype; row : integer); 71 | var 72 | i1,i2,nblanks,xpos : integer; 73 | prt_str : vtype; 74 | begin 75 | prt_str := ''; 76 | nblanks := 0; 77 | xpos := 0; 78 | for i1 := 1 to length(str) do 79 | begin 80 | if (str[i1] = ' ') then 81 | begin 82 | if (xpos > 0) then 83 | begin 84 | nblanks := nblanks + 1; 85 | if (nblanks > 5) then 86 | begin 87 | nblanks := 0; 88 | put_buffer(prt_str,row,xpos); 89 | prt_str := ''; 90 | xpos := 0; 91 | end 92 | end; 93 | end 94 | else 95 | begin 96 | if (xpos = 0) then xpos := i1; 97 | if (nblanks > 0) then 98 | begin 99 | for i2 := 1 to nblanks do 100 | prt_str := prt_str + ' '; 101 | nblanks := 0; 102 | end; 103 | prt_str := prt_str + str[i1]; 104 | end; 105 | end; 106 | if (xpos > 0) then 107 | put_buffer(prt_str,row,xpos); 108 | end; 109 | 110 | 111 | { Prints the gravestone of the character -RAK- } 112 | procedure print_tomb; 113 | var 114 | str1,str2,str3,str4,str5,str6,str7,str8 : vtype; 115 | dstr : array [0..19] of vtype; 116 | fnam : vtype; 117 | command : char; 118 | f1 : text; 119 | i1 : integer; 120 | day : packed array [1..11] of char; 121 | flag : boolean; 122 | begin 123 | date(day); 124 | str1 := fill_str(py.misc.name); 125 | str2 := fill_str(py.misc.title); 126 | str3 := fill_str(py.misc.tclass); 127 | writev(str4,'Level : ',py.misc.lev:1); 128 | str4 := fill_str(str4); 129 | writev(str5,py.misc.exp:1,' Exp'); 130 | str5 := fill_str(str5); 131 | writev(str6,py.misc.au:1,' Au'); 132 | str6 := fill_str(str6); 133 | writev(str7,'Died on Level : ',dun_level:1); 134 | str7 := fill_str(str7); 135 | str8 := fill_str(died_from); 136 | dstr[00] := ' '; 137 | dstr[01] := ' _______________________'; 138 | dstr[02] := ' / \ ___'; 139 | dstr[03] := ' / \ ___ / \ ___'; 140 | dstr[04] := ' / RIP \ \ : : / \'; 141 | dstr[05] := ' / \ : _;,,,;_ : :'; 142 | dstr[06] := ' /'+str1+ '\,;_ _;,,,;_'; 143 | dstr[07] := ' | the | ___'; 144 | dstr[08] := ' | '+str2+ ' | / \'; 145 | dstr[09] := ' | | : :'; 146 | dstr[10] := ' | '+str3+ ' | _;,,,;_ ____'; 147 | dstr[11] := ' | '+str4+ ' | / \'; 148 | dstr[12] := ' | '+str5+ ' | : :'; 149 | dstr[13] := ' | '+str6+ ' | : :'; 150 | dstr[14] := ' | '+str7+ ' | _;,,,,;_'; 151 | dstr[15] := ' | killed by |'; 152 | dstr[16] := ' | '+str8+ ' |'; 153 | dstr[17] := ' | '+day+ ' |'; 154 | dstr[18] := ' *| * * * * * * | *'; 155 | dstr[19] := '________)/\\_)_/___(\/___(//_\)/_\//__\\(/_|_)_______'; 156 | clear(1,1); 157 | for i1 := 0 to 19 do 158 | dprint(dstr[i1],i1+1); 159 | flush; 160 | if (get_com('Print to file? (Y/N)',command)) then 161 | case command of 162 | 'y','Y': begin 163 | prt('Enter Filename:',1,1); 164 | flag := false; 165 | repeat 166 | if (get_string(fnam,1,17,60)) then 167 | begin 168 | if (length(fnam) = 0) then fnam:='MORIACHR.DIE'; 169 | open (f1,file_name:=fnam,error:=continue); 170 | if (status(f1) <> 0) then 171 | prt('Error creating> ' + fnam,2,1) 172 | else 173 | begin 174 | flag := true; 175 | rewrite(f1,error:=continue); 176 | for i1 := 0 to 19 do 177 | writeln(f1,dstr[i1],error:=continue); 178 | end; 179 | close(f1,error:=continue); 180 | end 181 | else 182 | flag := true; 183 | until(flag); 184 | end; 185 | otherwise ; 186 | end; 187 | end; 188 | 189 | 190 | { Calculates the total number of points earned -JWT- } 191 | function total_points : integer; 192 | begin 193 | with py.misc do 194 | total_points := max_exp + (100*py.misc.max_lev); 195 | end; 196 | 197 | 198 | { Enters a players name on the top twenty list -JWT- } 199 | procedure top_twenty; 200 | var 201 | list : array [1..20] of vtype; 202 | blank : packed array [1..13] of char; 203 | i1,i2,i3,i4 : integer; 204 | n1 : integer; 205 | trys : integer; 206 | o1,o2 : vtype; 207 | f1 : text; 208 | flag,file_flag : boolean; 209 | begin 210 | if (wizard1) then exit; 211 | clear(1,1); 212 | for i1 := 1 to 20 do 213 | list[i1] := ''; 214 | n1 := 1; 215 | priv_switch(1); 216 | trys := 0; 217 | file_flag := false; 218 | repeat 219 | open (f1,file_name:=moria_top, 220 | organization:=sequential,history:=old, 221 | sharing:=none,error:=continue); 222 | if (status(f1) = 2) then 223 | begin 224 | trys := trys + 1; 225 | if (trys > 5) then 226 | file_flag := true 227 | else 228 | sleep(2); 229 | end 230 | else 231 | file_flag := true; 232 | until(file_flag); 233 | if ((status(f1) <> 0) and (status(f1) <> 2)) then 234 | open (f1,file_name:=moria_top, 235 | organization:=sequential,history:=new, 236 | sharing:=none,error:=continue); 237 | if (status(f1) <> 0) then 238 | begin 239 | writeln('Error in opening ',moria_top); 240 | writeln('Please contact local Moria Wizard.'); 241 | exit; 242 | end; 243 | reset(f1); 244 | while ((not eof(f1)) and (n1 <= 20)) do 245 | begin 246 | readln(f1,list[n1],error:=continue); 247 | n1 := n1 + 1; 248 | end; 249 | n1 := n1 - 1; 250 | i1 := 1; 251 | i3 := total_points; 252 | flag := false; 253 | while ((i1 <= n1) and (not flag)) do 254 | begin 255 | readv(list[i1],blank,i4); 256 | if (i4 < i3) then 257 | flag := true 258 | else 259 | i1 := i1 + 1; 260 | end; 261 | if ((flag) or (n1 = 0) or (n1 < 20)) then 262 | begin 263 | for i2 := 19 downto i1 do 264 | list[i2+1] := list[i2]; 265 | o1 := get_username; 266 | case py.misc.lev of 267 | 1 : writev(o2,py.misc.lev:1,'st level '); 268 | 2 : writev(o2,py.misc.lev:1,'nd level '); 269 | 3 : writev(o2,py.misc.lev:1,'rd level '); 270 | otherwise writev(o2,py.misc.lev:1,'th level '); 271 | end; 272 | writev(list[i1],pad(o1,' ',13),i3:7,' ', 273 | py.misc.name,', a ',o2,py.misc.race,' ', 274 | py.misc.tclass,'.'); 275 | if (n1 < 20) then 276 | n1 := n1 + 1; 277 | flag := false; 278 | end; 279 | rewrite(f1); 280 | for i1 := 1 to n1 do 281 | writeln(f1,list[i1]); 282 | close(f1); 283 | priv_switch(0); 284 | put_buffer('Username Points Character that died.',1,1); 285 | for i1 := 1 to n1 do 286 | put_buffer(list[i1],i1+1,1); 287 | put_buffer('',i1+2,1); 288 | put_qio; 289 | end; 290 | 291 | 292 | { Change the player into a King! -RAK- } 293 | procedure kingly; 294 | begin 295 | { Change the character attributes... } 296 | dun_level := 0; 297 | died_from := 'Ripe Old Age'; 298 | with py.misc do 299 | begin 300 | lev := lev + max_player_level; 301 | if (sex[1] = 'M') then 302 | begin 303 | title := 'Magnificent'; 304 | tclass := '*King*'; 305 | end 306 | else 307 | begin 308 | title := 'Beautiful'; 309 | tclass := '*Queen*'; 310 | end; 311 | au := au + 250000; 312 | max_exp := max_exp + 5000000; 313 | exp := max_exp; 314 | end; 315 | { Let the player know that he did good... } 316 | clear(1,1); 317 | dprint(' #',2); 318 | dprint(' #####',3); 319 | dprint(' #',4); 320 | dprint(' ,,, $$$ ,,,',5); 321 | dprint(' ,,=$ "$$$$$" $=,,',6); 322 | dprint(' ,$$ $$$ $$,',7); 323 | dprint(' *> <*> <*',8); 324 | dprint(' $$ $$$ $$',9); 325 | dprint(' "$$ $$$ $$"',10); 326 | dprint(' "$$ $$$ $$"',11); 327 | dprint(' *#########*#########*',12); 328 | dprint(' *#########*#########*',13); 329 | dprint(' Veni, Vidi, Vici!',16); 330 | dprint(' I came, I saw, I conquered!',17); 331 | dprint(' All Hail the Mighty King!',18); 332 | flush; 333 | pause(24); 334 | end; 335 | 336 | 337 | { What happens upon dying... -RAK- } 338 | begin 339 | if (total_winner) then kingly; 340 | print_tomb; 341 | top_twenty; 342 | exit; 343 | end; 344 | -------------------------------------------------------------------------------- /source/include/types.inc: -------------------------------------------------------------------------------- 1 | type 2 | byteint = [byte] 0..255; 3 | bytlint = [byte] -128..127; 4 | wordint = [word] 0..65535; 5 | worlint = [word] -32768..32767; 6 | quad_type = record 7 | l0 : unsigned; 8 | l1 : unsigned; 9 | end; 10 | atype = varying [16] of char; 11 | btype = varying [14] of char; 12 | ctype = varying [26] of char; 13 | dtype = varying [5] of char; 14 | etype = varying [34] of char; 15 | mtype = varying [190] of char; 16 | ntype = varying[1024] of char; 17 | ttype = varying [68] of char; 18 | vtype = varying [80] of char; 19 | stat_type = packed array [1..6] of char; 20 | obj_set = set of 0..255; 21 | char_set = set of 'A'..'z'; 22 | key_type = record { For char saver } 23 | file_id : [key(0)] packed array [1..70] of char; 24 | seed : integer; 25 | end; 26 | creature_type = record 27 | name : ctype; { Descrip of creature } 28 | cmove : unsigned; { Bit field } 29 | spells : unsigned; { Creature spells } 30 | cdefense: wordint; { Bit field } 31 | sleep : worlint; { Inactive counter } 32 | mexp : wordint; { Exp value for kill } 33 | aaf : byteint; { Area affect radius } 34 | ac : byteint; { AC } 35 | speed : bytlint; { Movement speed } 36 | cchar : char; { Character rep. } 37 | hd : dtype; { Creatures hit die } 38 | damage : etype; { Type attack and damage} 39 | level : byteint; { Level of creature } 40 | end; 41 | monster_type = record 42 | hp : worlint; { Hit points } 43 | csleep : worlint; { Inactive counter } 44 | cdis : worlint; { Cur dis from player } 45 | mptr : wordint; { Pointer into creature } 46 | nptr : wordint; { Pointer to next block } 47 | cspeed : bytlint; { Movement speed } 48 | 49 | { Note: FY and FX constrain dungeon size to 255 } 50 | fy : byteint; { Y Pointer into map } 51 | fx : byteint; { X Pointer into map } 52 | 53 | stuned : [bit(6),pos(104)] -32..31; { Rounds stunned} 54 | ml : [bit(1),pos(110)] boolean; { On if shown } 55 | confused: [bit(1),pos(111)] boolean; { On if confused} 56 | end; 57 | treasure_type = record 58 | name : ttype; { Object name } 59 | tval : byteint; { Catagory number } 60 | tchar : char; { Character representation} 61 | flags : unsigned; { Special flags } 62 | p1 : integer; { Misc. use variable } 63 | cost : integer; { Cost of item } 64 | subval : integer; { Sub-catagory number } 65 | weight : wordint; { Weight } 66 | number : wordint; { Number of items } 67 | tohit : worlint; { Pluses to hit } 68 | todam : worlint; { Pluses to damage } 69 | ac : worlint; { Normal AC } 70 | toac : worlint; { Pluses to AC } 71 | damage : dtype; { Damage when hits } 72 | level : bytlint; { Level item found } 73 | end; 74 | player_type = record 75 | misc : record 76 | name : vtype; { Name of character } 77 | race : vtype; { Race of character } 78 | sex : vtype; { Sex of character } 79 | title : vtype; { Character's title } 80 | tclass : vtype; { Character's class } 81 | max_exp : integer; { Max experience} 82 | exp : integer; { Cur experienc } 83 | au : integer; { Gold } 84 | age : wordint; { Characters age} 85 | ht : wordint; { Height } 86 | wt : wordint; { Weight } 87 | lev : wordint; { Level } 88 | max_lev : wordint; { Max level explored} 89 | srh : worlint; { Chance in search} 90 | fos : worlint; { Frenq of search} 91 | bth : worlint; { Base to hit } 92 | bthb : worlint; { BTH with bows } 93 | mana : worlint; { Mana points } 94 | mhp : worlint; { Max hit pts } 95 | ptohit : worlint; { Pluses to hit } 96 | ptodam : worlint; { Pluses to dam } 97 | pac : worlint; { Total AC } 98 | ptoac : worlint; { Magical AC } 99 | dis_th : worlint; { Display +ToHit} 100 | dis_td : worlint; { Display +ToDam} 101 | dis_ac : worlint; { Display +ToAC } 102 | dis_tac : worlint; { Display +ToTAC} 103 | disarm : worlint; { % to Disarm } 104 | save : worlint; { Saving throw } 105 | sc : worlint; { Social Class } 106 | pclass : byteint; { # of class } 107 | prace : byteint; { # of race } 108 | hitdie : byteint; { Char hit die } 109 | stl : bytlint; { Stealth factor} 110 | expfact : real; { Experience factor} 111 | cmana : real; { Cur mana pts } 112 | chp : real; { Cur hit pts } 113 | history : array [1..5] of vtype;{ History record} 114 | end; 115 | stat : record 116 | str : byteint; { Max strength } 117 | cstr : byteint; { Current strength } 118 | dex : byteint; { Max dexterity } 119 | cdex : byteint; { Current dexterity } 120 | con : byteint; { Max constitution } 121 | ccon : byteint; { Current constitution} 122 | int : byteint; { Max intelligence } 123 | cint : byteint; { Current intelligence} 124 | wis : byteint; { Max wisdom } 125 | cwis : byteint; { Current wisdom } 126 | chr : byteint; { Max charisma } 127 | cchr : byteint; { Current charisma } 128 | end; 129 | flags : record 130 | status : unsigned; { Status of player } 131 | rest : integer; { Rest counter } 132 | blind : integer; { Blindness counter } 133 | paralysis : integer; { Paralysis counter } 134 | confused : integer; { Confusion counter } 135 | food : integer; { Food counter } 136 | food_digested : integer; { Food per round } 137 | protection : integer; { Protection fr. evil } 138 | speed : integer; { Cur speed adjust } 139 | fast : integer; { Temp speed change } 140 | slow : integer; { Temp speed change } 141 | afraid : integer; { Fear } 142 | poisoned : integer; { Poisoned } 143 | image : integer; { Halucinate } 144 | protevil : integer; { Protect VS evil } 145 | invuln : integer; { Increases AC } 146 | hero : integer; { Heroism } 147 | shero : integer; { Super Heroism } 148 | blessed : integer; { Blessed } 149 | resist_heat : integer; { Timed heat resist } 150 | resist_cold : integer; { Timed cold resist } 151 | detect_inv : integer; { Timed see invisible } 152 | word_recall : integer; { Timed teleport level} 153 | see_infra : integer; { See warm creatures } 154 | tim_infra : integer; { Timed infra vision } 155 | see_inv : boolean; { Can see invisible } 156 | teleport : boolean; { Random teleportation} 157 | free_act : boolean; { Never paralyzed } 158 | slow_digest : boolean; { Lower food needs } 159 | aggravate : boolean; { Agravate monsters } 160 | fire_resist : boolean; { Resistance to fire } 161 | cold_resist : boolean; { Resistance to cold } 162 | acid_resist : boolean; { Resistance to acid } 163 | regenerate : boolean; { Regenerate hit pts } 164 | lght_resist : boolean; { Resistance to light } 165 | ffall : boolean; { No damage falling } 166 | sustain_str : boolean; { Keep strength } 167 | sustain_int : boolean; { Keep intelligence } 168 | sustain_wis : boolean; { Keep wisdom } 169 | sustain_con : boolean; { Keep constitution } 170 | sustain_dex : boolean; { Keep dexterity } 171 | sustain_chr : boolean; { Keep charisma } 172 | confuse_monster : boolean; { Glowing hands... } 173 | end; 174 | end; 175 | spell_type = record 176 | sname : ctype; 177 | slevel : byteint; 178 | smana : byteint; 179 | sexp : wordint; 180 | sfail : byteint; 181 | learned : boolean; 182 | end; 183 | spl_rec = record 184 | splnum : integer; 185 | splchn : integer; 186 | end; 187 | spl_type = array [1..22] of spl_rec; 188 | race_type = packed record 189 | trace : vtype; { Type of race } 190 | str_adj : bytlint; { adjustments } 191 | int_adj : bytlint; 192 | wis_adj : bytlint; 193 | dex_adj : bytlint; 194 | con_adj : bytlint; 195 | chr_adj : bytlint; 196 | b_age : wordint; { Base age of character } 197 | m_age : wordint; { Maximum age of character } 198 | m_b_ht : wordint; { base height for males } 199 | m_m_ht : wordint; { mod height for males } 200 | m_b_wt : wordint; { base weight for males } 201 | m_m_wt : wordint; { mod weight for males } 202 | f_b_ht : wordint; { base height females } 203 | f_m_ht : wordint; { mod height for females } 204 | f_b_wt : wordint; { base weight for female } 205 | f_m_wt : wordint; { mod weight for females } 206 | b_exp : real; { Base experience factor } 207 | b_dis : bytlint; { base chance to disarm } 208 | srh : bytlint; { base chance for search } 209 | stl : bytlint; { Stealth of character } 210 | fos : bytlint; { frequency of auto search } 211 | bth : bytlint; { adj base chance to hit } 212 | bthb : bytlint; { adj base to hit with bows } 213 | bsav : bytlint; { Race base for saving throw } 214 | bhitdie : bytlint; { Base hit points for race } 215 | infra : bytlint; { See infra-red } 216 | tclass : unsigned; { Bit field for class types } 217 | end; 218 | class_type = record 219 | title : vtype; { type of class } 220 | m_exp : real; { Class experience factor } 221 | adj_hd : bytlint;{ Adjust hit points } 222 | mdis : bytlint;{ mod disarming traps } 223 | msrh : bytlint;{ modifier to searching } 224 | mstl : bytlint;{ modifier to stealth } 225 | mfos : bytlint;{ modifier to freq-of-search } 226 | mbth : bytlint;{ modifier to base to hit } 227 | mbthb : bytlint;{ modifier to base to hit - bows} 228 | msav : bytlint;{ Class modifier to save } 229 | madj_str: bytlint;{ Class modifier for strength} 230 | madj_int: bytlint;{ Class modifier for intelligence} 231 | madj_wis: bytlint;{ Class modifier for wisdom } 232 | madj_dex: bytlint;{ Class modifier for dexterity} 233 | madj_con: bytlint;{ Class modifier for constitution} 234 | madj_chr: bytlint;{ Class modifier for charisma} 235 | pspell : boolean; { class use priest spells } 236 | mspell : boolean; { class use mage spells } 237 | end; 238 | background_type = record 239 | info : vtype; { History information } 240 | roll : byteint; { Die roll needed for history} 241 | chart : byteint; { Table number } 242 | next : bytlint;{ Pointer to next table } 243 | bonus : bytlint;{ Bonus to the Social Class } 244 | end; 245 | floor_type = record 246 | ftval : [bit(7),pos(0)] 0..15; 247 | ftopen : [bit(1),pos(7)] boolean; 248 | end; 249 | cave_type = record 250 | cptr : byteint; 251 | tptr : byteint; 252 | fval : [bit(4),pos(16)] 0..15; 253 | fopen : [bit(1),pos(20)] boolean; 254 | fm : [bit(1),pos(21)] boolean; 255 | pl : [bit(1),pos(22)] boolean; 256 | tl : [bit(1),pos(23)] boolean; 257 | end; 258 | row_floor = array [1..max_width] of cave_type; 259 | owner_type = record 260 | owner_name : vtype; 261 | max_cost : worlint; 262 | max_inflate : real; 263 | min_inflate : real; 264 | haggle_per : real; 265 | owner_race : byteint; 266 | insult_max : byteint; 267 | end; 268 | inven_record = record 269 | scost : integer; 270 | sitem : treasure_type; 271 | end; 272 | store_type = record 273 | store_open : worlint; 274 | owner : byteint; 275 | insult_cur : bytlint; 276 | store_ctr : byteint; 277 | store_inven : array [1..store_inven_max] of inven_record; 278 | end; 279 | -------------------------------------------------------------------------------- /aaareadme.1st: -------------------------------------------------------------------------------- 1 | The Dungeons of Moria - COPYRIGHT (c) Robert Alan Koeneke The Dungeons of Moria - COPYRIGHT (c) Robert Alan Koeneke 2 | 3 | 4 | 1.0 DISCLAIMER __________ 5 | 6 | Moria is intended for Public Domain, and may not be sold or 7 | marketed IN ANY FORM without the permision and written consent 8 | from the author Robert Alan Koeneke. I retain all copyrights to 9 | this program, in either the original or modified forms, and no 10 | violation, deletion, or change of the copyright notice is 11 | allowed. Futhermore, I will have no liability or responsibilty 12 | to any user with respect to loss or damage caused directly or 13 | indirectly by this program. 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 1 61 | The Dungeons of Moria - COPYRIGHT (c) Robert Alan Koeneke The Dungeons of Moria - COPYRIGHT (c) Robert Alan Koeneke 62 | 63 | 64 | 2.0 INTRODUCTION ____________ 65 | 66 | MORIA is a huge dungeon simulation game written mainly in 67 | VAX-11 PASCAL, encompasing about 22,000 lines of code. A single 68 | executable file is all that is needed to bring up MORIA for the 69 | first time, although a MORIA help library must be present in 70 | order to use the internal help options. 71 | 72 | In addition to the PASCAL source code, several macro 73 | functions and procedures are present which must be linked into 74 | the moria object library. These macro routines are primarily 75 | used for greatly improved speed on IO and execution. 76 | 77 | 78 | 79 | 3.0 THE DISTRIBUTION PACKAGE ___ ____________ _______ 80 | 81 | This distribution package contains many files organized into 82 | certain directories. The directory structure is as follows: 83 | 84 | +--------------------+ 85 | |Main MORIA directory| 86 | | Build.com | 87 | +--------------------+ 88 | / | \ 89 | / | \ 90 | +--------------------+ +--------------------+ +--------------------+ 91 | | DOC - Documentation| | SOURCE - .PAS files| | EXECUTE - Binaries | 92 | | source | | | | and data | 93 | +--------------------+ +--------------------+ +--------------------+ 94 | / \ 95 | / \ 96 | +--------------------+ +--------------------+ 97 | | MACRO - source & | | INCLUDE - Pascal | 98 | | library | | include files| 99 | +--------------------+ +--------------------+ 100 | 101 | 102 | A ready to run Moria is found in EXECUTE.DIR, along with all 103 | needed data files and the Moria help library. You may execute 104 | BUILD.COM to rebuild Moria if needed. Examine BUILD.COM closely 105 | and you will notice that it will allow you to rebuild certain 106 | sections of Moria or re-link it, if the proper parameter is used. 107 | 108 | Documentation source can be found in the directory DOC.DIR. 109 | MORIA.HLP is used to build the help library. MORIA.RNO is used 110 | for the manual which can be printed off. 111 | 112 | The source directory, SOURCE.DIR, contains only MORIA.PAS 113 | and TERMDEF.PAS. Most of the guts to Moria can be found in the 114 | directory INCLUDE.DIR, which contains all of the include files 115 | used by MORIA.PAS. MACRO.DIR contains several macro routines, 116 | whose objects are stored in MORIALIB.OLB, an object module 117 | library. 118 | 119 | 120 | 2 121 | The Dungeons of Moria - COPYRIGHT (c) Robert Alan Koeneke The Dungeons of Moria - COPYRIGHT (c) Robert Alan Koeneke 122 | 123 | 124 | 4.0 INSTALLATION ____________ 125 | 126 | Because of the size of MORIA when running, it is suggested 127 | that it be installed shared. MORIA can be installed with SYSPRV 128 | so that all data files can be kept locked up to all but system. 129 | MORIA turns off SYSPRV automatically unless accessing it's own 130 | data files, so that no breach in system security is possible. 131 | Also, the game itself should be read protected, allowing only 132 | EXECUTE access, so that it can not propagate within a system. 133 | 134 | 135 | Installed without SYSPRV /open/shared 136 | Executable protection MORIA.EXE (s:re,o:re,g:re,w:re) 137 | 138 | Installed with SYSPRV /priv=sysprv/open/shared 139 | Executable protection MORIA.EXE (s:re,o:e,g:e,w:e) 140 | 141 | 142 | 143 | When MORIA is first executed, it looks for certain data 144 | files in the same directory as the executable. If they are not 145 | found, they are created with default values and the game exits. 146 | The local MORIA WIZARD should edit these files for site specific 147 | information and running hours. 148 | 149 | Four data files are created and maintained by MORIA. 150 | MORIA.DAT contains a startup message and MORIA news, and can be 151 | used to tell MORIAvites about changes in playing times and such. 152 | HOURS.DAT contains a reject message and the normal operating 153 | hours for the game. Note that the only part of this file 154 | important to the game is the lines containing hours, and that 155 | text may be added before and/or after these lines. MORIATOP.DAT 156 | will contain the top twenty scores. MORIACHR.DAT contains an 157 | entry for each living, saved character, thus disallowing players 158 | to bring back dead characters. 159 | 160 | A fifth file is needed if you want to use the internal help 161 | command within MORIA. This is the MORIAHLP.HLB help library, 162 | which must be located in the same directory as the other data 163 | files. 164 | 165 | The suggested protection for these files is as follows: 166 | 167 | With SYSPRV Without SYSPRV 168 | MORIA.DAT (s:rw,o,g,w) (s:rw,o:r,g:r,w:r) 169 | HOURS.DAT (s:rw,o,g,w) (s:rw,o:r,g:r,w:r) 170 | MORIATOP.DAT (s:rw,o:r,g:r,w:r) (s:rw,o:rw,g:rw,w:rw) 171 | MORIACHR.DAT (s:rw,o,g,w) (s:rw,o:rw,g:rw,w:rw) 172 | MORIAHLP.HLB (s:r,o:r,g:r,w:r) (s:r,o:r,g:r,w:r) 173 | 174 | It is suggested that a special directory be set aside for MORIA 175 | game and data files, so that they may be easily protected and 176 | maintained. Note that the data files must be in the same 177 | directory as the executable. 178 | 179 | 180 | 3 181 | The Dungeons of Moria - COPYRIGHT (c) Robert Alan Koeneke The Dungeons of Moria - COPYRIGHT (c) Robert Alan Koeneke 182 | 183 | 184 | Characters may be saved in MORIA, and later restored. To 185 | save a character use -Z and supply a filename. The 186 | character will be encrypted so that no tampering will be allowed. 187 | To restore a character, set up a moria foreign command and supply 188 | the saved-character filename as an argument. 189 | 190 | Set up a MORIA foreign run command : $ moria :== $user1:[moria]moria 191 | Restore character : $ moria save_filename 192 | 193 | 194 | 195 | 196 | 197 | 198 | 199 | 200 | 201 | 202 | 203 | 204 | 205 | 206 | 207 | 208 | 209 | 210 | 211 | 212 | 213 | 214 | 215 | 216 | 217 | 218 | 219 | 220 | 221 | 222 | 223 | 224 | 225 | 226 | 227 | 228 | 229 | 230 | 231 | 232 | 233 | 234 | 235 | 236 | 237 | 238 | 239 | 240 | 4 241 | The Dungeons of Moria - COPYRIGHT (c) Robert Alan Koeneke The Dungeons of Moria - COPYRIGHT (c) Robert Alan Koeneke 242 | 243 | 244 | 5.0 NOTES _____ 245 | 246 | 5.1 The IO Bug... 247 | 248 | When Moria was run at high baud rates (9600 and above), the 249 | game would come to a screeching halt and the process would have 250 | to be killed. I suspected that I had screwed up on my use of 251 | QIO. But after tromping through the code and writing several 252 | test programs, I have come to the conclusion that a problem 253 | exists in the device driver. In order to "get around" this bug, 254 | I pause the process a small amount of time before issuing a QIO 255 | read command. This seems to allow the device driver to perform 256 | what ever duty needs doing, and no hang ups occur. If you should 257 | experience a problem with the game going into permanent LEF's, 258 | try increasing the pause time a bit. 259 | 260 | 261 | 262 | 5.2 Hibernating The Game... 263 | 264 | At certain places in the game, I have included code to 265 | hibernate for brief periods. Many of these were taken out with 266 | the addition of the pause before each INKEY, but some still 267 | exist. These are included to keep Moria "system friendly". My 268 | philosophy has been that a well written game should not eat the 269 | CPU up alive. If you wish to differ, these pauses can be removed 270 | to speed up the game, but you should not remove the pauses before 271 | INKEY unless you are running the game at baud rates less than 272 | 9600. 273 | 274 | 275 | -------------------------------------------------------------------------------- /source/include/wizard.inc: -------------------------------------------------------------------------------- 1 | { Print Moria credits -RAK- } 2 | [psect(misc1$code)] procedure game_version; 3 | var 4 | tmp_str : vtype; 5 | begin 6 | clear(1,1); 7 | writev(tmp_str,' Moria Version ',cur_version:3:2); 8 | put_buffer(tmp_str,1,1); 9 | put_buffer('Version 0.1 : 03/25/83',2,1); 10 | put_buffer('Version 1.0 : 05/01/84',3,1); 11 | put_buffer('Version 2.0 : 07/10/84',4,1); 12 | put_buffer('Version 3.0 : 11/20/84',5,1); 13 | put_buffer('Version 4.0 : 01/20/85',6,1); 14 | put_buffer('Modules :',8,1); 15 | put_buffer(' V1.0 Dungeon Generator - RAK',9,1); 16 | put_buffer(' Character Generator - RAK & JWT',10,1); 17 | put_buffer(' Moria Module - RAK',11,1); 18 | put_buffer(' Miscellaneous - RAK & JWT',12,1); 19 | put_buffer(' V2.0 Town Level & Misc - RAK',13,1); 20 | put_buffer(' V3.0 Internal Help & Misc - RAK',14,1); 21 | put_buffer(' V4.0 Source Release Version - RAK',15,1); 22 | put_buffer('Robert Alan Koeneke Jimmey Wayne Todd Jr.',17,1); 23 | put_buffer('Student/University of Oklahoma Student/University of Oklahoma',18,1); 24 | put_buffer('119 Crystal Bend 1912 Tiffany Dr.',19,1); 25 | put_buffer('Norman, OK 73069 Norman, OK 73071',20,1); 26 | put_buffer('(405)-321-2925 (405) 360-6792',21,1); 27 | pause(24); 28 | draw_cave; 29 | end; 30 | 31 | 32 | { Light up the dungeon -RAK- } 33 | [psect(wizard$code)] procedure wizard_light; 34 | var 35 | i1,i2,i3,i4 : integer; 36 | flag : boolean; 37 | begin 38 | if (cave[char_row,char_col].pl) then 39 | flag := false 40 | else 41 | flag := true; 42 | for i1 := 1 to cur_height do 43 | for i2 := 1 to cur_width do 44 | if (cave[i1,i2].fval in floor_set) then 45 | for i3 := i1-1 to i1+1 do 46 | for i4 := i2-1 to i2+1 do 47 | with cave[i3,i4] do 48 | begin 49 | pl := flag; 50 | if (not(flag)) then 51 | fm := false; 52 | end; 53 | prt_map; 54 | end; 55 | 56 | 57 | 58 | { Wizard routine for gaining on stats -RAK- } 59 | [psect(wizard$code)] procedure change_character; 60 | var 61 | tmp_val : integer; 62 | tmp_str : vtype; 63 | begin 64 | with py.stat do 65 | begin 66 | prt('(3 - 118) Strength = ',1,1); 67 | get_string(tmp_str,1,26,10); 68 | tmp_val := -999; 69 | readv(tmp_str,tmp_val,error:=continue); 70 | if ((tmp_val > 2) and (tmp_val < 119)) then 71 | begin 72 | str := tmp_val; 73 | cstr := tmp_val; 74 | prt_strength; 75 | end; 76 | prt('(3 - 118) Intelligence = ',1,1); 77 | get_string(tmp_str,1,26,10); 78 | tmp_val := -999; 79 | readv(tmp_str,tmp_val,error:=continue); 80 | if ((tmp_val > 2) and (tmp_val < 119)) then 81 | begin 82 | int := tmp_val; 83 | cint := tmp_val; 84 | prt_intelligence; 85 | end; 86 | prt('(3 - 118) Wisdom = ',1,1); 87 | get_string(tmp_str,1,26,10); 88 | tmp_val := -999; 89 | readv(tmp_str,tmp_val,error:=continue); 90 | if ((tmp_val > 2) and (tmp_val < 119)) then 91 | begin 92 | wis := tmp_val; 93 | cwis := tmp_val; 94 | prt_wisdom; 95 | end; 96 | prt('(3 - 118) Dexterity = ',1,1); 97 | get_string(tmp_str,1,26,10); 98 | tmp_val := -999; 99 | readv(tmp_str,tmp_val,error:=continue); 100 | if ((tmp_val > 2) and (tmp_val < 119)) then 101 | begin 102 | dex := tmp_val; 103 | cdex := tmp_val; 104 | prt_dexterity; 105 | end; 106 | prt('(3 - 118) Constitution = ',1,1); 107 | get_string(tmp_str,1,26,10); 108 | tmp_val := -999; 109 | readv(tmp_str,tmp_val,error:=continue); 110 | if ((tmp_val > 2) and (tmp_val < 119)) then 111 | begin 112 | con := tmp_val; 113 | ccon := tmp_val; 114 | prt_constitution; 115 | end; 116 | prt('(3 - 118) Charisma = ',1,1); 117 | get_string(tmp_str,1,26,10); 118 | tmp_val := -999; 119 | readv(tmp_str,tmp_val,error:=continue); 120 | if ((tmp_val > 2) and (tmp_val < 119)) then 121 | begin 122 | chr := tmp_val; 123 | cchr := tmp_val; 124 | prt_charisma; 125 | end; 126 | end; 127 | with py.misc do 128 | begin 129 | prt('(1 - 32767) Hit points = ',1,1); 130 | get_string(tmp_str,1,26,10); 131 | tmp_val := -1; 132 | readv(tmp_str,tmp_val,error:=continue); 133 | if ((tmp_val > 0) and (tmp_val < 32768)) then 134 | begin 135 | mhp := tmp_val; 136 | chp := tmp_val; 137 | prt_mhp; 138 | prt_chp; 139 | end; 140 | prt('(0 - 32767) Mana = ',1,1); 141 | get_string(tmp_str,1,26,10); 142 | tmp_val := -999; 143 | readv(tmp_str,tmp_val,error:=continue); 144 | if ((tmp_val > -1) and (tmp_val < 32768)) then 145 | begin 146 | mana := tmp_val; 147 | cmana := tmp_val; 148 | prt_cmana; 149 | end; 150 | writev(tmp_str,'Current=',srh:1,' (0-200) Searching = '); 151 | tmp_val := length(tmp_str); 152 | prt(tmp_str,1,1); 153 | get_string(tmp_str,1,tmp_val+1,10); 154 | tmp_val := -999; 155 | readv(tmp_str,tmp_val,error:=continue); 156 | if ((tmp_val > -1) and (tmp_val < 201)) then 157 | srh := tmp_val; 158 | writev(tmp_str,'Current=',stl:1,' (0-10) Stealth = '); 159 | tmp_val := length(tmp_str); 160 | prt(tmp_str,1,1); 161 | get_string(tmp_str,1,tmp_val+1,10); 162 | tmp_val := -999; 163 | readv(tmp_str,tmp_val,error:=continue); 164 | if ((tmp_val > -1) and (tmp_val < 11)) then 165 | stl := tmp_val; 166 | writev(tmp_str,'Current=',disarm:1,' (0-200) Disarming = '); 167 | tmp_val := length(tmp_str); 168 | prt(tmp_str,1,1); 169 | get_string(tmp_str,1,tmp_val+1,10); 170 | tmp_val := -999; 171 | readv(tmp_str,tmp_val,error:=continue); 172 | if ((tmp_val > -1) and (tmp_val < 201)) then 173 | disarm := tmp_val; 174 | writev(tmp_str,'Current=',save:1,' (0-100) Save = '); 175 | tmp_val := length(tmp_str); 176 | prt(tmp_str,1,1); 177 | get_string(tmp_str,1,tmp_val+1,10); 178 | tmp_val := -999; 179 | readv(tmp_str,tmp_val,error:=continue); 180 | if ((tmp_val > -1) and (tmp_val < 201)) then 181 | save := tmp_val; 182 | writev(tmp_str,'Current=',bth:1,' (0-200) Base to hit = '); 183 | tmp_val := length(tmp_str); 184 | prt(tmp_str,1,1); 185 | get_string(tmp_str,1,tmp_val+1,10); 186 | tmp_val := -999; 187 | readv(tmp_str,tmp_val,error:=continue); 188 | if ((tmp_val > -1) and (tmp_val < 201)) then 189 | bth := tmp_val; 190 | writev(tmp_str,'Current=',bthb:1,' (0-200) Bows/Throwing = '); 191 | tmp_val := length(tmp_str); 192 | prt(tmp_str,1,1); 193 | get_string(tmp_str,1,tmp_val+1,10); 194 | tmp_val := -999; 195 | readv(tmp_str,tmp_val,error:=continue); 196 | if ((tmp_val > -1) and (tmp_val < 201)) then 197 | bthb := tmp_val; 198 | writev(tmp_str,'Current=',au:1,' Gold = '); 199 | tmp_val := length(tmp_str); 200 | prt(tmp_str,1,1); 201 | get_string(tmp_str,1,tmp_val+1,10); 202 | tmp_val := -999; 203 | readv(tmp_str,tmp_val,error:=continue); 204 | if (tmp_val > -1) then 205 | begin 206 | au := tmp_val; 207 | prt_gold; 208 | end; 209 | end; 210 | erase_line(msg_line,msg_line); 211 | py_bonuses(blank_treasure,0); 212 | end; 213 | 214 | { Wizard routine for creating objects -RAK- } 215 | [psect(wizard$code)] procedure wizard_create; 216 | var 217 | tmp_val : integer; 218 | tmp_str : vtype; 219 | flag : boolean; 220 | begin 221 | msg_print('Warning: This routine can cause fatal error.'); 222 | msg_print(' '); 223 | msg_flag := false; 224 | with inventory[inven_max] do 225 | begin 226 | prt('Name : ',1,1); 227 | if (get_string(tmp_str,1,10,40)) then 228 | name := tmp_str 229 | else 230 | name := '& Wizard Object!'; 231 | repeat 232 | prt('Tval : ',1,1); 233 | get_string(tmp_str,1,10,10); 234 | tmp_val := 0; 235 | readv(tmp_str,tmp_val,error:=continue); 236 | flag := true; 237 | case tmp_val of 238 | 1,13,15 : tchar := '~'; 239 | 2 : tchar := '&'; 240 | 10 : tchar := '{'; 241 | 11 : tchar := '{'; 242 | 12 : tchar := '{'; 243 | 20 : tchar := '}'; 244 | 21 : tchar := '/'; 245 | 22 : tchar := '\'; 246 | 23 : tchar := '|'; 247 | 25 : tchar := '\'; 248 | 30 : tchar := ']'; 249 | 31 : tchar := ']'; 250 | 32 : tchar := '('; 251 | 33 : tchar := ']'; 252 | 34 : tchar := ')'; 253 | 35 : tchar := '['; 254 | 36 : tchar := '('; 255 | 40 : tchar := '"'; 256 | 45 : tchar := '='; 257 | 55 : tchar := '_'; 258 | 60 : tchar := '-'; 259 | 65 : tchar := '-'; 260 | 70,71 : tchar := '?'; 261 | 75,76,77: tchar := '!'; 262 | 80 : tchar := ','; 263 | 90 : tchar := '?'; 264 | 91 : tchar := '?'; 265 | otherwise flag := false; 266 | end; 267 | until (flag); 268 | tval := tmp_val; 269 | prt('Subval : ',1,1); 270 | get_string(tmp_str,1,10,10); 271 | tmp_val := 1; 272 | readv(tmp_str,tmp_val,error:=continue); 273 | subval := tmp_val; 274 | prt('Weight : ',1,1); 275 | get_string(tmp_str,1,10,10); 276 | tmp_val := 1; 277 | readv(tmp_str,tmp_val,error:=continue); 278 | weight := tmp_val; 279 | prt('Number : ',1,1); 280 | get_string(tmp_str,1,10,10); 281 | tmp_val := 1; 282 | readv(tmp_str,tmp_val,error:=continue); 283 | number := tmp_val; 284 | prt('Damage : ',1,1); 285 | get_string(tmp_str,1,10,5); 286 | damage := tmp_str; 287 | prt('+To hit: ',1,1); 288 | get_string(tmp_str,1,10,10); 289 | tmp_val := 0; 290 | readv(tmp_str,tmp_val,error:=continue); 291 | tohit := tmp_val; 292 | prt('+To dam: ',1,1); 293 | get_string(tmp_str,1,10,10); 294 | tmp_val := 0; 295 | readv(tmp_str,tmp_val,error:=continue); 296 | todam := tmp_val; 297 | prt('AC : ',1,1); 298 | get_string(tmp_str,1,10,10); 299 | tmp_val := 0; 300 | readv(tmp_str,tmp_val,error:=continue); 301 | ac := tmp_val; 302 | prt('+To AC : ',1,1); 303 | get_string(tmp_str,1,10,10); 304 | tmp_val := 0; 305 | readv(tmp_str,tmp_val,error:=continue); 306 | toac := tmp_val; 307 | prt('P1 : ',1,1); 308 | get_string(tmp_str,1,10,10); 309 | tmp_val := 0; 310 | readv(tmp_str,tmp_val,error:=continue); 311 | p1 := tmp_val; 312 | prt('Flags (In HEX): ',1,1); 313 | flags := get_hex_value(1,17,8); 314 | prt('Cost : ',1,1); 315 | get_string(tmp_str,1,10,10); 316 | tmp_val := 0; 317 | readv(tmp_str,tmp_val,error:=continue); 318 | cost := tmp_val; 319 | if (get_com('Allocate? (Y/N)',command)) then 320 | case command of 321 | 'y','Y': begin 322 | popt(tmp_val); 323 | t_list[tmp_val] := inventory[inven_max]; 324 | with cave[char_row,char_col] do 325 | begin 326 | if (tptr > 0) then 327 | delete_object(char_row,char_col); 328 | tptr := tmp_val; 329 | end; 330 | msg_print('Allocated...'); 331 | end; 332 | otherwise msg_print('Aborted...'); 333 | end; 334 | inventory[inven_max] := blank_treasure; 335 | end; 336 | end; 337 | -------------------------------------------------------------------------------- /source/include/scrolls.inc: -------------------------------------------------------------------------------- 1 | { Scrolls for the reading -RAK- } 2 | [psect(misc2$code)] procedure read; 3 | var 4 | i1 : unsigned; 5 | i2,i3,i4,item_val : integer; 6 | thit,tdam,y,x : integer; 7 | tmp : array [1..5] of integer; 8 | out_val : vtype; 9 | redraw,ident,first,flag : boolean; 10 | begin 11 | first := true; 12 | reset_flag := true; 13 | if (inven_ctr > 0) then 14 | begin 15 | if (find_range([70,71],i2,i3)) then 16 | if (py.flags.blind > 0) then 17 | msg_print('You can''t see to read the scroll.') 18 | else if (no_light) then 19 | msg_print('You have no light to read by.') 20 | else if (py.flags.confused > 0) then 21 | begin 22 | msg_print('The text seems to swim about the page!'); 23 | msg_print('You are too confused to read...'); 24 | end 25 | else 26 | begin 27 | redraw := false; 28 | if (get_item(item_val,'Read which scroll?',redraw, 29 | i2,i3)) then 30 | with inventory[item_val] do 31 | begin 32 | if (redraw) then draw_cave; 33 | reset_flag := false; 34 | i1 := flags; 35 | ident := false; 36 | while (i1 > 0) do 37 | begin 38 | i2 := bit_pos(i1); 39 | if (tval = 71) then i2 := i2 + 31; 40 | if (first) then 41 | if (not(i2 in [4,25])) then 42 | begin 43 | msg_print('As you read the scroll it vanishes.'); 44 | first := false; 45 | end; 46 | 47 | { Scrolls... } 48 | case (i2) of 49 | 1 : with inventory[23] do 50 | begin 51 | if (tval > 0) then 52 | begin 53 | objdes(out_val,23,false); 54 | msg_print('Your ' + out_val + ' glows faintly!'); 55 | if (enchant(tohit)) then 56 | begin 57 | flags := uand(%X'7FFFFFFF',flags); 58 | py_bonuses(blank_treasure,0); 59 | end 60 | else 61 | msg_print('The enchantment fails...'); 62 | end; 63 | ident := true; 64 | end; 65 | 2 : with inventory[23] do 66 | begin 67 | if (tval > 0) then 68 | begin 69 | objdes(out_val,23,false); 70 | msg_print('Your ' + out_val + ' glows faintly!'); 71 | if (enchant(todam)) then 72 | begin 73 | flags := uand(%X'7FFFFFFF',flags); 74 | py_bonuses(blank_treasure,0); 75 | end 76 | else 77 | msg_print('The enchantment fails...'); 78 | end; 79 | ident := true; 80 | end; 81 | 3 : begin 82 | i3 := 0; 83 | i4 := 0; 84 | if (inventory[26].tval > 0) then 85 | begin 86 | i3 := i3 + 1; 87 | tmp[i3] := 26; 88 | end; 89 | if (inventory[27].tval > 0) then 90 | begin 91 | i3 := i3 + 1; 92 | tmp[i3] := 27; 93 | end; 94 | if (inventory[32].tval > 0) then 95 | begin 96 | i3 := i3 + 1; 97 | tmp[i3] := 32; 98 | end; 99 | if (inventory[28].tval > 0) then 100 | begin 101 | i3 := i3 + 1; 102 | tmp[i3] := 28; 103 | end; 104 | if (inventory[24].tval > 0) then 105 | begin 106 | i3 := i3 + 1; 107 | tmp[i3] := 24; 108 | end; 109 | if (i3 > 0) then i4 := tmp[randint(i3)]; 110 | if (uand(%X'80000000',inventory[26].flags) <> 0) then 111 | i4 := 26 112 | else if (uand(%X'80000000',inventory[27].flags) <> 0) then 113 | i4 := 27 114 | else if (uand(%X'80000000',inventory[32].flags) <> 0) then 115 | i4 := 32 116 | else if (uand(%X'80000000',inventory[24].flags) <> 0) then 117 | i4 := 24 118 | else if (uand(%X'80000000',inventory[28].flags) <> 0) then 119 | i4 := 28; 120 | if (i4 > 0) then 121 | with inventory[i4] do 122 | begin 123 | objdes(out_val,i4,false); 124 | msg_print('Your ' + out_val + ' glows faintly!'); 125 | if (enchant(toac)) then 126 | begin 127 | flags := uand(%X'7FFFFFFF',flags); 128 | py_bonuses(blank_treasure,0); 129 | end 130 | else 131 | msg_print('The enchantment fails...'); 132 | end; 133 | ident := true; 134 | end; 135 | 4 : begin 136 | identify(inventory[item_val]); 137 | msg_print('This is an identify scroll'); 138 | msg_print(' '); 139 | if (ident_spell) then first := false; 140 | end; 141 | 5 : if (remove_curse) then 142 | begin 143 | msg_print('You feel as if someone is watching over you.'); 144 | ident := true;; 145 | end; 146 | 6 : ident := light_area(char_row,char_col); 147 | 7 : begin 148 | for i3 := 1 to randint(3) do 149 | begin 150 | y := char_row; 151 | x := char_col; 152 | summon_monster(y,x,false); 153 | end; 154 | ident := true; 155 | end; 156 | 8 : begin 157 | teleport(10); 158 | ident := true; 159 | end; 160 | 9 : begin 161 | teleport(100); 162 | ident := true; 163 | end; 164 | 10 : begin 165 | dun_level := dun_level - 3 + 2*randint(2); 166 | if (dun_level < 1) then 167 | dun_level := 1; 168 | moria_flag := true; 169 | ident := true; 170 | end; 171 | 11 : begin 172 | msg_print('Your hands begin to glow.'); 173 | py.flags.confuse_monster := true; 174 | ident := true; 175 | end; 176 | 12 : ident := map_area; 177 | 13 : ident := sleep_monsters1(char_row,char_col); 178 | 14 : ident := warding_glyph; 179 | 15 : ident := detect_treasure; 180 | 16 : ident := detect_object; 181 | 17 : ident := detect_trap; 182 | 18 : ident := detect_sdoor; 183 | 19 : begin 184 | msg_print('This is a mass genocide scroll.'); 185 | msg_print(' '); 186 | ident := mass_genocide; 187 | end; 188 | 20 : ident := detect_invisible; 189 | 21 : begin 190 | ident := aggravate_monster(20); 191 | msg_print('There is a high pitched humming noise'); 192 | end; 193 | 22 : ident := trap_creation; 194 | 23 : ident := td_destroy; 195 | 24 : ident := door_creation; 196 | 25 : begin 197 | identify(inventory[item_val]); 198 | msg_print('This is a Recharge-Item scroll.'); 199 | msg_print(' '); 200 | if (recharge(60)) then first := false; 201 | end; 202 | 26 : begin 203 | msg_print('This is a genocide scroll.'); 204 | msg_print(' '); 205 | ident := genocide; 206 | end; 207 | 27 : ident := unlight_area(char_row,char_col); 208 | 28 : ident := protect_evil; 209 | 29 : ident := create_food; 210 | 30 : ident := dispell_creature(%X'0008',60); 211 | 31 : begin 212 | msg_print('That scroll appeared to be blank.'); 213 | ident := true; 214 | end; 215 | 32 : with inventory[23] do 216 | begin 217 | if (tval > 0) then 218 | begin 219 | objdes(out_val,23,false); 220 | msg_print('Your ' + out_val + ' glows brightly!'); 221 | flag := false; 222 | for i3 := 1 to randint(2) do 223 | if (enchant(tohit)) then 224 | flag := true; 225 | for i3 := 1 to randint(2) do 226 | if (enchant(todam)) then 227 | flag := true; 228 | if (flag) then 229 | begin 230 | flags := uand(%X'7FFFFFFF',flags); 231 | py_bonuses(blank_treasure,0); 232 | end 233 | else 234 | msg_print('The enchantment fails...'); 235 | end; 236 | ident := true; 237 | end; 238 | 33 : with inventory[23] do 239 | begin 240 | if (tval > 0) then 241 | begin 242 | inventory[inven_max] := inventory[23]; 243 | objdes(out_val,23,false); 244 | msg_print('Your ' + out_val + 245 | ' glows black, then fades.'); 246 | tohit := -randint(5) - randint(5); 247 | todam := -randint(5) - randint(5); 248 | flags := %X'80000000'; 249 | py_bonuses(inventory[inven_max],-1); 250 | ident := true; 251 | end; 252 | end; 253 | 34 : begin 254 | if (uand(%X'80000000',inventory[26].flags) <> 0) then 255 | i3 := 26 256 | else if (uand(%X'80000000',inventory[27].flags) <> 0) then 257 | i3 := 27 258 | else if (uand(%X'80000000',inventory[32].flags) <> 0) then 259 | i3 := 32 260 | else if (uand(%X'80000000',inventory[24].flags) <> 0) then 261 | i3 := 24 262 | else if (uand(%X'80000000',inventory[28].flags) <> 0) then 263 | i3 := 28 264 | else if (inventory[26].tval > 0) then 265 | i3 := 26 266 | else if (inventory[27].tval > 0) then 267 | i3 := 27 268 | else if (inventory[24].tval > 0) then 269 | i3 := 24 270 | else if (inventory[28].tval > 0) then 271 | i3 := 28 272 | else 273 | i3 := 0; 274 | if (i3 > 0) then 275 | with inventory[i3] do 276 | begin 277 | objdes(out_val,i3,false); 278 | msg_print('Your ' + out_val + ' glows brightly!'); 279 | flag := false; 280 | for i3 := 1 to randint(2) + 1 do 281 | if (enchant(toac)) then 282 | flag := true; 283 | if (flag) then 284 | begin 285 | flags := uand(%X'7FFFFFFF',flags); 286 | py_bonuses(blank_treasure,0); 287 | end 288 | else 289 | msg_print('The enchantment fails...'); 290 | end; 291 | ident := true; 292 | end; 293 | 35 : begin 294 | if ((inventory[26].tval > 0) and (randint(4) = 1)) then 295 | i3 := 26 296 | else if ((inventory[27].tval > 0) and (randint(3) = 1)) then 297 | i3 := 27 298 | else if ((inventory[32].tval > 0) and (randint(3) = 1)) then 299 | i3 := 32 300 | else if ((inventory[24].tval > 0) and (randint(3) = 1)) then 301 | i3 := 24 302 | else if ((inventory[28].tval > 0) and (randint(3) = 1)) then 303 | i3 := 28 304 | else if (inventory[26].tval > 0) then 305 | i3 := 26 306 | else if (inventory[27].tval > 0) then 307 | i3 := 27 308 | else if (inventory[32].tval > 0) then 309 | i3 := 32 310 | else if (inventory[24].tval > 0) then 311 | i3 := 24 312 | else if (inventory[28].tval > 0) then 313 | i3 := 28 314 | else 315 | i3 := 0; 316 | if (i3 > 0) then 317 | with inventory[i3] do 318 | begin 319 | inventory[inven_max] := inventory[i3]; 320 | objdes(out_val,i3,false); 321 | msg_print('Your ' + out_val + 322 | ' glows black, then fades.'); 323 | flags := %X'80000000'; 324 | toac := -randint(5) - randint(5); 325 | py_bonuses(inventory[inven_max],-1); 326 | ident := true; 327 | end; 328 | end; 329 | 36 : begin 330 | for i3 := 1 to randint(3) do 331 | begin 332 | y := char_row; 333 | x := char_col; 334 | summon_undead(y,x); 335 | end; 336 | ident := true; 337 | end; 338 | 37 : ident := bless(randint(12)+6); 339 | 38 : ident := bless(randint(24)+12); 340 | 39 : ident := bless(randint(48)+24); 341 | 40 : begin 342 | ident := true; 343 | py.flags.word_recall := 25 + randint(30); 344 | msg_print('The air about you becomes charged...'); 345 | end; 346 | 41 : ident := destroy_area(char_row,char_col); 347 | 42 : ; 348 | 43 : ; 349 | 44 : ; 350 | 45 : ; 351 | 46 : ; 352 | 47 : ; 353 | 48 : ; 354 | 49 : ; 355 | 50 : ; 356 | 51 : ; 357 | 52 : ; 358 | 53 : ; 359 | 54 : ; 360 | 55 : ; 361 | 56 : ; 362 | 57 : ; 363 | 58 : ; 364 | 59 : ; 365 | 60 : ; 366 | 61 : ; 367 | 62 : ; 368 | otherwise ; 369 | end; 370 | { End of Scrolls... } 371 | end; 372 | if (not(reset_flag)) then 373 | begin 374 | if (ident) then 375 | identify(inventory[item_val]); 376 | if (not(first)) then 377 | begin 378 | desc_remain(item_val); 379 | inven_destroy(item_val); 380 | if (flags <> 0) then 381 | with py.misc do 382 | begin 383 | exp := exp + round(level/lev); 384 | prt_experience; 385 | end; 386 | end; 387 | end; 388 | end 389 | else 390 | if (redraw) then draw_cave; 391 | end 392 | else 393 | msg_print('You are not carrying any scrolls.'); 394 | end 395 | else 396 | msg_print('But you are not carrying anything.'); 397 | end; 398 | -------------------------------------------------------------------------------- /source/include/create.inc: -------------------------------------------------------------------------------- 1 | [psect(create$code)] procedure create_character; 2 | 3 | 4 | { Generates character's stats -JWT- } 5 | function get_stat : integer; 6 | var 7 | i,j : integer; 8 | begin 9 | i := randint(4) + randint(4) + randint(4) + 5; 10 | get_stat := i 11 | end; 12 | 13 | 14 | { Changes stats by given amount -JWT- } 15 | function change_stat(cur_stat,amount : integer) : integer; 16 | var 17 | i : integer; 18 | begin 19 | if (amount < 0) then 20 | for i := -1 downto amount do 21 | cur_stat := de_statp(cur_stat) 22 | else 23 | for i := 1 to amount do 24 | cur_stat := in_statp(cur_stat); 25 | change_stat := cur_stat; 26 | end; 27 | 28 | 29 | { Allows player to select a race -JWT- } 30 | function choose_race : boolean; 31 | var 32 | i2,i3,i4,i5 : integer; 33 | s : char; 34 | exit_flag : boolean; 35 | begin 36 | i2 := 1; 37 | i3 := 1; 38 | i4 := 3; 39 | i5 := 22; 40 | clear(21,1); 41 | prt('Choose a race (? for Help):',21,3); 42 | repeat 43 | put_buffer (chr(i3+96)+') '+race[i2].trace,i5,i4); 44 | i3 := i3 + 1; 45 | i4 := i4 + 15; 46 | if (i4 > 70) then 47 | begin 48 | i4 := 3; 49 | i5 := i5 + 1 50 | end; 51 | i2 := i2 + 1 52 | until (i2 > max_races); 53 | py.misc.race := ''; 54 | put_buffer('',21,30); 55 | exit_flag := false; 56 | repeat 57 | inkey_flush(s); 58 | i2 := index('abcdefghijklmnopqrstuvwxyz',s); 59 | if ((i2 <= max_races) and (i2 >= 1)) then 60 | with py do 61 | with race[i2] do 62 | begin 63 | misc.prace := i2; 64 | misc.race := trace; 65 | stat.str := get_stat; 66 | stat.int := get_stat; 67 | stat.wis := get_stat; 68 | stat.dex := get_stat; 69 | stat.con := get_stat; 70 | stat.chr := get_stat; 71 | stat.str := change_stat(stat.str,str_adj); 72 | stat.int := change_stat(stat.int,int_adj); 73 | stat.wis := change_stat(stat.wis,wis_adj); 74 | stat.dex := change_stat(stat.dex,dex_adj); 75 | stat.con := change_stat(stat.con,con_adj); 76 | stat.chr := change_stat(stat.chr,chr_adj); 77 | stat.cstr := stat.str; 78 | stat.cint := stat.int; 79 | stat.cwis := stat.wis; 80 | stat.cdex := stat.dex; 81 | stat.ccon := stat.con; 82 | stat.cchr := stat.chr; 83 | misc.srh := srh; 84 | misc.bth := bth; 85 | misc.bthb := bthb; 86 | misc.fos := fos; 87 | misc.stl := stl; 88 | misc.save := bsav; 89 | misc.hitdie := bhitdie; 90 | misc.lev := 1; 91 | misc.ptodam := todam_adj; 92 | misc.ptohit := tohit_adj; 93 | misc.ptoac := 0; 94 | misc.pac := toac_adj; 95 | misc.expfact:= b_exp; 96 | flags.see_infra := infra; 97 | exit_flag := true; 98 | choose_race := true; 99 | put_buffer(py.misc.race,4,15); 100 | end 101 | else if (s = '?') then 102 | begin 103 | moria_help('Character Races'); 104 | exit_flag := true; 105 | choose_race := false; 106 | end; 107 | until (exit_flag); 108 | end; 109 | 110 | 111 | { Will print the history of a character -JWT- } 112 | procedure print_history; 113 | var 114 | i1 : integer; 115 | begin 116 | put_buffer('Character Background',14,28); 117 | for i1 := 1 to 5 do 118 | put_buffer(py.misc.history[i1],i1+14,5) 119 | end; 120 | 121 | 122 | { Get the racial history, determines social class -RAK- } 123 | { Assumtions: Each race has init history beginning at } 124 | { (race-1)*3+1 } 125 | { All history parts are in accending order } 126 | procedure get_history; 127 | var 128 | hist_ptr,cur_ptr,test_roll : integer; 129 | start_pos,end_pos,cur_len : integer; 130 | line_ctr,new_start,social_class : integer; 131 | history_block : varying [400] of char; 132 | flag : boolean; 133 | begin 134 | { Get a block of history text } 135 | hist_ptr := (py.misc.prace-1)*3 + 1; 136 | history_block := ''; 137 | social_class := randint(4); 138 | cur_ptr := 0; 139 | repeat 140 | flag := false; 141 | repeat 142 | cur_ptr := cur_ptr + 1; 143 | if (background[cur_ptr].chart = hist_ptr) then 144 | begin 145 | test_roll := randint(100); 146 | while (test_roll > background[cur_ptr].roll) do 147 | cur_ptr := cur_ptr + 1; 148 | with background[cur_ptr] do 149 | begin 150 | history_block := history_block + info; 151 | social_class := social_class + bonus; 152 | if (hist_ptr > next) then cur_ptr := 0; 153 | hist_ptr := next; 154 | end; 155 | flag := true; 156 | end; 157 | until(flag); 158 | until(hist_ptr < 1); 159 | { Process block of history text for pretty output } 160 | start_pos := 1; 161 | end_pos := length(history_block); 162 | line_ctr := 1; 163 | flag := false; 164 | while (history_block[end_pos] = ' ') do 165 | end_pos := end_pos - 1; 166 | repeat 167 | while (history_block[start_pos] = ' ') do 168 | start_pos := start_pos + 1; 169 | cur_len := end_pos - start_pos + 1; 170 | if (cur_len > 70) then 171 | begin 172 | cur_len := 70; 173 | while (history_block[start_pos+cur_len-1] <> ' ') do 174 | cur_len := cur_len - 1; 175 | new_start := start_pos + cur_len; 176 | while (history_block[start_pos+cur_len-1] = ' ') do 177 | cur_len := cur_len - 1; 178 | end 179 | else 180 | flag := true; 181 | py.misc.history[line_ctr] := substr(history_block,start_pos,cur_len); 182 | line_ctr := line_ctr + 1; 183 | start_pos := new_start; 184 | until(flag); 185 | { Compute social class for player } 186 | if (social_class > 100) then 187 | social_class := 100 188 | else if(social_class < 1) then 189 | social_class := 1; 190 | py.misc.sc := social_class; 191 | end; 192 | 193 | 194 | { Gets the character's sex -JWT- } 195 | function get_sex : boolean; 196 | var 197 | s : char; 198 | exit_flag : boolean; 199 | begin 200 | py.misc.sex := ''; 201 | clear(21,1); 202 | prt('Choose a sex (? for Help):',21,3); 203 | prt('m) Male f) Female',22,3); 204 | prt('',21,29); 205 | repeat 206 | inkey_flush(s); 207 | case s of 208 | 'f' : begin 209 | py.misc.sex := 'Female'; 210 | prt(py.misc.sex,5,15); 211 | exit_flag := true; 212 | get_sex := true; 213 | end; 214 | 'm' : begin 215 | py.misc.sex := 'Male'; 216 | prt(py.misc.sex,5,15); 217 | exit_flag := true; 218 | get_sex := true; 219 | end; 220 | '?' : begin 221 | moria_help('Character Sex'); 222 | exit_flag := true; 223 | get_sex := false; 224 | end; 225 | otherwise ; 226 | end; 227 | until (exit_flag); 228 | end; 229 | 230 | 231 | { Computes character's age, height, and weight -JWT- } 232 | procedure get_ahw; 233 | var 234 | i1 : integer; 235 | begin 236 | i1 := py.misc.prace; 237 | py.misc.age := race[i1].b_age + randint(race[i1].m_age); 238 | case trunc((index(sex_type,py.misc.sex)+5)/6) of 239 | 1 : begin 240 | py.misc.ht := randnor(race[i1].f_b_ht,race[i1].f_m_ht); 241 | py.misc.wt := randnor(race[i1].f_b_wt,race[i1].f_m_wt) 242 | end; 243 | 2 : begin 244 | py.misc.ht := randnor(race[i1].m_b_ht,race[i1].m_m_ht); 245 | py.misc.wt := randnor(race[i1].m_b_wt,race[i1].m_m_wt) 246 | end 247 | end; 248 | py.misc.disarm := race[i1].b_dis + todis_adj; 249 | end; 250 | 251 | 252 | { Gets a character class -JWT- } 253 | function get_class : boolean; 254 | var 255 | i1,i2,i3,i4,i5 : integer; 256 | cl : array [0..max_class] of integer; 257 | s : char; 258 | exit_flag : boolean; 259 | begin 260 | for i2 := 1 to max_class do cl[i2] := 0; 261 | i1 := py.misc.prace; 262 | i2 := 1; 263 | i3 := 0; 264 | i4 := 3; 265 | i5 := 22; 266 | clear(21,1); 267 | prt('Choose a class (? for Help):',21,3); 268 | repeat 269 | if (uand(race[i1].tclass,bit_array[i2]) <> 0) then 270 | begin 271 | i3 := i3 + 1; 272 | put_buffer (chr(i3+96)+') '+class[i2].title,i5,i4); 273 | cl[i3] := i2; 274 | i4 := i4 + 15; 275 | if (i4 > 70) then 276 | begin 277 | i4 := 3; 278 | i5 := i5 + 1 279 | end; 280 | end; 281 | i2 := i2 + 1; 282 | until (i2 > max_class); 283 | py.misc.pclass := 0; 284 | put_buffer('',21,31); 285 | exit_flag := false; 286 | repeat 287 | inkey_flush(s); 288 | i2 := index('abcdefghijklmnopqrstuvwxyz',s); 289 | if ((i2 <= i3) and (i2 >= 1)) then 290 | begin 291 | py.misc.tclass := class[cl[i2]].title; 292 | py.misc.pclass := cl[i2]; 293 | exit_flag := true; 294 | get_class := true; 295 | clear(21,1); 296 | put_buffer(py.misc.tclass,6,15); 297 | with py.misc do 298 | begin 299 | hitdie := hitdie + class[pclass].adj_hd; 300 | mhp := con_adj + hitdie; 301 | chp := mhp; 302 | bth := bth + class[pclass].mbth; 303 | bthb := bthb + class[pclass].mbthb; {RAK} 304 | srh := srh + class[pclass].msrh; 305 | disarm := disarm + class[pclass].mdis; 306 | fos := fos + class[pclass].mfos; 307 | stl := stl + class[pclass].mstl; 308 | save := save + class[pclass].msav; 309 | title := player_title[pclass,1]; 310 | expfact:= expfact + class[pclass].m_exp; 311 | end; 312 | { Adjust the stats for the class adjustment -RAK- } 313 | with py do 314 | begin 315 | stat.str := change_stat(stat.str,class[misc.pclass].madj_str); 316 | stat.int := change_stat(stat.int,class[misc.pclass].madj_int); 317 | stat.wis := change_stat(stat.wis,class[misc.pclass].madj_wis); 318 | stat.dex := change_stat(stat.dex,class[misc.pclass].madj_dex); 319 | stat.con := change_stat(stat.con,class[misc.pclass].madj_con); 320 | stat.chr := change_stat(stat.chr,class[misc.pclass].madj_chr); 321 | stat.cstr := stat.str; 322 | stat.cint := stat.int; 323 | stat.cwis := stat.wis; 324 | stat.cdex := stat.dex; 325 | stat.ccon := stat.con; 326 | stat.cchr := stat.chr; 327 | misc.ptodam := todam_adj; { Real values } 328 | misc.ptohit := tohit_adj; 329 | misc.ptoac := toac_adj; 330 | misc.pac := 0; 331 | misc.dis_td := misc.ptodam; { Displayed values } 332 | misc.dis_th := misc.ptohit; 333 | misc.dis_tac:= misc.ptoac; 334 | misc.dis_ac := misc.pac; 335 | end; 336 | end 337 | else if (s = '?') then 338 | begin 339 | moria_help('Character Classes'); 340 | exit_flag := true; 341 | get_class := false; 342 | end; 343 | until(exit_flag); 344 | end; 345 | 346 | 347 | procedure get_money; 348 | var 349 | tmp : integer; 350 | begin 351 | with py.stat do 352 | tmp := cstr + cint + cwis + cdex + ccon + cchr; 353 | with py.misc do 354 | begin 355 | au := sc*6 + randint(25) + 325; { Social Class adj } 356 | au := au - tmp; { Stat adj } 357 | au := au + py.stat.cchr; { Charisma adj } 358 | if (au < 80) then au := 80; { Minimum } 359 | end; 360 | end; 361 | 362 | 363 | { ---------- M A I N for Character Creation Routine ---------- } 364 | { -JWT- } 365 | 366 | begin 367 | with py do 368 | begin 369 | { This delay may be reduced, but is recomended to keep players } 370 | { from continuously rolling up characters, which can be VERY } 371 | { expensive CPU wise. } 372 | repeat 373 | put_character; 374 | until(choose_race); 375 | while (not(get_sex)) do put_character; 376 | get_history; 377 | get_ahw; 378 | print_history; 379 | put_misc1; 380 | put_stats; 381 | while (not(get_class)) do 382 | begin 383 | put_character; 384 | print_history; 385 | put_misc1; 386 | put_stats; 387 | end; 388 | get_money; 389 | put_stats; 390 | put_misc2; 391 | put_misc3; 392 | get_name; 393 | pause_exit(24,player_exit_pause); 394 | end 395 | end; 396 | -------------------------------------------------------------------------------- /source/include/io.inc: -------------------------------------------------------------------------------- 1 | { Convert an integer into a system bin time -RAK- } 2 | { NOTE: Int_time is number of 1/100 seconds } 3 | { Max value = 5999 } 4 | [psect(misc2$code)] procedure convert_time( 5 | int_time : unsigned; 6 | var bin_time : quad_type); 7 | type 8 | time_type = packed array [1..13] of char; 9 | var 10 | time_str : time_type; 11 | secs,tics : unsigned; 12 | out_val : varying[2] of char; 13 | 14 | [asynchronous,external(SYS$BINTIM)] function $bin_time( 15 | %stdescr give_str : time_type; 16 | var slp_time : quad_type 17 | ) : integer; 18 | external; 19 | 20 | begin 21 | time_str := '0 00:00:00.00'; 22 | bin_time.l0 := 0; 23 | bin_time.l1 := 0; 24 | tics := int_time mod 100; 25 | secs := int_time div 100; 26 | if (secs > 0) then 27 | begin 28 | if (secs > 59) then secs := 59; 29 | writev(out_val,secs:2); 30 | time_str[10] := out_val[2]; 31 | if (secs > 9) then time_str[9] := out_val[1]; 32 | end; 33 | if (tics > 0) then 34 | begin 35 | writev(out_val,tics:2); 36 | time_str[13] := out_val[2]; 37 | if (tics > 9) then time_str[12] := out_val[1]; 38 | end; 39 | $bin_time(time_str,bin_time); 40 | end; 41 | 42 | 43 | { Set timer for hibernation -RAK- } 44 | [asynchronous,external(SYS$SETIMR)] function set_time( 45 | %immed efn : integer := %immed 5; 46 | var bintime : quad_type; 47 | %ref astadr : integer := %immed 0; 48 | %immed reqidt : integer := %immed 0) : integer; 49 | external; 50 | 51 | 52 | { Hibernate -RAK- } 53 | [asynchronous,external(SYS$WAITFR)] function hibernate( 54 | %immed efn : integer := %immed 5) : integer; 55 | external; 56 | 57 | 58 | { Sleep for given time -RAK- } 59 | { NOTE: Int_time is in seconds } 60 | [psect(misc2$code)] procedure sleep(int_time : unsigned); 61 | var 62 | bin_time : quad_type; 63 | begin 64 | convert_time(int_time*100,bin_time); 65 | set_time(bintime:=bin_time); 66 | hibernate; 67 | end; 68 | 69 | 70 | { Setup system time format for io_pause. -RAK- } 71 | { NOTE: IO$MOR_IOPAUSE is a constant } 72 | { IO$BIN_PAUSE is a variable used to store results } 73 | { NOTE: Remove or comment out for VMS 4.0 or greater } 74 | [psect(setup$code)] procedure setup_io_pause; 75 | begin 76 | convert_time(IO$MOR_IOPAUSE,IO$BIN_PAUSE); 77 | end; 78 | 79 | 80 | { Turns SYSPRV off if 0; on if 1; -RAK- } 81 | { This is needed if image is installed with SYSPRV because } 82 | { user could write on system areas. By turning the priv off } 83 | { system areas are secure } 84 | [psect(setup$code)] procedure priv_switch(switch_val : integer); 85 | type 86 | priv_field= record { Quad word needed for priv mask} 87 | low : unsigned; 88 | high : unsigned; 89 | end; 90 | var 91 | priv_mask : priv_field; 92 | 93 | { Turn off SYSPRV -RAK- } 94 | [external(SYS$SETPRV)] function $setprv( 95 | %immed enbflg : integer := %immed 0; 96 | var privs : priv_field; 97 | %immed prmflg : integer := %immed 0; 98 | %immed prvprv : integer := %immed 0) : integer; 99 | external; 100 | 101 | begin 102 | priv_mask.low := %X'10000000'; { SYSPRV } 103 | priv_mask.high := %X'00000000'; 104 | $setprv(enbflg:=switch_val,privs:=priv_mask); 105 | end; 106 | 107 | 108 | { Spawn a shell -RAK- } 109 | [external(LIB$SPAWN)] function shell_out( 110 | command_str : integer := %immed 0; 111 | input_file : integer := %immed 0; 112 | output_file : integer := %immed 0; 113 | flags : integer := %immed 0; 114 | process_name : integer := %immed 0; 115 | process_id : integer := %immed 0; 116 | comp_status : integer := %immed 0; 117 | comp_efn : integer := %immed 0; 118 | comp_astadr : integer := %immed 0; 119 | comp_astprm : integer := %immed 0 ) : integer; 120 | external; 121 | 122 | 123 | { Turn off Control-Y -RAK- } 124 | [psect(setup$code)] procedure no_controly; 125 | var 126 | bit_mask : unsigned; 127 | 128 | [external(LIB$DISABLE_CTRL)] function y_off( 129 | var mask : unsigned; 130 | old_mask : integer := %immed 0) : integer; 131 | external; 132 | 133 | begin 134 | bit_mask := %X'02000000'; { No Control-Y } 135 | y_off(mask:=bit_mask); 136 | end; 137 | 138 | 139 | { Turn on Control-Y -RAK- } 140 | [psect(setup$code)] procedure controly; 141 | var 142 | bit_mask : unsigned; 143 | 144 | [external(LIB$ENABLE_CTRL)] function y_on( 145 | var mask : unsigned; 146 | old_mask : integer := %immed 0) : integer; 147 | external; 148 | 149 | begin 150 | bit_mask := %X'02000000'; { Control-Y } 151 | y_on(mask:=bit_mask); 152 | end; 153 | 154 | 155 | { Dump IO to buffer -RAK- } 156 | { NOTE: Source is PUTQIO.MAR } 157 | procedure put_buffer ( 158 | %ref out_str : varying [a] of char; 159 | %immed row : integer; 160 | %immed col : integer 161 | ); 162 | external; 163 | 164 | 165 | { Dump the IO buffer to terminal -RAK- } 166 | { NOTE: Source is PUTQIO.MAR } 167 | procedure put_qio; 168 | external; 169 | 170 | 171 | [psect(setup$code)] procedure exit; 172 | 173 | { Immediate exit from program } 174 | [external(SYS$EXIT)] function $exit( 175 | %immed status : integer := %immed 1) : integer; 176 | external; 177 | 178 | begin 179 | controly; { Turn control-Y back on } 180 | put_qio; { Dump any remaining buffer } 181 | $exit; { exit from game } 182 | end; 183 | 184 | 185 | { Initializes I/O channel for use with INKEY } 186 | [psect(setup$code)] procedure init_channel; 187 | type 188 | ttype = packed array [1..3] of char; 189 | var 190 | status : integer; 191 | terminal : ttype; 192 | 193 | [external(SYS$ASSIGN)] function assign( 194 | %stdescr terminal : ttype; 195 | var channel : [volatile] integer; 196 | acmode : integer := %immed 0; 197 | mbxnam : integer := %immed 0) : integer; 198 | external; 199 | 200 | begin 201 | terminal := 'TT:'; 202 | status := assign(terminal,channel); 203 | if (not odd(status)) then 204 | begin 205 | writeln('Channel could not be assigned '); 206 | exit; 207 | end 208 | end; 209 | 210 | 211 | { QIOW definition -RAK- } 212 | [asynchronous,external(SYS$QIOW)] function qiow_read( 213 | %immed efn : integer := %immed 1; 214 | %immed chan : integer; 215 | %immed func : integer := %immed 0; 216 | %immed isob : integer := %immed 0; 217 | %immed astadr : integer := %immed 0; 218 | %immed astprm : integer := %immed 0; 219 | %ref get_char : [unsafe] char := %immed 0; 220 | %immed buff_len : integer := %immed 0; 221 | %immed delay_time : integer := %immed 0; 222 | %immed p4 : integer := %immed 0; 223 | %immed p5 : integer := %immed 0; 224 | %immed p6 : integer := %immed 0) : integer; 225 | external; 226 | 227 | { Gets single character from keyboard and returns } 228 | [psect(io$code)] procedure inkey(var getchar : char); 229 | var 230 | status : integer; 231 | begin 232 | put_qio; { Dump IO buffer } 233 | { Allow device driver to catch up } 234 | { NOTE: Remove or comment out for VMS 4.0 or greater } 235 | set_time(bintime:=IO$BIN_PAUSE); 236 | hibernate; 237 | { Now read } 238 | qiow_read(chan:=channel, 239 | func:=IO$MOR_INPUT, 240 | get_char:=getchar, 241 | buff_len:=1 ); 242 | msg_flag := false; 243 | end; 244 | 245 | 246 | { Gets single character from keyboard and returns } 247 | [psect(io$code)] procedure inkey_delay ( 248 | var getchar : char; 249 | delay : integer 250 | ); 251 | var 252 | status : integer; 253 | begin 254 | put_qio; { Dump the IO buffer } 255 | { Allow device driver to catch up } 256 | { NOTE: Remove or comment out for VMS 4.0 or greater } 257 | set_time(bintime:=IO$BIN_PAUSE); 258 | hibernate; 259 | { Now read } 260 | getchar := null; { Blank out return character } 261 | qiow_read(chan:=channel, 262 | func:=IO$MOR_DELAY, 263 | get_char:=getchar, 264 | buff_len:=1, 265 | delay_time:=delay ); 266 | end; 267 | 268 | 269 | { Flush the buffer -RAK- } 270 | [psect(io$code)] procedure flush; 271 | begin 272 | { Allow device driver to catch up } 273 | { NOTE: Remove or comment out for VMS 4.0 or greater } 274 | set_time(bintime:=IO$BIN_PAUSE); 275 | hibernate; 276 | { Now flush } 277 | qiow_read(chan:=channel,func:=IO$MOR_IPURGE); 278 | end; 279 | 280 | 281 | { Flush buffer before input -RAK- } 282 | [psect(io$code)] procedure inkey_flush(var x : char); 283 | begin 284 | put_qio; { Dup the IO buffer } 285 | if (not(wizard1)) then flush; 286 | inkey(x); 287 | end; 288 | 289 | 290 | { Retrieves foreign string input with game command -JWT- } 291 | [external(LIB$GET_FOREIGN)] procedure get_foreign( 292 | %descr msg_str : vtype; 293 | %descr prompt : vtype := %immed 0; 294 | %ref len : integer := %immed 0); 295 | external; 296 | 297 | 298 | { Clears given line of text -RAK- } 299 | [psect(io$code)] procedure erase_line ( 300 | row : integer; 301 | col : integer 302 | ); 303 | begin 304 | put_buffer(cursor_erl,row,col); 305 | end; 306 | 307 | 308 | { Clears screen at given row, column } 309 | [psect(io$code)] procedure clear(row,col : integer); 310 | var 311 | i1 : integer; 312 | begin 313 | for i1 := 2 to 23 do used_line[i1] := false; 314 | put_buffer(cursor_erp,row,col); 315 | put_qio; { Dump the Clear Sequence } 316 | end; 317 | 318 | 319 | { Outputs a line to a given interpolated y,x position -RAK- } 320 | [psect(io$code)] procedure print( 321 | str_buff : varying[a] of char; 322 | row : integer; 323 | col : integer 324 | ); 325 | begin 326 | row := row - panel_row_prt;{ Real co-ords convert to screen positions } 327 | col := col - panel_col_prt; 328 | used_line[row] := true; 329 | put_buffer(str_buff,row,col) 330 | end; 331 | 332 | 333 | { Outputs a line to a given y,x position -RAK- } 334 | [psect(io$code)] procedure prt( 335 | str_buff : varying[a] of char; 336 | row : integer; 337 | col : integer 338 | ); 339 | begin 340 | put_buffer(cursor_erl+str_buff,row,col); 341 | end; 342 | 343 | 344 | { Outputs message to top line of screen } 345 | [psect(io$code)] procedure msg_print(str_buff : varying[a] of char); 346 | var 347 | old_len : integer; 348 | in_char : char; 349 | begin 350 | if (msg_flag) then 351 | begin 352 | old_len := length(old_msg) + 1; 353 | put_buffer(' -more-',msg_line,old_len); 354 | repeat 355 | inkey(in_char); 356 | until (ord(in_char) in [3,13,25,26,27,32]); 357 | end; 358 | put_buffer(cursor_erl+str_buff,msg_line,msg_line); 359 | old_msg := str_buff; 360 | msg_flag := true; 361 | end; 362 | 363 | 364 | { Prompts (optional) and returns ord value of input char } 365 | { Function returns false if ,CNTL/(Y,C,Z) is input } 366 | [psect(io$code)] function get_com ( 367 | prompt : varying[a] of char; 368 | var command : char 369 | ) : boolean; 370 | var 371 | com_val : integer; 372 | begin 373 | if (length(prompt) > 1) then prt(prompt,1,1); 374 | inkey(command); 375 | com_val := ord(command); 376 | case com_val of 377 | 3,25,26,27 : get_com := false; 378 | otherwise get_com := true; 379 | end; 380 | erase_line(msg_line,msg_line); 381 | msg_flag := false; 382 | end; 383 | 384 | 385 | { Gets a string terminated by } 386 | { Function returns false if ,CNTL/(Y,C,Z) is input } 387 | [psect(io$code)] function get_string ( 388 | var in_str : varying[a] of char; 389 | row,column,slen : integer 390 | ) : boolean; 391 | var 392 | start_col,end_col,i1 : integer; 393 | x : char; 394 | tmp : vtype; 395 | flag,abort : boolean; 396 | 397 | begin 398 | abort := false; 399 | flag := false; 400 | in_str:= ''; 401 | put_buffer(pad(in_str,' ',slen),row,column); 402 | put_buffer('',row,column); 403 | start_col := column; 404 | end_col := column + slen - 1; 405 | repeat 406 | inkey(x); 407 | case ord(x) of 408 | 3,25,26,27 : abort := true; 409 | 13 : flag := true; 410 | 127 : begin 411 | if (column > start_col) then 412 | begin 413 | column := column - 1; 414 | put_buffer(' '+chr(8),row,column); 415 | in_str := substr(in_str,1,length(in_str)-1); 416 | end; 417 | end; 418 | otherwise begin 419 | tmp := x; 420 | put_buffer(tmp,row,column); 421 | in_str := in_str + tmp; 422 | column := column + 1; 423 | if (column > end_col) then 424 | flag := true; 425 | end; 426 | end; 427 | until (flag or abort); 428 | if (abort) then 429 | get_string := false 430 | else 431 | begin { Remove trailing blanks } 432 | i1 := length(in_str); 433 | if (i1 > 1) then 434 | begin 435 | while ((in_str[i1] = ' ') and (i1 > 1)) do 436 | i1 := i1 - 1; 437 | in_str := substr(in_str,1,i1); 438 | end; 439 | get_string := true; 440 | end; 441 | end; 442 | 443 | 444 | { Return integer value of hex string -RAK- } 445 | [psect(wizard$code)] function get_hex_value(row,col,slen : integer) : integer; 446 | type 447 | pack_type = packed array [1..9] of char; 448 | var 449 | bin_val : integer; 450 | tmp_str : vtype; 451 | pack_str : pack_type; 452 | 453 | [asynchronous,external(OTS$CVT_TZ_L)] function convert_hex_to_bin( 454 | %stdescr hex_str : pack_type; 455 | %ref hex_val : integer; 456 | %immed val_size : integer := %immed 4; 457 | %immed flags : integer := %immed 1) : integer; 458 | external; 459 | 460 | begin 461 | get_hex_value := 0; 462 | if (get_string(tmp_str,row,col,slen)) then 463 | if (length(tmp_str) <= 8) then 464 | begin 465 | pack_str := pad(tmp_str,' ',9); 466 | if (odd(convert_hex_to_bin(pack_str,bin_val))) then 467 | get_hex_value := bin_val; 468 | end; 469 | end; 470 | 471 | 472 | 473 | { Pauses for user response before returning -RAK- } 474 | [psect(misc2$code)] procedure pause(prt_line : integer); 475 | var 476 | dummy : char; 477 | begin 478 | prt('[Press any key to continue]',prt_line,24); 479 | inkey(dummy); 480 | erase_line(24,1); 481 | end; 482 | 483 | 484 | { Pauses for user response before returning -RAK- } 485 | { NOTE: Delay is for players trying to roll up "perfect" } 486 | { characters. Make them wait a bit... } 487 | [psect(misc2$code)] procedure pause_exit( 488 | prt_line : integer; 489 | delay : integer); 490 | var 491 | dummy : char; 492 | begin 493 | prt('[Press any key to continue, or -Z to exit]',prt_line,11); 494 | inkey(dummy); 495 | case ord(dummy) of 496 | 3,25,26 : begin 497 | erase_line(prt_line,1); 498 | if (delay > 0) then sleep(delay); 499 | exit; 500 | end; 501 | otherwise; 502 | end; 503 | erase_line(prt_line,1); 504 | end; 505 | 506 | 507 | { Returns the image path for Moria -RAK- } 508 | { Path is returned in a VARYING[80] of char } 509 | [psect(setup$code)] procedure get_paths; 510 | type 511 | word = 0..65535; 512 | rec_jpi = record 513 | pathinfo : packed record 514 | pathlen : word; 515 | jpi$_imagname : word; 516 | end; 517 | ptr_path : ^path; 518 | ptr_pathlen : ^integer; 519 | endlist : integer 520 | end; 521 | path = packed array [1..128] of char; 522 | var 523 | i1 : integer; 524 | tmp_str : path; 525 | image_path : vtype; 526 | flag : boolean; 527 | 528 | { Call JPI and return the image path as a packed 128 -RAK- } 529 | function get_jpi_path : path; 530 | var 531 | status : integer; 532 | user : path; 533 | jpirec : rec_jpi; 534 | 535 | { GETJPI definition } 536 | [asynchronous,external(SYS$GETJPI)] function $getjpi( 537 | %immed p1 : integer := %immed 0; 538 | %immed p2 : integer := %immed 0; 539 | %immed p3 : integer := %immed 0; 540 | var itmlst : rec_jpi; 541 | %immed p4 : integer := %immed 0; 542 | %immed p5 : integer := %immed 0; 543 | %immed p6 : integer := %immed 0) : integer; 544 | external; 545 | 546 | begin 547 | with jpirec do 548 | begin 549 | pathinfo.pathlen := 128; { Image length } 550 | pathinfo.jpi$_imagname := %x207; { Image path } 551 | new (ptr_path); 552 | pad(ptr_path^,' ',128); 553 | new (ptr_pathlen); 554 | ptr_pathlen^ := 0; 555 | endlist := 0; 556 | end; 557 | status := $getjpi(itmlst:=jpirec); 558 | if (not(odd(status))) then 559 | begin 560 | clear(1,1); 561 | put_buffer('Error in retrieving image path.',1,1); 562 | exit; 563 | end 564 | else 565 | get_jpi_path := jpirec.ptr_path^; 566 | end; 567 | 568 | begin 569 | tmp_str := get_jpi_path; 570 | i1 := 0; 571 | flag := false; 572 | image_path := ''; 573 | repeat 574 | i1 := i1 + 1; 575 | if (tmp_str[i1] = ']') then flag := true; 576 | image_path := image_path + tmp_str[i1]; 577 | if (i1 > 127) then flag := true; 578 | until(flag); 579 | MORIA_HOU := image_path + 'HOURS.DAT'; 580 | MORIA_MOR := image_path + 'MORIA.DAT'; 581 | MORIA_MAS := image_path + 'MORIACHR.DAT'; 582 | MORIA_TOP := image_path + 'MORIATOP.DAT'; 583 | MORIA_HLP := image_path + 'MORIAHLP.HLB'; 584 | end; 585 | -------------------------------------------------------------------------------- /source/include/save.inc: -------------------------------------------------------------------------------- 1 | { This save package was brought to by -JWT- 2 | and -RAK- } 3 | 4 | 5 | { Data Corruption means character is dead, or save file was -RAK- 6 | screwed with. Keep them guessing as to what is actually wrong.} 7 | [psect(save$code)] procedure data_exception; 8 | begin 9 | clear(1,1); 10 | prt('Data Corruption Error.',1,1); 11 | prt('',2,1); 12 | exit; 13 | end; 14 | 15 | 16 | { Uses XOR function to encode data -RAK- } 17 | [psect(save$code)] procedure coder(var line : ntype); 18 | var 19 | i1 : integer; 20 | i2,i3,i4 : unsigned; 21 | begin 22 | for i1 := 1 to length(line) do 23 | begin 24 | i2 := uint(ord(line[i1])); 25 | i3 := uint(randint(256)-1); 26 | i4 := uxor(i2,i3); 27 | line[i1] := chr(i4); 28 | end; 29 | end; 30 | 31 | 32 | { Encrypts a line of text, complete with a data-check sum-RAK- } 33 | { (original by JWT) } 34 | [psect(save$code)] procedure encrypt(var line : ntype); 35 | var 36 | i1,i2 : integer; 37 | temp : ntype; 38 | 39 | begin 40 | i2 := 0; 41 | for i1 := 1 to length(line) do 42 | i2 := i2 + ord(line[i1]) + i1; 43 | temp := line; 44 | writev(line,i2:1,' ',temp); 45 | coder(line); 46 | end; 47 | 48 | 49 | { Decrypts a line of text, complete with a data-check sum-RAK- } 50 | { (original by JWT) } 51 | [psect(save$code)] procedure decrypt(var line : ntype); 52 | var 53 | i1,i2,i3 : integer; 54 | temp : ntype; 55 | tmp : char; 56 | 57 | begin 58 | i2 := 0; 59 | coder(line); 60 | temp := line; 61 | readv(temp,i3,tmp,line); 62 | for i1 := 1 to length(line) do 63 | i2 := i2 + ord(line[i1]) + i1; 64 | if (i2 <> i3) then data_exception; 65 | end; 66 | 67 | 68 | { Actual save procedure -RAK- & -JWT- } 69 | [psect(save$code)] function save_char : boolean; 70 | var 71 | tot_monsters,tot_treasure : integer; 72 | i1,i2,trys : integer; 73 | xfloor : unsigned; 74 | save_seed : unsigned; 75 | fnam : vtype; 76 | temp : packed array [1..70] of char; 77 | out_rec,title1,title2 : ntype; 78 | f1 : text; 79 | f2 : file of key_type; 80 | flag,file_flag : boolean; 81 | 82 | begin 83 | prt('Enter Filename:',1,1); 84 | flag := false; 85 | { Open the user's save file -JWT- } 86 | if (get_string(fnam,1,17,60)) then 87 | begin 88 | if (length(fnam) = 0) then fnam := 'MORIACHR.SAV'; 89 | open (f1,FILE_NAME:=fnam,record_length:=1024,ERROR:=continue); 90 | if (status(f1) <> 0) then 91 | msg_print('Error creating> ' + fnam) 92 | else 93 | flag := true; 94 | end; 95 | { Make an attempt to open the MASTER file -JWT- } 96 | if (flag) then 97 | begin 98 | rewrite(f1,error:=continue); 99 | priv_switch(1); 100 | open (f2,file_name:=moria_mas, 101 | error:=continue,access_method:=keyed,organization:=indexed, 102 | history:=old,sharing:=readwrite); 103 | if (status(f2) <> 0) then 104 | begin 105 | priv_switch(0); 106 | open (f2,file_name:=moria_mas, 107 | error:=continue,access_method:=keyed, 108 | organization:=indexed,history:=new,sharing:=readwrite); 109 | end; 110 | if (status(f2) <> 0) then 111 | begin 112 | msg_print('Error saving character, contact MORIA Wizard.'); 113 | close(f1,error:=continue); 114 | flag := false; 115 | end; 116 | end; 117 | { Make an attempt to create a unique ID and write to MASTER -RAK-} 118 | if (flag) then 119 | begin 120 | trys := 0; 121 | file_flag := false; 122 | repeat 123 | for i1 := 1 to 70 do temp[i1] := chr(31+randint(95)); 124 | title1 := temp; 125 | seed := encrypt_seed1; 126 | coder(title1); 127 | for i1 := 1 to 70 do 128 | key_rec.file_id[i1] := title1[i1]; 129 | f2^ := key_rec; 130 | put(f2,error:=continue); 131 | if (status(f2) <> 0) then 132 | begin 133 | trys := trys + 1; 134 | if (trys > 5) then 135 | begin 136 | file_flag := true; 137 | flag := false; 138 | msg_print('Error in writing to MASTER.'); 139 | end; 140 | end 141 | else 142 | file_flag := true; 143 | until(file_flag); 144 | close(f2,error:=continue); 145 | priv_switch(0); 146 | end; 147 | { If ID was written to MASTER, continue saving -RAK- } 148 | if (flag) then 149 | begin 150 | save_seed := get_seed; 151 | writev(title2,save_seed:12,' ',temp); 152 | seed := encrypt_seed2; 153 | encrypt(title2); 154 | writeln(f1,title2,error:=continue); 155 | seed := save_seed; 156 | { Message to player on what is happening} 157 | clear(1,1); 158 | prt('Saving character...',1,1); 159 | put_qio; 160 | { Version number of Moria } 161 | writev(out_rec,cur_version); 162 | encrypt(out_rec); 163 | writeln(f1,out_rec,error:=continue); 164 | 165 | { Write out the player record. } 166 | with py.misc do 167 | begin 168 | writev(out_rec,name); 169 | encrypt(out_rec); 170 | writeln(f1,out_rec,error:=continue); 171 | 172 | writev(out_rec,race); 173 | encrypt(out_rec); 174 | writeln(f1,out_rec,error:=continue); 175 | 176 | writev(out_rec,sex); 177 | encrypt(out_rec); 178 | writeln(f1,out_rec,error:=continue); 179 | 180 | writev(out_rec,tclass); 181 | encrypt(out_rec); 182 | writeln(f1,out_rec,error:=continue); 183 | 184 | writev(out_rec,title); 185 | encrypt(out_rec); 186 | writeln(f1,out_rec,error:=continue); 187 | 188 | for i1 := 1 to 5 do 189 | begin 190 | out_rec := history[i1]; 191 | encrypt(out_rec); 192 | writeln(f1,out_rec,error:=continue); 193 | end; 194 | 195 | writev(out_rec,char_row:1,' ',char_col:1,' ', 196 | pclass:1,' ',prace:1,' ', 197 | age:1,' ',ht:1,' ',wt:1,' ',sc:1,' ',max_exp:1,' ', 198 | exp:1,' ',lev:1,' ',max_lev:1,' ',expfact:2:1); 199 | 200 | encrypt(out_rec); 201 | writeln(f1,out_rec,error:=continue); 202 | 203 | writev(out_rec,srh:1,' ',fos:1,' ',stl:1,' ',bth:1,' ', 204 | bthb:1,' ', 205 | mana:1,' ',cmana:1,' ',mhp:1,' ',chp:1:1,' ',au:1,' ', 206 | ptohit:1,' ',ptodam:1,' ',pac:1,' ',ptoac:1,' ', 207 | dis_th:1,' ',dis_td:1,' ',dis_ac:1,' ',dis_tac:1,' ', 208 | disarm:1,' ',save:1,' ',hitdie:1); 209 | 210 | encrypt(out_rec); 211 | writeln(f1,out_rec,error:=continue); 212 | 213 | writev(out_rec,inven_ctr:1,' ', 214 | inven_weight:1,' ',equip_ctr:1,' ',dun_level:1,' ', 215 | missle_ctr:1,' ',mon_tot_mult:1,' ',uand(%X'F',turn):1, 216 | ' ',randes_seed:12); 217 | 218 | encrypt(out_rec); 219 | writeln(f1,out_rec,error:=continue); 220 | end; 221 | 222 | { Write out the inventory records. } 223 | for i1 := 1 to inven_ctr do 224 | begin 225 | writev(out_rec,inventory[i1].tchar,inventory[i1].name); 226 | encrypt(out_rec); 227 | writeln(f1,out_rec,error:=continue); 228 | 229 | writev(out_rec,inventory[i1].damage); 230 | encrypt(out_rec); 231 | writeln(f1,out_rec,error:=continue); 232 | 233 | with inventory[i1] do 234 | writev(out_rec,tval:1,' ',subval:1,' ',weight:1,' ', 235 | number:1,' ',tohit:1,' ',todam:1,' ',ac:1,' ', 236 | toac:1,' ',p1:1,' ',flags:1,' ',level:1,' ',cost:1); 237 | encrypt(out_rec); 238 | writeln(f1,out_rec,error:=continue); 239 | end; 240 | 241 | { Write out the equipment records. } 242 | for i1 := 23 to inven_max-1 do 243 | begin 244 | writev(out_rec,inventory[i1].tchar,inventory[i1].name); 245 | encrypt(out_rec); 246 | writeln(f1,out_rec,error:=continue); 247 | 248 | writev(out_rec,inventory[i1].damage); 249 | encrypt(out_rec); 250 | writeln(f1,out_rec,error:=continue); 251 | 252 | with inventory[i1] do 253 | writev(out_rec,tval:1,' ',subval:1,' ',weight:1,' ', 254 | number:1,' ',tohit:1,' ',todam:1,' ',ac:1,' ', 255 | toac:1,' ',p1:1,' ',flags:1,' ',level:1,' ',cost:1); 256 | encrypt(out_rec); 257 | writeln(f1,out_rec,error:=continue); 258 | end; 259 | 260 | with py.stat do 261 | begin 262 | writev(out_rec,str:1,' ',cstr:1,' ',dex:1,' ',cdex:1,' ', 263 | con:1,' ',ccon:1,' ',int:1,' ',cint:1,' ',wis:1,' ', 264 | cwis:1,' ',chr:1,' ',cchr:1); 265 | encrypt(out_rec); 266 | writeln(f1,out_rec,error:=continue); 267 | end; 268 | 269 | with py.flags do 270 | begin 271 | writev(out_rec,status:1,' ',blind:1,' ',confused:1,' ', 272 | food:1,' ',food_digested:1,' ',protection:1,' ', 273 | speed:1,' ',afraid:1,' ', 274 | poisoned:1,' ',see_inv:1); 275 | encrypt(out_rec); 276 | writeln(f1,out_rec,error:=continue); 277 | 278 | writev(out_rec,fast:1,' ',slow:1,' ',protevil:1,' ', 279 | teleport:1,' ',free_act:1,' ',slow_digest:1); 280 | encrypt(out_rec); 281 | writeln(f1,out_rec,error:=continue); 282 | 283 | writev(out_rec,aggravate:1,' ',sustain_str:1,' ', 284 | sustain_int:1,' ',sustain_wis:1,' ',sustain_con:1,' ', 285 | sustain_dex:1,' ',sustain_chr:1); 286 | encrypt(out_rec); 287 | writeln(f1,out_rec,error:=continue); 288 | 289 | writev(out_rec,fire_resist:1,' ',cold_resist:1,' ', 290 | acid_resist:1,' ',regenerate:1,' ',lght_resist:1,' ', 291 | ffall:1,' ',confuse_monster:1); 292 | encrypt(out_rec); 293 | writeln(f1,out_rec,error:=continue); 294 | 295 | writev(out_rec,image:1,' ',invuln:1,' ',hero:1,' ', 296 | shero:1,' ',blessed:1,' ', 297 | resist_heat:1,' ',resist_cold:1,' ',detect_inv:1,' ', 298 | word_recall:1,' ',see_infra:1,' ',tim_infra:1); 299 | encrypt(out_rec); 300 | writeln(f1,out_rec,error:=continue); 301 | end; 302 | 303 | for i1 := 1 to 31 do 304 | with magic_spell[py.misc.pclass,i1] do 305 | begin 306 | writev(out_rec,learned:5,' ',sexp:5); 307 | encrypt(out_rec); 308 | writeln(f1,out_rec,error:=continue) 309 | end; 310 | 311 | { Write the important dungeon info and floor -RAK- } 312 | begin 313 | writev(out_rec,cur_height:1,' ',cur_width:1,' ', 314 | max_panel_rows:1,' ',max_panel_cols:1); 315 | encrypt(out_rec); 316 | writeln(f1,out_rec,error:=continue); 317 | 318 | { Save the floor } 319 | tot_treasure := 0; 320 | for i1 := 1 to cur_height do 321 | begin 322 | out_rec := pad(' ',' ',cur_width); 323 | for i2 := 1 to cur_width do 324 | begin 325 | with cave[i1,i2] do 326 | begin 327 | xfloor := fval; 328 | if (fopen) then 329 | xfloor := uor(xfloor,%X'10'); 330 | if (pl) then 331 | xfloor := uor(xfloor,%X'20'); 332 | if (fm) then 333 | xfloor := uor(xfloor,%X'40'); 334 | out_rec[i2] := chr(xfloor); 335 | if (tptr > 0) then 336 | tot_treasure := tot_treasure + 1; 337 | end; 338 | end; 339 | encrypt(out_rec); 340 | writeln(f1,out_rec,error:=continue); 341 | end; 342 | 343 | { Save the Treasure List } 344 | writev(out_rec,tot_treasure:1); 345 | encrypt(out_rec); 346 | writeln(f1,out_rec,error:=continue); 347 | for i1 := 1 to cur_height do 348 | for i2 := 1 to cur_width do 349 | if (cave[i1,i2].tptr > 0) then 350 | with t_list[cave[i1,i2].tptr] do 351 | begin 352 | writev(out_rec,i1:1,' ',i2:1); 353 | encrypt(out_rec); 354 | writeln(f1,out_rec,error:=continue); 355 | 356 | writev(out_rec,tchar,name); 357 | encrypt(out_rec); 358 | writeln(f1,out_rec,error:=continue); 359 | 360 | writev(out_rec,damage); 361 | encrypt(out_rec); 362 | writeln(f1,out_rec,error:=continue); 363 | 364 | writev(out_rec,tval:1,' ',subval:1,' ',weight:1,' ', 365 | number:1,' ',tohit:1,' ',todam:1,' ',ac:1,' ', 366 | toac:1,' ',p1:1,' ',flags:1,' ',level:1,' ',cost:1); 367 | encrypt(out_rec); 368 | writeln(f1,out_rec,error:=continue); 369 | end; 370 | 371 | { Save identified list } 372 | out_rec := ''; 373 | for i1 := 1 to max_objects do 374 | begin 375 | if (object_ident[i1]) then 376 | out_rec := out_rec + 'T' 377 | else 378 | out_rec := out_rec + 'F'; 379 | end; 380 | encrypt(out_rec); 381 | writeln(f1,out_rec,error:=continue); 382 | 383 | { Save the Monster List } 384 | i1 := muptr; 385 | tot_monsters := 0; 386 | if (i1 > 0) then 387 | repeat 388 | tot_monsters := tot_monsters + 1; 389 | with m_list[i1] do 390 | i1 := nptr; 391 | until (i1 = 0); 392 | writev(out_rec,tot_monsters:1); 393 | encrypt(out_rec); 394 | writeln(f1,out_rec,error:=continue); 395 | i1 := muptr; 396 | if (i1 > 0) then 397 | repeat 398 | with m_list[i1] do 399 | begin 400 | writev(out_rec,fy:1,' ',fx:1,' ',mptr:1,' ',hp:1, 401 | ' ',cspeed:1,' ',csleep:1,' ',cdis:1,' ',ml:1, 402 | ' ',confused:1); 403 | encrypt(out_rec); 404 | writeln(f1,out_rec,error:=continue); 405 | i1 := nptr; 406 | end; 407 | until (i1 = 0); 408 | 409 | { Save the town level stores } 410 | writev(out_rec,town_seed:12); 411 | encrypt(out_rec); 412 | writeln(f1,out_rec,error:=continue); 413 | for i1 := 1 to max_stores do 414 | with store[i1] do 415 | begin 416 | { Save items... } 417 | writev(out_rec,store_ctr:1); 418 | encrypt(out_rec); 419 | writeln(f1,out_rec,error:=continue); 420 | for i2 := 1 to store_ctr do 421 | with store_inven[i2].sitem do 422 | begin 423 | writev(out_rec,store_inven[i2].scost); 424 | encrypt(out_rec); 425 | writeln(f1,out_rec,error:=continue); 426 | writev(out_rec,tchar,name); 427 | encrypt(out_rec); 428 | writeln(f1,out_rec,error:=continue); 429 | writev(out_rec,damage); 430 | encrypt(out_rec); 431 | writeln(f1,out_rec,error:=continue); 432 | writev(out_rec,tval:1,' ',subval:1,' ',weight:1, 433 | ' ',number:1,' ',tohit:1,' ',todam:1,' ', 434 | ac:1,' ',toac:1,' ',p1:1,' ',flags:1,' ', 435 | level:1,' ',cost:1); 436 | encrypt(out_rec); 437 | writeln(f1,out_rec,error:=continue); 438 | end; 439 | if (store_open > turn) then 440 | store_open := store_open - turn + 15 441 | else 442 | store_open := 0; 443 | writev(out_rec,owner:1,' ',insult_cur:1,' ',store_open:1); 444 | encrypt(out_rec); 445 | writeln(f1,out_rec,error:=continue); 446 | end; 447 | end; 448 | close(f1,error:=continue) 449 | end; 450 | if (flag) then 451 | begin 452 | writev(out_rec,'Character saved. [Moria Version ', 453 | cur_version:5:2,']'); 454 | prt(out_rec,1,1); 455 | exit; 456 | end; 457 | save_char := flag; 458 | seed := get_seed; 459 | end; 460 | 461 | 462 | { Restore a saved game -RAK- & -JWT- } 463 | [psect(save$code)] function get_char(fnam : vtype) : boolean; 464 | var 465 | tot_treasures,tot_monsters : integer; 466 | i1,i2,i3,i4,dummy : integer; 467 | xfloor,save_seed : unsigned; 468 | save_version : real; 469 | in_rec,temp : ntype; 470 | temp_id : packed array [1..70] of char; 471 | f1 : text; 472 | f2 : file of key_type; 473 | dun_flag : boolean; 474 | 475 | begin 476 | dun_flag := false; 477 | clear(1,1); 478 | open (f1,FILE_NAME:=fnam,record_length:=1024,ERROR:=continue, 479 | HISTORY:=OLD); 480 | if (status(f1) <> 0) then 481 | begin 482 | prt('Error Opening> '+fnam,1,1); 483 | prt('',2,1); 484 | exit; 485 | end; 486 | reset(f1,ERROR:=continue); 487 | readln(f1,in_rec); 488 | seed := encrypt_seed2; 489 | decrypt(in_rec); 490 | temp := substr(in_rec,1,12); 491 | readv(temp,save_seed); 492 | temp := substr(in_rec,14,70); 493 | seed := encrypt_seed1; 494 | coder(temp); 495 | temp_id := temp; 496 | priv_switch(1); 497 | open (f2,file_name:=moria_mas, 498 | access_method:=keyed,organization:=indexed, 499 | history:=old,sharing:=readwrite,error:=continue); 500 | if (status(f2) <> 0) then 501 | begin 502 | prt('ERROR opening file MASTER.',1,1); 503 | exit; 504 | end; 505 | findk(f2,0,temp_id,eql,error:=continue); 506 | delete(f2,error:=continue); 507 | if (status(f2) <> 0) then 508 | data_exception; 509 | close(f2); 510 | priv_switch(0); 511 | seed := save_seed; 512 | prt('Restoring Character...',1,1); 513 | put_qio; 514 | readln(f1,in_rec); 515 | decrypt(in_rec); 516 | readv(in_rec,save_version); 517 | if (save_version <> cur_version) then 518 | begin 519 | prt('Save file is incompatable with this version.',2,1); 520 | writev(in_rec,' [Save file version ',save_version:5:2,']'); 521 | prt(in_rec,3,1); 522 | writev(in_rec,' [Moria version ',cur_version:5:2,']'); 523 | prt(in_rec,4,1); 524 | if (save_version > 4.0) then 525 | begin 526 | prt('Updating character for newer version...',5,1); 527 | dun_flag := true; 528 | end 529 | else 530 | exit; 531 | pause(24); 532 | end; 533 | 534 | readln(f1,in_rec); 535 | decrypt(in_rec); 536 | with py.misc do 537 | readv(in_rec,name); 538 | 539 | readln(f1,in_rec); 540 | decrypt(in_rec); 541 | with py.misc do 542 | readv(in_rec,race); 543 | 544 | readln(f1,in_rec); 545 | decrypt(in_rec); 546 | with py.misc do 547 | readv(in_rec,sex); 548 | 549 | readln(f1,in_rec); 550 | decrypt(in_rec); 551 | with py.misc do 552 | readv(in_rec,tclass); 553 | 554 | readln(f1,in_rec); 555 | decrypt(in_rec); 556 | with py.misc do 557 | readv(in_rec,title); 558 | 559 | for i1 := 1 to 5 do 560 | begin 561 | readln(f1,in_rec); 562 | decrypt(in_rec); 563 | py.misc.history[i1] := in_rec; 564 | end; 565 | 566 | readln(f1,in_rec); 567 | decrypt(in_rec); 568 | with py.misc do 569 | readv(in_rec,char_row,char_col,pclass,prace,age,ht,wt,sc, 570 | max_exp,exp,lev,max_lev,expfact); 571 | 572 | readln(f1,in_rec); 573 | decrypt(in_rec); 574 | with py.misc do 575 | readv(in_rec,srh,fos,stl,bth,bthb,mana,cmana,mhp,chp,au, 576 | ptohit,ptodam,pac,ptoac,dis_th,dis_td,dis_ac,dis_tac, 577 | disarm,save,hitdie); 578 | 579 | readln(f1,in_rec); 580 | decrypt(in_rec); 581 | readv(in_rec,inven_ctr,inven_weight,equip_ctr,dun_level, 582 | missle_ctr,mon_tot_mult,turn,randes_seed); 583 | 584 | { Read in the inventory records. } 585 | for i1 := 1 to inven_ctr do 586 | begin 587 | readln(f1,in_rec); 588 | decrypt(in_rec); 589 | readv(in_rec,inventory[i1].tchar,inventory[i1].name); 590 | 591 | readln(f1,in_rec); 592 | decrypt(in_rec); 593 | readv(in_rec,inventory[i1].damage); 594 | 595 | readln(f1,in_rec); 596 | decrypt(in_rec); 597 | with inventory[i1] do 598 | readv(in_rec,tval,subval,weight,number,tohit,todam,ac, 599 | toac,p1,flags,level,cost); 600 | end; 601 | 602 | { Read in the equipment records. } 603 | for i1 := 23 to inven_max-1 do 604 | begin 605 | readln(f1,in_rec); 606 | decrypt(in_rec); 607 | readv(in_rec,inventory[i1].tchar,inventory[i1].name); 608 | 609 | readln(f1,in_rec); 610 | decrypt(in_rec); 611 | readv(in_rec,inventory[i1].damage); 612 | 613 | readln(f1,in_rec); 614 | decrypt(in_rec); 615 | with inventory[i1] do 616 | readv(in_rec,tval,subval,weight,number,tohit,todam,ac, 617 | toac,p1,flags,level,cost); 618 | end; 619 | 620 | readln(f1,in_rec); 621 | decrypt(in_rec); 622 | with py.stat do 623 | readv(in_rec,str,cstr,dex,cdex,con,ccon,int,cint,wis,cwis,chr,cchr); 624 | 625 | 626 | with py.flags do 627 | begin 628 | readln(f1,in_rec); 629 | decrypt(in_rec); 630 | readv(in_rec,status,blind,confused,food,food_digested,protection, 631 | speed,afraid,poisoned,see_inv); 632 | 633 | readln(f1,in_rec); 634 | decrypt(in_rec); 635 | readv(in_rec,fast,slow,protevil,teleport,free_act,slow_digest); 636 | 637 | readln(f1,in_rec); 638 | decrypt(in_rec); 639 | readv(in_rec,aggravate,sustain_str,sustain_int,sustain_wis, 640 | sustain_con,sustain_dex,sustain_chr); 641 | 642 | readln(f1,in_rec); 643 | decrypt(in_rec); 644 | readv(in_rec,fire_resist,cold_resist,acid_resist,regenerate, 645 | lght_resist,ffall,confuse_monster); 646 | 647 | 648 | readln(f1,in_rec); 649 | decrypt(in_rec); 650 | readv(in_rec,image,invuln,hero,shero,blessed,resist_heat, 651 | resist_cold,detect_inv,word_recall,see_infra, 652 | tim_infra); 653 | end; 654 | 655 | { Older version characters do not store experience... } 656 | if (dun_flag) then 657 | begin 658 | for i1 := 1 to 31 do 659 | begin 660 | readln(f1,in_rec); 661 | decrypt(in_rec); 662 | readv(in_rec,magic_spell[py.misc.pclass,i1].learned) 663 | end; 664 | end 665 | else 666 | begin 667 | for i1 := 1 to 31 do 668 | with magic_spell[py.misc.pclass,i1] do 669 | begin 670 | readln(f1,in_rec); 671 | decrypt(in_rec); 672 | readv(in_rec,learned,sexp) 673 | end; 674 | end; 675 | 676 | { If same version, restore dungeon level... } 677 | if (not(dun_flag)) then 678 | begin 679 | { Read the important dungeon info and floor } 680 | readln(f1,in_rec); 681 | decrypt(in_rec); 682 | readv(in_rec,cur_height,cur_width,max_panel_rows,max_panel_cols); 683 | 684 | { Restore the floor } 685 | for i1 := 1 to cur_height do 686 | begin 687 | readln(f1,in_rec); 688 | decrypt(in_rec); 689 | for i2 := 1 to cur_width do 690 | begin 691 | xfloor := ord(in_rec[i2]); 692 | with cave[i1,i2] do 693 | begin 694 | fval := int(uand(%X'0F',xfloor)); 695 | if (uand(%X'10',xfloor) <> 0) then 696 | fopen := true; 697 | if (uand(%X'20',xfloor) <> 0) then 698 | pl := true; 699 | if (uand(%X'40',xfloor) <> 0) then 700 | fm := true; 701 | tl := false; 702 | tptr := 0; 703 | cptr := 0; 704 | end; 705 | end; 706 | end; 707 | 708 | { Restore the Treasure List } 709 | tlink; 710 | readln(f1,in_rec); 711 | decrypt(in_rec); 712 | readv(in_rec,tot_treasures); 713 | for i1 := 1 to tot_treasures do 714 | begin 715 | popt(i2); 716 | with t_list[i2] do 717 | begin 718 | readln(f1,in_rec); 719 | decrypt(in_rec); 720 | readv(in_rec,i3,i4); 721 | cave[i3,i4].tptr := i2; 722 | 723 | readln(f1,in_rec); 724 | decrypt(in_rec); 725 | readv(in_rec,tchar,name); 726 | 727 | readln(f1,in_rec); 728 | decrypt(in_rec); 729 | readv(in_rec,damage); 730 | 731 | readln(f1,in_rec); 732 | decrypt(in_rec); 733 | readv(in_rec,tval,subval,weight,number,tohit,todam,ac,toac, 734 | p1,flags,level,cost); 735 | end; 736 | end; 737 | 738 | { Re-identify objects } 739 | readln(f1,in_rec); 740 | decrypt(in_rec); 741 | for i1 := 1 to max_objects do 742 | if (in_rec[i1] = 'T') then 743 | identify(object_list[i1]) 744 | else 745 | object_ident[i1] := false; 746 | 747 | { Restore the Monster List } 748 | mlink; 749 | readln(f1,in_rec); 750 | decrypt(in_rec); 751 | readv(in_rec,tot_monsters); 752 | i3 := 0; 753 | for i1 := 1 to tot_monsters do 754 | begin 755 | readln(f1,in_rec); 756 | decrypt(in_rec); 757 | popm(i2); 758 | with m_list[i2] do 759 | begin 760 | readv(in_rec,fy,fx,mptr,hp,cspeed,csleep,cdis,ml,confused); 761 | cave[fy,fx].cptr := i2; 762 | if (muptr = 0) then 763 | muptr := i2 764 | else 765 | m_list[i3].nptr := i2; 766 | nptr := 0; 767 | i3 := i2; 768 | end; 769 | end; 770 | 771 | { Restore the town level stores } 772 | readln(f1,in_rec); 773 | decrypt(in_rec); 774 | readv(in_rec,town_seed); 775 | for i1 := 1 to max_stores do 776 | with store[i1] do 777 | begin 778 | readln(f1,in_rec); 779 | decrypt(in_rec); 780 | readv(in_rec,i2); 781 | store_ctr := i2; 782 | { If not current version then re-outfit the stores } 783 | if (dun_flag) then 784 | begin 785 | i2 := 0; 786 | store_ctr := 0; 787 | end; 788 | for i3 := 1 to i2 do 789 | with store_inven[i3].sitem do 790 | begin 791 | readln(f1,in_rec); 792 | decrypt(in_rec); 793 | readv(in_rec,store_inven[i3].scost); 794 | readln(f1,in_rec); 795 | decrypt(in_rec); 796 | readv(in_rec,tchar,name); 797 | readln(f1,in_rec); 798 | decrypt(in_rec); 799 | readv(in_rec,damage); 800 | readln(f1,in_rec); 801 | decrypt(in_rec); 802 | readv(in_rec,tval,subval,weight,number,tohit,todam, 803 | ac,toac,p1,flags,level,cost); 804 | end; 805 | readln(f1,in_rec); 806 | decrypt(in_rec); 807 | readv(in_rec,owner,insult_cur,store_open); 808 | end; 809 | store_maint; 810 | end; 811 | 812 | close(f1,error:=continue); 813 | open (f1,file_name:=fnam, 814 | record_length:=1024,history:=old,disposition:=delete, 815 | error:=continue); 816 | close(f1,error:=continue); 817 | seed := get_seed; 818 | get_char := dun_flag; 819 | end; 820 | 821 | 822 | { Wizard command for restoring character -RAK- } 823 | [psect(save$code)] procedure restore_char; 824 | var 825 | i1 : integer; 826 | fnam : vtype; 827 | in_rec,temp : ntype; 828 | temp_id : packed array [1..70] of char; 829 | f1 : text; 830 | f2 : file of key_type; 831 | flag : boolean; 832 | 833 | begin 834 | prt('Name of file to be restored: ',1,1); 835 | if (get_string(fnam,1,30,48)) then 836 | begin 837 | priv_switch(1); 838 | open (f1,file_name:=fnam, 839 | record_length:=1024,history:=old,error:=continue); 840 | if (status(f1) <> 0) then 841 | msg_print('Error Opening> '+fnam) 842 | else 843 | begin 844 | flag := true; 845 | open (f2,file_name:=moria_mas, 846 | access_method:=keyed,organization:=indexed, 847 | history:=old,sharing:=readwrite,error:=continue); 848 | if (status(f2) <> 0) then 849 | begin 850 | open (f2,file_name:=moria_mas, 851 | access_method:=keyed,organization:=indexed, 852 | history:=new,sharing:=readwrite,error:=continue); 853 | if (status(f2) <> 0) then 854 | begin 855 | msg_print('MASTER could not be opened.'); 856 | flag := false; 857 | end; 858 | end; 859 | if (flag) then 860 | begin 861 | reset(f1,error:=continue); 862 | readln(f1,in_rec,error:=continue); 863 | seed := encrypt_seed2; 864 | decrypt(in_rec); 865 | temp := substr(in_rec,14,70); 866 | seed := encrypt_seed1; 867 | coder(temp); 868 | for i1 := 1 to 70 do 869 | key_rec.file_id[i1] := temp[i1]; 870 | findk(f2,0,temp_id,eql,error:=continue); 871 | delete(f2,error:=continue); 872 | f2^ := key_rec; 873 | put(f2,error:=continue); 874 | if (status(f2) = 0) then 875 | msg_print('Character restored...') 876 | else 877 | msg_print('Could not write ID in MASTER.'); 878 | end; 879 | close(f1,error:=continue); 880 | close(f2,error:=continue); 881 | end; 882 | seed := get_seed; 883 | priv_switch(0); 884 | end; 885 | end; 886 | --------------------------------------------------------------------------------