PureBasic Forums - English

Posted: **Sun Apr 13, 2025 11:51 pm**

I think it would be interesting to have a post about help tools for the 3D environment. What exactly do I mean? Keyboards, maps, controls, mazes, warnings, radars, FX, or anything that can be easily added to a game or app.
That's why I've created this post.
In it, we could include code snippets to help with specific tasks.
I want to start it with this keyboard for entering text.

Input keyboard for 2D/3D environment
It works with both the physical and virtual keyboard.
It's sprite-based, so it's quite user-friendly.
The result phrase is stored in kb\txt.
Right-clicking the mouse shows or hides the keyboard.
Include sprite mouse cursor.
I followed miso's advice, and it should also work in new versions.
I read that skinkairewalker is looking for something like this. I hope it helps.
Keyboard is Spanish, but you can change. In procedure spriteKeyboard(x,y,w,h,txt.s="Keyboard") change 'Ñ' in kb\lett with your own country keyboard.

Solved black sprite. (i think...

)
TESTED: 6.02 and 6.20

Code: Select all

Global.b  sal
Global.l  renderTime
Global    camara
Global    fontLit= LoadFont(#PB_Any,"Arial",9)
Global    fontMed= LoadFont(#PB_Any,"Arial",16)
Global    fontBig= LoadFont(#PB_Any,"Arial",24)

Procedure   control3D()
  Protected.f speed=0.005, mouseSpd=0.005
  Protected.f KeyX,KeyY, MouseX,MouseY
  
  If KeyboardPushed(#PB_Key_A)
    KeyX= -speed * renderTime
  ElseIf KeyboardPushed(#PB_Key_D)
    KeyX= speed * renderTime
  Else
    KeyX= 0
  EndIf
  
  If KeyboardPushed(#PB_Key_W)
    KeyY= -speed * renderTime
  ElseIf KeyboardPushed(#PB_Key_S)
    KeyY= speed * renderTime
  Else
    KeyY= 0
  EndIf
  
  If KeyboardPushed(#PB_Key_LeftShift)
    keyY * 10
    keyX * 10
  EndIf

  MouseX = -MouseDeltaX() * mouseSpd * renderTime
  MouseY = -MouseDeltaY() * mouseSpd * renderTime
  
  RotateCamera(camara, MouseY, MouseX, 0, #PB_Relative)
  MoveCamera (camara, KeyX, 0, KeyY)
EndProcedure
Procedure   iniDX(title.s="")
  Protected   w,h
  Protected   size=50, col1.l=$0,col2.l=$aaaaaa, res=256
  Protected.i suelo_tx3D, suelo_mate, suelo_mesh, suelo
  UsePNGImageDecoder()
  UseJPEGImageDecoder()
  
  InitEngine3D()
  InitSprite()
  InitKeyboard()
  InitMouse()
  OpenWindow(0,0,0,800,600,title,#PB_Window_ScreenCentered|#PB_Window_BorderLess|#PB_Window_Maximize);|#PB_Window_Invisible)
  SetWindowColor(0,$444444)
  w= WindowWidth(0):h=WindowHeight(0)
  AntialiasingMode(#PB_AntialiasingMode_None)
  OpenWindowedScreen(WindowID(0), 0, 0, w,h, 0,0,0,#PB_Screen_NoSynchronization)
  KeyboardMode(#PB_Keyboard_International)
  CompilerIf #PB_Compiler_Version >= 620 ;this is for new PB. Thanks miso :)
    Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Main", #PB_3DArchive_FileSystem)
    Parse3DScripts() 
  CompilerEndIf
  s=128
  WorldShadows(#PB_Shadow_Modulative, -1, RGB(s,s,s), 2048)
  EnableWorldPhysics(1)
  EnableWorldCollisions(1)
  
  cubo_mesh=    CreateCube(#PB_Any,2)
  cubo_mate=    CreateMaterial(#PB_Any, #Null,$0000ff)
  cubo_enti=    CreateEntity(#PB_Any, MeshID(cubo_mesh), MaterialID(cubo_mate),0,1,0)
  luz=          CreateLight(#PB_Any,$ffffff,30,50,0,#PB_Light_Point)
  
  camara=       CreateCamera(#PB_Any,0,0,100,100)
                MoveCamera(camara,0,5,30)
                CameraBackColor(camara,$886644)
                CameraRange(camara, 0.1,1000)
  suelo_tx3D=   CreateTexture(#PB_Any,res,res)
  StartDrawing(TextureOutput(suelo_tx3D))
    Box(0,0,OutputWidth(),OutputHeight(),col1)
    Box(2,2,OutputWidth()-4,OutputHeight()-4,col2)
  StopDrawing()
  
  suelo_mesh=   CreatePlane(#PB_Any,size,size,1,1,1,1)
  suelo_mate=   CreateMaterial(#PB_Any,TextureID(suelo_tx3D))
                ScaleMaterial(suelo_mate,1/size,1/size)
  suelo=        CreateEntity(#PB_Any, MeshID(suelo_mesh), MaterialID(suelo_mate))
ProcedureReturn suelo
EndProcedure

;------- SPRITE KEYBOARD
Structure   sprKeyboard_stru
  x.w
  y.w
  w.w
  h.w
  xc.d
  yc.d
  txt.s
  key.a
  caps.b
  lett.s
  show.b
  spr.i
  sprMouse.i
EndStructure
Global kb.sprKeyboard_stru
Procedure   spriteKeyboardDisplay()
  If kb\show
    DisplayTransparentSprite(kb\spr,kb\x,kb\y)
    DisplayTransparentSprite(kb\sprMouse,MouseX(),MouseY())
  EndIf
EndProcedure
Procedure   spriteKeyboardDraw()
  Protected.l back=       $ff888888
  Protected.l screen=     $ff000000
  Protected.l screenInk=  $ff00ff00
  Protected.l ink=        $ff000000
  Protected.l br,sh
  Protected.w tx,ty
  Protected.a m
  Protected.s t
  Protected   n,p
  StartDrawing(SpriteOutput(kb\spr))
    DrawingMode(#PB_2DDrawing_AlphaBlend);|#PB_2DDrawing_Transparent)
    DrawingFont(FontID(fontMed))
    RoundBox(0,0,OutputWidth(),OutputHeight(),5,5,back)
    x=0:y=0:m=1
    For n=2 To 5
      For p=0 To 9
        t= Mid(kb\lett,m+kb\caps,1)
        tx= (kb\xc-TextWidth(t))/2: ty= ((kb\yc-4)-TextHeight(t))/2
        If kb\key=m
          br= $77000000
          sh= $77ffffff
        Else
          br= $77ffffff
          sh= $77000000
        EndIf
          Box(x+p*kb\xc,y+n*kb\yc,kb\xc-4,kb\yc-4,br)
          Box(4+x+p*kb\xc,4+y+n*kb\yc,kb\xc-4,kb\yc-4,sh)
          Box(4+x+p*kb\xc,4+y+n*kb\yc,kb\xc-8,kb\yc-8,back)
          DrawText(x+tx+p*kb\xc,y+ty+n*kb\yc,t,ink,$00000000)
        m+1
      Next p
    Next n
    Box(4,4,kb\w-8,-8+kb\yc*2,$77000000)
    Box(8,8,kb\w-12,-12+kb\yc*2,$77ffffff)
    Box(8,8,kb\w-16,-16+kb\yc*2,screen) 
    ClipOutput(8,8,kb\w-16,-16+kb\yc*2) 
      DrawingFont(FontID(fontBig))
      DrawText(10,10,kb\txt,screenInk,$00000000)
    UnclipOutput()
  StopDrawing()
EndProcedure
Procedure   spriteKeyboard(x,y,w,h,txt.s="Keyboard")
  Protected.l back=   $ff888888
  Protected.l ink=    $ff000000
  Protected   i
  kb\xc=        w/10
  kb\yc=        h/6
  kb\x=         x
  kb\y=         y
  kb\w=         w
  kb\h=         h
  kb\txt=       txt    
  kb\lett=      "1234567890"+
                "qwertyuiop"+
                "asdfghjklñ"+
                "zxcvbnm ◄▲"+
                "?@!$%&/.-_"+
                "QWERTYUIOP"+
                "ASDFGHJKLÑ"+
                "ZXCVBNM ◄▼"
  kb\spr=       CreateSprite(#PB_Any,w,h,#PB_Sprite_AlphaBlending)
  kb\sprMouse=  CreateSprite(#PB_Any,32,32,#PB_Sprite_AlphaBlending)
  i=            CreateImage(#PB_Any,32,32,32,#PB_Image_Transparent)
  StartVectorDrawing(ImageVectorOutput(i))
    VectorSourceColor($cc55ff88)
    AddPathSegments("M 0 0 L 31 15 L 31 31 L 15 31 C")
    FillPath()
    VectorSourceColor($ff000000)
    AddPathSegments("M 0 0 L 31 15 L 31 31 L 15 31 L 0 0 C")
    StrokePath(2)
  StopVectorDrawing()
  StartDrawing(SpriteOutput(kb\sprMouse)) 
    DrawingMode(#PB_2DDrawing_AllChannels)
    Box(0,0,OutputWidth(),OutputHeight(),RGBA(0,0,0,0))
    DrawAlphaImage(ImageID(i),0,0)
  StopDrawing()
  FreeImage(i)
  spriteKeyboardDraw()
EndProcedure
Procedure   spriteKeyboardEvento()
  Protected   x=MouseX(), y=MouseY(), px,py
  Static leftButton, rightButton,timer
  ;show/hide
  If MouseButton(#PB_MouseButton_Right)
    If rightButton=#False
      If kb\show
        kb\show= #False
      Else
        kb\show= #True
      EndIf
      rightButton=#True
    EndIf
  Else
    If rightButton=#True
      rightButton=#False
    EndIf
  EndIf
  ;keyboard control
  If kb\show
    If MouseButton(#PB_MouseButton_Left)
      If leftButton=#False
        If x>kb\x And x<kb\x+kb\w
          If y>kb\y And y<kb\y+kb\h
            px= Round((MouseX()-kb\x)/kb\xc,#PB_Round_Up)
            py= Round((MouseY()-((kb\y+(kb\yc*3))))/kb\yc,#PB_Round_Up)
            kb\key=  px + (py * 10)
            If kb\key= 40
              If kb\caps: kb\caps= 0: Else: kb\caps= 40: EndIf
            ElseIf kb\key= 39
              If Len(kb\txt)=1
                kb\txt= ""
              ElseIf Len(kb\txt)>1
                kb\txt= Left(kb\txt,Len(kb\txt)-1)
              EndIf
            Else
              kb\txt+ Mid(kb\lett,kb\key+kb\caps,1)
            EndIf
            spriteKeyboardDraw()
          EndIf
        EndIf
        leftButton= #True
      EndIf
    Else ;UP
      If leftButton=#True
        kb\key= 0
        spriteKeyboardDraw()
        leftButton=#False
      EndIf
    EndIf
    ;keyboard phisyc
    If KeyboardReleased(#PB_Key_Back)
      If Len(kb\txt)=1
        kb\txt= ""
      ElseIf Len(kb\txt)>1
        kb\txt= Left(kb\txt,Len(kb\txt)-1)
      EndIf
      spriteKeyboardDraw()
    EndIf
    tec.s= KeyboardInkey()
    If tec
      For p=1 To 80
        If tec=Mid(kb\lett,p,1)
          kb\txt+ tec;Mid(kb\lett,kb\key+kb\caps,1)
          If p>40:kb\caps=40:Else:kb\caps=0:EndIf
          kb\key=p-kb\caps
          timer= ElapsedMilliseconds()+250
          spriteKeyboardDraw()
          Break
        EndIf
      Next p
    Else
      If timer
        If ElapsedMilliseconds()>timer
          kb\key=0: timer= 0
          spriteKeyboardDraw()
        EndIf
      EndIf
    EndIf
  Else
    control3D()
  EndIf
EndProcedure


iniDX("spriteKeyboardInput")

spriteKeyboard((ScreenWidth()-400)/2,(ScreenHeight()-200)/2,400,200)
kb\show= #True

Repeat
  Repeat : event= WindowEvent(): Until event= 0
  
  ExamineKeyboard()
  ExamineMouse()
  If KeyboardPushed(#PB_Key_Escape)
    sal=1
  EndIf
  
  spriteKeyboardEvento()
  
  renderTime = RenderWorld()
  
  spriteKeyboardDisplay()
  
  FlipBuffers()
  Delay(1)
Until sal=1

Posted: **Mon Apr 14, 2025 9:44 am**

Yes, he wanted some kind of login form, that is similar to this. Thanks for sharing.

Just a side note again for the different PB versions. Sprite drawing had been changed in 6.21 beta4 ( maybe a couple versions earlier, I did not check)
Earlier a newly created transparent sprite started being fully transparent, now it starts fully opaque. I first draw a full box to set the alpha channel transparent, if I want a mouse sprite with transparency for example. (and that way it's compatible with older versions)

This change is not really a bug, but the matter of choice. Though unfortunate for compability. Check your code (mouse sprite) with the current versions.

Posted: **Mon Apr 14, 2025 2:08 pm**

Hey miso, here work good with PB6.20 no black sprite. Thanks for comments.
In 6.21 mouse pointer is a black sprite?

Posted: **Mon Apr 14, 2025 2:13 pm**

In 6.21 mouse pointer is a black sprite?

It's black at the parts, where it should be transparent. It's not hard to fix though.

Posted: **Mon Apr 14, 2025 2:19 pm**

And then heres my addition to the snippets:
Prerendering sprite fonts for fast display, for 2d and 3d screens.
Used characters can be selected, works with non standard and with variable width letters.
It sacrifices a little memory for the fast access of the arrays.
It uses mid, it can be replaced if someone does not like it.

Code: Select all

;Prerendering specific characters to sprites for fast display
;using variable-width fonts, works with 2d/3d screens
;To ensure font/characters exists, you might want to use fonts added with registerfontfile

EnableExplicit
#FONTNAME = "Arial"
#FONTSIZE = 24

#BASIC_NUMERICS="0123456789"
#BASIC_SYMBOLS="!@#$%^&*()-_=+[{]};:',<.>/?"+Chr(34)
#BASIC_CHARACTERS="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz "
#EXTRA_HUN = "ÁÉÓÖŐŰÚÜÍáéóíöőúüű"
#EXTRA_GER = "Ääß"
#EXTRA_CYRILLIC ="ФИСВУАПРШОЛДЬТЩЗЙКЫЕГМЦЧНЯфисвуапршолдьтщзйкыегмцчнябБжЖхХъЪэЭюЮĆĘęąŁćłĄŚśźżŻŹŃńĂăȘȚșțČĎĚŇŘŠŤŮŽčďěňřšťůžЄєŒœіІїЇøØĞŞİğşı"
#EXTRA_GREEK="ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩαβγδεζηθικλμνξοπρστυφχψωΆΈΉΊΌΎΏ"
#EXTRA_EXTRA = "ÀÂÃÅÆÇÈÊËÌÎÏÐÑÒÔÕÙÛÝÞŸàâãåæçèêëìîïðñòóôõùûýþÿάέήίόύώςΐϊĹĽŔĺľŕ∞ЁёĐđ"
#EXTRA_SYMBOLS = "\`|~¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿"
#JP_HIRAGANA = "ぁあぃいぅうぇえぉおかがきぎくぐけげこごさざしじすずせぜそぞただちぢっつづてでがとどなにぬねのはばぱひびぴふぶぷへべぺほぼぽまみむめもゃやゅゆょよらりるれろゎわゐゑをん"
#JP_KATAKANA = "ァアィイゥウェエォオカガキギクグケゲコゴサザシジスズセゼソゾタダチヂッツヅテデトドナニヌネノハバパヒビピフブプヘベペホボポマミムメモャヤュユョヨラリルレロヮワヰヱヲンヴヵヶ"
#JP_SYMBOLS = "゛゜ゝゞ"
#JP_KANJI_TEST = "中主乂九了争亊事二于云互五井亘亙些亜亞亟亠亡亢交亥亦亨享京亭亮亰亳亶人什仁仂仄仆仇今介仍从仏仔仕他仗付大学小少尓尖尚屯山"

Structure myfontstructure
  spr.i
  width.i
  height.i
EndStructure

Global Dim font.myfontstructure(0)
Global font.i = LoadFont(#PB_Any,#FONTNAME,#FONTSIZE)
Global usedcharacters.s = #BASIC_NUMERICS+#BASIC_SYMBOLS+#BASIC_CHARACTERS+#EXTRA_HUN+#EXTRA_GER+#EXTRA_GREEK+#JP_HIRAGANA+#JP_KATAKANA+#JP_KANJI_TEST+#JP_SYMBOLS+#EXTRA_CYRILLIC


;********************************************************************
;This procedure prerenders the lettes you want to use in your program
;********************************************************************
Procedure prerenderfont(characters.s)
  Protected characters_length.i = Len(characters.s)
  Protected i.i, itemp.i, icount.i
  StartDrawing(ScreenOutput())
  DrawingFont(FontID(font.i))
    For i = 1 To characters_length
      itemp = Asc(Mid(characters.s,i,1))
      If itemp>icount 
        icount = itemp 
        ReDim font(icount)
      EndIf
    font(itemp)\SPR = -1
    font(itemp)\width = TextWidth(Mid(characters.s,i,1))
    font(itemp)\height = TextHeight(Mid(characters.s,i,1))
  Next i
  StopDrawing()

  Define sprcount.i, missedsprs.i
  For i = 1 To characters_length
    With font(Asc(Mid(characters.s,i)))
      If \SPR = -1
        \SPR = CreateSprite(#PB_Any,\width,\height,#PB_Sprite_AlphaBlending)
        If IsSprite(\SPR)
          StartDrawing(SpriteOutput(\SPR))
          DrawingMode(#PB_2DDrawing_AllChannels)
          DrawingFont(FontID(font.i))
          Box(0,0,OutputWidth(),OutputHeight(),RGBA(0,0,0,0))
          DrawText(0,0,Mid(characters.s,i,1),RGBA(255,255,255,255),RGBA(0,0,0,0))
          StopDrawing()
          sprcount+1
        Else
        EndIf
      EndIf
    EndWith
  Next i
EndProcedure

;*****************************************
;This procedure can display text on screen
;*****************************************
Procedure put(x.i,y.i,t$)
  Protected i.i,pos.i,cc.i
  Protected length.i = Len(t$)
  For i = 1 To length.i
    cc=Asc(Mid(t$,i,1))
    If cc>ArraySize(font()) : cc=0 :EndIf
    If cc = 9
      pos = pos+#FONTSIZE
    ElseIf IsSprite(font(cc)\SPR)
       DisplayTransparentSprite(font(cc)\SPR,x+pos,y,255,RGBA(255,255,255,255))
      pos+font(cc)\width
    EndIf
  Next i
EndProcedure

ExamineDesktops()
InitSprite()
InitKeyboard()
InitMouse()
OpenWindow(0,0,0,DesktopUnscaledX(DesktopWidth(0)),DesktopUnscaledY(DesktopHeight(0)),"Variable-width sprite font prerender", #PB_Window_BorderLess)
OpenWindowedScreen(WindowID(0),0,0,WindowWidth(0),WindowHeight(0),1,0,0,#PB_Screen_SmartSynchronization)
SetFrameRate(60)
prerenderfont(usedcharacters.s)

Repeat
  Repeat: Until Not WindowEvent()
  ExamineKeyboard() : ExamineMouse() : ClearScreen(RGB(50,20,20))
  
  put(10,10+(5+#FONTSIZE)*1,#BASIC_NUMERICS)
  put(10,10+(5+#FONTSIZE)*2,#BASIC_CHARACTERS)
  put(10,10+(5+#FONTSIZE)*3,#BASIC_SYMBOLS)
  put(10,10+(5+#FONTSIZE)*4,#EXTRA_CYRILLIC)
  put(10,10+(5+#FONTSIZE)*5,#EXTRA_GER)
  put(10,10+(5+#FONTSIZE)*6,#EXTRA_GREEK)
  put(10,10+(5+#FONTSIZE)*7,#EXTRA_HUN)
  put(10,10+(5+#FONTSIZE)*8,#JP_HIRAGANA)
  put(10,10+(5+#FONTSIZE)*9,#JP_KATAKANA)
  put(10,10+(5+#FONTSIZE)*10,#JP_KANJI_TEST)
  put(10,10+(5+#FONTSIZE)*11,#JP_SYMBOLS)
  
  put(10,10+(5+#FONTSIZE)*13,"Hello World!!!")
  
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

Posted: **Mon Apr 14, 2025 2:21 pm**

Animated icons 2D/3D
This is a serie of animated icons, can use with canvas, image, sprite or textures. Include Watch, vertical scroll numbers (like tacometer), batery charge and signal coverture.
Remenber change in startdrawing your output, like spriteoutput, imageoutput...
Soon more!

Code: Select all

Global dir.Vector3
Global  fontLit= LoadFont(#PB_Any,"Arial",9)
Global  fontMed= LoadFont(#PB_Any,"Arial",16)
Global  fontBig= LoadFont(#PB_Any,"Arial",24)

winMain= OpenWindow(#PB_Any,0,0,960,540,"Animated Icons",#PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered)
CanvasGadget(0,0,0,960,540)

  Procedure   newXZ(x.f,z.f, d.f, a.f)
    a-90
    dir\x= x + (Cos(Radian(a)) * d)
    dir\z= z + (Sin(Radian(a)) * d)
  EndProcedure
  Procedure   PrimerDecimal(n.f)
    Protected.f n2,pe,pd
    n2 = n * 10
    pe = Int(n2)
    pd = pe - (Int(n) * 10)
    ProcedureReturn Int(pd)
  EndProcedure

  Procedure   ico_bateria(x.d,y.d,w.d,h.d, carga.b= 4, ink.l=$ffffffff)
    If carga>4:carga=4:EndIf
    Protected.d x2,w2=w
    w-4
    Protected.d l= (w-4) / 4
    Protected.d a= (h-4) / 4
    Protected.b p
    FrontColor(ink)
    DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Outlined)
    Box(x,y,w,h)
    DrawingMode(#PB_2DDrawing_AlphaBlend)
    Box(x+w,y+(h*0.25), 4,h*0.5)
    x+3: y+2: h-4
    If carga>0
      For p= 0 To carga-1
        x2= x+(l*p)-1
        Box(x2,y, l-1, h)
      Next p
    EndIf
  EndProcedure
  Procedure   ico_cobertura(x.d,y.d,w.d,h.d, cob.b= 4, ink.l=$ffffffff, barras.b= 4)
    Protected.d x2,y2
    Protected.d l= w / barras
    Protected.d a= h / barras
    Protected.b p
    If cob>barras:cob=barras:EndIf
    FrontColor(ink)
    DrawingMode(#PB_2DDrawing_AlphaBlend)
    y2= y+(a*(barras-1))
    If cob>0
      For p= 0 To cob-1
        x2= x+(l*p)
        Box(x2,y2, l-2, a*(p+1) )
        y2-a
      Next p
    EndIf
  EndProcedure
  Procedure   ico_reloj(x.d,y.d,w.d,h.d, time, ink.l=$ffffffff)
    Protected   hora= Hour(time)
    Protected   minu= Minute(time)
    Protected   segu= Second(time)
    Protected.d w2= w/2
    Protected.d h2= h/2
    Protected.d x2,y2
    Protected.d xc= x+w2
    Protected.d yc= y+h2
    FrontColor(ink)
    DrawingMode(#PB_2DDrawing_AlphaBlend)
    Circle(xc,yc,h2,$44000000)
    DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Outlined)
    Circle(xc,yc,h2)
    ;seg
    newXZ(xc,yc,h2*0.9,segu*6)
    LineXY(xc,yc,dir\x,dir\z)
    ;min
    newXZ(xc,yc,h2*0.7,minu*6)
    LineXY(xc,yc,dir\x,dir\z)
    ;hor
    newXZ(xc,yc,h2*0.5,hora*30)
    LineXY(xc,yc,dir\x,dir\z)
  EndProcedure
  Procedure   ico_contador(x.d,y.d,w.d,h.d, num.d, digits.b=5, ink.l=$ffffffff)
    Protected.s nc, ch,c2, t= RSet(Str(Round(num,#PB_Round_Down)),digits,"0")
    Protected.b d2= digits-1, cy
    Protected.d bo= w/digits, pas= h/10
    Protected.b pd= PrimerDecimal(num)
    ClipOutput(x,y,w,h)
    FrontColor(ink)
    cy= (h-TextHeight("Kg"))/2
    DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Transparent)
    Box(x,y,w,h,$44000000)
    For p= 0 To d2
      ch= Mid(t,p+1,1)
      n=  Val(ch)+1:If n>9:n=0:EndIf : c2= Str(n)
      x2= (bo*p) + x + (bo-TextWidth(ch)) / 2
      y2= y+cy
      nc= Mid(t,p+2,1)
      If p= d2 Or (nc= "9" And Mid(t,d2+1,1)="9")
        If pd=0:pd=10:EndIf
        DrawText(x2,y2-(pas * pd),ch)
        DrawText(x2,y2+h-(pas * pd),c2)
      Else
        DrawText(x2,y2,ch)
      EndIf
      Line(x+bo*p,y,1,h,$44ffffff)
      Line((x+bo*p)-1,y,1,h,$88000000)
    Next p
    DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Gradient)
    BackColor($88ffffff)
    FrontColor($00000000)
    LinearGradient(x,y,x,y+h)
    Box(x,y,w,h)
    BackColor($00000000)
    FrontColor($44000000)
    Box(x,y,w,h)
    UnclipOutput()
  EndProcedure
  
  Procedure   dibuja()
    Protected c= Second(Date()) % 5
    Static.d n= 1995
    StartDrawing(CanvasOutput(0))
      DrawingMode(#PB_2DDrawing_AlphaBlend)
      Box(0,0,OutputWidth(),OutputHeight(),$ff887766)
      ico_cobertura(10,10,40,20,c)
      ico_bateria(60,10,40,20,c)
      ico_reloj(10,40,90,90,Date())
      
    DrawingFont(FontID(fontMed))
      ico_contador(10,150,90,30,n)
    DrawingFont(FontID(fontBig))
      ico_contador(110,150,200,60,n)
      n+ 0.1
      Delay(100)
    StopDrawing()
  EndProcedure
  
Repeat
event= WindowEvent()

  Select event
    Case #PB_Event_Gadget
      EventGadget=  EventGadget()
      EventType=    EventType()
      Select EventGadget
        Case 0
          
      EndSelect
      
    Case #PB_Event_CloseWindow
      Break 
  EndSelect
  dibuja()
  Delay(1)
ForEver

Posted: **Mon Apr 14, 2025 2:28 pm**

Very nice prerendered font, thank you very much miso!!
Black sprite was fixed (i hope)

Posted: **Mon Apr 14, 2025 2:35 pm**

Black sprite was fixed (i hope)

Yes, it looks good now in 6.21 beta too.

Posted: **Sat May 03, 2025 5:18 pm**

3d orthographic camera for 2d. Contains some issues for rotation already reported. Beta8 PB6.21 and debugger off needed.
20250506 - updated with shooting + added static object walls
20250506 - second update

Code: Select all

;VER PB 6.21 Beta 8 OpenGL, probably cross platform, tested on WIN7 64bit
;-CONSTANTS
#MAINDESKTOP_H        = 0
#MAINWINDOW_H         = 0
#MAINWINDOW_NAME      = "Test Application"
#MAINWINDOW_FLAGS     = #PB_Window_BorderLess
#MAINWINDOW_RESIZE    = 1
#MAINWINDOW_TOPOFFSET = 0
#SCREEN_FLAGS         = #PB_Screen_WaitSynchronization
#SCREEN_FRAMERATE     = 60
#AUTOSTRETCH_ON       = 1
#AUTOSTRETCH_OFF      = 0
#MAINLOOP_DELAY       = 1
#COMPILER_MINIMUM_VERSION = 621

;-RENDER CONSTANTS
#MAINCAMERA = 1
#FINAL_RENDERCAMERA = 31
#MASK_GENERALPICKMASK=1<<1
#MASK_NOPICKMASK=1<<31
#MASK_MAINCAMERA=1<<1
#MASK_FINAL_RENDERCAMERA=1<<31
#RENDEROBJECT=1 ;RenderTexture, Material, Mesh, Entity shared
#RENDERWIDTH  = 1366/2 ;Aspect ratio does not matter here, it can stretch pixels though
#RENDERHEIGHT = 768  ;but not the render


Structure coord3d
  x.f
  y.f
  z.f
EndStructure


Structure coord2d
  x.f
  y.f
EndStructure

Global midscreen.coord2d


DeclareModule petskii
  Declare init()
  Declare textout(x,y,text.s,color.i,intensity.i=255)
  Declare textoutlined(x,y,text.s,color.i,outlinecolor.i,intensity.i=255)
  Declare destroy()
EndDeclareModule

Module petskii
;-HIDDEN VARIABLES/CONSTANTS  
  #USED_CHARACTERS="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!@#$%^&*()-_=+[{]};:',<.>/?"+Chr(34)
  Global Dim petskiifont(370):Global Dim fontimport.i(370)
;-SUB PROCEDURES
  Procedure sub_loadfont()
    Protected x.i,i.i,j.i,sprline.a
    For i = 1 To Len(#USED_CHARACTERS):fontImport(Asc(Mid(#USED_CHARACTERS,i,1)))=1 : Next i 
    Restore petskii_font
      For x= 1 To 370
        If fontimport(x)=1
          petskiifont(x)=CreateSprite(-1,8,12,#PB_Sprite_AlphaBlending)
          StartDrawing(SpriteOutput(petskiifont(x)))
          DrawingMode(#PB_2DDrawing_AllChannels)
          For j=0 To 11  
            Read.a sprline 
            For i=0 To 7
              If sprline&%1 :Plot(i,j,RGBA(255,255,255,255)): Else : Plot(i,j,RGBA(0,0,0,0)) : EndIf
              sprline>>1 
            Next i
          Next j
          StopDrawing()
          ZoomSprite(petskiifont(x),16,24)
        EndIf
      Next x
  EndProcedure
  
  ;-PUBLIC PROCEDURES  
  Procedure init()
    sub_loadfont()
  EndProcedure
  
  Procedure textout(x,y,text.s,color.i,intensity.i=255) : Protected.i textlength,i,character
    textlength.i = Len(text.s)
    For i = 1 To textlength.i
      character.i = Asc(Mid(text.s,i,1))
      If character.i>ArraySize(petskiifont()) : ProcedureReturn #Null : EndIf
      If IsSprite(petskiifont(character))
        DisplayTransparentSprite(petskiifont(character),(x+((i-1) * 16)),(y),intensity,color.i)
      EndIf
    Next i
  EndProcedure
  
  Procedure textoutlined(x,y,text.s,color.i,outlinecolor.i,intensity=255)
    textout(x-2,y,text.s,outlinecolor,intensity)
    textout(x+2,y,text.s,outlinecolor,intensity)
    textout(x,y-2,text.s,outlinecolor,intensity)
    textout(x,y+2,text.s,outlinecolor,intensity)
    textout(x,y,text.s,color,intensity)
  EndProcedure
  
  Procedure destroy()
    Protected i.i
    For i = 1 To Len(#USED_CHARACTERS)
      If IsSprite(petskiifont(i)) : FreeSprite(petskiifont(i)) : EndIf
    Next i
  EndProcedure
  
  ;-MODULE DATA
  DataSection
  petskii_font:
  Data.a $00,$00,$38,$38,$38,$38,$38,$38,$00,$38,$00,$00,$00,$00,$EE,$EE,$EE,$00,$00,$00,$00,$00,$00,$00,$00,$00,$EE,$EE,$EE,$FF,$EE,$FF,$EE,$EE,$00,$00,$00,$00,$38,$38,$FC,$0E,$7C,$E0,$7E,$38,$00,$00
  Data.a $00,$00,$CE,$CE,$EE,$70,$38,$1C,$EE,$E6,$00,$00,$00,$00,$7C,$7C,$EE,$7C,$3C,$EE,$EE,$FC,$00,$00,$00,$00,$E0,$E0,$70,$38,$00,$00,$00,$00,$00,$00,$00,$00,$70,$70,$38,$1C,$1C,$1C,$38,$70,$00,$00
  Data.a $00,$00,$1C,$1C,$38,$70,$70,$70,$38,$1C,$00,$00,$00,$00,$00,$00,$EE,$7C,$FF,$7C,$EE,$00,$00,$00,$00,$00,$00,$00,$38,$38,$FE,$38,$38,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$38,$38,$1C,$00
  Data.a $00,$00,$00,$00,$00,$00,$FE,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$38,$38,$00,$00,$00,$00,$00,$00,$C0,$E0,$70,$38,$1C,$0E,$00,$00,$00,$00,$7C,$7C,$EE,$FE,$FE,$EE,$EE,$7C,$00,$00
  Data.a $00,$00,$38,$38,$38,$3C,$38,$38,$38,$FE,$00,$00,$00,$00,$7C,$7C,$EE,$E0,$70,$1C,$0E,$FE,$00,$00,$00,$00,$7C,$7C,$EE,$E0,$78,$E0,$EE,$7C,$00,$00,$00,$00,$E0,$E0,$F0,$F8,$EE,$FE,$E0,$E0,$00,$00
  Data.a $00,$00,$FE,$FE,$0E,$7E,$E0,$E0,$EE,$7C,$00,$00,$00,$00,$7C,$7C,$EE,$0E,$7E,$EE,$EE,$7C,$00,$00,$00,$00,$FE,$FE,$EE,$70,$38,$38,$38,$38,$00,$00,$00,$00,$7C,$7C,$EE,$EE,$7C,$EE,$EE,$7C,$00,$00
  Data.a $00,$00,$7C,$7C,$EE,$EE,$FC,$E0,$EE,$7C,$00,$00,$00,$00,$38,$38,$38,$00,$00,$00,$38,$38,$00,$00,$00,$00,$38,$38,$38,$00,$00,$00,$38,$38,$1C,$00,$00,$00,$F0,$F0,$38,$1C,$0E,$1C,$38,$F0,$00,$00
  Data.a $00,$00,$00,$00,$00,$FE,$00,$FE,$00,$00,$00,$00,$00,$00,$1E,$1E,$38,$70,$E0,$70,$38,$1E,$00,$00,$00,$00,$7C,$7C,$EE,$E0,$70,$38,$00,$38,$00,$00,$00,$00,$7C,$7C,$EE,$FE,$FE,$0E,$CE,$7C,$00,$00
  Data.a $00,$00,$38,$38,$7C,$EE,$FE,$EE,$EE,$EE,$00,$00,$00,$00,$7E,$7E,$EE,$EE,$7E,$EE,$EE,$7E,$00,$00,$00,$00,$7C,$7C,$EE,$0E,$0E,$0E,$EE,$7C,$00,$00,$00,$00,$3E,$3E,$7E,$EE,$EE,$EE,$7E,$3E,$00,$00
  Data.a $00,$00,$FE,$FE,$0E,$0E,$3E,$0E,$0E,$FE,$00,$00,$00,$00,$FE,$FE,$0E,$0E,$3E,$0E,$0E,$0E,$00,$00,$00,$00,$7C,$7C,$EE,$0E,$FE,$EE,$EE,$7C,$00,$00,$00,$00,$EE,$EE,$EE,$EE,$FE,$EE,$EE,$EE,$00,$00
  Data.a $00,$00,$7C,$7C,$38,$38,$38,$38,$38,$7C,$00,$00,$00,$00,$F8,$F8,$70,$70,$70,$70,$7E,$3C,$00,$00,$00,$00,$EE,$EE,$7E,$3E,$1E,$3E,$7E,$EE,$00,$00,$00,$00,$0E,$0E,$0E,$0E,$0E,$0E,$0E,$FE,$00,$00
  Data.a $00,$00,$CE,$CE,$FE,$FE,$FE,$CE,$CE,$CE,$00,$00,$00,$00,$EE,$EE,$FE,$FE,$FE,$FE,$EE,$EE,$00,$00,$00,$00,$7C,$7C,$EE,$EE,$EE,$EE,$EE,$7C,$00,$00,$00,$00,$7E,$7E,$EE,$EE,$7E,$0E,$0E,$0E,$00,$00
  Data.a $00,$00,$7C,$7C,$EE,$EE,$EE,$EE,$7C,$F0,$00,$00,$00,$00,$7E,$7E,$EE,$EE,$7E,$3E,$7E,$EE,$00,$00,$00,$00,$7C,$7C,$EE,$0E,$7C,$E0,$EE,$7C,$00,$00,$00,$00,$FE,$FE,$38,$38,$38,$38,$38,$38,$00,$00
  Data.a $00,$00,$EE,$EE,$EE,$EE,$EE,$EE,$EE,$7C,$00,$00,$00,$00,$EE,$EE,$EE,$EE,$EE,$EE,$7C,$38,$00,$00,$00,$00,$CE,$CE,$CE,$CE,$FE,$FE,$FE,$CE,$00,$00,$00,$00,$EE,$EE,$EE,$7C,$38,$7C,$EE,$EE,$00,$00
  Data.a $00,$00,$EE,$EE,$EE,$EE,$7C,$38,$38,$38,$00,$00,$00,$00,$FE,$FE,$E0,$70,$38,$1C,$0E,$FE,$00,$00,$00,$00,$7C,$7C,$1C,$1C,$1C,$1C,$1C,$7C,$00,$00,$00,$00,$7C,$7C,$70,$70,$70,$70,$70,$7C,$00,$00
  Data.a $00,$00,$38,$38,$7C,$FE,$38,$38,$38,$38,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$FF,$00,$00,$00,$00,$00,$00,$00,$7C,$E0,$FC,$EE,$FC,$00,$00,$00,$00,$00,$00,$0E,$0E,$7E,$EE,$EE,$7E,$00,$00
  Data.a $00,$00,$00,$00,$00,$7C,$0E,$0E,$0E,$7C,$00,$00,$00,$00,$00,$00,$E0,$E0,$FC,$EE,$EE,$FC,$00,$00,$00,$00,$00,$00,$00,$7C,$EE,$FE,$0E,$7C,$00,$00,$00,$00,$00,$00,$F0,$38,$FC,$38,$38,$38,$00,$00
  Data.a $00,$00,$00,$00,$00,$FC,$EE,$EE,$FC,$E0,$7E,$00,$00,$00,$0E,$0E,$0E,$7E,$EE,$EE,$EE,$EE,$00,$00,$00,$00,$38,$38,$00,$3C,$38,$38,$38,$7C,$00,$00,$00,$00,$00,$00,$70,$00,$70,$70,$70,$70,$3C,$00
  Data.a $00,$00,$0E,$0E,$0E,$0E,$7E,$3E,$7E,$EE,$00,$00,$00,$00,$3C,$3C,$38,$38,$38,$38,$38,$7C,$00,$00,$00,$00,$00,$00,$00,$EE,$FE,$FE,$FE,$CE,$00,$00,$00,$00,$00,$00,$00,$7E,$EE,$EE,$EE,$EE,$00,$00
  Data.a $00,$00,$00,$00,$00,$7C,$EE,$EE,$EE,$7C,$00,$00,$00,$00,$00,$00,$00,$7E,$EE,$EE,$7E,$0E,$0E,$00,$00,$00,$00,$00,$00,$FC,$EE,$EE,$FC,$E0,$E0,$00,$00,$00,$00,$00,$00,$7E,$EE,$0E,$0E,$0E,$00,$00
  Data.a $00,$00,$00,$00,$00,$FC,$0E,$7C,$E0,$7E,$00,$00,$00,$00,$00,$00,$38,$FE,$38,$38,$38,$F0,$00,$00,$00,$00,$00,$00,$00,$EE,$EE,$EE,$EE,$FC,$00,$00,$00,$00,$00,$00,$00,$EE,$EE,$EE,$7C,$38,$00,$00
  Data.a $00,$00,$00,$00,$00,$CE,$FE,$FE,$FC,$FC,$00,$00,$00,$00,$00,$00,$00,$EE,$7C,$38,$7C,$EE,$00,$00,$00,$00,$00,$00,$00,$EE,$EE,$EE,$FC,$70,$3E,$00,$00,$00,$00,$00,$00,$FE,$70,$38,$1C,$FE,$00,$00
  Data.a $00,$00,$F0,$F0,$38,$38,$1E,$38,$38,$F0,$00,$00,$00,$00,$1E,$1E,$38,$38,$F0,$38,$38,$1E,$00,$00
  EndDataSection
EndModule

Procedure.f LERP(a.f,b.f,t.f)
  ProcedureReturn(((1.0-t.f)*a) + (b*t))
EndProcedure
  
Procedure.f INVLERP(a.f,b.f,v.f)
  If a=b : ProcedureReturn(1) : EndIf
  ProcedureReturn((v-a) / (b-a))
EndProcedure
  
Procedure.f remap(iMin.f,iMAX.f, oMin.f, oMax.f, v.f)  
  Protected t.f
  t.f = INVLERP(iMin,iMAX,v)
  ProcedureReturn(LERP(oMin,oMax,t))
EndProcedure

#SOUND_SAMPLE_RATE=8000
  #SOUND_BITS_PER_SAMPLE=8
  #SOUND_CHANNELS=1
  #SOUND_BYTERATE = (#SOUND_SAMPLE_RATE*#SOUND_CHANNELS*#SOUND_BITS_PER_SAMPLE)/8
  
  Procedure snd(frequency.f,length.i, attack,decay,sustain,release ,wf,af,tac,ns.i,vs.f,vd.f)
  Protected chunk.l = Int((length/1000)*#SOUND_BYTERATE)
  Protected samples.i = Int((length/1000)*#SOUND_SAMPLE_RATE)
  Protected headersize.i = 40 
  Protected result_id.i,i.i,mydata.a,output.i, position.i
  Protected fl_variable
  Protected *buffer
  Protected mastervolume.i=127
  *buffer=AllocateMemory(headersize+4+(chunk))
  Restore waveheader3
  For i= 1 To 40
    Read.a mydata.a
    PokeA(*buffer+position,mydata.a) : position=position+1
  Next i
  PokeL(*buffer+position,chunk) : position = position+4
  
  Protected singlewavetime.f = 1.0/frequency
  Protected awt.f =1.0/af
  Protected samplesperwave.i = Round(#SOUND_SAMPLE_RATE*singlewavetime,#PB_Round_Up)
  Protected aspw =  Round(#SOUND_SAMPLE_RATE*awt,#PB_Round_Up)
  Protected wavecount.i=Round(length/singlewavetime,#PB_Round_Up)
  Protected duty.f=0.5
  Protected vbtp.f= 0
  
  Protected steps.f,vbtstp.f
  steps = #SOUND_SAMPLE_RATE/frequency
  vbtstp = #SOUND_SAMPLE_RATE*vs/frequency
  
  Protected capc.i=0
  Protected attacksamples.i,decaysamples.i,sustainsamples.i,releasesamples.i,currentvolume.i
  attacksamples =remap(1,attack+decay+sustain+release,1,samples,attack)
  decaysamples =remap(1,attack+decay+sustain+release,1,samples,attack+decay)
  sustainsamples=remap(1,attack+decay+sustain+release,1,samples,attack+decay+sustain)
  releasesamples=samples
  
  Protected counter.i, targetperiod.i,apn = 0
    counter.i = 0
  targetperiod = samplesperwave
  For i= 1 To samples
    counter.i=counter+1
    capc.i=capc.i+1
    If capc=tac
      capc=0
      apn = 1-apn
    EndIf
    If counter>=targetperiod
      counter=0 : duty=duty*-1
      If vd>0 And vs>0
        vbtp=vbtp+vs
        vbtp=((2*3.14)/steps)*i*vs
        If apn
          targetperiod =Round(aspw*((1.0+(Sin(vbtp)*vd))),#PB_Round_Nearest)
          Else
          targetperiod =Round(samplesperwave*((1.0+(Sin(vbtp)*vd))),#PB_Round_Nearest)
          EndIf
      Else
        If apn
          targetperiod = aspw
        Else
          targetperiod = samplesperwave
        EndIf
      EndIf
    EndIf
    If i<attacksamples 
      currentvolume =lerp(0,mastervolume,i/attacksamples)
    ElseIf i<decaysamples
      currentvolume =lerp(mastervolume,mastervolume*0.8,i/decaysamples)
    ElseIf i<sustainsamples
      currentvolume =mastervolume*0.8
    Else
      currentvolume =lerp(0,mastervolume,i/releasesamples)
    EndIf
      output= 127+((currentvolume*duty)+(Random(ns)))
    PokeA(*buffer+position,output):position = position+1
  Next i
  result_id = CatchSound(#PB_Any,*buffer,headersize+4+(chunk))
  FreeMemory(*buffer)
  ProcedureReturn(result_id)
  EndProcedure    




;-AUXILIARY PROCEDURES
Procedure sub_checks()
  If Int(#PB_Compiler_Version) < #COMPILER_MINIMUM_VERSION
    Debug "Please compile with the currently newest beta 8 6.21."
    Debug "This snippet uses features presented with that update."
    End
  EndIf
  
  If #PB_Compiler_Debugger
    Debug "Please compile debugger off"
    End
  EndIf

EndProcedure

;-PROCEDURES
Procedure app_start()
  UsePNGImageDecoder()
  sub_checks()
  ExamineDesktops()
  InitEngine3D()
  InitSprite()
  InitKeyboard()
  InitMouse()
  InitSound()
  OpenWindow(#MAINWINDOW_H,0,0,DesktopUnscaledX(DesktopWidth(#MAINDESKTOP_H)),DesktopUnscaledY(DesktopHeight(#MAINDESKTOP_H)),#MAINWINDOW_NAME,#MAINWINDOW_FLAGS)
  OpenWindowedScreen(WindowID(#MAINWINDOW_H),0,0,WindowWidth(#MAINWINDOW_H),WindowHeight(#MAINWINDOW_H),#AUTOSTRETCH_ON,0,0,#SCREEN_FLAGS)
  SetFrameRate(#SCREEN_FRAMERATE)
  midscreen\x=ScreenWidth()/2
  midscreen\y=ScreenHeight()/2
  petskii::init()
  ;internal shaders
  Add3DArchive(#PB_Compiler_Home+"examples/3d/Data/Main",#PB_3DArchive_FileSystem)
  Parse3DScripts()
  
  ;shadows and bullet phy
  EnableWorldPhysics(#True)
  WorldShadows( #PB_Shadow_Additive,50000,RGBA(1,1,100,21))
  SetWorldAttribute(#PB_Shadow_FarDistance,50000)
  
  ;cameras
  CreateCamera(#MAINCAMERA,0,0,100,100,#MASK_MAINCAMERA)
  CameraRenderMode(#MAINCAMERA,#PB_Camera_Textured)
  CameraProjectionMode(#MAINCAMERA,#PB_Camera_Orthographic)
  MoveCamera(#MAINCAMERA,0,-0,-8,#PB_Absolute)
  
  CreateCamera(#FINAL_RENDERCAMERA,0,0,100,100,#MASK_FINAL_RENDERCAMERA)
  CameraRenderMode(#FINAL_RENDERCAMERA,#PB_Camera_Textured)
  CameraProjectionMode(#FINAL_RENDERCAMERA,#PB_Camera_Perspective)
  CameraRange(#FINAL_RENDERCAMERA,0,100000)
  MoveCamera(#FINAL_RENDERCAMERA,0,-0,200,#PB_Absolute|#PB_World)
  
  ;renderquad
  CreateRenderTexture(#RENDEROBJECT,CameraID(#MAINCAMERA),#RENDERWIDTH,#RENDERHEIGHT,#PB_Texture_ManualUpdate)
  CreateMaterial(#RENDEROBJECT,TextureID(#RENDEROBJECT))
  DisableMaterialLighting(#RENDEROBJECT,#True)
  MaterialFilteringMode(#RENDEROBJECT,#PB_Material_None)
  
  
  CreatePlane(#RENDEROBJECT,(ScreenWidth()/ScreenHeight())*1000,1000,1,1,1,1)
  CreateEntity(#RENDEROBJECT,MeshID(#RENDEROBJECT),MaterialID(#RENDEROBJECT),0,0,-1000,#MASK_NOPICKMASK,#MASK_FINAL_RENDERCAMERA)
  RotateEntity(#RENDEROBJECT,90,180,0,#PB_Absolute)
  SetRenderQueue(EntityID(#RENDEROBJECT),0,0)
  
  Global holeimg = CatchImage(#PB_Any,?hole)
  ResizeImage(holeimg,8,8)
  
  Global splatimg = CatchImage(#PB_Any,?bsplat)
  ResizeImage(splatimg,8,8)
  
  
  Global layertexture = CreateTexture(#PB_Any,1024,1024)
  StartDrawing(TextureOutput(layertexture))
  DrawingMode(#PB_2DDrawing_AllChannels)
  Box(0,0,OutputWidth(),OutputHeight(),RGBA(0,0,0,0))
  StopDrawing()
  
  ;creating the ground
  CreateTexture(2,16,16)
  CatchImage(2,?ground)
  StartDrawing(TextureOutput(2))
  DrawingMode(#PB_2DDrawing_AllChannels)
  Box(0,0,OutputWidth(),OutputHeight())
  DrawAlphaImage(ImageID(2),0,0)
  StopDrawing()
  CreateMaterial(2,TextureID(2))
  AddMaterialLayer(2,TextureID(layertexture),#PB_Material_AlphaBlend)
  ScaleMaterial(2,0.01,0.01,0)
  MaterialFilteringMode(2,#PB_Material_None)
  CreatePlane(2,10240,10240,1,1,1,1)
  CreateEntity(2,MeshID(2),MaterialID(2),0,0,0,#MASK_NOPICKMASK,#MASK_MAINCAMERA)
  CreateEntityBody(2,#PB_Entity_StaticBody,1,1,1)
  
  
  MoveCamera(#MAINCAMERA,0,3000,0,#PB_World|#PB_Absolute)
  CameraLookAt(#MAINCAMERA,EntityX(2),EntityY(2),EntityZ(2))
  
  ;creating the turretbase
  #HULL=3
  a=3
  CreateTexture(a,16,16)
  CatchImage(a,?base)
  StartDrawing(TextureOutput(a))
  DrawingMode(#PB_2DDrawing_AllChannels)
  Box(0,0,OutputWidth(),OutputHeight())
  DrawAlphaImage(ImageID(a),0,0)
  StopDrawing()
  CreateMaterial(a,TextureID(a))
  SetMaterialAttribute(a,#PB_Material_DepthWrite,#True)
  SetMaterialAttribute(a,#PB_Material_AlphaReject,#True)
  SetMaterialAttribute(a,#PB_Material_TAM,#PB_Material_ClampTAM)
  MaterialFilteringMode(a,#PB_Material_None)
  CreateCube(a,100)
  CreateEntity(a,MeshID(a),MaterialID(a),0,40,0,#MASK_NOPICKMASK,#MASK_MAINCAMERA)
  ScaleEntity(a,1/2,1/1.5,1/1.5)
  CreateEntityBody(a,#PB_Entity_BoxBody,1,1,1)
  EntityAngularFactor(a,0,1,0)
  EntityLinearFactor(a,1,0,1)
  ;SetEntityAttribute(a,#PB_Entity_MaxVelocity,200)
  ;creating the actual turret
  #TURR=4
  a=4
  CreateTexture(a,16,16)
  CatchImage(a,?turret)
  StartDrawing(TextureOutput(a))
  DrawingMode(#PB_2DDrawing_AllChannels)
  Box(0,0,OutputWidth(),OutputHeight())
  DrawAlphaImage(ImageID(a),0,0)
  StopDrawing()
  CreateMaterial(a,TextureID(a))
  SetMaterialAttribute(a,#PB_Material_DepthWrite,#True)
  SetMaterialAttribute(a,#PB_Material_AlphaReject,#True)
  SetMaterialAttribute(a,#PB_Material_TAM,#PB_Material_ClampTAM)
  MaterialFilteringMode(a,#PB_Material_None)
  CreateCube(a,80)
  CreateEntity(a,MeshID(a),MaterialID(a),0,61,0,#MASK_NOPICKMASK,#MASK_MAINCAMERA)
  EntityRenderMode(a,#PB_Shadow_None)
  
  ;creating a box
  a=5
  CreateTexture(a,16,16)
  CatchImage(a,?box)
  StartDrawing(TextureOutput(a))
  DrawingMode(#PB_2DDrawing_AllChannels)
  Box(0,0,OutputWidth(),OutputHeight())
  DrawAlphaImage(ImageID(a),0,0)
  StopDrawing()
  CreateMaterial(a,TextureID(a))
  SetMaterialAttribute(a,#PB_Material_DepthWrite,#True)
  SetMaterialAttribute(a,#PB_Material_AlphaReject,#True)
  SetMaterialAttribute(a,#PB_Material_TAM,#PB_Material_ClampTAM)
  MaterialFilteringMode(a,#PB_Material_None)
  CreateCube(a,40)
  For x = 100 To 150
    CreateEntity(x,MeshID(a),MaterialID(a),-1000+Random(2000),20,-1000+Random(2000),#MASK_GENERALPICKMASK,#MASK_MAINCAMERA)
    CreateEntityBody(x,#PB_Entity_BoxBody,1,1,1) : RotateEntity(x,0,Random(360),0)
    EntityAngularFactor(x,0,1,0)
    EntityLinearFactor(x,1,0,1)
    SetEntityAttribute(x,#PB_Entity_AngularSleeping,1)
    SetEntityAttribute(x,#PB_Entity_LinearSleeping,1)
  Next x
  
 ;creating a walls
  a=7
  CreateTexture(a,16,16)
  CatchImage(a,?wall)
  StartDrawing(TextureOutput(a))
  DrawingMode(#PB_2DDrawing_AllChannels)
  Box(0,0,OutputWidth(),OutputHeight())
  DrawAlphaImage(ImageID(a),0,0)
  StopDrawing()
  CreateMaterial(a,TextureID(a))
  SetMaterialAttribute(a,#PB_Material_DepthWrite,#True)
  SetMaterialAttribute(a,#PB_Material_AlphaReject,#True)
  SetMaterialAttribute(a,#PB_Material_TAM,#PB_Material_ClampTAM)
  MaterialFilteringMode(a,#PB_Material_None)
  CreateCube(a,220)
  For x = 200 To 225
    Repeat  
      tx = Random(4000)-2000
    Until Abs(tx)>250
    Repeat  
      tz = Random(4000)-2000
    Until Abs(tz)>250
    
    CreateEntity(x,MeshID(a),MaterialID(a),tx,98+x*0.1,tz,#MASK_GENERALPICKMASK,#MASK_MAINCAMERA): RotateEntity(x,0,Random(360),0)
    CreateEntityBody(x,#PB_Entity_StaticBody,1,1,1) 
  Next x

  
  
  ;creating the aim
  #AIM=6
  a=6
  
  CreateTexture(a,16,16)
  CatchImage(a,?cursor)
  StartDrawing(TextureOutput(a))
  DrawingMode(#PB_2DDrawing_AllChannels)
  Box(0,0,OutputWidth(),OutputHeight())
  DrawAlphaImage(ImageID(a),0,0)
  StopDrawing()
  CreateMaterial(a,TextureID(a))
  SetMaterialAttribute(a,#PB_Material_DepthWrite,#True)
  SetMaterialAttribute(a,#PB_Material_AlphaReject,#True)
  SetMaterialAttribute(a,#PB_Material_TAM,#PB_Material_ClampTAM)
  MaterialFilteringMode(a,#PB_Material_None)
  CreateCube(a,50)
  CreateEntity(a,MeshID(a),MaterialID(a),0,300,0,#MASK_NOPICKMASK,#MASK_MAINCAMERA)
  EntityRenderMode(a,#PB_Shadow_None)
  Global aim.coord3d
  aim\x=0 : aim\y=250 : aim\z=0
  
  
  CreateLight(0,RGB(255,255,255),0,0,0,#PB_Light_Directional)
  LightDirection(0,1,-2,1)
  WorldDebug(#PB_World_DebugNone)
  
  ;Global shot.i=snd(440,100,30,30,100,30,0,440,0,1,0.016,0.8)
  Global shot.i=snd(840,100,30,30,100,30,0,440,0,1,0.016,0.8)
  SoundVolume(shot,25)
  Global empty.i=snd(200,200,30,30,1,300,0,0,0,0,0.0,0)
  SoundVolume(empty,25)
  
  Global engine.i=snd(60,20,30,30,1,30,60,60,0,0,0.0,0)
  SoundVolume(engine,10)
  SetSoundFrequency(engine,5000)
  PlaySound(engine,#PB_Sound_Loop)
  
  
EndProcedure
#MAXDIST = 1000
Global ammo.i = 999

Procedure app_update()
  Protected w_event.i
  Repeat 
    w_event = WindowEvent() : If w_event = #PB_Event_CloseWindow : End : EndIf
  Until Not w_event
  ExamineKeyboard():ExamineMouse()
  aim\x = aim\x+(MouseDeltaX()*0.5)
  aim\z = aim\z+(MouseDeltaY()*0.5)
  If aim\x>EntityX(#turr)+#MAXDIST : aim\x = EntityX(#turr)+#MAXDIST : EndIf
  If aim\x<EntityX(#turr)-#MAXDIST : aim\x = EntityX(#turr)-#MAXDIST : EndIf
  
  If aim\z>EntityZ(#turr)+#MAXDIST : aim\z =EntityZ(#turr)+ #MAXDIST : EndIf
  If aim\z<EntityZ(#turr)-#MAXDIST : aim\z = EntityZ(#turr)-#MAXDIST : EndIf
  
  MoveCamera(#MAINCAMERA,CameraX(#MAINCAMERA)*0.9+EntityX(#aim)*0.1,CameraY(#MAINCAMERA),CameraZ(#MAINCAMERA)*0.9+EntityZ(#aim)*0.1,#PB_World|#PB_Absolute)
  MoveEntity(#AIM,aim\x,aim\y,aim\z,#PB_Absolute|#PB_World)
  EntityLookAt(#TURR,EntityX(#AIM),EntityY(#TURR),EntityZ(#AIM))
  
  If KeyboardPushed(#PB_Key_A) Or KeyboardPushed(#PB_Key_D)
    If KeyboardPushed(#PB_Key_A)
      RotateEntity(#HULL,0,1,0,#PB_World|#PB_Relative)
    EndIf
    
    If KeyboardPushed(#PB_Key_D)
      RotateEntity(#HULL,0,-1,0,#PB_World|#PB_Relative)
    EndIf
  Else
    RotateEntity(#HULL,0,0,0,#PB_World|#PB_Relative)
  EndIf
  
  
  If KeyboardPushed(#PB_Key_W) Or KeyboardPushed(#PB_Key_S) 
    SetSoundFrequency(engine,6000)
    If KeyboardPushed(#PB_Key_W)
      MoveEntity(#HULL,0,0,-100,#PB_Local|#PB_Relative)
    EndIf
    
    If KeyboardPushed(#PB_Key_S)
      MoveEntity(#HULL,0,0,100,#PB_Local|#PB_Relative)
    EndIf
  Else
    MoveEntity(#HULL,0,0,0,#PB_Local|#PB_Relative)
    SetSoundFrequency(engine,5000)
  EndIf

  MoveEntity(#TURR,EntityX(#HULL),61,EntityZ(#HULL),#PB_World|#PB_Absolute)
  
  If MouseButton(#PB_MouseButton_Right)
    If ammo<1 And SoundStatus(empty)<>#PB_Sound_Playing
      PlaySound(empty) 
    EndIf
    
    If SoundStatus(shot)<>#PB_Sound_Playing And ammo>0: PlaySound(shot) 
      aoff=Random(10)-5
      boff=Random(10)-5
      
      ammo-1
      dist.f = Sqr((EntityX(#aim)+aoff-EntityX(#hull))  *   (EntityX(#aim)+aoff-EntityX(#hull))+((EntityZ(#aim)+boff-EntityZ(#hull))*(EntityZ(#aim)+boff-EntityZ(#hull))) )
      rayhitbool = RayCast(EntityX(#hull),10,EntityZ(#hull),EntityDirectionX(#turr)*dist ,10,EntityDirectionZ(#turr)*dist,#MASK_GENERALPICKMASK)
      If rayhitbool 
        If IsEntity(rayhitbool)
          distent.f = Sqr((EntityX(#hull)-EntityX(rayhitbool))  *   (EntityX(#hull)-EntityX(rayhitbool))+((EntityZ(#hull)-EntityZ(rayhitbool))*(EntityZ(#hull)-EntityZ(rayhitbool))) )
          If rayhitbool<200:distb=25 :Else:distb=100:EndIf
          If Abs(distent)<Abs(dist)+distb
            CreateLine3D(1000,EntityX(#hull),EntityY(#hull),EntityZ(#hull),RGB(255,0,0),PickX(),PickY(),PickZ(),RGB(255,255,127))
            ApplyEntityImpulse(rayhitbool,NormalX()*-50,0,NormalZ()*-50)
            hg2=1
          Else
            CreateLine3D(1000,EntityX(#hull),EntityY(#hull),EntityZ(#hull),RGB(255,0,0),EntityX(#AIM)+aoff,EntityY(#AIM),EntityZ(#AIM)+boff,RGB(255,255,127))
            hg=1
          EndIf
        Else
          CreateLine3D(1000,EntityX(#hull),EntityY(#hull),EntityZ(#hull),RGB(255,0,0),EntityX(#AIM)+aoff,EntityY(#AIM),EntityZ(#AIM)+boff,RGB(255,255,127))
          hg=1
        EndIf
      Else
        CreateLine3D(1000,EntityX(#hull),EntityY(#hull),EntityZ(#hull),RGB(255,0,0),EntityX(#AIM)+aoff,EntityY(#AIM),EntityZ(#AIM)+boff,RGB(255,255,127))
        hg=1
      EndIf
    EndIf
  EndIf
  
  If hg >0
    StartDrawing(TextureOutput(layertexture))
    DrawingMode(#PB_2DDrawing_AlphaBlend)
     DrawAlphaImage(ImageID(holeimg),512-((EntityX(#aim)+aoff)/10),512-(EntityZ(#aim)+boff)/10,128)
    StopDrawing()
    hg=0
  EndIf
    
  If hg2 >0
    StartDrawing(TextureOutput(layertexture))
    DrawingMode(#PB_2DDrawing_AlphaBlend)
    DrawAlphaImage(ImageID(holeimg),512-(PickX()/10),512-PickZ()/10,128)
    StopDrawing()
    hg2=0
  EndIf

  
  
  UpdateRenderTexture(#RENDEROBJECT)
  If IsMesh(1000)
    FreeMesh(1000)
  EndIf
  
  If IsMesh(1001)
    FreeMesh(1001)
  EndIf
  RenderWorld(60)
  petskii::textoutlined(0,30,"AMMO : "+Str(ammo),RGB(150,80,20),RGB(0,0,0))
  petskii::textoutlined(0,0,"Controls: W A S D + Mouse + Right Mouse Button",RGB(150,80,20),RGB(0,0,0))
  FlipBuffers()
  Delay(#MAINLOOP_DELAY)
EndProcedure

;-MAIN PROGRAM PROCEDURE
Procedure main()
  app_start()
  Repeat
    app_update()
  Until KeyboardPushed(#PB_Key_Escape)
EndProcedure

;-MAIN PROGRAM
main()

DataSection
ground:
Data.a $89,$50,$4E,$47,$0D,$0A,$1A,$0A,$00,$00,$00,$0D,$49,$48,$44,$52,$00,$00,$00,$10,$00,$00,$00,$10,$08,$06,$00,$00,$00,$1F,$F3,$FF,$61,$00,$00,$00,$5F,$49,$44,$41,$54
Data.a $38,$CB,$63,$30,$36,$36,$FE,$5F,$5E,$5E,$FE,$1F,$44,$13,$C2,$D8,$D4,$31,$10,$A3,$11,$DD,$10,$64,$83,$48,$36,$80,$24,$17,$C0,$6C,$C3,$E7,$45,$06,$52,$9C,$8E,$D7,$00
Data.a $62,$02,$92,$60,$20,$22,$3B,$97,$90,$D3,$E9,$13,$88,$24,$19,$40,$6C,$62,$22,$2A,$0C,$08,$19,$86,$AC,$86,$22,$2F,$80,$0C,$61,$20,$27,$EE,$31,$BC,$80,$4D,$21,$BA,$18
Data.a $2E,$AF,$D1,$3E,$2F,$10,$32,$00,$00,$6E,$B8,$AD,$94,$79,$97,$60,$22,$00,$00,$00,$00,$49,$45,$4E,$44,$AE,$42,$60,$82

base:
Data.a $89,$50,$4E,$47,$0D,$0A,$1A,$0A,$00,$00,$00,$0D,$49,$48,$44,$52,$00,$00,$00,$10,$00,$00,$00,$10,$08,$06,$00,$00,$00,$1F,$F3,$FF,$61,$00,$00,$00,$83,$49,$44,$41,$54
Data.a $38,$CB,$A5,$53,$01,$0A,$00,$21,$08,$CB,$37,$F5,$38,$1F,$E7,$E3,$EE,$2A,$58,$88,$67,$4D,$B8,$60,$60,$A1,$6B,$DA,$6A,$6D,$2C,$11,$79,$26,$7C,$7C,$42,$CC,$5F,$9B,$DE
Data.a $FB,$C2,$8C,$CD,$6C,$41,$55,$D3,$18,$F9,$9B,$04,$81,$27,$98,$05,$19,$3C,$01,$F2,$3F,$0A,$4E,$C5,$00,$55,$E0,$93,$41,$9C,$11,$1C,$15,$A0,$05,$9C,$79,$92,$D2,$0C,$E2
Data.a $ED,$51,$45,$69,$06,$B1,$D8,$93,$94,$14,$54,$08,$E8,$2B,$B0,$16,$A8,$0F,$D8,$10,$4B,$3E,$B8,$3D,$63,$C9,$07,$37,$23,$51,$1F,$30,$2B,$5F,$67,$90,$91,$C4,$CF,$B4,$15
Data.a $FC,$FD,$CE,$2F,$54,$7B,$A2,$54,$36,$A1,$B0,$04,$00,$00,$00,$00,$49,$45,$4E,$44,$AE,$42,$60,$82
turret:
Data.a $89,$50,$4E,$47,$0D,$0A,$1A,$0A,$00,$00,$00,$0D,$49,$48,$44,$52,$00,$00,$00,$10,$00,$00,$00,$10,$08,$06,$00,$00,$00,$1F,$F3,$FF,$61,$00,$00,$00,$26,$49,$44,$41,$54
Data.a $38,$CB,$63,$60,$C0,$03,$18,$19,$19,$FF,$83,$30,$03,$B9,$60,$D4,$80,$81,$36,$00,$A6,$99,$6C,$43,$28,$36,$80,$2A,$61,$30,$0A,$E8,$04,$00,$60,$10,$18,$31,$8C,$83,$71
Data.a $F8,$00,$00,$00,$00,$49,$45,$4E,$44,$AE,$42,$60,$82
       
wall:
Data.a $89,$50,$4E,$47,$0D,$0A,$1A,$0A,$00,$00,$00,$0D,$49,$48,$44,$52,$00,$00,$00,$10,$00,$00,$00,$10,$08,$06,$00,$00,$00,$1F,$F3,$FF,$61,$00,$00,$00,$29,$49,$44,$41,$54
Data.a $38,$CB,$63,$60,$64,$64,$FC,$4F,$09,$66,$00,$11,$E5,$E5,$E5,$64,$61,$14,$03,$8C,$8D,$8D,$49,$C2,$A3,$06,$8C,$1A,$30,$5C,$0D,$A0,$28,$33,$51,$82,$01,$88,$AC,$9E,$58
Data.a $A1,$88,$0D,$92,$00,$00,$00,$00,$49,$45,$4E,$44,$AE,$42,$60,$82

box:
Data.a $89,$50,$4E,$47,$0D,$0A,$1A,$0A,$00,$00,$00,$0D,$49,$48,$44,$52,$00,$00,$00,$10,$00,$00,$00,$10,$08,$06,$00,$00,$00,$1F,$F3,$FF,$61,$00,$00,$00,$5B,$49,$44,$41,$54
Data.a $38,$CB,$63,$60,$64,$64,$FC,$4F,$09,$66,$00,$11,$69,$2E,$0C,$64,$61,$14,$03,$60,$F4,$DD,$8E,$50,$BC,$18,$59,$2D,$86,$0B,$08,$19,$82,$AC,$06,$C3,$00,$74,$05,$F8,$34
Data.a $23,$F3,$19,$D0,$35,$60,$33,$04,$9F,$18,$03,$36,$1B,$B1,$39,$15,$97,$1A,$06,$42,$4E,$26,$24,$4F,$1B,$03,$28,$F2,$02,$45,$81,$48,$51,$34,$52,$9C,$90,$A8,$92,$94,$C9
Data.a $CE,$4C,$94,$60,$00,$10,$96,$C7,$44,$CF,$DD,$33,$A8,$00,$00,$00,$00,$49,$45,$4E,$44,$AE,$42,$60,$82

cursor:
Data.a $89,$50,$4E,$47,$0D,$0A,$1A,$0A,$00,$00,$00,$0D,$49,$48,$44,$52,$00,$00,$00,$10,$00,$00,$00,$10,$08,$06,$00,$00,$00,$1F,$F3,$FF,$61,$00,$00,$00,$43,$49,$44,$41,$54
Data.a $38,$CB,$63,$60,$00,$02,$46,$46,$C6,$FF,$30,$CC,$40,$00,$60,$A8,$25,$56,$23,$2E,$83,$18,$C8,$D1,$8C,$6C,$08,$E5,$06,$0C,$5E,$80,$EC,$3C,$B2,$9D,$FA,$EE,$5D,$F9,$7F
Data.a $10,$26,$DB,$15,$14,$19,$40,$15,$2F,$D0,$3F,$B4,$07,$26,$25,$52,$9C,$99,$28,$CD,$CE,$00,$56,$9C,$2D,$89,$00,$54,$A3,$09,$00,$00,$00,$00,$49,$45,$4E,$44,$AE,$42,$60
Data.a $82


hole:
Data.a $89,$50,$4E,$47,$0D,$0A,$1A,$0A,$00,$00,$00,$0D,$49,$48,$44,$52,$00,$00,$00,$10,$00,$00,$00,$10,$08,$06,$00,$00,$00,$1F,$F3,$FF,$61,$00,$00,$00,$4D,$49,$44,$41,$54
Data.a $38,$CB,$63,$60,$64,$64,$FC,$CF,$80,$03,$E0,$93,$43,$51,$04,$C2,$E5,$E5,$E5,$FF,$8D,$8D,$8D,$FF,$C3,$F8,$44,$69,$86,$01,$90,$66,$98,$26,$90,$21,$20,$0C,$12,$23,$DA
Data.a $00,$74,$9B,$49,$76,$05,$36,$E7,$83,$F8,$44,$BB,$00,$5D,$23,$49,$5E,$C0,$17,$88,$24,$05,$24,$C9,$D1,$37,$0A,$46,$01,$12,$00,$00,$76,$BB,$38,$E9,$51,$9C,$DC,$DF,$00
Data.a $00,$00,$00,$49,$45,$4E,$44,$AE,$42,$60,$82

bsplat:
Data.a $89,$50,$4E,$47,$0D,$0A,$1A,$0A,$00,$00,$00,$0D,$49,$48,$44,$52,$00,$00,$00,$10,$00,$00,$00,$10,$08,$06,$00,$00,$00,$1F,$F3,$FF,$61,$00,$00,$00,$38,$49,$44,$41,$54
Data.a $38,$CB,$63,$E8,$60,$60,$F8,$0F,$C2,$0C,$40,$80,$CC,$26,$09,$20,$6B,$82,$19,$42,$92,$61,$E8,$9A,$48,$76,$05,$36,$03,$28,$32,$84,$E4,$F0,$A0,$8A,$ED,$F8,$5C,$43,$94
Data.a $ED,$D8,$F8,$64,$45,$E9,$28,$18,$91,$00,$00,$E3,$7D,$3B,$92,$FC,$FB,$7A,$4E,$00,$00,$00,$00,$49,$45,$4E,$44,$AE,$42,$60,$82
EndDataSection

;// 1 channel mono sample rate 8000 8 bit/sample (unsigned byte)
DataSection
Waveheader3:
Data.a $52,$49,$46,$46,$24,$08,$00,$00,$57,$41,$56,$45,$66,$6D,$74,$20,$10,$00,$00,$00,$01,$00,$01,$00,$40,$1F,$00,$00,$40,$1F,$01,$00,$04,$00,$08,$00,$64,$61,$74,$61
EndDataSection

Posted: **Mon May 05, 2025 6:36 pm**

Work perfect here, very fun demo, its the war!!

Is this part of a game you're making?
If you need a 3D model I can do it for you, I'm better modeler than a programmer haha

1000 thanks miso for your shared code!

Posted: **Mon May 05, 2025 6:49 pm**

Thanks. No, It's not part of any game, it's just playing with ortho. Messy, but short enough for someone to get ideas of his/her own. I will post a couple other later on. (Also I'm not against working together with you at all, but I'm just afraid I'm too lazy in the end

)

Posted: **Fri May 09, 2025 8:37 pm**

Orthographic cameras round 2. Sideview + stacking items. This one is particularly designed to 16:9 monitors (via placement of the side borders),
though it should run everywhere. Experimenting with no sync + async rendering.

PB 6.21 beta9 + nodebugger please.

Code: Select all

EnableExplicit

Procedure.i Timer(deltatime.i)
  Static.i LastTick
  If ElapsedMilliseconds()-LastTick>deltatime.i
    LastTick=ElapsedMilliseconds()
    ProcedureReturn(#True)
  EndIf
  ProcedureReturn(#False)
EndProcedure  

DeclareModule petskii
  Declare init()
  Declare textout(x,y,text.s,color.i,intensity.i=255)
  Declare textoutlined(x,y,text.s,color.i,outlinecolor.i,intensity.i=255)
  Declare destroy()
EndDeclareModule

Module petskii
;-HIDDEN VARIABLES/CONSTANTS  
  #USED_CHARACTERS="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!@#$%^&*()-_=+[{]};:',<.>/?"+Chr(34)
  Global Dim petskiifont(370):Global Dim fontimport.i(370)
;-SUB PROCEDURES
  Procedure sub_loadfont()
    Protected x.i,i.i,j.i,sprline.a
    For i = 1 To Len(#USED_CHARACTERS):fontImport(Asc(Mid(#USED_CHARACTERS,i,1)))=1 : Next i 
    Restore petskii_font
      For x= 1 To 370
        If fontimport(x)=1
          petskiifont(x)=CreateSprite(-1,8,12,#PB_Sprite_AlphaBlending)
          StartDrawing(SpriteOutput(petskiifont(x)))
          DrawingMode(#PB_2DDrawing_AllChannels)
          For j=0 To 11  
            Read.a sprline 
            For i=0 To 7
              If sprline&%1 :Plot(i,j,RGBA(255,255,255,255)): Else : Plot(i,j,RGBA(0,0,0,0)) : EndIf
              sprline>>1 
            Next i
          Next j
          StopDrawing()
          ZoomSprite(petskiifont(x),16,24)
        EndIf
      Next x
  EndProcedure
  
  ;-PUBLIC PROCEDURES  
  Procedure init()
    sub_loadfont()
  EndProcedure
  
  Procedure textout(x,y,text.s,color.i,intensity.i=255) : Protected.i textlength,i,character
    textlength.i = Len(text.s)
    For i = 1 To textlength.i
      character.i = Asc(Mid(text.s,i,1))
      If character.i>ArraySize(petskiifont()) : ProcedureReturn #Null : EndIf
      If IsSprite(petskiifont(character))
        DisplayTransparentSprite(petskiifont(character),(x+((i-1) * 16)),(y),intensity,color.i)
      EndIf
    Next i
  EndProcedure
  
  Procedure textoutlined(x,y,text.s,color.i,outlinecolor.i,intensity=255)
    textout(x-2,y,text.s,outlinecolor,intensity)
    textout(x+2,y,text.s,outlinecolor,intensity)
    textout(x,y-2,text.s,outlinecolor,intensity)
    textout(x,y+2,text.s,outlinecolor,intensity)
    textout(x,y,text.s,color,intensity)
  EndProcedure
  
  Procedure destroy()
    Protected i.i
    For i = 1 To Len(#USED_CHARACTERS)
      If IsSprite(petskiifont(i)) : FreeSprite(petskiifont(i)) : EndIf
    Next i
  EndProcedure
  
  ;-MODULE DATA
  DataSection
  petskii_font:
  Data.a $00,$00,$38,$38,$38,$38,$38,$38,$00,$38,$00,$00,$00,$00,$EE,$EE,$EE,$00,$00,$00,$00,$00,$00,$00,$00,$00,$EE,$EE,$EE,$FF,$EE,$FF,$EE,$EE,$00,$00,$00,$00,$38,$38,$FC,$0E,$7C,$E0,$7E,$38,$00,$00
  Data.a $00,$00,$CE,$CE,$EE,$70,$38,$1C,$EE,$E6,$00,$00,$00,$00,$7C,$7C,$EE,$7C,$3C,$EE,$EE,$FC,$00,$00,$00,$00,$E0,$E0,$70,$38,$00,$00,$00,$00,$00,$00,$00,$00,$70,$70,$38,$1C,$1C,$1C,$38,$70,$00,$00
  Data.a $00,$00,$1C,$1C,$38,$70,$70,$70,$38,$1C,$00,$00,$00,$00,$00,$00,$EE,$7C,$FF,$7C,$EE,$00,$00,$00,$00,$00,$00,$00,$38,$38,$FE,$38,$38,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$38,$38,$1C,$00
  Data.a $00,$00,$00,$00,$00,$00,$FE,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$38,$38,$00,$00,$00,$00,$00,$00,$C0,$E0,$70,$38,$1C,$0E,$00,$00,$00,$00,$7C,$7C,$EE,$FE,$FE,$EE,$EE,$7C,$00,$00
  Data.a $00,$00,$38,$38,$38,$3C,$38,$38,$38,$FE,$00,$00,$00,$00,$7C,$7C,$EE,$E0,$70,$1C,$0E,$FE,$00,$00,$00,$00,$7C,$7C,$EE,$E0,$78,$E0,$EE,$7C,$00,$00,$00,$00,$E0,$E0,$F0,$F8,$EE,$FE,$E0,$E0,$00,$00
  Data.a $00,$00,$FE,$FE,$0E,$7E,$E0,$E0,$EE,$7C,$00,$00,$00,$00,$7C,$7C,$EE,$0E,$7E,$EE,$EE,$7C,$00,$00,$00,$00,$FE,$FE,$EE,$70,$38,$38,$38,$38,$00,$00,$00,$00,$7C,$7C,$EE,$EE,$7C,$EE,$EE,$7C,$00,$00
  Data.a $00,$00,$7C,$7C,$EE,$EE,$FC,$E0,$EE,$7C,$00,$00,$00,$00,$38,$38,$38,$00,$00,$00,$38,$38,$00,$00,$00,$00,$38,$38,$38,$00,$00,$00,$38,$38,$1C,$00,$00,$00,$F0,$F0,$38,$1C,$0E,$1C,$38,$F0,$00,$00
  Data.a $00,$00,$00,$00,$00,$FE,$00,$FE,$00,$00,$00,$00,$00,$00,$1E,$1E,$38,$70,$E0,$70,$38,$1E,$00,$00,$00,$00,$7C,$7C,$EE,$E0,$70,$38,$00,$38,$00,$00,$00,$00,$7C,$7C,$EE,$FE,$FE,$0E,$CE,$7C,$00,$00
  Data.a $00,$00,$38,$38,$7C,$EE,$FE,$EE,$EE,$EE,$00,$00,$00,$00,$7E,$7E,$EE,$EE,$7E,$EE,$EE,$7E,$00,$00,$00,$00,$7C,$7C,$EE,$0E,$0E,$0E,$EE,$7C,$00,$00,$00,$00,$3E,$3E,$7E,$EE,$EE,$EE,$7E,$3E,$00,$00
  Data.a $00,$00,$FE,$FE,$0E,$0E,$3E,$0E,$0E,$FE,$00,$00,$00,$00,$FE,$FE,$0E,$0E,$3E,$0E,$0E,$0E,$00,$00,$00,$00,$7C,$7C,$EE,$0E,$FE,$EE,$EE,$7C,$00,$00,$00,$00,$EE,$EE,$EE,$EE,$FE,$EE,$EE,$EE,$00,$00
  Data.a $00,$00,$7C,$7C,$38,$38,$38,$38,$38,$7C,$00,$00,$00,$00,$F8,$F8,$70,$70,$70,$70,$7E,$3C,$00,$00,$00,$00,$EE,$EE,$7E,$3E,$1E,$3E,$7E,$EE,$00,$00,$00,$00,$0E,$0E,$0E,$0E,$0E,$0E,$0E,$FE,$00,$00
  Data.a $00,$00,$CE,$CE,$FE,$FE,$FE,$CE,$CE,$CE,$00,$00,$00,$00,$EE,$EE,$FE,$FE,$FE,$FE,$EE,$EE,$00,$00,$00,$00,$7C,$7C,$EE,$EE,$EE,$EE,$EE,$7C,$00,$00,$00,$00,$7E,$7E,$EE,$EE,$7E,$0E,$0E,$0E,$00,$00
  Data.a $00,$00,$7C,$7C,$EE,$EE,$EE,$EE,$7C,$F0,$00,$00,$00,$00,$7E,$7E,$EE,$EE,$7E,$3E,$7E,$EE,$00,$00,$00,$00,$7C,$7C,$EE,$0E,$7C,$E0,$EE,$7C,$00,$00,$00,$00,$FE,$FE,$38,$38,$38,$38,$38,$38,$00,$00
  Data.a $00,$00,$EE,$EE,$EE,$EE,$EE,$EE,$EE,$7C,$00,$00,$00,$00,$EE,$EE,$EE,$EE,$EE,$EE,$7C,$38,$00,$00,$00,$00,$CE,$CE,$CE,$CE,$FE,$FE,$FE,$CE,$00,$00,$00,$00,$EE,$EE,$EE,$7C,$38,$7C,$EE,$EE,$00,$00
  Data.a $00,$00,$EE,$EE,$EE,$EE,$7C,$38,$38,$38,$00,$00,$00,$00,$FE,$FE,$E0,$70,$38,$1C,$0E,$FE,$00,$00,$00,$00,$7C,$7C,$1C,$1C,$1C,$1C,$1C,$7C,$00,$00,$00,$00,$7C,$7C,$70,$70,$70,$70,$70,$7C,$00,$00
  Data.a $00,$00,$38,$38,$7C,$FE,$38,$38,$38,$38,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$FF,$00,$00,$00,$00,$00,$00,$00,$7C,$E0,$FC,$EE,$FC,$00,$00,$00,$00,$00,$00,$0E,$0E,$7E,$EE,$EE,$7E,$00,$00
  Data.a $00,$00,$00,$00,$00,$7C,$0E,$0E,$0E,$7C,$00,$00,$00,$00,$00,$00,$E0,$E0,$FC,$EE,$EE,$FC,$00,$00,$00,$00,$00,$00,$00,$7C,$EE,$FE,$0E,$7C,$00,$00,$00,$00,$00,$00,$F0,$38,$FC,$38,$38,$38,$00,$00
  Data.a $00,$00,$00,$00,$00,$FC,$EE,$EE,$FC,$E0,$7E,$00,$00,$00,$0E,$0E,$0E,$7E,$EE,$EE,$EE,$EE,$00,$00,$00,$00,$38,$38,$00,$3C,$38,$38,$38,$7C,$00,$00,$00,$00,$00,$00,$70,$00,$70,$70,$70,$70,$3C,$00
  Data.a $00,$00,$0E,$0E,$0E,$0E,$7E,$3E,$7E,$EE,$00,$00,$00,$00,$3C,$3C,$38,$38,$38,$38,$38,$7C,$00,$00,$00,$00,$00,$00,$00,$EE,$FE,$FE,$FE,$CE,$00,$00,$00,$00,$00,$00,$00,$7E,$EE,$EE,$EE,$EE,$00,$00
  Data.a $00,$00,$00,$00,$00,$7C,$EE,$EE,$EE,$7C,$00,$00,$00,$00,$00,$00,$00,$7E,$EE,$EE,$7E,$0E,$0E,$00,$00,$00,$00,$00,$00,$FC,$EE,$EE,$FC,$E0,$E0,$00,$00,$00,$00,$00,$00,$7E,$EE,$0E,$0E,$0E,$00,$00
  Data.a $00,$00,$00,$00,$00,$FC,$0E,$7C,$E0,$7E,$00,$00,$00,$00,$00,$00,$38,$FE,$38,$38,$38,$F0,$00,$00,$00,$00,$00,$00,$00,$EE,$EE,$EE,$EE,$FC,$00,$00,$00,$00,$00,$00,$00,$EE,$EE,$EE,$7C,$38,$00,$00
  Data.a $00,$00,$00,$00,$00,$CE,$FE,$FE,$FC,$FC,$00,$00,$00,$00,$00,$00,$00,$EE,$7C,$38,$7C,$EE,$00,$00,$00,$00,$00,$00,$00,$EE,$EE,$EE,$FC,$70,$3E,$00,$00,$00,$00,$00,$00,$FE,$70,$38,$1C,$FE,$00,$00
  Data.a $00,$00,$F0,$F0,$38,$38,$1E,$38,$38,$F0,$00,$00,$00,$00,$1E,$1E,$38,$38,$F0,$38,$38,$1E,$00,$00
  EndDataSection
EndModule



DeclareModule line
  Global initialized.b =#False , sprite_ID.i = -1, circlesprite_ID.i = -1, circlesprite_o_ID.i = -1
  Declare init(resolution.i)
  Declare destroy()
  Declare draw(x1.i,y1.i,x2.i,y2.i,color.i=-16776961,width.i=10,intensity.i = 255)
  Declare drawwindow(x.i,y.i,width.i,height.i,color.i=-16776961,intensity.i = 255)
  Declare drawCircle(x.i,y.i,radius,color.i=-16776961,intensity.i = 255)
  Declare drawCircleoutline(x.i,y.i,radius,color.i=-16776961,intensity.i = 255)
EndDeclareModule

Module line
  Procedure init(resolution.i)
    line::sprite_ID = CreateSprite(#PB_Any,1,1,#PB_Sprite_AlphaBlending)
    If Not IsSprite(line::sprite_ID) : ProcedureReturn #False : EndIf
    StartDrawing(SpriteOutput(line::sprite_ID))
    DrawingMode(#PB_2DDrawing_AllChannels)
    Box(0,0,OutputWidth(),OutputHeight(),RGBA(255,255,255,255))
    StopDrawing()
    
    line::circlesprite_ID = CreateSprite(#PB_Any,resolution.i,resolution.i,#PB_Sprite_AlphaBlending)
    If Not IsSprite(circlesprite_ID) : ProcedureReturn #False : EndIf
    StartDrawing(SpriteOutput(line::circlesprite_ID))
    DrawingMode(#PB_2DDrawing_AllChannels)
    Box(0,0,OutputWidth(),OutputHeight(),RGBA(0,0,0,0))
    Circle(OutputWidth()/2,OutputHeight()/2,OutputWidth()/2,RGBA(255,255,255,255))
    StopDrawing()
    
    line::circlesprite_o_ID = CreateSprite(#PB_Any,resolution.i,resolution.i,#PB_Sprite_AlphaBlending)
    If Not IsSprite(circlesprite_o_ID) : ProcedureReturn #False : EndIf
    StartDrawing(SpriteOutput(line::circlesprite_o_ID))
    DrawingMode(#PB_2DDrawing_AllChannels)
    Box(0,0,OutputWidth(),OutputHeight(),RGBA(0,0,0,0))
    Circle(OutputWidth()/2,OutputHeight()/2,OutputWidth()/2,RGBA(255,255,255,255))
    Circle(OutputWidth()/2,OutputHeight()/2,OutputWidth()/2-15,RGBA(0,0,0,0))
    StopDrawing()
    line::initialized = #True : ProcedureReturn #True  
  EndProcedure

  Procedure destroy()
    If IsSprite(line::sprite_ID) : FreeSprite(line::sprite_ID) : EndIf 
    If IsSprite(line::circlesprite_ID) : FreeSprite(line::circlesprite_ID):EndIf
    If IsSprite(line::circlesprite_o_ID) : FreeSprite(line::circlesprite_o_ID):EndIf
    line::initialized = #False
  EndProcedure
  
  Procedure draw(x1.i,y1.i,x2.i,y2.i,color.i=-16776961,width.i=10,intensity.i = 255)
    ;MIJIKAI and STARGATE code
    Protected.f length, dx, dy
    length = Sqr((X1-X2)*(X1-X2) + (Y1-Y2)*(Y1-Y2))
    dy = (X2-X1)*Width/(2*length)
    dx = (Y1-Y2)*Width/(2*length)
    ZoomSprite(line::sprite_ID,length,length)
    TransformSprite(line::sprite_ID, X1-dx, Y1-dy, X2-dx, Y2-dy, X2+dx, Y2+dy, X1+dx, Y1+dy)
    DisplayTransparentSprite(line::sprite_ID,0,0,intensity,color)
  EndProcedure
  
  Procedure drawwindow(x.i,y.i,width.i,height.i,color.i=-16776961,intensity.i = 255)
    ZoomSprite(line::sprite_ID,width,heigth)
    TransformSprite(line::sprite_ID, x, y, x+width, Y, X+width, Y+height, X, Y+height)
    DisplayTransparentSprite(line::sprite_ID,0,0,intensity,color)
    line::draw(x,y,x+width,y,RGBA(255,255,255,255),1,255)
    line::draw(x,y+height,x+width,y+height,RGBA(255,255,255,255),1,255)
    line::draw(x,y,x,y+height,RGBA(255,255,255,255),1,255)
    line::draw(x+width,y,x+width,y+height,RGBA(255,255,255,255),1,255)
  EndProcedure
  
  Procedure drawCircle(x.i,y.i,radius,color.i=-16776961,intensity.i = 255)
    Protected hradius.f =radius/2
    ZoomSprite(line::circlesprite_ID,radius,radius)
    DisplayTransparentSprite(line::circlesprite_ID,x,y,intensity,color)
  EndProcedure
  
  Procedure drawCircleoutline(x.i,y.i,radius,color.i=-16776961,intensity.i = 255)
    Protected hradius.f =radius/2
    ZoomSprite(line::circlesprite_O_ID,radius,radius)
    DisplayTransparentSprite(line::circlesprite_o_ID,x,y,intensity,color)
  EndProcedure
EndModule

;ortho2d
EnableExplicit
#MASK_GENERALPICKMASK=1<<1
#MASK_NOPICKMASK=1<<31
#MASK_MAINCAMERA=1<<1
#MASK_FINAL_RENDERCAMERA=1<<31

#RENDERWIDTH  = 1366
#RENDERHEIGHT = 768
Global mouseavailable = #True

Declare init()
Declare main()
Declare render()

Declare sweepevents()
Declare checkintputs()
Declare createworld()

If Int(#PB_Compiler_Version) < 621
  Debug "Please compile with the currently newest beta 8 6.21."
  Debug "This snippet uses features presented with that update."
  End
EndIf
  
If #PB_Compiler_Debugger
  Debug "Please compile debugger off"
  End
EndIf


InitEngine3D() : InitSprite() : InitKeyboard() : InitMouse()  
AntialiasingMode(#PB_AntialiasingMode_x2)
ExamineDesktops()
OpenWindow(0, 0,0, DesktopUnscaledX(DesktopWidth(0)),DesktopUnscaledY(DesktopHeight(0)), "RenderQuad Resize",#PB_Window_ScreenCentered|#PB_Window_BorderLess)
OpenWindowedScreen(WindowID(0), 0, 0, DesktopWidth(0), DesktopHeight(0), 1, 0, 0,#PB_Screen_NoSynchronization)

Global final_rendercamera.i,final_rendertexture.i,final_rendermaterial.i,final_renderquad_mesh.i,final_renderquad_entity.i
Global light_1.i
Global maincamera.i
Global.i oldtime,newtime

init()
main()

Procedure init()
  UsePNGImageDecoder()
  Add3DArchive(GetCurrentDirectory()+"\TEXTURES",#PB_3DArchive_FileSystem)
  Add3DArchive(#PB_Compiler_Home+"examples/3d/Data/Main",#PB_3DArchive_FileSystem)
  Add3DArchive(#PB_Compiler_Home+"examples/3d/Data/Textures",#PB_3DArchive_FileSystem)
  Parse3DScripts()
  EnableWorldPhysics(#True)
  WorldShadows( #PB_Shadow_Additive,50000,RGBA(1,1,100,21))
  SetWorldAttribute(#PB_Shadow_FarDistance,50000)
  
  maincamera=CreateCamera(-1,0,0,100,100,#MASK_MAINCAMERA)
  CameraBackColor(maincamera,(RGB(0,0,500)))
  CameraProjectionMode(maincamera,#PB_Camera_Orthographic)
  MoveCamera(maincamera,0,-0,-8,#PB_Absolute)
  
  final_rendercamera=CreateCamera(-1,0,0,100,100,#MASK_FINAL_RENDERCAMERA)
  CameraBackColor(final_rendercamera,(RGB(255,0,255)))
  MoveCamera(final_rendercamera,0,0,-100,#PB_Absolute)
  CameraRange(final_rendercamera,0,100000)
  MoveCamera(final_rendercamera,0,-0,200,#PB_Absolute|#PB_World)
  
  final_rendertexture = CreateRenderTexture(#PB_Any,CameraID(maincamera),#RENDERWIDTH,#RENDERHEIGHT,#PB_Texture_ManualUpdate)
  final_rendermaterial =CreateMaterial(#PB_Any,TextureID(final_rendertexture))
  DisableMaterialLighting(final_rendermaterial,#True)
  MaterialFilteringMode(final_rendermaterial,#PB_Material_None)

  final_renderquad_mesh=CreatePlane(#PB_Any,(ScreenWidth()/ScreenHeight())*1000,1000,1,1,1,1)
  final_renderquad_entity = CreateEntity(#PB_Any,MeshID(final_renderquad_mesh),MaterialID(final_rendermaterial),0,0,-1000,#MASK_NOPICKMASK,#MASK_FINAL_RENDERCAMERA)
  RotateEntity(final_renderquad_entity,90,180,0,#PB_Absolute)
  SetRenderQueue(EntityID(final_renderquad_entity),0,0)
  
  line::init(256)
  
 
  
  petskii::init()
  createworld()
EndProcedure

Procedure createworld()
  Global.i BG_T,BG_M,BG_MESH,BG_E,platform_M,platform2_M,platform_T,platform3_M
  Global.i BOX_T,BOX_M,BOX_MESH,SBOX_MESH,BOX_E
  Global.i SPHERE_MESH
  
  BG_T  = LoadTexture(#PB_Any,"clouds.jpg")
  BOX_T = LoadTexture(#PB_Any,"Caisse.png")
  platform_T = LoadTexture(#PB_Any,"ground_diffuse.png")
  
  BG_M =CreateMaterial(#PB_Any,TextureID(BG_T))
  BOX_M =CreateMaterial(#PB_Any,TextureID(BOX_T))
  platform_M =CreateMaterial(#PB_Any,TextureID(platform_T))
  ScaleMaterial(platform_M,0.1,1)
  
  platform2_M =CreateMaterial(#PB_Any,TextureID(platform_T))
  ScaleMaterial(platform2_M,1,0.1)
  
  platform3_M =CreateMaterial(#PB_Any,TextureID(platform_T))
  ScaleMaterial(platform3_M,0.06,1)
  
  
  BG_MESH = CreatePlane(#PB_Any,(ScreenWidth()/ScreenHeight())*1000 ,1000,1,1,1,1)
  BG_E=CreateEntity(#PB_Any,MeshID(BG_MESH),MaterialID(BG_M),0,0,-1000,#MASK_NOPICKMASK,#MASK_MAINCAMERA)
  RotateEntity(BG_E,90,180,0,#PB_Absolute)
  
  BOX_MESH =CreateCube(#PB_Any,100)
  SBOX_MESH =CreateCube(#PB_Any,30)
  SPHERE_MESH=CreateSphere(#PB_Any,20)
  BOX_E=CreateEntity(#PB_Any,MeshID(BOX_MESH),MaterialID(platform_M),0,0,-1000,#MASK_NOPICKMASK,#MASK_MAINCAMERA)
  
  ScaleEntity(box_E,10,1,1)
  MoveEntity(box_E,0,-160,0)
  CreateEntityBody(Box_E,#PB_Entity_StaticBody)
  
  BOX_E=CreateEntity(#PB_Any,MeshID(BOX_MESH),MaterialID(platform3_M),0,0,-1000,#MASK_NOPICKMASK,#MASK_MAINCAMERA)
  ScaleEntity(box_E,18,1,1)
  MoveEntity(box_E,0,-460,3)
  CreateEntityBody(Box_E,#PB_Entity_StaticBody)
  
  BOX_E=CreateEntity(#PB_Any,MeshID(BOX_MESH),MaterialID(platform2_M),0,0,-1000,#MASK_NOPICKMASK,#MASK_MAINCAMERA)
  ScaleEntity(box_E,1,10,1)
  MoveEntity(box_E,-862,40,2)
  CreateEntityBody(Box_E,#PB_Entity_StaticBody)

  BOX_E=CreateEntity(#PB_Any,MeshID(BOX_MESH),MaterialID(platform2_M),0,0,-1000,#MASK_NOPICKMASK,#MASK_MAINCAMERA)
  ScaleEntity(box_E,1,10,1)
  MoveEntity(box_E,860,40,1)
  CreateEntityBody(Box_E,#PB_Entity_StaticBody)
  
  
  light_1 = CreateLight(#PB_Any,RGB(255,255,255),50,50,-50,#PB_Light_Point)
  Protected x.i
  For x = 1 To 25
    BOX_E=CreateEntity(#PB_Any,MeshID(BOX_MESH),MaterialID(BOX_M),Random(1000)-500,Random(1000)+500,-1000,#MASK_GENERALPICKMASK,#MASK_MAINCAMERA)
    RotateEntity(BOX_E,0,0,40)
    CreateEntityBody(Box_E,#PB_Entity_BoxBody)
    EntityAngularFactor(box_E,0,0,1)
    EntityLinearFactor(box_E,1,1,0)
    EntityRenderMode(box_e,#PB_Entity_CastShadow)
  Next x
  
    For x = 1 To 25
    BOX_E=CreateEntity(#PB_Any,MeshID(SBOX_MESH),MaterialID(BOX_M),Random(1000)-500,Random(1000)+500,-1000,#MASK_GENERALPICKMASK,#MASK_MAINCAMERA)
    RotateEntity(BOX_E,0,0,40)
    CreateEntityBody(Box_E,#PB_Entity_BoxBody)
    EntityAngularFactor(box_E,0,0,1)
    EntityLinearFactor(box_E,1,1,0)
    EntityRenderMode(box_e,#PB_Entity_CastShadow)
  Next x

  
  For x = 1 To 10
    BOX_E=CreateEntity(#PB_Any,MeshID(SPHERE_MESH),MaterialID(bg_M),Random(1000)-500,Random(1000)+500,-1000,#MASK_GENERALPICKMASK,#MASK_MAINCAMERA)
    RotateEntity(BOX_E,0,0,40)
    CreateEntityBody(Box_E,#PB_Entity_BoxBody)
    EntityAngularFactor(box_E,0,0,1)
    EntityLinearFactor(box_E,1,1,0)
    EntityRenderMode(box_e,#PB_Entity_CastShadow)
  Next x
EndProcedure

Procedure main()
  Repeat
    sweepevents()
    checkintputs()
    If KeyboardPushed(#PB_Key_Left)
      MoveCamera(maincamera,-5,0,0,#PB_Relative)
    EndIf
    
    If KeyboardPushed(#PB_Key_Right)
      MoveCamera(maincamera,5,0,0,#PB_Relative)
    EndIf
    
    If KeyboardPushed(#PB_Key_Down)
      MoveCamera(maincamera,0,-5,0,#PB_Relative)
    EndIf
    
    If KeyboardPushed(#PB_Key_Up)
      MoveCamera(maincamera,0,5,0,#PB_Relative)
    EndIf
    render()
  Until KeyboardPushed(#PB_Key_Escape)
EndProcedure

Global pick = -1
Procedure render()
  Protected fps.s
  If Not MouseButton(#PB_MouseButton_Left) And Not mouseavailable
    mouseavailable = #True
    pick = -1
  EndIf
  
  
  
  If timer(16)
    UpdateRenderTexture(final_rendertexture)
    RenderWorld(128)
  Else
    RenderWorld(0)
  EndIf
  
  
  
  If MousePick(maincamera,MouseX(),MouseY(),#MASK_GENERALPICKMASK)>0 And MouseButton(#PB_MouseButton_Left) And mouseavailable = #True
    mouseavailable = #False
    pick = MousePick(maincamera,MouseX(),MouseY())
  EndIf
  
  If IsEntity(pick)
    MoveEntity(pick,EntityX(pick)+MouseDeltaX()*1,EntityY(pick)+MouseDeltaY()*-1,-1000, #PB_Absolute)
    ApplyEntityForce(pick,1,1,1)
    ApplyEntityTorque(pick,1,1,1)
  Else
    line::drawCircle(MouseX()-5,MouseY()-5,10,RGBA(5,255,10,50),55)
    line::drawCircleoutline(MouseX()-50,MouseY()-50,100,RGBA(5,5,5,255))
  EndIf
  
  petskii::textoutlined(0,0,Str(MouseX())+","+Str(MouseY()),RGBA(200,200,100,255),RGBA(5,5,5,255))
  petskii::textoutlined(0,30,Str(MousePick(maincamera,MouseX(),MouseY(),#MASK_GENERALPICKMASK)),RGBA(200,200,100,255),RGBA(5,5,5,255))
  fps.s = Str(Engine3DStatus(#PB_Engine3D_CurrentFPS))
  petskii::textoutlined(0,60,"FPS:"+fps,RGBA(200,200,100,255),RGBA(5,5,5,255))
  
  MoveLight(light_1,(CameraX(maincamera)+ScreenWidth()/ScreenHeight()*-500)+MouseX()+Random(1),CameraY(maincamera)-MouseY()+500+Random(1),-200+Random(10),#PB_Absolute)
  FlipBuffers()

EndProcedure

Procedure sweepevents()
  Repeat : Until Not WindowEvent()
EndProcedure

Procedure checkintputs()
  ExamineMouse()
  ExamineKeyboard()
EndProcedure

Posted: **Mon May 12, 2025 2:33 pm**

Here's an easy to use module to quickly setup DPI aware 3d borderless windowed fullscreens in any render resolution.
Your main camera has ID 1.
Camera ID 2 is reserved, as it does the final rendering, though you dont have to do anything with it in this setup,just ignore it.
If you need more cameras for your app, start adding them 3+ or #PB_Any.

Code: Select all

;VER PB 6.21 Beta 9
EnableExplicit
;-==============================================================
;- MODULE START
;-==============================================================
DeclareModule sys
  #MAIN_DESKTOP             = 0
  #MAIN_WINDOW              = 0
  #APPNAME                  = "Application"
  #SCREEN_FRAMERATE         = 60
  #MAINLOOP_DELAY           = 0
  #COMPILER_MINIMUM_VERSION = 621
  #MAIN_CAMERA              = 1<<0
  #RENDER_CAMERA            = 1<<1
  #PICK                     = 1<<0
  #DONTPICK                 = 1<<1
  #RENDERWIDTH_DEFAULT      = 1366
  #RENDERHEIGHT_DEFAULT     = 768
  
  Global desktopcount.i, renderwidth.i=#RENDERWIDTH_DEFAULT, renderheight.i=#RENDERHEIGHT_DEFAULT
  
  Declare open2d(renderwidth.i=#RENDERWIDTH_DEFAULT,renderheight.i=#RENDERHEIGHT_DEFAULT)
  Declare open3d(renderwidth.i=#RENDERWIDTH_DEFAULT, renderheight.i=#RENDERHEIGHT_DEFAULT)
  Declare SetOrthoCamera()
  Declare SetPerspectiveCamera()
  Declare.i entitycreate(mesh.i,material.i,x=0,y=0,z=0,pickmask.i=#PICK)
  Declare SweepEvents()
  Declare.i escape()
EndDeclareModule

Module sys
  Structure quadobject
    mesh.i
    entity.i
    texture.i
    material.i
  EndStructure
  
  Global quad.quadobject
  
  Declare checks()
  Declare Load3DScripts()
  
;==============================================================
;  Initializes before opening 2D Screen
;  You may correct it to your needs
;==============================================================
  Procedure init2d()
    sys::desktopcount = ExamineDesktops()
    UsePNGImageDecoder()
    InitSprite()
    InitKeyboard()
    InitMouse()
    InitSound()
  EndProcedure
  
;==============================================================
;  Initializes before opening 3D Screen
;  You may correct it to your needs
;==============================================================
  Procedure init3d()
    sys::desktopcount = ExamineDesktops()
    UsePNGImageDecoder()
    InitEngine3D()
    InitSprite()
    InitKeyboard()
    InitMouse()
    InitSound()
  EndProcedure
  
;==============================================================
;  Parse 3d resources
;  You have to add your correct routes
;==============================================================
  Procedure Load3DScripts()
    Add3DArchive(#PB_Compiler_Home+"examples/3d/Data/Main",#PB_3DArchive_FileSystem) 
    Parse3DScripts()
  EndProcedure
  
;==============================================================
;  Opens a fullscreen windowed 3d screen
;  Render resolution can be specified,
;  result will be stretched according to desktop aspect ratio
;==============================================================
  Procedure open2d(renderwidth.i=#RENDERWIDTH_DEFAULT,renderheight.i=#RENDERHEIGHT_DEFAULT)
    init2d()
    OpenWindow(#MAIN_WINDOW,0,0,renderwidth,renderheight,#APPNAME,#PB_Window_BorderLess|#PB_Window_Invisible)
    OpenWindowedScreen(WindowID(#MAIN_WINDOW),0,0,renderwidth,renderheight,1,0,0,#PB_Screen_WaitSynchronization)
    ResizeWindow(#MAIN_WINDOW,0,0,DesktopUnscaledX(DesktopWidth(#MAIN_DESKTOP)),DesktopUnscaledY(DesktopHeight(#MAIN_DESKTOP)))
    HideWindow(#MAIN_WINDOW,#False)
  EndProcedure
  
;==============================================================
;  Opens a fullscreen windowed 3d screen
;  Render resolution can be specified,
;  result won't be stretched
;  Sets the main camera with (ID=1)
;  You don't have to bother with the final render camera (ID=2)
;==============================================================
  Procedure open3d(renderwidth.i=#RENDERWIDTH_DEFAULT, renderheight.i=#RENDERHEIGHT_DEFAULT)
    init3d()
    If renderwidth>DesktopUnscaledX(DesktopWidth(#MAIN_DESKTOP)) : renderwidth = DesktopUnscaledX(DesktopWidth(#MAIN_DESKTOP)) : EndIf
    If renderheight>DesktopUnscaledY(DesktopHeight(#MAIN_DESKTOP)) : renderheight = DesktopUnscaledY(DesktopHeight(#MAIN_DESKTOP)) : EndIf
    OpenWindow(#MAIN_WINDOW,0,0,DesktopUnscaledX(DesktopWidth(#MAIN_DESKTOP)),DesktopUnscaledY(DesktopHeight(#MAIN_DESKTOP)),#APPNAME, #PB_Window_BorderLess)
    OpenWindowedScreen(WindowID(#MAIN_WINDOW),0,0,WindowWidth(#MAIN_WINDOW),WindowHeight(#MAIN_WINDOW),1,0,0,#PB_Screen_SmartSynchronization)
    Load3DScripts() : SetFrameRate(#SCREEN_FRAMERATE)
    CreateCamera(#RENDER_CAMERA,0,0,100,100,#RENDER_CAMERA)
    CreateCamera(#MAIN_CAMERA,0,0,100,100,#MAIN_CAMERA)
    quad\texture  = CreateRenderTexture(#PB_Any,CameraID(#MAIN_CAMERA),renderwidth,renderheight,#PB_Texture_AutomaticUpdate)
    quad\material = CreateMaterial(#PB_Any,TextureID(quad\texture))
    DisableMaterialLighting(quad\material,#True)
    MaterialFilteringMode(quad\material,#PB_Material_Bilinear)
    quad\mesh = CreatePlane(#PB_Any,(ScreenWidth()/ScreenHeight())*1000,1000,1,1,1,1)
    quad\entity = CreateEntity(#PB_Any,MeshID(quad\mesh),MaterialID(quad\material),0,0,-1200,#DONTPICK,#RENDER_CAMERA)
    RotateEntity(quad\entity,90,180,0,#PB_Absolute)
  EndProcedure
  
;=====================================================
; Sets the main world camera to orthographic
;=====================================================
  Procedure SetOrthoCamera()
    If IsCamera(#MAIN_CAMERA)
      CameraProjectionMode(#MAIN_CAMERA,#PB_Camera_Orthographic)
    EndIf
  EndProcedure
  
;=====================================================
; Sets the main world camera to perspective
;=====================================================
  Procedure SetPerspectiveCamera()
    If IsCamera(#MAIN_CAMERA)
      CameraProjectionMode(#MAIN_CAMERA,#PB_Camera_Perspective)
    EndIf
  EndProcedure
  
;=====================================================
; Shortened entity creation, it uses raw PB ID-s
;=====================================================
  Procedure.i entitycreate(mesh.i,material.i,x.i=0,y.i=0,z.i=0,pickmask.i=#PICK)
    Protected.i returnvalue=-1
    If IsMesh(mesh)
      If IsMaterial(material)
        returnvalue = CreateEntity(#PB_Any,MeshID(mesh),MaterialID(material),x,y,z,#PICK,#MAIN_CAMERA)
      else
        returnvalue = CreateEntity(#PB_Any,MeshID(mesh),#PB_Material_None,x,y,z,pickmask,#MAIN_CAMERA)
      EndIf
    EndIf
    ProcedureReturn returnvalue
  EndProcedure
  
;=====================================================
; Check for compiler version and debugger
; Adjust it to your needs
;=====================================================
  Procedure Checks()
    If #PB_Compiler_Version<#COMPILER_MINIMUM_VERSION
      Debug "Minimum Compiler version is "+ Str(#COMPILER_MINIMUM_VERSION) + "."
      End
    EndIf
    If #PB_Compiler_Debugger
      Debug "Please run without debugger"
      End
    EndIf
  EndProcedure
  
;=====================================================
; Processes windows events
; Delays(0), and examines the keyboard and mouse
;=====================================================
  Procedure SweepEvents()
    Protected w_event.i
    Delay(#MAINLOOP_DELAY)
    Repeat 
      w_event = WindowEvent() : If w_event = #PB_Event_CloseWindow : End : EndIf
    Until Not w_event
    ExamineKeyboard():ExamineMouse()
  EndProcedure
  
;=====================================================
;Short check if Escape is pressed
;=====================================================
  Procedure.i Escape()
    If KeyboardPushed(#PB_Key_Escape)
      ProcedureReturn #True
    EndIf
    ProcedureReturn #False
  EndProcedure
EndModule
;-=====================================================
;-MODULE END
;-=====================================================

;=====================================================
;- EXAMPLES
;=====================================================
Procedure create_example_sprite()
  CreateSprite(1,100,100,#PB_Sprite_AlphaBlending)
  StartDrawing(SpriteOutput(1))
  DrawingMode(#PB_2DDrawing_AllChannels)
  Box(0,0,OutputWidth(),OutputHeight(),RGBA(0,0,0,0))
  Circle(OutputWidth()/2,OutputHeight()/2,Round(OutputWidth()/2-1,#PB_Round_Down),RGBA(255,0,0,255))
  StopDrawing()
EndProcedure

;=====================================================
; A 2d example
;=====================================================
Procedure example_2d()
  Sys::open2d()
  create_example_sprite()
  ZoomSprite(1,ScreenHeight()/2,ScreenHeight()/2)
  Repeat
    sys::SweepEvents()
    ClearScreen(RGB(20,60,90))
    RotateSprite(1,1,#PB_Relative)
    DisplayTransparentSprite(1,ScreenWidth()/2-SpriteWidth(1)/2,ScreenHeight()/2-SpriteHeight(1)/2)
    FlipBuffers()
  Until sys::Escape()
EndProcedure


;=====================================================
; A 3d example
;=====================================================
Procedure example_3d()
  Protected.i cubeobj
  Sys::open3d(1366,768)
  ;sys::SetOrthoCamera() :;uncomment this line to switch the camera to orthographic
  create_example_sprite()
  CreateLight(1,RGB(255,255,255),0,0,0,#PB_Light_Directional) : LightDirection(1,1,-1,1)
  CreateCube(1,100) 
  cubeobj = sys::entitycreate(1,0,0,0,-500)
  Repeat
    sys::SweepEvents()
    RotateEntity(cubeobj,0,1,0,#PB_Relative)
    RenderWorld()
    RotateSprite(1,1,#PB_Relative)
    DisplayTransparentSprite(1,25,25)
    FlipBuffers()
  Until sys::Escape()
EndProcedure

;-==============================================================
;-RUN THE EXAMPLES HERE
;-==============================================================

;example_2d()
example_3d()

Edit: Left an error in the code, fixed.

Posted: **Mon May 12, 2025 2:43 pm**

On the example 2D, the circle is not perfect on my system (flattened by the poles).

Posted: **Mon May 12, 2025 2:47 pm**

On the example 2D, the circle is not perfect on my system (flattened by the poles).

Yes, the 2d screen stretches to your desktop, and all your sprites must be manually adjusted. I don't have any other solution to that.
(Or 2d screen must be opened corresponding to desktop ratio.)

So, it's the 3d scenery, that is DPI aware, sprites always need special attention. The main purpose of this module was to not to render
the scenery at desktop 8K or 4K, but in a reasonable size in borderless windowed mode. (also the quad can be used together with shaders for special effects.)

PureBasic Forums - English

3D snippets

3D snippets

Re: 3D snippets

Re: 3D snippets

Re: 3D snippets

Re: 3D snippets

3D snippets - Animated icons

Re: 3D snippets

Re: 3D snippets

Re: 3D snippets

Re: 3D snippets

Re: 3D snippets

Re: 3D snippets

Re: 3D snippets

Re: 3D snippets

Re: 3D snippets