It is currently Thu Mar 30, 2017 3:40 pm



Welcome
Welcome to rfobasic

You are currently viewing our boards as a guest, which gives you limited access to view most discussions and access our other features. By joining our free community, you will have access to post topics, communicate privately with other members (PM), respond to polls, upload content, and access many other special features. In addition, registered members also see less advertisements. Registration is fast, simple, and absolutely free, so please, join our community today. **You are not required to provide truthful information to any registration questions. Be whomever you wish to be.!


Post new topic Reply to topic  [ 33 posts ]  Go to page Previous  1, 2, 3, 4  Next
Author Message
 Post subject: Re: Some functions and tricks
Unread postPosted: Tue Apr 23, 2013 10:39 am 
Offline
User avatar

Joined: Mon Oct 17, 2011 9:34 am
Posts: 891
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:

Code:
GR.OPEN 255,0,155,55,0,1
PAUSE 1000
GR.ORIENTATION 1

GR.BITMAP.LOAD c1,"cartman.png"

GR.BITMAP.DRAW c,c1,100,100
gr.render

tget a1$,"Press Enter when finished","Test1"
cls % clear console screen
gr.render
Text.input a2$,"Hide keyboard & press Finished!","Test2"
gr.render

do
until 0


Although i wish "input" worked exactly as tget and text.input...
EDIT: As of version 1.76 input works in the graphics screen!
Image

_________________
Check out my RFO Basic! apps & games: Image, on Google Play Store! Slide me!, Amazon, or AppsLib!


Top
 Profile  
 
 Post subject: Re: Some functions and tricks
Unread postPosted: Thu May 23, 2013 11:07 am 
Offline

Joined: Sat Jun 04, 2011 2:29 pm
Posts: 184
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.

Solutions:
Quote:
Settings/Developer Option/Distroy Activities (no checked)
Settings/Energy/Quick Restart (no checked)
No cheked = No Select

Quote:
Settings/Developer Option/
I unchecked Don't keep activities and BASIC! behaves itself when loading a program now.

Quote:
Fooled around with Developer Options
think USB Debugging on
But it works now


Original link: Read all post please ;-)
post6895.html#p6895
post7798.html#p7798


BASIC wrote:
BASIC! has a reason for acting this way.

We will add a notice in the manual about this problem.


Top
 Profile  
 
 Post subject: Re: Some functions and tricks
Unread postPosted: Fri Oct 25, 2013 10:12 am 
Offline
User avatar

Joined: Sun May 19, 2013 10:53 am
Posts: 505
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.

Code:

sorting:

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

repeat

Return



Cheers

Alberto

_________________
Don't be afraid of the time passing by, the best is yet to come


Top
 Profile  
 
 Post subject: Routines for file selection and menu choice by touch
Unread postPosted: Wed Dec 04, 2013 11:13 am 
Offline

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.
Code:
!_____________________________________________________________________________
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!


Top
 Profile  
 
 Post subject: Re: Some functions and tricks
Unread postPosted: Thu Dec 05, 2013 2:06 pm 
Offline
User avatar

Joined: Mon Oct 17, 2011 9:34 am
Posts: 891
I've coded something similar. See my approach here:
media-explorer-v1-0-t540.html

_________________
Check out my RFO Basic! apps & games: Image, on Google Play Store! Slide me!, Amazon, or AppsLib!


Top
 Profile  
 
 Post subject: Re: Some functions and tricks
Unread postPosted: Sat Dec 14, 2013 11:04 pm 
Offline

Joined: Mon Dec 09, 2013 2:40 pm
Posts: 63
To avoid confusion, this post was deleted by Frank Cox on Dec 30, 2013. See updated/corrected post further down in this thread.


Last edited by Frank Cox on Mon Dec 30, 2013 10:44 pm, edited 1 time in total.

Top
 Profile  
 
 Post subject: Re: Some functions and tricks
Unread postPosted: Tue Dec 17, 2013 7:57 am 
Offline

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.

More detail in and around this post.

- Marc


Top
 Profile  
 
 Post subject: Re: Some functions and tricks
Unread postPosted: Tue Dec 17, 2013 9:12 am 
Offline

Joined: Mon Dec 09, 2013 2:40 pm
Posts: 63
Post deleted by Frank Cox on December 30, 2013


Last edited by Frank Cox on Mon Dec 30, 2013 10:58 pm, edited 1 time in total.

Top
 Profile  
 
 Post subject: Re: Some functions and tricks
Unread postPosted: Mon Dec 30, 2013 10:58 pm 
Offline

Joined: Mon Dec 09, 2013 2:40 pm
Posts: 63
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.

For anyone who's interested, I have a short write-up explaining the theory of operation for this function on my website here: http://www.melvilletheatre.com/articles/cstuff/2.html

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.
Code:
!!
* 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 <theatre@melvilletheatre.com> 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"

      result$=chr$(255)
   
      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

text$="Quidquid latine dictum sit, altum viditur."
original=len(text$)
print "original string:\n";text$;"\nlength=" + format$("###",len(text$))
text$=packtext$(text$)
print "compressed string:"
print text$
print "compressed length=";format$("###",len(text$));"\nCompression Ratio=";format$("##",len(text$)/original*100);"%"
text$=packtext$(text$)
print "String Restored:"
print text$
print "length=";format$("###",len(text$))


I was just thinking that since it is possible to create very nice user interfaces in Basic! using html and javascript, this function might be convenient for storing the webpages within the program. Depending on the application, it might save significant space on the device. I have used the C version of this function for similar purposes in the past. I don't know what the best way to store the compressed strings within a Basic! program would be, though -- perhaps sqlite records?


Top
 Profile  
 
 Post subject: Re: Some functions and tricks
Unread postPosted: Sun Feb 16, 2014 1:12 pm 
Offline

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

Code:
!!
!
! 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

    while ( lEnd = 0)
     lStr$ = mid$( pInStr$, lIndex, len( pWhat$))

     if ( lStr$ = pWhat$) then
      lEnd = 1
      lReturn = lIndex
     else
      if len( lStr$ + pWhat$) > len( pInStr$) then
       lEnd = 1
       lReturn = 0
      else
       lIndex = lIndex + 1

       if ( lIndex > len( pInStr$)) then
        lEnd = 1
        lReturn = 0
       endif
      endif
     endif
    repeat
   endif
  endif
endif

fn.rtn lReturn
fn.end % pos()

print "Testing the triming functions"
print ""
lStr$ = chr$( 32) + chr$( 10) + "string to trim" + chr$( 33) + chr$( 10) + chr$( 32)
print "TRIM LEFT  >"; FnText_TrimLeft( &lStr$); "<"
print "]"; lStr$; "["

lStr$ = chr$( 32) + chr$( 10) + "string to trim" + chr$( 33) + chr$( 10) + chr$( 32)
print "TRIM RIGHT >"; FnText_TrimRight( &lStr$); "<"
print "]"; lStr$; "["

lStr$ = chr$( 32) + chr$( 10) + "string to trim" + chr$( 33) + chr$( 10) + chr$( 32)
print "FULL TRIM  >"; FnText_Trim( &lStr$); "<"
print "]"; lStr$; "["

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)"

end


Top
 Profile  
 
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 33 posts ]  Go to page Previous  1, 2, 3, 4  Next


Who is online

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

Search for:
Jump to:  
cron
suspicion-preferred