EddIcon Resized

It has been some time since there was time to update this blog. That does not mean that nothing has been happening in QL heaven. Here is a glimpse at some of things happening here. A Q68 was acquired and one irritation was the EddIcon could not run on the 512x384 16 bit colour resolution screen as it only used a window 640x480. So after some devling about the innards of EddIcon here is a revamped version that has 3 window izes. The original, a medium sized window that fits in to 512x384 and a small window suitable for 512x256. Besides the window changes there have been some other changes to the interface and functionality. Sprites can now be saved out with RLE compression, as mode 64, 32 and mode 4. Mode 4 sprites can also be saved as a series of data statements to be incorporated in to QPTR superbasic. There are still some bugs in the colour handling routines so its not for release yet.

Other things that have been looked at are a simplified method of automatically creating and editing simple Qascade menus., reading and writing to FAT16 formatted CF cards on the Q60 and printing through the serial port via a RPi, Python and CUPs to a WiFi printer, a bit like the retroprint project. The difference being that CUPs handles text, HTML, and postscript. All of these modes work on the system. Quill doc files still have to be converted.

All these things might be looked at in future posts but at the moment here is EddIcon in 3 sizes.

 

When Source Code is provided

Compare in GD2 colour integrated with File Requestor SBASIC from QLWorld compiled with Turbo.

SerNet and DEV an excellent combination to connect a floppy drive to a Q68

The Q68 uses SDHC cards both as its hard disk like storage and as it's removable media.

There are (currently) no other physical storage devices for the Q68.

However it does have a serial port. So with another QL type system ( with a decent baud rate) connected via a null modem cable and using Sernet and the dev device the following SBASIC command :

DEV_USE 1,S2_FLP1_

a SBASIC or using the files thing  can now access flp1_ on the second QL second identified as S2 by sernet.

A powerful combination of  existing software enhancing the functionality of new hardware.

Answer to a question on the QLforum

In answer to polka's question in the QL Forum, here is a snippet of my boot code that allows the selection of multiple hardware configurations using a single boot file and to load alternative operating systems if desired.

The key elements are a timed loop that will start a default configuration if nothing is selected during the timeout period. Otherwise if an alternative configuration is chosen a file that indicates the selected cofiguration is written to the primary partition of the hard disk. This is used after the configuration of smsq/e is loaded and started by the boot file to set up the drivers and programs for the previously selected configurations.Nothing is written to these file but they could be used to add different adaptions to the boot.  

1000 REMark Overwrite the ROM SMSQ/E 2.91

1010 :

1020 REMark -- Mount Win2_,Win3_& Win4_ to make immediatly available --

1030 WIN_DRIVE 2,0,1 : WIN_DRIVE 3,0,2 : WIN_DRIVE 4,0,3 : ft=0

1040 REMark for the moment DONT automatically mount all drives except backup

1050 REMark AS DISK IS NOT ATTACHED

1060 REMark for the 1ST IDE SLAVE channel

1070 REMark WIN_DRIVE 5,1,0:WIN_DRIVE 6,1,1:WIN_DRIVE 7,1,2:WIN_DRIVE 8,1,3

1080 REMark for the 2ND IDE MASTER channel

1090 REMark WIN_DRIVE 5,2,0:WIN_DRIVE 6,2,1:WIN_DRIVE 7,2,2:WIN_DRIVE 8,2,3

1100 :

1110 WINDOW #0;SCR_XLIM(#0),SCR_YLIM(#0),0,0:CSIZE#0,0,0:INK#0,2:PAPER#0,0:CLS#0

1120 IF PEEKS$(2,3)='RES': GO TO 1930

1130 :

1140 WINDOW #1;256,128,128,64:INK#1,4:PAPER#1,0

1150 PAPER#1,0

1160 INK#1,7:PRINT "F1";:INK#1,4:PRINT " for SMSQ/E 3.33 (QMAC) + FAT32"

1170 INK#1,7:PRINT "F2";:INK#1,4:PRINT " for SMSQ/E 3.33 (QMAC) + QUBide"

1180 INK#1,7:PRINT "F3";:INK#1,4:PRINT " for SMSQ/E 3.33 (QMAC) + Win5-8"

1190 INK#1,7:PRINT "F4";:INK#1,4:PRINT " for SMSQ/E 3.33 + FAT16"

1200 PRINT

1210 INK#1,7:PRINT "F5";:INK#1,4:PRINT " for Test Versions of SMSQE & QPAC2"

1220 INK#1,7:PRINT "F6";:INK#1,4:PRINT " for QDOS Classic"

1230 INK#1,7:PRINT "F7";:INK#1,4:PRINT " for Mode4 SMSQ/E 3.32"

1240 INK#1,7:PRINT "F8";:INK#1,4:PRINT " for SMSQE Compile Enviroment"

1250 INK#1,7:PRINT "F9";:INK#1,4:PRINT " for SMSQ/E 3.13 mode 4 and PSION Chess"

1260 PRINT

1270 PRINT "   Timeout SMSQ/E 3.33 (QMAC) Win1-4 only"

1280 :

1290 timeout=DATE

1300 timeout=timeout+15

1310 REPeat lp

1320 IF PEEKS$(2,3)='RES':EXIT lp

1330 key=CODE(INKEY$(#0))

1340 SELect ON key

1350 :

1360   =232 : REMark F1 overwrite the ROM with SMSQ/E 3.33

1370          OPEN_OVER#3,"Win1_DoMountFat32":CLOSE#3:key=0

1380          AT#0,2,12

1390          PRINT#0,"INSERT CADDY with FAT32 CF card. Press ANYKEY"

1400          PAUSE#0

1410          IF PEEKS$(2,3)<>'RES':LRESPR "Win1_SMS_Q40smsq333_ROM"

1420 :

1430   =236 : REMark F2 go with SMSQ/E 3.33 + QUBide

1440          OPEN_OVER#3,"Win1_DoQUBide":CLOSE#3:key=0

1450          AT#0,2,12

1460          PRINT#0,"INSERT CADDY with QUBide CF card. Press ANYKEY" : PAUSE#0

1470          IF PEEKS$(2,3)<>'RES':LRESPR "Win1_SMS_Q40smsq333_ROM"

1480 :

1490   =240 : REMark F3 go with SMSQ/E 3.33 and Wins 5-8

1500          OPEN_OVER#3,"Win1_DoMountAll":CLOSE#3:key=0

1510          AT#0,2,12

1520          PRINT#0,"INSERT CADDY with HD containing Win5-8. Press ANYKEY" : PAUSE#0

1530          IF PEEKS$(2,3)<>'RES':LRESPR "Win1_SMS_Q40smsq333_ROM"

1540 :

1550   =244 : REMark F4 Use the new version of SMSQ/E with 3.33

1560          OPEN_OVER#3,"Win1_DoFAT16":CLOSE#3:key=0  : AT#0,2,15

1570          PRINT#0,"INSERT CADDY with FAT16 CF card. Press ANYKEY" : PAUSE#0

1580          IF PEEKS$(2,3)<>'RES':LRESPR "WIN1_SMS_Q40smsq333_rom"

1590          REMark IF PEEKS$(2,3)<>'RES':LRESPR "WIN1_rom"

1600 :

1610   =248 : REMark F5 Test version of SMSQ/E

1620          OPEN_NEW#3,"Win1_TestQPAC2":CLOSE#3:AT#0,2,12

1630          IF PEEKS$(2,3)<>'RES':LRESPR "Win1_SMQ_smsq_q40_testrom"

1640 :

1650   =234 : REMark F6 load QDOS Classic

1660           LRESPR Win1_Classic_SoftRom_rext

1670           COPY Win1_CLASSIC_CLASSICr_rom TO ram1_CLASSICr_rom

1680           PRINT#0,"Wait for Drive Light to go out, then Press Anykey to continue"

1690           PAUSE

1700           SOFTROM ram1_CLASSICr_rom

1710 :

1720   =238 : REMark F7 boot Mode 4 from Win1_

1730          OPEN_NEW#3,"Win1_Mode4":CLOSE#3

1740          IF PEEKS$(2,3)<>'RES':LRESPR "Win1_SMS_Q40smsq332mode4_ROM"

1750 :

1760   =242 : REMark F8 Try SMSQ/E compile environment

1770          OPEN_NEW#3,"Win1_CmpEnv":CLOSE#3

1780          BEEP 5000,0

1790          IF PEEKS$(2,3)<>'RES':LRESPR "Win1_SMS_Q40smsq333_rom"

1800 :

1810   =246 : REMark F9 boot 3.13 into mode 4

1820          OPEN_NEW#3,"Win1_psionchess":CLOSE#3

1830          IF PEEKS$(2,3)<>'RES':LRESPR "WIN1_SMS_q40mode4_rom"

1840 :

1850   =250 : REMark F10 smsq/e 3.33

1860          IF PEEKS$(2,3)<>'RES':LRESPR "Win1_SMS_Q40smsq333_rom"

1870 :

1880 END SELect

1890 IF DATE>timeout

1900      key=0:IF PEEKS$(2,3)<>'RES':LRESPR  "Win1_SMS_Q40smsq333_rom":EXIT lp

1910 END IF

1920 END REPeat lp

1930 :

1940 drv$="WIN1_"         : REMark Boot default directory

1950 REMark -- LOAD Enviroment Variable support early --

1960 LRESPR(drv$&"env_bin") : REMark used by all c68 progs

1970 :

1980 errt=FOPEN("Win1_DoMountFAT32")

1990 IF errt>0

2000    CLOSE#errt:DELETE "Win1_DoMountFAT32"

2010    WIN_DRIVE 5,2,0,0,"QXL.WIN"

2020    OPEN_OVER#3,ram1_Win5dump: DIR#3,Win5_:CLOSE#3:DELETE ram1_Win5dump

2030    SETENV "HDTYPE=FAT32"

2040 END IF

2050 :

2060 errt=FOPEN("Win1_DoMountAll")

2070 IF errt>0

2080    CLOSE#errt:DELETE "Win1_DoMountAll"

2090    WIN_DRIVE 5,2,0:WIN_DRIVE 6,2,1:WIN_DRIVE 7,2,2:WIN_DRIVE 8,2,3

2100    SETENV "HDTYPE=ALLWINS"

2110 END IF

2120 :

2130 errt=FOPEN("Win1_DoFAT16")

2140 IF errt>0

2150    CLOSE#errt:DELETE "Win1_DoFAT16" : WIN_DRIVE 5,2,0,0

2160    SETENV "HDTYPE=FAT16"

2170 END IF

2180 :

2190 errt=FOPEN("Win1_CmpEnv") : IF errt>0 :CLOSE#errt:LRUN Win1_Bootsmq_bas

2200 :

2210 errt=FOPEN("Win1_psionchess")

2220   IF errt>0

2230     CLOSE#errt:DELETE Win1_psionchess

2240     EX Win1_PRG_PSION_Chess_exe:STOP

2250   END IF

2260 :

2270 errt=FOPEN("Win1_Mode4")

2280 IF errt>0

2290    CLOSE#errt:DELETE "Win1_Mode4"

2300    REMark LRESPR("Win3_QTOP_thorgold_bin"):EX Win3_QTOP_TINDEX : STOP

2310    LRUN Win4_StartUp_Qx0boot

2320 END IF

2330 :

2340 TK2_EXT:IF VER$(1)>2.95 AND VER$(1)<=3.03:Set_Mode4_Colours

2350 key=KEYROW(7):REMark press "x" to load ProWess

2360 :

2370  IF VER$(1)<3 .03="" span="">

2380    LRESPR ('WIN1_CACHEMODES_rext') :WRITETHROUGH

2390    REMark LRESPR ('WIN1_MOVP4SMSQ60_cde')

2400 END IF

2410 REMark although MOVEP instruction removed from SMSQ/E 3.00 on there are some in Text87

2420 REMark so LRESPR 060 patch anyway

2430 LRESPR ('WIN1_MOVP4SMSQ60_cde')

2440 :

2450 IF VER$(1)=2.98 AND (key=0 OR key=8):DISP_SIZE 1024,512

2460 IF VER$(1)=2.99 AND (key=0 OR key=8):DISP_SIZE 1024,512

2470 :

2480 IF key=64:STOP

2490 :

2500 REMark -- Set Some Default Devices --

2510 IF SCR_LLEN>=128

2520   PWSDIR$="Win1_PWS_"  : REMark ProWesS default directory

2530 END IF

2540 DATA_USE "WIN1_" : PROG_USE "WIN1_"

2550 DEV_USE 1,Win1_PRG_EDT_ : REMark Editor 2.05 directory

2555 DEV_USE 8,FLP1_ : REMark make a device for CUE shell on Q68 to access a floppy

2560 :

2570 REMark set Colour Theme

2580 IF VER$(1)>=3.03:EX Win1_COLOUR_CoCo_setconf_bas;"Win1_COLOUR_CoCo_Themes_greys_thm,0"

2590 IF VER$(1)>=3.03:EX Win1_COLOUR_CoCo_setconf_bas;"Win1_COLOUR_CoCo_Themes_cream_thm,1"

2600 IF VER$(1)>=3.03:EX Win1_COLOUR_CoCo_setconf_bas;"Win1_COLOUR_CoCo_Themes_blueme_thm,2"

2610 IF VER$(1)>=3.03:EX Win1_COLOUR_CoCo_setconf_bas;"Win1_COLOUR_CoCo_Themes_copper_thm,3"

2620 :

2630 REMark set up window colours

2640 tcol=0

2650 IF VER$(1)>2.95:COLOUR_PAL:tcol=176

2660 WINDOW #0;SCR_XLIM(#0),SCR_YLIM(#0),0,0:CSIZE#0,0,0:INK#0,4:PAPER#0,tcol:CLS#0

2670 :

2680 BGCOLOUR_24 $919FCC : REMark BGCOLOUR_24 $AAAAFF : REMark BGCOLOUR_24 $878787

2685 REMark BGCOLOUR_24 $0

2690 : REMark Can we use ProWess

2700 errt=FOPEN("Win1_DoProWess")

2710 IF errt>0 : key=8 : CLOSE#errt:DELETE Win1_DoProWess

2720 IF SCR_LLEN>=128 AND key=8

2730   IF PWSDIR$(LEN(PWSDIR$))<>"_" THEN PWSDIR$=PWSDIR$&'_'

2740   LRESPR PWSDIR$&"ext_dll_rext"

2750   LRESPR PWSDIR$&"ext_syslib_rext"

2760   LRESPR PWSDIR$&"ext_global_rext"

2770   LRESPR PWSDIR$&"ext_PWbasic_rext"

2780   dd_err=0 : REMark for DATAdesign error trapping

2790 END IF

2800 :

2810 :

2820 REMark -- LOAD Extended environment extensions --

2830 IF VER$(1)>3.02

2840   LRESPR(drv$&"menu_rext")

2850   errt=FOPEN("Win1_TestQPAC2")

2860   IF errt>0

2870     CLOSE#errt:DELETE Win1_TestQPAC2

2880     LRESPR(drv$&"QPAC2_test")

2890   ELSE

2900     REMark LRESPR(drv$&"QPAC2_patch")

2910     LRESPR(drv$&"QPAC2_145a")

2920   END IF

2930 ELSE

2940   LRESPR("Win1_PRG_QD98_Menu_rext_old")

2950   LRESPR("Win1_TOOLS_QPAC2_Qpac2_139")

2960 END IF

2970 LRESPR ("Win1_QPTR")

2980 :

2990 REMark - Any more resident extensions?

3000 REMark --LOAD SERNET --

3010   BAUD 2,115200  : SER_ROOM 2,4096

3020   LRESPR("Win1_PRG_SERNET_sernet_rext")

3030   SNET 2

3040   SERNET

3050 :

3060 REMark install PFF virutal device whatever

3070 LRESPR ("Win1_PrinCtrl_PFF_bin")

3080 :

 and so on for loading extensions.

Reading Long File Names on FAT formatted SD cards

FAT drivers have been embedded in smsq/e for some time. Initially FAT12 for DOS formatted floppy disks and now FAT16 for the Q68. One frustrating thing about the drivers is that they only support the DOS short file name naming convention of 11 characters. This truncates names and makes it difficult to identify files in a list of similarly named files as shown.

The conventions for constructing LFNs can be found on the internet so after a bit of SBASIC work here is a first iteration of a menu system to manage files via their LFN on FAT 16 formatted disks.

The interface still needs a bit of work.

Multiple files can now be copied, moved or deleted from the FAT16 formatted SDHC card using their LFNs.

Qcascade Menu Editor for Q68

After some more work the mini menu editor for Qcascade has reached operational capability.
The idea of MenuEdit_QCSCDE_rc_bas and Make_Qcascade_rc_bas was to simplify and make more flexible the creation of small menus for use with Qcascade. As explained in the previous post the Qcascade _rc file and all the applications that will feature on the menu are located in a directory called APPS on win1_. EX Make_Qcascade_rc_bas, ideally from the Qcascade menu, and it will create a simple qcascade_rc filr incorporating all the files in the APPS directory. Next once the
 basic _rc file has been created EX MenuEdit_QCSCDE_rc_bas to embellish the menu derived from the _rc file with additional discription of the featured files if required. To add files to the menu add to the APPS directory and EX Make_Qcascade_rc_bas to update the _rc file, and that's it.

Writing MenuEdit_QCSCDE_rc_bas with the QPTR toolkit has not only refreshed my knowledge of this amazing toolkit but has also been a major learning experience as although I have written a number of QPTR based programs previously It seems I have only scratched the surface of what can be done with QPTR. Thanks also to Wolfgang Lenerz programming QPTR series in QLToday from the July/August 2002 issue through to the August/October 2004 issue.

Qcascade Menu Editor a work in progress for the Q68

There are now a plethora of free front ends for QL systems, many formerly commercial programs are now freeware. Several such as Launchpad, QDock and Go are from Dilwyn Jones. Then there is QTOP from CWO and Cueshell and QDT. There are also the more complex to customise ProWess and Proforma. Some require a bit of customisation but those from Dilwyn Jones are usually set up through the familiar config block and menu config and the point and click with the program. Where does this leave an old program like Qcascade, a drop down menu system from the 1990s written in C and using environment variables and a configuration script. The configuration script can be quite a tortuous process to set up especially if all the potential complexity of the software is used. As a result once configured it is not one that encourages change and adaption.

Acquisition of a Q68 has resulted in a new look at the use of Qcascade in the set up of this system. The Q68 system with 8 QXL.win files on SDHC card as "hard drives" has the potential to have access to up to 2-4 GB of files depending on the size of the QXL.win containers. The Q68 comes with a boot file for QDT and QDock as alternative desk top front ends. Speed on the Q68 system is dependent on screen size and colours used. Here there is a Q60 so for compatibility the 512x384 16 bit colour resolution works best with a speed that is similar to a SGcard/Aurora set up.

Given that Qdock had been chosen for the main front end it seemed that the best role for Qcascade would be to provide a menu of little apps that might be used to help with other tasks. As there was plenty of disk space programs were copied in to a directory on Win1_, neatly called APPS_.

A SBASIC program called "Make_QCSCDE_rc_bas" was created. When run this program scans the APPS_ directory and creates a new _rc file for Qcascade. To add programs to the menu, copy the program to the APPS_ directory and run "Make_QCSCDE_rc_bas"., place the mouse over the Qcascade button and press ESC and next time the menu is used the new app is on the menu. To remove - delete the program from the APPS_ folder and rebuild the menu as before. To make it really easy copy "Make_QCSCDE_rc_bas" to the APPS_ folder and run it from the menu. Simple.

Anyway here are 2 screen dumps.  One of the menu, and one of the next part of the project a pointer driven menu editor.Both programs have been written using QPTR 0.14 and show the use of 16 bit WMAN colours.

QL World File Finder Update - Wild Search

 Some time ago it was suggested here in QLHeaven that the File Finder program from QL World in 1989 was worthy of an update. At the moment there are several file finder programs on Dilwyn Jones website. QLHeaven has had a look at most of them. Many have drawbacks, some are complex and none are as simple as the original file finder program. So QLHeaven was pleased to discover that it had been updated.

The update is still a SBASIC listing that can be launched with EX. It needs SMSQE, and uses the WMAN colours. It also uses one QPTR keyword. As QPTR is now freeware and downloadable from Dilwyn Jones site this should not be an issue. The program is also FI2 capable. The advantage of it being a SBASIC listing is that it could be tweaked if need be. For example if for some reason a search pulled up more files that the arrays used in the program are designed for then they could be expanded. Although a search that pulls up more than 2k items surely cannot be a discriminating or useful search. The lists of files found may be saved as text documents for future reference if needed, and file names can be placed in the stuffer buffer.  Files can be exed or read/edited via FI2 if required.

Below are some screen shots of the program running on an Aurora system, a Q60 system and QPC2.

How to find SMSQ/E modules

I'm not certain where I found this program but I suspect it was from somewhere on Dilwyn Jones QL site http://www.dilwyn.me.uk/. It was written by Tony Tebby and was embedded in a document explaining the modular structure of smsqe:

Scanning an SMSQ OS File:

An SMSQ file can be scanned fairly easily with a simple SBASIC
program:

l00 REMark - scan bootloader file
110 DIM version$(4): version$(0)=4
120 OPEN #0,CON: CLS: BORDER 1,4
130 height = 17
140 INPUT 'SMSQ file>';f$
150 OPEN IN #3,f$
160 fln = FLEN(#3)
170 LGET #3\fln-$18+$4,mod_ptr : REMark - get length of host module
180 LGET #3\fln-$18+$14,bln    : REMark - length of bootloader file
190 IF bln: mod_ptr = mod_ptr + fln - bln
200 FOR i=1 to 9999
210   LGET #3\(mod_ptr),mbase,mlength
220   IF NOT mbase: EXIT              : REMark - end of file
230   IF NOT i mod height: INPUT a$;  : REMark - pause at screen full
240   WGET#3\(mod_ptr+$16),name_rel: REMark - relative pointer to name
250   GET#3\(mod_ptr+$16+name rel),name$  : REMark - fetch module name
260   IF LEN (name$)&&1: BGET#3,a : REMark - odd length name is padded
270   BGET #3,version$(1 TO 4)    : REMark - get version, if any
280   PRINT HEX$(mlength,24) !! version$ ! name$
290   mod_ptr = mod_ptr + mbase + mlength
300 END FOR i
310 CLOSE #3
320 INPUT a$

This will print the index (in hex), the version and the name of all except the host module.

This is the typical output of the file. Now here is a first pass improved version of the program.

100 REMark - scan bootloader file
110 DIM version$(4): version$(0)=4
120 OPEN #0,CON_512x420a20x16: CLS: BORDER 1,4
130 height = 52 : DIM d$(height,84) : pg=1
140 INPUT 'SMSQ file>';f$ : IF f$="":QUIT
150 OPEN_IN #3,f$
160 fln = FLEN(#3) : PRINT#0,CHR$(10)&HEX$(fln,32)&" length of file"&CHR$(10)
170 LGET #3\fln-$18+$4,mod_ptr : REMark - get length of host module
175 PRINT#0,HEX$(mod_ptr,32)&" length of host module"&CHR$(10)
180 LGET #3\fln-$18+$14,bln    : REMark - length of bootloader file
185 PRINT#0,HEX$(bln,32)&" length of bootloader file"&CHR$(10)
190 IF bln: mod_ptr = mod_ptr + fln - bln
200 FOR i=1 to 9999
210   LGET #3\(mod_ptr),mbase,mlength
220   IF NOT mbase: EXIT              : REMark - end of file
230   IF NOT i mod height: Inc : pg=pg+1 : INPUT a$;  : REMark - pause at screen full
240   WGET#3\(mod_ptr+$16),name_rel: REMark - relative pointer to name
250   GET#3\(mod_ptr+$16+name_rel),name$  : REMark - fetch module name
260   IF LEN (name$)&&1: BGET#3,a : REMark - odd length name is padded
270   BGET #3,version$(1 TO 4)    : REMark - get version, if any
280   PRINT HEX$(mod_ptr,32) !!!! HEX$(mlength,24) !! version$ ! name$
285   d$(i)=HEX$(mod_ptr,32)&"    "&HEX$(mlength,24)&"  "&version$&" "&name$
290   mod_ptr = mod_ptr + mbase + mlength
300 END FOR i
310 CLOSE #3 : PRINT#0,CHR$(10)&HEX$(mod_ptr,32)&" end of file"
320 PRINT#0,\"Save data as text file (S/s) or Quit program"
330 in=INKEY$(#0,-1) INSTR 'SsQq'&CHR$(27): REMark wait to close program
340 SELect on in
350   =1,2 : INPUT 'save file name>';sf$ : IF sf$="":QUIT
360   =Remainder : QUIT
370 END SELect
380 OPEN_NEW#3,sf$ : PRINT#3,f$\\HEX$(fln,32)&" length of file"&CHR$(10)
390 FOR i=1 TO height : IF d$(i)<>"": PRINT#3,d$(i) : END FOR i
400 PRINT#3,\\HEX$(mod_ptr,32)&" end of file"
410 CLOSE#3 : QUIT
420 :
430 DEFine PROCedure Inc
440   LOCal z$(height*pg),j
450   FOR j=1 TO height*pg : z$(j)=d$(j)
460   DIM d$(height*pg)
470   FOR j=1 TO height*pg :d$(j)=z$(j)
480 END DEFine

 This gives more useful information and now gives an option to save the screen output to a text file.

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