IMD 1.18: 22/01/1996 7:35:48 micro cornucopia kaypro user group disk 30 games with source in turbo pascal     30-DISK DOC$ARTILLRYCHN ARTILLRYPAS CRC COMCRCKLISTCRC D COMGAMEMENUCHNGAMEMENUPAS GAMES CHNGAMES COM? !"GAMES PAS#KISMET CHN,$%&'()KISMET PASZ*+,-./012345LANDER CHN6789LANDER PASJ:;<=>?@ABCLANDINSTDAT DEThis is a disk of games with source in Turbo Pascal. To play GAMES type "GAMES" after the A>. Turbo Pascal's "Chain" procedure allows you to chain to another program compiled as a .CHN file. Such a file contains only program code, and uses the Pascal library already present in memory (loaded with the first program - GAMES). GAMES chains to GAMEMENU which chains to the game you choose to play. At the end of the game it chains back to GAMEMENU. I wrote GAMEMENU so all the gaNUMCNVRTCHN FGNUMCNVRTPAS&HIJKLOVERUNDRCHNMNOVERUNDRPASOPQRPASCAL CHNSPASCAL PASTUVPLIFE CHNWXYZPLIFE PASC[\]^_`abcREADNUM PASdSNAKE CHNefghSNAKE PAS:ijklmnopSTARS CHNqrstSTARS PAScuvwxyz{|}~TELEPHONCHN TELEPHONPAS&TWINKLE CHNmes could be distributed in executable form without including the run time module with every game: thus saving 8K of disk space per program. These programs were put together by a beginning Pascal programmer and should help others new to Turbo. They function fairly well as games. Instructions are provided by each program, and a brief description of each follows. ARTILLRY.PAS This is a typical cannon shooting game. You pick an angle at which tTWINKLE PASWUMPUS CHNWUMPUS PASC  o fire the cannon. If you get close enough you hit the enemy. KISMET.PAS This game is very similar to Yahtzee. Variations are added by the introduction of color on the dice and an extra roll. The game ends after six turns by each player. LANDER.PAS This a game where you try to land on a planet. The planet is unspecified and changes each game. Thus the gravity changes, as well as fuel suppliege the default initial board. Answer "N" to get the same board each time you play. Type 0 to quit. Have fun! SNAKE.PAS In this game, you try to get the treasure before the snake roaming the screen can get you. The snake will ignore you for a while, but will get REAL interested as you build up a cash supply. Your object is to get the cash and get out the door. Use the U, N, H, and J keys to go up, down, left and righates. Setting coordinates outside the basic colony will end the input phase. The colony will cycle until one of three things happen; 1) the colony dies out, 2) the colony stabilizes (no births or deaths), or 3) a key on the keyboard is pressed. STARS.PAS If you like brain teasers then you're in for some fun. The object of this puzzle is to solve a 3 X 3 matrix such that *s appear in all positions except in the center whi1!͍!&+Ͳ"3 !!H !vP ! !3͡!3!H!vH  ͙"=*=!d!!dR"tŔ The enemy is *t!́ feet away!!!͐b! }2qŔ What angle? b!v+_b!v!I !4 !v͡*tRJ!͇}2o*o&E"*r!"rŔYou hit him!!!͐bŔ It took you ! *q&R!́ shots.͐b*r!NE!ŔYou have killed one enems, speed, and starting height. In addition there are meteor swarms to contend with. The file LANDINST.DAT contains instructions for this game. LANDINST.DAT The instructions for LANDER.PAS. NUMCNVRT.PAS This program lets you practice converting numbers from one base to another. OVERUNDR.PAS This is a dice betting game. You pick a number from 2 to 12 and roll two dice. Yout. TELEPHON.PAS This program generates letter patterns out of telephone numbers. (Telephon uses a recursive subroutine) TWINKLE.PAS This program fills the screen with stars then erases them in an interesting pattern. WUMPUS.PAS This is a typical game of Hunt the Wumpus. ch will be ' '. The positions on the matrix board are referred to as follows: 7 8 9 4 5 6 1 2 3 -- just like your numeric keypad. When a * is made a ' ', its immediate neighbors change state, that is: *s become ' 's and vice versa. In addition, changing a corner position also changes the center position; changing the center position also changes the outside middle positions. You will be asked if you want to chany.͐b"ŔYou have now destroyed *r!́ enemies of democracy.͐bÙ"*q&!R}2q*t͛E^"ŔYou overshot by bz"ŔYou under shot by bR*tRJ!͐b*q&!N*o&}oEʽ *q&!NE"ŔYou have run out of ammo.͐bŔWelcome to artillery͐bR͐bŔ>You are in the middle of a war (depressing, no?) and are being͐bŔ charged by thousands of enemies.͐bŔAYour job is to destroy their ouytposts. You have a win (four to one) if the roll matches the number picked, or (even money) if both the bet and the roll are over or under seven. PASCAL.PAS This program prints out Pascal triangles. PLIFE.PAS This is a version of LIFE, the classic computer game. You enter the coordinates of each starting cell until the initial pattern is set. You can erase a set cell by re-entering the cell's coordin  t your disposal͐bŔ enemy then write('You overshot by ') else write('You under shot by '); writeln(abs(enemy-dist)) en; (* how far away the enemy is *) killed : integer; (* how many we have hit *) shots : 0..numshells; (* number of shells left *) ch : char; (* used to answer questions *) hit : boolean; (* whether the enemy has been hit *) dummy : file; (* * dist * returns how far the shell went *) function dist:integer; (* * timeinair * figures out how long the shell * stays in the air *) function timeinair:real; begin timeinair := (2*velocity  enemy.'); assign(dummy,'gamemenu.chn'); chain(dummy) end. ́ of the enemy.͐b!? gamemenu.chn=!?ʹbR͐b%*p&(!YaEʂ$R͐bŔ You killed *r!d until (shots = 0) or hit; if shots = 0 then writeln('You have run out of ammo.') end; begin writeln('Welcome to artillery'); writeln; writeln('You are in the middle of a war (depressing, no?) and are being'); writeln('charged by thousands of enemies.'); writeln('Your job is to destroy their ouytposts. You have at your disposal'); writeln('a cannon, which you can shoot at any angle. As this is war,'); writeln('supplies are short, so you only have ',numshells,* sin(angle))/gravity end; begin dist := round((velocity * cos(angle))*timeinair) end; (* * fire * the user fires at enemy *) procedure fire; begin randomize; enemy := mindist + random(maxdist-mindist); writeln('The enemy is ',enemy:3,' feet away!!!'); shots := numshells; repeat write('What angle? '); readln(angle); angle := (angle * pi)/180.0; hit := abs(enemy-dist) <= 1; if hit then begin killed := killed + 1; (* * artillery * fire a shell at an enemy outpost *) program artillery (input, output); const numshells = 10; (* allowed 10 shells per target *) mindist = 100; (* minimum distance for a target *) maxdist = 1000; (* maximum distance for a target *) velocity = 200.0; (* initial velocity of 200 ft/sec^2 *) gravity = 32.2; (* gravity of 32.2 ft/sec^2 *) pi = 3.14159; var angle : real; (* angle to shoot at *) enemy : integer' per target.'); writeln; killed := 0; repeat writeln('*******************************************'); fire; write('I see another one, care to shoot again? '); read(trm,ch); writeln; while not (ch in ['y','n','Y','N']) do begin writeln('Please answer yes or no'); write('Want to try again? '); read(trm,ch); writeln end until upcase(ch) <> 'Y'; writeln; writeln('You killed ',killed,' of the  #CRC.COM 5.0 6/18/82CRCKFILE???!9" 1 M @ CRC Ver 5.0 CTL-S pauses, CTL-C aborts :] O@ ++Searching for CRCKLIST file++@ Now searching for "CRCKFILE" file++ !  1 .) F!  ͡]͸! ͔0CRCKLIST???CRCKFILE???!9" M à*,*.}|ډ!".*,{z{** u*.".G*.",!".***,}>*.#".ɯ22)! ",". <  NO FILECRC FILE$!   >. @ Checking wi match - : ̓ : J M @ Quantity of lines failed parse test - : ̓ : ~ M @ Quantity of file(s) not found - : ̓ * d͔  ͔ 0T  Җ Wyʩ 0T 0ztiil*#"ɯ2i2}! "!"]]2 s : ~# ++FILE NOT FOUND++$: F*}’">͇†]<  CANNOT CLOSE CRCFILE$CRCKLISTCRCSK FULL: CRCFILE$  w# !]͐ DONE$!e S!]Q !eZ @ --> FILE: XXXXXXXX.XXX CRC = oS) \<‘@ ++OPEN FAILED++ !" !" * | ʹ) \!~2 #" Ý: ) > T : ) @ ++FILE READ E3C --> FILE: KISMET .PAS CRC = 6D 38 --> FILE: STARS .PAS CRC = EB 21 --> FILE: 30-DISK .DOC CRC = 6B BE --> FILE: LANDER .PAS CRC = 37 0D --> FILE: LANDINST.DAT CRC = 24 E2 --> FILE: D .COM CRC = 66 48 --> FILE: GAMES .CHN CRC = C2 51th file - ! ~T #M M 2 2 2 2 ! >2 3o: : @ ***No CRC Files found***$> ʉ ʉw#: <2 P6: .6@ Can not parse string ! ~ʽT #ñM ! > 6 #6^#6! ~T #! 4M #x] #e w~ T #>2 @ - s M@ File not found ! 4 >2 o: G: „: G: „@ *Match* 2 ! 4@ <-- is, was --> : ) > T : ) M 2 ! 4<2 ~# @ Not a space between CRC values<2 G-CATALOG??? --> FILE: WUMPUS .CHN CRC = A9 A6 --> FILE: WUMPUS .PAS CRC = 8C D7 --> FILE: GAMEMENU.CHN CRC = DB 8B --> FILE: GAMES .PAS CRC = 30 83 --> FILE: GAMES .COM CRC = A0 8E --> FILE: ARTILLRY.CHN CRC = EF 6E --> FILE: ARTILLRY.PAS CRC = C1 54 --> FILE: GAMEMENU.PAS CRC = 8B 61 --> FILE: KISMET .CHN CRC = 0E 58 --> FILE: PLIFE .PAS CRC = 13 87 --> FILE: LANDER .CHN CRC = CB 78 --> FILE: CRC .COM CRC = B2 07 --> FILE: NUMCNVRT.CHN CRC = 54 73 --> FILE: STARSRROR++ <* |): o% |g}o" 2  ; 0T ~T #~A > T > _h : F{͇2h2|: ʲ !\   :\2 ! \  \ ! \  \! \  \<7=Ɓo&   ]  2h2|2   ~$#~# x  : F} *}= ">͇1 ].”#””͡”››tK››͸›* =: =͔="  ʳ ª~#.  ¿~  #~  .+~#0:0~#!A.O.Gy~#0M0 K MMɷ:m2 FSÄCRCKLIST$$$››tK›, › **}|!"*{z*~]*"Ü  DISK FULL: CRCFILE$!"*~ .CHN CRC = 78 F5 --> FILE: OVERUNDR.CHN CRC = 5B 73 --> FILE: OVERUNDR.PAS CRC = FE 93 --> FILE: PASCAL .CHN CRC = 47 72 --> FILE: PASCAL .PAS CRC = B2 B8 --> FILE: PLIFE .CHN CRC = 5D 8F --> FILE: SNAKE .CHN CRC = 2E 9D --> FILE: SNAKE .PAS CRC = 74 73 --> FILE: TELEPHON.CHN CRC = D2 93 --> FILE: TELEPHON.PAS CRC = D3 22 --> FILE: TWINKLE .CHN CRC = A3 3E --> FILE: TWINKLE .PAS CRC = 34 CD --> FILE: READNUM .PAS CRC = 5F C3 --> FILE: NUMCNVRT.PAS CRC = 87    Hit Space: KK : k Used: /k Not used: k *% DMf : remain on 1 !9" ! J> # ->! . *ͪe> # < * v K  K  K !B r+s+p+qA ?  p*A *? :]$Ž l]Q !]6 !E 6!C 6 :C *C &l ~2D U¼:E 2 :D S:E 2:D F:E 2:D V:E 2:D P:E 2 :D N2E ! _{ozgO{ozgi`N#Fogo&og_{_z#W OK = Y -S {-_ ! s+p+q*  ͼ 2 <2 : ! ڗ  K ! 4Á ! 6: =! ڻ * & NK ! 4œ >3  03} Z; { ) # ^#V"; *;  ͪ  *; q#pÝn* " ! p+q* )*= ^#V"; ! 6> ! i* &*; >OK : <2 E:/ *; ^#V*% DMf kK : *; Nf E*; ~ڻWK þE *; ~SK E = ! 6:! ':/ : = !: = : <2 * " !" >! .  * *&͵ "( * *&͵ > j*( #"( *DM*( V"( !" (   K!" }2 : <2 O:* * * "    >! = * DM** +" *( * " Ø* #" *&program GameMenu; (* Menu for games by Bruce Berryhill 10Jan85 *) var Answer: char; ChnFile: file; begin write('Hit any key to continue'); read(trm,Answer); repeat clrscr; writeln ('a Artillery'); writeln ('b Kismet'); writeln ('c Lander'); writeln ('d Convert numbers from one base to another'); writeln ('e Over Under'); writeln ('f Draw Pascal Triangles'); writeln ('g Life'); writelC 4Ø:!4:!5(  ! I3= : [= t:\a:\=_: :] t ?]\ : ҃! 6?Î : 2   ]Q  ?\\ : DM, Q ! "= *3 ##)*= "; */ &# "! *3 #"#  !! "% >!1 . 2' \: 2 : ʩ: ƀo&"* ~ʛ*# +"# ** DMY қ** DM  *; q#p* " . ** #DM*; -e**  *; w* #" )*= *; s#r*; "; : 2 !S 6!"V * "n >!S d*S &T ) ^#V"K O!l ^#V"M :S =2S M K  a*K "G *1!͍!#KͲŔHit any key to continueb!8!{bcŔ a Artillery͐bŔ b Kismet͐bŔ c Lander͐bŔ+d Convert numbers from one base to another͐bŔ e Over Under͐bŔf Draw Pascal Triangles͐bŔg Life͐bŔh Snake͐bŔ i Telephone͐bŔ j Twinkle͐bŔ k Wumpus͐bŔl Stars͐bR͐bŔ7Which game would you like to play? [a-l] to quit b!8!{b*{&(}2{*{&Q!A*( * " 3*1 #" " " *5 " > # R : B * +" ! +s#r( ! 6: " * ~2 * #" * +" > ʶ : 2 Ғ * +" : <2 O>ҳ ! 6* #" * ~2 p ̓: AOK = * Ͱ= * ͷ= * Ͱ= *# ͷ= * Ͱ= . g S -A >>!  ~?l W >#^ : /!:' —  ʑ #‹  W ʢ #™ i`N#FogDM!>))덑o|g =¼ DM!>)) = ^#V) ^#V|g}o n ('h Snake'); writeln ('i Telephone'); writeln ('j Twinkle'); writeln ('k Wumpus'); writeln ('l Stars'); writeln; write ('Which game would you like to play? [a-l] to quit '); read (trm,Answer); Answer := upcase(Answer); until (Answer in ['A' .. 'L']) or (answer = ^M); case Answer of 'A' : assign(ChnFile,'artillry.chn'); 'B' : assign(ChnFile,'kismet.chn'); 'C' : assign(ChnFile,'lander.chn'M "I *K  )*= ^#V"O I G  *G )*= N#F*O ? J*G #"G (*I )*= ^#V*O DM? m*I +"I JI G  *G )*= ^#V"Q *I )*= *G )*= N#Fq#p*I )*= *Q s#r*G #"G *I +"I K I  G M   !M G  :S <2S O!T *G s#r*S &l ) *M s#r*I "M ^I K  X:S <2S O!T *K s#r*S &l ) *I s#r*G "K û!" "    #* #" )*= * #" )*= N#Fq#p   * )*= * ) *= ^#VN#F? H * #" )*= ^#V";  *; ^#V" * )*= !Lk*{&! N}oE *{&AR"!K artillry.chn=È#BR3"!K kismet.chn=È#CRU"!K lander.chn=È#DRy"!K numcnvrt.chn=È#ER"!K overundr.chn=È#FR¿"!K pascal.chn=È#GR"!K plife.chn=È#HR#!K snake.chn=È#IR%#!K telephon.chn=È#JRH#!K twinkle.chn=È#KRj#!K wumpus.chn=È#LRˆ#!K stars.chn=c*{&! aEʦ#!KʹbRJ!K twinkle.chn=-#  ); 'D' : assign(ChnFile,'numcnvrt.chn'); 'E' : assign(ChnFile,'overundr.chn'); 'F' : assign(ChnFile,'pascal.chn'); 'G' : assign(ChnFile,'plife.chn'); 'H' : assign(ChnFile,'snake.chn'); 'I' : assign(ChnFile,'telephon.chn'); 'J' : assign(ChnFile,'twinkle.chn'); 'K' : assign(ChnFile,'wumpus.chn'); 'L' : assign(ChnFile,'stars.chn'); end; clrscr; if answer <> ^M then chain(ChnFile); end. ! !45(!.+/ 0y0( d!kZ!{Z͈͈o&  :(y ͠|( *"x2y( >28!?"9!!>2 :D]SXN]D [ (!e}̈́A8Q0G: x@!\w# (   yV. V!h6# (*(.(!8}(*(̈́w#>?> w#a{ |͒}͛Ɛ'@'7||}>"C"6# ""͐ͩ*B"[R5*"^#V#xW^8/w >uJ u` }>(; xQ }} ˸T}ٕ(0D=C ,= ( [ 0%D , 7 ͏ ?(8u x O - ; 8˸x X ,-xG}; }م 9; .>#n0[ D = - nx P ,-(-˸G,-; }ٕ? 9.>͏ 8u ?= u+-(>O 0u O 8^#V#N#FO/o&9O/o&9!9(> (G!9 w#E͊w}8uRB0 >R@RR!+ͨ z R!+ͨ z <!+ͨ z <!+ͨ z <!#ͨ z <!+ͨ z T]KB!z> S>))0 = |JJDMgo>jB0 7?= ͫCopyright (C) 1984 BORLAND IncA KAYPRO II-84d IVctedP=  ERC1B1~7#~=% o&ͦoͦܐԩͣ}!!"8~#(}:$= +*!Z!*B!!:(=2!Z: <2!!!:O::O:!*B͏ ?x P , 78ƀ8ƀ8ox٨!دoGOW_gɷɷ|لg{ً_zيWyىOxوG|ٔg{ٛ_zٚWyٙOx٘Gxٸyٹzٺ{ٻ|ټx٨ xx(ͼ ?}ٽÏ }ց; <(; 7D = |٤g{٣_z٢Wy١Ox٠GD u J }x>uu}ƀ/ƀo; -J }0W-J W,}l˸ͨ 8 ; ` x( -ͨ 8J -ͨ 8,J }l8;*!` ! >u` ` u--- J ,,,-xGg?+2n*8t z~,->uxu1!͍! LͲ!L gamemenu.chn=!LʹbH\<z5+)+<z {0Gɯgo||H}||/g}/o#}o&K[xAJSJDM!b"!6J"DM'ͬͬdͬ ͬ} wͦWͧ _}8(8J`9{T]=o`9y ,k- o&0%,` }g; }؉}颋.:}8c~I$I~L*kٷx˸; }0G,͙<},-(-J ! >0 a` o8 Oþ >um.`1pF,t6|!wS<.z}[|%FXc~ur1}Oٯx(<˸ͨ 8; !~Jͨ 0O!><ͨ 8 =  7 <` O ; 7 0 W-J OT0 j oD,:j !I}袋.}8c~I$I~L!> J= B== ͯ}8= ͵}/ͭ !*###~-_~(4Q6*>2>*##w:>*##~*#~(E[ ( ( ( !][ ( ( ((w#(6!]~-#8~>7  [>OkͼMs #rkͼpX á[ [ (( #w(q*#~[ (  *##~6͜O$*#~(08ʦ=ʦ==ʩ=ʬò+###~-_q46͡> *:4^q}Ò*|( w#!9! E9!!9~(+F͊!"9!(#>2*Ͳ"|>" :( ͆ *6#w*6#6 !\$![ (̈́( #:~CONTRMKBDLSTAUXUSR>2$*#~ Ͷ$*:> >w###6  #6++p>2S-$Ͷ:*6###ww#w$w#w: ##N#F*B> w#w#[s#r>2S$Ͷ$*6 #-Nw#Fwq#p#6#w#w#w* :( ͒*s#r*s#r"* 5KB!>u~#fo{_"*R0RnfR0KqputsrNF( ^VNF^V*SutKqp R*R(~w~wnf ut"6# * *!""*NFy(* "*B0Cnf* [R*"*RS[s#r^#VS>O"w2x2!"" @*>2"!"""!\Ͳ*: !~6go(\R*s#r_2x( s xu` ` 77 ` = O nf^VNF!DLT\I!!53!r1!\!> x #-= o˸xO(- }(x>8(C ,C `iM!>u|; |J>| )=|(DMbo˸ͦ88ͦx(0 8> Mx(>-Ͳ{(ay(Ͱͦ \z(>.Ͳ (Ͱ ~ͦ{>EͲ>+|(|Dg>-Ͳ|/ 0:p# ~# +>0w#,-  60#J˸}րogM| .M|( M6-#͐ͦ[R8 (G> ͒C~͒#*ͦC!h !lTRUEFALSEͦ!9^#(~#(G~͒#> ͒> Ò "F![(#RR0*4#4> RR *4 #4(>>2$*V(/˖:(#~+ x y2!͵( =( X:(R*:(###~-_-͌X> :("͟"*^˞*V˖0 SRѷR8A* N#F#s#r$ 0})jS\: *^ F* < >26"~͟*-w#ww#͟"~ <@*Ͳ!\  <ʮ!\$> >2*|>! * \$\<(!: [1Á\!(f"> 2:!<"F( #~#6e>!["N>!~8>O6*"w (=(&("( :(N 8y(~#x+% (6*#~[*#~ *~(h#"b=  8(T]DMR0 -a%}̈́o*!~6o&͠|ͣ}%^C User break1:% I/O% Run-time% error ͒%, PC=[R"͍% Program aborted*1!͍! LͲ!L gamemenu.chn=!Lʹb error ͒%, PC=[R"͍% Program aborted*1!͍!Ͳ!L gamemenu.chn=!Lʹ(C = ~> x0w#xG%P %P ZJDM%P = _~65i+~hìx-Sx9?+{Η@}|C C gZJDM0D ,7}o˸  #yO!@9i&   # w# /w#*###w* N#FB ͟r+s> !T]>)j)0 0= UR!#U*^#V#N#F#^#V>">!2DM"~x(L* :O(o:" C}=( ?*-N#Fp+qq#p! * F+N+++V+^Bq#p>>> SRѷR* s#r$ s#r"S"! N#FB(^x * 6#[<(H*! Kq#p##K[! *! 4 #4! x *$ *>w""{_!"*nf}(HR0nf" ^VMDnfutqp  program games; (* Loader for game chain by Bruce Berryhill 10Jan85 *) var dummy: file; begin assign(dummy,'gamemenu.chn'); chain(dummy) end. &N!r*+)n&!r*߫+)n&N}oE &!}2ѫ*߫#Ý%*#Ã%*#`%*ѫ&Q!ǫ!!5zʀ&"!ǫ-Q!r*+)n&a!ǫ*#A&!ǫ-Q!a!a!a!a!aͮ!ǫ-Q!a!a!a!a!aͮ}o}2̫*̫&!}2ƫ!!!R5zI'"!r*+)n&!r*!+)n&aE@'!}2ƫ*#'*ƫ&+(!!5zʀ'"!*+!s*#]'!!5z'"!!r*+)n&+!!r*+)n&+n&ded of *!͐bŔGrand total for basic section **!͐bR͐b**"!!5z"}2*!*+))))*&+)^#V"!`*&+))))) R!q́ = !*+))))*&+)^#V!͐b*&#;"R͐bŔTotal game value = *!͐bR͐bŔHit any key to continue͐b!8!bC-"*!!s!!RŒ#!*só#R¡#!*só#R³#!*s!"!!5z!! !r*&+)n&!! !֮!r*&+)n&))) !q͐b*&#î+R͐bQ!ŔReplace how many dice? b!*!͛*!͇}oEA,*!Ez3-}2ŔReplace which die? b!*!͛*!͇}oEʞ,*!-}oEʞ,!-Q*a!!r*+)M#*&+Ô,*&!}2"ŔPlayer number *!͐b!!5zʡ-}2!r*&+)M#*&#{-!}2*&!ͯE.R͐bj+R!s*#Ë'!!5z("*ޫ&!*+n&!N}o}2ޫ*#'*ޫ&}2*&E%R'}o}2*&!}2ޫ!!5z(}2!"!!5zʬ("!r*+)n&*&NEʣ(*!"*#m(*!NE(!}2ޫ*&#R(*ޫ&}2*&!}2!!!R5zE)"!r*+)n&!r*!+)n&aE<)!}2*#(*&}2ʹ#"ܫ!}2ޫ*&Rʡ)Rʡ)Rʡ)Rʡ)Rʡ)R§)$*R)W$}oE)!"ܫ*#}2*!r*&+)n&"*&##*"*K)!"ܫ!!5zV$"!r*+)n&*&NEM$*ܫ*&"ܫ*#$!}2ҫ!!!R5z.%"*!!5z%%"!r*+)n&!r*+)n&N!r*+)n&!r*+)n&N}oE%*ҫ&!}2ҫ!r*+)!s!r*+)!s*#Ì$*#r$*ҫ&!t}2׫*׫&!}2ѫ!!!R5z$&"*!!!R5z&"*!!5z&"߫!r*+)n&!r*+)ń0P(rint), E(veryone), S(core), R(eplace), Q(uit) ͐b!8!bR͐b*&(}2*&Q!Pa!Ea!Sa!Ra!QaEʺ-*&PRn.*g .ER¤.!*5zʡ.}2*&g *&#Ã..SR¸.!}2.RR.5,.QR.!/ gamemenu.chn=!/ʹbè-j+ŔScoring number? b!*!͛*!͇}oE.!*+))))*+)^#V!NE.*$!*5z/}2!!5z/}2!*&+))))*&+)!s#r*1!͍!X5Ͳz4"-*-^#V"!+._b! *-!͞*!aEV ŔPlease enter a number͐b**-s#r*!NE"!"!!5z!}2*!*+))))*&+)^#V"!`*&+))))) R!q́ = !*+))))*&+)^#V!͐b*&#À !"*!?tEm!*!F͇EN!!#"m!*!M͇Eg!!7"m!!K"R͐bŔBasic section totals to *!͐b*!aE"Ŕwith bonus adR)E%}oE)!"ܫ* R **&E*!"ܫ*!"ܫ* R-*&E$*!#"ܫ**!"ܫ* RW*O'EN**ܫ!"ܫT*!"ܫ* R‰*O'&}oEʀ**ܫ!"ܫÆ*!"ܫ* R³*@(Eʪ**ܫ!"ܫð*!"ܫ*R**R*(E**ܫ!2"ܫ*!"ܫ!*+))))*&+)*ܫs#r!`*&+))))) R!q͐bŔFor a total of *ܫ!͐bR͐bŔRoll #*&!́, your dice look like:͐b!!5z+,}2ŔDie #-*&  &#Ñ/*&#|/!`!+)))))* 1 - Aces 1 for each Ace )!`!+)))))* 2 - Dueces 2 for each Duece )!`!+)))))* 3 - Treys 3 for each Trey )!`!+)))))* 4 - Fours 4 for each Four )!`!+)))))* 5 - Fives 5 for each Five )!`!+)))))* 6 - Sixes 6 for each Six )!`!+)))))* 7 - 2 pair same color Tot a die can have *) dieindex = 1..numdice; (* index into dice array *) die = record (* structure for each die *) color : diecolor; (* its color *) value : dievalue (* its value *) end; tabletype = 1..scores; (* possible ways to score *) scoretype = array[tabletype] of integer; (* used for scoring *) var dice : array[dieindex] of die; (* the dice *) score : array[1..maxplayers] of scoretype; (* keep track of scores  writeln('Grand total for basic section ',sum+bonus) end; writeln; sum := sum + bonus; for i := 7 to scores do begin sum := sum + score[player][i]; writeln(tables[i],' = ',score[player][i]) end; writeln; writeln('Total game value = ',sum); writeln; writeln('Hit any key to continue'); read(trm,ch) end; (* * play * given a player, it will roll the dice, * print out the board, keep score, and do * anything else that needs to be done al dice )!`!+)))))* 8 - 3 of a kind Total dice )!`! +)))))* 9 - Straight 30 points )!`! +)))))*10 - Flush same color 35 points )!`! +)))))*11 - Full house Total dice + 15 )!`! +)))))*12 - Full house same color Total dice + 20)!`! +)))))*13 - 4 of a kind Total dice + 25 )!`!+)))))*14 - Yarborough free turn to*) numplayers : integer; (* number of players in the game *) curgame : 1..maxplays; (* current play number *) ch : char; (* input character *) colors : array[diecolor] of string[7]; (* will contain red,...*) tables : array[tabletype] of string[41]; (* how scoring is done *) j : 1..maxplayers; dummy : file; {$I readnum } (* * print * prints out a given players points *) procedure print(player:integer); var sum : integer; bonus(* * kismet game *) program kismet (input, output); const maxplayers = 4; (* maximum number of players *) scores = 15; (* 15 ways to make points *) numdice = 5; (* the number of dice in the game *) maxplays = 6; (* number of plays in a game *) diemax = 6; (* die values go from 1-6 *) type diecolor = (red,green,black,white); (*possible colors *) dievalue = 1..diemax; (* possible values*) procedure play(player:integer); var num : integer; (* input number from user *) roll : 1..4; (* roll we are on *) ch : char; (* input character *) i : 1..maxplayers; (* index for printing everyone's board *) dienum : dieindex; (* used in rolling the dice *) (* * rolldie * will return a random number, and a random * color for a die *) procedure rolldie(var dice : die); begin dice.value := random(dtal dice )!`!+)))))*15 - Kismet 5 of a kind Total dice + 50 )!֮!))) red !֮!))) green !֮!))) black ŔHow many players? b!*!͛*!͇}oEz4q/!!5z 5}2!*5z5}2_*_&J#*_&#4*&#4!*5z55}2_*_&g *_&#5!/ gamemenu.chn=!/ʹb!*5z}2_*_&J#*_&#4*&#4!*5z}2_*_&g *_&#5!/ gamemenu.chn : integer; i : tabletype; begin sum := 0; for i :=1 to 6 do begin sum := sum + score[player][i]; writeln(tables[i],' = ',score[player][i]) end; bonus := 0; if sum >= 63 then if sum <= 70 then bonus := 35 else if sum <= 77 then bonus := 55 else bonus := 75; writeln; writeln('Basic section totals to ',sum); if bonus <> 0 then begin writeln('with bonus added of ',bonus);   iemax) + 1; case (1 + random(3)) of 1: dice.color := red; 2: dice.color := green; 3: dice.color := black end end; (* * dietotal * returns the total of the sum of all the dice. *) function dietotal:integer; var i: dieindex; sum : integer; begin sum := 0; for i := 1 to numdice do sum := sum + dice[i].value; dietotal := sum end; (* * points * gives out points to a player * the way he (she) asked. for example, if the variable  if dice[i].color <> dice[i+1].color then flush := false end; (* * fullhouse * if there is a full house in the dice *) function fullhouse:boolean; (* * ifpair * if there is a pair (but not 3 or > of a kind) *) function ifpair:boolean; var tmp : array[1..diemax] of 0..numdice; (* number of each possibility *) begin (* * zero out the array *) for i := 1 to diemax do tmp[i] := 0; (* * count up the number of each  end; pair := numpairs >= 2 end; (* * three * returns whether on not there is a three of a kind in the dice *) function three:boolean; begin three := false; (* * simply roll through all combinations of three * and see if any are all equal *) for i := 1 to (numdice -2) do for j := i+1 to (numdice -1) do for k := i+2 to numdice do if (dice[i].value = dice[j].value) and (dice[j].value = dice[k].value) then : ifany; 7: if not pair then sum := 0; 8: if not three then sum := 0; 9: if straight then sum := 30 else sum := 0; 10: if flush then sum := 35 else sum := 0; 11: if fullhouse then sum := sum + 15 else sum := 0; 12: if fullhouse and flush then sum := sum + 20 else sum := 0; 13: if four then sum := sum + 25 else sum := 0; 14: ; 15: if five then sum := sum + 50 else sum := 0; end; score[player][how] := sum; writeln(t * how = 8 then the player asked for 3-of-a-kind *) procedure points(how:tabletype); var i,j,k : integer; (* indices into dice array *) return : boolean; (* used by subprocedures *) sum : integer; (* point sum *) (* * ifany * scores points if any correct * die values are shown *) procedure ifany; begin sum := 0; for i := 1 to numdice do if dice[i].value = how then sum := sum + how end; (* * pair * sees if there are 2value *) for i := 1 to numdice do tmp[dice[i].value] := tmp[dice[i].value] + 1; (* * see if any is exactly 2 *) for i := 1 to diemax do return := return or (tmp[i] = 2); ifpair := return end; (* * fullhouse *) begin fullhouse := three and ifpair end; (* * 4 of a kind *) function four:boolean; var counter : integer; j : 1..diemax; begin return := false; for j := 1 to diemax do begin counter := 0;  three := true end; (* * straight * returns whether or not there is a straight in the dice *) function straight:boolean; var has : set of 1..6; (* the dice put in a set *) begin has := []; for i := 1 to numdice do has := has + [dice[i].value]; straight := (has = [1,2,3,4,5]) or (has = [2,3,4,5,6]) end; (* * flush * whether or not there is a flush *) function flush:boolean; begin flush := true; for i := 1 to (numdice - 1) do ables[how]); writeln('For a total of ',sum); writeln end; (* * printdice * prints out the dice in a readable format *) procedure printdice; var i : dieindex; begin writeln('Roll #', roll ,', your dice look like:'); for i := 1 to numdice do writeln('Die #-',i,' ',dice[i].value,' ',colors[dice[i].color]); writeln end; (* * replace * will ask for a number (num), then will replace num dice *) procedure replace; var num : integer; used  different pairs, * with the 2 component of each pair having * the same color *) function pair:boolean; var numpairs : 0..3; begin numpairs := 0; for i := 1 to numdice -1 do for j := i+1 to numdice do if (dice[i].value = dice[j].value) and (dice[i].color = dice[j].color) then begin numpairs := numpairs + 1; dice[i].color := white; dice[j].color := white (* make sure neither is reused in a test *)  for i := 1 to numdice do if (dice[i].value = j) then counter := counter + 1; if (counter = 4) then return := true end; four := return end; (* * five * if there is five of a kind *) function five:boolean; begin five := true; for i := 1 to (numdice - 1) do if dice[i].value <> dice[i+1].value then five := false end; (* points *) begin sum := dietotal; return := false; case how of 1,2,3,4,5,6   : set of 1..numdice; numrep : 1..numdice; begin used := []; repeat write('Replace how many dice? '); readint(num) until (num > 0) and (num <= numdice); (* * cycle through num times replacing one die each time *) for numrep := num downto 1 do begin repeat repeat write('Replace which die? '); readint(num) until (num > 0) and (num <= numdice) until not (num in used); used := used + [num]; otal dice + 25 '; tables[14] := '14 - Yarborough free turn total dice '; tables[15] := '15 - Kismet 5 of a kind Total dice + 50 '; colors[red] := ' red '; colors[green] := ' green '; colors[black] := ' black ' end; (* main program *) begin repeat write('How many players? '); readint(numplayers) until (numplayers > 0) and (numplayers <= maxplayers); randomize; init; for curgame := 1 to maxplays do for j := 1 to numplayers do it * init strings *) procedure init; var i : diecolor; j : tabletype; k : 1..maxplayers; begin for k := 1 to numplayers do for j := 1 to scores do score[k][j] := 0; tables[1] := ' 1 - Aces 1 for each Ace '; tables[2] := ' 2 - Dueces 2 for each Duece '; tables[3] := ' 3 - Treys 3 for each Trey '; tables[4] := ' 4 - Fours 4 for each Four '; tables[5] := ' 5 - Fives 5 for each Fiv1!͍!1/Ͳð.!͡! ͡! !! ͼ !ͳ } ͳ !͡!!͡!!!^ͼ !͑}2*&}2*&!0R"*}2*&!0t*&!9͇}o}2*&P!Ͳ!"!"!"!}2!}2! m!͛E"*! mͯ*&}oEʇ!!*n&! NE}!*!"Ä!!}25!*! m͇*&}o}oE"!*n& E!*!  rolldie(dice[num]) end; roll := roll + 1 end; (* play *) begin writeln('Player number ',player); for dienum := 1 to numdice do rolldie(dice[dienum]); roll := 1; while roll < 4 do begin repeat writeln; printdice; writeln('P(rint), E(veryone), S(core), R(eplace), Q(uit) '); read(trm,ch); writeln; ch := upcase(ch) until (ch in ['P','E','S','R','Q']); case ch of 'P' : print(pla play(j); (* * now that it's all done, print out the results *) for j := 1 to numplayers do print(j); assign(dummy,'gamemenu.chn'); chain(dummy) end. e '; tables[6] := ' 6 - Sixes 6 for each Six '; tables[7] := ' 7 - 2 pair same color Total dice '; tables[8] := ' 8 - 3 of a kind Total dice '; tables[9] := ' 9 - Straight 30 points '; tables[10] := '10 - Flush same color 35 points '; tables[11] := '11 - Full house Total dice + 15 '; tables[12] := '12 - Full house same color Total dice + 20'; tables[13] := '13 - 4 of a kind T!*n&ͣ "*!"*!""!}2Ç!*!NE"!"*"*!P!ͲP!7Ͳ!}2ݭ!7 R!qb!8!ܭb*ܭ&(}2ܭR͐b*ܭ&!-Eʡ"!}2ݭö"! R!q͐b*ݭ&}oEJ"*ܭ&}2*&!( LANDINST.DAT<b!(b!(͝}oE1#!(8!֬P._b!֬ R!q͐b"Do you want instructions? Please answer Y or NQ!Ya!Na&"!YNEʊ#"Level of difficulty? .B:Beginner, E:Expert, N:Navigayer); 'E' : for i := 1 to numplayers do print(i); 'S' : roll := 4; 'R' : replace; 'Q' : begin assign(dummy,'gamemenu.chn'); chain(dummy) end; end (* case *) end; (* while *) printdice; repeat repeat write('Scoring number? '); readint(num) until (num > 0) and (num <= scores); until score[player][num] = 0; points(num) end; (* * in  tor, A:AstronautQ!Ba!Ea!Na!Aa&"}2ͬ*ͬ&BR$!}L!^͡p$ER9$!~L!^͡p$NRV$!!^͡p$ARp$!!^͎͡#!!^ͳ !0!^ͳ !j͡!!^ͳ !!^ͳ !H !p͡!!H!^ !pͳ !v͡!H!@!^ͼ !!^ͼ  ͙"T!@! !^ +}2*&!p!}L͸Eʣ.!v˸!v͡!v!d͸E>.ŔWe have landed safelybW.ŔWe have crashedbŔ at a speed of !v!!@́ meters/second.͐b!}2ê.!}2*&2#q$+-g-}oEʶ.Again? Y or NQ!Ya!Na&"!NNEʳ.ŔBye!͐b! gamemenu.chn=!ʹb2#q$+-g-}oEʶ.͇*V!t}oE)*T*VR"T!"*!"!p!v!}L ͼ !j*Vͼ ! !}L ͼ !p͡!v!j*Vͼ !}L ͳ !v͡*!!}L ͧN!p!}L͑}oE)% '*T!͛E+)$+!"V)!}LP Eʔ+ŔADespite the precautionary measures taken, the ship was destroyed.͐b!}2+Ŕ>Your prudent actions saved the ship from the mevel, is * less than the argument *) function unlucky(percentchance : real) : boolean; begin unlucky := rand(0.0, 1.0 - chance) <= percentchance; end; (* * converts a numerical ascii character to its corresponding integral value *) function asciitoint(digit : char) : integer; begin asciitoint := ord(digit) - ord('0'); end; (* * returns true if the argument is a numerical digit *) function isdigit(ch : char) : boolean; begin isdigit := (ch >= '0') and (ch <= ͼ !d͡!!X͡!}2FR͐bŔYou are b!v!ͥE<&ŔfallingbL&ŔrisingbŔ from a height of !p!!@͐bŔ meters at !v˸!!@́ m/s.͐b*F&}oE&Ŕ There are *T!́ liters of fuel left.͐b*T!N}2F!!X͡!}LP E)!!`! !^ ͳ ͙"R!*R5zʰ'"!X!L !X͡*#~'Ŕ"We are on a collisprogram lander; const instrfile = 'LANDINST.DAT'; maxrand = 32767; timeinc = 0.1; slightly = 0.1; moderately = 0.2; very = 0.3; impossible = 0.5; certainty = 1.0; minmeteors = 2.0; maxmeteors = 7.0; eachmisschance = 0.8; minavoid = 10; landingheight = 0.1; crashlandspeed = 6.0; type answers = set of 'A'..'Z'; str80 = string[80]; var speed, height, gravity : real; maenacing meteors!͐b!}2*&!!Xͼ P }oEq,ŔFYour piloting skills have steered you through the center of the swarm!͐b!}2a-*F&E -ŔCWhat a pity .. your craft was demolished by meteors before it could͐bŔ)be vaporized on contact with the surface.͐b!}2a-ŔBYour pointless gambling has destroyed the ship, you foolish plebe!͐b!}2*&!X!W!p!}L͑}oEʭ-!}2-*V! ͛E-(+}2-'9'); end; (* * convert determines the numerical value of the digits ina string. it returns * the integer and updates the string to now contain whatever was after the * end of the number. if the string is blank, the value is zero; if a number * is not found it returns -1. *) function convert(numstring : str80) : integer; var intvalue : integer; position : integer; digitsfound : integer; endofnumber : boolean; notinteresting : boolean; begin inion course with *R!͐bŔmeteors.b*F&E(R͐b)ŔIf we do not use more than ! !́liters of fuel in the͐bŔnext second, there is a !H!!Xͼ ͙!́ % probability that we will be͐bŔ*hit. If more is used it will be only 10 %.͐bŔUnits of fuel : b!G+ ._b!G  "V*V*T͛Eʈ)Ŕ There isn't that much fuel left.͐b)*V!ͯE)ŔI don't think that's possible.͐b*V*Txlandingspeed : real; chance, misschance : real; burn, fuel : integer; nummeteors : integer; inp : string[10]; ranout : boolean; dummy : file; (* * returns a random real number between lowlimit and highlimit *) function rand(lowlimit, highlimit : real) : real; begin rand := lowlimit + (highlimit - lowlimit + 1) * random; end; (* * returns true if a random number, weighted by the difficulty l  tvalue := 0; digitsfound := 0; position := 1; endofnumber := false; notinteresting := true; if length(numstring) > 0 then begin while (position < length(numstring)) and notinteresting do if numstring[position] = ' ' then position := position + 1 else notinteresting := false; while (position <= length(numstring)) and (not endofnumber) do if isdigit(numstring[position]) then begin intvalu0; speed := rand(0.0, 100.0 * chance) + 30.0; fuel := round(50.0 * rand(3.0 - chance, 4.0 - chance)); maxlandingspeed := crashlandspeed - 10.0 * chance; misschance := certainty; ranout := false; end; (* * tell player his height, speed and direction *) procedure writestatus; begin writeln; write('You are '); if speed > 0.0 then write('falling') else write('rising'); writeln(' from a height of ',height:1:1); writeln('meters at ',abs(str : string[80]; begin assign(instruct,instrfile); reset(instruct); while not eof(instruct) do begin readln(instruct,str); writeln(str); end; end; procedure startup; begin if ask('Do you want instructions? ','Please answer Y or N',['Y','N']) = 'Y' then instructions; randomize; end; (* * ask the player for the difficulty level of the next landing *) procedure getdifficulty; var level : char; begin level := ask('Le fuel to use in the next time period. *) procedure getburn; const fuelprompt = 'Units of fuel : '; begin repeat write(fuelprompt); readln(inp); burn := convert(inp); if burn > fuel then writeln('There isn''t that much fuel left.') else if burn < 0 then writeln('I don''t think that''s possible.'); until (burn <= fuel) and (burn >= 0); end; (* * figure out the craft's new speed according to the laws of physics *) procedure := intvalue * 10 + asciitoint(numstring[position]); position := position + 1; digitsfound := digitsfound + 1; end else endofnumber := true; if digitsfound = 0 then intvalue := -1; end; convert := intvalue; end; (* * asks a question with a single character answer. if the response is in the * set 'answers', the letter is returned. otherwise the string ifbad is * printed and the question is asked again. *) speed):1:1,' m/s.'); if not ranout then writeln('There are ',fuel:1,' liters of fuel left.'); ranout := fuel = 0; end; (* * determines if there are any meteors, and if so, how many *) procedure lookformeteors; var eachrock : integer; begin misschance := certainty; if unlucky(0.1) then begin nummeteors := round(rand(minmeteors,maxmeteors + 10.0 * chance)); for eachrock := 1 to nummeteors do misschance := misschance * eachmisschance; vel of difficulty? ','B:Beginner, E:Expert, N:Navigator, A:Astronaut', ['B','E','N','A']); case level of 'B' : chance := slightly; 'E' : chance := moderately; 'N' : chance := very; 'A' : chance := impossible; end; end; (* * variables that must be re-set each time a new landing is attempted *) procedure startgame; begin getdifficulty; gravity := rand(9.0 + chance, 11.0 + chance); height := rand(1.0 + chance, 2.0 + chance) * 100.e updatestatus; var deltat : integer; begin fuel := fuel - burn; deltat := 0; repeat deltat := deltat + 1; height := height - speed * timeinc - (gravity - burn) * 0.5 * sqr(timeinc); speed := speed + (gravity - burn) * timeinc; until (deltat = trunc(1 / timeinc)) or (height <= landingheight); end; (* * all the procedures that make a turn *) procedure doaturn; begin writestatus; lookformeteors; if fuel > 0 then getburn else  function ask(question, ifbad : str80; responses : answers) : char; var bad : boolean; ch : char; begin bad := true; repeat write(question); read(trm,ch); ch := upcase (ch); writeln; if ch in responses then bad := false else writeln(ifbad); until not bad; ask := ch; end; (* * prints out the instructions from a file instrfile *) procedure instructions; var instruct : text; ch : char;  writeln('We are on a collision course with ',nummeteors:1); write('meteors.'); if ranout then writeln else begin writeln('If we do not use more than ',minavoid:1,'liters of fuel in the'); writeln('next second, there is a ',round(100.0*(1.0-misschance)), ' % probability that we will be'); writeln('hit. If more is used it will be only 10 %.'); end; end; end; (* * asks the player for the amount of   burn := 0; updatestatus; end; (* * the course has changed: meteors have a lower chance of hitting *) function coursechanged : boolean; begin if unlucky(0.1) then begin writeln('Despite the precautionary measures taken, the ship was destroyed.'); coursechanged := true; end else begin writeln('Your prudent actions saved the ship from the menacing meteors!'); coursechanged := false; end end; function coursesame: booleanh to the ground that we can * say it has landed. could crash or touch down safely. *) function landed : boolean; begin if height < landingheight then begin speed := abs(speed); if speed < maxlandingspeed then write('We have landed safely') else write('We have crashed'); writeln(' at a speed of ',speed:1:1,' meters/second.'); landed := true; end else landed := false; end; begin startup; repeat s A simple when the fuel is asked for is equivalent to '0'. ; begin if not unlucky(1.0 - misschance) then begin writeln('Your piloting skills have steered you through the center of the swarm!'); coursesame := false; end else if ranout then begin writeln('What a pity .. your craft was demolished by meteors before it could'); writeln('be vaporized on contact with the surface.'); coursesame := true; end else begin writeln('Your pointless gambling has destroyed the ship, you fool LANDER is a game which simulates landing a ship on a planet. The ship's fuel, speed, and height, as well as the gravity and the maximum successful landing speed on the planet, are randomly determined at the start of each game, though they are weighted according to the skill level chosen. In order of increasing difficulty the choices are: B Beginner E Expert N Navigator A Astronaut In additiotartgame; repeat doaturn; until landed or anyhit; until ask('Again? ','Y or N',['Y','N']) = 'N'; writeln('Bye!'); assign(dummy,'gamemenu.chn'); chain(dummy) end. ish plebe!'); coursesame := true; end; end; (* * figures if any meteors (if there were any) managed to hit the ship. * different messages are printed depending on the thrust of the last turn. *) function anyhit : boolean; begin if (misschance = certainty) or (height <= landingheight) then anyhit := false else if burn > minavoid then anyhit := coursechanged else anyhit := coursesame; end; (* * returns true if the ship has come close enougn to the usual dangers of running out of fuel and landing too quickly (also known as crashing), a swarm of meteors will occasionally get on a collision course with you. If you do not change your course enough by burning a sufficient amount of fuel, each has a 20 % chance of hitting you. Even if you do so, 10 % of the time one of the rocks will stray and still hit you. This program uses its own integer conversion routines, and so will not 'bomb' if the amount of fuel is mistyped.   1!͍!l%Ͳ#"A*A^#V"&!(+._b!( *A!$͞*$!aEV ŔPlease enter a number͐b*&*As#r*$!NE}2!!"*!&R ŔBinary: b!!5z "!" *!* "* R!b*#á ò!RK!ŔOctal: b!!5zH!"!" *!* "* R!b*# !ò!R²!Ŕ Decimal: b!!5zʲ!"! " *! * "* R!b*#s!*""*""}2 ueses *) ch : char; (* used to answer questions *) frombase : base; (* from this base *) tobase : base; (* to this base *) good : boolean; input : char; dummy : file; {$I readnum } (* * makenumber * creates a random number of base * first, then prints it out in base * first. it then returns a decimal representation * of that number *) function makenumber(first:base):integer; var temp : string[10]; nuber *) (* * getnumber * gets a number from the user, in the * passed base. it then checks to see * if it is equal to the decimal answer * it was passed. it returns a boolean indictor * whether or not they matched *) function getnumber(readbase:base; answer:integer):boolean; var ch : string[5]; (* input from user *) factor : integer; (* multiplying factor *) inter : integer; (* intermediate results *) index : integer; (* index intŔ -> b* &R"Ŕ decimal: b! "J"R'"Ŕ octal: b!"J"RJ"Ŕ binary: b!"!+._b! m"!"!"**tE"!*n&Q!0!9kE"**!*n&!0R""*"*!"s"**NE"!}2 #ŔWrong!!!͐b!}2 * &ŔWhich would you like?͐bŔ1) Binary to decimal͐bŔ2) Binary to octal͐bŔ3) Octal to decimal͐bŔWhich number? b!s+_b!m : integer; index : integer; i : integer; begin num := 0; case first of binary : begin write('Binary: '); for index := 1 to 5 do begin i := random(base2); num := num * base2 + i; write(i:1) end end; octal : begin write('Octal: '); for index := 1 to 2 do begin (* * numcnvrt * tests your ability to convert a number * from bases * binary -> decimal, decimal -> binary * octal -> decimal, decimal -> octal * binary -> octal, octal -> binary *) program numcnvrt (input, output); const base2 = 2; (* binary *) base8 = 8; (* octal *) base10 = 10; (* decimal *) type base = (binary,octal,decimal); var i : integer; (* index variable *) right : integer; (* number of correct go ch *) strlength : integer; (* length of read in string *) begin write(' -> '); case readbase of decimal : begin write(' decimal: '); factor := base10 end; octal : begin write(' octal: '); factor := base8 end; binary : begin write(' binary: '); factor := base2 end end; readln(ch); strleng}2t*s&1R#!}2v!}2um$2R $!}2v!}2um$3R$$!}2v!}2um$ŔIllegal number͐bŔWhich number? b!s+_b!}2t*t&!NE#!"x!! 5z$"z*u&*v&g ͼ!E$*x!"x*z#Ó$R͐bŔYou got *x!́ out of 10͐bR͐bŔAgain? ͐b!8!wbR͐b*w&(!YaE#!C gamemenu.chn=!Cʹb out of 10͐bR͐bŔAgain? ͐b!8!wbR͐b*w&(!YaE# i := random(base8); num := num * base8 + i; write(i:1) end end; decimal : begin write('Decimal: '); for index := 1 to 2 do begin i := random(base10); num := num * base10 + i; write(i:1) end end end; makenumber := num end; (* makenum  th := length(ch); index := 1; inter := 0; while (strlength >= index) do begin if ch[index] in ['0'..'9'] then inter := (inter * factor) + (ord(ch[index]) - ord('0')) else index := strlength; index := index + 1 end; if inter = answer then getnumber := true else begin writeln('Wrong!!!'); getnumber := false end end; (* getnumber *) (* main -------------------------------------------------------------- *) Ŕ you get $*x!!͐b*z*x!"z"*v&!ͯ*u&!ͯ}o*v&!͛*u&!͛}o}oEʠ"ŔYou made even money.͐bŔ you won $*x!͐b*z*x"z"Ŕ You lost $*x!͐b*z*xR"zŔYou new total is $*z!͐b#""îP!ŮͲ!"**îͯ**͛}oEʼ#!Ů R!qb!**îͯ**͛}oEʹ#ŔSorry, only numbers between *î!́ and *!͐b#*"*n; writeln('You got ',right:2,' out of 10'); writeln; writeln('Again? '); read(trm,ch); writeln until upcase(ch) <> 'Y'; assign(dummy,'gamemenu.chn'); chain(dummy) end. program overunder(input, output); const maxdie = 6; (* the maximum # on a die *) mindie = 1; (* the minimum # on a die *) maxsum = 12; (* maximum sum for two dice *) minsum = 2; (* minimum sum for two dice *) startmoney = 500; (* amount of money player starts with *) type diesum = mindie..maxsum; (* type for the sum of dice *) dietype = mindie..maxdie; (* a die value *) str80 begin repeat writeln('Which would you like?'); writeln('1) Binary to decimal'); writeln('2) Binary to octal'); writeln('3) Octal to decimal'); write('Which number? '); readln(input); repeat good := true; case input of '1' : begin frombase := binary; tobase := decimal end; '2' : begin frombase := binary; tobase := octal What number do you want? !! "}2u Your bet? !*z""xR͐bŔ Overunder:͐bŔA simple dice game.͐bŔ%You choose a number between 2 and 12.͐bŔ)If the sum of two dice rolled is the same͐bŔ&as the number you picked, you win four͐bŔ'times your bet. If your number, and the͐bŔ'dice sum are either both under, or both͐bŔ(over 7, then you win the amount you bet.͐bR͐bR͐b!"zŔDo you want instructions? b!81!͍!&ͲÚ%"B*B^#V"'!)+._b!) *B!%͞*%!aEV ŔPlease enter a number͐b*'*Bs#r*%!NEÀ !!}2 * &Ŕ'Die#1 Die#2 Sum Your# Roll͐bj }2w*w&R!́ b*w&}2vj }2w*v&*w&}2v*w&R!́ *v&!́ *u&!́ b*v&!ͯEb!ŔUnder͐bÙ!*v&!͛Eʈ!ŔOver͐bÙ!ŔEven͐b*v&*u&NE"ŔYou matched!!!!͐b = string[80]; (* a string *) var money : integer; (* how much money player has *) bet : integer; (* how much is being bet this time *) die : dietype; (* value of a die *) sum : diesum; (* sum of the 2 dice *) numnum : diesum; (* number picked by player *) ch : char; (* used to answer questions *) dummy : file; {$I readnum } (* * play * throws the dice, prints them out, * an end; '3' : begin frombase := octal; tobase := decimal end else begin writeln('Illegal number'); write('Which number? '); readln(input); good := false end end; until good = true; randomize; right := 0; for i := 1 to 10 do if getnumber(tobase, makenumber(frombase)) then right := right + 1; writel!tbR͐b*t&(!YNE%$R͐b"R͐bg R͐bŔWant to try again? b!8!tbR͐b*t&(!Ya*z!͇}oE%*z!͇Eʧ&ŔSorry, you're out of money.͐b!D gamemenu.chn=!Dʹb*t&(!Ya*z!͇}oE%*z!͇EʇŔSorry, you're out of money.͐b!D gamemenu.chn=!Dʹbo  d keeps score *) procedure play; (* * dieroll * returns a random die value *) function dieroll:dietype; begin dieroll := 1 + random(maxdie) end; (* dieroll *) begin writeln('Die#1 Die#2 Sum Your# Roll'); die := dieroll; write(die:4,' '); sum := die; die := dieroll; sum := sum + die; write(die:4,' ',sum:4,' ',numnum:4,' '); if sum < 7 then writeln('Under') else if sum > 7 then ln; if upcase(ch) = 'Y' then inst; repeat writeln; getnumbers; writeln; play; writeln; write('Want to try again? '); read(trm,ch); writeln; until (upcase(ch) <> 'Y') or (money <= 0); if money <= 0 then writeln('Sorry, you''re out of money.'); assign(dummy,'gamemenu.chn'); chain(dummy) end.  write(question); randomize; readint(num); if (num < min) or (num > max) then writeln('Sorry, only numbers between ',min,' and ',max) end; legal := num; end; (* legal *) begin numnum := legal('What number do you want? ',minsum,maxsum); bet := legal('Your bet? ',1,money); end; (* getnumbers *) (* * inst * print out a list of instructions *) procedure inst; begin writeln; writeln('Overunder:'); writ(* * pascal * creates and draws pascal triangles of any size *) program pascal(input, output); var ch : char; (* used to answer questions *) dummy : file; (* * triangle * creates the triangle and prints it out. * note that only one row is created. To make * a node, all you need to know is the value of * the node to its left, and the value of the node * directly above it. as a result, i only keep the * previous row. *) procedure triangle; type nodeptr = ^ writeln('Over') else writeln('Even'); if sum = numnum then begin writeln('You matched!!!!'); writeln('you get $',bet*4); money := money + (bet * 4) end else if ((sum < 7) and (numnum < 7)) or ((sum > 7) and (numnum > 7)) then begin writeln('You made even money.'); writeln('you won $',bet); money := money + bet end else begin writeln('You lost $',bet); money := money1!͍!"Ͳ)" "5*5^#V"!+._b! *5!͞*!aEY ŔPlease enter a number͐b**5s#r*!NE"*?!NEʕ *R!b **?!NEʼ Ŕ b Ŕ* b!;cŔ/Which multiples do you want printed as spaces? b!?ŔSize of the triangle? b!A!*A5zʄ!"9!j !C!ͥ!*Cs#r*C*Es#r*C"E*9#A!R͐b!*A5z"""7!"=*E"C!*A*7R5z""9eln('A simple dice game.'); writeln('You choose a number between 2 and 12.'); writeln('If the sum of two dice rolled is the same'); writeln('as the number you picked, you win four'); writeln('times your bet. If your number, and the'); writeln('dice sum are either both under, or both'); writeln('over 7, then you win the amount you bet.'); writeln; writeln end; (* inst *) begin money := startmoney; write('Do you want instructions? '); read(trm,ch); writenode; node = record value : integer; (* value of this node *) next : nodeptr; (* next node (may be nil) *) end; var start : nodeptr; (* beginning of the last line *) curnode : nodeptr; (* current node *) size : integer; (* how big the triangle is to be *) mult : integer; (* the multiples to be removed *) last : integer; (* value of the last node *) heap : ^integer; (* pointer to the heap *) which : integer; (* which  - bet end; writeln('You new total is $',money) end; (* play *) (* * getnumbers * get the guess and the bet from the * player *) procedure getnumbers; (* * legal * gets a number between min * and max from the player, with proper error * checking *) function legal(question: str80;min,max:integer):integer; var num : integer; (* input number *) begin num := -1; while (num < min) or (num > max) do begin *=*C^#Vj *C^#V*=*Cs#r*C^#V"=*C^#V"C*9#!R͐b*7#Ø!!;kR͐bŔ Continue? b!8!{bR͐b*{&(!YaE)"!K gamemenu.chn=!Kʹb*7#Ø!!;kR͐bŔ Continue? b  node we are printing on the line *) left : integer; (* how many rows of the triangle left *) {$I readnum } (* * print * prints out the current node *) procedure print(value: integer); begin if mult = 0 then (* if mult = 0 => user wants real triangle *) write(value:4) else if (value mod mult) = 0 then write(' ') else write('* ') end; begin mark(heap); (* used to free up space *) write('Which multiples do youmediately adjacent to it. If a cell is͐bŔ=empty and has exactly 3 neighbors it will be born in the next͐bŔ6generation. If it is alive and has either two or three͐bŔ9neighbors, it will continue to live. Otherwise it dies of͐bŔloneliness or overcrowding.͐bŔ< The initial pattern is entered by typing the row and then͐bŔAthe column of the desired position. A cell is removed by entering͐bŔ>its position again. To finish entering give a position outs'*#'*#&*#ì&!"|!"z!q!!*!R%!!R*!F%5zʕ)"!!*!R%!P!R*!F%5zʌ)"!*#)))))))*#)"*n&R)*^#V!NE)!*s**R!*b**u%*|!"|Ã)Rƒ)*^#V!N*^#V!N}oEY)**u%Ã)!*s**R! b*z!"z*#{(*#9(*~*|*zR"~A*!!!!!P! want printed as spaces? '); readint(mult); write('Size of the triangle? '); readint(size); (* * create the first row. * note that it is being created from * the left side toward the right. *) for which := 1 to size do begin print(1); new(curnode); curnode^.value := 1; curnode^.next := start; start := curnode end; writeln; for left := 1 to size do begin last := 0; curnode := start; for which := 1 to (side͐bŔ 'Y'; assign(dummy,'gamemenu.chn'); chain(dummy) end. ^#V*F%s#r**^#V*%s#r*u!R*w!5zʎ&"*q!R*s!5zʅ&" !*#)))))))* #)!s#r* #;&*#&%*u!R*w!5z'"*q!R*s!5z'"!*#)))))))*#)n&!NE'!!5z'"!!5z'"!**#)))))))**#)!**#)))))))**#)^#V!s#r*#2  ́ is : bÎ*ͮ)l$ͫ)͏&'*~!N*|!N*z!N}o}o͠}oE+!!͠EF,!8!ybÞ,*~!NE{,ŔThis colony has died.͐bÞ,ŔThe pattern is stable.͐b!A gamemenu.chn=!Aʹbb2,*~ begin writeln('please answer yes or no'); read(trm,answer); writeln end; if upcase(answer) = 'Y' then begin writeln('LIFE simulates the growth of a colony of animals on a 0..', height-1:1,' by 0..',width-1:1,' ''world''.'); writeln('Whether a cell is born, lives, or dies depends on the number'); writeln('of living animals immediately adjacent to it. If a cell is'); writeln('empty and has exactly 3 neighbors it will be born i end; var board : array [minbound .. height] of array [minbound .. width] of cell; population : integer; births : integer; deaths : integer; ch : char; edge : edges; dummy : file; (* * initializes the edges of the pattern. this starts representing a pattern * which has no insides; the top is lower than the bottom, the left side is * to the right of the right side. this ensures that the coordinates of the * corner of the pattern after it across].nearby := 0; end; resetedges; end; (* * max ( & min) * returns the larger (smaller) of the two integer arguments *) function max(a, b: integer): integer; begin if a >= b then max := a else max := b end; function min(a, b: integer): integer; begin if a <= b then min := a else min := b end; (* * determine if and how the co-ordinates passed as argument change the bounds * of the pattern (the position of a box thatn the next'); writeln('generation. If it is alive and has either two or three'); writeln('neighbors, it will continue to live. Otherwise it dies of'); writeln('loneliness or overcrowding.'); writeln(' The initial pattern is entered by typing the row and then'); writeln('the column of the desired position. A cell is removed by entering'); writeln('its position again. To finish entering give a position outside'); writeln('of the dimensions of the screen. To s is entered will be correct without needing * to scan the entire array after the pattern is entered (a time consuming * process). *) procedure resetedges; begin edge.top := height - 1; edge.right := minbound + 1; edge.left := width - 1; edge.bottom := minbound + 1; end; procedure instructions; var answer : char; begin writeln('Would you like instructions for LIFE? '); read(trm,answer); writeln; while not (upcase(answer) in ['Y', 'N']) do  could contain living cells), * checking that it does not go off one of the sides of the board. *) procedure limits(x, y: integer); begin with edge do begin left := min(left,x); right := max(right,x); top := min(top,y); bottom := max(bottom,y); end; end; (* * this erases the record of the neighbors of all the cells, in preparation * for the new calculation of the nearby field *) procedure clearnearby; var down, across : integeprogram life; const height = 24; (* number of lines on screen *) width = 80; (* number of columns on screen *) minbound = -1; (* minimum dimension of screen bounds *) clearscreen = 26; (* screen clear character *) type state = (alive, dead); cell = record lookslikeitis : state; nearby : integer; end; edges = record left, right, top, bottom : integer; top a pattern, just hit'); writeln('any key. Type any key to start.'); writeln; read(trm,answer); writeln end; clrscr end; (* * initialize * resets the board to empty (all dead and with no neighbors) *) procedure initialize; var down, across : integer; begin instructions; for down := minbound to height do for across := minbound to width do begin board[down, across].lookslikeitis := dead; board[down,  r; begin for down := edge.top - 1 to edge.bottom + 1 do for across := edge.left - 1 to edge.right + 1 do board[down,across].nearby := 0; end; (* * computes the number of adjacent cells, and thus which cells will survive * through the next generation. To speed this up, the middle cell of the 3 by 3 * matrix which is being examioned is included in the count, even though it is * not really a neighbor of itself. this off-by-one discrepancy is taken into * account in the boa of the pattern, which is destroyed * by the prompt line which asks for the cell positions. *) procedure reprinttopline; var across : integer; begin gotoxy(1,1); for across := minbound + 1 to width - 1 do if board[minbound + 1][across].lookslikeitis = dead then write(' ') else write('*'); end; (* RePrintTopLine *) begin (* GetPositions *) finished := false; population := 0; gotoxy(1,1); write('Position of cell #',population +wn][across] do case lookslikeitis of dead: if nearby = 3 then begin lookslikeitis := alive; gotoxy(across,down); write('*'); limits(across,down); births := births + 1; end; alive: if (nearby = 3) or (nearby = 4) then limits(across,down) countneighbors; update; until (population = 0) or ((births = 0) and (deaths = 0)) or keypressed; gotoxy(1,1); if keypressed then read(trm,ch) else if population = 0 then writeln('This colony has died.') else writeln('The pattern is stable.'); assign(dummy,'gamemenu.chn'); chain(dummy) end. rd update. *) procedure countneighbors; var down, across : integer; deltadown, deltaacross : integer; begin clearnearby; for down := edge.top - 1 to edge.bottom + 1 do for across := edge.left - 1 to edge.right + 1 do if board[down,across].lookslikeitis = alive then for deltadown := -1 to 1 do for deltaacross := -1 to 1 do board[down+deltadown,across+deltaacross].nearby := board[down+deltadown,acros 1:1,' is : '); while not finished do begin readln(down, across); if (down <= minbound) or (down >= height) or (across <= minbound) or (across >= width) then finished := true else with board[down][across] do begin limits(across, down); gotoxy(across, down); if lookslikeitis = alive then begin write(' '); lookslikeitis := d else begin lookslikeitis := dead; gotoxy(across,down); write(' '); deaths := deaths + 1; end; end; population := population + births - deaths; end; (* * get the starting positions of the cells *) procedure getpositions; var down, across : integer; finished : boolean; (* * this is needed to reprint the top lines+deltaacross].nearby + 1; end; (* * update * if a birth or death occurs, the screen is updated. *) procedure update; var down, across : integer; localedge : edges; begin births := 0; deaths := 0; localedge := edge; resetedges; for down := max(minbound+1, localedge.top-1) to min(height-1, localedge.bottom+1) do for across := max(minbound+1, localedge.left-1) to min(width-1,localedge.right+1) do with board[doead; population := population - 1; end else begin write('*'); lookslikeitis := alive; population := population + 1; end; gotoxy(1,1); write('Position of cell #',population + 1:1,' is : '); end; end; reprinttopline; end; (* GetPositions *) (* main program *) begin initialize; getpositions; repeat   (* a procedure to input numbers with verification *) (* Bruce Berryhill 13 Jan 85 *) procedure readint(var innum: integer); var instring : string[20]; temp, error : integer; begin repeat temp := innum; (* save the variable *) readln(instring); (* input a number string *) val(instring,innum,error); (* convert the string into a number *) if error <> 0 then begin (* the string wa*+*-R! b!*+))))*-!s*Z!"Z!!R!$*Z!b!*`))))*b!s!`!$!h!+))!$!!5zʮ&"!h*+))!h*!R+))ͺ$*#v&!d!$!`!$!\!$!d!8!b*&(}2!d"*&URF'*^#V!͛EC'**^#V!Rs#r(NR‰'*^#V!ͯEʆ'**^#V!s#r(HR'*^#V!͛Eʾ'*^#V!R*s#r(JRŔ@by typing U, N, H and J respectively. You cannot move diagonally͐bŔ+though the snake can. You can quit with Q.͐bR͐bŔType any key to continue b!8!Sb !!'5z""M!!5z""K!*M))))*K!s*K#ì"*M#Ø"!!!Ss!!!Is!!!$s!!! s!!!#s!}2Y!}2X!"Z!! 5zʅ#"M!*M))))!!s*M#V#R!bF*FQ!!'k*HQ!!ku.͐b!b gamemenu.chn=!bʹb&EstŔYou have escaped with $*Z!͐by+ŔThe snake has eaten yosn't a number *) writeln('Please enter a number'); (* so prompt for a number *) innum := temp; (* and restore the variable *) end; until error = 0; end; '*^#V!'ͯE'*^#V!*s#r(QR(!}2Y!*^#V))))*^#Vn&!NEG(!d(!%*d*`N*f*bN}oEt(&Û(*d*\N*f*^N}oEʛ(!}2Y*^#V*^#VR!Ib!*^#V))))*^#V!s"*!NE)!"')*!͛E!)!"')!"*!*Z!d͇EZ)!!h!+))ͺ$X*!h!+))^#V*d!h!+))^#VR("!h!+))^#V*f!h!+))^#VR("!}oE#!*F))))*Hn&!N}2J$!}2J*J&}2?"@*@";!!'!R*;s#r*;!!!Rs#r*@͒#E$*;^#V*;^#V!*?&n&Rb!*;^#V))))*;^#V*?&s"7"9!!"1!!"/*1!a*/!a}oE$*7^#V*1*9s#r*9*7^#V*/s#r*9͒#*9^#V*dN*9^#V*fN}o}oE$*9^#V*9^#V!*9^#V))))*9^#V!s!!n&Rb+1!͍!+Ͳ0+"\"^*^*\*^R!"`*`ŔDo you want instructions? b!8!SbR͐b*S&(Q!Ya!Na}oEʸ ŔPlease enter 'Yes' or 'No'.͐b!8!SbR͐bQ *S&(!YNEʉ"R͐bŔLThe object of SNAKE is to get as much money ($) to the door (#) as possible.͐bŔCThe snake tries to prevent you (I). As you get more money, he tries͐bŔ=more and more successfully. You move up, down, left and right͐b*))))*n&!N**dN**fN}o}oED***R!Sb!*))))*!sX*!!h!+))ͺ$!h!+))%**dN**fN}oEʏ*!}2X!!Ez+"!h*+))!h*!R+))!h*+))^#V*dN!h*+))^#V*fN}oE+!}2X*+Ú*!h!+))!͊"W&&*Y&}oEJ++)*Y&*X&}oE6+!!R͐b*Y&Eʬ+ŔYou have escaped with $*Z!͐b+ŔThe snake has eaten yo  program snake; const playerchar = 'I'; snakechar = 'S'; moneychar = '$'; doorchar = '#'; upcommand = 'U'; downcommand = 'N'; leftcommand = 'H'; rightcommand = 'J'; quitcommand = 'Q'; snakelength = 5; height = 23; width = 39; clearscreen = 26; moneyworth = 25; type coordinate = record x : integer; y : integer; end; snaketype = array[1..snakelength] of coordinate; n if (pos.x in [0..width]) and (pos.y in [0..height]) then freespot := screen[pos.x, pos.y] = emptything else freespot := false; end; (* * assigns the coordinates of a position on the screen that is not being used *) procedure makespace(var newpos : coordinate; forwhat : thing); begin with newpos do begin repeat x := rand(0, width - 1); y := rand(0, height - 1); until freespot(newpos); gotoxy(x, y); wri writeln('more and more successfully. You move up, down, left and right'); writeln('by typing U, N, H and J respectively. You cannot move diagonally'); writeln('though the snake can. You can quit with Q.'); writeln; write('Type any key to continue '); read(trm,answer) end; end; (* * sets up all the variables *) procedure initialize; var x, y : integer; begin instructions; for x := 0 to width do for y := 0 to height do $',score); screen[money.x, money.y] := emptything; makespace(money, moneything); end; (* * position all of the items in the game making sure that none of them * overlap. *) procedure placeobjects; var snakebody : integer; begin makespace(snake[1], snakething); for snakebody := 2 to snakelength do placenearby(snake[snakebody], snake[snakebody - 1]); makespace(player, playerthing); makespace(money, moneything); makespace(door, doorthing); end; (*  thing = (playerthing, snakething, moneything, doorthing, emptything, scorething); var snake : snaketype; player, money, door : coordinate; score : integer; left, eaten : boolean; screen : array[0..width] of array[0..height] of thing; lookslike : array[thing] of char; dummy : file; (* * returns a random integer between min and max *) function rand(min, max: integer) : integer; begin rand := min + random(max-min+1); end; procedure instructions; varte(lookslike[forwhat]); screen[x, y] := forwhat; end; end; (* * placenearby finds a free coordinate adjacent to the argument coordinate * and places the thing there. *) procedure placenearby(var near, coord : coordinate); var deltax, deltay : integer; begin repeat repeat deltax := rand(-1, 1); deltay := rand(-1, 1); until (deltax <> 0) or (deltay <> 0); near.x := coord.x + deltax; near.y := coord.y + deltay; unti screen[x][y] := emptything; randomize; lookslike[snakething] := snakechar; lookslike[playerthing] := playerchar; lookslike[moneything] := moneychar; lookslike[emptything] := ' '; lookslike[doorthing] := doorchar; left := false; eaten := false; score := 0; for x := 0 to 10 do screen[x, 0] := scorething; write(chr(clearscreen)); end; (* * returns true if the position is valid and empty *) function freespot(pos : coordinate) : boolean; begi * read the player's move from the keyboard, not input so that the letter * will not be echoed and mess up the display. *) procedure playermove; var command : char; oldpos : coordinate; begin oldpos := player; read(kbd, command); command := upcase(command); with player do begin case command of upcommand : if y > 0 then y := y - 1; downcommand : if y < height then y := y + 1; leftcommand : if x > 0 then x := x - 1; ri answer : char; begin write('Do you want instructions? '); read(trm,answer); writeln; while not (upcase(answer) in ['Y','N']) do begin writeln('Please enter ''Yes'' or ''No''.'); read(trm,answer); writeln end; if upcase(answer) = 'Y' then begin writeln; writeln('The object of SNAKE is to get as much money ($) to the door (#) as possible.'); writeln('The snake tries to prevent you (I). As you get more money, he tries');l (freespot(near) or ((near.x = player.x) and (near.y = player.y))); gotoxy(near.x,near.y); screen[near.x, near.y] := snakething; write(lookslike[snakething]); end; (* * removes whatever is at the coordinates from the terminal screen * and the array screen. *) procedure remove(pos : coordinate); begin gotoxy(pos.x, pos.y); write(' '); screen[pos.x, pos.y] := emptything; end; procedure takegold; begin score := score + moneyworth; gotoxy(0,0); write('  ghtcommand : if x < width then x := x + 1; quitcommand : left := true ; end; if screen[x, y] = scorething then player := oldpos else begin remove(oldpos); if (player.x = money.x) and (player.y = money.y) then takegold else if (player.x = door.x) and (player.y = door.y) then left := true; gotoxy(x, y); write(playerchar); screen[x, y] := playerthing; end; en]); if (newpos.x = player.x) and (newpos.y = player.y) then eaten := true; for bodypart := snakelength downto 2 do begin snake[bodypart] := snake[bodypart - 1]; if (snake[bodypart].x = player.x) and (snake[bodypart].y = player.y) then eaten := true; end; snake[1] := newpos; end; begin (* main *) initialize; placeobjects; repeat playermove; if not left then snakemove; until left or eaten; gotoxy(0, heome 's and vice versa.͐bŔ?In addition, changing a corner position also changes the center͐bŔ@position; changing the center position also changes the outside͐bŔmiddle positions.͐bR͐bŔBYou will be asked if you want to change the default initial board.͐bŔ4Answer "N" to get the same board each time you play.͐bR͐bŔType 0 to quit. Have fun!͐b0 cR! e.!q́*** SHOOTING STARS ***͐b!͛!ŔDo you want instructions? (Y/d; end; (* * used by snakemove to figure out which way is the direction * toward the player *) function sign(x : integer) : integer; begin if x = 0 then sign := 0 else if x > 0 then sign := 1 else sign := -1; end; (* * snake moves randomly at first, then it goes more directly toward * the player *) procedure snakemove; var newpos : coordinate; bodypart : integer; begin if rand(0, score) <= 100 then placenearby(newpos, sna1!͍!.OͲ-"!8*b"Ů"ǮP!ɮͲ*Ǯ*Ů!ɮ R!qbPRESS SPACE BAR TO CONTINUE!!!*&! NEZ  !!"""**Ŕ b**!*&Q!Ya!ya!Na!naE *&!YN*&!yN}oE;!ŔYESb!*sP!ŔNO b!*sR!b""***5zʚ!"!*ͽ*#{!"!*5z!"R͐b*#î!ight); writeln; if left then writeln('You have escaped with $',score) else writeln('The snake has eaten you.'); assign(dummy,'gamemenu.chn'); chain(dummy) end. N)b!!!!͞ *&E%!!*"z!/E"xcŔ6Do you want to change the default initial board? (Y/N)b!!8!͞ *&Ee&!"z!"x*z!"*x!"**!?tEʰ&**!?R"ü&**"*x"z*!"x*x"*c!"R!f!+)!s#r!T!+)!s#r!f!+)!s#r!T!+)!s#r!f!+)!s#r!T!+)!:s#r!f!+)!s#r!T!+)! s#r!f!+)!s#r!T!+)! s#r!f!+)!s#r!T!+)ke[1]) else begin newpos.x := snake[1].x + sign(player.x - snake[1].x); newpos.y := snake[1].y + sign(player.y - snake[1].y); if (screen[newpos.x, newpos.y] = emptything) or ((newpos.x = player.x) and (newpos.y = player.y)) then begin gotoxy(newpos.x, newpos.y); write(snakechar); screen[newpos.x, newpos.y] := snakething; end else placenearby(newpos, snake[1]); end; remove(snake[snakelengthcŔ6If you like brain teasers then you're in for some fun.͐bŔ>The object of this puzzle is to solve a 3 X 3 matrix such that͐bŔ@*s appear in all positions except in the center which will be '.͐bŔ=The positions on the matrix board are referred to as follows:͐bŔ 7 8 9͐bŔ 4 5 6͐bŔ4 1 2 3 -- just like your numeric keypad.͐bŔ;When a * is made a ', its immediate neighbors change state,͐bŔ%that is: *s bec  !Os#r!f!+)!s#r!T!+)!s#r!f!+)!s#r!T!+)! s#r!f! +)!s#r!T! +)!s#r7 8 9!!4 5 6!!1 2 3!!0 - Quit!!!! 5z+)"uf&!d"s*s!͛E")!f*u+)!f*u+)^#V}/o|/g#s#r*u#(!!R! e.!qb!! 5z)"m!f*m+)^#V!ͯEʌ)Ŕ ' b!f*m+)^#V!͛Eʻ)Ŕ * b*m#T)!TURBO Pascal -- Wm Meacham, 6/2/84 ** Further "User friendly" enhancements -- WPM, 6/5/84 *} TYPE VECTOR = ARRAY[1..9] OF INTEGER ; STR80 = STRING[80] ; VAR SEED1, SEED2 : INTEGER ; STARS, F5 : VECTOR ; C : INTEGER ; DONE,REPLY : BOOLEAN ; dummy : file; { -------------------- Screen handling routines -------------------- } PROCEDURE KEYIN(VAR CIX : CHAR) ; BEGIN READ (KBD,CIX) ou fired*R!́ shots͐b!}2d*d&E"-!}2Qi%%&(,)*! ! ^!Would you like to play again?!! !P!! ͞ *P&}oEq.!}2Q*Q&E.!  gamemenu.chn=! ʹb^!Would you like to play again?!! N', 'n']) ; IF (CH = 'Y') OR (CH = 'y') THEN BEGIN WRITE ('YES') ; BOOL := TRUE END ELSE BEGIN WRITE ('NO ') ; BOOL := FALSE END END ; { ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ } PROCEDURE BEEP ; BEGIN WRITE (CHR(7)) END ; { ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ } { PROCEDURE CLRSCR ; Clear screen & home cur!R! e.!qb!!5zY*"m!f*m+)^#V!ͯE!*Ŕ ' b!f*m+)^#V!͛EP*Ŕ * b*m#)!͛!R! e.!qb!!5z*"m!f*m+)^#V!ͯEʶ*Ŕ ' b!f*m+)^#V!͛E*Ŕ * b*m#~*!͛!-!"[!! 5zʙ+"Y!T*e+)^#V!f*Y+)^#V!f*Y+)^#V"W*W!T*e+)^#VNEʐ+!f*Y+)!f*Y+)^#V}/o|/g#s#r*Y# +!! 5z+"Y*[!f*Y+)^#V"[*Y# { For TURBO Pascal -- WPM, 6/2/84} END ; { ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ } PROCEDURE WRITE_STR (ST:STR80 ; COL,ROW:INTEGER) ; BEGIN GOTOXY (COL,ROW) ; WRITE (ST) END ; { ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ } PROCEDURE PAUSE ; {Prints message on line 24, waits for user response} VAR CH : CHAR ; BEGIN WRITE_STR ('PRESS SPACE BAR TO CONTINUE',21,24) ; REPEAT KEYIN (CH) PROGRAM STARS ; {* ** PROGRAM TITLE: SHOOTING STARS ** ** WRITTEN BY: MARK J. BORGERSON ** DATE WRITTEN: July, 1976 ** ** WRITTEN FOR: PERSONAL ENJOYMENT ** ** TRANSLATED: Translated from BASIC ** by Ray Penley, SEPT 1979 ** 16 April 80 - added KEYIN. ** ** HISTORY: Originally from Pascal/Z Users' Group ** CP/M Users' Group volume 71 ** Modified for sor -- Built-in TURBO procedure } { ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ } PROCEDURE CLRlns(start,no_lines : integer); var i : integer; begin for i := start to start + no_lines do begin gotoxy(1,i); clreol; end end; { ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ } PROCEDURE SKIP(LINES:INTEGER) ; VAR I : INTEGER ; BEGIN FOR I := 1 TO LINES DO WRITELN END {---of SKIP---} ; { --------------ä+*["a*a!}2Q Your Shot !! !R*R&!0NE,!}2c,*R&!0R"eR͐b*R!"R*e!ͯ*e! ͛}oEk,!}2Q,!f*e+)^#V!͇E,Q!You can only Shoot Stars!! !!>5z,"O*O#ü, !! !}2Q*Q&}oE+R͐b!}2d!}2c+*c&E_-ŔGAME TERMINATED ͐b!}2d-*"g,)*g!NEʚ-Ŕ You lost!!!͐b!}2d-*g!`NE-Ŕ You WIN!!!͐bŔ Y UNTIL CH = CHR($20) ; WRITE_STR (' ',21,24) END ; { ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ } PROCEDURE READ_BOOL (VAR BOOL:BOOLEAN; COL,ROW:INTEGER) ; { Inputs "Y" OR "N" to boolean at row and column specified, prints "YES" or "NO"} VAR CH:CHAR ; BEGIN GOTOXY (COL, ROW) ; WRITE (' ') ; GOTOXY (COL, ROW) ; REPEAT KEYIN (CH) UNTIL (CH IN ['Y', 'y', '  ------ Routines for the game as such -------------------- } PROCEDURE INSTRUCTIONS ; VAR I : INTEGER ; BEGIN CLRSCR ; WRITELN('If you like brain teasers then you''re in for some fun.') ; WRITELN('The object of this puzzle is to solve a 3 X 3 matrix such that') ; WRITELN('*s appear in all positions except in the center which will be ''.') ; WRITELN('The positions on the matrix board are referred to as follows:') ; WRITELN(' 7  SEED2 := RANDOM (MAXINT) END END {--- of SEEDRAND ---} ; { ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ } FUNCTION RANDM : INTEGER ; { RANDM will return numbers from 0 to 32767. Call RANDM using the following convention: Range Use 0 - 32 RANDM DIV 1000 0 - 327 RANDM DIV 100 0 - 32767 RANDM GLOBAL SEED1, SEED2 : INTEGER } CONST HALFINT = 16383 ; { 1/2 want instructions? (Y/N)') ; READ_BOOL (ANS, 33, 4) ; IF ANS THEN INSTRUCTIONS END {---of HEADING---} ; (*============================================================* Procedures SEEDRAND and RANDM implement a Fibonacci series Random number generator. Written for PASCAL/Z By Raymond E. Penley, September 1979. Add these lines to your program -- VAR SEED1, SEED2 : INTEGER ; Within the body of the main program but BEFORE calling RANDM -- = (-17) ; F5[9] := 1190 ; WRITE_STR ('7 8 9', 21, 14) ; WRITE_STR ('4 5 6', 21, 17) ; WRITE_STR ('1 2 3', 21, 20) ; WRITE_STR ('0 - Quit', 21, 22) END {---of INITIALIZE---} ; { ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ } PROCEDURE LOAD ; VAR I, X7 : INTEGER ; BEGIN FOR I := 1 TO 9 DO BEGIN X7 := ( RANDM DIV 100 ) ; IF X7 > 200 THE8 9') ; WRITELN(' 4 5 6') ; WRITELN(' 1 2 3 -- just like your numeric keypad.') ; WRITELN('When a * is made a '', its immediate neighbors change state,') ; WRITELN('that is: *s become ''s and vice versa.') ; WRITELN('In addition, changing a corner position also changes the center') ; WRITELN('position; changing the center position also changes the outside') ; WRITELN('middle positions.') ; WRITELN ; WRIT OF MAXINT } VAR HALF1, HALF2, HALFADD : INTEGER ; BEGIN HALF1 := SEED1 DIV 2 ; HALF2 := SEED2 DIV 2 ; IF (HALF1+HALF2) >= HALFINT THEN HALFADD := HALF1 + HALF2 - HALFINT ELSE HALFADD := HALF1 + HALF2 ; SEED1 := SEED2 ; SEED2 := HALFADD * 2 ; { Restore from previous DIVision } RANDM := SEED2 END {---of RANDM---} ; (*============================================================*) PR SEEDRAND ; *============================================================*) PROCEDURE SEEDRAND ; { Initial values for SEED1 and SEED2 may be input here } VAR ANS : BOOLEAN ; BEGIN SEED1 := 10946 ; SEED2 := 17711 ; CLRSCR ; WRITE ('Do you want to change the default initial board? (Y/N)') ; READ_BOOL (ANS, 56, 1) ; IF ANS THEN BEGIN SEED1 := RANDOM (MAXINT) ; {Built-in TURBO function} N STARS[I] := (-STARS[I]) END END {---of LOAD---} ; { ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ } PROCEDURE BOARD ; VAR J : INTEGER ; BEGIN GOTOXY (1,1) ; WRITE(' ':20) ; FOR J := 7 TO 9 DO BEGIN IF STARS[ J ] < 0 THEN WRITE( ''' ') ; IF STARS[ J ] > 0 THEN WRITE( '* ') END ; SKIP(3) ; WRITE(' ':20) ; FOR J := 4 TO 6 DO ELN('You will be asked if you want to change the default initial board.') ; WRITELN('Answer "N" to get the same board each time you play.') ; WRITELN ; WRITELN('Type 0 to quit. Have fun!') ; PAUSE ; END {---of INSTRUCTIONS---} ; { ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ } PROCEDURE HEADING ; VAR ANS : BOOLEAN ; BEGIN CLRSCR ; WRITELN(' ':20, '*** SHOOTING STARS ***') ; SKIP(2) ; WRITE ('Do youOCEDURE INITIALIZE ; BEGIN CLRSCR ; C := 0 ; { SHOT COUNTER } STARS[1] := (-23) ; F5[1] := 1518 ; STARS[2] := (-3) ; F5[2] := 1311 ; STARS[3] := (-19) ; F5[3] := 570 ; STARS[4] := (-11) ; F5[4] := 3289 ; STARS[5] := 2 ; F5[5] := 2310 ; STARS[6] := (-5) ; F5[6] := 1615 ; STARS[7] := (-13) ; F5[7] := 2002 ; STARS[8] := (-7) ; F5[8] := 1547 ; STARS[9] :   BEGIN IF STARS[ J ] < 0 THEN WRITE( ''' ') ; IF STARS[ J ] > 0 THEN WRITE( '* ') END ; SKIP(3) ; WRITE(' ':20) ; FOR J := 1 TO 3 DO BEGIN IF STARS[ J ] < 0 THEN WRITE( ''' ') ; IF STARS[ J ] > 0 THEN WRITE( '* ') END ; SKIP(4) END {---of BOARD---} ; { ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ } PROCEDURE PLAYTHEGAME  WRITE_STR(' ',1,12) ; ERROR := TRUE END END UNTIL NOT ERROR ; WRITELN END {---of INPUT---} ; { -------------------- } BEGIN { PLAYTHEGAME } ENDOFGAME := FALSE ; QUIT := FALSE ; REPEAT INPUT ; IF QUIT THEN BEGIN WRITELN ('GAME T C, X : INTEGER ; STARS : VECTOR ; } VAR CIX : CHAR ; ERROR : BOOLEAN ; I : INTEGER ; BEGIN REPEAT ERROR := FALSE ; WRITE_STR('Your Shot ',1,11) ; KEYIN(CIX) ; IF CIX='0' THEN QUIT := TRUE ELSE BEGIN X := ( ORD(CIX) - ORD('0') ); LOAD ; BOARD ; PLAYTHEGAME ; CLRlns(13,12); WRITE_STR ('Would you like to play again?', 1, 13) ; READ_BOOL (REPLY, 31, 13) ; IF NOT REPLY THEN DONE := TRUE UNTIL DONE; assign(dummy,'gamemenu.chn'); chain(dummy) END {---of STARS---}. ; VAR D, X : INTEGER ; ENDOFGAME, QUIT : BOOLEAN ; { -------------------- } FUNCTION CHECK : INTEGER ; { Check to if the F value for the shot can be evenly divided by the stars value for each position. If the stars value divides into F without a remainder, the STAR or black hole is inverted (its sign is changed). GLOBAL X : INTEGER ; STARS, F5 : VECTOR ; } VAR ERMINATED ') ; ENDOFGAME := TRUE END ELSE BEGIN D := CHECK ; BOARD ; IF D = (-100) THEN BEGIN WRITELN('You lost!!!') ; ENDOFGAME := TRUE END ELSE IF D=96 THEN BEGIN  ; WRITELN ; C := C + 1 ; IF (X<1) OR (X>9) THEN ERROR := TRUE ELSE IF STARS[ X ] <= 0 THEN BEGIN BEEP ; WRITE_STR('You can only Shoot Stars',1,12) ; FOR I := 0 TO 16000 DO ; {DO NOTHING}  B1, K, Z5 : INTEGER ; BEGIN B1 := 0 ; FOR K := 1 TO 9 DO BEGIN Z5 := ( F5[ X ] DIV STARS[ K ] ) * STARS[ K ] ; IF Z5 = F5[ X ] THEN STARS[ K ] := (-STARS[ K ]) END ; FOR K := 1 TO 9 DO B1 := B1 +STARS[ K ] ; CHECK := B1 END {---of CHECK---} ; { -------------------- } PROCEDURE INPUT ; { GLOBAL  WRITELN('You WIN!!!') ; WRITELN('You fired', C:3, ' shots') ; ENDOFGAME := TRUE END END UNTIL ENDOFGAME END {---of PLAYTHEGAME---} ; { -------------------- The main program -------------------- } BEGIN { STARS } DONE := FALSE ; heading; REPEAT SEEDRAND ; { Seed the Random Number Generator } INITIALIZE   1!͍!s%Ͳ|#!0!15zE }2 !!5z: " !^* &)* +! s* # * &#!A}2 !2!95z }2 !!5z " * &!QNEʑ * &#}2 !^* &)* +* &s* &#}2 * #l * &#W "!"!}2*!͛E]!!*5z]!"!C*+n&!Z-E4!*"T!**R!͛ET!!}2*#!*& !"͠Eʫ!!8!b! gamemenu.chn=!ʹb**A͛E!!*A5z= array[1..lettersperdigit] of char; var dial : array['0'..'9'] of digitslet; vowels : set of 'A'..'Z'; phonenum : string[12]; word : array [1..maxnumlength] of char; numlength : integer; dummy : file; (* * initializes the array dial to contain the same (digit, 3 letters) * groups that are on telephones. 0 and 1 do not have any, and are set * to blank. the rest of the numbers are mapped to succeeding triples * of letters ( 2 -> A,B,C). the exception to ththen enoughvowels := false; end; end; (* * this is a recursive procedure which prints all possible combinations * of letters for the digits in the given phone number. given a position in * the number at which to continue looking, it loops through all the * possible values of the current position's letter (determined by the * corresponding letters for that digit on a telephone dial). for each * letter, it calls itself recursively on the next position in the number * (!"!C*+n&Rb*#!R͐bb"!!5zb""!C*+!^!M*n&)*+n&s* EY"*!c!*#" !}2*&!0t*&!9͇}o}2*&!!}2!-e.!M |!aE"!M!-e.!M |!ͽÿ"!M m"A*A!͇*A! ͛}oE0#!}2m#!*A5zm#"!M*n&k"}oEd#!}2*#;#*&Q!Aa!Ea!Ia!Oa!Ua!Ya!ZŔ=This program finds is is that the letter * Q is ignored, making the triple for 7 to be P,R,S. *) procedure setupdial; var i : integer; digit : char; letter : char; begin for digit := '0' to '1' do for i := 1 to lettersperdigit do dial[digit][i] := ' '; letter := 'A'; for digit := '2' to '9' do for i := 1 to lettersperdigit do begin if letter = 'Q' then letter := succ(letter); dial[digit][i] := letter; letteprogram telephone; const lettersperdigit = 3; (* each number can have 3 letters *) maxnumlength = 10; (* allows long distance numbers *) maxconsonants = 3; (* maximum number of consonants *) (* that are allowed in a word, if *) (* there are more than this many *) (* the rest of the combinations *) (* with this root are skipped *) type digitslet to figure out the next letter). the end of the number is reached * when the position would extend past the end of the string; then the current * permutation is printed and it returns to get the next combination. *) {$A-} (* allow recursive code *) procedure permutate(position:integer); var i : integer; ch : char; begin if keypressed then begin read(trm,ch); assign(dummy,'gamemenu.chn'); chain(dummy) end; if position > numlength then words that match the digits in a telephone͐bŔnumber. Words with more than !!́ consonants are automatically͐bŔ maxconsonants then for posinword := 1 to sofar do begin if word[posinword] in vowels then lastvowel := posinword else if posinword - lastvowel > maxconsonants    begin for i := 1 to numlength do write(word[i]); writeln end else for i := 1 to lettersperdigit do begin word[position] := dial[phonenum[position]][i]; if enoughvowels(position) then permutate(position + 1); end; end; (* * returns true if ch is a numerical character *) function isdigit (ch : char) : boolean; begin isdigit := (ch >= '0') and (ch <= '9'); end; (* * determines if the string typed in might writeln('have been listed.'); writeln; repeat write('What is your number? '); readln(phonenum); until arealphonenumber; permutate(1); assign(dummy,'gamemenu.chn'); chain(dummy) end. shuffle * shuffle the screen index *) procedure shuffle; var i : index; tmp : pos; rnd : index; begin for i := 1 to scrsize do begin rnd := random(scrsize) + 1; tmp := screen[rnd]; screen[rnd] := screen[i]; screen[i] := tmp end end; (* shuffle *) (* * fill * fill up the screen with a character *) procedure fill(ch:char); var i : index; begin for i := 1 to scrsize do begin gotoxy(screen[i].xloc,screen[i].y be a syntactically correct * telephone number. it must contain digits; it may optionally have * dashes (which are removed). *) function arealphonenumber : boolean; var digitpos : integer; begin arealphonenumber := true; while pos('-',phonenum) <> 0 do delete(phonenum,pos('-',phonenum),1); numlength := length(phonenum); if (numlength <= 0) or (numlength > maxnumlength) then arealphonenumber := false else for digitpos := 1 to numlength do if not isd(* * twinkle * randomly fill the screen with * '*' and then randomly remove them *) program twinkle(output); const scrsize = 1920; (* number of points on the screen *) xmax = 79; (* maximum x location (0 -> 79) *) ymax = 23; (* maximum y location *) type pos = record xloc : 0..xmax; yloc : 0..ymax end; index = 1..scrsize; var screen : array[index] of pos; dummy : file; (* * init * do a primitive c1!͍!!3Ͳ]!!!5z }2DR͐b*D&#!"F!!O5zʑ }2E!!5zʆ }2D!|*F+)*E&s!|*F+)*D&s*F!"F*D&#9 *E&#$ !!5z!">!!":!|*:+)<!|*:+)!|*>+)!|*>+)!<*>#Ý }29!!5z\!"3!|*3+)n&!|*3+)n&*9&Rb*3#!͒ !*!͒ ! !!L gamemenu.chn=!Lʹbz"3!|*3+)n&!|*3+)n&*9&loc); write(ch) end; end; (* fill *) (* main *) begin init; shuffle; fill ('*'); shuffle; fill (' '); assign(dummy,'gamemenu.chn'); chain(dummy) end. (* twinkle *) igit(phonenum[digitpos]) then begin arealphonenumber := false; end; end; begin setupdial; vowels := ['A','E','I','O','U','Y']; writeln('This program finds words that match the digits in a telephone'); writeln('number. Words with more than ',maxconsonants:1,' consonants are automatically'); writeln('rejected. Numbers may have embedded dashes and may be up to ',maxnumlength:1); writeln('digits long. Hit any key to exit before all the combinations'); lear screen, * then init the screen array *) procedure init; var scrindex : integer; (* index into screen array *) x : 0..xmax; y : 0..ymax; begin (* do a simple clear screen *) for y := 0 to ymax do writeln; randomize; scrindex := 1; for x := 0 to xmax do for y := 0 to ymax do begin screen[scrindex].xloc := x; screen[scrindex].yloc := y; scrindex := scrindex + 1 end end; (* init *) (* *   1!͍!K.}Ͳ-"ݮ"߮*߮*ݮ*߮R!"*R͐bŔ@Your mission, should you desire to accept it, is it hunt for the͐bŔBWumpus in his cave. To succeed, you must shoot it with one of your͐bR!!́D arrows. If you shoot into a room which is not directly connected to͐bŔCyours, the arrow will bounce to one of the rooms that does connect.͐bŔAThe bats in the cave may pick you up and place you in a different͐bŔAroom. If you en-(}2*&}2ͨ$,)* b!8!bR͐b*&(}2*&! -}oE&Ŕ Type ? for instructions.͐b*&! -Er&*&}2*&!!}2*&!@*>&+)-EE'*&}2>*>&*?&NEʮ'ŔLook Out!! The Wumpus got you.͐bŔBetter luck next time.͐b!}2:*?&!6-ES(!program wumpus; const maxrooms = 20; maxbats = 2; maxpits = 2; numberofarrows = 7; prompt = '> '; tunnelsperroom = 2; move = 'M'; quit = 'Q'; shoot = 'S'; help = '?'; type room = 1..maxrooms; rooms = set of room; var cave : array[room] of rooms; player : room; wumpus : room; arrowsleft : integer; ter a room which has a pit, you will fall into it.͐bŔ;If the wumpus finds you or you run out of arrows, you lose.͐bŔ8 At the prompt type m,s or q for move, shoot or quit.͐bR͐bŔDo you want instructions? b!8!ЮbR͐b*Ю&(Q!Ya!Na}oE^#ŔPlease answer yes or no͐bŔWould you like instructions? b!8!ЮbR͐b"*Ю&(!YNEv# }2ή}2Ϯ!@*Ϯ&+)!@*Ϯ&+)-Q*ή&a!@*ή&bR͐b*&(!YN}2;}2*&MR,ͮ*3,SR,#)3,QR&,͉+3,?R3, *;&*:&}o*9&}o*!!5z-}2}!6-Q!!a!6*}&#,!!5zZ-}2}!3-Q!!a!3*}&#-!!}2?*?&*>&a*?&!3-}o}o*?&!6-}o}oEZ-!}2;!}2:!}29!!}2*&!6-!3-}o*&*>&a}oE'Ŕ-A superbat picked you up and carried you off.͐b*&}2?*:&}o*?&!3-}oE(Ŕ.Don't do that!! Too late, you fell into a pit.͐bŔYou should be more careful.͐b!}2:!!!}2*&!-E(*&"**?&}2!͚}oE)Ŕwhere b!+_b*>&*&NEx)!}29Ó)*?&*&NEʓ)!}2:*&!@*&+)-}oE)!@*&+) quitting : boolean; killed : boolean; wumpuskilled : boolean; bats : rooms; pits : rooms; commandset : set of char; dummy : file; (* * rand * returns a random number between low and high *) function rand(low, high : integer) : integer; begin rand := low + random(high-low+1); end; procedure doinstr; begin writeln; writeln('Your mission, should you desire to accept it, is it hunt for the'); writeln('Wumpus in his cave+)!@*ή&+)-Q*Ϯ&a!!5z4$}2Ů*Ů&*Ů&!Rw#*Ů&#$!!5zʧ$}2Ů!*Ů&!R}2î*î&}/o|/g!@*Ů&+)-Eʜ$*Ů&*î&w#*Ů&#?$ŔYou are in room *?&!͐bŔ"There are tunnels leading to roomsb!!5zZ%}2*&!@*?&+)-EO%R! *&!b*&# %R͐b*?&!@*>&+)-!@*?&+)-!@*>&+)-Qͪ}oE%ŔI" []) then writeln('I smell a Wumpus.'); if cave[player] * bats <> [] then writeln('I hear bats.'); if cave[player] * pits <> [] then writeln('I feel a draft.'); end; (* * command * returns the single character that signifies what is to be de rooms do not match the list, the arrow bounces * randomly to a connecting tunnel. *) procedure doshoot; var nextroom, lastroom : room; begin lastroom := player; while not eoln do begin write('where '); readln(nextroom); if wumpus = nextroom then wumpuskilled := true else if player = nextroom then killed := true; if not (nextroom in cave[lastroom]) then nextroom := randroom(cave[lastroom]); lastroom := n rooms *) procedure addtunnel(from, dest : room); begin cave[from] := cave[from] + [dest]; cave[dest] := cave[dest] + [from]; end; (* * makemaze * makes a reasonably random maze. for each room tries to make 3 new tunnels. * if a tunnel already exists in that direction, another digging that way is * not made. *) procedure makemaze; var currentroom, tunnelto, newtunnel : room; begin for currentroom := 2 to maxrooms do addtunnel(currentroom, currentroom-1);gin if player in bats then begin repeat flewto := rand(1,maxrooms) until (not (flewto in (bats + pits))) and (flewto <> wumpus); writeln('A superbat picked you up and carried you off.'); player := flewto; end; end; (* * checkpits * determines if the player fell into a pit. *) procedure checkpits; begin if not killed and (player in pits) then begin writeln('Don''t do that!! Too late, you fell into a pit.'); write  extroom; skipblanks; end; arrowsleft := arrowsleft - 1; if killed then writeln('You klutz! You just shot yourself.') else if wumpuskilled then writeln('Congratulations! You slew the fearsome Wumpus.') else if arrowsleft = 0 then writeln('You ran out of arrows.') end; (* * domove * player's move, must be to an adjacent room *) procedure domove; var dest : room; begin write('To '); readln(dest); if not (dest in [1..maxrooms]nitialize; var i : room; begin randomize; for i := 1 to maxrooms do cave[i] := []; bats := []; pits := []; makemaze; wumpus := rand(1, maxrooms); for i := 1 to maxbats do bats := bats + [rand(1, maxrooms)]; for i := 1 to maxpits do pits := pits + [rand(1, maxrooms)]; repeat player := rand(1, maxrooms); until (player <> wumpus) and not (player in pits) and not (player in bats); quitting := false; killed := false; wumpus) then writeln('There is no room # ', dest) else if not (dest in cave[player]) then writeln('I see no tunnel to room # ',dest) else player := dest; checkbats; checkwump; checkpits; end; (* * doquit * asks if the player really wants to quit *) procedure doquit; var answer : char; begin writeln; write('Do you really want to quit now? '); read(trm,answer); writeln; quitting := upcase(answer) = 'Y' end; procedure doaturn(actkilled := false; arrowsleft := numberofarrows; commandset := [move, shoot, quit, help]; end; begin writeln('Welcome to Wumpus!!'); askinstruct; initialize; repeat doaturn(command); until gameover; assign(dummy,'gamemenu.chn'); chain(dummy) end. ion : char); begin case action of move : domove; shoot : doshoot; quit : doquit; help : doinstr; end; end; (* * gameover * returns true if the game is over *) function gameover : boolean; begin gameover := quitting or killed or wumpuskilled or (arrowsleft = 0); end; (* * initialize * generates a random maze and the positions of the player, wumpus,and bats. * make sure that the player doesn't start with the wumpus. *) procedure i  !  "  #  $  %  &  '