Hobby Basic, ένας μικρός διερμηνευτής για την κονσόλα των Windows

[Blue Max]

H Hobby Basic είναι ένας διερμηνευτής για την κονσόλα των Windows.
Το συντακτικό της είναι τύπου BASIC.
Χειρίζεται ANSI γραφικά με ευκολία.
Υποστηρίζει Ελληνικά και ποντίκι.
Δημιουργεί αυτόνομο εκτελέσιμο.
Είναι γραμμένη σε fasm.

Download


Λίγα λόγια για την γλώσσα.

Το 2013 έγραψα μια βιβλιοθήκη από ρουτίνες για την κονσόλα σε 32-bit assembly με σκοπό να με βοηθήσουν στα δικά μου project. Δηλαδή κώδικα που θα μπορούσα να επαναχρησιμοποιήσω. Έγραψα διάφορες μικρές εφαρμογές με την βιβλιοθήκη αυτή (ανάμεσα σε αυτές και ένα multi-user chat server), είδα πως οι ρουτίνες δουλεύουν σταθερά. Το 2015 μου ήρθε η ιδέα να δέσω την βιβλιοθήκη αυτή γύρω από έναν μικρό διερμηνευτή BASIC, έτσι γεννήθηκε η Hobby Basic. Μέχρι και σήμερα την αναπτύσω, σιγά-σιγά και χαλαρά, όταν ξεκλέψω λίγο ελεύθερο χρόνο κάποιο Σαββατοκύριακο. Πρόκειται για ένα απλοικό toy intepreter με ορισμένες μάλλον ασυνήθιστες δυνατότητες όπως θα διαπιστώσετε. Δεν σκοπεύει να αντικαταστήσει την αγαπημένη σας γλώσσα προγραμματισμού.

Λόγω της ιδιαιτερότητας του εκτελέσιμου αρχείου, που οφείλεται στο μικρό μεγέθους του, και την γλώσσα που είναι γραμμένο (assembly), υπάρχει περίπτωση το AV σας να γκρινιάξει. Θα είναι περίπτωση false positive, η HB είναι ανεβασμένη στο δίκτυο αρκετό καιρό και δοκιμασμένη από πολλούς χρήστες. Ανάμεσα στα παραδείγματα κώδικα που την συνοδεύουν θα βρείτε ένα σχεδιαστικό πρόγραμμα για την κονσόλα, έναν ANSI Viewer αλλά και ένα p2p Draw μεταξύ 2 υπολογιστών. Με εντελώς retro λοιπόν διάθεση την κάνω post σήμερα εδώ.


Ένα παράδειγμα κώδικα.

    rem  TV.BAS
    rem  Hobby Basic Interpreter

    FULL_BLOCK = 0x2588

    a$ = 'N  O   S  I  G  N  A  L'

    dim c[8] = 15,14,11,10,13,12,9,0

    title a$

    screen 80,25
    cursor 0,0
    color 0,7
    cls

    for x = 0 to 7
        pen c[x]
        paint x*10,0,10,25,FULL_BLOCK,1
    next x

    erase 17
    erase 18
    erase 19

    pen 15
    at 25,18,a$

    inkey

    cls : end

Πως να τρέξετε τα παραδείγματα.

Ανοίξτε την γραμμή εντολών CMD.EXE στον φάκελο της HB.
Για να τρέξετε το πρόγραμμα TV.BAS πληκτρολογήστε:

hb EXAMPLES/TV.BAS

Σημείωση για χρήστες των Windows 10.

Αν η Hobby Basic δεν λειτουργεί σωστά στην κονσόλα των Windows 10, δοκιμάστε να ενεργοποιήστε την επιλογή legacy για μέγιστη συμβατότητα.

Ακόμα ένα παράδειγμα κώδικα.

    rem  RALLY.BAS
    rem  Hobby Basic Interpreter

    C = 9
    R = 5
    D = 0

    dim rally[C,R]
    dim temp[16]

    rally$ = PATH('DATA\RALLY.HB')
    road$ = '███                     ███'
    distance = 0

    load rally$,rally[]
    if V0 = -1 then alert 0x10,'path not found',rally$ : end

    data$ = PATH('DATA\RALLY.TXT')
    if SIZE(data$) = -1 then save data$,'100'

    load data$,best$
    best$ = TRIM(best$)

    for index = 0 to 15
        rgbc index, -1
        temp[index] = V0
    next

    title 'Rally 0.2'
    screen 80,25
    cursor 0,0

    grab 0,0,C,R,rally[],1


start#

    gosub STAGE0

    if D > VAL(best$)
        best$ = STR(D)
        save data$,best$
    endif

    x = 36
    y = 12
    n = 30
    p = 40
    r = 0
    D = 0
    T = 40000

    color 0,7 : cls
    at 4,2,'Use the arrow keys'
    at 4,3,('Try to beat '+best$)
    at 4,4,'Distance 0'

    color 6,2
    for i = 0 to 24
        erase n,i,24,-1,-1
        at n,i,road$
    next

    for i = 3 to 0 step -1
        if i = 0
            at p,2,'█████'
            at p,3,'█   █'
            at p,4,'█   █'
            at p,5,'█   █'
            at p,6,'█████'
        elseif i = 1
            at p,2,'  █  '
            at p,3,'  █  '
            at p,4,'  █  '
            at p,5,'  █  '
            at p,6,'  █  '
        elseif i = 2
            at p,2,'█████'
            at p,3,'    █'
            at p,4,'█████'
            at p,5,'█    '
            at p,6,'█████'
        elseif i = 3
            at p,2,'█████'
            at p,3,'    █'
            at p,4,'█████'
            at p,5,'    █'
            at p,6,'█████'
        endif
        wait 400000
    next


main#

    paint x,y-1,C,R,-1,-1

    if KEY(37)
        x = x - 1
    elseif KEY(39)
        x = x + 1
    elseif KEY(27)
        for index = 0 to 15
            rgbc index, temp[index]
        next
        color 0,7:cls:end
    endif

    if (CELL(x,y+2) = '█' or CELL(x+1,y+4) = '█' or CELL(x+8,y+2) = '█' or CELL(x+7,y+4) = '█')
        grab x,y,C,R,rally[],1
        color 0,4
        paint 25,0,55,25,-1,1
        wait 1000000
        goto start
    endif

    grab x,y,C,R,rally[],1

    color 0,7
    move 25,1,50,24,25,0

    D = D + 1
    if ~(D % 500)
        r = (r + 1) % 4
        gosub STAGE//r
    endif

    n = n + RND() % 3 - 1
    if n < 25 then n = 25
    if n > 48 then n = 48

    at 13,4,D
    color 6,2
    at n,24,road$

    T = T - 20 : wait T
    goto main

    STAGE0#  rgbc 2,0x228B22 : rgbc 4,0x2A2AA5 : rgbc 6,0x0B86B8 : return
    STAGE1#  rgbc 2,0x800080 : rgbc 4,0x8B008B : rgbc 6,0xD355BA : return
    STAGE2#  rgbc 2,0x228B22 : rgbc 4,0x008000 : rgbc 6,0x6BB7BD : return
    STAGE3#  rgbc 2,0xED9564 : rgbc 4,0xFF901E : rgbc 6,0xE6E0B0 : return

 

[Always Somewhere]

Respect

 

[Blue Max]

Γεια χαρά Always Somewhere.

Αν κάποιος χρειαστεί βοήθεια ή περισσότερες οδηγίες για να την τρέξει, feel free to ask.

 

[Blue Max]

Μερικά παραδείγματα που έγραψα με την Hobby Basic. Με τον τρόπο αυτό τεστάρω την λειτουργικότητα της, ενώ παράλληλα επιδυκνείω τις δυνατότητες της. Όσο μεγαλώνει, τόσο περισσότερο διασκεδαστικός γίνεται ο προγραμματισμός με αυτή.


Τυχαίοι χρωματιστοί χαρακτήρες.

    rem  RND.BAS
    rem  Hobby Basic Interpreter

    color 0,0 : cls

    do

        x = RND() % 24 + 2
        y = RND() % 14 + 1
        c = RND() % 95 + 32
        pen c
        at x,y,CHR(c)

    until KEY(-1)

    cls : end

Διαβάζοντας το ποντίκι στην κονσόλα.

    rem  MOUSE.BAS
    rem  Hobby Basic Interpreter
    rem
    rem  mouse {}  --> V0,V1,V2,V3
    rem  Returns:
    rem  V0 = cell x
    rem  V1 = cell y
    rem  V2 = 1 left btn, 2 right btn, 4 double click, 254 lost focus, 255 got focus
    rem  V3 = coordinates in pixels (high/low order word)

    cls : print 'click mouse inside window'

    x = -1
    y = -1

    do

        mouse

        if (V0 <> x or V1 <> y)
            x = V0
            y = V1
            a$ = STR(x) + ',' + STR(y)
            title a$
        endif

        if V2 = 1
            ? a$ , ' left button'
        elseif V2 = 2
            ? a$ , ' right button'
        elseif V2 = 4
            ? a$ , ' double click'
        endif

    until KEY(27)
    end

Tetris για την Hobby Basic.

    rem  TETRIS.BAS
    rem  Hobby Basic Interpreter

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

    path$ = PATH('DATA\TETRIS.TXT')
    if SIZE(path$) = -1 then save path$,'100'

    load path$,best$
    best$ = TRIM(best$)

    title 'Tetris in Hobby Basic'

    screen 40,30
    cursor 0,0
    color 0,0
    cls

Restart#
    gosub Initialize
    gosub PlayGame
    gosub GameOver
    goto Restart

PlayGame#
    do : gosub GetKeys
        if TICK() - now > time
            gosub DeletePiece
            gosub Move40
            gosub PrintPiece
            now = TICK()
        endif
        wait 1
    until k = 27
    return

GetKeys#
    for a = 0 to 4
        if KEY(kbd[a])
            k = kbd[a]
            if k = 27 then break
            gosub DeletePiece
            gosub Move//k
            gosub PrintPiece
            break
        endif
    next
    wait 40000
    return

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

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

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

Move40#
    for r = 0 to 3
        if CELL(x+piecex[r], y+1+piecey[r]) <> ' '
            gosub PrintPiece
            x = startx
            y = starty
            gosub GetPiece
            if k = 27 then break
            gosub CheckLines
            return
        endif
    next
    y = y + 1
    return

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

CheckLine#
    for i = topleftx to maxx
        if CELL(i,j) <> 35 then return
    next
    for i = topleftx to maxx
        print at i,j,' '
    next
    for l = 0 to j-toplefty-1
        for n = topleftx to maxx
            info n,j-l-1
            i = V0
            pen V2
            print at n,j-l,CHR(i)
        next
    next
    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
    gosub DeleteNextPiece
    gosub GetNextPiece
    gosub PrintNextPiece
    for i=0 to 3
        if CELL(x+piecex[i], y+piecey[i]) <> ' '
        k = 27
        break
    endif
    next
    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
    pen 7
    return

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

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

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

GameOver#
    pen 5
    paint 18,2,20,26,-1,1
    pen 7
    print at 24,14,'GAME OVER'
    if score > VAL(best$)
        best$ = STR(score)
        save path$,best$
    endif
    inkey
    return

Initialize#
    color 0,8
    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: 0      ░                    ░░'
    at 0,9, '░                ░                    ░░'
    at 0,10,'░░░░░░░░░░░░░░░░░░                    ░░'
    at 0,11,'░░░░░░░░░░░░░░░░░░                    ░░'
    at 0,12,'░                ░                    ░░'
    at 0,13,'░  Best:         ░                    ░░'
    at 0,14,'░                ░     Press SPACE    ░░'
    at 0,15,'░░░░░░░░░░░░░░░░░░                    ░░'
    at 0,16,'░░░░░░░░░░░░░░░░░░                    ░░'
    at 0,17,'░                ░                    ░░'
    at 0,18,'░  Next:         ░                    ░░'
    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,'░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░'
    at 9,13,best$
    printcolor = 0
    nextcolor = 0
    topleftx = 18
    toplefty = 3
    maxx = 37
    maxy = 27
    startx = 27
    starty = 2
    x = startx
    y = starty
    nextx = 10
    nexty = 18
    time = 250
    score = 0
    i=0:k=0:r=0:j=0:l=0:n=0:ln=0:z=0:now=TICK()
    inkey:if V0=27 then cls:end
    paint 18,2,20,26,-1,-1
    gosub GetNextPiece
    gosub GetPiece
    gosub PrintScore
    gosub PrintNextPiece
    return

Τρίλιζα για την Hobby Basic.

    rem  XO.BAS
    rem  Hobby Basic Interpreter

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

    title 'X''s and O''s in Hobby Basic'

    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

Άνοιγμα μια εικόνας ANSI.

    rem  APPLE1.BAS
    rem  Hobby Basic Interpreter
    rem  ansi {path$,[s]}  --> V0

    apple$ = PATH('ART\APPLE.ANS')
    if SIZE(apple$) = -1 then alert 0x10,'path not found',apple$ : end

    screen 80,25
    cls

    ansi apple$

    inkey

    cls : end

Η εντολή Block.

    rem  APPLE2.BAS
    rem  Hobby Basic Interpreter
    rem
    rem  block {x,y,cols,rows,block_id}  --> V0
    rem  Copies a specific area of the screen to a memory block
    rem
    rem  block {x,y,block_id}  --> V0
    rem  Copies a memory block to screen


    apple$ = PATH('ART\APPLE.ANS')
    if SIZE(apple$) = -1 then alert 0x10,'path not found',apple$ : end

    ! block id's
    A = 700
    B = 701

    screen 80,25
    cursor 0,0
    cls

    ansi apple$

    ! split screen to blocks A and B
    block 0,0,40,25,A
    block 40,0,40,25,B

    cls

    ! copy blocks to screen
    block 0,0,B
    block 40,0,A

    inkey

    cls : end

Ανακάτεμα της οθόνης.

    rem  APPLE3.BAS
    rem  Hobby Basic Interpreter

    apple$ = PATH('ART\APPLE.ANS')
    if SIZE(apple$) = -1 then alert 0x10,'path not found',apple$ : end

    ! block id array
    dim a[16]

    ! set array to consecutive values starting from zero
    set a[],5:0

    title 'Press any key to start shuffling'

    screen 80,25
    cursor 0,0
    cls

    ansi apple$

    inkey

    title 'Press any key to stop'

    ! split screen to blocks
    for i = 0 to 15
        block (i%4)*20,(i/4)*6,20,6,a[i]
    next


    do

        ! shuffle array
        set a[],1

        ! copy blocks to screen
        for i = 0 to 15
            block (i%4)*20,(i/4)*6,a[i]
        next

        wait 30000

    until KEY(-1)
    end

Το παζλ 2048 για την Hobby Basic.

    rem  2048 Puzzle
    rem  Hobby Basic Interpreter

    dim board[4,4]
    dim blocked[4,4]
    delay = 10000

    path$ = PATH('DATA\2048.TXT')
    if SIZE(path$) = -1 then save path$,'100'

    load path$,best$
    best$ = TRIM(best$)

    title '2048 Puzzle in Hobby Basic'

    screen 80,25
    cursor 0,0
    color 0,0
    cls

start#

    pen 7
    at 1,18,'Join the numbers and get to the 2048 tile!'
    at 1,19,'Use the arrow keys to move the tiles'
    at 1,20,'Press R to restart, Esc to quit'
    at 32,2,'Score:'
    at 32,4,('Best: '+best$)
    erase 21

    done = 0
    score = 0
    moved = 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()
        at 39,2,(STR(score)+'     ')
        if done then break
        waitKey()
    until done

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

    if done = 27 then cls:end
    if done = 'R' then goto start

    locate 1,21
    print 'No more moves.'

    @@# inkey
    k = V0 & 0x5F
    if k = 'R' then goto start
    if k <> 27 then goto @b
    cls:end


sub drawBoard()

    local x,y,v,i

    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 (x*7)+2,(y*4)+1,6,3,-1,-1
            if i <> 5 then at (x*7)+2,(y*4)+2,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 = 38
        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 = 40
        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 = 37
        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 = 39
        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)

    local i = 0

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

    rets i + 9
ends

Η εντολής Repaint.

    rem  APPLE4.BAS
    rem  Hobby Basic Interpreter
    rem  repaint {x,y,cols,rows,color1,color2}

    apple$ = PATH('ART\APPLE.ANS')
    if SIZE(apple$) = -1 then alert 0x10,'path not found',apple$ : end

    screen 80,25
    cursor 0,0
    cls

    ansi apple$

    repaint 0,0,80,25,1,4
    repaint 0,0,80,25,9,13

    inkey

    cls : end

ANSI Text File Viewer για την Hobby Basic.

    rem  AVIEW.BAS
    rem  Hobby Basic Interpreter
    rem  ANSI Text File Viewer (remote version)

    url$ = 'https://sites.google.com/site/hobbybasicfiles/ansi/'

    if CHDIR('ART\',0) = -1
        ? 'missing ART folder' : pause : end
    endif

    path$ = PATH('AAA-VOL2.TXT')

    if SIZE(path$) = -1 then path$ = url$ + 'AAA-VOL2.TXT'

    ? 'loading list...',

    load path$,list$
    if V0 = -1 then ? 'failed' : pause : end

    speed = 5
    time = 2000000
    AUTO_PLAY = TRUE

    screen 80,25,1000
    cursor 0,0


main#

    color 0,7 : cls
    n = (RND() % 83) + 1
    a$ = GETLN(n,list$)
    if V0 = -1 then ? 'error loading line ',n : goto @F
    if SIZE(a$) = -1 then path$ = url$ + a$ else path$ = PATH(0) + '\' + a$
    title path$
    ansi path$,speed
    @@# if KEY(27) then end
    if AUTO_PLAY then wait time else inkey
    goto main

2D Side Movement.

    rem  SPRITE1.BAS
    rem  Hobby Basic Interpreter
    rem
    rem  grab {x,y,cols,rows,array[],method}
    rem  Copies screen to a 2D array or vice versa
    rem
    rem  method=0 screen to array
    rem  method=1 array to screen
    rem  method=2 array to screen (skip zero cells)
    rem
    rem  grab {ax,ay,cols,rows,array[],x,y}
    rem  Copies a specific part of a 2D array to screen


    LIGHT_SHADE = 0x2591
    FULL_BLOCK = 0x2588

    W = 80
    H = 25
    C = 6
    R = 4

    dim a[C,R]
    dim m[W,H]

    title 'Use the Arrow keys to move sprite'

    screen W,H
    cursor 0,0
    color 0,0
    cls

    color 1,8
    paint 0,H-3,W,3,LIGHT_SHADE,1
    pen 11
    at 2,H-2,'2D Side Movement'

    color 8,8
    paint 20,H-18,24,15,FULL_BLOCK,1
    color 4,4
    paint 50,H-13,20,10,FULL_BLOCK,1
    grab 0,0,W,H,m[],0

    x = 2
    y = H - R - 3
    px = x
    py = y

    color 13,13
    paint x,y,C,R,FULL_BLOCK,1
    color 0,0
    paint x+1,y+1,C-2,R-2,FULL_BLOCK,1
    grab x,y,C,R,a[],0


    do

        if (KEY(37) and x > 0)

            px = x
            x = x - 1

        elseif (KEY(39) and x <= W)

            px = x
            x = x + 1

        endif

        grab px,py,C,R,m[],px,py
        grab x,y,C,R,a[],2

        wait 12000

    until KEY(27)

    cls : end

2D Scrolling Background.

    rem  SPRITE2.BAS
    rem  Hobby Basic Interpreter
    rem
    rem  grab {x,y,cols,rows,array[],method}
    rem  Copies screen to a 2D array or vice versa
    rem
    rem  method=0 screen to array
    rem  method=1 array to screen
    rem  method=2 array to screen (skip zero cells)
    rem
    rem  grab {ax,ay,cols,rows,array[],x,y}
    rem  Copies a specific part of a 2D array to screen


    LIGHT_SHADE = 0x2591
    FULL_BLOCK = 0x2588

    W = 80
    H = 25
    C = 6
    R = 4

    dim a[C,R]
    dim m[2*W,H]

    view 0
    screen 2*W,H

    cursor 0,0 : color 0,0 : cls
    title 'Use the Arrow keys to move sprite - Spacebar to jump'

    color 13,13
    paint 0,0,C,R,FULL_BLOCK,1
    color 0,0
    paint 1,1,C-2,R-2,-1,-1
    grab 0,0,C,R,a[],0

    cls : color 1,8
    paint 0,H-3,W,3,LIGHT_SHADE,1
    pen 11
    at 2,H-2,'2D Scrolling Background'
    color 8,8
    paint 20,H-18,24,15,FULL_BLOCK,1
    color 4,4
    paint 50,H-13,20,10,FULL_BLOCK,1
    color 0,0

    copy 0,0,W,H
    paste W,0
    grab 0,0,2*W,H,m[],0

    screen W,H
    view 1

    d = 0
    up = 0
    T = H - 3
    f = T - R
    y = f
    x = 35

    grab x,0,W,T,m[],0,0
    grab x,y,C,R,a[],2


    do

        if ~ up
            if (KEY(32))
                up = 1
                v = -1
            elseif KEY(37)
                d = -2
            elseif KEY(39)
                d = 2
            else
                d = 0
            endif
        else
            y = y + v
            if y = 2
                v = 1
            elseif y > f
                up = 0
                y = f
            endif
        endif

        if (d or up)
            x = x + d
            if x < 0 then x = W-1
            if x > W-1 then x = 0
            grab x,0,W,T,m[],0,0
            grab 35,y,C,R,a[],2
        endif

        wait 12000

    until KEY(27)

    cls : end

Διαδρομές της Hobby Basic.

    rem  MISC.BAS
    rem  Hobby Basic Interpreter

    cmdline$ = V0

    rem  Do not write above this line

    dim argv$[8]

    argc = split(cmdline$,' ',argv$[])

    title 'Let''s Hobby'

    screen 80,25,300 : cls

    ? 'Current Directory'
    ? 'Hobby Basic Path'
    ? 'File Path'
    ? 'File Name'
    ? 'Windows Path'
    ? 'Interpreter Version'
    ? 'Windows Version'
    ? 'Host Name'
    ? 'Local IP Adrress'
    ? 'Window Title'
    ? 'Screen Resolution'
    ? 'Window Pixels'
    ? 'Window Cells'
    ? 'Cell Pixels'
    ? 'File Bytes'
    ? 'Tick Counter'
    ? 'Local Time'

    for i = 0 to 9
        at 25,i,PATH(i)
    next

    view 1
    at 25,10,(STR(V0)+'x'+STR(V1))

    screen -1,-1
    at 25,11,(STR(V2)+'x'+STR(V3))
    at 25,12,(STR(V0)+'x'+STR(V1))

    info 0,0
    at 25,13,(STR(V3&0xFF)+'x'+STR(V3>>16))

    at 25,14,SIZE(PATH(2))

    for i = 0 to argc - 1
        at 0,i+17,('CmdLine Argv$[' + STR(i) +']')
        at 25,i+17,argv$[i]
    next

    @@#
    at 25,15,STR(TICK(0))
    at 25,16,STR(TICK(1))
    if KEY(27) then cls : end
    wait 1
    goto @b

Αλλαγή της παλέτας των χρωμάτων.

    rem  PALETTE.BAS
    rem  Hobby Basic Interpreter
    rem  rgbc {index,0xBBGGRR}  --> V0

    FULL_BLOCK = 0x2588

    a$ = 'Whatever 16 full-RGB colors you like'

    dim temp[16]

    dim Molokai[16] = 0x121212,0x1080D0,0x98E123,0x43A8D0,0xFA2573,0x8700FF,0xDFD460,\
    0xBBBBBB,0x555555,0x00AFFF,0xB1E05F,0x51CEFF,0xF6669D,0xAF87FF,0xFFF26D,0xFFFFFF

    color 0,0
    cls

    ! store the old RGB values and set new
    for index = 0 to 15
        rgbc index, -1
        temp[index] = V0
        rgbc index, Molokai[index]
    next

    for i = 0 to 7
        pen i
        paint i*3,1,3,2,FULL_BLOCK,1
        pen i + 8
        paint i*3,3,3,2,FULL_BLOCK,1
    next

    locate 0,6

    for i = 0 to 15
        pen i
        ? a$
    next

    inkey

    ! restore the palette
    for index = 0 to 15
        rgbc index, temp[index]
    next

    end

P2P Drawing via UDP sockets.

    rem  P2P Drawing via UDP sockets
    rem  Click left mouse button to paint a cell
    rem  Click right mouse button to clear a cell
    rem  Swap the connection ports between the hosts
    rem  Set ipv4$ to remote computer address '192.168.1.xxx'

    getmouse()  fix  mouse:x=V0:y=V1:btn=V2:wait 1

    LOCAL_PORT = 50001
    REMOTE_PORT = 50002
    ipv4$ = 'localhost'

    px = -1
    py = -1

    if OPEN(LOCAL_PORT) = -1 then alert 0x10,'socket error ',STR(V0) : end

    title  'P2P Drawing via UDP sockets running on ',PATH(8)
    cursor 0,0
    color 0,0
    cls

    do

        getmouse()
        if (btn = 1 or btn = 2)
            if btn = 2 then c = 0 else c = 0x2588
            do : getmouse()
                if (x <> px or y <> py)
                    pen 15
                    at x,y,CHR(c)
                    px = x
                    py = y
                    ! send data string
                    a$ = STR((((x<<7)|y)<<15)|c)
                    n = SEND(ipv4$,REMOTE_PORT,a$)
                endif
            until btn = -1
        endif

        ! handle incoming messages
        while LEN(QUEUE(1))
            n = VAL(QUEUE(0))
            x = BITS(n,28,7)
            y = BITS(n,21,7)
            c = BITS(n,14,15)
            pen 9
            at x,y,CHR(c)
        endw

    until KEY(27)

    n = CLOSE() : end

XONIX για την Hobby Basic.

    rem  XONIX.BAS
    rem  Hobby Basic Interpreter

sub enemyMove(i)

    color 0,0 : at x[i],y[i],' '
    x[i] = x[i] + dx[i] : if grid[x[i],y[i]] = OK then dx[i] = -dx[i] : x[i] = x[i] + dx[i]
    y[i] = y[i] + dy[i] : if grid[x[i],y[i]] = OK then dy[i] = -dy[i] : y[i] = y[i] + dy[i]
    color 12,12 : at x[i],y[i],' '

ends

sub drop(x,y)

    if grid[x,y] = 0 then grid[x,y] = -1
    if grid[x-1,y] = 0 then drop(x-1,y)
    if grid[x+1,y] = 0 then drop(x+1,y)
    if grid[x,y-1] = 0 then drop(x,y-1)
    if grid[x,y+1] = 0 then drop(x,y+1)

ends

sub status()

    local a$ = 'Score  ' + STR(score) + '    Xn  ' + STR(lives) + '    Full  ' + STR(perc) + '%'
    title a$

ends

    S = 1
    C = 60
    R = 30
    CX = C / 2
    CY = R / 2
    CR = (C - 2) * (R - 2)
    TAIL = 0xAA0020
    delay = 70000
    dim grid[C,R]

    load PATH('DATA\XONIX.TXT'),xonix$
    if V0 = -1 then alert 0x30,PATH(3),'missing file'

    screen C,R
    cursor 0,0

    color 0,2 : cls : ? xonix$
    block 0,0,39,6,700


intro#

    color 0,15 : cls : title 'Xonix!'
    block CX-19,CY-5,700

    at CX-9,CY-8,'H o b b y  B a s i c'
    at CX-13,CY+4,'P r e s s  A  t o  S t a r t'
    pen 10 : i = 0 : k = 0 : lives = 3 : enemyCount = 1 : score = 0

    do
        store CX-19+i,CY-5,2,6
        paint CX-19+i,CY-5,2,6,-1,1
        wait 120000 : restore
        i = (i + 2) % 120
        k = KEY(-1) & 0x5F
        if k = 27 then alert 0x4|0x20,'Xonix','Do you want to exit ?': if V0 = 6 then cls : end
    until k = 'A'

    for i = 0 to CX : move 1,0,CX,R,0,0 : move CX,0,CX,R,CX+1,0 : wait 20000 : next


start#

    dim x[enemyCount]
    dim y[enemyCount]
    dim dx[enemyCount]
    dim dy[enemyCount]

    OK = ((0x11 + (enemyCount  % 8) * 17) << 16) | 0x20
    x = 0 : y = 0 : dx = 0 : dy = 0 : m = 0 : n = 0 : perc = 0 : t = TICK()

    for i = 0 to enemyCount - 1
        x[i] = RND() % CX + 10
        y[i] = RND() % CY + 5
        dx[i] = (RND() % 3 - 1)|1
        dy[i] = (RND() % 3 - 1)|1
    next

    wait 500000 : color 0,0 : cls : status()

    for i = 0 to R - 1
        for j = 0 to C - 1
            if i = 0 or j = 0 or i = R-1 or j = C-1 then grid[j,i] = OK else grid[j,i] = 0
        next
    next

    grab 0,0,C,R,grid[],1

    a$ = 'S t a g e  ' + STR(enemyCount)
    pen 15 : at CX-6,CY,a$
    wait 1500000
    erase CX-6,CY,15,-1,-1

    total = score
    Game = TRUE


main#

    if KEY(27) then Game = FALSE : lives = 1
    if KEY(37) then dx = -1 : dy = 0
    if KEY(39) then dx = 1 : dy = 0
    if KEY(38) then dx = 0 : dy = -1
    if KEY(40) then dx = 0 : dy = 1

    if ~Game
        for i = 1 to R - 2
            for j = 1 to C - 2
                if grid[j,i] = TAIL then grid[j,i] = 0xCC0020
            next
        next
        grab 0,0,C,R,grid[],2
        wait 1000000
        lives = lives - 1
        if lives = 0 then color 0,15 : at CX-7,CY,'G a m e  O v e r' : status() : inkey : goto intro
        goto start
    endif

    if TICK() - t > 50

        x = x + dx
        y = y + dy

        if (x < 0) then x = 0
        if (x > C - 1) then x = C - 1
        if (y < 0) then y = 0
        if (y > R - 1) then y = R - 1

        if grid[x,y] = TAIL
            Game = FALSE
        elseif grid[x,y] = 0
            grid[x,y] = TAIL
            m = 1
        endif

        t = TICK()

    endif

    for i = 0 to enemyCount - 1 : enemyMove(i) : next

    if grid[x,y] = OK and m

        dx = 0 : dy = 0 : m = 0 : n = 0

        for i = 0 to enemyCount - 1 : drop(x[i],y[i]) : next

        for i = 1 to R - 2
            for j = 1 to C - 2
                if grid[j,i] = -1 then grid[j,i] = 0 else grid[j,i] = OK : n = n + 1
            next
        next

        if n > 0 then perc = (n * 100) / CR : score = total + n : status()

    endif

    for i = 0 to enemyCount - 1
        if grid[x[i],y[i]] = TAIL then Game = FALSE : break
    next

    if ~Game then goto main

    grab 0,0,C,R,grid[],2

    color 14,14 : at x,y,' '

    if perc > 85 then enemyCount = enemyCount + 1 : goto start

    wait delay

    goto main

ρ



Τροποποίηση μια εικόνας ANSI που φορτώνει απευθείας από τον server.

    C = 16
    R = 12

    path$ = 'https://sites.google.com/site/hobbybasicfiles/pictures/SPACES1.ANS'

    screen 80,25
    color 0,0
    cls

    ansi path$

    block 0,3,C,R,700
    block C*2,3,C,R,701

    cls

    for x = 0 to 5
        block x*C,0,700
        block x*C,12,701
        repaint x*C,0,C,R,1,x+1
        repaint x*C,12,C,R,3,8-x
    next

    inkey
    end

Δημιουργία εκτελέσιμου αρχείου (.exe)

Για να δημιουργήσετε την εφαρμογή DRAW.EXE από το παράδειγμα DRAW.BAS

Πληκτρολογήστε στην γραμμή εντολών:

hb EXAMPLES/DRAW.BAS -bind DRAW.EXE

Η αυτόνομη εφαρμογή θα δημιουργηθεί μέσα στο φάκελο HB.

 

[Blue Max]

Η Hobby Basic δεν φιλοξενείται κάπου αλλού σε Ελληνική ιστοσελίδα. Εφόσον και αν δεν υπάρχει πρόβλημα με τους διαχειριστές και το φόρουμ γενικότερα, θα κάνω ποστ οτιδήποτε νέο την αφορά εδώ. Σχόλια ελεύθερα και ευπρόσδεκτα.

Λίγες περισσότερες πληροφορίες για την HB.

• 32-bit BASIC διερμηνευτής για Windows.
• Aναπτύσσεται στο notepad++ με τον fasm.
• Εύρος αριθμών −2147483647, +2147483647.
• 3 τύποι δεδομένων, αριθμοί, διατάξεις, συμβολοσειρές (strings).
• 2 τύποι διατάξεων, αριθμητικές και strings.
• 2 τύποι συναρτήσεων, built-in και user-defined.
• Προκαθορισμένες τιμές: FALSE,TRUE, EOL$, ST[]
• Σετ Τελεστών: =, <, >, <=, >=, <>, +, -, *, /, %, MOD, &, |, ^, <<, >>, AND, OR, NOT, ~
• Σετ εντολών BASIC (REM,PRINT,INPUT,GOTO,GOSUB,RETURN,IF...THEN...ELSE,DO...UNTIL,FOR...TO...{STEP}...NEXT,WHILE...ENDW,BREAK,DIM,END
• Σετ εντολών κονσόλας (CLS,AT,CURSOR,ERASE,INVERT,FLIP,GRAB,PAINT,REPAINT,MOVE,COPY,PASTE,WAIT,EXEC,TITLE,ALERT,RGBC,PEN,COLOR, LOCATE,VIEW,INKEY,MOUSE,INFO,SCREEN,BLOCK,STORE,RESTORE,LOAD,SAVE,CAT,RUN,ANSI)
• Σετ built-in συναρτήσεων (ABS,RND,KEY,TICK,SIZE,CELL,POW,BITS,ASC,LEN,VAL,COMP,CHDIR,FIND,SPLIT,BIN,CHR,HEX,STR,SPC,PATH,GETLN,BASE, LCASE,TRIM,UCASE,REVERSE,LEFT,RIGHT,MID,PAD,REPLACE,INSERT)
• Σετ συναρτήσεων δικτύου UDP (OPEN,CLOSE,SEND,QUEUE)
• Κυκλική στοίβα μεγέθους 262140 διπλών λέξεων (double words), εντολές PUSH,POP,ST[].
• Υποστήριξη (μερική) unicode χαρακτήρων στην κονσόλα.
• Δυνατότητα εκτέλεσης εντολής γραμμής εντολών.
• Δημιουργία αυτόνομου εκτελέσιμου αρχείου.
• Υποστήριξη ANSI γραφικών.

Υποστηρίζει Ελληνικά

Για Ελληνικά (μονοτονικά) στην κονσόλα, προϋπόθεση είναι η επιλογή της γραμματοσειρά Lucida Console.

    print 'Τη γλώσσα μου έδωσαν ελληνική'
    print 'το σπίτι φτωχικό στις αμμουδιές του Ομήρου.'
    print 'Μονάχη έγνοια η γλώσσα μου στις αμμουδιές του Ομήρου.'

Σχεδόν όλα μπορούν να γίνουν Ελληνικά στην Hobby Basic.

    τύπωσε fix print
    ανάποδα fix reverse

    dim Διάταξη$[3] = 'Παλιά','Περιοδικά','Πληροφορικής'

    for ΜΕΤΡΗΤΗΣ = 0 to 2
        τύπωσε ανάποδα(Διάταξη$[ΜΕΤΡΗΤΗΣ])
    next

Δημιουργεί αυτόνομο εκτελέσιμο

Ψευτο-εκτελέσιμο για την ακρίβεια. H Hobby Basic δένει (bind) τον διερμηνευτή με τον κώδικα και δημιουργεί αυτόνομη εκτελέσιμη εφαρμογή στα Windows. Αν το πρόγραμμα χρησιμοποιεί εξωτερικά αρχεία, π.χ εικόνες ANSI, αυτά θα πρέπει να συνοδεύουν την εφαρμογή. Το μέγεθος του τελικού αρχείου είναι μικρό, αφού πρόκειται για το μέγεθος του διερμηνευτή <50kb συν τα όποια kb του προγράμματος.

Στα συνοδευτικά παραδείγματα θα βρείτε το DRAW, ένα απλό πρόγραμμα ζωγραφικής για την κονσόλα. Φορτώνει και επεξεργάζεται εικόνες ANSI (.ans) και τις αποθηκεύει σε μορφή HB (.hb). Διαθέτει κάποιες στοιχειώδης δυνατότητες επεξεργασίας. Το εκτελέσιμο εδώ δημιουργήθηκε από την Hobby Basic ιδανικά για Windows XP/7. Download

 

[Always Somewhere]

Μας ενδιαφέρει πολύ! Συνέχισε να μας ενημερώνεις σε αυτό το thread!

Η hobby basic είναι σκέτη γλυκα!

 

[Blue Max]

Ευχαριστώ, νάσαι καλά. Πρόλαβα είδα το αρχικό μήνυμα. Θα σου πω απλά πως μπορείς να παίξεις λίγο μαζί της, και αργότερα αν θελήσεις να περάσεις σε ένα σοβαρό compiler. Δεν έχω σταματήσει να ασχολούμαι με BASIC, και σήμερα υπάρχουν εξαιρετικά εργαλεία.

Μου έστειλαν δύο προγράμματα (pong και snake) παιδιά από Ελλάδα. Περιττό να σου πω πόσο χάρηκα, δεν το περίμενα. Γενικά, μπορεί να είναι ένας απλοικός toy διερμηνευτής -ουσιαστικά χωρίς γραφικά- όμως είναι εύκολο να δημιουργήσεις ένα text adventrue. Αυτόν τον σκοπό είχα όταν ξεκίνησα να την γράφω. Έγραψα στην HB ένα "οικογενειακό" text adventrue με ANSI γραφικά και τα παιδιά μου γέλασαν πολύ.

Λίγες περισσότερες πληροφορίες για την HB, συνέχεια...

Για να σώσουμε μια οθόνη 80x25.

    dim a[80,25]              ! define array 80x25
    grab 0,0,80,25,a[],0      ! screen to array
    save 'screen.hb',a[]      ! save screen in .HB format

Για να φορτώσουμε μια οθόνη 80x25.

    dim a[80,25]              ! define array 80x25
    load 'screen.hb',a[]      ! load a saved .HB screen
    grab 0,0,80,25,a[],1      ! array to screen

Ένα απλό παράδειγμα.

Δανείζομαι μια ANSI εικόνα από την συλλογή eansis. Μια απλή εικόνα, ένα δέντρο μου κάνει. Την ανοίγω με το DRAW (το σχεδιαστικό που είναι γραμμένο στην HB) και την καθαρίζω λίγο. Κρατώ μόνο το δέντρο, την ταμπέλα, και την αποθηκεύω, εν συνεχεία...

screen 80,25,300
cursor 1,100
color 0,0
cls

dim a[80,25]

load 'RETRO80x25.HB',a[]
grab 0,0,80,25,a[],1

pen 6
at 2,4,'Καθώς η ομίχλη φεύγει,'
at 2,5,'η εικόνα ενός δάσους σχηματίζεται μπροστά σου...'
at 2,7,'Μπορείς να πας ανατολικά, προς το δάσος...'

locate 2,22
input '>',a$

Η συνέχεια επί της οθόνης....(όπως έλεγε o Αντρέας)

 

[Always Somewhere]

Χθες κατέβασα να δοκιμάσω στο smartphone τον puffin browser και έχει ένα θέμα με τα φόρουμ όταν γράφεις ποστ. Αντί να γράφει γράμματα τα σβήνει και κάνοντας επεξεργασία έχασα το σχόλιο μου.

Παρόλο που είναι καλός browser τον έχουν παρατήσει και δεν το έχουν διορθώσει ακόμα. Anyway..

Ήθελα να κάνω edit ξανά το σχόλιο μου για να γράψω ότι στα σχολεία του εξωτερικό (στην δευτέρα γυμνασίου) χρησιμοποιούν την QB64 για να μαθαίνουν τα παιδιά προγραμματισμό.

 

[Blue Max]

Η QB64 είναι σύγχρονος compiler και νομίζω συμβατή προς τα πίσω με την QBASIC της Microsoft (χωρίς να σχετίζεται με την MS). Δεν μου κάνει εντύπωση αν χρησιμοποιείται σε σχολεία και σήμερα παρά την εξέλιξη και την τάση σε πιο σύγχρονες γλώσσες προγραμματισμού python, java, κτλ

 

[Blue Max]

Για κάποιο λόγο ο server του google μπλοκάρει το κατέβασμα της Hobby Basic. Έχει ξανασυμβεί και πρόκειται μάλλον για περίπτωση false positive, ίσως να θεωρεί πως περιέχει ύποπτο αρχείο, πράγμα που φυσικά δεν συμβαίνει. Όπως και να έχει εδώ είναι η έκδοση 1.0.9.

 

[Blue Max]

Η Hobby Basic δεν έχει deadline και την αναβαθμίζω περιστασιακά. Έφτασε αισίως στην έκδοση 1.1.0. Ο διερμηνευτής ξεπέρασε τις 10000 γραμμές assembly κώδικα. Η Hobby Basic σιγά σιγά προσανατολίζεται στις νεώτερες εκδόσεις των Windows από τα Vista και πάνω. Τρέχει ιδανικά σε Windows 7. Συνεχίζει να είναι απόλυτα λειτουργική με τα Windows XP.

Hobby Basic Version 1.1.0 - Download

Έγιναν αλλαγές στον πηγαίο κώδικα και στα συνοδευτικά προγράμματα. Το manual εμπλουτίστηκε με λίγες παραπάνω πληροφορίες. Οι αλλαγές στον κώδικα αφορούν κυρίως την έξοδο του διερμηνευτή ώστε αυτή να γίνει όσο το δυνατόν ομαλότερη και οι αρχικές ρυθμίσεις της κονσόλας του χρήστη να επανέλθουν στην αρχική τους μορφή.

Παρακάτω μερικά μικρά παραδείγματα.

Invert στο μισό παράθυρο (80x26)

        cls
        screen 80,26,300
        at 33,13,'Normal  Invert'
        invert 40,0,40,26
        inkey

Invert στο μισό παράθυρο (για όλες τις διαστάσεις)

        cls
        screen -1,-1        ! get window cols rows in V0 V1
        at V0/2-7,V1/2,'Normal  Invert'
        invert V0/2,0,V0/2,V1
        inkey

Παράδειγμα της εντολής REPAINT. Το lightred 12 γίνεται lightpurple 13 στο μισό παράθυρο.
Για να δείτε τα χρώματα της κονσόλας γράψτε στην γραμμή εντολών: color /t

        cls
        screen 80,25
        ansi 'ART\APPLE.ANS'
        repaint 0,0,40,25,12,13
        inkey : cls

Flip screen horizontally.

        cls
        exec 'dir',a$
        screen -1,-1
        if V0 < 80 then screen 80,25
        ? a$
        flip 0,0,V0,V1,0
        inkey

Παράδειγμα της εντολής GETHTML.
Τυπώνει στην κονσόλα τον αριθμό των online μελών του retromaniax (από Vista και πάνω).

        source$ = GETHTML('https://retromaniax.gr/')
        start = FIND(source$,'block-footer-counter')
        if start = 0 then ? 'start failed' : end
        start = start + 22
        stop = FIND(source$,'</span>',start)
        if stop = 0 then ? 'stop failed' : end
        len = stop - start
        for n = 0 to len - 1 : a$ = a$ + source$(start+n) : next
        a$ = replace(a$,'&nbsp; ','')
        ?:? 'Μέλη online' : ? a$
        end

Dialog Boxes που υποστηρίζει η Hobby Basic.

       ! PATH('open')              open dialog box
       ! PATH('save')              save dialog box
       ! PATH('folder')            select folder dialog

        folder_path$ = PATH('folder')

Ο διερμηνευτής μπορεί από την γραμμή εντολών να φορτώσει ένα πρόγραμμα που βρίσκεται σε κάποιον server.
Δοκιμάστε το, ανοίξτε την γραμμή εντολών στον φάκελο της HB και κάντε copy-paste:

        HB.exe https://sites.google.com/site/hobbybasicfiles/TEST.BAS

Αλλάζοντας κάποια από τα χρώματα της κονσόλας με την εντολή RGBC (από Vista και πάνω).

        sub RGB(r,g,b)
            rets (b<<16)|(g<<8)|r
        ends

        screen -1,-1
        if V0 < 80 then screen 80,25
        c = V0/4
        r = V1/4
        len = c * r

        rgbc 1,RGB(68,36,52)
        rgbc 2,RGB(48,52,109)
        rgbc 3,RGB(218,212,94)
        rgbc 4,RGB(109,170,44)

        for n = 0 to len + c
            x = n % c
            y = n / c
            color (x+y)/4,0
            paint x*4,y*4,4,4,' ',1
        next

        inkey : cls : end

 

[Blue Max]

Για κάποιο λόγο ο server του google μπλοκάρει το κατέβασμα της Hobby Basic. Έχει ξανασυμβεί και πρόκειται μάλλον για περίπτωση false positive, ίσως να θεωρεί πως περιέχει ύποπτο αρχείο, πράγμα που φυσικά δεν συμβαίνει.

Το πρόβλημα δείχνει να αποκαταστάθηκε και το download link στο πρώτο ποστ δουλεύει ξανά.

 

[Blue Max]

Περισσότερα για τα χρώματα και τα κελιά.

Πρώτα κάποιες πληροφορίες για τα χρώματα της κονσόλας.
Η κονσόλα έχει 16 χρώματα φόντου και 16 χρώματα κειμένου.

Τυπώνουμε τα 16 χρώματα. Το χρώμα κειμένου 0 μαύρο δεν φαίνεται σε μαύρο φόντο.

    screen 80,25,300
    color 0,0
    cls

    for n=0 to 15
        pen n
        ? 'Text Color ',n
    next

    inkey
    end

Οι πιθανοί χρωματικοί συνδυασμοί στην κονσόλα είναι 256 (16x16).

    screen 80,25,300
    color 0,0
    cls

    y=21

    for n=0 to 255
        x=(n/16)*4+8
        color n/16,n%16
        a$=PAD(STR(n),'0',3)
        at x,y,a$
        color 0,0
        move x,y-15,4,16,x,y-16
        wait 10000
    next

    inkey
    end

• Ένα τυπικό παράθυρο κονσόλας με διαστάσεις 80x25 περιέχει 2000 κελιά.
• Η Hobby Basic δεσμεύει 1 διπλή λέξη των 32-bit (dword) για κάθε κελί.
• Το πρώτο byte μένει κενό. Κράτησα τον χώρο αυτό ηθελημένα αχρησιμοποίητο.
• Το δεύτερο byte περιέχει τα χρώματα χωρισμένα στο χαμηλό και υψηλό nibble.
• Δηλαδή 4-bit για το χρώμα του φόντου και 4-bit για το χρώμα του κείμενου.
• Η Hobby Basic δεσμεύει τα 2 εναπομείναντα byte (16-bit) για τον χαρακτήρα.
• Με αυτόν τον τρόπο μπορεί να υποστηρίξει wide χαρακτήρες όπως τα Ελληνικά.

Ας δούμε ένα παράδειγμα.

Χρώμα φόντου ανοιχτό κόκκινο 12 (0xC) (1100b)
Χρώμα κειμένου ανοιχτό κίτρινο 14 (0xE) (1110b)
Βάζουμε το γράμμα A (ASCII 65) (0x41) (1000001b) στο κελί 1,1.
Η εντολή GRAB αντιγράφει την οθόνη σε μια 2D διάταξη (και αντίστροφα).

    dim a[80,25]

    screen 80,10,300
    color 0,0
    cls

    color 12,14
    at 1,1,'A'

    grab 0,0,80,25,a[],0

    title 'Cell(1,1)=',a[1,1]

    inkey
    end

Το κελί 1,1 δίνει τιμή 13500481 που αναλύεται ως εξής:



Έτσι βλέπει η Hobby Basic τα κελιά στην κονσόλα.
Ελπίζω να βρήκατε αυτές τις πληροφορίες ενδιαφέρουσες.

 

[Blue Max]

Hobby Basic 1.1.1

Ένα μικρό update που ανεβάζει τον αριθμό της έκδοσης σε 1.1.1.
Η εντολή PRINT AT μπορεί να εμφανίσει κείμενο διατηρώντας ταυτόχρονα το χρώμα φόντου των κενών κελιών.

    screen 80,25 : cls

    for x = 0 to 7
        color x,0
        paint x*10,0,10,25,0x20,1
    next

    for x = 1 to 15
        pen x
        print at x,x,'Hobby Basic'
    next

    inkey : end

 

[Blue Max]

Εφόσον δεν υπάρχει η δυνατότητα να διορθώσω προηγούμενα post, παλαιότερα παραδείγματα ίσως να μην τρέξουν σε μεταγενέστερες εκδόσεις του διερμηνευτή.

Hobby Basic 1.1.2

Προστέθηκε η εντολή SOUND και η συνάρτηση GEN().

Η εντολή SOUND.
Η πρώτη σύνταξη φορτώνει ένα αρχείο wav στην μνήμη και του αναθέτει ένα αναγνωριστικό id.
Η δεύτερη παίζει το αρχείο (η παράμετρος flags είναι προαιρετική).

sound {path$,snd_id} --> V0
sound {[flags],snd_id} --> V0

    LASER=700
    path$='DATA\LASER.WAV'

    sound path$,LASER          ! load sound
    sound LASER                ! play sound

Η συνάρτηση GEN() επιστρέφει ένα string μήκους n, που αποτελείται από τυχαίους χαρακτήρες του string$.
Το παράδειγμα τυπώνει 10 τυχαία password των 16 χαρακτήρων το καθένα.

GEN(string$,n) --> string

    s1$ = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
    s2$ = '0123456789'
    s3$ = '!@#$%^&*()'

    s$ = s1$ + s2$ + s3$

    for x=1 to 10
        ? GEN(s$,16)
    next

Σε προηγούμενο post έγραψα για την δυνατότητα της HB να φορτώσει από την γραμμή εντολών ένα πρόγραμμα που βρίσκεται σε κάποιον server. Αυτό μπορεί να γίνει και μέσα από τον κώδικα.

    url$ = 'https://sites.google.com/site/hobbybasicfiles/TEST.BAS'

    load url$,1
    if V0 = -1 then ? 'load error' : end
    run 'TEST.BAS'

η απλά

    run url$

πάρε τον κώδικα

    a$ = GETSRC(url$)

Φορτώνει ένα απομακρυσμένο αρχείο ANSI (αντικατάσταση του TEST.BAS με APPLE.ANS στο url$).

    if SIZE(url$)=-1 then ? 'URL failed' : end

    screen -1,-1
    if V0<>80 then screen 80,25,300
    cls
    ansi url$
    pause
    cls
    end

 

[Blue Max]

Ένα παιχνίδι φιδάκι για την κονσόλα που μου έστειλε ανώνυμα ένας φίλος από Ελλάδα πριν αρκετό καιρό.

Έκανα ένα καλό ρετούς στον κώδικα εκμεταλευόμενος κάποιες νέες δυνατότητες του διερμηνευτή. Πρόσθεσα χρώματα (ήταν ασπρόμαυρο), best score, φόντο, το έκανα να μην τρακάρει στις άκρες αλλά να βγαίνει στην απέναντι πλευρά (μου αρέσει καλύτερα έτσι). Ωστόσο, οι βασικές ρουτίνες του παιχνιδιού παραμένουν λίγο πολύ ίδιες με την αρχική έκδοση. Το στιγμιότυπo είναι από Windows XP.

SNAKE.BAS

 

[Rygar]

Οταν ήμουν 14 ετών και επιασα πρώτη φορά τη locomotive basic του Μπάσταρντ μου (μιλάμε για καλοκαίρι του 88), το gosub το'λεγα "Γκόσουμπ". Μεγαλώνοντας λίγο συνειδητοποίησα ότι ο ποιητής ήθελε να πει Go(to)Sub. Αυτό θυμήθηκα όταν είδα τις gosub στον κώδικά σου.

 

[Blue Max]

Χε χε, πιστεύω δεν είσαι μόνος. Η Γκόσουμπ πρέπει να καταχωρηθεί στο SLANG.

 

[Rygar]

Η Γκόσουμπ και η Γκότο

 

[Blue Max]

Έψαχα την PSET στο manual να το κάνω πιο όμορφο αλλά ναι, κατανοητό γιατί δεν υπάρχει υλοποίηση σε windows cmd

Μου έδωσες μια καλή πάσα για να δώσω μια εσωτερική εικόνα λειτουργίας της Hobby Basic που είναι ένας απλοϊκός tokenizer διερμηνευτής.

Κοίτα να δεις τώρα, μπορείς να σχεδιάσεις στο παράθυρο της κονσόλας με το gdi των Windows έχοντας πάρει το hdc του. Πες πως θέλω να προσθέσω μια νέα εντολή, ας πούμε την PIXEL.

pixel {x,y,color}

Κάνω μια νέα καταχώρηση στην λίστα των εντολών.






Και μετά στο block που εκτελεί τις εντολές της κονσόλας.




Η ρουτίνα exec_pixel σε 32-bit assembly. Καλεί τον parser για να πάρει τις x,y τιμές και το χρώμα (0x00bbggrr). Στην συνέχεια καλεί την SetPixel του gdi των Windows.

proc exec_pixel uses eax ecx edx

    local x dd ?
    local y dd ?
    local crColor dd ?

    stdcall int_expr, addr x
    stdcall want, COMMA
    stdcall int_expr, addr y
    stdcall want, COMMA
    stdcall int_expr, addr crColor
    mov eax, [crColor]
    test eax, eax
    jl @f
    invoke SetPixel, [hDC], [x], [y], eax
    @@:
    ret
endp

Έτοιμο. Ας δοκιμάσουμε την νέα εντολή PIXEL στην κονσόλα με ένα gradient εφέ. Κώδικας Hobby Basic.

    color 0,7 : cls
    at 2,2,'GDI Graphics in console Window'

    for x = 0 to 200
        for y = 50 to 150
            c = (y<<16)|x
            PIXEL x,y,c
        next
    next

    inkey : end

Ο τρόπος αυτός σχεδιάζει απευθείας στο παράθυρο. Όμως θα χρειαζόταν διαφορετική προσέγγιση αν όντως ήθελα να προσθέσω gdi γραφικά στην κονσόλα. Παραδείγματος χάρη, αν αυτό το παράθυρο γίνει minimize τα gdi γραφικά χάνονται. Αυτό συμβαίνει γιατί αγνόησα τους μηχανισμούς γραφικών που διαθέτει ένα κανονικό παράθυρο. Πάντως είναι εφικτό και υπάρχουν λύσεις. Βλέπουμε.