1 REMark dense_bas (c) Timo Salmi
2 REMark Thu 1992 Oct 22 07:12:06
3 REMark version 2.27
4 :
100 CLEAR:kokoaika=DATE:mp=37
110 DIM ohj$(10),tpvm$(8),vr$(4):rpit%=512
120 p_tsotsake("TURBODENSE"),("05.03.89"),("2.7")
130 p_ikkunat:p_ohjeete
150 REPeat runko
250 DIM f1$(mp),f2$(mp),f$(mp),v$(7),rivi$(rpit%),mj$(rpit%)
270 CLS:p_ruutu
280 REPeat kysy
290 INK 7:PRINT"FILE TO BE CONDENSED? ";:clb=KEYROW(0)
300 INPUT f1$:IF f_nimtark((f1$)) THEN EXIT kysy
310 END REPeat kysy
320 IF NOT f_onkof((f1$)) THEN 
330 INK 2:PRINT f1$!"NOT"!"FOUND"
340 IF f_vielako:NEXT runko:ELSE :EXIT runko:END IF 
350 END IF 
370 REPeat kysy
380 INK 7:PRINT"NEW CONDENSED FILE  ? ";
390 clb=KEYROW(0):INPUT f2$
400 IF f_nimtark((f2$)) THEN EXIT kysy
410 END REPeat kysy
420 IF f1$==f2$ THEN 
430 INK 2:PRINT"DUPLICATE NAME":GO TO 280:END IF 
440 IF f_onkof((f2$)) THEN 
450 REPeat kysy
460 INK 7
470 PRINT f2$!"ALREADY"!"EXISTS,"!"DELETE (Y/N)?";
480 clb=KEYROW(0):INPUT!v$
490 IF v$=="y":DELETE f2$:EXIT kysy:END IF 
500 IF v$=="n" THEN 
510 IF f_vielako:NEXT runko:ELSE :EXIT runko:END IF 
520 END IF 
530 END REPeat kysy
540 END IF 
560 OPEN_IN#5,f1$:OPEN_NEW#6,f2$
580 REMark +
590 REPeat luerivi
600 IF EOF(#5) THEN EXIT luerivi
610 INPUT#5,rivi$
640 AT#3,0,0:PRINT#3,rivi$(1 TO (" "INSTR rivi$)-1)
670 r%="REMark " INSTR rivi$
680 IF "REMark +" INSTR rivi$ OR "REMark -" INSTR rivi$ THEN r%=0
690 IF r% THEN 
700 k%=0:i%=0
710 REPeat loop
720 i%=i%+1 :IF i%>r% THEN EXIT loop
730 IF rivi$(i%)=":" THEN k%=i%
740 END REPeat loop
750 IF k% THEN 
760 rivi$=rivi$(1 TO k%-1)
770 ELSE 
780 rivinro=f_nroval((rivi$(1 TO r%-1)))
790 IF ok THEN NEXT luerivi
800 END IF 
810 END IF 
840 pit%=LEN(rivi$)
850 IF " :" INSTR rivi$ THEN 
860 k%=0:i%=0
870 REPeat loop
880 i%=i%+1:IF i%>pit% THEN EXIT loop
890 IF rivi$(i%)=":" THEN k%=i%
900 END  REPeat loop
910 rivinro=f_nroval((rivi$(1 TO k%-1)))
920 IF ok THEN NEXT luerivi
930 END IF 
960 pit%=LEN(rivi$)
970 k%=" " INSTR rivi$ :ok=0
980 IF k% THEN rivinro=f_nroval((rivi$(1 TO k%)))
990 IF ok THEN 
1000 rivi$=rivi$(1 TO k%)&f_trim$((rivi$(k%+1 TO pit%)))
1010 END IF 
1030 PRINT#6,rivi$
1040 END REPeat luerivi
1050 REMark -
1070 CLOSE#5:CLOSE#6
1080 INK 7:PRINT f1$!"CONDENSED"!"INTO"!f2$
1090 IF NOT f_vielako THEN EXIT runko
1110 END REPeat runko
1130 INK 7:CLOSE#3:PRINT:p_valmis(1)
17000 DEFine PROCedure p_ikkunat
17010 leveys%=448:alku%=INT((512-leveys%)/2)
17020 WINDOW#1,leveys%,192,alku%, 37
17030 WINDOW#0,leveys%, 27,alku%,229
17040 PAPER#1,0:BORDER#1,1,4:CSIZE#1,1,0:CLS#1
17050 PAPER#0,0:CSIZE#0,1,0:CLS#0
17060 END DEFine p_ikkunat
17080 DEFine PROCedure p_ruutu
17090 OPEN#3,con_:WINDOW#3,48,12,alku%+leveys%-50,216
17100 PAPER#3,0:CSIZE#3,1,0:INK#3,7:BORDER#3,1,2:CLS#3
17110 END DEFine p_ruutu
20000 DEFine PROCedure p_tsotsake(ohj$,tpvm$,vr$)
20010 LOCal il1%,il2%,il%,i:MODE 4:il%=3
20020 levg%=448:alkug%=INT((512-levg%)/2)
20030 WINDOW 512,256,0,0:PAPER 0:CLS
20040 OPEN#3,con_:WINDOW#3,levg%,22,alkug%,16
20050 PAPER#3,0:CLS#3:BORDER#3,1,4:CSIZE#3,il%,1
20060 CURSOR#3,5,0:INK#3,4:PRINT#3,ohj$
20070 il2%=levg%-12*LEN(tpvm$)-9
20080 il1%=(il2%+(4+4*il%)*LEN(ohj$)-35-40*il%)/2
20090 INK#3,7:CURSOR#3,il1%,0:RESTORE 20100
20100 DATA 84,105,109,111,32,83,97,108,109,105
20110 FOR i=1 TO 10:READ il%:PRINT#3,CHR$(il%);:END FOR i
20120 CSIZE#3,2,0:INK#3,2
20130 CURSOR#3,il2%,10:PRINT#3,tpvm$
20140 CURSOR#3,il2%,0:PRINT#3,"Ver."!vr$:CLOSE#3
20150 END DEFine p_tsotsake
21000 DEFine PROCedure p_ohjeete
21010 LOCal vl$(2),kysy,i,j
21020 CLS:INK 7
21030 IF NOT f_kysynoye(("INSTRUCTIONS"),("N")) THEN RETurn 
21040 CLS
21050 PRINT" TURBODENSE is a utility to condense large SuperBASIC"
21060 PRINT"programs. It removes REMarks and indentations from a"
21070 PRINT"SuperBASIC program file."
21080 PRINT" Condensation is particularly useful prior compiling"
21090 PRINT"SuperBASIC programs. The resultant code will be more"
21100 PRINT"concise, and thus takes up less memory."
21110 PRINT" The maximum length allowed for a single line is"!rpit%
21120 PRINT"characters."
21130 PRINT" As special features TURBODENSE omits separator lines,"
21140 PRINT"i.e. lines with just a colon (:) in them. Lines with"
21150 PRINT"REMark within quotes, and lines with REMark + or"
21160 PRINT"REMark - (signals for threaded code) are not removed."
21170 INK 4:RESTORE 20100:AT 14,0
21180 FOR i=1 TO 10:READ j:PRINT CHR$(j);:END FOR i
21190 PRINT", Prof. of Accounting and Business Finance"
21200 PRINT"School of Business Studies, University of Vaasa"
21210 PRINT"P.O.Box 297, SF-65101 Vaasa, Finland"
21220 PRINT"InterNet address: ts@chyde.uwasa.fi"
21230 INK 2:clb=KEYROW(0)
21240 INPUT"TO CONTINUE: PRESS ENTER"!vl$:CLS
21250 END DEFine p_ohjeete
23000 REMark +
23010 DEFine FuNction f_nroval(mj$)
23020 LOCal sl$(11),il,nrl,pl%
23030 ok=0:sl$="1234567890 ":pl%=0
23040 IF LEN(mj$)=0 THEN RETurn 0
23050 FOR il=1 TO LEN(mj$)
23060 IF mj$(il) INSTR sl$=0 THEN RETurn 0
23070 END FOR il:ok=1:RETurn mj$
23080 END DEFine f_nroval
23090 REMark -
27000 DEFine FuNction f_nimtark(f$)
27010 LOCal pl%,dl$(5),ml$(8)
27020 pl%=LEN(f$):IF pl%<5:p_mdvherja:RETurn 0:END IF 
27030 dl$=f$(1 TO 3)
27040 IF NOT(dl$=="mdv" OR dl$=="fdk" OR dl$=="flp" OR dl$=="ram"):p_mdvherja:RETurn 0:END IF 
27050 IF f$(5)<>"_":p_mdvherja:RETurn 0:END IF 
27060 ml$="12":IF dl$=="flp" THEN ml$="1234"
27070 IF dl$="ram" THEN ml$="12345678"
27080 IF NOT f$(4)INSTR ml$:p_mdvherja:RETurn 0:END IF 
27090 IF pl%<6:INK 2:PRINT"NO FILENAME":RETurn 0:END IF 
27100 RETurn 1
27110 END DEFine f_nimtark
27130 DEFine PROCedure p_mdvherja
27140 INK 2:PRINT"MISSING OR UNKNOWN DEVICENAME":RETurn 
27150 END DEFine p_mdvherja
27500 DEFine FuNction f_onkof(f$)
27510 LOCal hl$(17),al$(37),fbl$(37),etsi,fon
27520 IF LEN(f$)<5 THEN RETurn 0
27530 hl$=f$(1 TO 5)&"tilaphak_tmp"
27540 DELETE hl$:OPEN_NEW#6,hl$:DIR#6,f$(1 TO 5)
27550 CLOSE#6:OPEN_IN#5,hl$:INPUT#5,al$,al$
27560 fbl$="":IF LEN(f$)>5 THEN fbl$=f$(6 TO)
27570 REPeat etsi
27580 IF EOF(#5):fon=0:EXIT etsi:END IF 
27590 INPUT#5,al$
27600 IF fbl$==al$:fon=1:EXIT etsi:END IF 
27610 END REPeat etsi
27620 CLOSE#5:DELETE hl$:RETurn fon
27630 END DEFine f_onkof
28500 DEFine FuNction f_kysynoye(mj$,oletus$)
28510 LOCal vl$(3),kysy,ml$(50)
28520 IF oletus$=="y" THEN 
28530 ml$=mj$&" (n,Y)? "
28540 ELSE :ml$=mj$&" (N,y)? ":END IF 
28550 REPeat kysy
28560 INK 7:PRINT ml$;:clb=KEYROW(0):INPUT vl$
28570 IF vl$="" THEN vl$=oletus$
28580 IF vl$=="n" THEN RETurn 0
28590 IF vl$=="y" THEN RETurn 1
28610 END REPeat kysy
28620 END DEFine f_kysynoye
29000 REMark +
29010 DEFine FuNction f_trim$(mj$)
29020 LOCal pl%,il%,jl%,ml$(rpit%),loop:pl%=LEN(mj$)+1
29030 REPeat loop
29040 pl%=pl%-1:IF pl%<1 THEN EXIT loop
29050 IF mj$(pl%)<>" " THEN EXIT loop
29060 END REPeat loop
29070 ml$="":il%=0:jl%=0
29080 REPeat loop
29090 il%=il%+1:IF il%>pl% THEN RETurn ml$
29100 IF jl% OR mj$(il%)<>" " THEN 
29110 ml$=ml$&mj$(il%):jl%=1:END IF 
29120 END REPeat loop
29130 END DEFine f_trim$
29140 REMark -
30000 DEFine PROCedure p_valmis(ch%)
30010 LOCal tl,ml,sl
30020 PRINT#ch%,"READY,"!"elapsed"!"time"!;
30030 sl=DATE-kokoaika
30040 tl=INT(sl/3600):sl=sl-tl*3600
30050 ml=INT(sl/60):sl=sl-60*ml
30060 IF tl>0 THEN PRINT#ch%,tl!"h"!;
30070 IF ml>0 OR tl>0 THEN PRINT#ch%,ml!"min"!;
30080 PRINT#ch%,sl!"sec"
30090 END DEFine p_valmis
30500 DEFine FuNction f_vielako
30510 LOCal key,cl,loop
30520 cl=0:PAPER#cl,0:INK#cl,4:CLS#cl
30530 PRINT#cl,"AGAIN: F3, EXIT: ESC";
30540 INK#cl,7:clb=KEYROW(0)
30550 REPeat loop
30560 key=CODE(INKEY$(-1))
30570 IF key=240:PAPER#cl,0:CLS#cl:RETurn 1:END IF 
30580 IF key=27:CLS#cl:RETurn 0:END IF 
30590 END REPeat loop
30600 END DEFine f_vielako
31000 DEFine PROCedure reset(i)
31010 LOCal il:MODE i
31020 FOR il=1,2:OPEN#il,con_:END FOR il
31030 WINDOW 512,256,0,0:PAPER 0:CLS
31040 WINDOW#0,448,40-(i=4),32,216+(i=4)
31050 WINDOW#2,448,200,32,16:PAPER#2,1:INK#2,7
31060 WINDOW 448+8*(i=4),200+2*(i=4),32-4*(i=4),16-(i=4)
31070 PAPER 2*(i=8):BORDER (i=4),4*(i=4)
31080 FOR il=0,1,2:CSIZE#il,(i=4)+2*(i=8),0:END FOR il
31090 PAPER#0,0:INK#0,7-3*(i=0):INK 7:CLS
31100 SCALE 100,0,0:FILL 0
31110 END DEFine reset
31990 STOP
32000 vsave 1:STOP
32010 vsave 2:STOP
32020 vsave 3:STOP
32030 vsave 4:STOP
32040 vsave 5:STOP
32050 vsave 6:STOP
32060 DEFine PROCedure vsave(dr)
32070 LOCal avl$(42),bvl$(42),dvl$(6,5):avl$="dense_bas"
32080 bvl$=DATE$:bvl$=bvl$(1 TO 4)
32090 IF bvl$<>1992 THEN 
32100 PRINT#0,DAY$!DATE$!"Not saved, set SDATE"
32110 BEEP 4000,12:STOP:END IF 
32120  ver1%=2:ver2%=27
32130 dvl$(1)="mdv1_":dvl$(2)="mdv2_"
32140 dvl$(3)="fdk1_":dvl$(4)="fdk2_"
32150 dvl$(5)="ram1_":dvl$(6)="ram2_"
32160 bvl$=dvl$(dr)&avl$
32170 DELETE bvl$:OPEN_NEW#3,bvl$:ver%=ver2%+1
32180 PRINT#3,"1 REMark ";avl$!"(c) Timo Salmi"
32190 PRINT#3,"2 REMark ";DAY$!DATE$
32200 PRINT#3,"3 REMark version"!ver1%;".";ver%
32210 PRINT#3,"4 :"
32220 LIST#3,100 TO 32110
32230 PRINT#3,"32120  ver1%=";ver1%;":ver2%=";ver%
32240 LIST#3,32130 TO:CLOSE#3
32250 PRINT#0,"Saved"!bvl$!"version"!ver1%;".";ver%
32260 END DEFine vsave
