fix amazing and bounce

beautiful-racket/br/demo/basic/amazing.bas

@@ -3,23 +3,25 @@
 10 PRINT TAB(28);"AMAZING PROGRAM"
 20 PRINT TAB(15);"CREATIVE COMPUTING  MORRISTOWN, NEW JERSEY"
 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
 130 PRINT
 140 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
-171 PRINT ".--";:GOTO 180
+171 PRINT "+--";:GOTO 180
-173 PRINT ".  ";
+173 PRINT "+  ";
 180 NEXT I
-190 PRINT "."
+190 PRINT "+"
 195 C=1:W(X,1)=C:C=C+1
 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
 230 R=1:S=S+1:GOTO 250
 240 R=R+1
@@ -28,64 +30,64 @@
 265 IF W(R-1,S)<>0 THEN 530
 270 IF 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
-310 X=INT(0.5*3+1)
+310 X=INT(RND(1)*3+1)
 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
 338 Q=1:GOTO 350
 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
-370 X=INT(0.5*2+1)
+370 X=INT(RND(1)*2+1)
 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
-405 IF S<>V THEN 420
+405 IF S<>VMAX THEN 420
 410 IF Z=1 THEN 450
 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
-450 X=INT(0.5*2+1)
+450 X=INT(RND(1)*2+1)
 460 ON X GOTO 790,860
-470 IF S<>V THEN 490
+470 IF S<>VMAX THEN 490
 480 IF Z=1 THEN 520
 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
 520 GOTO 790
 530 IF 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
-550 IF S<>V THEN 560
+550 IF S<>VMAX THEN 560
 552 IF Z=1 THEN 590
 554 Q=1:GOTO 570
 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
-590 X=INT(0.5*2+1)
+590 X=INT(RND(1)*2+1)
 600 ON X GOTO 820,860
-610 IF S<>V THEN 630
+610 IF S<>VMAX THEN 630
 620 IF Z=1 THEN 660
 625 Q=1:GOTO 640
 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
 660 GOTO 820
-670 IF R=H THEN 740
+670 IF R=HMAX 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
 695 Q=1:GOTO 830
 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
 730 GOTO 860
-740 IF S<>V THEN 760
+740 IF S<>VMAX THEN 760
 750 IF Z=1 THEN 780
 755 Q=1:GOTO 770
 760 IF W(R,S+1)<>0 THEN 780
@@ -93,46 +95,46 @@
 780 GOTO 1000
 790 W(R-1,S)=C
 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
 820 W(R,S-1)=C
 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
 860 W(R+1,S)=C
 870 C=C+1:IF V(R,S)=0 THEN 880
 875 V(R,S)=3:GOTO 890
 880 V(R,S)=2
 890 R=R+1
-900 IF C=H*V+1 THEN 1010
+900 IF C=HMAX*VMAX+1 THEN 1010
 905 GOTO 530
 910 IF Q=1 THEN 960
 920 W(R,S+1)=C:C=C+1:IF V(R,S)=0 THEN 940
 930 V(R,S)=3:GOTO 950
 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
 960 Z=1
 970 IF V(R,S)=0 THEN 980
 975 V(R,S)=3:Q=0:GOTO 1000
 980 V(R,S)=1:Q=0:R=1:S=1:GOTO 250
 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
 1020 PRINT "   ";
 1021 GOTO 1040
-1030 PRINT "  I";
+1030 PRINT "  |";
 1040 NEXT I
 1041 PRINT
-1043 FOR I=1 TO H
+1043 FOR I=1 TO HMAX
 1045 IF V(I,J)=0 THEN 1060
 1050 IF V(I,J)=2 THEN 1060
-1051 PRINT ":  ";
+1051 PRINT "+  ";
 1052 GOTO 1070
-1060 PRINT ":--";
+1060 PRINT "+--";
 1070 NEXT I
-1071 PRINT "."
+1071 PRINT "+"
 1072 NEXT J
 1073 END

beautiful-racket/br/demo/basic/bounce.bas

@@ -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

beautiful-racket/br/demo/basic/expander.rkt

@@ -146,6 +146,10 @@
   [(_ PRODUCT "*" VALUE) #'(* PRODUCT VALUE)]
   [(_ PRODUCT "/" VALUE) #'(/ PRODUCT VALUE)])
 
+(define-macro power
+  [(_ BASE) #'BASE]
+  [(_ BASE POWER) #'(expt BASE POWER)])
+
 (define-macro number
   [(_ "-" NUM) #'(- NUM)]
   [(_ NUM) #'NUM])
@@ -156,10 +160,15 @@
 
 (define print-list list)
 
-;; todo: make it work more like http://www.antonis.de/qbebooks/gwbasman/PRINT.html
 (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
     [#f (println)]
@@ -176,11 +185,8 @@
     [(list 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 (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 (SIN num) (sin num))
 (define (ABS num) (inexact->exact (abs num)))
@@ -195,7 +201,7 @@
        (basic:input ID) ...)]
   [(_ ID ...) #'(begin
                   (set! ID (let* ([str (read-line)]
-                                  [num (string->number str)])
+                                  [num (string->number (string-trim str))])
                              (or num str))) ...)])
 
 (define (basic:goto where) where)

beautiful-racket/br/demo/basic/parser.rkt

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

beautiful-racket/br/demo/basic/tokenizer.rkt

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

brag/brag/test/test-baby-json-hider.rkt

@@ -8,12 +8,12 @@
                                   ":"
                                   (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)))
-(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? 
  (syntax->datum
   (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) #\])) #\])) #\])))