XProfan

Windowtitle "Flattermann-Logo per Formel":Windowstyle 24:Window %maxx,%maxy:UsePen 1,5,0
'Q: mathworld.wolfram.com/BatmanCurve.html; 2015-05 nach XProfan by P. Specht
Declare x!,y!,w!,l!,h!,r!,xh&,yh&,m!:xh&=%maxx\2:yh&=%maxy\2:m!=20:Label:

whileloop -700,700,1:x!=&loop/100:w! = 3*sqroot(1-sqr(x!/7))

    l!=1/2*(x!+3)-3/7*sqrt(10)*sqroot(4-sqr(x!+1))+6/7*sqrt(10)
    r!=1/2*(3-x!)-3/7*sqrt(10)*sqroot(4-sqr(x!-1))+6/7*sqrt(10)
    h!=8.3-3/2*w!*(abs(x!+2/3)+abs(x!-2/3))+0.8*(abs(x!+1/3)+abs(x!-1/3))
    line xh&+m!*x!,(yh&-m!*Fe(x!)) - xh&+m!*x!,yh&-m!*Fe(x!)-1
    line xh&+m!*x!,(yh&-m!*Ge(x!)) - xh&+m!*x!,yh&-m!*Ge(x!)+1
    endwhile:m!=m!+4:goto "Label"

    Proc sqroot :parameters z!

        return if(z!<=0,0,sqrt(z!))

    endproc

    Proc Fe :parameters x!

        return (h!-l!)*He(x!+1) + (r!-h!)*He(x!-1) + (l!-w!)*He(x!+3) + (w!-r!)*He(x!-3) + w!

    Endproc

    Proc He :parameters x!

        return x!>0

    Endproc

    Proc Ge :parameters x!

        return 1/2*(abs(x!/2)+sqroot(1-sqr(abs(abs(x!)-2)-1))- \
        1/112 *(3*sqrt(33)-7)*sqr(x!)+3*sqroot(1-sqr(1/7*x!))-3)* \
        (if(x!=-4,0,(x!+4)/abs(x!+4))-if(x!=4,0,(x!-4)/abs(x!-4)))-3*sqroot(1-sqr(1/7*x!))

    Endproc