This is non-commercial site, its content is based on Atari 8-bit home computer contents and references.
If you feel your rights are violated by showing/using any part of contents of your product represented on this page,
please contact me immediatelly so I can remove it!
Atari 8-bit Source code
|
|
|
-
Entry name:HKD100
-
Category:Printer utilities
-
Publisher/Developer:Flop 7
Listing 1
10 EXEC NAZEV 14 EXEC PICMENU 16 EXEC CESTA 18 EXEC TISK 20 GOTO 10 22 PROC NAZEV 24 DIM FN$(18),D$(18),D1$(18) 26 POKE 82,1:? "":SETCOLOR 2,0,0:POKE 752,0 28 ? "ZADEJ NAZEV,NEBO PRO OBSAH DISKU":? "";:INPUT FN$:IF FN$="" THEN 48 30 GOSUB 36 32 TRAP 54:POKE 752,1:OPEN #1,4,0,FN$ 34 ENDPROC 36 IF FN$(1,1)<>"D" THEN D$="D:":D$(3)=FN$:FN$=D$:RETURN 38 TRAP 42:IF FN$(2,2)<>":" THEN 44 40 RETURN 42 D$="D:":D$(3)=FN$:FN$=D$:RETURN 44 IF FN$(3,3)<>":" THEN 42 46 RETURN 48 TRAP 54:FN$="D":FN$(2)=STR$(DNUM):FN$(3)=":*.*":OPEN #3,6,0,FN$ 50 TRAP 56:? "" 52 INPUT #3;D$:? D$;"";:INPUT #3;D1$:? D1$:GOTO 52 54 CLOSE #1:CLS:?:?:?:? "":?:?:?:GOTO 28 56 CLOSE #3:?:?:?:GOTO 28 58 GOTO 28 112 PROC PICMENU 114 CLS:?:?:?:?:?:? 116 ? " " 118 ? " ||" 120 ? " " 122 ? " | |" 124 ? " | |" 126 ? " | |" 128 ? " | |" 130 ? " | |" 132 ? " | |" 134 ? " | |" 136 ? " | |" 138 ? " " 140 GOSUB 188:GOSUB 184:GOSUB 186 142 POKE 764,255 144 KL=PEEK(764) 146 IF KL=12 THEN EXEC INFO:EXEC GR8:GOTO 194 148 IF KL=15 THEN 154 150 IF KL=14 THEN 168 152 GOTO 144 154 GOSUB 182:GOSUB 190:GOSUB 186 156 POKE 764,255 158 KL=PEEK(764) 160 IF KL=12 THEN EXEC INFO:EXEC KOALA:GOTO 194 162 IF KL=15 THEN 168 164 IF KL=14 THEN 140 166 GOTO 158 168 GOSUB 182:GOSUB 184:GOSUB 192 170 POKE 764,255 172 KL=PEEK(764) 174 IF KL=12 THEN EXEC INFO:EXEC BGRAF:GOTO 194 176 IF KL=15 THEN 140 178 IF KL=14 THEN 154 180 GOTO 172 182 POSITION 13,10:? " GRAPHICS 8 ":RETURN 184 POSITION 13,12:? " KOALA ":RETURN 186 POSITION 13,14:? " BGRAPH ":RETURN 188 POSITION 13,10:? "":RETURN 190 POSITION 13,12:? "":RETURN 192 POSITION 13,14:? "":RETURN 194 ENDPROC 196 PROC INFO 198 CLS:?:?:?:?:?:? 200 ? " " 202 ? " ||" 204 ? " " 206 ? " | |" 208 ? " | TISK NORMAL |" 209 ? " | |" 210 ? " | TISK INVERSNI |" 211 ? " | |" 212 ? " | NOVY OBRAZEK |" 214 ? " | |" 216 ? " " 218 ? " |stiskni libovolnou klavesu|" 220 ? " " 222 POKE 764,255 224 IF PEEK(764)<>255 THEN CLS:GOTO 230 226 IF PEEK(53279)=6 THEN EXIT:GOTO -10 228 GOTO 224 230 ENDPROC 232 PROC KOALA 234 GOSUB 266:GOSUB 254:POKE 106,PEEK(106)-34:DIM M$(7680) 238 POKE 560,DLEL:POKE 561,DLEH:POKE 88,SCL:POKE 89,SCH 240 JNK=USR(ADR(MILOAD$)) 242 VM=DPEEK(88) 244 MOVE VM,ADR(M$),7680 246 POKE 106,PEEK(106)+34 248 GRAPHICS 8+16:SETCOLOR 2,0,0:VM=DPEEK(88) 250 MOVE ADR(M$),VM,7680 252 ENDPROC 254 GRAPHICS 24 256 DLEL=PEEK(560):DLEH=PEEK(561):SCL=PEEK(88):SCH=PEEK(89):DLP=DLEL+256*DLEH+3 258 IF PEEK(DLP)=15 THEN POKE DLP,14 260 IF PEEK(DLP)=79 THEN POKE DLP,78:DLP=DLP+2 262 IF PEEK(DLP)<>65 THEN DLP=DLP+1:GOTO 258 264 RETURN 266 DIM MILOAD$(275) 268 FOR I=1 TO 275:READ Z:MILOAD$(I,I)=CHR$(Z):SUM=SUM+Z:NEXT I 270 IF SUM<>33490 THEN ? "CHYBA V DATECH":END 272 RETURN 274 DATA 104,162,16,169,7,157,66,3,160,1,132,213,169,0,157,72,3,157,73,3,32,86,228,164,213,192,8,208,2 276 DATA 133,212,192,14,48,7,192,19,16,3,153,182,2,200,192,28,48,219,16,8,80,46,66,46,32,39,56,54,169,0 278 DATA 133,219,133,220,165,88,133,215,133,217,165,89,133,216,133,218,169,0,133,214,157,72,3,157,73,3 280 DATA 32,86,228,16,1,96,168,41,128,133,222,152,41,127,208,24,169,0,157,72,3,157,73,3,32,86,228,133 282 DATA 214,169,0,157,72,3,157,73,3,32,86,228,133,213,169,0,157,72,3,157,73,3,32,86,228,133,221,160,0 284 DATA 165,221,145,215,56,165,213,233,1,133,213,165,214,233,0,133,214,144,170,165,212,201,2,208,10,230 286 DATA 215,208,73,230,216,208,69,144,219,230,220,24,165,215,105,80,133,215,144,2,230,216,169,96,197 288 DATA 220,208,48,169,0,133,220,165,219,208,19,169,1,133,219,24,165,217,105,40,133,215,165,218,105,0 290 DATA 133,216,144,21,169,0,133,219,24,165,217,105,1,133,215,133,217,165,218,105,0,133,216,133,218,165 292 DATA 213,208,7,165,214,208,3,24,144,160,165,222,16,13,169,0,157,72,3,157,73,3,32,86,228,133,221,24 294 DATA 144,156 296 PROC BGRAF 298 GRAPHICS 8+16:SETCOLOR 2,0,0:VM=DPEEK(88) 300 FOR I=1 TO 289 302 GET #1,A 304 NEXT I 306 BGET #1,VM,7680:CLOSE #1 308 ENDPROC 310 PROC GR8 312 GRAPHICS 8+16:SETCOLOR 2,0,0:VM=DPEEK(88) 314 BGET #1,VM,7680:CLOSE #1 316 ENDPROC 318 PROC TISK 320 DIM DMP$(107),L$(950),LINE$(320),B$(1),SP$(1000):I=0:K=0 322 DMP$="hhhhhhhi((Hjh8(Jii`" 324 SP$="" 325 TRAP 400 326 LPRINT CHR$(15) 327 LPRINT "10" 328 FOR I=1 TO 28 330 LINE$="":LINE$(320)="":LINE$(2)=LINE$:L$="" 332 X=USR(ADR(DMP$),ADR(LINE$),VM,3+4*(I<28)) 334 FOR J=1 TO 320 336 A=ASC(LINE$(J,J)) 338 IF PR=0 THEN A=255-A:GOTO 340 339 A=A+128 340 IF A=155 THEN A=159 342 B$=CHR$(A) 344 K=K+1 346 IF K=5 THEN L$(LEN(L$)+1)=B$:L$(LEN(L$)+1)=B$:K=0 348 L$(LEN(L$)+1)=B$ 350 L$(LEN(L$)+1)=B$ 352 NEXT J 354 SP$(LEN(SP$)+1)=L$ 356 LPRINT SP$ 358 SP$="" 360 VM=VM+280 362 NEXT I 370 CLR 372 ENDPROC 374 PROC CESTA 378 IF PEEK(53279)=3 THEN PR=1:GOTO 390 379 IF PEEK(53279)=5 THEN PR=0:GOTO 390 380 IF PEEK(53279)=6 THEN CLR:POKE 764,255:RUN 382 GOTO 378 390 ENDPROC 400 FOR I=1 TO 5 410 SOUND 0,60,10,15:PAUSE 10:SOUND 0,0,0,0:PAUSE 10 420 NEXT I 430 POKE 764,255 440 IF PEEK(764)=33 THEN 325 450 GOTO 440
References
Listing downloads
Copyright holder