Here is the code for the "wicked" scroller
'=================================================================
' By: Scott Shaver
'=================================================================
Strict
Framework BRL.GlMax2D
Import BRL.System
Import BRL.Basic
Import BRL.Retro
Import BRL.Max2D
Import BRL.pngloader
Graphics 640,480,32',60
'=================================================================
Incbin "mom_child.png"
Global mom:TImage = LoadImage("incbin::mom_child.png")
Global momImage:LineImage = LineImage.Create(mom)',0,255,255,255)
momImage.SetColorFunction(SetMomDrawColor) ' use this function to set the color when drawing
Incbin "hansolo_crisp.png"
Global font:TImage = LoadAnimImage("incbin::hansolo_crisp.png",32,32,0,128,FILTEREDIMAGE|MASKEDIMAGE|DYNAMICIMAGE)
Global lif:LineImageFont = LineImageFont.Create(font,0,0,0,90,-1)
lif.SetColorFunction(SetFontDrawColor) ' use this function to set the color when drawing
'lif.SetCoordFunction(SetFontCoordOffset) ' use this function to modify the draw coords
Incbin "hbar.png"
Global hbar:TImage = LoadImage("incbin::hbar.png")
MidHandleImage(hbar)
Global ang:Double=0
Global ang2:Double=0
Global tilt:Float=0'.5
Global tiltOff:Float=.01
Global scrollerx:Float=GraphicsWidth()
SetClsColor(100,100,200)
'lif.rotate(0,75,0)
'=================================================================
While Not KeyHit(KEY_ESCAPE)
Cls
SetScale(1,1)
'lif.DrawFont(tilt,False,0,0)
lif.rotate(4,0,0)
SetScale(1,1)
'momImage.Draw(320+Cos(ang2)*220,240+Sin(ang2)*140,tilt,False)
'momImage.rotate(0,0,1)
ang:+4
ang2:+1
'tilt:+tiltOff
'If tiltOff>0 And tilt>1 Then tiltOff=-.01
'If tiltOff<0 And tilt<-1 Then tiltOff=.01
Local msg:String = " WICKED SCROLLER! BROUGHT TO YOU BY ZPARTICLE! I HAVE ONLY EVER SEEN THIS IN ONE DEMO AND I THOUGHT IT WAS TOTALLY COOL! "
lif.DrawString(scrollerx,GraphicsHeight()/2,msg,0,0,0)
If scrollerx<=-Len(msg)*32 Then scrollerx=GraphicsWidth()
scrollerx:-1
Flip
Wend
End
'=================================================================
Function SetMomDrawColor(x:Int,y:Int,z:Int)
SetColor(Abs(255*Cos(x+ang2)),Abs(255*Sin(y+ang2)),Abs(255*Cos(y+ang2)))
End Function
'=================================================================
Function SetFontDrawColor(x:Int,y:Int,z:Int)
'SetColor(Abs(255*Cos(y+ang)),Abs(255*Sin(y+ang)),Abs(255*Cos(y+ang)))
SetColor(175+(5*z),175+(5*z),50+(5*z))
End Function
'=================================================================
Function SetFontCoordOffset(x:Double Var,y:Double Var)
x :+ Sin(y/.25+ang)*4
End Function
'=================================================================
' this type holds the coordinates for a line segment
'=================================================================
Type Line
Field x1:Double,y1:Double,x2:Double,y2:Double,z1:Double=15,z2:Double=15
Field SetDrawColor(x:Int,y:Int,z:Int) = Null
Field SetCoordOffset(x:Double Var,y:Double Var) = Null
Method compare:Int(o:Object)
Local s:Line = Line(o)
If Not s Then Return 1
Return z1 - s.z1
End Method
Method SetColorFunction(SetDrawColor(x:Int,y:Int,z:Int))
self.SetDrawColor = SetDrawColor
End Method
Method SetCoordFunction(SetCoordOffset(x:Double Var,y:Double Var))
self.SetCoordOffset = SetCoordOffset
End Method
Function Create:Line(x1:Double,y1:Double,x2:Double,y2:Double)
Local rval:Line = New Line
rval.x1=x1
rval.y1=y1
rval.x2=x2
rval.y2=y2
Return rval
End Function
'--------------------------------------------------------
' rotate a point around the origin, we rotate in the following order x,y,z
' xa,ya,za - The angle To rotate the point from its current position, in degrees
Method rotate(xa:Double,ya:Double,za:Double)
Local xx:Double = Cos(ya) * Cos(za)
Local xy:Double = (Sin(xa) * Sin(ya) *Cos(za)) - (Cos(xa) * Sin(za))
Local xz:Double = (Cos(xa) * Sin(ya) *Cos(za)) + (Sin(xa) * Sin(za))
Local yx:Double = Cos(ya) * Sin(za)
Local yy:Double = (Cos(xa) * Cos(za)) + (Sin(xa) * Sin(ya) * Sin(za))
Local yz:Double = (-Sin(xa) * Cos(za)) + (Cos(xa) * Sin(ya) * Sin(za))
Local zx:Double = -Sin(ya)
Local zy:Double = Sin(xa) * Cos(ya)
Local zz:Double = Cos(xa) * Cos(ya)
Local nx:Double = (x1*xx)+(y1*xy)+(z1*xz)
Local ny:Double = (x1*yx)+(y1*yy)+(z1*yz)
Local nz:Double = (x1*zx)+(y1*zy)+(z1*zz)
x1=nx
y1=ny
z1=nz
nx = (x2*xx)+(y2*xy)+(z2*xz)
ny = (x2*yx)+(y2*yy)+(z2*yz)
nz = (x2*zx)+(y2*zy)+(z2*zz)
x2=nx
y2=ny
z2=nz
End Method
'--------------------------------------------------------
' rotate a point around the origin, we rotate in the following order x,y,z
' xa,ya,za - The angle To rotate the point from its current position, in degrees
Method TempRotate(xa:Double,ya:Double,za:Double,x1:Double Var,y1:Double Var,z1:Double Var,x2:Double Var,y2:Double Var,z2:Double Var)
Local xx:Double = Cos(ya) * Cos(za)
Local xy:Double = (Sin(xa) * Sin(ya) *Cos(za)) - (Cos(xa) * Sin(za))
Local xz:Double = (Cos(xa) * Sin(ya) *Cos(za)) + (Sin(xa) * Sin(za))
Local yx:Double = Cos(ya) * Sin(za)
Local yy:Double = (Cos(xa) * Cos(za)) + (Sin(xa) * Sin(ya) * Sin(za))
Local yz:Double = (-Sin(xa) * Cos(za)) + (Cos(xa) * Sin(ya) * Sin(za))
Local zx:Double = -Sin(ya)
Local zy:Double = Sin(xa) * Cos(ya)
Local zz:Double = Cos(xa) * Cos(ya)
Local nx:Double = (x1*xx)+(y1*xy)+(z1*xz)
Local ny:Double = (x1*yx)+(y1*yy)+(z1*yz)
Local nz:Double = (x1*zx)+(y1*zy)+(z1*zz)
x1=nx
y1=ny
z1=nz
nx = (x2*xx)+(y2*xy)+(z2*xz)
ny = (x2*yx)+(y2*yy)+(z2*yz)
nz = (x2*zx)+(y2*zy)+(z2*zz)
x2=nx
y2=ny
z2=nz
End Method
Method Draw(x:Double,y:Double,tilt:Float, angle:Double=0)
Global lasty:Double=-1
Local x1:Double = self.x1
Local y1:Double = self.y1
Local z1:Double = self.z1
Local x2:Double = self.x2
Local y2:Double = self.y2
Local z2:Double = self.z2
If angle<>0 Then TempRotate(angle,0,0,x1,y1,z1,x2,y2,z2)
If SetDrawColor<>Null Then
SetDrawColor(x1+x,y1+y,z1)
EndIf
Local dx:Double = x1+x+(tilt*y1)
Local dy:Double = y1+y
If Abs(lasty-dy)>1 Then 'fill gaps between lines when wrapped around origin
If SetCoordOffset<>Null Then SetCoordOffset(dx,dy)
ScaleDrawRect(dx,dy-1,x2-x1,1)
EndIf
If SetCoordOffset<>Null Then SetCoordOffset(dx,dy)
ScaleDrawRect(dx,dy,x2-x1,1)
End Method
Function ScaleDrawRect(x:Double,y:Double,w:Double,h:Double)
Local sx:Float,sy:Float
GetScale(sx,sy)
If sx*x>GraphicsWidth() Or sy*y>GraphicsHeight() Then Return
DrawRect(sx*x,sy*y,w,h)
End Function
Method DrawByPixel(x:Double,y:Double,tilt:Double)
Local deltax:Double= Abs(x2 - x1) ' The difference between the x's
Local deltay:Double= Abs(y2 - y1) ' The difference between the y's
Local lx:Double= x1 ' Start x off at the first pixel
Local ly:Double= y1 ' Start y off at the first pixel
Local xinc1:Double= 0
Local yinc1:Double= 0
Local xinc2:Double= 0
Local yinc2:Double= 0
Local numadd:Double= 0
Local numpixels:Double= 0
Local den:Double= 0
Local num:Double= 0
If x2 >= x1 Then ' The x-values are increasing
xinc1 = 1
xinc2 = 1
Else ' The x-values are decreasing
xinc1 = -1
xinc2 = -1
EndIf
If y2 >= y1 Then ' The y-values are increasing
yinc1 = 1
yinc2 = 1
Else ' The y-values are decreasing
yinc1 = -1
yinc2 = -1
EndIf
If deltax >= deltay Then ' There is at least one x-value For every y-value
xinc1 = 0 ' Don't change the x when numerator >= denominator
yinc2 = 0 ' Don't change the y for every iteration
den = deltax
num = deltax / 2
numadd = deltay
numpixels = deltax ' There are more x-values than y-values
Else ' There is at least one y-value For every x-value
xinc2 = 0 ' Don't change the x for every iteration
yinc1 = 0 ' Don't change the y when numerator >= denominator
den = deltay
num = deltay / 2
numadd = deltax
numpixels = deltay ' There are more y-values than x-values
EndIf
For Local curpixel:Int = 0 To numpixels
If SetDrawColor<>Null Then
SetDrawColor(x1+x,y1+y,z1)
EndIf
Local dx:Double = lx+x-(y1*tilt)
Local dy:Double = ly+y
If SetCoordOffset<>Null Then SetCoordOffset(dx,dy)
ScaleDrawRect(dx,dy,1,1) ' draw the current pixel
num :+ numadd ' Increase the numerator by the top of the fraction
If num >= den Then ' Check If numerator >= denominator
num :- den ' Calculate the New numerator value
lx :+ xinc1 ' Change the x as appropriate
ly :+ yinc1 ' Change the y as appropriate
EndIf
lx :+ xinc2 ' Change the x as appropriate
ly :+ yinc2 ' Change the y as appropriate
Next
End Method
End Type
'=================================================================
' an image made of line segments
'=================================================================
Type LineImage
Field lines:Line[] = New Line[0]
Field width:Int = 0
Field height:Int = 0
Field lineCount:Int = 0
Field bar:Byte=False
Method SetColorFunction(SetDrawColor(x:Int,y:Int,z1:Int))
For Local l:Int = 0 Until lineCount
lines[l].SetColorFunction(SetDrawColor)
Next
End Method
Method SetCoordFunction(SetCoordOffset(x:Double Var,y:Double Var))
For Local l:Int = 0 Until lineCount
lines[l].SetCoordFunction(SetCoordOffset)
Next
End Method
Method Draw(x:Double,y:Double,tilt:Double,pixel:Byte=True,angle:Double=0,inc:Double=0)
lines.sort()
If pixel=True Then
For Local l:Int = 0 Until lineCount
lines[l].DrawByPixel(x,y,tilt)
Next
Else
Local drawBar:Byte=True
For Local l:Int = 0 Until lineCount
If bar=True And lines[l].z1>0 And drawBar=True Then
Local sx:Float,sy:Float
GetScale(sx,sy)
drawBar=False
SetColor(50,50,255)
DrawImageRect(hbar,sx*x,sy*y,sx*width,sy*ImageHeight(hbar))
EndIf
lines[l].Draw(x,y,tilt,angle+(inc*l))
Next
If bar=True And drawBar=True Then
Local sx:Float,sy:Float
GetScale(sx,sy)
drawBar=False
SetColor(50,50,255)
DrawImageRect(hbar,sx*x,sy*y,sx*width,sy*ImageHeight(hbar))
EndIf
EndIf
End Method
'--------------------------------------------------------
' rotate a point around the origin, we rotate in the following order x,y,z
' xa,ya,za - The angle To rotate the point from its current position, in degrees
Method rotate(xa:Double,ya:Double,za:Double)
For Local l:Int = 0 Until lineCount
lines[l].rotate(xa,ya,za)
Next
End Method
Function Create:LineImage(image:TImage,frame:Int=0,r:Int=0,g:Int=0,b:Int=0,angle:Double=0,inc:Double=0)
Local rval:LineImage = New LineImage
Local pm:TPixmap = LockImage( image,frame)
rval.width = PixmapWidth(pm)
rval.height = PixmapHeight(pm)
Local started:Byte=False
Local sx:Int=-1
Local ex:Int=-1
For Local y:Int = 0 Until rval.height
started=False
sx=-1
ex=-1
For Local x:Int = 0 Until rval.width
Local pix:Int = pm.ReadPixel(x,y)
If started=False And (pix & $FF000000)<>0 And (pix & $00FFFFFF) | (r Shl 16|g Shl 8|b) <> 0 Then ' found SOL
started=True
sx = x
Else If started=True And ((pix & $FF000000)=0 Or (pix & $00FFFFFF) | (r Shl 16|g Shl 8|b) = 0) Then ' found EOL
ex = x-1
EndIf
If started=True And ex<>-1 Then
Local l:Line = Line.Create(sx-(rval.width/2),y-(rval.height/2),ex-(rval.width/2),y-(rval.height/2))
If angle<>0 Or inc<>0 Then l.rotate(angle+(inc*y),0,0)
rval.lines = rval.lines[..(rval.lineCount+1)]
rval.lines[rval.lineCount]=l
rval.lineCount:+1
started=False
sx=-1
ex=-1
EndIf
Next
If started=True And ex=-1 Then
ex=rval.width-1
Local l:Line = Line.Create(sx-(rval.width/2),y-(rval.height/2),ex-(rval.width/2),y-(rval.height/2))
If angle<>0 Or inc<>0 Then l.rotate(angle+(inc*y),0,0)
rval.lines = rval.lines[..(rval.lineCount+1)]
rval.lines[rval.lineCount]=l
rval.lineCount:+1
EndIf
Next
UnlockImage(image,frame)
Return rval
End Function
End Type
'=================================================================
' a font made of LineImage objects
'=================================================================
Type LineImageFont
Field chars:LineImage[] = New LineImage[256]
Method SetColorFunction(SetDrawColor(x:Int,y:Int,z:Int))
For Local c:Int = 0 To 127
chars[c].SetColorFunction(SetDrawColor)
Next
End Method
Method SetCoordFunction(SetCoordOffset(x:Double Var,y:Double Var))
For Local l:Int = 0 To 127
chars[l].SetCoordFunction(SetCoordOffset)
Next
End Method
'--------------------------------------------------------
' rotate a point around the origin, we rotate in the following order x,y,z
' xa,ya,za - The angle To rotate the point from its current position, in degrees
Method rotate(xa:Double,ya:Double,za:Double)
For Local l:Int = 0 To 127
chars[l].rotate(xa,ya,za)
Next
End Method
Function Create:LineImageFont(image:TImage,r:Int=0,g:Int=0,b:Int=0,angle:Double,inc:Double)
Local rval:LineImageFont = New LineImageFont
For Local c:Int = 0 To 127
rval.chars[c] = LineImage.Create(image,c,r,g,b,angle,inc)
rval.chars[c].bar=True
Next
Return rval
End Function
Method DrawFont(tilt:Float=0,pixel:Byte=True,angle:Double=0,inc:Double=0)
For Local y:Int=0 To 15
For Local x:Int = 0 To 15
If chars[(y*16)+x]<>Null Then
chars[(y*16)+x].Draw((x+1)*chars[0].width,(y+1)*(chars[0].height+20),tilt,pixel,angle,inc)
EndIf
Next
Next
End Method
Method DrawString(x:Int,y:Int,msg:String,tilt:Float=0,angle:Double=0,inc:Double=0)
Local spacing = chars[0].width
Local msglen:Int = Len(msg)
Local curx:Int = x
' draw each character
For Local i:Int = 1 To msglen
' get the letter
Local letter:String = Mid$(msg,i,1)
' get the ascii code
Local ccode:Int = Asc(letter$)
chars[ccode].Draw(curx,y,.2,False,angle,inc)
' move To the Next character position
curx = curx + spacing
'angle:+5 ' this gives a spiral effect
Next
End Method
End Type
