' Title: Cartoon Speech Bubbles
'Programmer: Andy Amaya
' Date: 2011.06.21
NoMainWin
Global sw, sh
sw = 800 : sh = 600
WindowWidth = sw+8 : WindowHeight = sh+31
UpperLeftX = (DisplayWidth-sw)/2: UpperLeftY = (DisplayHeight-sh)/2
Open "Cartoon Thought Bubbles" For Graphics_nsb As #g
h$ = "#g"
#g "Down;TrapClose [xit]"
#g "when leftButtonDown [xit];when rightButtonDown [repeat]"
[repeat]
#g "Cls;Fill 64 192 255"
bubAngle = (bubAngle + 20) Mod 360
colr = (colr + 1) Mod 4
Select colr
Case 0: fill$ = "white" : outline$ = "black"
Case 1: fill$ = "lightgray": outline$ = "black"
Case 2: fill$ = "yellow" : outline$ = "darkblue"
Case 3: fill$ = "224 255 224": outline$ = "0 80 0"
End Select
bubWide = rand(300,400)
bubHigh = rand(150,200)
bubTail = rand( 30,200)
bubPen = rand(2,8)
Call sBubble h$, 400, 300, bubWide, bubHigh, bubTail, bubAngle, bubPen, outline$, fill$
#h$ "BackColor ";fill$;";Color red"
Call text h$, 320,260, "Speech bubbles can be"
Call text h$, 360,278, "small or large,"
Call text h$, 300,296, "and can be just about any color!"
#h$ "Color ";outline$
Call text h$, 300,335,"R-click to rotate 'tail' 20 degrees"
Call text h$, 355,355,"L-click to exit"
Wait
[xit]
Close #g
End
Sub sBubble h$, x, y, ew, eh, tail, angle, pen, outline$, fill$
'=====================================================================================
' sBubble - Speech Bubble Sub
'=====================================================================================
' Parameters:
' h$ is the alias to the current graphic window or graphic box (e.g. #graph)
'
' x, y are the center coords of the ellipse used to construct the speech bubble
'
' ew, eh are the width and height of the ellipse, respectively
'
' tail = the length of the 'tail' coming from speech bubble is variable so you can
' position the speech bubble far or near to the character
'
' angle = angle of tail coming from speech bubble NOTE: 0 degrees is due East
'
' pen = thickness of the speech bubble outline
'
' outline$ = is the color of the outline
'
' fill$ = is the fill color of the bubble
'
' NB: This function requires: fillTriangle() function
'=====================================================================================
d2r = 0.0174532925199433 'degree to radian conversion factor
angle = angle * d2r 'selected angle converted to radians
pi2 = 6.2831853071795865 'PI * 2
If pen < 2 Then pen = 2
rx = Int(ew/2): ry = Int(eh/2)
'draw the outline oval
#h$ "Color ";outline$;";BackColor ";fill$
'calc the points used to draw the tail outline
'5 degrees to the left of the tail 'angle'
angleL = angle+5*d2r
ltSideX = Cos(angleL)*(rx-pen*2) + x
ltSideY = Sin(angleL)*(ry-pen*2) + y
'5 degrees to the right of the tail 'angle'
angleR = angle-5*d2r
rtSideX = Cos(angleR)*(rx-pen*2) + x
rtSideY = Sin(angleR)*(ry-pen*2) + y
'calc the location of the 'point' of the tail
tailX = Cos(angle)*(rx+tail)+x
tailY = Sin(angle)*(ry+tail)+y
'draw the tail outline
#h$ "Size ";pen*2
#h$ "Line ";ltSideX;" ";ltSideY;" ";tailX;" ";tailY
#h$ "Line ";rtSideX;" ";rtSideY;" ";tailX;" ";tailY
#h$ "Size ";pen
'draw the main ellipse and fill in the tail
#h$ "Color ";outline$
#h$ "Place ";x;" ";y;";EllipseFilled ";ew;" ";eh
#h$ "Size 1;Color ";fill$
Call fillTriangle h$, ltSideX, ltSideY, tailX, tailY, rtSideX, rtSideY
End Sub
Sub fillTriangle h$,x1, y1, x2, y2, x3, y3
'triangle coordinates must be ordered: where x1 < x2 < x3
If x2 < x1 Then x = x2 : y = y2 : x2 = x1 : y2 = y1 : x1 = x : y1 = y
'swap x1, y1, with x3, y3
If x3 < x1 Then x = x3 : y = y3 : x3 = x1 : y3 = y1 : x1 = x : y1 = y
'swap x2, y2 with x3, y3
If x3 < x2 Then x = x3 : y = y3 : x3 = x2 : y3 = y2 : x2 = x : y2 = y
If x1 <> x3 Then slope1 = (y3-y1)/(x3-x1)
'draw the first half of the triangle
length = x2 - x1
If length <> 0 Then
slope2 = (y2-y1)/(x2-x1)
For x = 0 To length
#h$ "Line ";x+x1;" ";x*slope1+y1;" ";x+x1;" ";x*slope2+y1
Next
End If
'draw the second half of the triangle
y = length*slope1+y1 : length = x3-x2
If length <> 0 Then
slope3 = (y3-y2)/(x3-x2)
For x = 0 To length
#h$ "Line ";x+x2;" ";x*slope1+y;" ";x+x2;" ";x*slope3+y2
Next
End If
End Sub
Sub text h$, x, y, msg$
#h$ "Place ";x;" ";y;";\";msg$
End Sub
Function rand(lo,hi)
rand = Int(Rnd(1)*(hi-lo+1))+lo
End Function