TURTLE GRAPHICS for Petitcom V0.3

gistfile1.txt

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

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

'** Command **
TMAX=35
DIM T$(TMAX+1)
'A command 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
T$(17)="PS" 'PS Push To Stack
T$(18)="PP" 'PP Pop From Stack
T$(19)="AD" 'AD Add
T$(20)="SB" 'SB Substract
T$(21)="ML" 'ML Multiplicate
T$(22)="DV" 'DV Divide
T$(23)="R0" 'R0 Set Register0
T$(24)="R1" 'R1 Set Register1
T$(25)="R2" 'R2 Set Register2
T$(26)="R3" 'R3 Set Register3
T$(27)="R4" 'R4 Set Register4
T$(28)="R5" 'R5 Set Register5
T$(29)="R6" 'R6 Set Register6
T$(30)="R7" 'R7 Set Register7
T$(31)="R8" 'R8 Set Register8
T$(32)="R9" 'R9 Set Register9
T$(33)="DS" 'DS Direct Push
T$(34)="DP" 'DP Direct Pop
T$(35)="MS" 'MS Message

'** 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_USOV= 6:EM$(E_USOV)="User Stack OverFlow"
E_ILRG= 7:EM$(E_ILRG)="Illeagal Register"
E_DVZ = 8:EM$(E_DVZ )="Divide By Zero"
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)

USTMAX=1024
DIM UST(USTMAX)
DIM REG(10)
FOR I=0 TO 9:REG(I)=0:NEXT
USTP=0:VALUST=0
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
IF MID$(R$,0,1)=="$" THEN GOSUB @IDOP
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,@PS,@PP,@AD
ON CM-20 GOSUB @SB,@ML,@DV
IF 23<=CM AND CM<=32 THEN RG=CM-23:GOSUB @R0
ON CM-33 GOSUB @DS,@DP,@MS
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

@PS
IF OP<0 OR 9<OP THEN ERC=E_ILRG:RETURN
VALUST=REG(OP):GOSUB @PUSHUS
RETURN

@PP
IF OP<0 OR 9<OP THEN ERC=E_ILRG:RETURN
GOSUB @POPUST:IF ERC>0 THEN RETURN
REG(OP)=VALUST
RETURN

@AD
GOSUB @POPUST:V1=VALUST
GOSUB @POPUST:V2=VALUST
IF ERC>0 THEN RETURN
VALUST=V2+V1:GOSUB @PUSHUST
RETURN

@SB
GOSUB @POPUST:V1=VALUST
GOSUB @POPUST:V2=VALUST
IF ERC>0 THEN RETURN
VALUST=V2-V1:GOSUB @PUSHUST
RETURN

@ML
GOSUB @POPUST:V1=VALUST
GOSUB @POPUST:V2=VALUST
IF ERC>0 THEN RETURN
VALUST=V2*V1:GOSUB @PUSHUST
RETURN

@DV
GOSUB @POPUST:V1=VALUST
GOSUB @POPUST:V2=VALUST
IF ERC>0 THEN RETURN
IF V1==0 THEN ERC=E_DVZ:RETURN
VALUST=V2/V1:GOSUB @PUSHUST
RETURN

@R0 'R0~R9
REG(RG)=OP
RETURN

@DS
VALUST=OP:GOSUB @PUSHUST
RETURN

@DP
GOSUB @POPUST:IF ERC>0 THEN RETURN
RETURN

@MS
?"[";OP;"]"
RETURN

@PUSHUST
IF USTP==USTMAX THEN ERC=E_USOV:RETURN
UST(USTP)=VALUST
USTP=USTP+1
RETURN

@POPUST
IF USTP==0 THEN ERC=E_USOV:RETURN
VALUST=UST(USTP-1)
USTP=USTP-1
RETURN

@IDOP
IF LEN(R$)>2 THEN RETURN
R2=ASC(MID$(R$,1,1))
IF 48<=R2 AND R2<=57 THEN R$=STR$(REG(R2-48)):RETURN
IF R2==ASC("@") GOTO @IDOP1
IF R2==ASC("%") GOTO @IDOP2
RETURN
@IDOP1
IF ST<1 THEN R$="0":RETURN
R$=STR$(STCN(ST-1))
RETURN
@IDOP2
R$=STR$(VALUST)
RETURN

@ONERR
BEEP
?PC;":";EM$(ERC)
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"

7/23 タートルグラフィックス for プチコン V0.3
V0.2からの変更箇所
・変数(レジスタ)10個を追加。変数への代入は R0R9コマンドを利用。変数からの値の参照は オペランドに $0$9を指定。
・ユーザースタックを追加。変数・スタック間のPUSH・POPはPS、PPコマンド。オペランドの直接PUSH・POPはDS、DPコマンド。
・ユーザースタックの四則演算を追加。＋・－・×・÷はそれぞれAD、SB、ML、DVコマンド。
・オペランドに指定された値を表示するメッセージコマンド追加。MSコマンド。
V0.2版は https://gist.github.com/1029452 をご覧ください。