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#
torus2.txt · Last modified: 2024/01/05 00:21 by 127.0.0.1