BBC BASIC for Windows
« Fast RGB 'lerp' in BASIC »

Welcome Guest. Please Login or Register.
Apr 5th, 2018, 11:08pm



ATTENTION MEMBERS: Conforums will be closing it doors and discontinuing its service on April 15, 2018.
Ad-Free has been deactivated. Outstanding Ad-Free credits will be reimbursed to respective payment methods.

If you require a dump of the post on your message board, please come to the support board and request it.


Thank you Conforums members.

BBC BASIC for Windows Resources
Online BBC BASIC for Windows documentation
BBC BASIC for Windows Beginners' Tutorial
BBC BASIC Home Page
BBC BASIC on Rosetta Code
BBC BASIC discussion group
BBC BASIC for Windows Programmers' Reference

« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: Fast RGB 'lerp' in BASIC  (Read 495 times)
David Williams
Developer

member is offline

Avatar

meh


PM

Gender: Male
Posts: 452
xx Fast RGB 'lerp' in BASIC
« Thread started on: May 23rd, 2016, 9:37pm »

Here's a fast RGB linear interpolation in BASIC (one line):

Code:
      DEFFN_LerpRGB(A%,B%,F%)=(A%AND&FF)+(F%*((B%AND&FF)-(A%AND&FF))>>8)OR&100*(((A%AND&FF00)>>8)+(F%*(((B%AND&FF00)>>8)-((A%AND&FF00)>>8))>>8))OR&10000*((A%>>16)+(F%*(B%-A%>>16)>>8))
 


Where A% is RGB colour 1 (&RRGGBB) and B% is RGB colour 2 (&rrggbb), and F% is the interpolation value in the range 0 to 256. In the case of F% = 0, colour 1 is returned; in the case of F% = 256, colour 2 is returned.

Here's a quick example:

Code:
      MODE 8 : OFF

      WinW% = 2 * @vdu%!208
      WinH% = 2 * @vdu%!212

      col1% = &2040AA
      col2% = &FFA0A0

      GCOL 1

      FOR Y% = 0 TO WinH%-1
        f% = 256 * Y%/(WinH%-1)
        c% = FN_LerpRGB( col1%, col2%, f% )
        COLOUR 1, (c% AND &FF0000)>>16, (c% AND &FF00)>>8, c% AND &FF
        LINE 0, Y%, WinW%, Y%
      NEXT Y%
      END

      DEFFN_LerpRGB(A%,B%,F%)=(A%AND&FF)+(F%*((B%AND&FF)-(A%AND&FF))>>8)OR&100*(((A%AND&FF00)>>8)+(F%*(((B%AND&FF00)>>8)-((A%AND&FF00)>>8))>>8))OR&10000*((A%>>16)+(F%*(B%-A%>>16)>>8))
 


There are several possible useful variations of this function.

Sanity checks on F% (ensuring it's within the range 0 to 256) wouldn't be a bad idea.


David.
--
User IP Logged

David Williams
Developer

member is offline

Avatar

meh


PM

Gender: Male
Posts: 452
xx Re: Fast RGB 'lerp' in BASIC
« Reply #1 on: May 24th, 2016, 1:37pm »

If speed's important, then the following (suboptimal!) assembly language implementation is more than twice as fast as the BASIC equivalent (when called using SYS).

Code:
      MODE 10 : OFF

      WinW% = @vdu%!208
      WinH% = @vdu%!212

      lerp% = FNasm

      FOR I% = 1 TO 100
        W% = 64 + RND(300)
        H% = 64 + RND(200)
        X% = RND(WinW% - W%)
        Y% = RND(WinH% - H%)
  
        col1% = RND(&FFFFFF)
        col2% = RND(&FFFFFF)
  
        GCOL 1
        FOR J% = 0 TO H%-1
          F% = 256 * (J%/H%)
    
          SYS lerp%, col1%, col2%, F% TO rgb%
    
          COLOUR 1, rgb% AND &FF, (rgb% AND &FF00)>>8, (rgb% AND &FF0000)>>16
          LINE 2*X%, 2*(Y%+J%), 2*(X%+W%), 2*(Y%+J%)
        NEXT J%
  
      NEXT I%
      END

      DEF FNasm
      LOCAL C%, I%, P%, J%, K%
      DIM C% 109
      FOR I% = 0 TO 2 STEP 2
        P% = C%
        [OPT I%
  
        ; [ESP+4]  --> &xxB1G1R1
        ; [ESP+8]  --> &xxB2G2B2
        ; [ESP+12] --> f (interpolation factor in range 0 to 256)
  
        mov esi, [esp + 12]         ; ESI = f
  
        ; clamp f to the range 0 to 256
        cmp esi, 0
        jge J%
        mov esi, 0
        .J%
        cmp esi, 256
        jle K%
        mov esi, 256
        .K%
  
        xor eax, eax                ; result will be stored in EAX
  
        ; handle red lerp
        movzx ebx, BYTE [esp+4 +0]  ; R1
        movzx ecx, BYTE [esp+8 +0]  ; R2
        mov edx, ebx                ; copy R1
        sub ecx, ebx                ; R2 - R1
        imul ecx, esi               ; f*(R2-R1)
        sar ecx, 8                  ; f*(R2-R1) >> 8
        add ecx, edx                ; R1 + (f*(R2-R1) >> 8)
        or eax, ecx                 ; EAX = &000000RR
  
        ; handle green lerp
        movzx ebx, BYTE [esp+4 +1]  ; G1
        movzx ecx, BYTE [esp+8 +1]  ; G2
        mov edx, ebx                ; copy G1
        sub ecx, ebx                ; G2 - G1
        imul ecx, esi               ; f*(G2-G1)
        sar ecx, 8                  ; f*(G2-G1) >> 8
        add ecx, edx                ; G1 + (f*(G2-G1) >> 8)
        shl ecx, 8
        or eax, ecx                 ; EAX = &0000GGRR
  
        ; handle blue lerp
        movzx ebx, BYTE [esp+4 +2]  ; B1
        movzx ecx, BYTE [esp+8 +2]  ; B2
        mov edx, ebx                ; copy B1
        sub ecx, ebx                ; B2 - B1
        imul ecx, esi               ; f*(B2-B1)
        sar ecx, 8                  ; f*(B2-B1) >> 8
        add ecx, edx                ; B1 + (f*(B2-B1) >> 8)
        shl ecx, 16
        or eax, ecx                 ; EAX = &00BBGGRR
  
        ret 12
        ]
      NEXT I%
      =C%
 


User IP Logged

David Williams
Developer

member is offline

Avatar

meh


PM

Gender: Male
Posts: 452
xx Re: Fast RGB 'lerp' in BASIC
« Reply #2 on: May 24th, 2016, 3:32pm »

Code:
      MODE 10 : OFF

      WinW% = @vdu%!208
      WinH% = @vdu%!212

      lerp% = FNasm

      rectW% = 480
      rectH% = 480

      DIM p(2*rectW%-1,1), q(2*rectW%-1,1), m(1,1)

      FOR I% = 0 TO 2*rectW%-1 STEP 2
        p(I%, 0) = (I% - rectW%)
        p(I%, 1) = -rectH%
        p(I%+1, 0) = p(I%,0)
        p(I%+1, 1) = rectH%
      NEXT I%

      rgb1% = &FF8040
      rgb2% = &4080FF

      ORIGIN WinW%, WinH%
      GCOL 1

      *REFRESH OFF

      REPEAT
        CLS
        T% = TIME
        sin = SIN(T%/100)
        cos = COS(T%/100)
        m() = cos, -sin, sin, cos
        q() = p().m()
        @vdu%!248 = 2
        FOR I% = 0 TO 2*rectW%-1 STEP 2
          SYS lerp%, rgb1%, rgb2%, 256*I%/(2*rectW%-1) TO rgb3%
          COLOUR 1, rgb3% AND &FF, (rgb3% AND &FF00) >> 8, (rgb3% AND &FF0000) >> 16
          LINE q(I%,0), q(I%,1), q(I%+1,0), q(I%+1,1)
        NEXT
        @vdu%!248 = 1
        *REFRESH
      UNTIL FALSE
      END
      :
      :
      :
      :
      DEF FNasm
      LOCAL C%, I%, P%, J%, K%
      DIM C% 109
      FOR I% = 0 TO 2 STEP 2
        P% = C%
        [OPT I%
  
        ; [ESP+4]  --> &xxB1G1R1
        ; [ESP+8]  --> &xxB2G2B2
        ; [ESP+12] --> f (interpolation factor in range 0 to 256)
  
        mov esi, [esp + 12]         ; ESI = f
  
        ; clamp f to the range 0 to 256
        cmp esi, 0
        jge J%
        mov esi, 0
        .J%
        cmp esi, 256
        jle K%
        mov esi, 256
        .K%
  
        xor eax, eax                ; result will be stored in EAX
  
        ; handle red lerp
        movzx ebx, BYTE [esp+4 +0]  ; R1
        movzx ecx, BYTE [esp+8 +0]  ; R2
        mov edx, ebx                ; copy R1
        sub ecx, ebx                ; R2 - R1
        imul ecx, esi               ; f*(R2-R1)
        sar ecx, 8                  ; f*(R2-R1) >> 8
        add ecx, edx                ; R1 + (f*(R2-R1) >> 8)
        or eax, ecx                 ; EAX = &000000RR
  
        ; handle green lerp
        movzx ebx, BYTE [esp+4 +1]  ; G1
        movzx ecx, BYTE [esp+8 +1]  ; G2
        mov edx, ebx                ; copy G1
        sub ecx, ebx                ; G2 - G1
        imul ecx, esi               ; f*(G2-G1)
        sar ecx, 8                  ; f*(G2-G1) >> 8
        add ecx, edx                ; G1 + (f*(G2-G1) >> 8)
        shl ecx, 8
        or eax, ecx                 ; EAX = &0000GGRR
  
        ; handle blue lerp
        movzx ebx, BYTE [esp+4 +2]  ; B1
        movzx ecx, BYTE [esp+8 +2]  ; B2
        mov edx, ebx                ; copy B1
        sub ecx, ebx                ; B2 - B1
        imul ecx, esi               ; f*(B2-B1)
        sar ecx, 8                  ; f*(B2-B1) >> 8
        add ecx, edx                ; B1 + (f*(B2-B1) >> 8)
        shl ecx, 16
        or eax, ecx                 ; EAX = &00BBGGRR
  
        ret 12
        ]
      NEXT I%
      =C%
 




Essentially he same program but now 100% BASIC:

Code:
      MODE 10 : OFF

      WinW% = @vdu%!208
      WinH% = @vdu%!212

      rectW% = 480
      rectH% = 480

      DIM p(2*rectW%-1,1), q(2*rectW%-1,1), m(1,1)

      FOR I% = 0 TO 2*rectW%-1 STEP 2
        p(I%, 0) = (I% - rectW%)
        p(I%, 1) = -rectH%
        p(I%+1, 0) = p(I%,0)
        p(I%+1, 1) = rectH%
      NEXT I%

      rgb1% = &FF00FF
      rgb2% = &00FF00

      ORIGIN WinW%, WinH%
      GCOL 1

      *REFRESH OFF

      REPEAT
        CLS
        T% = TIME
        sin = SIN(T%/100)
        cos = COS(T%/100)
        m() = cos, -sin, sin, cos
        q() = p().m()
        @vdu%!248 = 2
        FOR I% = 0 TO 2*rectW%-1 STEP 2
          rgb3%=FN_LerpRGB(rgb1%,rgb2%,256*I%/(2*rectW%-1))
          COLOUR 1, rgb3% AND &FF, (rgb3% AND &FF00) >> 8, (rgb3% AND &FF0000) >> 16
          LINE q(I%,0), q(I%,1), q(I%+1,0), q(I%+1,1)
        NEXT
        @vdu%!248 = 1
        *REFRESH
      UNTIL FALSE
      END

      DEFFN_LerpRGB(U%,V%,F%)=(U%AND&FF)+(F%*((V%AND&FF)-(U%AND&FF))>>8)OR&100*(((U%AND&FF00)>>8)+(F%*(((V%AND&FF00)>>8)-((U%AND&FF00)>>8))>>8))OR&10000*((U%>>16)+(F%*(V%-U%>>16)>>8))
 



« Last Edit: May 24th, 2016, 8:46pm by David Williams » User IP Logged

David Williams
Developer

member is offline

Avatar

meh


PM

Gender: Male
Posts: 452
xx Re: Fast RGB 'lerp' in BASIC
« Reply #3 on: May 25th, 2016, 06:43am »

Quadratic RGB interpolation. This is just an experiment. Individual RGB components must be prevented from going negative, hence the 'clamping'. Also, I'm not sure if the result looks any better than using a compound (two-part) linear interpolant.

Code:
      MODE 8 : OFF

      GCOL 1

      REPEAT
        rgb1% = RND(&FFFFFF)
        rgb2% = RND(&FFFFFF)
        rgb3% = RND(&FFFFFF)
  
        r1& = rgb1%
        g1& = rgb1% >> 8
        b1& = rgb1% >> 16
  
        r2& = rgb2%
        g2& = rgb2% >> 8
        b2& = rgb2% >> 16
  
        r3& = rgb3%
        g3& = rgb3% >> 8
        b3& = rgb3% >> 16
  
        PROCgetQuadraticCoeffs( 0.0, r1&, 0.5, g1&, 1.0, b1&, a1, b1, c1 )
        PROCgetQuadraticCoeffs( 0.0, r2&, 0.5, g2&, 1.0, b2&, a2, b2, c2 )
        PROCgetQuadraticCoeffs( 0.0, r3&, 0.5, g3&, 1.0, b3&, a3, b3, c3 )
  
        FOR Y% = 0 TO 511
          f = Y%/511
          r = a1*f*f + b1*f + c1
          g = a2*f*f + b2*f + c2
          b = a3*f*f + b3*f + c3
          IF r < 0 r = 0
          IF r > 255 r = 255
          IF g < 0 g = 0
          IF g > 255 g = 255
          IF b < 0 b = 0
          IF b > 255 b = 255
          COLOUR 1, r, g, b
          LINE 0, 2*Y%, 1280, 2*Y%
        NEXT Y%
  
        WAIT 200
  
      UNTIL FALSE
      END

      DEF PROCgetQuadraticCoeffs( x1, y1, x2, y2, x3, y3, RETURN a, RETURN b, RETURN c )
      PROCsolve2x2( x1^2-x2^2, x1-x2, y1-y2, \
      \ x1^2-x3^2, x1-x3, y1-y3, \
      \ a, b )
      c = y1 - (a*x1^2 + b*x1)
      ENDPROC

      DEF PROCsolve2x2(A, B, C, D, E, F, RETURN x, RETURN y)
      LOCAL d, e
      e = A*E - B*D
      IF ABS( e ) < 0.0000001 THEN ENDPROC
      d = 1 / e
      x = d * (E*C - B*F)
      y = d * (A*F - D*C)
      ENDPROC
 



Another rotating square:

Code:
      MODE 10 : OFF

      WinW% = @vdu%!208
      WinH% = @vdu%!212

      rectW% = 480
      rectH% = 480

      DIM p(2*rectW%-1,1), q(2*rectW%-1,1), m(1,1)

      FOR I% = 0 TO 2*rectW%-1 STEP 2
        p(I%, 0) = (I% - rectW%)
        p(I%, 1) = -rectH%
        p(I%+1, 0) = p(I%,0)
        p(I%+1, 1) = rectH%
      NEXT I%

      newColours% = TRUE
      time0% = TIME

      ORIGIN WinW%, WinH%
      GCOL 1

      *REFRESH OFF

      REPEAT
        CLS
        IF newColours% THEN PROCgetRandomColours : newColours% = FALSE
        T% = TIME
        sin = SIN(T%/100)
        cos = COS(T%/100)
        m() = cos, -sin, sin, cos
        q() = p().m()
        @vdu%!248 = 2
        FOR I% = 0 TO 2*rectW%-1 STEP 2
          f = I%/(2*rectW%-1)
          r = a1*f*f + b1*f + c1
          g = a2*f*f + b2*f + c2
          b = a3*f*f + b3*f + c3
          IF r < 0 r = 0
          IF r > 255 r = 255
          IF g < 0 g = 0
          IF g > 255 g = 255
          IF b < 0 b = 0
          IF b > 255 b = 255
          COLOUR 1, r, g, b
          LINE q(I%,0), q(I%,1), q(I%+1,0), q(I%+1,1)
        NEXT
        @vdu%!248 = 1
        IF T% > time0%+300 THEN
          time0% = T%
          newColours% = TRUE
        ENDIF
        *REFRESH
      UNTIL FALSE
      END

      DEF PROCgetRandomColours
      rgb1% = RND(&FFFFFF)
      rgb2% = RND(&FFFFFF)
      rgb3% = RND(&FFFFFF)
      r1& = rgb1%
      g1& = rgb1% >> 8
      b1& = rgb1% >> 16
      r2& = rgb2%
      g2& = rgb2% >> 8
      b2& = rgb2% >> 16
      r3& = rgb3%
      g3& = rgb3% >> 8
      b3& = rgb3% >> 16
      PROCgetQuadraticCoeffs( 0.0, r1&, 0.5, g1&, 1.0, b1&, a1, b1, c1 )
      PROCgetQuadraticCoeffs( 0.0, r2&, 0.5, g2&, 1.0, b2&, a2, b2, c2 )
      PROCgetQuadraticCoeffs( 0.0, r3&, 0.5, g3&, 1.0, b3&, a3, b3, c3 )
      ENDPROC

      DEF PROCgetQuadraticCoeffs( x1, y1, x2, y2, x3, y3, RETURN a, RETURN b, RETURN c )
      PROCsolve2x2( x1^2-x2^2, x1-x2, y1-y2, \
      \ x1^2-x3^2, x1-x3, y1-y3, \
      \ a, b )
      c = y1 - (a*x1^2 + b*x1)
      ENDPROC

      DEF PROCsolve2x2(A, B, C, D, E, F, RETURN x, RETURN y)
      LOCAL d, e
      e = A*E - B*D
      IF ABS( e ) < 0.0000001 THEN ENDPROC
      d = 1 / e
      x = d * (E*C - B*F)
      y = d * (A*F - D*C)
      ENDPROC
 
« Last Edit: May 25th, 2016, 07:35am by David Williams » User IP Logged

RockOve
New Member
Image


member is offline

Avatar




PM


Posts: 7
xx Re: Fast RGB 'lerp' in BASIC
« Reply #4 on: May 26th, 2016, 12:38am »

"another rotating sqr"
in line 30

Code:
        rem this is wrong:
        rem sin = sin(T%/100)
        rem cos = cos(T%/100)
        rem m() = cos, -sin, sin, cos
        :
        rem here is how you do it:
        ssin = sin(T%/100)
        ccos = cos(T%/100)
        m() = ccos, -ssin, ssin, ccos
 
User IP Logged

KenDown
Full Member
ImageImageImage


member is offline

Avatar




PM


Posts: 181
xx Re: Fast RGB 'lerp' in BASIC
« Reply #5 on: Nov 11th, 2016, 6:50pm »

Referring to the LARP program, I'm a little confused by the results. I tried using these definitions:
col1% = &008800
col2% = &0000FF
which I expected would shade from dark green to light blue. Instead it shades from a sort of orange-brown to bright pink.

Anyone have any idea why?

Also, do you mind if I use this routine in one of my programs?
User IP Logged

David Williams
Developer

member is offline

Avatar

meh


PM

Gender: Male
Posts: 452
xx Re: Fast RGB 'lerp' in BASIC
« Reply #6 on: Nov 11th, 2016, 8:42pm »

Yes, sorry about this. I hadn't tested the 'lerping' function very well, and discovered it was broken a few weeks ago (but didn't think anyone would ever notice!).

Anyway, here's a more compact and possibly faster function which does actually work as intended:

Code:
      DEFFN_LerpRGB(A%,B%,F%)=(?^A%+(F%*(?^B%-?^A%)>>8))OR&100*(?(^A%+1)+(F%*(?(^B%+1)-?(^A%+1))>>8))OR&10000*(?(^A%+2)+(F%*(?(^B%+2)-?(^A%+2))>>8))
 



And here's the test program using your colour values (&008800, &0000FF):

Code:
      MODE 8 : OFF

      WinW% = 2 * @vdu%!208
      WinH% = 2 * @vdu%!212

      col1% = &008800
      col2% = &0000FF

      GCOL 1

      FOR Y% = 0 TO WinH%-1
        f% = 256 * Y%/(WinH%-1)
        c% = FN_LerpRGB( col1%, col2%, f% )
        COLOUR 1, (c% AND &FF0000)>>16, (c% AND &FF00)>>8, c% AND &FF
        LINE 0, Y%, WinW%, Y%
      NEXT Y%
      END

      DEFFN_LerpRGB(A%,B%,F%)=(?^A%+(F%*(?^B%-?^A%)>>8))OR&100*(?(^A%+1)+(F%*(?(^B%+1)-?(^A%+1))>>8))OR&10000*(?(^A%+2)+(F%*(?(^B%+2)-?(^A%+2))>>8))

 



And yes, you're welcome to use any of my code snippets/functions in your own programs.


David.
--
« Last Edit: Nov 11th, 2016, 8:44pm by David Williams » User IP Logged

KenDown
Full Member
ImageImageImage


member is offline

Avatar




PM


Posts: 181
xx Re: Fast RGB 'lerp' in BASIC
« Reply #7 on: Nov 12th, 2016, 03:56am »

Many thanks, both for the revised function and the permission.

I have a program that displays a rolling carousel of notices and announcements for my branch of the U3A and thought it would be nice to have a variegated background instead of just a plain colour. That's when I remembered your program and started to play with it in earnest.
User IP Logged

KenDown
Full Member
ImageImageImage


member is offline

Avatar




PM


Posts: 181
xx Re: Fast RGB 'lerp' in BASIC
« Reply #8 on: Nov 12th, 2016, 04:12am »

By the way, given that the colours are defined in hexadecimal, which means that the maximum for any one component is &FF, is there any conceivable harm in reducing the line to

COLOUR 1,c%>>16,c%>>8,c%AND&FF

instead of

COLOUR 1, (c% AND &FF0000)>>16, (c% AND &FF00)>>8, c% AND &FF

I know why you have done the AND&FF000 but is it necessary? (In fact I suspect that I could even get rid of the final AND&FF)
User IP Logged

David Williams
Developer

member is offline

Avatar

meh


PM

Gender: Male
Posts: 452
xx Re: Fast RGB 'lerp' in BASIC
« Reply #9 on: Nov 12th, 2016, 04:29am »

on Nov 12th, 2016, 04:12am, KenDown wrote:
By the way, given that the colours are defined in hexadecimal, which means that the maximum for any one component is &FF, is there any conceivable harm in reducing the line to

COLOUR 1,c%>>16,c%>>8,c%AND&FF


It certainly seems to work, so the interpreter is probably already performing an 'AND &FF' on each of the RGB values. Well spotted - it's nice to learn something new!


David.
--
« Last Edit: Nov 12th, 2016, 04:29am by David Williams » User IP Logged

Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

| |

This forum powered for FREE by Conforums ©
Terms of Service | Privacy Policy | Conforums Support | Parental Controls