I have YIM here and AIM at work... sent you that!
Just playing around with things:
; #############################
; INsanity 1.A
;
; Rook Zimbabwe aka SSG R. W. Dunn TXSG
; 9 MARCH 2005
; and RaGr aka R G Roeske 2005-05_10
; #############################
Graphics3D 800,600,16,2
SetBuffer BackBuffer()
SeedRnd MilliSecs()
Global camera=CreateCamera()
PositionEntity camera,0,0,-85
lights=CreateLight()
PositionEntity lights,0,200,-85
NBDreamFilter_Create()
Dim boardarea(11) ; main line of colored thingys
Dim topline(11) ; line to move the first selected UP to
Dim bottomline(11) ; line theat I wish I could see the second selected move down to
Dim boardx(11) ; array that holds piece locations set up later.
Dim boardy(11) ; probaly useless but set up for now just in case
Dim MyMesh(11)
Dim MyBrush(11)
Dim pCol$(11)
Dim result(11)
Dim Colchain(9)
Global xx
Global yy
Global what ; what color is it
Global firstpick ; piece picked first
Global secondpick ; piece picked second
Global slipper
Global pcolor$ ; what color is it
Global colr ; what to color it
Global where ; Variable to devolve array place in camerapick
Global picker ; FLAG for which pick it is 1 or 2 starts with 1
Global entity
Global g_BlurTex
Global g_BlurSprite
Const k_HDRTextureSize = 256 ; Blur texture size, must be power of 2
Const k_HDRMotionZoom# = 1.022 ; The amount the blur sprite scales
Const k_HDRBlurFeedBack = 220 ; 0 - 255 The amount of previous frame to feedback
Const k_HDRBlurFilter = 100 ; 0 - 255 The amount of the filter to overlay (additive) to the scene
Const k_HDRZSpritePos# = 1.1
Const k_HDRSpriteOffs# = 0.001
; ################################### MAKE INITIAL COLOR ARRAY FOR BOARD fill with 0
colr=0
For fillx = 0 To 11
boardarea(fillx)=colr
topline(fillx)=colr
bottomline(fillx)=colr
Next
; locations of pieces stored in array for manipulation later
For i=0 To 11
boardx(i)=-55+i*10
Next
; Colors set up now for use later
Restore colors
Global count=0
Global Tries=0
Repeat
Read c$
If c$="-" Exit
Read r,g,b
count=count+1
MyBrush(count)=CreateBrush(r,g,b):BrushShininess MyBrush(count),0.9:pCol$(count)=c$
Forever
.Colors
Data "Red",255,0,0
Data "Blue",40,40,255
Data "Yellow",192,192,0
Data "Green",0,144,0
Data "Orange",255,80,0
Data "Violet",122,23,255
Data "Cyan",23,192,192
Data "Brown",160,100,63
Data "White",192,192,192
Data "-"
; have to make a mouse pointer pic (32X32 DIAMOND standard mouse lean is OK)
;Global point=LoadImage("Mousepointer.png") ; ############ Load a pointer pic
Global gamePivot = CreatePivot()
;chain=LoadMesh("chain1.b3d") ; used in my game idea but not necessary
;ScaleEntity chain,4,.5,1
chain=CreateCylinder()
ScaleEntity chain,0.7,120,0.7
RotateEntity chain,0,0,90,True
;Global mesh=CreateCube()
Global mesh = CreateSphere(16)
EntityPickMode mesh,2
ScaleEntity mesh,4,4,4 ; was 5,5,5 for sphere
HideEntity mesh
For i=0 To 11
MyMesh(i)=CopyEntity(mesh)
Next
PointEntity lights,mesh
newcolor()
setupboard()
picker = 1
; ############################# START OF PROGRAM LOOP
While Not KeyHit(1)
NBDreamFilter_Update()
mx=MouseX()
my=MouseY()
e=CameraPick(camera,mx,my)
If e<>entity
If entity Then EntityAlpha entity,1
entity=e
EndIf
If e Then
xxx=EntityX(entity,True)
wherealpha=(xxx + 55)/10 ; math on xx to devolve array place (ain't fancy but it works)
If boardarea(wherealpha)<>result(wherealpha) EntityAlpha entity,.55
;EndIf
EndIf
If MouseHit(1) = True Then
that=CameraPick(camera,mx,my)
If that=0 Then Goto outme ; if picked something unpickable go out else select mesh
Select mesh
Case mesh
xx=EntityX(entity,True)
where=(xx + 55)/10 ; math on xx to devolve array place (ain't fancy but it works)
pickpiece$=EntityName$(entity)
Default
FlushMouse ; clean up mouse click
End Select
If MouseY()>274 And MouseY()<321 Then
If picker=1 Then ; this is where we use that FLAG
If boardarea(where)=result(where) Goto outme
If boardarea(where)<>0
topline(where)=boardarea(where) ; assign value from middle row to top
boardarea(where)=0
Else
topline(where)=bottomline(where)
bottomline(where)=0
; setupboard()
; Goto outme
EndIf
firstpick = where ; assign same value to holder for use later
For i=0 To 11
If bottomline(i)<>0 Then boardarea(i)=bottomline(i):bottomline(i)=0
Next
setupboard() ; reposition the boards line 1,2, and 3
FlushMouse
picker = 2 ; set picker to 2 for second pick
ElseIf picker=2
If boardarea(where)=result(where) Goto outme
If topline(firstpick)=result(where)
topline(where)=boardarea(where)
boardarea(firstpick)=topline(where) ; get the idea from picker=1
boardarea(where)=topline(firstpick)
topline(firstpick)=0
topline(where)=0
ElseIf bottomline(firstpick)=result(where)
bottomline(where)=boardarea(where)
boardarea(firstpick)=bottomline(where) ; get the idea from picker=1
boardarea(where)=bottomline(firstpick)
bottomline(firstpick)=0
bottomline(where)=0
Else
bottomline(firstpick)=boardarea(where)
boardarea(where)=topline(firstpick)
topline(firstpick)=0
topline(where)=0
If bottomline(firstpick)=result(firstpick)
boardarea(firstpick)=bottomline(firstpick)
bottomline(firstpick)=0
EndIf
EndIf
; secondpick = where
setupboard()
FlushMouse
; switcheroo() ; this is what I call to switch the values from what has been selected.
picker = 1
Tries=Tries+1
EndIf
EndIf
.outme
FlushMouse
EndIf
; ################################### USELESS BUT ADDED FOR FUN for now!
If KeyDown(57) Then ; SPACE BAR makes new setup... just for giggles
FreeEntity gamePivot
gamePivot = CreatePivot()
Cls
newcolor()
setupboard()
EndIf
; ################################### end of useless?
UpdateWorld()
RenderWorld()
; ############################# PRINT the array so I can check it...
finito=0
For i=0 To 11
If boardarea(i)=result(i) Then finito=finito+1
Next
Text 0,0,"SPACEBAR generates new color chain"
Text 0,20,finito+" spheres at position"
Text 0,40,"Tries: "+tries
ba$="":For i=0 To 11:ba$=ba$+Str$(result(i)):Next
Text 0,70,"GOAL:"+ba$
bb$="":For i=0 To 11:bb$=bb$+Str$(boardarea(i)):Next
Text 0,90," YOU:"+bb$
If finito=12
Text 400,120,"Done!!! You needed "+Tries+" Tries!",True,True
EndIf
;DrawImage point,MouseX(),MouseY() ; gotta show the mouse
Flip
Wend
NBDreamFilter_Destroy()
End
; ################################# FUNCTIONS
Function setupboard()
Cls
; BOTTOM LINE
col=-10
For row=0 To 11
what=bottomline(row)
If what<>0
PositionEntity Mymesh(row),boardx(row),col,0
PaintEntity Mymesh(row),MyBrush(bottomline(row))
EndIf
Next
; ########### topline
col=10
For row=0 To 11
what=topline(row)
If what<>0
PositionEntity Mymesh(row),boardx(row),col,0
PaintEntity Mymesh(row),MyBrush(topLine(row))
EndIf
Next
; MAIN ROW
col=0
For row=0 To 11
;For col=0 To 9
what=boardarea(row)
If what<>0
PositionEntity Mymesh(row),boardx(row),col,0
PaintEntity Mymesh(row),MyBrush(boardarea(row))
EndIf
Next
End Function
; #################################
Function checkforthree()
; not used and very simplistic for now
; LEFT and RIGHT
For row=0 To 9
a=boardarea(row)
b=boardarea(row+1)
c=boardarea(row+2)
If a = b Then
If b = c Then
boardarea(row)=0
boardarea(row+1)=0
boardarea(row+2)=0
;score = score+(55*sval)
EndIf
EndIf
Next
End Function
; #################################
Function newcolor(max=2)
For i=0 To 11
boardarea(i)=0
Next
For row = 0 To 11
Repeat
colr=Rand(1,count)
c=0
For i=0 To 11
If boardarea(i)=colr c=c+1
Next
Until c<max
boardarea(row)=colr
Next
finalchain()
Tries=0
End Function
Function finalchain()
Repeat
For i=1 To count
colchain(i)=i
Next
For i=1 To Rand(10,20)
s1=Rand(1,count)
s2=Rand(1,count)
c=colchain(s1):colchain(s1)=colchain(s2):colchain(s2)=c
Next
c=0
Posit=0
Repeat
c=c+1
For i=0 To 11
If boardarea(i)=colchain(c) result(Posit)=boardarea(i):Posit=Posit+1
Next
Until c=count
finito=0
For i=0 To 11
If boardarea(i)=result(i) Then finito=finito+1
Next
Until finito<3
End Function
Function capturescreen()
CopyRect 0,0,GraphicsWidth(),GraphicsHeight(),0,0,BackBuffer(),ImageBuffer(screenbk)
End Function
Function WobbleView()
gw#=GraphicsWidth()
gh#=GraphicsHeight()
underw_a=(underw_a+4)
steph#=gh/32
mu8#=gh/60
If underw_a>359 Then underw_a=0
For iif#=0 To gh-4 Step .001
wsin#=(Sin((underw_a+iif)Mod 360.0)*mu8#)
CopyRect 0, iif, gw,steph+4, 0,iif+wsin#, ImageBuffer(screenbk),BackBuffer()
iif=iif+steph
Next
End Function
;///////////////////////////////////////////////////////////////////////////////
; Creates the Dream filter
;///////////////////////////////////////////////////////////////////////////////
Function NBDreamFilter_Create()
; Create a fullscreen sprite
spr = CreateMesh(camera)
sf = CreateSurface(spr)
; Make a quad
AddVertex sf, -1, 1, 0, 0, 0
AddVertex sf, 1, 1, 0, 1, 0
AddVertex sf, -1,-1, 0, 0, 1
AddVertex sf, 1,-1, 0, 1, 1
AddTriangle sf, 0, 1, 2
AddTriangle sf, 3, 2, 1
; Set up the sprites position, scale etc...
zpos# = k_HDRZSpritePos#
range# = k_HDRMotionZoom*zpos#
PositionEntity spr, -k_HDRSpriteOffs#, k_HDRSpriteOffs#, zpos#
ScaleEntity spr, range#, range#, 1.0
EntityOrder spr, -10000
; Set full colour & additive blend
EntityFX spr, 1
EntityBlend spr, 3
g_BlurSprite = spr
; Create blur texture
g_BlurTex = CreateTexture(k_HDRTextureSize, k_HDRTextureSize)
EntityTexture spr, g_BlurTex
End Function
;///////////////////////////////////////////////////////////////////////////////
; Destroys the Dream filter
;///////////////////////////////////////////////////////////////////////////////
Function NBDreamFilter_Destroy()
FreeTexture g_BlurTex
FreeEntity g_BlurSprite
End Function
;///////////////////////////////////////////////////////////////////////////////
; Updates the Dream filter
;///////////////////////////////////////////////////////////////////////////////
Function NBDreamFilter_Update()
; Set the viewport to the same size as the blur texture
CameraViewport camera, 0, 0, k_HDRTextureSize, k_HDRTextureSize
; Set the blur feedback value (Additive)
col = k_HDRBlurFeedBack
EntityColor g_BlurSprite, col,col,col
; Render the scene (including the blur sprite and copy it into the texture)
RenderWorld
CopyRect 0,0,k_HDRTextureSize,k_HDRTextureSize, 0, 0, BackBuffer(), TextureBuffer(g_BlurTex)
; Reset the viewport to fullscreen
CameraViewport camera,0,0,GraphicsWidth(),GraphicsHeight()
; Set the blur filter value (Additive)
col = k_HDRBlurFilter
EntityColor g_BlurSprite, col,col,col
End Function
; end of all things
Trying for more of a visual punch... Sounds are needed badly... I may post some on my site as suggestions...
Let me see whats in my library of noise!