Home
JAQForum Ver 24.01
Log In or Join  
Active Topics
Local Time 12:47 26 Nov 2024 Privacy Policy
Jump to

Notice. New forum software under development. It's going to miss a few functions and look a bit ugly for a while, but I'm working on it full time now as the old forum was too unstable. Couple days, all good. If you notice any issues, please contact me.

Forum Index : Microcontroller and PC projects : Heart

Author Message
TassyJim

Guru

Joined: 07/08/2011
Location: Australia
Posts: 6098
Posted: 09:33pm 16 Feb 2024
Copy link to clipboard 
Print this post

Not a lot to say.
It should run on anything from a geek to cmm2 and MMB4W
 '
 OPTION EXPLICIT
 OPTION DEFAULT INTEGER
 
 DIM INTEGER frame, c
 DIM FLOAT x, y, p, w = MM.HRES, h = MM.HRES, hw = w/2, hh = h/2,sz, ys = 40
 
FUNCTION sdHeart(x AS FLOAT,y AS FLOAT) AS FLOAT
 STATIC FLOAT a, b, c
 y = y + 0.5 : y = 1.0 - y : x = ABS(x)
 IF x + y > 1.0 THEN
   sdHeart = SQR((x - 0.25) * (x - 0.25) + (y - 0.75) * (y - 0.75)) - 0.35355
 ELSE
   c = x + y
   IF c < 0 THEN
     c = 0.0
   ENDIF
   a = x * x + (y - 1.0) * (y - 1.0)
   b = (x - 0.5 * c) * (x - 0.5 * c) + (y - 0.5 * c) * (y - 0.5 * c)
   IF a < b THEN
     sdHeart = SQR(a) * SGN(x-y)
   ELSE
     sdHeart = SQR(b) * SGN(x-y)
   ENDIF
 ENDIF
END FUNCTION
 
 CLS
 FOR frame = 1 TO 250
   FOR c = 1 TO 10
     x = RND()*w
     y = RND()*h
     p = sdHeart((x - hw) / hh, (y - hh) / hh) * hh
     IF p < 0 THEN
       COLOUR RGB(150,20,10)
       sz = 1.5
     ELSE
       COLOUR RGB(20,20,70)
       sz = 1.5
     ENDIF
     p = ABS(p)
     CIRCLE x,y-ys,p
   NEXT c
   PAUSE 100
 NEXT frame


It needs the pause to see whats happening.

Translated form PureBasic which was translated from  https://www.shadertoy.com/view/dljyDc


Jim
VK7JH
MMedit   MMBasic Help
 
disco4now

Guru

Joined: 18/12/2014
Location: Australia
Posts: 896
Posted: 10:38pm 16 Feb 2024
Copy link to clipboard 
Print this post

Looks good.
Your title is probably going to get a lot of views considering the age of members on here.(and not just because Valentines day just passed)

Gerry
Latest F4 Latest H7
 
Grogster

Admin Group

Joined: 31/12/2012
Location: New Zealand
Posts: 9306
Posted: 11:17pm 16 Feb 2024
Copy link to clipboard 
Print this post

I immediately thought of the 70's rock band!
Smoke makes things work. When the smoke gets out, it stops!
 
TassyJim

Guru

Joined: 07/08/2011
Location: Australia
Posts: 6098
Posted: 11:50pm 16 Feb 2024
Copy link to clipboard 
Print this post

  disco4now said  
Your title is probably going to get a lot of views considering the age of members on here.
Gerry

I should have thought of that and made the PAUSE a random number to better match my rhythm.

Jim
VK7JH
MMedit   MMBasic Help
 
bigmik

Guru

Joined: 20/06/2011
Location: Australia
Posts: 2914
Posted: 02:16am 17 Feb 2024
Copy link to clipboard 
Print this post

Very Nice Jim,

I guess you forgot to give your wife flowers and had to make amends?

Mick
Mick's uMite Stuff can be found >>> HERE (Kindly hosted by Dontronics) <<<
 
ebbandflow
Newbie

Joined: 31/08/2023
Location: United States
Posts: 19
Posted: 06:02pm 18 Feb 2024
Copy link to clipboard 
Print this post

<3 this! Thanks for sharing.


 
vegipete

Guru

Joined: 29/01/2013
Location: Canada
Posts: 1109
Posted: 09:11pm 18 Feb 2024
Copy link to clipboard 
Print this post

Line 6 includes "h = MM.HRES". Is that as intended? It works fine regardless.
Visit Vegipete's *Mite Library for cool programs.
 
TassyJim

Guru

Joined: 07/08/2011
Location: Australia
Posts: 6098
Posted: 09:23pm 18 Feb 2024
Copy link to clipboard 
Print this post

  vegipete said  Line 6 includes "h = MM.HRES". Is that as intended? It works fine regardless.

That was the deliberate typo to see if anyone was looking.

Either that or I should proofread my work better.

As you probably assumed it should be MM.Vres and if you correct that, you will need to change the end of the line to ys = 0
 Dim Float x, y, p, w = Mm.hres, h = Mm.vres, hw = w/2, hh = h/2,sz, ys = 0

ys was added to make it fit the geek but correcting h was the correct fix.

Jim
VK7JH
MMedit   MMBasic Help
 
Print this page


To reply to this topic, you need to log in.

© JAQ Software 2024