+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Help Me! (https://qb64phoenix.com/forum/forumdisplay.php?fid=10)
+---- Thread: Problem replacing legacy code with modern QB64 code (/showthread.php?tid=3426)
Pages:
1
2
Problem replacing legacy code with modern QB64 code - HuggbardCeline - 01-27-2025
Dear Sirs,
first of all many thanks for this great forum. This forum is the reason why i'm learning QB64
![[Image: smile.png]](https://qb64phoenix.com/forum/images/icons/smile.png){kind=icon}
.I read the tutorial from here https://www.qb64tutorial.com
which was really excellent. Some smaller tutorials followd and i learned a lot.
For learning purposes i'm now trying to translate an older QBasic code to modern QB64 Code. It is an old Demo from Phatcode called "digital reality" by plasma. For me the most interesting part ist the Vector_Balls part.
My problem is I can't figure out how to do the page flipping in a correct way in modern QB64.
I also sent the DIGIREAL.BIN fily, simply rename .bmp to .BIN.
This is the reduced working code:
Code: (Select All)
'digital reality by plasma
'.........................
'
'[11-01-2004] updated final release
'[07-16-2002] final release
'[11-01-2001] contest release
'
'created for Toshi's Fall 2001 "Pure QB" demo competition
'placed 3rd out of 6 entries
'
'www.phatcode.net
'Dim ScreenImage& ' the main graphics screen
'Dim ActivePage% ' page being written to
'Dim ViewPage% ' page being viewed
'ScreenImage& = _NewImage(640, 640, 32) ' create main graphics screen'Screen ScreenImage&, , 1, 0 ' page 1 active and viewing page 0
'Screen ScreenImage&, , 0, 0 ' active and view page set to 0
DefInt A-Z
'$Static
Const NONE = 0
Const ADLIB = 1
Const MPU401 = 2
Const FALSE = 0
Const TRUE = Not FALSE
Const Compiled = TRUE 'change this to FALSE to run in the QB IDE
'change this to TRUE when compiling for extra speed
DECLARE SUB Do.End ()
DECLARE SUB Do.VectorBalls ()
DECLARE SUB Gfx.Pal.GetAttr (pal.seg, pal.off, Reg, r, g, b)
DECLARE SUB Gfx.Pal.Load (Filename$, pal.seg, pal.off)
DECLARE SUB Gfx.Pal.Set (pal.seg, pal.off)
DECLARE SUB Gfx.Put (x.pos, y.pos, src.seg, src.off, dest.seg, dest.off)
DECLARE SUB Gfx.Put.Mask (x.pos, y.pos, src.seg, src.off, dest.seg, dest.off, clip.color)
DECLARE SUB Lookup.GenTables ()
DECLARE SUB Pack.BLoad (PakFile, Filename$, segment, offset)
DECLARE FUNCTION Pack.Offset& (PakFile, Filename$)
Dim Shared Pack
Dim Shared PackFile$
PackFile$ = "DIGIREAL.BIN"
Pack = FreeFile
Open "DIGIREAL.BIN" For Binary As #Pack
If LOF(Pack) = 0 Then
Close #Pack
Kill PackFile$
Print "Cannot find " + PackFile$
End
End If
Dim Shared Gfx.OldSkool
Dim Shared Gfx.WaitSync
Dim Shared Pal.FadeBuffer(767)
'$Dynamic
'$Static
Dim Shared Lookup.Cosine(360) As Single
Dim Shared Lookup.Sine(360) As Single
Dim Shared Lookup.Sine160(0 To 360) As Single
Dim Shared Lookup.Cosine160(0 To 360) As Single
Randomize 357
Do.Startup
Lookup.GenTables
'Screen _NewImage(1024, 768, 32)
Screen 13
Do.VectorBalls
Sub Do.Startup
Dim Choose(2)
DetectVSync = TRUE
Choose(1) = 3
Gfx.WaitSync = Choose(1)
Cls
End Sub
Sub Do.VectorBalls
Seek #Pack, Pack.Offset&(Pack, "VECTORS.DAT")
Get #Pack, , NumShapes
Get #Pack, , NumBalls
Dim Vector(NumShapes, NumBalls - 1, 2)
Dim Temp(NumBalls - 1, 2)
Distance = 256
Dim Morph(NumShapes, NumBalls - 1, 2)
For i = 1 To NumShapes
For j = 0 To NumBalls - 1
Get #Pack, , x
Get #Pack, , y
Get #Pack, , z
Vector(i, j, 0) = x
Vector(i, j, 1) = y
Vector(i, j, 2) = z
Next
Next
'-----------------------------------------------------------------------------------------------------------------------
'ViewPage% = 0 ' set view page
'PCopy ViewPage% + 1, 0 ' copy page 1 or 2 to page 0
'ViewPage% = 1 - ViewPage% ' flip view page
'_Display '
Dim Screen.Buffer(32001)
Screen.Buffer(0) = 2560
Screen.Buffer(1) = 200
'-----------------------------------------------------------------------------------------------------------------------
For i = 1 To NumShapes - 1
For j = 0 To NumBalls - 1
startX = Vector(i, j, 0)
startY = Vector(i, j, 1)
startZ = Vector(i, j, 2)
endX = Vector(i + 1, j, 0)
endY = Vector(i + 1, j, 1)
endZ = Vector(i + 1, j, 2)
Morph(i, j, 0) = endX - startX
Morph(i, j, 1) = endY - startY
Morph(i, j, 2) = endZ - startZ
Next
Next
For i = 0 To NumBalls - 1
Vector(0, i, 0) = Vector(1, i, 0)
Vector(0, i, 1) = Vector(1, i, 1)
Vector(0, i, 2) = Vector(1, i, 2)
Next
Dim Ball(191) As Integer
Dim BallPal(2, 383) As Integer
Gfx.Pal.Load "BALL.PAL", VarSeg(BallPal(0, 0)), VarPtr(BallPal(0, 0))
Dim pal(383)
For i = 3 To 383
pal(i) = 10 + 256 * 10
Next
For i = 0 To 255
Gfx.Pal.sFade 255, i, VarSeg(pal(0)), VarPtr(pal(0)), VarSeg(BallPal(0, 0)), VarPtr(BallPal(0, 0))
If Gfx.WaitSync > 0 Then
Wait &H3DA, 8, 8
Wait &H3DA, 8
End If
Gfx.Pal.Set VarSeg(pal(0)), VarPtr(pal(0))
Next
Pack.BLoad Pack, "BALL.GFX", VarSeg(Ball(0)), VarPtr(Ball(0))
Def Seg = VarSeg(Screen.Buffer(0))
steps = 0
shape = 1
Do
'PCopy 1, 0 ' clear screen with page 3 image
If steps < 128 Then
For i = 0 To NumBalls - 1
Vector(0, i, 0) = Vector(shape, i, 0) + (Morph(shape, i, 0) / 128) * steps
Vector(0, i, 1) = Vector(shape, i, 1) + (Morph(shape, i, 1) / 128) * steps
Vector(0, i, 2) = Vector(shape, i, 2) + (Morph(shape, i, 2) / 128) * steps
Next
steps = steps + 1
ElseIf steps < 512 Then
steps = steps + 1
ElseIf steps = 512 And shape < NumShapes - 1 Then
steps = 0
shape = shape + 1
End If
If shape = NumShapes - 1 And steps > 128 And AngleX >= 0 And AngleX <= 5 And AngleY >= 0 And AngleY <= 0 And AngleZ >= 0 And AngleZ <= 5 Then
AngleX = 0
AngleY = 0
AngleZ = 0
Distance = Distance - 1
If Distance = 0 Then Exit Do
Else
AngleX = AngleX + 1
If AngleX >= 360 Then AngleX = 0
AngleY = AngleY + 1
If AngleY >= 360 Then AngleY = 0
AngleZ = AngleZ - 1
If AngleZ < 0 Then AngleZ = 359
End If
For i = 0 To NumBalls - 1
TempX = Vector(0, i, 0)
TempY = Vector(0, i, 1)
TempZ = Vector(0, i, 2)
'rotate around the x-axis
NewY = TempY * Lookup.Cosine(AngleX) - TempZ * Lookup.Sine(AngleX)
NewZ = TempY * Lookup.Sine(AngleX) + TempZ * Lookup.Cosine(AngleX)
NewX = TempX
TempX = NewX
TempY = NewY
TempZ = NewZ
'rotate around the y-axis
NewX = TempX * Lookup.Cosine(AngleY) + TempZ * Lookup.Sine(AngleY)
NewZ = -TempX * Lookup.Sine(AngleY) + TempZ * Lookup.Cosine(AngleY)
TempX = NewX
TempZ = NewZ
'rotate around the z-axis
NewX = TempX * Lookup.Cosine(AngleZ) - TempY * Lookup.Sine(AngleZ)
NewY = TempX * Lookup.Sine(AngleZ) + TempY * Lookup.Cosine(AngleZ)
TempX = NewX
TempY = NewY
'push the z coordinates into the view area
TempZ = TempZ - Distance
Temp(i, 0) = TempX * 256 \ TempZ + 160
Temp(i, 1) = TempY * 256 \ TempZ + 100
Temp(i, 2) = TempZ
Next
For j = 0 To NumBalls - 2
For k = j + 1 To NumBalls - 1
a = Temp(j, 2)
b = Temp(k, 2)
If a >= b Then
Swap Temp(j, 0), Temp(k, 0)
Swap Temp(j, 1), Temp(k, 1)
Swap Temp(j, 2), Temp(k, 2)
End If
Next
Next
For i = 0 To NumBalls - 1
Gfx.Put Temp(i, 0) - 10, Temp(i, 1) - 8, VarSeg(Ball(0)), VarPtr(Ball(0)), VarSeg(Screen.Buffer(0)), 4
Next
If Gfx.WaitSync > 1 Then
Wait &H3DA, 8, 8
Wait &H3DA, 8
End If
'-----------------------------------------------------------------------------------------------------------------------
'ActivePage% = 1 - ActivePage% ' flip active page
Put (0, 0), Screen.Buffer(0), PSet
ReDim Screen.Buffer(32001)
Screen.Buffer(0) = 2560
Screen.Buffer(1) = 200
'-----------------------------------------------------------------------------------------------------------------------
'_Display
Loop
End Sub
Sub Gfx.Pal.Load (Filename$, pal.seg, pal.off)
Seek #Pack, Pack.Offset&(Pack, Filename$)
Byte$ = " "
Def Seg = pal.seg
For x = 0 To 767
Get #Pack, , Byte$
Poke pal.off + x, Asc(Byte$)
Next
End Sub
Sub Gfx.Pal.Set (pal.seg, pal.off)
Def Seg = pal.seg
Out &H3C8, 0
For x = 0 To 255
red = Peek(pal.off + x * 3)
green = Peek(pal.off + x * 3 + 1)
blue = Peek(pal.off + x * 3 + 2)
If Gfx.OldSkool Then
gray = (red * 30 + green * 59 + blue * 11) \ 100
Out &H3C9, gray
Out &H3C9, gray
Out &H3C9, gray
Else
Out &H3C9, red
Out &H3C9, green
Out &H3C9, blue
End If
Next
End Sub
Sub Gfx.Pal.SetAttr (pal.seg, pal.off, Reg, r, g, b)
Def Seg = pal.seg
Poke pal.off + Reg * 3, r
Poke pal.off + Reg * 3 + 1, g
Poke pal.off + Reg * 3 + 2, b
End Sub
Sub Gfx.Pal.sFade (steps, frame, pal.seg, pal.off, topal.seg, topal.off)
For x = 0 To 767
Def Seg = topal.seg
target = Peek(topal.off + x)
Def Seg = pal.seg
current = Peek(pal.off + x)
If frame = 0 Then
Pal.FadeBuffer(x) = current
original = current
Else
original = Pal.FadeBuffer(x)
End If
If current < target Then
current = original + ((target - original) / steps) * frame
ElseIf current > target Then
current = target + ((original - target) / steps) * (steps - frame)
End If
Poke pal.off + x, current
Next
End Sub
Sub Gfx.Put (x.pos, y.pos, src.seg, src.off, dest.seg, dest.off)
Def Seg = src.seg
xsize = (Peek(src.off) + Peek(src.off + 1) * 256) / 8
ysize = Peek(src.off + 2)
If Compiled Then
For y = 0 To ysize - 1
For x = 0 To xsize - 1
Def Seg = src.seg
Byte = Peek(src.off + 4 + y * xsize + x)
If Byte <> 0 Then
If y.pos + y > 0 And y.pos + y < 200 And x.pos + x > 0 And x.pos + x < 320 Then
Def Seg = dest.seg
Poke dest.off + (y.pos + y) * 320 + x.pos + x, Byte
End If
End If
Next
Next
Else
For y = 0 To ysize - 1
For x = 0 To xsize - 1
Def Seg = src.seg
Byte = Peek(src.off + 4 + y * xsize + x)
If Byte <> 0 Then
If y.pos + y > 0 And y.pos + y < 200 And x.pos + x > 0 And x.pos + x < 320 Then
Def Seg = dest.seg
Poke dest.off + (y.pos + y) * 320& + x.pos + x, Byte
End If
End If
Next
Next
End If
End Sub
Sub Gfx.Put.Mask (x.pos, y.pos, src.seg, src.off, dest.seg, dest.off, clip.color)
Def Seg = src.seg
xsize = Peek(src.off) / 8
ysize = Peek(src.off + 2)
If Compiled Then
For y = 0 To ysize - 1
For x = 0 To xsize - 1
Def Seg = src.seg
Byte = Peek(src.off + 4 + y * xsize + x)
Def Seg = dest.seg
If y.pos + y > 0 And y.pos + y < 320 And x.pos + x > 0 And x.pos + x < 320 Then
If Peek(dest.off + (y.pos + y) * 320 + x.pos + x) <> clip.color Then
Poke dest.off + (y.pos + y) * 320 + x.pos + x, Byte
End If
End If
Next
Next
Else
For y = 0 To ysize - 1
For x = 0 To xsize - 1
Def Seg = src.seg
Byte = Peek(src.off + 4 + y * xsize + x)
Def Seg = dest.seg
If y.pos + y > 0 And y.pos + y < 320 And x.pos + x > 0 And x.pos + x < 320 Then
If Peek(dest.off + (y.pos + y) * 320& + x.pos + x) <> clip.color Then
Poke dest.off + (y.pos + y) * 320& + x.pos + x, Byte
End If
End If
Next
Next
End If
End Sub
Sub Lookup.GenTables
For x = 0 To 359
Lookup.Cosine(x) = Cos(x * 3.14159265# / 180)
Lookup.Sine(x) = Sin(x * 3.14159265# / 180)
Lookup.Sine160(x) = Lookup.Sine(x) / 160
Lookup.Cosine160(x) = Lookup.Cosine(x) / 160
Next
End Sub
Sub Pack.BLoad (PakFile, Filename$, segment, offset)
buffer = 8000
Seek #PakFile, 6
Get #PakFile, , NumFiles
For x = 1 To NumFiles
Name$ = Space$(8)
Get #PakFile, , Name$
Ext$ = Space$(3)
Get #PakFile, , Ext$
If Filename$ = LTrim$(RTrim$(Name$)) + "." + LTrim$(RTrim$(Ext$)) Then
FileNum = x
Exit For
End If
Next
If x = 0 Then
Close #PakFile
Exit Sub
End If
Seek #PakFile, 11 + NumFiles * 11 + (FileNum - 1) * 8
Get #PakFile, , FileLoc&
Get #PakFile, , FileLen&
FileLoc& = FileLoc& + 7
FileLen& = FileLen& - 7
Seek #PakFile, FileLoc& + 1
offset& = offset - 1
Block = buffer
Do
If Loc(PakFile) = FileLoc& + FileLen& + 1 Then Exit Do
If Loc(PakFile) + Block > FileLoc& + FileLen& + 1 Then
Block = (FileLoc& + FileLen& + 1) - Loc(PakFile)
End If
buffer$ = Input$(Block, # PakFile)
Def Seg = segment
For x = 1 To Len(buffer$)
Poke offset& + x, Asc(Mid$(buffer$, x, 1))
Next
offset& = offset& + Len(buffer$)
Loop Until EOF(PakFile)
buffer$ = ""
End Sub
Function Pack.Offset& (PakFile, Filename$)
Seek #PakFile, 6
Get #PakFile, , NumFiles
For x = 1 To NumFiles
Name$ = Space$(8)
Get #PakFile, , Name$
Ext$ = Space$(3)
Get #PakFile, , Ext$
If Filename$ = LTrim$(RTrim$(Name$)) + "." + LTrim$(RTrim$(Ext$)) Then
FileNum = x
Exit For
End If
Next
If x = 0 Then Exit Function
Seek #PakFile, 11 + NumFiles * 11 + (FileNum - 1) * 8
Get #PakFile, , FileLoc&
Get #PakFile, , FileLen&
Pack.Offset& = FileLoc& + 1
End Function
I'm also a little bit confused about the waitsync part.
Im trying it now for 1 week but I'm totally stuck
![[Image: sad.png]](https://qb64phoenix.com/forum/images/icons/sad.png){kind=icon}
.Thank you fot your help and work in advance.
Best regards,
Huggy
Admin Edit:
Removed the DIGIREAL.BMP as it was wanting to try and load as an image and couldn't (as it's a BIN file instead), so it just errored out and was inaccessible. You can now grab the file in the 7z archive and extract it without issue for testing and experimentation with the code above.
RE: Problem replacing legacy code with modern QB64 code - a740g - 01-27-2025
I will check this after work. But from a cursory look at your code - you can replace the OUT parts with _LIMIT and _PALETTECOLOR. OUT is emulated in QB64 and does not work exactly as it does under a non-protected mode OS like DOS.
RE: Problem replacing legacy code with modern QB64 code - HuggbardCeline - 01-27-2025
(01-27-2025, 12:11 PM)a740g Wrote: I will check this after work. But from a cursory look at your code - you can replace the OUT parts with _LIMIT and _PALETTECOLOR. OUT is emulated in QB64 and does not work exactly as it does under a non-protected mode OS like DOS.
Hi a740g,
oh man it would be really cool if you could fix it. I'm not good enough in QB64, not yet!.
For simpicity you could load a ball as an image and not from the .BIN file.
Best regards and many thanks,
Huggy
RE: Problem replacing legacy code with modern QB64 code - admin - 01-27-2025
Admin Edit:
Removed the DIGIREAL.BMP attachment from the original post, as it was wanting to try and load as an image and couldn't (as it's a BIN file instead), so it just errored out and was inaccessible. You can now grab the file in the 7z archive and extract it without issue for testing and experimentation with the code above.
File included here as well for ease of access:
RE: Problem replacing legacy code with modern QB64 code - SMcNeill - 01-27-2025
This works, AS IS, for me. It produces several nice red balls and rotates them around the screen in a nice little harmonious dance, without any issues.
All I had to do to get to this run is make one one simple change:
1) TAKE THE SPACE OUT OF THE BIN FILE NAME.
The file is "DIGIREAL(space).BIN". Rename it to "DIGIREAL.BIN" and it runs as expected, with no changes necessary.
RE: Problem replacing legacy code with modern QB64 code - Pete - 01-27-2025
I remember when I was 5, and wanted to learn how to ride a bike. I don't recall seeing the name "Harley Davidson" on the frame.
Plasma was a Guru back in the days of The QBasic Forum. My point being is yes, he has/had some really neat stuff, but I have to stretch my imagination to the breaking point to believe someone could easily start learning the language with one of his routines. Now if you can, wow, more power to you, but if you need help with putting together a program of your own you can always post some code, tell us what you are trying to get it to do, and get some advice and/or coding help.
Welcome to the forum. Please keep your hands and feet inside the IDE at all times. Steve's driving and besides, crash helmets are for girls.
Pete
RE: Problem replacing legacy code with modern QB64 code - a740g - 01-28-2025
I agree with Pete.
The code is over 2,000 lines of PEEK, POKE, DEFSEG, OUT, and WAIT - it certainly brings back a lot of memories! Porting all of this to modern QB64 is definitely possible, but it requires patience and time - both of which I am short on.
That said, I did manage to fix the music and get the code working as-is (well, mostly) with QB64-PE.
Enjoy!
RE: Problem replacing legacy code with modern QB64 code - Pete - 01-28-2025
See. Sam thinks crash helmets are for girls, too!
+1 to Sam for the update.
Pete
RE: Problem replacing legacy code with modern QB64 code - SMcNeill - 01-28-2025
And here I was thinking it worked as advertised for me. LOL! I often keep my speakers muted as I'm watching TV or listening to the radio with the PC running, for background noise. Never once did I think it was supposed to have sound and I'd just missed it.
RE: Problem replacing legacy code with modern QB64 code - Pete - 01-28-2025
Yes, sound certainly makes a difference. Without sound, musicals would be just a stupid waste of ******* time, but with sound, they're a ******* stupid waste of time. See the difference?
Pete