flat assembler
Message board for the users of flat assembler. Index > Tutorials and Examples > Hobby Basic, a toy language interpreter written in fasm Goto page Previous  1, 2, 3, 4  Next
Author
 Thread  MajorDill

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

begging somebody to repost them

thankyou 26 Apr 2014, 18:04  Picnic

Joined: 05 May 2007
Posts: 1291
Picnic
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 26 Apr 2014, 21:40  MajorDill

Joined: 01 Nov 2010
Posts: 20
MajorDill
got it - thanks 28 Apr 2014, 14:01  Picnic

Joined: 05 May 2007
Posts: 1291
Picnic
I have uploaded a new version with minor improvements and bug fixes.

Hobby Basic Version 0.4.0

XO game in console (uses the mouse).
Code:
```
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'

screen -1,-1
if V0 < 80 then screen 80,25
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
``` Last edited by Picnic on 19 Jan 2021, 13:20; edited 72 times in total 31 Jul 2015, 06:16  fasmnewbie Joined: 01 Mar 2011 Posts: 555 fasmnewbie I love this stuff. Excellent materials for beginners to learn from (although there's nothing 'beginners' with the code) 01 Aug 2015, 02:54
 fasmnewbie Joined: 01 Mar 2011 Posts: 555 fasmnewbie I am linking to this thread. 01 Aug 2015, 03:10
Picnic

Joined: 05 May 2007
Posts: 1291
Picnic
^^Thank you fasmnewbie.

I have uploaded a new version with minor improvements and bug fixes.

Hobby Basic Version 0.4.2

Code:
```
rem  APPLE1.BAS
rem  Hobby Basic Interpreter

apple\$ = PATH('ART\APPLE.ANS')

screen -1,-1
if V0 < 80 then screen 80,25,300

cls

ansi apple\$

inkey

cls : end
``` Last edited by Picnic on 19 Jan 2021, 13:20; edited 43 times in total 02 Aug 2015, 11:15  Picnic

Joined: 05 May 2007
Posts: 1291
Picnic
I have uploaded a new version with minor improvements and bug fixes.

Hobby Basic Version 0.5.0

The command BLOCK copies a specific area of the console screen to a memory block and vice versa.
Code:
```
rem  APPLE2.BAS
rem  Hobby Basic Interpreter

apple\$ = PATH('ART\APPLE.ANS')

! block id's
A = 700
B = 701

screen -1,-1
if V0 < 80 then screen 80,25

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

locate 0,24
inkey

cls : end
``` Last edited by Picnic on 19 Jan 2021, 13:21; edited 36 times in total 12 Aug 2015, 09:43  fasmnewbie Joined: 01 Mar 2011 Posts: 555 fasmnewbie 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. 12 Aug 2015, 12:43
Picnic

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

I have uploaded a new version with minor improvements and bug fixes.

Hobby Basic Version 0.5.1

Randomly shuffle the console screen.
Code:
```
rem  APPLE3.BAS
rem  Hobby Basic Interpreter

apple\$ = PATH('ART\APPLE.ANS')

! block id's array
dim a

! set array 0,1,2,...15
set a[],5:0

title 'Press Space to start/stop, Esc to exit'

screen -1,-1
if V0 < 80 then screen 80,25,300

ansi apple\$

inkey

! 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

if KEY(-1) then inkey else wait 30000

until KEY(27)

cls : end
``` Last edited by Picnic on 19 Jan 2021, 13:21; edited 27 times in total 15 Aug 2015, 22:13  Picnic

Joined: 05 May 2007
Posts: 1291
Picnic
I have uploaded a new version with minor improvements and bug fixes.

Hobby Basic Version 0.5.2

Console version of the game 2048.
Code:
```
rem  2048 Puzzle
rem  Hobby Basic Interpreter

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

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

best\$ = TRIM(best\$)
time = 10000

title '2048 Puzzle in Hobby Basic'

screen -1,-1
if V0 < 80 then screen 80,25,300
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

do
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

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
next x
next y

rets 0
ends

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 time : moveVert(x,y+d,1)
else
if (y + d) > 0 then drawBoard() : wait time : 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 time : moveHori(x+d,y,1)
else
if (x+d) > 0 then drawBoard() : wait time : 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
``` Last edited by Picnic on 19 Jan 2021, 13:22; edited 43 times in total 03 Sep 2015, 14:45  Picnic

Joined: 05 May 2007
Posts: 1291
Picnic
I have uploaded a new version with minor improvements and bug fixes.

Hobby Basic Version 0.5.6

How to replace color 12 with color 13 at a specific area of the screen using repaint command.
Code:
```
cls
screen 80,25
ansi 'ART\APPLE.ANS'
repaint 0,0,40,25,12,13
inkey : cls
``` Last edited by Picnic on 08 Jan 2021, 14:38; edited 56 times in total 09 Oct 2015, 06:27  SergeASM Joined: 13 Nov 2015 Posts: 21 SergeASM 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 20 Nov 2015, 10:21
Picnic

Joined: 05 May 2007
Posts: 1291
Picnic
Hi SergeASM,

Yes that's me, nice of you to ask. 20 Nov 2015, 11:34  Picnic

Joined: 05 May 2007
Posts: 1291
Picnic
I have uploaded a new version with minor improvements and bug fixes.

Hobby Basic Version 0.6.9

An ANSI Text File Viewer for the console. The program will download and view ANSI art files from web.
Code:
```
rem  AVIEW.BAS
rem  Hobby Basic Interpreter
rem  ANSI Text File Viewer (remote version)

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'

if V0 = -1 then ? 'failed' : pause : end

speed = 5
time = 2000000
AUTO_PLAY = TRUE

screen -1,-1
if V0 < 80 then 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 cls : end
if AUTO_PLAY then wait time else inkey
goto main
``` Last edited by Picnic on 19 Jan 2021, 13:23; edited 38 times in total 11 May 2016, 11:08  redrum88

Joined: 30 Mar 2016
Posts: 5
redrum88
Very nice, thanks! 19 May 2016, 00:25  Picnic

Joined: 05 May 2007
Posts: 1291
Picnic
I have uploaded a new version with minor improvements and bug fixes.

Hobby Basic Version 0.7.3

2D Side Movement. Use the Arrow keys to move sprite.
Code:
```
rem  SPRITE1.BAS
rem  Hobby Basic Interpreter

COLS = 80
ROWS = 25
C = 6
R = 4

dim a[C,R]
dim m[COLS,ROWS]

title 'Use the Arrow keys to move sprite'

screen COLS,ROWS
cursor 0,0
color 0,0
cls

color 1,8
pen 11
print at 2,ROWS-2,'2D Side Movement'

color 8,8
paint 20,ROWS-18,24,15,0x20,1
color 4,4
paint 50,ROWS-13,20,10,0x20,1
grab 0,0,COLS,ROWS,m[],0

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

color 13,13
paint x,y,C,R,0x20,1
color 0,0
paint x+1,y+1,C-2,R-2,0x20,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 <= COLS)

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
``` Last edited by Picnic on 19 Jan 2021, 13:23; edited 49 times in total 14 Jun 2016, 10:08  Picnic

Joined: 05 May 2007
Posts: 1291
Picnic
I have uploaded a new version with minor improvements and bug fixes.

Hobby Basic Version 0.7.5

2D Scrolling Background in console. Use the Arrow keys to move, Spacebar to jump.
Code:
```
rem  SPRITE2.BAS
rem  Hobby Basic Interpreter

COLS = 80
ROWS = 25
C = 6
R = 4

dim a[C,R]
dim m[2*COLS,ROWS]

view 0
screen 2*COLS,ROWS

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

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

cls
color 1,8
pen 11
at 2,ROWS-2,'2D Scrolling Background'
color 8,8
paint 20,ROWS-18,24,15,0x20,1
color 4,4
paint 50,ROWS-13,20,10,0x20,1
color 0,0

copy 0,0,COLS,ROWS
paste COLS,0
grab 0,0,2*COLS,ROWS,m[],0

screen COLS,ROWS
view 1

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

grab x,0,COLS,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 = COLS-1
if x > COLS-1 then x = 0
grab x,0,COLS,T,m[],0,0
grab 35,y,C,R,a[],2
endif

wait 12000

until KEY(27)

cls : end
``` Last edited by Picnic on 19 Jan 2021, 13:24; edited 50 times in total 07 Aug 2016, 09:10  Picnic

Joined: 05 May 2007
Posts: 1291
Picnic
I have uploaded a new version with minor improvements and bug fixes.

Hobby Basic Version 0.7.6

Simple console-based car game.
Code:
```
rem  RALLY.BAS
rem  Hobby Basic Interpreter

C = 9
R = 5
D = 0

dim rally[C,R]
dim temp

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

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

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
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
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

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
``` Last edited by Picnic on 19 Jan 2021, 13:25; edited 28 times in total 21 Oct 2016, 08:41  filox

Joined: 13 Feb 2013
Posts: 11
filox
Sorry but where i can find sources of Hobbybasic? 21 Oct 2016, 11:52  Display posts from previous: All Posts1 Day7 Days2 Weeks1 Month3 Months6 Months1 Year Oldest FirstNewest First  Jump to: Select a forum Official----------------AssemblyPeripheria General----------------MainTutorials and ExamplesDOSWindowsLinuxUnixMenuetOS Specific----------------MacroinstructionsOS ConstructionIDE DevelopmentProjects and IdeasNon-x86 architecturesHigh Level LanguagesProgramming Language DesignCompiler Internals Other----------------FeedbackHeapTest Area
Goto page Previous  1, 2, 3, 4  Next

Forum Rules:
 You cannot post new topics in this forumYou cannot reply to topics in this forumYou cannot edit your posts in this forumYou cannot delete your posts in this forumYou cannot vote in polls in this forumYou cannot attach files in this forumYou can download files in this forum