|
Post by tenochtitlanuk on Nov 9, 2020 16:46:27 GMT -5
I've been having fun with the ppm P6 images I recently described. Rosetta Code has a whole block of about 8 tasks that create various images with them. Bitmap /Flood fill Bitmap Bitmap /Bresenham's line algorithm Bitmap /Bézier curves /Cubic Bitmap /Bézier curves /Quadratic Bitmap /Histogram Bitmap /Midpoint circle algorithm Bitmap /Write a PPM file I've written code that generates an image file without having to draw it to a graphic window. Everything is written to a 2D array then saved as a file. The file is four lines of ASCII text, separated with chr$( 10), then simply three-bytes for the colour of each successive pixel. It's much simpler than creating a bmp file the same way- BMPs have a huge range of variations, with long preamble sections before you hit the pixel data. This image demonstrates the routines... The great thing is that demensions are up to you- no limit to a graphic window size. And you can add custom functions like the fill which swops background colour for whatever you fancy- here a colour 2D gradient done AFTER drawing the rest of the figure. I'll finish the relevant pages on my site soon..
|
|
|
Post by Carl Gundel on Nov 11, 2020 9:41:10 GMT -5
I've been having fun with the ppm P6 images I recently described. <snip> I'll finish the relevant pages on my site soon.. Cool stuff. Does it also work with LB5?
|
|
|
Post by tenochtitlanuk on Nov 11, 2020 17:35:06 GMT -5
I've spent several hours on trying in LB5 - but keep hitting either bugs or syntax changes with the old way not accepted. eg in the following it happily creates an interesting ppm graphic, but as soon as I de-rem the Bresenham subroutine it errors...
nomainwin
global Width, Height, CR$
Width =400 Height =400 CR$ =chr$( 10)
dim Pix$( Width, Height) ' set up local pixel arrays Px( x, y) holding 'RGB' as 3 bytes) dim Pix( 1000), Piy( 1000) ' hold values in subs for y =0 to Height for x =0 to Width Pix$( x, y) =chr$( min( (x *y) mod 255, 255)) +chr$( 120) +chr$( min( (x *y /100) mod 255, 255)) next x next y
call saveP6 notice "Done!" wait
' ________________________________________________________________________ sub setpixel x, y, r, g, b if x >=0 and x <=Width and y >=0 and y <=Height then Pix$( x, y) =chr$( r) +chr$( g) +chr$( b) end sub
sub saveP6 open "test.ppm" for output as #fOut print #fOut, "P6" +CR$; print #fOut, "# Created by Liberty BASIC" +CR$; print #fOut, str$( Width +1) +" " +str$( Height +1) +CR$; print #fOut, "255" +CR$; for y =Height to 0 step -1 for x =0 to Width print #fOut, Pix$( x, y); next x next y close #fOut end sub
function sgn( x) if x>=0 then sgn =1 else sgn =0 -1 end function
'sub bresenham x1, y1, x2, y2, r, g, b ' dx =abs( x2 -x1): sx =sgn( x2 -x1) ' dy =abs( y2 -y1): sy =sgn( y2 -y1) ' if dx <dy then e =dx /2 else e =dy /2 ' do ' call setpixel x1, y1, r, g, b ' if x1 =x2 then if y1 =y2 then exit do ' if dx >dy then ' x1 =x1 +sx: e =e -dy: if e <0 then e =e +dx: y1 =y1 +sy ' else ' y1 =y1 +sy: e =e -dx: if e <0 then e =e +dy: x1 =x1 +sx ' end if ' loop until 1 =2 'end sub
Should produce the ppm version of this image...
|
|
|
Post by tenochtitlanuk on Nov 12, 2020 19:15:24 GMT -5
LB5 is a bit choosy about nested structures and exiting without crashing if it doesn't like the syntax. It doesn't help that I can't change to a fixed-width font, and it enjoys messing up my pretty-printed formatting!
Anyway, here's a working version which will generate a ppm file with area filling, Bresenham straight lines, and circles. Will add the two Bezier routines asap. Painting programs like GIMP or image-viewers, or web browsers etc will often display these natively, and the painting packages will allow you to resave as 24 bit bitmaps, GIFs, JPGs or whatever you like..
nomainwin global Width, Height, CR$ Width =400 Height =400 CR$ =chr$( 10) dim Pix$( Width, Height) ' set up local pixel arrays Px( x, y) holding 'RGB' as 3 bytes) dim Pix( 1000), Piy( 1000) ' hold values in subs for y =0 to Height for x =0 to Width Pix$( x, y) =chr$( min( (x *y) mod 255, 255)) +chr$( 120) +chr$( min( (x *y /100) mod 255, 255)) next x next y
for K =250 to 100 step -5 call bresenham 100, 100, 400, K, 200, 200, 60 next K
for RR =10 to 150 step 10 call circle 200, 200, RR, 0, 0, 255 next RR call saveP6 notice "Done!" wait ' ________________________________________________________________________ sub setpixel x, y, r, g, b if x >=0 and x <=Width and y >=0 and y <=Height then Pix$( x, y) =chr$( r) +chr$( g) +chr$( b) end sub sub saveP6 open "test.ppm" for output as #fOut print #fOut, "P6" +CR$; print #fOut, "# Created by Liberty BASIC" +CR$; print #fOut, str$( Width +1) +" " +str$( Height +1) +CR$; print #fOut, "255" +CR$; for y =Height to 0 step -1 for x =0 to Width print #fOut, Pix$( x, y); next x next y close #fOut end sub function sgn( x) if x>=0 then sgn =1 else sgn =0 -1 end function ' ________________________________________________________________________ sub circle cx, cy, rd, r, g, b 'LOCAL f, x, y, ddx, ddy f =1 -rd y =rd ddy =0 -2 *rd
call setpixel cx, cy +rd, r, g, b call setpixel cx, cy -rd, r, g, b call setpixel cx +rd, cy, r, g, b call setpixel cx -rd, cy, r, g, b
while x <y if f >=0 then y = y -1 ddy =ddy +2 f =f +ddy end if
x =x +1 ddx =ddx +2 f =f + ddx +1
call setpixel cx +x, cy +y, r, g, b call setpixel cx -x, cy +y, r, g, b call setpixel cx +x, cy -y, r, g, b call setpixel cx -x, cy -y, r, g, b call setpixel cx +y, cy +x, r, g, b call setpixel cx -y, cy +x, r, g, b call setpixel cx +y, cy -x, r, g, b call setpixel cx -y, cy -x, r, g, b wend
end sub
sub bresenham x1, y1, x2, y2, r, g, b dx =abs( x2 -x1): sx =sgn( x2 -x1) dy =abs( y2 -y1): sy =sgn( y2 -y1) if dx <dy then e =dx /2 else e =dy /2 do call setpixel x1, y1, r, g, b if x1 =x2 then if y1 =y2 then exit do end if end if if dx >dy then x1 =x1 +sx: e =e -dy: if e <0 then e =e +dx: y1 =y1 +sy else y1 =y1 +sy: e =e -dx: if e <0 then e =e +dy: x1 =x1 +sx end if loop until 0 end sub
|
|
|
Post by Carl Gundel on Nov 13, 2020 8:55:01 GMT -5
I've spent several hours on trying in LB5 - but keep hitting either bugs or syntax changes with the old way not accepted. eg in the following it happily creates an interesting ppm graphic, but as soon as I de-rem the Bresenham subroutine it errors... Thanks. I'm on it. I'm sure it's some simple bug in the compiler.
|
|
|
Post by tenochtitlanuk on Nov 13, 2020 9:43:33 GMT -5
Doesn't like large numberw of parameters ( 10 or more?). Try this minimal demo. Then knock off the last one in the call and definition...
call bezierquad 10,100,250,270,150,320,40,0,0,1 wait sub bezierquad x1,y1,x2,y2,x3,y3,n,r,g,b end sub
|
|
|
Post by tenochtitlanuk on Nov 13, 2020 10:28:17 GMT -5
Works OK if I keep sub parameters to 9 or less.. nomainwin global Width, Height, CR$, pi Width =400 Height =400 CR$ =chr$( 10) pi =4 *atn( 1) dim Pix$( Width, Height) ' set up local pixel arrays Pix$( x, y) holding 'RGB' as 3 bytes) dim Pix( 1000), Piy( 1000) ' to hold values in subs
' colour gradient background for y =0 to Height for x =0 to Width Pix$( x, y) =chr$( min( (x *y) mod 255, 255)) +chr$( 120) +chr$( min( (x *y /100) mod 255, 255)) next x next y call saveP6 "P0"
call fill 180, 189, 80 for K =250 to 100 step -5 call bresenham 100, 100, 400, K, 0, 0, 160 next K call saveP6 "Pa"
call fill 180, 189, 80 for RR =10 to 150 step 10 call circle 200, 200, RR, 0, 0, 255 next RR call saveP6 "Pb"
call fill 255, 255, 255 radius =100 Ra = 60 for theta =0 to 4 *pi step 0.0003 Xc =int( radius *sin( theta) +300.5) Yc =int( radius *cos( theta) +150.5) radius =Ra *( 2 +sin( theta *5.1)) Ra =Ra *0.999999 call setpixel Xc, Yc, 0, 0, 0 scan next theta call saveP6 "Pc" ' fails
call fill 10, 89, 80 call bezierquad 10,100,250,270,150,320,40 call saveP6 "Pd"
call fill 10, 189, 80 call beziercubic 160, 350, 300, 250, 230, 0, 250, 100, 60 call saveP6 "Pe"
call fill 180, 189, 80 'call histogramAndBandW ' N/A 'call saveP6 "Pf" notice "Done!" wait ' ________________________________________________________________________
sub fill r, g, b for y =0 to Height for x =0 to Width Pix$( x, y) =chr$( r ) +chr$( g) +chr$( b) next x next y end sub
sub setpixel x, y, r, g, b if x >=0 and x <=Width and y >=0 and y <=Height then Pix$( x, y) =chr$( r) +chr$( g) +chr$( b) end sub
sub saveP6 n$ open n$ for output as #fOut print #fOut, "P6" +CR$; print #fOut, "# Created by Liberty BASIC" +CR$; print #fOut, str$( Width +1) +" " +str$( Height +1) +CR$; print #fOut, "255" +CR$; for y =Height to 0 step -1 for x =0 to Width print #fOut, Pix$( x, y); next x next y close #fOut end sub function sgn( x) if x>=0 then sgn =1 else sgn =0 -1 end function ' ________________________________________________________________________ sub circle cx, cy, rd, r, g, b 'LOCAL f, x, y, ddx, ddy f =1 -rd y =rd ddy =0 -2 *rd call setpixel cx, cy +rd, r, g, b call setpixel cx, cy -rd, r, g, b call setpixel cx +rd, cy, r, g, b call setpixel cx -rd, cy, r, g, b while x <y if f >=0 then y = y -1 ddy =ddy +2 f =f +ddy end if x =x +1 ddx =ddx +2 f =f + ddx +1 call setpixel cx +x, cy +y, r, g, b call setpixel cx -x, cy +y, r, g, b call setpixel cx +x, cy -y, r, g, b call setpixel cx -x, cy -y, r, g, b call setpixel cx +y, cy +x, r, g, b call setpixel cx -y, cy +x, r, g, b call setpixel cx +y, cy -x, r, g, b call setpixel cx -y, cy -x, r, g, b wend end sub sub bresenham x1, y1, x2, y2, r, g, b dx =abs( x2 -x1): sx =sgn( x2 -x1) dy =abs( y2 -y1): sy =sgn( y2 -y1) if dx <dy then e =dx /2 else e =dy /2 do call setpixel x1, y1, r, g, b if x1 =x2 then if y1 =y2 then exit do end if end if if dx >dy then x1 =x1 +sx: e =e -dy: if e <0 then e =e +dx: y1 =y1 +sy else y1 =y1 +sy: e =e -dx: if e <0 then e =e +dy: x1 =x1 +sx end if loop until 0 end sub ' _________________________________________________________ sub bezierquad x1,y1,x2,y2,x3,y3,n for i = 0 to n t =i /n t1 =1 -t a =t1^2 b =2 *t *t1 c =t^2 Pix( i) =int( a *x1 +b *x2 +c *x3 +0.5) Piy( i) =int( a *y1 +b *y2 +c *y3 +0.5) next i for i =0 to n -1 call bresenham Pix( i), Piy( i), Pix( i +1), Piy( i +1), r, g, b next i end sub ' ________ sub beziercubic x1, y1, x2, y2, x3, y3, x4, y4, n for i = 0 to n t =i /n t1 =1 -t a =t1^3 b =3 *t *t1^2 c =3 *t^2 *t1 d =t^3 Pix( i) =int( a *x1 +b *x2 +c *x3 +d *x4 +0.5) Piy( i) =int( a *y1 +b *y2 +c *y3 +d *y4 +0.5) next i for i =0 to n -1 call bresenham Pix( i), Piy( i), Pix( i +1), Piy( i +1), r, g, b next i end sub ' ________________________________________________________________________
|
|
|
Post by Rod on Nov 13, 2020 10:28:43 GMT -5
Dedication to a cause, love it. Hope this squashes a bug.
|
|
|
Post by Carl Gundel on Nov 19, 2020 20:37:31 GMT -5
Okay, LB 5 doesn't like this form: if expr then if expr2 then something
if x1 =x2 then if y1 =y2 then print "there"
|
|
|
Post by tenochtitlanuk on Nov 20, 2020 4:45:36 GMT -5
Yup- that's why I changed my nested if/thens to expanded forms...
|
|
|
Post by Rod on Nov 20, 2020 8:36:26 GMT -5
Is that even legal? Not according to the help file and it is not a form I have tried to use.
if a then if b then isn't something I would ever write. So I am not sure we have anything to fix.
But I see LB4 allows it?
a=1 b=1 if a then if b then print "double if!"
|
|
|
Post by Chris Iverson on Nov 20, 2020 13:03:57 GMT -5
By the established syntax of LB, it makes sense to me that it would be legal, but it's not a form I would ever use.
LB allows a single-line IF. IF <condition> THEN <single command>.
IF is a command, and its single-line form counts as a single command.
Therefore IF <condition> THEN IF <condition> THEN <single command> is also valid.
|
|
|
Post by Carl Gundel on Nov 20, 2020 15:04:00 GMT -5
By the established syntax of LB, it makes sense to me that it would be legal, but it's not a form I would ever use. LB allows a single-line IF. IF <condition> THEN <single command>. IF is a command, and its single-line form counts as a single command. Therefore IF <condition> THEN IF <condition> THEN <single command> is also valid. Yeah, it's not unreasonable to expect it to work, but I don't think most people would use that form.
|
|
|
Post by grimblefritz on Nov 20, 2020 16:55:23 GMT -5
Well, if we're listing oddities...
LB is the only BASIC I've encountered that terminates the entirety of a multi-command line if a conditional fails.
a=1 gosub [demo] a=2 gosub [demo] end
[demo] if a=2 then print "two" : print "hello" return
You will get the irrational output of:
|
|
|
Post by Carl Gundel on Nov 20, 2020 20:09:00 GMT -5
Well, if we're listing oddities... LB is the only BASIC I've encountered that terminates the entirety of a multi-command line if a conditional fails. a=1 gosub [demo] a=2 gosub [demo] end
[demo] if a=2 then print "two" : print "hello" return
You will get the irrational output of: How is that irrational? The first time a = 1 and so [demo] prints nothing. The second time a = 2 and so [demo] prints two and then hello.
|
|