Author |
Topic: Some RISC OS graphical ditties converted to BB4W (Read 622 times) |
|
DDRM
Administrator
member is offline
Gender: 
Posts: 321
|
 |
Re: Some RISC OS graphical ditties converted to BB
« Reply #14 on: Nov 22nd, 2015, 9:57pm » |
|
Hi David,
Something like this?
Code:
REM > WHEEL
MODE8:ORIGIN 640,512:OFF
GCOL 15
da=PI/120
FOR M%=82 TO 0 STEP -1
Z%=10*M%
FOR N%=1 TO 240
C%=(N%+M%) MOD 30
IF ((N%+M%) DIV 30) MOD 2 =0 THEN C%=30-C%
COLOUR 15,C%*8,0,(30-C%)*8
MOVE 0,0:MOVE Z%*SIN(N%*da),Z%*COS(N%*da)
PLOT85,Z%*SIN((N%+1)*da),Z%*COS((N%+1)*da)
NEXT N%
NEXT M%
END
I haven't tried to reproduce the dithering, I've just used the better colour options of BB4W! Makes life much easier...
By the way, I don't recall ever seeing NEXT, to close all the open FOR-NEXT loops!
:-)
D
|
|
 Logged
|
|
|
|
David Williams
Developer
member is offline
meh
Gender:
Posts: 452
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #15 on: Nov 22nd, 2015, 11:43pm » |
|
on Nov 22nd, 2015, 9:57pm, DDRM wrote:Hi David,
Something like this? |
|
Yes! Clever. Neatly wrapped up in a few lines of BASIC. When I first saw the original program run (under RISC OS on RPCEmu), and glanced at the code, I wondered how he got such smooth colour gradations in a 16-colour mode. Then I looked up VDU 23, 2, ... and there was the answer. The dithering in the original version is practically imperceptible (at least to my eyes).
Anyway, thanks for successfully meeting the challenge!
Quote:| By the way, I don't recall ever seeing NEXT, to close all the open FOR-NEXT loops! |
|
I noticed he does that in many of his programs. The reason behind it might be primarily speed - perhaps there's a small boost. He was writing many of his graphical 'ditties' on a relatively slow ARM2-based machine, so shaving off a few dozen clock cycles here and there may have been worthwhile.
Incidentally, here is his circular maze drawing program which I mentioned in a previous post. The only change I had to make was the display mode, and draw thicker lines (see what happens if you remove the @vdu%!248=2 statement!).
By the way, it may not be a 'true' maze! I haven't checked.
Code:
REM > MAZE
REM by Jan Vibe
REM Adapted for BB4W by DW
MODE 8
VDU5:MOVE 610,524:PRINT"Goal":VDU4:OFF
@vdu%!248 = 2
CIRCLE 640,512,500:CIRCLE 640,512,64
PROCA(400,512)
GCOL0:CIRCLE 640,512,500:CIRCLE 640,512,64:ON
@vdu%!248 = 1
END
DEFPROCA(X%,Y%)
LOCAL N%
FOR N%=1TO8:T=RADRND(360):X1%=X%+16*SINT:Y1%=Y%+16*COST
C%=0:FORI%=-8TO8STEP2
IF POINT(X1%+I%,Y1%+8)<>0 C%+=1
IF POINT(X1%+I%,Y1%-8)<>0 C%+=1
NEXT:FORI%=-4TO4STEP4
IF POINT(X1%+8,Y1%+I%)<>0 C%+=1
IF POINT(X1%-8,Y1%+I%)<>0 C%+=1
NEXT:IF C%<1 LINE X%,Y%,X1%,Y1%:PROCA(X1%,Y1%)
NEXT
ENDPROC
David.
--
|
|
Logged
|
|
|
|
David Williams
Developer
member is offline
meh
Gender:
Posts: 452
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #16 on: Nov 23rd, 2015, 12:44pm » |
|
More:
Code: REM > SQUIGG2
REM by Jan Vibe
REM Adapted for BB4W by DW
REMSYS"OS_UpdateMEMC",64,64
REMONERRORGOTO 370
REMMODE0:MODE128:OFF
MODE 8 : OFF
DIMA%(4),X%(180,2),Y%(180,2)
N%=RND(-TIME)
FORN%=1TO4:A%(N%)=2*RND(6):NEXT
FORN%=1TO180
X%(N%,1)=500*SINRAD(A%(1)*N%)*COSRAD(A%(2)*N%)+640
Y%(N%,1)=500*SINRAD(A%(3)*N%)*COSRAD(A%(4)*N%)+512
NEXT
REMA$="1":B$="2"
C%=2:K%=60
*REFRESH OFF
REPEAT
D%=C%:C%=3-C%
FORN%=1TO4:A%(N%)=2*RND(6):NEXT
FORN%=1TO180
X%(N%,D%)=500*SINRAD(A%(1)*N%)*COSRAD(A%(2)*N%)+640
Y%(N%,D%)=500*SINRAD(A%(3)*N%)*COSRAD(A%(4)*N%)+512
NEXT
FORI%=0TOK%
FORN%=1TO180
X%(N%,0)=(I%*X%(N%,D%)+(K%-I%)*X%(N%,C%))/K%
Y%(N%,0)=(I%*Y%(N%,D%)+(K%-I%)*Y%(N%,C%))/K%
NEXT
CLS
MOVEX%(180,0),Y%(180,0):FORN%=1TO180:DRAWX%(N%,0),Y%(N%,0):NEXT
REMOSCLI"FX 112,"+A$
REMOSCLI"FX 113,"+B$
REMSWAP A$,B$
REMWAIT:CLS
*REFRESH
WAIT 1
NEXT
UNTIL0
REMOSCLI"FX112,"+A$:ON:REPORT:PRINT" at line "STR$ERL
Code: REM > SQUIGG5
REM by Jan Vibe
REM Adapted for BB4W by DW
REMSYS"OS_UpdateMEMC",64,64
REMMODE128:MODE0:OFF:ORIGIN 640,512
MODE 8:OFF:ORIGIN 640,512
REMS1%=1:S2%=2
D1%=1:D2%=2:I%=64:K%=I%
DIM PX%(120,2),PY%(120,2)
PROCA(1):PROCA(2)
REMONERRORGOTO310
*REFRESH OFF
REPEAT
CLS
REMSYS 6,112,S1%:SYS 6,113,S2%:WAIT:CLS:SWAP S1%,S2%
IF K%=0 SWAP D1%,D2%:PROCA(D2%):K%=I% ELSE K%-=1
MOVE170,170:FORN%=1TO120
X=(PX%(N%,D1%)*K%+PX%(N%,D2%)*(I%-K%))/I%
Y=(PY%(N%,D1%)*K%+PY%(N%,D2%)*(I%-K%))/I%
DRAW X,Y:NEXT
ENDIF
*REFRESH
WAIT 1
UNTIL0
DEFPROCA(P%)
LOCAL N%,K1%,K2%,K3%,K4%,K5%,K6%,T
K1%=RND(10):K2%=RND(10):K3%=RND(10)
K4%=RND(10):K5%=RND(10):K6%=RND(10)
FORN%=1TO120:T=RAD(N%*3)
X=170*(SIN(K1%*T)+COS(K2%*T)+SIN(K3%*T))
Y=170*(SIN(K4%*T)+COS(K5%*T)+SIN(K6%*T))
PX%(N%,P%)=X:PY%(N%,P%)=Y
NEXT
ENDPROC
REMSYS 6,112,S1%:REPORT:PRINT" at line "STR$ERL:ON
Code: REM > WBLOCKS
REM by Jan Vibe
REM Adapted for BB4W by DW
REMMODE12:ORIGIN 0,256:OFF
MODE 8 : ORIGIN 0,256 : OFF
REMSYS"OS_UpdateMEMC",64,64
REMONERRORGOTO290
DIM A%(18,15):REMS1$="1":S2$="2"
*REFRESH OFF
REPEAT
FORN%=14TO0STEP-1:FORM%=0TO18:A%(M%,N%+1)=A%(M%,N%):NEXT,
K%=(K%+20)MOD360:Z%=128*SINRAD(K%+10)
REMOSCLI"FX112,"+S1$:OSCLI"FX113,"+S2$:WAIT:SWAPS1$,S2$:CLS
CLS
FORN%=0TO18
A%(N%,0)=Z%*SINRAD(30*N%+15)
NEXT
FORN%=15TO0STEP-1
FORM%=0TO18
X1%=56*M%+12*N%:Y1%=A%(M%,N%)+32*N%
X6%=X1%:Y6%=32*N%-128
X5%=X6%+56:Y5%=Y6%
X7%=X5%:Y7%=Y1%
X2%=X1%+12:Y2%=Y1%+32
X3%=X2%+56:Y3%=Y2%
X4%=X5%+12:Y4%=Y5%+32
GCOL1:MOVEX5%,Y5%:MOVEX4%,Y4%:PLOT&75,X3%,Y3%
GCOL2:MOVEX1%,Y1%:MOVEX7%,Y7%:PLOT&75,X3%,Y3%
GCOL4:MOVEX6%,Y6%:PLOT&65,X7%,Y7%
GCOL0:MOVEX1%,Y1%:DRAWX2%,Y2%:DRAWX3%,Y3%:DRAWX4%,Y4%:DRAWX5%,Y5%
DRAWX6%,Y6%:DRAWX1%,Y1%:DRAWX7%,Y7%:DRAWX5%,Y5%:LINEX7%,Y7%,X3%,Y3%
NEXT,
*REFRESH
WAIT 1
UNTIL0
REMOSCLI"FX112,"+S1$:REPORT:PRINT" at line "STR$ERL:ON
Code: REM > BLOBS
REM by Jan Vibe
REM Adapted for BB4W by DW
REM MODE12:MODE140:K%=20:OFF
MODE 8 : K%=20 : OFF
REMSYS"OS_UpdateMEMC",64,64
REMONERRORGOTO280
REMS1$="1":S2$="2"
DIMX%(K%),Y%(K%),R(K%),D(K%),DX%(K%),DY%(K%)
FORN%=1TOK%
R(N%)=64+RND(64):D(N%)=R(N%)/15
X%(N%)=R(N%)+RND(1280-2*R(N%))
Y%(N%)=R(N%)+RND(1024-2*R(N%))
DX%(N%)=4*RND(4)*SGN(RND(1)-.5)
DY%(N%)=4*RND(4)*SGN(RND(1)-.5)
NEXT
*REFRESH OFF
REPEAT
REMOSCLI"FX 112,"+S1$:OSCLI"FX113,"+S2$:WAIT:SWAP S1$,S2$:CLS
CLS
FORN%=1TO15:COLOUR N%,16*N%,16*N%,16*N%:NEXT
FORN%=1TO15:GCOL N%
FORM%=1TOK%:CIRCLE FILL X%(M%),Y%(M%),R(M%)-(N%-1)*D(M%)
NEXT,
FORN%=1TOK%
230 X1%=X%(N%)+DX%(N%):IFX1%-R(N%)<0ORX1%+R(N%)>1278 DX%(N%)=-DX%(N%):GOTO230
240 Y1%=Y%(N%)+DY%(N%):IFY1%-R(N%)<0ORY1%+R(N%)>1020 DY%(N%)=-DY%(N%):GOTO240
X%(N%)=X1%:Y%(N%)=Y1%:NEXT
*REFRESH
WAIT 1
UNTIL0
REMOSCLI"FX112,"+S1$:REPORT:PRINT" at line "STR$ERL:ON
Code: REM > WAVES
REM by Jan Vibe
REM Adapted for BB4W by DW
REMMODE12:ORIGIN 640,512:OFF:*FX10
MODE 8 : ORIGIN 640,512 : OFF : PROCpaletted
FORN%=1TO360:T=RADN%:K=10:SI=SINT:CO=COST
C%=7.5*(COSRAD(10*N%)+1):X=0:Y=0:MOVEX,Y
REPEAT:C%=C%MOD15+1:GCOL C%:K=K-.1:DX=K*SI:DY=K*CO
X=X+DX:Y=Y+DY:DRAW X,Y:UNTILK<=0:NEXT
C1%=1:C2%=9:REPEAT:C1%=C1%MOD15+1:C2%=C2%MOD15+1
WAIT:COLOUR C1%,255,255,255:COLOUR C2%,0,0,0
PROCanimate : WAIT 2
UNTIL0
REM The following code segment is from the
REM BB4W Programmer's Reference...
DEF PROCanimate
LOCAL C%, pal%()
DIM pal%(15)
SYS "GetPaletteEntries", @hpal%, 0, 16, ^pal%(0)
pal%() AND= &E0F0F0
FOR C% = 0 TO 15 : SWAP ?^pal%(C%), ?(2+^pal%(C%)) : NEXT
SYS "SetDIBColorTable", @memhdc%, 0, 16, ^pal%(0)
SYS "InvalidateRect", @hwnd%, 0, 0
ENDPROC
DEF PROCpaletted
LOCAL bits%, hbm%, oldbm%, bmih{}
DIM bmih{Size%, Width%, Height%, Planes{l&,h&}, BitCount{l&,h&}, \
\ Compression%, SizeImage%, XPelsPerMeter%, YPelsPerMeter%, \
\ ClrUsed%, ClrImportant%}
bmih.Size% = DIM(bmih{})
bmih.Width% = @vdu%!208
bmih.Height% = @vdu%!212
bmih.Planes.l& = 1
bmih.BitCount.l& = 4
SYS "CreateDIBSection", @memhdc%, bmih{}, 0, ^bits%, 0, 0 TO hbm%
IF hbm% = 0 ERROR 100, "Couldn't create DIBSection"
SYS "SelectObject", @memhdc%, hbm% TO oldbm%
SYS "DeleteObject", oldbm%
PROCanimate
ENDPROC
|
|
|
|
David Williams
Developer
member is offline
meh
Gender:
Posts: 452
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #17 on: Nov 23rd, 2015, 12:47pm » |
|
Avoid these two if you've consumed any LSD in the last hour or so:
Code: REM > NORDLYS
REM by Jan Vibe
REM Adapted for BB4W by DW
REMSYS"OS_UpdateMEMC",64,64
REMMODE12:ORIGIN 640,512:OFF
MODE 8 : ORIGIN 640,512 : OFF : PROCpaletted
DIM C1%(15),C2%(15),C3%(15),A%(4,2):N%=RND(-TIME):A%=0
FOR N%=1TO15
F1%=128*(SINRAD(24*N%)+1)
F2%=128*(SINRAD(24*N%+120)+1)
F3%=128*(SINRAD(24*N%+240)+1)
C1%(N%)=F1%:C2%(N%)=F2%:C3%(N%)=F3%
COLOUR N%,F1%,F2%,F3%
NEXT
REPEAT
FORN%=1TO2:FORM%=1TO4
A%(M%,N%)=RND(5)+1:NEXT,
FORN%=0TO270:T=RAD(N%/3)
X1=600*SIN(T*A%(1,1))*COS(T*A%(2,1))
Y1=500*SIN(T*A%(3,1))*COS(T*A%(4,1))
X2=600*SIN(T*A%(1,2))*COS(T*A%(2,2))
Y2=500*SIN(T*A%(3,2))*COS(T*A%(4,2))
ZX=(X2-X1)/28:ZY=(Y2-Y1)/28
FORI%=1TO15:C1%(I%-1)=C1%(I%):C2%(I%-1)=C2%(I%):C3%(I%-1)=C3%(I%)
NEXT:C1%(15)=C1%(0):C2%(15)=C2%(0):C3%(15)=C3%(0)
FORI%=1TO15:COLOURI%,C1%(I%),C2%(I%),C3%(I%):NEXT
PROCanimate : WAIT 1
A%=(A%+1)MOD15
FORM%=1TO15:GCOL 15-(M%+A%)MOD15
CIRCLE FILL X1,Y1,12:CIRCLE FILL X2,Y2,12
CIRCLE FILL -X1,Y1,12:CIRCLE FILL -X2,Y2,12
CIRCLE FILL -X1,-Y1,12:CIRCLE FILL -X2,-Y2,12
CIRCLE FILL X1,-Y1,12:CIRCLE FILL X2,-Y2,12
X1=X1+ZX:Y1=Y1+ZY:X2=X2-ZX:Y2=Y2-ZY
NEXT,
UNTIL0
REM The following code segment is from the
REM BB4W Programmer's Reference...
DEF PROCanimate
LOCAL C%, pal%()
DIM pal%(15)
SYS "GetPaletteEntries", @hpal%, 0, 16, ^pal%(0)
pal%() AND= &E0F0F0
FOR C% = 0 TO 15 : SWAP ?^pal%(C%), ?(2+^pal%(C%)) : NEXT
SYS "SetDIBColorTable", @memhdc%, 0, 16, ^pal%(0)
SYS "InvalidateRect", @hwnd%, 0, 0
ENDPROC
DEF PROCpaletted
LOCAL bits%, hbm%, oldbm%, bmih{}
DIM bmih{Size%, Width%, Height%, Planes{l&,h&}, BitCount{l&,h&}, \
\ Compression%, SizeImage%, XPelsPerMeter%, YPelsPerMeter%, \
\ ClrUsed%, ClrImportant%}
bmih.Size% = DIM(bmih{})
bmih.Width% = @vdu%!208
bmih.Height% = @vdu%!212
bmih.Planes.l& = 1
bmih.BitCount.l& = 4
SYS "CreateDIBSection", @memhdc%, bmih{}, 0, ^bits%, 0, 0 TO hbm%
IF hbm% = 0 ERROR 100, "Couldn't create DIBSection"
SYS "SelectObject", @memhdc%, hbm% TO oldbm%
SYS "DeleteObject", oldbm%
PROCanimate
ENDPROC
Code: REM > MATPAT
REM by Jan Vibe
REM Adapted for BB4W by DW
REM MODE9:OFF:ORIGIN 640,512
MODE 19 : OFF : ORIGIN 640,480 : PROCpaletted
DIMC1%(15),C2%(15),C3%(15)
FOR N%=1TO15
F1%=128*(SINRAD(24*N%)+1)
F2%=128*(SINRAD(24*N%+120)+1)
F3%=128*(SINRAD(24*N%+240)+1)
C1%(N%)=F1%:C2%(N%)=F2%:C3%(N%)=F3%
COLOUR N%,F1%,F2%,F3%
NEXT
FORB%=0TO128:Y%=B%*5
FORA%=B%TO160:X%=A%*5
GCOL(10*(COSRADX%+COSRADY%+SINRAD(SQR(X%*X%+Y%*Y%)*3)+3))MOD15+1
PLOT 4*A%,4*B%:PLOT -4*A%,4*B%:PLOT -4*A%,-4*B%:PLOT 4*A%,-4*B%
PLOT 4*B%,4*A%:PLOT -4*B%,4*A%:PLOT -4*B%,-4*A%:PLOT 4*B%,-4*A%
IF TIME>=3 THEN
FORI%=1TO15:C1%(I%-1)=C1%(I%):C2%(I%-1)=C2%(I%):C3%(I%-1)=C3%(I%)
NEXT:C1%(15)=C1%(0):C2%(15)=C2%(0):C3%(15)=C3%(0)
FORI%=1TO15:COLOURI%,C1%(I%),C2%(I%),C3%(I%):NEXT:PROCanimate:TIME=0
ENDIF
NEXT,
REPEAT
FORI%=1TO15:C1%(I%-1)=C1%(I%):C2%(I%-1)=C2%(I%):C3%(I%-1)=C3%(I%)
NEXT:C1%(15)=C1%(0):C2%(15)=C2%(0):C3%(15)=C3%(0)
FORI%=1TO15:COLOURI%,C1%(I%),C2%(I%),C3%(I%):NEXT
PROCanimate
K%=INKEY(3)
UNTIL0
REM The following code segment is from the
REM BB4W Programmer's Reference...
DEF PROCanimate
LOCAL C%, pal%()
DIM pal%(15)
SYS "GetPaletteEntries", @hpal%, 0, 16, ^pal%(0)
pal%() AND= &E0F0F0
FOR C% = 0 TO 15 : SWAP ?^pal%(C%), ?(2+^pal%(C%)) : NEXT
SYS "SetDIBColorTable", @memhdc%, 0, 16, ^pal%(0)
SYS "InvalidateRect", @hwnd%, 0, 0
ENDPROC
DEF PROCpaletted
LOCAL bits%, hbm%, oldbm%, bmih{}
DIM bmih{Size%, Width%, Height%, Planes{l&,h&}, BitCount{l&,h&}, \
\ Compression%, SizeImage%, XPelsPerMeter%, YPelsPerMeter%, \
\ ClrUsed%, ClrImportant%}
bmih.Size% = DIM(bmih{})
bmih.Width% = @vdu%!208
bmih.Height% = @vdu%!212
bmih.Planes.l& = 1
bmih.BitCount.l& = 4
SYS "CreateDIBSection", @memhdc%, bmih{}, 0, ^bits%, 0, 0 TO hbm%
IF hbm% = 0 ERROR 100, "Couldn't create DIBSection"
SYS "SelectObject", @memhdc%, hbm% TO oldbm%
SYS "DeleteObject", oldbm%
PROCanimate
ENDPROC
|
|
|
|
David Williams
Developer
member is offline
meh
Gender:
Posts: 452
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #18 on: Nov 23rd, 2015, 2:27pm » |
|
Code: REM > ILD
REM by Jan Vibe
REM Adapted for BB4W by DW
REMMODE12:OFF
MODE 8 : OFF : PROCpaletted
DIMA%(4),C1%(15),C2%(15),C3%(15)
FORN%=1TO15
F1%=24*N%:F2%=F1%+120:F3%=F1%+240
C1%(N%)=128*(SINRADF1%+1)
C2%(N%)=128*(SINRADF2%+1)
C3%(N%)=128*(SINRADF3%+1)
COLOUR N%,C1%(N%),C2%(N%),C3%(N%)
NEXT
REPEAT
F%=1:R%=0
REPEAT:GCOL0,F%:F%=F%MOD15+1
@vdu%!248 = 2
FORN%=0TO8STEP2
CIRCLE640,512,R%+N%
CIRCLE640,510,R%+N%
IF TIME>=4 PROCS:TIME=0
NEXT:R%=R%+N%:UNTILR%>820
@vdu%!248 = 1
FORN%=1TO6
A%=RND(30)+20:Z=RND(1)+1:F%=RND(180)
FORX%=0TO1280STEP2:Y%=A%*SINRAD(X%*Z+F%)
RECTANGLE FILL X%,0,2,1022 TO X%,Y%
IF TIME>=4 PROCS:TIME=0
NEXT
A%=RND(30)+20:Z=RND(1)+1:F%=RND(180)
FORY%=0TO1024STEP4:X%=A%*SINRAD(Y%*Z+F%)
RECTANGLE FILL0,Y%,1280,2 TO X%,Y%
IF TIME>=4 PROCS:TIME=0
NEXT,
TIME=0
REPEAT
PROCS:K=INKEY(4)
UNTIL TIME>=3000
UNTIL0
DEFPROCS
LOCAL N%
C1%(0)=C1%(15):C2%(0)=C2%(15):C3%(0)=C3%(15)
FORN%=14TO0STEP-1
C1%(N%+1)=C1%(N%):C2%(N%+1)=C2%(N%):C3%(N%+1)=C3%(N%)
NEXT:FORN%=1TO15:COLOUR N%,C1%(N%),C2%(N%),C3%(N%):PROCanimate:NEXT
ENDPROC
REM The following code segment is from the
REM BB4W Programmer's Reference...
DEF PROCanimate
LOCAL C%, pal%()
DIM pal%(15)
SYS "GetPaletteEntries", @hpal%, 0, 16, ^pal%(0)
pal%() AND= &E0F0F0
FOR C% = 0 TO 15 : SWAP ?^pal%(C%), ?(2+^pal%(C%)) : NEXT
SYS "SetDIBColorTable", @memhdc%, 0, 16, ^pal%(0)
SYS "InvalidateRect", @hwnd%, 0, 0
ENDPROC
DEF PROCpaletted
LOCAL bits%, hbm%, oldbm%, bmih{}
DIM bmih{Size%, Width%, Height%, Planes{l&,h&}, BitCount{l&,h&}, \
\ Compression%, SizeImage%, XPelsPerMeter%, YPelsPerMeter%, \
\ ClrUsed%, ClrImportant%}
bmih.Size% = DIM(bmih{})
bmih.Width% = @vdu%!208
bmih.Height% = @vdu%!212
bmih.Planes.l& = 1
bmih.BitCount.l& = 4
SYS "CreateDIBSection", @memhdc%, bmih{}, 0, ^bits%, 0, 0 TO hbm%
IF hbm% = 0 ERROR 100, "Couldn't create DIBSection"
SYS "SelectObject", @memhdc%, hbm% TO oldbm%
SYS "DeleteObject", oldbm%
PROCanimate
ENDPROC
|
|
Logged
|
|
|
|
David Williams
Developer
member is offline
meh
Gender:
Posts: 452
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #19 on: Nov 26th, 2015, 10:59pm » |
|
Not by Jan Vibe, but certainly inspired by one or two of his programs. It redraws (usually with a different colour scheme) every 10-or-so seconds.
Code:
REM>POLYWEB
REM by DW
REM Inspired by JV
REM Coded so as to be easily 'ported' to ARM BBC BASIC
MODE 10
OFF
ScrW% = @vdu%!208
ScrH% = @vdu%!212
Cx% = ScrW% DIV 2
Cy% = ScrH% DIV 2
MaxDist% = SQR(Cx%^2 + Cy%^2) + 0.5
NumCircs% = 150
MinSepDist% = 16
MaxSepDist% = 80
SepDiff% = MaxSepDist% - MinSepDist%
InitialRadius% = 100
DIM x%(NumCircs%-1), y%(NumCircs%-1)
DIM col%(NumCircs%-1, 2) : REM 0=R, 1=G, 2=B
R% = RND(-TIME)
REPEAT
swapRGB1% = RND(3)-1
swapRGB2% = RND(3)-1
swapRGB3% = RND(3)-1
swapRGB4% = RND(3)-1
invertR% = RND(2)-1
invertG% = RND(2)-1
invertB% = RND(2)-1
invertF% = RND(2)-1
x%(0) = RND( ScrW% )-1
y%(0) = RND( ScrH% )-1
PROCColour(0, FNdist(x%(0), y%(0))/MaxDist% )
FOR I% = 1 TO NumCircs%-1
REPEAT
x% = RND( ScrW% )-1
y% = RND( ScrH% )-1
dist0% = FNdist(x%, y%)
mindist% = MinSepDist% + dist0%/MaxDist%*SepDiff%
FOR J% = 0 TO I%-1
accept% = TRUE
d% = SQR((x% - x%(J%))^2 + (y% - y%(J%))^2)
IF d% < mindist% THEN
accept% = FALSE
J% = I%-1
ENDIF
NEXT J%
UNTIL accept%
x%(I%) = x%
y%(I%) = y%
PROCColour( I%, dist0%/MaxDist% )
NEXT I%
CLS
GCOL 15
FOR R% = InitialRadius% TO 1 STEP -1
FOR I% = 0 TO NumCircs%-1
COLOUR 15, col%(I%,0), col%(I%,1), col%(I%,2)
CIRCLE FILL 2*x%(I%), 2*y%(I%), 2*R%
NEXT I%
NEXT R%
WAIT 1000
UNTIL FALSE
END
DEF FNdist(X%, Y%)
= SQR((X% - Cx%)^2 + (Y% - Cy%)^2)
DEF PROCColour( K%, f )
IF invertF% THEN f = 1-f
col%(K%, 0) = f * RND(32)
col%(K%, 1) = f * (128 + RND(127))
col%(K%, 2) = f * RND(128)
IF invertR% THEN col%(K%,0) = 255 - col%(K%,0)
IF invertG% THEN col%(K%,1) = 255 - col%(K%,1)
IF invertB% THEN col%(K%,2) = 255 - col%(K%,2)
SWAP col%(K%, swapRGB1%), col%(K%, swapRGB2%)
SWAP col%(K%, swapRGB3%), col%(K%, swapRGB4%)
ENDPROC
|
|
|
|
David Williams
Developer
member is offline
meh
Gender:
Posts: 452
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #20 on: Nov 27th, 2015, 4:03pm » |
|
Who needs multithreading when you've got TIMERLIB?
This works well on my laptop PC, with occasional hiccups:
Code:
REM>POLYWEB2
REM by DW
REM Inspired by JV
*FLOAT 64
*ESC OFF
MODE 10
OFF
BallSprPath$ = LEFT$(@lib$, LEN@lib$-4) + "EXAMPLES\GRAPHICS\BALL.ICO"
NumBalls% = 20
ScrW% = @vdu%!208
ScrH% = @vdu%!212
INSTALL @lib$ + "TIMERLIB"
INSTALL @lib$ + "NOWAIT"
INSTALL @lib$ + "SPRITELIB"
IF FN_initsprites( NumBalls% ) = 0 STOP
SprReady% = FALSE
timerid% = FN_ontimer(10, PROCUpdateBalls, 1)
ON CLOSE PROC_killtimer(timerid%) : PROC_exitsprites : QUIT
ON ERROR ON ERROR OFF : PROC_killtimer(timerid%) : PROC_exitsprites : OSCLI "REFRESH ON" : PRINT 'REPORT$ : END
FOR I% = 0 TO NumBalls%-1
IF FN_createsprite(I%, BallSprPath$, 32, 32) = 0 ERROR 0, "Cannot create sprite "+STR$I%
NEXT I%
SprReady% = TRUE
Cx% = ScrW% DIV 2
Cy% = ScrH% DIV 2
MaxDist% = SQR(Cx%^2 + Cy%^2) + 0.5
NumCircs% = 150
MinSepDist% = 16
MaxSepDist% = 80
SepDiff% = MaxSepDist% - MinSepDist%
InitialRadius% = 100
DIM x%(NumCircs%-1), y%(NumCircs%-1)
DIM col%(NumCircs%-1, 2) : REM 0=R, 1=G, 2=B
R% = RND(-TIME) : TIME = 0
REPEAT
swapRGB1% = RND(3)-1
swapRGB2% = RND(3)-1
swapRGB3% = RND(3)-1
swapRGB4% = RND(3)-1
invertR% = RND(2)-1
invertG% = RND(2)-1
invertB% = RND(2)-1
invertF% = RND(2)-1
x%(0) = RND( ScrW% )-1
y%(0) = RND( ScrH% )-1
PROCColour(0, FNdist(x%(0), y%(0))/MaxDist% )
FOR I% = 1 TO NumCircs%-1
REPEAT
x% = RND( ScrW% )-1
y% = RND( ScrH% )-1
dist0% = FNdist(x%, y%)
mindist% = MinSepDist% + dist0%/MaxDist%*SepDiff%
FOR J% = 0 TO I%-1
accept% = TRUE
d% = SQR((x% - x%(J%))^2 + (y% - y%(J%))^2)
IF d% < mindist% THEN
accept% = FALSE
J% = I%-1
ENDIF
NEXT J%
UNTIL accept%
x%(I%) = x%
y%(I%) = y%
PROCColour( I%, dist0%/MaxDist% )
NEXT I%
CLS
GCOL 15
FOR R% = InitialRadius% TO 1 STEP -1
FOR I% = 0 TO NumCircs%-1
COLOUR 15, col%(I%,0), col%(I%,1), col%(I%,2)
CIRCLE FILL 2*x%(I%), 2*y%(I%), 2*R%
NEXT I%
NEXT R%
PROCwait(500)
UNTIL FALSE
END
DEF FNdist(X%, Y%)
= SQR((X% - Cx%)^2 + (Y% - Cy%)^2)
DEF PROCColour( K%, f )
IF invertF% THEN f = 1-f
col%(K%, 0) = f * RND(32)
col%(K%, 1) = f * (128 + RND(127))
col%(K%, 2) = f * RND(128)
IF invertR% THEN col%(K%,0) = 255 - col%(K%,0)
IF invertG% THEN col%(K%,1) = 255 - col%(K%,1)
IF invertB% THEN col%(K%,2) = 255 - col%(K%,2)
SWAP col%(K%, swapRGB1%), col%(K%, swapRGB2%)
SWAP col%(K%, swapRGB3%), col%(K%, swapRGB4%)
ENDPROC
DEF PROCUpdateBalls
IF NOT SprReady% THEN ENDPROC
LOCAL I%, T%, X%, Y%, a, b, c, d, e, f
T% = TIME
FOR I% = 0 TO NumBalls%-1
a = T%/35 + I%/10
b = T%/92 + 0.3
c = T%/134 + 1.4
d = SIN(T%/200)
e = SIN(T%/50 + 2.1)*COS(T%/250 - 0.8)
f = SIN(T%/160 + I%/8)*COS(T%/123 + 1.4)
X% = 320*SIN(a + f)*SIN(b + d)*SIN(c + e)
Y% = 300*COS(a + f)*COS(b + d)*COS(c + e)
PROC_movesprite(I%, ScrW%+2*X%, ScrH%+2*Y%, 1)
NEXT I%
ENDPROC
|
|
Logged
|
|
|
|
dfeugey
Guest
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #21 on: Nov 28th, 2015, 12:41pm » |
|
Cool...
|
|
Logged
|
|
|
|
David Williams
Developer
member is offline
meh
Gender:
Posts: 452
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #22 on: Nov 28th, 2015, 8:39pm » |
|
on Nov 28th, 2015, 12:41pm, dfeugey wrote:
I think it's time for an ARM BBC BASIC 'mega demo'.  Ideally not touching assembly language (in order to keep it purely BASIC). Anyway, if one were to go ahead with it, I think the Raspberry Pi 2 would have to be the minimum requirement (the new Titanium sounds very nice, but I can't afford one!).
Perhaps a future Raspberry Pi 3 will feature an ARM Cortex-A15? That'd be nice, wouldn't it?
(Someone ought to suggest it to Eben.)
Some new additions to my website: http://www.proggies.uk
I intend to upload my old and more recent BB4W efforts over the next week or two.
David.
--
|
|
|
|
dfeugey
Guest
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #23 on: Nov 29th, 2015, 06:47am » |
|
Yep, there is some room for a BBC Basic scene, because of the very fast two offers available (BBCBasic4Win and BBC Basic for RISC OS) and of the presence of interesting computers. On my todo list, I plan to recompile Brandy, with all the latest modifications, and perhaps even CGI management.
|
|
Logged
|
|
|
|
DDRM
Administrator
member is offline
Gender:
Posts: 321
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #24 on: Dec 4th, 2015, 08:17am » |
|
Hi Folks,
Not really a reply, and not converted from RISC OS, but it seems to fit with the ongoing theme.
Here's a small ditty based on spirograph. Feel free to fiddle with it to your heart's content!
Code:
REM Spirograph simulation (epicycles). A smaller wheel (r2) rolls around inside a bigger one (r1)
MODE 21
ORIGIN 800,600
r1=500 :REM Radius of fixed circle
*REFRESH OFF
FOR denom%=3 TO 10
da2=denom% :REM Angle change in inner wheel between each plotted point, in degrees. You can use it like a speed control
CLS
FOR num%=1 TO denom%-1
r2=r1*num%/denom%
FOR pen=0.1 TO 0.9 STEP 0.01 :REM Distance of pen between centre and edge of smaller wheel
REM CLS:REM If you unREM this line you can see each individual pattern!
IF num% MOD 2=0 THEN p=1-pen ELSE p=pen
PROCDrawIt(0,r1,r2,p,da2,denom%,num%)
*REFRESH
NEXT pen
NEXT num%
NEXT denom%
*REFRESH ON
END
:
DEFPROCDrawIt(startangle,r1,r2,pen,da2,denom%,col%)
LOCAL da1,count%
da1=da2*r2/r1 :REM angle change around fixed circle for each "step" of moving wheel
GCOL col%
count%=0
MOVE (r1-r2)*COSRAD(startangle+da1*count%)+pen*r2*COSRAD(startangle-da2*count%),(r1-r2)*SINRAD(startangle+da1*count%)+pen*r2*SINRAD(startangle-da2*count%)
REPEAT
count%+=1
DRAW (r1-r2)*COSRAD(startangle+da1*count%)+pen*r2*COSRAD(startangle-da2*count%),(r1-r2)*SINRAD(startangle+da1*count%)+pen*r2*SINRAD(startangle-da2*count%)
UNTIL count%*da2>=360*denom%
ENDPROC
Best wishes,
D
|
|
Logged
|
|
|
|
David Williams
Developer
member is offline
meh
Gender:
Posts: 452
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #25 on: Dec 4th, 2015, 7:08pm » |
|
Very nice, David.
Here's one inspired by a GIF animation I came across today whilst searching for something related:
http://www.i.imgur.com/Rnk6JvK.gif
(And here's what I was actually looking for: https://upload.wikimedia.org/wikipedia/commons/1/1a/Fourier_series_square_wave_circles_animation.gif)
Code:
REM>CIRCWAVES
REM Idea borrowed from an animated GIF found on Imgur via Reddit.com:
REM http://www.i.imgur.com/Rnk6JvK.gif
REM This BB4W version uses native graphics commands
*FLOAT 64
MODE 8
OFF
COLOUR 1, 64, 64, 64
COLOUR 2, 255, 255, 255
gap% = 2*32
radius% = 2*32
maxX% = (2*@vdu%!208 DIV gap%) + 1
maxY% = (2*@vdu%!212 DIV gap%) + 1
TIME = 0
*REFRESH OFF
REPEAT
CLS
REM Draw the circles first:
GCOL 1
FOR Y% = 0 TO maxY%
cy% = gap%*Y%
FOR X% = 0 TO maxX%
cx% = gap%*X%
CIRCLE cx%, cy%, radius%
NEXT X%
NEXT Y%
REM Now draw the moving points:
GCOL 2
T% = TIME * 2
I% = 0
FOR Y% = 0 TO maxY%
cy% = gap%*Y%
FOR X% = 0 TO maxX%
cx% = gap%*X%
px% = cx% + radius%*COSRAD(T% + I%)
py% = cy% + radius%*SINRAD(T% + I%)
CIRCLE FILL px%, py%, 8
I% += 15
NEXT X%
NEXT Y%
*REFRESH
UNTIL FALSE
EDIT: Which inevitably leads to something like this:
Code:
REM>CIRCWAVES2
*FLOAT 64
MODE 8
OFF
FOR I% = 1 TO 15
COLOUR I%, I%*255/16, I%*255/8, I%*255/4
NEXT I%
gap% = 2*16
radius% = 2*16
maxX% = (2*@vdu%!208 DIV gap%) + 1
maxY% = (2*@vdu%!212 DIV gap%) + 1
arraySz% = maxX% * maxY%
DIM grid%( arraySz%-1, 2 )
TIME = 0
*REFRESH OFF
REPEAT
CLS
I% = 0
T% = TIME
FOR Y% = 0 TO maxY%-1
cy% = gap%*Y%
FOR X% = 0 TO maxX%-1
cx% = gap%*X%
A% = T% + 8*I%
grid%(I%,0) = cx% + radius%*COSRADA%
grid%(I%,1) = cy% + radius%*SINRADA%
grid%(I%,2) = I% MOD 15
I% += 1
NEXT X%
NEXT Y%
FOR Y% = 0 TO maxY%-2
FOR X% = 0 TO maxX%-2
I% = Y%*maxX% + X%
GCOL grid%(I%,2)
MOVE grid%(I%,0), grid%(I%,1)
MOVE grid%(I%+1,0), grid%(I%+1,1)
PLOT 85, grid%(I%+maxX%,0), grid%(I%+maxX%,1)
PLOT 85, grid%(I%+maxX%+1,0), grid%(I%+maxX%+1,1)
NEXT X%
NEXT Y%
*REFRESH
UNTIL FALSE
|
|
|
|
dfeugey
Guest
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #26 on: Dec 7th, 2015, 05:30am » |
|
A full pack of screensavers
|
|
Logged
|
|
|
|
|
