Benutzer:Arbol01/Listings

Grafik

```/* Kreis */
pi = 3.141593
xn = 320
yn = 200
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
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
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
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
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

``` /* 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
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

```/* 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