QL QDOS and SMSQ/E Heaven: QL World Programs

There are many programming gems from the QL World magazine that deserve to be dusted down and brought up to date. Browsing through some old floppy disks to look for a C program to try in the GST C compiler, this was released as a public domain program over 2 years ago, QL Heaven came across this excellent small program from the autumn of 1989. Typed in by hand and used when the QL had only floppy disks and microdrives as devices. This is Finder_bas and uses pattern matching to find files from amongst the morass of accumulated files on disks and QXL.win files. The picture shows it finding the files with the thg tag on flp1_. A trivial example but on a QXL.win file with megabytes of data a useful tool.

This along with 3D Noughts and crosses deserves to be updated for modern systems. QL Heaven has another gem that will be featured here at some point. This is AI Draughts program, written entirely in SuperBasic and plays a mean game of draughts even though the users interface is dire. That's for another day.

In the QL user list there was an announcement of prototype of an ethernet board for the black box QL - from the picture is appears to use the QL expansion slot, so if it comes to production it might just use the Qplane or backplane. The pictures are here on flickr here

Below is the file finder listing

1000 DEFine FuNction Match (Pattern$,Str$)
1010 LOCal Chr,Text,Wcard,Mask$,loop,Result
1020 LOCal Charpos(10),EndChar(10),First(10)
1030 LOCal MinPos(10),MaxPos(10),x,Y
1040 Mask$=Pattern$:Chr=1 : Text=0
1050 FOR x=1 TO 10
1060 REPeat loop
1070    Wcard=Mask$(Chr) INSTR "\?*"
1080    IF Wcard >1 AND Text : Text=0 : EXIT loop
1090    IF ((Wcard>1)+Text)=0
1100      Text=1 : Charpos(x)=Chr
1110    END IF
1120    SELect ON Wcard
1130     =1 : IF Chr=LEN(Mask$):STOP
1140          IF Chr=1
1150             Mask$=Mask$(2 TO )
1160          ELSE
1170             Mask$=Mask$(1 TO Chr-1)&Mask$(Chr+1 TO)
1180          END IF
1190    =2 : MinPos(x)=MinPos(x)+1
1200    =3 :MaxPos(x)=1
1210    END SELect
1220    Chr=Chr+1
1230    IF Chr>LEN(Mask$):EXIT loop
1240 END REPeat loop
1250 EndChar(x)=Chr-1
1260 IF Chr > LEN(Mask$):EXIT x
1270 END FOR x
1280 :
1290 Y=1 : First(Y)=1 +MinPos(1)
1300 REPeat loop
1310    IF Charpos(Y)=0
1320      IF MaxPos(Y)
1330        Result=LEN(Str$) >=First(Y)-1
1340      ELSE
1350       Result=LEN(Str$)=First(Y)-1
1360      END IF
1370   ELSE
1380    IF First(Y) > LEN(Str$) : RETurn 0
1390    IF MaxPos(Y)
1400      last=LEN(Str$)
1410    ELSE
1420      last=First(Y)+EndChar(Y)-Charpos(Y)
1430    END IF
1440    Result=Mask$(Charpos(Y) TO EndChar(Y)) INSTR Str$(First(Y) TO last)
1450    END IF
1460 :
1470 IF Result=0
1480    REPeat BackTrack
1490       Y=Y-1 : IF Y=0 : RETurn 0
1500       IF MaxPos(Y):EXIT BackTrack
1510    END REPeat BackTrack
1520 ELSE
1530    IF Charpos(Y)=0 : RETurn 1
1540    First(Y)=First(Y)+Result
1550    First(Y+1)=First(Y)+EndChar(Y)-Charpos(Y)+MinPos(Y+1)
1560    Y=Y+1
1570 END IF
1580 END REPeat loop
1590 END DEFine    Match
1600 :
1610 MODE 4 : WINDOW 512,256,0,0
1620 PAPER 2,4 : CLS
1630     S=3 : OPEN#S,con_
1640     m=4 : OPEN#m,con_
1650     P=5 : OPEN#P,ser1
1660     F=6
1670     T=7
1680 Pattern$='*'
1690 Dev$='flp1_'
1700 TempFile$="ram1_TempFile"
1710 Medium$='< None >'
1720 Free =0 : Used=0
1730 Pattern : Device : Medium
1740 Display : Space : Menu 1
1750 REPeat loop
1760   key=Bar_Menu(max)
1770     SELect ON key
1780      =1 : New_Pattern
1790      =2 : New_Device
1800      =3,4
1810           Examine=key-3
1820           Search_Mode
1830      =5,0 : EXIT loop
1840     END SELect
1850 END REPeat loop
1855 CLOSE
1860 :
1870 DEFine PROCedure Draw_Wndo (ch,ac,dn,Xpos,Ypos,Col,Title$)
1880 WINDOW#ch,ac*8+20,dn*10+24,Xpos,Ypos

1890 PAPER#ch,2,0 : INK#ch,7 :CLS#ch

1900 BORDER#ch,1,0:BORDER#ch,4

1910 CSIZE#ch,2,0 :PRINT#ch,Title$

1920 WINDOW#ch,ac*8+8,dn*10+4,Xpos+6,Ypos+16

1930 PAPER#ch,Col: CLS#ch : BORDER#ch,2

1940 CSIZE#ch,1,0:INK#ch,7*(Col<4)

1950 END DEFine draw_window

1960 :

1970 DEFine PROCedure Display

1980 Draw_Wndo 1,40,17,140,56,0,"MEDIUM FILE"

1990 DIM media$(56,10),File$(56,48)

2000 END DEFine Display

2010 :

2020 DEFine PROCedure Pattern

2030 Draw_Wndo S,26,1,252,16,4,"PATTERN"

2040 PRINT#S,Pattern$

2050 END DEFine Pattern

2060 :

2070 DEFine PROCedure Device

2080 Draw_Wndo S,10,1,30,16,4,"DEVICE"

2090 PRINT #S,Dev$

2100 END DEFine Device

2110 :

2120 DEFine PROCedure Medium

2130 Draw_Wndo S,10,1,140,16,4,"MEDIUM"

2140 PRINT#S,Medium$

2150 END DEFine Medium

2160 :

2170 DEFine PROCedure Space

2180 Draw_Wndo S,10,2,30,56,4,"STATUS"

2190 PRINT#S, TO 4-LEN(Free);Free;"K Free"

2200 PRINT#S, TO 4-LEN(Used);Used;"K Used"

2210 END DEFine Space

2220 :

2230 DEFine PROCedure Menu(Type)

2240 LOCal n,Title$,Col

2250 WINDOW#m,120,146,20,108

2260 PAPER#m,2,4,0 : CLS#m

2270 IF Type=0 :RETurn

2280 IF Type>4 THEN

2285 Draw_Wndo S,10,3,30,108,7,"MESSAGE"

2290 Z=INT((Type*10)-40)

2310 IF Z =1 : PRINT#S,"Is ";Dev$;\"ready for"\"searching?"

2313 IF Z =2 : PRINT#S,"Print the"\"list?"

2314 IF Z =3 : PRINT#S,"Delete" \File$(x);"?"

2316 IF Z =4 : PRINT#S,"Print" \File$(x)

2318 IF Z =5 : PRINT#S,"Continue" \ "listing?"

2325 END IF

2328 Selection=INT(Type)

2330 SELect ON Selection

2340 =1 : RESTORE 2420

2350 =2 : RESTORE 2430

2360 =3 : RESTORE 2440

2370 =4 : RESTORE 2450

2380 END SELect

2390 READ max,Col,Title$

2400 Draw_Wndo m,10,max,30,176,Col,Title$

2410 FOR n=1 TO max : READ a$ : PRINT#m,a$

2420 DATA 5,4,"MAIN","Pattern","Device","List Only","Examine","Quit"

2430 DATA 4,4,"DEVICES","flp1_","flp2_","mdv1_","mdv2_"

2440 DATA 5,4,"FILE","Continue","View","Delete","Print","Quit"

2450 DATA 2,7,"Confirm","No","Yes"

2460 END DEFine Menu

2470 :

2480 DEFine FuNction Bar_Menu(max)

2490 LOCal n,key,loop

2500 n=0

2510 REPeat loop

2520 OVER#m,-1: BLOCK#m,80,10,0,n*10,7

2530 key=KEYROW(1) : key=CODE(INKEY$(-1))

2540 BLOCK#m,80,10,0,n*10,7 : OVER#m,0

2550 SELect ON key

2560 = 208 :n=(n-1) MOD max

2570 = 216 :n=(n-1) MOD max

2580 =10,32: RETurn n+1

2590 =27 : RETurn 0

2600 END SELect

2610 END REPeat loop

2620 END DEFine Bar_Menu

2630 :

2770 DEFine PROCedure New_Pattern

2780 LOCal loop,max,Temp$

2790 Draw_Wndo S,26,1,252,16,0,"NEW PATTERN"

2800 Menu 0 :INPUT#S,Temp$: Menu 4

2810 IF Bar_Menu(2)=2 : Pattern$=Temp$

2820 Pattern : PRINT#S; Pattern$: Menu 1

2830 END DEFine New_Pattern

2840 :

2850 DEFine PROCedure New_Device

2860 LOCal key,a$

2870 Menu 2

2880 key= Bar_Menu(max)

2890 SELect ON key

2900 =1: Dev$="flp1_"

2910 =2: Dev$="flp2_"

2920 =3: Dev$="mdv1_"

2930 =4: Dev$="mdv2_"

2940 END SELect

2950 Device : Menu 1

2960 END DEFine New_Device

2970 :

2980 DEFine PROCedure Search_Mode

2990 LOCal Loop1,Loop2,Loop3,x,Y

3000 Y=1

3010 REPeat Loop1

3020 IF Fetch_Dir = 0 : EXIT Loop1

3030 REPeat Loop2

3040 Menu 0

3050 FOR x=Y TO DIMN(File$)

3060 REPeat Loop3

3070 IF EOF(#T) : EXIT x

3080 INPUT#T,a$ : BEEP 200,100

3090 IF Match(Pattern$,a$):EXIT Loop3

3100 END REPeat Loop3

3110 File$(x)=a$ : media$(x)=Medium$

3120 PRINT Medium$; TO 12;a$

3130 IF Examine

3140 IF File_Check:CLOSE#T:EXIT Loop1

3150 END IF

3160 NEXT x

3170 PRINT\"End of Page"\

3180 END FOR x

3190 IF Print_page OR x=DIMN(File$)

3200 Y=1 : Display

3210 ELSE

3220 Y=x

3230 END IF

3240 IF EOF(#T) : CLOSE#T:EXIT Loop2

3250 END REPeat Loop2

3260 END REPeat Loop1

3270 Display : Menu 1

3280 END DEFine Search_Mode

3290 :

3300 DEFine FuNction Fetch_Dir

3310 LOCal loop,a$

3320 Menu 4.1 : IF Bar_Menu (2) <2 : RETurn 0

3330 DELETE TempFile$

3340 OPEN_NEW#T,TempFile$

3350 DIR#T,Dev$

3360 CLOSE#T : OPEN_IN#T,TempFile$

3370 INPUT#T,Medium$,a$

3380 Free=INT(a$/2)

3390 Used=a$("/" INSTR a$+1 TO " " INSTR a$ -1)

3400 Used=INT(Used/2)-Free

3410 Medium : Space : RETurn 1

3420 END DEFine Fetch_Dir

3430 :

3440 DEFine FuNction Print_page

3450 Menu 4.2

3460 IF Bar_Menu(2)=2

3470 PRINT#P;\\DATE$

3480 PRINT#P; \"Files Matching ";

3490 PRINT#P; Pattern$ \\

3500 FOR x=1 TO DIMN(File$)

3510 IF File$(x) ="":EXIT x

3520 PRINT#P, TO 8;media$(x);

3530 PRINT#P, TO 24;File$(x)

3540 END FOR x

3550 PRINT#P,CHR$(12)

3560 RETurn 1

3570 END IF

3580 RETurn 0

3590 END DEFine Print_page

3600 :

3610 DEFine FuNction File_Check

3620 LOCal loop,key

3630 Menu 3

3640 REPeat loop

3650 key=Bar_Menu(max)

3660 SELect ON key

3670 =1 : RETurn 0

3680 =2 : Show_File

3690 =3 : IF Delete_File : RETurn 0

3700 =4 : print_file

3710 =5,0 : RETurn 1

3720 END SELect

3730 Menu 3

3740 END REPeat loop

3750 END DEFine File_Check

3760 :

3770 DEFine PROCedure print_file

3780 LOCal Per_Page,Per_Input,Per_Line

3790 LOCal PageNum,R$,Lyne

3800 PageNum=1 : OPEN#F,Dev$&File$(x)

3810 REPeat Per_Page

3820 IF NOT New_Page THEN EXIT Per_Page

3830 REPeat Per_Input

3840 IF EOF(#F):EXIT Per_Input

3850 INPUT#F,R$

3860 REPeat Per_Line

3870 IF Lyne >50

3880 PRINT#P,CHR$(12)

3890 IF NOT New_Page THEN EXIT Per_Page

3900 END IF

3910 PRINT#P;" ";R$(1 TO 70)

3920 Lyne=Lyne+1

3930 IF LEN(R$)>70

3940 R$=R$(71 TO)

3950 ELSE

3960 EXIT Per_Line

3970 END IF

3980 END REPeat Per_Line

3990 END REPeat Per_Input

4000 END REPeat Per_Page

4010 CLOSE#F

4020 END DEFine print_file

4030 :

4040 DEFine FuNction New_Page

4050 Menu 4.4

4060 IF Bar_Menu(2) = 2

4070 PRINT#P,File$(x)!!!"Page ";PageNum\\\

4080 Lyne=1 : PageNum=PageNum+1

4090 RETurn 1

4100 END IF

4110 RETurn 0

4120 END DEFine New_Page

4130 :

4140 DEFine PROCedure Show_File

4160 CLS : VIEW Dev$&File$(x)

4180 IF INKEY$ = CHR$(27)

4190 Menu 4.5 : IF Bar_Menu(2)=1 : RETurn

4200 END IF

4240 PRINT FILL$("^",40)

4250 END DEFine Show_File

4260 :

4270 DEFine FuNction Delete_File

4280 Menu 4.3

4290 IF Bar_Menu(2)=2

4300 DELETE Dev$&File$(x)

4310 PRINT "File Deleted":RETurn 1

4320 END IF

4330 RETurn 0

4340 END DEFine Delete_File

4350 :

1880 WINDOW#ch,ac*8+20,dn*10+24,Xpos,Ypos