Recent posts

Pages1 2 3 4 5 6 7 8 9 10
#1
OxygenBasic Examples / Re: Function strMatchPattern
Last post by Charles Pegge - Yesterday at 05:33:01 PM
It is an interesting algorithm with hidden complexity. Here is one of my code serpents. :) It is in the form of a instr, and as you can see, it is considerably more complex than this AI version:

Code Select
'01/12/2023 CP

'01/12/2023
'
function instrp(int i,string s,p,int*en=0) as int
=================================================
'
'i   start position
's   string to search
'p   search string (with optional ? * wildcards
'en  boundary of found key string
'
if i<1
  i=1
endif
if not s
  return 0 'no source string
endif
if not p
  return 1 'no search string
endif
'
indexbase 1
byte bs at strptr(s) 'source string bytes
byte bp at strptr(p) 'search string bytes
int js=i      'source string position
int jp=1      'search string position
int ks=i      'next search start
int kt=i      'current search start
int kf=0      'prev key wild card position
int kg=0      'prev source wild card position
int fs=i      'possible found position
int ls=len(s) 'limit of source string
int lp=len(p) 'limit of search string
int ok=1      'vrification flag
byte ka=bp[1] 'first byte to search
do
  if jp>lp
    exit do
  endif
  if js>ls
    if jp<=lp
      ok=0
    endif
    exit do
  endif
  select bp[jp]
  case 42 '*
    ok=1
    while bp[jp]=42
      jp++
    wend
    do
      if js>ls 'end of string
        ok=1
        jp--
        exit do
      endif
      if ka=bs[js]
        ks=js
      endif
      if jp>lp 'end of pattern
        ok=1
        jp--
        exit do
      endif
      if bp[jp]=bs[js] 'possible match char
        ok=1
        jp--
        'these flags used for resuming wild card
        kf=jp
        kg=js+1
        exit do
      endif
      if bp[jp]=63 'possible match ? char
        ok=1
        jp--
        exit do
      endif
      js++
    loop
  case 63 '?
    if ka=bs[js]
      ks=js
    endif
    ok=1
    js++
  case else 'all other chars
    if bp[jp]=bs[js] 'byte match
      ok=1
      if ka=bs[js]
        ks=js
      endif
      js++
    else 'mismatch
      ok=0
      if kf
        'prev wildcard positions
        jp=kf-1
        js=kg
        kf=0
        kg=0
      else
        if ka=63
          ks=kt '?' was wildcard start
        endif
         if ks=kt
           ks++ 'nudge fwd
        endif
        kt=ks
        js=ks 'restart search
        fs=js
        jp=0
      endif
    endif
  end select
  jp++ 'next pattern byte
loop
if ok
  function=fs
else
  js=0
endif
en=js
end function
'
'test cases
===========
string s="aabcdefghijklmmnopqrstuvwxyz"
'print instrp 1,s,"ab"
'print instrp 1,s,"abz"
'print instrp 1,s,"xyz"
'print instrp 1,s,"mno"
'print instrp 1,s,"mm?o"
'print instrp 1,s,"m?o"
'print instrp 1,s,"m??"
'print instrp 1,s,"m??p"
'print instrp 1,s,"??m"
'print instrp 1,s,"*m"
'print instrp 1,s,"m*"
'print instrp 1,s,"m*z"
'print instrp 1,s,"m*k*z"
'print instrp 1,s,"m*n"
'print instrp 1,s,"a*b"
'print instrp 1,s,"a?*c"
'print instrp 1,s,"c?d"
'print instrp 1,s,"c*d"
'print instrp 1,s,"c?*e"
'print instrp 1,s,"c**f"
'print instrp 1,s,"c*??f" 'yes
'print instrp 1,s,"c*??g" 'no
'print instrp 1,s,"c??*g" 'yes
int en
'print instrp 1,s,"c??*g",en 'yes
'print en
uses console
s="abcdefghijklmmabcdefghijklmn"
int b
b=instrp(1,s,"d*lmm",en)
print b " - " en cr
print mid(s,b,en-b) cr
print instrp(1,s,"d*lmn",en) " - " en cr
print cr "ok" cr
wait
#2
OxygenBasic Examples / Re: Function strMatchPattern
Last post by Zlatko Vid - Yesterday at 05:20:12 PM
so nobody respond ...looks like a stupid question or what ?
#3
OxygenBasic / Re: GetKey
Last post by Charles Pegge - Yesterday at 04:30:18 PM
With a small mod the Ascii code (supporting esc) can be made available:

in console.inc
Code Select
  static KEY_RECORD KeyRecord
  '
  function inkey(int c=0) as int
  ================================
  static KEY_RECORD k[8]
  static int nr
  int d
  PeekConsoleInputA ConsIn,@k,8, @nr
  if nr
    if c=0
      indexbase 1
      int i
      for i=1 to nr
        if k[i].EventType=1 'KEY_EVENT
          if k[i].bKeyDown
            KeyRecord=k[i]
            d=KeyRecord.wVirtualKeyCode
            exit for
          endif
        endif
      next
    elseif GetAsyncKeyState(c)
      d=c
    endif
    FlushConsoleInputBuffer ConsIn
    return d   
  endif
  end function

test code:
Code Select
/*
  type KEY_RECORD
  ===============
    word EventType
    word wReserved
    dword bKeyDown
    word wRepeatCount
    word wVirtualKeyCode
    word wScanCode
    word wAsciiCode
    dword dwReserved
  end type
*/

uses console
string k
int a,c
do
  a=inkey
  if a
    c=KeyRecord.wAsciiCode
    k=a  ",  " c
    print k + cr
    if a=13 then break
  endif
loop

printl "end"

wait
[/cade]
#4
OxygenBasic / Re: GetKey
Last post by Nicola - Yesterday at 01:06:39 PM
Ok, but I need how the current GetKey works, which recognizes whether they are uppercase or lowercase. The only thing is that, like inkey, the ESC key code also returns.
#5
OxygenBasic / Re: GetKey
Last post by Charles Pegge - December 01, 2023, 11:09:26 PM
Yes, these are virtual keyboard codes, not ascii char codes. Almost every key has its own code, not sensitive to ctrl or shift.
#6
OxygenBasic / Re: GetKey
Last post by Nicola - December 01, 2023, 09:21:10 PM
Hi Charles
It looks like all characters are capitalized
#7
OxygenBasic Examples / Function strMatchPattern
Last post by Zlatko Vid - December 01, 2023, 06:55:42 PM
Function strMatchPattern recently posted by Theo generated by AI
do i made some stupid mistakes or i forget or something
else ..this function need array or not
in original use continue inside While loop i never saw before
is that normal ..program simply crush ?

my try:
Code Select
' Simple pattern matching function
'global vars
#lookahead
Dim in[500] as string
Dim patt[500] as string
'fn
Function strMatchPattern(s[500] as string, pattern[500] as string) as bool
    Dim sPos as int  : sPos = 1
    Dim pPos as int  : pPos = 1
    Dim sLen as int  : slen = len(s[])
    Dim pLen as int  : pLen = len(pattern[])
    Dim match as int : match = 0
    Dim star as int  : star = 0

    While sPos <= sLen
        if pPos <= pLen and (pattern[pPos] = s[sPos] or pattern[pPos] = "?") then
            pPos = pPos + 1
            sPos = sPos + 1
            goto cont
        end if

        if pPos <= pLen and pattern[pPos] = "*" then
            star = pPos
            match = sPos
            pPos = pPos + 1
           goto cont
        end if

        if star <> 0 then
            pPos = star + 1
            match += 1
            sPos = match
            goto cont
        end if

        return false
    Wend

'label
cont:

    While pPos <= pLen and pattern[pPos] = "*"
        pPos = pPos + 1
    Wend
    'fn return boolean TRUE/FALSE
    Return pPos > pLen
End Function

'call function...
in[1] = "testing" : patt[1]="test*"
print strMatchPattern( in[1] , patt[1] )
#8
OxygenBasic / Re: GetKey
Last post by Charles Pegge - December 01, 2023, 06:18:45 PM
Better!

Code Select
/*
  function GetKey() as int
  ========================
  static long blen,mode
  static byte z[4]
  GetConsoleMode ConsIn,mode
  SetConsoleMode ConsIn,0
  ReadConsole ConsIn,@z,1,@blen,null
  SetConsoleMode ConsIn,mode
  return z
  end function
*/

  ! GetAsyncKeyState lib "user32.dll" (int c) as int
  '
  function inkey(int c=0) as int
  ================================
  static KEY_RECORD k[8]
  static int nr
  int d
  PeekConsoleInputA ConsIn,@k,8, @nr
  if nr
    if c=0
      indexbase 1
      int i
      for i=1 to nr
        if k[i].EventType=1 'KEY_EVENT
          if k[i].bKeyDown
            d=k[i].wVirtualKeyCode
            exit for
          endif
        endif
      next
    elseif GetAsyncKeyState(c)
      d=c
    endif
    FlushConsoleInputBuffer ConsIn
    return d   
  endif
  end function

  function GetKey(int c=0) as int
  ===============================
  int d
  do
    d=inkey(c)
    if d
      if c
        if d=c
          return c
        endif
      else 'c=0
        return d
      endif
    endif
  loop
  end function

This supports:

if inkey(27)
...

waitkey (27)

as well as inkey() and getkey()

You can use these functions in your code, but they will be incorporated into the next console.inc
#9
OxygenBasic / Re: GetKey
Last post by Charles Pegge - December 01, 2023, 05:46:30 PM
Hi Nicola,

It's a bit sticky so I need to do some  more work on the buffering.
#10
OxygenBasic / Re: GetKey
Last post by Nicola - December 01, 2023, 05:41:50 PM
Great Charles.
That's what I wanted to tell you, to vary console.inc,
Yes, I knew inkey reported this, but I preferred GetKey as it waits for a key press before continuing.

Currently, the getkey function in console.inc looks like this:
Code Select
function GetKey() as int
========================
  static long blen,mode
  static byte z[16]
  GetConsoleMode ConsIn,mode
  SetConsoleMode ConsIn,0
  ReadConsole ConsIn,@z,1,@blen,null
  SetConsoleMode ConsIn,mode
  return z
end function
Pages1 2 3 4 5 6 7 8 9 10