Atari 8-bit Source code

1 REM ****************************
2 REM * Ludek Burian *
3 REM * M.Majerove 33 *
4 REM *798 11 Prostejov *
5 REM *__________________________*
6 REM * NADATA.BAS ver.0 *
7 REM * B&B SOFT (7.7.90) *
8 REM * AK Prostejov *
9 REM ****************************
10 REM
13 DIM A$(8),​D$(16),​H$(20),​A(20),​B(3),​Q$(1090)
15 GOSUB 5000
17 TUT1=0
18 POKE 16,​64
20 CLOSE #2:​OPEN #2,​4,​0,​"K:​"
30 ? "Cislo disku s databazi(1/2)"
40 GET #2,​A:​IF A=49 THEN D$="D1:​":​GOTO 70
50 IF A=50 THEN D$="D2:​":​GOTO 70
60 GOTO 40
70 REM
100 REM
110 ? "Nazev databaze ";:​INPUT A$
120 D$(4)=A$:​D$(LEN(D$)+1)=".DAT"
130 TRAP 150
140 CLOSE #1:​OPEN #1,​4,​0,​D$:​GOTO 160
150 ?:​? "Na disku neni tato database !":​?:​GOTO 100
160 NOTE #1,​Q,​W:​GET #1,​A:​GET #1,​B:​IF A<>82 OR B<>86 THEN ?:​? "Toto neni database MINI OFFICE!":​?:​CLOSE #1:​GOTO 100
170 GET #1,​A:​GET #1,​B:​POC=A+B*256
200 REM Nacitani nazvu
205 F=0:​? ""
210 FOR I=1 TO 20:​GET #1,​A:​A(I)=A:​S=1:​IF A=192 THEN S=0
215 IF S THEN ? I;" ";
220 IF S AND A<61 THEN ? "ALPHA ";
225 IF S AND A=64 THEN ? "INTGR ";
230 IF S AND A=65 THEN ? "DECIM ";
235 IF S AND A=128 THEN ? "DATE ";
240 IF S AND (A=66 OR A=67) THEN ? "FORM ";:​F=F+1
250 FOR ZP=1 TO 20:​GET #1,​B:​IF S THEN ? CHR$(B);:​IF B=155 THEN S=0
260 NEXT ZP:​IF A<61 THEN ? "";A
270 NEXT I:​?
280 IF F>0 THEN FOR I=1 TO F:​FOR ZP=1 TO 40:​GET #1,​A:​NEXT ZP:​NEXT I
290 ? "V poradku (A/N)?":​GET #2,​A
300 IF A=78 THEN ?:​? "Tak znova!":​?:​GOTO 100
310 IF A<>65 THEN ? "";:​GOTO 290
320 TRAP 320:​? "Kam zapisovat cislo disku(0=NIC)";:​INPUT A
330 IF A=0 THEN B(1)=0:​GOTO 370
340 IF A(A)>60 THEN 320
350 IF A(A)<4 THEN ? "Toto pole ma jenom ";A(A);" pozic. Chces presto zapsat?";:​GET #2,​ZP:​IF ZP<>65 THEN 320
360 B(1)=A
370 TRAP 370:​? "Kam zapisovat nazev pole(0=NIC)";:​INPUT A
372 IF A THEN 380
375 ?:​?:​? "Kdyz nechces zapsat tuto polozku,​ tak me nadrazdi a nahrej si jinej program!!":​? "";:​GOTO 370
380 IF A(A)>60 OR A=B(1) THEN 370
390 IF A(A)<12 THEN ? "Toto pole ma jenom ";A(A);" pozic. Chces presto zapsat?";:​GET #2,​ZP:​IF ZP<>65 THEN 370
400 B(2)=A
410 TRAP 410:​? "Kam zapisovat pocet sektoru(0=NIC)";:​INPUT A
420 IF A=0 THEN B(3)=A:​GOTO 500
425 IF A=B(1) OR A=B(2) THEN 410
430 IF A(A)<3 OR A(A)>60 THEN 410
440 IF A(A)<61 THEN B(3)=A:​PS=1:​GOTO 500
500 REM Nacteni hlavicek
510 NOTE #1,​Q1,​W1
520 HLA=PEEK(560)+PEEK(561)*256-(POC*4+20):​HLA1=HLA+POC*4-1
530 FOR I=HLA TO HLA1:​GET #1,​A:​POKE I,​A:​NEXT I
540 GOSUB 5100
800 REM Nacitani direktiv
805 DAT=PEEK(144)+PEEK(145)*256+5000:​DAT1=DAT
806 TUT=INT((HLA-DAT)/20):​?:​? "Zavazuji se,​ ze si budu pamatovat ";TUT;" direktiv":​FOR A=0 TO 300:​NEXT A
810 IF B(1) THEN DIM C$(A(B(1)))
815 TUT1=0
820 ? ""
830 IF B(1) THEN ? "Cislo disku";:​INPUT C$
840 TRAP 840:​? "Vloz disk a stiskni klavesu";:​GET #2,​A:​?:​?
850 CLOSE #1:​OPEN #1,​6,​0,​"D:​*.*"
860 TRAP 900:​I=0
870 INPUT #1,​H$:​Q$(I*15+1)=H$(3):​I=I+1
880 GOTO 870
900 TRAP 820:​Q$(I*15)=""
910 FOR ZP=0 TO I-2 STEP 2:​? ZP;" ";Q$(ZP*15+1,​ZP*15+15);
920 IF I-ZP-2 THEN ? " ";ZP+1;" ";Q$((ZP+1)*15+1,​(ZP+1)*15+15)
930 NEXT ZP:​?:​?
940 ? "Zrusit polozku,​souhlas,​jiny disk (Z/A/D)"
950 GET #2,​A
960 IF A=68 THEN 820
970 IF A=65 THEN 1100
980 IF A<>90 THEN 950
990 TRAP 990:​? "Zrusit polozku cislo";:​INPUT A
1000 IF A>I-2 THEN ? "";:​GOTO 940
1010 Q$(A*15+1)=Q$((A+1)*15+1):​I=I-1:​? ""
1020 GOTO 910
1100 REM Ulozeni dat
1101 A1=HLA+3
1102 IF I=1 THEN 820
1103 TUT1=TUT1+I-1:​GOSUB 5200
1104 IF NOT (B(1)) THEN 1120
1106 POKE DAT1,​I-1:​DAT1=DAT1+1
1108 IF LEN(C$)=0 THEN POKE DAT1,​155:​DAT1=DAT1+1:​GOTO 1120
1110 FOR A=1 TO LEN(C$):​POKE DAT1,​ASC(C$(A,​A)):​DAT1=DAT1+1:​NEXT A:​POKE DAT1,​155:​DAT1=DAT1+1
1120 H$="":​FOR ZP=0 TO I-2
1130 H$(1,​11)=Q$(ZP*15+1):​H$(12)=" "
1140 FOR A=1 TO 8:​IF H$(A,​A)=" " THEN H$(A,​A)=".":​H$(A+1)=H$(9):​GOTO 1160
1150 NEXT A:​A$=".":​A$(2)=H$(9):​H$(9)=A$
1160 IF H$(A+1,​A+1)=" " THEN H$(A,​A)=" "
1165 H$(13)=""
1170 FOR A=1 TO 12:​POKE DAT1,​ASC(H$(A,​A)):​DAT1=DAT1+1:​NEXT A
1180 FOR A=0 TO 2:​POKE DAT1,​ASC(Q$(A+ZP*15+13,​A+ZP*15+13)):​DAT1=DAT1+1:​NEXT A
1190 NEXT ZP
1200 ? "Dalsi disk nebo ulozit data(D/U):​"
1210 GET #2,​A:​IF A=68 THEN 820
1220 IF A<>85 THEN 1210
1230 ? "Vloz disk s databazi a stiskni klavesu":​GET #2,​A
1240 TRAP 1230:​CLOSE #1:​OPEN #1,​12,​0,​D$
1250 NOTE #1,​A,​B:​IF A<>Q THEN 1230
1260 ?:​? " Zapal si zatim,​ mne to chvili potrva"
1300 TRAP 40000:​REM Ukladani dat
1350 IF NOT (B(1)) THEN R=1:​GOTO 1395
1360 R=PEEK(DAT):​DAT=DAT+1
1370 C$="":​FOR I=1 TO 62
1380 IF PEEK(DAT)=155 THEN DAT=DAT+1:​GOTO 1395
1390 C$(I)=CHR$(PEEK(DAT)):​DAT=DAT+1:​NEXT I
1395 POP:​FOR ZP=1 TO R
1400 FOR I=1 TO 15
1410 H$(I)=CHR$(PEEK(DAT)):​DAT=DAT+1
1420 NEXT I
1430 REM
1440 GOSUB 8000
1450 FOR I=1 TO 20
1460 IF B(1)=I THEN GOTO 1610
1470 IF B(2)=I THEN GOTO 1650
1480 IF B(3)=I THEN GOTO 1700
1490 IF A(I)=192 THEN 1600
1500 IF A(I)<61 THEN FOR A=1 TO A(I):​PUT #1,​155:​NEXT A:​GOTO 1600
1510 IF A(I)=128 THEN FOR A=1 TO 3:​PUT #1,​0:​NEXT A:​GOTO 1600
1520 FOR A=1 TO 5:​PUT #1,​0:​NEXT A
1600 NEXT I:​GOTO 4000
1610 S=1:​FOR A=1 TO A(I)
1615 IF A>LEN(C$) THEN S=0
1620 IF S THEN PUT #1,​ASC(C$(A,​A)):​GOTO 1640
1630 PUT #1,​155
1640 NEXT A:​GOTO 1600
1650 S=1:​FOR A=1 TO A(I)
1660 IF H$(A,​A)=" " OR A=13 THEN S=0
1670 IF S THEN PUT #1,​ASC(H$(A,​A)):​GOTO 1690
1680 PUT #1,​155
1690 NEXT A:​GOTO 1600
1700 S=1:​FOR A=1 TO A(I)
1710 IF A=4 THEN S=0
1720 IF S THEN PUT #1,​ASC(H$(A+12,​A+12)):​GOTO 1740
1730 PUT #1,​155
1740 NEXT A:​GOTO 1600
4000 NEXT ZP:​IF DAT<DAT1 THEN 1300
4010 POINT #1,​Q1,​W1
4020 FOR I=HLA TO HLA1:​PUT #1,​PEEK(I):​NEXT I
4030 GRAPHICS 0:​? " Hotovo":​?:​?
4040 ? "Vase spokojenost nas cil"
4050 END
5000 DATA 0,​0,​48,​111,​99,​101,​116,​0,​109,​105,​115,​116,​0,​118,​0,​100,​97,​116,​97,​98,​97,​122,​105,​26,​0,​0,​0,​0,​0,​0,​0,​0,​0,​0,​0,​0
5005 DATA 0,​0,​0,​0
5010 DATA 0,​0,​58,​97,​122,​110,​97,​109,​117,​0,​118,​0,​112,​97,​109,​101,​116,​105,​26,​0,​0,​0,​0,​0,​0,​0,​0,​0,​0,​0,​0,​0,​0,​0,​0,​0,​0,​0
5020 DATA 0,​0,​0,​0,​0,​0,​0,​34,​6,​34,​0,​51,​47,​38,​52,​0,​0,​0,​0,​0,​0,​0
5025 GRAPHICS 0:​POKE 708,​220:​POKE 709,​0:​POKE 710,​200
5030 RESTORE 5000:​FOR I=1536 TO 1635:​READ A:​POKE I,​A:​NEXT I
5040 DL=PEEK(560)+PEEK(561)*256-2
5050 POKE DL,​66:​POKE DL+1,​0:​POKE DL+2,​6:​POKE DL+3,​2:​POKE DL+4,​6
5060 POKE 560,​PEEK(560)-2
5070 POKE DL+32,​PEEK(DL+32)-2
5080 RETURN
5100 TUT1=0:​FOR I=HLA+3 TO HLA1 STEP 4
5110 IF PEEK(I)=0 THEN TUT1=TUT1+1
5120 NEXT I:​IF TUT1=0 THEN ? "Promin,​ ale nemas misto v databazi!":​END
5125 TUT2=TUT1
5130 POKE 1570,​16+INT(TUT1/1000):​TUT1=TUT1-(INT(TUT1/1000))*1000
5140 POKE 1571,​16+INT(TUT1/100):​TUT1=TUT1-(INT(TUT1/100))*100
5150 POKE 1572,​16+INT(TUT1/10):​TUT1=TUT1-(INT(TUT1/10))*10
5160 POKE 1573,​16+TUT1
5170 RETURN
5200 IF TUT1>TUT OR TUT1>TUT2 THEN 5300
5205 TUT4=TUT1
5210 POKE 1610,​16+INT(TUT4/1000):​TUT4=TUT4-(INT(TUT4/1000))*1000
5220 POKE 1611,​16+INT(TUT4/100):​TUT4=TUT4-(INT(TUT4/100))*100
5230 POKE 1612,​16+INT(TUT4/10):​TUT4=TUT4-(INT(TUT4/10))*10
5240 POKE 1613,​16+TUT4
5250 RETURN
5300 ?:​? "Promin,​ ale mas malou kapacitu!":​FOR I=0 TO 500:​NEXT I:​GOTO 1230
6000 STOP
8000 REM Ukladani dat
8010 FOR A1=A1 TO HLA1 STEP 4
8020 IF PEEK(A1)<>0 THEN NEXT A1
8030 A=PEEK(A1-3)+PEEK(A1-2)*256:​B=PEEK(A1-1)
8040 POINT #1,​A,​B
8050 POKE A1,​1
8060 RETURN	

• Download link 1
• Download link 2