2D funny face creator by Rich

[pistol350]

yeah!
they faces are really funny

Code Select Expand


'Funny Faces
'by Rich Schafermeyer 12/2003
'could be made into screensaver with appropriate code from Ibasic forum
def win:window
def x0,y0,xcount,ycount,xycount,i,facecount,itemcount,sw,sh:int
def bcolor_r,bcolor_g,bcolor_b:int
def fcolor_r,fcolor_g,fcolor_b:int
def bkcolor_r,bkcolor_g,bkcolor_b:int
def hh,htype:int
def hw,hw1,hh1:float
def eh,ew,ehoff,evoff,highlight:float
def mw1,mw2,mw3,mw4:float
def mh1,mh2,mh3,mh4:float
def bstart,bstop,btype:int
def bw,bh:float
def location[15,2],newlocation,locationOK,mousemove:int
declare el(elstart:int,elstop:int,elx:int,ely:int,elx0:int,ely0:int,elw:int,ecolor_r:int,ecolor_g:int,ecolor_b:int)
declare bezier(pnum:int,bx0:int,bx1:int,bx2:int,bx3:int,bx4:int,by0:int,by1:int,by2:int,by3:int,by4:int,segnum:int)

getscreensize sw,sh
window win,0,0,sw,sh,@nocaption|@noautodraw,0,"",main

'make directx screen
if createscreen(win,sw,sh) < 0
    messagebox win, "Could not create DirectX screen","Error"
    closewindow win
    end
endif

'init variables
facecount=0
mousemove=0
xcount=4:ycount=3
xycount=12
sw=sw/xcount:sh=sh/ycount
bkcolor_r=100+rnd(130):bkcolor_g=100+rnd(130):bkcolor_b=100+rnd(130)
dxfill win,rgb(bkcolor_r,bkcolor_g,bkcolor_b)
setcursor win,@cscustom,0

starttimer win,1500:'set time between faces in milliseconds (1000 = 1 second)

run = 1
waituntil run = 0
setcursor win,@cscustom,1
closewindow win
end

sub main
select @class
   case @idchar
      run=0
   case @idlbuttondn
      run=0
   case @idrbuttondn
      run=0
   case @idmousemove
'      uncomment next two lines to make sensitive to mouse movement
'      mousemove=mousemove+1
'      if mousemove>10 then run=0
   case @iddxupdate
      dxflip win
   case @idtimer
      gosub picklocation
      gosub makeface
      facecount=facecount+1
      if facecount>xycount
         'reset variables
         facecount=0
         itemcount=0
         for i=0 to xycount
            location[i,0]=0
            location[i,1]=0
         next i
         'recolor screen
         dxfill win, rgb(100+rnd(130),100+rnd(130),100+rnd(130))
      endif
endselect
return

sub picklocation
def row,col:int
do
newlocation=rnd(xycount)
if location[newlocation,0]=0
   itemcount=itemcount+1
   locationOK=1
   row=newlocation/xcount
   col=newlocation-row*xcount
   location[newlocation,0]=sw*col+0.5*sw
   location[newlocation,1]=sh*row+0.5*sh
endif
if facecount>11 then locationOK=1
if itemcount>11 then locationOK=1
until locationOK=1
locationOK=0
return

sub makeface
def i,j:int
x0=location[newlocation,0]
y0=location[newlocation,1]
gosub initvariables
gosub makehead
gosub makemouth
gosub makebrows
gosub makeeyes
return

sub initvariables
'init: hh = head height, hw = head width as % of head height
hh=0.5*sh/ycount+rnd(0.5*sh/ycount)
hw=0.5+rnd(1)
hh1=rnd(1):hw1=rnd(1):htype=rnd(5)
'init eyes: ew = eye width as % of head width, eh = eye height as % of head height,
'ehoff = eye horizontal offset as % of face, evoff = eye vertical offset as % of face
ew=0.25+rnd(.25):eh=0.25+rnd(.25):ehoff=0.2+rnd(.5):evoff=0.1+rnd(.9)
'init mouth: mw1 & mw4 = mouth width as % of face width, mh2 & mh3 = mouth height as % of face height,
'mh1 & mh4 = mouth vertical offset as % of face
mw1=0.2+rnd(0.8):mw2=rnd(mw1*0.8):mw4=0.2+rnd(0.8):mw3=rnd(mw4*0.8)
mh1=rnd(0.8):mh2=rnd(0.8):mh3=rnd(0.8):mh4=rnd(0.8)
'init nose
nh=0.1+rnd(0.3):nw=0.2+rnd(nh):nvoff=rnd(0.5)
'init brows: bstart = starting angle, bstop = stopping angle
'bw = brow width as % of eye width, btype: 0 = same side, 1 = mirror, 2= none
bstart=rnd(360):bstop=rnd(360):bw=ew*(1.5+rnd(2)):bh=bw:btype=rnd(2.5)
'init color: bcolor is border color, fcolor is face fill color
bcolor_r=100:bcolor_g=0:bcolor_b=0
fcolor_r=100+rnd(150):fcolor_g=100+rnd(150):fcolor_b=100+rnd(150)
return

sub makehead
setlinestyle win,@lssolid,1
select htype
   case 0
      ellipse win,x0-hw*hh,y0-hh,2*hw*hh,2*hh,rgb(bcolor_r,bcolor_g,bcolor_b),rgb(fcolor_r,fcolor_g,fcolor_b)
   case 1
      rect win,x0-hw*hh,y0-hh,2*hw*hh,2*hh,rgb(bcolor_r,bcolor_g,bcolor_b),rgb(fcolor_r,fcolor_g,fcolor_b)
   case 2
      gosub roundrect
   case 3
      line win,x0,y0-hh,x0+hw*hh,y0+hh,rgb(bcolor_r,bcolor_g,bcolor_b)
      line win,x0-hh*hw,y0+hh,rgb(bcolor_r,bcolor_g,bcolor_b)
      line win,x0,y0-hh,rgb(bcolor_r,bcolor_g,bcolor_b)
      floodfill win,x0,y0,rgb(fcolor_r,fcolor_g,fcolor_b)
   case 4
      line win,x0,y0+hh,x0+hw*hh,y0-hh,RGB(100,0,0)
      line win,x0-hh*hw,y0-hh,RGB(100,0,0)
      line win,x0,y0+hh,RGB(100,0,0)
      floodfill win,x0,y0,rgb(fcolor_r,fcolor_g,fcolor_b)
endselect
return

sub makemouth
def cx,cy,c1x,cx2,cx3,cx4,cy1,cy2,cy3,cy4:int
'draw mouth using 4 dot bezier - needs 4 of 5 dots defined
bezier(4,x0-hh*hw*mw1,x0-hh*hw*mw2,0,x0+hh*hw*mw3,x0+hh*hw*mw1,y0+hh*mh1,y0+hh*mh2,0,y0+hh*mh3,y0+hh*mh1,16)
return

sub makeeyes
'draw black eyes
ellipse win,x0-hh*hw*ehoff-hh*hw*ew/2,y0-hh*evoff-hh*eh/2,hh*hw*ew,hh*eh,rgb(0,0,0),rgb(0,0,0)
ellipse win,x0+hh*hw*ehoff-hh*hw*ew/2,y0-hh*evoff-hh*eh/2,hh*hw*ew,hh*eh,rgb(0,0,0),rgb(0,0,0)
'draw white highlights
if sw<1000
   highlight=3
else
   highlight=5
endif
ellipse win,x0-hh*hw*ehoff-hh*hw*ew*0.25,y0-hh*evoff-hh*eh*.4,highlight,highlight,rgb(255,255,255),rgb(255,255,255)
ellipse win,x0+hh*hw*ehoff-hh*hw*ew*0.25,y0-hh*evoff-hh*eh*.4,highlight,highlight,rgb(255,255,255),rgb(255,255,255)
return

sub makebrows
def b1,b2:int
select btype
   case 0
      el(bstart,bstop,bw*ew*hh*hw,bh*eh*hh,x0-hh*hw*ehoff,y0-hh*evoff,3,0,0,0)
      el(bstart,bstop,bw*ew*hh*hw,bh*eh*hh,x0+hh*hw*ehoff,y0-hh*evoff,3,0,0,0)
   case 1
      el(bstart,bstop,bw*ew*hh*hw,bh*eh*hh,x0-hh*hw*ehoff,y0-hh*evoff,3,0,0,0)
      b1=540-bstart:if b1>360:b1=b1-360:endif
      b2=540-bstop:if b2>360:b2=b2-360:endif
      el(b2,b1,bw*ew*hh*hw,bh*eh*hh,x0+hh*hw*ehoff,y0-hh*evoff,3,0,0,0)
   case 2
endselect
return

sub roundrect
hw1=hh1
el(0,90,(1-hw1)*hh*hw,(1-hh1)*hh,x0+hh*hw*hw1,y0+hh*hh1,1,bcolor_r,bcolor_g,bcolor_b)
el(90,180,(1-hw1)*hh*hw,(1-hh1)*hh,x0-hh*hw*hw1,y0+hh*hh1,1,bcolor_r,bcolor_g,bcolor_b)
el(180,270,(1-hw1)*hh*hw,(1-hh1)*hh,x0-hh*hw*hw1,y0-hh*hh1,1,bcolor_r,bcolor_g,bcolor_b)
el(270,360,(1-hw1)*hh*hw,(1-hh1)*hh,x0+hh*hw*hw1,y0-hh*hh1,1,bcolor_r,bcolor_g,bcolor_b)
'top line
move win,x0-hh*hw*hw1-3,y0-hh-0
line win,x0+hh*hw*hw1,y0-hh,rgb(bcolor_r,bcolor_g,bcolor_b)
'bottom line
move win,x0-hh*hw*hw1,y0+hh-2
line win,x0+hh*hw*hw1+3,y0+hh-2,rgb(bcolor_r,bcolor_g,bcolor_b)
'left line
move win,x0-hh*hw,y0-hh*hh1
line win,x0-hh*hw,y0+hh*hh1+2,rgb(bcolor_r,bcolor_g,bcolor_b)
'right line
move win,x0+hh*hw-1,y0-hh*hh1-2
line win,x0+hh*hw-1,y0+hh*hh1,rgb(bcolor_r,bcolor_g,bcolor_b)
floodfill win,x0,y0,rgb(fcolor_r,fcolor_g,fcolor_b)
return

'draw ellipse
sub el(elstart,elstop,elx,ely,elx0,ely0,elw,ecolor_r,ecolor_g,ecolor_b)
def j:int
setlinestyle win,@lssolid,elw
j=elstart
move win,elx0+elx*cos(j*3.14/180),ely0+ely*sin(j*3.14/180)
do
line win,elx0+elx*cos(j*3.14/180),ely0+ely*sin(j*3.14/180),rgb(ecolor_r,ecolor_g,ecolor_b)
j=j+1:if j=361:j=0:endif
until j=elstop
return

'draw bezier curve
sub bezier(pnum,bx0,bx1,bx2,bx3,bx4,by0,by1,by2,by3,by4,segnum)
def incr,i,i1,i2,i3,i4,x,y:float
def j:int
incr = 1/segnum : i = 0
move win,bx0,by0
setlinestyle win,@lssolid,3
for j = 0 to segnum
i1 = 1 - i : i2 = (1 - i) * i1 : i3 = (1 - i) * i2 : i4 = (1 - i) * i3
select pnum
   case 2
      x=bx0*i1+bx4*i
      y=by0*i1+by4*i
   case 3
      x=bx0*i2+bx2*2*i*i1+bx4*i*i
      y=by0*i2+by2*2*i*i1+by4*i*i
   case 4   
      x=bx0*i3+bx1*3*i*i2+bx3*3*i*i*i1+bx4*i^3
      y=by0*i3+by1*3*i*i2+by3*3*i*i*i1+by4*i^3
   case 5
      x=bx0*i4+bx1*4*i*i3+bx2*6*i*i*i2+bx3*4*i^3*i1+bx4*i^4
      y=by0*i4+by1*4*i*i3+by2*6*i*i*i2+by3*4*i^3*i1+by4*i^4
endselect
line win,x,y
i = i + incr
next j
return