TheBackShed.com

Author

Message

Volhout
Guru

Joined: 05/03/2018
Location: Netherlands
Posts: 5919

Posted: 12:58pm 02 Dec 2024

Very nice !!!

Volhout

twofingers

Guru

Joined: 02/06/2014
Location: Germany
Posts: 1752

Posted: 01:25pm 02 Dec 2024

I think this is a nice example to understand "map" and to play with it.

'Toroidal Reactor by javavi/2024
MODE 2
Map Reset

Dim PicFile$="iter.bmp"
Dim integer cm(15)=(15,7,1,0,0,10,10,10,10,10,10,10,10,10,10,10)'red iter
'Dim integer cm(15)=(0,15,7,1,0,0,0,0,0,0,0,0,0,0,0,0)'dark iter
'Dim integer cm(15)=(15,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0)'colorful iter
Colour Map cm(),cm()

If MM.Info(exists file PicFile$) Then
Load image PicFile$
Else
For U=0 To 159
x1=U/128-1.25
For V=0 To 239
y1=V/128-1
X=0:Y=X:Z=-2.4
Do
k1=Sqr(X*X+Z*Z)-2
d1=1-Sqr(k1*k1+Y*Y)
X=X+x1*d1:Y=Y+y1*d1:Z=Z+d1
Loop Until d1<.005
v1=Atn(Z/X):u1=Atn(Y/k1)

sColor(): Pixel U,V
v1=3.13-v1
sColor(): Pixel 319-U,V
Next
Next
Save image PicFile$
EndIf

Do
T=cm(1)
For i=1 To 15-1:cm(i)=cm(i+1):Next
cm(15)=T
For i=1 To 15:Map(i)=cm(i):Next
Map Set
Pause 50
Loop

Sub sColor()
p=Sin(Int((u1+v1)*40)*99)*98
c=15 And ((u1-v1+p)*24*Abs(Sin(p)))
Color Map(c)
End Sub

/*
15 WHITE RGB(255, 255, 255)
14 YELLOW RGB(255, 255, 0)
13 LILAC RGB(255, 128, 255)
12 BROWN RGB(255, 128, 0)
11 FUCHSIA RGB(255, 64, 255)
10 RUST RGB(255, 64, 0)
9 MAGENTA RGB(255, 0, 255)
8 RED RGB(255, 0, 0)
7 CYAN RGB(0, 255, 255)
6 GREEN RGB(0, 255, 0)
5 CERULEAN RGB(0, 128, 255)
4 MIDGREEN RGB(0, 128, 0)
3 COBALT RGB(0, 64, 255)
2 MYRTLE RGB(0, 64, 0)
1 BLUE RGB(0, 0, 255)
0 BLACK RGB(0, 0, 0)
*/
>

javavi

Guru

Joined: 01/10/2023
Location: Ukraine
Posts: 561

Posted: 03:58pm 02 Dec 2024

Stellarator

RP2350 MODE 3 640x480 in colour

MODE 3
Map Reset
For U=0 To 319
x1=U/256-1.255
For V=0 To 479
y1=V/256-1
X=0:Y=X:Z=-2.4
Do
k=Sqr(X*X+Z*Z)-2
d=1-Sqr(k*k+Y*Y)
X=X+x1*d:Y=Y+y1*d:Z=Z+d
Loop Until d<.01
v1=Atn(Z/X)
u1=Atn(Y/k)
sColor(): Pixel U,V
v1=3.13-v1
sColor(): Pixel 639-U,V
Next
Next

'Dim integer cm(15)=(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15)
'Dim integer cm(15)=(0,15,7,1,0,0,0,0,0,0,0,0,0,0,0,0)
Dim integer cm(15)=(0,15,14,6,4,2,0,0,0,0,0,0,0,0,0,0)
Colour Map cm(),cm()
Do
T=cm(0)
For i=0 To 14:cm(i)=cm(i+1):Next
cm(15)=T
For i=0 To 15:Map(i)=cm(i):Next
Map Set
Pause 50
Loop

Sub sColor()
p=Sin(Int((u1+v1)*40)*99)*98
c=15 And ((u1-v1+p)*24*Abs(Sin(p)))
Color Map(c)
End Sub

javavi

Guru

Joined: 01/10/2023
Location: Ukraine
Posts: 561

Posted: 08:54pm 02 Dec 2024

Toroidal Reactor

MODE 2

Stellarator

'Toroidal Reactor by javavi/2024
MODE 2
Map Reset

Dim PicFile$="TOR.bmp"
Dim integer cm(15)=(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15)
Colour Map cm(),cm()

If MM.Info(exists file PicFile$) Then
Load image PicFile$
Else
For U=0 To 159
x1=U/128-1.25
For V=0 To 239
y1=V/128-1
X=0:Y=X:Z=-2.4
Do
k=Sqr(X*X+Z*Z)-2
d=1-Sqr(k*k+Y*Y)
X=X+x1*d:Y=Y+y1*d:Z=Z+d
Loop Until d<.005
v1=Atn(Z/X):u1=Atn(Y/k)
sColor(): Pixel U,V
v1=3.13-v1
sColor(): Pixel 319-U,V
Next :Next
Save image PicFile$
EndIf

Do
For N=0 To 31
T=cm(0)
For i=0 To 14:cm(i)=cm(i+1):Next
cm(15)=T
For i=0 To 15:Map(i)=cm(i):Next
Map Set
Pause 50
Next
For i=0 To 15
If i<4 Then cm(i)=Map(Int(Rnd*15)) Else cm(i)=0
Next
Loop

Sub sColor()
p=Sin(Int((u1+v1)*40)*99)*98
c=15 And ((u1-v1+p)*24*Abs(Sin(p)))
Color Map(c)
End Sub

twofingers

Guru

Joined: 02/06/2014
Location: Germany
Posts: 1752

Posted: 10:07am 03 Dec 2024

@Vadim: Good idea to add some variety.

Regards
Michael

javavi

Guru

Joined: 01/10/2023
Location: Ukraine
Posts: 561

Posted: 10:10am 03 Dec 2024

Fire Show Fountain

MODE 2
Map Reset
Dim integer cm(15)=(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15)
Colour Map cm(),cm()

For I=0 To 2100
If Y>230 Then
X=160
Y=240
x0=X:y0=Y
x1=Cos(Rnd*Pi)*5
y1=5+Rnd*16
EndIf
X=X+x1:Y=Y-y1:y1=y1-1
Inc C,-1:If C<1 Then C=15
Color Map(C)
If X>0 And X<320 Then Line x0,y0,X,Y
x0=X:y0=Y
Next

Do
For N=0 To 14
T=cm(1)
For i=1 To 14:cm(i)=cm(i+1):Next
cm(15)=T
For i=1 To 15:Map(i)=cm(i):Next
Map Set
Pause 100
Next
For i=1 To 15
If i<3 Then cm(i)=Map(Int(Rnd*15)) Else cm(i)=0
Next
Loop

Geoffg

Guru

Joined: 06/06/2011
Location: Australia
Posts: 3362

Posted: 11:41am 03 Dec 2024

javavi, I have to say that your "demo" programs are fantastic.
So much detail generated by such concise code.

Wonderful,
Geoff

javavi

Guru

Joined: 01/10/2023
Location: Ukraine
Posts: 561

Posted: 07:09pm 06 Dec 2024

Geoffg said I have to say that your "demo" programs are fantastic.
So much detail generated by such concise code.

Thanks Geoff,
I must say, and I've already said this here, that I don't make up these formulas myself, I just take examples from the Internet and rewrite them in MMBASIC for PicoMite. Some examples had to be completely rewritten, and some I came up with myself, most likely inspired by something I saw.

With respect, javavi

Martin H.

Guru

Joined: 04/06/2022
Location: Germany
Posts: 1459

Posted: 02:05pm 07 Dec 2024

javavi said

Toroidal Reactor

MODE 2

Stellarator

if you replace PAUSE 50 with FRAMEBUFFER wait then it really gets going

stanleyella

Guru

Joined: 25/06/2022
Location: United Kingdom
Posts: 2807

Posted: 01:15am 08 Dec 2024

javavi

Guru

Joined: 01/10/2023
Location: Ukraine
Posts: 561

Posted: 09:48pm 11 Dec 2024

∞ Lissajous Figures ∞

Option ANGLE DEGREES
FRAMEBUFFER CREATE
FRAMEBUFFER WRITE F
Colour RGB(Cyan),RGB(Blue)

CX=MM.HRes/2: CY=MM.VRes/2
Scale=0.95: AX=CY*Scale: AY=CY*Scale
a=1: b=0: p=0: f=0: c=0

Do
If p>360 Then p=0: EndIf
If b>6 Then a=a+1: b=0: c=0: EndIf
If a>5 Then a=1: b=0: c=0: EndIf
If c=50 Then
f=1
If a=Fix(b) Then f=0: c=0: EndIf
EndIf
If c=130 Then f=0: c=0: EndIf

CLS
sx= AX * Sin(p) + CX
sy= AY * Sin(p) + CY
For i= 0 To 360
x = AX * Sin(a*i + p) + CX
y = AY * Sin(b*i + p) + CY
Line sx,sy,x,y
sx=x: sy=y
Next i

Print "a ="a: Print "b ="b
FRAMEBUFFER COPY F,N,B

Inc p: Inc c
If f=0 Then b=b+.02: EndIf

Loop Until Inkey$ <> ""
End

javavi

Guru

Joined: 01/10/2023
Location: Ukraine
Posts: 561

Posted: 05:46am 13 Dec 2024

3D Dice

MODE 1
TILE 0,0,RGB(RED),RGB(BLACK),16,40
TILE 16,0,RGB(GREEN),RGB(BLACK),16,40
TILE 32,0,RGB(BLUE),RGB(BLACK),16,40
TILE 48,0,RGB(YELLOW),RGB(BLACK),16,40

'Print "3D Draw"
'--------------------------
Dim n=1, nv=24, nf=6+8, camera=1
' Load vertices arrey
Dim v(2,nv-1)
Restore vertices2
For i=0 To nv-1: For a=0 To 2: Read v(a,i):Next :Next
' Load facecount arrey
Dim INTEGER facecount(nf-1), facesize=0
Restore facecount2
For i=0 To nf-1: Read facecount(i): Inc facesize,facecount(i): Next
' Load faces arrey
Dim INTEGER faces(facesize-1)
Restore faces2
For i=0 To facesize-1: Read faces(i): Next
' Load colours arreys
Dim INTEGER c(1)=(0,RGB(GREEN))
Dim INTEGER edge(nf-1)=(1,1,1,1,1,1, 1,1,1,1,1,1,1,1)
Dim INTEGER fill(nf-1)=(0,0,0,0,0,0, 0,0,0,0,0,0,0,0)

Math SCALE v(), 100.0, v()
Draw3D CREATE 1,nv,nf,camera,v(),facecount(),faces(),c(),edge(),fill()
Draw3D CREATE 2,nv,nf,camera,v(),facecount(),faces(),c(),edge(),fill()
Draw3D CREATE 3,nv,nf,camera,v(),facecount(),faces(),c(),edge(),fill()
Draw3D CREATE 4,nv,nf,camera,v(),facecount(),faces(),c(),edge(),fill()
Draw3D CREATE 5,nv,nf,camera,v(),facecount(),faces(),c(),edge(),fill()
'--------------------------
nv=84: nf=21: camera=1
' Load vertices arrey
Dim v1(2,nv-1)
Restore vertices3
For i=0 To nv-1: For a=0 To 2: Read v1(a,i):Next :Next
' Load facecount arrey
Dim INTEGER facecount1(nf-1)
facesize=0
Restore facecount3
For i=0 To nf-1: Read facecount1(i): Inc facesize,facecount1(i): Next
' Load faces arrey
Dim INTEGER faces1(facesize-1)
Restore faces3
For i=0 To facesize-1: Read faces1(i): Next
' Load colours arreys
Dim INTEGER edge1(nf-1)=(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1)
Dim INTEGER fill1(nf-1)=(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1)

Math SCALE v1(), 100.0, v1()
Draw3D CREATE 6,nv,nf,camera,v1(),facecount1(),faces1(),c(),edge1(),fill1()

'--------------------------

Dim INTEGER viewplane=400
Draw3D CAMERA n, viewplane

Dim INTEGER x=0, y=0, z=6000

'Draw3D SHOW n, x, y, z
'END

'================================================
Dim FLOAT yaw=Rad(1), pitch=Rad(2), roll=Rad(0.5)
Dim FLOAT q(4)

FRAMEBUFFER CREATE
FRAMEBUFFER WRITE F
Do
Math Q_EULER yaw, pitch, roll, q()
Draw3D ROTATE q(),1
Draw3D ROTATE q(),2
Draw3D ROTATE q(),3
Draw3D ROTATE q(),4
Draw3D ROTATE q(),5
Draw3D ROTATE q(),6

Draw3D SHOW 1,x,y,z
Draw3D WRITE 6,x,y,z

Draw3D SHOW 2,-1800,y,z
Draw3D WRITE 6,-1800,y,z
Draw3D SHOW 3,-3600,y,z
Draw3D WRITE 6,-3600,y,z

Draw3D SHOW 4,1800,y,z
Draw3D WRITE 6,1800,y,z
Draw3D SHOW 5,3600,y,z
Draw3D WRITE 6,3600,y,z

Inc yaw,Rad(4) '1
Inc pitch,Rad(8) '2
Inc roll,Rad(2) '0.5
FRAMEBUFFER copy F,N,b
Loop Until Inkey$<>""

FRAMEBUFFER WRITE N
Memory
FRAMEBUFFER close
End

vertices2: '24/14
Data -4,3,-4, -3,4,-4, 3,4,-4, 4,3,-4, 4,-3,-4, 3,-4,-4, -3,-4,-4, -4,-3,-4
Data -4,4,-3, 4,4,-3, 4,-4,-3, -4,-4,-3, -4,4,3, 4,4,3, 4,-4,3, -4,-4,3
Data -4,3,4, -3,4,4, 3,4,4, 4,3,4, 4,-3,4, 3,-4,4, -3,-4,4, -4,-3,4
facecount2:
Data 8,8,8,8,8,8,3,3,3,3,3,3,3,3
faces2:
Data 0,1,2,3,4,5,6,7, 12,17,18,13,9,2,1,8, 3,9,13,19,20,14,10,4
Data 16,12,8,0,7,11,15,23, 11,6,5,10,14,21,22,15, 19,18,17,16,23,22,21,20
Data 8,1,0, 9,3,2, 10,5,4, 11,7,6, 12,16,17, 13,18,19, 14,20,21, 15,22,23

vertices3: '84/21
Data 0,1,-4,1,0,-4,0,-1,-4,-1,0,-4 '1
Data -2,4,-1,-1,4,-2,-2,4,-3,-3,4,-2, 2,4,3,3,4,2,2,4,1,1,4,2 '2
Data 4,-1,-2,4,-2,-1,4,-3,-2,4,-2,-3,4,1,0,4,0,1,4,-1,0,4,0,-1,4,3,2,4,2,3,4,1,2,4,2,1
Data -4,3,2,-4,2,1,-4,1,2,-4,2,3, -4,3,-2,-4,2,-3,-4,1,-2,-4,2,-1 '4
Data -4,-1,2,-4,-2,1,-4,-3,2,-4,-2,3, -4,-1,-2,-4,-2,-3,-4,-3,-2,-4,-2,-1
Data -2,-4,-3,-1,-4,-2,-2,-4,-1,-3,-4,-2, 2,-4,-3,3,-4,-2,2,-4,-1,1,-4,-2 '5
Data -2,-4,1,-1,-4,2,-2,-4,3,-3,-4,2, 2,-4,1,3,-4,2,2,-4,3,1,-4,2
Data 0,-4,-1, 1,-4,0, 0,-4,1, -1,-4,0
Data 2,3,4,1,2,4,2,1,4,3,2,4, -2,3,4,-3,2,4,-2,1,4,-1,2,4 '6
Data 2,1,4,1,0,4,2,-1,4,3,0,4, -2,1,4,-3,0,4,-2,-1,4,-1,0,4
Data 2,-1,4,1,-2,4,2,-3,4,3,-2,4, -2,-1,4,-3,-2,4,-2,-3,4,-1,-2,4
facecount3:
Data 4, 4,4, 4,4,4, 4,4,4,4, 4,4,4,4,4, 4,4,4,4,4,4
faces3:
Data 0,1,2,3
Data 4,5,6,7, 8,9,10,11
Data 12,13,14,15, 16,17,18,19, 20,21,22,23
Data 24,25,26,27, 28,29,30,31, 32,33,34,35, 36,37,38,39
Data 40,41,42,43, 44,45,46,47, 48,49,50,51, 52,53,54,55, 56,57,58,59
Data 60,61,62,63, 64,65,66,67, 68,69,70,71, 72,73,74,75, 76,77,78,79, 80,81,82,83

Volhout
Guru

Joined: 05/03/2018
Location: Netherlands
Posts: 5919

Posted: 07:34am 13 Dec 2024

Wauw !!!

Volhout

Martin H.

Guru

Joined: 04/06/2022
Location: Germany
Posts: 1459

Posted: 10:58am 13 Dec 2024

Nice Dice

matherp
Guru

Joined: 11/12/2012
Location: United Kingdom
Posts: 11472

Posted: 11:31am 13 Dec 2024

Great to see the 3d code in use again

stanleyella

Guru

Joined: 25/06/2022
Location: United Kingdom
Posts: 2807

Posted: 06:33pm 13 Dec 2024

fast,pico2 hdmi.
which manual is Draw3d explained please?
I found Math Q_EULER yaw, pitch, roll, q().
now found See the document “The CMM2 3D engine” in the PicoMiteVGA firmware
download for a full description.
Edited 2024-12-14 05:02 by stanleyella

Mixtel90

Guru

Joined: 05/10/2019
Location: United Kingdom
Posts: 8894

Posted: 07:03pm 13 Dec 2024

CMM2 has it, Stan. I'm not sure if it's been in a Pico manual yet.

stanleyella

Guru

Joined: 25/06/2022
Location: United Kingdom
Posts: 2807

Posted: 07:45pm 13 Dec 2024

thanks for replying Mick but clueless where, just relevant draw3d info and the 3d dice pico 2 works

Turbo46

Guru

Joined: 24/12/2017
Location: Australia
Posts: 1693

Posted: 07:49pm 13 Dec 2024

@Stan,
From the PicoMite manual:

3D Engine
NOT AVAILABLE IN WEBMITE VERSIONS
The 3D Engine includes ten commands for manipulating 3D images including setting the camera, creating, hiding, rotating, etc. See the document The CMM2 3D engine.pdf in the PicoMite firmware download for a full description of these commands and how to use them.

Bill

stanleyella

Guru

Joined: 25/06/2022
Location: United Kingdom
Posts: 2807

Posted: 08:59pm 13 Dec 2024

I got a shortcut to the online manual
https://www.c-com.com.au/mmhelp/

Edited 2024-12-14 07:32 by stanleyella