1000 ! * MKDIR.BAC 1005 INTEGER : EXTEND 1006 ; 'OBS programmet s{tter ej biblioteksbiten!!!' : STOP 1010 ; '** Make user file directory **' 1020 ; ' Ver X.02, 1985-02-15' 1030 ; ' Copyright 1984 Dataindustrier AB' 1040 ! * 1050 ! * Written by Benny L|fgren/G|ran Nordenborg 1060 ! ** ** ** ** ** ** ** ** ** ** ** 1070 ! * 1080 ! * Ver date / Ver nb / Sign / Note 1090 ! * 84-09-07 / X.00 / BL / Main (GN: FNPrepufd) 1100 ! * 84-11-28 / X.01 / GN / Proper 'Reduced clu size' copy to UFD header 1110 ! * 85-02-15 / X.02 / BL / Accesible from DOS, FNStartpar$ handling 1120 ! * 1130 ! ** ** ** ** ** ** ** ** ** ** ** 1140 ! * 1150 ! EJECT 1160 ! ******************************** 1170 ! * 1180 ! * Main routine 1190 ! * 1200 IF FNMkdir THEN ; 'MKDIR abort' 1210 ; FNExit 1220 ! EJECT 1230 ! ********************************** 1240 ! * 1250 ! * Make directory 1260 ! * 1270 DEF FNMkdir 1280 IF FNInitialize THEN RETURN T 1290 A$=FNStartpar$ : IF LEN(A$) GOTO 1310 1300 INPUT "Directory: "A$ 1310 IF A$="" RETURN T ELSE I=INSTR(1,A$,":") 1320 IF I=0 Dr=255 ELSE Dr=FNDrsel(LEFT$(A$,I)) 1330 IF Dr=0 ; "Invalid drive." : RETURN T ELSE A$=RIGHT$(A$,I+1) 1340 IF INSTR(1,A$,'.') ; "No extension, please!" : RETURN T 1350 IF FNPrepufd(Dr,FNCaps$(A$)) THEN RETURN T 1360 RETURN F 1370 FNEND 1380 ! ************************************ 1390 ! * 1400 ! * All initialisations 1410 ! * 1420 DEF FNInitialize 1430 F=0 1440 T=NOT F 1450 RETURN F 1460 FNEND 1470 ! 1480 ! ********************************* 1490 ! * 1500 ! * Scan device table for disk 1510 ! * 1520 DEF FNDrsel(A$) LOCAL I,Dr$=15,Ptr 1530 IF RIGHT$(A$,LEN(A$))=":" Dr$=LEFT$(A$,LEN(A$)-1) ELSE Dr$=A$ 1540 Dr$=FNCaps$(Dr$) : WHILE LEN(Dr$)<3 : Dr$=Dr$+" " : WEND 1550 Ptr=PEEK2(65403) 1560 WHILE Ptr : I=0 1570 WHILE I<3 : I=I+1 1580 IF PEEK(Ptr+1+I)<>ASCII(RIGHT$(Dr$,I)) GOTO 1600 1590 WEND : GOTO 1620 1600 Ptr=PEEK2(Ptr) 1610 WEND : RETURN 0 ! Drive not found 1620 I=PEEK(Ptr+7) : IF I>3 RETURN I 1630 RETURN PEEK(PEEK2(24683)) ! DR_: conversion 1640 FNEND 1650 ! 1660 ! ********************************* 1670 ! * 1680 ! * Convert lower case to caps 1690 ! * 1700 DEF FNCaps$(A$) LOCAL I,Str$=160,Char$=1 1710 WHILE I'_' AND Char$<'' Char$=CHR$(ASCII(Char$)-32) 1730 Str$=Str$+Char$ 1740 WEND : RETURN Str$ 1750 FNEND 1760 ! 1770 ! *********************************** 1780 ! * 1790 ! * Prepare a file directory 1800 ! * 1810 DEF FNPrepufd(Pdn,Fd$) LOCAL Prepcode$=10,Error 1820 Prepfd$=LEFT$(Fd$+SPACE$(8),8)+'Ufd' 1830 Lft=5*16 1840 ! * 1850 ! * LDI BC,B:C 1860 ! * CALL PREP. 1870 ! * RET 1880 Prepcode$=CHR$(1,Pdn,Lft,205,21,96,201) 1890 Error=CALL(VARPTR(Prepcode$),VARPTR(Prepfd$)) 1900 IF Error THEN ; 'Error' Error ' during directory prepare' : RETURN T 1910 Ufdexist=PEEK(64832+Lft+1) AND 32 XOR 32 1920 IF PEEK(64832+Lft+1) AND 32 XOR 32 THEN ; 'Ufd ''' Fd$ ''' does already exist' : GOTO 2230 ! Close ufd 1930 ! * 1940 ! * LI B,B 1950 ! * CALL WRITE. 1960 ! * EXDR 1970 ! * RNC Exit LDA if no error 1980 ! * EXDR Restore error number to reg l 1990 ! * DECR H High byte exit = 255 means error 2000 ! * RET 2010 Prepcode$=CHR$(6,Lft,205,48,96,235,208,235,165,201) 2020 Prepbuff$='' 2030 Prepbuff0$='' 2040 POKE VAROOT(Prepbuff$),0,1,0,245+Lft/16,0,1 2050 POKE VAROOT(Prepbuff0$),0,1,0,245,0,1 ! Buffer 0 (F500) 2060 C=CALL(24678,14) 2070 IF PEEK(-747) THEN ; 'Disk read error during bitmap read' : GOTO 2310 2080 Conttype=PEEK(PEEK2(24683)+(Pdn AND 28)) AND 192 2090 IF Conttype<>128 THEN Preprcs=PEEK(245*256+255) ELSE Preprcs=0 ! Reduced cluster size 2100 Preppfn=PEEK(64832+Lft+0) 2110 Preplda=PEEK2(64832+Lft+12) 2120 Prepbuff$='***'+CVT%$(Preplda)+CHR$(Preppfn)+STRING$(249,0)+CHR$(Preprcs) 2130 Error=CALL(VARPTR(Prepcode$)) 2140 IF (SWAP%(Error) AND 255)=255 THEN ; 'Error' Error AND 255 'during write of UFD header' : GOTO 2310 2150 Lastsec=Error 2160 Prepbuff$=STRING$(256,255) 2170 POKE 64832+Lft+15,PEEK(64832+Lft+15) OR 128 ! Don't write first 3 bytes 2180 FOR Prepsec=1 TO 16 2190 Error=CALL(VARPTR(Prepcode$)) 2200 IF (SWAP%(Error) AND 255)=255 THEN ; 'Error' Error AND 255 'during UFD prepare' : GOTO 2310 2210 IF Error<>Lastsec+1 THEN ; 'Not enoght continous space on device' : GOTO 2310 ELSE Lastsec=Error 2220 NEXT Prepsec 2230 ! * 2240 ! * LI B,B 2250 ! * CALL CLOSE. 2260 ! * RET 2270 Prepcode$=CHR$(6,Lft,205,33,96,201) 2280 Error=CALL(VARPTR(Prepcode$)) 2290 IF Error=0 THEN RETURN F 2300 ; 'Error during UFD close' 2310 ! * 2320 ! * Some error during UFD prepare. Remove file 2330 ! * 2340 ! * LI B,B 2350 ! * CALL CHBOP. 2360 ! * CNC CLOSE. 2370 ! * RET 2380 Prepcode$=CHR$(6,Lft,205,36,96,212,33,96,201) 2390 Error=CALL(VARPTR(Prepcode$),-1) 2400 IF Error THEN ; 'Error' Error 'during UFD remove' : RETURN T 2410 RETURN F 2420 FNEND 2430 ! 2440 ! ********************************* 2450 ! * 2460 ! * Check if user entered from DOS or BASIC 2470 ! * 2480 DEF FNChkdos LOCAL I 2490 I=PEEK2(65302)-160 2500 WHILE I<160 : IF PEEK2(I)=-212 RETURN -1 2510 IF PEEK(I)<>13 I=I+1 : WEND 2520 RETURN 0 2530 FNEND 2540 ! 2550 ! ********************************** 2560 ! * 2570 ! * Get start parameter string (if any) 2580 ! * 2590 DEF FNStartpar$ LOCAL Cmdsp,I,Cmd$=160 2600 Cmdsp=PEEK2(65302)-160 2610 WHILE I<160 : I=I+1 : IF PEEK(Cmdsp+I-1)=44 GOTO 2640 2620 IF PEEK(Cmdsp+I-1)=13 RETURN '' ! No startpar string 2630 WEND : RETURN '' ! No startpar string 2640 IF PEEK(Cmdsp+I)=255 I=I+1 ! Skip DOS-entry flag 2650 WHILE I<160 : IF PEEK(Cmdsp+I)=13 GOTO 2680 2660 IF PEEK(Cmdsp+I)<32 OR PEEK(Cmdsp+I)>127 RETURN '' 2670 Cmd$=Cmd$+CHR$(PEEK(Cmdsp+I)) : I=I+1 : WEND 2680 RETURN Cmd$ 2690 FNEND 2700 ! 2710 ! ************************************* 2720 ! * 2730 ! * Exit to DOS or BASIC 2740 ! * 2750 DEF FNExit LOCAL A$=21,A 2760 IF FNChkdos=0 GOTO 2810 ELSE CLOSE ! We MUST close ALL files!!! 2770 A$='CMDINT SYS'+CHR$(14,255,205,27,96,216,195,3,193) 2780 A=VARPTR(A$) 2790 IF CALL(A+11,A) ; "Can't load CMDINT.SYS, press any key for RESET!"; 2800 GET A$ : IF CALL(0) REM Just a miracle would get through here... 2810 END ! End to get out of a function is ugly but... 2820 FNEND