Sorry your browser is not supported!

print delimit csv$("Test",1)
wait key

sync on

` Create a sprite to move with the mouse()
ink rgb(255,0,0), 0
box 0, 0, 64, 64
get image 1, 0, 0, 64, 64, 1
sprite 1, 320, 240, 1
offset sprite 1, 32, 32
ink rgb(255,255,255),0

DRAW SPRITES MANUAL

do
   sprite 1, mousex(), mousey(), 1

   center text mousex(), mousey()-20, "This is some text behind the sprite"
   DRAW SPRITES
   center text mousex(), mousey()+4, "This is some text in front of the sprite"

   sync
loop

sync on
sync rate 0
hide mouse

set sprite 1, 0, 1

make image 1, 256, 256,

draw to image 1
cls rgb(255,0,0)

do
   cls

   draw to image 1
   Width = draw target width()
   Height = draw target height()

   for i = 1 to 20
      x = rnd(Width-1)
      y = rnd(Height-1)
      box x, y, x+1, y+1, rgb(rnd(255), rnd(255), rnd(255))
      `dot x, y, rgb(rnd(255), rnd(255), rnd(255))
   next
   
   sprite 1, mousex(), mousey(), 1
   offset sprite 1, Width/2, Height/2

   draw to bitmap 0

   sync
loop

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 OverlayImage 

   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

Function M1Loading()
	
	Set Dir "C:\STAB IN THE DARK 2.0\Media\LEVELS"
	If File Exist("LvlM1.dat")
		If Open Datafile To Read (12,"LvlM1.dat")	
			Datafile String Type 12,4
			local iArrayCount as integer 
			iArrayCount = Datafile Byte (12)
			Empty Array GameLvls()
		
			if iArrayCount >= 0
			
				for i = 0 to iArrayCount Step 1
			
					local strFile as string
					local iStrLen as integer
					iStrLen = Datafile Byte(12)
					strFile = Datafile Datastring(12,iStrLen)
					local iObjNum as integer 
					iObjNum = Datafile Byte (12)
					
					InputAddGameObject(strFile)
					
				next i
			endif
			
			Close DataFile 12
		else 
			Report Error "Unable to Open DataFile for Loading", "FAILED TO LOAD PROJECT"
		Endif 	
	else 	
		Report Error "File Does Not Exist","USER ERROR,YES THIS MEANS YOU"	
	Endif 	
	
Endfunction

iStrLen = Datafile Byte(12)
strFile = Datafile Datastring(12,iStrLen)

strFile = Datafile String$(12)

sync on
sync rate 0

rem start 3d
make object sphere 1,1

gosub debugSetup
gosub optionSetup
optionLoad()





intervalLookupTime = 2000
nextLookupTime = timer() + intervalLookupTime
lookupText$ = ""
rndText$ = ""
flagQuit = 0
keydown = 0

repeat

	text 0,0,  "Lookup Test Harness"
	text 0,15, "Lookups are being done at a rate of " + str$(int(intervalLookupTime/1000.0)) + " lookups/second"
	text 0,30, "Press Up Arrow to increase lookup rate and Down Arrow to decrease lookup rate"
	text 0,45, "Press q to quit"
	text 0,60, "Press any other key to concat to the current lookup text and do an immediate lookup"
	text 0,75, "(the faster you type, the faster the lookups will be)"
	text 0,90, "Lookup Text: " + lookupText$

	if timer() > nextLookupTime
	
		nextLookupTime = timer() + intervalLookupTime
		if lookupText$ <> ""
			retval$ = optionGetTag("language", lookupText$)
		else
			rem do a random lookup
			rndText$ = ""
			for i = 1 to 6
				rndText$ = rndText$ + chr$(rnd(25)+65)
			next
			retval$ = optionGetTag("language", rndText$)
		endif
			
	endif
	
	if scancode() <> 0 and keydown = 0
		keydown = 1 : found = 0
		if upkey() then inc intervalLookupTime, 100 : found = 1
		if downkey() then dec intervalLookupTime, 100 : found = 1
		if keystate(16) = 1 then flagQuit=1 : found = 1
		if found = 0
			lookupText$ = lookupText$ + ENTRY$()
			clear entry buffer
			retval$ = optionGetTag("language", rndText$)
		endif
		
	endif
	
	if scancode() = 0
		keydown = 0
	endif
	
	
	sync		

until (flagQuit = 1)

debugShutdown()

end


optionSetup:

	rem base must be built manually
	#constant OPTION_TABLES 1
	make lookup OPTION_TABLES
	set lookup OPTION_TABLES, "tables", str$(OPTION_TABLES)
	
	#constant OPTION_UNDEF "***UNDEFINED***"
	#constant OPTION_PATH ""
	
	rem copied over from system module to 
	rem create test harness
	#constant SYSTEM_FILE_TABLE 1
	#constant SYSTEM_FILE_OPTION 2
	global systemNextFreeLookup as integer
	
return

debugSetup:

	rem copied here for test harness
	OPEN LOG "lookup_test.log", 1
	SET LOG TAG 0, "[SYSTEM] INFO  ", ""
	SET LOG TAG 1, "[SYSTEM] WARN  ", ""
	SET LOG TAG 2, "[SYSTEM] ERROR ", ""
	#constant DEBUGINFO 0
	#constant DEBUGWARN 1
	#constant DEBUGERROR 2
	debugWrite(DEBUGINFO,"---- SYSTEM STARTUP ---")

return

function debugShutdown()
    rem copied here for test harness
	CLOSE LOG
	
endfunction

function debugWrite(level as integer, msg$ as string)
    rem copied here for test harness
	tstamp$ = systemGetRealDateTime("/"," ",":")
	WRITELN LOG level, "%s :: %s" , tstamp$, msg$
endfunction


function systemFreeLookup()
	rem copied here for test harness
	repeat
      inc systemNextFreeLookup
    until lookup exist(systemNextFreeLookup) = 0
   	
endfunction systemNextFreeLookup

function systemGetRealDateTime(dsep$,dtsep$,tsep$)

   rem copied here for test harness
   date$ = get date$()
   time$ = get time$()

   month$ = left$(date$,2)
   day$ = mid$(date$,4) + mid$(date$,5)
   year$ = "20" + right$(date$,2)
   date$ = year$+dsep$+month$+dsep$+day$

   hour$ = left$(time$,2)
   minutes$ = mid$(time$,4) + mid$(time$,5)
   seconds$ = right$(time$,2)
   time$ = hour$+tsep$+minutes$+tsep$+seconds$

   datetime$=date$+dtsep$+time$

endfunction datetime$

function optionGetTag(tableName$, key$)

	local retval$ as string
	retval$ = OPTION_UNDEF

	rem first find the tableID
	if search lookup (OPTION_TABLES, tableName$) = 1
		if lookup is valid(OPTION_TABLES)
			tableid = intval(lookup current value$(OPTION_TABLES))
			first lookup OPTION_TABLES
			rem now find the key/value pair in the right table
			if search lookup(tableid, key$) = 1
				if lookup is valid(tableid)
					retval$ = lookup current value$(tableid)
				else
					debugWrite(DEBUGWARN,"optionGetTag lookup invalid for table: " + str$(tableid))
				endif
			else
				debugWrite(DEBUGWARN,"optionGetTag lookup not found for table: " + str$(tableid) + " and key: " + key$)
				first lookup tableid
			endif
		else
			debugWrite(DEBUGWARN,"optionGetTag table lookup invalid for table: " + tablename$)
		endif
	else
		debugWrite(DEBUGWARN,"optionGetTag table lookup not found for table: " + tablename$)
	endif
	
endfunction retval$


function optionUpdateTag(tableName$, key$, value$)
	local tableid as integer
	
	rem first find the tableID
	if search lookup (OPTION_TABLES, tableName$) = 1
		if lookup is valid(OPTION_TABLES)
			tableid = intval(LOOKUP CURRENT VALUE$(OPTION_TABLES))
		endif
	else
		tableID = systemFreeLookup()
		make lookup tableID
		set lookup OPTION_TABLES, tableName$, str$(tableID)
		debugWrite(DEBUGINFO,"optionUpdateTag created table " + str$(tableID) + ". " + tableName$)
	endif
	
	
	rem now set the key/value pair in the table
	set lookup tableid, key$, value$
	debugWrite(DEBUGINFO,"optionUpdateTag created key " + key$ + " in table " + str$(tableID) + ". " + tableName$)
	
endfunction

function optionLoad()

	filename$ = OPTION_PATH + "tables.ini"
	if file exist(filename$)
		open to read SYSTEM_FILE_TABLE, filename$
			while not file end(SYSTEM_FILE_TABLE)
				read string SYSTEM_FILE_TABLE, table$
				filename$ = OPTION_PATH + table$ + ".ini"
				if file exist(filename$)
					open to read SYSTEM_FILE_OPTION, filename$
					while not file end(SYSTEM_FILE_OPTION)
						read string SYSTEM_FILE_OPTION, dat$
						split string dat$,"="
						optionUpdateTag(table$, get split word$(1), get split word$(2))
					endwhile
					close file SYSTEM_FILE_OPTION
				endif
			endwhile
		close file SYSTEM_FILE_TABLE
	endif

endfunction


function optionSave()

	local myTable as integer
	myTable = 1
	
	while lookup exist(OPTION_TABLES)
	
		FIRST LOOKUP OPTION_TABLES
		
		while lookup is valid(OPTION_TABLES)
		
			filename$ = OPTION_PATH + LOOKUP CURRENT KEY$(OPTION_TABLES) + ".ini"
			myTable = intval(LOOKUP CURRENT VALUE$(OPTION_TABLES))
			
			while lookup exist(myTable)
				
				if file exist(filename$)
					delete file filename$
				endif
				
				open to write SYSTEM_FILE_OPTION, filename$
				
				FIRST LOOKUP myTable
				
				while lookup is valid(myTable)
					dat$ = LOOKUP CURRENT KEY$(myTable) + "=" + LOOKUP CURRENT VALUE$(myTable)
					write string SYSTEM_FILE_OPTION, dat$
					next lookup myTable
				endwhile
				
				close file SYSTEM_FILE_OPTION
			
			endwhile
			
			next lookup OPTION_TABLES
		endwhile
	endwhile
	
endfunction

function optionGetTag(tableName$, key$)
   exitfunction lookup$( OPTION_TABLES, tableName$ + "/" + key$, OPTION_UNDEF)
endfunction ""

function optionGetTag(tableName$, key$)
   local FullKey$
   
   FullKey$ = tableName$ + "/" + key$
   if lookup exist( OPTION_TABLES, FullKey$ )
      exitfunction lookup$( OPTION_TABLES, FullKey$ )
   else
      exitfunction lookup$( OPTION_TABLES, "English/" + key$, OPTION_UNDEF )
   endif
endfunction ""

CURVE BEZIER%F%CurveBezier%Distance