Experiment with these monsters and Mastergy's 3d points program
The 2 attached images are needed:
Code: (Select All)
'Space Monster Ritual - james2464 Nov 18 2022
'Modified 3d points program by Mastergy
'Includes Art and/or Code from Mini-Monster-Mixer v0.2 created by James D. Jarvis
Screen _NewImage(800, 600, 32)
spritesheet = _LoadImage("monsters64.png", 32)
_Delay .5
Dim sprites&(40)
For j = 0 To 39
sprites&(j) = _NewImage(64, 64, 32)
Next j
ct = 0
Dim c As Long
c = _RGB(0, 0, 0)
For k = 1 To 5
For j = 1 To 8
ct = ct + 1
_PutImage (1, 64)-(64, 1), spritesheet, sprites&(ct), (j * 64 - 63, k * 64 - 63)-(j * 64, k * 64)
'Cls
'_PutImage (1, 1), sprites&(ct)
'Sleep
Next j
Next k
For j = 0 To 39
_ClearColor c, sprites&(j)
Next j
'create texture
shadows = 100
Dim texture(shadows - 1)
text_size = 64
'For at = 0 To shadows - 1
'temp = _NewImage(text_size, text_size, 32)
'_Dest temp
'grey = 255 - 252 / (shadows - 1) * at
'Color _RGB(grey, grey, grey)
'Circle (text_size / 2, text_size / 2), text_size * .45
'Paint (text_size / 2, text_size / 2)
'texture(at) = _CopyImage(temp, 33)
'_FreeImage temp
'Next at
For j = 0 To 39
texture(j) = _CopyImage(sprites&(j), 33)
Next j
texture(0) = _LoadImage("qb64pe-64.png", 33)
'create 3D points in a spherical shape
points_c = 800
space_size = 1000
Dim points(points_c - 1, 2)
For ap = 0 To points_c - 1
Do
points(ap, 0) = space_size * Rnd
points(ap, 1) = space_size * Rnd
points(ap, 2) = space_size * Rnd
Loop While Sqr((points(ap, 0) - space_size / 2) ^ 2 + (points(ap, 1) - space_size / 2) ^ 2 + (points(ap, 2) - space_size / 2) ^ 2) > space_size / 2
Next ap
'create spectator
Dim Shared sp(6)
'sp(0) = space_size / 2 'X to center space
'sp(1) = space_size / 2 'Y to center space
'sp(2) = space_size / 2 'Z to center space
sp(0) = 350
sp(1) = 700
sp(2) = 470
sp(3) = -.644 'looking in the direction of the observer XZ
sp(4) = 0 'looking in the direction of the observer YZ
sp(5) = 1 'multiplier X-Y see
sp(6) = 1 'multiplier Z see
'create screen
scr = _NewImage(1000, 1000 / _DesktopWidth * _DesktopHeight, 32)
Screen scr
_MouseHide
_FullScreen
_Dest scr
_DisplayOrder _Hardware , _Software
'Print "turn with the mouse, move with the mouse buttons, adjust the light with the mouse wheel!"
brightness = 90
flag = 0
Do
_Limit 40
'====================================================================
If flag = 0 Then
ct = 0
For ap = 0 To points_c - 1
If ap > 2 Then
If (points(ap, 0)) > 550 Then
ct = ct + 1
points(ap, 0) = points(ap, 0) + Rnd * 2 - 1.5
Else
If points(ap, 0) < 450 Then
ct = ct + 1
points(ap, 0) = points(ap, 0) + Rnd * 2 - .5
End If
End If
If (points(ap, 1)) > 550 Then
ct = ct + 1
points(ap, 1) = points(ap, 1) + Rnd * 2 - 1.5
Else
If points(ap, 1) < 450 Then
ct = ct + 1
points(ap, 1) = points(ap, 1) + Rnd * 2 - .5
End If
End If
If (points(ap, 2)) > 550 Then
ct = ct + 1
points(ap, 2) = points(ap, 2) + Rnd * 2 - 1.5
Else
If points(ap, 2) < 450 Then
ct = ct + 1
points(ap, 2) = points(ap, 2) + Rnd * 2 - .5
End If
End If
End If
Next ap
If flag = 1 Then
ct2 = 0
For ap = 0 To points_c - 1
nrad = ap / points_c * (_Pi * 2.1)
nx = Cos(nrad) * 350 + 500
ny = Sin(nrad) * 350 + 500
If ap > 2 Then
If (points(ap, 0)) > nx + .1 Then
ct2 = ct2 + 1
points(ap, 0) = points(ap, 0) + Rnd * 2 - 1.5
Else
If points(ap, 0) < nx - .1 Then
ct2 = ct2 + 1
points(ap, 0) = points(ap, 0) + Rnd * 2 - .5
End If
End If
If (points(ap, 1)) > ny + .1 Then
ct2 = ct2 + 1
points(ap, 1) = points(ap, 1) + Rnd * 2 - 1.5
Else
If points(ap, 1) < ny - .1 Then
ct2 = ct2 + 1
points(ap, 1) = points(ap, 1) + Rnd * 2 - .5
End If
End If
If (points(ap, 2)) > 500.1 Then
ct2 = ct2 + 1
points(ap, 2) = points(ap, 2) + Rnd * 2 - 1.5
Else
If points(ap, 2) < 499.9 Then
ct2 = ct2 + 1
points(ap, 2) = points(ap, 2) + Rnd * 2 - .5
End If
End If
End If
Next ap
points(0, 0) = 500: points(0, 1) = 500: points(0, 2) = 470
points(1, 0) = 500: points(1, 1) = 500: points(1, 2) = 500
points(2, 0) = 500: points(2, 1) = 500: points(2, 2) = 530
If ct2 = 0 Then
flag = 2
sp(0) = 500
sp(1) = 1500
sp(2) = 470
sp(4) = 0
sp(3) = 0
_Delay 1
End If
End If
'====================================================================
If sp(0) < 500 Then
sp(0) = sp(0) + d1
Else
sp(0) = sp(0) - d1
End If
If sp(1) > 510 Then
sp(1) = sp(1) - d2
Else
sp(1) = sp(1) + d2
End If
dt = 0
If Abs(d1) < .002 Then dt = dt + 1
If Abs(d2) < .002 Then dt = dt + 1
If dt = 2 Then
flag = 3
sp(2) = 470
sp(4) = 0
sp(3) = 0
End If
End If
'draw points
For ap = 0 To points_c - 1
x = points(ap, 0)
y = points(ap, 1)
z = points(ap, 2)
rotate_to_maptriangle x, y, z 'position of points from the point of view of the observer
Sub rotate_to_maptriangle (x, y, z)
x2 = x - sp(0)
y2 = y - sp(1)
z2 = z - sp(2)
rotate_2d x2, y2, sp(3)
rotate_2d y2, z2, sp(4) + _Pi / 2
x = x2 * sp(5)
y = y2 * sp(5)
z = z2 * sp(6)
End Sub
Sub rotate_2d (x, y, ang)
x1 = x * Cos(ang) - y * Sin(ang)
y1 = x * Sin(ang) + y * Cos(ang)
x = x1: y = y1
End Sub
Mini-Monster-Mixer Version 0.3b (maybe it should be 0.4)
I adjusted how the colors for the parts are selected so each sheet will be a little more coherent with a slightly wider range.
Adjusted sizes a little bit.
If it doesn't have wings it stands near the bottom of the tile instead of floating like the winged critters.
Code: (Select All)
'Mini-Monster-Mixer v0.3b
'By James D. Jarvis November 2022
'This program uses BASIMAGE coded by Dav for QB64GL 1.4, MAY/2020
'
'generate a sprite sheet of monsters
'each is 64 by 64 pixels but code here can be modified to change that
'
'press c or s to save a sprite sheet to the clipboard so you can paste it into a paint program
'and save is whatever format you desire
'pres <esc> to quit
'
'License: Share sprite sheets as long as they include generated credit bar in image
'any programs using original code or graphics from source or generated by program
' please include the following (or equivalent) line somwhere in comments and documentation:
'Includes Art and/or Code from Mini-Monster-Mixer v0.3b created by James D. Jarvis
'
Randomize Timer
Dim Shared ms&
ms& = _NewImage(512, 360, 32)
Screen ms&
_Title "Mini-Monster-Mixer V0.3b"
Dim Shared part&
Dim Shared kk1 As _Unsigned Long
Dim Shared kk2 As _Unsigned Long
Dim Shared kk3 As _Unsigned Long
Dim Shared kk4 As _Unsigned Long
Dim Shared kk5 As _Unsigned Long
Dim Shared kk6 As _Unsigned Long
Dim Shared clr~&
part& = BASIMAGE1&
Type critterbody_type
head As Integer
arm As Integer
torso As Integer
leg As Integer
wing As Integer
k1 As _Unsigned Long
k2 As _Unsigned Long
k3 As _Unsigned Long
k4 As _Unsigned Long
k5 As _Unsigned Long
k6 As _Unsigned Long
xsiz As Integer
ysiz As Integer
End Type
monster_limit = 40
Dim klrset(12, 3) As Integer
Dim Shared mlook(monster_limit) As critterbody_type
_Source part&
'read the colors from the color reference bar whichever color is in the top left corner will be transparent
clr~& = Point(0, 0) 'find background color of image
kk1 = Point(0, 1): kk2 = Point(0, 2): kk3 = Point(0, 3): kk4 = Point(0, 4): kk5 = Point(0, 5): kk6 = Point(0, 6)
_Dest part&
Line (0, 0)-(0, 6), clr~& 'erase the color reference bar from the bit map
_ClearColor clr~&, ms& 'set background color as transparent
_ClearColor clr~&, part&
_Source ms&
_Dest ms&
Do
Cls
'build a color set for the sprite sheet
For k = 1 To 12
If k < 7 Then
klrset(k, 1) = Int(Rnd * 150 + 105)
If Rnd * 6 > 4.5 Then klrset(k, 1) = Int(Rnd * 200 + 55)
klrset(k, 2) = Int(Rnd * 150 + 105)
klrset(k, 3) = Int(Rnd * 150 + 105)
Else
klrset(k, 1) = Int(Rnd * 200 + 33)
klrset(k, 2) = Int(Rnd * 210 + 33)
klrset(k, 3) = Int(Rnd * 220 + 33)
If Rnd * 6 > 4.5 Then klrset(k, 1) = Int(Rnd * 100 + 55)
End If
Next k
mmx = 0: mmy = 0
For m = 1 To monster_limit
'create a new set of monster sprites
'included image source has 16 options for head,arms,torso, and legs
mlook(m).head = Int(1 + Rnd * 16)
mlook(m).arm = Int(1 + Rnd * 16)
mlook(m).torso = Int(1 + Rnd * 16)
mlook(m).leg = Int(1 + Rnd * 16)
mlook(m).wing = Int(1 + Rnd * 86)
'determing colors for this specific monster sprite
kr = klrset(1 + Int(Rnd * 6), 1): kg = klrset(1 + Int(Rnd * 6), 2): kb = klrset(1 + Int(Rnd * 6), 3)
kr2 = Int(kr / 2): kg2 = Int(kg / 2): kb2 = Int(kb / 2)
kr3 = Int(kr2 / (1.2 + Rnd * 3)): kg3 = Int(kg2 / (1.2 + Rnd * 3)): kb3 = Int(kb2 / (1.2 + Rnd * 3))
mlook(m).k1 = _RGB32(kr, kg, kb)
mlook(m).k2 = _RGB32(kr2, kg2, kb2)
mlook(m).k3 = _RGB32(kr3, kg3, kb3)
mlook(m).k4 = _RGB32(klrset(1 + Int(Rnd * 12), 1) - 10, klrset(1 + Int(Rnd * 12), 2) - 10, klrset(1 + Int(Rnd * 12), 3) - 10)
kr = klrset(7 + Int(Rnd * 6), 1): kg = klrset(7 + Int(Rnd * 6), 2): kb = klrset(7 + Int(Rnd * 6), 3)
mlook(m).k5 = _RGB32(kr, kg, kb)
mlook(m).k6 = _RGB32(Int(kr / (2 + Rnd * 2)), Int(kg / (2 + Rnd * 2)), Int(kb / (2 + Rnd * 2)))
mlook(m).xsiz = 64 - Int(Rnd * 40) + Int(Rnd * 4)
If mlook(m).xsiz > 64 Then mlook(m).xsiz = 64
mlook(m).ysiz = 64 - Int(Rnd * 36) + Int(Rnd * 4)
If mlook(m).ysiz > 64 Then mlook(m).ysiz = 64
draw_monster mmx, mmy, m, 6
mmx = mmx + 64
If mmx >= _Width Then
mmx = 0
mmy = mmy + 64
End If
Next m
md$ = "Monster Sprite Sheet generated " + Date$ + " at " + Time$
md2$ = "Using Mini-Monster-Mixer V0.3b by James D. Jarvis"
_PrintString (0, 321), md$
_PrintString (0, 337), md2$
Do
_Limit 60
kk$ = InKey$
Loop Until kk$ <> ""
If kk$ = "C" Or kk$ = "c" Or kk$ = "S" Or kk$ = "s" Then
_ClipboardImage = ms&
_Delay 0.3
Locate 1, 1: Print "Sprite Sheet Saved to Clipboard"
Sleep 3
End If
Loop Until kk$ = Chr$(27)
_FreeImage part&
System
Sub draw_monster (Mx, my, mid, scale)
'generate a monster image from source sprite sheet part& and render to the programs main screen ms&
tempi& = _NewImage(32, 32, 32)
'tempi& creates a temporary one sprite image for rendering
_ClearColor clr~&, tempi&
_Dest tempi&
Cls
hs = Int(Rnd * (scale * 2))
If mlook(mid).wing < 17 Then _PutImage (0, 0)-(31, 31), part&, tempi&, ((mlook(mid).wing - 1) * 32, 128)-((mlook(mid).wing - 1) * 32 + 31, 128 + 31)
If mlook(mid).wing > 16 Then
_PutImage (0, 0)-(31, 31), part&, tempi&, ((mlook(mid).leg - 1) * 32, 96)-((mlook(mid).leg - 1) * 32 + 31, 96 + 31)
Else
If Rnd * 100 < 67 Then _PutImage (0, 0)-(31, 31), part&, tempi&, ((mlook(mid).leg - 1) * 32, 96)-((mlook(mid).leg - 1) * 32 + 31, 96 + 31)
End If
If mlook(mid).wing > 16 Then
_PutImage (0, 0)-(31, 31), part&, tempi&, ((mlook(mid).arm - 1) * 32, 32)-((mlook(mid).arm - 1) * 32 + 31, 32 + 31)
Else
If Rnd * 100 < 67 Then _PutImage (0, 0)-(31, 31), part&, tempi&, ((mlook(mid).arm - 1) * 32, 32)-((mlook(mid).arm - 1) * 32 + 31, 32 + 31)
End If
_PutImage (0 - Int(hs * .8), 0)-(31 + Int(hs * .8), 31), part&, tempi&, ((mlook(mid).torso - 1) * 32, 64)-((mlook(mid).torso - 1) * 32 + 31, 64 + 31)
_PutImage (0 - hs, 0)-(31 + hs, 31), part&, tempi&, ((mlook(mid).head - 1) * 32, 0)-((mlook(mid).head - 1) * 32 + 31, 31)
_Source tempi&
'repaint source image with generate color values for new monster sprite
For y = 0 To 31
For x = 0 To 31
Select Case Point(x, y)
Case kk1
PSet (x, y), mlook(mid).k1
Case kk2
PSet (x, y), mlook(mid).k2
Case kk3
PSet (x, y), mlook(mid).k3
Case kk4
PSet (x, y), mlook(mid).k4
Case kk5
PSet (x, y), mlook(mid).k5
Case kk6
PSet (x, y), mlook(mid).k6
End Select
Next x
Next y
'generated image in tempi& is rendered to ms& as a 64 by 64 sprite
If mlook(mid).xsiz = 64 And mlook(mid).ysiz = 64 Then
_PutImage (Mx, my)-(Mx + 63, my + 63), tempi&, ms&
Else
tx = Mx: ty = my
tx = tx + Int(64 - mlook(mid).xsiz) / 2
If mlook(mid).wing < 17 Then
ty = ty + Int((64 - mlook(mid).ysiz) / 2)
Else
ty = ty + (64 - mlook(mid).ysiz)
End If
_PutImage (tx, ty)-(tx + mlook(mid).xsiz - 1, ty + mlook(mid).ysiz - 1), tempi&, ms&
End If
_Source ms&
_Dest ms&
_FreeImage tempi&
End Sub
Added 24 additional heads (which may need some refining) and an alternate pose set with 12 variations of forequarters and 12 variations of hindquarters to produce heraldic beasts.
Code: (Select All)
'Mini-Monster-Mixer v0.4
'By James D. Jarvis November 2022
'This program uses BASIMAGE coded by Dav for QB64GL 1.4, MAY/2020
'
'generate a sprite sheet of monsters
'each is 64 by 64 pixels but code here can be modified to change that
'
'press c or s to save a sprite sheet to the clipboard so you can paste it into a paint program
'and save is whatever format you desire
'pres <esc> to quit
'
'License: Share sprite sheets as long as they include generated credit bar in image
'any programs using original code or graphics from source or generated by program
' please include the following (or equivalent) line somewhere in comments and documentation:
'Includes Art and/or Code from Mini-Monster-Mixer v0.4 created by James D. Jarvis
'
Randomize Timer
Dim Shared ms&
ms& = _NewImage(512, 360, 32)
Screen ms&
_Title "Mini-Monster-Mixer V0.4"
Dim Shared part&
Dim Shared part2&
Dim Shared kk1 As _Unsigned Long
Dim Shared kk2 As _Unsigned Long
Dim Shared kk3 As _Unsigned Long
Dim Shared kk4 As _Unsigned Long
Dim Shared kk5 As _Unsigned Long
Dim Shared kk6 As _Unsigned Long
Dim Shared clr~&
part& = BASIMAGE1&
part2& = BASIMAGE2&
Type critterbody_type
head As Integer
arm As Integer
torso As Integer
leg As Integer
wing As Integer
k1 As _Unsigned Long
k2 As _Unsigned Long
k3 As _Unsigned Long
k4 As _Unsigned Long
k5 As _Unsigned Long
k6 As _Unsigned Long
xsiz As Integer
ysiz As Integer
End Type
monster_limit = 40
Dim klrset(12, 3) As Integer
Dim Shared mlook(monster_limit) As critterbody_type
_Source part&
'read the colors from the color reference bar whichever color is in the top left corner will be transparent
clr~& = Point(0, 0) 'find background color of image
kk1 = Point(0, 1): kk2 = Point(0, 2): kk3 = Point(0, 3): kk4 = Point(0, 4): kk5 = Point(0, 5): kk6 = Point(0, 6)
_Dest part&
Line (0, 0)-(0, 6), clr~& 'erase the color reference bar from the bit map
_Dest part2&
Line (0, 0)-(0, 6), clr~& 'erase the color reference bar from the bit map
_ClearColor clr~&, ms& 'set background color as transparent
_ClearColor clr~&, part&
_ClearColor clr~&, part2&
_Source ms&
_Dest ms&
Do
Cls
'build a color set for the sprite sheet
For k = 1 To 12
If k < 7 Then
klrset(k, 1) = Int(Rnd * 150 + 105)
If Rnd * 6 > 4.5 Then klrset(k, 1) = Int(Rnd * 200 + 55)
klrset(k, 2) = Int(Rnd * 150 + 105)
klrset(k, 3) = Int(Rnd * 150 + 105)
Else
klrset(k, 1) = Int(Rnd * 200 + 33)
klrset(k, 2) = Int(Rnd * 210 + 33)
klrset(k, 3) = Int(Rnd * 220 + 33)
If Rnd * 6 > 4.5 Then klrset(k, 1) = Int(Rnd * 100 + 55)
End If
Next k
mmx = 0: mmy = 0
For m = 1 To monster_limit
'create a new set of monster sprites
'included image source has 16 options for head,arms,torso, and legs
mlook(m).head = Int(1 + Rnd * 40)
mlook(m).arm = Int(1 + Rnd * 16)
If mlook(m).head > 16 Then mlook(m).arm = Int(1 + Rnd * 28)
If mlook(m).arm > 16 Then
mlook(m).torso = 0
mlook(m).leg = Int(17 + Rnd * 12)
mlook(m).wing = 66
Else
mlook(m).torso = Int(1 + Rnd * 16)
mlook(m).leg = Int(1 + Rnd * 16)
mlook(m).wing = Int(1 + Rnd * 86)
End If
'determing colors for this specific monster sprite
kr = klrset(1 + Int(Rnd * 6), 1): kg = klrset(1 + Int(Rnd * 6), 2): kb = klrset(1 + Int(Rnd * 6), 3)
kr2 = Int(kr / 2): kg2 = Int(kg / 2): kb2 = Int(kb / 2)
kr3 = Int(kr2 / (1.2 + Rnd * 3)): kg3 = Int(kg2 / (1.2 + Rnd * 3)): kb3 = Int(kb2 / (1.2 + Rnd * 3))
mlook(m).k1 = _RGB32(kr, kg, kb)
mlook(m).k2 = _RGB32(kr2, kg2, kb2)
mlook(m).k3 = _RGB32(kr3, kg3, kb3)
mlook(m).k4 = _RGB32(klrset(1 + Int(Rnd * 12), 1) - 10, klrset(1 + Int(Rnd * 12), 2) - 10, klrset(1 + Int(Rnd * 12), 3) - 10)
kr = klrset(7 + Int(Rnd * 6), 1): kg = klrset(7 + Int(Rnd * 6), 2): kb = klrset(7 + Int(Rnd * 6), 3)
mlook(m).k5 = _RGB32(kr, kg, kb)
mlook(m).k6 = _RGB32(Int(kr / (2 + Rnd * 2)), Int(kg / (2 + Rnd * 2)), Int(kb / (2 + Rnd * 2)))
mlook(m).xsiz = 64 - Int(Rnd * 40) + Int(Rnd * 4)
If mlook(m).xsiz > 64 Then mlook(m).xsiz = 64
mlook(m).ysiz = 64 - Int(Rnd * 36) + Int(Rnd * 4)
If mlook(m).ysiz > 64 Then mlook(m).ysiz = 64
draw_monster mmx, mmy, m, 6
mmx = mmx + 64
If mmx >= _Width Then
mmx = 0
mmy = mmy + 64
End If
Next m
md$ = "Monster Sprite Sheet generated " + Date$ + " at " + Time$
md2$ = "Using Mini-Monster-Mixer V0.4 by James D. Jarvis"
_PrintString (0, 321), md$
_PrintString (0, 337), md2$
Do
_Limit 60
kk$ = InKey$
Loop Until kk$ <> ""
If kk$ = "C" Or kk$ = "c" Or kk$ = "S" Or kk$ = "s" Then
_ClipboardImage = ms&
_Delay 0.3
Locate 1, 1: Print "Sprite Sheet Saved to Clipboard"
Sleep 3
End If
Loop Until kk$ = Chr$(27)
_FreeImage part&
System
Sub draw_monster (Mx, my, mid, scale)
'generate a monster image from source sprite sheet part& and render to the programs main screen ms&
tempi& = _NewImage(64, 64, 32)
'tempi& creates a temporary one sprite image for rendering
_ClearColor clr~&, tempi&
_Dest tempi&
Cls
hs = Int(Rnd * (scale * 2))
If mlook(mid).wing < 17 Then _PutImage (0, 0)-(31, 31), part&, tempi&, ((mlook(mid).wing - 1) * 32, 128)-((mlook(mid).wing - 1) * 32 + 31, 128 + 31)
If mlook(mid).wing > 16 Then
If mlook(mid).arm < 17 Then
_PutImage (0, 0)-(31, 31), part&, tempi&, ((mlook(mid).leg - 1) * 32, 96)-((mlook(mid).leg - 1) * 32 + 31, 96 + 31)
Else
_PutImage (0 + 19, 0 + 31)-(31 + 19, 31 + 31), part2&, tempi&, ((mlook(mid).leg - 5) * 32, 32)-((mlook(mid).leg - 5) * 32 + 31, 32 + 31)
End If
Else
If Rnd * 100 < 67 Then _PutImage (0, 0)-(31, 31), part&, tempi&, ((mlook(mid).leg - 1) * 32, 96)-((mlook(mid).leg - 1) * 32 + 31, 96 + 31)
End If
If mlook(mid).wing > 16 Then
If mlook(mid).arm < 17 Then _PutImage (0, 0)-(31, 31), part&, tempi&, ((mlook(mid).arm - 1) * 32, 32)-((mlook(mid).arm - 1) * 32 + 31, 32 + 31)
If mlook(mid).arm > 16 Then _PutImage (7, 12)-(38, 43), part2&, tempi&, ((mlook(mid).arm - 17) * 32, 32)-((mlook(mid).arm - 17) * 32 + 31, 32 + 31)
Else
If Rnd * 100 < 67 Then _PutImage (0, 0)-(31, 31), part&, tempi&, ((mlook(mid).arm - 1) * 32, 32)-((mlook(mid).arm - 1) * 32 + 31, 32 + 31)
End If
_PutImage (0 - Int(hs * .8), 0)-(31 + Int(hs * .8), 31), part&, tempi&, ((mlook(mid).torso - 1) * 32, 64)-((mlook(mid).torso - 1) * 32 + 31, 64 + 31)
If mlook(mid).head < 17 Then
_PutImage (0 - hs, 0)-(31 + hs, 31), part&, tempi&, ((mlook(mid).head - 1) * 32, 0)-((mlook(mid).head - 1) * 32 + 31, 31)
Else
If mlook(mid).arm > 16 Then
_PutImage (7, 0)-(38, 31), part2&, tempi&, ((mlook(mid).head - 17) * 32, 0)-((mlook(mid).head - 17) * 32 + 31, 31)
Else
_PutImage (1, -6)-(32, 25), part2&, tempi&, ((mlook(mid).head - 17) * 32, 0)-((mlook(mid).head - 17) * 32 + 31, 31)
End If
End If
_Source tempi&
'repaint source image with generate color values for new monster sprite
For y = 0 To 63
For x = 0 To 63
Select Case Point(x, y)
Case kk1
PSet (x, y), mlook(mid).k1
Case kk2
PSet (x, y), mlook(mid).k2
Case kk3
PSet (x, y), mlook(mid).k3
Case kk4
PSet (x, y), mlook(mid).k4
Case kk5
PSet (x, y), mlook(mid).k5
Case kk6
PSet (x, y), mlook(mid).k6
End Select
Next x
Next y
'generated image in tempi& is rendered to ms& as a 64 by 64 sprite
If mlook(mid).xsiz = 64 And mlook(mid).ysiz = 64 Then
If mlook(mid).arm < 17 Then
_PutImage (Mx, my)-(Mx + 63, my + 63), tempi&, ms&, (0, 0)-(31, 31)
Else
_PutImage (Mx, my)-(Mx + 63, my + 63), tempi&, ms&, (0, 0)-(63, 63)
End If
Else
tx = Mx: ty = my
tx = tx + Int(64 - mlook(mid).xsiz) / 2
If mlook(mid).wing < 17 Then
ty = ty + Int((64 - mlook(mid).ysiz) / 2)
Else
ty = ty + (64 - mlook(mid).ysiz)
End If
If mlook(mid).arm < 17 Then
_PutImage (tx, ty)-(tx + mlook(mid).xsiz - 1, ty + mlook(mid).ysiz - 1), tempi&, ms&, (0, 0)-(31, 31)
Else
_PutImage (Mx, my)-(Mx + 63, my + 63), tempi&, ms&, (0, 0)-(63, 63)
End If
End If
_Source ms&
_Dest ms&
_FreeImage tempi&
End Sub
07-15-2023, 01:13 AM (This post was last modified: 07-15-2023, 01:27 AM by Dav.)
(07-15-2023, 12:50 AM)grymmjack Wrote: This isn't working in QB64 PE v3.8.0
I'm getting:
Memory out of range on line 419:
Code: (Select All)
_MemPut m, m.OFFSET, btemp$: _MemFree m
It's because of my BASIMAGE routine and the _INFLATE issue with QB64PE v3.7 and higher that @Steffan-68 recently brought to my attention. The quick fix is easy however, thanks to Steffan:
Change all the lines that say: btemp$ = _INFLATE$(btemp$)
Into this instead: btemp$ = _INFLATE$(btemp$, m.SIZE)
I'm going to redo my BASIMAGE program to correct this, and update my code that uses SUB's made with it.
(07-15-2023, 12:50 AM)grymmjack Wrote: This isn't working in QB64 PE v3.8.0
I'm getting:
Memory out of range on line 419:
Code: (Select All)
_MemPut m, m.OFFSET, btemp$: _MemFree m
It's because of my BASIMAGE routine and the _INFLATE issue with QB64PE v3.7 and higher that @Steffan-68 recently brought to my attention. The quick fix is easy however, thanks to Steffan:
Change all the lines that say: btemp$ = _INFLATE$(btemp$)
Into this instead: btemp$ = _INFLATE$(btemp$, m.SIZE)
I'm going to redo my BASIMAGE program to correct this, and update my code that uses SUB's made with it.
'Mini-Monster-Mixer v0.45
'By James D. Jarvis July 2023
'This program uses BASIMAGE coded by Dav
'
'generate a sprite sheet of monsters
'each is 64 by 64 pixels but code here can be modified to change that
'
'press c or s to save a sprite sheet to the clipboard so you can paste it into a paint program
'and save is whatever format you desire
'pres <esc> to quit
'
'License: Share sprite sheets as long as they include generated credit bar in image
'any programs using original code or graphics from source or generated by program
' please include the following (or equivalent) line somewhere in comments and documentation:
'Includes Art and/or Code from Mini-Monster-Mixer v0.4 created by James D. Jarvis
'
Randomize Timer
Dim Shared ms&
ms& = _NewImage(512, 360, 32)
Screen ms&
_Title "Mini-Monster-Mixer V0.45"
Dim Shared part&
Dim Shared part2&
Dim Shared kk1 As _Unsigned Long
Dim Shared kk2 As _Unsigned Long
Dim Shared kk3 As _Unsigned Long
Dim Shared kk4 As _Unsigned Long
Dim Shared kk5 As _Unsigned Long
Dim Shared kk6 As _Unsigned Long
Dim Shared clr~&
part& = BASIMAGE1&
part2& = BASIMAGE2&
Type critterbody_type
head As Integer
arm As Integer
torso As Integer
leg As Integer
wing As Integer
k1 As _Unsigned Long
k2 As _Unsigned Long
k3 As _Unsigned Long
k4 As _Unsigned Long
k5 As _Unsigned Long
k6 As _Unsigned Long
xsiz As Integer
ysiz As Integer
End Type
monster_limit = 40
Dim klrset(12, 3) As Integer
Dim Shared mlook(monster_limit) As critterbody_type
_Source part&
'read the colors from the color reference bar whichever color is in the top left corner will be transparent
clr~& = Point(0, 0) 'find background color of image
kk1 = Point(0, 1): kk2 = Point(0, 2): kk3 = Point(0, 3): kk4 = Point(0, 4): kk5 = Point(0, 5): kk6 = Point(0, 6)
_Dest part&
Line (0, 0)-(0, 6), clr~& 'erase the color reference bar from the bit map
_Dest part2&
Line (0, 0)-(0, 6), clr~& 'erase the color reference bar from the bit map
_ClearColor clr~&, ms& 'set background color as transparent
_ClearColor clr~&, part&
_ClearColor clr~&, part2&
_Source ms&
_Dest ms&
Do
Cls
'build a color set for the sprite sheet
For k = 1 To 12
If k < 7 Then
klrset(k, 1) = Int(Rnd * 150 + 105)
If Rnd * 6 > 4.5 Then klrset(k, 1) = Int(Rnd * 200 + 55)
klrset(k, 2) = Int(Rnd * 150 + 105)
klrset(k, 3) = Int(Rnd * 150 + 105)
Else
klrset(k, 1) = Int(Rnd * 200 + 33)
klrset(k, 2) = Int(Rnd * 210 + 33)
klrset(k, 3) = Int(Rnd * 220 + 33)
If Rnd * 6 > 4.5 Then klrset(k, 1) = Int(Rnd * 100 + 55)
End If
Next k
mmx = 0: mmy = 0
For m = 1 To monster_limit
'create a new set of monster sprites
'included image source has 16 options for head,arms,torso, and legs
mlook(m).head = Int(1 + Rnd * 40)
mlook(m).arm = Int(1 + Rnd * 16)
If mlook(m).head > 16 Then mlook(m).arm = Int(1 + Rnd * 28)
If mlook(m).arm > 16 Then
mlook(m).torso = 0
mlook(m).leg = Int(17 + Rnd * 12)
mlook(m).wing = 66
Else
mlook(m).torso = Int(1 + Rnd * 16)
mlook(m).leg = Int(1 + Rnd * 16)
mlook(m).wing = Int(1 + Rnd * 86)
End If
'determing colors for this specific monster sprite
kr = klrset(1 + Int(Rnd * 6), 1): kg = klrset(1 + Int(Rnd * 6), 2): kb = klrset(1 + Int(Rnd * 6), 3)
kr2 = Int(kr / 2): kg2 = Int(kg / 2): kb2 = Int(kb / 2)
kr3 = Int(kr2 / (1.2 + Rnd * 3)): kg3 = Int(kg2 / (1.2 + Rnd * 3)): kb3 = Int(kb2 / (1.2 + Rnd * 3))
mlook(m).k1 = _RGB32(kr, kg, kb)
mlook(m).k2 = _RGB32(kr2, kg2, kb2)
mlook(m).k3 = _RGB32(kr3, kg3, kb3)
mlook(m).k4 = _RGB32(klrset(1 + Int(Rnd * 12), 1) - 10, klrset(1 + Int(Rnd * 12), 2) - 10, klrset(1 + Int(Rnd * 12), 3) - 10)
kr = klrset(7 + Int(Rnd * 6), 1): kg = klrset(7 + Int(Rnd * 6), 2): kb = klrset(7 + Int(Rnd * 6), 3)
mlook(m).k5 = _RGB32(kr, kg, kb)
mlook(m).k6 = _RGB32(Int(kr / (2 + Rnd * 2)), Int(kg / (2 + Rnd * 2)), Int(kb / (2 + Rnd * 2)))
mlook(m).xsiz = 64 - Int(Rnd * 40) + Int(Rnd * 4)
If mlook(m).xsiz > 64 Then mlook(m).xsiz = 64
mlook(m).ysiz = 64 - Int(Rnd * 36) + Int(Rnd * 4)
If mlook(m).ysiz > 64 Then mlook(m).ysiz = 64
draw_monster mmx, mmy, m, 6
mmx = mmx + 64
If mmx >= _Width Then
mmx = 0
mmy = mmy + 64
End If
Next m
md$ = "Monster Sprite Sheet generated " + Date$ + " at " + Time$
md2$ = "Using Mini-Monster-Mixer V0.45 by James D. Jarvis"
_PrintString (0, 321), md$
_PrintString (0, 337), md2$
Do
_Limit 60
kk$ = InKey$
Loop Until kk$ <> ""
If kk$ = "C" Or kk$ = "c" Or kk$ = "S" Or kk$ = "s" Then
_ClipboardImage = ms&
_Delay 0.3
Locate 1, 1: Print "Sprite Sheet Saved to Clipboard"
Sleep 3
End If
Loop Until kk$ = Chr$(27)
_FreeImage part&
System
Sub draw_monster (Mx, my, mid, scale)
'generate a monster image from source sprite sheet part& and render to the programs main screen ms&
tempi& = _NewImage(64, 64, 32)
'tempi& creates a temporary one sprite image for rendering
_ClearColor clr~&, tempi&
_Dest tempi&
Cls
hs = Int(Rnd * (scale * 2))
If mlook(mid).wing < 17 Then _PutImage (0, 0)-(31, 31), part&, tempi&, ((mlook(mid).wing - 1) * 32, 128)-((mlook(mid).wing - 1) * 32 + 31, 128 + 31)
If mlook(mid).wing > 16 Then
If mlook(mid).arm < 17 Then
_PutImage (0, 0)-(31, 31), part&, tempi&, ((mlook(mid).leg - 1) * 32, 96)-((mlook(mid).leg - 1) * 32 + 31, 96 + 31)
Else
_PutImage (0 + 19, 0 + 31)-(31 + 19, 31 + 31), part2&, tempi&, ((mlook(mid).leg - 5) * 32, 32)-((mlook(mid).leg - 5) * 32 + 31, 32 + 31)
End If
Else
If Rnd * 100 < 67 Then _PutImage (0, 0)-(31, 31), part&, tempi&, ((mlook(mid).leg - 1) * 32, 96)-((mlook(mid).leg - 1) * 32 + 31, 96 + 31)
End If
If mlook(mid).wing > 16 Then
If mlook(mid).arm < 17 Then _PutImage (0, 0)-(31, 31), part&, tempi&, ((mlook(mid).arm - 1) * 32, 32)-((mlook(mid).arm - 1) * 32 + 31, 32 + 31)
If mlook(mid).arm > 16 Then _PutImage (7, 12)-(38, 43), part2&, tempi&, ((mlook(mid).arm - 17) * 32, 32)-((mlook(mid).arm - 17) * 32 + 31, 32 + 31)
Else
If Rnd * 100 < 67 Then _PutImage (0, 0)-(31, 31), part&, tempi&, ((mlook(mid).arm - 1) * 32, 32)-((mlook(mid).arm - 1) * 32 + 31, 32 + 31)
End If
_PutImage (0 - Int(hs * .8), 0)-(31 + Int(hs * .8), 31), part&, tempi&, ((mlook(mid).torso - 1) * 32, 64)-((mlook(mid).torso - 1) * 32 + 31, 64 + 31)
If mlook(mid).head < 17 Then
_PutImage (0 - hs, 0)-(31 + hs, 31), part&, tempi&, ((mlook(mid).head - 1) * 32, 0)-((mlook(mid).head - 1) * 32 + 31, 31)
Else
If mlook(mid).arm > 16 Then
_PutImage (7, 0)-(38, 31), part2&, tempi&, ((mlook(mid).head - 17) * 32, 0)-((mlook(mid).head - 17) * 32 + 31, 31)
Else
_PutImage (1, -6)-(32, 25), part2&, tempi&, ((mlook(mid).head - 17) * 32, 0)-((mlook(mid).head - 17) * 32 + 31, 31)
End If
End If
_Source tempi&
'repaint source image with generate color values for new monster sprite
For y = 0 To 63
For x = 0 To 63
Select Case Point(x, y)
Case kk1
PSet (x, y), mlook(mid).k1
Case kk2
PSet (x, y), mlook(mid).k2
Case kk3
PSet (x, y), mlook(mid).k3
Case kk4
PSet (x, y), mlook(mid).k4
Case kk5
PSet (x, y), mlook(mid).k5
Case kk6
PSet (x, y), mlook(mid).k6
End Select
Next x
Next y
'generated image in tempi& is rendered to ms& as a 64 by 64 sprite
If mlook(mid).xsiz = 64 And mlook(mid).ysiz = 64 Then
If mlook(mid).arm < 17 Then
_PutImage (Mx, my)-(Mx + 63, my + 63), tempi&, ms&, (0, 0)-(31, 31)
Else
_PutImage (Mx, my)-(Mx + 63, my + 63), tempi&, ms&, (0, 0)-(63, 63)
End If
Else
tx = Mx: ty = my
tx = tx + Int(64 - mlook(mid).xsiz) / 2
If mlook(mid).wing < 17 Then
ty = ty + Int((64 - mlook(mid).ysiz) / 2)
Else
ty = ty + (64 - mlook(mid).ysiz)
End If
If mlook(mid).arm < 17 Then
_PutImage (tx, ty)-(tx + mlook(mid).xsiz - 1, ty + mlook(mid).ysiz - 1), tempi&, ms&, (0, 0)-(31, 31)
Else
_PutImage (Mx, my)-(Mx + 63, my + 63), tempi&, ms&, (0, 0)-(63, 63)
End If
End If
_Source ms&
_Dest ms&
_FreeImage tempi&
End Sub