1 REM Ins{nd av Paul Pries <5322>    1986-11-14 09.12.11 (SEND)
1 ! Info om POKEITH.BAC!
2 ! Programmet g|r en basic fil med poke-satser av en ITH-fil.
3 ! Valfri adressering och valfria radnummer. Infil m}ste ha ext. " ITH "
4 ! Utfil f}r ext. " PKE ".
5 ! 
6 ! F}r fritt anv{ndas av medlemmar i ABC-klubben, dock ej i komersiellt
7 ! syfte. 
8 ! 
9 ! Hopas det blir till nytta f|r n}'n!
10 ! Om intresse finns kan jag skicka fler filer av denna typen.
11 ! 
12 ! Testad p} 802 & 806.
13 ! 
14 ! 
15 ! 
100 ! Program : POKEITH.BAC
110 ! 
120 ! Rev. date    /    Rev.numb.    /    Sign.    /    Note
130 ! 86-09-27     /     1.00        /     Pri     /    Main
140 ! 
150 ! 
160 ! 
170 ! 
180 ! 
190 ! (c) Paul Pries  Pl.125 Nordan}, 23200 Arl|v, 040-445108 / -16
200 ! 
210 ! 
220 ! *************************************************************************
230 ! **                                                                     **
240 ! **                    Variable declaration part.                       **
250 ! **                                                                     **
260 ! *************************************************************************
270 ! 
280 EXTEND : INTEGER 
290 ! 
300 IF PEEK(65364%)>40% Sp$=SPACE$((PEEK(65364%)-40%)/2%)
310 Line1$=Sp$+'    Konvertering  .ITH  -->  POKE    '+Sp$
320 Line25$='     Copyright: Paul Pries, Pl.125 Nordan}, 23200 Arl|v, 040-445108 & 16   '
330 Inf%=1% : Uf%=2% : True%=-1% : False%=0% : X%=1%
340 H$='0123456789ABCDEF'
350 ! 
360 ! *************************************************************************
370 ! **                                                                     **
380 ! **                       Main program.                                 **
390 ! **                                                                     **
400 ! *************************************************************************
410 ! 
420 Z%=FNInit%
430 Z%=FNFiles% : IF NOT Z% GOTO 500
440 Z$=FNGetline$ : IF ASCII(Z$)>126% GOTO 500 ! Fault indication
450 Z%=FNChangeload%(Z$) : IF Z%=0% GOTO 500
460 Outline$=FNConvert$(Z$) : IF ASCII(Outline$)>126% GOTO 500
470 Z%=FNPutline%(Outline$) : IF NOT Z% GOTO 500
480 Z$=FNGetline$ : IF ASCII(Z$)>126% GOTO 500 ELSE IF ASCII(Z$)=32% GOTO 490 ELSE GOTO 460
490 Z%=FNMorefiles% : IF Z% GOTO 420
500 END 
510 END 
520 ! 
530 ! *************************************************************************
540 ! **                                                                     **
550 ! **                       Function declaration part                     **
560 ! **                                                                     **
570 ! *************************************************************************
580 ! 
590 DEF FNInit%
600   ; CHR$(12%) Line1$
610   Z%=FNLine25%(Line25$)
620   PRINT CUR(15%,15%) SPACE$(160%)
630   PRINT CUR(5%,15%); : INPUT ' Infil (.ITH) : 'Infil$
640   Z%=INSTR(1%,Infil$,'.')
650   IF Z% Inext$=MID$(Infil$,Z%,3%) ELSE Infil$=Infil$+'.ITH' : PRINT CUR(5%,31%) Infil$ : GOTO 680
660   IF Inext$='.BAC' PRINT CUR(15%,15%) CHR$(7%,7%,7%) ' Felaktigt programformat !! Ny infil? (J/N) ';
670   GET Sv$ : IF FNS%(Sv$) GOTO 620 ELSE RETURN False%
680   Utfil$=LEFT$(Infil$,INSTR(1%,Infil$,'.'))+'PKE'
690   PRINT CUR(7%,15%) ' Utfil :  ' Utfil$
700   RETURN True%
710 FNEND 
720 ! 
730 ! 
740 DEF FNFiles%
750   ON ERROR GOTO 790
760   OPEN Infil$ AS FILE Inf%
770   PREPARE Utfil$ AS FILE Uf%
780   RETURN True%
790   PRINT CUR(15%,15%) CHR$(7%,7%,7%) 'Error : ' ERRCODE ' !  Fler filer? (J/N) '; : GET Sv$
800   IF FNS%(Sv$) CLOSE : Z%=FNInit%+FNFiles% : RETURN True% ELSE GOTO 810
810   RETURN False%
820 FNEND 
830 ! 
840 ! 
850 DEF FNGetline$
860   ON ERROR GOTO 900
870   INPUT LINE #Inf%,A$ : A$=LEFT$(A$,LEN(A$)-4%) : Inline$=RIGHT$(A$,2%)
880   IF MID$(Inline$,8%,1%)='1' RETURN ''
890   RETURN Inline$
900   IF ERRCODE=34% PRINT CUR(15%,15%) CHR$(7%,7%,7%) ' Sista raden! ' : CLOSE Inf% : RETURN ''
910   CLOSE Inf% : RETURN CHR$(127%)
920 FNEND 
930 ! 
940 ! 
950 DEF FNChangeload%(Z$)
960   ON ERROR GOTO 1070
970   Adr$=MID$(Z$,3%,4%)
980   Adr%=FNCount%(Adr$,4096%,1%)
990   IF Adr%<0% GOTO 1070
1000   IF Adr%>ABS(32768%) GOTO 1020 ELSE GOTO 1010
1010   PRINT CUR(9%,15%) CHR$(7%,7%,7%) ' Du kan normalt inte POKE:a p} adress ' Adr%
1020   PRINT CUR(11%,15%) ' Modifiera laddadress? (J/N) '; : GET Sv$ : IF FNS%(Sv$)=0% PRINT CUR(13%,15%) : GOTO 1040
1030   PRINT CUR(13%,15%); : INPUT ' Ny laddadress : 'Ladr% : Adr%=Ladr%
1040   PRINT CUR(9%,15%) SPACE$(480%) : PRINT CUR(9%,15%);
1050   PRINT ' Laddadress : ' Adr%
1060   RETURN True%
1070   PRINT CUR(15%,15%) CHR$(7%,7%,7%) ' Fel har uppst}tt i adresshanteringen !  Tryck <RETURN> ! '
1080   GET Sv$ : PRINT CUR(15%,15%) SPACE$(160%)
1090   RETURN False%
1100 FNEND 
1110 DEF FNCount%(Adr$,A%,X%)
1120   Sum%=0%
1130   ON ERROR GOTO 1190
1140   WHILE FIX(A%)>0%
1150     Ad%=(INSTR(1%,H$,MID$(Adr$,X%,1%))-1%)*A%
1160     Sum%=Sum%+Ad% : A%=A%/16% : X%=X%+1%
1170   WEND 
1180   RETURN Sum%
1190   RETURN True%
1200 FNEND 
1210 ! 
1220 ! 
1230 DEF FNConvert$(Z$)
1240   ON ERROR GOTO 1340
1250   Outline$=''
1260   Line$=RIGHT$(Z$,9%)
1270   FOR N%=1% TO LEN(Line$)-1% STEP 2%
1280     U$=MID$(Line$,N%,2%)
1290     A%=16%
1300     Outline$=Outline$+NUM$(FNCount%(U$,16%,1%))+','
1310   NEXT N% : N{stalediga%=N%
1320   Outline$=LEFT$(Outline$,LEN(Outline$)-1%)
1330   RETURN Outline$
1340   RETURN CHR$(127%)
1350 FNEND 
1360 ! 
1370 ! 
1380 DEF FNPutline%(Outline$)
1390   ON ERROR GOTO 1480
1400   IF Flagga% GOTO 1440 ELSE Flagga%=True%
1410   PRINT CUR(11%,15%) CHR$(7%,7%,7%);
1420   INPUT ' Start radnummer f|r basicprogrammet : 'Rad%
1430   IF Rad%<1% PRINT CUR(11%,15%) SPACE$(160%) : GOTO 1410 ELSE 1440
1440   X$=NUM$(Rad%)+' '+'POKE'+' '+NUM$(Adr%)+','
1450   PRINT #Uf%,X$+Outline$
1460   Rad%=Rad%+1% : Adr%=Adr%+N{stalediga%/2%
1470   RETURN True%
1480   PRINT CUR(15%,15%) CHR$(7%,7%,7%) ' Error : ' ERRCODE ' har uppst}tt!  Tryck <RETURN> ! ' : GET Sv$
1490   PRINT CUR(15%,15%) SPACE$(160%) CUR(15%,15%)
1500   RETURN False%
1510 FNEND 
1520 ! 
1530 ! 
1540 DEF FNLine25%(Info$)
1550   OUT 56%,6%,57%,25%
1560   POKE VAROOT(Vdu$),80%,0%,32639%,127%
1570   Vdu$=Info$
1580   RETURN True%
1590 FNEND 
1600 ! 
1610 ! 
1620 DEF FNS%(Sv$)=((ASCII(Sv$) AND 95%)=74%) OR (Sv$='') 
1630 DEF FNMorefiles%
1640   PRINT CUR(15%,15%) ' Fler filer ?  (J/N) : '; : GET Sv$ : PRINT Sv$
1650   IF FNS%(Sv$) PRINT CUR(15%,15%) SPACE$(160%) CUR(15%,15%) : RETURN True%
1660   RETURN False%
1670 FNEND