Wiki Diff forum-msg-id-136368-edit, revision #1 to tip

Original date:2021-09-06 12:37:40
Original date:2021-09-06 12:27:16
Edited by: petelomax
Subject: Particle fountain

I quickly translated https://rosettacode.org/mw/index.php?title=Particle_fountain#Raku
however it gets me a perfectly formed but tiny version, any ideas on fixing that?
however it gets me a tiny but perfectly formed version, any ideas on fixing that?
<eucode>
--
-- demo\rosetta\Particle_fountain.exw
-- ==================================
--
with javascript_semantics
include pGUI.e

Ihandle dlg, canvas
cdCanvas cddbuffer, cdcanvas

constant title = "Particle fountain"
constant help_text = """
Use UP and DOWN arrow keys to modify the saturation of the particle colors.
Use PAGE UP and PAGE DOWN keys to modify the "spread" of the particles.
Toggle reciprocation off / on with the SPACE bar.
Use LEFT and RIGHT arrow keys to modify angle range for reciprocation.
Press the "q" key to quit.
"""

constant particlenum = 3000
-- each particle is {x,y,color,life,dx,dy}
sequence particles = repeat({0,0,0,0,0,0},particlenum)
atom t1 = time()+1
integer fps = 0
bool reciprocate = true
atom range = 1.5,
spread = 1.5,
saturation = 0.4,
start = time(),
df = 0.0001

function redraw_cb(Ihandle /*ih*/, integer /*posx*/, /*posy*/)
integer {w, h} = IupGetIntInt(canvas, "DRAWSIZE")
cdCanvasActivate(cddbuffer)
cdCanvasClear(cddbuffer)
for i=1 to length(particles) do
atom {x,y,color,life} = particles[i]
if life>0 then
cdCanvasPixel(cddbuffer, x, h-y, color)
end if
end for
cdCanvasFlush(cddbuffer)
return IUP_DEFAULT
end function

function map_cb(Ihandle ih)
cdcanvas = cdCreateCanvas(CD_IUP, ih)
cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)
cdCanvasSetBackground(cddbuffer, CD_BLACK)
return IUP_DEFAULT
end function

function hsv_to_rgb(atom h, s, v)
atom r,g,b
if s=0 then
{r,g,b} = {v,v,v}
else
integer i = floor(h*6)
atom f = h*6-i,
p = v*(1-s),
q = v*(1-s*f),
t = v*(1-s*(1-f))
switch i do
case 0,
6: {r,g,b} = {v, t, p}
case 1: {r,g,b} = {q, v, p}
case 2: {r,g,b} = {p, v, t}
case 3: {r,g,b} = {p, q, v}
case 4: {r,g,b} = {t, p, v}
case 5: {r,g,b} = {v, p, q}
end switch
end if
return cdEncodeColor(r*255, g*255, b*255)
end function

function timer_cb(Ihandle /*ih*/)
integer {w, h} = IupGetIntInt(canvas, "DRAWSIZE")
fps += 1
df = time()-start
start = time()
for i=1 to particlenum do
atom {x,y,color,life,dx,dy} = particles[i]
if life<=0 then
if rnd()<df then
life = 2.5 -- time to live
x = w/2 -- starting position x
y = h/10 -- and y
-- randomize velocity so points reach different heights:
atom r = iff(reciprocate?range*sin(time()):0)
dx = (spread*rnd()-spread/2+r)*10 -- starting velocity x
dy = (rnd()-2.9) * h/20.5 -- and y
color = hsv_to_rgb(round(remainder(time(),5)/5,100), saturation, 1)
end if
else
if y>h/10 and dy>0 then
dy *= -0.3 -- "bounce"
end if
dy += (h/10)*df -- adjust velocity
x += dx*df -- adjust position x
y += dy*df -- and y
life -= df
end if
particles[i] = {x,y,color,life,dx,dy}
end for
IupRedraw(canvas)
if time()>t1 then
IupSetStrAttribute(dlg,"TITLE","%s (%d, %d fps/s)",{title,particlenum,fps})
t1 = time()+1
fps = 0
end if
return IUP_DEFAULT
end function

function key_cb(Ihandle /*dlg*/, atom c)
if c=K_ESC or lower(c)='q' then return IUP_CLOSE
elsif c=K_F1 then IupMessage(title,help_text)
elsif c=K_UP then saturation = min(saturation+0.1,1)
elsif c=K_DOWN then saturation = max(saturation-0.1,0)
elsif c=K_PGUP then spread = min(spread+0.1,5)
elsif c=K_PGDN then spread = max(spread-0.1,0.2)
elsif c=K_RIGHT then range = min(range+0.1,2)
elsif c=K_LEFT then range = max(range-0.1,0.1)
elsif c=K_SP then reciprocate = not reciprocate
end if
return IUP_CONTINUE
end function

procedure main()
IupOpen()

canvas = IupGLCanvas("RASTERSIZE=800x800")
IupSetCallbacks({canvas}, {"ACTION", Icallback("redraw_cb"),
"MAP_CB", Icallback("map_cb")})
dlg = IupDialog(canvas,`TITLE="%s"`,{title})
IupSetCallback(dlg, "KEY_CB", Icallback("key_cb"))
Ihandle timer = IupTimer(Icallback("timer_cb"), 1000/25)
IupShowXY(dlg,IUP_CENTER,IUP_CENTER)
IupSetAttribute(canvas, "RASTERSIZE", NULL)
if platform()!=JS then
IupMainLoop()
IupClose()
end if
end procedure

main()
</eucode>
Also note that I haven't done any significant testing on the key handling bits.

Search



Quick Links

User menu

Not signed in.

Misc Menu