BBC BASIC for Windows
« 13964 dots »

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



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: 13964 dots  (Read 1321 times)
David Williams
Developer

member is offline

Avatar

meh


PM

Gender: Male
Posts: 452
xx 13964 dots
« Thread started on: Apr 22nd, 2016, 09:18am »

Code:
      REM 13964 dots

      *FLOAT 64

      MODE 8 : OFF

      DIM rc{l%, t%, r%, b%}
      DIM BITMAPINFOHEADER{Size%, Width%, Height%, Planes{l&,h&}, BitCount{l&,h&}, \
      \                    Compression%, SizeImage%, XPelsPerMeter%, YPelsPerMeter%, \
      \                    ClrUsed%, ClrImportant%}
      DIM bmi{Header{} = BITMAPINFOHEADER{}, Palette%(255)}
      bmi.Header.Size% = DIM(BITMAPINFOHEADER{})
      bmi.Header.Width% = @vdu%!208
      bmi.Header.Height% = @vdu%!212
      bmi.Header.Planes.l& = 1
      bmi.Header.BitCount.l& = 8
      bmi.Palette%(1) = &FF00FF
      bmi.Palette%(2) = &8000FF
      SYS "CreateDIBSection", @memhdc%, bmi{}, 0, ^bits%, 0, 0 TO hbitmap%
      IF hbitmap% = 0 ERROR 100, "Couldn't create DIBSection"
      SYS "SelectObject", @memhdc%, hbitmap% TO oldhbm%
      SYS "DeleteObject", oldhbm%
      CLS

      z = 0
      j = 4
      k = 2

      *REFRESH OFF

      REPEAT
        CLS
        FOR a = 0 TO 2*PI STEP 0.0009
          i = PI*(SIN(a+j)+COS(2*a+k))
          X% = 320 + 220*SIN(a)*SIN(i+z)
          Y% = 256 + 200*COS(a)*COS(i)
          bits%?((511-(Y%-32))*640 + X%+22) = 2
          bits%?(Y%*640 + X%) = 1
        NEXT
        z += 0.075
        j += 0.0325 * 0.5
        k += 0.05   * 0.5
        SYS "InvalidateRect", @hwnd%, rc{}, 0
        *REFRESH
        WAIT 1
      UNTIL FALSE
 
User IP Logged

DDRM
Administrator
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 321
xx Re: 13964 dots
« Reply #1 on: Apr 22nd, 2016, 12:45pm »

Hi David,

Thanks for that amusing, if somewhat bizarre, offering! cheesy

Care to offer us any guidance about what it portrays (or why), and the somewhat cryptic title? I googled it and got a slow cooker (well, I didn't actually buy it), but I'm not sure that's what you had in mind - unless you like watching the pattern until your supper has slow-cooked?

smiley

D
User IP Logged

David Williams
Developer

member is offline

Avatar

meh


PM

Gender: Male
Posts: 452
xx Re: 13964 dots
« Reply #2 on: Apr 22nd, 2016, 1:28pm »

Hello David,

It was inspired by a famous Amiga multi-part demo called 'Desert Dream' (coded primarily by an extraordinary talent named Laxity):

https://www.youtube.com/watch?v=hV2353kXHac

Skip to 5:58 to see the relevant part. Quite how Laxity managed to plot 12000 pixels so quickly on the Amiga probably had his fellow demo coders scratching their heads for years.

I was going to recreate (just for fun) the entire demo in ARM BBC BASIC, but my enthusiasm simply ran out of steam, as it so often does. sad


BTW, I enjoyed your machine code-powered Julia & Mandelbrot sets!


David.
--
User IP Logged

David Williams
Developer

member is offline

Avatar

meh


PM

Gender: Male
Posts: 452
xx Re: 13964 dots
« Reply #3 on: Apr 22nd, 2016, 5:13pm »

FWIW, here's two other effects from early in the 'Desert Dream' demo (these are intended to be easily ported to ARM BBC BASIC). The source code is included for inspection, but not GFXLIB. I'm putting them up here as I won't be completing the project (i.e. a remake in BBC BASIC of the demo).

http://wikisend.com/download/787688/dd.zip


David.
--
User IP Logged

michael
Senior Member
ImageImageImageImage


member is offline

Avatar




PM


Posts: 335
xx Re: 13964 dots
« Reply #4 on: Apr 22nd, 2016, 9:03pm »

That is pretty amazing work. Hypnotic.
User IP Logged

I like making program generators and like reinventing the wheel
David Williams
Developer

member is offline

Avatar

meh


PM

Gender: Male
Posts: 452
xx Re: 13964 dots
« Reply #5 on: Apr 29th, 2016, 3:01pm »

Just a short YouTube video featuring smooth, anti-aliased curves:

https://www.youtube.com/watch?v=oyYyWx0tQjs

Created with BB4W, of course.
User IP Logged

David Williams
Developer

member is offline

Avatar

meh


PM

Gender: Male
Posts: 452
xx Re: 13964 dots
« Reply #6 on: Jan 26th, 2017, 4:57pm »

This version is much more efficient (although the use of the WAIT 1 statement kind of masks the improvement in performance):

Code:
      REM 13964 dots
      REM (More efficient, but also more cryptic!)

      *FLOAT 64

      MODE 8 : OFF

      DIM rc{l%, t%, r%, b%}
      DIM BITMAPINFOHEADER{Size%, Width%, Height%, Planes{l&,h&}, BitCount{l&,h&}, \
      \                    Compression%, SizeImage%, XPelsPerMeter%, YPelsPerMeter%, \
      \                    ClrUsed%, ClrImportant%}
      DIM bmi{Header{} = BITMAPINFOHEADER{}, Palette%(255)}
      bmi.Header.Size% = DIM(BITMAPINFOHEADER{})
      bmi.Header.Width% = @vdu%!208
      bmi.Header.Height% = @vdu%!212
      bmi.Header.Planes.l& = 1
      bmi.Header.BitCount.l& = 8
      bmi.Palette%(1) = &FF00FF
      bmi.Palette%(2) = &8000FF
      SYS "CreateDIBSection", @memhdc%, bmi{}, 0, ^bits%, 0, 0 TO hbitmap%
      IF hbitmap% = 0 ERROR 100, "Couldn't create DIBSection"
      SYS "SelectObject", @memhdc%, hbitmap% TO oldhbm%
      SYS "DeleteObject", oldhbm%
      CLS

      z = 0
      j = 4
      k = 2

      A% = bits% + &54D96
      B% = bits%

      *REFRESH OFF

      REPEAT
        CLS
        FOR a = 0 TO 2*PI STEP 0.0009
          i=PI*(SIN(a+j)+COS(2*a+k))
          X%=&140+&DC*SINa*SIN(i+z)
          Y%=&280*INT(&100+&C8*COSa*COSi)
          A%?(X%-Y%)=&2
          B%?(Y%+X%)=&1
        NEXT
        z += 0.075
        j += 0.0325 * 0.5
        k += 0.05   * 0.5
        SYS "InvalidateRect", @hwnd%, rc{}, 0
        *REFRESH
        WAIT 1
      UNTIL FALSE
 



Consider replacing WAIT 1 with SYS "Sleep", 1


David.
--
User IP Logged

michael
Senior Member
ImageImageImageImage


member is offline

Avatar




PM


Posts: 335
xx Re: 13964 dots
« Reply #7 on: Jan 27th, 2017, 01:47am »

You ever tried making a rotating planet?
User IP Logged

I like making program generators and like reinventing the wheel
DDRM
Administrator
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 321
xx Re: 13964 dots
« Reply #8 on: Jan 27th, 2017, 2:16pm »

Hi Michael,

Well, there's Richard's "world" demo in the graphics examples folder. That uses D3D to map a picture of the earth onto a sphere.

Here's some code I've done which generates a fractal world (have your own new world every time!). Again it uses D3D to render it. Warning: while it doesn't take 6 days, it DOES take a little while, especially if you increase size%.
Code:
      size%=128   :REM You can change this to change the level of detail. Must be a power of 2.
      REM  If you make size% bigger than 256 you'll need to increase HIMEM by more
      HIMEM=LOMEM+1E7

      maxht%=size%/8
      MODE 21 :REM 800 x 600
      xres%=800
      yres%=600
      sf%=xres%/size%
      PRINT"Please wait while the world is created"
      DIM map%(size%+1,size%),m2%(size%,size%)
      PROCmapfill(0,0,size%)
      max%=0
      min%=0
      PROCsizemap

      water%=min%+(max%-min%)/2
      grass%=min%+2*(max%-min%)/3
      snow%=max%-(max%-min%)/10
      vsf%=100/(max%-water%)


      nd%=size%
      d=500

      INSTALL @lib$+"D3DLIB"

      ON CLOSE PROCcleanup:QUIT
      ON ERROR PROCcleanup:PRINT REPORT$:END

      DIM l%(1), b%(0), n%(0), f%(0), s%(0), m%(0), t%(0), y(0), p(0), r(0), X(0), Y(0), Z(0), e(2), a(2)

      DIM l%(0) 103
      l%(0)!0 = 3 : REM directional light
      l%(0)!4 = FN_f4(0.0)  : REM red component
      l%(0)!8 = FN_f4(0.0)  : REM green component
      l%(0)!12 = FN_f4(0.0) : REM blue component
      l%(0)!64 = FN_f4(1) : REM. X component of direction
      l%(0)!68 = FN_f4(0) : REM. Y component of direction
      l%(0)!72 = FN_f4(0) : REM. Z component of direction

      DIM l%(1) 103
      l%(1)!0 = 1 : REM point light
      l%(1)!4 = FN_f4(10)  : REM red component
      l%(1)!8 = FN_f4(10)  : REM green component
      l%(1)!12 = FN_f4(10) : REM blue component
      l%(1)!52 = FN_f4(1000) : REM. X position
      l%(1)!56 = FN_f4(100) : REM. Y position
      l%(1)!60 = FN_f4(2000) : REM. Z position
      l%(1)!76 = FN_f4(1000000) : REM. range of light
      l%(1)!88 = FN_f4(1.0) : REM. attenuation 1

      d% = FN_initd3d(@hwnd%, 2, 1)
      IF d% = 0 ERROR 100, "Can't initialise Direct3D"
      n%(0)=6*(nd%)^2
      f%(0)=&52
      s%(0)=28
      b%(0)=FN_setupVbuf(d%,n%(0),f%(0),s%(0))
      :
      e() = 0, 0, 17000   :REM Eye position
      a() = 0, 0, 0       :REM point to look at (defines sight line)
      REPEAT
        p() = 0
        r() = 0
        y()=TIME/100
        X() = 0
        PROC_render(d%, &FF505050, 2, l%(), 1, m%(), t%(), b%(), n%(), f%(), s%(), y(), p(), r(), X(), Y(), Z(), e(), a(), PI/4, 5/4, 1, 25000)
        e(2)-=10
      UNTIL INKEY(1)=0 OR e(2)<600
      END

      END
      :
      REM Recursively create a fractal map
      DEFPROCmapfill(l%,b%,s%)
      LOCAL h%,s2%,h2%
      h%=s%/2
      IF s%>maxht% THEN s2%=maxht% ELSE s2%=s%
      h2%=s2%/2
      map%(l%+h%,b%+h%)=(map%(l%,b%)+map%(l%+s%,b%)+map%(l%,b%+s%)+map%(l%+s%,b%+s%))/4 + RND(s2%)-h2%
      IF l%=0 THEN map%(l%,b%+h%)=(map%(l%,b%)+map%(l%,b%+s%)+map%(l%+h%,b%+h%))/3 + RND(s2%)-h2%  : map%(size%,b%+h%)=map%(l%,b%+h%)
      IF b%=0 THEN map%(l%+h%,b%)=(map%(l%,b%)+map%(l%+s%,b%)+map%(l%+h%,b%+h%))/3 + RND(s2%)-h2%
      IF l%+s%< size% THEN map%(l%+s%,b%+h%)=(map%(l%+s%,b%)+map%(l%+s%,b%+s%)+map%(l%+h%,b%+h%))/3 + RND(s2%)-h2%
      map%(l%+h%,b%+s%)=(map%(l%,b%+s%)+map%(l%+s%,b%+s%)+map%(l%+h%,b%+h%))/3 + RND(s2%)-h2%
      IF s%>1 THEN
        PROCmapfill(l%,b%,h%)
        PROCmapfill(l%+h%,b%,h%)
        PROCmapfill(l%,b%+h%,h%)
        PROCmapfill(l%+h%,b%+h%,h%)
      ENDIF
      ENDPROC
      :
      REM Find the highest and lowest altitudes on the map
      DEFPROCsizemap
      LOCAL x%,y%
      FOR x%=0 TO size%
        FOR y%=0 TO size%
          IF map%(x%,y%)>max% THEN max%=map%(x%,y%)
          IF map%(x%,y%)<min% THEN min%=map%(x%,y%)
        NEXT y%
      NEXT x%
      ENDPROC
      :
      REM. Richard's code for setting up a vertex buffer in memory
      DEF FN_setupVbuf(D%,N%,V%,L%)
      LOCAL F%,P%,B%,R%,vb%,c%,t

      SYS!(!D%+92),D%,N%*L%,0,V%,0,^B%,0 TO R%:REM CreateVertexBuffer
      IF R% THEN=0
      SYS!(!B%+44),B%,0,N%*L%,^P%,0:REM pVB::Lock

      REM Here is my bit, which actually writes the data for the vertices
      vb%=P%
      DIM coords(nd%+1,nd%+1,3)
      FOR h%=0 TO nd%
        FOR v%=0 TO nd%
          coords(h%,v%,0)=d*SIN(PI*v%/nd%)*COS(2*PI*h%/nd%)
          coords(h%,v%,2)=d*SIN(PI*v%/nd%)*SIN(2*PI*h%/nd%)
          coords(h%,v%,1)=d*COS(PI*v%/nd%)
          coords(h%,v%,3)=RND(&FFFFFF)
        NEXT v%
      NEXT h%
      FOR x%=0 TO nd%-1
        FOR y%=0 TO nd%-1
          PROCdopoint(x%,y%)
          PROCdopoint(x%,y%+1)
          PROCdopoint(x%+1,y%+1)
    
          PROCdopoint(x%,y%)
          PROCdopoint(x%+1,y%+1)
          PROCdopoint(x%+1,y%)
        NEXT y%
      NEXT x%

      SYS!(!B%+48),B%:REM pVB::Unlock
      =B%
      :
      DEFPROCdopoint(x%,y%)
      LOCAL ecol%,eht
      REM Decide which bits are underwater, hills, mountains etc
      eht=map%(x%,y%)+ABS(size%/2-y%)^2/size%
      ecol%=&304010
      water%=min%+(max%-min%)/2
      grass%=min%+2*(max%-min%)/3
      snow%=max%-(max%-min%)/10
      REM Fill vertex buffer with the coordinates, which need to be in SINGLE FLOAT (4 byte) format
      !vb%=FN_f4(coords(x%,y%,0))
      vb%+=4
      !vb%=FN_f4(coords(x%,y%,1))
      vb%+=4
      !vb%=FN_f4(coords(x%,y%,2))
      vb%+=4
      !vb%=FN_f4(coords(x%,y%,0))
      vb%+=4
      !vb%=FN_f4(coords(x%,y%,1))
      vb%+=4
      !vb%=FN_f4(coords(x%,y%,2))
      vb%+=4
      IF eht>snow% THEN !vb%=INT(&F0F0F0) ELSE IF map%(x%,y%)<water% THEN  !vb%=INT(&F0) ELSE IF map%(x%,y%)<grass% THEN  !vb%=INT(&F000) ELSE !vb%=INT(ecol%)
      vb%+=4
      ENDPROC
      :
      DEF PROCcleanup
      t%(0) += 0:IF t%(0) PROC_release(t%(0))
      b%(0) += 0:IF b%(0) PROC_release(b%(0))
      b%(0) += 0:IF b%(0) PROC_release(b%(0))
      d% += 0   :IF d%    PROC_release(d%)
      ENDPROC
 


In the past I've written versions which generate the fractal world, then draw it as a 2D image from 32 different angles, saving each and then displaying them in sequence, to give animated rotation. I can't find it, but I'll try to dig it out...

Best wishes,

D
User IP Logged

David Williams
Developer

member is offline

Avatar

meh


PM

Gender: Male
Posts: 452
xx Re: 13964 dots
« Reply #9 on: Feb 3rd, 2017, 10:03pm »

Now adapted to run under BBC-SDL (x86).

UPDATE (04-Feb-2017): Now even more efficient. Averages 18 fps (with Wait% set to TRUE, otherwise 22 fps) under BBC-SDL on my Celeron-based laptop. I'm tempted to write a few lines of ARM code (for clearing the rendering surface/buffer), so that it might work under Android (ARM).

Code:
      REM 13964 dots (now even more efficient)
      REM 04-Feb-2017
      REM Works with BB4W and BBC-SDL (x86)

      Wait% = TRUE : REM Setting to FALSE may improve frame rate (at cost of v. high CPU usage!)

      M% = 2
      HIMEM = LOMEM + M%*&100000
      HIMEM = (HIMEM + 7) AND -8

      BB4W% = (INKEY(-256) == &57)

      IF BB4W% THEN
        GetTicks$ = "GetTickCount"
        SetWindowText$ = "SetWindowText"
      ELSE
        GetTicks$ = "SDL_GetTicks"
        SetWindowText$ = "SDL_SetWindowTitle"
      ENDIF

      ScrW% = 512
      ScrH% = 512
      VDU 23,22,ScrW%;ScrH%;8,16,16,0 : OFF

      REM Create a 512x512 (32-bpp) 'surface' bitmap:
      DIM bmp{a%,w%,h%}
      bmp.w%=ScrW%
      bmp.h%=ScrH%
      bmp.a%=FNcreateBMP32(bmp.w%,bmp.h%)

      PROCInitGLIB(g{},bmp.w%,bmp.h%)

      cx% = ScrW% / 2
      cy% = ScrH% / 2
      xoffs% = 20
      yoffs% = 16

      g.a%=bmp.a% + 54

      A% = g.a% + 4*(cx% + ScrW%*cy%)
      B% = g.a% + 4*(cx%+xoffs% + ScrW%*(ScrH%-cy%-yoffs%))

      z = 0
      j = 4
      k = 2

      frames% = 0
      frameRate% = 0
      SYS GetTicks$ TO time0%

      REM --------------------------------
      REM Hex constants explained:
      REM   &DC (220)   = radius/amplitude
      REM   &800 (2048) = 4*ScrW%
      REM   &FF (255)   = colour (blue)
      REM   &FF00FF     = colour (magenta)
      REM --------------------------------

      REPEAT
  
        SYS Clr, g{}, 0
  
        FOR a = 0 TO 2*PI STEP 0.0009
          i=PI*(SIN(a+j)+COS(2*a+k))
          X%=&DC*SINa*SIN(i+z)
          Y%=&DC*COSa*COSi
          A%!(&800*Y%+4*X%)=&FF
          B%!(&800*Y%-4*X%)=&FF00FF
        NEXT
  
        z += 0.075
        j += 0.0325 * 0.5
        k += 0.05   * 0.5
  
        OSCLI "MDISPLAY "+STR$~bmp.a%
        IF Wait% THEN WAIT 1
  
        frames% += 1
        SYS GetTicks$ TO time1%
        IF time1%-time0% >= 1000 THEN
          frameRate% = frames%
          frames% = 0
          SYS SetWindowText$, @hwnd%, STR$frameRate% + " fps"
          SYS GetTicks$ TO time0%
        ENDIF
  
      UNTIL FALSE
      END

      DEF FNcreateBMP32( W%, H% )
      LOCAL A%, S%
      S% = 54 + 4*W%*H% + 6
      DIM A% S%-1
      A% = ((A% + 3) AND -4) + 2 : REM The +2 ensures address of first pixel is DWORD-aligned
      A%?0 = ASC"B"
      A%?1 = ASC"M"
      A%!2 = 54 + 4*W%*H%
      A%!6 = 0
      A%!10 = 54
      A%!14 = 40
      A%!18 = W%
      A%!22 = H%
      A%?26 = 1
      A%?28 = 32
      A%!30 = 0
      A%!34 = 4*W%*H%
      A%!38 = 0
      A%!42 = 0
      A%!46 = 0
      A%!50 = 0
      = A%

      DEFPROCInitGLIB(RETURN v{},W%,H%):LOCALS%,Z%:DIMv{a%,w%,h%}
      v.w%=W%
      v.h%=H%
      S%=FNmalloc(128)
      $S%="608B6C24248B4424288B7D008B4D040FAF4D08FCF3AB61C2080000":Clr=FN`m(S%,0)
      ENDPROC
      DEFFN`m(S%,O%)
      LOCALA%,I%:A%=FNmalloc(LEN$S%):FORI%=0TOLEN$S%DIV2-1
        A%?I%=EVAL("&"+MID$($S%,2*I%+1,2)):NEXT
      IFO%>0PROC`d(A%,O%,gClip)
      =A%
      DEFPROC`d(B%,O%,C%):LOCALD%,P%:D%=C%-B%-O%-5:P%=B%+O%+1:!P%=D%:ENDPROC
      DEFFNmalloc(N%):LOCALA%:DIM A% N%+7:A%=(A%+7) AND -8:=A%
      REM ============================================================================
 




« Last Edit: Feb 4th, 2017, 02:51am by David Williams » User IP Logged

David Williams
Developer

member is offline

Avatar

meh


PM

Gender: Male
Posts: 452
xx Re: 13964 dots
« Reply #10 on: Feb 4th, 2017, 09:02am »

Now up and running on BBC-SDL Android (ARM).

The YouTube video linked-to below is rather scrappy, and shows a slightly earlier version of the program in action on a Motorola Moto G4. The program listed below, however, thankfully doesn't display any of the 'garbage' seen in the video!

If running on an ARM-based Android device, then please set Wait% to FALSE, otherwise expect it to run very slowly. The dear old ARM CPU is having to do all those floating point math calculations itself, without the assistance of a dedicated FPU (at least, that's my understanding).

UPDATE: Just did a quick timed test of using *MDISPLAY to render a 640x480 32-bpp RGB8888 BMP image, versus a 640x480 16-bpp RGB565 BMP image. On my Android device (Moto G4), BBC-SDL managed about 22 renderings of the RGB8888 image in 1 second, against around 90 of the RGB565 image. Going by this, *MDISPLAY (or whatever it relies on) renders RGB565 BMPs around 4 times faster than RGB8888. So I think RGB565 is the way to go on mobile devices as far as software-based rendering is concerned.


Video:

https://www.youtube.com/watch?v=NDziaYWbd0w


Code:
      REM "13964 dots" // v1.51 (04-Feb-2017)
      REM Works with BB4W and BBC-SDL (x86 and ARM)

      Wait% = TRUE : REM Setting to FALSE may improve frame rate (at cost of v. high CPU usage!)

      M% = 2
      HIMEM = LOMEM + M%*&100000
      HIMEM = (HIMEM + 7) AND -8

      BB4W% = (INKEY(-256) == &57)

      IF BB4W% THEN
        GetTicks$ = "GetTickCount"
        SetWindowText$ = "SetWindowText"
      ELSE
        GetTicks$ = "SDL_GetTicks"
        SetWindowText$ = "SDL_SetWindowTitle"
      ENDIF

      WinW% = 512
      WinH% = 512
      VDU 23,22,WinW%;WinH%;8,16,16,0 : OFF

      REM Create a 512x512 8-bpp 'surface' bitmap (with 3-colour palette):
      DIM bmp{a%, w%, h%}, pal%(2)
      bmp.w% = WinW%
      bmp.h% = WinH%
      pal%(0) = 0       : REM black
      pal%(1) = &0000FF : REM blue
      pal%(2) = &FF00FF : REM magenta
      PROCcreateBMP8( WinW%, WinH%, 3, pal%(), bmp.a%, pxlDataOffs% )

      REM bmp.a% = address of bitmap (i.e. points to BMP header)

      cx% = WinW% / 2
      cy% = WinH% / 2
      xoffs% = 5
      yoffs% = 6

      bits% = bmp.a% + pxlDataOffs% : REM get start of bitmap pixel data

      clr% = FNassemble

      F% = bits% + (cx% + WinW%*cy%)
      G% = bits% + (cx%+xoffs% + WinW%*(WinH%-cy%-yoffs%))

      z = 0
      j = 4
      k = 2

      frames% = 0
      frameRate% = 0
      SYS GetTicks$ TO time0%

      REM --------------------------------
      REM Hex constants explained:
      REM   &DC (220)  = radius/amplitude
      REM   &200 (512) = WinW%
      REM --------------------------------

      REPEAT
  
        A% = bits% : CALL clr%
  
        FOR a = 0 TO 2*PI STEP 0.0009
          i=PI*(SIN(a+j)+COS(2*a+k))
          X%=&DC*SINa*SIN(i+z)
          Y%=&DC*COSa*COSi
          F%?(&200*Y%+X%)=1
          G%?(&200*Y%-X%)=2
        NEXT
  
        z += 0.075
        j += 0.0325 * 0.5
        k += 0.05   * 0.5
  
        OSCLI "MDISPLAY "+STR$~bmp.a%
  
        IF Wait% THEN WAIT 1
  
        frames% += 1
        SYS GetTicks$ TO time1%
        IF time1%-time0% >= 1000 THEN
          frameRate% = frames%
          frames% = 0
          SYS SetWindowText$, @hwnd%, STR$frameRate% + " fps"
          SYS GetTicks$ TO time0%
        ENDIF
  
      UNTIL FALSE
      END

      DEF PROCcreateBMP8( W%, H%, N%, p%(), RETURN A%, RETURN S% )
      REM W%   = width (in pixels) of bitmap
      REM H%   = height (in pixels) of bitmap
      REM N%   = no. of colours (1 to 256)
      REM p%() = palette/colour table - &00RRGGBB
      REM S%   = (return) total header+palette data size in bytes
      LOCAL I%, T%
      S% = 54 + 4*N%
      T% = S% + W%*H% : REM total BMP size (header + palette + pixel data)
      DIM A% T%+7
      A% = ((A% + 3) AND -4) + 2 : REM The +2 ensures address of first pixel is DWORD-aligned
      A%?0 = ASC"B"
      A%?1 = ASC"M"
      A%!2 = T%
      A%!6 = 0
      A%!10 = 54
      A%!14 = 40
      A%!18 = W%
      A%!22 = H%
      A%?26 = 1
      A%?28 = 8
      A%!30 = 0
      A%!34 = W%*H%
      A%!38 = 0
      A%!42 = 0
      A%!46 = N% : REM no. colours in palette
      A%!50 = 0
      FOR I% = 0 TO N%-1
        A%!(54 + 4*I%) = p%(I%)
      NEXT I%
      ENDPROC

      DEF FNassemble
      LOCAL code%, clr%, lp%, I%, L%, P%, p, cpu$

      REM ------------------------------------------
      REM This nice code segment is the work of RTR:
      p = PI
      CASE !^p OF
        WHEN &2168C235: cpu$ = "x86"
        WHEN &54442D18: cpu$ = "ARM"
        OTHERWISE: QUIT
      ENDCASE
      REM ------------------------------------------

      REM Code to clear a 512x512 8-bpp bitmap buffer

      DIM code% 255, L% -1

      IF cpu$ = "x86" THEN
        P% = code%
        [OPT 0
        ; EAX (A%) = 8-bpp bitmap buffer (pixel data - not header!)
        .clr%
        pushad
        mov edi, eax             ; EDI = bitmap buffer
        mov eax, 0               ; EAX = colour palette indices - writing 4 pixels at a time
        mov ecx, (512*512 DIV 4) ; ECX = total no. of pixels
        cld
        rep stosd
        popad
        ret
        ]
      ENDIF

      IF cpu$ = "ARM" THEN
        FOR I% = 8 TO 10 STEP 2
          P% = code%
          [OPT I%
    
          .clr%
    
          ; r0 (A%) = 8-bpp bitmap buffer (pixel data - not header!)
    
          push {r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11,r12,lr}
    
          mov r1, #0
          mov r2, r1
          mov r3, r1
          mov r4, r1
          mov r5, r1
          mov r6, r1
          mov r7, r1
          mov r8, r1
    
          ; clear a total of 512x512 (=262144) pixels
          ; (clear 256 pixels per loop iteration, a total of 1024 times)
    
          mov r9, #1024
    
          .lp%
          stmia r0!, {r1,r2,r3,r4,r5,r6,r7,r8} ; 32 pixels cleared
          stmia r0!, {r1,r2,r3,r4,r5,r6,r7,r8} ; 64
          stmia r0!, {r1,r2,r3,r4,r5,r6,r7,r8} ; 96
          stmia r0!, {r1,r2,r3,r4,r5,r6,r7,r8} ; 128
          stmia r0!, {r1,r2,r3,r4,r5,r6,r7,r8} ; 160
          stmia r0!, {r1,r2,r3,r4,r5,r6,r7,r8} ; 192
          stmia r0!, {r1,r2,r3,r4,r5,r6,r7,r8} ; 224
          stmia r0!, {r1,r2,r3,r4,r5,r6,r7,r8} ; 256
          subs r9, r9, #1
          bne lp%
    
          pop {r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11,r12,pc}
    
          ]
        NEXT I%
      ENDIF

      = clr%

 
« Last Edit: Feb 4th, 2017, 5:17pm by David Williams » User IP Logged

David Williams
Developer

member is offline

Avatar

meh


PM

Gender: Male
Posts: 452
xx Re: 13964 dots
« Reply #11 on: Feb 4th, 2017, 9:31pm »

This new version -- actually now 10,000 dots -- uses an RGB565 (16-bpp) 'surface' on which to draw and plot things, and which is then displayed using *MDISPLAY. This does speed up rendering a lot (at least on many Android devices), but the main bottleneck is the plotting (in BASIC) of the 10,000 points, and all that heavy duty floating point math.

If someone could try the program listed below on an ARM-based Android device and kindly report the frame rate, and name/model of device Android is running on, then I would appreciate it. I get 10 fps if Wait% is set to TRUE, and 12/13 fps when it's set to FALSE.

Code:
      REM "10000 dots" // v1.01 (04-Feb-2017)
      REM Works with BB4W and BBC-SDL (x86 and ARM)
      REM Uses a RGB565 (16-bpp) rendering surface

      Wait% = TRUE : REM Setting to FALSE may improve frame rate (at cost of v. high CPU usage!)

      M% = 2
      HIMEM = LOMEM + M%*&100000
      HIMEM = (HIMEM + 7) AND -8

      ON ERROR CLS : VDU 7 : PRINT REPORT$; : WAIT 150 : QUIT

      BB4W% = (INKEY(-256) == &57)

      IF BB4W% THEN
        GetTicks$ = "GetTickCount"
        SetWindowText$ = "SetWindowText"
      ELSE
        GetTicks$ = "SDL_GetTicks"
        SetWindowText$ = "SDL_SetWindowTitle"
      ENDIF

      WinW% = 512
      WinH% = 512
      VDU 23,22,WinW%;WinH%;8,16,16,0 : OFF

      S% = 72 + 2*640*480
      DIM bmp% S%+7 : bmp%=(bmp%+7) AND -8
      RESTORE : FOR I% = 0 TO 71 : READ bmp%?I% : NEXT I%
      bits% = bmp% + 72

      clr% = FNassemble

      cx% = WinW% / 2
      cy% = WinH% / 2
      xoffs% = 10
      yoffs% = 12

      F% = bits% + 2*(cx% + WinW%*cy%)
      G% = bits% + 2*(cx%+xoffs% + WinW%*(WinH%-cy%-yoffs%))

      frames% = 0
      frameRate% = 0
      SYS GetTicks$ TO time0%

      REM --------------------------------
      REM Hex constants explained:
      REM   &DC (220)  = radius/amplitude
      REM   &200 (512) = WinW%
      REM --------------------------------

      TIME = 0

      REPEAT
  
        A% = bits% : CALL clr%
  
        T% = TIME
  
        z = T%/333
        j = 4 + T%/212
        k = 2 + T%/280
  
        FOR a = 0 TO 2*PI STEP 0.0012568
          i=PI*(SIN(a+j)+COS(2*a+k))
          X%=&DC*SINa*SIN(i+z)
          Y%=&DC*COSa*COSi
          A%=F%+&400*Y%+2*X%:?A%=&1F:A%?1=&F8
          A%=G%+&400*Y%-2*X%:?A%=&1F:A%?1=&42
        NEXT
  
        OSCLI "MDISPLAY "+STR$~bmp%
  
        PRINT TAB(0,0)STR$frameRate%+" fps"
  
        IF Wait% THEN WAIT 1
  
        frames% += 1
        SYS GetTicks$ TO time1%
        IF time1%-time0% >= 1000 THEN
          frameRate% = frames%
          frames% = 0
          SYS SetWindowText$, @hwnd%, STR$frameRate% + " fps"
          SYS GetTicks$ TO time0%
        ENDIF
  
      UNTIL FALSE
      END


      DEF FNassemble
      LOCAL code%, clr%, lp%, I%, L%, P%, p, cpu$

      REM ------------------------------------------
      REM This nice code segment is the work of RTR:
      p = PI
      CASE !^p OF
        WHEN &2168C235: cpu$ = "x86"
        WHEN &54442D18: cpu$ = "ARM"
        OTHERWISE: QUIT
      ENDCASE
      REM ------------------------------------------

      REM Code to clear a 512x512 16-bpp bitmap buffer

      DIM code% 255, L% -1

      IF cpu$ = "x86" THEN
        P% = code%
        [OPT 0
        ; EAX (A%) = 16-bpp bitmap buffer (pixel data - not header!)
        .clr%
        pushad
        mov edi, eax             ; EDI = bitmap buffer
        mov eax, 0               ; EAX = colour palette indices - writing 8 pixels at a time
        mov ecx, (512*512 DIV 2) ; ECX = total no. of pixels
        cld
        rep stosd
        popad
        ret
        ]
      ENDIF

      IF cpu$ = "ARM" THEN
        FOR I% = 8 TO 10 STEP 2
          P% = code%
          [OPT I%
    
          .clr%
    
          ; r0 (A%) = 16-bpp bitmap buffer (pixel data - not header!)
    
          push {r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11,r12,lr}
    
          mov r1, #0
          mov r2, r1
          mov r3, r1
          mov r4, r1
          mov r5, r1
          mov r6, r1
          mov r7, r1
          mov r8, r1
    
          ; clear a total of 512x512 (=262144) pixels
          ; (clear 128 pixels per loop iteration, a total of 2048 times)
    
          mov r9, #2048
    
          .lp%
          stmia r0!, {r1,r2,r3,r4,r5,r6,r7,r8} ; 16 pixels cleared
          stmia r0!, {r1,r2,r3,r4,r5,r6,r7,r8} ; 32
          stmia r0!, {r1,r2,r3,r4,r5,r6,r7,r8} ; 48
          stmia r0!, {r1,r2,r3,r4,r5,r6,r7,r8} ; 64
          stmia r0!, {r1,r2,r3,r4,r5,r6,r7,r8} ; 80
          stmia r0!, {r1,r2,r3,r4,r5,r6,r7,r8} ; 96
          stmia r0!, {r1,r2,r3,r4,r5,r6,r7,r8} ; 112
          stmia r0!, {r1,r2,r3,r4,r5,r6,r7,r8} ; 128
          subs r9, r9, #1
          bne lp%
    
          pop {r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11,r12,pc}
    
          ]
        NEXT I%
      ENDIF

      = clr%

      DATA 66,77,72,0,8,0,0,0,0,0,70,0,0,0,56,0,0,0,0,2,0,0,0,2,0,0,1,0,16,0,3,0,0,0,2,0,8,0,32,46,0,0,32,46,0,0,0,0,0,0,0,0,0,0,0,248,0,0,224,7,0,0,31,0,0,0,0,0,0,0,0,0

 


« Last Edit: Feb 4th, 2017, 9:36pm 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