-+-+-+-+-+-+-+-+ START OF PART 3 -+-+-+-+-+-+-+-+
X if (xstr.length = 1) then
X smg$put_chars(disp`5B1`5D,'YARDS TO GO: '+xstr,4,60)
X else
X smg$put_chars(disp`5B1`5D,'YARDS TO GO: '+xstr,4,60);
X statistic('YARDS GAINED: ',4);
X showdown;
Xend;
X
Xprocedure receiveplay;
Xbegin
X repeat
X kbf := iaddress(you.userid);
X ubf := iaddress(you);
X rmsstatus := rms_get(pas$rab(playfile)`5E,false);
X if (not(odd(rmsstatus))) then lib$signal(rmsstatus);
X if (not(pid_check(you.pid))) then begin
X mestart := true;
X finitiate;
X lib$signal(iaddress(football_ghosted));
X end;
X lib$wait(0.4);
X until (me.count < you.count);
X kbf := iaddress(me.userid);
X ubf := iaddress(me);
X rmsstatus := rms_get(pas$rab(playfile)`5E,true);
X if (not(odd(rmsstatus))) then lib$signal(rmsstatus);
X me.count := you.count;
X rmsstatus := rms_update(pas$rab(playfile)`5E);
X if (not(odd(rmsstatus))) then lib$signal(rmsstatus); `20
Xend;
X
Xprocedure sendplay;
Xvar
X now : datetime;
Xbegin
X kbf := iaddress(you.userid);
X ubf := iaddress(you);
X repeat
X rmsstatus := rms_get(pas$rab(playfile)`5E,false);
X until (rmsstatus <> rms$_busy);
X if (not(odd(rmsstatus))) then lib$signal(rmsstatus);
X kbf := iaddress(me.userid);
X ubf := iaddress(me);
X repeat
X rmsstatus := rms_get(pas$rab(playfile)`5E,true);
X until (rmsstatus <> rms$_busy);
X if (not(odd(rmsstatus))) then lib$signal(rmsstatus);
X me.formation := myform;
X me.play := myact;
X me.pos := where;
X me.count := you.count + 1;
X me.time := gtime;
X me.gained := stat;
X me.quarter := quarter;
X me.down := down;
X me.dir := dir;
X me.ydstogo := ydstogo;
X me.dokickoff := dokickoff;
X me.score := score;
X me.intercepted := interception;
X me.fumble := fumble;
X rmsstatus := rms_update(pas$rab(playfile)`5E);
X if (not(odd(rmsstatus))) then lib$signal(rmsstatus);
Xend;
X
Xprocedure timer (lost: integer);
Xbegin
X if (not(newquarter)) and (not(newhalf)) and (not(gameover)) then begin
X lost := lost * huddle;
X if (mestart) then begin
X gtime := gtime - lost;
X if (gtime < 0) then begin
X gtime := gametime;
X quarter := quarter + 1;
X newquarter := true;
X if (quarter = 3) then
X newhalf := true
X else if (quarter = 5) then
X gameover := true;
X end;
X sendplay;
X receiveplay;
X end else begin
X receiveplay;
X sendplay;
X gtime := you.time;
X if (quarter < you.quarter) then begin
X quarter := you.quarter;
X newquarter := true;
X if (quarter = 3) then
X newhalf := true
X else if (quarter = 5) then
X gameover := true;
X end;
X end;
X end;
Xend;
X
Xprocedure moveball (fromspot, tospot : integer);
Xbegin
X if (tospot > fromspot) then
X for i := fromspot to tospot - 1 do begin
X restore(i);
X place(i+1);
X end
X else
X for i := fromspot downto tospot + 1 do begin
X restore(i);
X place(i-1);
X end;
Xend;
X
Xprocedure runplay;
Xvar
X mag : integer;
X outstr : string;
X completepass : boolean := false;
Xbegin
X if (mestart) then begin (* run the play *)
X xlen := trim(dp_table`5Byou.play`5D,playstr);
X info('The defense ran a '+substr(playstr,1,xlen)+'! ');
X mag := roll_play(me.formation, me.play, you.formation, you.play);
X if ispass(me.play) then begin
X if (mag < 0) then begin
X stat := mag;
X info('You are sacked for a big loss! ');
X end else if (isdeeppass(me.play)) then begin
X if passing then
X completepass := (rnd(100) > 60)
X else
X completepass := (rnd(100) > 70);
X if completepass then begin
X if (rnd(100) <= 15) then interception := true;
X stat := 10+mag*rnd(6);
X if (not(interception)) then
X info('You complete the long bomb for big yardage! ');
X end else
X stat := 0;
X end else if (iseasypass(me.play)) then begin
X if passing then
X completepass := (rnd(100) > 20)
X else
X completepass := (rnd(100) > 25);
X if completepass then begin
X if (rnd(100) <= 5) then interception := true;
X stat := rnd(mag)*rnd(2) + 1;
X if (not(interception)) then
X info('You completed the pass! ');
X end else
X stat := 0;
X end else begin
X if passing then
X completepass := (rnd(100) > 40)
X else
X completepass := (rnd(100) > 50);
X if completepass then begin
X if (rnd(100) <= 8) then interception := true;
X stat := rnd(mag)*rnd(4) + 1;
X if (not(interception)) then
X info('You completed the pass! ');
X end else
X stat := 0;
X end;
X if (stat = 0) and (not(interception)) then
X info('The pass was incomplete. ');
X end else begin
X if (rnd(100) <= 5) then fumble := true;
X if running then
X stat := rnd(mag+5) - 1
X else
X stat := rnd(mag+4) - 2;
X if (not(fumble)) then begin
X if (stat <= 1) then
X info('You were stopped cold! ')
X else if (stat >= 6) then
X info('You blew away the defense! ')
X else
X info('You ran into the defensive front! ');
X end;
X end;
X old_where := where;
X if (dir) then
X where := where + stat
X else
X where := where - stat;
X moveball(old_where, where); (* old_where and where is handled here *)
X
X if (interception) then info('The ball was intercepted!');
X if (fumble) then info('The runningback fumbled the ball!');
X
X if (not(fumble)) and (not(interception)) then begin
X
X (* are we in end zone? *)
X`20
X if (((dir) and (where >= 100)) or
X (not(dir) and (where <= 0))) then
X score := 7
X else if (((dir) and (where <= 0)) or
X (not(dir) and (where >= 100))) then (* Safety! *)
X score := -2
X
X (* we only care about downs when there is no score! *)
X
X else begin`20
X if (ydstogo <= stat) then begin
X down := 1;
X ydstogo := 10;
X comment('FIRST DOWN!');
X end else begin
X down := down + 1;
X ydstogo := ydstogo - stat;
X end;
X end;
X end else begin
X down := 1;
X ydstogo := 10;
X if (interception) then comment('INTERCEPTION!');
X if (fumble) then comment('FUMBLE!');
X dir := not(dir);
X turnover;
X end;
X statcard;
X sendplay;
X receiveplay;
X end
X else begin (* not mestart *)
X receiveplay;
X sendplay;
X stat := you.gained;
X interception := you.intercepted;
X fumble := you.fumble;
X xlen := trim(op_table`5Byou.play`5D,playstr);
X info('The offense ran a '+substr(playstr,1,xlen)+'! ');
X
X if (not(fumble)) and (not(interception)) then begin
X if ispass(you.play) then begin
X if (stat < 0) then
X info('You sacked the quarterback for a big loss! ')
X else if (isdeeppass(you.play)) then begin
X if (stat > 0) then
X info('The receiver snags the long bomb! Completed pass! ');
X end else begin
X if (stat > 0) then
X info('The pass was complete! ');
X end;
X if (stat = 0) then
X info('The pass was incomplete. ');
X end else begin
X if (stat <= 1) then
X info('You stopped them cold! ')
X else if (stat >= 6) then
X info('The offensive line blew you away! ')
X else
X info('The defensive front contained the running back! ');
X end;
X end else begin
X if (interception) then info('The ball was intercepted!');
X if (fumble) then info('The runningback fumbled the ball!');
X end;
X
X old_where := where;
X where := you.pos;
X moveball(old_where, where); (* old_where and where is handled here *)
X
X if (fumble) or (interception) then begin
X down := 1;
X ydstogo := 10;
X if (interception) then comment('INTERCEPTION!');
X if (fumble) then comment('FUMBLE!');
X dir := not(dir);
X turnover;
X end;
X
X score := you.score;
X down := you.down;
X ydstogo := you.ydstogo;
X statcard;
X end;
Xend;
X
Xprocedure handlescore;
Xbegin
X if (mestart) then begin (* Any Score? *)
X if (score <> 0) then begin
X old_where := where;
X if (score = 7) then begin
X if (dir) then
X where := 35
X else
X where := 65;
X myscore := myscore + 7;
X comment('TOUCHDOWN!');
X end else if (score = -2) then begin
X if (dir) then
X where := 15
X else
X where := 85;
X yourscore := yourscore + 2;
X comment('SAFETY!');
X end else if (score = 3) then begin
X if (dir) then
X where := 35
X else
X where := 65;
X myscore := myscore + 3;
X comment('FIELD GOAL!');
X end;
X restore(old_where); (* take care old_where and where now! *)
X place(where);
X dokickoff := true;
X smg$ring_bell(disp`5B1`5D,3);
X turnover;
X end;
X sendplay;
X receiveplay;
X end else begin (* not mestart *)
X receiveplay;
X sendplay;
X if (score <> 0) then begin
X old_where := where;
X where := you.pos;
X score := you.score;
X if (score = 7) then begin
X yourscore := yourscore + 7;
X comment('TOUCHDOWN!');
X end else if (score = -2) then begin
X myscore := myscore + 2;
X comment('SAFETY!');
X end else if (score = 3) then begin
X yourscore := yourscore + 3;
X comment('FIELD GOAL! ');
X end;
X restore(old_where); (* take care old_where and where now! *)
X place(where);
X dokickoff := you.dokickoff;
X smg$ring_bell(disp`5B1`5D,3);
X turnover;
X end;
X end;
X teamlight;
X printscore;
Xend;
X
Xprocedure handletime;
Xbegin
X if (mestart) then begin (* Change of quarter *)
X if gameover then begin
X comment('GAME OVER!');
X lib$wait(2.0);
X (* Disney world for me!! *)
X end
X else if newhalf then begin
X (* change offense here ..could be tricky *)
X dir := not(dir);
X restore(old_where);
X old_where := where;
X if (dir) then
X where := 35
X else
X where := 65;
X ydstogo := 10;
X dokickoff := true; (* old_where and where will be handled in kickoff
V *)
X comment('SECOND HALF!');
X mestart := not(istarted);
X arrow;
X lib$wait(2.0);
X end else if newquarter then begin
X dir := not(dir);
X old_where := where;
X where := 100 - where;
X restore(old_where);
X place(where);
X comment('NEW QUARTER!');
X arrow;
X end;
X sendplay;
X receiveplay;
X end
X else begin (* not mestart *)
X receiveplay;
X sendplay;
X dir := you.dir;
X old_where := where;
X where := you.pos;
X dokickoff := you.dokickoff;
X (* change offense here ..could be tricky *)
X (* will read from mail box *)
X if gameover then begin
X comment('GAME OVER!');
X lib$wait(2.0);
X (* Disney world for me!! *)
X end else if newhalf then begin
X ydstogo := 10;
X comment('SECOND HALF!');
X mestart := not(istarted);
X arrow;
X lib$wait(2.0);
X end else if newquarter then begin
X restore(old_where);
X place(where);
X comment('NEW QUARTER!');
X arrow;
X end;
X end;
Xend;
X
Xprocedure handledown;
Xbegin
X if not(newhalf) and not(gameover) then begin
X if (mestart) then begin (* 5th down? *)
X if (down > 4) then begin
X ydstogo := 10;
X dir := not(dir);
X comment('NEW OFFENSE! ');
X turnover;
X end;
X sendplay;
X receiveplay;`20
X end
X else begin (* not mestart..that will be changed *)
X receiveplay;
X sendplay;
X if (you.down = 1) and not(fumble) and not(interception) then
X comment('FIRST DOWN!');
X down := you.down;
X ydstogo := you.ydstogo;
X dir := you.dir;
X if (down > 4) then begin
X comment('NEW OFFENSE! ');
X turnover;
X end;
X end;
X end;
X
X if (down > 4) then begin (* must be done here..or receiver will miss it *
V)
X down := 1;
X showdown;
X end;
Xend;
X
Xprocedure handlekick;
Xvar
X scored : boolean := false;
Xbegin
X if (mestart) then begin
X if (dir) then
X scored := ((100-where) < rnd(50))
X else
X scored := (where < rnd(50));
X if scored then begin
X score := 3;
X info('The kick was good!');
X end else begin
X dir := not(dir);
X info('The kick missed the uprights!');
X comment('NEW OFFENSE!');
X end;
X down := 1;
X ydstogo := 10;
X sendplay;
X receiveplay;
X end else begin
X receiveplay;
X sendplay;
X score := you.score;
X if (score = 3) then begin
X info('The kick was good!');
X end else begin
X dir := you.dir;
X info('The kick missed the uprights!');
X comment('NEW OFFENSE!');
X end;
X down := you.down;
X ydstogo := you.ydstogo;
X end;
Xend;
X
Xprocedure handlepunt;
Xbegin
X old_where := where;
X if (mestart) then begin
X stat := kickbase + rnd(20);
X if (dir) then
X where := where + stat
X else
X where := where - stat;
X sendplay;
X receiveplay;
X end else begin
X receiveplay;
X sendplay;
X where := you.pos;
X stat := you.gained;
X end;
X dir := not(dir);
X moveball(old_where, where);
X statistic('PUNT: ',2);
Xend;
X
Xprocedure handlekickoff;
Xbegin
X dokickoff := false;
X restore(old_where);
X old_where := where;
X if (mestart) then begin
X stat := kickbase + rnd(30);
X if (dir) then
X where := where + stat
X else
X where := where - stat;
X sendplay;
X receiveplay;
X end else begin
X receiveplay;
X sendplay;
X where := you.pos;
X stat := you.gained;
X end;
X moveball(old_where,where);
+-+-+-+-+-+-+-+- END OF PART 3 +-+-+-+-+-+-+-+-