A PB test piece that tries to emulate random mutation on simple numbers

[hutch--]

This is a warmed over 2015 test piece to make it faster and with a larger range.

#IF 0  ' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤

    This test piece is a very simple version of random mutation. It starts with a reversed string
    of numbers and randomly replaces any of the 7 numbers one at a time then tests it against a test
    string of a predetermined order. It will run up to 10 million iterations but will exit on a
    match displaying the iteration or will show "No match found" if there is no match.

#ENDIF ' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤

    #compile exe "wrandom.exe"
    #compiler PBCC

    #include "\basic\include\win32api.inc"

FUNCTION PBmain as LONG

    LOCAL cnt as DWORD
    LOCAL rvl as DWORD
    LOCAL clk as DWORD                          ' current location for display

    st1$ = "7654321"                            ' the start string
    tst$ = "1234567"                            ' the test string

    cnt = 0                                     ' zero the counter

    conout "Emulate random mutation over 7 numbers, from 7654321 to 1234567"

    randomize                                   ' get a random seed from the timer

    ' ---------------------------------------------------------------------------
    ' for the donkeys who did not understand the original test piece, the leading
    ' and trailing random number range emulates DNA errors that occur naturally.
    ' ---------------------------------------------------------------------------
    Do
      rvl = rnd(0, 8)                           ' get a random location between 0 and 8
      char$ = format$(rnd(1, 7))                ' get a random integer string between 1 and 7
      mid$(st1$, rvl, 1) = char$                ' replace character with "char$" variable

    ' -----------------------------------------------------------------
    ' display current string + iteration count at fixed screen location
    ' -----------------------------------------------------------------
      If clk > 49 Then                          ' show every fiftieth iteration
        op$ = st1$+" - iteration "
        printat op$+str$(cnt),0,1               ' needed to provide delay for RND generator
        clk = 0
      End If

    ' ---------------------
    ' test for string match
    ' ---------------------
      If st1$ = tst$ Then
        conout "match "+st1$+" found on iteration "+str$(cnt)
        ! jmp outlbl
      End if

    ! add clk, 1
    ! add cnt, 1                                ' increment counter
    Loop while cnt < 10000000

    conout "No match found"                     ' if no match found, display result

  outlbl:

    conout "Press any key to close ...."
    waitkey$                                    ' pause so you can see the result

End FUNCTION

' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤

FUNCTION printat(text$,ByVal x as DWORD,ByVal y as DWORD) as DWORD

    #REGISTER NONE

    LOCAL hOutPut  as DWORD
    LOCAL xyVar    as DWORD
    LOCAL var      as DWORD

    GetStdHandle %STD_OUTPUT_HANDLE

  PREFIX "!"
    mov hOutPut, eax
  ; -----------------------------------
  ; make both co-ordinates into a DWORD
  ; -----------------------------------
    mov  ecx, x
    mov  eax, y
    shl  eax, 16
    mov  ax, cx
    mov var, eax
  END PREFIX

    SetConsoleCursorPosition hOutPut,var

    conout text$+"        "

End FUNCTION

' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤

DECLARE FUNCTION CO_GetStdHandle LIB "KERNEL32.DLL" ALIAS "GetStdHandle" (BYVAL nStdHandle AS DWORD) AS DWORD
DECLARE FUNCTION CO_WriteFile LIB "KERNEL32.DLL" ALIAS "WriteFile" (BYVAL hFile AS DWORD, _
                 ByVal lpBuffer AS DWORD, BYVAL nNumberOfBytesToWrite AS DWORD, _
                 ByVal lpNumberOfBytesWritten AS DWORD, ByVal lpOverlapped AS DWORD) AS LONG
                 
MACRO CO_STD_OUTPUT_HANDLE = -11&

' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤

FUNCTION conout(txt$,OPT ByVal arg as DWORD) as DWORD

  ' -------------------------------------------
  ' conout basic$       = default appends CRLF
  ' conout basic$, 0    = default appends CRLF
  ' conout basic$, 1    = non zero omits CRLF
  ' bytes_written = conout(basic$,[opt arg])
  ' -------------------------------------------

    #REGISTER NONE

    LOCAL hOutPut  as DWORD
    LOCAL bWritten as DWORD
    LOCAL slen     as DWORD
    LOCAL ptxt     as DWORD

    If arg = 0 Then
      txt$ = txt$ + $CRLF
    End if

    ptxt = StrPtr(txt$)

    PREFIX "! "
    mov eax, ptxt           ; load address into EAX
    mov eax, [eax-4]        ; get length store 4 bytes below
    mov slen, eax           ; write it to a variable
    END PREFIX

    hOutPut = CO_GetStdHandle(CO_STD_OUTPUT_HANDLE)
    CO_WriteFile hOutPut,ptxt,slen,VarPtr(bWritten),0

    FUNCTION = bWritten

END FUNCTION

' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤