Post by tenochtitlanuk on Oct 12, 2019 12:35:58 GMT -5
Anyone else picking up this thread might look at the methods used in the LB Rosetta entries for multiplying, transposing and exponentiating matrices. eg Rosetta Code LB entries I think Anatoly ( tsh3) posted a related version somewhere??
Post by tenochtitlanuk on Oct 10, 2019 13:05:51 GMT -5
Was at a loose end with half an hour to kill. Had a quick look on Rosetta code for a new task, and found an interesting one- binary population count. The population count is the number of 1s (ones) in the binary representation of a non-negative integer. For example, 5 (which is 101 in binary) has a population count of 2.
Evil numbers are non-negative integers that have an even population count.
Odious numbers are positive integers that have an odd population countYou should get the results quoted there- my code prints ai a more illustrative way. Will put the code up after ( perhaps) others have a go. HINT decimal to binary routines are already on Rosetta Code.
for d =0 to 5 TX = 180 *d +26 ' <<<< start position, direction of each Koch curve. TY = 87 *d +51 Ttheta =0
for side =1 to 3 call fwd l, d call turn 120 next side
#wg "flush" '#wg "print 1110"
sub quit h$ call save$ close #h$ end end sub
sub fwd length, depth scan if depth <= 0 then call forward length else call fwd length /3, depth -1: call turn -60 call fwd length /3, depth -1: call turn 120 call fwd length /3, depth -1: call turn -60 call fwd length /3, depth -1 end if
function sinRad( a) sinRad =sin( a *pi /180) end function
function cosRad( a) cosRad =cos( a *pi /180) end function
'sub draw lifted, x, y ' if lifted =0 then #wg "up" else #wg "down" ' #wg "line "; TX; " "; TY; " "; x; " "; y ' Ttheta =atan2( x -TX, TY -y) *180 /pi ' NB DEGREES. ' TX =x ' TY =y 'end sub
sub turn angle ' increment/update global turtle direction ( in DEGREES) Ttheta =( Ttheta +angle) 'mod 360 end sub
sub forward s dx =s *cosRad( Ttheta) dy =s *sinRad( Ttheta) #wg "down ; line "; TX; " "; TY; " "; TX +dx; " "; TY +dy; " ; up" TX =TX +dx TY =TY +dy end sub
function atan2( x, y) Result$ = "Undetermined" If ( x = 0) and ( y > 0) Then atan2 = pi / 2: Result$ = "Determined" If ( x = 0) and ( y < 0) Then atan2 = 3 * pi / 2: Result$ = "Determined" If ( x > 0) and ( y = 0) Then atan2 = 0: Result$ = "Determined" If ( x < 0) and ( y = 0) Then atan2 = pi: Result$ = "Determined" If Result$ = "Determined" Then [End.of.function]
BaseAngle = Atn( abs( y) /abs( x)) If (x > 0) and (y > 0) Then atan2 = BaseAngle If (x < 0) and (y > 0) Then atan2 = pi -BaseAngle If (x < 0) and (y < 0) Then atan2 = pi +BaseAngle If (x > 0) and (y < 0) Then atan2 = 2*pi -BaseAngle [End.of.function] end function
sub graticule #wg "down" for x =0 to 1500 step 50 ' draw vertical graticule lines 'if x =( Tx -2) then #wg "size 4 ; color red" else #wg "size 2 ; color white" #wg "line "; x +2; " "; 2; " "; x +2; " "; 702 next x for y =0 to 800 step 50 #wg "line "; 2; " "; y +2; " "; 1202; " "; y +2 next y #wg "up" end sub
sub saveS #wg "flush" #wg "getbmp scr 0 0 1110 710" filedialog "Save as ", "*.bmp", fn$ bmpsave "scr", fn$ end sub
Post by tenochtitlanuk on Oct 8, 2019 17:19:28 GMT -5
Basically, here's a warning to LB-ers not to use inbuilt turtle commands for accurate results. It stores nearest screen position and/or an integer angle, so each move/draw can be wrong by up to half a pixel. The next move then starts from the wrong position/angle, and in figures with finer detail than a large square it goes badly and unpredictably wrong. Example is my Koch curve example.. see rosettacode.org/wiki/Koch_curve
My replacements for draw and turning store x, y and orientation as floats, so errors should not exceed one pixel.
Post by tenochtitlanuk on Oct 8, 2019 17:09:29 GMT -5
Yup, I've never got other than the built-in Windows dlls to work on my Linux/Wine/LB installations. Use ImageMagick as an exe not the dll version. Tried the same file locations and addresses as you have. I have no code which relies on such nowadays- but I keep a Windows 10 installation for the odd task -eg running an interface to my weather station which needs a custom dll.
Post by tenochtitlanuk on Sept 30, 2019 17:22:00 GMT -5
More accurately, turtle graphics WOULD have helped. But they can't be used for accurate graphics since they round off distances and angles. Luckily I wrote replacements long ago- so the errors don't accumulate as in the first attempt.
Post by tenochtitlanuk on Sept 30, 2019 12:21:52 GMT -5
In a moment of madness I wondered if I could create a sine wave which was modulated at a higher frequency- but transverse to its current direction ( imagine bending a wire into a whole lot of small sin waves, then bending that wire bigger amounts but of much longer wavelength.) I thought turtle graphics would help.
Function DownloadToFile( urlfile$, localfile$) open "URLmon" for dll as #url calldll #url, "URLDownloadToFileA",_ 0 as long,_ ' null urlfile$ as ptr,_ ' url to download localfile$ as ptr,_ ' save file name 0 as long,_ ' reserved, must be 0 0 as long,_ ' callback address, can be 0 DownloadToFile as ulong ' 0 =success close #url end function
function decToComma$( a$) a$ =left$( a$,10) ' <<<<<<<<<<<<<<<<<< for j =1 to len( a$) c$ =mid$( a$, j, 1) if c$ ="." then decToComma$ =decToComma$ +"," else decToComma$ =decToComma$ +c$ end if next j if instr( "0123456789", left$( decToComma$, 1)) then decToComma$ ="" +decToComma$ decToComma$ =right$( " " +decToComma$, 8) end function
'********************************* 'You do not need to understand the two functions that follow. 'Paste them at the bottom of your code, and call the image-loading function like this: ' hBitmap=GDIPlusLoadImage(imgfile$) 'You may then use Liberty BASIC's LOADBMP function to load the image. ' loadbmp "image",hBitmap 'Draw it in a graphicbox or graphics window with LB's DRAWBMP statement. '*********************************
function GDIPlusLoadImage( file$) open "gdiplus.dll" for dll as #gdiplus 'this struct will be filled by API functions
STRUCT GDITOKEN, token as ulong 'we MUST fill this struct with GdiPlusVersion number
STRUCT GdiplusStartupInput,_ GdiplusVersion as ulong,_ DebugEventCallback as ulong,_ SuppressBackgroundThread as long,_ SuppressExternalCodecs as long
GdiplusStartupInput.GdiplusVersion.struct =1 'must be = 1
calldll #gdiplus,"GdiplusStartup",_ GDITOKEN as struct,_ GdiplusStartupInput as struct,_ status as ulong 'returns zero if successful
if status <>0 then GDIPlusLoadImage =0 else wFile$ =MultiByteToWideChar$( file$)
calldll #gdiplus, "GdipCreateBitmapFromFile", _ wFile$ as ptr,_ 'filename string in unicode (wide) character format GDITOKEN as struct,_ status as ulong 'returns zero if successful
hBmpGdip =GDITOKEN.token.struct 'GDI+ bitmap returned in struct
if status <>0 then GDIPlusLoadImage =0 else 'create GDI bitmap handle from GDI+ bitmap calldll #gdiplus, "GdipCreateHBITMAPFromBitmap", _ hBmpGdip as ulong,_ 'GDIPlus bitmap GDITOKEN as struct,_ 'bitmap handle will be returned in this struct 0 as ulong,_ status as ulong 'returns zero if successful
if status <>0 then GDIPlusLoadImage=0 else 'get a bitmap handle we can use with Liberty BASIC's LOADBMP GDIPlusLoadImage =GDITOKEN.token.struct end if
calldll #gdiplus, "GdipDisposeImage",_ 'remove GDI+ bitmap hImage as ulong,_ 'GDI+ bitmap handle result as ulong end if
calldll #gdiplus,"GdiplusShutdown",_ 'you must call this when finished token as ulong,_ 'Token returned by a previous call to GdiplusStartup. result as void 'no return from this function
close #gdiplus end if end function
function MultiByteToWideChar$( String$) 'converts any string into unicode CodePage = 0 dwFlags = 0 cchMultiByte = -1 lpMultiByteStr$ = String$ cchWideChar = len( String$) *3 lpWideCharStr$ = space$( cchWideChar)
calldll #kernel32, "MultiByteToWideChar", _ CodePage as ulong, _ 'CP_ACP=0, ansi code page dwFlags as ulong, _ 'use 0, flags for character translation lpMultiByteStr$ as ptr,_ 'the ascii string to convert cchMultiByte as long, _ 'len of string, -1 for null-terminated string lpWideCharStr$ as ptr, _ 'buffer for returned ansi string cchWideChar as long, _ 'size in wide characters of string buffer result as long 'returns number of wide characters written to buffer
if result = 0 then MultiByteToWideChar$ = "" else MultiByteToWideChar$ = left$( lpWideCharStr$, result *2) end if
Post by tenochtitlanuk on Sept 26, 2019 14:41:52 GMT -5
It really messed with the mental gears in my head! It's really off-putting when you get the ratios/phase/rates wromg- teeth crossing over, wheels rotating the wrong way or at wrong speed. Can't spend any more time on it at present as I'm away from home- but intend to get back and will be interested in what you can create. You're ahead of me already- I intended to add an index dot to make it easy to see what was going on.