I would like to carry out a project in color on the Mandelbrot set, using:
- the mathematical Wsh (jscript is faster than vbscript?) or batch (ieee754 penpen's work)
- some Aacini's utility (for the management of the mouse)
- multi-threaded batch (to use multiple cores)
- color gradient
- deep zoom
- .... and more ...
I would not do it all alone. Who's' with me?
References:
- http://www.dostips.com/forum/viewtopic.php?p=12542#p12542 Initial expert's work
- Aacini work on high resolution The best on high resolution!
- SUPERFRACTALTHING MATHS by K.I. MARTIN 100 times faster zoom math
jeb wrote:One of my next goals is to use multiple threads for the mandelbrot.
So on a Core-I7 it could be 8 times faster.
jeb
A base to start:
Code: Select all
:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: Mandelbrot
::
:: Use font raster 8x8 or Lucida console 5
:: Tested on Windows 7 32bit
::
::
:: v.0.1 Initial Version. Based on Aacini/jeb code.
::
:: - Tune Env + Implemented a queue for speedup call findstr, quadruple speed!
:: - rewritten core of Iteration , 10% more Speed
:: - fixed bug that overflow the core iteration loop. Reduce FixedPoint precis. from 4 to 3 digit.
:: - Flips X coordinates to match with real Mandelbrot
:: - Palette rainbow!
::
:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
@echo off & Setlocal EnableDelayedExpansion
cls
:: for raster 8x8
mode 88,60
:: for raster 6x4
rem mode 188,100
:: for Lucida console 5
rem mode 330,140
call :init
:: increase the queue lenght for more speed! QueueLen=1 => Disabled, 16=lowresolution 128=Highresolution
set QueueLen=4
rem 1=42 2=71 3=90 4=105 6=125 8=138 16=160 chars/sec
rem X
rem X X
rem X X X
rem X X X X
rem X X X X X
rem X X X X X X
rem X X X X X X X
rem X X X X X X X
rem 1 2 3 4 6 8 16
REM Working values: maximum screen coordinates and iteration level
set /A maxX=Cols-15, maxY=Lines-5, maxLevel=56, one=1000
:: to 3 decimal because go overflow.
call :IntAsFP $xLeft=-2.100
call :IntAsFP $yTop= 1.125
call :IntAsFP $xRight= 0.800
call :IntAsFP $yBottom=-1.125
:: a particolar/Zoom
call :IntAsFP $xLeft=-0.420
call :IntAsFP $yTop= 1.000
call :IntAsFP $xRight= 0.250
call :IntAsFP $yBottom= 0.580
set /A "$xStep=($xRight-$xLeft)/maxX, $yStep=($yTop-$yBottom)/maxY, four=4*one*one"
set "chars=°±²Û"
set "char_0=ú"
set "Colors=04 4C CE EA A2 22 2A AB B9 91 15 50 "
set "Color_0=a"
cls
echo(&echo(
set /A $yPos=$yTop+$yStep, nChar=0
set t0=%time%
for /L %%y in (0,1,%maxY%) do (
set /P ".=%BS% " <NUL
set /A $yPos-=$yStep, $xPos=$xLeft-$xStep
for /L %%x in (0,1,%maxX%) do (
set /A "$xPos+=$xStep, $xIter=$xPos, $yIter=$yPos, $xSquare=$xIter*$xIter, $ySquare=$yIter*$yIter, $root=$xSquare+$ySquare"
set level=
for /L %%i in (1,1,%maxLevel%) do if not defined level (
if !$root! lss %four% (
:: check overflow!
set /A "$yIter=2*$xIter*$yIter/%one%+$yPos, $xIter=($root-2*$ySquare)/%one%+$xPos, $ySquare=$yIter*$yIter, $root=$xIter*$xIter+$ySquare"
) else set level=%%i
)
if not defined level set level=0
set /a nChar+=1
for %%l in (!level!) do (
:: color/char mapping
set /a "ic=((%%l-1) %% 4), ico=((%%l-1)/4 %% 12)*3"
if !level! gtr 0 (
for %%i in (!ic!) do set char=!chars:~%%i,1!
for %%i in (!ico!) do set col=!Colors:~%%i,3!
) else (
set char=!char_0!
set col=!Color_0!
)
rem ex call :ColorText !showColor[%%l]! "!showChar[%%l]!"
rem ex (echo !showChar[%%l]!\..\') > colorPrint.txt & findstr /a:!showColor[%%l]! /f:colorPrint.txt "."
rem if queue full than flush and queue
if !Queue! geq !QueueLen! (
(echo !QueueChar!\..\') > colorPrint.txt & %FS% /a:!QueueColor! /f:colorPrint.txt "."
set QueueChar=!char!
set QueueColor=!col!
set Queue=1
) else (
rem if same color than queue
if "!QueueColor!"=="!col!" (
set QueueChar=!QueueChar!!char!
set /a Queue+=1
) else (
rem not same color. Flush and queue
if defined QueueChar ( (echo !QueueChar!\..\') > colorPrint.txt & %FS% /a:!QueueColor! /f:colorPrint.txt "." )
set QueueChar=!char!
set QueueColor=!col!
set Queue=1
)
)
)
)
rem End of Line. flush queue
if defined QueueChar (
(echo !QueueChar!\..\') > colorPrint.txt & %FS% /a:!QueueColor! /f:colorPrint.txt "."
set QueueChar=
set QueueColor=
set Queue=0
)
:: Performance Statistic.
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, Cs=nChar*100*10/a"
title !cs:~0,-1!.!cs:~-1! Chars/sec
echo(
)
popd
goto :EOF
:IntAsFP Int=FP
set FP=%2
If "!FP:~0,1!"=="-" (
set FP=!FP:~1!
set sign=-
)
If "!FP:~0,1!"=="0" set FP=!FP:~1!
set %1=!sign!!FP:.=!
set FP=
set sign=
exit /B
:Init
pushd %tmp%
for /f %%f in ('where findstr') do set FS=%%f
:: get currenct lines and columns from mode command.
for /f "skip=2 tokens=2" %%f in ('mode con:') do if not defined Lines (set Lines=%%f) else if not defined Cols set Cols=%%f
(
for /F "Tokens=1 delims==" %%v in ('set') do set "%%v="
set /a Lines=%Lines%, Cols=%Cols%
set FS=%FS%
)
for /f %%a in ('"prompt $H&for %%b in (1) do rem"') do set "BS=%%a"
set BS=%BS%%BS%%BS%%BS%%BS%%BS%
<nul >"'" set /p ".=%BS% %BS%"
goto :eof
remove comment from "mode 330,140", set font Lucida console 5 and set higher QueueLen for a nice and fast result! Try!!
UPDATE:
Code: Select all
:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: Mandelbrot
::
:: Use font raster 8x8 or Lucida console 5
::
:: For use +double Y resolution must disable ClearType but Activate Smoothness font edge in System preference. Sperimental mode.
::
:: Tested on Windows 7 32bit
::
:: v 0.2a New Features: Double resolution in Y
:: - Alpha stage for double resolution in Y. Only 16 color is permitted.
:: - Speed slow for maintain code small.
:: - TODO: double resolution in X, software dithering, resolve bug on queue double resolution
::
:: v.0.1 Initial Version. Based on Aacini/jeb code.
::
:: - Tune Env + Implemented a queue for speedup call of findstr, quadruple speed!
:: - rewritten core of Iteration , 10% more Speed
:: - fixed bug that overflow the core iteration loop. Reduce FixedPoint precis. from 4 to 3 digit.
:: - Flips X coordinates to match with real Mandelbrot
:: - Palette rainbow!
::
:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
@echo off & Setlocal EnableDelayedExpansion
cls
:: for raster 8x8
mode 88,60
:: for raster 6x4
rem mode 188,100
:: for Lucida console 5
rem mode 330,140
:: for Lucida console 2 Bold (Half resolution / Hardware dither)
rem mode 480,360
:: for Lucida console 2 (Hardware dither)
rem mode 960,360
:: Sperimental!!!
:: Use +double Y resolution/16 color with software dithering or single resolution/256 color with hardware dithering
rem set Double=TRUE
call :init
:: increase the queue lenght for more speed! QueueLen=1 => Disabled, 16=lowresolution 128=Highresolution
set MaxQueueLen=2
:: Q=current queue Len
set Q=0
rem 1=42 2=71 3=90 4=105 6=125 8=138 16=160 chars/sec
rem X
rem X X
rem X X X
rem X X X X
rem X X X X X
rem X X X X X X
rem X X X X X X X
rem X X X X X X X
rem 1 2 3 4 6 8 16
REM Working values: maximum screen coordinates and iteration level
set /A maxX=Cols-15, maxY=Lines-5, maxLevel=48, one=1000
:: to 3 decimal because go overflow.
call :IntAsFP xLeft=-2.100
call :IntAsFP yTop= 1.125
call :IntAsFP xRight= 0.800
call :IntAsFP yBottom=-1.125
rem goto :n
set maxLevel=56
call :IntAsFP xLeft=-0.420
call :IntAsFP yTop= 1.000
call :IntAsFP xRight= 0.250
call :IntAsFP yBottom= 0.580
:n
set /A "xStep=(xRight-xLeft)/maxX, yStep=(yTop-yBottom)/maxY, four=4*one*one"
cls
echo(&echo(
set t0=%time%
(
:: remove unnecessary vars.
set t0=
rem set MaxqueueLen=
rem set one=
set MaxX=
set MaxY=
rem set MaxLevel=
set Lines=
set Cols=
rem set FS=
rem set four=
rem set Color_0=
rem set Char_0=
set mBS=
set BS=
set yTop=
set yBottom=
set xRight=
set xLeft=
set yStep=
set xStep=
set /A a_Cy=%yTop%+%yStep%, nChar=0
for /L %%y in (0,1,%maxY%) do (
set /P ".=%BS% " <NUL
set /A a_Cy-=%yStep%, a_Cx=%xLeft%-%xStep%
for /L %%x in (0,1,%maxX%) do (
rem title %xStep% %yStep%
set /A a_Cx+=%xStep%
call :I
if /I "!Double!"=="TRUE" (
set co1=!col!
set /A "a_Cy+=(%yStep%/2)"
call :I
if "!col!"=="!co1!" (
set char=Û
set col=7!col!
) else set Col=!col:~0,1!!co1:~0,1!
set /A "a_Cy-=(%yStep%/2)"
)
rem ex call :ColorText !showColor[%%l]! "!showChar[%%l]!"
rem ex (echo !showChar[%%l]!\..\') > colorPrint.txt & findstr /a:!showColor[%%l]! /f:colorPrint.txt "."
rem TODO: Use this coloring : (echo Ü)> colorPrint.txt & %FS% /a:%1%2 /f:colorPrint.txt "."
call :Q
)
rem End of Line. flush queue
if defined QueueChar (
(echo !QueueChar!\..\') > colorPrint.txt & %FS% /a:!QueueColor! /f:colorPrint.txt "."
set QueueChar=
set QueueColor=
set Q=0
)
:: Performance Statistic.
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, Cs=nChar*100*10/a"
title !cs:~0,-1!.!cs:~-1! Chars/sec
set cs=& set a=
echo(
)
)
rem set
popd
goto :EOF
:Q
(
rem if queue full than flush and queue
if !Q! geq %MaxQueueLen% (
(echo !QueueChar!\..\') > colorPrint.txt & %FS% /a:!QueueColor! /f:colorPrint.txt "."
set QueueChar=!char!
set QueueColor=!col!
set Q=1
) else (
rem if same color than queue
if "!QueueColor!"=="!col!" (
set QueueChar=!QueueChar!!char!
set /a Q+=1
) else (
rem not same color. Flush and queue
if defined QueueChar ( (echo !QueueChar!\..\') > colorPrint.txt & %FS% /a:!QueueColor! /f:colorPrint.txt "." )
set QueueChar=!char!
set QueueColor=!col!
set Q=1
)
)
exit /b )
:I
(
set /a $x=a_Cx, $y=a_Cy, $m=$x*$x+$y*$y
set bLev=
:: check overflow!
for /L %%i in (1,1,%maxLevel%) do if not defined bLev (
if !$m! lss %four% (
set /A "a=2*$x*$y/%one%+a_Cy, $x=($m-2*$y*$y)/%one%+a_Cx, $y=a, $m=$x*$x+$y*$y"
) else set bLev=%%i
)
if not defined bLev set bLev=0
for %%l in (!bLev!) do (
:: color/char mapping
if /I "!Double!"=="TRUE" (
set /a "ic=0, ico=((%%l-1) %% 12) * 3, nChar+=1"
:: Hybrid system color for test.
rem set /a "ic=((%%l-1) %% 4), ico=((%%l-1)/4 %% 12)*3, nChar+=1"
) else set /a "ic=((%%l-1) %% 4), ico=((%%l-1)/4 %% 12)*3, nChar+=1"
if %%l gtr 0 (
for %%i in (!ic!) do set char=!chars:~%%i,1!
for %%i in (!ico!) do set col=!Colors:~%%i,3!
) else (
set char=%char_0%
set col=%Color_0%
)
)
set ic=& set ico=
exit /b )
:IntAsFP Int=FP
set FP=%2
If "!FP:~0,1!"=="-" (
set FP=!FP:~1!
set sign=-
)
If "!FP:~0,1!"=="0" set FP=!FP:~1!
set %1=!sign!!FP:.=!
set FP=
set sign=
exit /B
:Init
pushd %tmp%
for /f %%f in ('where findstr') do set FS=%%f
:: get currenct lines and columns from mode command.
for /f "skip=2 tokens=2" %%f in ('mode con:') do if not defined Lines (set Lines=%%f) else if not defined Cols set Cols=%%f
(
for /F "Tokens=1 delims==" %%v in ('set') do set "%%v="
set /a Lines=%Lines%, Cols=%Cols%
set FS=%FS%
set Double=%Double%
)
for /f %%a in ('"prompt $H&for %%b in (1) do rem"') do set "BS=%%a"
set mBS=%BS%%BS%%BS%%BS%%BS%%BS%
<nul >"'" set /p ".=%mBS% %mBS%"
<nul >"Ü" set /p ".=%BS%"
:: Setting Color palette
if /I "!Double!"=="TRUE" (
set "chars=Ü"
set "char_0=Ü"
set "Colors=4 C E A 2 2 3 B 9 1 5 D "
set "Color_0=0"
) else (
set "chars=°±²Û"
set "char_0=ú"
set "Colors=04 4C CE EA A2 22 2A AB B9 91 15 50 "
set "Color_0=a"
)
:: Hybrid system color for test.
rem set "chars=ÛÛÛÛ"
rem set "chars=ÜÜÜÜ"
rem set "char_0=ú"
rem set "Colors=4 C E A 2 2 3 B 9 1 5 D "
rem set "Color_0=0"
goto :eofeinstein1969
).