Changeset 269 for Include/basic/function.sbp

Timestamp:

Jun 2, 2007, 7:08:26 PM (17 years ago)

Author:

イグトランス (egtra)

Message:

basicディレクトリの一部の_System関数をActiveBasic名前空間へ入れた

File:

• Include/basic/function.sbp (modified) (14 diffs)

Include/basic/function.sbp

@@ -13 +13 @@
 
 #require <Classes/System/Math.ab>
+#require <Classes/ActiveBasic/Math/Math.ab>
 
 
@@ -91 +92 @@
 End Function
 
-#ifdef _WIN64
-
-Function _System_GetNaN() As Double
-    SetQWord(VarPtr(_System_GetNaN) As *QWord, &H7FF8000000000000)
-End Function
-
-Function _System_GetInf(sign As Boolean) As Double
-    Dim s = 0 As QWord
-    If sign Then s = 1 << 63
-    SetQWord(VarPtr(_System_GetInf) As *QWord, &h7FF0000000000000 Or s)
-End Function
-
-#else
-
-Function _System_GetNaN() As Double
-    Dim p As *DWord
-    p = VarPtr(_System_GetNaN) As *DWord
-    p[0] = 0
-    p[1] = &H7FF80000
-End Function
-
-Function _System_GetInf(sign As Boolean) As Double
-    Dim s = 0 As DWord
-    If sign Then s = (1 As DWord) << 31
-    Dim p As *DWord
-    p = VarPtr(_System_GetInf) As *DWord
-    p[0] = 0
-    p[1] = &h7FF00000 Or s
-End Function
-
-#endif
-
-' xの符号だけをyのものにした値を返す。
-' 引数 x 元となる絶対値
-' 引数 y 元となる符号
-Function CopySign(x As Double, y As Double) As Double
-    SetQWord(VarPtr(CopySign), (GetQWord(VarPtr(x)) And &h7fffffffffffffff) Or (GetQWord(VarPtr(y)) And &h8000000000000000))
-End Function
-
-Function CopySign(x As Single, y As Single) As Single
-    SetDWord(VarPtr(CopySign), (GetDWord(VarPtr(x)) And &h7fffffff) Or (GetDWord(VarPtr(y)) And &h80000000))
-End Function
-
-Function _System_SetSign(x As Double, isNegative As Long) As Double
-#ifdef _WIN64
-    SetQWord(AddressOf(CopySign), (GetQWord(VarPtr(x)) And &h7fffffffffffffff) Or (isNegative << 63))
-#else
-    SetDWord(AddressOf(CopySign), GetDWord(VarPtr(x)))
-    SetDWord(AddressOf(CopySign) + SizeOf (DWord), GetQWord(VarPtr(x) + SizeOf (DWord)) And &h7fffffff Or (isNegative << 31))
-#endif
-End Function
-
 Const RAND_MAX=&H7FFFFFFF
 Dim _System_RndNext=1 As DWord
@@ -157 +106 @@
 
 '------------- ここからBasic標準関数の定義 -------------
-
 
 '------------------
@@ -193 +141 @@
 
 Function Int(number As Double) As Long
-    Int=Fix(number)
-    If number<0 Then
-        If number<Fix(number) Then Int=Int-1
+    Int = Fix(number)
+    If number < 0 Then
+        If number < Fix(number) Then Int--
     End If
 End Function
@@ -221 +169 @@
 
 Function Abs(number As Double) As Double
-    'Abs = Math.Abs(number)
+    'Abs = System.Math.Abs(number)
     If number < 0 then
         return -number
@@ -230 +178 @@
 
 Function Exp(x As Double) As Double
-    Exp = Math.Exp(x)
+    Exp = System.Math.Exp(x)
 End Function
 
 Function Log(x As Double) As Double
-    Log = Math.Log(x)
-End Function
-
-Function Log1p(x As Double) As Double
-    If x < -1 Or IsNaN(x) Then
-        Log1p = _System_GetNaN()
-    ElseIf x = 0 Then
-        x = 0
-    ElseIf IsInf(x) Then
-        Log1p = x
-    Else
-        Log1p = _System_Log1p(x)
-    End If
-End Function
-
-Function _System_Log1p(x As Double) As Double
-    Dim s = 0 As Double
-    Dim i = 7 As Long
-    While i >= 1
-        Dim t = (i * x) As Double
-        s = t / (2 + t / (2 * i + 1 + s))
-        i--
-    Wend
-    Return x / (1 + s)
+    Log = System.Math.Log(x)
 End Function
 
 Function Sgn(number As Double) As Long
-    Sgn = Math.Sign(number)
+    Sgn = System.Math.Sign(number)
 End Function
 
 Function Sqr(number As Double) As Double
-    Sqr = Math.Sqrt(number)
+    Sqr = System.Math.Sqrt(number)
 End Function
 
 Function Atn(number As Double) As Double
-    Atn = Math.Atan(number)
-End Function
-
-Function _Support_tan(x As Double, ByRef k As Long) As Double
-    Dim i As Long
-    Dim t As Double, x2 As Double
-
-    If x>=0 Then
-        k=Fix(x/(_System_PI/2)+0.5)
-    Else
-        k=Fix(x/(_System_PI/2)-0.5)
-    End If
-
-    x=(x-(CDbl(3217)/CDbl(2048))*k)+4.4544551033807686783083602485579e-6*k
-
-    x2=x*x
-    t=0
-
-    For i=19 To 3 Step -2
-        t=x2/(i-t)
-    Next
-
-    _Support_tan=x/(1-t)
+    Atn = System.Math.Atan(number)
 End Function
 
 Function Atn2(y As Double, x As Double) As Double
-    Atn2 = Math.Atan2(y, x)
+    Atn2 = System.Math.Atan2(y, x)
 End Function
 
 Function Sin(number As Double) As Double
-    Sin = Math.Sin(number)
+    Sin = System.Math.Sin(number)
 End Function
 
 Function Cos(number As Double) As Double
-    Cos = Math.Cos(number)
+    Cos = System.Math.Cos(number)
 End Function
 
 Function Tan(number As Double) As Double
-    Tan = Math.Tan(number)
-End Function
-
-Function IsNaN(ByVal x As Double) As Boolean
-    Dim p As *DWord
-    p = VarPtr(x) As *DWord
-    IsNaN = False
-    If (p[1] And &H7FF00000) = &H7FF00000 Then
-        If (p[0] <> 0) Or ((p[1] And &HFFFFF) <> 0) Then
-            IsNaN = True
-        End If
-    End If
-End Function
-
-Function IsInf(x As Double) As Boolean
-    Dim p As *DWord, nan As Double
-    p = VarPtr(x) As *DWord
-    p[1] And= &h7fffffff
-    nan = _System_GetInf(False)
-    IsInf = (memcmp(p As *Byte, VarPtr(nan), SizeOf (Double)) = 0)
-End Function
-
-Function IsNaNOrInf(x As Double) As Boolean
-    IsNaNOrInf = IsFinite(x)
-End Function
-
-Function IsFinite(x As Double) As Boolean
-    Dim p As *DWord, nan As Double
-    p = VarPtr(x) As *DWord
-'   p[1] And= &h7ffe0000
-    p[1] And= &H7FF00000
-    p[0] = 0
-    nan = _System_GetInf(/*x,*/ False)
-    IsFinite = (memcmp(p As BytePtr, VarPtr(nan), SizeOf (Double)) = 0)
+    Tan = System.Math.Tan(number)
 End Function
 
@@ -445 +315 @@
 
 Function Hex$(x As QWord) As String
-    Hex$ = _System_Hex(HIDWORD(x), True) + _System_Hex(LODWORD(x), False)
+    If HIDWORD(x) = 0 Then
+        Hex$ = _System_Hex(LODWORD(x), True)
+    Else
+        Hex$ = _System_Hex(HIDWORD(x), True) + _System_Hex(LODWORD(x), False)
+    End If
 End Function
 
@@ -518 +392 @@
 
     For i=10 To 1 Step -1
-        If (num\CDWord(8^i)) And &H07 Then
+        If (num \ CDWord(8^i)) And &H07 Then
             Exit For
         End If
@@ -526 +400 @@
     i2=0
     Do
-        Oct$[i2] = &h30 +((num \ CDWord(8 ^ i)) And &H07) As StrChar ' &h30 = Asc("0")
+        Oct$[i2] = &h30 + ((num \ CDWord(8 ^ i)) And &H07) As StrChar ' &h30 = Asc("0")
         If i=0 Then Exit Do
         i--
@@ -619 +493 @@
 
 Function Str$(dbl As Double) As String
-    If IsNaN(dbl) Then
+    If ActiveBasic.Math.IsNaN(dbl) Then
         Return "NaN"
-    ElseIf IsInf(dbl) Then
+    ElseIf ActiveBasic.Math.IsInf(dbl) Then
         If dbl > 0 Then
             Return "Infinity"
@@ -715 +589 @@
 End Function
 
-Function Str$(value As Int64) As String
-    Dim temp[255] As Char
-    _sntprintf(temp, Len (temp) \ SizeOf (Char), "%I64d", value)
-    Str$ = New String( temp )
+Function Str$(i As Int64) As String
+    If i < 0 Then
+        Return "-" & Str$(-i As QWord)
+    Else
+        Return Str$(i As QWord)
+    End If
+End Function
+
+Function Str$(x As QWord) As String
+    If x = 0 Then
+        Return "0"
+    End If
+
+    Dim buf[20] As StrChar
+    buf[20] = 0
+    Dim i = 19 As Long
+    Do
+        buf[i] = (x Mod 10 + &h30) As StrChar
+        x \= 10
+        If x = 0 Then
+            Exit Do
+        End If
+        i--
+    Loop
+    Return New String(VarPtr(buf[i]), 20 - i)
+End Function
+
+Function Str$(x As Long) As String
+#ifdef _WIN64
+    Return Str$(x As Int64)
+#else
+    If x < 0 Then
+        Return "-" & Str$(-x As DWord)
+    Else
+        Return Str$(x As DWord)
+    End If
+#endif
+End Function
+
+Function Str$(x As DWord) As String
+#ifdef _WIN64
+    Return Str$(x As QWord)
+#else
+    If x = 0 Then
+        Return "0"
+    End If
+
+    Dim buf[10] As StrChar
+    buf[10] = 0
+    Dim i = 9 As Long
+    Do
+        buf[i] = (x Mod 10 + &h30) As StrChar
+        x \= 10
+        If x = 0 Then
+            Exit Do
+        End If
+        i--
+    Loop
+    Return New String(VarPtr(buf[i]), 10 - i)
+#endif
+End Function
+
+Function Str$(x As Word) As String
+    Return Str$(x As ULONG_PTR)
+End Function
+
+Function Str$(x As Integer) As String
+    Return Str$(x As LONG_PTR)
+End Function
+
+Function Str$(x As Byte) As String
+    Return Str$(x As ULONG_PTR)
+End Function
+
+Function Str$(x As SByte) As String
+    Return Str$(x As LONG_PTR)
+End Function
+
+Function Str$(x As Single) As String
+    Return Str$(x As Double)
+End Function
+
+Function Str$(b As Boolean) As String
+    If b Then
+        Return "True"
+    Else
+        Return "False"
+    End If
 End Function
 
@@ -775 +733 @@
 
     While buf[0]=Asc(" ") or buf[0]=Asc(Ex"\t")
-        buf++
+        buf = VarPtr(buf[1])
     Wend
 
@@ -1140 +1098 @@
 End Function
 
+Function _System_ChrCpy(dst As PCWSTR, src As PCWSTR, size As SIZE_T) As PCWSTR
+    memcpy(dst, src, size * SizeOf (WCHAR))
+    Return dst
+End Function
+
+Function _System_ChrCpy(dst As PCSTR, src As PCSTR, size As SIZE_T) As PCSTR
+    memcpy(dst, src, size)
+    Return dst
+End Function
+
 Function _System_StrCmp(s1 As PCSTR, s2 As PCSTR) As Long
     Dim i = 0 As SIZE_T
@@ -1231 +1199 @@
 End Function
 
-Namespace ActiveBasic
-    Namespace Windows
-        Function GetPathFromIDList(pidl As LPITEMIDLIST) As String
-            Dim buf[ELM(MAX_PATH)] As TCHAR
-            If SHGetPathFromIDList(pidl, buf) Then
-                Return New String(buf)
-            Else
-                Return ""
-            End If
-        End Function
-
-        Function GetFolderPath(hwnd As HWND, folder As Long) As String
-            Dim pidl As LPITEMIDLIST
-            Dim hr = SHGetSpecialFolderLocation(hwnd, folder, pidl)
-            If SUCCEEDED(hr) Then
-                GetFolderPath = GetPathFromIDList(pidl)
-                CoTaskMemFree(pidl)
-            Else
-                GetFolderPath = ""
-            End If
-        End Function
-
-        Function GetFolderPath(folder As Long) As String
-            Return GetFolderPath(0, folder)
-        End Function
-    End Namespace
-End Namespace
-
 #endif '_INC_FUNCTION