1 ON ERROR PRINT REPORT$;" at ";ERL : END
    2 REM Scan input to get text
    3 DIM C$(33),TEXT$(256),ISDICT%(256),USED%(256),ISTEXT%(256)
    4 NUMTEXT%=1
    5 TEXT$(0)="?":USED%(0)=1:ISTEXT%(0)=1
    6 numtypes%=0
    7 typesize%=0
    8 DIM typeindex%(128),typeinfo% 4096
    9 numclasses%=0
   10 DIM classinfo% 256
   11 DIM classnames$(12)
   12 numtiles%=0
   13 DIM tileinfo% 256
   14 numbooks%=0
   15 nummags%=0
   16 F%=OPENIN("duntsv")
   17 L$=GET$#F%
   18 REPEAT
   19   PROCgetline
   20   textworthy%=0
   21   IF C$(2)="Weapon" OR C$(2)="Ammo" OR LEFT$(C$(2),6)="Armour" OR C$(2)="Book" OR C$(2)="Magazine" OR C$(2)="Drink" OR C$(2)="Food" OR C$(2)="Item" OR C$(2)="Monster" OR C$(2)="Dungeon" OR C$(2)="Cash" OR C$(2)="Dictionary" THEN textworthy%=1
   22   IF textworthy%=1 THEN PROCaddtext(C$(1)):PROCaddtext(C$(10)):ISTEXT%(FNgettext(C$(10)))=1:PROCaddtext(C$(11)):ISTEXT%(FNgettext(C$(11)))=1
   23   IF C$(2)="Dictionary" THEN ISDICT%(FNgettext(C$(1)))=1 ELSE IF textworthy%=1 THEN ISTEXT%(FNgettext(C$(1)))=1
   24   IF C$(2)="Class" THEN PROCclass
   25 UNTIL EOF#F%
   26 CLOSE#F%
   27 DIM INDIR%(256)
   28 J=0
   29 FOR I=0 TO NUMTEXT%-1
   30   IF ISDICT%(I)=0 THEN INDIR%(J)=I : J=J+1
   31 NEXT I
   32 IF J<128 THEN PRINT "Not enough non-dictionary text ("+J+")" : END
   33 DICTSTART=J
   34 FOR I=0 TO NUMTEXT%-1
   35   IF ISDICT%(I)=1 THEN INDIR%(J)=I : J=J+1
   36 NEXT I
   37 F%=OPENIN("duntsv")
   38 L$=GET$#F%
   39 REPEAT
   40   PROCgetline
   41   IF C$(2)="Weapon" THEN PROCweapon
   42   IF C$(2)="Ammo" THEN PROCammo
   43   IF LEFT$(C$(2),6)="Armour" THEN PROCarmour
   44   IF C$(2)="Book" THEN PROCbook
   45   IF C$(2)="Magazine" THEN PROCmagazine
   46   IF C$(2)="Software" THEN PROCsoftware
   47   IF C$(2)="Drink" THEN PROCdrink
   48   IF C$(2)="Food" THEN PROCfood
   49   IF C$(2)="Item" THEN PROCitem
   50   IF C$(2)="Monster" THEN PROCmonster
   51   IF C$(2)="Fake monster" THEN PROCfake
   52   IF C$(2)="Dungeon" THEN PROCdungeon
   53   IF C$(2)="Cash" THEN PROCcash
   54   IF C$(2)="Dictionary" OR C$(2)="Class" OR C$(2)="" THEN OK=1
   55   IF OK=0 THEN PRINT "Unknown type '"+C$(2)+"' encountered"
   56 UNTIL EOF#F%
   57 CLOSE#F%
   58 FOR I=0 TO numtypes%-1
   59   PRINT "Type ";I;" = ";TEXT$(INDIR%(typeinfo%?(typeindex%(I)+1)));" class ";typeinfo%?(typeindex%(I))
   60   IF classnames$(typeinfo%?(typeindex%(I)))="Monster" THEN PROCfixinv(I)
   61 NEXT I
   62 FOR I=0 TO numclasses%-1
   63   PRINT "Class ";I;" = ";classnames$(I)
   64 NEXT I
   65 FOR I=0 TO numtiles%-1
   66   PRINT "Tile ";I;" = ";TEXT$(INDIR%(tileinfo%?(I*3)))
   67 NEXT I
   68 tosave%=0
   69 FOR T=0 TO DICTSTART-1
   70   PRINT "String ";T;" = ";TEXT$(INDIR%(T));" (Used ";USED%(INDIR%(T));" times)"
   71   IF USED%(INDIR%(T))=0 THEN tosave%=tosave%+2
   72   FOR D=DICTSTART TO NUMTEXT%-1
   73     REPEAT
   74       P=INSTR(TEXT$(INDIR%(T)),TEXT$(INDIR%(D)))
   75       IF USED%(INDIR%(T))=0 THEN P=0
   76       IF P<>0 THEN TEXT$(INDIR%(T))=LEFT$(TEXT$(INDIR%(T)),P-1)+CHR$(D)+MID$(TEXT$(INDIR%(T)),P+LEN(TEXT$(INDIR%(D)))):USED%(INDIR%(D))=USED%(INDIR%(D))+1
   77     UNTIL P=0
   78   NEXT D
   79 NEXT T
   80 FOR T=DICTSTART TO NUMTEXT%-1
   81   save%=USED%(INDIR%(T))*(LEN(TEXT$(INDIR%(T)))-1)-(LEN(TEXT$(INDIR%(T)))+2)
   82   IF ISTEXT%(INDIR%(T)) THEN save%=save%+LEN(TEXT$(INDIR%(T)))+2
   83   PRINT "String ";T;" = ";TEXT$(INDIR%(T));" (Used ";USED%(INDIR%(T));" times; ";save%;" byte saving";
   84   IF ISTEXT%(INDIR%(T)) THEN PRINT "; also text)" ELSE IF save%<=0 THEN PRINT ") **removed**" ELSE PRINT ")"
   85   IF save%<=0 AND ISTEXT%(INDIR%(T))=0 THEN PROCundict(T):T=T-1
   86   IF T=NUMTEXT%-1 THEN T=1000000
   87 NEXT T
   88 F%=OPENOUT("dundat")
   89 REM headers...
   90 PROCdbl(6+2*numtypes%+typesize%)
   91 PROCdbl(6+2*numtypes%+typesize%+2*numclasses%)
   92 PROCdbl(6+2*numtypes%+typesize%+2*numclasses%+3*numtiles%)
   93 REM Type data
   94 FOR I=0 TO numtypes%-1
   95   PROCdbl(numtypes%*2+typeindex%(I))
   96 NEXT I
   97 FOR I=0 TO typesize%-1
   98   BPUT#F%,typeinfo%?I
   99 NEXT I
  100 REM Class data
  101 FOR I=0 TO numclasses%*2-1
  102   BPUT#F%,classinfo%?I
  103 NEXT I
  104 REM Tile data
  105 FOR I=0 TO numtiles%*3-1
  106   BPUT#F%,tileinfo%?I
  107 NEXT I
  108 REM Text data
  109 P=NUMTEXT%*2+2
  110 FOR I=0 TO NUMTEXT%
  111   PROCdbl(P)
  112   IF I<NUMTEXT% AND USED%(INDIR%(I))>0 THEN P=P+LEN(TEXT$(INDIR%(I)))
  113 NEXT I
  114 FOR I=0 TO NUMTEXT%-1
  115   IF USED%(INDIR%(I))>0 THEN BPUT#F%,TEXT$(INDIR%(I));
  116 NEXT I
  117 CLOSE#F%
  118 PRINT numtypes%;" types, ";typesize%;" data size"
  119 PRINT numclasses%;" classes"
  120 PRINT numtiles%;" tiles"
  121 PRINT numbooks%;" books"
  122 PRINT nummags%;" magazines"
  123 PRINT NUMTEXT%;" strings (";(NUMTEXT%-DICTSTART);" dictionary)"
  124 PRINT tosave%;" bytes can be saved by removing unused strings" 
  125 END
  126 DEF PROCgetline
  127 OK=0
  128 L$=GET$#F%
  129 L$=L$+CHR$(9)
  130 S=1
  131 FOR C=1 TO 33
  132   E=INSTR(L$,CHR$(9),S)
  133   IF E<>0 THEN C$(C)=MID$(L$,S,E-S) : S=E+1 ELSE C$(C)=""
  134 NEXT C
  135 ENDPROC
  136 DEF PROCaddtext(T$)
  137 IF T$="" THEN ENDPROC
  138 FOR I=0 TO NUMTEXT%-1
  139   IF TEXT$(I)=T$ THEN ENDPROC
  140 NEXT I
  141 TEXT$(NUMTEXT%)=T$
  142 NUMTEXT%=NUMTEXT%+1
  143 ENDPROC
  144 DEF FNgettext(T$)
  145 FOR T=0 TO NUMTEXT%-1
  146   IF TEXT$(T)=T$ THEN =T
  147 NEXT T
  148 =255
  149 DEF PROCweapon
  150 PROCstd
  151 typeinfo%?typesize%=FNgettext2(C$(11))
  152 typesize%=typesize%+1
  153 typeinfo%?typesize%=FNgetval(C$(12))
  154 typesize%=typesize%+1
  155 ENDPROC
  156 DEF PROCammo
  157 PROCstd
  158 ENDPROC
  159 DEF PROCarmour
  160 PROCstd
  161 T=-1
  162 IF C$(2)="Armour (badge)" THEN T=1
  163 IF C$(2)="Armour (chest)" THEN T=2
  164 IF C$(2)="Armour (coat)" THEN T=4
  165 IF C$(2)="Armour (glasses)" THEN T=8
  166 IF T=-1 THEN PRINT "Unknown armour type: ";C$(2):CLOSE#F%:END
  167 typeinfo%?typesize%=T
  168 typesize%=typesize%+1
  169 typeinfo%?typesize%=FNgetval(C$(13))
  170 typesize%=typesize%+1
  171 ENDPROC
  172 DEF PROCbook
  173 PROCstd
  174 typeinfo%?typesize%=1+numbooks%+13*nummags% : REM books are always issue 0
  175 typesize%=typesize%+1
  176 numbooks%=numbooks%+1
  177 ENDPROC
  178 DEF PROCmagazine
  179 PROCstd
  180 typeinfo%?typesize%=numbooks%+13*nummags% : REM magazines are issue 1-13
  181 typesize%=typesize%+1
  182 nummags%=nummags%+1
  183 ENDPROC
  184 DEF PROCsoftware
  185 OK=1
  186 PRINT "Skipping software entry '"+C$(1)+"'"
  187 ENDPROC
  188 DEF PROCdrink
  189 PROCstd
  190 typeinfo%?typesize%=FNgetval(C$(28))
  191 typesize%=typesize%+1
  192 typeinfo%?typesize%=FNgetval(C$(29))
  193 typesize%=typesize%+1
  194 ENDPROC
  195 DEF PROCfood
  196 PROCstd
  197 typeinfo%?typesize%=FNgetval(C$(28))
  198 typesize%=typesize%+1
  199 typeinfo%?typesize%=FNgetval(C$(29))
  200 typesize%=typesize%+1
  201 ENDPROC
  202 DEF PROCitem
  203 PROCstd
  204 ENDPROC
  205 DEF PROCmonster
  206 PROCstd
  207 typeinfo%?typesize%=FNgetval(C$(16))
  208 typesize%=typesize%+1
  209 typeinfo%?typesize%=FNgetval(C$(18))
  210 typesize%=typesize%+1
  211 typeinfo%?typesize%=FNgetval(C$(19))
  212 typesize%=typesize%+1
  213 typeinfo%?typesize%=FNgetval(C$(20))
  214 typesize%=typesize%+1
  215 typeinfo%?typesize%=FNgetval(C$(21))
  216 typesize%=typesize%+1
  217 typeinfo%?typesize%=FNgetval(C$(22))
  218 typesize%=typesize%+1
  219 typeinfo%?typesize%=FNgetval(C$(23))*8+128
  220 typesize%=typesize%+1
  221 typeinfo%?typesize%=FNgetval(C$(24))*8+128
  222 typesize%=typesize%+1
  223 typeinfo%?typesize%=FNgetval(C$(25))*8+128
  224 typesize%=typesize%+1
  225 typeinfo%?typesize%=FNgetval(C$(26))*8+128
  226 typesize%=typesize%+1
  227 typeinfo%?typesize%=FNgetval(C$(27))*8+128
  228 typesize%=typesize%+1
  229 typeinfo%?typesize%=FNgetchar(C$(4))
  230 typesize%=typesize%+1
  231 typeinfo%?typesize%=monflags
  232 typesize%=typesize%+1
  233 typeinfo%?typesize%=FNgetval(C$(28))
  234 typesize%=typesize%+1
  235 typeinfo%?typesize%=FNgetval(C$(29))
  236 typesize%=typesize%+1
  237 REM Inventory...
  238 I$=C$(30)+","
  239 S=1
  240 REPEAT
  241   E=INSTR(I$,",",S)
  242   IF E<>0 THEN PROCinv(MID$(I$,S,E-S)) : S=E+1
  243 UNTIL E=0
  244 typeinfo%?typesize%=255
  245 typesize%=typesize%+1
  246 ENDPROC
  247 DEF PROCfake
  248 OK=1
  249 PRINT "Skipping fake entry '"+C$(1)+"'"
  250 ENDPROC
  251 DEF PROCdungeon
  252 OK=1
  253 tileinfo%?(numtiles%*3)=FNgettext2(C$(1))
  254 tileinfo%?(numtiles%*3+1)=FNgetchar(C$(4))
  255 tileinfo%?(numtiles%*3+2)=FNgetflags(C$(9)) OR FNgetflags(C$(5))
  256 numtiles%=numtiles%+1
  257 IF numtiles%>32 THEN PRINT "Too many tiles!" : CLOSE#F% : END
  258 ENDPROC
  259 DEF PROCclass
  260 classinfo%?(numclasses%*2)=FNgetchar(C$(4))
  261 classnames$(numclasses%)=C$(1)
  262 classinfo%?(numclasses%*2+1)=FNgetval(C$(12))
  263 numclasses%=numclasses%+1
  264 ENDPROC
  265 DEF FNgettext2(T$)
  266 IF T$="" THEN USED%(0)=USED%(0)+1:=0
  267 FOR TT=0 TO NUMTEXT%-1
  268   IF TEXT$(INDIR%(TT))=T$ THEN USED%(INDIR%(TT))=USED%(INDIR%(TT))+1:=TT
  269 NEXT TT
  270 PRINT "Can't find text '"+T$+"'!"
  271 CLOSE#F%
  272 END
  273 DEF PROCdbl(T)
  274 BPUT#F%,T MOD 256
  275 BPUT#F%,T DIV 256
  276 ENDPROC
  277 DEF PROCstd
  278 OK=1
  279 typeindex%(numtypes%)=typesize%
  280 numtypes%=numtypes%+1
  281 typeinfo%?typesize%=FNgetclass(C$(2))
  282 typesize%=typesize%+1
  283 typeinfo%?typesize%=FNgettext2(C$(1))
  284 typesize%=typesize%+1
  285 IF C$(3)="" THEN C$(3)="£0"
  286 V$=MID$(C$(3),2)
  287 IF INSTR(V$,".") THEN SH=INSTR(V$,".")-LEN(V$):V$=LEFT$(V$,INSTR(V$,".")-1)+RIGHT$(V$,-SH) ELSE SH=0
  288 REPEAT
  289   IF RIGHT$(V$,1)="0" THEN V$=LEFT$(V$,LEN(V$)-1):SH=SH+1
  290 UNTIL RIGHT$(V$,1)<>"0"
  291 C=VAL(V$)
  292 V$=STR$(C*10^SH)
  293 IF C>255 OR VAL(V$)<>VAL(MID$(C$(3),2)) THEN PRINT "Cost error: ";C$(3);"->";V$;" ";C;"E";SH;" for ";C$(1) : CLOSE#F% : END
  294 typeinfo%?typesize%=C
  295 typesize%=typesize%+1
  296 typeinfo%?typesize%=SH+128
  297 typesize%=typesize%+1
  298 V$=C$(6)
  299 IF V$="" THEN V$="0"
  300 IF INSTR(V$,".") THEN SH=INSTR(V$,".")-LEN(V$):V$=LEFT$(V$,INSTR(V$,".")-1)+RIGHT$(V$,-SH) ELSE SH=0
  301 REPEAT
  302   IF RIGHT$(V$,1)="0" THEN V$=LEFT$(V$,LEN(V$)-1):SH=SH+1
  303 UNTIL RIGHT$(V$,1)<>"0"
  304 C=VAL(V$)
  305 V$=STR$(C*10^SH)
  306 IF C>255 OR VAL(V$)<>VAL(C$(6)) THEN PRINT "Mass error: ";C$(6);"->";V$;" ";C;"E";SH;" for ";C$(1) : CLOSE#F% : END
  307 typeinfo%?typesize%=C
  308 typesize%=typesize%+1
  309 typeinfo%?typesize%=SH+128
  310 typesize%=typesize%+1
  311 typeinfo%?typesize%=FNgetval(C$(7))
  312 typesize%=typesize%+1
  313 typeinfo%?typesize%=FNgetval(C$(8))
  314 typesize%=typesize%+1
  315 typeinfo%?typesize%=FNgetflags(C$(9)) OR FNgetflags(C$(5))
  316 typesize%=typesize%+1
  317 IF C$(10)="" THEN typeinfo%?typesize%=FNgettext2(C$(1)) ELSE typeinfo%?typesize%=FNgettext2(C$(10))
  318 typesize%=typesize%+1
  319 IF C$(15)="" THEN PRINT "Warning! ";C$(1);" has unset probability"
  320 typeinfo%?typesize%=FNgetval(C$(15))
  321 typesize%=typesize%+1
  322 I=INSTR(C$(17),"-")
  323 IF I=0 THEN C$(17)="0-29":I=2
  324 typeinfo%?typesize%=FNgetval(LEFT$(C$(17),I-1))
  325 typesize%=typesize%+1
  326 typeinfo%?typesize%=FNgetval(MID$(C$(17),I+1))
  327 typesize%=typesize%+1
  328 ENDPROC
  329 DEF FNgetval(T$)
  330 IF T$="" THEN =0
  331 IF ASC(T$)=ASC("£") THEN =VAL(MID$(T$,1))
  332 =VAL(T$)
  333 DEF FNgetchar(T$)
  334 IF T$="" THEN =0
  335 IF LEN(T$)>1 THEN =0
  336 =ASC(T$)
  337 DEF FNgetflags(T$)
  338 T$=T$+","
  339 monflags=0
  340 flags=0
  341 S=1
  342 REPEAT
  343   E=INSTR(T$,",",S)
  344   IF E<>0 THEN PROCflag(MID$(T$,S,E-S)) : S=E+1
  345 UNTIL E=0
  346 =flags
  347 DEF FNgetclass(T$)
  348 IF LEFT$(T$,6)="Armour" THEN T$="Armour"
  349 FOR T=0 TO numclasses%-1
  350   IF T$=classnames$(T) THEN =T
  351 NEXT T
  352 PRINT "Unknown class '"+T$+"'!" : CLOSE#F% : END
  353 DEF PROCflag(F$)
  354 IF F$="explo" THEN flags=flags OR 1 : ENDPROC
  355 IF F$="operable" THEN flags=flags OR 2 : ENDPROC
  356 IF F$="electronic" THEN flags=flags OR 4 : ENDPROC
  357 IF F$="blinding" THEN flags=flags OR 8 : ENDPROC
  358 IF F$="sharp" THEN flags=flags OR 16 : ENDPROC
  359 IF F$="breakable" THEN flags=flags OR 32 : ENDPROC
  360 IF F$="GREEN" THEN flags=flags OR 64 : ENDPROC
  361 IF F$="BLUE" THEN flags=flags OR 128 : ENDPROC
  362 IF F$="hit" THEN monflags=monflags OR 1 : ENDPROC
  363 IF F$="bite" THEN monflags=monflags OR 2 : ENDPROC
  364 IF F$="kick" THEN monflags=monflags OR 4 : ENDPROC
  365 IF F$="scream" THEN monflags=monflags OR 8 : ENDPROC
  366 IF F$="wield" THEN monflags=monflags OR 16 : ENDPROC
  367 IF F$="throw" THEN monflags=monflags OR 32 : ENDPROC
  368 IF F$="wear" THEN monflags=monflags OR 64 : ENDPROC
  369 IF F$="walkable" THEN flags=flags OR 1 : ENDPROC
  370 IF F$="visible" THEN flags=flags OR 2 : ENDPROC
  371 IF F$="openable" THEN flags=flags OR 4 : ENDPROC
  372 IF F$="closeable" THEN flags=flags OR 8 : ENDPROC
  373 IF F$="lockable" THEN flags=flags OR 16 : ENDPROC
  374 IF F$<>"" THEN PRINT "Warning! unknown flag '"+F$+"'"
  375 ENDPROC
  376 DEF PROCcash
  377 PROCstd
  378 ENDPROC
  379 DEF PROCundict(T)
  380 REM Remove dictionary word
  381 FOR TT=0 TO DICTSTART-1
  382   REPEAT
  383     P=INSTR(TEXT$(INDIR%(TT)),CHR$(T))
  384     IF P<>0 THEN TEXT$(INDIR%(TT))=LEFT$(TEXT$(INDIR%(TT)),P-1)+TEXT$(INDIR%(T))+MID$(TEXT$(INDIR%(TT)),P+1)
  385   UNTIL P=0
  386   REM swap highest for T
  387   REPEAT
  388     P=INSTR(TEXT$(INDIR%(TT)),CHR$(NUMTEXT%-1))
  389     IF P<>0 THEN MID$(TEXT$(INDIR%(TT)),P,1)=CHR$(T)
  390   UNTIL P=0
  391 NEXT TT
  392 REM swap assignments, decrement count
  393 INDIR%(T)=INDIR%(NUMTEXT%-1)
  394 NUMTEXT%=NUMTEXT%-1
  395 ENDPROC
  396 DEF PROCinv(I$)
  397 IF I$="" THEN ENDPROC
  398 REM Parse monster inv string
  399 REM Is of the form Item:Base%+PerExp%
  400 I=INSTR(I$,":"):IF I=0 THEN PRINT "Bad inventory string '";I$;"'":CLOSE#F%:END
  401 N=FNgettext2(LEFT$(I$,I-1)):USED%(INDIR%(N))=USED%(INDIR%(N))-1
  402 typeinfo%?typesize%=N
  403 typesize%=typesize%+1
  404 J$=MID$(I$,I+1)
  405 I=INSTR(J$,"+"):IF I=0 THEN I=INSTR(J$,"-",1):IF I=0 THEN PRINT "Bad inventory string '";I$;"'":CLOSE#F%:END
  406 typeinfo%?typesize%=VAL(LEFT$(J$,I))+128
  407 typesize%=typesize%+1
  408 typeinfo%?typesize%=VAL(MID$(J$,I))+128
  409 typesize%=typesize%+1
  410 ENDPROC
  411 DEF PROCfixinv(T)
  412 REM Swap inventory string IDs for type IDs
  413 o%=typeinfo%+typeindex%(T)+28
  414 WHILE ?o%<>255
  415   FOR TT=0 TO numtypes%-1
  416     IF typeinfo%?(typeindex%(TT)+1)=?o% THEN ?o%=TT:o%=o%+3:TT=numtypes%
  417   NEXT TT
  418   IF TT=numtypes% THEN PRINT "Bad inventory item: ";TEXT$(INDIR%(?o%)):END
  419 ENDWHILE
  420 ENDPROC