Index
> Examples and Tutorials > Hobby Basic, a toy language interpreter written in fasmGoto page Previous 1, 2, 3 |
| Author |
|
|
revolution
filox wrote: Sorry but where i can find sources of Hobbybasic? |
|||
21 Oct 2016, 12:13 |
|
|
system error
This is good. Keep it coming, bro!
|
|||
|
22 Oct 2016, 13:32 |
|
|
filox
revolution wrote:
No source, only EXE and Demo.bas |
|||
|
26 Oct 2016, 12:24 |
|
|
sleepsleep
hi filox,
you could try pm picnic for source etc |
|||
|
26 Oct 2016, 12:36 |
|
|
filox
Picnic wrote: Hi filox, the source is not available, at least not yet. Hobby Basic has still some way to go. I want to extend the command list, find methods to make the intepreter faster, add features like user procedures with parameters and local variables and some other ideas i have. This is done somewhat slowly, the only days i can steal some time to work are the weekends. Hi picnic, if u can share code with us, we can help you possibly to improve it faster and i'm interested in it for educational scope  |
|||
|
18 Nov 2016, 13:19 |
|
|
Picnic
Last edited by Picnic on 21 Mar 2020, 06:22; edited 2 times in total |
|||
|
21 Nov 2016, 15:50 |
|
|
Picnic
Last edited by Picnic on 21 Mar 2020, 06:23; edited 42 times in total |
|||
|
21 Dec 2016, 12:34 |
|
|
avcaballero
Hello, it is very interesting. I was very fond of qbasic. I'd just say that it would be nice to see your page in English, Greek is a bit hard for me
 |
|||
|
21 Dec 2016, 13:20 |
|
|
Picnic
Last edited by Picnic on 21 Mar 2020, 06:22; edited 31 times in total |
|||
|
28 May 2018, 13:49 |
|
|
Robocod
Source code?
|
|||
|
19 Dec 2018, 21:23 |
|
|
sts-q
|
|||
|
20 Dec 2018, 09:33 |
|
|
Picnic
I uploaded a new version with minor improvements and bug fixes.
Many new examples added. Hobby Basic Version 1.0.5 Download |
|||
|
05 Mar 2020, 09:56 |
|
|
Picnic
I uploaded a new version with minor improvements and (not so minor) bug fixes.
Hobby Basic Version 1.0.6 Download This is a simple text drawing program for the Windows console written in Hobby Basic. If someone could run the program in a Windows 10 environment and confirm that the mouse is working, I would appreciate it. I had some minor issues with Windows 10, I made some corrections and changes, but i haven't tested them since I don't have often access to Windows 10. Code:
rem Text Draw Version 0.3
rem Written in Hobby Basic
rem Click to select a character from the right panel
rem Click and drag mouse on main panel to draw
rem Right click and drag mouse to select area
rem Drag the selected area anywhere in screen
rem Double click to paste the selected area
rem Use the color picket to select the color
rem Click on BG or FG to select the attribute
rem LOAD extensions: .ANS, .HB
rem SAVE extensions: .HB
cmdline$ = V0
rem Do not write above this line
msg$=\
'Text Draw version 0.3'+EOL$+\
'Written in Hobby Basic'+EOL$+EOL$+\
'Instructions:'+EOL$+\
'Click to select a character from the right panel'+EOL$+\
'Click and drag mouse on main panel to draw'+EOL$+\
'Right click and drag mouse to select area'+EOL$+\
'Drag the selected area anywhere in screen'+EOL$+\
'Double click to paste the selected area'+EOL$+\
'Use the color picket to select the color'+EOL$+\
'Click on BG or FG to select the attribute'+EOL$+\
'LOAD extensions: .ANS, .HB'+EOL$+\
'SAVE extensions: .HB'+EOL$
MOVED fix (x <> cx or y <> cy)
CENTER fix (x > 8 and x < (W-11))
LPANEL fix (x > 0 and x < 9)
RPANEL fix (x > (W-10))
OUTSIDE fix (a < 9 or ((a + w) > W-11))
SELECTED fix a,b,w,h
PANEL fix 9,0,C,R
C = 80
R = 40
W = C + 20
MB_OK = 0x0
MB_YESNO = 0x4
ID_YES = 6
dim charset[270]
dim map[C,R]
dim argv$[8]
title$ = 'Text Draw'
msg1$ = 'File is not saved, exit?'
msg2$ = 'Do you want to exit?'
screen W,R
cursor 0,0
color 0,0
cls
p = 0
load_charset(0x0,0x5)
load_charset(0x20,0x0FF)
load_charset(0x2000,0x25FF)
for i = 0 to p - 1
? CHR(charset[i]),
if ~(i % 8) then ?
next
block 0,0,8,R,600 : cls
color 8,8
cls
color 0,0
paint 9,0,W-20,R,-1,-1
block W-9,2,600
color 8,15
paint W-11,0,11,R,-1,1
pen 7
at 1,1,'NEW'
at 1,2,'LOAD'
at 1,3,'SAVE'
at 1,4,'UNDO'
at 1,5,'CLEAR'
at 1,6,'INVERT'
at 1,7,'ROTATE'
at 1,8,'ABOUT'
pen 15
at 1,10,' ----'
at 0,12,'>FG'
pen 7
at 1,14,'BG'
at W-8,1,'select'
color 7,7
erase 4,12,4,' ',1
color 0,0
erase 4,14,4,' ',1
for i = 0 to 7
color i,0
paint 1,i*2+17,3,2,' ',1
color i+8,0
paint 4,i*2+17,3,2,' ',1
next
color 8,0
paint 4,17,3,2,9618,1
x = 0 : y = 0 : cx = -1 : cy = -1 : dx = -1 : dy = -1 : rx = -1 : ry = -1 : sx = -1 : sy = -1 : v = 12 : r = 0 : lx = -1 : ly = -1
mx = -1 : my = -1 : bg = 0 : fg = 7 : w = 0 : h = 0 : c = 0 : ch = 0 : a = -1 : b = -1 : saved = 1 : over = 0 : sel = 0
a$ = '' : b$ = '' : c$ = ''
if split(cmdline$,' ',argv$[]) > 1 then load_file(UCASE(argv$[1]))
a$ = title$+' ('+STR(p) + ' characters loaded)'
title a$
main#
do
btn = get_mouse()
if CENTER
if MOVED
cursor 1,100
coords()
ucode()
a$ = title$+' ('+STR(x-9)+','+STR(y)+')'
title a$
endif
if (btn = 4 and sel = 1)
restore
store PANEL
store W-11,0,11,R
block x,y,700
restore
btn = -1
sel = 0
goto continue
endif
if (btn = 1 and sel = 1 and a <= x and x <= (a + w) and b <= y and y <= (b + h))
block SELECTED,701
restore
store PANEL
clear(SELECTED)
block SELECTED,701
while get_mouse() <> -1
if (mx <> x or my <> y)
block a,b,701
if mx < x then a = a + (x - mx)
if mx > x then a = a - (mx - x)
if my < y then b = b + (y - my)
if my > y then b = b - (my - y)
if b < 0 then b = 0 : y = (h >> 1)
block SELECTED,701
block a,b,700
if OUTSIDE
color 12,4
paint SELECTED,-1,1
color bg, fg
elseif MOVED
a$ = title$+' ('+STR(a-9)+','+STR(b)+')'
title a$
endif
endif
endw
if OUTSIDE then block a,b,701 : restore
a = -1
b = -1
btn = -1
sel = 0
goto continue
endif
if (btn = 1 or btn = 2)
sx = x
sy = y
saved = 0
if sel = 1 then restore : a = -1 : b = -1 : sel = 0
store x,y,1,1
if btn = 1 then draw(x,y,1,1)
while get_mouse() <> -1
if (CENTER and MOVED)
restore
coords()
b$ = a$+' --> '+STR(x-9)+','+STR(y)
w = ABS(sx-x) + 1
h = ABS(sy-y) + 1
if x > sx then x = sx
if y > sy then y = sy
a = x : b = y
block x,y,w,h,700
store x,y,w,h
draw(x,y,w,h)
ucode()
title b$
endif
endw
if btn = 2 then sel = 1
endif
elseif LPANEL
cursor 0,0
if btn = 1
if sel = 1 then restore : sel = 0
if (y = 2 or y = 3 or y = 8)
color 8,7
erase 1,y,7,-1,1
endif
if y = 1
do:restore:until V0=-1
clear(PANEL)
elseif y = 2
load_file(UCASE(PATH('open')))
do:until ~KEY(27)
elseif y = 3
save_file(UCASE(PATH('save')))
do:until ~KEY(27)
elseif y = 4
restore
elseif y = 5
store SELECTED
clear(SELECTED)
elseif y = 6
store SELECTED
invert SELECTED
elseif y = 7
store SELECTED
r = r ^ 1
flip SELECTED,r
elseif y = 8
alert 0x40,title$,msg$
do:until ~KEY(27)
elseif (y = 12 or y = 14)
color 8,15
erase 0,y,1,'>',1
erase 1,y,2,-1,1
if y = 12 then v = 14 else v = 12
erase 0,v,1,' ',1
color 8,7
erase 1,v,2,-1,1
v = y
elseif (y > 15 and y < 33)
info x,y
if V1 = 8 then c = 9618 else c = 32
if v = 12 then fg = V1 : color fg,0 else bg = V1 : color bg,0
erase 4,v,4,c,1
endif
endif
if (MOVED and x > 0 and x < 7 and y > 0 and y < 9)
if (x <> lx or y <> ly)
color 8,7
erase 1,ly,8,-1,1
grab 1,y,7,1,a$
a$ = TRIM(a$)
color 7,8
erase 1,y,LEN(a$),-1,1
b$ = title$+' ('+a$+')'
title b$
over = 1
endif
lx = x
ly = y
goto continue
endif
if over = 1
over = 0
color 8,7
paint 1,1,7,8,-1,1
endif
elseif RPANEL
cursor 0,0
if (MOVED and y > 2 and (x <> dx or y <> dy))
info x,y
if V0 <> 32
invert dx,dy,1,1
invert x,y,1,1
ucode()
c$ = title$+' (U+'+PAD(STR(ASC(c)),'0',4)+ ')'
title c$
dx = x
dy = y
endif
endif
if (btn = 1 and y > 2)
info x,y
if V0 <> 32
ch = V0
color 8,15
erase rx,ry,1,-1,1
color 0,11
erase x,y,1,-1,1
rx = x
ry = y
endif
endif
endif
continue#
wait 1
until KEY(27)
if saved = 0 then c$ = msg1$ else c$ = msg2$
alert MB_YESNO,title$,c$
if V0 <> ID_YES then goto main
color 0,7
cls
end
sub load_charset(start,finish)
for i = start to finish
if p > SIZE(charset[])-1 then break
at 0,0,CHR(i)
info 0,0
if (V0 <> 0 and V0 <> '?')
charset[p] = V0
p = p + 1
a$ = 'Loading char U+' + PAD(UCASE(HEX(V0)),'0',4)
title a$
endif
next
ends
sub clear(x,y,w,h)
color 0,0
paint x,y,w,h,-1,-1
color bg,fg
ends
sub draw(x,y,w,h)
if btn = 1
color bg,fg
paint x,y,w,h,ch,1
elseif btn = 2
color 0,1
paint x,y,w,h,-1,1
endif
ends
sub ucode()
info x,y
if V0 <> 32 then c = V0
c$ = 'U+'+PAD(STR(c),'0',4)+' '+CHR(c)
color 8,7
at W-9,1,c$
ends
sub coords()
locate x,y
color 8,15
c$ = STR(x-9)+','+STR(y)+' '
at 2,10,c$
cx = x
cy = y
ends
sub get_mouse()
mouse
mx = x
my = y
x = V0
y = V1
rets V2
ends
sub load_file(path$)
if LEN(path$) > 3
if SIZE(path$) <> -1
if COMP(RIGHT(path$,4),'.ANS')
view 0
store PANEL
store 0,0,W,R
screen C,R
color 0,0
cls
ansi path$
set map[],0
grab 0,0,C,R,map[],0
screen W,R
restore
grab PANEL,map[],1
saved = 1
view 1
elseif COMP(RIGHT(path$,3),'.HB')
set map[],0
load path$,map[]
store PANEL
clear(PANEL)
grab PANEL,map[],1
saved = 1
endif
endif
endif
ends
sub save_file(path$)
if ~COMP(RIGHT(path$,3),'.HB')
path$ = path$ + '.HB'
endif
if LEN(path$) > 3
set map[],0
grab PANEL,map[],0
save path$,map[]
if V0 <> -1
c$ = 'Save path: ' + path$
alert MB_OK,title$,c$
saved = 1
endif
endif
ends
Windows XP Screenshot 
Windows 7 Screenshot 
How to create the standalone DRAW.EXE Save the code as DRAW.BAS in the EXAMPLES folder. Type at the command-line: Code:
hb EXAMPLES/DRAW.BAS -bind DRAW.EXE
The standalone application will be created inside the HB folder. To open the apple image directly from the command-line, type: Code:
DRAW ART\APPLE.ANS
 Last edited by Picnic on 22 May 2020, 20:31; edited 1 time in total |
|||
|
22 May 2020, 13:13 |
|
|
bitRAKE
I think I ran all of them on Windows 10.
About the mouse one: didn't indicate which button was double-clicked, and the middle button displays as the left button. This might be a limitation of the API - I don't know. I did find an error in the XONIX game. I was able to meet the edge at the same time as the red spot. This causes the area not to be filled until I completed another closing move. This typically is just a "one-off" error. Also, an error in DRAW.BAS, line 336, changed to "if p > 269 then break", and it seems to work. Was only missing 1200 baud modem sounds.
Well done! |
|||
|
22 May 2020, 15:05 |
|
|
Picnic
Thanks for taking the time running the examples bitRAKE, i appreciate that.
Quote: This might be a limitation of the API - I don't know. I think i have to update my code a bit. The interpreter using the same mouse routine since 2015. Quote: Also, an error in DRAW.BAS, line 336, changed to "if p > 269 then break", and it seems to work. Out of range!, i missed that, it's better this way. Code:
if p > SIZE(charset[])-1 then break
Quote: I did find an error in the XONIX game. I was able to meet the edge at the same time as the red spot. This causes the area not to be filled until I completed another closing move. This typically is just a "one-off" error. Oh come on now, how fast did you notice that. A true game tester  |
|||
|
22 May 2020, 20:51 |
|
|
bitRAKE
Another oddity is not being able to select a character from the codepage that characters are displayed with. The saved images display correctly, but limited character selection as seen in the picture. I was even able to crash the console by selecting different fonts. Windows 10 might be to blame here as they try to push everyone to Powershell.
Putting this in a batch file will compile all the examples: Code: FOR %%G IN (.\EXAMPLES\*.BAS) DO (HB "%%G" -bind ".\BIN\%%~nG.EXE")
|
||||||||||
|
23 May 2020, 05:21 |
|
|||||||||
|
Picnic
The program seems to work well with raster fonts as the default font set on the console.
But selecting a different font before the program execution meshes things up in Windows 7 also. Running the program with raster font 8x12 default. 
Changing to Lucida during runtime in Windows 7 looks ok. 
But, setting Lucida as the default font and then running the program, it breaks the set. 
Quote: Putting this in a batch file will compile all the examples: I like this. I can do it through HB as well. Something like that, Code:
alert (0x4|0x20),"","Do you want to compile all the examples?"
if V0 = 6
exec "if not exist BIN\NUL md BIN"
exec "FOR %G IN (.\EXAMPLES\*.BAS) DO (HB ""%G"" -bind "".\BIN\%~nG.EXE"")"
endif
Thanks again bitRAKE. |
|||
|
23 May 2020, 13:13 |
|
| Goto page Previous 1, 2, 3 < Last Thread | Next Thread > |
Forum Rules:
|