1 'SHAPE MAKER by James YI 73327,1653      03/28/87
2 'For making or editing shapes and save them to a shape table.
3 'See Shpmkr.doc for instructions.
15 X=119:Y=80:DP=1
20 LOADM"SHPDRW":DR=PEEK(62715)+PEEK(62716)*256:RESTORE33:CLS:POKE-12,0:POKE-11,0
30 FILES:LINEINPUT"Choose a shape table or CR to create a new one:";F$
32 IFF$>""THENLOADMF$:TB=PEEK(62715)+PEEK(62716)*256ELSEINPUT"Table location";TB:FORL=0TO5:READD:POKETB+L,D:NEXT
33 DATA 0,5,0,1,1,255
35 POKE-14,TB-INT(TB/256)*256:POKE-13,TB/256:CLS
40 MX=PEEK(TB):TD=TB+MX*4+1:TE=TB+PEEK(TD)+PEEK(TD+1)*256+(PEEK(TD+2)*PEEK(TD+3))/8:TE=INT(TE-(TE>INT(TE)))
45 GOSUB400:PRINT"There are"MX+1"shapes on this table.":PRINT"1) Add":PRINT"2) Edit":PRINT"3) Delete":PRINT"4) Save-Quit"
47 R$=INPUT$(1):GOSUB400:IFR$="1"THEN48ELSEIFR$="2"ORR$="3"THEN50ELSE280
48 SH=MX+1:IFSH>255THENBEEP:PRINT"The table is full.":GOTO45ELSE55
50 INPUT"Shape #";SH:IFSH>255THENBEEP:PRINT"Must be less than 256.":GOTO50
52 IFSH>MXTHENBEEP:PRINT"No shape #";SH:GOTO50ELSEIFR$="2"THENCALLDR,SH,X+Y*256
55 TD=TB+SH*4+1:LC=PEEK(TD)+PEEK(TD+1)*256:SZ=(PEEK(TD+2)*PEEK(TD+3))/8:SZ=INT(SZ-(SZ>INT(SZ))):IFR$="3"THEN410ELSEIFR$="1"THENSZ=0
60 GOSUB400:PRINT"EDITING SHAPE #";SH
70 PRINT@28,"DRAW S#";SP
90 GOTO190
100 I$=INKEY$:IFI$=""THENI$=" "
110 I=ASC(I$):X=X+DP*((I=29)-(I=28)):Y=Y-DP*((I=31)-(I=30))
120 IFX<0THENX=239ELSEIFX>239THENX=0ELSEIFY<0THENY=127ELSEIFY>127THENY=0
130 IFINSTR("Cc",I$)THENCLS:GOTO60
140 IFI$="1"THENLX=X:LY=YELSEIFI$="2"THENRX=X:RY=Y
150 IFI$="="THENDP=10ELSEIFI$="-"THENDP=1
160 IFI=9THENIFNOTNWTHENCALLDR,SP,X+Y*256
170 IFINSTR(",.",I$)THENSP=SP-(I$=",")*(SP>0)+(I$=".")*(SP<MX):PRINT@35,SP;:PRINT"  "
180 CALLDR,0,PX+PY*256:IFI=52THENPSET(X,Y)ELSEIFI=51THENPRESET(X,Y)ELSEIFI=13THEN200ELSEIFI=27THEN40
190 CALLDR,0,X+Y*256:PX=X:PY=Y
195 GOTO 100
200 HS=ABS(RX-LX)+1:VS=ABS(RY-LY)+1:NS=(HS*VS)/8:NS=INT(NS-(NS>INT(NS)))
210 E=TE+NS-SZ-4*(SH>MX)-1:GOSUB400:PRINT"Shape table will now reside:":PRINT"from"TB"to"E".":PRINT"Is this Ok?";
215 P$=INPUT$(1):IFINSTR("Yy",P$)=0THEN190
220 GOSUB300:POKETD,LC-INT(LC/256)*256:POKETD+1,LC/256:POKETD+2,HS:POKETD+3,VS
240 H=LX:IFRX<LXTHENH=RX
250 V=LY:IFRY<LYTHENV=RY
260 CALL DR+269,SH,H+V*256
270 GOSUB400:PRINT"1) Add or edit on the same table.":PRINT"2) Save-Quit.":R$=INPUT$(1):IFR$="1"THEN40
280 IFF$=""THENINPUT"Save as";F$
285 SAVEMF$,TB,TE:MENU
300 IFSH>MXTHEN370
310 D=NS-SZ:IFD<0THEN330ELSEL=TE
320 IFL=TB+LC+SZ-1THEN350ELSEPOKEL+D,PEEK(L):L=L-1:GOTO320
330 L=TB+LC+SZ
340 IFL=TE+1THEN350ELSEPOKEL+D,PEEK(L):L=L+1:GOTO340
350 L=TD
360 IFL=MX*4+1+TBTHENRETURNELSEL=L+4:N=PEEK(L)+PEEK(L+1)*256:N=N+D:POKEL,N-INT(N/256)*256:POKEL+1,N/256:GOTO360
370 POKETB,SH:FORL=TETOTB+MX*4+5STEP-1:POKEL+4,PEEK(L):NEXT
380 FORL=TB+1TOTB+MX*4+1STEP4:N=PEEK(L)+PEEK(L+1)*256:N=N+4:POKEL,N-INT(N/256)*256:POKEL+1,N/256:NEXT:LC=TE+4-TB
390 RETURN
400 PRINT@0,SPACE$(240);SPACE$(80):PRINT@0,"";:RETURN
410 IFSH=0THENBEEP:PRINT"Can't delete #";SH:GOTO40
420 FORL=TD+4TOTB+LC-1:POKEL-4,PEEK(L):NEXT:FORL=TB+LC+SZTOTE:POKEL-SZ-4,PEEK(L):NEXT
430 FORL=TB+1TOTD-4STEP4:N=PEEK(L)+PEEK(L+1)*256:N=N-4:POKEL,N-INT(N/256)*256:POKEL+1,N/256:NEXT:L=TD
440 IFL=TB+MX*4+1THENPOKETB,MX-1:GOTO40ELSEN=PEEK(L)+PEEK(L+1)*256:N=N-SZ-4:POKEL,N-INT(N/256)*256:POKEL+1,N/256:L=L+4:GOTO440