[特效代码] 分形图:谢尔宾斯基地毯

a20150604

有点闲, 想画点简单的平面分形图, 就先画个 谢尔宾斯基地毯 吧


这个图形是左右, 上下, 中心对称的, 用图形复制的方法是很快的

REM Sierpinski carpet call 递归图形复制高速版
%1 @goto :initCON
@echo off & setlocal enabledelayedexpansion
set /a "w=83,h=83, h1=h,t=w*h,xc=w/2+1,yc=h/2"
set "TAB=	" & for /F %%a in ('"prompt $h&for %%b in (1) do rem"')do Set "BS=%%a"
set /a "buffwid = w, linesWantBackAbove = h + 1 - 1, cntBS = 2 + (buffwid + 7) / 8 * linesWantBackAbove"
set "BSs=" & for /L %%a in (1 1 !cntBS!) do set "BSs=!BSs!%BS%"
set "aLineBS=" & for /L %%a in (1 1 !w!) do set "aLineBS=!aLineBS!%BS%"
mode %w%,%h1%
for /l %%i in (1 1 !t!) do set "s=!s! "
call :f 0 0 81 s
REM <nul set /p "=!aLineBS!" & (2>nul echo;%TAB%!BSs!) & <nul set /p "=%BS%"
REM <nul set /p "=%BS%!s:~0,-1!"
title complete & >nul pause &exit
:f xcnt ycnt hei s
setlocal
set "s=!%4!"
if %3 leq 1 (
    set /a "i=%1-xc + (%2-yc) * w + 1, L=i-1"
    for /f "tokens=1,2" %%a in ("!L! !i!") do (set s=!s:~0,%%a!#!s:~%%b!)
) else (
    set /a "h=%3 / 3"
    set /a "x=%1 + - h, y=%2 + - h"
    call :f !x! !y! !h! %4
    set /a "x1=%1 + (- %3/2), y1=%2 + (- %3/2), xb=x1+h, yb=y1+h"
    for %%x in (- 0^& +) do for %%y in (- 0^& +) do (
        if "%%x%%y" neq "0&0&" if "%%x%%y" neq "--" (
            set /a "x2=xb + (%%x h), y2=yb + (%%y h)"
            for /L %%j in (1 1 !h!) do (
                set /a "i=x2-xc + (y2-yc + %%j-1) * w + h, L=i-h, i1=x1-xc + (y1-yc + %%j-1) * w"
                for /f "tokens=1-4" %%a in ("!L! !i! !i1! !h!") do (
                    set "s=!s:~0,%%a!!s:~%%c,%%d!!s:~%%b!"
                    <nul set /p "=!aLineBS!" & (2>nul echo;%TAB%!BSs!) & <nul set /p "=%BS%"
                    <nul set /p "=%BS%!s:~0,-1!"
                )
            )
        )
    )
)
(
    endlocal
    set "%4=%s%"
    exit /b
)
:initCON
@echo off
for %%a in (  FontSize:00080008      FontFamily:00000030  WindowSize:00C800C8
              ScreenColors:0000000f  CodePage:000001b5    ScreenBufferSize:00C800C8
) do for /f "tokens=1,2 delims=:" %%b in ("%%a") do (
  >nul reg add HKCU\Console\Sierpinski_carpet /v %%b /t reg_dword /d 0x%%c /f
)
start "Sierpinski_carpet" /max "%ComSpec%" /c "%~0" REM & (call :delReg) & exit
REM end of :initCON
exit /b
:delReg
setlocal enabledelayedexpansion
set "s=!time:~-4,1!"
:delReg.loop
set /a "elapse = (1!time:~-4,1! - s) %% 10"
if %elapse% lss 2 goto :delReg.loop
>nul reg delete HKCU\Console\Sierpinski_carpet /f
endlocal
exit /b
REM end of :delReg
复制代码

for 模拟递归版

%1 @goto :initCON
@echo off & setlocal enabledelayedexpansion
call :clearVars
set /a "w=83,h=83, h1=h,t=w*h,xc=w/2+1,yc=h/2"
mode %w%,%h1%

set "TAB=	" & for /F %%a in ('"prompt $h&for %%b in (1) do rem"')do Set "BS=%%a"
set /a "buffwid = w, linesWantBackAbove = h + 1 - 1, cntBS = 2 + (buffwid + 7) / 8 * linesWantBackAbove"
set "BSs=" & for /L %%a in (1 1 !cntBS!) do set "BSs=!BSs!%BS%"
set "aLineBS=" & for /L %%a in (1 1 !w!) do set "aLineBS=!aLineBS!%BS%"

for /l %%i in (1 1 !t!) do set "s=!s! "
REM 堆栈 xSt, ySt, hSt, iSt 都取 4 位一节
set "xL=- + + - 0&0&- + "
set "yL=- + - + - + 0&0&"
set /a "xcnt=0, ycnt=0, hei=81, istep=-2"

:enter

for /L %%* in () do (
        <nul set /p "=!aLineBS!" & (2>nul echo;%TAB%!BSs!) & <nul set /p "=%BS%"
        <nul set /p "=%BS%!s:~0,-1!"

        REM if 层终结条件 满足
        if !hei! leq 1 (
            REM 层终结计算
            set /a "i=xcnt-xc + (ycnt-yc) * w + 1, L=i-1"
            for /f "tokens=1,2" %%a in ("!L! !i!") do (set s=!s:~0,%%a!#!s:~%%b!)

            REM 参数出栈
            set /a "xcnt=!xSt:~-4!, ycnt=!ySt:~-4!, hei=!hSt:~-4!, istep=!iSt:~-4!"
            set "xSt=!xSt:~0,-4!"
            set "ySt=!ySt:~0,-4!"
            set "hSt=!hSt:~0,-4!"
            set "iSt=!iSt:~0,-4!"
            REM goto :enter
        ) else (
        REM else
            REM if 本层子计算未完成
            if !istep! lss 14 (
                REM 生成 并更新 下一个(或第1个)子计算 的 参数
                if !istep! geq 0 (
                    REM 还原上层中心坐标
                    for %%i in (!istep!) do set /a "xcnt-=(!xL:~%%i,2! hei/3), ycnt-=(!yL:~%%i,2! hei/3)"
                )
                set /a "istep+=2"
                for %%i in (!istep!) do set /a "xcnt+=(!xL:~%%i,2! hei/3), ycnt+=(!yL:~%%i,2! hei/3)"
                REM 参数入栈
                set "t=!xcnt!   !ycnt!"
                set "xSt=!xSt!!t:~0,4!"
                set "ySt=!ySt!!t:~-4!"
                set "t=!istep!   !hei!"
                set "hSt=!hSt!!t:~-4!"
                set "iSt=!iSt!!t:~0,4!"
                REM 层递进一
                set /a "hei/=3, istep=-2"
                REM goto :enter
            ) else (
            REM else
                REM if 栈空
                if "!hSt!"=="" (
                    REM goto :complete
                    <nul set /p "=!aLineBS!" & (2>nul echo;%TAB%!BSs!) & <nul set /p "=%BS%"
                    <nul set /p "=%BS%!s:~0,-1!"                    
                    title complete any to exit... &  >nul pause &exit
                ) else (
                REM else
                    REM 参数出栈
                    set /a "xcnt=!xSt:~-4!, ycnt=!ySt:~-4!, hei=!hSt:~-4!, istep=!iSt:~-4!"
                    set "xSt=!xSt:~0,-4!"
                    set "ySt=!ySt:~0,-4!"
                    set "hSt=!hSt:~0,-4!"
                    set "iSt=!iSt:~0,-4!"
                    REM goto :enter
                )
            )
        )

)
:complete
exit

:initCON
@echo off
for %%a in (  FontSize:00080008      FontFamily:00000030  WindowSize:00C800C8
              ScreenColors:0000000f  CodePage:000001b5    ScreenBufferSize:00C800C8
) do for /f "tokens=1,2 delims=:" %%b in ("%%a") do (
  >nul reg add HKCU\Console\Sierpinski_carpet /v %%b /t reg_dword /d 0x%%c /f
)
start "Sierpinski_carpet" /max "%ComSpec%" /c "%~0" REM & (call :delReg) & exit
REM end of :initCON
exit /b

:clearVars
set "Path=%SystemRoot%\system32"
for /f "delims==" %%a in ('set') do (
  if /i "%%a" neq "Path" set "%%a="
)
exit /b
REM end of :clearVars
复制代码

call 递归版:

%1 @goto :initCON
@echo off & setlocal enabledelayedexpansion
call :clearVars

set /a "w=83,h=83, h1=h+1,t=w*h,xc=w/2+1,yc=h/2-1"
mode %w%,%h1%
for /l %%i in (1 1 !t!) do set "s=!s! "
call :f 0 0 81 s
echo;!s! &pause &exit

:f xcnt ycnt hei s
setlocal
set "s=!%4!"
if %3 leq 1 (

    set /a "i=%1-xc + (%2-yc) * w + 1, L=i-1"
    for /f "tokens=1,2" %%a in ("!L! !i!") do (set s=!s:~0,%%a!#!s:~%%b!)
    cls & echo;!s!
) else (
    set /a "h=%3 / 3"
    for %%x in (- 0^& +) do for %%y in (- 0^& +) do (
        if "%%x%%y" neq "0&0&" (
            set /a "x=%1 + (%%x h), y=%2 + (%%y h)"
            call :f !x! !y! !h! %4
        )
    )
)
(
    endlocal
    set "%4=%s%"
    exit /b
)

:d
set /a "i=%1-xc + (%2-yc) * w + 1, L=i-1"
for /f "tokens=1,2" %%a in ("!L! !i!") do (set s=!s:~0,%%a!#!s:~%%b!)
exit /b


:initCON
@echo off
for %%a in (  FontSize:00080008      FontFamily:00000030  WindowSize:00C800C8
              ScreenColors:0000000f  CodePage:000001b5    ScreenBufferSize:00C800C8
) do for /f "tokens=1,2 delims=:" %%b in ("%%a") do (
  >nul reg add HKCU\Console\Sierpinski_carpet /v %%b /t reg_dword /d 0x%%c /f
)
start "Sierpinski_carpet" /max "%ComSpec%" /c "%~0" REM & (call :delReg) & exit
REM end of :initCON

exit /b

:clearVars
set "Path=%SystemRoot%\system32"
for /f "delims==" %%a in ('set') do (
  if /i "%%a" neq "Path" set "%%a="
)
REM set path=
exit /b
REM end of :clearVars
复制代码

goto 递归版, 没有期望的的速度, 毕竟 goto 要在文件中搜索行标, 快不了

%1 @goto :initCON
@echo off & setlocal enabledelayedexpansion
call :clearVars
set /a "w=83,h=83, h1=h+1,t=w*h,xc=w/2+1,yc=h/2-1"
mode %w%,%h1%
for /l %%i in (1 1 !t!) do set "s=!s! "
REM 堆栈 xSt, ySt, hSt, iSt 都取 4 位一节
set "xL=- + + - 0&0&- + "
set "yL=- + - + - + 0&0&"
set /a "xcnt=0, ycnt=0, hei=81, istep=-2"
:enter
    cls & echo;!s!
        REM if 层终结条件 满足
        if !hei! leq 1 (
            REM 层终结计算
            set /a "i=xcnt-xc + (ycnt-yc) * w + 1, L=i-1"
            for /f "tokens=1,2" %%a in ("!L! !i!") do (set s=!s:~0,%%a!#!s:~%%b!)

            REM 参数出栈
            set /a "xcnt=!xSt:~-4!, ycnt=!ySt:~-4!, hei=!hSt:~-4!, istep=!iSt:~-4!"
            set "xSt=!xSt:~0,-4!"
            set "ySt=!ySt:~0,-4!"
            set "hSt=!hSt:~0,-4!"
            set "iSt=!iSt:~0,-4!"
            goto :enter
        ) else (
        REM else
            REM if 本层子计算未完成
            if !istep! lss 14 (
                REM 生成 并更新 下一个(或第1个)子计算 的 参数
                if !istep! geq 0 (
                    REM 还原上层中心坐标
                    for %%i in (!istep!) do set /a "xcnt-=(!xL:~%%i,2! hei/3), ycnt-=(!yL:~%%i,2! hei/3)"
                )
                set /a "istep+=2"
                for %%i in (!istep!) do set /a "xcnt+=(!xL:~%%i,2! hei/3), ycnt+=(!yL:~%%i,2! hei/3)"
                REM 参数入栈
                set "t=!xcnt!   !ycnt!"
                set "xSt=!xSt!!t:~0,4!"
                set "ySt=!ySt!!t:~-4!"
                set "t=!istep!   !hei!"
                set "hSt=!hSt!!t:~-4!"
                set "iSt=!iSt!!t:~0,4!"
                REM 层递进一
                set /a "hei/=3, istep=-2"
                goto :enter
            ) else (
            REM else
                REM if 栈空
                if "!hSt!"=="" (
                    goto :complete
                ) else (
                REM else
                    REM 参数出栈
                    set /a "xcnt=!xSt:~-4!, ycnt=!ySt:~-4!, hei=!hSt:~-4!, istep=!iSt:~-4!"
                    set "xSt=!xSt:~0,-4!"
                    set "ySt=!ySt:~0,-4!"
                    set "hSt=!hSt:~0,-4!"
                    set "iSt=!iSt:~0,-4!"
                    REM goto :enter
                    goto :enter
                )
            )
        )

:complete
echo;!s! &pause &exit

:d
title xcnt=%1, ycnt=%2
set /a "i=%1-xc + (%2-yc) * w + 1, L=i-1"
for /f "tokens=1,2" %%a in ("!L! !i!") do (set s=!s:~0,%%a!#!s:~%%b!)
exit /b
:initCON
@echo off
for %%a in (  FontSize:00080008      FontFamily:00000030  WindowSize:00C800C8
              ScreenColors:0000000f  CodePage:000001b5    ScreenBufferSize:00C800C8
) do for /f "tokens=1,2 delims=:" %%b in ("%%a") do (
  >nul reg add HKCU\Console\Sierpinski_carpet /v %%b /t reg_dword /d 0x%%c /f
)
start "Sierpinski_carpet" /max "%ComSpec%" /c "%~0" REM & (call :delReg) & exit
REM end of :initCON
exit /b

:clearVars
set "Path=%SystemRoot%\system32"
for /f "delims==" %%a in ('set') do (
  if /i "%%a" neq "Path" set "%%a="
)
REM set path=
exit /b
REM end of :clearVars
复制代码

CrLf

说好的 :delReg 去哪了...

a20150604

回复 2# CrLf

第二部也许出吧

dingcool

it is cool~~~~~~~~~