Author Topic: Puzzle-Time :-)  (Read 5980 times)

0 Members and 1 Guest are viewing this topic.

Offline Theo Gottwald

  • Administrator
  • Hero Member
  • *****
  • Posts: 899
    • it-berater
Puzzle-Time :-)
« on: July 19, 2009, 10:37:40 PM »
Aaah ... all this perfect readable and understandable code looks boring to you?

You want to see something thats completely undokumented and crypted?
While still usable, if you can find out what it does?

A puzzle, you have to find out what its good for at the end?

Ok, then you found the right Post. Take a look on this.

Its an older code (working!) which was from the times of PB 8 when we did not yet have the comfort of Objects.
I can say it has to do with Datatypes.

This code hits the edge of what was possible using PB 8.

Code: [Select]


#IF NOT %DEF(%M_MTPC_INC)
%M_MTPC_INC=1

' MACRO M_Create_List(P1)  - erzeugt neuen Parameterblock
' FUNCTION M_AY(BYVAL a AS LONG) AS DWORD - Stepweiser Increment für Speicherverwaltung 3 3 3 3 6 6 6 6 usw.
' SUB M_AL(BYREF T01() AS STRING,BYVAL T02 AS DWORD) - Redim Preserve für Stringfelder
' SUB M_AM(BYREF T01() AS BYTE,BYVAL T02 AS DWORD) - ' Redim Preserve für Bytefeld
' SUB M_AK(BYVAL T01 AS M_Enum PTR) - Redim if necessary, abhängig von .N
' SUB M_AO(BYVAL T01 AS M_Enum PTR,BYVAL T02 AS LONG) -  Add Element T02 on TOS Freestack
' FUNCTION M_AN(BYVAL T01 AS M_Enum PTR) AS LONG - Get Freestack-Element oder -1 wenn keines da
' FUNCTION M_AP(BYVAL T01 AS M_Enum PTR,BYREF T02 AS BYTE) AS LONG  - Get Free-Index, Set Byte to T02
' SUB M_Free(BYVAL T01 AS M_Enum PTR,BYVAL T02 AS LONG) - Set Element T02 to "Free"
' SUB M_AR(BYVAL T01 AS M_Enum PTR,BYVAL T02 AS LONG,BYREF T03 AS STRING,BYREF T04 AS STRING,BYREF T05 AS STRING,BYREF T06 AS STRING,BYREF T07 AS STRING) Die Parameter T03-T07 zuweisen auf den Parameterstapel, Index T02,  nicht Multithreadingsafe
' FUNCTION M_New(BYVAL T01 AS M_Enum PTR,BYREF T03 AS STRING,BYREF T04 AS STRING,BYREF T05 AS STRING,BYREF T06 AS STRING,BYREF T07 AS STRING) AS LONG - Reserve free Element, set Strings and return index to it, Multithreading-safe
' MACRO FUNCTION M_GetEl(P1,P2) - Get Parameter-Element P2 from Index P1
' MACRO M_SetElm(P1,P2,P3) - Set Parameter-Element P2 from Index P1 to String P3, Multithreadingsafe
' MACRO M_SetEl(P1,P2,P3)  - Set Parameter-Element P2 from Index P1 to String P3, nicht Multithreadingsafe

' USE:
'M_Create_List(C42,1,25,10)
'T01=M_New1(C42,"Jose")
'X_AU "Got: "+STR$(T01)
'X_AU "->"+M_GetEl(C42,T01,0)
'--------------------------------------------------------------------
' Achtung!
' Es muss ein:
' DeleteCriticalSection @C42.@CS
' pro Liste
' ans ENDE der Applikation gemacht werden
'--------------------------------------------------------------------
' Type-Defs
'--------------------------------------------------------------------
#IF NOT %DEF(%Type_M_Enum)
%Type_M_Enum=1
TYPE M_Enum
 A1 AS LONG ' Additional Infos 1
 A2 AS LONG ' Additional Infos 2
 A3 AS LONG ' Additional Infos 3
 A4 AS LONG ' Additional Infos 4
 A5 AS LONG ' Additional Infos 5
 N AS DWORD ' Anzahl Elemente
 D AS DWORD ' Aktuell Dimensioniert
 E AS DWORD ' Anzahl Dimensionen in Dimension 1 (fix)
 GW AS DWORD ' Grundwert bei Dimensionierung
 SW AS DWORD ' Stepwert für Dimensionierung
 S AS STRING PTR
 B AS BYTE PTR ' Byte-Feld (Byte Allocation Table)
 FP AS STRING PTR ' Freestack-Stringptr
 FPF AS STRING PTR ' First Element Freestack
 FS AS LONG ' Freestack-Elements
 CS AS CRITICAL_SECTION PTR
END TYPE
#ENDIF

MACRO M_Lock(P1)
  EnterCriticalSection @P1.@CS
END MACRO

MACRO M_Unlock(P1)
  LeaveCriticalSection @P1.@CS
END MACRO

'######################################################################################################################
'######################################################################################################################

' P1 - Name
' P2 - Anzahl der Dimensionen in Dimension 1, Beispiel:4
' P3 - Grundwert für Dimensionierung, z.b. 25
' P4 - Stepwert z.b. 10
MACRO M_Create_List(P1,P2,P3,P4)
MACROTEMP M01,M02,M03,M04,M05
GLOBAL M01 AS M_Enum
GLOBAL M02() AS STRING
GLOBAL M03() AS BYTE
GLOBAL M04 AS STRING ' Freestack
GLOBAL M05 AS CRITICAL_SECTION
 P1=VARPTR(M01)
 M01.GW=P3:M01.SW=P4 ' Grundwert und Stepwert notieren
 M01.S=VARPTR(M02())
 M01.B=VARPTR(M03())
 DIM M02(P2,P3),M03(P3)
 M01.E=P2 ' Anzahl Elemente in der 1. (fixen) Dimension
 M01.D=P3 ' Anzahl Elemente in der 2 ten - dynamischen Dimension
 M01.FP=VARPTR(M04)
 M01.FPF=STRPTR(M04)
 M01.N=0
 M01.CS=VARPTR(M05)
 InitializeCriticalSection M01.@CS
END MACRO
'--------------------------------------------------------------------
'--------------------------------------------------------------------
' Get Parameter-Block Max-Element
MACRO FUNCTION M_GetME(P1)= @P1.N

'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################


'Multi-Thread-Parameter-Block 2
#IF NOT %DEF(%M_Array_INC)
%M_Array_INC=1

' MACRO M_Create_Array(P1)  - erzeugt neues Nummerisches Array
' USE:
'M_Create_Array(C41,1,25,10)

'--------------------------------------------------------------------
' Achtung!
' Es muss ein:
' DeleteCriticalSection @C41.@CS
' pro Liste
' ans ENDE der Applikation gemacht werden
'--------------------------------------------------------------------
' Type-Defs
'--------------------------------------------------------------------
#IF NOT %DEF(%Type_M_EnumA)
%Type_M_EnumA=1
TYPE M_EnumA
 A1 AS LONG ' Additional Infos 1
 A2 AS LONG ' Additional Infos 2
 A3 AS LONG ' Additional Infos 3
 A4 AS LONG ' Additional Infos 4
 N AS DWORD ' Anzahl Elemente
 D AS DWORD ' Aktuell Dimensioniert
 GW AS DWORD ' Grundwert bei Dimensionierung
 SW AS DWORD ' Stepwert für Dimensionierung
 L1 AS LONG PTR ' Numerisches-Feld 1(LONG)
 L2 AS LONG PTR ' Numerisches-Feld 2(LONG)
 LP1 AS LONG PTR ' Numerisches-Feld 1(LONG) erstes Element
 LP2 AS LONG PTR ' Numerisches-Feld 2(LONG) erstes Element
 CS AS CRITICAL_SECTION PTR
END TYPE

TYPE M_EnumB
 A1 AS LONG ' Additional Infos 1
 A2 AS LONG ' Additional Infos 2
 A3 AS LONG ' Additional Infos 3
 A4 AS LONG ' Additional Infos 4
 N AS DWORD ' Anzahl Elemente
 D AS DWORD ' Aktuell Dimensioniert
 GW AS DWORD ' Grundwert bei Dimensionierung
 SW AS DWORD ' Stepwert für Dimensionierung
 L1 AS LONG PTR ' Numerisches-Feld 1(LONG)
 L2 AS LONG PTR ' Numerisches-Feld 2(LONG)
 L3 AS LONG PTR ' Numerisches-Feld 3(LONG)
 L4 AS LONG PTR ' Numerisches-Feld 4(LONG)
 LP1 AS LONG PTR ' Numerisches-Feld 1(LONG) erstes Element
 LP2 AS LONG PTR ' Numerisches-Feld 2(LONG) erstes Element
 LP3 AS LONG PTR ' Numerisches-Feld 3(LONG) erstes Element
 LP4 AS LONG PTR ' Numerisches-Feld 4(LONG) erstes Element
 CS AS CRITICAL_SECTION PTR
END TYPE
#ENDIF

MACRO M_LockA(P1)
  EnterCriticalSection(@P1.@CS)
END MACRO

MACRO M_UnlockA(P1)
  LeaveCriticalSection(@P1.@CS)
END MACRO
'--------------------------------------------------------------------
' P2 - Stepwert=Grundwert z.b. 10
MACRO M_Create_ArrayA(P1,P2)
MACROTEMP M01,M02,M03,M04
GLOBAL M01 AS M_EnumA
GLOBAL M02(),M03() AS LONG
GLOBAL M04 AS CRITICAL_SECTION
 P1=VARPTR(M01)
 M01.GW=P2:M01.SW=P2 ' Grundwert und Stepwert notieren
 M01.L1=VARPTR(M02())
 M01.L2=VARPTR(M03())
 DIM M02(P2),M03(P2)
 M01.D=P2
 M01.N=0
 M01.LP1=VARPTR(M02(0))
 M01.LP2=VARPTR(M03(0))
 M01.CS=VARPTR(M04)
 InitializeCriticalSection M01.@CS
END MACRO
'--------------------------------------------------------------------
' P2 - Stepwert=Grundwert z.b. 10
MACRO M_Create_ArrayB(P1,P2)
MACROTEMP M01,M02,M03,M04,M05,M06
GLOBAL M01 AS M_EnumB
GLOBAL M02(),M03(),M04(),M05() AS LONG
GLOBAL M06 AS CRITICAL_SECTION
 P1=VARPTR(M01)
 M01.GW=P2:M01.SW=P2 ' Grundwert und Stepwert notieren
 M01.L1=VARPTR(M02())
 M01.L2=VARPTR(M03())
 M01.L3=VARPTR(M04())
 M01.L4=VARPTR(M05())
 DIM M02(P2),M03(P2),M04(P2),M05(P2)
 M01.D=P2
 M01.N=0
 M01.LP1=VARPTR(M02(0))
 M01.LP2=VARPTR(M03(0))
 M01.LP3=VARPTR(M04(0))
 M01.LP4=VARPTR(M05(0))
 M01.CS=VARPTR(M06)
 InitializeCriticalSection M01.@CS
END MACRO
'--------------------------------------------------------------------
' Get Array-Element L1(P2) von Object P1
MACRO FUNCTION M_GetEL1(P1,P2)= @P1.@LP1[P2]
'--------------------------------------------------------------------
' Get Array-Element L2(P2) von Object P1
MACRO FUNCTION M_GetEL2(P1,P2)= @P1.@LP2[P2]
'--------------------------------------------------------------------
' Get Array-Element L3(P2) von Object P1
MACRO FUNCTION M_GetEL3(P1,P2)= @P1.@LP3[P2]
'--------------------------------------------------------------------
' Get Array-Element L4(P2) von Object P1
MACRO FUNCTION M_GetEL4(P1,P2)= @P1.@LP4[P2]
'--------------------------------------------------------------------
' Get Parameter-Block Max-Element
MACRO FUNCTION M_GetMEA(P1)= @P1.N
'--------------------------------------------------------------------
'MACRO  M_SetEL2(P1,P2,P3,P4) - Set Parameter-Element L1(=P3) und L2 (=P4) from Array P1, Index P2, Multithreadingsafe
MACRO M_SetEL2(P1,P2,P3,P4)
 M_Lock(P1)
 @P4.@LP1[P2]=P3:@P4.@LP2[P2]=P4
 M_UnLock(P1)
END MACRO
'--------------------------------------------------------------------
'MACRO  M_SetE4(P1,P2,P3,P4) - Set Parameter-Element L1(=P3) und L2 (=P4) from Array P1, Index P2, Multithreadingsafe
MACRO M_SetE4(P1,P2,P3,P4,P5,P6)
 M_Lock(P1)
 @P4.@LP1[P2]=P3:@P4.@LP2[P2]=P4
 @P4.@LP3[P2]=P5:@P4.@LP4[P2]=P6
 M_UnLock(P1)
END MACRO
'--------------------------------------------------------------------
' MACRO  M_SetE2(P1,P2,P3,P4) - Set Parameter-Element L1(=P3) und L2 (=P4) from Array P1, Index P2, NICHT Multithreadingsafe
MACRO M_SetE2(P1,P2,P3,P4)
 @P4.@LP1[P2]=P3:@P4.@LP2[P2]=P4
END MACRO
'--------------------------------------------------------------------
' MACRO  M_ReSetALB(P1,P2) - Set Parameter-Element L1=0 und L2=0 from Array P1, Index P2, NICHT Multithreadingsafe
MACRO M_ReSetZ2(P1,P2)
 @P4.@LP1[P2]=0:@P4.@LP2[P2]=0
END MACRO
'--------------------------------------------------------------------
' MACRO  M_ReSetZ4(P1,P2) - Set Parameter-Element L1=0 und L2=0 from Array P1, Index P2, NICHT Multithreadingsafe
MACRO M_ReSetZ4(P1,P2)
 @P4.@LP1[P2]=0:@P4.@LP2[P2]=0
 @P4.@LP3[P2]=0:@P4.@LP4[P2]=0
END MACRO

'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_AU_INC)
%M_AU_INC=1

'--------------------------------------------------------------------
' Reserve free Element, set Strings (nur T03,rest leer) and return index to it, Multithreading-safe
FUNCTION M_AU(BYVAL T01 AS M_Enum PTR,BYREF T03 AS STRING) AS LONG
  REGISTER R01 AS LONG,R02 AS LONG
  LOCAL T05 AS STRING
  T05="":EnterCriticalSection @T01.@CS
  R02=M_AP(T01,1) ' Get/reserve next Free
  M_AR BYVAL @T01.S,R02,T03,T05,T05,T05,T05
  LeaveCriticalSection @T01.@CS
  FUNCTION=R02
 END FUNCTION

 MACRO FUNCTION M_New1(P1,P2) = M_AU(P1,P2)
'--------------------------------------------------------------------
#ENDIF
'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_AP_INC)
%M_AP_INC=1

'--------------------------------------------------------------------
' Get Free-Index, Set Byte to T02
 FUNCTION M_AP(BYVAL T01 AS M_Enum PTR,BYREF T02 AS BYTE) AS LONG
  REGISTER R01 AS LONG,R02 AS LONG
  R01=M_AN(T01)
  IF (R01=-1) THEN
    INCR @T01.N
    M_AK(T01)
    R02=@T01.N-1
  ELSE
    R02=R01
  END IF
   M_BS(BYVAL @T01.B,R02,T02)
  FUNCTION=R02
 END FUNCTION
'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_AR_INC)
%M_AR_INC=1

'--------------------------------------------------------------------
' Die Parameter T03-T07 zuweisen auf den Parameterstapel, Index T02,  nicht Multithreadingsafe
SUB M_AR(BYREF T01() AS STRING,BYVAL T02 AS LONG,BYREF T03 AS STRING,BYREF T04 AS STRING,BYREF T05 AS STRING,BYREF T06 AS STRING,BYREF T07 AS STRING)
  REGISTER R01 AS LONG,R02 AS LONG
  R01=T02
  T01(0,R01)=T03
  T01(1,R01)=T04
  T01(2,R01)=T05
  T01(3,R01)=T06
  T01(4,R01)=T07
END SUB
'--------------------------------------------------------------------
#ENDIF
'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_BJ_INC)
%M_BJ_INC=1

'--------------------------------------------------------------------
' (internal) Array Redim, ohne Lock, ohne Check
SUB M_BJ(BYVAL M01 AS M_EnumB PTR,BYREF T01() AS LONG,BYREF T02() AS LONG,BYREF T03() AS LONG,BYREF T04() AS LONG)
 REGISTER R01 AS LONG,R02 AS LONG
 R02=@M01.N
 IF zero(R02) THEN GOTO enx
  R01=M_AY(R02,BYVAL @M01.SW)
  IF (R01<>@M01.D) THEN
   REDIM PRESERVE T01(R01)
   REDIM PRESERVE T02(R01)
   REDIM PRESERVE T03(R01)
   REDIM PRESERVE T04(R01)
   @M01.D=R01
  END IF
  enx:
END SUB
'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_AK_INC)
%M_AK_INC=1

'--------------------------------------------------------------------
' Redim if necessary, abhängig von .N
SUB M_AK(BYVAL T01 AS M_Enum PTR)
REGISTER R01 AS DWORD,R02 AS DWORD
'incr @T01.N)
R01=M_AY(@T01.N,@T01.SW)
IF (R01<>@T01.D) THEN
'   X_AU "in M_AK: Dimme: "+STR$(@T01.E)+","+STR$(R01)
   M_AL T01,BYVAL @T01.S,R01 ' REDIM PRESERVE String
   M_AM BYVAL @T01.B,R01 ' REDIM PRESERVE Byte
   @T01.D=R01
END IF
END SUB
'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_AL_INC)
%M_AL_INC=1

'--------------------------------------------------------------------
' Redim Preserve für Stringfelder
SUB M_AL(BYVAL T01 AS M_Enum PTR,BYREF T02() AS STRING,BYVAL T03 AS LONG)
 REDIM PRESERVE T02((@T01.E),T03)
' X_AU "Bounds:"+STR$(UBOUND(T02(1)))+","+STR$(UBOUND(T02(2)))
END SUB
'--------------------------------------------------------------------
#ENDIF
'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_AM_INC)
%M_AM_INC=1

'--------------------------------------------------------------------
' Redim Preserve für Bytefeld
SUB M_AM(BYREF T01() AS BYTE,BYVAL T02 AS DWORD)
 REDIM PRESERVE T01(T02)
END SUB
'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_AY_INC)
%M_AY_INC=1

'--------------------------------------------------------------------
' Stepweiser Increment für Speicherverwaltung 3 3 3 3 6 6 6 6 usw.
' a  =aktueller Wert, b=Stepwert, Rückgabe ist der Wert für Redim
FUNCTION M_AY(BYVAL T01 AS LONG,BYVAL T02 AS DWORD) AS DWORD
REGISTER T04 AS DWORD
A_DIV(T04,T01,T02)
A_INC(T04)
!MOV EAX,T04
!MUL T02
!MOV function,eax
END FUNCTION

'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################
#IF NOT %DEF(%M_AN_INC)
%M_AN_INC=1

'--------------------------------------------------------------------
' Get Freestack-Element oder -1 wenn keines da
FUNCTION M_AN(BYVAL T01 AS M_Enum PTR) AS LONG
 REGISTER R01 AS LONG,R02 AS LONG
 R01=@T01.FS
 IF (R01>0) THEN
     R02=CVL(RIGHT$(@T01.@FPF,4))
     DECR @T01.FS:R01=LEN(@T01.@FPF)
     @T01.@FPF=LEFT$(@T01.@FPF,R01-4)
 ELSE
     R02=-1
 END IF
 FUNCTION=R02
END FUNCTION
'--------------------------------------------------------------------
#ENDIF
'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_BS_INC)
%M_BS_INC=1

'--------------------------------------------------------------------
' Set Byte-Array Element T02 to T03
SUB M_BS(BYREF T01() AS BYTE,BYVAL T02 AS LONG,BYVAL T03 AS LONG)
  T01(T02)=T03
END SUB
'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_AS_INC)
%M_AS_INC=1

'--------------------------------------------------------------------
 ' M_Free Set Element T02 to "Free"
 SUB M_AS(BYVAL T01 AS M_Enum PTR,BYVAL T02 AS LONG)
   REGISTER R01 AS LONG,R02 AS DWORD
   IF (@T01.@B[T02]=0) THEN GOTO enx ' Already free
   R02=@T01.E:@T01.@B[T02]=0 ' Byte auf 0 setzen
   GFOR(R01,0,R02)
    M_SetElClr(T01,R01,T02)
   GNAX(R01)
   M_AO T01,T02
   enx:
 END SUB

 MACRO M_Free(P1,P2)
  M_AS(P1,P2)
 END MACRO
'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_AO_INC)
%M_AO_INC=1

'--------------------------------------------------------------------
' Add Element T02 on TOS Freestack
SUB M_AO(BYVAL T01 AS M_Enum PTR,BYVAL T02 AS LONG)
 REGISTER R01 AS LONG,R02 AS LONG
  IF (@T01.FS=0) THEN
    @T01.@FPF=MKL$(T02)
  ELSE
    @T01.@FPF=@T01.@FPF+MKL$(T02)
  END IF
  INCR @T01.FS ' Size erhöhen
END SUB
'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_BR_INC)
%M_BR_INC=1

'--------------------------------------------------------------------
' Set MTPC-String Element to ""
SUB M_BR(BYREF T01() AS STRING,BYVAL T02 AS LONG,BYVAL T03 AS LONG)
 T01(T02,T03)=""
END SUB
'--------------------------------------------------------------------
'MACRO  M_SetElm(P1,P2,P3) - Set Parameter-Element P2 from Index P1 to String P3, Multithreadingsafe
MACRO  M_SetElmCLR(P4,P1,P2)
 M_Lock(P4)
  M_BR BYVAL @P4.S,P1,P2
 M_UnLock(P4)
END MACRO
'--------------------------------------------------------------------
' MACRO  M_SetEl(P4,P1,P2,P3)  - CLR Parameter-Element P2 from Index P1 to "", nicht Multithreadingsafe
MACRO  M_SetElClr(P4,P1,P2)
 M_BR BYVAL @P4.S,P1,P2
END MACRO
'--------------------------------------------------------------------
#ENDIF
'######################################################################################################################
'######################################################################################################################


#IF NOT %DEF(%M_BA_INC)
%M_BA_INC=1

'--------------------------------------------------------------------
' Reserve free Element, set Strings (nach P$(T04 bis (T04+T05)-9)) and return index to it, Multithreading-safe
FUNCTION M_BA(BYVAL T01 AS M_Enum PTR,BYREF T03() AS STRING,BYVAL T04 AS LONG,BYVAL T05 AS LONG) AS LONG
  REGISTER R01 AS LONG,R02 AS LONG
  LOCAL T09 AS STRING
  IF (@T01.E<1) THEN R02=-1:GOTO enx
  EnterCriticalSection @T01.@CS
  R02=M_AP(T01,4) ' Get/reserve next Free
  DECR T05 ' Da wir bei 0 anfangen
  L001:
  FOR R01=0 TO T05
   T09=T03(R01+T04)
   L002:
    ' X_AU "Set: "+STR$(R01)+" of "+STR$(@T01.E)+","+STR$(R02)+" of "+STR$(@T01.D)+ " * Len=("+STR$(LEN(T09))+")->"+T09
     M_SetEl(T01,R01,R02,T09)
     L003:
  NEXT R01
  L004:
  LeaveCriticalSection @T01.@CS
  enx:
  FUNCTION=R02
 END FUNCTION

 MACRO FUNCTION M_NewPM(P1,P2,P3,P4) = M_BA(P1,P2,P3,P4)
'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_BO_INC)
%M_BO_INC=1

'--------------------------------------------------------------------
' Set MTPC-String Element to Value
SUB M_BO(BYREF T01() AS STRING,BYVAL T02 AS LONG,BYVAL T03 AS LONG,BYREF T04 AS STRING)
 T01(T02,T03)=T04
END SUB
'--------------------------------------------------------------------
'MACRO  M_SetElm(P1,P2,P3) - Set Parameter-Element P2 from Index P1 to String P3, Multithreadingsafe
MACRO  M_SetElm(P4,P1,P2,P3)
 M_Lock(P4)
  M_BO BYVAL @P4.S,P1,P2,P3
 M_UnLock(P4)
END MACRO
'--------------------------------------------------------------------
' MACRO  M_SetEl(P4,P1,P2,P3)  - Set Parameter-Element P2 from Index P1 to String P3, nicht Multithreadingsafe
MACRO  M_SetEl(P4,P1,P2,P3)
 M_BO BYVAL @P4.S,P1,P2,P3
END MACRO
'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_BB_INC)
%M_BB_INC=1
'--------------------------------------------------------------------

' Free all Elements, Multithreading-safe
FUNCTION M_BB(BYVAL T01 AS M_Enum PTR) AS LONG
  REGISTER R01 AS LONG,R02 AS LONG
  M_Lock(T01)
  R02=@T01.N
  GFOR(R01,0,R02)
   M_Free(T01,R01)
  GNAX(R01)
  M_Unlock(T01)
  enx:
  FUNCTION=R02
 END FUNCTION

'--------------------------------------------------------------------
#ENDIF
'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_BN_INC)
%M_BN_INC=1

'--------------------------------------------------------------------
' Array Add unique Element T01-> L1() with Parameters T02-> L2(), ... T04 etc. - Index is secret (may shift)
SUB M_BN(BYVAL M01 AS M_EnumB PTR,BYVAL T01 AS LONG,BYVAL T02 AS LONG,BYVAL T03 AS LONG,BYVAL T04 AS LONG)
 REGISTER R01 AS LONG,R02 AS LONG
 M_LockA(M01)
 R01=T01 ' Ins Register nehmen
  FOR R02=0 TO @M01.N
   IF (@M01.@LP1[R02]=R01) THEN GOTO enx
  NEXT R01
' G_DG(@M01.N,enx) ' Wenn >Maxlong springe enx
  R01=M_BK(M01,BYVAL @M01.L1,BYVAL @M01.L2,BYVAL @M01.L3,BYVAL @M01.L4)
  @M01.@LP1[R01]=T01 ' Neue Elemente zuweisen
  @M01.@LP2[R01]=T02
  @M01.@LP3[R01]=T03 ' Neue Elemente zuweisen
  @M01.@LP4[R01]=T04
 enx:
 M_UnLockA(M01)
END SUB
'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_BK_INC)
%M_BK_INC=1

'--------------------------------------------------------------------
' (internal) Array Add Element mit Redim, ohne Lock, ohne Check, use M_BH instead, returns Element-Index from new-Element
FUNCTION M_BK(BYVAL M01 AS M_EnumB PTR,BYREF T01() AS LONG,BYREF T02() AS LONG,BYREF T03() AS LONG,BYREF T04() AS LONG) AS LONG
  INCR @M01.N
  M_BJ M01,T01(),T02(),T03(),T04() ' Redim
 FUNCTION=@M01.N
END FUNCTION
'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_BM_INC)
%M_BM_INC=1

'--------------------------------------------------------------------
' Array Delete Element T03 für 4 Longfelder
SUB M_BM(BYVAL M01 AS M_EnumB PTR,BYVAL T03 AS LONG)
 M_LockA(M01)
  IF zero(@M01.N) THEN GOTO enx ' Wenn Array leer
  IF (T03>@M01.D) THEN GOTO enx ' Wenn ausserhalb des dimensionieten Bereiches
  M_BL(M01,BYVAL @M01.L1,BYVAL @M01.L2,BYVAL @M01.L3,BYVAL @M01.L4,T03) ' Remove Element und redim
 enx:
 M_UnLockA(M01)
END SUB
'--------------------------------------------------------------------
#ENDIF
'######################################################################################################################
'######################################################################################################################


#IF NOT %DEF(%M_BL_INC)
%M_BL_INC=1

'--------------------------------------------------------------------
' Array Delete Element und Redim, ohne Lock, ohne Check
SUB M_BL(BYVAL M01 AS M_EnumB PTR,BYREF T01() AS LONG,BYREF T02() AS LONG,BYREF T03() AS LONG,BYREF T04() AS LONG,BYVAL T03 AS LONG)
  ARRAY DELETE T01(T03)
  ARRAY DELETE T02(T03) ' remove Element
  ARRAY DELETE T03(T03)
  ARRAY DELETE T04(T03) ' remove Element
  DECR @M01.N
  M_BJ M01,T01(),T02(),T03(),T04() ' Redim
END SUB
'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_BQ_INC)
%M_BQ_INC=1

'--------------------------------------------------------------------
' Get MTPC-String Element als Function
FUNCTION M_BQ(BYREF T01() AS STRING,BYVAL T02 AS LONG,BYVAL T03 AS LONG) AS STRING
 LOCAL T04 AS STRING
 T04=T01(T02,T03)
 FUNCTION=T04
END FUNCTION

' Get Parameter-Element P2 from Index P1 from Object P3
MACRO FUNCTION M_GetEl(P1,P2,P3)= M_BQ(BYVAL @P1.S,P2,P3)
'--------------------------------------------------------------------
#ENDIF
'######################################################################################################################
'######################################################################################################################
« Last Edit: January 16, 2011, 01:45:03 PM by Theo Gottwald »

Offline Petr Schreiber

  • Full Member
  • ***
  • Posts: 183
Re: Puzzle-Time :-)
« Reply #1 on: August 02, 2009, 10:00:29 PM »
Theo,

did anyone send you correct guess via PM already?
Looks to me a bit like emulation of object model, but I am not 100% sure as my German knowledge is weak.
AMD Sempron 3400+ | 1GB RAM @ 533MHz | GeForce 6200 / GeForce 9500GT | 32bit Windows XP SP3

psch.thinbasic.com

Offline Theo Gottwald

  • Administrator
  • Hero Member
  • *****
  • Posts: 899
    • it-berater
Re: Puzzle-Time :-)
« Reply #2 on: August 03, 2009, 08:06:36 AM »
Hallo Petr,

no, the Puzzle is still open.

While actually I may think of doing something like this using the new Objects.
So far you are right.