rem ************************************************************************
rem * PONG WITH HIGH SCORE TABLE *
rem ************************************************************************
set display mode 800,600,16
`.......................................................
` hope you find this a help to you
` by xmen
`......................................................
sync on
hide mouse
dim NAME$(21)
dim score(21)
dim input$(1)
dim oldname$(20)
dim oldscore(20)
FILENAME$="c:\pongscore.pscr"
`...................................Name of players................
NAME$(1)="xmen"
NAME$(2)="big"
NAME$(3)="soft"
NAME$(4)="hard"
NAME$(5)="bad"
NAME$(6)="nice"
NAME$(7)="sweet"
NAME$(8)="darkbasic"
NAME$(9)="darkbasic pro"
NAME$(10)="empty"
NAME$(11)="old"
NAME$(12)="sweet score"
NAME$(13)="darkbasic cool"
NAME$(14)="darkbasic pro dont no"
NAME$(15)="empty"
NAME$(16)="empty"
NAME$(17)="empty"
NAME$(18)="empty"
NAME$(19)="secand to last"
NAME$(20)="last"
`....................................Score of players................
SCORE(1)=5000
SCORE(2)=4000
SCORE(3)=3000
SCORE(4)=2000
SCORE(5)=1000
SCORE(6)=500
SCORE(7)=400
SCORE(8)=300
SCORE(9)=200
SCORE(10)=100
SCORE(11)=90
SCORE(12)=80
SCORE(13)=70
SCORE(14)=60
SCORE(15)=50
SCORE(16)=40
SCORE(17)=30
SCORE(18)=20
SCORE(19)=10
SCORE(20)=5
ink rgb(255,0,0),1
text 2,2,"..PONG.."
get image 3,1,1,text width("..PONG.."),text height("..PONG.."),3
sprite 3,-1000,-10000,3
cls
for a=0 to 8
ink rgb(250,250,250),1
circle 11,11,a
next a
get image 2,0,0,25,25
cls
text 320,300,"....Get ready..."
sleep 2000
wall_x1=20:wall_y1=20:wall_x2=620:wall_y2=460
rem Define paddle properties
paddle_x=bitmap width()-100:paddle_y=240
paddle_size=50:paddle_speed=15
rem Place restart marker
`start:
rem Define ball properties
ball_x#=rnd(100)+270:ball_y#=rnd(100)+190:ball_radius=5
orig_ball_move_x#=-20.5:ball_move_x#=orig_ball_move_x#
orig_ball_move_y#=-7.6:ball_move_y#=orig_ball_move_y#
rem Set buffers on and turn off the mouse
rem Main loop
do
`paste image 7,21,30
ink rgb(255,255,255),0
box wall_x1-1,wall_y1-1,bitmap width()-1,wall_y2+17
ink rgb(0,200,0),1
`box 1,30,bitmap width()-20,bitmap height()-100
box wall_x1,wall_y1,bitmap width()-1,wall_y2+16
`bitmap height()-50
ink rgb(200,200,200),1
circle bitmap width()/2,bitmap height()/2-40,50
line bitmap width()/2,wall_y1,bitmap width()/2+1,wall_y2+17
box 15+paddle_x,paddle_y-paddle_size,15+paddle_x+2,paddle_y+paddle_size
sprite 1,paddle_x,paddle_y,1
sprite 2,ball_x#,ball_y#,2
`ball_radius
rem Draw score
text 0,0,"Score: "+str$(score)
rem Detect for key pressed and move the paddle accordingly
if upkey()=1 then dec paddle_y,paddle_speed
if downkey()=1 then inc paddle_y,paddle_speed
`if leftkey()=1 then dec paddle_x,paddle_speed
`if rightkey()=1 then inc paddle_x,paddle_speed
rem Stop paddles from going off the screen
if paddle_y-paddle_size<=wall_y1 then paddle_y=wall_y1+paddle_size
if paddle_y+paddle_size>=wall_y2 then paddle_y=wall_y2-paddle_size
rem Detect collision of ball on the walls
if ball_x#-ball_radius<=wall_x1 then ball_move_x#=0-ball_move_x#
if ball_y#-ball_radius<=wall_y1 then ball_move_y#=0-ball_move_y#:ball_y#=wall_y1+ball_radius
if ball_y#+ball_radius>=wall_y2 then ball_move_y#=0-ball_move_y#:ball_y#=wall_y2-ball_radius
rem Detect for collision of the ball on the paddle
if ball_x#+ball_radius>=paddle_x-5 and ball_x#+ball_radius<=paddle_x+20 and ball_y#>=paddle_y-paddle_size and ball_y#<=paddle_y+paddle_size
ball_move_x#=0-ball_move_x#:score=score+50
rem Adjust the y-movement of the ball according to where it hit the paddle
ball_move_y#=orig_ball_move_y#*(paddle_y-ball_y#)/30
endif
rem Move the ball
inc ball_x#,ball_move_x#
inc ball_y#,ball_move_y#
rem Reset if the ball goes off screen
if ball_x#>790
for a=1 to 50
sprite 3,bitmap width()/3+50,bitmap height()/3,3
scale sprite 3,100+a*8
sync
next a
sprite 3,-1000,-10000,3
if score>5
open to read 1,filename$
for num=1 to 21
read string 1,name$(num)
read long 1,score(num)
next num
close file 1
`....................................Function that ask for name...........
input("Enter Name..")
`................................Score of Player......................
newscore(score)
`.................................Show score...........................
`gosub load
gosub setup
gosub save
gosub LOAD
if score>50 then score=score-50 else score=0
ball_x#=rnd(100)+270:ball_y#=rnd(100)+190:ball_radius=5
orig_ball_move_x#=-20.5:ball_move_x#=orig_ball_move_x#
orig_ball_move_y#=-7.6:ball_move_y#=orig_ball_move_y#
endif
if score>50 then score=score-50 else score=0
`goto start
ball_x#=rnd(100)+270:ball_y#=rnd(100)+190:ball_radius=5
orig_ball_move_x#=-20.5:ball_move_x#=orig_ball_move_x#
orig_ball_move_y#=-7.6:ball_move_y#=orig_ball_move_y#
endif
rem Refresh screen
sync
cls
rem Loop to the beginning
loop
`........................................Save Score.....................
SAVE:
IF FILE EXIST(filename$) THEN DELETE FILE filename$
open to write 1,filename$
for num=1 to 21
write string 1,name$(num)
write long 1,score(num)
next num
close file 1
RETURN
`.......................................Load Score.....................
LOAD:
open to read 1,filename$
for num=1 to 21
read string 1,name$(num)
read long 1,score(num)
next num
close file 1
repeat
text 320,550," Mouse click to exit "
sync
until mouseclick()
cls
text 320,300,"Get ready"
sleep 2000
score=0
RETURN
SETUP:
ink rgb(0,0,120),1
box 100,10,bitmap width()-100,bitmap height()-100
ink rgb(0,0,100),1
box 102,12,bitmap width()-102,bitmap height()-102
ink rgb(0,0,80),1
box 103,13,bitmap width()-103,30
ink rgb(0,0,200),1
box 103,32,bitmap width()-103,bitmap height()-103
ink rgb(255,255,255),1
box 114,43,bitmap width()-114,bitmap height()-114
ink rgb(255,255,255),1
set text font "times new roman"
set text size 16
set text to bold
Text bitmap width()/2-50,15,"HIGHT SCORE"
FOR NUM=1 TO 20
ink rgb(0,0,0),1
Text 120,28+NUM *TEXT HEIGHT(NAME$(NUM)),str$(num)+" "+NAME$(NUM)
`line 120,28+NUM *TEXT HEIGHT(NAME$(NUM)), bitmap width()-115,28+NUM *TEXT HEIGHT(NAME$(NUM))
ink rgb(250,0,0),1
Text bitmap width()-200,28+NUM *TEXT HEIGHT(NAME$(NUM)),str$(score(NUM))
NEXT NUM
RETURN
`........................................INPUT NAME.....................
FUNCTION INPUT(t$)
Done=0
set text font "system"
c$=""
cs3$=""
tw=text width(t$)+12
if len(t$)<10 then tw=99:wt=28
ti=0
dtime=0
ink rgb(120,120,120),1
box 230,130,234+tw,180
ink rgb(220,220,210),1
box 231,131,233+tw,179
ink rgb(170,170,140),1
box 232,132,232+tw,145
ink rgb(255,255,255),1
box 232,148,232+tw,178
ink rgb(255,255,255),1
if len(t$)<10 then center text 284,130,t$
if len(t$)=>10 then text 237+wt,130,t$:tw=88
repeat
if a$="" then ky=0 else ky=1
a$=inkey$()
if scancode()=14 and ky=0 then d$=left$(c$,len(c$)-1):c$=d$ :ink rgb(255,255,255),1
if scancode()<>14 and ky=0 then b$=a$
if a$<>"" and ky=0 and text width(c$)<330
c$=c$+b$
ink rgb(255,255,255),1
box 232,148,232+tw,178
ink rgb(0,0,0),1
center text 280,155,c$
input$(1)=c$
if text width(c$)>100
CS3$=CS3$+A$
ink rgb(120,120,120),1
box 230-text width(CS3$),130,234+tw+text width(CS3$)+20,180
ink rgb(220,220,210),1
box 231-text width(CS3$),131,233+tw+text width(CS3$)+20,179
ink rgb(170,170,140),1
box 232-text width(CS3$),132,232+tw+text width(CS3$)+20,145
ink rgb(255,255,255),1
box 232-text width(CS3$),148,232+tw+text width(CS3$)+20,178
ink rgb(255,255,255),1
if len(t$)<10 then center text 285+text width(CS3$)/text width(T$),130,t$
if len(t$)=>10 then center text 285+text width(CS3$)/text width(T$)+wt,130,t$:done=1
ink rgb(0,0,0),1
center text 280,155,c$
endif
endif
sync
until returnkey() or Done=1
Done=0
endfunction
`......................................Function to change score........
FUNCTION NEWSCORE(score)
for scr=1 to 20
oldname$(scr)=name$(scr)
oldscore(scr)=score(scr)
next scr
for scr=1 to 20
if score=>score(scr)
pos=scr
exit
endif
next scr
for newscr=pos to 20
name$(pos)=input$(1)
score(pos)=score
name$(newscr+1)=oldname$(newscr)
score(newscr+1)=oldscore(newscr)
next newscr
ENDFUNCTION
