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:Picture Loader
-
Category:Printer utilities
-
Publisher/Developer:Flop 7, IMMORTAL Software Ltd., Jarham Software
-
Year:1989
Listing 1
0 REM upravil IMMORTAL Software Ltd. 10 DIM A(50),NAME$(12),I$(1),SP$(10),A$(10) 20 W=200:GRM=8 30 GRAPHICS 0:SETCOLOR 1,15,15:SETCOLOR 2,0,0:CLS:? " " 40 ? " " 50 ? " " 60 ? " " 70 ? " " 80 ? " " 90 ? " " 100 ? " " 110 ? " "; 120 PAUSE (W):? "":?:? " ":W=0 130 ? " NORMAL LOAD " 140 ? " TURBO LOAD " 150 ? " NORMAL SAVE " 160 ? " TURBO SAVE " 170 ? " NEGATIVE " 180 ? " SHIFT (LEFT,RIGHT,UP) " 190 ? " GRAPHICS MODE " 200 ? " PRINT " 210 ? " CONTINUAL DELETE " 220 ? " REKONSTRUCTION " 230 ?:? " ";:POKE 559,34 240 OPEN #5,4,0,"K:":GET #5,K:CLOSE #5 250 CLS 260 ON K-47 GOTO 1400,430,280,490,355,710,1240,1030,680,930 270 POKE 559,0:GOTO 40 280 GOSUB 360 290 CLS:GRAPHICS 8+32:SETCOLOR 2,15,15:SETCOLOR 1,0,0 300 Q=PEEK(88)+PEEK(89)*256:TOP=Q+8*1024:V=8*1024 310 TRAP 330:OPEN #1,4,0,NAME$ 320 BGET #1,Q,V 330 CLOSE #1:POKE 732,0 340 CLS:POKE 752,1:?:? " to MENU" 345 IF (PEEK(732)<>17) THEN 345 350 GOTO 30 355 GOTO 370 360 GRAPHICS 0:SETCOLOR 2,0,0:SETCOLOR 1,10,10:INPUT "ENTER T:filename ";A$ 361 IF LEN(A$)>=2 THEN IF A$(1,2)="T:" THEN NAME$=A$:GOTO 364 362 NAME$="T:":NAME$(3)=A$ 364 LE1=LEN(A$):LE2=6-LE1:SP$=" ":NAME$(LE1+3)=SP$(1,LE2):NAME$(9)=".PIC" 366 RETURN 370 GOSUB 360:CLS:GRAPHICS 8+32:SETCOLOR 2,15,15 380 Q=PEEK(88)+PEEK(89)*256:TOP=Q+8*1024:V=8*1024 390 TRAP 410:OPEN #1,8,0,NAME$ 400 BPUT #1,Q,V 410 CLOSE #1:POKE 732,0 420 IF (PEEK(732)<>17) THEN 340 430 CLS:GRAPHICS 8+32:SETCOLOR 2,15,15:SETCOLOR 1,0,0 440 Q=PEEK(88)+PEEK(89)*256:TOP=Q+8*1024:V=8*1024 450 OPEN #1,4,0,"C:" 460 FOR I=Q TO TOP:GET #1,A:POKE I,ABS(A-255):NEXT I 470 CLOSE #1:POKE 732,0 480 IF (PEEK(732)<>17) THEN 340 490 CLS:GRAPHICS 8+32:SETCOLOR 2,15,15:SETCOLOR 1,0,0 500 Q=PEEK(88)+PEEK(89)*256:TOP=Q+8*1024:V=8*1024 510 OPEN #1,8,0,"C:" 520 FOR I=Q TO TOP:A=PEEK(I):PUT #1,A:NEXT I 530 CLOSE #1:POKE 732,0 540 IF (PEEK(732)<>17) THEN 340 550 ?:INPUT "LEFT SHIFT AT";POSUN 560 CLS:GRAPHICS 8+32:SETCOLOR 2,15,15:SETCOLOR 1,0,0 570 Q=PEEK(88)+PEEK(89)*256:LTOP=Q+40 580 FOR L=0 TO 190 590 FOR I=Q+L*40 TO LTOP-1+L*40 600 REM IF I-L*40>LTOP-POSUN THEN 620 610 POKE I,PEEK(I+POSUN):GOTO 650 620 FOR K=I TO LTOP+L*40 630 POKE K,0 640 NEXT K:GOTO 660 650 NEXT I 660 NEXT L:CLOSE #1:POKE 732,0 670 IF (PEEK(732)<>17) THEN 340 680 POKE 752,1:?:? " to COPY" 681 POKE 752,1:?:? " to MENU" 690 ?:INPUT "HARDCOPY a x X, b x Y, ENTER A,B";A,B:PAR=B*16+A 695 CLS:GRAPHICS 8+32:SETCOLOR 2,15,15:SETCOLOR 1,0,0:CLOSE:OPEN #2,8,PAR,"P:":CLOSE #1:POKE 82,0:POKE 732,0 700 IF (PEEK(732)<>17) THEN 345 710 CLS:GRAPHICS 8+32:SETCOLOR 2,15,15:SETCOLOR 1,0,0 720 Q=PEEK(88)+PEEK(89)*256:TOP=Q+8*1024:V=8*1024 730 FOR I=Q TO TOP:POKE I,ABS(PEEK(I)-255):NEXT I:POKE 732,0:CLS 740 IF (PEEK(732)<>17) THEN 340 750 CLS:GRAPHICS 8+32:SETCOLOR 2,15,15:SETCOLOR 1,0,0 760 Q=PEEK(88)+PEEK(89)*256:TOP=Q+8*1024:V=8*1024:Z=24 770 FOR L=0 TO 191 780 X=1:POC=Q+L*40-1 790 FOR I=POC TO POC+40-1 800 A(X)=PEEK(I):X=X+1 810 NEXT I 820 X=1 830 FOR I=POC TO POC+(40-Z)-1 840 POKE I,A(Z+X):X=X+1 850 NEXT I 860 X=1 870 FOR I=POC+(40-Z) TO POC+40-1 880 POKE I,A(X):X=X+1 890 NEXT I 900 X=1 910 NEXT L:POKE 732,0 920 IF (PEEK(732)<>17) THEN 340 930 CLS:GRAPHICS 8+32:SETCOLOR 2,15,15:SETCOLOR 1,0,0 940 Q=PEEK(88)+PEEK(89)*256:TOP=Q+8*1024:V=8*1024:Z=25:POKE 732,0 950 FOR L=191 TO 0 STEP -1 960 X=1:POC=Q+L*40 970 FOR I=POC TO POC+39 980 POKE I,0 990 NEXT I 1000 IF PEEK(732)=17 THEN POKE 732,0:GOTO 340 1010 NEXT L:POKE 732,0 1020 IF (PEEK(732)<>17) THEN 340 1030 CLS:GRAPHICS GRM+32:POKE 731,1:POKE 732,0:POKE 752,1:?:? " to MENU" 1040 IF (PEEK(732)=17) THEN POKE 731,0 1050 I$=INKEY$:IF I$="" THEN I$=" " 1060 A=ASC(I$) 1070 IF A=28 OR A=45 THEN S1=S1+1:IF S1>15 THEN S1=0 1080 IF A=29 OR A=61 THEN S2=S2+1:IF S2>15 THEN S2=0 1090 IF A=30 OR A=43 THEN S3=S3+1:IF S3>15 THEN S3=0 1100 IF A=31 OR A=42 THEN S4=S4+1:IF S4>15 THEN S4=0 1110 SETCOLOR 0,5,S1:SETCOLOR 1,5,S2:SETCOLOR 2,5,S3:SETCOLOR 4,5,S4 1120 GOTO 1040 1130 ?:INPUT "ENTER LONG UP SHIFT";X 1140 CLS:GRAPHICS 8+32:SETCOLOR 2,15,15:SETCOLOR 1,0,0 1150 Q=PEEK(88)+PEEK(89)*256:TOP=Q+8*1024:V=8*1024 1160 FOR L=0 TO 190 1170 FOR I=Q+L*40 TO Q+L*40+40-1 1180 AA=PEEK(I+X*40) 1190 POKE I,AA 1200 NEXT I 1210 NEXT L:POKE 732,0 1220 IF (PEEK(732)<>17) THEN 340 1230 GET A:? A:GOTO 1230 1240 ? "SHIFT EFT OR IGHT OR P ?"; 1250 GET A:I$=CHR$(A) 1258 IF I$="L" THEN 550 1260 IF I$="U" THEN 1130 1262 IF I$="R" THEN 1280 1270 GOTO 1250 1280 ?:INPUT "RIGHT SHIFT AT";POSUN 1290 CLS:GRAPHICS 8+32:SETCOLOR 2,15,15:SETCOLOR 1,0,0 1300 Q=PEEK(88)+PEEK(89)*256:LTOP=Q+40 1310 FOR L=0 TO 190 1320 FOR I=LTOP+L*40-1 TO Q+L*40 STEP -1 1340 POKE I,PEEK(I-POSUN) 1380 NEXT I 1390 NEXT L:CLOSE #1:POKE 732,0 1395 IF (PEEK(732)<>17) THEN 340 1400 ? "REKONSTRUCTION FROM INCLAIR OR TARI?"; 1410 GET A 1420 IF A=65 THEN 1530 1430 IF A=83 THEN 1450 1440 GOTO 1410 1450 CLS:GRAPHICS 8+32:SETCOLOR 2,15,15:SETCOLOR 1,0,0 1460 Q=PEEK(88)+PEEK(89)*256:LTOP=Q+40 1470 FOR L=0 TO 190 1480 FOR I=0 TO 3 1490 POKE I+Q+L*40,0:POKE LTOP+L*40-1-I,0 1500 NEXT I 1510 NEXT L:CLOSE #1:POKE 732,0 1520 IF (PEEK(732)<>17) THEN 340 1530 ? "REKONSTRUCTION FROM ATARI" 1540 ? "RKONSTRUCTION OR EFT OR IGHT DELETE?"; 1550 GET A 1560 IF A=69 THEN 750 1570 IF A=76 THEN LE=1:RI=0:GOTO 1600 1580 IF A=82 THEN LE=0:RI=1:GOTO 1600 1590 GOTO 1550 1600 INPUT "ENTER LONG EDGE DEL.";DEL 1610 CLS:GRAPHICS 8+32:SETCOLOR 2,15,15:SETCOLOR 1,0,0 1620 Q=PEEK(88)+PEEK(89)*256:LTOP=Q+40 1630 FOR L=0 TO 190 1640 FOR I=Q+L*40+(40-DEL)*RI TO LTOP+L*40-1-(40-DEL)*LE 1650 POKE I,0 1660 NEXT I 1670 NEXT L:CLOSE #1:POKE 732,0 1680 IF (PEEK(732)<>17) THEN 340
References
Listing downloads
Copyright holder