Raspberry Pi in a QL Case

There has been talk of using the Raspberry Pi as  a platform for a QL successor. Here below are links to a site showing how someone has built a RPi into a QL case and connected it to the orginal QL keyboard. Although unless you are set on retaining the original QL's limited range of keys and their feel, it would seem easier to find on ebay a slimline mini usb keyboard of the required dimensions and fit this in place of the original keyboard with if needed a little trimming of the case.

http://www.deblauweschicht.nl/tinkering/qlkeys1.html

http://www.deblauweschicht.nl/tinkering/qlkeys2.html

Noticed By QL-Users List

See the Mail Archive here  about detecting the pointer without using QPTR etc.

Fame at Last

There is life in old programs yet

The maths tutor program from the February 1989 QL World has proven useful here in QL Heaven. A certain person having to learn times tables found this utility useful. It has everything needed. A learning mode with explanations, a test mode which is probably the most useful, a brain taxing quiz mode and more. The interface is simple but reflects the time at which it was written.  The program was installed on a windows laptop with a shortcut icon to launch QPC" which on start up loaded and ran the Multiplication tables program. No QL knowledge needed. No doubt it could be run under windows using other PD or freeware emulators.

Here is the listing if anyone is interested. BTW it has been slightly modified from the listing in the magazine to take advantage of the greater screen terrain available on PCs and hence the font size used may be inappropriate for a base QL. And there are a very small number of other tweaks of little significance. 

100 :

200 :

210 :

220 :

230 intro "Multiplication Tables"

240 :

250 test = 0 : DIM tables_list(12)

260 REPeat do_tables

270   menu

280 :

290   IF menu_choice$ INSTR "LRPT"

300       which_table

320   ELSE

330       quiz_tables test,tables_list

350   END IF

355 :

360   IF menu_choice$ INSTR "T"

370       tables_list(table_choice)=table_choice

380       test_tables(table_choice)

400   END IF

410   IF menu_choice$ INSTR "P"

420       practise_tables(table_choice)

440   END IF

450   IF menu_choice$ INSTR "R"

460       recite_tables(table_choice)

480   END IF

490   IF menu_choice$ INSTR "L"

500       learn_table(table_choice)

520   END IF

530 END REPeat do_tables

540 :

550 :

560 :

570 :

580 :

590 :

600 DEFine PROCedure intro (title$)

610 CSIZE 2,1:PAPER 2:INK 7:CLS

620 AT 5,(26-LEN(title$))/2:PRINT title$:PAUSE 90

630 CSIZE 2,1:PAPER 1:INK 6:CLS

640 END DEFine intro

650 :

660 :

670 :

680 :

690 DEFine PROCedure menu

700 PAPER 6:INK 1:CSIZE 2,1:CLS

710 AT 3,1:PRINT "Press the letter for your choice or 'ESC' to Quit"

720 AT 6,1:PRINT "To learn a table:-   ";TO 27;"PRESS L"

730 AT 8,1:PRINT "To recite a table: - " ;TO 27;"PRESS R"

740 AT 10,1:PRINT "To practise a table: - ";TO 27;"PRESS P"

750 AT 12,1:PRINT "For a test on a table:- ";TO 27;"Press T"

760 AT 14,1:PRINT "For a tables quiz:- ";TO 27;"Press Q"

770   REPeat menu_choice

780     AT 16,27: PRINT "Which?"

785     menu_choice$=INKEY$(-1) : convert_case

787     IF menu_choice$=CHR$(27):STOP

790     IF menu_choice$<>"" AND menu_choice$ INSTR "LRPTQ" THEN

800       EXIT menu_choice

810     ELSE

820       rub_out menu_choice$,16,33

830     END IF

840   END REPeat menu_choice

850 END DEFine menu

860 :

870 :

880 :

890 :

900 DEFine PROCedure which_table

910 CLS

920 AT 4,4:PRINT "Which table < 1,.....,12 >? and press ENTER"

930 REPeat pick_table

940 AT 14,27: INPUT table_choice$

950   IF table_choice$<"1" OR table_choice$>"12" THEN

960      rub_out table_choice$,14,27

970   ELSE

980     LET table_choice=table_choice$

990     EXIT pick_table

1000  END IF

1010 END REPeat pick_table

1020 END DEFine which_table

1030 :

1040 :

1050 :

1060 :

1070 DEFine PROCedure learn_table(table_choice)

1080 intro "Learn a Table"

1090 FOR learn=1 TO 12

1100   teach table_choice,learn:wait:CLS

1110 END FOR learn

1120 recite_tables(table_choice)

1130 END DEFine learn_table

1140 :

1150 :

1160 :

1170 :

1180 DEFine PROCedure recite_tables(table_choice)

1190 intro "Recite a Table"

1200 :

1210 REPeat table_recite

1220 CLS

1230 FOR M = 1 TO 12

1240   AT M,11:PRINT table_choice:AT M,15:PRINT "x";M

1250 AT M,21:PRINT "=  ":AT M,24:PRINT table_choice*M

1260 PAUSE 175

1270 END FOR M

1280 option "Recite","Practice"

1290 :

1300 IF option$ INSTR "CMP" THEN EXIT table_recite

1310 END REPeat table_recite

1320 IF option$ INSTR "P" THEN practise_tables(table_choice)

1330 IF option$ INSTR "C" THEN

1340    which_table

1350    recite_tab1es (table_choice)

1360 END IF

1370 END DEFine recite_tables

1380 :

1390 :

1400 :

1410 :

1420 DEFine PROCedure practise_tables(table_choice)

1430  intro "Practise a Table"

1440  REPeat table_practise

1450    DIM hiqh_light(12):LET mistakes=0:CLS

1460 :

1470    FOR M=1 TO 12

1480       AT M,11:PRINT table_choice:AT M,15:PRINT 'x';M

1490       AT M,21:PRINT "=  ":LET answer$="?"

1500       check_input answer$,M,24

1510       IF answer$=tab1e_choice*M THEN

1520          good_news

1530 :

1540       END IF

1550       IF answer$<>table_choice*M THEN

1560          LET high_light(M) = 1 : LET mistakes=mistakes+1

1570          bad_news

1590          teach table_choict,M

1610          wait

1630          Rebuild_table(tab1e_choice),M

1660       END IF

1670   END FOR M

1680 IF mistakes = 0 THEN

1690   option "Practise", "Test"

1700 END IF :

1710  IF option$ INSTR "CMT" THEN

1720     EXIT table_practise

1730  ELSE

1740     AT 16,9:PRINT "Practise those in red"

1750     AT l7,9:PRINT "then press any key. " : wait

1760  END IF

1770 END REPeat table_practise

1780 IF option$ INSTR "T" THEN test_tables(table_choice)

1790 IF option$ INSTR "C" THEN

1800    which_table

1810    practise_tables ( table_choice )

1820 END IF

1830 END DEFine practise_tables

1840 :

1850 :

1860 :

1870 :

1880 DEFine PROCedure Rebuild_table(table_choice,M)

1890 CLS:CSIZE 2,1

1900 :

1910 FOR row = 1 TO M

1920 IF high_light(row)=1 THEN STRIP 2

1930 AT row,11:PRINT table_choice;" ":AT row, 15:PRINT "x  ";row

1940 AT row, 21:PRINT "=" :AT row,24:PRINT table_choice*row

1950 STRIP 1

1960 END FOR row

1970 END DEFine Rebuild_table

1980 :

1990 :

2000 :

2010 :

2020 DEFine PROCedure test_tables(table_choice)

2030 LOCal a$, time_now$,end_time$

2040 LET test=1

2050 intro "Test a Table"

2060 PAPER 6: INK 0

2070   REPeat table_test

2080     DIM number(10)

2090     a$=DATE$:time_now$=a$(16 TO 20)

2100     correct_marker = 0

2110     LET number_1=table_choice

2120     LET tables_list(number_1)=table_choice

2130     FOR counter = 1 TO 10

2140       CSIZE 3,1

2150       CLS

2160       REPeat multiplier

2170         LET mark=0

2180         LET number_2=RND(1 TO 12)

2190         FOR check=1 TO counter

2200           IF number_2=number(check) THEN mark=1:EXIT check

2210         END FOR check

2220         IF mark=0 THEN EXIT multiplier

2230       END REPeat multiplier

2240       LET number(check)= number_2

2250       AT 5,6: PRINT number_1:AT 5,10:PRINT "x  ";number_2

2260       AT 5,16:PRINT "=   ":LET answer$="?"

2270       check_input answer$,5,19

2280       IF answer$=number_1*number_2 THEN

2290          correct_marker= correct_marker+1:good_news: correct

2300       ELSE

2310          bad_news: wrong:teach number_1,number_2: wait

2320       END IF

2330    END FOR counter

2340    CSIZE 2,1

2350    CLS

2360    a$=DATE$:end_time$=a$(16 TO 20)

2370    minutes=end_time$(1 TO 2)-time_now$(1 TO 2)

2380    time_elapsed=60*(end_time$(1 TO 2)-time_now$(1 TO 2))+end_time$(4 TO 5)-time_now$( 4 TO 5)

2390    faces(correct_marker)

2400    AT 20,10:PRINT "You took "!time_elapsed!"seconds." !

2410    option "Test","Quiz"

2420 :

2430    IF option$ INSTR "CMQ" THEN EXIT table_test

2440   END REPeat table_test

2450 IF option$ INSTR "C" THEN

2460 which_table

2470 test_tables (table_choice)

2480 END IF

2490 IF option$ INSTR "Q" THEN quiz_tables test, tables_list

2500 END DEFine test_tables

2510 :

2520 :

2530 :

2540 :

2550 DEFine PROCedure quiz_tables(test,tables_list)

2560 LOCal a$, time_now$,correct_marker,mark,table

2570 intro "Tables Quiz"

2580 PAPER 6:INK 0

2590 DIM new_tables_list(12),tab(12)

2600 FOR table=1 TO 10

2610    tab(table)=2*table+1

2620 END FOR table

2630 FOR table=11 TO 12

2640   tab(table) = 3*table-9

2650 END FOR table

2660 quiz_list test,tables_list,new_tables_list

2670 :

2680 LET new_tables_list(0)=0:correct_total=0:total_time=0

2690 FOR table = 1 TO 12

2700      IF new_tables_list(table)<>0 THEN

2710      LET new_tables_list(0)=new_tables_list(0)+1

2720    END IF

2730 END FOR table

2740 REPeat quiz

2750 intro "There will be "&new_tables_list(O)&"rounds"

2760 FOR round =1 TO new_tables_list(0)

2770 intro "Round "&round

2780 PAPER 6 : INK 0: CSIZE 3,1

2790 DIM n3(10),n4(10)

2800 a$=DATE$:time_now$=a$(16 TO 20)

2810 correct_marker=0

2820 FOR counter=1 TO 10

2830   CLS:CSIZE 3,1

2840   REPeat multiplicand

2850     number_3=RND(1 TO 12)

2860     IF new_tables_list(number_3)<>0 THEN

2870       mark=0

2880       IF new_tables_list(0)>=10 THEN

2890          FOR check=1 TO counter

2900             IF number_3=n3(check) THEN mark=1:EXIT check

2910          END FOR check

2920       END IF

2930       IF mark=0 THEN EXIT multiplicand

2940     END IF

2950   END REPeat multiplicand

2960   LET n3(counter)=number_3

2970   REPeat multiplier

2980     mark=0

2990     number_4=RND(1 TO 12)

3000     FOR check=1 TO counter

3010       IF number_4=n4(check) THEN mark=1:EXIT check

3020     END FOR check

3030     IF mark=0 THEN EXIT multiplier

3040   END REPeat multiplier

3050   LET n4(counter)=number_4

3060   AT 5,6: PRINT number_3:AT 5,10: PRINT "x  ";number_4

3070   AT 5,16: PRINT "=  ":LET answer$="?"

3080   check_input answer$,5,19

3090   IF answer$=number_3*number_4 THEN

3100      correct_marker= correct_marker + 1:good_news: correct

3110   ELSE

3120      bad_news:wrong

3130      teach number_3,number_4:wait

3140   END IF

3150 END FOR counter

3160 CLS:CSIZE 2,1

3170 a$=DATE$:end_time$=a$(16 TO 20)

3180 minutes=end_time$(1 TO 2)-time_now$(1 TO 2)

3190 time_elapsed=60*(end_time$(1 TO 2)-time_now$(1 TO 2))+end_time$(4 TO 5)-time_now$(4 TO 5)

3200 faces(correct_marker)

3210 AT 12,10:PRINT "You took "!time_elapsed!"seconds."

3220 PAUSE 150

3230 LET correct_total=correct_total+correct_marker

3240 LET total_time=total_time+time_elapsed

3250 CLS

3260 END FOR round

3270 CLS

3280 AT 5,4:PRINT "You got ";correct_total;" outof ";round*10;" correct"

3290 AT 7,5:PRINT "You took "!total_time!"seconds. "

3300 PAUSE 150

3310 option "Quiz"," "

3320 :

3330 IF option$ INSTR "M" THEN EXIT quiz

3340 END REPeat quiz

3350 END DEFine quiz_tables

3360 :

3370 :

3380 :

3390 :

3400 DEFine PROCedure correct

3410 AT 6,9: INK 2:FLASH 1:PRINT "Well done!"

3420 PAUSE 100: FLASH 0: INK 0

3430 END DEFine correct:

3440 :

3450 :

3460 :

3470 :

3480 DEFine PROCedure wrong

3490 AT 6,5: INK 2: FLASH 1: PRINT "No. Wait for help !"

3500 PAUSE 100 :FLASH 0:INK 0

3510 END DEFine wrong

3520 :

3530 :

3540 :

3550 :

3560 DEFine PROCedure bad_news

3570 FOR j= 1 TO 255

3580 BEEP 500,j

3590 END FOR j

3600 END DEFine bad_news

3610 :

3620 :

3630 :

3640 :

3650 DEFine PROCedure good_news

3660 FOR j= 100 TO 4000 STEP 500

3670 BEEP 5000,j: PAUSE 5

3680 END FOR j

3690 END DEFine good_news

3700 :

3710 :

3720 :

3730 :

3740 DEFine PROCedure teach(n1,n2 )

3750 CLS:CSIZE 2,1

3760 AT 1,1:PRINT "To work out "!n1! " x"!n2!":":PRINT

3770 FOR j=1 TO n1

3780   FOR k=1 TO n2

3790     PRINT "*";

3800   END FOR k:PRINT

3810 END FOR j

3820 AT 5,17 : PRINT "There are " ;n1:AT 6,17 :: PRINT "lots of ";n2;" 's"

3830 AT 7,17 : PRINT "If you count all"

3840 AT 8,17 : PRINT "the stars, you":AT 9,17:PRINT "wiI1 find that"

3850 AT 10,17 : PRINT "there are ";n1*n2:AT 11,17: PRINT "of them. "

3860 AT 12,17 : FLASH 0 : PRINT "So:  "

3870 AT 14,17:UNDER 0: CSIZE 2,1:PRINT n1 ;" x ";n2;" = ";n1*n2

3880 FLASH 0: UNDER 0: CSIZE 2,1

3890 AT 17,17: PRINT "Press any key."

3900 CSIZE 2,1

3910 END DEFine teach

3920 :

3930 :

3940 :

3950 :

3960 DEFine PROCedure faces(cownt)

3970 CLS

3980 AT 1,1: PRINT "You got ";cownt;" of them right, "

3990 increment=0: radius=7

4000 FOR n=1 TO cownt

4010 CIRCLE n*radius+1+increment,80,radius

4020 ARC n*radius+1+increment - 2.6, 78 TO n*radius+1+increment+2.6,78,PI

4030 POINT n*radius +1+increment - 2,82 : POINT n*radius+ 1+increment+2,82

4040 increment=increment+radius+2

4050 END FOR n

4060 AT 12,1:PRINT "and ";10 - cownt;" of them wrong"

4070 increment=0

4080 FOR n=1 TO 10-cownt

4090 CIRCLE n*radius+1+ increment,50,radius

4100 ARC n*radius+1+increment-2.6,46 TO n*radius+1+increment+2.6,46,-PI

4110 POINT n*radius+1+increment-2,52:POINT n*radius+1+increment+2,52

4120 increment=increment+1+radius+2

4130 END FOR n

4140 END DEFine faces

4150 :

4160 :

4170 :

4180 :

4190 DEFine PROCedure wait

4200 LOCal a$

4210 a$=""

4220 REPeat loop

4230 a$=INKEY$

4240   IF a$ <> "" THEN EXIT loop

4250 END REPeat loop

4260 END DEFine wait

4270 :

4280 :

4290 :

4300 :

4310 DEFine PROCedure rub_out(text$,text_line,column)

4320 LET length = LEN(text$)

4330 AT text_line,column:PRINT FILL$(" ",length)

4340 END DEFine rub_out

4350 :

4360 :

4370 :

4380 :

4390 DEFine PROCedure check_input(answer$,text_line,column)

4400 REPeat get_input

4410   AT text_line,column : INPUT answer$

4420   IF answer$="" OR answer$=" " THEN GO TO 4410

4430   IF answer$<="0" OR answer$>"999" THEN

4440      rub_out answer$,text_line,column

4450   ELSE

4460      EXIT get_input

4470   END IF

4480 END REPeat get_input

4490 END DEFine check_input

4500 :

4510 :

4520 :

4530 :

4540 DEFine PROCedure option(level$,change$)

4550 PAUSE 125 : CSIZE 2,1

4560 IF level$(1) INSTR "RPT" THEN AT 14,4: PRINT "Press C to Change table"

4570 AT 15,4:PRINT "Press R to Repeat"

4580 AT 16,4:PRINT "Press M to obtain Menu"

4590 IF change$<>" " THEN

4600     AT 20,4 : PRINT "Press ";change$(1);" to move on to a ";change$

4610 END IF

4620 REPeat choose_option

4630   AT 22,4: PRINT "Which?";

4635   menu_choice$=INKEY$(-1) : convert_case :option$=menu_choice$

4640   IF option$<>"" AND LEN(option$)=1 THEN

4650       IF (change$=" " AND option$ INSTR "RM" ) OR (level$(1) INSTR "RPT" AND option$ INSTR "RCM"&change$(1) ) THEN

4660         EXIT choose_option

4670       ELSE

4680         rub_out option$, 18,10

4690       END IF

4700     ELSE

4710       IF option$<>"" THEN rub_out option$,18,10

4720   END IF

4730 END REPeat choose_option

4740 END DEFine option

4750 :

4760 :

4770 :

4780 :

4790 DEFine PROCedure quiz_list(test,tables_list,new_tables_list)

4800 AT 6,2: PRINT "The quiz will be on the following"

4810 AT 7,2: PRINT "Multiplication tables: "

4820 AT 9,5: PRINT;

4830 FOR tab1e=1 TO 12

4840    IF test=0 THEN

4850       PRINT " ";table;

4860     ELSE

4870       IF tables_list(table)<>0 THEN PRINT " ";table;

4880    END IF

4890 END FOR table

4900 PRINT " "

4910 AT 12,5:PRINT "Press A to Accept this list. "

4920 AT 14,5:PRINT "Press C to Change this list. "

4930 REPeat quiz_on

4940 AT 16, 5: PRINT "Which?"

4945 menu_choice$=INKEY$(-1):convert_case:quiz_on$=menu_choice$

4950 IF quiz_on$<>" " AND LEN(quiz_on$)=1 THEN

4960    IF quiz_on$ INSTR "AC" THEN

4970       EXIT quiz_on

4980     ELSE

4990       STRIP 1: rub_out quiz_on$,16,11: STRIP 6

5000    END IF

5010 ELSE

5020   IF quiz_on$<>"" THEN STRIP 1:rub_out quiz_on$, 16,11 :STRIP 6

5030 END IF

5040 END REPeat quiz_on

5050 IF quiz_on$ INSTR "c" THEN

5060   alter_list test,tables_list,new_tables_list:RETurn

5070 ELSE

5080   FOR table=1 TO 12

5090      IF test=1 THEN LET new_tables_list(table)=tables_list(table)

5100      IF test=0 THEN LET new_tables_list(table)=table

5110   END FOR table

5120 END IF

5130 END DEFine quiz_list

5140 :

5150 :

5160 :

5170 :

5180 DEFine PROCedure alter_list(test,tables_list,new_tables_list)

5190 LOCal pick_table

5200 PAPER 1:CLS:STRIP 7:INK 0

5210 AT 8,2 : PRINT "< or >, to choose, to select"

5220 AT 9,10: PRINT " to delete"

5230 AT l0,2: PRINT " when your list is complete"

5240 AT 15,3: PRINT "Multiplication tables chosen: -"

5250 CSIZE 1,0

5260 n=1

5270 REPeat quiz_on

5280   FOR table=1 TO 12

5290     STRIP 7

5300     IF table=n THEN STRIP 2

5310     AT 13,tab(table)-2: PRINT table;

5320   END FOR table

5330   a$=INKEY$(-1)

5340   IF a$=CHR$(192) THEN n=n-1:IF n=0  THEN n=1

5350   IF a$=CHR$(200) THEN n=n+1:IF n=13 THEN n=12

5360   IF a$=CHR$(32) THEN

5370      LET new_tables_list(n)=n

5380      AT 17,tab(n)-2:STRIP 2:PRTNT n

5390   END IF

5400   IF a$=CHR$(194) THEN

5410      LET new_tables_list(n)=0

5420      AT 17,tab(n)-2 : STRIP 1:PRINT "  "

5430   END IF

5440   IF a$=CHR$(10) THEN

5460      LET pick_table=O

5470      FOR check=1 TO 12

5480         LET pick_table= pick_table+new_tables_list(check)

5496      END FOR check

5500      IF pick_table<>0 THEN CLS:PAPER 6:INK 0:EXIT quiz_on

5510   END IF

5520 END REPeat quiz_on

5530 END DEFine alter_list

5540 :

5550 :

5560 :

5570 :

5580 DEFine PROCedure convert_case

5590 IF CODE(menu_choice$)>90 : menuchoice$=CHR$(CODE(menu_choice$)-32)

5600 END DEFine convert_case

SMSQ/E Licence Change!!!

It will be like this:

Wolfgang Lenerz informed the QL-users group that the licence for SMSQ/E has changed to a BSD licence. This appears to a significant change to the contentious issue of the development of SMSQ/E, too late to save the Qx0 but possibly not too late to support the porting of SMSQ/E to emulators other than QPC2.


 Copyright (c) 1989-2012, by the following persons:


Tony Tebby
Marcel Kilgus
Bruno Coativy
Fabrizio Diversi
Phoebus Dokos
Thierry Godefroy
Jérôme Grimbert
George Gwilt
John Hall
Mark Swift
Per Witte
Wolfgang Lenerz

collectively called the "COPYRIGHT HOLDERS".

All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.


THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.


"I'll get around to change that, hopefully sometimes around next week, and put it up on the website." Wolfgang

RaspberryPi

The Raspberry Pi user guide is in. QL Heaven is going to read this before getting a RPi. There a a lot more possibilities to this than running uQLx on it.

QL Today Subscription Cancelled

QL Heaven is still QLing but the subs to QL Today have not been renewed. QL Heaven is excited about the possibility of a Raspberry Pi as a QL emulator and that the QL user's list has indicated that uQLx has been successfully compiled for the Rpi. But the editorial line taken by the current QL Today editor makes it impossible to renew the subscription to this journal despite the fact that QL Heaven has subscribed faithfully through thick and thin, despite quantities of dubious content since the launch of this magazine.

Gold Card

Just seen a Gold Card go on ebay for exactly £109.77. WOW. No guarantees it was functional. It was sold as "new", in unopened packaging. BTW how was it photographed for the sale? Any way the image here is a Gold card, just not the one sold. This one is definitely functional. But what it demonstrates is that there is still demand for faster QL hardware. Any possibility of adapting an emulator to run natively on RPi?

QLToday - To Subscribe or Not

Subscription renewals are now due for QLToday. To renew or not that is the question. QL Heaven has subscribed continuously since the magazine was launched but now considers that QLToday has been gradually detaching from ordinary QL users since Mr Wicks has taken the editorial chair. Each edition has had either a direct or indirect attack on Quanta plus a self congratulatory bit on the number of pages filled in the magazine. Yet there is little sense of the quality of the content. The amount of filler smeared over the pages is now outstanding and often filled with angst. I can give references to specific articles if required. What QL Heaven asks has this got to do with QLing.  The business model Geoff Wicks unwittingly adheres to gives the magazine little influence on the actual content, yet quality of content is the key responsibility of the editor. But no, Geoff sees the last "independent" QL magazine as a soap box for his anti Quanta and pseudoprescient views. To be fair Geoff is not unique as there have been many more virulent precursors. However, it is clear that if QLToday keeps its current editorial line Mr Wicks will ensure that he will be literally and factually the last man standing in QLToday.

QLHeaven is still considering if it should resubscribe to QLToday. Is it time to quit?

QL Hardware

Memory Lane computing has pulled out of developing the QL-SD card although it is said that the drivers are ready. The project is now back with Peter Graf - who originated it. It is not surprising really that the project became non viable as the number of users of black box QL must now be minuscule and when last surveyed a few years ago this die hard group had been most resistant to upgrading or spending anything on hardware over the preceding decades. C'est la vie.

If hardware projects are to succeed they must tap into the modernisers group of QL users

Non Parametric Statistics for the QL - back to the 1980s

Here at QL Heaven a box of old 3.5inch floppy disks has been reopened. The box has been stored for some time. The first disk out of the box was labelled MDV Cartridges copied 8th April 2001. The single disk contained Superbasic software written in the mid to late 1980s. This included some statistical comparison methods for research. Back then there were absolutely no commercial statistics packages for the QL. And now the situation is exactly unchanged.

In the interests of preservation the software package has been again copied to one of the QXL.win files on QPC. Running the programs with SBASIC threw up some interesting faults. Badly constructed IF statements with additional unnecessary END IFs that threw the END DEFine statements out of kilter. Clashes between some of the program's variable names and SBASIC keywords and horror of horrors even some GOTOs. How the programs ran I don't know. Yet they did, presumably because the QDOS Superbasic interpreter was more generous in allowing constructs that SBASIC does not.

QL Heaven plans to review the programs further to discover if the calculations produced are in fact valid after the tweaks required to stop the SBASIC interpreter complaining. If so perhaps they will be published here as listings.

QL World Programs - File Finder

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

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 :