Liberty BASIC Community Forum
« Sample Program .bas code »

Welcome Guest. Please Login or Register.
Sep 21st, 2017, 12:17am


Rules|Home|Help|Search|Recent Posts|Notification


« Previous Topic | Next Topic »
Pages: 1 2 3  ...  7 Notify Send Topic Print
 locked  Author  Topic: Sample Program .bas code  (Read 905 times)
Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Sample Program .bas code
« Thread started on: Aug 5th, 2017, 02:11am »

This thread will host the updated .bas code for the sample programs that ship with Liberty BASIC. General discussions on the previous thread.
« Last Edit: Aug 5th, 2017, 10:03am by Rod » User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program amPmTime.bas
« Reply #1 on: Aug 5th, 2017, 02:13am »

amPmTime.bas

Code:
    'the function take "hh:mm:ss" in 24hr format
    'and returns "hh:mm:ss" in 12hr format

    print amPmTime$("00:30:30")
    print amPmTime$("12:30:30")

    'you can also send it the current time using the time$() function
    print amPmTime$(time$())
    wait

function amPmTime$(t$)

    'extract the hour24 value from t$ using the val() and word$() functions
    hour24 = val(word$(t$,1,":"))


    'truncate t$ to the remaining "mm:ss" and
    'append to ":" using the after$() function
    t$=":"+after$(t$,":")

    'are we AM or PM?
    select case
        case hour24 > 12
            'set to 12hr PM format deduct 12 hours
            hour12 = hour24 - 12
            amOrPm$ = " PM"
        case hour24 = 12
            'set to 12hr PM format
            hour12 = hour24
            amOrPm$ = " PM"
        case hour24 < 12
            'handle midnight and set to 12hr AM format
            hour12 = hour24
            if hour12 = 0 then hour12 = 12
            amOrPm$ = " AM"
    end select

    'set the hour value back to a leading zero string
    'so if the hour12 is 1 it becomes "01"
    h$=right$("00"+str$(hour12),2)

    'now pass the result back to the main program in the function name
    'build the result by adding the component strings together
    amPmTime$ = h$ + t$ + amOrPm$
end function

 
« Last Edit: Aug 5th, 2017, 10:04am by Rod » User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program ascii.bas
« Reply #2 on: Aug 5th, 2017, 02:33am »

ascii.bas

Code:
    'This lists the ascii value of characters in a string

    input "Please enter a string >"; entry$

    'for all characters in the string
    for i = 1 to len(entry$)
        'use mid$() function to get i-th letter
        c$=mid$(entry$,i,1)
        'then asc() to get the ascii value
        print c$, asc(c$)
    next  
« Last Edit: Aug 5th, 2017, 10:04am by Rod » User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program binaryFileExample.bas
« Reply #3 on: Aug 5th, 2017, 02:37am »

binaryFileExample.bas

should be called fileOpsBinary.bas

fileOpsSequential.bas and fileOpsRAF.bas need written

Code:
    'This program shows basic binary file operation
    'first create a file and put some text in it.
    open "myfile.dat" for output as #my
    #my "hey diddle diddle"
    close #my

    'Now open the file in binary mode, seek to
    'a specific place and read or write some text.
    open "myfile.dat" for binary as #my
    'move the record pointer to position 4 and see what is there now
    seek #my, 4
    print input$(#my, 6)
    'move the record pointer back and rewrite the value
    seek #my, 4
    #my "doddle"
    'move the record pointer back and check what is there now
    seek #my, 4
    print input$(#my, 6)

    close #my
  



fileOpsSequential.bas

Code:
    'This program shows basic sequential file operation
    'first create a file and put some text in it.
    open "myfile.dat" for output as #my
    #my "hey diddle diddle"
    close #my

    'Now open the file in sequential mode
    open "myfile.dat" for input as #my

    'read in the contents to an array
    dim text$(10)
    dat=1
    while eof(#my) = 0
        text$(dat)=INPUTTO$(#my, " ")
        dat=dat+1
    wend
    close #my

    'see what data item 2 is
    print text$(2)

    'rewrite the value
    text$(2)="doddle"

    'rewrite the file sequentially
    open "myfile.dat" for output as #my
    for i=1 to dat-1
    #my text$(i)+" "
    print text$(i)+" ";
    next
    close #my

 


fileOpsRAF.bas

Code:
 'This program shows basic RAF file operation
    'first create a file and put some text in it.
    open "myfile.dat" for output as #my
    #my "heydiddlediddle"
    close #my

    'Now open the file in RAF mode
    open "myfile.dat" for random as #my  LEN=15
    FIELD #my,3 as first$,6 as second$,6 as third$

    'get record 1 so filling the fields
    get #my,1
    print second$

    'rewrite the field value and put it back in the file
    second$="doddle"
    put #my,1

    'check what is there now
    get #my,1
    print first$+" "+second$+" "+third$

    close #my

 
« Last Edit: Aug 5th, 2017, 10:04am by Rod » User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program bitmap.bas
« Reply #4 on: Aug 5th, 2017, 02:38am »

bitmap.bas

should be called bmpbutton.bas

Code:

    'this program sets and amends the bmp background of a bmpbutton

    nomainwin
    'first load two spare bmp images and name them
    loadbmp "arrow", "bmp\arrwbttn.bmp"
    loadbmp "blue", "bmp\bluebttn.bmp"
    'set up the bmpbuttons with their initial blank image, another bmp from file
    bmpbutton #main.button1, "bmp\blank4.bmp", [button1Click], UL, 22, 11
    bmpbutton #main.button2, "bmp\blank4.bmp", [button2Click], UL, 22, 46
    open "Bmpbutton demo" for window as #main
    #main "trapclose [quit]"
    wait

    [button1Click]
    #main.button2 "setfocus"        'setfocus highlights the named button
    #main.button2 "bitmap arrow"    'use the named bmp images in the buttons
    #main.button1 "bitmap blue"
    wait

    [button2Click]
    #main.button1 "setfocus"
    #main.button1 "bitmap arrow"
    #main.button2 "bitmap blue"

    'the button that has focus will fire if "Enter is pressed.

    wait



    [quit]
    close #main
    unloadbmp "arrow"
    unloadbmp "blue"
    end
  
« Last Edit: Aug 5th, 2017, 10:05am by Rod » User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program boxes.bas
« Reply #5 on: Aug 5th, 2017, 03:06am »

boxes.bas

This is really about flush and segments.


Code:
    'This program draws some boxes and introduces the drawing commands
    'flush, segment, delsegment and redraw
    'all you will see on screen is THREE boxes, use the debugger and step
    'through the program to see SIX boxes being drawn initially.

    nomainwin

    'set up some colors
    dim color$(6)
    color$(1) = "red"
    color$(2) = "brown"
    color$(3) = "yellow"
    color$(4) = "green"
    color$(5) = "blue"
    color$(6) = "darkpink"



    open "Boxes" for graphics as #1
        #1 "trapclose [quit]"

        'now draw SIX boxes, flush to save SIX drawn segments
        'we will later remove some of those segments
        #1 "down ; size 2"
        for x = 10 to 60 step 10
            #1 "color "; color$(x/10)
            #1 "place ";x;" ";x
            #1 "box "; x+60 ; " ";x+60
            #1 "flush"
        next x

        'now, just to prove it can be done, we will remove every
        'second segment and then redraw the remaining THREE segments
        'first we get the last drawn segment number
        #1 "segment segId"
        'now loop and delete every second one
        for x = 1 to segId - 1 step 2
            #1 "delsegment "; x
        next x
        'redraw all remaining segments
        #1 "redraw"
        wait

    [quit]
    close #1
    end

 
« Last Edit: Aug 5th, 2017, 10:05am by Rod » User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program browseForFolder.bas code
« Reply #6 on: Aug 5th, 2017, 10:07am »

browseForFolder.bas

This is a version coded by Stefan Pendal. Earlier code produces random protection violation crashes.


Code:
    'There are many discussions on conforums that include browse for folder code
    'Stefan Pendal provides this code which appears stable.
    'Older versions give an occasional protection violation error

    'The purpose of this code is to open a dialog for the user to choose a destination folder

    crlf$ = chr$(13) + chr$(10)
    Hint$ = "Select any folder"; crlf$; "--------------------"; crlf$; "or CANCEL to exit"
    Caption$ = "Select destination folder"
    RootDir$ = "11"
    SelectedDir$ = "C:\Programme\7-Zip"
    DialogStyle$ = ""

    print BrowseForFolder$(Caption$, Hint$, RootDir$, SelectedDir$, DialogStyle$)
end

function BrowseForFolder$(Caption$, Hint$, RootDirID$, StartDir$, Style$)
' returns the selected folder
'
' Hint$ can use up to three lines for the new style dialog (default)
' and up to two lines for the old style dialog,
' use CRLF to seperate the lines
'
' using the old style dialog includes a status text

    open "ole32" for dll as #ole32

    BIF.RETURNONLYFSDIRS   = 1
    BIF.DONTGOBELOWDOMAIN  = 2
    BIF.STATUSTEXT         = 4
    BIF.RETURNFSANCESTORS  = 8
    BIF.EDITBOX            = hexdec("10")
    BIF.VALIDATE           = hexdec("20")
    BIF.NEWDIALOGSTYLE     = hexdec("40")
    BIF.USENEWUI           = BIF.NEWDIALOGSTYLE or BIF.EDITBOX
    BIF.BROWSEINCLUDEURLS  = hexdec("80")
    BIF.UAHINT             = hexdec("100")
    BIF.NONEWFOLDERBUTTON  = hexdec("200")
    BIF.NOTRANSLATETARGETS = hexdec("400")
    BIF.BROWSEFORCOMPUTER  = hexdec("1000")
    BIF.BROWSEFORPRINTER   = hexdec("2000")
    BIF.BROWSEINCLUDEFILES = hexdec("4000")
    BIF.SHAREABLE          = hexdec("8000")

    STRUCT BrowseInfo,_
        hWndOwner       As ulong,_
        pIDLRoot        As ulong,_
        pszDisplayName$ As ptr,_
        lpszTitle$      As ptr,_
        ulFlags         As uLong,_
        lpfnCallback    As uLong,_
        lParam$         As ptr,_
        iImage          As uLong,_
        dlgCaption$     As ptr

    BrowseInfo.lpszTitle$.struct  = Hint$
    BrowseInfo.pIDLRoot.struct    = GetSpecialfolderIDL(hexdec(RootDirID$))
    BrowseInfo.lParam$.struct     = StartDir$ + chr$(0)
    BrowseInfo.dlgCaption$.struct = Caption$

    BrowseInfo.pszDisplayName$.struct = space$(_MAX_PATH)

    select case lower$(Style$)
        case "old"
            BrowseInfo.ulFlags.struct = BIF.RETURNONLYFSDIRS or BIF.STATUSTEXT
        case else
            BrowseInfo.ulFlags.struct = BIF.RETURNONLYFSDIRS or BIF.NEWDIALOGSTYLE or BIF.NONEWFOLDERBUTTON
    end select

    callback lpfn, BrowseCallbackProc(handle, ulong, ulong, ulong), ulong

    BrowseInfo.lpfnCallback.struct = lpfn

    calldll #shell32, "SHBrowseForFolder",_
        BrowseInfo as struct,_
        lpIDList   as ulong

    If lpIDList > 0 Then
        BrowseForFolder$ = SHGetPathFromIDList$(lpIDList)

        calldll #ole32, "CoTaskMemFree",_
            lpIDList as ulong,_
            result   as void
    End If

    close #ole32
end function

function BrowseCallbackProc(Handle, Message, lParam, lpData)
    BFFM.INITIALIZED     = 1
    BFFM.SELCHANGED      = 2
    BFFM.VALIDATEFAILEDA = 3
    BFFM.VALIDATEFAILEDW = 4
    BFFM.IUNKNOWN        = 5

    BFFM.SETSTATUSTEXTA = _WM_USER + 100
    BFFM.ENABLEOK       = _WM_USER + 101
    BFFM.SETSELECTIONA  = _WM_USER + 102
    BFFM.SETSELECTIONW  = _WM_USER + 103
    BFFM.SETSTATUSTEXTW = _WM_USER + 104
    BFFM.SETOKTEXT      = _WM_USER + 105
    BFFM.SETEXPANDED    = _WM_USER + 106

    select case Message
        case BFFM.INITIALIZED
            Folder$ = winstring(lpData)
            Caption$ = winstring(BrowseInfo.dlgCaption$.struct)
            if Caption$ <> "" then call SetWindowText Handle, Caption$
            if Folder$ <> "" then call PostMessageString Handle, BFFM.SETSELECTIONA, 1, Folder$
        case BFFM.SELCHANGED
            selFolder$ = SHGetPathFromIDList$(lParam)
            if selFolder$ <> "" then call PostMessageString Handle, BFFM.SETSTATUSTEXTA, 1, selFolder$
    end select

    SetFolderPath = 0
end function

function SHGetPathFromIDList$(lpIDList)
    sPath$ = space$(_MAX_PATH) + chr$(0)

    calldll #shell32, "SHGetPathFromIDListA",_
        lpIDList as ulong,_
        sPath$   as ptr,_
        result   as boolean

    SHGetPathFromIDList$ = trim$(sPath$)
end function

sub SetWindowText Handle, Text$
    calldll #user32, "SetWindowTextA", _
        Handle as ulong, _
        Text$  as ptr, _
        result as ulong
end sub

sub PostMessageString Handle, Message, wParam, lParam$
    calldll #user32, "PostMessageA", _
        Handle  as ulong, _
        Message as ulong, _
        wParam  as ulong, _
        lParam$ as ptr, _
        result  as ulong
end sub

Function GetSpecialfolderIDL(CSIDL)
' Get Special Folders
' from Mastering Liberty BASIC 3
'
' Folder ID 00: CSIDL_DESKTOP
' Folder ID 01: CSIDL_INTERNET
' Folder ID 02: CSIDL_PROGRAMS
' Folder ID 03: CSIDL_CONTROLS
' Folder ID 04: CSIDL_PRINTERS
' Folder ID 05: CSIDL_PERSONAL
' Folder ID 06: CSIDL_FAVORITES
' Folder ID 07: CSIDL_STARTUP
' Folder ID 08: CSIDL_RECENT
' Folder ID 09: CSIDL_SENDTO
' Folder ID 0A: CSIDL_BITBUCKET
' Folder ID 0B: CSIDL_STARTMENU
' Folder ID 0C: CSIDL_MYDOCUMENTS
' Folder ID 0D: CSIDL_MYMUSIC
' Folder ID 0E: CSIDL_MYVIDEO
' Folder ID 0F: Error
' Folder ID 10: CSIDL_DESKTOPDIRECTORY
' Folder ID 11: CSIDL_DRIVES
' Folder ID 12: CSIDL_NETWORK
' Folder ID 13: CSIDL_NETHOOD
' Folder ID 14: CSIDL_FONTS
' Folder ID 15: CSIDL_TEMPLATES
' Folder ID 16: CSIDL_COMMON_STARTMENU
' Folder ID 17: CSIDL_COMMON_PROGRAMS
' Folder ID 18: CSIDL_COMMON_STARTUP
' Folder ID 19: CSIDL_COMMON_DESKTOPDIRECTORY
' Folder ID 1A: CSIDL_APPDATA
' Folder ID 1B: CSIDL_PRINTHOOD
' Folder ID 1C: CSIDL_LOCAL_APPDATA
' Folder ID 1D: CSIDL_ALTSTARTUP
' Folder ID 1E: CSIDL_COMMON_ALTSTARTUP
' Folder ID 1F: CSIDL_COMMON_FAVORITES
' Folder ID 20: CSIDL_INTERNET_CACHE
' Folder ID 21: CSIDL_COOKIES
' Folder ID 22: CSIDL_HISTORY
' Folder ID 23: CSIDL_COMMON_APPDATA
' Folder ID 24: CSIDL_WINDOWS
' Folder ID 25: CSIDL_SYSTEM
' Folder ID 26: CSIDL_PROGRAM_FILES
' Folder ID 27: CSIDL_MYPICTURES
' Folder ID 28: CSIDL_PROFILE
' Folder ID 29: CSIDL_SYSTEMX86
' Folder ID 2A: CSIDL_PROGRAM_FILESX86
' Folder ID 2B: CSIDL_PROGRAM_FILES_COMMON
' Folder ID 2C: CSIDL_PROGRAM_FILES_COMMONX86
' Folder ID 2D: CSIDL_COMMON_TEMPLATES
' Folder ID 2E: CSIDL_COMMON_DOCUMENTS
' Folder ID 2F: CSIDL_COMMON_ADMINTOOLS
' Folder ID 30: CSIDL_ADMINTOOLS
' Folder ID 31: CSIDL_CONNECTIONS
' Folder ID 32: Error
' Folder ID 33: Error
' Folder ID 34: Error
' Folder ID 35: CSIDL_COMMON_MUSIC
' Folder ID 36: CSIDL_COMMON_PICTURES
' Folder ID 37: CSIDL_COMMON_VIDEO
' Folder ID 38: CSIDL_RESOURCES
' Folder ID 39: CSIDL_RESOURCES_LOCALIZED
' Folder ID 3A: CSIDL_COMMON_OEM_LINKS
' Folder ID 3B: CSIDL_CDBURN_AREA
' Folder ID 3C: Error
' Folder ID 3D: CSIDL_COMPUTERSNEARME
' Folder ID 3E: CSIDL_PROFILES
' Folder ID 3F: Error

    struct IDL, _
        cb   As uLong, _
        abID As short

    calldll #shell32, "SHGetSpecialFolderLocation",_
        0     as ulong, _
        CSIDL as ulong, _
        IDL   as struct,_
        ret   as ulong

    if ret = 0 then GetSpecialfolderIDL = IDL.cb.struct
End Function

 
« Last Edit: Aug 5th, 2017, 10:08am by Rod » User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program Buttons1.bas
« Reply #7 on: Aug 5th, 2017, 10:25am »

Buttons1.bas

Code:
    'This is a turtle graphics demo for Liberty BASIC
    'it shows how menu and button input coexists

    nomainwin

    size = 100
    color$ = "Red"

    button #1, "Triangle", [triangle], LR, 170, 10
    button #1, "Square", [square], LR, 90, 10
    button #1, "Size", [size], LR, 25, 10
    button #1, "Red", [colorRed], UL, 5, 5
    button #1, "Blue", [colorBlue], UL, 46, 5
    button #1, "Green", [colorGreen], UL, 95, 5
    menu #1, &Colors, &red, [colorRed], &blue, [colorBlue], &green, [colorGreen]
    menu #1, &Options, &square, [square], &triangle, [triangle], &size, [size], |, &quit, [quit]
    open "Turtle graphics" for graphics_nsb as #1

    #1 "trapclose [quit]"
    wait


[triangle]
    #1 "delsegment seg"
    #1 "color "; color$
    #1 "cls ; home ; down ; north"
    for x = 1 to size
        #1 "turn 122 ; go "; str$(x*2)
    next x
    #1 "flush seg"
    wait


[square]
    #1 "delsegment seg"
    #1 "color "; color$
    #1 "cls ; home ; down ; north"
    for x = 1 to size
        #1 "turn 88 ; go "; str$(x*2)
    next x
    #1 "flush seg"
    wait

[colorRed]
    color$ = "red"
    wait

[colorBlue]
    color$ = "blue"
    wait

[colorGreen]
    color$ = "green"
    wait

[size]
    prompt "What size figure?"; size
    if size<0 then size=10
    if size>200 then size=200
    wait

[quit]
    close #1
    end



 

« Last Edit: Aug 5th, 2017, 10:26am by Rod » User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program Calc2.bas
« Reply #8 on: Aug 5th, 2017, 10:40am »

Calc2.bas

Not much to fix here, I widened the window just a tad and changed print #calc, to #calc Oh! and trapclose [quit], thanks Richard.

Code:
    'CALC2.BAS - calculator for Liberty BASIC
    nomainwin

    menu #calc, "&About Calc", "Calc &Info", [info]
    button #calc, " 0 ", [button0], LL, 5, -12
    button #calc, " . ", [buttonPoint], LL, 40, -12
    button #calc, " = ", [buttonEquals], LL, 75, -12
    button #calc, "CLR", [buttonClear], LL, 110, -12
    button #calc, " 1 ", [button1], LL, 5, 16
    button #calc, " 2 ", [button2], LL, 40, 16
    button #calc, " 3 ", [button3], LL, 75, 16
    button #calc, " / ", [buttonDivide], LL, 110, 16
    button #calc, " 4 ", [button4], LL, 5, 44
    button #calc, " 5 ", [button5], LL, 40, 44
    button #calc, " 6 ", [button6], LL, 75, 44
    button #calc, " X ", [buttonMultiply], LL, 110, 44
    button #calc, " 7 ", [button7], LL, 5, 72
    button #calc, " 8 ", [button8], LL, 40, 72
    button #calc, " 9 ", [button9], LL, 75, 72
    button #calc, " - ", [buttonSubtract], LL, 110, 72
    button #calc, " + ", [buttonAdd], LL, 110, 100
    WindowWidth = 160
    WindowHeight = 280
    open "Calculator" for graphics_nsb_nf as #calc
    #calc "trapclose [quit]"
    #calc "font helv 12"

    ' set display$ up as two spaces
    display$ = "? "
    ' set up a shortcut for printing the entry line only
    blanks$ = "\"+chr$(13)+" "


    ' wait for a button to be pressed
    wait


[display]  ' update the entire display

    buffer$ = chr$(13)
    for i = 6 to 2 step -2
        buffer$ = buffer$ + " " + word$(lines$, i - 1) + " " + word$(lines$, i) + "                 " + chr$(13)
    next i
    #calc "cls"
    #calc "\" + buffer$ + "                   "
    gosub [displayEntry]
    #calc "flush"

  return


[displayEntry]  ' display the current entry line only

    #calc "place 0 0"
    #calc blanks$ + display$
    #calc "flush"

  return


[button0]  ' 0 was pressed

    display$ = display$ + "0"
    gosub [displayEntry]
    wait

[button1]  ' 1 was pressed

    display$ = display$ + "1"
    gosub [displayEntry]
    wait

[button2]  ' 2 was pressed

    display$ = display$ + "2"
    gosub [displayEntry]
    wait

[button3]  ' 3 was pressed

    display$ = display$ + "3"
    gosub [displayEntry]
    wait

[button4]  ' 4 was pressed

    display$ = display$ + "4"
    gosub [displayEntry]
    wait

[button5]  ' 5 was pressed

    display$ = display$ + "5"
    gosub [displayEntry]
    wait

[button6]  ' 6 was pressed

    display$ = display$ + "6"
    gosub [displayEntry]
    wait

[button7]  ' 7 was pressed

    display$ = display$ + "7"
    gosub [displayEntry]
    wait

[button8]  ' 8 was pressed

    display$ = display$ + "8"
    gosub [displayEntry]
    wait

[button9]  ' 9 was pressed

    display$ = display$ + "9"
    gosub [displayEntry]
    wait


[buttonPoint]  ' the decimal point button was pressed

    ' only allow one decimal point per entry
    if instr(display$, ".") > 0 then wait

    display$ = display$ + "."
    gosub [displayEntry]
    wait


[buttonClear]  ' the CLR button was pressed, clear the entry

    display$ = "? "
    gosub [display]
    wait


[buttonAdd]  ' the + button was pressed

    if len(display$) = 2 then display$ = "+ " : gosub [displayEntry] : wait
    gosub [resolvePending]
    display$ = "+ "
    gosub [display]
    wait


[buttonSubtract]  ' the - button was pressed

    if len(display$) = 2 then display$ = "- " : gosub [displayEntry] : wait
    gosub [resolvePending]
    display$ = "- "
    gosub [display]
    wait


[buttonMultiply]  ' the X button was pressed

    if len(display$) = 2 then display$ = "X " : gosub [displayEntry] : wait
    gosub [resolvePending]
    display$ = "X "
    gosub [display]
    wait


[buttonDivide]

    if len(display$) = 2 then display$ = "/ " : gosub [displayEntry] : wait
    gosub [resolvePending]
    display$ = "/ "
    gosub [display]
    wait


[buttonEquals]  ' the = button was pressed

    if len(display$) = 2 then display$ = "= " : gosub [displayEntry] : wait
    gosub [resolvePending]
    display$ = "? "
    gosub [display]
    wait


[resolvePending]

    'take the bottom-most two items and perform the appropriate
    'operation (if any)

    first = val(word$(lines$, 2))
    second = val(word$(display$, 2))
    op$ = left$(display$, 1)

    lines$ = display$ + " " + lines$

    if op$ = "+" then lines$ = "= " + str$(first + second) + " " + lines$ : return
    if op$ = "-" then lines$ = "= " + str$(first - second) + " " + lines$ : return
    if op$ = "X" then lines$ = "= " + str$(first * second) + " " + lines$ : return
    if op$ = "/" then lines$ = "= " + str$(first / second) + " " + lines$ : return
    if op$ = "=" or op$ = "?" then lines$ = "= " + str$(second) + " " + lines$ : return

  return

[info]

    notice "About Calc"  + chr$(13) + "Calc, a Liberty BASIC Application"
    wait


[quit]
close #calc
end


 
« Last Edit: Aug 5th, 2017, 11:10am by Rod » User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program call32-4.bas
« Reply #9 on: Aug 5th, 2017, 11:18am »

Needs work
User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program checkbox.bas
« Reply #10 on: Aug 5th, 2017, 11:20am »

checkbox.bas

Just needed slight tidy and move away from input loop to wait style of program flow.

Code:

    ' This code demonstrates how to use checkboxes in your
    ' Liberty BASIC programs

    nomainwin

    button #1, "&Ok", [quit], UL, 120, 90, 40, 25
    checkbox #1.cb, "I am a checkbox", [set], [reset], 10, 10, 130, 20
    button #1, "Set", [set], UL, 10, 50
    button #1, "Reset", [reset], UL, 50, 50
    textbox #1.text, 10, 90, 100, 24

    WindowWidth = 180
    WindowHeight = 160
    open "Checkbox test" for dialog as #1
    #1 "trapclose [quit]"
    wait


[set]
    #1.cb "set"
    goto [readCb]

[reset]
    #1.cb "reset"
    goto [readCb]

[readCb]
    #1.cb "value?"
    input #1.cb, t$
    #1.text "I am "; t$
    wait

[quit]
    close #1
    end
 
User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program circles.bas
« Reply #11 on: Aug 5th, 2017, 11:24am »

circles.bas

Just a tidy


Code:

    ' draw a set of concentric circles
    nomainwin
    dim color$(4)
    color$(1) = "red"
    color$(2) = "blue"
    color$(3) = "green"
    color$(4) = "yellow"

    open "Circles" for graphics as #1
    #1 "trapclose [quit]"

    count = 1
    #1 "home"
    #1 "down"
    #1 "size 6"
    for x = 124 to 0 step -12
        #1 "color "; color$(count)
        count = count + 1
        if count > 4 then count = 1
        #1 "circle "; x
    next x
    #1 "flush"
    wait

[quit]
    close #1
    end

 
User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program clock2.bas
« Reply #12 on: Aug 5th, 2017, 11:57am »

clock2.bas

Should be called clock3.bas Richard fixes some flaws in the drawing of the hands and uses the simpler delete named segment option.

Code:

    'clock3.bas  - a clock program for Liberty BASIC
    'corrections by Richard T Russell
     nomainwin
     WindowWidth = 120
     WindowHeight = 144
     open "Clock" for graphics_nsb_nf as #clock
     #clock "trapclose [exit]"

     #clock "fill white"
     for angle = 0 to 330 step 30
         #clock "up ; home ; north ; turn "; angle
         #clock "go 40 ; down ; go 5"
     next angle

     #clock "flush segId"

    'start a timer to update the clock display every second
     timer 1000, [display]
     wait

[display]

     time$ = time$()
     second.deg = val(right$(time$, 2)) * 6
     minute.deg = val(mid$(time$, 4, 2)) * 6 + int(second.deg / 60)
     hour.deg = val(time$) * 30 + int(minute.deg / 12)
     if hour.deg >= 360 then hour.deg = hour.deg - 360

     ' delete the named ie last drawn segment
     #clock "delsegment segId"

     ' erase each hand if its position has changed
     #clock "color white"
     if oldSecond.deg <> second.deg then #clock "size 1 ; home ; north ; turn "; oldSecond.deg ; " ; go 38" : oldSecond.deg = second.deg
     if oldMinute.deg <> minute.deg then #clock "size 2 ; home ; north ; turn "; oldMinute.deg ; " ; go 38" : oldMinute.deg = minute.deg
     if oldHour.deg <> hour.deg then     #clock "size 2 ; home ; north ; turn "; oldHour.deg; " ; go 19" : oldHour.deg = hour.deg

     ' redraw all three hands, second hand first
     #clock "color black"
     #clock "size 1 ; home ; north ; turn "; second.deg ; " ; go 38"
     #clock "size 2 ; home ; north ; turn "; minute.deg ; " ; go 38"
     #clock "size 2 ; home ; north ; turn "; hour.deg; " ; go 19"

     ' flush to end segment, then get the next segment id #
     #clock "flush segId"
     wait

[exit]

     timer 0   'prevent timer ticks from building up
     confirm "Quit Clock?"; q$
     if q$ = "yes" then
         close #clock
     else
         timer 1000, [display]
         wait
     end if

     end




 
« Last Edit: Aug 7th, 2017, 02:29am by Rod » User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program collides.bas
« Reply #13 on: Aug 5th, 2017, 3:58pm »

collides.bas

Tidy, including removing trailing ; and timer added to make program run visible.

Code:
    'demonstrate sprite collision in Liberty BASIC
    'list$ will contain the name of colliding sprites
    'found each cycle

    loadbmp "smiley1", "sprites\smiley1.bmp"
    loadbmp "smiley2", "sprites\smiley2.bmp"
    loadbmp "smiley3", "sprites\smiley3.bmp"
    loadbmp "smiley4", "sprites\smiley4.bmp"
    loadbmp "landscape", "sprites\bg1.bmp"
    WindowHeight = 300
    WindowWidth = 400
    graphicbox #w.g, 0, 0, 400, 300
    open "sprite test" for window_nf as #w
    #w "trapclose [quit]"

    #w.g "down ; background landscape"
    #w.g "addsprite smiley smiley1 smiley2 smiley3 smiley4"
    #w.g "addsprite smiler smiley1 smiley2 smiley3 smiley4"
    #w.g "addsprite smiled smiley1 smiley2 smiley3 smiley4"
    #w.g "addsprite smiles smiley1 smiley2 smiley3 smiley4"
    #w.g "cyclesprite smiley 1"
    #w.g "cyclesprite smiler 1"
    #w.g "cyclesprite smiled 1"
    #w.g "cyclesprite smiles 1"
    timer 112, [draw]
    wait

    [draw]
    #w.g "spritexy smiley "; x; " "; x
    #w.g "spritexy smiler "; 100-x; " "; x
    #w.g "spritexy smiled "; 100-x; " "; 100-x
    #w.g "spritexy smiles "; x; " "; 100-x
    #w.g "drawsprites";
    #w.g "spritecollides smiley list$"
    if list$ > "" then print list$
    x=x+5
    if x>100 then [quit]
    wait


[quit]
    timer 0
    close #w
    end

 
« Last Edit: Aug 5th, 2017, 4:18pm by Rod » User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program colordialog.bas
« Reply #14 on: Aug 6th, 2017, 02:59am »

colordialog.bas

Tidy and a window to show results.


Code:

    'This program launches a color dialog to get users color choice
    nomainwin


    open "Color Picker" for graphics as #1
    #1 "down ; trapclose [quit]"

    'lets fine tune a light red color
    color$="255 100 100"
    colordialog color$, r$
    #1 "fill ";r$
    wait


    [quit]
    close #1
    end
 
User IP Logged

Pages: 1 2 3  ...  7 Notify Send Topic Print
« Previous Topic | Next Topic »

Rules|Home|Help|Search|Recent Posts|Notification

Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls