1 ' PGM-PLUS (RAM: max. 64kByte)(c) by G.Schwandtner 1993 V2.1
5 IFNWPGM THEN320
7 IFDBS>0THEN400
10 DEFSEG=0:MD=0:IFPEEK1825=2ANDPEEK1867=0THENMD=1
15 IFPEEK1727+PEEK1728<>0THEN100
20 A=PEEK1712+256*PEEK1713+65536*PEEK1714+150:POKE1727,A MOD256:POKE1728,A MOD65536\256:POKE1729,A\65536
30 POKE1733,PEEK1715:POKE1734,PEEK1716:POKE1735,PEEK1717
100 NWPGM=0:PB=PEEK1712+PEEK1713*256+150:PE=PEEK1715+PEEK1716*256+PEEK1717*65536:GOS=0:DB=0
105 IFPEEK1685+PEEK1686*256+PEEK1687*65536<>PEEK1688+PEEK1686*256+PEEK1687*65536THENRETURN
110 IFPB=PE THENIFMD=1THENCLS:PRINT">        < NEW PRG? [Y/N]";:IFINPUT$(1)="Y"THEN245ELSECLS:END ELSEEND
115 PP=PEEK1858+PEEK1859*256+PEEK1860*65536:IFPP>=PB ANDPP<=PE THENSPG=(PP-PB)/15ELSESPG=0
120 N$="":FORA=SPG*15+PB TOSPG*15+PB+7:N$=N$+CHR$(PEEK(A+7)):NEXTA:N$=LEFT$(N$+"        ",8)
130 IFMD=1THENCLS:PRINT">";N$;"< 1>Ren 2>Edit 3>Add   4>Del .>RUN 0>MEMO كلمن>Sel >?";CHR$(29);:GOTO140
135 CLS:PRINT">";N$;"< .>RUN 0>MEMO كلمن>Sel";CHR$(29);:GOTO140
140 $=INPUT$(1)
141 IF$=CHR$(29)THENSPG=0:GOTO120
142 IF$=CHR$(28)THENSPG=(PE-PB)/15-1:GOTO120
143 IF$="0"THENGOSUB400:GOTO10
145 IF$=CHR$(30)THENIFSPG>0THENSPG=SPG-1:GOTO120ELSE140
147 IF$=CHR$(31)THENIFPB+SPG*15<PE-15THENSPG=SPG+1:GOTO120ELSE140
149 IF$="."THENA=SPG*15+PB:POKE1858,A MOD256:POKE1859,A\256:POKE1860,0:CLS:GOTO"LIB1:"+N$
150 IFMD THENONVAL($)GOTO200,170,240,300
160 CLS:END
170 P=PB+SPG*15
180 POKE1771,P MOD256:POKE1772,P\256:POKE1773,0
185 POKE1618,P MOD256:POKE1619,P\256:POKE1620,0
190 END
200 LOCATE1,0:INPUT@8;N$
210 IFLEN(N$)>8THEN120
215 N$=LEFT$(N$+"        ",8)
220 FORA=1TO8:POKEA+PB+SPG*15+6,ASC(MID$(N$,A)):NEXTA
230 IFGOS=1THENGOS=0:RETURN ELSE120
240 LOCATE0,1:PRINT"Add new program ?              ";:$=INPUT$(1,@):IF$<>"Y"AND$<>"y"THEN110
245 IFFRE0<200ORFRE1<17THENPRINT"OM-Error !!":GOTO120
250 IFPEEK1700=0THENPOKE1700,255:POKE1701,PEEK1701-1ELSEPOKE1700,PEEK1700-1
255 CLEAR
260 PA=PEEK1709+PEEK1710*256:PE=PEEK1715+PEEK1716*256+PEEK1717*65536:PR=PA-15
265 FORA=PA-15TOPE-16:POKEA,PEEK(A+15):NEXTA
270 PW=PEEK(PE-15)+PEEK(PE-14)*256-1:POKEPE-12,PEEK(PE-15):POKEPE-11,PEEK(PE-14)
275 POKEPW,0:POKEPE-15,PW MOD256:POKEPE-14,PW\256
280 POKE1709,PR MOD256:POKE1710,PR\256:POKE1712,PA MOD256:POKE1713,PA\256
285 AP=PEEK1616+PEEK1617*256-15:POKE1771,AP MOD256:POKE1772,AP\256:POKE1616,PEEK1771:POKE1617,PEEK1772
290 PB=PA+150:SPG=(PE-PB)/15-1
295 GOS=1:GOSUB200
297 MD=1:GOTO20
300 LOCATE0,1:PRINT"Delete program ?               ";:$=INPUT$(1,@):IF$<>"Y"AND$<>"y"THEN130
305 A=PB+SPG*15:B=PEEK(A+3)+PEEK(A+4)*256:B=B+1:POKEA+3,B MOD256:POKEA+4,B\256
310 CLS:PRINT"NEW program and then restart    this program. AVOID CLEAR!!!"
315 NWPGM=1:GOTO170
320 PA=PEEK1709+PEEK1710*256:P=PB+SPG*15
325 IFPEEK(P)+PEEK(P+1)*256<>PEEK(P+3)+PEEK(P+4)*256-1THEN310ELSECLS:PRINT"Deleting program.";
330 FORA=P-1TOPA STEP-1:POKEA+15,PEEK(A):NEXTA
335 PA=PA+15
340 POKE1709,PA MOD256:POKE1710,PA\256
345 PA=PA+15:POKE1712,PA MOD256:POKE1713,PA\256
350 P=PEEK1771+PEEK1772*256+15:POKE1771,P MOD256:POKE1772,P\256:POKE1616,P MOD256:POKE1617,P\256
360 MD=1:GOTO20
400 DEFSEG=0:MD=0:IFPEEK1825=2ANDPEEK1867=0THENMD=1
410 DBP=PEEK1709+PEEK1710*256:POKE1613,PEEK1703:POKE1614,PEEK1704:GOSUB480:DBN=1
415 IFDBS>0THEN600
420 CLS:IFMD=1THENPRINT"1>Next 2>First 3>Add 4>Del      0>Exit/Act. Selected DB:";DBN;ELSEPRINT"1>Next 2>First 0>Exit/Activate  Selected DB:";DBN;
430 $=INPUT$(1)
435 IFMD=1THENONVAL($)-2GOTO500,550
440 ONVAL($)GOTO455,400
445 IFVAL($)=0THENGOSUB480:IF$="E"THENCLS:END ELSERETURN
450 GOTO430
455 GOSUB460:GOTO420
460 RESTORE#CHR$(26),,465
465 A=PEEK1613+PEEK1614*256+1:IFA<PEEK1706+PEEK1707*256THENPOKE1613,A MOD256:POKE1614,A\256:DBN=DBN+1ELSEDBN=1:POKE1613,PEEK1703:POKE1614,PEEK1704:GOSUB480
470 RETURN
480 A=PEEK1613+PEEK1614*256:IFA=0THENRETURN
481 POKEDBP,PEEK1613:POKEDBP+1,PEEK1614:RESTORE#CHR$(26),,485
485 A=PEEK1613+PEEK1614*256+1:POKEDBP+3,A MOD256:POKEDBP+4,A\256
487 POKE1613,PEEKDBP:POKE1614,PEEK(DBP+1)
490 RETURN
500 POKEDBP+3,PEEK1706:POKEDBP+4,PEEK1707
502 RESTORE#CHR$(26),,505
505 A=PEEK1613+PEEK1614*256+1
510 WRITE#"AB":POKEA-1,26
520 POKE1613,A MOD256:POKE1614,A\256:DBN=DBN+1:GOSUB480:WRITE#
530 GOTO400
550 A=PEEK1613+PEEK1614*256:IF A<=PEEK1703+PEEK1704*256 THEN CLS:PRINT "First DB cannot be removed";:$=INPUT$(1,@):GOTO 420
555 IFPEEK(A-1)<>26ORPEEK(A)<>26THENCLS:PRINT"Delete this DB with NEW#        before using this function !";:$=INPUT$(1,@):GOTO420
560 WRITE#"A":POKEA-1,65:POKEA+1,13:POKEA+2,10:POKE1613,A MOD256:POKE1614,A\256:WRITE#:GOTO400
600 DBSS=DBS:FORDBSC=1TODBS-1:GOSUB460:GOSUB480:IFDBN=1ANDDBSS<>1THENDBSC=DBSS
605 NEXTDBSC
607 IFDBN=1ANDDBSS<>1THENDBS=-1ELSEDBS=0
610 RETURN