Author |
Topic: Some RISC OS graphical ditties converted to BB4W (Read 621 times) |
|
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
|
|
|
|
David Williams
Developer
member is offline
meh
Gender:
Posts: 452
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #19 on: Nov 26th, 2015, 10:59pm » |
|
Not by Jan Vibe, but certainly inspired by one or two of his programs. It redraws (usually with a different colour scheme) every 10-or-so seconds.
Code:
REM>POLYWEB
REM by DW
REM Inspired by JV
REM Coded so as to be easily 'ported' to ARM BBC BASIC
MODE 10
OFF
ScrW% = @vdu%!208
ScrH% = @vdu%!212
Cx% = ScrW% DIV 2
Cy% = ScrH% DIV 2
MaxDist% = SQR(Cx%^2 + Cy%^2) + 0.5
NumCircs% = 150
MinSepDist% = 16
MaxSepDist% = 80
SepDiff% = MaxSepDist% - MinSepDist%
InitialRadius% = 100
DIM x%(NumCircs%-1), y%(NumCircs%-1)
DIM col%(NumCircs%-1, 2) : REM 0=R, 1=G, 2=B
R% = RND(-TIME)
REPEAT
swapRGB1% = RND(3)-1
swapRGB2% = RND(3)-1
swapRGB3% = RND(3)-1
swapRGB4% = RND(3)-1
invertR% = RND(2)-1
invertG% = RND(2)-1
invertB% = RND(2)-1
invertF% = RND(2)-1
x%(0) = RND( ScrW% )-1
y%(0) = RND( ScrH% )-1
PROCColour(0, FNdist(x%(0), y%(0))/MaxDist% )
FOR I% = 1 TO NumCircs%-1
REPEAT
x% = RND( ScrW% )-1
y% = RND( ScrH% )-1
dist0% = FNdist(x%, y%)
mindist% = MinSepDist% + dist0%/MaxDist%*SepDiff%
FOR J% = 0 TO I%-1
accept% = TRUE
d% = SQR((x% - x%(J%))^2 + (y% - y%(J%))^2)
IF d% < mindist% THEN
accept% = FALSE
J% = I%-1
ENDIF
NEXT J%
UNTIL accept%
x%(I%) = x%
y%(I%) = y%
PROCColour( I%, dist0%/MaxDist% )
NEXT I%
CLS
GCOL 15
FOR R% = InitialRadius% TO 1 STEP -1
FOR I% = 0 TO NumCircs%-1
COLOUR 15, col%(I%,0), col%(I%,1), col%(I%,2)
CIRCLE FILL 2*x%(I%), 2*y%(I%), 2*R%
NEXT I%
NEXT R%
WAIT 1000
UNTIL FALSE
END
DEF FNdist(X%, Y%)
= SQR((X% - Cx%)^2 + (Y% - Cy%)^2)
DEF PROCColour( K%, f )
IF invertF% THEN f = 1-f
col%(K%, 0) = f * RND(32)
col%(K%, 1) = f * (128 + RND(127))
col%(K%, 2) = f * RND(128)
IF invertR% THEN col%(K%,0) = 255 - col%(K%,0)
IF invertG% THEN col%(K%,1) = 255 - col%(K%,1)
IF invertB% THEN col%(K%,2) = 255 - col%(K%,2)
SWAP col%(K%, swapRGB1%), col%(K%, swapRGB2%)
SWAP col%(K%, swapRGB3%), col%(K%, swapRGB4%)
ENDPROC
|
|
|
|
David Williams
Developer
member is offline
meh
Gender:
Posts: 452
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #20 on: Nov 27th, 2015, 4:03pm » |
|
Who needs multithreading when you've got TIMERLIB?
This works well on my laptop PC, with occasional hiccups:
Code:
REM>POLYWEB2
REM by DW
REM Inspired by JV
*FLOAT 64
*ESC OFF
MODE 10
OFF
BallSprPath$ = LEFT$(@lib$, LEN@lib$-4) + "EXAMPLES\GRAPHICS\BALL.ICO"
NumBalls% = 20
ScrW% = @vdu%!208
ScrH% = @vdu%!212
INSTALL @lib$ + "TIMERLIB"
INSTALL @lib$ + "NOWAIT"
INSTALL @lib$ + "SPRITELIB"
IF FN_initsprites( NumBalls% ) = 0 STOP
SprReady% = FALSE
timerid% = FN_ontimer(10, PROCUpdateBalls, 1)
ON CLOSE PROC_killtimer(timerid%) : PROC_exitsprites : QUIT
ON ERROR ON ERROR OFF : PROC_killtimer(timerid%) : PROC_exitsprites : OSCLI "REFRESH ON" : PRINT 'REPORT$ : END
FOR I% = 0 TO NumBalls%-1
IF FN_createsprite(I%, BallSprPath$, 32, 32) = 0 ERROR 0, "Cannot create sprite "+STR$I%
NEXT I%
SprReady% = TRUE
Cx% = ScrW% DIV 2
Cy% = ScrH% DIV 2
MaxDist% = SQR(Cx%^2 + Cy%^2) + 0.5
NumCircs% = 150
MinSepDist% = 16
MaxSepDist% = 80
SepDiff% = MaxSepDist% - MinSepDist%
InitialRadius% = 100
DIM x%(NumCircs%-1), y%(NumCircs%-1)
DIM col%(NumCircs%-1, 2) : REM 0=R, 1=G, 2=B
R% = RND(-TIME) : TIME = 0
REPEAT
swapRGB1% = RND(3)-1
swapRGB2% = RND(3)-1
swapRGB3% = RND(3)-1
swapRGB4% = RND(3)-1
invertR% = RND(2)-1
invertG% = RND(2)-1
invertB% = RND(2)-1
invertF% = RND(2)-1
x%(0) = RND( ScrW% )-1
y%(0) = RND( ScrH% )-1
PROCColour(0, FNdist(x%(0), y%(0))/MaxDist% )
FOR I% = 1 TO NumCircs%-1
REPEAT
x% = RND( ScrW% )-1
y% = RND( ScrH% )-1
dist0% = FNdist(x%, y%)
mindist% = MinSepDist% + dist0%/MaxDist%*SepDiff%
FOR J% = 0 TO I%-1
accept% = TRUE
d% = SQR((x% - x%(J%))^2 + (y% - y%(J%))^2)
IF d% < mindist% THEN
accept% = FALSE
J% = I%-1
ENDIF
NEXT J%
UNTIL accept%
x%(I%) = x%
y%(I%) = y%
PROCColour( I%, dist0%/MaxDist% )
NEXT I%
CLS
GCOL 15
FOR R% = InitialRadius% TO 1 STEP -1
FOR I% = 0 TO NumCircs%-1
COLOUR 15, col%(I%,0), col%(I%,1), col%(I%,2)
CIRCLE FILL 2*x%(I%), 2*y%(I%), 2*R%
NEXT I%
NEXT R%
PROCwait(500)
UNTIL FALSE
END
DEF FNdist(X%, Y%)
= SQR((X% - Cx%)^2 + (Y% - Cy%)^2)
DEF PROCColour( K%, f )
IF invertF% THEN f = 1-f
col%(K%, 0) = f * RND(32)
col%(K%, 1) = f * (128 + RND(127))
col%(K%, 2) = f * RND(128)
IF invertR% THEN col%(K%,0) = 255 - col%(K%,0)
IF invertG% THEN col%(K%,1) = 255 - col%(K%,1)
IF invertB% THEN col%(K%,2) = 255 - col%(K%,2)
SWAP col%(K%, swapRGB1%), col%(K%, swapRGB2%)
SWAP col%(K%, swapRGB3%), col%(K%, swapRGB4%)
ENDPROC
DEF PROCUpdateBalls
IF NOT SprReady% THEN ENDPROC
LOCAL I%, T%, X%, Y%, a, b, c, d, e, f
T% = TIME
FOR I% = 0 TO NumBalls%-1
a = T%/35 + I%/10
b = T%/92 + 0.3
c = T%/134 + 1.4
d = SIN(T%/200)
e = SIN(T%/50 + 2.1)*COS(T%/250 - 0.8)
f = SIN(T%/160 + I%/8)*COS(T%/123 + 1.4)
X% = 320*SIN(a + f)*SIN(b + d)*SIN(c + e)
Y% = 300*COS(a + f)*COS(b + d)*COS(c + e)
PROC_movesprite(I%, ScrW%+2*X%, ScrH%+2*Y%, 1)
NEXT I%
ENDPROC
|
|
Logged
|
|
|
|
dfeugey
Guest
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #21 on: Nov 28th, 2015, 12:41pm » |
|
Cool...
|
|
Logged
|
|
|
|
David Williams
Developer
member is offline
meh
Gender:
Posts: 452
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #22 on: Nov 28th, 2015, 8:39pm » |
|
on Nov 28th, 2015, 12:41pm, dfeugey wrote:
I think it's time for an ARM BBC BASIC 'mega demo'.  Ideally not touching assembly language (in order to keep it purely BASIC). Anyway, if one were to go ahead with it, I think the Raspberry Pi 2 would have to be the minimum requirement (the new Titanium sounds very nice, but I can't afford one!).
Perhaps a future Raspberry Pi 3 will feature an ARM Cortex-A15? That'd be nice, wouldn't it?
(Someone ought to suggest it to Eben.)
Some new additions to my website: http://www.proggies.uk
I intend to upload my old and more recent BB4W efforts over the next week or two.
David.
--
|
|
|
|
dfeugey
Guest
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #23 on: Nov 29th, 2015, 06:47am » |
|
Yep, there is some room for a BBC Basic scene, because of the very fast two offers available (BBCBasic4Win and BBC Basic for RISC OS) and of the presence of interesting computers. On my todo list, I plan to recompile Brandy, with all the latest modifications, and perhaps even CGI management.
|
|
Logged
|
|
|
|
DDRM
Administrator
member is offline
Gender:
Posts: 321
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #24 on: Dec 4th, 2015, 08:17am » |
|
Hi Folks,
Not really a reply, and not converted from RISC OS, but it seems to fit with the ongoing theme.
Here's a small ditty based on spirograph. Feel free to fiddle with it to your heart's content!
Code:
REM Spirograph simulation (epicycles). A smaller wheel (r2) rolls around inside a bigger one (r1)
MODE 21
ORIGIN 800,600
r1=500 :REM Radius of fixed circle
*REFRESH OFF
FOR denom%=3 TO 10
da2=denom% :REM Angle change in inner wheel between each plotted point, in degrees. You can use it like a speed control
CLS
FOR num%=1 TO denom%-1
r2=r1*num%/denom%
FOR pen=0.1 TO 0.9 STEP 0.01 :REM Distance of pen between centre and edge of smaller wheel
REM CLS:REM If you unREM this line you can see each individual pattern!
IF num% MOD 2=0 THEN p=1-pen ELSE p=pen
PROCDrawIt(0,r1,r2,p,da2,denom%,num%)
*REFRESH
NEXT pen
NEXT num%
NEXT denom%
*REFRESH ON
END
:
DEFPROCDrawIt(startangle,r1,r2,pen,da2,denom%,col%)
LOCAL da1,count%
da1=da2*r2/r1 :REM angle change around fixed circle for each "step" of moving wheel
GCOL col%
count%=0
MOVE (r1-r2)*COSRAD(startangle+da1*count%)+pen*r2*COSRAD(startangle-da2*count%),(r1-r2)*SINRAD(startangle+da1*count%)+pen*r2*SINRAD(startangle-da2*count%)
REPEAT
count%+=1
DRAW (r1-r2)*COSRAD(startangle+da1*count%)+pen*r2*COSRAD(startangle-da2*count%),(r1-r2)*SINRAD(startangle+da1*count%)+pen*r2*SINRAD(startangle-da2*count%)
UNTIL count%*da2>=360*denom%
ENDPROC
Best wishes,
D
|
|
Logged
|
|
|
|
David Williams
Developer
member is offline
meh
Gender:
Posts: 452
|
|
Re: Some RISC OS graphical ditties converted to BB
« Reply #25 on: Dec 4th, 2015, 7:08pm » |
|
Very nice, David.
Here's one inspired by a GIF animation I came across today whilst searching for something related:
http://www.i.imgur.com/Rnk6JvK.gif
(And here's what I was actually looking for: https://upload.wikimedia.org/wikipedia/commons/1/1a/Fourier_series_square_wave_circles_animation.gif)
Code:
REM>CIRCWAVES
REM Idea borrowed from an animated GIF found on Imgur via Reddit.com:
REM http://www.i.imgur.com/Rnk6JvK.gif
REM This BB4W version uses native graphics commands
*FLOAT 64
MODE 8
OFF
COLOUR 1, 64, 64, 64
COLOUR 2, 255, 255, 255
gap% = 2*32
radius% = 2*32
maxX% = (2*@vdu%!208 DIV gap%) + 1
maxY% = (2*@vdu%!212 DIV gap%) + 1
TIME = 0
*REFRESH OFF
REPEAT
CLS
REM Draw the circles first:
GCOL 1
FOR Y% = 0 TO maxY%
cy% = gap%*Y%
FOR X% = 0 TO maxX%
cx% = gap%*X%
CIRCLE cx%, cy%, radius%
NEXT X%
NEXT Y%
REM Now draw the moving points:
GCOL 2
T% = TIME * 2
I% = 0
FOR Y% = 0 TO maxY%
cy% = gap%*Y%
FOR X% = 0 TO maxX%
cx% = gap%*X%
px% = cx% + radius%*COSRAD(T% + I%)
py% = cy% + radius%*SINRAD(T% + I%)
CIRCLE FILL px%, py%, 8
I% += 15
NEXT X%
NEXT Y%
*REFRESH
UNTIL FALSE
EDIT: Which inevitably leads to something like this:
Code:
REM>CIRCWAVES2
*FLOAT 64
MODE 8
OFF
FOR I% = 1 TO 15
COLOUR I%, I%*255/16, I%*255/8, I%*255/4
NEXT I%
gap% = 2*16
radius% = 2*16
maxX% = (2*@vdu%!208 DIV gap%) + 1
maxY% = (2*@vdu%!212 DIV gap%) + 1
arraySz% = maxX% * maxY%
DIM grid%( arraySz%-1, 2 )
TIME = 0
*REFRESH OFF
REPEAT
CLS
I% = 0
T% = TIME
FOR Y% = 0 TO maxY%-1
cy% = gap%*Y%
FOR X% = 0 TO maxX%-1
cx% = gap%*X%
A% = T% + 8*I%
grid%(I%,0) = cx% + radius%*COSRADA%
grid%(I%,1) = cy% + radius%*SINRADA%
grid%(I%,2) = I% MOD 15
I% += 1
NEXT X%
NEXT Y%
FOR Y% = 0 TO maxY%-2
FOR X% = 0 TO maxX%-2
I% = Y%*maxX% + X%
GCOL grid%(I%,2)
MOVE grid%(I%,0), grid%(I%,1)
MOVE grid%(I%+1,0), grid%(I%+1,1)
PLOT 85, grid%(I%+maxX%,0), grid%(I%+maxX%,1)
PLOT 85, grid%(I%+maxX%+1,0), grid%(I%+maxX%+1,1)
NEXT X%
NEXT Y%
*REFRESH
UNTIL FALSE
|
|
|
|
|
