Here are some results for a test file:
Code: Select all
compiling . . .
Success ( 450.1857522999999 seconds)
FreeBASIC Compiler - Version 1.07.3 (2020-12-31), built for win64 (64bit)
Copyright (C) 2004-2019 The FreeBASIC development team.
standalone
-gen gcc -Wc -O3
--------------------------------------------------------------------------------
compiling . . .
Success ( 435.4475182999995 seconds)
FreeBASIC Compiler - Version 1.07.2 (2020-12-25), built for win32 (32bit)
Copyright (C) 2004-2019 The FreeBASIC development team.
standalone
-gen gcc -Wc -O3
--------------------------------------------------------------------------------
compiling . . .
Success ( 2.656405900001118 seconds)
FreeBASIC Compiler - Version 1.07.2 (2020-12-25), built for win32 (32bit)
Copyright (C) 2004-2019 The FreeBASIC development team.
standalone
-gen gas
--------------------------------------------------------------------------------
compiling . . .
Success ( 5.384803700002522 seconds)
FreeBASIC Compiler - Version 1.07-(08).1 (2020-08-07), built for win64 (64bit)
Copyright (C) 2004-2019 The FreeBASIC development team.
standalone
-gen gas64
-------------------------------------------------------------------------------- Please use the mouse wheel to adjust the magnification, probably make it 1.
The saved file is testbitmap.bas, approx 32000 lines of data, which you can test yourself with gas and gcc.
But please note you will have to wait 7 or 8 minutes to compile with -gen gcc, -gen gas is only a few seconds.
Code: Select all
'Data maker
Screen 17,32
Dim As String nag = _
"S2C0BM197,135M+5,-27M+3,-25M+4,-21M+6,-10M+15,-10"_
&"M+5,-4M+11,-4M+8,0M+2,4M+48,1M+15,7"_
&"M+15,7M+12,10M+12,13M+19,27M+7,15M+6,13"_
&"M+7,7M+23,5M+39,-9M+37,-10M+20,-1M+24,3"_
&"M+30,5M+18,-10M+34,-23M+15,-3M+18,6M+15,11"_
&"M+12,15M+2,28M+5,39M+-5,18M+-17,38M+-7,14"_
&"M+-20,34M+-12,21M+-4,9M+-2,3M+-1,37M+4,9"_
&"M+-4,1M+-9,-7M+-7,-17M+-3,-30M+6,-38M+23,-59"_
&"M+4,-29M+-3,-21M+-13,-17M+-10,-6M+-13,-4M+-17,0"_
&"M+-6,3M+5,18M+11,28M+0,27M+-3,15M+-7,13"_
&"M+-10,16M+-12,11M+-9,11M+-9,10M+6,19M+8,13"_
&"M+5,6M+6,12M+-4,11M+-12,17M+-14,13M+-10,13"_
&"M+-8,13M+-7,10M+-4,11M+-12,6M+-8,3M+-5,11"_
&"M+0,6M+-28,-9M+3,-12M+8,-8M+13,-7M+8,-5"_
&"M+12,-10M+9,-16M+10,-15M+12,-15M+0,-10M+-3,-13"_
&"M+-2,-8M+-5,1M+-3,12M+-8,9M+-12,13M+-10,13"_
&"M+-7,16M+-8,15M+-5,8M+-8,11M+-9,9M+-13,12"_
&"M+-3,9M+273,4M+0,13M+-382,-1M+-1,-12M+71,-3"_
&"M+20,-21M+27,-20M+28,-41M+6,-14M+5,-20M+-19,-35"_
&"M+-7,-10M+-8,-7M+-9,-4M+-16,7M+-12,3M+-29,0"_
&"M+-22,1M+-14,21M+-13,27M+-13,19M+-12,30M+-7,22"_
&"M+-4,19M+-7,22M+31,3M+-1,15M+-171,-1M+-2,-13"_
&"M+95,-2M+13,-8M+15,-9M+8,-13M+8,-21M+5,-32"_
&"M+5,-22M+9,-21M+8,-22M+8,-19M+-3,-4M+-17,5"_
&"M+-9,3M+-69,0M+-4,7M+-4,12M+5,17M+9,10"_
&"M+13,14M+11,10M+10,3M+12,4M+4,11M+-2,12"_
&"M+-8,7M+-8,-4M+-20,-14M+-15,-13M+-36,-56M+-2,-19"_
&"M+7,-14M+15,-8M+48,-20M+-7,-26M+5,-11M+1,-11"_
&"M+7,-7M+6,-11M+8,-18M+3,-18M+-1,-14M+-4,-10"_
&"M+-6,-11M+-8,1M+-14,12M+-7,10M+-3,15M+-6,8"_
&"M+-12,-2M+-16,-6M+-4,-17M+1,-16"_
&"BM+191,77P4294967295,0"
dim as any ptr tmp=imagecreate(640,400,rgb(0,100,255))
for x as long=50 to 590
for y as long=50 to 350
pset tmp,(x,y),rgb(x,x xor y,y)
next y
next x
draw tmp,nag
draw string tmp,(0,0),"Test bitmap"
bsave "testbitmap.bmp",tmp
imagedestroy tmp
'bload "testbitmap.bmp"
'sleep
open "testbitmap.bas" for output as #2
Type bitmap_size
As long across,down
End Type
Dim mybitmap As String ="testbitmap.bmp"
Redim shared As ulong pixel_colours(0,0) 'shared to increase potential size
Function size(bmp As String) As bitmap_size 'fetch bitmap width/height
Dim As long w,h
Open bmp For Binary As #1
Get #1, 19, w
Get #1, 23, h
Close #1
Return Type<bitmap_size>(w,h)
End Function
Sub load(bmp As String,pixels() As ulong) 'load bitmap into array of point colours
Bload bmp
dim count as integer
dim as string comma=","
dim as string dash="_"
Dim temp As bitmap_size=size(bmp)
Redim pixels(temp.across,temp.down)
dim max as integer=(1+temp.across)*(1+temp.down)
For x As Integer=0 To temp.across
For y As Integer=0 To temp.down
count=count+1
pixels(x,y)=Point(x,y)
if count=max then
comma=""
dash=""
end if
print #2,"&H"& hex(point(x,y)),
if count mod 8=0 then print #2,dash
Next y
Next x
End Sub
'Use mouse or keys to move bitmap in this run
Sub drawbitmap(mx As Integer,my As Integer,mybitmap As bitmap_size,scale as single=1)
#macro magnify(pivotx,pivoty,px,py,scale)
var rotx=scale*(px-pivotx)+pivotx
var roty=scale*(py-pivoty)+pivoty
#endmacro
For x As Integer=mx To mx+mybitmap.across
For y As Integer=my To my+mybitmap.down
magnify(mx,my,x,y,scale)
line(rotx-scale/2,roty-scale/2)-(rotx+scale/2,roty+scale/2),pixel_colours(x-mx,y-my),BF
Next y
Next x
End Sub
'____________________________
Sub framecounter(msg as single)
Static As double frame,fps
frame=frame+1
Static As double t1,t2
If frame>=fps Then
t1 = Timer
fps = frame/(t1-t2)
Windowtitle "Frames per second = " + str(fps) + " magnification= " +str( msg)
t2=Timer
frame=0
End If
End Sub
'______________________________________
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Dim As bitmap_size bitmap_info=size(mybitmap) 'get height/width of bitmap
print #2,"redim shared as ulong a(";str(bitmap_info.across);",";str(bitmap_info.down);")"
print #2 ,"DATA _"
draw string(bitmap_info.across,bitmap_info.down), "PLEASE WAIT"
load mybitmap,pixel_colours() 'set bitmap into an array
'variables for the mouse and arrow keys
Dim As Integer mx,my,mw,mb,copymx,copymy
dim as string i
'Testing loop for this section.
Do
Getmouse(mx,my,mw,mb)
if mb=2 then exit do
if mw<0 then mw=10
if mw=0 then mw=1
If mb=1 Then
copymx=mx:copymy=my
End If
i=inkey
if i= chr(255) + "K" then copymx=copymx-5
if i= chr(255) + "M" then copymx=copymx+5
if i= chr(255) + "P" then copymy=copymy+5
if i= chr(255) + "H" then copymy=copymy-5
Screenlock
Cls
drawbitmap(copymx,copymy,bitmap_info,mw/10) 'SCALE
draw string(20,20),"TURN MOUSE WHEEL --- MAGNIFICATION = "&str(mw/10),rgb(255,255,255)
draw string(20,50),"END AT THE REQUIRED MAGNIFICATION",rgb(255,255,255)
draw string(20,80),"LEFT CLICK TO SHIFT IMAGE",rgb(255,255,255)
draw string(20,110),"ESC OR RIGHT CLICK TO END",rgb(255,255,255)
framecounter(mw/10)
Screenunlock
Sleep 1,1
Loop Until i=Chr(27)
'Running code
print #2," "
print #2,"screen 17,32"
print #2,"dim as double magnification"
print #2,"magnification= ";mw/10
print #2,"Type bitmap_size"
print #2,"As Integer across,down"
print #2,"End Type"
print #2,"sub read_data(mybitmap as bitmap_size)"
print #2,"for x as integer=0 to mybitmap.across"
print #2,"for y as integer=0 to mybitmap.down"
print #2,"read a(x,y)"
print #2,"next y"
print #2,"next x"
print #2,"end sub"
print #2,"dim shared as any pointer image"
print #2,"image=imagecreate(magnification*ubound(a,1),magnification*ubound(a,2))"
print #2,"Sub drawbitmap_to_image(mybitmap As bitmap_size,scale as single=1,mx As Integer=0,my As Integer=0)"
print #2,"#macro magnify(pivotx,pivoty,px,py,scale)"
print #2,"var rotx=scale*(px-pivotx)+pivotx"
print #2,"var roty=scale*(py-pivoty)+pivoty"
print #2,"#endmacro"
print #2,"For x As Integer=mx To mx+mybitmap.across"
print #2,"For y As Integer=my To my+mybitmap.down"
print #2,"magnify(mx,my,x,y,scale)"
print #2,"line image,(rotx-scale/2,roty-scale/2)-(rotx+scale/2,roty+scale/2),a(x-mx,y-my),BF"
print #2,"Next y"
print #2,"Next x"
print #2,"End Sub"
print #2,"Dim As bitmap_size bitmap_info"
print #2,"bitmap_info.across=ubound(a)"
print #2,"bitmap_info.down=ubound(a,2)"
print #2,"read_data(bitmap_info)"
print #2,"drawbitmap_to_image(bitmap_info,magnification)"
print #2,"'BITMAP image is now in image"
print #2,"'This just displays the image"
print #2,"dim as string i"
print #2,"Do"
print #2,"i=inkey"
print #2,"Screenlock"
print #2,"Cls"
print #2,"locate 2,2"
print #2,"print ""magnification ="";";mw/10
print #2,"put(";copymx;",";copymy;"),image,pset"
print #2,"Screenunlock"
print #2,"Sleep 1,1"
print #2,"Loop Until i=Chr(27)"
print #2,"imagedestroy image"
close #2
locate 10,10
color rgb(200,200,200)
print "SAVED -- testbitmap.bas is your file"
locate 12,10
print "Press a key to end"
sleep
