home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
educ
/
count2.zip
/
COUNT2.PAS
Wrap
Pascal/Delphi Source File
|
1985-10-05
|
3KB
|
97 lines
program COUNT ;
{This is a counting program for small children that uses screen control.
It was written for TURBO pascal.
Revision 1.0 3-22-85 Mike Secord}
{$I-}
const
num = 14 ; {this sets the maximum number of items to count 14 is prog max}
var
i, j, k, l, n: integer ;
flag, ok: boolean ;
done: string[1] ;
procedure drawbox(x1,y1,x2,y2: integer) ;
var
i: integer ;
begin
gotoxy(x1,y1) ;
lowvideo ;
for i := x1 to x2 do write(' ') ;
gotoxy(x1,y1+1) ;
for i := y1+1 to y2 do
begin
gotoxy(x1,i) ; write(' ') ;
gotoxy(x2,i) ; write(' ') ;
end ;
gotoxy(x1,y2) ;
for i := x1 to x2 do write(' ') ;
end; {of procedure drawbox}
procedure face (x1,y1: integer; happy: boolean) ;
{x1 and y1 are the upper left hand corner of the box containing the face}
var
i : integer ;
begin
gotoxy(x1,y1) ; writeln(' ***** ') ;
gotoxy(x1,y1+1) ; writeln(' * o o * ') ;
gotoxy(x1,y1+2) ; writeln('* ^ *') ;
gotoxy(x1,y1+3) ;
if happy = true then writeln(' * |___| * ') ;
if happy = false then writeln(' * .---. * ') ;
gotoxy(x1,y1+4) ; writeln(' ***** ') ;
end;{of face procedure}
begin {main program}
clrscr ;
gotoxy(20,12) ;
write('C O U N T T H E I T E M S G A M E ') ;
delay(3000) ;
repeat
clrscr ;
flag := true ;
highvideo ;
for j := 1 to 5 do
begin
drawbox(20, 4, 60, 12 ) ;
highvideo ;
gotoxy(21,7) ;
write(' ') ;
gotoxy(21,9) ;
write(' ') ;
randomize ;
for i:= 1 to random(num)+1 do
begin
if i > 7 then
begin
gotoxy(20+5*(i-7),9) ;
write('##') ;
end ;
if i< 8 then
begin
gotoxy(20+5*i, 7) ;
write('##') ;
end ;
end ;
repeat
gotoxy(45,15) ;
write('HOW MANY ITEMS IN THE BOX ? ',^H,^H,^H,^H,^H,^H,^H) ;
read(k) ;
ok := (ioresult = 0) ;
if not ok then write(^G) ;
until ok ;
if k = i then flag:=true
else flag := false ;
lowvideo ;
if j = 1 then face(1,19,flag)
else face((j-1)*15, 19, flag) ;
end;
highvideo ;
repeat
writeln ;
write('WOULD YOU LIKE TO PLAY AGAIN (Y or N) ? ') ;
readln(done) ;
ok := (ioresult = 0) ;
if not ok then write(^G) ;
until ok ;
until (done = 'n') or (done = 'N') ;
end.