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 4 5  ...  7 Notify Send Topic Print
 locked  Author  Topic: Sample Program .bas code  (Read 902 times)
Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program exponent.bas
« Reply #30 on: Aug 7th, 2017, 09:46am »

exponent.bas

Quite a few changes, added transparent text handling.


Code:
    'draw an exponential graph in a graphic box
    'using transparent background text drawing
    nomainwin

    WindowWidth=350
    WindowHeight=350
    graphicbox #g.gb 5,5,303,303
    open "Expo Curve" for graphics_nsb as #g
    #g "trapclose [quit]"

    'get the handle of the graphicbox and associated DC
    hw=hwnd(#g.gb)
    CallDll #user32, "GetDC",_
    hw as ulong,_   'handle of graphic box
    hdc as ulong    'handle of its DC


    'set the graphics box to transparent text background
    calldll #gdi32, "SetBkMode",_
        hdc AS ulong,_
        _TRANSPARENT AS long,_
        ret AS long

    #g.gb "font courier_new 6"
    #g.gb "color blue"
    #g.gb "down"

    for x = 0 to 300 step 25
        #g.gb "line "; x ; " 0"; " "; x ; " 300"
        #g.gb "line 0 "; x; " 300 "; x
    next x

    #g.gb "place 0 0"
    #g.gb "color red"
    for x = 1 to 270 step 10
        #g.gb "line ";oldx;" ";oldy;" ";x;" ";(x * x / 260)
        #g.gb "place "; x+5 ; " "; (x * x / 260)
        #g.gb "\";using("####.##",x * x / 260)
        oldx=x: oldy=(x * x / 260)
    next x

    #g.gb "place 0 248"
    #g.gb "font courier_new 24 bold"
    #g.gb "color green"
    #g.gb "\Exponential \Plot "
    #g.gb "flush"
    wait

[quit]
    close #g
    end
 
User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program factoril.bas
« Reply #31 on: Aug 7th, 2017, 09:52am »

factorial.bas

a few explanatory words added


Code:
    'The factorial of n is calculated by the product of integer numbers from 1 to n.


    input "Factorial of?"; n

    print factorial(n)
    end

function factorial(n)
    'note that the function recursively calls itself
    'until n=1, then it returns
    if n = 1 then
        factorial = n
    else
        factorial = n * factorial(n-1)
    end if
end function
 
« Last Edit: Aug 7th, 2017, 09:52am by Rod » User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program fileExists.bas
« Reply #32 on: Aug 7th, 2017, 09:57am »

fileExists.bas


Unchanged


Code:
    'fileExists.bas - Show how to determine if a file exists
    dim info$(10,10)
    input "Type a file path (ie. c:\windows\somefile.txt)?"; fpath$
    if fileExists(fpath$) then
        print fpath$; " exists!"
      else
        print fpath$; " doesn't exist!"
    end if
    end

'return a true if the file in fullPath$ exists, else return false
function fileExists(fullPath$)
    files pathOnly$(fullPath$), filenameOnly$(fullPath$), info$()
    fileExists = val(info$(0, 0)) > 0
end function

'return just the directory path from a full file path
function pathOnly$(fullPath$)
    pathOnly$ = fullPath$
    while right$(pathOnly$, 1) <> "\" and pathOnly$ <> ""
        pathOnly$ = left$(pathOnly$, len(pathOnly$)-1)
    wend
end function

'return just the filename from a full file path
function filenameOnly$(fullPath$)
    pathLength = len(pathOnly$(fullPath$))
    filenameOnly$ = right$(fullPath$, len(fullPath$)-pathLength)
end function

 
User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program fontpowr.bas
« Reply #33 on: Aug 11th, 2017, 03:53am »

fontpowr.bas


Just tidied


Code:
    'A graphic control can display multiple fonts and color
    nomainwin

    open "graphics" for graphics as #graph
    #graph "trapclose [quit]"
    #graph "down"

    #graph "font courier_new 8"
    #graph "place 10 15"
    #graph "\courier new"

    #graph "font courier_new 12 italic"
    #graph "place 10 35"
    #graph "\courier new italic"

    #graph "color red"
    #graph "font times_new_roman 16 bold italic"
    #graph "place 10 65"
    #graph "\times new roman bold italic"
    #graph "color black"

    #graph "font ariel 18 underscore"
    #graph "place 10 90"
    #graph "\ariel underscore"

    #graph "flush"

    wait

[quit]
    close #graph
    end
 
User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program fontdlg.bas
« Reply #34 on: Aug 11th, 2017, 03:55am »

fontdlg.bas


Unchanged bar some words of explanation


Code:
    'This code pre selects a font and allows the user to accept or change it

    fontdialog "times_new_roman 10 bold italic", myFont$
    print myFont$ 
 
User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program fontbug.bas
« Reply #35 on: Aug 11th, 2017, 04:54am »

fontbug.bas / fonttest.bas


Should be called fontdemo.bas fonttest.bas is a more refined version of fontbug.bug so get rid of fontbug.bas and rename fonttest.bas to fontdemo.bas


Changed program flow from input loop to wait, general tidy.


Code:
   
    'this program is useful for checking the font code for Liberty BASIC
    nomainwin

    pick$(0) = "she sells"
    pick$(1) = "sea shells"
    pick$(2) = "by the"
    pick$(3) = "seashore"

    UpperLeftX = int((DisplayWidth-WindowWidth)/2)
    UpperLeftY = int((DisplayHeight-WindowHeight)/2)
    WindowWidth = 420
    WindowHeight = 450
    texteditor #main.te1,  8,  8,  192,  152
    texteditor #main.te2,  208,  8,  184,  152
    textbox #main.tb1,  16,  192,  112,  24
    statictext #main.Statictext4, "Font_Name w h",  8,  168,  100,  18
    statictext #main.Statictext7, "Font_Name w h",  208,  168,  100,  18
    button #main.apply1, "Apply", [applyFont1], UL,  136,  192,  67,  24
    textbox #main.tb2,  216,  192,  112,  24
    button #main.apply2, "Apply", [applyFont2], UL,  336,  192,  56,  24

    radiobutton #main.rb1, "Radiobutton 1", [set], [clear], 16, 226, 190, 20
    radiobutton #main.rb2, "Radiobutton 2", [set], [clear], 216, 226, 190, 20

    checkbox #main.cb1, "Checkbox 1", [set], [clear], 16, 256, 190, 20
    checkbox #main.cb2, "Checkbox 2", [set], [clear], 216, 256, 190, 20

    combobox #main.combo, pick$(), [wait], 8, 280, 192, 100
    listbox #main.list, pick$(), [wait], 208, 280, 184, 100

    Menu #main, "&Edit"
    open "Font Demo" for window as #main
    #main "font times_new_roman 10"
    #main "TRAPCLOSE [main.END]"

    #main.te1 "Enter a font name"
    #main.te1 "and width and height"
    #main.te1 "in the field below"
    #main.te1 "and click the button."
    #main.te1 "Example:"
    #main.te1 "courier_new 8 15"

    #main.te2 "Enter a font name"
    #main.te2 "and width and height"
    #main.te2 "in the field below"
    #main.te2 "and click the button."
    #main.te2 "Example:"
    #main.te2 "roman 8 15"

    wait


[main.END]
    close #main
    END


[set]  'do nothing
    wait


[clear]  'do nothing
    wait


[applyFont1]

    #main.tb1 "!contents? fontName$"
    #main.te1 "!font "; fontName$
    #main.apply1 "!font "; fontName$
    #main.Statictext4 "!font "; fontName$
    #main.tb1 "!font "; fontName$
    #main.rb1 "font "; fontName$
    #main.cb1 "font "; fontName$
    #main.combo "font "; fontName$
    wait

[applyFont2]

    #main.tb2 "!contents? fontName$"
    #main.te2 "!font "; fontName$
    #main.apply2 "!font "; fontName$
    #main.Statictext7 "!font "; fontName$
    #main.tb2 "!font "; fontName$
    #main.rb2 "font "; fontName$
    #main.cb2 "font "; fontName$
    #main.list "font "; fontName$
    wait



 
« Last Edit: Aug 11th, 2017, 05: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 get-IP-Address.bas
« Reply #36 on: Aug 11th, 2017, 05:10am »

get-IP-address.bas


unchanged

Code:
'httpget$() function used to obtain your current external IP address.
'No parsing is required, the page returns nothing but the IP.
'This example was borrowed from the runbasic wiki on wikispaces.
'http://runbasic.wikispaces.com

url$="http://www.networksecuritytoolkit.org/nst/cgi-bin/ip.cgi"

r$=httpget$(url$)
print r$
end

 
User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program glblarry.bas
« Reply #37 on: Aug 11th, 2017, 05:11am »

glblarry.bas



Just some words of explanation.


Code:
'arrays are global by default and can be accessed directly within subs and functions
'this code fills and displays an array with a random quantity of
'numbers
dim numbers(100)
count = fillRandomly()
for x = 1 to count
    print numbers(x)
next x
end

function fillRandomly()
    fillRandomly = int(rnd(1)*100)+1
    for x = 1 to fillRandomly
        numbers(x) = int(rnd(1)*fillRandomly)+1
    next x
end function
 
User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program glblhndl.bas
« Reply #38 on: Aug 11th, 2017, 05:22am »

glblhndl.bas


Added a sub example as well as function example


Code:
    'window handles are global and can be used directly withing subs and functions
    '#draw is the handle for the graphics window in the example below
    nomainwin

    open "global handles" for graphics as #draw
    #draw "trapclose [quit]"
    #draw "down"

    x = drawLine(50, 50, 150, 50)
    x = drawLine(50, 100, 150, 100)
    x = drawLine(50, 50, 50, 100)
    call draw 150, 50, 150, 100
    wait

[quit]
    close #draw
    end

function drawLine(a, b, c, d)
    #draw "line "; a; " "; b; " "; c; " "; d
end function


sub draw a,b,c,d
    #draw "color red ;line "; a; " "; b; " "; c; " "; d
end sub

 
User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program grafdemo.bas
« Reply #39 on: Aug 11th, 2017, 06:05am »

grafdemo.bas



ugg needs some work, any volunteers?
User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program graphics.bas
« Reply #40 on: Aug 11th, 2017, 06:06am »

graphics.bas


Simple tidy.


Code:
    ' This is a turtle graphics demo
    nomainwin

    WindowWidth = 600
    WindowHeight = 400
    open "This is a turtle graphics window!" for graphics_nsb_nf as #1
    #1 "trapclose [quit]"

    #1 "fill black ; home ; down ; north"
    for x = 1 to 100
        #1 "turn 54 ; go "; str$(x*3)
        go$ = "turn 59 ; go "; str$(int(x/7))
        #1 "color "; 55 + (x * 2); " 0 "; max(x-20,0)*2
        for y = 1 to 6
            #1 go$
        next y
    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 hanoi.bas
« Reply #41 on: Aug 11th, 2017, 06:19am »

Hanoi.bas


Changed program flow to wait instead of input loop



Code:
    ' Hanoi.bas

    ' This simple Liberty BASIC program let's the user
    ' play the puzzle "Tower of Hanoi".

    ' We don't want a main window
    nomainwin

    ' Prepare the variables that hold the disk data
    tiny = 1
    small = 1
    medium = 1
    large = 1


    gosub [openWindow]
    gosub [drawPuzzle]

    #hanoi "when leftButtonUp [beginMove]"

[start]
    if hanoiStarted = 0 then #hanoi "redraw" : hanoiStarted = 1
    wait




[openWindow]    'Open the puzzle's window

    WindowWidth = 410
    WindowHeight = 300
    open "Tower of Hanoi" for graphics_nsb as #hanoi
    #hanoi "trapclose [quitHanoi]"
    return


[drawPuzzle]    ' Draw the pegs

    #hanoi "cls ; fill black ; down ; backcolor black"
    #hanoi "color darkgray ; size 10 ; line 100 120 100 220"
    #hanoi "line 200 120 200 220"
    #hanoi "line 300 120 300 220"
    #hanoi "color lightgray ; size 15 ; line 0 220 400 220"


[drawDisks]     ' Draw the disks

    peg1 = 207
    peg2 = 207
    peg3 = 207

    if large <> 1 then [largeIsNotOne]
    #hanoi "size 10 ; color red"
    #hanoi "line 60 "; peg1; " 140 "; peg1
    peg1 = peg1 - 10
    goto [drawMedium]

[largeIsNotOne]

    if large <> 2 then [largeIsNotTwo]
    #hanoi "size 10 ; color red"
    #hanoi "line 160 "; peg2; " 240 "; peg2
    peg2 = peg2 - 10
    goto [drawMedium]

[largeIsNotTwo]

    #hanoi "size 10 ; color red"
    #hanoi "line 260 "; peg3; " 340 "; peg3
    peg3 = peg3 - 10


[drawMedium]    ' Draw the medium size disk

    if medium <> 1 then [mediumIsNotOne]
    #hanoi "size 10 ; color green"
    #hanoi "line 70 "; peg1; " 130 "; peg1
    peg1 = peg1 - 10
    goto [drawSmall]

[mediumIsNotOne]

    if medium <> 2 then [mediumIsNotTwo]
    #hanoi "size 10 ; color green"
    #hanoi "line 170 "; peg2; " 230 "; peg2
    peg2 = peg2 - 10
    goto [drawSmall]

[mediumIsNotTwo]

    #hanoi "size 10 ; color green"
    #hanoi "line 270 "; peg3; " 330 "; peg3
    peg3 = peg3 - 10

[drawSmall]    ' Draw the small size disk

    if small <> 1 then [smallIsNotOne]
    #hanoi "size 10 ; color blue"
    #hanoi "line 80 "; peg1; " 120 "; peg1
    peg1 = peg1 - 10
    goto [drawTiny]

[smallIsNotOne]

    if small <> 2 then [smallIsNotTwo]
    print #hanoi, "size 10 ; color blue"
    print #hanoi, "line 180 "; peg2; " 220 "; peg2
    peg2 = peg2 - 10
    goto [drawTiny]

[smallIsNotTwo]

    #hanoi "size 10 ; color blue"
    #hanoi "line 280 "; peg3; " 320 "; peg3
    peg3 = peg3 - 10


[drawTiny]    ' Draw the tiny size disk

    if tiny <> 1 then [tinyIsNotOne]
    #hanoi "size 10 ; color yellow"
    #hanoi "line 90 "; peg1; " 110 "; peg1
    peg1 = peg1 - 10
    goto [finishDrawing]

[tinyIsNotOne]

    if tiny <> 2 then [tinyIsNotTwo]
    #hanoi "size 10 ; color yellow"
    #hanoi "line 190 "; peg2; " 210 "; peg2
    peg2 = peg2 - 10
    goto [finishDrawing]

[tinyIsNotTwo]

    #hanoi "size 10 ; color yellow"
    #hanoi "line 290 "; peg3; " 310 "; peg3
    peg3 = peg3 - 10


[finishDrawing]

    #hanoi "flush" ;

    return


[beginMove]     ' Start to move a disk

    if MouseX < 60 or MouseX > 340 then notice "Oops! No pin there!" : wait
    if MouseY > 215 or MouseY < 120 then notice "Oops! No pin there!" : wait

    peg = int((MouseX + 50) / 100)

    noDisks$ = "There are no disk on that pin!"
    if tiny <> peg and small <> peg and medium <> peg and large <> peg then notice noDisks$ : wait

    #hanoi "place 10 10 ; color white ; backcolor black"
    #hanoi "\\ Peg "; peg; " has been selected.\ Please select a destination peg."

    #hanoi "when leftButtonUp [endMove]"

    wait


[endMove]   ' Finish moving a disk

    if MouseX < 60 or MouseX > 340 then notice "Oops! No pin there!" : wait
    if MouseY > 215 or MouseY < 120 then notice "Oops! No pin there!" : wait

    ontoPeg = int((MouseX + 50) / 100)
    if ontoPeg = peg then [resetSelection]

    ' Determine which disk to move
    if large = peg then disk$ = "large"
    if medium = peg then disk$ = "medium"
    if small = peg then disk$ = "small"
    if tiny = peg then disk$ = "tiny"

    ' Determine if move is legal
    moveOnto$ = "nothing"
    if large = ontoPeg then moveOnto$ = "large"
    if medium = ontoPeg then moveOnto$ = "medium"
    if small = ontoPeg then moveOnto$ = "small"
    if tiny = ontoPeg then moveOnto$ = "tiny"

    if moveOnto$ = "nothing" then [finishMove]

    if disk$ = "large" and moveOnto$ = "medium" then [illegalMove]
    if disk$ = "large" and moveOnto$ = "small" then [illegalMove]
    if disk$ = "medium" and moveOnto$ = "small" then [illegalMove]
    if disk$ = "medium" and moveOnto$ = "tiny" then [illegalMove]
    if disk$ = "small" and moveOnto$ = "tiny" then [illegalMove]

[finishMove]

    #hanoi "when leftButtonUp [beginMove]"

    if disk$ = "large" then large = ontoPeg
    if disk$ = "medium" then medium = ontoPeg
    if disk$ = "small" then small = ontoPeg
    if disk$ = "tiny" then tiny = ontoPeg

    gosub [drawPuzzle]
    if tiny = 3 and small = 3 and medium = 3 and large = 3 then [youWin]

    wait


[illegalMove]

    notice "That move is not allowed!"


[resetSelection]

    #hanoi "when leftButtonUp [beginMove]"
    #hanoi "place 10 10 ; color black ; backcolor black"
    #hanoi "\\ Peg "; peg; " has been selected.\ Please select a destination peg."
    wait


[youWin]

    beep
    notice "You win!"
    confirm "Play another?"; answer$
    if answer$ = "no" then [quitHanoi]

    tiny = 1
    small = 1
    medium = 1
    large = 1
    gosub [drawPuzzle]
    goto [start]


[quitHanoi]

    #hanoi "trapclose"
    close #hanoi
    end

 
User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

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

hockey.bas


Untouched and very much up to modern standards :)

Code:
'by David Drake


'Play against the computer!
'A demonstration of a game creation technique
'The computer determines where the puck will end up and moves its piece there

'Released as open source, so don't blame me  ;-)

[setupWindow]
    nomainwin

    notice "Liberty Hockey!"+chr$(13)+_
        "Don't let the puck slip past you!"+chr$(13)+_
        "You are the left paddle. Move paddle up and"+chr$(13)+_
        "down with the arrow keys. Good luck!"

    gosub [startMusic]

    UpperLeftX = DisplayWidth/2-640/2
    UpperLeftY = DisplayHeight/2-480/2
    WindowWidth = 640
    WindowHeight = 480
    graphicbox #main.gb 0,0,640,480
    open "Hockey" for window as #main

    #main.gb "down;fill white;color lightgray; size 6; place 4 4 ; box 629 446;line 0 230 640 230;line 319 0 319 480; flush"
    #main.gb "color darkcyan;place 280 215;font times_new_roman 36;\L"
    #main.gb "place 330 280;font times_new_roman 36;\B"
    #main "trapclose [quit]"

    #main.gb "getbmp bg 1 1 640 480"
    loadbmp "hitter","bmp\hitter.bmp"
    loadbmp "puck","bmp\puck.bmp"
    #main.gb "addsprite hlt hitter"
    #main.gb "addsprite hrt hitter"
    #main.gb "addsprite puck puck"
    #main.gb "background bg"
    #main.gb "drawsprites"
    #main.gb "spritexy hrt 610 200"
    #main.gb "spritexy hlt 20 200"
    #main.gb "spritemovexy puck 8 12"
    #main.gb "setfocus"
    #main.gb "when characterInput [keyPressed]"
    starttime = time$("milliseconds")
    puckvx = 14
    puckvy = 12
    level = 10
    desty = 170
    delay = 80
    timer 80, [loop]
    wait

[keyPressed]
    c$ = lower$(Inkey$)
    if asc(right$(c$,1))=38 then hlty = hlty - 10:hltDy = -1
    if asc(right$(c$,1))=40 then hlty = hlty + 10:hltDy = 1
    if hlty > 550 then hlty = 550
    if hlty < 0 then hlty = 0
    if c$=chr$(27) then goto [quit]
    wait

[loop]
    if time$("milliseconds") > endMusicTime then
        gosub [stopMusic]
        gosub [startMusic]
    end if
    #main.gb "spritexy? hrt hrtx hrty"
    #main.gb "spritexy? puck puckx pucky"
    if hrty < desty-25 and puckvx > 0 then hrty = hrty + 10:hrtDy = 1:if hrty> 530 then hrty = 530
    if hrty > desty-25 and puckvx > 0 then hrty = hrty - 10:hrtDy = -1:if hrty<0 then hrty = 0
    if puckx < 1   and puckvx < 0 then [pointComputer]
    if puckx > 590 and puckvx > 0 then [pointHuman]
    if pucky < 1   and puckvy < 0 then puckvy = 0 - puckvy:puckFlag = 1:playwave "media\bump.wav",async
    if pucky > 400 and puckvy > 0 then puckvy = 0 - puckvy:puckFlag = 1:playwave "media\bump.wav",async
    #main.gb "spritecollides puck col$"

    if instr(col$,"hlt") > 0 and puckvx < 0 then
        puckvx = 0 - puckvx
        puckvy = puckvy + hltDy
        if rnd(1) < .1 then
            if puckvy < 0 then puckvy = puckvy - 1
            if puckvy > 0 then puckvy = puckvy + 1
        end if
        puckFlag = 1
        playwave "media\beep.wav",async
        gosub [guessLocation]
    end if

    if instr(col$,"hrt") > 0 and puckvx > 0 then
        puckvx = 0 - puckvx
        puckvy = puckvy + hrtDy
        if rnd(1) < .1 then
            if puckvy < 0 then puckvy = puckvy - 1
            if puckvy > 0 then puckvy = puckvy + 1
        end if
        puckFlag = 1
        playwave "media\beep.wav",async
    end if

    if puckFlag = 1 then
        puckFlag = 0
        #main.gb "spritemovexy puck ";puckvx;" ";puckvy;
    end if
    #main.gb "spritexy hrt 605 ";hrty
    #main.gb "spritexy hlt  20 ";hlty
    #main.gb "drawsprites"
    hltDy = 0
    hrtDy = 0
    elapsed = (time$("milliseconds")-starttime)/1000
    if elapsed > level then
        level = elapsed + 5
        delay = delay-4
        if delay < 50 then
            delay = 50
            if puckxv < 0 then puckxv = puckxv - 1
            if puckxv > 0 then puckxv = puckxv + 1
        end if
        timer delay, [loop]
    end if
    wait

[guessLocation]
    'This speeds up the loop every 5 seconds
    #main.gb "spritexy? puck puckx pucky"
    m = puckvy/puckvx
    desty = m*(580-puckx)+pucky
    print desty;" ";
    if desty < 0 then desty = int(abs(desty))
    if desty > 400 then desty = int(800 - desty)
    desty = abs(desty)
    return

[pointComputer]
    timer 0
    notice "Computer wins! You lasted ";elapsed;" seconds."
    goto [quit]

[pointHuman]
    timer 0
    notice "You win! Way to go."
    goto [quit]

[startMusic]
    endMusicTime = time$("milliseconds")+60000+42000
    a$="open media\theme.mid type sequencer alias fictoplay"
    calldll #winmm,"mciSendStringA",a$ as ptr,_
        i1 as ulong,_
        i2 as long,_
        i3 as long,_
        r as long
    a$="play fictoplay"
    calldll #winmm,"mciSendStringA",_
        a$ as ptr,_
        i1 as ulong,_
        i2 as long,_
        i3 as long,_
        r as long
    return

[stopMusic]
    a$="close fictoplay"
    calldll #winmm,"mciSendStringA",_
        a$ as ptr,_
        i1 as ulong,_
        i2 as long,_
        i3 as long,_
        r as long
    return

[quit]
    gosub [stopMusic]
    close #main
    end




 
User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program imitate.bas
« Reply #43 on: Aug 11th, 2017, 06:34am »

imitate.bas


tidy only

Code:
    'demonstrates imitation radiobuttons, using checkboxes
    'you could just use a radiobutton control but
    'this shows what checkboxes can do.

    nomainwin

    WindowWidth = 270
    WindowHeight = 200

    statictext #cfg, "Confirm File Operations:", 20, 20, 200, 20
    checkbox #cfg.always, "Always", [alwaysConfirm], [setAlways], 40, 45, 130, 20
    checkbox #cfg.whenReplacing, "When Replacing", [whenReplacingConfirm], [setWhenReplacing], 40, 70, 130, 20
    checkbox #cfg.never, "Never", [neverConfirm], [setNever], 40, 95, 130, 20
    button #cfg, " &OK ", [cfgOk], UL, 20, 125
    open "Action Confirmation - Setup" for dialog as #cfg
    #cfg "trapclose [cfgOk]"
    wait



[alwaysConfirm]

    #cfg.whenReplacing "reset"
    #cfg.never "reset"
    confrm$ = "always"
    wait

[setAlways]

    #cfg.always "set"
    wait


[whenReplacingConfirm]


    #cfg.always "reset"
    #cfg.never "reset"
    confrm$ = "whenReplacing"
    wait

[setWhenReplacing]

    #cfg.whenReplacing "set"
    wait


[neverConfirm]

    #cfg.whenReplacing "reset"
    #cfg.always "reset"
    confrm$ = "never"
    wait

[setNever]

    #cfg.never "set"
    wait



[cfgOk]

    confirm "Save this configuration?"; answer$
    'perform some sort of save for config here

    close #cfg

    end

 
User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5526
xx Re: Sample Program inkey.bas
« Reply #44 on: Aug 11th, 2017, 10:49am »

inkey.bas
inkey2.bas

probably need to keep the original, simpler example as well



Code:
    'INKEY.BAS - how to use the Inkey$ variable
    'Note that some keys will return two bytes, some one byte
    'some keys will send two messages one for keydown
    'and one for keyup.

    'The value returned is NOT an ASC value
    'it is a virtual keycode number
    'see Inkey2.bas for more info




    open "Inkey$ example" for graphics as #graph
    #graph "when characterInput [fetch]"
    #graph "setfocus"
    #graph "\\Press a key and observe the mainwin data"
    wait

[fetch] 'a character was typed!
    key$ = Inkey$
    if len(key$)=1 then
        print len(key$);" ";
        print asc(key$);" ";
        print key$
    else
        print len(key$);" ";
        print asc(left$(key$,1));" ";
        print asc(right$(key$,1));" ";
        print right$(key$,2)
    end if
    wait

 

Code:
    'INKEY.BAS - how to use the Inkey$ variable
    'nomainwin

    open "Inkey$ example" for graphics as #graph
    #graph "when characterInput [fetch]"
    #graph "setfocus"
    #graph "\\Press any key or key combination"
    wait

[fetch]

    'a key or key combination was pressed, fetch it
    'some keys issue a key down and a key up message. For example Shift Control and Enter do so
    'Esc issues three messages, press some keys and observe the mainwin data
    #graph  "when characterInput"
    key$ = Inkey$

    'show what we got in the mainwin
    'key messages are either one or two bytes long
    print len(key$),
    if len(key$)=1 then
        print "-- ";asc(right$(key$,1)),right$(key$,1)
    else
        print right$("  ";asc(left$(key$,1)),2);" ";asc(right$(key$,1)),right$(key$,1)
    end if


    'get the key value of the right most character of a two byte message or
    'simply the key value of a single byte message
    key=asc(right$(key$,1))

    'if we have received a a single byte message it is most likely a printable character
    'but some system keys like Enter,Tab and Backspace can send single byte messages
    'so lets filter out the single byte alpha numeric messages and send the rest on as system key messages
    if key >=32 and key<=126 and len(key$)=1 then
            #graph "\";key$

    'if we have received a two byte message or a single byte message that is not alpha numeric
    'then we have a system key message
    else
        'seek out its virtual keycode value
        'Go here for full list http://msdn.microsoft.com/en-us/library/dd375731(VS.85).aspx
        select case key
            case 3
                #graph "\Ctrl C COPY"
            case 22
                #graph "\Ctrl V PASTE"
            case _VK_SHIFT
                #graph "\Shift"
            case _VK_RETURN
                #graph "\Enter"
            case _VK_LEFT
                #graph "\Left Arrow"
            case _VK_RIGHT
                #graph "\Right Arrow"
            case _VK_UP
                #graph "\Up Arrow"
            case _VK_DOWN
                #graph "\Down Arrow"
            case _VK_PRIOR
                #graph "\Page Up"
            case _VK_NEXT
                #graph "\Page Down"
            case _VK_HOME
                #graph "\Home"
            case _VK_BACK
                #graph "\Back"
            case _VK_END
                #graph "\End"
            case _VK_DELETE
                #graph "\Delete"
            case _VK_CONTROL
                #graph "\Control"
            case else
                #graph "\Not in list"
        end select
    end if

    print #graph, "when characterInput [fetch]"
    print #graph, "setfocus"
    wait
 

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

Pages: 1 2 3 4 5  ...  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