It is currently Sat Mar 25, 2017 12:32 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: Thu Jan 17, 2013 7:33 am 
Offline

Joined: Sun Jan 22, 2012 3:38 pm
Posts: 19
I've listed some Date functions below:

All function input dates are in "DD/MM/YYYY" format - but the functions could be
easily amended to accept american date format or Y, M,D inputs

1. WeekDay: Returns the day of the week
2. WeekDayName$: Returns the day of the week name as a string
3. DateDiff: Returns the number of days between Dates
4. WeekNumber: Returns the ISO Week Number
5. WeekNumber$:Returns the ISO Week Number in a string

Code:

Fn.Def iStr$(A)
     Fn.Rtn Left$(Str$(A), Len(Str$(A)) - 2)
Fn.End

Fn.Def GetDF(Y, M, D)

    DF = 365 * Y + D + 31 * (M - 1)

    If M < 3 Then
        DF = DF + Floor((Y - 1) / 4) - Floor(3 / 4 * (Floor((Y - 1) / 100) + 1))
    Else
        DF = DF - Floor(0.4 * M + 2.3) + Floor(Y / 4) - Floor(3 / 4 * (Floor(Y / 100) + 1))
    End If

    Fn.Rtn DF

Fn.End

Fn.Def WeekDay(E$)

    !Sunday = 0, Monday = 1 etc

    D = Val(Left$(E$, 2))
    M = Val(Mid$(E$, 4, 2))
    Y = Val(Right$(E$, 4))

    DF = GetDF(Y, M, D)
   
    Fn.Rtn DF - Floor(DF / 7) * 7 - 1
   
Fn.End

Fn.Def WeekDayName$(E$, N)

    Array.Load DayNames$[], "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday"
    If N = 0 Then
        Fn.Rtn DayNames$[WeekDay(E$) + 1]
    Else
        Fn.Rtn Left$(DayNames$[WeekDay(E$) + 1], 3)
    End if

Fn.End

Fn.Def DateDiff(E$, F$)

    D = Val(Left$(E$, 2))
    M = Val(Mid$(E$, 4, 2))
    Y = Val(Right$(E$, 4))

    DF1 = GetDF(Y, M, D)

    D = Val(Left$(F$, 2))
    M = Val(Mid$(F$, 4, 2))
    Y = Val(Right$(F$, 4))

    DF2 = GetDF(Y, M, D)

    Fn.Rtn DF2 - DF1
   
Fn.End

Fn.Def WeekNumber(E$)
   
    Y = Val(Right$(E$, 4))
    I = 0
   
    Do
        I = I + 1
        T = WeekDay(Left$("0" + iStr$(I), 2) + "/01/" + Right$(E$, 4))
    Until T = 4

    I = I - 3
    If I < 1 Then
        Week1St$ = iStr$(31 + I) + "/12/" + iStr$(Y - 1)
    Else
        Week1St$ = "0" + iStr$(I) + "/01/" + Right$(E$, 4)
    End If

    T = 1 + Floor(DateDiff(Week1St$, E$) / 7)
   
    If T = 0 Then T = WeekNumber("31/12/" + iStr$(Y - 1))
    Fn.Rtn T
   
Fn.End

Fn.Def WeekNumber$(E$)
    Fn.Rtn iStr$(Weeknumber(E$))
Fn.End


Top
 Profile  
 
 Post subject: Re: Some functions and tricks
Unread postPosted: Thu Jan 17, 2013 9:11 am 
Offline
User avatar

Joined: Tue Jan 03, 2012 9:31 am
Posts: 5447
Location: Paris, France
Hi, I forgot I wrote these functions as well as others some time ago in this very forum:
viewtopic.php?f=5&t=655

DateToJulian()
JulianToDate$()
IsLeapYear()
EasterDate()
DayOfWeek()
Christian dates...

_________________
- Creator of the Android BASIC! Compiler


Top
 Profile  
 
 Post subject: Re: Some functions and tricks
Unread postPosted: Thu Jan 17, 2013 3:20 pm 
Offline

Joined: Sun Jan 22, 2012 3:38 pm
Posts: 19
Hi

Now that you mention it I recall seeing your functions some time ago - but promptly forgot about them (dementia setting in). I wrote the above functions as I really needed the weeknumber by date for an app I'm writing.


Top
 Profile  
 
 Post subject: Re: Some functions and tricks
Unread postPosted: Fri Jan 18, 2013 3:22 am 
Offline
User avatar

Joined: Tue Jan 03, 2012 9:31 am
Posts: 5447
Location: Paris, France
Great we are complementary ;-)

_________________
- Creator of the Android BASIC! Compiler


Top
 Profile  
 
 Post subject: Re: Some functions and tricks
Unread postPosted: Sat Jan 19, 2013 4:03 am 
Offline

Joined: Sat Dec 22, 2012 2:32 pm
Posts: 801
Hi

a basic formula-parser could be found here:
http://laughton.com/basic/programs/utilities/Parser/

related thread:
post6478.html#p6478

regards,
brochi


Top
 Profile  
 
 Post subject: Re: Some functions and tricks
Unread postPosted: Sun Feb 17, 2013 1:20 pm 
Offline
User avatar

Joined: Mon Oct 17, 2011 9:34 am
Posts: 891
A command for drawing round rectangles is missing from basic.
But can easily be recreated with this function:
Code:
! round rectangle, basic! v1.72 by tony_gr

FN.DEF grRoundRect(x,y,a, BHei,BWth)
GR.ARC arcd1, x,y,x+a,y+a, -90,-90, 0 % top left
GR.ARC arcdd1, x+Bwth-a,y,x+Bwth,y+a, -90,90, 0 % top right
GR.LINE r1,x+a/2,y, x+Bwth-a/2,y % left
GR.LINE r2,x, y+a/2 , x, y +Bhei -a/2 % up
GR.ARC arcd2, x,y +Bhei-a ,x+a,y+Bhei, -180,-90, 0 % bottom left
GR.ARC arcdd2, x+Bwth-a,y +Bhei-a ,x+Bwth,y+Bhei, 0,90, 0 % bottom right
GR.LINE r3,x+a/2, y +Bhei , x+Bwth-a/2, y+Bhei % right
GR.LINE r4,x+bwth, y+a/2 , x+Bwth, y +Bhei-a/2 % down
FN.END

! main
GR.OPEN 255,0,0,0,0,1
PAUSE 1000
GR.ORIENTATION 1

GR.COLOR 255,0,255,0,0 % set last parameter=0
GR.SET.STROKE 4

! X=150 Y=50 r=30 hei=90 wth=170
CALL grRoundRect(150,50,30,90,170)
GR.RENDER

DO
! nothing
UNTIL 0


Based on this we may now create a rounded-bicolor button with some aligned- shadowed text:

Code:
! bicolor rounded button, Basic! v1.72, by Antonis
GR.OPEN 255,0,0,0,0,1
PAUSE 1000
GR.ORIENTATION 1

X=150
Y=50
a=30 % radius
Bhei=80 % button height
Bwth=170 % button width
text$="Basic!"
txtsize=55
c1=55 % text color
c2=55
c3=255
type=4 % 1=Default font, 2=Monospace, 3=San Serif, 4=Serif
shadow=3 % pixels
sc1=255 % shadow text color
sc2=255
sc3=250
bcu1=255 % button color up
bcu2=0
bcu3=0
bcd1=155 % button color down
bcd2=0
bcd3=25

GOSUB roundedbutton
GR.RENDER

DO
UNTIL 0

! bicolor rounded button
roundedbutton:
GR.TEXT.BOLD 1
GR.COLOR 255,bcu1,bcu2,bcu3,1
! 1 up
GR.ARC arcd1, x,y,x+a,y+a, -90,-90, 1
! 2 up
GR.ARC arcdd1, x+Bwth-a,y,x+Bwth,y+a, -90,90, 1
GR.RECT r1,x+a/2,y, x+Bwth-a/2,y+a/2
GR.RECT r2,x, y+a/2 , x+Bwth, y +Bhei/2

GR.COLOR 255,bcd1,bcd2,bcd3,1
! 1 down
GR.ARC arcd2, x,y +Bhei-a ,x+a,y+Bhei, -180,-90, 1
! 2 down
GR.ARC arcdd2, x+Bwth-a,y +Bhei-a ,x+Bwth,y+Bhei, 0,90, 1
GR.RECT r3,x+a/2, y +Bhei-a/2 , x+Bwth-a/2, y+Bhei
GR.RECT r4,x, y+Bhei/2 , x+Bwth, y +Bhei-a/2

GR.TEXT.TYPEFACE type
GR.TEXT.SIZE txtsize
GR.GET.TEXTBOUNDS Text$, left, top, right, bottom
GR.TEXT.ALIGN 2
! first shadow
GR.COLOR 255,sc1,sc2,sc3,1
GR.TEXT.DRAW text1,X+bwth*0.5-shadow,Y+bHei-(bHei+top)*0.5-shadow,Text$
!  then text
GR.COLOR 255,C1,C2,C3,1
GR.TEXT.DRAW text2,X+bwth*0.5,Y+bHei-(bHei+top)*0.5,Text$
GR.TEXT.ALIGN 1
RETURN

:mrgreen:

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


Top
 Profile  
 
 Post subject: round$(nexp)
Unread postPosted: Tue Feb 26, 2013 3:36 am 
Offline

Joined: Wed Feb 20, 2013 3:25 pm
Posts: 421
Location: Italy
The following function allows to transform a number into a string which:
- corresponds to the ROUNDed number
- doesn't contain the tailing ".0"
- doesn't use the exponential notation in case of large numbers
- doesn't contain extra white spaces

FN.DEF round$(n)
f$="##################%"
n$=FORMAT$(f$,ROUND(n))
FN.RTN REPLACE$(n$," ","")
FN.END


Top
 Profile  
 
 Post subject: Re: Some functions and tricks
Unread postPosted: Sun Mar 03, 2013 6:09 am 
Offline
User avatar

Joined: Mon Oct 17, 2011 9:34 am
Posts: 891
A very compat function to create a pie chart.
Insert your positive values in the array and give x,y, and radius.
Powered by -my favourite- gr.arc! :mrgreen:

Code:
! pie chart, basic! v1.73 by tony_gr
FN.DEF pie(ddata[],x,y,r)
ARRAY.SUM sum, ddata[]
ARRAY.LENGTH l, ddata[]
start=0
FOR i=1 TO l
  part=360*ddata[i]/sum
  eend=start+ROUND(part)
  IF i=l THEN eend=360
  j= (start+eend)/2
  GR.COLOR 255,i*40,255-i*50,5+i*50,1
  GR.ARC ar, x-r,y-r,x+r,y+r,-start,-eend+start,1
  x1=x+1.2*r*COS(TORADIANS(j))-10
  y1=y+1.2*r*SIN(TORADIANS(j+180))
  GR.TEXT.DRAW tx,x1,y1,REPLACE$(STR$(ddata[i]),".0","")
  start=eend
NEXT
GR.RENDER
FN.END

! main
GR.OPEN 255,0,0,0,0,1
PAUSE 1000

ARRAY.LOAD ddata[],2.5,12,5,3,7,5,22,5,5,6,7,8,1,5,4

GR.TEXT.SIZE 25
CALL pie(ddata[],200,200,150)

DO
! nothing
UNTIL 0

_________________
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: Fri Mar 29, 2013 5:19 pm 
Offline

Joined: Sat Jun 04, 2011 2:29 pm
Posts: 184
Hi...

Sometimes we need a wait command in text mode.
WAIT Command
Original link:http://rfobasic.freeforums.org/post5910.html#p5910 (Germany)
Code:
!Call with gosub
!When you press BACKKEY it return
..
..
PRINT "Press Backkey to Return"
GOSUB OnBackK
..
..

OnBackK:
wait:
IF wait$ <> "no" THEN GOTO wait
wait$ = ""
RETURN

ONBACKKEY:
wait$="no"
pause 99  %Update 21.11.2012
BACK.RESUME
In my phone works fine.


;==================================
Sometimes we need to put more entries with the INPUT command.
INPUT command combined with SPLIT Command

Original link: none
Code:
INPUT "SomeThings separated with colon(:) ", string$,"aa:bb:cc:dd"
argument$ = ":"
split result$[], string$, argument$
array.length length, result$[]
for i = 1 to length
   a1$=result$[1]
   b1$=result$[2]
   c1$=result$[3]
   d1$=result$[4]
next i
Print " "
Print a1$,b1$,c1$,d1$


Top
 Profile  
 
 Post subject: Re: Some functions and tricks
Unread postPosted: Thu Apr 11, 2013 8:44 am 
Offline

Joined: Sat Jun 04, 2011 2:29 pm
Posts: 184
Hello....

Copy Files and Directories
Original link:
http://rfobasic.freeforums.org/post7279.html#p7279

In order to copy a single file
Code:
FN.DEF COPY(srcFile$, destFile$)
  BYTE.OPEN r, fid, srcFile$
  BYTE.COPY fid, destFile$
  ! No need to close fid, it's closed by the BYTE.COPY
FN.END


In order to copy a directory full of files (recursively, including sub-folders full of files too)
Code:
FN.DEF DIR_COPY(srcFolder$, destFolder$)
  ! Both srcFolder$ and destFolder$ must finish with a "/"
  FILE.MKDIR destFolder$
  FILE.DIR srcFolder$, srcFiles$[]
  ARRAY.LENGTH n, srcFiles$[]
  FOR i=1 TO n
    IF RIGHT$(srcFiles$[i], 3) = "(d)" THEN
      subFolder$ = LEFT$(srcFiles$[i], LEN(srcFiles$[i]) - 3) + "/"
      CALL DIR_COPY(srcFolder$+subFolder$, destFolder$+subFolder$)
    ELSE
      CALL COPY(srcFolder$+srcFiles$[i], destFolder$+srcFiles$[i])
    END IF
  NEXT
FN.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:  
suspicion-preferred