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 Previous  1, 2, 3  Next
Author
Thread Post new topic Reply to topic
MajorDill



Joined: 01 Nov 2010
Posts: 18
when I click on download nothing is there. Just learning fasm and could really use these examples.

begging somebody to repost them

thankyou
Post 26 Apr 2014, 18:04
View user's profile Send private message Reply with quote
Picnic



Joined: 05 May 2007
Posts: 1277
Location: countryside
Hi MajorDill,

Sorry about this. I'm building my website but it will take me longer than expected. See the 1st post.


Last edited by Picnic on 29 Aug 2014, 19:32; edited 2 times in total
Post 26 Apr 2014, 21:40
View user's profile Send private message Reply with quote
MajorDill



Joined: 01 Nov 2010
Posts: 18
got it - thanks
Post 28 Apr 2014, 14:01
View user's profile Send private message Reply with quote
Picnic



Joined: 05 May 2007
Posts: 1277
Location: countryside
A set of special console commands is available to make things easier.
These commands return values to reserved variables V0,V1,V2,V3.
See ReadMe.txt for more information.

Code:

    !  cls
    !  at      {x,y,arg}
    !  cusror  {bShow,n}
    !  erase   {x,y,len,char,n}
    !  invert  {x,y,cols,rows}
    !  flip    {x,y,cols,rows,n}
    !  grab    {x,y,cols,rows,array[],n}
    !  paint   {x,y,cols,rows,char,n}
    !  copy    {x,y,cols,rows}
    !  paste   {x,y}
    !  wait    {n}
    !  exec    {cmd$,[a$]}
    !  title   {arg1,...}
    !  pen     {foreground}              --> V1
    !  color   {background,text}         --> V0,V1
    !  locate  {x,y}                     --> V0,V1
    !  inkey                             --> V0,V1,V2
    !  mouse                             --> V0,V1,V2,V3
    !  peek    {x,y}                     --> V0,V1,V2,V3
    !  screen  {cols,rows,[n]}           --> V0,V1,V2,V3
    !  view    {n,...}                   --> V0,V1,V2,V3
    !  block   {x,y,cols,rows,id}        --> V0
    !  store   {x,y,cols,rows}           --> V0
    !  restore                           --> V0
    !  file    {path$,arg,n}             --> V0
    !  ansi    {path$,[s]}               --> V0
    !  alert   {arg1,...}                --> V0
    !  bitmap  {x,y,path$}               --> V0
    !  sndplay {[flags],path$}           --> V0
    !  runfile {path$}                   --> V0
    


Code:

    cls
    at 33,12,"normal  invert"
    invert 40,0,40,25    ! assumes 80x25 screen
    inkey
    

Image


Code:

    color 0,7:cls
    paint 0,0,40,25,'A',1
    color 1,9
    paint 20,12,20,13,-1,1
    paint 10,6,20,13,' ',0
    inkey
    

Image


Code:

    for i=0 to 139
        x=i%20
        y=i/20
        color (x+y)/4,0
        paint x*4,y*4,4,4,0x20,1
    next

    for i=1 to 15
        pen i
        at i,i,"Hobby Basic"
    next

    inkey
    

Image


Last edited by Picnic on 16 Aug 2019, 11:18; edited 55 times in total
Post 31 Jul 2015, 06:16
View user's profile Send private message Reply with quote
fasmnewbie



Joined: 01 Mar 2011
Posts: 549
I love this stuff. Excellent materials for beginners to learn from (although there's nothing 'beginners' with the code)
Post 01 Aug 2015, 02:54
View user's profile Send private message Visit poster's website Reply with quote
fasmnewbie



Joined: 01 Mar 2011
Posts: 549
I am linking to this thread.
Post 01 Aug 2015, 03:10
View user's profile Send private message Visit poster's website Reply with quote
Picnic



Joined: 05 May 2007
Posts: 1277
Location: countryside
^^Thank you fasmnewbie.


ASCII Tetris in Hobby Basic.
Code:

    rem  ASCII Tetris Game

    dim piecex[4]
    dim piecey[4]
    dim nextpiecex[4]
    dim nextpiecey[4]
    dim keys[5]=27,37,38,39,40
    dim score[4]=40,100,300,1200

    title "ASCII Tetris"
    screen 40,30
    cursor 0,0

Restart#
    gosub Initialize
    gosub PlayGame
    gosub GameOver
    goto Restart

PlayGame#
    do
        gosub DeletePiece
        gosub MoveDown
        gosub PrintPiece
        last=TICK()
        do:gosub GetKeys
        until ((TICK()-last>delay) or Esc)
    until Esc
    return

GetKeys#
    k=0
    for z=0 to 4
        if KEY(keys[z])
            k=keys[z]
            if k=27 then Esc=1
            gosub DeletePiece
            on k-36 gosub MoveLeft,Rotate,MoveRight,MoveDown
            gosub PrintPiece
            if (k=38 or k=40) then wait 90000 else wait 50000
            break
        endif
    next z
    if ~k then wait 1
    return

Rotate#
    for i=0 to 3
        if CELL(x+2-piecex[i], y+piecey[i])<>32 then return
    next i
    for i=0 to 3
        temp=piecex[i]
        piecex[i]=2-piecey[i]
        piecey[i]=temp
    next i
    return

MoveLeft#
    for i=0 to 3
        if CELL(x-1+piecex[i], y+piecey[i])<>32 then return
    next i
    x=x-1
    return

MoveRight#
    for i=0 to 3
        if CELL(x+1+piecex[i], y+piecey[i])<>32 then return
    next i
    x=x+1
    return

MoveDown#
    for r=0 to 3
        if CELL(x+piecex[r], y+1+piecey[r])<>32
            gosub PrintPiece
            x=startx
            y=starty
            gosub GetPiece
            gosub CheckLines
            return
        endif
    next r
    y=y+1
    return

CheckLines#
    ln=0
    for j=toplefty to maxy
        gosub CheckLine
    next j
    if ln>0
        delay=delay-1
        score=score+score[ln-1]
        gosub PrintScore
    endif
    return

CheckLine#
    for i=topleftx to maxx
        if CELL(i,j)<>35 then return
    next i
    for i=topleftx to maxx
        print at i,j,' '
    next i
    for l=0 to j-toplefty-1
        for n=topleftx to maxx
            peek n,j-l-1
            i=V0
            pen V2
            print at n,j-l,CHR(i)
        next n
    next l
    ln=ln+1
    return

PrintScore#
    print at 10,8,score
    return

GetPiece#
    for i=0 to 3
        piecex[i]=nextpiecex[i]
        piecey[i]=nextpiecey[i]
    next i
    gosub DeleteNextPiece
    gosub GetNextPiece
    gosub PrintNextPiece
    for i=0 to 3
        if CELL(x+piecex[i], y+piecey[i])<>32
        Esc=1
        break
    endif
    next i
    return

GetNextPiece#
    i=RND(5) : nextcolor=i+9
    if i=0
        nextpiecex[0]=0
        nextpiecey[0]=1
        nextpiecex[1]=1
        nextpiecey[1]=1
        nextpiecex[2]=0
        nextpiecey[2]=2
        nextpiecex[3]=1
        nextpiecey[3]=2
    elseif i=1
        nextpiecex[0]=0
        nextpiecey[0]=1
        nextpiecex[1]=1
        nextpiecey[1]=1
        nextpiecex[2]=2
        nextpiecey[2]=1
        nextpiecex[3]=0
        nextpiecey[3]=2
    elseif i=2
        nextpiecex[0]=0
        nextpiecey[0]=1
        nextpiecex[1]=1
        nextpiecey[1]=1
        nextpiecex[2]=2
        nextpiecey[2]=1
        nextpiecex[3]=1
        nextpiecey[3]=2
    elseif i=3
        nextpiecex[0]=0
        nextpiecey[0]=1
        nextpiecex[1]=1
        nextpiecey[1]=1
        nextpiecex[2]=2
        nextpiecey[2]=1
        nextpiecex[3]=2
        nextpiecey[3]=2
    elseif i=4
        nextpiecex[0]=0
        nextpiecey[0]=1
        nextpiecex[1]=1
        nextpiecey[1]=1
        nextpiecex[2]=2
        nextpiecey[2]=1
        nextpiecex[3]=3
        nextpiecey[3]=1
    endif
    return

PrintPiece#
    pen printcolor
    for i=0 to 3
        print at x+piecex[i],y+piecey[i],'#'
    next i
    pen 7
    return

DeletePiece#
    for i=0 to 3
        print at x+piecex[i],y+piecey[i],' '
    next i
    return

PrintNextPiece#
    pen nextcolor
    for i=0 to 3
        print at nextx+nextpiecex[i],nexty+nextpiecey[i],'#'
    next i
    pen 7
    return

DeleteNextPiece#
    printcolor=nextcolor
    for i=0 to 3
        print at nextx+nextpiecex[i],nexty+nextpiecey[i],' '
    next i
    return

GameOver#
    pen 8
    paint 18,3,20,25,-1,1
    pen 15
    print at 24,14,"GAME OVER"
    inkey
    return

Initialize#
    printcolor=0
    nextcolor=0
    topleftx=18
    toplefty=3
    maxx=37
    maxy=27
    startx=27
    starty=2
    x=startx
    y=starty
    nextx=9
    nexty=14
    delay=300
    score=0
    Esc=0
    pen 7
    at 0,0, "########################################"
    at 0,1, "########################################"
    at 0,2, "#                #                    ##"
    at 0,3, "#     TETRIS     #                    ##"
    at 0,4, "#                #                    ##"
    at 0,5, "##################                    ##"
    at 0,6, "##################                    ##"
    at 0,7, "#                #                    ##"
    at 0,8, "#  Score:        #                    ##"
    at 0,9, "#                #                    ##"
    at 0,10,"##################                    ##"
    at 0,11,"##################                    ##"
    at 0,12,"#                #                    ##"
    at 0,13,"#  Next:         #                    ##"
    at 0,14,"#                #     Press SPACE    ##"
    at 0,15,"#                #                    ##"
    at 0,16,"#                #                    ##"
    at 0,17,"#                #                    ##"
    at 0,18,"##################                    ##"
    at 0,19,"##################                    ##"
    at 0,20,"##################                    ##"
    at 0,21,"##################                    ##"
    at 0,22,"##################                    ##"
    at 0,23,"##################                    ##"
    at 0,24,"##################                    ##"
    at 0,25,"##################                    ##"
    at 0,26,"##################                    ##"
    at 0,27,"##################                    ##"
    at 0,28,"########################################"
    at 0,29,"########################################"
    i=0:k=0:r=0:j=0:l=0:n=0:ln=0:z=0
    inkey:if V0=27 then end
    paint 18,3,20,25,-1,-1
    gosub GetNextPiece
    gosub GetPiece
    gosub PrintScore
    gosub PrintNextPiece
    return
    


Image


Last edited by Picnic on 16 Aug 2019, 11:20; edited 26 times in total
Post 02 Aug 2015, 11:15
View user's profile Send private message Reply with quote
Picnic



Joined: 05 May 2007
Posts: 1277
Location: countryside
Arrays are 1D and 2D with the pointer starting from 0. Elements of an array are
either signed integer values or strings. The size of an array changes dynamically
by calling DIM again. The initial values of the elements of an array are set to 0.

Code:

    dim a[4]=1,2,3,4

    for i=0 to 3
        ? a[i]
    next
    


Code:

    dim a[2,2]=10,20,0x1E,101000b

    dim b[2,2]

    b[]=a[]      ! copy array

    for y=0 to 1
        for x=0 to 1
            ? b[x,y]
        next
    next
    


Code:

    dim a$[3]="One","Two","Three"

    dim a$[4]     ! resize array

    a$[3]="Four"

    n=SIZE(a$[])  ! get array size --> V0,V1

    for i=0 to n-1
        ? a$[i]
    next
    

Image


Last edited by Picnic on 17 May 2019, 22:05; edited 20 times in total
Post 12 Aug 2015, 09:43
View user's profile Send private message Reply with quote
fasmnewbie



Joined: 01 Mar 2011
Posts: 549
Picnic

It would be very nice if you could share your passion with Tomasz and others at Programming Language & Design section where you can properly introduce your Hobby Basic to the community. Good to see FASM is becoming a language of choice for compiler writing.
Post 12 Aug 2015, 12:43
View user's profile Send private message Visit poster's website Reply with quote
Picnic



Joined: 05 May 2007
Posts: 1277
Location: countryside
^^I feel it's early for that now. The interpreter is far for being complete. Surely i might do that but in later time.


A label is identified by the symbol # at the end of a name. Comments in the
source code start with the symbol ! or the REM command.
Code:

    retry#

    ! line comment
    rem  line comment

    input "Secret number:",n
    if n<>1234 then goto retry
    end
    


Code:

    for x=1 to 3
        on x gosub L1,L2,L3
    next
    pause
    end

    L1# print "Label 1":return
    L2# print "Label 2":return
    L3# print "Label 3":return
    


Anonymous Labels.
Code:

    @@#

    !  @@ followed by # create an anonymous label
    !  goto @b  (backward jump)
    !  goto @f  (forward jump)
    !  Ctrl-C to exit loop

    goto @b
    


Last edited by Picnic on 16 Aug 2019, 11:28; edited 11 times in total
Post 15 Aug 2015, 22:13
View user's profile Send private message Reply with quote
Picnic



Joined: 05 May 2007
Posts: 1277
Location: countryside
A string variable is identified by the symbol $ at the end of a name.
Concatenation uses the + addition symbol to add parts to a string variable.
Code:

    age=10
    a$="I am "+chr(34)+str(age)+chr(34)+" years old."
    print a$
    

Code:

    a$="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    b$=reverse(a$)
    print a$,EOL$,b$
    print left(a$,5)
    

Code:

    do
        input "How many words:",n
    until n>0

    dim a$[n]
    for i=0 to n-1
        print "Enter word a$[",i,"]:",
        input a$[i]
    next
    

Code:

    do
        input "Enter password:",a$
    until comp(trim(a$),"letmein")=1
    print "You are in."
    pause
    

Image


Last edited by Picnic on 31 May 2019, 10:17; edited 29 times in total
Post 03 Sep 2015, 14:45
View user's profile Send private message Reply with quote
Picnic



Joined: 05 May 2007
Posts: 1277
Location: countryside
Built-in functions return either an integer, or a string value. A variable to
store the return value must always precede the call (unless a print operation).

Code:

    ! abs(n)                    --> int
    ! asc(a$)                   --> int
    ! cell(x,y)                 --> int
    ! comp(a$,b$)               --> int
    ! find(a$,find$,[start])    --> int
    ! split(a$,delim,array$[])  --> int
    ! getbits(x,p,n)            --> int
    ! len(a$)                   --> int
    ! size([arg])               --> int,V0,V1
    ! key(n)                    --> int
    ! rnd(n)                    --> int
    ! pow(x,y)                  --> int
    ! tick([n])                 --> int     
    ! val(a$)                   --> int
    ! base(n,radix)             --> string
    ! bin(n)                    --> string
    ! chr(n)                    --> string
    ! hex(n)                    --> string
    ! lcase(a$)                 --> string
    ! left(a$,length)           --> string
    ! mid(a$,start,length)      --> string
    ! pad(a$,char,length)       --> string
    ! path([arg])               --> string
    ! readln(n,a$)              --> string,V0
    ! replace(a$,find$,text)    --> string
    ! reverse(a$)               --> string
    ! insert(a$,pos,text)       --> string
    ! right(a$,length)          --> string
    ! spc(n)                    --> string
    ! str(n)                    --> string
    ! trim(a$)                  --> string
    ! ucase(a$)                 --> string


    x=VAL("510")/2              ! x=255
    x=ASC("hello")              ! x=104 (ASCII of 'h')
    x=FIND("abcdefg","de")      ! x=4
    x=TICK()                    ! x=tick counter
    ? CHR(65)                   ! prints 'A'
    ? "0x",UCASE(HEX(255))      ! prints "0xFF"
    ? RIGHT("Hello",2)          ! prints "lo"
    ? LCASE("HELP Me")          ! prints "help me"
    ? PATH(1)                   ! HB path (e.g., "C:\HB")
    do:wait 1:until KEY(27)     ! wait until key Esc
    


Last edited by Picnic on 16 Aug 2019, 11:20; edited 33 times in total
Post 09 Oct 2015, 06:27
View user's profile Send private message Reply with quote
SergeASM



Joined: 13 Nov 2015
Posts: 21
In the file Console.asm I see "Copyright © 2013-2015, Nick Kouvaris". Is this the same Nick Kouvaris, which did flash games on lightforce.freestuff.gr?

Serge
Post 20 Nov 2015, 10:21
View user's profile Send private message Visit poster's website Reply with quote
Picnic



Joined: 05 May 2007
Posts: 1277
Location: countryside
Hi SergeASM,

Yes that's me, nice of you to ask.
Post 20 Nov 2015, 11:34
View user's profile Send private message Reply with quote
Picnic



Joined: 05 May 2007
Posts: 1277
Location: countryside
A user-defined function gets parameters specified by the user. A parameter is
passed by value. The return value is always an integer.


2048 puzzle game in Hobby Basic.
Code:

    rem  2048 Puzzle
    rem  Use the arrow keys to move the tiles
    rem  When two tiles with the same number touch, they merge into one!

    menu6$=PATH(1)+"\ART\MENU6.ANS"
    if SIZE(menu6$)=-1 then alert menu6$," not found"

    VK_UP=38
    VK_DOWN=40
    VK_LEFT=37
    VK_RIGHT=39

    dim board[4,4]
    dim blocked[4,4]

    path$=PATH(1)+"\DATA\2048.TXT"
    if SIZE(path$)=-1 then file path$,"0",0
    file path$,best$,1
    best$=TRIM(best$)
    delay=10000

    title "2048 in Hobby Basic"
    screen 80,30
    cursor 0,0
    ansi menu6$

    pen 7
    at 63,4,"SCORE:"
    at 63,6,"BEST:"
    pen 7
    at 1,23,"Join the numbers and get to the 2048 tile!"
    at 1,24,"Use the arrow keys to move the tiles"
    at 1,25,"Press R to restart, Esc to quit"

start#

    done=0
    score=0
    moved=1
    erase 70,4,7,-1,-1
    erase 70,6,7,-1,-1
    erase 0,26,160,-1,-1

    for y=0 to 3
        for x=0 to 3
            board[x,y]=0
            blocked[x,y]=0
        next x
    next y

    addTile()

    do
        if moved then addTile()
        drawBoard()
        if done then break
        waitKey()
    until done

    if score>VAL(best$)
        best$=STR(score)
        file path$,best$,0
    endif

    if done=27 then end
    if done='R' then goto start
    locate 1,26:? "No more moves. Your score: ",score
    @@# inkey:k=V0&0x5F
    if k='R' then goto start
    if k<>27 then goto @b
    end


sub drawBoard()

    local x,y

    at 70,4,score
    at 70,6,best$

    for y=0 to 3
        for x=0 to 3
            v=board[x,y]:if v=0 then i=5 else i=pickColor(v)
            color i,0:paint 34+(x*7),3+(y*4),6,3,0x20,1
            if i<>5 then at 34+(x*7),4+(y*4),PAD(STR(v),0x20,5)
        next x
    next y
   color 0,7
ends


sub waitKey()

    local x,y,k

    moved=0
    inkey:k=V0&0x5F
    if (k=27 or k='R') then done=k:rets
    k=V2:if (k>36 and k<41) then movDir(k)
    for y=0 to 3
        for x=0 to 3
            blocked[x,y]=0
        next x
    next y
ends


sub addTile()

    local x,y,a,b

    for y=0 to 3
        for x=0 to 3
            if ~board[x,y]
                do:a=RND(4):b=RND(4):until ~board[a,b]
                if RND(100)>89 then board[a,b]=4 else board[a,b]=2
                if canMove() then rets
            endif
        next x
    next y

    done=1
ends


sub canMove()

    local x,y

    for y=0 to 3
        for x=0 to 3
            if ~board[x,y] then rets 1
        next x
    next y

    for y=0 to 3
        for x=0 to 3
            if testAdd(x+1,y,board[x,y]) then rets 1
            if testAdd(x-1,y,board[x,y]) then rets 1
            if testAdd(x,y+1,board[x,y]) then rets 1
            if testAdd(x,y-1,board[x,y]) then rets 1
        next x
    next y

    rets 0
ends


sub testAdd(x,y,v)

    if (x<0 or x>3 or y<0 or y>3) then rets 0
    if board[x,y]=v then rets 1

    rets 0
ends


sub moveVert(x,y,d)

    if (board[x,y+d] and board[x,y+d]=board[x,y] and ~blocked[x,y] and ~blocked[x,y+d])
        board[x,y]=0
        board[x,y+d]=board[x,y+d]*2
        score=score+board[x,y+d]
        blocked[x,y+d]=1
        moved=1
    elseif (~board[x,y+d] and board[x,y])
        board[x,y+d]=board[x,y]
        board[x,y]=0
        moved=1
    endif

    if d>0
        if y+d<3 then drawBoard():wait delay:moveVert(x,y+d,1)
    else
        if y+d>0 then drawBoard():wait delay:moveVert(x,y+d,-1)
    endif
ends


sub moveHori(x,y,d)

    if (board[x+d,y] and board[x+d,y]=board[x,y] and ~blocked[x,y] and ~blocked[x+d,y])
        board[x,y]=0
        board[x+d,y]=board[x+d,y]*2
        score=score+board[x+d,y]
        blocked[x+d,y]=1
        moved=1
    elseif (~board[x+d,y] and board[x,y])
        board[x+d,y]=board[x,y]
        board[x,y]=0
        moved=1
    endif

    if d>0
        if x+d<3 then drawBoard():wait delay:moveHori(x+d,y,1)
    else
        if x+d>0 then drawBoard():wait delay:moveHori(x+d,y,-1)
    endif
ends


sub movDir(d)

    local x,y

    if d=VK_UP
        for x=0 to 3
            y=1
            while y<4
                if board[x,y] then moveVert(x,y,-1)
                y=y+1
            endw
        next x
    elseif d=VK_DOWN
        for x=0 to 3
            y=2
            while y>=0
                if board[x,y] then moveVert(x,y,1)
                y=y-1
            endw
        next x
    elseif d=VK_LEFT
        for y=0 to 3
            x=1
            while x<4
                if board[x,y] then moveHori(x,y,-1)
                x=x+1
            endw
        next y
    elseif d=VK_RIGHT
        for y=0 to 3
            x=2
            while x>=0
                if board[x,y] then moveHori(x,y,1)
                x=x-1
            endw
        next y
    endif
ends


sub pickColor(v)

    i=0
    while v>2
        v=v>>1
        i=i+1:if i>6 then i=0
    endw

    rets i+9
ends
    

Image


Last edited by Picnic on 16 Aug 2019, 11:21; edited 20 times in total
Post 11 May 2016, 11:08
View user's profile Send private message Reply with quote
redrum88



Joined: 30 Mar 2016
Posts: 5
Very nice, thanks!
Post 19 May 2016, 00:25
View user's profile Send private message Reply with quote
Picnic



Joined: 05 May 2007
Posts: 1277
Location: countryside
A set of UDP network functions is available for sending and receiving messages
using a connectionless UDP socket. When such a socket is created, all incoming
UDP messages are placed in the waiting stack (queue) and accessed according to
the first-in first-out (FIFO) principle.


A UDP reverse-echo server (Netcat for Windows: nc -u 192.168.1.x 50000)
Code:

    rem  UDP reverse-echo server

    PORT=50000

    ! open UDP socket
    n=OPEN(PORT)
    if n=-1 then alert "error ",V0:end

    title "Server running at ",PATH(6)
    screen 80,30,300
    cursor 0,0

    dim a$[4]
    msg$=""
    info$=""

    do

        ! handle incoming messages
        while LEN(QUEUE(1))

            ! get queue info
            info$=QUEUE(2)

            ! pop the queue
            msg$=QUEUE(0)

            ! print info and message
            ? info$," ",msg$

            ! split info [IP PORT LENGTH TIME]
            n=SPLIT(info$," ",a$[])

            ! send message back reversed
            n=SEND(a$[0],VAL(a$[1]),REVERSE(msg$))

        endw

        wait 1

    until KEY(27)

    n=CLOSE()
    end
    

Testing via UDP Terminal (Android).

Image



P2P console drawing program via UDP.
Drawing changes appear in real time.
Left/Right mouse click (paint/erase).
Keys: 0 to 7 (pen color), space (clear).
Swap the ports between the 2 hosts.
Replace variable ip$ with the remote ip address x.x.x.x
Code:

    rem  P2P drawing program via UDP

    status  fix  mouse:x=V0:y=V1:btn=V2:wait 1

    local_port=50001
    remote_port=50000
    ip$="localhost"

    if open(local_port)=-1 then alert "socket error ",V0:end
    cx=-1:cy=-1:c=7

    title "P2P drawing - host ",path(6)
    screen 80,25
    cursor 0,0
    color 0,7
    cls

    do:status

        if key(32) then cls
        for i=48 to 55
            if key(i) then c=i-48:break
        next

        if btn=1 or btn=2
            if btn=2 then n=0x20 else n=9608
            do:status
                if x<>cx or y<>cy
                    cx=x:cy=y
                    pen c+8
                    at x,y,chr(n)
                    i=send(ip$,remote_port,str((((((c<<7)|x)<<7)|y)<<15)|n))
                endif
            until btn=-1
        endif

        while len(queue(1))
            i=val(queue(0))
            pen getbits(i,31,3)+8
            at getbits(i,28,7),getbits(i,21,7),chr(getbits(i,14,15))
        endw

    until key(27)

    i=close()
    end
    

Testing in local home network between 2 PC's.

Image


Last edited by Picnic on 16 Aug 2019, 11:12; edited 34 times in total
Post 14 Jun 2016, 10:08
View user's profile Send private message Reply with quote
Picnic



Joined: 05 May 2007
Posts: 1277
Location: countryside
I/O operations in Hobby Basic.

Code:

    ! file path$,a$,0          save string as text file
    ! file path$,a$,1          load text file to string
    ! file path$,a$,2          append string to end of file
    ! file path$,array[],0     save array as binary file
    ! file path$,array[],1     load binary file to array
    ! file path$,array[],2     append data to end of file
    ! file path$,0,0           create empty file
    ! file URL$,0,1            download URL
    ! file URL$,0,2            download URL (silently)
    ! file path$,0,3           delete file
    


Code:

    input "Write some text:",a$

    ! save string as text file
    path$=path(1)+"\a.txt"
    file path$,a$,0

    ! print file size
    print path$," ",size(path$)," bytes"
    pause
    

Image


Last edited by Picnic on 16 Aug 2019, 11:24; edited 32 times in total
Post 07 Aug 2016, 09:10
View user's profile Send private message Reply with quote
Picnic



Joined: 05 May 2007
Posts: 1277
Location: countryside
A new version upload with some minor improvements, and fixes in bugs i noticed.
I have tested the interpreter with success in Windows XP/7/8 32/64 bit, Wine (Linux).
The source code have been removed from the zip file.

A drawing program written in Hobby Basic.
Code:

    rem  Textdraw Version 0.2

    C=80
    R=40
    M=270
    W=C+20
    MB_OK=0x0
    MB_YESNO=0x4
    ID_YES=6
    p=0

    dim a[M]
    dim m[C,R]
    dim e[C,R]
    dim p[C,R]

    moved  fix  (x<>tmpx or y<>tmpy)
    left_panel  fix  (x<9 and btn=1)
    right_panel  fix  (x>(W-10))
    main_panel  fix  (x>8 and x<(W-11))

    help$="L   Load (file types .ANS .HB)"+EOL$
    help$=help$+"S   Save (as type .HB "+STR(C)+'x'+STR(R)+')'+EOL$
    help$=help$+"C   Clear screen"+EOL$
    help$=help$+"U   Undo last move"+EOL$
    help$=help$+"F   Flip rectangle"+EOL$
    help$=help$+"P   Paste rectangle"+EOL$
    help$=help$+"I    Invert rectangle"+EOL$
    ver$="Textdraw Version 0.2"
    path$=PATH(1)+"\ART\"
    cursor 0,0
    color 0,0

    for i=0 to 0x25A0
        if p>=M then break
        at 0,0,CHR(i)
        peek 0,0
        if (V0<>0x3F and (i<6 or i>13))
            a[p]=V0
            p=p+1
            title "loading charset  U+",PAD(UCASE(HEX(V0)),'0',4)
        endif
    next

    title ver$," - Press H for help"
    screen W,R
    cls

    for i=0 to p-1
        ? CHR(a[i]),
        if (i%8)=0 then print
    next

    copy 0,0,8,R:cls
    paste W-9,2
    color 8,15
    paint 0,0,9,R,' ',1
    paint W-11,0,11,R,-1,1
    at 1,1," Load"
    at 1,3," Save"
    at 1,5," Clear"
    at 1,7," ----"
    at 0,9,">FG"
    at 1,11,"BG"
    color 8,7
    at W-8,1,"select"
    color 7,7
    erase 4,9,4,' ',1
    color 0,0
    erase 4,11,4,' ',1

    for i=0 to 7
        color i,0
        paint 1,i*2+14,3,2,' ',1
        color i+8,0
        paint 4,i*2+14,3,2,' ',1
    next

    color 8,0
    paint 4,14,3,2,9618,1

    save=1:tmpx=-1:tmpy=-1:cx=-1:cy=-1:bg=0:fg=7:e=0:z=0:w=0:h=0
    a=9:b=0:c=0:v=9:u=0:i=0:n=0:t=0:k=0:sx=0:sy=0:a$="":b$="":c$=""

    start#

    do

        k=KEY(-1)&0x5F
        if k='L'
            goto load_file
        elseif k='S'
            goto save_file
        elseif k='C'
            clear()
        elseif (k='U' and u>0)
            restore:u=u-1
        elseif k='P'
            store 9,0,C,R:u=u+1
            store W-11,0,11,C:u=u+1
            store 0,0,9,R:u=u+1
            grab x,y,w,h,p[],1
            restore:u=u-1
            restore:u=u-1
        elseif k='D'
            store 9,0,C,R:u=u+1
            color 0,0
            paint a,b,w,h,-1,-1
        elseif k='I'
            store 9,0,C,R:u=u+1
            invert a,b,w,h
        elseif k='F'
            store 9,0,C,R:u=u+1
            z=z^1:flip a,b,w,h,z
        elseif k='H'
            alert MB_OK,ver$,help$
        endif

        btn=status()

        if main_panel

            if moved
                ucode()
                coords()
            endif

            if (btn=1 or btn=2)
                store 9,0,C,R:u=u+1
                sx=x:sy=y:draw(x,y,1,1)
                while status()<>-1
                    if (main_panel and moved)
                        w=abs(sx-x)+1
                        h=abs(sy-y)+1
                        if x>sx then x=sx
                        if y>sy then y=sy
                        if (x>8 and x<W-11) then a=x:b=y
                        draw(x,y,w,h)
                    endif
                endw
                save=0
                if (btn=2 and u>0)
                    restore:u=u-1
                    grab a,b,w,h,p[],0
                endif
            endif

        elseif left_panel

            if y=1
                load_file#
                copy 0,0,W,R
                color 0,7:cls
                cursor 1,100
                title -1,b$
                title "Load (file types .ANS .HB)"
                screen W,R,M
                ? "Load from: ",path$,EOL$
                cmd$="dir /b "+CHR(0x22)+path$+CHR(0x22)
                exec cmd$,a$
                a$=TRIM(UCASE(a$))
                n=0:r=0:i=0
                do
                    i=i+1
                    c$=TRIM(READLN(i,a$)):r=V0
                    if ((r<>-1 and n<M) and (COMP(RIGHT(c$,3),".HB") | COMP(RIGHT(c$,4),".ANS")))
                        ? c$
                        n=n+1
                    endif
                until r=-1
                ?:input "Enter a file name to load:",a$
                a$=TRIM(UCASE(a$))
                cursor 0,0
                screen W,R
                paste 0,0
                color bg,fg
                title b$
                if n=0 then goto continue
                if COMP(RIGHT(a$,3),".HB")   ! load HB data
                    if LEN(a$)>3
                        a$=path$+a$
                        if SIZE(a$)<>-1
                            file a$,e[],1
                            clear()
                            grab 9,0,C,R,e[],1
                            title a$
                            save=1
                        endif
                    endif
                elseif COMP(RIGHT(a$,4),".ANS")   ! load ANSI art
                    if LEN(a$)>3
                        a$=path$+a$
                        if SIZE(a$)<>-1
                            view 0
                            store 0,0,W,R
                            screen 80,40
                            color 0,0:cls
                            ansi a$
                            grab 0,0,C,R,e[],0
                            screen W,R
                            restore
                            grab 9,0,C,R,e[],1
                            title a$
                            view 1
                            save=1
                        endif
                    endif
                endif

            elseif y=3
                save_file#
                copy 0,0,W,R
                color 0,7:cls
                cursor 1,100
                title -1,b$
                screen W,R,M
                title "Save (file types .HB)"
                ? "Save to: ",path$
                ?:input "Enter a file name to save:",a$
                a$=TRIM(UCASE(a$))
                cursor 0,0
                screen W,R
                paste 0,0
                color bg,fg
                title b$
                if ~COMP(RIGHT(a$,3),".HB") then a$=a$+".HB"
                if LEN(a$)>3
                    a$=path$+a$
                    grab 9,0,C,R,m[],0
                    file a$,m[],0
                    if V0<>-1
                        title a$
                        save=1
                    endif
                endif

            elseif y=5
                clear()

            elseif (y=9 or y=11)
                color 8,15
                erase 0,y,1,'>',1
                if y=9 then v=11 else v=9
                erase 0,v,1,' ',1
                v=y

            elseif (y>12 and y<30)
               peek x,y
                if V1=8 then e=9618 else e=32
                if v=9
                    fg=V1
                    color fg,0
                else
                    bg=V1
                    color bg,0
                endif
                erase 4,v,4,e,1
            endif

        elseif right_panel

            peek x,y
            if V0<>32
                if btn=1
                    c=V0
                    invert cx,cy,1,1
                    color 8,15
                    erase cx,cy,1,-1,1
                    color 11,0
                    erase x,y,1,-1,1
                    invert x,y,1,1
                    cx=x:cy=y
                endif
                ucode()
            endif

        endif

        continue#

        wait 1
    until KEY(27)

    if save=0
        alert MB_YESNO,ver$,"File is not save, exit?"
    else
        alert MB_YESNO,ver$,"Do you want to exit?"
    endif

    if V0<>ID_YES then goto start
    end


sub clear()
    do:restore:until V0=-1
    color 0,0
    paint 9,0,C,R,-1,-1
    color 8,7
    erase W-9,1,8,0x20,1
    color bg,fg
    title ver$," - Press H for help"
    save=0
    u=0
ends


sub draw(x,y,w,h)
    if btn=1
        color bg,fg
        paint x,y,w,h,c,1
    elseif btn=2
        color 0,1
        paint x,y,w,h,-1,1
    endif
ends


sub ucode()
    peek x,y
    i=V0:if i=32 then rets
    color 8,7
    at W-9,1,("U+"+PAD(STR(i),'0',4)+' '+CHR(i))
ends


sub coords()
    tmpx=x
    tmpy=y
    color 8,15
    at 2,7,(STR(x-9)+','+STR(y)+' ')
ends


sub status()
    mouse
    x=V0
    y=V1
    rets V2
ends
    

Image


Last edited by Picnic on 14 Apr 2019, 14:39; edited 8 times in total
Post 21 Oct 2016, 08:41
View user's profile Send private message Reply with quote
filox



Joined: 13 Feb 2013
Posts: 11
Sorry but where i can find sources of Hobbybasic?
Post 21 Oct 2016, 11:52
View user's profile Send private message Reply with quote
Display posts from previous:
Post new topic Reply to topic

Jump to:  
Goto page Previous  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.