|
|
Post by bluatigro on Jun 21, 2018 13:53:48 GMT
this is a proof of consept
i can not code a realistic face
expand this and let this solve crimes
add some const
change *.max const
add or change draw.* sub's
''bluatigro 21 jun 2018
''robo suspect hunter
''writen in justbasic 2.0
''proof of concept
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , property.max
winx = WindowWidth
winy = WindowHeight
global nose.rect , nose.circle , nose.type.max , nose.type
nose.rect = 0
nose.circle = 1
nose.type.max = 1
nose.type = 0
global nose.big , nose.midle , nose.small , nose.size.max , nose.size
nose.big = 0
nose.midle = 1
nose.small = 2
nose.size.max = 2
nose.size = 1
global chin.rect , chin.round , chin.type.max , chin.type
chin.rect = 0
chin.round = 1
chin.type.max = 1
chin.type = 2
global hair.bold , hair.strait , hair.curls , hair.type.max , hair.type
hair.bold = 0
hair.strait = 1
hair.curls = 2
hair.type.max = 2
hair.type = 3
global hair.short , hair.midle , hair.long , hair.size.max , hair.size
hair.short = 0
hair.midle = 1
hair.long = 2
hair.size.max = 2
hair.size = 4
property.max = 4
global skin.color$ , hair.color$ , eye.color$
skin.color$ = "pink"
hair.color$ = "yellow"
eye.color$ = "blue"
dim gen( 9 , property.max )
menu #m , "color" _
, "skin color" , [skin.color] _
, "hair color" , [hair.color] _
, "eye color" , [eye.color]
menu #m , "info" _
, "read me" , [info]
button #m.btn , "push me" , [input.data] , UL , 50 , 0 , 200 , 50
nomainwin
open "robo suspect hunter 1.0" for graphics as #m
#m "trapclose [quit]"
#m "font 50 bold"
#m.btn "!font 30 bold"
#m "size 5"
call start.all
wait
sub start.all
#m "cls"
for i = 0 to 9
gen( i , hair.type ) = dice( hair.type.max )
gen( i , hair.size ) = dice( hair.size.max )
gen( i , nose.type ) = dice( nose.type.max )
gen( i , nose.size ) = dice( nose.size.max )
gen( i , chin.type ) = dice( chin.type.max )
next i
call draw9
end sub
sub draw9
#m "cls"
for a = 0 to 2
for b = 0 to 2
x = a * winx / 3 + winx / 6
y = b * winy / 3 + winy / 6
no = 1 + a + b * 3
call draw.skin x , y , 1
call draw.chin x , y , 1 , gen( no , chin.type )
call draw.hair x , y , 1 _
, gen( no , hair.type ) , gen( no , hair.size )
call draw.eye x - 20 , y - 20 , 1
call draw.eye x + 20 , y - 20 , 1
call draw.nose x , y , 1 _
, gen( no , nose.type ) , gen( no , nose.size )
#m "goto " ; a * winx / 3 + 50 ; " " ; b * winy / 3 + winy / 3.5 - 100
#m "down"
#m "\" ; no
#m "up"
next b
next a
end sub
[info]
notice "this program is for aiding the police" + chr$( 13 ) _
+ "to find a suspect of a crime ." + chr$( 13 ) _
+ "instructions :" + chr$( 13 ) _
+ "1 : set al color's ." + chr$( 13 ) _
+ "2 : push the button ." + chr$( 13 ) _
+ "3 : type 2 digit's of the best lookalikes ." + chr$( 13 ) _
+ "4 : type 1 digit if you have the suspect ." + chr$( 13 ) _
+ "good hunt ."
wait
[input.data]
prompt "type 1 or 2 digits" ; in$
if len( in$ ) <> 1 and len( in$ ) <> 2 then
notice "ERROR : 1 or 2 digits !!"
goto [input.data]
end if
a = val( left$( in$ , 1 ) )
b = val( right$( in$ , 1 ) )
if a < 1 or a > 9 or b < 1 or b > 9 then
notice "ERROR : a digit must be >= 1 and <= 9 !!"
goto [input.data]
end if
if len( in$ ) = 1 then
''suspect found
#m "cls"
call draw.skin winx / 2 , winy / 2 , 3
call draw.chin winx / 2 , winy / 2 , 3 , gen( a - 1 , chin.type )
call draw.hair winx / 2 , winy / 2 , 3 _
, gen( a - 1 , hair.type ) , gen( a - 1 , hair.size )
call draw.eye winx / 2 - 3 * 20 , winy / 2 - 3 * 20 , 3
call draw.eye winx / 2 + 3 * 20 , winy / 2 - 3 * 20 , 3
call draw.nose winx / 2 , winy / 2 , 3 _
, gen( a - 1 , nose.type ) , gen( a - 1 , nose.size )
else
''create next generation
for i = 0 to property.max
gen( 0 , i ) = gen( a - 1 , i )
gen( 1 , i ) = gen( b - 1 , i )
next i
for i = 2 to 9
for j = 0 to property.max
if rnd( 0 ) < .5 then
gen( i , j ) = gen( 0 , j )
else
gen( i , j ) = gen( 1 , j )
end if
next j
if rnd( 0 ) < .1 then
select case dice( 4 )
case nose.type
gen( i , nose.type ) = dice( nose.type.max )
case nose.size
gen( i , nose.size ) = dice( nose.size.max )
case hair.type
gen( i , hair.type ) = dice( hair.type.max )
case hair.size
gen( i , hair.size ) = dice( hair.size.max )
case chin.type
gen( i , chin.type ) = dice( chin.type.max )
case else
end select
end if
next i
call draw9
end if
wait
function dice( x )
dice = int( rnd( 0 ) * ( x + 1 ) )
end function
sub draw.hair x , y , d , type , size
if type <> hair.bold then
#m "color " ; hair.color$
#m "backcolor " ; hair.color$
#m "goto " ; x ; " " ; y - d * 50
#m "down"
#m "piefilled " ; 50 * d ; " " ; 20 * d ; " 180 360"
#m "up"
select case size
case hair.long
q = y + d * 50
case hair.midle
q = y
case hair.short
q = y - d * 50
case else
end select
select case type
case hair.curls
for i = y - d * 50 to q step d * 15
call rond x - d * 45 , i , 10 , 10 , hair.color$
call rond x + d * 45 , i , 10 , 10 , hair.color$
next i
case hair.strait
#m "goto " ; x - d * 50 ; " " ; y - d * 50
#m "down"
#m "boxfilled " ; x - d * 40 ; " " ; q
#m "up"
#m "goto " ; x + d * 50 ; " " ; y - d * 50
#m "down"
#m "boxfilled " ; x + d * 40 ; " " ; q
#m "up"
case else
end select
end if
end sub
sub draw.chin x , y , d , type
if type = chin.rect then
#m "color " ; skin.color$
#m "backcolor " ; skin.color$
#m "goto " ; x - 30 * d ; " " ; y
#m "down"
#m "boxfilled " ; x + 30 * d ; " " ; y + 60 * d
#m "up"
end if
end sub
sub draw.skin x , y , d
call rond x , y , d * 60 , d * 80 , skin.color$
end sub
sub draw.nose x , y , d , type , size
#m "color black"
#m "backcolor " ; skin.color$
select case size
case nose.small
q = 10
case nose.midle
q = 13
case nose.big
q = 16
case else
q = 10
end select
if type = nose.rect then
#m "goto " ; x - d * q ; " " ; y - d * q
#m "down"
#m "boxfilled " ; x + d * q ; " " ; y + d * q
#m "up"
else
#m "goto " ; x ; " " ; y
#m "down"
#m "circlefilled " ; d * q
#m "up"
end if
end sub
sub draw.eye x , y , d
call rond x , y , d * 25 , d * 15 , "white"
call rond x , y , d * 10 , d * 10 , eye.color$
call rond x , y , d * 5 , d * 5 , "black"
end sub
sub rond x , y , dx , dy , clr$
#m "goto " ; x ; " " ; y
#m "color " ; clr$
#m "backcolor " ; clr$
#m "down"
#m "ellipsefilled " ; dx ; " " ; dy
#m "up"
end sub
[skin.color]
colordialog "set skin color" , skin.color$
wait
[hair.color]
colordialog "set hair color" , hair.color$
wait
[eye.color]
colordialog "set eye color" , eye.color$
wait
[quit]
close #m
end
|
|
|
|
Post by bluatigro on Jun 21, 2018 14:07:54 GMT
update :
removed some silly mistakes
''bluatigro 21 jun 2018
''robo suspect hunter
''writen in justbasic 2.0
''proof of concept
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , property.max
winx = WindowWidth
winy = WindowHeight
global nose.rect , nose.circle , nose.type.max , nose.type
nose.rect = 0
nose.circle = 1
nose.type.max = 1
nose.type = 0
global nose.big , nose.midle , nose.small , nose.size.max , nose.size
nose.big = 0
nose.midle = 1
nose.small = 2
nose.size.max = 2
nose.size = 1
global chin.rect , chin.round , chin.type.max , chin.type
chin.rect = 0
chin.round = 1
chin.type.max = 1
chin.type = 2
global hair.bold , hair.strait , hair.curls , hair.type.max , hair.type
hair.bold = 0
hair.strait = 1
hair.curls = 2
hair.type.max = 2
hair.type = 3
global hair.short , hair.midle , hair.long , hair.size.max , hair.size
hair.short = 0
hair.midle = 1
hair.long = 2
hair.size.max = 2
hair.size = 4
property.max = 4
global skin.color$ , hair.color$ , eye.color$
skin.color$ = "pink"
hair.color$ = "yellow"
eye.color$ = "blue"
dim gen( 9 , property.max )
menu #m , "color" _
, "skin color" , [skin.color] _
, "hair color" , [hair.color] _
, "eye color" , [eye.color]
menu #m , "info" _
, "read me" , [info]
button #m.btn , "push me" , [input.data] , UL , 50 , 0 , 200 , 50
nomainwin
open "robo suspect hunter 1.0" for graphics as #m
#m "trapclose [quit]"
#m "font 50 bold"
#m.btn "!font 30 bold"
#m "size 5"
call start.all
wait
sub start.all
#m "cls"
for i = 0 to 9
gen( i , hair.type ) = dice( hair.type.max )
gen( i , hair.size ) = dice( hair.size.max )
gen( i , nose.type ) = dice( nose.type.max )
gen( i , nose.size ) = dice( nose.size.max )
gen( i , chin.type ) = dice( chin.type.max )
next i
call draw9
end sub
sub draw9
#m "cls"
for a = 0 to 2
for b = 0 to 2
x = a * winx / 3 + winx / 6
y = b * winy / 3 + winy / 6
no = 1 + a + b * 3
call draw.skin x , y , 1
call draw.chin x , y , 1 , gen( no , chin.type )
call draw.hair x , y , 1 _
, gen( no , hair.type ) , gen( no , hair.size )
call draw.eye x - 20 , y - 20 , 1
call draw.eye x + 20 , y - 20 , 1
call draw.nose x , y , 1 _
, gen( no , nose.type ) , gen( no , nose.size )
#m "goto " ; a * winx / 3 + 50 ; " " ; b * winy / 3 + winy / 3.5 - 100
#m "down"
#m "\" ; no
#m "up"
next b
next a
end sub
[info]
notice "this program is for aiding the police" + chr$( 13 ) _
+ "to find a suspect of a crime ." + chr$( 13 ) _
+ "instructions :" + chr$( 13 ) _
+ "1 : set al color's ." + chr$( 13 ) _
+ "2 : push the button ." + chr$( 13 ) _
+ "3 : type 2 digit's of the best lookalikes ." + chr$( 13 ) _
+ "4 : type 1 digit if you have the suspect ." + chr$( 13 ) _
+ "good hunt ."
wait
[input.data]
prompt "type 1 or 2 digits" ; in$
if len( in$ ) <> 1 and len( in$ ) <> 2 then
notice "ERROR : 1 or 2 digits !!"
goto [input.data]
end if
a = val( left$( in$ , 1 ) )
b = val( right$( in$ , 1 ) )
if a < 1 or a > 9 or b < 1 or b > 9 then
notice "ERROR : a digit must be >= 1 and <= 9 !!"
goto [input.data]
end if
if len( in$ ) = 1 then
''suspect found
#m "cls"
call draw.skin winx / 2 , winy / 2 , 3
call draw.chin winx / 2 , winy / 2 , 3 , gen( a , chin.type )
call draw.hair winx / 2 , winy / 2 , 3 _
, gen( a , hair.type ) , gen( a , hair.size )
call draw.eye winx / 2 - 3 * 20 , winy / 2 - 3 * 20 , 3
call draw.eye winx / 2 + 3 * 20 , winy / 2 - 3 * 20 , 3
call draw.nose winx / 2 , winy / 2 , 3 _
, gen( a , nose.type ) , gen( a , nose.size )
else
''create next generation
for i = 0 to property.max
gen( 0 , i ) = gen( a , i )
gen( 1 , i ) = gen( b , i )
next i
for i = 2 to 9
for j = 0 to property.max
if rnd( 0 ) < .5 then
gen( i , j ) = gen( 0 , j )
else
gen( i , j ) = gen( 1 , j )
end if
next j
if rnd( 0 ) < .2 then
select case dice( 4 )
case nose.type
gen( i , nose.type ) = dice( nose.type.max )
case nose.size
gen( i , nose.size ) = dice( nose.size.max )
case hair.type
gen( i , hair.type ) = dice( hair.type.max )
case hair.size
gen( i , hair.size ) = dice( hair.size.max )
case chin.type
gen( i , chin.type ) = dice( chin.type.max )
case else
end select
end if
next i
call draw9
end if
wait
function dice( x )
dice = int( rnd( 0 ) * ( x + 1 ) )
end function
sub draw.hair x , y , d , type , size
if type <> hair.bold then
#m "color " ; hair.color$
#m "backcolor " ; hair.color$
#m "goto " ; x ; " " ; y - d * 50
#m "down"
#m "piefilled " ; 50 * d ; " " ; 20 * d ; " 180 360"
#m "up"
select case size
case hair.long
q = y + d * 50
case hair.midle
q = y
case hair.short
q = y - d * 50
case else
end select
select case type
case hair.curls
for i = y - d * 50 to q step d * 15
call rond x - d * 45 , i , d * 10 , d * 10 , hair.color$
call rond x + d * 45 , i , d * 10 , d * 10 , hair.color$
next i
case hair.strait
#m "goto " ; x - d * 50 ; " " ; y - d * 50
#m "down"
#m "boxfilled " ; x - d * 40 ; " " ; q
#m "up"
#m "goto " ; x + d * 50 ; " " ; y - d * 50
#m "down"
#m "boxfilled " ; x + d * 40 ; " " ; q
#m "up"
case else
end select
end if
end sub
sub draw.chin x , y , d , type
if type = chin.rect then
#m "color " ; skin.color$
#m "backcolor " ; skin.color$
#m "goto " ; x - 30 * d ; " " ; y
#m "down"
#m "boxfilled " ; x + 30 * d ; " " ; y + 60 * d
#m "up"
end if
end sub
sub draw.skin x , y , d
call rond x , y , d * 60 , d * 80 , skin.color$
end sub
sub draw.nose x , y , d , type , size
#m "color black"
#m "backcolor " ; skin.color$
select case size
case nose.small
q = 10
case nose.midle
q = 13
case nose.big
q = 16
case else
q = 10
end select
if type = nose.rect then
#m "goto " ; x - d * q ; " " ; y - d * q
#m "down"
#m "boxfilled " ; x + d * q ; " " ; y + d * q
#m "up"
else
#m "goto " ; x ; " " ; y
#m "down"
#m "circlefilled " ; d * q
#m "up"
end if
end sub
sub draw.eye x , y , d
call rond x , y , d * 25 , d * 15 , "white"
call rond x , y , d * 10 , d * 10 , eye.color$
call rond x , y , d * 5 , d * 5 , "black"
end sub
sub rond x , y , dx , dy , clr$
#m "goto " ; x ; " " ; y
#m "color " ; clr$
#m "backcolor " ; clr$
#m "down"
#m "ellipsefilled " ; dx ; " " ; dy
#m "up"
end sub
[skin.color]
colordialog "set skin color" , skin.color$
wait
[hair.color]
colordialog "set hair color" , hair.color$
wait
[eye.color]
colordialog "set eye color" , eye.color$
wait
[quit]
close #m
end
|
|
|
|
Post by bluatigro on Jun 22, 2018 9:42:07 GMT
update :
added a beard and a moustage
its a pitty JB2 can not work whit 32 bit bmp's
and that i dont know where to find the files of face-parts
other wise i can write the real program
that wood be easyer that this because i dont have to write drawing code
''bluatigro 21 jun 2018
''robo suspect hunter
''writen in justbasic 2.0
''proof of concept
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , property.max
winx = WindowWidth
winy = WindowHeight
global nose.rect , nose.circle , nose.type.max , nose.type
nose.rect = 0
nose.circle = 1
nose.type.max = 1
nose.type = 0
global nose.big , nose.small , nose.size.max , nose.size
nose.big = 0
nose.small = 1
nose.size.max = 1
nose.size = 1
global chin.rect , chin.round , chin.type.max , chin.type
chin.rect = 0
chin.round = 1
chin.type.max = 1
chin.type = 2
global hair.none , hair.strait , hair.curls , hair.type.max , hair.type
hair.none = 0
hair.strait = 1
hair.curls = 2
hair.type.max = 2
hair.type = 3
global hair.short , hair.midle , hair.long , hair.size.max , hair.size
hair.short = 0
hair.midle = 1
hair.long = 2
hair.size.max = 2
hair.size = 4
global moustage.none , moustage.rect , moustage.rond
global moustage.type.max , moustage.type
moustage.none = 0
moustage.rect = 1
moustage.round = 2
moustage.type.max = 2
moustage.type = 5
global moustage.big , moustage.smal , moustage.size.max , moustage.size
moustage.big = 0
moustage.smal = 1
moustage.size.max = 1
moustage.size = 6
global beard.none , beard.rect , beard.round , beard.tri
global beard.type.max , beard.type
beard.none = 0
beard.rect = 1
beard.round = 2
beard.type.max = 2
beard.type = 7
global beard.big , bread.smal , bread.size.max , beard.size
beard.big = 0
beard.smal = 1
beard.size.max = 1
beard.size = 8
property.max = 8
global skin.color$ , hair.color$ , eye.color$
skin.color$ = "pink"
hair.color$ = "yellow"
eye.color$ = "blue"
dim gen( 9 , property.max )
menu #m , "color" _
, "skin color" , [skin.color] _
, "hair color" , [hair.color] _
, "eye color" , [eye.color]
menu #m , "read me" _
, "read me" , [info]
button #m.btn , "push me" , [input.data] , UL , 50 , 0 , 200 , 50
nomainwin
open "robo suspect hunter 1.1" for graphics as #m
#m "trapclose [quit]"
#m "font 50 bold"
#m.btn "!font 30 bold"
#m "size 5"
call start.all
wait
sub start.all
#m "cls"
for i = 0 to 9
gen( i , hair.type ) = dice( hair.type.max )
gen( i , hair.size ) = dice( hair.size.max )
gen( i , nose.type ) = dice( nose.type.max )
gen( i , nose.size ) = dice( nose.size.max )
gen( i , chin.type ) = dice( chin.type.max )
gen( i , moustage.type ) = dice( moustage.type.max )
gen( i , moustage.size ) = dice( moustage.size.max )
gen( i , beard.type ) = dice( beard.type.max )
gen( i , beard.size ) = dice( beard.size.max )
next i
call draw9
end sub
sub draw9
#m "cls"
for a = 0 to 2
for b = 0 to 2
x = a * winx / 3 + winx / 6
y = b * winy / 3 + winy / 6
no = 1 + a + b * 3
call draw.skin x , y , 1
call draw.chin x , y , 1 , gen( no , chin.type )
call draw.hair x , y , 1 _
, gen( no , hair.type ) , gen( no , hair.size )
call draw.eye x - 20 , y - 20 , 1
call draw.eye x + 20 , y - 20 , 1
call draw.beard x , y , 1 _
, gen( a , beard.type ) , gen( a , beard.size )
call draw.moustage x , y , 1 _
, gen( a , beard.type ) , gen( a , beard.size )
call draw.nose x , y , 1 _
, gen( no , nose.type ) , gen( no , nose.size ) #m "color black"
#m "backcolor white"
#m "goto " ; a * winx / 3 + 50 ; " " ; b * winy / 3 + winy / 3.5 - 100
#m "down"
#m "\" ; no
#m "up"
next b
next a
end sub
[info]
notice "this program is for aiding the police" + chr$( 13 ) _
+ "to find a suspect of a crime ." + chr$( 13 ) _
+ "instructions :" + chr$( 13 ) _
+ "1 : set al color's ." + chr$( 13 ) _
+ "2 : push the button ." + chr$( 13 ) _
+ "3 : type 2 digit's of the best lookalikes ." + chr$( 13 ) _
+ "4 : type 2 digit's if good property is seen ." + chr$( 13 ) _
+ "5 : type 1 digit if you have the suspect ." + chr$( 13 ) _
+ "number of faces = " ; faces() ; chr$( 13 ) _
+ "good hunt ."
wait
[input.data]
prompt "type 1 or 2 digits" ; in$
if len( in$ ) <> 1 and len( in$ ) <> 2 then
notice "ERROR : 1 or 2 digits !!"
goto [input.data]
end if
a = val( left$( in$ , 1 ) )
b = val( right$( in$ , 1 ) )
if a < 1 or a > 9 or b < 1 or b > 9 then
notice "ERROR : a digit must be >= 1 and <= 9 !!"
goto [input.data]
end if
if len( in$ ) = 1 then
''suspect found
#m "cls"
call draw.skin winx / 2 , winy / 2 , 3
call draw.chin winx / 2 , winy / 2 , 3 , gen( a , chin.type )
call draw.hair winx / 2 , winy / 2 , 3 _
, gen( a , hair.type ) , gen( a , hair.size )
call draw.eye winx / 2 - 3 * 20 , winy / 2 - 3 * 20 , 3
call draw.eye winx / 2 + 3 * 20 , winy / 2 - 3 * 20 , 3
call draw.beard winx / 2 , winy / 2 , 3 _
, gen( a , beard.type ) , gen( a , beard.size )
call draw.moustage winx / 2 , winy / 2 , 3 _
, gen( a , beard.type ) , gen( a , beard.size )
call draw.nose winx / 2 , winy / 2 , 3 _
, gen( a , nose.type ) , gen( a , nose.size )
else
''create next generation whit evolution
for i = 0 to property.max
''save best genes
gen( 0 , i ) = gen( a , i )
gen( 1 , i ) = gen( b , i )
next i
for i = 2 to 9
''crosover genes to create kid genes
for j = 0 to property.max
if rnd( 0 ) < .5 then
gen( i , j ) = gen( 0 , j )
else
gen( i , j ) = gen( 1 , j )
end if
next j
if rnd( 0 ) < .2 then
''mutate some kid genes
select case dice( property.max )
case nose.type
gen( i , nose.type ) = dice( nose.type.max )
case nose.size
gen( i , nose.size ) = dice( nose.size.max )
case hair.type
gen( i , hair.type ) = dice( hair.type.max )
case hair.size
gen( i , hair.size ) = dice( hair.size.max )
case chin.type
gen( i , chin.type ) = dice( chin.type.max )
case beard.type
gen( i , beard.type ) = dice( beard.type.max )
case beard.size
gen( i , beard.size ) = dice( beard.size.max )
case moustage.type
gen( i , moustage.type ) = dice( moustage.type.max )
case moustage.size
gen( i , moustage.size ) = dice( moustage.size.max )
case else
end select
end if
next i
call draw9
end if
wait
function faces()
uit = hair.type.max + 1
uit = uit * ( hair.size.max + 1 )
uit = uit * ( nose.type.max + 1 )
uit = uit * ( nose.size.max + 1 )
uit = uit * ( chin.type.max + 1 )
uit = uit * ( moustege.type.max + 1 )
uit = uit * ( moustage.size.max + 1 )
uit = uit * ( beard.type.max + 1 )
uit = uit * ( beard.size.max + 1 )
faces = uit
end function
function dice( x )
dice = int( rnd( 0 ) * ( x + 1 ) )
end function
sub draw.beard x , y , d , type , size
if type <> beard.none then
select case size
case beard.big
q = 70
case beard.smal
q = 55
case else
end select
select case type
case beard.rect
call rect x - d * q/2 , y + d * 40 , x + d * q/2 , y + d * q _
, hair.color$ , hair.color$ , 1
case beard.round
call rond x , y + d * 50 , d * q , d * q / 2 _
, hair.color$ , hair.color$ , 1
case else
end select
end if
end sub
sub draw.moustage x , y , d , type , size
if type <> moustage.none then
select case size
case moustage.big
q = 50
case moustage.smal
q = 25
case else
end select
select case type
case beard.rect
call rect x - d * q/2 , y + d * 10 , x + d * q/2 , y + d * 20 _
, hair.color$ , hair.color$ , 1
case beard.round
call rond x , y + d * 15 , d * q , d * 10 _
, hair.color$ , hair.color$ , 1
case else
end select
end if
end sub
sub draw.hair x , y , d , type , size
if type <> hair.none then
call rond x , y - d * 50 , d * 60 , d * 20 _
, hair.color$ , hair.color$ , 1
select case size
case hair.long
q = y + d * 50
case hair.midle
q = y
case hair.short
q = y - d * 50
case else
end select
select case type
case hair.curls
for i = y - d * 50 to q step d * 15
call rond x - d * 45 , i , d * 10 , d * 10 _
, hair.color$ , hair.color$ , 1
call rond x + d * 45 , i , d * 10 , d * 10 _
, hair.color$ , hair.color$ , 1
next i
case hair.strait
call rect x - d * 50 , y - d * 50 , x - d * 40 , q _
, hair.color$ , hair.color$ , 1
call rect x + d * 50 , y - d * 50 , x + d * 40 , q _
, hair.color$ , hair.color$ , 1
case else
end select
end if
end sub
sub draw.chin x , y , d , type
if type = chin.rect then
call rect x - 30 * d , y , x + 30 * d , y + 60 * d _
, skin.color$ , skin.color$ , 1
end if
end sub
sub draw.skin x , y , d
call rond x , y , d * 60 , d * 80 , skin.color$ , skin.color$ , 1
end sub
sub draw.nose x , y , d , type , size
#m "color black"
#m "backcolor " ; skin.color$
select case size
case nose.small
q = 10
case nose.big
q = 16
case else
q = 10
end select
if type = nose.rect then
call rect x - d * q , y - d * q , x + d * q , y + d * q _
, "black" , skin.color$ , 4
else
call rond x , y , d * q , d * q , "black" , skin.color$ , 4
end if
end sub
sub draw.eye x , y , d
call rond x , y , d * 25 , d * 15 , "white" , "white" , 1
call rond x , y , d * 10 , d * 10 , eye.color$ , eye.color$ , 1
call rond x , y , d * 5 , d * 5 , "black" , "black" , 1
end sub
sub rect x1 , y1 , x2 , y2 , clr$ , bclr$ , size
#m "size " ; size
#m "goto " ; x1 ; " " ; y1
#m "color " ; clr$
#m "backcolor " ; bclr$
#m "down"
#m "boxfilled " ; x2 ; " " ; y2
#m "up"
end sub
sub rond x , y , dx , dy , clr$ , bclr$ , size
#m "size " ; size
#m "goto " ; x ; " " ; y
#m "color " ; clr$
#m "backcolor " ; bclr$
#m "down"
#m "ellipsefilled " ; dx ; " " ; dy
#m "up"
end sub
sub triangle x1 , y1 , x2 , y2 , x3 , y3 , clr$ , bclr$ , size
if y1 = y2 then y1 = y1 - .1
if y2 = y3 then y3 = y3 + .1
if y1 = y3 then y3 = y3 + .1
if y1 > y3 then
h = y1
y1 = y3
y3 = h
h = x1
x1 = x3
x3 = h
end if
if y1 > y2 then
h = y1
y1 = y2
y2 = h
h = x1
x1 = x2
x2 = h
end if
if y2 > y3 then
h = y2
y2 = y3
y3 = h
h = x2
x2 = x3
x3 = h
end if
#m "color " ; clr$
#m "size 1"
for i = y1 to y3
a = x1 + ( x3 - x1 ) * (i-y1) / ( y3 - y1 )
if i < y2 then
b = x1 + ( x2 - x1 ) * (i-y1) / ( y2 - y1 )
else
b = x2 + ( x3 - x2 ) * (i-y2) / ( y3 - y2 )
end if
if abs( a - b ) > 1 then
#m "down"
#m "line " ; int( a ) ; " " ; i _
; " " ; int( b ) ; " " ; i
#m "up"
end if
next i
#m "color " ; bclr$
#m "size " ; size
#m "down"
#m "line " ; x1 ; " " ; y1 ; " " ; x2 ; " "; y2
#m "line " ; x1 ; " " ; y1 ; " " ; x2 ; " "; y2
#m "line " ; x1 ; " " ; y1 ; " " ; x2 ; " "; y2
#m "up"
end sub
[skin.color]
colordialog "set skin color" , skin.color$
wait
[hair.color]
colordialog "set hair color" , hair.color$
wait
[eye.color]
colordialog "set eye color" , eye.color$
wait
[quit]
close #m
end
|
|
