$! ------------------ CUT HERE ----------------------- $ v='f$verify(f$trnlnm("SHARE_VERIFY"))' $! $! This archive created by VMS_SHARE Version 7.2-007 22-FEB-1990 $! On 16-APR-1993 17:20:59.27 By user MASMUMMY $! $! 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 5 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. $README.TXT;1 $! 2. BUILD.COM;1 $! 3. DFORMS.HLP;1 $! 4. DPLAYS.HLP;1 $! 5. FOOTBALL.INC;1 $! 6. FOOTBALL.PAS;1 $! 7. FOOTMSG.MSG;1 $! 8. OFORMS.HLP;1 $! 9. OPLAYS.HLP;1 $! 10. RMS.INC;1 $! $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 $ if f$search(P1) .eqs. "" then $ goto file_absent $ e "-W-EXISTS, File ''P1' exists. Skipped." $ delete 'f'* $ exit $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' XBefore compiling, you will have to change constants BOOTHFILE and HELPLIB Xin RMS.INC to point to where the files will be kept on your system. XOnce you run the program, you will need to place world RW on the .BOOTH Xfile, world R on the .HLB file, and world E on the .EXE, so others can Xenter the game. X XIf you have any questions, do not hesitate to send me mail. X XThanks, XBill X Xmasmummy@ubvms.cc.buffalo.edu XMASMUMMY@UBVMS.BITNET $ CALL UNPACK $README.TXT;1 1734892142 $ create 'f' X$ pascal football X$ message footmsg/obj=footmsg X$ link/notrace football,footmsg X$ if f$search("*.OBJ;*") .nes. "" then delete/noconfirm *.obj;* X$ lib/cre/help football.hlb X$ lib/ins football.hlb dforms,dplays,oforms,oplays X$ exit $ CALL UNPACK BUILD.COM;1 2050569227 $ create 'f' X1 Turtle XThe turtle has seven defensive backs, one linebacker, and three linemen Xready to prevent long yardage gain. X1 Prevent XThis formation consists of six defensive backs, two linebackers, and Xthree linemen. It is designed to prevent quick scoring but often Xbackfires. X1 Eagle XThe eagle has five linebackers, two linemen, and four defensive backs. XIt provides adequate coverage and great rushing potential due to the Xtremendous strength of the five linebackers. However, it is soft against Xa powerful run inside, since there are only two linemen. X1 Normal XThere are four defensive backs, four linebackers, and three linemen. XThis is the most balanced defensive form for normal circumstances. X1 Bear XThe bear has an eight-man front consisting of four linebackers and four Xlinemen. It has much potential for powerful pass rushing and guards against Xthe run quite well. X1 Goal_Line XThis form puts the entire defensive on the line mainly to shut down the Xoffensive especially for short yardage attempts. This formation is Xvery effective against the run, but defensive players must watch out Xfor the screen pass. X1 Against_Punt XThis formation offers the defense a chance to block the punt. X1 Against_Kick XThis formation offers the defense a chance to block the kick. $ CALL UNPACK DFORMS.HLP;1 742981897 $ create 'f' X1 Pass_Blitz XThe linebackers and safeties go all out to rush the quarterback. This is Xan excellent play to rattle the offense and is surprisingly effective Xagainst the run since it blocks all holes. X1 Run_Blitz XThis play has the defensive front sealing off all holes up front where Xthe runningback would try to get through. Sometimes, this play can also Xrattle the quarterback, since the defense dominates the line of scrimmage. X1 Zone_Defense XThe linebackers and safeties drop back looking to cover the receivers in Xthe event of a pass. Only defensive linemen are rushing up front. This Xplay is the safest way to prevent the big play by the offense. X1 React_Defense XThe defensive linebackers hang loose in the middle of the field, reacting Xto the ball. If they sense a pass play, they will drop back to cover it. XOtherwise, they rush up front. This play is a conservative play for the Xtimes when the defense is unsure what the offense might do. X1 Punt_Block XThis play is designed for the sole purpose of blocking a punt. X1 Kick_Block XThis play is designed for the sole purpose of blocking a kick. $ CALL UNPACK DPLAYS.HLP;1 487664450 $ create 'f' X`5BHidden`5D XConst X T = True; X F = False; X X y = 0; X x = 10; (* don't cares in bonus table *) X XConst X (* Offensive formation *) X X OF_HAIL_BRENT = 1; X OF_FIREBALL = 2; X OF_RED_GUN = 3; X OF_TROLL_FRONT = 4; X OF_HAMMER_FORMATION = 5; X OF_LED_PIPE = 6; X OF_PUNT = 7; X OF_KICK = 8; X MAX_OF = 8; X X (* Offensive play *) X X OP_PLAY_ACT_PASS = 1; X OP_POWER_RUN_INSIDE = 2; X OP_POWER_SWEEP = 3; X OP_SCREEN = 4; X OP_DEEP_PASS = 5; X OP_CROSSING_PASS = 6; X OP_COUNTER_GAP = 7; X OP_PUNT = 8; X OP_KICK = 9; X MAX_OP = 9; X X OP_KICK_OFF = 10; (* special *) X X (* Defensive formation *) X X DF_TURTLE = 1; X DF_PREVENT = 2; X DF_EAGLE = 3; X DF_NORMAL = 4; X DF_BEAR = 5; X DF_GOAL_LINE = 6; X DF_AGAIN_PUNT = 7; X DF_AGAIN_KICK = 8; X MAX_DF = 8; X X (* Defensive play *) X X DP_PASS_BLITZ = 1; X DP_RUN_BLITZ = 2; X DP_ZONE = 3; X DP_REACT = 4; X DP_AGAIN_PUNT = 5; X DP_AGAIN_KICK = 6; X MAX_DP = 6; X X DP_RUN_BACK = 7; (* special *) X XType X String = Packed Array`5B1..20`5D Of Char; X XVar X (* Offensive formatin action flag *) X X OffenFormFlags : `5BReadOnly`5D Array`5B1..MAX_OF, 1..MAX_OP`5D Of Boolean V := ( X (F, F, F, F, T, T, F, F, F), X (T, T, T, T, T, T, T, F, F), X (T, T, T, T, T, T, T, F, F), X (T, T, T, T, T, T, T, F, F), X (T, T, T, T, T, T, T, F, F), X (F, T, T, T, F, F, T, F, F), X (F, F, F, F, F, F, F, T, F), X (F, F, F, F, F, F, F, F, T)); X X (* Defensive formation action flag *) X X DefFormFlags : `5BReadOnly`5D Array`5B1..MAX_DF, 1..MAX_DP`5D Of Boolean : V= ( X (F, F, T, T, F, F), X (T, T, T, T, F, F), X (T, T, T, T, F, F), X (T, T, T, T, F, F), X (T, T, T, T, F, F), X (F, T, F, T, F, F), X (F, F, F, F, T, F), X (F, F, F, F, F, T)); X X (* Formation match up bonus *) X X Form_MatchUp_Bonus : `5BReadOnly`5D Array`5B1..MAX_OF, 1..MAX_DF`5D Of Int Veger := ( X (1, 2, 4, 6, 7, 9, x, x), X (2, 1, 2, 4, 5, 8, x, x), X (3, 2, 1, 2, 4, 7, x, x), X (4, 3, 2, 1, 2, 6, x, x), X (6, 4, 3, 2, 1, 4, x, x), X (7, 6, 4, 3, 2, 1, x, x), X (x, x, x, x, x, x, x, x), X (x, x, x, x, x, x, x, x)); X X (* Play match up bonus *) X X Play_MatchUp_Bonus : `5BReadOnly`5D Array`5B1..MAX_OP, 1..MAX_DP`5D Of Int Veger := ( X (0, 5, 3, 3, x, x), X (2, 2, 3, 2, x, x), X (1, 0, 4, 3, x, x), X (7, 4, 0, 0, x, x), X (1, 4, 2, 2, x, x), X (0, 3, 2, 4, x, x), X (0, 0, 6, 5, x, x), X (x, x, x, x, x, x), X (x, x, x, x, x, x)); X X (* Blizt bonus *) X X Blitz_Bonus : `5BReadOnly`5D Array`5B1..MAX_DF`5D Of Integer := ( X 0, 1, 2, 3, 5, 6, y, y); X X (* Pass bonus *) X X Pass_Bonus : `5BReadOnly`5D Array`5B1..MAX_OF`5D Of Integer := ( X 6, 5, 3, 2, 1, 0, y, y); X X (* tables *) `20 X X OF_Table : `5BReadOnly`5D Array`5B1..MAX_OF`5D Of String := ( X 'Hail_Brent', X 'Fireball', X 'Red_Gun', X 'Troll_Front', X 'Hammer_Form', X 'Led_Pipe', X 'Punt_Formation', X 'Kick_Formation'); X X OP_Table : `5BReadOnly`5D Array`5B1..MAX_OP`5D Of String := ( X 'PlayAction_Pass', X 'PowerRun_Inside', X 'Power_Sweep', X 'Screen_Pass', X 'Deep_Pass', X 'Crossing_Pass', X 'Counter_Gap', X 'Punt', X 'Kick'); X X DF_Table : `5BReadOnly`5D Array`5B1..MAX_DF`5D Of String := ( X 'Turtle', X 'Prevent', X 'Eagle', X 'Normal', X 'Bear', X 'Goal_Line', X 'Against_Punt', X 'Against_Kick'); X X DP_Table : `5BReadOnly`5D Array`5B1..MAX_DP`5D Of String := ( X 'Pass_Blitz', X 'Run_Blitz', X 'Zone_Defense', X 'React_Defense', X 'Punt_Block', X 'Kick_Block'); X X `20 XFunction Rnd(Max : Integer): Integer; XVar FirstCall : `5BStatic`5D Boolean := True; Seed : `5BStatic`5D Unsigned; XBegin X If FirstCall Then Begin X FirstCall := False; X Seed := Clock; X End; X Rnd := Round(Mth$Random(Seed)*(Max-1) + 1); XEnd; X XFunction IsPass(OPlay : Integer): Boolean; XBegin X IsPass := (OPlay = OP_PLAY_ACT_PASS) Or X (OPlay = OP_SCREEN) Or X (OPlay = OP_DEEP_PASS) Or X (OPlay = OP_CROSSING_PASS); XEnd; X XFunction IsDeepPass(OPlay : Integer): Boolean; XBegin X IsDeepPass := (OPlay = OP_PLAY_ACT_PASS) Or X (OPlay = OP_DEEP_PASS); XEnd; X XFunction IsEasyPass(OPlay : Integer): Boolean; XBegin X IsEasyPass := (OPlay = OP_SCREEN); XEnd; X XFunction IsBlitz(DPlay : Integer): Boolean; XBegin X IsBlitz := (DPlay = DP_PASS_BLITZ) Or X (DPlay = DP_RUN_BLITZ); XEnd; X XFunction Roll_Play(OFor, OPlay, DFor, DPlay: Integer): Integer; XVar I : Integer; XBegin X I := Form_MatchUp_Bonus`5BOFor, DFor`5D X +Play_MatchUp_Bonus`5BOPlay, DPlay`5D; X If (IsPass(OPlay) And IsBlitz(DPlay)) Then Begin X If (Blitz_Bonus`5BDFor`5D > 3) Then Begin (* Do Or Die! *) X If (Rnd(100) < 40) Then Begin X I := - Rnd(15); X End Else Begin X I := I + Pass_Bonus`5BOFor`5D; X End; X End Else Begin (* Boring! *) X I := I + Pass_Bonus`5BOFor`5D - Blitz_Bonus`5BDFor`5D; X End; X End; X Roll_Play := I; XEnd; $ CALL UNPACK FOOTBALL.INC;1 2000770538 $ create 'f' X`5Binherit('sys$library:starlet','sys$library:pascal$lib_routines', X 'sys$library:pascal$smg_routines','sys$library:pascal$mth_routines' V, X 'sys$library:pascal$str_routines')`5D X Xprogram maslib_football (input,output); X X%include 'football.inc' X%include 'rms.inc' X Xprocedure finitiate; forward; X Xfunction cv (line: integer): integer; Xvar X tmp : integer; Xbegin X tmp := round(line*6.0/10.0+9.0); X if (tmp < 1) then X cv := 1 X else X cv := tmp; Xend; X Xfunction trim (instr: string; var outstr: vartwe): integer; Xbegin X writev(outstr,instr); X for k := 1 to 20 do begin X if (lib$ichar(substr(outstr,k,1)) <> 32) then trim := k; X end; Xend; X Xprocedure ctrim (var instr: fifstr; var slen : $uword); Xvar X outstr : fifstr; Xbegin X str$trim(outstr,instr,slen); X instr := outstr; Xend; X Xfunction slead(s : varstr): varstr; Xvar i : $uword; done : boolean := false; Xbegin X i := 0; X while not done do begin X i := i + 1; X if i > s.length then done := true X else done := ( (s`5Bi`5D <> ' ') and (s`5Bi`5D <> chr(9)) ); X end; X if i > s.length then slead := '' X else slead := substr(s, i, s.length - i + 1); Xend; X Xprocedure convert (num: integer; var str: varstr; var slen: integer); Xbegin X writev(str,num); X str := slead(str); X slen := str.length; Xend; X Xprocedure arrow; Xbegin X if (dir) then X smg$put_chars_wide(disp`5B1`5D,'====>',6,36,smg$m_bold) X else X smg$put_chars_wide(disp`5B1`5D,'<====',6,36,smg$m_bold); Xend; X Xprocedure turnover; Xbegin X mestart := not(mestart); X arrow; X lib$wait(2.0); Xend; X Xprocedure statistic (line: fifstr; pos : integer); Xvar X statstr : varstr := ' '; Xbegin X convert(stat,statstr,xlen); X if (xlen = 1) then statstr := ' '+statstr; X smg$put_chars(disp`5B1`5D,' ',pos,36); X smg$put_chars(disp`5B1`5D,line+statstr,pos,36); Xend; X Xprocedure showdown; Xvar X dwnstr : varstr; Xbegin X if (down < 5) then begin X convert(down,dwnstr,xlen); X smg$put_chars(disp`5B1`5D,'DOWN: '+dwnstr,1,36); X end else X smg$put_chars(disp`5B1`5D,'DOWN: 1',1,36); Xend; X Xprocedure comment (line: fifstr); Xbegin X smg$put_chars_wide(disp`5B1`5D,line,6,50,smg$m_bold); Xend; X Xprocedure message (line: istring); Xbegin X smg$create_virtual_display(5,25,disp`5B4`5D,smg$m_border); X smg$paste_virtual_display(disp`5B4`5D,paste,10,27); X smg$put_line(disp`5B4`5D,line,,,,smg$m_wrap_word); X lib$wait(2.0); X smg$delete_virtual_display(disp`5B4`5D); Xend; X Xprocedure info (line: istring); Xvar X exist : `5Bstatic`5D boolean := false; Xbegin X if line.length > 0 then begin X if not exist then begin +-+-+-+-+-+-+-+- END OF PART 1 +-+-+-+-+-+-+-+- -+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+ X smg$create_virtual_display(4,33,disp`5B5`5D,smg$m_border); X smg$paste_virtual_display(disp`5B5`5D,paste,2,2); X exist := true; X end; X smg$put_line(disp`5B5`5D,line,,,,smg$m_wrap_word); X end else begin X smg$delete_virtual_display(disp`5B5`5D); X exist := false; X end; Xend; X Xprocedure winner; Xvar X scorestr : varstr := ' '; Xbegin X smg$create_virtual_display(22,78,disp`5B1`5D); X smg$create_pasteboard(paste); X smg$set_cursor_mode(paste,smg$m_cursor_off); X smg$set_broadcast_trapping(paste); X smg$paste_virtual_display(disp`5B1`5D,paste,2,2); X if (myscore > yourscore) then begin X smg$put_chars_highwide(disp`5B1`5D,me.city,2,20,smg$m_blink); X smg$put_chars_highwide(disp`5B1`5D,me.name,4,20,smg$m_blink); X smg$put_chars_highwide(disp`5B1`5D,you.city,14,20); X smg$put_chars_highwide(disp`5B1`5D,you.name,16,20); X convert(myscore,scorestr,xlen); X smg$put_chars_highwide(disp`5B1`5D,scorestr,4,8,smg$m_blink); X convert(yourscore,scorestr,xlen); X smg$put_chars_highwide(disp`5B1`5D,scorestr,16,8); X end else if (yourscore > myscore ) then begin X smg$put_chars_highwide(disp`5B1`5D,you.city,2,20,smg$m_blink); X smg$put_chars_highwide(disp`5B1`5D,you.name,4,20,smg$m_blink); X smg$put_chars_highwide(disp`5B1`5D,me.city,14,20); X smg$put_chars_highwide(disp`5B1`5D,me.name,16,20); X convert(yourscore,scorestr,xlen); X smg$put_chars_highwide(disp`5B1`5D,scorestr,4,8,smg$m_blink); X convert(myscore,scorestr,xlen); X smg$put_chars_highwide(disp`5B1`5D,scorestr,16,8); X end else begin X smg$put_chars_highwide(disp`5B1`5D,me.city,2,20,smg$m_blink); X smg$put_chars_highwide(disp`5B1`5D,me.name,4,20,smg$m_blink); X smg$put_chars_highwide(disp`5B1`5D,you.city,14,20,smg$m_blink); X smg$put_chars_highwide(disp`5B1`5D,you.name,16,20,smg$m_blink); X convert(yourscore,scorestr,xlen); X smg$put_chars_highwide(disp`5B1`5D,scorestr,4,8,smg$m_blink); X convert(myscore,scorestr,xlen); X smg$put_chars_highwide(disp`5B1`5D,scorestr,16,8,smg$m_blink); X end; X lib$wait(7.5); X smg$set_cursor_mode(paste,smg$m_cursor_on); X smg$delete_virtual_display(disp`5B1`5D); X smg$delete_pasteboard(paste); Xend; X Xprocedure teamlight; Xbegin X if (mestart) then begin X smg$put_chars(disp`5B1`5D,me.city,1,9,,smg$m_bold); X smg$put_chars(disp`5B1`5D,me.name,2,9,,smg$m_bold); X smg$put_chars(disp`5B1`5D,you.city,4,9); X smg$put_chars(disp`5B1`5D,you.name,5,9); X end else begin X smg$put_chars(disp`5B1`5D,me.city,1,9); X smg$put_chars(disp`5B1`5D,me.name,2,9); X smg$put_chars(disp`5B1`5D,you.city,4,9,,smg$m_bold); X smg$put_chars(disp`5B1`5D,you.name,5,9,,smg$m_bold); X end; Xend; X Xprocedure printscore; Xvar X str1, str2 : varying`5B6`5D of char; Xbegin X writev(str1, myscore:0); X writev(str2, yourscore:0); X if (mestart) then begin X smg$put_chars(disp`5B1`5D,str1,2,2,,smg$m_bold); X smg$put_chars(disp`5B1`5D,str2,5,2); X end else begin X smg$put_chars(disp`5B1`5D,str1,2,2); X smg$put_chars(disp`5B1`5D,str2,5,2,,smg$m_bold); X end; Xend; `20 X Xprocedure place (loc: integer); Xbegin X smg$put_chars(disp`5B2`5D,'0',8,cv(loc),,smg$m_bold) Xend; X Xprocedure restore (loc: integer); Xbegin X case (loc) of X 0,10,20,30,40,50,60,70,80,90,100: X smg$draw_line(disp`5B2`5D,7,cv(loc),8,cv(loc)); X otherwise X smg$put_chars(disp`5B2`5D,' ',8,cv(loc)); X end; Xend; X`20 Xprocedure menu_select(num: integer; var option: integer); Xvar X choice : $uword; Xbegin X if (num=1) then begin X smg$create_virtual_display(max_of,25,disp`5B3`5D,smg$m_block_border); X smg$paste_virtual_display(disp`5B3`5D,paste,9,27); X smg$create_menu(disp`5B3`5D,%descr of_table,smg$k_vertical); X end else if (num=2) then begin X smg$create_virtual_display(max_op,25,disp`5B3`5D,smg$m_block_border); X smg$paste_virtual_display(disp`5B3`5D,paste,9,27); X smg$create_menu(disp`5B3`5D,%descr op_table,smg$k_vertical); X end else if (num=3) then begin X smg$create_virtual_display(max_df,25,disp`5B3`5D,smg$m_block_border); X smg$paste_virtual_display(disp`5B3`5D,paste,9,27); X smg$create_menu(disp`5B3`5D,%descr df_table,smg$k_vertical); X end else if (num=4) then begin X smg$create_virtual_display(max_dp,25,disp`5B3`5D,smg$m_block_border); X smg$paste_virtual_display(disp`5B3`5D,paste,9,27); X smg$create_menu(disp`5B3`5D,%descr dp_table,smg$k_vertical); X end; X smg$select_from_menu(keyb,disp`5B3`5D,choice,,,%descr helplib,,,,smg$m_bol Vd); X smg$delete_virtual_display(disp`5B3`5D); X option := choice; Xend; X Xprocedure create_screen; Xvar X yrdstr : varstr := ' '; Xbegin X smg$create_virtual_display(6,78,disp`5B1`5D); X smg$create_virtual_display(15,77,disp`5B2`5D,smg$m_block_border); X smg$create_pasteboard(paste); X smg$create_virtual_keyboard(keyb); X smg$set_cursor_mode(paste,smg$m_cursor_off); X smg$set_broadcast_trapping(paste); X smg$paste_virtual_display(disp`5B1`5D,paste,2,2); X smg$paste_virtual_display(disp`5B2`5D,paste,9,2); X X smg$put_chars(disp`5B1`5D,me.city,1,9); X smg$put_chars(disp`5B1`5D,me.name,2,9); X smg$put_chars(disp`5B1`5D,you.city,4,9); X smg$put_chars(disp`5B1`5D,you.name,5,9); X smg$put_chars(disp`5B1`5D,'0',2,2); X smg$put_chars(disp`5B1`5D,'0',5,2); X X for i := 1 to 77 do begin X if (odd(i)) then begin X smg$put_chars(disp`5B2`5D,'_',5,i); X smg$put_chars(disp`5B2`5D,'_',10,i); X end else begin X smg$put_chars(disp`5B2`5D,' ',5,i); X smg$put_chars(disp`5B2`5D,' ',10,i); X end; X end; X smg$draw_line(disp`5B2`5D,1,9,15,9); X smg$put_chars(disp`5B2`5D,'G',14,8); X for i := 1 to 9 do begin X smg$draw_line(disp`5B2`5D,1,9+i*6,15,9+i*6); X if (i<6) then X convert(i,yrdstr,xlen) X else X convert(10-i,yrdstr,xlen); X smg$put_chars(disp`5B2`5D,yrdstr,14,cv(i*10-1)); X smg$put_chars(disp`5B2`5D,chr(48),14,cv(i*10+1)); X end; X smg$draw_line(disp`5B2`5D,1,69,15,69); X smg$put_chars(disp`5B2`5D,'G',14,70); Xend; X Xfunction pid_check (pid : unsigned): boolean; Xvar X sysstatus : integer := 1; X dummy : unsigned := 1; Xbegin X sysstatus := lib$getjpi(jpi$_pid,pid,,dummy); X case (sysstatus) of X ss$_nopriv : pid_check := true; `7B Process exists, no privilege to v View `7D X ss$_nonexpr : pid_check := false; `7B Process no longer exists `7D X ss$_normal : pid_check := true; `7B Process exists, privilege to view V `7D X otherwise X lib$signal(sysstatus); X end; Xend; X Xprocedure initiate; Xvar X master_pid : unsigned; X hudstr : packed array `5B1..1`5D of char; Xbegin X writeln(chr(27)+'`5B2J'+chr(27)+'`5B1;1H'); X lib$get_foreign(you.userid,,alen); X if ((alen = 0) or (you.userid = ' ')) then begin X repeat X lib$get_input(you.userid,'What is the username of your opponent? ',ale Vn); X until ((alen > 0) and (you.userid <> ' ')); X if (not(odd($asctoid(you.userid,,)))) then X lib$signal(iaddress(football_baduser)); X end; X lib$getjpi(jpi$_username,,,,me.userid); X lib$getjpi(jpi$_master_pid,,,master_pid); X lib$getjpi(jpi$_pid,,,me.pid); X str$upcase(you.userid,you.userid); X str$upcase(me.userid,me.userid); X if (master_pid = me.pid) then lib$signal(iaddress(football_notspawn)); X if (you.userid = me.userid) then lib$signal(iaddress(football_lonely)); X X (* Open the playerfile and write your record *) X X open(playfile, boothfile, history := unknown, access_method := keyed, X organization := indexed, record_type := fixed, X sharing := readwrite, user_action := rms_open); X lib$get_input(%descr me.city,%stdescr 'What city is your team from? '); X lib$get_input(%descr me.name,%stdescr 'What is the name of your team? '); X str$upcase(me.name,me.name); X str$upcase(me.city,me.city); X writeln(' '); X me.formation := 0; X me.play := 0; X me.count := 0; X me.time := gametime; X me.pos := 0; X me.gained := 0; X me.quarter := 1; X me.down := 1; X me.iswaiting := true; X me.dir := true; X rbf := iaddress(me); X rmsstatus := rms_put(pas$rab(playfile)`5E); X if (not(odd(rmsstatus))) then lib$signal(rmsstatus); X X (* Get the other player's record from the player file *) X X kbf := iaddress(you.userid); X ubf := iaddress(you); X rmsstatus := rms_get(pas$rab(playfile)`5E,false); X if (rmsstatus = rms$_rnf) then begin X repeat X lib$wait(4.0); X wait := wait + 1; X rmsstatus := rms_get(pas$rab(playfile)`5E,false); X until ((odd(rmsstatus)) or (wait >= 10)); X end; X X (* The other player's record was not found - timeout period reached *) X X if (not(odd(rmsstatus))) then begin X`20 X (* Delete my record *) X 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 rmsstatus := rms_delete(pas$rab(playfile)`5E); X if (not(odd(rmsstatus))) then lib$signal(rmsstatus); X lib$signal(iaddress(football_absent)); X end; X X (* Other player's record was found - check to see if current *) X X if (not(pid_check(you.pid))) then begin X X (* Delete my record *) X 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 rmsstatus := rms_delete(pas$rab(playfile)`5E); X if (not(odd(rmsstatus))) then lib$signal(rmsstatus); X X (* Delete other record *) X X kbf := iaddress(you.userid); X ubf := iaddress(you); X rmsstatus := rms_get(pas$rab(playfile)`5E,true); X if (not(odd(rmsstatus))) then lib$signal(rmsstatus); X rmsstatus := rms_delete(pas$rab(playfile)`5E); X if (not(odd(rmsstatus))) then lib$signal(rmsstatus); X lib$signal(iaddress(football_badrecord)); X end; X X (* Other player unghosted - is he playing or waiting to play? *) X X if (not(you.iswaiting)) then begin X X (* Delete my record *) X 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 rmsstatus := rms_delete(pas$rab(playfile)`5E); X if (not(odd(rmsstatus))) then lib$signal(rmsstatus); X lib$signal(iaddress(football_playing)); X end; X X (* The other player is waiting for me - set his ISWAITING to false *) X X kbf := iaddress(you.userid); X ubf := iaddress(you); X rmsstatus := rms_get(pas$rab(playfile)`5E,true); X if (not(odd(rmsstatus))) then lib$signal(rmsstatus); X you.iswaiting := false; X rmsstatus := rms_update(pas$rab(playfile)`5E); X if (not(odd(rmsstatus))) then lib$signal(rmsstatus); X X (* One of these people has to go first - compare entry times *) X X if (you.pid > me.pid) then X istarted := true X else X istarted := false; X if (istarted) then begin 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 mestart := true; X me.first := true; X rmsstatus := rms_update(pas$rab(playfile)`5E); X if (not(odd(rmsstatus))) then lib$signal(rmsstatus); X end else begin 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 you.first := true; X rmsstatus := rms_update(pas$rab(playfile)`5E); X if (not(odd(rmsstatus))) then lib$signal(rmsstatus); X end; X X (* Find out each player's offensive strategy *) X X writeln('OFFENSIVE STRATEGIES'); X writeln; X writeln('1) No huddle (very long game)'); X writeln('2) Short huddle (long game)'); X writeln('3) Regular huddle (short game)'); X writeln('4) Long huddle (very short game)'); X writeln; X repeat `20 X lib$get_input(hudstr,'Choice> ',alen); X readv(hudstr,huddle,error:=continue); X until (statusv = 0) and (huddle >= 1) and (huddle <= 4); X writeln; X X writeln('TEAM STRENGTH'); X writeln; X writeln('1) running'); X writeln('2) passing'); X writeln; X repeat `20 X lib$get_input(hudstr,'Choice> ',alen); X readv(hudstr,huddle,error:=continue); X until (statusv = 0) and (huddle >= 1) and (huddle <= 2); X if (huddle = 1) then X running := true X else if (huddle = 2) then X passing := true; X writeln; X X (* Coin toss - means absolutely nothing, and is totally fake *) X`20 X if (rnd(100) > 50) then X writeln('Heads has won the toss, I think.') X else X writeln('Tails has won the toss, I think.'); X if (mestart) then begin X ctrim(me.city,alen); X writeln(substr(me.city,1,alen)+' will receive the ball first!'); X end else begin X ctrim(you.city,alen); X writeln(substr(you.city,1,alen)+' will receive the ball first!'); X end; X lib$wait(3.0); Xend; X Xprocedure finitiate; Xbegin 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 rmsstatus := rms_delete(pas$rab(playfile)`5E); X if (not(odd(rmsstatus))) then lib$signal(rmsstatus); X smg$set_cursor_mode(paste,smg$m_cursor_on); X smg$delete_virtual_keyboard(keyb); X smg$delete_virtual_display(disp`5B1`5D); X smg$delete_virtual_display(disp`5B2`5D); X smg$delete_pasteboard(paste); X close(playfile); Xend; X Xprocedure statcard; Xvar X xstr : varstr; Xbegin X convert(gtime,xstr,xlen); X if (gtime >= 1000) then X xstr := substr(xstr,1,2)+'.'+substr(xstr,3,2) X else if (gtime >= 100) then X xstr := ' '+substr(xstr,1,1)+'.'+substr(xstr,2,2) X else if (gtime >= 10) then X xstr := ' .'+xstr X else X xstr := ' .0'+xstr; X smg$put_chars(disp`5B1`5D,' ',1,60); X smg$put_chars(disp`5B1`5D,'TIME: '+xstr,1,60); X convert(quarter,xstr,xlen); X smg$put_chars(disp`5B1`5D,'QUARTER: '+xstr,2,60); X if (where < 51) then X convert(where,xstr,xlen) X else X convert(100-where,xstr,xlen); X smg$put_chars(disp`5B1`5D,' ',3,60); X if (xstr.length = 1) then X smg$put_chars(disp`5B1`5D,'BALL ON: '+xstr,3,60) X else X smg$put_chars(disp`5B1`5D,'BALL ON: '+xstr,3,60); X convert(ydstogo,xstr,xlen); X smg$put_chars(disp`5B1`5D,' ',4,60); +-+-+-+-+-+-+-+- END OF PART 2 +-+-+-+-+-+-+-+- -+-+-+-+-+-+-+-+ 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 +-+-+-+-+-+-+-+- -+-+-+-+-+-+-+-+ START OF PART 4 -+-+-+-+-+-+-+-+ X statistic('KICKOFF: ',2); X dir := not(dir); Xend; X Xprocedure handlerunback; Xbegin X old_where := where; X if (mestart) then begin X if ((where > 100) or (where < 0)) then begin X if (where > 100) then X where := 80 X else X where := 20; X restore(old_where); X place(where); X comment('TOUCHBACK!'); X end else begin X if (not(interception)) and (not(fumble)) then begin X comment('RUNBACK!'); X stat := rbbase + rnd(20); X end else if (fumble) then begin X stat := rnd(15); X end else if (interception) then begin X case (rnd(100)) of X 1..30 : stat := 0; X 31..70 : stat := rnd(20); X 71..100 : stat := rnd(100); X end; X end; X `20 X if (dir) then X where := where + stat X else X where := where - stat; X moveball(old_where,where); X statistic('RUNBACK: ',3); X X (* are we in end zone? *) X X if (((dir) and (where >= 100)) or (not(dir) and (where <= 0))) then X score := 7; X end; X sendplay; X receiveplay; X end else begin X receiveplay; X sendplay; X if ((where > 100) or (where < 0)) then begin X where := you.pos; X restore(old_where); X place(where); X comment('TOUCHBACK!'); X end else begin X if (not(interception)) and (not(fumble)) then comment('RUNBACK!'); X where := you.pos; X stat := you.gained; X score := you.score; X moveball(old_where, where); X stat := you.gained; X statistic('RUNBACK: ',3); X end; X end; X down := 1; X ydstogo := 10; Xend; X Xprocedure perform; Xbegin X timer(rnd(25)+20); X runplay; X if (interception) or (fumble) then handlerunback; X handlescore; X handletime; X handledown; X statcard; X if (not(gameover)) then begin X teamlight; X printscore; X end; X info(''); Xend; X Xprocedure kickoff; Xbegin X timer(10+rnd(10)); X comment('KICKOFF!'); X handlekickoff; X arrow; X handlerunback; X handletime; X statcard; X if (not(gameover)) then begin X teamlight; X printscore; X end; X info(''); Xend; X Xprocedure kick; Xbegin X timer(10+rnd(10)); X handlekick; X handlescore; `7B If score does not equal zero turnover happens here V `7D X handletime; X if (score = 0) then turnover; X statcard; X if (not(gameover)) then begin X teamlight; X printscore; X end; X info(''); Xend; X Xprocedure punt; Xbegin X timer(10+rnd(10)); X comment('PUNT!'); X handlepunt; X handlerunback; X handletime; X if (not(newhalf)) then turnover; X statcard; X if (not(gameover)) then begin X teamlight; X printscore; X end; X info(''); Xend; X Xbegin X $setpri(,,4,); X quarter := 1; X down := 1; X gtime := gametime; X ydstogo := 10; X initiate; X create_screen; X where := 35; X old_where := 35; X timer(0); X statcard; X repeat X score := 0; (* let's make sure no score will carry over! *) X interception := false; X fumble := false; X newhalf := false; X newquarter := false; X gameover := false; X if (dokickoff) then begin X lib$wait(2.0); X kickoff; X end; X if (mestart) then begin X repeat X menu_select(1,myform); X menu_select(2,myact); X if not offenformflags`5Bmyform, myact`5D then X message('You can''t choose that play in such formation! '); X until offenformflags`5Bmyform, myact`5D; X comment(' '); X sendplay; X receiveplay; X if (myact = op_punt) then X punt X else if (myact = op_kick) then X kick X else X perform; X end else begin X receiveplay; X info('Offensive formation: '); X info(of_table`5Byou.formation`5D); X repeat X menu_select(3,myform); X menu_select(4,myact); X if not defformflags`5Bmyform, myact`5D then X message('You can''t choose that play from that formation! '); X until defformflags`5Bmyform, myact`5D; X comment(' '); X sendplay; X info(''); X if (you.play = op_punt) then X punt X else if (you.play = op_kick) then X kick X else`20 X perform; X end; X until (gameover); X finitiate; X winner; Xend. X`7B X**************************************************************************** V**** X* `20 V * X* Program: MASLIB_FOOTBALL V * X* Co-Author: Xiaomu Zeng V * X* BITNET: MASWINDY@UBVMS V * X* Internet: maswindy@ubvms.cc.buffalo.edu V * X* Co-Author: William W. Brennessel V * X* BITNET: MASMUMMY@UBVMS V * X* Internet: masmummy@ubvms.cc.buffalo.edu V * X* `20 V * X* This program was created for personal use, and may be copied and altered V * X* under the condition that the authors are not responsible for any problem Vs * X* that may occur. Comments and criticisms are always welcome. V * X* `20 V * X**************************************************************************** V**** X`7D $ CALL UNPACK FOOTBALL.PAS;1 122011343 $ create 'f' X.facility football,1 X X.severity severe X ABSENT "Other player has not entered game within timeout period" X BADRECORD "Bad record left by other player - please reenter game" X BADUSER "Username does not exist in the rights database" X GHOSTED "Other player seems to have ghosted" X LONELY "Football should be played with someone other than yourself" X NOTSPAWN "Football must be run in a spawned process" X PLAYING "Other player is currently engaged in another game" X.end $ CALL UNPACK FOOTMSG.MSG;1 654703206 $ create 'f' X1 Hail_Brent XThis formation is designed to get any eligible receiver downfield and Xstretch the defense to an extreme. It consists of no runningbacks, and Xfive wide receivers on the line. X1 Fireball XThis formation consists of four wide receivers and a single runningback. XThis is commonly used for run and shoot situations. X1 Red_Gun XThe Red Gun has three wide receivers on the line, a single back in the Xbackfield, and a tight end for blocking and/or receiving. X1 Troll_Front XTwo tight ends line up on one side of the offensive line, either to Xblock for the runningback or to protect the quarterback. There are Xtwo wide receivers also on the line. X1 Hammer_Form XThree tight ends line up front and form a tough offensive line. There is Xone wide receiver and one runningback as well. X1 Led_Pipe XThis is the formation where the defense hopes they took some aspirin before Xplaying. There are four tight ends on the line and a runningback in the Xbackfield ready to punish anyone who stands in their way. Quarterbacks Xhave been also known to run screen pass from this formation with great Xsuccess. X1 Punt_Formation XThis formation serves to protect the punter so he may get the punt off. X1 Kick_Formation XThis formation serves to protect the kicker so he may get the kick off. $ CALL UNPACK OFORMS.HLP;1 673331777 $ create 'f' X1 PlayAction_Pass XThe quarterback fakes a handoff to the runningback, then drops back Xlooking for a pass downfield. A successful play is when the runningback Xdraws the linebackers away, giving the quarterback time to find his man. XThis play works well against run blitzes and reaction defenses. X1 PowerRun_Inside XThe quarterback hands the ball off to the runningback, who runs between Xthe tackles in search of daylight. Provided the offensive line blasts Xa hole in the defense, this play is good for short yardage situations. X1 Power_Sweep XThe offense moves as a unit towards the outside, forcing blocks that allow Xthe runningback to turn the corner and explode into the secondary. This Xplay works well against drop-back defenses, but can be stuffed by a good Xblitz. X1 Screen_Pass XLinemen release defenders while the quarterback dumps the pass off to the Xrunningback. Then the linemen proceed downfield to block for the back as Xhe scrambles his way into the secondary. This play is optimum offense Xagainst the blitz. X1 Deep_Pass XThe quarterback gets to test his strength and accuracy as he lobs the long Xbomb down the field. This is a difficult play due to the precision Xrequired for completion. X1 Crossing_Pass XThe receivers drop underneath the coverage and look to the quarterback for Xshort to medium yardage. The pattern takes time to develop, but is quite Xeffective against most pass coverages. However, the offensive line must Xmake sure the pass rush does not get to the quarterback first. X1 Counter_Gap XOne side of the offensive line pulls to the other side, overloading the Xline of scrimmage, and blasting a path for the runningback to move through. XThis play is very powerful against a balanced defensive front. However, Xan aggresive defensive play can cut this play short in the backfield. X1 Punt XThe punt is an excellent idea for 4th down situations outside of field Xgoal range, except when points are needed desperately. X1 Kick XThe kick is an attempt at the 3-point field goal. Be aware that distance Xcan affect the ball's chance of sailing through the uprights. $ CALL UNPACK OPLAYS.HLP;1 1040999443 $ create 'f' Xconst X puntbase = 35; X kickbase = 45; X fgbase = 30; X rbbase = 10; X boothfile = '$1$DUA12:`5BTEMP.MASMUMMY`5DFOOTBALL.BOOTH'; X helplib = '$1$DUA12:`5BTEMP.MASMUMMY`5DFOOTBALL.HLB'; X gametime = 1500; X Xtype X $word = `5BWORD`5D -32768..32767; X $byte = `5BBYTE`5D -128..127; X $uword = `5BWORD`5D 0..65535; X $uquad = `5BQUAD,UNSAFE`5D record X long_1 : unsigned; X long_2 : unsigned; X end; X unsafe_file = `5Bunsafe`5D file of char; X ptr_to_fab = `5Efab$type; X ptr_to_rab = `5Erab$type; X ident = packed array `5B1..12`5D of char; X varstr = varying `5B10`5D of char; X datetime = packed array `5B1..23`5D of char; X istring = varying `5B1024`5D of char; X fifstr = packed array `5B1..15`5D of char; X vartwe = varying `5B20`5D of char; X X players = record X userid : `5Bkey(0)`5D ident; `7B The username of the player `7D X pid : unsigned; `7B Process ID `7D X formation : integer; `7B The formation `7D X play : integer; `7B The play action `7D X count : integer; `7B Determines who is to receive informa Vtion `7D X time : integer; `7B Actual time in game `7D X pos : integer; `7B Absolute position on field (1-100) ` V7D X city : fifstr; `7B Team's city `7D X name : fifstr; `7B Team's name `7D X gained : integer; `7B Actual number of yards gained `7D X ydstogo : integer; `7B Yards to go for first down `7D X quarter : integer; `7B Quarter `7D X down : integer; `7B Down `7D X score : integer; `7B Score (non accumlative) `7D X dokickoff : boolean; `7B Do kickoff `7D X iswaiting : boolean; `7B If player is waiting for another `7D X first : boolean; `7B Who received first `7D X dir : boolean; `7B Direction of play on field `7D X intercepted : boolean; `7B Interception `7D X fumble : boolean; `7B Fumble `7D`20 X end; X X playlist = file of players; X Xvar X rmsstatus : unsigned := 1; X huddle : integer := 1; X ksz : $byte := 12; `7B All key sizes are 12 `7D X usz,rsz : $word := 92; `7B The recordsize of the playerfile `7D X ubf,kbf,rbf : $uword; X playfile : playlist; X me,you : players; X disp : array `5B1..10`5D of unsigned; X paste,keyb : unsigned; X alen : $uword; X playstr : vartwe; X i,j,k,l,old_where,where,who,xlen,stat,wait : integer := 0; X myform,myact,quarter,gtime,down,ydstogo,score : integer := 0; X myscore,yourscore : integer := 0; X dir,dokickoff,istarted : boolean := true; X gameover,newhalf,newquarter,mestart,fumble,interception, X passing, running : boolean := false; X football_ghosted,football_absent,football_playing, X football_badrecord,football_notspawn,football_lonely, X football_baduser : `5Bexternal`5D unsigned; X X X`5Bexternal`5D Xfunction pas$fab(var f : unsafe_file) : ptr_to_fab; extern; X X`5Bexternal`5D Xfunction pas$rab(var f : unsafe_file) : ptr_to_rab; extern; X Xfunction rms_open (var fab : fab$type; X var rab : rab$type; X var f : playlist) : unsigned; Xbegin X fab.fab$l_fop := fab$m_cif; X rab.rab$l_fab := iaddress(fab); X rmsstatus := $create(fab); X if (odd(rmsstatus)) then X rmsstatus := $connect(rab); X rms_open := rmsstatus; Xend; X Xfunction rms_put(var rab: rab$type) : unsigned; Xbegin X rab.rab$b_rac := rab$c_key; X rab.rab$b_tmo := 10; `7B timeout period of 10 seconds ` V7D X rab.rab$w_rsz := rsz; `7B record size `7D X rab.rab$l_rbf := rbf; `7B address of the record buffer ` V7D X rab.rab$l_rop := rab$m_tmo + rab$m_wat + rab$m_uif; X rms_put := $put(rab); `7B write the new record `7D Xend; X Xfunction rms_get(var rab: rab$type; lock: boolean) : unsigned; Xbegin X rab.rab$b_rac := rab$c_key; `7B keyed access `7D X rab.rab$b_ksz := ksz; `7B size of the key `7D X rab.rab$l_kbf := kbf; `7B address of the key buffer `7 VD X rab.rab$w_usz := usz; `7B size of the record `7D X rab.rab$b_tmo := 10; `7B timeout period of 10 seconds V `7D X rab.rab$l_ubf := ubf; `7B address of the record buffer V `7D X if (lock) then X rab.rab$l_rop := rab$m_tmo + rab$m_wat X else X rab.rab$l_rop := rab$m_tmo + rab$m_wat + rab$m_nlk; +-+-+-+-+-+-+-+- END OF PART 4 +-+-+-+-+-+-+-+- -+-+-+-+-+-+-+-+ START OF PART 5 -+-+-+-+-+-+-+-+ X rms_get := $get(rab); `7B get the record `7D Xend; X Xfunction rms_update(var rab : rab$type) : unsigned; Xbegin X rms_update := $update(rab); `7B update the locked record `7D Xend; X Xfunction rms_delete(var rab : rab$type) : unsigned; Xbegin X rms_delete := $delete(rab); `7B delete the locked record `7D Xend; $ CALL UNPACK RMS.INC;1 454190815 $ v=f$verify(v) $ EXIT