Doing Data Input in Graphics Screen: There is a big difference on how the commands Input, TGet, and Text.Input work. Last 2 can be used while in graphics screen without closing the graphics screen. And that's faster. All you must do is refresh screen with a gr.render after issuing these 2 commands. Example:
When loading a sample program nothing appears in the editor. When loading a program out of Sample_Programs(d) or normal the file names show, but when I load them the file is empty in the editor. Using File Explorer browsing to the files I can open them and the data is there.
I think the problem is with Android OS 4.0 or higher.
Settings/Developer Option/Distroy Activities (no checked) Settings/Energy/Quick Restart (no checked) No cheked = No Select
Settings/Developer Option/ I unchecked Don't keep activities and BASIC! behaves itself when loading a program now.
Fooled around with Developer Options think USB Debugging on But it works now
Here a new way to sort a group of numeric values. Here I use a bitwise operation (XORing).
Here the code: short and fast.
Just place a variable named "Sample" sized as per your need then a dim BWS[sample] at the begining of your code.
Gosub Sorting all the time you need to sort the array BWS.
index = 1
while index < sample
if BWS[index + 1] < BWS[index] then BWS[index] = bxor(BWS[index], BWS[index + 1]) BWS[index + 1] = bxor(BWS[index], BWS[index + 1]) BWS[index] = bxor(BWS[index], BWS[index + 1]) if index > 1 then index = index - 2 end if
index = index + 1
_________________ Don't be afraid of the time passing by, the best is yet to come
Post subject: Routines for file selection and menu choice by touch
Posted: Wed Dec 04, 2013 11:13 am
Joined: Thu Feb 14, 2013 6:41 am Posts: 68
Just as a demo, this program plays a music file seleleted by the user, but it demonstrates two functions intended for more general use: (1) Select_file$() to touch-select a file from a within a tree of folders. That in turn calls (2) Menu(A$) for touch-selection from a menu of choices given in A$. The number of lines and colums adusts depending on the length of the longest choice, and the size and initial orientation of the device screen.
!_____________________________________________________________________________ Fn.def menu(A$) ! On entry the elements of A$ hold the menu choices ! Returns the number of the element in A$ the user chose gr.open 255,0,0,128,0,-1 pause 500 % 'Certain sync problems' gr.screen w,h % screen dimensions for either orientation if w>h then gr.orientation 0 % fix landscape else gr.orientation 1 % fix portrait end if gr.cls % restart list gr.color 255, 255, 255, 255, 1 gr.text.size 30 % vary to taste gr.text.align 1 % xy = left of writing line array.length Nin,A$ % size of input array if Nin=0 then Fn.rtn % called with empty array biggest=0 for t=1 to Nin gr.text.width tt,A$[t] if tt>biggest then biggest=tt next ncol=floor(w/(biggest+40)) % no of columns if ncol=0 then ncol=1 % at least one column wcol=w/ncol % width of columns nlin=floor(h/50+0.5) % no lines on screen hlin=h/nlin % height of lines (~50) ntot=ncol*nlin % total screen capacity INCLUDING More/Quit dim gn[ntot] % graphic obj nos for col=1 to ncol for lin=1 to nlin x=wcol*(col-1)+20 y=hlin*lin-15 n=lin+nlin*(col-1) if n=ntot then % control slot gr.color 255, 160, 160,160, 1 % dimmed gr.text.align 3 % xy = right of writing line x=w-20 end if gr.text.draw gn[n],x,y, "" next next offset=0 % offset of display within A$ do if (Nin>=(ntot+offset-1)) then t$="More..." else t$="QUIT" gr.modify gn[ntot],"text",t$ for n=1 to (ntot-1) % all non-control slots if (n+offset)>Nin then gr.modify gn[n],"text","" % empty slot else gr.modify gn[n],"text",A$[n+offset] % new text end if next gr.render !Wait for touch -------------------------------------------------------------- do gr.touch touched,x,y until touched n=1+floor(y/hlin)+nlin*floor(x/wcol) % n=1..(ntot+1) gr.hide gn[n] gr.render pause 200 % blink time gr.show gn[n] gr.render do % Wait for lift gr.touch touched,xx,yy until !touched !Touch complete -------------------------------------------------------------- if (n=ntot) if (t$="QUIT") then result=0 d_u.break else offset=offset+ntot-1 % 'More' endif elseif (n<ntot)&(n<(Nin-offset+1)) then result=n+offset d_u.break endif until 0 gr.close Fn.rtn result Fn.end !_____________________________________________________________________________ Fn.def select_file$() ! Returns the name of the selected file as a string root$="../.." % vary to suit device latest$=root$+"(d)" while right$(latest$,3)="(d)" latest$=left$(latest$,len(latest$)-3) file.dir latest$,t$ % t$ holds directory list t=menu(t$) % choose a list item if t>0 then % chosen latest$=latest$+"/"+t$[t] else % quitted if latest$=root$+"(d)" then % quitted root latest$=root$ else latest$=root$+"(d)" % quitted sub-directory end if end if undim t$ % for re-use repeat Fn.rtn latest$ Fn.end !_____________________________________________________________________________ f$=select_file$() gr.open 0,0,0,0 gr.front 0 gr.close if is_in(upper$(right$(f$,4)),"MIDI.WAV.AAC.MP3.WMA.AMR.OGG") then print "Playing:" audio.stop audio.load n,f$ audio.play n end if print f$ while 1 repeat end
Any comments and corrections will be gratefully received!
Joined: Wed Oct 03, 2012 9:53 am Posts: 2786 Location: Colorado, U.S.
Very nice! Thank you, Frank. Somebody (Estabrooks?) must have put a lot of work into that two-letter-pair table.
I wonder if a text compression scheme like that could be incorporated into the BASIC! Editor? It might help on devices that limit the editable content size.
A point of caution: you have a GOTO jumping out of an IF block. That's okay in some versions of BASIC, especially if they are compiled, but in this one it breaks some internal bookkeeping. If you do it often enough (a semi-arbitrary 50,000 times), BASIC! will complain. Your GOTO allows two nested IF blocks to start with no matching ENDIF to clean up the books, so you get 25,000 passes. Some block types (FOR, DO, WHILE) are sanity-checked at program exit, so you can get an error with just one GOTO. This a bug in BASIC!, but for now we're stuck with it.
This being the "functions and tricks" thread, it's a good place for reminder to everybody, especially programmers porting from another version of BASIC: don't jump in or out of a block with a GOTO, and don't BREAK out of a non-matching block type.
PATTERN-BASED STRING COMPRESSION -- Revised version
This is an implementation of a very clever string compression function that I originally came across several years ago. (Actually, that can probably measured in decades now.) The original implementation of this function was written for Microsoft QuickBasic; I rewrote it as a C function a while back, and now have re-written it again for RFO-Basic.
This function now uses the same control flow as my C adaptation, and avoids the use of unconditional control transfers.
The header on the original QuickBasic function states:
' Super Text/String Packer/Unpacker for QB4.5 ' Originally by Greg Estabrooks ' Slightly changed by Hauke Daempfling
The purpose of this function is to compress a text string; it does a pretty good job of it as most text will compress to between 55-65% of the original size. This is, of course, not as good as the compression you will get out of a zip file or something similar to that, but the advantage of this function is that it is very small and self-contained, so it's easy to add into any program that you wish include text compression into. I have used it for storing screen layout templates, help files and even a custom spelling checker dictionary. I'm sure it has other uses too; I just haven't come across them yet.
Note that the magic of this function is all contained within in the dictionary$ string; it is critical to the compression that you use the EXACT string as specified; any changes will cause the compression ratio to decrease dramatically.
!! * packtext.bas * ' Super Text/String Packer/Unpacker for QB4.5 ' Originally by Greg Estabrooks ' Slightly changed by Hauke Daempfling * * RFO-Basic for Android version adapted by Frank Cox <firstname.lastname@example.org> December 30, 2013 * * packtext.bas for RFO-Basic Copyright (c) 2013, Frank Cox All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY FRANK COX "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL FRANK COX BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. !!
fn.def packtext$(text$) dictionary$=" e as tinthouerhet anreesr d onn or o i y wo tontyo. neisarteed, ctiy bat snd fal pensestvengitu talehaurllcousa mf dfoof siril hmeg om Icehironsasiossbedepe rli Tetel nicho lilprcactutThpaeceachh wige ebuaisursulmawaotowtsmploI solyee Cunm rtieno Sdiwhs.rafincademe.irplk ury Pwoacos gams,duayavucColamowe Aoopu" if len(dictionary$) <> 320 then fn.rtn "ERROR: Dictionary has the wrong size" if left$(text$,1) <> chr$(255) if len(text$) < 4 then fn.rtn text$ % No use with strings less than 4 characters for counter = 1 to len(text$) if ascii(mid$(text$,counter,1)) < 32 | ascii(mid$(text$,counter,1)) > 127 counter=-1 f_n.break endif next if counter=-1 then fn.rtn "String contains character with value out of range"
for counter=1 to len(text$) for dictsearch=1 to len(dictionary$) step 2 if mid$(text$,counter,2)=mid$(dictionary$,dictsearch,2) then f_n.break next if dictsearch < len(dictionary$) % we found the characters that we want result$=result$+chr$(dictsearch/2+96) counter++ else result$ = result$ + chr$(ascii(mid$(text$, counter, 1)) - 32) endif next else for counter=2 to len(text$) if ascii(mid$(text$,counter,1)) > 95 result$ = result$ + mid$(dictionary$, (ascii(mid$(text$,counter,1)) - 96) * 2 + 1, 2) else result$ = result$ + chr$(ascii(mid$(text$, counter, 1)) + 32) endif next endif fn.rtn result$ fn.end
Joined: Sat Feb 15, 2014 1:33 pm Posts: 9 Location: 59 Lille
My own TrimLeft, TrimRight, Trim (both sides) and Pos functions
The trim functions remove all chars with an ASCII code lower and equal to 32 (space).
WARNING: these functions are not optimized for speed
!! ! ! Triming functions calling conventions: ! ! NumVar = FnText_TrimLeft( &StringVar$) ! NumVar = FnText_TrimRight( &StringVar$) ! NumVar = FnText_Trim( &StringVar$) ! ! After the call to one of these three functions, 'NumVar' contains: ! ! 0 : nothing to trim in the string ! 1 : the string have been trimed ! ! ! 'Pos' function calling convention: ! ! NumVar = pos( InStr$, What$) ! ! After the call to this function 'NumVar' contains: ! ! 0 : searched string not found ! 1 : the pos of the searched string ! !!
FN.DEF FnText_TrimLeft( pvString$) !* !* parameter(s) : !* pvString$ : a string to trim !* !* return : !* 0 : nothing to trim !* 1 : trimmed !* lReturn = 0
IF ( pvString$ <> "") THEN ! ! Loop to remove all chars lowers than chr$( 32). ! Any other chars (numbers, punctuation, accents...) ! are left in place and stops the loop. ! WHILE (( pvString$ <> "") & ( LEFT$( pvString$, 1) <= chr$( 32))) pvString$ = MID$( pvString$, 2) lReturn = 1 REPEAT ENDIF
FN.RTN lReturn FN.END % FnText_TrimLeft( )
FN.DEF FnText_TrimRight( pvString$) !* !* parameter(s) : !* pvString$ : a string to trim !* !* return : !* 0 : nothing to trim !* 1 : trimmed !* lReturn = 0
IF ( pvString$ <> "") THEN lLength = len( pvString$) ! ! Loop to remove all chars lowers than chr$( 32). ! Any other chars (numbers, punctuation, accents...) ! are left in place and stops the loop. ! WHILE ( ( pvString$ <> "") & ( right$( pvString$, 1) <= chr$( 32))) pvString$ = left$( pvString$, lLength - 1) lLength = len( pvString$)
lReturn = 1 REPEAT ENDIF
FN.RTN lReturn FN.END % FnText_TrimRight( )
FN.DEF FnText_Trim( pvString$) !* !* parameter(s) : !* pvString$ : a string to trim !* !* return : !* 0 : nothing to trim !* 1 : trimmed !* lReturn = 0 lReturn_1 = FnText_TrimLeft( &pvString$) lReturn_2 = FnText_TrimRight( &pvString$)
lReturn = ( ( lReturn_1 = 1) & ( lReturn_2 = 1))
FN.RTN lReturn FN.END % FnText_Trim( )
fn.def pos( pInStr$, pWhat$) lReturn = 0
if ( pWhat$ = "") then lReturn = 0 else if ( pInStr$ = pWhat$) then lReturn = 1 else if len( pInStr$) < len( pWhat$) then lReturn = 0 else lEnd = 0 lIndex = 1
lStr$ = "nothing to trim" print "FULL TRIM >"; FnText_Trim( &lStr$); "<" print "]"; lStr$; "["
print "" print "Testing the pos function" print ""
print pos( "a simple sentence without meaning", ""); " (should be 0.0)" print pos( "a simple sentence without meaning", "something"); " (should be 0.0)" print pos( "a simple sentence without meaning", "a simple sentence without any meaning"); " (should be 0.0)" print pos( "a simple sentence without meaning", "a simple sentence without meaning too"); " (should be 0.0)" print pos( "a simple sentence without meaning", "a simple sentence without meaning"); " (should be 1.0)" print pos( "a simple sentence without meaning", "simple"); " (should be 3.0)"
Users browsing this forum: No registered users and 1 guest
You cannot post new topics in this forum You cannot reply to topics in this forum You cannot edit your posts in this forum You cannot delete your posts in this forum You cannot post attachments in this forum