Author Topic: Another hypnotic animation.  (Read 812 times)

Galileo

  • Guest
Another hypnotic animation.
« on: June 22, 2019, 05:57:02 pm »
Hello again.

New graphic program. The image changes with each pass, slowly transforming.

Code: [Select]
sub distance(x1, y1, x2, y2)  //between two points x1,y1 and x2,y2
    return ((x1 - x2) ^ 2 + (y1 - y2) ^ 2) ^ .5
end sub

open window 256, 256
sh=peek("winheight")
sw=peek("winwidth")
do
   tm = peek("secondsrunning")
   dr = ran(256) : dg = ran(256) : db = ran(256)
   for y = 0 to sh
       for x = 0 to sw
           vl = sin(distance(x + tm, y, 128, 128) / 8)
           vl = vl + sin(distance(x, y, 64, 64) / 8)
           vl = vl + sin(distance(x, y + tm / 7, 192, 64) / 7)
           vl = vl + sin(distance(x, y, 192, 100) / 8)
           clr = 256 / (1 + abs(vl))
           r = abs(clr - dr) : g = abs(clr - dg) : b = abs(clr - db)
           color r, g, b
           dot x, y
       next
   next
loop

Cybermonkey

  • Administrator
  • *****
  • Posts: 0
Re: Another hypnotic animation.
« Reply #1 on: June 22, 2019, 08:58:17 pm »
That's nice. I made a port to AllegroBASIC.
Code: [Select]
'OtroPlasma4.yab by Galileo
'ported to AllegroBASIC by Cybermonkey

def distance(x1, y1, x2, y2)  'between two points x1,y1 and x2,y2
    return ((x1 - x2) ^ 2 + (y1 - y2) ^ 2) ^ .5
enddef
srnd (val(right(TIME,2)))

screen (256, 256, "OtroPlasma")
sh=screenheight
sw=screenwidth
do
   tm = tickcount/100
   dr = fix (rnd*256)
   dg = fix (rnd*256)
   db = fix (rnd*256)
   for y = 0 to sh
       for x = 0 to sw
           vl = sin(distance(x + tm, y, 128, 128) / 8)
           vl = vl + sin(distance(x, y, 64, 64) / 8)
           vl = vl + sin(distance(x, y + tm / 7, 192, 64) / 7)
           vl = vl + sin(distance(x, y, 192, 100) / 8)
           clr = 256 / (1 + abs(vl))
           r = abs(clr - dr)
           g = abs(clr - dg)
           b = abs(clr - db)
           ink (r, g, b)
           pset (x, y)
       next
       redraw
   next

until (keypressed=true) or (windowclosed=true)     

EDIT: Of course if the plasma shall always be the same, one has to use "tm=tickkcount/1000"...
« Last Edit: June 22, 2019, 09:00:23 pm by Cybermonkey »

B+

  • Guest
Re: Another hypnotic animation.
« Reply #2 on: June 23, 2019, 01:45:11 am »
It is hypnotic when things move.

Code: [Select]
_TITLE "Hypnotic" 'mod of Galileo's at Retro 2019-06-22 B+
'open window 256, 256
SCREEN _NEWIMAGE(256, 256, 32)
RANDOMIZE TIMER
'sh=peek("winheight")
sh = _HEIGHT
'sw=peek("winwidth")
sw = _WIDTH
d = 1
DO
    'tm = peek("secondsrunning")
    tm = TIMER(.001)
    dr = ran(256): dg = ran(256): db = ran(256)
    w = w + 5 / 83 '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< get things moving
    FOR y = 0 TO sh
        FOR x = 0 TO sw
            vl = SIN(distance(x + tm, y, 128, 128) / 8 + w)
            vl = vl + SIN(distance(x, y, 64, 64) / 8)
            vl = vl + SIN(distance(x, y + tm / 7, 192, 64) / 7)
            vl = vl + SIN(distance(x, y, 192, 100) / 8)
            clr = 255 / (1.00001 * ABS(vl))
            r = .9 * ABS(clr - dr): g = .4 * ABS(clr - dg): b = .5 * ABS(clr - db)
            'COLOR r, g, b
            'dot x, y
            PSET (x, y), _RGB32(r, g, b)
        NEXT
    NEXT
    IF w > 1000 OR w < -1000 THEN w = 0: d = d * -1
    _DISPLAY
    _LIMIT 200
LOOP
FUNCTION distance (x1, y1, x2, y2) '//between two points x1,y1 and x2,y2
    distance = ((x1 - x2) ^ 2 + (y1 - y2) ^ 2) ^ .5
END FUNCTION
FUNCTION ran% (sing)
    ran% = INT(RND * sing) + 1
END FUNCTION


I am changing the name of mine to Ectoplasm. :-))
« Last Edit: June 23, 2019, 03:35:21 am by B+ »

Cybermonkey

  • Administrator
  • *****
  • Posts: 0
Re: Another hypnotic animation.
« Reply #3 on: June 23, 2019, 09:49:33 am »
It's IMHO even better with
Code: [Select]
    tm = TIMER(.01)

ZXDunny

  • Guest
Re: Another hypnotic animation.
« Reply #4 on: June 26, 2019, 01:20:19 pm »
So I converted to SpecBAS, but in the finest B+ tradition I added my own take on it:

1. Lissajous path through the field (line 40 handles that)
2. Conversion to 256 colours with Palette rotation - freaky
3. Expanded to the full window using filled rectangles.

I could probably get more FPS (this runs at 60fps on my core i7) if I use a bitmap scaling routine rather than the filled rects.
Getting the lissajous path to not jump all over the place when you press a key to get new colours was a trial, but it worked out well.
It looks blocky, but by god it looks nice when it moves.

Code: [Select]
10 z=2,s=6,w=scrw/s,h=scrh/s,
   r1=200,r2=300,a1,a2,s1,s2,sp=1:
   screen lock
20 dr,dg,db=rnd*256:
   for i=0 to 127:
      c=i:
      palette i,abs(c-dr),abs(c-dg),abs(c-db):
      palette 255-i,abs(c-dr),abs(c-dg),abs(c-db):
   next i
30 gs1,gs2=(.125+rnd*2)/1000
40 a1+=s1,
   a2+=s2,
   mx=SIN a1*r1,
   my=COS a2*r2,
   s1+=(gs1-s1)/sp,
   s2+=(gs2-s2)/sp
50 tm=msecs/200:
   for y1=0 to h:
      for x1=0 to w:
         x=(x1+mx)*z,
         y=(y1+my)*z,
         vl=sin(pyth(x-128,y-128)/8)+sin(pyth(x-64+tm,y-64)/8)+sin(pyth(x-192,(y+tm/7)-64)/7)+sin(pyth(x-192,y-100)/8)+sin(pyth(x-64-(tm*8),y-192)/15):
         rectangle ink 256/(1+abs(vl))-1;x1*s,y1*s,s,s fill:
      next x1:
   next y1:
   sp=64:
   palette shr 1,0 to 255:
   wait screen:
   if inkey$="" then
      GO To 40
   Else
      DO:
      Loop until INKEY$="":
      GO To 20


Peter

  • Guest
Re: Another hypnotic animation.
« Reply #5 on: June 26, 2019, 06:36:57 pm »
This is my contribution in BaCon, using animated GIF (256 colors):

Code: [Select]
INCLUDE canvas-gd

OPTION VARTYPE double

DEF FN distance(x1, y1, x2, y2) = POW( ( POW((x1 - x2),2)+POW((y1 - y2), 2) ), .5 )

WINDOW("hypnotic", 256, 256)

sh=HEIGHT
sw=WIDTH

SUB generate_frame
    tm = TIMER
    dr = RANDOM(256) : dg = RANDOM(256) : db = RANDOM(256)
    FOR y = 0 TO sh
        FOR x = 0 TO sw
            vl = SIN(distance(x + tm, y, 128, 128) / 8)
            vl = vl + SIN(distance(x, y, 64, 64) / 8)
            vl = vl + SIN(distance(x, y + tm / 7, 192, 64) / 7)
            vl = vl + SIN(distance(x, y, 192, 100) / 8)
            clr = 256 / (1 + ABS(vl))
            r = ABS(clr - dr) : g = ABS(clr - dg) : b = ABS(clr - db)
            INK(r, g, b, 255)
            PIXEL(x, y)
        NEXT
    NEXT
ENDSUB

FRAMES(40)
CALLBACK(400, generate_frame)
WAITKEY