WorldSim3D game engine
Would you like to react to this message? Create an account in a few clicks or log in to continue.

Go down
Alex
Alex
King
Posts : 19
Join date : 2023-01-05
https://worldsim3d.forumotion.com

The 15 puzzle (3D) (made by Tiranas) Empty The 15 puzzle (3D) (made by Tiranas)

Sun Jan 08, 2023 7:11 am
Hi guys, did you ever played the "15 puzzle" game?

The 15 puzzle (also called Gem Puzzle, Boss Puzzle, Game of Fifteen, Mystic Square and many others) is a sliding puzzle having 15 square tiles numbered 1–15 in a frame that is 4 tiles high and 4 tiles wide, leaving one unoccupied tile position. Tiles in the same row or column of the open position can be moved by sliding them horizontally or vertically, respectively. The goal of the puzzle is to place the tiles in numerical order. (Wikipedia)

By the way, I know Tiranas as a really good programmer!

Download: 15 puzzle (10 mb, zip, google drive)

The 15 puzzle (3D) (made by Tiranas) Screen10


Last edited by Alex on Sun Jan 08, 2023 11:41 am; edited 1 time in total

Alex likes this post

Alex
Alex
King
Posts : 19
Join date : 2023-01-05
https://worldsim3d.forumotion.com

The 15 puzzle (3D) (made by Tiranas) Empty Source code !!!

Sun Jan 08, 2023 11:39 am
Code:
'----------------------------------------------------
'  "The 15 puzzle"
'' Made by Tiranas (Dec 17, 2020)
'----------------------------------------------------
#Include "./WorldSim3D.bi"
#include "./SampleFunctions.bi"

randomize timer
dim shared as float32    fTmp      = 0f
dim shared as string      sTmp1

Dim as wFont      MyFont               = 0
Dim as Int32      prevFPS             = 0
dim as wColor4s  sceneColor         = (255,0,0,0)
dim shared as wVector2i  fromPos     = (0, 0)
dim shared as wVector2i  toPos        = (0, 0)
dim as String    wndCaption          = "3D Fifteen puzzle (made by Tiranas) with WorldSim3D game engine "
dim as String    metrics          = ""
Dim shared as wVector3f  vec3, vec4
dim shared as float32        cubsize
  cubsize = 25
Dim shared as wGuiObject  msg_err      = 0
dim shared as wTexture    sText0        = 0
dim shared as wAnimator  cubemove_anim = 0
dim shared as wNode      sNodeBSG      = 0

dim shared as wNode      cube(0 to 64)
Dim shared as int32      nMax, nSavI, eg, nm, nMove
Dim shared As Byte        m()
Dim shared As int32      iSelectedNode

dim shared as byte        m2(1 To 6, 1 To 6, 0 To 1)
dim shared as int32      nDoHod
dim shared as int32      gf_retry
dim shared as byte        gf_iq, gf_min, gf_recur, gbErr
Dim shared As Boolean    bAuto = false
Dim shared As Boolean    nAutoMove = false

' For Rit1() function
dim shared as int32      iNul, jNul
dim shared as int32      gHTX, gHTY
dim shared as int32      gHX1, gHY1

declare sub CreateBackground()
declare sub control_key()
declare sub ScreenShot_only()
declare Sub CreatePole()
declare Function GetSumm() As Boolean
declare Function Rnd1() As Byte 
declare Sub NewPole()
declare sub MoveCubeToPos(iSelNode as int32)
declare Function GetVictory() As Boolean

declare sub Set_m2()
declare Function rMove1(m3() As Byte, k As Byte, i0 As Int32, j0 As Int32) As int32
declare Sub AI_Move()
declare sub AI_MoveAll()
declare Function GetRetryIQ(v As int32) As Byte
declare Function Rit1(m3() As Byte, nMove As Byte, i0 As Int32, j0 As Int32) As Int32
 


dim as wVector2u screen_size = (1360, 768)
'Dim as Boolean init=wEngineStart(wDRT_OPENGL, wDEFAULT_SCREENSIZE, 32, false, FALSE, TRUE, FALSE)
Dim as Boolean init=wEngineStart(wDRT_OPENGL, screen_size, 32, false, FALSE, TRUE, FALSE)
if Not init then
   PrintWithColor("wEngineStart() failed!"): end
endif

'    Dim shared As wVector2u scrSize
'    wWindowGetSize(@scrSize)

dim shared as wGuiObject  button1
dim as wVector2i          minPos, maxPos
minPos.x = 600: minPos.y = 690
maxPos.x = 750: maxPos.y = 720
button1 = wGuiButtonCreate (minPos, maxPos, "AI solution", "I give up. You yourself solve!")
wGuiObjectSetId (button1, 101)


Dim as string fontPath="./Assets/Fonts/Consolas_12.xml"

CheckFilePath(fontPath)
MyFont=wFontLoad(fontPath)
wEngineShowLogo(false)

    Dim as wGuiObject guiSkin = wGuiGetSkin()
    wGuiSkinSetFont(guiSkin, MyFont)
    wGuiSkinSetColor(guiSkin, wGDC_3D_FACE, wCOLOR4s_SKYBLUE)
    Dim as wColor4s btnColor = (255,25,100,0)
    wGuiSkinSetColor(guiSkin, wGDC_BUTTON_TEXT, btnColor)
    For i as Int32 = 0 To wGDC_COUNT - 1
        Dim as wColor4s clr = wGuiSkinGetColor(guiSkin,i)
        clr.alpha=255
        wGuiSkinSetColor(guiSkin, i, clr)
    Next i

     
dim shared as wNode  camera2
Dim shared as wVector3f  pos2, tar1, tar2, vec1, vec2, normal_vec, n_vec
pos2.x = 200: pos2.y = 0: pos2.z = 0
tar2.x = 0: tar2.x = 0: tar2.x = 0
      camera2 = wCameraCreate (pos2, tar2)
      wCameraSetClipDistance (Camera2, 12000, 1)
      wCameraSetFov (Camera2, 0.8) ' wMathPI/2.5

CreateBackground()
NewPole()
CreatePole()

Dim As double fTime = timer + 0.01667
while(wEngineRunning())
  if (timer >= fTime) Then
    fTime = timer + 0.01667
   
    wSceneBegin(sceneColor)
               
    wSceneDrawAll()   
    /'
    fromPos.x = 10: fromPos.y = 10
    metrics = "Polygons:  " & Str(wSceneGetPrimitivesDrawn())
    wFontDraw(MyFont,metrics,fromPos,toPos,wCOLOR4s_YELLOW)
   
    metrics = "Nodes:  " & Str(wSceneGetNodesCount())
    fromPos.x = 10: fromPos.y += 20
    wFontDraw(MyFont,metrics,fromPos,toPos,wCOLOR4s_DARKORANGE)

    metrics = "Meshes:  " & Str(wSceneGetMeshesCount())
    fromPos.x = 10: fromPos.y += 20
    wFontDraw(MyFont,metrics,fromPos,toPos,wCOLOR4s_LIME)
   '/
    metrics = "Moves:  " & Str(nMove)
    fromPos.x = 10: fromPos.y = 10
    wFontDraw(MyFont,metrics,fromPos,toPos,wCOLOR4s_MAGENTA)

    'fromPos.x = 10: fromPos.y += 20
    'wFontDraw(MyFont,sTmp1,fromPos,toPos,wCOLOR4s_WHITE)

    wGuiDrawAll()
    wSceneEnd()
   
    wEngineCloseByEsc()
    if prevFPS <> wEngineGetFPS() then
      prevFPS = wEngineGetFPS()
      wWindowSetCaption(wndCaption+str(prevFPS))
    endif
    control_key()
  endif
wend

wEngineStop()
end

sub control_key()
  Dim as wKeyEvent Ptr    KeyEvent
  Dim as wMouseEvent Ptr  MouseEvent
  Dim as wNode            SelectedNode
  Dim as wGuiEvent Ptr    guiEvent = 0
   
  if cubemove_anim <> 0 then
    if wAnimatorIsFinished(cubemove_anim) then
      wAnimatorSetEnable(cubemove_anim, false, 0)
      cubemove_anim = 0
      if GetVictory() then
        wGuiObjectSetEnable (button1, true)
        nAutoMove = false
      endif
    else
      exit sub
    endif
  endif

  if nAutoMove then
    AI_MoveAll()
    exit sub
  endif

  if msg_err <> 0 then
    if(wGuiIsEventAvailable()) Then
      guiEvent = wGuiReadEvent()
      if(guiEvent->event=wGCT_MESSAGEBOX_OK) Then
        msg_err = 0
        NewPole()
        CreatePole()
        exit sub
      endif
    endif
    exit sub
  endif

    if wGuiIsEventAvailable() Then
      guiEvent = wGuiReadEvent()
      if guiEvent -> event = wGCT_BUTTON_CLICKED Then
        If guiEvent -> id = 101 Then
          wGuiObjectSetEnable (button1, false)
          nAutoMove = true
          exit sub
        endif
      endif
    endif


  Do While (wInputIsKeyEventAvailable())
    KeyEvent = wInputReadKeyEvent()
         
    If (Not KeyEvent->isControl) And (Not KeyEvent->isShift) Then
      dim as int32 ind1
      Select case as const KeyEvent->key       
        Case wKC_PLUS  ' increase
        Case wKC_MINUS ' decrease
        Case wKC_F1
          'if KeyEvent->direction = wKD_UP Then VisHelp = Not VisHelp
         Case wKC_F2
        Case wKC_F3
        Case wKC_F11
          '
        Case wKC_F12
          if KeyEvent->direction = wKD_UP Then ScreenShot_only()
        Case wKC_KEY_W, wKC_UP, wKC_NUMPAD8
          If KeyEvent->direction = wKD_UP and ((nm + eg) <= nMax) Then
            ind1 = m(nm + eg)  ' 38 Up
            MoveCubeToPos(ind1)
          endif
        Case wKC_KEY_D, wKC_RIGHT, wKC_NUMPAD6
          If KeyEvent->direction = wKD_UP and ((nm - 1) >= 0) Then
            ind1 = m(nm - 1)      ' 39 Right
            MoveCubeToPos(ind1)
          endif
        Case wKC_KEY_S, wKC_DOWN, wKC_NUMPAD2
          If KeyEvent->direction = wKD_UP and ((nm - eg) >= 0) Then
            ind1 = m(nm - eg)    ' 40 Down
            MoveCubeToPos(ind1)
          endif
        Case wKC_KEY_A, wKC_LEFT, wKC_NUMPAD4
          If KeyEvent->direction = wKD_UP and ((nm + 1) <= nMax) Then
            ind1 = m(nm + 1)    ' 37 Left
            MoveCubeToPos(ind1)
          endif
        Case wKC_ESCAPE
      End Select    
    Else
      Exit Do
    EndIf
  loop


  while wInputIsMouseEventAvailable()
    MouseEvent = wInputReadMouseEvent()
    if MouseEvent->action=wMET_MOUSE_MOVED then
      SelectedNode = wCollisionGetNodeFromScreen(MouseEvent->position)
      for i as Int32 = 0 to nMax
        if cube(i) <> 0 then wNodeSetDebugMode(cube(i), wDM_OFF)
      next i
      if SelectedNode <> 0 then
        for i as Int32 = 0 to nMax
          if SelectedNode = cube(i) then
            if cube(i) <> 0 then
              wNodeSetDebugMode(cube(i), wDM_BBOX)
              iSelectedNode = i: exit for
            endif
          endif
        next i
      else
        iSelectedNode = -1
      endif
    endif
    if MouseEvent->action=wMET_LMOUSE_LEFT_UP then
      MoveCubeToPos(iSelectedNode)
    endif
  wend

 
end sub

Sub ScreenShot_only()
  Dim As String sFile
  For i As int32 = 0 To 999
      sFile = "./Screenshots/ScreenShot_" & Right("0000" & Str(i), 3) & ".jpg"
    If Not wFileIsExist(sFile) Then
      wSystemSaveScreenShot(sFile)
      Exit For
    EndIf
  Next i
End Sub

sub MoveCubeToPos(iSelNode as int32)
  ' Move a cell
  if iSelNode < 0 then exit sub
  if cubemove_anim <> 0 then
    if not wAnimatorIsFinished(cubemove_anim) then
      exit sub
    endif
  endif
 
  if nMove >= 2048 then
    msg_err = wGuiMessageBoxCreate("I am sorry, man", "You have reached the maximum number of moves!", true, wGMBF_OK, 0)
    exit sub
  endif
 
  Dim k As Int32, i As Int32, B As Byte, sav_nm as byte
  If ((nm - 1) >= 0) And ((nm Mod eg) <> 0) Then If (m(nm - 1) = iSelNode) Then k = -1
  If ((nm + 1) <= nMax) And (((nm + 1) Mod eg) <> 0) Then If (m(nm + 1) = iSelNode) Then k = 1
  If (nm - eg) >= 0 Then If (m(nm - eg) = iSelNode) Then k = -eg
  If (nm + eg) <= nMax Then If (m(nm + eg) = iSelNode) Then k = eg
  If k = 0 Then Exit Sub
  sav_nm = nm
  B = m(nm): m(nm) = m(nm + k): m(nm + k) = B: nm = nm + k


    vec2 = vec1
    vec2.y =  vec1.y + ((nMax - sav_nm) \  eg) * (cubsize + 0.3) - (eg shr 1) * cubsize + (cubsize shr 1)
    vec2.z =  vec1.z + (sav_nm mod eg) * (cubsize + 0.3) - (eg shr 1) * cubsize + (cubsize shr 1)
    vec3 = wNodeGetAbsolutePosition(cube(iSelNode))
    cubemove_anim = wAnimatorFlyingStraightCreate (cube(iSelNode), vec3, vec2, 300, false)
    'wNodeSetPosition (cube(iSelNode), vec2)
  nMove = nMove + 1
end sub


Function GetVictory() As Boolean
  For i as int32 = 0 To (nMax - 1)
    If m(i) <> (i + 1) Then return false
  Next i
  if nAutoMove then
    msg_err = wGuiMessageBoxCreate("I win!", "I am awesome. AI is perfect!", true, wGMBF_OK, 0)
  else
    msg_err = wGuiMessageBoxCreate("You win!", "You are clever! You did well!", true, wGMBF_OK, 0)
  endif
  return true
End Function


Function Rnd1() As Byte
  dim as byte Rnd2 = Fix(Rnd * (nMax + 1))
  return Rnd2
End Function

Function GetSumm() As Boolean
  ' Solvability check and correction
  Dim i As Byte, j As Byte, iSum As Int32, I1 As Byte, i2 As Byte
  iSum = 0
  For i = 0 To nMax
    For j = i + 1 To nMax
      If m(i) > m(j) Then iSum = iSum + 1
    Next j
  Next i
  iSum = iSum + Sqr(nMax + 1)
  If (iSum Mod 2) = 0 Then ' correction
    For i = 0 To 30
      I1 = Rnd1(): i2 = Rnd1()
      If (I1 <> i2) And ((m(I1) > 0) And (m(i2) > 0)) Then j = m(I1): m(I1) = m(i2):  m(i2) = j: Exit For
    Next i
  Else
    return True
  End If
End Function

Sub NewPole()
  Dim I1 As Byte, i2 As Byte, j As Byte
  iSelectedNode = -1
  nMove = 0
  nDoHod = 0
  nSavI = 0
  gf_min = 10
  gf_iq = gf_min: gf_retry = 0: gf_recur = 0
 
    nMax = (nSavI + 4) * (nSavI + 4) - 1
    If nMax = 15 Then eg = 4
    If nMax = 24 Then eg = 5
    If nMax = 35 Then eg = 6

    Erase m: ReDim m(36)
   
    For i as int32 = 0 To nMax
      If i < nMax Then m(i) = i + 1
    Next i
      For n as int32 = 1 To 64
        I1 = Rnd1(): i2 = Rnd1()
        If (I1 <> i2) And ((m(I1) > 0) And (m(i2) > 0)) Then j = m(I1): m(I1) = m(i2):  m(i2) = j
      Next n
      GetSumm()  ' Solvability check and correction
    for i as int32 = 0 to nMax
      If m(i) = 0 Then
        nm = i
        exit for
      endif
    next i
end sub

Sub CreatePole()
  dim as string        sFile
  dim as wTexture      sText
  dim as wMaterial      mat1
  dim as int32          nnPlus = 0
 
  if sText0 = 0 then
    sFile = ".\Assets\texture\b1.jpg"
    sText0 = wTextureLoad(sFile)
    wEngineSetTransparentZWrite(true)
  endif
 
  for i as int32 = 1 to 15
    if cube(i) = 0 then
      nnPlus += 1
      sFile = ".\Assets\texture\" + str(i) + ".jpg"
      sText = wTextureLoad (sFile)
      cube(i) = wNodeCreateCube(cubsize, false, wCOLOR4s_WHITE)
      mat1 = wNodeGetMaterial(cube(i), 0)
      wMaterialSetFlag (mat1, wMF_LIGHTING, FALSE)
      wMaterialSetFlag (mat1, wMF_ANISOTROPIC_FILTER, TRUE)
      wMaterialSetFlag (mat1, wMF_BILINEAR_FILTER, false)
      wMaterialSetFlag (mat1, wMF_TRILINEAR_FILTER, TRUE)
      wMaterialSetTexture (mat1, 0, sText)
    endif
  next i

  for i as int32 = 0 to nMax
    if m(i) > 0 then
      vec2 = vec1
      vec2.y =  vec1.y + ((nMax - i) \  eg) * (cubsize + 0.3) - (eg shr 1) * cubsize + (cubsize shr 1)
      vec2.z =  vec1.z + (i mod eg) * (cubsize + 0.3) - (eg shr 1) * cubsize + (cubsize shr 1)
      wNodeSetPosition (cube(m(i)), vec2)
      if nnPlus > 0 then
        wNodeRotateToNode (cube(m(i)), Camera2)
      endif
    endif
  next i
End Sub








'---------------------------------
' AI !
'---------------------------------


Function Rit1(m3() As Byte, nMove As Byte, i0 As Int32, j0 As Int32) As Int32
  ' Evaluation function
  Dim i As Int32, j As Int32, d As Int32, s1 As Int32
  Dim i3 As Int32, j3 As Int32, k3 As Byte, rr as int32
  k3 = 127
  For d = 1 To eg
    If (k3 = 127) Then
      For i = 1 To eg
        If (m3(i, d, 0) = m3(i, d, 1)) Then
          rr = rr + nMax
        Else
          k3 = m3(i, d, 1): i3 = i: j3 = d: Exit For
        End If
      Next i
      If (k3 = 127) Then rr = rr + 10000 Else Exit For
    End If
    If (k3 = 127) Then
      For j = 1 To eg
        If (m3(d, j, 0) = m3(d, j, 1)) Then
          rr = rr + nMax
        Else
          k3 = m3(d, j, 1): i3 = d: j3 = j: Exit For
        End If
      Next j
      If (k3 = 127) Then rr = rr + 10000 Else Exit For
    End If
  Next d
  If (k3 < 127) And (k3 > 0) Then
    For j = 1 To eg
      For i = 1 To eg
        If (k3 = m3(i, j, 0)) Then
          s1 = nMax - Abs(i - i3) - Abs(j - j3) - Abs(i - i0) - Abs(j - j0)
          Exit For
        End If
      Next i
      If (s1 > 0) Then Exit For
    Next j
  End If
  rr = rr - nMove + s1
  return rr
End Function


sub Set_m2()
  ' Fill in the m2 matrix and determine the coordinates of the zero cell
  Dim I1 As Byte, j1 As Byte, X As Int32
  I1 = 1: j1 = 1
  Erase m2
  For X = 0 To nMax
    m2(I1, j1, 0) = m(X) ' current filling of the matrix
    If X < nMax Then m2(I1, j1, 1) = X + 1 ' correct filling of the matrix
    If m(X) = 0 Then iNul = I1: jNul = j1
    I1 = I1 + 1: If I1 > eg Then j1 = j1 + 1: I1 = 1
  Next X
End sub


Function rMove1(m3() As Byte, k As Byte, i0 As Int32, j0 As Int32) As int32
  ' sorting through the options of moves
  If k > gf_iq Then return 0
  Dim R(3) As Int32, i As Int32, h As Int32
  If (i0 < eg) Then
    m3(i0, j0, 0) = m3(i0 + 1, j0, 0): m3(i0 + 1, j0, 0) = 0
    'Call VisM3(m3())
    R(0) = Rit1(m3(), k, i0 + 1, j0) + rMove1(m3(), k + 1, i0 + 1, j0)
    m3(i0 + 1, j0, 0) = m3(i0, j0, 0): m3(i0, j0, 0) = 0
  End If
  If (i0 > 1) Then
    m3(i0, j0, 0) = m3(i0 - 1, j0, 0): m3(i0 - 1, j0, 0) = 0
    R(1) = Rit1(m3(), k, i0 - 1, j0) + rMove1(m3(), k + 1, i0 - 1, j0)
    m3(i0 - 1, j0, 0) = m3(i0, j0, 0): m3(i0, j0, 0) = 0
  End If
  If (j0 < eg) Then
    m3(i0, j0, 0) = m3(i0, j0 + 1, 0): m3(i0, j0 + 1, 0) = 0
    R(2) = Rit1(m3(), k, i0, j0 + 1) + rMove1(m3(), k + 1, i0, j0 + 1)
    m3(i0, j0 + 1, 0) = m3(i0, j0, 0): m3(i0, j0, 0) = 0
  End If
  If (j0 > 1) Then
    m3(i0, j0, 0) = m3(i0, j0 - 1, 0): m3(i0, j0 - 1, 0) = 0
    R(3) = Rit1(m3(), k, i0, j0 - 1) + rMove1(m3(), k + 1, i0, j0 - 1)
    m3(i0, j0 - 1, 0) = m3(i0, j0, 0): m3(i0, j0, 0) = 0
  End If
  dim as int32 rH1
  rH1 = R(0): i = 1 ' 37 Left  (1)
  If (R(1) >= rH1) Then rH1 = R(1): i = 2 ' 39 Right (2)
  If (R(2) > rH1) Then rH1 = R(2): i = 3  ' 38 Up    (3)
  If (R(3) >= rH1) Then rH1 = R(3): i = 4 ' 40 Down  (4)
  If (k = 1) Then
    return i
  Else
    return rH1
    'rMove1 = r(0) + r(1) + r(2) + r(3)
  End If
End Function


Function GetRetryIQ(v As int32) As Byte
  If (v = 1) And (gf_retry = 2) Then return 0
  If (v = 2) And (gf_retry = 1) Then return 0
  If (v = 3) And (gf_retry = 4) Then return 0
  If (v = 4) And (gf_retry = 3) Then return 0
  return 1
End Function

sub AI_MoveAll()
  if cubemove_anim <> 0 then
    if wAnimatorIsFinished(cubemove_anim) then
      wAnimatorSetEnable(cubemove_anim, false, 0)
      cubemove_anim = 0
    endif
    return
  endif
  if nAutoMove or not bAuto then AI_Move()
end sub

Sub AI_Move()
  ' AI move
  If bAuto Then Exit Sub
  bAuto = True
  Dim As int32 v, xn, yn
  '  "I'm thinking"
  ' Fill in the m2 matrix and determine the coordinates of the zero cell
  Set_m2()
  'Call Get_ex_ey ' Determine the minimum upper bound of processing
  If nDoHod = 0 Then
    v = rMove1(m2(), 1, iNul, jNul)
  End If
  If GetRetryIQ(v) = 0 Or nDoHod > 0 Then
    nDoHod = nDoHod + 1
    If nDoHod >= 2 Then nDoHod = 0
    ' There is a repeat of the move
    Set_m2()
    If jNul = (eg - 1) Then
      If iNul = (eg - 2) Then
        v = 3
      Else
        If iNul > (eg - 2) Then
          v = 2
        Else
          v = 3
        End If
      End If
    Else
      If jNul = eg Then
        If iNul = eg Then
          v = 4
        Else
          If iNul < eg Then
            v = 1
          Else
            v = 1
          End If
        End If
      Else
        v = 2
      End If
    End If
  End If
 
 
  dim as int32 ind1
  gf_retry = v
  Select Case v
  Case 1
          If ((nm + 1) <= nMax) Then
            ind1 = m(nm + 1)      ' 37 Left
            MoveCubeToPos(ind1)
          endif
  Case 2
          If ((nm - 1) >= 0) Then
            ind1 = m(nm - 1)      ' 39 Right
            MoveCubeToPos(ind1)
          endif
  Case 3
          If ((nm + eg) <= nMax) Then
            ind1 = m(nm + eg)      ' 38 Up
            MoveCubeToPos(ind1)
          endif
  Case 4
          If ((nm - eg) >= 0) Then
            ind1 = m(nm - eg)      ' 40 Down
            MoveCubeToPos(ind1)
          endif
  End Select
  bAuto = False
End Sub


sub CreateBackground()
  dim as string    sFile = ".\Assets\texture\Background1.jpg"
  dim as wTexture  sText = wTextureLoad(sFile)
  dim as wVector2f  tileSize = (400, 200)
  sNodeBSG = wNodeCreatePlane(tileSize, wVECTOR2u_ONE, 0, wVECTOR2f_ONE, false)
      dim as wMaterial  mat1 = wNodeGetMaterial(sNodeBSG, 0)
      wMaterialSetFlag (mat1, wMF_LIGHTING, FALSE)
      wMaterialSetFlag (mat1, wMF_ANISOTROPIC_FILTER, TRUE)
      wMaterialSetFlag (mat1, wMF_BILINEAR_FILTER, false)
      wMaterialSetFlag (mat1, wMF_TRILINEAR_FILTER, TRUE)
      wMaterialSetTexture (mat1, 0, sText)
  dim as wVector3f  vBCG, vTar
  vBCG = vec1
  vBCG.x = -cubsize
  wNodeSetPosition (sNodeBSG, vBCG)
  wNodeRotateToNode (sNodeBSG, Camera2)
  vTar.z = 270
  vTar.y = -90
  wNodeSetAbsoluteRotation (sNodeBSG, vTar)
  wNodeUpdateAbsolutePosition (sNodeBSG)
  wNodeDraw (sNodeBSG)
end sub
Back to top
Permissions in this forum:
You cannot reply to topics in this forum