Cartoon Sheep Function

-=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- (c) WidthPadding Industries 1987 0\|531\|0 -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=-
SoCoder -> Snippet Home -> Graphical Effects

Andy_A	Created : 03 July 2011 System : Windows Language : Blitz Cartoon Sheep Function Make all the cartoon sheep you could ever want...
Q: What could you ever use this for? A: Maybe, as a screen saver to count stuff before going to sleep. ; Title: Cartoon Sheep Function ;Programmer: Andy Amaya ; Date: 2011.06.29 ;======================================================= ;FillTriangle by Tom Toad ;https://www.blitzmax.com/codearcs/codearcs.php?code=1200 ;======================================================= AppTitle "Cartoon Sheep" Global sw = 800, sh = 600, retX, retY Graphics sw, sh, 32, 2 SetBuffer BackBuffer() SeedRnd MilliSecs() ;color constants Const black% = $00 Const white% = $FFFFFF Const red% = $FF0000 Const yellow% = $FFFFE0 Const green% = $FF00 Const blue% = $FF Const darkblue% = $80 Const lightgray%= $D0D0D0 Const gray% = $808080 Const peach% = $FFB060 Const skyblue% = $20A0FF Const brown% = $604020 setClsColor(skyblue) While MouseHit(1) = 0 Cls For i = 1 To 9 colr = Rand(1,3) Select colr Case 1: outline = black : fill = white Case 2: outline = black : fill = lightgray Case 3: outline = brown : fill = yellow End Select scale = Rand(10,50) ; scale values of 10 to 100 recommended x = Rand(scale5,sw-scale5) ;keep 'em on y = Rand(scale3,sh-scale3) ;screen here If toggle Then sheep(x, y, scale3, scale5, outline, fill, Rand(-70,70), Rand(0,1),1) Else sheep(x, y, scale5, scale3, outline, fill, Rand(-70,70), Rand(0,1),1) End If toggle = 1-toggle Next setColor(black) Text 400,580,"Right click for more random sheep --------- Left click to Exit",True Flip WaitMouse() Wend End Function sheep(x, y, ovalw, ovalh, outline, fill, headAngle, headPos, penWidth) ;============================================================================== ; sheep function to draw cartoon sheep ;============================================================================== ; Parameters: ; x,y are the center coords of the main ellipse used to construct the body ; ovalw, ovalh are the width and height of the main ellipse ; outline is the Hex color used to draw the sheep's outline ; fill is the Hex color used to fill in the wool ; headAngle is the angle of the sheep's head ; headPos locates the head on the left or right of the body ; penWidth determines the width of the outline in pixels ; ;======================================================================================= ; NB: requires setColor(), fillTriangle(), rLocate(), rEllipse() and tBubble() functions ;======================================================================================= Local bigRad%, legW%, legH%, radx%, rady%, tx%, ty%, bodyBump%, stroke% Local headRadX%, headRadY%, eyeRadX%, eyeRadY%, earLocX%, earLocY% Local eyeOutlineX%, eyeOutlineY% ;make sure we derive proportions from the longest axis If ovalw > ovalh Then bigRad = ovalw Else bigRad = ovalh legW = bigRad/20 If legW < 3 Then legW = 3 legH = legW5 radx = ovalw Shr 1 rady = ovalh Shr 1 setColor(outline) ;left front leg oval center tx = Cos(51)radx +x ty = Sin(51)rady +y rEllipse(tx, ty, legW, legH, 30, Rand(-12,12), 1) ;rt front leg oval center tx = Cos(68)radx +x ty = Sin(68)rady +y rEllipse(tx, ty, legW, legH, 30, Rand(-12,12), 1) ;left back leg oval center tx = Cos(110)radx +x ty = Sin(110)rady +y-legW rEllipse(tx, ty, legW, legH, 30, Rand(-12,12), 1) ;right back leg oval center tx = Cos(127)radx +x ty = Sin(127)rady +y+legW rEllipse(tx, ty, legW, legH, 30, Rand(-12,12), 1) ;calc proportional bumps bodyBump = bigRad Shr 4 If bodyBump < 1 Then bodyBump = 1 stroke = bodyBump/3 If stroke < 1 Then stroke = 1 tBubble(x, y, ovalw, ovalh, bodyBump, stroke, outline, fill) ;body ;place head center on left or right of body If headPos = 0 Then hx = x-radx ;left Else hx = x+radx ;right End If hy = y ;proportions for head headRadX = bigRad/8 headRadY = bigRad/4 eyeRadX = headRadX.3 eyeRadY = headRadY.3 If eyeRadX < 2 Then eyeRadX = 2 If eyeRadY < 4 Then eyeRadY = 4 ;draw the head setColor(peach) rEllipse(hx, hy, headRadX, headRadY, 30, headAngle, 1) setColor(outline) rEllipse(hx, hy, headRadX, headRadY, 30, headAngle, 0) setColor(peach) ;calc ear center distances earLocX = Float(headRadX)1.1 earLocY = Float(headRadY)1.1 ;calc center of left ear rLocate(hx, hy, earLocX, earLocY, headAngle, 325) rEllipse(retX, retY, eyeRadX, eyeRadY, 30, headAngle+45, 1) ;calc center of right ear rLocate(hx, hy, earLocX, earLocY, headAngle, 215) rEllipse(retX, retY, eyeRadX, eyeRadY, 30, headAngle-45, 1) ;calc eye center distances eyeOutlineX% = Float(headRadX).4 eyeOutlineY% = Float(headRadY).4 ;calc center of right eye setColor(outline) rLocate(hx, hy, eyeOutlineX, eyeOutlineY, headAngle,190) exR = retX : eyR = retY rEllipse(exR, eyR, eyeRadX, eyeRadY, 30, headAngle, 1) ;calc center of left eye rLocate(hx, hy, eyeOutlineX, eyeOutlineY, headAngle,350) exL = retX : eyL = retY rEllipse(exL, eyL, eyeRadX, eyeRadY, 30, headAngle, 1) ;draw the whites of eyes setColor white whiteX = eyeRadX-2 If whiteX < 1 Then whiteX = 1 whiteY = eyeRadY-2 If whiteY < 2 Then whiteY = 2 rEllipse(exL, eyL, whiteX,whiteY,30,headAngle, 1) rEllipse(exR, eyR, whiteX,whiteY,30,headAngle, 1) setColor(outline) ;calc proportional pupil radii eyePupilX = eyeOutlineX .35 eyePupilY = eyeOutlineY * .35 ;calc center of pupils angle = Rand(0,359) rLocate(exR, eyR, eyePupilX, eyePupilY, headAngle, angle) rEllipse(retX, retY, eyePupilX, eyePupilY, 10, headAngle, 1) rLocate(exL, eyL, eyePupilX, eyePupilY, headAngle, angle) rEllipse(retX, retY, eyePupilX, eyePupilY, 10, headAngle, 1) ;calc location of head wool woolBump = bodyBump/6 If woolBump < 1 Then woolBump = 1 rLocate(hx, hy, headRadX.72, headRadY.72, headAngle, 270) tBubble(retX, retY, headRadY.75, headRadX.75, woolBump, woolBump, outline, fill) ;head wool End Function ;======================================================= ;FillTriangle by Tom Toad ;https://www.blitzmax.com/codearcs/codearcs.php?code=1200 ;======================================================= Function fillTriangle(x1#,y1#,x2#,y2#,x3#,y3#) Local slope1#,slope2#,slope3#,x#,y#,length# ;make sure the triangle coordinates are ordered so that x1 < x2 < x3 If x2 < x1 Then x = x2: y = y2: x2 = x1: y2 = y1: x1 = x: y1 = y If x3 < x1 Then x = x3: y = y3: x3 = x1: y3 = y1: x1 = x: y1 = y 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) length = x2 - x1 ;draw the first half of the triangle If length <> 0 Then slope2 = (y2-y1)/(x2-x1) For x = 0 To length Line x+x1,xslope1+y1,x+x1,xslope2+y1 Next End If y = lengthslope1+y1 length = x3-x2 ;draw the second half If length <> 0 Then slope3 = (y3-y2)/(x3-x2) For x = 0 To length Line x+x2,xslope1+y,x+x2,xslope3+y2 Next End If End Function Function reticle(x,y,colr) Local r%, g%, b% r = ColorRed g = ColorGreen b = ColorBlue setColor(colr) Line(x-5,y,x+5,y) Line(x,y-5,x,y+5) Color r,g,b End Function Function tBubble(x%, y%, ew%, eh%, bump%, pen%, outline%=0, fill%=$FFFFFF) ;========================= Thought Bubble Function ================================== ;Parameters: ; x,y are the center of the main ellipse used to construct the thought bubble ; ; ew is the total width of the main ellipse ( xRadius 2) ; eh is the total height of the main ellipse ( yRadius * 2) ; ; bump is a value used to determine overall height of bumps encircling the main ; ellipse - inversely proportional (i.e. smaller bump values make bigger bumps ; and larger bump values make smaller bumps) ; ; pen determines the width of the outline stroke used to draw thought bubble ; ; outline is a hex color value of bubble outline (default = black) ; ; fill is the hex color value used to fill the bubble (default = white) ;===================================================================================== ; NB: requires setColor() function ;===================================================================================== Local ex%, ey%, radX%, radY%, rand1%, rand2%, arcUsed%, arc% Local rad%, cx%, cy%, x1%, y1%, x2%, y2%, oldX%, oldY%, pen2% If pen < 2 Then pen = 2 pen2 = pen Shr 1 ex = x ;center X of main ellipse ey = y ;center Y of main ellipse radX = ew Shr 1 ;radius of main ellipse along X axis radY = eh Shr 1 ;radius of main ellipse along Y axis rand1 = Int(ew/bump) ;1/bump the width of main ellipse rand2 = Int(eh/bump) ;1/bump the height of main ellipse ;make sure rand1 is less than rand2 If rand2 < rand1 Then tmp = rand1:rand1=rand2:rand2=tmp ;if rand1 = rand2 then divide rand1 by 2 If Abs(rand1 - rand2) < 5 Then rand1 = rand1/2 ;this variable keeps track of degrees used by all arc segments arcUsed = 0 ;first point is a random location on ellipse in degrees (always even) arc = Rand(0,179)2 ;this is a point on main ellipse at number of degrees in 'degree' variable x1 = Cos(arc)radX+ex y1 = Sin(arc)radY+ey ;remember this first point to draw the last bump and close the bubble later oldX = x1: oldY = y1 ;use loop to keep adding bumps (circles) While arcUsed <= 360-rand22 ;get a new random number of degrees stp = Rand(rand1, rand2)2 ;keep running total of 'angle of arc' used so far arcUsed = arcUsed + stp ;keep track of current location in degrees on the main ellipse arc = arc+stp ;calc x,y coords on main ellipse at current 'arc' value x2 = Cos(arc)radX+ex y2 = Sin(arc)radY+ey ;calc radius of the circle used to draw the bump rad = Floor(Sqr((x2-x1)(x2-x1)+(y2-y1)(y2-y1))+.5)+1 ;find mid-point of x1,y1 and x2,y2 to use as center of circle used to draw bump cx = (x1+x2)/2 cy = (y1+y2)/2 ;change color to hex value in 'outline' parameter setColor(outline) ;draw a filled circle 'pen2' pixels larger than inner filled circle (thickness of outline) Oval cx-rad/2-pen2, cy-rad/2-pen2, rad+pen, rad+pen,True ;change color to hex value in 'fill' parameter setColor(fill) ;draw the 'fill' colored filled circle Oval cx-rad/2, cy-rad/2, rad, rad, True ;remember last coords on ellipse drawn to, as x1,y1 x1 = x2: y1 = y2 Wend ;============================================================================ ; OK, ellipse nearly encircled with bumps, only room enough for one last bump ;============================================================================ ;these are coords of first point we used to start drawing bumps ;x1,y1 holds the coords of the last coords used to draw a bump in loop x2 = oldX : y2 = oldY ;calc the radius of the circle used to draw the last bump rad = Int(Sqr((x2-x1)(x2-x1)+(y2-y1)(y2-y1)) +.5)+1 ;calc the mid point coords between x1,y1 and x2,y2 to use as center of circle cx = (x1+x2)/2 cy = (y1+y2)/2 ;change color to hex value in 'outline' parameter setColor(outline) ;draw a filled circle 'pen2' pixels larger than inner filled circle (thickness of outline) Oval cx-rad/2-pen2, cy-rad/2-pen2, rad+pen, rad+pen, True ;change color to hex value in 'fill' parameter setColor(fill) ;draw the 'fill' colored filled circle Oval cx-rad/2, cy-rad/2, rad, rad, True ;draw the main filled ellipse, which erases all of the semi-circles inside of the ellipse Oval ex-radX, ey-radY, ew, eh,True End Function Function rEllipse(centerX%, centerY%, radius1#, radius2#, segments#, angle#, mode%) ;============================== Rotated Ellipse Function ============================== ; Parameters are: ; ; centerX, centerY coords locate center of ellipse to be plotted ; radius1 is width of ellipse along the X axis ; radius2 is height of ellipse along the Y axis ; segments is number of line segments used to draw the ellipse (minimum of 3) ; angle is number of degrees to rotate the ellipse (NOTE: 0 degrees = East) ; mode - when mode = 0 then draw an un-filled ellipse else draw a filled ellipse ; ;====================================================================================== ; NB: requires fillTriangle() function ;====================================================================================== Local rca#, rsa#, incSize#, i#, ca#, sa#, x1%, y1%, x2%, y2% rca = Cos(angle) : rsa = Sin(angle) If segments < 3.0 Then segments = 3.0 incSize = 360.0/segments If angle = 0 Then x1 = radius1+centerX : y1 = centerY Else x1 = rcaradius1+centerX : y1 = rsaradius1+centerY End If ; Plot x1, y1 i = incSize While i <= 360.01 ca = Cos(i)radius1 : sa = Sin(i)radius2 If angle = 0.0 Then x2 = Int(ca + centerX) : y2 = Int(sa + centerY) Else x2 = Int(rcaca-rsasa +centerX) : y2 = Int(rsaca+rcasa +centerY) End If ;if mode is zero draw an un-filled ellipse If mode = 0 Then Line x1, y1, x2, y2 Else ;otherwise use the fillTriangle function to fill current arc segment fillTriangle(centerX, centerY, x1, y1, x2, y2) End If x1 = x2 : y1 = y2 i = i + incSize Wend End Function ;locate any angle location on a rotated ellipse Function rLocate#(cx, cy, r1, r2, headAngle, angle) Local rca#, rsa#, ca#, sa#,x#, y# rca =Cos(headAngle) : rsa = Sin(headAngle) ca = Cos(angle)r1: sa = Sin(angle)r2 ;============================================== ; retX and retY are GLOBAL! * ; which allows us to return both x and y values ;============================================== retX = Int(rcaca-rsasa+cx) retY = Int(rsaca+rcasa+cy) End Function Function setColor(hexValue%) Color (hexValue Shr 16) And 255,(hexValue Shr 8) And 255, hexValue And 255 End Function Function setClsColor(hexValue%) ClsColor (hexValue Shr 16) And 255,(hexValue Shr 8) And 255, hexValue And 255 End Function Function rgb2hex%(r%, g%, b%) Return (r Shl 16) Or (g Shl 8) Or b End Function --v

Comments

Comments