Atari 8-bit Source code

100 REM -----------------------------
110 REM - Disk-Etikettier -
120 REM - -
130 REM - (c) 1984/85 by -
140 REM - -
150 REM - Burkhard Wagner -
160 REM - Pestalozzistr.2 -
170 REM - 4350 Recklinghausen -
180 REM - -
190 REM - ATARI BIT BYTER USER CLUB -
200 REM -----------------------------
210 REM - Initialisieren -
220 REM -----------------------------
230 GOSUB 1080
240 POKE 709,​12:​POKE 710,​4
250 POKE 711,​12:​POKE 708,​148
260 POKE 752,​0:​POSITION 1,​2
270 DL=PEEK(560)+256*PEEK(561)
280 POKE DL+7,​7:​POKE DL+8,​6
290 ? ""
300 ? " (C)1984 BY B. WAGNER":​?
310 REM -----------------------------
320 REM - Abfrage Disk-Art -
330 REM -----------------------------
340 ? "1. Disketa se soubory":​?
350 ? "2. Disketa BOOT":​?
360 ? "3. Volba tiskarny":​?
365 ? "4. Konec":​?
370 POKE 752,​0:​? "Volba:​ ";
380 GET #3,​T:​IF T<49 OR T>52 THEN 380
390 DEL=8:​GOSUB 1180
400 ON T-48 GOSUB 460,​690,​2140,​420
410 RUN
420 GRAPHICS 0:​END
430 REM -----------------------------
440 REM - File-Disks -
450 REM -----------------------------
460 ? "Jmeno diskety":​?
470 GOSUB 900
480 ? "Vlozte pozadovanou disketu a stisknete RETURN"
490 GET #3,​T:​IF T<>155 THEN 490
500 DEL=1:​GOSUB 1180:​? DN$;":​"
510 GOSUB 1240:​FOR J=1 TO 4
520 GOSUB 1280:​POSITION 2,​17
530 ? "Vsechna jmena na etiketu? (A/N)"
540 GET #3,​T
550 IF CHR$(T)="N" THEN AW=1:​GOTO 570
560 IF CHR$(T)<>"A" THEN 540
570 IF EOF THEN 590
580 NEXT J
590 DEL=11:​GOSUB 1180
600 IF AW THEN GOSUB 1420
610 GOSUB 2020:​GOSUB 1540
620 GOSUB 1790:​? #1:​GOSUB 1630
630 GOSUB 1980
640 GOSUB 2090:​GOSUB 1910
650 FOR I=1 TO 16-INT(V/4):​? #1:​NEXT I:​CLOSE #1:​RETURN
660 REM -----------------------------
670 REM - Boot-Disks -
680 REM -----------------------------
690 ? "Napiste oznaceni etikety":​?
700 GOSUB 900
710 ? "Vlozte,​ prosim,​ etiketu <RETURN>"
720 GET #3,​T:​OPEN #1,​8,​0,​"P"
730 GOSUB 1670:​GOSUB 1630
740 ? #1;"Jmeno:​":​GOSUB 1710:​? #1;DN$;
750 FOR O=1 TO 21-LEN(DN$)
760 ? #1;" ";:​NEXT O:​? #1;BW$
770 ? #1:​GOSUB 1630
780 ? #1;"Operacni system:​ "
790 GOSUB 1710
800 IF BS=2 THEN ? #1;"XE":​GOTO 830
810 IF BS=3 THEN ? #1;"400/800":​GOTO 830
820 ? #1;"XL"
830 GOSUB 1630:​? #1;"Filetyp:​"
840 GOSUB 1710:​? #1;PS$(PS*3-2,​PS*3)
850 FOR I=1 TO 5:​? #1:​NEXT I
860 DEL=1:​GOSUB 1180:​RETURN
870 REM -----------------------------
880 REM - Upro Parameterabfrage -
890 REM -----------------------------
900 ? "Jmeno diskety (max 20 znaku):​":​POKE 702,​0:​POKE 752,​0:​?:​INPUT #2,​DN$:​POKE 702,​64:​DEL=3:​GOSUB 1180
910 POKE 752,​1:​? "Operacni system:​":​?:​? "(1) XL":​? "(2) XE":​? "(3) 400/800"
920 GET #3,​BS:​IF BS<49 OR BS>51 THEN 920
930 BS=BS-48:​DEL=5:​GOSUB 1180:​POKE 752,​0
940 ? "(1) ic";CHR$(127);CHR$(127);"(2) r":​? "(3) mand";CHR$(127);CHR$(127);"(4) "
950 ? "(5) t";CHR$(127);CHR$(127);"(6) asicot":​? "(7) ot";CHR$(127);CHR$(127);"(8) o"
960 ? "(9) icrooftasic";CHR$(127);"(10) ischt":​? "(11) eien";CHR$(127);CHR$(127);"(12) th"
970 ? "(13) cal";CHR$(127);CHR$(127);"(14) p":​? "(15) i";CHR$(127);CHR$(127);"(16) tem"
980 ? "(17) e";CHR$(127);CHR$(127);"(18) oecode":​? "(19) ectcode";CHR$(127);"(20) ion"
990 POSITION 2,​17:​? "1 ";CHR$(30);CHR$(30);CHR$(30);
1000 INPUT #2,​PS:​IF PS<1 OR PS>20 OR PS<>INT(PS) THEN 990
1010 DEL=14:​GOSUB 1180:​POKE 752,​1
1020 ? "Napiste inicialy:​ ";
1030 FOR I=1 TO 2:​GET #3,​T:​BW$(I)=CHR$(T):​? BW$(I,​I);:​NEXT I:​?:​POKE 752,​0
1040 DEL=1:​GOSUB 1180:​POKE 752,​1:​RETURN
1050 REM ----------------------------
1060 REM - Stringinit Upro -
1070 REM ----------------------------
1080 DIM DN$(20),​BW$(2),​F$(15),​PS$(60),​DN(64),​PR$(64*16),​BS$(2),​DOS$(4),​PR2$(64*16),​P1$(2),​P2$(2)
1085 IF PEEK(1536)=0 THEN P1$="":​P2$="H":​GOTO 1090
1086 P1$="@":​P2$="T"
1090 FOR I=1 TO 64:​DN(I)=1:​NEXT I
1110 PS$="BASBINCOMEXEBOOBBOPILLOGMSBGEMDATFORPASLISLSTSYSTXTSRCOBJACT"
1120 OPEN #3,​4,​0,​"K"
1130 OPEN #2,​12,​0,​"E":​POKE 756,​204
1140 RETURN
1150 REM ----------------------------
1160 REM - Zeilenlsch Upro -
1170 REM ----------------------------
1180 FOR I=1 TO DEL
1190 ? CHR$(28);CHR$(156);
1200 NEXT I:​RETURN
1210 REM ----------------------------
1220 REM - OPEN Directory Upro -
1230 REM ----------------------------
1240 CLOSE #4:​OPEN #4,​6,​0,​"D:​*.*":​RETURN
1250 REM ----------------------------
1260 REM - Filenamen anzeigen -
1270 REM ----------------------------
1280 DEL=11:​FOR K=1 TO 16:​INPUT #4,​F$
1290 IF F$(6,​8)="Fre" THEN EOF=1:​RETURN
1300 PR$(LEN(PR$)+1)=F$(3,​13):​PR$(LEN(PR$)+1)=" "
1310 GOSUB 1360:​POSITION 2+18*(INT(K/2)=K/2)+(K<10 AND J=1),​6+K/2
1320 ? K+J*16-16;". ";F$(3,​14):​NEXT K:​RETURN
1330 REM ----------------------------
1340 REM - Bild lschen? Upro -
1350 REM ----------------------------
1360 IF J>1 AND K=1 THEN GOSUB 1180
1370 RETURN
1380 REM ----------------------------
1390 REM - Welche Namen auf das -
1400 REM - Etikett ? Upro -
1410 REM ----------------------------
1420 GOSUB 1240
1430 FOR J=1 TO 64:​POSITION 2,​7
1440 ? "no nebo e ? ":​INPUT #4,​F$
1450 IF F$(5,​7)="FRE" THEN 1500
1460 POSITION 2,​9:​? J;". ";F$(3,​14)
1470 GET #3,​T:​IF CHR$(T)<>"A" AND CHR$(T)<>"N" THEN 1470
1480 IF CHR$(T)="N" THEN DN(J)=0
1490 DEL=2:​GOSUB 1180:​NEXT J
1500 DEL=2:​GOSUB 1180:​RETURN
1510 REM ----------------------------
1520 REM - Otevreni kanalu tiskarny
1530 REM ----------------------------
1540 POKE 752,​1:​? "S (1) nebo bez (2) extendru ?"
1550 GET #3,​T:​IF T<49 OR T>50 THEN 1550
1560 EX=(T=49):​DEL=2:​GOSUB 1180
1570 OPEN #1,​8,​0,​"P"
1580 ? #1;"A";CHR$(6);
1590 POKE 752,​0:​RETURN
1600 REM ----------------------------
1610 REM - Superscript ein -
1620 REM ----------------------------
1630 ? #1;"S";CHR$(0);:​RETURN
1640 REM ----------------------------
1650 REM - Compressed aus,​ 9/72inch -
1660 REM ----------------------------
1670 ? #1;P1$;"A";CHR$(9);:​RETURN
1680 REM ----------------------------
1690 REM - Superscript aus -
1700 REM ----------------------------
1710 ? #1;P2$;:​RETURN
1720 REM ----------------------------
1730 REM - Normalschrift ein -
1740 REM ----------------------------
1750 ? #1;"H";:​RETURN
1760 REM ----------------------------
1770 REM - Header drucken Upro -
1780 REM ----------------------------
1790 GOSUB 1980:​GOSUB 1710:​? #1;DN$;
1800 IF BS=2 THEN BS$="XE":​GOTO 1830
1810 IF BS=3 THEN BS$="NX":​GOTO 1830
1820 BS$="XL"
1830 FOR J=1 TO 22-LEN(DN$):​? #1;" ";:​NEXT J:​? #1;"DOS:​ ";DOS$;
1840 FOR J=1 TO 5-LEN(DOS$):​? #1;" ";:​NEXT J:​? #1;BS$;:​FOR J=1 TO 4-LEN(BS$):​? #1;" ";:​NEXT J
1850 ? #1;PS$(PS*3-2,​PS*3);
1860 ? #1;" ";:​? #1;BW$
1870 RETURN
1880 REM ----------------------------
1890 REM - Filenamen drucken -
1900 REM ----------------------------
1910 TRAP 1940:​FOR J=1 TO (LEN(PR$)/12+1)*4 STEP 4
1920 FOR K=1 TO 4:​? #1;PR$(J*12+K*12-23,​J*12+K*12-12);:​V=V+1:​NEXT K:​? #1
1930 NEXT J
1940 TRAP 32767:​RETURN
1950 REM ----------------------------
1960 REM - Compressed ein -
1970 REM ----------------------------
1980 ? #1;CHR$(27);CHR$(15);:​RETURN
1990 REM ----------------------------
2000 REM - Ktery DOS? -
2010 REM ----------------------------
2020 POKE 752,​0:​POKE 756,​224:​POSITION 2,​6:​? "DOS - verze ":​? " ":​POSITION 17,​6
2030 INPUT DOS$:​POKE 756,​204:​DEL=1:​GOSUB 1180:​RETURN
2040 REM ----------------------------
2050 REM - Belegen des Druck- -
2060 REM - Strings mit den ge- -
2070 REM - whlten Programmen -
2080 REM ----------------------------
2090 PR2$="":​FOR J=1 TO LEN(PR$)/12
2100 IF DN(J)=0 THEN 2130
2110 PR2$(LEN(PR2$)+1)=PR$(J*12-11,​J*12-4*(EX=0))
2120 IF EX=0 THEN PR2$(LEN(PR2$)+1)=" "
2130 NEXT J:​PR$="":​PR$=PR2$:​RETURN
2136 REM ----------------------------
2137 REM - Volba tiskarny -
2138 REM ----------------------------
2140 ? "(1) Epson & kompatible"
2150 ? "(2) Riteman F+ [c+]"
2160 ? "(3) Star Gemini"
2170 ? "(4) Mannesmann Tally MT 80"
2175 ?:​? "Volba:​";
2180 GET #3,​T:​IF T<49 OR T>52 THEN 2180
2190 IF T=49 OR T=50 OR T=51 THEN POKE 1536,​1:​P1$="@":​P2$="T"
2200 IF T=52 THEN P1$="":​P2$="H":​POKE 1536,​0
2210 DEL=5:​GOSUB 1180:​POP:​GOTO 340	

• Download link 1
• Download link 2