DosBatch 3D Engine.

[einstein1969]

Hi Antonio,

I like your interactive version!

I have found the initial article that had inpired me for porting the behavior . This is the link.

The initial project is not based on porting but generating something similar, but in the end it seems copied

I have seen that you begin using html5 canvas. I don't know but perhaps you can use with HTA
For HTA demo you can try 1kjs. I have ported some js in hta in the past. Should I look for in my backup ...

But back to the dos batch.

For modify the code I need remember the initial work. (but i don't remeber).

Then I resume my work here.

The initial work is on CUBE (a rotating cube). This work use the FILLRECT (javascript is the language
that i used for porting varius graphic application and fillrect is very fast graphics canvas instruction)

The sphere use the PLOT function. The dos batch version is faster than FILLRECT.

This is the code for cube. In this code there are some comments on various operations and the variables
are more easy to understand.

For rotate on Z,X,Y change the ZA,XA,YA angle.

Code: Select all

@echo off & set /a cols=55, lines=50 & goto :Init_system

       ________________
      /|              /|
     /               / |
    /  |            /  |
   /_______________/   |
   |   |           |   |
   |               |   |
   |   |           |   |
   |               |   |
   |   |           |   |
   |    -----------|---|
   |  /            |   /
   |               |  /
   |/              | /
   |_______________|/   


Reference:

http://en.wikipedia.org/wiki/Rotation_(mathematics)
http://www.bit-101.com/tutorials/perspective.html
http://en.wikipedia.org/wiki/3D_projection

:Main

set t0=!time!

(setlocal & rem for /F "delims==" %%v in ('set') do set "%%v="

 set AF=1 %anti flikering. Keep redraw near timer coalescing for windows 7 and up%
 set /a t=100000, rn=0, n=t


 set /a "pf[1].x=-35+5, pf[1].y=35, pf[1].z=35"
 set /a "pf[2].x=35+5, pf[2].y=35, pf[2].z=35"
 
 set /a "pf[3].x=35+5, pf[3].y=-35, pf[3].z=35"
 set /a "pf[4].x=-35+5, pf[4].y=-35, pf[4].z=35"
 
 set /a "pf[5].x=35+5, pf[5].y=35, pf[5].z=-35"
 set /a "pf[6].x=-35+5, pf[6].y=35, pf[6].z=-35"
 
 set /a "pf[7].x=35+5, pf[7].y=-35, pf[7].z=-35"
 set /a "pf[8].x=-35+5, pf[8].y=-35, pf[8].z=-35"

 set /a "pf[9].x=5, pf[y].y=0, pf[8].z=0"


 set /a np=9

rem for generate more point change in if 1=1 ...
if 1==2 (
 set /a np=3
 for /L %%n in (1,1,!np!) do set /a "pf[%%n].x=(%%n-2)*35+5, pf[%%n].y=0, pf[%%n].z=0"
 set /a np+=3
 for /L %%n in (4,1,!np!) do set /a "pf[%%n].x=(%%n-5)*35+5, pf[%%n].y=35, pf[%%n].z=0"
 set /a np+=3
 for /L %%n in (7,1,!np!) do set /a "pf[%%n].x=(%%n-8)*35+5, pf[%%n].y=-35, pf[%%n].z=0"
 set /a np+=3
 for /L %%n in (10,1,!np!) do set /a "pf[%%n].x=(%%n-11)*35+5, pf[%%n].y=0, pf[%%n].z=35"
 set /a np+=3
 for /L %%n in (13,1,!np!) do set /a "pf[%%n].x=(%%n-14)*35+5, pf[%%n].y=35, pf[%%n].z=35"
 set /a np+=3
 for /L %%n in (16,1,!np!) do set /a "pf[%%n].x=(%%n-17)*35+5, pf[%%n].y=-35, pf[%%n].z=35"
 set /a np+=3
 for /L %%n in (19,1,!np!) do set /a "pf[%%n].x=(%%n-20)*35+5, pf[%%n].y=0, pf[%%n].z=-35"
 set /a np+=3
 for /L %%n in (22,1,!np!) do set /a "pf[%%n].x=(%%n-23)*35+5, pf[%%n].y=35, pf[%%n].z=-35"
 set /a np+=3
 for /L %%n in (25,1,!np!) do set /a "pf[%%n].x=(%%n-26)*35+5, pf[%%n].y=-35, pf[%%n].z=-35"
)

 for /L %%N in (100000,1,110000) do (

  for /L %%n in (1,1,!np!) do set /a "p[%%n].x=pf[%%n].x, p[%%n].y=pf[%%n].y, p[%%n].z=pf[%%n].z"

  ::rotazione asse Y, X o Z in radians! 
  set /a yA = 10000*4/100*%%N, ZA = 10000*6/100*%%N, XA = 10000*2/100*%%N


  :: calcolo il seno
  set /a "a0=yA, a=a0 %% 62832, b0s=(a>>31|1)*a"

  if !b0s! gtr 47124 (set /a "a=a-(a>>31|1)*62832, s=%SIN%"
  )  else (if !b0s! gtr 15708 (set /a "a=(a>>31|1)*31416-a, s=%SIN%"
          ) else set /a "s=%SIN%"
  )

  :: calcolo il coseno. Cos(x)=Sin(PI/2-x)
  set /a "a0=yA, a=(15708-a0) %% 62832, b0c=(a>>31|1)*a

  if !b0c! gtr 47124 (set /a "a=a-(a>>31|1)*62832, c=%SIN%"
  )  else (if !b0c! gtr 15708 (set /a "a=(a>>31|1)*31416-a, c=%SIN%"
          ) else set /a "c=%SIN%"
  )

  :: calcolo il seno
  set /a "a0=ZA, a=a0 %% 62832, b0s=(a>>31|1)*a"

  if !b0s! gtr 47124 (set /a "a=a-(a>>31|1)*62832, s1=%SIN%"
  )  else (if !b0s! gtr 15708 (set /a "a=(a>>31|1)*31416-a, s1=%SIN%"
          ) else set /a "s1=%SIN%"
  )

  :: calcolo il coseno. Cos(x)=Sin(PI/2-x)
  set /a "a0=ZA, a=(15708-a0) %% 62832, b0c=(a>>31|1)*a

  if !b0c! gtr 47124 (set /a "a=a-(a>>31|1)*62832, c1=%SIN%"
  )  else (if !b0c! gtr 15708 (set /a "a=(a>>31|1)*31416-a, c1=%SIN%"
          ) else set /a "c1=%SIN%"
  )

  :: calcolo il seno
  set /a "a0=XA, a=a0 %% 62832, b0s=(a>>31|1)*a"

  if !b0s! gtr 47124 (set /a "a=a-(a>>31|1)*62832, s2=%SIN%"
  )  else (if !b0s! gtr 15708 (set /a "a=(a>>31|1)*31416-a, s2=%SIN%"
          ) else set /a "s2=%SIN%"
  )

  :: calcolo il coseno. Cos(x)=Sin(PI/2-x)
  set /a "a0=XA, a=(15708-a0) %% 62832, b0c=(a>>31|1)*a

  if !b0c! gtr 47124 (set /a "a=a-(a>>31|1)*62832, c2=%SIN%"
  )  else (if !b0c! gtr 15708 (set /a "a=(a>>31|1)*31416-a, c2=%SIN%"
          ) else set /a "c2=%SIN%"
  )

  :: rotazione
  for /L %%n in (1,1,!np!) do set /a  "rotx = (p[%%n].x * c - p[%%n].y * s)/10000, roty = (p[%%n].x * s + p[%%n].y * c)/10000, p[%%n].x=rotx, p[%%n].y=roty, rotx = (p[%%n].x * c1 - p[%%n].z * s1)/10000, rotz = (p[%%n].x * s1 + p[%%n].z * c1)/10000, p[%%n].x=rotx, p[%%n].z=rotz, roty = (p[%%n].y * c2 - p[%%n].z * s2)/10000, rotz = (p[%%n].y * s2 + p[%%n].z * c2)/10000, p[%%n].y=roty, p[%%n].z=rotz"

  :: proiezione 3d to 2d
  for /L %%n in (1,1,!np!) do set /a "px[%%n] = (p[%%n].x * 150) / (p[%%n].z + 350) + %cols%/2, pY[%%n] = (p[%%n].y * 150) / (p[%%n].z + 350) + %lines%/2"

  :: Riempio buffer
  for /L %%n in (1,1,!np!) do (
    :: Fillrect macro - call :fillrect_1 px[%%n] py[%%n] px[%%n]+1 py[%%n] 4
    if !px[%%n]! gtr 0 if !py[%%n]! gtr 0 if !px[%%n]! lss !cols! if !py[%%n]! lss !lines! Set /a x1=px[%%n], y1=py[%%n], W=1, H=1, c=4, %FILLRECT%
  )

 rem if not "!OT!"=="!time:~10,1!" (

    rem set | more

    :: call :Flush_BufferScreen
    cls & For /L %%l in (1,1,%lines%) do echo( !_%%l!
    rem ping -n 2 127.0.0.1 >nul

    call :clr_screenBuffer
    set /a rn+=1
    set OT=!time:~10,1!
rem  )

  if %%N gtr !t! (
      for /F "tokens=1-8 delims=:.," %%a in ("%t0: =0%:!time: =0!") do set /a "a=(((1%%e-1%%a)*60)+1%%f-1%%b)*6000+1%%g%%h-1%%c%%d, a+=(a>>31) & 8640000"
      if defined AF (set /a "FPS=rn*100/a, t+=(FPS+100)") else set /a "FPS=(%%N-100000)*100*10/a, t+=(FPS+800)"
      title FPS=!FPS!
      set a=&set FPS=
  )
)
 
endlocal)


goto :eof


:prepare_fillrect_1
  set L[0]=%empty%
  For /L %%l in (1,1,%cols%) do set "L[1]=!L[1]!°"
  For /L %%l in (1,1,%cols%) do set "L[2]=!L[2]!±"
  For /L %%l in (1,1,%cols%) do set "L[3]=!L[3]!²"
  For /L %%l in (1,1,%cols%) do set "L[4]=!L[4]!Û"
goto :eof

:Flush_BufferScreen
  cls
  For /L %%l in (1,1,%lines%) do echo( !_%%l!
goto :eof

:clr_screenBuffer
  For /L %%l in (1,1,%lines%) do set _%%l=%empty%
goto :eof

:init_screenbuffer
  set Empty=
  For /L %%l in (1,1,%cols%) do set "empty=!empty! "
goto :eof


:Init_system

  set /a cc=cols+2, ll=lines+3
  mode %cc%,%ll%
  cls

  setlocal DisableDelayedExpansion

  set "FILLRECT=y2=y1+H-1, X2=x1+W & For /F "tokens=1-4" %%u in ("!x1! !c! !W! !X2!") do"
  set "FILLRECT=%FILLRECT% For /L %%y in (!y1!,1,!y2!) do set _%%y="
  set "FILLRECT=%FILLRECT%!_%%y:~0,%%u!!L[%%v]:~0,%%w!!_%%y:~%%x!"

  set "SIN=(a-a*a/1920*a/312500+a*a/1920*a/15625*a/15625*a/2560000-a*a/1875*a/15360*a/15625*a/15625*a/16000*a/44800000)"

  setlocal EnableDelayedExpansion

  call :init_screenbuffer
  Call :clr_screenbuffer
  Call :prepare_fillrect_1
Goto :Main  

but this cube stuff don't like me and then i moved into sphere.

TO be continued...

einstein1969

[npocmaka_]

Should I use specific CHCP code for the cube?
At the moment I'm seeing only the angles and center of the cube with ├ symbols.

[einstein1969]

try this version (in unicode), the points visulized are 9: 8 angle and 1 center. This don't like me...

Code: Select all

@echo off & set /a cols=55, lines=50 & goto :Init_system


Reference:

http://en.wikipedia.org/wiki/Rotation_(mathematics)
http://www.bit-101.com/tutorials/perspective.html
http://en.wikipedia.org/wiki/3D_projection

:Main

set t0=!time!

(setlocal & rem for /F "delims==" %%v in ('set') do set "%%v="

 set AF=1 %anti flikering. Keep redraw near timer coalescing for windows 7 and up%
 set /a t=100000, rn=0, n=t


 set /a "pf[1].x=-35+5, pf[1].y=35, pf[1].z=35"
 set /a "pf[2].x=35+5, pf[2].y=35, pf[2].z=35"
 
 set /a "pf[3].x=35+5, pf[3].y=-35, pf[3].z=35"
 set /a "pf[4].x=-35+5, pf[4].y=-35, pf[4].z=35"
 
 set /a "pf[5].x=35+5, pf[5].y=35, pf[5].z=-35"
 set /a "pf[6].x=-35+5, pf[6].y=35, pf[6].z=-35"
 
 set /a "pf[7].x=35+5, pf[7].y=-35, pf[7].z=-35"
 set /a "pf[8].x=-35+5, pf[8].y=-35, pf[8].z=-35"

 set /a "pf[9].x=5, pf[y].y=0, pf[8].z=0"


 set /a np=9

rem for generate more point change in if 1=1 ...
if 1==2 (
 set /a np=3
 for /L %%n in (1,1,!np!) do set /a "pf[%%n].x=(%%n-2)*35+5, pf[%%n].y=0, pf[%%n].z=0"
 set /a np+=3
 for /L %%n in (4,1,!np!) do set /a "pf[%%n].x=(%%n-5)*35+5, pf[%%n].y=35, pf[%%n].z=0"
 set /a np+=3
 for /L %%n in (7,1,!np!) do set /a "pf[%%n].x=(%%n-8)*35+5, pf[%%n].y=-35, pf[%%n].z=0"
 set /a np+=3
 for /L %%n in (10,1,!np!) do set /a "pf[%%n].x=(%%n-11)*35+5, pf[%%n].y=0, pf[%%n].z=35"
 set /a np+=3
 for /L %%n in (13,1,!np!) do set /a "pf[%%n].x=(%%n-14)*35+5, pf[%%n].y=35, pf[%%n].z=35"
 set /a np+=3
 for /L %%n in (16,1,!np!) do set /a "pf[%%n].x=(%%n-17)*35+5, pf[%%n].y=-35, pf[%%n].z=35"
 set /a np+=3
 for /L %%n in (19,1,!np!) do set /a "pf[%%n].x=(%%n-20)*35+5, pf[%%n].y=0, pf[%%n].z=-35"
 set /a np+=3
 for /L %%n in (22,1,!np!) do set /a "pf[%%n].x=(%%n-23)*35+5, pf[%%n].y=35, pf[%%n].z=-35"
 set /a np+=3
 for /L %%n in (25,1,!np!) do set /a "pf[%%n].x=(%%n-26)*35+5, pf[%%n].y=-35, pf[%%n].z=-35"
)

 for /L %%N in (100000,1,110000) do (

  for /L %%n in (1,1,!np!) do set /a "p[%%n].x=pf[%%n].x, p[%%n].y=pf[%%n].y, p[%%n].z=pf[%%n].z"

  ::rotazione asse Y, X o Z in radians! 
  set /a yA = 10000*4/100*%%N, ZA = 10000*6/100*%%N, XA = 10000*2/100*%%N


  :: calcolo il seno
  set /a "a0=yA, a=a0 %% 62832, b0s=(a>>31|1)*a"

  if !b0s! gtr 47124 (set /a "a=a-(a>>31|1)*62832, s=%SIN%"
  )  else (if !b0s! gtr 15708 (set /a "a=(a>>31|1)*31416-a, s=%SIN%"
          ) else set /a "s=%SIN%"
  )

  :: calcolo il coseno. Cos(x)=Sin(PI/2-x)
  set /a "a0=yA, a=(15708-a0) %% 62832, b0c=(a>>31|1)*a

  if !b0c! gtr 47124 (set /a "a=a-(a>>31|1)*62832, c=%SIN%"
  )  else (if !b0c! gtr 15708 (set /a "a=(a>>31|1)*31416-a, c=%SIN%"
          ) else set /a "c=%SIN%"
  )

  :: calcolo il seno
  set /a "a0=ZA, a=a0 %% 62832, b0s=(a>>31|1)*a"

  if !b0s! gtr 47124 (set /a "a=a-(a>>31|1)*62832, s1=%SIN%"
  )  else (if !b0s! gtr 15708 (set /a "a=(a>>31|1)*31416-a, s1=%SIN%"
          ) else set /a "s1=%SIN%"
  )

  :: calcolo il coseno. Cos(x)=Sin(PI/2-x)
  set /a "a0=ZA, a=(15708-a0) %% 62832, b0c=(a>>31|1)*a

  if !b0c! gtr 47124 (set /a "a=a-(a>>31|1)*62832, c1=%SIN%"
  )  else (if !b0c! gtr 15708 (set /a "a=(a>>31|1)*31416-a, c1=%SIN%"
          ) else set /a "c1=%SIN%"
  )

  :: calcolo il seno
  set /a "a0=XA, a=a0 %% 62832, b0s=(a>>31|1)*a"

  if !b0s! gtr 47124 (set /a "a=a-(a>>31|1)*62832, s2=%SIN%"
  )  else (if !b0s! gtr 15708 (set /a "a=(a>>31|1)*31416-a, s2=%SIN%"
          ) else set /a "s2=%SIN%"
  )

  :: calcolo il coseno. Cos(x)=Sin(PI/2-x)
  set /a "a0=XA, a=(15708-a0) %% 62832, b0c=(a>>31|1)*a

  if !b0c! gtr 47124 (set /a "a=a-(a>>31|1)*62832, c2=%SIN%"
  )  else (if !b0c! gtr 15708 (set /a "a=(a>>31|1)*31416-a, c2=%SIN%"
          ) else set /a "c2=%SIN%"
  )

  :: rotazione
  for /L %%n in (1,1,!np!) do set /a  "rotx = (p[%%n].x * c - p[%%n].y * s)/10000, roty = (p[%%n].x * s + p[%%n].y * c)/10000, p[%%n].x=rotx, p[%%n].y=roty, rotx = (p[%%n].x * c1 - p[%%n].z * s1)/10000, rotz = (p[%%n].x * s1 + p[%%n].z * c1)/10000, p[%%n].x=rotx, p[%%n].z=rotz, roty = (p[%%n].y * c2 - p[%%n].z * s2)/10000, rotz = (p[%%n].y * s2 + p[%%n].z * c2)/10000, p[%%n].y=roty, p[%%n].z=rotz"

  :: proiezione 3d to 2d
  for /L %%n in (1,1,!np!) do set /a "px[%%n] = (p[%%n].x * 150) / (p[%%n].z + 350) + %cols%/2, pY[%%n] = (p[%%n].y * 150) / (p[%%n].z + 350) + %lines%/2"

  :: Riempio buffer
  for /L %%n in (1,1,!np!) do (
    :: Fillrect macro - call :fillrect_1 px[%%n] py[%%n] px[%%n]+1 py[%%n] 4
    if !px[%%n]! gtr 0 if !py[%%n]! gtr 0 if !px[%%n]! lss !cols! if !py[%%n]! lss !lines! Set /a x1=px[%%n], y1=py[%%n], W=1, H=1, c=4, %FILLRECT%
  )

 rem if not "!OT!"=="!time:~10,1!" (

    rem set | more

    :: call :Flush_BufferScreen
    cls & For /L %%l in (1,1,%lines%) do echo( !_%%l!
    rem ping -n 2 127.0.0.1 >nul

    call :clr_screenBuffer
    set /a rn+=1
    set OT=!time:~10,1!
rem  )

  if %%N gtr !t! (
      for /F "tokens=1-8 delims=:.," %%a in ("%t0: =0%:!time: =0!") do set /a "a=(((1%%e-1%%a)*60)+1%%f-1%%b)*6000+1%%g%%h-1%%c%%d, a+=(a>>31) & 8640000"
      if defined AF (set /a "FPS=rn*100/a, t+=(FPS+100)") else set /a "FPS=(%%N-100000)*100*10/a, t+=(FPS+800)"
      title FPS=!FPS!
      set a=&set FPS=
  )
)
 
endlocal)


goto :eof


:prepare_fillrect_1
  set L[0]=%empty%
  For /L %%l in (1,1,%cols%) do set "L[1]=!L[1]!░"
  For /L %%l in (1,1,%cols%) do set "L[2]=!L[2]!▒"
  For /L %%l in (1,1,%cols%) do set "L[3]=!L[3]!▓"
  For /L %%l in (1,1,%cols%) do set "L[4]=!L[4]!█"
goto :eof

:Flush_BufferScreen
  cls
  For /L %%l in (1,1,%lines%) do echo( !_%%l!
goto :eof

:clr_screenBuffer
  For /L %%l in (1,1,%lines%) do set _%%l=%empty%
goto :eof

:init_screenbuffer
  set Empty=
  For /L %%l in (1,1,%cols%) do set "empty=!empty! "
goto :eof


:Init_system

  set /a cc=cols+2, ll=lines+3
  mode %cc%,%ll%
  cls

  setlocal DisableDelayedExpansion

  set "FILLRECT=y2=y1+H-1, X2=x1+W & For /F "tokens=1-4" %%u in ("!x1! !c! !W! !X2!") do"
  set "FILLRECT=%FILLRECT% For /L %%y in (!y1!,1,!y2!) do set _%%y="
  set "FILLRECT=%FILLRECT%!_%%y:~0,%%u!!L[%%v]:~0,%%w!!_%%y:~%%x!"

  set "SIN=(a-a*a/1920*a/312500+a*a/1920*a/15625*a/15625*a/2560000-a*a/1875*a/15360*a/15625*a/15625*a/16000*a/44800000)"

  setlocal EnableDelayedExpansion

  call :init_screenbuffer
  Call :clr_screenbuffer
  Call :prepare_fillrect_1
Goto :Main

I have changed the subroutine ":prepare_fillrect_1"

You can try codepage 850, 437... I use raster fonts.
The character used is the ALT-219 witch is the BLOCK ("█") in my configuration.

Ref: Terminal font & codepage 437

But i don't know if this resolve your question...

Einstein1969

[Aacini]

After a hard research job I finally achieved my goal! The program below is an interactive version that allows to control the rotation of the 3D Sphere in the three axis via keyboard keys. I modified the original program in three different ways: 1. Reformated the code style in order to made it more readable (so I could understood what I should modify). 2. Added the new code required for the interactive control; this point also required to entirely rewrite the 3D rotation code, because the original version had a series of expanded and factorized equations based on a single rotation angle that can not be used with 3 different angles. 3. Modified the code in order to improve efficiency; these last changes mainly consist in moving code sections from one place to another, or entirely removing they. All my modifications are marked with the "REM APA mod" legend, excepting when a code section was removed from its place.

Code: Select all

@echo off
setlocal EnableDelayedExpansion

REM APA mod
if "%1" neq "" goto %1

title Sphere 3D


    :: By einstein1969. Dedicated to jeb, dbenham, penpen, carlos, aGerman, Aacini, EdDyreen, 
    :: npocmaka_, Sponge Belly, Magialisk, the users and the staff of Dostips forum.

    :: Use raster font 8x8

    :: v 0.0.2 passed from 16.6 FPS to ~20.0 FPS

    :: Variables enigma:

    :: ?   =   Sphere radius
    :: rt   =   Rotation angle
    :: ds   =   Distance Z of sphere
    :: _dx,_dy   =   Offset x,y of projecting coordinates in 2D plane.
    :: a,b   =   Sine, cosine of rotation angle
    :: ax,ay,az   =   Rotation coordinate 3D, now a, b, c
    :: c,d   =   X,Y coordinate of projecting 3D to 2D, now a,b
    :: e   =   Z coordinate, now c

REM Interactive version by Antonio Perez Ayala aka Aacini
cls
echo/
echo Sphere 3D original version by einstein1969
echo Interactive version by Aacini
echo/
echo Sphere 3D rotation is controlled by WASDERQZX keys this way:
echo/
echo  zoom in   up
echo         \   ^|   counterclockwise ^<- E  R -^> clockwise
echo          Q  W
echo   left ^<- A S D -^> right
echo          Z  ^|
echo         / down  X = exit
echo zoom out
echo/
pause


:Init_system

  set /a cols=62, lines=58

  set /a cc=cols+2, ll=lines+2
  mode %cc%,%ll% & cls

(  
  for /F "Tokens=1 delims==" %%v in ('set') do set "%%v="
  set /a cols=%cols%, lines=%lines%
  REM APA mod
  set "ComSpec=%ComSpec%"
)

  set "_SIN=a-a*a/1920*a/312500+a*a/1920*a/15625*a/15625*a/2560000-a*a/1875*a/15360*a/15625*a/15625*a/16000*a/44800000"

  REM APA mod: Convert final sine calculation into a long "function" expression
  REM http://www.dostips.com/forum/viewtopic.php?f=3&t=6744
  REM                                  if !c! gtr 47124   (set /a "a=a-(a>>31|1)*62832") else if !c! gtr 15708  set /a "a=(a>>31|1)*31416-a"
  set "SIN(x)=(a=(x)%%62832, c=(a>>31|1)*a, t=((c-47125)>>31)+1, a-=t*((a>>31|1)*62832)  +  ^^^!t*( (((c-15709)>>31)+1)*(-(a>>31|1)*31416+2*a)  ), %_SIN%)"
  set "_SIN="

  For /L %%l in (1,1,%cols%) do set "_empty=!_empty! "

  REM APA mod
  set "g=.ABCDEFG"

REM APA mod
set /a ?=100, rx=0, ry=0, rz=0, ds=800, _dx=cols/2, _dy=lines/2, _dz=4000, _1=10000


REM APA mod: Start the control and animation processes in parallel
cd . > pipeFile.txt
"%~F0" Input >> pipeFile.txt | "%~F0" Main < pipeFile.txt
del pipeFile.txt
goto :EOF


REM APA mod: Control part: get control keys and send the corresponding command to the animation part
:Input
set /A Drx=0, Dry=0, Drz=0, exit=0, Dr=31416/180
set "letter= ADWSERQZX"
set "com[A]=Dry-=Dr,ry-=1"  &  set "var[A]=Dry"
set "com[D]=Dry+=Dr,ry+=1"  &  set "var[D]=Dry"
set "com[W]=Drz-=Dr,rz+=1"  &  set "var[W]=Drz"
set "com[S]=Drz+=Dr,rz-=1"  &  set "var[S]=Drz"
set "com[E]=Drx-=Dr,rx-=1"  &  set "var[E]=Drx"
set "com[R]=Drx+=Dr,rx+=1"  &  set "var[R]=Drx"
set "com[Q]=ds+=100"        &  set "var[Q]=ds"
set "com[Z]=ds-=100"        &  set "var[Z]=ds"
set "com[X]=exit=1"         &  set "var[X]=exit"

:getKey
   title Sphere 3D:  rx=%ry%, ry=%rz%, rz=%rx%, zoom=%ds:~0,-1%%%
   C:\Windows\System32\choice /C %letter% /N
   set "option=!letter:~%errorlevel%,1!"
   set /A "!com[%option%]!"
   set "var=!var[%option%]!"
   echo %var%=!%var%!
if %option% neq X goto getKey
C:\Windows\System32\ping localhost -n 3 > NUL
exit



:Main

(setlocal

  for /F "Tokens=1 delims==" %%v in ('set _') do set "%%v="
  set "lines="
  set "cols="
  REM APA mod
  set "ComSpec="

  rem giro completo (120)*31416/60 o multipli di 120
for /L %%\ in () do (
   
   REM APA mod: Get control command and execute it
   set /P "command="
   if defined command (
      set /A "!command!"
      set "command="
      if "!exit!" equ "1" exit
   )
   REM APA Instead of: if !ds! lss 1000 (set /a ds+=10) else %_FPS%
   set /a "rx+=Drx, ry+=Dry, rz+=Drz"
   
   setlocal

   REM APA mod: Calculate sine and cosine of rotating angles in three axis
   set /A "sx=%SIN(x):x=rx%"
   set /A "cx=%SIN(x):x=15708-rx%"
   set /A "sy=%SIN(x):x=ry%"
   set /A "cy=%SIN(x):x=15708-ry%"
   set /A "sz=%SIN(x):x=rz%"
   set /A "cz=%SIN(x):x=15708-rz%"

   REM APA mod                  %%a  %%b  %%c  %%d  %%e  %%f
   For /f "tokens=1-6" %%a in ("!sx! !cx! !sy! !cy! !sz! !cz!") do (

      REM APA "sin cos" of 12 angles in %%i %%j for Sphere meridians (x axis)
      for %%h in ("0 9999" "-5000 8661" "-8661 5000" "-9999 0" "-8661 -5000" "-5000 -8661" "0 -9999" "5000 -8661" "8661 -5000" "9999 0" "8661 5000" "5000 8661") do for /f "tokens=1,2" %%i in (%%h) do (

         REM APA "sin cos" of 7 angles in %%u %%v for Sphere parallels (y axis)
         set "i=0"
         for %%t in ("3827 9239" "7071 7071" "9239 3827" "9999 0" "9239 -3827" "7071 -7071" "3827 -9239") do for /f "tokens=1,2" %%u in (%%t) do (

            REM APA Calculate a sphere point
            set /A "a=?*%%j/10000*%%u/10000,  b=?*%%v/10000,  c=?*%%i/10000*%%u/10000"

            REM APA MOD!: Rotation on all axis
            set /A "x=(a*%%b-b*%%a)/10000*%%d/10000 - c*%%c/10000,  t=%%b*%%c/10000, u=%%a*%%c/10000, v=c*%%d/10000"
            set /A "y=a*(%%a*%%f/10000 - t *%%e/10000)/10000  +  b*(%%b*%%f/10000 + u *%%e/10000)/10000  -  v *%%e/10000"
            set /A "z=a*(%%a*%%e/10000 + t *%%f/10000)/10000  +  b*(%%b*%%e/10000 - u *%%f/10000)/10000  +  v *%%f/10000"

            REM APA Projection of 3D to 2D
            set /A "a=ds*x/(z-%_dz%)+%_dx%, b=ds*y/(z-%_dz%)+%_dy%, APA=(i+=1)*((z>>31)+1)"

            if not defined L!b! set "L!b!=%_empty%"

            REM APA mod: _$PLOT_ ... _PLOT$_ code inserted here
            For /F "tokens=1-3" %%x in ("!a! !b! !APA!") do set "c=!L%%y:~%%x!" & set "L%%y=!L%%y:~0,%%x!!g:~%%z,1!!c:~1!"

         )

      )

   )

   cls & For /L %%l in (1,1,%lines%) do echo/ !L%%l!
   endlocal
)

endlocal)

Antonio

[Squashman]

Somehow I am able to get the Zoom in and Zoom out keys to flip flop if I max out the zoom out.

[Aacini]

I completed several small improvements in my previous code, including some points that increase the efficiency. I don't like to complete timing tests, but I am pretty sure that this code run faster than previous one, in despite that the new version calculate and show two additional points in the screen (North and South Poles).

EDIT 2015-10-28: I added a modification that correctly show points in the top of the sphere instead of the bottom when both points coincide, for points located in the northern hemisphere.

Code: Select all

@echo off
setlocal EnableDelayedExpansion

REM APA mod
if "%1" neq "" goto %1

title Sphere 3D


    :: By einstein1969. Dedicated to jeb, dbenham, penpen, carlos, aGerman, Aacini, EdDyreen, 
    :: npocmaka_, Sponge Belly, Magialisk, the users and the staff of Dostips forum.

    :: Use raster font 8x8

    :: v 0.0.2 passed from 16.6 FPS to ~20.0 FPS

    :: Variables enigma:

    :: ?   =   Sphere radius
    :: rt   =   Rotation angle
    :: ds   =   Distance Z of sphere
    :: _dx,_dy   =   Offset x,y of projecting coordinates in 2D plane.
    :: a,b   =   Sine, cosine of rotation angle
    :: ax,ay,az   =   Rotation coordinate 3D, now a, b, c
    :: c,d   =   X,Y coordinate of projecting 3D to 2D, now a,b
    :: e   =   Z coordinate, now c

REM Interactive version by Antonio Perez Ayala aka Aacini

cls
echo/
echo Sphere 3D original version by einstein1969
echo Interactive version by Aacini
echo/
echo Sphere 3D rotation is controlled by WASDERQZ keys this way:
echo/
echo  zoom in   up
echo         \   ^|   counterclockwise ^<- E R -^> clockwise
echo          Q  W
echo   left ^<- A S D -^> right
echo          Z  ^|
echo         / down
echo zoom out
echo/
echo/
echo -^> Press P key to pause/exit
echo/
pause


:Init_system

  set /a cols=62, lines=58

  set /a cc=cols+2, ll=lines+2
  mode %cc%,%ll% & cls

(  
  for /F "Tokens=1 delims==" %%v in ('set') do set "%%v="
  set /a cols=%cols%, lines=%lines%
  REM APA mod
  set "ComSpec=%ComSpec%"
)

  set "_SIN=a-a*a/1920*a/312500+a*a/1920*a/15625*a/15625*a/2560000-a*a/1875*a/15360*a/15625*a/15625*a/16000*a/44800000"

  REM APA mod: Convert final sine calculation into a long "function" expression
  REM http://www.dostips.com/forum/viewtopic.php?f=3&t=6744
  REM                                  if !c! gtr 47124   (set /a "a=a-(a>>31|1)*62832") else if !c! gtr 15708  set /a "a=(a>>31|1)*31416-a"
  set "SIN(x)=(a=(x)%%62832, c=(a>>31|1)*a, t=((c-47125)>>31)+1, a-=t*((a>>31|1)*62832)  +  ^^^!t*( (((c-15709)>>31)+1)*(-(a>>31|1)*31416+2*a)  ), %_SIN%)"
  set "_SIN="

  For /L %%l in (1,1,%cols%) do set "_empty=!_empty! "

  REM APA mod
  set "g=.ABCDEFGNS"

REM APA mod
set /a ?=100, rx=0, ry=0, rz=0, ds=800, _dx=cols/2, _dy=lines/2, _dz=4000, _1=10000


REM APA mod: Start the control and animation processes in parallel
cd . > pipeFile.txt
"%~F0" Input >> pipeFile.txt | "%~F0" Main < pipeFile.txt
del pipeFile.txt
goto :EOF


REM APA mod: Control part: get control keys and send the corresponding command to the animation part
:Input
set /A Drx=0, Dry=0, Drz=0, Dr=31416/180
set "letter= ADWSERQZP"
set "com[A]=Dry-=Dr,ry-=1"  &  set "var[A]=Dry"
set "com[D]=Dry+=Dr,ry+=1"  &  set "var[D]=Dry"
set "com[W]=Drz-=Dr,rz+=1"  &  set "var[W]=Drz"
set "com[S]=Drz+=Dr,rz-=1"  &  set "var[S]=Drz"
set "com[E]=Drx-=Dr,rx-=1"  &  set "var[E]=Drx"
set "com[R]=Drx+=Dr,rx+=1"  &  set "var[R]=Drx"
set "com[Q]=ds+=100"        &  set "var[Q]=ds"
set "com[Z]=ds-=100"        &  set "var[Z]=ds"
set "com[P]=ps=1"           &  set "var[P]=ps"

:getKey
   title Sphere 3D:  rx=%ry%, ry=%rz%, rz=%rx%, zoom=%ds:~0,-1%%%
   C:\Windows\System32\choice /C %letter% /N
   set "option=!letter:~%errorlevel%,1!"
   set /A "!com[%option%]!"
   set "var=!var[%option%]!"
   echo %var%=!%var%!
if %option% neq P goto getKey
C:\Windows\System32\choice /C CSX /N
if %errorlevel% neq 3 (
   if %errorlevel% equ 1 (
      echo Continue
   ) else (
      set /A Drx=Dry=Drz=rx=ry=rz=0
      echo Stop
   )
   goto getKey
)
echo Exit
C:\Windows\System32\ping localhost -n 3 > NUL
exit

:pause
set "ps=0"
set /P "=Press C to Continue, S to Stop movement or X to eXit: " < NUL
:wait
   set /P "command="
   if "%command%" equ "Exit" exit
   if "%command%" equ "Stop" set /A Drx=Dry=Drz=0 & exit /B
if "%command%" neq "Continue" goto wait
exit /B


:Main

(setlocal

  for /F "Tokens=1 delims==" %%v in ('set _') do set "%%v="
  set "lines="
  set "cols="
  REM APA mod
  set "ComSpec="

  rem giro completo (120)*31416/60 o multipli di 120
for /L %%\ in () do (
   
   REM APA mod: Get control command and execute it
   set /P "command="
   if defined command (
      set /A "!command!"
      set "command="
      if "!ps!" equ "1" call :pause
   )
   REM APA Instead of: if !ds! lss 1000 (set /a ds+=10) else %_FPS%
   set /a "rx+=Drx, ry+=Dry, rz+=Drz"
   
   setlocal

   REM APA mod: Calculate sine and cosine of rotating angles in three axis
   set /A "sx=%SIN(x):x=rx%"
   set /A "cx=%SIN(x):x=15708-rx%"
   set /A "sy=%SIN(x):x=ry%"
   set /A "cy=%SIN(x):x=15708-ry%"
   set /A "sz=%SIN(x):x=rz%"
   set /A "cz=%SIN(x):x=15708-rz%"

   REM APA mod                  %%a  %%b  %%c  %%d  %%e  %%f
   For /f "tokens=1-6" %%a in ("!sx! !cx! !sy! !cy! !sz! !cz!") do (

      REM APA mod: Calculate rotation common factors *much* less times (just once!)
      set /A "p=%%a*%%f/10000, q=%%a*%%e/10000, r=%%b*%%f/10000, s=%%b*%%e/10000, t=%%b*%%c/10000, u=%%a*%%c/10000"

      REM APA "sin cos" of 12 angles in %%i %%j for Sphere meridians (x axis)
      for %%h in ("0 9999" "-5000 8661" "-8661 5000" "-9999 0" "-8661 -5000" "-5000 -8661" "0 -9999" "5000 -8661" "8661 -5000" "9999 0" "8661 5000" "5000 8661") do for /f "tokens=1,2" %%i in (%%h) do (

         REM APA "sin cos" of 7 angles in %%u %%v for Sphere parallels (y axis)
         set "i=0"
         for %%t in ("3827 9239" "7071 7071" "9239 3827" "9999 0" "9239 -3827" "7071 -7071" "3827 -9239") do for /f "tokens=1,2" %%u in (%%t) do (

            REM APA Calculate a sphere point
            set /A "a=?*%%j/10000*%%u/10000,  b=?*%%v/10000,  c=?*%%i/10000*%%u/10000"

            REM APA MOD!: Rotation on all axis
            set /A "x=(a*%%b-b*%%a)/10000*%%d/10000 - c*%%c/10000,    v=c*%%d/10000"
            set /A "y=a*(p - t *%%e/10000)/10000  +  b*(r + u *%%e/10000)/10000  -  v *%%e/10000"
            set /A "z=a*(q + t *%%f/10000)/10000  +  b*(s - u *%%f/10000)/10000  +  v *%%f/10000"

            REM APA Projection of 3D to 2D
            set /A "a=ds*x/(z-%_dz%)+%_dx%, b=ds*y/(z-%_dz%)+%_dy%, APA=(i+=1)*((z>>31)+1)"

            if not defined L!b! set "L!b!=%_empty%"

            REM APA mod: _$PLOT_ ... _PLOT$_ code inserted here
            For /F "tokens=1-3" %%x in ("!a! !b! !APA!") do (
               set "c=!L%%y:~%%x!"
               REM APA mod: Give preference to "top" points over "bottom" ones
               if "%%z" neq "0" (
                  set "L%%y=!L%%y:~0,%%x!!g:~%%z,1!!c:~1!"
               ) else if "!c:~0,1!" equ " " (
                  set "L%%y=!L%%y:~0,%%x!.!c:~1!"
               )
            )

         )

      )

      REM APA mod: Draw the North and South Poles
      for %%v in (1 -1) do (

         set /A "b=?*%%v,  x=(-b*%%a)/10000*%%d/10000, y=b*(r+u*%%e/10000)/10000, z=b*(s-u*%%f/10000)/10000"
         set /A "a=ds*x/(z-%_dz%)+%_dx%, b=ds*y/(z-%_dz%)+%_dy%, APA=(i+=1)*((z>>31)+1)"

         if not defined L!b! set "L!b!=%_empty%"

         For /F "tokens=1-3" %%x in ("!a! !b! !APA!") do (
            set "c=!L%%y:~%%x!"
            if "%%z" neq "0" (set "L%%y=!L%%y:~0,%%x!!g:~%%z,1!!c:~1!") else if "!c:~0,1!" equ " " set "L%%y=!L%%y:~0,%%x!.!c:~1!"
         )

      )

   )

   cls & For /L %%l in (1,1,%lines%) do echo/ !L%%l!
   endlocal
)

endlocal)

EDIT 2015-10-28: I added a modification that correctly show points in the top of the sphere instead of the bottom when both points coincide, for points located in the northern hemisphere.

Antonio

[Samir]

I can't wait to play with this when I have time. Great stuff!

[einstein1969]

Hi Antonio,

Very good work!

I like your version because there are some important points:

• This version is fast although is readable.
  
• The new method of using variables like functions is very nice trick and the speed is faster than other methods If the environment is near empty.
  In my old test i haved seen that the "if then else" was faster (this is wrong) but new test show me other correct results.
  
  This code:
  

  Code: Select all

  set /A "sx=%abs(x):x=x%"
  

  
  is 10% faster than
  

  Code: Select all

  if !x! lss 0 (set /A sx=-x) else set /A sx=x
  

  
  (this with near empty environment and with set "Abs(x)=(((x)>>31|1)*(x))")
  
• The asyncronous input method via set /P (with not blocking method, via files) is elegant. Than the method that send
  commands and use this in the other thread keep the code small.

Thank you! I could not have ever made!

----------------------------------------------------------------------------------
I thinks on other optimizations now that the code is more readable and more flexible.

For example add 2D clipping:

Code: Select all

if !a! gtr 0 if !b! gtr 0 if !a! lss %cols% if !b! lss %lines% %PLOT% ...

For example use one SET in the calcolous of rotation using the trick of Newline ^

I have not probed this code!!!

Code: Select all

            set /A "x=(a*%%b-b*%%a)/10000*%%d/10000 - c*%%c/10000,    v=c*%%d/10000, ^
                    y=a*(p - t *%%e/10000)/10000  +  b*(r + u *%%e/10000)/10000  -  v *%%e/10000, ^
                    z=a*(q + t *%%f/10000)/10000  +  b*(s - u *%%f/10000)/10000  +  v *%%f/10000"

Onother my research on this SET /A behavior:

Code: Select all

@echo off

rem setlocal EnableDelayedExpansion

rem Vector like dos batch data structures. Is faster then setting a[%i]=value ?

set "a=1000 1500 2000"

rem how to access the first element:
set /A b=%a:~0,4%*5

echo b:%b%

rem alternative. Faster?

set /A b=a*5

echo b:%b%

How can we use this behavior?

And i think in a version that use more than 80 sphere points! for example settable via input key. Or for example
a dinamic model.

Ps: the best trick in my code is the SETLOCAL/ENDLOCAL method that revert initial values of lines variables

Einstein1969

[Aacini]

@Einstein1969:

• The "SIN(x)" variable can be deleted just below my "REM APA mod & set "ComSpec=" lines (below :Main). This saves more than 270 bytes from the environment.
  
  
• Yes, one long SET command run faster that 3 shorter ones. Perhaps you could keep two versions in the same file: the "clear but slow", and the "fast and ugly" one. I used to keep several versions of a program in the same file via a trick that enable/disable certain REM commands in order to select differents parts of the code. For example:
  
  

  Code: Select all

  %CLEAR%   set /A "a=1"
  %CLEAR%   set /A "b=2"
  %CLEAR%   set /A "c=3"
  
  %FAST%    set /A "a=1, b=2, c=3"
  
  To select Clear version: set "CLEAR=" & set "FAST=REM"
  To select Fast version:  set "CLEAR=REM" & set "FAST="
  

  
  
• You may write this code:
  
  

  Code: Select all

  if !a! gtr 0 if !b! gtr 0 if !a! lss %cols% if !b! lss %lines% %PLOT%
  

  
  ... in this faster (and uglier) way:
  
  

  Code: Select all

  set /A "test= !(a-1>>31)  &  !(b-1>>31)  &  ((cols-(a+1))>>31)+1  &  ((lines-(b+1))>>31)+1"
  if !test! equ 1 %PLOT%
  

  
  
• This is the vector-like element access method you asked for:
  
  

  Code: Select all

  @echo off
  setlocal
  
  :: Accessing array elements
  
  @echo off
  
  rem Vector like dos batch data structure. End it with "0"
  
  set "a=1000,1500,2000,0"
  
  rem Convert the list into an element extraction expression based on "i" value
  rem See: http://www.dostips.com/forum/viewtopic.php?f=3&t=6429
  
  rem The value of i is the element to get, base 1
  rem If delayed expansion is enabled, escape the "!"
  
  set /A "i=1, b=%a:,=*!(i-=1)+%"
  
  echo b: %b%
  

  
  However, I doubt this method run faster than individual array elements access. If it does, perhaps it is because the lesser bytes that the vector requires (one name) instead of the multiple array (one name per) elements. Post the result, please.

Ps: the best trick in my code is the SETLOCAL/ENDLOCAL method that revert initial values of lines variables

Einstein1969

Yes, I already was aware of that!


[OFF TOPIC] I just saw a trick in SO that allows to create an empty file via REM command:

Code: Select all

rem/ > empty.txt

Had been this trick mentioned before? I would like to steal the credit from the original poster!

Antonio

[penpen]

Offtopic:

Had been this trick mentioned before? I would like to steal the credit from the original poster!

Yes, if i remember right, then this trick was used by an "IBM guy" (acually i cannot find his homepage; all i know: It was dark yellow). He also wrote that the fastest method were:

Code: Select all

(if i==b m)>file.ext

(But i assume you could replace some characters.)

penpen

[lmstearn]

Beautiful! Hope this dev continues. Just a niggle: pipeFile.txt won't be deleted on WM_CLOSE: is there a way?.

[einstein1969]

New Release 0.03 with rainbow colors and dinamic model.

Try it and let me know how fast your processor is. I did my best to optimize the code. I hope it's fast enough even on old pcs.

use VT escape sequence avaible in windows 10.

Code: Select all

:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
@echo off & setlocal EnableDelayedExpansion 

    :: Porting By Francesco Poscetti aka einstein1969

    :: Use raster font 8x8, save in utf8

    :: v 0.0.3 	update sin code, use vt100, auto tune number of points, use bullet ·
    ::		code optimization for faster execution, dinamic resolution based on pc performance
    ::		better zbuffer, break near infinite loop by jeb.
    :: v 0.0.2 	passed from 16.6 FPS to ~20.0 FPS

    :: Variables enigma:

    :: _R   =   Sphere radius
    :: rt   =   Rotation angle
    :: ds   =   Distance Z of sphere
    :: _dx,_dy   =   Offset x,y of projecting coordinates in 2D plane.
    :: sx,cx   =   Sine, cosine of rotation angle
    :: a,b,c   =   Rotation coordinate 3D
    :: a,b   =   X,Y coordinate of projecting 3D to 2D
    :: c   =   Z coordinate

    :: Ref:
    :: https://invisible-island.net/xterm/ctlseqs/ctlseqs.html
    :: https://learn.microsoft.com/en-us/windows/console/console-virtual-terminal-sequences

:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  title Sphere 3D
  set /a _cols=120, _lines=90
  rem utf 8
  chcp 65001
  mode %_cols%,%_lines%
  set /a _cols-=2, _lines-=2
  cls
  for /F %%a in ('Echo(prompt $E^| cmd') Do Set _ESC=%%a

:ChoiceLabel
  echo(
  choice /M "Select the maximum speed. Choose a number between 2 and 9 where 2 very fast and 9 slow. Default [5] ?" /D 5 /C 23456789 /T 10 /N
  if %errorlevel% gtr 0 (set /a _dT=%errorlevel%+1) else goto :ChoiceLabel

  :: Hide the cursor
  <nul set /p "=%_ESC%[?25l"
(  
  for /F "Tokens=1 delims==" %%v in ('set') do set "%%v="
  set /a "_cols=%_cols%, _lines=%_lines%"
  set "_ESC=%_ESC%"
  set "_dT=%_dT%"
)

  rem https://www.dostips.com/forum/viewtopic.php?f=3&t=4896
  set "_SIN(x)=(a=((x)%%62832)+(((x)%%62832)>>31&62832), b=(a-15708^a-47124)>>31,a=(-a&b)+(a&~b)+(31416&b)+(-62832&(47123-a>>31)),a-a*a/1875*a/320000+a*a/1875*a/15625*a/16000*a/2560000-a*a/1875*a/15360*a/15625*a/15625*a/16000*a/44800000)"

  set "_loop=FOR /L %%# in (1,1,2) do "
  %_loop%%_loop% set "_loop=!_loop!!_loop!!_loop!"

:: Main

  set /a "_R=160, _dx=_cols/2, _dy=_lines/2, _dz=4000, _ndx=6, ds=0, rt=0, i=1"

  for /L %%L in () do (

	%= Prepare for faster dinamic execution =%

	set /a "_ndy=_ndx/2, _stepx=62832/_ndx, _stepy=31416/_ndy"

	%= rainbow colors =%
	set /a H=0, dH=359/_ndx, V=10000

	for /L %%C in (1,1,!_ndx!) do (

	  set /a "mm = (H*10000/60 %% 20000) - 10000, mm=(mm>>31|1)*mm, C = V, X = C *(10000 - mm)/10000, C=C*255/10000, X=X*255/10000"
	  if !H! lss 60 (set /a R=C, G=X, B=0) else (
   		if !H! lss 120 (set /a R=X, G=C, B=0) else (
			if !H! lss 180 (set /a R=0, G=C, B=X) else (
				if !H! lss 240 (set /a R=0, G=X, B=C) else (
					if !H! lss 300 (set /a R=X, G=0, B=C) else (
						if !H! lss 360 (set /a R=C, G=0, B=X) else (echo ERROR!)
	  )))))
	  %= compute for 216 color map =%
          set /A "C_%%C=((R-35)/40+((R-48)>>8)-((R-75)>>8))*36 + ((G-35)/40+((G-48)>>8)-((G-75)>>8))*6 + ((B-35)/40+((B-48)>>8)-((B-75)>>8)) + 16"
	  set /A H+=dH
	)
	%= Empty vars =%
	set "X=" & set "V=" & set "G=" & set "R=" & set "C=" & set "B=" & set "mm=" & set "dH=" & set "H="

	%= meridians =%	
	set /a "angle=0"	
	set "_X="
	for /L %%X in (1,1,!_ndx!) do (
		set /A "sx=%_SIN(x):x=angle%, cx=%_SIN(x):x=(15708-angle)%, angle+=_stepx"
		set "_X=!_X!"!sx! !cx!" "
	)

	%= parallels =%
	set /a "angle=_stepy"
	set "_Y="
	for /L %%X in (2,1,!_ndy!) do (	
		set /A "sx=%_SIN(x):x=angle%, cx=%_SIN(x):x=(15708-angle)%, angle+=_stepy"
		set "_Y=!_Y!"!sx! !cx!" "	
	)
	set "angle="

	%= Poles 0-pi =%
	set /A "sx=%_SIN(x):x=0%, cx=%_SIN(x):x=(15708)%"
	set "_PX="!sx! !cx!""
	set "_PY="!sx! !cx!" "
	set /A "sx=%_SIN(x):x=31416%, cx=%_SIN(x):x=(15708-31416)%"
	set "_PY=!_PY!"!sx! !cx!""

	call :rotate
	
	set /a _ndx+=2
  )

goto :eof

:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:rotate

(setlocal

  for /F "Tokens=1 delims==" %%v in ('set _') do set "%%v="

  %= clear screen and Home =%
  set/p "=%_ESC%[2J%_ESC%H"<nul

  %_loop% (

    for /f "tokens=1-4 delims=:.," %%a in ("!time: =0!") do set /a "t2=(((1%%a*60)+1%%b)*60+1%%c)*100+1%%d-36610100, tD=t2-t1, tD+=(tD>>31) & 8640000, el+=1"
  
    %= 4=25 FPS max =%
    if !tD! geq %_dT% (

	%= Full loop (120)*31416/60 or multiple of 120 =%
	set /a "t1=t2, rt+=31416/60, il+=1, fc+=1"

	if %_ndx% lss 36 if !il! gtr 20 (
		set /a "z=el/il"
		if !il! gtr 2000 set /a "il=el=0"
		if !z! gtr 20 goto :exit
	)

	if !fc! geq 50 (
		set /a "elaps=(t2-oldt), FPS=1000*fc/elaps, oldt=t2, fc=0"
		title Sphere 3D - FPS:!FPS:~0,-1!.!FPS:~-1! - splits:%_ndx% ratio:!z!
		set "elaps="
		set "FPS="
	)

	if !ds! lss 1000 (set /a ds+=10)

	%= Cos(x)=Sin(PI/2-x) =%
	set /A "sx=%_SIN(x):x=rt%, cx=%_SIN(x):x=(15708-rt)%"

	For /f "tokens=1,2" %%a in ("!sx! !cx!") do (
	set "cx=" & set "sx="

	set "s=!s!%_ESC%[92m"
	set "e=!e!%_ESC%[30m"

	%= Bright Foreground Red =%
	set "t=!t!%_ESC%[91m"

	%= Poles =%
        for %%f in (%_PX%) do for /f "tokens=1,2" %%g in (%%f) do (
		for %%t in (%_PY%) do for /f "tokens=1,2" %%u in (%%t) do (
			set /a "a=%_R%*%%h/10000*%%u/10000, c=%_R%*%%g/10000*%%u/10000, b=%_R%*%%v/10000, a=(a*%%b/10000-(b*%%a+c*%%b)/10000*%%a/10000)*%%b/10000-(b*%%b-c*%%a)/10000*%%a/10000, b=(%_R%*%%h/10000*%%u/10000*%%b/10000-(b*%%a+c*%%b)/10000*%%a/10000)*%%a/10000+(b*%%b-c*%%a)/10000*%%b/10000, c=%_R%*%%h/10000*%%u/10000*%%a/10000+(%_R%*%%v/10000*%%a+c*%%b)/10000*%%b/10000, a=ds*a/(c-%_dz%)+%_dx%, b=ds*b/(c-%_dz%)+%_dy%"
			if !c! lss 0 (
				set "s=!s!%_ESC%[!b!;!a!H·"
			) else (
				set "d=!d!%_ESC%[!b!;!a!H♥"
	)))

	set /A "z=1"

	%= meridians =%
	for %%f in (%_X%) do for /f "tokens=1,2" %%g in (%%f) do (

	  For %%C in (!z!) do set "t=!t!%_ESC%[38;5;!C_%%C!m"

	  %= parallels =%
          for %%t in (%_Y%) do for /f "tokens=1,2" %%u in (%%t) do (

            set /a "a=%_R%*%%h/10000*%%u/10000, c=%_R%*%%g/10000*%%u/10000, b=%_R%*%%v/10000, a=(a*%%b/10000-(b*%%a+c*%%b)/10000*%%a/10000)*%%b/10000-(b*%%b-c*%%a)/10000*%%a/10000, b=(%_R%*%%h/10000*%%u/10000*%%b/10000-(b*%%a+c*%%b)/10000*%%a/10000)*%%a/10000+(b*%%b-c*%%a)/10000*%%b/10000, c=%_R%*%%h/10000*%%u/10000*%%a/10000+(%_R%*%%v/10000*%%a+c*%%b)/10000*%%b/10000, a=ds*a/(c-%_dz%)+%_dx%, b=ds*b/(c-%_dz%)+%_dy%"

	    if !c! lss 0 (
			set "s=!s!%_ESC%[!b!;!a!H·"
	    ) else (
			%= *Φ•○♥øo =%
			set "d=!d!%_ESC%[!b!;!a!H♥"
	    )

          ) %= parallels =%

	  set "t=!t!!d!"
	  set "e=!e!!d!"
	  set "d="

	  set /A z+=1
  		
	) %= meridians =%
	)

	%= intrinsic cls =%
	%= echo zbuffer like, keep separate to overcome 8k limit =%
	echo(!s!
	echo(!t!

	set "s=!s! "
	set "t=!e!  "
	%= keep space for empty "t" =%
	set "e= "

	%= Foreground Black =%
	set s=!s:92m=30m!

	set /a i+=1
	if !i! geq 3 (
		set "s=!s:* =!"
		set "t=!t:* =!"
	)

    ) %= if !tD! geq _dT =%
  ) %= end_loop =%
)
:exit

(endlocal & set /a rt=%rt%, ds=%ds%)

goto :eof

.

[einstein1969]

this is the file:

[IcarusLives]

New Release 0.03 with rainbow colors and dinamic model.

Try it and let me know how fast your processor is. I did my best to optimize the code. I hope it's fast enough even on old pcs.

use VT escape sequence avaible in windows 10.

Code: Select all

:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
@echo off & setlocal EnableDelayedExpansion 

    :: Porting By Francesco Poscetti aka einstein1969

    :: Use raster font 8x8, save in utf8

    :: v 0.0.3 	update sin code, use vt100, auto tune number of points, use bullet ·
    ::		code optimization for faster execution, dinamic resolution based on pc performance
    ::		better zbuffer, break near infinite loop by jeb.
    :: v 0.0.2 	passed from 16.6 FPS to ~20.0 FPS

    :: Variables enigma:

    :: _R   =   Sphere radius
    :: rt   =   Rotation angle
    :: ds   =   Distance Z of sphere
    :: _dx,_dy   =   Offset x,y of projecting coordinates in 2D plane.
    :: sx,cx   =   Sine, cosine of rotation angle
    :: a,b,c   =   Rotation coordinate 3D
    :: a,b   =   X,Y coordinate of projecting 3D to 2D
    :: c   =   Z coordinate

    :: Ref:
    :: https://invisible-island.net/xterm/ctlseqs/ctlseqs.html
    :: https://learn.microsoft.com/en-us/windows/console/console-virtual-terminal-sequences

:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  title Sphere 3D
  set /a _cols=120, _lines=90
  rem utf 8
  chcp 65001
  mode %_cols%,%_lines%
  set /a _cols-=2, _lines-=2
  cls
  for /F %%a in ('Echo(prompt $E^| cmd') Do Set _ESC=%%a

:ChoiceLabel
  echo(
  choice /M "Select the maximum speed. Choose a number between 2 and 9 where 2 very fast and 9 slow. Default [5] ?" /D 5 /C 23456789 /T 10 /N
  if %errorlevel% gtr 0 (set /a _dT=%errorlevel%+1) else goto :ChoiceLabel

  :: Hide the cursor
  <nul set /p "=%_ESC%[?25l"
(  
  for /F "Tokens=1 delims==" %%v in ('set') do set "%%v="
  set /a "_cols=%_cols%, _lines=%_lines%"
  set "_ESC=%_ESC%"
  set "_dT=%_dT%"
)

  rem https://www.dostips.com/forum/viewtopic.php?f=3&t=4896
  set "_SIN(x)=(a=((x)%%62832)+(((x)%%62832)>>31&62832), b=(a-15708^a-47124)>>31,a=(-a&b)+(a&~b)+(31416&b)+(-62832&(47123-a>>31)),a-a*a/1875*a/320000+a*a/1875*a/15625*a/16000*a/2560000-a*a/1875*a/15360*a/15625*a/15625*a/16000*a/44800000)"

  set "_loop=FOR /L %%# in (1,1,2) do "
  %_loop%%_loop% set "_loop=!_loop!!_loop!!_loop!"

:: Main

  set /a "_R=160, _dx=_cols/2, _dy=_lines/2, _dz=4000, _ndx=6, ds=0, rt=0, i=1"

  for /L %%L in () do (

	%= Prepare for faster dinamic execution =%

	set /a "_ndy=_ndx/2, _stepx=62832/_ndx, _stepy=31416/_ndy"

	%= rainbow colors =%
	set /a H=0, dH=359/_ndx, V=10000

	for /L %%C in (1,1,!_ndx!) do (

	  set /a "mm = (H*10000/60 %% 20000) - 10000, mm=(mm>>31|1)*mm, C = V, X = C *(10000 - mm)/10000, C=C*255/10000, X=X*255/10000"
	  if !H! lss 60 (set /a R=C, G=X, B=0) else (
   		if !H! lss 120 (set /a R=X, G=C, B=0) else (
			if !H! lss 180 (set /a R=0, G=C, B=X) else (
				if !H! lss 240 (set /a R=0, G=X, B=C) else (
					if !H! lss 300 (set /a R=X, G=0, B=C) else (
						if !H! lss 360 (set /a R=C, G=0, B=X) else (echo ERROR!)
	  )))))
	  %= compute for 216 color map =%
          set /A "C_%%C=((R-35)/40+((R-48)>>8)-((R-75)>>8))*36 + ((G-35)/40+((G-48)>>8)-((G-75)>>8))*6 + ((B-35)/40+((B-48)>>8)-((B-75)>>8)) + 16"
	  set /A H+=dH
	)
	%= Empty vars =%
	set "X=" & set "V=" & set "G=" & set "R=" & set "C=" & set "B=" & set "mm=" & set "dH=" & set "H="

	%= meridians =%	
	set /a "angle=0"	
	set "_X="
	for /L %%X in (1,1,!_ndx!) do (
		set /A "sx=%_SIN(x):x=angle%, cx=%_SIN(x):x=(15708-angle)%, angle+=_stepx"
		set "_X=!_X!"!sx! !cx!" "
	)

	%= parallels =%
	set /a "angle=_stepy"
	set "_Y="
	for /L %%X in (2,1,!_ndy!) do (	
		set /A "sx=%_SIN(x):x=angle%, cx=%_SIN(x):x=(15708-angle)%, angle+=_stepy"
		set "_Y=!_Y!"!sx! !cx!" "	
	)
	set "angle="

	%= Poles 0-pi =%
	set /A "sx=%_SIN(x):x=0%, cx=%_SIN(x):x=(15708)%"
	set "_PX="!sx! !cx!""
	set "_PY="!sx! !cx!" "
	set /A "sx=%_SIN(x):x=31416%, cx=%_SIN(x):x=(15708-31416)%"
	set "_PY=!_PY!"!sx! !cx!""

	call :rotate
	
	set /a _ndx+=2
  )

goto :eof

:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:rotate

(setlocal

  for /F "Tokens=1 delims==" %%v in ('set _') do set "%%v="

  %= clear screen and Home =%
  set/p "=%_ESC%[2J%_ESC%H"<nul

  %_loop% (

    for /f "tokens=1-4 delims=:.," %%a in ("!time: =0!") do set /a "t2=(((1%%a*60)+1%%b)*60+1%%c)*100+1%%d-36610100, tD=t2-t1, tD+=(tD>>31) & 8640000, el+=1"
  
    %= 4=25 FPS max =%
    if !tD! geq %_dT% (

	%= Full loop (120)*31416/60 or multiple of 120 =%
	set /a "t1=t2, rt+=31416/60, il+=1, fc+=1"

	if %_ndx% lss 36 if !il! gtr 20 (
		set /a "z=el/il"
		if !il! gtr 2000 set /a "il=el=0"
		if !z! gtr 20 goto :exit
	)

	if !fc! geq 50 (
		set /a "elaps=(t2-oldt), FPS=1000*fc/elaps, oldt=t2, fc=0"
		title Sphere 3D - FPS:!FPS:~0,-1!.!FPS:~-1! - splits:%_ndx% ratio:!z!
		set "elaps="
		set "FPS="
	)

	if !ds! lss 1000 (set /a ds+=10)

	%= Cos(x)=Sin(PI/2-x) =%
	set /A "sx=%_SIN(x):x=rt%, cx=%_SIN(x):x=(15708-rt)%"

	For /f "tokens=1,2" %%a in ("!sx! !cx!") do (
	set "cx=" & set "sx="

	set "s=!s!%_ESC%[92m"
	set "e=!e!%_ESC%[30m"

	%= Bright Foreground Red =%
	set "t=!t!%_ESC%[91m"

	%= Poles =%
        for %%f in (%_PX%) do for /f "tokens=1,2" %%g in (%%f) do (
		for %%t in (%_PY%) do for /f "tokens=1,2" %%u in (%%t) do (
			set /a "a=%_R%*%%h/10000*%%u/10000, c=%_R%*%%g/10000*%%u/10000, b=%_R%*%%v/10000, a=(a*%%b/10000-(b*%%a+c*%%b)/10000*%%a/10000)*%%b/10000-(b*%%b-c*%%a)/10000*%%a/10000, b=(%_R%*%%h/10000*%%u/10000*%%b/10000-(b*%%a+c*%%b)/10000*%%a/10000)*%%a/10000+(b*%%b-c*%%a)/10000*%%b/10000, c=%_R%*%%h/10000*%%u/10000*%%a/10000+(%_R%*%%v/10000*%%a+c*%%b)/10000*%%b/10000, a=ds*a/(c-%_dz%)+%_dx%, b=ds*b/(c-%_dz%)+%_dy%"
			if !c! lss 0 (
				set "s=!s!%_ESC%[!b!;!a!H·"
			) else (
				set "d=!d!%_ESC%[!b!;!a!H♥"
	)))

	set /A "z=1"

	%= meridians =%
	for %%f in (%_X%) do for /f "tokens=1,2" %%g in (%%f) do (

	  For %%C in (!z!) do set "t=!t!%_ESC%[38;5;!C_%%C!m"

	  %= parallels =%
          for %%t in (%_Y%) do for /f "tokens=1,2" %%u in (%%t) do (

            set /a "a=%_R%*%%h/10000*%%u/10000, c=%_R%*%%g/10000*%%u/10000, b=%_R%*%%v/10000, a=(a*%%b/10000-(b*%%a+c*%%b)/10000*%%a/10000)*%%b/10000-(b*%%b-c*%%a)/10000*%%a/10000, b=(%_R%*%%h/10000*%%u/10000*%%b/10000-(b*%%a+c*%%b)/10000*%%a/10000)*%%a/10000+(b*%%b-c*%%a)/10000*%%b/10000, c=%_R%*%%h/10000*%%u/10000*%%a/10000+(%_R%*%%v/10000*%%a+c*%%b)/10000*%%b/10000, a=ds*a/(c-%_dz%)+%_dx%, b=ds*b/(c-%_dz%)+%_dy%"

	    if !c! lss 0 (
			set "s=!s!%_ESC%[!b!;!a!H·"
	    ) else (
			%= *Φ•○♥øo =%
			set "d=!d!%_ESC%[!b!;!a!H♥"
	    )

          ) %= parallels =%

	  set "t=!t!!d!"
	  set "e=!e!!d!"
	  set "d="

	  set /A z+=1
  		
	) %= meridians =%
	)

	%= intrinsic cls =%
	%= echo zbuffer like, keep separate to overcome 8k limit =%
	echo(!s!
	echo(!t!

	set "s=!s! "
	set "t=!e!  "
	%= keep space for empty "t" =%
	set "e= "

	%= Foreground Black =%
	set s=!s:92m=30m!

	set /a i+=1
	if !i! geq 3 (
		set "s=!s:* =!"
		set "t=!t:* =!"
	)

    ) %= if !tD! geq _dT =%
  ) %= end_loop =%
)
:exit

(endlocal & set /a rt=%rt%, ds=%ds%)

goto :eof

I love this so much. You always do such a good job einstein1969! I need to study this code so I can understand it!

[T3RRY]

Phenomenally Impressive!

Edit: FYI, I got an average of 16.6 fps with my processor specs being:
Intel(R) Core(TM) i5-9400 CPU @ 2.90GHz, 2904 Mhz, 6 Core(s), 6 Logical Processor(s)