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
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤