{$N+,W-} program sheepdog; const screenx = 79; screeny = 24; penxl = 37; penxu = 41; penyl = 10; penyu = 13; gatex = 39; gatey = 10; scorey = 24; scorexl = 37; scorexu = 40; maxanimals = 6; doggy = '+'; sheepy = '='; marginx = '-'; marginy = '|'; pennyx = '-'; pennyy = '|'; space = ' '; cup = chr(18); cdown = chr(20); cleft = chr(28); cright = chr(29); dogmoves = 250; scorecount = 50; type pixel = (nothing, border, status, pen, object, user); animal = record x, y : integer end; animals = array [1..maxanimals] of animal; const sheepstart = animals((9, 17), (8, 18), (9, 18), (10, 18), (9, 19), (10, 19)); var screen : array [1..screenx, 1..screeny] of pixel; sheep : animals; dog : animal; sheepsize : integer; score : integer; i : integer; finished : boolean; function rnd(s:integer):real; external; procedure jswset(b : integer); external; procedure jswreset(b : integer); external; {***************** Terminal Dependent Functions ***************************} { VC404 } procedure locate(x, y :integer); begin write(chr(16), chr(31 + y), chr(31 + x)) end; procedure clearscreen; var i : integer; begin write(chr(24)); for i := 1 to 10000 do end; {**************************************************************************} procedure place(x, y : integer; p : pixel; c : char); begin screen[x, y] := p; locate(x, y); write(c) end; function collision(d : animal):boolean; begin with d do collision := screen[x, y] <> nothing end; function jobdone:boolean; var result : boolean; i : integer; begin with dog do result := (x = gatex) and (y = gatey); if result then begin i := 0; repeat i := i + 1; with sheep[i] do result := (y > penyl) and (y < penyu) and (x > penxl) and (x < penxu) until (i = sheepsize) or not result end; jobdone := result end; function movedog:boolean; var ch : char; xx, yy : integer; newdog : animal; begin movedog := false; read(ch); if ch <> chr(0) then begin xx := 0; yy := 0; if ch = cup then yy := -1 else if ch = cdown then yy := 1 else if ch = cleft then xx := -1 else if ch = cright then xx := 1; if (xx + yy) <> 0 then begin newdog := dog; with newdog do begin x := x + xx; y := y + yy end; if not collision(newdog) then begin with dog do place(x, y, nothing, space); dog := newdog; with dog do begin place(x, y, user, doggy); movedog := jobdone end end end end end; function update:boolean; begin score := score - 2; locate(scorexl, scorey); write(score : 4); update := score = 0 end; function movesheep:boolean; var xdef, ydef, dx, dy, xabs, yabs : integer; i : integer; terminate : boolean; newsheep : animal; function sgn(i : integer):integer; begin if i > 0 then sgn := 1 else if i < 0 then sgn := -1 else sgn := 0 end; begin terminate := false; xdef := trunc(rnd(0) * 3.0) - 1; ydef := trunc(rnd(0) * 3.0) - 1; if ((xdef < -1) or (xdef > 1)) or ((ydef < -1) or (ydef > 1)) then write(xdef:3, ydef:3); i := 0; repeat i := i + 1; with sheep[i] do begin xabs := abs(dog.x - x); yabs := abs(dog.y - y); if ((xabs < 2) and (yabs < 2)) or ((xabs > 16) or (yabs > 8)) then begin dx := xdef; dy := ydef end else begin dx := sgn(x - dog.x); dy := sgn(y - dog.y) end; newsheep := sheep[i]; with newsheep do begin x := x + dx; y := y + dy end; if not collision(newsheep) then begin place(x, y, nothing, space); sheep[i] := newsheep; with newsheep do place(x, y, object, sheepy) end; xdef := dx; ydef := dy; terminate := movedog end until (i = sheepsize) or terminate; movesheep := terminate end; procedure finishup; var ch : char; begin locate(penxl - 6, penyl - 3); write('G a m e O v e r'); locate(penxl - 10, penyl - 1); write('Press to Continue'); repeat read(ch) until ch = space end; function play:boolean; var ch : char; begin clearscreen; jswreset(12); jswreset(6); if score > -1 then begin writeln; writeln('Your Score : ', score); writeln; writeln end; writeln(' S h e e p d o g T r i a l s'); writeln; writeln(' You must attempt to manoeuvre the sheep into the pen in the'); writeln('centre of the screen. You control the sheepdog while up to six'); writeln('sheep wander about the screen.'); writeln; writeln(' The sheep will wander according to the following rules :'); writeln('1. If the dog is the correct distance from the sheep, the sheep'); writeln(' will move away from the sheepdog.'); writeln('2. If the dog is too far away, the sheep will move randomly.'); writeln('3. If the dog is too near, the sheep will panic and scatter.'); writeln('4. Sheep directed into the pen will escape if left unguarded'); writeln(' for too long.'); writeln('5. All other things being equal, the sheep will tend to follow'); writeln(' each other.'); writeln; writeln(' When you have rounded up the sheep, place the dog in the'); writeln('gate of the pen to end the game.'); writeln; writeln; write('Would you like to play ? [Y/N] '); readln(ch); play := ch = 'Y' end; procedure initialise; var i, j : integer; rubbish : boolean; begin finished := false; repeat write('Number of sheep desired [1..', maxanimals, '] : '); readln(sheepsize) until (sheepsize >= 1) and (sheepsize <= maxanimals); jswset(12); jswset(6); for i := 2 to (screenx - 1) do begin for j := 2 to (screeny - 1) do begin screen[i, j] := nothing end end; clearscreen; for i := 1 to screenx do begin place(i, 1, border, marginx); place(i, screeny, border, marginx) end; for j := 2 to (screeny - 1) do begin place(1, j, border, marginy); place(screenx, j, border, marginy) end; for i := penxl to penxu do begin place(i, penyl, pen, pennyx); place(i, penyu, pen, pennyx) end; for j := (penyl + 1) to (penyu - 1) do begin place(penxl, j, pen, pennyy); place(penxu, j, pen, pennyy) end; place(gatex, gatey, nothing, space); for i := scorexl to scorexu do place(i, scorey, status, space); score := 3000 + sheepsize * 1000 + 2; rubbish := update; for i := 1 to sheepsize do begin sheep[i] := sheepstart[i]; with sheep[i] do place(x, y, object, sheepy) end; repeat with dog do begin x := trunc(rnd(0) * float(screenx)) + 1; y := trunc(rnd(0) * float(screeny)) + 1 end until not collision(dog); with dog do place(x, y, user, doggy) end; begin score := -1; while play do begin initialise; loop i := 0; loop i := i + 1; finished := movedog; exit if finished; if (i mod scorecount) = 0 then finished := update; exit if finished or (i = dogmoves); end; exit if finished; finished := movesheep; exit if finished; end; finishup end end.