v0.065 Added character creation function. There are two positions for the characters; 2D overview map position and 3D quest position (by vector3)
By the way, that previous message of mine was a question as to whether the quest is 3D or 100% 2D. I am guessing you agree that the overview map can be 2D, and the quest be 3D like in the original Total War games.
`%Project 'Untitled'%
`%Version 0.065%
`======================
Type ItemType rem Chris Tate( v0.007,v0.022) - Type in progress...
Name$
Price#
Owner
Image
Object
Description$
Action
BuildUpDelay
MinimumExperienceLevel
Endtype
Type SkillType rem Chris Tate( v0.063) - Character type in progress...
Attack#
Defense#
Speed#
Intelligence#
Accuracy#
Range#
Endtype
Type CharacterType rem Chris Tate( v0.061) - Character type in progress...
Name$
HitPoints#
Experience#
PositionVector
`Skill as SkillType
Object
Image
Sprite
IsNPC
IsCPUControlled
Group
Faction
TextColor
Endtype
Type BeepSoundsType rem Chris Tate( v0.057) - Beep sound collection type in progress...
UseItem$
GetItem$
ActivateCommand$
Error$
TextType$
Endtype
Global Dim Items() as ItemType rem Chris Tate (v0.035) - Items for the characters, enemies and who knows what
Global SoundBank as BeepSoundsType rem VisualProg (v0.060) - variable of bank
Gosub _Initialize_Sounds rem Chris Tate (v0.059) - Initialize sounds
Gosub _Initialize_Items rem Chris Tate (v0.053) - Load items call
Type BitMap_Pixel_Type Color As Integer, View As Byte EndType : Global Dim BitMap_Buffer(800,600) As BitMap_Pixel_Type rem VisualProg (v0.017) - this bitmap container, from 2D graphics
Type BeepSound_Note_Type Freq As Integer, Duration As Integer EndType : Global Dim BeepSound_Buffer(0) As BeepSound_Note_Type rem VisualProg (v0.048) - sound container
Global kernel32dll=1 : load dll "kernel32.dll",kernel32dll rem VisualProg (v0.038) kernel for sound
goto _jmp_finalFunctionBlock0001 rem VisualProg (v0.009) - form the space for code
function printf(arg_x,arg_y,arg_str$,arg_color)
ink arg_color,0 : text arg_x,arg_y,arg_str$: rem VisualProg (v0.015,v0.027)
endfunction
function printBitMap(posx,posy,width,height)
for y=0 to height
for x=0 to width : BitMap_Buffer(x,y).View=0x30
printf(posx*4+x*4,posy*4+y*4,chr$(BitMap_Buffer(x,y).View),BitMap_Buffer(x,y).Color) :
next x
next y: rem VisualProg (v0.021,v0.029) out BitMap to [x,y] read size [width,height]
endfunction
function hexToInt(arg_hex$)
local result as integer:result=0
for i=1 to len(arg_hex$):char$=(mid$(arg_hex$,i)):if (char$="1")
inc result,0x01*16^(len(arg_hex$)-i):endif
if (char$="2"):inc result,0x02*16^(len(arg_hex$)-i):endif : if (char$="3"):inc result,0x03*16^(len(arg_hex$)-i):endif
if (char$="4"):inc result,0x04*16^(len(arg_hex$)-i):endif : if (char$="5"):inc result,0x05*16^(len(arg_hex$)-i):endif
if (char$="6"):inc result,0x06*16^(len(arg_hex$)-i):endif : if (char$="7"):inc result,0x07*16^(len(arg_hex$)-i):endif
if (char$="8"):inc result,0x08*16^(len(arg_hex$)-i):endif : if (char$="9"):inc result,0x09*16^(len(arg_hex$)-i):endif
if (char$="A"):inc result,0x0A*16^(len(arg_hex$)-i):endif : if (char$="B"):inc result,0x0B*16^(len(arg_hex$)-i):endif
if (char$="C"):inc result,0x0C*16^(len(arg_hex$)-i):endif : if (char$="D"):inc result,0x0D*16^(len(arg_hex$)-i):endif
if (char$="E"):inc result,0x0E*16^(len(arg_hex$)-i):endif : if (char$="F"):inc result,0x0F*16^(len(arg_hex$)-i):endif
next i:rem VisualProg (v0.023) convert for loading TextBitMap
endfunction result
function loadBitMap12BitFromMemory(arg_bin$)
color=0 : x=-1 : y=0
repeat
if (left$(arg_bin$,1)="\") : inc y : x=-1 : arg_bin$=right$(arg_bin$,len(arg_bin$)-1) : else : if (left$(arg_bin$,1)="~") : inc x : BitMap_Buffer(x,y).Color=oldcolor : arg_bin$=right$(arg_bin$,len(arg_bin$)-1) : else : if (left$(arg_bin$,1)="*") : arg_bin$=right$(arg_bin$,len(arg_bin$)-1) : tmp=hexToInt(left$(arg_bin$,2)) : arg_bin$=right$(arg_bin$,len(arg_bin$)-2) : for i=0 to tmp : BitMap_Buffer(x+i,y).Color=oldColor : next i : inc x,tmp : else : inc x : tmp$=left$(arg_bin$,3) : color=rgb(hexToInt(mid$(tmp$,1))*0x0F,hexToInt(mid$(tmp$,2))*0x0F,hexToInt(mid$(tmp$,3))*0x0F) : BitMap_Buffer(x,y).Color=color : arg_bin$=right$(arg_bin$,len(arg_bin$)-3) : oldColor=color : endif : endif : endif
until (len(arg_bin$)<3): rem VisualProg (v0.025,0.046) loading TextBitMap12Bit
endfunction
function Beep(dwFreq,dwDuration)
call dll kernel32dll,"Beep",dwFreq,dwDuration rem VisualProg (v0.036) sound beep
endfunction
function LoadBeepSound(arg_bin$)
Undim BeepSound_Buffer(0) : Global Dim BeepSound_Buffer(0) as BeepSound_Note_Type : pos=-1
repeat
inc pos : Array Insert At Bottom BeepSound_Buffer(0)
if (left$(arg_bin$,1)="-"):arg_bin$=right$(arg_bin$,len(arg_bin$)-1):tmp=hexToInt(left$(arg_bin$,2)):BeepSound_Buffer(pos).Duration=tmp*8:BeepSound_Buffer(pos).Freq=-1:arg_bin$=right$(arg_bin$,len(arg_bin$)-2):else:tmp=hexToInt(left$(arg_bin$,2)):BeepSound_Buffer(pos).Freq=tmp*8:arg_bin$=right$(arg_bin$,len(arg_bin$)-2):tmp=hexToInt(left$(arg_bin$,2)):BeepSound_Buffer(pos).Duration=tmp*8:arg_bin$=right$(arg_bin$,len(arg_bin$)-2):endif
until (len(arg_bin$)<3) rem VisualProg (v0.050,v0.052,v0.056) - loading beepSound
endfunction
function PlayBeepSound(arg_pos,arg_len)
if (arg_len<=0) : tmp=Array Count (BeepSound_Buffer(0))-1 : else : tmp=arg_len : endif : if (arg_pos<0) : arg_pos=0 : endif : if (arg_pos>Array Count (BeepSound_Buffer(0))-1) : exitfunction : endif
for i=arg_pos to tmp
if (BeepSound_Buffer(i).Freq<>-1) : Beep(BeepSound_Buffer(i).Freq,BeepSound_Buffer(i).Duration) : else : Wait (BeepSound_Buffer(i).Duration) : endif
next i rem VisualProg (v0.054) - play beepSound
endfunction
//==--==--==--==--==--==--==--==--==--==--==
Function MakeItem(sName$,fPrice#,sDescription$,iUsageActionID,iMinExperience, iImage, iObject, iBuildUpMillisecondDelay) rem Chris Tate (v0.043) - Item creation function declaration
If sName$ = "" rem Chris Tate (v0.047) Finished item specification constructor
` Error handle TODO
ExitFunction -1
Endif
Array Insert At Bottom Items()
Local id : id = Array Count( Items())
Items(id).Name$ = sName$ : Items(id).Price# = fPrice# : Items(id).Description$ = sDescription$
Items(id).Action = iUsageActionID : Items(id).MinimumExperienceLevel = iMinExperience
Items(id).Image = iImage : Items(id).Object = iObject : Items(id).BuildUpDelay = iBuildUpMillisecondDelay
Endfunction id
//==--==--==--==--==--==--==--==--==--==--==
Function MakeCharacter(sName$,HitPoints#,Experience#, mapX#, mapY#, questPositionVector3, skill as SkillType, spriteId, objectId, iTextColor) rem Chris Tate (v0.065) - Defined character constructor function
EndFunction id
//==--==--==--==--==--==--==--==--==--==--==
_Initialize_Items: rem Chris Tate (v0.049) - Initialization of all required game items
Local sDescription$
Global SealedLetterFromFriend rem Chris Tate (v0.051) - Created sealed letter for the attention of the bartender
sDescription$ = "A sealed letter for the bartender from a friend far away"
SealedLetterFromFriend = MakeItem("Sealed Letter", 0.0, sDescription$, 0, 0, 0, 0, 0)
Return
_Initialize_Sounds: rem VisualProg (v0.058,v0.064) - initialization all sounds datas
SoundBank.UseItem$ = "3A087A08"
SoundBank.GetItem$ = "7A083A087A08"
SoundBank.ActivateCommand$ = "write you sound"
SoundBank.Error$ = "write you sound"
SoundBank.TextType$ = "write you sound"
Return
_jmp_finalFunctionBlock0001: rem VisualProg (v0.006) - start program. Above will be functions
rem TheComet (v0.005, v0.032) - (DEPRECATED) Use this to add new lines inside print statements, e.g. "this line"+nl+"is over this line"
Global CharacterName$ = "Mysterious Outlander" rem Chris Tate (v0.001)
Global CharacterPositionX#=0.0, CharacterPositionY#=0.0, CharacterPositionZ#=0.0 rem VisualProg (v0.002)
printa("{w}You, "+CharacterName$+", push open the shabby doors of the town's inn and\nenter. The dry desert dust flows around you dramatically, highlighted by the\nrays of the setting sun. The desolate chatter of drunk emotions ceases to be,\nas all eyes set on you. "+chr$(34)+"{r}What be your name, stranger?{w}"+chr$(34)+"\nthe bartender asks from across the room.{g}"):input "Enter your name ->", CharacterName$ : rem TheComet (v0.003, v0.008, v0.026) Fixed new lines, now uses printa instead of print
_try_again_idiot: rem TheComet (v0.010) For when the player is too stupid to press the given keys
For i = 1 to 4 : Print : Next i : Ink RGB(0,255,0),0 : Print "Greetings " + CharacterName$ + ", what be the purpose of your visit? " : Wait 2000 : Input "Enter reply > [D] 'Give me a drink' [S] 'Tell me a story' [W] 'I need work' [G]'I have something to give to you' "; option$ ` Chris Tate (v0.004,v0.011) Move input down a bit
Select Upper$(option$) rem Chris Tate (v0.013) Bartender reply
Case "D" `-----------------------
if (trigger_drink=0) then gosub _option_drink : global trigger_drink=1 : loadBitMap12BitFromMemory(Images_TextBitMap12Bit_GlassOfBeer$) : cls 0 : printBitMap(110,70,34,39) : set cursor 0,0 : gosub _try_again_idiot : else : printa("{w}[*You already have a drink!*]") : gosub _try_again_idiot rem VisualProg (v0.033) drink
Endcase
Case "G" `-----------------------
Gosub _something_to_give_bartender_at_start rem Chris Tate (v0.037,v0.041) Story branch related to giving the bartender something
Endcase
Case "W" `-----------------------
gosub _option_i_need_work : rem TheComet (v0.042) Call subroutine for handling "i need work" option
Endcase
Case "S" `-----------------------
Endcase
Case Default
cls 0:set cursor 0,0:printa("{r}"+chr$(34)+"Bahahahaaa!"+chr$(34)+"{w} the bartender bellowed. {r}"+chr$(34)+"Your brain cavity wouldn't\nmake a drinkin' cup for a canary!"+chr$(34)+"{w}"):goto _try_again_idiot : rem TheComet(v0.014, v0.020, v0.028) - Looks like the player is too stupid - added insults
Endcase
Endselect
printa("{l}Thank you for playing! This is the End!"):wait key:end : rem TheComet (v0.030) Not trollling - if execution reaches here, it's time to exit (as to not flow into functions and subroutines)
_option_drink: rem TheComet(v0.012) The character chose a drink!
t$="000*03222665999~888777*02877888988~A99999777555443333111000*0BFFF\000*02444BBBEEE*02EED*05EDD*02EEDEDDDDCCCBBAA988444000*0AFFF\000~333CCBEEE~EED~EEEEEDEDDDDDDCCCCBCBA*08AA9221000*09FFF\000~555DCCEEDEEEEEDDDDDDCCCBBBABA8A97A87986976875*02865~875~876433000*09FFF\000~333CBBEDD*02DDCCCBCB9A97A86986976975875864753*04653764222000*09FFF\000~333CCBEDD*02DDCCCBBA9A87986~976875865764754753~653*02764111000*09FFF\000~443CCBEDD*02DDDCCBBA9A86986~976875865764754653*03654764111000*09FFF\000~333CBBEDD*03CCBBA8A86986~876875865764754654653*03654333000*09FFF\000~333CBBEDDDDDEDD~CCBB98986~976876865765764754654653654653654~665888777767666~555333111000~FFF\000~333BBBDDD~EDD~CCBB98986976~875865765754654~653*02654~887EEE*04EDDDDD888222000FFF\000~444BBBDDC~DDD~CBBA98975875*02865765754654643*03653654766AAABABAAA*03CCCEEE888111FFF\000~443AA9BBACBADCBDDDCBA986864863864863~853753743742642~643*02544111~222*02333766CCC~333FFF\000~332643842951C96DCCBA9B84E91*02E81D81~D71C61B61A51940840741742333000*05333AAADDD444FFF\000~3326428"
t$=t$+"41A51C95DCCB98C83E91*03E81~D71~C61B50A50940840741332000*05333BBBCCC333FFF\000~433642841A61C94DCBA87C82E91~E90E91E81E91E80~D60C60A50940840741332000*05444CCCCBB222FFF\000~432642841A61C83CB9B86D81E91EA0FA0E91~E81E80~C70C60A50950840741433000*05555DDDBAA111FFF\000~432642841A61D82DA6C94EA1~FA0*02E81*02D81C70C60A50950840741433000*05666EEEAA9111FFF\000~432642841B61D81EA2E91EA1~FA0E91FA0~E91E80D80D70C60B50950840741433000*04111777EEE888000FFF\000~432642841B61D81EA2~EA1E91~E90FA0~F90E90E80D70C60B50950840741432000*04111888EEE777000FFF\000~433742851B71D81EA2~EA1~FA0~E91EA0FA0E90E81D81C61B50A50940741643000*04222999EEE666000FFF\000~432742841B71E92EA2EA1~EA0~E90E81E90*02D70*02B60A50841~653000*04333BBBDDD444000FFF\000~543752851B72D92E91D81~E90E91E81E80E90E80~C60~D70B61A51951851653000*04444CCBDDD333000FFF\000~543864A62B72C82D92D81~E80E91E80E90~E70E90D70C61C81A51A61962A73753000*04554DDCCCC222000FFF\000111544975A73C83C72D92D81E90E91~E80FA0~D71E90D70C61C81A51B72A62B83764000*04655DDDBBB111000FFF\000110654A86A83C82C72"
t$=t$+"D92E81E90EA1E91E80E91E81D70E91D71B61D91A51B72A62A83864000*03111777EEEAAA000~FFF\000111654975B83B72C82D92E91E90E91EA1E90E91~D70D81~C61D91A51B72A62A73864000*03111888EEE888000~FFF\000111654974B83B72C82D92D81E80E81E91E90~E91D70E80C71C61D91A51B72A62A84864000*03222A99FFE666000~FFF\000111654974B83B72~D92E81E90E91~E90*02D70E81C71C61C81A51B72A62B95864111000*02444BBBEEE444000~FFF\000111654975B83B72~D82E81~E91~E80~E90D70C71D71C61C81A51B72A62B94864222111434767A99EEDDDD111000~FFF\000111654974B83B72C82D82D81E91E90E91E90~F90D70D81D70C61B71A51B72A62A73963987A99BBBDDDEEEDDD777000*02FFF\000111654974B83B71C82~E81E90E91~E80E90E80D70E80D70C61C81951A62A72973974CBAEEE~CCC999545111000*02FFF\000211665974B83B72C81D81E81E80E90E81E80*02D70D71~C61C71A51A62962974~BA8999666222111000*04FFF\000211654864A83A62B71C81D71D80E80*04D70~C70B61C71951A61962874875443000*08FFF\000221654653863852951A62A51B50B61~B60~B50A50B61A50A40A50841851852875~111000*08FFF\000222654643754853863963A62A51*02A61A51A50951~A51941951852863865876766222000*08FFF"
t$=t$+"\000433543544766876987~A97~B98B97A86B97*02A87~987A87765*02665765444000*08FFF\000443433543654766877998BAACBADCBCCBDCBDDCDCC~BBABAA998887766665654665655333000*08FFF\000111333543654653764875976975A86*05976975865864754753754654333000*09FFF\000*02111433432643754986A86A75A86A75A86~A76976864753653543433222000*0BFFF\000*03332433655766A98~A97B98A97~A98A87987876765655443333111000*0BFFF\*24FFF\"
Global Images_TextBitMap12Bit_GlassOfBeer$=t$ rem VisualProg (v0.031,v0.062) - image beer - old version - 3879bytes, new version - 3498bytes
Cls : For i = 1 to 20 : Wait 20 : beerColour = Rgb(i*10,i*6,i*(5*(i>17))) : Box 0, Screen Height()-((i*1.0)*Screen Height()/25), Screen Width(), Screen Height()-(((i+1)*1.0)*Screen Height()/25), beerColour, beerColour , beerColour, beerColour : Next i : Wait 1000 rem Chris Tate (v0.016,v0.018,v0.019) - Background transition indicating the filling of beer; version 0.016; Had to reinsert because the code was incorrectly altered
Return ` You can now close your labels in the same entry
_option_tell_story: rem TheComet(v0.034) User chose for bartender to tell a story!
return
function printa(s$) :for p=0 to len(s$):c$=right$(left$(s$,p),1):if c$="{":for p2=p+1 to len(s$):c2$=right$(left$(s$,p2),1):if c2$="}":exit:endif:next p2:dec p2,1:c$=right$(left$(s$,p2),p2-p):p=p2+1:if len(c$)>1:ink hexToInt(c$),0:else:if lower$(c$)="r":ink 0xFFFF0000,0:endif:if lower$(c$)="g":ink 0xFF00FF00,0:endif:if lower$(c$)="b":ink 0xFF0000FF,0:endif:if lower$(c$)="y":ink 0xFFFFFF00,0:endif:if lower$(c$)="l":ink 0xFF00FFFF,0:endif:if lower$(c$)="m":ink 0xFFFF00FF,0:endif:if lower$(c$)="w":ink 0xFFFFFFFF,0:endif:endif:c$="":endif:if c$="\":inc p:if right$(left$(s$,p),1)="n":print :endif:c$="":endif:printc c$:next p:print : rem TheComet (v0.024) printa supports colour changes mid-sentence, and doesn't screw up DBPs internal cursor when mixing with newlines. "nl" IS DEPRECATED. Colours are specified between {} brackets, w=white, r=red, g=green, b=blue, y=yellow, m=magenta, l=lightblue. You may also specify a CAPITAL hex value, e.g. {FF00FFFF}. New lines are specified with \n.
endfunction
_something_to_give_bartender_at_start: rem Chris Tate (v0.039) Added 'I have something to give to you' story path sub routine
rem Chris Tate (v0.045) A certain item to be given
Local iTX
Local iTY
Local iVel = -1
Set Text Size 30
w = Screen Width() : h = Screen Height()
iTX = w - 60 : iTY = h - 60
While iTY => -59
Ink Rgb(40,Rnd(100)+40,0), 0
Box iTX, iTY, iTX + 60, iTY + 60
Ink Rgb(Rnd(100)+40,100,0), 50
Center Text iTX + 30, iTY + 20, "?"
Inc iTX, iVel * 60
If iTX => w Or iTX <= -59
iVel = 0-iVel
Dec iTY, 60
Endif
Wait 1
EndWhile
rem Chris Tate (v0.055) Transition into item interface; a tidy up of the screen will take place after establishment
Local tw : tw = (w*0.5)-60
Local th : th = (h*0.5)-60
Local cw#
Local ch#
Local cw : cw = w/2
Local ch : ch = h/2
Repeat
cw# = CurveValue(tw,cw#,80.0)
ch# = CurveValue(th,ch#,80.0)
Box cw-cw#,ch-ch#,cw+cw#,ch+ch#,0xFF000000,0xFF004000,0xFF000000,0xFF004000
Until cw#+1=>tw And ch#+1=>th
Box cw-tw,ch-th,cw+tw,ch+th,0xFF103000,0xFF305000,0xFF103000,0xFF305000
Return
_option_i_need_work: rem TheComet(v0.040) User chose for bartender to give him work
printa("{r}"+chr$(34)+"Work you say? Ayee..."+chr$(34)+"{w} The bartender drew out in a long, gurgling tone, apparently thinking with great effort.") : rem TheComet (v0.044) Bartender thinks about work and then leaves.
if trigger_drink
printa("{r}"+chr$(34)+"Y'all just stay put and finish your beer while ah go out back."+chr$(34)+"{w} With that, he leaves\nthrough the back door and you are left alone with the rest of the people in the inn.")
else
rem damn not enough characters
endif
return
remstart
Moderations : 0.043 - Broke down string of beer into multiple lines, and fixed various spacing issues Thanks to Green Gandalf. - 12/06/2014
remend
