18: Outlining Fonts

If you've tried desktop publishing or advanced word processing, you will know that one of the superior features of RISC OS is the ease with which it handles fonts. To get some practice at using them ourselves, we will add text to our application.

First, be warned! This section introduces no fewer than eleven new procedures and makes a great many changes to existing ones. If you're not concerned about using fonts, you could skip the section entirely and go on to reading about printing. You'll then find, of course, that some procedures have acquired extra lines, or some lines extra statements, but you can ignore them.

Font Handles and Painting

Press F12, start up Basic and enter the following:

SYS "Font_FindFont",,"Trinity.Medium",24*16,24*16 TO fhandle%

Register R1 contains the address of the string containing the font. As we've seen earlier, Basic's SYS command puts the address where Basic has stored 'Trinity.Medium' into R1.

The numbers in R2 and R3 refer to the horizontal and vertical point sizes respectively, expressed in ¹/₁₆ths of a point. A point is ¹/₇₂ inch. In this example, we're producing 24 point characters with a normal width to height ratio.

We could put the x and y resolution in dots per inch into R4 and R5, but leaving them out of the instruction results in them being loaded with zeros, which makes the font manager use default resolution.

After the call, we put the number returned in R0 into variable fhandle%. This is the font handle, used for producing 24pt Trinity.Medium characters.

Now to put something on the screen. Press Return a few times to scroll the screen upwards and leave some white space on which to write some outline font text. Then enter:

SYS "Font_Paint",fhandle%,"Outline font text",%100010000,200,200

You can, of course, put whatever you like between the second set of quotes. It will appear on the screen in quite large letters.

The font handle, fhandle%, is in R0 and the string, or rather its address, in R1. The binary number in R2 is a set of flags - in this example, bits 4 and 8 are set. Bit 4 indicates that the x and y coordinates (in R3 and R4) are in OS units, rather than millipoints (¹/_72,000 of an inch!) and bit 8 tells the system to use the font handle in R0.

If bit 8 is not set, the font manager uses the current font. This is usually the font handle produced by the last call to Font_FindFont, or it can be set by a call to Font_SetFont, with the font handle in R0.

The full list of flag bits is in the Programmer's Reference Manual. Most of them are ignored by RISC OS 2, including bit 8. It is possible, by using various flags and registers, to justify the text (adjusting the lengths of spaces between words so that it fits the desired space), produce a rubout box or even print from right to left (useful if you have an Arabic font!).

Losing the Font

SYS "Font_LoseFont",fhandle%

with the font handle in R0. It doesn't matter if another application is using the same font with the same x and y point sizes (which would produce the same font handle). The system counts how many times a font handle is produced and lost so that it knows when the font is finally finished with.

So how do we add text to our test application? We produced a standard for plot commands in our Plot Instruction List whereby the details for each command - the PLOT code, x and y coordinates and colour - were contained in four bytes. Clearly, we'll need more bytes than this if we want to include a string of text and a font handle.

Let's start in the same way as we did when we wrote the original application, by building a few new commands into the program. Look in PROCinit and find the line:

!list%=-1

This is the line which puts -1 at the start of the Plot Instruction List when you first load the program. Take it out and replace it with nine new lines, so that the start of PROCinit looks like this:

 1540 DEFPROCinit
 1550 REM initialisation before polling loop starts
 1560 DIM b% 255,ws% 1023,menspc% 1023,stack% 1023,list% 1023
 1570 wsend%=ws%+1024:stackend%=stack%+1024:stackptr%=stack%
 1580 quit%=FALSE
 1590 SYS "Font_FindFont",,"Trinity.Medium",12*16,12*16 TO fonth%
 1600 !list%=&00071C1F:list%!4=fonth%
 1610 $(list%+8)="Hello"+CHR$0+CHR$0+CHR$0
 1620 list%!16=16
 1630 SYS "Font_FindFont",,"Trinity.Medium",18*16,18*16 TO fonth2%
 1640 list%!20=&000FFC1F:list%!24=fonth2%
 1650 $(list%+28)="Hello again"+CHR$0
 1660 list%!40=20
 1670 list%!44=-1
 1680 colsel%=7
 1690 PROCload_templates
      etc.

These are instructions for putting two text strings in our window with different colours and point sizes. The first instruction is contained in lines 1600 to 1620, but we first have to generate a font handle for it to use. This is done by the call to Font_FindFont in line 1590. To keep things relatively simple, our application will only use uncompressed characters; that is, characters with equal x and y point sizes. Line 1590, then, initialises a 12pt Trinity Medium font and makes its font handle fonth%.

If you look back at Section 11, where we invented the format for our Plot Instruction List, you will see that the top eight bits of the word contain the PLOT code. We will indicate that this is a command to print text by giving it a PLOT code of zero (this usually means 'draw a line, the coordinates being relative to the last point', so it's no loss to us if we intercept it and use it for something else!).

The first word which line 1600 inserts at list% is an instruction of this type: you can see that the top two hex digits, corresponding to the top eight bits, are zero. The rest of the word contains the x and y coordinates and the colour number, which will be used in plotting our text in the same manner as other instructions.

The second word, at list%+4, contains the font handle, which was produced in the previous line. This is followed by the text string itself, starting at list%+8. This string contains six characters, including the Return character on the end, which occupy 1½ words. In order to keep things word-aligned (that is, at an address divisible by 4), we put the next part of the instruction at list%+16.

At present, we can delete the last instruction in the list by clicking Adjust anywhere in the window. The program does this simply by finding the -1 at the end of the list, going back to the previous word and replacing it with a new -1. In the case of a text string, it clearly has to go back further, but how is it to know that the word before the -1 is the end of a string and not an ordinary graphics plotting instruction? The answer is to add a special word to the end of the string to tell it; one whose top byte contains a zero.

This is the purpose of the word in line 1620 at list%+16. The number in this word is the length of the entire instruction, excluding itself, which in this case is 16 bytes; four for the plot instruction, four for the font handle and eight for the text string.

Lines 1640 to 1660 add a second instruction to the list, this time to plot a string in 16pt Trinity Medium. The string is slightly longer this time, occupying three words, so the word on the end is put 12 bytes further on. Finally, line 1670 puts -1 on the end of the whole list.

Do not try running the program yet as the software does not know how to interpret these new instructions yet. First we need to add a few more lines to PROCdraw:

 2430 DEFPROCdraw(b%,xorig%,yorig%)
 (2440 to 2570 REM lines...)
 2580 LOCAL coords%,colour%,plot%
 2590 MOVE xorig%,yorig%
 2600 coords%=list%
 2610 WHILE !coords%<>-1
 2620   PROCplot_shape(!coords%,x%,y%,colour%,plot%)
 2630   IF plot%=0 THEN
 2640     PROCtext(xorig%+x%,yorig%-y%,colour%,coords%)
 2650   ELSE
 2660     SYS "Wimp_SetColour",colour%
 2670     PLOT plot%,xorig%+x%,yorig%-y%
 2680     coords%+=4
 2690   ENDIF
 2700 ENDWHILE
 2710 ENDPROC
 2720 :

The first part of the procedure works in the same way as before, extracting the x and y coordinates (relative to the window origin), the colour and the PLOT code from the instruction word. If the PLOT code is zero, indicating that this is a text instruction, the rest of the operation is handled by PROCtext, passing it the x and y screen coordinates, the colour and the address of the instruction, contained in coords%. Note that the instruction to increment coords% by 4 ready for the next instruction is contained in the 'ELSE' part of the IF ... THEN ... ENDIF structure which handles graphics plotting; PROCtext makes its own arrangements.

Now enter the new procedure:

 4790 DEFPROCtext(x%,y%,col%,RETURN coords%)
 4800 fh%=coords%!4:coords%+=8
 4810 SYS "Wimp_SetFontColours",,1,col%
 4820 SYS "Font_SetFont",fh%
 4830 SYS "Font_Paint",,coords%,%10000,x%,y%
 4840 WHILE ?coords%>=32:coords%+=1:ENDWHILE
 4850 coords%+=1:WHILE (coords% MOD 4)<>0:coords%+=1:ENDWHILE
 4860 coords%+=4
 4870 ENDPROC
 4880 :

Line 4800 first extracts the font handle from the second word of the instruction, then increments coords% so that it points to the start of the text string itself.

Because we are plotting text in a desktop window, we set its colour using Wimp_SetFontColours. This call calculates how many intermediate colours can be used for anti-aliasing when putting the font on the screen and sets up the font manager accordingly. Register R1 contains the font background colour, which is the same as the window background colour, and R2 the foreground colour, passed to our procedure by PROCdraw.

In our earlier experiment in font painting, we told Font_Paint which font handle we wanted to use by putting it in R0 and setting bit 8 in the flags register, R2. RISC OS 2 doesn't allow this, but only works with the current font. We'll do it the RISC OS 2 way, to maintain backward compatibility. Font_SetFont makes font handle fh% the current font and we just tell Font_Paint the address of the text string, in R1, set bit 4 of the flags, to say that our coordinates are in OS units, not millipoints, and put the x and y coordinates in R3 and R4.

Having painted the string, we have to increment coords%, ready for the next instruction. Line 4840 increments it one byte at a time through the text string, looking for the terminating character. In theory, this will be a Return (ASCII code 13) but it responds to anything less than 32 to be on the safe side. Having found it and moved on to the following byte, the next line word-aligns coords% by incrementing it if it is not divisible by 4. It now contains the address of the extra word at the end of the instruction. Adding a further 4 onto it in line 4860 completes the job.

Because coords% was passed to the procedure as a parameter, it is treated as a local variable within it. In order that its final value can be passed back to PROCdraw, the keyword RETURN is placed before its name in the parameter list in line 4790, just as we did with PROCget_origin.

The listing so far can be found as page_180.

You should now find that your application window contains two text strings, one 12pt black and one 16pt light blue. You can add and delete other lines and shapes, but do not try to delete the text strings or the program will crash.

Adding text to our window becomes a further option to be selected, so we need to extend the dialogue box. Load your template file and open the Options window. We are going to add a bit to the bottom, so that it looks like this:

First, increase the height of the window to accommodate the new text entry controls. We need two more icons at the bottom, the first of which can easily be created by copying the 'Rectangle' icon and changing the text in the copy to 'Text'. The other icon is, of course, writable and should be given the appropriate button type.

The new radio icon should already have an ESG of 1, having been copied from the icon above it, and the writable icon should be left with an ESG of zero. Make its foreground colour black and background colour white, in accordance with standard RISC OS practice. Make it an indirected text-only icon, give it an indirected buffer size of 100 bytes, and put no text in it initially. Give it a validation string of 'Pptr_write', too, so that the pointer changes shape when passing over it.

Both icons need to be renumbered. You will recall that the existing four radio icons are numbered 0 to 3, the colour indicator box is number 4 and the 'OK' box number 5. Renumber the new 'Text' radio icon number 6 and the writable icon 7, ensuring that the original four radio icons, the current-colour icon and the OK icon retain their existing numbers. (The icon numbers of the colour selector icons are not important, as we do not use their icon numbers.) When you have completed the job, resave the template file.

When PROCload_templates creates the dialogue box, it will allocate 100 bytes from the indirected workspace area to the buffer which will hold the text in the writable icon. We can discover the address of this buffer and make it the value of a variable by inserting an extra line:

 1280 DEFPROCload_templates
 1290 REM opens window template file, loads and creates window
 1300 SYS "Wimp_OpenTemplate",,"<Shapes$Dir>.Templates"
 1310 REM ****** load and create Info box ******
 1320 SYS "Wimp_LoadTemplate",,stack%,ws%,wsend%,-1,"progInfo",0 TO ,,ws%
 1330 $stack%!(88+32*0+20)=version$
 1340 SYS "Wimp_CreateWindow",,stack% TO info%
 1350 REM ****** load and create main window ******
 1360 SYS "Wimp_LoadTemplate",,stack%,ws%,wsend%,-1,"Main",0 TO ,,ws%
 1370 SYS "Wimp_CreateWindow",,stack% TO main%
 1380 REM ****** load and create Options dialogue box ******
 1390 SYS "Wimp_LoadTemplate",,stack%,ws%,wsend%,-1,"Options",0 TO ,,ws%
 1400 textbuf%=!(stack%+88+32*7+20)
 1410 SYS "Wimp_CreateWindow",,stack% TO options%
 1420 REM ****** load and create Save box ******
 1430 SYS "Wimp_LoadTemplate",,stack%,ws%,wsend%,-1,"xfer_send",0 TO ,,ws%
 1440 savestr%=!(stack%+88+32*2+20)
 1450 SYS "Wimp_CreateWindow",,stack% TO saveas%
 1460 REM ****** end of window creation ******
 1470 SYS "Wimp_CloseTemplate"
 1480 ENDPROC
 1490 :

You may remember we used this technique for the Save box filename icon in Section 16. We take the starting address of the data block, b%, add on 88 bytes for the main window definition, 32 bytes for each icon before the one we're interested in (7 in this case), then another 20 to find the position of the word we want within the icon definition. The word at this address contains the address of the icon text buffer, which we make the value of textbuf%.

You will recall that PROCmouseclick passes on clicks over the dialogue box to PROCopt_box. The only change to be made to this procedure is to extend the list of icons which are ignored so that it includes our new 'Text' radio icon:

 3460 DEFPROCopt_box(button%,icon%)
 3470 CASE icon% OF
 3480   WHEN 0,1,2,3,6:
 3490   WHEN 5:
 3500     !b%=options%:b%!4=4
          etc.

We do not need to do anything about clicks over the writable icon, as these are not reported to the application; the Wimp places the caret itself.

You can use the application like this, but the two new icons will be ignored. Selecting 'Text' has the effect of producing a Move command, as all the other radio icons are deselected, and any text that you type into the writable icon will have no effect.

We need a new procedure for adding text to our Plot Instruction List, and we call it by adding two lines to PROCadd_item:

 2960 DEFPROCadd_item
 2970 x%=!b%:y%=b%!4
 2980 PROCget_origin(main%,xorig%,yorig%)
 2990 coords%=FNend
 3000 IF coords%<list%+1020 THEN
 3010 CASE TRUE OF
 3020   WHEN FNicon_state(options%,0):plot%=4:REM MOVE
 3030   WHEN FNicon_state(options%,1):plot%=5:REM DRAW
 3040   WHEN FNicon_state(options%,2):plot%=157:REM CIRCLE FILL
 3050   WHEN FNicon_state(options%,3):plot%=101:REM RECTANGLE FILL
 3060   WHEN FNicon_state(options%,6):plot%=0:REM TEXT
 3070   OTHERWISE:plot%=4:REM MOVE - all icons deselected
 3080 ENDCASE
 3090 !coords%=(((x%-xorig%) AND &FFC) DIV 4)+((yorig%-y%) AND 
      &FFC)*(1<<12)+(colsel% AND &F)*(1<<10)
 3100 coords%?3=plot%
 3110 IF plot%=0 PROCadd_text(coords%)
 3120 coords%!4=-1
 3130 PROCforce_redraw(main%)
 3140 ENDIF
 3150 ENDPROC
 3160 :

If icon 6 (the 'Text' radio icon) is selected, the Plot code is set to zero, to indicate a text instruction. The procedure then carries on as before, generating the new word for the Plot Instruction List. Before it puts -1 in the following word, however, we call our new procedure for handling the text, passing it the address of the first word of the instruction in coords%. PROCadd_text uses two-way parameter passing; it passes back an increased value for coords% so that line 3120 puts the -1 in the right place. If the string is too long to fit in the 1000 bytes allowed for the Plot Instruction List, PROCadd_text will sound a beep and decrease coords% by 4, with the result that line 3420 puts its -1 in place of the instruction word that it has just generated - the new instruction is cancelled because there isn't room for it.

Now to the new procedure for handling the text string:

 4980 DEFPROCadd_text(RETURN coords%)
 4990 LOCAL n%,pt%,fonth%
 5000 PROCterm(textbuf%)
 5010 IF coords%+LEN$textbuf%>list%+984:VDU 7:coords%-=4:ENDPROC
 5020 pt%=14*16
 5030 SYS "Font_FindFont",,"Trinity.Medium",pt%,pt% TO fonth%
 5040 coords%!4=fonth%
 5050 $(coords%+8)=$textbuf%
 5060 n%=LEN$textbuf%+8
 5070 coords%?n%=0
 5080 n%+=1
 5090 WHILE n% MOD 4<>0:n%+=1:ENDWHILE
 5100 coords%!n%=n%
 5110 coords%+=n%
 5120 ENDPROC
 5130 :

Note the RETURN keyword before coords%; the value is passed back to PROCadd_item at the end of this procedure.

The first action of the procedure is to replace the zero on the end of the string in the dialogue box's text buffer with a Return. We do this so that we can use the LEN of the string to calculate whether or not there is room for this instruction in the 1000-byte Plot Instruction List buffer. Line 5010 performs this calculation and aborts the procedure, with coords% reduced by 4 as we saw earlier, if there isn't.

We will stick with 14pt Trinity Medium text for the moment. Line 5020 sets the point size times 16 and line 5030 generates the font handle, which the following line puts into the word following the instruction.

Line 5050 copies the text string from textbuf% into the Plot Instruction List, starting at the third word. Our local variable n% is set to the length of the string plus 8, which, when added to coords% (the address of the start of the instruction) gives the address of the first byte following the string. Line 5070 puts a zero in this byte to terminate it in place of the Return character, which keeps the font manager happy.

We then increment n% so that it and coords%, when added together, point to the first byte following this terminating zero. The address we want for our next operation is, in fact, the first one which is divisible by 4, that is, word-aligned. If n% isn't divisible by 4, line 5090 increments it until it is. The value of n% is then the length of the instruction so far and this is the figure that we want to put into the word at coords%+n%.

Finally, we add this number to coords% and pass it back to PROCadd_item.

You can now select the 'Text' radio icon, type in a line of text and click on 'OK'. When you click Select over your main window, your carefully-chosen words will appear in 14pt Trinity Medium. You still can't delete the text with the Adjust button, but you can use the Clear menu option and start again.

To be able to delete text with Adjust, we need to make a few alterations to PROCdelete_item:

 3340 DEFPROCdelete_item
 3350 coords%=FNend
 3360 IF coords%>list% THEN
 3370   coords%-=4
 3380   IF (!coords% AND &FF000000)=0 coords%-=!coords%:SYS "Font_LoseFont",coords%!4
 3390   !coords%=-1
 3400 ELSE
 3410   VDU 7
 3420 ENDIF
 3430 PROCforce_redraw(main%)
 3440 ENDPROC
 3450 :

We've made the original IF ... THEN ... ELSE structure multi-line, as there is a further IF ... THEN within it.

To remind you, the procedure starts by finding the -1 at the end of the Plot Instruction List, using FNend. If the last instruction is not a text string, we still replace the preceding word with -1 as previously.

If the word before the -1 has zero in its highest eight bits, it follows the end of a text string and contains the number that we have to subtract from coords% to get the address of the instruction preceding the string. That is the word which we need to replace with -1 to delete the instruction.

There is a further job for this procedure to do. Every time we click Select to paint a new string in the window, we call PROCadd_text, which creates a new font handle. Every time we delete a string, therefore, we should call Font_LoseFont to say that we've finished with it (if we use the same font and point size, as we do at the moment, it will actually be the same number, but the font manager keeps track of how many times it's been used and lost).

After we've decreased coords% to the address of the instruction, the font handle is in coords%+4.

If we use the Clear menu option to clear the window, we will still have some outstanding font handles, but we will deal with them later.

The current version of the program can be found as page_187.

Choosing the Font Size

We need two more menu options to be able to choose the font name and font size, so we now need to make some additions to the line of DATA statements in PROCwindow_menu:

 2850 DEFPROCwindow_menu
 2860 RESTORE +1
 2870 DATA Shapes,Options,Clear,Save,Font_M,Font size,*
 2880 wmenu%=FNmake_menu
 2890 ENDPROC
 2900 :

As you may recall from Section 9, the '_M' suffix on the Font option tells FNmake_menu to set a bit in the menu item flags which makes the Wimp send a message to our application when we try to open a submenu.

We will deal with this option later. First, we need a submenu to set the point size. This will have one writable item, which will need a short buffer to hold what we type into it.

Add a further item to the DIM statements at the beginning of PROCinit and a new line:

 1550 DEFPROCinit
 1560 REM initialisation before polling loop starts
 1570 DIM b% 255,ws% 1023,menspc% 1023,stack% 1023,list% 1023,ptsize% 12
 1580 $ptsize%=""
      etc.

Twelve bytes should easily be enough to hold any point size we're likely to type in. Line 1580 ensures that the buffer initially contains the null string. If you wish, of course, you could put in a default point size, such as:

 1580 $ptsize%="14"

Now add the procedure to create the new submenu:

 5180 DEFPROCfont_size_menu
 5190 RESTORE+1
 5200 DATA Font size,_W,ptsize%,12,*
 5210 fmenu%=FNmake_menu
 5220 ENDPROC
 5230 :

This menu is a trifle unusual as the single item has no text, consisting of just an underline, followed by a 'W'. The width of the menu is determined by the length of the title.

As we saw when we wrote FNmake_menu in Section 9, a writable item needs three DATA statements telling it the title, address and length of the buffer.

We naturally require more lines in PROCmenus to call this procedure and attach the submenu to the main window menu:

 1950 DEFPROCmenus
 1960 REM create menus and attach submenus and dialogue boxes
 1970 PROCmain_menu
 1980 PROCattach(mainmenu%,0,info%)
 1990 PROCwindow_menu
 2000 PROCfont_size_menu
 2010 PROCattach(wmenu%,0,options%)
 2020 PROCattach(wmenu%,2,saveas%)
 2030 PROCattach(wmenu%,3,1)
 2040 PROCattach(wmenu%,4,fmenu%)
 2050 $savestr%="ShapeFile"
 2060 ENDPROC
 2070 :

As well as attaching our new submenu to item 4 of the window menu, we also tell PROCattach to attach something to item 3, purely to make it put an arrow to the right of the Font name item. It doesn't matter which address we give for the submenu as the Wimp will ignore it; because the 'message' flag is set, it will simply tell us when the pointer is over the arrow and take no further action.

Changing the point size is very simple because we made provision for it when we wrote PROCadd_text. The line which is now line 5060 originally set variable pt% to 14*16. Change it now to read:

 5020 DEFPROCadd_text(RETURN coords%)
 5030 LOCAL n%,pt%,fonth%
 5040 PROCterm(textbuf%)
 5050 IF coords%+LEN$textbuf%>list%+984:VDU 7:coords%-=4:ENDPROC
 5060 pt%=VAL$ptsize%*16:IF pt%=0 pt%=14*16
 5070 SYS "Font_FindFont",,"Trinity.Medium",pt%,pt% TO fonth%
      etc.

The new line uses the VAL keyword which works out the numerical value of whatever is in the string at ptsize%. If you do not enter a valid string, VAL returns zero. In this case, the last part of the line sets pt% to a default value of 14pt. You may like to try out these new additions. The listing can be found as page_189.

Creating a Font Name Menu

Fortunately, there is a SWI which will do all this work for us and produce a finished submenu block; Font_ListFonts. We tell it where we want the submenu block, where the indirected data workspace is, and the name of the font to put a tick against, and it does the rest. (Note that this SWI is only capable of building font menus from RISC OS 3 onwards. If you want your application to run on RISC OS 2, you must do all the work yourself.)

When we generated our earlier menus, we used a block of memory whose starting address was given as menspc%. Each time we generated a menu, menspc% was increased so that it pointed to the start of the unused portion of the block. We did a similar thing with the indirected data workspace and its variable ws%. It follows, then, that we can tell Font_ListFonts to put the menu block at the current value of menspc% and indirected data at ws%.

Unless you have very few fonts, you will probably find that 1024 bytes each is not enough space for your existing menus and window data plus your font menu. You could double the size of both areas to 2048 bytes, or even more if you have a lot of fonts, but watch out for error messages indicating that Basic does not have enough space; you may need to increase the WimpSlot, too.

We also need another buffer, which we'll call fontname%, to hold the current font name. The start of PROCinit now looks like this:

 1550 DEFPROCinit
 1560 REM initialisation before polling loop starts
 1570 DIM b% 255,ws% 2047,menspc% 2047,stack% 1023,list% 1023,ptsize% 12,fontname% 50
 1580 $ptsize%=""
 1590 $fontname%="Trinity.Medium"
 1600 wsend%=ws%+2048:stackend%=stack%+1024:stackptr%=stack%:menend%=menspc%+2048
 1610 quit%=FALSE
      etc.

We've put 'Trinity.Medium' in the new buffer as a default font name. Notice that we've increased wsend%, which shows the end address of the workspace buffer and also introduced a similar variable, menend% to indicate the end of the menu buffer.

When we move the mouse pointer over the arrow to the right of the Font menu item, the Wimp sends us a message telling us of the fact, so we must add a line to PROCreceive to handle it:

 1770 DEFPROCreceive
 1780 REM handles messages received from the Wimp with reason codes 17 or 18
 1790 CASE b%!16 OF
 1800   WHEN 0:quit%=TRUE
 1810   WHEN 2:PROCsave
 1820   WHEN 3:PROCload
 1830   WHEN &400C0:PROCmenu_message
 1840 ENDCASE
 1850 ENDPROC
 1860 :

The first 20 bytes of the message block at b% are the standard message information which we learnt about in Section 15. The remainder of the block contains the following:

b%+20		Submenu pointer
b%+24		x coordinate of new submenu top left-hand corner
b%+28		y coordinate of new submenu top left-hand corner
b%+32		main menu item number
b%+36		first submenu item number
		etc., plus -1 to terminate the list

The pointer to the submenu data block at b%+20 will be invalid as we didn't put the correct number into our dummy PROCattach procedure. We could have put in the current value of menspc%, but this would have become invalid if we had created any more menus. This does not matter, as we know where to create our submenu by the value of menspc% when we do it. The remaining details are correct, though, and can be used by our new procedure:

 5260 DEFPROCmenu_message
 5270 CASE TRUE OF
 5280   WHEN topmenu%=wmenu% AND b%!32=3 AND b%!36=-1:PROCfont_list(b%!24,b%!28)
 5290 ENDCASE
 5300 ENDPROC
 5310 :
 5320 DEFPROCfont_list(menx%,meny%)
 5330 buf%=menspc%
 5340 SYS "Font_ListFonts",,0,%101<<19,,0,,0 TO ,,,bsize1%,,bsize2%
 5350 IF bsize1%>menend%-buf% ERROR 1<<30,
      "Not enough space to list all the fonts"
 5360 IF bsize2%>wsend%-ws% ERROR 1<<30,
      "Insufficient indirected workspace to list all fonts"
 5370 SYS "Font_ListFonts",,buf%,%101<<19,menend%-buf%,ws%,wsend%-ws%,fontname%
 5380 PROCattach(wmenu%,3,buf%)
 5390 SYS "Wimp_CreateSubMenu",,buf%,menx%,meny%
 5400 ENDPROC
 5410 :

We start with a general routine for handling menu messages in case we decide to add more menu items to be handled in this manner. The CASE TRUE OF structure will allow us to do this.

Line 5280 checks that we are in the window menu (topmenu%, you will recall, holds the address of the top menu block which we need to reopen the menu structure if we click Adjust on a menu item), and that the pointer is on item 3. We also check that b%+36 is -1 to ensure that we're not already on a submenu off item 3. Assuming all this is true, we call PROCfont_list, passing it the x and y coordinates where we wish the submenu to appear.

We call Font_ListFonts twice; the first time to ask it to tell us how much buffer space it requires and the second time to assemble the submenu. The zeros in R1 and R4 on the first call tell it to return the required buffer sizes.

Register R2 contains a set of flags, all of which are listed in the Programmer's Reference Manual. The expression '%101<<19' means that we set bits 19 and 21 to 1. Bit 19 tells the routine that we want it to assemble a menu block, rather than to return a list of fonts, and bit 21 tells it to put a tick against the font whose name is in the buffer whose address we put in R6. If we were also to set bit 20 (with the expression '%111<<19'), the routine would put the System Font at the top of the list. (That is, the standard bitmap font which is used for non-outline-font printing by RISC OS, rather than the lookalike outline font called System, which was supplied with some RISC OS systems and which will appear among the other outline fonts on the menu if it is installed.)

The call returns with the amount of menu and indirected data workspace required in R3 and R5 respectively. Lines 5350 and 5360 check these against the available buffer space and give an error message if either is not large enough. If this happens, you have two alternatives: rewrite PROCinit to enlarge the buffer space or shorten your font list!

When we call Font_ListFonts again in line 5370, we put the menu buffer address in R1, the amount of free menu space in R3, the workspace address and amount free in R4 and R5 respectively and the address where we hold the name of our current font in R6. The routine then creates the new menu block for us. Having created it, we attach it properly to the main menu block so that Wimp_DecodeMenu will work in PROCmenuclick.

Wimp_CreateSubMenu works in the same way as Wimp_CreateMenu except that it doesn't close the parent menu. We pass it the address of the submenu block in R1 and the x and y coordinates in R2 and R3.

You should now find that your Font name menu item leads you to a very professional-looking font menu. Try it; the listing can be found as page_192. Of course, choosing items from the font menu won't actually produce any results just yet.

To make use of this menu, we need to add a couple of lines to PROCmenuclick:

 2080 DEFPROCmenuclick
 2090 REM handles mouse clicks on menu in response to Wimp_Poll reason code 9
 2100 LOCAL c%,adj%
 2110 c%=FNstack(20)
 2120 SYS "Wimp_GetPointerInfo",,c%
 2130 adj%=(c%!8 AND 1)
 2140 SYS "Wimp_DecodeMenu",,topmenu%,b%,c%
 2150 CASE $c% OF
 2160   WHEN "Quit":quit%=TRUE
 2170   WHEN "Clear":PROCclear
 2180   WHEN "Save":PROCchecksave
 2190   OTHERWISE
 2200     IF LEFT$($c%,5)="Font.":PROCpick_font
 2210 ENDCASE
 2220 IF adj% PROCshowmenu(topmenu%,topx%,topy%)
 2230 PROCunstack(c%)
 2240 ENDPROC
 2250 :

The three WHEN statements in the CASE ... OF structure check the whole string c$. We obviously can't do this in the case of the Font name item so we'll deal with it as an OTHERWISE item; line 1780 is executed if none of the WHEN statements applies.

If we clicked on, say, Trinity Medium, the complete string c$ would contain:

Font.Trinity.Medium

Line 2200 checks the first five characters (up to the first '.') and calls a new procedure which we now enter:

 5360 DEFPROCpick_font
 5370 SYS "Wimp_DecodeMenu",,buf%,b%+4,fontname%
 5380 SYS "Font_ListFonts",,buf%,%101<<19,menend%-buf%,ws%,wsend%-ws%,fontname%
 5390 ENDPROC
 5400 :

PROCmenuclick made use of Wimp_DecodeMenu, although it wasn't strictly necessary to do so. All the information we needed to tell which menu item had been chosen was contained in the data block starting at b% when the procedure was called.

In the case of the font submenu, though, things are different. We have no way of knowing which font name is in which menu item unless we decode it.

To remind you, Wimp_DecodeMenu requires the addresses of the top menu block in R1, the list of menu item numbers in R2 and a buffer to hold the decoded string in R3. If we told it the address of the main window menu and the start of the list of all the item numbers, we would end up with a string such as:

Font.Trinity.Medium

which is more than we want. We can, however, just decode the first font submenu. Its address is buf% and its menu item number is in b%+4. This will produce a string containing just the font name, which is what we need to put into fontname%.

If we terminated the procedure here, it would certainly work. You could click Select on, say, Homerton Bold and, the next time you opened the menu, you would find that the tick had indeed moved to Homerton Bold. If, however, you clicked Adjust, the menu would stay open, having been redrawn by PROCmenuclick, but the click would stay where it was. This is because the menu block hadn't been updated.

It would look more professional if the tick moved as soon as we clicked Adjust. To achieve this, line 4720 calls Font_ListFonts one more time to update the menu block. The previous line has put our new font name in fontname% and it is this same buffer which Font_ListFonts uses to determine which font name to tick.

Now that we have the name of our chosen font in the buffer at fontname%, using it is very simple. We just have to replace 'Trinity.Medium' with fontname% in PROCadd_text when we call Font_FindFont:

 4980 DEFPROCadd_text(RETURN coords%)
 4990 LOCAL n%,pt%,fonth%
 5000 PROCterm(textbuf%)
 5010 IF coords%+LEN$textbuf%>list%+984:VDU 7:coords%-=4:ENDPROC
 5020 pt%=VAL$ptsize%*16:IF pt%=0 pt%=14*16
 5030 SYS "Font_FindFont",,fontname%,pt%,pt% TO fonth%
 5040 coords%!4=fonth%
      etc.

You should now be able to type a text string into the writable icon in your dialogue box and choose the colour, typeface and font size in which to plot it. Now that you have this working, it's time to remove those instructions that you added to the Plot Instruction List in PROCinit and put back the '!list%=-1' instruction which they replaced, so that the start of PROCinit again looks like this:

 1550 DEFPROCinit
 1560 REM initialisation before polling loop starts
 1570 DIM b% 255,ws% 2047,menspc% 2047,stack% 1023,list% 1023,ptsize% 12,fontname% 50
 1580 $ptsize%=""
 1590 $fontname%="Trinity.Medium"
 1600 wsend%=ws%+2048:stackend%=stack%+1024:stackptr%=stack%:menend%=menspc%+2048
 1610 quit%=FALSE
 1620 !list%=-1
 1630 colsel%=7
      etc.

The listing thus far can be found as page_195.

Font Saving Problems

The problem is that the file just contains our Plot Instruction List which refers to fonts only by their font handles. If you save a file and immediately load it in again, the font handles are still valid, so the machine can paint the text strings in the appropriate fonts and point sizes. If you reset the machine, though, it no longer recognises the font handles.

Clearly we need to save font information along with the Plot Instruction List. The easiest way to do this is to double the size of the buffer at list%:

 1570 DEFPROCinit
 1580 REM initialisation before polling loop starts
 1590 DIM b% 255,ws% 2047,menspc% 2047,stack% 1023,list% 2047,ptsize% 12,fontname% 50
 1600 $ptsize%=""
 1610 $fontname%="Trinity.Medium"
 1620 wsend%=ws%+2048:stackend%=stack%+1024:stackptr%=stack%:
      menend%=menspc%+2048:fontlist%=list%+1024
 1630 quit%=FALSE
 1640 !list%=-1:!fontlist%=-1
 1650 colsel%=7
      etc.

We've effectively created two 1,024-byte buffers, one pointed to by list% and the other by fontlist%. Doing it this way ensures that they occupy a continuous section of memory, so that they can easily be saved together in one file. The two statements in line 1640 set the first word of each of them to -1.

The new buffer will contain a list of font handles, point sizes and font names. Unfortunately, RISC OS does not have a SWI which obtains a font name from its handle, so we will have to update the list every time we generate a new font handle in PROCadd_text.

We first add a new line to PROCadd_text:

 5030 DEFPROCadd_text(RETURN coords%)
 5040 LOCAL n%,pt%,fonth%
 5050 PROCterm(textbuf%)
 5060 IF coords%+LEN$textbuf%>list%+984:VDU 7:coords%-=4:ENDPROC
 5070 pt%=VAL$ptsize%*16:IF pt%=0 pt%=14*16
 5080 SYS "Font_FindFont",,fontname%,pt%,pt% TO fonth%
 5090 PROCadd_font(fonth%,pt%)
 5100 coords%!4=fonth%
      etc.

Line 5090 passes the font handle and point size to our new procedure:

 5470 DEFPROCadd_font(h%,p%)
 5480 LOCAL n%,found%
 5490 found%=FALSE
 5500 n%=fontlist%
 5510 WHILE !n%<>-1
 5520   IF !n%=h% found%=TRUE
 5530   n%+=8
 5540   WHILE ?n%>=32:n%+=1:ENDWHILE
 5550   n%+=1
 5560   WHILE n% MOD 4<>0 n%+=1:ENDWHILE
 5570 ENDWHILE
 5580 IF NOT found% THEN
 5590   !n%=h%:n%!4=p%:$(n%+8)=$fontname%
 5600   n%+=8
 5610   WHILE ?n%>=32:n%+=1:ENDWHILE
 5620   n%+=1
 5630   WHILE n% MOD 4<>0 n%+=1:ENDWHILE
 5640   !n%=-1
 5650 ENDIF
 5660 ENDPROC
 5670 :

Each entry in the list will consist of one word containing the font handle and one containing the point size, followed by the font name, padded out to fill a whole number of words. A word containing -1 finishes the list.

Avoiding Duplicate Font Handle Entries

We start by setting local variable found% to FALSE. A further local variable, n% is set to the beginning of the list and the contents of the first word compared with the font handle. If there is a match, found% is set to TRUE. We then increase n% by 8 bytes to the address of the beginning of the font name, then keep incrementing it until we find the terminating character at the end of the name and the start of the next word beyond it. The process is repeated until we find -1 instead of a font handle.

If found% has become TRUE, we do not need to do anything else, as the new font handle is the same as one already in the list. If it has not been found, we add it in place of the -1. Line 5590 adds the font handle, point size and font name and lines 5600 to 5630 find the address of the first word following the name. Finally, line 5640 puts a new -1 at the end of the list.

We now need to save a larger block of memory so that our file contains both the Plot Instruction List and the font list. To do this, we make a minor modification to PROCsave2:

 4640 DEFPROCsave2
 4650 n%=FNend2+4
 4660 SYS "XOS_CLI","SAVE "+$savestr%+" "+STR$~list%+" "+STR$~n% TO err%;flags%
      etc.

In the earlier version, we called FNend, which found the address of the -1 at the end of the Plot Instruction List. We've replaced it with a call to FNend2 which works in exactly the same way, except that it starts looking at fontlist% instead of list%:

 5680 DEFFNend2
 5690 LOCAL n%
 5700 n%=fontlist%
 5710 WHILE !n%<>-1
 5720   n%+=4
 5730 ENDWHILE
 5740 =n%
 5750 :

An alternative approach would be to use the same function and pass to it the address where we want to start looking for the -1 as a parameter. We would use FNend in its original manner by calling FNend(list%) and to find the end of the font list by calling FNend(fontlist%).

We are now saving files in excess of 1,024 bytes in length, a lot of which will consist of whatever garbage happens to lie between the end of the Plot Instruction List and the start of the font list. If you have several font definitions, the file will probably be longer than 1,024 bytes - the size of one sector on an ADFS floppy disc. This means that the file will occupy two sectors instead of one, which is not very efficient if a lot of it is garbage.

You could improve matters by copying the font list onto the end of the Plot Instruction List before you save it to produce a shorter file with no garbage.

We make use of the font list when we load a file:

 3800 DEFPROCload
 3810 IF b%!40<>&012 ERROR 1<<30,"Filetype not recognised"
 3820 PROCterm(b%+44)
 3830 !fontlist%=-1
 3840 SYS "XOS_CLI","LOAD "+$(b%+44)+" "+STR$~list% TO err%;flags%
 3850 IF (flags% AND 1)<>0 !err%=1<<30:SYS "OS_GenerateError",err%
 3860 b%!12=b%!8
 3870 b%!16=4:REM Message_DataLoadAck
 3880 SYS "Wimp_SendMessage",17,b%,b%!4
 3890 $savestr%=$(b%+44)
 3900 PROCupdate_fonts
 3910 !b%=main%
 3920 SYS "Wimp_GetWindowState",,b%
      etc.

Line 3830 puts -1 at the beginning of the font list before we load the file. This is our own bit of backward compatibility; you may have a file of a beautifully-crafted picture that you produced with your application before you started this section; such a file will be less than 1,024 bytes long and will not overwrite any existing font list. Line 3830 ensures that the font list will be empty in this situation. The call to the new procedure to update the fonts is in line 3900. Notice that it comes after the file is loaded but before the window is updated. We have two new procedures to type in:

 5760 DEFPROCupdate_fonts
 5770 LOCAL n%
 5780 n%=fontlist%
 5790 WHILE !n%<>-1 AND n%<fontlist%+1024
 5800   oldh%=!n%
 5810   SYS "XFont_FindFont",,n%+8,n%!4,n%!4 TO newh%;flags%
 5820   IF (flags% AND 1)<>0:err%=newh%:!err%=1<<30:PROCclear:SYS"OS_GenerateError",err%
 5830   PROCupdate_plot_list(oldh%,newh%)
 5840   !n%=newh%
 5850   n%+=8
 5860   WHILE ?n%>=32:n%+=1:ENDWHILE
 5870   n%+=1
 5880   WHILE n% MOD 4<>0:n%+=1:ENDWHILE
 5890 ENDWHILE
 5900 ENDPROC
 5910 :
 5920 DEFPROCupdate_plot_list(old%,new%)
 5930 LOCAL n%
 5940 n%=FNend
 5950 WHILE n%>list%
 5960   IF (!n% AND &FF000000)<>0 THEN
 5970     n%-=4
 5980   ELSE
 5990     n%-=!n%
 6000     IF n%!4=old% n%!4=new%
 6010     IF n%>list% n%-=4
 6020   ENDIF
 6030 ENDWHILE
 6040 ENDPROC
 6050 :

Line 5790 starts a search of the font list with a safeguard. If the file is corrupted and doesn't contain -1, the search stops at 1,024 bytes.

We meet a problem when we regenerate font handles. The new handle for, say, 14pt Trinity Medium may not be the same number as the old handle for the same font when we saved the file. You may have been using other applications which used fonts, either when you saved the file or when you load it. Each time we generate a new font handle, we must go through the Plot Instruction List looking for all instances of the old handle and replace them with the new one.

New Handles For Old

Line 5830 calls the procedure to update the font handle in the Plot Instruction List, passing it the old and new font handles, and the remainder of the procedure increments n% past the font name to the start of the next entry.

PROCupdate_plot_list works backwards through the Plot Instruction List in the same way as PROCdelete_item does when we delete the last item from the list, checking the font handle of each text instruction. If line 6000 finds a match, it replaces the old handle with the new one.

There is one more thing involving fonts that our application has to do to be a well-behaved program. We call Font_LoseFont each time we click Adjust to delete a text string but do nothing about font handles remaining when we get rid of the entire Plot Instruction List. We do this on three occasions:

• When we choose Clear from the window menu
• When we load a file
• When we quit the application

The Plot Instruction list tells us which font handles we've generated and how many times we've used them. Each time we insert a string into the list, we call Font_FindFont. If we had, say, six strings which were all in 14pt Trinity Medium, we would have generated the same font handle six times, but the font manager would know this. To tell it that we've finished with this handle, we have to call Font_LoseFont six times. Only then will it know that the space in the font cache can be given to something else.

To do this, we simply have to go through the Plot Instruction list calling Font_LoseFont once for each text string, passing it the appropriate font handle. Our final new procedure in this section does this:

 6060 DEFPROClose_fonts
 6070 LOCAL n%
 6080 n%=FNend
 6090 WHILE n%>list%
 6100   IF (!n% AND &FF000000)<>0 THEN
 6110     n%-=4
 6120   ELSE
 6130     n%-=!n%
 6140     SYS "Font_LoseFont",n%!4
 6150   IF n%>list% n%-=4
 6160   ENDIF
 6170 ENDWHILE
 6180 !fontlist%=-1
 6190 ENDPROC
 6200 :

In much the same way as PROCupdate_plot_list and PROCdelete_item, the procedure works backwards through the list. Its final action is to empty the font list by putting -1 in its first word.

Add a line calling this procedure to PROCclear and PROCload:

 3640 DEFPROCclear
 3650 PROClose_fonts
 3660 !list%=-1
 3670 PROCforce_redraw(main%)
 3680 ENDPROC
 3690 :

 3800 DEFPROCload
 3810 IF b%!40<>&012 ERROR 1<<30,"Filetype not recognised"
 3820 PROCterm(b%+44)
 3830 PROClose_fonts
 3840 SYS "XOS_CLI","LOAD "+$(b%+44)+" "+STR$~list% TO err%;flags%
 3850 IF (flags% AND 1)<>0 !err%=1<<30:SYS "OS_GenerateError",err%
 3860 b%!12=b%!8
      etc.

Note that the new line in PROCload takes the place of the one which put -1 in fontlist%. It isn't needed now because this job is done by the new procedure.

Only after you've checked that there are no errors in PROClose_fonts, should you put a similar line in PROCclose. This is because PROCclose forms part of the error-handling system; an error in PROClose_fonts would call the error handler, which in turn would call PROCclose once again, which would call PROClose_fonts and you would be in an infinite loop, causing the program to hang the machine.

To be extra safe, we'll put an extra line in PROCclose to disable the error handler:

  230 DEFPROCclose
  240 REM tells the Wimp to quit the application
  250 ON ERROR OFF
  260 PROClose_fonts
  270 SYS "Wimp_CloseDown",task%,&4B534154
  280 ENDPROC
  290 :

Unfortunately, this will spoil the working of the first of our two error handlers - the one in line 60 which handles errors which occur while the program is initialising before entering the main polling loop. This line at present calls PROCclose, then prints the error message and line number. To keep this facility, rewrite line 60 to read:

   60 ON ERROR SYS "Wimp_CloseDown",task%,&4B534154:REPORT:PRINT" at line ";ERL:END

That completes our support for fonts in this application. The listing can be found as page_203.