User Tools

Site Tools


torus2
      ON ERROR OSCLI "refresh on" : IF ERR=17 CHAIN @lib$+"../examples/tools/touchide" ELSE MODE 3 : PRINT REPORT$ : END
 
      REM  Torus 2
      REM  Version 1.2 // 16-Mar-2012
      REM  Original BB4W/GFXLIB program by David Williams
      REM  BBCSDL/GFX2DLIB adaptation by Richard Russell.
 
      REM  Prevent the program window from being resized by the user
      IF @platform% >= &2050000 SYS "SDL_SetWindowResizable", @hwnd%, FALSE
 
      REM  Select a 640x512 display mode and switch off the flashing cursor
      MODE 8
      OFF
 
      REM  Initialise 2D graphics
      PROC_init2D
 
      REM  Install and initialise SORTLIB (which will be used to depth-sort the
      REM  'vector balls' according to their Z coordinate)
      INSTALL @lib$ + "sortlib"
      sort%% = FN_sortinit(1, 0)
 
      REM  Load-in the ball sprite (20x20 pixels)
      ballSprite = FN_loadBMP( @dir$ + "ball3_20x20.bmp", 0 )
 
      REM  Define torus vars
      ballsPerRing% = 12
      ringRadius% = 20
      ringDist% = 56
      numRings% = 32
      numBalls% = numRings% *  ballsPerRing%
 
      REM  Array to hold the balls' positions in '3D space'
      DIM p(2, numBalls% - 1)
 
      REM  Array to hold the balls' positions *after* they've been rotated
      DIM q(2, numBalls% - 1)
 
      REM  Arrays to hold each ball's ``normal vector``
      DIM n(2, numBalls% - 1)
 
      REM  Arrays to hold each ball's rotated normal vector
      DIM o(2, numBalls% - 1)
 
      REM  Rotation matrices
      DIM a(2,2), b(2,2), c(2,2), r(2,2)
 
      REM  Define our 'light source' direction vector
      DIM light(2)
      light() = 20, 5, -10
      light() /= MOD(light())
 
      REM  Set up a horizontally-scrolling starfield (four pixels per star)
      numStars% = 100
      DIM sx( numStars%-1 ), sy( numStars%-1 ), dx( numStars%-1 )
      DIM pt{( numStars%*4-1 ) x%, y%}
 
      FOR I% = 0 TO numStars%-1
        sx( I% ) = 640.0 * RND(1)
        sy( I% ) = 48 + (512.0 - 2*48) * RND(1)
        dx( I% ) = 0.5 + 3.5*I%/numStars% - 0.5*RND(1)
      NEXT I%
 
      REM  Define our 3D torus object
      N% = 0
 
      FOR T% = 0 TO numRings%-1
 
        FOR A% = 0 TO ballsPerRing%-1
 
          x = ringDist% + ringRadius% * SIN( A% * 2*PI/ballsPerRing% )
          y = ringRadius% * COS( A% * 2*PI/ballsPerRing% )
          z = 0.0
 
          nx = 1.0 * SIN( A% * 2*PI/ballsPerRing% )
          ny = 1.0 * COS( A% * 2*PI/ballsPerRing% )
          nz = 0.0
 
          PROCrotate( x, y, z,    0, T%*(2*PI/numRings%), 0, x`, y`, z` )
 
          PROCrotate( nx, ny, nz, 0, T%*(2*PI/numRings%), 0, nx`, ny`, nz` )
 
          p( 0, N% ) = x`
          p( 1, N% ) = y`
          p( 2, N% ) = z`
 
          n( 0, N% ) = nx`
          n( 1, N% ) = ny`
          n( 2, N% ) = nz`
 
          N% += 1
 
        NEXT A%
 
      NEXT T%
 
      a = 2.0 * PI*RND(1) : REM  \
      b = 2.0 * PI*RND(1) : REM   >---  rotation angles
      c = 2.0 * PI*RND(1) : REM  /
 
      REM  Disable automatic program window refresh
      *REFRESH OFF
 
      REPEAT
 
        REM  Clear the viewport
        PROC_clr2D(0, 0, 0)
 
        REM  Update star positions
        FOR I% = 0 TO numStars%-1
          IF sx(I%) > 640 sx(I%) -= 640
          pt{( I%*4 )}.x% = sx(I%) + 0.5
          pt{( I%*4 )}.y% = sy(I%) + 0.5
          pt{(I%*4+1)}.x% = sx(I%) + 1.5
          pt{(I%*4+1)}.y% = sy(I%) + 0.5
          pt{(I%*4+2)}.x% = sx(I%) + 0.5
          pt{(I%*4+2)}.y% = sy(I%) + 1.5
          pt{(I%*4+3)}.x% = sx(I%) + 1.5
          pt{(I%*4+3)}.y% = sy(I%) + 1.5
        NEXT
        sx() += dx()
 
        REM  Draw stars (four pixels per star)
        PROC_pixels2D(pt{(numStars%*0)}, numStars%, &40, &40, &40, &FF)
        PROC_pixels2D(pt{(numStars%*1)}, numStars%, &80, &80, &80, &FF)
        PROC_pixels2D(pt{(numStars%*2)}, numStars%, &C0, &C0, &C0, &FF)
        PROC_pixels2D(pt{(numStars%*3)}, numStars%, &FF, &FF, &FF, &FF)
 
        REM  Draw upper and lower blue borders
        FOR Y% = 0 TO 47
          C% = 255*(1 - Y%/47)
          PROC_rect2D(0, Y%, 640, 1, 0, 0, C%, &FF)
          PROC_rect2D(0, 511-Y%, 640, 1, 0, 0, C%, &FF)
        NEXT
 
        REM  Create the rotation matrix
        a() = 1, 0, 0, 0, COS(a), -SIN(a), 0, SIN(a), COS(a)
        b() = COS(b), 0, SIN(b), 0, 1, 0, -SIN(b), 0, COS(b)
        c() = COS(c), -SIN(c), 0, SIN(c), COS(c), 0, 0, 0, 1
        r() = b() . a()
        r() = c() . r()
 
        REM  Rotate the 3D positions of the balls
        REM  (and also rotate the normal vectors)
        q() = r() . p()
        o() = r() . n()
 
        REM  Sort the rotated ball positions according to their Z-coordinate
        C% = numBalls%
        CALL sort%%, q(2,0), q(1,0), q(0,0), o(2,0), o(1,0), o(0,0)
 
        REM  ===========================
        REM  Draw the depth-sorted balls
        REM  ===========================
 
        FOR I%=0 TO numBalls%-1
 
          REM  Calc. perspective factor
          z = 280 / (200 + q(2,I%))
 
          REM  Calc. 2D viewport coordinates
          X% = 304 + q(0,I%)*z
          Y% = 240 + q(1,I%)*z
 
          REM  Calc. angle between the ball's normal vector,
          REM  and light source vector
          l_dot_n = light(0)*o(0,I%) + light(1)*o(1,I%) + light(2)*o(2,I%)
          IF l_dot_n < 0 l_dot_n = 0
          l_dot_n = 0.5 + l_dot_n / 2
 
          REM  Plot the ball sprite ('tinting' it white in real-time!)
          PROC_plot2D(ballSprite, 20, 20, X%, Y%, &FF*l_dot_n, &FF*l_dot_n, &FF*l_dot_n, &FF, FALSE, FALSE, FALSE)
 
        NEXT
 
        REM  Increment and check the rotation angles
        a += 0.0292710182113
        b += 0.0263168891711
        c += 0.0221941538383
 
        IF a > 2*PI THEN a -= 2*PI
        IF b > 2*PI THEN b -= 2*PI
        IF c > 2*PI THEN c -= 2*PI
 
        REM  Update the screen (program window)
        *REFRESH
 
      UNTIL FALSE
 
      DEF PROCrotate( x, y, z, a, b, c, RETURN x3, RETURN y3, RETURN z3 )
      LOCAL x1, y1, z1, x2, y2, z2
      LOCAL ca, cb, cc, sa, sb, sc
 
      ca = COSa
      cb = COSb
      cc = COSc
      sa = SINa
      sb = SINb
      sc = SINc
 
      REM X rotation
      y1 = y*ca - z*sa
      z1 = y*sa + z*ca
      x1 = x
 
      REM Y rotation
      z2 = z1*cb - x1*sb
      x2 = z1*sb + x1*cb
      y2 = y1
 
      REM Z rotation
      x3 = x2*cc - y2*sc
      y3 = x2*sc + y2*cc
      z3 = z2
      ENDPROC
 
      REM High(ish)-performance 2D graphics library
 
      DEF PROC_init2D
      PIXELFORMAT = &16362004
      `SDL_SetRenderDrawColor`  = FN_gpa("SDL_SetRenderDrawColor")
      `SDL_SetTextureAlphaMod`  = FN_gpa("SDL_SetTextureAlphaMod")
      `SDL_SetTextureColorMod`  = FN_gpa("SDL_SetTextureColorMod")
      `SDL_SetTextureBlendMode` = FN_gpa("SDL_SetTextureBlendMode")
      `SDL_RenderDrawPoints`    = FN_gpa("SDL_RenderDrawPoints")
      `SDL_RenderFillRect`      = FN_gpa("SDL_RenderFillRect")
      `SDL_RenderClear`         = FN_gpa("SDL_RenderClear")
      `SDL_RenderCopy`          = FN_gpa("SDL_RenderCopy")
      `SDL_RenderCopyEx`        = FN_gpa("SDL_RenderCopyEx")
      ENDPROC
 
      DEF FN_loadBMP(path$, K%)
      LOCAL R%, s%%, t%%
      SYS "SDL_RWFromFile", path$, "rb" TO R%
      IF R%=0 ERROR 103, "Unable to load " + path$
      SYS "SDL_LoadBMP_RW", R%, 1 TO s%%
      IF s%%=0 ERROR 104, "Unable to create surface from " + path$
      IF K%<>TRUE SYS "SDL_SetColorKey", s%%, 1, K%
      SYS "SDL_ConvertSurfaceFormat", s%%, PIXELFORMAT, 0 TO t%%
      SYS "SDL_FreeSurface", s%% : s%% = t%%
      SYS "SDL_CreateTextureFromSurface", @memhdc%, s%% TO t%%
      IF t%%=0 ERROR 105, "Unable to create texture from " + path$
      SYS "SDL_FreeSurface", s%%
      = t%%
 
      DEF PROC_clr2D(R%,G%,B%)
      SYS `SDL_SetRenderDrawColor`,@memhdc%,R%,G%,B%,&FF
      SYS `SDL_RenderClear`,@memhdc%
      ENDPROC
 
      DEF PROC_plot2D(t%%,W%,H%,X%,Y%,R%,G%,B%,A%,M%,F%,a)
      LOCAL rc{} : DIM rc{x%,y%,w%,h%}
      rc.x% = X% - W%/2
      rc.y% = Y% - H%/2
      rc.w% = W%
      rc.h% = H%
      IF A%<>&FF SYS `SDL_SetTextureColorMod`,t%%,A%
      IF R%<>&FF OR G%<>&FF OR B%<>&FF SYS `SDL_SetTextureColorMod`,t%%,R%,G%,B%
      IF M% SYS `SDL_SetTextureBlendMode`,t%%,M%
      IF a<>0 OR F% THEN
        IF @platform% AND &40 THEN
          SYS `SDL_RenderCopyEx`,@memhdc%,t%%,FALSE,rc{},FN_nz(a),FALSE,F%
        ELSE
          SYS `SDL_RenderCopyEx`,@memhdc%,t%%,FALSE,rc{},FN_dl(a),FN_dh(a),FALSE,F%
        ENDIF
      ELSE
        SYS `SDL_RenderCopy`,@memhdc%,t%%,FALSE,rc{}
      ENDIF
      IF M% SYS `SDL_SetTextureBlendMode`,t%%,FALSE
      IF R%<>&FF OR G%<>&FF OR B%<>&FF SYS `SDL_SetTextureColorMod`,t%%,&FF,&FF,&FF
      IF A%<>&FF SYS `SDL_SetTextureColorMod`,t%%,&FF
      ENDPROC
 
      DEF PROC_rect2D(X%,Y%,W%,H%,R%,G%,B%,A%)
      LOCAL rc{} : DIM rc{x%,y%,w%,h%}
      rc.x% = X%
      rc.y% = Y%
      rc.w% = W%
      rc.h% = H%
      SYS `SDL_SetRenderDrawColor`,@memhdc%,R%,G%,B%,A%
      SYS `SDL_RenderFillRect`,@memhdc%,rc{}
      ENDPROC
 
      DEF PROC_pixels2D(p%%,N%,R%,G%,B%,A%)
      SYS `SDL_SetRenderDrawColor`,@memhdc%,R%,G%,B%,A%
      SYS `SDL_RenderDrawPoints`,@memhdc%,p%%,N%
      ENDPROC
 
      DEF FN_gpa(p$)
      IF @platform% AND &40 THEN
        LOCAL P%, p%%
        DIM p%% LOCAL 8
        P% = p%% + !340 - PAGE
        [OPT 0:equq p$:]
        = ]p%%
      ENDIF
      LOCAL P%
      DIM P% LOCAL 8
      [OPT 0:nop:]
      CASE P%?-1 OF
        WHEN &90: [OPT 0:call p$:] = P% + P%!-4
        WHEN &E1: [OPT 0:equd p$:] = P%!-4
      ENDCASE
      = FALSE
 
      DEF FN_dl(a#)=!^a#
 
      DEF FN_dh(a#)=!(^a#+4)
 
      DEF FN_nz(a#) a#*=1.0:IFa#=0 ?(^a#+7)=&80
      = a#
This website uses cookies. By using the website, you agree with storing cookies on your computer. Also you acknowledge that you have read and understand our Privacy Policy. If you do not agree leave the website.More information about cookies
torus2.txt · Last modified: 2018/05/01 13:13 by richardrussell