[PTC] BEFUNGE Source

ACLS
CLEAR
COLOR 1
PS=5
DIM S(1000)
DIM G$(24,32)
DIM R$(24,33)
DIM B$(36,2)
FOR Y=0 TO 23
 FOR X=0 TO 31
  G$(Y,X)=" "
  BGPUT 1,X,Y,1000,15,0,0
 NEXT
NEXT
TX=1
SB=1
FOR I=0 TO 3
 BREPEAT I,10,2
NEXT
I=0
RESTORE @LANG
@P
READ S$,R$
IF S$==""  THEN @EDIT
IF S$=="Q" THEN S$=CHR$(34)
B$(I,0)=S$
B$(I,1)=R$
I=I+1
GOTO @P

@EDIT
DF=0
CLS
COLOR 1
FOR Y=0 TO 23
 FOR X=0 TO 31
  LOCATE X,Y
  ?G$(Y,X);
 NEXT
NEXT
PNLTYPE "KYA"
@EDITL
VSYNC 1
B=BUTTON(1)
BGPUT 1,GX,GY,4,0,0,0
IF B!=0 THEN GOSUB @BCHK
IF KEYBOARD!=0 THEN GOSUB @PUT
GOTO @EDITL

@BCHK
IF B AND    1 THEN BGPUT 1,GX,GY,1000,15,0,0:GY=GY-1
IF B AND    2 THEN BGPUT 1,GX,GY,1000,15,0,0:GY=GY+1
IF B AND    4 THEN BGPUT 1,GX,GY,1000,15,0,0:GX=GX-1
IF B AND    8 THEN BGPUT 1,GX,GY,1000,15,0,0:GX=GX+1
IF B AND 1024 THEN @MENU
IF GX<0  THEN GX=0
IF GY<0  THEN GY=0
IF GX>31 THEN GX=31
IF GY>23 THEN GY=23
RETURN

@PUT
K$=INKEY$()
IF KEYBOARD==15 THEN GOSUB @ERASE
G$(GY,GX)=K$
LOCATE GX,GY
?K$;
RETURN

@ERASE
G$(GY,GX)=""
LOCATE GX,GY
?" ";
RETURN
BREPEAT 15,10,1

@MENU
COLOR 0
PNLTYPE "OFF"
PNLSTR 0,0,"BEFUNGE FOR PTC - Menu"
PNLSTR 0,1,"А:Run"
PNLSTR 0,2,"Б:Load"
PNLSTR 0,3,"Ф:Save"
PNLSTR 0,4,"Х:New"
PNLSTR 0,5,"н:Debug"
PNLSTR 0,6,"[START]:Close"
@ML
VSYNC 1
B=BUTTON(1)
IF B AND   16 THEN @RUN
IF B AND   32 THEN @LOAD
IF B AND   64 THEN @SAVE
IF B AND  128 THEN @NEW
IF B AND  512 THEN @DEBUG
IF B AND 1024 THEN @EDIT
GOTO @ML

@RUN
CLS
RX=0
RY=0
SP=0
EF=0
CX=0
CY=0
IX=0
IY=0
SA=0
SB=1
COLOR 1
FOR I=0 TO 99
 S(I)=0
NEXT
BGPUT 1,GX,GY,1000,15,0,0
FOR Y=0 TO 23
 FOR X=0 TO 31
  R$(Y,X)=G$(Y,X)
  LOCATE X,Y
  ?R$(Y,X);
 NEXT
NEXT
IF DF==1 THEN @SKPR
COLOR 0
PNLSTR 0,0,"Running... Press [START] to stop"
CY=1
@SKPR
IF DF==1 THEN RETURN
@READ
BGPUT 1,RX-(IX+SX),RY-(IY+SY),1000,15,0,0
SX=0
SY=0
C$=R$(RY,RX)
IF SA==0 AND (C$=="" OR C$==" ") THEN @NXT
IF SA==1 AND C$==CHR$(34) THEN GOSUB @QM:GOTO @NXT
IF SA==1 THEN GOSUB @SGPH:GOTO @NXT
FOR A=0 TO 35
 IF C$==B$(A,0) THEN GOSUB B$(A,1)
NEXT
@NXT
BGPUT 1,RX,RY,2,0,0,0
VSYNC 9-PS
IF EF==1 THEN @EP
B=BUTTON(0)
IF B AND 1024 THEN GX=RX:GY=RY:GOTO @EDIT
RX=RX+IX+SX
RY=RY+IY+SY
IF RX<0  THEN RX=RX+32
IF RY<0  THEN RY=RY+24
IF RX>31 THEN RX=RX-32
IF RY>23 THEN RY=RY-24
IF DF==1 THEN RETURN
GOTO @READ

@DEBUG
DF=1
CX=0
CY=0
GOSUB @RUN
@DBL
GOSUB @READ
COLOR 0
FOR I=0 TO 23
 PNLSTR 0,I," "*32
NEXT
FOR I=0 TO 99
 PNLSTR CX,CY,STR$(S(I))
 CI=LEN(STR$(S(I)))+1
 GOSUB @CSR
NEXT
CX=0
CY=0
@DIL
VSYNC 1
B=BUTTON(1)
IF B!=0 THEN GOTO @DBL
GOTO @DIL

@P0
IF SP==100 THEN RETURN
S(SP)=0
SP=SP+1
RETURN

@P1
IF SP==1000 THEN RETURN
S(SP)=1
SP=SP+1
RETURN

@P2
IF SP==1000 THEN RETURN
S(SP)=2
SP=SP+1
RETURN

@P3
IF SP==1000 THEN RETURN
S(SP)=3
SP=SP+1
RETURN

@P4
IF SP==1000 THEN RETURN
S(SP)=4
SP=SP+1
RETURN

@P5
IF SP==1000 THEN RETURN
S(SP)=5
SP=SP+1
RETURN

@P6
IF SP==1000 THEN RETURN
S(SP)=6
SP=SP+1
RETURN

@P7
IF SP==1000 THEN RETURN
S(SP)=7
SP=SP+1
RETURN

@P8
IF SP==1000 THEN RETURN
S(SP)=8
SP=SP+1
RETURN

@P9
IF SP==1000 THEN RETURN
S(SP)=9
SP=SP+1
RETURN

@MA
IF SP==0 THEN RETURN
SP=SP-1
A1=S(SP)
S(SP)=0
IF SP==0 THEN RETURN
SP=SP-1
A2=S(SP)
S(SP)=A1+A2
SP=SP+1
RETURN

@MS
IF SP==0 THEN RETURN
SP=SP-1
S1=S(SP)
S(SP)=0
IF SP==0 THEN RETURN
SP=SP-1
S2=S(SP)
S(SP)=A2-A1
SP=SP+1
RETURN

@MM
IF SP==0 THEN RETURN
SP=SP-1
M1=S(SP)
S(SP)=0
IF SP==0 THEN RETURN
SP=SP-1
M2=S(SP)
S(SP)=M1*M2
SP=SP+1
RETURN

@MD
IF SP==0 THEN RETURN
SP=SP-1
D1=S(SP)
S(SP)=0
IF SP==0 THEN RETURN
SP=SP-1
D2=S(SP)
S(SP)=FLOOR(D2/D1)
SP=SP+1
RETURN

@MR
IF SP==0 THEN RETURN
SP=SP-1
R1=S(SP)
S(SP)=0
IF SP==0 THEN RETURN
SP=SP-1
R2=S(SP)
S(SP)=D2%D1
SP=SP+1
RETURN

@LN
IF SP==0 THEN RETURN
SP=SP-1
NV=S(SP)
S(SP)=!NV
SP=SP+1
RETURN

@GT
IF SP==0 THEN RETURN
SP=SP-1
G1=S(SP)
S(SP)=0
IF SP==0 THEN RETURN
SP=SP-1
G2=S(SP)
S(SP)=G2>G1
SP=SP+1
RETURN

@DR
IX=1
IY=0
RETURN

@DL
IX=-1
IY=0
RETURN

@DU
IX=0
IY=-1
RETURN

@DD
IX=0
IY=1
RETURN

@DQ
DV=RND(4)
IF DV==0 THEN IX=1:IY=0
IF DV==1 THEN IX=0:IY=1
IF DV==2 THEN IX=-1:IY=0
IF DV==3 THEN IX=0:IY=-1
RETURN

@HI
IF SP==0 THEN RETURN
SP=SP-1
IV=S(SP)
S(SP)=0
IF IV==0 THEN GOSUB @DR ELSE GOSUB @DL
RETURN

@VI
IF SP==0 THEN RETURN
SP=SP-1
IV=S(SP)
S(SP)=0
IF IV==0 THEN GOSUB @DD ELSE GOSUB @DU
RETURN

@QM
SWAP SA,SB
RETURN

@SD
IF SP==0 THEN RETURN
SP=SP-1
DV=S(SP)
SP=SP+1
S(SP)=DV
SP=SP+1
RETURN

@SS
IF SP==0 THEN RETURN
SP=SP-1
S1=S(SP)
IF SP==0 THEN RETURN
SP=SP-1
S2=S(SP)
S(SP)=S1
SP=SP+1
S(SP)=S2
SP=SP+1
RETURN

@SE
IF SP==0 THEN RETURN
SP=SP-1
S(SP)=0
RETURN

@ON
COLOR 0
SP=SP-1
IF DF==1 THEN @SKPN
CI=LEN(STR$(S(SP)))+1
IF CX+(CI-1)>32 THEN CX=0:CY=CY+1
PNLSTR CX,CY,STR$(S(SP))
GOSUB @CSR
@SKPN
S(SP)=0
RETURN

@OC
COLOR 0
SP=SP-1
IF S(SP)==13 THEN @CR
IF DF==1 THEN @SKPC
PNLSTR CX,CY,CHR$(S(SP))
CI=1
GOSUB @CSR
@SKPC
S(SP)=0
RETURN

@GS
SX=IX
SY=IY
RETURN

@GP
IF SP<3 THEN RETURN
COLOR 1
SP=SP-1
PY=S(SP)
S(SP)=0
SP=SP-1
PX=S(SP)
S(SP)=0
SP=SP-1
PV=S(SP)
S(SP)=0
BGPUT 1,PX,PY,5,0,0,0
VSYNC 1
R$(PY,PX)=CHR$(PV)
VSYNC 1
BGPUT 1,PX,PY,1000,15,0,0
LOCATE PX,PY
?CHR$(PV);
RETURN

@GG
IF SP<2 THEN RETURN
SP=SP-1
PY=S(SP)
S(SP)=0
SP=SP-1
PX=S(SP)
BGPUT 1,PX,PY,10,0,0,0
VSYNC 1
S(SP)=ASC(R$(PY,PX))
VSYNC 1
BGPUT 1,PX,PY,1000,15,0,0
SP=SP+1
RETURN

@IN
GOSUB @CG
LOCATE 0,0
COLOR 1
?"Input a number"
INPUT IN
GOSUB @CSR
S(SP)=IN
SP=SP+1
GOSUB @PG
RETURN

@IC
GOSUB @CG
LOCATE 0,0
COLOR 1
?"Input a character"
LINPUT IC$
GOSUB @CSR
S(SP)=ASC(IC$)
SP=SP+1
GOSUB @PG
RETURN

@GE
EF=1
RETURN

@SGPH
S(SP)=ASC(R$(RY,RX))
SP=SP+1
RETURN

@CSR
CX=CX+CI
IF CX>31 THEN CX=0:CY=CY+1
RETURN

@CR
CX=0
CY=CY+1
RETURN

@CG
PNLTYPE "KYA"
FOR Y=0 TO 23
 FOR X=0 TO 31
  LOCATE X,Y
  ?" ";
 NEXT
NEXT
RETURN

@PG
FOR Y=0 TO 23
 FOR X=0 TO 31
  LOCATE X,Y
  ?G$(Y,X);
 NEXT
NEXT
PNLTYPE "OFF"
RETURN

@EP
PNLSTR 0,CY+1,"Done! Press any button..."
@EPL
VSYNC 1
B=BUTTON(1)
IF B==0 THEN GOTO @EPL
BGPUT 1,RX,RY,1000,15,0,0
GOTO @EDIT

@LOAD
CLS
COLOR 1
?"FYPE TILENAME"
LINPUT FN$
LOAD"GRP:"+FN$,FALSE
FOR Y=0 TO 23
 FOR X=0 TO 31
  G$(Y,X)=CHR$(GSPOIT(X,Y))
 NEXT
NEXT
GOTO @EDIT

@SAVE
CLS
COLOR 1
?"FILENAME PLS"
LINPUT FN$
FOR Y=0 TO 23
 FOR X=0 TO 31
  IF G$(Y,X)=="" THEN G$(Y,X)=" "
  GPSET X,Y,ASC(G$(Y,X))
 NEXT
NEXT
SAVE"GRP:"+FN$
GOTO @EDIT

@NEW
FOR Y=0 TO 23
 FOR X=0 TO 31
  G$(Y,X)=" "
 NEXT
NEXT
GX=0
GY=0
GOTO @EDIT

@LANG
DATA "0","@P0"
DATA "1","@P1"
DATA "2","@P2"
DATA "3","@P3"
DATA "4","@P4"
DATA "5","@P5"
DATA "6","@P6"
DATA "7","@P7"
DATA "8","@P8"
DATA "9","@P9"
DATA "+","@MA"
DATA "-","@MS"
DATA "*","@MM"
DATA "/","@MD"
DATA "%","@MR"
DATA "!","@LN"
DATA "`","@GT"
DATA ">","@DR"
DATA "<","@DL"
DATA "^","@DU"
DATA "V","@DD"
DATA "?","@DQ"
DATA "_","@HI"
DATA "|","@VI"
DATA "Q","@QM"
DATA ":","@SD"
DATA "\","@SS"
DATA "$","@SE"
DATA ".","@ON"
DATA ",","@OC"
DATA "#","@GS"
DATA "P","@GP"
DATA "G","@GG"
DATA "&","@IN"
DATA "~","@IC"
DATA "@","@GE"
DATA "",""