Code used Pallette entrys 2 - 5 so I just looped those on each other.
Code: Select all
05 GOSUB 45000: REM WRITE VERA DEFAULT PALLETTE
10 PA=$FA00
20 VPOKE 1,PA+ 0,0 :VPOKE 1,PA+ 1, 0
30 VPOKE 1,PA+ 2,0 :VPOKE 1,PA+ 3, 0
40 VPOKE 1,PA+ 4,0 +$0F:VPOKE 1,PA+ 5, 0
50 VPOKE 1,PA+ 6,0 +$0F:VPOKE 1,PA+ 7,$0F
60 VPOKE 1,PA+ 8,$F0+$0F:VPOKE 1,PA+ 9, 0
70 VPOKE 1,PA+10,$F0+$0F:VPOKE 1,PA+11,$0F
75 P1=2
110 N%=200
120 R=\XFF*2/235
130 X=0:Y=0:V=0:T=0
140 S%=60
150 SCREEN $80
160 CLS
210 FOR I=0 TO N%
220 FOR J=0 TO N%
230 U=SIN(I+V)+SIN(R*I+X)
240 V=COS(I+V)+COS(R*I+X)
250 X=U+T
260 A%=40+INT((2+U)*S%):B%=INT((2-V)*S%)
270 C%=2
280 IF I>=100 THEN C%=C%+1
290 IF J>=100 THEN C%=C%+2
300 PSET A%,B%,C%
305 IF J/40 = INT(J/40) THEN GOSUB 500
310 NEXT J
320 NEXT I
325 X = 0
330 GET A$
335 X=X+1:IF X/40=INT(X/40) THEN GOSUB 500
336 IF X = 2000 THEN X=0
340 IF A$="" THEN 330
370 T=T+.025
380 GOTO 150
500 IF P1=2 THEN P2=5:GOTO 520
510 P2 = P1 - 1
520 GOSUB 40500
530 P1 = P1 - 1:IF P1<2 THEN P1=5
540 RETURN
REM SET OF GOSUBS FOR DIRECT VERA PALLETTE MANIPULATION
REM USES VPOKE & VPEEK
REM FOR THE OTHER ROUTINES TO WORK RELIABLY SHOULD GOSUB 45000
REM FIRST. ALSO GOSUB 45000 IS USED AT ANY TIME TO RESET
REM THE VERA PALLETTE TO DEFAULT VALUES.
REM ..
REM ...
REM WHEN THE VERA IS INITIALLY SET TO GRAPHICS MODE IT USES THE
REM DEFAULT PALLETTE BUT IF YOU USE VPEEK TO READ IT RETURNS
REM RANDOM GARBAGE... AFTER YOU VPOKE THEM IT ALL WORKS
REM AS EXPECTED.
REM .
REM ..
REM ...
REM THIS CODE DOES ABSOLUTELY NO ERROR CHECKING !!!!!!
REM IF USING R%,G% OR B% VALUES SHOULD ALWAYS BE BETWEEN
REM 0-15
REM .
REM ..
REM ...
REM WHEN USING P1 AND P2 TO POINT AT PALLETTE ENTRYS THEY SHOULD
REM ALWAYS BE BETWEEN 0 AND 255
REM I HAD ERROR CHECKING CODE WHEN WRITING THESE ROUTINES
REM BUT ERROR CHECKING TAKES CPU CYCLES.... JUST KEEP THE VALUES
REM CORRECT BEFORE CALLING.
REM .
REM ..
REM ...
REM ..
REM GOSUB 45000.. POKES IN THE DEFAULT PALLETTE VALUES
REM SHOULD BE CALLED AT INIT. AND THEN ANY TIME
REM TO RESET THE VERA TO DEFAULT VALUES
REM ..
REM GOSUB 40000.. SETS PALLETTE ENTRY P1 TO R%,G%,B%
REM ..
REM GOSUB 40100.. READS VALUES AT P1 RETURNS IN R%,G%,B%
REM ..
REM GOSUB 40200.. CHANGES THE PALLETTE COLOR P2 TO P1. BUT DIFFERENT THAN 41000
REM 41000 CHANGES IT FAST. 40200 IMPLEMENTS A FADE WITH SPEED
REM CONTROLLED BY THE VALUE OF J (BIGGER VALUE=SLOWER)
REM ACTUALLY MOST OF THE WORK DONE BY GOSUB TO 40300
REM ..
REM GOSUB 40300 FADES PALLETTE COLOR AT P1 TO R%,G%,B%
REM SPEED CONTROLLED BY THE VALUE OF J. 1 TO 10
REM IS SO FAR BEST FOR ME BUT I DIDN'T RESTRICT VALUES
REM THE BIGGER J IS.. THE SLOWER THE FADE.
REM ..
REM GOSUB 40500.. SWAPS THE PALLETTE VALUES BETWEEN P1 AND P2
REM IF AND ITS A BIG IF... I MAKE FURTHER CHANGES
REM THE NEXT ROUTINE I MAKE WILL BE TO DO THIS AS A
REM ..FADE.. USING A SIMILIAR ALGORITHM I USED IN GOSUB 40300
REM ..
REM GOSUB 41000.. COPYS PALLETTE ENTRY P1 TO P2. P1 IS UNCHANGED
REM ..
REM .
REM ..
REM ...
39995 REM SET PALLETTE ENTRY P1 TO R%,G%,B%
40000 VPOKE 1,$FA00+(P1*2),(G%*16) + B%
40010 VPOKE 1,$FA00+((P1*2)+1),R%
40020 RETURN
40100 REM READ PALLETTE ENTRY AT P1
40100 REM RETURNED IN %R,%G,%B
40100 A1 = $FA00+(P1*2)
40105 R% = VPEEK(1,A1+1)
40110 GB%= VPEEK(1,A1)
40115 G% = GB%/16
40120 B% = GB% AND $0F
40125 RETURN
40199 FADE P2 FROM CURRENT COLOR TO P1 COLOR, J IS JIFFY DELAY
40200 GOSUB 40100
40205 P3=P1
40210 P1=P2
40215 GOSUB 40300
40220 P1=P3
40225 RETURN
40299 REM FADE P1 TO R%,G%,B%, J IS JIFFY DELAY
40300 DR%=R%:DG%=G%:DB%=B%
40305 GOSUB 40100
40310 RI=1:IF DR%<R% THEN RI=-1
40315 GI=1:IF DG%<G% THEN GI=-1
40320 BI=1:IF DB%<B% THEN BI=-1
40325 IF DR%<>R% THEN R%=R%+RI
40330 IF DG%<>G% THEN G%=G%+GI
40335 IF DB%<>B% THEN B%=B%+BI
40340 GOSUB 40000
40345 SLEEP J
40350 IF DR%=R% AND DG%=G% AND DB%=B% THEN 40360
40355 GOTO 40325
40360 RETURN
40499 REM SWAP PALLETTE COLORS AT P1 & P2
40500 A1 = $FA00+(P1*2)
40505 A2 = $FA00+(P2*2)
40510 B1 = VPEEK (1,A1)
40515 B2 = VPEEK (1,A1+1)
40520 B3 = VPEEK (1,A2)
40525 B4 = VPEEK (1,A2+1)
40530 VPOKE 1, A1, B3
40535 VPOKE 1, A1+1, B4
40540 VPOKE 1, A2, B1
40550 VPOKE 1, A2+1, B2
40560 RETURN
40999 REM COPY P1 PALLETTE ENTRY TO P2.. P1 IS LEFT UNCHANGED.
41000 VPOKE 1,$FA00+(P2*2), VPEEK(1, $FA00+(P1*2))
41010 VPOKE 1,$FA00+(P2*2)+1, VPEEK(1, $FA00+(P1*2)+1)
41020 RETURN
45000 RESTORE 50000
45010 REM LOOP THROUGH THE PALLETTE ADDRESS SPACE
45015 REM AND POKE THE VERA DEFAULT PALLETTE
45020 FOR PE = $FA00 TO $FBFE STEP 2
45025 READ R:READ GB
45030 VPOKE 1,PE,GB
45035 VPOKE 1,PE+1, R
45040 NEXT PE
45050 RETURN
49999 REM DEFAULT VERA PALLETTE AS DATA. FROM 0 TO 255 (2 BYTES EACH ENTRY)RGB
50000 DATA $00,$00,$0F,$FF,$08,$00,$0A,$FE,$0C,$4C,$00,$C5,$00,$0A,$0E,$E7,$0D
50005 DATA $85,$06,$40,$0F,$77,$03,$33,$07,$77,$0A,$F6,$00,$8F,$0B,$BB,$00,$00
50010 DATA $01,$11,$02,$22,$03,$33,$04,$44,$05,$55,$06,$66,$07,$77,$08,$88,$09
50015 DATA $99,$0A,$AA,$0B,$BB,$0C,$CC,$0D,$DD,$0E,$EE,$0F,$FF,$02,$11,$04,$33
50020 DATA $06,$44,$08,$66,$0A,$88,$0C,$99,$0F,$BB,$02,$11,$04,$22,$06,$33,$08
50025 DATA $44,$0A,$55,$0C,$66,$0F,$77,$02,$00,$04,$11,$06,$11,$08,$22,$0A,$22
50030 DATA $0C,$33,$0F,$33,$02,$00,$04,$00,$06,$00,$08,$00,$0A,$00,$0C,$00,$0F
50035 DATA $00,$02,$21,$04,$43,$06,$64,$08,$86,$0A,$A8,$0C,$C9,$0F,$EB,$02,$11
50040 DATA $04,$32,$06,$53,$08,$74,$0A,$95,$0C,$B6,$0F,$D7,$02,$10,$04,$31,$06
50045 DATA $51,$08,$62,$0A,$82,$0C,$A3,$0F,$C3,$02,$10,$04,$30,$06,$40,$08,$60
50050 DATA $0A,$80,$0C,$90,$0F,$B0,$01,$21,$03,$43,$05,$64,$07,$86,$09,$A8,$0B
50055 DATA $C9,$0D,$FB,$01,$21,$03,$42,$04,$63,$06,$84,$08,$A5,$09,$C6,$0B,$F7
50060 DATA $01,$20,$02,$41,$04,$61,$05,$82,$06,$A2,$08,$C3,$09,$F3,$01,$20,$02
50065 DATA $40,$03,$60,$04,$80,$05,$A0,$06,$C0,$07,$F0,$01,$21,$03,$43,$04,$65
50070 DATA $06,$86,$08,$A8,$09,$CA,$0B,$FC,$01,$21,$02,$42,$03,$64,$04,$85,$05
50075 DATA $A6,$06,$C8,$07,$F9,$00,$20,$01,$41,$01,$62,$02,$83,$02,$A4,$03,$C5
50080 DATA $03,$F6,$00,$20,$00,$41,$00,$61,$00,$82,$00,$A2,$00,$C3,$00,$F3,$01
50085 DATA $22,$03,$44,$04,$66,$06,$88,$08,$AA,$09,$CC,$0B,$FF,$01,$22,$02,$44
50090 DATA $03,$66,$04,$88,$05,$AA,$06,$CC,$07,$FF,$00,$22,$01,$44,$01,$66,$02
50095 DATA $88,$02,$AA,$03,$CC,$03,$FF,$00,$22,$00,$44,$00,$66,$00,$88,$00,$AA
50100 DATA $00,$CC,$00,$FF,$01,$12,$03,$34,$04,$56,$06,$68,$08,$8A,$09,$AC,$0B
50105 DATA $CF,$01,$12,$02,$24,$03,$46,$04,$58,$05,$6A,$06,$8C,$07,$9F,$00,$02
50110 DATA $01,$14,$01,$26,$02,$38,$02,$4A,$03,$5C,$03,$6F,$00,$02,$00,$14,$00
50115 DATA $16,$00,$28,$00,$2A,$00,$3C,$00,$3F,$01,$12,$03,$34,$05,$46,$07,$68
50120 DATA $09,$8A,$0B,$9C,$0D,$BF,$01,$12,$03,$24,$04,$36,$06,$48,$08,$5A,$09
50125 DATA $6C,$0B,$7F,$01,$02,$02,$14,$04,$16,$05,$28,$06,$2A,$08,$3C,$09,$3F
50130 DATA $01,$02,$02,$04,$03,$06,$04,$08,$05,$0A,$06,$0C,$07,$0F,$02,$12,$04
50135 DATA $34,$06,$46,$08,$68,$0A,$8A,$0C,$9C,$0F,$BE,$02,$11,$04,$23,$06,$35
50140 DATA $08,$47,$0A,$59,$0C,$6B,$0F,$7D,$02,$01,$04,$13,$06,$15,$08,$26,$0A
50145 DATA $28,$0C,$3A,$0F,$3C,$02,$01,$04,$03,$06,$04,$08,$06,$0A,$08,$0C,$09
50150 DATA $0F,$0B
BUBBLE2.BAS- (6.93 KiB) Downloaded 215 times
BUBBLEA.PRG- (4.23 KiB) Downloaded 236 times