Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Mein Flusi
| Uploader: |  Ferdi |
| Datum/Zeit: | 10.09.2007 17:16:10 |
DECLARE SUB BOOM ()
DECLARE SUB Motor (Geschwindigkeit%)
DECLARE SUB DrawFlugzeug (Geschwindigkeit%, Neigung1%, Hoehe%, starttime!, Stroemungsabriss%, Variometer%)
DECLARE SUB Tag (y1%, y2%)
DECLARE SUB Nacht (y1%)
DECLARE SUB VerschiebeKameraFACETRI3D (Dreieck AS ANY, kamera AS ANY, NeuDreieck AS ANY)
DECLARE SUB VerschiebeFACETRI3D (Dreieck AS ANY, Vektor AS ANY, NeuDreieck AS ANY)
DECLARE SUB SkaliereFACETRI3D (Dreieck AS ANY, Skalarx AS SINGLE, Skalary AS SINGLE, Skalarz AS SINGLE, NeuDreieck AS ANY)
DECLARE SUB ZeichneFACETRI3D (Dreieck AS ANY, Farbe AS INTEGER)
DECLARE SUB RotiereXYZFACETRI3D (Dreieck AS ANY, Alpha AS SINGLE, Beta AS SINGLE, Gamma AS SINGLE, NeuDreieck AS ANY)
DECLARE SUB VerschiebePUNKT3D (Punkt AS ANY, Vektor AS ANY, NeuPunkt AS ANY)
DECLARE SUB SkalierePUnkt3D (Punkt AS ANY, Skalarx AS SINGLE, Skalary AS SINGLE, Skalarz AS SINGLE, NeuPunkt AS ANY)
DECLARE SUB RotiereXPUNKT3D (Punkt AS ANY, Beta AS SINGLE, NeuPunkt AS ANY)
DECLARE SUB RotiereYPUNKT3D (Punkt AS ANY, Gamma AS SINGLE, NeuPunkt AS ANY)
DECLARE SUB RotiereZPUNKT3D (Punkt AS ANY, Alpha AS SINGLE, NeuPunkt AS ANY)
DECLARE SUB RotiereXYZPuNKT3D (Punkt AS ANY, Alpha AS SINGLE, Beta AS SINGLE, Gamma AS SINGLE, NeuPunkt AS ANY)
DECLARE SUB Wolke1 (x%, y%)
DECLARE SUB Neigung (Wert%)
DECLARE SUB Variomet (Wert%)
DECLARE SUB Speed (Wert%)
DECLARE SUB Alt (Wert%)
DECLARE SUB LoadJMP (f$)
DECLARE SUB DrawHilfen (Geschwindigkeit%, Neigung1%, Hoehe%, Variometer%, Stroemungsabriss%)
'//-------------------------- KONSTANTEN ----------------------------
CONST FOCUS = 200 '255 ' Entfernung Betrachter->Projektionsfl„che
CONST DEGtoRAD = 3.14159265358979# / 180 ' "Grad in Bogenmaá"-Konstante
'//-------------------------- DATENTYPEN ---------------------------
TYPE PUNKT3D
x AS SINGLE
y AS SINGLE
z AS SINGLE
END TYPE
TYPE VEKTOR3D
x AS SINGLE
y AS SINGLE
z AS SINGLE
END TYPE
TYPE FACETRI3D
p1 AS PUNKT3D
p2 AS PUNKT3D
p3 AS PUNKT3D
p4 AS PUNKT3D
p5 AS PUNKT3D
p6 AS PUNKT3D
p7 AS PUNKT3D
p8 AS PUNKT3D
END TYPE
TYPE KAMERA3D
Position AS PUNKT3D
Xrot AS SINGLE
Yrot AS SINGLE
Zrot AS SINGLE
END TYPE
'// ------------------------ VARIABLEN FšR DEMO ----------------------
DIM SHARED MaxBaeume%
MaxBaeume% = 900
DIM SHARED kamera AS KAMERA3D ' unsere Kamera...
DIM SHARED Dreieck(MaxBaeume%) AS FACETRI3D ' Dreieck im Objektraum
DIM SHARED TransDreieck(MaxBaeume%) AS FACETRI3D ' Datenstruktur fr transformiertes Dreieck
DIM SHARED Alpha AS SINGLE ' Rotationswinkel um den Dreieck im Objektraum gedreht werden soll
DIM SHARED Taste$ ' hier speichern wir die von INKEY$ erhaltene Taste
'DIM SHARED starttime ' Startzeit des Flugsimulators
DIM SHARED Vektor AS VEKTOR3D
DIM SHARED Neigung1% ' Die Neigung des Flugzeugs
DIM SHARED Variometer% ' Steigung
DIM vorher(MaxBaeume%)
'starttime! = TIMER ' Startzeit des Flugsimulators
DIM SHARED AnzahlDerBaeume%
DIM SHARED SternX(1000) AS INTEGER
DIM SHARED SternY(1000) AS INTEGER
AnzahlDerBaeume% = 90
FOR I = 1 TO 1000 - 1
SternX% = INT(RND * 1000) + 1
SternY% = INT(RND * 1000) + 1
NEXT I
'// Die Start x1 und y1 Koordinaten fr den Horizont
y1% = 50
y2% = 50
'################################INTRO########################################
CLS
WIDTH 80, 50
SCREEN 13
CLS
'LoadJMP "C:\FFSSetup\I2.jmp"
'PRINT "Das ist der Flughafen Seattle"
'SLEEP
'LoadJMP "C:\FFSSetup\I1.jmp"
'LOCATE 24, 1
'PRINT "Steigen Sie in ihre neue Cessna ein und fliegen Sie los."
'SLEEP
'// Videomodus fr Doublebuffering initialisieren
SCREEN 7, , 0, 1
'// Hauptschleife
DO
'// Rotationswinkel um die Y-Achse erh”hen
'// und vermeiden, dass wir einen šberlauf kriegen
'Alpha = Alpha + 1 'Stillgelegt
'IF Alpha >= 360 THEN Alpha = 0
'// Dreieck im Objektraum drehen
'FOR bb = 1 TO AnzahlDerBaeume%
'RotiereXYZFACETRI3D Dreieck(bb), Alpha, Beta, Gamma, TransDreieck(bb)
'NEXT bb
'// Transformiertes Dreieck in den Kameraraum transformieren
FOR BBB = 1 TO AnzahlDerBaeume%
VerschiebeKameraFACETRI3D TransDreieck(BBB), kamera, TransDreieck(BBB)
NEXT BBB
'// Projizieren und Zeichnen
'
'Das ist ein bisschen kompliziert. Eine kleine Erl„uterung:
' P2
' /\
' / \
' / \
' / \
' / \
'P1----------P3
' P5| |P4
' | |
' | |
' | |
' | |
' P7--P6
'
'Das soll ein BAUM sein. Die ganzen Ps sind die Punkte
'Die Verteilung der Baume geschieht per Zufallszahlen
IF genug% < AnzahlDerBaeume% THEN
RANDOMIZE TIMER
'Max% = INT((10000 - 1000 + 1) * RND + 1000)
'IF ErsteRunde% = 0 THEN
' Max% = INT((3 - 2) + 1) * RND + 2
' ErsteRunde% = 1
'ELSE
' IF Max3% = 1 THEN
' Max% = 2
' Max2% = 0
' END IF
' IF Max2% = 1 THEN
' Max% = 3
' Max3% = 0
' END IF
' IF Max% = 3 THEN
' Max% = 1000
' Max3% = 1
' Max2% = 0
' END IF
' IF Max% = 2 THEN
' Max% = 100
' Max2% = 1
' Max3% = 0
' END IF
'END IF
FOR B = genug% TO (AnzahlDerBaeume% - 1)
RANDOMIZE B
Dreieck(B).p1.x = INT(RND * 10000) + -10000
Dreieck(B).p1.y = INT(RND * 100) + -100
Dreieck(B).p1.z = INT(RND * 0) + 10000
'Dreieck.p1.x = -40: Dreieck.p1.y = -40: Dreieck.p1.z = 0
Dreieck(B).p2.x = Dreieck(B).p1.x + 40: Dreieck(B).p2.y = Dreieck(B).p1.y + 80: Dreieck(B).p2.z = Dreieck(B).p1.z
Dreieck(B).p3.x = Dreieck(B).p1.x + 80: Dreieck(B).p3.y = Dreieck(B).p1.y: Dreieck(B).p3.z = Dreieck(B).p1.z
Dreieck(B).p4.x = Dreieck(B).p1.x + 48: Dreieck(B).p4.y = Dreieck(B).p1.y: Dreieck(B).p4.z = Dreieck(B).p1.z
Dreieck(B).p5.x = Dreieck(B).p1.x + 40: Dreieck(B).p5.y = Dreieck(B).p1.y: Dreieck(B).p5.z = Dreieck(B).p1.z
Dreieck(B).p6.x = Dreieck(B).p1.x + 48: Dreieck(B).p6.y = Dreieck(B).p1.y - 40: Dreieck(B).p6.z = Dreieck(B).p1.z
Dreieck(B).p7.x = Dreieck(B).p1.x + 40: Dreieck(B).p7.y = Dreieck(B).p1.y - 40: Dreieck(B).p7.z = Dreieck(B).p1.z
IF ERR = 9 THEN
PRINT "Leider ist ein Technischer Fehler aufgetreten"
SLEEP 2
RUN
END IF
'ZeichneFACETRI3D Dreieck(B), 4
genug% = genug% + 1
z = z + 1
NEXT B
END IF
IF genug% >= AnzahlDerBaeume% THEN
FOR ba = 1 TO AnzahlDerBaeume%
Dreieck(ba).p2.x = Dreieck(ba).p1.x + 40: Dreieck(ba).p2.y = Dreieck(ba).p1.y + 80: Dreieck(ba).p2.z = Dreieck(ba).p1.z
Dreieck(ba).p3.x = Dreieck(ba).p1.x + 80: Dreieck(ba).p3.y = Dreieck(ba).p1.y: Dreieck(ba).p3.z = Dreieck(ba).p1.z
Dreieck(ba).p4.x = Dreieck(ba).p1.x + 48: Dreieck(ba).p4.y = Dreieck(ba).p1.y: Dreieck(ba).p4.z = Dreieck(ba).p1.z
Dreieck(ba).p5.x = Dreieck(ba).p1.x + 40: Dreieck(ba).p5.y = Dreieck(ba).p1.y: Dreieck(ba).p5.z = Dreieck(ba).p1.z
Dreieck(ba).p6.x = Dreieck(ba).p1.x + 48: Dreieck(ba).p6.y = Dreieck(ba).p1.y - 40: Dreieck(ba).p6.z = Dreieck(ba).p1.z
Dreieck(ba).p7.x = Dreieck(ba).p1.x + 40: Dreieck(ba).p7.y = Dreieck(ba).p1.y - 40: Dreieck(ba).p7.z = Dreieck(ba).p1.z
ZeichneFACETRI3D Dreieck(ba), 4
NEXT ba
END IF
'Und hier wird berprft, ob die B„ume berhaupt zu sehen sind
FOR B = 1 TO AnzahlDerBaeume%
IF Dreieck(B).p1.z <= 0 THEN
'genug% = genug% - 1
RANDOMIZE B
Dreieck(B).p1.x = INT((1000 - -1000 + 1) * RND + -5000)
Dreieck(B).p1.y = INT(RND * 100) + -100
Dreieck(B).p1.z = INT(RND * 0) + 10000
'Dreieck.p1.x = -40: Dreieck.p1.y = -40: Dreieck.p1.z = 0
Dreieck(B).p2.x = Dreieck(B).p1.x + 30: Dreieck(B).p2.y = Dreieck(B).p1.y + 70: Dreieck(B).p2.z = Dreieck(B).p1.z
Dreieck(B).p3.x = Dreieck(B).p1.x + 80: Dreieck(B).p3.y = Dreieck(B).p1.y: Dreieck(B).p3.z = Dreieck(B).p1.z
Dreieck(B).p4.x = Dreieck(B).p1.x + 48: Dreieck(B).p4.y = Dreieck(B).p1.y: Dreieck(B).p4.z = Dreieck(B).p1.z
Dreieck(B).p5.x = Dreieck(B).p1.x + 40: Dreieck(B).p5.y = Dreieck(B).p1.y: Dreieck(B).p5.z = Dreieck(B).p1.z
Dreieck(B).p6.x = Dreieck(B).p1.x + 48: Dreieck(B).p6.y = Dreieck(B).p1.y - 40: Dreieck(B).p6.z = Dreieck(B).p1.z
Dreieck(B).p7.x = Dreieck(B).p1.x + 40: Dreieck(B).p7.y = Dreieck(B).p1.y - 40: Dreieck(B).p7.z = Dreieck(B).p1.z
END IF
IF Dreieck(B).p1.x = -1500 OR Dreieck(B).p1.z < 30 THEN
genug% = genug% - 1
RANDOMIZE B
Dreieck(B).p1.x = INT((1000 - -1000 + 1) * RND + -5000)
Dreieck(B).p1.y = INT(RND * 100) + -100
Dreieck(B).p1.z = INT(RND * 0) + 10000
'Dreieck.p1.x = -40: Dreieck.p1.y = -40: Dreieck.p1.z = 0
Dreieck(B).p2.x = Dreieck(B).p1.x + 40: Dreieck(B).p2.y = Dreieck(B).p1.y + 80: Dreieck(B).p2.z = Dreieck(B).p1.z
Dreieck(B).p3.x = Dreieck(B).p1.x + 80: Dreieck(B).p3.y = Dreieck(B).p1.y: Dreieck(B).p3.z = Dreieck(B).p1.z
Dreieck(B).p4.x = Dreieck(B).p1.x + 48: Dreieck(B).p4.y = Dreieck(B).p1.y: Dreieck(B).p4.z = Dreieck(B).p1.z
Dreieck(B).p5.x = Dreieck(B).p1.x + 40: Dreieck(B).p5.y = Dreieck(B).p1.y: Dreieck(B).p5.z = Dreieck(B).p1.z
Dreieck(B).p6.x = Dreieck(B).p1.x + 48: Dreieck(B).p6.y = Dreieck(B).p1.y - 40: Dreieck(B).p6.z = Dreieck(B).p1.z
Dreieck(B).p7.x = Dreieck(B).p1.x + 40: Dreieck(B).p7.y = Dreieck(B).p1.y - 40: Dreieck(B).p7.z = Dreieck(B).p1.z
END IF
IF Dreieck(B).p1.y = -10 OR Dreieck(B).p1.y = 50 THEN
genug% = genug% - 10
RANDOMIZE B
Dreieck(B).p1.x = INT((1000 - -1000 + 1) * RND + -5000)
Dreieck(B).p1.y = INT(RND * 100) + -100
Dreieck(B).p1.z = INT(RND * 0) + 10000
'Dreieck.p1.x = -40: Dreieck.p1.y = -40: Dreieck.p1.z = 0
Dreieck(B).p2.x = Dreieck(B).p1.x + 40: Dreieck(B).p2.y = Dreieck(B).p1.y + 80: Dreieck(B).p2.z = Dreieck(B).p1.z
Dreieck(B).p3.x = Dreieck(B).p1.x + 80: Dreieck(B).p3.y = Dreieck(B).p1.y: Dreieck(B).p3.z = Dreieck(B).p1.z
Dreieck(B).p4.x = Dreieck(B).p1.x + 48: Dreieck(B).p4.y = Dreieck(B).p1.y: Dreieck(B).p4.z = Dreieck(B).p1.z
Dreieck(B).p5.x = Dreieck(B).p1.x + 40: Dreieck(B).p5.y = Dreieck(B).p1.y: Dreieck(B).p5.z = Dreieck(B).p1.z
Dreieck(B).p6.x = Dreieck(B).p1.x + 48: Dreieck(B).p6.y = Dreieck(B).p1.y - 40: Dreieck(B).p6.z = Dreieck(B).p1.z
Dreieck(B).p7.x = Dreieck(B).p1.x + 40: Dreieck(B).p7.y = Dreieck(B).p1.y - 40: Dreieck(B).p7.z = Dreieck(B).p1.z
END IF
NEXT B
IF mehrBaeume% = 1 THEN
'LOCATE 1, 1: PRINT "Mehr Baeume"
'AnzahlDerBaeume% = AnzahlDerBaeume% + 90
IF Runde% = 10 THEN
Hallo% = 1
Runde% = Runde% + 1
IF Runde% > 10 THEN
Runde% = 1
END IF
END IF
END IF
IF Hallo% = 1 THEN
AnzahlDerBaeume% = AnzahlDerBaeume% + 90
END IF
IF AnzahlDerBaeume% >= MaxBaeume% THEN
AnzahlDerBaeume% = MaxBaeume%
END IF
CALL DrawFlugzeug(Geschwindigkeit%, Neigung1%, Hoehe%, starttime!, Stroemungsabriss%, Variometer%)
LINE (1, 1)-(400, 35), 0, BF
Alt (Hoehe%)
Speed (Geschwindigkeit%)
Neigung (Neigung1%)
Variomet (Variometer%)
'// Wetterdaten auswerten
Wetter$ = "Tag"
IF Wetter$ = "Tag" THEN
CALL Tag(y1%, y2%)
ELSE
CALL Nacht(y1%)
END IF
'// Wolken zeichnen
CALL Wolke1(100, y1% - 25)
CALL Wolke1(150, y1% - 20)
CALL Wolke1(200, y1% - 40)
LINE (0, 150)-(320, 150), 8
LINE (20, 150)-(0, 0), 8
LINE (300, 150)-(320, 0), 8
LINE (160, 150)-(120, 0), 8
LINE (160, 150)-(200, 0), 8
LINE (0, 1)-(320, 1), 8
PAINT (10, 149), 8
PAINT (160, 147), 8
PAINT (310, 148), 8
PAINT (3, 0), 8
PAINT (122, 0), 8
PAINT (222, 0), 8
PAINT (5, 151), 8, 15
'LINE (1, y1%)-(400, y1%), 0, BF
CALL DrawHilfen(Geschwindigkeit%, Neigung1%, Hoehe%, Variometer%, Stroemungsabriss%)
'// Hier nehmen wir die Tastatureingabe
'// vom Benutzer entgegen. Derzeit noch mit INKEY$
FOR f = 1 TO AnzahlDerBaeume%
vorher(f) = Dreieck(f).p1.z
NEXT f
Taste$ = INKEY$
'// Bewegung entlang positiver Z-Achse (vorw„rts)?
IF (Taste$ = CHR$(0) + CHR$(62)) THEN 'F4-Taste
'FOR j = 1 TO 9
' Dreieck(j).p1.z = Dreieck(j).p1.z + 1
'NEXT j
mehr% = mehr% + AnzahlDerBaeume%
Geschwindigkeit% = 200
Vektor.z = 200
END IF
'// Bewegung entlang der negativen Z-Achse (rckw„rts)?
IF (Taste$ = CHR$(0) + CHR$(59)) THEN 'F1-Taste ?
Geschwindigkeit% = 0
Vektor.z = 0
END IF
IF (Taste$ = CHR$(0) + CHR$(61)) THEN 'F3-Taste
'FOR j = 1 TO 9
' Dreieck(j).p1.z = Dreieck(j).p1.z + 1
'NEXT j
mehr% = mehr% + AnzahlDerBaeume%
IF Geschwindigkeit% < 200 THEN
Geschwindigkeit% = Geschwindigkeit% + 1
Vektor.z = Vektor.z + 1
END IF
IF Geschwindigkeit% < 0 THEN Geschwindigkeit% = 0
END IF
'// Bewegung entlang negativer Z-Achse (rckw„rts)?
'// Dies ist eine unbeschriebene Funktion, die in
'// der Wirklichkein nicht stattfindet
IF (Taste$ = "s") THEN
'FOR j = 1 TO 9
' Dreieck(j).p1.z = Dreieck(j).p1.z + 1
'NEXT j
Geschwindigkeit% = Geschwindigkeit% - 1
Vektor.z = Vektor.z - 1
END IF
IF (Taste$ = CHR$(0) + CHR$(60)) THEN 'F2-Taste
'FOR j = 1 TO 9
' Dreieck(j).p1.z = Dreieck(j).p1.z - 1
'NEXT j
Geschwindigkeit% = Geschwindigkeit% - 1
Vektor.z = Vektor.z - 1
IF Geschwindigkeit% < 0 THEN Geschwindigkeit% = 0
END IF
'// Bewegung entlang positiver X-Achse (Rechts%)?
IF (Taste$ = CHR$(0) + CHR$(77)) THEN '
'FOR j = 1 TO 9
' Dreieck(j).p1.x = Dreieck(j).p1.x - 1
'NEXT j
Beta = Beta + 10
Neigung1% = Neigung1% + 10
Rechts% = Rechts% + 10
Vektor.x = Vektor.x + 10
IF Rechts% > 360 THEN Rechts% = 0
END IF
'// Bewegung entlang negativer X-Achse (links)?
IF (Taste$ = CHR$(0) + CHR$(75)) THEN
'FOR j = 1 TO 9
' Dreieck(j).p1.x = Dreieck(j).p1.x + 1
'NEXT j
Beta = Beta - 10
Neigung1% = Neigung1% - 10
Rechts% = Rechts% - 10
Vektor.x = Vektor.x - 10
IF Rechts% < -360 THEN Rechts% = 0
END IF
'// Bewegung entlang positiver Y-Achse (unten)?
IF (Taste$ = CHR$(0) + CHR$(80)) THEN
'FOR j = 1 TO 9
' Dreieck(j).p1.y = Dreieck(j).p1.y - 1
'NEXT j
'Unten = Unten - 10
Variometer% = Variometer% - 1
'Vektor.y = Vektor.y - 10
IF Unten < 0 THEN Unten = 0
y1% = y1% - 1
y2% = y2% - 1
IF y1% < 0 THEN y1% = 0
IF y2% < 0 THEN y2% = 0
END IF
'// bewegung entlang negativen Y-Achse (oben)?
IF (Taste$ = CHR$(0) + CHR$(72)) THEN
'FOR j = 1 TO 9
' Dreieck(j).p1.y = Dreieck(j).p1.y + 1
'NEXT j
'Unten = Unten + 10
Variometer% = Variometer% + 1
Vektor.y = Vektor.y + 10
y1% = y1% + 1
y2% = y2% + 1
IF Unten < 0 THEN Unten = 0
END IF
'//Str”mungsabriss?
IF Variometer% > 50 OR Variometer% < -50 THEN
Stroemungsabriss% = 1
ELSE Stroemungsabriss% = 0
END IF
IF Taste$ = "o" THEN
Variometer% = 0
END IF
IF (Taste$ = CHR$(27)) THEN '//Wenn Escape-Taste
Ende% = 1 ' gedrckt dann
END IF ' Ende% = 1
Hoehe% = Hoehe% + Variometer%
IF Hoehe% = 0 AND Variometer% < -10 THEN
CALL BOOM
END IF
IF Hoehe% < 0 THEN
Hoehe% = 0
Variometer% = 0
END IF
y1% = y1% + Variometer
IF y1% < 0 THEN
y1% = 0
END IF
'// [("Alle")] Baume verschieben
FOR GG = 1 TO AnzahlDerBaeume%
Vektor.z = Geschwindigkeit%
Vektor.x = Rechts%
Vektor.y = Hoehe%
kamera.Position.z = Geschwindigkeit%
kamera.Position.x = Rechts%
kamera.Position.y = Hoehe%
'CALL VerschiebeFACETRI3D(Dreieck(GG), Vektor, Dreieck(GG))
'CALL VerschiebeKameraFACETRI3D(Dreieck(GG), kamera, Dreieck(GG))
Dreieck(GG).p1.z = Dreieck(GG).p1.z - Geschwindigkeit%
Dreieck(GG).p1.x = Dreieck(GG).p1.x - Rechts%
Dreieck(GG).p1.y = -Hoehe% 'Dreieck(GG).p1.Y - Hoehe%
'y2% = y2% + Unten
IF vorher(GG) <> Dreieck(GG).p1.z THEN
mehrBaeume% = 1
ELSE
mehrBaeume% = 0
END IF
IF Hoehe% < 252 AND Dreieck(GG).p1.z = 0 THEN
CALL BOOM
END IF
NEXT GG
'LOCATE 1, 1
'PRINT "AnzahlDerBaeume%:";
'PRINT AnzahlDerBaeume%
'PRINT "Hallo:" + STR$(Hallo%) + " ";
'PRINT "MehrBaeume:" + STR$(mehtBaeume%) + " ";
'PRINT "Runde: " + STR$(Runde%) + " ";
'Bitte etwas Warten...
'time! = TIMER
'DO: LOOP UNTIL TIMER - time! = .05
'// Good old Doublebuffering...
PCOPY 0, 1
CLS
'//Abbruch bei Druck auf Escape-Taste
LOOP UNTIL Ende% = 1
Ende:
'// zurck in den Textmodus (sch”ne Variante)
SCREEN 0
WIDTH 80, 25
END
SUB Alt (Wert%)
w = 30: h = 30: y = 17: x = 17
BYTES = 30 * 30 + 4
FOM = INT((BYTES + 1) / 1)
o = 0
DIM frame(FOM - 1, 1 TO 11) AS INTEGER
OPEN "C:\Alt.qaa" FOR INPUT AS #1
DO
INPUT #1, a, B, f
PSET (a, B), f
LOOP UNTIL EOF(1)
CLOSE
'SLEEP
'FOR ax = 1 TO 10
'LINE (16, 384)-(336, 416), 0, BF
'NEXT
FOR x = 17 TO (16 * 17) + 32 STEP 32
o = o + 1
LINE (x - 16, y - 16)-(x + 16, y + 16), 0, B
GET (x - 16, y - 16)-(x + 16, y + 16), frame(0, o)
NEXT x
dx = 0
dy = 0
o = 1
I = 5
'--------|
x = 50 '|
'....... |
y = 170 '|
'--------|
'DO
' a$ = ""
' WHILE a$ = ""
' a$ = INKEY$
'WEND
IF Wert% > 9 AND Wert% < 100 THEN Wert% = Wert% / 10
IF Wert% > 100 AND Wert% < 1000 THEN Wert% = Wert% / 100
dx = 0
dx = 1: o = Wert% + 1: I = 0
IF a$ = CHR$(27) THEN END
IF o > 9 THEN o = 1
IF I > 9 THEN I = 1
IF dx = 1 THEN PUT (x - 16, y - 16), frame(0, o), PSET
IF dx = -1 THEN PUT (x - 16, y - 16), frame(0, I), PSET
x = x - dx * 0
'IF INKEY$ = CHR$(27) THEN EXIT SUB
'LOOP
END SUB
SUB BOOM
CLS
SCREEN 0
COLOR 0, 4
CLS
WIDTH 80, 25
FOR y = 1 TO 25
FOR x = 1 TO 80
LOCATE y, x
PRINT "BOOM "
NEXT x
NEXT y
SLEEP
CLS
FOR Farbe = 1 TO 15
COLOR Farbe
IF Farbe = 4 THEN
COLOR 19
END IF
PRINT "Bitte Drcken Sie eine Taste zum berspringen"
PRINT "ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ"
PRINT ""
PRINT ""
PRINT "ÛÛÛ ÛÛÛ ÛÛÛ ÛÛ ÛÛ"
PRINT "Û Û Û Û Û Û Û Û Û Û"
PRINT "Û Û Û Û Û Û Û Û Û Û"
PRINT "Û Û Û Û Û Û Û Û Û"
PRINT "ÛÛÛ Û Û Û Û Û Û Û"
PRINT "Û Û Û Û Û Û Û Û"
PRINT "Û Û Û Û Û Û Û Û"
PRINT "Û Û Û Û Û Û Û Û"
PRINT "ÛÛÛ ÛÛÛ ÛÛÛ Û Û"
SLEEP 1
NEXT Farbe
SLEEP
END
END SUB
SUB DrawFlugzeug (Geschwindigkeit%, Neigung1%, Hoehe%, starttime!, Stroemungsabriss%, Variometer%)
'LINE (0, 150)-(320, 150), 8
'LINE (20, 150)-(0, 0), 8
'LINE (300, 150)-(320, 0), 8
'LINE (160, 150)-(120, 0), 8
'LINE (160, 150)-(200, 0), 8
'LINE (0, 1)-(320, 1), 8
'PAINT (10, 149), 8
'PAINT (160, 147), 8
'PAINT (310, 148), 8
'PAINT (160, 160), 8
'PAINT (3, 0), 8
'PAINT (122, 0), 8
'PAINT (222, 0), 8
COLOR 10', 8
LOCATE 25, 12
'PRINT "Geschwindigkeit%: ";
PRINT Geschwindigkeit%
LOCATE 25, 18
'PRINT "Neigung: ";
'PRINT Rechts%!;
PRINT Neigung1%
LOCATE 25, 6
'PRINT "H”he: ";
PRINT Hoehe%
LOCATE 25, 24
'PRINT "Variometer:";
PRINT Variometer%
'LOCATE 1, 24
'COLOR 4, 0
'PRINT "Start: ";
'PRINT starttime! / 60 ^ 2
LOCATE 23, 1
IF Stroemungsabriss% = 1 THEN
LOCATE 22, 26
COLOR 4, 0
PRINT "Str”mungsabriss"
Stroemungsabriss% = 0
END IF
'CALL Motor(Geschwindigkeit%)
COLOR 15, 0
END SUB
SUB DrawHilfen (Geschwindigkeit%, Neigung1%, Hoehe%, Variometer%, Stroemungsabriss%)
LOCATE 25, 12
'PRINT "Geschwindigkeit%: ";
PRINT Geschwindigkeit%
LOCATE 25, 18
'PRINT "Neigung: ";
'PRINT Rechts%!;
PRINT Neigung1%
LOCATE 25, 6
'PRINT "H”he: ";
PRINT Hoehe%
LOCATE 25, 24
'PRINT "Variometer:";
PRINT Variometer%
'LOCATE 1, 24
'COLOR 4, 0
'PRINT "Start: ";
'PRINT starttime! / 60 ^ 2
LOCATE 23, 1
IF Stroemungsabriss% = 1 THEN
LOCATE 22, 26
COLOR 4, 0
PRINT "Str”mungsabriss"
Stroemungsabriss% = 0
END IF
END SUB
SUB LoadJMP (f$)
'+------SYNTAX-------+
'| F$ - Eingabedatei |
'+-------------------+
CLOSE #1
DIM Byte AS STRING * 1, id AS STRING * 8
OPEN f$ FOR INPUT AS #1: CLOSE #1
OPEN f$ FOR BINARY AS #1
GET #1, 1, id
IF id = "JMP10QB" + CHR$(4) THEN 'Standard: Farben 0-15 bzw. 0-255
GET #1, 9, Byte '<== Cursorposition in Datei setzen fr lesen der Palette
Farbe1 = 0
Anzahl = ASC(Byte) ' und Farbanzahl festsetzen
ELSEIF id = "JMP10QB" + CHR$(1) THEN 'NEU: Farben, die ver„ndert werden sollen, k”nnen festgelegt werden
GET #1, , Byte: Farbe1 = ASC(Byte) 'Farbe 1
GET #1, , Byte: Anzahl = ASC(Byte) 'Farbe 2
ELSEIF id = "JMP10QB" + CHR$(2) THEN 'Graue Palette (Normal) Syntax wie oben
GET #1, 9, Byte
Farbe1 = 0
Anzahl = ASC(Byte)
ELSEIF id = "JMP10QB" + CHR$(3) THEN 'Graue Palette (Extra) Syntax wie oben
GET #1, , Byte: Farbe1 = ASC(Byte) 'Farbe 1
GET #1, , Byte: Anzahl = ASC(Byte) 'Farbe 2
ELSE
CLS : LOCATE 1: COLOR 15: PRINT "No JMP-File!": END
END IF
'Lese Palette
IF id = "JMP10QB" + CHR$(2) OR id = "JMP10QB" + CHR$(3) THEN
FOR Attr = Farbe1 TO Anzahl: OUT &H3C8, Attr
GET #1, , Byte: FOR RGB1 = 1 TO 3: OUT &H3C9, ASC(Byte)
NEXT RGB1, Attr
ELSE
FOR Attr = Farbe1 TO Anzahl: OUT &H3C8, Attr
FOR RGB1 = 1 TO 3: GET #1, , Byte: OUT &H3C9, ASC(Byte)
NEXT RGB1, Attr
END IF
IF id = "JMP10QB" + CHR$(4) THEN
IF Anzahl = 15 THEN Start = 60 ELSE Start = 800
ELSEIF id = "JMP10QB" + CHR$(2) THEN
IF Anzahl = 15 THEN Start = 26 ELSE Start = 266
ELSEIF id = "JMP10QB" + CHR$(3) THEN
Start = 10 + (Anzahl - Farbe1 + 1) + 5
ELSE
Start = 10 + (Anzahl - Farbe1 + 1) * 3 + 5
END IF
'Bitmap
GET #1, Start, Xsize: GET #1, , Ysize
GET #1, Start + 9, Byte '<== Cursorposition in Datei setzen fr lesen der Farben
FOR x = 0 TO Xsize
Row$ = SPACE$(Ysize + 1): GET #1, , Row$
FOR y = 0 TO Ysize
PSET (x, y), ASC(MID$(Row$, y + 1, 1))
NEXT y, x
CLOSE
END SUB
SUB Motor (Geschwindigkeit%)
'Das ist ein Versuch ein anst„ndiges Motorenger„usch
'zu erzeugen. Is'n bischen Nervig, deswegen habe ich es
'auch herausgenommen. Wer lust hat es fertig zu Programmieren
'kann dies auch tun. Es w„hre nett wenn man's mir zu Mailen
'wrde. Viel Spaá :-D
'SELECT CASE Geschwindigkeit%
' CASE 0 TO 50
' SOUND 65.5, 1
' CASE 50 TO 100
' SOUND 98, 1
' CASE 100 TO 150
' SOUND 147, 1
' CASE 150 TO 200
' SOUND 196, 1
'END SELECT
'Zweiter versuch:
IF Geschwindigkeit% > 0 THEN
'SOUND Geschwindigkeit% + 50, 2
END IF
END SUB
SUB Nacht (y1%)
FOR Sterne = 1 TO 1000 - 1
IF SternY > y1% THEN
PSET (SternX%, SternY%), 15
END IF
NEXT Sterne
VIEW
END SUB
SUB Neigung (Wert%)
w = 30: h = 30: y = 17: x = 17
BYTES = 30 * 30 + 4
FOM = INT((BYTES + 1) / 1)
o = 0
DIM frame(FOM - 1, 1 TO 11) AS INTEGER
OPEN "C:\Neigung.qaa" FOR INPUT AS #1
DO
INPUT #1, a, B, f
PSET (a, B), f
LOOP UNTIL EOF(1)
CLOSE
'SLEEP
'FOR ax = 1 TO 10
LINE (16, 384)-(336, 416), 0, BF
'NEXT
FOR x = 17 TO (16 * 17) + 32 STEP 32
o = o + 1
LINE (x - 16, y - 16)-(x + 16, y + 16), 0, B
GET (x - 16, y - 16)-(x + 16, y + 16), frame(0, o)
NEXT x
dx = 0
dy = 0
o = 1
I = 5
'--------|
x = 150 '|
'....... |
y = 170 '|
'--------|
'DO
' a$ = ""
' WHILE a$ = ""
' a$ = INKEY$
'WEND
IF Wert% > 9 AND Wert% < 100 THEN Wert% = Wert% / 10
IF Wert% > 100 AND Wert% < 1000 THEN Wert% = Wert% / 100
IF Wert% < 0 THEN Wert% = Wert% * -1
IF Wert% < -9 AND Wert% < -100 THEN Wert% = (Wert% / 10) * -1
IF Wert% < -100 AND Wert% < -1000 THEN Wert% = (Wert% / 100) * -1
dx = 0
dx = 1: o = Wert% + 1: I = 0
IF a$ = CHR$(27) THEN END
IF o > 9 THEN o = 1
IF I > 9 THEN I = 1
IF dx = 1 THEN PUT (x - 16, y - 16), frame(0, o), PSET
IF dx = -1 THEN PUT (x - 16, y - 16), frame(0, I), PSET
x = x - dx * 0
'IF INKEY$ = CHR$(27) THEN EXIT SUB
'LOOP
END SUB
'// Funktion: RotiereXPUNKT3D
'//
'// Beschreibung: Rotiert den šbergebenen Punkt um den Winkel Beta um die
'// X-Achse und speichert das Ergebnis in NeuPunkt
'//---------------------------------------------------------------------------
SUB RotiereXPUNKT3D (Punkt AS PUNKT3D, Beta AS SINGLE, NeuPunkt AS PUNKT3D)
NeuPunkt.x = Punkt.x
NeuPunkt.y = Punkt.y * COS(DEGtoRAD * Beta) - Punkt.z * SIN(DEGtoRAD * Beta)
NeuPunkt.z = Punkt.y * SIN(DEGtoRAD * Beta) + Punkt.z * COS(DEGtoRAD * Beta)
END SUB
'// Funktion: RotiereXYZFACETRI3D
'//
'// Beschreibung: Rotiert das bergebene Dreieck um die Winkel Alpha, Beta und
'// Gamma um die Z-, X- und Y-Achse und speichert das Ergebnis
'// in NeuDreieck
'//---------------------------------------------------------------------------
SUB RotiereXYZFACETRI3D (Dreieck AS FACETRI3D, Alpha AS SINGLE, Beta AS SINGLE, Gamma AS SINGLE, NeuDreieck AS FACETRI3D)
RotiereXYZPuNKT3D Dreieck.p1, Alpha, Beta, Gamma, NeuDreieck.p1
RotiereXYZPuNKT3D Dreieck.p2, Alpha, Beta, Gamma, NeuDreieck.p2
RotiereXYZPuNKT3D Dreieck.p3, Alpha, Beta, Gamma, NeuDreieck.p3
RotiereXYZPuNKT3D Dreieck.p4, Alpha, Beta, Gamma, NeuDreieck.p4
RotiereXYZPuNKT3D Dreieck.p5, Alpha, Beta, Gamma, NeuDreieck.p5
RotiereXYZPuNKT3D Dreieck.p6, Alpha, Beta, Gamma, NeuDreieck.p6
RotiereXYZPuNKT3D Dreieck.p7, Alpha, Beta, Gamma, NeuDreieck.p7
RotiereXYZPuNKT3D Dreieck.p8, Alpha, Beta, Gamma, NeuDreieck.p8
END SUB
'// Funktion: RotiereXYZPUNKT3D
'//
'// Beschreibung: Rotiert den šbergebenen Punkt um die Winkel Alpha, Beta und
'// Gamma um die Z-, X- und Y-Achse und speichert das Ergebnis
'// in NeuPunkt
'//---------------------------------------------------------------------------
SUB RotiereXYZPuNKT3D (Punkt AS PUNKT3D, Alpha AS SINGLE, Beta AS SINGLE, Gamma AS SINGLE, NeuPunkt AS PUNKT3D)
DIM ptemp1 AS PUNKT3D
DIM ptemp2 AS PUNKT3D
RotiereYPUNKT3D Punkt, Gamma, ptemp1
RotiereXPUNKT3D ptemp1, Beta, ptemp2
RotiereZPUNKT3D ptemp2, Alpha, NeuPunkt
END SUB
'// Funktion: RotiereYPUNKT3D
'//
'// Beschreibung: Rotiert den šbergebenen Punkt um den Winkel Gamma um die
'// Y-Achse und speichert das Ergebnis in NeuPunkt
'//---------------------------------------------------------------------------
SUB RotiereYPUNKT3D (Punkt AS PUNKT3D, Gamma AS SINGLE, NeuPunkt AS PUNKT3D)
NeuPunkt.x = Punkt.z * SIN(DEGtoRAD * Gamma) + Punkt.x * COS(DEGtoRAD * Gamma)
NeuPunkt.y = Punkt.y
NeuPunkt.z = Punkt.z * COS(DEGtoRAD * Gamma) - Punkt.x * SIN(DEGtoRAD * Gamma)
END SUB
'// Funktion: RotiereZPUNKT3D
'//
'// Beschreibung: Rotiert den šbergebenen Punkt um den Winkel Alpha um die
'// Z-Achse und speichert das Ergebnis in NeuPunkt
'//---------------------------------------------------------------------------
SUB RotiereZPUNKT3D (Punkt AS PUNKT3D, Alpha AS SINGLE, NeuPunkt AS PUNKT3D)
NeuPunkt.x = Punkt.y * SIN(DEGtoRAD * Alpha) + Punkt.x * COS(DEGtoRAD * Alpha)
NeuPunkt.y = Punkt.y * COS(DEGtoRAD * Alpha) - Punkt.x * SIN(DEGtoRAD * Alpha)
NeuPunkt.z = Punkt.z
END SUB
'// Funktion: SkaliereFACETRI3D
'//
'// Beschreibung: Skaliert das bergebene Dreieck um die Skalare Skalarx,
'// Skalary und Skalarz auf den drei Achsen und speichert
'// das Ergebnis in NeuDreieck
'//---------------------------------------------------------------------------
SUB SkaliereFACETRI3D (Dreieck AS FACETRI3D, Skalarx AS SINGLE, Skalary AS SINGLE, Skalarz AS SINGLE, NeuDreieck AS FACETRI3D)
SkalierePUnkt3D Dreieck.p1, Skalarx, Skalary, Skalarz, NeuDreieck.p1
SkalierePUnkt3D Dreieck.p2, Skalarx, Skalary, Skalarz, NeuDreieck.p2
SkalierePUnkt3D Dreieck.p3, Skalarx, Skalary, Skalarz, NeuDreieck.p3
SkalierePUnkt3D Dreieck.p4, Skalarx, Skalary, Skalarz, NeuDreieck.p4
SkalierePUnkt3D Dreieck.p5, Skalarx, Skalary, Skalarz, NeuDreieck.p5
SkalierePUnkt3D Dreieck.p6, Skalarx, Skalary, Skalarz, NeuDreieck.p6
SkalierePUnkt3D Dreieck.p7, Skalarx, Skalary, Skalarz, NeuDreieck.p7
SkalierePUnkt3D Dreieck.p8, Skalarx, Skalary, Skalarz, NeuDreieck.p8
END SUB
'// Funktion: SkaliereFACETRI3D
'//
'// Beschreibung: Skaliert den bergebenen Punkt um die Skalare Skalarx,
'// Skalary und Skalarz auf den drei Achsen und speichert
'// das Ergebnis in NeuPunkt
'//---------------------------------------------------------------------------
SUB SkalierePUnkt3D (Punkt AS PUNKT3D, Skalarx AS SINGLE, Skalary AS SINGLE, Skalarz AS SINGLE, NeuPunkt AS PUNKT3D)
NeuPunkt.x = Punkt.x * Skalarx
NeuPunkt.y = Punkt.y * Skalary
NeuPunkt.z = Punkt.z * Skalarz
END SUB
SUB Speed (Wert%)
w = 30: h = 30: y = 17: x = 17
BYTES = 30 * 30 + 4
FOM = INT((BYTES + 1) / 1)
o = 0
DIM frame(FOM - 1, 1 TO 11) AS INTEGER
OPEN "C:\Speed.qaa" FOR INPUT AS #2
DO
INPUT #2, a, B, f
'PSET (a, B), f
LOOP UNTIL EOF(2)
CLOSE
'FOR ax = 1 TO 10
' LINE (16, 384)-(336, 416), 0, BF
'NEXT
FOR x = 17 TO (16 * 17) + 32 STEP 32
o = o + 1
'LINE (x - 16, y - 16)-(x + 16, y + 16), 0, B
GET (x - 16, y - 16)-(x + 16, y + 16), frame(0, o)
NEXT x
dx = 0
dy = 0
o = 1
I = 5
'---------|
x = 100 '|
'....... |
y = 170 '|
'---------|
IF Wert% > 9 AND Wert% < 100 THEN Wert% = Wert% / 10
IF Wert% > 100 AND Wert% < 1000 THEN Wert% = Wert% / 100
IF Wert% < 0 THEN Wert% = Wert% * -1
IF Wert% < -9 AND Wert% < -100 THEN Wert% = (Wert% / 10) * -1
IF Wert% < -100 AND Wert% < -1000 THEN Wert% = (Wert% / 100) * -1
dx = 0
dx = 1: o = Wert% + 1: I = 0
IF o > 9 THEN o = 1
IF I > 9 THEN I = 1
IF dx = 1 THEN PUT (x - 16, y - 16), frame(0, o), PSET
IF dx = -1 THEN PUT (x - 16, y - 16), frame(0, I), PSET
x = x - dx * 0
IF INKEY$ = CHR$(27) THEN EXIT SUB
END SUB
SUB Tag (y1%, y2%)
'PRINT "SUB Tag aufgerufen"
y1% = y2%
y2% = y1%
IF y1% AND y2% <= 0 THEN
EXIT SUB
END IF
LINE (0, y1%)-(400, y2%), 1
PAINT (1, 1), 1
CIRCLE (10, y1% - 20), 16, 14
PAINT (15, y1% - 30), 14
END SUB
SUB Variomet (Wert%)
w = 30: h = 30: y = 17: x = 17
BYTES = 30 * 30 + 4
FOM = INT((BYTES + 1) / 1)
o = 0
DIM frame(FOM - 1, 1 TO 11) AS INTEGER
OPEN "C:\Variomet.qaa" FOR INPUT AS #1
DO
INPUT #1, a, B, f
PSET (a, B), f
LOOP UNTIL EOF(1)
CLOSE
'SLEEP
'FOR ax = 1 TO 10
'LINE (16, 384)-(336, 416), 0, BF
'NEXT
FOR x = 17 TO (16 * 17) + 32 STEP 32
o = o + 1
LINE (x - 16, y - 16)-(x + 16, y + 16), 0, B
GET (x - 16, y - 16)-(x + 16, y + 16), frame(0, o)
NEXT x
dx = 0
dy = 0
o = 1
I = 5
'--------|
x = 200 '|
'....... |
y = 170 '|
'--------|
'DO
' a$ = ""
' WHILE a$ = ""
' a$ = INKEY$
'WEND
IF Wert% > 9 AND Wert% < 100 THEN Wert% = Wert% / 10
IF Wert% > 100 AND Wert% < 1000 THEN Wert% = Wert% / 100
IF Wert% < 0 THEN Wert% = Wert% * -1
IF Wert% < -9 AND Wert% < -100 THEN Wert% = (Wert% / 10) * -1
IF Wert% < -100 AND Wert% < -1000 THEN Wert% = (Wert% / 100) * -1
dx = 0
dx = 1: o = Wert% + 1: I = 0
IF a$ = CHR$(27) THEN END
IF o > 9 THEN o = 1
IF I > 9 THEN I = 1
IF dx = 1 THEN PUT (x - 16, y - 16), frame(0, o), PSET
IF dx = -1 THEN PUT (x - 16, y - 16), frame(0, I), PSET
x = x - dx * 0
'IF INKEY$ = CHR$(27) THEN EXIT SUB
'LOOP
END SUB
'// Funktion: VerschiebeFACETRI3D
'//
'// Beschreibung: Verschiebt das bergebene Dreieck um den angegebenen
'// Vektor und speichert das Ergebnis in NeuDreieck
'//
'//---------------------------------------------------------------------------
SUB VerschiebeFACETRI3D (Dreieck AS FACETRI3D, Vektor AS VEKTOR3D, NeuDreieck AS FACETRI3D)
VerschiebePUNKT3D Dreieck(GG).p1, Vektor, Dreieck(GG).p1
VerschiebePUNKT3D Dreieck(GG).p2, Vektor, Dreieck(GG).p2
VerschiebePUNKT3D Dreieck(GG).p3, Vektor, Dreieck(GG).p3
VerschiebePUNKT3D Dreieck(GG).p4, Vektor, Dreieck(GG).p4
VerschiebePUNKT3D Dreieck(GG).p5, Vektor, Dreieck(GG).p5
VerschiebePUNKT3D Dreieck(GG).p6, Vektor, Dreieck(GG).p6
VerschiebePUNKT3D Dreieck(GG).p7, Vektor, Dreieck(GG).p7
VerschiebePUNKT3D Dreieck(GG).p8, Vektor, Dreieck(GG).p8
END SUB
'// Funktion: VerschiebeKameraFACETRI3D
'//
'// Beschreibung: Verschiebt das bergebene Dreieck um die inverse
'// Kameraposition in vom Weltraum in den Kameraraum
'// rotiert es um die negativen Rotationswinkel der
'// Kameraachsen und speichert das Ergebnis in NeuDreieck
'//---------------------------------------------------------------------------
SUB VerschiebeKameraFACETRI3D (Dreieck AS FACETRI3D, kamera AS KAMERA3D, NeuDreieck AS FACETRI3D)
DIM KameraVektor AS VEKTOR3D
'// den inversen Vektor aus der Kameraposition
'// erstellen um den das Dreieck verschoben wird
KameraVektor.x = -kamera.Position.x
KameraVektor.y = -kamera.Position.y
KameraVektor.z = -kamera.Position.z
'// Alle Punkte des Dreiecks verschieben...
VerschiebeFACETRI3D Dreieck, KameraVektor, NeuDreieck
'// ...und um den Ursprung um die negativen
'// Rotationswinkel rotieren. Beachtet das
'// wir die Winkel nach Alpha (z), Beta (x), Gamma(y) bergeben mssen!!!
RotiereXYZFACETRI3D NeuDreieck, -kamera.Zrot, -kamera.Xrot, -kamera.Yrot, NeuDreieck
END SUB
'// Funktion: VerschiebePUNKT3D
'//
'// Beschreibung: Verschiebt den bergebenen Punkt um den angegebenen
'// Vektor und speichert das Ergebnis in NeuPunkt
'//
'//---------------------------------------------------------------------------
SUB VerschiebePUNKT3D (Punkt AS PUNKT3D, Vektor AS VEKTOR3D, NeuPunkt AS PUNKT3D)
NeuPunkt.x = Punkt.x + Vektor.x
NeuPunkt.y = Punkt.y + Vektor.y
NeuPunkt.z = Punkt.z + Vektor.z
END SUB
SUB Wolke (x, y)
RANDOMIZE TIMER
RadiusDerWolke1 = INT(RND * 16) + 8
RadiusDerWolke2 = INT(RND * 16) + 8
RadiusDerWolke3 = INT(RND * 16) + 8
xDerWolke2 = x - RadiusDerWolke1 + 9
yDerWolke2 = y '- RadiusDerWolke1 + 9
xDerWolke3 = x + RadiusDerWolke1 + 9
yDerWolke3 = y '+ RadiusDerWolke1 + 9
CIRCLE (x, y), RadiusDerWolke1
CIRCLE (xDerWolke2, yDerWolke2), RadiusDerWolke2
CIRCLE (xDerWolke3, yDerWolke3), RadiusDerWolke3
PAINT (x - 8, y - 8), 15
PAINT (xDerWolke2 + 3, yDerWolke2 + 3), 15
PAINT (xDerWolke3 + 3, yDerWolke3 + 3), 15
END SUB
SUB Wolke1 (x%, y%)
RadiusDer1Wolke = 16
RadiusDer2Wolke = 8
RadiusDer3Wolke = 10
xDer2Wolke = x% + 16
yDer2Wolke = y%
xDer3Wolke = x% - 10
yDer3Wolke = y%
CIRCLE (x%, y%), 15
CIRCLE (xDer2Wolke, yDer2Wolke), RadiusDer2Wolke, 15
CIRCLE (xDer3Wolke, yDer3Wolke), RadiusDer3Wolke, 15
PAINT (x% + 3, y% + 3), 15
PAINT (xDer2Wolke, yDer2Wolke), 15
PAINT (xDer3Wolke, yDer3Wolke), 15
PAINT (x% + 14, y%), 15
PAINT (xDer3Wolke - 8, yDer3Wolke - 1), 15
END SUB
'// Funktion: ZeichneFACETRI3D
'//
'// Beschreibung: Projiziert die Punkte der ganzen B„ume auf die Projektions-
'// fl„che (Bildschirmkoordinatensystem) und zeichnet die
'// die Verbindungslinien zwischen den Punkten (Drahtgitter-
'// modell)
'//---------------------------------------------------------------------------
SUB ZeichneFACETRI3D (Dreieck AS FACETRI3D, Farbe AS INTEGER)
DIM xp1, yp1
DIM xp2, yp2
DIM xp3, yp3
DIM xp4, yp4
DIM xp5, yp5
DIM xp6, yp6
DIM xp7, yp7
xp1 = Dreieck.p1.x * FOCUS / (FOCUS + Dreieck.p1.z) + 160
yp1 = -Dreieck.p1.y * FOCUS / (FOCUS + Dreieck.p1.z) + 100
xp2 = Dreieck.p2.x * FOCUS / (FOCUS + Dreieck.p2.z) + 160
yp2 = -Dreieck.p2.y * FOCUS / (FOCUS + Dreieck.p2.z) + 100
xp3 = Dreieck.p3.x * FOCUS / (FOCUS + Dreieck.p3.z) + 160
yp3 = -Dreieck.p3.y * FOCUS / (FOCUS + Dreieck.p3.z) + 100
xp4 = Dreieck.p4.x * FOCUS / (FOCUS + Dreieck.p4.z) + 160
yp4 = -Dreieck.p4.y * FOCUS / (FOCUS + Dreieck.p4.z) + 100
xp5 = Dreieck.p5.x * FOCUS / (FOCUS + Dreieck.p5.z) + 160
yp5 = -Dreieck.p5.y * FOCUS / (FOCUS + Dreieck.p5.z) + 100
xp6 = Dreieck.p6.x * FOCUS / (FOCUS + Dreieck.p6.z) + 160
yp6 = -Dreieck.p6.y * FOCUS / (FOCUS + Dreieck.p6.z) + 100
xp7 = Dreieck.p7.x * FOCUS / (FOCUS + Dreieck.p7.z) + 160
yp7 = -Dreieck.p7.y * FOCUS / (FOCUS + Dreieck.p7.z) + 100
xp8 = Dreieck.p8.x * FOCUS / (FOCUS + Dreieck.p8.z) + 160
yp8 = -Dreieck.p8.y * FOCUS / (FOCUS + Dreieck.p8.z) + 100
xp1$ = STR$(INT(xp1)): yp1$ = STR$(INT(yp1))
xp2$ = STR$(INT(xp2)): yp2$ = STR$(INT(yp2))
xp3$ = STR$(INT(xp3)): yp3$ = STR$(INT(yp3))
xp4$ = STR$(INT(xp4)): yp4$ = STR$(INT(yp4))
xp5$ = STR$(INT(xp5)): yp5$ = STR$(INT(yp5))
xp6$ = STR$(INT(xp6)): yp6$ = STR$(INT(yp6))
xp7$ = STR$(INT(xp7)): yp7$ = STR$(INT(yp7))
'Neigung:
'IF Neigung1% > 360 THEN Neigung% = 0
'IF Neigung1% < -360 THEN Neigung = 0
'Neigung$ = STR$(Neigung%)
'DRAW "TA" + STR$(Neigung%)
'DRAW "TA60"
LINE (xp1, yp1)-(xp2, yp2), 2
'DRAW "C4"
'DRAW "BM" + xp1$ + "," + yp1$ + ""
'DRAW "M" + xp2$ + "," + yp2$ + ""
LINE (xp2, yp2)-(xp3, yp3), 2
'DRAW "C4"
'DRAW "BM" + xp2$ + "," + yp2$ + ""
'DRAW "M" + xp3$ + "," + yp3$ + ""
LINE (xp3, yp3)-(xp1, yp1), 2
'DRAW "C4"
'DRAW "BM" + xp3$ + "," + yp3$ + ""
'DRAW "M" + xp1$ + "," + yp1$ + ""
LINE (xp4, yp4)-(xp6, yp6), 6
'DRAW "C6"
'DRAW "BM" + xp4$ + "," + yp4$ + ""
'DRAW "M" + xp6$ + "," + yp6$ + ""
LINE (xp5, yp5)-(xp7, yp7), 6
'DRAW "C6"
'DRAW "BM" + xp5$ + "," + yp5$ + ""
'DRAW "M" + xp7$ + "," + yp7$ + ""
LINE (xp6, yp6)-(xp7, yp7), 6
'DRAW "BM" + xp6$ + "," + yp6$ + ""
'DRAW "M" + xp7$ + "," + yp7$ + ""
' LINE (xp7, yp7)-(xp8, yp8), 6
xx = xp1
yy = yp1 + 5
'PAINT (xx, yy), 2, 2 , CHR$(77)
END SUB