Older Version
Newer Version
JanetTerra
Oct 20, 2009
===Simple Jack-O-Lantern Play [[user:JanetTerra]] ===
[[code format="vbnet"]]
Nomainwin
' Janet Terra
' Jack-o-lantern Challenge 2009
' Released into Public Domain
title$ = "Simple Jack-o-Lantern Play"
orange$ = "255 159 63"
edge$ = "255 183 95"
brown$ = "223 143 31"
carve$ = "191 111 0"
pumpkinEyes = 0
pumpkinNose = 0
pumpkinMouth = 0
gWidth = 500
bWidth = 230
WindowWidth = 800
WindowHeight = 600
UpperLeftX = Int((DisplayWidth - WindowWidth) / 2)
UpperLeftY = Int((DisplayHeight - WindowHeight) / 2)
BackgroundColor$ = "Black"
Menu #main, "&Options", "&New", [NewPumpkin],|, _
"E&xit", [EndApp]
Graphicbox #main.g, 0, 0, gWidth, 450
Graphicbox #main.t, 0, 450, gWidth, 100
Graphicbox #main.b, gWidth + 50, 50, bWidth, 350
Open title$ for Window as #main
#main, "Trapclose [EndApp]"
#main.g, "Down; Fill Black"
Gosub [DrawTitle]
#main.b, "Down; Fill Black"
Gosub [GlowSprite]
#main.g, "Fill Black; Home"
#main.g, "Getbmp bg 0 0 1 1"
#main.g, "Background bg"
#main.g, "Posxy pumpkinX pumpkinY"
#main.g, "Spritexy glow ";pumpkinX - 140;" ";pumpkinY - 82
#main.g, "Cyclesprite glow 1"
#main.g, "Segment segPumpkin"
#main.g, "Flush"
[NewPumpkin]
Timer 0
midX = pumpkinX
midY = pumpkinY
EyesSelection = 0
NoseSelection = 0
MouthSelection = 0
h$ = "#main.g"
Gosub [DrawPumpkin]
#main.g, "Segment pumpkinSeg"
#main.g, "Flush"
#main.b, "Down"
Gosub [FaceSelections]
Wait
[ClickSelections]
xClick = MouseX
yClick = MouseY
midX = pumpkinX
midY = pumpkinY
FaceSelection = 0
Timer 0
LightCandle = 0
Select Case
Case xClick > 120
FaceSelection = 0
Case yClick > 105 and yClick < 120
FaceSelection = 1
Case yClick > 130 and yClick < 145
FaceSelection = 2
Case yClick > 155 and yClick < 170
FaceSelection = 3
Case yClick > 205 and yClick < 220
LightCandle = 1
End Select
midX = pumpkinX
midY = pumpkinY
Select Case FaceSelection
Case 1
Gosub [SelectEyes]
Case 2
Gosub [SelectNose]
Case 3
Gosub [SelectMouth]
End Select
If LightCandle = 0 Then
Wait
End If
[SelectCandle]
Gosub [LightCandle]
bg$ = orange$
fg$ = "Black"
Timer 100, [GlowCandle]
Wait
[GlowCandle]
#main.g, "Drawsprites"
Wait
[ClickEyes]
xClick = MouseX
yClick = MouseY
Select Case
Case yClick > 20 and yClick < 80
EyesSelection = 1
eyeY = pumpkinY - 70
Case yClick > 100 and yClick < 160
EyesSelection = 2
eyeY = pumpkinY - 40
Case yClick > 175 and yClick < 220
EyesSelection = 3
eyeY = pumpkinY - 35
Case yClick > 240 and yClick < 280
EyesSelection = 4
eyeY = pumpkinY - 15
Case yClick > 300 and yClick < 330
Gosub [FaceSelections]
Wait
Case Else
Wait
End Select
Gosub [JackOLantern]
Wait
[ClickNose]
xClick = MouseX
yClick = MouseY
Select Case
Case xClick < 85
Wait
Case xClick > 155
Wait
Case yClick > 15 and yClick < 75
NoseSelection = 1
noseY = pumpkinY
Case yClick > 95 and yClick < 145
NoseSelection = 2
noseY = pumpkinY + 30
Case yClick > 165 and yClick < 195
NoseSelection = 3
noseY = pumpkinY + 30
Case yClick > 215 and yClick < 240
NoseSelection = 4
noseY = pumpkinY + 10
Case yClick > 255 and yClick < 280
NoseSelection = 5
noseY = pumpkinY + 20
Case yClick > 300 and yClick < 330
Gosub [FaceSelections]
Wait
Case Else
Wait
End Select
midX = pumpkinX
midY = pumpkinY
Gosub [JackOLantern]
Wait
[ClickMouth]
xClick = MouseX
yClick = MouseY
Select Case
Case yClick > 45 and yClick < 120
MouthSelection = 1
mouthY = pumpkinY + 70
Case yClick > 140 and yClick < 215
MouthSelection = 2
mouthY = pumpkinY + 100
Case yClick > 225 and yClick < 270
MouthSelection = 3
mouthY = pumpkinY + 75
Case yClick > 300 and yClick < 330
Gosub [FaceSelections]
Wait
Case Else
Wait
End Select
midX = pumpkinX
midY = pumpkinY
Gosub [JackOLantern]
Wait
[DrawPumpkin]
If h$ = "#main.g" Then
#h$, "Delsegment ";pumpkinSeg
End If
#h$, "Fill Black; Size 1"
#h$, "Color ";orange$
#h$, "Backcolor ";orange$
#h$, "Place ";midX;" ";midY
#h$, "Circlefilled 152"
#h$, "Size 4"
#h$, "Color ";edge$
#h$, "Place ";midX;" ";midY
#h$, "Circle 154"
#h$, "Color ";brown$
#h$, "Place ";midX;" ";midY + 12
#h$, "Ellipse 40 340"
#h$, "Place ";midX;" ";midY + 12
#h$, "Ellipse 100 340"
#h$, "Place ";midX;" ";midY + 12
#h$, "Ellipse 180 340"
#h$, "Place ";midX;" ";midY + 12
#h$, "Ellipse 250 340"
#h$, "Color ";carve$
x1 = midX - 100
x2 = x1 + 15
y1 = midY - 120
y2 = midY - 110
For t = 1 to 7
#h$, "Line ";x1;" ";y1;" ";x2;" ";y2
x1 = x2
x2 = x1 + 15
#h$, "Line ";x1;" ";y2;" ";x2;" ";y1
x1 = x2
x2 = x1 + 15
Next t
#h$, "Place ";midX;" ";midY
#h$, "Color Black"
For r = 158 to 200
#h$, "Circle ";r
Next r
#h$, "Color Darkgreen"
For s = midX - 15 to midX + 15
#h$, "Place ";s;" ";midY -150
#h$, "North; Turn 30; Go 50"
Next s
Return
[JackOLantern]
h$ = "#main.g"
#h$, "Delsegment ";segPumpkin
flushFlag = 0
midX = pumpkinX
midY = pumpkinY
Gosub [DrawPumpkin]
midX = pumpkinX
midY = pumpkinY
Select Case EyesSelection
Case 1
eyeX = midX - 60
Gosub [Eyes1]
eyeX = midX + 60
Gosub [Eyes1]
Case 2
eyeX = midX - 60
Gosub [Eyes2]
eyeX = midX + 60
Gosub [Eyes2]
Case 3
eyeX = midX - 60
Gosub [Eyes3]
eyeX = midX + 60
Gosub [Eyes3]
Case 4
eyeX = midX - 60
Gosub [Eyes4]
eyeX = midX + 60
Gosub [Eyes4]
End Select
noseX = midX
Select Case NoseSelection
Case 1
Gosub [Nose1]
Case 2
Gosub [Nose2]
Case 3
Gosub [Nose3]
Case 4
Gosub [Nose4]
Case 5
noseX = midX - 10
Gosub [Nose5]
noseX = midX + 10
Gosub [Nose5]
End Select
mouthX = midX
Select Case MouthSelection
Case 1
Gosub [Mouth1]
Case 2
Gosub [Mouth2]
Case 3
Gosub [Mouth3]
End Select
If h$ = "#main.g" Then
#h$ "Segment pumpkinSeg"
#h$, "Flush"
End If
Return
[SelectEyes]
#main.b, "Cls; Fill Yellow"
#main.b, "Backcolor ";orange$
fg$ = "Black"
bg$ = orange$
h$ = "#main.b"
midX = pumpkinX
midY = pumpkinY
eyeX = 55: eyeY = 20
Gosub [Eyes1]
eyeX = 175
Gosub [Eyes1]
eyeX = 55: eyeY = 130
Gosub [Eyes2]
eyeX = 175
Gosub [Eyes2]
eyeX = 55: eyeY = 200
Gosub [Eyes3]
eyeX = 175
Gosub [Eyes3]
eyeX = 55: eyeY = 280
Gosub [Eyes4]
eyeX = 175
Gosub [Eyes4]
#main.b, "Backcolor Yellow; Color ";orange$
#main.b, "Font Times_New_Roman 24 Bold Italic"
x$ = "Cancel"
#main.b, "Stringwidth? x$ width"
#main.b, "Place ";Int((bWidth / 2) - (width / 2));" 330"
#main.b, "\";x$
#main.b, "Flush EyeSelection"
#main.b, "When leftButtonUp [ClickEyes]"
Return
[Eyes1]
#h$, "Size 3"
#h$, "Color ";fg$
For r = 210 to 150 Step -1
#h$, "Place ";eyeX;" ";eyeY
#h$, "North; Turn ";r
#h$, "Go 60"
Next r
#h$, "Color ";bg$
#h$, "Backcolor ";bg$
#h$, "Place ";eyeX;" ";eyeY + 55
#h$, "Circlefilled 7"
Return
[Eyes2]
#h$, "Size 3"
#h$, "Color ";fg$
#h$, "Backcolor ";fg$
#h$, "Place ";eyeX;" ";eyeY
#h$, "Ellipsefilled 45 60"
#h$, "Color ";bg$
#h$, "Backcolor ";bg$
#h$, "Place ";eyeX + 10;" ";eyeY + 20
#h$, "Circlefilled 7"
Return
[Eyes3]
#h$, "Size 3"
#h$, "Color ";fg$
#h$, "Backcolor ";fg$
#h$, "Place ";eyeX;" ";eyeY
#h$, "Ellipsefilled 60 45"
#h$, "Color ";bg$
#h$, "Backcolor ";bg$
#h$, "Place ";eyeX + 25;" ";eyeY
#h$, "Circlefilled 7"
Return
[Eyes4]
#h$, "Size 3"
#h$, "Color ";fg$
for r = -90 to 90
perCent = Abs(r) / 100
goLen = 9 - Int(perCent * 10)
#h$, "Place ";eyeX;" ";eyeY
#h$, "North; Turn ";r
#h$, "Go ";30 + goLen
Next r
#h$, "Color ";bg$
for r = -90 to 90
perCent = Abs(r) / 100
goLen = 9 - Int(perCent * 10)
#h$, "Place ";eyeX - 10;" ";eyeY
#h$, "North; Turn ";r
#h$, "Go ";7 + goLen
Next r
Return
[SelectNose]
#main.b, "Cls; Fill Yellow"
#main.b, "Backcolor ";orange$
fg$ = "Black"
bg$ = orange$
h$ = "#main.b"
noseX = 120: noseY = 20
Gosub [Nose1]
noseX = 120: noseY = 120
Gosub [Nose2]
noseX = 120: noseY = 180
Gosub [Nose3]
noseX = 120: noseY = 200
Gosub [Nose4]
noseX = 110: noseY = 260
Gosub [Nose5]
noseX = 130: noseY = 260
Gosub [Nose5]
#main.b, "Backcolor Yellow; Color ";orange$
#main.b, "Font Times_New_Roman 24 Bold Italic"
x$ = "Cancel"
#main.b, "Stringwidth? x$ width"
#main.b, "Place ";Int((bWidth / 2) - (width / 2));" 330"
#main.b, "\";x$
#main.b, "Flush NoseSelection"
#main.b, "When leftButtonUp [ClickNose]"
Return
[Nose1]
#h$, "Size 3"
#h$, "Color ";fg$
#h$, "Backcolor ";fg$
For r = 210 to 150 Step -1
#h$, "Place ";noseX;" ";noseY
#h$, "North; Turn ";r
#h$, "Go 50"
Next r
Return
[Nose2]
#h$, "Size 3"
#h$, "Color ";fg$
#h$, "Backcolor ";fg$
#h$, "Place ";noseX;" ";noseY
#h$, "Circlefilled 20"
Return
[Nose3]
#h$, "Size 3"
#h$, "Color ";fg$
#h$, "Backcolor ";fg$
#h$, "Place ";noseX;" ";noseY
#h$, "Ellipsefilled 60 20"
Return
[Nose4]
#h$, "Size 3"
#h$, "Color ";fg$
#h$, "Backcolor ";fg$
For r = 210 to 150 Step -1
#h$, "Place ";noseX;" ";noseY
#h$, "North; Turn ";r
#h$, "Up; Go 25; Down; Go 10"
Next r
Return
[Nose5]
#h$, "Size 3"
#h$, "Color ";fg$
#h$, "Backcolor ";fg$
For r = 250 to 110 Step -1
#h$, "Place ";noseX;" ";noseY
#h$, "North; Turn ";r
#h$, "Up; Go 10; Down; Go 5"
Next r
Return
[SelectMouth]
#main.b, "Cls; Fill Yellow"
#main.b, "Backcolor ";orange$
fg$ = "Black"
bg$ = orange$
h$ = "#main.b"
mouthX = 120: mouthY = 50
Gosub [Mouth1]
mouthX = 120: mouthY = 180
Gosub [Mouth2]
mouthX = 120: mouthY = 230
Gosub [Mouth3]
#main.b, "Backcolor Yellow; Color ";orange$
#main.b, "Font Times_New_Roman 24 Bold Italic"
x$ = "Cancel"
#main.b, "Stringwidth? x$ width"
#main.b, "Place ";Int((bWidth / 2) - (width / 2));" 330"
#main.b, "\";x$
#main.b, "Flush MouthSelection"
#main.b, "When leftButtonUp [ClickMouth]"
Return
[Mouth1]
#h$, "Size 3"
#h$, "Color ";fg$
#h$, "Backcolor ";fg$
For r = 270 to 90 Step -1
#h$, "Place ";mouthX;" ";mouthY
#h$, "North; Turn ";r
#h$, "Go 70"
Next r
#h$, "Color ";bg$
#h$, "Backcolor ";bg$
#h$, "Place ";mouthX - 50;" ";mouthY
#h$, "Boxfilled ";mouthX - 30;" ";mouthY + 20
#h$, "Place ";mouthX - 10;" ";mouthY
#h$, "Boxfilled ";mouthX + 10;" ";mouthY + 20
#h$, "Place ";mouthX + 30;" ";mouthY
#h$, "Boxfilled ";mouthX + 50;" ";mouthY + 20
Return
[Mouth2]
#h$, "Size 3"
#h$, "Color ";fg$
#h$, "Backcolor ";fg$
#h$, "Place ";mouthX;" ";mouthY
#h$, "Circlefilled 35"
Return
[Mouth3]
#h$, "Size 3"
#h$, "Color ";fg$
#h$, "Backcolor ";fg$
#h$, "Place ";mouthX - 60;" ";mouthY
#h$, "Boxfilled ";mouthX + 60;" ";mouthY + 40
#h$, "Color ";bg$
#h$, "Backcolor ";bg$
x = mouthX - 50
For t = 1 to 6
For r = -20 to 20
#h$, "Place ";x;" ";mouthY + 10
#h$, "North; Turn ";r
#h$, "Go 12"
Next r
For r = 200 to 160 Step -1
#h$, "Place ";x;" ";mouthY + 30
#h$, "North; Turn ";r
#h$, "Go 12"
Next r
x = x + 20
Next t
Return
[FaceSelections]
#main.b, "Color Black; Backcolor Black"
#main.b, "Cls; Place -5 -5; Boxfilled ";bWidth + 10;" 360"
#main.b, "Font Times_New_Roman 14 Bold Italic"
#main.b, "Place 10 80; Color ";orange$
#main.b, "\Click to"
#main.b, "Font Times_New_Roman 14 Bold"
#main.b, "Color Yellow"
#main.b, "Place 10 120"
#main.b, "\Select Eyes"
#main.b, "Place 10 145"
#main.b, "\Select Nose"
#main.b, "Place 10 170"
#main.b, "\Select Mouth"
#main.b, "Place 10 220"
#main.b, "\Light Candle"
#main.b, "Flush SelectionsText"
#main.b, "When leftButtonUp [ClickSelections]"
Return
[DrawTitle]
#main.t, "Font Times_New_Roman 24 Bold Italic"
#main.t, "Down; Fill Black"
#main.t, "Backcolor Black; Color 255 128 0"
t$ = "Simple Pumpkin Play"
#main.t, "Stringwidth? title$ width"
#main.t, "Place ";Int(gWidth / 2 - 10) - Int(width / 2);" 25"
#main.t, "\";title$
#main.t, "Flush"
Return
[GlowSprite]
gHue = Int(Rnd(1) * 50) * 5
For i = 1 to 4
#main.g, "Color White; Backcolor White"
#main.g, "Place 0 0; Boxfilled 280 224"
#main.g, "Color Black; Backcolor Black"
#main.g, "Place 0 224; Boxfilled 280 448"
#main.g, "Place 140 112; Ellipsefilled 280 224"
rHue = 195 + i * 15
gInc = 5
For x = 280 to 1 Step -1
If gHue < 5 Then
gHue = 5
gInc = 5
End If
If gHue > 250 Then
gHue = 250
gInc = -5
End If
gHue = gHue + gInc
#main.g, "Color ";rHue;" ";gHue;" 0"
#main.g, "Place 140 336; Ellipsefilled ";x;" 224"
#main.g, "Ellipsefilled ";x;" 224"
Next x
#main.g, "Getbmp g";i;" 0 0 280 448"
Next i
#main.g, "Addsprite glow g1 g2 g3 g4"
#main.g, "Spritexy glow 120 150"
#main.g, "Discard"
Return
[LightCandle]
midX = 160
mid1Y = 200
mid2Y = 560
WindowWidth = 500
WindowHeight = 740
UpperLeftX = 1
UpperLeftY = 1
Graphicbox #1.g, 0, 0, 500, 740
' Remove next line for Just BASIC application
Stylebits #1, _WS_POPUP, _WS_CAPTION, 0, 0
Open "" for Window as #1
#1.g, "When leftButtonUp [CloseCandle]"
CandleScreen = 1
#1.g, "Horizscrollbar Off"
#1.g, "Down"
#1.g, "Place 0 360; Boxfilled 350 720"
h$ = "#1.g"
midY = mid2Y
eyeYpumpkin = eyeY
noseYpumpkin = noseY
mouthYpumpkin = mouthY
Gosub [DrawPumpkin]
#1.g, "Color White; Backcolor White"
#1.g, "Place -2 -2; Boxfilled 352 360"
#1.g, "Color Black; Backcolor Black"
midY = mid1Y
#1.g, "Place ";midX;" ";midY
#1.g, "Circlefilled 154"
For s = midX - 15 to midX + 15
#1.g, "Place ";s;" ";midY -150
#1.g, "North; Turn 30; Go 50"
Next s
Select Case EyesSelection
Case 1
eyeY = mid2Y - 70
eyeX = midX - 60
Gosub [Eyes1]
eyeX = midX + 60
Gosub [Eyes1]
Case 2
eyeY = mid2Y - 40
eyeX = midX - 60
Gosub [Eyes2]
eyeX = midX + 60
Gosub [Eyes2]
Case 3
eyeY = mid2Y - 35
eyeX = midX - 60
Gosub [Eyes3]
eyeX = midX + 60
Gosub [Eyes3]
Case 4
eyeY = mid2Y - 15
eyeX = midX - 60
Gosub [Eyes4]
eyeX = midX + 60
Gosub [Eyes4]
End Select
noseX = midX
Select Case NoseSelection
Case 1
noseY = mid2Y
Gosub [Nose1]
Case 2
noseY = mid2Y + 30
Gosub [Nose2]
Case 3
noseY = mid2Y + 30
Gosub [Nose3]
Case 4
noseY = mid2Y + 10
Gosub [Nose4]
Case 5
noseY = mid2Y + 20
noseX = midX - 10
Gosub [Nose5]
noseX = midX + 10
Gosub [Nose5]
End Select
mouthX = midX
Select Case MouthSelection
Case 1
mouthY = mid2Y + 70
Gosub [Mouth1]
Case 2
mouthY = mid2Y + 100
Gosub [Mouth2]
Case 3
mouthY = mid2Y + 75
Gosub [Mouth3]
End Select
bg$ = "Black"
fg$ = "White"
Select Case EyesSelection
Case 1
eyeY = mid1Y - 70
eyeX = midX - 60
Gosub [Eyes1]
eyeX = midX + 60
Gosub [Eyes1]
Case 2
eyeY = mid1Y - 40
eyeX = midX - 60
Gosub [Eyes2]
eyeX = midX + 60
Gosub [Eyes2]
Case 3
eyeY = mid1Y - 35
eyeX = midX - 60
Gosub [Eyes3]
eyeX = midX + 60
Gosub [Eyes3]
Case 4
eyeY = mid1Y - 15
eyeX = midX - 60
Gosub [Eyes4]
eyeX = midX + 60
Gosub [Eyes4]
End Select
eyeY = eyeYpumpkin
Select Case NoseSelection
Case 1
noseY = mid1Y
Gosub [Nose1]
Case 2
noseY = mid1Y + 30
Gosub [Nose2]
Case 3
noseY = mid1Y + 30
Gosub [Nose3]
Case 4
noseY = mid1Y + 10
Gosub [Nose4]
Case 5
noseY = mid1Y + 20
noseX = midX - 10
Gosub [Nose5]
noseX = midX + 10
Gosub [Nose5]
End Select
noseY = noseYpumpkin
Select Case MouthSelection
Case 1
mouthY = midY + 70
Gosub [Mouth1]
Case 2
mouthY = midY + 100
Gosub [Mouth2]
Case 3
mouthY = midY + 75
Gosub [Mouth3]
End Select
mouthY = mouthYpumpkin
#1.g, "Flush PumpkinSprite"
#1, "Show"
#1.g, "Getbmp pumpkin 0 1 320 720"
#main.g, "Addsprite pumpkin pumpkin"
#main.g, "Spritexy pumpkin ";pumpkinX - 160;" ";pumpkinY - 199
#main.g, "Drawsprites"
[CloseCandle]
Close #1
CandleScreen = 0
Return
[EndApp]
Timer 0
If CandleScreen = 1 Then
Close #1
End If
Close #main
End
[[code]]