Another amazing porting...

Discussion forum for all Windows batch related topics.

Moderator: DosItHelp

Post Reply
Message
Author
einstein1969
Expert
Posts: 941
Joined: 15 Jun 2012 13:16
Location: Italy, Rome

Another amazing porting...

#1 Post by einstein1969 » 25 Oct 2023 02:30

Hi to all,

It's been a long time since I left the dos alone due to my bad health. A year ago I was working on this port and I didn't have the strength to publish it. I have to thank aGerman and others because they allowed me to set the fonts. If you have any suggestions let me know. I also have a version in development which uses convolution to make everything more pleasant.

Code: Select all

echo off & setlocal enableDelayedExpansion

mode CON: COLS=128 LINES=96 & chcp 65001 >nul

call :init_setfont

rem %rem setfont% 3 Lucida Console
%setfont% 3 Consolas

for /F "Tokens=1 delims==" %%v in ('set') do if not %%v==ComSpec if not %%v==Path if not %%v==TMP set "%%v="

call :macros

:: Hide the cursor
<nul set /p "=!ESC![?25l"

set /a "imageSize.Width=128, imageSize.Height=96, H=imageSize.Height-1, L=imageSize.Width-1"

set "c0=255;226;137" & set "c1=233;158;069" & set "c2=165;090;000" & set "c3=000;000;000"

set /A seed = 0x7EC80000, dir=i=0

set max=56475
set tot=0

set "t0=!time: =0!"

(
echo Awo3vi+bBysOPPWbipEbCw69k3i4PrBacLUCgNCxnNIgkyCcPREm1t8Zl/WQo6NH 
echo ivcIWSmtoyx9/A191XowUdQxVCuyQrEUipYpFLDxUywEEwoJPrvpFhh3uOKscoDH
echo UkCNPD6vrWMeFLI9I4/Ae6+dMS6WziWnnjcsRCu5ITk=
) >"%tmp%\s-mon.txt"

certutil -decode "%tmp%\s-mon.txt" "%tmp%\s-mon.bin" >nul

for %%F in ("%tmp%\s-mon.bin") do <nul  >"%tmp%\s-mon.tmp" set /p ".=@" & set ds=%%~zF

for /l %%n in (1,1,32) do if !ds! gtr 1 set /a "ds/=2" & type "%tmp%\s-mon.tmp" >>"%tmp%\s-mon.tmp"

set /a expectedNum=0, d=0
for /F "eol=F usebackq tokens=1,2 skip=1 delims=:[] " %%A in (`fc /b "%tmp%\s-mon.bin" "%tmp%\s-mon.tmp"`) DO (
    set /a num=0x%%A && (
            set /a numDec=num-1
            for /L %%n in (!expectedNum!,1,!numDec!) DO (
		set /a "d=(d+1) %% 2"
		set "s=!s!40"
	        if !d! equ 0 set "s=!s! "
	    )
            set /a "expectedNum=num+1, d=(d+1) %% 2"
            set "s=!s!%%B"
	    if !d! equ 0 set "s=!s! "
    )
)

for %%L in (%s%
) do (

  set /A "seed = (seed & -65536) | 0x%%L, x = 0x%%L & 255, y = (0x%%L >> 8) & 255, len=(64 - i) * 32, i+=1, ic=(i-1) & 3"

  set /a p=tot*100/max
  title Decompressing !p!%%

  For %%C in (!ic!) do For /L %%M in (1,1,!len!) do (
    
    set /A "carry = seed & 0x80000000, seed = (seed << 1) & -1"
                    
   if !carry! gtr 0x80000000 (set /A "seed = seed ^ 0x04C11DB7, dir = seed & 255, dir=dir & 130") else set /A "dir=dir & 130"

    if !dir! equ 0   (set /A "y+=1, y&=127"
    ) else (
    	if !dir! equ 2   (set /A "x+=1, x&=127"
	) else (
    		if !dir! equ 128 (set /A "y-=1, y&=127"
		) else if !dir! equ 130 set /A "x-=1, x&=127"
	)
    )

    if !y! leq 95 if !x! leq 127 (

	set /A "bx=x+1, by=y+1, tot+=1"

	set "color=!c%%C!"
	%Plot% !bx! !by! !color:~0,3! !color:~4,3! !color:~8,3!
    )
  )
)
:next

%difftime%
title Decompressing 100%% elapsed: !td! sec max=!tot!

pause>nul:

goto :eof

::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
rem implemento macro
:macros 

set "Char=█"
rem set "Char=*"


for /F %%a in ('echo prompt $E^| cmd') do set "ESC=%%a"

:: define LF as a Line Feed (newline) character
set ^"LF=^

^" Above empty line is required - do not remove

:: define CR as a Carriage Return character
for /f %%A in ('copy /Z "%~dpf0" nul') do set "CR=%%A"

:: define BS as a BackSpace character
for /f %%A in ('"prompt $H&for %%B in (1) do rem"') do set "BS=%%A"

:: define a newline with line continuation
set ^"\n=^^^%LF%%LF%^%LF%%LF%^^"

::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: macro Plot=Screen.Setpixel X Y R G B

set Plot=for %%# in (1 2) do if %%#==2 (%\n%
           for /f "tokens=1-5 delims=, " %%1 in ("^!args^!") do (%\n%
	       ^<nul set /p "=!ESC![%%2;%%1H!ESC![38;2;%%3;%%4;%%5m!Char!!ESC![0m"%\n%
           )) else set args=

rem %rem Plot% 10 10 150 0 0

::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: Difftime

set gettime=set "t0=^!time: =0^!"

set difftime=for /F "tokens=1-8 delims=:.," %%a in ("^!t0: =0^!:^!time: =0^!") do set /a "td=(((1%%e-1%%a)*60)+1%%f-1%%b)*6000+1%%g%%h-1%%c%%d, td+=(a>>31) & 8640000, td=td/100"

goto :eof

:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::.
:init_setfont
:: - BRIEF -
::  Get or set the console font size and font name.
:: - SYNTAX -
::  %setfont% [fontSize [fontName]]
::    fontSize   Size of the font. (Can be 0 to preserve the size.)
::    fontName   Name of the font. (Can be omitted to preserve the name.)
:: - EXAMPLES -
::  Output the current console font size and font name:
::    %setfont%
::  Set the console font size to 14 and the font name to Lucida Console:
::    %setfont% 14 Lucida Console
setlocal DisableDelayedExpansion
set setfont=for /l %%# in (1 1 2) do if %%#==2 (^
%=% for /f "tokens=1,2*" %%- in ("? ^^!arg^^!") do endlocal^&powershell.exe -nop -ep Bypass -c ^"Add-Type '^
%===% using System;^
%===% using System.Runtime.InteropServices;^
%===% [StructLayout(LayoutKind.Sequential,CharSet=CharSet.Unicode)] public struct FontInfo{^
%=====% public int objSize;^
%=====% public int nFont;^
%=====% public short fontSizeX;^
%=====% public short fontSizeY;^
%=====% public int fontFamily;^
%=====% public int fontWeight;^
%=====% [MarshalAs(UnmanagedType.ByValTStr,SizeConst=32)] public string faceName;}^
%===% public class WApi{^
%=====% [DllImport(\"kernel32.dll\")] public static extern IntPtr CreateFile(string name,int acc,int share,IntPtr sec,int how,int flags,IntPtr tmplt);^
%=====% [DllImport(\"kernel32.dll\")] public static extern void GetCurrentConsoleFontEx(IntPtr hOut,int maxWnd,ref FontInfo info);^
%=====% [DllImport(\"kernel32.dll\")] public static extern void SetCurrentConsoleFontEx(IntPtr hOut,int maxWnd,ref FontInfo info);^
%=====% [DllImport(\"kernel32.dll\")] public static extern void CloseHandle(IntPtr handle);}';^
%=% $hOut=[WApi]::CreateFile('CONOUT$',-1073741824,2,[IntPtr]::Zero,3,0,[IntPtr]::Zero);^
%=% $fInf=New-Object FontInfo;^
%=% $fInf.objSize=84;^
%=% [WApi]::GetCurrentConsoleFontEx($hOut,0,[ref]$fInf);^
%=% If('%%~.'){^
%===% $fInf.nFont=0; $fInf.fontSizeX=0; $fInf.fontFamily=0; $fInf.fontWeight=0;^
%===% If([Int16]'%%~.' -gt 0){$fInf.fontSizeX=[Int16]'%%~.';$fInf.fontSizeY=[Int16]'%%~.'}^
%===% If('%%~/'){$fInf.faceName='%%~/'}^
%===% [WApi]::SetCurrentConsoleFontEx($hOut,0,[ref]$fInf);}^
%=% Else{(''+$fInf.fontSizeY+' '+$fInf.faceName)}^
%=% [WApi]::CloseHandle($hOut);^") else setlocal EnableDelayedExpansion^&set arg=
endlocal &set "setfont=%setfont%"
if !!# neq # set "setfont=%setfont:^^!=!%"
exit /b
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
%===% If([Int16]'%%~.' -gt 0){$fInf.fontSizeY=[Int16]'%%~.'}^
%===% If([Int16]'%%~.' -gt 0){$fInf.fontSizeX=[Int16]'%%~.';$fInf.fontSizeY=[Int16]'%%~.'}^
###############################################################################

PS:There is a little bug in setting the fonts and I hope that aGerman or someone else will help me solve it

PS2: I forgot to mention that it uses fractal compression.
Attachments
port_2_forum.zip
(2.73 KiB) Downloaded 1122 times

IcarusLives
Posts: 161
Joined: 17 Jan 2016 23:55

Re: Another amazing porting...

#2 Post by IcarusLives » 25 Oct 2023 06:28

Hello einstein!

I hope you're doing well. Amazing work as always. Seems to perform really well on my low grade acer laptop.

Thanks for sharing!

P.s I haven't forgotten the 3D rose you wanted to do. Though I still have no idea how to do it, I still think it would be very fun. Cheers!

aGerman
Expert
Posts: 4654
Joined: 22 Jan 2010 18:01
Location: Germany

Re: Another amazing porting...

#3 Post by aGerman » 26 Oct 2023 09:53

einstein1969 wrote:
25 Oct 2023 02:30
PS:There is a little bug in setting the fonts and I hope that aGerman or someone else will help me solve it
I don't get what bug you're talking about. Seems to work on my Win11. (only in Conhost of course, not in Windows Terminal as setting the font programmatically is just not foreseen and will probably never be implemented)

Steffen

einstein1969
Expert
Posts: 941
Joined: 15 Jun 2012 13:16
Location: Italy, Rome

Re: Another amazing porting...

#4 Post by einstein1969 » 26 Oct 2023 10:09

Sorry steffen, it wasn't a bug but a particular behavior on fixed fonts where there were more options like 5x4 and 5x12 and he doesn't know which one to choose.

Maybe it's been fixed and I'm remembering wrong.

Then I'll check better and report it here.

aGerman
Expert
Posts: 4654
Joined: 22 Jan 2010 18:01
Location: Germany

Re: Another amazing porting...

#5 Post by aGerman » 26 Oct 2023 11:19

OK, got you.

Code: Select all

setlocal DisableDelayedExpansion
set setfont=for /l %%# in (1 1 2) do if %%#==2 (^
%=% for /f "tokens=1-3*" %%- in ("? ^^!arg^^!") do endlocal^&powershell.exe -nop -ep Bypass -c ^"Add-Type '^
%===% using System;^
%===% using System.Runtime.InteropServices;^
%===% [StructLayout(LayoutKind.Sequential,CharSet=CharSet.Unicode)] public struct FontInfo{^
%=====% public int objSize;^
%=====% public int nFont;^
%=====% public short fontSizeX;^
%=====% public short fontSizeY;^
%=====% public int fontFamily;^
%=====% public int fontWeight;^
%=====% [MarshalAs(UnmanagedType.ByValTStr,SizeConst=32)] public string faceName;}^
%===% public class WApi{^
%=====% [DllImport(\"kernel32.dll\")] public static extern IntPtr CreateFile(string name,int acc,int share,IntPtr sec,int how,int flags,IntPtr tmplt);^
%=====% [DllImport(\"kernel32.dll\")] public static extern void GetCurrentConsoleFontEx(IntPtr hOut,int maxWnd,ref FontInfo info);^
%=====% [DllImport(\"kernel32.dll\")] public static extern void SetCurrentConsoleFontEx(IntPtr hOut,int maxWnd,ref FontInfo info);^
%=====% [DllImport(\"kernel32.dll\")] public static extern void CloseHandle(IntPtr handle);}';^
%=% $hOut=[WApi]::CreateFile('CONOUT$',-1073741824,2,[IntPtr]::Zero,3,0,[IntPtr]::Zero);^
%=% $fInf=New-Object FontInfo;^
%=% $fInf.objSize=84;^
%=% [WApi]::GetCurrentConsoleFontEx($hOut,0,[ref]$fInf);^
%=% If('%%~.'){^
%===% $fInf.nFont=0; $fInf.fontSizeX=0; $fInf.fontFamily=0; $fInf.fontWeight=0;^
%===% If([Int16]'%%~.' -gt 0){$fInf.fontSizeX=[Int16]'%%~.'}^
%===% If([Int16]'%%~/' -gt 0){$fInf.fontSizeY=[Int16]'%%~/'}^
%===% If('%%~0'){$fInf.faceName='%%~0'}^
%===% [WApi]::SetCurrentConsoleFontEx($hOut,0,[ref]$fInf);}^
%=% Else{(''+$fInf.fontSizeY+' '+$fInf.faceName)}^
%=% [WApi]::CloseHandle($hOut);^") else setlocal EnableDelayedExpansion^&set arg=
endlocal &set "setfont=%setfont%"
if !!# neq # set "setfont=%setfont:^^!=!%"
exit /b
Now you can specify it like so:

Code: Select all

%setfont% 5 12 Lucida Console
Steffen

einstein1969
Expert
Posts: 941
Joined: 15 Jun 2012 13:16
Location: Italy, Rome

Re: Another amazing porting...

#6 Post by einstein1969 » 27 Oct 2023 02:31

thank you steffen,

I will add at the script.

In the main I working at a version that use convolution for blurring the image. Its too slow for release.

it uses the same data.

These are datacoded in base 64. The data in bin format is very low in space. The compression is very high. Even this is data loss mode.

Code: Select all

Awo3vi+bBysOPPWbipEbCw69k3i4PrBacLUCgNCxnNIgkyCcPREm1t8Zl/WQo6NH 
ivcIWSmtoyx9/A191XowUdQxVCuyQrEUipYpFLDxUywEEwoJPrvpFhh3uOKscoDH
UkCNPD6vrWMeFLI9I4/Ae6+dMS6WziWnnjcsRCu5ITk=
I search anyone that work with me for write a program in c or assembler for that part that compress an image. I don't remember very well "c" or intel asm. The program will use graphic engine for speed up the compression phase.

I show the result here even attached png.

Image
Attachments
image1.png
image1.png (57.45 KiB) Viewed 67609 times
Last edited by einstein1969 on 27 Oct 2023 09:33, edited 2 times in total.

miskox
Posts: 553
Joined: 28 Jun 2010 03:46

Re: Another amazing porting...

#7 Post by miskox » 27 Oct 2023 08:27

Amazing.

Regarding your compression: I can't help you but can't you use unzip.exe because you say you could use .exe file?

Saso

einstein1969
Expert
Posts: 941
Joined: 15 Jun 2012 13:16
Location: Italy, Rome

Re: Another amazing porting...

#8 Post by einstein1969 » 27 Oct 2023 09:20

@miskox
I didn't understand what you wrote

The data are 128 bytes and become 172 in coding based on 64.

I don't think those 128 bytes can still be compressed. Maybe yes but I think that the overhead of a compression have the 128bytes exceed. But I did not do evidence. Perhaps with a compression with a fixed dictionary it could work but I wait for the opinion of someone more experienced than me.

However, the image produced is 128x96 with 4 colors (2 bit) = 3072 bytes. That is, it is reduced by 24 times. That is, 95.833% are less. Only 4.166% remains.

The help I asked is in making the algorithm that compresses an image and creates compressed data. In fact, I think that the "fractal" function must also accompany the data produced. So the ratio may not be so high/low.

The algorithm that decompresses uses a random pseudo function. Aacini once wrote something about it. But I couldn't find the thread.

Here is where I quote him https://www.dostips.com/forum/Viewtopi ... 51#p45511
.
Last edited by einstein1969 on 27 Oct 2023 09:24, edited 1 time in total.

einstein1969
Expert
Posts: 941
Joined: 15 Jun 2012 13:16
Location: Italy, Rome

Re: Another amazing porting...

#9 Post by einstein1969 » 27 Oct 2023 09:23

I tried to zip 128 byte but the out.zip is 280 bytes.
Last edited by einstein1969 on 27 Oct 2023 09:36, edited 1 time in total.

einstein1969
Expert
Posts: 941
Joined: 15 Jun 2012 13:16
Location: Italy, Rome

Re: Another amazing porting...

#10 Post by einstein1969 » 27 Oct 2023 09:28

I have found the study that write of this method :

https://www.researchgate.net/publicatio ... sformation

this document explain the algorithm used!
.

einstein1969
Expert
Posts: 941
Joined: 15 Jun 2012 13:16
Location: Italy, Rome

Re: Another amazing porting...

#11 Post by einstein1969 » 27 Oct 2023 10:00

IcarusLives wrote:
25 Oct 2023 06:28
Hello einstein!

I hope you're doing well. Amazing work as always. Seems to perform really well on my low grade acer laptop.

Thanks for sharing!

P.s I haven't forgotten the 3D rose you wanted to do. Though I still have no idea how to do it, I still think it would be very fun. Cheers!
Hi Icarus, the rose is blocked for the moment.

I was implementing the division in batch because it was needed in the most complex calculations such as Exp and Log.

In reality the code was a little long and therefore slow.

But if I get back in health and I feel like it I will do it because, even if slow, the result should be beautiful.

In reality I had already started in 2016-19 I believe to make some black and white experiment and if I find it in my backups I share it here. It is only the first part where only the rose stem is drawn, but it's already something.

PS. the rose is in 3D!!!

miskox
Posts: 553
Joined: 28 Jun 2010 03:46

Re: Another amazing porting...

#12 Post by miskox » 29 Oct 2023 11:53

einstein1969 wrote:
27 Oct 2023 09:20
@miskox
I didn't understand what you wrote

The data are 128 bytes and become 172 in coding based on 64.
How much data you need to compress? Can makecab/expand be useful? Where are you going to store this compressed data?

viewtopic.php?p=14704#p14704
viewtopic.php?p=39196#p39196

More info maybe?

Saso

einstein1969
Expert
Posts: 941
Joined: 15 Jun 2012 13:16
Location: Italy, Rome

Re: Another amazing porting...

#13 Post by einstein1969 » 30 Oct 2023 04:00

Now I think I understand what you meant.

I'm looking at the second link but it doesn't seem right to me.

In reality the compressed data was without encoding and to bring it into the batch file I encoded it in base 64. Did I understand correctly?

miskox
Posts: 553
Joined: 28 Jun 2010 03:46

Re: Another amazing porting...

#14 Post by miskox » 31 Oct 2023 10:13

If you need this data in a file then makecab/expand solution might work for you.

1. Create a .cab file that contains your file.
2. Create a dump of this .cab file (for example with viewtopic.php?p=14361#p14361)
3. And copy/paste the code in viewtopic.php?p=39196#p39196

Hope this helps.
Saso

einstein1969
Expert
Posts: 941
Joined: 15 Jun 2012 13:16
Location: Italy, Rome

Re: Another amazing porting...

#15 Post by einstein1969 » 06 Nov 2023 15:38

Thanks Saso I will keep it present when I will be able to produce a greater amount of data.

Post Reply