home *** CD-ROM | disk | FTP | other *** search
/ 64'er 1985 May / 64er_Magazin_85-05_1985_Markt__Technik_de.d64 / 3d-movie-maker (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  7KB  |  358 lines
  1. 100 rem -----------------------------
  2. 105 rem -- 3d-movie-maker          --
  3. 110 rem -- ein programm von:       --
  4. 115 rem -- dirk & armin biernaczyk --
  5. 120 rem -- an der papenburg 41     --
  6. 125 rem -- 4630 bochum 6           --
  7. 130 rem -- tel.: //////            --
  8. 135 rem -----------------------------
  9. 140 rem (c) 1985 by armin & dirk
  10. 145 rem             biernaczyk
  11. 150 :
  12. 160 rem ------------------
  13. 170 rem --- hauptmenue ---
  14. 180 rem ------------------
  15. 190 :
  16. 191 ifa=0thena=1:load"trick.obj",8,1
  17. 192 :
  18. 195 poke56,50:clr:rem speicher herab.
  19. 200 printchr$(147)
  20. 210 printspc(10)"** 3d-movie-maker **"
  21. 220 print:print:print:print
  22. 230 printspc(9)"1 - grafik erstellen"
  23. 235 print
  24. 240 printspc(9)"2 - grafik abspielen"
  25. 245 print
  26. 250 printspc(9)"3 - grafik laden"
  27. 255 print
  28. 260 printspc(9)"4 - grafik abspeichern"
  29. 262 print
  30. 264 printspc(9)"5 - ende"
  31. 265 :
  32. 270 getw$:ifw$<"1"orw$>"5"then270
  33. 280 w=val(w$)
  34. 285 ifw=5thenend
  35. 290 onwgosub1040,5040,6040,7040
  36. 300 goto200
  37. 310 :
  38. 315 :
  39. 320 :
  40. 1000 rem -----------------
  41. 1010 rem --- erstellen ---
  42. 1020 rem -----------------
  43. 1030 :
  44. 1040 gosub4540   :rem variablen
  45. 1050 gosub4040   :rem einlesen
  46. 1060 printchr$(147)"fertige bilder: "
  47. 1061 ifan*(a2*6+2)<23000then1080
  48. 1062 print"zu wenig speicherplatz"
  49. 1063 poke198,0:wait198,1:return
  50. 1070 :
  51. 1080 forq=1toan  :rem anzahl der bilder
  52. 1085 gosub3040   :rem bewegen
  53. 1090 gosub2040   :rem berechnen
  54. 1095 getta$:ifta$=" "thenifq>1thensys49152,q-1,a2,1
  55. 1100 next
  56. 1110 q=q-1
  57. 1120 return
  58. 1130 :
  59. 1135 :
  60. 2000 rem -----------------
  61. 2010 rem --- berechnen ---
  62. 2020 rem -----------------
  63. 2030 :
  64. 2040 rem --- verschieben1 ---
  65. 2050 :
  66. 2060 fori=1toa1
  67. 2070 x1(i)=x(i)+x1:y1(i)=y(i)+y1
  68. 2080 z1(i)=z(i)+z1
  69. 2090 next
  70. 2100 :
  71. 2110 rem --- drehen ---
  72. 2120 :
  73. 2130 ifw1=0then2250
  74. 2140 fori=1toa1
  75. 2150 xd=x1(i):yd=y1(i)
  76. 2160 ifxd=0thenxd=1e-20
  77. 2165 ifyd=0thenyd=1e-20
  78. 2170 r=sqr(xd*xd+yd*yd)
  79. 2180 w=atn(yd/xd)
  80. 2190 ifxd>0andyd<0thenw=w+(NULL)*2:goto2210
  81. 2200 ifxd<0thenw=w+(NULL)
  82. 2210 w=w+w1
  83. 2220 y1(i)=sin(w)*r:x1(i)=cos(w)*r
  84. 2230 next
  85. 2240 :
  86. 2250 ifw2=0then2370
  87. 2260 fori=1toa1
  88. 2270 zd=z1(i):yd=y1(i)
  89. 2280 ifzd=0thenzd=1e-20
  90. 2285 ifyd=0thenyd=1e-20
  91. 2290 r=sqr(zd*zd+yd*yd)
  92. 2300 w=atn(yd/zd)
  93. 2310 ifzd>0andyd<0thenw=w+(NULL)*2:goto2330
  94. 2320 ifzd<0thenw=w+(NULL)
  95. 2330 w=w+w2
  96. 2340 y1(i)=sin(w)*r:z1(i)=cos(w)*r
  97. 2350 next
  98. 2360 :
  99. 2370 ifw3=0then2510
  100. 2380 fori=1toa1
  101. 2390 zd=z1(i):xd=x1(i)
  102. 2400 ifzd=0thenzd=1e-20
  103. 2405 ifxd=0thenxd=1e-20
  104. 2410 r=sqr(zd*zd+xd*xd)
  105. 2420 w=atn(xd/zd)
  106. 2430 ifzd>0andxd<0thenw=w+(NULL)*2:goto2450
  107. 2440 ifzd<0thenw=w+(NULL)
  108. 2450 w=w+w3
  109. 2460 x1(i)=sin(w)*r:z1(i)=cos(w)*r
  110. 2470 next
  111. 2480 :
  112. 2490 rem --- umrechnen ---
  113. 2500 :
  114. 2510 fori=1toa1
  115. 2530 x1(i)=(x1(i)+x2)*1.01^(z1(i)+z2)
  116. 2540 y1(i)=(y1(i)+y2)*1.01^(z1(i)+z2)
  117. 2560 next
  118. 2565 rem 1.01 kann leicht geaendert
  119. 2567 rem werden
  120. 2580 :
  121. 2590 pa=0:pb=199
  122. 2600 po=po-2
  123. 2601 rem -----------------------------
  124. 2602 rem --- ubergetretene linien  ---
  125. 2603 rem --- berechnen und poken   ---
  126. 2604 rem -----------------------------
  127. 2610 fori=1toa2
  128. 2620 x0%=x1(p1(i)):y1%=y1(p1(i))
  129. 2630 x2%=x1(p2(i)):y2%=y1(p2(i))
  130. 2640 x1%=0:x3%=0:me=0
  131. 2641 ifx0%> 159andx2%> 159then2760
  132. 2642 ifx0%<-159andx2%<-159then2760
  133. 2643 ify1%<- 99andy2%<- 99then2760
  134. 2644 ify1%>  99andy2%>  99then2760
  135. 2650 ify1%=y2%then2711
  136. 2655 ifx2%=x0%then2690
  137. 2660 m=(y2%-y1%)/(x2%-x0%)
  138. 2670 b=-m*x0%+y1%
  139. 2680 goto2720
  140. 2690 ify1%>99ory1%<-99theny1%=99*sgn(y1%)
  141. 2700 ify2%>99ory2%<-99theny2%=99*sgn(y2%)
  142. 2710 goto 2760
  143. 2711 ifx0%>159orx0%<-159thenx0%=159*sgn(x0%)
  144. 2712 ifx2%>159orx2%<-159thenx2%=159*sgn(x2%)
  145. 2713 goto 2760
  146. 2720 ifx0%>159orx0%<-159thenx0%=159*sgn(x0%):y1%=m*x0%+b
  147. 2730 ifx2%>159orx2%<-159thenx2%=159*sgn(x2%):y2%=m*x2%+b
  148. 2740 ify1%>99ory1%<-99theny1%=99*sgn(y1%):x0%=(y1%-b)/m
  149. 2750 ify2%>99ory2%<-99theny2%=99*sgn(y2%):x2%=(y2%-b)/m
  150. 2760 ify1%>99ory1%<-99thenx1%=255:x0%=0:y1%=0:y2%=0:x2%=0:goto2810
  151. 2770 ifx0%>159orx0%<-159thenx1%=255:x0%=0:y1%=0:y2%=0:x2%=0:goto2810
  152. 2780 :
  153. 2790 x0%=x0%+160:x2%=x2%+160
  154. 2791 y1%=y1%+100:y2%=y2%+100
  155. 2793 ify1%>pathenpa=y1%
  156. 2794 ify2%>pathenpa=y2%
  157. 2795 ify1%<pbthenpb=y1%
  158. 2796 ify2%<pbthenpb=y2%
  159. 2799 ifx0%>255thenx0%=x0%-256:x1%=1
  160. 2800 ifx2%>255thenx2%=x2%-256:x3%=1
  161. 2805 :
  162. 2810 pokepo,x0%:pokepo-1,x1%
  163. 2820 pokepo-2,y1%:pokepo-3,x2%
  164. 2830 pokepo-4,x3%:pokepo-5,y2%
  165. 2840 po=po-6
  166. 2850 next
  167. 2860 :
  168. 2862 ifpa<pbthenpa=199:pb=0
  169. 2863 pa=40*((paor7)+1)/256+1
  170. 2864 pb=40*(pband248)/256
  171. 2866 poke po+6*a2+2,int(p1)-int(p3)
  172. 2868 poke po+6*a2+1,p3
  173. 2870 p1=p2:p2=pa:p3=p4:p4=pb
  174. 2872 printchr$(19)spc(16)q
  175. 2880 return
  176. 2890 :
  177. 2900 :
  178. 3000 rem ---------------
  179. 3010 rem --- bewegen ---
  180. 3020 rem ---------------
  181. 3030 :
  182. 3040 ife=0then3100
  183. 3050 w1=w1+wz:w2=w2+wx:w3=w3+wy
  184. 3060 x1=x1+xa:y1=y1+ya:z1=z1+za
  185. 3070 x2=x2+xb:y2=y2+yb:z2=z2+zb
  186. 3080 e=e-1:return
  187. 3090 :
  188. 3100 read xa,ya,za,wx,wy,wz,xb,yb,zb,e
  189. 3110 wx=wx*(NULL)/180:wy=wy*(NULL)/180
  190. 3120 wz=wz*(NULL)/180:ya=-ya:yb=-yb
  191. 3130 goto3050
  192. 3140 :
  193. 3150 :
  194. 4000 rem ----------------
  195. 4010 rem --- einlesen ---
  196. 4020 rem ----------------
  197. 4030 :
  198. 4040 i=0
  199. 4050 i=i+1
  200. 4060 read x(i),y(i),z(i)
  201. 4070 y(i)=-y(i)
  202. 4080 ifx(i)<1000then4050
  203. 4090 a1=i-1
  204. 4100 i=0
  205. 4110 i=i+1
  206. 4120 read p1(i),p2(i)
  207. 4130 ifp1(i)<1000then4110
  208. 4140 a2=i-1
  209. 4150 :
  210. 4155 an=0
  211. 4157 reada:ifa=1000then4180
  212. 4160 fori=1to9:reada:next
  213. 4170 an=an+a:goto4157
  214. 4180 restore
  215. 4190 reada,a,a
  216. 4200 ifa<1000then4190
  217. 4210 reada,a
  218. 4220 ifa<1000then4210
  219. 4230 :
  220. 4240 printchr$(147)"bilderzahl  "an
  221. 4250 printchr$(19)spc(11);:input i
  222. 4260 ifi>255ori>anthen4240
  223. 4270 an=i
  224. 4280 return
  225. 4290 :
  226. 4300 :
  227. 4500 rem -----------------
  228. 4510 rem --- variablen ---
  229. 4520 rem -----------------
  230. 4530 :
  231. 4533 rem nach bedarf dimensionieren
  232. 4536 :
  233. 4540 dim x(50),y(50),z(50)
  234. 4560 dim x1(50),y1(50),z1(50)
  235. 4570 dim p1(50),p2(50)
  236. 4580 po=35839:p1=32:p2=32:p3=0:p4=0
  237. 4590 return
  238. 4600 :
  239. 4605 :
  240. 5000 rem -----------------
  241. 5010 rem --- abspielen ---
  242. 5020 rem -----------------
  243. 5030 :
  244. 5040 ifq>0anda2>0then5090
  245. 5050 printchr$(147):print:print:print
  246. 5060 printspc(5)"es gibt keine grafik"
  247. 5070 poke198,0:wait198,1:poke198,0
  248. 5080 return
  249. 5090 input"[147]wievile durchlauefe";du
  250. 5091 ifdu>255ordu<1then5090
  251. 5092 print"wieviele bilder     "q
  252. 5093 print"[145]"spc(19);:inputi
  253. 5094 ifi>qori<1then5092
  254. 5100 :
  255. 5105 sys49152,i,a2,du:return
  256. 5110 :
  257. 6000 rem -------------
  258. 6010 rem --- laden ---
  259. 6020 rem -------------
  260. 6030 :
  261. 6040 printchr$(147):print:print:print:print
  262. 6050 input"   filename: ";na$
  263. 6055 ifna$="m"thenreturn
  264. 6060 open2,8,2,na$+".gra,s,r"
  265. 6070 open1,8,15:input#1,fe$
  266. 6080 iffe$="00"then6090
  267. 6082 close1:close2:goto6040
  268. 6090 get#2,q$,a2$
  269. 6100 q=asc(q$):a2=asc(a2$)
  270. 6110 ad=35839-q*(a2*6+2)
  271. 6140 close2:close1
  272. 6150 ah=int(ad/256):al=ad-ah*256
  273. 6160 a$=na$+".gra,s"
  274. 6170 fori=51000to51000+len(a$)-1
  275. 6180 pokei,asc(mid$(a$,i-50999,1))
  276. 6190 next
  277. 6200 poke183,len(a$)
  278. 6210 poke187,56:poke188,199
  279. 6220 poke185,0:poke186,8:poke147,0
  280. 6570 poke195,al:poke196,ah
  281. 6580 sys62648
  282. 6590 return
  283. 6600 :
  284. 6610 :
  285. 6620 :
  286. 7000 rem -------------------
  287. 7010 rem --- abspeichern ---
  288. 7020 rem -------------------
  289. 7030 :
  290. 7040 ifq>0anda2>0then7090
  291. 7050 printchr$(147):print:print:print
  292. 7060 printspc(5)"es gibt keine grafik"
  293. 7070 poke198,0:wait198,1:poke198,0
  294. 7080 return
  295. 7090 printchr$(147):print:print:print
  296. 7100 input"    filename: ";na$
  297. 7105 ifna$="m"thenreturn
  298. 7110 open2,8,2,na$+".gra,s,w"
  299. 7120 open1,8,15:input#1,fe$
  300. 7130 iffe$="00"then7140
  301. 7135 close1:close2:goto7090
  302. 7140 print#2,chr$(q);chr$(a2);
  303. 7150 fori=35839-q*(a2*6+2)to35839
  304. 7160 print#2,chr$(peek(i));:next
  305. 7170 close2:close1:return
  306. 7175 :
  307. 7180 :
  308. 7185 :
  309. 8000 rem -------------------------
  310. 8010 rem --- datas fuer punkte ---
  311. 8020 rem -------------------------
  312. 8030 :
  313. 8040 data -20, 10,0
  314. 8050 data -30, 10,0
  315. 8060 data -30,-10,0
  316. 8070 data -20,-10,0
  317. 8080 data -20,  0,0
  318. 8090 data -30,  0,0
  319. 8100 data -15, 10,0
  320. 8110 data -15,  0,0
  321. 8120 data - 5, 10,0
  322. 8130 data - 5,  0,0
  323. 8140 data - 5,-10,0
  324. 8150 data  10, 10,0
  325. 8160 data   5,  5,0
  326. 8170 data  15,-10,0
  327. 8180 data   5,-10,0
  328. 8190 data   5,  0,0
  329. 8200 data  15,  0,0
  330. 8210 data  15, -5,0
  331. 8220 data   5, -5,0
  332. 8230 data  20,-10,0
  333. 8240 data  20,  0,0
  334. 8250 data  20, -5,0
  335. 8260 data  30,  0,0
  336. 8900 data 1000,1000,1000
  337. 8910 :
  338. 9000 rem ----------------------------
  339. 9010 rem --- verbindungsvoschrift ---
  340. 9020 rem ----------------------------
  341. 9030 :
  342. 9040 data  1, 2,  2, 3,  3, 4,  4, 5
  343. 9050 data  5, 6,  7, 8,  8,10,  9,11
  344. 9060 data 12,13, 14,15, 15,16, 16,17
  345. 9070 data 17,18, 18,19, 20,21, 22,23
  346. 9450 data 1000,1000
  347. 9460 :
  348. 9500 rem --------------------------
  349. 9510 rem --- bewegungsvoschrift ---
  350. 9520 rem --------------------------
  351. 9530 :
  352. 9531 rem xa,ya,za,wx,wy,wz,xb,yb,zb,e
  353. 9550 data 0,0,  1 ,0,0,0 ,0,0,  0 ,30
  354. 9560 data 0,0,  0 ,0,5,0 ,0,0,  0 ,108
  355. 9570 data 0,0,-30 ,0,0,0 ,0,0,-30 ,1
  356. 9580 data 0,0,  0 ,5,0,5 ,0,0,.81 ,36
  357. 9620 data 1000
  358.