Page 1 of 1

Just For Kids

Posted: Sun Mar 17, 2013 8:47 am
by GarryRicketson
This is a project I am working on, I have been using qb64 to do it, at this point I need to make a "menu", also there are some minor "adjustments" needed. Any suggestions or ideas, are welcome, usually even when it is qbasic, or qb4.5, code, I can use it with qb64,
I think it would take some major changes though to make it a qbasic, or qb4.5 program.
Hope it is ok to share it here, ?

Code: Select all

REM Much thanks to Unseen, and his "useing a sprite sheet" tutorial, so it code I used to do this.
REM This is being worked on and compiled with qb64 GL 0.977 for linux
REM Also Oldoslover has wrote most of the basic code, I have modified it some
REM to try to get exactly what I want.
DEFINT A-Z
SCREEN _NEWIMAGE(600, 400, 32)
WINDOW SCREEN(200, 100)-(420, 250)
volume = 1 '
intromusic = _SNDOPEN("justforkids.ogg", "VOL")

_SNDVOL intromusic, volume '
_SNDLOOP intromusic '
PRINT " JustForKids With QB64GL  0.977"
PRINT "test1"
_DELAY .5
PRINT " MY DRAWINGS "
_DELAY .5

TYPE Rectangle
    X AS INTEGER
    Y AS INTEGER
    Width AS INTEGER
    Height AS INTEGER
END TYPE

Sprite& = _LOADIMAGE("3.png")
DIM SpriteImageRect(50) AS Rectangle
FOR j% = 0 TO _HEIGHT(Sprite&) - (_HEIGHT(Sprite&) / 2) STEP (_HEIGHT(Sprite&) / 2)
    FOR i% = 0 TO _WIDTH(Sprite&) - (_WIDTH(Sprite&) / 10) STEP (_WIDTH(Sprite&) / 10)
        SpriteImageRect(rectcnt%).X = i%
        SpriteImageRect(rectcnt%).Y = j%
        SpriteImageRect(rectcnt%).Width = _WIDTH(Sprite&) / 10
        SpriteImageRect(rectcnt%).Height = _HEIGHT(Sprite&) / 2
        rectcnt% = rectcnt% + 1
    NEXT

NEXT
FOR i% = 0 TO 19

    _PUTIMAGE (200, 100)-(420, 250), Sprite&, , (SpriteImageRect(i%).X, SpriteImageRect(i%).Y)-(SpriteImageRect(i%).X + SpriteImageRect(i%).Width, SpriteImageRect(i%).Y + SpriteImageRect(i%).Height)
    _DISPLAY
    _DELAY .5
NEXT i%
REM
DEFINT A-Z
CONST True = -1, False = 0
CONST MaxPics = 3, PicWide = 100, PicHigh = 100, MaxScrWidth = 640, MaxScrHeight = 480
TYPE Coords
    x1 AS INTEGER
    y1 AS INTEGER
    x2 AS INTEGER
    y2 AS INTEGER
END TYPE
DIM PicCords(1 TO 3) AS Coords

DIM SHARED PicNames$(3)
DIM SHARED PicHandle(1 TO 3) AS LONG
DIM SHARED mx%, my%, mbl%, mbr%
DIM Locales(1 TO MaxPics) AS INTEGER

DIM SoundFX(1 TO 3) AS LONG
DIM SomeSoundPlaying AS INTEGER
DIM SomeSoundPlayingHandle AS LONG
DIM Playing(1 TO 3) AS INTEGER
DIM Played(1 TO 3) AS INTEGER

Video& = _NEWIMAGE(640, 420, 32)
SCREEN Video&

FOR i% = 19 TO 19
    _PUTIMAGE (0, 0)-(640, 420), Sprite&, , (SpriteImageRect(i%).X, SpriteImageRect(i%).Y)-(SpriteImageRect(i%).X + SpriteImageRect(i%).Width, SpriteImageRect(i%).Y + SpriteImageRect(i%).Height)

NEXT
PRINT "TEST4"
PRINT "Press escape to quit"
SLEEP

_MOUSESHOW
GOSUB MakCoords
GOSUB LoadPics
GOSUB LoadSoundFXs
GOSUB DisplayPics


DO
    _LIMIT 30

    MousePoll
    GOSUB PollPics
    PRINT
    COLOR _RGB32(255, 255, 255)
    LOCATE 1, 1
    GOSUB HighlightSelection
    GOSUB AnySoundFXStillPlaying
    IF AnyFXPlaying = True THEN
        'do nothing till current soundFX is finished playing
    ELSE
        IF PicSelected% <> OldPicSelected% THEN GOSUB ResetPlayed
        IF PicSelected% <> 0 THEN GOSUB Chek4SoundFXNowPlaying
        OldPicSelected% = PicSelected%
    END IF
    _DISPLAY
LOOP UNTIL _KEYDOWN(27)
SLEEP

SYSTEM
'---------------------------- GOSUBS
AnySoundFXStillPlaying:
'Are any SFX currently playing
AnyFXPlaying = False
FOR t% = 1 TO 3
    AnyFXPlaying = _SNDPLAYING(SoundFX(t%))
    IF AnyFXPlaying = True THEN EXIT FOR
NEXT t%
RETURN

Chek4SoundFXNowPlaying:
'Is the wanted sound already playing
Playing(PicSelected%) = _SNDPLAYING(SoundFX(PicSelected%))
IF Playing(PicSelected%) = True THEN
    RETURN
ELSE
    GOSUB Chek4SoundFXBeenPlayed
END IF
RETURN

Chek4SoundFXBeenPlayed:
' Has this sound been played before while in this selected state
IF Played(PicSelected%) = True THEN
    RETURN
ELSE
    GOSUB PlaySoundFX1
END IF
RETURN

ResetPlayed:
FOR t% = 1 TO 3
    Played(t%) = False
NEXT t%
RETURN

PlaySoundFX1:
SELECT CASE PicSelected%
    CASE 1
        _SNDPLAY SoundFX(1)
        Played(PicSelected%) = True ' <--- workd but needs to be toggled when new selection occurs
    CASE 2
        _SNDPLAY SoundFX(2)
        Played(PicSelected%) = True ' <--- workd but needs to be toggled when new selection occurs
    CASE 3
        _SNDPLAY SoundFX(3)
        Played(PicSelected%) = True ' <--- workd but needs to be toggled when new selection occurs
END SELECT
RETURN

PollPics:
IF mbl% = -1 THEN
    'button is down check x and y coords
ELSE
    RETURN
END IF

SELECT CASE my%
    CASE 100 TO 200
        'we in correct range up and down the screen
    CASE ELSE
        PicSelected% = 0
        RETURN
END SELECT

SELECT CASE mx%
    CASE PicCords(1).x1 TO PicCords(1).x2
        PicSelected% = 1
        AnimalName$ = "APE"
    CASE PicCords(2).x1 TO PicCords(2).x2
        PicSelected% = 2
        AnimalName$ = "BEAR"
    CASE PicCords(3).x1 TO PicCords(3).x2
        PicSelected% = 3
        AnimalName$ = "CAT"
    CASE ELSE
        PicSelected% = 0
END SELECT
RETURN

HighlightSelection:
FOR t% = 1 TO 3
    IF PicSelected% = t% THEN
        FOR tt% = 0 TO 2
            LINE (PicCords(t%).x1 - tt%, PicCords(t%).y1 - tt%)-(PicCords(t%).x2 + tt%, PicCords(t%).y2 + tt%), _RGB32(255, 255, 0), B
        NEXT tt%
        COLOR _RGB32(255, 255, 255)
        _PRINTSTRING (PicCords(t%).x1 + 10, PicCords(t%).y2 + 10), AnimalName$
    ELSE
        FOR tt% = 0 TO 2
            '     LINE (PicCords(t%).x1 - tt%, PicCords(t%).y1 - tt%)-(PicCords(t%).x2 + tt%, PicCords(t%).y2 + tt%), _RGB32(0, 0, 0), B
        NEXT tt%
        COLOR _RGB32(0, 0, 0)
        BlankName$ = "        "
        _PRINTSTRING (PicCords(t%).x1 + 10, PicCords(t%).y2 + 10), BlankName$
    END IF
NEXT t%
RETURN

MakCoords:
TotalPicWide% = MaxPics * PicWide
TotalBlankWide% = MaxScrWidth - TotalPicWide%
TotalNumberSpaceBetweenPics% = MaxPics + 1
IndividualSpaceBetweenPics% = TotalBlankWide% \ TotalNumberSpaceBetweenPics%
FOR Locations% = 1 TO MaxPics
    Locales(Locations%) = IndividualSpaceBetweenPics% * Locations% + Gap%
    PicCords(Locations%).x1 = Locales(Locations%)
    PicCords(Locations%).x2 = PicCords(Locations%).x1 + PicWide - 1
    PicCords(Locations%).y1 = 100
    PicCords(Locations%).y2 = PicCords(Locations%).y1 + PicHigh - 1
    Gap% = Gap% + 100
NEXT Locations%
RETURN

DisplayPics:
FOR t% = 1 TO 3
    _PUTIMAGE (PicCords(t%).x1, PicCords(t%).y1)-(PicCords(t%).x2, PicCords(t%).y2), PicHandle(t%), Video&
NEXT t%
RETURN

LoadPics:
FOR t = 1 TO 3
    READ Temp$
    Temp$ = RTRIM$(LTRIM$(Temp$))
    PicNames$(t) = Temp$
    PicHandle(t) = _LOADIMAGE(Temp$, 32)
    IF PicHandle(t) = -1 THEN
        PRINT "Image not found"
        dummy$ = INPUT$(1)
        SYSTEM
    END IF
    'PRINT Temp$, PicHandle(t)
NEXT t
RETURN

LoadSoundFXs:
FOR t% = 1 TO 3
    READ Temp$
    SoundFX(t%) = _SNDOPEN(Temp$, "VOL,SYNC")
    IF SoundFX(t%) = 0 THEN
        PRINT "Unable to load sound effect ,"; Temp$
        dummy$ = INPUT$(1)
        SYSTEM
    END IF
    'PRINT Temp$, SoundFX(t%)
NEXT t%
RETURN
'============================== CALL SUBS
SUB MousePoll ()
DO WHILE _MOUSEINPUT
    mx% = __MOUSEX: my% = _MOUSEY: mbl% = _MOUSEBUTTON(1): mbr% = _MOUSEBUTTON(2)
LOOP
END SUB

'****************************** DATA
DATA Ape1.png,Bear1.png,Cat1.png
DATA Ape-se.wav,Bear-se.wav,Cat-se.wav

I will add a link to a zipped package, with the images and sound files needed shortly.
from garry
Here is the link to the zipped package, it includes all the images and sprite sheet needed.
JustForKids3-test.zip