Play station Joystick test

#Basic code
clg
graphsize 500,500
font "arial",10,100
openserial 1, "COM3"
x=250
y=250
dx=0
dy=0
for a = 1 to 90000
n=asc (read(1))
if int (n/10)=1 then dx=-1
if int (n/10)=2 then dx=0
if int (n/10)=3 then dx=1
if int (n/10)=4 then dy=-1
if int (n/10)=5 then dy=0
if int (n/10)=6 then dy=1
x=x-dx
y=y+dy
circle x, y,2
next a

// Arduino code
 int x = 0;
 int y = 0;
 int F = 0;    
void setup()
{  Serial.begin(9600);
}
void loop()
{
  x = map(analogRead(1),0,1023,15,35);
  y = map(analogRead(2),0,1023,45,65);
  F = map(analogRead(0),0,1023,78,88);
  Serial.write(x);
  delay(10);
  Serial.write(y);
  delay(10);
  Serial.write(F);
  delay(10);
}

Parametric Spirograph

r=90
centerx=150
centery=150
rm=30
for n = 1 to 6
color rgb(int (rand*3)*127, int(rand*3)*127, int(rand*3)*127)
for t = 0 to 6.28 step .002
x=r*sin(t)+centerx
y=r*cos(t)+centery
xm=rm*sin(-t*3*n)+x
ym=rm*cos(-t*3*n)+y
circle xm,ym,1
next t
next n

Graphing a sensor using Arduino

#Basic code
graphsize 900,300
font "arial",10,100
openserial 1, "COM4"
for window = 1 to 300
clg
for l = 25 to 325 step 25
line 30,l,900,l
text 0,l-5,5.5-int(l)/50+"V"
next l
for x = 1 to 900
pause .01
n=asc (read(1))
print n
circle x,277-2*n,2
next x
next window

// Arduino code
 int L = 0;
 int S = 0;         
void setup()
{  Serial.begin(9600); }

void loop()
{
  L = analogRead(2);
  S = map(L ,0,1023,0,127);
  //Serial.println(L); 
 Serial.write(S);       
  delay(50);
}

Hello World

# Creates a file and writes hellow world
# The file is in the same folder as the basic application
# Use notepad or word to open
open "blackboard.txt"
write "Hello world"

Pythagoras Game

graphsize 600,400
color black
rect 0,0,600,400
color white
x1=int(rand*600)
y1=int(rand*400)
circle x1,y1,3
x2=int(rand*600)
y2=int(rand*400)
circle x2,y2,3
# Vertical and Horizontal distance
h=x1-x2
v=y1-y2
# Pythagoras formula
dist=sqrt(v^2+h^2)
Print "The black rectangle is 600 by 400"
input "What is the distance between the points",a
font "arial" ,30,30

text 150,200,"Distance="+int(dist)

Pac Man

levels=1
fastgraphics
graphsize 600,600
clg
dim board$ (16,levels)
dim area$ (16,30)
dim monstersname$(4)
dim monsterx(4)
dim monstery(4)
dim monsterxspeed(4)
dim monsteryspeed(4)
board$ [0,0]= "HHHHHHHHHHHHHHHHHHHHHHH       "
board$ [1,0]= "H**********H**********H Score "
board$ [2,0]= "H@HHH*HHHH*H*HHHH*HHH@H       "
board$ [3,0]= "H*********************H       "
board$ [4,0]= "H*HHH*H*HHH HHH*H*HHH*H @ 5P  "
board$ [5,0]= "H*****H*********H*****H       "
board$ [6,0]= "HHHHH*H*HHHHHHH*H*HHHHH * 1p  "
board$ [7,0]= "HHHHH*H         H*HHHHH       "
board$ [8,0]= "HHHHH*H HHH HHH H*HHHHH       "
board$ [9,0]= "        H     H         Lifes "
board$ [10,0]="H*HHH*H HHHHHHH H*HHH*H       "
board$ [11,0]="H@HHH*H         H*HHH@H       "
board$ [12,0]="H*HHH*H*HHH*HHH*H*HHH*H       "
board$ [13,0]="H*HHH*H*HHH*HHH*H*HHH*H       "
board$ [14,0]="H*********************H       "
board$ [15,0]="HHHHHHHHHHHHHHHHHHHHHHH       "
font "courier" ,25,200

# To put the board in a 2D array easier to handle
for row = 0 to 15
for collum = 0 to 29
area$ [row,collum]= mid( board$ [row,0],collum+1,1)
next collum
next row

# Main loop
for life = 3 to 0 step- 1
# Drawing the board
color black
rect 0,0,600,405
for y = 0 to 15
for x = 0 to 29
if area$[y,x]= "H" then color white
if area$[y,x]= "*" then color Yellow
if area$[y,x]= "@" then color red
text x*20,y*25,area$[y,x]
next x
next y

if life = 0 then
color green
font "Aril" ,50,100
Text 50,50,"GAME OVER"
refresh
end
end if


# initial variables for packman
xspeed = 1
yspeed = 0
xpac = 220
ypac = 125
mouth=0
Score = 0
dead = false

# initial positions for monsters
monstersname$[0]="Blue"
monsterx[0]=190
monstery[0]=240
monsterxspeed[0]=1
monsteryspeed[0]=0
monstersname$[1]="Yellow"
monsterx[1]=210
monstery[1]=240
monsterxspeed[1]=1
monsteryspeed[1]=0
monstersname$[2]="Orange"
monsterx[2]=190
monstery[2]=240
monsterxspeed[2]=-1
monsteryspeed[2]=0
monstersname$[3]="Purple"
monsterx[3]=210
monstery[3]=240
monsterxspeed[3]=-1
monsteryspeed[3]=0


# Action loop
do
gosub packman
gosub monsters
refresh
pause .01
if Score = 139 then
color green
font "Aril" ,50,100
Text 50,50,"You won"
refresh
end
end if
until dead = true
next life



monsters:
for n = 0 to 3

# Erases monster for next frame
color black
rect monsterx[n]-10,monstery[n]-10,21,21

# Changing monster direction
if (monsterx[n]+10)%20 =0 and (monstery[n]+10)%25=0 then

xcell=int((monsterx[n])/20)
ycell=int(monstery[n]/25)
self$ = area$[ycell,xcell]
lef$ = area$[ycell,xcell-1]
righ$ = area$[ycell,xcell+1]
up$ = area$[ycell-1,xcell]
down$ = area$[ycell+1,xcell]

flag=false
# when the monster is going right
if monsterxspeed[n]=1 then
if up$<>"H" and int(rand*2)>0 and flag = false then
monsteryspeed[n]=-1
monsterxspeed[n]=0
flag=true
end if
if down$<>"H" and flag = false then
monsteryspeed[n]=1
monsterxspeed[n]=0
flag=true
end if
if righ$="H" and flag = false then
monsteryspeed[n]=0
monsterxspeed[n]=-1
flag=true
end if
if lef$= "*" then color Yellow
if lef$= "@" then color red
if lef$= "*" or lef$= "@" then text (xcell-1)*20,ycell*25,lef$
end if
# when the monster is going left
if monsterxspeed[n]=-1 then
if up$<>"H" and int(rand*2)>0 and flag = false then
monsteryspeed[n]=-1
monsterxspeed[n]=0
flag=true
end if
if down$<>"H" and flag = false then
monsteryspeed[n]=1
monsterxspeed[n]=0
flag=true
end if
if lef$="H" and flag = false then
monsteryspeed[n]=0
monsterxspeed[n]=1
flag=true
end if
if righ$= "*" then color Yellow
if righ$= "@" then color red
if righ$= "*" or righ$= "@" then text (xcell+1)*20,ycell*25,righ$
end if
# when the monster is going up
if monsteryspeed[n]=-1 then
if lef$<>"H" and int(rand*2)>0 and flag = false then
monsteryspeed[n]=0
monsterxspeed[n]=-1
flag = true
end if
if righ$<>"H" and flag = false then
monsteryspeed[n]=0
monsterxspeed[n]=1
flag = true
end if
if up$="H" and flag = false then
monsteryspeed[n]=1
monsterxspeed[n]=0
flag=true
end if
if down$= "*" then color Yellow
if down$= "@" then color red
if down$= "*" or down$= "@" then text xcell*20,(ycell+1)*25,down$
end if
# when the monster is going down
if monsteryspeed[n]=1 then
if lef$<>"H" and int(rand*2)>0 and flag = false then
monsteryspeed[n]=0
monsterxspeed[n]=-1
flag = true
end if
if righ$<>"H" and flag = false then
monsteryspeed[n]=0
monsterxspeed[n]=1
flag = true
end if
if down$="H" and flag = false then
monsteryspeed[n]=-1
monsterxspeed[n]=0
flag = true
end if
if up$= "*" then color Yellow
if up$= "@" then color red
if up$= "*" or up$= "@" then text xcell*20,(ycell-1)*25,up$
end if
end if


# Shift from left to right of the board
IF monsterx[n] = 15 THEN monsterx[n] = 435
IF monsterx[n] = 440 THEN monsterx[n] = 15

monsterx[n]=monsterx[n]+monsterxspeed[n]
monstery[n]=monstery[n]+monsteryspeed[n]

# Drawing the monsters
if n = 0 then color Blue
if n = 1 then color Orange
if n = 2 then color Yellow
if n = 3 then color Purple
Circle monsterx[n],monstery[n],10
rect monsterx[n]-10,monstery[n],21,11
# Monsters eyes and mouth
color white
Circle monsterx[n]-3,monstery[n]-4,4
Circle monsterx[n]+3,monstery[n]-4,4
color black
Circle monsterx[n]-3+monsterxspeed[n]*2,monstery[n]+monsteryspeed[n]*2-4,2
Circle monsterx[n]+3+monsterxspeed[n]*2,monstery[n]-4+monsteryspeed[n]*2,2
rect monsterx[n]-4,monstery[n]+4,8,3

# Pac dies
if abs(monsterx[n] - (xpac+10))<2 and abs(monstery[n]-(ypac+15))<2 then
dead = true
sound 1000,1000
end if
next n

return


packman:
# Erases pacman for next frame
color black
rect xpac,ypac,20,28

# Identifies the cells around pacman
if xpac/20 =int(xpac/20) and ypac/25=int(ypac/25)then
xcell=int((xpac)/20)
ycell=int(ypac/25)
self$ = area$[ycell,xcell]
lef$ = area$[ycell,xcell-1]
righ$ = area$[ycell,xcell+1]
up$ = area$[ycell-1,xcell]
down$ = area$[ycell+1,xcell]
# Key controls
z = key
if z = 16777235 and up$<>"H" then
yspeed = -1
xspeed = 0
end if
if z = 16777237 and down$<>"H" then
yspeed = 1
xspeed = 0
end if
if z = 16777234 and lef$<>"H" then
xspeed = -1
yspeed = 0
end if
if z = 16777236 and righ$<>"H" then
xspeed = 1
yspeed = 0
end if
# to stop when crashing the wall
if up$="H" and yspeed=-1 then yspeed=0
if down$="H" and yspeed=1 then yspeed=0
if lef$="H" and xspeed=-1 then xspeed=0
if righ$="H" and xspeed=1 then xspeed=0
# adding points
if self$="*" then
area$[ycell,xcell]=" "
Score = Score+1
end if
if self$="@" then
area$[ycell,xcell]=" "
Score = Score+5
end if
end if
# transportation left to right
IF xpac = 10 THEN xpac = 435
IF xpac = 440 THEN xpac = 20
# changing position
xpac = xpac+xspeed
ypac = ypac+yspeed
# Drawing packman
color white
if xspeed = 1 then direc=1.57
if xspeed = -1 then direc=-1.57
if yspeed = 1 then direc= 3.14
if yspeed = -1 then direc= 0
if yspeed+xspeed<>0 then mouth=mouth+.2
pie xpac,ypac+5,20,20,direc+sin (mouth),6.28-2*sin (mouth)

# Writing scores and lifes
color black
rect 520,60,100,30
rect 520,260,100,30
color white
text 520,60,Score
text 520,260,life
return

Bouncy maze

levels=5
fastgraphics
graphsize 600,600
clg
dim board$ (16,levels)
board$ [0,0]= "xxxxxxxxxxxxxxxxxxxxxxxxxx"
board$ [1,0]= "x                        x"
board$ [2,0]= "x                        x"
board$ [3,0]= "x    xxxxxxxxxxxxxxxx    x"
board$ [4,0]= "x                   x    x"
board$ [5,0]= "x                   x    x"
board$ [6,0]= "xxxxxxxxxxxxxxx     x    x"
board$ [7,0]= "x                   x    x"
board$ [8,0]= "x                   x    x"
board$ [9,0]= "x         xxxxxxxxxxx    x"
board$ [10,0]="x         x         x    x"
board$ [11,0]="x         x         x    x"
board$ [12,0]="x    x    x    x    x    x"
board$ [13,0]="x              x         x"
board$ [14,0]="x              x         x"
board$ [15,0]="xxxxxxxxxxxxxxxxxxxxxxxxxx"
font "courier" ,25,200
#initial speed and position
px=100
py=140
ax=2
ay=2
# main loop
do
for y =  0 to 15
text 0,y*25,board$[y,0]
next y

circle px,py,10
refresh
clg
if mid(board$[floor(py/25-.2),0],ceil(px/19+0.4),1)="x" then
ax=-ax
end if
if mid(board$[floor(py/25-.2),0],ceil(px/19+0.2),1)="x" then
ax=-ax
end if
if mid(board$[floor(py/25-.1),0],ceil(px/19+0.3),1)="x" then
ay=-ay
end if
if mid(board$[floor(py/25-.3),0],ceil(px/19+0.3),1)="x" then
ay=-ay
end if
px=px+ax
py=py+ay
until 3=2

Report generator for busy teachers

for n = 0 to 10
pause 0.01
print "Benny ";
a=int(rand*3)
if a=0 then print "evolves ";
if a=1 then print "develops his work ";
if a=2 then print "has improved ";
a=int(rand*5)
if a=0 then print "brilliantely";
if a=1 then print "fantasticaly";
if a=2 then print "very well";
if a=3 then print "exeptionally";
if a=4 then print "with exellence";
print ". The homework is ";
a=int(rand*5)
if a=0 then print "marvellous.";
if a=1 then print "a true wonder.";
if a=2 then print "outstanding.";
if a=3 then print "unique.";
if a=4 then print "beautifull.";
a=int(rand*3)
if a=0 then print "We trust ";
if a=1 then print "We assume ";
if a=2 then print "We believe ";
a=int(rand*4)
if a=0 then print "he will achive ";
if a=1 then print "he is going to get ";
if a=2 then print "he will get ";
if a=3 then print "he is going to attain ";
a=int(rand*4)
if a=0 then print "fantastic results."
if a=1 then print "high grades."
if a=2 then print "lots of As."
if a=3 then print "tonnes of A*s."
next n

Flappy Ball

# Minimalist version of flappy bird, Work in progress
# Click to jump
graphsize 600,400
fastgraphics
Dim obstaclehight(10)
birdy=200
dy=-1
lifes=3

for level = 1 to 5
  # Generate obstacles
   for n = 0 to 9
     obstaclehight[n] = 150+ int(rand*(10+40*level))-20*level
   next n
   # restart point after losing a life
   start:
   # End game code
   if lifes = 0 then
       color black
       font "arial",50,50
       text 50,50,"End"
       refresh
       end
   end if
   pause 1
   # Running code
   for x = 1 to 2200 step 1
       color yellow
       rect 0,0,600,400
       color black
       font "arial",50,50
       text 50-x,50,"Level:"+(level)
       if level < 5 then text 2200-x,50,"Level:"+(level+1)
       if level = 5 then text 2200-x,50,"End"
       # Drawing columns
       for n = 0 to 9
          color darkgreen
          rect 300+n*200-x,0,50,400
          color yellow
          rect 300+n*200-x,obstaclehight[n],50,100
         # Ball death
           if 300+n*200-x=50 or 300+n*200-x=0 then
               if birdy < obstaclehight[n] or birdy > obstaclehight[n]+100 then
                  lifes=lifes-1
                   goto start
                end if
            end if
         next n
   # Ball draw
   color red
   circle 50,birdy,10
   color white
   circle 52,birdy-2,3
   color black
   circle 53,birdy-2,2
   rect 56,birdy+2,5,3
   color black
   font "arial",20,100
   text 10,10,"Lifes"+lifes
   # Movement
   birdy=birdy+dy
   dy=dy+.015
   if clickx>0 then dy=-1
   clickclear
   refresh
  next x
next level
end

3D Ball

# Based in an example program, a retake on a 3D simulation

graphsize 500,500
vx=.002
vy=.003
vz=.005
xball=1
yball=1
zball=1
while 1=1
a = mousex / 200
b = mousey / 200
gosub update
end while
update:
fastgraphics
clg
x=0
y=2
z=0
gosub matrix
x1=sx
y1=sy
x=2
y=0
z=0
gosub matrix
x2=sx
y2=sy
x=2
y=2
z=0
gosub matrix
x3=sx
y3=sy
color darkgreen
poly{200,200,x1,y1,x3,y3,x2,y2}
xball=xball+vx
yball=yball+vy
zball=zball+vz
vz=vz-.0005
if xball>2 then vx=-vx
if xball<0 then vx=-vx
if yball>2 then vy=-vy
if yball<0 then vy=-vy
if zball<0 then vz=-vz*.98
color black
x=xball
y=yball
z=0
gosub matrix
chord sx,sy,10,5-((y1+y2+y3)/100),0,pi*2
color red
x=xball
y=yball
z=zball
gosub matrix
circle sx,sy,5

if y3<200 then
color darkyellow
poly{200,200,x1,y1,x3,y3,x2,y2}
end if
refresh
clg
return
matrix:
u = x
v = y
w = z
u2 = u * cos(a) - v * sin(a)
v2 = u * sin(a) + v * cos(a)
w2 = w
u = u2
v = v2
w = w2
u2 = u
v2 = v * cos(b) - w * sin(b)
w2 = v * sin(b) + w * cos(b)
u = u2
v = v2
w = w2
sx = 200+u * (w + 2) * 35
sy = 200+v * (w + 2) * 35
return

Bucktooth Bunny

# Khan academy is a brilliant educational site . You can learn everything there including programming . This is the Basic256 version of the bucktooth bunny. As you can see from the link below the code is very similar to the one used in Khan academy wich is based in Javascript.
# https://www.khanacademy.org/cs/programming/variables/p/challenge-bucktooth-bunny

arc(150-25, 70-60, 60, 120,0,2*pi) # left ear
arc(240-25, 70-60, 60, 120,0,2*pi) # right ear
color (black,white)
circle(200, 170, 75) # face
rect(185, 200, 15, 10) # left tooth
rect(200, 200, 15, 10) # right tooth
color (black,black)
circle(170, 150, 5) # left eye
circle(230, 150, 5) # right eye

line(150, 200, 250, 200) # mouth

Marbles Game

# This is a big one . Clean of most bugs but there are still a few
Fastgraphics
# graphics window size
graphsize 800,600
clg
fastgraphics
rem initial variables
nball=20
Dim x(nball)
Dim y(nball)
Dim vx(nball)
Dim vy(nball)
Dim mass(nball)
Dim colisionflag(nball,nball)
Dim bounceflag(nball)
ed=1
out=0
turn=1

# One can change the order of the levels here
gosub first
gosub waitfordirection
gosub new
gosub two
gosub waitfordirection
gosub new
gosub three
gosub waitfordirection
gosub new
gosub four
gosub waitfordirection
gosub new
gosub five
gosub waitfordirection
color white
font "arial",50,100
Text 170,200,"Hurray"
refresh
end
end


# These are the 5 levels it is easy to make more
first:
balls=2
tries=2
mass[0]=10: x[0]=250: y[0]=250
mass[1]=10: x[1]=100: y[1]=100
mass[2]=10: x[2]=400: y[2]=400
return

two:
balls=4
tries=4
mass[0]=10: x[0]=100: y[0]=100
mass[1]=10: x[1]=150: y[1]=150
mass[2]=10: x[2]=200: y[2]=200
mass[3]=10: x[3]=250: y[3]=250
mass[10]=20: x[10]=300: y[10]=300
return

three:
balls=5
tries=4
mass[0]=10: x[0]=100: y[0]=100
mass[1]=10: x[1]=200: y[1]=200

mass[3]=10: x[3]=400: y[3]=400
mass[10]=20: x[10]=400: y[10]=300
mass[11]=20: x[11]=350: y[11]=350
mass[12]=20: x[12]=250: y[12]=250
return

four:
balls=8
tries=6
mass[0]=10: x[0]=250: y[0]=250
mass[1]=10: x[1]=150: y[1]=150
mass[2]=10: x[2]=350: y[2]=350
mass[3]=10: x[3]=400: y[3]=100
mass[4]=10: x[4]=100: y[4]=400

mass[10]=20: x[10]=100: y[10]=100
mass[11]=20: x[11]=400: y[11]=400
mass[12]=20: x[12]=150: y[12]=350
mass[13]=20: x[13]=350: y[13]=150
return


five:
balls=8
tries=7
mass[0]=10: x[0]=250: y[0]=250
mass[1]=10: x[1]=100: y[1]=100
mass[2]=10: x[2]=400: y[2]=400
mass[3]=10: x[3]=400: y[3]=100
mass[4]=10: x[4]=100: y[4]=400

mass[10]=20: x[10]=150: y[10]=150
mass[11]=20: x[11]=350: y[11]=350
mass[12]=20: x[12]=150: y[12]=350
mass[13]=20: x[13]=350: y[13]=150
return


# Initializes the scenaries
new:
for u = 0 to 19
mass[u]=0: x[u]=0: y[u]=0
next u
return

waitfordirection:
do
clickclear
refresh
do
gosub drawtable
for u = 0 to 19
dx=mousex-x[0]
dy=mousey-y[0]
gosub drawball
next u

#cue
color white
line mousex+100*dx,mousey+100*dy,x[0],y[0]
color red
line mousex,mousey,x[0],y[0]
circle mousex,mousey,3
refresh
dist=(dx^2+dy^2)^.5
vx[0]=(clickx-x[0])*dist/10000
vy[0]=(clicky-y[0])*dist/10000
until clicky >0
gosub round
until out = balls or  tries = 0
turn=turn+1
out=0
return


round:
tries=tries-1
do
gosub drawtable
for u = 0 to 19
# balls out
goingout=false
if mass[u]>0 and (x[u]>450 or x[u]<50 or y[u]>450 or y[u]<50) then
         goingout=true
         mass[u]=mass[u]-1
         if mass[u]=0 then
         goingout=true
         out = out + 1
vx[u]=0
vy[u]=0
y[u]=0
x[u]=0
end if
# White out
if u = 0 then gosub finish
end if

# drag
vx[u]=vx[u]*0.993
vy[u]=vy[u]*0.993
x[u]=x[u]+vx[u]
y[u]=y[u]+vy[u]
# draw
gosub drawball
next u
refresh
gosub colision
total_speed=0

for marble = 0 to 19
total_speed=total_speed+abs(vx[marble])+abs(vy[marble])
next marble
until total_speed<1 and goingout=false
if tries = 0 and out < balls then gosub finish
#  reset the marble for the next round
for marble = 0 to 19
vx[marble]=0
vy[marble]=0
next marble
return

finish:
color white
font "arial",50,100
Text 170,200,"Oops"
refresh
end
return

drawtable:
color blue
rect 0,0,800,600
for grad=1 to 10
color rgb (0,83+4*grad,0)
rect 50+grad,50+grad,400-grad*2,400-grad*2
rect 500+grad,50+grad, 250-grad*2,400-grad*2
next grad


color rgb (0,83,0)
font "arial",22,100
Text 530,70, "Round nº :"+turn
Text 530,120,"Shots left :"+tries
Text 530,170,"____________"
Text 530,220,"Shoot the"
Text 530,270,"yellow balls"
Text 530,320,"out of the mat"
return


drawball:
font "arial",8,100
if mass[u]>0 then
for k = 1 to mass[u]
color rgb (200*(1.2-1/k),200*(1.2-1/k),0)
if u = 0 then color rgb ( 200*(1.2-1/k), 200*(1.2-1/k), 200*(1.2-1/k))
circle x[u],y[u],mass[u]-k
next k
end if

return

colision:
rem collision detection
for u1 = 0 to 18
for u2 = u1+1 to 19
dx = x[u2]-x[u1]
dy = y[u2]-y[u1]
distance = (dx*dx+dy*dy)^.5
if distance < (mass[u1]+mass[u2])and x[u2]<450 and x[u2]>50 and y[u2]<450 and y[u2]>50 then
if colisionflag[u1,u2]=0 then
rem vx and vy calc
sound 1000,7
ax=dx/distance
ay=dy/distance
va1=vx[u1]*ax+vy[u1]*ay
vb1=-vx[u1]*ay+vy[u1]*ax
va2=vx[u2]*ax+vy[u2]*ay
vb2=-vx[u2]*ay+vy[u2]*ax
vaP1=va1 + (1+ed)*(va2-va1)/(1+mass[u1]/mass[u2])
vaP2=va2 + (1+ed)*(va1-va2)/(1+mass[u2]/mass[u1])
vx[u1]=vaP1*ax-vb1*ay
vy[u1]=vaP1*ay+vb1*ax
vx[u2]=vaP2*ax-vb2*ay
vy[u2]=vaP2*ay+vb2*ax
colisionflag[u1,u2]=1
end if
else
colisionflag[u1,u2]=0
end if
next u2
next u1
return

Matching Cards

# Another game for the interactive whiteboard

Dim a$(4,3)
Dim value(4,3)
Dim pair(2)
Dim pair$(2)
font "arial",40,40
Graphsize 750,450
time = second+minute*60+hour*3600
QA = 0
# Atributing questions and answers########
do
n1=int(rand*9+1)
n2=int(rand*9+1)
question$=n1+"x"+n2
answer$ = string (n1*n2)
#################################
repetition = false
#checking for repetitions
for n=0 to 2
for m=0 to 3
if a$[m,n]=answer$ then repetition = true
next m
next n

if repetition = false then
#selecting 1 card for question
Q =0
do
v=int(rand*3)
h=int(rand*4)

if a$[h,v]="" then
a$[h,v]= question$
value[h,v]= int(answer$)
Q = 1
end if
until Q =1
#selecting 1 card for answer
A =0
do
v=int(rand*3)
h=int(rand*4)
if a$[h,v]="" then
a$[h,v]= answer$
value[h,v]= int(answer$)
A = 1
end if
until A =1
QA =QA +2
end if
until QA = 12


# Clicking the cards
cards=12
do
gosub drawcards
p=0
do
clickclear
t=0
do
if second+minute*60+hour*3600>t then
color white
rect 600,0,450,150
color black
text 600,40,second+minute*60+hour*3600 - time+" sec"
t=second+minute*60+hour*3600
end if
until clicky>0
x=int(clickx/150)
y=int(clicky/150)
pair[p]=value[x,y]
pair$[p]=a$[x,y]
p=p+1
color red
circle 150*x+20,150*y+20,10
until p=2
pause .5

if pair[0]=pair[1]and pair$[0]<>pair$[1] then
for n=0 to 3
for m=0 to 2
if value[n,m]=pair[1]then a$[n,m]="Yes"
next m
next n
cards=cards-2
end if
until cards=0

drawcards:
for n=0 to 3
for m=0 to 2
color black
if a$[n,m]="Yes" then color green
Rect 150*n,150*m,140,140
color white
text 150*n+20,150*m+40,a$[n,m]
next m
next n
return

end 

Estimate the angle

# This is a game designed to be played on an interactive whiteboard by two players

clg
fastgraphics
p1=0:p2=0
Bestof = 5
#Main ####################################
do

angle1=int(rand*360)
angle2=int(rand*360)
gosub drawscale
gosub drawpie
color white

text 170,280,"A turn"
refresh
gosub cliked
text 170,330,"Guess: "+guess+"º"
refresh
error1=abs(guess-angle1)
pause 1

text 470,280,"B turn"
refresh
gosub cliked
text 470,330,"Guess: "+guess+"º"
refresh
error2=abs(guess-angle2)
pause 1

gosub drawscale
gosub drawpie

color red
if error1<error2 then
win=200
p1=p1+1
color green
end if
text 170,330,"Real: "+angle1+"º"
text 170,380,"Error: "+error1+"º"
color red
if error1>error2 then
win=470
p2=p2+1
color green
end if
text 470,330,"Real: "+angle2+"º"
text 470,380,"Error: "+error2+"º"
color green
text win,150,"Winner"
refresh
pause 2
clg
until p1=Bestof or p2=Bestof
#End code####################################
color black
if p1=5 then text 270,320,"Player A won :)"
if p2=5 then text 270,320,"Player B won :)"
refresh
end
#Subroutines###################################
cliked:
clickclear
do
guess=mousey-7
until clicky>0
return

drawpie:
font "arial",30,100
text 170,10, "Palyer A: "+p1
text 470,10, "Player B: "+p2
color orange
pie ( 150,70,200,200,0,pi*angle1/180 )
color blue
pie ( 450,70,200,200,0,pi*angle2/180 )
return

drawscale:
font "arial",10,100
color black
graphsize 800,600
rect 0,0,800,600
color white
for y = 0 to 360 step 20
text 10,y,y
line 30,y+7,100,y+7
text 775,y,y
line 700,y+7,770,y+7
next y
refresh
return

Nim (with levels)

#After complaints I added some levels to the game

#Take as many pieces you want from one of the piles

#The one who takes the last piece wins

Print "Click to select the collumn and the number of pieces to remove "
Print "Who takes the last wins "
fastgraphics
graphsize 400,420
font("arial",17,100)
a=0
b=0
c=0
d=0
level$ = prompt("What level 3-7")
level = int(level$)
if level >6 then a=7
if level >5 then b=6
if level >4 then c=5
if level >3 then d=4
e=3
f=2
g=1

for turn = 1 to 1000
gosub draw
if a+b+c+d+e+f+g=0 then
color white
alert ( "Computer (me) won")
refresh
end
end if

refresh

if turn=1 then
ans = confirm("Do you want to play first y/n? ")
if ans then Print "Start"

if not (ans) then
gosub Computerplay
gosub draw
refresh
end if
end if

gosub humanplay
gosub draw

if a+b+c+d+e+f+g=0 then
alert ("You won")
refresh
end
end if

refresh
gosub Computerplay
next turn

Computerplay:
thought =0
wining=false
do
thought=thought+1

do
at=a
bt=b
ct=c
dt=d
et=e
ft=f
gt=g
pile = int(rand*7)
If pile = 0 then at=at-int(rand*at)-1
If pile = 1 then bt=bt-int(rand*bt)-1
If pile = 2 then ct=ct-int(rand*ct)-1
If pile = 3 then dt=dt-int(rand*dt)-1
If pile = 4 then et=et-int(rand*et)-1
If pile = 5 then ft=ft-int(rand*ft)-1
If pile = 6 then gt=gt-int(rand*gt)-1
until (at>-1) and (bt>-1) and (ct>-1)and(dt>-1) and (et>-1) and (ft>-1)and (gt>-1)

a$ = toradix (at+8,2)
b$ = toradix (bt+8,2)
c$ = toradix (ct+8,2)
d$ = toradix (dt+8,2)
e$ = toradix (et+8,2)
f$ = toradix (ft+8,2)
g$ = toradix (gt+8,2)

units = int (mid(a$,4,1))+int (mid(b$,4,1))+int(mid(c$,4,1))+int (mid(d$,4,1))+int (mid(e$,4,1))+int(mid(f$,4,1))+int(mid(g$,4,1))
twos = int (mid(a$,3,1))+int (mid(b$,3,1))+int(mid(c$,3,1))+int (mid(d$,3,1))+int (mid(e$,3,1))+int(mid(f$,3,1))+int(mid(g$,3,1))
fours = int (mid(a$,2,1))+int (mid(b$,2,1))+int(mid(c$,2,1))+int (mid(d$,2,1))+int (mid(e$,2,1))+int(mid(f$,2,1))+int(mid(g$,2,1))

if units/2=int(units/2) and twos/2=int(twos/2) and fours/2=int(fours/2) then wining=true
until wining=true or thought =1000
a=at
b=bt
c=ct
d=dt
e=et
f=ft
g=gt
pause 1
return


draw:
clg
color darkblue
rect 0,0,400,420
color grey
text 33,20," A .....B.....C .....D.....E .....F .....G"
for n = 1 to 7
for radius = 20 to 0 step -1
color rgb(255-radius*7,255-radius*7,0)
if a>= n then circle 50,n*50+30,radius
if b>= n then circle 100,n*50+30,radius
if c>= n then circle 150,n*50+30,radius
if d>= n then circle 200,n*50+30,radius
if e>= n then circle 250,n*50+30,radius
if f>= n then circle 300,n*50+30,radius
if g>= n then circle 350,n*50+30,radius
next radius
next n
for n = 1 to 7
color black
if a>= n then text 43,n*50+20,a+1-n
if b>= n then text 93,n*50+20,b+1-n
if c>= n then text 143,n*50+20,c+1-n
if d>= n then text 193,n*50+20,d+1-n
if e>= n then text 243,n*50+20,e+1-n
if f>= n then text 293,n*50+20,f+1-n
if g>= n then text 343,n*50+20,g+1-n
next n
return

humanplay:
p=0
p$=""
clickclear
do
if clickx >30 and clicky >60 and (clickx +clicky)<470 then
if clickx<370 then p$="g"
if clickx<320 then p$="f"
if clickx<270 then p$="e"
if clickx<220 then p$="d"
if clickx<170 then p$="c"
if clickx<120 then p$="b"
if clickx<70 then p$="a"


row=floor((clicky-55)/50)

If p$ = "a" then p=a-row
If p$ = "b" then p=b-row
If p$ = "c" then p=c-row
If p$ = "d" then p=d-row
If p$ = "e" then p=e-row
If p$ = "f" then p=f-row
If p$ = "g" then p=g-row

If p$ = "a" then a=a-p
If p$ = "b" then b=b-p
If p$ = "c" then c=c-p
If p$ = "d" then d=d-p
If p$ = "e" then e=e-p
If p$ = "f" then f=f-p
If p$ = "g" then g=g-p
end if
pause .1

until p >0

return

n body simulation

# this is a n-body simulation , use arrow keys to keep it centered

# Number of inital particles


graphsize 600,600
fastgraphics
n=100
dim x(n+1)
dim y(n+1)
dim xspeed(n+1)
dim yspeed(n+1)
dim xac(n+1)
dim yac(n+1)
dim mass(n+1)
dim radius(n+1)
# initializing variables ##############
for p = 1 to n
a=rand*2*pi
r=rand*300
x[p]=r*cos(a)+300
y[p]=r*sin(a)+300
s=rand*2*pi/20
xspeed[p]=cos(a+s)-cos(a)
yspeed[p]=sin(a+s)-sin(a)
radius[p]=3
mass[p]=radius[p]^3
next p

gravity=0
dist=0
colision = 0
dx=0
dy=0
v=0
h=0

loop:
# arrow keys####################
a = key
if 16777234=a then h=h-5
if 16777236 =a then h=h+5
if 16777237=a then v=v-5
if 16777235=a then v=v+5

for u = 1 to n
for t = 1 to n
if u<>t and mass[t]>0 and mass[u]>0 then
dx=x[u]-x[t]
dy=y[u]-y[t]
dist=(dx^2 + dy^2)^(1/2)
collide = false
if dist < radius[u]+radius[t] then collide = true
# gravity code################
if collide = true then
x[u]=(x[u]*mass[u]+x[t]*mass[t])/(mass[u]+mass[t])
y[u]=(y[u]*mass[u]+y[t]*mass[t])/(mass[u]+mass[t])
xspeed[u]=(xspeed[u]*mass[u]+xspeed[t]*mass[t])/(mass[u]+mass[t])
yspeed[u]=(yspeed[u]*mass[u]+yspeed[t]*mass[t])/(mass[u]+mass[t])
mass[u]=mass[u]+mass[t]
radius[u]=mass[u]^(1/3)
mass[t]=0
radius[t]=0
end if

# colision code################
if collide = false then
gravity = mass[t]*mass[u]/dist^2
xac[u]= gravity*dx/(1000*mass[u])
yac[u]= gravity*dy/(1000*mass[u])
xspeed[u]=xspeed[u]-xac[u]
yspeed[u]=yspeed[u]-yac[u]
x[u]=x[u]+xspeed[u]
y[u]=y[u]+yspeed[u]
end if
###############################
end if
next t
color white
circle x[u]+h,y[u]+v,radius[u]
next u
refresh
clg
color black
rect 0,0,600,600

goto loop

Solid of revolution

 

# This program calculates the volume of a revolution solid.  The parameters  are hardcoded but they are highlighted for you to change

clg

font "arial", 15,100
graphsize 500,500
fastgraphics
#Graph Area######################
xmin=-6
xmax=6
ymin=-5
ymax=5
################################
tx=500/(xmax-xmin)
ty=500/(ymax-ymin)
area=0
#x Boudaries######################
bound1=-3
bound2=3
#################################
range=bound2-bound1
dx=.02
Volume_solid=0
for s = 0 to 2*pi step .1
if s <pi then
 for y = ymin to ymax 
 for x = xmin to xmax
  color black
  circle tx*x-xmin*tx, ty*y-ymin*ty,3
  if y=ymax+ymin then text tx*x-xmin*tx-15, ty*y-ymin*ty,x
  if x=0 then text tx*x-xmin*tx-15,ty*y-ymin*ty,-y+ymax+ymin
 next x : next y
line -xmin*tx,0,-xmin*tx,500 : line 0,500+ymin*ty,500,500+ymin*ty
end if
for x = xmin to xmax step dx
xg= tx*x-xmin*tx
color red
y0=y
#Equation###############################
y=sin(x)+2
########################################
yg1= 500-ty*y+ty*ymin
circle xg, yg1,1
#Solid
if x<= bound2 and  x>= bound1 then
fill= 100*(sin(s))+100
color rgb(200-fill,200-fill,fill)
arc xg-.05*y*ty*2, yg1, .1*y*ty*2, y*ty*2,s,.1
if s=0 then Volume_solid=Volume_solid+dx*(y0/2+y/2)^2*pi
#Area
if s <pi then
color green
if int(xg+1)/2 = int(xg/2+1) then line xg,yg1,xg,500+ymin*ty
fill= 255*(x-bound1)/range
end if
end if
next x
refresh
if s=0 then pause .5
pause .02
next s
input "press any key",k
Text 20,20, "Volume="+Volume_solid
refresh

Definite integral

# This program calculates the area between two functions the parameters functions, boundaries are hardcoded but they are highlighted for you to change





 font "arial", 15,100
 graphsize 500,500
 fastgraphics
 # Choose the dimentions of the graph#############
 xmin=-5
 xmax=5
 ymin=-5
 ymax=5
 ##########################################
 y1=0:y2=0
 tx=500/(xmax-xmin)
 ty=500/(ymax-ymin)
 for y = ymin to ymax
 for x = xmin to xmax
 circle tx*x-xmin*tx, ty*y-ymin*ty,3
 if y=ymax+ymin then text tx*x-xmin*tx-15, ty*y-ymin*ty,x
 if x=0 then text tx*x-xmin*tx-15, ty*y-ymin*ty,-y+ymax+ymin
 next x : next y
 line -xmin*tx,0,-xmin*tx,500 : line 0,500+ymin*ty,500,500+ymin*ty
 rem generate area
 #Choose the x boundaries#####################
 bound1=-2
 bound2=2
 #########################################
 area=0
 range=bound2-bound1
 dx=.01
 for x = xmin to xmax step dx
 xg= tx*x-xmin*tx
 color red
 p1=y1
 #Equation1 red#############################
 y1=x^2
 #########################################
 yg1= 500-ty*y1+ty*ymin
 circle xg, yg1,1
 color blue
 p2=y2
 #Equation2 blue###########################
 y2=x-2
 ########################################
 yg2= 500-ty*y2+ty*ymin
 circle xg, yg2,1
 if x<= bound2 and x>= bound1 then
 color darkgreen
 area=area+((y1+p1)/2-(y2+p2)/2)*dx
 if int(xg+1)/2 = int(xg/2+1) then line xg,yg1,xg,yg2
 fill= 255*(x-bound1)/range
 end if
 next x
 refresh
 input "press a key",a
 text 20,20,"Area="+area
 refresh

Rock-paper-scissors

# This is a simulation of a system based on the popular game Rock-paper-scissors



clg: n=80: radius=8
graphsize 600,600
font "arial",10,100
outputvisible ( false )
fastgraphics
Dim type(n):Dim xpos(n):Dim ypos(n):Dim xspeed(n):Dim yspeed(n): Dim type(n)
# initial values
for u = 0 to n-1
a=rand
xpos[u]=(rand*600):ypos[u]=(rand*400):xspeed[u]=sin(a):yspeed[u]=cos(a):type[u]=int(rand*3)
next u
c=0
color black
rect 0,410,600,190
loop:
for u = 0 to n-2
for v = u+1 to n-1
distx=(xpos[u]-xpos[v])^2
disty=(ypos[u]-ypos[v])^2
dist=(distx+disty)^0.5
if dist<2*radius then gosub colision
next v
next u
S=0
R=0
P=0
c=c+1
if c=600 then
c=0
color black
rect 0,410,600,190
endif
for u = 0 to n-1
xpos[u]=xpos[u]+ xspeed[u]
ypos[u]=ypos[u]+ yspeed[u]
if xpos[u]<0 then xspeed[u]=(rand/10-1.05)*xspeed[u]
if ypos[u]<0 then yspeed[u]=(rand/10-1.05)*yspeed[u]
if xpos[u]>600 then xspeed[u]=(rand/10-1.05)*xspeed[u]
if ypos[u]>400 then yspeed[u]=(rand/10-1.05)*yspeed[u]
# Drawing objects
if type[u]=0 then
color red
circle xpos[u],ypos[u],radius
color black
text xpos[u]-5,ypos[u]-5,"S"
S=S+1
end if
if type[u]=1 then
color green
circle xpos[u],ypos[u],radius
color black
text xpos[u]-5,ypos[u]-5,"R"
R=R+1
end if
if type[u]=2 then
color yellow
circle xpos[u],ypos[u],radius
color black
text xpos[u]-5,ypos[u]-5,"P"
P=P+1
end if
next u
color red
circle c,600-(180/n)*S,1
color green
circle c,600-(180/n)*R,1
color yellow
circle c,600-(180/n)*P,1
refresh
color white
rect 0,0,600,410
goto loop
colision:
if type[u]=0 and type[v]=1 then type[u]=1
if type[v]=0 and type[u]=1 then type[v]=1
if type[u]=1 and type[v]=2 then type[u]=2
if type[v]=1 and type[u]=2 then type[v]=2
if type[u]=2 and type[v]=0 then type[u]=0
if type[v]=2 and type[u]=0 then type[v]=0
return

Number Bases

# counting in different bases
graphsize 300,300
font "Times New Roman",18,100
fastgraphics
dim base$(17)
dim comp(17)
for x = 1 to 2048
for base = 2 to 16
base$[base]=toradix(x,base)
comp=length(base$[base])
text 180-comp*12,20*base-42,base$[base]
text 200,20*base-42,"Base "+base
next base
refresh
clg
next x

PASCAL TRIANGLE

# I got this one from the BBC basic in Rosetta Code site
font "arial",10,100
graphsize 700,350
nrows = 16
FOR row = 1 TO nrows
acc = 1
FOR element = 1 TO row
text element*40+350-row*20,row*20, acc+" "
acc = acc * (row - element) / element
NEXT element
PRINT
NEXT row

Cellular automation 2

# The cellular automation program was malfunctioning for a long time because I did not update the code for the New Basic 256 version .
# This is a new version where the chaotic rule and the fractal rule are used different alternating patterns.
#http://mathworld.wolfram.com/ElementaryCellularAutomaton.html

fastgraphics
graphsize 600,300
For n = 1 to 300
plot (300,1)
Print "Fractal rule every "+n+" rows"
For y = 1 to 300
For x = 1 to 600
a=0
if pixel(x-1,y)=black then a=a+1
if pixel(x,y)=black then a=a+10
if pixel(x+1,y)=black then a=a+100

if y/n = int (y/n) then
gosub fractal
else
gosub chaotic
end if

next x
refresh
next y
refresh
clg
next n

chaotic:
if a=001 or a=110 or a =010 or a=100 then plot (x,y+1)
return
fractal:
if a=001 or a=010 or a=100 then plot (x,y+1)
return

Fastest Lap

# This program is just a big fat loop with a goto in the end.  All the wrong stuff.

graphsize(800,600)
fastgraphics
outputvisible (false)
clg
font ("arial",15,100)
dim track(30)


track={-14,2,-13,4,-12,5,-10,6,10,6,12,5,13,4,14,2,14,0,13,-0,12,-0,11,0,10,1,8,2,7,2,6,1,6,-4,5,-6,4,-7,2,-8,-0,-8,-2,-7,-3,-6,-4,-4,-4,-0,-5,1,-6,2,-7,2,-8,1,-9,-0,-9,-5,-10,-7,-11,-8,-12,-8,-13,-7,-14,-5,-14,2}

dim car1(38)
dim car2(18)
car1={0,-10,-4,-9,-5,-8,-5,-4,-4,2,-4,4,-5,6,-5,9,-4,10,4,10,5,9,5,6,4,4,4,2,5,-4,5,-8,4,-9,0,-10}
car2={0,-2,-1,-2,-3,-0,-3,2,0,1,3,2,3,-0,1,-2,0,-2}
dim pointer (10)
pointer={3,-0,0,1,-15,-0,0,-1,3,-0}

dim tree(100,2)
for n = 0 to 99
tree [n,0]=int (rand*2200-1200)
tree [n,1]=int (rand*2000-1800)
next n

rad = 0
px=-200
py=-50
turn =0
speed =0
flag =0
time =0
laps=-1
bestime=999
init=second()+minute()*60+hour()*3600


#intro####################################
for n = 1 to 100 step .2
penwidth(2*n)
Color (black,green)
clg
stamp 500,250-n*5,n,2*pi*(n/100),track
refresh
next n
penwidth(1)


loop:
# controls arrow keys ###################
z = key
if z = 16777235 then speed=speed+.1
if z = 16777237 then speed=speed-.1
if z = 16777234 and turn>-.2 then
turn =turn-pi/90
else
turn=turn*.95
end if
if z = 16777236 and turn<.2 then turn =turn+pi/90
rad = rad+turn
yspeed = sin (rad)*speed
xspeed = cos (rad)*speed
py = py + yspeed
px = px + xspeed
#Track#######################
color green
rect 0,0,600,600
color darkgreen
for n = 0 to 99
circle tree[n,0]-px, tree[n,1]-py,20
next n
Color (black,0)
penwidth(200)
stamp -px,-350-py,100,0,track
color black
penwidth(1)
color white
rect -px+300,-py+150,20,200
color grey
rect -px,-py+50,300,80
rect -px,-py+370,300,80
color black
Text -px+70,-py+370,"Use arrow keys"
#Car and lake #######################
color red
stamp 300, 300,2,rad+pi/2, car1
color blue
stamp 300, 300,2,rad+pi/2, car2
color blue
circle -px+70,-py-700,300

#Result panel###############
color blue
rect 600,0,200,600
Color (black,blue)
penwidth(5)
stamp 700,70,5,0,track
color red
circle px/20+715,py/20+102,3
circle 700,200,80
color white
stamp 700,200,5,speed,pointer
time=second()+minute()*60+hour()*3600-init
text 610,300,"Time= "+time+"sec"
text 610,350, "Lap count ="+laps
text 610,400, "Best Time ="+bestime
refresh
#Car goes to grass##########
grass =0
if pixel(321,321)<>black then grass=grass+1
if pixel(279,279)<>black then grass=grass+1
if pixel(279,321)<>black then grass=grass+1
if pixel(321,279)<>black then grass=grass+1
if grass>2 and speed>.2 then speed = speed*.9
#lapcount###########
If pixel (321,300)=white then
if flag=0 then
laps = laps + 1
flag =1
init =second()+minute()*60+hour()*3600
if time<bestime and laps >0 then bestime=time
end if
else
flag = 0
end if
####################
clg
goto loop

TETRIS

graphsize 600,440
 fastgraphics
 font ("arial",20,100)
 Dim i(4):Dim j(4):Dim l(4):Dim o(4):Dim s(4):Dim t(4):Dim z(4)
 i = { 0x10F00, 0x12222, 0x100F0, 0x14444}
 j = { 0x144C0, 0x18E00, 0x16440, 0x10E20}
 l = {0x14460, 0x10E80, 0x1C440, 0x12E00 }
 o = { 0x1CC00, 0x1CC00, 0x1CC00, 0x1CC00}
 s = {0x106C0, 0x18C40, 0x16C00, 0x14620 }
 t = {0x10E40, 0x14C40, 0x14E00, 0x14640}
 z = { 0x10C60, 0x14C80, 0x1C600, 0x12640}
 Dim board(14,29)
 Dim stat(7)
 Score = 0
 endgame = false
 initialwait= 0.1
 # main loop for each newpiece
 do
 wait = initialwait
 rot=int(rand*4)
 shape = int (rand*7)
 stat[shape]=stat[shape]+1
 cores = int (rand*7)+1
 piecedown = false
 ypos=-1
 xpos=5
 # loop for each frame
 do
 ypos=ypos+1
 # controls
 for press = 1 to 4
 a = key
 if 16777234=a then xpos=xpos -checkmove(ref (board),a,xpos,ypos,shape$)
 if 16777236 = a then xpos=xpos +checkmove(ref (board),a,xpos,ypos,shape$)
 if 16777237=a then wait =0.01
 if 16777235=a then
 oldrot=rot
 rot = rot+1
 if rot = 4 then rot = 0
 gosub selectshape
 if checkmove(ref (board),a,xpos,ypos,shape$)=0 then
 rot = oldrot
 gosub selectshape
 end if
 end if
 pause wait
 next press
 # procedures
 gosub scorepanel
 gosub selectshape
 gosub drawboard
 gosub drawshape
 refresh
 until piecedown = true
 # these procedures are executed when a piece is down
 gosub newboard
 gosub takeline
 gosub takeline
 until endgame = true
 #last instructions before end of game
 Color white
 font ("arial",50,100)
 text 70,100, "Game Over"
 refresh
 end
 scorepanel:
 color darkgreen
 rect 0,0,600,450
 color green
 Text 300,20,"Use arrow keys"
 Text 300,60, "I .... "+stat[0]
 Text 300,100,"J .... "+stat[1]
 Text 300,140,"L .... "+stat[2]
 Text 300,180,"O .... "+stat[3]
 Text 300,220,"S .... "+stat[4]
 Text 300,260,"T .... "+stat[5]
 Text 300,300,"Z .... "+stat[6]
 Text 300,350,"Score .... "+Score
 return
 selectshape:
 if shape = 0 then shape$ = tobinary (i[rot])
 if shape = 1 then shape$ = tobinary (j[rot])
 if shape = 2 then shape$ = tobinary (l[rot])
 if shape = 3 then shape$ = tobinary (o[rot])
 if shape = 4 then shape$ = tobinary (s[rot])
 if shape = 5 then shape$ = tobinary (t[rot])
 if shape = 6 then shape$ = tobinary (z[rot])
 return
 function checkmove (ref (board),a,xpos,ypos,shape$)
 checkmove=1
 p=1
 For v = 1 to 4
 For h = 1 to 4
 p=p+1
 if mid(shape$,p,1)="1" then
 if board[xpos+h,ypos+v]>0 then checkmove=0
 if chr(a)="N" and (xpos+h>11 or xpos+h<2) then
 checkmove=0
 return
 end if
if a=16777236 and xpos+h>10 then checkmove=0
 if a=16777236 and board[xpos+h+1,ypos+v]>0 then checkmove=0
 if a=16777234 and xpos+h<3 then checkmove=0
 if a=16777234 and board[xpos+h-1,ypos+v]>0 then checkmove=0
 end if
 next h
 next v
 end function
 drawshape:
 if cores = 1 then color red
 if cores = 2 then color blue
 if cores = 3 then color yellow
 if cores = 4 then color orange
 if cores = 5 then color green
 if cores = 6 then color purple
 if cores = 7 then color white
 p=1
 For v = 1 to 4
 For h = 1 to 4
 p=p+1
 if mid(shape$,p,1)="1" then
 rect xpos*20+h*20,ypos*20+v*20,19,19
 if board[xpos+h,ypos+v+1]>0 or ypos+v=20 then piecedown=true
 end if
 next h
 next v
 if piecedown=true then
 if ypos<2 then endgame =true
 return
 end if
 return
 newboard:
 p=2
 For v = 1 to 4
 For h = 1 to 4
 if mid(shape$,p,1)="1" then board[xpos+h,ypos+v]=cores
 p=p+1
 next h
 next v
 return
 drawboard:
 For y = 1 to 20
 For x = 2 to 11
 if board[x,y] = 1 then color red
 if board[x,y] = 2 then color blue
 if board[x,y] = 3 then color yellow
 if board[x,y] = 4 then color orange
 if board[x,y] = 5 then color green
 if board[x,y] = 6 then color purple
 if board[x,y] = 7 then color white
 if board[x,y]=0 then color black
 rect x*20,y*20,19,19
 next x
 next y
 return
 takeline:
 For y = 20 to 1 step -1
 complete = true
 For x = 2 to 11
 if board[x,y]=0 then complete = false
 next x
 if complete = true then
 For row = y to 1 step -1
 For position = 1 to 10
 board[position,row]=board[position,row-1]
 next position
 next row
 Score = Score +1
 ix = initialwait*.9
 initialwait=ix
 end if
 next y
 return