Wednesday 26 December 2012

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

Sunday 23 December 2012

Sunday 2 December 2012

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

Sunday 25 November 2012

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

Monday 1 October 2012

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.

Sunday 5 August 2012

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.

Sunday 29 July 2012

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?

Saturday 30 June 2012

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?

Tuesday 12 June 2012

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

Sunday 8 April 2012

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.

Sunday 19 February 2012

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 :