Post by tsh73 on Dec 22, 2023 8:33:42 GMT -5
Ok, two mods
First uses big picture (actually 500x506 as was found in the Internet),
named map500_32.bmp
drops interpolating part - simply use color inder trace point.
Really, not much difference. But program got simpler.
First uses big picture (actually 500x506 as was found in the Internet),
named map500_32.bmp
drops interpolating part - simply use color inder trace point.
Really, not much difference. But program got simpler.
'CNC like drawing
'tsh73 Dec 2023
'zig-zag path, drawing with variable white dots on black
'used 100x100 penny dephmap
'googled penny dephmap, resized 100x100, saved as 32 bit
'v5: add intepolating (copied from old fisheye program)
' not bothering to understand how it works
'v6: CNC zigzag path
'v7: change set x y to drawing interpolated point
'v8: use big picture, remove interpolating
'fname$ = "penny.bmp" '32 bit, greyscale, 100x100
fname$ = "map500_32.bmp" '32 bit, greyscale, 500x506
'nomainwin
res$=ckhTile$(fname$)
if res$<>"" then
notice "ERROR "_
+chr$(13)+"ERROR reading ";fname$ _
+chr$(13)+ res$
end
end if
call GetBmpDimensions fname$, width, height
print fname$;" is ";width;" x ";height
open fname$ for input as #bmp
fLen=lof(#bmp)
offSet=fLen-4*width*height
seek #bmp, offSet
bmp$=input$(#bmp, fLen-offSet)
close #bmp
print "fLen", fLen
print "offset", offSet
print "len(bmp$)", len(bmp$)
sz=6
WindowHeight = 40+height
WindowWidth = 10+width
open "test" for graphics_nsb_nf as #gr
#gr "trapclose [quit]"
#gr "home; posxy cx cy"
#gr "down"
#gr "fill black"
#gr "color white"
#gr "size ";sz
lineLen=4*width
dim counter(255, 2)
for i = 1 to 255:counter(i, 1)=i: next
dim b(width+1,height+1) 'color actually 00 BB GG RR, but for grays, take BB
#gr "home"
#gr "backcolor black"
#gr "\Reading bitmap..."
'fill array
for y = 0 to height
for x = 0 to width
SCAN
b(x,height-y)= asc(mid$(bmp$, 2+y*lineLen+x*4, 1))
'print x, y , b(x,y)
next
next
#gr "\Done..."
#gr "cls" 'or leters still visible!
#gr "fill black"
sz2=sz*sqr(2)
x=0
y=int(sz2)
#gr "size 1"
d=1
'move up/ till y <= 0
'move -> for sz2
'move down/ till x<=0
'move down for sz2
'that will be triangle
'upper left triangle
while 1
while y > 0
'#gr "size 1"
'#gr "set ";x;" ";y
gosub [drawInterpolatedDot]
x=x+d:y=y-d
'call pause 50
wend
'#gr "color cyan "
xx=x+sz2
while x < xx
'#gr "set ";x;" ";y
gosub [drawInterpolatedDot]
x=x+d
'call pause 50
wend
'#gr "color pink "
while x > 0
'#gr "set ";x;" ";y
gosub [drawInterpolatedDot]
x=x-d:y=y+d
'call pause 50
wend
'#gr "color yellow "
yy=y+sz2
while y < yy
'#gr "set ";x;" ";y
gosub [drawInterpolatedDot]
y=y+d
'call pause 50
wend
if y >height then exit while
wend
'now same but lower right triangle
while 1
'#gr "color pink"
while x < width
'#gr "set ";x;" ";y
gosub [drawInterpolatedDot]
x=x+d:y=y-d
'call pause 50
wend
'#gr "color cyan "
yy=y+sz2
while y < yy
'#gr "set ";x;" ";y
gosub [drawInterpolatedDot]
y=y+d
'call pause 50
wend
'#gr "color pink "
while y < height
'#gr "set ";x;" ";y
gosub [drawInterpolatedDot]
x=x-d:y=y+d
'call pause 50
wend
'#gr "color yellow "
xx=x+sz2
while x < xx
'#gr "set ";x;" ";y
gosub [drawInterpolatedDot]
x=x+d
'call pause 50
wend
if x >width-2 then exit while '-2 is a crutch against out of array
wend
'notice "Job done"
wait
[drawInterpolatedDot]
'now instead of interpolation, just read b(x,y)
if (x > width) or (y >height) then return 'cut errors
c1=int(b(x,y))
szz=1.4*sz*(c1-50)/206
#gr "size ";szz
if szz>0.5 then 'it looks I got something wrong for negatives
#gr "set ";x;" ";y
end if
return
#gr "flush"
wait
[quit]
close #gr
end
'-----------------------------
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
sub pause mil
t0=time$("ms")
while time$("ms")-t0<mil
scan
wend
end sub
function ckhTile$(fileName$)
'returns error message
open fileName$ for input as #gbd
temp$ = input$(#gbd, 54)
close #gbd
if left$(temp$,2)<>"BM" then
ckhTile$="Not a valid BMP file, check first 10 bytes: "
'_
' +toReadable$(left$(temp$,10))
exit function
end if
bpp = asc(mid$(temp$, 29, 1))+asc(mid$(temp$, 30, 1))*256
'if bpp<>24 then ckhTile$="Expected 24 bpp BMP, got ";bpp
if bpp<>32 then ckhTile$="Expected 32 bpp BMP, got ";bpp
end function