Sorry your browser is not supported!

#constant   GWL_EXSTYLE       -20
#constant   WS_EX_LAYERED     0x80000
#constant   LWA_COLORKEY      0x00000001
#constant   LWA_ALPHA         0x00000002

sync on
sync rate 60

load dll "user32.dll", 1

Window = call dll(1, "GetActiveWindow")

`SetWindowLong (hWnd ,GWL_EXSTYLE ,GetWindowLong (hWnd ,GWL_EXSTYLE ) | WS_EX_LAYERED )
call dll 1, "SetWindowLongA", Window, GWL_EXSTYLE, call dll(1, "GetWindowLongA", Window, GWL_EXSTYLE) || WS_EX_LAYERED

Mode = LWA_ALPHA
`Mode = LWA_COLORKEY

Alpha = 127
call dll 1, "SetLayeredWindowAttributes", Window, ColorRef(0, 0, 0), Alpha, Mode

make object cube 1, 1.0
color backdrop rgb(0, 0, 0)

repeat
   yrotate object 1, wrapvalue( object angle y(1) + 1.0 )
   sync
until scancode() > 0

delete dll 1

end

function ColorRef(Red, Green, Blue)
   local CR as dword

   if Red > 255 then Red = 255
   if Red < 0 then Red = 0

   if Green > 255 then Green = 255
   if Green < 0 then Green = 0

   if Blue > 255 then Blue = 255
   if Blue < 0 then Blue = 0

   CR = Red || (Green << 8) || (Blue << 16)
endfunction CR

sync on
sync rate 0

WantedFile$="swiaty/swiat3.dbo"

print "Wanted File: "
print WantedFile$
print
print "Press a key to start"
sync
wait key

ItemReference=ADD ITEM TO QUEUE( WantedFile$ )

while not CHECK QUEUED ITEM LOADED(ItemReference)
endwhile

print
print "Loaded"
print

LOAD QUEUED ITEM TO MEMBLOCK ItemReference, 1

if memblock exist(1)
   print "Address: "; get memblock ptr(1)
   print "Size: "; get memblock size(1)

   MAP MEMBLOCK TO BANK 1, 1


   DELETE QUEUED ITEM ItemReference

   sync
   wait key

   MAKE OBJECT FROM BANK 1,1
   position object 1, 0, 0, 0
   position camera 0, 500, -90
   PITCH CAMERA DOWN 70


   do
   sync
   loop

else
   print "Memblock was not created"
endif

sync

wait key
end

float Abs(float X){
 return (x < 0.0 ? -x : x );
}

sync on

make object cube 1, 1.0
instance object 2, 1
clone object 3, 1
clone object 4, 1, 1

backdrop off
cls

i = first object()
while (i)
   print "Object "; i; ", Instance of "; Object instance of(i); ", Cloned from "; Object clone of(i)
   i = next object()
endwhile

i = first object()
while (i)
   delete object i
   i = next object()
endwhile

sync off
wait key

sync on
sync rate 0
autocam off

for i = 1 to 200
   if rnd(1) = 0
      set default object group 1
      make object cube i, 1.0
   else
      set default object group 2
      make object sphere i, 1.5
   endif
   position object i, rnd(100) - 50.0, 0.0, rnd(100) - 50.0
next

position camera 0.0, 100.0, 0.0
point camera 0.0, 0.0, 0.0

dim GroupHidden(2) as integer

KeyDown = 0

do
   Hide = 0

   if KeyDown = 0
      if inkey$() = "0" then Hide = 1
      if inkey$() = "1" then Hide = 2
      if Hide then KeyDown = 1
   else
      if scancode() = 0 then KeyDown = 0
   endif

   if Hide
      GroupHidden( Hide ) = 1 - GroupHidden( Hide )
      if GroupHidden( Hide ) = 1
         HideGroup( Hide )
      else
         ShowGroup( Hide )
      endif
   endif

   sync
loop

function HideGroup(Group as integer)
   local Obj as integer

   Obj = first object in group( Group )
   while Obj
      hide object Obj
      Obj = next object in group( Group )
   endwhile
endfunction

function ShowGroup(Group as integer)
   local Obj as integer

   Obj = first object in group( Group )
   while Obj
      show object Obj
      Obj = next object in group( Group )
   endwhile
endfunction

global dim Pointers(4) as dword

Pointers(1) = _GetFP_for_One()
Pointers(2) = _GetFP_for_Two()
Pointers(3) = _GetFP_for_Three()
Pointers(4) = 11231231             ` Deliberately invalid function pointer

print "Checking pointers are valid"
for i = 1 to 4
   print "Pointer "; i; " is ";
   if FUNCTION PTR IS VALID( Pointers(i) )
      print "valid"
   else
      print "invalid"
   endif
next

print ""
print "Calling as command"
CALL FUNCTION PTR Pointers(1), 1, 2, 3
CALL FUNCTION PTR Pointers(2), 1, 2
CALL FUNCTION PTR Pointers(3), 1

print ""
print "Calling as function"
` Must assign to a variable to coerce the return value to the correct type
a = CALL FUNCTION PTR(Pointers(1), 1, 2, 3)
print "Result was "; a

a = CALL FUNCTION PTR(Pointers(2), 1, 2)
print "Result was "; a

a# = CALL FUNCTION PTR(Pointers(3), 1)
print "Result was "; a#

` Will cause a runtime error
`CALL FUNCTION PTR 12345678

print ""
print "Loading the user32 DLL"
Handle = LOAD DLL("user32")
if Handle
   print "Loaded the DLL"
   MsgBox = GET PTR TO DLL FUNCTION(Handle, "MessageBoxA")

   if MsgBox
      print "Calling the MessageBoxA function in User32.dll"
      CALL FUNCTION PTR MsgBox, 0, "Hello", "Title", 0
   else
      print "Unable to find MessageBoxA"
   endif

   print "Full pathname of the DLL is "; DLL FILENAME$( Handle )

   UNLOAD DLL Handle
else
   print "Unable to load user32"
endif

wait key
end


function _GetFP_for_One()
   exitfunction GET PTR TO NEXT FUNCTION()
endfunction 0

function One(a as integer, b as integer, c as integer)
   print "You called function One - "; a; " "; b; " "; c
endfunction 1



function _GetFP_for_Two()
   exitfunction GET PTR TO NEXT FUNCTION()
endfunction 0

function Two(a as integer, b as integer)
   print "You called function Two - "; a; " "; b
endfunction 2



function Three(a as integer)
   print "You called function Three - "; a
endfunction 3.0

function _GetFP_for_Three()
   exitfunction GET PTR TO PREV FUNCTION()
endfunction 0

` Create and initialise the arrays
dim array1(9) as integer
dim array2(9) as string

for i = 0 to 9
   array1(i) = rnd(100)
   read array2(i)
next

` Show and sort 'array1'
print "Sorting an integer array"
print "  Before:"
for i = 0 to 9
   array1(i) = rnd(100)
   print "    "; array1(i)
next

BubbleSort( 0, 9, fp_Array1_SwapIfLessThan() )

print ""
print "  After:"
for i = 0 to 9
   print "    "; array1(i)
next

wait key
cls

` Show and sort 'array2'
print "Sorting a string array"
print "  Before:"
for i = 0 to 9
   print "    "; array2(i)
next

BubbleSort( 0, 9, fp_Array2_SwapIfLessThan() )

print ""
print "  After:"
for i = 0 to 9
   print "    "; array2(i)
next

wait key
end

` Data for the string array
data "old"
data "one"
data "another"
data "help"
data "what"
data "dark"
data "normal"
data "error"
data "array"
data "games"


` Handlers for sorting the integer array 'array1'
function fp_Array1_SwapIfLessThan()
   exitfunction get ptr to next function()
endfunction 0

function __Array1_SwapIfLessThan(a as integer, b as integer)
   local T as integer

   if array1(a) < array1(b)
      T = array1(a)
      array1(a) = array1(b)
      array1(b) = T
      exitfunction 1
   endif
endfunction 0

` Handlers for sorting the string array 'array2'
function fp_Array2_SwapIfLessThan()
   exitfunction get ptr to next function()
endfunction 0

function __Array2_SwapIfLessThan(a as integer, b as integer)
   local T as string

   if array2(a) < array2(b)
      T = array2(a)
      array2(a) = array2(b)
      array2(b) = T
      exitfunction 1
   endif
endfunction 0


` *** Here's the one and only bubblesort function
function BubbleSort(Left as integer, Right as integer, fp_SwapIfLessThan as dword)
   local Swap as integer
   local i as integer
   local Res as integer

   repeat
      Swap = 0
      for i = Left+1 to Right
         Res = call function ptr( fp_SwapIfLessThan, i, i-1)
         if Res = 1 then Swap = 1
      next
   until Swap = 0
endfunction

sync on
sync rate 60
autocam off

dim Behaviour(2) as dword
Behaviour(0) = fp_MoveClockwise()
Behaviour(1) = fp_MoveAnticlockwise()
Behaviour(2) = fp_Occillate()

type Object_t
   BehaviourID as integer
   Speed as float
   Flag as integer
endtype

dim Objects(0) as Object_t

for Object = 1 to 20
   make object cube Object, 1.0

   repeat
      x = rnd(100)-50.0
      z = rnd(100)-50.0
   until abs(x) > 10.0 and abs(z) > 10.0
   position object Object, x, 0.0, z

   yrotate object Object, rnd(359)

   array insert at bottom Objects()
   Objects().BehaviourID = rnd( array count( Behaviour() ) )
   Objects().Speed = 0.5
   Objects().Flag = 0
next i

position camera 0.0, 120.0, 0.0
point camera 0.0, 0.0, 0.0

do
   UpdateObjects()
   sync
loop

function UpdateObjects()
   local Object as integer
   local Action as dword

   for Object = 1 to array count( Objects() )
      Action = Behaviour( Objects(Object).BehaviourID )
      call function ptr Action, Object
   next
endfunction





function fp_MoveClockwise()
   exitfunction get ptr to next function()
endfunction 0

function Do_MoveClockwise(Object as integer)
   yrotate object Object, wrapvalue( object angle y(Object) + 2.0 )
   move object Object, Objects( Object ).Speed
endfunction

function fp_MoveAnticlockwise()
   exitfunction get ptr to next function()
endfunction 0

function Do_MoveAnticlockwise(Object as integer)
   yrotate object Object, wrapvalue( object angle y(Object) - 2.0 )
   move object Object, Objects( Object ).Speed
endfunction

function fp_Occillate()
   exitfunction get ptr to next function()
endfunction 0

function Do_Occillate(Object as integer)
   ` If flag not set, point object towards origin and set the flag
   if Objects(Object).Flag = 0
      Objects(Object).Flag = 1
      point object Object, 0.0, 0.0, 0.0
   endif

   ` Flag will be set to either 1 (forward) or -1 (backward)
   ` Multiply the speed by the flag will move the object in the right direction
   move object Object, Objects(Object).Speed * Objects(Object).Flag

   if sqrt( object position x(Object) ^ 2.0 + object position z(Object) ^ 2.0 ) > 80.0
      Objects(Object).Flag = Objects(Object).Flag * -1
   endif
endfunction

Release 20070328
Matrix1Util_01    1.0.0.3
    Reverted to slightly slower but safer string length check when
        searching memory banks (other caused panics on occasions).

Matrix1Util_04    1.0.0.2
	Modified PEEK STRING functions to avoid aliasing problem.
	
Matrix1Util_05    1.0.0.2
    Added FIND FREE CAMERA to the plug-in.

Matrix1Util_07    1.0.0.3
	Modified MIN/MAX for strings to avoid aliasing problem.

Matrix1Util_11    1.0.0.1
    First release of the console window plug-in.

Matrix1Util_16    1.0.0.4
    Pretty much everything changed
    - All commands got at least a small performance boost.
    - All string modification commands were rewritten (some are many times faster).
	
Matrix1Util_19    1.0.0.2
    If deleting from a group prior to the 'current' item in that group,
        move the current item back one to point at the same object.

Matrix1Util_20    1.0.0.2
    Added ALLOW NULL FUNCTION PTR to the plug-in.
    Allow null to be used as a function pointer if selected.

Matrix1Util_21    1.0.0.1
    First release of the zones plug-in - seems that some people still use the
        old plug-in for these commands.
    A few new bonus commands added, more to come later.

remstart
      SyncFunctions.dba

      Handle = RegisterSyncFunctions( PreSyncFP, PostSyncFP )
         Register a pair of functions to be executed pre & post sync.
         The functions that the functions pointers come from should not accept any arguments.

      UnregisterSyncFunctions( Handle )
         Unregister a previously registered pair of functions

      DoSync()
         Execute all pre-sync functions, issue a sync command, then execute all post-sync function.
remend

type __SF__SyncFunctions_t
   ID as integer
   PreSync as dword
   PostSync as dword
endtype

global dim __SF__SyncFunctions() as __SF__SyncFunctions_t
global __SF__LastSyncID as integer
global __SF__InitialisedSyncFunctions as integer

function RegisterSyncFunctions(PreSync as dword, PostSync as dword)
   local Pos as integer

   if function ptr is valid( PreSync ) = 0 then PreSync = 0
   if function ptr is valid( PostSync ) = 0 then PostSync = 0

   if PreSync = 0 then if PostSync = 0 then exitfunction -1

   if __SF__InitialisedSyncFunctions = 0
      global dim __SF__SyncFunctions() as __SF__SyncFunctions_t
      __SF__InitialisedSyncFunctions = 1
      __SF__LastSyncID = 0x0000ffff
   endif

   array insert at bottom __SF__SyncFunctions()

   inc __SF__LastSyncID
   __SF__SyncFunctions().ID = __SF__LastSyncID
   __SF__SyncFunctions().PreSync = PreSync
   __SF__SyncFunctions().PostSync = PostSync

endfunction __SF__LastSyncID

function UnregisterSyncFunctions(ID as integer)

   array index to top __SF__SyncFunctions()
   while array index valid( __SF__SyncFunctions() )

      if ID = __SF__SyncFunctions().ID
         array delete element __SF__SyncFunctions()
         exitfunction
      endif

      next array index __SF__SyncFunctions()
   endwhile

endfunction

function DoSync()
   local i as integer

   if __SF__InitialisedSyncFunctions
      for i = array count( __SF__SyncFunctions() ) to 0 step -1
         if __SF__SyncFunctions(i).PreSync then call function ptr __SF__SyncFunctions(i).PreSync
      next

      sync

      for i = array count( __SF__SyncFunctions() ) to 0 step -1
         if __SF__SyncFunctions(i).PostSync then call function ptr __SF__SyncFunctions(i).PostSync
      next
   else
      sync
   endif
endfunction

function DeleteObject(Object as integer)
   position object Object, 99999999.0, Object * 10000.0, 99999999.0
   hide object Object
   Place object in group Object, 10000
endfunction

function _fp_RecoverSingleObject()
   exitfunction get ptr to next function()
endfunction 0

function RecoverSingleObject()
   local Object as integer

   if group count( 10000 ) > 0
      Object = first object in group( 10000 )
      delete object Object
   endif
endfunction

RegisterSyncFunctions( _fp_RecoverSingleObject(), 0 )

sync on
sync rate 0

RegisterSyncFunctions( _fp_RecoverSingleObject(), 0 )

for i = 1 to 1000
   make object cube i, 1.0
next

repeat
   text 0, 0,  "Total objects: " + str$( object count() )
   text 0, 15, " Live objects: " + str$( group count(0) )
   text 0, 30, " Dead objects: " + str$( group count(10000) )

   text 0, 60, "          FPS: " + str$( screen fps() )
   if group count(0) > 0
      for i = 1 to 10
         DeleteObject( first object in group(0) )
      next
   endif

   DoSync()
until object count() = 0

end



function DeleteObject(Object as integer)
   position object Object, 99999999.0, Object * 10000.0, 99999999.0
   hide object Object
   Place object in group Object, 10000
endfunction

function _fp_RecoverSingleObject()
   exitfunction get ptr to next function()
endfunction 0

function RecoverSingleObject()
   local Object as integer

   if group count( 10000 ) > 0
      Object = first object in group( 10000 )
      delete object Object
   endif
endfunction