Saturday, December 14, 2013

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

Sunday, November 24, 2013

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 

Friday, November 1, 2013

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

Tuesday, October 22, 2013

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

Sunday, October 13, 2013

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

Wednesday, October 9, 2013

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

Tuesday, October 8, 2013

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

Thursday, September 26, 2013

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

Tuesday, September 24, 2013

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

Tuesday, September 17, 2013

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

Saturday, April 13, 2013

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

Wednesday, April 3, 2013

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

Thursday, March 28, 2013

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

Friday, January 11, 2013

Charlie

clg
penwidth 2
color (black ,-256^2/3)
circle 150,100,50
arc 150,100,13,13,0,3.14
circle 140,100,2
circle 170,100,2
arc 120,107,66,30,1.8,2.7
penwidth 1
arc 130,90,15,5,3.14*1.5,2
arc 163,90,15,5,6,1
arc 135,60,25,15,0,-5.14
arc 155,60,20,15,0,5.14

Thursday, January 10, 2013

Trigonometric Functions


graphsize 500,350
hip ={0,0,60,0,60,3,0,3,0,0}
fastgraphics
for n = 0 to pi*2 step .01
color black
circle 70,70,62
color white
circle 70,70,58
color black
stamp 70,70,1,-n,hip
rect 140,70,400,3
rect 140,250,400,3
color red
if cos(n)>0 then rect 70,70,60*cos(n),3
if cos(n)<0 then rect 70-60*cos(n+pi),70,60*cos(n+pi),3
color blue
if sin(n)>0 then stamp 70+cos(n)*60,70,sin(n),-pi/2,hip
if sin(n)<0 then stamp 70+cos(n)*60,70,sin(pi+n),pi/2,hip
color blue
circle n*50+140,50*sin(n+pi)+70,2
color red
circle n*50+140,50*cos(n+pi)+250,2
refresh
next n

Normal Distribution


# Normal distribution simulation with mean=300 and standard deviation = 60


graphsize 600,600
sd=60
mean=300
dim bar(600)
for n = 0 to 99999    
number = int(mean + sd*sqr(-2*log(rand))*cos(2*pi*rand))   
bar[number]=bar[number]+1
plot number,500-bar[number]
next n


Tuesday, January 8, 2013

Sprites

Town
Cars

clg
# For this program to work you need to copy the pictures and save in your disk/pen, and then change the path in imgload if necessary.

# This is the sprite sheet
imgload 150,75,"G:\cars.png"


spritedim 16
n=0
fastgraphics

# slicing vehicles from the sprite sheet
for y = 0 to 112.5 step 37.5
for x = 0 to 225 step 75
spriteslice n,x,y,75,37.5
n=n+1
next x
next y
pause 2

graphsize 600,300

#Backgroud image
imgload 300,150,"G:\town.png"


# Placing vehicles
for n = 0 to 3
spriteplace n,int(rand*20)+n*100,260
spriteshow n
next n
for n = 4 to 7
spriteplace n,int(rand*20)+n*100-300,265
spriteshow n
next n
for n = 8 to 11
spriteplace n,int(rand*20)+n*100-700,275
spriteshow n
next n
for n = 12 to 15
spriteplace n,int(rand*20)+n*100-1100,280
spriteshow n
next n

# Makes sprites move
loop:
for n = 0 to 7
if n>-1 and n<4 then spritemove n,1.2,0
if n>3 and n<8 then spritemove n,.8,0
if spritex (n) = 600 then spritemove n,-600,0
next n
for n = 8 to 15
if n>7 and n<12 then spritemove n,-1.2,0
if n>11 and n<16 then spritemove n,-.8,0
if spritex (n) = 0 then spritemove n,600,0
next n
refresh
goto loop

Charater count

# Gives a count of each character from t$
t$ = "Les Misérables, is a sung-through musical play based on the novel of the same name by French poet and playwright Victor Hugo. It has music by Claude-Michel Schönberg, original French lyrics by Alain Boublil and Jean-Marc Natel, with an English-language libretto by Herbert Kretzmer(...)"
font("arial",11,100)
t$ = lower(t$)
clg
long= length (t$)
dim letters(255)

for n=1 to long
for x = 0 to 254
if chr(x)= mid(t$,n,1)then letters[x]=letters[x]+1
next x
next n

#Frequency table
for x = 0 to 254
if letters[x]>0 then print chr(x)+" "+letters[x]
next x

# Bar chart (onlny for plain letters)
bar = 0
for x = 97 to 125
if letters[x]>0 then
Text 0,bar*12,chr(x)
rect 13,bar*12+6,letters[x],8
bar=bar+1
end if
next x

Sunday, January 6, 2013

Famous character 2


#With 3 lines we can make a famous character. Complete it and write your code as a comment.We will publish your attempts.
circle 150,200,90
circle 75,90,50
circle 225,90,50


Friday, January 4, 2013

Famous characters 1


#Complete the two famous characters. And post your code as a comment.





fastgraphics
color darkgreen
rect 0,0,300,300
call hairyhead(80,150,40,60,yellow)
call hairyhead(220,150,55,45,orange)
color black
rect 55,120,50,6
Rem put the rest of the code here










refresh

subroutine hairyhead (x,y,xradius,yradius,cor)
color cor
for r = 0 to 1 step .001
arc x-r*xradius,y-r*yradius,2*r*xradius,2*r*yradius,0,pi*2
next r
for n = -17*(xradius/yradius) to 17*(xradius/yradius) step .02
color black
stamp n+x,y-yradius*.9,rand*3,pi+rand*3.6-1.8,{0,0,0,10,0,0}
next n
end subroutine



Engine

#engine parts made with stampmaker







graphsize 720,300
rod={2,1,2,-1,1,-2,-13,-2,-14,-1,-14,1,-13,2,1,2,2,1}
piston={-1,1,-1,-1,0,-2,5,-2,6,-3,13,-3,13,3,6,3,5,2,0,2,-1,1}
cylinder={-3,3,10,3,10,-3,-3,-3,-3,-4,11,-4,13,0,11,4,-3,4,-3,3}
cross={-1,4,1,4,1,1,4,1,4,-1,1,-1,1,-4,-1,-4,-1,-1,-4,-1,-4,1,-1,1,-1,4}
fastgraphics
for x = 0 to 10000 step .1
clg
color rgb(80,80,80)
stamp 480+35*cos(x),150,10,sin(x)/4,rod
color rgb(20,20,20)
circle 360,150,50
color rgb(120,120,120)
stamp 360,150,10,-x,cross
color rgb(80,80,80)
stamp 240+35*(-cos(x)),150,10,-sin(-x)/4+pi,rod
color rgb(20,20,20)
stamp 480+35*cos(x),150,10,piston
stamp 240+35*(-cos(x)),150,10,pi,piston
stamp 560,150,10,cylinder
stamp 160,150,10,pi,cylinder
color rgb(120*(sin(x))+125,127,120*(sin(x+pi))+125)
rect 61,121,35*(-cos(x))+49,59
rect 611-35*(-cos(x)),121,35*(-cos(x))+52,59
refresh
rem pause .01
next x

Stampmaker


# Draw a shape then copy the array and use it for Stamps
graphsize 800,500
fastgraphics
print "Shape={";
oldx=0
oldy=0
n=2
dim shape(2)
init= true
fin = false
clickclear
decimal(0)

loop:
gosub drawgraph
circle mousex,mousey,3
color red
circle shape[0],shape[1],4
color black
refresh
clg
x=clickx/20-20
y=-clicky/20+12
if n>3 and shape[n-2]=shape[0] and shape[n-1]=shape[1]then fin=true
# Checks for new click
if oldx<>clickx or oldy<>clicky then
if init = true then print x+","+y;
if init = false then
print ","+x+","+y;
n=n+2
end if
init= false
redim shape(n)
shape[n-2]= round (clickx,20)
shape[n-1]= round (clicky,20)
end if
oldx=clickx
oldy=clicky
if n > 3 then call draw (ref(shape),n,fin)
goto loop

subroutine draw(ref(shape),n,fin)
for p = 4 to n step 2
line shape[p-4],shape[p-3],shape[p-2],shape[p-1]
next p
if fin = true then
refresh
Print "}"
stamp 0,0,shape
refresh
print "Copy paste and run"
end
end if
end subroutine

drawgraph:
color black
for y= 0 to 480 step 20
for x= 0 to 800 step 20
circle x,y,2
next x
next y
line 0,240,800,240
line 400,0,400,480
return

function round(number,nearest)
if number%nearest<nearest/2 then
round = int (number/nearest)*nearest
else
round = int (number/nearest)*nearest+nearest
end if
end function

Wednesday, January 2, 2013

Mr Winky

# requires BASIC256 version 0.9.9.25 or later
# New functions (chord , arc , pie) showcase. Based on Jim's program




clg
color yellow
circle 150,150,150
color black
circle 100,100,20
chord 50,50,200,200, radians(135), radians(90)
arc 190,80,40,40,radians(90),radians(180)
pie 110,90,80,80,radians(135),radians(90)
end

Sunday, December 30, 2012

Snowman

# Snowman by V

y=20
color cyan
rect 0,0,300,300
color white
circle 100,230+y,50
circle 100,150+y,45
circle 100,70+y,40
colour black
circle 90,60+y,5
circle 110,60+y,5
circle 100,85+y,5
circle 110,85+y,5
circle 90,85+y,5
circle 80,80+y,5
circle 120,80+y,5

Saturday, December 29, 2012

Rosetta Code example

# This is a code example in basic 256 that you can find in Rosetta code website http://rosettacode.org/wiki/Greyscale_bars/Display. There you will find this program (and more) in many other languages such as Java Python and C, and that is a very good way to learn new programming languages.

h=ceil(graphheight/4)
for row=1 to 4
w=ceil(graphwidth/(8*row))
c=255/(8*row-1)
for n = 0 to (8*row-1)
color rgb(255-c*n,255-c*n,255-c*n)
if row/2 = int(row/2) then color rgb(c*n,c*n,c*n)
rect n*w,h*(row-1),w,h
next n
next row

Friday, December 28, 2012

Gears

clg
fastgraphics
dim x(3)
dim y(3)
dim rad(3)
dim init(3)
x[0]=150
y[0]=150
rad[0]=70
init[0]=0
x[1]=220
y[1]=220
rad[1]=35
init[1]=-.15
x[2]=90
y[2]=90
rad[2]=21
init[2]=.2
for rot = 0 to 100000
   for w = 0 to 2
      circle x[w],y[w],rad[w]-8
      tri = {0, 0, -5, rad[w], 5, rad[w]}
      for r = 0 to 2*pi step pi*7/rad[w]
           if w=1 or w=2 then clock = -rot
           if w=0 then clock = rot
           stamp x[w],y[w],1,r+init[w]+clock/(7*rad[w]),tri
       next r
    next w
    refresh
    clg
next rot

Saturday, December 22, 2012

Flags 2


# Union jack
color blue
rect 0,0,300,300
color white
poly {0,20,0,0,20,0,300,280,300,300,280,300}
poly {280,0,300,0,300,20,20,300,0,300,0,280}
color red
poly {0,10,0,0,10,0,300,290,300,300,290,300}
poly {290,0,300,0,300,10,10,300,0,300,0,290}
color white
rect 120,0,60,300
rect 0,120,300,60
color red
rect 130,0,40,300
rect 0,130,300,40
pause 2
# Stars and Stripes
for n = 0 to 13 step 2
color red
rect 0,n*23,300,23
color white
rect 0,(n+1)*23,300,23
next n
font "arial",15,100
color blue
rect 0,0,120,7*23
color white
for x = 1 to 6
for y = 1 to 5
text x*18-8,y*34-27,"*"
next y
next x
for x = 1 to 5
for y = 1 to 4
text x*18,y*34-10,"*"
next y
next x
Rem Триколор
color white
rect 0,0,300,100
color blue
rect 0,100,300,100
color red
rect 0,200,300,100

Thursday, December 20, 2012

Train

# by C&F
fastgraphics
x=0
speed=1
loop:
x=x+speed
speed=speed+.03
if x>1 then speed=2
clg
pause .01
color black
if x > 400 then x=-100
rect 10+x,160,30,60
color orange
rect 10+x,195,120,50
color grey
circle 70+x,250,15
circle 110+x,250,15
circle 35+x,250,15
color black
circle 70+x,250,5
circle 110+x,250,5
circle 35+x,250,5
colour black
rect -30+x,220,40,10
color red
rect -100+x,195,75,50
color grey
circle -80+x,250,15
circle -40+x,250,15
color black
circle -80+x,250,5
circle -40+x,250,5
refresh
goto loop

Blimp


# Blimp by R
clg
fastgraphics
x=0
y=60
font "arial",15,50
loop:
x=x+.2
if x>300 then x = -220
color grey
circle 150-x,70+y,50
circle 120-x,70+y,50
circle 180-x,70+y,50
color black
rect 100-x,100+y,100,40
Text 120-x,70+y,"R&S Inc."
color white
circle 120-x,120+y,5
circle 150-x,120+y,5
circle 180-x,120+y,5
refresh
clg
goto loop

Cool person


# Cool person by R
clg
color 255,160,160
circle(150,50,50)
color 255,160,160
rect(146,100,10,10)
color blue
circle(130,40,5)
color blue
circle(170,40,5)
color yellow
x=120
y=15
poly {x+25,y+25,x+50,y+50,x+25,y+50}
color red
rect(140,80,30,10)
color green
rect(100,110,110,75)
color red
rect (130,75,10,10)
color red
rect (170,75,10,10)

Ambulance

# Ambulance by V
fastgraphics
x=0
y=0
loop:
x=x+1
if x>1000 then x = 0
colour darkgreen
rect 0,0,900,300
colour red
circle 950-x,225+y,10
color White
rect 910-x,270+y,60,20
rect 930-x,230+y,70,60
color red
rect 950-x,250+y,30,10
color red
rect 960-x,240+y,10,30
color black
circle 925-x,290+y,10
circle 990-x,290+y,10
refresh
clg
goto loop

House


#house by F
fastgraphics
x=1
loop:
if x> 100 then x=1
x=x+.1
colour red
rect 100,100,100,100
colour black
rect 140,150,25,50
colour darkred
rect 175,50,25,50
colour grey
circle 185,45-x,5
circle 200,45-x,4
circle 190,45-x,3
circle 180,45-x,2
refresh
clg
goto loop

Sunday, December 2, 2012

Venny

#Venn diagrams and logical operators
Font "Arial",30,100
For s = 1 to 5
clg
Text 20,20 ,"A"
Text 260,20 ,"B"
gosub circles
For n = 1 to 2000
x=rand*300
y=rand*300
A=0
B=0
gosub checkA
gosub checkB
if s = 1 then gosub one
if s = 2 then gosub two
if s = 3 then gosub three
if s = 4 then gosub four
if s = 5 then gosub five
next n
next s
end
one:
Text 140,250 ,"A"
if A=1 then circle x,y,2
return
two:
Text 100,250 ," A"+chr(1352)+"B"
if A=1 and B=1 then circle x,y,2
return
three:
Text 100,250 ," A"+chr(1357)+"B"
if A=1 or B=1 then circle x,y,2
return
four:
Text 120,250 ,"A'"
if not A=1 then circle x,y,2
return
five:
Text 100,250 ,"(A"+chr(1357)+"B)'"
if not (A=1 or B=1) then circle x,y,2
return
checkA:
if (x-100)^2+(y-150)^2<10000 then A=1
Return
checkB:
if (x-200)^2+(y-150)^2<10000 then B=1
Return
circles:
For x = 1 to 300
y=(-(x-200)^2+10000)^.5+150
circle x,y,2
circle x,-y+300,2
circle x-100,y,2
circle x-100,-y+300,2
next x
return