TURTLE GRAPHICS for Petitcom V0.2

TURTLE

'+----------------------+
'| TURTLE GRAPHICS V0.2 |
'+----------------------+
CLEAR:CLS:GPAGE 0:GCLS
VISIBLE 1,1,1,1,1,1
?"TURTLE GRAPHICS V0.2"

MYPRG$="TURTLE"
KEY 3,"SAVE"+CHR$(34)+"PRG:"+MYPRG$
EDPRG$="TEDIT"
DEBUG=0

'** Command **
TMAX=16
DIM T$(TMAX+1)
'A commnad with *(Asterisk) is for direct mode
T$(0)= "FW" 'FW ForWard
T$(1)= "BW" 'BW BackWard
T$(2)= "RT" 'RT Right-Turn
T$(3)= "LT" 'LT Left-Turn
T$(4)= "PU" 'PU Pen-Up
T$(5)= "PD" 'PD Pen-Down
T$(6)= "PC" 'PC Pen-Color
T$(7)= "RP" 'RP Repeat
T$(8)= "ER" 'ER End-Repeat
T$(9)= "CL" 'CL Clear
T$(10)="EX" 'EX *Load&Execute
T$(11)="ST" 'ST *Status
T$(12)="LS" 'LS *List Program
T$(13)="ED" 'ED *Edit Program
T$(14)="LD" 'LD *Load Program
T$(15)="RN" 'RN *Run Program
T$(16)="QT" 'QT *Quit

'** ErrorCode ++
E_SYX = 1:EM$(E_SYX )="Wrong Syntax"
E_OF  = 2:EM$(E_OF  )="OverFlow"
E_WORP= 4:EM$(E_WORP)="Without Repeat"
E_WOOP= 5:EM$(E_WOOP)="Without Operand"
E_NDM = 9:EM$(E_NDM )="Not Direct Mode"

TX=127:TY=95:TA=0
PEN=1:PENC=5
MODE=0:'0=Direct,1=Program
FN$=""
DIM STPC(20),STCN(20)

WT=1
GOSUB @SPINIT
GOSUB @SPDISP

@INP
INPUT "> ";PG$
PC=0:ST=0

@LOOP
'** Parse Command Token **
R$=""
GOSUB @R
CM=-1
FOR I=0 TO TMAX
 IF T$(I)==R$ THEN CM=I:I=TMAX
NEXT

'** Parse Operand **
R$=""
GOSUB @R
OP=VAL(R$)
IF CM>=0 THEN ?T$(CM);
?OP

'** Execute Command **
ERC=0
ON CM GOSUB @FW,@BW,@RT,@LT,@PU,@PD,@PC,@RP,@ER,@CL
ON CM-10 GOSUB @EX,@ST,@LS,@ED,@LD,@RN,@QT
GOSUB @SPDISP
IF DEBUG THEN ?"TX,TY,TA=";TX;",";TY;",";TA
IF ERC>0 GOTO @ONERR
IF LEN(PG$)>=PC GOTO @LOOP
GOTO @INP

@R
I$=MID$(PG$,PC,1):PC=PC+1
IF I$==" " OR I$=="" OR I$==CHR$(13) THEN RETURN
R$=R$+I$
GOTO @R

@RLINE
AJ=0.003
GLINE PX+AJ,PY+AJ,TX+AJ,TY+AJ,PENC
RETURN

@FW
PX=TX:PY=TY
R=RAD((TA>90)*360-(TA-90))
TX=TX+COS(R)*OP
TY=TY-SIN(R)*OP
IF PEN==0 THEN RETURN
GOSUB @RLINE
RETURN

@BW
PX=TX:PY=TY
R=RAD((TA>90)*360-(TA-90))
TX=TX-COS(R)*OP
TY=TY+SIN(R)*OP
IF PEN==0 THEN RETURN
GOSUB @RLINE
RETURN

@RT
IF OP>360 OR OP<0 THEN ERC=E_OF:RETURN
TA=TA+OP
IF TA>=360 THEN TA=TA-360
RETURN

@LT
IF OP>360 OR OP<0 THEN ERC=E_OF:RETURN
TA=TA-OP
IF TA<0 THEN TA=TA+360
RETURN

@PU
PEN=0
RETURN

@PD
PEN=1
RETURN

@PC
IF OP<0 THEN PENC=PENC-OP:RETURN
PENC=OP%256
RETURN

@RP
ST=ST+1
STPC(ST)=PC:STCN(ST)=OP
RETURN

@ER
IF ST<1 THEN ERC=E_WORP:RETURN
L=STCN(ST)-1:STCN(ST)=L
IF L>0 THEN PC=STPC(ST):RETURN
STPC(ST)=0:STCN(ST)=0
ST=ST-1
RETURN

@CL
CLS:GPAGE 0:GCLS
TX=127:TY=95:TA=0
PEN=1:PENC=5
RETURN

@EX
IF MODE!=0 THEN ERC=E_NDM:RETURN
GOSUB @LD
IF RESULT==FALSE THEN RETURN
PC=0:ST=0:PG$=MEM$
RETURN

@ST
IF MODE!=0 THEN ERC=E_NDM:RETURN
?"TX,TY,TA=";TX;",";TY;",";TA
?"PEN,PENC=";PEN;",";PENC
RETURN

@LS
IF MODE!=0 THEN ERC=E_NDM:RETURN
?"FileName=";FN$
?MEM$
RETURN

@ED
IF MODE!=0 THEN ERC=E_NDM:RETURN
IF FN$=="" THEN ?"No Program":RETURN
CLS
?"PRG:";MYPRG$
FOR I=(FN$=="") TO 0
 IF MID$(FN$,0,4)!="MEM:" THEN FN$="MEM:"+FN$
 ?FN$
NEXT
EXEC EDPRG$
RETURN

@LD
IF MODE!=0 THEN ERC=E_NDM:RETURN
INPUT "FILE NAME>";FN$
IF MID$(FN$,0,4)!="MEM:" THEN FN$="MEM:"+FN$
LOAD FN$,FALSE
IF RESULT==FALSE THEN ?"File Not Found"
RETURN

@RN
IF MODE!=0 THEN ERC=E_NDM:RETURN
IF LEN(MEM$)==0 AND FN$=="" THEN ?"No Program":RETURN
PC=0:ST=0:PG$=MEM$
RETURN

@QT
END

@ONERR
BEEP
?PC;":";
IF ERC==E_SYX   THEN ?EM$(E_SYX )
IF ERC==E_OF    THEN ?EM$(E_OF  )
IF ERC==E_WORP  THEN ?EM$(E_WORP)
IF ERC==E_WOOP  THEN ?EM$(E_WOOP)
IF ERC==E_NDM   THEN ?EM$(E_NDM )
GOTO @INP

@SPDISP
AX=SIN(-2*PI()*(TA-45)/360)*9.9
AY=COS(-2*PI()*(TA-45)/360)*11.314
SPANGLE 0,TA
SPOFS 0,TX-AX,TY-AY
VSYNC WT
RETURN

@SPINIT
SPPAGE 0:SPCLR
RESTORE @SPDAT
FOR J=0 TO 1
 SP1$="":SP2$=""
 FOR I=0 TO 7
  READ A$,B$
  SP1$=SP1$+A$
  SP2$=SP2$+B$
 NEXT I
 CHRSET "SPU0",J*2,SP1$
 CHRSET "SPU0",J*2+1,SP2$ 
NEXT J
SPSET 0,0,0,0,0,1
RETURN

@SPDAT
DATA "00000002","00000000"
DATA "00000002","00000000"
DATA "00000020","20000000"
DATA "00000020","20000000"
DATA "00000200","02000000"
DATA "00000200","02000000"
DATA "00002000","00200000"
DATA "00002000","00200000"
DATA "00020002","00020000"
DATA "00020020","20020000"
DATA "00200200","02002000"
DATA "00202000","00202000"
DATA "02020000","00020200"
DATA "02200000","00002200"
DATA "00000000","00000000"
DATA "00000000","00000000"

6/26 タートルグラフィックス for プチコン V0.2
V0.1からの変更箇所
・開始時のタイトル（バージョン）表示
・タートルの表示
・エラーメッセージの表示
・MEM$にプログラムが読み込まれていればLS,RN,EDを実行可能なように変更
V0.1版は更新日が June 18, 2011 のものを見てください。