Intro
Box Collision
Sphere Collision
Rightclick Menu
Collection of Text Effects
Multiple Shadows
Blend Images
|
rem 3D Intro
rem written by: Lukas Wadenhof a.k.a n0id 2004
rem =======================
sync on : sync rate 60 : cls 0
print "N0ID" : get image 1,0,0,40,15 : rem You Can Make An Image and Use the command 'Load Image image$,1'
make object plain 1,100,100 : texture object 1,1
backdrop on : color backdrop rgb(0,0,0)
do : xscale#=xscale#+0.3 : yscale#=yscale#+0.1 : zscale#=zscale#+0.3 : scale object 1,xscale#,yscale#,zscale#
if xscale#>150 then xscale#=150 else xrotate object 1,wrapvalue(object angle x(1)-2.88)
if yscale#>50 then yscale#=50: xrotate object 1,0
if zscale#>150 then zscale#=150:center text 300,400,"N0iDs 3D -intro . v.1.1":center text 300,415,"This and More can be found at my webpage: www.n0id.tk"
if mouseclick()>0 or returnkey()>0 or spacekey()>0 then delete image 1:delete object 1:goto something
sync:loop
something:
end
|
rem Box Collision 2004
sync on : sync rate 60 : hide mouse
for x = 1 to 10
make object cube x,10
position object x,(-50+rnd(100)),0,(-50+rnd(100))
next x
make object cube 11,3
color object 11,rgb(196,255,196)
player=11
do
if leftkey()=1 then yrotate object player,wrapvalue(object angle y( player )-3.0)
if rightkey()=1 then yrotate object player,wrapvalue(object angle y( player )+3.0)
if upkey()=1
x# = object position x(player) : y# = object position y(player) : z# = object position z(player)
position object player,x#+sin(object angle y(player)),y#,z#
for c = 1 to 10
if box_collision(player,c)=1 then position object player, x#, y#, z#
next c
x#= object position x(player)
position object player, x#,y#,z#+cos(object angle y(player))
for c = 1 to 10
if box_collision(player,c)=1 then position object player, x#, y#, z#
next c
endif
position camera object position x(11),50,object position z(11)
point camera object position x(11),0,object position z(11)
sync:loop
function box_collision(nr1,nr2)
x1# = object position x(nr1) : y1# = object position y(nr1) : z1# = object position z(nr1)
x2# = object position x(nr2) : y2# = object position y(nr2) : z2# = object position z(nr2)
xs2# = object size x(nr2) : ys2# = object size y(nr2) : zs2# = object size z(nr2)
if x1# > x2# - xs2# / 2
if x1# < x2# + xs2# / 2
if y1# > y2# - ys2# / 2
if y1# < y2# + ys2# / 2
if z1# > z2# - zs2# / 2
if z1# < z2# + zs2# / 2
exitfunction 1
endif
endif
endif
endif
endif
endif
endfunction 0
|
rem Sphere Collision 2004
sync on : sync rate 60 : hide mouse
for x = 1 to 10
make object sphere x,10
position object x,(-50+rnd(100)),0,(-50+rnd(100))
next x
make object cube 11,3
color object 11,rgb(196,255,196)
player=11
do
if leftkey()=1 then yrotate object player,wrapvalue(object angle y( player )-3.0)
if rightkey()=1 then yrotate object player,wrapvalue(object angle y( player )+3.0)
if upkey()=1
x# = object position x(player) : y# = object position y(player) : z# = object position z(player)
position object player,x#+sin(object angle y(player)),y#,z#
for c = 1 to 10
if sphere_collision(player,c,5)=1 then position object player, x#, y#, z#
next c
x#= object position x(player)
position object player, x#,y#,z#+cos(object angle y(player))
for c = 1 to 10
if sphere_collision(player,c,5)=1 then position object player, x#, y#, z#
next c
endif
position camera object position x(11),50,object position z(11)
point camera object position x(11),0,object position z(11)
sync:loop
function sphere_collision(nr1,nr2,dist)
x1# = object position x(nr1) : y1# = object position y(nr1) : z1# = object position z(nr1)
x2# = object position x(nr2) : y2# = object position y(nr2) : z2# = object position z(nr2)
if sqrt( (x1#-x2#)^2 + (y1#-y2#)^2 + (z1#-z2#)^2 ) < dist then exitfunction 1
endfunction 0
|
sync on : sync rate 60
#CONSTANT C_TRUE 0x000001
#CONSTANT C_FALSE 0x000000
#CONSTANT C_MOUSELEFTCLICK 0x000001
#CONSTANT C_MOUSERIGHTCLICK 0x000002
setupRightClickMenu()
Do
CLS RGB( 0, 78, 152 )
Result = updateRightClickMenu()
If Result > 0
`If Result = 1 Then blablabla...
Ink Rgb(255, 255, 255), 0
Text 100, 100, "You Selected ItemNo. "+str$(Result)+" Which was "+szItemsRMenu( Result )
EndIf
Sync : Loop
Function setupRightClickMenu()
Local txtWidth As Integer
Local txtHeight As Integer
Global iTrueTXTHeight As Integer
Global iTrueTXTWidth As Integer
Global items As Integer
Global iMenuImage As Integer
Global iRMenuLatch As Integer
Global iRMenuActivated As Integer
Global iRMenuX As Integer
Global iRMenuY As Integer
Global iRMMC As Integer
Global iRMenuTrueX AS Integer
Global iRMenuTrueY AS Integer
items = 5
Dim szItemsRMenu( items ) As String
szItemsRMenu(1) = "Cut"
szItemsRMenu(2) = "Copy"
szItemsRMenu(3) = "Paste"
szItemsRMenu(4) = "-"
szItemsRMenu(5) = "Properties"
for x = 1 to items
txtWidth = text width( szItemsRMenu( x ) )
txtHeight = 16
If txtWidth > oldTxtWidth Then iTrueTXTWidth = txtWidth+30
oldTxtWidth = txtWidth
next x
iTrueTXTHeight = (txtHeight*items)+5
makeRightClickMenu( iTrueTXTHeight, iTrueTXTWidth )
EndFunction
Function makeRightClickMenu( iHeight As Integer, iWidth As Integer )
Ink RGB( 172, 168, 153 ), 0 : Box 0, 0, iWidth, iHeight
Ink RGB( 255, 255, 255 ), 0 : Box 1, 1, iWidth, iHeight-1
iMenuImage = FindImage()
Get Image iMenuImage, 0, 0, iWidth, iHeight
EndFunction
Function updateRightClickMenu()
Local iMX As Integer
Local iMY As Integer
iMX = MouseX()
iMY = MouseY()
iRMMC = MouseClick()
If iRMMC = C_MOUSERIGHTCLICK And iRMenuLatch = C_FALSE
iRMenuLatch = C_TRUE
iRMenuX = iMX : iRMenuY = iMY
iRMenuActivated = C_TRUE
EndIf
If iRMenuActivated = C_TRUE
If iRMenuY > Screen Height() - iTrueTXTHeight
If iRMenuX > Screen Width() - iTrueTXTWidth
iRMenuTrueX = iRMenuX - iTrueTXTWidth
iRMenuTrueY = iRMenuY - iTrueTXTHeight
Else
iRMenuTrueX = iRMenuX
iRMenuTrueY = iRMenuY - iTrueTXTHeight
EndIf
Else
If iRMenuX > Screen Width() - iTrueTXTWidth
iRMenuTrueX = iRMenuX - iTrueTXTWidth
iRMenuTrueY = iRMenuY
Else
iRMenuTrueX = iRMenuX
iRMenuTrueY = iRMenuY
EndIf
EndIf
Paste Image iMenuImage, iRMenuTrueX, iRMenuTrueY
For x = 1 to items
If szItemsRMenu( x ) <> "-"
Ink RGB( 000, 000, 000 ), 0
Text iRMenuTrueX+15, 5+iRMenuTrueY+(x*15)-15, szItemsRMenu( x )
Else
Ink RGB( 172, 168, 153 ), 0
Line iRMenuTrueX+5, (5+iRMenuTrueY+(x*15)-15)+6, iRMenuTrueX+iTrueTXTWidth-5, (5+iRMenuTrueY+(x*15)-15)+6
EndIf
If iMX > 5+iRMenuTrueX And iMX < iRMenuTrueX + iTrueTXTWidth-5
If iMY > (5+iRMenuTrueY+(x*15)-17) And iMY < 4+iRMenuTrueY+(x*15)
If szItemsRMenu( x ) <> "-"
Ink RGB( 049, 106, 197 ), 0
Box iRMenuTrueX+5, (6+iRmenuTrueY+(x*15)-17), iRMenuTrueX+iTrueTXTWidth-5, (4+iRMenuTrueY+(x*15)+2)
Ink RGB( 255, 255, 255 ), 0
Text iRMenuTrueX+15, 5+iRMenuTrueY+(x*15)-15, szItemsRMenu( x )
If iRMMC = C_MOUSELEFTCLICK Then iRMenuActivated = C_FALSE : ExitFunction x
EndIf
EndIf
EndIf
Next x
If iRMMC > 0 And iRMenuLatch = C_FALSE Then iRMenuActivated = C_FALSE
EndIf
If iRMMC <> C_FALSE And iRMenuLatch = C_TRUE Then iRMenuLatch = C_FALSE
EndFunction C_FALSE
Function FindImage()
Repeat : Inc image, 1 : Until Not Image Exist( image )
EndFunction image
|
sync on
sync rate 60
output$ = do_some_stuff_first( "Hello! How are you today? I don't want to know personally, it's just text to demonstrate this function." )
do
cls rgb( 250, 223, 133 )
ink rgb(255,255,255),0
text 10, 10, "Normal Text"
text_outline( 10, 25, "Outlined Text" )
text_shadow( 10, 40, "Shadow Text" )
text_underline( 10, 55, "Underlined Text" )
text_overstroke( 10, 70, "Overstroke Text" )
text_flc( 10, 85, "First letter colored")
text_colorfade( 10, 100, "Text fade color to color", rgb(255, 0, 0), rgb(0,0,255) )
text_to_sucky_lang( 10, 115, "Text to sucky language" )
text_reversed( 10, 130, "Reversed Text" )
text_circle( 300, 300, "Text in a circle", 100 )
text_wave( 10, 150, "Text in a wave", 10 )
do_teh_stuff__fo_sho( output$ )
sync
loop
function do_some_stuff_first( string$ )
dim nxp#(0)
dim nyp#(0)
for x= 1 to len(string$)
array insert at bottom nxp#(0)
array insert at bottom nyp#(0)
next x
endfunction string$
Function do_teh_stuff__fo_sho( string$ )
omx#=mousex():omy#=mousey()
for x=1 to len(string$)
nxp#(x) = curvevalue( omx#+10+text width(left$(string$,x)), nxp#(x), 10.0+(1.3*x) )
nyp#(x) = curvevalue( omy#, nyp#(x), 10.0+(1.3*x) )
text nxp#(x),nyp#(x), mid$(string$,x)
next
EndFunction
function text_outline( xpos, ypos, string$ )
ink 0,0
text xpos+1, ypos, string$
text xpos, ypos+1, string$
text xpos, ypos-1, string$
text xpos-1, ypos, string$
ink rgb(255,255,255),0
text xpos, ypos, string$
endfunction
function text_shadow( xpos, ypos, string$ )
ink 0,0
text xpos+2, ypos+1, string$
ink rgb(255,255,255),0
text xpos+1, ypos, string$
endfunction
function text_underline( xpos, ypos, string$ )
text xpos, ypos, string$
siz=text width(string$)
line xpos, ypos+text height(string$), xpos+siz, ypos+text height(string$)
endfunction
function text_overstroke( xpos, ypos, string$ )
text xpos, ypos, string$
siz=text width(string$)
line xpos, ypos+(text height(string$)/2), xpos+siz, ypos+(text height(string$)/2)
endfunction
function text_flc( xpos, ypos, string$ )
Ink rgb(0, 128, 255),0
text xpos, ypos, left$( string$, 1 )
ink rgb(255,255,255),0
text xpos+(text width(left$(string$,1))), ypos, right$(string$,(len(string$)-1))
endfunction
function text_colorfade( xpos, ypos, string$, c as dword, e as dword )
er=rgbr(e):eg=rgbg(e):eb=rgbb(e)
cr=rgbr(c):cg=rgbg(c):cb=rgbb(c)
sr=rgbr(c):sg=rgbg(c):sb=rgbb(c)
neg=text width(left$(string$,1))
for x = 1 to len(string$)
char$=mid$(string$,x)
Ink rgb(cr,cg,cb),0
text xpos-neg+(text width(left$(string$,x))), ypos, char$
cr = ((((100*(len(string$)-x))/len(string$))*sr)/100)+((((100*x)/len(string$))*er)/100)
cg = ((((100*(len(string$)-x))/len(string$))*sg)/100)+((((100*x)/len(string$))*eg)/100)
cb = ((((100*(len(string$)-x))/len(string$))*sb)/100)+((((100*x)/len(string$))*eb)/100)
next
endfunction
function text_to_sucky_lang( xpos, ypos, string$ )
ink rgb(255,255,255),0
neg=text width(left$(string$,1))
for x = 1 to len(string$)
m$=lower$(mid$(string$,x))
if m$="i" then m$="1"
if m$="r" then m$="2"
if m$="e" then m$="3"
if m$="a" then m$="4"
if m$="s" then m$="5"
if m$="g" then m$="6"
if m$="t" then m$="7"
if m$="b" then m$="8"
if m$="o" then m$="0"
if x# > 1 then x#=0:m$=upper$(m$)
text xpos-neg+(text width(left$(string$,x))), ypos, m$
inc x#,0.35
next x
endfunction
function text_reversed( xpos, ypos, string$ )
for x = len(string$) to 1 step -1
reversed$ = reversed$ + mid$(string$,x)
next x
text xpos, ypos, reversed$
endfunction
function text_circle( xpos, ypos, string$, radius )
total=len(string$)
for x = 1 to total
char$=mid$(string$,x)
xp = xpos+ (Sin((radius/total)*(x*3.14))*radius)
yp = ypos- (Cos((radius/total)*(x*3.14))*radius)
text xp, yp, char$
next
endfunction
function text_wave( xpos, ypos, string$, seed )
for x = 1 to len(string$)
xp=xpos-(text width(left$(string$,1)))+(text width(left$(string$,x)))
yp=ypos+sin(-x*314)*seed
text xp, yp, mid$(string$,x)
next x
endfunction
|
Set Display Mode 1024, 768, 32
Sync On
Sync Rate 0
Autocam off
set text to bold
color backdrop 0
set ambient light 15
` make floor
make matrix 1, 2000, 2000, 100, 100
position matrix 1, -1000, 0, -1000
`for x = 1 to 100:for y = 1 to 100:inc stepper, 2:set matrix height 1, x, y, cos(stepper) * 15:next y:next x
`update matrix 1
set matrix wireframe off 1
` make object to cast shadow
make object cube 1, 100
position object 1, 100, 50, 100
set shadow shading on 1, -1, 1000, 1
make object cube 2, 100
position object 2, -250, 50, -250
set shadow shading on 2, -1, 1000, 1
` lights
GoSub setup
add_Shadow_Light( 500, 100, 500, RGB(255,0,0), 600 )
add_Shadow_Light( 424, 150, -424, RGB(0,255,0), 800 )
add_Shadow_Light( -182, 429, 120, RGB(0,0,255), 800 )
` camera
position camera -200, 100, -200
do
` debug
set cursor 0,0
print screen fps()
print int(camera position x()), "/", int(camera position y()), "/", int(camera position z())
` camera
move camera (upkey()-downkey())*2.0
rotate camera camera angle x()+mousemovey(), camera angle y()+mousemovex(), 0.0
` object 2
Inc increaser#, 0.5
Position Object 2, Object Position X(2)+(Sin(Increaser#)*5), 50, Object Position Z(2)+(Cos(Increaser#)*5)
` lights
For a = 1 To Array Count(Light(0))
rotate camera Light(a).CameraID, camera angle x(), camera angle y(), camera angle z()
position camera Light(a).CameraID, camera position x(), camera position y(), camera position z()
color light 0, Light(a).color
Position Light 0,light(a).xpos, light(a).ypos, light(a).zpos
Set Light Range 0, Light(a).range
set global shadow color RGBR(Light(a).color)/8, RGBG(Light(a).color)/8, RGBB(Light(a).color)/8, 100
set shadow position -1, light(a).xpos, light(a).ypos, light(a).zpos
sync mask 2^Light(a).CameraID
fastsync
next a
sync mask 2^0
For x = 1 To Array Count(Light(0))
sprite Light(x).ImageID, 0, 0, Light(x).ImageID
size sprite Light(x).ImageID, screen width(), screen height()
set sprite alpha Light(x).ImageID, 127.5
Next x
` Update
Sync
loop
setup:
Type t_Lights
xPos As Float
yPos As Float
zPos As Float
Color As dWord
Range As Float
CameraID As Integer
ImageID As Integer
EndType
Dim light(0) As t_Lights
set point light 0, 0,0,0
RETURN
Function add_Shadow_Light( xpos as float, ypos as float, zpos as float, color as dword, range as float )
Array Insert At Bottom Light(0)
pos = Array Count(Light(0))
Light(pos).xpos = xpos
Light(pos).ypos = ypos
Light(pos).zpos = zpos
Light(pos).color = color
Light(pos).range = range
Light(pos).CameraID = FindFreeCamera()
Light(pos).ImageID = Find Free Image()
make camera Light(pos).CameraID : set camera to image Light(pos).CameraID, Light(pos).ImageID, 1024, 768
EndFunction
Function FindFreeCamera()
repeat : inc returnVal, 1 : Until Not Camera Exist(returnVal)
Endfunction returnVal
|
RemStart
Project: Blend two images
Started: 31th October 2009
Author: Lukas W
RemEnd
Rem LW - Initialize
sync on
sync rate 0
set text size 72
Rem LW - Load First image
For x = 0 to 127 : For y = 0 To 127 : dot x,y,RGB(rnd(255),rnd(255),rnd(255)) : NExt y : Next x
Get Image 1, 0, 0, 128, 128
`load image "img01.jpg", 1
Rem LW - Load Second Image
CLS RGB(0, 255, 0)
for x = 0 to 9 : circle rnd(128), rnd(256), 5+rnd(30) : next x
Get Image 2, 0, 0, 128, 256
`load image "img02.bmp", 2
Rem LW - BLEND_IMAGES function
Rem LW - img_one - the bottom image
Rem LW - img_two - the top image
Rem LW - img_blended - the blended image
Rem LW - blend_amount# - amount to blend 0-full, 127.5-half, 255-none
Rem LW - width - the desired width of the blended image
Rem LW - height - the desired height of the blended image
BLEND_IMAGES( 1, 2, 3, 127.5, 128, 128 )
Rem LW - Begin Main Loop
DO : CLS 0
Rem LW - Paste First Image
Paste Image 1, 0, 0
Rem LW - Paste Second Image
Paste Image 2, 175, 0
Rem LW - Add some text
Text 129, 20, "+"
Text 309, 20, "="
Rem LW - Paste Third Image
Paste Image 3, 350, 0
Sync : LOOP
function blend_Images( img_one, img_two, img_blended, blend_amount#, width, height )
Create Bitmap 1, width, height
CLS 0
Sprite img_one, width+10,height+10, img_one
Size Sprite img_one, width, height
Sprite img_one, 0,0, img_one
Set Sprite img_one, 0, 1
Sprite img_two, width+10,height+10, img_two
Size Sprite img_two, width, height
Sprite img_two, 0,0, img_two
Set Sprite img_two,0,1
Set Sprite Alpha img_two, blend_amount#
Sync : Get Image img_blended, 0, 0, width, height
Delete Sprite img_one
Delete Sprite img_two
Delete Bitmap 1
endfunction
|
|
