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

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

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

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

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

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

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

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

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

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

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

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

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

Doppler efect

#Doppler efect
fastgraphics

x=0

loop:

for b = 1 to 10

color white

rect 0,0,300,300

x=x+1

a=.5

for n = 1 to 255 step 5

a=a*-1+.5

color rgb(255-a*n,255-a*n,255-a*n)

circle x + (n-b)*.5-255,150,255-(n-b)

next n

refresh

clg

next b

goto loop

3D Bounce

graphsize 900,450

fastgraphics

vx=2

vy=3

vz=5

x=10

y=10

z=14

Loop:

color darkred

rect 0,0,900,450

color rgb(0,123,0)

poly{0,300,450,450,900,300,450,150}

color rgb(0,83,0)

poly{0,300,450,150,450,0,0,150}

color rgb(0,103,0)

poly{900,300,450,150,450,0,900,150}

color red

vz=vz-.05

x=x+vx

y=y+vy

z=z+vz

vz=vz-.05

h=(x+y)*cos(1/3)

v=300-(-x+y)*sin(1/3)

if x>465 then vx=-vx

if x<0 then vx=-vx

if y>465 then vy=-vy

if y<0 then vy=-vy

if z<0 then vz=-vz

color black

rect h,v,10,2

color red

circle h,v-z,10

refresh

clg

goto Loop

Golden Waves

graphsize 600,600

fastgraphics

for t=1 to 60 step .1

color darkred

rect 0,0,600,600

For y1 = 0 to 24

For x1 = 0 to 24

x=12*(24-x1)+12*y1

y=-6*(24-x1)+6*y1+300

d= ((10-x1)^2+(10-y1)^2)^.5

h=60*sin(x1/4+t)+65

if t>10 and t<20 then h=60*sin(y1/4+t)+65

if t>20 and t<30 then h=60*sin((x1-y1)/4+t)+65

if t>30 and t<40 then h=30*sin(x1/2+t)+30*sin(y1/2+t)+65

if t>40 and t<50 then h=60*sin((x1+y1)/4+t)+65

if t>50 and t<60 then h=60*sin(d*.3+t)+65

color rgb(100+h,100+h,h)

poly{x,y-h,x+10,y+5-h,x+20,y-h,x+10,y-5-h}

color rgb(60,60,0)

poly{x,y-h,x+10,y+5-h,x+10,y,x,y-5}

color rgb(150,150,0)

poly{x+10,y+5-h,x+10,y,x+20,y-5,x+20,y-h}

next x1

next y1

refresh

clg

next t

Flags

# By C
color orange
rect (50,250,20,50)
color darkblue
rect (50,50,1000,220)
color orange
rect (100,270,20,30)
color red
rect (0,0,1000,750)
color white
rect (0,110,1000,100)
color blue
rect(0,200,1000,750)
Pause 2
color orange
rect (50,250,20,50)
color darkblue
rect (50,50,1000,220)
color orange
rect (100,270,20,30)
color red
rect (0,0,1000,750)
color white
rect (0,110,1000,100)
color red
rect(0,200,1000,750)
pause 2
color white
rect (0,0,10000,10000)
color red
rect 135,0,25,1000
color red
rect 0,135,2500,25
Pause 2
color black
rect (0,0,1000,750)
color red
rect (0,110,1000,100)
color yellow
rect(0,200,1000,750)
Pause 2
color green
rect 0,0,100,1000
color white
rect 100,0,100,1000
color orange
rect 200,0,100,1000
Pause 2
color darkgreen
rect 0,0,100,300
color red
rect 100,0,200,300
color yellow
circle 100,150,50

Walk on by

# A rough attempt to model human walking

clg

graphsize 900,300

Fastgraphics

Dim limb(8)

limb = {0, 0, 0, 100, 10, 100,10,0}

y=140

people=10

Dim x(people)

Dim dx(people)

Dim r(people)

Dim g(people)

Dim b(people)

For n=0 to people-1

x[n]=int(rand*900)

dx[n]=(-1)^int(rand*2+1)

r[n]=int(rand*255)

g[n]=int(rand*255)

b[n]=int(rand*255)

next n

For p=0 to 10000

gosub walkman

next p

walkman:

clg

For n=0 to people-1

color r[n],g[n],b[n]

x[n]=x[n]+dx[n]

if x[n]<0 then x[n]=900

if x[n]>900 then x[n]=0

ywable=-10*abs(sin(x[n]*.03+pi/2))

xwable=-30*abs(sin(x[n]*.03))

leftrot=sin(x[n]*.03)/2

rightrot=sin(x[n]*.03+pi)/2

circle x[n]-xwable+5,y+ywable-25,15

stamp x[n]-xwable,y+60+ywable,1,leftrot,limb

stamp x[n]-xwable,y+ywable,.8,leftrot,limb

color r[n],0,b[n]

rect x[n]-10-xwable,y+ywable,30,70

color rgb( r[n],g[n],b[n])

stamp x[n]-xwable,y+60+ywable,1,rightrot,limb

stamp x[n]-xwable,y+ywable,.8,rightrot,limb

next n

refresh

return

Krypto - make the target number

# This program uses the new functions and subroutines from version 0.9.9.1










cls
clg
dim n(4)
dim op$(4)
target = int (rand*60)
n[0]=int (rand*10)+1
n[1]=int (rand*10)+1
n[2]=int (rand*10)+1
n[3]=int (rand*10)+1
graphsize 600,200
font "arial",40,100
text 0,20, "Target number is : "+ target
text 0,100, "Use only: "+ n[0]+", "+n[1]+", "+n[2]+", "+n[3]
counter=0
op$[0]="+"
op$[1]="-"
op$[2]="*"
op$[3]="/"
for turn = 1 to 2
For t1 = 0 to 3
For t2 = 0 to 3
For t3 = 0 to 3
For t4 = 0 to 3
For t5 = 0 to 3
For t6 = 0 to 3
For t7 = 0 to 3
if t1<>t3 and t3<>t5 and t5<>t7 and t1<>t5 and t3<>t7 and t1<>t7 then
a=eval(op$[t2],n[t1],n[t3])
c=eval(op$[t6],n[t5],n[t7])
ac=eval(op$[t4],a,c)
if ac = target and turn =2 then Print "("+ n[t1]+op$[t2]+n[t3]+")"+op$[t4]+"("+ n[t5]+op$[t6]+n[t7]+")="+ac
if ac = target and turn =1 then counter = counter +1
b=eval(op$[t4],n[t3],n[t5])
ba=eval(op$[t2],n[t1],b)
bac=eval(op$[t6],ba,n[t7])
if bac= target and turn =2 then Print "(("+ n[t1]+op$[t2]+"("+n[t3]+op$[t4]+n[t5]+"))"+op$[t6]+n[t7]+"="+bac
if bac = target and turn =1 then counter = counter +1
bc=eval(op$[t6],b,n[t7])
bca=eval(op$[t2],n[t1],bc)
if bca= target and turn =2 then Print n[t1]+op$[t2]+"(("+n[t3]+op$[t4]+n[t5]+")"+op$[t6]+n[t7]+")="+bca
if bca = target and turn =1 then counter = counter +1
ab=eval(op$[t4],a,n[t5])
abc=eval(op$[t6],ab,n[t7])
if abc= target and turn =2 then Print "(("+ n[t1]+op$[t2]+n[t3]+")"+op$[t4]+n[t5]+")"+op$[t6]+n[t7]+"="+abc
if abc = target and turn =1 then counter = counter +1
cb=eval(op$[t4],n[t3],c)
cba=eval(op$[t2],n[t1],cb)
if cba = target and turn =2 then Print n[t1]+op$[t2]+"("+n[t3]+op$[t4]+"("+n[t5]+op$[t6]+n[t7]+"))="+cba
if cba = target and turn =1 then counter = counter +1
end if
next t7
next t6
next t5
next t4
next t3
next t2
next t1
print "Number of solutions "+counter
input "press any key to get solutions",a
next turn
function eval(e$,x,y)
if e$="*" then eval = x*y
if e$="/" and y<>0 then eval = x/y
if e$="/" and y=0 then eval = 10000000
if e$="-" then eval = x-y
if e$="+" then eval = x+y
end function

Multiparticle collider

Rem 2D collisions
fastgraphics

m=6

n=m^2

Dim x(n)

Dim y(n)

Dim vx(n)

Dim vy(n)

Dim mass(n)

Dim colisionflag(n,n)

ed=1

u=0

rem initial variables

for a = 0 to m-1

for b = 0 to m-1

x[u]=50*a+10

y[u]=50*b+10

vx[u]=rand-.5

vy[u]=rand-.5

mass[u]=7

u=u+1

next b

next a

Rem main loop

While 1=1

for u = 0 to n-1

If x[u]<mass[u] or x[u]>(300-mass[u]) then vx[u]=-vx[u]

If y[u]<mass[u] or y[u]>(300-mass[u]) then vy[u]=-vy[u]

x[u]=x[u]+vx[u]

y[u]=y[u]+vy[u]

color rgb (u*7,0,255-u*7)

circle x[u],y[u],mass[u]

next u

refresh

clg

gosub colision

end while

colision:

rem collision detection

for u1 = 0 to n-2

for u2 = u1+1 to n-1

dx = x[u2]-x[u1]

dy = y[u2]-y[u1]

distance = (dx*dx+dy*dy)^.5

if distance < (mass[u1]+mass[u2]) then

if colisionflag[u1,u2]=0 then

rem vx and vy calc

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