Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
rtlib.bas
| Uploader: |  ThePuppetMaster |
| Datum/Zeit: | 26.08.2008 22:18:44 |
'###############################################################################################################
'###############################################################################################################
'### F B - C O R E
'###############################################################################################################
'###############################################################################################################
'### Version: 1.00.0
'### Revision: 0
'###############################################################################################################
'### (c) 2008 By.: /_\ DeltaLab's Germany [experimental computing]
'### Author: Martin Wiemann
'### Date of Idea: 2008.08.16 - 17:55:38
'###############################################################################################################
'### Copy('s) of this code or a part of this IS allowed!!!
'###############################################################################################################
'###############################################################################################################
#include once "rtlib_io.bi"
#include once "rtlib_memman.bi"
#include once "rtlib_video.bi"
'###############################################################################################################
Type _FBString
str_ptr as UByte Ptr
str_len as UInteger
alloc_size as UInteger
End Type
'###############################################################################################################
Sub TWait (V_Time as UInteger)
For Y as UInteger = 1 to V_Time
For X as UInteger = 1 to 400000000
Next
Next
End Sub
'###############################################################################################################
Public Function _fb_In CDecL Alias "fb_In" (V_Port as UInteger) as Integer
Return inb(V_Port)
End Function
'###############################################################################################################
Public Sub _fb_Cls CDecL Alias "fb_Cls" (V_Mode as UInteger)
Int_Text_CLS()
End Sub
'====================================================================================================================
Public Function _fb_Locate CDecL Alias "fb_Locate" (V_Row as Integer, V_Col as Integer, V_Cursor as Integer) as Integer
Int_Text_Cursor_Move(V_Row, V_Col)
If @V_Cursor <> 0 Then
If V_Cursor = 0 Then Int_Text_Cursor_Hide Else Int_Text_Cursor_Show
End If
Return V_Row * G_Video_Text_Col * 256 + V_Col
End Function
'====================================================================================================================
Public Function _fb_Color CDecL Alias "fb_Color" (V_ForeColor as Integer, V_BackColor as Integer, V_Flags as Integer) as Integer
G_Video_Text_Color = CByte(V_ForeColor)
Return G_Video_Text_Color
End Function
'###############################################################################################################
Public Sub _fb_PrintByte CDecL Alias "fb_PrintByte" (V_FD as UInteger, V_Value as Byte, V_Mask as UInteger)
If V_FD = 0 Then
Dim XNum(1 to 20) as UByte
Dim XNumS AS UByte
Dim X AS UInteger = 20
Dim N as UByte = 0
If V_Value < 0 Then V_Value += Cast(UByte, -1) + 1: N = 1
Do
If N = 1 Then
XNum(X) = 48 - ((V_Value) MOD 10)
Else: XNum(X) = V_Value MOD 10 + 48
End If
X -= 1: V_Value = V_Value \ 10
Loop Until V_Value = 0
If N = 1 Then Int_Text_Print_EX("-")
For X = 1 To 20
If XNum(X) = 0 AND XNumS = 0 Then Continue For
Int_Text_Print_EX(, XNum(X))
XNumS = 1
Next
If (V_Mask and 1) = 1 Then Int_Text_Print_EX(, 13): Int_Text_Print_EX(, 10)
Else
End If
End Sub
'--------------------------------------------------------------------------------------------------------------------
Public Sub _fb_PrintUByte CDecL Alias "fb_PrintUByte" (V_FD as UInteger, V_Value as UByte, V_Mask as UInteger)
If V_FD = 0 Then
Dim XNum(1 to 20) as UByte
Dim XNumS AS UByte
Dim X AS UInteger = 20
Do
XNum(X) = V_Value MOD 10 + 48
X -= 1: V_Value = V_Value \ 10
Loop Until V_Value <= 0
For X = 1 To 20
If XNum(X) = 0 AND XNumS = 0 Then Continue For
Int_Text_Print_EX(, XNum(X))
XNumS = 1
Next
If (V_Mask and 1) = 1 Then Int_Text_Print_EX(, 13): Int_Text_Print_EX(, 10)
Else
End If
End Sub
'====================================================================================================================
Public Sub _fb_PrintShort CDecL Alias "fb_PrintShort" (V_FD as UInteger, V_Value as Short, V_Mask as UInteger)
If V_FD = 0 Then
Dim XNum(1 to 20) as UByte
Dim XNumS AS UByte
Dim X AS UInteger = 20
Dim N as UByte = 0
If V_Value < 0 Then V_Value += Cast(UShort, -1) + 1: N = 1
Do
If N = 1 Then
XNum(X) = 48 - ((V_Value) MOD 10)
Else: XNum(X) = V_Value MOD 10 + 48
End If
X -= 1: V_Value = V_Value \ 10
Loop Until V_Value = 0
If N = 1 Then Int_Text_Print_EX("-")
For X = 1 To 20
If XNum(X) = 0 AND XNumS = 0 Then Continue For
Int_Text_Print_EX(, XNum(X))
XNumS = 1
Next
If (V_Mask and 1) = 1 Then Int_Text_Print_EX(, 13): Int_Text_Print_EX(, 10)
Else
End If
End Sub
'--------------------------------------------------------------------------------------------------------------------
Public Sub _fb_PrintUShort CDecL Alias "fb_PrintUShort" (V_FD as UInteger, V_Value as UShort, V_Mask as UInteger)
If V_FD = 0 Then
Dim XNum(1 to 20) as UByte
Dim XNumS AS UByte
Dim X AS UInteger = 20
Do
XNum(X) = V_Value MOD 10 + 48
X -= 1: V_Value = V_Value \ 10
Loop Until V_Value <= 0
For X = 1 To 20
If XNum(X) = 0 AND XNumS = 0 Then Continue For
Int_Text_Print_EX(, XNum(X))
XNumS = 1
Next
If (V_Mask and 1) = 1 Then Int_Text_Print_EX(, 13): Int_Text_Print_EX(, 10)
Else
End If
End Sub
'====================================================================================================================
Public Sub _fb_PrintInt CDecL Alias "fb_PrintInt" (V_FD as UInteger, V_Value as Integer, V_Mask as UInteger)
If V_FD = 0 Then
Dim XNum(1 to 20) as UByte
Dim XNumS AS UByte
Dim X AS UInteger = 20
Dim N as UByte = 0
If V_Value < 0 Then V_Value += Cast(UInteger, -1) + 1: N = 1
Do
If N = 1 Then
XNum(X) = 48 - ((V_Value) MOD 10)
Else: XNum(X) = V_Value MOD 10 + 48
End If
X -= 1: V_Value = V_Value \ 10
Loop Until V_Value = 0
If N = 1 Then Int_Text_Print_EX("-")
For X = 1 To 20
If XNum(X) = 0 AND XNumS = 0 Then Continue For
Int_Text_Print_EX(, XNum(X))
XNumS = 1
Next
If (V_Mask and 1) = 1 Then Int_Text_Print_EX(, 13): Int_Text_Print_EX(, 10)
Else
End If
End Sub
'--------------------------------------------------------------------------------------------------------------------
Public Sub _fb_PrintUInt CDecL Alias "fb_PrintUInt" (V_FD as UInteger, V_Value as UInteger, V_Mask as UInteger)
If V_FD = 0 Then
Dim XNum(1 to 20) as UByte
Dim XNumS AS UByte
Dim X AS UInteger = 20
Do
XNum(X) = V_Value MOD 10 + 48
X -= 1: V_Value = V_Value \ 10
Loop Until V_Value <= 0
For X = 1 To 20
If XNum(X) = 0 AND XNumS = 0 Then Continue For
Int_Text_Print_EX(, XNum(X))
XNumS = 1
Next
If (V_Mask and 1) = 1 Then Int_Text_Print_EX(, 13): Int_Text_Print_EX(, 10)
Else
End If
End Sub
'====================================================================================================================
Public Sub _fb_PrintInteger CDecL Alias "fb_PrintInteger" (V_FD as UInteger, V_Value as Integer, V_Mask as UInteger)
If V_FD = 0 Then
Dim XNum(1 to 20) as UByte
Dim XNumS AS UByte
Dim X AS UInteger = 20
Dim N as UByte = 0
If V_Value < 0 Then V_Value += Cast(UInteger, -1) + 1: N = 1
Do
If N = 1 Then
XNum(X) = 48 - ((V_Value) MOD 10)
Else: XNum(X) = V_Value MOD 10 + 48
End If
X -= 1: V_Value = V_Value \ 10
Loop Until V_Value = 0
If N = 1 Then Int_Text_Print_EX("-")
For X = 1 To 20
If XNum(X) = 0 AND XNumS = 0 Then Continue For
Int_Text_Print_EX(, XNum(X))
XNumS = 1
Next
If (V_Mask and 1) = 1 Then Int_Text_Print_EX(, 13): Int_Text_Print_EX(, 10)
Else
End If
End Sub
'--------------------------------------------------------------------------------------------------------------------
Public Sub _fb_PrintUInteger CDecL Alias "fb_PrintUInteger" (V_FD as UInteger, V_Value as UInteger, V_Mask as UInteger)
If V_FD = 0 Then
Dim XNum(1 to 20) as UByte
Dim XNumS AS UByte
Dim X AS UInteger = 20
Do
XNum(X) = V_Value MOD 10 + 48
X -= 1: V_Value = V_Value \ 10
Loop Until V_Value <= 0
For X = 1 To 20
If XNum(X) = 0 AND XNumS = 0 Then Continue For
Int_Text_Print_EX(, XNum(X))
XNumS = 1
Next
If (V_Mask and 1) = 1 Then Int_Text_Print_EX(, 13): Int_Text_Print_EX(, 10)
Else
End If
End Sub
'====================================================================================================================
Public Sub _fb_PrintString CDecL Alias "fb_PrintString" (V_FD as UInteger, V_Handle as _FBString Ptr, V_Mask as UInteger)
If V_FD = 0 Then
Dim XP AS UByte Ptr = V_Handle->str_ptr
' Int_Text_Add("[PRISTR] "): _fb_PrintInteger(0, Cast(Integer, V_Handle), 0)
For X as UInteger = 1 to V_Handle->str_len
Int_Text_Print_EX(, *XP): XP += 1
Next
If (V_Mask and 1) = 1 Then Int_Text_Print_EX(, 13): Int_Text_Print_EX(, 10)
Else
End If
End Sub
'###############################################################################################################
Public Function _malloc CDecL Alias "malloc" (V_Length As UInteger) as Any Ptr
Dim TAPtr as Any Ptr = _mem_alloc(V_Length)
'Int_Text_Add("[MALLOC] "): _fb_PrintInteger(0, Cast(Integer, TAPtr), 0)
Return TAPtr
End Function
'###############################################################################################################
Public Function _fb_StrAllocTempDescZEx CDecL Alias "fb_StrAllocTempDescZEx" (ByVal str_ptr as UByte Ptr, ByVal str_len AS UInteger) as _FBString Ptr
Dim THandle AS _FBString Ptr = _malloc(SIZEOF(_FBString))
THandle->str_ptr = str_ptr
THandle->str_len = str_len
THandle->alloc_size = str_len
Return THandle
End Function
'###############################################################################################################
Public Function _fb_CHR CDecL Alias "fb_CHR" (V_ArgC as UInteger, ...) as _FBString Ptr
Dim THandle AS _FBString Ptr = _fb_StrAllocTempDescZEx(_malloc(V_ArgC), V_ArgC)
Dim TPtr as UByte Ptr = THandle->str_ptr
Dim XARG as Any Ptr = va_first()
For X as UInteger = 1 to V_ArgC
*TPtr = va_arg(XARG, UByte)
XARG = va_next(XARG, UByte)
TPtr += 1
Next
Return THandle
End Function
'====================================================================================================================
Public Function _fb_ZStrLen(ByRef V_Src as UByte Ptr) as UInteger
Dim XPtr as UByte Ptr = V_Src
Do Until *XPtr = 0
XPtr += 1
Loop
Return Cast(UInteger, XPtr - V_Src)
End Function
'--------------------------------------------------------------------------------------------------------------------
Public Sub _fb_FIXSTRING(ByRef V_Str as Any Ptr, ByRef V_Size as Integer, ByRef B_StrPtr as UByte Ptr, ByRef B_Size as Integer)
If V_Size = -1 Then
' Int_Text_Add("[FIXSTR] +Z+")
B_StrPtr = Cast(UByte Ptr, V_Str)
B_Size = Cast(Integer, Cast(_FBString Ptr, @V_Str)->str_len)
Else
' Int_Text_Add("[FIXSTR] +D+")
B_StrPtr = @V_Str
B_Size = V_Size - 1
End If
End Sub
'====================================================================================================================
Public Sub _fb_StrDelete CDecL Alias "fb_StrDelete" (ByRef V_String as _FBString Ptr)
'Int_Text_Add("[StrDel]")
_mem_free(V_String->str_ptr)
V_String->str_ptr = 0
V_String->str_len = 0
V_String->alloc_size = 0
_mem_free(V_String)
V_String = 0
End Sub
'--------------------------------------------------------------------------------------------------------------------
Public Function _fb_StrConcat CDecL Alias "fb_StrConcat" (ByVal V_Dest as _FBString Ptr, ByRef V_Src1 as Any Ptr, ByVal V_Src1_Size as Integer, ByRef V_Src2 as Any Ptr, ByVal V_Src2_Size as Integer) as _FBString Ptr
Dim TS1Len as UInteger
Dim TS1Ptr as UByte Ptr
Dim TS2Len as UInteger
Dim TS2Ptr as UByte Ptr
_fb_FIXSTRING(V_Src1, V_Src1_Size, TS1Ptr, TS1Len)
_fb_FIXSTRING(V_Src2, V_Src2_Size, TS2Ptr, TS2Len)
If Cast(_FBString Ptr, V_Dest)->str_ptr <> 0 Then _mem_free(Cast(_FBString Ptr, V_Dest)->str_ptr)
Cast(_FBString Ptr, V_Dest)->str_ptr = _malloc(TS1Len + TS2Len)
Cast(_FBString Ptr, V_Dest)->str_len = TS1Len + TS2Len
Cast(_FBString Ptr, V_Dest)->alloc_size = TS1Len + TS2Len
_memcpy(Cast(_FBString Ptr, V_Dest)->str_ptr, TS1Ptr, TS1Len)
_memcpy(Cast(_FBString Ptr, V_Dest)->str_ptr + TS1Len, TS2Ptr, TS2Len)
Return V_Dest
End Function
'--------------------------------------------------------------------------------------------------------------------
Public Function _fb_StrAssign CDecL Alias "fb_StrAssign" (ByVal V_Dest as Any Ptr, ByVal V_Dest_Size as Integer, ByRef V_Src as Any Ptr, ByVal V_Src_Size as Integer, ByVal V_Fill_Rem as Integer) as Any Ptr
Dim TSLen as UInteger
Dim TSPtr as UByte Ptr
_fb_FIXSTRING(V_Src, V_Src_Size, TSPtr, TSLen)
If V_Dest_Size = -1 Then
Cast(_FBString Ptr, V_Dest)->str_ptr = _malloc(TSLen)
Cast(_FBString Ptr, V_Dest)->str_len = TSLen
Cast(_FBString Ptr, V_Dest)->alloc_size = TSLen
_memcpy(Cast(_FBString Ptr, V_Dest)->str_ptr, TSPtr, TSLen)
Else ' ZString
End If
Return V_Dest
End Function
'--------------------------------------------------------------------------------------------------------------------
Public Function _fb_StrConcatAssign CDecL Alias "fb_StrConcatAssign" (ByVal V_Dest as Any Ptr, ByVal V_Dest_Size as Integer, ByRef V_Src as Any Ptr, ByVal V_Src_Size as Integer, ByVal V_Fill_Rem as Integer) as Any Ptr
Dim TSLen as UInteger
Dim TSPtr as UByte Ptr
_fb_FIXSTRING(V_Src, V_Src_Size, TSPtr, TSLen)
If V_Dest_Size = -1 Then
If Cast(_FBString Ptr, V_Dest)->str_ptr <> 0 Then
Dim TPtr as UByte Ptr = _malloc(Cast(_FBString Ptr, V_Dest)->str_len + TSLen)
_memcpy(TPtr, Cast(_FBString Ptr, V_Dest)->str_ptr, Cast(_FBString Ptr, V_Dest)->str_len)
_memcpy(TPtr + Cast(_FBString Ptr, V_Dest)->str_len, TSPtr, TSLen)
_mem_free(Cast(_FBString Ptr, V_Dest)->str_ptr)
Cast(_FBString Ptr, V_Dest)->str_ptr = TPtr
Cast(_FBString Ptr, V_Dest)->str_len += TSLen
Cast(_FBString Ptr, V_Dest)->alloc_size += TSLen
End if
Else ' ZString
End If
Return V_Dest
End Function
'--------------------------------------------------------------------------------------------------------------------
Public Function _fb_StrCompare CDecL Alias "fb_StrCompare" (ByRef V_Src1 as Any Ptr, ByVal V_Src1_Size as Integer, ByRef V_Src2 as Any Ptr, ByVal V_Src2_Size as Integer) as Integer
Dim TS1Len as UInteger
Dim TS1Ptr as UByte Ptr
Dim TS2Len as UInteger
Dim TS2Ptr as UByte Ptr
_fb_FIXSTRING(V_Src1, V_Src1_Size, TS1Ptr, TS1Len)
_fb_FIXSTRING(V_Src2, V_Src2_Size, TS2Ptr, TS2Len)
If TS1Ptr = TS2Ptr Then Return 0
If (TS1Len or TS2Len) = 0 Then Return 0
If TS1Len <> TS2Len Then Return 1
Dim C as UInteger
Do
If *TS1Ptr <> *TS2Ptr Then Return 1
TS1Ptr += 1
TS2Ptr += 1
Loop Until (*TS1Ptr = 0) and (*TS2Ptr = 0)
Return 0
End Function
'--------------------------------------------------------------------------------------------------------------------
Public Function _fb_StrInStr CDecL Alias "fb_StrInstr" (ByVal V_Start as Integer, ByRef V_Src as _FBString, ByRef V_Search as _FBString) as Integer
If V_Src.str_len < V_Start Then Return 0
If V_Search.str_len <= 0 Then Return 0
Dim TSPtr as Ubyte Ptr = V_Src.str_ptr
Dim TFPtr as Ubyte Ptr = V_Search.str_ptr
Dim Y as UInteger
For X as UInteger = V_Start To V_Src.str_len
If *TSPtr = *TFPtr Then
For Y = 1 to V_Search.str_len
If X + Y - 1 > V_Src.str_len Then Return 0
If *(TSPtr + Y) <> *(TFPtr + Y) Then Exit For
Next
If Y = V_Search.str_len Then Return X
End If
TSPtr += 1
Next
Return 0
End Function
#include once "rtlib_input.bi"