start tok64 d64-hKiBCs
1 REM program: graphics factory
2 REM author : marco h. westerweel
3 REM (c)1989, all rights reserved
4 REM haaksbergen, the netherlands
5 :
10 PRINT"{clear}":DIMsc$(23,38),s1$(23),gl$(54),cr$(46),d(255):dl$=CHR$(20)
15 z$="{space*38}":cy$="{reverse on}{156} ":rt$=CHR$(13):cl$="{156}"
20 rl$="{right*38}":sq$="{home}{down*23}"
25 bo=4:ba=15:ca=4:cx=0:pa=1:op$=LEFT$(sq$,16)+"{right*2}{reverse on}{red}copy{right*5}"
30 op$=op$+"modify"+rt$+"{down*2}{reverse on}{red}{right*2}crunch{right*3}replace"+rt$+"{down*2}{right*2}{reverse on}{red}scratch{right*2}view"
35 r$(1)=LEFT$(sq$,16)+"{right*2}{reverse off}{black}copy":r$(2)=LEFT$(sq$,16)+LEFT$(rl$,11)+"{reverse off}{black}modify"
40 r$(3)=sq$+"{up*5}{right*2}{reverse off}{black}crunch":r$(4)=sq$+LEFT$(rl$,11)+"{up*5}{reverse off}{black}replace"
45 r$(5)=sq$+"{up*2}{right*2}{reverse off}{black}scratch":r$(6)=sq$+LEFT$(rl$,11)+"{up*2}{reverse off}{black}view":cu$="{up}{down}{left}{right}"
50 FORdd=1TO255:d(dd)=9:NEXT:FORdd=1TO6:READd2:d(d2)=dd:NEXT
55 FORdd=1TO16:READd2:d(d2)=7:NEXT:FORdd=135TO138:d(dd)=8:NEXT
60 FORdd=1TO41:READd2:d(d2)=10:NEXT
65 DATA 157,29,17,145,18,146,5,28,30,31,129,144,149,150,151,152,153,154,155
70 DATA 156,158,159,1,2,3,4,6,7,8,9,10,11,12,13,14,15,16,19,20,21,22,23,24,25
75 DATA 26,27,34,44,58,59,128,130,131,132,133,134,139,140,141,142,143,147,148
80 bo=4:ba=15:ca=4:cx=0:GOSUB585:GOSUB590:bl$="{right*2}{reverse on}{blue}{space*16}"
85 PRINT"{home}{down}{reverse off}{black} setting up{.*3} "
90 OPEN8,8,8,"0:gf/dir,s,r":FORgl=1TO54:INPUT#8,gl$(gl)
95 IFgl$(gl)<>"*"THENlg=lg+1
100 NEXT:CLOSE8
105 fi$="cr/gf intro":GOSUB850:GOSUB870:FORw=1TO1500:NEXTw
110 OPEN8,8,8,"0:cr/gf menu,s,r":FORs1=1TO23:INPUT#8,s1$:INPUT#8,s2$
115 s1$(s1)=s1$+s2$:s1$="":s2$="":NEXT:CLOSE8:GOSUB590
120 pa=1:sq=1:rl=1:qx=1:sx=1:rx=1:rv$="{reverse on}":co$="{156}":hc$=" ":ch$="{reverse on}{156} "
125 cy$=sc$(1,1):PRINT"{home}";:FORs1=1TO23:PRINT"{right}"s1$(s1):NEXT
130 PRINTsq$"{down}{reverse on}{156}{space*2}use {black}crsr{156} & {black}return{156} to enter commands{space*2}{up}"
135 IFca$="c"THENIF(ro=7ORro=2)THENca$="":lg=lg-1
140 PRINT"{home}{down}"SPC(35)"{reverse off}{black}new"
145 GETgt$:IFgt$<>rt$THENIFgt$<>"{left}"THEN145
150 IFgt$=rt$THENGOSUB510:ro=7:GOSUB360:IFca$="c"THEN120
155 IFgt$=rt$THENIFca$="a"THEN570
160 IFgt$="{left}"THENPRINT"{home}{down}"SPC(30)"{reverse off}{black}old{right*2}{reverse on}{red}new":GOTO165
165 GETgt$:IFgt$<>rt$ANDgt$<>"{right}"THEN165
170 IFgt$="{right}"THENPRINT"{home}{down}"SPC(30)"{reverse on}{red}old":GOTO140
175 IFgt$=rt$THENg2=1:g1=6:GOSUB340
180 PRINT"{home}{down*4}"SPC(11)"{reverse off}{black}advance"
185 GETgt$:IFgt$<>rt$THENIFgt$<>"{down}"THENIFgt$<>"{left}"THEN185
190 IFgt$=rt$THENIFgl$(g1)<>"*"THENg1=g1+6:g2=g1-5:GOSUB340:GOTO185
195 IFgt$="{left}"THEN210
200 IFgt$="{down}"THENtt=1:PRINT"{home}{down*4}{right*2}{reverse on}{red}reverse{right*2}{reverse on}{red}advance":GOTO260
205 GOSUB340:GOTO185
210 PRINT"{home}{down*4}{right*2}{reverse off}{black}reverse{right*2}{reverse on}{red}advance"
215 GETgt$:IFgt$<>rt$THENIFgt$<>"{down}"THENIFgt$<>"{right}"THEN215
220 IFgt$=rt$THENg1=g1-6:g2=g1-5:GOSUB340:GOTO215
225 IFgt$="{right}"THENPRINT"{home}{down*4}{right*2}{reverse on}{red}reverse":GOTO180
230 IFgt$="{down}"THENtt=1:PRINT"{home}{down*4}{right*2}{reverse on}{red}reverse{right*2}advance":GOTO260
235 GETgt$:IFgt$<>"{down}"THENIFgt$<>"{up}"THENIFgt$<>rt$THEN235
240 IFgt$="{down}"THENtt=tt+1:IFtt>6THENtt=6:GOTO260
245 IFgt$="{up}"THENtt=tt-1:IFtt<1THENtt=0:GOSUB355:GOTO180
250 IFgt$=rt$ANDgl$(fl)="*"THEN235
255 IFgt$=rt$THEN270
260 PRINTLEFT$(sq$,8);:FORgx=g2TOg1:PRINT"{reverse on}{blue}{right*2}"gl$(gx):NEXT
265 fl=g2+tt-1:PRINTLEFT$(sq$,7+tt)"{reverse off}{black}{right*2}"gl$(fl):GOTO235
270 ro=1:PRINTr$(1)
275 tg=0:GETgt$:FORgt=1TO4:IFgt$=MID$(cu$,gt,1)THENtg=gt:gt=4
280 NEXT:IFgt$=rt$ANDro<>2THENGOSUB360:IFca$="c"THEN120
285 IFgt$=rt$THEN395
290 IFtg=0THEN275
295 ONtgGOTO300,310,320,330
300 ro=ro-2:IFro<1THENro=1
305 GOTO335
310 ro=ro+2:IFro>6THENro=6
315 GOTO335
320 ro=ro-1:IFro<1THENro=1
325 GOTO335
330 ro=ro+1:IFro>6THENro=6
335 PRINTop$r$(ro):GOTO275
340 IFg1<6THENg1=6:g2=1:GOTO350
345 IFg1>53THENg1=54:g2=49
350 PRINTLEFT$(sq$,8);:FORgl=1TO6:PRINTbl$:NEXT
355 PRINTLEFT$(sq$,8);:FORgl=g2TOg1:PRINT"{right*2}{reverse on}{blue}"gl$(gl):NEXT:RETURN
360 PRINTsq$SPC(24)"{up*2}{reverse off}{black}cancel{right*2}{reverse on}{red}accept"
365 GETgt$:IFgt$<>rt$THENIFgt$<>"{right}"THEN365
370 IFgt$=rt$THENca$="c":RETURN
375 IFgt$="{right}"THENPRINTsq$SPC(24)"{up*2}{reverse on}{red}cancel{right*2}{reverse off}{black}accept"
380 GETgt$:IFgt$<>rt$THENIFgt$<>"{left}"THEN380
385 IFgt$="{left}"THEN360
390 IFgt$=rt$THENca$="a":RETURN
395 ONroGOTO460,400,915,495,445,425,570
400 IFLEFT$(gl$(fl),3)="cr/"THEN120
405 GOSUB510:fx$=fi$:IFlg=54THEN120
410 GOSUB360:IFca$="c"THEN120
415 IFgl$(fl)<>f2$THENfi$=gl$(fl):GOSUB845
420 GOSUB870:GOTO605
425 IFgl$(fl)<>f2$THENfi$=gl$(fl):GOSUB845
430 GOSUB870
435 GETgt$:IFgt$<>CHR$(133)THEN435
440 GOSUB590:GOTO120
445 lg$=gl$(fl):lg=lg-1:IFlg=0THENlg=1:GOTO120
450 GOSUB590:PRINT"{home}{down}{reverse off}{black} scratching{.*3} ";lg$:gl$(fl)=gl$(lg+1):gl$(lg+1)="*"
455 OPEN15,8,15:PRINT#15,"s0:"+lg$:CLOSE15:GOSUB590:GOSUB830:GOTO120
460 IFLEFT$(gl$(fl),3)<>"cr/"THEN120
465 IFgl$(fl)<>f2$THENfi$=gl$(fl):GOSUB845
470 GOSUB590:PRINT"{home}{down}{reverse on}{156}{.*3}insert new disk & press"rt$"{down}{right*3}{reverse on}{black} c {156} to copy ";fi$
475 GETc$:IFc$<>"c"THEN475
480 GOSUB785:PRINT"{home}{down*4}{reverse on}{156}{.*3}insert original disk & press {black}return"
485 GETrr$:IFrr$<>rt$THEN485
490 GOSUB590:GOTO120
495 IFLEFT$(gl$(fl),3)="cr/"THEN120
500 IFgl$(fl)<>f2$THENfi$=gl$(fl):GOSUB845
505 GOSUB870:GOTO605
510 fi$="":lg=lg+1:IFlg=55THENlg=54:RETURN
515 PRINTsq$"{down}{reverse on}{156} {black}return{156}:accepts name, {black}del{156}:deletes name{up}"
520 PRINT"{home}{down*10}"SPC(22)"{black}{reverse off}?{left}";:FORw=1TO100:NEXTw
525 PRINT"{reverse on}{red}?{left}";:FORw=1TO100:NEXTw
530 GETnf$:IF(nf$<"a"ORnf$>"z")AND(nf$<"0"ORnf$>"9")THEN520
535 IFLEN(fi$)<15THENPRINTnf$;:fi$=fi$+nf$:IFLEN(fi$)<15THENPRINT"{black}{reverse off}?{reverse on}{red}{left}";
540 GETnf$:IFnf$=rt$ANDLEN(fi$)<16THENPRINT"{reverse on}{red} ":RETURN
545 IFnf$<>dl$THEN555
550 IFfi$<>""THENfi$=LEFT$(fi$,LEN(fi$)-1):PRINT"{black}{reverse off}{left}?{reverse on}{red} {left*2}";:IFfi$=""THEN520
555 IF(nf$>"/"ANDnf$<":")ORnf$=" "THEN535
560 IFnf$<"a"ORnf$>"z"THEN540
565 GOTO535
570 GOSUB590:PRINT"{home}{down}{reverse off}{black} initializing{.*3} "
575 FORs1=1TO23:FORs2=1TO38:sc$(s1,s2)="{reverse on}{156} ":NEXT:NEXT:GOSUB585:GOSUB590
580 PRINT"{home}{right}"cx$:cy$=sc$(1,1):GOSUB765:GOSUB895:GOTO605
585 POKE53280,bo:POKE53281,ba:cx$="{reverse off}{black}*":RETURN
590 zx=0:PRINT"{home}";:FORz=1TO24:PRINTcl$"{reverse on} "z$:zx=zx+40:POKE1023+zx,160
595 POKE55295+zx,ca:NEXT:PRINTcl$"{reverse on} "z$"{up}":POKE2023,160:POKE56295,ca
600 RETURN
605 GETpc$:IFpc$=""THENGOSUB775:GOTO605
610 gp=d(ASC(pc$)):IFgp=10THEN605
615 ONgpGOSUB675,645,630,660,690,690,695,705,700
620 IFpc$=CHR$(137)THEN120
625 GOTO605
630 IFsq<1ORsq>22THEN640
635 sq=sq+1:GOSUB740
640 RETURN
645 IFrl<1ORrl>37THEN655
650 rl=rl+1:GOSUB740
655 RETURN
660 IFsq<2ORsq>24THEN670
665 sq=sq-1:GOSUB740
670 RETURN
675 IFrl<2ORrl>39THEN685
680 rl=rl-1:GOSUB740
685 RETURN
690 rv$=pc$:ch$=rv$+co$+hc$:GOSUB765:RETURN
695 co$=pc$:ch$=rv$+co$+hc$:GOSUB765:RETURN
700 hc$=pc$:ch$=rv$+co$+hc$:GOSUB765:RETURN
705 pg=ASC(pc$)-134:ONpgGOTO730,725,710,715
710 GOSUB785:GOSUB590:GOTO735
715 PRINTsq$"{down}{reverse on}{156}{space*2}{reverse off}{black} garbage collection {reverse on}{156}{.*3} please hold{space*2}{up}":th=FRE(0)
720 GOSUB870:GOTO735
725 pa=1:GOTO735
730 pa=2:GOSUB765
735 RETURN
740 qs=sq:PRINTLEFT$(sq$,sx)LEFT$(rl$,rx)cy$LEFT$(sq$,sq)LEFT$(rl$,rl)cx$
745 sx=sq:qx=qs:rx=rl:ONpaGOTO750,755
750 cy$=sc$(qx,rx):GOTO760
755 cy$=ch$:sc$(qx,rx)=cy$
760 RETURN
765 PRINTLEFT$(sq$,sq)LEFT$(rl$,rl)ch$
770 sc$(qx,rx)=ch$:cy$=sc$(qx,rx):RETURN
775 PRINTLEFT$(sq$,sq)LEFT$(rl$,rl)cx$:FORw=1TO100:NEXTw
780 PRINTLEFT$(sq$,sq)LEFT$(rl$,rl)cy$:FORw=1TO100:NEXTw:RETURN
785 GOSUB590:IFro=2THENfi$=fx$:fx$="":GOTO795
790 IFro=4THENdn$=fi$:fi$="replacement file"
795 PRINT"{home}{down}{reverse off}{black} saving{.*3} ";fi$" ":OPEN8,8,8,"0:"+fi$+",s,w"
800 IFLEFT$(fi$,3)="cr/"THENFORcr=1TO46:PRINT#8,cr$(cr):NEXT:GOTO810
805 FORs1=1TO23:FORs2=1TO38:PRINT#8,sc$(s1,s2):NEXT:NEXT
810 CLOSE8:IFro<>4THENIFro<>1THENgl$(lg)=fi$:GOSUB830:GOTO825
815 IFro=1THEN825
820 OPEN15,8,15:PRINT#15,"s0:"+dn$:PRINT#15,"r0:"+dn$+"="+fi$:CLOSE15:fi$=dn$
825 f2$=fi$:RETURN
830 OPEN8,8,8,"0:dummy name,s,w":FORgl=1TO54:PRINT#8,gl$(gl):NEXT
835 CLOSE8:OPEN15,8,15:PRINT#15,"s0:gf/dir"
840 PRINT#15,"r0:gf/dir=dummy name":CLOSE15:RETURN
845 GOSUB590:PRINT"{home}{down}{reverse off}{black} loading{.*3} ";fi$" "
850 OPEN8,8,8,"0:"+fi$+",s,r"
855 IFLEFT$(fi$,3)="cr/"THENFORcr=1TO46:INPUT#8,cr$(cr):NEXT:GOTO865
860 FORs1=1TO23:FORs2=1TO38:INPUT#8,sc$(s1,s2):NEXT:NEXT
865 CLOSE8:f2$=fi$:cy$=sc$(1,1):ch$=sc$(1,1):RETURN
870 bo=4:ba=15:ca=4:cx=0:GOSUB585:GOSUB590:PRINT"{home}";
875 IFLEFT$(fi$,3)<>"cr/"THEN885
880 FORcr=1TO46STEP2:PRINT"{right}"cr$(cr);cr$(cr+1):NEXT:GOTO890
885 FORs1=1TO23:PRINT"{right}";:FORs2=1TO38:PRINTsc$(s1,s2);:NEXT:PRINT"":NEXT
890 f2$=fi$:IFro=0THEN910
895 PRINTsq$"{down}{reverse on}{156}";:ONroGOTO895,900,895,900,895,905,900
900 PRINT" {black}f2{156}:save, {black}f4{156}:gar/col, {black}f5{156}:paint, {black}f7{156}:plot{up}":GOTO910
905 PRINT"{space*3}press {black}f1{156} to return to options menu.{up}"
910 RETURN
915 cr=0:IFLEFT$(gl$(fl),3)="cr/"THEN120
920 lg=lg+1:IFlg=55THENlg=54:GOTO120
925 IFgl$(fl)<>f2$THENfi$=gl$(fl):GOSUB845
930 GOSUB590:IFLEN(fi$)>13THENfi$=LEFT$(fi$,13)
935 fi$="cr/"+fi$:PRINT"{home}{down}{reverse off}{right}{black} crunching{.*3} ";fi$:OPEN8,8,8,"0:"+fi$+",s,w"
940 s1$="":s2$="":FORs1=1TO23:s1$=sc$(s1,1):sc$(s1,1)="":l1$=LEFT$(s1$,2)
945 rv$=LEFT$(l1$,1):co$=RIGHT$(l1$,1):FORs2=2TO19:s2$=sc$(s1,s2)
950 sc$(s1,s2)="":l2$=LEFT$(s2$,2):IFl2$=l1$THENs1$=s1$+RIGHT$(s2$,1):GOTO990
955 l1$=l2$:vr$=LEFT$(l2$,1):oc$=RIGHT$(l2$,1)
960 IFvr$<>rv$THENIFoc$<>co$THENs1$=s1$+s2$:rv$=vr$:co$=oc$:GOTO990
965 IFvr$=rv$THEN975
970 rv$=vr$:s1$=s1$+vr$
975 IFoc$=co$THEN985
980 co$=oc$:s1$=s1$+oc$
985 s1$=s1$+RIGHT$(s2$,1)
990 NEXT:sx$=s1$:s1$=sc$(s1,20):sc$(s1,20)="":l1$=LEFT$(s1$,2)
995 rv$=LEFT$(s1$,1):co$=RIGHT$(l1$,1):FORs2=21TO38:s2$=sc$(s1,s2)
1000 sc$(s1,s2)="":l2$=LEFT$(s2$,2)
1005 IFl2$=l1$THENs1$=s1$+RIGHT$(s2$,1):GOTO1045
1010 l1$=l2$:vr$=LEFT$(l2$,1):oc$=RIGHT$(l2$,1)
1015 IFvr$<>rv$THENIFoc$<>co$THENs1$=s1$+s2$:rv$=vr$:co$=oc$:GOTO1045
1020 IFvr$=rv$THEN1030
1025 rv$=vr$:s1$=s1$+vr$
1030 IFco$=oc$THEN1040
1035 co$=oc$:s1$=s1$+oc$
1040 s1$=s1$+RIGHT$(s2$,1)
1045 NEXT:PRINT#8,sx$:PRINT#8,s1$:cr=cr+2:cr$(cr-1)=sx$:sx$="":cr$(cr)=s1$
1050 s1$="":NEXT:CLOSE8:GOSUB590:gl$(lg)=fi$:GOSUB830:f2$=fi$:cr=0:GOTO120
stop tok64
(bastext 1.0)