8000 Samples scooped from thejoyfulprogrammer.com · chrisws/smallbasic.github.io@84b4647 · GitHub
[go: up one dir, main page]
Skip to content

Commit 84b4647

Browse files
chriswschrisws
committed
Samples scooped from thejoyfulprogrammer.com
1 parent b1f7060 commit 84b4647

File tree

123 files changed

+6103
-3
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

123 files changed

+6103
-3
lines changed

‎samples/bpf/BestOf Graphics/B+B.bas

Lines changed: 47 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,47 @@
1+
'<== comment some SmallBasic for Bpf started 2015-03-20
2+
'case and indents, insensitive, ? == PRINT
3+
4+
func etc(r, c, rc, counter)
5+
local i, rc3, r2, flap
6+
rc3 = rc - 9
7+
if rc3 < 0 then rc3 = rc3 + 15
8+
color rc, rc3
9+
locate r, c
10+
if counter mod 2 then print "hello world" else print "HI, BPF!"
11+
for i = 10 to 1 step -1
12+
if i mod 2 then color 15,9 else color 0,14
13+
r2=rnd
14+
if r2<.33 then
15+
flap=1
16+
elseif r2<.67
17+
flap=0
18+
else
19+
flap=-1
20+
fi
21+
locate 11 - i + r, c + int((10-i)/2) + flap
22+
? string(i, "*")
23+
next
24+
end function
25+
26+
'====================================================== main
27+
'Have you discovered the neat change case in the Edit menu ?
28+
'3: modes, Modes, MODES highlight text to change and toggle
29+
r = 10
30+
rd = -.5
31+
cycle=1
32+
while 1
33+
counter+=1
34+
if counter mod 72=0 then cycle=cycle*-1 :counter=0
35+
if r = 10 then rd = -.25
36+
if r = 5 then rd = .25
37+
r = r + rd
38+
FOR i = -3.14 TO 3.14 step 6.28 / 12
39+
'screens be different VVV (rounder circle for B+) V
40+
d=etc(int(sin(i+dx)*r*1.3)+14, int(cos(i+dy*cycle)*r*5)+50, abs(i*100) mod 16, counter)
41+
NEXT
42+
if inkey = chr(27) then end
43+
delay 60
44+
dx+=.087264 :dy+=.087264
45+
color 0,15
46+
cls
47+
wend

‎samples/bpf/BestOf Graphics/bb2fork smurf.bas

Lines changed: 43 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,43 @@
1+
'<== comment some SmallBasic for Bpf started 2015-03-20
2+
'case and indents, insensitive
3+
func etc(r, c, rc)
4+
'just to be safe using LOCAL i
5+
local i
6+
7+
rc3 = rc - 9
8+
if rc3 < 0 then rc3 = rc3 + 15
9+
color rc, rc3
10+
locate r, c
11+
print ucase("hello world")
12+
for i = 10 to 1 step -1
13+
if i mod 2 then color 15,9 else color 0,14
14+
'<=== this is a comment, this=> ? is equavlent to print
15+
locate 11 - i + r, c
16+
? string(i, "*")
17+
next
18+
19+
'OK this does work commented out ????
20+
'sorry, something wasn't from my cut and paste
21+
'etc=1
22+
23+
end function
24+
'====================================================== main
25+
'Have you discovered the neat change case in the Edit menu ?
26+
'3: modes, Modes, MODES
27+
r = 10
28+
rd = -.5
29+
while 1
30+
FOR i = -3.14 TO 3.14 step 6.28 / 12
31+
#if r > 9 then rd = -.125
32+
#if r < 7 then rd = .125
33+
#r = r + rd
34+
35+
'screens may be different VVV (rounder circle for B+) V
36+
d = etc(int(sin(i+dx) * atan(i*2.5+5)*5.3) + 14, int(cos(i+dy) * atan(i*2.5+7) *25) + 50, abs(i * 100) mod 16)
37+
NEXT
38+
if inkey = chr(27) then end
39+
delay 50
40+
dx+=.087264 :dy+=.087264
41+
color 0,15
42+
cls
43+
wend

‎samples/bpf/BestOf Graphics/sineballcube.bas

Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,16 @@
1+
'sineballcube.bas SmallBASIC(! MS) 2015-08-23 MGA/B+ translated and modified from:
2+
'sinecube 2006 mennonite public domain
3+
FOR l = 8 * 32 TO 1 STEP -8
4+
FOR y = 4 TO 4 * 32 STEP 4
5+
FOR x = 8 * 32 TO 1 STEP -8
6+
if SIN(x * y * l * 3.14) >0 then drawball x+y,y+l
7+
NEXT x
8+
NEXT y
9+
NEXT l
10+
sub drawball(x,y)
11+
xc=x+12:yc=y+12
12+
for r=9 to 1 step -1
13+
circle xc,yc,r,1,rgb(255-r*25,255-r*20,0) filled
14+
next
15+
pset xc,yc,rgb(255,255,0)
16+
end

‎samples/bpf/BestOf Graphics/sinecube3c.bas

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
1+
'sinecube3c.bas SmallBASIC 2015-08-24 MGA/B+ modified from:
2+
'sinecube 2006 mennonite public domain
3+
color 7,0:cls
4+
FOR l = 8 * 32 TO 0 STEP -8
5+
FOR y = 4 TO 4 * 32 STEP 4
6+
FOR x = 8 * 32 TO 0 STEP -8
7+
if SIN(x * y * l * 3.14) >0 then cube x+y,y+l,y
8+
NEXT x
9+
NEXT y
10+
NEXT l
11+
sub cube(x,y,c)
12+
for i=0 to 2
13+
line x+i,y+i,x+6+i,y+i,rgb(c*1.9,c*1.9,c+127)
14+
line x+i,y+i+1,x+i,y+7+i,rgb(0,0,1.9*c)
15+
next
16+
rect x+3,y+3,x+10,y+10,rgb(1.9*c,0,0) filled
17+
rect x+4,y+4,x+9,y+9,0 filled
18+
end

‎samples/bpf/BestOf Graphics/v20 last B+B.bas

Lines changed: 48 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,48 @@
1+
'v20 last of day B+B from me
2+
'<== comment some SmallBasic for Bpf started 2015-03-20
3+
'case and indents, insensitive, ? == PRINT
4+
5+
func etc(r, c, rc, counter)
6+
local i, rc3, r2, flap
7+
rc3 = rc - 9
8+
if rc3 < 0 then rc3 = rc3 + 15
9+
color rc, rc3
10+
locate r, c
11+
if counter mod 2 then print "hello world" else print "HI, BPF!"
12+
for i = 10 to 1 step -1
13+
if i mod 2 then color 15,9 else color 0,14
14+
r2=rnd
15+
if r2<.33 then
16+
flap=1
17+
elseif r2<.67
18+
flap=0
19+
else
20+
flap=-1
21+
fi
22+
locate 11 - i + r, c + int((10-i)/2) + flap
23+
? string(i, "*")
24+
next
25+
end function
26+
27+
'====================================================== main
28+
'Have you discovered the neat change case in the Edit menu ?
29+
'3: modes, Modes, MODES highlight text to change and toggle
30+
r = 10
31+
rd = -.5
32+
cycle=1
33+
while 1
34+
counter+=1
35+
if counter mod 72=0 then cycle=cycle*-1 :counter=0
36+
if r = 10 then rd = -.25
37+
if r = 5 then rd = .25
38+
r = r + rd
39+
FOR i = -3.14 TO 3.14 step 6.28 / 12
40+
'screens be different VVV (rounder circle for B+) V
41+
d=etc(int(sin(i+dx)*r*1.3)+14, int(cos(i+dy*cycle)*r*5)+50, abs(i*100) mod 16, counter)
42+
NEXT
43+
if inkey = chr(27) then end
44+
delay 60
45+
dx+=.087264 :dy+=.087264
46+
color 0,15
47+
cls
48+
wend

‎samples/bpf/Misc Bpf/3d block lettes.bas

Lines changed: 28 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,28 @@
1+
'3d Block Letters.bas for SmallBASIC 2015-08-30 MGA/B+ combine 2 recent code creations
2+
option base 1
3+
name="SmallBASIC" 'here is a different way to get letter data (not the greatest but fast)
4+
? name
5+
ln=len(name)
6+
xd=ln*9
7+
yd=16
8+
dim dat(xd,yd)
9+
for y=1 to yd
10+
for x=1 to xd
11+
if point(x,y)<>point(0,0) then dat(x,y)="O" else dat(x,y)=" "
12+
next
13+
next
14+
color 15,0:cls
15+
for z=1 to 128
16+
for row = yd to 1 step-1
17+
for col=1 to xd
18+
if dat(col,row)="O" then cube 10*col+z,10*row+z,z
19+
next col
20+
next row
21+
next z
22+
sub cube(x,y,c)
23+
for i=0 to 2
24+
line x+i,y+i,x+6+i,y+i,rgb(c*1.9,c*1.9,c+127)
25+
line x+i,y+i+1,x+i,y+7+i,rgb(0,0,1.9*c)
26+
next
27+
rect x+3,y+3,x+10,y+10,rgb(1.9*c,0,0) filled
28+
end

‎samples/bpf/Misc Bpf/Another center finder.bas

Lines changed: 75 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,75 @@
1+
'Another center finder.bas in SmallBASIC 2015-09-12 MGA/B+
2+
'Thanks to ScriptBasic for posting 1968 Dartmouth Code
3+
'different center, can't circumcribe or inscribe
4+
5+
? "To find a center of triangle, click 3 points to draw Triangle."
6+
7+
pen on
8+
p1x=-100
9+
while p1x=-100
10+
if pen(3) then p1x=pen(4):p1y=pen(5)
11+
wend
12+
circle p1x,p1y,2,1 filled
13+
? "one"
14+
delay 200
15+
16+
p2x=-100
17+
while p2x=-100
18+
if pen(3) then p2x=pen(4):p2y=pen(5)
19+
wend
20+
circle p2x,p2y,2,1 filled
21+
? "two"
22+
line p1x,p1y,p2x,p2y
23+
mp1x=p1x+(p2x-p1x)/2
24+
mp1y=p1y+(p2y-p1y)/2
25+
delay 200
26+
27+
p3x=-100
28+
while p3x=-100
29+
if pen(3) then p3x=pen(4):p3y=pen(5)
30+
wend
31+
circle p3x,p3y,2,1 filled
32+
? "three"
33+
pen off
34+
'draw triangle
35+
line p2x,p2y,p3x,p3y
36+
line p3x,p3y,p1x,p1y
37+
mp2x=p2x+(p3x-p2x)/2
38+
mp2y=p2y+(p3y-p2y)/2
39+
mp3x=p3x+(p1x-p3x)/2
40+
mp3y=p3y+(p1y-p3y)/2
41+
42+
circle mp1x,mp1y,2,1 filled
43+
circle mp2x,mp2y,2,1 filled
44+
circle mp3x,mp3y,2,1 filled
45+
46+
line mp1x,mp1y,p3x,p3y
47+
line mp2x,mp2y,p1x,p1y
48+
line mp3x,mp3y,p2x,p2y
49+
50+
ABCs4StdFrm mp1x,mp1y,p3x,p3y
51+
A=U:B=V:C=W
52+
ABCs4StdFrm mp2x,mp2y,p1x,p1y
53+
D=U:E=V:F=W
54+
Solve4XY
55+
circle X,Y,2,1 filled
56+
57+
func slope(q1x,q1y,q2x,q2y)
58+
slope=(q2y-q1y)/(q2x-q1x)
59+
end
60+
61+
sub ABCs4StdFrm(r1x,r1y,r2x,r2y)
62+
'takes two points that define line and gets A,B,C's for Standard Form of line
63+
local m
64+
m=slope(r1x,r1y,r2x,r2y)
65+
U=-m:V=1:W=r2y-m*r2x 'U,V,W are global
66+
end
67+
68+
sub Solve4XY()
69+
'globals A,B,C,D,E,F
70+
local G
71+
G=A*E-B*D
72+
IF G=0 THEN PRINT "NO UNIQUE SOLUTION":exit
73+
X=(C*E-B*F)/G
74+
Y=(A*F-C*D)/G
75+
end

‎samples/bpf/Misc Bpf/BAS_1968.bas

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,21 @@
1+
REM Basic 1968.bas, 2015-02-12
2+
REM THE FIRST PROGRAM STDUIED BY KEREMY AND KURTZ
3+
REM OF DARTMOUTH, WAS NOT "HELLO WORLD!"
4+
REM AX + BY = C
5+
REM DX + EY = F
6+
REM SOLUTION: X= (CE-BF)/(AE-BD)
7+
REM Y= (AF-CD)/(AE-BD)
8+
9+
10 READ A,B,D,E
10+
15 LET G=A*E-B*D
11+
20 IF G=0 THEN 65
12+
30 READ C,F
13+
37 LET X=(C*E-B*F)/G
14+
42 LET Y=(A*F-C*D)/G
15+
55 PRINT X,Y
16+
60 GOTO 30
17+
65 PRINT "NO UNIQUE SOLUTION"
18+
70 DATA 1,2,4
19+
80 DATA 2,-7,5
20+
85 DATA 1,3,4,-7
21+
90 END

‎samples/bpf/Misc Bpf/BAS_NOW.bas

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,35 @@
1+
REM BAS_NOW.bas, 2015-02-21
2+
REM THE FIRST PROGRAM STDUIED BY KEREMY AND KURTZ
3+
REM OF DARTMOUTH, WAS NOT "HELLO WORLD!"
4+
REM NOW DAYS IS BASIC FASTER THAN A SPREADSHEET SOLUTION???????
5+
5 LET AGAIN$="NO"
6+
PRINT " AX + BY = C"
7+
PRINT " DX + EY = F"
8+
PRINT " SOLUTION: X= (CE-BF)/(AE-BD)"
9+
PRINT " Y= (AF-CD)/(AE-BD)"
10+
PRINT " WHEN (AE-BD) <> 0"
11+
PRINT
12+
INPUT "A = ",A
13+
INPUT "B = ",B
14+
INPUT "C = ",C
15+
INPUT "D = ",D
16+
INPUT "E = ",E
17+
INPUT "F = ",F
18+
PRINT
19+
LET G=A*E-B*D
20+
IF G=0 THEN PRINT "NO UNIQUE SOLUTION"
21+
IF G=0 THEN PRINT
22+
IF G=0 THEN INPUT "TO TRY AGAIN JUST PRESS ENTER, ANY KEY +ENTER TO QUIT ",AGAIN$
23+
IF G=0 AND LEN(AGAIN$)=0 THEN CLS
24+
IF G=0 AND LEN(AGAIN$)=0 THEN GOTO 5
25+
IF G=0 AND LEN(AGAIN$) THEN END
26+
LET X=(C*E-B*F)/G
27+
LET Y=(A*F-C*D)/G
28+
PRINT "X = ";X;" ";"Y = ";Y
29+
PRINT
30+
INPUT "TO TRY AGAIN JUST PRESS ENTER, ANY KEY +ENTER TO QUIT ",AGAIN$
31+
IF LEN(AGAIN$)=0 THEN CLS
32+
IF LEN(AGAIN$)=0 THEN GOTO 5
33+
IF LEN(AGAIN$) THEN END
34+
35+

‎samples/bpf/Misc Bpf/BAS_NOWv2.bas

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
'BAS_NOWv2.bas, 2015-02-22, B+ using SmallBASIC (?=PRINT)
2+
? " AX + BY = C DX + EY = F"
3+
? " SOLUTION: WHEN (AE-BD) <> 0"
4+
? " X= (CE-BF)/(AE-BD) Y= (AF-CD)/(AE-BD)" :?:quit=""
5+
WHILE quit=""
6+
INPUT " A,B,C,D,E,F +ENTER ",a,b,c,d,e,f
7+
g=a*e-b*d
8+
IF g THEN ?"X=";(c*e-b*f)/g;" Y=";(a*f-c*d)/g ELSE ?"NO UNIQUE SOLUTION"
9+
INPUT "ANY KEY +ENTER TO QUIT, JUST ENTER TO GO AGAIN ",quit :?
10+
WEND
11+
12+
13+

0 commit comments

Comments
 (0)
0