i want to make some low resolution game... some kind 640x480. but still not got that resolutions and window sizing. now i make some canvas gadget, make some arrows button events and my unit come walk to some direction, with wrong count middle-side directions (some kind left + down. i have +1 +1 for x and y. it is a little wrong... and i am not understand how to apply some speed param - because it cant be less than 1 pixel - but first is window question)
so how to make some full screen window, where i can use 2D grafic and use buttons, like canvas do?
Code: Select all
Enumeration ;{
#Window
#MainCanvasWindow
#MainMapImg
#TempUnitImage
;}
EndEnumeration
UsePNGImageDecoder()
;{ bits
Macro SetBit(Var, Bit)
Var | (Bit)
EndMacro
Macro ClearBit(Var, Bit)
Var & (~(Bit))
EndMacro
Macro TestBit(Var, Bit)
Bool(Var & (Bit))
EndMacro
Macro NumToBit(Num)
(1<<(Num))
EndMacro
Macro GetBits(Var, StartPos, EndPos)
((Var>>(StartPos))&(NumToBit((EndPos)-(StartPos)+1)-1))
EndMacro
;}
Global UnitDirection.a
Global UnitOldDirection.a
Global quit
; wilbert's transparent
Procedure ByteSwap32(addrLong)
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
!mov rax, [p.v_addrLong]
!mov ecx, [rax]
!bswap ecx
!mov [rax], ecx
CompilerElse
!mov eax, [p.v_addrLong]
!mov ecx, [eax]
!bswap ecx
!mov [eax], ecx
CompilerEndIf
EndProcedure
Procedure SetImageTransparent(hImg32, TransparentColorRGB.l) ;returns 1 on success, 0 on error/fail
Protected width,height,pitch,imgbase, x,y, *RGBA.Long
If ImageDepth(hImg32) <> 32: ProcedureReturn 0: EndIf
width = ImageWidth(hImg32)
height = ImageHeight(hImg32)
If StartDrawing(ImageOutput(hImg32)) = 0
ProcedureReturn 0
EndIf
If DrawingBufferPixelFormat() & #PB_PixelFormat_32Bits_RGB
TransparentColorRGB | $FF000000 ;Linux & OSX
Else
ByteSwap32(@TransparentColorRGB) ;Windows
TransparentColorRGB = (TransparentColorRGB >> 8) | $FF000000
EndIf
DrawingMode(#PB_2DDrawing_Default)
pitch = DrawingBufferPitch()
imgbase = DrawingBuffer()
width-1: height-1
For y = 0 To height
*RGBA = imgbase + (y * pitch)
For x = 0 To width
If *RGBA\l = TransparentColorRGB
*RGBA\l = 0 ;= RGBA(0,0,0, 0) ;set Alpha channel to 0 (fully transparent)
EndIf
*RGBA+4
Next x
Next y
StopDrawing()
ProcedureReturn 1 ;SUCCESS
EndProcedure
CreateImage(#MainMapImg, 672, 576, 32, RGB(50, 100, 50))
Global Dim UnitGFXArray.l(12)
For i = 1 To 12
UnitGFXArray(i) = CreateImage(#PB_Any, 8, 8, 32)
Next
If StartDrawing(ImageOutput(UnitGFXArray(1))) ;{
Box(0, 0, 8, 8, RGB(255, 0, 255))
Line(4, 0, -4, 4) ; < - left
Line(5, 0, -4, 4)
Line(0, 4, 4, 4)
Line(1, 4, 4, 4)
StopDrawing()
;}
EndIf
If StartDrawing(ImageOutput(UnitGFXArray(2))) ;{
Box(0, 0, 8, 8, RGB(255, 0, 255))
Line(0, 4, 4, -4) ; ^ - up
Line(1, 4, 4, -4)
Line(4, 0, 4, 4)
Line(5, 0, 4, 4)
StopDrawing()
;}
EndIf
If StartDrawing(ImageOutput(UnitGFXArray(3))) ;{
Box(0, 0, 8, 8, RGB(255, 0, 255))
Line(4, 0, 4, 4) ; > - right
Line(5, 0, 4, 4)
Line(7, 3, -4, 4)
Line(7, 4, -4, 4)
StopDrawing()
;}
EndIf
If StartDrawing(ImageOutput(UnitGFXArray(4))) ;{
Box(0, 0, 8, 8, RGB(255, 0, 255))
Line(0, 4, 4, 4) ; - down
Line(1, 4, 4, 4)
Line(4, 7, 4, -4)
Line(5, 7, 4, -4)
StopDrawing()
;}
EndIf
If StartDrawing(ImageOutput(UnitGFXArray(5))) ;{
Box(0, 0, 8, 8, RGB(255, 0, 255))
Line(0, 3, 1, 4) ; - down+left
Line(1, 3, 1, 4)
Line(0, 6, 5, 1)
Line(0, 7, 5, 1)
StopDrawing()
;}
EndIf
If StartDrawing(ImageOutput(UnitGFXArray(6))) ;{
Box(0, 0, 8, 8, RGB(255, 0, 255))
Line(0, 0, 6, 1) ; - up+left
Line(0, 1, 6, 1)
Line(0, 2, 1, 5)
Line(1, 2, 1, 5)
StopDrawing()
;}
EndIf
If StartDrawing(ImageOutput(UnitGFXArray(7))) ;{
Box(0, 0, 8, 8, RGB(255, 0, 255))
Line(7, 0, -6, 1) ; - up+right
Line(7, 1, -6, 1)
Line(7, 2, -1, 5)
Line(6, 2, -1, 5)
StopDrawing()
;}
EndIf
If StartDrawing(ImageOutput(UnitGFXArray(8))) ;{
Box(0, 0, 8, 8, RGB(255, 0, 255))
Line(7, 3, -1, 4) ; - down+right
Line(6, 3, -1, 4)
Line(7, 6, -5, 1)
Line(7, 7, -5, 1)
StopDrawing()
;}
EndIf
For i = 1 To 12
If IsImage(UnitGFXArray(i))
SetImageTransparent(UnitGFXArray(i), RGB(255, 0, 255))
EndIf
Next
Procedure CanvasUpdate(*Value)
startx.w = 100
starty.w = 100
starto.a = 1
Repeat
If StartDrawing(CanvasOutput(#MainCanvasWindow))
DrawImage(ImageID(#MainMapImg), 0, 0)
DrawingMode(#PB_2DDrawing_AlphaBlend)
Select UnitDirection
Case 8 ; left
startx - 1
starto = 1
Case 4 ; up
starty - 1
starto = 2
Case 2 ; right
startx + 1
starto = 3
Case 1 ; down
starty + 1
starto = 4
Case 9 ; down+left
startx - 1
starty + 1
starto = 5
Case 12 ; up+left
startx - 1
starty - 1
starto = 6
Case 6 ; up+right
startx + 1
starty - 1
starto = 7
Case 3 ; down+right
startx + 1
starty + 1
starto = 8
EndSelect
DrawImage(ImageID(UnitGFXArray(starto)), startx, starty)
StopDrawing()
EndIf
Delay(100)
Until quit = 1
quit = 2
EndProcedure
If OpenWindow(#Window, 100, 100, 692, 596, "", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
CanvasGadget(#MainCanvasWindow, 10, 10, 672, 576, #PB_Canvas_Keyboard)
SetActiveGadget(#MainCanvasWindow)
CanvasThread = CreateThread(@CanvasUpdate(), *Value)
Repeat
Select WaitWindowEvent()
Case #PB_Event_Gadget
Select EventGadget()
Case #MainCanvasWindow
Select EventType()
Case #PB_EventType_KeyDown
ButtonCode = GetGadgetAttribute(#MainCanvasWindow, #PB_Canvas_Key)
Select ButtonCode ;{
Case #PB_Shortcut_Left
UnitDirection = SetBit(UnitDirection, NumToBit(3))
UnitOldDirection = SetBit(UnitOldDirection, NumToBit(3))
Case #PB_Shortcut_Up
UnitDirection = SetBit(UnitDirection, NumToBit(2))
UnitOldDirection = SetBit(UnitOldDirection, NumToBit(2))
Case #PB_Shortcut_Right
;Debug "r"
UnitDirection = SetBit(UnitDirection, NumToBit(1))
UnitOldDirection = SetBit(UnitOldDirection, NumToBit(1))
Case #PB_Shortcut_Down
UnitDirection = SetBit(UnitDirection, NumToBit(0))
UnitOldDirection = SetBit(UnitOldDirection, NumToBit(0))
;}
EndSelect
Case #PB_EventType_KeyUp
ButtonCode = GetGadgetAttribute(#MainCanvasWindow, #PB_Canvas_Key)
Select ButtonCode ;{
Case #PB_Shortcut_Left
UnitDirection = ClearBit(UnitDirection, NumToBit(3))
If UnitDirection > 0
; for save last orientation
UnitOldDirection = ClearBit(UnitDirection, NumToBit(3))
EndIf
Case #PB_Shortcut_Up
UnitDirection = ClearBit(UnitDirection, NumToBit(2))
If UnitDirection > 0
UnitOldDirection = ClearBit(UnitDirection, NumToBit(2))
EndIf
Case #PB_Shortcut_Right
UnitDirection = ClearBit(UnitDirection, NumToBit(1))
If UnitDirection > 0
UnitOldDirection = ClearBit(UnitDirection, NumToBit(1))
EndIf
Case #PB_Shortcut_Down
UnitDirection = ClearBit(UnitDirection, NumToBit(0))
If UnitDirection > 0
UnitOldDirection = ClearBit(UnitDirection, NumToBit(0))
EndIf
;}
EndSelect
EndSelect
EndSelect
Case #PB_Event_CloseWindow
quit = 1 ; end until thread will ready
EndSelect
Until quit = 2
EndIf
End