Thema_3
kwurz_1.lst
' Prozeduren ' mit Wertübergabe(Call by Value) ' und mit Variablenübergabe (Call by Reference) ' //Programm Kubikwurzelberechnug z = 19683 // eine geeignete Zahl zum Test (ohne Eingabe) OPENW #1 TITLEW #1, "Wurzelberechnung (3. Wurzel)" FULLW #1 start% = TIMER // Zeit seit Systemstart in Millisekunden i% = 1 // Schleifendurchläufe mitzählen REPEAT TEXT 30,30,"Im " + STR$(i%) + ". Schleifendurchlauf " TEXT 30,60,"ist die Zahl z =" + STR$(z,7,2) + SPACE$(20) DELAY 1 // Ablauf bremsen wrz3(z) // Prozeduraufruf i% = i% + 1 // oder auch schneller INC i% bzw. i%++ (für integer) // GETEVENT UNTIL z < 1.01 OR TIMER - start% > 10000 CLOSEW #1 // // --- Prozedurdefinition --- PROCEDURE wrz3(zahl) zahl = zahl ^ (1 / 3) // Kubikwurzel RETURN ' ' AUFGABEN: 1. Die Prozedurdefinition von wrz3 abändern in: ' PROCEDURE wrz3(VAR zahl) ' Wirkung erklären! ' 2. Die Prozedurdefinition um die Ausgabe ' des Parameters zahl ergänzen - Wirkung?
funkt_2.lst
' Funktionen mit Wertübergabe (Call by Value)
' Einzeilige und mehrzeilige Funktionsdefinitionen
'
//Programm Darstellung von Funktionen
OPENW #1,0,0,_X,_Y,0
// Koordinatenachsen - Achsenwerte bei PLOT beachten
LINE 10,500,720,500 // Abszissenachse
LINE 120,500,120,515 // Strich für x-Einheit (100 Pixel)
LINE 20, 10, 20,510 // Ordinatenachse
LINE 5,400, 20,400 // Strich für y-Einheit (100 Pixel)
//
TEXT 100,20,"Die Schaubilder der Funktionen: "
FOR x_pix% = 0 TO 600
PLOT 20 + x_pix%,500 - x_pix% // Diagonale zum Vergleich
arg = x_pix% / 100 // 100 Pixel sind eine Einheit
// erster Parameter: double-Konstante wird als Wert übergeben
y1 = @f( 1.15, arg) // Funktionsaufruf f
y_pix% = y1 * 100 // Umrechnung der Werte (double) in Pixel
PLOT 20 + x_pix%, 500 - y_pix% // y-Achse 20 rechts, x- Achse 500 runter
//
y2 = @rezip(arg * arg) // Funktionsaufruf rezip
y_pix% = y2 * 100 // Umrechnung der Werte (double) in Pixel
PLOT 20 + x_pix%, 500 - y_pix% // y-Achse 20 rechts, x- Achse 500 runter
// DELAY .1 // eventuell: langsam zeichnen
NEXT x_pix%
DELAY 5
CLOSEW #1
// --- Funktionen mit Wertübergabe (Call by Value) ---
//
// --- Einzeilige Funktion ---
DEFFN f(k,x) = k * SIN(2 * x) // Argumente Typ double
//
// --- Mehrzeilige Funktion ---
FUNCTION rezip(x)
IF x<>0
g=1/x
ELSE
// wahlweise eine der 2 Folgezeilen aktivieren: Wirkung?
//g = 1.0E+308 // sehr großer double-Wert
g = 20000000 // sehr großer long-Wert
ENDIF
RETURN g
ENDFUNC
'
' AUFGABEN: 1. Änderung der Funktionsdefinition von f
' 2. Einbindung einer weiteren Funktion
' (Definition und Aufruf)
'
mittel_3.lst
' Call by Reference von Feldern
' lokale Variablen in der Funktion
' Ermittlung der Felddimension in einer Funktion
' Zusammenhang Funktion - Prozedur (Rückgabevariable)
//Programm Mittelwert
OPTION BASE 1
REPEAT
INPUT "Wie viele Werte? ",anz%
DIM tabelle(anz%)
FOR j%=1 TO anz%
INPUT "Wert: ",tabelle(j%)
NEXT j%
TEXT 300,20,"Mittelwert ist"
TEXT 300,40,STR$(@mittelwert(tabelle()),10,3)
ALERT 2,"nochmal",1,"JA|NEIN",jn| //Entscheidung
ERASE tabelle()
CLS
UNTIL jn|=2
//
//--- Funktion mit Feldübergabe VAR ---
FUNCTION mittelwert(VAR liste())
LOCAL i%, mw, s // lokale Variablen
LOCAL d% = DIM?(liste())
FOR i% = 1 TO d%
s = s + liste(i%)
NEXT i%
mw = s / d%
RETURN mw
ENDFUNC
'
' AUFGABEN: 1.Programmänderung zur Berechnung:
' - des Produktes
' - der Summe der Quadrate
' - des geometrischen Mittels
' - des Minimums bzw. Maximums
' ...
' aller Werte der Tabelle
' 2.Struktogramm des Hauptprogramms
' 3.Funktion durch eine Prozedur ersetzen.
trend_4.lst
' Gesamtübung
' Trendberechnung ( ohne GFA MATRIX-Befehle )
' Prozeduren, Funktionen und Felder, Feldübergabe mit VAR
' Vorgabe der nötigen Rechenformeln Proberechnung mit 4 Zahlen
' Entwicklung des Struktogramms der Prozedur trend
' Prozedur nach Struktogramm mit Hilfen entwickeln
' Hauptprogramm und Funktionen kopieren
'
//ACHTUNG: dieses Proramm läuft exklusiv! keine Ereignisabfrage!
// Programm zur Trendberechnung
OPTION BASE 1 // Indexzählung ab 1
OPENW #1,0,0,_X,_Y,0
TITLEW #1,"Trendberechnung"
REPEAT
INPUT "Wie viele Werte? ",anz%
DIM y_werte(anz%),y_trend(anz%)
y_werte(1)=ROUND(RND*100,2) // zufälliger Startwert
FOR j%=2 TO anz%
y_werte(j%)=y_werte(j%-1)+ROUND(RND*10,2) // ... + Anstieg
NEXT j%
trend(y_werte(),y_trend())
FOR i%=1 TO anz%
TEXT 10,16+16*i%,STR$(i%,3)+" "+STR$(y_werte(i%),10,2)+" "+STR$(y_trend(i%),10,2)
NEXT i%
ALERT 2,"nochmal",1,"JA|NEIN",jn|
ERASE y_werte(),y_trend()
CLS
UNTIL jn|=2
CLOSEW #1
//--------- Prozeduren und Funktionen -----------
PROCEDURE trend(VAR y(),trend())
LOCAL i%,d%,dx%,mw_y,anstieg
d%=DIM?(y())
DIM x(d%),xx(d%),xy(d%)
IF EVEN(d%)
x(1)=-(d%-1)
dx%=2
ENDIF
IF ODD(d%)
x(1)=-(d%-1)/2
dx%=1
ENDIF
FOR i%=2 TO d%
x(i%)=x(i%-1)+dx%
NEXT i%
FOR i%=1 TO d%
xx(i%)=x(i%)*x(i%)
xy(i%)=x(i%)*y(i%)
NEXT i%
anstieg=@summe(xy())/@summe(xx())
mw_y=@mittelwert(y())
FOR i%=1 TO d%
trend(i%)=mw_y+anstieg*x(i%)
NEXT i%
ERASE x(),xx(),xy()
RETURN
FUNCTION mittelwert(VAR liste())
LOCAL mw=@summe(liste())/DIM?(liste())
RETURN mw
ENDFUNC
FUNCTION summe(VAR liste())
LOCAL i%,s
FOR i%=1 TO DIM?(liste())
s=s+liste(i%)
NEXT i%
RETURN s
ENDFUNC
'
' AUFGABEN: 1. Eingabe von Startwert und Anstiegszahlen
' 2. Anstieg und Mittelwert ausgeben im Hauptprogramm
' (Prozedur ändern, da Variablen lokal!)
' 3. Funktionen als .LST speichern
abinot_5.lst
' Programmierübung nach vorgegebenem Struktogramm
' Verschachtelung von Prozeduren, Arbeit mit Feldern
' Parameterübergabe: Call by Value und Call by Reference
'
// Programm Abiturnoten
OPTION BASE 1
OPENW #1,0,0,_X,_Y,0
TITLEW #1,"Abiturnoten"
REPEAT
GETEVENT
INPUT "Anzahl der Noten ",anz%
DIM pkt%(anz%),von_pkt%(anz%)
FOR i%=1 TO anz%
INPUT "Punkte",pkt%(i%)
INPUT "von Punkte",von_pkt%(i%)
NEXT i%
abinote(pkt%(),von_pkt%())
ALERT 2,"nochmal",1,"JA|NEIN",jn|
ERASE pkt%(),von_pkt%()
CLS
UNTIL jn|=2
CLOSEW #1
//-------------------------------
PROCEDURE abinote(VAR pkt%(),von_pkt%())
LOCAL punktsumme%=@summe(pkt%())
LOCAL erreichbar%=@summe(von_pkt%())
erreicht=punktsumme%/erreichbar%
notenzuweisung(erreicht,zensur$)
TEXT 400,32,"Die Note ist: "+zensur$
RETURN
PROCEDURE notenzuweisung (quotient,VAR note$)
quotient=quotient*100 // für CASE ganzzahlig machen
quotient = ROUND (quotient) // exakter: abrunden!
SELECT quotient
CASE 0 TO 15
note$=" 6 "
CASE 16 TO 23
note$=" 5 minus "
CASE 24 TO 31
note$=" 5 "
CASE 32 TO 39
note$=" 5 plus "
CASE 40 TO 44
note$="4 minus "
CASE 45 TO 50
note$=" 4"
CASE 51 TO 56
note$=" 4 plus "
CASE 57 TO 61
note$=" 3 minus "
CASE 62 TO 67
note$=" 3 "
CASE 68 TO 72
note$=" 3 plus "
CASE 73 TO 77
note$=" 2 minus "
CASE 78 TO 83
note$=" 2 "
CASE 84 TO 89
note$=" 2 plus "
CASE 90 TO 94
note$=" 1 minus "
CASE 95 TO 99
note$=" 1 "
CASE 100
note$=" 1 plus "
ENDSELECT
RETURN
// Summe für long-Felder
FUNCTION summe(VAR liste%()) //geändert aus double-Version
LOCAL i%,s%=0
FOR i%=1 TO DIM?(liste%())
s%=s%+liste%(i%)
NEXT i%
RETURN s%
ENDFUNC
'
' AUFGABEN: 1. Funktion Summe als summe_l.lst speichern.
dynam_6.lst
' Datenfelder mit variabler Anzahl von Elementen ' (dynamische RAM-Datenstrukturen) ' Zeitverhalten (Speicher, Ausgabe) ' Adresse von Variablen bzw. Feldelementen - Speichertransfer ' Feld a() vom Typ double (8 byte) wird ständig erweitert ' läuft exclusiv (keine Ereignisabfrage) ' //dynamische Datenstrukturen bytes|=8 DIM a(0) //ein Element 0. vereinbart OPENW #0,0,0,_X,_Y,0 //ganzer Bildschirm DO INC index% DIM b(index%) //schneller binärer Speichertransfer //von Adresse von a(0) nach Adresse von b(0) BMOVE V:a(0),V:b(0),DIM?(a())*bytes| wert=RAND(30000)*RND //zufällige Werte (reell) b(index%)=wert //zuweisen SWAP a(),b() //Tausch der Felddeskriptoren ERASE b() //und löschen TEXT 10,10,index% //Programmausgabe // (*) EXIT IF MOUSEK //Ende mit Maustaste LOOP CLOSEW #0 ' ' AUFGABEN: 1.Programmausgaben erweitern (Zeitverhalten?) ' (*) ' FOR i%=0 TO DIM?(a())-1 ' TEXT 50+50*((16+16*i%)DIV_Y),(16+16*i%)MOD_Y,a(i%) ' NEXT i% '
sdyna_7.lst
' dynamische RAM- Datenstrukturen (Strings)
' Zeichenkettenfeld a$() wird ständig erweitert
' ACHTUNG!
' WINDOWS benutzt bei Bedarf statt des RAM die Festplatte
' (SWAP-DATEI)
' ---> dann lieber gleich in eine eigene Datei (später!) speichern!
' (Programm läuft exklusiv - keine Ereignisabfrage)
'
// dynamische String- Datenstrukturen
OPENW #0,0,0,_X,_Y,0 // ganzer Bildschirm
anz%=0
DIM a$(anz%) // ein 0. Zeichenkettenelement
DO
INC anz%
DIM b$(anz%)
i%=-1
REPEAT
i%++
EXIT IF MOUSEK = 2 // Abbruch mit rechter Maustaste
b$(i%) = a$(i%) // "umkopieren"
UNTIL i%=anz%-1
EXIT IF MOUSEK=2
// bis 45 Zeichen zufälligen Code erzeugen:
b$(anz%)=STRING$(RAND(45),RAND(256))
SWAP a$(),b$()
ERASE b$()
TEXT 10,16,"anz% = "+STR$(anz%)
IF (32*anz%)MOD_Y <32 THEN CLS
TEXT 10,32+(32*anz%)MOD_Y,a$(anz%)
LOOP
CLOSEW #0
'
' AUFGABEN: 1. String auf 32000 Zeichen erweitern.
' 2. Ausgabe entfernen (Zeitverhalten!) und Fenster
' verändern (Attribute). Ereignisabfrage PEEKEVENT
' einfügen und Test der WINDOWS-Bedienung.
lineal_8.lst
' Nutzung dynamischer Datenstrukturen
' Speicheranforderung wird schrittweise verringert.
'
//Programm Lineal (Skalenteilung)
//----------
OPENW #0
dms% = 12 //Dimension des Lineals (Anzahl)
DIM lin(dms%)
diff = 1.5 // Skalendifferenz
TEXT 2,32,lin(0)
// Datenfeld mit Skalenwerten füllen
FOR i% = 1 TO dms%
lin(i%)=lin(i%-1)+diff
TEXT 2,32+16*i%,lin(i%)
NEXT i%
//----------
i%=0
// Lineal schrittweise verkürzen
DO
alt%=DIM?(lin())
neu%=alt%-1
EXIT IF neu%=0
DIM lineal_neu(neu%-1) // -1 DA INDEX AB 0)
BMOVE V:lin(0),V:lineal_neu(0),8*neu%
SWAP lin(),lineal_neu()
ERASE lineal_neu()
FOR j%=0 TO DIM?(lin())-1
TEXT 48+48*i%,32+16*j%,lin(j%)
NEXT j%
DELAY 1
INC i%
LOOP
REPEAT
GETEVENT
UNTIL MENU(1)=4
CLOSEW #0
'
' AUFGABEN: 1. Speicheranforderung theoretisch nachvollziehen.
linue_9.lst
' Übung zu dynamischen Datenstrukturen
' Aufgabenstellung durch Propgrammablauf
' dynamische Struktur in einer Prozedur
' Schriften
'
//Übung zum Lineal
//----------------
OPENW #1,2,2,_X-4,_Y-4,$2f0
TITLEW #1, "Mit Klick links weiter"
FONT "Arial", WIDTH 6, HEIGHT 12
FONT TO fnt&
SETFONT fnt&
DIM lin(0)
lin(0)=0
diff=1.5
REPEAT
PEEKEVENT
lineal(diff, lin())
FOR i%= 0 TO DIM?(lin())-1
TEXT 10,32+16*i%,STR$(i%)+". "+STR$(lin(i%))
NEXT i%
DELAY 0.5 // sonst ist die Maus zu schnell
REPEAT
PEEKEVENT
knopf|=MOUSEK
UNTIL knopf|>=1 OR MENU(1)=4
UNTIL MENU(1)=4
SETFONT SYSTEM_FONT
FREEFONT fnt&
CLOSEW #1
// ---------------------------------------------------
PROCEDURE lineal(differenz,VAR lineal())
LOCAL alt%=DIM?(lineal()) // Anzahl der Elemente
LOCAL neu%=alt%+1
DIM lineal_neu(neu%-1) // ... -1 da Index ab 0
BMOVE V:lineal(0),V:lineal_neu(0),8*alt%
lineal_neu(neu%-1)=lineal_neu(neu%-2)+differenz
SWAP lineal(),lineal_neu()
ERASE lineal_neu()
RETURN
'
' AUFGABEN: 1. Struktogramm zeichnen
' 2. einzelne Befehle erläutern
' 3. "Trockentest" - Inhalt der Felder