Wikibooks

Benutzer:Arbol01/Listings

< Benutzer:Arbol01

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;
Abgerufen von „https://de.wikibooks.org/w/index.php?title=Benutzer:Arbol01/Listings&oldid=103847“