| 10 REM 3D Animated Graphics
20 REM by Ian C. Sharpe 30 REM (c) Computing with the Amstrad 40 REM ------------- CPC ------------- 50 IF HIMEM<>8999 AND HIMEM<41900 THEN PRINT"Switch off all roms but rom 7":END ELSE GOSUB 680 60 BORDER 0:RESTORE 60:FOR i=0 TO 3:READ j:INK i,j:NEXT:DATA 0,26,11,15 70 store=9000:get=9035:MODE 1:WINDOW 12,29,10,17:PAPER 2:CLS 80 PRINT:PRINT" 1 .. Load Frames" 90 PRINT" 2 .. Draw Waves" 100 PRINT" 3 .. Draw Beads" 110 PRINT" 4 .. Animate" 120 PRINT:PRINT" Choice?":PAPER 0 130 WHILE INKEY$<>"":WEND 140 a$="":WHILE a$="":a$=INKEY$:WEND 150 IF a$<"1" OR a$>"4" THEN 140 160 ON VAL(a$) GOSUB 180,280,420,600 170 CLEAR:GOTO 70 180 REM *** Load Frames *** 190 MODE 1:WINDOW 10,30,8,13:PAPER 3:CLS 200 PRINT:PRINT" 1 .. Load Waves" 210 PRINT" 2 .. Load Beads" 220 PRINT:PRINT" Choice?" 230 WHILE INKEY$<>"":WEND 240 a$="":WHILE a$="":a$=INKEY$:WEND 250 IF a$="1" THEN ipf$="waves.bin" ELSE IF a$="2" THEN ipf$="beads.bin" ELSE 240 260 LOAD ipf$,9116 270 RETURN 280 REM *** Waves *** 290 DEG:MODE 1:ORIGIN 0,230 300 DEFINT a-z:DEFREAL s:cx=150:yc=125 310 DIM s(360):FOR i=0 TO 360:s(i)=SIN(i):NEXT 320 FOR z=1 TO 8:z5=z*5:CLS 330 FOR x=0 TO 150 STEP 2 340 m=-1000:x2=(x-cx)^2 350 FOR y=0 TO 250 STEP 2 360 a=z5*s((z*SQR(x2+(y-yc)^2)/2)MOD 360)+y/2 370 IF a>m THEN PLOT x,a,((y/16) MOD 3)+1:PLOT 300-x,a:m=a 380 NEXT y,x:CALL store,z 390 NEXT 400 ERASE s:LOCATE 1,15:SAVE"waves.bin",b,9116,&8000 410 RETURN 420 REM *** Beads *** 430 MODE 1:DIM a(90,2):r=20:k1=1:k2=2 440 FOR fr=1 TO 8:CLS:ORIGIN 0,200 450 FOR i=0 TO 200 STEP 10:MOVE 0,i:DRAWR 320,0,1:NEXT 460 DEG:FOR i=0 TO 90 STEP 2:a(i,0)=r*COS(i):a(i,1)=r*SIN(i):a(i,2)=2-2*a(i,0):NEXT 470 FOR z=1 TO 200 STEP 10:p=p XOR 1:cl=2+p:cx=150+100*SIN(k1*z):cy=100+150*COS(k2*z)/z-z/5 480 GOSUB 530:NEXT 490 CALL store,fr:k1=k1+0.1:NEXT 500 ERASE a:LOCATE 1,15:SAVE"beads.bin",b,9116,&8000 510 RETURN 520 : 530 ORIGIN cx,cy+200:FOR i=4 TO 90 STEP 2 540 PLOT a(i-2,0),a(i-2,1),1 550 DRAW a(i,0),a(i,1),1:MOVER -2,0:DRAWR a(i,2),0,cl:PLOTR 0,0,1 560 PLOT a(i-2,0),2-a(i-2,1),1:MOVER -2,0:DRAWR a(i,2),0,cl 570 PLOTR 0,0,1 580 NEXT 590 RETURN 600 REM *** Animate *** 610 RESTORE 610:FOR i=1 TO 4:fp(i,0)=1-2*ROUND(RND):READ fp(i,1):NEXT:DATA 1,3,6,8 620 WHILE 1 630 FOR f=1 TO 4 640 fp(f,1)=fp(f,1)+fp(f,0):IF fp(f,1)=9 OR fp(f,1)=0 THEN fp(f,0)=-fp(f,0):GOTO 660 650 CALL get,f,fp(f,1) 660 NEXT:IF INKEY$<>"" THEN RETURN 670 WEND 680 REM *** Machine code *** 690 MEMORY 8999:ln=790:RESTORE 790 700 FOR adr=&2328 TO &239B STEP 13 710 READ byte$:chk=0 720 FOR i=0 TO 12 730 v=VAL("&"+MID$(byte$,i*2+1,2)) 740 POKE adr+i,v:chk=chk+v 750 NEXT 760 IF chk<>VAL("&"+RIGHT$(byte$,3)) THEN PRINT"ERROR in LINE";ln:STOP 770 ln=ln+4:NEXT 780 RETURN 790 DATA CD73235D542100C00664C5E50150A 800 DATA 2800EDB0E17CC60867D24723D5668 810 DATA 1150C019D1C110E8C9FE02C0CD71A 820 DATA 7323CD80230664CD19BDC5D5015AE 830 DATA 2800EDB0D17AC60857D26F23E567E 840 DATA 2150C019D1EBC110E7C9DD46006AA 850 DATA 21FC1311A00F1910FDC9DD4602504 860 DATA FD219223FD23FD2310FAFD5E00678 870 DATA FD5601C900C028C0C0E3E8E300733 |