Atari 8-bit Source code

1 REM ******************************
2 REM * Ing. Dubsky Jan *
3 REM * Ivancice - Letkovice 73 *
4 REM * PSC 664 91 *
5 REM * AK Brno - 141 ZO Svazarmu *
6 REM ******************************
7 ------------------------------
8 ------------------------------
10 *B +:​TRAP 14:​POKE 106,​128:​V=1:​S=1:​KONEC=60:​FOR I=48528 TO 48535:​POKE I,​0:​NEXT I
11 DIM A$(60),​B$(40),​C$(275):​A$="STUVWXYZ[\]^_RRRRRRRRRRRRRRRRRRRR"
12 EXEC TITUL:​EXEC BEEP:​EXEC USRN:​EXEC BEEP:​EXEC KEYCTRL:​EXEC UVOD:​EXEC BEEP:​EXEC KEYCTRL
13 EXEC PRANI:​EXEC BEEP:​EXEC KEYCTRL
14 CLOSE:​TRAP 14:​EXEC MENU:​GOTO 14
15 END
16 ------------------------------
17 ------------------------------
100 PROC MENU:​GRAPHICS 0:​SETCOLOR 2,​12,​2:​SETCOLOR 1,​12,​12:​POKE 752,​1:​RESTORE #MENUD:​EXEC TEXT:​KEY=-1
101 IF KEY=31 THEN FU=1:​GOTO 109
102 IF KEY=30 THEN FU=2:​GOTO 109
103 IF KEY=26 THEN FU=3:​GOTO 109
104 IF KEY=24 THEN FU=4:​GOTO 109
105 IF KEY=29 THEN FU=5:​GOTO 109
106 IF KEY=27 THEN FU=6:​GOTO 109
107 IF KEY=51 THEN FU=7:​KEY=-1:​EXEC VYFU:​GOTO 110
108 EXEC BEEP:​EXEC KEYCTRL:​GOTO 101
109 KEY=-1:​IF FU=1:​EXEC ZVETSENI:​ENDIF:​EXEC VYBOBR:​EXEC VYFU
110 ENDPROC
111 PROC VYFU:​ON FUEXEC COPY,​LOADS,​SAVES,​INVER,​OBRAZ,​PREVOD,​TEXTP:​ENDPROC
112 PROC ZVETSENI:​RESTORE #ZVETD:​EXEC TEXT
113 IF KEY=63:​V=1:​ELSE:​IF KEY=21:​V=2:​ELSE:​IF KEY=18:​V=3:​ELSE:​IF KEY=58:​S=1:​KONEC=60:​ELSE:​IF KEY=42:​S=2
114 KONEC=30:​ELSE:​IF KEY=56:​S=3:​KONEC=20:​ELSE:​IF KEY=28:​KEY=-1:​GOTO 116:​ENDIF:​ENDIF:​ENDIF:​ENDIF
115 ENDIF:​ENDIF:​ENDIF:​KEY=-1:​POSITION 11,​6:​? V:​POSITION 11,​7:​? S:​EXEC BEEP:​EXEC KEYCTRL:​GOTO 113
116 ENDPROC
117 PROC TEXTP:​RESTORE #TEXTD:​EXEC TEXT:​INPUT B$:​OPEN #3,​8,​17,​"P:​":​? #3:​? #3,​B$:​? #3:​? #3:​CLOSE #3:​ENDPROC
118 PROC VYBOBR:​RESTORE #VYBD:​EXEC TEXT
119 IF KEY=31:​OBR=1:​GOTO 120:​ELSE:​IF KEY=30:​OBR=2:​GOTO 120:​ENDIF:​ENDIF:​EXEC KEYCTRL:​GOTO 119
120 KEY=-1:​ENDPROC
121 PROC COPY:​EXEC GF:​EXEC OBRVY:​PO=DPEEK(88)-1:​A=48536:​POKE 1782,​60:​POKE 1783,​0:​POKE 756,​188
122 OPEN #3,​8,​16*V+S,​"P:​":​FOR I=0 TO 23:​EXEC DEFCHAR:​EXEC TISK:​IF PEEK(764)=28:​EXIT:​ENDIF:​NEXT I:​CLOSE #3
123 POKE 756,​224:​POKE 1782,​56:​POKE 1783,​1
124 EXEC OBRVY:​EXEC KEYCTRL:​ENDPROC
125 PROC DEFCHAR:​B=DPEEK(88):​FOR J=0 TO 39:​FOR K=0 TO 7:​POKE A+J*8+K,​PEEK(B+I*320+K*40+J):​NEXT K:​NEXT J:​ENDPROC
126 PROC TISK:​? #3;A$(1,​KONEC);:​OD=PO+1:​PO=OD+319:​EXEC INVERZE:​ENDPROC
127 PROC BEEP:​A=15:​REPEAT:​DSOUND 1,​900,​12,​A:​PAUSE 2:​A=A-1:​UNTIL A=12:​A=15:​REPEAT:​DSOUND 1,​1800,​12,​A:​PAUSE 1
128 A=A-1:​UNTIL A=9:​A=14:​REPEAT:​DSOUND 1,​2700,​12,​A:​PAUSE 2:​A=A-2:​UNTIL A=0:​DSOUND:​ENDPROC
129 PROC KEYCTRL:​POKE 764,​255:​REPEAT:​UNTIL PEEK(764)<>255:​KEY=PEEK(764):​POKE 764,​255:​ENDPROC
130 PROC TEXT:​READ K:​FOR I=1 TO K:​READ B$:​? B$:​NEXT I:​ENDPROC
131 PROC INVER:​EXEC GF:​EXEC OBRVY:​OD=DPEEK(88):​PO=OD+7860:​EXEC INVERZE:​EXEC OBRUL:​EXEC KEYCTRL:​ENDPROC
132 PROC INVERZE:​FOR Z1=OD TO PO:​POKE Z1,​255-PEEK(Z1):​NEXT Z1:​ENDPROC
133 PROC OBRVY:​IF OBR=1:​A=32799:​ELSE:​A=40660:​ENDIF:​MOVE A,​DPEEK(88),​7680:​ENDPROC
134 PROC OBRUL:​IF OBR=1:​A=32799:​ELSE:​A=40660:​ENDIF:​MOVE DPEEK(88),​A,​7680:​ENDPROC
135 PROC GF:​GRAPHICS 8+16:​SETCOLOR 2,​5,​12:​SETCOLOR 1,​5,​0:​ENDPROC
136 PROC OBRAZ:​EXEC GF:​EXEC OBRVY:​EXEC KEYCTRL:​ENDPROC
137 PROC SAVES:​RESTORE #SAVED:​EXEC TEXT:​POSITION 30,​10:​? OBR:​POSITION 16,​14:​INPUT B$:​EXEC GF:​EXEC OBRVY
138 TRAP 139:​OPEN #4,​8,​0,​B$:​BPUT #4,​DPEEK(88),​7680
139 CLOSE #4:​ENDPROC
140 PROC LOADS:​EXEC VYGR:​RESTORE #LOADD:​EXEC TEXT:​POSITION 30,​15:​? OBR:​POSITION 16,​19:​INPUT B$:​EXEC GF
141 OPEN #1,​4,​0,​B$:​ON BEXEC LMAGPA,​L7680,​LKOAL,​L3840,​L7680
142 CLOSE #1:​EXEC KEYCTRL:​KEY=-1:​ENDPROC
143 PROC VYGR:​RESTORE #VYGRD:​EXEC TEXT
144 IF KEY=31:​B=1:​GOTO 147:​ELSE:​IF KEY=30:​B=2:​GOTO 147:​ELSE:​IF KEY=26:​B=3:​GOTO 147:​ELSE:​IF KEY=24:​B=4
145 GOTO 147:​ELSE:​IF KEY=29:​B=5:​GOTO 147:​ENDIF:​ENDIF:​ENDIF:​ENDIF:​ENDIF
146 KEY=-1:​EXEC KEYCTRL:​GOTO 144
147 KEY=-1:​ENDPROC
148 PROC LKOAL:​GRAPHICS 15+16:​TRAP 149:​A=USR(ADR(C$))
149 EXEC OBRUL:​EXEC GF:​EXEC OBRVY:​EXEC OBRUL:​ENDPROC
150 PROC L3840:​TRAP 151:​BGET #1,​DPEEK(88),​3840
151 EXEC P7N15:​EXEC OBRUL:​ENDPROC
152 PROC L7680:​TRAP 153:​BGET #1,​DPEEK(88),​7680:​EXEC OBRUL
153 ENDPROC
154 PROC LMAGPA:​BGET #1,​DPEEK(88),​6:​EXEC L3840:​A=DPEEK(88)+7679:​B=PEEK(A-1):​POKE A,​B:​POKE A-40,​B:​EXEC OBRUL
155 ENDPROC
156 PROC PREVOD:​EXEC GF:​COLOR 1:​RESTORE #PRED:​FOR I=1 TO 7:​READ A,​B,​B$:​TEXT A,​B,​B$:​NEXT I
157 IF OBR=1:​A=32799:​ELSE:​A=40660:​ENDIF:​FOR I=0 TO 191:​FOR J=0 TO 39:​B=PEEK(A+I*40+J):​EXEC PBIT:​NEXT J:​NEXT I
158 EXEC BEEP:​EXEC BEEP:​EXEC KEYCTRL:​IF KEY=33:​EXEC OBRUL:​ENDIF:​ENDPROC
159 PROC PBIT:​B$=HEX$(B):​B$=B$(1,​1):​K=0:​EXEC PL1:​EXEC PL2:​B$=HEX$(B):​B$=B$(2,​2):​K=4:​EXEC PL1:​EXEC PL2:​ENDPROC
160 PROC PL1:​Z1=2:​IF B$="0" OR B$="4" OR B$="8" OR B$="C" THEN EXEC BILA:​EXEC BOD:​GOTO 164
161 IF B$="1" OR B$="5" OR B$="9" OR B$="D" THEN EXEC SEDA1:​EXEC BOD:​GOTO 164
162 IF B$="2" OR B$="6" OR B$="A" OR B$="E" THEN EXEC SEDA2:​EXEC BOD:​GOTO 164
163 IF B$="3" OR B$="7" OR B$="B" OR B$="F" THEN EXEC CERNA:​EXEC BOD
164 ENDPROC
165 PROC PL2:​Z1=0:​IF B$="0" OR B$="1" OR B$="2" OR B$="3" THEN EXEC BILA:​EXEC BOD:​GOTO 169
166 IF B$="4" OR B$="5" OR B$="6" OR B$="7" THEN EXEC SEDA1:​EXEC BOD:​GOTO 169
167 IF B$="8" OR B$="9" OR B$="A" OR B$="B" THEN EXEC SEDA2:​EXEC BOD:​GOTO 169
168 IF B$="C" OR B$="D" OR B$="E" OR B$="F" THEN EXEC CERNA:​EXEC BOD
169 ENDPROC
170 PROC BOD:​COLOR COL1:​PLOT J*8+K+Z1,​I:​COLOR COL2:​PLOT J*8+K+Z1+1,​I:​ENDPROC
171 PROC BILA:​COL1=0:​COL2=0:​ENDPROC
172 PROC SEDA1:​COL1=0:​COL2=1:​ENDPROC
173 PROC SEDA2:​IF I/2=INT(I/2):​COL1=0:​COL2=0:​ELSE:​COL1=1:​COL2=1:​ENDIF:​ENDPROC
174 PROC CERNA:​COL1=1:​COL2=1:​ENDPROC
175 PROC P7N15:​A=DPEEK(88):​FOR I=3800 TO 0 STEP -40:​FOR J=0 TO 1:​MOVE A+I,​A+2*I+J*40,​40:​NEXT J:​NEXT I:​ENDPROC
176 PROC TITUL:​GRAPHICS 12+16:​POKE 712,​112:​RESTORE #TITD:​FOR I=1 TO 3:​READ A,​B,​B$:​TEXT A,​B,​B$:​NEXT I:​ENDPROC
177 PROC UVOD:​GRAPHICS 0:​SETCOLOR 2,​3,​2:​SETCOLOR 1,​3,​12:​POKE 752,​1:​RESTORE #UVD:​EXEC TEXT:​ENDPROC
178 PROC PRANI:​RESTORE #BLPD:​EXEC TEXT:​ENDPROC
179 PROC USRN:​RESTORE #USRD:​FOR I=1 TO 275:​READ A:​C$(I,​I)=CHR$(A):​NEXT I:​ENDPROC
180 ------------------------------
181 ------------------------------
1000 # MENUD:​DATA 13,​,​
1001 DATA ,​ HARDCOPY,​ OBRAZ-LOAD,​ OBRAZ-SAVE,​ OBRAZ-INVERZE
1002 DATA  OBRAZ-UKAZKA,​ OBRAZ-PREVOD,​ TEXT,​=PRERUSENI HARDCOPY (po dokonceni
1003 DATA tisku radku=8;16 nebo 24 mikroradku),​ = Navrat do MENU
1004 # ZVETD:​DATA 7,​,​Vyska =,​Sirka =,​ZVETSENI   nebo 
1005 DATA VYSKA   nebo ,​SIRKA   nebo ,​ = konec volby
1006 # VYBD:​DATA 3,​,​,​
1007 # SAVED:​DATA 3,​Podprogram SAVE bude ulozen,​. obraz,​Zarizeni:​Jmeno
1008 # LOADD:​DATA 3,​Podprogram LOAD bude nahran,​. obraz,​Zarizeni:​Jmeno
1009 # TEXTD:​DATA 2,​Zadej text pro tisk,​(max. 40 znaku)
1010 # VYGRD:​DATA 6,​,​ Magic-Painter,​ Design-Master (GR.8)
1011 DATA  Koala Microillustrator,​ GRAPHICS 7 (3840 bytu),​ GRAPHICS 9;10;11;15 (7680 bytu)
1012 # PRED:​DATA 15,​100,​,​15,​108,​**********************************
1013 DATA 15,​116,​* Cekej - pracuji !! *,​15,​124,​**********************************
1014 DATA 15,​132,​,​7,​150,​ Ponechani obr. v pameti a MENU
1015 DATA 7,​160,​ Navrat do MENU
1016 # TITD:​DATA 4,​0,​HARD,​4,​7,​COPY,​0,​14,​SUPER
1017 # UVD:​DATA 18,​,​Program je schopen provadet hardcopy,​obrazovky. Obrazy mohou byt vytvoreny
1018 DATA v grafice 7;8;9;10;11 nebo 15.,​Pri tisku obrazku je mozno volit,​zvetseni (vyska = 1 az 3)
1019 DATA  (sirka = 1 az 3),​Obrazek je mozno nejprve invertovat,​a az potom vytisknout.
1020 DATA Je-li obrazek v 4-barevne grafice,​(7 nebo 15) jevi se COLOR 1 a COLOR 2
1021 DATA jako svisle pruhy. Funkci PREVOD lze,​obraz transformovat tak aby byl COLOR
1022 DATA 2 zobrazen jako vodorovne pruhy.,​Funkce SAVE slouzi k prevodu obrazku,​v GR.7;9;10;11 nebo 15 do GR.8
1023 DATA s moznosti dale je zpracovat napr.,​programem Design-Master
1024 # BLPD:​DATA 5,​,​Prijemnou praci s programem preje,​autor.,​,​ Ing. Dubsky Jan (c) 1990
1025 # USRD:​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
1026 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
1027 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
1028 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
1029 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
1030 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
1031 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
1032 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
1033 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
1034 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,​144,​156	

• Download link 1
• Download link 2