XProfan

WindowTitle "ExpMan: Eine Funktionskurve aus bis zu 5 Glockenkurven manuell erzeugen"
'(CL) CopyLeft 2016-05 by P.Specht, Vienna/Austria - Ohne jede Gewähr! No warranty whatsoever!
WindowStyle 24:Window 0,0-%maxx,%maxy
declare xh&,yh&,x!,y!,first&,n&,fnr&,anzf&,lastx!,lasty!,w$,co&
declare f1pos!,f1streu!,f1amp!,f2pos!,f2streu!,f2amp!,f3pos!
declare f3streu!,f3amp!,f4pos!,f4streu!,f4amp!,f5pos!,f5streu!,f5amp!
xh&=width(%hwnd)\2:yh&=height(%hwnd)*7/8:font 2

proc f :parameters x!,mu!,sigma!

    return exp(-1*sqr(x!-mu!)/sigma!)

endproc

Default:
anzf&=5
inc anzf&'da plus Summenkurve
f1pos!=-2:f1streu!=1:f1amp!=1
f2pos!=-1:f2streu!=1:f2amp!=1
f3pos!= 0:f3streu!=1:f3amp!=1
f4pos!= 1:f4streu!=1:f4amp!=1
f5pos!= 2:f5streu!=1:f5amp!=1
beep
SCHLEIFE:
fnr&=anzf&+1

REPEAT

    dec fnr&'funktionsnummer
    first&=1

    whileloop -xh&,xh&,10

        x!=&Loop/100

        SELECT fnr&

            caseof 1 : y!=f(x!,f1pos!,f1streu!)*f1amp!:co&=rgb(255,0,0)

            caseof 2 : y!=f(x!,f2pos!,f2streu!)*f2amp!:co&=rgb(0,200,0)

            caseof 3 : y!=f(x!,f3pos!,f3streu!)*f3amp!:co&=rgb(0,0,255)

            caseof 4 : y!=f(x!,f4pos!,f4streu!)*f4amp!:co&=rgb(200,0,255)

            caseof 5 : y!=f(x!,f5pos!,f5streu!)*f5amp!:co&=rgb(100,100,0)

            caseof 6 : co&=0

            y! = f(x!,f1pos!,f1streu!)*f1amp!+f(x!,f2pos!,f2streu!)*f2amp!+ \
            f(x!,f3pos!,f3streu!)*f3amp!+f(x!,f4pos!,f4streu!)*f4amp!+f(x!,f5pos!,f5streu!)*f5amp!

        ENDSELECT

        if first&

            first&=0

        else

            usepen 0,2+4*(fnr&=anzf&),co&
            line xh&+lastx!*100,(yh&-lasty!*200) - xh&+x!*100,yh&-y!*200

        endif

        lastx!=x!:lasty!=y!

    endwhile

UNTIL fnr&=0

usepen 0,1,0:line 0,yh& - 2*xh&,yh&
locate 1,1
print "\n                        "
color 12,15
print " 1 F1-Position: ";format$("%g",f1pos!);"       "
print " 2 F1-Streuung: ";format$("%g",f1streu!);"       "
print " 3 F1-Amplitude ";format$("%g",f1amp!);"       "
print "                                   "
color 2,15
print " 4 F2-Position: ";format$("%g",f2pos!);"       "
print " 5 F2-Streuung: ";format$("%g",f2streu!);"       "
print " 6 F2-Amplitude:";format$("%g",f2amp!);"       "
print "                                   "
color 9,15
print " 7 F3-Position: ";format$("%g",f3pos!);"       "
print " 8 F3-Streuung: ";format$("%g",f3streu!);"       "
print " 9 F3-Amplitude ";format$("%g",f3amp!);"       "
print "                                   "
color 3,15
print " 7 F4-Position: ";format$("%g",f4pos!);"       "
print " 8 F4-Streuung: ";format$("%g",f4streu!);"       "
print " 9 F4-Amplitude ";format$("%g",f4amp!);"       "
print "                                   "
color 6,15
print " 7 F5-Position: ";format$("%g",f5pos!);"       "
print " 8 F5-Streuung: ";format$("%g",f5streu!);"       "
print " 9 F5-Amplitude ";format$("%g",f5amp!);"       "
color 0,15
print "\n Neustart? [j/-]             ";
locate 3,17:input w$:if w$<>"":f1pos!=val(w$):goto "weitr":endif
locate 4,17:input w$:if w$<>"":f1streu!=val(w$):case f1Streu!=0:f1Streu!=1:goto "weitr":endif
locate 5,17:input w$:if w$<>"":f1amp!=val(w$):goto "weitr":endif
locate 7,17:input w$:if w$<>"":f2pos!=val(w$):goto "weitr":endif
locate 8,17:input w$:if w$<>"":f2streu!=val(w$):case f2Streu!=0:f2Streu!=1:goto "weitr":endif
locate 9,17:input w$:if w$<>"":f2amp!=val(w$):goto "weitr":endif
locate 11,17:input w$:if w$<>"":f3pos!=val(w$):goto "weitr":endif
locate 12,17:input w$:if w$<>"":f3streu!=val(w$):case f3Streu!=0:f3Streu!=1:goto "weitr":endif
locate 13,17:input w$:if w$<>"":f3amp!=val(w$):goto "weitr":endif
locate 15,17:input w$:if w$<>"":f4pos!=val(w$):goto "weitr":endif
locate 16,17:input w$:if w$<>"":f4streu!=val(w$):case f4Streu!=0:f4Streu!=1:goto "weitr":endif
locate 17,17:input w$:if w$<>"":f4amp!=val(w$):goto "weitr":endif
locate 19,17:input w$:if w$<>"":f5pos!=val(w$):goto "weitr":endif
locate 20,17:input w$:if w$<>"":f5streu!=val(w$):case f5Streu!=0:f5Streu!=1:goto "weitr":endif
locate 21,17:input w$:if w$<>"":f5amp!=val(w$):goto "weitr":endif
locate 23,17:input w$:if w$="j":cls:goto "Default":endif
weitr:
cls
goto "SCHLEIFE"