 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
Ferdi
Anmeldungsdatum: 10.03.2007
Beiträge: 284
Wohnort: Berlin
|
 Verfasst am: 12.03.2007, 19:43 Titel: Bildschirm drehen |
 |
|
Hallo Läute,
ich progge gerade einen Flugsimulator in QBasic und habe ein
kleines Problem(chen): Da sich Flugzeuge bekanntlich bei einer
Kurve drehen, sollte das in meinem Flusi auch so sein leider weiß
ich nicht wie ich das anstellen soll 
Kann mir mal jemand helfen?
Danke |
|
| Nach oben |
|
 |
Skilltronic
Anmeldungsdatum: 10.09.2004
Beiträge: 1148
Wohnort: Köln
|
| Verfasst am: 12.03.2007, 23:20 Titel: |
|
|
Hallo und Wilkommen im Forum!
Also ich denke, dazu musst du die kartesischen xy-Koordinaten der Grafik in polare (Radius und Winkel) umwandeln, dann drehen, zurückwandeln und neu zeichnen. Da steckt aber ein ziemlicher Rechenaufwand (SIN, COS und ATN) dahinter, was das Ganze - vor allem mit QB - recht langsam macht.
Gruß
Skilltronic
_________________
Elektronik und QB? www.skilltronics.de ! |
|
| Nach oben |
|
|
Eisbaer
Anmeldungsdatum: 16.10.2004
Beiträge: 354
Wohnort: Deutschland,Bayern
|
| Verfasst am: 13.03.2007, 00:21 Titel: Flugsimulator |
|
|
Auf der Seite von Triton gibt es eine nette kleine Spielerei dazu;
FSim43 - genialer 3D Flugsimulator!
http://www.silizium-net.de/downspie.htm
evt. ist das was für dich..
oder
Flight - Beste QB Flugsimulation die ich je gesehen habe!!!
Grüße Eisbaer
_________________
Eigene Webseite:
http://www.eisbaer-studios.de |
|
| Nach oben |
|
|
Elvis
Anmeldungsdatum: 01.06.2006
Beiträge: 818
Wohnort: Deutschland, BW
|
| Verfasst am: 13.03.2007, 19:15 Titel: |
|
|
Ich habe mir zwar die Links von Eisbaer nicht genau angesehen, würde dir
aber eine möglichst in Assembler oder C/C++ geschriebene Lib empfehlen,
die dann Rechenaufwändige Abschnitte für QBasic übernimmt. 
Am besten wäre es natürlich, wenn du sie selbst schreiben könntest, was
ich aber kaum glaube... 
Grüße, Elvis |
|
| Nach oben |
|
|
Ferdi
Anmeldungsdatum: 10.03.2007
Beiträge: 284
Wohnort: Berlin
|
| Verfasst am: 14.03.2007, 17:42 Titel: |
|
|
Danke, dass ihr mir geantwortet habt!!!
Welche Lib würdest du mir denn empfehlen??
Die Routiene kann ich wirklich nicht selber schreiben
SCHADE  |
|
| Nach oben |
|
|
Elvis
Anmeldungsdatum: 01.06.2006
Beiträge: 818
Wohnort: Deutschland, BW
|
| Verfasst am: 14.03.2007, 21:31 Titel: |
|
|
Keine Ahnung... 
Sie muss lediglich schnell rechnen können, also eine Mathe-Lib...
Grüße, Elvis |
|
| Nach oben |
|
|
Ferdi
Anmeldungsdatum: 10.03.2007
Beiträge: 284
Wohnort: Berlin
|
| Verfasst am: 16.03.2007, 17:22 Titel: |
|
|
Reicht UGL aus??
Wenn nicht kann mir mal jemand eine Routine schreiben
oder mir ein paar gute Tips zum schreiben dieser Routine
geben??
Danke im Vorraus |
|
| Nach oben |
|
|
dreael
Administrator
Anmeldungsdatum: 10.09.2004
Beiträge: 2529
Wohnort: Hofen SH (Schweiz)
|
| Verfasst am: 16.03.2007, 21:40 Titel: |
|
|
| Skilltronic hat Folgendes geschrieben: | | Da steckt aber ein ziemlicher Rechenaufwand (SIN, COS und ATN) dahinter, was das Ganze - vor allem mit QB - recht langsam macht. |
Grundsätzlich völlig korrekt im Zeitalter, wo QB von der Technologie aktuell war - sprich 286er/386er-DOS-Zeitalter - noch tatsächlich undenkbar damals ohne Assembler.
Inzwischen aber hat sich dank mit 3,4 GHz getakteten Pentium D-Prozessoren die Situation dramatisch geändert, dass heutzutage selbst ohne Compiler genügend Geschwindigket für Animationen vorhanden sind.
@Ferdi: In Deinem Fall lautet das Stichwort Koordinatentransformation, wofür man sich in der Linearen Algebra entsprechend auskennen sollte, speziell, was eine Matrix aus 3 orthogonal zueinanderstehenden Einheitsvektoren (in QB übrigens ein herrliches Beispiel für TYPE!) ist. Ebenso ist Knowhow im Bereich Zentralprojektion notwendig: Der Bildschirm stellt quasi eine im Raum schwebende Ebene dar, auf welcher Du die momentan gesehene Landschaft draufprojezierst.
Vielleicht kannst Du uns ja sonst einmal einen Zwischenstand Deines Projekts auf einen Webspace hochladen, damit wir hineinschauen können. Ansonsten kann ich Dir aus meiner Sammlung folgende Beispiele aus dem Bereich 3D und Zentralprojektion anbieten:
http://www.dreael.ch/Deutsch/Download/Labyrinth.html
http://www.dreael.ch/Deutsch/Download/Pyramide3D.html
Ferner steckt noch im Projekt
http://www.dreael.ch/Deutsch/Download/Funktionsdarstellung.html
ebenfalls etwas für Dich wertvolles: Dreieck-Zeichenroutine (Unterprogramm), welche auch Kommastellen berücksichtigt, was die Darstellung von noch weit entfernten Landschaftsobjekten viel präziser darstellt, als wenn man nur eine eine Integerkoordinaten-Polygonroutine verwendet.
_________________
Teste die PC-Sicherheit mit www.sec-check.net |
|
| Nach oben |
|
|
darkinsanity
aka sts
Anmeldungsdatum: 01.11.2006
Beiträge: 456
|
| Verfasst am: 18.03.2007, 19:17 Titel: |
|
|
| Ich hab irgendwo noch Sub´s rumfliegen, drei davon können einen Punkt im 3D Raum drehen und eine die einen Punkt im 2D drehen kann, (um eine bestimmte Koordinate) bei interesse Mail an info@greensoft.de.vu |
|
| Nach oben |
|
|
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 18.03.2007, 19:19 Titel: |
|
|
hm, wieso stellst du's nicht einfach hier rein bzw ladest die datei hoch? dafür ist ein forum doch da andere könnten den source auch gebrauchen.
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
 |
|
| Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 18.03.2007, 19:20 Titel: |
|
|
ein einzelnen Punkt um eine bestimmte achse zu drehen ist nicht so kompliziert, aber ein ganzes Bild so ohne Lib, da muss man schon 'ne gute und vorallem schnelle berechnung basteln, sonst schläft man ein *gg*
_________________
 |
|
| Nach oben |
|
|
darkinsanity
aka sts
Anmeldungsdatum: 01.11.2006
Beiträge: 456
|
| Verfasst am: 19.03.2007, 15:47 Titel: |
|
|
Ich such den Source mal...
Man könnte doch die einzelnen Punkte nehmen, drehen und wieder zeichnen, da gibts so en befehl, fällt mir aber grad nicht ein. Problem ist allerdings die Geschwindigkeit. Aber auf neueren PC´s sollte das doch klappen, oder??
wenn nicht, da gibts so en Programm das wandelt QBASIC in C um, habs noch nicht getestet, aber das müsste das ganze doch schneller machen, oder? |
|
| Nach oben |
|
|
Elvis
Anmeldungsdatum: 01.06.2006
Beiträge: 818
Wohnort: Deutschland, BW
|
| Verfasst am: 19.03.2007, 15:52 Titel: |
|
|
Solche Auto-Compiler produzieren glaube ich keinen so besonders guten
Code...
Aber ausschliessen will ich es trotzdem nicht...
Grüße, Elvis |
|
| Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 19.03.2007, 16:17 Titel: |
|
|
Hab gerade mal 'n Verusch gemacht, aber da ist irgendwie der Wurm drinne, ist allerdings auch FreeBASIC...
| Code: |
CONST PI AS DOUBLE = 3.1415926535897932/180
Screen 18,32,2
Bload "Test.bmp"
CenterX=320
CenterY=240
Dim Read_Scr as UByte
Dim Write_Scr as UByte
Read_Scr=0 : Write_Scr=1
While Inkey$<>Chr$(27)
For y=0 to 479
For x=0 to 639
ScreenSet Read_Scr,Write_Scr
XX=0-CenterX+x
YY=0-CenterY+y
Col=Point(x,y)
ScreenSet Write_Scr,Write_Scr
NewX=Cos(Winkel*pi)*XX
NewY=Sin(Winkel*pi)*YY
NewX=CenterX+NewX
NewY=CenterY+NewY
If NewX>-1 and NewY>-1 and NewX<640 and NewY<480 Then Pset (NewX,NewY),Col
Next x
Next y
Winkel=Winkel+1
If Winkel=360 then Winkel=0
Wend
sleep
|
Habs nicht so mit komplexer Mathematik
_________________
|
|
| Nach oben |
|
|
Skilltronic
Anmeldungsdatum: 10.09.2004
Beiträge: 1148
Wohnort: Köln
|
| Verfasst am: 19.03.2007, 16:45 Titel: |
|
|
Hallo
Also ich glaube, da ist in mehrfacher Hinsicht der Wurm drin. Erstens ist das Verfahren, den ganzen Bildschirm Pixelweise zu drehen eher ungeeignet. Für einen Flugsimulator o.ä. ist es besser, die Koordinaten für die angezeigten Objekte, z.B. die Eckpunkte von Polygonen oder so zu drehen und so ein neues Bild zu zeichnen. So muss auch nur ein Bruchteil der Berechnungen ausgeführt werden, als wenn man den ganzen Bildschirm dreht.
Ausserdem müsstest du bei deiner Methode erstmal den Ausgangswinkel und Abstand zum Mittelpunkt für jedes Pixel berechnen. Das meinte ich mit wandeln in Polarkoordinaten. Für 3D sogar mit 2 Winkeln und einem Radius.
Ach ja, den Wert von Pi brauchst du nicht unbedingt auszuschreiben. Probier mal das:
| Code: | pi# = 4 * ATN(1)
PRINT pi# |
Gruß
Sklilltronic
_________________
Elektronik und QB? www.skilltronics.de ! |
|
| Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 19.03.2007, 16:49 Titel: |
|
|
Ja, gut ist die Routine nicht, auch wenn sie funktionieren würde, es ging mir eigentlich dabei um einen einfachen test, aber der ist gründlich daneben gegangen
Das mit dem ATN hatte ich schon wieder vergessen 
_________________
|
|
| Nach oben |
|
|
Ferdi
Anmeldungsdatum: 10.03.2007
Beiträge: 284
Wohnort: Berlin
|
| Verfasst am: 20.03.2007, 21:05 Titel: |
|
|
Tja, leider bin ich noch überhaupt nicht fertig mit meinem Flusi und wenn ihr meinen Quellcode sehen würdet, würdet ihr umfallen
Der ist so schlecht geschrieben
Aber ich mach es (nur weil ihr es seid):
| Code: | 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!)
'//-------------------------- KONSTANTEN ----------------------------
CONST FOCUS = 255 ' Entfernung Betrachter->Projektionsfl„che
CONST DEGtoRAD = 3.141593 / 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 kamera(9) AS KAMERA3D ' unsere Kamera...
DIM Dreieck(9) AS FACETRI3D ' Dreieck im Objektraum
DIM TransDreieck(9) AS FACETRI3D ' Datenstruktur f?r transformiertes Dreieck
DIM Alpha AS SINGLE ' Rotationswinkel um den Dreieck im Objektraum gedreht werden soll
DIM Taste$ ' hier speichern wir die von INKEY$ erhaltene Taste
'// Die Start x1 und y1 Koordinaten f?r den Horizont
y1 = 50
y2 = 50
'// Videomodus f?r 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 9
RotiereXYZFACETRI3D Dreieck(bb), 0, 0, Alpha, TransDreieck(bb)
NEXT bb
'// Transformiertes Dreieck in den Kameraraum transformieren
FOR BBB = 1 TO 9
VerschiebeKameraFACETRI3D TransDreieck(BBB), kamera(BBB), TransDreieck(BBB)
NEXT BBB
'// Projizieren und Zeichnen
IF genug% < 9 THEN
FOR b = 1 TO 9
RANDOMIZE TIMER
Dreieck(b).p1.x = INT(RND * 1000) + -1000
Dreieck(b).p1.y = INT(RND * 1000) + -1000
Dreieck(b).p1.z = INT(RND * 0) + 1000
'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
ZeichneFACETRI3D TransDreieck(b), 4
genug% = genug% + 1
NEXT b
END IF
IF genug% >= 9 THEN
FOR baeume = 1 TO 9
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 TransDreieck(baeume), 4
NEXT baeume
END IF
'// 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)
'// Hier nehmen wir die Tastatureingabe
'// vom Benutzer entgegen. Derzeit noch mit INKEY$
Taste$ = INKEY$
'// Bewegung entlang positiver Z-Achse (vorw„rts)?
IF (Taste$ = CHR$(0) + CHR$(62)) THEN
Geschwindigkeit% = 200
END IF
IF (Taste$ = CHR$(0) + CHR$(61)) THEN
Geschwindigkeit = Geschwindigkeit + 10
END IF
'// Bewegung entlang negativer Z-Achse (r?ckw„rts)?
'// Dies ist eine unbeschriebene Funktion, die in
'// der Wirklichkein nicht stattfindet :-)
IF (Taste$ = "s") THEN
Geschwindigkeit = Geschwindigkeit - 10
END IF
IF (Taste$ = CHR$(0) + CHR$(60)) THEN
Geschwindigkeit = Geschwindigkeit - 10
END IF
'// Bewegung entlang positiver X-Achse (rechts)?
IF (Taste$ = CHR$(0) + CHR$(77)) THEN
Rechts = Rechts + 10
END IF
'// Bewegung entlang negativer X-Achse (links)?
IF (Taste$ = CHR$(0) + CHR$(75)) THEN
Rechts = Rechts - 10
END IF
'// Bewegung entlang positiver Y-Achse (unten)?
IF (Taste$ = CHR$(0) + CHR$(80)) THEN
Unten = Unten - 10
y1 = y1 - 1
y2 = y2 - 1
KKKKK = 9
END IF
'// bewegung entlang negativen Y-Achse (oben)?
IF (Taste$ = CHR$(0) + CHR$(72)) THEN
Unten = Unten + 10
y1 = y1 + 1
y2 = y2 + 1
END IF
IF (Taste$ = CHR$(27)) THEN '//Wenn Escape-Taste
Ende% = 1 ' gedr?ckt dann
END IF ' Ende% = 1
'// [("Alle")] Baume verschieben
kamera(K).Position.z = kamera(K).Position.z + Geschwindigkeit%
kamera(KKK).Position.x = kamera(KKK).Position.x + Rechts
kamera(KKKKK).Position.y = kamera(KKKKK).Position.y + Unten
'// Good old Doublebuffering...
PCOPY 0, 1
CLS
'//Abbruch bei Druck auf Escape-Taste
LOOP UNTIL Ende% = 1
Ende:
'// zur?ck in den Textmodus (sch”ne Variante)
SCREEN 0
WIDTH 80, 25
END
SUB Nacht (y1)
VIEW SCREEN (1, 1)-(319, 199)
AnzahlDerSterne% = 1000
FOR Sterne = 1 TO AnzahlDerSterne%
sternX = INT(RND * 400) + 1
sterny = INT(RND * y1) + 1
PSET (sternX, sterny), 15
NEXT Sterne
VIEW
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 Tag (y1, y2)
'PRINT "SUB Tag aufgerufen"
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
'// 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.p1, Vektor, NeuDreieck.p1
VerschiebePUNKT3D Dreieck.p2, Vektor, NeuDreieck.p2
VerschiebePUNKT3D Dreieck.p3, Vektor, NeuDreieck.p3
VerschiebePUNKT3D Dreieck.p4, Vektor, NeuDreieck.p4
VerschiebePUNKT3D Dreieck.p5, Vektor, NeuDreieck.p5
VerschiebePUNKT3D Dreieck.p6, Vektor, NeuDreieck.p6
VerschiebePUNKT3D Dreieck.p7, Vektor, NeuDreieck.p7
VerschiebePUNKT3D Dreieck.p8, Vektor, NeuDreieck.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 m?ssen!!!
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 eines Dreiecks 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
LINE (xp1, yp1)-(xp2, yp2), 2
LINE (xp2, yp2)-(xp3, yp3), 2
LINE (xp3, yp3)-(xp1, yp1), 2
LINE (xp4, yp4)-(xp6, yp6), 6
LINE (xp5, yp5)-(xp7, yp7), 6
LINE (xp6, yp6)-(xp7, yp7), 6
' LINE (xp7, yp7)-(xp8, yp8), 6
xx = xp1
yy = yp1 + 5
'PAINT (xx, yy), 2
END SUB
|
Ich habe das Tuturial von Mario Zechner gelesen und habe das halbe Programm übernommen 
Wie ihr bestimmt sehen könnt kann ich zwar ein paar Bäume zeichnen aber nicht bewegen 
Vieleicht könnt ihr mir dabei auch helfen |
|
| Nach oben |
|
|
Ferdi
Anmeldungsdatum: 10.03.2007
Beiträge: 284
Wohnort: Berlin
|
| Verfasst am: 30.08.2007, 17:42 Titel: |
|
|
Hab die halben Sommerferien an meinem Flusi gearbeitet.
Hier der verbesserte Code:
| Code: | 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%
AnzahlDerBaeume% = 90
'// 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%
RANDOMIZE B
Dreieck(B).p1.x = Max% 'INT((Max% - -Max% + 1) * RND + -Max%) '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%)
VIEW SCREEN (1, 1)-(319, 199)
AnzahlDerSterne% = 1000
FOR Sterne = 1 TO AnzahlDerSterne%
'sternX = INT(RND * 400) + 1
'sternY = INT(RND * y1%) + 1
PSET (sternX, sternY), 15
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
|
Das "Baumproblen is jetz auch gelöst.
Davür ein neues Problem:
Bei
| Code: | FOR B = genug% TO AnzahlDerBaeume%
RANDOMIZE B
Dreieck(B).p1.x = Max% 'INT((Max% - -Max% + 1) * RND + -Max%) '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
|
Kommt "Index außerhalb der Bereiches"
Wie löse ich das Problem???
|
|
| Nach oben |
|
|
Mao
Anmeldungsdatum: 25.09.2005
Beiträge: 4409
Wohnort: /dev/hda1
|
| Verfasst am: 30.08.2007, 18:00 Titel: |
|
|
| Code: | | FOR B = genug% TO AnzahlDerBaeume%-1 |
Versuch's mal damit. 
Das Array Dreieck enthält zwar 900 Elemente, aber diese gehen von 0 bis 899.
Deine Bäume zählst du aber wahrscheinlich von 1 an.
(Btw, wäre es nicht besser, du würdest MaxBaeume% als Konstante verwenden?)
_________________
Eine handvoll Glück reicht nie für zwei.
--
 |
|
| Nach oben |
|
|
Ferdi
Anmeldungsdatum: 10.03.2007
Beiträge: 284
Wohnort: Berlin
|
| Verfasst am: 30.08.2007, 18:36 Titel: |
|
|
Danke!
Probiere es gleich aus.
Das mit der Konstante werd ich auch gleich einbauen.
|
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
