Posts: 371
Threads: 30
Joined: Jul 2022
Reputation:
25
@Petr
yes it is a logical tip rendering only what is visible for the player to avoid the overcharge of CPU or of Game Engine. Also if this tip is good and appreciated when many more graphic and sound resources have been used respect a 2D retro game.
Very smart the tip of zoom of the image! Thanks for sharing.
@SMcNeill
yeah this is the mouse scrolling of AOE and C&C! It is sensible to the distance between mouse pointer and edge of screen!
Thanks for sharing.
Posts: 371
Threads: 30
Joined: Jul 2022
Reputation:
25
Here a camera/scenario with hero
Code: (Select All)
Rem demonstration of scrolling of a camera (little view) on a scenario (Total view)
' global variables
Dim Scenario As Long, Camera As Long
Dim d As Integer, x As Integer, y As Integer, Sw As Integer, Sh As Integer, Cw As Integer, Ch As Integer
Dim k As String
' initialization
Sw = 1200
Sh = 800
Cw = 200
Ch = 200
x = 1
y = 1
k = ""
Randomize Timer
Scenario = _NewImage(Sw, Sh, 32)
Camera = _NewImage(Cw, Ch, 32)
Screen Camera
_FullScreen
_Title "A demonstration of scrolling of a camera on a scenario"
' creating the scenario
_Dest Scenario
For a = 1 To 100
Line (Rnd * Sw, Rnd * Sh)-(Rnd * Sw, Rnd * Sh), _RGBA32(Rnd * 255, Rnd * 255, Rnd * 255, 255), B
Next a
_Dest Scr
a = 1
While k <> "Q"
k = UCase$(InKey$)
If k = "W" Then y = y - 1
If k = "S" Then y = y + 1
If k = "A" Then x = x - 1
If k = "D" Then x = x + 1
a = a * -1
If x < 1 Then x = 1
If x > (Sw - Cw) Then x = Sw - Cw
If y < 1 Then y = 1
If y > (Sh - Ch) Then y = Sh - Ch
Cls
_PutImage (1, 1), Scenario, Camera, (x, y)-(Cw + x, Ch + y)
MakeHero x, Ch + y - 60, a
_PrintString (1, 1), "Use WASD to move camera"
_PrintString (1, 18), "Q to quit"
_Display
_Limit 100
Wend
End
Sub MakeHero (X As Integer, Y As Integer, status As Integer)
If X > _Width - 40 Then X = _Width - 40
If Y > _Height - 60 Then Y = _Height - 60
Line (X + 20, Y)-(X, Y + 40), _RGBA32(127, 60, 227, 255)
Line (X + 20, Y)-(X + 40, Y + 40), _RGBA32(127, 60, 227, 255)
Line (X, Y + 40)-(X + 40, Y + 40), _RGBA32(127, 60, 227, 255)
Paint (X + 20, Y + 20), _RGBA32(127, 60, 227, 255), _RGBA32(127, 60, 227, 255)
Circle (X + 10, Y + 30), 5, _RGBA32(255, 6, 6, 255)
Circle (X + 30, Y + 30), 5, _RGBA32(255, 6, 6, 255)
If status = 1 Then
Line (X + 15, Y + 40)-(X + 20, Y + 60), _RGBA(127, 60, 227, 255), BF
Line (X + 30, Y + 40)-(X + 35, Y + 60), _RGBA(127, 60, 227, 255), BF
ElseIf status = -1 Then
Line (X + 10, Y + 40)-(X + 15, Y + 60), _RGBA(127, 60, 227, 255), BF
Line (X + 25, Y + 40)-(X + 30, Y + 60), _RGBA(127, 60, 227, 255), BF
End If
End Sub
and here the hero moving on the scrolling of background made by tiles
Code: (Select All)
Rem Demonstration of scrolling towards right or left of the background
Rem STEP 7 adding a character on the background scrolling towards right /left & down/up in loop
' Global variables' declaration
Dim Back As Long, Scr As Long, x As Integer, y As Integer, w As Integer, h As Integer
Dim i As Integer, k As String, dx As Integer, dy As Integer, O As Integer, V As Integer, S As Integer
Dim Hx As Integer, Hy As Integer, M As Integer
_Title " Demo of background scrolling with character: step 7" ' title on the titlebar of the application
' variables' initialization
w = 800: h = 600
y = 1
x = 1
Scr = _NewImage(w, h, 32)
Back = _NewImage(w, h, 32)
dx = 1
dy = 1
S = 1
O = 1
V = 1
M = 1
Hx = 1
Hy = h - 60
Randomize Timer ' it starts the random generator of number
Screen Scr ' it creates window of the application
_Dest Back ' it sets the surface as destination of graphic output
' it draws a background by using a FOR loop with graphic instructions (LINE and _RGBA)
For i = 1 To 100
Line ((Rnd * (780) + 10), Rnd * (580) + 10)-(Rnd * (780) + 10, Rnd * (580) + 10), _RGBA32(Rnd * (255), Rnd * (255), Rnd * (255), 255), B
Next i
_Dest 0 ' it sets the surface of destination of graphic output as the window of the application
' it manages the keyboard input of user and the scrolling background
While k <> "Q"
k = UCase$(InKey$) ' it takes the input from keyboard
Cls 'it clears previous screen
_PutImage (x, y), Back, Scr 'it paints screen now
_PutImage (x - w, y), Back, Scr ' it completes the background on the left side
_PutImage (x, y - h), Back, Scr ' it completes the background on the upper side
_PutImage (x - w, y - h), Back, Scr ' it completes the background on the upper side
_PrintString (1, 1), "Press Q to quit program, S to stop/start demo, R to reverse directions" ' it shows instruction for user on the screen
_PrintString (1, 20), " O stop/start horizontal scrolling, V stop/start vertical scrolling"
MakeHero Hx, Hy, M
M = M * -1
' it starts/stops the scrolling
If k = "S" Then S = S * -1
If k = "R" Then
' it changes only scrolling activated
If O > 0 Then dx = dx * -1
If V > 0 Then dy = dy * -1
' it changes the direction of scrolling +1 = to right to bottom/ -1 = to left to up
End If
If k = "O" Then O = O * -1 'it sets the status of horizontal scrolling
If k = "V" Then V = V * -1 ' it sets the status of vertical scrolling
If S > 0 And O > 0 Then x = x + dx: Hx = Hx + dx ' it scrolls only horizontal
If S > 0 And V > 0 Then y = y + dy: Hy = Hy + dy ' it scrolls only vertical
If dx > 0 And x > w Then x = 1 ' it corrects x when it is over w and scrolling is to right
If dx < 0 And x < 1 Then x = w ' it corrects x when it is under 1 and scrolling is to left
If dy > 0 And y > h Then y = 1 ' it corrects y when it is over h and scrolling is to down
If dy < 0 And y < 1 Then y = h ' it corrects when it is under 1 and scrolling is to up
If Hx > w - 40 Then Hx = w - 40
If Hx < 1 Then Hx = 1
If Hy > h - 60 Then Hy = h - 60
If Hy < 1 Then Hy = 1
_Display ' it forces hardware to show image
_Limit 100 ' it reduces the number of cycles of CPU used by this application
Wend
End
Sub MakeHero (X As Integer, Y As Integer, status As Integer)
If X > _Width - 40 Then X = _Width - 40
If Y > _Height - 60 Then Y = _Height - 60
Line (X + 20, Y)-(X, Y + 40), _RGBA32(127, 60, 227, 255)
Line (X + 20, Y)-(X + 40, Y + 40), _RGBA32(127, 60, 227, 255)
Line (X, Y + 40)-(X + 40, Y + 40), _RGBA32(127, 60, 227, 255)
Paint (X + 20, Y + 20), _RGBA32(127, 60, 227, 255), _RGBA32(127, 60, 227, 255)
Circle (X + 10, Y + 30), 5, _RGBA32(255, 6, 6, 255)
Circle (X + 30, Y + 30), 5, _RGBA32(255, 6, 6, 255)
If status = 1 Then
Line (X + 15, Y + 40)-(X + 20, Y + 60), _RGBA(127, 60, 227, 255), BF
Line (X + 30, Y + 40)-(X + 35, Y + 60), _RGBA(127, 60, 227, 255), BF
ElseIf status = -1 Then
Line (X + 10, Y + 40)-(X + 15, Y + 60), _RGBA(127, 60, 227, 255), BF
Line (X + 25, Y + 40)-(X + 30, Y + 60), _RGBA(127, 60, 227, 255), BF
End If
End Sub
This is the 7th step of the tutorial and it goes beyond the goal to make a scrolling background and it shows how to render character (so also for obstacles, goods and enemies) on a moving background.
I thank @Bplus for the feedback to give me the stimulus to go on with this basical tutorial.
Posts: 2,219
Threads: 226
Joined: Apr 2022
Reputation:
110
From Tempo's SCREEN 0 code...
Code: (Select All)
Width 80, 25 ' screen 0 only text 80 columns for 25 rows
_ControlChr Off
_Title "Scrolling text in SCREEN 0 with arrow keys"
Dim Row As String, Text(1 To 40) As String, cText(1 To 255, 1 To 40) As Integer, a As Integer, b As Integer, R As Integer, C As Integer
' initialization
' it builds a string of 255 characters
For a = 1 To 255
Row = Row + Chr$(a)
Next a
' it builds 40 rows of 255 characters for row
For a = 1 To 40
Text(a) = Right$(Row, a + 10) + Left$(Row, 255 - a - 10)
For b = 1 To 255
cText(b, a) = (b * a) Mod 7
Next b
Next a
R = 1
C = 1
While -1
_Limit 30
Row = UCase$(InKey$)
If Len(Row) = 2 Then
Select Case InStr("HPKM", Mid$(Row, 2, 1))
Case 1: R = R - 1
Case 2: R = R + 1
Case 3: C = C - 1
Case 4: C = C + 1
End Select
End If
If R = oldr And C = oldc Then _Continue
oldr = R: oldc = C
Cls , 0
For a = 0 To 24
Locate a + 1, 1
If (a + R) < 41 And (a + R) > 0 Then
For b = 1 To 80
If (C + b - 1 < 256) And (C + b - 1 > 0) Then
Color , cText(C + b - 1, a + R)
Print Mid$(Text(a + R), C + b - 1, 1);
Else
Color , 0
Print " ";
End If
Next b
End If
Next
_Display
Wend
End
Minor modifications made for my purposes, only. I like this. From the old days, we couldn't get away with printing each character at a time. Too slow and you had to use PCOPY to remove flickering. In QB64 it's fast enough and _Display kills the flickering.
I'll give it a +2 because 1, it was made by another Italian, and 2, well it's in SCREEN 0!
Pete 
Posts: 371
Threads: 30
Joined: Jul 2022
Reputation:
25
@Pete I like your beautify of the code
Posts: 2,219
Threads: 226
Joined: Apr 2022
Reputation:
110
(12-05-2024, 07:25 PM)TempodiBasic Wrote: @Pete I like your beautify of the code
Thanks!
It's getting better with age. Funny, I hate so much as a tiny ding in a clean paint job but I've always put up with writing very ugly ASCII code. I envy Steve... because his code doesn't seem to bother him.
Pete
Posts: 371
Threads: 30
Joined: Jul 2022
Reputation:
25
@Pete
Hi
here you can see an evolution of your beautified code after a transformation to get versatile code in a SUB
SUB scrolling text
it maybe useful
Posts: 2,717
Threads: 329
Joined: Apr 2022
Reputation:
222
Just as my example above for a graphic screen, I'd simply do this the exact same way for a SCREEN 0 screen, as illustrated below:
Code: (Select All)
Dim Shared As Long Display, Widescreen
Display = _NewImage(120, 30, 0)
Widescreen = _NewImage(360, 90, 0) '3 times the display size.
Screen Display
_Dest Widescreen
'Fill the widescreen with some text
For xframe = 0 To 2
For yframe = 0 To 2
c = c + 1
For y = 1 To 30
Color 15 - c, c
Locate yframe * 30 + y, xframe * 120 + 1
p$ = Str$(y) + ") LINE NUMBER #" + Str$(y) + Space$(120)
p$ = Left$(p$, 120)
Print p$;
Next
Next
Next
xstart = 1: ystart = 1
Do
While _MouseInput: Wend
If _MouseX <= 3 Then xstart = xstart - 1
If _MouseX >= 118 Then xstart = xstart + 1
If _MouseY <= 3 Then ystart = ystart - 1
If _MouseY >= 28 Then ystart = ystart + 1
If xstart < 1 Then xstart = 1
If ystart < 1 Then ystart = 1
If xstart > 241 Then xstart = 241
If ystart > 61 Then ystart = 61
PutZero xstart, ystart
_Limit 30
Loop Until _KeyHit
Sub PutZero (xstart, ystart)
Dim As _MEM m(1)
m(0) = _MemImage(Display)
m(1) = _MemImage(Widescreen)
Dim As _Integer64 yOffset, xOffset, y
yOffset = (ystart - 1) * 720
xOffset = (xstart - 1) * 2
Dim temp As String * 240
For y = 0 To 29
_MemGet m(1), m(1).OFFSET + yOffset + y * 720 + xOffset, temp
_MemPut m(0), m(0).OFFSET + y * 240, temp
Next
_MemFree m(0)
_MemFree m(1)
End Sub
Posts: 371
Threads: 30
Joined: Jul 2022
Reputation:
25
@SMcNeill
Hey man thanks for remembering us the use of _MEM, the QB64pe pointers.
So, as I got some time to spend into this features I go on with your demo.
It is fantastic! What can I modify to be nearest to _MEM logic?
Yes filling the screen using the same _MEM functions.
And ,TADA, here it is
So thanks, you have brought me to understand (o to remember?)how characters are stored into screen 0 memory.
I hope you like it.
Code: (Select All)
_ControlChr Off
Dim Shared As Long Display, Widescreen
Display = _NewImage(120, 30, 0)
Widescreen = _NewImage(360, 90, 0) '3 times the display size.
Screen Display
_Dest Widescreen
Dim m As _MEM ' our MEM pointer
m = _MemImage(Widescreen)
'Fill the widescreen with some text
' il colore in memoria e' conservato come ASCII con valore del risultato di questa formula Fg+(Fg*Bg)+Bg
' ogni carattere usa 2 byte il primo e' il carattere il secondo e' il valore per colore primo piano e colore sfondo
For c = 1 To 3
For d = 1 To 30
finalLine$ = ""
base$ = Line120$(d)
finalLine$ = RawLine120$(base$, ColorText(15 - c, 7 - c)) + RawLine120$(base$, ColorText(15 - (c + 1), 7 - (c + 3))) + RawLine120$(base$, ColorText(15 - (c + 2), 7 - (c + 4)))
_MemPut m, m.OFFSET + ((d - 1) * 720) + ((c - 1) * 720 * 30), finalLine$
Next d
Next c
_MemFree m
'---------------> the PRINT method used in the original code<----------------------
''For xframe = 0 To 2
'' For yframe = 0 To 2
'' c = c + 1
'' For y = 1 To 30
'' Color 15 - c, c
'' Locate yframe * 30 + y, xframe * 120 + 1
'' p$ = Str$(y) + ") LINE NUMBER #" + Str$(y) + Space$(120)
'' p$ = Left$(p$, 120)
'' Print p$;
'' Next
'' Next
''Next
'--------------------><---------------------------------------------------------------
xstart = 1: ystart = 1
Do
While _MouseInput: Wend
If _MouseX <= 3 Then xstart = xstart - 1
If _MouseX >= 118 Then xstart = xstart + 1
If _MouseY <= 3 Then ystart = ystart - 1
If _MouseY >= 28 Then ystart = ystart + 1
If xstart < 1 Then xstart = 1
If ystart < 1 Then ystart = 1
If xstart > 241 Then xstart = 241
If ystart > 61 Then ystart = 61
PutZero xstart, ystart
_Limit 30
Loop Until _KeyHit
End
Sub PutZero (xstart, ystart)
Dim As _MEM m(1)
m(0) = _MemImage(Display)
m(1) = _MemImage(Widescreen)
Dim As _Integer64 yOffset, xOffset, y
yOffset = (ystart - 1) * 720
xOffset = (xstart - 1) * 2
Dim temp As String * 240
For y = 0 To 29
_MemGet m(1), m(1).OFFSET + yOffset + y * 720 + xOffset, temp
_MemPut m(0), m(0).OFFSET + y * 240, temp
Next
_MemFree m(0)
_MemFree m(1)
End Sub
' NEWCODE for filling the video screen memory
Function ColorText (Fg As Integer, Bg As Integer)
ColorText = Fg + (Fg * Bg) + Bg
End Function
Function Line120$ (a As Integer)
p$ = Str$(a) + ") LINE NUMBER #" + Str$(a) + Space$(120)
p$ = Left$(p$, 120)
Line120$ = p$
End Function
Function RawLine120$ (a As String, b As Integer)
For c = 1 To Len(a)
t$ = t$ + Chr$(Asc(a, c)) + Chr$(b)
Next c
RawLine120$ = t$
End Function
Posts: 2,219
Threads: 226
Joined: Apr 2022
Reputation:
110
I really should take the time sometime to figure out MEM, sometime.
Pete
|
