1 REM Ins{nd av Bo Kullmar * <1789>    1985-10-15 23.43.37
2 ! **********************************************************************
3 ! Program          HUVUD.800        Utg}va  2.11     1985-10-15
4 ! av Gunnar Tidner, {ndrad av Bo Kullmar
5 ! Ins{nd av Bo Kullmar, 1789.
6 ! F|r ABC800M ABC800C ABC802 ABC806
8 ! Testad p} ABC806
9 ! **********************************************************************
10 ! Ett f|rs|k att bilda en standardhuvud f|r ABC-Klubbbens program.
20 ! ----------------------------------------------------------------------
30 ! En utfil :  "HEADER.BAS" bildas som sedan med MERGE sammanfogas
40 ! med huvudprogrammet innan slutgiltig programlagring sker.
50 ! ---------------------------------------------------------------------
60 ! Om du inte vill anget n}got s} kan du vid vissa fr}gor svar med <CR>.
70 ! ---------------------------------------------------------------------
80 ! Om du anger kombinationer med datortyper och grafik som inte finns s}
90 ! f}r du b|rja om igen med att ange datortyp och grafik!
100 ! ---------------------------------------------------------------------
110 INTEGER : EXTEND 
120 DIM U$=200,M$=200
1000 PREPARE 'HEADER.BAS' AS FILE 1 : L=1
1010 IF PEEK(-17)=255 THEN Z=FNTidinst
1020 ; CHR$(12) '*** Skapar Klubbens Standardhuvd ***' : ; : ; : ; 
1025 ; 'F|r anvisningar, lista programmet!' : ; : ; 
1030 ; "Programnamn: "; : INPUT LINE P$ : ; : P$=LEFT$(P$,LEN(P$)-2)
1040 IF LEN(P$)>12 ; 'max 12 tecken' : GOTO 1030
1050 IF LEN(P$)<1 THEN 1030
1060 D$=LEFT$(TIME$,10)
1070 ; "Version: "; : INPUT LINE V$ : ; : V$=LEFT$(V$,LEN(V$)-2)
1080 ; "Upphovsman: "; : INPUT LINE U$ : ; : U$=LEFT$(U$,LEN(U$)-2)
1090 IF U$='' THEN 1080
1100 ; "[ndrat av: "; : INPUT LINE P1$ : ; : P1$=LEFT$(P1$,LEN(P1$)-2)
1110 ; "Ins{nt av: "; : INPUT LINE I$ : ; : I$=LEFT$(I$,LEN(I$)-2)
1120 IF LEN(I$)=0 THEN ; 'Du m}ste ange vem som skickar in programmet!' : GOTO 1110
1130 Abc800m$='' : Abc800c$='' : Abc802$='' : Abc806$=''
1140 Hr$='' : Lr$='' : Ar$=''
1150 Abc800m=FNTyp('F|r ABC800 M')
1160 Abc800c=FNTyp('F|r ABC800 C')
1170 Abc802=FNTyp('F|r ABC802')
1180 Abc806=FNTyp('F|r ABC806')
1190 IF Abc800m THEN Abc800m$='ABC800M'
1200 IF Abc800c THEN Abc800c$=' ABC800C'
1210 IF Abc802 THEN Abc802$=' ABC802'
1220 IF Abc806 THEN Abc806$=' ABC806'
1230 Hr=FNTyp('F|r HR-grafik')
1240 IF Hr THEN Hr$=', med HR-grafik'
1250 Lr=FNTyp('F|r l}ggrafik')
1260 IF Lr THEN Lr$=', med l}ggrafik'
1270 Ar=FNTyp('F|r ASCII-gafik')
1280 IF Ar THEN Ar$=', med ASCII-grafik'
1290 Datortyp$=Abc800m$+Abc800c$+Abc802$+Abc806$+Hr$+Lr$+Ar$
1300 IF LEN(Datortyp$)=0 THEN ; CHR$(7) : ; 'Du m}ste ange datortyp!' : GOTO 1140
1310 IF LEFT$(Datortyp$,1)=' ' THEN Datortyp$=RIGHT$(Datortyp$,2)
1320 IF Abc800m AND Ar THEN ; CHR$(7) : ; 'ASCII grafik finns ej f|r ABC800 M!' : GOTO 1130
1330 IF Abc800m AND Lr THEN ; CHR$(7) : ; 'L}ggrafik finns ej f|r ABC800 M!' : GOTO 1130
1340 IF Abc802 AND Hr THEN ; CHR$(7) : ; 'Hr grafik finns ej f|r ABC802!' : GOTO 1130
1350 IF Abc806 AND Lr THEN ; CHR$(7) : ; 'L}ggrafik finns ej f|r ABC806!' : GOTO 1130
1355 ; 'Disktyp? Svara <CR> om programmet {r oberoende av disktyp!'
1360 ; 'F|r disk typ? '; : INPUT LINE Disktyp$ : Disktyp$=LEFT$(Disktyp$,LEN(Disktyp$)-2)
1370 ; 
1375 IF LEN(Disktyp$) Disktyp$=Disktyp$+', '
1380 Superdos=FNTyp('F|r UFD-DOS, svara CR om oberoende av DOS')
1390 IF Superdos THEN Superdos$='med UFD-DOS' ELSE Superdos$='med gammalt DOS'
1395 IF Superdos=10 Superdos$=''
1400 Disktyp$=Disktyp$+Superdos$
1410 T800m$='' : T800c$='' : T802$='' : T806$=''
1420 IF FNTyp('Testad p} ABC800 M') THEN T800m$=' ABC800M'
1430 IF FNTyp('Testad p} ABC800 C') THEN T800c$=' ABC800C'
1440 IF FNTyp('Testad p} ABC802') THEN T802$=' ABC802'
1450 IF FNTyp('Testad p} ABC806') THEN T806$=' ABC806'
1460 Test$=T800m$+T800c$+T802$+T806$
1470 IF LEN(Test$)=0 THEN ; 'Du m}ste ange dator som programmet {r testat p}!' : GOTO 1410
1480 IF LEFT$(Test$,1)=' ' THEN Test$=RIGHT$(Test$,2)
1490 ; #L,"2 ! "+STRING$(70,42)
1500 D$=" Utg}va  "+V$+SPACE$(9-LEN(V$))+D$
1510 ; #L,"3 ! Program          ";P$ TAB(38) D$
1520 IF LEN(P1$) THEN U$=U$+', {ndrad av '+P1$
1530 ; #L,"4 ! av ";U$
1540 ; #L,'5 ! Ins{nd av ' I$
1550 ; #L,"6 ! F|r " Datortyp$
1560 IF LEN(Disktyp$) THEN ; #L,'7 ! F|r disk ' Disktyp$
1570 ; #L,'8 ! Testad p} ' Test$
1580 ; "Extra kommentar rad" 9+I "? (avbryt med CR)"
1590 IF I=0 THEN ; 'Du kan t ex ange om programmet {ven kan k|ras p} alla diskar och dos!'
1600 INPUT LINE M$ : ; : M$=LEFT$(M$,LEN(M$)-2)
1610 IF LEN(M$) THEN ; #L,I+9 " ! ";M$ : I=I+1 : GOTO 1580
1620 ; #L,I+9 "! "+STRING$(70,42)
1630 CLOSE 1
1640 ; : ; 'Klart! Nu skall du ladda in programmet och sedan ge kommandot'
1650 ; 'MERGE HEADER.BAS, s} har du f}tt in ditt nya programhuvud i programmet.'
1660 END 
1670 DEF FNTidinst LOCAL ]r,M}nad,Dag,Tim,Min,Sek,Rad,Svar$=1
1680   ; CHR$(12) '*** Skapar Klubbens Standardhuvd ***' : ; : ; : ; 
1690   ; 'Inst{llning av datum och tid:'
1700   ; 
1710   INPUT ']r? ']r
1720   INPUT 'M}nad? 'M}nad
1730   INPUT 'Dag? 'Dag
1740   INPUT 'Tid (xx,xx,xx,) ? 'Tim,Min,Sek
1750   POKE -17,]r,M}nad,Dag,Tim,Min,Sek
1760   Rad=PEEK(-173)+1
1770   ; CUR(Rad,0) TIME$
1780   ; : ; '[r datum och tid riktig (J) ?'
1790   WHILE SYS(5)=0
1800     IF (PEEK(-11) AND 16)=0 THEN ; CUR(Rad+2,30) '_'; ELSE ; CUR(Rad+2,30) ' ';
1810     ; CUR(Rad,0) TIME$
1820   WEND 
1830   GET Svar$ : ; CUR(Rad+2,30) WHT Svar$
1840   IF Svar$='N' OR Svar$='n' THEN Z=FNTidinst ELSE RETURN 0
1850 FNEND 
1860 DEF FNTyp(Fr}ga$)
1870   ; Fr}ga$ '?  (J/N) ';
1880   GET Svar$ : ; Svar$
1890   IF INSTR(1,Fr}ga$,'UFD')=0 AND Svar$<>'J' AND Svar$<>'j' AND Svar$<>'N' AND Svar$<>'n' THEN 1870
1900   IF Svar$='J' OR Svar$='j' THEN RETURN -1
1910   IF Svar$='N' OR Svar$='n' THEN RETURN 0
1915   IF INSTR(1,Fr}ga$,'UFD')<>0 RETURN 10
1920 FNEND