THIN.Hack

[MouseTrap]

I created a roguelike framework in TB. Enjoy.


'------------------------
'// THIN.Hack Map test //
'// Not very optimized in some places
'------------------------
uses "CONSOLE"
randomize

Console_SetScreenBufferSize(80,25)
Console_HideCursor
Console_SetTitle("THIN.Hack MapTest 0.1")


'// Commands
Const CMD_UP as long =1
Const CMD_DN as long =2
Const CMD_LEFT as long =3
Const CMD_RIGHT as long =4


'// Map
const MAPW as long = 100
const MAPH as long = 100

'// Map Tiles
Const FLOOR as long = 1
const DOOR as long =2
Const WALL as long =3
const START as long = 4
const DEST as long = 5

'-------------------------------------------
Type tCell
Ctype as long '// TileType
Visible as long '// in los flag
HasSeen as long '// past los flag
Flags(4) as long '// data for whatever..
End Type
'-------------------------------------------
Type tLoc '// location type used by player,monsters, map items, ect
X as long
Y as long
End Type
'-------------------------------------------
Type tEntity '// moving thing
fCol as long
mloc as tLoc
End Type
'-------------------------------------------
Type tPlayer
Ent as tEntity
End Type
'-------------------------------------------
Dim Player as tPlayer
player.Ent.mloc.x = MAPW/2
player.Ent.mloc.y = MAPH/2

Dim Map(MAPW,MAPH) as tCell

Dim OffX,OffY as long
offx=(MAPW/2)-40
offy=(MAPH/2)-12
'-------------------------------------------------------------------------
Sub CreateMap()
dim X,Y,I as long
for x = 1 to MAPW
for y = 1 to MAPH
Map(x,y).Ctype = WALL
Next
Next
for i=1 to 45
WallRect(rnd(2,MAPW-2),rnd(2,MAPH-2),rnd(4,MAPW/3),rnd(4,MAPH/3))
next
for i=1 to 39
RoomRect(rnd(2,MAPW-3),rnd(2,MAPH-3),rnd(4,15),rnd(4,15))
next
'map(3,4).Ctype=DEST
End Sub
'-------------------------------------------------------------------------
sub WallRect(x as long,y as long,w as long,h as long)
dim i as long 'x,y,w,h as long
if X+w >= MAPW then exit sub
if Y+h >= MAPH then exit sub

for i=x to x+w
Map(i,y).Ctype = FLOOR
Map(i,y+h).Ctype = FLOOR
next
for i=y to y+h
Map(x,i).Ctype = FLOOR
Map(x+w,i).Ctype = FLOOR
next
End Sub
'-------------------------------------------------------------------------
Sub RoomRect(x as long,y as long,w as long,h as long)
dim x1,y1 as long
if X+w >= MAPW then exit sub
if Y+h >= MAPH then exit sub
for x1 = x to x+w
for y1 = y to y+h
Map(x1,y1).cType = FLOOR
next
next
End Sub
'-------------------------------------------------------------------------
Sub DrawMap()
dim X,Y,X1,Y1,I as long
dim colr as long

for x = 1 to MAPW
for y = 1 to MAPH
If not ((x-offx > 80 or x-offx < 0) or (y-offy > 25 or y-offy < 0)) then
if map(x,y).HasSeen = 1 then
if map(x,y).Ctype=WALL then
PrintAT(chr$(178),x-offx,y-offy,iif( map(x,y).Visible,10,2) ) '// for oldschool use "#"
endif
if map(x,y).Ctype=FLOOR then
PrintAT(chr$(176),x-offx,y-offy,iif( map(x,y).Visible,9,1)) '// or "."
endif
Endif
endif
next
next
End Sub
'-------------------------------------------------------------------------
Sub DrawEnt()
PrintAt(chr$(1),40,12,15)
End Sub
'-------------------------------------------------------------------------
Sub Los()
'// this reaaally crawls in TB. maybe use Oxygen to speed this up.
'// for some reason this is skipping tiles in TB, its works perfectly in other langauges though.. (cast to single not working??) >:-(
Dim XX,YY as long
Dim angle as single
dim dist as long
dim x as single = player.ent.mloc.X + 0.5
dim y as single = player.ent.mloc.Y + 0.5
dim ymove as single
dim xmove as single

For xx = 1 To MAPW
For yy = 1 To MAPH
If Map(xx, yy).visible = True Then
Map(xx, yy).HasSeen = 1 '// Mark the cell as previously seen
Map(xx, yy).visible = 0
EndIf
Next
Next

For angle = 1 To 360 Step 0.18
dist = 0
x = (player.ent.mloc.X) as single + 0.5 '// Add 0.5 to simulate looking from the center of the tile.
y = (player.ent.mloc.Y) as single + 0.5
xmove = Cos(angle)
ymove = Sin(angle)

while true
x = x + xmove
y = y + ymove
dist = dist + 1
If dist >= 9 Then Exit while
If X >= MAPW Then Exit while
If y >= MAPH Then Exit while
If x < 0 Then Exit while
If y < 0 Then Exit while
Map(x, y).visible = 1
If Map(x, y).cType = WALL Then Exit while
wend
Next
End Sub
'-------------------------------------------------------------------------
Sub Update(cmd as long)
dim x,y, mh1 as long

Select case cmd
case CMD_UP
if Map(Player.Ent.mLoc.x,Player.Ent.mLoc.y-1).cType = FLOOR then
Player.Ent.mLoc.y -=1
offy -= 1
endif
case CMD_DN
if Map(Player.Ent.mLoc.x,Player.Ent.mLoc.y+1).cType = FLOOR then
Player.Ent.mLoc.y +=1
offy += 1
endif
Case CMD_LEFT
if Map(Player.Ent.mLoc.x-1,Player.Ent.mLoc.y).cType = FLOOR then
Player.Ent.mLoc.x -=1
offX -= 1
endif
case CMD_RIGHT
if Map(Player.Ent.mLoc.x+1,Player.Ent.mLoc.y).cType = FLOOR then
Player.Ent.mLoc.x +=1
offX += 1
endif
End Select
End Sub
'-------------------------------------------------------------------------
Sub DrawStats()
'// this probably wont work if the flickering cant be disabled..
Console_Box(1,21,78,3,20,20,"Stats",46,%Console_BOX_FLAG_3DOFF)
End Sub
'-------------------------------------------------------------------------
dim key as string
while Map(MAPW/2,MAPH/2).Ctype <> FLOOR '// find starting location
CreateMap
wend
'-------
Los
Drawmap
DrawEnt
Update(CMD_UP)
Los
Drawmap
DrawEnt

'-------
while true
Console_SetCursorPosition(0,0)

'Update
DOEVENTS
key = console_inkey
if len(key) = 3 and asc(right$(key,1)) = %CONSOLE_LBUTTON then
'PrintAT("Mhit",0,0,15)
endif
if len(key)=2 and asc(left$(key,1))=0 then
'printl asc(right$(key,1))
select case asc(right$(key,1))
case 37
Update(CMD_LEFT)
case 38
Update(CMD_UP)
case 39
Update(CMD_RIGHT)
case 40
Update(CMD_DN)
end select

Los
Console_Cls
Drawmap
DrawEnt
DrawStats
endif
wend
console_waitkey

[ErosOlmi]

Great !!!!! :eusaclap:

Great thinBasic program.
Wow, what a first thinBasic script!

Thanks a lot.
Karma point on its way.

[Michael Hartlef]

ULTIMA here you come. Great job!

[Petr Schreiber]

:eusaclap:

Really nice script! I like the effect of radial light :shock:

One thing - in thinBasic, you can handle following case:


If not ((x-offx > 80 or x-offx < 0) or (y-offy > 25 or y-offy < 0)) then


Like this:


If not (outside(x-offx, 0, 80) or outside(y-offy, 0, 25) ) then


Or like this:


If (inside(x-offx, 0, 80) and inside(y-offy, 0, 25) ) then


Thank you,
Petr

[MouseTrap]

Thanks.
It was a learning exercise for me and the TB language.

[MouseTrap]

Ok, I wasnt aware of the 'inside,outside' commands. thats pretty neat..
It could use some optimizations all over the place. especially in the raycasting routine.
I mostly did it to learn the TB language. Maybe i'll try to move the routine to oxygen for a speed boost.

Thanks!

[Michael Clease]

Perhaps this would help, precalc the sin and cos tables should save some time.



DIM CosTable(360/0.18) AS SINGLE
DIM SinTable(360/0.18) AS SINGLE

'-------------------------------------------------------------------------
SUB BuildCOSINtable()
LOCAL angle as Single
LOCAL counter AS LONG VALUE = 1
For angle = 1 To 360 Step 0.18
CosTable(Counter) = Cos(angle)
SinTable(Counter) = Sin(angle)
INCR Counter
NEXT
END SUB




For angle = 1 To 2000 '360 Step 0.18
dist = 0
x = (player.ent.mloc.X) as single + 0.5 '// Add 0.5 to simulate looking from the center of the tile.
y = (player.ent.mloc.Y) as single + 0.5
xmove = CosTable(angle) 'Cos(angle)
ymove = SinTable(angle) 'Sin(angle)

[MouseTrap]

Thats a great idea! i'd competly overlooked lookup tables.

btw: In TB im using a line like "y = (player.ent.mloc.Y) as single + 0.5"
Is that the correct way to cast an the long 'mloc.Y' into the single?

[ErosOlmi]

btw: In TB im using a line like "y = (player.ent.mloc.Y) as single + 0.5"
Is that the correct way to cast an the long 'mloc.Y' into the single?


Yes, it is but in reality it should not be necessary because internally thinBasic performs all calculations using EXT numeric data type and making automatic casting whenever necessary.

[MouseTrap]

Ok, in TB ive been only using long datatypes so bytes and words wont be cast up on the processor, but from what your saying it shouldnt matter if its long or byte in terms of speed because it all 80bit internally, yes?

[ErosOlmi]

Yes and no.

Calculations are all made with the max precision possible, 80bits.
Casting in than made when necessary, for example during variable reading and variable assignment, function parameters passing, UDT elements handling, ...
Speed is effected in any case because assigning 4 bytes for a LONG instead of 10 bytes for an EXT makes a great difference.

Explicit casting (like in your example) was introduced some versions ago to solve some special situations where intermediate rounding were wrongly effecting calculations.

[MouseTrap]

Ok, Thanks!

[ErosOlmi]

MouseTrap,

I didn't resist and even if I should be already in my bed, I tried to little optimize your script.
Mainly I changed some DIM to STATIC (much faster) plus some little other tricks.

Hope you can get some visible speed improve.
I will use this script as testing meter to improve some console functions.

Ciao
Eros

[MouseTrap]

very cool!
I do get a noticeable speedup.
I'll definitely use this version if i make any additions.

Thanks!

[ErosOlmi]

Little further update in previous source.
Changed ASC usage in main loop in order to avoid LEFT$ and RIGHT$ usage

[MouseTrap]

I added the lookup tables provided by Michael Clease. Its hard to tell it provides a speedup, I think sin/cos are natively fast enough.
I'm currently working with Oxygen/O2h to try and speed up the LOS routine.
There are some examples of defining a local array and binding it to a TB array's address for use in O2h, but its giving me errors.
my asm skills are pretty much non-existent. but its fun to play with anyway. Maybe Charles will post some use-cases on the O2h syntax.

[ErosOlmi]

A little further increment:

In LOS function substitute:

If dist >= 9 Then Exit while
If X >= MAPW Then Exit while
If y >= MAPH Then Exit while
If x < 0 Then Exit while
If y < 0 Then Exit while
with

if some(dist >= 9, X >= MAPW, y >= MAPH, x < 0, y < 0) then exit while

SOME is like a multiple OR.

Ciao
Eros

[MouseTrap]

Ha!, those keywords are new to me, 'some', 'inside', ect. I need to re-read the docs..
Great!

[ErosOlmi]

I think I've got a little more improve but this time developing new CONSOLE functions athat will allow to work in double buffer mode. This also solve flickering caused by CONSOLE_CLS command. Problem is that new functions need at least Win2K OS.

Attached to to this post a bundled EXE version of the revised script.

If you want new Console module, in attached zip file you can find new thinBasic_Console.dll (to be copied into \thinBasic\Mod\ directory) and also script source code.

A note: I've changed in LOS function
from this:

For angle = 1 To 360 Step 0.18
to this:

For angle = 1 To 360
and all seems working as expected. Is the first STEPing by 0.18 increments necessary? Maybe I'm missing something.

Ciao
Eros

[MouseTrap]

Cool, I'll check it out.

Is the first STEPing by 0.18 increments necessary? Maybe I'm missing something.
It is necessary because just 360 iterations will create gaps in the raycasting at a larger distance.
using a shadowcasting method would be a lot more efficient but I not familiar enough with the algo.
using no step value shows no difference in the TB example because something is not right and I'm not sure whats wrong
something is being treated as an int where it should be a float. I implemented this routine in a compiled language and it works
properly. You can see what's wrong by moving down a hallway and notice that one side is being lit but not the other.
also moving from a hallway into a room you see the vision is getting the angles 0 to 45 rathar than -45 to 45.

[MouseTrap]

wow!, thats nice and smooth..

[ErosOlmi]

Yes, much smoother thanks to console double buffer screen.
Anyhow I've got the best improve avoiding to stepping by 0.18 so we will need to find a way to better tune it.

Can you be so kind to tell me which is the line that round to an INT value instead of a single?
Is the following in LOS function?


x = (player.ent.mloc.X) as single + 0.5 '// Add 0.5 to simulate looking from the center of the tile.



Thanks
Eros

[MouseTrap]

Can you be so kind to tell me which is the line that round to an INT value instead of a single?

;) i'm not sure, everything looks correct.

[ErosOlmi]

I think the problem is the lack of precision in SINGLE data type.

I see some difference (better quality) using all DOUBLE variables in LOC function and leaving the FOR with just 1 to 360 without any STEPping.

I'm not sure too. It is all new to me so I'm just trying by mistake ;)

Thanks a lot for this nice script. It is very useful for me for improving some CONSOLE functions we developed a lot of time ago.

Ciao
Eros

[MouseTrap]

I think that fixed it. removing the '+ 0.5' addition to the tile seems to solve it.
it also removes the need for the fractional step.
This was a good learning experience. thanks to help from you and the other here on the forum
i've learned a lot about TB.

Thanks!

[ErosOlmi]

Thanks.
We had also great input and scripts from you ! That was great.

Remember to let us know about your feeling using thinBasic.
We appreciate even negative feelings if they are honestly expressed. We want to improve thinBasic as much as we are able so personal thoughts of people also using other programming languages are very important.

Ciao
Eros

[MouseTrap]

I changed the buffer commands into a single Flip function.
It seems that the console_box function is not benifiting from the new back buffer.
re-enabling the 'drawstats' sub doesnt work as expected.

if len(key)=2 and asc(key)=0 then
'printl asc(right$(key,1))
select case asc(key,2)
case 37
lUpdated = Update(CMD_LEFT)
case 38
lUpdated = Update(CMD_UP)
case 39
lUpdated = Update(CMD_RIGHT)
case 40
lUpdated = Update(CMD_DN)
case 27
exit while
end select

if lUpdated then

Los
Console_Cls_Buffer(sBuffer_ToWrite)
Drawmap
DrawEnt
DrawStats

flip
end if
end if

Sub Flip()
console_setactivescreenbuffer(sBuffer_Active)
sBuffer_ToWrite = iif(sBuffer_ToWrite = sBuffer_1,sBuffer_2,sBuffer_1)
sBuffer_Active = iif(sBuffer_Active = sBuffer_1,sBuffer_2,sBuffer_1)
End Sub

[MouseTrap]

I'm encountering a problem. I think i need the advice of a veteren.
Ive updated the script to add monsters.
In particular the new function added called 'MonsterLos'
If this function is called, the program no longer responds to user input. but its not stuck in a loop or anything.
Here is the script:

'------------------------
'// THIN.Hack Map test //
'// Not very optimized in some places
'------------------------


waitkey

uses "CONSOLE"
uses "sapi"
uses "math"
'sapi_setrate(109)
randomize

Console_SetScreenBufferSize(80,25)
Console_HideCursor
Console_SetTitle("THIN.Hack MapTest 0.1")


'// Commands
Const CMD_UP as long =1
Const CMD_DN as long =2
Const CMD_LEFT as long =3
Const CMD_RIGHT as long =4


'// Map
const MAPW as long = 50'100
const MAPH as long = 50'100

'// Map Tiles
Const FLOOR as long = 1
const DOOR as long =2
Const WALL as long =3
const START as long = 4
const DEST as long = 5

const MAXMONSTER as long= 32

'-------------------------------------------
Type tCell
Ctype as long '// TileType
Visible as long '// in los flag
HasSeen as long '// past los flag
Flags(4) as long '// data for whatever..
End Type
'-------------------------------------------
Type tLoc '// location type used by player,monsters, map items, ect
X as long
Y as long
End Type
'-------------------------------------------
Type tItem
X as long
Y as long
Name as string
Weapon as boolean
Armor as boolean
Dmg as long
OnUse as string '// function pointer hopefully [fp not allow, use call and name then]
iFlags(16) as long '// item details
fFlags(4) as single
Symbol as long
End Type
'-------------------------------------------
Type tEntity '// moving thing
Name as string
Symbol as string
fCol as long
mloc as tLoc
MaxHealth as long
Health as long
Items(16) as tItem
Condition as long '// bitmask
Speed as long
tmpSpeed as long
End Type
'-------------------------------------------
'-------------------------------------------
'-------------------------------------------
'-------------------------------------------

'-------------------------------------------
Type tPlayer
Ent as tEntity
End Type
'-------------------------------------------
Dim Player as tPlayer
Dim monsters(MAXMONSTER) as tEntity
#INCLUDE ONCE "THINHack_Player.tBasic"

Sub Create_Player()
player.Ent.mloc.x = MAPW/2
player.Ent.mloc.y = MAPH/2
Player.Ent.Symbol =chr$(1)
Player.Ent.fCol = 15
End Sub





Dim Map(MAPW,MAPH) as tCell

Dim OffX,OffY as long
offx=(MAPW/2)-40
offy=(MAPH/2)-12

Dim MapItems(256) as tItem

'-------------------------------------------------------------------------
Sub CreateMap()
static X,Y,I as long
for x = 1 to MAPW
for y = 1 to MAPH
Map(x,y).Ctype = WALL
Next
Next
for i=1 to 45
WallRect(rnd(2,MAPW-2),rnd(2,MAPH-2),rnd(4,MAPW/3),rnd(4,MAPH/3))
next
for i=1 to 39
RoomRect(rnd(2,MAPW-3),rnd(2,MAPH-3),rnd(4,15),rnd(4,15))
next
'map(3,4).Ctype=DEST
End Sub
'-------------------------------------------------------------------------
sub WallRect(x as long,y as long,w as long,h as long)
static i as long 'x,y,w,h as long
if X+w >= MAPW then exit sub
if Y+h >= MAPH then exit sub

for i=x to x+w
Map(i,y).Ctype = FLOOR
Map(i,y+h).Ctype = FLOOR
next
for i=y to y+h
Map(x,i).Ctype = FLOOR
Map(x+w,i).Ctype = FLOOR
next
End Sub
'-------------------------------------------------------------------------
Sub RoomRect(x as long,y as long,w as long,h as long)
static x1,y1 as long
if X+w >= MAPW then exit sub
if Y+h >= MAPH then exit sub
for x1 = x to x+w
for y1 = y to y+h
Map(x1,y1).cType = FLOOR
next
next
End Sub

Function AngleTO(X1 as long ,Y1 as long,X2 as long,Y2 as long) as long
dim dx as long = x2 - x1
dim dy as long = y2 - y1
Return mod(ATan2(dy,dx),360)
End Function

Function Distance(X1 as long,Y1 as long,X2 as long,Y2 as long) as long
Local dX,dY as long
dx=x1-x2
dy=y1-y2
Return Sqr(dx*dx + dy*dy)
End Function
'-------------------------------------------------------------------------
$CHR_178 = "#"'chr$(178)
$CHR_176 = "."'chr$(176)

Sub DrawMap()
static X,Y,X1,Y1,I as long
'static colr as long

for x = 1 to MAPW
for y = 1 to MAPH

If (inside(x-offx, 0, 80) and inside(y-offy, 0, 25) ) then
'If not ((x-offx > 80 or x-offx < 0) or (y-offy > 25 or y-offy < 0)) then


if map(x,y).HasSeen then
if map(x,y).Ctype = WALL then
PrintAT_Buffer $CHR_178,x-offx,y-offy,iif( map(x,y).Visible,10,2), sBuffer_ToWrite '// for oldschool use "#"
else 'if map(x,y).Ctype = FLOOR then
PrintAT_Buffer $CHR_176,x-offx,y-offy,iif( map(x,y).Visible,9,1), sBuffer_ToWrite '// or "."
end if
End if

end if

next
next
End Sub
'-------------------------------------------------------------------------
Sub DrawEnt()
Dim i as long
for i = 1 to MAXMONSTER
if len(Monsters(i).name) then
PrintAt_Buffer Monsters(i).Symbol,Monsters(i).mloc.x-offx,Monsters(i).mloc.y-offy,Monsters(i).fCol,sBuffer_ToWrite
endif
next
PrintAt_Buffer chr$(1), 40, 12, 15, sBuffer_ToWrite
End Sub
'-------------------------------------------------------------------------
Sub Los()
'// this reaaally crawls in TB. maybe use Oxygen to speed this up.
'// for some reason this is skipping tiles in TB, its works perfectly in other langauges though.. (cast to single not working??) >:-(
static XX,YY as long
static angle as single
static dist as single
static x as single
static y as single
static ymove as single
static xmove as single

'x = player.ent.mloc.X + 0.5
'y = player.ent.mloc.Y + 0.5

For xx = 1 To MAPW
For yy = 1 To MAPH
If Map(xx, yy).visible Then
Map(xx, yy).HasSeen = 1 '// Mark the cell as previously seen
Map(xx, yy).visible = 0
EndIf
Next
Next

For angle = 1 To 360 'Step 0.18
dist = 0
x = (player.ent.mloc.X) '+ 0.5 '// Add 0.5 to simulate looking from the center of the tile.
y = (player.ent.mloc.Y) '+ 0.5
xmove = Cos(angle)
ymove = Sin(angle)

while true
x = x + xmove
y = y + ymove
dist += 1
if some(dist >= 8, X >= MAPW, y >= MAPH, int(x) <= 0, int(y) <= 0) then exit while

Map(x, y).visible = 1
If Map(x, y).cType = WALL Then Exit while
wend
Next

End Sub
'------------------------------------------------------------------------
Function MonsterLOS(mIndex as long) as long
static XX,YY as long
static angle as single
static dist as single
static x as single
static y as single
static ymove as single
static xmove as single
static A2 as long
static A3,A4 as long
Dim Ret as long

A2 = AngleTo( Monsters(mIndex).mLoc.X,Monsters(mIndex).mLoc.Y, Player.ent.mLoc.X, Player.ent.mLoc.Y )
A3 = mod(A2-10,360)
A4 = mod(A2+10,360)

For angle = A3 To A4
dist = 0
x = Monsters(mIndex).mLoc.X '+ 0.5 '// Add 0.5 to simulate looking from the center of the tile.
y = Monsters(mIndex).mLoc.Y '+ 0.5
xmove = Cos(angle)
ymove = Sin(angle)

Do
x = x + xmove
y = y + ymove
dist += 1
if some(dist >= 8, X >= MAPW, y >= MAPH, int(x) <= 0, int(y) <= 0) then exit while

if x = Player.ent.mLoc.X and Y = Player.ent.mLoc.Y then
ret = 1
return 1
'exit do
end if
'Map(x, y).visible = 1
'If Map(x, y).cType = WALL Then Exit while
loop
Next

return 0'ret
End Function
'-------------------------------------------------------------------------
Sub UpdateMonsters()
static I as long = 1
for I = 1 to MAXMONSTER
if Len(Monsters(i).name) then
if distance(Monsters(i).mLoc.X,Monsters(i).mLoc.Y, Player.ent.mLoc.X,Player.ent.mLoc.Y) <= 8 then
if MonsterLOS(i) then
Monsters(i).fCol = 14
endif
endif
endif
Next
End Sub
'-------------------------------------------------------------------------
function Update(cmd as long)
'dim x,y, mh1 as long

Select case cmd
case CMD_UP
if Map(Player.Ent.mLoc.x,Player.Ent.mLoc.y-1).cType = FLOOR then
Player.Ent.mLoc.y -=1
offy -= 1
function = %TRUE
endif
case CMD_DN
if Map(Player.Ent.mLoc.x,Player.Ent.mLoc.y+1).cType = FLOOR then
Player.Ent.mLoc.y +=1
offy += 1
function = %TRUE
endif
Case CMD_LEFT
if Map(Player.Ent.mLoc.x-1,Player.Ent.mLoc.y).cType = FLOOR then
Player.Ent.mLoc.x -=1
offX -= 1
function = %TRUE
endif
case CMD_RIGHT
if Map(Player.Ent.mLoc.x+1,Player.Ent.mLoc.y).cType = FLOOR then
Player.Ent.mLoc.x +=1
offX += 1
function = %TRUE
endif
End Select
End function
'-------------------------------------------------------------------------
Sub DrawStats()
'// this probably wont work if the flickering cant be disabled..
Console_Box(1,21,78,3,20,20,"Stats",46,%Console_BOX_FLAG_3DOFF)
End Sub
'-------------------------------------------------------------------------

Console_SetScreenBufferSize(80, 25)

dim sBuffer_1 as long = Console_CreateScreenBuffer
dim sBuffer_2 as long = Console_CreateScreenBuffer
dim sBuffer_Active as long = sBuffer_1
dim sBuffer_ToWrite as long = sBuffer_1

console_setactivescreenbuffer(sBuffer_Active)


dim key as string
while Map(MAPW/2,MAPH/2).Ctype <> FLOOR '// find starting location
CreateMap
wend
'---------------------------------------------
Sub CreateMonster()
'// TODO: do Checks that no items or ents are already at location //
Monsters(1).Name = "Troll"
Monsters(1).fCol = 12
Monsters(1).MaxHealth = 20
Monsters(1).Health = 20
Monsters(1).speed = 1
Monsters(1).tmpSpeed = 1
Monsters(1).Symbol = "t"
dim x,y as long

Do
x= rnd(1,Mapw)
y= rnd(1,Maph)
if Map(x,y).cType = FLOOR then
Monsters(1).mLoc.X = x
Monsters(1).mLoc.Y = y
exit sub
endif
loop
End Sub
'-----------------------------------------------
Create_Player()
CreateMonster


'-------
Los
Drawmap
DrawEnt
Update(CMD_UP)
Los
Drawmap
DrawEnt

'-------
Console_SetCursorPosition(0,0)

dim lUpdated as long

while true
lUpdated = %FALSE
'Update
DOEVENTS
key = console_inkey
'if len(key) = 3 and asc(right$(key,1)) = %CONSOLE_LBUTTON then
' 'PrintAT("Mhit",0,0,15)
'endif
if len(key)=2 and asc(key)=0 then
'printl asc(right$(key,1))
select case asc(key,2)
case 37
lUpdated = Update(CMD_LEFT)
case 38
lUpdated = Update(CMD_UP)
case 39
lUpdated = Update(CMD_RIGHT)
case 40
lUpdated = Update(CMD_DN)
case 27
exit while
end select

if lUpdated then


Los
UpdateMonsters
Console_Cls_Buffer(sBuffer_ToWrite)
Drawmap
DrawEnt
DrawStats

flip

end if
end if
wend

Sub Flip()
console_setactivescreenbuffer(sBuffer_Active)
sBuffer_ToWrite = iif(sBuffer_ToWrite = sBuffer_1,sBuffer_2,sBuffer_1)
sBuffer_Active = iif(sBuffer_Active = sBuffer_1,sBuffer_2,sBuffer_1)
End Sub
'console_waitkey

[Petr Schreiber]

Hi MouseTrap,

I cannot test it because ThinHack_player file is missing.
Could you please upload it?


Petr

[MouseTrap]

I removed the reference from the script, it didnt do anything. but you will need the new console dll posted by Eros a few threads earlier.

forgot to mention:
comment/uncomment the 'MonsterLOS' functon inside 'updatemonsters' to see the difference

[Petr Schreiber]

Hi,

it complained about inproper UDT members here, I changed player.mloc to player.ent.mloc and it seems to work:


'------------------------
'// THIN.Hack Map test //
'// Not very optimized in some places
'------------------------



uses "CONSOLE"
uses "sapi"
uses "math"

'sapi_setrate(109)
randomize

Console_SetScreenBufferSize(80,25)
Console_HideCursor
Console_SetTitle("THIN.Hack MapTest 0.1")


'// Commands
Const CMD_UP as long =1
Const CMD_DN as long =2
Const CMD_LEFT as long =3
Const CMD_RIGHT as long =4


'// Map
const MAPW as long = 50'100
const MAPH as long = 50'100

'// Map Tiles
Const FLOOR as long = 1
const DOOR as long =2
Const WALL as long =3
const START as long = 4
const DEST as long = 5

const MAXMONSTER as long= 32

'-------------------------------------------
Type tCell
Ctype as long '// TileType
Visible as long '// in los flag
HasSeen as long '// past los flag
Flags(4) as long '// data for whatever..
End Type
'-------------------------------------------
Type tLoc '// location type used by player,monsters, map items, ect
X as long
Y as long
End Type
'-------------------------------------------
Type tItem
X as long
Y as long
Name as string
Weapon as boolean
Armor as boolean
Dmg as long
OnUse as string '// function pointer hopefully [fp not allow, use call and name then]
iFlags(16) as long '// item details
fFlags(4) as single
Symbol as long
End Type
'-------------------------------------------
Type tEntity '// moving thing
Name as string
Symbol as string
fCol as long
mloc as tLoc
MaxHealth as long
Health as long
Items(16) as tItem
Condition as long '// bitmask
Speed as long
tmpSpeed as long
End Type
'-------------------------------------------
'-------------------------------------------
'-------------------------------------------
'-------------------------------------------

'-------------------------------------------
Type tPlayer
Ent as tEntity
End Type
'-------------------------------------------
Dim Player as tPlayer
Dim monsters(MAXMONSTER) as tEntity


Sub Create_Player()
player.Ent.mloc.x = MAPW/2
player.Ent.mloc.y = MAPH/2
Player.Ent.Symbol =chr$(1)
Player.Ent.fCol = 15
End Sub






Dim Map(MAPW,MAPH) as tCell

Dim OffX,OffY as long
offx=(MAPW/2)-40
offy=(MAPH/2)-12

Dim MapItems(256) as tItem

'-------------------------------------------------------------------------
Sub CreateMap()
static X,Y,I as long
for x = 1 to MAPW
for y = 1 to MAPH
Map(x,y).Ctype = WALL
Next
Next
for i=1 to 45
WallRect(rnd(2,MAPW-2),rnd(2,MAPH-2),rnd(4,MAPW/3),rnd(4,MAPH/3))
next
for i=1 to 39
RoomRect(rnd(2,MAPW-3),rnd(2,MAPH-3),rnd(4,15),rnd(4,15))
next
'map(3,4).Ctype=DEST
End Sub
'-------------------------------------------------------------------------
sub WallRect(x as long,y as long,w as long,h as long)
static i as long 'x,y,w,h as long
if X+w >= MAPW then exit sub
if Y+h >= MAPH then exit sub

for i=x to x+w
Map(i,y).Ctype = FLOOR
Map(i,y+h).Ctype = FLOOR
next
for i=y to y+h
Map(x,i).Ctype = FLOOR
Map(x+w,i).Ctype = FLOOR
next
End Sub
'-------------------------------------------------------------------------
Sub RoomRect(x as long,y as long,w as long,h as long)
static x1,y1 as long
if X+w >= MAPW then exit sub
if Y+h >= MAPH then exit sub
for x1 = x to x+w
for y1 = y to y+h
Map(x1,y1).cType = FLOOR
next
next
End Sub

Function AngleTO(X1 as long ,Y1 as long,X2 as long,Y2 as long) as long
dim dx as long = x2 - x1
dim dy as long = y2 - y1
Return mod(ATan2(dy,dx), 360)
End Function

Function Distance(X1 as single,Y1 as single,X2 as single,Y2 as single) as single
Local dX,dY as single
dx=x1-x2
dy=y1-y2
Return Sqr(dx*dx + dy*dy)
End Function
'-------------------------------------------------------------------------
$CHR_178 = "#"'chr$(178)
$CHR_176 = "."'chr$(176)

Sub DrawMap()
static X,Y,X1,Y1,I as long
'static colr as long

for x = 1 to MAPW
for y = 1 to MAPH

If (inside(x-offx, 0, 80) and inside(y-offy, 0, 25) ) then
'If not ((x-offx > 80 or x-offx < 0) or (y-offy > 25 or y-offy < 0)) then


if map(x,y).HasSeen then
if map(x,y).Ctype = WALL then
PrintAT_Buffer $CHR_178,x-offx,y-offy,iif( map(x,y).Visible,10,2), sBuffer_ToWrite '// for oldschool use "#"
else 'if map(x,y).Ctype = FLOOR then
PrintAT_Buffer $CHR_176,x-offx,y-offy,iif( map(x,y).Visible,9,1), sBuffer_ToWrite '// or "."
end if
End if

end if

next
next
End Sub
'-------------------------------------------------------------------------
Sub DrawEnt()
Dim i as long
for i = 1 to MAXMONSTER
if len(Monsters(i).name) then
PrintAt_Buffer Monsters(i).Symbol,Monsters(i).mloc.x-offx,Monsters(i).mloc.y-offy,Monsters(i).fCol,sBuffer_ToWrite
endif
next
PrintAt_Buffer chr$(1), 40, 12, 15, sBuffer_ToWrite
End Sub
'-------------------------------------------------------------------------
Sub Los()
'// this reaaally crawls in TB. maybe use Oxygen to speed this up.
'// for some reason this is skipping tiles in TB, its works perfectly in other langauges though.. (cast to single not working??) >:-(
static XX,YY as long
static angle as single
static dist as single
static x as single
static y as single
static ymove as single
static xmove as single

'x = player.ent.mloc.X + 0.5
'y = player.ent.mloc.Y + 0.5

For xx = 1 To MAPW
For yy = 1 To MAPH
If Map(xx, yy).visible Then
Map(xx, yy).HasSeen = 1 '// Mark the cell as previously seen
Map(xx, yy).visible = 0
EndIf
Next
Next

For angle = 1 To 360 'Step 0.18
dist = 0
x = (player.ent.mloc.X) '+ 0.5 '// Add 0.5 to simulate looking from the center of the tile.
y = (player.ent.mloc.Y) '+ 0.5
xmove = Cos(angle)
ymove = Sin(angle)

while true
x = x + xmove
y = y + ymove
dist += 1
if some(dist >= 8, X >= MAPW, y >= MAPH, int(x) <= 0, int(y) <= 0) then exit while

Map(x, y).visible = 1
If Map(x, y).cType = WALL Then Exit while
wend
Next

End Sub
'------------------------------------------------------------------------
Function MonsterLOS(mIndex as long)
static XX,YY as long
static angle as single
static dist as single
static x as single
static y as single
static ymove as single
static xmove as single
static A2 as long
static A3,A4 as long

A2 = AngleTo( Monsters(mIndex).mLoc.X,Monsters(mIndex).mLoc.Y, Player.ent.mLoc.X, Player.ent.mLoc.Y )
A3 = mod(A2-10,360)
A4 = mod(A2+10,360)

For angle = A3 To A4
dist = 0
x = Monsters(mIndex).mLoc.X '+ 0.5 '// Add 0.5 to simulate looking from the center of the tile.
y = Monsters(mIndex).mLoc.Y '+ 0.5
xmove = Cos(angle)
ymove = Sin(angle)

while true
x = x + xmove
y = y + ymove
dist += 1
if some(dist >= 8, X >= MAPW, y >= MAPH, int(x) <= 0, int(y) <= 0) then exit while

if x = Player.ent.mLoc.X and Y = Player.ent.mLoc.Y then
return 1
end if
'Map(x, y).visible = 1
'If Map(x, y).cType = WALL Then Exit while
wend
Next

return 0
End Function
'-------------------------------------------------------------------------
Sub UpdateMonsters() as long
static I as long = 1
for I = 1 to MAXMONSTER
if Len(Monsters(i).name) then
if distance(Monsters(i).mLoc.X,Monsters(i).mLoc.Y, Player.ent.mLoc.X,Player.ent.mLoc.Y) <= 8 then
if MonsterLOS(i) then
Monsters(i).fCol = 14
endif
endif
endif
Next
End Sub
'-------------------------------------------------------------------------
function Update(cmd as long)
'dim x,y, mh1 as long

Select case cmd
case CMD_UP
if Map(Player.Ent.mLoc.x,Player.Ent.mLoc.y-1).cType = FLOOR then
Player.Ent.mLoc.y -=1
offy -= 1
function = %TRUE
endif
case CMD_DN
if Map(Player.Ent.mLoc.x,Player.Ent.mLoc.y+1).cType = FLOOR then
Player.Ent.mLoc.y +=1
offy += 1
function = %TRUE
endif
Case CMD_LEFT
if Map(Player.Ent.mLoc.x-1,Player.Ent.mLoc.y).cType = FLOOR then
Player.Ent.mLoc.x -=1
offX -= 1
function = %TRUE
endif
case CMD_RIGHT
if Map(Player.Ent.mLoc.x+1,Player.Ent.mLoc.y).cType = FLOOR then
Player.Ent.mLoc.x +=1
offX += 1
function = %TRUE
endif
End Select
End function
'-------------------------------------------------------------------------
Sub DrawStats()
'// this probably wont work if the flickering cant be disabled..
' Console_Box(1,21,78,3,20,20,"Stats",46,%Console_BOX_FLAG_3DOFF)
End Sub
'-------------------------------------------------------------------------

Console_SetScreenBufferSize(80, 25)

dim sBuffer_1 as long = Console_CreateScreenBuffer
dim sBuffer_2 as long = Console_CreateScreenBuffer
dim sBuffer_Active as long = sBuffer_1
dim sBuffer_ToWrite as long = sBuffer_1

console_setactivescreenbuffer(sBuffer_Active)


dim key as string
while Map(MAPW/2,MAPH/2).Ctype <> FLOOR '// find starting location
CreateMap
wend
'---------------------------------------------
Sub CreateMonster()
'// TODO: do Checks that no items or ents are already at location //
Monsters(1).Name = "Troll"
Monsters(1).fCol = 12
Monsters(1).MaxHealth = 20
Monsters(1).Health = 20
Monsters(1).speed = 1
Monsters(1).tmpSpeed = 1
Monsters(1).Symbol = "t"
dim x,y as long

Do
x= rnd(1,Mapw)
y= rnd(1,Maph)
if Map(x,y).cType = FLOOR then
Monsters(1).mLoc.X = x
Monsters(1).mLoc.Y = y
exit sub
endif
loop
End Sub
'-----------------------------------------------
Create_Player()
CreateMonster


'-------
Los
Drawmap
DrawEnt
Update(CMD_UP)
Los
Drawmap
DrawEnt

'-------
Console_SetCursorPosition(0,0)

dim lUpdated as long

while true
lUpdated = %FALSE
'Update
DOEVENTS
key = console_inkey
'if len(key) = 3 and asc(right$(key,1)) = %CONSOLE_LBUTTON then
' 'PrintAT("Mhit",0,0,15)
'endif
if len(key)=2 and asc(key)=0 then
'printl asc(right$(key,1))
select case asc(key,2)
case 37
lUpdated = Update(CMD_LEFT)
case 38
lUpdated = Update(CMD_UP)
case 39
lUpdated = Update(CMD_RIGHT)
case 40
lUpdated = Update(CMD_DN)
case 27
exit while
end select

if lUpdated then


Los
UpdateMonsters
Console_Cls_Buffer(sBuffer_ToWrite)
Drawmap
DrawEnt
DrawStats

flip

end if
end if
wend

Sub Flip()
console_setactivescreenbuffer(sBuffer_Active)
sBuffer_ToWrite = iif(sBuffer_ToWrite = sBuffer_1,sBuffer_2,sBuffer_1)
sBuffer_Active = iif(sBuffer_Active = sBuffer_1,sBuffer_2,sBuffer_1)
End Sub
'console_waitkey


It looks beautiful BTW ;), I like it!
Petr

P.S. Eros I think return from While/Wend does not work for now :oops:

EDIT: Added "Uses "Math"" for atan2

[MouseTrap]

your totally right about the mLoc being missing. i would think the compiler would catch that. and the Math include too.
i got it working enough to move around the map, but if monsterlos is called then the script just halts again..
oh well..

thanks for finding that.

[ErosOlmi]

P.S. Eros I think return from While/Wend does not work for now :oops:


I will have a look asap :unguee:

[MouseTrap]

I fixed all of the errors except what i think is 'return from inside a loop' issue.
I've updated the code from a few posts back.

[Lionheart008]

hallo mousetrap:) first of all you are very welcome here... and I haven't had time enough to look after your script, but what I have seen is really great, I like very much! complimento per te :-D my skills about "console" are still very bad I prefer working with "UI" and "TBGL"... but some day I will get this knowledge too 8)

thanks for the amazing script, go forward to make new ones ! :)

@petr:
in your script I have got an error in LINE 200... it's not running for me.. don't know why...?


Sub DrawEnt()
Dim i as long
for i = 1 to MAXMONSTER
if len(Monsters(i).name) then
PrintAt_Buffer Monsters(i).Symbol,Monsters(i).mloc.x-offx,Monsters(i).mloc.y-offy,Monsters(i).fCol,sBuffer_ToWrite
endif
next
PrintAt_Buffer chr$(1), 40, 12, 15, sBuffer_ToWrite
End Sub

here I have got the mistake: PrintAt_Buffer Monsters(i).Symbol,Monsters(i).mloc.x-offx,Monsters(i).mloc.y-offy,Monsters(i).fCol,sBuffer_ToWrite

wish all a good day, I was some minutes before at the dentist (over one hour horrible op)... nothing to laugh for me this whole day long... autscho :x

best regards, Lionheart

[Petr Schreiber]

Frank,

it does not run because you have not updated the thinBasic_Console DLL with the one Eros posted earlier in this thread.

[ErosOlmi]

P.S. Eros I think return from While/Wend does not work for now :oops:


I will have a look asap :unguee:


Fixed. Will be present in next release.