Author |
Topic: Some RISC OS graphical ditties converted to BB4W (Read 619 times) |
|
dfeugey
Guest
|
 |
Re: Some RISC OS graphical ditties converted to BB
« Reply #4 on: Nov 8th, 2015, 3:28pm » |
|
Very interesting too. Could be good screensavers (with a few more code to integrate in windows as screensaver).
|
|
 Logged
|
|
|
|
David Williams
Developer
member is offline
meh
Gender: 
Posts: 452
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #5 on: Nov 8th, 2015, 4:15pm » |
|
on Nov 8th, 2015, 3:28pm, dfeugey wrote:Very interesting too. Could be good screensavers (with a few more code to integrate in windows as screensaver).
|
|
Cheers, David. Just occupying myself on this most solemn of days. Here's another Vibe effort:
Jan Vibe's 'Facets' - two variants. The first version uses BB4W's native graphics commands (i.e. Windows GDI); the second version uses my graphics library (GLIB, not GFXLIB) to draw the circles.
Code:
REM > FACETS
REM by Jan Vibe
REM Adapted for BB4W by DW
REMMODE28:OFF
MODE 19 : OFF : REM 640x480
ScrW% = @vdu%!208
ScrH% = @vdu%!212
K%=1000:R%=40
DIM X%(K%),Y%(K%),C%(K%),LX%(10000),LY%(10000)
B%=0:REPEAT:T%=0:B%+=1
REPEAT:X%(B%)=RND(ScrW%):Y%(B%)=RND(ScrH%):C%(B%)=RND(63):T%+=1
UNTIL POINT(2*X%(B%),2*Y%(B%))=0 OR T%>=5000
GCOL C%(B%):CIRCLE FILL 2*X%(B%),2*Y%(B%),2*R%
UNTILT%>=5000
FORN%=R%TO0STEP-1
FORI%=1TOB%:GCOL C%(I%):CIRCLE FILL 2*X%(I%),2*Y%(I%),2*N%:NEXTI%,N%
LP%=0:GCOL0
FORY%=0TOScrH% STEP 2
FORX%=0TOScrW% STEP 2
C%=POINT(2*X%,2*Y%):F%=0
IFPOINT(2*X%-2,2*Y%)<>C% F%=1
IFPOINT(2*X%+2,2*Y%)<>C% F%=1
IFPOINT(2*X%,2*Y%-2)<>C% F%=1
IFPOINT(2*X%,2*Y%+2)<>C% F%=1
IFF%=1 LP%+=1:LX%(LP%)=X%:LY%(LP%)=Y%
NEXTX%,Y%
FORN%=1TOLP%
CIRCLE FILL 2*LX%(N%),2*LY%(N%),2*4
NEXT
The GLIB-based one can be downloaded from the following URL. The Zip folder includes the compiled EXE, and the source (including library files). This version loops every 10 seconds.
http://www.proggies.uk/bb4w/facets_glib.zip
David.
--
|
|
|
|
David Williams
Developer
member is offline
meh
Gender:
Posts: 452
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #6 on: Nov 9th, 2015, 12:33pm » |
|
More Vibisms!
Code:
REM > CA2
REM by Jan Vibe
REM Adapted for BB4W by DW
REMMODE9:OFF
MODE 8 : OFF
DIMA%(10000),B%(10000)
F%=4:N%=2:A%()=640:B%()=512:GCOL1
FORN%=1TO8:COLOUR N%+7,31*N%,31*N%,240:NEXT:COLOUR0,0,0,128
REPEAT
P%=RND(N%):X%=A%(P%):Y%=B%(P%):A%(P%)=A%(N%):B%(P%)=B%(N%):N%-=1
A%=X%+F%:B%=X%-F%:C%=Y%+F%:D%=Y%-F%:CC%=0
FORI%=-8TO8STEP4:FORJ%=-8TO8STEP4
IF NOT(I%=0 AND J%=0) CC%-=(POINT(X%+I%,Y%+J%)<>0)
NEXT,:GCOL CC%/3+7:PLOT X%,Y%:GCOL1
PROCS(X%,C%):PROCS(B%,Y%):PROCS(X%,D%):PROCS(A%,Y%)
PROCS(B%,C%):PROCS(B%,D%):PROCS(A%,D%):PROCS(A%,C%)
UNTIL N%=-1
END
DEFPROCS(X%,Y%)
LOCAL A%,C%
IF POINT(X%,Y%)=0 THEN
FORA%=-24TO20STEP4
IF POINT(X%-24,Y%+A%)<>0 C%+=1
IF POINT(X%+24,Y%+A%+4)<>0 C%+=1
IF POINT(X%+A%+4,Y%-24)<>0 C%+=1
IF POINT(X%+A%,Y%+24)<>0 C%+=1
NEXT
IFC%<=15 N%+=1:A%(N%)=X%:B%(N%)=Y%:PLOT X%,Y%
ENDIF
ENDPROC
Code:
REM > CIRCLE2
REM by Jan Vibe
REM Very slightly modified by DW (space character inserted after DRAWBY),
REM but result still not quite correct (due, I think, to ARM BASIC and
REM BB4W handling the DRAW BY statement slightly differently).
REM Jan's comment:
REM
REM Inspired from Allister Jenks 'Cropcircle' in the september issue
REM of Acorn user. The flattened corn has been given the plaited look
REM the 'real' crop circles always have.
Code proceeds as the following one-liner:
Code:MODE8:OFF:R=350:L=640:M=512:FORN=1TO15:COLOURN,16*N,12*N,0:NEXT:COLOUR0,112,64,0:FORY=950TO0STEP-50:FORX=0TO1280STEP2:A=X+RND(32):B=Y+RND(50):Q=SQR((L-A)^2+(M-B)^2):Z=-(ABS(Q-R)<80):K=A-L:O=ACS(K/Q):V=PI+O*(B>M)-O*(B<=M):C=Z*4*SINV+(1-Z)*(4*RND(1)-2):D=Z*4*COSV+(1-Z)*4:MOVEA,B:FORN=1TO15:GCOLN:DRAWBY C,D:NEXT,,
Correct version (multi-line):
Code:
REM > CIRCLE2
REM by Jan Vibe
REM Adapted for BB4W by DW
REM Inspired from Allister Jenks 'Cropcircle' in the september issue
REM of Acorn user. The flattened corn has been given the plaited look
REM the 'real' crop circles always have.
MODE 8
OFF
R = 350
L = 640
M = 512
FOR N = 1 TO 15
COLOUR N,16*N,12*N,0
NEXT
COLOUR 128,112,64,0 : CLG
FOR Y = 950 TO 0 STEP -50
FOR X = 0 TO 1280 STEP 2
A = X + RND(32)
B = Y + RND(50)
Q = SQR((L-A)^2 + (M-B)^2)
Z = -(ABS(Q-R) < 80)
K = A-L
O = ACS(K/Q)
V = PI + O*(B>M)-O*(B<=M)
C = Z*4*SINV + (1-Z)*(4*RND(1)-2)
D = Z*4*COSV + (1-Z)*4
MOVE A, B
FOR N = 1 TO 15
GCOL N
DRAW A+N*C, B+N*D
NEXT N
NEXT X
NEXT Y
Code:
REM > COLSQUARE
REM by Jan Vibe
REM Adapted for BB4W by DW
MODE8:OFF
GCOL 15
F%=TIME:DIM C%(4,3),P%(10,8,3)
FORJ%=0TO8:FORI%=0TO10:FORN%=1TO3:P%(I%,J%,N%)=RND(255):NEXT,,
FORJ%=0TO7:FORI%=0TO9:FORN%=1TO3
C%(1,N%)=P%(I%,J%,N%)
C%(2,N%)=P%(I%+1,J%,N%)
C%(3,N%)=P%(I%+1,J%+1,N%)
C%(4,N%)=P%(I%,J%+1,N%)
NEXT
X1%=I%*128:Y1%=J%*128:X2%=X1%+128:Y2%=Y1%+128
PROCP(X1%,Y1%,C%(1,1),C%(1,2),C%(1,3))
PROCA(X1%,Y1%,X2%,Y2%,C%())
NEXT,
END
DEFPROCA(X1%,Y1%,X3%,Y3%,FC%())
LOCAL X2%,Y2%,N%,LC%(),MC%()
DIM LC%(4,3),MC%(5,3)
X2%=(X1%+X3%)/2:Y2%=(Y1%+Y3%)/2
FORN%=1TO3
MC%(1,N%)=(FC%(1,N%)+FC%(2,N%))/2
MC%(2,N%)=(FC%(2,N%)+FC%(3,N%))/2
MC%(3,N%)=(FC%(3,N%)+FC%(4,N%))/2
MC%(4,N%)=(FC%(4,N%)+FC%(1,N%))/2
NEXT
FORN%=1TO3:MC%(5,N%)=(MC%(1,N%)+MC%(2,N%)+MC%(3,N%)+MC%(4,N%))/4:NEXT
PROCP(X2%,Y1%,MC%(1,1),MC%(1,2),MC%(1,3))
PROCP(X1%,Y2%,MC%(4,1),MC%(4,2),MC%(4,3))
PROCP(X2%,Y2%,MC%(5,1),MC%(5,2),MC%(5,3))
IF X2%-X1%>8 OR Y2%-Y1%=8 THEN
FORN%=1TO3:LC%(1,N%)=FC%(1,N%):LC%(2,N%)=MC%(1,N%)
LC%(3,N%)=MC%(5,N%):LC%(4,N%)=MC%(4,N%):NEXT
PROCA(X1%,Y1%,X2%,Y2%,LC%())
FORN%=1TO3:LC%(1,N%)=MC%(1,N%):LC%(2,N%)=FC%(2,N%)
LC%(3,N%)=MC%(2,N%):LC%(4,N%)=MC%(5,N%):NEXT
PROCA(X2%,Y1%,X3%,Y2%,LC%())
FORN%=1TO3:LC%(1,N%)=MC%(4,N%):LC%(2,N%)=MC%(5,N%)
LC%(3,N%)=MC%(3,N%):LC%(4,N%)=FC%(4,N%):NEXT
PROCA(X1%,Y2%,X2%,Y3%,LC%())
FORN%=1TO3:LC%(1,N%)=MC%(5,N%):LC%(2,N%)=MC%(2,N%)
LC%(3,N%)=FC%(3,N%):LC%(4,N%)=MC%(3,N%):NEXT
PROCA(X2%,Y2%,X3%,Y3%,LC%())
ENDIF
ENDPROC
DEFPROCP(X%,Y%,R%,G%,B%)
LOCAL C%
C%=RND(-X%*Y%-F%):R%=FNR(R%):G%=FNR(G%):B%=FNR(B%)
REMC%=(R%<<8)+(G%<<16)+(B%<<24)
REMSYS "ColourTrans_SetGCOL",C%,,,&100,0
COLOUR 15, R%, G%, B%
PLOT X%,Y%
PLOT 2+X%,Y%
ENDPROC
DEFFNR(R%)
R%=R%+RND(32)-16
IF R%>255 R%=255
IF R%<0 R%=0
=R%
Code:
REM > DRAMATIC2
REM by Jan Vibe
REM Adapted for BB4W by DW
MODE8:OFF
GCOL 15
DIM A%(319,255)
A%(000,000)=RND:PROCA(A%(0,0),0,0)
A%(319,000)=RND:PROCA(A%(255,0),1020,0)
A%(000,255)=RND:PROCA(A%(0,255),000,1020)
A%(319,255)=RND:PROCA(A%(255,255),1020,1020)
PROCF(0,0,319,255)
END
DEFPROCF(X1%,Y1%,X3%,Y3%)
LOCAL X2%,Y2%,P%,R%,G%,B%
P%=X3%-X1%:IF P%>=2 THEN
X2%=(X1%+X3%)/2:Y2%=(Y1%+Y3%)/2
PROCS(X1%,Y2%,X1%,Y1%,X1%,Y3%):PROCS(X2%,Y3%,X1%,Y3%,X3%,Y3%)
PROCS(X3%,Y2%,X3%,Y3%,X3%,Y1%):PROCS(X2%,Y1%,X1%,Y1%,X3%,Y1%)
IF RND(1)>.5 THEN
PROCS(X2%,Y2%,X1%,Y2%,X3%,Y2%)
ELSE
PROCS(X2%,Y2%,X2%,Y1%,X2%,Y3%)
ENDIF
PROCF(X1%,Y1%,X2%,Y2%):PROCF(X1%,Y2%,X2%,Y3%)
PROCF(X2%,Y2%,X3%,Y3%):PROCF(X2%,Y1%,X3%,Y2%)
ENDIF
ENDPROC
DEFPROCS(X%,Y%,X1%,Y1%,X2%,Y2%)
IF A%(X%,Y%)=0 THEN
A%(X%,Y%)=FNP(A%(X1%,Y1%),A%(X2%,Y2%)):PROCA(A%(X%,Y%),4*X%,4*Y%)
ENDIF
ENDPROC
DEFFNP(P1%,P2%)
LOCAL R1%,R2%,G1%,G2%,B1%,B2%,R%,G%,B%,PX%:PX%=P%*4
P1%=P1%>>8:R1%=P1%AND&FF:P1%=P1%>>8:G1%=P1%AND&FF:P1%=P1%>>8:B1%=P1%AND&FF
P2%=P2%>>8:R2%=P2%AND&FF:P2%=P2%>>8:G2%=P2%AND&FF:P2%=P2%>>8:B2%=P2%AND&FF
R%=FNM(R1%,R2%,PX%):G%=FNM(G1%,G2%,PX%):B%=FNM(B1%,B2%,PX%)
=(R%<<8)+(G%<<16)+(B%<<24)
DEFFNM(C1%,C2%,P%)
LOCAL C%
C%=(C1%+C2%)/2+RND(P%)-P%/2+RND(17)-9
IF C%>255 C%=255
IF C%<0 C%=0
=C%
DEFPROCA(A%,X%,Y%)
LOCAL R%,G%,B%
A%=A%>>8:R%=A%AND&FF:A%=A%>>8:G%=A%AND&FF:A%=A%>>8:B%=A%AND&FF
PROCRGB(R%,G%,B%):REMLINE X%,Y%,X%+2,Y%
RECTANGLE FILL X%,Y%,4,4
ENDPROC
DEFPROCRGB(R%,G%,B%)
LOCAL C%:C%=(R%<<8)+(G%<<16)+(B%<<24)
REMSYS "ColourTrans_SetGCOL",C%,,,&100,0
COLOUR 15, R%, G%, B%
ENDPROC
More coming soon :D
--
|
|
Logged
|
|
|
|
dfeugey
Guest
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #7 on: Nov 9th, 2015, 1:34pm » |
|
Hope you'll put all of this on your website (both ROS and Windows versions). Useful code...
|
|
Logged
|
|
|
|
David Williams
Developer
member is offline
meh
Gender:
Posts: 452
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #8 on: Nov 9th, 2015, 4:01pm » |
|
on Nov 9th, 2015, 1:34pm, dfeugey wrote:Hope you'll put all of this on your website (both ROS and Windows versions). Useful code...
|
|
Well, possibly. In the meantime, here's some more:
Code: REM > ELASTICNET *** Jan Vibe february 94 ***
REM by Jan Vibe
REM Adapted for BB4W by DW
REM Original version had W%=7 and H%=5
REM This version has W%=12 and H%=10
REMMODE140:MODE12:OFF:COLOUR0,0,0,255
*FLOAT 64
MODE 8 : OFF
COLOUR 0, 0, 0, 255 : CLG
PRINT'TAB(34)"Elastic net"''
PRINTTAB(10)"This program simulates a elastic net with balls attached"
PRINTTAB(10)"to the knots."'
PRINTTAB(10)"You can move a ball by moving the mousepointer over the"
PRINTTAB(10)"ball, and click the left mousebutton. As long as you hold"
PRINTTAB(10)"the button depressed, the ball follows the mouse. When"
PRINTTAB(10)"you release the button, the ball snaps back."'
PRINTTAB(10)"You can fix balls by moving the moving the pointer over"
PRINTTAB(10)"the ball, and click the right mousebutton. This stops"
PRINTTAB(10)"the ball from moving. Getting the right ball when the net"
PRINTTAB(10)"is moving can be real tricky. Fixed balls can also be"
PRINTTAB(10)"moved with the pointer."'
PRINTTAB(10)"You can release fixed balls by moving the pointer over the"
PRINTTAB(10)"over the ball, and click the the middle mousebutton."
PRINTTAB(10,25)"Click the mouse to continue.":VDU30
REPEAT:MOUSE A%,B%,C%:UNTIL C%<>0:CLS:K=INKEY(50)
REM W%=7 :REM Width in balls
REM H%=5 :REM height in balls
W%=12 :REM Width in balls
H%=10 :REM height in balls
WX%=1000 :REM Width in pixels
HY%=800 :REM Height in pixels
V%=6 :REM Weight of the balls
T=0.5 :REM Balls tendency to stay where it is put originally
D=0.99 :REM Damping factor
G=5 :REM Gravity
P1%=1:P2%=2:S1%=1:S2%=2:PX%=0:PY%=0
WD=(1280-WX%)/2:WB=WX%/(W%-1):HD=(1024-HY%)/2:HB=HY%/(H%-1)
DIM X(W%,H%,2),Y(W%,H%,2),DX(W%,H%),DY(W%,H%),F%(W%,H%)
DIM OX(W%,H%),OY(W%,H%)
REM This stops top row from moving
FORN%=1TOW%:F%(N%,H%)=1:NEXT
REM placing of balls
FORJ%=1TOH%:FORI%=1TOW%
X(I%,J%,P1%)=WD+(I%-1)*WB:Y(I%,J%,P1%)=HD+(J%-1)*HB
OX(I%,J%)=X(I%,J%,P1%):OY(I%,J%)=Y(I%,J%,P1%)
NEXT,
REMONERRORGOTO920
REM*POINTER
*REFRESH OFF
REM Screen and mouse control
REPEAT
REMSYS 6,112,S1%:SYS 6,113,S2%:WAIT:CLS:SWAP S1%,S2%
CLS
GPX%=PX%:GPY%=PY%:PX%=0:PY%=0:MOUSE XM,YM,BM%
IF BM%<>0 THEN
DL=1E9:FORJ%=1TOH%:FORI%=1TOW%
DM=(X(I%,J%,P1%)-XM)^2+(Y(I%,J%,P1%)-YM)^2:IF DM<DL DL=DM:PX%=I%:PY%=J%
NEXT,:IF GPX%<>0 PX%=GPX%:PY%=GPY%
X(PX%,PY%,P1%)=XM:Y(PX%,PY%,P1%)=YM
IF BM%=1 F%(PX%,PY%)=1
IF BM%=2 F%(PX%,PY%)=0
ENDIF
SWAP P1%,P2%
REM drawing of net
FORJ%=1TOH%-1:FORI%=1TOW%-1
LINEX(I%,J%,P2%),Y(I%,J%,P2%),X(I%+1,J%,P2%),Y(I%+1,J%,P2%)
LINEX(I%,J%,P2%),Y(I%,J%,P2%),X(I%,J%+1,P2%),Y(I%,J%+1,P2%):NEXT,
FORN%=1TOW%-1
LINEX(N%,H%,P2%),Y(N%,H%,P2%),X(N%+1,H%,P2%),Y(N%+1,H%,P2%):NEXT
FORN%=1TOH%-1
LINEX(W%,N%,P2%),Y(W%,N%,P2%),X(W%,N%+1,P2%),Y(W%,N%+1,P2%):NEXT
FORJ%=1TOH%:FORI%=1TOW%:CIRCLEFILLX(I%,J%,P2%),Y(I%,J%,P2%),12:NEXT,
REM Calculate new position for net
FORJ%=1TOH%:FORI%=1TOW%
IF NOT(I%=PX%ANDJ%=PY%) THEN
IF F%(I%,J%)=1 THEN
X(I%,J%,P1%)=X(I%,J%,P2%):Y(I%,J%,P1%)=Y(I%,J%,P2%)
ELSE
WT=0:NX=0:NY=0
IF I%>1 THEN NX+=X(I%-1,J%,P2%):NY+=Y(I%-1,J%,P2%):WT+=1
IF I%<W% THEN NX+=X(I%+1,J%,P2%):NY+=Y(I%+1,J%,P2%):WT+=1
IF J%>1 THEN NX+=X(I%,J%-1,P2%):NY+=Y(I%,J%-1,P2%):WT+=1
IF J%<H% THEN NX+=X(I%,J%+1,P2%):NY+=Y(I%,J%+1,P2%):WT+=1
NX+=OX(I%,J%)*T:NY+=OY(I%,J%)*T:WT+=T
NX+=X(I%,J%,P2%)*V%:NY+=Y(I%,J%,P2%)*V%:WT+=V%
X(I%,J%,P1%)=NX/WT+DX(I%,J%):Y(I%,J%,P1%)=NY/WT+DY(I%,J%)
DX(I%,J%)=(X(I%,J%,P1%)-X(I%,J%,P2%))*D
DY(I%,J%)=(Y(I%,J%,P1%)-Y(I%,J%,P2%))*D-G
ENDIF
ENDIF
NEXT,
*REFRESH
WAIT 1
UNTIL0
REMSYS 6,112,S1%:REPORT:PRINT" at line "STR$ERL:ON
Code: REM > LEAF
REM by Jan Vibe
REM Adapted for BB4W by DW
MODE8:OFF:RESTORE:READ K%:REMGCOL 144 TINT 128:CLG
COLOUR 0,34,34,102 : CLG
COLOUR 4,51,119,51
COLOUR 6,187,119,51
COLOUR 12,51,255,51
DIMGX1(K%),GY1(K%),GX2(K%),GY2(K%),M%(K%),C%(K%),F%(K%)
FORN%=1TOK%:READGX1(N%),GY1(N%),GX2(N%),GY2(N%),M%(N%),C%(N%),F%(N%)
GX1(N%)=GX1(N%)/16:GY1(N%)=(GY1(N%)-8)/16
GX2(N%)=GX2(N%)/16:GY2(N%)=(GY2(N%)-8)/16
NEXT:PROCREPLACE(64,0,864,830,50,0,1,1)
END
DEFPROCREPLACE(X1,Y1,X2,Y2,L%,C%,M%,F%)
LOCAL DX,DY,X3,Y3,X4,Y4,N%
IF L%=0 OR (X2-X1)^2+(Y2-Y1)^2<=16 THEN
GCOL C%:MOVEX1,Y1:DRAWX2,Y2
ELSE
DX=X2-X1:DY=Y2-Y1
FORN%=1TOK%
IFF%=1 THEN
X3=DX*GX1(N%)-M%*DY*GY1(N%)+X1:Y3=DY*GX1(N%)+M%*DX*GY1(N%)+Y1
X4=DX*GX2(N%)-M%*DY*GY2(N%)+X1:Y4=DY*GX2(N%)+M%*DX*GY2(N%)+Y1
PROCREPLACE(X3,Y3,X4,Y4,L%-1,C%(N%),M%*M%(N%),F%(N%))
ELSE
PROCREPLACE(X1,Y1,X2,Y2,0,C%,M%,F%)
ENDIF
NEXT
ENDIF
ENDPROC
DATA 5 :REM Number of elements
REM x1,y1,x2,y2,mirror,colour,fertility
DATA 0, 8, 6, 8, 1, 6, 0
DATA 6, 8,16, 3, -1, 12, 1
DATA 6, 8,13,12, -1, 4, 1
DATA 3, 8, 4,10, 1, 12, 1
DATA 3, 8, 5, 5, -1, 4, 1
Code: REM > FERNS
REM by Jan Vibe
REM Adapted for BB4W by DW
MODE8:OFF
DIM Y%(320),C%(320)
FORN%=1TO319:C%(N%)=RND(15):NEXT
REPEAT
REPEAT:P%=RND(319):H%=Y%(P%):Q%=C%(P%)
IF Y%(P%-1)>H% H%=Y%(P%-1):Q%=C%(P%-1)
IF Y%(P%+1)>H% H%=Y%(P%+1):Q%=C%(P%+1)
H%=H%+4:Y%(P%)=H%:C%(P%)=Q%
GCOL Q%:PLOT 4*P%,H%
IF RND(1)>.99 C%(RND(319))=RND(15)
UNTILH%>=1020
MOVE0,4:MOVE1280,1024:PLOT&BD,0,0:Y%()-=4
WAIT 1
UNTIL0
Code: REM > TARTAN
REM by Jan Vibe
REM Adapted for BB4W by DW
MODE8:OFF
R1=(RND(1)-.5)*3:R2=(RND(1)-.5)*3
G1=(RND(1)-.5)*3:G2=(RND(1)-.5)*3
B1=(RND(1)-.5)*3:B2=(RND(1)-.5)*3
GCOL 15
FORY%=0TO1023STEP2
FORX%=0TO1279STEP2
R%=(SINRAD(R1*X%+R2*Y%)+1)*127
G%=(SINRAD(G1*X%+G2*Y%)+1)*127
B%=(SINRAD(B1*X%+B2*Y%)+1)*127
PROCP(X%,Y%,R%,G%,B%)
NEXT,
END
DEFPROCP(X%,Y%,R%,G%,B%)
LOCAL C%
R%=FNA(R%):G%=FNA(G%):B%=FNA(B%)
REMC%=(R%<<8)+(G%<<16)+(B%<<24)
REMSYS "ColourTrans_SetGCOL",C%,,,&100,0
COLOUR 15, R%, G%, B%
IF POINT(X%,Y%)=0 LINE X%,Y%,X%,Y%
ENDPROC
DEFFNA(A%)
A%=A%+RND(32)-16
IF A%>255 A%=255
IF A%<0 A%=0
=A%
Code: REM > STRUKFILL
REM by Jan Vibe
REM Adapted for BB4W by DW
MODE19:OFF
DIM PX%(10000),PY%(10000):PX%()=640:PY%()=512:P%=10
FORN%=1TOP%:PX%(N%)=RND(1280):PY%(N%)=RND(1024):NEXT
FORN%=1TO8:T1=RAD(45*N%+120):T2=RAD(45*N%+180):T3=RAD(45*N%+270)
COLOUR N%,127*(SINT1+1),127*(SINT2+1),127*(SINT3+1):NEXT
REPEAT:C%=0:RESTORE
R%=RND(P%):X%=PX%(R%):Y%=PY%(R%):PX%(R%)=PX%(P%):PY%(R%)=PY%(P%):P%-=1
FORI%=1TO8:READ A%,B%:C%+=1:X1%=X%+A%:Y1%=Y%+B%
IF POINT(X1%,Y1%)=0 GCOLC%:PLOT X1%,Y1%:P%+=1:PX%(P%)=X1%:PY%(P%)=Y1%
NEXT:UNTILP%=0
DATA -4,-4, 0,-4, 4,-4, 4,0, 4,4, 0,4, -4,4, -4,0
|
|
Logged
|
|
|
|
David Williams
Developer
member is offline
meh
Gender:
Posts: 452
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #9 on: Nov 9th, 2015, 4:07pm » |
|
Dazzling:
Code: REM > NOVA
REM by Jan Vibe
REM Adapted for BB4W by DW
REM Includes from the BB4W Programmer's Reference (Wiki)
REMMODE9:OFF:REM:COLOUR0,0,0,240
MODE 8:OFF:PROCpaletted
@vdu%!248 = 2 : REM thicker line (larger points)
DIMX%(1,3000),Y%(1,3000),D%(1,3000),F%(1,3000),DX%(8),DY%(8),C%(15,3)
FORN%=0TO7:READA%,B%:DX%(N%)=4*A%:DY%(N%)=4*B%:NEXT
P1%=0:P2%=1:C1%=1:TI%=TIME:C%()=240
X%(P1%,C1%)=640:Y%(P1%,C1%)=512:D%(P1%,C1%)=RND(8)-1:F%(P1%,C1%)=RND(15)
REPEAT
SWAP P1%,P2%:C2%=C1%:C1%=0:F%=F%MOD15+1
FORN%=1TOC2%:PROCF
PX%=X%(P2%,N%):PY%=Y%(P2%,N%):PD%=D%(P2%,N%):PF%=F%(P2%,N%)
T%=0:REPEAT:T%+=1:DP%=(RND(3)+6+PD%)MOD8
K%=POINT(PX%+DX%(DP%),PY%+DY%(DP%)):UNTILK%=0 OR T%=3
IF K%=0 THEN
XP%=PX%+DX%(DP%):YP%=PY%+DY%(DP%):FP%=PF%:IFRND(1)>.7 FP%=PF%MOD15+1
C1%+=1:X%(P1%,C1%)=XP%:Y%(P1%,C1%)=YP%:D%(P1%,C1%)=DP%:F%(P1%,C1%)=FP%
GCOL FP%:LINE PX%,PY%,XP%,YP%
ENDIF
IFRND(1)>.65THEN
T%=0:REPEAT:T%+=1:DP%=RND(8)-1
K%=POINT(PX%+DX%(DP%),PY%+DY%(DP%)):UNTILK%=0 OR T%=3
IF K%=0 THEN
XP%=PX%+DX%(DP%):YP%=PY%+DY%(DP%):PF%=PF%:IFRND(1)>.7 FP%=PF%MOD15+1
C1%+=1:X%(P1%,C1%)=XP%:Y%(P1%,C1%)=YP%:D%(P1%,C1%)=DP%:F%(P1%,C1%)=FP%
GCOL FP%:LINE XP%,YP%,XP%,YP%
ENDIF
ENDIF
NEXT
UNTILC1%=0
REPEAT:PROCF:UNTIL0
DEFPROCF
LOCAL N%,M%
IF TIME>=TI% THEN
FORN%=14TO1STEP-1:FORM%=1TO3:C%(N%+1,M%)=C%(N%,M%):NEXT,
FORM%=1TO3:C%(0,M%)=C%(0,M%)+RND(13)+15
C%(1,M%)=127*(SINRADC%(0,M%)+1):NEXT
FORN%=1TO15:COLOURN%,C%(N%,1),C%(N%,2),C%(N%,3):NEXT
TI%=TIME+7
ENDIF
PROCanimate
ENDPROC
DATA-1,1, 0,1, 1,1, 1,0, 1,-1, 0,-1, -1,-1, -1,0
REM Code from the 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 > INFERNO
REM by Jan Vibe
REM Adapted for BB4W by DW
REMMODE27:OFF:PROCT
MODE 19 : OFF : PROCpaletted : PROCT
FORN%=0TO1280STEP2:GCOLRND(15):PLOT N%,0:NEXT
FORY%=2TO960STEP2
FORX%=0TO1280STEP2
R%=2*(RND(3)-2):C%=ABS(POINT(X%+R%,Y%-2)):IF RND(1)>.8 C%=C%MOD15+1
GCOLC%:LINE X%,Y%,X%,Y%:PROCT
NEXT X%
NEXT Y%
REPEAT:PROCT:UNTIL0
DEFPROCT
IF TIME>T% THEN
LOCAL F%:S%=S%MOD15+1
FORN%=1TO15:F%=(S%+N%)MOD15+1:COLOURF%,255,16*N%,0:NEXT
PROCanimate
T%=TIME+5
ENDIF
ENDPROC
REM Code from the 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
Less dazzling, but pretty nonetheless:
Code: REM > STARFISH *** Jan Vibe december 93 ***
REM Adapted for BB4W by DW
MODE8:OFF
DIM X(200,15),Y(200,15),A%(200,15),B%(200,15):X()=-200
FORN%=1TO15:COLOUR N%,8*N%+127,16*N%,16*N%:NEXT
FORY%=0TO256STEP4:FORX%=0TO255STEP2:GCOLRND(15):PLOTX%,Y%:NEXT,
FORY%=0TO1023STEP128:FORX%=0TO1279STEP128
IF X%>=255ORY%>=255THEN
A%=RND(127):B%=RND(127):MOVEA%,B%:MOVEA%+127,B%+127:PLOT&BE,X%,Y%
ENDIF
NEXT,
P1%=0:P2%=1:C1%=6:R=50:S=3
FORN%=1TO6
X(N%,P1%)=640:Y(N%,P1%)=512:A%(N%,P1%)=60*N%:B%(N%,P1%)=RND(12)+3
NEXT
REPEAT
P2%=P1%:P1%=(P1%+1)MOD16:C2%=C1%:C1%=0:F=R/16
FORN%=1TOC2%
FORM%=1TO15:K%=(P2%+15-M%)MOD15+1
GCOLM%:CIRCLE FILL X(N%,K%),Y(N%,K%),R-F*M%
NEXT,
FORN%=1TOC2%
IF B%(N%,P2%)>0 THEN
C1%+=1:A%(C1%,P1%)=(A%(N%,P2%)+(RND(1)-.5)*(55-R)):T=RAD(A%(C1%,P1%))
X(C1%,P1%)=X(N%,P2%)+(R*SINT)/S:Y(C1%,P1%)=Y(N%,P2%)+(R*COST)/S
B%(C1%,P1%)=B%(N%,P2%)-1
ELSE
C1%+=1:A%(C1%,P1%)=(A%(N%,P2%)-RND(20)-20):T=RAD(A%(C1%,P1%))
X(C1%,P1%)=X(N%,P2%)+(R*SINT)/S:Y(C1%,P1%)=Y(N%,P2%)+(R*COST)/S
B%(C1%,P1%)=RND(12)+3
C1%+=1:A%(C1%,P1%)=(A%(N%,P2%)+RND(20)+20):T=RAD(A%(C1%,P1%))
X(C1%,P1%)=X(N%,P2%)+(R*SINT)/S:Y(C1%,P1%)=Y(N%,P2%)+(R*COST)/S
B%(C1%,P1%)=RND(12)+3
ENDIF
NEXT
R-=.85
UNTILR<=8
FORI%=1TO16
P2%=P1%:P1%=(P1%+1)MOD16:C2%=C1%:C1%=0:F=R/16
FORN%=1TOC2%
FORM%=1TO15:K%=(P2%+15-M%)MOD15+1
GCOLM%:CIRCLE FILL X(N%,K%),Y(N%,K%),R-F*M%
NEXT,
FORN%=1TOC2%:C1%+=1:X(N%,P1%)=-200:NEXT,
Jan Vibe was probably the master of RISC OS graphical 'ditties'; his programs were listed in Acorn User magazine every month in the late 80s up until the mid 90s.
|
|
Logged
|
|
|
|
David Williams
Developer
member is offline
meh
Gender:
Posts: 452
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #10 on: Nov 10th, 2015, 1:38pm » |
|
This guy's certainly got a head for recursion:
Code: REM > MARBLEFILL *** Jan Vibe february 93 ***
REM Adapted for BB4W by DW
MODE9:OFF:HIMEM=PAGE+5*&100000
DIM GX%(4),GY%(4),V$(24)
FORN%=1TO4:READ GX%(N%),GY%(N%):NEXT
FORN%=1TO24:READV$(N%):NEXT
FORN%=1TO15:COLOUR N%,16*N%,16*N%,16*N%:NEXT
GCOL 7:@vdu%!248=2:CIRCLE 640,512,500:@vdu%!248=1
PROCA(640,512,V$(RND(24)))
END
DEFPROCA(X%,Y%,A$)
LOCALN%
T%=0:C%=0:FORM%=1TO4:K%=POINT(X%+GX%(M%),Y%+GY%(M%))
IF K%>0 C%+=K%:T%+=1
NEXT:IF T%=0 T%=1
GCOL (C%/T%+2*RND(1)+15.5)MOD16:PLOT X%,Y%
FORN%=1TO4:P%=VALMID$(A$,N%,1):X1%=X%+GX%(P%):Y1%=Y%+GY%(P%)
IF POINT(X1%,Y1%)=0 PROCA(X1%,Y1%,V$(RND(24)))
NEXT
ENDPROC
DATA -4,0, 4,0, 0,-4, 0,4
DATA 1234,1243,1324,1342,1423,1432,2134,2143,2314,2341,2413,2431
DATA 3124,3142,3214,3241,3412,3421,4123,4132,4213,4231,4312,4321
Code: REM > SEAWEED
REM by Jan Vibe
REM Adapted for BB4W by DW
REM MODE128:MODE0:OFF:COLOUR0,0,0,128
MODE 8:OFF:COLOUR0,0,0,128:CLG
DIM B%(128),D%(128)
REM S1%=1:S2%=2
FORN%=1TO128:B%(N%)=RND(31)-16:D%(N%)=RND(7)-4:NEXT
REM ONERRORGOTO300
*REFRESH OFF
REPEAT
REM SYS 6,112,S1%:SYS 6,113,S2%:WAIT:CLS:SWAP S1%,S2%
CLS
FORN%=1TO128
IFRND(1)>.9 D%(N%)=RND(7)-4
IF ABS(B%(N%)+D%(N%))>15 D%(N%)=-D%(N%)
B%(N%)+=D%(N%):NEXT
C%=0:PROCT(640,0,300,0,6)
*REFRESH
WAIT 4
UNTIL0
DEFPROCT(X%,Y%,Z%,A%,L%)
LOCAL X1%,Y1%,F
C%+=1:F=(7-L%)/1.5
X1%=X%+Z%*SINRAD(A%+F*B%(C%))
Y1%=Y%+Z%*COSRAD(A%+F*B%(C%))
LINE X%,Y%,X1%,Y1%
IF L%>0 THEN
PROCT(X1%,Y1%,Z%/1.4,A%-45,L%-1)
PROCT(X1%,Y1%,Z%/1.4,A%+45,L%-1)
ENDIF
ENDPROC
300 REM SYS 6,112,S1%:REPORT:PRINT" at line "STR$ERL:ON
Code: REM > SHATTER2 *** Jan Vibe may 93 ***
REM by Jan Vibe
REM Adapted for BB4W by DW
REM MODE140:MODE12:OFF
MODE 8:OFF
DIM TX%(50,15),TY%(50,15),TN%(50),AX%(15),AY%(15)
REM S1%=1:S2%=2
GCOL 15
*REFRESH OFF
REPEAT
V%=RND(6)+2:TN%(1)=V%:D=360/V%
FORN%=1TOV%:T=RAD(360-N%*D)
TX%(1,N%)=640+300*SINT:TY%(1,N%)=512+300*COST
NEXT
FORI%=1TO49
IF I%=1 THEN
R%=1
ELSE
MAX%=0:FORN%=1TOI%
X1%=0:Y1%=0
FORM%=1 TO TN%(N%):X1%+=TX%(N%,M%):Y1%+=TY%(N%,M%):NEXT
X1%=X1%/TN%(N%):Y1%=Y1%/TN%(N%)
A%=0:FORM%=1TOTN%(N%):M1%=M%MODTN%(N%)+1
X2%=TX%(N%,M%):Y2%=TY%(N%,M%):X3%=TX%(N%,M1%):Y3%=TY%(N%,M1%)
A%+=(X1%*Y2%+Y1%*X3%+Y3%*X2%-Y2%*X3%-Y1%*X2%-X1%*Y3%)/2
NEXT
IF A%>MAX% MAX%=A%:R%=N%
NEXT
ENDIF
P%=TN%(R%)
FORN%=1TOP%:AX%(N%)=TX%(R%,N%):AY%(N%)=TY%(R%,N%):NEXT
L%=0:FORN%=1TOP%:N1%=N%MODP%+1
G%=(AX%(N%)-AX%(N1%))^2+(AY%(N%)-AY%(N1%))^2
IF G%>L% L%=G%:D11%=N%
NEXT
REPEAT:D21%=RND(P%):UNTIL D11%<>D21%
IF D11%>D21% SWAP D11%,D21%
D12%=D11%MODP%+1:D22%=D21%MODP%+1
F1%=RND(2):F2%=3-F1%
PX1%=(F1%*AX%(D11%)+F2%*AX%(D12%))/3
PY1%=(F1%*AY%(D11%)+F2%*AY%(D12%))/3
PX2%=(F1%*AX%(D21%)+F2%*AX%(D22%))/3
PY2%=(F1%*AY%(D21%)+F2%*AY%(D22%))/3
K%=0:FORN%=1TOP%
K%+=1:TX%(R%,K%)=AX%(N%):TY%(R%,K%)=AY%(N%)
IF N%=D11% THEN
K%+=1:TX%(R%,K%)=PX1%:TY%(R%,K%)=PY1%
K%+=1:TX%(R%,K%)=PX2%:TY%(R%,K%)=PY2%
N%=D21%
ENDIF
NEXT:TN%(R%)=K%
Q%=I%+1
K%=1:TX%(Q%,K%)=PX1%:TY%(Q%,K%)=PY1%
FORN%=D11%+1TOD21%
K%+=1:TX%(Q%,K%)=AX%(N%):TY%(Q%,K%)=AY%(N%)
NEXT
K%+=1:TX%(Q%,K%)=PX2%:TY%(Q%,K%)=PY2%:TN%(Q%)=K%
NEXT
REM ONERRORGOTO790
FORI%=0TO20
REM SYS 6,112,S1%:SYS 6,113,S2%:WAIT:CLS:SWAP S1%,S2%
CLS
FORN%=1TO50
PROCD(N%,I%/30)
NEXT N%
*REFRESH
WAIT 5
NEXT I%
REM SYS 6,112,S1%:SYS 6,113,S2%:WAIT:CLS:SWAP S1%,S2%
WAIT 100
UNTIL0
DEFPROCD(P%,F)
LOCAL N%,CX%,CY%,MX%,MY%,X%,Y%,F1
FORN%=1TOTN%(P%):CX%+=TX%(P%,N%):CY%+=TY%(P%,N%):NEXT
CX%=CX%/TN%(P%):CY%=CY%/TN%(P%)
MX%=(CX%-640):MY%=(CY%-512):F1=F+1
X%=TX%(P%,TN%(P%))-640
Y%=TY%(P%,TN%(P%))-512
MOVEX%+MX%*F+640,Y%+MY%*F+512
FORN%=1TOTN%(P%)
X%=TX%(P%,N%)-640
Y%=TY%(P%,N%)-512
MOVE MX%*F1+640,MY%*F1+512
PLOT85,X%+MX%*F+640,Y%+MY%*F+512
NEXT
ENDPROC
REM SYS 6,112,S1%:REPORT:PRINT" at line "STR$ERL:ON
Code: REM > ICE2
REM by Jan Vibe
MODE8:OFF:GCOL 15
DIM X(500,2),Y(500,2),DX(500,2),DY(500,2),A(500,2)
REPEAT:CLS:T1%=1:P1%=1:P2%=2:Q=.2:X(T1%,P1%)=640:Y(T1%,P1%)=512
A(T1%,P1%)=RND(360):T=RADA(T1%,P1%)
DX(T1%,P1%)=5*SINRADT:DY(T1%,P1%)=5*COST
REPEAT:T2%=0
FORN%=1TOT1%
NX=X(N%,P1%)+DX(N%,P1%):NY=Y(N%,P1%)+DY(N%,P1%)
IF POINT(NX,NY)=0 THEN
T2%+=1:X(T2%,P2%)=NX:Y(T2%,P2%)=NY
DX(T2%,P2%)=DX(N%,P1%):DY(T2%,P2%)=DY(N%,P1%):A(T2%,P2%)=A(N%,P1%)
LINE X(N%,P1%),Y(N%,P1%),NX,NY
IFRND(1)>Q THEN
T2%+=1:X(T2%,P2%)=NX:Y(T2%,P2%)=NY:M%=0
REPEAT:M%+=1:A(T2%,P2%)=(RND(120)+A(N%,P1%)+300)MOD360:T=RADA(T2%,P2%)
DX(T2%,P2%)=5*SINT:DY(T2%,P2%)=5*COST
UNTIL POINT(NX+DX(T2%,P2%),NY+DY(T2%,P2%))=0 OR M%=5
IF M%=5 T2%-=1
ENDIF
ENDIF
NEXT
SWAP T1%,T2%:SWAP P1%,P2%:Q=.9:IF T1%<10 Q=.8
UNTIL T1%=0
K=INKEY(300)
UNTIL0
Code: REM > GRANITE
REM by Jan Vibe
REM Adapted for BB4W by DW
MODE9:OFF:FORN%=0TO15:COLOUR N%,16*N%,16*N%,16*N%:NEXT:FORY%=4TO1016STEP4:FORX%=4TO1272STEP4:C%=POINT(X%-4,Y%)+POINT(X%-4,Y%-4)+POINT(X%,Y%-4)+POINT(X%+4,Y%-4):GCOL(C%/4+8*(RND(1)-.44))MOD16:PLOTX%,Y%:NEXT,
Code: REM > MAZE
REM by Jan Vibe
REM Adapted for BB4W by DW (may be slightly incorrect)
MODE8:OFF:B%=12
RECTANGLE 640-2*B%,512-2*B%,4*B%:MOVE640-2*B%,512+2*B%:PLOT2,0,-B%+4
PROCA(640-2*B%,512+2*B%)
END
DEFPROCA(X%,Y%)
LOCALN%
FORN%=1TO8
B1%=B%*SGN(RND(1)-.5):B2%=0:IFRND(1)>.5 SWAP B1%,B2%
X1%=X%+B1%:Y1%=Y%+B2%
IF POINT(X1%,Y1%)=0 LINE X%,Y%,X1%,Y1%:PROCA(X1%,Y1%)
NEXT
ENDPROC
|
|
Logged
|
|
|
|
DDRM
Administrator
member is offline
Gender:
Posts: 321
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #11 on: Nov 18th, 2015, 08:18am » |
|
Hi David,
I well remember the "Vibe-isms" from the 80's and 90's Acorn User magazine. What always impressed me was his ability to get so much out of such small amounts of code. Of the examples you posted, the maze one is amazing (sorry, couldn't resist!).
While looking (again) at maze-drawing algorithms in Wikipedia, I saw the section on cellular automata that generate maze-like conformations, so I thought I'd have a go.
While the basic automaton generates maze-LIKE patterns, making it into a fully connected maze, with a guaranteed route from start to finish means some post processing. I've put in some such code, though there are circumstances in which (usually very small) sections remain isolated. Note that this algorithm does NOT guarantee a unique route through the maze - and there can be circular routes, so simple maze-solving algorithms (such as wall-following) will fail!
Here's the code, if anyone wants a play. Try changing the maximum number of neighbours, and/or the probability of a space starting with a cell in it.
Code:
REM Maze-generating cellular automaton
MODE 21
NoOfSquares%=32
maxneighbours%=4 :REM Try changing to 5
Startingprob=0.3 :REM Probability that a square will start with a cell in it
sf%=1024/NoOfSquares%
DIM m%(NoOfSquares%,NoOfSquares%,1)
FOR x%=1 TO NoOfSquares%-1
FOR y%=1 TO NoOfSquares%-1
IF RND(1)<Startingprob THEN m%(x%,y%,0)=1
NEXT y%
NEXT x%
l%=0
l1%=1
cownt%=0
REM Here's the cellular automaton section
REPEAT
cownt%+=1
changes%=0
FOR x%=1 TO NoOfSquares%-1
FOR y%=1 TO NoOfSquares%-1
m%(x%,y%,l1%)=m%(x%,y%,l%)
c%=m%(x%-1,y%-1,l%)+m%(x%-1,y%,l%)+m%(x%-1,y%+1,l%)+m%(x%,y%-1,l%)+m%(x%,y%+1,l%)+m%(x%+1,y%-1,l%)+m%(x%+1,y%,l%)+m%(x%+1,y%+1,l%)
IF c%=3 AND m%(x%,y%,l%)=0 THEN changes%+=1:m%(x%,y%,l1%)=1
IF (c%=0 OR c%>maxneighbours%) AND (m%(x%,y%,l%)=1) THEN changes%+=1:m%(x%,y%,l1%)=0
NEXT y%
NEXT x%
SWAP l%,l1%
PROCDraw(l%)
UNTIL changes%=0 OR cownt%>50
REM Open entrance and exit
py%=NoOfSquares%/2
px%=NoOfSquares%
m%(px%,py%,l%)=1
m%(px%-1,py%,l%)=1
px%=0
m%(px%,py%,l%)=1
m%(px%+1,py%,l%)=1
PROCDraw(l%)
REM PROCvisit tries out all the pathways from a given point, setting flags in visited squares
PROCvisit(px%,py%)
REM Identify unconnected sections and try to connect them
FOR x%=1 TO NoOfSquares%-1
FOR y%=1 TO NoOfSquares%-1
IF m%(x%,y%,l%)=1 THEN
isolated%=TRUE
IF x%>2 THEN
IF m%(x%-2,y%,l%)=2 THEN m%(x%-1,y%,l%)=1:PROCvisit(x%-1,y%):PROCDraw(l%):isolated%=FALSE
ENDIF
IF x%<NoOfSquares%-2 AND isolated% THEN
IF m%(x%+2,y%,l%)=2 THEN m%(x%+1,y%,l%)=1:PROCvisit(x%+1,y%):PROCDraw(l%):isolated%=FALSE
ENDIF
IF y%>2 AND isolated% THEN
IF m%(x%,y%-2,l%)=2 THEN m%(x%,y%-1,l%)=1:PROCvisit(x%,y%-1):PROCDraw(l%):isolated%=FALSE
ENDIF
IF y%<NoOfSquares%-2 AND isolated% THEN
IF m%(x%,y%+2,l%)=2 THEN m%(x%,y%+1,l%)=1:PROCvisit(x%,y%+1):PROCDraw(l%):isolated%=FALSE
ENDIF
ENDIF
NEXT y%
NEXT x%
PROCDraw(l%)
WAIT 20
REM Let's clear it and re-traverse the maze, to check we can get from start to finish!
PROCClear(l%)
PROCDraw(l%)
WAIT 20
PROCvisit(0,NoOfSquares%/2)
PROCDraw(l%)
END
:
DEFPROCDraw(n%)
LOCAL x%,y%
REM CLS
FOR x%=0 TO NoOfSquares%
FOR y%=0 TO NoOfSquares%
CASE m%(x%,y%,n%) OF
WHEN 0 GCOL 15 :REM Wall
WHEN 1 GCOL 0 :REM passage
WHEN 2 GCOL 1 :REM Visited passage
ENDCASE
RECTANGLE FILL sf%*x%,sf%*y%,sf%,sf%
NEXT y%
NEXT x%
ENDPROC
:
DEFPROCvisit(px%,py%)
IF m%(px%,py%,l%)<>1 THEN ENDPROC
m%(px%,py%,l%)=2
IF px%<NoOfSquares% THEN PROCvisit(px%+1,py%)
IF py%<NoOfSquares% THEN PROCvisit(px%,py%+1)
IF px%>0 THEN PROCvisit(px%-1,py%)
IF py%>0 PROCvisit(px%,py%-1)
ENDPROC
:
DEFPROCClear(l%)
LOCAL x%,y%
FOR x%=0 TO NoOfSquares%
FOR y%=0 TO NoOfSquares%
IF m%(x%,y%,l%)=2 THEN m%(x%,y%,l%)=1
NEXT y%
NEXT x%
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 #12 on: Nov 18th, 2015, 6:16pm » |
|
on Nov 18th, 2015, 08:18am, DDRM wrote:Hi David,
I well remember the "Vibe-isms" from the 80's and 90's Acorn User magazine. What always impressed me was his ability to get so much out of such small amounts of code. Of the examples you posted, the maze one is amazing (sorry, couldn't resist!). |
|
Indeed, and in fact I was just trying to track down his circular maze drawer. If I can find it, I'll adapt it and put it up here. His 'crop circle'-drawing one-liner is really excellent.
It was from one of his programs that I learnt how to do screen bank swapping (I didn't have the RISC OS Programmer's Reference Manual):
Code:J%=1:K%=2
REPEAT
WAIT : CLS
<...draw graphics...>
SYS 6, 112, J%
SYS 6, 113, K%
SWAP J%, K%
UNTIL FALSE
That bit of code found its way into practically every program I ever wrote for RISC OS!
Quote:| While looking (again) at maze-drawing algorithms in Wikipedia, I saw the section on cellular automata that generate maze-like conformations, so I thought I'd have a go. |
|
Interesting and rather entertaining to watch (even more so after setting NoOfSquares% to a higher value such as 64)! I had never heard of automaton-generated mazes until now, but then I've never really looked into maze generation. I once made a Wolfenstein-style 3D maze demo (based on D3DLIB), all orthogonal walls, where I created the maze the tedious way - using a custom-built editor. I think that using a maze generator (such as yours) would have been more interesting and probably less time-consuming. Anyway, I think your code (comprehensible as usual) is particularly informative to those trying to get their head around recursion! I must admit, I don't think I've ever employed such techniques in my projects, but only because I haven't got the head for it.
David.
--
PS. Bonus for the interested: Here's a little Vibe-esque demo (EXE - the included source requires GFXLIB). Actually, it came about from a need to draw random, twisty curves for a game I'm making. The method I came up with seems to do a reasonable job. http://www.proggies.uk/bb4w/ropefade.zip
|
|
Logged
|
|
|
|
David Williams
Developer
member is offline
meh
Gender:
Posts: 452
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #13 on: Nov 22nd, 2015, 1:29pm » |
|
Perhaps someone else could have a go at porting the next one? The code listed below will run without errors, but the result is not correct! The program makes effective use of RISC OS's ECF (Extended Colour Fill) patterns (VDU 23, [2 to 5], ...), not supported by BB4W (they're not really needed since the RISC OS version runs in 16-colour mode 12 (640x512 and those horrible 'tall' pixels), and BB4W can display 'True Colour' making dithering patterns unnecessary).
This is what you should see in an appropriately modified version:
http://www.proggies.uk/bb4w/img/jvibe_wheel_scrshot.gif
Below is Jan Vibe's original, unmolested code:
Code:
10REM > WHEEL
20
30MODE12:ORIGIN 640,512:OFF
40FORN%=0TO15:COLOUR N%,16*N%,0,16*(15-N%):NEXT
50FORM%=82TO0STEP-1:Z%=10*M%
60FORN%=1TO240
70C%=(N%+M%)MOD30
80A%=(N%+M%)DIV30
90B%=A%MOD2
100IF B%=0 C%=30-C%
110PROCC(C%)
120MOVE 0,0:MOVE Z%*SINRAD(1.5*N%),Z%*COSRAD(1.5*N%)
130PLOT85,Z%*SINRAD(1.5*(N%+1)),Z%*COSRAD(1.5*(N%+1))
140NEXT,
150END
160
170DEFPROCC(A%)
180LOCAL P1%,P2%
190A%=A%MOD31
200IF A%MOD2=0 THEN
210 GCOL A%DIV2
220ELSE
230 A%=A%DIV2
240 P1%=FNA(A%,A%+1)
250 P2%=FNA(A%+1,A%)
260 VDU23,2,P1%,P2%,P1%,P2%,P1%,P2%,P1%,P2%
270 GCOL16,0
280ENDIF
290ENDPROC
300
310DEFFNA(A%,B%)
320LOCAL N%,C%,AB%
330C%=8
340FORN%=1TO4
350AB%=AB%<<1:IF C%ANDA% AB%+=1
360AB%=AB%<<1:IF C%ANDB% AB%+=1
370C%=C%/2:NEXT
380=AB%
|
|
Logged
|
|
|
|
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
|
|
|
|
|
