Another _Mem function program

[eoredson]

Here is my first stab at yet another _Mem function set program:

This is my first lame attempt of using _Mem functions..  

Let me know if anything needs to be added or is incorrect..

-ejo

Code: (Select All)

Rem example using _mem functions. v1.0a 01/30/2025 QB64 PD 2025.

Rem  written by Erik Jon Oredson at eoredson@gmail.com

Rem new version 2.0a adds display function.

$Checking:Off

_ScreenMove _Middle

Width 80, 25

Dim m As _MEM

Dim n As _MEM

Dim p As _Offset

Color 15

Print "Mem sample program v2.0a"

Print "Mem value(10-32767)";

Input t

If t >= 10 And t <= 32767 Then

Else

  End

End If

l$ = LTrim$(Str$(t))

l = Len(l$) ' length of mem value



' define length of memory buffer

m = _MemNew(t * l + l)

n = _MemNew(t * l + l)

p = m.TYPE



' perform the memory functions

GoSub PutMem

GoSub CopyMem

GoSub GetMem

GoSub FreeMem



' take apart the memory buffer

Color 14

Print "Display memory buffer."

Print " Memtype:"; p ' ; "("; _Bin$(p); ")"

For q = 1 To t

  z = Int(Val(Mid$(b$, (q - 1) * l + 1, l)))

  Print z;

Next

Print

x = More

Color 7

End



' store the memory buffer

PutMem:

Color 14

For q = 1 To t

  x$ = String$(l, "0")

  s$ = s$ + Right$(x$ + LTrim$(Str$(q)), l)

Next

Print "Store memory buffer."

x = Display(s$)

_MemPut m, m.OFFSET, s$

Return



' copy the memory buffer

CopyMem:

Color 14

s$ = Space$(t * l)

_MemGet m, m.OFFSET, s$

Print "Copy memory buffer."

x = Display(s$)

_MemCopy m, m.OFFSET, m.SIZE To n, n.OFFSET

Return



' read the memory buffer

GetMem:

Color 14

b$ = Space$(t * l)

_MemGet n, n.OFFSET, b$

Print "Read memory buffer."

x = Display(b$)

Return



' always clear the memory when done

FreeMem:

Color 14

Print "Free memory buffer."

_MemFree m: _MemFree n

x = More

Return



' prompt for next display

Function More

  Color 15

  Print "-more-";

  Do

      _Limit 50

      x$ = InKey$

      If Len(x$) Then

        Print

        Exit Do

      End If

  Loop

  More = -1

End Function



' prompt for next display

Function MoreX

  Color 15

  Print "-next-";

  Do

      _Limit 50

      x$ = InKey$

      If Len(x$) Then

        Print

        Exit Do

      End If

  Loop

  MoreX = -1

End Function



Function Display (o$)

  c = -1

  For d = 1 To Len(o$)

      c = c + 1

      If c >= 22 * 80 Then

        c = 0

        Print

        x = MoreX

      End If

      Color 14

      Print Mid$(o$, d, 1);

  Next

  Print

  x = More

  Display = -1

End Function

[eoredson]

This is some _Mem coding for prime numbers:

Code: (Select All)

Rem example using _mem functions with primes. v1.0a 01/30/2025 QB64 PD 2025.

Rem  written by Erik Jon Oredson at eoredson@gmail.com

$Checking:Off

_ScreenMove _Middle

Dim m As _MEM

Dim n As _MEM

Dim p As _Offset

Color 15

Print "Mem sample program v1.0a"

Print "Prime value(10-32767)";

Input t

If t >= 10 And t <= 32767 Then

Else

  End

End If



' length of mem prime value

l = GetPrime(t)

l$ = LTrim$(Str$(l))

l = Len(l$)



' define length of memory buffer

m = _MemNew(t * l + l)

n = _MemNew(t * l + l)

p = m.TYPE



' perform the memory functions

GoSub PutMem

GoSub CopyMem

GoSub GetMem

GoSub FreeMem



' take apart the memory buffer

Color 14

Print "Display memory buffer."

Print " Memtype:"; p ' ; "("; _Bin$(p); ")"

For q = 1 To t

  z = Int(Val(Mid$(b$, (q - 1) * l + 1, l)))

  Print z;

Next

Print

x = More

Color 7

End



' store the memory buffer

PutMem:

Color 14

For q = 1 To t

  w = GetPrime(q)

  x$ = String$(l, "0")

  s$ = s$ + Right$(x$ + LTrim$(Str$(w)), l)

Next

Print "Store memory buffer."

x = Display(s$)

_MemPut m, m.OFFSET, s$

Return



' copy the memory buffer

CopyMem:

Color 14

s$ = Space$(t * l)

_MemGet m, m.OFFSET, s$

Print "Copy memory buffer."

x = Display(s$)

_MemCopy m, m.OFFSET, m.SIZE To n, n.OFFSET

Return



' read the memory buffer

GetMem:

Color 14

b$ = Space$(t * l)

_MemGet n, n.OFFSET, b$

Print "Read memory buffer."

x = Display(b$)

Return



' always clear the memory when done

FreeMem:

Color 14

Print "Free memory buffer."

_MemFree m: _MemFree n

x = More

Return



' prompt for next display

Function More

  Color 15

  Print "-more-";

  Do

      _Limit 50

      x$ = InKey$

      If Len(x$) Then

        Print

        Exit Do

      End If

  Loop

  More = -1

End Function



' prompt for next display

Function MoreX

  Color 15

  Print "-next-";

  Do

      _Limit 50

      x$ = InKey$

      If Len(x$) Then

        Print

        Exit Do

      End If

  Loop

  MoreX = -1

End Function



Function Display (o$)

  c = -1

  For d = 1 To Len(o$)

      c = c + 1

      If c >= 22 * 80 Then

        c = 0

        Print

        x = MoreX

      End If

      Color 14

      Print Mid$(o$, d, 1);

  Next

  Print

  x = More

  Display = -1

End Function



Function GetPrime (Temp#)

  PrimeNumber# = Int(Temp#)

  If PrimeNumber# <= 0# Then

      Prime# = 0

  End If

  If PrimeNumber# = 1# Then

      Prime# = 2

  End If

  If PrimeNumber# > 1# Then

      PrimeCounter# = 0

      PrimeNumber# = PrimeNumber# + 1#

      Do

        Prime# = Prime# + 1

        PrimeFlag = 0

        For Factor# = 2 To Int(Sqr(Prime#))

            If Prime# / Factor# = Int(Prime# / Factor#) Then

              PrimeFlag = -1

              Exit For

            End If

        Next

        If PrimeFlag = 0 Then

            PrimeCounter# = PrimeCounter# + 1

        End If

        If PrimeCounter# = PrimeNumber# Then

            Exit Do

        End If

      Loop

  End If

  Temp# = Prime#

  GetPrime = Temp#

End Function