## 
## This is Daimler's 350-point "Adventure" (circa June 1990, according
## to Russel Dalenberg). Its version information lists
##     
##         -Conversion to BDS  C by J. R. Jaeger
##         -Unix standardization by Jerry D. Pohl.
##         -OS/2 Conversion by Martin Heller
##         -Conversion to TurboC 2.0 by Daimler
##     
## It contains Jerry Pohl's original ADVENT.DOC (dated 12 JUNE 1984),
## plus comments from Martin Heller (dated 30-Aug-1988). Strangely for
## an expansion, Daimler's version actually introduces a number of typos
## into the data files, and disables a handful of inessential verbs
## (READ, EAT, FILL) with the comment that there is "no room" for them
## (presumably in the PC's limited memory).
##  -------------------------------------------------------------------
##  Adapted for HiTech C Z80 under CP/M by Ladislau Szilagyi, Oct. 2023
##  Uncommented Daimler's disabled verbs - game is complete again !
##  Added a new pseudo-random number generator (Xorshift)
##  Adapted to Cowgol language by Ladislau Szilagyi, Feb. 2025

include "misc.coh";
include "string.coh";

@decl sub get_dbugflg(): (ret: int16) @extern("get_dbugflg");
@decl sub bug(n: uint8) @extern("bug");
@decl sub set_newloc(v: int16) @extern("set_newloc");
@decl sub set_oldloc(v: int16) @extern("set_oldloc");
@decl sub set_oldloc2(v: int16) @extern("set_oldloc2");
@decl sub toting(item: uint16): (ret: uint8) @extern("toting");
@decl sub at(item: uint16): (ret: uint8) @extern("at");
@decl sub get_prop(obj: uint8): (ret: int16) @extern("get_prop");
@decl sub badmove(motion: int16, verb: int16) @extern("badmove");
@decl sub rspeak(msg: uint8) @extern("rspeak");
@decl sub spcmove(rdest: uint16) @extern("spcmove");
@decl sub forced(atloc: uint16): (ret: uint8) @extern("forced");
@decl sub set_motion(v: int16) @extern("set_motion");

var dummy: [uint8];

const	MAXTRAV	:= 	(16+1);		# max # of travel directions from loc	
					# +1 for terminator travel[x].tdest=-1	
record	trav is
	tdest: int16;
	tverb: int16;
	tcond: int16;
end record;

var	travel: trav[MAXTRAV];

#	WARNING: the travel array for the cave is stored as MAXLOC
#	         strings.  the strings are an array of 1..MAXTRAV
#	         LONG INTEGERS.  this requires 32 bit LONG INTEGERS.
#	         these values are used in database.c "gettrav".
#	         tdset*1000000 + tverb*1000 + tcond = value stored

var cave: [uint8][] :=
	{
	"2002,2044,2029,3003,3012,3019,3043,4005,4013,4014,4046,4030,5006,5045,5043,8063,",
	"1002000,1012000,1007000,1043000,1045000,1030000,5006000,5045000,5046000,",
	"1003000,1011000,1032000,1044000,11062000,33065000,79005000,79014000,",
	"1004000,1012000,1045000,5006000,5043000,5044000,5029000,7005000,7046000,7030000,8063000,",
	"4009000,4043000,4030000,5006050,5007050,5045050,6006000,5044000,5046000,",
	"1002000,1045000,4009000,4043000,4044000,4030000,5006000,5046000,",
	"1012000,4004000,4045000,5006000,5043000,5044000,8005000,8015000,8016000,8046000,595060000,595014000,595030000,",
	"5006000,5043000,5046000,5044000,1012000,7004000,7013000,7045000,9003303,9019303,9030303,593003000,",
	"8011303,8029303,593011000,10017000,10018000,10019000,10044000,14031000,11051000,",
	"9011000,9020000,9021000,9043000,11019000,11022000,11044000,11051000,14031000,",
	"8063303,9064000,10017000,10018000,10023000,10024000,10043000,12025000,12019000,12029000,12044000,3062000,14031000,",
	"8063303,9064000,11030000,11043000,11051000,13019000,13029000,13044000,14031000,",
	"8063303,9064000,11051000,12025000,12043000,14023000,14031000,14044000,",
	"8063303,9064000,11051000,13023000,13043000,20030150,20031150,20034150,15030000,16033000,16044000,",
	"1803,1804,1700,1703,1704,1901,1903,1904,2202,2203,2203,2203,2202,2204,1402,3405,",
	"14001000,",
	"15038000,15043000,596039312,21007412,597041412,597042412,597044412,597069412,27041000,",
	"15038000,15011000,15045000,",
	"15010000,15029000,15043000,28045311,28036311,29046311,29037311,30044311,30007311,32045000,74049035,32049211,74066000,",
	"001000,",
	"001000,",
	"15001000,",
	"67043000,67042000,68044000,68061000,25030000,25031000,648052000,",
	"67029000,67011000,",
	"23029000,23011000,31056724,26056000,",
	"88001000,",
	"596039312,21007412,597041412,597042412,597043412,597069412,17041000,40045000,41044000,",
	"19038000,19011000,19046000,33045000,33055000,36030000,36052000,",
	"19038000,19011000,19045000,",
	"19038000,19011000,19043000,62044000,62029000,",
	"89001524,90001000,",
	"19001000,",
	"3065000,28046000,34043000,34053000,34054000,35044000,302071159,100071000,",
	"33030000,33055000,15029000,",
	"33043000,33055000,20039000,",
	"37043000,37017000,28029000,28052000,39044000,65070000,",
	"36044000,36017000,38030000,38031000,38056000,",
	"37056000,37029000,37011000,595060000,595014000,595030000,595004000,595005000,",
	"36043000,36023000,64030000,64052000,64058000,65070000,",
	"41001000,",
	"42046000,42029000,42023000,42056000,27043000,59045000,60044000,60017000,",
	"41029000,42045000,43043000,45046000,80044000,",
	"42044000,44046000,45043000,",
	"43043000,48030000,50046000,82045000,",
	"42044000,43045000,46043000,47046000,87029000,87030000,",
	"45044000,45011000,",
	"45043000,45011000,",
	"44029000,44011000,",
	"50043000,51044000,",
	"44043000,49044000,51030000,52046000,",
	"49044000,50029000,52043000,53046000,",
	"50044000,51043000,52046000,53029000,55045000,86030000,",
	"51044000,52045000,54046000,",
	"53044000,53011000,",
	"52044000,55045000,56030000,57043000,",
	"55029000,55011000,",
	"13030000,13056000,55044000,58046000,83045000,84043000,",
	"57043000,57011000,",
	"27001000,",
	"41043000,41029000,41017000,61044000,62045000,62030000,62052000,",
	"60043000,62045000,107046100,",
	"60044000,63045000,30043000,61046000,",
	"62046000,62011000,",
	"39029000,39056000,39059000,65044000,65070000,103045000,103074000,106043000,",
	"64043000,66044000,556046080,68061000,556029080,70029050,39029000,556045060,72045075,71045000,556030080,106030000,",
	"65047000,67044000,556046080,77025000,96043000,556050050,97072000,",
	"66043000,23044000,23042000,24030000,24031000,",
	"23046000,69029000,69056000,65045000,",
	"68030000,68061000,120046331,119046000,109045000,113075000,",
	"71045000,65030000,65023000,111046000,",
	"65048000,70046000,110045000,",
	"65070000,118049000,73045000,97048000,97072000,",
	"72046000,72017000,72011000,",
	"19043000,120044331,121044000,75030000,",
	"76046000,77045000,",
	"75045000,",
	"75043000,78044000,66045000,66017000,",
	"77046000,",
	"3001000,",
	"42045000,80044000,80046000,81043000,",
	"80044000,80011000,",
	"44046000,44011000,",
	"57046000,84043000,85044000,",
	"57045000,83044000,114050000,",
	"83043000,83011000,",
	"52029000,52011000,",
	"45029000,45030000,",
	"25030000,25056000,25043000,20039000,92044000,92027000,",
	"25001000,",
	"23001000,",
	"95045000,95073000,95023000,72030000,72056000,",
	"88046000,93043000,94045000,",
	"92046000,92027000,92011000,",
	"92046000,92027000,92023000,95045309,95003309,95073309,611045000,",
	"94046000,94011000,92027000,91044000,",
	"66044000,66011000,",
	"66048000,72044000,72017000,98029000,98045000,98073000,",
	"97046000,97072000,99044000,",
	"98050000,98073000,301043000,301023000,100043000,",
	"301044000,301023000,301011000,99044000,302071159,33071000,101047000,101022000,",
	"100046000,100071000,100011000,",
	"103030000,103074000,103011000,",
	"102029000,102038000,104030000,618046114,619046115,64046000,",
	"103029000,103074000,105030000,",
	"104029000,104011000,103074000,",
	"64029000,65044000,108043000,",
	"131046000,132049000,133047000,134048000,135029000,136050000,137043000,138044000,139045000,61030000,",
	"556043095,556045095,556046095,556047095,556048095,556049095,556050095,556029095,556030095,106043000,626044000,",
	"69046000,113045000,113075000,",
	"71044000,20039000,",
	"70045000,50030040,50039040,50056040,53030050,45030000,",
	"131049000,132045000,133043000,134050000,135048000,136047000,137044000,138030000,139029000,140046000,",
	"109046000,109011000,109109000,",
	"84048000,",
	"116049000,",
	"115047000,593030000,",
	"118049000,660041233,660042233,660069233,660047233,661041332,303041000,21039332,596039000,",
	"72030000,117029000,",
	"69045000,69011000,653043000,65307000,",
	"69045000,74043000,",
	"74043000,74011000,653045000,653007000,",
	"123047000,660041233,660042233,660069233,660049233,303041000,596039000,124077000,126028000,129040000,",
	"122044000,124043000,124077000,126028000,129040000,",
	"123044000,125047000,125036000,128048000,128037000,128030000,126028000,129040000,",
	"124046000,124077000,126045000,126028000,127043000,127017000,",
	"125046000,125023000,125011000,124077000,610030000,610039000,",
	"125044000,125011000,125017000,124077000,126028000,",
	"124045000,124029000,124077000,129046000,129030000,129040000,126028000,",
	"128044000,128029000,124077000,130043000,130019000,130040000,130003000,126028000,",
	"129044000,124077000,126028000,",
	"107044000,132048000,133050000,134049000,135047000,136029000,137030000,138045000,139046000,112043000,",
	"107050000,131029000,133045000,134046000,135044000,136049000,137047000,138043000,139030000,112048000,",
	"107029000,131030000,132044000,134047000,135049000,136043000,137045000,138050000,139048000,112046000,",
	"107047000,131045000,132050000,133048000,135043000,136030000,137046000,138029000,139044000,112049000,",
	"107045000,131048000,132030000,133046000,134043000,136044000,137049000,138047000,139050000,112029000,",
	"107043000,131044000,132029000,133049000,134030000,135046000,137050000,138048000,139047000,112045000,",
	"107048000,131047000,132046000,133030000,134029000,135050000,136045000,138049000,139043000,112044000,",
	"107030000,131043000,132047000,133029000,134044000,135045000,136046000,137048000,139049000,112050000,",
	"107049000,131050000,132043000,133044000,134045000,135030000,136048000,137029000,138046000,112047000,",
	"112045000,112011000,"
	};

var caveend: [uint8][] :=
	{
	"000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,000,",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	"6000,6000,7000,8000,4000,0000,0000,5000,9150,1150,4150,5150,3150,3150,9000,5000,",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	",",
	","
	};

#	Routine to fill travel array for a given location
sub gettrav(loc: uint8) @extern("gettrav") is
	var	i: uint8;
	var	t: int32;
	var	p1: [uint8];
	var	q1: [uint8];
	var	p2: [uint8];
	var	q2: [uint8];
	var	buf1: uint8[256];
	var	buf2: uint8[256];
	var	aptr: [uint8];
	var	atrav: uint8[256];
	var	hasend: uint8 := 1;

	dummy := strcpy(&buf1[0], cave[loc - 1]);
	p1 := &buf1[0];

	dummy := strcpy(&buf2[0], caveend[loc - 1]);
	p2 := &buf2[0];

	if [p2] == ',' then
		hasend := 0;
	end if;

	aptr := &atrav[0];

	q1 := strchr(p1, ',');
	while q1 != nil loop
		[q1] := 0;
		dummy := strcpy(aptr, p1);
		p1 := q1 + 1;

		if hasend == 1 then
			q2 := strchr(p2, ',');
			[q2] := 0;
			dummy := strcat(aptr, p2);
			p2 := q2 + 1;
		end if;

		q1 := strchr(p1, ',');
		#print(aptr); print_nl();
		aptr := aptr + strlen(aptr) + 1;
	end loop;
	[aptr] := 0;		

	aptr := &atrav[0];

	i := 0;
	while i < MAXTRAV loop
		t := atol(aptr); 	# convert to long int
		travel[i].tcond := (t % 1000) as int16;
		t := t / 1000;
		travel[i].tverb := (t % 1000) as int16;
		t := t / 1000;
		travel[i].tdest := (t % 1000) as int16;

		aptr := aptr + strlen(aptr) + 1;

		if [aptr] == 0 then
			i := i + 1;
		    	travel[i].tdest := -1;	# end of array
		    	if get_dbugflg() == 1 then
				i := 0;
				while travel[i].tdest != -1 loop
					print("cave[");
					print(itoa(loc as int16));
					print("] = ");
					print(itoa(travel[i].tdest));
					print_char(' ');
					print(itoa(travel[i].tverb));
					print_char(' ');
					print(itoa(travel[i].tcond));
					print_nl();
					i := i + 1;
				end loop;
			end if;
		    	return;
		end if;
		i := i + 1;
	end loop;
	bug(33);
end sub;

#	Routine to figure out a new location
#	given current location and a motion.
sub dotrav(loc: int16, motion: int16, verb:int16) @extern("dotrav") is
	var	mvflag: uint8;
	var	hitflag: uint8;
	var	kk: uint8;
	var	rdest: int16;
	var	rverb: int16;
	var	rcond: int16;
	var	robject: int16;
	var	pctt: uint16;

	set_newloc(loc);
	mvflag := 0;
	hitflag := 0;
	pctt := xrnd() % 100;

	kk := 0;
	while travel[kk].tdest >= 0 and mvflag == 0 loop
		rdest := travel[kk].tdest;
		rverb := travel[kk].tverb;
		rcond := travel[kk].tcond;
		robject := rcond % 100;

		if get_dbugflg() == 1 then
			print("rdest = ");
			print(itoa(rdest));
			print(", rverb = ");
			print(itoa(rverb));
			print(", rcond = ");
			print(itoa(rcond));
			print(", robject = ");
			print(itoa(robject));
			print(" in dotrav\n");
		end if;

		if rverb != 1 and rverb != motion and hitflag == 0 then
			kk := kk + 1;
			continue;
		end if;

		hitflag := hitflag + 1;

		var r := rcond;
		r := r / 100;
		if r == 3 or r == 4 or r == 5 then r := 7; end if;
		case r is
		when 0:
			if rcond == 0 or pctt < rcond as uint16 then
				mvflag := mvflag + 1;
			end if;
			if rcond == 1 and get_dbugflg() == 1 then
				print("%% move ");
				print(itoa(pctt as int16));
				print_char(' ');
				print(itoa(mvflag as int16));
				print_nl();
			end if;
		when 1:
			if robject == 0 or toting(robject as uint16) == 1 then
				mvflag := mvflag + 1;
			end if;
		when 2:
			if toting(robject as uint16) == 1 or at(robject as uint16) == 1 then
				mvflag := mvflag + 1;
			end if;
		#when 3:
		#when 4:
		#when 5:
		when 7:
			if get_prop(robject as uint8) != (rcond/100)-3 then
				mvflag := mvflag + 1;
			end if;
		when else:
			bug(37);
		end case;
		kk := kk + 1;
	end loop;

	if mvflag == 0 then
		badmove(motion, verb);
	elseif rdest > 500 then
		rspeak((rdest-500) as uint8);
	elseif rdest>300 then
		spcmove(rdest as uint16);
	else 
		set_newloc(rdest);
		if get_dbugflg() == 1 then
			print("newloc in dotrav = ");
			print(itoa(rdest)); #newloc
			print_nl();
		end if;
	end if;
end sub;

#	Routine to copy a travel array
sub copytrv(trav1: [trav], trav2: [trav]) is
	var	i: uint8;

	i := 0;
	while i < MAXTRAV loop
		[trav2].tdest := [trav1].tdest;
		[trav2].tverb := [trav1].tverb;
		[trav2].tcond := [trav1].tcond;
		trav1 := @next trav1;
		trav2 := @next trav2;
		i := i + 1;
	end loop;
end sub;

#	Routine to handle request to return
#	from whence we came!
sub goback(loc: int16, oldloc: int16, oldloc2: int16, verb: int16) @extern("goback") is
	var	kk: uint8;
	var	k2: uint8;
	var	want: int16;
	var	temp: int16;
	var 	strav: trav[MAXTRAV];

	if forced(oldloc as uint16) == 1 then
		want := oldloc2;
	else
		want := oldloc;
	end if;
	set_oldloc2(oldloc);
	oldloc2 := oldloc;
	set_oldloc(loc);
	oldloc := loc;
	k2 := 0;
	if want == loc then
		rspeak(91);
		return;
	end if;
	copytrv(&travel[0], &strav[0]);
	kk := 0;
	while travel[kk].tdest != 0xFFFF loop
		if travel[kk].tcond == 0 and travel[kk].tdest == want then
			set_motion(travel[kk].tverb);
			dotrav(loc, travel[kk].tverb, verb);
			return;
		end if;
		if travel[kk].tcond == 0 then
			k2 := kk;
			temp := travel[kk].tdest;
			gettrav(temp as uint8);
			if forced(temp as uint16) == 1 and travel[0].tdest == want then
				k2 := temp as uint8;
			end if;
			copytrv(&strav[0], &travel[0]);
		end if;
		kk := kk + 1;
	end loop;
	if k2 > 0 then
		set_motion(travel[k2].tverb);
		dotrav(loc, travel[k2].tverb, verb);
	else
		rspeak(140);
	end if;
end sub;