Sorry your browser is not supported!

w=image width(img) : h=image height(img)
make image img,w,h
draw to image img

function set_territory_color(terr as integer, old as integer, new as integer)
   local x,y,red,grn,blu
   redmut=color(old,new).red : grnmut=color(old,new).green : blumut=color(old,new).blue
   img=terrstart+terr-1 : mut=abs(redmut)+abs(grnmut)+abs(blumut)
   if memblock exist(terr)
      `memblock bestaat -> image is van kleur veranderd, herstel vanuit memblock
      make image from memblock img,terr
      if mut=0 then delete memblock terr
   else
      if mut>0
         `memblock bestaat niet -> image is nog van originele kleur, maak copy naar memblock
         make memblock from image terr,img
      endif
   endif
   if mut>0
      w=image width(img) : h=image height(img)
      `set current bitmap bufferscr
      make image img,w,h
      draw to image img
      `paste image img,0,0 : delete image img
      lock pixels
      for x=0 to w
         for y=0 to h
            p=point(x,y) : red=rgbr(p) : grn=rgbg(p) : blu=rgbb(p)
            if (not (red=0 and grn=0 and blu=0)) and (not (red=78 and grn=92 and blu=101)) and (not (red=114 and grn=141 and blu=168))
               red=red+redmut : grn=grn+grnmut : blu=blu+blumut
               if red>255 then red=255
               if red<0 then red=0
               if grn>255 then grn=255
               if grn<0 then grn=0
               if blu>255 then blu=255
               if blu<0 then blu=0
               dot x,y,rgb(red,grn,blu)
            endif
         next y
      next x
      unlock pixels
      `get image img,0,0,w,h,1
      `set current bitmap 0
   endif
endfunction

v# = 1.0
select sgn(v#)
   case 1
      print "a"
   endcase
   case 0
      print "b"
   endcase
   case -1
      print "c"
   endcase
endselect

wait key
end

print "Starting"

select 1.0
   case 1  : print "a" : endcase
   case 0  : print "b" : endcase
   case -1 : print "c" : endcase
endselect

print "Done"
wait key

dType = draw target type()

sync on
sync rate 60
autocam off
hide mouse

` Generate some objects to look at
for Obj = 1 to 100
   make object cube Obj, 1.0
   repeat
      position object Obj, rnd(100)-50.0, 0.0, rnd(100)-50.0
   until abs(object position x(Obj)) > 5.0 and abs(object position z(Obj)) > 5.0
next

CreateOverlay(1)

do
   control camera using arrowkeys 0, 0.2, 1.5

   for Obj = 1 to 100
      yrotate object Obj, wrapvalue( object angle y(Obj) + 1.0 )
   next

   UpdateOverlay(1)

   DisplayOverlay(1, mousex(), mousey())
   sync
loop




function CreateOverlay(OverlayImage as integer)
   make image 1, 160, 160
endfunction




function UpdateOverlay(OverlayImage as integer)
   local OrigTarget as integer
   local OrigType as integer

   local Width as integer
   local Height as integer

   ` 1. Save the current draw target and then switch to the target image
   OrigType   = draw target type()
   OrigTarget = draw target()

   draw to image 1

   Width = draw target width()
   Height = draw target height()
   
   ` 2. I want an overlay background of green with 50% transparency
   cls rgb(128, 0, 255, 0)

   ` Filled circle of black at 50% alpha
   fill circle Width/2, Height/2, min(Width, Height)/2-1, rgb(128, 0, 0, 0)

   ` White border
   line 0, 0, Width-1, 0
   line 0, 0, 0, Height-1
   line Width-1, 0, Width-1, Height-1
   line 0, Height-1, Width-1, Height-1

   
   set cursor 0, 2
   print " Frame rate = "; screen fps()
   print " x = "; camera position x(0)
   print " z = "; camera position z(0)
   print " Angle = "; wrapvalue( camera angle y(0) )

   ` 4. Reset back to the original draw target
   set draw target OrigType, OrigTarget
endfunction




function DisplayOverlay(OverlayImage as integer, x as integer, y as integer)
   ` 1. Paste the image to the display
   paste image OverlayImage, x, y, 1
endfunction

ptr = alloc(9999)
...
newptr = realloc(ptr, 999999)
if newptr <> 0 then ptr = newptr

one = 1
one# = 1.0
if one=one#
  print "equal"
else
  print "not equal"
endif
wait key
end

`This code will silently exit at Barnski's 'lua register function ptr' command when using 'matrix1util_20.dll' dated 02.03.2010
`The code will not crash when using 'matrix1util_20.dll' dated 20.04.2008
`Something is clashing with 'Barnski'sLuaPlugin_release.dll' dated 21.10.2008
sync on : sync rate 30
C_setupLogfile("log.txt")

C_incArray()

text 10, 10,  "Press a key to exit"
sync : sync  
wait key
end  


function C_RegFunc(ptr as dword, luaname as string, vartypes as string, returnyes as integer, plugfunc as integer)

    lua register function ptr, luaname, vartypes, returnyes, plugfunc `this line causes a silent exit
    c_writelog("ptr: " + str$(ptr) + " luaname: " + luaname + " vartypes: " + vartypes + " returnyes: " + str$(returnyes), -1,0)
                                                                                                            
endfunction


function C_incArray() : fncpt = get ptr to this function() : C_RegFunc(fncpt, "C_incArray", "", 0, 0) : if g_commonRegistered = 0 then exitfunction

    `(this is an empty test function)

endfunction

function C_setupLogfile(logname$)

    f = FIND FREE FILE()

    if file exist (logname$) = 1
        delete FILE logname$
    endif
    
    OPEN DATAFILE TO WRITE f, logname$
     
        WRITE DATAFILE STRING (f), "Log Started: "                      + get time$() + " On: " + get date$() 
        WRITE DATAFILE STRING (f), "DirectX ver: "                      + get dx version$()
        WRITE DATAFILE STRING (f), "Windows Version: "                  + str$(windows version ()) `400x - Windows 95,410x - Windows 98, 490x - Windows ME, 500x - Windows 2000, 501x - Windows XP,502x - Windows 2003, 600x - Windows Vista or Windows 2008
        WRITE DATAFILE STRING (f), "CPU Vendor: "                       + get processor vendor$(0)
        WRITE DATAFILE STRING (f), "CPU Brand: "                        + get processor brand$(1)
        WRITE DATAFILE STRING (f), "CPU Name: "                         + get processor name$(1)
        
        WRITE DATAFILE STRING (f), "CPU platform: "                     + get processor platform$(1)
        WRITE DATAFILE STRING (f), "CPU Type ID: "                      + str$(get processor type id(1))
        WRITE DATAFILE STRING (f), "CPU processor family: "             + str$(get processor family id(1))
        WRITE DATAFILE STRING (f), "CPU modelID: "                      + str$(get processor model id(1))
        
        WRITE DATAFILE STRING (f), "CPU steppingID: "                   + str$(get processor stepping id(1))
        WRITE DATAFILE STRING (f), "CPU mhz: "                          + str$(get processor frequency(1))
        WRITE DATAFILE STRING (f), "CPU Processor Count: "              + str$(processor count ())
        
        WRITE DATAFILE STRING (f), "Graphics Card: "                    + current graphics card$()
        WRITE DATAFILE STRING (f), "Maximum Pixel Shader Value: "       + str$(get maximum pixel shader value())
        WRITE DATAFILE STRING (f), "Maximum Pixel Shader Version: "     + str$(get maximum pixel shader version())
        
        WRITE DATAFILE STRING (f), "Function Count: "                   + str$(GET FUNCTION COUNT())

        global g_iLogFileIndex = f

endfunction

function C_writelog(x$,y,p) 

          logstring$ = get time$() + " | " + x$ + " | " + str$(y)         
          WRITE DATAFILE STRING (g_iLogFileIndex), logstring$
          if p = 1` if p = 1 then write to screen, otherwise just write to log
			    print logstring$
			    sync
		  endif

endfunction

function C_writelog(x$,y,p) 

          logstring$ = get time$() + " | " + x$ + " | " + str$(y)         
          WRITE DATAFILE STRING (g_iLogFileIndex), logstring$
          if p = 1` if p = 1 then write to screen, otherwise just write to log
			    print logstring$
			    sync
		  endif

endfunction

make object plain 1, 100.0, 100.0, 120, 120
wait key

set message callback "WndProc"

do
    sync
loop

function WndProc(hwnd, msg, wparam, lparam)
    select msg
        case 0x5
            set display mode lparam && 0xFFFF, lparam >> 16, 32
            print "Resizing..."
        endcase
        case 0x10
            msgbox "Closing...", 0, 0
            set message callback ""
        endcase
    endselect
endfunction 0

	// if index size exceeds 16bit, cannot allow index buffer
	if ( dwIndexCount > 0 )
		if ( dwIndexCount > 0x0000FFFF )
			return false;

`sync on
`sync rate 0

set message callback "WndProc"

yinc = text height("|")

repeat
   box 0, 0, screen width(), yinc * 3.5, 0xff000000
   text 0, 0, "Press SPACE to disable the callback"
   text 0, yinc, "Press ENTER to enable the callback"
   text 0, yinc + yinc, "Press ESCAPE to end the program"
   
   if spacekey() then set message callback ""
   if returnkey() then set message callback "WndProc"

   sync
until escapekey()

set message callback ""

end

#constant WM_RESIZE  0x0005
#constant WM_CLOSE   0x0010

function WndProc(hwnd as dword, msg as dword, wparam as dword, lparam as dword)
   print hwnd; " - "; msg; " - "; wparam; " - "; lparam
   select msg
      case WM_RESIZE
         Width = max(1, lparam && 0xffff)
         Height = max(1, lparam >> 16)
         set message callback 0                           ` Disable callback
         set display mode Width, Height, screen depth()
         set message callback  get ptr to this function() ` Re-enable callback
      endcase
      case WM_CLOSE
         stop current message
      endcase
   endselect
endfunction 0

call function name "First"
call function name "Second"
call function name "Last"
wait key
end

function First()
   print "First"
endfunction

function Second()
   print "Second"
endfunction

function Last()
   print "Last"
endfunction

dim fn(2)

fn(0) = get ptr to function("First")
fn(1) = get ptr to function("Second")
fn(2) = get ptr to function("Last")

for i = 1 to 3
   print "Loop number "; i
   for f = 0 to 2
      call function ptr fn(f)
   next
next

wait key
end

function First()
   print "First"
endfunction

function Second()
   print "Second"
endfunction

function Last()
   print "Last"
endfunction

if bank exist(1) = 0
   make memblock from bank 255,1
endif

if bank exist(1) = 0
   make bank 1,1
   make memblock from bank 255,1
endif