Code: Select all
REM "Disco II"
REM Version 1.0 (04-Mar-2019)
REM Works with BB4W & Android edition of BBCSDL (may work with others)
HIMEM = PAGE + 10*&100000
ON ERROR PROCError( REPORT$ + " at line " + STR$ERL )
BB4W% = (INKEY(-256) == &57)
MODE 8 : OFF
IF POS
IF BB4W% THEN GetTicks$="GetTickCount" ELSE GetTicks$="SDL_GetTicks"
ScrW% = @vdu%!208
ScrH% = @vdu%!212
MaxColours% = 16
MaxBrightnessLevels% = 32
DIM Square{ sz%, nX%, nY%, nColours%, nBrightnessLevels%, \
\ bevelSz%, bevelCol{b%,t%,l%,r%}, \
\ bm%(MaxColours%-1,MaxBrightnessLevels%-1), maskBm% }
DIM Colours%(MaxColours%-1)
Square.sz% = 64
Square.nX% = ScrW% / Square.sz%
Square.nY% = ScrH% / Square.sz%
Square.nColours% = 8
Square.nBrightnessLevels% = 16
Square.bevelSz% = 0.45 * (Square.sz%/2)
Square.bevelCol.b% = 164
Square.bevelCol.t% = 255
Square.bevelCol.l% = 128
Square.bevelCol.r% = 200
Colours%() = &FFFFFF, &FF0000, &FF8000, &FFFF00, \
\ &00FF00, &0000FF, &FF00FF, &00FFFF
DIM grid{ w%, h% }
grid.w% = Square.nX%/2
grid.h% = Square.nY%/2
DIM grid{(grid.w%*grid.h%-1) colIndex1&, colIndex2&, selIndex&, level, levelDec, chgTime% }
*REFRESH OFF
PROCCreateMaskImage
file$ = @tmp$ + "disco2_mask.bmp"
OSCLI "SCREENSAVE """ + file$ + """ " +STR$0+","+STR$0+","+STR$(2*Square.sz%)+","+STR$(2*Square.sz%)
CLS : *REFRESH ON
F% = OPENIN(file$) : S% = EXT#F% : CLOSE#F%
IF F% = 0 THEN ERROR 0, "Can't load " + file$
DIM Square.maskBm% S%
OSCLI "LOAD """ + file$ + """ " + STR$~Square.maskBm%
REM Pray that the mask bitmap is 24-bpp
PROCCreateBitmaps
FOR Y% = 0 TO grid.h%-1
FOR X% = 0 TO grid.w%-1
I% = grid.w%*Y% + X%
grid{(I%)}.selIndex& = 0
grid{(I%)}.level = Square.nBrightnessLevels%-1
PROCNewParams(I%, 0)
NEXT X%
NEXT Y%
*REFRESH OFF
SYS GetTicks$ TO time0% : time0% -= 16
REPEAT
SYS GetTicks$ TO time1%
dt = (time1% - time0%) / 1000
time0% = time1%
FOR Y% = 0 TO grid.h%-1
FOR X% = 0 TO grid.w%-1
I% = grid.w%*Y% + X%
IF grid{(I%)}.selIndex& THEN
C% = grid{(I%)}.colIndex1&
ELSE
C% = grid{(I%)}.colIndex2&
ENDIF
M% = Square.bm%( C%, grid{(I%)}.level )
x% = Square.sz%*X%
y% = Square.sz%*Y%
OSCLI "MDISPLAY "+STR$~M%+" "+STR$(2*x%)+","+STR$(2*y%)
OSCLI "MDISPLAY "+STR$~M%+" "+STR$(2*(ScrW%-x%-Square.sz%))+","+STR$(2*y%)
OSCLI "MDISPLAY "+STR$~M%+" "+STR$(2*x%)+","+STR$(2*(ScrH%-y%-Square.sz%))
OSCLI "MDISPLAY "+STR$~M%+" "+STR$(2*(ScrW%-x%-Square.sz%))+","+STR$(2*(ScrH%-y%-Square.sz%))
grid{(I%)}.level -= dt * 25 * grid{(I%)}.levelDec
IF grid{(I%)}.level < 0 THEN
grid{(I%)}.level = Square.nBrightnessLevels%-1
grid{(I%)}.selIndex& EOR= 1
IF grid{(I%)}.chgTime% < time1% THEN
PROCNewParams(I%, time1%)
ENDIF
ENDIF
NEXT X%
NEXT Y%
*REFRESH
IF BB4W% THEN WAIT 1
UNTIL FALSE
END
:
:
:
:
DEF PROCNewParams(I%, T%)
LOCAL K%
grid{(I%)}.levelDec = 0.5 + 0.5*RND(1)
grid{(I%)}.chgTime% = T% + 5000 + RND(15000)
grid{(I%)}.colIndex1& = RND(Square.nColours%) - 0.999
REPEAT
K% = RND(Square.nColours%)-1
UNTIL K% <> grid{(I%)}.colIndex1&
grid{(I%)}.colIndex2& = K%
ENDPROC
:
:
:
:
DEF PROCCreateMaskImage
LOCAL I%, K%
GCOL 1
COLOUR 1,228,228,228 : RECTANGLE FILL 0, 0, 2*Square.sz%-1, 2*Square.sz%-1
FOR I% = 0 TO Square.bevelSz%-1
REM B, T, L, R
K%=Square.bevelCol.b% : COLOUR 1,K%,K%,K% : LINE 2*I%, 2*I%, 2*(Square.sz%-I%-1), 2*I%
K%=Square.bevelCol.t% : COLOUR 1,K%,K%,K% : LINE 2*I%, 2*(Square.sz%-I%-1), 2*(Square.sz%-I%-1), 2*(Square.sz%-I%-1)
K%=Square.bevelCol.l% : COLOUR 1,K%,K%,K% : LINE 2*I%, 2*I%, 2*I%, 2*(Square.sz%-I%-1)
K%=Square.bevelCol.r% : COLOUR 1,K%,K%,K% : LINE 2*(Square.sz%-I%-1), 2*I%, 2*(Square.sz%-I%-1), 2*(Square.sz%-I%-1)
NEXT I%
REM TR diagonal
K%=(Square.bevelCol.t% + Square.bevelCol.r%)/2 : COLOUR 1,K%,K%,K%
LINE 2*(Square.sz%-Square.bevelSz%), 2*(Square.sz%-Square.bevelSz%), 2*Square.sz%-1, 2*Square.sz%-1
REM BR diagonal
K%=(Square.bevelCol.b% + Square.bevelCol.r%)/2 : COLOUR 1,K%,K%,K%
LINE 2*(Square.sz%-Square.bevelSz%), 2*Square.bevelSz%-1, 2*Square.sz%-1, 0
REM BL diagonal
K%=(Square.bevelCol.b% + Square.bevelCol.l%)/2 : COLOUR 1,K%,K%,K%
LINE 0, 0, 2*Square.bevelSz%-1, 2*Square.bevelSz%-1
REM TL diagonal
K%=(Square.bevelCol.t% + Square.bevelCol.l%)/2 : COLOUR 1,K%,K%,K%
LINE 0, 2*Square.sz%-1, 2*(Square.bevelSz%-1), 2*(Square.sz%-Square.bevelSz%)
ENDPROC
:
:
:
:
DEF PROCCreateBitmaps
LOCAL A%, B%, C%, I%, L%, O%, r&, g&, b&, f, g
FOR C% = 0 TO Square.nColours%-1
r& = Colours%(C%) >> 16
g& = Colours%(C%) >> 8
b& = Colours%(C%)
FOR L% = 0 TO Square.nBrightnessLevels%-1
Square.bm%(C%,L%) = FNCreateBMP24(Square.sz%, Square.sz%)
A% = Square.bm%(C%,L%) + 54
B% = A% + 3*Square.sz%^2
REM Fill square bitmap with flat colour:
FOR I% = A% TO B%-1 STEP 3
?I% = b&
I%?1 = g&
I%?2 = r&
NEXT I%
REM Now scale bitmap's colours using the mask bitmap and global scale factor:
O% = Square.maskBm% + Square.maskBm%!10
g = 0.1 + 0.9*L%/(Square.nBrightnessLevels%-1)
FOR I% = A% TO B%-1 STEP 3
f = ?O% / 255
?I% *= f*g
I%?1 *= f*g
I%?2 *= f*g
O% += 3
NEXT I%
NEXT L%
NEXT C%
ENDPROC
:
:
:
:
DEF FNCreateBMP24(W%, H%)
LOCAL A%, S%
S% = 54 + 3*W%*H%
DIM A% S%+4
A% = ((A% + 3) AND -4) + 2
A%?0 = ASC"B"
A%?1 = ASC"M"
A%!2 = S%
A%!10 = 54
A%!14 = 40
A%!18 = W%
A%!22 = H%
A%?26 = 1
A%?28 = 24
A%!34 = 3*W%*H%
= A%
:
:
:
:
DEF PROCError( s$ )
IF NOT BB4W% THEN
IF ERR=17 CHAIN @lib$+"../examples/tools/touchide"
ENDIF
CLS : ON : VDU 7
PRINT '" "+s$;
REPEAT
WAIT 10
UNTIL FALSE
ENDPROC
