|
Post by tsh73 on Jul 19, 2021 15:48:08 GMT -5
Ha! I didn't knew but I just happen to save some 40 didgits of Pi so it happens to be enough My first attempt ends in fail - I tried to read in BMP but forgot lines are stored top down So I reverted to slow but working function GetPixelValue$(x, y, handle$) 'pi digits 'since I failed with eading BMP directly (lines are stored from below) fileName$="origP.bmp" call GetBmpDimensions fileName$, w,h print w,h '194 69 N=w*h print N '13386 w=w-1 h=h-1 'for single gray line top left
'nomainwin open "test" for graphics_nsb_nf as #gr #gr "trapclose [quit]" #gr "down" '#gr "fill white; flush" #gr "home; posxy cx cy"
loadbmp "bmp", fileName$ #gr, "drawbmp bmp 0 0"
#gr "flush"
pi0$="3.1415926535 8979323846 2643383279 5028841971" pi$="31415926535897932384626433832795028841971"
dim d$(10), d(10) for i = 1 to len(pi$) SCAN d=val(mid$(pi$,i,1)) if d$(d)="" then d$(d)= GetPixelValue$(i, 1, "#gr") print i, d, d$(d), "new" else if d$(d)= GetPixelValue$(i, 1, "#gr") then print i, d, d$(d), "(OK)" else print i, d, d$(d), "NOT OK!!!": end end if end if
next print
open "pi.txt" for output as #2
for j = 1 to h print "line ";j;" of ";h for i = 1 to w SCAN 'if (j-1)*w+i>500 then exit for 'print j, i, (j-1)*w+i, GetPixelValue$(i, j, "#gr") 'print (j-1)*w+i,mid$(pi$,i,1), GetPixelValue$(i, j, "#gr") col$= GetPixelValue$(i, j, "#gr") for k = 0 to 9 if col$=d$(k) then d(k)=d(k)+1: #2, k;:exit for next next 'if (j-1)*w+i>500 then exit for next close #2
print for k = 0 to 9 print k, d(k) next
wait
[quit] timer 0 close #gr end
'Custom functions and subs:
sub GetBmpDimensions fileName$, byref width, byref height open fileName$ for input as #gbd temp$ = input$(#gbd, 24) close #gbd width = asc(mid$(temp$, 19, 1))+asc(mid$(temp$, 20, 1))*256 height = asc(mid$(temp$, 23, 1))+asc(mid$(temp$, 24, 1))*256 end sub
'***************************************************** 'GetPixelValue$ returns a string with the RGB values of the pixel 'in coordinates x and y in window/graphicbox names handle$ (e.g, "#main.graph") function GetPixelValue$(x, y, handle$)
'Grab a 1*1 bitmap #handle$, "getbmp gpv "; x; " "; y; " "; 1; " "; 1
'Save in a bmp file bmpsave "gpv", "getpvaluetemp.bmp"
'Open the file for string input and get it's full contents open "getpvaluetemp.bmp" for input as #gpv s$ = input$(#gpv, lof(#gpv)) close #gpv
'Check if user's display is 32-bit, and read the red-green-blue values 'If display 16 bit, then colors are masked. So some last (3 for red, 2 for green, 3 for blue) bits always 0 'That means that you did not get 255 255 255 for white - (248 252 248) instead. You have to experiment 'otherwise function returns nothing (support for other display types could be added (?)) bpp = asc(mid$(s$, 29, 1)) select case bpp case 32 red = asc(mid$(s$, 69, 1)) green = asc(mid$(s$, 68, 1)) blue = asc(mid$(s$, 67, 1)) case 24 'LBB: 24 bit, no palette red = asc(mid$(s$, 57, 1)) green = asc(mid$(s$, 56, 1)) blue = asc(mid$(s$, 55, 1)) 'print red,green, blue case 16 bytes = asc(mid$( s$, 67, 1)) + 256*asc(mid$( s$, 68, 1)) red = (bytes AND 63488) /256 '0xF800 green = (bytes AND 2016) / 32 * 4 '0x7E0 blue = (bytes AND 31) * 8 '0x1F end select
'concatenate the return value, delete temporary file and free memory GetPixelValue$ = using("###",red)+using("####",green)+using("####",blue) kill "getpvaluetemp.bmp" unloadbmp "gpv" end function
Reading first 40+ pixels and checking it fits Pi 1 3 0 0 255 new 2 1 255 0 0 new 3 4 255 255 0 new 4 1 255 0 0 (OK) 5 5 0 255 255 new 6 9 150 150 80 new 7 2 0 255 0 new 8 6 255 0 255 new 9 5 0 255 255 (OK) 10 3 0 0 255 (OK) 11 5 0 255 255 (OK) 12 8 80 80 80 new 13 9 150 150 80 (OK) 14 7 255 255 255 new 15 9 150 150 80 (OK) 16 3 0 0 255 (OK) 17 2 0 255 0 (OK) 18 3 0 0 255 (OK) 19 8 80 80 80 (OK) 20 4 255 255 0 (OK) 21 6 255 0 255 (OK) 22 2 0 255 0 (OK) 23 6 255 0 255 (OK) 24 4 255 255 0 (OK) 25 3 0 0 255 (OK) 26 3 0 0 255 (OK) 27 8 80 80 80 (OK) 28 3 0 0 255 (OK) 29 2 0 255 0 (OK) 30 7 255 255 255 (OK) 31 9 150 150 80 (OK) 32 5 0 255 255 (OK) 33 0 0 0 0 new 34 2 0 255 0 (OK) 35 8 80 80 80 (OK) 36 8 80 80 80 (OK) 37 4 255 255 0 (OK) 38 1 255 0 0 (OK) 39 9 150 150 80 (OK) 40 7 255 255 255 (OK) 41 1 255 0 0 (OK)
Counting number of occurences for each digits i0 1278 1 1294 2 1306 3 1286 4 1278 5 1352 6 1323 7 1344 8 1327 9 1336
Now, it runs slow, but it creates file pi.txt with just digits. So for graphing I used it In shades of green, 0..9 <=> black..green source picture repainted (193 x 68) remapped to square (114 x 114) woven into square spiral, from center into Archimedes spiral from center Really, there is nothing special in base 10, so "10 shades of green" is pretty random. I would like to see same on base 2 pi, just with black and white. codes 'pi digits 'read from a text file fileName$="pi.txt" open fileName$ for input as #1 pi$=input$(#1, lof(#1)) close #1 print len(pi$) '194 69
WindowWidth=1050:WindowHeight=650 nomainwin open "test" for graphics_nsb_nf as #gr #gr "trapclose [quit]" #gr "down" '#gr "fill white; flush" #gr "home; posxy cx cy" #gr "flush"
w=193 s=5 'uncomment to map on square 'w=int(sqr(193*68)):s=5 notice "w=";w #gr "size ";s for i = 1 to len(pi$) SCAN d=val(mid$(pi$,i,3)) x=(i-1) mod w y=int((i-1)/w) c$= "0 ";int(255*d/9);" 0"'rgb #gr "color ";c$;"; set ";x*s+2/2;" ";y*s+s/2 next #gr "flush"
wait
[quit] timer 0 close #gr end
'Custom functions and subs:
sub GetBmpDimensions fileName$, byref width, byref height open fileName$ for input as #gbd temp$ = input$(#gbd, 24) close #gbd width = asc(mid$(temp$, 19, 1))+asc(mid$(temp$, 20, 1))*256 height = asc(mid$(temp$, 23, 1))+asc(mid$(temp$, 24, 1))*256 end sub
'***************************************************** 'GetPixelValue$ returns a string with the RGB values of the pixel 'in coordinates x and y in window/graphicbox names handle$ (e.g, "#main.graph") function GetPixelValue$(x, y, handle$)
'Grab a 1*1 bitmap #handle$, "getbmp gpv "; x; " "; y; " "; 1; " "; 1
'Save in a bmp file bmpsave "gpv", "getpvaluetemp.bmp"
'Open the file for string input and get it's full contents open "getpvaluetemp.bmp" for input as #gpv s$ = input$(#gpv, lof(#gpv)) close #gpv
'Check if user's display is 32-bit, and read the red-green-blue values 'If display 16 bit, then colors are masked. So some last (3 for red, 2 for green, 3 for blue) bits always 0 'That means that you did not get 255 255 255 for white - (248 252 248) instead. You have to experiment 'otherwise function returns nothing (support for other display types could be added (?)) bpp = asc(mid$(s$, 29, 1)) select case bpp case 32 red = asc(mid$(s$, 69, 1)) green = asc(mid$(s$, 68, 1)) blue = asc(mid$(s$, 67, 1)) case 24 'LBB: 24 bit, no palette red = asc(mid$(s$, 57, 1)) green = asc(mid$(s$, 56, 1)) blue = asc(mid$(s$, 55, 1)) 'print red,green, blue case 16 bytes = asc(mid$( s$, 67, 1)) + 256*asc(mid$( s$, 68, 1)) red = (bytes AND 63488) /256 '0xF800 green = (bytes AND 2016) / 32 * 4 '0x7E0 blue = (bytes AND 31) * 8 '0x1F end select
'concatenate the return value, delete temporary file and free memory GetPixelValue$ = using("###",red)+using("####",green)+using("####",blue) kill "getpvaluetemp.bmp" unloadbmp "gpv" end function
'pi digits 'spiral fileName$="pi.txt" open fileName$ for input as #1 pi$=input$(#1, lof(#1)) close #1 print len(pi$) '194 69
WindowWidth=650:WindowHeight=650 'nomainwin open "test" for graphics_nsb_nf as #gr #gr "trapclose [quit]" #gr "down" '#gr "fill white; flush" #gr "home; posxy cx cy" #gr "flush"
s=5 x=0:y=0 dir=0 l=0
#gr "size ";s
l=0 i=1 d=val(mid$(pi$,i,1)) c$= "0 ";int(255*d/9);" 0"'rgb #gr "color ";c$;"; set ";cx+x*s;" ";cy+y*s while i<len(pi$) SCAN i=i+1 d=val(mid$(pi$,i,1)) k=k+1 select case dir mod 4 case 0:x=x+1 case 1:y=y-1 case 2:x=x-1 case 3:y=y+1 end select if k>l then k=0 dir=dir+1 if dir mod 2 = 0 then l=l+1 end if
c$= "0 ";int(255*d/9);" 0"'rgb ' print i, d, x, y ' if i >20 then exit while #gr "color ";c$;"; set ";cx+x*s;" ";cy+y*s wend #gr "flush"
wait
end
for i = 1 to len(pi$) SCAN d=val(mid$(pi$,i,3)) x=(i-1) mod w y=int((i-1)/w) c$= "0 ";int(255*d/9);" 0"'rgb #gr "color ";c$;"; set ";x*s;" ";y*s next #gr "flush"
wait
[quit] timer 0 close #gr end
'Custom functions and subs:
sub GetBmpDimensions fileName$, byref width, byref height open fileName$ for input as #gbd temp$ = input$(#gbd, 24) close #gbd width = asc(mid$(temp$, 19, 1))+asc(mid$(temp$, 20, 1))*256 height = asc(mid$(temp$, 23, 1))+asc(mid$(temp$, 24, 1))*256 end sub
'***************************************************** 'GetPixelValue$ returns a string with the RGB values of the pixel 'in coordinates x and y in window/graphicbox names handle$ (e.g, "#main.graph") function GetPixelValue$(x, y, handle$)
'Grab a 1*1 bitmap #handle$, "getbmp gpv "; x; " "; y; " "; 1; " "; 1
'Save in a bmp file bmpsave "gpv", "getpvaluetemp.bmp"
'Open the file for string input and get it's full contents open "getpvaluetemp.bmp" for input as #gpv s$ = input$(#gpv, lof(#gpv)) close #gpv
'Check if user's display is 32-bit, and read the red-green-blue values 'If display 16 bit, then colors are masked. So some last (3 for red, 2 for green, 3 for blue) bits always 0 'That means that you did not get 255 255 255 for white - (248 252 248) instead. You have to experiment 'otherwise function returns nothing (support for other display types could be added (?)) bpp = asc(mid$(s$, 29, 1)) select case bpp case 32 red = asc(mid$(s$, 69, 1)) green = asc(mid$(s$, 68, 1)) blue = asc(mid$(s$, 67, 1)) case 24 'LBB: 24 bit, no palette red = asc(mid$(s$, 57, 1)) green = asc(mid$(s$, 56, 1)) blue = asc(mid$(s$, 55, 1)) 'print red,green, blue case 16 bytes = asc(mid$( s$, 67, 1)) + 256*asc(mid$( s$, 68, 1)) red = (bytes AND 63488) /256 '0xF800 green = (bytes AND 2016) / 32 * 4 '0x7E0 blue = (bytes AND 31) * 8 '0x1F end select
'concatenate the return value, delete temporary file and free memory GetPixelValue$ = using("###",red)+using("####",green)+using("####",blue) kill "getpvaluetemp.bmp" unloadbmp "gpv" end function
'pi digits 'square spiral fileName$="pi.txt" open fileName$ for input as #1 pi$=input$(#1, lof(#1)) close #1 print len(pi$) '194 69
WindowWidth=650:WindowHeight=650 nomainwin open "Pi Archimedes spiral" for graphics_nsb_nf as #gr #gr "trapclose [quit]" #gr "down" '#gr "fill white; flush" #gr "home; posxy cx cy" #gr "flush"
s=5 x=0:y=0 dir=0 l=0
#gr "size ";s pi=acs(-1) tau=2*pi
l=0 i=1 d=val(mid$(pi$,i,1)) c$= "0 ";int(255*d/9);" 0"'rgb #gr "color ";c$;"; set ";cx+x*s;" ";cy+y*s a=1 while i<len(pi$) SCAN i=i+1 d=val(mid$(pi$,i,1)) x=a*cos(a)/tau y=0-a*sin(a)/tau a=a+1/a*s
c$= "0 ";int(255*d/9);" 0"'rgb ' print i, d, x, y ' if i >20 then exit while #gr "color ";c$;"; set ";cx+x*s;" ";cy+y*s wend #gr "flush"
wait
end
for i = 1 to len(pi$) SCAN d=val(mid$(pi$,i,3)) x=(i-1) mod w y=int((i-1)/w) c$= "0 ";int(255*d/9);" 0"'rgb #gr "color ";c$;"; set ";x*s;" ";y*s next #gr "flush"
wait
[quit] timer 0 close #gr end
'Custom functions and subs:
sub GetBmpDimensions fileName$, byref width, byref height open fileName$ for input as #gbd temp$ = input$(#gbd, 24) close #gbd width = asc(mid$(temp$, 19, 1))+asc(mid$(temp$, 20, 1))*256 height = asc(mid$(temp$, 23, 1))+asc(mid$(temp$, 24, 1))*256 end sub
'***************************************************** 'GetPixelValue$ returns a string with the RGB values of the pixel 'in coordinates x and y in window/graphicbox names handle$ (e.g, "#main.graph") function GetPixelValue$(x, y, handle$)
'Grab a 1*1 bitmap #handle$, "getbmp gpv "; x; " "; y; " "; 1; " "; 1
'Save in a bmp file bmpsave "gpv", "getpvaluetemp.bmp"
'Open the file for string input and get it's full contents open "getpvaluetemp.bmp" for input as #gpv s$ = input$(#gpv, lof(#gpv)) close #gpv
'Check if user's display is 32-bit, and read the red-green-blue values 'If display 16 bit, then colors are masked. So some last (3 for red, 2 for green, 3 for blue) bits always 0 'That means that you did not get 255 255 255 for white - (248 252 248) instead. You have to experiment 'otherwise function returns nothing (support for other display types could be added (?)) bpp = asc(mid$(s$, 29, 1)) select case bpp case 32 red = asc(mid$(s$, 69, 1)) green = asc(mid$(s$, 68, 1)) blue = asc(mid$(s$, 67, 1)) case 24 'LBB: 24 bit, no palette red = asc(mid$(s$, 57, 1)) green = asc(mid$(s$, 56, 1)) blue = asc(mid$(s$, 55, 1)) 'print red,green, blue case 16 bytes = asc(mid$( s$, 67, 1)) + 256*asc(mid$( s$, 68, 1)) red = (bytes AND 63488) /256 '0xF800 green = (bytes AND 2016) / 32 * 4 '0x7E0 blue = (bytes AND 31) * 8 '0x1F end select
'concatenate the return value, delete temporary file and free memory GetPixelValue$ = using("###",red)+using("####",green)+using("####",blue) kill "getpvaluetemp.bmp" unloadbmp "gpv" end function
|
|
|
Post by tsh73 on Jul 26, 2021 16:04:09 GMT -5
Since Pi digits is pretty random I wonder how it will work if used as direction change Here is random walk with step "s" in radom direction "d=int(rnd(0)*10)" I just wanted it to have visible "recent" part fading into "old" part, could be tweaked more. (Smaller N = faster, bigger N - nice fading effect) Now, only put next digit of Pi intstead of "d" (saved of another computer...)
nomainwin 'open "test" for graphics_nsb_nf as #gr open "test" for graphics_nsb_fs as #gr #gr "down; home; posxy cx cy" #gr "trapclose [quit]" #gr "size 2"
N=30 k = 1000 dim x(k), y(k) pi = acs(-1) ' randomize 0.5 s = 15 x(0)=cx:y(0)=cy for i = 1 to k d=int(rnd(0)*10) a=2*pi*d/10 x(i)=x(i-1)+s*cos(a) y(i)=y(i-1)+s*sin(a) next
for i = 1 to k-N SCAN for j = N-1 to 0 step -1 'c = int(127+128*j/N) 'N: bright. 0: almost white c = int(200-200*j/N) c$=c;" 254 ";c 'print c, ">";c$;"<" #gr "color ";c$ ' #gr "color 100 254 190" #gr "line ";x(i+j);" ";y(i+j);" ";x(i+j-1);" ";y(i+j-1) next 'wait call pause 10 next
wait
[quit] timer 0 close #gr end
sub pause mil t=time$("ms")+mil while time$("ms")<t scan wend [quit] end sub
|
|