$! ------------------ 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 +-+-+-+-+-+-+-+-