1 REM Ins{nd av Erik Wetterberg <5948>  1987-01-21 Diskett
2 ! 
10 ! SAVE PEJLING.BAC
11 ! ------------------ pejling --------------------
20 ! spel f|r en deltagare och en dator
21 ! Instruktioner i PEJLING.INF som man kan n} ocks} med
22 ! programmets hj{lptangent.
30 ! 
40 ! utvecklat f|r Facit DTC 2
50 ! anpassat (efter b{sta f|rm}ga) {ven till ABC806
60 ! anpassning till andra datorer kan g|ras i FNInittang
70 ! Erik Wetterberg <5948>
80 ! --------------
81 ! Rev 19870314.1849 Bengt Sandgren <2776>
82 ! Sp{rrat rad 110 ATTIRBUTE
83 ! Rad 515 tillkommit f|r att ge alla ABC80x samma tangentfunktioner
84 ! Tagit bort CHAIN "NUL:" p} rad 740
85 ! Tagit bort CHAIN "meny" p} rad 480
86 ! [ndrat rad 1800
87 ! Rad 1480-1500 {ndrat f|r att ej texten skall krocka med grafiken vid
88 ! avslutat spel (ABC802).
89 ! 
90 ! -----------------------------------------------------
100 INTEGER 
110 ! ATTRIBUTE 1
120 RANDOMIZE 
130 DIM G%(0%:9%,0%:9%),Mark%(1%:8%,1%:8%)
140 True%=(1%=1%)
150 Z%=FNInittang%
160 Tkn$="A"
170 ! --------------- RITA PLAN ---------------------
180 PRINT CHR$(12%)
190 FOR Rad%=0% TO 19%
200   IF MOD(Rad%,2%)=0% THEN Str$="j    " ELSE Str$="zpppp"
210   IF Rad%=19% THEN Str$="*    "
220   PRINT CUR(Rad%,6%) GWHT RIGHT$(Str$,2%);
230   FOR I%=1% TO 9%
240     PRINT GWHT Str$;
250   NEXT I% 
260   PRINT WHT SPACE$(20%);
270 NEXT Rad% 
280 PRINT CUR(20%,5%) Tangtext1$;
290 PRINT CUR(21%,5%) Tangtext2$;
300 Rad%=0% : Kol%=0%
310 Z%=FNSlumpa%
320 A$=" "
330 WHILE A$<>Esc$
340   PRINT CUR(Rad%*2%,Kol%*5%+8%);
350   GET A$
360   IF A$=Upp$ THEN IF Rad%>0% Rad%=Rad%-1% ELSE PRINT CHR$(7%)
370   IF A$=Ner$ THEN IF Rad%<9% Rad%=Rad%+1% ELSE PRINT CHR$(7%)
380   IF A$=Fram$ THEN IF Kol%<9% Kol%=Kol%+1% ELSE PRINT CHR$(7%)
390   IF A$=Bak$ THEN IF Kol%>0% Kol%=Kol%-1% ELSE PRINT CHR$(7%)
400   IF A$=Pejl$ THEN Z%=FNPejla%(Tkn$) : Tkn$=CHR$(ASCII(Tkn$)+1%)
410   IF A$=Mark$ THEN Z%=FNRitaring%(Rad%,Kol%,1%)
420   IF A$=Radmark$ THEN Z%=FNRitaring%(Rad%,Kol%,0%)
430   IF A$=Help$ THEN Z%=FNHelp%("PEJLING.INF")
440 WEND 
450 Z%=FNAvsluta%
460 IF FNIgen% THEN GOTO 160
470 ON ERROR GOTO 490
480 ! CHAIN "meny"
490 END 
500 ! ------------------
510 DEF FNInittang%
515   IF PEEK(39%)>0% OR PEEK(39%)<5% OR PEEK(39%)=10% THEN GOTO 540
520   IF PEEK(39%)<>4% THEN GOTO 630
530   ! ----- tangentkoder ABC 80x ----------------
540   Tangtext1$="->:H|ger <-:V{nster PF5:Upp PF7:Ner CTRL-PF4:Hj{lp"
550   Tangtext2$="PF1:Pejla PF2:S{tt mark PF3:Radera mark PF4:Avsluta"
560   Esc$=CHR$(195%) : Ret$=CHR$(13%)
570   Del$=CHR$(199%) : Linedel$=CHR$(24%)
580   Upp$=CHR$(196%) : Ner$=CHR$(198%)
590   Fram$=CHR$(9%) : Bak$=CHR$(8%)
600   Pejl$=CHR$(192%) : Mark$=CHR$(193%) : Radmark$=CHR$(194%)
610   Help$=CHR$(227%)
620   RETURN 0%
630   IF PEEK(39%)<>6% THEN GOTO 730
640   ! ----- tangentkoder Facit DTC 2 ------------
650   Tangtext1$="F1:Pejla  F2:S{tt mark  C:Radera mark  Esc:Avsluta"
660   Esc$=CHR$(27%) : Ret$=CHR$(13%)
670   Del$=CHR$(8%) : Linedel$=CHR$(24%)
680   Upp$=CHR$(160%) : Ner$=CHR$(161%)
690   Fram$=CHR$(163%) : Bak$=CHR$(162%)
700   Pejl$=CHR$(206%) : Mark$=CHR$(207%) : Radmark$=CHR$(24%)
710   Help$=CHR$(165%)
720   RETURN 0%
730   PRINT CHR$(12%)+"Programmet ej anpassat f|r denna dator"+CHR$(7%)
740   RETURN 0% ! CHAIN "NUL:"
750 FNEND 
760 ! -------------------------------
770 DEF FNSlumpa% LOCAL Radsl%,Kolsl%,Antal%
780   Antal%=FNReadtal%("Antal hinder(1-5): ",4%,23%,5%)
790   IF Antal%<1% OR Antal%>5% THEN PRINT CHR$(7%); : GOTO 780
800   Radsl%=INT(RND*8%)+1% : Kolsl%=INT(RND*8%)+1%
810   FOR I%=1% TO Antal%
820     WHILE G%(Radsl%,Kolsl%)<>0%
830       Radsl%=INT(RND*8%)+1% : Kolsl%=INT(RND*8%)+1%
840     WEND 
850     G%(Radsl%,Kolsl%)=1%
860   NEXT I% 
870   RETURN 0%
880 FNEND 
890 ! -------------------------------
900 DEF FNRitaring%(Inrad%,Inkol%,Inf{rg%) LOCAL Lch1$=3,Lch2$=3
910   IF Inrad%=0% OR Inrad%=9% OR Inkol%=0% OR Inkol%=9% THEN RETURN 0%
920   Lch1$="   " : Lch2$=CHR$(112%,112%,112%)
930   IF Inf{rg%=1% THEN Lch1$=CHR$(60%,44%,52%) : Lch2$=CHR$(115%,115%,113%)
940   PRINT GWHT CUR(Inrad%*2%,Inkol%*5%+7%) Lch1$;
950   PRINT GWHT CUR(Inrad%*2%+1%,Inkol%*5%+7%) Lch2$;
960   Mark%(Inrad%,Inkol%)=Inf{rg%
970   RETURN 0%
980 FNEND 
990 ! -------------------
1000 DEF FNPejla%(Id$) LOCAL V{%,H|%,Rpos%,Kpos%
1010   IF NOT ((Rad%=0% OR Rad%=9%) XOR (Kol%=0% OR Kol%=9%)) THEN ; CHR$(7%) : RETURN 0%
1020   PRINT CUR(Rad%*2%,Kol%*5%+8%) WHT Id$;
1030   IF Rad%=0% THEN Rrikt%=1% : Krikt%=0%
1040   IF Rad%=9% THEN Rrikt%=-1% : Krikt%=0%
1050   IF Kol%=0% THEN Krikt%=1% : Rrikt%=0%
1060   IF Kol%=9% THEN Krikt%=-1% : Rrikt%=0%
1070   Rpos%=Rad% : Kpos%=Kol%
1080   T$=""
1090   ! ----------------- LOOP
1100   IF G%(Rpos%+Rrikt%,Kpos%+Krikt%) THEN T$="+" : Z%=FNV{nd% : GOTO 1200
1110   IF Rrikt%<>0% THEN V{%=G%(Rpos%+Rrikt%,Kpos%+Rrikt%) : H|%=G%(Rpos%+Rrikt%,Kpos%-Rrikt%)
1120   IF Krikt%<>0% THEN V{%=G%(Rpos%-Krikt%,Kpos%+Krikt%) : H|%=G%(Rpos%+Krikt%,Kpos%+Krikt%)
1130   IF V{% AND H|% THEN Z%=FNV{nd% : GOTO 1170
1140   IF H|% THEN Z%=FNV{nster% : GOTO 1170
1150   IF V{% THEN Z%=FNH|ger% : GOTO 1170
1160   Rpos%=Rpos%+Rrikt% : Kpos%=Kpos%+Krikt%
1170   IF Rpos%>0% AND Rpos%<9% AND Kpos%>0% AND Kpos%<9% THEN GOTO 1090
1180   PRINT CUR(Rpos%*2%+1%,Kpos%*5%+7%) WHT T$+CHR$(ASCII(Id$) OR 32%);
1190   RETURN 0%
1200   IF Rrikt%=1% THEN Rpos%=9%
1210   IF Rrikt%=-1% THEN Rpos%=0%
1220   IF Krikt%=1% THEN Kpos%=9%
1230   IF Krikt%=-1% THEN Kpos%=0%
1240   GOTO 1180
1250 FNEND 
1260 DEF FNV{nd%
1270   Rrikt%=-Rrikt% : Krikt%=-Krikt%
1280   RETURN 0%
1290 FNEND 
1300 DEF FNV{nster%
1310   IF Rrikt%<>0% THEN Krikt%=Rrikt% : Rrikt%=0% : RETURN 0%
1320   IF Krikt%<>0% THEN Rrikt%=-Krikt% : Krikt%=0% : RETURN 0%
1330 FNEND 
1340 DEF FNH|ger%
1350   IF Rrikt%<>0% THEN Krikt%=-Rrikt% : Rrikt%=0% : RETURN 0%
1360   IF Krikt%<>0% THEN Rrikt%=Krikt% : Krikt%=0% : RETURN 0%
1370 FNEND 
1380 ! ----------------------------------------
1390 DEF FNAvsluta% LOCAL Traff%,Ejhitt%,Miss%
1400   FOR I%=1% TO 8%
1410     FOR J%=1% TO 8%
1420       IF G%(I%,J%) THEN Z%=FNSetdot%(I%*6%+2%,J%*10%+15%)+FNSetdot%(I%*6%+2%,J%*10%+16%)+FNSetdot%(I%*6%+2%,J%*10%+17%)
1430       IF G%(I%,J%) THEN IF Mark%(I%,J%) THEN Traff%=Traff%+1% ELSE Ejhitt%=Ejhitt%+1%
1440       IF NOT G%(I%,J%) AND Mark%(I%,J%) THEN Miss%=Miss%+1%
1450       G%(I%,J%)=0% : Mark%(I%,J%)=0%
1460     NEXT J% 
1470   NEXT I% 
1480   PRINT WHT CUR(20%,65%) "Tr{ffar: " Traff%;
1490   PRINT CUR(21%,65%) "Ej hitttade:" Ejhitt%;
1500   PRINT CUR(22%,65%) "Missar:" Miss%
1510   RETURN 0%
1520 FNEND 
1530 ! -----------------------------
1540 DEF FNHelp%(Filnamn$) LOCAL Scr$=0,Save$=2048,T$=1,Line$=80,Rad%,Eof%
1550   ON ERROR GOTO 1750
1560   POKE VAROOT(Scr$),0%,8%,0%,120%,0%,8%
1570   Save$=Scr$
1580   OPEN Filnamn$ AS FILE 9%
1590   Eof%=NOT True%
1600   PRINT CHR$(12%)
1610   WHILE NOT Eof%
1620     Rad%=0%
1630     WHILE Rad%<23% AND NOT Eof%
1640       INPUT LINE #9%,Line$
1650       PRINT CUR(23%,0%) Line$;
1660       Rad%=Rad%+1%
1670     WEND 
1680     PRINT CUR(23%,50%) "Tryck p} n}gon tangent"; : GET T$
1690     PRINT CUR(23%,50%) SPACE$(30%);
1700   WEND 
1710   PRINT CHR$(12%)
1720   Scr$=Save$
1730   CLOSE 9%
1740   RETURN 0%
1750   IF ERRCODE=34% THEN Eof%=True% : RESUME 1680
1760   PRINT "FNHelp errcode: " ERRCODE : STOP 
1770 FNEND 
1780 ! --------------------------------
1790 DEF FNIgen% LOCAL S$=1
1800   PRINT CUR(23%,5%) WHT "En omg}ng till Jj/Nn       ";
1810   WHILE 1%
1820     GET S$
1830     IF S$="J" OR S$="j" THEN RETURN True%
1840     IF S$="N" OR S$="n" THEN RETURN NOT True%
1850     PRINT CHR$(7%);
1860   WEND 
1870 FNEND 
1880 ! -----------------------------
1890 DEF FNReadtal%(Inprompt$,In%,Inrad%,Inkol%) LOCAL Lch%,Lnr%,Ltxt$=5
1900   ! inl{sning av ett heltal
1910   ON ERROR GOTO 2090
1920   Ltxt$=NUM$(In%)+SPACE$(5%-LEN(NUM$(In%)))
1930   Lnr%=1%
1940   PRINT WHT CUR(Inrad%,Inkol%) Inprompt$+Ltxt$;
1950   PRINT CUR(Inrad%,Inkol%+LEN(Inprompt$)+Lnr%-1%);
1960   GET Lch$
1970   IF Lch$=Ret$ THEN GOTO 2070
1980   IF Lch$=Del$ AND Lnr%>1% THEN MID$(Ltxt$,Lnr%-1%,6%-Lnr%)=RIGHT$(Ltxt$,Lnr%) : Lnr%=Lnr%-1% : GOTO 1940
1990   IF Lch$=Linedel$ THEN MID$(Ltxt$,1%,5%)=SPACE$(5%) : Lnr%=1% : GOTO 1940
2000   IF Lch$=Bak$ AND Lnr%>1% THEN Lnr%=Lnr%-1% : GOTO 1950
2010   IF Lch$=Fram$ AND Lnr%<5% THEN Lnr%=Lnr%+1% : GOTO 1950
2020   IF Lch$=Help$ THEN Z%=FNHelp%("PEJLING.INF") : GOTO 1950
2030   IF Lch$<"0" OR Lch$>"9" THEN PRINT CHR$(7%); : GOTO 1960
2040   IF Lnr%>5% THEN PRINT CHR$(7%); : GOTO 1960
2050   PRINT Lch$; : MID$(Ltxt$,Lnr%,1%)=Lch$
2060   Lnr%=Lnr%+1% : GOTO 1960
2070   IF Ltxt$=SPACE$(5%) THEN RETURN 0% ELSE RETURN VAL(Ltxt$)
2080   ! ------- felhantering fnreadtal --------
2090   IF ERRCODE=210% THEN PRINT CHR$(7%) : RESUME 1930
2100   PRINT " ** FNReadtal Errcode: " ERRCODE : STOP 
2110 FNEND 
2120 ! 
2130 ! ----------- subrutiner f|r l}guppl|sningsgrafik
2140 DEF FNLowres%(Rad%,Kol%,Funk%) LOCAL Adr%,Schr%,Trad%,Tkol%,Bitmap%
2150   Trad%=Rad%/3% : Tkol%=Kol%/2%
2160   Adr%=30720%+(80%*Trad%)+Tkol%
2170   Schr%=PEEK(Adr%)
2180   IF Schr%>160% THEN Schr%=0%
2190   IF Schr%>31% AND Schr%<128% THEN Schr%=0%
2200   Trad%=MOD(Rad%,3%) : Tkol%=MOD(Kol%,2%)
2210   IF Trad%=0% THEN IF Tkol%=0% THEN Bitmap%=1% ELSE Bitmap%=2%
2220   IF Trad%=1% THEN IF Tkol%=0% THEN Bitmap%=4% ELSE Bitmap%=8%
2230   IF Trad%=2% THEN IF Tkol%=0% THEN Bitmap%=16% ELSE Bitmap%=128%
2240   IF Funk%=0% THEN POKE Adr%,Schr% AND NOT Bitmap%
2250   IF Funk%=1% THEN POKE Adr%,Schr% OR Bitmap%
2260   RETURN PEEK(Adr%) AND Bitmap%
2270 FNEND 
2280 DEF FNSetdot%(Rad%,Kol%)=FNLowres%(Rad%,Kol%,1%) 
2290 DEF FNClrdot%(Rad%,Kol%)=FNLowres%(Rad%,Kol%,0%) 
2300 DEF FNDot%(Rad%,Kol%)=FNLowres%(Rad%,Kol%,2%)<>0% 
2310 DEF FNTxpoint%(Kol%,Rad%,Funk%)=FNLowres%(71%-Rad%,Kol%,Funk%)