Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 04/09/2014 in all areas

  1. Use this : $list = GUICtrlCreateList("",100,0,200,200, BitOr($WS_BORDER, $WS_VSCROLL) )
    1 point
  2. jguinch

    Lottery - Challenge

    czardas, there is no winner, because Guiness did no play ...
    1 point
  3. mikell

    Remove string between numbers

    $str = "<tr> <td>30/09/2013</td> <td> 69Â 290 </td> <td> 9Â 980 </td> <td></td> </tr> <tr> <td>30/09/2012</td> <td> 46Â 350 &euro; </td> <td> 1Â 280 </td> <td></td> </tr> <tr> <td>30/09/2011</td> <td> 12Â 030 </td> <td> 20Â 260 </td> <td></td> </tr> </tbody> </table>" $res = StringRegExpReplace($str, '\h*(\d+)[^\d/]+(\d+)[^<]*', '$1$2') msgbox(0,"", $res) ?
    1 point
  4. It is a really strange question but just in case... $JOE = "192.168.1.45" $BOB = "192.168.1.34" $USERSTR = "ifconfig $BOB netmask 255.255.255.0" $aSearchVariable = StringRegExp($USERSTR, "(\$.*?) ", 1) $newip = Execute($aSearchVariable[0]) $new = StringRegExpReplace($USERSTR, "(\$.*?) ", $newip & " ") MsgBox(0, "IP", $new) Keep in mind that there is no error checks at all. Cheers, sahsanu
    1 point
  5. Maybe you can use AutoItSetOption ( "ExpandVarStrings" , 1) AutoItSetOption ( "ExpandVarStrings" , 1) $BOB = "192.168.1.34" $USERSTR = "ifconfig $BOB$ netmask 255.255.255.0" MsgBox(0, "IP", $USERSTR)
    1 point
  6. Try this John: #include <GDIPlus.au3> #include <GUIConstantsEx.au3> #include <StaticConstants.au3> #include <WinAPIEx.au3> #include <Memory.au3> _GDIPlus_Startup() Local $Base64String $Base64String &= 'iVBORw0KGgoAAAANSUhEUgAAADwAAAAtCAMAAADFqPh+AAAABGdBTUEAALGPC/xhBQAAAAFzUkdCAK7OHOkAAAAgY0hSTQAAeiYAAICEAAD6AAAAgOgAAHUwAADqYAAAOpgAABdwnLpRPAAAAYNQTFRFAAAK/fnu7+vj1dPPxMPOq6usp6enm5ucpaWk6+jg6ebfn5+glZWYf36ESklkJiYzHR0pBQUPAAAJGxsnJiYxi4uPr6+w4d7Ze3qFFxckSUl2W1u9ZWXGbGzncXHvXl69ray2RERlcHDtExMf9fHoTExrSkmIaGjhdHTmkZHeoKDlqqrrsLDtiYnao6Oi+vbskJCUOjprZ2fXwcHsISEu+fXrSEiauLjvTEy9V1fAnJzjr6/sl5fgUFC+pqbooaGhQkKqZWXNQkK1MzOWRUW4c3PKe3vSMzOdNzdz0M7PhISJJCQwNTWGMTGqjo3VLi6q//vw5OHcyMfPKyuolJPPCgoUIyOeJSWgc3PD29nVHh6YnZ3FGBiUHByWMTGkERGPExORIiKbCQmJDAyLFRWTAABpBgaGAAB2AABkPz9nAAB/AABwAABdAABRAAB6AABHDQ0XAABFFRUmAAA3AAAyAAA9AABWAAAvAABSAAAtAAAnEBAaAAAhAAAbAAAVAAARAAAKMwwy/wAAAAF0Uk5TAEDm2GYAAAABYktHRACIBR1IAAAACXBIWXMAAABIAAAASABGyWs+AAADUklEQVRIx5XW61/SUBgH8DHGNmEbm8BpA4zVFC8FAoENyzBCUzFFS0uNtAsZicGYRGaXf71tXISxzfV9yXl+fM52tj0PBOk4YCfiQjE93IU4xxyQJTfiIUjKSzPjw3x+KgBcHmTMPHoLECzNBUPhids6E+FIkPaxPA5M4mMgQHF3QndNRe4IFIojkwZZJzYlRKcnZmbn7t03cm8udnc6KrBI3K2PzvMJfzI1PTP3wMrcTCqZ5uPO4WwGkL6FVGr24U1mUws+Ah9KT7pIn5jNLj662eOsyBHoQNoByLS4tBR7YkdsSfQmctfXjQToZVEMLdrzVMzTHjzTO16MflYoFFZm7VktFJ4LAOneaJRK5hWrMZuU2jUK72x8fYPOa2G71OJiAminlCtuvlCt9MS2ViypxZvpuPqgOsn0tiYb7los7TxaCZvKatXFwK4SBtTaS00+1PWqVCo51l9FQsbyWvUaFXdAMLa33/G6IHZslTSZh29EA4XXnfK9HAwdbBQPu/aXO1ZLPTtH2WW9/W61N7AOIVTybU95+51mIXHQz++uvhu0Xe4VJykEAt7D476T8nvNYTlI7PTiGT7yvqd80q899LsglP7wcdDxySfNSSVIuPvb3yqrPx0PFn7w4RDGfDZz+qWKjXXjb0eXGQzCxr9aOKsFPbAaPv82sjauhJnTb1Y+hhE1XB+pOlXCcaFyai7Ez3e2XT/TL1UaOQhN185MLBxl+gcmVfSrNRqHeKpZMRI9gntJd8ArSyMFzSoPOdnmlxGbW/1TdvBTslyvjdY0WScEE0xNZ/P6+VL++qJ1XjPCEMo7iXul78Mi3SRMJNty/bsxyZtT+t46KfwYFtWiSLDdbtV/mGmS6vuc8fil8yFK+IClLy9a9XNTkj8Oq9+hXdJXHxL1VH9eylLdCseCztcTrwrSELndkqw1q3i3194iOLn1X2QBQ/odY+NK/h8XQgKdvO5VLNe+sK3NsfjAgDDvYrlL2zgSPdD1Z074aUuDC6C67u4AiSL9ywa66NJPBmrL8kw1fL9v0GywPDoykyhgkKCuaOaPKYa+ooDxNKTNYdgULfjTjb8j9tJ+gWYBCizGuB3EgxlMgIwyAZIAWE6A2p0znj3jyuzp1s+e/wA7MayZVXjA0AAAACJ0RVh0Y29tbWVudAAiQ3JlYXRlZCB3aXRoIENoaW1wbHkuY29tIiIEkkgAAAAldEVYdGRhdGU6Y3JlYXRlADIwMTQtMDQtMDlUMDc6MDM6NDgt' $Base64String &= 'MDQ6MDBqEUZ/AAAAJXRFWHRkYXRlOm1vZGlmeQAyMDE0LTA0LTA5VDA3OjAzOjQ4LTA0OjAwG0z+wwAAAABJRU5ErkJggg==' $hHBITMAP = _GDIPlus_BitmapCreateFromMemory(Binary(_Base64Decode($Base64String)), True) $aDim = _WinAPI_BitmapGetDim($hHBITMAP) Local $iH = $aDim[0] Local $iW = $aDim[1] Global Const $hGUI = GUICreate("Test", 300, 200), $STM_SETIMAGE = 0x0172 GUISetBkColor(0xfffbf0) Global Const $iPic = GUICtrlCreatePic("", 10, 10, $iW, $iH) _WinAPI_DeleteObject(GUICtrlSendMsg($iPic, $STM_SETIMAGE, $IMAGE_BITMAP, $hHBITMAP)) GUISetState() Do Switch GUIGetMsg() Case $GUI_EVENT_CLOSE _Exit() Case $iPic MsgBox(0, "Test", "Button was pressed") EndSwitch Until False Func _Exit() _WinAPI_DeleteObject($hHBITMAP) _GDIPlus_Shutdown() GUIDelete() Exit EndFunc ;==>_Exit Func _WinAPI_BitmapGetDim($hHBitmap) Local $tDim = DllStructCreate($tagBITMAP) DllCall("gdi32.dll", "int", "GetObject", "int", $hHBitmap, "int", DllStructGetSize($tDim), "struct*", $tDim) If @error Then Return SetError(1, 0, 0) Local $aDim[2] = [$tDim.bmWidth, $tDim.bmHeight] Return $aDim EndFunc Func _Base64Decode($sB64String) Local $struct = DllStructCreate("int") Local $a_Call = DllCall("Crypt32.dll", "int", "CryptStringToBinary", "str", $sB64String, "int", 0, "int", 1, "ptr", 0, "ptr", DllStructGetPtr($struct, 1), "ptr", 0, "ptr", 0) If @error Or Not $a_Call[0] Then Return SetError(1, 0, "") Local $a = DllStructCreate("byte[" & DllStructGetData($struct, 1) & "]") $a_Call = DllCall("Crypt32.dll", "int", "CryptStringToBinary", "str", $sB64String, "int", 0, "int", 1, "ptr", DllStructGetPtr($a), "ptr", DllStructGetPtr($struct, 1), "ptr", 0, "ptr", 0) If @error Or Not $a_Call[0] Then Return SetError(2, 0, "") Return DllStructGetData($a, 1) EndFunc ;==>_Base64Decode Br, UEZ
    1 point
  7. mLipok

    Lottery - Challenge

    Good question. but ultimately http://www.youtube.com/watch?v=04854XqcfCY&feature=kp
    1 point
  8. I think I found the bug! Please change line Local $aFolder = _OL_FolderAccess($oOL, "", $olFolderOutbox) in function _OL_Wrapper_SendMail Local $aFolder = _OL_FolderAccess($oOL, "", $olFolderDrafts) and the message will get sent even when Outlook was not running.
    1 point
  9. Mat

    Lisp

    I haven't done much with AutoIt recently, and had some hours spare waiting for game of thrones, so I started this. Ended up being quite fun so I finished it this afternoon. Currently the following are available: defun quote append rest first second third last butlast listp null list-length * + - / ceiling floor round random if = < <= > >= mapcar eval All the definitions and tests are taken from this page: http://jtra.cz/stuff/lisp/sclr/ If you want some examples that work: (defun foo (x) (if (= (second (ceiling x 2)) 0) (+ x 10) (- x 10))) (mapcar 'foo '(1 2 3 4 5)) That defines a function 'foo' that takes one input 'x'. If x is odd then it subtracts 10, and if its even then adds 10. It then applies it to a list (mapcar), so the result is the list, with each value having had foo called on it. #include <Array.au3> ; _ArrayDisplay, _ArraySearch ; Car Type constants. Do NOT use these, use the wrapping functions instead. Global Enum $CT_LIST, $CT_ATOM ; Memory. Do not access directly, use the mem* functions. Global $_MEMORY[1000][3] = [[0, 0, 0]] ; car type, car, cdr Global Const $nil[2] = [$CT_LIST, 0] #cs ; An example of building a list, and evaluating it. ; In this case we evaluate: ; ; (if (= 1 2) 3 (* 4 5)) $mul = consAllocAtom("*") $l = listPushAtom($mul, "4") listPushAtom($l, "5") $eq = consAllocAtom("=") $l = listPushAtom($eq, "1") listPushAtom($l, "2") $if = consAllocAtom("if") $l = listPushList($if, $eq) $l = listPushAtom($l, "3") listPushList($l, $mul) $list = consAllocList($if) listPrint($list) Local $callstack = 0 Local $result = lispEval($callstack, $list), $error = @error, $extended = @extended ConsoleWrite("> " & listToStr($result) & @LF & "Error: " & $error & ", Extended: " & $extended & @LF) If $error Then memDisplay() #ce #cs ; Example of callstack, defun and calling user defined functions. ; ; (defun test () 3) ; ; (defun foo (a b c) (+ a b c)) ; ; (foo 1 (* 2 test) 4) Local $callstack = callstackCreate() $defun = consAllocAtom("defun") listPushAtom($defun, "test") listPushList($defun, 0) listPushAtom($defun, "3") $list = consAllocList($defun) listPrint($list) Local $result = lispEval($callstack, $list), $error = @error, $extended = @extended ConsoleWrite("> " & listToStr($result) & @LF & "Error: " & $error & ", Extended: " & $extended & @LF) If $error Then memDisplay() $param_list = consAllocAtom("a") listPushAtom($param_list, "b") listPushAtom($param_list, "c") $func_body = consAllocAtom("+") listPushAtom($func_body, "a") listPushAtom($func_body, "b") listPushAtom($func_body, "c") $defun = consAllocAtom("defun") listPushAtom($defun, "foo") listPushList($defun, $param_list) listPushList($defun, $func_body) $list = consAllocList($defun) listPrint($list) Local $result = lispEval($callstack, $list), $error = @error, $extended = @extended ConsoleWrite("> " & listToStr($result) & @LF & "Error: " & $error & ", Extended: " & $extended & @LF) If $error Then memDisplay() $mul = consAllocAtom("*") $l = listPushAtom($mul, "2") listPushAtom($l, "test") $code = consAllocAtom("foo") listPushAtom($code, "1") listPushList($code, $mul) listPushAtom($code, "4") $list = consAllocList($code) listPrint($list) Local $result = lispEval($callstack, $list), $error = @error, $extended = @extended ConsoleWrite("> " & listToStr($result) & @LF & "Error: " & $error & ", Extended: " & $extended & @LF) If $error Then memDisplay() #ce #cs ; Tests the lexer and parser ; ; (foo 1 (* 2 test) 4) $lexer = lexerCreate("(foo 1 '(* 2 test) ""This is a String"")") While 1 $t = lexerGetToken($lexer) If $t = "" Then ExitLoop ConsoleWrite($t & " ") WEnd ConsoleWrite(@LF) $lexer = lexerCreate("(foo 1 '(* 2 test) ""This is a String"")") Local $list = parserParse($lexer) ConsoleWrite("> " & listToStr($list) & @LF) #ce ; Example of using a read-eval-loop ; ; Uses InputBox to read user input, and MsgBox to show the result. relGo(reader, writer) Func reader() Local $ret = InputBox("Enter line", "Press cancel to stop rel.") If @error Then Return SetError(1) Return $ret EndFunc ;==>reader Func writer($str) MsgBox(0, "Test", $str) EndFunc ;==>writer #Region Read-Eval-Loop Func relGo($reader, $writer) Local $line, $result, $error, $extended Local $callstack = callstackCreate() While 1 $line = Call($reader) If @error Then ExitLoop If $line = "" Then ContinueLoop $result = relEval($callstack, $line) $error = @error $extended = @extended If Not $error Then Call($writer, listToStr($result)) Else Call($writer, "Error: " & $error & ", Extended: " & $extended) EndIf WEnd EndFunc ;==>relGo Func relEval(ByRef $callstack, $line) Local $lexer = lexerCreate($line) Local $list = parserParse($lexer) If @error Then Return SetError(@error, @extended, 0) ; Parser or Lexer threw an error ConsoleWrite($line & @LF) ConsoleWrite("> " & listToStr($list) & @LF) Local $result = lispEval($callstack, $list) Return SetError(@error, @extended, $result) EndFunc ;==>relEval #EndRegion Read-Eval-Loop #Region Lexer ; Currently very very very basic. Does the job though. ; Creates a lexer. Func lexerCreate($str) Local $lexer[6] $lexer[0] = $str ; Data $lexer[1] = 1 ; Line $lexer[2] = 1 ; Column $lexer[3] = 1 ; Absolute $lexer[4] = "" ; Name. $lexer[5] = 0 ; Tail. Return $lexer EndFunc ;==>lexerCreate ; Gets the next token from the lexer. Func lexerGetToken(ByRef $lexer) If IsArray($lexer[5]) Then Return lexerGetToken($lexer[5]) ; Currently this is the most basic lexer possible. ; All tokens are 1 character, whitespace is ignored. Local $c, $tok ; Ignore leading whitespace Do $c = _lexerGetChar($lexer) Until Not StringIsSpace($c) Local Enum $stNone = 0, $stString, $stInt, $stSymbol, $stFloat Local $st = 0 While 1 Switch $st Case $stNone Select Case '' $tok = "" ExitLoop Case $c = '(' Or $c = ')' Or $c = '.' Or $c = '''' $tok = $c ExitLoop Case $c = '"' $st = $stString Case StringIsDigit($c) $tok = $c $st = $stInt Case Not StringRegExp($c, "[^[:graph:]]") $tok = $c $st = $stSymbol Case Else ConsoleWrite("Invalid character: '" & $c & "'." & @LF) Return SetError(200, 0, 0) ; Invalid character. EndSelect Case $stString If $c = '\' Then ; Escape Sequence $c = _lexerGetChar($lexer) Switch $c Case '\' $tok &= '\' Case 'n' $tok &= @CRLF Case 't' $tok &= @TAB Case '"' $tok &= '"' Case Else ConsoleWrite("Unknown escape sequence: '\" & $c & "'" & @LF) Return SetError(201, 0, 0) ; Unknown escape sequence EndSwitch ElseIf $c = '"' Then ExitLoop Else $tok &= $c EndIf Case $stSymbol If $c = ')' Then _lexerPutbackChar($lexer, $c) ExitLoop ElseIf StringIsSpace($c) Or $c = '' Then ExitLoop ElseIf Not StringRegExp($c, "[^[:graph:]]") Then $tok &= $c Else ConsoleWrite("Invalid character: '" & $c & "'." & @LF) Return SetError(200, 0, 0) ; Invalid character. EndIf Case $stInt If StringIsDigit($c) Then $tok &= $c ElseIf $c = '.' Then $tok &= $c $st = $stFloat ElseIf $c = ')' Then _lexerPutbackChar($lexer, $c) ExitLoop ElseIf StringIsSpace($c) Or $c = '' Then ExitLoop Else ConsoleWrite("Invalid character: '" & $c & "'." & @LF) Return SetError(200, 0, 0) ; Invalid character. EndIf Case $stFloat If StringIsDigit($c) Then $tok &= $c ElseIf $c = ')' Then _lexerPutbackChar($lexer, $c) ExitLoop ElseIf StringIsSpace($c) Or $c = '' Then ExitLoop Else ConsoleWrite("Invalid character: '" & $c & "'." & @LF) Return SetError(200, 0, 0) ; Invalid character. EndIf EndSwitch $c = _lexerGetChar($lexer) WEnd Return $tok EndFunc ;==>lexerGetToken Func _lexerPutbackChar(ByRef $lexer, $c) _lexerGetChar($lexer, $c) EndFunc ;==>_lexerPutbackChar ; Gets the next character from the stream, and increments counters. ; CRLF is treated as 1 character. Func _lexerGetChar(ByRef $lexer, $cLast = '') Local $c = StringMid($lexer[0], $lexer[3], 1) Local Static $cPrev = '' If $cLast <> '' Then $cPrev = $cLast Return EndIf If $cPrev <> '' Then $c = $cPrev $cPrev = '' Return $c EndIf If $c = "" Then ; Out of bounds. Return "" EndIf If $c = @CR Then ; Check for LF If StringMid($lexer[0], $lexer[3] + 1, 1) = @LF Then $c = @CRLF $lexer[3] += 1 EndIf EndIf If StringInStr(@CRLF, $c) Then ; Newline $lexer[1] += 1 $lexer[2] = 1 Else $lexer[2] += 1 EndIf $lexer[3] += 1 Return $c EndFunc ;==>_lexerGetChar #EndRegion Lexer #Region Parser ; Dead basic. Very little error checking, it assumes that anything it doesn't ; expect is an atom, so will accept garbage. Func parserParse(ByRef $lexer) Local $list = parserParseList($lexer) Return consAllocList($list) EndFunc ;==>parserParse Func parserParseList(ByRef $lexer) Local $tok, $top = 0 While 1 $tok = lexerGetToken($lexer) If @error Then Return SetError(@error, @extended, 0) ; Lexer threw an error EndIf If $tok = "" Then ExitLoop If $tok = "(" Then If Not $top Then $top = parserParseList($lexer) Else listPushList($top, parserParseList($lexer)) EndIf ElseIf $tok = "'" Then Local $q = consAllocAtom("quote") $tok = lexerGetToken($lexer) If @error Then Return SetError(@error, @extended, 0) ; Lexer threw an error EndIf If $tok = "(" Then listPushList($q, parserParseList($lexer)) Else listPushAtom($q, $tok) EndIf If Not $top Then $top = $q Else listPushList($top, $q) EndIf ElseIf $tok = "." Then ; Not Implemented! Return SetError(301, 0, 0) ; Not Implemented ElseIf $tok = ")" Then ExitLoop Else If Not $top Then $top = consAllocAtom($tok) Else listPushAtom($top, $tok) EndIf EndIf WEnd Return $top EndFunc ;==>parserParseList #EndRegion Parser #Region Symbol Table ; Todo. ; This will be required before defun and user library functions can be written. Func callstackCreate() Local $callstack[200] ; Global scope is first scope. $callstack[0] = 1 ; Count $callstack[1] = callstackCreateFrame() ; $callstack[1] is global scope. Return $callstack EndFunc ;==>callstackCreate Func callstackCreateFrame() Local $frame[10][4] $frame[0][0] = 0 ; Count in [0][0] ; Frame has a row for each symbol. ; [symbol, params, num_params, code] Return $frame EndFunc ;==>callstackCreateFrame Func callstackDefun(ByRef $callstack, $symbol, $params, $num_params, $code) Return callstackFrameDefun($callstack[$callstack[0]], $symbol, $params, $num_params, $code) EndFunc ;==>callstackDefun Func callstackFrameDefun(ByRef $frame, $symbol, $params, $num_params, $code) $frame[0][0] += 1 If $frame[0][0] = UBound($frame) - 1 Then ReDim $frame[$frame[0][0] + 10][UBound($frame, 2)] EndIf $frame[$frame[0][0]][0] = $symbol $frame[$frame[0][0]][1] = $params $frame[$frame[0][0]][2] = $num_params $frame[$frame[0][0]][3] = $code Return $frame[0][0] EndFunc ;==>callstackFrameDefun Func callstackEnterFunc(ByRef $callstack, $params, $num_params, $param_values) Local $frame = callstackCreateFrame() Local $p = $params, $v = $param_values While $p callstackFrameDefun($frame, consGetCarData($p), 0, 0, consGetCar($v)) $p = consGetCdr($p) $v = consGetCdr($v) If $p And Not $v Then Return SetError(111, 0, 0) ; Incorrect number of parameters given. EndIf WEnd Return callstackEnter($callstack, $frame) EndFunc ;==>callstackEnterFunc Func callstackEnter(ByRef $callstack, $frame) $callstack[0] += 1 If $callstack[0] = UBound($callstack) Then ; Stack overflow? Can't just keep increasing the stack. ConsoleWrite("STACK OVERFLOW" & @LF) Return SetError(108, 0, 0) ; Stack Overflow EndIf $callstack[$callstack[0]] = $frame Return $callstack[0] EndFunc ;==>callstackEnter Func callstackLeave(ByRef $callstack) If $callstack[0] = 1 Then ; Attempting to leave global frame? Return SetError(109, 0, 0) ; Stack Underflow EndIf $callstack[$callstack[0]] = 0 $callstack[0] -= 1 Return $callstack[0] EndFunc ;==>callstackLeave Func callstackLookup(ByRef $callstack, $symbol) Local $ret[2], $i If $callstack[0] > 1 Then ; Check top frame. $i = callstackFrameLookup($callstack[$callstack[0]], $symbol) If $i <> -1 Then $ret[0] = $callstack[0] $ret[1] = $i Return $ret EndIf EndIf ; Check global frame $i = callstackFrameLookup($callstack[1], $symbol) If $i <> -1 Then $ret[0] = 1 $ret[1] = $i Return $ret EndIf Return 0 EndFunc ;==>callstackLookup Func callstackFrameLookup(ByRef $frame, $symbol) Return _ArraySearch($frame, $symbol, 0, 0, 1, 2, 1, 0) EndFunc ;==>callstackFrameLookup #EndRegion Symbol Table #Region Error Handling ; Who needs error handling anyway. ; Functions returning errors return a (hopefully) unique error code. This ; should then be returned by the caller. @extended contains the con pair ; pointer. #EndRegion Error Handling #Region Lisp Functions ; Evaluates a list/atom. ; Returns a cons value. Func lispEval(ByRef $callstack, $cons) If $cons = 0 Then ; nil Return $nil ElseIf consIsAtom($cons) Then ; Atom on its own. If StringIsInt(consGetCarData($cons)) Or StringIsFloat(consGetCarData($cons)) Then Return consGetCar($cons) Else Local $ret = lispCallFunction($callstack, consGetCarData($cons), $nil) If @error Then Return SetError(@error, @extended, $ret) EndIf Return $ret EndIf EndIf Local $list = consGetCarData($cons) If consIsList($list) Then Return SetError(101, $list, 0) ; Expected a function name. EndIf Local $ret = lispCallFunction($callstack, consGetCarData($list), consGetCdr($list)) If @error Then Return SetError(@error, @extended, $ret) EndIf Return $ret EndFunc ;==>lispEval ; Calls a function. ; $fnAtom - The atom the function is associated with. ; $cons - The head of the parameter list. Func lispCallFunction(ByRef $callstack, $fnAtom, $list) Local $ret Local $fn = lispGetFunction($fnAtom) If $fn <> -1 Then $ret = Call(libraryGetFunctions()[$fn][1], $callstack, $list) If @error = 0xDEAD And @extended = 0xBEEF Then Return SetError(102, $list, 0) ; Function does not exist. ElseIf @error Then ; Error reported by function call Return SetError(@error, @extended, $ret) EndIf ElseIf IsArray($callstack) Then $fn = callstackLookup($callstack, $fnAtom) If Not IsArray($fn) Then Return SetError(102, $list, 0) ; Function does not exist. EndIf Local $frame = $callstack[$fn[0]] If consIsList($frame[$fn[1]][3]) Or $frame[$fn[1]][2] Then callstackEnterFunc($callstack, $frame[$fn[1]][1], $frame[$fn[1]][2], $list) $ret = lispEval($callstack, $frame[$fn[1]][3]) If @error Then Return SetError(@error, @extended, 0) EndIf callstackLeave($callstack) Else $ret = consGetCar($frame[$fn[1]][3]) EndIf Else Return SetError(102, $list, 0) ; Function does not exist. EndIf Return $ret EndFunc ;==>lispCallFunction ; Looks up a function. Func lispGetFunction($atom) Local $a = libraryGetFunctions() Return _ArraySearch($a, $atom, 0, 0, 1, 2, 1, 0) EndFunc ;==>lispGetFunction ; DEfine FUNction - defines a macro in LISP. ; Syntax is: ; (defun foo (a b c d) (+ a b c d)) ; user macro is then called using: ; (foo 1 2 3 4) ; > 10 Func lispDefun(ByRef $callstack, $list) ; LISP[defun] Local $symbol, $params, $num_params, $code If Not IsArray($callstack) Then Return SetError(112, $list, 0) ; Defun: callstack must be defined. EndIf If consIsList($list) Then Return SetError(103, $list, 0) ; Defun: symbol invalid. EndIf $symbol = consGetCarData($list) If lispGetFunction($symbol) <> -1 Then Return SetError(104, $list, 0) ; Defun: symbol already exists. EndIf If consIsTail($list) Then Return SetError(105, $list, 0) ; Defun: 3 parameters required. EndIf $list = consGetCdr($list) If Not consIsList($list) Then ; Single parameter. $params = $list $num_params = 1 Else $params = consGetCarData($list) $num_params = listGetLength($params) EndIf If consIsTail($list) Then Return SetError(105, $list, 0) ; Defun: 3 parameters required. EndIf $code = consGetCdr($list) callstackDefun($callstack, $symbol, $params, $num_params, $code) Return $nil EndFunc ;==>lispDefun #EndRegion Lisp Functions #Region Library ; For testing purposes, a manually maintained array of functions would be a ; pain in the arse. ; To solve this, a list is generated from the source code. Any functions with ; the comment LISP[...] are added, associated with the atom ... ; For obvious reasons this doesn't work compiled. Use ; _libraryFunctionsArrayCode() to get an array. ; ; http://jtra.cz/stuff/lisp/sclr/ ; Returns the array of library functions, in the form: ; [Function Atom, AutoIt Function] Func libraryGetFunctions() Local Static $aFunctions = _libraryParseFunctions() Return $aFunctions EndFunc ;==>libraryGetFunctions ; Gets the function list from source code. Func _libraryParseFunctions() Local $a = StringRegExp(FileRead(@ScriptFullPath), _ "(?m)(?i)^Func\s+([[:alnum:]]+)\s*\(.*\)\s*;\s*LISP\[([^\]]+)\].*$", 3) Local $aRet[UBound($a) / 2][2] For $i = 0 To UBound($a) - 1 Step +2 $aRet[$i / 2][0] = $a[$i + 1] $aRet[$i / 2][1] = $a[$i] Next Return $aRet EndFunc ;==>_libraryParseFunctions ; Returns the function library, as parsed from the source code, as an AutoIt ; array. Func _libraryFunctionsArrayCode() Local $a = libraryGetFunctions() Local $ret = "Global $_FUNCTIONS[" & UBound($a) & "][2] = [ _" & @CRLF For $i = 0 To UBound($a) - 1 $ret &= @TAB & @TAB & _ "[""" & $a[$i][0] & """, " & $a[$i][1] & "], _" & @CRLF Next $ret = StringTrimRight($ret, StringLen(", _" & @CRLF)) & "]" Return $ret EndFunc ;==>_libraryFunctionsArrayCode ; (quote foo) = foo Func lispQuote(ByRef $callstack, $list) ; LISP[quote] Return $list EndFunc ;==>lispQuote #Region List Operators ; Todo: ; assoc ; cons ; consp ; getf ; list ; mapc ; mapcan ; mapcar ; mapcon ; maplist ; member ; pop ; push ; pushnew ; rplaca ; rplacd ; set-difference ; union Func lispAppend(ByRef $callstack, $list) ; LISP[append] Local $l = lispEval($callstack, $list) If @error Then Return SetError(@error, @extended, 0) ; Eval threw an error. If Not consIsList($l) Then Return SetError(402, $list, 0) ; Append should have list arguments Local $ret = consGetCarData($l), $last = listGetTail(consGetCarData($l)) While Not consIsTail($list) $list = consGetCdr($list) $l = lispEval($callstack, $list) If @error Then Return SetError(@error, @extended, 0) ; Eval threw an error. If Not consIsList($l) Then Return SetError(402, $list, 0) ; Append should have list arguments If consIsNil($l) Then ContinueLoop consSetCdr($last, consGetCarData($l)) $last = listGetTail(consGetCarData($l)) WEnd Return consAllocList($ret) EndFunc ;==>lispAppend Func lispRest(ByRef $callstack, $list) ; LISP[rest] Local $l = lispEval($callstack, $list) If @error Then Return SetError(@error, @extended, 0) ; Eval threw an error. If Not consIsList($l) Then Return $nil Return consGetCdr(consGetCarData($l)) EndFunc ;==>lispRest Func lispFirst(ByRef $callstack, $list) ; LISP[first] Local $l = lispEval($callstack, $list) If @error Then Return SetError(@error, @extended, 0) ; Eval threw an error. If Not consIsList($l) Then Return $nil Return consGetCar(consGetCarData($l)) EndFunc ;==>lispFirst Func lispSecond(ByRef $callstack, $list) ; LISP[second] Local $l = lispEval($callstack, $list) If @error Then Return SetError(@error, @extended, 0) ; Eval threw an error. If Not consIsList($l) Then Return $nil Return consGetCar(consGetCdr(consGetCarData($l))) EndFunc ;==>lispSecond Func lispThird(ByRef $callstack, $list) ; LISP[third] Local $l = lispEval($callstack, $list) If @error Then Return SetError(@error, @extended, 0) ; Eval threw an error. If Not consIsList($l) Then Return $nil Return consGetCar(consGetCdr(consGetCdr(consGetCarData($l)))) EndFunc ;==>lispThird Func lispLast(ByRef $callstack, $list) ; LISP[last] Local $l = lispEval($callstack, $list) If @error Then Return SetError(@error, @extended, 0) ; Eval threw an error. If consIsAtom($l) Then Return $nil $l = consGetCarData($l) Local $count = 1 If Not consIsTail($list) Then $list = consGetCdr($list) Local $c = lispEval($callstack, $list) If consIsList($c) Then Return SetError(401, $list, 0) ; Expected count atom EndIf $count = consGetCarData($c) If $count <= 0 Then Return $nil EndIf Local $len = listGetLength($l) - $count If $len <= 0 Then Return $nil Local $ret = $l For $i = 1 To $len $ret = consGetCdr($ret) Next Return $ret EndFunc ;==>lispLast Func lispButLast(ByRef $callstack, $list) ; LISP[butlast] Local $l = lispEval($callstack, $list) If @error Then Return SetError(@error, @extended, 0) ; Eval threw an error. If consIsAtom($l) Then Return $nil $l = consGetCarData($l) Local $count = 1 If Not consIsTail($list) Then $list = consGetCdr($list) Local $c = lispEval($callstack, $list) If consIsList($c) Then Return SetError(401, $list, 0) ; Expected count atom EndIf $count = consGetCarData($c) If $count <= 0 Then Return $l EndIf Local $len = listGetLength($l) - $count If $len <= 0 Then Return $nil Local $top = consDuplicate($l), $here = $top, $next For $i = 1 To $len - 1 $next = consDuplicate(consGetCdr($here)) consSetCdr($here, $next) $here = $next Next consSetCdr($here, 0) Return $top EndFunc ;==>lispButLast Func lispListp(ByRef $callstack, $list) ; LISP[listp] Local $l = lispEval($callstack, $list) If @error Then Return SetError(@error, @extended, 0) ; Eval threw an error. If consIsList($l) Then Return pairCreateAtom(1) Else Return $nil EndIf EndFunc ;==>lispListp Func lispNull(ByRef $callstack, $list) ; LISP[null] Local $l = lispEval($callstack, $list) If @error Then Return SetError(@error, @extended, 0) ; Eval threw an error. If consIsNil($l) Then Return pairCreateAtom(1) Else Return $nil EndIf EndFunc ;==>lispNull Func lispListLength(ByRef $callstack, $list) ; LISP[list-length] Local $l = lispEval($callstack, $list) If @error Then Return SetError(@error, @extended, 0) ; Eval threw an error. If Not consIsList($l) Then Return pairCreateAtom(0) If listIsCyclic($l) Then Return $nil Return pairCreateAtom(listGetLength(consGetCarData($l))) EndFunc ;==>lispListLength #EndRegion List Operators #Region Maths ; (* a b c d ...) Func lispMul(ByRef $callstack, $list) ; LISP[*] Local $product = 1 Local $val Do $val = lispEval($callstack, $list) If @error Then Return SetError(@error, @extended, 0) ; listEval returned an error EndIf If consIsList($val) Then Return SetError(113, $list, 0) ; Undefined: multiplication of lists EndIf $product *= Number(consGetCarData($val)) $list = consGetCdr($list) Until Not $list Return pairCreateAtom($product) EndFunc ;==>lispMul ; (+ a b c d ...) Func lispAdd(ByRef $callstack, $list) ; LISP[+] Local $sum = 0 Local $val Do $val = lispEval($callstack, $list) If @error Then Return SetError(@error, @extended, 0) ; listEval returned an error EndIf If consIsList($val) Then Return SetError(103, $list, 0) ; Undefined: addition with lists. EndIf $sum += Number(consGetCarData($val)) $list = consGetCdr($list) Until Not $list Return pairCreateAtom($sum) EndFunc ;==>lispAdd ; (- a b c d ...) Func lispMinus(ByRef $callstack, $list) ; LISP[-] Local $sum = 0, $first = True Local $val Do $val = lispEval($callstack, $list) If @error Then Return SetError(@error, @extended, 0) ; listEval returned an error EndIf If consIsList($val) Then Return SetError(103, $list, 0) ; Undefined: addition with lists. EndIf If $first Then If consIsTail($list) Then $sum = -Number(consGetCarData($val)) Else $sum = Number(consGetCarData($val)) EndIf $list = consGetCdr($list) $first = False Else $sum -= Number(consGetCarData($val)) $list = consGetCdr($list) EndIf Until Not $list Return pairCreateAtom($sum) EndFunc ;==>lispMinus ; (/ a b c d ...) Func lispDiv(ByRef $callstack, $list) ; LISP[/] Local $product = 0, $first = True Local $val Do $val = lispEval($callstack, $list) If @error Then Return SetError(@error, @extended, 0) ; listEval returned an error EndIf If consIsList($val) Then Return SetError(103, $list, 0) ; Undefined: addition with lists. EndIf If $first Then If consIsTail($list) Then $product = 1 / Number(consGetCarData($val)) Else $product = Number(consGetCarData($val)) EndIf $list = consGetCdr($list) $first = False Else $product /= Number(consGetCarData($val)) $list = consGetCdr($list) EndIf Until Not $list Return pairCreateAtom($product) EndFunc ;==>lispDiv Func _lispRound(ByRef $callstack, $list, $predicate) Local $number, $divisor $number = lispEval($callstack, $list) If @error Then Return SetError(@error, @extended, 0) EndIf If Not consIsAtom($number) Then Return SetError(403, $number, 0) ; If: number must be an atom. EndIf $number = consGetCarData($number) If consIsTail($list) Then $divisor = 1 Else $divisor = lispEval($callstack, consGetCdr($list)) If @error Then Return SetError(@error, @extended, 0) EndIf If Not consIsAtom($divisor) Then Return SetError(404, $divisor, 0) ; If: number must be an atom. EndIf $divisor = consGetCarData($divisor) EndIf Local $quotient = $predicate($number / $divisor) Local $remainder = $number - $quotient * $divisor Local $ret = consAllocAtom($quotient) listPushAtom($ret, $remainder) Return consAllocList($ret) EndFunc ;==>_lispRound Func lispCeiling(ByRef $callstack, $list) ; LISP[ceiling] Return _lispRound($callstack, $list, Ceiling) EndFunc ;==>lispCeiling Func lispFloor(ByRef $callstack, $list) ; LISP[floor] Return _lispRound($callstack, $list, Floor) EndFunc ;==>lispFloor Func lispRound(ByRef $callstack, $list) ; LISP[round] Return _lispRound($callstack, $list, Round) EndFunc ;==>lispRound Func lispRandom(ByRef $callstack, $list) ; LISP[random] Local $max $max = lispEval($callstack, $list) If @error Then Return SetError(@error, @extended, 0) EndIf If Not consIsAtom($max) Then Return SetError(403, $max, 0) ; Random: max must be an atom. EndIf $max = Number(consGetCarData($max)) Local $result = Random() * $max If IsInt($max) Then $result = Int($result) Return pairCreateAtom($result) EndFunc ;==>lispRandom #EndRegion Maths #Region Equality+Logical+If ; (if <expr> <true_value> <false_value>) Func lispIf(ByRef $callstack, $list) ; LISP[if] If $list = 0 Then Return SetError(105, $list, 0) ; If: At least 2 parameters required. EndIf ; Evaluate the expression Local $expr = lispEval($callstack, $list) If @error Then Return SetError(@error, @extended, 0) EndIf If Not consIsAtom($expr) Then Return SetError(108, $expr, 0) ; If: <expr> must be an atom. EndIf ; Get boolean result Local $result If consIsNil($expr) Then $result = False Else $result = Number(consGetCarData($expr)) EndIf ; Get true and false expressions If consIsTail($list) Then Return SetError(105, $list, 0) ; If: At least 2 parameters required. EndIf Local $true_code, $false_code $true_code = consGetCdr($list) $false_code = consGetCdr($true_code) Local $ret If $result Then $ret = lispEval($callstack, $true_code) Else $ret = lispEval($callstack, $false_code) EndIf Return $ret EndFunc ;==>lispIf ; (= a b c d ...) Func lispEquals(ByRef $callstack, $list) ; LISP[=] Return lispCompare($callstack, $list, compareEqual) EndFunc ;==>lispEquals Func compareEqual($a, $b) Return ($a = $b) EndFunc ;==>compareEqual ; (< a b c d ...) Func lispLess(ByRef $callstack, $list) ; LISP[<] Return lispCompare($callstack, $list, compareLess) EndFunc ;==>lispLess Func compareLess($a, $b) Return ($a < $b) EndFunc ;==>compareLess ; (<= a b c d ...) Func lispLessOrEqual(ByRef $callstack, $list) ; LISP[<=] Return lispCompare($callstack, $list, compareLessOrEqual) EndFunc ;==>lispLessOrEqual Func compareLessOrEqual($a, $b) Return ($a <= $b) EndFunc ;==>compareLessOrEqual ; (> a b c d ...) Func lispGreater(ByRef $callstack, $list) ; LISP[>] Return lispCompare($callstack, $list, compareGreater) EndFunc ;==>lispGreater Func compareGreater($a, $b) Return ($a > $b) EndFunc ;==>compareGreater ; (>= a b c d ...) Func lispGreaterOrEqual(ByRef $callstack, $list) ; LISP[>=] Return lispCompare($callstack, $list, compareGreaterOrEqual) EndFunc ;==>lispGreaterOrEqual Func compareGreaterOrEqual($a, $b) Return ($a >= $b) EndFunc ;==>compareGreaterOrEqual ; Compares a list values according to a predicate. Func lispCompare(ByRef $callstack, $list, $predicate) ; As a naive operators, it wouldn't make sense for this to optimise the ands Local $result = True Local $a, $b, $br If $list = 0 Then Return SetError(105, $list, 0) ; =: At least 2 parameters required. EndIf ; Evaluate a and b $a = $list $b = consGetCdr($a) If $b = 0 Then Return SetError(105, $list, 0) ; =: At least 2 parameters required. EndIf $a = lispEval($callstack, $a) If @error Then Return SetError(@error, @extended, 0) EndIf Do $br = lispEval($callstack, $b) If @error Then Return SetError(@error, @extended, 0) EndIf Local $result If Not consIsAtom($a) Then If Not consIsAtom($br) Then ; Compare lists $result = $result And False Else $result = $result And False EndIf Else If Not consIsAtom($br) Then $result = $result And False Else ; Compare atoms. $result = $result And $predicate(consGetCarData($a), consGetCarData($br)) EndIf EndIf $b = consGetCdr($b) $a = $br Until Not $b If $result Then Return pairCreateAtom(1) Else Return $nil EndIf EndFunc ;==>lispCompare #EndRegion Equality+Logical+If #Region Functions, Evaluation and flow control ; (mapcar fn lists) Func lispMapCar(ByRef $callstack, $list) ; LISP[mapcar] Local $fn Local $lists[listGetLength($list) - 1] Local $nils = 0 ; Evaluate the expression Local $fn = lispEval($callstack, $list) If @error Then Return SetError(@error, @extended, 0) EndIf If Not consIsAtom($fn) Then Return SetError(108, $fn, 0) ; If: <expr> must be an atom. EndIf $fn = consGetCarData($fn) For $i = 0 To UBound($lists) - 1 $list = consGetCdr($list) $lists[$i] = lispEval($callstack, $list) If @error Then Return SetError(@error, @extended, 0) If consIsAtom($lists[$i]) Then Return SetError(405, $list, 0) ; Expected a list EndIf $lists[$i] = consGetCarData($lists[$i]) If consIsNil($lists[$i]) Then $nils += 1 Next Local $ret = 0, $r, $retTail = 0 Local $l, $next, $top Do $top = consDuplicate($lists[0]) $l = $top For $i = 1 To UBound($lists) - 1 $next = consDuplicate($lists[$i]) consSetCdr($l, $next) $l = $next Next consSetCdr($l, 0) $r = lispCallFunction($callstack, $fn, $top) If @error Then Return SetError(@error, @extended, 0) ; Calling the function returned an error If $ret = 0 Then $ret = consDuplicate($r) $retTail = $ret Else $r = consDuplicate($r) consSetCdr($retTail, $r) $retTail = $r EndIf For $i = 0 To UBound($lists) - 1 If $lists[$i] Then $lists[$i] = consGetCdr($lists[$i]) If Not $lists[$i] Then $nils += 1 EndIf Next Until $nils = UBound($lists) Return consAllocList($ret) EndFunc ;==>lispMapCar Func lispFnEval(ByRef $callstack, $list) ; LISP[eval] Local $l = lispEval($callstack, $list) Return lispEval($callstack, $l) EndFunc ;==>lispEval #EndRegion Functions, Evaluation and flow control #EndRegion Library #Region Pair functions ; Pairs are 2d arrays that are convenient for passing car values around without ; using memory. Think of them a bit like registers. Func pairCreate($a, $b) Local $aRet[2] = [$a, $b] Return $aRet EndFunc ;==>pairCreate Func pairCreateAtom($data) Return pairCreate($CT_ATOM, $data) EndFunc ;==>pairCreateAtom Func pairCreateList($ptr) Return pairCreate($CT_LIST, $ptr) EndFunc ;==>pairCreateList #EndRegion Pair functions #Region List functions ; Functions that manipulate and work with lists. ; Unlike cons values, input to these functions must be in memory. ; Returns the tail of the list. Func listGetTail($list) If consIsTail($list) Then Return $list Else Return listGetTail(consGetCdr($list)) EndIf EndFunc ;==>listGetTail ; Creates a new cons pair, with the given car value, sets it as the tail of the ; list, and returns the new tail. ; Should be used by the user. Use one specific listPush* functions. Func listPush($list, $carType, $carData) Local $new = consAlloc($carType, $carData) If Not consIsTail($list) Then $list = listGetTail($list) EndIf consSetCdr($list, $new) Return $new EndFunc ;==>listPush ; Creates a new cons pair, with the given car list, sets it as the tail of the ; list, and returns the new tail. Func listPushList($list, $ptr) Return listPush($list, $CT_LIST, $ptr) EndFunc ;==>listPushList ; Creates a new cons pair, with the given car atom, sets it as the tail of the ; list, and returns the new tail. Func listPushAtom($list, $atom) Return listPush($list, $CT_ATOM, $atom) EndFunc ;==>listPushAtom ; Prints a list to the console. Func listPrint($list) ConsoleWrite(listToStr($list) & @LF) EndFunc ;==>listPrint ; Returns the string representation of a list. ; As an added bonus, this function will accept car data as an array, rather ; than just a pointer to a list in memory. Func listToStr($list) If consIsNil($list) Then Return "NIL" If IsArray($list) Then ; Car value. If consIsList($list) Then Return "(" & listToStr(consGetCarData($list)) & ")" Else Return String(consGetCarData($list)) EndIf Else ; Pointer If $list = 0 Then Return "" ; End of list Local $ret = listToStr(consGetCar($list)) Local $cdr = consGetCdr($list) If $cdr Then $ret &= " " & listToStr($cdr) EndIf Return $ret EndIf EndFunc ;==>listToStr ; Checks if a list is cyclic Func listIsCyclic($list) Local $start = $list While Not consIsTail($list) $list = consGetCdr($list) If $list = $start Then Return True WEnd Return False EndFunc ;==>listIsCyclic ; Gets the length of a list. Func listGetLength($list) If $list = 0 Then Return 0 ElseIf consIsTail($list) Then Return 1 Else Return 1 + listGetLength(consGetCdr($list)) EndIf EndFunc ;==>listGetLength ; Compares two lists. ; Only a shallow compare. Func listCompare($a, $b) If $a = $b Then Return True Do If consGetCarType($a) <> consGetCarType($b) _ Or consGetCarData($a) <> consGetCarData($b) Then Return False Else $a = consGetCdr($a) $b = consGetCdr($b) EndIf Until Not $a And Not $b Return True EndFunc ;==>listCompare #EndRegion List functions #Region Cons pair functions ; Cons values can be either pointers to memory, or local pairs. ; If the input is an array then it is treated as a pair, all functions can ; handle both types, even if this just means returning an error. ; Checks if this cons pair is the tail of a list (no following pair) Func consIsTail($cons) If IsArray($cons) Then Return True Else Return consGetCdr($cons) = 0 EndIf EndFunc ;==>consIsTail ; Checks if the cons value is an atom. ; nil is a special case. It is both an atom and a list. Func consIsAtom($cons) Return (consGetCarType($cons) = $CT_ATOM) _ ; Is an atom Or (consGetCarData($cons) = 0) ; Is nil EndFunc ;==>consIsAtom ; Checks if the cons value is a list. Func consIsList($cons) Return consGetCarType($cons) = $CT_LIST EndFunc ;==>consIsList ; Checks if the cons value is nil. Func consIsNil($cons) Return consIsList($cons) And (consGetCarData($cons) = 0) EndFunc ;==>consIsNil ; Gets the type of the cons value (returns one of the $CT_* constants). ; This should NOT be used by the user. You should be using one of the consIs* ; functions above, as these will deal with special cases such as nil. Func consGetCarType($cons) If IsArray($cons) Then Return $cons[0] Else Return memGet($cons, 0) EndIf EndFunc ;==>consGetCarType ; Gets the data of the car element of the cons pair. Func consGetCarData($cons) If IsArray($cons) Then Return $cons[1] Else Return memGet($cons, 1) EndIf EndFunc ;==>consGetCarData ; Gets the car part of the cons pair. ; This is returned as a pair. Func consGetCar($cons) If IsArray($cons) Then Return $cons Else Return pairCreate(consGetCarType($cons), consGetCarData($cons)) EndIf EndFunc ;==>consGetCar ; Sets the type of the car part of the cons pair. Func consSetCarType(ByRef $cons, $carType) If IsArray($cons) Then $cons[0] = $carType Else memSet($cons, 0, $carType) EndIf EndFunc ;==>consSetCarType ; Sets the data of the car part of the cons pair. Func consSetCarData(ByRef $cons, $carData) If IsArray($cons) Then $cons[1] = $carData Else memSet($cons, 1, $carData) EndIf EndFunc ;==>consSetCarData ; Sets the car value of the cons pair. Func consSetCar(ByRef $cons, $carType, $carData) consSetCarType($cons, $carType) consSetCarData($cons, $carData) EndFunc ;==>consSetCar ; Sets the car value of the cons pair (from a given pair) Func consSetCarP(ByRef $cons, $car) Return consSetCar($cons, $car[0], $car[1]) EndFunc ;==>consSetCarP ; Gets the cdr part of the cons pair. Func consGetCdr($cons) If IsArray($cons) Then Return SetError(104, 0, 0) ; Operation only valid on pairs in memory Else Return memGet($cons, 2) EndIf EndFunc ;==>consGetCdr ; Sets the cdr part of the cons pair. Func consSetCdr($cons, $cdr) If IsArray($cons) Then Return SetError(104, 0, 0) ; Operation only valid on pairs in memory Else memSet($cons, 2, $cdr) EndIf EndFunc ;==>consSetCdr ; Allocates a new cons pair in memory, and assigns the car value. ; Should be used by the user. Use one specific consAlloc* functions. Func consAlloc($carType, $carData) Local $ptr = memAlloc() consSetCar($ptr, $carType, $carData) Return $ptr EndFunc ;==>consAlloc ; Create a duplicate of a cons cell in memory. Func consDuplicate($cons) Local $ret = consAlloc(consGetCarType($cons), consGetCarData($cons)) consSetCdr($ret, consGetCdr($cons)) Return $ret EndFunc ;==>consDuplicate ; Allocates a new cons pair in memory, and assigns the car list Func consAllocList($ptr) Return consAlloc($CT_LIST, $ptr) EndFunc ;==>consAllocList ; Allocates a new cons pair in memory, and assigns the car atom Func consAllocAtom($atom) Return consAlloc($CT_ATOM, $atom) EndFunc ;==>consAllocAtom #EndRegion Cons pair functions #Region Memory Functions ; Currently very basic. Just allocates a car,cdr pair in an array and returns ; the index. ; Could be made a lot more complex, $_MEMORY is never accessed directly. ; Unfortunately with this model, $_MEMORY has to be a global in order to be ; redimmed. ; Allocated a cons pair of memory and returns a pointer Func memAlloc() $_MEMORY[0][0] += 1 ; Expand memory as required If $_MEMORY[0][0] >= UBound($_MEMORY) Then ReDim $_MEMORY[$_MEMORY[0][0] + 1000][3] EndIf ; Zero Memory $_MEMORY[$_MEMORY[0][0]][0] = 0 $_MEMORY[$_MEMORY[0][0]][1] = 0 $_MEMORY[$_MEMORY[0][0]][2] = 0 Return $_MEMORY[0][0] EndFunc ;==>memAlloc ; Frees memory. Func memFree(ByRef $ptr) ; Meh. Just leave it. EndFunc ;==>memFree ; Retrieves the cons pair property $v at index $i Func memGet($i, $v) If $i = 0 Then ConsoleWrite("SIGSEGV: Attempt to dereference null pointer" & @LF) Return 0 EndIf Return $_MEMORY[$i][$v] EndFunc ;==>memGet ; Sets the cons pair property $v at index $i Func memSet($i, $v, $value) If $i = 0 Then ConsoleWrite("SIGSEGV: Attempt to dereference null pointer" & @LF) Return 0 EndIf $_MEMORY[$i][$v] = $value EndFunc ;==>memSet ; Displays memory (debug) Func memDisplay() ; Redim the array to be the same size as memory. Local $a = $_MEMORY ReDim $a[$a[0][0] + 1][UBound($a, 2)] _ArrayDisplay($a) EndFunc ;==>memDisplay #EndRegion Memory Functions Hopefully it's not too hard to read and understand. It was a bit of fun to put together. Matt
    1 point
  10. One line. #include "czardas.au3" _czardas() czardas.au3 Func _czardas() Local $a2[3] = ["lost", "won", 5 & Random(1, 49, 1)] While Not StringInStr($a2[2], "|", 0, 6) $a2[2] = StringRegExpReplace($a2[2] & StringRegExpReplace($a2[2] & "|" & 5 & Random(1, 49, 1), "(" & $a2[2] & ")", ""), "\|+", "|") WEnd Return MsgBox(0, "Lottery", "You " & $a2[StringStripWS(StringRegExpReplace(StringRegExpReplace(InputBox("Enter 7 Numbers", ""), "(\A| )", "5"), "(" & $a2[2] & ")", ""), 8) = ""]) EndFunc ;==>_czardas
    1 point
  11. czardas

    Lottery - Challenge

    No, includes, no error checks and no ternary operator. If you enter an empty string you will confuse it. You have to check yourself that you have entered 7 unique numbers between 1 and 49 separated by spaces otherwise you might think you have won when you haven't. An additional error check would require an extra line of code. Local $a2[3] = ["lost","won",5 & Random(1,49,1)] While Not StringInStr($a2[2],"|",0,6) $a2[2] = StringRegExpReplace($a2[2] & StringRegExpReplace($a2[2] & "|" & 5 & Random(1,49,1) , "(" & $a2[2] & ")", "") , "\|+", "|") WEnd MsgBox(0, "Lottery", "You " & $a2[StringStripWS(StringRegExpReplace(StringRegExpReplace(InputBox("Enter 7 Numbers",""), "(\A| )", "5"), "("&$a2[2]&")", ""), 8) = ""]) : Edit : Changed one word in the description.
    1 point
×
×
  • Create New...