History (a MRU type)

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

History (a MRU type)

Post by MrSwiss »

Hi all,

this Type is aimed at a 'Most Recently Used' implementation (MRU), which means:
  • latest entry at the lowest position (index = 0) of array (string-array)
  • at start, the pre-defined (sized) array is filled, first
  • whenever it's full, the entry at UBound() is deleted, before the new string is added
Test/Demo code included:

Code: Select all

' History_type_test2.bas -- 2018-07-13, by MrSwiss
'
' compile: -s console
'
Type History
  Private:
    As ZString Ptr  p_str   ' only for real strings (NOT binary strings!)
  Public:
    Declare Destructor()    ' we need a custom destructor here! (whenever dealing with ptr's)
    Declare Sub add_str(h() As History, ByRef n_str As Const String)    ' this is the workhorse
    Declare Sub show(ByVal row As UByte=1, ByVal col As UByte=1, ByVal fgc As UByte=7, ByVal bgc As UByte=0)
End Type

Destructor History()
    ' on destruction: free the allocated mem. (discard zstring ptr's data)
    If This.p_str <> 0 Then DeAllocate(This.p_str) : This.p_str = 0
End Destructor

Sub History.add_str( _                  ' add a new string (deleting one, if needed)
          h()   As History, _           ' array's are always ByRef (implicit, specifier NOT allowed)
    ByRef n_str As Const String _       ' read only
    )
    Dim As ULong siz = Len(n_str), lb = LBound(h), ub = UBound(h)
    ' always add new string at index: 0 (aka: at the top, in a up-counting loop)
    If h(ub).p_str <> 0 Then DeAllocate(h(ub).p_str)    ' kill the oldest string (free the mem.)
    For m As UInteger = ub To lb + 1 Step -1    ' copy ptr's values to new location (in array)
        h(m).p_str = h(m - 1).p_str     ' push all remaining, one position down (0 becomes 1 etc.)
    Next
    h(lb).p_str = CAllocate(siz + 1, 1) ' allocate cleared mem. for the new string
    *h(lb).p_str = n_str                ' copy string data --> finished
End Sub

Sub History.show( _
    ByVal row   As UByte = 1, _         ' default: top
    ByVal col   As UByte = 1, _         ' default: left
    ByVal fgc   As UByte = 7, _         ' foreground color, default: grey 
    ByVal bgc   As UByte = 0 _          ' background color, default: black
    )
    Locate row, col                     ' cursor positioning
    If fgc <> 7 OrElse bgc <> 0 Then    ' if there is/are user defined color(s): use it/them
        Color(fgc, bgc) : Print *This.p_str : Color(7, 0)   ' after use: reset to default
    Else                                ' use default console colors
        Print *This.p_str               ' dereference the ptr (to show string data)
    End If 
End Sub
' end type definition


' ===== Test/Demo code =====
' pick a random positive number, from a pre-defined range (return type = ULong)
#Define ULRange(l, h)   ( CULng(Rnd * ( (h) - (l) ) + (l)) )    ' useful for indexing

Randomize

Dim As History  hist(0 To 9)            ' fixed size array, 10 elements
Dim As String   t_str(0 To 49), _       ' fixed size array, 50 elements
                title = "*** History (a MRU type) -- Test/Demo ***"

For i As UInteger = 0 To 49             ' generate t_str() data
    If i > 9 Then                       ' occures more than below 10
        t_str(i) = " " + Str(i) + "  test-string "  ' prepend a single space
    Else
        t_str(i) = "  " + Str(i) + "  test-string " ' prepend two space's
    End If
    Rnd : Rnd : Rnd : Rnd : Rnd : Rnd   ' heat up randomizer
Next

For f As Integer = 6 To 0 Step -1       ' initialize array partly (to show it filling up)
    ' any valid index can be used below: hist(index) ... (nul is safe, always)
    hist(0).add_str(hist(), t_str(f))   ' consecutive from string-array
Next
' finished: preparing things (ready, to start main-loop)

Do
    Color 15 : Print title : Print String(Len(title), "~") : Color 7
    For i As UInteger = LBound(hist) To UBound(hist)
        hist(i).show(i + 4, 3, 14, 1)   ' any position & color's (yellow, dark-blue)
    Next
    hist(0).add_str(hist(), t_str(ULRange(0, 49)))  ' use a random chosen new string
    If Len(InKey()) > 0 Then Exit Do    ' on user action: QUIT prog.
    Sleep(2000) : Cls                   ' give some time to: 'look at it'
Loop
' clean up ...
Erase(hist) : Erase(t_str)              ' destroy array's (assures Destructor() call)
' ===== END Test/Demo code =====    ' ----- EOF -----
Last edited by MrSwiss on Jul 13, 2018 20:19, edited 1 time in total.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: History (a MRU type)

Post by dodicat »

Thank you Mr Swiss.
On the history topic,here I use a string to record.
The string is tallied (by a deliminator) to count the number of passed events and truncicated when that number is the required value.
The string is then split on the deliminator and the history array filled.

A little example for a game UDT to use this history recorder.
(not a game as such, but a demo)
set for 7 history events.

Code: Select all

 


Screenres 300,500,32
width 300\8,500\16
color , rgb(0,0,50)
cls
'=========  history stuff ================
namespace record
Function TALLY(SomeString As String,PartString As String) As Long
    Dim As Long LenP=Len(PartString),count
    Dim As Long position=Instr(SomeString,PartString)
    If position=0 Then Return 0
    While position>0
        count+=1
        position=Instr(position+LenP,SomeString,PartString)
    Wend
    Return count
End Function

Sub string_split(byval s As String,chars As String,result() As String)
    redim result(0)
    Dim As String var1,var2
Dim As long pst,LC=len(chars)
      #macro split(stri)
    pst=Instr(stri,chars)
    var1="":var2=""
    If pst<>0 Then
    var1=Mid(stri,1,pst-1)
    var2=Mid(stri,pst+LC)
    Else
    var1=stri
End if
    if len(var1) then 
    redim preserve result(1 to ubound(result)+1)
    result(ubound(result))=var1
    end if
    #endmacro
   Do
   split(s):s=var2
Loop Until var2=""
End Sub

type history
    private:
    as string s                'working string 
    as string a(any)           'store history
    as string d=chr(213,214)   'arbitary deliminator
    public:
    as long limit=6            'history length default
    declare sub push(as string)
    declare sub pop()
    declare sub show(as long=0,as long=0)
end type

sub history.push(n as string)
    if tally(s,d)>=limit then s=mid(s,instr(s,d)+len(d)) 'count deliminators, truncicate accordingly
     s+=n+d                                              'push the string
     string_split(s,d,a())                               'split on deliminator
end sub

sub history.pop()
    redim preserve a(lbound(a) to ubound(a)-1)
end sub

sub history.show(row as long,col as long)
    locate row,col
for n as long=lbound(a) to ubound(a)
    locate ,col
     print a(n)
 next
 print
end sub

'other  methods
'...

end namespace
'======================================

'===========  possible game loop ========

declare function fbmain() as long
end fbmain


sub setdice(i() as any ptr,size as long) 'create images
Type v
    As Long x,y
End Type
Dim as v p(1 To 7)
redim i(1 To 6)
Dim As Long sz=size,dt=sz/12
p(1)=Type(sz/4,sz/4)
p(2)=Type(sz/4,sz/2)
p(3)=Type(sz/4,3*sz/4)
p(4)=Type(3*sz/4,sz/4)
p(5)=Type(3*sz/4,sz/2)
p(6)=Type(3*sz/4,3*sz/4)
p(7)=Type(sz/2,sz/2)

For n As Long=1 To 6
    i(n)=Imagecreate(sz,sz,rgb(200,200,200))
    Select Case n
    Case 1
        Circle i(1),(p(7).x,p(7).y),dt,0,,,,f
    Case 2
        Circle i(2),(p(1).x,p(1).y),dt,0,,,,f
        Circle i(2),(p(6).x,p(6).y),dt,0,,,,f
    Case 3
        Circle i(3),(p(1).x,p(1).y),dt,0,,,,f
        Circle i(3),(p(7).x,p(7).y),dt,0,,,,f
        Circle i(3),(p(6).x,p(6).y),dt,0,,,,f
    Case 4
        Circle i(4),(p(1).x,p(1).y),dt,0,,,,f 
        Circle i(4),(p(3).x,p(3).y),dt,0,,,,f 
        Circle i(4),(p(4).x,p(4).y),dt,0,,,,f 
        Circle i(4),(p(6).x,p(6).y),dt,0,,,,f 
    Case 5
        Circle i(5),(p(1).x,p(1).y),dt,0,,,,f 
        Circle i(5),(p(3).x,p(3).y),dt,0,,,,f 
        Circle i(5),(p(4).x,p(4).y),dt,0,,,,f 
        Circle i(5),(p(6).x,p(6).y),dt,0,,,,f 
        Circle i(5),(p(7).x,p(7).y),dt,0,,,,f 
    Case 6
        For z As Long=1 To 6
            Circle i(6),(p(z).x,p(z).y),dt,0,,,,f 
        Next z
    End Select
Next
end sub
'framerate regulator
Function Regulate(Byval MyFps As Long,Byref fps As Long=0) As Long
    Static As Double timervalue,lastsleeptime,t3,frames
    Var t=Timer
    frames+=1
    If (t-t3)>=1 Then t3=t:fps=frames:frames=0
    Var sleeptime=lastsleeptime+((1/myfps)-T+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function

function throw(f() as any ptr,byref ret as long=0) as any ptr 'record a random image
     #define range(f,l) Int(Rnd*((l+1)-(f))+(f))
    #define s range(1,6)
    ret=s
    return f(ret)
end function

'indroduce a possible game udt
type player
    h as record.history '< ------ history field from namespace
    x as long
    y as long
    declare sub throwdie(as string,f() as any ptr)
end type

sub player.throwdie(n as string,f() as any ptr)
    dim as long r
    draw string(x,y-20),n
   for n as long=1 to 50
    dim as any ptr tmp
       tmp=throw(f(),r)
       screenlock
     put(x,y),tmp,pset
     screenunlock
     sleep regulate(60)
next n 
h.push(str(r)) 'record for history
end sub

function fbmain() as long
randomize
dim  as any ptr f()
setdice(f(),100) 'set up images 100 by 100

dim as player pl1,pl2
'fix player dice screen position
pl1.x=25
pl1.y=60

pl2.x=180
pl2.y=60
'keep 7 history values
pl1.h.limit=7
pl2.h.limit=7

do
pl1.throwdie("Player 1",f()) 'get a random image from f()
sleep 200
pl2.throwdie("Player 2",f()) '        ""
draw string(80,200),"HISTORIES"
'histories
pl1.h.show(12,5)
pl2.h.show(12,25)
sleep 500
loop until len(inkey)
return 0
end function

sleep
  
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: History (a MRU type)

Post by MrSwiss »

Hi dodicat, thank you.
I've wanted to create (an array) of the most 'simplistic' type. Going against the ones
here 'flooding' their types, with sometimes useless information(s). What I'm referring
to is: information that could otherwise be gained (i.e. a simple calculation with exis-
ting data).

Also using show() in a way, that allowes to add color(s), if so wanted (with optinal
parameters), default initialized ... (again, no need to store colors in the type itself).

Minimizing the use of CAllocate/DeAllocate as well as eliminating the need, to do
any array resizing. Using instead the flexibility offered by the use of pointers ...
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: History (a MRU type)

Post by MrSwiss »

MrSwiss wrote:Also using show() in a way, that allowes to add color(s), if so wanted (with optinal
parameters), default initialized ... (again, no need to store colors in the type itself).
There was however, something I've missed on show(), the option(s) to place the output
at row/column, which I've added in the latest version (first posts code, modified today).
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: History (a MRU type)

Post by dodicat »

There are about as many histories as rainy days in Summer.
(but not this Summer so far)
edit: tried using memcpy instead of looping.

Code: Select all

  
    
dim as string s(490)= _
{"__DATE__","__DATE_ISO__","__FB_64BIT__","__FB_ARGC__","__FB_ARGV__", _
"__FB_ARM__","__FB_ASM__","__FB_BACKEND__","__FB_BIGENDIAN__","__FB_BUILD_DATE__", _
"__FB_CYGWIN__","__FB_DARWIN__","__FB_DEBUG__","__FB_DOS__","__FB_ERR__", _
"__FB_FPMODE__","__FB_FPU__","__FB_FREEBSD__","__FB_GCC__","__FB_LANG__", _
"__FB_LINUX__","__FB_MAIN__","__FB_MIN_VERSION__","__FB_MT__","__FB_NETBSD__", _
"__FB_OPENBSD__","__FB_OPTION_BYVAL__","__FB_OPTION_DYNAMIC__","__FB_OPTION_ESCAPE__","__FB_OPTION_EXPLICIT__", _
"__FB_OPTION_GOSUB__","__FB_OPTION_PRIVATE__","__FB_OUT_DLL__","__FB_OUT_EXE__","__FB_OUT_LIB__", _
"__FB_OUT_OBJ__","__FB_PCOS__","__FB_SIGNATURE__","__FB_SSE__","__FB_UNIX__", _
"__FB_VECTORIZE__","__FB_VER_MAJOR__","__FB_VER_MINOR__","__FB_VER_PATCH__","__FB_VERSION__", _
"__FB_WIN32__","__FB_XBOX__","__FILE__","__FILE_NQ__","__FUNCTION__", _
"__FUNCTION_NQ__","__LINE__","__PATH__","__TIME__","#", _
"#ASSERT","#DEFINE","#ELSE","#ELSEIF","#ENDIF", _
"#ENDMACRO","#ERROR","#IF","#IFDEF","#IFNDEF", _
"#INCLIB","#INCLUDE","#LANG","#LIBPATH","#LINE", _
"#MACRO","#PRAGMA","#PRINT","#UNDEF","$DYNAMIC", _
"$INCLUDE","$LANG","$STATIC","ABS","ABSTRACT", _
"ACCESS","ACOS","ADD ","ALIAS","ALLOCATE", _
"ALPHA ","AND","ANDALSO","ANY","APPEND", _
"AS","ASC","ASIN","ASM","ASSERT", _
"ASSERTWARN","ATAN2","ATN","BASE","BEEP", _
"BIN","BINARY","BIT","BITRESET","BITSET", _
"BLOAD","BOOLEAN","BSAVE","BYREF","BYTE", _
"BYVAL","CALL","CALLOCATE","CASE","CAST", _
"CBOOL","CBYTE","CDBL","CDECL","CHAIN", _
"CHDIR","CHR","CINT","CIRCLE","CLASS", _
"CLEAR","CLNG","CLNGINT","CLOSE","CLS", _
"COLOR","COMMAND","COMMON","CONDBROADCAST","CONDCREATE", _
"CONDDESTROY","CONDSIGNAL","CONDWAIT","CONST","CONSTRUCTOR", _
"CONTINUE","COS","CPTR","CSHORT","CSIGN", _
"CSNG","CSRLIN","CUBYTE","CUINT","CULNG", _
"CULNGINT","CUNSG","CURDIR","CUSHORT","CUSTOM", _
"CVD","CVI","CVL","CVLONGINT","CVS", _
"CVSHORT","DATA","DATE","DATEADD","DATEDIFF", _
"DATEPART","DATESERIAL","DATEVALUE","DAY","DEALLOCATE", _
"DECLARE","DEFBYTE","DEFDBL","DEFINED","DEFINT", _
"DEFLNG","DEFLONGINT","DEFSHORT","DEFSNG","DEFSTR", _
"DEFUBYTE","DEFUINT","DEFULONGINT","DEFUSHORT","DELETE", _
"DESTRUCTOR","DIM","DIR","DO","DOUBLE", _
"DRAW","DRAW STRING","DYLIBFREE","DYLIBLOAD","DYLIBSYMBOL", _
"ELSE","ELSEIF","ENCODING","END","ENUM", _
"ENVIRON","EOF","EQV","ERASE","ERFN", _
"ERL","ERMN","ERR","ERROR","EVENT", _
"EXEC","EXEPATH","EXIT","EXP","EXPORT", _
"EXTENDS","EXTERN","FALSE","FIELD","FILEATTR", _
"FILECOPY","FILEDATETIME","FILEEXISTS","FILELEN","FIX", _
"FLIP","FOR","FORMAT","FRAC","FRE", _
"FREEFILE","FUNCTION","GET","GETJOYSTICK","GETKEY", _
"GETMOUSE","GOSUB","GOTO","HEX","HIBYTE", _
"HIWORD","HOUR","IF","IIF","IMAGECONVERTROW", _
"IMAGECREATE","IMAGEDESTROY","IMAGEINFO","IMP","IMPLEMENTS", _
"IMPORT","INKEY","INP","INPUT","INPUT$", _
"INSTR","INSTRREV","INT","INTEGER","IS", _
"ISDATE","ISREDIRECTED","KILL","LBOUND","LCASE", _
"LEFT","LEN","LET","LIB","LINE", _
"LOBYTE","LOC","LOCAL","LOCATE","LOCK", _
"LOF","LOG","LONG","LONGINT","LOOP", _
"LOWORD","LPOS","LPRINT","LSET","LTRIM", _
"MID","MINUTE","MKD","MKDIR","MKI", _
"MKL","MKLONGINT","MKS","MKSHORT","MOD", _
"MONTH","MONTHNAME","MULTIKEY","MUTEXCREATE","MUTEXDESTROY", _
"MUTEXLOCK","MUTEXUNLOCK","NAKED","NAME","NAMESPACE", _
"NEW","NEXT","NOT","NOW","OBJECT", _
"OCT","OFFSETOF","ON ERROR","ONCE","OPEN", _
"OPEN COM","OPEN CONS","OPEN ERR","OPEN LPT","OPEN PIPE", _
"OPEN SCRN","OPERATOR","OPTION()","OPTION BASE","OPTION BYVAL", _
"OPTION DYNAMIC","OPTION ESCAPE","OPTION EXPLICIT","OPTION GOSUB","OPTION NOGOSUB", _
"OPTION NOKEYWORD","OPTION PRIVATE","OPTION STATIC","OR","ORELSE", _
"OUT","OUTPUT","OVERLOAD","OVERRIDE","PAINT", _
"PALETTE","PASCAL","PCOPY","PEEK","PMAP", _
"POINT","POINTCOORD","POINTER","POKE","POS", _
"PRESERVE","PRESET","PRINT","?","PRIVATE", _
"PROCPTR","PROPERTY","PROTECTED","PSET","PTR", _
"PUBLIC","PUBLIC","PUT","RANDOM","RANDOMIZE", _
"READ","REALLOCATE","REDIM","REM","RESET", _
"RESTORE","RESUME","RESUME NEXT","RETURN","RGB", _
"RGBA","RIGHT","RMDIR","RND","RSET", _
"RTRIM","RUN","SADD","SCOPE","SCREEN", _
"SCREENCOPY","SCREENCONTROL","SCREENEVENT","SCREENGLPROC","SCREENINFO", _
"SCREENLIST","SCREENLOCK","SCREENPTR","SCREENRES","SCREENSET", _
"SCREENSYNC","SCREENUNLOCK","SECOND","SEEK","SELECT CASE", _
"SETDATE","SETENVIRON","SETMOUSE","SETTIME","SGN", _
"SHARED","SHELL","SHL","SHORT","SHR", _
"SIN","SINGLE","SIZEOF","SLEEP","SPACE", _
"SPC","SQR","STATIC","STDCALL","STEP", _
"STICK","STOP","STR","STRIG","STRING", _
"STRPTR","SWAP","SYSTEM","TAB","TAN", _
"THEN","THIS","THREADCALL","THREADCREATE","THREADDETACH", _
"THREADWAIT","TIME","TIMER","TIMESERIAL","TIMEVALUE", _
"TO","TRANS","TRIM","TRUE","TYPE", _
"TYPEOF","UBOUND","UBYTE","UCASE","UINTEGER", _
"ULONG","ULONGINT","UNION","UNLOCK","UNSIGNED", _
"UNTIL","USHORT","USING","VA_ARG","VA_FIRST", _
"VA_NEXT","VAL","VALLNG","VALINT","VALUINT", _
"VALULNG","VAR","VARPTR","VIEW","VIRTUAL", _
"WAIT","WBIN","WCHR","WEEKDAY","WEEKDAYNAME", _
"WEND","WHILE","WHEX","WIDTH","WINDOW", _
"WINDOWTITLE","WINPUT","WITH","WOCT","WRITE", _
"WSPACE","WSTR","WSTRING","XOR","YEAR", _
"ZSTRING"}
#include "crt.bi"

type history
 redim as string a(1 to 10)
 declare sub setlimit(as long)
 declare sub push(as string)
 declare sub show(as long=1,as long=1)
end type

sub history.setlimit(n as long)
 redim preserve a(1 to n)
end sub


sub history.push(s as string)
    memcpy(@a(1),@a(2),(ubound(a)-1)*sizeof(string))
    Clear a(ubound(a)), 0, Sizeof(a(ubound(a)))
    a(ubound(a))=s
end sub

'sub history.push(s as string)
 'for n as long=0 to ubound(a)-2
 '(@a(1))[n]=(@a(2))[n]
 'next
 'a(ubound(a))=s
'end sub

sub history.show(row as long,col as long)
 locate row,col
for n as long=lbound(a) to ubound(a)
 locate ,col
 if len(a(n)) then print a(n)
 next
 print
end sub

dim as history h,i,j
'h limit is default 10
i.setlimit(7)
j.setlimit(15)



#define range(f,l) Int(Rnd*((l+1)-(f))+(f))
dim as long g
do
 cls
h.push(str(g))
i.push(str(sqr(10*g)))
j.push s(range(0,490))
color 6
h.show(3,2)
color 7
i.show(3,12)
color 15
j.show(3,40)
g+=1
sleep 500
loop until inkey=chr(27)



 
  
  
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: History (a MRU type)

Post by MrSwiss »

Hi all,

here goes Revision 2, of the History ...

Changes:
  • instead of a single ZString Ptr, an array of those
  • additionally: array bounds saved in type
Test/Demo code changes are:
2 x History (dimmed) + 1 History Ptr (used: New/Delete keywords)

See also, comments in code:

Code: Select all

' History_type_test4.bas -- 2018-07-17, by MrSwiss, rev. 2
'
' compile: -s console
'
Type History                            ' a MRU type (most recently used)
  Private:
    As ZString Ptr  psz(Any)            ' only for real strings (NOT binary strings!)
    As Long         lb, ub              ' stores arrays bounds (lower/upper)
  Public:
    Declare Destructor()                ' we need a custom destructor here! (whenever dealing with ptr's)
    Declare Sub init(ByVal lba As Long=0, ByVal uba As Long=9, ByRef nst As Const String="")
    Declare Sub add_str(ByRef nst As Const String)    ' this is the workhorse
    Declare Sub show(ByVal row As UByte=1, ByVal col As UByte=1, ByVal fgc As UByte=7, ByVal bgc As UByte=0)
    Declare Sub get_bds(ByRef lba As Long=0, ByRef uba As Long=0)   ' get currently set bounds
End Type

Destructor History()
    With This   ' on destruction: free the allocated mem. (discard all zstring ptr's data)
        For i As Integer = .lb To .ub
            If .psz(i) <> 0 Then DeAllocate(.psz(i))
        Next
        Erase(.psz)                     ' delete ptr array
    End With
End Destructor

Sub History.init( _                     ' initializer (must be called first, before other use)
    ByVal lba   As Long=0, _            ' lower bound, default 0
    ByVal uba   As Long=9, _            ' upper bound, default 9
    ByRef nst   As Const String="" _    ' initial string (if any), read only
    )
    If lba > uba Then Swap lba, uba     ' assure correct array sizing (lower to upper bound)
    With This
        .lb = lba : .ub = uba : ReDim .psz(.lb To .ub)  ' save bounds, init the ptr array
        If Len(nst) > 0 Then            ' if there is a string, allocate memory & copy it
            .psz(lb) = Allocate(Len(nst) + 1)
            *.psz(lb) = nst + Chr(0)    ' add terminator (if allocated memory isn't cleared)
        End If
    End With
End Sub

Sub History.add_str( _                  ' add a new string (deleting one, if needed)
    ByRef nst   As Const String _       ' string to add, read only
    )
    With This   ' always add new string at lower bound (aka: at the top, in a up-counting loop)
        If .psz(.ub) <> 0 Then DeAllocate(.psz(.ub))' kill the oldest string (free the memory)
        For m As Integer = .ub To .lb + 1 Step -1   ' copy ptr's values to new location (in array)
            .psz(m) = .psz(m - 1)       ' push all remaining, one position down (0 becomes 1 etc.)
        Next
        .psz(.lb) = Allocate(Len(nst) + 1)  ' allocate memory for the new string
        *.psz(.lb) = nst + Chr(0)       ' copy string data & terminator
    End With
End Sub

Sub History.show( _                     ' display the ptr arrays data (strings)
    ByVal row   As UByte = 1, _         ' default: top
    ByVal col   As UByte = 1, _         ' default: left
    ByVal fgc   As UByte = 7, _         ' foreground color, default: grey 
    ByVal bgc   As UByte = 0 _          ' background color, default: black
    )
    Locate row, col                     ' cursor positioning (top/left pos.)
    With This
        If fgc <> 7 OrElse bgc <> 0 Then    ' if there is/are user defined color(s): use it/them
            Color(fgc, bgc)
            For n As Integer = .lb To .ub : Locate , col : Print *.psz(n) : Next
            Color(7, 0)                 ' after use: reset to default
        Else                            ' use default console colors
            For n As Integer = .lb To .ub : Locate , col : Print *.psz(n) : Next
        End If
    End With
End Sub

Sub History.get_bds( _
    ByRef lba   As Long=0, _
    ByRef uba   As Long=0 _
    )
    lba = This.lb : uba = This.ub
End Sub
' end type definition


' ===== Test/Demo code =====
' pick a random number, from a pre-defined range (return type = Long)
#Define LRange(l, h)   ( CLng(Rnd * ( (h) - (l) ) + (l)) )

Randomize

Dim As History  hist1, hist2            ' 2 History Types (uninitialized)
Dim As String   t_str(0 To 49), _       ' fixed size array, 50 elements
                title = "*** History (a MRU type, rev. 2) -- Test/Demo (with: Ptr) ***"

For i As UInteger = 0 To 49             ' generate t_str() data
    If i > 9 Then                       ' occures more than below 10
        t_str(i) = " " + Str(i) + "  test-string "  ' prepend a single space
    Else
        t_str(i) = "  " + Str(i) + "  test-string " ' prepend two space's
    End If
    Rnd : Rnd : Rnd : Rnd : Rnd : Rnd   ' heat up randomizer
Next

Var ph0 = New History                   ' a 'New' History Ptr (default ctor call)
ph0->init                               ' defaults: index 0 .. 9, no string
hist1.init(-6, -1, "Long")              ' any sort of index possible
hist2.init( 1, 16, "Double")            ' a 'one' based array

For f As Integer = 6 To 0 Step -1       ' initialize array partly (to show it filling up)
    ph0->add_str(t_str(f))              ' consecutive from string-array
Next
' finished: preparing things (ready, to start main-loop)

Do
    Locate ,, 0                         ' cursor OFF | below: title & underline
    Color 15 : Print title : Print String(Len(title), "~") : Color 7
    ph0->show ( 4,  3, 14,  1)          ' any position & color's: yellow, dark-blue
    hist1.show( 4, 30, 15,  2)          ' white, green
    hist2.show( 4, 45, 12)              ' bright red, black (= default)
    ph0->add_str (t_str(LRange(0, 49))) ' use a random chosen new string (from array)
    hist1.add_str(Str(LRange(-100000, 100000))) ' use a random chosen new Long
    hist2.add_str(Str(Sqr(LRange(4, 10000))))   ' use a random chosen new Double
    Locate 22, 1, 1 : Print "press a key, to EXIT ... ";
    If Len(InKey()) > 0 Then Exit Do    ' on user action: QUIT prog.
    Sleep(500) : Cls                    ' give some time to: 'look at it'
Loop
' clean up ...
Erase(t_str) : Delete(ph0)              ' destroy string array | destroy History ptr
' ===== END Test/Demo code =====    ' ----- EOF -----
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: History (a MRU type)

Post by MrSwiss »

A quick fix of the Destructor ...

In the unlikely event of a declared, but uninitialized History, the Destructor
could possibly cause a crash, on program exit ...

Just replace with the Destructor below:

Code: Select all

Destructor History()    ' on destruction: free the allocated mem. (discard all zstring ptr's data)
    With This                           ' exit on a uninizialized array
        If LBound(.psz) = 0 AndAlso UBound(.psz) = -1 Then Exit Destructor
        Erase(.psz)                     ' delete ptr array (freeing allocated memory)
    End With
End Destructor
Post Reply