Welcome, Guest |
You have to register before you can post on our site.
|
Latest Threads |
astuce pour survivre fina...
Forum: Utilities
Last Post: coletteleger
05-14-2025, 04:47 AM
» Replies: 0
» Views: 9
|
trouver permis de conduir...
Forum: Utilities
Last Post: nicolasrene
05-05-2025, 05:24 AM
» Replies: 0
» Views: 16
|
LIGHTBAR Menu
Forum: Programs
Last Post: nicolasrene
05-05-2025, 05:08 AM
» Replies: 15
» Views: 945
|
Learning Pallet Rack Safe...
Forum: Utilities
Last Post: Sandrapew
04-03-2025, 09:36 AM
» Replies: 0
» Views: 39
|
Choosing New Versus or Pr...
Forum: Utilities
Last Post: Sandrapew
03-18-2025, 01:11 AM
» Replies: 0
» Views: 33
|
The QB64 IDE shell
Forum: Utilities
Last Post: JasonPag
09-16-2024, 05:37 PM
» Replies: 9
» Views: 1,059
|
Importance regarding Ches...
Forum: Utilities
Last Post: JasonPag
09-01-2024, 06:34 PM
» Replies: 0
» Views: 71
|
Chess and Analysis and En...
Forum: Utilities
Last Post: JasonPag
08-28-2024, 02:37 PM
» Replies: 0
» Views: 68
|
DAY 009:_PutImage
Forum: Keyword of the Day!
Last Post: grymmjack
09-02-2023, 02:57 PM
» Replies: 54
» Views: 3,439
|
Fall Banner Contest?
Forum: Site Suggestions
Last Post: grymmjack
08-31-2023, 11:50 PM
» Replies: 36
» Views: 2,169
|
|
|
Updated old Googly Eyes screen saver |
Posted by: Dav - 07-08-2023, 09:19 PM - Forum: Programs
- Replies (10)
|
 |
Finally getting my feet wet coding again after a long break. Updated the old GooglyEyes screensaver. Some of you may remember that one. Clicking the eyes now make them go goofy and run off screen. Added a rotating background using rotozoom.
- Dav
Code: (Select All)
'===============
'GOOGLYEYES4.BAS
'===============
'Blinking Eyes drift around, looking in direction they go.
'Shows how to create images off screen to use with _PUTIMAGE.
'Demo also shows how to move the images in interesting ways.
'Has a scrolling background image.
'Coded by Dav, JULY/2023
'V4 - Clicking eyes make them go googly and run off screen.
' Added a sound effect when clicking on them.
' Added a rotating background image.
' Added press ESC to quit
'=== First, create 4 eye images to use....
'=== Create image of eyes looking left
eyeleft& = _NEWIMAGE(230, 200, 32)
_DEST eyeleft& 'point to above image so we can draw to it
ball 50, 50, 50, 255, 255, 255 'left eye
ball 30, 50, 20, 0, 0, 128 'left pupil
ball 150, 50, 50, 255, 255, 255 'right eye
ball 130, 50, 20, 0, 0, 128 'right pupil
CIRCLE (50, 50), 50, _RGB(0, 0, 0)
CIRCLE (150, 50), 50, _RGB(0, 0, 0)
CIRCLE (30, 50), 20, _RGB(0, 0, 0)
CIRCLE (130, 50), 20, _RGB(0, 0, 0)
'=== Create image of eyes looking right
eyeright& = _NEWIMAGE(230, 200, 32)
_DEST eyeright& 'point to above image so we can draw to it
ball 50, 50, 50, 255, 255, 255
ball 70, 50, 20, 0, 0, 128
ball 150, 50, 50, 255, 255, 255
ball 170, 50, 20, 0, 0, 128
CIRCLE (50, 50), 50, _RGB(0, 0, 0)
CIRCLE (150, 50), 50, _RGB(0, 0, 0)
CIRCLE (70, 50), 20, _RGB(0, 0, 0)
CIRCLE (170, 50), 20, _RGB(0, 0, 0)
'=== Create an image of eyes looking up
eyeup& = _NEWIMAGE(230, 200, 32)
_DEST eyeup& 'point to above image so we can draw to it
ball 50, 50, 50, 255, 255, 255
ball 50, 30, 20, 0, 0, 128
ball 150, 50, 50, 255, 255, 255
ball 150, 30, 20, 0, 0, 128
CIRCLE (50, 50), 50, _RGB(0, 0, 0)
CIRCLE (150, 50), 50, _RGB(0, 0, 0)
CIRCLE (50, 30), 20, _RGB(0, 0, 0)
CIRCLE (150, 30), 20, _RGB(0, 0, 0)
'=== Create an image of eyes looking down
eyedown& = _NEWIMAGE(230, 200, 32)
_DEST eyedown& 'point to above image so we can draw to it
ball 50, 50, 50, 255, 255, 255
ball 50, 70, 20, 0, 0, 128
ball 150, 50, 50, 255, 255, 255
ball 150, 70, 20, 0, 0, 128
CIRCLE (50, 50), 50, _RGB(0, 0, 0)
CIRCLE (150, 50), 50, _RGB(0, 0, 0)
CIRCLE (50, 70), 20, _RGB(0, 0, 0)
CIRCLE (150, 70), 20, _RGB(0, 0, 0)
'=== Create an image of eyes blinking
eyeblink& = _NEWIMAGE(200, 800, 32)
_DEST eyeblink& 'point to above image so we can draw to it
ball 50, 150, 50, 196, 196, 196
ball 150, 150, 50, 196, 196, 196
ball 50, 150, 20, 64, 64, 128
ball 150, 150, 29, 64, 64, 128
CIRCLE (50, 150), 50, _RGB(0, 0, 0)
CIRCLE (150, 150), 50, _RGB(0, 0, 0)
'=== Create a background image to use
back& = _NEWIMAGE(200, 150, 32)
_DEST back&
FOR x = -1 TO 200
FOR y = -1 TO 150
LINE (x, y)-(x + RND * 10, y + RND * 10), _RGBA(RND * 32, RND * 32, 25 + RND * 200, 25 + RND * 200), BF
NEXT
NEXT
'=== smooth out the background image...
_SOURCE back&
FOR u = 1 TO 3 'do it 3 times for extra smooth
FOR x = 1 TO 199
FOR y = 1 TO 149
p1~& = POINT(x, y)
p2~& = POINT(x + 1, y)
p3~& = POINT(x, y + 1)
p4~& = POINT(x + 1, y + 1)
p5~& = POINT(x - 1, y)
p6~& = POINT(x, y - 1)
p7~& = POINT(x - 1, y - 1)
p8~& = POINT(x - 1, y + 1)
p9~& = POINT(x + 1, y - 1)
IF x + 1 > 200 THEN p2~& = p1~&: p4~& = p1~&: p9~& = p1~&
IF x - 1 < 0 THEN p5~& = p1~&: p7~& = p1~&: p8~& = p1~&
IF y + 1 > 150 THEN p3~& = p1~&: p4~& = p1~&: p8~& = p1~&
IF y - 1 < 0 THEN p6~& = p1~&: p7~& = p1~&: p9~& = p1~&
r = _RED32(p1~&) + _RED32(p2~&) + _RED32(p3~&) + _RED32(p4~&) + _RED32(p5~&) + _RED32(p6~&) + _RED32(p7~&) + _RED32(p8~&) + _RED32(p9~&)
g = _GREEN32(p1~&) + _GREEN32(p2~&) + _GREEN32(p3~&) + _GREEN32(p4~&) + _GREEN32(p5~&) + _GREEN32(p6~&) + _GREEN32(p7~&) + _GREEN32(p8~&) + _GREEN32(p9~&)
b = _BLUE32(p1~&) + _BLUE32(p2~&) + _BLUE32(p3~&) + _BLUE32(p4~&) + _BLUE32(p5~&) + _BLUE32(p6~&) + _BLUE32(p7~&) + _BLUE32(p8~&) + _BLUE32(p9~&)
PSET (x, y), _RGB(r / 9, g / 9, b / 9)
NEXT
NEXT
NEXT
'=== Now we point to main screen
_SOURCE 0
_DEST 0 'set destination to draw to main screen
SCREEN _NEWIMAGE(1000, 800, 32) 'main screen size
RANDOMIZE TIMER 'do this so the RND call is different everytime
Eyes = 50 'the number of eyes on screen
EyeSizeMax = 250 'largest size eyes can be
DIM EyeX(Eyes), EyeY(Eyes) 'x/y position of the eye
DIM EyeSize(Eyes) ' size of eye
DIM EyeGrowth(Eyes) 'eye growing or shrinking on screen
DIM EyeDrift(Eyes) 'direction eye drifts across screen
DIM EyeDriftSpeed(Eyes) 'speed for the drift
DIM EyeBlinkFlag(Eyes) 'eyes blinking flag
DIM EyeBlinkCount(Eyes)
DIM EyeGoogly(Eyes)
'generate eye values
FOR d = 1 TO Eyes
EyeX(d) = RND * _WIDTH 'make random x position
EyeY(d) = RND * _HEIGHT 'make random y position
EyeSize(d) = (RND * EyeSizeMax) 'random eye size, up to EyeSizeMax
EyeGrowth(d) = INT(RND * 2) 'make way eye size is changing, 0=shrinking, 1=growing
EyeDrift(d) = INT(RND * 4) 'make random direction a eye can drift (4 different ways)
EyeDriftSpeed(d) = INT(RND * 3) + 2 'speed eyes will be drifting
EyeBlinkFlag(d) = 0 'if eye is blinking or not
EyeBlinkCount(d) = 0
EyeGoogly(d) = 0
NEXT
DO
WHILE _MOUSEINPUT: WEND
'Bubble sort through eyesize, putting smallest size first so..
'..they will be _PUTIMAGE'd first, putting them in the background.
FOR b = 1 TO Eyes
FOR b2 = 1 TO Eyes
IF EyeSize(b2) > EyeSize(b) THEN
SWAP EyeX(b), EyeX(b2)
SWAP EyeY(b), EyeY(b2)
SWAP EyeSize(b), EyeSize(b2)
SWAP EyeGrowth(b), EyeGrowth(b2)
SWAP EyeDrift(b), EyeDrift(b2)
SWAP EyeDriftSpeed(b), EyeDriftSpeed(b2)
SWAP EyeBlinkFlag(b), EyeBlinkFlag(b2)
SWAP EyeBlinkCount(b), EyeBlinkCount(b2)
END IF
NEXT
NEXT
'CLS 'I don't think CLS is needed now, the back& image clears screen
'=== rotozoom background image
RotoZoom3 _WIDTH / 2, _HEIGHT / 2, back&, 30, 8, a
a = a + .01: IF a >= 360 THEN a = a - 360
'=== step through each eye
FOR d = 1 TO Eyes
'if eye is shrinking, subtract eyesize, else add to it
IF EyeGrowth(d) = 0 THEN
EyeSize(d) = EyeSize(d) - 1
ELSE
EyeSize(d) = EyeSize(d) + 1
END IF
'if eyesize reaches max size, switch growth to 0 start shrinking instead
IF EyeSize(d) >= EyeSizeMax THEN EyeGrowth(d) = 0
'if if reaches smallest eyesize, switch growth to 1 to start growing now
IF EyeSize(d) <= 20 THEN EyeGrowth(d) = 1
'drift eye in 1 of 4 directions we generated, and do +x,-x,+y,-y to it.
IF EyeDrift(d) = 0 THEN EyeX(d) = EyeX(d) + EyeDriftSpeed(d) 'drift right
IF EyeDrift(d) = 1 THEN EyeX(d) = EyeX(d) - EyeDriftSpeed(d) 'drift left
IF EyeDrift(d) = 2 THEN EyeY(d) = EyeY(d) + EyeDriftSpeed(d) 'drift down
IF EyeDrift(d) = 3 THEN EyeY(d) = EyeY(d) - EyeDriftSpeed(d) 'drift up
'this creates the shakiness. randomly adjust x/y positions by +/-2 each step
IF INT(RND * 2) = 0 THEN EyeX(d) = EyeX(d) + 2 ELSE EyeX(d) = EyeX(d) - 2
IF INT(RND * 2) = 0 THEN EyeY(d) = EyeY(d) + 2 ELSE EyeY(d) = EyeY(d) - 2
'below handles if eye goes off screen, let it dissapear completely.
'If it had been clicked and Gone Googly, then reset speed afterwards
IF EyeX(d) > _WIDTH + EyeSize(d) THEN EyeX(d) = -EyeSize(d): EyeDriftSpeed(d) = INT(RND * 3) + 2
IF EyeX(d) < -EyeSize(d) THEN EyeX(d) = _WIDTH + EyeSize(d): EyeDriftSpeed(d) = INT(RND * 3) + 2
IF EyeY(d) > _HEIGHT + EyeSize(d) THEN EyeY(d) = -EyeSize(d): EyeDriftSpeed(d) = INT(RND * 3) + 2
IF EyeY(d) < -EyeSize(d) THEN EyeY(d) = _HEIGHT + EyeSize(d): EyeDriftSpeed(d) = INT(RND * 3) + 2
'drift eye in 1 of 4 directions we generated, and +x,-x,+y,-y to it.
'If blinking flag on...
IF EyeBlinkFlag(d) = 1 THEN
SELECT CASE EyeBlinkCount(d)
CASE 0 TO 3
_PUTIMAGE (EyeX(d), EyeY(d))-(EyeX(d) + EyeSize(d), EyeY(d) + EyeSize(d)), eyeblink&
CASE 4 TO 8
LINE (EyeX(d), EyeY(d) + (EyeSize(d) / 6))-(EyeX(d) + EyeSize(d), EyeY(d) + (EyeSize(d) / 6) + 3), _RGB(64, 64, 64), BF
CASE 9 TO 12
_PUTIMAGE (EyeX(d), EyeY(d))-(EyeX(d) + EyeSize(d), EyeY(d) + EyeSize(d)), eyeblink&
END SELECT
EyeBlinkCount(d) = EyeBlinkCount(d) + 1
IF EyeBlinkCount(d) > 12 THEN
EyeBlinkCount(d) = 0
EyeBlinkFlag(d) = 0
END IF
ELSE
'showing normal eyes
IF EyeDrift(d) = 0 THEN _PUTIMAGE (EyeX(d), EyeY(d))-(EyeX(d) + EyeSize(d), EyeY(d) + EyeSize(d)), eyeright& 'drift right
IF EyeDrift(d) = 1 THEN _PUTIMAGE (EyeX(d), EyeY(d))-(EyeX(d) + EyeSize(d), EyeY(d) + EyeSize(d)), eyeleft& 'drift left
IF EyeDrift(d) = 2 THEN _PUTIMAGE (EyeX(d), EyeY(d))-(EyeX(d) + EyeSize(d), EyeY(d) + EyeSize(d)), eyedown& 'drift down
IF EyeDrift(d) = 3 THEN _PUTIMAGE (EyeX(d), EyeY(d))-(EyeX(d) + EyeSize(d), EyeY(d) + EyeSize(d)), eyeup& 'drift up
END IF
'Add code here to add nose and mouth to the here (next version...)
'get random direction change,growth and blinking once in a while
SELECT CASE INT(RND * 300)
CASE 1: EyeDrift(d) = 0: EyeDriftSpeed(d) = INT(RND * 3) + 2
CASE 2: EyeDrift(d) = 1: EyeDriftSpeed(d) = INT(RND * 3) + 2
CASE 3: EyeDrift(d) = 2: EyeDriftSpeed(d) = INT(RND * 3) + 2
CASE 4: EyeDrift(d) = 3: EyeDriftSpeed(d) = INT(RND * 3) + 2
CASE 5: EyeGrowth(d) = 0
CASE 6: EyeGrowth(d) = 1
CASE 7: IF EyeBlinkFlag(d) = 0 THEN EyeBlinkFlag(d) = 1
END SELECT
IF _MOUSEBUTTON(1) THEN
mx = _MOUSEX: my = _MOUSEY
IF mx > EyeX(d) AND mx < EyeX(d) + EyeSize(d) AND my > EyeY(d) AND my < EyeY(d) + EyeSize(d) THEN
EyeGrowth(d) = INT(RND * 2)
EyeDrift(d) = INT(RND * 4)
EyeDriftSpeed(d) = EyeDriftSpeed(d) + 4
SOUND 7000 + (RND * 3000), .1
END IF
END IF
NEXT
_DISPLAY
_LIMIT 30
LOOP UNTIL INKEY$ = CHR$(27)
SYSTEM
SUB ball (x, y, size, r&, g&, b&)
'small sub that draws a filled ball with given color.
FOR s = 1 TO size STEP .4
CIRCLE (x, y), s, _RGB(r&, g&, b&)
r& = r& - 1: g& = g& - 1: b& = b& - 1
NEXT
END SUB
SUB RotoZoom3 (X AS LONG, Y AS LONG, Image AS LONG, xScale AS SINGLE, yScale AS SINGLE, radianRotation AS SINGLE)
DIM px(3) AS SINGLE: DIM py(3) AS SINGLE ' simple arrays for x, y to hold the 4 corners of image
DIM W&, H&, sinr!, cosr!, i&, x2&, y2& ' variables for image manipulation
W& = _WIDTH(Image&): H& = _HEIGHT(Image&)
px(0) = -W& / 2: py(0) = -H& / 2 'left top corner
px(1) = -W& / 2: py(1) = H& / 2 ' left bottom corner
px(2) = W& / 2: py(2) = H& / 2 ' right bottom
px(3) = W& / 2: py(3) = -H& / 2 ' right top
sinr! = SIN(-radianRotation): cosr! = COS(-radianRotation) ' rotation helpers
FOR i& = 0 TO 3 ' calc new point locations with rotation and zoom
x2& = xScale * (px(i&) * cosr! + sinr! * py(i&)) + X: y2& = yScale * (py(i&) * cosr! - px(i&) * sinr!) + Y
px(i&) = x2&: py(i&) = y2&
NEXT
_MAPTRIANGLE _SEAMLESS(0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
_MAPTRIANGLE _SEAMLESS(0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
END SUB
|
|
|
Taylor Series |
Posted by: Jack - 07-07-2023, 06:51 PM - Forum: Programs
- No Replies
|
 |
Code: (Select All)
_Title "Taylor"
'program deriv by Oliver Aberth
'the original program computed the derivatives of the expression
'I changed it to compute the taylor series instead
'it was included as an example in the Basic interpreter called
'precision Basic which ran on CP/M and IMB compatible PC's
'there are shortcomings to the program, for example it fails to compute
'the series for sin(x)/x at x=0 due to division by 0.
'if the number of terms is 0 then it simply evaluates the expression
'involving the variable x using the value of the expansion point.
10 Dim A$(26), C#(200), E%(200), K%(200)
20 PI# = 3.141592653589793#
30 M% = 60
40 J% = 0
50 A$(2) = "x": A$(3) = "(": A$(4) = "Acos(": A$(5) = "Asin("
60 A$(6) = "Atan(": A$(7) = "Cos(": A$(8) = "Cosh(": A$(9) = "Exp("
70 A$(10) = "Log(": A$(11) = "Sin(": A$(12) = "Sinh(": A$(13) = "Sqr("
80 A$(14) = "Tan(": A$(15) = "Tanh(": A$(16) = "-": A$(17) = "+"
90 A$(21) = "+": A$(22) = "-": A$(23) = "*": A$(24) = "/": A$(25) = "^": A$(26) = ")"
100 Cls
110 Print
120 Print Tab(10); "Program to expand f(x) into a Taylor series"
130 Print
140 Input "Enter by number the highest term to be calculated ", N%
150 If Int(N%) <> N% Or N% < 0 Then 140
160 Print
170 Print "specify f(x) by entering successive elements of f(x) by code below"
180 Print "(entering a zero will delete the last f(x) element)"
190 Print
200 Print "C denotes any constant"
210 J% = 1: K% = 1: E9% = 0: E3% = 17
220 Print
230 GoTo 260
240 Print
250 Cls
260 Print "f(x)=";
270 If J% = 1 Then 360
280 For I% = 1 To J% - 1
290 E% = E%(I%)
300 If E% <> 1 Then 340
310 K1% = K%(I%)
320 Print C#(K1%);
330 GoTo 350
340 Print A$(E%);
350 Next I%
360 Print: Print
370 If E3% = 6 Then 450
380 Print "C X ( acos asin atan cos cosh exp log sin sinh sqr tan tanh";
390 If E3% = 17 Then Print " - +": GoTo 410
400 Print
410 Print "1 2 3 4 5 6 7 8 9 10 11 12 13 14 15";
420 If E3% = 17 Then Print " 16 17": GoTo 510
430 Print
440 GoTo 510
450 Print "+ - * / ^ ";
460 If E9% > 0 Then Print ")": GoTo 480
470 Print "end of f(x)"
480 Print "1 2 3 4 5";
490 If E9% > 0 Then Print " 6": GoTo 510
500 Print " 6"
510 Input "Enter code integer ", E%
520 If Int(E%) <> E% Or E% < 0 Or E% > E3% Then 240
530 If E% > 0 Then 690
540 If J% = 1 Then 240
550 J% = J% - 1
560 E% = E%(J%)
570 If E% < 21 Then 610
580 E3% = 6
590 If E% = 26 Then E9% = E9% + 1
600 GoTo 240
610 If E% < 16 Then 640
620 E3% = 17
630 GoTo 240
640 E3% = 17
650 If E%(J% - 1) = 16 Or E%(J% - 1) = 17 Then E3% = 15
660 If E% = 1 Then K% = K% - 1
670 If E% >= 3 Then E9% = E9% - 1
680 GoTo 240
690 If E3% = 6 Then 860
700 If E3% = 15 Then 740
710 If E% <= 15 Then 740
720 E3% = 15
730 GoTo 920
740 If E% <> 1 Then 800
750 Input "Enter constant ", A$
760 C#(K%) = Val(A$ + "#")
770 K%(J%) = K%: K% = K% + 1
780 E3% = 6
790 GoTo 920
800 If E% <> 2 Then 830
810 E3% = 6
820 GoTo 920
830 E9% = E9% + 1
840 E3% = 17
850 GoTo 920
860 E% = E% + 20
870 If E% <> 26 Then 910
880 If E9% = 0 Then 950
890 E9% = E9% - 1
900 GoTo 920
910 E3% = 17
920 E%(J%) = E%
930 J% = J% + 1
940 GoTo 240
950 E%(J%) = 27
960 N1% = N% + 1
970 Dim O%(M%), V%(M%), S#(M%, N1%)
980 S#(0, 1) = 1#
990 If N% < 2 Then 1030
1000 For L% = 2 To N%
1010 S#(0, L%) = 0#
1020 Next L%
1030 For L% = 1 To M%
1040 S#(L%, N1%) = 0#
1050 Next L%
1060 Print
1070 For L% = 1 To M%
1080 If S#(L%, N1%) <> 0# Then Stop
1090 Next L%
1100 Print " press return to end or enter expantion point"
1101 Input "Enter x value at which series is to be expanded ", A$
1110 If A$ = "" Then End
1120 Z# = Val(A$ + "#")
1130 C#(0) = Z#
1140 Cls
1150 S#(0, 0) = C#(0): O% = 0: V% = 0: S# = 0#: J% = 0: O%(0) = 0: E3% = 17
1160 J% = J% + 1: E% = E%(J%)
1170 If E3% = 6 Then 1540
1180 If E3% = 15 Then 1250
1190 If E% < 16 Then 1250
1200 E3% = 15
1210 If E% = 17 Then 1160
1220 O% = O% + 1
1230 O%(O%) = 30
1240 GoTo 1160
1250 If E% = 1 Then 1380
1260 If E% = 2 Then 1340
1270 If E% = 3 Then 1300
1280 O% = O% + 1
1290 O%(O%) = E% + 30
1300 O% = O% + 1
1310 O%(O%) = 10
1320 E3% = 17
1330 GoTo 1160
1340 V%(V%) = 0
1350 V% = V% + 1
1360 E3% = 6
1370 GoTo 1160
1380 For I% = 1 To M%
1390 If S#(I%, N1%) = 0# Then 1430
1400 Next I%
1410 Print "Stack filled"
1420 Stop
1430 V%(V%) = I%
1440 V% = V% + 1
1450 K% = K%(J%)
1460 S#(I%, 0) = C#(K%)
1470 If N% < 1 Then 1510
1480 For K% = 1 To N%
1490 S#(I%, K%) = 0#
1500 Next K%
1510 S#(I%, N1%) = 1#
1520 E3% = 6
1530 GoTo 1160
1540 If E% > 24 Then 1580
1550 O2% = 20
1560 If E% > 22 Then O2% = 22
1570 GoTo 1600
1580 O2% = 30
1590 If E% > 25 Then O2% = 20
1600 If O%(O%) <= O2% Then 1630
1610 GoSub 1880
1620 GoTo 1600
1630 If E% = 27 Then 1720
1640 If E% = 26 Then 1690
1650 O% = O% + 1
1660 O%(O%) = E%
1670 E3% = 17
1680 GoTo 1160
1690 If O%(O%) <> 10 Then Stop
1700 O% = O% - 1
1710 GoTo 1160
1720 If O%(O%) <> 0 Or V% <> 1 Then Stop
1730 I% = V%(0)
1740 S#(I%, N1%) = 0#
1750 Print
1751 Print "if there are more than 20 terms to be printed then the program"
1752 Print "will pause after printing 20 terms and wait for a keypress"
1753 Print "to print another 20 terms and so on until all terms are printed"
1754 Input "press return to continue", A$
1756 Print
1760 Print "function = ";
1770 If S#(I%, 0) >= 0# Then Print " ";
1780 Print S#(I%, 0)
1790 If N% < 1 Then 1870
1800 For K% = 1 To N%
1810 Print "A"; K%;
1820 Print Tab(14); "= ";
1830 If S#(I%, K%) >= 0 Then Print " ";
1840 Print S#(I%, K%)
1850 If (K% Mod 20) = 0 Then Input "", A$
1860 Next K%
1865 Input "", A$
1870 GoTo 1060
1880 O1% = O%(O%): O% = O% - 1
1890 For K% = 1 To M%
1900 If S#(K%, N1%) = 0# Then 1930
1910 Next K%
1920 Stop
1930 S#(K%, N1%) = 1#
1940 Z# = V% - 1#
1950 K2% = V%(Z#)
1960 S#(K2%, N1%) = 0#
1970 If O1% >= 30 Then 2890
1980 V% = Z#
1990 Z# = Z# - 1#
2000 K1% = V%(Z#)
2010 V%(Z#) = K%
2020 S#(K1%, N1%) = 0#
2030 If O1% = 21 Then 2080
2040 If O1% = 22 Then 2120
2050 If O1% = 23 Then 2160
2060 If O1% = 24 Then 2240
2070 GoTo 2340
2080 For L% = 0 To N%
2090 S#(K%, L%) = S#(K1%, L%) + S#(K2%, L%)
2100 Next L%
2110 Return
2120 For L% = 0 To N%
2130 S#(K%, L%) = S#(K1%, L%) - S#(K2%, L%)
2140 Next L%
2150 Return
2160 For L% = 0 To N%
2170 Z# = 0#
2180 For M1% = 0 To L%
2190 Z# = Z# + S#(K1%, M1%) * S#(K2%, L% - M1%)
2200 Next M1%
2210 S#(K%, L%) = Z#
2220 Next L%
2230 Return
2240 Z1# = S#(K2%, 0)
2250 For L% = 0 To N%
2260 Z# = S#(K1%, L%)
2270 If L% = 0 Then 2310
2280 For M1% = 1 To L%
2290 Z# = Z# - S#(K2%, M1%) * S#(K%, L% - M1%)
2300 Next M1%
2310 S#(K%, L%) = Z# / Z1#
2320 Next L%
2330 Return
2340 If N% < 1 Then 2390
2350 For L% = 1 To N%
2360 Z# = S#(K2%, L%)
2370 If Z# <> 0# Then 2800
2380 Next L%
2390 Z1# = S#(K1%, 0)
2400 Z# = S#(K2%, 0)
2410 Z2# = Z# + 1#
2420 If Z1# = 0# Then If Int(Z#) = Z# And Z# > 0# Then 2550
2430 S#(K%, 0) = Z1# ^ Z#
2440 If N% < 1 Then 2540
2450 For L% = 1 To N%
2460 Z# = 0#: Z3# = 0#
2470 For M1% = 1 To L%
2480 Z4# = S#(K%, L% - M1%) * S#(K1%, M1%)
2490 Z3# = Z3# + Z4#
2500 Z# = Z# + M1% * Z4#
2510 Next M1%
2520 S#(K%, L%) = (Z# * Z2# / L% - Z3#) / Z1#
2530 Next L%
2540 Return
2550 For K3% = 1 To M%
2560 If S#(K3%, N1%) = 0 Then If K3% <> K2% Then 2590
2570 Next K3%
2580 Stop
2590 S#(K%, N1%) = 0#
2600 Z2# = Z#
2610 For L% = 0 To N%
2620 S#(K%, L%) = 0#
2630 S#(K3%, L%) = S#(K1%, L%)
2640 Next L%
2650 S#(K%, 0) = 1#
2660 K4% = K%
2670 Z# = Int(Z2# / 2)
2680 Z1# = Z2# - Z# - Z#
2690 Z2# = Z#
2700 If Z1# = 0 Then 2770
2710 K1% = K3%: Z# = K2%: K2% = K4%: K% = Z#: K4% = Z#
2720 GoSub 2160
2730 If Z2# > 0 Then 2770
2740 S#(K%, N1%) = 1#
2750 V%(V% - 1) = K%
2760 Return
2770 K1% = K3%: Z# = K2%: K2% = K3%: K% = Z#: K3% = Z#
2780 GoSub 2160
2790 GoTo 2670
2800 V%(V%) = K2%
2810 S#(K2%, N1%) = 1#
2820 V% = V% + 1: K2% = K1%
2830 GoSub 3070
2840 O1% = 23
2850 GoSub 1890
2860 O1% = 39
2870 GoSub 1890
2880 Return
2890 V%(Z#) = K%
2900 If O1% <> 30 Then 2950
2910 For L% = 0 To N%
2920 S#(K%, L%) = -S#(K2%, L%)
2930 Next L%
2940 Return
2950 If O1% <> 39 Then 3060
2960 S#(K%, 0) = Exp(S#(K2%, 0))
2970 If N% < 1 Then 3050
2980 For L% = 1 To N%
2990 Z# = 0#
3000 For M1% = 1 To L%
3010 Z# = Z# + M1% * S#(K%, L% - M1%) * S#(K2%, M1%)
3020 Next M1%
3030 S#(K%, L%) = Z# / L%
3040 Next L%
3050 Return
3060 If O1% <> 40 Then 3190
3070 Z2# = S#(K2%, 0)
3080 S#(K%, 0) = Log(Z2#)
3090 If N% < 1 Then 3180
3100 For L% = 1 To N%
3110 Z# = 0#
3120 If L% = 1 Then 3160
3130 For M1% = 1 To L% - 1
3140 Z# = Z# + M1% * S#(K2%, L% - M1%) * S#(K%, M1%)
3150 Next M1%
3160 S#(K%, L%) = (S#(K2%, L%) - Z# / L%) / Z2#
3170 Next L%
3180 Return
3190 If O1% = 37 Or O1% = 38 Or O1% = 41 Or O1% = 42 Or O1% = 44 Or O1% = 45 Then 3210
3200 GoTo 3550
3210 For K3% = 1 To M%
3220 If S#(K3%, N1%) = 0 Then If K3% <> K2% Then 3250
3230 Next K3%
3240 Stop
3250 If Not (O1% = 37 Or O1% = 38) Then 3270
3260 Z# = K%: K% = K3%: K3% = Z#
3270 Z# = S#(K2%, 0)
3280 If O1% = 38 Or O1% = 42 Or O1% = 45 Then 3330
3290 S#(K%, 0) = Sin(Z#)
3300 S#(K3%, 0) = Cos(Z#)
3310 Z1# = -1#
3320 GoTo 3380
3330 S#(K%, 0) = Exp(Z#)
3340 S#(K%, 0) = .5# * (S#(K%, 0) - 1# / S#(K%, 0))
3350 S#(K3%, 0) = Exp(Z#)
3360 S#(K3%, 0) = .5# * (S#(K3%, 0) + 1# / S#(K3%, 0))
3370 Z1# = 1#
3380 If N% < 1 Then 3490
3390 For L% = 1 To N%
3400 Z# = 0#: Z2# = 0#
3410 For M1% = 1 To L%
3420 Z3# = M1% * S#(K2%, M1%)
3430 Z# = Z# + S#(K3%, L% - M1%) * Z3#
3440 Z2# = Z2# + S#(K%, L% - M1%) * Z3#
3450 Next M1%
3460 S#(K%, L%) = Z# / L%
3470 S#(K3%, L%) = Z2# * Z1# / L%
3480 Next L%
3490 If Not (O1% = 44 Or O1% = 45) Then Return
3500 S#(K3%, N1%) = 1#
3510 V%(V%) = K3%
3520 V% = V% + 1
3530 O1% = 24
3540 GoTo 1890
3550 If O1% <> 43 Then 3610
3560 Z1# = S#(K2%, 0)
3570 Z2# = 1.5#
3580 S#(K%, 0) = Sqr(Z1#)
3590 K1% = K2%
3600 GoTo 2440
3610 For K3% = 1 To M%
3620 If S#(K3%, N1%) = 0 Then If K3% <> K2% Then 3650
3630 Next K3%
3640 Stop
3650 Z1# = -1#
3660 If O1% = 36 Then Z1# = 1#
3670 S#(K3%, 0) = 1# + Z1# * S#(K2%, 0) * S#(K2%, 0)
3680 If N% < 1 Then 3760
3690 For L% = 1 To N%
3700 Z# = 0#
3710 For M1% = 0 To L%
3720 Z# = Z# + S#(K2%, M1%) * S#(K2%, L% - M1%)
3730 Next M1%
3740 S#(K3%, L%) = Z# * Z1#
3750 Next L%
3760 If O1% <> 36 Then 3890
3770 S#(K%, 0) = Atn(S#(K2%, 0))
3780 Z1# = S#(K3%, 0)
3790 If N% < 1 Then 3880
3800 For L% = 1 To N%
3810 Z# = 0#
3820 If L% = 1 Then 3860
3830 For M1% = 1 To L% - 1
3840 Z# = Z# + M1% * S#(K3%, L% - M1%) * S#(K%, M1%)
3850 Next M1%
3860 S#(K%, L%) = (S#(K2%, L%) - Z# / L%) / Z1#
3870 Next L%
3880 Return
3890 S#(K3%, N1%) = 1#
3900 S#(K%, N1%) = 0#
3910 V%(V% - 1) = K3%
3920 Z1# = S#(K3%, 0)
3930 S#(K%, 0) = Sqr(Z1#)
3940 Z2# = 1.5#
3950 If N% < 1 Then 4060
3960 For L% = 1 To N%
3970 Z# = 0#
3980 Z3# = 0#
3990 For M1% = 1 To L%
4000 Z4# = S#(K%, L% - M1%) * S#(K3%, M1%)
4010 Z3# = Z3# + Z4#
4020 Z# = Z# + Z4# * M1%
4030 Next M1%
4040 S#(K%, L%) = (Z# * Z2# / L% - Z3#) / Z1#
4050 Next L%
4060 Z1# = S#(K%, 0)
4070 X# = S#(K2%, 0)
4080 If Abs(X#) = 1 Then Y# = Sgn(X#) * .5 * PI# Else Y# = Atn(X# / Sqr(1# - X# * X#))
4090 S#(K3%, 0) = Y#
4100 If N% < 1 Then 4190
4110 For L% = 1 To N%
4120 Z# = 0#
4130 If L% = 1 Then 4170
4140 For M1% = 1 To L% - 1
4150 Z# = Z# + M1% * S#(K%, L% - M1%) * S#(K3%, M1%)
4160 Next M1%
4170 S#(K3%, L%) = (S#(K2%, L%) - Z# / L%) / Z1#
4180 Next L%
4190 If O1% = 35 Then Return
4200 S#(K3%, 0) = S#(K3%, 0) - .5# * PI#
4210 O1% = 30
4220 GoTo 1890
|
|
|
Alt-Keys pattern |
Posted by: eoredson - 07-07-2023, 04:52 AM - Forum: Utilities
- Replies (3)
|
 |
I have been looking at the keyboard scancodes for the keys Alt-A to Alt-Z and found no pattern to them!
Are they internal to the electronic keyboard itself?
Thanks, Erik.
Here is a program to trap and display them:
Code: (Select All) Rem $Dynamic
DefInt A-Z
Dim Keys(1 To 26) As Integer
' scancodes for Alt-A to Alt-Z.
Data 30,48,46,32,18,33,34,35,23,36,37,38,50,49,24,25,16,19,31,20,22,47,17,45,21,44
' read Alt-<key> data.
For Var = 1 To 26
Read Keys(Var)
Next
Color 15
Print "Press <escape> to exit. Otherwise press Alt-A to Alt-Z."
Color 14
Do
_Limit 50
I$ = InKey$
If Len(I$) Then
If I$ = Chr$(27) Then Color 7: End
End If
If Len(I$) = 2 Then
X = Asc(Right$(I$, 1))
For Z = 1 To 26
If Keys(Z) = X Then
Print "Pressed Alt-"; Chr$(Z + 64); " scan"; X
End If
Next
End If
Loop
End
' scancodes for Alt-A to Alt-Z.
Rem ALT-A = 30
Rem ALT-B = 48
Rem ALT-C = 46
Rem ALT-D = 32
Rem ALT-E = 18
Rem ALT-F = 33
Rem ALT-G = 34
Rem ALT-H = 35
Rem ALT-I = 23
Rem ALT-J = 36
Rem ALT-K = 37
Rem ALT-L = 38
Rem ALT-M = 50
Rem ALT-N = 49
Rem ALT-O = 24
Rem ALT-P = 25
Rem ALT-Q = 16
Rem ALT-R = 19
Rem ALT-S = 31
Rem ALT-T = 20
Rem ALT-U = 22
Rem ALT-V = 47
Rem ALT-W = 17
Rem ALT-X = 45
Rem ALT-Y = 21
Rem ALT-Z = 44
|
|
|
Archive-dot-org simple helper |
Posted by: mnrvovrfc - 07-06-2023, 10:39 PM - Forum: Utilities
- Replies (11)
|
 |
This is a program that could make life a bit easier to navigate "archive-dot-org" if the user is only looking to download music or video.
N.B. This requires a bit of research to configure the program as desired. As it stands it only works for audio (FLAC, MP3, OGG, WAV etc.) This research is to obtain the "subjects" which are tags that have to be written precisely into a web address. On "archive-dot-org" some categories are written out like plain English, capitalized short phrases with spaces, which cannot stand into a web address. The site has a chooser of subjects which puts down stuff which could be unpredictable. (Sometimes it chooses "multiple categories" which is the same word or words but in different upper-lower-case combinations.) Therefore the user must tinker a little bit to obtain a subject tag for use with this program. It's a vain attempt to make this program more flexible.
This program requires one text file, and it's recommended to provide another. The required file has one line which is the full path of the executable to the web browser. Because I programmed this on Linux, I'm not familiar with a way to launch the web browser from an user's QB64 program on MacOS or on Windows. I also programmed to launch the AppImage which might appear clumsy to some of you. This file is not provided, you will have to create it. It is called "helparchorg-browser.txt", it must reside in the same directory as the executable. This program only reads the first line of this file, so make sure it has a correct entry. 
It's recommended to have also "helparchorg-category.txt". It could also be called "helparchorg-subject.txt". Here you will put down a subject, one per line, for the media that is sought. If you want two categories at a time then put each tag joined by a plus sign. At the moment no more than two categories could be joined.
The program reads the text files, tells the user that it found the web browser, and then shows a menu with the categories. If there's only one then it's "electronic", at the moment, but this could be changed in the source code. The user types in a number for the subject or subjects he/she desires and presses [ENTER]. Pressing [ENTER] with no entry quits the program.
After that, the user is asked what year of creation or release for the media sought, starting with 2013. Again, this could be modified in the source code. Type in the menu choice for the year, not the year itself LOL, and press [ENTER]. Press [ENTER] without entry at this point to leave the program.
This program then launches the web browser with the address fabricated from the data it was given.
Code: (Select All)
'by mnrvovrfc 6-July-2023
OPTION _EXPLICIT
DIM AS INTEGER c, lsubj, j, plu
DIM prefx$, afile$, launchprog$, comd$, asubj$, ayear$, entry$
DIM fe AS LONG
prefx$ = "helparchorg-"
afile$ = prefx$ + "browser.txt"
IF NOT _FILEEXISTS(afile$) THEN
PRINT "The web browser wasn't found! Aborting."
END
END IF
fe = FREEFILE
OPEN afile$ FOR INPUT AS fe
DO UNTIL EOF(fe)
LINE INPUT #fe, entry$
entry$ = _TRIM$(entry$)
IF entry$ <> "" AND launchprog$ = "" THEN
launchprog$ = entry$
EXIT DO
END IF
LOOP
CLOSE fe
IF NOT _FILEEXISTS(launchprog$) THEN
PRINT "The web browser wasn't found! Aborting."
END
END IF
PRINT "Discovered web browser executable called:"
PRINT launchprog$
afile$ = prefx$ + "subject.txt"
IF NOT _FILEEXISTS(afile$) THEN
afile$ = prefx$ + "category.txt"
END IF
IF _FILEEXISTS(afile$) THEN
fe = FREEFILE
OPEN afile$ FOR INPUT AS fe
DO UNTIL EOF(fe)
LINE INPUT #fe, entry$
entry$ = _TRIM$(entry$)
IF entry$ <> "" THEN lsubj = lsubj + 1
LOOP
CLOSE fe
IF lsubj < 1 THEN
PRINT "At least one entry required from input file!"
END
END IF
REDIM subj(1 TO lsubj) AS STRING
c = 0
fe = FREEFILE
OPEN afile$ FOR INPUT AS fe
DO UNTIL EOF(fe)
LINE INPUT #fe, entry$
entry$ = _TRIM$(entry$)
IF entry$ <> "" THEN
c = c + 1
subj(c) = entry$
END IF
LOOP
CLOSE fe
ELSE
lsubj = 1
REDIM subj(1 TO lsubj) AS STRING
subj(lsubj) = "electronic"
END IF
PRINT "*** archive-dot-org helper ***"
IF lsubj = 1 THEN
PRINT: PRINT "There's only one category available: "; subj(1)
asubj$ = subj(1)
ELSE
PRINT: PRINT "Please choose your category."
FOR j = 1 TO lsubj
PRINT USING "(##)"; j;
PRINT " "; subj(j)
NEXT
LINE INPUT entry$
entry$ = _TRIM$(entry$)
IF entry$ = "" THEN SYSTEM
c = VAL(entry$)
IF c > 0 AND c <= lsubj THEN
asubj$ = subj(c)
ELSE
PRINT "Incorrect input given! Aborting."
END
END IF
END IF
PRINT: PRINT "Please choose the year of release."
FOR j = 2013 TO 2023
PRINT USING "(####)"; j - 2012;
PRINT " "; j
NEXT
LINE INPUT entry$
entry$ = _TRIM$(entry$)
IF entry$ = "" THEN SYSTEM
c = VAL(entry$)
IF c > 0 AND c < 12 THEN
ayear$ = _TRIM$(STR$(c + 2012))
ELSE
PRINT "Incorrect input given! Aborting."
END
END IF
comd$ = launchprog$ + " 'https://archive.org/details/audio?and[]=year%3A%22" + ayear$ + _
"%22&and[]=mediatype%3A%22audio%22&and[]=subject%3A%22"
plu = INSTR(asubj$, "+")
IF plu > 0 THEN
comd$ = comd$ + LEFT$(asubj$, plu - 1) + "%22&and[]=subject%3A%22" + MID$(asubj$, plu + 1) + "%22'"
ELSE
comd$ = comd$ + asubj$ + "%22'"
END IF
SHELL _HIDE _DONTWAIT comd$
SYSTEM
For this program as it stands, try this as "helparchorg-category.txt":
Code: (Select All) electronic
podcast
Popular Music+Jazz
|
|
|
Auto reload program upon RUN |
Posted by: Cobalt - 07-06-2023, 08:58 PM - Forum: Help Me!
- Replies (2)
|
 |
Anybody have any clever ideas on how one would get the IDE to reload a program when it was run? The program in question actually updates itself when it runs, and I was just wondering if there was a way to get the ide to reload the code so I wouldn't forget to reload it and go change some code save it and destroy the changes the program made last time it ran.
|
|
|
|