XProfan

English

p.specht

with the Karthesischen Kegelschnittgleichung a*x² + 2b*x*y + c*y² + 2d*x + 2e*y + f = 0 can all types of Kegelschnitten (ellipsis, parable, Hyperbel) including all degenerierten Cases (Geradenzwickel, straight, point or Garnichts) displayed go. in the astronomy concerns the zB The pathways of Kometen. with already ermittelten Parameters would but from interest, circa whom type it itself each objectively deals and as Bestimmungselemente the Kegelschnittes lauten. the leistet nachstehendes, of me to XProfan-11 übersetzes Program from the genialen Homepage of Prof. J.-P. Moreau - How always without Gewähr!

Compile Mark Separation

Window Title upper$("Aus karthesischer Kegelschnittformel "+\
"auf Parameter the Kegelschnittes schließen")
Window Style 24':Window (%maxx-%maxy)/2,0-%maxy,%maxy
font 2:set("decimals",12):randomize
'Q: https://jean-pierre.moreau.pagesperso-orange.fr/Basic/conical_bas.txt
'Transscribed to XProfan 11.2a by P.woodpecker, Vienna (Austria).
'*  Type: Parabola                                   *
'*  Center:  x=0.999999  y=5.000000                  *
'*  Symmetry direction:  x=1  y=-1                   *
'*  Focus:   x=1.124999  y=4.875000                  *
'*  Parameter:           0.35355339                  *
'*                                                   *
'*                     Basic Version by J-P Moreau.  *
'*                           (www.jpmoreau.fr)       *
Declare c$,a!,b!,c!,d!,e!,f!,x!,y!
Declare ex!,xc!,yc!,xla!,xlb!,xf1!,yf1!,xf2!,yf2!
Declare xs1!,ys1!,xs2!,ys2!,xv1!,yv1!,xv2!,yv2!
Declare delta!,u!,xl!,xm!,x2!,y2!,i&,j&,ityp&,typ&
START:
CLS rgb(200+rnd(56),200+rnd(56),200+rnd(56))
print
print "          UMFORMUNG THE KEGELSCHNITTGLEICHUNG ON ELEMENTARE DARSTELLUNG  "
print "          ==============================================================  \n"
print "  Parameter the Gleichung a*x² + 2b*x*y + c*y² + 2d*x + 2e*y + f = 0 prompt:\n"
'Testwerte lt. example from the Sourcetext:
a!=1:b!=2:c!=1:d!=-13:e!=-11:f!=32
print "  question: should The values the internen Testbeispiels use [j/n]? ";
input c$:c$=left$(lower$(trim$(c$)),1):case (c$="j") or (c$="y"):goto "Huepf"
print
print "    a  = ";:input a!
print "    2b = ";:input b!
print "    c  = ";:input c!
print "    2d = ";:input d!
print "    2e = ";:input e!
print "    f  = ";:input f!

if (a!=0) and (b!=0) and (c!=0) and (d!=0) and (e!=0) and (f!=0)

    beep:print "\n   *** it get no values association! *** "
    waitinput 10000
    goto "START"

endif

Huepf:
print
b!=b!/2: d!=d!/2: e!=e!/2
delta!=a!*c!-b!*b!

if delta!=0

    gosub "S1000"'call Parabola

else

    xc!=(b!*e!-d!*c!)/delta!
    yc!=(b!*d!-a!*e!)/delta!
    f! = f! + a!*xc!*xc!+2*b!*xc!*yc!+c!*yc!*yc!+2*d!*xc!+2*e!*yc!

    if f!=0

        if delta!>0

            ityp&=7'one point

        else

            ityp&=6'two lines
            goto "G100"

        endif

    endif

    u!=sqrt((a!-c!)*(a!-c!)+4*b!*b!)
    xl!=(a!+c!-u!)/2: xm!=(a!+c!+u!)/2

    if (a!=c!) and (b!=0)

        if (f!*a!)>=0

            ityp&=8'no conical
            goto "G100"

        else

            ityp&=4'circle
            xla!=sqrt(-f!/a!)
            ex!=1
            goto "G100"

        endif

    endif

    if (a!<c!) and (b!=0)

        x2!=1: y2!=0: xv1!=1: yv1!=0

    else

        xv1!=b!: yv1!=1-a!
        u!=sqrt(xv1!*xv1!+yv1!*yv1!)
        x2!=xv1!/u!: y2!=yv1!/u!

    endif

    if delta!<0

        gosub "S2000"'call Hyperbola

    else

        gosub "S3000"'call ellipsis

    endif

endif'else if delta=0

' print results
G100:

if ityp&=1

    print "  Type: Ellipse"
    print
    print "  Mittelpunktkoordianten:  x=";stature$("%g",xc!);"  y=";stature$("%g",yc!)
    print "\n  direction large axis  :  x=";stature$("%g",xv1!);"  y=";stature$("%g",yv1!)
    print "\n  direction small axis :  x=";stature$("%g",xv2!);"  y=";stature$("%g",yv2!)
    print "\n  length large Halbachse :  ";stature$("%g",xla!)
    print "\n  length small Halbachse:  ";stature$("%g",xlb!)
    print "\n  Brennpunktkoordinaten :  x=";stature$("%g",xf1!);"  y=";stature$("%g",yf1!)
    print "\n  Zweiter focus    :  x=";stature$("%g",xf2!);"  y=";stature$("%g",yf2!)
    print "\n  Num.Exzentrizität     :  ";stature$("%g",ex!)

endif

if ityp&=2

    if (a!+c!)=0

        print "  type: Gleichseitige Hyperbel"

    else

        print "  type: Hyperbel"

    endif

    print
    print "  Mittelpunkt           :  x=";stature$("%g",xc!);"  y=";stature$("%g",yc!)
    print "\n  direction first axis  :  x=";stature$("%g",xv1!);"  y=";stature$("%g",yv1!)
    print "\n  direction second axis :  x=";stature$("%g",xv2!);"  y=";stature$("%g",yv2!)
    print "\n  first Leitgerade      :  x=";stature$("%g",xs1!);"  y=";stature$("%g",ys1!)
    print "\n  second Leitgerade     :  x=";stature$("%g",xs2!);"  y=";stature$("%g",ys2!)
    print "\n  first focus     :  x=";stature$("%g",xf1!);"  y=";stature$("%g",yf1!)
    print "\n  Zweiter focus    :  x=";stature$("%g",xf2!);"  y=";stature$("%g",yf2!)
    print "\n  Num.Exzentrizität     :  ";stature$("%g",ex!)

endif

if ityp&=3

    print "  type: Parabel"
    print
    print "  Mittelpunkt           :  x=";stature$("%g",xc!); "  y=";stature$("%g",yc!)
    print "\n  Symmetrieachsenvektor :  x=";stature$("%g",xv1!);"  y=";stature$("%g",yv1!)
    print "\n  Brennpunktskoordinaten:  x=";stature$("%g",xf1!);"  y=";stature$("%g",yf1!)
    print "\n  Parameter the parable :  "; stature$("%g",ex!)

endif

if ityp&=4

    print "  type: Kreis"
    print
    print "  Mittelpunkt           :  x=";stature$("%g",xc!);"  y=";stature$("%g",yc!)
    print "\n  radius                :  ";stature$("%g",xla!)
    print "\n  Num.Exzentrizität     :  ";stature$("%g",ex!)

endif

case ityp&=5: print "  this Kegelschnitt degeneriert to line."
case ityp&=6: print "  this Kegelschnitt degeneriert To two Geraden."
case ityp&=7: print "  this Kegelschnitt degeneriert to a individual point."
case ityp&=8: print "  honest not lösbar. no Kegelschnitt!"
print
Waitinput
Print "\n   another example durchrechnen [n,e = end]? ";
input c$:c$=left$(lower$(trim$(c$)),1)
casenot (c$="n") or (c$="e"):Goto "START"
beep:Print "\n   Program exits.\n\n   On see again!"
Waitinput 3000
END'of main program
'Subroutine parable
s1000:
ityp&=3

if (c!=0) and (a!=0)'The parabola does hardship exist or is degenerated into a line

    if (d!=0) and (e!=0)

        typ&=8'no conical

    else

        typ&=5'line
        return

    endif

endif

if (a!=0)

    x2!=1: y2!=0: xl!=0: xm!=1

else

    if a!<0

        f!=-f!: e!=-e!: d!=-d!
        c!=-c!: b!=-b!: a!=-a!

    endif

    xl!=sqrt(a!): xm!=sqrt(c!)
    case b!<0 : xm!=-xm!
    u!=sqrt(a!+c!)
    x2!=xm!/u!: y2!=-xl!/u!
    f!=f!*u!:c!=(a!+c!)*u!
    u!=d!*xm!-e!*xl!: e!=d!*xl!+e!*xm!: d!=u!

endif

if d!=0

    if sqr(e!)<(c!*f!)

        typ&=8

    else

        typ&=6'two lines
        return

    endif

else

    x!=(e!*e!-c!*f!)/2/c!/d! : y!=-e!/c!
    xc!=x!*x2!-y!*y2! : yc!=y!*x2!+x!*y2!
    ex!=-d!/c!
    xf1!=xc!+ex!*x2!/2 :yf1!=yc!+ex!*y2!/2
    xv1!=xm! : yv1!=-xl!

endif

return
'Subroutine Hyperbel
s2000:
ityp&=2
xla!=sqrt(-abs(f!)/xl!): xlb!=sqrt(abs(f!)/xm!)

if f!<0

    u!=xla!: xla!=xlb!: xlb!=u!
    u!=x2!: x2!=-y2!: y2!=u!
    u!=xv1!: xv1!=-yv1!: yv1!=u!

endif

xv2!=-yv1!: yv2!=xv1!
u!=sqrt(xla!*xla!+xlb!*xlb!)
xs1!=xc!+x2!*xla!: ys1!=yc!+y2!*xla!
xs2!=xc!-x2!*xla!: ys2!=yc!-y2!*xla!
xf1!=xc!+x2!*u!: yf1!=yc!+y2!*u!
xf2!=xc!-x2!*u!: yf2!=yc!-y2!*u!
ex!=u!/xla!
return
'Subroutine ellipsis
s3000:
ityp&=1

if (f!*xl!)>0

    typ&=8'no conical
    return

endif

xla!=sqrt(-f!/xl!): xlb!=sqrt(-f!/xm!)

if xl!<0

    u!=xla!: xla!=xlb!: xlb!=u!
    u!=x2!: x2!=-y2!: y2!=u!
    u!=xv1!: xv1!=-yv1!: yv1!=u!

endif

xv2!=-yv1!: yv2!=xv1!
u!=sqrt(xla!*xla!-xlb!*xlb!)
xf1!=xc!+x2!*u!: yf1!=yc!+y2!*u!
xf2!=xc!-x2!*u!: yf2!=yc!-y2!*u!
ex!=u!/xla!
return