SimplePumpkinPlay

Simple Jack-O-Lantern Play - JanetTerra

 
    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