home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
64'er
/
64ER_CD.iso
/
s85xx
/
s8504b.d64
/
3d-2
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
1995-03-30
|
8KB
|
382 lines
1 REM
2 REM 3D-SUPERGRAFIK
3 REM BY OLIVER GUENTER
4 REM GRAEVINGHOLZSTR. 44
5 REM 4600 DORTMUND 16
6 REM TEL: 0231/853317
7 REM
8 REM FUER C-64 MIT VC-1541
9 REM
100 REM *******************************
101 REM * INITIALISIERUNG *
102 REM *******************************
103 SYS50212:SYS50182:SYS50191,15,15
104 V=53248:POKE50168,63
105 POKEV+21,0:POKEV+32,15:POKEV+33,15
106 DIMDX(150),DY(150),DZ(150)
107 DIMMX(150),MY(150),MZ(150)
108 DIMBX(150),BY(150)
109 DIMWX(120),WY(120),WZ(120)
110 DIMFL(120,8)
111 DIMPF(120),RF(120)
112 REM *******************************
113 REM * HAUPTMENUE *
114 REM *******************************
115 FU$="[200]AUPTMENUE":GOSUB124
116 PRINTTAB(11);"-1- [196]ATEN EINGEBEN"
117 PRINTTAB(11);"-2- [196]ATEN LADEN"
118 PRINTTAB(11);"-3- [196]ATEN SPEICHERN"
119 PRINTTAB(11);"-4- [194]ILD BERECHNEN"
120 PRINTTAB(11);"-5- [200]ARDCOPY"
121 GETIN$:IN=VAL(IN$)
122 ONINGOTO134,175,201,228,387
123 GOTO121
124 REM *******************************
125 REM * TITEL + FUNKTION *
126 REM *******************************
127 PRINT"[147][144][198]UNKTION : ";FU$
128 PRINT"****************************************";
129 PRINT"* [144]3[196]-[211]UPERGRAFIK *";
130 PRINT"* *";
131 PRINT"* [144]([195]) [207]LIVER [199]UENTER *";
132 PRINT"****************************************[144]"
133 RETURN
134 REM *******************************
135 REM * DATEN EINGEBEN *
136 REM *******************************
137 FU$="[196]ATEN EINGEBEN":GOSUB124
138 INPUT"[215]IE VIELE [208]UNKTE ";AP
139 IFAP=0THENGOTO112
140 INPUT"[215]IE VIELE [198]LAECHEN ";AF
141 IFAF=0THENGOTO112
142 FORQ=1TOAP
143 FU$="[208]UNKTE EINGEBEN":GOSUB124
144 PRINT"[208]UNKT :";Q
145 INPUT"[216]-[203]OORDINATE ";DX(Q)
146 INPUT"[217]-[203]OORDINATE ";DY(Q)
147 INPUT"[218]-[203]OORDINATE ";DZ(Q)
148 PRINT"RICHTIG ?"
149 POKE198,0:WAIT198,1
150 IFPEEK(631)=78THENPRINT"[145][145][145][145][145][145][145][145][145][145]":POKE198,0:GOTO143
151 NEXT
152 POKE198,0
153 FORQ=1TOAF
154 FU$="[198]LAECHEN EINGEBEN":GOSUB124
155 PRINT"[198]LAECHE :";Q;""
156 R=0
157 FORW=1TO8
158 IFR=1THENNEXT:GOTO168
159 PRINT"[208]UNKT :";W;
160 T$=""
161 INPUTT$
162 T=VAL(T$)
163 IFT<0ORT>APORINT(T)<>TTHENPRINT"[145][145]":GOTO159
164 IFRIGHT$(T$,1)="L"THENT=-T
165 FL(Q,W)=T
166 IFT=0THENR=1:PF(Q)=W-1:NEXT
167 NEXT:PF(Q)=8
168 PRINT"RICHTIG ?"
169 POKE198,0:WAIT198,1
170 IFPEEK(631)=78THENPRINT"":POKE198,0:GOTO154
171 NEXT
172 PRINT"< [211][208][193][195][197] >[146]"
173 GETIN$:IFIN$<>" "THEN173
174 GOTO112
175 REM *******************************
176 REM * DATEN LADEN *
177 REM *******************************
178 FU$="[196]ATEN LADEN ($=[196]IR)":GOSUB124
179 INPUT"[198]ILENAME ";FL$
180 IFFL$="@"THENGOTO112
181 IFFL$="$"THENPRINT:SYS50209:GOTO179
182 OPEN15,8,15:OPEN1,8,2,"3D-"+FL$+",S,R"
183 GOSUB423
184 IFER=1THENCLOSE1:CLOSE15:GOTO179
185 GET#1,A$:AP=ASC(A$)
186 FORQ=1TOAP
187 INPUT#1,A$:DX(Q)=VAL(A$)
188 INPUT#1,A$:DY(Q)=VAL(A$)
189 INPUT#1,A$:DZ(Q)=VAL(A$)
190 NEXT
191 GET#1,A$:AF=ASC(A$)
192 FORQ=1TOAF
193 GET#1,A$:PF(Q)=ASC(A$)
194 FORW=1TOPF(Q)
195 GET#1,A$:FL(Q,W)=ASC(A$)-128
196 NEXT
197 NEXT
198 CLOSE1
199 CLOSE15
200 GOTO112
201 REM *******************************
202 REM * DATEN SPEICHERN *
203 REM *******************************
204 FU$="[196]ATEN SPEICHERN ($=[196]IR)":GOSUB124
205 GOSUB413:IFER=1THENGOTO112
206 INPUT"[198]ILENAME ";FL$
207 IFFL$="@"THENGOTO112
208 IFFL$="$"THENPRINT:SYS50209:GOTO206
209 OPEN15,8,15:OPEN1,8,2,"3D-"+FL$+",S,W"
210 GOSUB423
211 IFER=1THENCLOSE1:CLOSE15:GOTO206
212 PRINT#1,CHR$(AP);
213 FORQ=1TOAP
214 PRINT#1,DX(Q)
215 PRINT#1,DY(Q)
216 PRINT#1,DZ(Q)
217 NEXT
218 PRINT#1,CHR$(AF);
219 FORQ=1TOAF
220 PRINT#1,CHR$(PF(Q));
221 FORW=1TOPF(Q)
222 PRINT#1,CHR$(FL(Q,W)+128);
223 NEXT
224 NEXT
225 CLOSE1
226 CLOSE15
227 GOTO112
228 REM *******************************
229 REM * BILD BERECHNEN *
230 REM *******************************
231 FU$="[194]ILD BERECHNEN":GOSUB124
232 GOSUB413:IFER=1THENGOTO112
233 INPUT"[216]-[196]REHWINKEL ";XD
234 INPUT"[217]-[196]REHWINKEL ";YD
235 INPUT"[218]-[196]REHWINKEL ";ZD
236 INPUT"[200]INTERSCHNEIDUNG (J/N) ";HI$
237 IFHI$="J"THENHI=1:GOTO240
238 IFHI$<>"N"THENPRINT"[145][145][145]":GOTO236
239 HI=0
240 INPUT"[198]LUCHTPUNKT (J/N) ";F$
241 IFF$="J"THENF=1:GOTO245
242 IFF$<>"N"THENPRINT"[145][145][145]":GOTO240
243 F=0
244 GOTO247
245 INPUT"[193]UGPUNKT-[203]OOR. 0,0,25[157][157][157][157][157][157][157][157]";FX,FY,FZ
246 IFFZ<=0THENPRINT"[145][145][145]":GOTO245
247 INPUT"[215]ERTE AUSGEBEN (J/N) N[157][157][157]";WE$
248 IFWE$="J"THENWE=1:GOTO251
249 IFWE$<>"N"THENPRINT"[145][145][145]":GOTO247
250 WE=0
251 PRINT"[196]REHE [208]UNKTE"
252 FORQ=1TOAP
253 WX(Q)=DX(Q)
254 WY(Q)=DY(Q)
255 WZ(Q)=DZ(Q)
256 NEXT
257 IFXD=0THENGOTO262
258 FORQ=1TOAP
259 WI=XD:XP=WY(Q):YP=WZ(Q):GOSUB434
260 WY(Q)=XP:WZ(Q)=YP
261 NEXT
262 IFYD=0THENGOTO267
263 FORQ=1TOAP
264 WI=YD:XP=WZ(Q):YP=WX(Q):GOSUB434
265 WZ(Q)=XP:WX(Q)=YP
266 NEXT
267 IFYD=0THENGOTO272
268 FORQ=1TOAP
269 WI=ZD:XP=WX(Q):YP=WY(Q):GOSUB434
270 WX(Q)=XP:WY(Q)=YP
271 NEXT
272 IFF=1THENGOTO278
273 FORQ=1TOAP
274 BX(Q)=WX(Q)
275 BY(Q)=WY(Q)
276 NEXT
277 GOTO285
278 PRINT"[145][194]ERECHNE [194]ILDPUNKTE"
279 FORQ=1TOAP
280 X1=FX:Y1=FY:Z1=FZ
281 X2=WX(Q):Y2=WY(Q):Z2=WZ(Q)
282 GOSUB446
283 BX(Q)=X1:BY(Q)=Y1
284 NEXT
285 IFHI=0THENGOTO298
286 PRINT"[145][194]ERECHNE [205]ITTELPUNKTE"
287 FORQ=1TOAF
288 ZX=0:ZY=0:ZZ=0
289 FORW=1TOPF(Q)
290 ZX=ZX+BX(ABS(FL(Q,W)))
291 ZY=ZY+BY(ABS(FL(Q,W)))
292 ZZ=ZZ+WZ(ABS(FL(Q,W)))
293 NEXT
294 MX(Q)=ZX/PF(Q)
295 MY(Q)=ZY/PF(Q)
296 MZ(Q)=ZZ/PF(Q)
297 NEXT
298 PRINT"[145][194]ERECHNE [193]CHSEINHEITEN"
299 PX=0:NX=0:PY=0:NY=0
300 FORQ=1TOAP
301 ZX=BX(Q)
302 ZY=BY(Q)
303 GOSUB458
304 NEXT
305 AX=-(PX+NX)/2
306 AY=-(PY+NY)/2
307 BX=(ABS(PX)+ABS(NX))/3.2
308 BY=(ABS(PY)+ABS(NY))/2
309 AE=BX
310 IFBX<BYTHENAE=BY
311 AE=AE*100/98
312 FORQ=1TOAF
313 RF(Q)=Q
314 NEXT
315 IFHI=0THENGOTO325
316 PRINT"[145][194]ERECHNE [210]EIHENFOLGE "
317 FORQ=1TOAF-1
318 FORW=Q+1TOAF
319 IFMZ(RF(Q))<=MZ(RF(W))THENGOTO323
320 A=RF(Q)
321 RF(Q)=RF(W)
322 RF(W)=A
323 NEXT
324 NEXT
325 PRINT"[145][218]EICHNE [194]ILD "
326 SYS50185:SYS50176
327 FORQ=1TOAF
328 SYS50188
329 NF=RF(Q)
330 FORW=1TOPF(NF)
331 ZX=BX(ABS(FL(NF,W)))
332 ZY=BY(ABS(FL(NF,W)))
333 GOSUB466
334 E=W+1:IFE>PF(NF)THENE=1
335 X=ZX:Y=ZY
336 ZX=BX(ABS(FL(NF,E)))
337 ZY=BY(ABS(FL(NF,E)))
338 GOSUB466
339 R=SGN(FL(NF,E))
340 LO=0
341 IFR=1THENGOTO344
342 IFHI=0THENGOTO347
343 LO=3
344 SYS50200+LO,X,Y,ZX,ZY
345 IFLO=3THENSYS50194,X,Y
346 IFLO=3THENSYS50194,ZX,ZY
347 NEXT
348 IFHI=0THENGOTO353
349 ZX=MX(NF)
350 ZY=MY(NF)
351 GOSUB466
352 SYS50206,ZX,ZY
353 NEXT
354 PRINT"[145]< [211][208][193][195][197] >[146] "
355 GETIN$:IFIN$<>" "THENGOTO355
356 SYS50182
357 INPUT"[145][194]ILD AENDERN (J/N) ";AE$
358 IFAE$="N"THENGOTO376
359 IFAE$<>"J"THENGOTO357
360 X=160:Y=100:LO=3:SYS50176:POKEV+21,1
361 GETIN$:IFIN$="S"THENLO=0
362 IFIN$="L"THENLO=3
363 IFIN$="E"THENPOKEV+1,0:GOTO373
364 JO=PEEK(249)
365 IF(JOAND1)=0ANDY>0THENY=Y-1
366 IF(JOAND2)=0ANDY<199THENY=Y+1
367 IF(JOAND4)=0ANDX>0THENX=X-1
368 IF(JOAND8)=0ANDX<319THENX=X+1
369 IF(JOAND16)=0THENSYS50194+LO,X,Y
370 POKEV,((X+13)AND255):POKEV+1,Y+40
371 POKEV+16,((X+13)AND256)/256
372 GOTO361
373 PRINT"[145]< [211][208][193][195][197] >[146] "
374 SYS50182
375 GETIN$:IFIN$<>" "THENGOTO375
376 IFWE=0THENGOTO112
377 FORQ=1TOAP
378 FU$="[215]ERTE AUSGEBEN":GOSUB124
379 PRINT"[208]UNKT :";Q
380 PRINT"[216]-[203]OORDINATE :";BX(Q)
381 PRINT"[217]-[203]OORDINATE :";BY(Q)
382 IFF=0THENPRINT"[218]-[203]OORDINATE :";WZ(Q)
383 PRINT"< [211][208][193][195][197][160]>[146]"
384 GETIN$:IFIN$<>" "THENGOTO384
385 NEXT
386 GOTO112
387 REM *******************************
388 REM * HARDCOPY EPSON RX-80 *
389 REM *******************************
390 FU$="[200]ARDCOPY":GOSUB124
391 INPUT"[201]ST DER [196]RUCKER WIRKLICH AN ";D$
392 IFD$="J"THENGOTO395
393 IFD$<>"N"THENPRINT"[145][145][145]":GOTO391
394 GOTO112
395 OPEN4,4,2:REM ++ GROSS/KLEIN ++
396 PRINT#4
397 PRINT#4,"[206]AME : ";FL$
398 PRINT#4,"[216]-[196]REHWINKEL :";XD
399 PRINT#4,"[217]-[196]REHWINKEL :";YD
400 PRINT#4,"[218]-[196]REHWINKEL :";ZD
401 PRINT#4,"[200]INTERSCHNEIDUNG : ";HI$
402 PRINT#4,"[198]LUCHTPUNKT : ";F$
403 IFF=1THENPRINT#4,"[193]UGPUNKT :";FX;",";FY;",";FZ
404 PRINT#4
405 PRINT#4
406 CLOSE4
407 OPEN4,4,1:REM ++ EPSON MODE ++
408 SYS50215,4
409 PRINT#4,CHR$(10)
410 PRINT#4,CHR$(10)
411 CLOSE4
412 GOTO112
413 REM *******************************
414 REM * AUF DATEN TESTEN *
415 REM *******************************
416 ER=0
417 IFAP>0THENRETURN
418 PRINT"[203]EINE [196]ATEN VORHANDEN ![146]"
419 PRINT"< [211][208][193][195][197] >[146]"
420 GETIN$:IFIN$<>" "THENGOTO420
421 ER=1
422 RETURN
423 REM *******************************
424 REM * FEHLERKANAL ABFRAGEN *
425 REM *******************************
426 ER=0
427 INPUT#15,FE,FE$,T,S
428 IFFE=0THENRETURN
429 PRINT"[196]ISKFEHLER :[146] ";FE$
430 PRINT"[212]RACK :[146]";T
431 PRINT"[211]EKTOR :[146]";S
432 ER=1
433 RETURN
434 REM *******************************
435 REM * REC->POL + WI POL->REC *
436 REM *******************************
437 LA=SQR(XP^2+YP^2)
438 IFXP=0THENWK=(null)/2*SGN(YP):GOTO442
439 WK=ATN(YP/XP)
440 IFSGN(XP)=-1THENWK=WK+(null)*SGN(YP)
441 IFSGN(XP)=-1ANDSGN(YP)=0THENWK=(null)
442 WK=WK+(WI*(null)/180)
443 XP=COS(WK)*LA
444 YP=SIN(WK)*LA
445 RETURN
446 REM *******************************
447 REM * SCHNITTPT. GERADE/EBENE *
448 REM *******************************
449 IFX2=X1THENGOTO453
450 M=(Z2-Z1)/(X2-X1)
451 B=Z1-M*X1
452 X1=-B/M
453 IFY2=Y1THENGOTO457
454 N=(Z2-Z1)/(Y2-Y1)
455 C=Z1+N*Y1
456 Y1=-C/N
457 RETURN
458 REM *******************************
459 REM * AE BERECHNEN *
460 REM *******************************
461 IFPX<ZXTHENPX=ZX
462 IFNX>ZXTHENNX=ZX
463 IFPY<ZYTHENPY=ZY
464 IFNY>ZYTHENNY=ZY
465 RETURN
466 REM *******************************
467 REM * BILDKOOR. BERECHNEN *
468 REM *******************************
469 ZX=160+((ZX+AX)*100/AE)
470 ZY=100-((ZY+AY)*100/AE)
471 RETURN