Thank you very much for the detailed explanation. I will take a closer look at it during my vacation. For more than 15 years, I have only been working with Windows when there is no other option (with customers and stubborn family members). Otherwise, I use Linux almost exclusively.
I have written ‘Bricks’, a Breakout clone, for zeptoforth on the PicoCalc with the RP2350 (which it requires because it uses hardware single-precision floating point). The controls are simply left and right-arrow to move the player, and q to exit. The game continues ad infinitum until q is pressed ─ if the ball hits the bottom of the screen it and the player are simply reset as if it were a new game (but the bricks stay as-is). At the start of the game and each time the ball and player are reset the user needs to press a key to continue. Note that as it uses key? and key to detect keypresses it relies upon key repeat to function, which can be a bit wonky.
Here is a screenshot of the game right after the ball and player have been reset:
The source code of the game is at zeptoforth/test/rp2350/picocalc_bricks.fs at master · tabemann/zeptoforth · GitHub.
The full source is as follows:
\ Copyright (c) 2026 Travis Bemann
\
\ Permission is hereby granted, free of charge, to any person obtaining a copy
\ of this software and associated documentation files (the "Software"), to deal
\ in the Software without restriction, including without limitation the rights
\ to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
\ copies of the Software, and to permit persons to whom the Software is
\ furnished to do so, subject to the following conditions:
\
\ The above copyright notice and this permission notice shall be included in
\ all copies or substantial portions of the Software.
\
\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
\ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
\ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
\ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
\ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
\ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
\ SOFTWARE.
begin-module bricks
float32 import
picocalc-term import
tinymt32 import
pixmap8 import
pixmap8-utils import
st7365p-8-common import
begin-structure coord-size
field: coord-x
field: coord-y
end-structure
begin-structure delta-size
field: delta-x
field: delta-y
end-structure
begin-structure ball-size
coord-size +field ball-coord
delta-size +field ball-delta
field: ball-radius
field: ball-color
end-structure
begin-structure block-size
coord-size +field block-coord
field: block-width
field: block-height
field: block-color
field: block-active
end-structure
begin-structure player-size
coord-size +field player-coord
delta-size +field player-delta
field: player-width
field: player-height
field: player-color
end-structure
160e0 constant blocks-center-x
80e0 constant blocks-center-y
20e0 constant default-block-width
7.5e0 constant default-block-height
2e0 constant default-ball-radius
160e0 constant init-ball-x
160e0 constant init-ball-y
120e0 constant init-ball-speed
vpi 2e0 v/ constant init-ball-angle-range
60e0 constant default-player-width
7.5e0 constant default-player-height
160e0 constant init-player-x
300e0 constant init-player-y
16 constant horiz-block-count
8 constant vert-block-count
horiz-block-count vert-block-count * constant block-count
begin-structure world-size
ball-size +field world-ball
block-size block-count * +field world-blocks
player-size +field world-player
tinymt32-size +field world-prng
field: world-last-tick
field: world-tick
end-structure
: rnd ( world -- v )
world-prng tinymt32-generate-uint32 0 f64>v
;
: interval ( world -- v )
dup world-tick @ swap world-last-tick @ - u>v 10000e0 v/
;
: convert-angle ( n -- n' ) 255 * 60 / ;
: angle-color { angle -- rgb8 }
angle 60 < if
255 angle convert-angle 0
else
angle 120 < if
120 angle - convert-angle 255 0
else
angle 180 < if
0 255 angle 120 - convert-angle
else
angle 240 < if
0 240 angle - convert-angle 255
else
angle 300 < if
angle 240 - convert-angle 0 255
else
255 0 360 angle - convert-angle
then
then
then
then
then
rgb8
;
: rnd-color ( world -- rgb8 )
rnd 360e0 v* v>n angle-color
;
: init-block { x y world block -- }
horiz-block-count 1- n>v default-block-width v* 2e0 v/
blocks-center-x swap v-
default-block-width x n>v v* v+
block block-coord coord-x !
vert-block-count 1- n>v default-block-height v* 2e0 v/
blocks-center-y swap v-
default-block-height y n>v v* v+
block block-coord coord-y !
default-block-width block block-width !
default-block-height block block-height !
world rnd-color block block-color !
true block block-active !
;
: init-blocks { world -- }
vert-block-count 0 ?do
horiz-block-count 0 ?do
i j world j horiz-block-count * i + block-size *
world world-blocks + init-block
loop
loop
;
: init-ball { world ball -- }
init-ball-x ball ball-coord coord-x !
init-ball-y ball ball-coord coord-y !
default-ball-radius ball ball-radius !
vpi 2e0 v/ init-ball-angle-range 2e0 v/ v-
init-ball-angle-range world rnd v* v+ { angle }
angle vcos init-ball-speed v* ball ball-delta delta-x !
angle vsin init-ball-speed v* ball ball-delta delta-y !
world rnd-color ball ball-color !
;
: init-player { world player -- }
init-player-x player player-coord coord-x !
init-player-y player player-coord coord-y !
0e0 player player-delta delta-x !
0e0 player player-delta delta-y !
default-player-width player player-width !
default-player-height player player-height !
world rnd-color player player-color !
;
: init-prng { prng -- }
rng::random prng tinymt32-init
prng tinymt32-prepare-example
;
: init-world { world -- }
systick::systick-counter dup world world-tick !
world world-last-tick !
world world-prng init-prng
world init-blocks
world dup world-ball init-ball
world dup world-player init-player
;
0 0 0 rgb8 constant erase-color
: draw-rect { erase? color x y width height display -- }
width 2e0 v/ { width2/ }
height 2e0 v/ { height2/ }
x width2/ v- vround-zero v>n { x0 }
y height2/ v- vround-zero v>n { y0 }
erase? if erase-color else color then
x0 y0
width 0.5e0 v+ vround-zero v>n
height 0.5e0 v+ vround-zero v>n
display draw-rect-const
;
: draw-block { erase? display block -- }
erase? block block-color @
block block-coord coord-x @
block block-coord coord-y @
block block-width @
block block-height @
display draw-rect
;
: draw-player { erase? display player -- }
erase? player player-color @
player player-coord coord-x @
player player-coord coord-y @
player player-width @
player player-height @
display draw-rect
;
: draw-circle { erase? color x y radius display -- }
erase? if erase-color else color then
x v>n y v>n radius v>n display draw-filled-circle
;
: draw-ball { erase? display ball -- }
erase? ball ball-color @
ball ball-coord coord-x @
ball ball-coord coord-y @
ball ball-radius @
display draw-circle
;
: draw-world { display world -- }
display clear-pixmap
horiz-block-count vert-block-count * 0 ?do
false display i block-size * world world-blocks +
draw-block
loop
false display world world-player draw-player
false display world world-ball draw-ball
;
: collide-rect { time x y width height ball -- collide? }
ball ball-coord coord-x @ { bx }
ball ball-coord coord-y @ { by }
ball ball-delta delta-x @ { bdx }
ball ball-delta delta-y @ { bdy }
ball ball-radius @ { radius }
bx bdx time v* v+ { bx' }
by bdy time v* v+ { by' }
width 2e0 v/ { width2/ }
height 2e0 v/ { height2/ }
x width2/ v- radius v- { x0 }
y height2/ v- radius v- { y0 }
x width2/ v+ radius v+ { x1 }
y height2/ v+ radius v+ { y1 }
bx x0 v< bx' x0 v>= and
bx x1 v> bx' x1 v<= and or
bx' x0 v>= bx' x1 v<= and or
by y0 v< by' y0 v>= and
by y1 v> by' y1 v<= and or
by' y0 v>= by' y1 v<= and or and dup if
bx x0 v<= bx' x0 v>= and if
bdx vabs vnegate ball ball-delta delta-x !
x0 ball ball-coord coord-x !
then
bx x1 v>= bx' x1 v<= and if
bdx vabs ball ball-delta delta-x !
x1 ball ball-coord coord-x !
then
by y0 v<= by' y0 v>= and if
bdy vabs vnegate ball ball-delta delta-y !
y0 ball ball-coord coord-y !
then
by y1 v>= by' y1 v<= and if
bdy vabs ball ball-delta delta-y !
y1 ball ball-coord coord-y !
then
then
;
: collide-block { time display ball block -- }
block block-active @ if
time
block block-coord coord-x @
block block-coord coord-y @
block block-width @
block block-height @
ball collide-rect if
false block block-active !
true display block draw-block
then
then
;
: collide-blocks { time display ball world -- }
horiz-block-count vert-block-count * 0 ?do
time display ball
i block-size * world world-blocks + collide-block
loop
;
0.5e0 constant collide-player-fract
: collide-player { time ball player -- }
time
player player-coord coord-x @
player player-coord coord-y @
player player-width @
player player-height @
ball collide-rect if
player player-delta delta-x @ collide-player-fract v*
ball ball-delta delta-x @ v+
ball ball-delta delta-x !
then
;
: collide-wall { time ball -- bottom? }
ball ball-coord coord-x @ { bx }
ball ball-coord coord-y @ { by }
ball ball-delta delta-x @ { bdx }
ball ball-delta delta-y @ { bdy }
ball ball-radius @ { radius }
bx bdx time v* v+ { bx' }
by bdy time v* v+ { by' }
term-pixels-dim@ n>v swap n>v { height width }
bx' width radius v- v>= if
bdx vabs vnegate ball ball-delta delta-x !
then
bx' radius v<= if
bdx vabs ball ball-delta delta-x !
then
by' radius v<= if
bdy vabs ball ball-delta delta-y !
then
by' height v>=
;
: +delta! { time delta coord -- }
delta delta-x @ time v* coord coord-x @ v+ coord coord-x !
delta delta-y @ time v* coord coord-y @ v+ coord coord-y !
;
: move-ball { time ball -- }
time ball ball-delta ball ball-coord +delta!
;
0.0625e0 constant friction0
1e0 64e0 v/ constant friction1
: apply-friction { time player -- }
friction0 time v** friction1 time v** v* { friction' }
player player-delta delta-x @ friction' v*
player player-delta delta-x !
;
: move-player { time player -- }
time player player-delta player player-coord +delta!
player player-width @ 2e0 v/ { width2/ }
player player-coord coord-x @ { x }
term-pixels-dim@ drop n>v { width' }
x width2/ v<= dup if
width2/ player player-coord coord-x !
then
x width' width2/ v- v>= dup if
width' width2/ v- player player-coord coord-x !
then
or if
0e0 player player-delta delta-x !
then
;
: update { display world -- died? }
world interval { time }
true display world world-ball draw-ball
true display world world-player draw-player
time display world world-ball world collide-blocks
time world world-ball world world-player collide-player
time world world-ball collide-wall dup if
world dup world-ball init-ball
world dup world-player init-player
else
time world world-ball move-ball
time world world-player apply-friction
time world world-player move-player
then
false display world world-ball draw-ball
false display world world-player draw-player
;
240e0 constant accel
640e0 constant max-speed
: accel-left { time player -- }
player player-delta delta-x @ accel ( time v* ) v-
max-speed vnegate vmax
player player-delta delta-x !
;
: accel-right { time player -- }
player player-delta delta-x @ accel ( time v* ) v+
max-speed vmin
player player-delta delta-x !
;
: reset-tick { world }
systick::systick-counter dup world world-tick !
world world-last-tick !
;
: run-game ( -- )
page
world-size [: { world }
world init-world
world [: { world display }
display world draw-world
display update-display
;] with-term-display
begin key? until
key [char] q = if exit then
world reset-tick
begin
world [: { world display }
display world update
display update-display
;] with-term-display
if
begin key? until
key [char] q = if exit then
world reset-tick
else
key? if
key case
$1B of
key? if
key case
[char] [ of
key? if
key case
[char] D of
world interval
world world-player accel-left
endof
[char] C of
world interval
world world-player accel-right
endof
endcase
then
endof
endcase
then
endof
[char] q of
exit
endof
endcase
then
world world-tick @ world world-last-tick !
systick::systick-counter world world-tick !
then
again
;] with-aligned-allot
;
end-module
2 Likes
A Mandelbrot set drawing app, written in Zeptoforth. It uses both of the cores in RP3250, and runs under less than 1 sec.
begin-module mand
\ Mandelbrot set
float32 import
picocalc-term-common import
picocalc-term import
oo import
pixmap8 import
task import
timer import
st7365p-8-common import
320 Constant W
300 Constant H
32 Constant MAX_ITER
variable pix W H * allot
<pixmap8> class-size buffer: mypix8
variable colors MAX_ITER allot
variable done0
variable done1
: initcolors
256 MAX_ITER / { n }
MAX_ITER 0 do
i n * dup dup rgb8 colors i + c!
loop
;
: storepix { c x y }
c 2 * pix y W * x + + c! ;
: drawpix
[: { c x y display }
colors c + c@ x y display draw-pixel-const
;] with-term-display
;
: upd
[: { display }
display update-display
;] with-term-display
;
: upd1
[: { display }
0 0 0 0 w h
mypix8 display draw-rect
;] with-term-display
upd
;
: mandel { X_MIN X_MAX Y_MIN Y_MAX p }
{ fzx fzy fcx fcy }
{ fzx_next iter }
{ ftx fty }
us-counter-lsb { t1 }
X_MAX X_MIN v- { XDELTA }
Y_MAX Y_MIN v- { YDELTA }
YDELTA H n>v v/ { fystep }
XDELTA W n>v v/ { fxstep }
p 0= if
Y_MIN to fcy
else
Y_MIN fystep v+ to fcy
then
H p - p do
fcy fystep
dup v+
v+ to fcy
X_MIN to fcx
W 0 do
fcx fxstep v+ to fcx
0e0 dup to fzx to fzy
0 to iter
begin
fzx dup v* to ftx
fzy dup v* to fty
ftx fty v+ 4e0 v<= iter MAX_ITER < and
while
ftx fty v- fcx v+ to fzx_next
2e0 fzx v* fzy v* fcy v+ to fzy
fzx_next to fzx
iter 1+ to iter
repeat
iter i j storepix
loop
upd
2 +loop
p 0= if
1 done0 !
else
1 done1 !
then
done0 @ done1 @ and if
us-counter-lsb t1 - .
upd1
us-counter-lsb t1 - .
mypix8 destroy
then
;
: mand1 -2e0 .5e0 -1.15e0 1.15e0 0 mandel ;
: mand2 -2e0 .5e0 -1.15e0 1.15e0 1 mandel ;
\ : mand1 -0.75e0 .5e0 0e0 1.15e0 0 mandel ;
\ : mand2 -0.75e0 .5e0 0e0 1.15e0 1 mandel ;
\ : mand1 -0.375e0 .25e0 0.575e0 1.15e0 0 mandel ;
\ : mand2 -0.375e0 .25e0 0.575e0 1.15e0 1 mandel ;
: doit
0 done0 !
0 done1 !
initcolors
pix W H <pixmap8> mypix8 init-object
0 ['] mand1 1024 1024 1024 0 spawn-on-core
0 ['] mand2 1024 1024 1024 1 spawn-on-core
run
run ;
end-module
: m mand::doit ;
3 Likes
'tribar aka Penrose triangle
Dim x1%(5)=(137,184,320,98,121,247)
Dim y1%(5)=(0,0,235,235,194,194)
Dim x2%(5)=(320,295,25,137,160,98)
Dim y2%(5)=(235,276,276,85,126,235)
Dim x3%(5)=(137,247,198,137,25,0)
Dim y3%(5)=(0,194,194,85,276,235)
CLS
Polygon 6,x1%(),y1%(),&Hff0000,&hff0000)
Polygon 6,x2%(),y2%(),&H00ff00,&h00ff00)
Polygon 6,x3%(),y3%(),&H0000ff,&h0000ff)
2 Likes
'celtic knot from just basic
CLS
Option angle radians
th%=14
xc%=160
yc%=160
d%=th%*5
r%=th%*4
r1%=th%*3
hex!=Pi/3
hd2!=hex!/2
Color &Hffffff
For nh%=1 To 6
x0%=xc%+d%*Cos(nh%*hex!-hd2!)
y0%=yc%+d%*Sin(nh%*hex!-hd2!)
s!=nh%*hex!
'outer radius
arc_ x0%,y0%,r%,s!-0.37,s!+1.2
arc_ x0%,y0%,r%,s!+1.47,s!+2.77
'inner eye
arc_ x0%,y0%,r%,s!+3.05,s!+4.3
arc_ x0%,y0%,r%,s!+4.55,s!+5.6
'inner radius
arc_ x0%,y0%,r1%,s!-0.1,s!+1.15
arc_ x0%,y0%,r1%,s!+1.51,s!+2.73
'inner eye
arc_ x0%,y0%,r1%,s!+3.1,s!+4.25
arc_ x0%,y0%,r1%,s!+4.58,s!+5.32
'outside origins
x0%=xc%+(2*d%-1.5*th%)*Cos(s!)
y0%=yc%+(2*d%-1.5*th%)*Sin(s!)
'outer radius
arc_ x0%,y0%,r%,s!+1.68,s!+3.25
arc_ x0%,y0%,r%,s!+3.51,s!+4.6
'inner radius
arc_ x0%,y0%,r1%,s!+1.98,s!+3.2
arc_ x0%,y0%,r1%,s!+3.56,s!+4.3
Next nh%
Sub arc_ x%,y%,r%,start!,stop!
If stop!<0 Then stop!=stop!+2*Pi
If start!<0 Then start!=start!+2*Pi
If stop!<start! Then
t!=stop!
stop!=start!
start!=t!
End If
ast!=10*Pi/(r%*r%*(stop!-start!))
a!=start!
Do While a!<stop!
Pixel x%+r%*Cos(a!),y%+r%*Sin(a!)
a!=a!+ast!
Loop
End Sub
3 Likes
I wrote a single graphing program for zeptoforth on the RP2350 using hardware floating point. It can graph any number of words (within reason and stack space) that take a single floating-point argument for an x value and return a single floating-point value for a y value or raises float32::x-domain-error for arguments on which they are not defined.
Graphing is carried out by calling graph::draw-graph with the signature ( fn … f0 count x-min x-max y-min y-max – ) where fn through f0 are count execution tokens to words to graph, each with its own signature ( x – y ), count is the number of words to graph, x-min is a floating-point value for the minimum x value to graph (inclusive), x-max is a floating-point value for the maximum x value to graph (exclusive), y-min is a floating-point value for the minimum y value to graph (exclusive), and y-max is a floating-point value for the maximum y value to graph (inclusive).
Be careful, though, as there are some words such as float32::vln which ought to not be defined for given arguments but which hang rather than raising float32::x-domain-error.
The source code can be found at zeptoforth/test/rp2350/picocalc_graph.fs at master · tabemann/zeptoforth · GitHub.
Be aware, there is currently a bug in float32::vfloor that is in release 1.16.1 and all previous releases that I am now, as I write this, preparing a new release 1.16.1.1 to fix.
A screenshot of the graphing demo graphing a sine and a cosine function over the x domain [-2,2) and the y range (-2,2]:
' vcos ' vsin 2 vpi -2e0 v* vpi 2e0 v* -2e0 2e0 graph::draw-graph
can be seen below:
The source code is repeated in full below:
\ Copyright (c) 2026 Travis Bemann
\
\ Permission is hereby granted, free of charge, to any person obtaining a copy
\ of this software and associated documentation files (the "Software"), to deal
\ in the Software without restriction, including without limitation the rights
\ to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
\ copies of the Software, and to permit persons to whom the Software is
\ furnished to do so, subject to the following conditions:
\
\ The above copyright notice and this permission notice shall be included in
\ all copies or substantial portions of the Software.
\
\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
\ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
\ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
\ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
\ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
\ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
\ SOFTWARE.
begin-module graph
picocalc-term import
pixmap8 import
st7365p-8-common import
float32 import
begin-module graph-internal
begin-structure space-size
field: x-min
field: x-max
field: y-min
field: y-max
end-structure
: x-incr { space -- v }
space x-max @ space x-min @ v-
term-pixels-dim@ drop n>v v/
;
: convert-y { y space -- y' }
y space y-min @ v-
space y-max @ space y-min @ v- v/
term-pixels-dim@ nip n>v v* v>n negate
term-pixels-dim@ nip +
;
: convert-x { x space -- x' }
x space x-min @ v-
space x-max @ space x-min @ v- v/
term-pixels-dim@ drop n>v v* v>n
;
7 constant mark-size
: draw-x-marks { color space display -- }
0e0 space convert-y { y }
space x-max @ space x-min @ v- vabs v>n
term-pixels-dim@ drop 4 / <= if
space x-max @ space x-min @ vmax v>n 1+
space x-max @ space x-min @ vmin v>n 1- ?do
i n>v space convert-x { x }
color x y [ mark-size 2 / ] literal - 1 mark-size
display draw-rect-const
loop
then
;
: draw-y-marks { color space display -- }
0e0 space convert-x { x }
space y-max @ space y-min @ v- vabs v>n
term-pixels-dim@ nip 4 / <= if
space y-max @ space y-min @ vmax v>n 1+
space y-max @ space y-min @ vmin v>n 1- ?do
i n>v space convert-y { y }
color x [ mark-size 2 / ] literal - y mark-size 1
display draw-rect-const
loop
then
;
: draw-x-axis { color space display -- }
space y-min @ space y-max @ vmin v0<=
space y-min @ space y-max @ vmax v0>= and if
0e0 space convert-y { y }
color 0 y term-pixels-dim@ drop 1
display draw-rect-const
color space display draw-x-marks
then
;
: draw-y-axis { color space display -- }
space x-min @ space x-max @ vmin v0<=
space x-min @ space x-max @ vmax v0>= and if
0e0 space convert-x { x }
color x 0 1 term-pixels-dim@ nip
display draw-rect-const
color space display draw-y-marks
then
;
: draw-axes { color space display -- }
color space display draw-x-axis
color space display draw-y-axis
;
: draw-fx { f color space display -- }
space x-incr { incr }
0e0 false { last-y last-y? }
term-pixels-dim@ drop 0 ?do
i n>v incr v* space x-min @ v+ { x }
x f try dup ['] x-domain-error = if
2drop 0e0 false
else
?raise true
then
{ y y? }
y? if
y space convert-y { y' }
color i y' display draw-pixel-const
last-y? if
last-y space convert-y { last-y' }
last-y' y' < if
y' last-y' - { diff }
diff 2 / { diff2/ }
color i 1- last-y' 1 diff2/
display draw-rect-const
color i last-y' diff2/ + 1 diff diff2/ -
display draw-rect-const
else
y' last-y' < if
last-y' y' - { diff }
diff 2 / { diff2/ }
color i 1- last-y' diff2/ - 1 diff2/
display draw-rect-const
color i y' 1 diff diff2/ -
display draw-rect-const
then
then
then
then
y to last-y
y? to last-y?
loop
;
255 255 255 rgb8 constant axes-color
create colors
255 0 0 rgb8 c,
0 255 0 rgb8 c,
0 0 255 rgb8 c,
255 0 255 rgb8 c,
255 255 0 rgb8 c,
0 255 255 rgb8 c,
here colors - cell align, constant color-count
end-module> import
: draw-graph ( fn ... f0 u x-min x-max y-min y-max -- )
page
[: { display }
display clear-pixmap
display update-display
;] with-term-display
space-size [: { x-min' x-max' y-min' y-max' space }
x-min' space x-min !
x-max' space x-max !
y-min' space y-min !
y-max' space y-max !
space [: { count space display }
axes-color space display draw-axes
count 0 ?do
colors i color-count umod + c@ { color }
color space display draw-fx
loop
;] with-term-display
;] with-aligned-allot
;
end-module
1 Like
'DLA
CLS
Randomize &H123478
Option default integer
Dim s(319),c(319)
d=1
m=14
For i=0 To 319
s(i)=0
c(i)=0
Next i
Do While d<=319
x=1+Int(Rnd()*318)
f=x
If s(f)<s(x-1) Then f=x-1
If s(f)<s(x+1) Then f=x+1
If Int(Rnd()*2)=1 And s(f)=s(x+1) Then f=x+1
s(x)=s(f)
c(x)=c(f)
If c(x)=0 Then c(x)=1+(x Mod 14)
cc=c(x)
br=Choice(cc And 8,255,127)
rr=Choice(cc And 1,br,0)
gg=Choice(cc And 2,br,0)
bb=Choice(cc And 4,br,0)
Pixel x,319-s(x),RGB(rr,gg,bb)
s(x)=s(x)+1
If s(x)=d Then d=d+1
Loop
2 Likes
'polar rose
a0%=0
b0%=0
cc!=Pi/180
FRAMEBUFFER create
FRAMEBUFFER write f
Do
CLS
FRAMEBUFFER wait
a0%=a0%+5
b0%=b0%+3
For j=0 To 2
a%=a0%+j*120
For i=0 To 20
r%=100*Sin((a%+i)*3*cc!)
x%=r%*Cos((a%+i+b0%)*cc!)+160
y%=r%*Sin((a%+i+b0%)*cc!)+160
Circle x%,y%,i>>1,1,1,&Hffffff,&Hffffff)
Next i
Next j
FRAMEBUFFER copy f,n
Loop Until Inkey$=Chr$(27)
1 Like
'dancing circles, TIC-80
Option default integer
n=6
Dim ang(n)
For i=1 To n-1
ang(i)=0
Next i
w=25
FRAMEBUFFER create
FRAMEBUFFER write f
Do
CLS
x=160
y=160
Circle x,y,n*w,1,1,&Hffffff,0
For i=1 To n-1
x=x+w*Cos(ang(i)/30)
y=y+w*Sin(ang(i)/30)
Circle x,y,(n-i)*w,1,1,&Hffffff,0
ang(i)=ang(i)+i
Next i
FRAMEBUFFER wait
FRAMEBUFFER copy f,n
Loop Until Inkey$=Chr$(27)
1 Like
'sin paths
CLS
df%=0
Option angle radians
For th!=0 To 2*Pi Step 0.015
rad!=-(0.5*Sin(5*th!))*(0.5*Cos(4*th!))*600
an!=th!+Sin(rad!/60)
xp%=Int(160+rad!*Cos(an!))
yp%=Int(160+rad!*Sin(an!))
If df%=1 Then
Line x0%,y0%,xp%,yp%,1,&Hffffff
x0%=xp%
y0%=yp%
Else
df%=1
x0%=xp%
y0%=yp%
End If
Next th!
'sin paths
CLS
df%=0
Option angle radians
For th!=0 To 4*Pi Step 0.04
rad!=(1.05+Sin(th!*4.5))*80
an!=th!-Cos(th!*10)/8
xp%=Int(160+rad!*Cos(an!))
yp%=Int(160+rad!*Sin(an!))
If df%=1 Then
Line x0%,y0%,xp%,yp%,1,&Hffffff
x0%=xp%
y0%=yp%
Else
df%=1
x0%=xp%
y0%=yp%
End If
Next th!
' leaf QB program
CLS
ex%=220
sx%=50
sy%=160
x!=1
y1=0
r3!=Sqr(3)/6
Randomize Timer
Do
If Rnd()>0.5 Then
x0!=0.5*x!+r3!*y!
y0!=r3!*x!-0.5*y!
Else
x0!=0.66666666*x!+0.3333333
y0!=-0.66666666*y
End If
x!=x0!
y!=y0!
Pixel x!*ex%+sx%,sy%-y!*ex%
Loop Until Inkey$=Chr$(27)
3 Likes
'Mona 256b intro Atari XE/XL
CLS
Option default integer
Dim co(3)=(RGB(&Hff,&He2,&H89),RGB(&He9,&H9e,&H45),RGB(&Ha5,&H5a,&H00),0)
seed=&H7EC80000
XOR_MSK = &H04C11DB7
dir=0
carry=0
Restore BRUSH
For part=0 To 63
Read word
seed = (seed And &HFFFF0000) Or word
bx=word And 255
by=(word>>8) And 255
For length = 0 To (64 - part) * 32 - 1
carry = seed And &H80000000
seed = (seed << 1) And &HFFFFFFFF
If carry Then
seed = seed Xor XOR_MSK
dir = seed And 255
EndIf
If (dir And &H82) = 0 Then
by = (by + 1) And 127
GoTo putd
EndIf
If (dir And &H82) = 2 Then
bx = (bx + 1) And 127
GoTo putd
EndIf
If (dir And &H82) = &H80 Then
by = (by - 1) And 127
GoTo putd
EndIf
If (dir And &H82) = &H82 Then
bx = (bx - 1) And 127
EndIf
putd:
If (bx<128) And (by<96) Then
Box 2*bx,2*by,2,2,0,co(part And 3),co(part And 3)
EndIf
Next length
Next part
BRUSH:
Data &H030A, &H37BE, &H2F9B, &H072B, &H0E3C, &HF59B, &H8A91, &H1B0B
Data &H0EBD, &H9378, &HB83E, &HB05A, &H70B5, &H0280, &HD0B1, &H9CD2
Data &H2093, &H209C, &H3D11, &H26D6, &HDF19, &H97F5, &H90A3, &HA347
Data &H8AF7, &H0859, &H29AD, &HA32C, &H7DFC, &H0D7D, &HD57A, &H3051
Data &HD431, &H542B, &HB242, &HB114, &H8A96, &H2914, &HB0F1, &H532C
Data &H0413, &H0A09, &H3EBB, &HE916, &H1877, &HB8E2, &HAC72, &H80C7
Data &H5240, &H8D3C, &H3EAF, &HAD63, &H1E14, &HB23D, &H238F, &HC07B
Data &HAF9D, &H312E, &H96CE, &H25A7, &H9E37, &H2C44, &H2BB9, &H2139
5 Likes
WOW! This is crazy work man. Good job
'Barry Martin fractal
CLS
x!=0
y!=0
Do
t!=x!
x!=y!-Sin(x!)
y!=3.14-t!
Pixel 4*x!+160,4*y!+160,&Hff00
Loop Until Inkey$=Chr$(27)
3 Likes
'Aabesque BASICODE3 program
CLS
Dim t(80) As float
Dim ho,ve,x0,y0,mx,my,rc,tt,aa,bb As float
Const km=0.104719755
aa=0
bb=0
For n=0 To 79
t(n+1)=Sin(n*km)
Next n
For n=5 To 60 Step 5
mx=0.5+0.31*t(n+1)
my=0.5-0.31*t(n+15+1)
rc=0.18
aa=n+45
bb=n+75
x0=0
y0=0
l3020()
rc=0.119
aa=n+10
bb=n+50
l3020()
Next n
Sub l3020()
tt=aa
l3110()
Pixel x0+ho,y+ve
If bb<=aa Then
bb=bb+0
End If
For z=aa To bb
hoo=ho
vee=ve
tt=z
l3110()
Line x0+ho,y0+ve,x0+hoo,y0+vee
Next z
End Sub
Sub l3110()
31
If tt>60 Then
tt=tt-60
GoTo 31
End If
ho=Int(300*(mx+rc*t(tt+1)))
ve=Int(300*(my-rc*t(tt+15+1)))
End Sub
2 Likes
'Monkey tree fractal
CLS
Dim dx(11)
Dim dy(11)
Dim sd(6)
Dim rd(6)
Dim sn(4)
Dim ln(6)
m=7/6
Restore l270
For n=0 To 6
Read xx
sd(n)=xx
Read xx
rd(n)=xx
ln(n)=1/3
Next n
ln(2)=Sqr(ln(1))
nc=4
x=300
y=220
tl=240
For c=0 To nc
sn(c)=0
Next c
Do While sn(0)=0
x0=x
y0=y
d=0
l=tl
ns=0
For c=1 To nc
i=sn(c)
l=l*ln(i)
j=sn(c-1)
ns=ns+sd(j)
k=Int(ns/2)
If k*2<>ns Then
d=d+12-rd(i)
Else
d=d+rd(i)
EndIf
d=d Mod 12
Next c
x=x+m*l*Cos(Pi/6*(d-6))
y=y-l*Sin(Pi/6*(d-6))
Line x0,y0,x,y,,&Hffffff
sn(nc)=sn(nc)+1
For c=nc To 1 Step -1
If sn(c)=7 Then
sn(c)=0
sn(c-1)=sn(c-1)+1
EndIf
Next c
Loop
l270:
Data 0,0,1,0,1,7
Data 0,10,0,0,0,2,1,2
2 Likes
'Circle Fractal
Dim scalev1!=5
Dim scalev2!=2
Dim vp!=0.2
Dim scaleh1!=2
Dim scaleh2!=1.4
Dim hp!=0.2
Dim depth%=0
CLS
drawf(320,320,Pi-0.9,50,0)
Save image "fracc.bmp"
Sub drawf x,y,a!,s!,w
Local x1,y1,c,ns!
depth%=depth%+1
If s!<0.2 Then
GoTo l1
EndIf
If depth% And 1 Then
c=&Hffffff
Else
c=&H00ff00
EndIf
Circle x/2,y/2,s!/2,1,1,c,c
If w<>1 Then
x1=Sin(a!)*s!*2.5+x
y1=Cos(a!)*s!*2.5+y
If w=3 Then
ns!=s!/scalev2!
Else
ns!=s!/scalev1!
EndIf
drawf(x1,y1,a!+vp!,ns!,3)
EndIf
If w<>2 Then
x1=Sin(a!-Pi/2)*s!*2.5+x
y1=Cos(a!-Pi/2)*s!*2.5+y
If w=4 Then
ns!=s!/scaleh2!
Else
ns!=s!/scaleh1!
EndIf
drawf(x1,y1,a!+hp!,ns!,4)
EndIf
If w<>3 Then
x1=Sin(a!-Pi)*s!*2.5+x
y1=Cos(a!-Pi)*s!*2.5+y
If w=1 Then
ns!=s!/scalev2!
Else
ns!=s!/scalev1!
EndIf
drawf(x1,y1,a!+vp!,ns!,1)
EndIf
If w<>4 Then
x1=Sin(a!-Pi*1.5)*s!*2.5+x
y1=Cos(a!-Pi*1.5)*s!*2.5+y
If w=2 Then
ns!=s!/scaleh2!
Else
ns!=s!/scaleh1!
EndIf
drawf(x1,y1,a!+hp!,ns!,2)
EndIf
l1:
depth%=depth%-1
End Sub
2 Likes
2 Likes
