Disco 2

Discussions related to graphics (2D and 3D), animation and games programming
Post Reply
David Williams
Posts: 68
Joined: Wed 04 Jul 2018, 16:23

Disco 2

Post by David Williams » Mon 04 Mar 2019, 00:23

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

p_m21987
Posts: 117
Joined: Mon 02 Apr 2018, 21:51

Re: Disco 2

Post by p_m21987 » Mon 04 Mar 2019, 14:57

Can we expect a Disco 3 at some point in the future?

David Williams
Posts: 68
Joined: Wed 04 Jul 2018, 16:23

Re: Disco 2

Post by David Williams » Mon 04 Mar 2019, 16:22

p_m21987 wrote:
Mon 04 Mar 2019, 14:57
Can we expect a Disco 3 at some point in the future?
I don't think this forum needs any more of my failed experiments. :D

Post Reply