Changeset 269 for Include/basic
- Timestamp:
- Jun 2, 2007, 7:08:26 PM (17 years ago)
- Location:
- Include/basic
- Files:
-
- 3 edited
-
command.sbp (modified) (1 diff)
-
function.sbp (modified) (14 diffs)
-
prompt.sbp (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
Include/basic/command.sbp
r258 r269 34 34 35 35 Sub _System_End() 36 System.Detail.hasShutdownStarted = True 36 37 Dim exitCode = System.Environment.ExitCode 37 38 _System_EndProgram() -
Include/basic/function.sbp
r258 r269 13 13 14 14 #require <Classes/System/Math.ab> 15 #require <Classes/ActiveBasic/Math/Math.ab> 15 16 16 17 … … 91 92 End Function 92 93 93 #ifdef _WIN6494 95 Function _System_GetNaN() As Double96 SetQWord(VarPtr(_System_GetNaN) As *QWord, &H7FF8000000000000)97 End Function98 99 Function _System_GetInf(sign As Boolean) As Double100 Dim s = 0 As QWord101 If sign Then s = 1 << 63102 SetQWord(VarPtr(_System_GetInf) As *QWord, &h7FF0000000000000 Or s)103 End Function104 105 #else106 107 Function _System_GetNaN() As Double108 Dim p As *DWord109 p = VarPtr(_System_GetNaN) As *DWord110 p[0] = 0111 p[1] = &H7FF80000112 End Function113 114 Function _System_GetInf(sign As Boolean) As Double115 Dim s = 0 As DWord116 If sign Then s = (1 As DWord) << 31117 Dim p As *DWord118 p = VarPtr(_System_GetInf) As *DWord119 p[0] = 0120 p[1] = &h7FF00000 Or s121 End Function122 123 #endif124 125 ' xの符号だけをyのものにした値を返す。126 ' 引数 x 元となる絶対値127 ' 引数 y 元となる符号128 Function CopySign(x As Double, y As Double) As Double129 SetQWord(VarPtr(CopySign), (GetQWord(VarPtr(x)) And &h7fffffffffffffff) Or (GetQWord(VarPtr(y)) And &h8000000000000000))130 End Function131 132 Function CopySign(x As Single, y As Single) As Single133 SetDWord(VarPtr(CopySign), (GetDWord(VarPtr(x)) And &h7fffffff) Or (GetDWord(VarPtr(y)) And &h80000000))134 End Function135 136 Function _System_SetSign(x As Double, isNegative As Long) As Double137 #ifdef _WIN64138 SetQWord(AddressOf(CopySign), (GetQWord(VarPtr(x)) And &h7fffffffffffffff) Or (isNegative << 63))139 #else140 SetDWord(AddressOf(CopySign), GetDWord(VarPtr(x)))141 SetDWord(AddressOf(CopySign) + SizeOf (DWord), GetQWord(VarPtr(x) + SizeOf (DWord)) And &h7fffffff Or (isNegative << 31))142 #endif143 End Function144 145 94 Const RAND_MAX=&H7FFFFFFF 146 95 Dim _System_RndNext=1 As DWord … … 157 106 158 107 '------------- ここからBasic標準関数の定義 ------------- 159 160 108 161 109 '------------------ … … 193 141 194 142 Function Int(number As Double) As Long 195 Int =Fix(number)196 If number <0 Then197 If number <Fix(number) Then Int=Int-1143 Int = Fix(number) 144 If number < 0 Then 145 If number < Fix(number) Then Int-- 198 146 End If 199 147 End Function … … 221 169 222 170 Function Abs(number As Double) As Double 223 'Abs = Math.Abs(number)171 'Abs = System.Math.Abs(number) 224 172 If number < 0 then 225 173 return -number … … 230 178 231 179 Function Exp(x As Double) As Double 232 Exp = Math.Exp(x)180 Exp = System.Math.Exp(x) 233 181 End Function 234 182 235 183 Function 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) 260 185 End Function 261 186 262 187 Function Sgn(number As Double) As Long 263 Sgn = Math.Sign(number)188 Sgn = System.Math.Sign(number) 264 189 End Function 265 190 266 191 Function Sqr(number As Double) As Double 267 Sqr = Math.Sqrt(number)192 Sqr = System.Math.Sqrt(number) 268 193 End Function 269 194 270 195 Function 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) 294 197 End Function 295 198 296 199 Function Atn2(y As Double, x As Double) As Double 297 Atn2 = Math.Atan2(y, x)200 Atn2 = System.Math.Atan2(y, x) 298 201 End Function 299 202 300 203 Function Sin(number As Double) As Double 301 Sin = Math.Sin(number)204 Sin = System.Math.Sin(number) 302 205 End Function 303 206 304 207 Function Cos(number As Double) As Double 305 Cos = Math.Cos(number)208 Cos = System.Math.Cos(number) 306 209 End Function 307 210 308 211 Function 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) 343 213 End Function 344 214 … … 445 315 446 316 Function 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 448 322 End Function 449 323 … … 518 392 519 393 For i=10 To 1 Step -1 520 If (num \CDWord(8^i)) And &H07 Then394 If (num \ CDWord(8^i)) And &H07 Then 521 395 Exit For 522 396 End If … … 526 400 i2=0 527 401 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") 529 403 If i=0 Then Exit Do 530 404 i-- … … 619 493 620 494 Function Str$(dbl As Double) As String 621 If IsNaN(dbl) Then495 If ActiveBasic.Math.IsNaN(dbl) Then 622 496 Return "NaN" 623 ElseIf IsInf(dbl) Then497 ElseIf ActiveBasic.Math.IsInf(dbl) Then 624 498 If dbl > 0 Then 625 499 Return "Infinity" … … 715 589 End Function 716 590 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 ) 591 Function 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 597 End Function 598 599 Function 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) 616 End Function 617 618 Function 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 628 End Function 629 630 Function 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 651 End Function 652 653 Function Str$(x As Word) As String 654 Return Str$(x As ULONG_PTR) 655 End Function 656 657 Function Str$(x As Integer) As String 658 Return Str$(x As LONG_PTR) 659 End Function 660 661 Function Str$(x As Byte) As String 662 Return Str$(x As ULONG_PTR) 663 End Function 664 665 Function Str$(x As SByte) As String 666 Return Str$(x As LONG_PTR) 667 End Function 668 669 Function Str$(x As Single) As String 670 Return Str$(x As Double) 671 End Function 672 673 Function Str$(b As Boolean) As String 674 If b Then 675 Return "True" 676 Else 677 Return "False" 678 End If 721 679 End Function 722 680 … … 775 733 776 734 While buf[0]=Asc(" ") or buf[0]=Asc(Ex"\t") 777 buf ++735 buf = VarPtr(buf[1]) 778 736 Wend 779 737 … … 1140 1098 End Function 1141 1099 1100 Function _System_ChrCpy(dst As PCWSTR, src As PCWSTR, size As SIZE_T) As PCWSTR 1101 memcpy(dst, src, size * SizeOf (WCHAR)) 1102 Return dst 1103 End Function 1104 1105 Function _System_ChrCpy(dst As PCSTR, src As PCSTR, size As SIZE_T) As PCSTR 1106 memcpy(dst, src, size) 1107 Return dst 1108 End Function 1109 1142 1110 Function _System_StrCmp(s1 As PCSTR, s2 As PCSTR) As Long 1143 1111 Dim i = 0 As SIZE_T … … 1231 1199 End Function 1232 1200 1233 Namespace ActiveBasic1234 Namespace Windows1235 Function GetPathFromIDList(pidl As LPITEMIDLIST) As String1236 Dim buf[ELM(MAX_PATH)] As TCHAR1237 If SHGetPathFromIDList(pidl, buf) Then1238 Return New String(buf)1239 Else1240 Return ""1241 End If1242 End Function1243 1244 Function GetFolderPath(hwnd As HWND, folder As Long) As String1245 Dim pidl As LPITEMIDLIST1246 Dim hr = SHGetSpecialFolderLocation(hwnd, folder, pidl)1247 If SUCCEEDED(hr) Then1248 GetFolderPath = GetPathFromIDList(pidl)1249 CoTaskMemFree(pidl)1250 Else1251 GetFolderPath = ""1252 End If1253 End Function1254 1255 Function GetFolderPath(folder As Long) As String1256 Return GetFolderPath(0, folder)1257 End Function1258 End Namespace1259 End Namespace1260 1261 1201 #endif '_INC_FUNCTION -
Include/basic/prompt.sbp
r258 r269 166 166 .x = 0 167 167 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) 169 169 .y++ 170 170 Else … … 203 203 End If 204 204 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) 206 206 207 207 'Draw the text buffer added
Note:
See TracChangeset
for help on using the changeset viewer.
