QB64.org Forum
Active Forums => QB64 Discussion => Topic started by: SpriggsySpriggs on December 08, 2021, 04:20:53 pm
-
Like the title says, needing some ideas for a small project. Something to do with API (Windows) would be the most preferable. I've been bored out of my mind recently and have been impatiently awaiting my new PC to get back from the shop. Hit me with some good ideas so I can at least keep my mind sharp.
-
Small projects???
I started one, and 4 months later I have a multi-language, 10,000+ lines of code system, and it is still not ready for release (maybe beginning of next week).
Good luck, as my experience is small projects tend to take on a life of their own, once others find out about them!
Like the title says, needing some ideas for a small project. Something to do with API (Windows) would be the most preferable. I've been bored out of my mind recently and have been impatiently awaiting my new PC to get back from the shop. Hit me with some good ideas so I can at least keep my mind sharp.
-
Weren't you going to do a tutorial?
-
How about being able to output direct to a PDF file? I did try playing around with that but failed miserably.
-
I've been writing it up for the past two weeks.
However, the program I wanted to write to illustrate it wound up being 5 programs, 2 C++ libraries, almost 1,000 SQL statements, HTML/CSS. It's approaching 10,000 total lines of code.
After I told a friend in a baseball game about it, he wanted to use it, and then it snowballed into features that were needed.
It's on the way. I plan to break one of the programs out and rework it for the tutorial. But I want to put the entire system here first, then the tutorial will follow.
Also, I went and recently revisited Galleon's code in the Wiki on it, and found it doesn't quite work due to massive memory issues with _MEMGET and other memory statements. Row sizes not right, skipping values, adding values to rows and columns that they don't belong to. It is a mess.
Weren't you going to do a tutorial?
-
How about something to input sound from a microphone? Or a way to mem map a file so we can load say an mp3 into memory and then _SNDLOAD it to decode it from there, like from a ramdrive. Or I'd love a QB64 interface with VideoLan....
-
How about something to input sound from a microphone? Or a way to mem map a file so we can load say an mp3 into memory and then _SNDLOAD it to decode it from there, like from a ramdrive. Or I'd love a QB64 interface with VideoLan...
@SMcNeill
Strange how the ideas basically coincide. I'm thinking now that I'm going to try to do (but God knows when) inverse functions in SaveImage - precisely to embed Base64 images into the source code and then load them directly into _NEWIMAGE without using _LOADIMAGE. But of course this use is highly marginal. And you're guessing right. Your Christmas theme, your testing. That was the reason I started thinking about it.
@SpriggsySpriggs
But at the moment I do not have proposals for new libraries, first I have to tutor me the existing ones, which with my time regime will be for several months.
-
How about something to input sound from a microphone? Or a way to mem map a file so we can load say an mp3 into memory and then _SNDLOAD it to decode it from there, like from a ramdrive. Or I'd love a QB64 interface with VideoLan....
@SMcNeill Looks like I've already messed with audio input before but could definitely revisit it for some tweaks and improvements. https://www.qb64.org/forum/index.php?topic=3975.msg133174#msg133174 (https://www.qb64.org/forum/index.php?topic=3975.msg133174#msg133174)
-
How about being able to output direct to a PDF file? I did try playing around with that but failed miserably.
@Mad Axeman I have made code before that would allow you to output to a PDF but you would have to select the "Microsoft Print to PDF" printer with this code. https://www.qb64.org/forum/index.php?topic=4102.msg134503#msg134503 (https://www.qb64.org/forum/index.php?topic=4102.msg134503#msg134503)
-
For my Baseball/Softball Statistics system I'm writing, I have looked at converting some of the reports generated to PDF on Linux, by doing the following after constructing these commands in pipecom:
enscript -p output.ps input.txt
ps2pdfwr output.ps output.pdf
Both utilities exist on most all Linux distro's.
I wonder if something as simple and similar can be done in a Windows API?
@Mad Axeman I have made code before that would allow you to output to a PDF but you would have to select the "Microsoft Print to PDF" printer with this code. https://www.qb64.org/forum/index.php?topic=4102.msg134503#msg134503 (https://www.qb64.org/forum/index.php?topic=4102.msg134503#msg134503)
-
just some ideas
1. sound:
MIDI libraries to load play and save MIDI files.
2.
Multiple mice on the same pc
there is an hanging thread in the forum that has for base an API call
3.
.zip files manager (like OS does ) that seems to be native of Windows nowaday
-
Like the title says, needing some ideas for a small project. Something to do with API (Windows) would be the most preferable. I've been bored out of my mind recently and have been impatiently awaiting my new PC to get back from the shop. Hit me with some good ideas so I can at least keep my mind sharp.
Maybe we finally get that multiple mouse input working? :-D
https://www.qb64.org/forum/index.php?topic=3695.msg130410#msg130410 (https://www.qb64.org/forum/index.php?topic=3695.msg130410#msg130410)
https://www.qb64.org/forum/index.php?topic=3766.0 (https://www.qb64.org/forum/index.php?topic=3766.0)
https://www.qb64.org/forum/index.php?topic=3348.msg126454#msg126454 (https://www.qb64.org/forum/index.php?topic=3348.msg126454#msg126454)
Pretty please?
:-)
I'm currently absorbed in this isometric Christmas thing
https://www.qb64.org/forum/index.php?topic=4471.0 (https://www.qb64.org/forum/index.php?topic=4471.0)
Too many projects!
-
just some ideas
1. sound:
MIDI libraries to load play and save MIDI files.
2.
Multiple mice on the same pc
there is an hanging thread in the forum that has for base an API call
3.
.zip files manager (like OS does ) that seems to be native of Windows nowaday
All good ones... That multi mouse functionality would be awesome. Multi keyboard would be a nice one too. The API functionality is built into Windows and I think Mac/Linux have equivalents, but this low-level stuff just seems to be over my head...
I would really like full control over MIDI from QB64 - not just playing back files but MIDI OX type functionality: read/send input/output from/to MIDI devices, play notes either on the PC's sound card or control external keyboards & instruments (provided you have a MIDI interface on the PC). Enough to write a tracker/sequencer that can drive external MIDI devices, transform MIDI I/O and send it back to a device, and read/write/edit MIDI files.
And low-level, ADSR, 3+ channel, sound synthesis you can program like on a Commodore 64 SID chip...
I could go on and on!
-
just some ideas
1. sound:
MIDI libraries to load play and save MIDI files.
2.
Multiple mice on the same pc
there is an hanging thread in the forum that has for base an API call
3.
.zip files manager (like OS does ) that seems to be native of Windows nowaday
To DIRECT MIDI playing without external library. Have you see this @MasterGy source code?
DEFLNG A-Z
TYPE FILEDIALOGTYPE
lStructSize AS LONG ' For the DLL call
hwndOwner AS LONG ' Dialog will hide behind window when not set correctly
hInstance AS LONG ' Handle to a module that contains a dialog box template.
lpstrFilter AS _OFFSET ' Pointer of the string of file filters
lpstrCustFilter AS _OFFSET
nMaxCustFilter AS LONG
nFilterIndex AS LONG ' One based starting filter index to use when dialog is called
lpstrFile AS _OFFSET ' String full of 0's for the selected file name
nMaxFile AS LONG ' Maximum length of the string stuffed with 0's minus 1
lpstrFileTitle AS _OFFSET ' Same as lpstrFile
nMaxFileTitle AS LONG ' Same as nMaxFile
lpstrInitialDir AS _OFFSET ' Starting directory
lpstrTitle AS _OFFSET ' Dialog title
flags AS LONG ' Dialog flags
nFileOffset AS INTEGER ' Zero-based offset from path beginning to file name string pointed to by lpstrFile
nFileExtension AS INTEGER ' Zero-based offset from path beginning to file extension string pointed to by lpstrFile.
lpstrDefExt AS _OFFSET ' Default/selected file extension
lCustData AS LONG
lpfnHook AS LONG
lpTemplateName AS _OFFSET
END TYPE
DECLARE DYNAMIC LIBRARY "comdlg32" ' Library declarations using _OFFSET types
FUNCTION GetOpenFileNameA& (DIALOGPARAMS AS FILEDIALOGTYPE) ' The Open file dialog
FUNCTION GetSaveFileNameA& (DIALOGPARAMS AS FILEDIALOGTYPE) ' The Save file dialog
END DECLARE
DECLARE LIBRARY
FUNCTION FindWindow& (BYVAL ClassName AS _OFFSET, WindowName$) ' To get hWnd handle
END DECLARE
DECLARE DYNAMIC LIBRARY "winmm"
FUNCTION midiOutGetNumDevs (numdevs AS INTEGER)
FUNCTION midiOutOpen (lphMidiOut AS LONG, BYVAL uDeviceID AS LONG, BYVAL dwCallback AS LONG, BYVAL dwInstance AS LONG, BYVAL dwFlags AS LONG)
FUNCTION midiOutClose (BYVAL hMidiOut AS LONG)
FUNCTION midiOutShortMsg (BYVAL hMidiOut AS LONG, BYVAL dwMsg AS LONG)
END DECLARE
_TITLE "ALGORITMUS-ZENE (TOTH GYULA 2019) "
CLS: REM GOSUB masolasvedelem
prog1 = _NEWIMAGE(1200, 1100, 32): SCREEN prog1
prog2 = _NEWIMAGE(400, 80, 32)
_FULLSCREEN _STRETCH , _SMOOTH
DIM par$(99), par(99, 2), bill$(99, 1), utolsohang(99), utolsohangszer(99)
DIM aktiv1 AS LONG, aktiv2 AS LONG
DIM utos(99, 19), poli(99, 19), sav(99, 19), csend(99)
DIM kuld AS LONG
DIM hmidiout AS LONG
DIM midi$(255), savok$(99)
DIM x(9999)
DIM mmidi AS LONG, keret AS LONG
DIM aktivsav(99), savmutatakt(99), polimutatakt(99), utosmutatakt(99)
DIM keszlet(99, 3)
DIM hangref$(255), hangnev$(11)
DIM aktivkeszlet(11)
sv$ = "ver1"
GOSUB hangdec
REM DIM mauzx AS _FLOAT, mauzy AS _FLOAT
helpmutat = 1
aktiv2 = _RGB32(194, 161, 133)
aktiv1 = _RGB32(255, 255, 255)
keret = aktiv2
dobszel$ = "1114112022233637394344"
a$(0) = STRING$(10000, ".")
x(0) = 2
x(1) = 70
x(2) = 81
x(20) = 25: REM savok szama
x(21) = 1: REM haladas iranya, szorzoja
x(22) = 0: REM aktualis leptek-pozicio
x(23) = 2: REM metronom szorzo
x(24) = 0: REM ennyi aktiv sav van, ezt majd a program tolti ki (savinst)
x(25) = 4000: REM savhossz
x(30) = 8: REM ennyi polifonikus hangszer
x(31) = 8: REM ennyi utos hangszer
x(32) = 5: REM polifonikus jelfogok-szama
x(33) = 5: REM hangkeszlet 2 ennyediken
x(34) = 1: REM sorozat aktualis ertek szorzoja
x(35) = 45: REM tempo
x(36) = 3: REM sorozat tag1
x(37) = 5: REM sorozat tag2
x(38) = 100: REM sorozat szorzo
x(39) = 0: REM hangszer lecsengese
REM UTOS tomb : a,b a-melyik sav
REM b-0: aktiv-e b-1:hangszer:c-1:hangero
REM 1.param : (0) = kussol (1)=utos (2) = polifonikus
CLS
sx = 1: sy = 1
RANDOMIZE TIMER: GOSUB miditest: GOSUB midiinst
GOSUB billdec
GOSUB decparam
GOSUB randaktivkeszlet
GOSUB randaktivhangdec
GOSUB randrendeles
GOSUB newsavinst
GOSUB hangokdec
GOSUB savdec
GOSUB keszletdec
GOSUB polidec: GOSUB randpoli
GOSUB utosdec: GOSUB randutos
GOSUB pre
GOSUB randhangsor5
GOSUB sorrendrendeles
GOSUB randoktkeszlet
GOSUB randpolixoktav
IF _FILEEXISTS("last.alg") THEN fajlnev$ = "last.alg": GOSUB zenebetoltese
DO
_LIMIT x(35) / 5
REM _DISPLAY
bill$ = LCASE$(INKEY$)
SELECT CASE bill$
CASE CHR$(27): GOSUB midizar: fajlnev$ = "last.alg": GOSUB zenementese: SYSTEM
CASE bill$(0, 0): aleptek = 0
CASE bill$(1, 0): GOSUB savtxtadd: GOSUB randutos
CASE bill$(2, 0): GOSUB utoshangszerrand
CASE bill$(3, 0): GOSUB savtxtadd: GOSUB randpoli
CASE bill$(4, 0): GOSUB savtxtadd: GOSUB randpolixhangszer
CASE bill$(5, 0): GOSUB savtxtadd: GOSUB randpolixoktav
CASE bill$(6, 0): GOSUB savtxtadd: GOSUB randpolivtrack
CASE bill$(7, 0): GOSUB commn
CASE bill$(8, 0): GOSUB savtxtadd: GOSUB randomsorozat
CASE bill$(9, 0): GOSUB randaktivhangdec
CASE bill$(10, 0): GOSUB randaktivkeszlet
CASE bill$(11, 0): GOSUB randrendeles
CASE bill$(12, 0): GOSUB sorrendrendeles
CASE bill$(13, 0): GOSUB randhangsor5
CASE bill$(14, 0): GOSUB randhangsor7
CASE bill$(15, 0): helpmutat = helpmutat XOR 1
CASE bill$(16, 0): GOSUB keszletminta4bit
CASE bill$(17, 0): GOSUB randoktkeszlet
CASE bill$(18, 0): GOSUB midizar: GOSUB inakt: fajlnev$ = "uj": GOSUB zenementese2: RUN
CASE bill$(19, 0): GOSUB midizar: GOSUB inakt: fajlnev$ = "uj": GOSUB zenebetoltese: fajlnev$ = "last.alg": GOSUB zenementese: RUN
CASE bill$(20, 0): GOSUB visszaallit: GOSUB midizar: RUN
END SELECT
aktiv$ = ""
CLS
ykpoli = 24 + x(24) - 16: xkpoli = 5
ykkeszlet = 24 + x(24) - 16: xkkeszlet = 64
yksav = 4: xksav = 5
ykutos = yksav: xkutos = 70 - 6
ykhangk = ykpoli: xkhangk = 96
GOSUB parammutat
IF x(32) THEN GOSUB hangokmutat
GOSUB savaktdel
GOSUB utosmutat
GOSUB utosaktdel
GOSUB polimutat
GOSUB poliaktdel
GOSUB savmutat
IF x(32) THEN GOSUB keszletmutat
COLOR _RGB32(255, 255, 255): LINE (900, 0)-(900, 1100)
IF (_KEYDOWN(100303) OR _KEYDOWN(100304)) OR helpmutat THEN GOSUB billmutat
_DISPLAY
egergorgo = 0: FOR t = 0 TO 200:
q = _MOUSEINPUT: mauzx = (_MOUSEX / 8) + 1: mauzy = (_MOUSEY / 16) + 1:
egergorgo = _MOUSEWHEEL + egergorgo
NEXT t
egergorgo = SGN(egergorgo)
IF LEN(aktiv$) THEN GOSUB akciokezelo
REM GOSUB midihangszer
REM GOSUB feltcsend
IF x(32) THEN GOSUB midipolion
GOSUB szolalutos
IF x(23) THEN GOSUB metronom
x(22) = aleptek * x(34) + 1600
aleptek = aleptek + 1
SELECT CASE x(32)
CASE 0: x(33) = 0
CASE 1: x(33) = 1
CASE 2: x(33) = 2
CASE 3: x(33) = 3
CASE 4: x(33) = 4
CASE 5: x(33) = 5
END SELECT
LOOP
inakt:
SCREEN prog2: _FULLSCREEN _OFF
_AUTODISPLAY: CLS
PRINT "inaktiv, ne zard be !": RETURN
visszaallit: IF _FILEEXISTS("last.alg") THEN KILL "last.alg"
RETURN
billdec:
bill$(0, 0) = "0": bill$(0, 1) = "sorozat kezdoponta allitas"
bill$(1, 0) = "q": bill$(1, 1) = "utoshangszerek random hangszerei"
bill$(2, 0) = "w": bill$(2, 1) = "utoshangszerek random SAV-jai"
bill$(3, 0) = "y": bill$(3, 1) = "polihangszerek random ertekek"
bill$(4, 0) = "x": bill$(4, 1) = "polihangszerek random hangszerei"
bill$(5, 0) = "c": bill$(5, 1) = "polihangszerek random oktavok"
bill$(6, 0) = "v": bill$(6, 1) = "polihangszerek random savjai"
bill$(7, 0) = "n": bill$(7, 1) = "polihangszerek egyforma 2 track"
bill$(8, 0) = "a": bill$(8, 1) = "random sorozat eloallitasa"
bill$(9, 0) = "1": bill$(9, 1) = "keszlet random aktivizalasa"
bill$(10, 0) = "2": bill$(10, 1) = "alapkeszlet random aktivizalasa"
bill$(11, 0) = "3": bill$(11, 1) = "random hangkeszlethez rendeles"
bill$(12, 0) = "4": bill$(12, 1) = "rendezett hangkeszlethez rendeles"
bill$(13, 0) = "5": bill$(13, 1) = "5-foku hangsor betoltes"
bill$(14, 0) = "7": bill$(14, 1) = "7-foku hangsor betoltes"
bill$(15, 0) = "h": bill$(15, 1) = "HELP - billentyuzet funkciok"
bill$(16, 0) = "8": bill$(16, 1) = "keszlet aktiv 4 bit minta alapjan"
bill$(17, 0) = "s": bill$(17, 1) = "random oktav keszlet"
bill$(18, 0) = "p": bill$(18, 1) = "zene mentese"
bill$(19, 0) = "o": bill$(19, 1) = "zene betoltese"
bill$(20, 0) = "r": bill$(20, 1) = "RESET, mindent alapertekre"
RETURN
billmutat: xx = 0: FOR t = 0 TO 99
IF LEN(bill$(t, 0)) THEN
xx = xx + 1
LOCATE xx, 1: PRINT SPACE$(45)
LOCATE xx, 1: PRINT UCASE$(bill$(t, 0)) + " - "; bill$(t, 1)
END IF
NEXT t
RETURN
szolalutos: FOR t = 0 TO x(31) - 1
aktualsav = aktivsav(utos(t, 3))
eltolas = sav(aktualsav, 1)
ae = MID$(savok$(aktualsav), x(22) + 1 + eltolas, 1) = bit$(1)
IF ae AND utos(t, 0) THEN
kuld = &H7F0099: mmidi = utos(t, 1) + 35
kuld = kuld OR ((mmidi AND 255) * 256)
q = midiOutShortMsg(hmidiout, kuld): IF q THEN END
END IF
NEXT t: RETURN
savaktdel: FOR t = 0 TO 99: savmutatakt(t) = 0: NEXT t: RETURN
poliaktdel: FOR t = 0 TO 99: polimutatakt(t) = 0: NEXT t: RETURN
utosaktdel: FOR t = 0 TO 99: utosmutatakt(t) = 0: NEXT t: RETURN
akciokezelo:
modosit = -egergorgo
IF _MOUSEBUTTON(1) = 0 AND _MOUSEBUTTON(2) = 0 THEN mbm = 0
IF _MOUSEBUTTON(1) AND mbm = 0 THEN modosit = -1: mbm = 1
IF _MOUSEBUTTON(2) AND mbm = 0 THEN modosit = 1: mbm = 1
IF modosit THEN
SELECT CASE aktiv$
CASE "parameterek"
mx0 = par(aktivp1, 0)
modositott2 = x(mx0) + modosit
felt = modositott2 >= par(aktivp1, 1) AND modositott2 <= par(aktivp1, 2)
IF felt AND mx0 = 30 THEN GOSUB csend
IF felt THEN x(mx0) = modositott2
IF felt AND mx0 = 24 THEN GOSUB utoshangszerrand: GOSUB randpolivtrack
CASE "utosparam"
utos(aktivp1, aktivp2) = utos(aktivp1, aktivp2) + modosit
utos(aktivp1, 0) = ABS(utos(aktivp1, 0)) AND 1
IF utos(aktivp1, 2) > 127 THEN utos(aktivp1, 2) = 0
IF utos(aktivp1, 2) < 0 THEN utos(aktivp1, 2) = 127
IF utos(aktivp1, 1) > 45 THEN utos(aktivp1, 1) = 0
IF utos(aktivp1, 1) < 0 THEN utos(aktivp1, 1) = 45
IF utos(aktivp1, 3) >= x(24) THEN utos(aktivp1, 3) = 0
IF utos(aktivp1, 3) < 0 THEN utos(aktivp1, 3) = x(24) - 1
CASE "aktivhangok"
IF modosit THEN aktivkeszlet(aktivp1) = aktivkeszlet(aktivp1) XOR 1
CASE "poliparam"
poli(aktivp1, aktivp2) = poli(aktivp1, aktivp2) + modosit
poli(aktivp1, 0) = ABS(poli(aktivp1, 0)) AND 1
IF poli(aktivp1, 1) > 127 THEN poli(aktivp1, 1) = 0
IF poli(aktivp1, 1) < 0 THEN poli(aktivp1, 1) = 127
IF poli(aktivp1, 2) > 127 THEN poli(aktivp1, 2) = 0
IF poli(aktivp1, 2) < 0 THEN poli(aktivp1, 2) = 127
IF poli(aktivp1, 8) > 4 THEN poli(aktivp1, 8) = 4
IF poli(aktivp1, 8) < -4 THEN poli(aktivp1, 8) = -4
FOR t3 = 3 TO 6
IF poli(aktivp1, t3) > (x(24) - 1) THEN poli(aktivp1, t3) = 0
IF poli(aktivp1, t3) < 0 THEN poli(aktivp1, t3) = x(24) - 1
NEXT t3
CASE "keszlet"
55: keszlet(aktivp1, aktivp2) = keszlet(aktivp1, aktivp2) + modosit
keszlet(aktivp1, 1) = ABS(keszlet(aktivp1, 1)) AND 1
IF keszlet(aktivp1, 3) > 4 THEN keszlet(aktivp1, 3) = 4
IF keszlet(aktivp1, 3) < -4 THEN keszlet(aktivp1, 3) = -4
IF keszlet(aktivp1, 2) > 11 THEN keszlet(aktivp1, 2) = 0
IF keszlet(aktivp1, 2) < 0 THEN keszlet(aktivp1, 2) = 11
IF (aktivkeszlet(keszlet(aktivp1, 2)) = 0) AND (aktivp2 = 2) THEN GOTO 55
CASE "savparam"
sav(aktivp1, aktivp2) = sav(aktivp1, aktivp2) + modosit
sav(aktivp1, 2) = ABS(sav(aktivp1, 2)) AND 1
IF sav(aktivp1, 1) > 9 THEN sav(aktivp1, 1) = 9
IF sav(aktivp1, 1) < -9 THEN sav(aktivp1, 1) = -9
END SELECT
END IF
GOTO 77
FOR t = 0 TO 2 ^ x(33) - 1
IF aktivkeszlet(keszlet(t, 2)) = 0 THEN keszlet(t, 1) = 0
NEXT t
77
RETURN
newsavinst: CLS: REDIM anali(999): x(22) = 0: aleptek = 0: REM aktualis lepes 1-ra
FOR t = 0 TO x(20) - 1: savok$(t) = STRING$(14, "."): NEXT t
FOR alep = 0 TO x(25) - 1: ertek = (x(1) * alep) AND (x(2) * alep)
FOR t = 0 TO x(20) - 1: bit = SGN((2 ^ t) AND ertek)
savok$(t) = savok$(t) + bit$(bit): anali(t) = anali(t) + bit: NEXT t
NEXT alep
aktivsavdb = 0: FOR t = 0 TO x(20) - 1
IF anali(t) THEN aktivsav(aktivsavdb) = t: aktivsavdb = aktivsavdb + 1
NEXT t: x(24) = aktivsavdb
REM anali fejlec
REM 0-aktiv sav (ezt majd a program tolti ki)
REM 1-osszes 1-es
RETURN
savtxtadd: FOR t = 0 TO x(20): savok$(t) = MID$(savok$(t), 2) + "*": NEXT t: RETURN
randomsorozat:
REM 3,11 jo !
alap = INT(x(38) * RND(1)): x(1) = alap * x(36): x(2) = alap * x(37)
GOTO newsavinst
pre: FOR t = 0 TO 99: utos(t, 0) = 1: utos(t, 2) = 127: NEXT t: RETURN
midiinst:
midi$(0) = "AcousticGrandPiano"
midi$(1) = "BrightAcousticPiano"
midi$(2) = "ElectricGrandPiano"
midi$(3) = "Honky-tonkPiano"
midi$(4) = "ElectricPiano1"
midi$(5) = "ElectricPiano2"
midi$(6) = "Harpsichord"
midi$(7) = "Clavi"
midi$(8) = "Celesta"
midi$(9) = "Glockenspiel"
midi$(10) = "MusicBox"
midi$(11) = "Vibraphone"
midi$(12) = "Marimba"
midi$(13) = "Xylophone"
midi$(14) = "TubularBells"
midi$(15) = "Dulcimer"
midi$(16) = "DrawbarOrgan"
midi$(17) = "PercussiveOrgan"
midi$(18) = "RockOrgan"
midi$(19) = "ChurchOrgan"
midi$(20) = "ReedOrgan"
midi$(21) = "Accordion"
midi$(22) = "Harmonica"
midi$(23) = "TanaoAccordion"
midi$(24) = "AcousticGuitar(nylon)"
midi$(25) = "AcousticGuitar(steel)"
midi$(26) = "ElectricGuitar(jazz)"
midi$(27) = "ElectricGuitar(clean)"
midi$(28) = "ElectricGuitar(muted)"
midi$(29) = "OverdrivenGuitar"
midi$(30) = "DistortionGuitar"
midi$(31) = "Guitarharmonics"
midi$(32) = "AcousticBass"
midi$(33) = "ElectricBass(finger)"
midi$(34) = "ElectricBass(pick)"
midi$(35) = "FretlessBass"
midi$(36) = "SlapBass1"
midi$(37) = "SlapBass2"
midi$(38) = "SynthBass1"
midi$(39) = "SynthBass2"
midi$(40) = "Violin"
midi$(41) = "Viola"
midi$(42) = "Cello"
midi$(43) = "Contrabass"
midi$(44) = "TremoloStrings"
midi$(45) = "PizzicatoStrinqs"
midi$(46) = "OrchestralHarp"
midi$(47) = "Timpani"
midi$(48) = "StringEnsemble1"
midi$(49) = "StringEnsemble2"
midi$(50) = "SynthStrings1"
midi$(51) = "SynthStrings2"
midi$(52) = "ChoirAahs"
midi$(53) = "VoiceOohs"
midi$(54) = "SynthVoice"
midi$(55) = "OrchestraHit"
midi$(56) = "Trumpet"
midi$(57) = "Trombone"
midi$(58) = "Tuba"
midi$(59) = "MutedTrumpet"
midi$(60) = "FrenchHorn"
midi$(61) = "BrassSection"
midi$(62) = "SynthBrass1"
midi$(63) = "SynthBrass2"
midi$(64) = "SopranoSax"
midi$(65) = "AltoSax"
midi$(66) = "Tenor"
midi$(67) = "BaritoneSax"
midi$(68) = "Oboe"
midi$(69) = "EnglishHorn"
midi$(70) = "Bassoon"
midi$(71) = "Clarinet"
midi$(72) = "Piccolo"
midi$(73) = "Flute"
midi$(74) = "Recorder"
midi$(75) = "PanFlute"
midi$(76) = "BlownBottle"
midi$(77) = "Shakuhachi"
midi$(78) = "Whistle"
midi$(79) = "Ocarina"
midi$(80) = "Lead1(square)"
midi$(81) = "Lead2(saw)"
midi$(82) = "Lead3(calliope)"
midi$(83) = "Lead4(chill)"
midi$(84) = "Lead5(charanq)"
midi$(85) = "Lead6(voice)"
midi$(86) = "Lead7(fifths)"
midi$(87) = "Lead8(bass+lead)"
midi$(88) = "Pad1(newage)"
midi$(89) = "Pad2(warm)"
midi$(90) = "Pad3(polysynth)"
midi$(91) = "Pad4(choir)"
midi$(92) = "Pad5(bowed)"
midi$(93) = "Pad6(metallic)"
midi$(94) = "Pad7(halo)"
midi$(95) = "Pad8(sweep)"
midi$(96) = "FX1(rain)"
midi$(97) = "Fx2%(soundtrack)"
midi$(98) = "FX3(crystal)"
midi$(99) = "FX(Athmosphere)"
midi$(100) = "FX5(brightness)"
midi$(101) = "FX6(goblins)"
midi$(102) = "FX7(echoes)"
midi$(103) = "FX8(sci-li)"
midi$(104) = "Sitar"
midi$(105) = "Banjo"
midi$(106) = "Shamisen"
midi$(107) = "Koto"
midi$(108) = "Kalimba"
midi$(109) = "Bagpipe"
midi$(110) = "Fiddie"
midi$(111) = "Shanai"
midi$(112) = "TinkleBell"
midi$(113) = "Agogo"
midi$(114) = "SteelDrums"
midi$(115) = "Woodblock"
midi$(116) = "TaikoDrum"
midi$(117) = "MelodicTom"
midi$(118) = "SynthDrum"
midi$(119) = "ReverseCymbal"
midi$(120) = "GuitarFretNoise"
midi$(121) = "BreathNoise"
midi$(122) = "Seashore"
midi$(123) = "BirdTweet"
midi$(124) = "TelephoneRing"
midi$(125) = "Helicopter"
midi$(126) = "Applause"
midi$(127) = "Gunshot"
midi$(128) = "AcousticBassDrum"
midi$(129) = "BassDrum1"
midi$(130) = "SideStick"
midi$(131) = "AcousticSnare"
midi$(132) = "HandClap"
midi$(133) = "ElectricSnare"
midi$(134) = "LowFloorTom"
midi$(135) = "ClosedHi-Hat"
midi$(136) = "HighFloorTom"
midi$(137) = "PedalHi-Hat"
midi$(138) = "LowTom"
midi$(139) = "OpenHi-Hat"
midi$(140) = "Low-MidTom"
midi$(141) = "Hi-MidTom"
midi$(142) = "CrashCymbal1"
midi$(143) = "HighTom"
midi$(144) = "RideCymbal1"
midi$(145) = "ChineseCymbal"
midi$(146) = "RideBell"
midi$(147) = "Tambourine"
midi$(148) = "SplashCymbal"
midi$(149) = "Cowbell"
midi$(150) = "CrashCymbal2"
midi$(151) = "Vibraslap"
midi$(152) = "RideCymbal2"
midi$(153) = "HiBongo"
midi$(154) = "LowBongo"
midi$(155) = "MuteHiConga"
midi$(156) = "OpenHiConga"
midi$(157) = "LowConga"
midi$(158) = "HighTimbale"
midi$(159) = "LowTimbale"
midi$(160) = "HighAgogo"
midi$(161) = "LowAgogo"
midi$(162) = "Cabasa"
midi$(163) = "Maracas"
midi$(164) = "ShortWhistle"
midi$(165) = "LongWhistle"
midi$(166) = "ShortGuiro"
midi$(167) = "LongGuiro"
midi$(168) = "Claves"
midi$(169) = "HiWoodBlock"
midi$(170) = "LowWoodBlock"
midi$(171) = "MuteCuica"
midi$(172) = "OpenCuica"
midi$(173) = "MuteTriangle"
midi$(174) = "OpenTriangle"
bit$(0) = ".": bit$(1) = "Ű"
RETURN
miditest:
hmidiout = 0
q = midiOutGetNumDevs(0): PRINT "MIDI-eszkozokok szama:"; q
IF q = 0 THEN PRINT "nincs MIDI-eszkoz": END
q = midiOutOpen(hmidiout, 0, 0, 0, 0): IF q THEN PRINT "MIDI-t nem sikerult megnyitni": END
PRINT "MIDI megnyitva"
REM ---------------------
ch = 9
kuld = &H0020C0 + ch
q = midiOutShortMsg(hmidiout, kuld)
PRINT q
kuld = &H7F2C90 + ch
q = midiOutShortMsg(hmidiout, kuld)
PRINT q
REM SLEEP .2
kuld = &HFF2C80 + ch
q = midiOutShortMsg(hmidiout, kuld)
PRINT q
RETURN
midizar: q = midiOutClose(hmidiout): RETURN
metronom: ms1 = x(23): ms2 = ms1 * 2: ms4 = ms1 * 4
mdob = (aleptek / ms2) = INT(aleptek / ms2): IF mdob = 0 THEN mdoba = 0
mccc = ((aleptek + ms1) / ms2) = INT((aleptek + ms1) / ms2): IF mccc = 0 THEN mccca = 0
mdzs = ((aleptek + ms2) / ms4) = INT((aleptek + ms2) / ms4): IF mdzs = 0 THEN mdzsa = 0
IF mdob AND mdoba = 0 THEN q = midiOutShortMsg(hmidiout, &H7F0099 OR (35 * 256)): mdoba = 1
IF mdzs AND mdzsa = 0 THEN q = midiOutShortMsg(hmidiout, &H7F0099 OR (38 * 256)): mdzsa = 1
IF mccc AND mccca = 0 THEN q = midiOutShortMsg(hmidiout, &H7F0099 OR (44 * 256)): mccca = 1
RETURN
randpoli:
GOSUB randpolivtrack: GOSUB randpolixhangszer: GOSUB randpolixoktav: RETURN
randpolixhangszer: FOR t = 0 TO 99: poli(t, 1) = INT(128 * RND(1)): NEXT t: RETURN
randpolixoktav: FOR t = 0 TO 99: poli(t, 8) = INT(4 * RND(1)) - 2: NEXT t: RETURN
randpolivtrack: FOR t = 0 TO 99:
poli(t, 3) = INT(x(24) * RND(1))
poli(t, 4) = INT(x(24) * RND(1))
poli(t, 5) = INT(x(24) * RND(1))
poli(t, 6) = INT(x(24) * RND(1))
poli(t, 7) = INT(x(24) * RND(1))
NEXT t: RETURN
commn:
q = INT(x(24) * RND(1))
q2 = INT(x(24) * RND(1))
FOR t = 0 TO 99
q3 = INT(x(24) * RND(1) * .7)
poli(t, 3) = q3
poli(t, 4) = q3 + 1
poli(t, 5) = q
poli(t, 6) = q2
poli(t, 7) = q3 + 2
NEXT t
RETURN
randutos: FOR t = 0 TO 99: utos(t, 1) = INT(46 * RND(1)): NEXT t: RETURN
hangokdec:
hn$(0) = "akt "
hn$(1) = "hang "
RETURN
polidec:
pn$(0) = "akt "
pn$(1) = "hangszerneve "
pn$(2) = "vol "
pn$(3) = "sav0 "
pn$(4) = "sav1 "
pn$(5) = "sav2 "
pn$(6) = "sav3 "
pn$(7) = "sav4 "
pn$(8) = "okt "
FOR t = 0 TO 99: poli(t, 0) = 1: poli(t, 2) = 127: NEXT t
RETURN
utosdec:
un$(0) = "akt "
un$(1) = "hangszerneve "
un$(2) = "vol "
un$(3) = "sav "
FOR t = 0 TO 99: utos(t, 0) = 1: utos(t, 2) = 127: utos(t, 3) = t: NEXT t
RETURN
utoshangszerrand:
FOR t = 0 TO 99: utos(t, 3) = INT(x(24) * RND(1)): NEXT t
RETURN
keszletdec:
kn$(0) = "num "
kn$(1) = "akt "
kn$(2) = "hang "
kn$(3) = "okt "
RETURN
savdec:
sn$(0) = "sav "
sn$(1) = "elt "
sn$(2) = "neg "
sn$(3) = "muveleti eredmeny "
sn$(4) = "jel "
FOR t = 0 TO 99: sav(t, 0) = 0: NEXT t: RETURN
polimutat:
ykpoli = 32
LOCATE ykpoli - 1, xkpoli: COLOR _RGB32(255, 255, 255): PRINT "POLIFONIKUS HANGSZEREK"
phol = 0: FOR t2 = 0 TO 9
IF LEN(pn$(t2)) THEN
COLOR _RGB32(177, 238, 127): LOCATE ykpoli, 1 + phol + xkpoli: PRINT pn$(t2)
FOR t = 0 TO x(30) - 1: ir$ = "--"
SELECT CASE t2
CASE 0: ir$ = bit$(poli(t, 0))
CASE 1: ir$ = MID$(STR$(poli(t, 1)), 2) + "-" + midi$(poli(t, 1))
CASE 2: ir$ = HEX$(poli(t, 2))
CASE 3, 4, 5, 6, 7:
IF (x(32) - (t2 - 3)) > 0 THEN ir$ = STR$(poli(t, t2))
CASE 8: ir$ = STR$(poli(t, 8))
END SELECT
xpoz = 1 + phol + xkpoli: ypoz = ykpoli + t + 1: xhossz = LEN(pn$(t2))
felt = (mauzy >= ypoz) AND (mauzy <= ypoz + yhossz)
felt = (mauzx >= xpoz) AND (mauzx <= xpoz + xhossz) AND felt
IF felt THEN COLOR aktiv1: aktiv$ = "poliparam": aktivp1 = t: aktivp2 = t2 ELSE COLOR aktiv2
LOCATE ypoz, xpoz: ir$ = LEFT$(ir$, LEN(pn$(t2)))
IF polimutatakt(t) THEN COLOR aktiv1
PRINT ir$
IF felt THEN FOR t5 = 0 TO x(32) - 1: savmutatakt(poli(t, 3 + t5)) = 1: NEXT t5
NEXT t: END IF: phol = phol + LEN(pn$(t2))
NEXT t2
boxx1 = (xkpoli - 1) * 8
boxy1 = (ykpoli - 2) * 16
boxx2 = boxx1 + (phol + xhossz) * 8 - 6
boxy2 = boxy1 + (x(30) + 2) * 16
COLOR keret: LINE (boxx1, boxy1)-(boxx2, boxy2), , B
RETURN
parammutat:
xk = 114: yk = 3
felt = mauzx >= (xk)
IF felt THEN aktiv$ = "parameterek": aktivp1 = INT(mauzy - 3)
COLOR _RGB32(255, 255, 255)
LOCATE 1, 114: PRINT "PARAMETEREK"
FOR t = 0 TO 99
IF LEN(par$(t)) THEN
IF aktiv$ = "parameterek" AND aktivp1 = t THEN COLOR aktiv1 ELSE COLOR aktiv2
LOCATE yk + t, xk: PRINT par$(t)
LOCATE yk + t, xk + 15: PRINT x(par(t, 0))
END IF
NEXT t
COLOR _RGB32(255, 255, 255)
LOCATE 40, 114: PRINT "HELP - H-billenytu"
LOCATE 42, 114: PRINT "ha elfogy a sav, nyomd meg a 0-at"
LOCATE 43, 114: PRINT "hasznald az egeret, bal-jobb klikk"
LOCATE 44, 114: PRINT "ertekek nov/csokk,es a gorgot"
LOCATE 55, 114: PRINT "Toth Gyula (30)4543730"
LOCATE 56, 114: PRINT "facebook.com/gyula.toth.165"
RETURN
utosmutat:
LOCATE ykutos - 1, xkutos: COLOR _RGB32(255, 255, 255): PRINT "UTOS HANGSZEREK"
phol = 0: FOR t2 = 0 TO 9
IF LEN(un$(t2)) THEN
COLOR _RGB32(177, 238, 127): LOCATE ykutos, 1 + phol + xkutos: PRINT un$(t2)
FOR t = 0 TO x(31) - 1: ir$ = "--"
SELECT CASE t2
CASE 0: ir$ = bit$(utos(t, 0))
CASE 1: ir$ = MID$(STR$(utos(t, 1)), 2) + "-" + midi$(utos(t, 1) + 128)
CASE 2: ir$ = HEX$(utos(t, 2))
CASE 3: ir$ = STR$(utos(t, 3))
END SELECT
xpoz = 1 + phol + xkutos: ypoz = ykutos + t + 1: xhossz = LEN(un$(t2))
felt = (mauzx >= xpoz) AND (mauzx <= xpoz + xhossz)
felt = (mauzy >= ypoz) AND (mauzy <= ypoz + yhossz) AND felt
IF felt THEN COLOR aktiv1: aktiv$ = "utosparam": aktivp1 = t: aktivp2 = t2 ELSE COLOR aktiv2
LOCATE ypoz, xpoz: ir$ = LEFT$(ir$, LEN(un$(t2)))
IF utosmutatakt(t) THEN COLOR aktiv1
PRINT ir$
IF felt THEN savmutatakt(utos(t, 3)) = 1
NEXT t: END IF: phol = phol + LEN(un$(t2))
NEXT t2
boxx1 = (xkutos - 1) * 8
boxy1 = (ykutos - 2) * 16
boxx2 = boxx1 + (phol + xhossz) * 8 - 6
boxy2 = boxy1 + (x(31) + 2) * 16
COLOR keret: LINE (boxx1, boxy1)-(boxx2, boxy2), , B
RETURN
savmutat:
LOCATE yksav - 1, xksav: COLOR _RGB32(255, 255, 255): PRINT "GENERALT SAVOK ERTEKI"; x(1); ","; x(2); ","; x(22)
phol = 0: FOR t2 = 0 TO 9
IF LEN(sn$(t2)) THEN
COLOR _RGB32(177, 238, 127): LOCATE yksav, 1 + phol + xksav: PRINT sn$(t2)
FOR t = 0 TO x(24) - 1: ir$ = "--"
aktualsav = aktivsav(t)
SELECT CASE t2
CASE 0: ir$ = STR$(t)
CASE 1: ir$ = STR$((sav(aktualsav, 1)))
CASE 2: ir$ = (bit$(sav(aktualsav, 2)))
CASE 3: ir$ = MID$(savok$(aktualsav), x(22) + sav(aktualsav, 1))
CASE 4: ir$ = STR$(anali(aktualsav))
END SELECT
xpoz = 1 + phol + xksav: ypoz = yksav + t + 1: xhossz = LEN(sn$(t2))
felt = (mauzx >= xpoz) AND (mauzx <= xpoz + xhossz)
felt = (mauzy >= ypoz) AND (mauzy <= ypoz + yhossz) AND felt
IF felt AND ((t2 = 1 OR t2 = 2) OR t2 = 3) THEN COLOR aktiv1: aktiv$ = "savparam": aktivp1 = aktualsav: aktivp2 = t2 ELSE COLOR aktiv2
LOCATE ypoz, xpoz: ir$ = LEFT$(ir$, LEN(sn$(t2)))
IF savmutatakt(t) THEN COLOR aktiv1
PRINT ir$
IF felt AND (t2 = 3) THEN
FOR t5 = 0 TO 99
IF utos(t5, 3) = t THEN utosmutatakt(t5) = 1
FOR t6 = 0 TO x(32) - 1
IF poli(t5, 3 + t6) = t THEN polimutatakt(t5) = 1
NEXT t6, t5
END IF
NEXT t
END IF
phol = phol + LEN(sn$(t2))
NEXT t2
boxx1 = (xksav - 1) * 8
boxy1 = (yksav - 2) * 16
boxx2 = boxx1 + (phol + xhossz) * 8 - 6
boxy2 = boxy1 + (x(24) + 2) * 16
COLOR keret: LINE (boxx1, boxy1)-(boxx2, boxy2), , B
RETURN
keszletmutat:
ykkeszlet = 32
LOCATE ykkeszlet - 1, xkkeszlet: COLOR _RGB32(255, 255, 255): PRINT "AKTIVHANG"; x(33)
phol = 0: FOR t2 = 0 TO 5
IF LEN(kn$(t2)) THEN
COLOR _RGB32(177, 238, 127): LOCATE ykkeszlet, 1 + phol + xkkeszlet: PRINT kn$(t2)
FOR t = 0 TO 2 ^ x(33) - 1: ir$ = "--"
SELECT CASE t2
CASE 0: ir$ = STR$(t)
CASE 1: ir$ = bit$(keszlet(t, 1))
CASE 2: ir$ = STR$(keszlet(t, 2))
CASE 3: ir$ = STR$(keszlet(t, 3))
END SELECT
xpoz = 1 + phol + xkkeszlet: ypoz = ykkeszlet + t + 1: xhossz = LEN(kn$(t2))
felt = (mauzx >= xpoz) AND (mauzx <= xpoz + xhossz)
felt = (mauzy >= ypoz) AND (mauzy <= ypoz + yhossz) AND felt
IF felt AND ((t2 = 1 OR t2 = 2) OR t2 = 3) THEN COLOR aktiv1: aktiv$ = "keszlet": aktivp1 = t: aktivp2 = t2 ELSE COLOR aktiv2
LOCATE ypoz, xpoz: ir$ = LEFT$(ir$, LEN(kn$(t2)))
PRINT ir$
NEXT t
END IF
phol = phol + LEN(kn$(t2))
NEXT t2
boxx1 = (xkkeszlet - 1) * 8
boxy1 = (ykkeszlet - 2) * 16
boxx2 = boxx1 + (phol + xhossz) * 8 - 6
boxy2 = boxy1 + (x(32) + 2) * 16
boxy2 = boxy1 + ((2 ^ x(32) + 2) * 16)
COLOR keret: LINE (boxx1, boxy1)-(boxx2, boxy2), , B
FOR t = 0 TO 2 ^ x(33) - 1
IF keszlet(t, 1) THEN
boxx1 = (xkkeszlet + 16) * 8
boxy1 = (ykkeszlet + 3 - 2.5 + t) * 16
melyik = keszlet(t, 2)
boxx2 = xkhangk * 8
boxy2 = (ykhangk + 3 - 2.5 + melyik) * 16
REM boxy2 = boxy1 + ((2 ^ x(32) + 2) * 16)
COLOR _RGB32(255, 255, 255): LINE (boxx1, boxy1)-(boxx2, boxy2)
END IF
NEXT t
RETURN
hangdec: ah = 0: okt = 0
hk$ = "c-c#d-d#e-f-f#g-g#a-a#h-"
FOR t = 0 TO 255
hangref$(t) = MID$(hk$, ah * 2 + 1, 2) + MID$(STR$(okt), 2)
ah = ah + 1: IF ah = 12 THEN ah = 0: okt = okt + 1
NEXT t
FOR t = 0 TO 11: hangnev$(t) = MID$(hk$, t * 2 + 1, 2): NEXT t
RETURN
hangokmutat:
ykhangk = 32
LOCATE ykhangk - 1, xkhangk: COLOR _RGB32(255, 255, 255): PRINT "HANGOK"
phol = 0: FOR t2 = 0 TO 2
IF LEN(hn$(t2)) THEN
COLOR _RGB32(177, 238, 127): LOCATE ykhangk, 1 + phol + xkhangk: PRINT hn$(t2)
FOR t = 0 TO 11: ir$ = "--"
SELECT CASE t2
CASE 0: ir$ = bit$(aktivkeszlet(t))
CASE 1: ir$ = hangnev$(t)
END SELECT
xpoz = 1 + phol + xkhangk: ypoz = ykhangk + t + 1: xhossz = LEN(hn$(t2))
felt = (mauzx >= xpoz) AND (mauzx <= xpoz + xhossz)
felt = (mauzy >= ypoz) AND (mauzy <= ypoz + yhossz) AND felt
IF felt AND ((t2 = 1 OR t2 = 2) OR t2 = 3) THEN COLOR aktiv1: aktiv$ = "aktivhangok": aktivp1 = t: aktivp2 = t2 ELSE COLOR aktiv2
LOCATE ypoz, xpoz: ir$ = LEFT$(ir$, LEN(hn$(t2)))
PRINT ir$
NEXT t
END IF
phol = phol + LEN(hn$(t2))
NEXT t2
boxx1 = (xkhangk - 1) * 8
boxy1 = (ykhangk - 2) * 16
boxx2 = boxx1 + (phol + xhossz) * 8 - 6
boxy2 = boxy1 + 14 * 16
COLOR keret: LINE (boxx1, boxy1)-(boxx2, boxy2), , B
RETURN
randhangsor5:
aktivkeszlet(0) = 1
aktivkeszlet(1) = 0
aktivkeszlet(2) = 1
aktivkeszlet(3) = 0
aktivkeszlet(4) = 1
aktivkeszlet(5) = 0
aktivkeszlet(6) = 0
aktivkeszlet(7) = 1
aktivkeszlet(8) = 0
aktivkeszlet(9) = 1
aktivkeszlet(10) = 0
aktivkeszlet(11) = 0
RETURN
randhangsor7:
aktivkeszlet(0) = 1
aktivkeszlet(1) = 0
aktivkeszlet(2) = 1
aktivkeszlet(3) = 0
aktivkeszlet(4) = 1
aktivkeszlet(5) = 1
aktivkeszlet(6) = 0
aktivkeszlet(7) = 1
aktivkeszlet(8) = 0
aktivkeszlet(9) = 1
aktivkeszlet(10) = 0
aktivkeszlet(11) = 1
RETURN
randoktkeszlet:
FOR t = 0 TO 2 ^ x(33) - 1
keszlet(t, 3) = INT(2 * RND(1)) - 1
NEXT t
RETURN
randaktivhangdec:
FOR t = 0 TO 2 ^ x(33) - 1
keszlet(t, 1) = INT(2 * RND(1))
NEXT t
RETURN
keszletminta4bit:
minta = INT(8 * RND(1)): hh = 0
FOR t = 0 TO 2 ^ x(33) - 1
keszlet(t, 1) = SGN(minta AND 2 ^ hh)
hh = hh + 1: hh = hh AND 3
NEXT t
RETURN
randrendeles:
FOR t = 0 TO 2 ^ x(33) - 1
112: melyik = INT(12 * RND(1))
IF aktivkeszlet(melyik) = 0 THEN GOTO 112
keszlet(t, 2) = melyik
NEXT t
RETURN
sorrendrendeles: melyik = 0
FOR t = 0 TO 2 ^ x(33) - 1
IF keszlet(t, 1) THEN
114: melyik = melyik + 1: IF melyik = 12 THEN melyik = 0
IF aktivkeszlet(melyik) = 0 THEN GOTO 114
keszlet(t, 2) = melyik
END IF
NEXT t
RETURN
randaktivkeszlet: FOR t = 0 TO 11:
aktivkeszlet(t) = INT(2 * RND(1))
NEXT t: RETURN
midihangszer: FOR t = 0 TO x(30) - 1: mh = t: IF t > 8 THEN mh = mh + 1
kom = 12 + mh + poli(t, 1) * 256: q = midiOutShortMsg(hmidiout, kuld)
NEXT t: RETURN
midipolion:
FOR t = 0 TO 22: mh = t: IF t > 8 THEN mh = mh + 1
REM eltolas = sav(aktualsav, 1)
hangero = poli(t, 2)
h1 = SGN(MID$(savok$(aktivsav(poli(t, 3))), x(22) + 1 + eltolas, 1) = bit$(1))
h2 = SGN(MID$(savok$(aktivsav(poli(t, 4))), x(22) + 1 + eltolas, 1) = bit$(1))
h3 = SGN(MID$(savok$(aktivsav(poli(t, 5))), x(22) + 1 + eltolas, 1) = bit$(1))
h4 = SGN(MID$(savok$(aktivsav(poli(t, 6))), x(22) + 1 + eltolas, 1) = bit$(1))
h5 = SGN(MID$(savok$(aktivsav(poli(t, 7))), x(22) + 1 + eltolas, 1) = bit$(1))
aktive1 = poli(t, 0)
okt1 = poli(t, 8)
egyuttallas = (h1 + h2 * 2 + h3 * 4 + h4 * 8 + h5 * 16)
egyuttallas = egyuttallas AND (2 ^ x(32) - 1)
melyikhang = keszlet(egyuttallas, 2)
aktive2 = keszlet(egyuttallas, 1)
okt2 = keszlet(egyuttallas, 3)
aktive3 = aktivkeszlet(melyikhang)
ahangszer = poli(t, 1)
REM hangszer kuldes
REM uj hang kuldes, es eltarolni
hang = (35 + melyikhang + (okt1 + okt2 + 2) * 12)
csatorna = mh
hangero = 127 * SGN(aktive1 AND (aktive2 AND aktive3))
hangszer = ahangszer
REM kussoltatas ha :hang vagy hangszer valtozik vagy direktvalzotatas van
feltetel1 = utolsohangszer(csatorna) <> ahangszer
feltetel2 = utolsohang(csatorna) <> hang
feltetel3 = x(39) OR (t > x(30) - 1)
IF (feltetel1 OR feltetel2) OR feltetel3 THEN
REM kussoltatas
kuld = csatorna + 9 * 16 + utolsohang(csatorna) * 256 + 0 * 65536: q = midiOutShortMsg(hmidiout, kuld)
END IF
IF feltetel1 THEN
REM hangszer beallitasa
kuld = csatorna + 12 * 16 + ahangszer * 256 + 127 * 65536: q = midiOutShortMsg(hmidiout, kuld)
END IF
IF (feltetel2 OR feltetel3) AND (t < x(30)) THEN
REM csatornara hang kiadasa es rogzitese
kuld = csatorna + 9 * 16 + hang * 256 + hangero * 65536: q = midiOutShortMsg(hmidiout, kuld)
END IF
utolsohang(csatorna) = hang
utolsohangszer(csatorna) = ahangszer
NEXT t
RETURN
csend: RETURN
FOR t = 0 TO x(30) - 1: mh = t: IF t > 8 THEN mh = mh + 1
kuld = csend(t)
q = midiOutShortMsg(hmidiout, kuld)
NEXT t
RETURN
feltcsend: RETURN
FOR t = 0 TO x(30) - 1: mh = t: IF t > 8 THEN mh = mh + 1
IF marad(t) = 0 THEN
kuld = csend(t)
q = midiOutShortMsg(hmidiout, kuld)
END IF
NEXT t
RETURN
decparam:
q = 0: par(q, 0) = 34: par(q, 1) = -21: par(q, 2) = 21: par$(q) = "leptek-szorzo"
q = 1: par(q, 0) = 30: par(q, 1) = 0: par(q, 2) = 20: par$(q) = "polihangszer"
q = 2: par(q, 0) = 31: par(q, 1) = 0: par(q, 2) = 20: par$(q) = "utoshangszer"
q = 3: par(q, 0) = 24: par(q, 1) = 2: par(q, 2) = 25: par$(q) = "savok szama"
q = 4: par(q, 0) = 35: par(q, 1) = 10: par(q, 2) = 100: par$(q) = "tempo"
q = 5: par(q, 0) = 23: par(q, 1) = 0: par(q, 2) = 3: par$(q) = "metronom"
q = 6: par(q, 0) = 32: par(q, 1) = 0: par(q, 2) = 5: par$(q) = "hangkeszlet"
q = 7: par(q, 0) = 36: par(q, 1) = 1: par(q, 2) = 500: par$(q) = "sorozat TAG1"
q = 8: par(q, 0) = 37: par(q, 1) = 1: par(q, 2) = 500: par$(q) = "sorozat TAG2"
q = 9: par(q, 0) = 38: par(q, 1) = 1: par(q, 2) = 10000: par$(q) = "sorozat szorzo"
q = 10: par(q, 0) = 39: par(q, 1) = 0: par(q, 2) = 1: par$(q) = "poli-hangszer lecsengese"
RETURN
zenementese2:
Filter$ = "Zenei-Algoritmus files (*.alg)|*.ALG|All files (*.*)|*.*"
Flags& = OFN_OVERWRITEPROMPT + OFN_NOCHANGEDIR ' add flag constants here
SFile$ = GetSaveFileName$("Zenei Algoritmus mentese ", ".\", Filter$, 1, Flags&, hWnd&)
fajlnev$ = "last.alg": GOSUB zenementese
IF SFile$ <> "" THEN fajlnev$ = SFile$: GOSUB zenementese
RETURN
zenementese:
OPEN fajlnev$ FOR OUTPUT AS 1
PRINT #1, sv$
PRINT #1, aleptek
FOR t1 = 0 TO 99: FOR t2 = 0 TO 19: PRINT #1, utos(t1, t2): NEXT t2, t1
FOR t1 = 0 TO 99: FOR t2 = 0 TO 19: PRINT #1, poli(t1, t2): NEXT t2, t1
FOR t1 = 0 TO 99: FOR t2 = 0 TO 19: PRINT #1, sav(t1, t2): NEXT t2, t1
FOR t1 = 0 TO 99: PRINT #1, savok$(t1): NEXT t1
FOR t1 = 0 TO 9999: PRINT #1, x(t1): NEXT t1
FOR t1 = 0 TO 99: PRINT #1, aktivsav(t1): NEXT t1
FOR t1 = 0 TO 99: PRINT #1, savmutatakt(t1): NEXT t1
FOR t1 = 0 TO 99: PRINT #1, polimutatakt(t1): NEXT t1
FOR t1 = 0 TO 99: PRINT #1, utosmutatakt(t1): NEXT t1
FOR t1 = 0 TO 99: FOR t2 = 0 TO 3: PRINT #1, keszlet(t1, t2): NEXT t2, t1
FOR t1 = 0 TO 11: PRINT #1, aktivkeszlet(t1): NEXT t1
CLOSE 1
RETURN
zenebetoltese:
IF fajlnev$ <> "last.alg" THEN
Filter$ = "Zenei-Algoritmus files (*.alg)|*.ALG|All files (*.*)|*.*"
Flags& = OFN_FILEMUSTEXIST + OFN_NOCHANGEDIR + OFN_READONLY ' add flag constants here
OFile$ = GetOpenFileName$("Zenei Algoritmus betoltese ", ".\", Filter$, 1, Flags&, hWnd&)
fajlnev$ = OFile$
END IF
IF _FILEEXISTS(fajlnev$) = 0 THEN RETURN
OPEN fajlnev$ FOR INPUT AS 1
LINE INPUT #1, ver$: IF ver$ <> sv$ THEN GOTO 888
INPUT #1, aleptek
FOR t1 = 0 TO 99: FOR t2 = 0 TO 19: INPUT #1, utos(t1, t2): NEXT t2, t1
FOR t1 = 0 TO 99: FOR t2 = 0 TO 19: INPUT #1, poli(t1, t2): NEXT t2, t1
FOR t1 = 0 TO 99: FOR t2 = 0 TO 19: INPUT #1, sav(t1, t2): NEXT t2, t1
FOR t1 = 0 TO 99: INPUT #1, savok$(t1): NEXT t1
FOR t1 = 0 TO 9999: INPUT #1, x(t1): NEXT t1
FOR t1 = 0 TO 99: INPUT #1, aktivsav(t1): NEXT t1
FOR t1 = 0 TO 99: INPUT #1, savmutatakt(t1): NEXT t1
FOR t1 = 0 TO 99: INPUT #1, polimutatakt(t1): NEXT t1
FOR t1 = 0 TO 99: INPUT #1, utosmutatakt(t1): NEXT t1
FOR t1 = 0 TO 99: FOR t2 = 0 TO 3: INPUT #1, keszlet(t1, t2): NEXT t2, t1
FOR t1 = 0 TO 11: INPUT #1, aktivkeszlet(t1): NEXT t1
888: CLOSE 1: RETURN
szisz:
END
FUNCTION GetOpenFileName$ (Title$, InitialDir$, Filter$, FilterIndex, Flags&, hWnd&)
' Title$ - The dialog title.
' InitialDir$ - If this left blank, it will use the directory where the last opened file is
' located. Specify ".\" if you want to always use the current directory.
' Filter$ - File filters separated by pipes (|) in the same format as using VB6 common dialogs.
' FilterIndex - The initial file filter to use. Will be altered by user during the call.
' Flags& - Dialog flags. Will be altered by the user during the call.
' hWnd& - Your program's window handle that should be aquired by the FindWindow function.
'
' Returns: Blank when cancel is clicked otherwise, the file name selected by the user.
' FilterIndex and Flags& will be changed depending on the user's selections.
DIM OpenCall AS FILEDIALOGTYPE ' Needed for dialog call
fFilter$ = Filter$
FOR R = 1 TO LEN(fFilter$) ' Replace the pipes with character zero
IF MID$(fFilter$, R, 1) = "|" THEN MID$(fFilter$, R, 1) = CHR$(0)
NEXT R
fFilter$ = fFilter$ + CHR$(0)
lpstrFile$ = STRING$(2048, 0) ' For the returned file name
lpstrDefExt$ = STRING$(10, 0) ' Extension will not be added when this is not specified
OpenCall.lStructSize = LEN(OpenCall)
OpenCall.hwndOwner = hWnd&
OpenCall.lpstrFilter = _OFFSET(fFilter$)
OpenCall.nFilterIndex = FilterIndex
OpenCall.lpstrFile = _OFFSET(lpstrFile$)
OpenCall.nMaxFile = LEN(lpstrFile$) - 1
OpenCall.lpstrFileTitle = OpenCall.lpstrFile
OpenCall.nMaxFileTitle = OpenCall.nMaxFile
OpenCall.lpstrInitialDir = _OFFSET(InitialDir$)
OpenCall.lpstrTitle = _OFFSET(Title$)
OpenCall.lpstrDefExt = _OFFSET(lpstrDefExt$)
OpenCall.flags = Flags&
Result = GetOpenFileNameA&(OpenCall) ' Do Open File dialog call!
IF Result THEN ' Trim the remaining zeros
GetOpenFileName$ = LEFT$(lpstrFile$, INSTR(lpstrFile$, CHR$(0)) - 1)
Flags& = OpenCall.flags
FilterIndex = OpenCall.nFilterIndex
END IF
END FUNCTION
FUNCTION GetSaveFileName$ (Title$, InitialDir$, Filter$, FilterIndex, Flags&, hWnd&)
' Title$ - The dialog title.
' InitialDir$ - If this left blank, it will use the directory where the last opened file is
' located. Specify ".\" if you want to always use the current directory.
' Filter$ - File filters separated by pipes (|) in the same format as VB6 common dialogs.
' FilterIndex - The initial file filter to use. Will be altered by user during the call.
' Flags& - Dialog flags. Will be altered by the user during the call.
' hWnd& - Your program's window handle that should be aquired by the FindWindow function.
' Returns: Blank when cancel is clicked otherwise, the file name entered by the user.
' FilterIndex and Flags& will be changed depending on the user's selections.
DIM SaveCall AS FILEDIALOGTYPE ' Needed for dialog call
fFilter$ = Filter$
FOR R = 1 TO LEN(fFilter$) ' Replace the pipes with zeros
IF MID$(fFilter$, R, 1) = "|" THEN MID$(fFilter$, R, 1) = CHR$(0)
NEXT R
fFilter$ = fFilter$ + CHR$(0)
lpstrFile$ = STRING$(2048, 0) ' For the returned file name
lpstrDefExt$ = STRING$(10, 0) ' Extension will not be added when this is not specified
SaveCall.lStructSize = LEN(SaveCall)
SaveCall.hwndOwner = hWnd&
SaveCall.lpstrFilter = _OFFSET(fFilter$)
SaveCall.nFilterIndex = FilterIndex
SaveCall.lpstrFile = _OFFSET(lpstrFile$)
SaveCall.nMaxFile = LEN(lpstrFile$) - 1
SaveCall.lpstrFileTitle = SaveCall.lpstrFile
SaveCall.nMaxFileTitle = SaveCall.nMaxFile
SaveCall.lpstrInitialDir = _OFFSET(InitialDir$)
SaveCall.lpstrTitle = _OFFSET(Title$)
SaveCall.lpstrDefExt = _OFFSET(lpstrDefExt$)
SaveCall.flags = Flags&
Result& = GetSaveFileNameA&(SaveCall) ' Do dialog call!
IF Result& THEN ' Trim the remaining zeros
GetSaveFileName$ = LEFT$(lpstrFile$, INSTR(lpstrFile$, CHR$(0)) - 1)
Flags& = SaveCall.flags
FilterIndex = SaveCall.nFilterIndex
END IF
END FUNCTION
-
How about being able to output direct to a PDF file? I did try playing around with that but failed miserably.
I think the same. It would be very useful
-
@SpriggsySpriggs
After all, one thing occurred to me. But consider whether it will not be too laborious. This is the only function that returns TRUE or FALSE. Detection if a sound card is present.
-
@Petr
Hi and Thanks to share this work of MasterGy!
It seems a good and complex MIDI station/sequencer.
Surely it isn't born to be shared internationally seeing the text showed by application.
I'll take a look seeking for easy implementation of functions like _LoadMidi, _SaveMidi, _PlayMidi param% where param% is like Start/Stop/Pause/End thinking just like a PLAY duplicate for MIDI files.
But you reading my answer can understand that I have poor knowledge of MIDI, except that like file it brings notes and not vibrations (sounds) so it is like a music sheet. So if I wants to play a song and I have its MIDI I can hear it played by a piano or a choord or a guitar.