Welcome to Schneider / Amstrad CPC Forum. Please login or sign up.

28. March 2024, 13:48:40

Login with username, password and session length

Shoutbox

TFM

2024-01-15, 17:06:57
Momentan billige Farbbänder auf Ebay für PCW

Devilmarkus

2023-07-09, 10:37:40
Zweiter 👋😂🤣

TFM

2023-06-13, 14:21:49
Sommerloch!

TFM

2023-05-30, 17:00:20
Erster ;-)

Recent

Members
Stats
  • Total Posts: 11,653
  • Total Topics: 1,328
  • Online today: 80
  • Online ever: 1,724
  • (16. January 2020, 00:18:45)
Users Online
Users: 1
Guests: 93
Total: 94

93 Guests, 1 User
TFM

Raytracing auf dem CPC

Started by Devilmarkus, 09. February 2021, 13:59:21

Previous topic - Next topic

0 Members and 2 Guests are viewing this topic.

Devilmarkus

Hallo zusammen,
aktuell beschäftige ich mich mit Raytracing auf dem CPC.
Dazu habe ich ein MSX2 BASIC Programm für den CPC angepasst und bin noch dabei, daran zu Arbeiten.

Hier für Grünmonitore (Fertig soweit)
http://cpc-live.com/CPCBasic/gray.html?example=examples/graytracing

Farb-Raytracing (Natürlich grober)
http://cpc-live.com/CPCBasic/index.html?example=examples/raycolor

Die Listings könnt ihr euch jeweils von der Seite kopieren.

@MV: Ich habe mir dafür mal dein Tool "geborgt"... Falls du das nicht möchtest, bitte Info an mich, dann entferne ich es natürlich wieder von meinem Server.
Am echten CPC würde sowas locker 5-6 Stunden dauern, im emulierten CPC mit Turbo auch noch gut eine Stunde.
https://cpcwiki.de
Dein Deutsches CPCWiki!

HAL6128

Hallo Markus,
schönes Thema. Ich muss mal sehen, ob ich noch die Programme, die ich vor einiger Zeit hierzu (und them Thema Raycasting) geschrieben habe finde.

Devilmarkus

Ja, das wäre toll.... Bin mal gespannt!
https://cpcwiki.de
Dein Deutsches CPCWiki!

HAL6128

#3
So. Das erste Beispiel wäre zum Thema "Ray-Casting". Hier wird ja nur in der Ebene gerendert, d.h. die Kamera befindet sich in der Höhe immer an der gleichen Stelle. In dem Beispiel in BASIC befindest Du Dich in einem Raum in dem Du mit den Cursortasten umherwandern kannst. Die Szene wird nach dem Drücken der Pfeiltasten einen Schritt weiter in der entsprechenden Richtung immer wieder neu aufgebaut. Leider dauert das Aufbauen eines Bildschirm teilweise 20 Sekunden. Also, es ist schon etwas mühsam und nur für "Geduldige" durch den Raum zu wandern. In den DATA Statements am Ende wird der Raum definiert.
Die Engine hierzu ist aus einem Programmiertutorial für 3D Wolfenstein.


10 ON ERROR GOTO 1560
20 MODE 0
30 DEG
40 INK 0,0:BORDER 0:' Hintergrund und Border (schwarz)
50 INK 1,3:INK 2,6:' Farbe Rot in dunkel (3) und hell (6)
60 INK 3,11:INK 4,20:' Farbe Blau in dunkel (11) und hell (20)
70 INK 5,9:INK 6,18:' Farbe Gruen in dunkel (9) und hell (18)
80 INK 7,13:INK 8,26:' Farbe Weiss in dunkel (13) und hell (26)
90 INK 9,12:INK 10,24:' Farb Gelb in dunkel (12) und hell (24)
100 INK 11,23
110 winkel=15:' Rotationwinkel waehrend der Bewegung
120 mapwidth=24:mapheight=24
130 DIM worldmap$(mapwidth,mapheight)
140 'RESTORE 1310
150 FOR y=1 TO mapheight
160 FOR x=1 TO mapwidth
170 READ worldmap$(x,y)
180 'LOCATE x,y:PRINT worldmap$(x,y)
190 NEXT x
200 NEXT y
210 REM
220 REM variablendeklaration
230 REM
240 posx=22:posy=12:' Startposition = Position des Spielers
250 dirx=-1:diry=0:' Initialrichtung = Blickrichtung des Spielers
260 planex=0:planey=0.66:' 2D-Ebene der Kamera = Kameraebene des Spielers (senkrecht zur Richtung/Winkel atan(0.66/1.0)=66 Grad
270 newtime=0:' Zeitmessung 1 = aktuelle Zeit
280 oldtime=TIME/300:' Zeitmessung 2 = vergangene Zeit
290 breite=320:hoehe=200
300 REM
310 REM raycast
320 REM
330 WHILE INKEY(18)<>0
340 CLS:ORIGIN 0,0
350 GRAPHICS PEN 7:MOVE (640-breite)/2,(400-hoehe)/2:DRAWR breite,0:DRAWR 0,hoehe/2:DRAWR -breite,0:DRAWR 0,-hoehe/2:ORIGIN 0,0:MOVE
(640-breite),(400-hoehe)-5:FILL 7
360 GRAPHICS PEN 11:MOVE (640-breite)/2,(400-hoehe):DRAWR breite,0:DRAWR 0,hoehe/2:DRAWR -breite,0:DRAWR 0,-hoehe/2:ORIGIN 0,0:MOVE
(640-breite),(400-hoehe)+5:FILL 11
370 ORIGIN 0,0
380 FOR x=0 TO breite STEP 4
390 camerax=2*x/breite-1.01:'Umrechnung X-KO nach Kamera-KO >> -1 = links / 0 = mitte / 1 = rechts
400 rayposx=posx:'Initiierung des Rays auf Spierlpos.
410 rayposy=posy
420 raydirx=dirx+planex*camerax:'Vektorberechnung ray=origin+t*direction
430 raydiry=diry+planey*camerax:'das gleiche nur y
440 REM
450 REM variablendeklaration fuer raycast
460 REM
470 mapx=rayposx:'in welcher box der Karte befinden wir uns?
480 mapy=rayposy
490 'sidedistx:sidedisty / Initiierung Schrittweite zum naechsten Feld rechts/links/oben/unten
500 deltadistx=SQR(1+(raydiry*raydiry)/(raydirx*raydirx)):'berechnung vektorlaenge
510 deltadisty=SQR(1+(raydirx*raydirx)/(raydiry*raydiry))
520 'perpwalldist / Distanz zur Wand
530 'stepx:stepy / Richtung des Schrittes / entweder +1 oder -1
540 hit=0:'Schnitt mit Wand?
550 'side / welche seite NS oder EW
560 REM
570 REM berechnung schrittweite und erhoehung
580 REM
590 IF raydirx<0 THEN stepx=-1:sidedistx=(rayposx-mapx)*deltadistx ELSE stepx=1:sidedistx=(mapx+1-rayposx)*deltadistx:' immer einen
schritt links/rechts
600 IF raydiry<0 THEN stepy=-1:sidedisty=(rayposy-mapy)*deltadisty ELSE stepy=1:sidedisty=(mapy+1-rayposy)*deltadisty:' immer einen
schritt oben/unten
610 REM
620 REM hit-algorithmus (DDA)
630 REM
640 WHILE hit=0
650 IF sidedistx<sidedisty THEN sidedistx=sidedistx+deltadistx:mapx=mapx+stepx:side=0 ELSE sidedisty=sidedisty+deltadisty:mapy=mapy+
stepy:side=1:' springe zum naechsten feld
660 IF worldmap$(mapx,mapy)>"0" THEN hit=1
670 WEND
680 REM
690 REM berechnung distanz zur kamera
700 REM
710 IF side=0 THEN perpwalldist=ABS((mapx-rayposx+(1-stepx)/2)/raydirx) ELSE perpwalldist=ABS((mapy-rayposy+(1-stepy)/2)/raydiry)
720 REM
730 REM hoehenberechnung der wand
740 REM
750 lineheight=ABS(hoehe/perpwalldist)
760 REM
770 REM berechnet den hoechsten und niedrigsten Pixel
780 REM
790 drawstart=CINT(-1*lineheight/2+hoehe/2)
800 IF drawstart<0 THEN drawstart=0
810 drawend=CINT(lineheight/2+hoehe/2)
820 IF drawend>=hoehe THEN drawend=hoehe-1
830 REM
840 REM Definition der Farbe
850 REM Wand(1) = Rot / Box(2) = Gruen / Box(3) = Blau / Box(4) = Gelb / groesser 4 = weiss
860 REM
870 IF worldmap$(mapx,mapy)="1" AND side=1 THEN GRAPHICS PEN 2
880 IF worldmap$(mapx,mapy)="1" AND side=0 THEN GRAPHICS PEN 1
890 IF worldmap$(mapx,mapy)="2" AND side=1 THEN GRAPHICS PEN 6
900 IF worldmap$(mapx,mapy)="2" AND side=0 THEN GRAPHICS PEN 5
910 IF worldmap$(mapx,mapy)="3" AND side=1 THEN GRAPHICS PEN 4
920 IF worldmap$(mapx,mapy)="3" AND side=0 THEN GRAPHICS PEN 3
930 IF worldmap$(mapx,mapy)="4" AND side=1 THEN GRAPHICS PEN 10
940 IF worldmap$(mapx,mapy)="4" AND side=0 THEN GRAPHICS PEN 9
950 IF worldmap$(mapx,mapy)>"4" THEN GRAPHICS PEN 8
960 REM
970 REM Ausgabe
980 REM
990 MOVE (640-breite)/2+x,(400-hoehe)/2+drawstart:DRAWR 0,(drawend-drawstart)
1000 'PRINT#8,worldmap$(mapx,mapy),y,x,camerax,raydirx,raydiry,mapx,mapy,sidedistx,sidedisty,deltadistx,deltadisty,perpwalldist,step
x,stepy,hit,side,lineheigt,drawstart,drawend
1010 NEXT x
1020 REM
1030 REM Berechnung Zeit
1040 REM
1050 newtime=TIME/300
1060 frametime=newtime-oldtime
1070 LOCATE 1,1:PEN 8:PRINT ROUND(frametime,1)
1080 oldtime=newtime
1090 REM
1100 REM Abfrage und Bewegungsmatrix
1110 REM
1120 ok=0
1130 IF INKEY(0)=0 THEN 1140 ELSE 1170
1140 IF worldmap$((posx+dirx),posy)="0" THEN posx=posx+dirx
1150 IF worldmap$(posx,posy+diry)="0" THEN posy=posy+diry
1160 ok=1
1170 IF INKEY(2)=0 THEN 1180 ELSE 1210
1180 IF worldmap$(posx-dirx,posy)="0" THEN posx=posx-dirx
1190 IF worldmap$(posx,posy-diry)="0" THEN posy=posy-diry
1200 ok=1
1210 IF INKEY(1)=0 THEN 1220 ELSE 1250
1220 tmpdir=dirx:dirx=dirx*COS(-winkel)-diry*SIN(-winkel):diry=tmpdir*SIN(-winkel)+diry*COS(-winkel)
1230 tmpplane=planex:planex=planex*COS(-winkel)-planey*SIN(-winkel):planey=tmpplane*SIN(-winkel)+planey*COS(-winkel)
1240 ok=1
1250 IF INKEY(8)=0 THEN 1260 ELSE 1300
1260 tmpdir=dirx:dirx=dirx*COS(winkel)-diry*SIN(winkel):diry=tmpdir*SIN(winkel)+diry*COS(winkel)
1270 tmpplane=planex:planex=planex*COS(winkel)-planey*SIN(winkel):planey=tmpplane*SIN(winkel)+planey*COS(winkel)
1280 ok=1
1290 CLEAR INPUT
1300 IF ok=1 THEN WEND ELSE 1120
1310 END
1320 DATA 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
1330 DATA 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
1340 DATA 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
1350 DATA 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
1360 DATA 1,0,0,0,0,0,2,2,2,2,2,0,0,0,0,3,0,3,0,3,0,0,0,1
1370 DATA 1,0,0,0,0,0,2,0,0,0,2,0,0,0,0,0,0,0,0,0,0,0,0,1
1380 DATA 1,0,0,0,0,0,2,0,0,0,2,0,0,0,0,3,0,0,0,3,0,0,0,1
1390 DATA 1,0,0,0,0,0,2,0,0,0,2,0,0,0,0,0,0,0,0,0,0,0,0,1
1400 DATA 1,0,0,0,0,0,2,2,2,2,2,0,0,0,0,3,0,3,0,3,0,0,0,1
1410 DATA 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
1420 DATA 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
1430 DATA 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
1440 DATA 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
1450 DATA 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
1460 DATA 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
1470 DATA 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
1480 DATA 1,4,4,4,4,4,4,4,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
1490 DATA 1,4,0,4,0,0,0,0,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
1500 DATA 1,4,0,4,0,0,5,0,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
1510 DATA 1,4,0,4,0,0,0,0,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
1520 DATA 1,4,0,4,4,4,4,4,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
1530 DATA 1,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
1540 DATA 1,4,4,4,4,4,4,4,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
1550 DATA 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
1560 PRINT ERR,"...in Zeile ";ERL:STOP

LambdaMikel

Sehr schön! Hatte damals das Buch "Data Becker 3D Grafik Programmierung mit Disk Amiga Jemmrich Massmann Schulz" für den Amiga 500, das hatte damals auch viele Basic Raytracing-Programme. Evtl. auch eine gute Quelle?

Gibt es in der englischen Version als PDF:

https://ia800202.us.archive.org/19/items/Amiga3dGraphicProgrammingInBasic/Amiga3dGraphicProgrammingInBasic.pdf

Devilmarkus

Quote from: HAL6128 on 10. February 2021, 20:03:57
So. Das erste Beispiel wäre zum Thema "Ray-Casting"....

Interessant, wirklich sehr schade, dass es so langsam ist... Und der Interpreter vom @MV hat scheinbar Probleme mit der Umsetzung, da stimmen die Koordinaten leider nicht...
https://cpcwiki.de
Dein Deutsches CPCWiki!

HAL6128

Ich muss mir mal die Parameter anschauen, ob ich da nicht einen Wurm reingebracht habe. Zumindest gibt es einen Bug (Division bei Zero), wenn exakt die Mitte des Bildes gerendert wird.
Hier noch ein Beispiel aus der ct von 1986 (beim Starten einfach komplettes Bild wählen). Ich habe das Menü mit einem GOTO Befehl umgangen, sonst könnten die Parameter auch verändert werden....
Läuft auf dem Emulator ziemlich flott!


10 MODE 1:INK 0,26:BORDER 0:INK 1,3:INK 2,6:INK 3,15
20 RAD
30 GOTO 1080
40 REM ** z. 100-399: formel fuer das muster **
50 IF INT(p1/2)*2-INT(p1)=INT(p2/2)*2-INT(p2) THEN PLOT s-sa,tt,2 ELSE PLOT s-sa,tt,2:s=s+4:RETURN
60 RETURN
70 '
80 FOR s=so TO sp STEP 2
90     p1=s*cc+cd
100    p2=s*ce+cf
110    GOSUB 50
120 NEXT
130 RETURN
135 :
140 REM ** kugelrand **
150 ca=d+c*t:dis=ca*ca-a*(t*t*b+t*e+f):IF dis<0 THEN f0=-1:RETURN
160 cb=SQR(dis)*SGN(a):s1=(ca-cb)/a:s2=(ca+cb)/a:f1=s1*ma+t*mb+mc>0
170 f2=s2*ma+t*mb+mc>0:s1=INT(s1+0.5):s2=INT(s2+0.5):IF f1 AND f2 THEN 260
180 IF f1 THEN 230
190 IF NOT f2 THEN f0=-1:RETURN
200 IF s2>sb THEN f0=-1:RETURN
210 IF s2<sa THEN s1=sa:s2=sb:f1=0:f2=0:f0=0:RETURN
220 s1=s2:s2=sb:f1=-1:f2=0:f0=0:RETURN
230 IF s1<sa THEN f0=-1:RETURN
240 IF s1>sb THEN s1=sa:s2=sb:f2=0:f1=0:f0=0:RETURN
250 s2=s1:s1=sa:f2=-1:f1=0:f0=0:RETURN
260 IF s1>sb OR s2<sa THEN f0=-1:RETURN
270 IF s1<sa THEN s1=sa:f1=0
280 IF s2>sb THEN s2=sb:f2=0
290 f0=0:RETURN
300 '
310 REM ** schattenrand **
320 ca=q+t*p:dis=ca*ca-n*(t*t*o+t*r+u):IF dis<0 THEN f5=-1:RETURN
330 cb=SQR(dis)*SGN(n):s3=(ca-cb)/n:s4=(ca+cb)/n:f1=s3*v+t*w+x<0:f2=s4*v+t*w+x<0
340 s3=INT(s3+0.5):s4=INT(s4+0.5):IF f1 AND f2 THEN 430
350 IF f1 THEN 400
360 IF NOT f2 THEN f5=-1:RETURN
370 IF s4>sb THEN f5=-1:RETURN
380 IF s4<sa THEN s3=sa:s4=sb:f5=0:RETURN
390 s3=s4:s4=sb:f5=0:RETURN
400 IF s3<sa THEN f5=-1:RETURN
410 IF s3>sb THEN s3=sa:s4=sb:f5=0:RETURN
420 s4=s3:s3=sa:f5=0:RETURN
430 IF s3>sb OR s4<sa THEN f5=-1:RETURN
440 IF s3<sa THEN s3=sa
450 IF s4>sb THEN s4=sb
460 f5=0:RETURN
470 '
480 IF s3>sa THEN so=sa:sp=s3-1:GOSUB 80:RETURN
490 RETURN
500 IF s1>sa THEN so=sa:sp=s1-1:GOSUB 80:RETURN
510 RETURN
520 IF s4<sb THEN so=s4+1:sp=sb:GOSUB 80:RETURN
530 RETURN
540 IF s2<sb THEN so=s2+1:sp=sb:GOSUB 80:RETURN
550 RETURN
560 '
570 REM ** hauptschleife **
580 t=ta-1:GOSUB 150:f4=NOT f0:f3=f0:CLS
590 FOR t=ta TO tb STEP 2:tt=-1*(tb-t-399):squ=s1:sr=s2:GOSUB 150:IF f0 THEN 810
600 f4=-1:IF f3 THEN MOVE s1-sa,tt:DRAW s2-sa,tt,1:f3=0:GOTO 840
610 IF s2-s1<2 THEN 750
620 '
630 REM ** das kugelinnere **
640 FOR s=s1+1 TO s2-1:z1=s*a1+t*b1+c1:z2=s*a2+t*b2+c2:z3=t*b3+c3
650 ca=z1*z1+z2*z2+z3*z3:cb=m1*z1+m2*z2+m3*z3:j=(cb-SQR(cb*cb-ca*y))/ca
660 p1=j*z1+q1:p2=j*z2+q2:p3=j*z3+q3:r1=p1-k1:r2=p2-k2:r3=p3-k3
670 ca=2*(z1*r1+z2*r2+z3*r3)/rr:z1=z1-ca*r1:z2=z2-ca*r2:z3=z3-ca*r3
680 IF z3>=0 THEN 720
690 j=-p3/z3:p1=p1+j*z1:p2=p2+j*z2:IF p1*n1+p2*n2<z THEN GOSUB 50:GOTO 720
700 IF p1*p1*g+p2*p2*h+p1*p2*i+p1*k+p2*l+m<0 THEN GOSUB 50:GOTO 720
710 PLOT s-sa,tt,1
720 NEXT
730 '
740 REM ** kugelrand **
750 IF squ<>s1 THEN MOVE squ+SGN(s1-squ)-sa,tt:DRAW s1-sa,tt,1:GOTO 770
760 IF f1 THEN PLOT s1-sa,tt,1
770 IF sr<>s2 THEN MOVE sr+SGN(s2-sr)-sa,tt:DRAW s2-sa,tt,1:GOTO 840
780 IF f2 THEN PLOT s2-sa,tt,1:GOTO 840
790 GOTO 840
800 '
810 IF f4 THEN MOVE squ-sa,tt:DRAW sr-sa,tt,1:f4=0
820 '
830 REM ** die ebene, direkt gesehen **
840 IF t>=-c3/b3 THEN GOTO 980:GOTO 1000
850 REM ** die ebene, direkt gesehen **
860 ca=t*b3+c3:cc=-q3*a1/ca:cd=(q1-q3*(t*b1+c1)/ca)
870 ce=-q3*a2/ca:cf=(q2-q3*(t*b2+c2)/ca)
880 GOSUB 320:IF f0 AND f5 THEN so=sa:sp=sb:GOSUB 80:GOTO 980
890 IF f0 THEN GOSUB 480:GOSUB 520:GOTO 970
900 IF f5 THEN GOSUB 500:GOSUB 540:GOTO 980
910 IF s4<s1-1 THEN GOSUB 480:so=s4+1:sp=s1-1:GOSUB 80:GOSUB 540:GOTO 970
920 IF s3>s2+1 THEN GOSUB 500:so=s2+1:sp=s3-1:GOSUB 80:GOSUB 520:GOTO 970
930 IF s1>s3 THEN GOSUB 480:MOVE s3-sa,tt:DRAW s1-sa,tt,1:GOTO 950
940 GOSUB 500
950 IF s4>s2 THEN MOVE s2-sa,tt:DRAW s4-sa,tt,1:GOSUB 520:GOTO 980
960 GOSUB 540:GOTO 980
970 MOVE s3-sa,tt:DRAW s4-sa,tt,1
980 NEXT
990 '
1000 '
1010 g$=INKEY$:IF g$="" THEN 1010
1020 REM ** fertig **
1030 END
1040 '
1050 '
1060 REM ** programmstart **
1070 REM eingabe, berechnung d. parameter und vektoren **
1080 s=1:ca=1:cb=1:t=1:z1=1:z2=1:z3=1:p1=1:p2=1:p3=1:j=1:r1=1:r2=1:r3=1:a1=1
1090 a2=1:b1=1:b2=1:b3=1:c1=1:c2=1:c3=1:k1=1:k2=1:k3=1:m1=1:m2=1:m3=1:q1=1:q2=1
1100 q3=1:tt=1:n1=1:n2=1:z=1:y=1:g=1:h=1:i=1:l=1:m=1:rr=1
1110 cc=1:cd=1:ce=1:cf=1:f1=1:f2=1:sa=1:sb=1
1120 dis=1:f0=1:f5=1:so=1:sp=1:s1=1:s2=1:s3=1:s4=1:squ=1:sr=1:f3=1:f4=1:v=1:w=1
1130 x=1:ma=1:mb=1:mc=1:a=1:b=1:c=1:d=1:e=1:f=1:q=1:p=1:n=1:o=1:r=1:u=1
1140 GOTO 1210:PRINT"die Kugel:":INPUT "Koordinaten des Mittelpunkts ";k1,k2,k3
1150 INPUT"Radius ";rr:rr=rr*rr
1160 PRINT:INPUT"Koordinaten der Lampe ";l1,l2,l3
1170 INPUT"Koordinate der Kamera ";q1,q2,q3
1180 INPUT"Ihr Blickvektor ";c1,c2,c3
1190 PRINT:INPUT"Oeffnungswinkel hor/ver ";ca,cb
1200 INPUT"Koordinaten der Ecke r.o. ";cc,cd
1210 k1=0:k2=0:k3=1:rr=1:l1=35:l2=45:l3=6.5:q1=-7:q2=-7:q3=1.7:c1=7:c2=6.5:c3=-0.88:ca=10.8:cb=7.5:cc=320:cd=200
1220 p=3.14159265
1230 ca=ca/180*p:cb=cb/180*p:a1=c2:a2=-c1:b1=-c1*c3:b2=-c2*c3:b3=c2*c2+c1*c1
1240 ce=SQR(1+c3*c3/b3)/cc*TAN(ca):a1=ce*a1:a2=ce*a2:ce=1/SQR(b3)/cd*TAN(cb)
1250 b1=b1*ce:b2=b2*ce:b3=b3*ce
1260 n1=k1-l1:n2=k2-l2:n3=k3-l3:z=n1*l1+n2*l2+n3*l3:ca=n1*n1+n2*n2+n3*n3-rr
1270 g=n1*n1-ca:h=n2*n2-ca:i=2*n1*n2:k=2*l1*ca-2*z*n1:l=2*l2*ca-2*z*n2
1280 m=z*z-ca*(l1*l1+l2*l2+l3*l3)
1290 ca=-a1*q3:cb=b3*q1-b1*q3:cc=c3*q1-c1*q3:cd=-a2*q3:ce=b3*q2-b2*q3
1300 cf=c3*q2-c2*q3
1310 n=g*ca*ca  +h*cd*cd  +i*ca*cd
1320 o=g*cb*cb  +h*ce*ce  +i*cb*ce        +k*cb*b3
1330 p=g*2*ca*cb+h*2*cd*ce+i*(ca*ce+cb*cd)+k*ca*b3
1340 q=g*2*ca*cc+h*2*cd*cf+i*(ca*cf+cc*cd)+k*ca*c3
1350 r=g*2*cb*cc+h*2*ce*cf+i*(cb*cf+cc*ce)+k*(cb*c3+cc*b3)
1360 u=g*cc*cc  +h*cf*cf  +i*cc*cf        +k*cc*c3
1370 o=o+l*ce*b3          +m*b3*b3
1380 p=p+l*cd*b3
1390 q=q+l*cd*c3
1400 r=r+l*(ce*c3+cf*b3)  +m*b3*c3*2
1410 u=u+l*cf*c3          +m*c3*c3
1420 p=-0.5*p:q=-0.5*q
1430 v=ca*n1+cd*n2:w=cb*n1+ce*n2-b3*z:x=cc*n1+cf*n2-c3*z
1440 m1=k1-q1:m2=k2-q2:m3=k3-q3:y=m1*m1+m2*m2+m3*m3-rr
1450 ca=a1*a1+a2*a2:cb=b1*b1+b2*b2+b3*b3:cc=c1*c1+c2*c2+c3*c3:ma=m1*a1+m2*a2
1460 mb=m1*b1+m2*b2+m3*b3:mc=m1*c1+m2*c2+m3*c3
1470 a=ma*ma-y*ca
1480 b=mb*mb-y*cb
1490 c=-ma*mb
1500 d=-ma*mc
1510 e=2*mb*mc
1520 f=mc*mc-y*cc
1530 sa=-320:ta=-200:sb=639:tb=399:sb=sb+sa:tb=tb+ta:GOTO 1560
1540 INPUT"koordinaten der ecke li. u. ";sa,ta
1550 INPUT"groesse des ausschnitts ";sb,tb:sb=sb+sa:tb=tb+ta
1560 INPUT"skizze (s) / komplette zeichnung (z)  ";a$:IF a$="z" THEN 580
1570 IF a$<>"s" THEN 1560
1580 '
1590 REM ** skizze **
1600 CLS
1610 MOVE 0,0:DRAW 0,tb-ta,1:MOVE sb-sa,0:DRAW sb-sa,tb-ta,1:MOVE 0,0:DRAW sb-sa,0,1
1620 MOVE sb-sa,tb-ta:DRAW 0,tb-ta,1
1630 cc=INT(-c3/b3+0.5):IF cc>=tb THEN cc=tb:GOTO 1660
1640 IF cc<=ta THEN cc=ta:GOTO 1690
1650 MOVE 0,tb-cc:DRAW sb-sa,tb-cc,1
1660 FOR t=ta TO cc:tt=tb-t:GOSUB 150:IF NOT f0 THEN PLOT s1-sa,tt,1:PLOT s2-sa,tt,1
1670 GOSUB 320:IF NOT f5 THEN PLOT s3-sa,tt,1:PLOT s4-sa,tt,1
1680 NEXT
1690 FOR t=cc TO tb:tt=tb-t:GOSUB 150:IF NOT f0 THEN PLOT s1-sa,tt,1:PLOT s2-sa,tt,1
1700 NEXT
1710 a$=INKEY$:IF a$<>"w" THEN 1710
1720 GOTO 1530


Devilmarkus

Das sieht schon wesentlich interessanter aus, auch wenn es etwas "Gekünstelt" scheint...
Was ich toll fände, wäre für meine Routine eine Art "Quick-draw Preview", also dass sich der User die Szene so zb mit 3 Ansichten selber zusammenstellen kann, pro Objekt noch einen Shader wählen kann (Sind 6 oder 7) und dann rendern kann.
https://cpcwiki.de
Dein Deutsches CPCWiki!