Author |
Topic: Some RISC OS graphical ditties converted to BB4W (Read 615 times) |
|
David Williams
Developer
member is offline
meh
Gender: 
Posts: 452
|
 |
Some RISC OS graphical ditties converted to BB4W
« Thread started on: Nov 8th, 2015, 10:51am » |
|
These are from Jan Vibe (many old-timer RISC OS users will remember this guy). I think I might have put these up before, but looking back through this section of the forum, I can't find them. So perhaps I didn't?
Jan Vibe's 'Guts' (both versions are full screen; click mouse or press Escape to exit):
Code:
REM > GUTS
REM Original ARM BBC BASIC version by Jan Vibe
REM Adapted for BB4W by DW
*FLOAT 64
ON CLOSE VDU 7 : QUIT
ON ERROR PROC_error
GWL_STYLE = -16
HWND_TOPMOST = -1
WS_VISIBLE = &10000000
WS_CLIPCHILDREN = &2000000
WS_CLIPSIBLINGS = &4000000
SYS "GetSystemMetrics", 0 TO xscreen%
SYS "GetSystemMetrics", 1 TO yscreen%
SYS "SetWindowLong", @hwnd%, GWL_STYLE, WS_VISIBLE + \
\ WS_CLIPCHILDREN + WS_CLIPSIBLINGS
SYS "SetWindowPos", @hwnd%, HWND_TOPMOST, 0, 0, xscreen%, yscreen%, 0
VDU 26 : OFF
GCOL 0 : FILL 0,0
scrW% = @vdu%!208
scrH% = @vdu%!212
DIM BX%(15),by%(15),BZ(15):BX%()=-100:A%=0
FORN%=1TO15:COLOUR 16-N%,7*N%+150,14*N%+45,14*N%+45:NEXT
X1%=RND(scrW%)+256:Y1%=RND(scrH%)+256
DX1%=RND(16)*SGN(RND(1)-.5):DY1%=RND(16)*SGN(RND(1)-.5)
X2%=RND(scrW%)+256:Y2%=RND(scrH%)+256
DX2%=RND(16)*SGN(RND(1)-.5):DY2%=RND(16)*SGN(RND(1)-.5)
REPEAT
MOUSE msX%, msY%, mBtn%
H%=X1%+DX1%:IF H%<256 OR H%>2*scrW%-256 DX1%=RND(16)*SGN(-DX1%)
H%=Y1%+DY1%:IF H%<256 OR H%>scrH%+512 DY1%=RND(16)*SGN(-DY1%)
X1%+=DX1%:Y1%+=DY1%
IF X2%<X1% AND DX2%<24 DX2%+=1
IF X2%>X1% AND DX2%>-24 DX2%-=1
IF Y2%<Y1% AND DY2%<24 DY2%+=1
IF Y2%>Y1% AND DY2%>-24 DY2%-=1
X2%+=DX2%:Y2%+=DY2%:A%=(A%+10)MOD360:Z=(SINRADA%+1)+2
FORN%=2TO15
BX%(N%-1)=BX%(N%):by%(N%-1)=by%(N%):BZ(N%-1)=BZ(N%)
NEXT:BX%(15)=X2%:by%(15)=Y2%:BZ(15)=Z
FORN%=1TO15:GCOLN%:CIRCLE FILL BX%(N%),by%(N%),N%*BZ(N%):NEXT
UNTIL mBtn% <> 0
VDU 7 : QUIT
END
DEF PROC_fixWindowSize
LOCAL GWL_STYLE, WS_THICKFRAME, WS_MAXIMIZEBOX, ws%
GWL_STYLE = -16
WS_THICKFRAME = &40000
WS_MAXIMIZEBOX = &10000
SYS "GetWindowLong", @hwnd%, GWL_STYLE TO ws%
SYS "SetWindowLong", @hwnd%, GWL_STYLE, ws% AND NOT (WS_THICKFRAME+WS_MAXIMIZEBOX)
ENDPROC
DEF PROC_error
IF ERR = 17 THEN VDU 7 : QUIT
OSCLI "REFRESH ON" : ON
COLOUR 0, 0, 0, 0
COLOUR 128, 0, 0, 0 : COLOUR 128
COLOUR 7, 255, 255, 255 : COLOUR 7
VDU 7
REPORT : PRINT " at line "; ERL;
REPEAT : WAIT 1 : UNTIL FALSE
ENDPROC
Code:
REM > GUTS2
REM Original ARM BBC BASIC version by Jan Vibe
REM Adapted for BB4W by DW
*FLOAT 64
ON CLOSE VDU 7 : QUIT
ON ERROR PROC_error
GWL_STYLE = -16
HWND_TOPMOST = -1
WS_VISIBLE = &10000000
WS_CLIPCHILDREN = &2000000
WS_CLIPSIBLINGS = &4000000
SYS "GetSystemMetrics", 0 TO xscreen%
SYS "GetSystemMetrics", 1 TO yscreen%
SYS "SetWindowLong", @hwnd%, GWL_STYLE, WS_VISIBLE + \
\ WS_CLIPCHILDREN + WS_CLIPSIBLINGS
SYS "SetWindowPos", @hwnd%, HWND_TOPMOST, 0, 0, xscreen%, yscreen%, 0
VDU 26 : OFF
GCOL 0 : FILL 0,0
scrW% = @vdu%!208
scrH% = @vdu%!212
DIM BX%(15),by%(15),BZ(15),R(15),G(15),B(15)
BX%()=-100:A%=0:AR%=RND(360):AG%=RND(360):AB%=RND(360)
REMSYS "OS_SWINumberFromString",,"ColourTrans_SetGCOL" TO set_gcol%
X1%=RND(scrW%)+256:Y1%=RND(scrH%)+256
DX1%=RND(16)*SGN(RND(1)-.5):DY1%=RND(16)*SGN(RND(1)-.5)
X2%=RND(scrW%)+256:Y2%=RND(scrH%)+256
DX2%=RND(16)*SGN(RND(1)-.5):DY2%=RND(16)*SGN(RND(1)-.5)
GCOL 1
REPEAT
MOUSE msX%, msY%, msBtn%
H%=X1%+DX1%:IF H%<256 OR H%>2*scrW%-256 DX1%=RND(16)*SGN(-DX1%)
H%=Y1%+DY1%:IF H%<256 OR H%>scrH%+512 DY1%=RND(16)*SGN(-DY1%)
X1%+=DX1%:Y1%+=DY1%
IF X2%<X1% AND DX2%<24 DX2%+=1
IF X2%>X1% AND DX2%>-24 DX2%-=1
IF Y2%<Y1% AND DY2%<24 DY2%+=1
IF Y2%>Y1% AND DY2%>-24 DY2%-=1
X2%+=DX2%:Y2%+=DY2%:A%=(A%+10)MOD360:Z=(SINRADA%+1)+2
AR%=(AR%+RND(12))MOD360:SR=(1+SINRADAR%)/2
AG%=(AG%+RND(12))MOD360:SG=(1+SINRADAG%)/2
AB%=(AB%+RND(12))MOD360:SB=(1+SINRADAB%)/2
FORN%=2TO15
BX%(N%-1)=BX%(N%):by%(N%-1)=by%(N%):BZ(N%-1)=BZ(N%)
R(N%-1)=R(N%):G(N%-1)=G(N%):B(N%-1)=B(N%)
NEXT
BX%(15)=X2%:by%(15)=Y2%:BZ(15)=Z:R(15)=SR:G(15)=SG:B(15)=SB
FORN%=1TO15
CR=1-N%/15*R(N%):CG=1-N%/15*G(N%):CB=1-N%/15*B(N%)
REMSYS set_gcol%,((CR*&FF)<<8)+((CG*&FF)<<16)+((CB*&FF)<<24),,,&100,0
COLOUR 1, 255*CR, 255*CG, 255*CB
CIRCLE FILL BX%(N%),by%(N%),N%*BZ(N%):NEXT
UNTIL msBtn% <> 0
VDU 7: QUIT
END
DEF PROC_fixWindowSize
LOCAL GWL_STYLE, WS_THICKFRAME, WS_MAXIMIZEBOX, ws%
GWL_STYLE = -16
WS_THICKFRAME = &40000
WS_MAXIMIZEBOX = &10000
SYS "GetWindowLong", @hwnd%, GWL_STYLE TO ws%
SYS "SetWindowLong", @hwnd%, GWL_STYLE, ws% AND NOT (WS_THICKFRAME+WS_MAXIMIZEBOX)
ENDPROC
DEF PROC_error
IF ERR = 17 THEN VDU 7 : QUIT
OSCLI "REFRESH ON" : ON
COLOUR 0, 0, 0, 0
COLOUR 128, 0, 0, 0 : COLOUR 128
COLOUR 7, 255, 255, 255 : COLOUR 7
VDU 7
REPORT : PRINT " at line "; ERL;
REPEAT : WAIT 1 : UNTIL FALSE
ENDPROC
|
|
 Logged
|
|
|
|
David Williams
Developer
member is offline
meh
Gender:
Posts: 452
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #1 on: Nov 8th, 2015, 10:53am » |
|
'ELASTIC2' by Jan Vibe (sorry if I've put this up before; I don't remember doing so!):
Code:
REM > ELASTIC2 *** Jan Vibe february 94 ***
REM Original ARM BBC BASIC version by Jan Vibe
REM Adapted (and modified) for BB4W by DW
*ESC OFF
ON ERROR PROC_error
PROC_fixWindowSize
MODE 8 : OFF
COLOUR0,0,0,255 : COLOUR 128 : CLS
PRINTTAB(33,1)"Elastic sheet"'
PRINTTAB(10)"This program demonstrates the movements of a elastic sheet."
PRINTTAB(10)"The sheet is made up of coloured rectangles, the corners of"
PRINTTAB(10)"which can be moved with the mousepointer."'
PRINTTAB(10)"To move a corner, place the pointer near the corner and"
PRINTTAB(10)"press the left mousebutton down, and hold it down. This"
PRINTTAB(10)"causes the corner nearest the pointer to lock onto the"
PRINTTAB(10)"pointer, and follow it when it is moved. When the mouse-"
PRINTTAB(10)"button is released, the corner is free to move again."'
PRINTTAB(10)"A corner can be stopped from moving by placing the pointer"
PRINTTAB(10)"over it, and pressing the right mousebutton. The corner"
PRINTTAB(10)"is now fixed, but can still be moved with the mouse."'
PRINTTAB(10)"The fixed corners can be released by moving the mouse over"
PRINTTAB(10)"the corner, and pressing the middle mousebutton."
PRINTTAB(23,25)"Click any mousebutton to continue"
REPEAT:MOUSE A%,B%,C%:UNTILC%<>0
REPEAT:MOUSE A%,B%,C%:UNTILC%=0
W%=16 :REM Number of points in X direction
H%=15 :REM Number of points in Y direction
WX%=1280 :REM Width of original sheet
HY%=1024 :REM Height of original sheet
V%=6 :REM Weight of sheet material
T=0.5 :REM Tendency of sheet corners to stay where put originally
D=0.99 :REM Damping factor
P1%=1:P2%=2:S1%=1:S2%=2:PX%=0:PY%=0:D1=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%)
FORN%=1TO15:COLOURN%,16*N%,16*N%,0: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
NEXT
TIME=0
REM ONERRORGOTO890
REM*POINTER
*REFRESH OFF
REM Screen and mouse control
REPEAT
CLS
REMSYS 6,112,S1%:SYS 6,113,S2%:WAIT:CLS:SWAP S1%,S2%
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: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
IF TIME>300 D1=D
SWAP P1%,P2%
REM drawing of net
FORJ%=1TOH%-1:FORI%=1TOW%-1:C%=J%+I%:GCOLABS((C%MOD28)-14)+1
MOVEX(I%,J%,P2%),Y(I%,J%,P2%):MOVEX(I%+1,J%,P2%),Y(I%+1,J%,P2%)
PLOT85,X(I%,J%+1,P2%),Y(I%,J%+1,P2%)
PLOT85,X(I%+1,J%+1,P2%),Y(I%+1,J%+1,P2%)
NEXT
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%))*D1
DY(I%,J%)=(Y(I%,J%,P1%)-Y(I%,J%,P2%))*D1
ENDIF
ENDIF
NEXT
NEXT
*REFRESH
WAIT 1
UNTIL0
REMSYS 6,112,S1%:REPORT:PRINT" at line "STR$ERL:ON
DEF PROC_fixWindowSize
LOCAL GWL_STYLE, WS_THICKFRAME, WS_MAXIMIZEBOX, ws%
GWL_STYLE = -16
WS_THICKFRAME = &40000
WS_MAXIMIZEBOX = &10000
SYS "GetWindowLong", @hwnd%, GWL_STYLE TO ws%
SYS "SetWindowLong", @hwnd%, GWL_STYLE, ws% AND NOT (WS_THICKFRAME+WS_MAXIMIZEBOX)
ENDPROC
DEF PROC_error
OSCLI "REFRESH ON" : ON : COLOUR 7 : VDU 7
REPORT : PRINT " at line "; ERL;
REPEAT : WAIT 1 : UNTIL FALSE
ENDPROC
|
|
Logged
|
|
|
|
David Williams
Developer
member is offline
meh
Gender:
Posts: 452
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #2 on: Nov 8th, 2015, 12:25pm » |
|
Jan Vibe's 'JELLY2' (use the mouse to nudge the jelly, but do it subtly!):
Code:
REM > JELLY2
REM by Jan Vibe
REM Adapted for BB4W by DW
MODE 8 : OFF
REMMODE224:MODE 96
DIM X(39,1),Y(39,1),DX(39),DY(39),OX(39),OY(39)
P1%=0:P2%=1:S1%=1:S2%=2:REM*POINTER
FORN%=0TO39:T=RAD(9*N%)
X(N%,0)=640+300*SINT:OX(N%)=X(N%,0)
Y(N%,0)=512+300*COST:OY(N%)=Y(N%,0)
NEXT
REMONERRORGOTO320
*REFRESH OFF
REPEAT
CLS
SWAP P1%,P2%
REMSYS 6,112,S1%:SYS 6,113,S2%:WAIT:CLS:SWAP S1%,S2%
MOVEX(39,P2%),Y(39,P2%)
@vdu%!248=2 : REM BB4W enhancement: thicker lines
FORN%=0TO39:DRAWX(N%,P2%),Y(N%,P2%):NEXT
@vdu%!248=1
FORN%=0TO39:N1%=(N%+1)MOD40:N2%=(N%+39)MOD40
OB%=B%:MOUSE X%,Y%,B%:IF B%<>0 THEN
IF B%<>OB% THEN
D=1E9:M%=0:FORI%=0TO39:Z=(X%-X(I%,P2%))^2+(Y%-Y(I%,P2%))^2
IF Z<D D=Z:M%=I%
NEXT
ENDIF
X(M%,P1%)=X%:Y(M%,P1%)=Y%
ENDIF
X(N%,P1%)=(3*X(N%,P2%)+X(N1%,P2%)+X(N2%,P2%)+OX(N%))/6+DX(N%)
Y(N%,P1%)=(3*Y(N%,P2%)+Y(N1%,P2%)+Y(N2%,P2%)+OY(N%))/6+DY(N%)
IF B%=0 OR N%<>M% THEN
DX(N%)=(X(N%,P1%)-X(N%,P2%))*.98:DY(N%)=(Y(N%,P1%)-Y(N%,P2%))*.98
ENDIF
NEXT
*REFRESH
WAIT 1
UNTIL0
REMSYS 6,112,S1%:REPORT:PRINT" at line "STR$ERL:ON
|
|
|
|
David Williams
Developer
member is offline
meh
Gender:
Posts: 452
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #3 on: Nov 8th, 2015, 12:40pm » |
|
'COLTRAP2' by Jan Vibe:
Code:
REM > COLTRAP2
REM by Jan Vibe
REM Adapted for BB4W by DW
REMMODE"X1024 Y768 C32K":OFF
*ESC OFF
ON ERROR PROCError(REPORT$ + " at line " + STR$ERL)
ScrW% = 1024
ScrH% = 768
PROCFixWndSz
VDU 23,22,ScrW%;ScrH%;8,16,16,0 : VDU 26 : OFF
DIM P%(4,5)
GCOL 15
REPEAT
FOR N%=1TO4:FORM%=3TO5:P%(N%,M%)=RND(255):NEXT,
P%(1,1)=RND(1024):P%(1,2)=RND(768)
P%(2,1)=RND(1024)+1024:P%(2,2)=RND(768)
P%(3,1)=RND(1024)+1024:P%(3,2)=RND(768)+768
P%(4,1)=RND(1024):P%(4,2)=RND(768)+768
PROCCS(P%(),30)
UNTIL0
DEFPROCCS(P%(),D%)
LOCAL N%,M%,XA%(),YA%(),RA%(),GA%(),BA%(),X%(),Y%(),R%(),G%(),B%()
DIMXA%(2),YA%(2),RA%(2),GA%(2),BA%(2)
DIMX%(D%,D%),Y%(D%,D%),R%(D%,D%),G%(D%,D%),B%(D%,D%)
FORN%=0TOD%
XA%(1)=(P%(1,1)*(D%-N%)+P%(4,1)*N%)/D%
YA%(1)=(P%(1,2)*(D%-N%)+P%(4,2)*N%)/D%
RA%(1)=(P%(1,3)*(D%-N%)+P%(4,3)*N%)/D%
GA%(1)=(P%(1,4)*(D%-N%)+P%(4,4)*N%)/D%
BA%(1)=(P%(1,5)*(D%-N%)+P%(4,5)*N%)/D%
XA%(2)=(P%(2,1)*(D%-N%)+P%(3,1)*N%)/D%
YA%(2)=(P%(2,2)*(D%-N%)+P%(3,2)*N%)/D%
RA%(2)=(P%(2,3)*(D%-N%)+P%(3,3)*N%)/D%
GA%(2)=(P%(2,4)*(D%-N%)+P%(3,4)*N%)/D%
BA%(2)=(P%(2,5)*(D%-N%)+P%(3,5)*N%)/D%
FORM%=0TOD%
X%(M%,N%)=(XA%(1)*(D%-M%)+XA%(2)*M%)/D%
Y%(M%,N%)=(YA%(1)*(D%-M%)+YA%(2)*M%)/D%
R%(M%,N%)=(RA%(1)*(D%-M%)+RA%(2)*M%)/D%
G%(M%,N%)=(GA%(1)*(D%-M%)+GA%(2)*M%)/D%
B%(M%,N%)=(BA%(1)*(D%-M%)+BA%(2)*M%)/D%
NEXTM%,N%
FOR N%=0TOD%-1:FORM%=0TOD%-1
RA%(1)=(R%(M%,N%)+R%(M%+1,N%)+R%(M%+1,N%+1)+R%(M%,N%+1))/4
GA%(1)=(G%(M%,N%)+G%(M%+1,N%)+G%(M%+1,N%+1)+G%(M%,N%+1))/4
BA%(1)=(B%(M%,N%)+B%(M%+1,N%)+B%(M%+1,N%+1)+B%(M%,N%+1))/4
REMPROCRGB(RA%(1),GA%(1),BA%(1))
COLOUR 15, RA%(1), GA%(1), BA%(1)
MOVEX%(M%,N%),Y%(M%,N%):MOVEX%(M%+1,N%),Y%(M%+1,N%)
PLOT85,X%(M%,N%+1),Y%(M%,N%+1):PLOT85,X%(M%+1,N%+1),Y%(M%+1,N%+1)
NEXTM%,N%
ENDPROC
REM DEFPROCRGB(R%,G%,B%)
REM LOCAL C%:C%=(R%<<8)+(G%<<16)+(B%<<24)
REM SYS "ColourTrans_SetGCOL",C%,,,&100,0
REM ENDPROC
DEF PROCFixWndSz
LOCAL W%
SYS"GetWindowLong",@hwnd%,-16 TO W%
SYS"SetWindowLong",@hwnd%,-16,W% ANDNOT&40000 ANDNOT&10000
ENDPROC
DEF PROCError(s$)
OSCLI "REFRESH ON"
CLS : ON : VDU 7
PRINT '" " + s$;
REPEAT UNTIL INKEY(1)=0
ENDPROC
|
|
Logged
|
|
|
|
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
|
|
|
|
|
