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

[Blue Max]

Το coffee project της ημέρας.
Ένα απλό Hex Viewer γραμμένο στην Hobby Basic.

view 11:screen 80,30,3000:color 0,7:cls
m=0FFFFFh:dim a[m]:p$=TRIM(0,PATH('open'))
if LEN(p$)<1 then end else load p$,a[]:r=V0
if r<1 then ?r:end else p=0:e=r/4:title p$:a$=''
@@#b$='':a$=PAD(HEX(p*4),'0',8)+':  '
for i=0 to 3
    for j=0 to 3
        n=(a[p]>>(j*8))&0FFh
        a$=a$+PAD(HEX(n),'0',2)+' '
        if n<32 or n>126 then n='.'
        b$=b$+CHR(n)
    next
    p=p+1
next
a$=UCASE(a$)+b$:?a$
if p>e then ?'length: ',p*4:pause:end else goto @b

 

[Blue Max]

To coffee project της ημέρας.
Particles ο στο παράθυρο της κονσόλας που όταν συγκρούονται μεταξύ τους αλλάζουν κατεύθυνση. διασχίζουν το μπλε, συγκρούονται και αλλάζουν κατεύθυνση στο λευκό τετράγωνο και στο κείμενο.

CELL.BAS

 

[Blue Max]

To coffee project της ημέρας.
Ζωντανεύοντας μια εικόνα ANSI με λίγες γραμμές Hobby Basic.
Χειρισμός με τα βελάκια πληκτρολογίου και το Enter.
Η αρχική εικόνα απεικονίζει ένα μενού 1

    view 11:screen 80,25,300:cursor 0,0:color 0,7:cls
    menu_delete fix  pen 3:erase x+2,y*2+z,LEN(a$[y]),-1,1:at x,y*2+z,' ':at x+LEN(a$[y])+3,y*2+z,' '
    menu_select fix  pen 15:erase x+2,y*2+z,LEN(a$[y]),-1,1:pen 14:at x,y*2+z,'>':at x+LEN(a$[y])+3,y*2+z,'<'
    x=34:y=0:z=11:dim a$[5]='Menu-Setup','File-Setup','About','Help','Exit'
    ansi 'https://16colo.rs/pack/roy-stuf/raw/ROY-DC1.ANS'
    A# inkey
    if V2=38
        menu_delete
        if y>0 then y=y-1
        menu_select
    elseif V2=40
        menu_delete
        if y<4 then y=y+1
        menu_select
    elseif V0=13
        if y=4 then end else alert a$[y]
    endif
    goto A

 

[Blue Max]

Το coffee project της ημέρας.
Υπερσύνδεσμος-link στο παράθυρο της κονσόλας!

    view 11 : screen 80,25 : color 0,7 :cls
    url$ = 'https://retromaniax.gr/'
    url.x = 2 : url.y = 4 : url.h = 0 : url.len = LEN(url$) : tmp$ = PATH(9)
    at url.x,url.y-2,'Κάντε κλικ στον σύνδεσμο':at url.x,url.y,url$
    do
        wait 1 : mouse : x = V0 : y = V1 : btn = V2
        if (y = url.y and x > url.x and x <= (url.x+url.len))
            if ~url.h then url.h = 1: pen 14 : at url.x,url.y,url$ : title 'Open: '+url$
        elseif url.h
            url.h = 0 : pen 7 : at url.x,url.y,url$ :title tmp$
        endif
        if (btn = 1 and url.h) then cmd$ = 'start chrome '+url$ : exec cmd$
    until KEY(27)
    end

 

[Blue Max]

To coffee project της ημέρας.
Ένα ANSI αυτοκινητάκι που κινείται και αλλάζει κατεύθυνση με τα βελάκια πληκτρολογίου στο παράθυρο της κονσόλας.
Στο zip θα βρείτε το γραφικό, ρίχτε το στον φάκελο ART της Hobby Basic.

    path$=PATH('ART\CAR.ANS')
    w=80:h=25:c=32:r=7:x=2:y=h-r
    screen w,h,300:cursor 0,0:color 0,0:cls
    ansi path$:copy 0,0,c,r:color 0,0:cls:paste x,y
    do:wait 10
        if (KEY(37) and x>0)
            if ~v then v=1:flip x,y,c,r,0
            move x,y,c,r,x-2,y:x=x-2
        elseif (KEY(39) and x<(w-c))
            if v=1 then v=0:flip x,y,c,r,0
            move x,y,c,r,x+2,y:x=x+2
        endif
    until KEY(27)
    cls:end

 

[Blue Max]

To coffe project της ημέρας.
Το αυτοκινητάκι αλλάζει κατεύθυνση αλλά δεν μετακινείται.
Μετακινείται όμως το ANSI φόντο δίνοντας έτσι την αίσθηση της κίνησης στο παράθυρο της κονσόλας.
Στο zip θα βρείτε τα γραφικά, ρίξτε τα στον φάκελο ART της Hobby Basic.

    car$=PATH('ART\CAR.ANS')
    night$=PATH('ART\NIGHT.ANS')
    w=80:h=30:c=32:r=7:x=(w/2)-16:y=h-r
    screen w,h,300:cursor 0,0:color 0,0:cls
    ansi car$:copy 0,0,c,r:color 0,0
    cls:ansi night$:paste x,y
    do:wait 5
        if (KEY(37) and x>0)
            if ~v then v=1:flip x,y,c,r,0
            store w-1,0,1,h-r
            move 0,0,w-1,h-r,1,0
            restore 0,0
        elseif (KEY(39) and x<(w-c))
            if v=1 then v=0:flip x,y,c,r,0
            store 0,0,1,h-r
            move 1,0,w-1,h-r,0,0
            restore w-1,0
        endif
    until KEY(27)
    cls:end

 

[Blue Max]

Το coffee project της ημέρας.
H Βασίλισσα από τον Φοίνικα κυνηγάει το ποντίκι.



Το zip περιέχει το Text Draw (DRAW.BAS), το σχεδιαστικό πρόγραμμα κονσόλας γραμμένο με την Hobby Basic.
Περιέχει επίσης το ANSI γραφικό (LUCIANO.ANS) από Blocktronics group με παλιά arcade παιχνίδια. 1

Ρίχνουμε το DRAW.BAS στον φάκελο EXAMPLES και το LUCIANO.ANS στον φάκελο ART της Hobby Basic.

Ανοίγουμε το Text Draw με την Hobby Basic.
Φορτώνουμε LOAD το γραφικό (μπορεί να καθυστερήσει λιγάκι γιατί φορτώνει 41 frames).





Με τα βέλη πληκτρολογίου πηγαίνουμε στον Φοίνικα (frame 16).




Πατάμε F10 και γίνεται export το frame στο αρχείο LUCIANO.BAS στον φάκελο EXAMPLES.




Τελειώσαμε με το Text Draw, το κλείνουμε.
Ανοίγουμε με το notepad το LUCIANO.BAS και κάτω από την γραμμή της grab προσθέτουμε

    x=34
    y=20
    copy x,y,13,5
    cls
    paste x,y

    while ~KEY(27)
        mouse
        if (V0<1 or V1<1) then goto A
        x1=x:y1=y:a=x+6:b=y+1
        if (a<V0 and a<72) then x=x+1
        if (a>V0 and a>7) then x=x-1
        if (b<V1 and b<45) then y=y+1
        if (b>V1 and b>2) then y=y-1
        move x1,y1,13,5,x,y
        A# wait 50
    endw
    end

Tρέχουμε τον κώδικα με την Hobby Basic.
H Βασίλισσα κινείται και κυνηγάει το ποντίκι στο παράθυρο της κονσόλας.

 

[Always Somewhere]

Ωραίος!!!

 

[Blue Max]

Ένα μικρό διάλειμα από την Hobby Basic για να παρουσιάσω κάποια παλιότερα project.
Αφορούν διερμηνευτές ως επί το πλείστον, οπότε δεν ανοίγω καινούργιο topic.
Ξεκινάω με το Little Man Computer ένα μοντέλο ενός υποθετικού υπολογιστή.

Το Little Man Computer (LMC) είναι ένα εκπαιδευτικό μοντέλο ενός υπολογιστή, που δημιουργήθηκε από τον Dr. Stuart Madnick το 1965.
Στο zip θα βρείτε έναν μεταγλωτιστή της συμβολικής γλώσσας του LMC που έχω γράψει πριν αρκετά χρόνια σε x86 assembly.
Το project έμεινε για πάντα στην έκδοση 0.1 γιατί έχασα τον πηγαίο κώδικα μου, ξενέρωσα και δεν το άρχισα ποτέ από την αρχή.
Τρέχει από την γραμμή εντολών των Windows.

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

     INP
     OUT      // Initialize output
LOOP BRZ QUIT // Label this memory address as LOOP. If the accumulator value is 0, jump to the memory address labeled QUIT
     SUB ONE  // Subtract the value stored at address ONE from the accumulator
     OUT
     BRA LOOP // Jump (unconditionally) to the memory address labeled LOOP
QUIT HLT      // Label this memory address as QUIT
ONE  DAT 1    // Store the value 1 in this memory address, and label it ONE (variable declaration)

H έξοδος του προγράμματος (Windows 10).



Υπάρχει άφθονο υλικό για το Little Man Computer στο διαδίκτυο.
https://en.wikipedia.org/wiki/Little_man_computer
https://www.101computing.net/LMC/
YouTube

 

[Blue Max]

Το post αυτό αφορά την μετατροπή που έκανα στον πηγαίο κώδικα της MiniBasic.
Η MiniBasic είναι γραμμένη από τον Sylvain Bizoirre το 2001 σε x86 assembly 32 bit σύνταξη masm32. Τρέχει σε Windows.
Κάθησα (πριν αρκετά χρόνια) και τροποποίησα την σύνταξη για τον fasm. Κάνει compile & run με ένα κλικ μέσα από το fasmw ide.
Είναι ένας απλοϊκός διερμηνευτής με εκπαιδευτική όμως αξία για όσους ασχολούνται με x86 assembly.
Η αρχική έκδοση έχει αρκετά μικρά ide bugs που συνεχίζουν και στην fasm έκδοση.
Δεν έγινε προσπάθεια διόρθωσης τους, άλλωστε δεν ήταν αυτός ο σκοπός μου.
Το zip περιέχει και τις 2 εκδόσεις, την masm32 και την fasm.

Η πρώτη οθόνη.



Ας γράψουμε ένα καταπληκτικό πρόγραμμα.



Η έξοδος του καταπληκτικού προγράμματος.

 

[Blue Max]

Hobby Basic 1.3.8

Ένα νέο update στον διερμηνευτή.

Μέχρι χθες η Hobby Basic μπορούσε να συγκρίνει συμβολοσειρές (strings) με την βοήθεια της συνάρτησης COMP() όπως στο παρακάτω παράδειγμα.

    a$ = 'BASIC'
    b$ = 'basic'
    if COMP(a$,b$) = 1 then ? 'strings are equal'

Πλέον, η σύγκριση μεταξύ συμβολοσειρών μπορεί να γίνει με τον κλασικό τρόπο της BASIC.

    a$ = 'BASIC'
    b$ = 'basic'
    if a$ = b$ then ? 'strings are equal'

Σύγκριση συμβολοσειρών στην έκδοση 1.3.8

    color 0,7
    cls
    input "Enter string1: ",a$
    input "Enter string2: ",b$
    if a$ = b$ then print "the strings are equal"  rem test for equality
    if a$ <> b$ then print "the strings are not equal"  rem test for inequality
    if a$ > b$ then print a$," is lexically higher than ",b$  rem test for lexically higher
    if a$ < b$ then print a$," is lexically lower than ",b$  rem test for lexically lower
    if a$ <= b$ then print a$," is not lexically higher than ",b$
    if a$ >= b$ then print a$," is not lexically lower than ",b$
    pause

 

[Blue Max]

Το Πάσχα έκλεψα λίγο χρόνο και πρόσθεσα μια νέα εντολή στην Hobby BASIC την TIMES.
Βρίσκεται σε δοκιμαστική φάση, χωρίς να έχω αποφασίσει 100% την οριστική της μορφή.
Είναι σαν ένας βρόγχος For...Next αλλά για single-line.
Η σύνταξη είναι TIMES n <commands>

Λίγα παραδείγματα.

    times 10  ? 'Hello'

Η times χρησιμοποιεί την μεταβλητή V3 για μετρητή. Η αρίθμηση ξεκινάει από το 0.

    times 10 ? 'Counting ',V3

    a$ = 'Hobby BASIC'
    times 10 ? at V3,V3,a$
    times 11 ? at 10-V3,V3+10,a$

    view 11
    screen 80,25,300:cls
    times 140 x=V3%20:y=V3/20:color (x+y)/4,0:paint x*4,y*4,4,4,-1,-1
    times 15 pen V3:?at V3,V3,"Hello World!"
    inkey:end

Το πρόγραμμα φορτώνει στην κονσόλα μια online ANSI 80x25 εικόνα και την ανακατεύει (shuffle).

    ! Ctrl-C to exit
    bx fix (V3%4)*20
    by fix (V3/4)*6
    dim b[16]
    view 11
    screen 80,25,300
    color 0,0
    cls
    ansi 'https://16colo.rs/pack/ansipics/raw/ANARCHY.ANS'
    times 16 bsave bx,by,20,6,V3
    times 1000 b[].set 0 : b[].shuffle : wait 30 : times 16 bload bx,by,b[V3]      ! nested times

 

[Blue Max]

Το coffee project της ημέρας.
Χρωματιστά τουβλάκια αναπηδάνε στο παράθυρο της κονσόλας.

    view 11
    screen 80,25,300
    cursor 0,0:cls
    a$ = 'Hello World!'
    dim a[80,25], b[80,25]
    dim x[6] = 15,25,35,45,55,65
    dim y[6] = 2,16,12,8,6,2
    dim v[6] = 1,-1,-1,-1,-1,-1
    times 8 color V3,0:paint V3*10,0,10,25,-1,-1
    store 0,0,80,25
    times 6 flip 15+V3*10,0,10,25,0
    times 15 pen V3+1:? at V3+1,V3+1,a$
    grab 0,0,80,25,b[],0
    restore
    times 15 pen V3+1:? at V3+1,V3+1,a$
    grab 0,0,80,25,a[],0
    loop#
    for i = 0 to 5
        grab x[i],y[i],10,6,a[],x[i],y[i]
        grab x[i],y[i]+v[i],10,6,b[],x[i],y[i]+v[i]
        y[i] = y[i]+v[i] : if (y[i]<1 or y[i]>18) then v[i] = -v[i]
    next
    if ~KEY(27) then wait 30:goto loop else cls:end

 

[Blue Max]

Το coffee project της ημέρας.
Ένας απλοϊκός Brainfuck interpreter γραμμένος στην Hobby BASIC, μεταφορά ενός C script.

    rem  Simple Brainfuck Interpreter in Hobby BASIC

    ARRAYSIZE = 16777216
    MAXCODESIZE = 65536

    path$ = TRIM(0, PATH('open'))
    if ~LEN(path$) then end

    load path$, code$
    if V0 = -1 then ? 'Can''t open file' : end

    code$ = REPLACE(code$,CHR(13),'')
    code$ = REPLACE(code$,CHR(10),'')
    code$ = REPLACE(code$,CHR(32),'')
    codelength = LEN(code$)
    memp = ARRAYSIZE/2
    stackp = 0

    dim array[ARRAYSIZE]
    dim stack[MAXCODESIZE]
    dim code[MAXCODESIZE]
    dim targets[MAXCODESIZE]

    for codep = 0 to codelength-1
        code[codep] = ASC(code$(codep))
    next

    for codep = 0 to codelength-1
        if code[codep] = '[' then stack[stackp] = codep : stackp = stackp + 1
        if code[codep] = ']'
            if stackp = 0
                ? 'Unmatched '']'' at byte ', codep : end
            else
                stackp = stackp - 1
                targets[codep] = stack[stackp]
                targets[stack[stackp]] = codep
            endif
        endif
    next

    if stackp > 0
        stackp--
        ? 'Unmatched ''['' at byte ', stack[stackp] : end
    endif

    for codep = 0 to codelength-1
        select code[codep]
            case '+' : array[memp] = (array[memp]+1) & 255
            case '-' : array[memp] = (array[memp]-1) & 255
            case '<' : memp = memp - 1
            case '>' : memp = memp + 1
            case ',' :
                inkey
                ? CHR(V0) ,
                if V0 = 13 then V0 = 10
                array[memp] = V0
            case '.' : if array[memp] <> 10 then ? CHR(array[memp]),  else ?
            case '[' : if ~array[memp] then codep = targets[codep]
            case ']' : if array[memp] then codep = targets[codep]
        endsel
    next
    end

Τρέχοντας το Hello World! από την Wikipedia.

++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.

 

[Blue Max]

Το coffee project της ημέρας.
Πρόκειται για έναν επίσης απλοϊκό Brainfuck interpreter που έχω γράψει πριν αρκετά χρόνια σε 16 bit assembly. Έχει 60000 κελιά των 8 bit με αρχικό δείκτη στην μέση, για να τρέχει script σε οποιαδήποτε κατεύθυνση. Compile με τον fasm δημιουργεί αρχείο .com που θα τρέξει μόνο σε πραγματικό DOS ή DOSBox.

    org 100h
    mov di, array
    push di
    mov cx, 30000
    xor ax, ax
    cld
    rep stosw
    pop di
    add di, 30000
    mov si, code
    sub si, 1
A:  add si, 1
    cmp byte [si], 0
    je Q
    cmp byte [si], '>'
    jne B
    add di, 1
    jmp A
B:  cmp byte [si], '<'
    jne C
    sub di, 1
    jmp A
    C: cmp byte [si], '+'
    jne D
    add byte [di], 1
    jmp A
D:  cmp byte [si], '-'
    jne E
    sub byte [di], 1
    jmp A
E:  cmp byte [si], '.'
    jne F
    mov dl,[di]
    mov ah, 2
    int 21h
    cmp dl, 10
    jne F
    mov dl, 13
    int 21h
    jmp A
F:  cmp byte [si], ','
    jne H
    mov ah, 1
    int 21h
    cmp al, 13
    jne G
    mov al, 10
G:  mov [di], al
    jmp A
H:  cmp byte [si], ']'
    jne I
    pop si
    sub si, 1
    jmp A
I:  cmp byte [si], '['
    jne A
    push si
    cmp byte [di], 0
    jne A
    pop si
    xor cx, cx
J:  cmp byte [si], '['
    jne K
    add cx, 1
    jmp L
K:  cmp byte [si], ']'
    jne L
    sub cx, 1
L:  test cx, cx
    jz A
    add si, 1
    jmp J
Q:  int 20h

    code:
    db '++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.',0

    array db 60000 dup ?

Τρέχοντας το Hello World! στο DOSBox.

 

[Blue Max]

Το post αυτό αφορά την μετατροπή που έκανα στον πηγαίο κώδικα της MBASIC.
Η MBASIC είναι γραμμένη από τον Andrey Tamelo το 2001 σε x86 assembly 16 bit σύνταξη TASM.
Απαιτεί επεξεργαστή 80386 ή μεγαλύτερο, DOS 3.0 ή παραπάνω, ή το DOSBox. Το εκτελέσιμο της είναι .com αρχείο.
Πριν αρκετά χρόνια τροποποίησα την MBASIC για τον fasm. Κάνει compile & run με ένα κλικ μέσα από το fasmw ide.
Είναι ένας πολύ απλοϊκός διερμηνευτής με εκπαιδευτική όμως αξία για όσους ασχολούνται με x86 assembly στα 16 bit.

Το παράδειγμα παρουσιάζει όλες τις εντολές της MBASIC.

cls
start:
x=0
input "enter a number: ",i
print i
if i<10 then end
beep
gosub subr1
goto start

subr1:
for t=1 to i
x=x+1
gosub subr2
next
return

subr2: print "x=";x
return

Η έξοδος του προγράμματος στο DOSBox.

 

[Blue Max]

Hobby BASIC 1.4.0

Το update αφορά ένα bug-fix στην εντολή break.
Το πρόγραμμα "Guess The Secret Word" τεστάρει το fix, ενώ παράλληλα δοκιμάζει τον τελεστή σύγκρισης = σε wide συμβολοσειρές.
Φορτώνει μια λίστα με Ελληνικές λέξεις από εξωτερικό αρχείο, επιλέγει μία στην τύχη και την κρύβει.
Μπορείτε να προσθέσετε λέξεις ή να φορτώσετε το Αγγλικό αρχείο που θα βρείτε στο zip.
Μόνο μικροί χαρακτήρες επιτρέπονται. Στα Ελληνικά θα χρειαστούν τόνοι.

    rem Hobby BASIC Interpreter

    filename$ = 'words_gr.txt'

    load filename$,temp$
    if V0 = -1 then print filename$,' not found' : pause : end

    count = SPLIT(temp$,EOL$,-1)
    if count < 1 then filename$,' is empty' : pause : end

    dim words$[count]
    SPLIT(temp$,EOL$,words$[])

    do
        guessX = RND() % count
        secretWord$ = TRIM(0,words$[guessX])
        numChars = LEN(secretWord$)
    until numChars > 0

    screen 80,30,300
    color 0,7
    cls

    print 'Welcome to Guess The Secret Word.'
    print 'This secret word has ',numChars,' letters.'

    times numChars print '*',
    print

    print 'Guess (to stop the program, press #) :'

    bGuessedCorrectly = 0

    while 1

        input choice$
        if FIND(choice$,'#') > 0 then break

        if secretWord$ = choice$
            bGuessedCorrectly = 1
            break
        endif

        for i = 0 to numChars-1
            if i < numChars and i < LEN(choice$)
                if secretWord$(i) = choice$(i)
                    print choice$(i),
                else
                    print '*',
                endif
            else
                print '*',
            endif
        next

        print

    endw

    if bGuessedCorrectly = 0
        print 'Bad luck, you did not find the word. The hidden word was: ',secretWord$
    else
        print 'Congratulations!, you found the hidden word.'
    endif

    end

Τα παραδείγματα στον φάκελο UDP της Hobby BASIC ανανεώθηκαν.
Προστέθηκε ένα απλοϊκό Chat μεταξύ 2 υπολογιστών τοπικού δικτύου.
Ο φάκελος UDP περιλαμβάνει τώρα 4 παραδείγματα, Client/Server, P2PDraw και P2PChat.

    rem  P2PCHAT.BAS
    rem  P2P Chatting via UDP sockets
    rem  Hobby BASIC Interpreter

    rem set remote ip address
    rem change to 192.168.1.xxx
    REMOTE_IP$ = 'localhost'

    rem swap the ports between the two hosts
    LOCAL_PORT = 50004
    REMOTE_PORT = 50005

    rem open listening socket
    if OPEN(LOCAL_PORT) = -1
        print 'socket error ',STR(V0) : pause : end
    endif

    screen 80,25,1000
    cursor 1,100
    color 0,7
    cls

    print 'Chat running on ',PATH(8)

    dim a$[4]

    while 1   rem Ctrl-C to exit

        rem get user input
        input '>',msg$

        msg$ = TRIM(0,msg$)

        if LEN(msg$) > 0
            rem send message to the remote pc
            SEND(REMOTE_IP$,REMOTE_PORT,msg$)
        endif

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

            rem get message info
            info$ = QUEUE(2)

            rem split info [IP PORT LENGTH TIME]
            SPLIT(info$,' ',a$[])

            rem pop the queue
            msg$ = QUEUE(0)

            rem print message
            pen 3
            print a$[0],' ',msg$
            pen 7

        endw

    endw

    CLOSE()
    end

Chat μεταξύ 2 υπολογιστών τοπικού δικτύου.

 

[Blue Max]

To coffee project της ημέρας.
Σκέφτηκα να φορτώσω μια εικόνα bitmap στην κονσόλα.
Η ιδέα ενός text adventure με εικόνες μου ήρθε παίζοντας το Battle of Leningrad του skylas.
Έγραψα πρόχειρα σε win32 asm μια εντολή bitmap x,y,path$ για να κάνω μια δοκιμή.
Οι τιμές x και y περνάνε σε pixel, path o δείκτης διαδρομής της εικόνας.

proc load_bitmap uses eax ebx ecx edx edi, x:dword, y:dword, path:dword

    local hBitmap dd ?
    local memDC dd ?
    local bi BITMAP

    setv -1  ; V0

    invoke LoadImage, 0, [path], 0, 0, 0, LR_LOADFROMFILE or LR_DEFAULTSIZE
    test eax, eax
    jz .continue

    mov [hBitmap], eax
    invoke GetObject, eax, sizeof.BITMAP, addr bi

    invoke CreateCompatibleDC, [hDC]
    mov [memDC], eax
    invoke SelectObject, eax, [hBitmap]

    invoke BitBlt, [hDC], [x], [y], [bi.bmWidth], [bi.bmHeight], [memDC], 0, 0, SRCCOPY

    invoke DeleteDC, [memDC]
    invoke DeleteObject, [hBitmap]

    movzx eax, word [bi.bmBitsPixel]
    mov ebx, [bi.bmWidth]
    mov ecx, [bi.bmHeight]

    setv eax, ebx, ecx  ; V0,V1,V2

    .continue:

    ret
endp

Μια δοκιμή. Ίσως προσθέσω την εντολή σε κάποιο επόμενο update του διερμηνευτή, όχι όμως τώρα.

    cls
    bitmap 50,50,'logo.bmp'
    inkey

Ξεκίνησα να γράφω κάτι. Έφτασα μέχρι ένα σημείο και μετά το παράτησα, όμως μου αρέσει Η δοκιμή τελείωσε. Ίσως, αν βρω χρόνο το καλοκαίρι να κάτσω να γράψω ένα text adventure στην Hobby BASIC. Θα χρειαστώ σενάριο, εικόνες, ήχους, κ.τ.λ. Δεν μπορώ να το κάνω αυτή την περίοδο. Σημειώστε πως το teaser που δείχνω είναι πλήρως λειτουργικό.

 

[Blue Max]

Βέβαια, εφόσον η Hobby BASIC υποστηρίζει ποντίκι στην κονσόλα θα μπορούσα ίσως να γράψω κάτι σαν scumm, η έστω να έχει το look and feel αυτής οπότε να μιλάμε για ένα point and click text adventure με εικόνες. Μου αρέσει και αυτό. Κάτι σε τρομαχτικό σκέφτομαι. Θα δούμε.

 

[Blue Max]

Ο διερμηνευτής ξεπέρασε τα 1000 downloads στο φόρουμ του flat assembler. Συγκίνηση on.




To coffee project της ημέρας.
Ένας ANSI viewer γραμμένος στην Hobby BASIC 1.4.3.

Εισαγωγή.

To 16color.rs φιλοξενεί χιλιάδες εικόνες ANSI σε φακέλους χρονολογικά, παράδειγμα ο φάκελος 1990.
Σκοπός μου να γράψω έναν viewer που θα μπορεί να φορτώσει απευθείας τις ANSI εικόνες που βρίσκονται ανεβασμένες στην εν λόγω ιστοσελίδα. Θα μπορεί όμως να λειτουργήσει και offline, φορτώνοντας εικόνες από τον φάκελο ART της Hobby BASIC.

Δοκιμές.

To screenshot είναι από τον κώδικα της σελίδας 1990. Βλέπω πως η σελίδα για την εικόνα AKO.ANS είναι η /PACK/1990/AKO.ANS




Επισκέφτηκα την σελίδα και είδα πως ο απευθείας σύνδεσμος (direct link) της εικόνας είναι ελαφρά διαφορετικός pack/1990/raw/AKO.ANS
Δοκιμάζω τον σύνδεσμο, φορτώνω την εικόνα στην κονσόλα.

    screen 80,30,300
    color 0,7
    cls
    ansi "https://16colo.rs/pack/1990/raw/AKO.ANS"
    inkey
    end

Δοκιμάζω τώρα να "κλέψω" όλους τους συνδέσμους τύπου .ANS από την σελίδα 1990 και να τους σώσω σε ένα αρχείο κειμένου. Η σελίδα περιέχει περίπου 440 διπλούς συνδέσμους, άρα κοντά 220 αρχεία .ANS.

    src$ = GETSRC("https://16colo.rs/pack/1990/")
    links$ = EXTRACT(src$,".ans")
    if LEN(TRIM(0,links$) > 0)
        save "links.txt",links$
    endif

Το πρόγραμμα.

O Viewer φορτώνει εικόνες από 6 διαφορετικούς φακέλους του 16color.rs. Μπορούν φυσικά να προστεθούν και άλλοι. Μπορεί να τις αναπαράγει τυχαία ή σε σειρά. Περιλαμβάνει μερικό έλεγχο λαθών και κάνει skip στα διπλά ονόματα. Παίζει αυτόματα σαν slideshow ή manual κάνοντας skip στην επόμενη πατώντας κάποιο πλήκτρο (ή το Esc και στις 2 περιτπώσεις). Αποθηκεύει αντίγραφο κάθε εικόνας που φορτώνει στον φάκελο ART της Hobby BASIC. Πριν φορτώσει κάθε εικόνα, πρώτα ελέγχει αν υπάρχει ήδη κατεβασμένη και την φορτώνει από τον σκληρό δίσκο κάνοντας την εναλλαγή αυτόματα από online σε offline. Μπορεί ακόμα να δουλέψει μόνο offline φορτώνοντας τις εικόνες που θα βρει μέσα στον φάκελο ART.

Άφησα το πρόγραμμα να τρέξει κάμποση ώρα σε Windows 10 αλλάζοντας που και που τις παραμέτρους του. Δεν είδα κάποιο πρόβλημα, χωρίς όμως αυτό να αποκλείεται. Θα το ενσωματώσω στα παραδείγματα σε μια επόμενη έκδοση του διερμηνευτή.

    rem  AVIEW.BAS
    rem  Hobby Basic Interpreter
    rem  ANSI Text File Viewer (requires an internet connection)

    AUTO_PLAY = 1
    RANDOM_ORDER = 1
    TEXT_SPEED = 2
    OFFLINE = 0

    url$ = "https://16colo.rs/pack/"

    numOfFolders = 6
    dim folder$[numOfFolders] = "1990", "ansipics", "eansis", "1991", "aaa-8991", "ensiart"

    if RANDOM_ORDER then folder$[].SHUFFLE

    view 11
    screen 80,50
    cursor 0,0
    color 0,7
    cls

    ? "ANSI Text File Viewer for Hobby Basic"

    art_path$ = PATH("ART\")

    if CHDIR(art_path$,0) = -1
        ? "Can''t find ART folder"
        pause
        end
    endif

    if OFFLINE
        ? "AVIEW is running offline"
        exec "dir /b *.ans",tmp$
        tmp$ = TRIM(0,tmp$)
        goto split_links
    endif

    index = -1

    next_folder#

    index = (index+1) % numOfFolders
    folder_path$ = url$ + folder$[index] + "/"
    raw_path$ = folder_path$ + "raw/"

    ? "Loading source from ",folder_path$

    src$ = GETSRC(folder_path$)
    if V0 <> 1
        ? "Can''t open URL"
        wait 2000
        goto next_folder
    endif

    tmp$ = TRIM(0,EXTRACT(src$,".ans"))
    if LEN(tmp$) = 0
        ? "Can''t find any .ANS links in folder ",folder$[index]
        wait 2000
        goto next_folder
    endif

    split_links#

    numOfLinks = SPLIT(tmp$,CHR(13),-1)
    if numOfLinks = 0
        ? "Splitting links to array failed"
        wait 2000
        if ~OFFLINE then goto next_folder else pause : end
    endif

    ? numOfLinks," links found with extension .ANS" : wait 500

    dim list$[numOfLinks+1]
    SPLIT(tmp$,CHR(13),list$[])
    if RANDOM_ORDER then list$[].SHUFFLE

    x = 0

    ansi_viewer#

    filename$ = RIGHT(TRIM(0,list$[x]),-1)
    path$ = art_path$ + filename$
    if SIZE(path$) = -1
        if OFFLINE then goto @f
        path$ = raw_path$ + filename$
    endif

    if prev_path$ = path$ then goto @f
    prev_path$ = path$

    color 0,7
    cls
    title path$
    ansi path$,TEXT_SPEED
    if KEY(27) then wait 100 : goto @f
    if AUTO_PLAY then wait 3000 else inkey
    @@# x = x + 1 : if x < numOfLinks then goto ansi_viewer
    if ~OFFLINE then goto next_folder else goto ansi_viewer

Κλείνοντας.

Η Hobby BASIC είναι εξ'ολοκλήρου γραμμένη σε 32-bit assembly και Win32 API. Η εντολή ANSI έχει backend έναν handmade loader γραμμένο σε assembly για να μπορεί να φορτώνει γραφικά ANSI στην κονσόλα, η εντολή EXTRACT που ανακτά τους συνδέσμους από μια ιστοσελίδα το ίδιο.

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