Post by: SMcNeill on July 28, 2019, 02:23:39 pm
Code: [Select]
SoundDir$ = ".\Alphabet Sounds\"
DIM AlphaSound(65 TO 90)
FOR i = 65 TO 90
temp$ = SoundDir$ + CHR$(i) + ".ogg"
AlphaSound(i) = _SNDOPEN(temp$, "VOL,SYNC,LEN,PAUSE")
NEXT
DO
INPUT "Input word to spell aloud: "; word$
IF word$ = "" THEN SYSTEM
word$ = UCASE$(word$)
FOR i = 1 TO LEN(word$)
_SNDPLAY AlphaSound(ASC(word$, i))
_DELAY 1
NEXT
LOOPMy niece recently just gave birth to a lovely little girl (8 lbs 3 ozs), and I was thinking of a simple little program to help them learn to read and write in a few years. What I've came up with is a very nice little concept (at least, I think it is):
Step 1: Let the user download some free images from the internet (such as a cat or dog, or such), and then save them with that filename.
Step 2: The program should look in the folder for those image files, and then pop the picture up on the screen, and then place them on the screen for us, along with their letters. It should then read those letters back to us, to help a child familiarize themselves with the images of those letters on the screen, and how they correspond to each other.
What we have here is just a demo of taking a word and spelling it out aloud for the user, but I plan to expand upon it later so it'll do as described above. My question to you guys is:
1) Is there someone who wants to record their voice saying various words and share them for this project? I've got a speech impediment which sometimes slurs some of my spoken words (which is one reason, I suppose, why I turned to writing as a means to get my thoughts and ideas across to the world), so just some simple *.ogg recordings of "cat", "dog", "frog", and so on would be appreciated.
2) Anyone have a good source for low resolution images of simple words? I don't need a million large images to package with this little program; small ones which represent the image will work nicely -- but they need to be copywrite free/open.
3) This should work quite easily for nouns and such, but does anyone have an idea how we'd represent an ACTION like this? How do we convey the concept of "run", "bounce", "fall"?
All-in-all, it seems like a simple enough concept to pull off for a program; just a little time consuming to gather various images to showcase our words....
Anywho, I thought I'd share the concept and see if anyone would be interested in helping me to assemble a simple little program like this. ;)
Post by: Petr on July 28, 2019, 04:15:19 pm
However, this idea caught my attention. Pictures would probably be enough in 256 colors. The moving things, well, I would solve the file name such as sprite-run, sprite-fall ... but here we encounter a technical problem, because the ordinary user does not download, as a programmer, the correct format sprite image, for example, 5 frames and two rows. Thus, sprite would have to be present in the program beforehand. I thought of an improvement. Suppose the file is named "good brown dog .gif". It might be possible for the program to spell and print only the name since the last space (dog), according to the space in the name and the set level (brown dog) or at top level the full title. That's just an idea. Definitely, on pinterest I downloaded pictures to the meditation program, there are many free, another option is to download SVG and save part of the screen to compatible format.
Next idea - is on screen cat image? Press to it and play "meow" :-D This can be done with internal DATA block and included audio files...
(DATA CAT, meow.ogg, DOG, bark.ogg ....)
Post by: Petr on July 28, 2019, 04:24:02 pm
Post by: SMcNeill on July 28, 2019, 07:39:07 pm
Now all I need is:
Tons of simple photos like the whopping three I've assembled so far,
And someone with a clear, easy to understand voice to speak the actual words so I can put them into another \sounds\ directory and load them so I can have the program talk to us like:
"C"
"A"
"T"
...
"CAT"
...
"C"
"A"
"T"
Speak the letters, say the word, Speak the letters again...
Once I get a good assortment of words and images, I'll probably have the program set up so you can run learning exercises with it...
Let it go through a cycle of 10 words, 3 times each (30 total images would go across the screen), and then pop an image up on the screen and ask, "Can you spell (insert image word here)?" Let the child give it a shot, see how they do, and then score them just like in school.
Problem words can be saved to a list for future study, and passed words will go into a different list for review much later (like mid terms or final exams in schools).
All in all, I think this has the potential to be a nice little teaching tool for young children (or as a starting point for anyone who might want to learn the English language, for that matter.)
Try it out and tell me what you think of it guys. :D
Post by: Pete on July 29, 2019, 01:14:36 am
https://www.vectorstock.com/royalty-free-vector/surprised-emoji-with-a-mexican-hat-vector-20777258
https://www.vectorstock.com/royalty-free-vector/cartoon-man-with-two-rollers-paints-a-brick-wall-vector-24911576
I'm pretty sure that's a MAGA hat, in that one.
Oh, you wanted a cat... OK, got it... https://www.vectorstock.com/royalty-free-vector/halloween-black-cat-vector-1350256
Kidding aside, a lot less sites have free images these days and a lot of them are going to "For personal use only." I would consider what you want it for to be just that, but if you wanted to market it at some point, well, that's a horse of a different color. Anyway, 1,000? That will take you awhile. I believe WGET has a newly added image search function, but I'm not sure if you could use it on sites like these. If it could point to only the free for personal use images, you could download all of them, and sort them out later. I made some kind of utility for this ages ago, just searching for the 3-letter extension of image files. Sure, you could get that off of Bing, Google, DuckDuckGo, etc., but again, you would be stumbling all over copyright issues, but if you could target only free images, you'd be golden.
Good luck, and congrats on the addition to the family.
Pete
Post by: Petr on July 29, 2019, 11:14:43 am
Post by: Petr on July 29, 2019, 04:46:46 pm
Post by: SMcNeill on July 30, 2019, 11:59:34 am
Code: [Select]
SCREEN _NEWIMAGE(800, 600, 32)
_TITLE "Spell It Aloud"
DEFLNG A-Z
RANDOMIZE TIMER
CONST ImageDir$ = ".\Images\"
CONST SoundDir$ = ".\Alphabet Sounds\"
DIM AlphaSound(65 TO 90)
REDIM SHARED PhotoList(100000) AS STRING
REDIM SHARED PhotoTags(100000) AS STRING
DIM SHARED f AS LONG, f1 AS LONG
'load our fonts
f = _LOADFONT("courbd.ttf", 84, "MONOSPACE")
f1 = _LOADFONT("courbd.ttf", 20, "MONOSPACE")
_FONT f
fw = _FONTWIDTH: fh = _FONTHEIGHT
'Load the alphabet sound library
FOR i = 65 TO 90
temp$ = SoundDir$ + CHR$(i) + ".ogg"
AlphaSound(i) = _SNDOPEN(temp$, "VOL,SYNC,LEN,PAUSE")
NEXT
_FONT f
'Get a listing of the files
PhotoList$ = ImageDir$ + "*.bmp " + ImageDir$ + "*.jpg " + ImageDir$ + "*.png " + ImageDir$ + "*.gif "
SHELL _HIDE "DIR " + PhotoList$ + "/b /s /a-d >PhotoList.txt"
'Load those names into a file.
OPEN "Photolist.txt" FOR BINARY AS #1
DO UNTIL EOF(1)
PhotoCount = PhotoCount + 1
LINE INPUT #1, PhotoList(PhotoCount)
LOOP
REDIM _PRESERVE PhotoList(PhotoCount)
CLOSE
_DELAY 1 'Give everything a moment to initialize and get started for us.
DO
DO UNTIL photochosen <> oldpic
photochosen = INT(RND * PhotoCount) + 1
LOOP
oldpic = photochosen
word$ = UCASE$(PhotoList(photochosen))
word$ = MID$(word$, _INSTRREV(word$, "\") + 1)
word$ = LEFT$(word$, INSTR(word$, ".") - 1)
IF tempimage <> 0 THEN _FREEIMAGE tempimage 'free the old image
tempimage = _LOADIMAGE(PhotoList(photochosen), 32) 'get the new image
GetTags word$
CLS
_PUTIMAGE (50, 50)-(750, 500), tempimage 'Put the image to the screen
ShowTags 'Display the tags up top
'Put the letters to the screen one by one
pw = _PRINTWIDTH(word$): StartX = (_WIDTH - pw) \ 2 'center position
FOR i = 1 TO LEN(word$)
a = ASC(word$, i) AND NOT 32 'play lowercase letters as uppercase sounds
_PRINTSTRING (StartX + (i - 1) * fw, 510), MID$(word$, i, 1)
IF a < 65 OR a > 90 THEN _CONTINUE 'ignore non-letters in the file name
_SNDPLAY AlphaSound(a)
WHILE _SNDPLAYING(AlphaSound(a)) 'wait for sound to finish before playing again
_LIMIT 10 'play nice with CPU during wait
WEND
NEXT
DO
k = _KEYHIT
_KEYCLEAR
_LIMIT 10
SELECT CASE k
CASE 65, 97 'a,A
AddTags word$
CASE 68, 100 'd,D
DeleteTags word$
CASE 32 'space
_DELAY 1
EXIT DO
CASE 27 'escape
SYSTEM 'quit
END SELECT
LOOP
LOOP
SUB BlankTop
LINE (0, 0)-(799, 49), &HFF000000, BF 'blank out the top info
END SUB
SUB AddTags (tfile$)
BlankTop
_FONT f1
LOCATE 1, 1: PRINT "Add Tag:";
INPUT tag$
IF tag$ <> "" THEN
u = UBOUND(phototags)
FOR i = 1 TO u
IF _STRICMP(tag$, PhotoTags(i)) = 0 THEN TagExists = -1: EXIT FOR
NEXT
IF NOT TagExists THEN
REDIM _PRESERVE PhotoTags(u + 1) AS STRING
PhotoTags(u + 1) = tag$
file$ = ".\Images\" + tfile$ + ".txt"
OPEN file$ FOR OUTPUT AS #1
FOR i = 1 TO u + 1
PRINT #1, "#";
PRINT #1, PhotoTags(i);
PRINT #1, " ";
NEXT
CLOSE
END IF
END IF
ShowTags
_FONT f
END SUB
SUB DeleteTags (tfile$)
BlankTop
_FONT f1
LOCATE 1, 1: PRINT "Delete Tag:";
INPUT tag$
IF tag$ <> "" THEN
u = UBOUND(phototags)
FOR i = 1 TO u
IF _STRICMP(tag$, PhotoTags(i)) = 0 THEN TagExists = -1: EXIT FOR
NEXT
IF TagExists THEN
FOR j = i TO u - 1
PhotoTags(j) = PhotoTags(j + 1)
NEXT
REDIM _PRESERVE PhotoTags(u - 1) AS STRING
file$ = ".\Images\" + tfile$ + ".txt"
OPEN file$ FOR OUTPUT AS #1
FOR i = 1 TO u - 1
PRINT #1, "#";
PRINT #1, PhotoTags(i);
PRINT #1, " ";
NEXT
CLOSE
END IF
END IF
ShowTags
_FONT f
END SUB
SUB GetTags (tfile$)
'Load the PhotoTags
file$ = ".\Images\" + tfile$ + ".txt"
OPEN file$ FOR BINARY AS #1
IF LOF(1) = 0 THEN 'if there's no tags, we can't get them.
CLOSE
REDIM _PRESERVE PhotoTags(0) AS STRING
EXIT SUB
END IF
DO UNTIL EOF(1)
LINE INPUT #1, junk$
l = 1
DO UNTIL l = 0
l = INSTR(junk$, "#")
IF l THEN
junk$ = MID$(junk$, l + 1)
l1 = INSTR(junk$, "#")
IF l1 = 0 THEN 'nothing more, we now have the tag
tag$ = junk$
l = 0
ELSE
tag$ = LEFT$(junk$, l1 - 1)
junk$ = MID$(junk$, l1)
END IF
END IF
tag$ = _TRIM$(tag$) 'no leading/tailing spaces for ease of matching
TagFound = 0
FOR i = 1 TO TagCount 'Check the existing tags to see if these exist
IF PhotoTags(i) = tag$ THEN TagFound = -1: EXIT FOR
NEXT
IF NOT TagFound THEN 'If not, add the new tags to the list
TagCount = TagCount + 1
IF TagCount > UBOUND(PhotoTags) THEN REDIM _PRESERVE PhotoTags(TagCount + 1000) AS STRING
PhotoTags(TagCount) = tag$
END IF
LOOP
LOOP
CLOSE
REDIM _PRESERVE PhotoTags(TagCount) AS STRING
END SUB
SUB ShowTags
BlankTop
_FONT f1
PRINT UBOUND(phototags); " TAGS: "
FOR i = 1 TO UBOUND(Phototags)
PRINT "#"; PhotoTags(i); " ";
NEXT
_FONT f
END SUBWhen a picture is now loaded, the program should either read the tag file, or else create a blank one for it. You can easily add tags by hitting the A key, and delete them with the D key, before moving on to the next image.
Later, I foresee adding in a routine to allow the user to limit results via tags, so they can create "custom-style lesson plans" for children. I think here would be a good place to grab word lists to organize by year/week to create lesson plans for children: https://www.k12reader.com/worksheet/first-grade-master-spelling-list/view/
For example: Sight words and -at family words
1. the
2. of
3. and
4. that
5. cat
6. mat
7. sat
8. hat
Some of those would be hard to represent with pictures alone (the, of, and, that), but the cat, hat, mat easily and readily fits the format of this little program.
By adding tags such as #Year1 #AT_Word #Week1, we can fix it so that an user could search for those things and have only them pop up for a "study guide", to help a child learn those items.
"cat" might have the tags: #Year1 #AT_Word #Week1 #Animal #Pet #Cute #Fluffy (and whatever else we want to describe it with), so later the user can enter their search tags and easily create a custom-list of photos for their child to spell and look at. :)
You're going the route of adding sounds to the program; I thought I'd take the steps towards making us a searchable tag-system for ease of usability. Between the both of us, we may end up with a really nice little teaching tool out of this project. ;)
Post by: Petr on July 30, 2019, 12:13:56 pm
Post by: Petr on July 30, 2019, 12:23:13 pm
Post by: Petr on July 30, 2019, 12:49:45 pm
Code: [Select]
'Steve's idea: 10 different words, each of which is repeated three times and then one is picked and the child writes image name
'(text input, I suppose, because QB64 does not have microphone support)?
SCREEN _NEWIMAGE(800, 600, 32)
_TITLE "Spell It Aloud"
RANDOMIZE TIMER
ImageDir$ = ".\Images\"
SoundDir$ = ".\Alphabet Sounds\"
DIM SHARED AlphaSound(65 TO 90), f AS LONG, f1 AS LONG
REDIM SHARED PhotoList(100000) AS STRING
REDIM SHARED PhotoTags(100000) AS STRING
REDIM SHARED IMG10(9) AS LONG 'array fo 10 different images. Contains diferent indexes numbers for PhotoList()
'load our fonts
f = _LOADFONT("courbd.ttf", 84, "MONOSPACE")
f1 = _LOADFONT("courbd.ttf", 20, "MONOSPACE")
_FONT f
fw = _FONTWIDTH: fh = _FONTHEIGHT
'Load the alphabet sound library
FOR i = 65 TO 90
temp$ = SoundDir$ + CHR$(i) + ".ogg"
AlphaSound(i) = _SNDOPEN(temp$, "VOL,SYNC,LEN,PAUSE")
NEXT
'Get a listing of the files
PhotoList$ = ImageDir$ + "*.bmp " + ImageDir$ + "*.jpg " + ImageDir$ + "*.png " + ImageDir$ + "*.gif "
SHELL _HIDE "DIR " + PhotoList$ + "/b /s /a-d >PhotoList.txt"
'Load those names into a file.
OPEN "Photolist.txt" FOR BINARY AS #1
DO UNTIL EOF(1)
PhotoCount = PhotoCount + 1
LINE INPUT #1, PhotoList(PhotoCount)
LOOP
CLOSE #1
REDIM _PRESERVE PhotoList(PhotoCount)
_DELAY 1 'Give everything a moment to initialize and get started for us.
Insert_10_Different_Images 'insert 10 different indexes numbers from PhotoList, to array IMG10() [LONG] [0..9]
DO
' DO UNTIL photochosen <> oldpic
' RANDOMIZE TIMER
' photochosen = INT(RND * PhotoCount) + 1
' LOOP
' oldpic = photochosen
photochosen = IMG10(index)
index = index + 1
IF index > 9 THEN index = INT(1 + RND * 8): Query = 1
word$ = UCASE$(PhotoList(photochosen))
word$ = MID$(word$, _INSTRREV(word$, "\") + 1)
word$ = LEFT$(word$, INSTR(word$, ".") - 1)
IF tempimage < -1 THEN _FREEIMAGE tempimage
tempimage = _LOADIMAGE(PhotoList(photochosen), 32)
GetTags word$
'Put the image to the screen UPGRADE
FOR Loop_it = 1 TO 3 'as you say. 3x one word + image, this 10x with different images an then query.
CLS
'program photo area is 700 x 450 pixels. So:
GetNewWH 700, 450, tempimage, nW, nH
Ws = 400 - (nW / 2)
We = 400 + (nW / 2)
Hs = 300 - (nH / 2) - 25
He = 300 + (nH / 2) - 25
_PUTIMAGE (Ws, Hs)-(We, He), tempimage
ShowTags 'Display the tags up top
'Put the letters to the screen one by one
pw = _PRINTWIDTH(word$)
StartX = (_WIDTH - pw) \ 2
IF Query = 0 THEN 'as you need: 10x 3 words and then query to image name
FOR i = 1 TO LEN(word$)
a = ASC(word$, i) AND NOT 32
_PRINTSTRING (StartX + (i - 1) * fw, 510), MID$(word$, i, 1)
IF ASC(word$, i) = 32 THEN _DELAY .5: _CONTINUE
IF a < 65 OR a > 90 THEN _CONTINUE
_SNDPLAY AlphaSound(ASC(word$, i))
DO WHILE _SNDPLAYING(AlphaSound(ASC(word$, i))): LOOP ' UPGRADE
NEXT
ELSE
oldFont = _FONT
_FONT 16
'is time to query.....none _INPUTSTRING statement.... :) i am so lasy!!!!!
_PRINTSTRING (10, 510), "Insert image name: "
DO UNTIL inpt$ = CHR$(13)
inpt$ = INKEY$
IF INT(TIMER) MOD 2 = 0 THEN cursor$ = "_" ELSE cursor$ = ""
IF LEN(inpt$) THEN
word2$ = word2$ + UCASE$(inpt$)
IF inpt$ = CHR$(9) THEN word2$ = LEFT$(word2$, LEN(word2$) - 1) 'backspace
END IF
_PRINTSTRING (10 + (20 * 8), 510), word2$ + cursor$
LOOP
ok$ = "Correct!"
okl = _PRINTWIDTH(ok$)
word2$ = MID$(word2$, 1, LEN(word2$) - 1) 'erase CHR$(13) - ENTER from this word
IF UCASE$(_TRIM$(word2$)) = UCASE$(_TRIM$(word$)) THEN
_FONT oldFont
StartX = _WIDTH / 2 - okl / 2
_PRINTSTRING (StartX, 510), ok$
SLEEP 2
END IF
Query = 0
Insert_10_Different_Images
_FONT oldFont
index = 0
_CONTINUE
END IF ' if query condition
WordPlay word$
DO
WHILE _MOUSEINPUT: WEND
MX = _MOUSEX
MY = _MOUSEY
IF MX > Ws AND MX < We AND MY > Hs AND MY < He THEN
IF _FILEEXISTS(_CWD$ + "\animal sounds\" + word$ + ".mp3") THEN
_MOUSESHOW "link"
IF _MOUSEBUTTON(1) THEN AnimalSound word$
END IF
ELSE
_MOUSESHOW "default"
END IF
'keyboard access
k = _KEYHIT
_KEYCLEAR
_LIMIT 10
SELECT CASE k
CASE 65, 97 'a,A
AddTags word$
CASE 68, 100 'd,D
DeleteTags word$
CASE 32 'space
' _DELAY 1
SLEEP 1 ' Better for testing it
EXIT DO
CASE 27 'escape
SYSTEM 'quit
END SELECT
LOOP
NEXT Loop_it
LOOP
SUB AnimalSound (Word$)
ASound$ = _CWD$ + "\animal sounds\" + Word$ + ".mp3"
aAsound = _SNDOPEN(ASound$)
_SNDPLAY aAsound
DO WHILE _SNDPLAYING(aAsound)
IF LEN(INKEY$) THEN _SNDSTOP (aAsound): EXIT DO
LOOP
_SNDCLOSE aAsound
_MOUSESHOW "default"
END SUB
SUB GetNewWH (destWidth, destHeight, handle AS LONG, NewWidth, NewHeight) 'Sub return in variables NewWidth and NewHeight new image Width and image Height with the same ratio for optimal picture to set area width and height with [destWidth, destHeight]
W = _WIDTH(handle)
H = _HEIGHT(handle)
Pw = W / destWidth
Ph = H / destHeight
IF W > H THEN P = Pw ELSE P = Ph
NewWidth = W / P
NewHeight = H / P
END SUB
SUB Insert_10_Different_Images 'place 10 different indexes from array PhotoList
Max = UBOUND(photolist) 'PhotoList [1..?]
REDIM IMG10(9) AS LONG
pass = 0
DIM i_nr AS INTEGER
DO UNTIL pass = 10
st:
RANDOMIZE TIMER
i_nr = 1 + RND * Max
FOR t = 0 TO 9
IF IMG10(t) = i_nr THEN GOTO st
NEXT t
FOR t = 0 TO 9
IF IMG10(t) = 0 THEN IMG10(t) = i_nr: pass = pass + 1: EXIT FOR
NEXT t
LOOP
END SUB
SUB WordPlay (W AS STRING) 'will be replaced to my own mp3..... i never learn english, BUT I TRY IT.
'path$ = _CWD$ + "\Words\" + W$ + ".mp3"
'Word = _SNDOPEN(path$)
'_SNDPLAY Word
'DO WHILE _SNDPLAYING(Word): LOOP
FOR l = 1 TO LEN(W)
char = ASC(W, l)
IF char = 32 THEN _DELAY .5: _CONTINUE
_SNDPLAY AlphaSound(char)
_DELAY .35
NEXT l
END SUB
SUB BlankTop
LINE (0, 0)-(799, 49), &HFF000000, BF 'blank out the top info
END SUB
SUB AddTags (tfile$)
BlankTop
_FONT f1
LOCATE 1, 1: PRINT "Add Tag:";
INPUT tag$
IF tag$ <> "" THEN
u = UBOUND(phototags)
FOR i = 1 TO u
IF _STRICMP(tag$, PhotoTags(i)) = 0 THEN TagExists = -1: EXIT FOR
NEXT
IF NOT TagExists THEN
REDIM _PRESERVE PhotoTags(u + 1) AS STRING
PhotoTags(u + 1) = tag$
file$ = ".\Images\" + tfile$ + ".txt"
OPEN file$ FOR OUTPUT AS #1
FOR i = 1 TO u + 1
PRINT #1, "#";
PRINT #1, PhotoTags(i);
PRINT #1, " ";
NEXT
CLOSE
END IF
END IF
ShowTags
_FONT f
END SUB
SUB DeleteTags (tfile$)
BlankTop
_FONT f1
LOCATE 1, 1: PRINT "Delete Tag:";
INPUT tag$
IF tag$ <> "" THEN
u = UBOUND(phototags)
FOR i = 1 TO u
IF _STRICMP(tag$, PhotoTags(i)) = 0 THEN TagExists = -1: EXIT FOR
NEXT
IF TagExists THEN
FOR j = i TO u - 1
PhotoTags(j) = PhotoTags(j + 1)
NEXT
REDIM _PRESERVE PhotoTags(u - 1) AS STRING
file$ = ".\Images\" + tfile$ + ".txt"
OPEN file$ FOR OUTPUT AS #1
FOR i = 1 TO u - 1
PRINT #1, "#";
PRINT #1, PhotoTags(i);
PRINT #1, " ";
NEXT
CLOSE
END IF
END IF
ShowTags
_FONT f
END SUB
SUB GetTags (tfile$)
'Load the PhotoTags
file$ = ".\Images\" + tfile$ + ".txt"
OPEN file$ FOR BINARY AS #1
IF LOF(1) = 0 THEN 'if there's no tags, we can't get them.
CLOSE
REDIM _PRESERVE PhotoTags(0) AS STRING
EXIT SUB
END IF
DO UNTIL EOF(1)
LINE INPUT #1, junk$
l = 1
DO UNTIL l = 0
l = INSTR(junk$, "#")
IF l THEN
junk$ = MID$(junk$, l + 1)
l1 = INSTR(junk$, "#")
IF l1 = 0 THEN 'nothing more, we now have the tag
tag$ = junk$
l = 0
ELSE
tag$ = LEFT$(junk$, l1 - 1)
junk$ = MID$(junk$, l1)
END IF
END IF
tag$ = _TRIM$(tag$) 'no leading/tailing spaces for ease of matching
TagFound = 0
FOR i = 1 TO TagCount 'Check the existing tags to see if these exist
IF PhotoTags(i) = tag$ THEN TagFound = -1: EXIT FOR
NEXT
IF NOT TagFound THEN 'If not, add the new tags to the list
TagCount = TagCount + 1
IF TagCount > UBOUND(PhotoTags) THEN REDIM _PRESERVE PhotoTags(TagCount + 1000) AS STRING
PhotoTags(TagCount) = tag$
END IF
LOOP
LOOP
CLOSE
REDIM _PRESERVE PhotoTags(TagCount) AS STRING
END SUB
SUB ShowTags
BlankTop
_FONT f1
PRINT UBOUND(phototags); " TAGS: "
FOR i = 1 TO UBOUND(Phototags)
PRINT "#"; PhotoTags(i); " ";
NEXT
_FONT f
END SUB
Post by: SMcNeill on July 31, 2019, 03:25:24 pm
I've started to implement a better search/tag system for the images, allowing us to quickly and easily customize the images we show for the user. The input routines are now working, but I need to add the save/change routine for the tags on the photos themselves...
Currently my time is rather limited (my wife is in the hospital again, with severe dehydration from "oozing ulcers" causing her extreme stomach issues), so I'm not able to push this project forward at the speed which I'd like to see it go -- but I'll eventually get to the finish line! It'll just take a little longer than anticipated... (...like usual. :P )
Post by: Petr on July 31, 2019, 04:21:38 pm
Why in your color CONST you use unsigned long mark - this hexadecimal value is this type also without this mark
Wouldn't it be better to put the TAG search under the icon to activate it? Put a few icons on the right - to search for TAGs, to edit TAGs, to volume? It's just a suggestion. Is this the intention that only numbers can be entered when editing Photo Tags theme? I suppose he should go in there to enter the text?
If you want, I'll make those icon adjustments, and I would add some background. Tell me if you want to go the way when the TAG dialog will be right in the main window, or we'll complicate it a bit with icons (I can would do it tomorrow).
Post by: SMcNeill on July 31, 2019, 04:47:45 pm
Here’s why:
Code: [Select]
SCREEN _NEWIMAGE(800,600,32)
CONST White = &HFFFFFFFF ‘bright white
COLOR White
PSET (0,0), White
IF POINT(0,0) = White THEN
PRINT “It matches”
ELSE
PRINT “You broke your program! Try UNSIGNED LONG instead!
END IFPOINT returns FLOAT values (and I have no idea why they’re not integer), and 1234567890 (Whatever the unsigned value actually is) is *NOT* equal to -1 (the signed value).
Think of it as _BYTE value vs _UNSIGNED _BYTE:
DIM b AS _UNSIGNED _BYTE
b = 1
IF b = NOT 0 THEN.....
NOT 0 is -1.
1 is not equal to -1.
That’s a FALSE if statement.
If you keep colors unsigned, you’ll save yourself a lot of headaches in the future.
As for layout/changes, give me a day or two to finish up things and get them functional, and then we can tweak them and move them around a bit.
If you look, the editor allows for both numbers and text in the tags. Year is a number, as is Week, but Sound and Theme are both strings.
Think of cat as: Year 1, Week 1, “AT”, “Animal”.
Cat, hat, bat, sat, pat, fat.... all these are “AT” words and contain the same sound.
Year/Week/Sound info can all be gathered from the lists here: https://www.k12reader.com/worksheet/first-grade-master-spelling-list/view/
Theme is just whatever seems to make sense. Animal, Person, Vehicle, etc...
And if you look at the internal folders, you’ll even find my voice recorded now for “cat.MP3” and “is how you spell.MP3”. I’ll try and add more words as time allows, since nobody is volunteering to be a pet “mike-monkey” for the project.
Post by: Petr on July 31, 2019, 05:17:24 pm
Post by: Petr on July 31, 2019, 05:33:35 pm
Code: QB64: [Select]
- TYPE TagType
- _TITLE "Spell It Aloud"
- ImageDir$ = ".\Images\"
- SoundDir$ = ".\Alphabet Sounds\"
- 'load our fonts
- _FONT f
- 'Load the alphabet sound library
- _FONT f
- ChangeSearchTags
- Insert_10_Different_Images 'insert 10 different indexes numbers from PhotoList, to array IMG10() [LONG] [0..9]
- ' DO UNTIL photochosen <> oldpic
- ' RANDOMIZE TIMER
- ' photochosen = INT(RND * PhotoCount) + 1
- ' LOOP
- ' oldpic = photochosen
- photochosen = IMG10(index)
- index = index + 1
- fullpath$ = PhotoList(photochosen)
- 'Put the image to the screen UPGRADE
- _FONT f1
- CenterText 0, 0, 800, 50, "Spell It Aloud"
- _FONT f
- 'program photo area is 700 x 450 pixels. So:
- GetNewWH 500, 450, tempimage, nW, nH
- Ws = 300 - (nW / 2)
- We = 300 + (nW / 2)
- Hs = 300 - (nH / 2) - 25
- He = 300 + (nH / 2) - 25
- DisplayTags 575, 150, "Search Tags", LimitTag
- DisplayTags 575, 300, "Photo Tags", PhotoTag
- 'Put the letters to the screen one by one
- StartX = (600 - pw) \ 2
- oldFont = _FONT
- _FONT 16
- 'is time to query.....none _INPUTSTRING statement.... :) i am so lasy!!!!!
- inpt$ = INKEY$
- ok$ = "Correct!"
- _FONT oldFont
- SLEEP 2
- Query = 0
- Insert_10_Different_Images
- _FONT oldFont
- index = 0
- WordPlay word$
- MX = _MOUSEX
- MY = _MOUSEY
- _MOUSESHOW "link"
- _MOUSESHOW "default"
- 'keyboard access
- k = _KEYHIT
- _LIMIT 10
- ' _DELAY 1
- SYSTEM 'quit
- NEXT Loop_it
- _SNDPLAY aAsound
- _SNDCLOSE aAsound
- _MOUSESHOW "default"
- Pw = W / destWidth
- Ph = H / destHeight
- NewWidth = W / P
- NewHeight = H / P
- SUB Insert_10_Different_Images 'place 10 different indexes from array PhotoList
- pass = 0
- st:
- NEXT t
- NEXT t
- 'path$ = _CWD$ + "\Words\" + W$ + ".mp3"
- 'Word = _SNDOPEN(path$)
- '_SNDPLAY Word
- 'DO WHILE _SNDPLAYING(Word): LOOP
- _DELAY .35
- NEXT l
- SUB ChangeSearchTags
- 'Get a listing of the files
- PhotoList$ = ImageDir$ + "*.bmp " + ImageDir$ + "*.jpg " + ImageDir$ + "*.png " + ImageDir$ + "*.gif "
- 'Load those names into a file.
- PhotoCount = 0
- ' IF LimitTag.Year = 0 AND LimitTag.Week = 0 AND _TRIM$(LimitTag.Sound) = "" AND _TRIM$(LimitTag.Theme) = "" THEN
- file$ = TagDir$ + word$ + ".txt"
- CLOSE #2
- good = -1
- PhotoCount = PhotoCount + 1
- PhotoList(PhotoCount) = fullpath$
- s = SaveState
- _FONT 16
- Box x, y, 100, 20, 1, Black, Gold
- CenterText x, y, x + 100, y + 20, temp$
- k = _KEYHIT
- CASE 8
- CASE 13
- _LIMIT 10
- ChangeValue$ = word$
- RestoreState s
- s = SaveState
- _FONT 16
- w = 200: h = 106
- Box x, y, w, h, 2, BlueGray, Gold
- CenterText x, y + 2, x + 200, y + 20, Title
- xs = x + 24: ys = y + 24 'x/y start after the box offset
- bxs = xs + 50: bys = ys - 2 'x/y start for the display boxes
- Box bxs, bys + i * 20, 100, 20, 1, Black, Gold
- CenterValue bxs, bys, bxs + 100, bys + 20, DisplayTag.Year
- CenterValue bxs, bys + 20, bxs + 100, bys + 40, DisplayTag.Week
- CenterText bxs, bys + 60, bxs + 100, bys + 80, DisplayTag.Theme
- RestoreState s
- xmax = x2 - x1: ymax = y2 - y1
- xpos = (xmax - textlength) / 2
- CenterText x1, y1, x2, y2, text$
- FUNCTION SaveState
- TYPE SaveStateType
- 'Data to Save
- SS.InUse = -1
- SS.F = _FONT
- SS.DC = _DEFAULTCOLOR
- SS.BG = _BACKGROUNDCOLOR
- SS.D = _DEST
- SS.S = _SOURCE
- SS.Disp = _AUTODISPLAY
- SS.CurY = CSRLIN
- SaveState = i
- NSS = NSS + 1
- SaveState = NSS
- SS.InUse = 0 'Let the routine know that we're no longer in use for this handle
- _FONT SS.F
- COLOR SS.DC, SS.BG
- _DEST SS.D
- _SOURCE SS.S
- LOCATE SS.CurY, SS.CurX
[ This attachment cannot be displayed inline in 'Print Page' view ]
Post by: SMcNeill on July 31, 2019, 08:48:30 pm
The little search areas now search and no longer tell you to die if they don't make a match.
You can click and update search or photo tags with a simple click of the mouse.
If the word "cat" comes up, you'll now get to hear my voice talking to you! Aren't you lucky!!
So what's next?
A replay button would be nice, so the user could hear the word again if they want.
A next button so we don't have to use the spacebar, unless we just want to.
A mouse click to exit the input routines when changing the search/photo tags. It's amazing how naturally that feels to me, and how much I notice not being able to do it.
An option to REVIEW, where we can replay the current choices X number of times to review them.
An option to QUIZ, where we then take the quiz on the current options and see if we can actually spell them.
And after that??
I dunno! At that point, I think just grabbing photos, sounds, and organizing them so we'd have a large assortment for learning would be all that we'd have left to gather!
Post by: bplus on July 31, 2019, 09:29:22 pm
Steve's code with comment in CONST line does not work but this does!
Code: QB64: [Select]
Post by: Petr on August 01, 2019, 01:48:45 am
The same correct output as BPlus:
Code: QB64: [Select]
- LOCATE 10
+ found CRITICAL IDE bug. For killing IDE write this line:
CONST whiteA = &HFFFFFFFF\
it is a typo - killer for IDE.
see us later
Post by: Petr on August 01, 2019, 02:49:09 pm
[ This attachment cannot be displayed inline in 'Print Page' view ]
Post by: Petr on August 01, 2019, 03:26:29 pm
Code: QB64: [Select]
off topic - Steve, yesterday you had the funny report Die! in program and today we solved killed IDEs after CONST. Maybe ghosts work ... :)
Post by: SMcNeill on August 01, 2019, 03:53:32 pm
I still do on it, but today not so fast...
I've gotten side-tracked as well, and haven't been working on it as I'd intended. Today I've been digging around and playing in QB64's internals itself, corrrecting the IDE killing glitch and adding in a $COLOR32 metacommand (for my personal pleasure, even if it's not for anybody else's). You can see my post on it here: https://www.qb64.org/forum/index.php?topic=1556.0
I'll try and look at your changes and work on this again tomorrow, if time allows. My wife thinks she should be released from the hospital later tonight, or early in the morning, and my free time is going to disappear while helping her get settled home once more.
Post by: Petr on August 01, 2019, 04:10:19 pm
Of course, health and family are always in the first place. I wish you full health for you both.
Post by: Petr on August 01, 2019, 05:23:13 pm
next image, replay word, set volume, quit. Buttons for quiz and for test are not programmed.
Post by: SMcNeill on August 01, 2019, 05:28:52 pm
So here is next develop version with icons (buttons). Tomorrow i try solving buttons reaction time (sometimes is loooong). Add new folder "Config" contains background image and icon image. Functional buttons:
next image, replay word, set volume, quit. Buttons for quiz and for test are not programmed.
I’m thinking the best way to handle all the input would be to swap over to an ON TIMER event. Then we can have an escape variable to stop the SDNPLAY loops and keep the program responsive at all times. I’ll see about doing the swap over later tonight. ;D
Post by: Petr on August 01, 2019, 05:44:14 pm
Post by: SMcNeill on August 02, 2019, 06:38:15 pm
At this point, we can now STOP the speech in the middle of a word ("cat" is a very good test word for stopping, as it's the only one which actually says the word itself and then repeats the spelling for you a second time), and we can now PLAY a word as many times as we want.
At this point, the next order of business is to actually build the REVIEW buttons (we already create the list of acceptable images which fit our search parameters), so we can set the number of times we want to review our words/images in a setting...
I picture this to be as simple as a setting with a value from 1 to 5 (a quick set of click buttons should quickly set the value), after which we generate a study list of Number of Pictures * Times to Review.
So let's say we have a list of 3 words which meet our match criteria: "HAT, CAT, BAT"
And then we want to study them 2 times...
We just shuffle that list twice and put it into a new list: "CAT, BAT, HAT, BAT, HAT, CAT"
This new list will be our "study list", and the LAST and NEXT buttons will give us manual control to move forward and backward in the list as we wish...
After the review list (and movement buttons) are added, all that's left is to create the TEST button so a child can then test themselves and see how well they do with the words when the images show up for them.
And after that... It's more or less a done product. :D
Post by: Petr on August 03, 2019, 05:12:59 am
Code: QB64: [Select]
Post by: SMcNeill on August 03, 2019, 05:19:18 am
Code: QB64: [Select]
- $COLOR32
- TYPE TagType
- _TITLE "Spell It Aloud"
- 'load our fonts
- _FONT f
- 'Load the alphabet sound library
- temp$ = WordSoundDir$ + "is how you spell.ogg"
- _FONT f
- ChangeSearchTags
- Timer1 = _FREETIMER
- oldpic = PhotoChosen
- playagain:
- fullpath$ = PhotoList(PhotoChosen)
- 'program photo area is 500 x 450 pixels. So:
- GetNewWH 500, 450, tempimage, nW, nH
- LoadPhotoTags word$
- DisplayTags 575, 300, "Photo Tags", PhotoTag
- PlayLetters word$
- DrawNoMatches
- _LIMIT 10
- SUB UserInput
- STATIC oldmouse
- MB = 0
- ChangeSearchTags
- ChangeSearchTags
- LimitTag.Sound = temp$
- ChangeSearchTags
- temp$ = ChangeValue(650, 231, LimitTag.Theme, 0)
- LimitTag.Theme = temp$
- ChangeSearchTags
- ChangePhotoTags word$
- ChangePhotoTags word$
- ChangePhotoTags word$
- PhotoTag.Theme = ChangeValue(650, 381, PhotoTag.Theme, 0)
- ChangePhotoTags word$
- ShowNext = -2
- ShowNext = -1
- ControlVariable1 = -1 'Stop Command for playing the word
- ControlVariable = 0
- k = _KEYHIT
- ShowNext = -1
- SYSTEM 'quit
- DrawCommandBoxes
- SUB DrawCommandBoxes
- s = SaveState
- _FONT 16
- BoxTitle 575, 450, 640, 470, 2, BlueGray, Gold, "LAST"
- BoxTitle 641, 450, 705, 470, 2, BlueGray, Gold, "PLAY"
- BoxTitle 706, 450, 770, 470, 2, BlueGray, Gold, "NEXT"
- BoxTitle 575, 471, 640, 490, 2, BlueGray, Gold, "VOL"
- COLOR Maroon
- BoxTitle 641, 471, 705, 490, 2, BlueGray, Gold, "STOP"
- COLOR Yellow
- BoxTitle 706, 471, 770, 490, 2, BlueGray, Gold, "QUIT"
- RestoreState s
- Box x1, y1, x2 - x1 + 1, y2 - y1 + 1, thick, fg, bg
- CenterText x1, y1 + thick, x2, y2 + thick, title$
- SUB DrawNoMatches
- S = SaveState
- _FONT f1
- Box 50, 50, 500, 500, 5, Silver, Gold
- CenterText 0, 0, 800, 50, "Spell It Aloud"
- CenterText 50, 50, 550, 550, "No Matches"
- PhotoTag.Year = 0
- PhotoTag.Week = 0
- PhotoTag.Theme = ""
- RestoreState S
- DisplayTags 575, 300, "Photo Tags", PhotoTag
- ShowNext = -1
- 'Put the letters to the screen one by one
- ControlVariable1 = 0
- temp$ = WordSoundDir$ + word$ + ".ogg"
- _SNDPLAY IsHowYouSpell
- _SNDPLAY temp
- _SNDCLOSE temp
- _DELAY 1
- 'Get a listing of the files
- file$ = TagDir$ + word$ + ".txt"
- file$ = TagDir$ + word$ + ".txt"
- PhotoTag.Year = 0
- PhotoTag.Week = 0
- PhotoTag.Theme = ""
- SUB ChangeSearchTags
- 'Get a listing of the files
- PhotoList$ = ImageDir$ + "*.bmp " + ImageDir$ + "*.jpg " + ImageDir$ + "*.png " + ImageDir$ + "*.gif "
- 'Load those names into a file.
- PhotoCount = 0
- file$ = TagDir$ + word$ + ".txt"
- CLOSE #2
- good = -1
- PhotoCount = PhotoCount + 1
- PhotoList(PhotoCount) = fullpath$
- ShowNext = -1
- S = SaveState
- _FONT 16
- Box x, y, 100, 20, 1, Black, Gold
- CenterText x, y, x + 100, y + 20, temp$
- k = _KEYHIT
- CASE 8
- CASE 13
- _LIMIT 10
- ChangeValue$ = word$
- RestoreState S
- DisplayTags 575, 300, "Photo Tags", PhotoTag
- S = SaveState
- _FONT 16
- w = 200: h = 106
- Box x, y, w, h, 2, BlueGray, Gold
- CenterText x, y + 2, x + 200, y + 20, Title
- xs = x + 24: ys = y + 24 'x/y start after the box offset
- bxs = xs + 50: bys = ys - 2 'x/y start for the display boxes
- Box bxs, bys + i * 20, 100, 20, 1, Black, Gold
- CenterValue bxs, bys, bxs + 100, bys + 20, DisplayTag.Year
- CenterValue bxs, bys + 20, bxs + 100, bys + 40, DisplayTag.Week
- CenterText bxs, bys + 60, bxs + 100, bys + 80, DisplayTag.Theme
- RestoreState S
- xmax = x2 - x1: ymax = y2 - y1
- xpos = (xmax - textlength) / 2
- CenterText x1, y1, x2, y2, text$
- FUNCTION SaveState
- TYPE SaveStateType
- 'Data to Save
- SS.InUse = -1
- SS.F = _FONT
- SS.DC = _DEFAULTCOLOR
- SS.BG = _BACKGROUNDCOLOR
- SS.D = _DEST
- SS.S = _SOURCE
- SS.Disp = _AUTODISPLAY
- SS.CurY = CSRLIN
- SaveState = i
- NSS = NSS + 1
- SaveState = NSS
- SS.InUse = 0 'Let the routine know that we're no longer in use for this handle
- _FONT SS.F
- COLOR SS.DC, SS.BG
- _DEST SS.D
- _SOURCE SS.S
- LOCATE SS.CurY, SS.CurX
- Pw = W / destWidth
- Ph = H / destHeight
- NewWidth = W / P
- NewHeight = H / P
Sorry! I apparently forgot to post the code block earlier. /blush
Post by: Petr on August 03, 2019, 05:26:00 am
Post by: SMcNeill on August 03, 2019, 05:35:34 am
This easy and very stupid code show, what i mean, if i say, that ON TIMER get out in middle in the loop:Code: QB64: [Select]
Sometimes, you want to be able to pop in and out of the middle of a loop.
Code: [Select]
DIM f AS LONG
ON TIMER(.1) GOSUB timerdone
TIMER ON
DO
c = (c + 1) MOD 16
COLOR c
PRINT "COLOR "; c,
_LIMIT 10 'no need to use a lot of CPU; we're going to handle things VIA the timed routine
LOOP
timerdone:
IF NOT paused THEN
f = f + 1
PRINT "For next loop value is:"; f
END IF
k = _KEYHIT
IF k = 32 THEN GOSUB pausetimer
RETURN
pausetimer:
paused = NOT paused
RETURNThe above is a very simple demo of how things might interact so that we do one thing (the main process), while still using ON TIMER as a means to handle control of other processes.
In the Spell It code I posted above, the SUB UserInput reads mouse/keystrokes via an ON TIMER routine, and by utilizing its ability to jump out of the middle of loops/subs, we can use it as a ready means to set control flags so we can stop the sound playing at any point in the process.
Code: [Select]
_SNDPLAY AlphaSound(a)
WHILE _SNDPLAYING(AlphaSound(a)) 'wait for sound to finish before playing again
_LIMIT 10 'play nice with CPU during wait
IF ControlVariable1 THEN _SNDSTOP (AlphaSound(a))
WEND
ControlVariable1 can be set in the ON TIMER routine, and when set, we stop the sound and simply wait for the next process to be initiated by the user. (play, next, quit, ect...)
Post by: Petr on August 03, 2019, 05:51:45 am
I am on the end in your source code in new compiled IDE with support for your new metacommand $color and give this screen.... Line 579 not exists, maximal row value in source code is 501...
if i comment your new metacommand, i find next bug - you use none LOF(1) control in SUB ChangeSearchTags, so, if is user idiot, so as me, and copy your Spell source code to new installation dir without needed subdirectories, so it generate Input past end of file on row 309 :)
image with your source code so, as it, with missing subdirectories for Spell program:
Post by: Petr on August 03, 2019, 05:55:21 am
Post by: SMcNeill on August 03, 2019, 06:08:18 am
Steve.... i am very curious. How is this possible?
It's actually a glitch which I didn't notice in the last BAS file I posted earlier.
If you open QB64.bas (which you downloaded from earlier), do a quick search for $COLOR32. At line 2981, you'll see where there's:
Code: [Select]
IF a3u$ = "$COLOR32" THEN
ColorHack = -1This is where QB64 is now parsing the metacommand for $COLOR32. What it's doing is very simple -- it's actually just injecting those lines into your code (much like a native $INCLUDE statement would), and adding them to your available CONST list...
The glitch is rather simple: I didn't bother to parse those statements and add the values manually to the CONST list (it's a bunch of different TYPE values which we use to track them), since QB64 already parses and deals with them for us, as it reads our code. The glitch is that each time it processes them, it adds to the linecount for them -- all 200+ times!
Fix is really simple:
Add a line for: oldlinenumber = linenumber to the start of that IF block, and then linenumber = oldlinenumber to the end of that IF block (right before the GOTO which continues processing the rest of our code.
So that error you're getting isn't past the end of the file; your internal line counter is just off, until that one little glitch is corrected.
(There's always something simple like this, which is overlooked when making changes, which is why we have a development build for people to test these things, and a stable build so they don't have to worry about them.) ;D
Post by: Petr on August 03, 2019, 06:27:48 am
Code: QB64: [Select]
We are going to have lunch, I will work with it again later.
Post by: FellippeHeitor on August 03, 2019, 09:41:23 am
It's actually a glitch which I didn't notice in the last BAS file I posted earlier.
If you open QB64.bas (which you downloaded from earlier), do a quick search for $COLOR32. At line 2981, you'll see where there's:Code: [Select]IF a3u$ = "$COLOR32" THEN
ColorHack = -1
This is where QB64 is now parsing the metacommand for $COLOR32. What it's doing is very simple -- it's actually just injecting those lines into your code (much like a native $INCLUDE statement would), and adding them to your available CONST list...
The glitch is rather simple: I didn't bother to parse those statements and add the values manually to the CONST list (it's a bunch of different TYPE values which we use to track them), since QB64 already parses and deals with them for us, as it reads our code. The glitch is that each time it processes them, it adds to the linecount for them -- all 200+ times!
Fix is really simple:
Add a line for: oldlinenumber = linenumber to the start of that IF block, and then linenumber = oldlinenumber to the end of that IF block (right before the GOTO which continues processing the rest of our code.
So that error you're getting isn't past the end of the file; your internal line counter is just off, until that one little glitch is corrected.
(There's always something simple like this, which is overlooked when making changes, which is why we have a development build for people to test these things, and a stable build so they don't have to worry about them.) ;D
Might also be a good idea to only inject the CONST declarations if ColorHack = 0.
Post by: Petr on August 03, 2019, 10:24:06 am
Code: QB64: [Select]
I must upgrading my version in own way, because in your new source is too many news.
Post by: Petr on August 03, 2019, 11:16:05 am
Post by: SMcNeill on August 04, 2019, 01:06:51 am
Code: QB64: [Select]
- $COLOR32
- TYPE TagType
- _TITLE "Spell It Aloud"
- 'load our fonts
- _FONT f
- 'Load the alphabet sound library
- temp$ = WordSoundDir$ + "is how you spell.ogg"
- _FONT f
- WordList(0) = 3 'three times repeating the list, as default
- ChangeSearchTags
- ShowNext = -1
- ControlVariable = 0
- MB = mouseclick
- ChangeSearchTags
- ShowNext = -1
- ChangeSearchTags
- ShowNext = -1
- LimitTag.Sound = temp$
- ChangeSearchTags
- ShowNext = -1
- temp$ = ChangeValue(650, 231, LimitTag.Theme, 0)
- LimitTag.Theme = temp$
- ChangeSearchTags
- ShowNext = -1
- ChangePhotoTags word$
- ShowNext = -1: ControlVariable1 = -1
- ChangePhotoTags word$
- ShowNext = -1: ControlVariable1 = -1
- ChangePhotoTags word$
- ShowNext = -1: ControlVariable1 = -1
- PhotoTag.Theme = ChangeValue(650, 381, PhotoTag.Theme, 0)
- ChangePhotoTags word$
- ShowNext = -1: ControlVariable1 = -1
- PhotoChosen = PhotoChosen - 1
- ShowNext = -1
- ShowNext = -1
- PhotoChosen = PhotoChosen + 1
- ShowNext = -1
- k = _KEYHIT
- PhotoChosen = PhotoChosen + 1
- ShowNext = -1
- SYSTEM 'quit
- ShowNext = 0
- temp$ = PhotoList(WordList(PhotoChosen))
- 'program photo area is 500 x 450 pixels. So:
- GetNewWH 500, 450, tempimage, nW, nH
- LoadPhotoTags word$
- DisplayTags 575, 150, temp$, LimitTag
- DisplayTags 575, 300, "Photo Tags", PhotoTag
- DrawCommandBoxes
- DrawNoMatches
- ControlVariable1 = 0
- _LIMIT 10
- SUB DrawCommandBoxes
- s = SaveState
- _FONT 16
- BoxTitle 575, 450, 640, 470, 2, BlueGray, Gold, "LAST"
- BoxTitle 641, 450, 705, 470, 2, BlueGray, Gold, "PLAY"
- BoxTitle 706, 450, 770, 470, 2, BlueGray, Gold, "NEXT"
- BoxTitle 575, 471, 640, 490, 2, BlueGray, Gold, "VOL"
- COLOR Maroon
- BoxTitle 641, 471, 705, 490, 2, BlueGray, Gold, "STOP"
- COLOR Yellow
- BoxTitle 706, 471, 770, 490, 2, BlueGray, Gold, "QUIT"
- RestoreState s
- Box x1, y1, x2 - x1 + 1, y2 - y1 + 1, thick, fg, bg
- CenterText x1, y1 + thick, x2, y2 + thick, title$
- SUB DrawNoMatches
- S = SaveState
- _FONT f1
- Box 50, 50, 500, 500, 5, Silver, Gold
- CenterText 0, 0, 800, 50, "Spell It Aloud"
- CenterText 50, 50, 550, 550, "No Matches"
- PhotoTag.Year = 0
- PhotoTag.Week = 0
- PhotoTag.Theme = ""
- DisplayTags 575, 150, "Search Tags (0)", LimitTag
- DisplayTags 575, 300, "Photo Tags", PhotoTag
- RestoreState S
- 'Put the letters to the screen one by one
- ControlVariable1 = 0
- GOSUB checkstop
- temp$ = WordSoundDir$ + word$ + ".ogg"
- _SNDPLAY IsHowYouSpell
- GOSUB checkstop
- _SNDPLAY temp
- GOSUB checkstop
- _SNDCLOSE temp
- GOSUB checkstop
- checkstop:
- ControlVariable1 = -1 'Stop Command for playing the word
- 'Get a listing of the files
- file$ = TagDir$ + word$ + ".txt"
- file$ = TagDir$ + word$ + ".txt"
- PhotoTag.Year = 0
- PhotoTag.Week = 0
- PhotoTag.Theme = ""
- SUB ChangeSearchTags
- 'Get a listing of the files
- PhotoList$ = ImageDir$ + "*.bmp " + ImageDir$ + "*.jpg " + ImageDir$ + "*.png " + ImageDir$ + "*.gif "
- 'Load those names into a file.
- PhotoCount = 0
- file$ = TagDir$ + word$ + ".txt"
- CLOSE #2
- good = -1
- PhotoCount = PhotoCount + 1
- PhotoList(PhotoCount) = fullpath$
- MakeList
- SUB MakeList
- RepeatCount = WordList(0)
- WordList(0) = RepeatCount
- PhotoChosen = 1
- PhotoChosen = 0
- TempList(i) = i
- Count = Count + 1
- WordList(Count) = TempList(j)
- S = SaveState
- _FONT 16
- Box x, y, 100, 20, 1, Black, Gold
- CenterText x, y, x + 100, y + 20, temp$
- k = _KEYHIT
- CASE 8
- CASE 13
- _LIMIT 10
- DisplayTags 575, 300, "Photo Tags", PhotoTag
- ChangeValue$ = tword$
- RestoreState S
- S = SaveState
- _FONT 16
- W = 200: h = 106
- Box x, y, W, h, 2, BlueGray, Gold
- CenterText x, y + 2, x + 200, y + 20, Title
- xs = x + 24: ys = y + 24 'x/y start after the box offset
- bxs = xs + 50: bys = ys - 2 'x/y start for the display boxes
- Box bxs, bys + i * 20, 100, 20, 1, Black, Gold
- CenterValue bxs, bys, bxs + 100, bys + 20, DisplayTag.Year
- CenterValue bxs, bys + 20, bxs + 100, bys + 40, DisplayTag.Week
- CenterText bxs, bys + 60, bxs + 100, bys + 80, DisplayTag.Theme
- RestoreState S
- xmax = x2 - x1: ymax = y2 - y1
- xpos = (xmax - textlength) / 2
- CenterText x1, y1, x2, y2, text$
- FUNCTION SaveState
- TYPE SaveStateType
- 'Data to Save
- SS.InUse = -1
- SS.F = _FONT
- SS.DC = _DEFAULTCOLOR
- SS.BG = _BACKGROUNDCOLOR
- SS.D = _DEST
- SS.S = _SOURCE
- SS.Disp = _AUTODISPLAY
- SS.CurY = CSRLIN
- SaveState = i
- NSS = NSS + 1
- SaveState = NSS
- SS.InUse = 0 'Let the routine know that we're no longer in use for this handle
- _FONT SS.F
- COLOR SS.DC, SS.BG
- _DEST SS.D
- _SOURCE SS.S
- LOCATE SS.CurY, SS.CurX
- Pw = W / destWidth
- Ph = H / destHeight
- NewWidth = W / P
- NewHeight = H / P
- FUNCTION mouseclick%
- i% = _MOUSEINPUT
- mouseclick% = -1
It's now making the review lists (I still need to quick code in the buttons to change how many times we review our words, as of now, they're stuck at 3 times each), and I think I've sorted out the glitches so that we no longer require the ON TIMER method of handling things. All GOTO statements are now removed as well, since many folks find them completely distasteful, and all that's left at this point is to:
1) Add the 5 quick select buttons for the numbers of times to review the material chosen.
2) To add in the quiz routine at the end of the review process.
And then it's just add pictures and words, and tag them so they can be reviewed as wanted.
Post by: Petr on August 04, 2019, 07:27:14 am
Yeah, I have a provocative day today. Steve, because I don't have enough imagination, I ask you to elaborate on the idea. Five buttons. Good. Specifically, what to this 5 buttons have to do. Thanks for your patience.
Post by: SMcNeill on August 04, 2019, 12:16:09 pm
Steve, because I don't have enough imagination, I ask you to elaborate on the idea. Five buttons. Good. Specifically, what to this 5 buttons have to do. Thanks for your patience.
They're now in there. All that's left now is for the QUIZ portion of the program! ;D
Code: [Select]
$COLOR:32
TYPE TagType
Year AS INTEGER
Week AS INTEGER
Sound AS STRING
Theme AS STRING
END TYPE
SCREEN _NEWIMAGE(800, 600, 32)
_TITLE "Spell It Aloud"
RANDOMIZE TIMER
$IF WIN THEN
temp$ = MID$(_CWD$, _INSTRREV(_CWD$, "\") + 1)
$ELSE
temp$ = MID$(_CWD$, _INSTRREV(_CWD$, "/") + 1)
$END IF
IF temp$ <> "Spell It Aloud" THEN
PRINT "ERROR -- Program not in proper directory."
PRINT "Stopping execution..."
PRINT
PRINT "Please don't be a dufus, and fix it!"
END IF
CONST ImageDir$ = ".\Images\"
CONST SoundDir$ = ".\Alphabet Sounds\"
CONST TagDir$ = ".\Image Tags\"
CONST WordSoundDir$ = ".\Word Sounds\"
DIM SHARED PhotoTag AS TagType
DIM SHARED LimitTag AS TagType
DIM SHARED AlphaSound(65 TO 90)
REDIM SHARED PhotoList(100000) AS STRING
REDIM SHARED WordList(0) AS LONG
DIM SHARED PhotoCount AS LONG
DIM SHARED PhotoChosen AS LONG
DIM SHARED f AS LONG, f1 AS LONG
DIM SHARED IsHowYouSpell AS LONG
DIM SHARED ControlVariable1 AS LONG
DIM SHARED ShowNext AS LONG
'load our fonts
f = _LOADFONT("courbd.ttf", 84, "MONOSPACE")
f1 = _LOADFONT("courbd.ttf", 48, "MONOSPACE")
_FONT f
fw = _FONTWIDTH: fh = _FONTHEIGHT
'Load the alphabet sound library
FOR i = 65 TO 90
temp$ = SoundDir$ + CHR$(i) + ".ogg"
AlphaSound(i) = _SNDOPEN(temp$, "VOL,SYNC,LEN,PAUSE")
NEXT
temp$ = WordSoundDir$ + "is how you spell.ogg"
IsHowYouSpell = _SNDOPEN(temp$, "VOL,SYNC,LEN,PAUSE")
_FONT f
_DELAY 1 'Give everything a moment to initialize and get started for us.
WordList(0) = 3 'three times repeating the list, as default
ChangeSearchTags
ShowNext = -1
DO
ControlVariable = 0
WHILE _MOUSEINPUT: WEND
MB = _MOUSEBUTTON(1)
Mx = _MOUSEX: My = _MOUSEY
IF MB AND NOT oldmouse THEN
IF Mx >= 650 AND Mx <= 750 THEN 'the mouse is in the correct X area for input
SELECT CASE My
CASE 171 TO 190
temp$ = ChangeValue(650, 171, STR$(LimitTag.Year), -1)
LimitTag.Year = VAL(temp$)
ChangeSearchTags
ShowNext = -1
CASE 191 TO 210
temp$ = ChangeValue(650, 191, STR$(LimitTag.Week), -1)
LimitTag.Week = VAL(temp$)
ChangeSearchTags
ShowNext = -1
CASE 211 TO 230
temp$ = ChangeValue(650, 211, LimitTag.Sound, 0)
LimitTag.Sound = temp$
ChangeSearchTags
ShowNext = -1
CASE 231 TO 250
temp$ = ChangeValue(650, 231, LimitTag.Theme, 0)
LimitTag.Theme = temp$
ChangeSearchTags
ShowNext = -1
CASE 324 TO 340
PhotoTag.Year = VAL(ChangeValue(650, 324, STR$(PhotoTag.Year), -1))
ChangePhotoTags word$
ShowNext = -1: ControlVariable1 = -1
CASE 341 TO 360
PhotoTag.Week = VAL(ChangeValue(650, 341, STR$(PhotoTag.Week), -1))
ChangePhotoTags word$
ShowNext = -1: ControlVariable1 = -1
CASE 361 TO 380
PhotoTag.Sound = ChangeValue(650, 361, PhotoTag.Sound, 0)
ChangePhotoTags word$
ShowNext = -1: ControlVariable1 = -1
CASE 381 TO 400
PhotoTag.Theme = ChangeValue(650, 381, PhotoTag.Theme, 0)
ChangePhotoTags word$
ShowNext = -1: ControlVariable1 = -1
END SELECT
END IF
IF _MOUSEY > 450 AND _MOUSEY < 470 THEN 'it's the right Y pos for the top control buttons
SELECT CASE _MOUSEX
CASE 575 TO 640 'Last
PhotoChosen = PhotoChosen - 1
IF PhotoChosen < 1 THEN PhotoChosen = 1
ShowNext = -1
CASE 641 TO 705 'Play
ShowNext = -1
CASE 706 TO 770 'Next
PhotoChosen = PhotoChosen + 1
IF PhotoChosen > UBOUND(WordList) THEN PhotoChosen = 1
ShowNext = -1
END SELECT
ELSEIF _MOUSEY > 471 AND _MOUSEY < 491 THEN 'it's the right Y pos for the 2nd row of control buttons
SELECT CASE _MOUSEX
CASE 575 TO 640 'Vol not yet implemented
CASE 641 TO 705 'Stop now handled via the sound sub
CASE 706 TO 770: SYSTEM 'Quit
END SELECT
ELSEIF _MOUSEY > 495 AND _MOUSEY < 515 THEN 'it's in the review column
oldR = WordList(0)
R = (_MOUSEX - 641) / 26
IF R <> oldR THEN
IF R > 0 AND R < 5 THEN WordList(0) = INT(R + 1)
MakeList
ShowNext = -1
END IF
END IF
END IF
k = _KEYHIT
SELECT CASE k
CASE 32 'space for next picture
PhotoChosen = PhotoChosen + 1
IF PhotoChosen > WordList(0) THEN PhotoChosen = 1
ShowNext = -1
CASE 27 'escape
SYSTEM 'quit
END SELECT
IF ShowNext THEN
ShowNext = 0
IF PhotoChosen THEN
temp$ = PhotoList(WordList(PhotoChosen))
word$ = MID$(temp$, _INSTRREV(temp$, "\") + 1)
word$ = LEFT$(word$, INSTR(word$, ".") - 1)
IF tempimage <> 0 THEN _FREEIMAGE tempimage 'free the old image
tempimage = _LOADIMAGE(temp$, 32) 'get the new image
CLS
_FONT f1: CenterText 0, 0, 800, 50, "Spell It Aloud": _FONT f
'program photo area is 500 x 450 pixels. So:
GetNewWH 500, 450, tempimage, nW, nH
_PUTIMAGE (300 - (nW / 2), 300 - (nH / 2) - 25)-STEP(nW, nH), tempimage
LoadPhotoTags word$
temp$ = "Search Tags (" + _TRIM$(STR$(PhotoChosen)) + " of " + _TRIM$(STR$(UBOUND(wordlist))) + ")"
DisplayTags 575, 150, temp$, LimitTag
DisplayTags 575, 300, "Photo Tags", PhotoTag
DrawCommandBoxes
IF ControlVariable1 = 0 THEN PlayLetters word$
ELSE
DrawNoMatches
END IF
ControlVariable1 = 0
END IF
_LIMIT 10
_DISPLAY
oldmouse = MB
LOOP
SUB DrawCommandBoxes
s = SaveState
_FONT 16
COLOR Black, 0
BoxTitle 575, 450, 640, 470, 2, BlueGray, Gold, "LAST"
BoxTitle 641, 450, 705, 470, 2, BlueGray, Gold, "PLAY"
BoxTitle 706, 450, 770, 470, 2, BlueGray, Gold, "NEXT"
BoxTitle 575, 471, 640, 490, 2, BlueGray, Gold, "VOL"
COLOR Maroon
BoxTitle 641, 471, 705, 490, 2, BlueGray, Gold, "STOP"
COLOR Yellow
BoxTitle 706, 471, 770, 490, 2, BlueGray, Gold, "QUIT"
COLOR Black
BoxTitle 575, 495, 640, 515, 2, BlueGray, Gold, "REVIEW:"
R = WordList(0) '3
FOR i = 1 TO 5
IF i <> R THEN
COLOR LightGray
BoxTitle 641 + (i - 1) * 26, 495, 641 + i * 26, 515, 1, Black, Gold, STR$(i)
ELSE
COLOR White
BoxTitle 641 + (i - 1) * 26, 495, 641 + i * 26, 515, 1, BlueGray, Gold, STR$(i)
END IF
NEXT
RestoreState s
END SUB
SUB BoxTitle (x1, y1, x2, y2, thick, fg AS _UNSIGNED LONG, bg AS _UNSIGNED LONG, title$)
Box x1, y1, x2 - x1 + 1, y2 - y1 + 1, thick, fg, bg
CenterText x1, y1 + thick, x2, y2 + thick, title$
END SUB
SUB DrawNoMatches
S = SaveState
CLS
_FONT f1
Box 50, 50, 500, 500, 5, Silver, Gold
CenterText 0, 0, 800, 50, "Spell It Aloud"
FOR i = 1 TO 10 STEP .5
CIRCLE (300, 300), 200 - i, BrickRed
LINE (300 + SIN(_D2R(-45)) * 198 + i, 300 + COS(_D2R(-45)) * 198 + i)-(300 + SIN(_D2R(135)) * 198 + i, 300 + COS(_D2R(135)) * 198 + i), BrickRed
NEXT
COLOR Yellow, 0
CenterText 50, 50, 550, 550, "No Matches"
PhotoTag.Year = 0
PhotoTag.Week = 0
PhotoTag.Sound = ""
PhotoTag.Theme = ""
DisplayTags 575, 150, "Search Tags (0)", LimitTag
DisplayTags 575, 300, "Photo Tags", PhotoTag
RestoreState S
END SUB
SUB PlayLetters (word$)
'Put the letters to the screen one by one
ControlVariable1 = 0
pw = _PRINTWIDTH(word$): StartX = (600 - pw) \ 2 'center position
FOR i = 1 TO LEN(word$)
a = ASC(word$, i) AND NOT 32 'play lowercase letters as uppercase sounds
_PRINTSTRING (StartX + (i - 1) * _FONTWIDTH, 510), CHR$(a)
_DISPLAY
IF a < 65 OR a > 90 THEN _CONTINUE 'ignore non-letters in the file name
_SNDPLAY AlphaSound(a)
WHILE _SNDPLAYING(AlphaSound(a)) 'wait for sound to finish before playing again
_LIMIT 10 'play nice with CPU during wait
GOSUB checkstop
IF ControlVariable1 THEN _SNDSTOP (AlphaSound(a))
WEND
NEXT
IF ContolVariable1 = 0 THEN
temp$ = WordSoundDir$ + word$ + ".ogg"
IF _FILEEXISTS(temp$) THEN
_SNDVOL IsHowYouSpell, .5
_SNDPLAY IsHowYouSpell
WHILE _SNDPLAYING(IsHowYouSpell) 'wait for sound to finish before playing again
_LIMIT 10 'play nice with CPU during wait
GOSUB checkstop
IF ControlVariable1 THEN _SNDSTOP (IsHowYouSpell): EXIT SUB
WEND
temp = _SNDOPEN(temp$, "VOL,SYNC,LEN,PAUSE")
_SNDPLAY temp
WHILE _SNDPLAYING(temp) 'wait for sound to finish before playing again
_LIMIT 10 'play nice with CPU during wait
GOSUB checkstop
IF ControlVariable1 THEN _SNDCLOSE temp: EXIT SUB
WEND
_SNDCLOSE temp
FOR i = 1 TO LEN(word$)
a = ASC(word$, i) AND NOT 32 'play lowercase letters as uppercase sounds
_PRINTSTRING (StartX + (i - 1) * _FONTWIDTH, 510), CHR$(a)
IF a < 65 OR a > 90 THEN _CONTINUE 'ignore non-letters in the file name
_SNDPLAY AlphaSound(a)
WHILE _SNDPLAYING(AlphaSound(a)) 'wait for sound to finish before playing again
_LIMIT 10 'play nice with CPU during wait
GOSUB checkstop
IF ControlVariable1 THEN EXIT SUB
WEND
NEXT
END IF
END IF
EXIT SUB
checkstop:
WHILE _MOUSEINPUT: WEND
IF _MOUSEBUTTON(1) THEN
IF _MOUSEY > 451 AND _MOUSEY < 491 THEN
IF _MOUSEX > 575 AND _MOUSEX < 770 THEN 'stop
ControlVariable1 = -1 'Stop Command for playing the word
END IF
END IF
END IF
RETURN
END SUB
SUB ChangePhotoTags (word$)
'Get a listing of the files
file$ = TagDir$ + word$ + ".txt"
OPEN file$ FOR OUTPUT AS #1
PRINT #1, PhotoTag.Year
PRINT #1, PhotoTag.Week
PRINT #1, PhotoTag.Sound
PRINT #1, PhotoTag.Theme
CLOSE
END SUB
SUB LoadPhotoTags (word$)
file$ = TagDir$ + word$ + ".txt"
IF _FILEEXISTS(file$) THEN
OPEN file$ FOR INPUT AS #1
INPUT #1, PhotoTag.Year
INPUT #1, PhotoTag.Week
INPUT #1, PhotoTag.Sound
INPUT #1, PhotoTag.Theme
CLOSE
ELSE
PhotoTag.Year = 0
PhotoTag.Week = 0
PhotoTag.Sound = ""
PhotoTag.Theme = ""
IF word$ <> "" THEN ChangePhotoTags word$
END IF
END SUB
SUB ChangeSearchTags
'Get a listing of the files
PhotoList$ = ImageDir$ + "*.bmp " + ImageDir$ + "*.jpg " + ImageDir$ + "*.png " + ImageDir$ + "*.gif "
SHELL _HIDE "DIR " + PhotoList$ + "/b /s /a-d >PhotoList.txt"
REDIM _PRESERVE PhotoList(100000)
'Load those names into a file.
OPEN "Photolist.txt" FOR BINARY AS #1
PhotoCount = 0
DO UNTIL EOF(1)
LINE INPUT #1, fullpath$
word$ = MID$(fullpath$, _INSTRREV(fullpath$, "\") + 1)
word$ = LEFT$(word$, INSTR(word$, ".") - 1)
file$ = TagDir$ + word$ + ".txt"
IF _FILEEXISTS(file$) THEN
OPEN file$ FOR INPUT AS #2
INPUT #2, PhotoTag.Year
INPUT #2, PhotoTag.Week
INPUT #2, PhotoTag.Sound
INPUT #2, PhotoTag.Theme
ELSE
OPEN file$ FOR OUTPUT AS #2
PRINT #2, 0
PRINT #2, 0
PRINT #2, ""
PRINT #2, ""
END IF
CLOSE #2
good = -1
IF LimitTag.Year <> 0 AND LimitTag.Year <> PhotoTag.Year THEN good = 0
IF LimitTag.Week <> 0 AND LimitTag.Week <> PhotoTag.Week THEN good = 0
IF LimitTag.Sound <> "" AND LimitTag.Sound <> PhotoTag.Sound THEN good = 0
IF LimitTag.Theme <> "" AND LimitTag.Theme <> PhotoTag.Theme THEN good = 0
IF good THEN
PhotoCount = PhotoCount + 1
PhotoList(PhotoCount) = fullpath$
END IF
LOOP
REDIM _PRESERVE PhotoList(PhotoCount)
CLOSE
MakeList
END SUB
SUB MakeList
RepeatCount = WordList(0)
REDIM WordList(PhotoCount * RepeatCount) AS LONG
WordList(0) = RepeatCount
IF UBOUND(wordlist) > 0 THEN
PhotoChosen = 1
ELSE
PhotoChosen = 0
EXIT SUB
END IF
DIM TempList(PhotoCount) AS LONG
FOR i = 1 TO PhotoCount
TempList(i) = i
NEXT
FOR i = 1 TO RepeatCount
FOR j = 1 TO PhotoCount
r = INT(RND * PhotoCount) + 1
SWAP TempList(j), TempList(r)
NEXT
FOR j = 1 TO PhotoCount
Count = Count + 1
WordList(Count) = TempList(j)
NEXT
NEXT
END SUB
FUNCTION ChangeValue$ (x, y, tword$, limit)
S = SaveState
_FONT 16
temp$ = CHR$(179)
_KEYCLEAR
_AUTODISPLAY
DO
Box x, y, 100, 20, 1, Black, Gold
CenterText x, y, x + 100, y + 20, temp$
k = _KEYHIT
SELECT CASE k
CASE 8
tword$ = LEFT$(tword$, LEN(tword$) - 1)
CASE 13
EXIT DO
CASE 48 TO 57 'We'll always accept numeric input
tword$ = tword$ + CHR$(k)
CASE 65 TO 90, 97 TO 122 'A-Z (a-z) only when we're dealing with a string
IF NOT limit THEN tword$ = tword$ + CHR$(k)
END SELECT
temp$ = tword$ + CHR$(179)
_LIMIT 10
DisplayTags 575, 150, "Search Tags (" + _TRIM$(STR$(PhotoCount)) + ")", LimitTag
DisplayTags 575, 300, "Photo Tags", PhotoTag
LOOP
ChangeValue$ = tword$
RestoreState S
END SUB
SUB DisplayTags (x, y, Title AS STRING, DisplayTag AS TagType)
S = SaveState
_FONT 16
W = 200: h = 106
Box x, y, W, h, 2, BlueGray, Gold
COLOR Gold, 0
CenterText x, y + 2, x + 200, y + 20, Title
LINE (x + 1, y + 19)-STEP(W - 2, 0), Gold
COLOR White, 0
xs = x + 24: ys = y + 24 'x/y start after the box offset
_PRINTSTRING (xs, ys), "Year :"
_PRINTSTRING (xs, ys + 20), "Week :"
_PRINTSTRING (xs, ys + 40), "Sound:"
_PRINTSTRING (xs, ys + 60), "Theme:"
bxs = xs + 50: bys = ys - 2 'x/y start for the display boxes
FOR i = 0 TO 3
Box bxs, bys + i * 20, 100, 20, 1, Black, Gold
NEXT
CenterValue bxs, bys, bxs + 100, bys + 20, DisplayTag.Year
CenterValue bxs, bys + 20, bxs + 100, bys + 40, DisplayTag.Week
CenterText bxs, bys + 40, bxs + 100, bys + 60, DisplayTag.Sound
CenterText bxs, bys + 60, bxs + 100, bys + 80, DisplayTag.Theme
RestoreState S
END SUB
SUB Box (x, y, wide, high, thick, Kolor AS _UNSIGNED LONG, Trim AS _UNSIGNED LONG)
LINE (x, y)-STEP(wide, high), Kolor, BF
FOR i = 0 TO thick - 1
LINE (x + i, y + i)-STEP(wide - 2 * i, high - 2 * i), Trim, B
NEXT
END SUB
SUB CenterText (x1, y1, x2, y2, text$)
text$ = _TRIM$(text$)
xmax = x2 - x1: ymax = y2 - y1
textlength = _PRINTWIDTH(text$)
xpos = (xmax - textlength) / 2
ypos = (ymax - _FONTHEIGHT) / 2
_PRINTSTRING (x1 + xpos, y1 + ypos), text$
END SUB
SUB CenterValue (x1, y1, x2, y2, value AS LONG)
text$ = _TRIM$(STR$(value))
CenterText x1, y1, x2, y2, text$
END SUB
FUNCTION SaveState
TYPE SaveStateType
InUse AS INTEGER
DC AS INTEGER
BG AS INTEGER
F AS INTEGER
D AS INTEGER
S AS INTEGER
Disp AS INTEGER
CurX AS INTEGER
CurY AS INTEGER
END TYPE
DIM SS AS SaveStateType, Temp AS SaveStateType
SHARED NSS AS LONG 'Number of Saved States
SHARED SaveMem AS _MEM
IF NOT _MEMEXISTS(SaveMem) THEN
SaveMem = _MEMNEW(LEN(SS) * 255) 'Save up to 255 save states; More than 255 and we toss an error
$CHECKING:OFF
_MEMFILL SaveMem, SaveMem.OFFSET, SaveMem.SIZE, 0 AS _UNSIGNED _BYTE
$CHECKING:ON
END IF
'Data to Save
SS.InUse = -1
SS.F = _FONT
SS.DC = _DEFAULTCOLOR
SS.BG = _BACKGROUNDCOLOR
SS.D = _DEST
SS.S = _SOURCE
SS.Disp = _AUTODISPLAY
SS.CurX = POS(0)
SS.CurY = CSRLIN
$CHECKING:OFF
FOR i = 1 TO NSS
o = (i - 1) * LEN(SS)
_MEMGET SaveMem, SaveMem.OFFSET + o, Temp
IF Temp.InUse = 0 THEN
_MEMPUT SaveMem, SaveMem.OFFSET + o, SS
SaveState = i
EXIT FUNCTION
END IF
NEXT
_MEMPUT SaveMem, SaveMem.OFFSET + NSS * LEN(SS), SS
$CHECKING:ON
NSS = NSS + 1
SaveState = NSS
END SUB
SUB RestoreState (WhichOne AS LONG)
DIM SS AS SaveStateType
SHARED NSS AS LONG 'Number of Saved States
SHARED SaveMem AS _MEM
_MEMGET SaveMem, SaveMem.OFFSET + (WhichOne - 1) * LEN(SS), SS
$CHECKING:ON
IF SS.InUse THEN
SS.InUse = 0 'Let the routine know that we're no longer in use for this handle
$CHECKING:OFF
_MEMPUT SaveMem, SaveMem.OFFSET + (WhichOne - 1) * LEN(SS), SS
$CHECKING:ON
_FONT SS.F
COLOR SS.DC, SS.BG
_DEST SS.D
_SOURCE SS.S
IF SS.Disp THEN _AUTODISPLAY ELSE _DISPLAY
LOCATE SS.CurY, SS.CurX
END IF
END SUB
SUB GetNewWH (destWidth, destHeight, handle AS LONG, NewWidth, NewHeight) 'Sub return in variables NewWidth and NewHeight new image Width and image Height with the same ratio for optimal picture to set area width and height with [destWidth, destHeight]
W = _WIDTH(handle)
H = _HEIGHT(handle)
Pw = W / destWidth
Ph = H / destHeight
IF W > H THEN P = Pw ELSE P = Ph
NewWidth = W / P
NewHeight = H / P
END SUBWhat the review buttons does is choose how many times we review the material at hand, before we finish and take our (not yet implemented) quiz.
For example, we narrow down our list of words to "Petr, Pete, Peter".
If the Review number is one, our review list might be: "Pete, Petr, Peter"
If the Review number is two, our review list might be: "Pete, Petr, Peter, Petr, Peter, Pete".
It's just the number of times (from 1 to 5) which we want to set to review the material, before taking a test on it.
Not related to this, but related to QB64 development:
If you notice, the syntax on $COLOR32 has changed a little in my version; it's now $COLOR:32. (See that : in there?)
This is because $COLOR now has 2 modes which we can get names from -- $COLOR:32 for 32-bit color names, and $COLOR:0 for screen 0 color names.
It's a slight change, but it makes my current version of QB64 slightly incompatible with yours, at the moment.
When this little project is finished, I'll probably just put the CONST values in an $INCLUDE file for now, so that it'll be usable for everyone -- those that keep up with the latest development builds, and those who prefer the stable 1.3 version instead. ;)
Post by: Petr on August 04, 2019, 01:57:56 pm
So i am tryed it and have query. If selecting 3 images, in Photo tags saving for this 3 photos the same flags to theme and then select review - let say to 3x. Then if i press space or next button, are this 3 photos playing (if i set this theme to search tag). So after then, when are this selected images all played, in current version starting again, but final version then start quiz. Its so correct?
Post by: SMcNeill on August 04, 2019, 06:44:54 pm
Things still needed:
It needs some layout work to center things better to make the screen prettier.
A prettier QUIZ results page, with pauses in case the user has a quiz with more words than can appear on a single display page.
Hard/Easy mode to be implemented for the spelling quiz --
At the moment, all we're having is the HARD mode implemented. (Enter the word, with no help whatsoever.)
For easy mode, I picture it to limit word input to the proper number of letters, and to display a placeholder on the screen for the letters. Such as for "cat", the screen will offer a prompt of three stars ("***") as placeholders to help indicate how many letters belong in the word.
But, more or less, our little spelling training program is workable the way it already exists! ;D
Post by: Petr on August 05, 2019, 11:28:14 am
This is big and nice work, Steve.
Post by: SW on August 05, 2019, 01:18:42 pm
I mind its good to add multi lingual support by adding ".\en\Alphabet Sounds\" and "".\en\Word Sounds\". So you can add other pronounces(languages) for same images.