给一些PASCAL小游戏的源程序

program bobo

uses crt

type type1=record

h,l,f:integer

end

const m:array[1..6,1..16]of integer=

((1,0,1,1,1,0,1,0,1,0,1,1,1,0,0,0),

(1,2,1,2,0,2,1,2,1,2,0,2,0,2,0,2),

(1,1,1,0,1,1,1,0,1,0,1,0,0,1,1,1),

{(0,2,0,2,1,2,0,2,0,2,1,2,1,2,0,2),

(0,0,0,1,1,1,1,1,1,1,1,1,1,1,0,0), }

(0,2,1,2,1,2,0,2,0,2,1,2,1,2,1,2),

(0,0,1,0,1,1,1,0,1,0,1,0,1,1,1,1),

(0,2,1,2,0,2,0,2,1,2,0,2,0,2,1,2))

var yellow,white:type1

ybomb,wbomb:array[1..10]of type1

fire:array[1..100]of type1

map:array[0..6,0..16]of integer

yb,wb,ybo,wbo,yw,yv,wv,ww,tms,ts,tm,t:integer

yueshi,weili:array[1..10]of type1

b:boolean

procedure pushtype1(var t:array of type1th,tl,tf:integer)

var i:integer

begin

for i:=1 to high(t) do

with t[i] do

if f<=0 then

begin

f:=tf

h:=th

l:=tl

exit

end

end

procedure print

var i,j:integer

begin

textbackground(black)

clrscr

for i:=1 to 16 do

for j:=1 to 6 do

if map[j,i] in [1,2] then

begin

if map[j,i]=1 then textcolor(green)

else if map[j,i]=2 then textcolor(brown)

gotoxy(i*4-3,j*4-3)write('>>>>')

gotoxy(i*4-3,j*4-2)write('>>>>')

gotoxy(i*4-3,j*4-1)write('>>>>')

gotoxy(i*4-3,j*4-0)write('>谈唯>>>')

end

for i:=1 to high(fire) do

with fire[i] do

if f>0 then

begin

textcolor(red)

gotoxy(l*4-3,h*4-3)write('>>岁侍简<<')

gotoxy(l*4-3,h*4-2)write('>><<'乎裤)

gotoxy(l*4-3,h*4-1)write('>><<')

gotoxy(l*4-3,h*4-0)write('>><<')

end

for i:=1 to high(yueshi) do

with yueshi[i] do

if f>0 then

begin

textcolor(red)

gotoxy(l*4-3,h*4-3)write(' /\ ')

gotoxy(l*4-3,h*4-2)write('/__\')

gotoxy(l*4-3,h*4-1)write('\ /')

gotoxy(l*4-3,h*4-0)write(' \/ ')

end

for i:=1 to high(weili) do

with weili[i] do

if f>0 then

begin

textcolor(114)

gotoxy(l*4-3,h*4-3)write('____')

gotoxy(l*4-3,h*4-2)write('|/\|')

gotoxy(l*4-3,h*4-1)write('|\/|')

gotoxy(l*4-3,h*4-0)write('/__/')

end

for i:=1 to high(ybomb) do

with ybomb[i] do

if f>0 then

begin

textcolor(blue)

gotoxy(l*4-3,h*4-3)write(' XX ')

gotoxy(l*4-3,h*4-2)write('| |')

gotoxy(l*4-3,h*4-1)write('| |')

gotoxy(l*4-3,h*4-0)write('\__/')

end

for i:=1 to high(wbomb) do

with wbomb[i] do

if f>0 then

begin

textcolor(blue)

gotoxy(l*4-3,h*4-3)write(' XX ')

gotoxy(l*4-3,h*4-2)write('| |')

gotoxy(l*4-3,h*4-1)write('| |')

gotoxy(l*4-3,h*4-0)write('\__/')

end

textbackground(black)

textbackground(black)

if yellow.f>0 then textcolor(14)

else textcolor(12)

gotoxy(yellow.l*4-3,yellow.h*4-3)write('/--\')

gotoxy(yellow.l*4-3,yellow.h*4-2)write('|^^|')

gotoxy(yellow.l*4-3,yellow.h*4-1)write('|\/|')

gotoxy(yellow.l*4-3,yellow.h*4-0)write('\__/')

if white.f>0 then textcolor(15)

else textcolor(12)

gotoxy(white.l*4-3,white.h*4-3)write('/--\')

gotoxy(white.l*4-3,white.h*4-2)write('|^^|')

gotoxy(white.l*4-3,white.h*4-1)write('|\/|')

gotoxy(white.l*4-3,white.h*4-0)write('\__/')

end

procedure newthing(h,l:integer)

var i:integer

begin

b:=true

i:=random(3)

if i<=0 then pushtype1(yueshi,h,l,1)

else if i=1 then pushtype1(weili,h,l,1)

end

procedure checkthing

var i:integer

begin

for i:=1 to high(yueshi) do

with yueshi[i] do

begin

if (f>0)and(h=yellow.h)and(l=yellow.l) then begin b:=trueinc(yb)f:=0end

if (f>0)and(h=white.h)and(l=white.l) then begin b:=trueinc(wb)f:=0end

end

for i:=1 to high(weili) do

with weili[i] do

begin

if (f>0)and(h=yellow.h)and(l=yellow.l) then begin b:=trueinc(yw)f:=0end

if (f>0)and(h=white.h)and(l=white.l) then begin b:=trueinc(ww)f:=0end

end

end

procedure runbomby(ch:char)

begin

if ch='q' then halt

{yellow}

if ch in['f','j','k','l','i'] then

begin

if(ch='f')and(yb>0){and(map[yellow.h,yellow.l]=0)}then

begin dec(yb)pushtype1(ybomb,yellow.h,yellow.l,3)map[yellow.h,yellow.l]:=4end

else if(ch='j')and(map[yellow.h,yellow.l-1]=0)and(yellow.l>1) then dec(yellow.l)

else if(ch='l')and(map[yellow.h,yellow.l+1]=0)and(yellow.l<16) then inc(yellow.l)

else if(ch='i')and(map[yellow.h-1,yellow.l]=0)and(yellow.h>1) then dec(yellow.h)

else if(ch='k')and(map[yellow.h+1,yellow.l]=0)and(yellow.h<6) then inc(yellow.h)

end

{white}

else if ch in['8','6','5','4','0'] then

begin

if(ch='0')and(wb>0){and(map[white.h,white.l]=0)}then

begin dec(wb)pushtype1(wbomb,white.h,white.l,3)map[white.h,white.l]:=4end

else if(ch='4')and(map[white.h,white.l-1]=0)and(white.l>1) then dec(white.l)

else if(ch='6')and(map[white.h,white.l+1]=0)and(white.l<16) then inc(white.l)

else if(ch='8')and(map[white.h-1,white.l]=0)and(white.h>1) then dec(white.h)

else if(ch='5')and(map[white.h+1,white.l]=0)and(white.h<6) then inc(white.h)

end

end

procedure bomb(h,l,w:integer)

const fx:array[1..4,1..2]of -1..1=((1,0),(0,1),(-1,0),(0,-1))

var i,j,xh,xl:integer

begin

b:=true

pushtype1(fire,h,l,5)

for j:=1 to 4 do

begin

xh:=hxl:=l

for i:=1 to w do

begin

inc(xh,fx[j,1])

inc(xl,fx[j,2])

if (xh<1)or(xh>6)or(xl<1)or(xl>16) then break

if map[xh,xl]=1 then begin pushtype1(fire,xh,xl,5)map[xh,xl]:=0newthing(xh,xl)breakend

else if map[xh,xl]=2 then break

else pushtype1(fire,xh,xl,5)

end

end

end

procedure check

var i,t:integer

begin

t:=0

for i:=1 to high(fire) do

with fire[i] do

begin

if (f>0)and(h=yellow.h)and(l=yellow.l) then begin yellow.f:=0b:=trueend

if (f>0)and(h=white.h)and(l=white.l) then begin white.f:=0b:=trueend

end

end

procedure runbomb

var i:integer

begin

for i:=1 to high(ybomb) do

with ybomb[i] do

if f>0 then

begin

dec(f)

if f<=0 then

begin

map[h,l]:=0

bomb(h,l,yw)

inc(yb)

end

end

for i:=1 to high(wbomb) do

with wbomb[i] do

if f>0 then

begin

dec(f)

if f<=0 then

begin

map[h,l]:=0

bomb(h,l,ww)

inc(wb)

end

end

end

procedure init

var i,j:integer

begin

yb:=1wb:=1yw:=1ww:=1

textbackground(black)

clrscr

fillchar(map,sizeof(map),0)

for i:=1 to 6 do

for j:=1 to 16 do

map[i,j]:=m[i,j]

with yellow do begin f:=1h:=6l:=1end

with white do begin f:=1h:=1l:=16end

fillchar(ybomb,sizeof(ybomb),0)

fillchar(wbomb,sizeof(wbomb),0)

fillchar(fire,sizeof(fire),0)

fillchar(yueshi,sizeof(yueshi),0)

fillchar(weili,sizeof(weili),0)

tms:=0tm:=0ts:=0

end

procedure main

var ch:char

i:integer

begin

t:=0

while (white.f=1)and(yellow.f=1) do

begin

b:=false

delay(8)

inc(tms,10)

if tms=1000 then

begin

tms:=0

inc(ts)

if ts=60 then

begin

inc(tm)

ts:=0

end

end

if tms mod 100=0 then

for i:=1 to high(fire) do

begin

if fire[i].f=0 then b:=true

dec(fire[i].f)

end

if keypressed then

begin

ch:=readkey

b:=true

runbomby(ch)

end

if tms=0 then runbomb

check

checkthing

if b then begin printinc(t)end

end

delay(500)

end

procedure over

var ch:char

i:integer

begin

clrscr

gotoxy(1,1)

if (white.f=0)and(yellow.f=0) then

begin

writeln('DDDRRR A W W W ')

writeln('D D R RA AW W W W ')

writeln('D D RR AAAAA WWWW ')

writeln('DDDR RR AA W W ')

end

else if yellow.f=0 then

begin

textcolor(15)

writeln('W W W HH IIII TTTTTT EEEEEEW W W OOO N N')

writeln('W W W W HHHHH II TTEE____W W W W OO NN N')

writeln('WWWW HH II TTEEWWWW OO N NN')

writeln('W W HH IIIITTEEEEEEW W OOO N N')

end

else if white.f=0 then

begin

textcolor(14)

writeln('YY EEEEEE L L OOO W W WW W W OOO N N')

writeln(' Y Y EE____ L L OO W W W WW W W W OO NN N')

writeln(' YEE L L OO WWWWWWWW OO N NN')

writeln(' YEEEEEE LLLL LLLL OOO W WW W OOO N N')

end

repeat ch:=readkeyuntil ch=#13

end

begin

while true do

begin

init

main

over

end

readln

end.

楼上的是穷举粗仔算法，要O（n^2）含春的时间。

我的是DP，只用O（n）的时间，比他快了n倍岩老汪。

var

x,y,tmp,now,i:longint

ax,ay,ans:longint

begin

ax:=0

ay:=0

ans:=0

now:=0

x:=0

y:=0

i:=0

while not eoln do begin

read(tmp)

inc(i)

now:=now+tmp

if now<tmp then begin

now:=tmp

x:=i

end

y:=i

if now>ans then begin

ans:=now

ax:=x

ay:=y

end

end

readln

writeln('max=',ans)

writeln('From No.',ax,' to No.',ay)

end.

---