'Circuit diagram by Naoki Tsutae
t=0
For y=0 To 319
For x=0 To 319
cc=Abs(t+((x-t)Xor(x+t))^3) Mod 997
If cc<97 Then
cc=0
Else
cc=&Hffffff
EndIf
Pixel x,y,cc
Next x
t=t+1
Next y
4 Likes
'scrambler fractal,Processing
'press +/- for size
'spacebar for generation
'arrows to move
'Esc quits
FRAMEBUFFER create
Dim integer gen=0,rad=80,thick=2,xb=160,yb=160
drw()
Do
k$=Inkey$
If k$="+" Then
rad=rad+1
drw()
EndIf
If k$="-" Then
rad=rad-1
drw()
EndIf
If k$=" " Then
gen=gen+1
drw()
EndIf
If k$=Chr$(128) Then'UP
yb=yb-10
drw()
EndIf
If k$=Chr$(129) Then'DOWN
yb=yb+10
drw()
EndIf
If k$=Chr$(130) Then'LEFT
xb=xb-10
drw()
EndIf
If k$=Chr$(131) Then'RIGHT
xb=xb+10
drw()
EndIf
Loop Until k$=Chr$(27)
FRAMEBUFFER write n
'Save image "sf.bmp"
Sub drw()
FRAMEBUFFER write f
CLS
f=0
gr=100*(gen+1)
For f=0 To 2*Pi Step Pi/gr
x=xb
y=yb
last=1
For i=0 To gen
fa=2^i
x=x+Cos(fa*f)*rad/fa
y=y+last*Sin(fa*f)*rad/fa
last=-last
Next i
Box x,y,thick,thick
Next f
FRAMEBUFFER write n
FRAMEBUFFER wait
FRAMEBUFFER copy f,n
End Sub
1 Like
'Sierpinski arrowhead
CLS
Dim px,py,x,y
x=159
y=0
px=x
py=y
Dim heading!=-Pi/6
ah(6,300,Pi/3)
End
Sub ah(n,l,turn!)
If n=0 Then
x=x+l*Sin(heading!)
y=y+l*Cos(heading!)
Line px,py,x,y
px=x
py=y
Else
ah(n-1,l/2,-turn!)
heading!=heading!-turn!
ah(n-1,l/2,turn!)
heading!=heading!-turn!
ah(n-1,l/2,-turn!)
EndIf
End Sub
3 Likes
'gem, ZX Spectrum/BetaSoft,1985
CLS
Dim integer d=15
gem(159,159,40)
'Save image"gem.bmp"
Sub gem(x,y,s)
Line x,y-s,x-s,y
Line x-s,y,x,y+s
Line x,y+s,x+s,y
Line x+s,y,x,y-s
If s>4 Then
gem(x,y+s,s-d)
gem(x,y-s,s-d)
gem(x-s,y,s-d)
gem(x+s,y,s-d)
EndIf
End Sub
2 Likes
'Fibonacci squares and spiral
CLS
Dim f(14)
f(0)=1
f(1)=1
For n=2 To 14
f(n)=f(n-1)+f(n-2)
Next n
ccw=0'clockwise
sc=8'scale
For n=0 To 9
If ccw Then
s=1
Else
s=-1
EndIf
cx=159
cy=159
an=0
For i=0 To n
r=f(i)*sc
a0=an
a1=an+s*Pi/2
ux=Cos(a0)
uy=Sin(a0)
vx=Cos(a1)
vy=Sin(a1)
'rectangle
Line cx,cy,cx+r*ux,cy+r*uy
Line cx+r*ux,cy+r*uy,cx+r*(ux+vx),cy+r*(uy+vy)
Line cx+r*(ux+vx),cy+r*(uy+vy),cx+r*vx,cy+r*vy
Line cx,cy,cx+r*vx,cy+r*vy
'arc
If ccw Then
ab=a0
ae=a1
Else
ab=a1
ae=a0
EndIf
For tf=ab To ae Step 0.001
px=cx+r*Cos(tf)
py=cy+r*Sin(tf)
If (px>=0) And (px<320) And (py>=0) And (py<320) Then
Pixel px,py
EndIf
Next tf
nr=f(i+1)*sc
cx=cx+(r-nr)*Cos(a1)
cy=cy+(r-nr)*Sin(a1)
an=a1
Next i
Next n
4 Likes
'flowsnake aka Peano Gosper curve
CLS
Dim start_x=140
Dim start_y=0
Dim start_angle=0
Dim angle=60
Dim start_length=270
Dim float x,y,an
Dim iter=3
x=start_x
y=start_y
an=start_angle-(iter*Atn(Sqr(3)/5)*Pi/180)
curve(iter,"a",start_length)
Sub curve(ci,t$,ln)
Local l
If ci>0 Then
l=ln/Sqr(7)
If t$="a" Then
curve(ci-1,"a",l)
an=an+angle
curve(ci-1,"b",l)
an=an+angle*2
curve(ci-1,"b",l)
an=an-angle
curve(ci-1,"a",l)
an=an-2*angle
curve(ci-1,"a",l)
curve(ci-1,"a",l)
an=an-angle
curve(ci-1,"b",l)
an=an+angle
Else
an=an-angle
curve(ci-1,"a",l)
an=an+angle
curve(ci-1,"b",l)
curve(ci-1,"b",l)
an=an+2*angle
curve(ci-1,"b",l)
an=an+angle
curve(ci-1,"a",l)
an=an-2*angle
curve(ci-1,"a",l)
an=an-angle
curve(ci-1,"b",l)
EndIf
Else
x1=x+ln*Cos(an*Pi/180)
y1=y+ln*Sin(an*Pi/180)
Line x,y,x1,y1
x=x1
y=y1
EndIf
End Sub
3 Likes
Ooooh trippy!
20char
'Tektronix 4051
CLS
c=Pi/180
s=4
For a=0 To 3600 Step 7
x=160+s*25*Cos(a*c)
y=160+s*25*Sin(a*c)
ll=10*s
la=1.7*a
Line x,y,x+ll*Cos(la*c),y+ll*Sin(la*c)
Next a
3 Likes
A quick and dirty dashboard. CPU temperature, battery level, usage on drives A: and B:.
To use, make room for the GUI controls with OPTION GUI CONTROLS 4 (or more).
dr$ = MM.Info(drive)
CLS
Font 3
GUI gauge #1, 80, 80, 60, RGB(yellow), 0, 0, 80, 1, "`C", RGB(blue), 20, RGB(green), 50, RGB(yellow), 60, RGB(red)
GUI gauge #2, 240, 80, 60, RGB(yellow), 0, 0, 100, 0, "bat%", RGB(red), 20, RGB(yellow), 60, RGB(green)
GUI gauge #3, 80, 240, 60, RGB(yellow), 0, 0, 100, 2, "A:%", RGB(green), 90, RGB(yellow), 95, RGB(red)
GUI gauge #4, 240, 240, 60, RGB(yellow), 0, 0, 100, 2, "B:%", RGB(green), 90, RGB(yellow), 95, RGB(red)
Do
CtrlVal(#1) = Pin(temp)
CtrlVal(#2) = MM.Info(battery)
If MM.Info(charging) Then
Circle 240, 115, 5, , ,RGB(yellow),RGB(yellow)
Else
Circle 240, 115, 5, , ,0,0
EndIf
Drive "A:"
CtrlVal(#3) = 100 * (MM.Info(disk size) - MM.Info(free space)) / MM.Info(disk size)
Drive "B:"
CtrlVal(#4) = 100 * (MM.Info(disk size) - MM.Info(free space)) / MM.Info(disk size)
Text 160, 160, DateTime$(now), "CM"
Pause 500
Loop Until Inkey$ <> ""
Drive (dr$)
CLS
(The image doesn’t match the code in regards to the date display. I am an American gentleman and I get the creeps when the day comes first in the date. To get the matching display, replace “DateTime$(now)” with “fixdate$(0)” and use the following function: (I keep this in my library.)
Function fixdate$(time As float)
Local string dt$ = DateTime$(time)
If time = 0 Then dt$=DateTime$(now)
fixdate$ = Mid$(dt$,7,4)+"/"+Mid$(dt$,4,2)+"/"+LEFT$(dt$,2)
Cat fixdate$, " "+Time$
End Function
4 Likes
'Hex Tile, BBC MicroBot
'line must be fixed
CLS
v_=56/2'size
Dim x(12)
Dim y(12)
Dim u(12)
Dim v(12)
s=Pi/3
w=v_*Sqr(3)
d=v_*3/2
'Randomize &h1235678
n=0
x(0)=0
y(0)=v_
For l=1 To 11
x(l)=Sin(l*s)*v_
y(l)=Cos(l*s)*v_
u(l)=(x(l)+x(l-1))/2
v(l)=(y(l)+y(l-1))/2
Next l
o=0
For y_=0 To d+320 Step d
o=1-o
For x_=o*w/2 To 320+w/2 Step w
xo=x_
yo=y_
xp=x(5)
yp=y(5)
Color RGB(255,0,0)
For l=6 To 8
Line xo+xp,yo+yp,x(l)+xo,y(l)+yo
xp=x(l)
yp=y(l)
Next l
m=1+Int(Rnd()*6)
Color RGB(255,255,0))
Arc_(xo+x(m),yo+y(m),xo+u(m),yo+v(m),xo+x(m+1),yo+y(m+1))
For l=m-1 To m
Arc_(xo+u(4+l)*2,yo+v(4+l)*2,xo+u(3+l),yo+v(3+l),xo+x(4+l),yo+y(4+l))
Next l
Next x_
Next y_
Sub arc_(xc,yc,x1,y1,x2,y2)
a1=Atan2(y1-yc,x1-xc)
a2=Atan2(y2-yc,x2-xc)
If a2<a1 Then
a2=a2+2*Pi
EndIf
da=(a2-a1)/50'steps
r=Sqr((x1-xc)^2+(y1-yc)^2)
For a=a1 To a2 Step da
px=xc+r*Cos(a)
py=yc+r*Sin(a)
If (px>=0) And (px<320) And (py>=0) And (py<320) Then
Pixel px,py
EndIf
Next a
End Sub
'
2 Likes