Brace yourself for quite a first in the world of FreeBASIC: squadrons and squadrons of custom pixel-based ships that will soon be yours for the taking, free to use the creation of your own games in FB. Yes, I am doing what I can to revive this FreeBASIC gaming community... with stuff like this!!! (^-^)v !!
For example, this all-new code from me lets you check out my own custom algorithms that I made which enables you to create a randomized pixel craft with a physical size of just almost 20x20 pixels each!!! Check it out:
Code: Select all
'======================================================================
' P i x e l C r a f t D e s i g n e r ( F r e e B A S I C )
'======================================================================
' For 8-bit color modes. The special custom version for 15- to 32-bit
' color graphics modes is gonna be built-in EXCLUSIVELY into the new
' AFlib2 Remixed!!!
'
' Presented by Adigun Azikiwe Polack.
' (c)2008 Adigun Azikiwe Polack. All Rights Reserved.
'======================================================================
Declare Sub GeneratePalette_Rel
Declare Sub MakeGradient ( Byval startcol as Integer, _
Byval r1 as Integer, Byval g1 as Integer, _
Byval b1 as Integer, _
Byval endcol as Integer, _
Byval r2 as Integer, Byval g2 as Integer, _
Byval b2 as Integer)
Declare Sub CreatePixelCraft_256color ( Byval x as integer, _
Byval y as integer, _
Byval ColSpread as integer, _
Byval Size_x as integer, _
Byval Size_y as integer )
Screenres 400, 300, 8, 0, 0
Dim rand as integer
GeneratePalette_Rel
NextPattern:
rand = int(rnd(1)* 155) + 101
Line(0, 0)-(400, 300), 1, bf
For ShipLine_x as Integer = 0 to 28 step 1
For ShipLine_y as Integer = 0 to 14 step 1
CreatePixelCraft_256color (ShipLine_x * 20) + 1, (ShipLine_y * 20) + 1, 0, 16, 17
Next
Next
sleep
IF multikey(&h01) then end else Goto NextPattern
Sub CreatePixelCraft_256color ( Byval x as integer, _
Byval y as integer, _
Byval ColSpread as integer, _
Byval Size_x as integer, _
Byval Size_y as integer )
If Size_x > 16 then Size_x = 16
If Size_y > 17 then Size_y = 17
Size_x /= 2
Size_y += 11
x -= 1
y -= 2
Dim as Integer ColRandom, OuterShell, Start
Start = (Size_x + 2)
For Vert as Integer = 0 to Size_y
Outershell = 1
If Vert < (Size_y / 2.1) then
Start -= 1: If Start < 0 then Start = 0
else
Start += 2
End if
For Horiz as Integer = Start to Size_x
If OuterShell > 0 then
If (int(rnd(1) * 70) + (1 + Vert)) > 35 - (Vert \ 2) or Vert = 0 and Horiz = (Size_x) or Horiz = (Size_x - 1) then
Pset (Horiz + x, Vert + y), 0
Pset (((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y), 0
OuterShell = 0
End if
Else
ColRandom = int(rnd(1) * 7) + 1
ColRandom += 1
If ColRandom > 8 then ColRandom = int(rnd(1) * 4) + int(rnd(1) * 4)
Select Case as const ColRandom
Case 1:
Pset (Horiz + x, Vert + y), 23 + (Colspread * 16)
Pset (((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y), 19 + (Colspread * 16)
Case 2:
Pset (Horiz + x, Vert + y), 24 + (Colspread * 16)
Pset (((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y), 20 + (Colspread * 16)
Case 3:
Pset (Horiz + x, Vert + y), 25 + (Colspread * 16)
Pset (((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y), 21 + (Colspread * 16)
Case 4:
Pset (Horiz + x, Vert + y), 26 + (Colspread * 16)
Pset (((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y), 22 + (Colspread * 16)
Case 5:
Pset (Horiz + x, Vert + y), 28 + (Colspread * 16)
Pset (((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y), 24 + (Colspread * 16)
Case 6:
Pset (Horiz + x, Vert + y), 31 + (Colspread * 16)
Pset (((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y), 27 + (Colspread * 16)
Case 7:
Pset (Horiz + x, Vert + y), 29 + (Colspread * 16)
Pset (((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y), 25 + (Colspread * 16)
Case 8:
Pset (Horiz + x, Vert + y), 0 + (Colspread * 16)
Pset (((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y), 0 + (Colspread * 16)
End Select
End if
Next
Next
End Sub
'_________________________________________________________________________
Sub GeneratePalette_Rel
'Special thanks to Richard Eric M. Lope (Relsoft) for his classic 256-color
'palette which inspired me to do this exact custom emulation of this one
'indeed!!! ^-^=b !
Dim as Integer SetupPalette, PaletteArrange
Dim as Single RGBchannel(1 to 3), Channel_Target, PalSet
Palette
For SetupPalette = 0 to 15 step 1
Select Case as Const SetupPalette
Case 0: Channel_Target = 0
Case 1: Channel_Target = 5
Case 2: Channel_Target = 8
Case 3: Channel_Target = 11
Case 4: Channel_Target = 14
Case 5: Channel_Target = 17
Case 6: Channel_Target = 20
Case 7: Channel_Target = 24
Case 8: Channel_Target = 28
Case 9: Channel_Target = 32
Case 10: Channel_Target = 36
Case 11: Channel_Target = 40
Case 12: Channel_Target = 45
Case 13: Channel_Target = 50
Case 14: Channel_Target = 56
Case 15: Channel_Target = 63
End Select
For PalSet = 1 to 3
RGBchannel(PalSet) = Channel_Target
Next
Palette 16 + SetupPalette, RGBchannel(1) + (256 * RGBchannel(2)) + (65536 * RGBchannel(3))
Next
For PaletteArrange = 2 to 15 step 1
For SetupPalette = 0 to 15 step 1
Select Case as Const SetupPalette
Case 0: Channel_Target = 0
Case 1: Channel_Target = 4
Case 2: Channel_Target = 8
Case 3: Channel_Target = 12
Case 4: Channel_Target = 16
Case 5: Channel_Target = 21
Case 6: Channel_Target = 25
Case 7: Channel_Target = 29
Case 8: Channel_Target = 33
Case 9: Channel_Target = 37
Case 10: Channel_Target = 42
Case 11: Channel_Target = 46
Case 12: Channel_Target = 50
Case 13: Channel_Target = 54
Case 14: Channel_Target = 58
Case 15: Channel_Target = 63
End Select
Select Case as Const PaletteArrange
Case 2:
RGBchannel(1) = Channel_Target
RGBchannel(2) = 0
RGBchannel(3) = 0
Case 3:
RGBchannel(1) = 0
RGBchannel(2) = 0
RGBchannel(3) = Channel_Target
Case 4:
RGBchannel(1) = 0
RGBchannel(2) = Channel_Target
RGBchannel(3) = 0
Case 5:
RGBchannel(1) = Channel_Target
RGBchannel(2) = 0
RGBchannel(3) = Channel_Target
Case 6:
RGBchannel(1) = 0
RGBchannel(2) = Channel_Target
RGBchannel(3) = Channel_Target
Case 7:
RGBchannel(1) = Channel_Target
RGBchannel(2) = Channel_Target
RGBchannel(3) = 0
Case 8:
RGBchannel(1) = Channel_Target
RGBchannel(2) = int(Channel_Target / 2)
RGBchannel(3) = 0
Case 9:
RGBchannel(1) = Channel_Target
RGBchannel(2) = 0
RGBchannel(3) = int(Channel_Target / 2)
Case 10:
RGBchannel(1) = 0
RGBchannel(2) = int(Channel_Target / 2)
RGBchannel(3) = Channel_Target
Case 11:
RGBchannel(1) = Channel_Target
RGBchannel(2) = int(Channel_Target / 1.5)
RGBchannel(3) = int(Channel_Target / 2)
Case 12:
RGBchannel(1) = Channel_Target
RGBchannel(2) = int(Channel_Target / 2)
RGBchannel(3) = int(Channel_Target / 2)
Case 13:
RGBchannel(1) = int(Channel_Target / 1.4)
RGBchannel(2) = int(Channel_Target / 2)
RGBchannel(3) = 0
Case 14:
RGBchannel(1) = 0
RGBchannel(2) = 0
RGBchannel(3) = 0
Case 15:
RGBchannel(1) = (int(Channel_Target / 2) + 32)
RGBchannel(2) = Channel_Target
RGBchannel(3) = 0
End Select
Palette (PaletteArrange * 16) + SetupPalette, RGBchannel(1) + (256 * RGBchannel(2)) + (65536 * RGBchannel(3))
Next
Next
End Sub
'_________________________________________________________________________
Sub MakeGradient (Byval startcol as Integer, _
Byval r1 as Integer, Byval g1 as Integer, _
Byval b1 as Integer, _
Byval endcol as Integer, _
Byval r2 as Integer, Byval g2 as Integer, _
Byval b2 as Integer)
'This command makes a gradient color by interpolating the RGB values of
'the first color index (startcol) and the second (endcol) by the number of
'colors.
Dim as Single R, G, B
Dim as Single Rstep, Gstep, Bstep
Dim as Single col, cols
If r1 <= -24 then r1 = -24
If g1 <= -24 then g1 = -24
If b1 <= -24 then b1 = -24
If r2 <= -24 then r2 = -24
If g2 <= -24 then g2 = -24
If b2 <= -24 then b2 = -24
If r1 >= 63 then r1 = 63
If g1 >= 63 then g1 = 63
If b1 >= 63 then b1 = 63
If r2 >= 63 then r2 = 63
If g2 >= 63 then g2 = 63
If b2 >= 63 then b2 = 63
If startcol > endcol then
Swap endcol, startcol
Swap r2, r1
Swap g2, g1
Swap b2, b1
End if
R = r1
G = g1
B = b1
cols = (endcol - startcol + 1)
Rstep = (r2 - r1 + 1) / cols
Gstep = (g2 - g1 + 1) / cols
Bstep = (b2 - b1 + 1) / cols
For col = startcol TO endcol
R = R + Rstep
G = G + Gstep
B = B + Bstep
If R > 63 then R = 63
If R < 0 then R = 0
If G > 63 then G = 63
If G < 0 then G = 0
If B > 63 then B = 63
If B < 0 then B = 0
Palette col, (65536 * (fix(B)) + (256 * fix(G)) + fix(R))
Next col
End Sub
And even better news is that I have created this specialized version entitled the “<i>Shmup Pixel Craft Generator</i>”, which touches up on this subject and more!! Created using both FB and the new AFlib2 Remixed and you can even generate and save your own custom true-color Pixel Craft creations to individual .BMP sprite sheets... download it here:
...and get started!!!
Thank you all so very much, and see you back with your thoughts. (^-^)v !