flat assembler
Message board for the users of flat assembler.

flat assembler > Examples and Tutorials > Hobby Basic, a toy language interpreter written in fasm

Goto page 1, 2, 3  Next
Author
Thread Post new topic Reply to topic
Picnic



Joined: 05 May 2007
Posts: 1273
Location: countryside
Image

Hobby Basic is a toy language interpreter for the Windows console.
Its syntax resembles BASIC.
It's written in fasm + Win32 API.
It's a small personal project.

Download


Last edited by Picnic on 08 Jun 2019, 07:52; edited 141 times in total
Post 05 May 2013, 21:16
View user's profile Send private message Reply with quote
AsmGuru62



Joined: 28 Jan 2004
Posts: 1389
Location: Toronto, Canada
Great stuff!
Things like that motivate beginners to start programming.
Post 05 May 2013, 22:15
View user's profile Send private message Send e-mail Reply with quote
MHajduk



Joined: 30 Mar 2006
Posts: 5994
Location: Poland
I suppose that the author's sentiment to QuickBasic was the main inspiration for this project. Nice thing. Smile
Post 05 May 2013, 22:28
View user's profile Send private message Visit poster's website Reply with quote
typedef



Joined: 25 Jul 2010
Posts: 2909
Location: 0x77760000
Nice. This prompts me to make a CLI graphics library. Looks pretty neat.
Post 07 May 2013, 04:31
View user's profile Send private message Reply with quote
Picnic



Joined: 05 May 2007
Posts: 1273
Location: countryside
I am glad you like it, i had some concern whether it can be served as helpful example despite the lack of comments in source.

A test program for the interpreter.

Code:

    cols=80
    rows=25
    VK_LEFT=37
    VK_RIGHT=39

    path$=PATH(1)+"\DESCENT.TXT"
    if SIZE(path$)=-1 then file path$,"0",0
    screen cols,rows
    cursor 0,0

start#

    bg=1
    n=30
    x=37
    y=rows/2
    score=0
    delay=90
    lvup=400

    color 0,0:cls
    file path$,best$,1
    best$=TRIM(best$)

    pen 7
    at 4,2,"Use the arrow keys"
    at 4,3,("Best Score "+best$)
    at 4,4,("Next Level at "+STR(lvup))

    color bg,8
    for i=0 to rows-1
        erase 30,i,14,-1,1
        at 30,i,"██          ██"
    next

    do

        if KEY(VK_LEFT)<>0
            x=x-1
        elseif KEY(VK_RIGHT)<>0
            x=x+1
        endif

        if CELL(x,y)<>" "
            color 0,12
            at x-1,y-1,"X X"
            at x,y,"X"
            at x-1,y+1,"X X"
            pen 15:at 32,8,"Game Over"
            if score>VAL(best$)
                best$=STR(score)
                file path$,best$,0
            endif
            wait 1500000
            goto start
        endif

        pen 7
        at x,y,'█'
        color 0,0
        move 25,1,40,rows-1,25,0
        color bg,8

        n=n+RND(3)-1
        if n<25 then n=25
        if n>50 then n=50
        at n,rows-1,"██          ██"
        erase n,rows-1,14,-1,1

        score=score+1
        title "Distance ",score:pen 7
        if ~(score%lvup) then bg=bg+1:at 18,4,(STR(score+lvup)+" ")
        if (delay>10 and ~(score%50)) then delay=delay-2
        at 4,5,("Descent speed "+STR(100-delay))
        wait delay*1000

    until KEY(27)
    end
    


Image


Last edited by Picnic on 18 May 2019, 22:18; edited 3 times in total
Post 07 May 2013, 10:10
View user's profile Send private message Reply with quote
TmX



Joined: 02 Mar 2006
Posts: 820
Location: Jakarta, Indonesia
This is very nice.
Reminiscent of DOS apps.

Mouse handling would be a nice addition, I think Wink
Post 07 May 2013, 15:45
View user's profile Send private message Reply with quote
HaHaAnonymous



Joined: 02 Dec 2012
Posts: 1181
Location: Unknown
Stupid post removed.


Last edited by HaHaAnonymous on 28 Feb 2015, 20:54; edited 1 time in total
Post 07 May 2013, 20:58
View user's profile Send private message Reply with quote
typedef



Joined: 25 Jul 2010
Posts: 2909
Location: 0x77760000
Picnic wrote:
I am glad you like it, i had some concern whether it can be served as helpful example despite the lack of comments in source.


If it can be understood then no worries.

Besides not all examples are aimed at beginners.
Post 07 May 2013, 23:30
View user's profile Send private message Reply with quote
Picnic



Joined: 05 May 2007
Posts: 1273
Location: countryside
TmX wrote:
Mouse handling would be a nice addition, I think Wink


Mouse events handling added in Hobby Basic. Wink
Code:

    do

        mouse

        ! V0 = cell x
        ! V1 = cell y
        ! V2 = button: 1 left, 2 right, 4 double click
        ! V3 = coordinates in pixels (high/low order word)

        title V0,',',V1

        wait 1

    until KEY(27)
    

Image



Hyper-link in console.
Code:

    title -1,t$
    cursor 0,0
    color 0,7:cls

    oldx=-1
    oldy=-1
    h=0
    a$="www.google.com":a=len(a$)
    at 2,2,a$

    do

        mouse
        x=V0:y=V1:btn=V2

        if (x<>oldx or y<>oldy)
            if (x>2 and x<(a+2) and y=2)
                if h=0
                    h=1
                    pen 14:erase 2,2,a,-1,1
                    title "Open URL:  ",a$
                endif
            elseif h=1
                h=0
                pen 7:erase 2,2,a,-1,1
                title t$
            endif
        endif

        if (btn=1 and h)
            exec ("start chrome.exe https://"+a$)
        endif

        oldx=x
        oldy=y
        wait 1

    until key(27)
    end
    

Image


Last edited by Picnic on 04 Jun 2019, 06:32; edited 10 times in total
Post 18 Aug 2013, 22:52
View user's profile Send private message Reply with quote
Picnic



Joined: 05 May 2007
Posts: 1273
Location: countryside
A new version, the first that supports unicode characters in 16-bit encoding.

Code:

    cls
    τύπωσε  fix  print
    τύπωσε "Euro Symbol: €."
    τύπωσε "English: I can eat glass and it doesn''t hurt me."
    τύπωσε "Greek: Μπορώ να φάω γυαλί χωρίς να πάθω τίποτα."
    τύπωσε "Íslenska / Icelandic: Ég get etið gler án þess  meiða mig."
    τύπωσε "Romanian: Pot  mănânc sticlă și ea nu  rănește."
    τύπωσε "Ukrainian: Я можу їсти шкло, й воно мені не пошкодить."
    τύπωσε "Polish: Mogę jeść szkło, i mi nie szkodzi."
    τύπωσε "Czech: Mohu jíst sklo, neublíží mi."
    pause
    


Image


Last edited by Picnic on 02 Jun 2019, 09:27; edited 6 times in total
Post 15 Dec 2013, 01:37
View user's profile Send private message Reply with quote
typedef



Joined: 25 Jul 2010
Posts: 2909
Location: 0x77760000
I get this when I run MOUSE

Image
Post 15 Dec 2013, 05:58
View user's profile Send private message Reply with quote
Picnic



Joined: 05 May 2007
Posts: 1273
Location: countryside
Thanks for the feedback typedef. Can you please tell me your Windows version and if you tried the rest of the samples?
Post 15 Dec 2013, 10:10
View user's profile Send private message Reply with quote
typedef



Joined: 25 Jul 2010
Posts: 2909
Location: 0x77760000
Windows 7 64 bit. Actually all the programs except the binary and the the color ones. And why it says print I don't know
Post 15 Dec 2013, 14:27
View user's profile Send private message Reply with quote
Picnic



Joined: 05 May 2007
Posts: 1273
Location: countryside
I will look into the problem as soon as i can. I starting to feel a bit outdated with my windows xp 32-bit.


Last edited by Picnic on 15 Dec 2013, 17:35; edited 1 time in total
Post 15 Dec 2013, 17:28
View user's profile Send private message Reply with quote
typedef



Joined: 25 Jul 2010
Posts: 2909
Location: 0x77760000
I see. It's a version difference thing.
Post 15 Dec 2013, 17:34
View user's profile Send private message Reply with quote
Picnic



Joined: 05 May 2007
Posts: 1273
Location: countryside
I think i found what was causing the trouble. Give it a try if you like typedef.
Post 18 Dec 2013, 21:33
View user's profile Send private message Reply with quote
typedef



Joined: 25 Jul 2010
Posts: 2909
Location: 0x77760000
They work now Very Happy. Care to share what was causing it to say that?
Post 18 Dec 2013, 22:53
View user's profile Send private message Reply with quote
Picnic



Joined: 05 May 2007
Posts: 1273
Location: countryside
Nice to hear!
Sure, it seems that an improper call to SetConsoleOutputCP function crush the program. By the way, i installed Windows 7.
Post 19 Dec 2013, 21:09
View user's profile Send private message Reply with quote
typedef



Joined: 25 Jul 2010
Posts: 2909
Location: 0x77760000
Picnic wrote:
Nice to hear!
Sure, it seems that an improper call to SetConsoleOutputCP function crush the program. By the way, i installed Windows 7.


Hmm. Nice, what Win7 version?
Post 20 Dec 2013, 01:13
View user's profile Send private message Reply with quote
Picnic



Joined: 05 May 2007
Posts: 1273
Location: countryside
^^Home premium 32-bit.
A new version upload with some minor improvements, and fixes in bugs i noticed.


X's And O's (Tic Tac Toe) game. Plays with mouse.
Code:

    rem  X's and O's Game

    P1  fix  m[x,y]
    P2  fix  m[x+i,y+j]
    P3  fix  m[x+i*2,y+j*2]

    screen 80,30
    screen 80,30
    cursor 0,0

restart#
    color 0,7:cls:locate 0,15
    n=0:dim m[3,3]=0,0,0,0,0,0,0,0,0
    at 4,1,"X''s and O''s"
    at 0,3,"Player X  vs  CPU O"
    paint 1,7,17,1,'_',0
    paint 1,10,17,1,'_',0
    paint 6,5,1,9,'|',0
    paint 12,5,1,9,'|',0
    @@# at 0,15,"Play first? [y/n]"
    inkey:p=V0:if p=27 then end
    if (p='y' or p='Y') then p=1 else p=0
    at 0,15,"Strong CPU? [y/n]"
    inkey:z=V0:if z=27 then goto @b
    do
        if p=0 then gosub cpu_move else gosub player_move
        gosub is_winner:p=p^1:n=n+1
    until (w<>0 or n=9)
    erase 0,15,30,-1,-1:pen 7
    if w=0 then at 0,15,"Game was a draw"
    if w=1 then at 0,15,"Player X has won!"
    if w=2 then at 0,15,"CPU O has won!"
    at 0,16,"press a key":inkey:goto restart

player_move#
    pen 7:at 0,15,"Player X''s turn       "
    @@# if key(27) then goto restart
    mouse:x=(V0+1)/7:y=(V1+1)/4-1:btn=V2:wait 1
    if (x<0 or x>2 or y<0 or y>2) or btn=0 then goto @b
    if m[x,y]=0 then m[x,y]=1:pen 10:at x*6+3,y*3+6,'X':return
    goto @b

cpu_move#
    pen 7:at 0,15,"CPU O''s turn          "
    b=0:cx=0:cy=0
    x=0:i=1:j=0:for y=0 to 2:gosub scoring:next
    y=0:i=0:j=1:for x=0 to 2:gosub scoring:next
    x=2:y=0:i=-1:j=1:gosub scoring
    x=0:i=1:j=1:gosub scoring
    m[cx,cy]=2:wait 500000
    pen 15:at cx*6+3,cy*3+6,'O'
    return

scoring#
    r=0:k=0:s=0
    if P1=0 then r=x:k=y:s=1
    if P2=0 then r=x+i:k=y+j:s=1
    if P3=0 then r=x+i*2:k=y+j*2:s=1
    if (P1=1 and P2=0 and P3=0) then r=x+i*2:k=y+j*2:s=2
    if (P1=0 and P2=1 and P3=0) then r=x:k=y:s=2
    if (P1=0 and P2=0 and P3=1) then r=x:k=y:s=2
    if (P1=0 and P2=0 and P3=0) then r=x:k=y:s=4
    if (P1=2 and P2=0 and P3=0) then r=x+i*2:k=y+j*2:s=8
    if (P1=0 and P2=2 and P3=0) then r=x:k=y:s=8
    if (P1=0 and P2=0 and P3=2) then r=x:k=y:s=8
    if (P1=1 and P2=1 and P3=0) then r=x+i*2:k=y+j*2:s=16
    if (P1=1 and P2=0 and P3=1) then r=x+i:k=y+j:s=16
    if (P1=0 and P2=1 and P3=1) then r=x:k=y:s=16
    if (P1=2 and P2=2 and P3=0) then r=x+i*2:k=y+j*2:s=32
    if (P1=2 and P2=0 and P3=2) then r=x+i:k=y+j:s=32
    if (P1=0 and P2=2 and P3=2) then r=x:k=y:s=32
    if (m[1,1]=0 and z='y') then r=1:k=1:s=64
    if s>b then b=s:cx=r:cy=k
    return

is_winner#
    w=0:x=0:i=1:j=0:for y=0 to 2:gosub win:next
    y=0:i=0:j=1:for x=0 to 2:gosub win:next
    x=2:y=0:i=-1:j=1:gosub win
    x=0:i=1:j=1:gosub win
    return

win#
    if (P1=1 and P2=1 and P3=1) then w=1
    if (P1=2 and P2=2 and P3=2) then w=2
    return
    


Image


Last edited by Picnic on 18 May 2019, 22:35; edited 3 times in total
Post 20 Dec 2013, 20:37
View user's profile Send private message Reply with quote
Display posts from previous:
Post new topic Reply to topic

Jump to:  
Goto page 1, 2, 3  Next

< Last Thread | Next Thread >
Forum Rules:
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 vote in polls in this forum
You cannot attach files in this forum
You can download files in this forum


Copyright © 1999-2019, Tomasz Grysztar.

Powered by rwasa.