suzanne.soy/beautiful-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix amazing and bounce

Browse Source
This commit is contained in:
Matthew Butterick 2016-06-10 14:17:56 -07:00
parent 3bbbf45358
commit 1391c2abae
6 changed files with 123 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

90
beautiful-racket/br/demo/basic/amazing.bas
View File

@ -3,23 +3,25 @@
10 PRINT TAB(28);"AMAZING PROGRAM" 10 PRINT TAB(28);"AMAZING PROGRAM"
20 PRINT TAB(15);"CREATIVE COMPUTING MORRISTOWN, NEW JERSEY" 20 PRINT TAB(15);"CREATIVE COMPUTING MORRISTOWN, NEW JERSEY"
30 PRINT:PRINT:PRINT:PRINT 30 PRINT:PRINT:PRINT:PRINT
100 H = 10 : V = 10 100 INPUT "WHAT ARE YOUR WIDTH AND LENGTH";HMAX,VMAX
110 DIM W(H,V),V(H,V) 102 IF HMAX<>1 AND VMAX<>1 THEN 110
104 PRINT "MEANINGLESS DIMENSIONS. TRY AGAIN.":GOTO 100
110 DIM W(HMAX,VMAX),V(HMAX,VMAX)
120 PRINT 120 PRINT
130 PRINT 130 PRINT
140 PRINT 140 PRINT
150 PRINT 150 PRINT
160 Q=0:Z=0:X=INT(0.5*H+1) 160 Q=0:Z=0:X=INT(RND(1)*HMAX+1)
165 FOR I=1 TO H 165 FOR I=1 TO HMAX
170 IF I=X THEN 173 170 IF I=X THEN 173
171 PRINT ".--";:GOTO 180 171 PRINT "+--";:GOTO 180
173 PRINT ". "; 173 PRINT "+ ";
180 NEXT I 180 NEXT I
190 PRINT "." 190 PRINT "+"
195 C=1:W(X,1)=C:C=C+1 195 C=1:W(X,1)=C:C=C+1
200 R=X:S=1:GOTO 260 200 R=X:S=1:GOTO 260
210 IF R<>H THEN 240 210 IF R<>HMAX THEN 240
215 IF S<>V THEN 230 215 IF S<>VMAX THEN 230
220 R=1:S=1:GOTO 250 220 R=1:S=1:GOTO 250
230 R=1:S=S+1:GOTO 250 230 R=1:S=S+1:GOTO 250
240 R=R+1 240 R=R+1
@ -28,64 +30,64 @@
265 IF W(R-1,S)<>0 THEN 530 265 IF W(R-1,S)<>0 THEN 530
270 IF S-1=0 THEN 390 270 IF S-1=0 THEN 390
280 IF W(R,S-1)<>0 THEN 390 280 IF W(R,S-1)<>0 THEN 390
290 IF R=H THEN 330 290 IF R=HMAX THEN 330
300 IF W(R+1,S)<>0 THEN 330 300 IF W(R+1,S)<>0 THEN 330
310 X=INT(0.5*3+1) 310 X=INT(RND(1)*3+1)
320 ON X GOTO 790,820,860 320 ON X GOTO 790,820,860
330 IF S<>V THEN 340 330 IF S<>HMAX THEN 340
334 IF Z=1 THEN 370 334 IF Z=1 THEN 370
338 Q=1:GOTO 350 338 Q=1:GOTO 350
340 IF W(R,S+1)<>0 THEN 370 340 IF W(R,S+1)<>0 THEN 370
350 X=INT(0.5*3+1) 350 X=INT(RND(1)*3+1)
360 ON X GOTO 790,820,910 360 ON X GOTO 790,820,910
370 X=INT(0.5*2+1) 370 X=INT(RND(1)*2+1)
380 ON X GOTO 790,820 380 ON X GOTO 790,820
390 IF R=H THEN 470 390 IF R=HMAX THEN 470
400 IF W(R+1,S)<>0 THEN 470 400 IF W(R+1,S)<>0 THEN 470
405 IF S<>V THEN 420 405 IF S<>VMAX THEN 420
410 IF Z=1 THEN 450 410 IF Z=1 THEN 450
415 Q=1:GOTO 430 415 Q=1:GOTO 430
420 print R ; S+1 : IF W(R,S+1)<>0 THEN 450 420 IF W(R,S+1)<>0 THEN 450
430 X=INT(0.5*3+1) 430 X=INT(RND(1)*3+1)
440 ON X GOTO 790,860,910 440 ON X GOTO 790,860,910
450 X=INT(0.5*2+1) 450 X=INT(RND(1)*2+1)
460 ON X GOTO 790,860 460 ON X GOTO 790,860
470 IF S<>V THEN 490 470 IF S<>VMAX THEN 490
480 IF Z=1 THEN 520 480 IF Z=1 THEN 520
485 Q=1:GOTO 500 485 Q=1:GOTO 500
490 print R ; S+1 : IF W(R,S+1)<>0 THEN 520 490 IF W(R,S+1)<>0 THEN 520
500 X=INT(0.5*2+1) 500 X=INT(RND(1)*2+1)
510 ON X GOTO 790,910 510 ON X GOTO 790,910
520 GOTO 790 520 GOTO 790
530 IF S-1=0 THEN 670 530 IF S-1=0 THEN 670
540 IF W(R,S-1)<>0 THEN 670 540 IF W(R,S-1)<>0 THEN 670
545 IF R=H THEN 610 545 IF R=HMAX THEN 610
547 IF W(R+1,S)<>0 THEN 610 547 IF W(R+1,S)<>0 THEN 610
550 IF S<>V THEN 560 550 IF S<>VMAX THEN 560
552 IF Z=1 THEN 590 552 IF Z=1 THEN 590
554 Q=1:GOTO 570 554 Q=1:GOTO 570
560 IF W(R,S+1)<>0 THEN 590 560 IF W(R,S+1)<>0 THEN 590
570 X=INT(0.5*3+1) 570 X=INT(RND(1)*3+1)
580 ON X GOTO 820,860,910 580 ON X GOTO 820,860,910
590 X=INT(0.5*2+1) 590 X=INT(RND(1)*2+1)
600 ON X GOTO 820,860 600 ON X GOTO 820,860
610 IF S<>V THEN 630 610 IF S<>VMAX THEN 630
620 IF Z=1 THEN 660 620 IF Z=1 THEN 660
625 Q=1:GOTO 640 625 Q=1:GOTO 640
630 IF W(R,S+1)<>0 THEN 660 630 IF W(R,S+1)<>0 THEN 660
640 X=INT(0.5*2+1) 640 X=INT(RND(1)*2+1)
650 ON X GOTO 820,910 650 ON X GOTO 820,910
660 GOTO 820 660 GOTO 820
670 IF R=H THEN 740 670 IF R=HMAX THEN 740
680 IF W(R+1,S)<>0 THEN 740 680 IF W(R+1,S)<>0 THEN 740
685 IF S<>V THEN 700 685 IF S<>VMAX THEN 700
690 IF Z=1 THEN 730 690 IF Z=1 THEN 730
695 Q=1:GOTO 830 695 Q=1:GOTO 830
700 IF W(R,S+1)<>0 THEN 730 700 IF W(R,S+1)<>0 THEN 730
710 X=INT(0.5*2+1) 710 X=INT(RND(1)*2+1)
720 ON X GOTO 860,910 720 ON X GOTO 860,910
730 GOTO 860 730 GOTO 860
740 IF S<>V THEN 760 740 IF S<>VMAX THEN 760
750 IF Z=1 THEN 780 750 IF Z=1 THEN 780
755 Q=1:GOTO 770 755 Q=1:GOTO 770
760 IF W(R,S+1)<>0 THEN 780 760 IF W(R,S+1)<>0 THEN 780
@ -93,46 +95,46 @@
780 GOTO 1000 780 GOTO 1000
790 W(R-1,S)=C 790 W(R-1,S)=C
800 C=C+1:V(R-1,S)=2:R=R-1 800 C=C+1:V(R-1,S)=2:R=R-1
810 IF C=H*V+1 THEN 1010 810 IF C=HMAX*VMAX+1 THEN 1010
815 Q=0:GOTO 260 815 Q=0:GOTO 260
820 W(R,S-1)=C 820 W(R,S-1)=C
830 C=C+1 830 C=C+1
840 V(R,S-1)=1:S=S-1:IF C=H*V+1 THEN 1010 840 V(R,S-1)=1:S=S-1:IF C=HMAX*VMAX+1 THEN 1010
850 Q=0:GOTO 260 850 Q=0:GOTO 260
860 W(R+1,S)=C 860 W(R+1,S)=C
870 C=C+1:IF V(R,S)=0 THEN 880 870 C=C+1:IF V(R,S)=0 THEN 880
875 V(R,S)=3:GOTO 890 875 V(R,S)=3:GOTO 890
880 V(R,S)=2 880 V(R,S)=2
890 R=R+1 890 R=R+1
900 IF C=H*V+1 THEN 1010 900 IF C=HMAX*VMAX+1 THEN 1010
905 GOTO 530 905 GOTO 530
910 IF Q=1 THEN 960 910 IF Q=1 THEN 960
920 W(R,S+1)=C:C=C+1:IF V(R,S)=0 THEN 940 920 W(R,S+1)=C:C=C+1:IF V(R,S)=0 THEN 940
930 V(R,S)=3:GOTO 950 930 V(R,S)=3:GOTO 950
940 V(R,S)=1 940 V(R,S)=1
950 S=S+1:IF C=H*V+1 THEN 1010 950 S=S+1:IF C=HMAX*VMAX+1 THEN 1010
955 GOTO 260 955 GOTO 260
960 Z=1 960 Z=1
970 IF V(R,S)=0 THEN 980 970 IF V(R,S)=0 THEN 980
975 V(R,S)=3:Q=0:GOTO 1000 975 V(R,S)=3:Q=0:GOTO 1000
980 V(R,S)=1:Q=0:R=1:S=1:GOTO 250 980 V(R,S)=1:Q=0:R=1:S=1:GOTO 250
1000 GOTO 210 1000 GOTO 210
1010 FOR J=1 TO V 1010 FOR J=1 TO VMAX
1011 PRINT "I"; 1011 PRINT "|";
1012 FOR I=1 TO H 1012 FOR I=1 TO HMAX
1013 IF V(I,J)<2 THEN 1030 1013 IF V(I,J)<2 THEN 1030
1020 PRINT " "; 1020 PRINT " ";
1021 GOTO 1040 1021 GOTO 1040
1030 PRINT " I"; 1030 PRINT " |";
1040 NEXT I 1040 NEXT I
1041 PRINT 1041 PRINT
1043 FOR I=1 TO H 1043 FOR I=1 TO HMAX
1045 IF V(I,J)=0 THEN 1060 1045 IF V(I,J)=0 THEN 1060
1050 IF V(I,J)=2 THEN 1060 1050 IF V(I,J)=2 THEN 1060
1051 PRINT ": "; 1051 PRINT "+ ";
1052 GOTO 1070 1052 GOTO 1070
1060 PRINT ":--"; 1060 PRINT "+--";
1070 NEXT I 1070 NEXT I
1071 PRINT "." 1071 PRINT "+"
1072 NEXT J 1072 NEXT J
1073 END 1073 END

55
beautiful-racket/br/demo/basic/bounce.bas Normal file
View File

@ -0,0 +1,55 @@
#lang br/demo/basic
10 PRINT TAB(33);"BOUNCE"
20 PRINT TAB(15);"CREATIVE COMPUTING MORRISTOWN, NEW JERSEY"
30 PRINT:PRINT:PRINT
90 DIM T(20)
100 PRINT "THIS SIMULATION LETS YOU SPECIFY THE INITIAL VELOCITY"
110 PRINT "OF A BALL THROWN STRAIGHT UP, AND THE COEFFICIENT OF"
120 PRINT "ELASTICITY OF THE BALL. PLEASE USE A DECIMAL FRACTION"
130 PRINT "COEFFICIENCY (LESS THAN 1)."
131 PRINT
132 PRINT "YOU ALSO SPECIFY THE TIME INCREMENT TO BE USED IN"
133 PRINT "'STROBING' THE BALL'S FLIGHT (TRY .1 INITIALLY)."
134 PRINT
135 INPUT "TIME INCREMENT (SEC)";S2
140 PRINT
150 INPUT "VELOCITY (FPS)";V
160 PRINT
170 INPUT "COEFFICIENT";C
180 PRINT
182 PRINT "FEET"
184 PRINT
186 S1=INT(70/(V/(16*S2)))
190 FOR I=1 TO S1
200 T(I)=V*C^(I-1)/16
210 NEXT I
220 FOR H=INT(-16*(V/32)^2+V^2/32+.5) TO 0 STEP -.5
221 IF INT(H)<>H THEN 225
222 PRINT H;
225 L=0
230 FOR I=1 TO S1
240 FOR TI=0 TO T(I) STEP S2
245 L=L+S2
250 IF ABS(H-(.5*(-32)*TI^2+V*C^(I-1)*TI))>.25 THEN 270
260 PRINT TAB(L/S2);"0";
270 NEXT TI
275 TI=T(I+1)/2
276 IF -16*TI^2+V*C^(I-1)*TI<H THEN 290
280 NEXT I
290 PRINT
300 NEXT H
310 PRINT TAB(1);
320 FOR I=1 TO INT(L+1)/S2+1
330 PRINT ".";
340 NEXT I
350 PRINT
355 PRINT " 0";
360 FOR I=1 TO INT(L+.9995)
380 PRINT TAB(INT(I/S2));I;
390 NEXT I
400 PRINT
410 PRINT TAB(INT(L+1)/(2*S2)-2);"SECONDS"
420 PRINT
430 GOTO 135
440 END

22
beautiful-racket/br/demo/basic/expander.rkt
View File

@ -146,6 +146,10 @@
[(_ PRODUCT "*" VALUE) #'(* PRODUCT VALUE)] [(_ PRODUCT "*" VALUE) #'(* PRODUCT VALUE)]
[(_ PRODUCT "/" VALUE) #'(/ PRODUCT VALUE)]) [(_ PRODUCT "/" VALUE) #'(/ PRODUCT VALUE)])
(define-macro power
[(_ BASE) #'BASE]
[(_ BASE POWER) #'(expt BASE POWER)])
(define-macro number (define-macro number
[(_ "-" NUM) #'(- NUM)] [(_ "-" NUM) #'(- NUM)]
[(_ NUM) #'NUM]) [(_ NUM) #'NUM])
@ -156,10 +160,15 @@
(define print-list list) (define print-list list)
;; todo: make it work more like http://www.antonis.de/qbebooks/gwbasman/PRINT.html
(define (basic:print [args #f]) (define (basic:print [args #f])
(define (println [x ""]) (displayln x) (set! current-print-position 0)) (define (println [x ""])
(define (print x) (display x) (set! current-print-position (+ current-print-position (string-length x)))) (define xstr (format "~a" x))
(displayln xstr)
(set! current-print-position 0))
(define (print x)
(define xstr (format "~a" x))
(display xstr)
(set! current-print-position (+ current-print-position (string-length xstr))))
(match args (match args
[#f (println)] [#f (println)]
@ -176,11 +185,8 @@
[(list print-list-items ...) [(list print-list-items ...)
(for-each println print-list-items)])) (for-each println print-list-items)]))
;; todo: make it work more like http://www.antonis.de/qbebooks/gwbasman/TAB.html
;; need to track current line position
(define current-print-position 0) (define current-print-position 0)
(define (TAB num) (make-string (max 0 (- num current-print-position)) #\space)) (define (TAB num) (make-string (max 0 (INT (- num current-print-position))) #\space))
(define (INT num) (inexact->exact (truncate num))) (define (INT num) (inexact->exact (truncate num)))
(define (SIN num) (sin num)) (define (SIN num) (sin num))
(define (ABS num) (inexact->exact (abs num))) (define (ABS num) (inexact->exact (abs num)))
@ -195,7 +201,7 @@
(basic:input ID) ...)] (basic:input ID) ...)]
[(_ ID ...) #'(begin [(_ ID ...) #'(begin
(set! ID (let* ([str (read-line)] (set! ID (let* ([str (read-line)]
[num (string->number str)]) [num (string->number (string-trim str))])
(or num str))) ...)]) (or num str))) ...)])
(define (basic:goto where) where) (define (basic:goto where) where)

6
beautiful-racket/br/demo/basic/parser.rkt
View File

@ -15,7 +15,7 @@ statement : "def" id /"(" id /")" /"=" expr
| [/"let"] id-expr "=" expr | [/"let"] id-expr "=" expr
| "print" [print-list] | "print" [print-list]
| "return" | "return"
| "for" id /"=" value /"to" value [/"step" value] | "for" id /"=" expr /"to" expr [/"step" expr]
| "next" [id] | "next" [id]
print-list : expr [[";"] [print-list]] print-list : expr [[";"] [print-list]]
@ -26,7 +26,9 @@ comp-expr : sum [("=" | ">" | ">=" | "<" | "<=" | "<>") comp-expr]
sum : [sum ("+" | "-")] product sum : [sum ("+" | "-")] product
product : [product ("*" | "/")] value product : [product ("*" | "/")] power
power : value [/"^" value]
@value : id-val @value : id-val
| id-expr | id-expr

2
beautiful-racket/br/demo/basic/tokenizer.rkt
View File

@ -24,7 +24,7 @@
"RETURN" "return" "CLEAR" "clear" "LIST" "list" "RUN" "run" "RETURN" "return" "CLEAR" "clear" "LIST" "list" "RUN" "run"
"END" "end" "THEN" "then" "ELSE" "else" "GOSUB" "gosub" "END" "end" "THEN" "then" "ELSE" "else" "GOSUB" "gosub"
"AND" "and" "OR" "or" "STOP" "stop" "LET" "let" "DEF" "def" "DIM" "dim" "ON" "on" "AND" "and" "OR" "or" "STOP" "stop" "LET" "let" "DEF" "def" "DIM" "dim" "ON" "on"
";" "=" "(" ")" "+" "-" "*" "/" ";" "=" "(" ")" "+" "-" "*" "/" "^"
"<=" ">=" "<>" "<" ">" "=" ":" ",") (string-downcase lexeme)] "<=" ">=" "<>" "<" ">" "=" ":" ",") (string-downcase lexeme)]
[number (token 'NUMBER (string->number lexeme))] [number (token 'NUMBER (string->number lexeme))]
[(seq upper-case (repetition 0 +inf.0 (or upper-case numeric)) (? "$")) (token 'ID (string->symbol lexeme))] [(seq upper-case (repetition 0 +inf.0 (or upper-case numeric)) (? "$")) (token 'ID (string->symbol lexeme))]

6
brag/brag/test/test-baby-json-hider.rkt
View File

@ -8,12 +8,12 @@
":" ":"
(token 'STRING "'hello world'") (token 'STRING "'hello world'")
"}"))) "}")))
(check-equal? (syntax->datum parse-result) '(my:json (":"))) (check-equal? (syntax->datum parse-result) '(json (":")))
(define syntaxed-colon-parens (cadr (syntax->list parse-result))) (define syntaxed-colon-parens (cadr (syntax->list parse-result)))
(check-equal? (syntax->datum (syntax-property syntaxed-colon-parens 'my:kvpair)) 'my:kvpair) (check-equal? (syntax->datum (syntax-property syntaxed-colon-parens 'kvpair)) 'kvpair)
(check-equal? (check-equal?
(syntax->datum (syntax->datum
(parse "[[[{}]],[],[[{}]]]")) (parse "[[[{}]],[],[[{}]]]"))
'(my:json (my:array #\[ (my:json (my:array #\[ (my:json (my:array #\[ (my:json) #\])) #\])) #\, (my:json (my:array #\[ #\])) #\, (my:json (my:array #\[ (my:json (my:array #\[ (my:json) #\])) #\])) #\]))) '(json (array #\[ (json (array #\[ (json (array #\[ (json) #\])) #\])) #\, (json (array #\[ #\])) #\, (json (array #\[ (json (array #\[ (json) #\])) #\])) #\])))