Listing of file='SKETCHPL' on disk='vmedia/2282_graphics_crt_demos.wvd.zip'
# Sector 71, program filename = 'SKETCHPL'
0000 DEFFN'0 "LIST S HEX(03) D 100,"
0001 DEFFN'1 "LIST S HEX(03) D 145,299"
0002 DEFFN'2 "LIST S HEX(03) D 700,899"
0004 DEFFN'4 "SCRATCH T#1,"; HEX(22); "SKETCHPL"; HEX(22); ": SAVE DC T#1, ()"
; HEX(22); "SKETCHPL" ;HEX(22)
0008 REM STUBBED ERASE
0017 DEFFN'17 "RENUMBER 145-299 TO 150 STEP 5"
0018 DEFFN'18 "RENUMBER 700-899 TO 700 STEP 5"
0099 DEFFN'126 HEX(60)
0100 DIM C(50,2),P$(100)12,P$12,P0$12,P1$12,K$1,K0$,P9$3
0105 DIM X,Y,R,S,P,D
0106 PRINT HEX(020D0C030F);TAB(14);HEX(020400020E);" Computer Aided Sketch Pad
. ";HEX(020402000F)
0107 PRINT AT(3,0);
: LINPUT "Graphic CRT is at what address?" ?-P9$
: IF VER(P9$,"HHH")<3 OR POS("C4" = STR(P9$,,1))=0 THEN 107
0108 SELECT #15 <P9$>
: ERRORGOTO 107
0109 $OPEN #15
: ERRORGOTO 107
0110 SELECT PLOT <P9$>
0120 PRINT AT(3,0,70);HEX(06);
0130 REM % INITIAL CONDITIONS
0132 GOSUB '50(999,999,999,999,999,-1)
: P0$=P1$
0134 FOR I=1 TO 100
: P$(I)=P0$
: NEXT I
0136 X=400
: Y=256
: R=50
: S=6
: D=+1
0138 PLOT <,,HEX(E5E103)>
0140 SELECT D
0142 GOSUB 650
0150 REM % MAIN LOOP
0155 GOSUB '53(X,Y,R,S,P,D)
0160 GOSUB '51(X,Y,R,S,P)
0165 GOSUB '52(X,Y,S,D)
0170 X0=X
: Y0=Y
: R0=R
: S0=S
: P0=P
: D0=D
0175 KEYIN K$,,180
: GOTO 175
0180 ON VAL(K$) GOSUB ,,715,705,720,725,710,8,755,751,730,740,745,735,805,,,,7
16,706,721,726,711,,,,731,741,746,736,9999
: ELSE GOTO 175
0185 IF VAL(K$)=10 THEN 195
0190 KEYIN K$,190,180
0195 IF VAL(K0$)=10 THEN 210
0200 GOSUB '51(X0,Y0,R0,S0,P0)
0205 GOSUB '52(X0,Y0,S0,-1)
0210 K0$=K$
0215 GOTO 155
0400 REM %CALCULATE IMAGE
0404 DIM X1,Y1,R1,S1,T1,I1,P1,R1(2,2),C1(50,2)
0408 DEFFN '51(X1,Y1,R1,S1,P1)
0409 MAT REDIM C(S1,2),C1(S1,2)
0412 T1=360/S1
0416 FOR I1=1 TO S1
0420 C1(I1,1)=R1*COS((I1-1)*T1)
0424 C1(I1,2)=R1*SIN((I1-1)*T1)
0428 NEXT I1
0432 R1(1,1),R1(2,2)=COS(P1)
: R1(1,2)=+SIN(P1)
: R1(2,1)=-SIN(P1)
0436 MAT C=C1*R1
0440 RETURN
0444 REM %PLOT
0448 DIM I1,D1,S1,X0,X1,Y0,Y1
0452 DEFFN'52(X1,Y1,S1,D1)
0456 IF D1>0 THEN PLOT <,,HEX(E1)>,<,,R>
: ELSE PLOT <,,HEX(E2)>,<,,R>
0460 X0=ROUND((C(1,1),0)
: Y0=ROUND((C(1,2),0)
0464 PLOT <X1+X0,Y1+Y0,U>
0468 FOR I1=2 TO S1+1
0472 IF I1<=S1 THEN 476
: X1=ROUND((C(1,1),0)
: Y1=ROUND((C(1,2),0)
: GOTO 480
0476 X1=ROUND((C(I1,1),0)
: Y1=ROUND((C(I1,2),0)
0480 PLOT <X1-X0, Y1-Y0, D>
0482 X0=X1
: Y0=Y1
0484 NEXT I1
0488 RETURN
0500 REM % PACK
0502 DIM X1,Y1,R1,S1,P1,D1,P1$12
0505 DEFFN'50(X1,Y1,R1,S1,P1,D1)
: PACK (-###) P1$ FROM X1,Y1,R1,S1,P1,D1
: RETURN
0550 REM % MENU
0555 DIM R1,C1
0560 DEFFN'53(X,Y,R,S,P,D)
0561 R1=2
: C1=16
0565 PRINT AT(R1,C1);"Co-orinates of Centroid:"
0570 PRINT TAB(C1+5);
: PRINTUSING 600,"X:",X
0575 PRINT TAB(C1+5);
: PRINTUSING 600,"Y:",Y
0580 PRINT
: PRINT TAB(C1);
: PRINTUSING 605,"Number of sides:",S
0585 PRINT TAB(C1);
: PRINTUSING 605,"Diameter:",2*R
0590 PRINT TAB(C1);
: PRINTUSING 610,"Angle of rotation:",P,"`"
0595 RETURN
0600 %## ###
0605 %################### -### ###
0610 %################### +### ###
0649 REM % SF KEY MENU
0650 PRINT AT(11,0);TAB(25);HEX(0E);"\D3\C6\A0\CB\C5\D9\D3\BA"
: PRINT
0651 PRINT TAB(5); "'5 - Move Down";TAB(40);"'6 - Move Up"
0652 PRINT TAB(5);"'12 - Move Right";TAB(40);"'13 - Move Left"
0653 PRINT TAB(5);"'4 - Rotate left";TAB(40);"'7 - Rotate right"
0654 PRINT TAB(5);"'11 - Increase Size";TAB(40);"'14 - Decrease Size"
0655 PRINT TAB(5);"'3 - Increase number of sides";TAB(40);"'19 - Decrease num
ber of sides"
0656 PRINT TAB(5);"'10 - Save Polygon";TAB(40);"'9 - Delete Polygon"
0657 PRINT TAB(5);"'15 - Re-draw Entire Screen";TAB(40);"'31 - Exit Program"
0658 PRINT TAB(12); "(Use upper case SF keys for more coarse adjustments)"
0659 RETURN
0700 REM % ADJUSTMENT SUBROUTINES
0704 REM '4,'20 - ROTATE LEFT
0705 P=P+1
: RETURN
0706 P=P+10
: RETURN
0709 REM '7,'23 - ROTATE RIGHT
0710 P=P-1
: RETURN
0711 P=P-10
: RETURN
0714 REM '3,'19 - NUMBER OF SIDES
0715 S=MIN(S+1,50)
: RETURN
0716 S=MAX(S-1,2)
: RETURN
0719 REM '5,'22 - DOWN
0720 Y=MAX(Y-1,ABS(R))
: RETURN
0721 Y=MAX(Y-10,ABS(R))
: RETURN
0724 REM '6,'22 - UP
0725 Y=MIN(Y+1,512-ABS(R))
: RETURN
0726 Y=MIN(Y+10,512-ABS(R))
: RETURN
0729 REM '11,'27 - INCREASE SIZE
0730 R=MIN(R+1,800-X,512-Y)
: RETURN
0731 R=MIN(R+10,800-X,512-Y)
: RETURN
0734 REM '14,'30 - DECREASE SIZE
0735 R=MAX(R-1,0)
: RETURN
0736 R=MAX(R-10,0)
: RETURN
0739 REM '12,'28 - MOVE RIGHT
0740 X=MIN(X+1,800-ABS(R))
: RETURN
0741 X=MIN(X+10,800-ABS(R))
: RETURN
0744 REM '13,'29 - MOVE LEFT
0745 X=MAX(X-1,ABS(R))
: RETURN
0746 X=MAX(X-10,ABS(R))
: RETURN
0750 REM '10 - SAVE POLYGON
0751 GOSUB '55(X,Y,R,S,P,+1)
: RETURN
0754 REM '9 - DELETE POLYGON
0755 GOSUB '55(X,Y,R,S,P,-1)
: RETURN
0800 REM % REDRAW
0801 DIM X2,Y2,R2,S2,P2,D2,I2
0805 PLOT <,,HEX(03E5)>
0806 FOR I2=1 TO 100
0807 IF P$(I2)=P0$ THEN 825
0810 UNPACK (-###) P$(I2) TO X2,Y2,R2,S2,P2,D2
0815 GOSUB '51(X2,Y2,R2,S2,P2)
0820 GOSUB '52(X2,Y2,S2,D2)
0825 NEXT I2
: RETURN
0850 REM % STORE POLYGON
0851 DIM L2$2,X2,Y2,R2,S2,P2,D2
0855 DEFFN'55(X2,Y2,R2,S2,P2,D2)
: GOSUB '50(X2,Y2,R2,S2,P2,-D2)
0860 MAT SEARCH P$(),=P1$ TO L2$ STEP 12
0865 IF L2$>HEX(0000) THEN STR(P$(),VAL(L2$,2),12)=P0$
0870 GOSUB '50(X2,Y2,R2,S2,P2,D2)
0875 MAT SEARCH P$(),=P0$ TO L2$ STEP 12
0880 IF L2$>HEX(0000) THEN STR(P$(),VAL(L2$,2),12)=P1$
: ELSE STOP "ARRAY FULL STUBBED." #
0885 RETURN
9999 DEFFN'31
: $CLOSE
: LOAD T "START"