Source Code 1994 March/Source_Code_CD-ROM_Walnut_Creek_March_1994.iso/compsrcs/games/vmsnet/ayo/part01

Text File | 1992-07-15 | 14.4 KB | 509 lines

Path: uunet!wupost!uwm.edu!ux1.cso.uiuc.edu!umn.edu!news.cs.indiana.edu!bsu-cs!bsu-ucs.uucp!00mjstum
From: [e-mail] (Matthew J. Stum)
Newsgroups: vmsnet.sources.games
Subject: AYO, part 001 OF 002
Message-ID: <[e-mail]>
Date: 16 Jul 92 15:35:55 GMT
Lines: 500

$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-010  25-Jun-1992
$!   On 16-JUL-1992 10:31:19.73   By user 00MJSTUM (Matthew J. Stum)
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$!+ THIS PACKAGE DISTRIBUTED IN 2 PARTS, TO KEEP EACH PART
$!  BELOW 30 BLOCKS
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. AYO.DOC;1
$!       2. AYO.PAS;3
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ x = P1 - f$parse(P1,,,"version")
$ y = f$search(x)
$ if y .eqs. "" then $ goto file_absent
$ x = f$integer(f$parse(P1,,,"version")-";")
$ y = f$integer(f$parse(y,,,"version")-";")
$ if x .gt. y then $ goto file_absent
$ if f$mode() .eqs. "INTERACTIVE" then $ goto file_interactive
$ if x .eq. y then e "-W-EXISTS, File ''P1' exists. Skipped."
$ if x .ne. y then e "-W-NEWERVERSION, of File ''P1' exists. Skipped."
$file_delete:
$ delete 'f'*
$ exit
$file_interactive:
$ if x .eq. y then e "-W-EXISTS, File ''P1' exists."
$ if x .ne. y then e "-W-NEWERVERSION, of File ''P1' exists."
$ read/error=file_delete/end=file_delete-
  /prompt="Create new version [y/n]: " -
  sys$command x
$ if .not. x then $ e "-W-SKIPPED, File ''P1' skipped."
$ if .not. x then $ goto file_delete
$ P1 = P1 - f$parse(P1,,,"version")
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
"output_file"));ENDPROCEDURE;Unpacker;QUIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create 'f'
XAYO - West African game of strategy
X
X* Instructions for compiling:
X
X  You will need a Pascal compiler as well as the
X  SYS$LIBRARY:PASCAL$LIB_ROUTINES.PEN environment file.
X
X  $ PAS AYO.PAS
X  $ LINK AYO.OBJ
X  $ RUN AYO
X
X* Game information and instructions:
X
X  Background and instructions are available at the main menu.
X
X
XMatt Stum
[e-mail]
$ CALL UNPACK AYO.DOC;1 1198855459
$ create 'f'
X`7B
X`09Title:   AYO - West African game of strategy
X`09Author:  Matthew J. Stum
X`09Address: [e-mail]
X`7D
X
X`5Binherit ('sys$library:starlet','sys$library:pascal$lib_routines')`5D
Xprogram ayo(input,output,logfile);
X
Xconst
X`09esc = chr(27);
X`09rv = esc+'`5B7m';
X`09norm = esc+'`5B0m';
X`09p1 = rv;
X`09p2 = norm;
X`09func = io$_readvblk+io$m_noecho;
X
Xtype
X`09v4string = varying `5B4`5D of char;
X`09v8string = varying `5B8`5D of char;
X`09pocket_type = array `5B'a'..'l'`5D of integer;
X
Xvar
X`09logfile:text;
X`09logging:boolean;
X`09stat:unsigned;
X`09iochan:`5Bword`5D0..65355;
X`09pocket:array `5B'a'..'l'`5D of integer;
X`09owner:array `5B'a'..'l'`5D of v4string;
X`09loc,loc2:array `5B'a'..'l'`5D of v8string;
X`09hand,comp:integer;
X`09comp_start:char;
X`09done,
X`09really_done:boolean;
X`09pocket_choice,
X`09final_pocket:char;
X`09player:v4string;
X`09game:integer;
X`09difficulty_level:integer;
X`09tm:packed array `5B1..11`5D of char;
X`09key,choice:char;
X`09i:integer;
X
Xprocedure logit(scores:pocket_type; choice:char);
Xvar   i:char;
Xbegin
X`09open(file_variable:=logfile,file_name:='ayo.log',
X`09`09history:=unknown);
X`09extend(logfile);
X`09for i:='a' to 'l' do
X`09   begin
X`09`09write(logfile,i,pocket`5Bi`5D:5,'   ');
X`09   end;
X`09writeln(logfile);
X`09for i:='a' to 'l' do
X`09   begin
X`09`09write(logfile,i,scores`5Bi`5D:5,'   ');
X`09   end;
X`09writeln(logfile);
X`09writeln(logfile,'Choice: ',choice);
X`09writeln(logfile);
X`09close(logfile);
Xend;
X
Xprocedure set_ownership;
Xvar i:char;
Xbegin
X`09for i:='a' to pred(comp_start) do
X`09`09owner`5Bi`5D:=esc+'`5B7m';
X`09for i:=comp_start to 'l' do
X`09`09owner`5Bi`5D:=esc+'`5B0m';
Xend;
X
Xprocedure init_pockets;
Xvar i:char;
Xbegin
X`09hand:=0;
X`09comp:=0;
X`09for i:='a' to 'l' do
X`09`09pocket`5Bi`5D:=4;
Xend;
X
Xprocedure init_loc;
Xvar i:char;
Xbegin
X`09for i:='a' to 'f' do
X`09   begin
X`09`09writev(loc`5Bi`5D,esc,'`5B',12:1,';',24+(ord(i)-ord('a'))*6:1,'H');
X`09`09writev(loc2`5Bi`5D,esc,'`5B',14:1,';',25+(ord(i)-ord('a'))*6:1,'H');
X`09   end;
X`09for i:='g' to 'l' do
X`09   begin
X`09`09writev(loc`5Bi`5D,esc,'`5B',9:1,';',24+(ord('l')-ord(i))*6:1,'H');
X`09`09writev(loc2`5Bi`5D,esc,'`5B',7:1,';',25+(ord('l')-ord(i))*6:1,'H');
X`09   end;
Xend;
X
Xprocedure show_seeds;
Xvar i:char;
Xbegin
X`09for i:='l' downto 'g' do
X`09 `09writeln(loc`5Bi`5D,owner`5Bi`5D,pocket`5Bi`5D:2,norm);
X`09for i:='a' to 'f' do
X`09 `09writeln(loc`5Bi`5D,owner`5Bi`5D,pocket`5Bi`5D:2,norm);
Xend;
X
Xprocedure show_captured;
Xbegin
X`09writeln(esc,'`5B16;25HSeeds Captured:');
X`09writeln(esc,'`5B17;27H     You: ',hand:2);
X`09writeln(esc,'`5B18;27HComputer: ',comp:2);
Xend;
X
Xprocedure show_last_game;
Xbegin
X`09writeln(esc,'`5B10;1HLast Round (#',game-1:1,'): ');
X`09writeln('       You: ',hand:2);
X`09writeln('  Computer: ',48-hand:2);
Xend;
X
Xprocedure redraw;
Xbegin
X`09write(esc,'`5B2J');
X`09writeln(rv,esc,'`5B2;35H         ',norm,'\');
X`09writeln(rv,esc,'`5B3;35H  A Y O  ',norm,' `7C');
X`09writeln(rv,esc,'`5B4;35H         ',norm,' `7C');
X`09writeln(   esc,'`5B5;35H\________\`7C');
X`09writeln(esc,'`5B5;66HLevel: ',(difficulty_level) div 2:1);
X`09if player=p1 then
X`09`09writeln(esc,'`5B6;65HFirst: You')
X`09   else
X`09`09writeln(esc,'`5B6;63HFirst: Computer');
X`09writeln( esc,'`5B7;22H   L     K     J     I     H     G');
X`09writeln( esc,'`5B8;22H/----\/----\/----\/----\/----\/----\     Ctrl-W = R
Vedraw');
X`09writeln( esc,'`5B9;22H`7C    `7C`7C    `7C`7C    `7C`7C    `7C`7C    `7C`
V7C    `7C       the screen.');
X`09writeln(esc,'`5B10;22H\----/\----/\----/\----/\----/\----/');
X`09writeln(esc,'`5B11;22H/----\/----\/----\/----\/----\/----\        Q = Qui
Vt.');
X`09writeln(esc,'`5B12;22H`7C    `7C`7C    `7C`7C    `7C`7C    `7C`7C    `7C`
V7C    `7C');
X`09writeln(esc,'`5B13;22H\----/\----/\----/\----/\----/\----/        M = Ans
Vwer');
X`09writeln(esc,'`5B14;22H   A     B     C     D     E     F          your ma
Vil.');
X`09show_seeds;
X`09show_captured;
X`09if game>1 then show_last_game;
Xend;
X
Xprocedure move_seeds(pkt:char; var final:char);
Xvar i,j:integer;
Xbegin
X`09j:=pocket`5Bpkt`5D;
X`09pocket`5Bpkt`5D:=0;
X`09writeln(loc`5Bpkt`5D,owner`5Bpkt`5D,pocket`5Bpkt`5D:2,norm);
X`09writeln(rv,loc2`5Bpkt`5D,chr(ord(pkt)-ord('a')+ord('A')),norm);
X`09writeln(loc2`5Bpkt`5D,chr(ord(pkt)-ord('a')+ord('A')));
X`09for i:=1 to j do
X`09   begin
X`09`09pkt:=succ(pkt);
X`09`09if pkt>'l' then pkt:='a';
X`09`09pocket`5Bpkt`5D:=pocket`5Bpkt`5D+1;
X`09`09writeln(loc`5Bpkt`5D,owner`5Bpkt`5D,pocket`5Bpkt`5D:2,norm);
X`09`09writeln(rv,loc2`5Bpkt`5D,chr(ord(pkt)-ord('a')+ord('A')),norm);
X`09`09writeln(loc2`5Bpkt`5D,chr(ord(pkt)-ord('a')+ord('A')));
X`09   end;
X`09final:=pkt;
Xend;
X
Xprocedure capture(player:v4string; pkt:char);
Xvar temp:integer;
Xbegin
X`09temp:=0;
X`09while (pocket`5Bpkt`5D in `5B2,3`5D) do
X`09   begin
X`09`09temp:=temp+pocket`5Bpkt`5D;
X`09`09pocket`5Bpkt`5D:=0;
X`09`09writeln(loc`5Bpkt`5D,owner`5Bpkt`5D,pocket`5Bpkt`5D:2,norm);
X`09`09writeln(rv,loc2`5Bpkt`5D,chr(ord(pkt)-ord('a')+ord('A')),norm);
X`09`09writeln(loc2`5Bpkt`5D,chr(ord(pkt)-ord('a')+ord('A')));
X`09`09pkt:=pred(pkt);
X`09`09if pkt<'a' then pkt:='l';
X`09   end;
X`09if player=p1 then
X`09   begin
X`09`09hand:=hand+temp;
X`09`09show_captured;
X`09   end
X`09  else
X`09   begin
X`09`09comp:=comp+temp;
X`09`09show_captured;
X`09   end;
Xend;
X
Xprocedure get_player_choice(var pkt:char);
Xvar valid:boolean;
Xbegin
X`09valid:=false;
X`09repeat
X`09   repeat
X`09`09stat:=$qiow(chan:=iochan,func:=func,p1:=pkt,
X`09`09`09p2:=1);
X`09`09case pkt of
X`09`09chr(23):redraw;
X`09`09end; (*case*)
X`09   until pkt in `5B'a'..'m','A'..'M','q','Q'`5D;
X`09   if pkt in `5B'A'..'L'`5D then
X`09`09pkt := chr(ord(pkt)-ord('A')+ord('a'));
X`09   if pkt in `5B'q','Q'`5D then
X`09`09valid:=true
X`09     else
X`09   if pkt in `5B'm','M'`5D then
X`09      begin
X`09`09writeln(esc,'`5B2J',esc,'`5B1;1HEntering Mail...');
X`09`09lib$spawn('Mail');
X`09`09redraw;
X`09      end
X`09     else
X`09   if (owner`5Bpkt`5D=player)and(pocket`5Bpkt`5D>0) then
X`09`09valid:=true;
X`09until valid;
Xend;
X
Xfunction evaluate_move(pkt:char; pocket:pocket_type; level:integer):integer;
Xvar scores:pocket_type; top:integer; temp:char;
X    i,j,score:integer;
Xbegin
X`09score:=0;
X`09j:=pocket`5Bpkt`5D;
X`09pocket`5Bpkt`5D:=0;
X`09for i:=1 to j do
X`09   begin
X`09`09pkt:=succ(pkt);
X`09`09if pkt>'l' then pkt:='a';
X`09`09pocket`5Bpkt`5D:=pocket`5Bpkt`5D+1;
X`09   end;
X`09while (pocket`5Bpkt`5D in `5B2,3`5D) do
X`09   begin
X`09`09if odd(level) then
X`09`09`09score:=score+pocket`5Bpkt`5D
X`09`09   else
X`09`09`09score:=score-pocket`5Bpkt`5D;
X`09`09pocket`5Bpkt`5D:=0;
X`09`09pkt:=pred(pkt);
X`09`09if pkt<'a' then pkt:='l';
X`09   end;
X`09if level=difficulty_level then evaluate_move:=score
X`09  else
X`09if odd(level) then
X`09   begin
X`09`09for temp:='a' to 'l' do
X`09`09`09scores`5Btemp`5D:=50*(10-level);
X`09`09temp:='a';
X`09`09while temp<=pred(comp_start) do
X`09`09   begin
X`09`09`09if pocket`5Btemp`5D>0 then
X`09`09`09`09scores`5Btemp`5D:=evaluate_move(temp,pocket,level+1);
X`09`09`09temp:=succ(temp);
X`09`09   end;
X`09`09temp:='a';
X`09`09top:=999;
X`09`09while temp<=pred(comp_start) do
X`09`09   begin
X`09`09`09if scores`5Btemp`5D<top then
X`09`09`09   begin
X`09`09`09`09top:=scores`5Btemp`5D;
X`09`09`09`09pkt:=temp;
X`09`09`09   end;
X`09`09`09temp:=succ(temp);
X`09`09   end;
X`09   end
X`09  else
X`09   begin
X`09`09for temp:='a' to 'l' do
X`09`09`09scores`5Btemp`5D:=-51;
X`09`09temp:=comp_start;
X`09`09while temp<='l' do
X`09`09   begin
X`09`09`09if pocket`5Btemp`5D>0 then
X`09`09`09`09scores`5Btemp`5D:=evaluate_move(temp,pocket,level+1);
X`09`09`09temp:=succ(temp);
X`09`09   end;
X`09`09temp:=comp_start;
X`09`09top:=-999;
X`09`09while temp<='l' do
X`09`09   begin
X`09`09`09if scores`5Btemp`5D>top then
X`09`09`09   begin
X`09`09`09`09top:=scores`5Btemp`5D;
X`09`09`09`09pkt:=temp;
X`09`09`09   end;
X`09`09`09temp:=succ(temp);
X`09`09   end;
X`09   end;
X`09evaluate_move:=score+top;
Xend;
X
Xprocedure get_computer_choice(var pkt:char);
Xvar score:pocket_type; top:integer; temp:char; pkt2:char;
Xbegin
X`09writeln(esc,'`5B19;1HThinking...');
X`09for temp:='a' to 'l' do
X`09`09score`5Btemp`5D:=-9999;
X`09temp:=comp_start;
X`09while temp<='l' do
X`09   begin
X`09`09if pocket`5Btemp`5D>0 then
X`09`09`09score`5Btemp`5D:=evaluate_move(temp,pocket,1);
X`09`09temp:=succ(temp);
X`09   end;
X`09temp:=comp_start;
X`09top:=-9999;
X`09pkt2:=' ';
X`09pkt:=' ';
X`09while temp<='l' do
X`09   begin
X`09`09if pocket`5Btemp`5D>0 then
X`09`09`09if score`5Btemp`5D>top then
X`09`09`09   begin
X`09`09`09`09top:=score`5Btemp`5D;
X`09`09`09`09pkt2:=pkt;
X`09`09`09`09pkt:=temp;
X`09`09`09   end;
X`09`09temp:=succ(temp);
X`09   end;
X`09time(tm);
X`09if tm`5B11`5D in `5B'0'`5D then
X`09   if pkt2<>' ' then pkt:=pkt2;
X`09if logging then logit(score,pkt);
X`09writeln(esc,'`5B19;1H           ');
Xend;
X
Xprocedure are_we_done(player:v4string; var done:boolean);
Xvar i:char;
Xbegin
X`09done:=true;
X`09for i:='a' to 'l' do
X`09  if (pocket`5Bi`5D>0)and(owner`5Bi`5D=player) then done:=false;
Xend;
X
Xprocedure divy_up(var comp_start:char);
Xvar i:char;
Xbegin
X`09`09for i:='a' to pred(comp_start) do
X`09`09  begin
X`09`09   hand:=hand+pocket`5Bi`5D;
X`09`09  end;
X`09`09i:=chr(ord('a')+(hand div 4));
X`09`09case (hand mod 4) of
X`09`09   0,1: comp_start:=i;
X`09`09     3: begin
X`09`09`09owner`5Bi`5D:=p1;
X`09`09`09comp_start:=succ(i)
X`09`09`09end;
X`09`09     2: if owner`5Bi`5D=p1 then
X`09`09`09`09comp_start:=succ(i)
X`09`09`09   else
X`09`09`09`09comp_start:=i;
X`09`09`09end; (*case*)
X`09`09game:=game+1;
X`09`09show_last_game;
Xend;
X
Xprocedure play_the_game;
Xbegin
X`09comp_start:='g';
X`09game:=1;
X`09init_loc;
X`09set_ownership;
X`09init_pockets;
X`09redraw;
X`09really_done:=false;
X`09repeat
X`09`09repeat
X`09`09`09if player=p1 then
X`09`09`09   get_player_choice(pocket_choice)
X`09`09`09  else
X`09`09`09   get_computer_choice(pocket_choice);
X`09`09`09if not(pocket_choice in `5B'q','Q'`5D) then
X`09`09`09   begin
X`09`09`09`09move_seeds(pocket_choice,final_pocket);
X`09`09`09`09capture(player,final_pocket);
X`09`09`09`09if player=p1 then player:=p2 else player:=p1;
X`09`09`09`09are_we_done(player,done);
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-
--
Matt Stum                    Gwydion ap Myrddin       Ball State University
[e-mail]   Shire of Afonlyn, MK     Muncie, IN  USA