Benutzer:Arbol01/Listings
Grafik Bearbeiten
/* Kreis */ pi = 3.141593 xn = 320 yn = 200 radius = 160 SCREEN 12 FOR index = 1 TO 360 STEP .1 x = SIN((pi / 180) * index) y = COS((pi / 180) * index) xr = x * radius + xn yr = y * radius + yn LINE (xr, yr)-(xr + 1, yr + 1), 1, BF NEXT index
/* P-Orbital */ pi = 3.141593 xn = 320 yn = 200 nradius = 160 SCREEN 12 FOR index = 0 TO 3600 STEP .1 x = SIN((pi / 180) * index) y = COS((pi / 180) * index) r = sin((pi/180)*index) xr = x * r + xn yr = y * r + yn LINE (xr, yr)-(xr + 1, yr + 1), 1, BF NEXT index
/* Propeller */ pi = 3.141593 xn = 320 yn = 200 nradius = 160 SCREEN 12 FOR index = 0 TO 720 STEP .1 x = SIN((pi / 180) * index) y = COS((pi / 180) * index) r = SIN((pi / 60) * index) xr = x * nradius * r + xn yr = y * nradius * r + yn LINE (xr, yr)-(xr + 1, yr + 1), 1, BF NEXT index
/* Kleeblatt */ pi = 3.141593 xn = 320 yn = 200 nradius = 160 SCREEN 12 FOR index = 0 TO 360 STEP .1 x = SIN((pi / 180) * index) y = COS((pi / 180) * index) r = SIN((pi / 90) * index) xr = x * nradius * r + xn yr = y * nradius * r + yn LINE (xr, yr)-(xr + 1, yr + 1), 1, BF NEXT index
/* Spirale */ pi = 3.141593 xn = 320 yn = 200 nradius = 160 SCREEN 12 FOR index = 0 TO 3600 STEP .1 x = SIN((pi / 180) * index) y = COS((pi / 180) * index) r = index / 10 xr = x * r + xn yr = y * r + yn LINE (xr, yr)-(xr + 1, yr + 1), 1, BF NEXT index
/* Apfelmännchen */
DECLARE FUNCTION box! (xpos!, ypos!, xlen!, ylen!, farbe!)
DECLARE FUNCTION complex! (ix!, iy!, r!, i!, m!, gk!)
SCREEN 12
m = 4
gk = 200
maxh = 640
maxv = 480
INPUT "minr: ", minr
INPUT "maxr: ", maxr
INPUT "mini: ", mini
INPUT "maxi: ", maxi
dr = (maxr - minr) / (maxh - 1)
di = (maxi - mini) / (maxv - 1)
FOR iy = 0 TO maxv - 1
FOR ix = 0 TO maxh - 1
r = minr + ix * dr
i = mini + iy * di
k = complex(ix, iy, r, i, m, gk)
IF k = gk THEN
k = 0
ELSE
k = k MOD 9
IF k = 0 THEN k = 9
END IF
empty = box(ix, iy, 1, 1, k)
NEXT ix
NEXT iy
FUNCTION box (xpos, ypos, xlen, ylen, farbe) LINE (xpos, ypos)-(xpos + xlen, ypos + ylen), farbe, BF box = 0 END FUNCTION
FUNCTION complex (ix, iy, r, i, m, gk)
counter = 0
x = 0
y = 0
t = 0
WHILE (t <= m) AND (k < gk)
xt = x * x - y * y + r
yt = 2 * x * y + i
counter = counter + 1
t = xt * xt + yt * yt
x = xt
y = yt
WEND
complex = counter
END FUNCTION
/* Apfelmännchen-Orbitale */
DECLARE FUNCTION box! (xpos!, ypos!, xlen!, ylen!, farbe!)
OPEN "orbit1.txt" FOR OUTPUT AS #1
SCREEN 12
m = 4
gk = 250
dx = 320
dy = 240
r = -.5
i = -.5
FOR i = -1 TO 0 STEP .02
FOR r = -1 TO 0 STEP .02
k = 0
x = 0
y = 0
t = 0
ox = 1
oy = 1
CLS
WHILE (t <= m) AND (k < gk)
xt = x * x - y * y + r
yt = 2 * x * y + i
k = k + 1
t = xt * xt + yt * yt
x = xt
y = yt
lx = (x + 1) * 640
ly = (y + 1) * 480
empty = box(lx, ly, lx, ly, 2)
ox = lx
oy = ly
WEND
IF k = 250 THEN PRINT #1, r, i
NEXT r
NEXT i
FUNCTION box (xpos, ypos, xlen, ylen, farbe) LINE (xpos, ypos)-(xpos + xlen, ypos + ylen), farbe, BF box = 0 END FUNCTION
/* Interferenz */
SCREEN 12
DIM st(8)
st(0) = 160
st(1) = 80
st(2) = 40
st(3) = 20
st(4) = 10
st(5) = 5
st(6) = 2
st(7) = 1
INPUT "zoomfaktor:", zf
INPUT "farbtiefe:", cd
INPUT "farbzahl:", cn
pi = 3.1415926535#
fk = (zf * pi)
FOR s = 0 TO 7
FOR y = 0 TO 479 STEP st(s)
FOR x = 0 TO 639 STEP st(s)
col = SIN((-1 * (zf / 2) * pi) + x * (fk / 640)) - SIN((-1 * (zf / 2) * pi) + y * (fk / 480))
col = (col + 1) * cd
col = col MOD cn
IF col <> 0 THEN col = 11
LINE (x, y)-(x + (st(s) - 1), y + (st(s) - 1)), col, BF
NEXT x
NEXT y
NEXT s
/* Farbtabelle */
to line make "ll1 [] make "ll2 [] make "x1 ((random 400) - 200) make "y1 ((random 400) - 200) make "x2 ((random 400) - 200) make "y2 ((random 400) - 200) make "ll1 lput :x1 :ll1 make "ll1 lput :y1 :ll1 make "ll2 lput :x2 :ll2 make "ll2 lput :y2 :ll2 make "colr random 8 setpc :colr pu setpos :ll1 pd setpos :ll2 end
to lines repeat 512 [line] end
Mathe-Spiele Bearbeiten
/* RAO (BASIC)
CLS
DIM e(6)
e(0) = 10
e(1) = 100
e(2) = 1000
e(3) = 10000
xs1 = 10
xs2 = 1
xs3 = 5
xs4 = 6
ys = 0
yad = 50
FOR x = 0 TO 10000 STEP 10
FOR y = 0 TO 10000 STEP 10
z1 = (xs1 + x) ^ 2 + (ys + y) ^ 2
z2 = (xs2 + x) ^ 2 + (ys + y) ^ 2
z3 = (xs3 + x) ^ 2 + (ys + y) ^ 2
z4 = (xs4 + x) ^ 2 + (ys + y) ^ 2
f1 = e(FIX(LOG(xs1 + x) / LOG(10)))
f2 = e(FIX(LOG(xs2 + x) / LOG(10)))
f3 = e(FIX(LOG(xs3 + x) / LOG(10)))
f4 = e(FIX(LOG(xs4 + x) / LOG(10)))
c1 = ((ys + y) * f1 + (xs1 + x))
c2 = ((ys + y) * f2 + (xs2 + x))
c3 = ((ys + y) * f1 + (xs3 + x))
c4 = ((ys + y) * f2 + (xs4 + x))
IF c1 = z1 THEN PRINT (ys1 + y), (xs1 + x), z1, c1
IF c2 = z2 THEN PRINT (ys1 + y), (xs2 + x), z2, c2
IF c3 = z3 THEN PRINT (ys2 + y), (xs1 + x), z3, c3
IF c4 = z4 THEN PRINT (ys2 + y), (xs2 + x), z4, c4
NEXT y
NEXT x
/* Binomialkoeffizient - 4GL */
MAIN
DEFINE ergebnis INTEGER,
wert1 INTEGER,
wert2 INTEGER
PROMPT "n : " FOR wert1
PROMPT "k : " FOR wert2
CALL binomial_koeffizient(wert1,wert2) RETURNING ergebnis
DISPLAY ergebnis
END MAIN
FUNCTION binomial_koeffizient(n,k)
DEFINE ergebnis1 INTEGER,
ergebnis2 INTEGER,
n INTEGER,
k INTEGER
IF ((k = 0) AND (n >= 0)) OR ((k = n) AND (k >= 0)) THEN
LET ergebnis1 = 1
RETURN ergebnis1
END IF
IF (n > k) AND (k > 0) THEN
CALL binomial_koeffizient(n-1,k-1) RETURNING ergebnis1
CALL binomial_koeffizient(n-1,k) RETURNING ergebnis2
LET ergebnis1 = ergebnis1 + ergebnis2
RETURN ergebnis1
END IF
END FUNCTION
Zeiger Bearbeiten
/* Abstrakter Stack - ADA */
WITH integer_text_io, text_io;
USE integer_text_io, text_io;
PROCEDURE abstrackter_stack IS
PACKAGE stackpack IS
TYPE stack;
TYPE zeiger IS ACCESS stack;
TYPE stack IS RECORD
inhalt : integer;
vorgaenger : zeiger ;
nachfolger : zeiger ;
END RECORD;
PROCEDURE push(wert : integer);
PROCEDURE rotate;
FUNCTION pop RETURN integer;
FUNCTION empty RETURN boolean;
END stackpack;
stack_counter : integer;
zahl : integer;
number : integer;
PACKAGE BODY IS
top:zeiger:=null;
PROCEDURE push(wert:integer) IS
feld : zeiger;
s1 : zeiger;
s2 : zeiger;
index : integer;
BEGIN
feld := NEW stack;
IF stack_counter = 0 THEN
top := feld; -- Wenn noch kein Feld vorhanden ist
feld.vorgaenger := feld; -- muss erstmal eines eingerichtet
feld.nachfolger := feld; -- werden.
feld.inhalt := wert;
END IF;
IF stack_counter = 1 THEN
feld.vorgaenger := top; -- Da bei zwei Feldern beide aneinander
feld.nachfolger := top; -- haengen, braucht das zweite nur auf
top.vorgaenger := feld; -- das erste und das erste nur auf das
top.nachfolger := feld; -- zweite zu zeigen.
feld.inhalt := wert;
IF top.inhalt < wert THEN
top := top.nachfolger;
END IF;
END IF;
IF stack_counter > 1 THEN
IF top.nachfolger.inhalt > wert or top.inhalt < wert THEN
-- Hier wird nach einem kleinsten und groessten Element gesucht
feld.vorgaenger := top;
feld.nachfolger := top.nachfolger;
top.nachfolger.vorgaenger := feld;
top.nachfolger := feld;
feld.inhalt := wert;
IF top.inhalt < wert THEN
top := top.nachfolger;
END IF;
ELSE -- ansonsten wird normal eingefuegt
s1 := top.nachfolger;
s2 := top.nachfolger.nachfolger;
index := 0;
WHILE index <= stack_counter-1 LOOP
IF wert >= s1.inhalt and wert <= s2.inhalt THEN
feld.vorgaenger := s1;
feld.nachfolger := s2;
s1.nachfolger := feld;
s2.vorgaenger := feld;
feld.inhalt := wert;
ELSE
s1 := s1.nachfolger;
s2 := s2.nachfolger;
END IF
index := index + 1;
END LOOP;
END IF;
END IF;
stack_counter := stack_counter + 1;
END push;
PROCEDURE rotate IS -- Diese Prozedur zeigt alle
index : integer; -- Elemente des Stacks an
BEGIN
FOR index IN 1..stack_counter LOOP
PUT(top.inhalt);
PUT_LINE("");
top := top.vorgaenger;
END LOOP;
END ROTATE;
FUNCTION pop RETURN integer IS
s1 : zeiger;
s2 : zeiger;
wert : integer;
BEGIN
IF stack_counter = 1 THEN
wert := top.inhalt;
top := null;
END IF;
IF stack_counter > 1 THEN
wert := top.inhalt;
s1 := top.vorgaenger;
s2 := top.nachfolger;
top := s1;
s1.nachfolger := s2;
s2.vorgaenger := s1;
END IF;
IF stack_counter = 0 THEN
PUT_LINE("ausgegebener Wert ist Falsch, da der Stack leer ist!");
-- wo nichts ist, kann auch nichts ausgegeben werden
END IF;
stack_counter := stack_counter - 1;
RETURN wert;
END;
FUNCTION empty RETURN boolean IS -- Ist der Stack leer?
BEGIN
RETURN top = null;
END empty;