RetroBASIC
Retrogamecoding(.org) => Examples => Topic started by: Rick3137 on July 09, 2013, 08:13:58 PM
-
This first program is a simple Game Board Demo.
' Game Board Demo by Rick3137 http://rb23.yolasite.com/
Var btn as string
Var mx as number
Var my as number
Var column as number
Var row as number
Function OnLoad()
setBackgroundColor( 0, 0, 40)
EndFunction
Function OnDraw()
setColor( 255, 255, 255 )
Print( Str$( mx ) , 20, 100)
Print( Str$( my ) , 20, 120)
Print( Str$( column ) , 20, 140)
Print( Str$( row ) , 20, 160)
setColor ( 50 , 50 , 100 )
FillRectangle ( 90 , 0, 520, 520)
setColor ( 90 , 90 , 150 )
FillRectangle ( 100 , 10, 500, 500)
Squares()
EndFunction
Function Squares()
Var x as number
Var y as number
Var x2 as number
Var y2 as number
Var x3 as number
Var y3 as number
setColor ( 255 , 255 , 255 )
x=100
y=10
x2 = x+2
y2 = y+3
x3 = x+48
y3 = y+48
For a = 1 to 100
StrokeRectangle ( x , y, 50, 50)
for b = 1 to 2
setColor ( 0 , 0 , 0 )
Line(x2,y2,x3,y2)
Line(x3,y2,x3,y3)
setColor ( 255 , 255 , 255 )
Next
x=x+50
if x > 590 then
x=100
y = y + 50
endif
x2 = x+2
y2 = y+3
x3 = x+48
y3 = y+48
Next
endfunction
Function OnMouseMoved(x as number, y as number)
mx = x
my = y
mx = Int ( mx )
my = Int ( my )
x = mx -50
y = my - 10
column = Int ( x/50 )
row = Int ( y/50 + 1 )
EndFunction
Function OnMouseReleased(x as number ,y as number, button as string)
Select button
Case "l"
btn = "Left"
break
Case "r"
btn = "Right"
break
EndSelect
EndFunction
By Rick3137--- http://rb23.yolasite.com/ (http://rb23.yolasite.com/)
-
Hi Rick3137,
Thanks for giving BrowserBasic a go.
I had to add variable declarations for the 2 for loops at line 44 and 47 to get it run.
Not sure which version of BB your were using.
It looks like you are getting ready to program a game a chess or checkers or draughts perhaps?
-
OK. I upgraded my copy. I'm always looking for something new to tinker with. Then I try to do a small right-up for it and put some samples on my website. I need to get me another website that actually does HTML and JavaScript.
The first program is just a template for building board games. I'm not sure what game, but I might do something like Othello. I hope some other users find it useful.
Here's the fixed version:
' Game Board Demo by Rick3137 http://rb23.yolasite.com/
Var btn as string
Var mx as number
Var my as number
Var column as number
Var row as number
Function OnLoad()
setBackgroundColor( 0, 0, 40)
EndFunction
Function OnDraw()
setColor( 255, 255, 255 )
Print( Str$( mx ) , 20, 100)
Print( Str$( my ) , 20, 120)
Print( Str$( column ) , 20, 140)
Print( Str$( row ) , 20, 160)
setColor ( 50 , 50 , 100 )
FillRectangle ( 90 , 0, 520, 520)
setColor ( 90 , 90 , 150 )
FillRectangle ( 100 , 10, 500, 500)
Squares()
EndFunction
Function Squares()
Var x as number
Var y as number
Var x2 as number
Var y2 as number
Var x3 as number
Var y3 as number
Var a as number
Var b as number
setColor ( 255 , 255 , 255 )
x=100
y=10
x2 = x+2
y2 = y+3
x3 = x+48
y3 = y+48
For a = 1 to 100
StrokeRectangle ( x , y, 50, 50)
for b = 1 to 2
setColor ( 0 , 0 , 0 )
Line(x2,y2,x3,y2)
Line(x3,y2,x3,y3)
setColor ( 255 , 255 , 255 )
Next
x=x+50
if x > 590 then
x=100
y = y + 50
endif
x2 = x+2
y2 = y+3
x3 = x+48
y3 = y+48
Next
endfunction
Function OnMouseMoved(x as number, y as number)
mx = x
my = y
mx = Int ( mx )
my = Int ( my )
x = mx -50
y = my - 10
column = Int ( x/50 )
row = Int ( y/50 + 1 )
EndFunction
Function OnMouseReleased(x as number ,y as number, button as string)
Select button
Case "l"
btn = "Left"
break
Case "r"
btn = "Right"
break
EndSelect
EndFunction
-
Has a nice clean look to it. :)
If you are looking for a challenge maybe you could do a "Langton's Ant" program.
see http://en.wikipedia.org/wiki/Langton%27s_ant
Not exactly a game but quite good fun all the same.
-
Thanks Steve, that's a good one.
-
GAME BOARD TEMPLATE 2
This template has a grid of 20x20.
' Game Board Demo2 by Rick3137 http://rb23.yolasite.com/
Var btn as string
Var mx as number
Var my as number
Var column as number
Var row as number
Function OnLoad()
setBackgroundColor( 0, 0, 40)
EndFunction
Function OnDraw()
setColor( 255, 255, 255 )
Print( Str$( mx ) , 20, 100)
Print( Str$( my ) , 20, 120)
Print( Str$( column ) , 20, 140)
Print( Str$( row ) , 20, 160)
setColor ( 50 , 50 , 100 )
FillRectangle ( 90 , 0, 520, 520)
setColor ( 90 , 90 , 150 )
FillRectangle ( 100 , 10, 500, 500)
Squares()
EndFunction
Function Squares()
Var x as number
Var y as number
Var a as number
setColor ( 255 , 255 , 255 )
x=100
y=10
For a = 1 to 400
StrokeRectangle ( x , y, 25, 25)
x=x+25
if x > 590 then
x=100
y = y + 25
endif
Next
endfunction
Function OnMouseMoved(x as number, y as number)
mx = x
my = y
mx = Int ( mx )
my = Int ( my )
x = mx - 75
y = my - 10
column = Int ( x/25 )
row = Int ( y/25 + 1 )
EndFunction
Function OnMouseReleased(x as number ,y as number, button as string)
Select button
Case "l"
btn = "Left"
break
Case "r"
btn = "Right"
break
EndSelect
EndFunction
-
BOARD TEMPLATE3
This board template has a 30 x 20 grid. Use it as a starter program.
' Game Board Demo3 by Rick3137 http://rb23.yolasite.com/
Var btn as string
Var mx as number
Var my as number
Var column as number
Var row as number
Function OnLoad()
setBackgroundColor( 0, 0, 40)
EndFunction
Function OnDraw()
setColor( 255, 255, 255 )
Print( Str$( mx ) , 20, 100)
Print( Str$( my ) , 20, 120)
Print( Str$( column ) , 20, 140)
Print( Str$( row ) , 20, 160)
setColor ( 50 , 50 , 100 )
FillRectangle ( 90 , 0, 770, 520)
setColor ( 90 , 90 , 150 )
FillRectangle ( 100 , 10, 750, 500)
Squares()
EndFunction
Function Squares()
Var x as number
Var y as number
Var a as number
setColor ( 255 , 255 , 255 )
x=100
y=10
For a = 1 to 600
StrokeRectangle ( x , y, 25, 25)
x=x+25
if x > 840 then
x=100
y = y + 25
endif
Next
endfunction
Function OnMouseMoved(x as number, y as number)
mx = x
my = y
mx = Int ( mx )
my = Int ( my )
x = mx - 75
y = my - 10
column = Int ( x/25 )
row = Int ( y/25 + 1 )
EndFunction
Function OnMouseReleased(x as number ,y as number, button as string)
Select button
Case "l"
btn = "Left"
break
Case "r"
btn = "Right"
break
EndSelect
EndFunction
-
Hi Rick
I need to get me another website that actually does HTML and JavaScript.
I had similar problem.
Then I remembered that my Broadband ISP provides me with a few Gb of webspace for free.
Maybe yours does too.
cheers, SteveOW.
PS I like your Yola website.
-
LANGTON'S ANT
I think it needs more squares. The pattern looks perfectly random to me.
' Langtons Ant by Rick3137 http://rb23.yolasite.com/
Var btn as string
Var mx as number
Var my as number
Var column as number
Var row as number
Var Sqr[800] as array
Var square as number
Var c2 as number
Var r2 as number
Var x2 as number
Var y2 as number
Var ant as number
Var t1 as number
Var time as number
Var direction as number '1=up 2=right 3=down 4=left
Var test as string
Function OnLoad()
Var a as number
setBackgroundColor( 0, 0, 40)
ant = 285
direction = 1
t1 = 1
for a = 1 to 600
Sqr[a] = 1
next
EndFunction
Function OnUpdate( dt as number )
UpdateAnt()
endfunction
Function OnDraw()
Var a as number
Print( Str$( direction ) , 20, 100)
setColor ( 50 , 50 , 100 )
FillRectangle ( 90 , 0, 770, 520)
Squares()
PaintAnt()
EndFunction
Function PaintAnt()
r2 = Int ( (ant - 1 )/30 )
c2 = Int ( ant - r2 * 30 )
r2 = r2 + 1
x2 = 75 + 25 * c2
y2 = 25 * r2 - 15
setColor ( 255 , 90 , 50 )
FillRectangle ( x2+8 , y2+7, 10, 10)
Endfunction
Function UpdateAnt()
RotateAnt()
FlipColor()
MoveAnt()
time = 0
r2 = Int ( (ant - 1 )/30 )
c2 = Int ( ant - r2 * 30 )
r2 = r2 + 1
x2 = 75 + 25 * c2
y2 = 25 * r2 - 15
endfunction
Function Squares()
Var x as number
Var y as number
Var a as number
Var b as number
x=100
y=10
For a = 1 to 600
setColor ( 90 , 90 , 255 )
b = Sqr[a]
if b < 2 then setColor ( 90 , 90 , 255 ) endif
if b = 2 then setColor ( 90 , 255 , 50 ) endif
FillRectangle ( x , y, 25, 25)
setColor ( 255 , 255 , 255 )
StrokeRectangle ( x , y, 25, 25)
x=x+25
if x > 840 then
x=100
y = y + 25
endif
Next
endfunction
Function RotateAnt()
Var a as number
Var b as number
a = direction
b = Sqr[ant]
if b < 2 then
a = a + 1
if a > 4 then a = 1 endif
endif
if b > 1 then
a = a - 1
if a < 1 then a = 4 endif
endif
direction = a
endfunction
Function FlipColor()
Var a as number
Var b as number
b = Sqr[ant]
if b > 1 then
a=1
else
a=2
endif
Sqr[ant] = a
endfunction
Function MoveAnt()
Var a as number
Var b as number
Var c as number
Var d as number
b = Sqr[ant]
a = direction
if ant < 1 then
ant = 285
direction = 1
endif
if ant > 600 then
ant = 285
direction = 1
endif
if a = 1 then
ant = ant - 30
if ant < 1 then
ant = 285
direction = 1
endif
endif
if a = 2 then
ant = ant + 1
endif
if a = 3 then
ant = ant + 30
if ant > 600 then
ant = 285
direction = 1
endif
endif
if a = 4 then
ant = ant - 1
endif
endfunction
-
Hi Rick,
It looks good, but as you say, the grid needs to have more cells.
I think you need about 200x200 = 40,000 cells in order to see the "Ant Highway" being built.
From memory I think it takes about 10,000 steps before the highway building behavior pattern emerges.
Your code is a little too cryptic for me to adjust easilly.
I might have a go at it myself in BB.
Here is a link to a little competition some people had in writing a Langton's Ant Program some years back.
http://ubuntuforums.org/archive/index.php/t-812784.html
It might be interesing to see how Langton's Ant could be done in NaaLaa and EGSL.
cheers, SteveOW.
-
It might be interesing to see how Langton's Ant could be done in NaaLaa and EGSL.
Here (http://retrogamecoding.org/board/index.php?topic=184.0) is EGSL version.
-
LANGTON'S ANT 2
This time I used enough squares to show the ant highway.
' Langtons Ant by Rick3137 http://rb23.yolasite.com/
Var Sqr[60000] as array
Var square as number
Var ant as number
Var direction as number '1=up 2=right 3=down 4=left
Var cnt as number
Function OnLoad()
Var a as number
ant = 18090
direction = 1
for a = 1 to 599990
Sqr[a] = 1
next
cnt = 1
EndFunction
Function OnUpdate( dt as number )
Var a as number
cnt = cnt + 1
if cnt < 28 then
for a = 1 to 500
UpdateAnt()
next
endif
endfunction
Function OnDraw()
DrawSquares()
EndFunction
Function UpdateAnt()
RotateAnt()
FlipColor()
MoveAnt()
endfunction
Function DrawSquares()
Var x as number
Var y as number
Var a as number
Var b as number
Var cnt as number
cnt = 1
x=10
y=10
For a = 1 to 40000
setColor ( 90 , 90 , 255 )
b = Sqr[a]
if b < 2 then setColor ( 90 , 90 , 255 ) endif
if b = 2 then setColor ( 90 , 255 , 50 ) endif
if a = ant then setColor ( 255 , 90 , 90 ) endif
FillRectangle ( x-1 , y-1, 3, 3 )
cnt = cnt + 1
x=x+3
if cnt = 201 then
cnt = 1
x=10
y = y + 3
endif
Next
endfunction
Function RotateAnt()
Var a as number
Var b as number
a = direction
b = Sqr[ant]
if b = 1 then
a = a + 1
if a > 4 then a = 1 endif
endif
if b = 2 then
a = a - 1
if a < 1 then a = 4 endif
endif
direction = a
endfunction
Function FlipColor()
Var a as number
Var b as number
b = Sqr[ant]
if b = 2 then
a=1
else
a=2
endif
Sqr[ant] = a
endfunction
Function MoveAnt()
Var a as number
a = direction
if a = 1 then
ant = ant - 200
endif
if a = 2 then
ant = ant + 1
endif
if a = 3 then
ant = ant + 200
endif
if a = 4 then
ant = ant - 1
endif
endfunction
-
Hi Rick, it looks good. :)
I took your code and made a few changes, mainly cosmetic.
Now programmer can easilly switch between different number of hidden steps.
The way you use a 1D array to represent a 2D grid is interesting.
' LangtonsAnt by Rick3137 http://rb23.yolasite.com/
'... Define Global Variables
var NumHiddenSteps as number
'NumHiddenSteps = 1
NumHiddenSteps = 50
'NumHiddenSteps = 500
Var CellVal[60000] as array
Var square as number
Var antCell as number
Var direction as number '...values 0=up 90=right 180=down 270=left
Var plotCount as number
Function OnLoad()
Var Cnum as number
antCell = 18090
direction = 0 '1
for Cnum = 1 to 599990 '...why not 599999?
CellVal[Cnum] = 0
next
plotCount = 1
EndFunction
Function OnUpdate( dt as number )
Var CellNum as number
var numReplots as number
numReplots = 14000/NumHiddenSteps
plotCount = plotCount + 1
if plotCount < numReplots then
for CellNum = 1 to NumHiddenSteps '...when plotCount > numReplots, the prog updatesantCell position NumHiddenSteps times before plotting
UpdateAnt()
next
endif
endfunction
Function OnDraw()
DrawSquares()
EndFunction
Function UpdateAnt()
RotateAnt()
FlipColor()
MoveAnt()
endfunction
Function DrawSquares()
Var x as number
Var y as number
Var Cnum as number
Var plotCount as number
plotCount = 1
x=10
y=10
For Cnum = 1 to 40000 '...200 x 200 = 40,000
setColor ( 90 , 90 , 255 )'...blue, default, for cells with value = 0
if CellVal[Cnum] = 1 then setColor ( 90 , 255 , 50 ) endif '...green
if Cnum = antCell then setColor ( 255 , 90 , 90 ) endif '...red
FillRectangle ( x-1 , y-1, 3, 3 )
plotCount = plotCount + 1
x = x+3
if plotCount = 201 then '... begin new row
plotCount = 1
x = 10
y = y + 3
endif
Next
endfunction
Function RotateAnt()
if CellVal[antCell] = 0 then
direction = direction + 90
if direction > 270 then direction = 0 endif
elseif CellVal[antCell] = 1 then
direction = direction - 90
if direction < 0 then direction = 270 endif
endif
endfunction
Function FlipColor()
if CellVal[antCell] = 0 then
CellVal[antCell] = 1
else
CellVal[antCell] = 0
endif
endfunction
Function MoveAnt()
if direction= 0 then
antCell = antCell - 200 '...move up to prev row
elseif direction = 90 then
antCell = antCell + 1
elseif direction = 180 then
antCell = antCell + 200 '...move down to next row
elseif direction = 270 then
antCell = antCell - 1
endif
endfunction
-
I have heard of having bugs in code, but never to code bugs.
;D
-
Nice remix Steve. Now all it needs is some bug spray. 8)
-
SIERPINSKI TRIANGLE
' This program written by Rick3137
' http://rb23.yolasite.com/
' 1 Radian = 57.2958 Degrees.
' 1 degree = .0174532925 Radians
Var pendown as number
Var cnt as number
Var cnt2 as number
Var PenX as number
Var PenY as number
Var Angle as number
Var Angle2 as number
Var d as number
Var dx as number
Var dy as number
Var x1 as number
Var y1 as number
Var x2 as number
Var y2 as number
Var red as number
Var green as number
Var blue as number
Var d as number
Var AngleR as number
Var Color as number
Function OnLoad()
d = 550
Angle = 270
AngleR = 120
PenX = 400
PenY = 300
pendown = 1
Color = 100
setColor ( 125 , 122 , 250 )
setBackgroundColor( 0, 0, 50)
endfunction
Function OnUpdate( dt as number )
endfunction
Function OnDraw()
Color = 1
PenX = 200
PenY = 500
x1 = PenX
y1 = PenY
x2 = 300
y2 = 400
Angle = 60
Fractal( d )
endfunction
Function ChangeColor( n as number )
Color = Color + n
if Color > 99 then Color = 1 endif
SetColor2( Color )
endfunction
Function RotateRight( n as number )
if Angle > n then
Angle = Angle - n
else
n = n - Angle
Angle = 360 - Angle
endif
if Angle = 360 then Angle = 0 endif
EndFunction
Function RotateLeft( n as number )
Angle = Angle + n
if Angle > 360 then
Angle = n - 360
endif
EndFunction
Function DegreeToRadian( n as number )
Angle2 = n * .0174532925
EndFunction
Function MoveSteps ( n as number )
DegreeToRadian ( Angle )
dx = cos (Angle2)
dy = sin (Angle2)
dx = dx * n
dy = dy * n
x2 = PenX + dx
y2 = PenY - dy
if pendown = 1 then line ( PenX , PenY , x2 , y2 ) endif
PenX = PenX + dx
PenY = PenY - dy
EndFunction
Function Fractal ( Distance as number )
Var cnt as number
cnt = 0
while (cnt < 3)
MoveSteps ( Distance )
RotateRight( AngleR )
Fractal2 ( Distance / 2 )
cnt = cnt + 1
EndWhile
EndFunction
Function Fractal2 ( Distance as number )
Var cnt as number
cnt = 0
while (cnt < 3)
MoveSteps ( Distance )
RotateRight( AngleR )
Fractal3 ( Distance / 2 )
cnt = cnt + 1
EndWhile
EndFunction
Function Fractal3 ( Distance as number )
Var cnt as number
cnt = 0
ChangeColor(5)
while (cnt < 3)
MoveSteps ( Distance )
RotateRight( AngleR )
Fractal4 ( Distance / 2 )
cnt = cnt + 1
EndWhile
EndFunction
Function Fractal4 ( Distance as number )
Var cnt as number
cnt = 0
while (cnt < 3)
MoveSteps ( Distance )
RotateRight( AngleR )
Fractal5 ( Distance / 2 )
cnt = cnt + 1
EndWhile
EndFunction
Function Fractal5 ( Distance as number )
Var cnt as number
cnt = 0
while (cnt < 3)
MoveSteps ( Distance )
RotateRight( AngleR )
Fractal6 ( Distance / 2 )
cnt = cnt + 1
EndWhile
EndFunction
Function Fractal6 ( Distance as number )
Var cnt as number
cnt = 0
while (cnt < 3)
MoveSteps ( Distance )
RotateRight( AngleR )
Fractal7 ( Distance / 2 )
cnt = cnt + 1
EndWhile
EndFunction
Function Fractal7 ( Distance as number )
Var cnt as number
cnt = 0
while (cnt < 3)
MoveSteps ( Distance )
RotateRight( AngleR )
cnt = cnt + 1
EndWhile
EndFunction
Function SetColor2( clr as number )
if clr > 99 then clr = 1 endif
if clr = 0 then clr = 1 endif
if clr < 0 then clr = 1 endif
if clr = 1 then setcolor (10, 10, 255) endif
if clr = 2 then setcolor (60, 60, 255) endif
if clr = 3 then setcolor (30, 60, 250) endif
if clr = 4 then setcolor (40, 80, 240) endif
if clr = 5 then setcolor (50, 100, 230) endif
if clr = 6 then setcolor (60, 120, 230) endif
if clr = 7 then setcolor (70, 140, 220) endif
if clr = 8 then setcolor (80, 160, 220) endif
if clr = 9 then setcolor (90, 180, 200) endif
if clr = 10 then setcolor (150, 255, 255) endif
if clr = 11 then setcolor (120, 230, 255) endif
if clr = 12 then setcolor (120, 210, 255) endif
if clr = 13 then setcolor (120, 180, 255) endif
if clr = 14 then setcolor (120, 160, 255) endif
if clr = 15 then setcolor (20, 140, 255) endif
if clr = 16 then setcolor (20, 255, 230) endif
if clr = 17 then setcolor (20, 255, 190) endif
if clr = 18 then setcolor (20, 255, 170) endif
if clr = 19 then setcolor (20, 255, 140) endif
if clr = 20 then setcolor (20, 255, 120) endif
if clr = 21 then setcolor (0, 255, 100) endif
if clr = 22 then setcolor (0, 255, 90) endif
if clr = 23 then setcolor (0, 235, 80) endif
if clr = 24 then setcolor (0, 205, 70) endif
if clr = 25 then setcolor (0, 90, 60) endif
if clr = 26 then setcolor (0, 255, 50) endif
if clr = 27 then setcolor (0, 245, 40) endif
if clr = 28 then setcolor (0, 225, 30) endif
if clr = 29 then setcolor (0, 215, 20) endif
if clr = 30 then setcolor (0, 205, 10) endif
if clr = 31 then setcolor (235, 255, 10) endif
if clr = 32 then setcolor (215, 255, 20) endif
if clr = 33 then setcolor (255, 255, 30) endif
if clr = 34 then setcolor (255, 235, 40) endif
if clr = 35 then setcolor (255, 215, 50) endif
if clr = 36 then setcolor (255, 195, 60) endif
if clr = 37 then setcolor (255, 85, 50) endif
if clr = 38 then setcolor (255, 75, 40) endif
if clr = 39 then setcolor (155, 155, 10) endif
if clr = 40 then setcolor (155, 255, 10) endif
if clr = 41 then setcolor (255, 10, 255) endif
if clr = 42 then setcolor (255, 40, 255) endif
if clr = 43 then setcolor (255, 60, 255) endif
if clr = 44 then setcolor (255, 180, 255) endif
if clr = 45 then setcolor (255, 10, 255) endif
if clr = 46 then setcolor (235, 10, 255) endif
if clr = 47 then setcolor (215, 10, 255) endif
if clr = 48 then setcolor (195, 80, 255) endif
if clr = 49 then setcolor (255, 90, 195) endif
if clr = 50 then setcolor (255, 90, 165) endif
if clr = 51 then setcolor (10, 20, 255) endif
if clr = 52 then setcolor (40, 40, 255) endif
if clr = 53 then setcolor (80, 80, 255) endif
if clr = 54 then setcolor (40, 80, 255) endif
if clr = 55 then setcolor (50, 100, 255) endif
if clr = 56 then setcolor (60, 120, 255) endif
if clr = 57 then setcolor (70, 140, 255) endif
if clr = 58 then setcolor (80, 160, 255) endif
if clr = 59 then setcolor (90, 180, 255) endif
if clr = 60 then setcolor (150, 200, 255) endif
if clr = 61 then setcolor (10, 255, 255) endif
if clr = 62 then setcolor (20, 255, 235) endif
if clr = 63 then setcolor (30, 255, 215) endif
if clr = 64 then setcolor (40, 255, 195) endif
if clr = 65 then setcolor (50, 235, 255) endif
if clr = 66 then setcolor (50, 215, 255) endif
if clr = 67 then setcolor (50, 195, 255) endif
if clr = 68 then setcolor (50, 95, 255) endif
if clr = 69 then setcolor (50, 155, 155) endif
if clr = 70 then setcolor (100, 255, 255) endif
if clr = 71 then setcolor (0, 255, 200) endif
if clr = 72 then setcolor (0, 255, 180) endif
if clr = 73 then setcolor (0, 255, 160) endif
if clr = 74 then setcolor (0, 255, 140) endif
if clr = 75 then setcolor (0, 255, 120) endif
if clr = 76 then setcolor (0, 255, 50) endif
if clr = 77 then setcolor (0, 215, 40) endif
if clr = 78 then setcolor (50, 255, 30) endif
if clr = 79 then setcolor (90, 255, 20) endif
if clr = 80 then setcolor (110, 255, 10) endif
if clr = 81 then setcolor (255, 255, 10) endif
if clr = 82 then setcolor (255, 255, 20) endif
if clr = 83 then setcolor (255, 255, 30) endif
if clr = 84 then setcolor (255, 255, 40) endif
if clr = 85 then setcolor (255, 255, 50) endif
if clr = 86 then setcolor (255, 255, 60) endif
if clr = 87 then setcolor (255, 255, 70) endif
if clr = 88 then setcolor (255, 255, 80) endif
if clr = 89 then setcolor (255, 255, 90) endif
if clr = 90 then setcolor (255, 255, 100) endif
if clr = 91 then setcolor (255, 10, 255) endif
if clr = 92 then setcolor (255, 20, 255) endif
if clr = 93 then setcolor (255, 30, 255) endif
if clr = 94 then setcolor (255, 40, 255) endif
if clr = 95 then setcolor (255, 50, 255) endif
if clr = 96 then setcolor (255, 60, 255) endif
if clr = 97 then setcolor (255, 70, 255) endif
if clr = 98 then setcolor (255, 80, 255) endif
if clr = 99 then setcolor (255, 90, 255) endif
endfunction
-
SIERPINSKI TRIANGLE; very colorful and ... triangular.
-
THE SQUARE ROOT OF A TRIANGLE
' This program written by Rick3137
' http://rb23.yolasite.com/
' 1 Radian = 57.2958 Degrees.
' 1 degree = .0174532925 Radians
Var pendown as number
Var cnt as number
Var cnt2 as number
Var PenX as number
Var PenY as number
Var Angle as number
Var Angle2 as number
Var d as number
Var dx as number
Var dy as number
Var x1 as number
Var y1 as number
Var x2 as number
Var y2 as number
Var red as number
Var green as number
Var blue as number
Var d as number
Var AngleR as number
Var Color as number
Function OnLoad()
d = 450
Angle = 270
AngleR = 120
PenX = 350
PenY = 400
pendown = 1
Color = 100
setColor ( 125 , 122 , 250 )
setBackgroundColor( 0, 0, 50)
endfunction
Function OnUpdate( dt as number )
endfunction
Function OnDraw()
Color = 1
PenX = 280
PenY = 370
Angle = 0
Fractal( d )
endfunction
Function ChangeColor( n as number )
Color = Color + n
if Color > 99 then Color = 1 endif
SetColor2( Color )
endfunction
Function RotateRight( n as number )
if Angle > n then
Angle = Angle - n
else
n = n - Angle
Angle = 360 - Angle
endif
if Angle = 360 then Angle = 0 endif
EndFunction
Function RotateLeft( n as number )
Angle = Angle + n
if Angle > 360 then
Angle = Angle - 360
endif
EndFunction
Function DegreeToRadian( n as number )
Angle2 = n * .0174532925
EndFunction
Function MoveSteps ( n as number )
DegreeToRadian ( Angle )
dx = cos (Angle2)
dy = sin (Angle2)
dx = dx * n
dy = dy * n
x2 = PenX + dx
y2 = PenY - dy
if pendown = 1 then line ( PenX , PenY , x2 , y2 ) endif
PenX = PenX + dx
PenY = PenY - dy
EndFunction
Function Fractal ( Distance as number )
Var cnt1 as number
cnt1 = 0
while (cnt1 < 4)
MoveSteps ( Distance /4 )
Fractal2 ( Distance /2 )
MoveSteps ( Distance /4 )
RotateLeft( 90 )
cnt1 = cnt1 + 1
EndWhile
EndFunction
Function Fractal2 ( Distance as number )
Var cnt2 as number
cnt2 = 0
while (cnt2 < 3)
RotateLeft( AngleR )
MoveSteps ( Distance )
Fractal3 ( Distance / 2 )
cnt2 = cnt2 + 1
EndWhile
EndFunction
Function Fractal3 ( Distance as number )
Var cnt as number
cnt = 0
ChangeColor(5)
while (cnt < 3)
RotateLeft( AngleR )
MoveSteps ( Distance )
Fractal4 ( Distance / 2 )
cnt = cnt + 1
EndWhile
EndFunction
Function Fractal4 ( Distance as number )
Var cnt as number
cnt = 0
while (cnt < 3)
RotateLeft( AngleR )
MoveSteps ( Distance )
Fractal5 ( Distance / 2 )
cnt = cnt + 1
EndWhile
EndFunction
Function Fractal5 ( Distance as number )
Var cnt as number
cnt = 0
while (cnt < 3)
RotateLeft( AngleR )
MoveSteps ( Distance )
Fractal6 ( Distance / 2 )
cnt = cnt + 1
EndWhile
EndFunction
Function Fractal6 ( Distance as number )
Var cnt as number
cnt = 0
while (cnt < 3)
RotateLeft( AngleR )
MoveSteps ( Distance )
Fractal7 ( Distance / 2 )
cnt = cnt + 1
EndWhile
EndFunction
Function Fractal7 ( Distance as number )
Var cnt as number
cnt = 0
while (cnt < 3)
RotateLeft( AngleR )
MoveSteps ( Distance )
cnt = cnt + 1
EndWhile
EndFunction
Function SetColor2( clr as number )
if clr > 99 then clr = 1 endif
if clr = 0 then clr = 1 endif
if clr < 0 then clr = 1 endif
if clr = 1 then setcolor (10, 10, 255) endif
if clr = 2 then setcolor (60, 60, 255) endif
if clr = 3 then setcolor (30, 60, 250) endif
if clr = 4 then setcolor (40, 80, 240) endif
if clr = 5 then setcolor (50, 100, 230) endif
if clr = 6 then setcolor (60, 120, 230) endif
if clr = 7 then setcolor (70, 140, 220) endif
if clr = 8 then setcolor (80, 160, 220) endif
if clr = 9 then setcolor (90, 180, 200) endif
if clr = 10 then setcolor (150, 255, 255) endif
if clr = 11 then setcolor (120, 230, 255) endif
if clr = 12 then setcolor (120, 210, 255) endif
if clr = 13 then setcolor (120, 180, 255) endif
if clr = 14 then setcolor (120, 160, 255) endif
if clr = 15 then setcolor (20, 140, 255) endif
if clr = 16 then setcolor (20, 255, 230) endif
if clr = 17 then setcolor (20, 255, 190) endif
if clr = 18 then setcolor (20, 255, 170) endif
if clr = 19 then setcolor (20, 255, 140) endif
if clr = 20 then setcolor (20, 255, 120) endif
if clr = 21 then setcolor (0, 255, 100) endif
if clr = 22 then setcolor (0, 255, 90) endif
if clr = 23 then setcolor (0, 235, 80) endif
if clr = 24 then setcolor (0, 205, 70) endif
if clr = 25 then setcolor (0, 90, 60) endif
if clr = 26 then setcolor (0, 255, 50) endif
if clr = 27 then setcolor (0, 245, 40) endif
if clr = 28 then setcolor (0, 225, 30) endif
if clr = 29 then setcolor (0, 215, 20) endif
if clr = 30 then setcolor (0, 205, 10) endif
if clr = 31 then setcolor (235, 255, 10) endif
if clr = 32 then setcolor (215, 255, 20) endif
if clr = 33 then setcolor (255, 255, 30) endif
if clr = 34 then setcolor (255, 235, 40) endif
if clr = 35 then setcolor (255, 215, 50) endif
if clr = 36 then setcolor (255, 195, 60) endif
if clr = 37 then setcolor (255, 85, 50) endif
if clr = 38 then setcolor (255, 75, 40) endif
if clr = 39 then setcolor (155, 155, 10) endif
if clr = 40 then setcolor (155, 255, 10) endif
if clr = 41 then setcolor (255, 10, 255) endif
if clr = 42 then setcolor (255, 40, 255) endif
if clr = 43 then setcolor (255, 60, 255) endif
if clr = 44 then setcolor (255, 180, 255) endif
if clr = 45 then setcolor (255, 10, 255) endif
if clr = 46 then setcolor (235, 10, 255) endif
if clr = 47 then setcolor (215, 10, 255) endif
if clr = 48 then setcolor (195, 80, 255) endif
if clr = 49 then setcolor (255, 90, 195) endif
if clr = 50 then setcolor (255, 90, 165) endif
if clr = 51 then setcolor (10, 20, 255) endif
if clr = 52 then setcolor (40, 40, 255) endif
if clr = 53 then setcolor (80, 80, 255) endif
if clr = 54 then setcolor (40, 80, 255) endif
if clr = 55 then setcolor (50, 100, 255) endif
if clr = 56 then setcolor (60, 120, 255) endif
if clr = 57 then setcolor (70, 140, 255) endif
if clr = 58 then setcolor (80, 160, 255) endif
if clr = 59 then setcolor (90, 180, 255) endif
if clr = 60 then setcolor (150, 200, 255) endif
if clr = 61 then setcolor (10, 255, 255) endif
if clr = 62 then setcolor (20, 255, 235) endif
if clr = 63 then setcolor (30, 255, 215) endif
if clr = 64 then setcolor (40, 255, 195) endif
if clr = 65 then setcolor (50, 235, 255) endif
if clr = 66 then setcolor (50, 215, 255) endif
if clr = 67 then setcolor (50, 195, 255) endif
if clr = 68 then setcolor (50, 95, 255) endif
if clr = 69 then setcolor (50, 155, 155) endif
if clr = 70 then setcolor (100, 255, 255) endif
if clr = 71 then setcolor (0, 255, 200) endif
if clr = 72 then setcolor (0, 255, 180) endif
if clr = 73 then setcolor (0, 255, 160) endif
if clr = 74 then setcolor (0, 255, 140) endif
if clr = 75 then setcolor (0, 255, 120) endif
if clr = 76 then setcolor (0, 255, 50) endif
if clr = 77 then setcolor (0, 215, 40) endif
if clr = 78 then setcolor (50, 255, 30) endif
if clr = 79 then setcolor (90, 255, 20) endif
if clr = 80 then setcolor (110, 255, 10) endif
if clr = 81 then setcolor (255, 255, 10) endif
if clr = 82 then setcolor (255, 255, 20) endif
if clr = 83 then setcolor (255, 255, 30) endif
if clr = 84 then setcolor (255, 255, 40) endif
if clr = 85 then setcolor (255, 255, 50) endif
if clr = 86 then setcolor (255, 255, 60) endif
if clr = 87 then setcolor (255, 255, 70) endif
if clr = 88 then setcolor (255, 255, 80) endif
if clr = 89 then setcolor (255, 255, 90) endif
if clr = 90 then setcolor (255, 255, 100) endif
if clr = 91 then setcolor (255, 10, 255) endif
if clr = 92 then setcolor (255, 20, 255) endif
if clr = 93 then setcolor (255, 30, 255) endif
if clr = 94 then setcolor (255, 40, 255) endif
if clr = 95 then setcolor (255, 50, 255) endif
if clr = 96 then setcolor (255, 60, 255) endif
if clr = 97 then setcolor (255, 70, 255) endif
if clr = 98 then setcolor (255, 80, 255) endif
if clr = 99 then setcolor (255, 90, 255) endif
endfunction
-
TRIANGULAR PENTAGON
' This program written by Rick3137
' http://rb23.yolasite.com/
' 1 Radian = 57.2958 Degrees.
' 1 degree = .0174532925 Radians
Var pendown as number
Var cnt as number
Var cnt2 as number
Var PenX as number
Var PenY as number
Var Angle as number
Var Angle2 as number
Var d as number
Var dx as number
Var dy as number
Var x1 as number
Var y1 as number
Var x2 as number
Var y2 as number
Var red as number
Var green as number
Var blue as number
Var d as number
Var AngleR as number
Var Color as number
Function OnLoad()
d = 650
AngleR = 120
pendown = 1
Color = 100
setColor ( 125 , 122 , 250 )
setBackgroundColor( 0, 0, 50)
endfunction
Function OnUpdate( dt as number )
endfunction
Function OnDraw()
Color = 1
PenX = 280
PenY = 510
Angle = 0
Fractal( d )
endfunction
Function ChangeColor( n as number )
Color = Color + n
if Color > 99 then Color = 1 endif
SetColor2( Color )
endfunction
Function RotateRight( n as number )
if Angle > n then
Angle = Angle - n
else
n = n - Angle
Angle = 360 - Angle
endif
if Angle = 360 then Angle = 0 endif
EndFunction
Function RotateLeft( n as number )
Angle = Angle + n
if Angle > 360 then
Angle = Angle - 360
endif
EndFunction
Function DegreeToRadian( n as number )
Angle2 = n * .0174532925
EndFunction
Function MoveSteps ( n as number )
DegreeToRadian ( Angle )
dx = cos (Angle2)
dy = sin (Angle2)
dx = dx * n
dy = dy * n
x2 = PenX + dx
y2 = PenY - dy
if pendown = 1 then line ( PenX , PenY , x2 , y2 ) endif
PenX = PenX + dx
PenY = PenY - dy
EndFunction
Function Fractal ( Distance as number )
Var cnt1 as number
cnt1 = 0
while (cnt1 < 5)
MoveSteps ( Distance /4 )
Fractal2 ( Distance /2 )
MoveSteps ( Distance /4 )
RotateLeft( 72 )
cnt1 = cnt1 + 1
EndWhile
EndFunction
Function Fractal2 ( Distance as number )
Var cnt2 as number
cnt2 = 0
while (cnt2 < 5)
RotateLeft( 72 )
MoveSteps ( Distance/2 )
Fractal3 ( Distance / 2 )
cnt2 = cnt2 + 1
EndWhile
EndFunction
Function Fractal3 ( Distance as number )
Var cnt as number
cnt = 0
ChangeColor(5)
while (cnt < 3)
RotateLeft( AngleR )
MoveSteps ( Distance * .8 )
Fractal4 ( Distance / 2 )
cnt = cnt + 1
EndWhile
EndFunction
Function Fractal4 ( Distance as number )
Var cnt as number
cnt = 0
while (cnt < 3)
RotateLeft( AngleR )
MoveSteps ( Distance )
Fractal5 ( Distance / 2 )
cnt = cnt + 1
EndWhile
EndFunction
Function Fractal5 ( Distance as number )
Var cnt as number
cnt = 0
while (cnt < 3)
RotateLeft( AngleR )
MoveSteps ( Distance )
Fractal6 ( Distance / 2 )
cnt = cnt + 1
EndWhile
EndFunction
Function Fractal6 ( Distance as number )
Var cnt as number
cnt = 0
while (cnt < 3)
RotateLeft( AngleR )
MoveSteps ( Distance )
Fractal7 ( Distance / 2 )
cnt = cnt + 1
EndWhile
EndFunction
Function Fractal7 ( Distance as number )
Var cnt as number
cnt = 0
while (cnt < 3)
RotateLeft( AngleR )
MoveSteps ( Distance )
cnt = cnt + 1
EndWhile
EndFunction
Function SetColor2( clr as number )
if clr > 99 then clr = 1 endif
if clr = 0 then clr = 1 endif
if clr < 0 then clr = 1 endif
if clr = 1 then setcolor (10, 10, 255) endif
if clr = 2 then setcolor (60, 60, 255) endif
if clr = 3 then setcolor (30, 60, 250) endif
if clr = 4 then setcolor (40, 80, 240) endif
if clr = 5 then setcolor (50, 100, 230) endif
if clr = 6 then setcolor (60, 120, 230) endif
if clr = 7 then setcolor (70, 140, 220) endif
if clr = 8 then setcolor (80, 160, 220) endif
if clr = 9 then setcolor (90, 180, 200) endif
if clr = 10 then setcolor (150, 255, 255) endif
if clr = 11 then setcolor (120, 230, 255) endif
if clr = 12 then setcolor (120, 210, 255) endif
if clr = 13 then setcolor (120, 180, 255) endif
if clr = 14 then setcolor (120, 160, 255) endif
if clr = 15 then setcolor (20, 140, 255) endif
if clr = 16 then setcolor (20, 255, 230) endif
if clr = 17 then setcolor (20, 255, 190) endif
if clr = 18 then setcolor (20, 255, 170) endif
if clr = 19 then setcolor (20, 255, 140) endif
if clr = 20 then setcolor (20, 255, 120) endif
if clr = 21 then setcolor (0, 255, 100) endif
if clr = 22 then setcolor (0, 255, 90) endif
if clr = 23 then setcolor (0, 235, 80) endif
if clr = 24 then setcolor (0, 205, 70) endif
if clr = 25 then setcolor (0, 90, 60) endif
if clr = 26 then setcolor (0, 255, 50) endif
if clr = 27 then setcolor (0, 245, 40) endif
if clr = 28 then setcolor (0, 225, 30) endif
if clr = 29 then setcolor (0, 215, 20) endif
if clr = 30 then setcolor (0, 205, 10) endif
if clr = 31 then setcolor (235, 255, 10) endif
if clr = 32 then setcolor (215, 255, 20) endif
if clr = 33 then setcolor (255, 255, 30) endif
if clr = 34 then setcolor (255, 235, 40) endif
if clr = 35 then setcolor (255, 215, 50) endif
if clr = 36 then setcolor (255, 195, 60) endif
if clr = 37 then setcolor (255, 85, 50) endif
if clr = 38 then setcolor (255, 75, 40) endif
if clr = 39 then setcolor (155, 155, 10) endif
if clr = 40 then setcolor (155, 255, 10) endif
if clr = 41 then setcolor (255, 10, 255) endif
if clr = 42 then setcolor (255, 40, 255) endif
if clr = 43 then setcolor (255, 60, 255) endif
if clr = 44 then setcolor (255, 180, 255) endif
if clr = 45 then setcolor (255, 10, 255) endif
if clr = 46 then setcolor (235, 10, 255) endif
if clr = 47 then setcolor (215, 10, 255) endif
if clr = 48 then setcolor (195, 80, 255) endif
if clr = 49 then setcolor (255, 90, 195) endif
if clr = 50 then setcolor (255, 90, 165) endif
if clr = 51 then setcolor (10, 20, 255) endif
if clr = 52 then setcolor (40, 40, 255) endif
if clr = 53 then setcolor (80, 80, 255) endif
if clr = 54 then setcolor (40, 80, 255) endif
if clr = 55 then setcolor (50, 100, 255) endif
if clr = 56 then setcolor (60, 120, 255) endif
if clr = 57 then setcolor (70, 140, 255) endif
if clr = 58 then setcolor (80, 160, 255) endif
if clr = 59 then setcolor (90, 180, 255) endif
if clr = 60 then setcolor (150, 200, 255) endif
if clr = 61 then setcolor (10, 255, 255) endif
if clr = 62 then setcolor (20, 255, 235) endif
if clr = 63 then setcolor (30, 255, 215) endif
if clr = 64 then setcolor (40, 255, 195) endif
if clr = 65 then setcolor (50, 235, 255) endif
if clr = 66 then setcolor (50, 215, 255) endif
if clr = 67 then setcolor (50, 195, 255) endif
if clr = 68 then setcolor (50, 95, 255) endif
if clr = 69 then setcolor (50, 155, 155) endif
if clr = 70 then setcolor (100, 255, 255) endif
if clr = 71 then setcolor (0, 255, 200) endif
if clr = 72 then setcolor (0, 255, 180) endif
if clr = 73 then setcolor (0, 255, 160) endif
if clr = 74 then setcolor (0, 255, 140) endif
if clr = 75 then setcolor (0, 255, 120) endif
if clr = 76 then setcolor (0, 255, 50) endif
if clr = 77 then setcolor (0, 215, 40) endif
if clr = 78 then setcolor (50, 255, 30) endif
if clr = 79 then setcolor (90, 255, 20) endif
if clr = 80 then setcolor (110, 255, 10) endif
if clr = 81 then setcolor (255, 255, 10) endif
if clr = 82 then setcolor (255, 255, 20) endif
if clr = 83 then setcolor (255, 255, 30) endif
if clr = 84 then setcolor (255, 255, 40) endif
if clr = 85 then setcolor (255, 255, 50) endif
if clr = 86 then setcolor (255, 255, 60) endif
if clr = 87 then setcolor (255, 255, 70) endif
if clr = 88 then setcolor (255, 255, 80) endif
if clr = 89 then setcolor (255, 255, 90) endif
if clr = 90 then setcolor (255, 255, 100) endif
if clr = 91 then setcolor (255, 10, 255) endif
if clr = 92 then setcolor (255, 20, 255) endif
if clr = 93 then setcolor (255, 30, 255) endif
if clr = 94 then setcolor (255, 40, 255) endif
if clr = 95 then setcolor (255, 50, 255) endif
if clr = 96 then setcolor (255, 60, 255) endif
if clr = 97 then setcolor (255, 70, 255) endif
if clr = 98 then setcolor (255, 80, 255) endif
if clr = 99 then setcolor (255, 90, 255) endif
endfunction
-
@Rick3137
Very nice examples.
Thanks for sharing them with us.