https://youtu.be/yai1srcKc1A
Code: Select all
REM Semi-Realistic Kaleidoscope
REM Requires BB4W & GfxLib2
REM
REM Note that this program uses a *very* inefficient means of achieving a kaleidoscope effect!
*ESC OFF
MODE 8 : OFF
ScrW% = 640
ScrH% = 512
INSTALL @lib$ + "GFXLIB2.BBC"
PROCInitGFXLIB(g{}, 0)
DIM g2{} = g{}
g2{} = g{}
INSTALL @lib$+"GFXLIB_modules\ClrLG.bbc" : PROCInitModule(0)
INSTALL @lib$+"GFXLIB_modules\DrawFilledCircle.bbc" : PROCInitModule(0)
INSTALL @lib$+"GFXLIB_modules\BPlotRotateScale2.bbc" : PROCInitModule(0)
INSTALL @lib$+"GFXLIB_modules\PlotRotateScale2.bbc" : PROCInitModule(0)
INSTALL @lib$+"GFXLIB_modules\Copy.bbc" : PROCInitModule(0)
INSTALL @lib$+"GFXLIB_modules\BPlotFlip.bbc" : PROCInitModule(0)
INSTALL @lib$+"GFXLIB_modules\PlotFlip.bbc" : PROCInitModule(0)
INSTALL @lib$+"GFXLIB_modules\ReplaceColour.bbc" : PROCInitModule(0)
nDiscs% = 100
DIM disc{( nDiscs%-1 ) move%, x, y, r, x2, y2, dx, dy, rgb}
imgSz% = 512
img% = FNmalloc(4 * imgSz%^2)
maskSz% = 256
maskBm% = FNmalloc(4 * maskSz%^2)
bm1Sz% = 256
bm1% = FNmalloc(4 * bm1Sz%^2)
bm2Sz% = 256
bm2% = FNmalloc(4 * bm2Sz%^2)
REM Create equilateral triangle mask bitmap:
SYS GFXLIB_SaveAndSetDispVars%, g{}, maskBm%, maskSz%, maskSz%
FOR Y% = 0 TO maskSz%-1
w = Y%*TANRAD30
IF w <= maskSz%/2 THEN
SYS GFXLIB_Line%, g{}, 0, Y%, maskSz%/2-w, Y%, &808080
SYS GFXLIB_Line%, g{}, maskSz%/2+w, Y%, maskSz%-1, Y%, &808080
ELSE
SYS GFXLIB_Line%, g{}, 0, Y%, maskSz%-1, Y%, &808080
ENDIF
NEXT Y%
SYS GFXLIB_RestoreDispVars%, g{}
REM Initialise discs:
FOR I% = 0 TO nDiscs%-1
disc{(I%)}.move% = FALSE
disc{(I%)}.x = RND(ScrW%)
disc{(I%)}.y = RND(ScrH%)
disc{(I%)}.r = 8 + RND(20)
CASE RND(12) OF
WHEN 1 : disc{(I%)}.rgb = &FF0000
WHEN 2 : disc{(I%)}.rgb = &00FF00
WHEN 3 : disc{(I%)}.rgb = &0000FF
WHEN 4 : disc{(I%)}.rgb = &FF00FF
WHEN 5 : disc{(I%)}.rgb = &FFFF00
WHEN 6 : disc{(I%)}.rgb = &00FFFF
WHEN 7 : disc{(I%)}.rgb = &FF8000
WHEN 8 : disc{(I%)}.rgb = &0080FF
WHEN 9 : disc{(I%)}.rgb = &00FF80
WHEN 10 : disc{(I%)}.rgb = &80FF00
WHEN 11 : disc{(I%)}.rgb = &8080FF
WHEN 12 : disc{(I%)}.rgb = &FFFFFF
ENDCASE
NEXT I%
TIME = 0
moveDiscsTime% = 500
*REFRESH OFF
REPEAT
T% = TIME
REM Rotational angle of discs bitmap:
angle = 720*SIN(T%/1000 + PI/5*SIN(T%/1050+0.345))*SIN(T%/950 + PI/8*SIN(T%/800-1.25))
REM Draw discs and update their positions:
SYS GFXLIB_SaveAndSetDispVars%, g{}, img%, imgSz%, imgSz%
SYS GFXLIB_Clr%, g{}, 0
FOR I% = 0 TO nDiscs%-1
SYS GFXLIB_DrawFilledCircle%, g{}, disc{(I%)}.x, disc{(I%)}.y, disc{(I%)}.r+3, &010101
SYS GFXLIB_DrawFilledCircle%, g{}, disc{(I%)}.x, disc{(I%)}.y, disc{(I%)}.r, disc{(I%)}.rgb
IF disc{(I%)}.move% THEN
disc{(I%)}.x += disc{(I%)}.dx
disc{(I%)}.y += disc{(I%)}.dy
IF (disc{(I%)}.x - disc{(I%)}.x2)^2 + (disc{(I%)}.y - disc{(I%)}.y2)^2 < 0.5^2 THEN
disc{(I%)}.move% = FALSE
ENDIF
ENDIF
NEXT I%
SYS GFXLIB_RestoreDispVars%, g{}
REM If it's time to move the discs, then set new target positions:
IF TIME > moveDiscsTime% THEN
FOR I% = 0 TO nDiscs%-1
disc{(I%)}.move% = TRUE
disc{(I%)}.x2 = RND(ScrW%)
disc{(I%)}.y2 = RND(ScrH%)
dx = disc{(I%)}.x2 - disc{(I%)}.x
dy = disc{(I%)}.y2 - disc{(I%)}.y
len = SQR( dx^2 + dy^2 )
disc{(I%)}.dx = dx / len
disc{(I%)}.dy = dy / len
NEXT I%
moveDiscsTime% = TIME + 1000 + RND(1000)
ENDIF
REM Draw the rotating disc image bitmap:
SYS GFXLIB_BPlotRotateScale2%, g{}, img%, imgSz%, imgSz%, ScrW%/2, ScrH%/2, &10000*angle, &10000
REM Draw the equilateral triangle mask bitmap:
SYS GFXLIB_Plot%, g{}, maskBm%, maskSz%, maskSz%, (ScrW%-maskSz%)/2, ScrH%/2
REM Copy mask bitmap to a temp buffer (bm1%):
SYS GFXLIB_SaveAndSetDispVars%, g2{}, bm1%, bm1Sz%, bm1Sz%
SYS GFXLIB_Copy%, g{}, g2.bmBuffAddr%, g2.bmBuffW%, g2.bmBuffH%, (ScrW%-maskSz%)/2, ScrH%/2
SYS GFXLIB_RestoreDispVars%, g2{}
REM Replace the grey masking colour with black:
SYS GFXLIB_ReplaceColour%, bm1%, bm1Sz%, bm1Sz%, &808080, &000000
REM Copy a vertically flipped version of bm1 into bm2:
SYS GFXLIB_SaveAndSetDispVars%, g{}, bm2%, bm2Sz%, bm2Sz%
SYS GFXLIB_BPlotFlip%, g{}, bm1%, bm1Sz%, bm1Sz%, 0, 0, 1
SYS GFXLIB_RestoreDispVars%, g{}
REM Clear the window (actually fill it with a colour gradient):
SYS GFXLIB_ClrLG%, g{}, &208020, &202080
REM Draw top thee equilateral triangle bitmaps:
SYS GFXLIB_Plot%, g{}, bm1%, bm1Sz%, bm1Sz%, (ScrW%-maskSz%)/2, ScrH%/2
SYS GFXLIB_PlotRotateScale2%, g{}, bm2%, bm2Sz%, bm2Sz%, ScrW%/2+108, ScrH%/2+65, 60*&10000, &10000
SYS GFXLIB_PlotRotateScale2%, g{}, bm2%, bm2Sz%, bm2Sz%, ScrW%/2-109, ScrH%/2+65,-60*&10000, &10000
REM Draw the bottom three:
SYS GFXLIB_PlotFlip%, g{}, bm1%, bm1Sz%, bm1Sz%, (ScrW%-maskSz%)/2, 5, 2
SYS GFXLIB_PlotRotateScale2%, g{}, bm1%, bm1Sz%, bm1Sz%, ScrW%/2+108, ScrH%/2-60, (180-60)*&10000, &10000
SYS GFXLIB_PlotRotateScale2%, g{}, bm1%, bm1Sz%, bm1Sz%, ScrW%/2-109, ScrH%/2-60, (180+60)*&10000, &10000
REM Draw enclosing hexagon:
FOR R% = 256 TO 258
FOR I% = 0 TO 5
x1 = 319 + R%*COSRAD(60 * I%)
y1 = 258 + R%*SINRAD(60 * I%)
x2 = 319 + R%*COSRAD(60 * (I%+1))
y2 = 258 + R%*SINRAD(60 * (I%+1))
SYS GFXLIB_Line%, g{}, x1, y1, x2, y2, &000001
NEXT I%
NEXT R%
PROCdisplay
UNTIL FALSE
Perhaps a BBCSDL user (other than Richard for once!) could take up the challenge of doing a cross-platform version of this little graphical ditty?
