Changeset 269 for Include/basic


Ignore:
Timestamp:
Jun 2, 2007, 7:08:26 PM (17 years ago)
Author:
イグトランス (egtra)
Message:

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

Location:
Include/basic
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • Include/basic/command.sbp

    r258 r269  
    3434
    3535Sub _System_End()
     36    System.Detail.hasShutdownStarted = True
    3637    Dim exitCode = System.Environment.ExitCode
    3738    _System_EndProgram()
  • Include/basic/function.sbp

    r258 r269  
    1313
    1414#require <Classes/System/Math.ab>
     15#require <Classes/ActiveBasic/Math/Math.ab>
    1516
    1617
     
    9192End Function
    9293
    93 #ifdef _WIN64
    94 
    95 Function _System_GetNaN() As Double
    96     SetQWord(VarPtr(_System_GetNaN) As *QWord, &H7FF8000000000000)
    97 End Function
    98 
    99 Function _System_GetInf(sign As Boolean) As Double
    100     Dim s = 0 As QWord
    101     If sign Then s = 1 << 63
    102     SetQWord(VarPtr(_System_GetInf) As *QWord, &h7FF0000000000000 Or s)
    103 End Function
    104 
    105 #else
    106 
    107 Function _System_GetNaN() As Double
    108     Dim p As *DWord
    109     p = VarPtr(_System_GetNaN) As *DWord
    110     p[0] = 0
    111     p[1] = &H7FF80000
    112 End Function
    113 
    114 Function _System_GetInf(sign As Boolean) As Double
    115     Dim s = 0 As DWord
    116     If sign Then s = (1 As DWord) << 31
    117     Dim p As *DWord
    118     p = VarPtr(_System_GetInf) As *DWord
    119     p[0] = 0
    120     p[1] = &h7FF00000 Or s
    121 End Function
    122 
    123 #endif
    124 
    125 ' xの符号だけをyのものにした値を返す。
    126 ' 引数 x 元となる絶対値
    127 ' 引数 y 元となる符号
    128 Function CopySign(x As Double, y As Double) As Double
    129     SetQWord(VarPtr(CopySign), (GetQWord(VarPtr(x)) And &h7fffffffffffffff) Or (GetQWord(VarPtr(y)) And &h8000000000000000))
    130 End Function
    131 
    132 Function CopySign(x As Single, y As Single) As Single
    133     SetDWord(VarPtr(CopySign), (GetDWord(VarPtr(x)) And &h7fffffff) Or (GetDWord(VarPtr(y)) And &h80000000))
    134 End Function
    135 
    136 Function _System_SetSign(x As Double, isNegative As Long) As Double
    137 #ifdef _WIN64
    138     SetQWord(AddressOf(CopySign), (GetQWord(VarPtr(x)) And &h7fffffffffffffff) Or (isNegative << 63))
    139 #else
    140     SetDWord(AddressOf(CopySign), GetDWord(VarPtr(x)))
    141     SetDWord(AddressOf(CopySign) + SizeOf (DWord), GetQWord(VarPtr(x) + SizeOf (DWord)) And &h7fffffff Or (isNegative << 31))
    142 #endif
    143 End Function
    144 
    14594Const RAND_MAX=&H7FFFFFFF
    14695Dim _System_RndNext=1 As DWord
     
    157106
    158107'------------- ここからBasic標準関数の定義 -------------
    159 
    160108
    161109'------------------
     
    193141
    194142Function Int(number As Double) As Long
    195     Int=Fix(number)
    196     If number<0 Then
    197         If number<Fix(number) Then Int=Int-1
     143    Int = Fix(number)
     144    If number < 0 Then
     145        If number < Fix(number) Then Int--
    198146    End If
    199147End Function
     
    221169
    222170Function Abs(number As Double) As Double
    223     'Abs = Math.Abs(number)
     171    'Abs = System.Math.Abs(number)
    224172    If number < 0 then
    225173        return -number
     
    230178
    231179Function Exp(x As Double) As Double
    232     Exp = Math.Exp(x)
     180    Exp = System.Math.Exp(x)
    233181End Function
    234182
    235183Function Log(x As Double) As Double
    236     Log = Math.Log(x)
    237 End Function
    238 
    239 Function Log1p(x As Double) As Double
    240     If x < -1 Or IsNaN(x) Then
    241         Log1p = _System_GetNaN()
    242     ElseIf x = 0 Then
    243         x = 0
    244     ElseIf IsInf(x) Then
    245         Log1p = x
    246     Else
    247         Log1p = _System_Log1p(x)
    248     End If
    249 End Function
    250 
    251 Function _System_Log1p(x As Double) As Double
    252     Dim s = 0 As Double
    253     Dim i = 7 As Long
    254     While i >= 1
    255         Dim t = (i * x) As Double
    256         s = t / (2 + t / (2 * i + 1 + s))
    257         i--
    258     Wend
    259     Return x / (1 + s)
     184    Log = System.Math.Log(x)
    260185End Function
    261186
    262187Function Sgn(number As Double) As Long
    263     Sgn = Math.Sign(number)
     188    Sgn = System.Math.Sign(number)
    264189End Function
    265190
    266191Function Sqr(number As Double) As Double
    267     Sqr = Math.Sqrt(number)
     192    Sqr = System.Math.Sqrt(number)
    268193End Function
    269194
    270195Function Atn(number As Double) As Double
    271     Atn = Math.Atan(number)
    272 End Function
    273 
    274 Function _Support_tan(x As Double, ByRef k As Long) As Double
    275     Dim i As Long
    276     Dim t As Double, x2 As Double
    277 
    278     If x>=0 Then
    279         k=Fix(x/(_System_PI/2)+0.5)
    280     Else
    281         k=Fix(x/(_System_PI/2)-0.5)
    282     End If
    283 
    284     x=(x-(CDbl(3217)/CDbl(2048))*k)+4.4544551033807686783083602485579e-6*k
    285 
    286     x2=x*x
    287     t=0
    288 
    289     For i=19 To 3 Step -2
    290         t=x2/(i-t)
    291     Next
    292 
    293     _Support_tan=x/(1-t)
     196    Atn = System.Math.Atan(number)
    294197End Function
    295198
    296199Function Atn2(y As Double, x As Double) As Double
    297     Atn2 = Math.Atan2(y, x)
     200    Atn2 = System.Math.Atan2(y, x)
    298201End Function
    299202
    300203Function Sin(number As Double) As Double
    301     Sin = Math.Sin(number)
     204    Sin = System.Math.Sin(number)
    302205End Function
    303206
    304207Function Cos(number As Double) As Double
    305     Cos = Math.Cos(number)
     208    Cos = System.Math.Cos(number)
    306209End Function
    307210
    308211Function Tan(number As Double) As Double
    309     Tan = Math.Tan(number)
    310 End Function
    311 
    312 Function IsNaN(ByVal x As Double) As Boolean
    313     Dim p As *DWord
    314     p = VarPtr(x) As *DWord
    315     IsNaN = False
    316     If (p[1] And &H7FF00000) = &H7FF00000 Then
    317         If (p[0] <> 0) Or ((p[1] And &HFFFFF) <> 0) Then
    318             IsNaN = True
    319         End If
    320     End If
    321 End Function
    322 
    323 Function IsInf(x As Double) As Boolean
    324     Dim p As *DWord, nan As Double
    325     p = VarPtr(x) As *DWord
    326     p[1] And= &h7fffffff
    327     nan = _System_GetInf(False)
    328     IsInf = (memcmp(p As *Byte, VarPtr(nan), SizeOf (Double)) = 0)
    329 End Function
    330 
    331 Function IsNaNOrInf(x As Double) As Boolean
    332     IsNaNOrInf = IsFinite(x)
    333 End Function
    334 
    335 Function IsFinite(x As Double) As Boolean
    336     Dim p As *DWord, nan As Double
    337     p = VarPtr(x) As *DWord
    338 '   p[1] And= &h7ffe0000
    339     p[1] And= &H7FF00000
    340     p[0] = 0
    341     nan = _System_GetInf(/*x,*/ False)
    342     IsFinite = (memcmp(p As BytePtr, VarPtr(nan), SizeOf (Double)) = 0)
     212    Tan = System.Math.Tan(number)
    343213End Function
    344214
     
    445315
    446316Function Hex$(x As QWord) As String
    447     Hex$ = _System_Hex(HIDWORD(x), True) + _System_Hex(LODWORD(x), False)
     317    If HIDWORD(x) = 0 Then
     318        Hex$ = _System_Hex(LODWORD(x), True)
     319    Else
     320        Hex$ = _System_Hex(HIDWORD(x), True) + _System_Hex(LODWORD(x), False)
     321    End If
    448322End Function
    449323
     
    518392
    519393    For i=10 To 1 Step -1
    520         If (num\CDWord(8^i)) And &H07 Then
     394        If (num \ CDWord(8^i)) And &H07 Then
    521395            Exit For
    522396        End If
     
    526400    i2=0
    527401    Do
    528         Oct$[i2] = &h30 +((num \ CDWord(8 ^ i)) And &H07) As StrChar ' &h30 = Asc("0")
     402        Oct$[i2] = &h30 + ((num \ CDWord(8 ^ i)) And &H07) As StrChar ' &h30 = Asc("0")
    529403        If i=0 Then Exit Do
    530404        i--
     
    619493
    620494Function Str$(dbl As Double) As String
    621     If IsNaN(dbl) Then
     495    If ActiveBasic.Math.IsNaN(dbl) Then
    622496        Return "NaN"
    623     ElseIf IsInf(dbl) Then
     497    ElseIf ActiveBasic.Math.IsInf(dbl) Then
    624498        If dbl > 0 Then
    625499            Return "Infinity"
     
    715589End Function
    716590
    717 Function Str$(value As Int64) As String
    718     Dim temp[255] As Char
    719     _sntprintf(temp, Len (temp) \ SizeOf (Char), "%I64d", value)
    720     Str$ = New String( temp )
     591Function Str$(i As Int64) As String
     592    If i < 0 Then
     593        Return "-" & Str$(-i As QWord)
     594    Else
     595        Return Str$(i As QWord)
     596    End If
     597End Function
     598
     599Function Str$(x As QWord) As String
     600    If x = 0 Then
     601        Return "0"
     602    End If
     603
     604    Dim buf[20] As StrChar
     605    buf[20] = 0
     606    Dim i = 19 As Long
     607    Do
     608        buf[i] = (x Mod 10 + &h30) As StrChar
     609        x \= 10
     610        If x = 0 Then
     611            Exit Do
     612        End If
     613        i--
     614    Loop
     615    Return New String(VarPtr(buf[i]), 20 - i)
     616End Function
     617
     618Function Str$(x As Long) As String
     619#ifdef _WIN64
     620    Return Str$(x As Int64)
     621#else
     622    If x < 0 Then
     623        Return "-" & Str$(-x As DWord)
     624    Else
     625        Return Str$(x As DWord)
     626    End If
     627#endif
     628End Function
     629
     630Function Str$(x As DWord) As String
     631#ifdef _WIN64
     632    Return Str$(x As QWord)
     633#else
     634    If x = 0 Then
     635        Return "0"
     636    End If
     637
     638    Dim buf[10] As StrChar
     639    buf[10] = 0
     640    Dim i = 9 As Long
     641    Do
     642        buf[i] = (x Mod 10 + &h30) As StrChar
     643        x \= 10
     644        If x = 0 Then
     645            Exit Do
     646        End If
     647        i--
     648    Loop
     649    Return New String(VarPtr(buf[i]), 10 - i)
     650#endif
     651End Function
     652
     653Function Str$(x As Word) As String
     654    Return Str$(x As ULONG_PTR)
     655End Function
     656
     657Function Str$(x As Integer) As String
     658    Return Str$(x As LONG_PTR)
     659End Function
     660
     661Function Str$(x As Byte) As String
     662    Return Str$(x As ULONG_PTR)
     663End Function
     664
     665Function Str$(x As SByte) As String
     666    Return Str$(x As LONG_PTR)
     667End Function
     668
     669Function Str$(x As Single) As String
     670    Return Str$(x As Double)
     671End Function
     672
     673Function Str$(b As Boolean) As String
     674    If b Then
     675        Return "True"
     676    Else
     677        Return "False"
     678    End If
    721679End Function
    722680
     
    775733
    776734    While buf[0]=Asc(" ") or buf[0]=Asc(Ex"\t")
    777         buf++
     735        buf = VarPtr(buf[1])
    778736    Wend
    779737
     
    11401098End Function
    11411099
     1100Function _System_ChrCpy(dst As PCWSTR, src As PCWSTR, size As SIZE_T) As PCWSTR
     1101    memcpy(dst, src, size * SizeOf (WCHAR))
     1102    Return dst
     1103End Function
     1104
     1105Function _System_ChrCpy(dst As PCSTR, src As PCSTR, size As SIZE_T) As PCSTR
     1106    memcpy(dst, src, size)
     1107    Return dst
     1108End Function
     1109
    11421110Function _System_StrCmp(s1 As PCSTR, s2 As PCSTR) As Long
    11431111    Dim i = 0 As SIZE_T
     
    12311199End Function
    12321200
    1233 Namespace ActiveBasic
    1234     Namespace Windows
    1235         Function GetPathFromIDList(pidl As LPITEMIDLIST) As String
    1236             Dim buf[ELM(MAX_PATH)] As TCHAR
    1237             If SHGetPathFromIDList(pidl, buf) Then
    1238                 Return New String(buf)
    1239             Else
    1240                 Return ""
    1241             End If
    1242         End Function
    1243 
    1244         Function GetFolderPath(hwnd As HWND, folder As Long) As String
    1245             Dim pidl As LPITEMIDLIST
    1246             Dim hr = SHGetSpecialFolderLocation(hwnd, folder, pidl)
    1247             If SUCCEEDED(hr) Then
    1248                 GetFolderPath = GetPathFromIDList(pidl)
    1249                 CoTaskMemFree(pidl)
    1250             Else
    1251                 GetFolderPath = ""
    1252             End If
    1253         End Function
    1254 
    1255         Function GetFolderPath(folder As Long) As String
    1256             Return GetFolderPath(0, folder)
    1257         End Function
    1258     End Namespace
    1259 End Namespace
    1260 
    12611201#endif '_INC_FUNCTION
  • Include/basic/prompt.sbp

    r258 r269  
    166166                .x = 0
    167167            ElseIf buf[i2] = &h0a Then 'LF \n
    168                 _PromptSys_TextLine[.y].Length = Math.Max(_PromptSys_TextLine[.y].Length, .x)
     168                _PromptSys_TextLine[.y].Length = System.Math.Max(_PromptSys_TextLine[.y].Length, .x)
    169169                .y++
    170170            Else
     
    203203            End If
    204204        Next
    205         _PromptSys_TextLine[.y].Length = Math.Max(_PromptSys_TextLine[.y].Length, .x)
     205        _PromptSys_TextLine[.y].Length = System.Math.Max(_PromptSys_TextLine[.y].Length, .x)
    206206
    207207        'Draw the text buffer added
Note: See TracChangeset for help on using the changeset viewer.