Squares

General FreeBASIC programming questions.
fxm
Posts: 9559
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Postby fxm » Sep 05, 2011 13:30

dodicat wrote:I'm having a devil of a time getting onto the forum, quite often, dead slow and stop.

See this post and the followings:
http://www.freebasic.net/forum/viewtopi ... 762#162762
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Postby rolliebollocks » Sep 05, 2011 19:06

@Dodicat

I fixed the problem. It should be able to eat Tom Sawyer now.
dodicat
Posts: 6390
Joined: Jan 10, 2006 20:30
Location: Scotland

Postby dodicat » Sep 06, 2011 19:22

rolliebollocks wrote:@Dodicat

I fixed the problem. It should be able to eat Tom Sawyer now.

Thanks Rollie, It's ok now.
I've adjusted my own to end on a space:
How many words (approx) would you like to write? ? 50
Start triplet = HEL
P just only cont work looking absural fool. He eyes finglady
this for for slacket, who you id well mout knew chang toms eatin
he now tround. Thers close edge could looked the girl a mated
wishment went you as would with and very so brush cover a new
invity --> FULL RUN

I'm having trouble uploading a code file, 1213 lines doesn't upload, even splitting it into two, I've had to delete much of the code.
Usually my paintstring thing uploads ok, I've used it plenty of times.

Here's my trial upload split.
DATA.BAS

Code: Select all

colour:
DATA _
&HFF0F0F0F,&HFF4E504A,&HFF222320,&HFF6B6D64,&HFF6B6D64,&HFF0F0F0F,&HFF000000,&HFF0F0F0F,_
&HFF919191,&HFF919191,&HFF0F0F0F,&HFF000000,&HFF000000,&HFF636363,&HFF919191,&HFF000000,_
&HFF0F0F0F,&HFF919191,&HFF0F0F0F,&HFF000000,&HFF000000,&HFF919191,&HFF000000,&HFF000000,_
&HFF0F0F0F,&HFF000000,&HFF919191,&HFF000000,&HFF000000,&HFF919191,&HFF000000,&HFF000000,_
&HFF919191,&HFF000000,&HFF000000,&HFF919191,&HFF000000,&HFF636363,&HFF000000,&HFF000000,_
&HFF0F0F0F,&HFF919191,&HFF919191,&HFF000000,&HFF000000,&HFF0F0F0F,&HFF0F0F0F,&HFF919191,_
&HFF000000,&HFF000000,&HFF919191,&HFF0F0F0F,&HFF000000,&HFF919191,&HFF000000,&HFF000000,_
&HFF0F0F0F,&HFF000000,&HFF919191,&HFF000000,&HFF000000,&HFF0F0F0F,&HFF000000,&HFF000000,_
&HFF000000,&HFF919191,&HFF919191,&HFF000000,&HFF0F0F0F,&HFF0F0F0F,&HFF000000,&HFF919191,_
&HFF000000,&HFF000000,&HFF0F0F0F,&HFF0F0F0F,&HFF000000,&HFF000000,&HFF919191,&HFF919191,_
&HFF000000,&HFF000000,&HFF0F0F0F,&HFF000000,&HFF919191,&HFF000000,&HFF000000,&HFF0F0F0F,_
&HFF000000,&HFF919191,&HFF000000,&HFF000000,&HFF000000,&HFF0F0F0F,&HFF0F0F0F,&HFF000000,_
&HFF919191,&HFF0F0F0F,&HFF000000,&HFF000000,&HFF919191,&HFF919191,&HFF000000,&HFF000000,_
&HFF919191,&HFF000000,&HFF000000,&HFF0F0F0F,&HFF000000,&HFF0F0F0F,&HFF000000,&HFF919191,_
&HFF000000,&HFF000000,&HFF919191,&HFF0F0F0F,&HFF000000,&HFF0F0F0F,&HFF000000,&HFF0F0F0F,_
&HFF919191,&HFF000000,&HFF0F0F0F,&HFF0F0F0F,&HFF000000,&HFF919191,&HFF0F0F0F,&HFF000000,_
&HFF919191,&HFF919191,&HFF0F0F0F,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,_
&HFF000000,&HFF000000,&HFF000000,&HFF919191,&HFF000000,&HFF0F0F0F,&HFF919191,&HFF000000,_
&HFF000000,&HFF919191,&HFF000000,&HFF000000,&HFF919191,&HFF919191,&HFF000000,&HFF0F0F0F,_
&HFF919191,&HFF0F0F0F,&HFF0F0F0F,&HFF919191,&HFFD6DAC9,&HFF919191,&HFF000000,&HFF000000,_
&HFF000000,&HFF000000,&HFF919191,&HFF919191,&HFF000000,&HFF000000,&HFF919191,&HFF0F0F0F,_
&HFF000000,&HFF9E9F9B,&HFFDEE1D3,&HFF919191,&HFF0F0F0F,&HFF0F0F0F,&HFF919191,&HFF919191,_
&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF919191,&HFF000000,&HFF0F0F0F,&HFF000000,_
&HFF000000,&HFF919191,&HFF919191,&HFF000000,&HFF000000,&HFF919191,&HFF919191,&HFF0F0F0F,_
&HFF000000,&HFF0F0F0F,&HFF0F0F0F,&HFF000000,&HFF919191,&HFF000000,&HFF000000,&HFF919191,_
&HFF919191,&HFF636363,&HFF919191,&HFF919191,&HFF0F0F0F,&HFF000000,&HFF000000,&HFF919191,_
&HFF919191,&HFF000000,&HFF0F0F0F,&HFF000000,&HFF0F0F0F,&HFF919191,&HFF000000,&HFF000000,_
&HFF919191,&HFF636363,&HFF919191,&HFF000000,&HFF0F0F0F,&HFF919191,&HFF000000,&HFF0F0F0F,_
&HFF0F0F0F,&HFF000000,&HFF0F0F0F,&HFF919191,&HFF0F0F0F,&HFF000000,&HFF919191,&HFF919191,_
&HFF0F0F0F,&HFF000000,&HFF0F0F0F,&HFF919191,&HFF919191,&HFF0F0F0F,&HFF000000,&HFF000000,_
&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,_
&HFF0F0F0F,&HFF0F0F0F,&HFF000000,&HFF0F0F0F,&HFF0F0F0F,&HFF000000,&HFF000000,&HFF919191,_
&HFF919191,&HFF636363,&HFF919191,&HFF0F0F0F,&HFF000000,&HFF0F0F0F,&HFF0F0F0F,&HFF919191,_
&HFF000000,&HFF000000,&HFF919191,&HFF000000,&HFF000000,&HFF919191,&HFF000000,&HFF0F0F0F,_
&HFF919191,&HFF000000,&HFF0F0F0F,&HFF0F0F0F,&HFF000000,&HFF919191,&HFF919191,&HFF000000,_
&HFF000000,&HFF919191,&HFF000000,&HFF000000,&HFF919191,&HFF000000,&HFF000000,&HFF919191,_
&HFF0F0F0F,&HFF000000,&HFF919191,&HFF000000,&HFF0F0F0F,&HFF919191,&HFF000000,&HFF000000,_
&HFF919191,&HFF000000,&HFF000000,&HFF919191,&HFF919191,&HFF000000,&HFF000000,&HFF919191,_
&HFF000000,&HFF0F0F0F,&HFF919191,&HFF000000,&HFF000000,&HFF919191,&HFF000000,&HFF000000,_
&HFF919191,&HFF0F0F0F,&HFF000000,&HFF919191,&HFF000000,&HFF0F0F0F,&HFF919191,&HFF000000,_
&HFF000000,&HFF919191,&HFF0F0F0F,&HFF000000,&HFF000000,&HFF919191,&HFF919191,&HFF000000,_
&HFF000000,&HFF919191,&HFF000000,&HFF000000,&HFF919191,&HFF919191,&HFF0F0F0F,&HFF000000,_
&HFF000000,&HFF000000,&HFF919191,&HFF0F0F0F,&HFF000000,&HFF919191,&HFF919191,&HFF000000,_
&HFF0F0F0F,&HFF000000,&HFF000000,&HFF919191,&HFF919191,&HFF000000,&HFF000000,&HFF000000,_
&HFF000000,&HFF919191,&HFF0F0F0F,&HFF000000,&HFF000000,&HFF000000,&HFF0F0F0F,&HFF919191,_
&HFF919191,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,_
&HFF000000,&HFF000000,&HFF000000,&HFF919191,&HFF0F0F0F,&HFF0F0F0F,&HFF919191,&HFF000000,_
&HFF008000,&HFF000000,&HFF000000,&HFF008000,&HFF000000,&HFF919191,&HFF800000,&HFF800000,_
&HFF000000,&HFF000000,&HFF0F0F0F,&HFF008000,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0F0F0F,_
&HFF800000,&HFF800000,&HFF0000FF,&HFF000000,&HFF000000,&HFF919191,&HFF000000,&HFF008000,_
&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF000000,&HFF0000FF,&HFF0000FF,&HFF000000,&HFF000000,_
&HFF800000,&HFF800000,&HFF800000,&HFF000000,&HFF000000,&HFF0000FF,&HFF0000FF,&HFF000000,_
&HFF000000,&HFF000000,&HFF008000,&HFF008000,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,_
&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF800000,&HFF800000,&HFF800000,&HFF000000,_
&HFF0000FF,&HFF0000FF,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF0F0F0F,_
&HFF000000,&HFF000000,&HFF008000,&HFF008000,&HFF00FF00,&HFF008000,&HFF0000FF,&HFF0000FF,_
&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF800000,_
&HFF800000,&HFF800000,&HFF800000,&HFF000000,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF000000,_
&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF919191,&HFF000000,&HFF0F0F0F,&HFF008000,_
&HFF008000,&HFF008000,&HFF008000,&HFF00FF00,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,_
&HFF0000FF,&HFF0000FF,&HFF000000,&HFF0000FF,&HFF000000,&HFF0000FF,&HFF800000,&HFF800000,_
&HFF800000,&HFF800000,&HFF000000,&HFF0000FF,&HFF0000FF,&HFF000000,&HFF000000,&HFF000000,_
&HFF000000,&HFF000000,&HFF0F0F0F,&HFF000000,&HFF919191,&HFF008000,&HFF008000,&HFF008000,_
&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,_
&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF000000,&HFF0000FF,&HFF0000FF,&HFF000000,&HFF000000,_
&HFF800000,&HFF800000,&HFF000000,&HFF000000,&HFF0000FF,&HFF0000FF,&HFF000000,&HFF000000,_
&HFF000000,&HFF919191,&HFF000000,&HFF000000,&HFF919191,&HFF008000,&HFF00FF00,&HFF008000,_
&HFF008000,&HFF008000,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,_
&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,_
&HFF0000FF,&HFF000000,&HFF800000,&HFF000000,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF000000,_
&HFF919191,&HFF000000,&HFF000000,&HFF919191,&HFF00FF00,&HFF00FF00,&HFF008000,&HFF00FF00,_
&HFF008000,&HFF008000,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,_
&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF000000,&HFF0000FF,_
&HFF000000,&HFF000000,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF800000,&HFF800000,_
&HFF000000,&HFF0F0F0F,&HFF000000,&HFF919191,&HFF919191,&HFF00FF00,&HFF00FF00,&HFF00FF00,_
&HFF00FF00,&HFF008000,&HFF008000,&HFF008000,&HFF008000,&HFF008000,&HFF0000FF,&HFF0000FF,_
&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,_
&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF000000,_
&HFF800000,&HFF800000,&HFF000000,&HFF919191,&HFF000000,&HFF000000,&HFF919191,&HFF919191,_
&HFF000000,&HFF00FF00,&HFF00FF00,&HFF00FF00,&HFF00FF00,&HFF008000,&HFF008000,&HFF008000,_
&HFF008000,&HFF008000,&HFF008000,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,_
&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF000000,_
&HFF000000,&HFF0000FF,&HFF0000FF,&HFF800000,&HFF800000,&HFF800000,&HFF000000,&HFF000000,_
&HFF000000,&HFF919191,&HFF919191,&HFF000000,&HFF00FF00,&HFF00FF00,&HFF00FF00,&HFF00FF00,_
&HFF008000,&HFF008000,&HFF008000,&HFF008000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,_
&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF000000,&HFF0000FF,&HFF0000FF,_
&HFF0000FF,&HFF000000,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF800000,&HFF800000,&HFF800000,_
&HFF800000,&HFF000000,&HFF0F0F0F,&HFF0F0F0F,&HFF000000,&HFF919191,&HFF919191,&HFF000000,_
&HFF00FF00,&HFF00FF00,&HFF00FF00,&HFF00FF00,&HFF008000,&HFF008000,&HFF008000,&HFF008000,_
&HFF000000,&HFF000000,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF000000,&HFF0000FF,&HFF0000FF,_
&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF800000,&HFF800000,&HFF800000,&HFF919191,_
&HFF000000,&HFF0F0F0F,&HFF0F0F0F,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF0F0F0F,_
&HFF919191,&HFF919191,&HFF000000,&HFF00FF00,&HFF00FF00,&HFF00FF00,&HFF00FF00,&HFF00FF00,_
&HFF008000,&HFF008000,&HFF008000,&HFF0000FF,&HFF0000FF,&HFF000000,&HFF0000FF,&HFF0000FF,_
&HFF0000FF,&HFF800000,&HFF800000,&HFF800000,&HFF800000,&HFF800000,&HFF800000,&HFF0F0F0F,_
&HFF000000,&HFF919191,&HFF0F0F0F,&HFF000000,&HFF00FF00,&HFF00FF00,&HFF00FF00,&HFF008000,_
&HFF008000,&HFF008000,&HFF008000,&HFF008000,&HFF0000FF,&HFF0000FF,&HFF0000FF,&HFF0000FF,_
&HFF800000,&HFF800000,&HFF800000,&HFF800000,&HFF800000,&HFF800000,&HFF919191,&HFF000000,_
&HFF000000,&HFF0F0F0F,&HFF00FF00,&HFF00FF00,&HFF00FF00,&HFF00FF00,&HFF008000,&HFF008000,_
&HFF008000,&HFF008000,&HFF000000,&HFF919191,&HFF800000,&HFF000000,&HFF800000,&HFF800000,_
&HFF800000,&HFF800000,&HFF000000,&HFF000000,&HFF919191,&HFF0F0F0F,&HFF000000,&HFF00FF00,_
&HFF00FF00,&HFF00FF00,&HFF00FF00,&HFF008000,&HFF008000,&HFF008000,&HFF008000,&HFF800000,_
&HFF800000,&HFF800000,&HFF800000,&HFF800000,&HFF800000,&HFF000000,&HFF000000,&HFF636363,_
&HFF00FF00,&HFF00FF00,&HFF00FF00,&HFF00FF00,&HFF008000,&HFF008000,&HFF008000,&HFF008000,_
&HFF800000,&HFF800000,&HFF800000,&HFF800000,&HFF800000,&HFF000000,&HFF0F0F0F,&HFF919191,_
&HFF000000,&HFF00FF00,&HFF00FF00,&HFF00FF00,&HFF00FF00,&HFF008000,&HFF008000,&HFF008000,_
&HFF008000,&HFF800000,&HFF800000,&HFF800000,&HFF800000,&HFF000000,&HFF000000,&HFF0F0F0F,_
&HFF919191,&HFF000000,&HFF00FF00,&HFF00FF00,&HFF00FF00,&HFF00FF00,&HFF008000,&HFF008000,_
&HFF008000,&HFF008000,&HFF800000,&HFF800000,&HFF800000,&HFF000000,&HFF000000,&HFF0F0F0F,_
&HFF919191,&HFF000000,&HFF00FF00,&HFF00FF00,&HFF00FF00,&HFF00FF00,&HFF00FF00,&HFF008000,_
&HFF008000,&HFF008000,&HFF008000,&HFF000000,&HFF800000,&HFF0F0F0F,&HFF000000,&HFF919191,_
&HFF000000,&HFF00FF00,&HFF00FF00,&HFF00FF00,&HFF00FF00,&HFF008000,&HFF008000,&HFF008000,_
&HFF008000,&HFF008000,&HFF008000,&HFF000000,&HFF919191,&HFF0F0F0F,&HFF000000,&HFF0F0F0F,_
&HFF919191,&HFF919191,&HFF636363,&HFF919191,&HFF000000,&HFF00FF00,&HFF00FF00,&HFF00FF00,_
&HFF00FF00,&HFF00FF00,&HFF008000,&HFF008000,&HFF008000,&HFF008000,&HFF0F0F0F,&HFF919191,_
&HFF000000,&HFF000000,&HFF919191,&HFF0F0F0F,&HFF000000,&HFF008000,&HFF008000,&HFF00FF00,_
&HFF008000,&HFF00FF00,&HFF00FF00,&HFF008000,&HFF008000,&HFF008000,&HFF008000,&HFF000000,_
&HFF636363,&HFF919191,&HFF000000,&HFF0F0F0F,&HFF919191,&HFF000000,&HFF000000,&HFF008000,_
&HFF008000,&HFF008000,&HFF00FF00,&HFF00FF00,&HFF00FF00,&HFF00FF00,&HFF008000,&HFF008000,_
&HFF008000,&HFF0F0F0F,&HFF919191,&HFF000000,&HFF000000,&HFF919191,&HFF000000,&HFF000000,_
&HFF000000,&HFF00FF00,&HFF008000,&HFF008000,&HFF008000,&HFF00FF00,&HFF00FF00,&HFF008000,_
&HFF008000,&HFF000000,&HFF919191,&HFF000000,&HFF0F0F0F,&HFF0F0F0F,&HFF008000,&HFF000000,_
&HFF000000,&HFF000000,&HFF008000,&HFF008000,&HFF008000,&HFF008000,&HFF008000,&HFF008000,_
&HFF008000,&HFF008000,&HFF0F0F0F,&HFF000000,&HFF636363,&HFF000000,&HFF919191,&HFF000000,_
&HFF008000,&HFF000000,&HFF000000,&HFFFF8040,&HFFFF8040,&HFFFF8040,&HFF00FF00,&HFF008000,_
&HFF008000,&HFF0F0F0F,&HFF636363,&HFF000000,&HFF000000,&HFF919191,&HFF000000,&HFF000000,_
&HFF0F0F0F,&HFF00FF00,&HFF008000,&HFF000000,&HFF000000,&HFFFF8040,&HFFFF8040,&HFFFF8040,_
&HFF000000,&HFF00FF00,&HFF008000,&HFF008000,&HFF0F0F0F,&HFF000000,&HFF0F0F0F,&HFF919191,_
&HFF0F0F0F,&HFF000000,&HFF000000,&HFF000000,&HFF919191,&HFF000000,&HFF00FF00,&HFF008000,_
&HFF008000,&HFFFF8040,&HFFFFFF80,&HFFFF8040,&HFFFF8040,&HFF000000,&HFF000000,&HFF000000,_
&HFF00FF00,&HFF00FF00,&HFF000000,&HFF000000,&HFF000000,&HFF919191,&HFF919191,&HFF0F0F0F,_
&HFF0F0F0F,&HFF919191,&HFF000000,&HFF008000,&HFF008000,&HFF008000,&HFFFF8040,&HFFFF8040,_
&HFFFF8040,&HFFFF8040,&HFF000000,&HFFFF8040,&HFF008000,&HFF000000,&HFF0F0F0F,&HFF000000,_
&HFF919191,&HFF919191,&HFF000000,&HFF008000,&HFF008000,&HFF008000,&HFFFF8040,&HFF0000FF,_
&HFFFF8040,&HFF000000,&HFF000000,&HFFFF8040,&HFFFF8040,&HFF000000,&HFF919191,&HFF000000,_
&HFF0F0F0F,&HFF0F0F0F,&HFF008000,&HFF008000,&HFFFF0000,&HFFFF8040,&HFFFF8040,&HFF0F0F0F,_
&HFF919191,&HFF0F0F0F,&HFF0F0F0F,&HFF919191,&HFF919191,&HFF000000,&HFFFF0000,&HFF000000,_
&HFF000000,&HFF000000,&HFF919191,&HFF919191,&HFF000000,&HFF000000,&HFF000000,&HFF000000,_
&HFF000000,&HFF0F0F0F,&HFF919191,&HFF919191,&HFF0F0F0F,&HFF000000,&HFF000000,&HFF000000,_
&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,_
&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,_
&HFF0F0F0F,&HFF0F0F0F,&HFF0F0F0F,&HFF000000,&HFF0F0F0F,&HFF000000,&HFF000000,&HFF000000,_
&HFF919191,&HFF919191,&HFF000000,&HFF919191,&HFF000000,&HFF919191,&HFF000000,&HFF000000,_
&HFF000000,&HFF0F0F0F,&HFF0F0F0F,&HFF0F0F0F,&HFF000000,&HFF000000,&HFF919191,&HFF000000,_
&HFF262626,&HFF636363,&HFF919191,&HFF000000,&HFF919191,&HFF000000,&HFF000000,&HFF919191,_
&HFF000000,&HFF000000,&HFF0F0F0F,&HFF000000,&HFF000000,&HFF919191,&HFF000000,&HFF000000,_
&HFF000000,&HFF919191,&HFF0F0F0F,&HFF000000,&HFF000000,&HFF000000,&HFF919191,&HFF000000,_
&HFF0F0F0F,&HFF000000,&HFF919191,&HFF0F0F0F,&HFF000000,&HFF000000,&HFF000000,&HFF919191,_
&HFF000000,&HFF919191,&HFF0F0F0F,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,_
&HFF000000,&HFF0F0F0F,&HFF000000,&HFF000000,&HFF919191,&HFF000000,&HFF000000,&HFF919191,_
&HFF000000,&HFF919191,&HFF000000,&HFF000000,&HFF000000,&HFF919191,&HFF000000,&HFF0F0F0F,_
&HFF000000,&HFF919191,&HFF000000,&HFF000000,&HFF919191,&HFF000000,&HFF919191,&HFF0F0F0F,_
&HFF000000,&HFF000000,&HFF919191,&HFF000000,&HFF919191,&HFF000000,&HFF919191,&HFF0F0F0F,_
&HFF000000,&HFF0F0F0F,&HFF919191,&HFF000000,&HFF919191,&HFF0F0F0F,&HFF000000,&HFF0F0F0F,_
&HFF000000,&HFF919191,&HFF0F0F0F,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,_
&HFF919191,&HFF0F0F0F,&HFF000000,&HFF000000,&HFF000000,&HFF919191,&HFF0F0F0F,&HFF000000,_
&HFF000000,&HFF000000,&HFF000000,&HFF919191,&HFF000000,&HFF000000,&HFF000000,&HFF000000,_
&HFF919191,&HFF0F0F0F,&HFF000000,&HFF0F0F0F,&HFF000000,&HFF000000,&HFF000000,&HFF919191,_
&HFF000000,&HFF000000,&HFF0F0F0F,&HFF0F0F0F,&HFF000000,&HFF000000,&HFF804000,&HFF804000,_
&HFF919191,&HFF000000,&HFF000000,&HFF919191,&HFF804000,&HFF804000,&HFF000000,&HFF0F0F0F,_
&HFF804000,&HFF804000,&HFF000000,&HFF000000,&HFF919191,&HFF000000,&HFF000000,&HFF919191,_
&HFF000000,&HFF000000,&HFF0F0F0F,&HFF000000,&HFF000000,&HFF000000,&HFF919191,&HFF000000,_
&HFF000000,&HFF000000,&HFF919191,&HFF000000,&HFF000000,&HFF000000,&HFF919191,&HFF000000,_
&HFF000000,&HFF000000,&HFF919191,&HFF000000,&HFF000000,&HFF000000,&HFF919191,&HFF000000,_
&HFF000000,&HFF0F0F0F,&HFF000000,&HFF919191,&HFF919191,&HFF0F0F0F,&HFF000000,&HFF000000,_
&HFF919191,&HFF000000,&HFF000000,&HFF0F0F0F,&HFF0F0F0F,&HFF000000,&HFF000000,&HFF919191,_
&HFF000000,&HFF000000,&HFF919191,&HFF000000,&HFF000000,&HFF000000,&HFF919191,&HFF000000,_
&HFF919191,&HFF000000,&HFF000000,&HFF919191,&HFF000000,&HFF0F0F0F,&HFF000000,&HFF0F0F0F,_
&HFF919191,&HFF919191,&HFF0F0F0F,&HFF000000,&HFF0F0F0F,&HFF0F0F0F
xpos:
DATA _
0,0,0,0,0,0,1,1,1,1,1,1,2,2,2,2,3,3,3,3,_
4,4,4,5,5,6,6,6,7,7,7,8,8,8,9,9,9,10,10,11,_
11,11,11,11,12,12,13,13,13,14,14,14,15,15,15,16,16,17,17,17,_
18,18,19,19,20,20,20,20,21,21,22,22,22,23,23,24,24,25,25,25,_
25,26,26,27,27,27,28,28,29,29,29,29,29,30,30,30,30,30,30,31,_
31,31,31,31,31,31,32,32,32,32,33,33,33,33,33,33,33,34,34,34,_
34,34,35,35,35,35,35,36,36,36,36,36,36,36,36,36,36,36,36,36,_
36,37,37,37,37,37,37,38,38,38,38,38,38,38,38,38,38,38,38,38,_
38,39,39,39,39,39,39,39,39,39,39,39,39,39,39,39,39,39,39,40,_
40,40,40,40,40,40,40,40,40,40,40,40,40,41,41,41,41,41,41,41,_
41,41,41,41,41,41,42,42,42,42,42,42,42,42,42,43,43,43,43,43,_
43,43,43,44,44,44,44,44,44,45,45,45,45,45,45,45,45,45,45,45,_
45,45,45,45,45,45,45,45,45,45,46,46,47,47,48,48,48,48,48,48,_
49,49,49,49,49,50,50,50,50,50,50,51,51,51,51,51,52,52,52,52,_
52,52,52,53,53,53,53,53,53,54,54,54,54,54,54,55,55,55,55,55,_
55,55,56,56,56,56,56,56,57,57,57,57,57,57,58,58,58,58,58,58,_
59,59,59,59,59,59,59,59,60,60,60,60,60,60,60,60,60,61,61,61,_
61,61,61,61,62,62,62,62,62,62,63,63,63,63,63,64,64,64,64,64,_
64,64,65,65,65,65,65,65,65,65,66,66,66,67,67,67,68,68,68,69,_
69,69,69,69,69,69,69,70,70,70,70,70,70,70,70,70,70,70,70,71,_
71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,72,72,_
72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,_
72,72,73,73,73,73,73,73,73,73,73,73,73,73,73,73,73,73,73,73,_
73,73,73,73,73,73,73,73,73,73,73,74,74,74,74,74,74,74,74,74,_
74,74,74,74,74,74,74,74,74,74,74,74,74,74,74,74,74,74,74,74,_
74,75,75,75,75,75,75,75,75,75,75,75,75,75,75,75,75,75,75,75,_
75,75,75,75,75,75,75,75,75,75,75,75,75,76,76,76,76,76,76,76,_
76,76,76,76,76,76,76,76,76,76,76,76,76,76,76,76,76,76,76,76,_
76,76,76,76,77,77,77,77,77,77,77,77,77,77,77,77,77,77,77,77,_
77,77,77,77,77,77,77,77,77,77,77,77,77,77,77,77,77,78,78,78,_
78,78,78,78,78,78,78,78,78,78,78,78,78,78,78,78,78,78,78,78,_
78,78,78,78,78,78,78,78,78,78,78,78,78,79,79,79,79,79,79,79,_
79,79,79,79,79,79,79,79,79,79,79,79,79,79,79,79,79,79,79,79,_
79,79,79,79,79,79,79,79,80,80,80,80,80,80,80,80,80,80,80,80,_
80,80,80,80,80,80,80,80,80,80,80,80,80,80,80,80,80,80,80,80,_
80,80,80,80,81,81,81,81,81,81,81,81,81,81,81,81,81,81,81,81,_
81,81,81,81,81,81,81,81,81,81,81,81,81,81,81,81,81,81,81,82,_
82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,_
82,82,82,82,83,83,83,83,83,83,83,83,83,83,83,83,83,83,83,83,_
83,83,83,83,83,83,84,84,84,84,84,84,84,84,84,84,84,84,84,84,_
84,84,84,84,84,84,84,85,85,85,85,85,85,85,85,85,85,85,85,85,_
85,85,85,85,86,86,86,86,86,86,86,86,86,86,86,86,86,86,86,86,_
86,87,87,87,87,87,87,87,87,87,87,87,87,87,87,87,87,87,88,88,_
88,88,88,88,88,88,88,88,88,88,88,88,88,88,89,89,89,89,89,89,_
89,89,89,89,89,89,89,89,89,90,90,90,90,90,90,90,90,90,90,90,_
90,90,90,90,90,90,90,90,90,91,91,91,91,91,91,91,91,91,91,91,_
91,91,91,91,92,92,92,92,92,92,92,92,92,92,92,92,92,92,92,92,_
92,92,93,93,93,93,93,93,93,93,93,93,93,93,93,93,93,93,93,94,_
94,94,94,94,94,94,94,94,94,94,94,94,94,94,95,95,95,95,95,95,_
95,95,95,95,95,95,95,95,95,95,95,95,96,96,96,96,96,96,96,96,_
96,96,96,96,96,96,96,96,96,97,97,97,97,97,97,97,97,97,97,97,_
97,97,97,97,97,97,97,97,97,97,98,98,98,98,98,98,98,98,98,98,_
98,98,98,98,98,98,98,98,98,98,98,99,99,99,99,99,99,99,99,99,_
99,99,99,99,99,99,99,100,100,100,100,100,100,100,100,100,100,100,100,100,_
100,100,101,101,101,101,101,101,101,101,101,101,101,101,102,102,102,102,102,102,_
102,103,103,103,103,103,103,103,103,103,103,103,103,103,103,103,103,103,103,103,_
103,103,103,103,104,104,104,104,104,105,105,105,105,105,105,106,106,106,106,106,_
106,106,106,107,107,107,108,108,108,108,108,108,109,109,109,109,109,109,110,110,_
110,110,110,111,111,111,111,112,112,112,112,112,113,113,113,113,114,114,114,114,_
114,114,115,115,115,115,115,115,115,115,115,115,115,116,116,116,116,116,117,117,_
117,117,117,118,118,118,118,119,119,119,119,120,120,120,120,120,120,121,121,121,_
121,121,122,122,122,122,122,122,122,122,122,123,123,123,123,123,123,123,124,124,_
124,124,124,125,125,125,125,125,125,125,126,126,126,126,126,127,127,127,127,128,_
128,128,129,129,129,129,130,130,130,131,131,131,131,131,132,132,132,132,132,133,_
133,133,133,134,134,134,135,135,135,135,136,136,136,137,137,137,137,138,138,138,_
138,139,139,139,139,140,140,140,140,141,141,141,141,141,142,142,142,142,142,143,_
143,143,143,143,144,144,144,144,144,145,145,145,145,146,146,146,146,146,147,147,_
147,147,148,148,148,148,148,148,149,149
ypos:
DATA _
35,36,37,38,39,40,33,34,35,40,41,42,32,33,42,43,33,43,44,45,_
33,45,46,33,46,33,46,47,33,34,47,34,35,47,35,36,47,36,47,34,_
35,36,46,47,34,46,34,45,46,33,34,45,33,44,45,33,44,33,43,44,_
33,43,33,43,33,34,42,43,34,42,34,41,42,34,41,34,41,33,34,40,_
41,33,40,33,39,40,33,39,33,38,39,55,56,33,38,55,56,57,58,32,_
33,37,38,55,58,59,32,37,55,59,32,33,37,55,59,60,61,33,37,55,_
61,62,33,37,54,55,62,32,33,37,38,39,40,41,42,43,44,45,54,62,_
63,32,45,46,54,63,64,31,32,46,47,54,59,60,61,62,63,64,65,68,_
69,30,31,47,48,53,54,59,62,63,64,65,66,67,68,69,70,74,75,30,_
48,49,53,59,63,64,70,71,73,74,75,76,77,30,49,52,53,59,64,65,_
71,72,73,77,78,79,29,30,49,50,52,59,65,79,80,29,50,51,52,59,_
65,80,81,29,59,63,64,65,81,28,29,59,60,61,62,63,69,70,71,72,_
73,74,75,76,77,78,79,80,81,82,28,69,28,69,27,28,64,65,66,69,_
27,64,66,69,70,27,63,64,66,67,70,27,62,63,67,70,26,27,61,62,_
67,70,71,26,60,61,67,68,71,26,59,60,68,71,72,26,58,59,68,69,_
72,73,26,57,58,69,73,74,26,56,57,69,70,74,26,55,56,70,74,75,_
26,53,54,55,70,71,75,76,26,52,53,71,72,76,77,78,79,26,27,52,_
72,73,79,80,27,52,73,74,80,81,27,52,74,75,81,27,52,75,76,77,_
81,82,27,52,77,78,79,80,81,82,27,28,52,28,52,53,13,28,53,13,_
28,29,30,31,39,40,53,13,14,16,17,29,30,31,39,40,41,53,54,13,_
14,15,16,17,18,19,20,29,30,31,32,36,37,38,39,40,41,54,12,14,_
15,16,17,18,19,20,21,22,30,31,32,36,37,38,39,41,42,43,45,54,_
83,84,11,12,13,14,15,16,17,18,19,20,21,22,23,30,31,32,33,35,_
36,37,38,39,42,43,44,45,54,55,83,11,12,13,14,15,16,17,18,19,_
20,21,22,23,24,25,30,31,32,33,34,35,36,37,38,41,43,44,55,82,_
83,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,30,_
31,32,33,34,35,36,41,43,44,55,56,81,82,10,11,12,13,14,15,16,_
17,18,19,20,21,22,23,24,25,26,27,28,29,30,32,33,34,35,36,42,_
56,57,80,81,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,_
26,27,28,29,30,31,32,33,34,35,36,37,41,57,79,80,84,9,10,11,_
12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,_
32,33,34,35,36,37,40,57,58,78,79,83,84,9,10,11,12,13,14,15,_
16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,_
36,37,39,58,77,78,82,83,9,10,11,12,13,14,15,16,17,18,19,20,_
21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,58,69,_
76,77,81,82,9,10,11,12,13,14,15,16,17,18,23,24,26,27,28,29,_
30,31,32,33,34,35,36,58,59,69,70,71,72,73,74,75,76,80,81,9,_
10,11,12,13,14,15,16,25,27,28,29,30,31,32,33,34,35,36,37,59,_
69,78,79,80,9,10,11,12,13,14,15,16,27,28,29,30,31,32,33,34,_
35,36,59,60,69,78,9,10,11,12,13,14,15,16,29,30,31,32,33,34,_
35,36,60,69,76,77,78,9,10,11,12,13,14,15,16,29,30,31,32,33,_
34,60,69,76,9,10,11,12,13,14,15,16,29,30,31,32,33,60,69,76,_
77,9,10,11,12,13,14,15,16,29,30,31,32,60,67,68,69,77,9,10,_
11,12,13,14,15,16,29,30,31,60,65,66,67,77,9,10,11,12,13,14,_
15,16,17,29,30,60,64,65,77,9,10,11,12,13,14,15,16,17,18,29,_
60,61,62,63,64,71,72,73,77,10,11,12,13,14,15,16,17,18,29,70,_
71,73,74,77,7,9,10,11,12,13,14,15,16,17,18,28,29,69,70,74,_
77,78,8,9,10,11,12,13,14,15,16,17,18,29,68,69,74,75,78,7,_
8,9,10,11,12,15,16,17,18,29,67,68,75,78,5,6,7,8,9,10,_
12,13,15,16,17,18,21,29,67,75,78,79,5,6,7,8,9,10,16,17,_
18,21,22,23,29,67,68,75,79,4,5,6,7,8,9,10,11,16,17,18,_
22,23,29,68,69,70,71,72,79,80,4,5,6,7,8,9,10,11,12,16,_
17,18,22,23,28,29,72,73,74,75,80,4,5,6,7,8,9,10,11,17,_
18,22,23,27,28,79,80,4,5,6,7,8,9,10,11,17,18,22,23,24,_
27,79,5,6,9,17,18,22,24,25,26,27,78,79,9,17,18,21,22,77,_
78,16,17,18,19,20,21,61,62,63,64,65,66,67,68,69,70,71,72,73,_
74,75,76,77,16,17,18,19,61,16,17,18,19,20,61,15,16,17,18,19,_
20,60,61,15,20,60,13,15,20,21,59,60,13,14,15,21,58,59,12,13,_
21,22,58,12,22,57,58,12,22,55,56,57,12,22,54,55,12,22,51,52,_
53,54,11,12,22,44,45,46,47,48,49,50,51,11,22,23,43,44,10,11,_
23,42,43,10,23,41,42,10,23,40,41,9,10,23,38,39,40,8,9,23,_
37,38,4,5,6,7,8,23,35,36,37,5,23,31,32,33,34,35,5,23,_
29,30,31,5,23,25,26,27,28,29,5,22,23,24,25,5,6,22,23,6,_
22,23,6,7,22,23,7,22,23,7,12,13,22,23,7,8,12,13,23,8,_
12,13,23,8,9,23,9,10,23,24,10,23,24,10,11,23,24,11,12,23,_
24,12,13,23,24,13,14,23,24,14,15,22,23,24,15,16,24,25,26,16,_
17,21,24,26,17,19,24,26,27,17,18,23,27,18,19,24,26,27,19,20,_
23,26,20,21,22,24,25,26,22,24

And the code:

Code: Select all


#include "data.bas"
#include "fbgfx.bi"
screen 20,32,1, fb.GFX_ALPHA_PRIMITIVES
dim shared as integer xres,yres
screeninfo xres,yres
Dim Shared np(1 To 4) As Double
Sub rotate(Byval pivot_x As Double,_   
    Byval pivot_y As Double,_
    Byval first_x As Double,_   
    Byval first_y As Double,_
    Byval second_x As Double, _ 
    Byval second_y As Double, _   
    byval arc_1 as double,_       
    byval arc_2 as double,_
    Byval angle As Double, _   
    Byval magnifier As Double,_
    Byval dilator as double,_
    Byval colour As Integer,_
    byval thickness as double,_
    Byref shape As String,_
    image as any pointer=0)
    shape=lcase$(shape)     
    Dim p As Double = 4*Atn(1)  '(pi)
    Dim radians As Double
    Dim line_xvector As Double
    Dim line_yvector As Double
    Dim pivot_xvector As Double
    Dim pivot_yvector As Double
    Dim th As Double
    th=thickness
    Dim sx As Double=second_x
    angle=angle mod 360
    radians=(2*p/360)*angle   
    #Macro thickline(t)
    Dim As Double s,h,c
    Dim As Uinteger prime=rgb(255,255,255)
    h=Sqr(((np(1))-(np(3)))^2+((np(2))-(np(4)))^2)
    s=((np(4))-np(2))/h
    c=(np(1)-(np(3)))/h
    line image, (np(3)+s*t/2,np(4)+c*t/2)-(np(1)+s*t/2,np(2)+c*t/2),prime
    line image, (np(3)-s*t/2,np(4)-c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),prime
    line image, (np(3)+s*t/2,np(4)+c*t/2)-(np(3)-s*t/2,np(4)-c*t/2),prime
    line image, (np(1)+s*t/2,np(2)+c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),prime
    paint image,((np(3)+np(1))/2, (np(4)+np(2))/2),prime,prime
   
    line image, (np(3)+s*t/2,np(4)+c*t/2)-(np(1)+s*t/2,np(2)+c*t/2),colour
    line image, (np(3)-s*t/2,np(4)-c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),colour
    line image, (np(3)+s*t/2,np(4)+c*t/2)-(np(3)-s*t/2,np(4)-c*t/2),colour
    line image, (np(1)+s*t/2,np(2)+c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),colour
    paint image,((np(3)+np(1))/2, (np(4)+np(2))/2), colour, colour
    #EndMacro
   
    #macro thickcircle(t)
    Dim As Uinteger prime=rgb(255,255,255)
    dim as double xp1,xp2,yp1,yp2
    dim arc1 as double=arc_1*p/180
    dim arc2 as double=arc_2*p/180
    arc1=2*p+(arc1-(radians))
    arc2=2*p+(arc2-(radians))
    sx=sx*magnifier
    if arc1=arc2 then
        circle image,(np(3),np(4)),sx+t/2,prime,,,second_y
        circle image,(np(3),np(4)),sx-t/2,prime,,,second_y
        paint image,(np(3),np(4)+sx),prime,prime
        paint image,(np(3)+sx,np(4)),prime,prime
        circle image,(np(3),np(4)),sx+t/2,colour,,,second_y
        circle image,(np(3),np(4)),sx-t/2,colour,,,second_y
        paint image,(np(3),np(4)+sx),colour,colour
        paint image,(np(3)+sx,np(4)),colour,colour
    end if
    if arc1<>arc2 then
        xp1=np(3)+(sx)*cos(.5*(arc2+arc1))
        yp1=np(4)-(sx)*sin(.5*(arc2+arc1))
        circle image,(np(3),np(4)),sx+t/2,prime,arc1,arc2,second_y
        circle image,(np(3),np(4)),sx-t/2,prime,arc1,arc2,second_y
        line image,(np(3)+(sx+t/2)*cos(arc1),np(4)-(sx+t/2)*sin(arc1))-(np(3)+(sx-t/2)*cos(arc1),np(4)-(sx-t/2)*sin(arc1)),prime
        line image,(np(3)+(sx+t/2)*cos(arc2),np(4)-(sx+t/2)*sin(arc2))-(np(3)+(sx-t/2)*cos(arc2),np(4)-(sx-t/2)*sin(arc2)),prime
       
        paint image,(xp1,yp1),prime,prime
       
        circle image,(np(3),np(4)),sx+t/2,colour,arc1,arc2,second_y
        circle image,(np(3),np(4)),sx-t/2,colour,arc1,arc2,second_y
        line image,(np(3)+(sx+t/2)*cos(arc1),np(4)-(sx+t/2)*sin(arc1))-(np(3)+(sx-t/2)*cos(arc1),np(4)-(sx-t/2)*sin(arc1)),colour
        line image,(np(3)+(sx+t/2)*cos(arc2),np(4)-(sx+t/2)*sin(arc2))-(np(3)+(sx-t/2)*cos(arc2),np(4)-(sx-t/2)*sin(arc2)),colour
       
        paint image,(xp1,yp1),colour,colour
       
    end if
    #endmacro
    magnifier=dilator*magnifier     
    pivot_xvector=first_x-pivot_x
    pivot_yvector=first_y-pivot_y
    pivot_xvector=dilator*pivot_xvector 
    pivot_yvector=dilator*pivot_yvector
    Dim mover(1 To 2,1 To 2) As Double
    Dim new_pos(1 To 2) As Double
    mover(1,1)=Cos(radians)
    mover(2,2)=Cos(radians)
    mover(1,2)=-Sin(radians)
    mover(2,1)=Sin(radians)
    line_xvector=magnifier*(second_x-first_x)         
    line_yvector=magnifier*(second_y-first_y)             
    new_pos(1)=mover(1,1)*pivot_xvector+mover(1,2)*pivot_yvector +pivot_x
    new_pos(2)=mover(2,1)*pivot_xvector+mover(2,2)*pivot_yvector +pivot_y
    Dim new_one(1 To 2) As Double       
    new_one(1)=mover(1,1)*line_xvector+mover(1,2)*line_yvector +first_x
    new_one(2)=mover(2,1)*line_xvector+mover(2,2)*line_yvector +first_y
    Dim xx As Double   
    Dim yy As Double
    xx=first_x-new_pos(1)
    yy=first_y-new_pos(2)
    np(1)=new_one(1)-xx 
    np(2)=new_one(2)-yy   
    np(3)=first_x-xx
    np(4)=first_y-yy
    Select Case shape
    Case "line"
        If th<2 Then
            line image,(np(3),np(4))-(np(1),np(2)),colour
        Else
            thickline(th)   
        End If
    Case "circle"
        dim arc1 as double=arc_1*p/180
        dim arc2 as double=arc_2*p/180
        if arc1=arc2 then
            If th<=3 Then
                for n as double=magnifier*sx-1 to magnifier*sx+1 step .5
                    circle image,(np(3),np(4)),n,colour,,,second_y       
                next n
            Else
                thickcircle(th)
            End If
            endif
            if arc1<>arc2 then
                If th<=3 Then
                    arc1=2*p+(arc1-(radians))'new
                    arc2=2*p+(arc2-(radians))'new
                    for n as double=magnifier*sx-1 to magnifier*sx+1 step .5
                        circle image,(np(3),np(4)),n,colour,arc1,arc2,second_y   
                    next n
                else
                    thickcircle(th)
                end if
            end if
        Case "circlefill"
            dim as double xp1,xp2,yp1,yp2
            Dim As Uinteger prime=rgb(255,255,255)
            dim arc1 as double=arc_1*p/180
            dim arc2 as double=arc_2*p/180
            if arc1=arc2 then circle image,(np(3),np(4)),magnifier*sx,colour,,,second_y,F
            if arc1<>arc2 then
                xp1=np(3)+magnifier*sx*cos(.5*(arc2+arc1))*3/4
                yp1=np(4)-magnifier*sx*sin(.5*(arc2+arc1))*3/4   
                circle image,(np(3),np(4)),magnifier*sx,prime,arc1,arc2,second_y
                line image,(np(3),np(4))-(np(3)+magnifier*sx*cos(arc2),np(4)-magnifier*sx*sin(arc2)),prime
                line image,(np(3),np(4))-(np(3)+magnifier*sx*cos(arc1),np(4)-magnifier*sx*sin(arc1)),prime
                paint image,(xp1,yp1),prime,prime
                circle image,(np(3),np(4)),magnifier*sx,colour,arc1,arc2,second_y
                line image,(np(3),np(4))-(np(3)+magnifier*sx*cos(arc2),np(4)-magnifier*sx*sin(arc2)),colour
                line image,(np(3),np(4))-(np(3)+magnifier*sx*cos(arc1),np(4)-magnifier*sx*sin(arc1)),colour
                paint image,(xp1,yp1),colour,colour
            end if
            Case"box"
            line image,(np(3),np(4))-(np(1),np(2)),colour,b
        Case "boxfill"
            line image,(np(3),np(4))-(np(1),np(2)),colour,bf
        Case "linepoint","circlepoint"
            'nothing drawn
        Case "linepointset","circlepointset"
            If shape="linepointset" Then
                Pset image,(np(1),np(2)),colour
                Pset image,(np(3),np(4)),colour
                Endif
                If shape="circlepointset" Then
                    Pset image,(np(3),np(4)),colour
                End If
            Case Else
                Print "unknown rotation shape"
            End Select
        End Sub
        dim shared as double next_x,next_y
        sub paintstring(x as double,_
            y as double,_
            s as string,_
            size as double,_
            c as uinteger,_
            line_angle as double=0,_
            char_angle as double=0,_
            thickness_tweak as double=1,_
            image as any pointer=0)
           
            dim l as integer=len(s)
            dim px as double=16*size+x
            y=y+16*size
            dim py as double=y'16*size+y
            dim z as integer=0
            dim th as double
            th=((.5-size)/4.5+5)*thickness_tweak
            dim sp as double=6
            dim sp2 as double=6
            dim pi as double=4*atn(1)
            dim la as double=(line_angle *.5)
            dim ca as double=(char_angle*.5)
            sp2=sp2+30*abs(sin(ca*pi/180-la*pi/180))
            #macro set(x1,y1,x2,y2,sarc,earc,shape,im)
            rotate(px,py,x1,y1,x2,y2,sarc,earc,-char_angle,1,size,c,th*size,shape,im)
            #endmacro
            #macro spaces(xpixels,ypixels)
            px=px+(xpixels*size+sp2*size)*cos(line_angle*pi/180)
            py=py-(ypixels*size+sp2*size)*sin(line_angle*pi/180)
            next_x=px-16*size
            next_y=py-16*size
            #endmacro
            for n as integer=1 to l
               
                select case mid$(s,n,1)
                case " "
                    spaces(30,30)
                case "|"
                    z=z+1
                    px=(x+16*size+z*16*sin(line_angle*pi/180))+1.3*z*(24*size+size*sp*size)*sin(line_angle*pi/180)
                    py=(y+z*16*cos(line_angle*pi/180))+1.3*z*(24*size+size*sp*size)*cos(line_angle*pi/180)
                    next_x=px-16*size
                    next_y=py-16*size
                case "a"
                    set(px-4,py+4,10,1,360,360,"circle",image)
                    set(px+6,py-8,px+6,py+16,.0,.0,"line",image)
                    spaces(26,26)
                case "B"
                    set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert
                    set(px-12,py-14,px-5,py-14,.0,.0,"line",image)'top
                    set(px-12,py+14,px-5,py+14,.0,.0,"line",image)'base
                    set(px-5,py-6,8,1,290,450,"circle",image)'top loop
                    set(px-5,py+6,8,1,270,430,"circle",image)'base loop
                    set(px-12,py,px-2,py,.0,.0,"line",image)'middle
                    spaces(24,24)
                case "b"
                    set(px-2,py+4,10,1,360,360,"circle",image)
                    set(px-12,py-16,px-12,py+16,.0,.0,"line",image)
                    spaces(28,28)
                case "c"
                    set(px-4,py+4,10,1,60,300,"circle",image)
                    spaces(20,20)
                    spaces(30,30)
                case "d"
                    set(px-4,py+4,10,1,360,360,"circle",image)
                    set(px+6,py-16,px+6,py+16,.0,.0,"line",image)
                    spaces(26,26)
                case "e"
                    set(px-4,py+4,10,1,0,320,"circle",image)
                    set(px-12,py+3,px+8,py+3,.0,.0,"line",image)
                    spaces(26,26)
                case "F"
                    set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert
                    set(px-12,py-14,px+6,py-14,.0,.0,"line",image)'top
                    set(px-12,py,px-2,py,.0,.0,"line",image)'middle
                    spaces(24,24)
                case "f"
                    set(px-2,py-8,10,1,0,170,"circle",image)'curve
                    set(px-12,py-10,px-12,py+16,.0,.0,"line",image)'vert
                    set(px-10,py,px-2,py,.0,.0,"line",image)'middle
                    spaces(28,28)
                case "g"
                    set(px-4,py+4,10,1,360,360,"circle",image)
                    set(px+6,py-6,px+6,py+20,.0,.0,"line",image)
                    set(px-4,py+17,10,1,230,345,"circle",image)
                    spaces(26,26)
                case "h"
                    set(px-4,py+2,8,1,0,170,"circle",image)'curve right
                    set(px-12,py-16,px-12,py+16,.0,.0,"line",image)
                    set(px+4,py,px+4,py+16,.0,.0,"line",image)
                    spaces(25,25)
                case "i"
                    set(px-12,py-6,px-12,py+16,.0,.0,"line",image)
                    set(px-12,py-14,1,1,360,360,"circle",image)
                    spaces(10,10)
                case "j"
                    set(px,py-6,px,py+20,.0,.0,"line",image)
                    set(px-7,py+20,7,1,220,360,"circle",image)
                    set(px,py-14,1,1,360,360,"circle",image)
                    spaces(22,22)
                case "K"
                    set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert
                    set(px+6,py-16,px-12,py,.0,.0,"line",image)'upper
                    set(px+6,py+16,px-6,py-3,.0,.0,"line",image)
                    spaces(25,25)
                case "k"
                    set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert
                    set(px+3,py-6,px-12,py,.0,.0,"line",image)'upper
                    set(px,py+16,px-8,py-3,.0,.0,"line",image)'lower
                    spaces(20,20)
                case "L"
                    set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert
                    set(px-12,py+14,px+6,py+14,.0,.0,"line",image)'base
                    spaces(25,25)
                case "l"
                    set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert
                    spaces(10,10)
                case "M"
                    set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert
                    set(px+12,py-16,px+12,py+16,.0,.0,"line",image)'vert
                    set(px-12,py-16,px,py,.0,.0,"line",image)'left arm
                    set(px+12,py-16,px,py,.0,.0,"line",image)'right arm
                    spaces(32,32)
                case "m"
                    set(px-6,py+2,6,1,0,170,"circle",image)'curve left
                    set(px+6,py+2,6,1,0,170,"circle",image)'curve right
                    set(px-12,py-5,px-12,py+16,.0,.0,"line",image)'vert left
                    set(px+12,py,px+12,py+16,.0,.0,"line",image)'vert right
                    set(px,py+16,px,py,.0,.0,"line",image)'mid arm
                    spaces(32,32)
                case "n"
                    set(px-4,py+2,8,1,0,170,"circle",image)'curve right
                    set(px-12,py-5,px-12,py+16,.0,.0,"line",image)'vert left
                    set(px+4,py+16,px+4,py,.0,.0,"line",image)'mid arm
                    spaces(24,24)
                case "o"
                    set(px-4,py+4,10,1,360,360,"circle",image)
                    spaces(26,26)
                case "r"
                    set(px-4,py+4,10,1,30,130,"circle",image)
                    set(px-12,py-8,px-12,py+16,.0,.0,"line",image)
                    spaces(24,24)
                case "s"
                    set(px-4,py+4,10,1,40,140,"circle",image)'top
                    set(px-1,py-4,10,1,180,240,"circle",image)'topslant
                    set(px-6,py+14,10,1,20,100,"circle",image)'baseslant
                    set(px-4,py+4,10,1,220,325,"circle",image)'base
                    spaces(26,26)
                case "t"
                    set(px-12,py-16,px-12,py+10,.0,.0,"line",image)'edge
                    set(px-12,py-4,px-2,py-4,.0,.0,"line",image)
                    set(px-4,py+4,10,1,210,320,"circle",image)
                    spaces (24,24)
                case "y"
                    set(px-4,py+4,8,1,180,380,"circle",image)'top
                    set(px+4,py-6,px+4,py+20,.0,.0,"line",image)'right
                    set(px-6,py+17,10,1,230,345,"circle",image)'base
                    set(px-12,py-6,px-12,py+4,.0,.0,"line",image)'left
                    spaces(24,24)
                case "z"
                    set(px-16,py-4,px+2,py-4,.0,.0,"line",image)'top
                    set(px-16,py+14,px+2,py+14,.0,.0,"line",image)'base
                    set(px+1,py-5,px-14,py+14,.0,.0,"line",image)'slope
                    spaces(20,20)
                end select
            next n
        end sub
        Type pixel_data
            As Integer Xpos,Ypos
            as uinteger colour
        End Type
        Type bow
            As Integer min,max,z
            As Single br,bg,bb,ba
            as single xp,yp
        End Type
        Dim shared As bow r1
        #define Red(c) (CUInt(c) Shr 16 And 255 )
        #define green(c) (CUInt(c) Shr  8 And 255 )
        #define blue(c) (CUInt(c)  And 255 )
        #define alpha(c) (CUInt(c) Shr 24         )
        #define distance(cx,cy,px,py) sqr( (cx-px)*(cx-px)+(cy-py)*(cy-py))
        Function rainbow(p As bow,part as string="outer",im as any pointer) As Uinteger
            Dim As Uinteger r,g,b,col
            Dim As Double gap=(p.max-p.min)/6
            if part="inner" then
                If p.z>=p.min-2*gap And p.z<p.min Then
                    col=point(p.xp,p.yp,im)
                    p.br=red(col)
                    p.bg=green(col)
                    p.bb=blue(col)
                    r=(238-p.br)*(p.z-p.min+2*gap)/(2*gap)+p.br
                    g=(130-p.bg)*(p.z-p.min+2*gap)/(2*gap)+p.bg
                    b=(238-p.bb)*(p.z-p.min+2*gap)/(2*gap)+p.bb
                    Return Rgba(r,g,b,p.ba)
                End If
                If p.z>=p.min And p.z<p.min+gap Then 
                    r=(75-238)*(p.z-p.min)/gap+238               
                    g=-130*(p.z-p.min)/(gap)+130                 
                    b=(130-238)*(p.z-p.min)/gap+238                 
                    Return Rgba(r,g,b,p.ba)
                End If
                If p.z>=p.min+gap And p.z<p.min+2*gap Then
                    r=(0-75)*(p.z-p.min-gap)/gap+75                     
                    g=0
                    b=  (255-130)*(p.z-p.min-gap)/gap+130                   
                    Return Rgba(r,g,b,p.ba)
                End If
                If p.z>=p.min+2*gap And p.z<p.min+3*gap Then
                    r=0                                       
                    g=128*(p.z-p.min-2*gap)/gap '               
                    b=-255*(p.z-p.min-2*gap)/gap+255               
                    Return Rgba(r,g,b,p.ba)
                End If
                If p.z>=p.min+3*gap And p.z<p.min+4*gap Then
                    r=255*(p.z-p.min-3*gap)/gap                   
                    g=(255-128)*(p.z-p.min-3*gap)/gap +128       
                    b=0                                           
                    Return Rgba(r,g,b,p.ba)
                End If
                If p.z>=p.min+4*gap And p.z<p.min+5*gap Then
                    r=255                                             
                    g=(165-255)* (p.z-p.min-4*gap)/gap  +255                 
                    b=0                                                 
                    Return Rgba(r,g,b,p.ba)
                End If
                If p.z>=p.min+5*gap And p.z<p.min+6*gap Then
                    r=255                                                   
                    g=  -165* (p.z-p.min-5*gap)/gap +165                   
                    b=0                                                     
                    Return Rgba(r,g,b,p.ba)
                End If
                If p.z>=p.min+6*gap And p.z<p.min+8*gap Then
                    col=point(p.xp,p.yp,im)
                    p.br=red(col)
                    p.bg=green(col)
                    p.bb=blue(col)
                    r=(p.br-255)*(p.z-p.min-6*gap)/(2*gap)+255
                    g=p.bg*(p.z-p.min-6*gap)/(2*gap)
                    b=p.bb*(p.z-p.min-6*gap)/(2*gap)
                    Return Rgba(r,g,b,p.ba)
                End If
            end if
        End Function
        sub background(im as any pointer)
            paint im,(0,0),rgb(200,200,255)
            for z as integer=0 to yres
                line im,(0,z)-(xres,z),rgba(z/4,z/4,255,80)
            next z
            Dim As Double cx=xres/2,cy=1000
            For x As Integer=0 To xres
                For y As Integer=0 To yres
                    r1.xp=x:r1.yp=y
                    r1.z=distance(cx,cy,x,y)
                    r1.min=600
                    r1.max=620
                    r1.ba=255
                    Pset im,(x,y),rainbow(r1,"inner",im)
                Next y
            Next x
            for z as integer=1 to 20
                paintstring(250+z,500,"FreeBasic",2,rgb(10*z,200-10*z,0),0,0,1,im)
            next z
            paintstring(250,600,"Look at my horse,",1,rgb(0,93,49),0,0,1,im)
            paintstring(250,650,"My horse is amazing.",1,rgb(0,93,49),0,0,1,im)
        end sub
        redim shared as pixel_data a(1350)
        dim shared as integer count
        dim as double magnification
        magnification=  1.7
        dim shared as integer _width,_height
        _width=  257
        _height=  140
        #macro read_data(col,xp,yp)
        restore col
        for z as integer=1 to ubound(a)
            read a(z).colour
        next z
        restore xp
        for z as integer=1 to ubound(a)
            read a(z).xpos
        next z
        restore yp
        for z as integer=1 to ubound(a)
            read a(z).ypos
        next z
        #endmacro
        dim shared as any pointer image(2)
        image(1)=imagecreate(_width,_height)
        image(2)=imagecreate(xres,yres)
        Sub drawbitmap_to_image(scale as single=1,n as integer)
            dim as integer max_x=-1e6,min_x=1e6,max_y=-1e6,min_y=1e6
            dim as single rotx,roty
            #macro magnify(pivotx,pivoty,px,py,scale)
            rotx=scale*(px-pivotx)+pivotx
            roty=scale*(py-pivoty)+pivoty
            #endmacro
            for z as integer=1 to ubound(a)
                magnify(0,0,(a(z).xpos),(a(z).ypos),scale)
                if max_x<rotx then max_x=rotx
                if min_x>rotx then min_x=rotx
                if max_y<roty then max_y=roty
                if min_y>roty then min_y=roty
            next z
            min_x=min_x-scale:max_x=max_x+scale
            min_y=min_y-scale:max_y=max_y+scale
            for z as integer=1 to ubound(a)
                magnify(0,0,(a(z).xpos),(a(z).ypos),scale)
                rotx=rotx-min_x:roty=roty-min_y
                line image(n),(rotx-scale/2,roty-scale/2)-(rotx+scale/2,roty+scale/2),a(z).colour,BF
            next z
        End Sub
        read_data(colour,xpos,ypos) 
        drawbitmap_to_image(magnification,1)
        background(image(2))
        dim as string i
        dim as integer mx,my
        Do
            i=inkey
            getmouse mx,my
            Screenlock
            Cls
            put(0,0),image(2),trans
            put(370+10,226+10),image(1),trans
            Screenunlock
            Sleep 1,1
        Loop Until i=Chr(27)
        imagedestroy image(1)
        imagedestroy image(2)
       
albert
Posts: 5635
Joined: Sep 28, 2006 2:41
Location: California, USA

Postby albert » Sep 06, 2011 21:21

I Got windows 7 (64 bit ) but the INET at my apartment is a MAC network so i haven't been able to get connected, got to find an Apple crossover driver..

I downloaded a Linux Distro called Topologi-Linux and finally got it installed but i can't get internet or sound working and have rebuilt the kernel 4-5 times and it keeps crashing.. I'm thinking on making my own distro and calling it ALOS or A-LOSS (HAHA!!)
dodicat
Posts: 6390
Joined: Jan 10, 2006 20:30
Location: Scotland

Postby dodicat » Sep 06, 2011 22:05

albert wrote:I Got windows 7 (64 bit ) but the INET at my apartment is a MAC network so i haven't been able to get connected, got to find an Apple crossover driver..

I downloaded a Linux Distro called Topologi-Linux and finally got it installed but i can't get internet or sound working and have rebuilt the kernel 4-5 times and it keeps crashing.. I'm thinking on making my own distro and calling it ALOS or A-LOSS (HAHA!!)


Hi Albert
I use PCLINUXOS, it is the only distro that I can find to utilize my speedtouch modem (usb).
I've tried most of the big names, Fedora, Mandriva, Ubunto etc. none of them can handle this silly little modem.
@Richard
I'm trying to convert coloured bitmaps to black and white.
I've followed your duster code, got a packed.bmp, but it wont open with paint.
Maybe I need 16 bit bmp files.
I've done it the ordinary way, well, maybe overdone it.
Just drag a bitmap onto the exe of this code, and GRAY.bmp should appear, your original bitmap is preserved of course.
It works quite well with the 800 X 600 desktop background files, bliss, Autumn etc.

Code: Select all

'Drag a bitmap onto the exe of this file to return black and white
screen 20,32
'from help file
Type bitmap_header Field = 1
    bfType          As UShort
    bfsize          As UInteger
    bfReserved1     As UShort
    bfReserved2     As UShort
    bfOffBits       As UInteger
    biSize          As UInteger
    biWidth         As UInteger
    biHeight        As UInteger
    biPlanes        As UShort
    biBitCount      As UShort
    biCompression   As UInteger
    biSizeImage     As UInteger
    biXPelsPerMeter As UInteger
    biYPelsPerMeter As UInteger
    biClrUsed       As UInteger
    biClrImportant  As UInteger
End Type
type pixel
    as integer x,y
    as uinteger col
    end type
#Define Red(a) ((a shr 16) and 255)
#Define Green(a) ((a shr 8) and 255)
#Define Blue(a) (a and 255)
#define alpha(c) (CUInt(c) Shr 24)
#define GREY(c) rgb(.299*Red(c)+.587*Green(c)+.114*Blue(c),.299*Red(c)+.587*Green(c) +.114*Blue(c),.299*Red(c)+.587*Green(c)+.114*Blue(c))
screen 20,32,1
Dim shared mybitmap As String
dim shared as string outfile
mybitmap=command(1)
outfile="GRAY.bmp"
dim shared as any pointer im

Dim shared bmp_header As bitmap_header
Open mybitmap For Binary As #1
    Get #1, , bmp_header
Close #1

sub load_image
im=imagecreate(bmp_header.biWidth, bmp_header.biHeight)
bload(mybitmap,im)
put(0,0),im
end sub

sub paint_grey_image
    dim as uinteger r,g,b
    redim as pixel colour(0)
    dim as uinteger tempcol
    dim as integer count
    for y as integer=0 to bmp_header.biHeight
        for x as integer=0 to bmp_header.biWidth
            count=count+1
         redim preserve colour(count)
         colour(count)=type<pixel>(x,y,point(x,y,im))
         tempcol=colour(count).col
         r=red(tempcol)
         g=green(tempcol)
         b=blue(tempcol)
         tempcol=grey(rgb(r,g,b))
         colour(count).col=tempcol
         pset (colour(count).x,colour(count).y),colour(count).col
         pset im,(colour(count).x,colour(count).y),colour(count).col
        next x
        next y
    end sub
   
    sub savegrayimage
    bsave (outfile,im)
        end sub
 '_______________________________   
load_image
paint_grey_image
savegrayimage
draw string(100,100),"DONE, New bitmap is GRAY.bmp",rgb(200,200,0)
draw string(100,150),"Press ESC",rgb(200,200,0)
imagedestroy im
Sleep

Richard
Posts: 2999
Joined: Jan 15, 2007 20:44
Location: Australia

Postby Richard » Sep 07, 2011 0:02

@ dodicat.
Sorry I don't have time to analyse the problem immediately. There are subtle differences between BMP formats. Pay careful attention to the pallet dimensions. I wrote and read several 32 x 32 pixel files to test the formats.
I think I relied heavily on http://en.wikipedia.org/wiki/BMP_file_format

Maybe this BMP dump is of some use;

Code: Select all

' ====================================================================
' read in and report details of filename.BMP
' ====================================================================
Dim As String filename = "image1.bmp" '"bmp.bmp"
#include once "file.bi"

' Screen 19
Print
If FileExists(filename) Then
    Print "filename = "; filename
    Print "filesize in bytes ="; FileLen(filename)
Else
    Print "File "; filename; " not found."
    Sleep
    End
End If

Open filename For Binary As #1

'---------------------------------------------------------------------
' BMP header
'---------------------------------------------------------------------
Print
Print "Bytes BMP header contents"

'   2 bytes  file signature = BM = 0x42, 0x4D
Dim As String*2 signature
Get #1,, signature
Print "  2   filetype signature = "; signature
If signature <> "BM" Then
    Print "Incorrect signature, file is not a .bmp file"
    Sleep
    End
End If
'   4 bytes  size of this bmp file in bytes
Dim As Integer BMP_header_size
Get #1,, BMP_header_size
Print "  4   BMP file or header size ="; BMP_header_size

'   2 bytes  application code1
Dim As Short app_code_1
Get #1,, app_code_1
Print "  2   application code 1 ="; app_code_1

'   2 bytes  application code2
Dim As Short app_code_2
Get #1,, app_code_2
Print "  2   application code 2 ="; app_code_2

'   4 bytes  starting address of first bitmap data
Dim As Integer bitmap_start
Get #1,, bitmap_start
Print "  4   bitmap start address="; bitmap_start

'---------------------------------------------------------------------
' Device Independent Bitmap information, use the windows V3 header
'---------------------------------------------------------------------
Print
Print "Bytes DIB header contents"
'   4  size of this header (40 bytes)
Dim As Integer header_size
Get #1,, header_size
Print "  4   DIB header size ="; header_size
If header_size = 40 Then
    Print "      file format used is = Windows V3"
Else
    Select Case header_size
    Case 12
        Print "format is = OS/2 V1"
    Case 64
        Print "format is = OS/2 V2"
    Case 108
        Print "format is = Windows V4"
    Case 124
        Print "format is = Windows V5"
    Case Else
        Print "An unknown format is being used"
    End Select
    Print "This format is not suported."
    Sleep
    End
End If

'   4  bitmap width in pixels (signed integer)
Dim As Integer bitmap_width
Get #1,, bitmap_width
Print "  4   width ="; bitmap_width

'   4  bitmap hight in pixels (signed integer)
Dim As Integer bitmap_height
Get #1,, bitmap_height
Print "  4   height ="; bitmap_height

'   2  number of color planes used (must be one)
Dim As Short color_planes
Get #1,, color_planes
Print "  2   color planes ="; color_planes

'   2  bits per pixel = color depth. typically 1, 4, 8, 16, 24, 32
Dim As Short bits_per_pixel
Get #1,, bits_per_pixel
Print "  2   bits per pixel ="; bits_per_pixel

Dim As Integer horiz_data = bits_per_pixel * bitmap_width ' number of bits
horiz_data = Int((7+horiz_data) /8)     ' bytes needed per row
horiz_data = 4 * Int((3+horiz_data) /4) ' bytes used per row in file
Print "      bytes needed per row ="; horiz_data

'   4  compression method (zero = none)
Dim As Integer compression_method
Get #1,, compression_method
Print "  4   compression method ="; compression_method

'   4  size of the raw bitmap image, not filesize
Dim As Integer bitmap_size
Get #1,, bitmap_size
Print "  4   bitmap size in bytes ="; bitmap_size

'   4  horizontal resolution, pixels per metre, signed integer
Dim As Integer horiz_ppm
Get #1,, horiz_ppm
Print "  4   horizontal pixels per metre ="; horiz_ppm; "   ="; horiz_ppm * 25.4 / 1000; " dpi"

'   4  vertical resolution, pixels per metre, signed integer
Dim As Integer vert_ppm
Get #1,, vert_ppm
Print "  4     vertical pixels per metre ="; vert_ppm; "   ="; vert_ppm * 25.4 / 1000; " dpi"

Dim As Double wideness = 1000 * bitmap_width / horiz_ppm    ' width in mm
Dim As Double highness = 1000 * bitmap_height / vert_ppm    ' height in mm
Print Using "      image size is#####.## mm wide by#####.## mm high"; wideness; highness
Print Using "      image size is####.### inches  by####.### inches "; wideness/25.4; highness/25.4

'---------------------------------------------------------------------
'   4  the number of colors in the color palette, zero defaults to 2^n
Dim As Integer palette_colors
Get #1,, palette_colors
Print "  4   palette colors ="; palette_colors

'   4  number of important colors used, (generally ignored)
Dim As Integer important_colors
Get #1,, important_colors
Print "  4   important colors ="; important_colors

'---------------------------------------------------------------------
' color palette
'---------------------------------------------------------------------
'   number of entries in this table is 2^n or less, (specified in header)
'   each table entry is four bytes RGBX in reversed order
'   table is not used when color depth is greater than 8 bits
'   palette_colors = zero defaults to 2^n if bits_per_pixel <= 8
'---------------------------------------------------------------------
If bits_per_pixel > 8 Then ' no palette is used
    palette_colors = 0
    Print "      no palette is used with colour depth ="; bits_per_pixel
Else
    If palette_colors = 0 Then
        palette_colors = 2 ^ bits_per_pixel
        Print "      palette colors have defaulted to ="; palette_colors
    End If
End If
Print "      palette size in bytes ="; 4 * palette_colors

If palette_colors > 0 Then
    Dim As Integer palette_table(0 To palette_colors - 1)   ' outer scope
    Get #1,, palette_table()   ' read the entire palette table
End If

Sleep
'---------------------------------------------------------------------
' bitmap data
'---------------------------------------------------------------------
'   bottom row first, left to right, then row on row, bottom to top.
Print
If BMP_header_size < 50000 Then
    Dim As String*1 s
    For j As Integer = 1 To bitmap_height
        For i As Integer = 1 To horiz_data
            Get #1,, s
            Print Hex(Asc(s),2);
        Next i
        Print
    Next j
    If Eof(1) Then
        Print "End of file found as expected"
    Else   
        Print "File has an unexpected tail"
        Do While Not Eof(1)
            Get #1,, s
            Print Hex(Asc(s),2);" ";
        Loop
    End If
    Sleep
End If
Close

' ====================================================================
'               E n d    o f    P r o g r a m
' ====================================================================
dodicat
Posts: 6390
Joined: Jan 10, 2006 20:30
Location: Scotland

Postby dodicat » Sep 07, 2011 22:25

Thanks Richard.
In the spirit of Watson Watt, it's about enough to be getting on with.
I've been reading some of the great man's stuff, in that way I get the measure of him, or more explicitly, I have got hold of his tally strings.

How many words (approx) would you like to write? ? 60
Start triplet = ELL
rected powere were us much was lowing could hout km feed to
canning these. Givil time chan image of a difficult theighter
objections of rawn a he operine the let the fried out using the
defeat forcept the radar profestil the rans at which ther a defence
in three of boatson awar ships the my tizards --> FULL RUN

Normally, I would regard these words as Gibberish, but in the case of the great man, I would say these may well have been his actual utterances, late one Saturday night down at the old Red Lion.
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Postby rolliebollocks » Sep 07, 2011 23:34

@Dodicat

Those are great, and so is the horse riding on a rainbow.
dodicat
Posts: 6390
Joined: Jan 10, 2006 20:30
Location: Scotland

Postby dodicat » Sep 10, 2011 19:33

Thanks for the trial Rollie~
I had difficulty posting the large rainbow thing, even splitting it.
You used to be able to post about 1700 lines, but no more it seems.
Perhaps the criterion is size in Kbytes, if so then about 50 is tops.
dodicat
Posts: 6390
Joined: Jan 10, 2006 20:30
Location: Scotland

Postby dodicat » Sep 13, 2011 22:24

Hi all
Squares is very quiet these days, TIME for silly code.
I tried to get a tartan time, but couldn't get my hands on a weaving pattern, so I just made my own MacDodicat, and got LED astray.
If you don't like the tartan here, you can just use any old colour.
Caters for small time and big time.
Or a sizable date.

Code: Select all



Sub digits(t As String,x As Integer,y As Integer,clr As Uinteger,sz As Single,texture As String="",img As Any Pointer=0)
    x=x-sz
    Dim As Integer v,flag
    Dim kk As Single=sz/5
    Dim As String dig(1 To 8)
    dig(1)=Mid(t,1,1)
    dig(2)=Mid(t,2,1)
    dig(3)=Mid(t,4,1)
    dig(4)=Mid(t,5,1)
    dig(5)=Mid(t,7,1)
    dig(6)=Mid(t,8,1)
    dig(7)=Mid(t,9,1)
    dig(8)=mid(t,10,1)
    #macro incircle(cx,cy,radius,x,y)
    (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
    #endmacro
    'MacDodicat
    #define _texture rgb(255*abs(sin(z2/kk)),255*abs(cos(z1/kk)),255*abs(sin(z1/kk))*abs(cos(z2/kk)))
   
    #macro thickline(x1,y1,x2,y2,colour,thickness,image)
    Scope
        Dim As Single b1,b2,b3,b4
        Dim As Any Pointer im=image
        If thickness<2 Then
            Dim As Single cx1,cy1,cx2,cy2
            cx1=x1: cy1=y1: cx2=x2: cy2=y2
            If cx2<cx1 Then Swap cx2,cx1
            If cy2<cy1 Then Swap cy2,cy1
            For z1 As Single=cx1 To cx2
                For z2 As Single=cy1 To cy2
                    If texture<> "" Then Pset im,(z1,z2),_texture
                    If texture= "" Then Pset im,(z1,z2),clr
                Next z2
            Next z1
        Else               
            Dim As Double s,h,c
            h=Sqr((x2-x1)^2+(y2-y1)^2)  'hypotenuse
            If h=0 Then h=1e-6
            s=(y1-y2)/h                 'sine
            c=(x2-x1)/h                 'cosine
            b1=x1+s*thickness/2
            b2=y1+c*thickness/2
            b3=x2-s*thickness/2
            b4=y2-c*thickness/2
            If b4<b2 Then Swap b2,b4
            If b3<b1 Then Swap b1,b3
            For z1 As Single=b1 To b3
                For z2 As Single=b2 To b4
                    If texture<>"" Then Pset im,(z1,z2),_texture
                    If texture="" Then Pset im,(z1,z2),clr
                Next z2
            Next z1
        End If
    End Scope
    #endmacro
    #macro display(_a,_b,_c,_d,_e,_f,_g)
    If flag Then 'the two colons
        For z1 As Single=x+2*sz-sz/5 To x+2*sz+sz/5
            For z2 As Single=y+sz/2-sz/5 To y+sz/2+sz/5
                If incircle((x+2*sz),(y+sz/2),(sz/5),z1,z2) Then
                    If texture<>"" Then Pset img,(z1,z2),_texture
                    If texture="" Then Pset img,(z1,z2),clr
                End If
            Next z2
        Next z1
        For z1 As Single=x+2*sz-sz/5 To x+2*sz+sz/5
            For z2 As Single=y+1.5*sz-sz/5 To y+1.5*sz+sz/5
                If incircle((x+2*sz),(y+1.5*sz),(sz/5),z1,z2) Then
                    If texture<>"" Then Pset img,(z1,z2),_texture
                    If texture="" Then Pset img,(z1,z2),clr
                End If
            Next z2
        Next z1   
        x=x+sz
    End If
    x=x+2*sz
    If _a=1 Then :thickline(x,y,(x+sz),y,clr,(sz/5),img):End If
    If _b=1 Then :thickline((x+sz),y,(x+sz),(y+sz),clr,(sz/5),img):End If
    If _c=1 Then :thickline((x+sz),(y+sz),(x+sz),(y+2*sz),clr,(sz/5),img):End If
    If _d=1 Then :thickline((x+sz),(y+2*sz),x,(y+2*sz),clr,(sz/5),img):End If
    If _e=1 Then :thickline(x,(y+2*sz),x,(y+sz),clr,(sz/5),img):End If
    If _f=1 Then :thickline(x,(y+sz),x,y,clr,(sz/5),img):End If
    If _g=1 Then :thickline(x,(y+sz),(x+sz),(y+sz),clr,(sz/5),img):End If
    #endmacro
    dim as integer ub
    if len(t)=10 then ub=8
    if len(t)=8 then ub=6
    For z As Integer=1 To Ub'ound(dig)
        v=Valint(dig(z))
        Select Case v
        Case 0
            display(1,1,1,1,1,1,0)
        Case 1
            display(0,1,1,0,0,0,0)
        Case 2
            display(1,1,0,1,1,0,1)
        Case 3
            display(1,1,1,1,0,0,1)
        Case 4
            display(0,1,1,0,0,1,1)
        Case 5
            display(1,0,1,1,0,1,1)
        Case 6
            display(1,0,1,1,1,1,1)
        Case 7
            display(1,1,1,0,0,0,0)
        Case 8
            display(1,1,1,1,1,1,1)
        Case 9
            display(1,1,1,1,0,1,1)
        End Select
        If z=2 Or z=4 Then
            flag=1
        Else
            flag=0
        End If
    Next z
End Sub
'_______________________________________________
Screen 19,32

Do
    Screenlock
    Cls
    'DIGITS(time or date,startX,startY,colour,size,optional string if texture is required, optional image)
    digits(time,0,100,0,50,"Texture")
    digits(Time,100,250,0,5,"Texture")
    digits(Time,0,300,Rgb(255,0,200),30,"")
    digits(Time,100,400,Rgb(255,255,255),3)
    digits(date,200,400,Rgb(255,255,255),3)
    digits(date,200,500,0,20,"Texture")
 
    Screenunlock
    Sleep 1,1
Loop Until Inkey=Chr(27)
Sleep
dafhi
Posts: 1335
Joined: Jun 04, 2005 9:51

Postby dafhi » Sep 15, 2011 2:26

pretty cool dodi. I had a crazy idea. There I am using that word again. Anyway, if Unlimited Detail tech is for real, there is the potential for crazy built upon crazy. Faster rendering through masks, for instance.
albert
Posts: 5635
Joined: Sep 28, 2006 2:41
Location: California, USA

Postby albert » Sep 15, 2011 3:40

Heres my "Ghost on a Harley" abstract510.bas

Code: Select all

dim as integer xres,yres
screen 19
screeninfo xres,yres
screenres xres,yres

dim as double c1,c2,s1,s2
dim as double x1,x2,y1,y2
dim as double rad=atn(1)/45
dim as double xctr,yctr,radius=150
dim as double deg1,deg2,span

xctr=xres/2
yctr=yres/2

for deg1 = 0 to 360 step .5
   
    c1=cos(deg1*rad)
    s1=sin(deg1*rad)
   
    for deg2 = 0 to 360 step 2
       
        c2 = cos(deg2*rad)
        s2 = sin(deg2*rad)
       
        x1=radius*c1*c1*cos(c2*c1*s2*deg2*rad*log(deg2*rad*c1))'*1.5
        x2=radius*c2*c1*sin(c2*c1*s2*deg2*rad*log(deg2*c1))'/1.5
       
        y1=radius*s1*c1*sin(s2*c1*s2*deg2*rad*log(deg2*c1))'/1.5
        y2=radius*s2*s1*cos(c2*c1*s2*deg2*rad*log(deg2*rad*c1))'*1.5
       
        pset(xctr+y1+y2,yctr+x1+x2),9
       
    next
   
next

sleep



Although it doesn't quite look like a motorcycle.
albert
Posts: 5635
Joined: Sep 28, 2006 2:41
Location: California, USA

Postby albert » Sep 15, 2011 3:46

I finally got a full 100mbs internet connection!!
I didn't know the apartment complex has wired ethernet..
So now I'm connected!!
dafhi
Posts: 1335
Joined: Jun 04, 2005 9:51

Postby dafhi » Sep 15, 2011 3:52

reminds me of pig guard with food in a basket :)
dodicat
Posts: 6390
Joined: Jan 10, 2006 20:30
Location: Scotland

Postby dodicat » Sep 16, 2011 21:12

dafhi wrote:pretty cool dodi. I had a crazy idea. There I am using that word again. Anyway, if Unlimited Detail tech is for real, there is the potential for crazy built upon crazy. Faster rendering through masks, for instance.


Welcome back Albert.

Hi dafhi
I see that the graphics buffs use screenpointers to speed up Freebasic graphics.
So my next project is to start using this method myself.

I've compared the bressenham method to the screenpointer method, for a screenfill, using the help file example for screenpointer.
I've kept the bressenham as x,y and z directions here, although the z component is unused in this example.
If I convert the bressenham method to screen pointers then that'll be a start.
Fast graphics, I would say in freebasic, must be achieved using pointers, for the screen functions(line, pset etc.) are a bit slow, but easier to use.

(Of course, everybody already knows this!)

So, I'm a bit away from unlimited detail tech at the moment, but I'll be bearing down on it -- soon.

Code: Select all


'Bressenham V Screenpointer
screen 19,32

dim as integer xres,yres,bypp, pitch
screeninfo xres,yres, , bypp, pitch
dim as double t1,t2

#macro Bressenhamline(xf,yf,zf,xs,ys,zs,colour)
scope
dim as integer x1=xf,y1=yf,z1=zf,nx=xs-xf,ny=ys-yf,nz=zs-zf
var length = sqr(nx*nx+ny*ny+nz*nz)
nx=nx/length:ny=ny/length:nz=nz/length
for i as integer=0 to length
    x1=x1+nx:y1=y1+ny:z1=z1+nz
    pset(x1,y1),colour
next i
end scope
#endmacro

'fill screen by Bressenham
screenlock()
t1=timer
for y as integer=0 to yres
    Bressenhamline(0,y,0,xres,y,0,rgb(x1,x1 xor y1,y1))
next y
t2=timer
screenunlock()
print "Bressenham time ";t2-t1
print "press a key"
sleep


'_FROM HELP FILE, fill screen by screenpointer
cls

Dim As Any Ptr row = screenptr
Dim As UInteger Ptr pixel
ScreenLock()
    t1=timer
    For y As Integer = 0 To yres - 1
         pixel = row
        For x As Integer = 0 To xres - 1
            *pixel = RGB(x,(x Xor y), y)
            pixel += 1
        Next x
        row += pitch
    Next y
t2=timer
ScreenUnlock()

print "Screen Pointer time ";t2-t1
Sleep



Return to “General”

Who is online

Users browsing this forum: No registered users and 5 guests