BBC BASIC Programmers' Reference

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
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

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#```