Apple-Befunge/editor-apple befunge.txt

NEW

REM APPLE BEFUNGE EDITOR V1.1
REM ----- ------- ------ ----

REM BEFUNGE-93-ESQUE INTERPRETER
REM WRITTEN IN APPLESOFT BASIC!

REM V1.0 JUN 2000 CHRIS PRESSEY
REM V1.1 FEB 2012 CHRIS PRESSEY

REM THIS WORK IS HEREBY ENTERED INTO
REM THE PUBLIC DOMAIN

REM THIS LISTING IS INTENDED TO BE
REM PASTED INTO YOUR EMULATOR.  SO,
REM TO SAVE SPACE AND TIME, THESE
REM 'REM'S EXIST ONLY IN THIS FILE,
REM AND ARE NOT SAVED IN PROGRAM

REM IT IS RECOMMENDED TO RUN YOUR
REM EMULATOR AT FULL SPEED, OR THE
REM INTERPRETER WILL BE SOMEWHAT,
REM SHALL WE SAY, POKEY

100 GOSUB 8000: GOTO 720

REM RUN-PROGRAM LOOP

200 VTAB Y%+1:HTAB X%+1
220 IR%=PG%(X%,Y%)
225 IF QM%=1 THEN GOSUB 910:GOTO 240
230 IF IM%=0 OR IR%=59 THEN GOSUB 400
235 IF RM%=0 THEN 720
240 GOSUB 250: GOTO 200

REM ADVANCE IP

250 X%=X%+DX%:Y%=Y%+DY%
260 IF X%>39 THEN X%=X%-40
265 IF X%<0  THEN X%=X%+40
270 IF Y%>23 THEN Y%=Y%-24
275 IF Y%<0  THEN Y%=Y%+24
280 RETURN

REM DISPLAY PAGE

300 J%=0
320 VTAB J%+1: HTAB 1
330 I%=0
340 IF I%=39 AND J%=23 GOTO 360
350 PRINT CHR$(PG%(I%,J%));
360 I%=I%+1:IF I%<40 THEN GOTO 340
370 J%=J%+1:IF J%<24 THEN GOTO 320
390 RETURN

REM EXECUTE IR%

400 IF IR%<33 THEN RETURN
412 IF IR%=86 THEN GOTO 3410:REM V
413 IF IR%=73 THEN GOTO 3010:REM I
414 IF IR%=71 THEN GOTO 3610:REM G
415 IF IR%=80 THEN GOTO 3710:REM P
416 IF IR%>=65 AND IR%<=70 THEN GOTO 2260
418 IF IR%>=92 THEN ON IR%-91 GOTO 3610,3110,3210,3310
420 IF IR%>=58 THEN ON IR%-57 GOTO 2310,2410,2510,2610,2710,2810,2910
430 IF IR%>=48 AND IR%<=57 THEN GOTO 2210
440 IF IR%>41 THEN ON IR%-41 GOTO 1610,1710,1810,1910,2010,2110
450 ON IR%-32 GOTO 1010,1110,1210,1310,1410,1510,3510
460 RETURN

REM PUSH D% ONTO STACK

500 ST%(SP%)=D%:SP%=SP%+1:RETURN

REM POP D% FROM STACK

600 IF SP%=0 THEN GOTO 650
620 SP%=SP%-1:D%=ST%(SP%)
630 RETURN
650 D%=0
690 RETURN

REM EDIT-PROGRAM LOOP

720 VTAB Y%+1:HTAB X%+1
722 IR%=PG%(X%,Y%)
730 GET A$:A%=ASC(A$)
733 IF A%=23 THEN GOSUB 6210:GOTO 720
734 IF A%=15 THEN GOSUB 6010:GOTO 720
735 IF A%=1 THEN GOSUB 8010:GOTO 720
736 IF A%=14 THEN GOSUB 7140:GOSUB 300:GOTO 720
737 IF A%=5 THEN GOSUB 7010:GOTO 720
738 IF A%=12 THEN DX%=1:DY%=0:X%=0:Y%=0:GOTO 720
740 IF A%=7 THEN RM%=1:GOTO 200
741 IF A%=9 THEN GOSUB 810

REM BACKTICK BECOMES APOSTROPHE
REM TILDE BECOMES EQUALS SIGN
REM VERTICAL BAR BECOMES LETTER I

742 IF A%=96 THEN A%=39
744 IF A%=126 THEN A%=61
746 IF A%=124 THEN A%=73
750 IF A%=20 THEN GOSUB 7110:GOTO 720
752 IF A%=18 THEN GOSUB 300:GOTO 720
760 IF A%=11 THEN DX%= 0:DY%=-1:GOSUB 250
765 IF A%=8  THEN DX%=-1:DY%= 0:GOSUB 250
770 IF A%=21 THEN DX%= 1:DY%= 0:GOSUB 250
775 IF A%=10 THEN DX%= 0:DY%= 1:GOSUB 250
777 IF A%=13 THEN DX%= 0:DY%= 1:X%=0:GOSUB 250:DX%=1:DY%=0:GOTO 720

REM SHELL TO BASIC

785 IF A%=27 THEN HOME:END:GOSUB 300:GOTO 720
786 IF X%=39 AND Y%=23 THEN GOSUB 250:GOTO 720
787 IF A%>127 THEN A%=A%-128:GOTO 787
788 IF A%>95 THEN A%=A%-32:GOTO 788
790 IF A%>31 THEN PG%(X%,Y%)=A%:PRINT CHR$(A%);:GOSUB 250
795 GOTO 720

REM HELP

810 VTAB 5:INVERSE
812 HTAB 5:PRINT " CTRL+I      - SHOW THIS HELP "
814 HTAB 5:PRINT "------------------------------"
816 HTAB 5:PRINT " ARROW KEYS  - MOVE CURSOR/IP "
818 HTAB 5:PRINT " (CTRL+J = DOWN, CTRL+K = UP) "
820 HTAB 5:PRINT " CTRL+L      - HOME CURSOR    "
822 HTAB 5:PRINT " CTRL+N      - NEW:CLEAR PROG "
824 HTAB 5:PRINT " CTRL+O      - OPEN:LOAD PROG "
826 HTAB 5:PRINT " CTRL+W      - WRITE:SAVE PRG "
828 HTAB 5:PRINT " CTRL+G      - GO:RUN PROGRAM "
830 HTAB 5:PRINT " CTRL+T      - SINGLE STEP IP "
832 HTAB 5:PRINT " CTRL+E      - EXAMINE STACK  "
834 HTAB 5:PRINT " CTRL+R      - REDRAW SCREEN  "
836 HTAB 5:PRINT " CTRL+A      - SHOW ABOUT BOX "
838 HTAB 5:PRINT " CTRL+C      - STOP PROG RUN  "
840 HTAB 5:PRINT " ESC (,CONT) - SHELL TO BASIC "
842 HTAB 5:PRINT "------------------------------"
844 HTAB 5:PRINT " PRESS ANY KEY TO RESUME EDIT "
880 NORMAL
890 GET WT$:GOSUB 300
895 RETURN

REM QUOTEMODE

910 IF IR%=34 THEN QM%=0:GOTO 990
920 D%=IR%
930 GOSUB 500
990 RETURN

REM ! BOOLEAN NOT

1010 GOSUB 600
1020 IF D%=0 THEN D%=1:GOTO 1040
1030 D%=0
1040 GOSUB 500
1090 RETURN

REM " TOGGLE QUOTEMODE

1110 IF QM%=0 THEN QM%=1:GOTO 1180
1120 QM%=0
1180 REM
1190 RETURN

REM # TRAMPOLINE

1210 X%=X%+DX%
1220 Y%=Y%+DY%
1290 RETURN

REM $ POP

1310 GOSUB 600
1390 RETURN

REM % MODULO (SLOW!)

1410 GOSUB 600
1420 E%=D%
1430 GOSUB 600
1440 IF D%>E% THEN D%=D%-E%:GOTO 1440
1450 GOSUB 500
1490 RETURN

REM & INPUT INTEGER

1510 HTAB 1:VTAB 23
1520 INVERSE:PRINT OS$;:NORMAL
1530 INPUT "";WT$
1535 D%=VAL(WT$)
1537 IF WT$=CHR$(3) THEN RM%=0
1538 J%=22:GOSUB 320
1540 GOSUB 500
1550 OS$=""
1590 RETURN

REM * MULTIPLY INTEGERS

1610 GOSUB 600
1620 E%=D%
1630 GOSUB 600
1640 D%=D%*E%
1650 GOSUB 500
1690 RETURN

REM + ADD INTEGERS

1710 GOSUB 600
1720 E%=D%
1730 GOSUB 600
1740 D%=D%+E%
1750 GOSUB 500
1790 RETURN

REM , OUTPUT CHARACTER

1810 GOSUB 600
1820 IF D%<>10 THEN GOTO 1880
1825 HTAB 1:VTAB 24
1830 INVERSE:PRINT OS$;" (EOL)";:NORMAL
1840 GET WT$:IF WT$=CHR$(3) THEN RM%=0
1850 OS$=""
1858 J%=23:GOSUB 320
1860 RETURN
1880 OS$=OS$+CHR$(D%)
1882 IF LEN(OS$)>30 THEN GOTO 1825
1890 RETURN

REM - SUBTRACT INTEGERS

1910 GOSUB 600
1920 E%=D%
1930 GOSUB 600
1940 D%=D%-E%
1950 GOSUB 500
1990 RETURN

REM . OUTPUT INTEGER

2010 GOSUB 600
2020 OS$=OS$+STR$(D%)+" "
2030 IF LEN(OS$)>30 THEN GOTO 1825
2090 RETURN

REM / DIVIDE INTEGERS

2110 GOSUB 600
2120 E%=D%
2130 GOSUB 600
2140 IF E%=0 GOTO 2170
2150 D%=D%/E%
2160 GOSUB 500
2165 RETURN
2170 PRINT "WHAT DO YOU WANT ";D%;"/";E%;" TO BE";
2180 INPUT D%
2185 GOSUB 500
2190 RETURN

REM 0-9 PUSH DIGIT

2210 D%=IR%-48
2220 GOSUB 500
2240 RETURN

REM A-F PUSH HEX DIGIT

2260 D%=IR%-55
2270 GOSUB 500
2290 RETURN

REM COLON DUP VALUE

2310 GOSUB 600:GOSUB 500:GOSUB 500
2390 RETURN

REM ; IGNORE MODE

2410 IF IM%=0 THEN IM%=1:GOTO 2490
2420 IM%=0
2490 RETURN

REM < LEFT

2510 DX%=-1:DY%=0
2590 RETURN

REM ~ INPUT CHARACTER
REM USES = ON APPLE ][+

2610 HTAB 1:VTAB 24
2615 INVERSE:PRINT OS$;:NORMAL
2620 GET WT$
2626 J%=23:GOSUB 320:REM TRICKY BASTARD!
2628 IF WT$=CHR$(3) THEN RM%=0
2630 D%=ASC(WT$)
2640 GOSUB 500
2690 RETURN

REM > RIGHT

2710 DX%=1:DY%=0
2790 RETURN

REM ? RANDOM

2810 QD%=RND(1)*4+1
2815 ON QD% GOTO 2820,2830,2840,2850
2820 DX%= 1:DY%= 0:RETURN
2830 DX%=-1:DY%= 0:RETURN
2840 DX%= 0:DY%= 1:RETURN
2850 DX%= 0:DY%=-1:RETURN
2890 RETURN

REM @ END PROGRAM

2910 HTAB 1:VTAB 24
2920 INVERSE:PRINT OS$;" (END)";:NORMAL
2930 GET WT$
2935 J%=23:GOSUB 320:REM TRICKY BASTARD!
2940 RM%=0:OS$=""
2990 RETURN

REM | UP-DOWN DECISION
REM USES I ON APPLE ][+

3010 GOSUB 600
3015 DX%=0
3020 IF D%<>0 THEN DY%=-1:GOTO 3090
3030 DY%=1
3090 RETURN

REM ] CALL MACHINE LANGUAGE

3110 GOSUB 600
3111 CALL D%
3190 RETURN

REM ^ UP

3210 DX%=0:DY%=-1
3290 RETURN

REM _ LEFT-RIGHT DECISION

3310 GOSUB 600
3315 DY%=0
3320 IF D%<>0 THEN DX%=-1:GOTO 3390
3330 DX%=1
3390 RETURN

REM V DOWN

3410 DX%=0:DY%=1
3490 RETURN

REM ` GREATER THAN
REM USES ' ON APPLE ][+

3510 GOSUB 600
3515 E%=D%
3520 GOSUB 600
3525 IF D%>E% THEN D%=1:GOTO 3530
3527 D%=0
3530 GOSUB 500
3590 RETURN

REM G GET FROM SPACE

3610 GOSUB 600
3615 E%=D%
3620 GOSUB 600
3732 IF D%<0 THEN D%=PEEK(E%):GOTO 3640
3630 D%=PG%(D%,E%)
3640 GOSUB 500
3690 RETURN

REM P PUT INTO SPACE

3710 GOSUB 600
3715 E%=D%
3720 GOSUB 600
3725 F%=D%
3730 GOSUB 600
3732 IF F%<0 THEN POKE E%,D%:GOTO 3790
3740 PG%(F%,E%)=D%
3742 HTAB F%+1:VTAB E%+1:INVERSE:PRINT CHR$(D%);:NORMAL
3790 RETURN

REM \ SWAP

3610 GOSUB 600
3620 E%=D%
3630 GOSUB 600
3640 F%=D%:D%=E%:GOSUB 500
3650 D%=F%:GOSUB 500
3690 RETURN

REM ---------------------------------

REM LOAD PROGRAM

6010 HTAB 1:VTAB 23:INPUT "FILENAME: ";F$
6012 GOSUB 7140
6015 I=0:J=0
6020 PRINT D$;"OPEN";F$
6030 PRINT D$;"READ";F$

6032 A$="": CALL 64879
6034 FOR K=512 TO 611: IF PEEK(K)<>141 THEN A$=A$+CHR$(PEEK(K)-128): NEXT
6042 IF LEFT$(A$,14)="END OF PROGRAM" THEN GOTO 6060
6045 FOR I=0 TO LEN(A$)-1:PG%(I,J)=ASC(MID$(A$,I+1,1)):NEXT
6050 J=J+1:GOTO 6032
6060 PRINT D$;"CLOSE";F$
6080 GOSUB 300
6090 RETURN

REM SAVE PROGRAM

6210 HTAB 1:VTAB 23:INPUT "FILENAME: ";F$
6215 I=0
6220 PRINT D$;"OPEN";F$
6230 PRINT D$;"WRITE";F$
6242 FOR J=0 TO 24
6244 FOR I=0 TO 39:PRINT CHR$(PG%(I,J));:NEXT
6246 PRINT: NEXT
6248 PRINT "END OF PROGRAM"
6250 PRINT D$;"CLOSE";F$
6280 GOSUB 300
6290 RETURN

REM EXAMINE STACK

7010 HTAB 1:VTAB 20:QQ$=""
7012 D%=0
7014 IF D%=SP% GOTO 7020
7016 QQ$=QQ$+STR$(ST%(D%))+" "
7018 D%=D%+1:GOTO 7014
7020 INVERSE:PRINT QQ$;:NORMAL
7030 GET WT$
7035 J%=19:GOSUB 320
7090 RETURN

REM SINGLE STEP

7110 IF QM%=1 THEN GOSUB 910:GOTO 7114
7112 IF IM%=0 OR IR%=59 THEN GOSUB 400
7114 GOSUB 250
7116 RETURN

REM NEW PLAYFIELD

7140 J%=0
7150 I%=0
7160 PG%(I%,J%)=32
7170 I%=I%+1:IF I%<40 THEN GOTO 7160
7180 J%=J%+1:IF J%<24 THEN GOTO 7150
7190 RETURN

REM INITIALIZE AND SHOW ABOUT BOX

8000 DIM PG%(79,24)
8010 DIM ST%(256)
8020 X%=0:Y%=0:DX%=1:DY%=0:QM%=0:IM%=0:RM%=0
8030 I%=0:J%=0:IR%=0:SP%=0:D%=0:E%=0:F%=0
8040 OS$="":D$=CHR$(4)
8050 HOME:VTAB 7
8053 HTAB 4:PRINT " ______________________________"
8055 HTAB 4:PRINT "/                              \"
8056 HTAB 4:PRINT "\      APPLE BEFUNGE V1.1      /"
8058 HTAB 4:PRINT "/      ------------------      \"
8060 HTAB 4:PRINT "\   BY CAT'S EYE TECHNOLOGIES  /"
8062 HTAB 4:PRINT "/    HTTP://WWW.CATSEYE.TC/    \"
8063 HTAB 4:PRINT "\   PUBLIC DOMAIN, FEB 2012    /"
8064 HTAB 4:PRINT "/  BASED ON BEFUNGE-93 & -96+  \"
8066 HTAB 4:PRINT "\  PRESS CTRL+I FOR HELP INFO  /"
8068 HTAB 4:PRINT "/ LONG LIVE RETROCOMPUTING :-) \"
8070 HTAB 4:PRINT "\______________________________/"
8080 HTAB 4:PRINT "  INITIALIZING, PLEASE WAIT... ";
8090 GOSUB 7140
8100 VTAB 18:HTAB 4:PRINT "  PRESS RETURN KEY TO CONTINUE ";
8110 GET WT$:GOSUB 300
8120 RETURN

RUN