Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.


Messages - MasterGy

Pages: 1 ... 20 21 [22]
316
QB64 Discussion / Re: 3d fps game (Fulopke es az ellenallok)_MAPTRIANGLE3D
« on: December 09, 2019, 07:46:44 pm »
Hi ! I'd like to do a "fülöpke2". I wanted it to be such an airplane mode, but the problem is that you can get bored quickly. but the course gives you the opportunity to jump on it. if that's the case, i want to put the old batteries in it. for example, flying only under certain conditions. it would be a lot of ideas if anyone has any, i would appreciate it. I want it to be boring. but they would need simple solutions. if someone has good ideas.

https://www.youtube.com/watch?v=binF_L_BwRM&feature=youtu.be

317
QB64 Discussion / Re: 3d fps game (Fulopke es az ellenallok)_MAPTRIANGLE3D
« on: December 05, 2019, 08:09:11 pm »
i like the solution in the edit. the level building !! take a lot! good luck with the game!

318
QB64 Discussion / Re: 3d fps game (Fulopke es az ellenallok)_MAPTRIANGLE3D
« on: December 05, 2019, 08:04:34 pm »
I was really surprised by the maptriangle3d speed and I got a lot of ideas, but I'm just experimenting. if anyone can get out of it, use it. I was thinking of flying game, but I don't have time. but as a basis for someone to be good.

use W,S, and mouse !

Code: QB64: [Select]
  1. DIM terep(39999, 49), pont(39999, 49), kellkocka(99, 99, 99)
  2. CONST pip180 = 3.1415 / 180
  3.  
  4.  
  5. res3dx = 1024
  6. res3dy = 768
  7. ivx = 200 'X-dimension size
  8. ivy = 200 'Y-dimension size
  9. ivz = 200 'Z-dimension size
  10. ks = .1 '1 box size
  11. kockadb = 1600 'piece of cubes
  12. msens = .3 'mouse sensitive
  13.  
  14.  
  15.  
  16.  
  18. mon = _NEWIMAGE(res3dx, res3dy, 32)
  19.  
  20.  
  21. 'create box texture
  22. kep0 = _NEWIMAGE(200, 200, 32): _DEST kep0: CIRCLE (100, 100), 60, _RGB32(255, 255, 255)
  23. LINE (0, 0)-(199, 199), , B , _RGB32(255, 255, 255)
  24. PAINT (100, 100), _RGB32(122, 139, 200), _RGB32(255, 255, 255)
  25. PAINT (2, 2), _RGB32(55, 0, 0), _RGB32(255, 255, 255)
  26. kep(0) = _COPYIMAGE(kep0, 33)
  28.  
  29.  
  30.  
  31. 'if you have a picture, use this
  32. 'kep(0) = _LOADIMAGE("d:\3dtext.bmp", 33)
  33.  
  34.  
  35.  
  36.  
  37.  
  38.  
  39. kezdpontkocka = pontdb: pontdb = pontdb + kockadb * 8
  40. kezdterepkocka = terepdb: terepdb = terepdb + kockadb * 6
  41.  
  42. GOSUB objadd '3d data to array for boxes
  43.  
  45.  
  47.     lepes = 2: 'speed me
  48.     px = 0: py = 0: pz = 0: GOSUB enlepes
  49.     IF _KEYDOWN(119) THEN px = en(5): py = en(6): pz = en(7)
  50.     IF _KEYDOWN(115) THEN px = -en(5): py = -en(6): pz = -en(7)
  51.     GOSUB egerkezelo: en(0) = en(0) + px * lepes: en(1) = en(1) + py * lepes: en(2) = en(2) + pz * lepes
  52.  
  53.     GOSUB pontcalc
  54.  
  55.     FOR t = 0 TO terepdb - 1
  56.         IF terep(t, 14) THEN
  57.             szorzo = 10
  58.  
  59.             x0 = pont(terep(t, 0), 20) * szorzo
  60.             y0 = pont(terep(t, 0), 21) * szorzo
  61.             z0 = -pont(terep(t, 0), 22) * szorzo + addz
  62.             x1 = pont(terep(t, 1), 20) * szorzo
  63.             y1 = pont(terep(t, 1), 21) * szorzo
  64.             z1 = -pont(terep(t, 1), 22) * szorzo + addz
  65.             x2 = pont(terep(t, 2), 20) * szorzo
  66.             y2 = pont(terep(t, 2), 21) * szorzo
  67.             z2 = -pont(terep(t, 2), 22) * szorzo + addz
  68.             x3 = pont(terep(t, 3), 20) * szorzo
  69.             y3 = pont(terep(t, 3), 21) * szorzo
  70.             z3 = -pont(terep(t, 3), 22) * szorzo + addz
  71.  
  72.             akep = terep(t, 4)
  73.             sx0 = terep(t, 5)
  74.             sy0 = terep(t, 6)
  75.             sx1 = terep(t, 7)
  76.             sy1 = terep(t, 8)
  77.             sx2 = terep(t, 9)
  78.             sy2 = terep(t, 10)
  79.             sx3 = terep(t, 11)
  80.             sy3 = terep(t, 12)
  81.  
  82.             limit = 12000
  83.             felt1 = x1 > -limit AND x1 < limit: felt2 = x2 > -limit AND x2 < limit
  84.             felt3 = x3 > -limit AND x3 < limit: felt4 = x4 > -limit AND x4 < limit
  85.             felt5 = y1 > -limit AND y1 < limit: felt6 = y2 > -limit AND y2 < limit
  86.             felt7 = y3 > -limit AND y3 < limit: felt8 = y4 > -limit AND y4 < limit
  87.             felt9 = z1 < 1 AND z1 > -10000: felt10 = z2 < 1 AND z2 > -10000
  88.             felt11 = z3 < 1 AND z3 > -10000: felt12 = z4 < 1 AND z4 > -10000
  89.             felta = ((felt1 AND felt2) AND (felt3 AND felt4)) AND ((felt5 AND felt6) AND (felt7 AND felt8))
  90.             feltb = (felt9 AND felt10) AND (felt11 AND felt12)
  91.  
  92.  
  93.             IF felta AND feltb THEN
  94.  
  95.                 _MAPTRIANGLE (sx0, sy0)-(sx1, sy1)-(sx2, sy2), kep(akep) TO(x0, y0, z0)-(x1, y1, z1)-(x2, y2, z2), , _SMOOTH
  96.                 _MAPTRIANGLE (sx3, sy3)-(sx1, sy1)-(sx2, sy2), kep(akep) TO(x3, y3, z3)-(x1, y1, z1)-(x2, y2, z2), , _SMOOTH
  97.  
  98.             END IF
  99.         END IF
  100.     NEXT t
  101.     LOCATE 1, 1: PRINT "en3"; en(3); "en4"; en(4)
  102.     LOCATE 2, 1: PRINT "en5"; en(5); "en6"; en(6); "en7"; en(7)
  103.     _DISPLAY: CLS
  106.  
  107.  
  108.  
  109. egerkezelo:
  110.  
  111.  
  112.  
  113. makt = 0: mousex = 0: mousey = 0
  114. FOR t = 0 TO 100: makt = _MOUSEINPUT
  115.     IF makt THEN
  116.         mousex = _MOUSEMOVEMENTX + mousex
  117.         mousey = _MOUSEMOVEMENTY + mousey
  118.  
  119.     END IF
  121.  
  122.  
  123.  
  124. en(3) = en(3) - mousey * msens
  125. en(4) = en(4) + (mousex * msens) * neg
  126. zslimit = 89
  127. IF en(3) >= 360 THEN en(3) = 0
  128. IF en(3) < 0 THEN en(3) = 360
  129. IF en(4) >= 360 THEN en(4) = 0
  130. IF en(4) < 0 THEN en(4) = 360
  132.  
  133.  
  134.  
  135. enlepes:
  136.  
  137.  
  138.  
  139. x5 = SIN(pip180 * en(4)) * 1
  140. x7 = COS(pip180 * en(4)) * 1
  141. neg = SGN(COS(en(3) * pip180))
  142. x5 = neg * x5: x7 = neg * x7
  143. x6 = (SIN(pip180 * en(3)) * 3)
  144.  
  145.  
  146.  
  147. s = (ABS(x6)) + (ABS(x5)) + ABS(x7)
  148. en(5) = 1 / s * x5
  149. en(6) = 1 / s * x6
  150. en(7) = 1 / s * x7
  151.  
  152.  
  153.  
  155.  
  156.  
  157.  
  158. pontcalc:
  159. FOR t = 1 TO pontdb - 1
  160.     x = pont(t, 0) - en(0): y = pont(t, 1) - en(1): z = pont(t, 2) - en(2)
  161.     rotx = pip180 * en(3): rotz = 0: roty = pip180 * en(4)
  162.     x2 = (x * COS(rotz)) - (y * SIN(rotz))
  163.     y2 = (x * SIN(rotz)) + (y * COS(rotz))
  164.     x3 = (x2 * COS(roty)) - (z * SIN(roty))
  165.     z2 = (x2 * SIN(roty)) + (z * COS(roty))
  166.     y3 = (y2 * COS(rotx)) - (z2 * SIN(rotx))
  167.     z3 = (y2 * SIN(rotx)) + (z2 * COS(rotx))
  168.     pont(t, 20) = x3: pont(t, 21) = y3: pont(t, 22) = z3
  170. t = 5
  171. qx = pont(t, 20) - pont(t, 0)
  172. qy = pont(t, 21) - pont(t, 1)
  173. qz = pont(t, 22) - pont(t, 2)
  174.  
  175.  
  176.  
  177.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  
  189. objadd:
  190.  
  191. ks = 5: REM kocka merete
  192. koc(0, 0) = -1
  193. koc(0, 1) = -1
  194. koc(0, 2) = -1
  195. koc(1, 0) = 1
  196. koc(1, 1) = -1
  197. koc(1, 2) = -1
  198. koc(2, 0) = -1
  199. koc(2, 1) = 1
  200. koc(2, 2) = -1
  201. koc(3, 0) = 1
  202. koc(3, 1) = 1
  203. koc(3, 2) = -1
  204. koc(4, 0) = -1
  205. koc(4, 1) = -1
  206. koc(4, 2) = 1
  207. koc(5, 0) = 1
  208. koc(5, 1) = -1
  209. koc(5, 2) = 1
  210. koc(6, 0) = -1
  211. koc(6, 1) = 1
  212. koc(6, 2) = 1
  213. koc(7, 0) = 1
  214. koc(7, 1) = 1
  215. koc(7, 2) = 1
  216.  
  217. FOR t = 0 TO kockadb - 1
  218.     DO: lehetx = INT(INT(ivx / ks) * RND(1)): lehety = INT(INT(ivy / ks) * RND(1)): lehetz = INT(INT(ivz / ks) * RND(1))
  219.     LOOP WHILE kellkocka(lehetx, lehety, lehetz)
  220.     kellkocka(lehetx, lehety, lehetz) = 1: ap = kezdpontkocka + t * 8
  221.     FOR t2 = 0 TO 7
  222.         pont(ap + t2, 0) = lehetx * ks + koc(t2, 0) * ks / 2 - ivx / 2
  223.         pont(ap + t2, 1) = lehety * ks + koc(t2, 1) * ks / 2 - ivy / 2
  224.         pont(ap + t2, 2) = lehetz * ks + koc(t2, 2) * ks / 2 - ivz / 2
  225.     NEXT t2
  226.  
  227.     at = kezdterepkocka + t * 6
  228.     atx = at + 0: p1 = ap + 0: p2 = ap + 1: p3 = ap + 2: p4 = ap + 3: GOSUB terepmake
  229.     atx = at + 1: p1 = ap + 5: p2 = ap + 4: p3 = ap + 7: p4 = ap + 6: GOSUB terepmake
  230.     atx = at + 2: p1 = ap + 1: p2 = ap + 5: p3 = ap + 3: p4 = ap + 7: GOSUB terepmake
  231.     atx = at + 3: p1 = ap + 4: p2 = ap + 0: p3 = ap + 6: p4 = ap + 2: GOSUB terepmake
  232.     atx = at + 4: p1 = ap + 4: p2 = ap + 5: p3 = ap + 0: p4 = ap + 1: GOSUB terepmake
  233.     atx = at + 5: p1 = ap + 7: p2 = ap + 6: p3 = ap + 3: p4 = ap + 2: GOSUB terepmake
  234.  
  235.  
  237.  
  239.  
  240. terepmake:
  241.  
  242. terep(atx, 0) = p1
  243. terep(atx, 1) = p2
  244. terep(atx, 2) = p3
  245. terep(atx, 3) = p4
  246. terep(atx, 4) = 0: REM kep azonosito
  247. terep(atx, 5) = 0
  248. terep(atx, 6) = 0
  249. terep(atx, 7) = _WIDTH(kep(0)) - 1
  250. terep(atx, 8) = 0
  251. terep(atx, 9) = 0
  252. terep(atx, 10) = _HEIGHT(kep(0)) - 1
  253. terep(atx, 11) = _WIDTH(kep(0)) - 1
  254. terep(atx, 12) = _HEIGHT(kep(0)) - 1
  255. terep(atx, 14) = 1: REM terep aktiv
  257.  
  258.  
  259.  
  260.  
  261.  

319
QB64 Discussion / Re: 3d fps game (Fulopke es az ellenallok)_MAPTRIANGLE3D
« on: December 05, 2019, 08:00:37 pm »
thank you Petr !

320
QB64 Discussion / 3d fps game (Fulopke es az ellenallok)_MAPTRIANGLE3D
« on: December 03, 2019, 05:17:48 pm »
Hi !

Sorry to open a new topic. I opened a new topic because I want to put it here if there is an update to the game.
I changed the game to MAPTRINGLE3D. Much better! The CPU is barely working, other tasks take more time. The rendering is beautiful, the text is the highest.

In maptriangle2d, I had to sort the tiles in order. That's a lot of time. You don't need maptriangle3d. Just "print" the 3d data and then the wonderful

_DISPLAY command displays. In addition, he hardly works in cpu.

I improved the game, added a little bit, has a finish, tried to enhance the game experience.

Thanks to those who are developing qb64, there are tremendous graphical opportunities.

https://www.youtube.com/watch?v=TFSOcD6jUbA

download (with source code)

https://drive.google.com/open?id=13TMm1HYUu0RIbToY4NF49qwReS5mNCxO



321
QB64 Discussion / Re: I'm new to QB64 and I'm having a conniption
« on: December 03, 2019, 01:23:39 pm »
Hi ! familiar problem, I used to say this:

do

    FOR ttt = 0 TO 1000: x = _MOUSEINPUT: NEXT ttt   
X = _MOUSEX
...

loop

322
QB64 Discussion / Re: 3d fps game (Fulopke es az ellenallok)
« on: December 02, 2019, 12:28:38 am »

This is the program.
Calculates from the bits of the resulting bands what sounds and at what pitch.

I'll write in more detail later if you wish. For now, if you press the R button, new music is always created. the values can be adjusted with the mouse using the left and right buttons and the scroll wheel.




Code: QB64: [Select]
  1. DEFLNG A-Z
  2. TYPE FILEDIALOGTYPE
  3.     lStructSize AS LONG '        For the DLL call
  4.     hwndOwner AS LONG '          Dialog will hide behind window when not set correctly
  5.     hInstance AS LONG '          Handle to a module that contains a dialog box template.
  6.     lpstrFilter AS _OFFSET '     Pointer of the string of file filters
  7.     lpstrCustFilter AS _OFFSET
  8.     nMaxCustFilter AS LONG
  9.     nFilterIndex AS LONG '       One based starting filter index to use when dialog is called
  10.     lpstrFile AS _OFFSET '       String full of 0's for the selected file name
  11.     nMaxFile AS LONG '           Maximum length of the string stuffed with 0's minus 1
  12.     lpstrFileTitle AS _OFFSET '  Same as lpstrFile
  13.     nMaxFileTitle AS LONG '      Same as nMaxFile
  14.     lpstrInitialDir AS _OFFSET ' Starting directory
  15.     lpstrTitle AS _OFFSET '      Dialog title
  16.     flags AS LONG '              Dialog flags
  17.     nFileOffset AS INTEGER '     Zero-based offset from path beginning to file name string pointed to by lpstrFile
  18.     nFileExtension AS INTEGER '  Zero-based offset from path beginning to file extension string pointed to by lpstrFile.
  19.     lpstrDefExt AS _OFFSET '     Default/selected file extension
  20.     lCustData AS LONG
  21.     lpfnHook AS LONG
  22.     lpTemplateName AS _OFFSET
  24.  
  25. DECLARE DYNAMIC LIBRARY "comdlg32" ' Library declarations using _OFFSET types
  26.     FUNCTION GetOpenFileNameA& (DIALOGPARAMS AS FILEDIALOGTYPE) ' The Open file dialog
  27.     FUNCTION GetSaveFileNameA& (DIALOGPARAMS AS FILEDIALOGTYPE) ' The Save file dialog
  29.  
  31.     FUNCTION FindWindow& (BYVAL ClassName AS _OFFSET, WindowName$) ' To get hWnd handle
  33.  
  35.     FUNCTION midiOutGetNumDevs (numdevs AS INTEGER)
  36.     FUNCTION midiOutOpen (lphMidiOut AS LONG, BYVAL uDeviceID AS LONG, BYVAL dwCallback AS LONG, BYVAL dwInstance AS LONG, BYVAL dwFlags AS LONG)
  37.     FUNCTION midiOutClose (BYVAL hMidiOut AS LONG)
  38.     FUNCTION midiOutShortMsg (BYVAL hMidiOut AS LONG, BYVAL dwMsg AS LONG)
  40.  
  41. _TITLE "ALGORITMUS-ZENE (TOTH GYULA 2019) "
  42. CLS: REM GOSUB masolasvedelem
  43. prog1 = _NEWIMAGE(1200, 1100, 32): SCREEN prog1
  44. prog2 = _NEWIMAGE(400, 80, 32)
  45.  
  46.  
  48. DIM par$(99), par(99, 2), bill$(99, 1), utolsohang(99), utolsohangszer(99)
  49. DIM aktiv1 AS LONG, aktiv2 AS LONG
  50.  
  51. DIM utos(99, 19), poli(99, 19), sav(99, 19), csend(99)
  52. DIM kuld AS LONG
  53. DIM hmidiout AS LONG
  54. DIM midi$(255), savok$(99)
  55. DIM x(9999)
  56. DIM mmidi AS LONG, keret AS LONG
  57. DIM aktivsav(99), savmutatakt(99), polimutatakt(99), utosmutatakt(99)
  58. DIM keszlet(99, 3)
  59. DIM hangref$(255), hangnev$(11)
  60. DIM aktivkeszlet(11)
  61.  
  62. sv$ = "ver1"
  63.  
  64. GOSUB hangdec
  65.  
  66. REM DIM mauzx AS _FLOAT, mauzy AS _FLOAT
  67. helpmutat = 1
  68. aktiv2 = _RGB32(194, 161, 133)
  69. aktiv1 = _RGB32(255, 255, 255)
  70. keret = aktiv2
  71.  
  72. dobszel$ = "1114112022233637394344"
  73. a$(0) = STRING$(10000, ".")
  74.  
  75.  
  76.  
  77.  
  78.  
  79.  
  80. x(0) = 2
  81. x(1) = 70
  82. x(2) = 81
  83. x(20) = 25: REM savok szama
  84. x(21) = 1: REM haladas iranya, szorzoja
  85. x(22) = 0: REM aktualis leptek-pozicio
  86. x(23) = 2: REM metronom szorzo
  87. x(24) = 0: REM ennyi aktiv sav van, ezt majd a program tolti ki (savinst)
  88. x(25) = 4000: REM savhossz
  89. x(30) = 8: REM ennyi polifonikus hangszer
  90. x(31) = 8: REM ennyi utos hangszer
  91. x(32) = 5: REM polifonikus jelfogok-szama
  92. x(33) = 5: REM hangkeszlet 2 ennyediken
  93. x(34) = 1: REM sorozat aktualis ertek szorzoja
  94. x(35) = 45: REM tempo
  95. x(36) = 3: REM sorozat tag1
  96. x(37) = 5: REM sorozat tag2
  97. x(38) = 100: REM sorozat szorzo
  98. x(39) = 0: REM hangszer lecsengese
  99.  
  100. REM UTOS tomb : a,b  a-melyik sav
  101. REM b-0: aktiv-e b-1:hangszer:c-1:hangero
  102.  
  103. REM 1.param : (0) = kussol (1)=utos (2) = polifonikus
  105. sx = 1: sy = 1
  106. RANDOMIZE TIMER: GOSUB miditest: GOSUB midiinst
  107.  
  108.  
  109. GOSUB billdec
  110. GOSUB decparam
  111. GOSUB randaktivkeszlet
  112. GOSUB randaktivhangdec
  113. GOSUB randrendeles
  114. GOSUB newsavinst
  115. GOSUB hangokdec
  116. GOSUB savdec
  117. GOSUB keszletdec
  118. GOSUB polidec: GOSUB randpoli
  119. GOSUB utosdec: GOSUB randutos
  120. GOSUB pre
  121.  
  122. GOSUB randhangsor5
  123. GOSUB sorrendrendeles
  124. GOSUB randoktkeszlet
  125. GOSUB randpolixoktav
  126.  
  127.  
  128. IF _FILEEXISTS("last.alg") THEN fajlnev$ = "last.alg": GOSUB zenebetoltese
  129.  
  131.  
  132.     _LIMIT x(35) / 5
  133.     REM    _DISPLAY
  134.  
  135.  
  136.     bill$ = LCASE$(INKEY$)
  137.  
  138.     SELECT CASE bill$
  139.         CASE CHR$(27): GOSUB midizar: fajlnev$ = "last.alg": GOSUB zenementese: SYSTEM
  140.         CASE bill$(0, 0): aleptek = 0
  141.         CASE bill$(1, 0): GOSUB savtxtadd: GOSUB randutos
  142.         CASE bill$(2, 0): GOSUB utoshangszerrand
  143.         CASE bill$(3, 0): GOSUB savtxtadd: GOSUB randpoli
  144.         CASE bill$(4, 0): GOSUB savtxtadd: GOSUB randpolixhangszer
  145.         CASE bill$(5, 0): GOSUB savtxtadd: GOSUB randpolixoktav
  146.         CASE bill$(6, 0): GOSUB savtxtadd: GOSUB randpolivtrack
  147.         CASE bill$(7, 0): GOSUB commn
  148.         CASE bill$(8, 0): GOSUB savtxtadd: GOSUB randomsorozat
  149.         CASE bill$(9, 0): GOSUB randaktivhangdec
  150.         CASE bill$(10, 0): GOSUB randaktivkeszlet
  151.         CASE bill$(11, 0): GOSUB randrendeles
  152.         CASE bill$(12, 0): GOSUB sorrendrendeles
  153.         CASE bill$(13, 0): GOSUB randhangsor5
  154.         CASE bill$(14, 0): GOSUB randhangsor7
  155.         CASE bill$(15, 0): helpmutat = helpmutat XOR 1
  156.         CASE bill$(16, 0): GOSUB keszletminta4bit
  157.         CASE bill$(17, 0): GOSUB randoktkeszlet
  158.         CASE bill$(18, 0): GOSUB midizar: GOSUB inakt: fajlnev$ = "uj": GOSUB zenementese2: RUN
  159.         CASE bill$(19, 0): GOSUB midizar: GOSUB inakt: fajlnev$ = "uj": GOSUB zenebetoltese: fajlnev$ = "last.alg": GOSUB zenementese: RUN
  160.         CASE bill$(20, 0): GOSUB visszaallit: GOSUB midizar: RUN
  161.     END SELECT
  162.  
  163.     aktiv$ = ""
  164.     CLS
  165.     ykpoli = 24 + x(24) - 16: xkpoli = 5
  166.     ykkeszlet = 24 + x(24) - 16: xkkeszlet = 64
  167.     yksav = 4: xksav = 5
  168.     ykutos = yksav: xkutos = 70 - 6
  169.     ykhangk = ykpoli: xkhangk = 96
  170.     GOSUB parammutat
  171.     IF x(32) THEN GOSUB hangokmutat
  172.     GOSUB savaktdel
  173.     GOSUB utosmutat
  174.     GOSUB utosaktdel
  175.  
  176.     GOSUB polimutat
  177.     GOSUB poliaktdel
  178.     GOSUB savmutat
  179.     IF x(32) THEN GOSUB keszletmutat
  180.  
  181.     COLOR _RGB32(255, 255, 255): LINE (900, 0)-(900, 1100)
  182.     IF (_KEYDOWN(100303) OR _KEYDOWN(100304)) OR helpmutat THEN GOSUB billmutat
  183.     _DISPLAY
  184.     egergorgo = 0: FOR t = 0 TO 200:
  185.  
  186.         q = _MOUSEINPUT: mauzx = (_MOUSEX / 8) + 1: mauzy = (_MOUSEY / 16) + 1:
  187.         egergorgo = _MOUSEWHEEL + egergorgo
  188.     NEXT t
  189.     egergorgo = SGN(egergorgo)
  190.     IF LEN(aktiv$) THEN GOSUB akciokezelo
  191.     REM GOSUB midihangszer
  192.     REM     GOSUB feltcsend
  193.     IF x(32) THEN GOSUB midipolion
  194.     GOSUB szolalutos
  195.     IF x(23) THEN GOSUB metronom
  196.     x(22) = aleptek * x(34) + 1600
  197.     aleptek = aleptek + 1
  198.     SELECT CASE x(32)
  199.         CASE 0: x(33) = 0
  200.         CASE 1: x(33) = 1
  201.         CASE 2: x(33) = 2
  202.         CASE 3: x(33) = 3
  203.         CASE 4: x(33) = 4
  204.         CASE 5: x(33) = 5
  205.     END SELECT
  206.  
  208.  
  209. inakt:
  212. PRINT "inaktiv, ne zard be !": RETURN
  213.  
  214.  
  215.  
  216. visszaallit: IF _FILEEXISTS("last.alg") THEN KILL "last.alg"
  218.  
  219. billdec:
  220. bill$(0, 0) = "0": bill$(0, 1) = "sorozat kezdoponta allitas"
  221. bill$(1, 0) = "q": bill$(1, 1) = "utoshangszerek random hangszerei"
  222. bill$(2, 0) = "w": bill$(2, 1) = "utoshangszerek random SAV-jai"
  223. bill$(3, 0) = "y": bill$(3, 1) = "polihangszerek random ertekek"
  224. bill$(4, 0) = "x": bill$(4, 1) = "polihangszerek random hangszerei"
  225. bill$(5, 0) = "c": bill$(5, 1) = "polihangszerek random oktavok"
  226. bill$(6, 0) = "v": bill$(6, 1) = "polihangszerek random savjai"
  227. bill$(7, 0) = "n": bill$(7, 1) = "polihangszerek egyforma 2 track"
  228. bill$(8, 0) = "a": bill$(8, 1) = "random sorozat eloallitasa"
  229. bill$(9, 0) = "1": bill$(9, 1) = "keszlet random aktivizalasa"
  230. bill$(10, 0) = "2": bill$(10, 1) = "alapkeszlet random aktivizalasa"
  231. bill$(11, 0) = "3": bill$(11, 1) = "random hangkeszlethez rendeles"
  232. bill$(12, 0) = "4": bill$(12, 1) = "rendezett hangkeszlethez rendeles"
  233. bill$(13, 0) = "5": bill$(13, 1) = "5-foku hangsor betoltes"
  234. bill$(14, 0) = "7": bill$(14, 1) = "7-foku hangsor betoltes"
  235. bill$(15, 0) = "h": bill$(15, 1) = "HELP - billentyuzet funkciok"
  236. bill$(16, 0) = "8": bill$(16, 1) = "keszlet aktiv 4 bit minta alapjan"
  237. bill$(17, 0) = "s": bill$(17, 1) = "random oktav keszlet"
  238. bill$(18, 0) = "p": bill$(18, 1) = "zene mentese"
  239. bill$(19, 0) = "o": bill$(19, 1) = "zene betoltese"
  240. bill$(20, 0) = "r": bill$(20, 1) = "RESET, mindent alapertekre"
  241.  
  243.  
  244.  
  245. billmutat: xx = 0: FOR t = 0 TO 99
  246.     IF LEN(bill$(t, 0)) THEN
  247.         xx = xx + 1
  248.         LOCATE xx, 1: PRINT SPACE$(45)
  249.         LOCATE xx, 1: PRINT UCASE$(bill$(t, 0)) + " - "; bill$(t, 1)
  250.     END IF
  253.  
  254.  
  255.  
  256. szolalutos: FOR t = 0 TO x(31) - 1
  257.  
  258.     aktualsav = aktivsav(utos(t, 3))
  259.  
  260.     eltolas = sav(aktualsav, 1)
  261.     ae = MID$(savok$(aktualsav), x(22) + 1 + eltolas, 1) = bit$(1)
  262.     IF ae AND utos(t, 0) THEN
  263.         kuld = &H7F0099: mmidi = utos(t, 1) + 35
  264.         kuld = kuld OR ((mmidi AND 255) * 256)
  265.         q = midiOutShortMsg(hmidiout, kuld): IF q THEN END
  266.     END IF
  267.  
  269.  
  270.  
  271. savaktdel: FOR t = 0 TO 99: savmutatakt(t) = 0: NEXT t: RETURN
  272. poliaktdel: FOR t = 0 TO 99: polimutatakt(t) = 0: NEXT t: RETURN
  273. utosaktdel: FOR t = 0 TO 99: utosmutatakt(t) = 0: NEXT t: RETURN
  274.  
  275. akciokezelo:
  276. modosit = -egergorgo
  277. IF _MOUSEBUTTON(1) = 0 AND _MOUSEBUTTON(2) = 0 THEN mbm = 0
  278. IF _MOUSEBUTTON(1) AND mbm = 0 THEN modosit = -1: mbm = 1
  279. IF _MOUSEBUTTON(2) AND mbm = 0 THEN modosit = 1: mbm = 1
  280.  
  281. IF modosit THEN
  282.     SELECT CASE aktiv$
  283.         CASE "parameterek"
  284.             mx0 = par(aktivp1, 0)
  285.             modositott2 = x(mx0) + modosit
  286.             felt = modositott2 >= par(aktivp1, 1) AND modositott2 <= par(aktivp1, 2)
  287.             IF felt AND mx0 = 30 THEN GOSUB csend
  288.             IF felt THEN x(mx0) = modositott2
  289.             IF felt AND mx0 = 24 THEN GOSUB utoshangszerrand: GOSUB randpolivtrack
  290.         CASE "utosparam"
  291.  
  292.             utos(aktivp1, aktivp2) = utos(aktivp1, aktivp2) + modosit
  293.             utos(aktivp1, 0) = ABS(utos(aktivp1, 0)) AND 1
  294.  
  295.  
  296.  
  297.             IF utos(aktivp1, 2) > 127 THEN utos(aktivp1, 2) = 0
  298.             IF utos(aktivp1, 2) < 0 THEN utos(aktivp1, 2) = 127
  299.             IF utos(aktivp1, 1) > 45 THEN utos(aktivp1, 1) = 0
  300.             IF utos(aktivp1, 1) < 0 THEN utos(aktivp1, 1) = 45
  301.  
  302.             IF utos(aktivp1, 3) >= x(24) THEN utos(aktivp1, 3) = 0
  303.             IF utos(aktivp1, 3) < 0 THEN utos(aktivp1, 3) = x(24) - 1
  304.         CASE "aktivhangok"
  305.             IF modosit THEN aktivkeszlet(aktivp1) = aktivkeszlet(aktivp1) XOR 1
  306.         CASE "poliparam"
  307.  
  308.  
  309.             poli(aktivp1, aktivp2) = poli(aktivp1, aktivp2) + modosit
  310.             poli(aktivp1, 0) = ABS(poli(aktivp1, 0)) AND 1
  311.             IF poli(aktivp1, 1) > 127 THEN poli(aktivp1, 1) = 0
  312.             IF poli(aktivp1, 1) < 0 THEN poli(aktivp1, 1) = 127
  313.             IF poli(aktivp1, 2) > 127 THEN poli(aktivp1, 2) = 0
  314.             IF poli(aktivp1, 2) < 0 THEN poli(aktivp1, 2) = 127
  315.             IF poli(aktivp1, 8) > 4 THEN poli(aktivp1, 8) = 4
  316.             IF poli(aktivp1, 8) < -4 THEN poli(aktivp1, 8) = -4
  317.  
  318.             FOR t3 = 3 TO 6
  319.                 IF poli(aktivp1, t3) > (x(24) - 1) THEN poli(aktivp1, t3) = 0
  320.                 IF poli(aktivp1, t3) < 0 THEN poli(aktivp1, t3) = x(24) - 1
  321.             NEXT t3
  322.         CASE "keszlet"
  323.            55: keszlet(aktivp1, aktivp2) = keszlet(aktivp1, aktivp2) + modosit
  324.  
  325.  
  326.  
  327.             keszlet(aktivp1, 1) = ABS(keszlet(aktivp1, 1)) AND 1
  328.             IF keszlet(aktivp1, 3) > 4 THEN keszlet(aktivp1, 3) = 4
  329.             IF keszlet(aktivp1, 3) < -4 THEN keszlet(aktivp1, 3) = -4
  330.             IF keszlet(aktivp1, 2) > 11 THEN keszlet(aktivp1, 2) = 0
  331.             IF keszlet(aktivp1, 2) < 0 THEN keszlet(aktivp1, 2) = 11
  332.             IF (aktivkeszlet(keszlet(aktivp1, 2)) = 0) AND (aktivp2 = 2) THEN GOTO 55
  333.  
  334.  
  335.         CASE "savparam"
  336.             sav(aktivp1, aktivp2) = sav(aktivp1, aktivp2) + modosit
  337.             sav(aktivp1, 2) = ABS(sav(aktivp1, 2)) AND 1
  338.             IF sav(aktivp1, 1) > 9 THEN sav(aktivp1, 1) = 9
  339.             IF sav(aktivp1, 1) < -9 THEN sav(aktivp1, 1) = -9
  340.  
  341.  
  342.     END SELECT
  344. GOTO 77
  345. FOR t = 0 TO 2 ^ x(33) - 1
  346.     IF aktivkeszlet(keszlet(t, 2)) = 0 THEN keszlet(t, 1) = 0
  348. 77
  349.  
  351.  
  352.  
  353.  
  354.  
  355. newsavinst: CLS: REDIM anali(999): x(22) = 0: aleptek = 0: REM aktualis lepes 1-ra
  356. FOR t = 0 TO x(20) - 1: savok$(t) = STRING$(14, "."): NEXT t
  357. FOR alep = 0 TO x(25) - 1: ertek = (x(1) * alep) AND (x(2) * alep)
  358.     FOR t = 0 TO x(20) - 1: bit = SGN((2 ^ t) AND ertek)
  359.     savok$(t) = savok$(t) + bit$(bit): anali(t) = anali(t) + bit: NEXT t
  360. NEXT alep
  361. aktivsavdb = 0: FOR t = 0 TO x(20) - 1
  362.     IF anali(t) THEN aktivsav(aktivsavdb) = t: aktivsavdb = aktivsavdb + 1
  363. NEXT t: x(24) = aktivsavdb
  364.  
  365.  
  366. REM anali fejlec
  367. REM 0-aktiv sav (ezt majd a program tolti ki)
  368. REM 1-osszes 1-es
  370.  
  371.  
  372.  
  373.  
  374.  
  375.  
  376. savtxtadd: FOR t = 0 TO x(20): savok$(t) = MID$(savok$(t), 2) + "*": NEXT t: RETURN
  377.  
  378. randomsorozat:
  379. REM 3,11 jo !
  380.  
  381. alap = INT(x(38) * RND(1)): x(1) = alap * x(36): x(2) = alap * x(37)
  382. GOTO newsavinst
  383.  
  384.  
  385.  
  386. pre: FOR t = 0 TO 99: utos(t, 0) = 1: utos(t, 2) = 127: NEXT t: RETURN
  387.  
  388.  
  389.  
  390.  
  391.  
  392.  
  393.  
  394.  
  395.  
  396.  
  397.  
  398.  
  399.  
  400.  
  401.  
  402.  
  403.  
  404.  
  405.  
  406.  
  407.  
  408.  
  409.  
  410.  
  411.  
  412.  
  413.  
  414.  
  415.  
  416.  
  417. midiinst:
  418. midi$(0) = "AcousticGrandPiano"
  419. midi$(1) = "BrightAcousticPiano"
  420. midi$(2) = "ElectricGrandPiano"
  421. midi$(3) = "Honky-tonkPiano"
  422. midi$(4) = "ElectricPiano1"
  423. midi$(5) = "ElectricPiano2"
  424. midi$(6) = "Harpsichord"
  425. midi$(7) = "Clavi"
  426. midi$(8) = "Celesta"
  427. midi$(9) = "Glockenspiel"
  428. midi$(10) = "MusicBox"
  429. midi$(11) = "Vibraphone"
  430. midi$(12) = "Marimba"
  431. midi$(13) = "Xylophone"
  432. midi$(14) = "TubularBells"
  433. midi$(15) = "Dulcimer"
  434. midi$(16) = "DrawbarOrgan"
  435. midi$(17) = "PercussiveOrgan"
  436. midi$(18) = "RockOrgan"
  437. midi$(19) = "ChurchOrgan"
  438. midi$(20) = "ReedOrgan"
  439. midi$(21) = "Accordion"
  440. midi$(22) = "Harmonica"
  441. midi$(23) = "TanaoAccordion"
  442. midi$(24) = "AcousticGuitar(nylon)"
  443. midi$(25) = "AcousticGuitar(steel)"
  444. midi$(26) = "ElectricGuitar(jazz)"
  445. midi$(27) = "ElectricGuitar(clean)"
  446. midi$(28) = "ElectricGuitar(muted)"
  447. midi$(29) = "OverdrivenGuitar"
  448. midi$(30) = "DistortionGuitar"
  449. midi$(31) = "Guitarharmonics"
  450. midi$(32) = "AcousticBass"
  451. midi$(33) = "ElectricBass(finger)"
  452. midi$(34) = "ElectricBass(pick)"
  453. midi$(35) = "FretlessBass"
  454. midi$(36) = "SlapBass1"
  455. midi$(37) = "SlapBass2"
  456. midi$(38) = "SynthBass1"
  457. midi$(39) = "SynthBass2"
  458. midi$(40) = "Violin"
  459. midi$(41) = "Viola"
  460. midi$(42) = "Cello"
  461. midi$(43) = "Contrabass"
  462. midi$(44) = "TremoloStrings"
  463. midi$(45) = "PizzicatoStrinqs"
  464. midi$(46) = "OrchestralHarp"
  465. midi$(47) = "Timpani"
  466. midi$(48) = "StringEnsemble1"
  467. midi$(49) = "StringEnsemble2"
  468. midi$(50) = "SynthStrings1"
  469. midi$(51) = "SynthStrings2"
  470. midi$(52) = "ChoirAahs"
  471. midi$(53) = "VoiceOohs"
  472. midi$(54) = "SynthVoice"
  473. midi$(55) = "OrchestraHit"
  474. midi$(56) = "Trumpet"
  475. midi$(57) = "Trombone"
  476. midi$(58) = "Tuba"
  477. midi$(59) = "MutedTrumpet"
  478. midi$(60) = "FrenchHorn"
  479. midi$(61) = "BrassSection"
  480. midi$(62) = "SynthBrass1"
  481. midi$(63) = "SynthBrass2"
  482. midi$(64) = "SopranoSax"
  483. midi$(65) = "AltoSax"
  484. midi$(66) = "Tenor"
  485. midi$(67) = "BaritoneSax"
  486. midi$(68) = "Oboe"
  487. midi$(69) = "EnglishHorn"
  488. midi$(70) = "Bassoon"
  489. midi$(71) = "Clarinet"
  490. midi$(72) = "Piccolo"
  491. midi$(73) = "Flute"
  492. midi$(74) = "Recorder"
  493. midi$(75) = "PanFlute"
  494. midi$(76) = "BlownBottle"
  495. midi$(77) = "Shakuhachi"
  496. midi$(78) = "Whistle"
  497. midi$(79) = "Ocarina"
  498. midi$(80) = "Lead1(square)"
  499. midi$(81) = "Lead2(saw)"
  500. midi$(82) = "Lead3(calliope)"
  501. midi$(83) = "Lead4(chill)"
  502. midi$(84) = "Lead5(charanq)"
  503. midi$(85) = "Lead6(voice)"
  504. midi$(86) = "Lead7(fifths)"
  505. midi$(87) = "Lead8(bass+lead)"
  506. midi$(88) = "Pad1(newage)"
  507. midi$(89) = "Pad2(warm)"
  508. midi$(90) = "Pad3(polysynth)"
  509. midi$(91) = "Pad4(choir)"
  510. midi$(92) = "Pad5(bowed)"
  511. midi$(93) = "Pad6(metallic)"
  512. midi$(94) = "Pad7(halo)"
  513. midi$(95) = "Pad8(sweep)"
  514. midi$(96) = "FX1(rain)"
  515. midi$(97) = "Fx2%(soundtrack)"
  516. midi$(98) = "FX3(crystal)"
  517. midi$(99) = "FX(Athmosphere)"
  518. midi$(100) = "FX5(brightness)"
  519. midi$(101) = "FX6(goblins)"
  520. midi$(102) = "FX7(echoes)"
  521. midi$(103) = "FX8(sci-li)"
  522. midi$(104) = "Sitar"
  523. midi$(105) = "Banjo"
  524. midi$(106) = "Shamisen"
  525. midi$(107) = "Koto"
  526. midi$(108) = "Kalimba"
  527. midi$(109) = "Bagpipe"
  528. midi$(110) = "Fiddie"
  529. midi$(111) = "Shanai"
  530. midi$(112) = "TinkleBell"
  531. midi$(113) = "Agogo"
  532. midi$(114) = "SteelDrums"
  533. midi$(115) = "Woodblock"
  534. midi$(116) = "TaikoDrum"
  535. midi$(117) = "MelodicTom"
  536. midi$(118) = "SynthDrum"
  537. midi$(119) = "ReverseCymbal"
  538. midi$(120) = "GuitarFretNoise"
  539. midi$(121) = "BreathNoise"
  540. midi$(122) = "Seashore"
  541. midi$(123) = "BirdTweet"
  542. midi$(124) = "TelephoneRing"
  543. midi$(125) = "Helicopter"
  544. midi$(126) = "Applause"
  545. midi$(127) = "Gunshot"
  546. midi$(128) = "AcousticBassDrum"
  547. midi$(129) = "BassDrum1"
  548. midi$(130) = "SideStick"
  549. midi$(131) = "AcousticSnare"
  550. midi$(132) = "HandClap"
  551. midi$(133) = "ElectricSnare"
  552. midi$(134) = "LowFloorTom"
  553. midi$(135) = "ClosedHi-Hat"
  554. midi$(136) = "HighFloorTom"
  555. midi$(137) = "PedalHi-Hat"
  556. midi$(138) = "LowTom"
  557. midi$(139) = "OpenHi-Hat"
  558. midi$(140) = "Low-MidTom"
  559. midi$(141) = "Hi-MidTom"
  560. midi$(142) = "CrashCymbal1"
  561. midi$(143) = "HighTom"
  562. midi$(144) = "RideCymbal1"
  563. midi$(145) = "ChineseCymbal"
  564. midi$(146) = "RideBell"
  565. midi$(147) = "Tambourine"
  566. midi$(148) = "SplashCymbal"
  567. midi$(149) = "Cowbell"
  568. midi$(150) = "CrashCymbal2"
  569. midi$(151) = "Vibraslap"
  570. midi$(152) = "RideCymbal2"
  571. midi$(153) = "HiBongo"
  572. midi$(154) = "LowBongo"
  573. midi$(155) = "MuteHiConga"
  574. midi$(156) = "OpenHiConga"
  575. midi$(157) = "LowConga"
  576. midi$(158) = "HighTimbale"
  577. midi$(159) = "LowTimbale"
  578. midi$(160) = "HighAgogo"
  579. midi$(161) = "LowAgogo"
  580. midi$(162) = "Cabasa"
  581. midi$(163) = "Maracas"
  582. midi$(164) = "ShortWhistle"
  583. midi$(165) = "LongWhistle"
  584. midi$(166) = "ShortGuiro"
  585. midi$(167) = "LongGuiro"
  586. midi$(168) = "Claves"
  587. midi$(169) = "HiWoodBlock"
  588. midi$(170) = "LowWoodBlock"
  589. midi$(171) = "MuteCuica"
  590. midi$(172) = "OpenCuica"
  591. midi$(173) = "MuteTriangle"
  592. midi$(174) = "OpenTriangle"
  593. bit$(0) = ".": bit$(1) = "Ű"
  595. miditest:
  596.  
  597. hmidiout = 0
  598. q = midiOutGetNumDevs(0): PRINT "MIDI-eszkozokok szama:"; q
  599. IF q = 0 THEN PRINT "nincs MIDI-eszkoz": END
  600.  
  601. q = midiOutOpen(hmidiout, 0, 0, 0, 0): IF q THEN PRINT "MIDI-t nem sikerult megnyitni": END
  602. PRINT "MIDI megnyitva"
  603. REM ---------------------
  604.  
  605.  
  606.  
  607.  
  608.  
  609. ch = 9
  610.  
  611. kuld = &H0020C0 + ch
  612. q = midiOutShortMsg(hmidiout, kuld)
  614.  
  615. kuld = &H7F2C90 + ch
  616. q = midiOutShortMsg(hmidiout, kuld)
  618.  
  620.  
  621. kuld = &HFF2C80 + ch
  622. q = midiOutShortMsg(hmidiout, kuld)
  625.  
  626. midizar: q = midiOutClose(hmidiout): RETURN
  627.  
  628.  
  629. metronom: ms1 = x(23): ms2 = ms1 * 2: ms4 = ms1 * 4
  630. mdob = (aleptek / ms2) = INT(aleptek / ms2): IF mdob = 0 THEN mdoba = 0
  631. mccc = ((aleptek + ms1) / ms2) = INT((aleptek + ms1) / ms2): IF mccc = 0 THEN mccca = 0
  632. mdzs = ((aleptek + ms2) / ms4) = INT((aleptek + ms2) / ms4): IF mdzs = 0 THEN mdzsa = 0
  633. IF mdob AND mdoba = 0 THEN q = midiOutShortMsg(hmidiout, &H7F0099 OR (35 * 256)): mdoba = 1
  634. IF mdzs AND mdzsa = 0 THEN q = midiOutShortMsg(hmidiout, &H7F0099 OR (38 * 256)): mdzsa = 1
  635. IF mccc AND mccca = 0 THEN q = midiOutShortMsg(hmidiout, &H7F0099 OR (44 * 256)): mccca = 1
  637.  
  638.  
  639.  
  640. randpoli:
  641.  
  642. GOSUB randpolivtrack: GOSUB randpolixhangszer: GOSUB randpolixoktav: RETURN
  643.  
  644. randpolixhangszer: FOR t = 0 TO 99: poli(t, 1) = INT(128 * RND(1)): NEXT t: RETURN
  645. randpolixoktav: FOR t = 0 TO 99: poli(t, 8) = INT(4 * RND(1)) - 2: NEXT t: RETURN
  646. randpolivtrack: FOR t = 0 TO 99:
  647.     poli(t, 3) = INT(x(24) * RND(1))
  648.     poli(t, 4) = INT(x(24) * RND(1))
  649.     poli(t, 5) = INT(x(24) * RND(1))
  650.     poli(t, 6) = INT(x(24) * RND(1))
  651.     poli(t, 7) = INT(x(24) * RND(1))
  653.  
  654. commn:
  655. q = INT(x(24) * RND(1))
  656. q2 = INT(x(24) * RND(1))
  657.  
  658. FOR t = 0 TO 99
  659.     q3 = INT(x(24) * RND(1) * .7)
  660.     poli(t, 3) = q3
  661.     poli(t, 4) = q3 + 1
  662.     poli(t, 5) = q
  663.     poli(t, 6) = q2
  664.     poli(t, 7) = q3 + 2
  666.  
  667.  
  669.  
  670. randutos: FOR t = 0 TO 99: utos(t, 1) = INT(46 * RND(1)): NEXT t: RETURN
  671.  
  672. hangokdec:
  673. hn$(0) = "akt "
  674. hn$(1) = "hang "
  676.  
  677. polidec:
  678. pn$(0) = "akt "
  679. pn$(1) = "hangszerneve      "
  680. pn$(2) = "vol "
  681. pn$(3) = "sav0 "
  682. pn$(4) = "sav1 "
  683. pn$(5) = "sav2 "
  684. pn$(6) = "sav3 "
  685. pn$(7) = "sav4 "
  686. pn$(8) = "okt "
  687. FOR t = 0 TO 99: poli(t, 0) = 1: poli(t, 2) = 127: NEXT t
  689.  
  690.  
  691.  
  692. utosdec:
  693. un$(0) = "akt "
  694. un$(1) = "hangszerneve      "
  695. un$(2) = "vol "
  696. un$(3) = "sav "
  697.  
  698. FOR t = 0 TO 99: utos(t, 0) = 1: utos(t, 2) = 127: utos(t, 3) = t: NEXT t
  700.  
  701. utoshangszerrand:
  702. FOR t = 0 TO 99: utos(t, 3) = INT(x(24) * RND(1)): NEXT t
  704.  
  705. keszletdec:
  706. kn$(0) = "num "
  707. kn$(1) = "akt "
  708.  
  709. kn$(2) = "hang "
  710. kn$(3) = "okt "
  711.  
  713.  
  714. savdec:
  715. sn$(0) = "sav "
  716. sn$(1) = "elt "
  717. sn$(2) = "neg "
  718. sn$(3) = "muveleti eredmeny                  "
  719. sn$(4) = "jel "
  720. FOR t = 0 TO 99: sav(t, 0) = 0: NEXT t: RETURN
  721.  
  722. polimutat:
  723. ykpoli = 32
  724. LOCATE ykpoli - 1, xkpoli: COLOR _RGB32(255, 255, 255): PRINT "POLIFONIKUS HANGSZEREK"
  725. phol = 0: FOR t2 = 0 TO 9
  726.     IF LEN(pn$(t2)) THEN
  727.         COLOR _RGB32(177, 238, 127): LOCATE ykpoli, 1 + phol + xkpoli: PRINT pn$(t2)
  728.         FOR t = 0 TO x(30) - 1: ir$ = "--"
  729.  
  730.             SELECT CASE t2
  731.                 CASE 0: ir$ = bit$(poli(t, 0))
  732.                 CASE 1: ir$ = MID$(STR$(poli(t, 1)), 2) + "-" + midi$(poli(t, 1))
  733.                 CASE 2: ir$ = HEX$(poli(t, 2))
  734.                 CASE 3, 4, 5, 6, 7:
  735.                     IF (x(32) - (t2 - 3)) > 0 THEN ir$ = STR$(poli(t, t2))
  736.                 CASE 8: ir$ = STR$(poli(t, 8))
  737.             END SELECT
  738.  
  739.             xpoz = 1 + phol + xkpoli: ypoz = ykpoli + t + 1: xhossz = LEN(pn$(t2))
  740.             felt = (mauzy >= ypoz) AND (mauzy <= ypoz + yhossz)
  741.  
  742.             felt = (mauzx >= xpoz) AND (mauzx <= xpoz + xhossz) AND felt
  743.  
  744.             IF felt THEN COLOR aktiv1: aktiv$ = "poliparam": aktivp1 = t: aktivp2 = t2 ELSE COLOR aktiv2
  745.  
  746.             LOCATE ypoz, xpoz: ir$ = LEFT$(ir$, LEN(pn$(t2)))
  747.             IF polimutatakt(t) THEN COLOR aktiv1
  748.             PRINT ir$
  749.             IF felt THEN FOR t5 = 0 TO x(32) - 1: savmutatakt(poli(t, 3 + t5)) = 1: NEXT t5
  750.  
  751.  
  752.     NEXT t: END IF: phol = phol + LEN(pn$(t2))
  753. NEXT t2
  754. boxx1 = (xkpoli - 1) * 8
  755. boxy1 = (ykpoli - 2) * 16
  756. boxx2 = boxx1 + (phol + xhossz) * 8 - 6
  757. boxy2 = boxy1 + (x(30) + 2) * 16
  758.  
  759. COLOR keret: LINE (boxx1, boxy1)-(boxx2, boxy2), , B
  760.  
  761.  
  763. parammutat:
  764. xk = 114: yk = 3
  765. felt = mauzx >= (xk)
  766.  
  767. IF felt THEN aktiv$ = "parameterek": aktivp1 = INT(mauzy - 3)
  768.  
  769.  
  770. COLOR _RGB32(255, 255, 255)
  771. LOCATE 1, 114: PRINT "PARAMETEREK"
  772. FOR t = 0 TO 99
  773.     IF LEN(par$(t)) THEN
  774.         IF aktiv$ = "parameterek" AND aktivp1 = t THEN COLOR aktiv1 ELSE COLOR aktiv2
  775.         LOCATE yk + t, xk: PRINT par$(t)
  776.         LOCATE yk + t, xk + 15: PRINT x(par(t, 0))
  777.     END IF
  779. COLOR _RGB32(255, 255, 255)
  780. LOCATE 40, 114: PRINT "HELP - H-billenytu"
  781. LOCATE 42, 114: PRINT "ha elfogy a sav, nyomd meg a 0-at"
  782. LOCATE 43, 114: PRINT "hasznald az egeret, bal-jobb klikk"
  783. LOCATE 44, 114: PRINT "ertekek nov/csokk,es a gorgot"
  784.  
  785. LOCATE 55, 114: PRINT "Toth Gyula (30)4543730"
  786. LOCATE 56, 114: PRINT "facebook.com/gyula.toth.165"
  788.  
  789. utosmutat:
  790. LOCATE ykutos - 1, xkutos: COLOR _RGB32(255, 255, 255): PRINT "UTOS HANGSZEREK"
  791.  
  792. phol = 0: FOR t2 = 0 TO 9
  793.     IF LEN(un$(t2)) THEN
  794.         COLOR _RGB32(177, 238, 127): LOCATE ykutos, 1 + phol + xkutos: PRINT un$(t2)
  795.         FOR t = 0 TO x(31) - 1: ir$ = "--"
  796.  
  797.             SELECT CASE t2
  798.                 CASE 0: ir$ = bit$(utos(t, 0))
  799.                 CASE 1: ir$ = MID$(STR$(utos(t, 1)), 2) + "-" + midi$(utos(t, 1) + 128)
  800.                 CASE 2: ir$ = HEX$(utos(t, 2))
  801.                 CASE 3: ir$ = STR$(utos(t, 3))
  802.             END SELECT
  803.  
  804.             xpoz = 1 + phol + xkutos: ypoz = ykutos + t + 1: xhossz = LEN(un$(t2))
  805.  
  806.             felt = (mauzx >= xpoz) AND (mauzx <= xpoz + xhossz)
  807.             felt = (mauzy >= ypoz) AND (mauzy <= ypoz + yhossz) AND felt
  808.  
  809.  
  810.             IF felt THEN COLOR aktiv1: aktiv$ = "utosparam": aktivp1 = t: aktivp2 = t2 ELSE COLOR aktiv2
  811.             LOCATE ypoz, xpoz: ir$ = LEFT$(ir$, LEN(un$(t2)))
  812.             IF utosmutatakt(t) THEN COLOR aktiv1
  813.             PRINT ir$
  814.             IF felt THEN savmutatakt(utos(t, 3)) = 1
  815.     NEXT t: END IF: phol = phol + LEN(un$(t2))
  816. NEXT t2
  817.  
  818. boxx1 = (xkutos - 1) * 8
  819. boxy1 = (ykutos - 2) * 16
  820. boxx2 = boxx1 + (phol + xhossz) * 8 - 6
  821. boxy2 = boxy1 + (x(31) + 2) * 16
  822. COLOR keret: LINE (boxx1, boxy1)-(boxx2, boxy2), , B
  823.  
  824.  
  826.  
  827. savmutat:
  828. LOCATE yksav - 1, xksav: COLOR _RGB32(255, 255, 255): PRINT "GENERALT SAVOK ERTEKI"; x(1); ","; x(2); ","; x(22)
  829. phol = 0: FOR t2 = 0 TO 9
  830.     IF LEN(sn$(t2)) THEN
  831.         COLOR _RGB32(177, 238, 127): LOCATE yksav, 1 + phol + xksav: PRINT sn$(t2)
  832.         FOR t = 0 TO x(24) - 1: ir$ = "--"
  833.             aktualsav = aktivsav(t)
  834.             SELECT CASE t2
  835.                 CASE 0: ir$ = STR$(t)
  836.                 CASE 1: ir$ = STR$((sav(aktualsav, 1)))
  837.                 CASE 2: ir$ = (bit$(sav(aktualsav, 2)))
  838.                 CASE 3: ir$ = MID$(savok$(aktualsav), x(22) + sav(aktualsav, 1))
  839.                 CASE 4: ir$ = STR$(anali(aktualsav))
  840.             END SELECT
  841.  
  842.             xpoz = 1 + phol + xksav: ypoz = yksav + t + 1: xhossz = LEN(sn$(t2))
  843.  
  844.             felt = (mauzx >= xpoz) AND (mauzx <= xpoz + xhossz)
  845.             felt = (mauzy >= ypoz) AND (mauzy <= ypoz + yhossz) AND felt
  846.             IF felt AND ((t2 = 1 OR t2 = 2) OR t2 = 3) THEN COLOR aktiv1: aktiv$ = "savparam": aktivp1 = aktualsav: aktivp2 = t2 ELSE COLOR aktiv2
  847.             LOCATE ypoz, xpoz: ir$ = LEFT$(ir$, LEN(sn$(t2)))
  848.             IF savmutatakt(t) THEN COLOR aktiv1
  849.             PRINT ir$
  850.  
  851.             IF felt AND (t2 = 3) THEN
  852.                 FOR t5 = 0 TO 99
  853.                     IF utos(t5, 3) = t THEN utosmutatakt(t5) = 1
  854.                     FOR t6 = 0 TO x(32) - 1
  855.                         IF poli(t5, 3 + t6) = t THEN polimutatakt(t5) = 1
  856.                 NEXT t6, t5
  857.             END IF
  858.  
  859.         NEXT t
  860.     END IF
  861.  
  862.     phol = phol + LEN(sn$(t2))
  863. NEXT t2
  864.  
  865. boxx1 = (xksav - 1) * 8
  866. boxy1 = (yksav - 2) * 16
  867. boxx2 = boxx1 + (phol + xhossz) * 8 - 6
  868. boxy2 = boxy1 + (x(24) + 2) * 16
  869. COLOR keret: LINE (boxx1, boxy1)-(boxx2, boxy2), , B
  870.  
  872.  
  873.  
  874. keszletmutat:
  875. ykkeszlet = 32
  876. LOCATE ykkeszlet - 1, xkkeszlet: COLOR _RGB32(255, 255, 255): PRINT "AKTIVHANG"; x(33)
  877. phol = 0: FOR t2 = 0 TO 5
  878.     IF LEN(kn$(t2)) THEN
  879.         COLOR _RGB32(177, 238, 127): LOCATE ykkeszlet, 1 + phol + xkkeszlet: PRINT kn$(t2)
  880.         FOR t = 0 TO 2 ^ x(33) - 1: ir$ = "--"
  881.             SELECT CASE t2
  882.                 CASE 0: ir$ = STR$(t)
  883.                 CASE 1: ir$ = bit$(keszlet(t, 1))
  884.                 CASE 2: ir$ = STR$(keszlet(t, 2))
  885.                 CASE 3: ir$ = STR$(keszlet(t, 3))
  886.             END SELECT
  887.  
  888.             xpoz = 1 + phol + xkkeszlet: ypoz = ykkeszlet + t + 1: xhossz = LEN(kn$(t2))
  889.  
  890.             felt = (mauzx >= xpoz) AND (mauzx <= xpoz + xhossz)
  891.             felt = (mauzy >= ypoz) AND (mauzy <= ypoz + yhossz) AND felt
  892.             IF felt AND ((t2 = 1 OR t2 = 2) OR t2 = 3) THEN COLOR aktiv1: aktiv$ = "keszlet": aktivp1 = t: aktivp2 = t2 ELSE COLOR aktiv2
  893.             LOCATE ypoz, xpoz: ir$ = LEFT$(ir$, LEN(kn$(t2)))
  894.             PRINT ir$
  895.  
  896.  
  897.         NEXT t
  898.     END IF
  899.  
  900.     phol = phol + LEN(kn$(t2))
  901. NEXT t2
  902.  
  903. boxx1 = (xkkeszlet - 1) * 8
  904. boxy1 = (ykkeszlet - 2) * 16
  905. boxx2 = boxx1 + (phol + xhossz) * 8 - 6
  906. boxy2 = boxy1 + (x(32) + 2) * 16
  907. boxy2 = boxy1 + ((2 ^ x(32) + 2) * 16)
  908. COLOR keret: LINE (boxx1, boxy1)-(boxx2, boxy2), , B
  909.  
  910. FOR t = 0 TO 2 ^ x(33) - 1
  911.     IF keszlet(t, 1) THEN
  912.         boxx1 = (xkkeszlet + 16) * 8
  913.         boxy1 = (ykkeszlet + 3 - 2.5 + t) * 16
  914.         melyik = keszlet(t, 2)
  915.         boxx2 = xkhangk * 8
  916.         boxy2 = (ykhangk + 3 - 2.5 + melyik) * 16
  917.         REM        boxy2 = boxy1 + ((2 ^ x(32) + 2) * 16)
  918.         COLOR _RGB32(255, 255, 255): LINE (boxx1, boxy1)-(boxx2, boxy2)
  919.     END IF
  922.  
  923.  
  924.  
  925.  
  926. hangdec: ah = 0: okt = 0
  927. hk$ = "c-c#d-d#e-f-f#g-g#a-a#h-"
  928. FOR t = 0 TO 255
  929.     hangref$(t) = MID$(hk$, ah * 2 + 1, 2) + MID$(STR$(okt), 2)
  930.     ah = ah + 1: IF ah = 12 THEN ah = 0: okt = okt + 1
  932.  
  933. FOR t = 0 TO 11: hangnev$(t) = MID$(hk$, t * 2 + 1, 2): NEXT t
  935.  
  936.  
  937.  
  938.  
  939. hangokmutat:
  940. ykhangk = 32
  941. LOCATE ykhangk - 1, xkhangk: COLOR _RGB32(255, 255, 255): PRINT "HANGOK"
  942. phol = 0: FOR t2 = 0 TO 2
  943.     IF LEN(hn$(t2)) THEN
  944.         COLOR _RGB32(177, 238, 127): LOCATE ykhangk, 1 + phol + xkhangk: PRINT hn$(t2)
  945.         FOR t = 0 TO 11: ir$ = "--"
  946.             SELECT CASE t2
  947.                 CASE 0: ir$ = bit$(aktivkeszlet(t))
  948.                 CASE 1: ir$ = hangnev$(t)
  949.  
  950.             END SELECT
  951.  
  952.             xpoz = 1 + phol + xkhangk: ypoz = ykhangk + t + 1: xhossz = LEN(hn$(t2))
  953.  
  954.             felt = (mauzx >= xpoz) AND (mauzx <= xpoz + xhossz)
  955.             felt = (mauzy >= ypoz) AND (mauzy <= ypoz + yhossz) AND felt
  956.             IF felt AND ((t2 = 1 OR t2 = 2) OR t2 = 3) THEN COLOR aktiv1: aktiv$ = "aktivhangok": aktivp1 = t: aktivp2 = t2 ELSE COLOR aktiv2
  957.             LOCATE ypoz, xpoz: ir$ = LEFT$(ir$, LEN(hn$(t2)))
  958.             PRINT ir$
  959.  
  960.  
  961.         NEXT t
  962.  
  963.     END IF
  964.     phol = phol + LEN(hn$(t2))
  965. NEXT t2
  966.  
  967. boxx1 = (xkhangk - 1) * 8
  968. boxy1 = (ykhangk - 2) * 16
  969. boxx2 = boxx1 + (phol + xhossz) * 8 - 6
  970. boxy2 = boxy1 + 14 * 16
  971. COLOR keret: LINE (boxx1, boxy1)-(boxx2, boxy2), , B
  972.  
  974. randhangsor5:
  975. aktivkeszlet(0) = 1
  976. aktivkeszlet(1) = 0
  977. aktivkeszlet(2) = 1
  978. aktivkeszlet(3) = 0
  979. aktivkeszlet(4) = 1
  980. aktivkeszlet(5) = 0
  981. aktivkeszlet(6) = 0
  982. aktivkeszlet(7) = 1
  983. aktivkeszlet(8) = 0
  984. aktivkeszlet(9) = 1
  985. aktivkeszlet(10) = 0
  986. aktivkeszlet(11) = 0
  988. randhangsor7:
  989. aktivkeszlet(0) = 1
  990. aktivkeszlet(1) = 0
  991. aktivkeszlet(2) = 1
  992. aktivkeszlet(3) = 0
  993. aktivkeszlet(4) = 1
  994. aktivkeszlet(5) = 1
  995. aktivkeszlet(6) = 0
  996. aktivkeszlet(7) = 1
  997. aktivkeszlet(8) = 0
  998. aktivkeszlet(9) = 1
  999. aktivkeszlet(10) = 0
  1000. aktivkeszlet(11) = 1
  1002.  
  1003.  
  1004. randoktkeszlet:
  1005. FOR t = 0 TO 2 ^ x(33) - 1
  1006.     keszlet(t, 3) = INT(2 * RND(1)) - 1
  1007.  
  1010.  
  1011.  
  1012. randaktivhangdec:
  1013. FOR t = 0 TO 2 ^ x(33) - 1
  1014.     keszlet(t, 1) = INT(2 * RND(1))
  1015.  
  1018. keszletminta4bit:
  1019. minta = INT(8 * RND(1)): hh = 0
  1020.  
  1021. FOR t = 0 TO 2 ^ x(33) - 1
  1022.     keszlet(t, 1) = SGN(minta AND 2 ^ hh)
  1023.     hh = hh + 1: hh = hh AND 3
  1024.  
  1027.  
  1028.  
  1029. randrendeles:
  1030. FOR t = 0 TO 2 ^ x(33) - 1
  1031.  
  1032.     112: melyik = INT(12 * RND(1))
  1033.     IF aktivkeszlet(melyik) = 0 THEN GOTO 112
  1034.     keszlet(t, 2) = melyik
  1037.  
  1038. sorrendrendeles: melyik = 0
  1039. FOR t = 0 TO 2 ^ x(33) - 1
  1040.     IF keszlet(t, 1) THEN
  1041.        114: melyik = melyik + 1: IF melyik = 12 THEN melyik = 0
  1042.         IF aktivkeszlet(melyik) = 0 THEN GOTO 114
  1043.         keszlet(t, 2) = melyik
  1044.     END IF
  1047.  
  1048. randaktivkeszlet: FOR t = 0 TO 11:
  1049.     aktivkeszlet(t) = INT(2 * RND(1))
  1051.  
  1052.  
  1053. midihangszer: FOR t = 0 TO x(30) - 1: mh = t: IF t > 8 THEN mh = mh + 1
  1054.     kom = 12 + mh + poli(t, 1) * 256: q = midiOutShortMsg(hmidiout, kuld)
  1056.  
  1057. midipolion:
  1058.  
  1059. FOR t = 0 TO 22: mh = t: IF t > 8 THEN mh = mh + 1
  1060.  
  1061.  
  1062.     REM     eltolas = sav(aktualsav, 1)
  1063.  
  1064.  
  1065.     hangero = poli(t, 2)
  1066.     h1 = SGN(MID$(savok$(aktivsav(poli(t, 3))), x(22) + 1 + eltolas, 1) = bit$(1))
  1067.     h2 = SGN(MID$(savok$(aktivsav(poli(t, 4))), x(22) + 1 + eltolas, 1) = bit$(1))
  1068.     h3 = SGN(MID$(savok$(aktivsav(poli(t, 5))), x(22) + 1 + eltolas, 1) = bit$(1))
  1069.     h4 = SGN(MID$(savok$(aktivsav(poli(t, 6))), x(22) + 1 + eltolas, 1) = bit$(1))
  1070.     h5 = SGN(MID$(savok$(aktivsav(poli(t, 7))), x(22) + 1 + eltolas, 1) = bit$(1))
  1071.  
  1072.  
  1073.  
  1074.     aktive1 = poli(t, 0)
  1075.     okt1 = poli(t, 8)
  1076.  
  1077.     egyuttallas = (h1 + h2 * 2 + h3 * 4 + h4 * 8 + h5 * 16)
  1078.     egyuttallas = egyuttallas AND (2 ^ x(32) - 1)
  1079.  
  1080.     melyikhang = keszlet(egyuttallas, 2)
  1081.     aktive2 = keszlet(egyuttallas, 1)
  1082.  
  1083.     okt2 = keszlet(egyuttallas, 3)
  1084.     aktive3 = aktivkeszlet(melyikhang)
  1085.     ahangszer = poli(t, 1)
  1086.  
  1087.  
  1088.  
  1089.  
  1090.     REM hangszer kuldes
  1091.  
  1092.     REM uj hang kuldes, es eltarolni
  1093.     hang = (35 + melyikhang + (okt1 + okt2 + 2) * 12)
  1094.     csatorna = mh
  1095.     hangero = 127 * SGN(aktive1 AND (aktive2 AND aktive3))
  1096.     hangszer = ahangszer
  1097.  
  1098.     REM kussoltatas ha :hang vagy hangszer valtozik vagy direktvalzotatas van
  1099.     feltetel1 = utolsohangszer(csatorna) <> ahangszer
  1100.     feltetel2 = utolsohang(csatorna) <> hang
  1101.     feltetel3 = x(39) OR (t > x(30) - 1)
  1102.     IF (feltetel1 OR feltetel2) OR feltetel3 THEN
  1103.         REM kussoltatas
  1104.         kuld = csatorna + 9 * 16 + utolsohang(csatorna) * 256 + 0 * 65536: q = midiOutShortMsg(hmidiout, kuld)
  1105.     END IF
  1106.  
  1107.     IF feltetel1 THEN
  1108.         REM hangszer beallitasa
  1109.         kuld = csatorna + 12 * 16 + ahangszer * 256 + 127 * 65536: q = midiOutShortMsg(hmidiout, kuld)
  1110.     END IF
  1111.  
  1112.     IF (feltetel2 OR feltetel3) AND (t < x(30)) THEN
  1113.         REM csatornara hang kiadasa es rogzitese
  1114.         kuld = csatorna + 9 * 16 + hang * 256 + hangero * 65536: q = midiOutShortMsg(hmidiout, kuld)
  1115.     END IF
  1116.     utolsohang(csatorna) = hang
  1117.     utolsohangszer(csatorna) = ahangszer
  1118.  
  1119.  
  1120.  
  1121.  
  1122.  
  1123.  
  1126.  
  1127. csend: RETURN
  1128. FOR t = 0 TO x(30) - 1: mh = t: IF t > 8 THEN mh = mh + 1
  1129.     kuld = csend(t)
  1130.     q = midiOutShortMsg(hmidiout, kuld)
  1133.  
  1134. feltcsend: RETURN
  1135. FOR t = 0 TO x(30) - 1: mh = t: IF t > 8 THEN mh = mh + 1
  1136.     IF marad(t) = 0 THEN
  1137.         kuld = csend(t)
  1138.         q = midiOutShortMsg(hmidiout, kuld)
  1139.     END IF
  1142.  
  1143. decparam:
  1144. q = 0: par(q, 0) = 34: par(q, 1) = -21: par(q, 2) = 21: par$(q) = "leptek-szorzo"
  1145. q = 1: par(q, 0) = 30: par(q, 1) = 0: par(q, 2) = 20: par$(q) = "polihangszer"
  1146. q = 2: par(q, 0) = 31: par(q, 1) = 0: par(q, 2) = 20: par$(q) = "utoshangszer"
  1147. q = 3: par(q, 0) = 24: par(q, 1) = 2: par(q, 2) = 25: par$(q) = "savok szama"
  1148. q = 4: par(q, 0) = 35: par(q, 1) = 10: par(q, 2) = 100: par$(q) = "tempo"
  1149. q = 5: par(q, 0) = 23: par(q, 1) = 0: par(q, 2) = 3: par$(q) = "metronom"
  1150. q = 6: par(q, 0) = 32: par(q, 1) = 0: par(q, 2) = 5: par$(q) = "hangkeszlet"
  1151.  
  1152. q = 7: par(q, 0) = 36: par(q, 1) = 1: par(q, 2) = 500: par$(q) = "sorozat TAG1"
  1153. q = 8: par(q, 0) = 37: par(q, 1) = 1: par(q, 2) = 500: par$(q) = "sorozat TAG2"
  1154. q = 9: par(q, 0) = 38: par(q, 1) = 1: par(q, 2) = 10000: par$(q) = "sorozat szorzo"
  1155. q = 10: par(q, 0) = 39: par(q, 1) = 0: par(q, 2) = 1: par$(q) = "poli-hangszer lecsengese"
  1156.  
  1158.  
  1159. zenementese2:
  1160. Filter$ = "Zenei-Algoritmus files (*.alg)|*.ALG|All files (*.*)|*.*"
  1161. Flags& = OFN_OVERWRITEPROMPT + OFN_NOCHANGEDIR '   add flag constants here
  1162. SFile$ = GetSaveFileName$("Zenei Algoritmus mentese                                                                     ", ".\", Filter$, 1, Flags&, hWnd&)
  1163.  
  1164. fajlnev$ = "last.alg": GOSUB zenementese
  1165. IF SFile$ <> "" THEN fajlnev$ = SFile$: GOSUB zenementese
  1167.  
  1168.  
  1169. zenementese:
  1170.  
  1171. OPEN fajlnev$ FOR OUTPUT AS 1
  1172. PRINT #1, sv$
  1173. PRINT #1, aleptek
  1174. FOR t1 = 0 TO 99: FOR t2 = 0 TO 19: PRINT #1, utos(t1, t2): NEXT t2, t1
  1175. FOR t1 = 0 TO 99: FOR t2 = 0 TO 19: PRINT #1, poli(t1, t2): NEXT t2, t1
  1176. FOR t1 = 0 TO 99: FOR t2 = 0 TO 19: PRINT #1, sav(t1, t2): NEXT t2, t1
  1177. FOR t1 = 0 TO 99: PRINT #1, savok$(t1): NEXT t1
  1178. FOR t1 = 0 TO 9999: PRINT #1, x(t1): NEXT t1
  1179. FOR t1 = 0 TO 99: PRINT #1, aktivsav(t1): NEXT t1
  1180. FOR t1 = 0 TO 99: PRINT #1, savmutatakt(t1): NEXT t1
  1181. FOR t1 = 0 TO 99: PRINT #1, polimutatakt(t1): NEXT t1
  1182. FOR t1 = 0 TO 99: PRINT #1, utosmutatakt(t1): NEXT t1
  1183. FOR t1 = 0 TO 99: FOR t2 = 0 TO 3: PRINT #1, keszlet(t1, t2): NEXT t2, t1
  1184. FOR t1 = 0 TO 11: PRINT #1, aktivkeszlet(t1): NEXT t1
  1187.  
  1188. zenebetoltese:
  1189. IF fajlnev$ <> "last.alg" THEN
  1190.     Filter$ = "Zenei-Algoritmus files (*.alg)|*.ALG|All files (*.*)|*.*"
  1191.     Flags& = OFN_FILEMUSTEXIST + OFN_NOCHANGEDIR + OFN_READONLY '    add flag constants here
  1192.     OFile$ = GetOpenFileName$("Zenei Algoritmus betoltese                                                                                            ", ".\", Filter$, 1, Flags&, hWnd&)
  1193.  
  1194.     fajlnev$ = OFile$
  1196.  
  1197. IF _FILEEXISTS(fajlnev$) = 0 THEN RETURN
  1198.  
  1199. OPEN fajlnev$ FOR INPUT AS 1
  1200. LINE INPUT #1, ver$: IF ver$ <> sv$ THEN GOTO 888
  1201. INPUT #1, aleptek
  1202. FOR t1 = 0 TO 99: FOR t2 = 0 TO 19: INPUT #1, utos(t1, t2): NEXT t2, t1
  1203. FOR t1 = 0 TO 99: FOR t2 = 0 TO 19: INPUT #1, poli(t1, t2): NEXT t2, t1
  1204. FOR t1 = 0 TO 99: FOR t2 = 0 TO 19: INPUT #1, sav(t1, t2): NEXT t2, t1
  1205. FOR t1 = 0 TO 99: INPUT #1, savok$(t1): NEXT t1
  1206. FOR t1 = 0 TO 9999: INPUT #1, x(t1): NEXT t1
  1207. FOR t1 = 0 TO 99: INPUT #1, aktivsav(t1): NEXT t1
  1208. FOR t1 = 0 TO 99: INPUT #1, savmutatakt(t1): NEXT t1
  1209. FOR t1 = 0 TO 99: INPUT #1, polimutatakt(t1): NEXT t1
  1210. FOR t1 = 0 TO 99: INPUT #1, utosmutatakt(t1): NEXT t1
  1211. FOR t1 = 0 TO 99: FOR t2 = 0 TO 3: INPUT #1, keszlet(t1, t2): NEXT t2, t1
  1212. FOR t1 = 0 TO 11: INPUT #1, aktivkeszlet(t1): NEXT t1
  1213. 888: CLOSE 1: RETURN
  1214.  
  1215.  
  1216.  
  1217.  
  1218.  
  1219.  
  1220.  
  1221. szisz:
  1223.  
  1224.  
  1225.  
  1226.  
  1227. FUNCTION GetOpenFileName$ (Title$, InitialDir$, Filter$, FilterIndex, Flags&, hWnd&)
  1228.     '  Title$      - The dialog title.
  1229.     '  InitialDir$ - If this left blank, it will use the directory where the last opened file is
  1230.     '  located. Specify ".\" if you want to always use the current directory.
  1231.     '  Filter$     - File filters separated by pipes (|) in the same format as using VB6 common dialogs.
  1232.     '  FilterIndex - The initial file filter to use. Will be altered by user during the call.
  1233.     '  Flags&      - Dialog flags. Will be altered by the user during the call.
  1234.     '  hWnd&       - Your program's window handle that should be aquired by the FindWindow function.
  1235.     '
  1236.     ' Returns: Blank when cancel is clicked otherwise, the file name selected by the user.
  1237.     ' FilterIndex and Flags& will be changed depending on the user's selections.
  1238.  
  1239.     DIM OpenCall AS FILEDIALOGTYPE ' Needed for dialog call
  1240.  
  1241.     fFilter$ = Filter$
  1242.     FOR R = 1 TO LEN(fFilter$) ' Replace the pipes with character zero
  1243.         IF MID$(fFilter$, R, 1) = "|" THEN MID$(fFilter$, R, 1) = CHR$(0)
  1244.     NEXT R
  1245.     fFilter$ = fFilter$ + CHR$(0)
  1246.  
  1247.     lpstrFile$ = STRING$(2048, 0) ' For the returned file name
  1248.     lpstrDefExt$ = STRING$(10, 0) ' Extension will not be added when this is not specified
  1249.     OpenCall.lStructSize = LEN(OpenCall)
  1250.     OpenCall.hwndOwner = hWnd&
  1251.     OpenCall.lpstrFilter = _OFFSET(fFilter$)
  1252.     OpenCall.nFilterIndex = FilterIndex
  1253.     OpenCall.lpstrFile = _OFFSET(lpstrFile$)
  1254.     OpenCall.nMaxFile = LEN(lpstrFile$) - 1
  1255.     OpenCall.lpstrFileTitle = OpenCall.lpstrFile
  1256.     OpenCall.nMaxFileTitle = OpenCall.nMaxFile
  1257.     OpenCall.lpstrInitialDir = _OFFSET(InitialDir$)
  1258.     OpenCall.lpstrTitle = _OFFSET(Title$)
  1259.     OpenCall.lpstrDefExt = _OFFSET(lpstrDefExt$)
  1260.     OpenCall.flags = Flags&
  1261.  
  1262.     Result = GetOpenFileNameA&(OpenCall) '            Do Open File dialog call!
  1263.  
  1264.     IF Result THEN ' Trim the remaining zeros
  1265.         GetOpenFileName$ = LEFT$(lpstrFile$, INSTR(lpstrFile$, CHR$(0)) - 1)
  1266.         Flags& = OpenCall.flags
  1267.         FilterIndex = OpenCall.nFilterIndex
  1268.     END IF
  1269.  
  1271.  
  1272. FUNCTION GetSaveFileName$ (Title$, InitialDir$, Filter$, FilterIndex, Flags&, hWnd&)
  1273.     '  Title$      - The dialog title.
  1274.     '  InitialDir$ - If this left blank, it will use the directory where the last opened file is
  1275.     '     located. Specify ".\" if you want to always use the current directory.
  1276.     '  Filter$     - File filters separated by pipes (|) in the same format as VB6 common dialogs.
  1277.     '  FilterIndex - The initial file filter to use. Will be altered by user during the call.
  1278.     '  Flags&      - Dialog flags. Will be altered by the user during the call.
  1279.     '  hWnd&       - Your program's window handle that should be aquired by the FindWindow function.
  1280.  
  1281.     ' Returns: Blank when cancel is clicked otherwise, the file name entered by the user.
  1282.     ' FilterIndex and Flags& will be changed depending on the user's selections.
  1283.  
  1284.     DIM SaveCall AS FILEDIALOGTYPE ' Needed for dialog call
  1285.  
  1286.     fFilter$ = Filter$
  1287.     FOR R = 1 TO LEN(fFilter$) ' Replace the pipes with zeros
  1288.         IF MID$(fFilter$, R, 1) = "|" THEN MID$(fFilter$, R, 1) = CHR$(0)
  1289.     NEXT R
  1290.     fFilter$ = fFilter$ + CHR$(0)
  1291.  
  1292.     lpstrFile$ = STRING$(2048, 0) ' For the returned file name
  1293.     lpstrDefExt$ = STRING$(10, 0) ' Extension will not be added when this is not specified
  1294.     SaveCall.lStructSize = LEN(SaveCall)
  1295.     SaveCall.hwndOwner = hWnd&
  1296.     SaveCall.lpstrFilter = _OFFSET(fFilter$)
  1297.     SaveCall.nFilterIndex = FilterIndex
  1298.     SaveCall.lpstrFile = _OFFSET(lpstrFile$)
  1299.     SaveCall.nMaxFile = LEN(lpstrFile$) - 1
  1300.     SaveCall.lpstrFileTitle = SaveCall.lpstrFile
  1301.     SaveCall.nMaxFileTitle = SaveCall.nMaxFile
  1302.     SaveCall.lpstrInitialDir = _OFFSET(InitialDir$)
  1303.     SaveCall.lpstrTitle = _OFFSET(Title$)
  1304.     SaveCall.lpstrDefExt = _OFFSET(lpstrDefExt$)
  1305.     SaveCall.flags = Flags&
  1306.  
  1307.     Result& = GetSaveFileNameA&(SaveCall) ' Do dialog call!
  1308.  
  1309.     IF Result& THEN ' Trim the remaining zeros
  1310.         GetSaveFileName$ = LEFT$(lpstrFile$, INSTR(lpstrFile$, CHR$(0)) - 1)
  1311.         Flags& = SaveCall.flags
  1312.         FilterIndex = SaveCall.nFilterIndex
  1313.     END IF
  1315.  
  1316.  
  1317.  
  1318.  
  1319.  
  1320.  
  1321.  
  1322.  
  1323.  
  1324.  

323
QB64 Discussion / Re: 3d fps game (Fulopke es az ellenallok)
« on: December 01, 2019, 03:53:51 pm »
thank you petr! no, it has nothing to do with any format. midi is just a tool for directly speaking the results of operations. uses windows midi and recorded it in wav. the program needs nothing but midi. and I can write it with a .lib from qb64.

324
QB64 Discussion / Re: 3d fps game (Fulopke es az ellenallok)
« on: December 01, 2019, 01:06:00 pm »
thank you! honored as you write about the game.
I made the course by taking a picture. I cut it into squares. the content of this image is the texture of the terrain, and the depth at a given point is determined by the grayscale of the image. black low, white high .
then the walls. palya.bmp contains info. red: out of sight. Blue Inner Walls White: Wall Green: Free space, here can be created umbrellas, random enemies.
based on palya.bmp, with another program, I create columns at a uniform distance that I delete in a file. this is the wall. this is fal.dat
then externally, for easier calibration, the height of the walls is determined by falmagassag.dat.
the first two values ​​are the height of the outer walls low / high, and the third value is the fixed height of the inner walls. (fixed because it is easier to calculate than projectile projectiles)

other...
I don't know if I'm interested ... I figured out a way to create music by algorithm. translate it if you find it interesting.

It was written in qb64

http://tukorgravirozas.fw.hu/mastergy/5hang/index.html
http://tukorgravirozas.fw.hu/mastergy/algzene/index.html

325
QB64 Discussion / Re: 3d fps game (Fulopke es az ellenallok)
« on: November 30, 2019, 08:02:36 am »

727/5000
big file, yes. there are some files that are unnecessary but left there. the rest is advertising, textura. it was a big puzzle to adjust the difficulty of the different levels. lots of numbers determine difficulty. was eventually solved by the linear registry principle. but i'm curious about the partial results. menuneed \ jic.dat contains the amount of time it took for someone to complete a course. this is useful info for me to learn and fine-tune the linear difficulty. the game had a very small bug in it, here is the patch and "codelevel". this code is encrypted for how long someone got and exactly how many minutes he played.

https://sharefiles.app/download/e2d986fc4ea863274c4de2aaa1534e39aacf3210

326
QB64 Discussion / Re: 3d fps game (Fulopke es az ellenallok)
« on: November 30, 2019, 07:22:39 am »
thanks for the comments, fine if you like it, a lot of work with it. at first I only needed a 3d rendering, then as I added it, it became more and more like a game.
then I put in a few things and then, obsessively, wanted to get something interesting out of it.
If you like, I'm happy.

327
QB64 Discussion / 3d fps game (Fulopke es az ellenallok)
« on: November 29, 2019, 06:33:02 pm »
hi.

I am Toth Gyula from Hungary.
I make a FPS-game in QB64.

Try it. (zip in .bas)
THX.

download:
https://sharefiles.app/download/8c13890f42db97b4f21ba6c4420e29df0e3ddecf

little video:

https://www.youtube.com/watch?v=JJAAKUdcMX0

Pages: 1 ... 20 21 [22]