dpNotes are a collection of - hopefully - useful ideas for the furtherance of OPL programming. In dpNotes we focus primarily on Symbian OS v6 (ER6) and later, though some of it was around already at v5 (ER5) and even OPL16 times.

dpNotes were written by Martin Harnevie. If you have any comments or ideas please mail them to Martin at

dpNotes

Index

dpNote 0001 - Finding out the number of images in an MBM file
dpNote 0002 - Using the Nokia 9200 Series Communicator system fonts
dpNote 0003
- Getting the path to the location of an OPL application
dpNote 0004 - IOSEEK - documented and undocumented features
dpNote 0005 -
Calculating UID checksum
dpNote 0006
- Handling of simple stacks
dpNote 0007
- Multi-dimensional arrays
dpNote 0008 -
Stack of buffers with configurable size
dpNote 0009 - Getting the serial (IMEI) number of a Nokia 9200 Series Communicator
dpNote 0010 - Making the v6/S80 WINS Emulator more programmer friendly for OPL development
dpNote 0011 - Showing the amount of free memory
dpNote 0012 - Naming conventions
dpNote 0013 - Conversion between large hexadecimal and decimal numbers
dpNote 0014 - Useful POKEs and PEEKs
dpNote 0015 -
Endianism
dpNote 0016 - Toolbar buttons with text only
dpNote 0017 - dpToolbar - a better Toolbar for Psion Teklogix netBook and Psion Series 7
dpNote 0018 - Loading a complete file into a buffer
dpNote 0019 -
Converting long text buffers between Unicode and Ascii
dpNote 0020 -
LOC function which gives correct answer for control and Unicode characters
dpNote 0021 -
Character conversions
dpNote 0022 -
Converting between Unicode and SCSU
dpNote 0023 - Clipboard - accurate copying and pasting of text in ER6 and ER7
dpNote 0024 -
Adding a bitmap to an MBM file
dpNote 0025 -
Useful IO functions and wrappers
dpNote 0026 - Predictable Pause
dpNote 0027 - Launching an application from OPL and wait until it finishes before returning
dpNote 0028 - Asynchronous event loop with inactivity timer
dpNote 0029 - Key event codes for Series 60 phones
dpNote 0030
- Returning more than one value

Note: For ease of reading, we are using // comments in lieu of REM comments. We only use the latter to inactivate code, not to add comments code. If you try to compile with // comments you will of course get an error, but you can easily change to // comments using Find/Replace All.

dpNote 0001

2 July 2002


All OPL versions

Finding out the number of images in an MBM file

This procedure is quite useful when the number of images in an MBM file is unknown.
Usage:
NumberOfImages&=IoMbmImages&:(aMbmFileName$)

CONST KMbmFileImageCounterOffset&=&00000010
CONST KLongSize&=4

PROC IoMbmImages&:(aMbmFileName$)
LOCAL IoStatus%,hMbm%,IoMode%,Offset&,NoOfImages&
// open the image file
IoMode%=KIoModeOpen% OR KIoFormatBinary% OR KIoAccessRandom% OR KIoAccessShare%
IoStatus%=IOOPEN(hMbm%,aMbmFileName$,IoMode%)
IF IoStatus%<0
  RAISE KErrNotExists%
ENDIF
// move to the position of the offset address of the image counter
Offset&=KMbmFileImageCounterOffset&
IOSEEK(hMbm%,1,Offset&)
// read the position of the image counter
IOREAD(hMbm%,ADDR(Offset&),KLongSize&)
// move to the position of the image counter
IOSEEK(hMbm%,1,Offset&)
// read the image counter
IOREAD(hMbm%,ADDR(NoOfImages&),KLongSize&)
// close the image file
IOCLOSE(hMbm%)
// return number of images in file
RETURN NoOfImages&
ENDP

dpNote 0002

5 July 2002


v6 Series 80 R1

Using the Nokia 9200 Series Communicator system fonts

The
Const.oph file for Symbian OS v6.0 does not include the font UIDs for the Nokia 9200 Series Communicator. You could add the following constants to your Const.oph file to address this:

CONST KFontLindaBold16&=         268457209 // &100054F9
CONST KFontLindaBold18&=         268457210
CONST KFontLindaBold20&=         268457211 // in CBA titles for 9210
CONST KFontLindaBold22&=         268457212
CONST KFontLindaBold24&=         268457213
CONST KFontLindaBold29&=         268457214
CONST KFontLindaBoldItalic20&=   268457215
CONST KFontLindaItalic20&=       268457216
CONST KFontLindaNarrow20&=       268457217
CONST KFontLindaNarrow24&=       268457218
CONST KFontLindaNarrow29&=       268457219
CONST KFontLindaNormal18&=       268457220
CONST KFontLindaNormal20&=       268457221 // in gIPRINT for 9210
CONST KFontLindaNormal24&=       268457222
CONST KFontLindaNormal29&=       268457223 
// &10005507

CONST KFontTerminalNormal8&=     268437778 // &10000912, same in ER5
CONST KFontTerminalZoomed15&=    268437779 // &10000913
, same in ER5

The fonts are now selectable with
gFONT as normal.

The designations given are now taken from the 9210 screen layout document. They are slightly modified to comply with OPL coding standards.

The
KFontLindaBold20& UID is particularly useful if you wish to have a consistent font on your CBA titles.

And the KFontLindaNormal20& UID is useful if you wish to create variants of gIPRINT and ALERT messages. By the way, the green frame has the RGB value KRgbMessageBorderGreen&=&008800.

dpNote 0003

15 July 2002


All OPL versions

Getting the path to the location of an OPL application

This is a routine used in every OPL application we've developed. We have seen so many different ways of doing the same thing, but we find this method the most universal.

Usage, and one of the first things you do in the application:

Location$=Path$:

CONST KMaxFilenameLen%=255
CONST KCmdAppName%=1
CONST KParseFilenameOffset%=4


The constants above should normally be included in Const.oph.

PROC Path$:
LOCAL Path$(KMaxFilenameLen%),Offset%(6)
Path$=PARSE$(CMD$(KCmdAppName%),"",Offset%())
Path$=LEFT$(Path$,Offset%(KParseFilenameOffset%)-1)
RETURN Path$
ENDP

dpNote 0004

15 July 2002


All OPL versions
IOSEEK - documented and undocumented features

IOSEEK
has two more uses than the OPL manuals, for instance the OPL Guide & Reference (Release 036 for ER5),
usually mention. Modes 4 and 5 will return or set the current position in a text file. Furthermore, Mode 3 will return the resulting pointer in a binary file.

The typical usage is
IOSEEK(hFile%,IoMode%,Offset&), where hFile% is the relevant handle returned by IOOPEN, and IoMode% is the IOSEEK Mode. The Offset& is used to specify or receive pointers and positions.

IoMode%=1 will set the pointer in a binary file to the absolute value specified in Offset&.

IoMode%=2, will set the pointer in a binary file to Offset& bytes from the end of the file, i.e. Offset& is here equal to FileSize&-AbsoluteOffset&.

IoMode%=3 will set the pointer in a binary file to Offset& bytes relative to the current position. At the same time, Offset& will also be set to the resulting pointer. In other words, if Offset&=0, IOSEEK(hFile%,3,Offset&) will make Offset& take the value of the current pointer. This is sometimes not clearly documented either.

IoMode%=4 will set Offset& to the current position in a text file.

IoMode%=5 will set the current position in a text file to Offset&.

IoMode%=6 will rewind a text file to the first position. Offset& is not used, but you must still pass it as a argument.

Take note that by convention we talk about 'pointers' when handling binary files (Modes 1-3) and 'positions' when handling text files (Modes 4-6).
dpNote 0005

15 July 2002


All OPL versions

Calculating UID checksum

Want to define your own file formats? You will need to extract the UID4 from the
SyUIDCheckSum$: function. But this function, though you are passing three long integers to it, returns a string. And this string contains the other UIDs as well. This procedure helps you extract the UID4 as a long integer.

INCLUDE "System.oxh"

rem CONST
KTextHeader%=1 // ER1-ER5
CONST KTextHeader%=2 // ER6-ER7

PROC UidCheckSum&:(aUid1&,aUid2&,aUid3&)
LOCAL Header$(16),UidNo%,Uid&
// the System.opx function returns the complete file header as a string
Header$=SyUidCheckSum$:(aUid1&,aUid2&,aUid3&) // ER6 and later
rem Header$=CheckUid$:(aUid1&,aUid2&,aUid3&) // ER5 and earlier
// since we entered LongInt values, we should return LongInt values
// by setting this to 1,2,3 the other UIDs can be returned
//
but this is of course not needed here
UidNo%=4
Uid&=PEEKL(ADDR(Header$)+KTextHeader%+(UidNo%-1)*4)
RETURN Uid&
ENDP

See dpNote 0005 about the value of KTextHeader%.

dpNote 0006

15 July 2002


All OPL versions

Handling of simple stacks

This dpNote contains some general routines for stack handling. They can be used as a framework to build more advanced data formats, e.g. multidimensional arrays, lists and trees etc, as OPL does not have inherent support for these. Here, the stack routines are written to handle short integer values. They can easily be modified to handle values of other byte sizes.

CONST KStackShortHeader%=4
CONST KShortSize&=2

PROC StackShortCreate&:
// Usage: pStack&=StackShortCreate&
LOCAL p&
p&=ALLOC(KStackShortHeader%)
// 0 items so far
POKEL p&,&0000
RETURN p&
ENDP

PROC StackShortDestroy:(apStack&)
FREEALLOC apStack&
ENDP

PROC StackShortEmptyB%:(apStack&)
// returns KTrue% if stack is empty
RETURN (PEEKL(apStack&)=&0000)
ENDP

PROC StackShortDepth&:(apStack&)
// returns the number of items in the stack
RETURN PEEKL(apStack&)
ENDP

PROC StackShortAddr&:(apStack&,aNo&)
// returns the pointer address of a stack item number aNo&
IF aNo&<1 OR aNo&>StackShortDepth&:(apStack&)
  RAISE KErrInvalidStackNo%
ENDIF
RETURN apStack&+
KShortSize&*(aNo&-1)+KStackShortHeader%
ENDP

PROC StackShortRecall%:(apStack&,aNo&)
// returns the value of the item number aNo&
// usage: Value%=StackShortRecall%:(pStack&,Number%)
RETURN PEEKW(StackShortAddr&:(apStack&,aNo&))
ENDP

PROC StackShortStore:(apStack&,aNo&,aValue%)
// stores the value aValue% at position aNo&
POKEW StackShortAddr&:(apStack&,aNo&),aValue%
ENDP

PROC StackShortPeek%:(apStack&)
// returns the value of the item on top of the stack
// usage: Value%=StackShortPeek%:(pStack&)
RETURN PEEKW(StackShortAddr&:(apStack&,StackShortDepth&:(apStack&)))
ENDP

PROC StackShortPush&:(apStack&,aValue%)
// usage: pStack&=StackShortPush&:(pStack&,Value%)
LOCAL pNew&,size&,NewNoItems&
// calculate the new no of items
NewNoItems&=1+StackShortDepth&:(apStack&)
// calculate the new cell size
size&=KStackShortHeader%+KShortIntWidth&*NewNoItems&
// adjust to new cell size
pNew&=REALLOC(apStack&,size&)
IF pNew&=0
  RAISE KErrNoMemory%
ENDIF
// insert resulting number of items
POKEL pNew&,NewNoItems&
// insert value
POKEW StackShortAddr&:(pNew&,NewNoItems&),aValue%
// return new pointer
RETURN pNew&
ENDP

PROC StackShortPop%:(apStack&)
// usage: Value%=StackShortPop%:(pStack&)
LOCAL Value%,OldNoItems&,pNew&,size&,NewNoItems&
IF StackShortEmptyB%:(apStack&)
  RAISE KErrStackEmpty%
ENDIF
OldNoItems&=StackShortDepth&:(apStack&)
Value%=PEEKW(StackShortAddr&:(apStack&,OldNoItems&))
// calculate the new no of items
NewNoItems&=OldNoItems&-1
// calculate the new cell size
size&=KStackShortHeader%+KShortIntWidth&*NewNoItems&
// adjust to new cell size
pNew&=REALLOC(apStack&,size&)
// this check should not be needed, but let's check it anyway
IF pNew&<>apStack&
  RAISE KErrShrinkCellFailure%
ENDIF
// insert resulting number of units
POKEL pNew&,NewNoItems&
// return popped value
RETURN Value%
ENDP


PROC StackShortClear:(apStack&)
// guarantees that the pointer value is the same,
//
which StackShortDestroy: followed by StackShortCreate&: would not
LOCAL pNew&
// shrinking the cell
pNew&=REALLOC(apStack&,KStackShortHeader%)
// this check should not be needed, but let's check it anyway
IF pNew&<>apStack&
  RAISE KErrShrinkCellFailure%
ENDIF
// zero the counter
POKEL apStack&,&0000
ENDP

PROC StackShortDelete:(apStack&,aNo&)
// deletes an item without changing the order of other items
LOCAL OldNoOfItems&,Item&
OldNoOfItems&=StackShortDepth&:(apStack&)
// copy all items above the deleted item one step downwards
Item&=aNo&
WHILE Item&<OldNoOfItems&
  StackShortStore:(apStack&,Item&,StackShortRecall%:(apStack&,Item&+1))
  Item&=Item&+1
ENDWH
// remove the last item
StackShortPop%:(apStack&)
ENDP

PROC StackShortSwap:(apStack&,aNo1&,aNo2&)
LOCAL tmp%
tmp%=StackShortRecall%:(apStack&,aNo1&)
StackShortStore:(apStack&,aNo1&,StackShortRecall%:(apStack&,aNo2&))
StackShortStore:(apStack&,aNo2&,tmp%)
ENDP

PROC StackShortMirror:(apStack&)
// turns the stack inside-out so that what was previously on top,
// is now at the bottom etc
LOCAL LastNo&,MiddleNo&,q&,tmp%
IF StackShortEmptyB%:(apStack&)
  RAISE KErrStackEmpty%
ENDIF
LastNo&=StackShortDepth&:(apStack&)
// no point doing stack mirror if no of items less than 2
IF LastNo&<2
  RETURN
ENDIF
// doesn't actually matter if LastNo& is even or odd
MiddleNo&=LastNo&/2
q&=1
DO
  StackShortSwap:(apStack&,q&,LastNo&+1-q&)
  q&=q&+1
UNTIL q&>MiddleNo&
ENDP

PROC StackShortOccurrences%:(apStack&,aValue%)
// returns number of occurrences of a value
LOCAL found%,i&,NoOfItems&
found%=0
NoOfItems&=StackShortDepth&:(apStack&)
IF NoOfItems&=0
  RETURN found%
ENDIF
i&=1
DO
  IF aValue%=StackShortRecall%:(apStack&,i&)
    found%=found%+1
  ENDIF
  i&=i&+1
UNTIL i&>NoOfItems&
RETURN found%
ENDP

PROC StackShortFind&:(apStack&,aValue%)
// returns position of first occurrence of a value counted from top
// returns 0 if not found
LOCAL position&,NoOfItems&
position&=0
IF StackShortEmptyB%:(apStack&)
  RETURN position&
ENDIF
NoOfItems&=StackShortDepth&:(apStack&)
position&=NoOfItems&
DO
  IF aValue%=StackShortRecall%:(apStack&,position&)
    BREAK
  ENDIF
  position&=position&-1
UNTIL position&=0
RETURN position&
ENDP

dpNote 0007

28 Aug 2002
(Updated
4 Dec 2003
)

All OPL versions

Multi-dimensional arrays

OPL keywords do not support multidimensional arrays. But it is reasonably easy to implement it using the stack model of dpNote 0006. In this example we are looking at some procedures for handling integer two dimensional arrays.

The code is calling procedures and using constants of the dpNote 0006.

PROC ArrayDim&:(aNoOfColumns%,aNoOfRows%)
// this procedure sets up the array and remembers its dimension - similar to the
//
DIM command of some BASIC dialects. Just remember that Column comes before Row,
// just as x comes before y.
// Usage pMyArray&=ArrayDim&:(NumberOfColumns%,NumberOfRows%)
LOCAL pArray&,TotalNoOfPositions%,i%
// calculate the total number of positions
TotalNoOfPositions%=aNoOfColumns%*aNoOfRows%
// create stack
pArray&=StackShortCreate&:
pArray&=StackShortPush&:(pArray&,aNoOfColumns%) // remember no of columns in 1st header
pArray&=StackShortPush&:(pArray&,aNoOfRows%) // remember no of rows in 2nd header
// initialise the complete array to zero. You could also use REALLOC for this,
// but that would not guarantee that all variables in the array are set to zero
i%=1
WHILE i%<=TotalNoOfPositions%
  pArray&=StackShortPush&:(pArray&,$0)
  i%=i%+1
ENDWH
// return the pointer
RETURN pArray&
ENDP

PROC ArrayGetCols%:(apArray&)
RETURN StackShortRecall%:(apArray&,&0001)
ENDP

PROC ArrayGetRows%:(apArray&)
RETURN StackShortRecall%:(apArray&,&0002)
ENDP

PROC ArrayPos&:(apArray&,aCol%,aRow%)
// returns the position of the element of an array item (aCol%,aRow%)
LOCAL Position&,TotalCol%,TotalRow%
// obtain the array size
TotalCol%=ArrayGetCols%:(apArray&)
TotalRow%=ArrayGetRows%:(apArray&)
// check that the position is valid, and give error if otherwise
IF aCol%<1 OR aCol%>TotalCol% OR aRow%<1 OR aRow%>TotalRow%
  RAISE KErrInvalidStackNo%
ENDIF
// return position and add 2 for the header
Position&=(aRow%-1)*TotalCol%+aCol%+2
RETURN Position&
ENDP

PROC ArrayAddr&:(apArray&,aCol%,aRow%)
// returns the pointer address of the array item (aCol%,aRow%)
RETURN StackShortAddr&:(apArray&,ArrayPos&:(apArray&,aCol%,aRow%))
ENDP

PROC ArraySto:(apArray&,aCol%,aRow%,aValue%)
// stores the value aValue% to array item (aCol%,aRow%)
StackShortStore:(apArray&,ArrayPos&:(apArray&,aCol%,aRow%),aValue%)
ENDP

PROC ArrayRcl%:(apArray&,aCol%,aRow%)
// returns the value of the array item (aCol%,aRow%)
RETURN StackShortRecall%:(apArray&,ArrayPos&:(apArray&,aCol%,aRow%))
ENDP

PROC ArrayDestroy:(apArray&)
// erases array and frees up memory
StackShortDestroy:(apArray&)
ENDP

Assume now that we wish to create and populate a matrix A of 5 colums and 2 rows and a matrix B of 2 columns and 3 rows, and then do some calculations, this is how it can be done.

CONST KMatrixACol%=5
CONST KMatrixARow%=2
CONST KMatrixBCol%=2
CONST KMatrixBRow%=3

PROC Main:
LOCAL A&,B& // matrix handlers
// initialise arrays
A&=ArrayDim&:(KMatrixACol%,KMatrixARow%)
B&=ArrayDim&:(KMatrixBCol%,KMatrixBRow%)
// populate array A with '25' in all positions
ArrayPopulate:(A&,25)
// populate array B with '13' in all positions
ArrayPopulate:(B&,13)
// add A(5,2) to B(2,3) and put in A(1,1) and print it, it should print 38
ArraySto:(A&,1,1,ArrayRcl%:(A&,5,2)+ArrayRcl%:(B&,2,3))
PRINT ArrayRcl%:(A&,1,1)
GET
// erase both arrays and release memory
ArrayDestroy:(A&)
ArrayDestroy:(B&)
ENDP

PROC ArrayPopulate:(apArray&,aValue%)
LOCAL i%,j%,TotalCol%,TotalRow%
TotalCol%=ArrayGetCols%:(apArray&)
TotalRow%=ArrayGetRows%:(apArray&)
i%=1
WHILE i%<=TotalCol%
  j%=1
  WHILE j%<=TotalRow%
    ArraySto:(apArray&,i%,j%,aValue%)
    j%=j%+1
  ENDWH
  i%=i%+1
ENDWH
ENDP

It would now also be easy to write procedures for matrix addition and multiplication etc, where the result is put in matrix C.

C&=ArrayAdd&:(A&,B&) // should give error if A& and B& are not of same size
C&=ArrayAddValue&:(A&,aValue%)
C&=ArrayMultiply&:(A&,B&) // assumes no of colums in A& = no of rows in B&

C&=ArrayMultiplyByValue&:(A&,aValue%)

But we won't do it this time.

dpNote 0008

28 Aug 2002

1 Jan 2006

All OPL versions

Stack of buffers with configurable size

In dpNote0006 we looked at a simple byte stack. In dpModule.opo there are ready made stacks available for:

- Byte
(StackByte...)
- Word / short integer
(StackShort...)
- Long integer
(StackLong...)
- Float
(StackFloat...)
- Complex (two floats)
(StackComplex...)
- String with configurable length
(StackString...)
- Buffer with configurable size
(StackBuffer...)

This dpNote will demonstrate a stack of buffers with configurable size.

// the StackBufferHeader has depth stored in the first four bytes and the
// size of buffer stored in the next four bytes
CONST KStackBufferHeader&=&0008
CONST KStackBufferSizeOffset&=&0004

PROC StackBufferCreate&:(aBufferSize&)
// Usage: pStack&=StackBufferCreate&
LOCAL pStack&
pStack&=ALLOC(KStackBufferHeader&)
// 0 items so far
POKEL pStack&,&00000000
POKEL (pStack&+KStackBufferSizeOffset&),aBufferSize&
RETURN pStack&
ENDP

PROC StackBufferDestroy:(apStack&)
FREEALLOC apStack&
ENDP

PROC StackBufferDepth&:(apStack&)
// returns the number of items in a stack
RETURN PEEKL(apStack&)
ENDP

PROC StackBufferSize&:(apStack&)
// returns the size of each buffer item
RETURN PEEKL(apStack&+KStackBufferSizeOffset&)
ENDP

PROC StackBufferEmptyB%:(apStack&)
// returns KTrue% if stack is empty
RETURN (PEEKL(apStack&)=&00000000)
ENDP

PROC StackBufferAddr&:(apStack&,aNo&)
// returns the pointer address of a stack item aNo&
IF aNo&<1 OR aNo&>StackBufferDepth&:(apStack&)
  RAISE KErrInvalidStackNo%
ENDIF
RETURN apStack&+StackBufferOffset&:(apStack&,aNo&)
ENDP

PROC StackBufferOffset&:(apStack&,aNo&)
RETURN (StackBufferSize&:(apStack&)*(aNo&-1)+KStackBufferHeader&)
ENDP

PROC StackBufferRecallN&:(apStack&,aNo&)
// allocates and returns a pointer to a Buffer value
// Usage: pBuffer&=StackBufferRecallN&:(pStack&,Number%)
// the N indicates that a new buffer is created
LOCAL pBuffer&,BufferSize&
BufferSize&=StackBufferSize&:(apStack&)
pBuffer&=ALLOC(BufferSize&)
BufferCopy:(pBuffer&,StackBufferAddr&:(apStack&,aNo&),BufferSize&)
RETURN pBuffer&
ENDP

PROC StackBufferStore:(apStack&,aNo&,apBuffer&)
// stores the value aValue% at position aNo&
BufferCopy:(StackBufferAddr&:(apStack&,aNo&),apBuffer&,StackBufferSize&:(apStack&))
ENDP

PROC StackBufferStoreD:(apStack&,aNo&,apBuffer&)
// stores the value aValue% at position aNo&
// the D indicates that the buffer is destroyed
BufferCopy:(StackBufferAddr&:(apStack&,aNo&),apBuffer&,StackBufferSize&:(apStack&))
// destroy incoming cell
FREEALLOC(apBuffer&)
ENDP

PROC StackBufferPeekN&:(apStack&)
// returns a pointer of the item on top of the stack
// usage: pBuffer&=StackBufferPeek&:(apStack&)
// the N indicates that a new buffer is created
LOCAL pBuffer&,BufferSize&
BufferSize&=StackBufferSize&:(apStack&)
pBuffer&=ALLOC(Size&)
BufferCopy:(pBuffer&,StackBufferAddr&:(apStack&,StackBufferDepth&:(apStack&)),BufferSize&)
RETURN pBuffer&
ENDP

PROC StackBufferPush&:(apStack&,apBuffer&)
// Usage: pStack&=StackBufferPush&:(pStack&,pBuffer&)
LOCAL pNew&,size&,NewNoItems&,BufferSize&
BufferSize&=StackBufferSize&:(apStack&)
// calculate the new no of items
NewNoItems&=1+StackBufferDepth&:(apStack&)
// calculate the new cell size and adjust cell
size&=KStackBufferHeader&+BufferSize&*NewNoItems&
pNew&=REALLOC(apStack&,size&)
IF pNew&=&0
  RAISE KErrNoMemory%
ENDIF
// insert resulting number of items
POKEL pNew&,NewNoItems&
// insert new value
BufferCopy:(StackBufferAddr&:(pNew&,NewNoItems&),apBuffer&,BufferSize&)
// return new pointer
RETURN pNew&
ENDP

PROC StackBufferPushD&:(apStack&,apBuffer&)
// Usage: pStack&=StackBufferPushD&:(pStack&,pBuffer&)
// the D indicates that the buffer is destroyed
LOCAL pNew&
pNew&=StackBufferPush&:(apStack&,apBuffer&)
FREEALLOC(apBuffer&)
// return new pointer
RETURN pNew&
ENDP

PROC StackBufferPopN&:(apStack&)
// usage: pBuffer&=StackBufferPop&:(pStack&)
// the N indicates that a new buffer is created
LOCAL Value%,NoItems&,size&,pBuffer&,BufferSize&
IF StackBufferEmptyB%:(apStack&)
  RETURN &0000
ENDIF
BufferSize&=StackBufferSize&:(apStack&)
NoItems&=StackBufferDepth&:(apStack&)
// get the value to be popped
pBuffer&=ALLOC(BufferSize&)
BufferCopy:(pBuffer&,StackBufferAddr&:(apStack&,NoItems&),BufferSize&)
// calculate the new no of items
NoItems&=NoItems&-1
// calculate the new cell size
size&=KStackBufferHeader&+BufferSize&*NoItems&
// adjust to new cell size. since we're reducing we don't need to update pointer
REALLOC(apStack&,size&)
// insert resulting number of units
POKEL apStack&,NoItems&
// return popped value
RETURN pBuffer&
ENDP

PROC StackBufferClear:(apStack&)
// guarantees that the pointer value is the same,
// which StackBufferDestroy: followed by StackBufferCreate&: would not.
//
// shrinking the cell, since we're reducing we don't need to update pointer
REALLOC(apStack&,KStackBufferHeader&)
// zero the counter
POKEL apStack&,&0000
ENDP

PROC StackBufferDelete:(apStack&,aNo&)
// deletes an item without changing the order of other items
LOCAL NoOfItems&
NoOfItems&=StackBufferDepth&:(apStack&)
IF aNo&>NoOfItems&
  RAISE KErrInvalidStackNo%
ENDIF
ADJUSTALLOC(apStack&,StackBufferOffset&:(apStack&,aNo&),-StackBufferSize&:(apStack&))
// update header counter
POKEL apStack&,(NoOfItems&-1)
ENDP

PROC StackBufferInsertD&:(apStack&,aNo&,apBuffer&)
// inserts an item without changing the order of other items
// aNo& is the place where the insertion is done
// the D indicates that the incoming buffer is destroyed
LOCAL NoOfItems&,Item&,pNew&
// increase no of items
NoOfItems&=1+StackBufferDepth&:(apStack&)
// handle out of range cases
IF aNo&>=NoOfItems&
  Item&=NoOfItems&
ELSEIF aNo&<=&0
  Item&=1
ELSE
  Item&=aNo&
ENDIF
// increase cell size with one item
pNew&=ADJUSTALLOC(apStack&,StackBufferOffset&:(apStack&,Item&),StackBufferSize&:(apStack&))
IF pNew&=&0
  RAISE KErrNoMemory%
ENDIF
// update header
POKEL pNew&,NoOfItems&
// store value and destroy the incoming cell
StackBufferStoreD:(pNew&,Item&,apBuffer&)
// return new pointer
RETURN pNew&
ENDP

PROC StackBufferSwap:(apStack&,aNo1&,aNo2&)
LOCAL pTmp&
pTmp&=StackBufferRecallN&:(apStack&,aNo1&)
StackBufferStoreD:(apStack&,aNo1&,StackBufferRecallN&:(apStack&,aNo2&))
StackBufferStoreD:(apStack&,aNo2&,pTmp&)
ENDP

PROC StackBufferMirror:(apStack&)
// turns the stack inside-out so that what was previously on top
// is now at the bottom etc
LOCAL LastNo&,MiddleNo&,q&
LastNo&=StackBufferDepth&:(apStack&)
// no point in doing stack mirror if no of items less than 2
IF LastNo&<2
  RETURN
ENDIF
MiddleNo&=LastNo&/2
q&=1
DO
  StackBufferSwap:(apStack&,q&,LastNo&+1-q&)
  q&=q&+1
UNTIL q&>MiddleNo&
ENDP

PROC StackBufferOccurrences%:(apStack&,apBuffer&)
LOCAL found%,i&,NoOfItems&,pValue&
found%=$0
NoOfItems&=StackBufferDepth&:(apStack&)
IF NoOfItems&=&0
  RETURN found%
ENDIF
i&=1
DO
  pValue&=StackBufferRecallN&:(apStack&,i&)
  IF StackBufferIdenticalB%:(apBuffer&,pValue&)
    found%=found%+1
  ENDIF
  FREEALLOC(pValue&)
  i&=i&+1
UNTIL i&>NoOfItems&
RETURN found%
ENDP

PROC StackBufferFind&:(apStack&,apBuffer&)
// returns position of first occurrence of a value counted from top
// returns 0 if not found
LOCAL position&,NoOfItems&,pComparison&
position&=&0
IF StackBufferEmptyB%:(apStack&)
  RETURN position&
ENDIF
NoOfItems&=StackBufferDepth&:(apStack&)
position&=NoOfItems&
DO
  pComparison&=StackBufferRecallN&:(apStack&,position&)
  IF StackBufferIdenticalB%:(apBuffer&,pComparison&)
    BREAK
  ENDIF
  FREEALLOC(pComparison&)
  position&=position&-&1
UNTIL position&=&0
RETURN position&
ENDP

PROC StackBufferIdenticalB%:(apValue1&,apValue2&)
LOCAL BufferSize&,oIndex&
BufferSize&=StackBufferSize&:(apValue1&)
IF BufferSize&<>StackBufferSize&:(apValue2&)
  RETURN KFalse%
ENDIF
oIndex&=0
WHILE oIndex&<BufferSize&
  IF PEEKB(apValue1&+oIndex&)<>PEEKB(apValue2&+oIndex&)
    RETURN KFalse%
  ENDIF
  oIndex&=oIndex&+&1
ENDWH
RETURN KTrue%
ENDP

dpNote 0009

28 Aug 2002


v6 Series 80 R1

v6 Series 80 WINS

Getting the serial (IMEI) number of a Nokia 9200 Series Communicator

The serial number is the one normally written below the barcode and it only becomes visible once you remove the battery. Of course you can also get it from the phone screen by pressing *#06#. The number is also referred to as the IMEI number.

INCLUDE "System.oxh"

CONST KWINSSerialNumber$="111111111111111"

PROC SerialNumberGet$:
// first check if the routine is run in WINS, because there is
// a bug in SyGetPhoneInfo$:, it hangs when run from emulator
IF MachineTypeGet&:<>KSyMachineUid_Win32Emulator&
  // SyGetPhoneInfo$: returns a 16 character string. The rightmost
  // character is unknown. It needs to be truncated off
  // to avoid any issues with later comparisons.
  RETURN LEFT$(SyGetPhoneInfo$:(KPhoneInfoSerialNumber%),15)
ELSE
  // if run from WINS, return a faked serial number
  RETURN KWINSSerialNumber$
ENDIF
ENDP

PROC MachineTypeGet&:
LOCAL value&,return&
value&=0
return&=SyGetHAL&:(KSyMachineUID&,value&)
RETURN value&
ENDP

dpNote 0010

3 Sep 2002

v6 Series 80
WINS

Making the v6/S80 WINS Emulator more programmer friendly for OPL development

We find it most practical to program OPL in the WINS Emulator. In WINS for v5.0 there was a "Psion 5mx/netBook-style" VGA console. As far as we are concerned using this console provides the best trade-off between overview and ability to view other windows on the PC screen at the same time. Moreover, the width is 640 pixels, exactly like the Nokia Communicator's screen. But the height is 480 pixels in lieu of the Communicator's 200 pixels.

Once you have installed the WINS emulator on a PC, usually the WINS console layout is defined in the
C:\Symbian\6.0\NokiaCPP\Epoc32\Data folder. This is done in the epoc.ini file. The console image used is defined by the statements:

# screen size and location
ScreenWidth 640
ScreenHeight 200
ScreenOffsetX 137
ScreenOffsetY 62
fasciabitmap 9210Small.bmp


Now, you can change these values to fit the WINS v5 VGA console.

# screen size and location
ScreenWidth 640
ScreenHeight 480
ScreenOffsetX 87
ScreenOffsetY 48
fasciabitmap VGA9210.bmp


The first time we did it, we noted that some things in the Series 80 release 1 are hardcoded and some are softcoded. For instance the status bar to the left seems hardcoded, as the battery symbol etc does not move to the bottom. But the CBA to the right seems softcoded, so the buttons spread out over the available height. This requires some tweaking of the
epoc.ini file so as to fit the CBA button areas to their new locations. And the CBA buttons will need to be located correctly in the image, since they are literally "hardcoded" on a Communicator and not like the Toolbar of v5.0 vintage.

Furthermore, the "Psion 5mx-style" silkscreen buttons below the screen have to be replaced by the Series 80 application buttons. This requires pasting of the application button image and aligning the corresponding parameters in the
epoc.ini file to the new location.

And lastly, almost all the Symbian OS v5.0 machines, including the netPad, have silkscreen buttons to the left, which the Communicator does not have. Well, we masked them out, except for the top one [Menu], which we found practical to keep; it makes it easier to access the Menu than to hit F1. This also means that definition of a new virtual key is needed.

It all becomes a "hybrid" looking creation, but we find it very practical.



If anyone wish to do this, the console image file and the epoc.ini file are downloadable below. They should be put in
C:\Symbian\6.0\NokiaCPP\Epoc32\Data.

Remember to backup or rename the existing epoc.ini file before you replace it. At the end of your OPL development you will probably want to go back and test your application with a Nokia 9200 Series Communicator console.

Console image file:
VGA9210.bmp
Console settings file:
epoc.ini.

We have later discovered that what is described in this dpNote does not work for WINS for Series 80 release 2.
T
he UI of 9500 and 9300 appears differently coded.

dpNote 0011

3 Sep 2002

v6 Series 80 R1

Showing the amount of free memory

INCLUDE "System.oxh"
INCLUDE "Const.oph"

PROC MessageFreeMemory:
Message:("Free RAM: "+GEN$(FreeMemoryGet&:/1024/1024,12)+" MBytes")
ENDP

PROC Message:(aMsg$)
gIPRINT aMsg$,KBusyTopRight%
ENDP

PROC FreeMemoryGet&:
LOCAL TotalRam&,TotalRom&,MaxFreeRam&,FreeRam&
SyMemoryInfo:(TotalRam&,TotalRom&,MaxFreeRam&,FreeRam&)
RETURN FreeRam&
ENDP

dpNote 0012

4 Sep 2002

All OPL versions

Naming conventions

Conventions are used to make coding easier. The larger the program, the more sense they make. These are some of our naming conventions for constants, variable names, procedure names etc that we use. Adopt it or leave it. We have seen many other conventions from other developers which also make sense. Whichever convention you use, it is helpful.

Constants should commence with a capital 'K', e.g.
KMaxStringLen%. Some OPL documentations say that constants can only be used in OPL file headers and in OPH files. In fact, they can be used anywhere in the code outside a procedure as long as they are declared before they are used. Therefore, constants can be "local" to a procedure. Just make sure that their names do not clash with other constants.

Globals should commence with a capital 'G', e.g.
GScreenWidth%=gWIDTH. Using this convention helps you remember which variables should be declared with the EXTERNAL statment in procedures. It also helps you reducing the use of globals.

Variables passed by value should commence with an 'a' in the receiving procedure, e.g.

PROC LoadTextFileIntoBuffer&:(aFileName$)
LOCAL pBuffer&
// do it
RETURN pBuffer&
ENDP

could be called by pMyTextBuffer&=LoadTextFileIntoBuffer&:("MyTextFile.txt")

Variables passed by reference should commence with an '_' in the receiving procedure. In this procedure the complex number Y is passed by value and added into the complex number X which is passed by reference and later returned by reference.

PROC ComplexAdd:(_ReX&,_ImX&,aReY,aImY)
LOCAL ReX,ImX
// acquire values passed by reference
ReX=PEEKF(_ReX&)
:ImX=PEEKF(_ImX&)
// make complex number addition
ReX=ReX+aReY :ImX=ImX+aImY
// return values
POKEF _ReX&,ReX :POKEF _ImX&,ImX
ENDP

The procedure could be called by: ComplexAdd:(ADDR(ReZ),ADDR(ImZ),-2.7,4.3) , after which ReZ and ImZ will have the resulting value.

Boolean variables, i.e. variables that should only take the value KTrue% or KFalse% should end with a 'B', e.g. GCbaVisibleB%. In this case it is also a global variable. This is also recommended if a procedure can only return KTrue% or KFalse% e.g. TitleBarVisibleB%:.

Absolute Pointers should commence with a 'p', e.g. pStack&=ALLOC(KStackHeader%)

Relative Pointers (a.k.a. Offsets) should commence with an 'o', e.g. oJumpTable&

Handles, for instance when using IO operations, should commence with a 'h' as in
IOOPEN(hInfile%,aFileName$,IoMode%).

Window IDs, should end with 'WID', e.g.
TitleWID%=gCREATE(0,0,TitleWidth%,ScreenHeight%,KVisible%,K4KColourMode%)

Variables that are used for application and file UIDs should end with 'UID', e.g. ApplicationUID&

Other types of IDs, e.g. for handling of sprites, should end with ID, e.g.
SpriteID&=SpriteCreate&:(TitleWID%,KHiddenPosXY%,KHiddenPosXY%,KFalse%)

Labels that are called from GOTO and ONERR and the like should commence with 'LBL_', e.g. ONERR LBL_Cleanup::

Not only as a nod to object oriented programming, but also because makes it easier to navigate in large programs, it is better to name procedures and variables in "inverted language", meaning that you commence with the "class name", and then, if applicable, indicate the "sub class" and end with specifying your action. For instance, it makes it easier to name your clipboard handling procedure as ClipboardStringWrite:(aString$)rather than WriteStringToClipboard:(aString$). The former is easier to find, though of course the latter flows better as human language.

dpNote 0013

4 Sep 2002
(Modified 25 October 2004)

All OPL versions

Conversions between large Hexadecimal and Decimal numbers

The typical way to obtain a string with hexadecimal representation of a number is HEX$(&nnnnnnnn). This only works for hexadecimal numbers up to &ffffffff.

Converting to decimal representation of a hexadecimal number can be done via EVAL("&"+"nnnnnnnn"), but this method will only work up to &3fffffff since the EVAL function interpretes a the &nnnnnnnn expression as a signed hexadecimal number.

The following two procedures will work with up to 16 digits in decimal format and up to 13 digits in hexadecimal unsigned format. An additional advantage is that they both receive and return the numbers as strings.


Take note that, as the procedures are written here, they will not accept any impurities, e.g. strings with signs, points or exponents, so these elements will have to be cleared out beforehand.


PROC CvHexFromDec$:(aDecString$)
// safe to use for up to 13 significant hex digits
// and 16 significant dec digits
LOCAL HexString$(KMaxStringLen%)
LOCAL value,residue
// convert from lowest significant while shifting downwards
value=EVAL(aDecString$)
HexString$=""
DO
  value=value/16.0
  residue=(value-INTF(value))*16.0
  value=INTF(value)
  HexString$=HEX$(residue)+HexString$
UNTIL value=0
IF LEN(HexString$)>13
  RAISE KErrOverflow%
ENDIF
RETURN HexString$
ENDP

PROC CvDecFromHex$:(aHexString$)
// safe to use for up to 13 significant hex digits
// and 16 significant dec digits
LOCAL value,i%,len%
len%=LEN(aHexString$)
IF len%<=7
  // if HexString smaller than 8 digits a faster method can be used
  value=EVAL("&"+aHexString$)
ELSEIF len%<=13
  // convert one by one and shift upwards
  i%=len%
  value=0
  DO
    value=value*16.0+EVAL("$"+MID$(aHexString$,len%-i%+1,1))
    i%=i%-1
  UNTIL i%<1
ELSE
  RAISE KErrOverflow%
ENDIF
RETURN GEN$(value,16)
ENDP

dpNote 0014

12 Aug 2005

All OPL versions

Useful POKEs and PEEKs

Whereas memory shortage shouldn't be a problem with OPL applications, sometimes you might, for one reason or another, like to not use a full byte for storing one single boolean.

PROC PokeBoolean:(aPointer&,aBooleanB%)
// used to reduce space needed for a boolean value in a descriptor
// KTrue% will be stored as $ff and KFalse% will be stored as $00
POKEB aPointer&,(aBooleanB% AND $ff)
ENDP

PROC PeekBooleanB%:(aPointer&)
// used to PEEK a boolean value stored with PokeBoolean
RETURN NOT (PEEKB(aPointer%)=$00)
ENDP

PROC PeekBitB%:(aByte%,aBit%)
// tests a single bit if true or not
// bits are numbered from 0(LSB)..7(MSB)
RETURN (aByte%=($02**aBit%))
ENDP


PROC PokeBit:(_Byte&,aBit%,aStateB%)
// sets or unsets a bit between 0..7
LOCAL Byte%,ShiftedBit%
ShiftedBit%=$02**aBit%
Byte%=PeekWordLE&:(_Byte&)
// first make sure it's set regardless of desired state
Byte%=(Byte% OR ShiftedBit%)
// then invert it if it should be unset
IF NOT aStateB%
  Byte%=Xor&:(Byte%,ShiftedBit%) // ER5
  rem Byte%=SyXor&:(Byte%,ShiftedBit%) // ER6 and later
ENDIF
// return
PokeWordLE:(_Byte&,Byte%)
ENDP

dpNote 0015

30 April 2007

All OPL versions

Endianism

The following POKEs and PEEK are useful for the handling of Unicode characters, which, depending on the origin of the text file, can be stored either as big or little endian.

PROC PokeCharBE:(aPointer&,aChar16&)
// POKEs a 2 byte Unicode character as big endian
POKEB aPointer&,((aChar16& AND &ff00)/&0100)
POKEB (aPointer&+&1),(aChar16& AND &00ff)
ENDP

PROC PeekCharBE&:(aPointer&)
// PEEKs a 2 byte Unicode character as big endian
RETURN (PEEKB(aPointer&)*&0100) OR PEEKB(aPointer&+&1)
ENDP

PROC PokeCharLE:(aPointer&,aChar16&)
// POKEs a 2 byte Unicode character as little endian
POKEB aPointer&,(aChar16& AND &00ff)
POKEB (aPointer&+&1),((aChar16& AND &ff00)/&0100)
ENDP

PROC PeekCharLE&:(aPointer&)
// PEEKs a 2 byte Unicode character as little endian
RETURN PEEKB(aPointer&)OR (PEEKB(aPointer&+&1)*&0100)
ENDP

And finally this simple function converts Little to Big Endian and vice verse.

PROC CvEndianSwitch&:(aChar16&)
RETURN ((aChar16& AND &ff00)/&0100) OR ((aChar16& AND &00ff)*&0100)
ENDP

dpNote 0016

6 Sep 2004

v5 Eikon
Toolbar buttons with text only

The following code is a workaround for creating Toolbar buttons without a bitmap. If a bitmap is not declared when using Toolbar this causes empty boxes to be displayed on devices like Psion Series 5 and Psion netBook. The trick is to use an empty bitmap.

PROC BitMapZeroCreate&:
// Returns handle to empty bitmap to be used in TBarButt
LOCAL ZeroBM&
// clearer to go via variable, coz gCREATEBIT returns short int
ZeroBM&=gCREATEBIT(0,0)
RETURN ZeroBM&
ENDP

and then:

PROC main:
GLOBAL GZeroBM&
.
.
GZeroBM&=BitMapZeroCreate&:
.
.
// in toolbar initialisation routine
TBarButt:("a",1,"Welcome",0,GZeroBM&,GZeroBM&,0)
.
.
// in exit routine
gCLOSE GZeroBM&
dpNote 0017

15 March 2004
(updated 11 August 2004)

v5 (only Psion Teklogix netBook and Psion Series 7)

dpToolbar - a better Toolbar for Psion Teklogix netBook and Psion Series 7

dpToolbar is, what we hope, an improved Toolbar for the VGA colour screen Psions. It is meant to be used as an OPL programming tool. It adds the following features compared to the built in Toolbar:

1. Fix of the battery symbol bug - the battery symbol is now drawn, so no MBMs are needed.

2. Fix of the 6th button latch bug. In the orginal Toolbar, the 6th button does not latch properly. Now it does.

3. Ability to toggle the toolbar between left and right side of screen. In fact this feature was the original reason why we developed dpToolbar.

4. Fix of the undefined button selection bug - which previously could create hanging

5. Battery background turns red when its time to change backup battery. With the original Toolbar, nothing actually happens with the battery symbol when the backup battery needs to be replaced, even though one can see from the code that some action was intended. Now the background around the battery symbol turns red when the backup battery needs to be replaced.

6. When clicking on the battery symbol on the dpToolbar, the system battery window will instantly be brought to the foreground.

7. The battery is updated with higher precision than the original Toolbar, the latter only having four levels.

8. dpToolbar is now fully backwards compatible with the original Toolbar.

9. dpToolbar is now fully compatible with Andrew Gregory's Toolbar Patcher.

10. dpToolbar can now display Robin Hood's MoonClock. It will detect if MoonClock is installed, locate the mbm-file and display the phase of the moon based on the current date.

11. A small yellow arrow is now shown when external power is connected.

12. In the original Toolbar, only some actions will trigger a battery status update. Now all actions will.

dpToolbar battery status

  The main battery is full and the external power source is connected.

  The main battery is empty and there is no external power source.

  The main battery has been removed, but the external power source is connected.

  The main battery has been reinserted and is recharging from external power.

 The backup battery is empty or removed. Insert a fresh backup battery as soon as possible.

Location and use of dpToolbar files

dpToolbar comprises of two files.

1.
Toolbar.opo should be placed into X:System\Opl\, where X can be either C or D.

2.
Toolbar.oph should always be placed in X:System\Opl\, where X can be either C or D.

You must also modify the include statement in the application to:

INCLUDE "Toolbar.oph"

dpToolbar can now be used exactly like the original Toolbar. However to cover all options you should use the following routine to load dpToolbar:

CONST KPathAlternative1$="C:\System\Opl\Toolbar.opo"
CONST KPathAlternative2$="D:\System\Opl\Toolbar.opo"
CONST KPathAlternative3$="E:\System\Opl\Toolbar.opo"


IF EXIST(KPathAlternative1$)
  Message:("Loaded: "+KPathAlternative1$)
  LOADM KPathAlternative1$
ELSEIF EXIST(KPathAlternative2$)
  Message:("Loaded: "+KPathAlternative2$)
  LOADM KPathAlternative2$
ELSEIF EXIST(KPathAlternative3$)
  Message:("Loaded: "+KPathAlternative3$)
  LOADM KPathAlternative3$
ELSE
  Message:("Toolbar.opo not found","Error in loading","See instructions! ")
  PAUSE 40 :STOP
ENDIF
TBarLink:("Main")


OPXs

dpToolbar will also need to have Date.opx, System.opx, SysRam.opx and SystInfo.opx installed.

Public Procedures

The following is a list of public procedures of dpToolbar. There are some additions.

// Public procedures
EXTERNAL TBarLink:(aAppLink$)
EXTERNAL TBarInit:(aTitle$,aScreenW%,aScreenH%)
EXTERNAL TBarInitC:(aTitle$,aScreenW%,aScreenH%,aWindowMode%)
EXTERNAL TBarInitNonStd:(aName$,aScreenW%,aScreenH%,aWidth%)
EXTERNAL TBarSetTitle:(aName$)
EXTERNAL TBarButt:(aShortCut$,aPos%,aText$,aState%,aBitmap&,aMask&,aFlags%)
EXTERNAL TBarOfferB%:(aWID&,aPtrType&,aPtrX&,aPtrY&)
EXTERNAL TBarLatch:(aComponent%)
EXTERNAL TBarShow:
EXTERNAL TBarHide:
EXTERNAL TBarOrientationLeft:                     REM // added in dpToolbar
EXTERNAL TBarOrientationRight:
                   REM // added in dpToolbar
EXTERNAL TBarColour:(aFgR%,aFgG%,aFgB%,aBgR%,aBgG%,aBgB%)
EXTERNAL TBarIndicators:
                          REM // rewritten in dpToolbar
EXTERNAL TBarDpVersion$:
                          REM // added in dpToolbar

TBarOrientationLeft: will orient the Toolbar to the left side of the screen instead of the right. This is of importance for some work situations when the right hand is occupied or when the overall screen layout so demands it. Several of DP applications, for instance dpCalc, make use of this function.

TBarOrientationRight: will orient the Toolbar back to the right side of the screen.

TBarIndicators: will now update both the battery information and check the backup battery.

Public Variables

The following globals are available for the application:

TbWidth% holds the pixel width of the toolbar.

TbVisibleB% carries the value KTrue% if visible and otherwise KFalse%. Take note that according to DP coding norms, a boolean variable name ends with B%. This is a change compared to the original Toolbar.

TbRightB% has the value KTrue% if the Toolbar is right oriented and KFalse% if it is left oriented. This is a new variable.
TBarOrientationLeft: and TBarOrientationRight: will automatically set TbRightB% accordingly, so
TbRightB% should only be tested, not modified, by the application.

TbMenuSym% carries the current 'Show toolbar' menu symbol (to be OR:ed with shortcut letter). This has not been changed since the original Toolbar.

TbWID% holds the Toolbar Window ID. Take note of the name change. DP always uses WID% to denote a window ID variable.

Files and demo application

The files are downloadable here together with a simple demonstration application. Running the demo application, pressing Ctrl+T will toggle between left and right.

This is dpCalc with the Toolbar oriented to the left. The external power is OFF.



This is dpCalc with the Toolbar oriented to the right. The external power is ON:

dpNote 0018

20 Dec 2002

All OPL versions

Loading a complete file into a buffer

This procedure will load a complete file into a buffer, id est into memory, for further manipulation.

Usage:
pOutBuffer&=TextFileLoadIntoBuffer&:(Path$+FileName$)

The buffer is allocated, which means that it has to be cleaned up later.

INCLUDE "System.oxh"

CONST KIoReadWriteChunk&=&2000

PROC TextFileLoadIntoBuffer&:(aFileName$)
LOCAL pBuffer&,InFilesize&
LOCAL hInfile%,IoMode%,r%,IoReturn&
// allocate buffer according to file size
InFilesize&=SyFileSize&:(aFileName$)
Message:("Filesize: "+GEN$(InFilesize&,12))
pBuffer&=ALLOC(InFilesize&+KIoReadWriteChunk&) // give ample additional space
// load text file into the buffer
IoMode%=KIoModeOpen% OR KIoFormatBinary% OR KIoAccessRandom%
IOOPEN(hInfile%,aFileName$,IoMode%)
r%=0
DO
  IoReturn&=IOREAD(hInfile%,pBuffer&+r%*KIoReadWriteChunk&,KIoReadWriteChunk&)
  r%=r%+1
  BUSY GEN$(r%,6)
UNTIL IoReturn&<>KIoReadWriteChunk&
BUSY OFF
IOCLOSE(hInfile%)
RETURN pBuffer&
ENDP

PROC Message:(aMsg$)
gIPRINT aMsg$,KBusyTopRight%
ENDP

dpNote 0019

21 Dec 2002

v6 Series 80 R1

Converting long text buffers between Unicode and Ascii

These two procedures are useful when you have read a text file into a binary buffer, for instance using the routine described in dpNote 0018, and wish to covert it to either Unicode or Ascii format.

For conversion from Unicode to Ascii, the usage is:


CvUnicodeToAscii:(ADDR(pBuffer&),ADDR(BufferSize&))

For conversion from Ascii to Unicode, the usage is

CvAsciiToUnicode:(ADDR(pBuffer&),ADDR(BufferSize&))

The procedures require the Buffer.opx and the Convert.opx.

Also take note that a real program should have out of memory error handling.

INCLUDE "Buffer.oxh"
INCLUDE "Convert.oxh"
INCLUDE "Const.oph"

PROC CvUnicodeToAscii:(_pBuffer&,_BufferSize&)
// this routine converts Unicode text in a binary buffer apSource& to
// a buffer with the same text in Ascii. The size of the resulting
// buffer is half that of the original buffer
LOCAL SourceSize&,SourceLength&,pSource&,TargetSize&,TargetLength&,pTarget&
LOCAL ChunkLength&,pIn&,pOut&
// obtain BYREF values
pSource&=PEEKL(_pBuffer&)
SourceSize&=PEEKL(_BufferSize&)
// get size of source buffer and calculate length
// using LENALLOC(pSource&) will give word alignment error
SourceLength&=SourceSize&/KUnicodeFactor%
// the size of the target buffer is half of that of the source buffer
TargetLength&=SourceLength&
TargetSize&=TargetLength&
// allocate the target buffer
pTarget&=ALLOC(TargetSize&)
IF pTarget&=0 :RAISE KErrNoMemory% :ENDIF
// the Convert opx only allows conversion of 255 characters at a time
ChunkLength&=KMaxStringLen%
// initialise pointers
pIn&=pSource&
pOut&=pTarget&
// convert 255 characters at a time
WHILE (pIn&-pSource&)<=(SourceSize&-KMaxStringLen%*KUnicodeFactor%)
  CvFromUnicode:(pOut&,ChunkLength&,BufferAsString$:(pIn&,ChunkLength&))
  // the source buffer pointer is offset 2 times more than the target
  pIn&=pIn&+ChunkLength&*KUnicodeFactor%
  pOut&=pOut&+ChunkLength&
  // check if the pointer is closer than 255 chars to the end of buffer
ENDWH
// handle the remaining chunk
ChunkLength&=(SourceSize&-(pIn&-pSource&))/KUnicodeFactor%
CvFromUnicode:(pOut&,ChunkLength&,BufferAsString$:(pIn&,ChunkLength&))
// free up the source buffer
FREEALLOC pSource&
// return BYREF values passed by reference
POKEL _pBuffer&,pTarget&
POKEL _BufferSize&,TargetSize&
ENDP

PROC CvAsciiToUnicode:(_pBuffer&,_BufferSize&)
// this routine converts Ascii text in a buffer apSource& to
// a buffer with the same text in Unicode. The size of the resulting
// buffer is double that of the original buffer
// i.e. TargetSize&=aSourceSize&*KUnicodeFactor%
LOCAL SourceSize&,SourceLength&,pSource&,TargetSize&,TargetLength&,pTarget&
LOCAL ChunkLength&,pIn&,pOut&
// obtain BYREF values
pSource&=PEEKL(_pBuffer&)
SourceSize&=PEEKL(_BufferSize&)

// get size of source buffer and calculate length
SourceSize&=aSourceSize&
SourceLength&=aSourceSize&
// the size of the target buffer is double that of the source buffer
TargetLength&=SourceLength&
TargetSize&=TargetLength&*KUnicodeFactor%
// allocate the target buffer
pTarget&=ALLOC(TargetSize&)
IF pTarget&=0 :RAISE KErrNoMemory% :ENDIF
// the convert opx only allows to conversion of 255 characters at a time
ChunkLength&=KMaxStringLen%
// initialise pointers
pIn&=pSource&
pOut&=pTarget&
// convert 255 characters at a time
WHILE (pIn&-pSource&)<=(SourceSize&-KMaxStringLen%)
  BufferFromString&:(pOut&,ChunkLength&,CvUnicode$:(pIn&,ChunkLength&))
  // the target buffer pointer is offset 2 times more than the source
  pIn&=pIn&+ChunkLength&
  pOut&=pOut&+ChunkLength&*KUnicodeFactor%
  // check if the pointer is closer than 255 chars to the end of buffer
ENDWH
// handle the remaining chunk
ChunkLength&=(SourceSize&-(pIn&-pSource&))
BufferFromString&:(pOut&,ChunkLength&,CVUnicode$:(pIn&,ChunkLength&))
// free up the source buffer
FREEALLOC pSource&
// return values passed by reference
POKEL _pBuffer&,pTarget&

POKEL _BufferSize&,TargetSize&
ENDP

Convention: We always use the word 'length' or 'len' to refer to the length of a string in characters. We always use the word 'size' to refer to a the size of a string in bytes. In ER5 days, there was no apparent difference, so in the documentation of the Buffer.opx, which is unchanged in ER6 and later, sometimes the two terms are confused.

dpNote 0020

21 Dec 2002

v6 Series 80 R1

LOC function which gives correct answer for control and Unicode characters

The LOC(aString$,aChar$) function in OPL does not work correctly in v6/S80 for control and Unicode characters.

As a workaround, the following procedure can be used. It requires the Buffer OPX.

INCLUDE "Buffer.oxh"
INCLUDE "Const.oph"

PROC Loc%:(aString$,aChar$)
LOCAL String$(KMaxStringLen%),Location%
String$=aString$
Location%=BufferFind&:(ADDR(String$)+KUnicodeHeader%,LEN(String$),aChar$,0)+1
RETURN Location%
ENDP


Thanks to Kevin Millican for this idea.

dpNote 0021

21 Dec 2002

All OPL versions
Character conversions

In dpNote 0019, we are converting a text buffer between ASCII and Unicode using the Convert OPX. However, ER1-ER5 programmers do not have the benefit of this OPX. What if I for some reason wish to prepare a Unicode text file in a Psion for later transfer over to a Symbian phone or other Unicode device?

As second issue are those Psion specific characters that are defined between $06 and $10. Those are not part of Code Page 1252 and will not be converted if not handled specifically. Hence these conversion routines are important also for OPL programmers of ER6 and later. What if I want to be able to read Psion generated ASCII files on my Nokia 9500?


CONST KCvUnicodeCharNotUsed&=&001a
CONST KCvUnicodeCharNotAvailable&=&001a
CONST KCvAsciiCharNotUsed%=$1a
CONST KCvAsciiCharNotAvailable%=$1a
CONST KUnicodeFactor%=2

PROC CvCp1252ToUnicode:(_pBuffer&,_Size&)
// converts a buffer of 1 byte Code Page 1252 characters to a
// buffer of 2 bytes Unicode characters. The size of the resulting
// buffer is double that of the original buffer
// i.e. TargetSize&=aSourceSize&*KUnicodeFactor%
// assumes that the Unicode characters are stored as Little Endian
LOCAL pOut&,Size&,Offset&,Word&,Byte%,pIn&
// acquire BYREF values
pIn&=PEEKL(_pBuffer&)
Size&=PEEKL(_Size&)*KUnicodeFactor%
pOut&=ALLOC(Size&)
IF pOut&=0 :RAISE KErrNoMemory% :ENDIF
Offset&=0
DO
  Byte%=PEEKB(pIn&+Offset&/KUnicodeFactor%)
  // avoid jump for speed purposes
  IF Byte%>=$20 AND Byte%<=$7f
    Word&=Byte%
  ELSE
    Word&=CvAsciiCharToUnicode&:(Byte%)
  ENDIF
  // since POKEW interprets values >&8000 as negative we need to use
  // bytewise pokes, however we can avoid jump if possible for
  // speed purposes
  IF Word&<=&7fff
    POKEW (pOut&+Offset&),Word&
  ELSE
    PokeWordLE:((pOut&+Offset&),Word&)
  ENDIF
  Offset&=Offset&+KUnicodeFactor%
UNTIL Offset&>=Size&
// cleanup
FREEALLOC(pIn&)
// return BYREF values
POKEL _pBuffer&,pOut&
POKEL _Size&,Size&
ENDP

PROC CvUnicodeToCp1252:(_pBuffer&,_Size&)
// Converts a buffer of 2 bytes Unicode characters to a
// buffer of 1 byte Code Page 1252 characters
// assumes that the Unicode characters are stored as Little Endian
LOCAL pOut&,Size&,Offset&,Byte%,Word&,pIn&
// acquire BYREF values
Size&=PEEKL(_Size&)/KUnicodeFactor%
pIn&=PEEKL(_pBuffer&)
// allocate buffer - half the size of source buffer
pOut&=ALLOC(Size&)
IF pOut&=0 :RAISE KErrNoMemory% :ENDIF
Offset&=0
WHILE Offset&<Size&
  Word&=PeekWordLE&:(pIn&+Offset&*KUnicodeFactor%)
  // do fast conversion of common characters for speed purposes
  IF Word&>=&0020 AND Word&<=&007f
    Byte%=Word&
  ELSE
    Byte%=CvUnicodeCharToAscii%:(Word&)
  ENDIF
  POKEB (pOut&+Offset&),Byte%
  Offset&=Offset&+&0001
ENDWH
// cleanup
FREEALLOC(pIn&)
// return BYREF values
POKEL _pBuffer&,pOut&
POKEL _Size&,Size&
ENDP

PROC CvUnicodeToPsion:(_pBuffer&,_Size&)
// converts a buffer of 2 bytes Little Endian Unicode characters to
// a buffer of 1 byte Psion Code Page 1252 characters
//
// KNonBreakingTabER5%=$0a is not supported in Unicode
//
LOCAL pInStart&,pOutStart&,Size&,Offset&,Word&,Byte%
// aquire BYREF values
pInStart&=PEEKL(_pBuffer&)
Size&=PEEKL(_Size&)/KUnicodeFactor%
// prepare outbuffer
pOutStart&=ALLOC(Size&)
IF pOutStart&=0 :RAISE KErrNoMemory% :ENDIF
// convert
Offset&=0
WHILE Offset&<Size&
  Word&=PeekWordLE&:(pInStart&+Offset&*KUnicodeFactor%)
  // quick character convert for speed reasons
  IF Word&>=&0020 AND Word&<=&007f
    Byte%=Word&
  // Psion special characters start here
  ELSEIF Word&=KParagraphEnd& // $2029
    Byte%=KParagraphEndER5% // $06
  ELSEIF Word&=KLineBreak& // $2028
    Byte%=KLineBreakER5% // $07
  ELSEIF Word&=KPageBreak& // $000c
    Byte%=KPageBreakER5% // $08
  ELSEIF Word&=KTabCharacter& // $0009
    Byte%=KTabCharacterER5% // $09
  ELSEIF Word&=KNonBreakingHyphen& // $2011
    Byte%=KNonBreakingHyphenER5% // $0b
  ELSEIF Word&=KPotentialHyphen& // $00ad
    Byte%=KPotentialHyphenER5% // $0c
  ELSEIF Word&=KCarriageReturn& // &000d
    Byte%=KCarriageReturnER5% // $0d
  ELSEIF Word&=KPictureCharacter& // $fffc
    Byte%=KPictureCharacterER5% // $0e
  ELSEIF Word&=&2027 // Hyphenation point
    Byte%=KVisibleSpaceCharacterER5% // $0f
  ELSEIF Word&=KNonBreakingSpace& // $00a0
    Byte%=KNonBreakingSpaceER5% // $10
  // all other characters
  ELSE
    Byte%=CvUnicodeCharToAscii%:(Word&)
  ENDIF
  POKEB (pOutStart&+Offset&),Byte%
  Offset&=Offset&+&1
ENDWH
// cleanup
FREEALLOC(pInStart&)
// return BYREF values
POKEL _pBuffer&,pOutStart&
POKEL _Size&,Size&
ENDP

PROC CvPsionToUnicode:(_pBuffer&,_Size&)
// converts a buffer of 1 byte Psion Code Page 1252 characters to a
// buffer of 2 bytes Unicode characters
// assumes that the Unicode characters are stored as Little Endian
LOCAL pIn&,pInCurrent&,pInEnd&,pOut&,pOutCurrent&,Size&,Word&,Byte%,NextByte%
// aquire BYREF values
pIn&=PEEKL(_pBuffer&)
Size&=PEEKL(_Size&)
pInEnd&=pIn&+Size&
// prepare outbuffer
pOut&=ALLOC(Size&*KUnicodeFactor%)
IF pOut&=0 :RAISE KErrNoMemory% :ENDIF
// convert
pInCurrent&=pIn&
pOutCurrent&=pOut&
WHILE pInCurrent&<pInEnd&
  Byte%=PEEKB(pInCurrent&)
  // let's do this for speed reasons
  IF Byte%>=$20 AND Byte%<=$7f
    Word&=Byte%
  // special Psion characters
  ELSEIF ((Byte%>=$06) AND (Byte%<=$10))
    IF Byte%=KParagraphEndER5% // $06
      // handle the case when we have two $06 after each other
      IF ((pInCurrent&+&1)<(pIn&+Size&))
        NextByte%=PEEKB(pInCurrent&+&1)
      ELSE
        NextByte%=$00
      ENDIF
      IF NextByte%=KParagraphEndER5%
        Word&=KParagraphEnd& rem KCarriageReturnER5% // $000d
        PokeWordLE:(pOutCurrent&,Word&)
        pOutCurrent&=pOutCurrent&+KUnicodeFactor%
        Word&=KLineBreak& rem KLineFeed& // $000a
        PokeWordLE:(pOutCurrent&,Word&)
        pOutCurrent&=pOutCurrent&+KUnicodeFactor%
        pInCurrent&=pInCurrent&+&2
        CONTINUE
      ELSE
        Word&=KParagraphEnd& // $2029
      ENDIF
    ELSEIF Byte%=KLineBreakER5% // $07
      Word&=KLineBreak& // $2028
    ELSEIF Byte%=KPageBreakER5% // $08
      Word&=KPageBreak& // $000c
    ELSEIF Byte%=KTabCharacterER5% // $09
      Word&=KTabCharacter& // $0009
    ELSEIF Byte%=KNonBreakingTabER5% // $0a
      Word&=KTabCharacter& // $0009
    ELSEIF Byte%=KNonBreakingHyphenER5% // $0b
      Word&=KNonBreakingHyphen& // $2011
    ELSEIF Byte%=KPotentialHyphenER5% // $0c
      Word&=KPotentialHyphen& // $00ad
    ELSEIF Byte%=KCarriageReturnER5% // $0d
      Word&=KCarriageReturn& // &000d
    ELSEIF Byte%=KPictureCharacterER5% // $0e
      Word&=KPictureCharacter& // $fffc
    ELSEIF Byte%=KVisibleSpaceCharacterER5% // $0f
      Word&=&2027 // Hyphenation point
    ELSEIF Byte%=KNonBreakingSpaceER5% // $10
      Word&=KNonBreakingSpace& // $00a0
    ELSE
      Word&=KCvUnicodeCharNotAvailable&
    ENDIF
  ELSE
    Word&=CvAsciiCharToUnicode&:(Byte%)
  ENDIF
  // avoid jump if possible for speed purposes
  IF Word&<=&7fff
    POKEW pOutCurrent&,Word&
  ELSE
    PokeWordLE:(pOutCurrent&,Word&)
  ENDIF
  pInCurrent&=pInCurrent&+&1
  pOutCurrent&=pOutCurrent&+KUnicodeFactor%
ENDWH
// cleanup
FREEALLOC(pIn&)
// return BYREF values
POKEL _pBuffer&,pOut&
POKEL _Size&,(Size&*KUnicodeFactor%)
ENDP

PROC CvAsciiCharToUnicode&:(aAsciiChar%)
// this should be according to charset Code Page 1252 but we have not
// fully verified this. This can be done in a Unicode machine
IF aAsciiChar%<=$7f AND aAsciiChar%>=$00
  RETURN aAsciiChar%
ELSEIF aAsciiChar%=$ad // "­" (in)visible soft hyphen
  RETURN &00ad // soft hyphen
ELSEIF aAsciiChar%>=$a0 AND aAsciiChar%<=$ff
  RETURN aAsciiChar%
ELSEIF aAsciiChar%=$80 // "€" euro
  RETURN &20ac
ELSEIF aAsciiChar%=$81 // not used
  RETURN KCvUnicodeCharNotUsed&
ELSEIF aAsciiChar%=$82 // "," single low quotation mark
  RETURN &201a
ELSEIF aAsciiChar%=$83 // "ƒ" function f
  RETURN &0192
ELSEIF aAsciiChar%=$84 // "„" double comma
  RETURN &201e
ELSEIF aAsciiChar%=$85 // "…" horizontal ellipsis
  RETURN &2026
ELSEIF aAsciiChar%=$86 // "†" dagger, long cross
  RETURN &2020
ELSEIF aAsciiChar%=$87 // "‡" double dagger
  RETURN &2021
ELSEIF aAsciiChar%=$88 // "ˆ" modifier letter circumflex accent
  RETURN &02c6
ELSEIF aAsciiChar%=$89 // "‰" permille
  RETURN &2030
ELSEIF aAsciiChar%=$8a // "Š" latin capital letter s with caron
  RETURN &0160
ELSEIF aAsciiChar%=$8b // "‹" single left-pointing angle quotation mark
  RETURN &2039
ELSEIF aAsciiChar%=$8c // "Œ" latin capital ligature OE
  RETURN &0152
ELSEIF aAsciiChar%=$8d // not used
  RETURN KCvUnicodeCharNotUsed&
ELSEIF aAsciiChar%=$8e // "Ž" latin capital letter z with caron
  RETURN &017b
ELSEIF aAsciiChar%=$8f // not used
  RETURN KCvUnicodeCharNotUsed&
ELSEIF aAsciiChar%=$90 // not used
  RETURN KCvUnicodeCharNotUsed&
ELSEIF aAsciiChar%=$91 // "‘" left single quotation mark
  RETURN &2018
ELSEIF aAsciiChar%=$92 // "’" right single quotation mark
  RETURN &2019
ELSEIF aAsciiChar%=$93 // "“" left double quotation mark
  RETURN &201c
ELSEIF aAsciiChar%=$94 // "”" right double quotation mark
  RETURN &201d
ELSEIF aAsciiChar%=$95 // "•" bullet
  RETURN &2022
ELSEIF aAsciiChar%=$96 // "–" en dash
  RETURN &2013
ELSEIF aAsciiChar%=$97 // "—" horizontal bar
  RETURN &2015
ELSEIF aAsciiChar%=$98 // "˜" small tilde
  RETURN &02dc
ELSEIF aAsciiChar%=$99 // "™" trade mark sign
  RETURN &2122
ELSEIF aAsciiChar%=$9a // "š" latin small letter s with caron
  RETURN &0161
ELSEIF aAsciiChar%=$9b // "›" single right-pointing angle quotation mark
  RETURN &203a
ELSEIF aAsciiChar%=$9c // "œ" latin small ligature OE
  RETURN &0153
ELSEIF aAsciiChar%=$9d // not used
  RETURN KCvUnicodeCharNotUsed&
ELSEIF aAsciiChar%=$9e // "ž" latin small letter z with caron
  RETURN &017e
ELSEIF aAsciiChar%=$9f // "Ÿ" latin capital letter y with diaeresis
  RETURN &0178
ELSE
  RETURN KCvUnicodeCharNotUsed&
ENDIF
ENDP

PROC CvUnicodeCharToAscii%:(aUnicodeChar&)
// this should be according to Code Page 1252
IF aUnicodeChar&<=&007f AND aUnicodeChar&>=&0000
  RETURN aUnicodeChar&
ELSEIF aUnicodeChar&>=&00a0 AND aUnicodeChar&<=&00ff
  RETURN aUnicodeChar&
ELSEIF aUnicodeChar&=&0152 // "Œ" latin capital ligature OE
  RETURN $8c
ELSEIF aUnicodeChar&=&0153 // "œ" latin small ligature OE
  RETURN $9c
ELSEIF aUnicodeChar&=&0160 // "Š" latin capital letter s with caron
  RETURN $8a
ELSEIF aUnicodeChar&=&0161 // "š" latin small letter s with caron
  RETURN $9a
ELSEIF aUnicodeChar&=&0178 // "Ÿ" latin capital letter y with diaeresis
  RETURN $9f
ELSEIF aUnicodeChar&=&017b // "Ž" latin capital letter z with caron
  RETURN $8e
ELSEIF aUnicodeChar&=&017e // "ž" latin small letter z with caron
  RETURN $9e
ELSEIF aUnicodeChar&=&0192 // "ƒ" function f
  RETURN $83
ELSEIF aUnicodeChar&=&02c6 // "ˆ" modifier letter circumflex accent
  RETURN $88
ELSEIF aUnicodeChar&=&02dc // "˜" small tilde
  RETURN $98
ELSEIF aUnicodeChar&=&2013 // "–" en dash
  RETURN $96
ELSEIF aUnicodeChar&=&2015 // "—" horizontal bar
  RETURN $97
ELSEIF aUnicodeChar&=&2018 // "‘" left single quotation mark
  RETURN $91
ELSEIF aUnicodeChar&=&2019 // "’" right single quotation mark
  RETURN $92
ELSEIF aUnicodeChar&=&201a // "," single low quotation mark
  RETURN $82
ELSEIF aUnicodeChar&=&201c // "“" left double quotation mark
  RETURN $93
ELSEIF aUnicodeChar&=&201d // "”" right double quotation mark
  RETURN $94
ELSEIF aUnicodeChar&=&201e // "„" double comma
  RETURN $84
ELSEIF aUnicodeChar&=&2020 // "†" dagger, long cross
  RETURN $86
ELSEIF aUnicodeChar&=&2021 // "‡" double dagger
  RETURN $87
ELSEIF aUnicodeChar&=&2022 // "•" bullet
  RETURN $95
ELSEIF aUnicodeChar&=&2026 // "…" horizontal ellipsis
  RETURN $85
ELSEIF aUnicodeChar&=&2030 // "‰" permille
  RETURN $89
ELSEIF aUnicodeChar&=&2039 // "‹" single left-pointing angle quotation mark
  RETURN $8b
ELSEIF aUnicodeChar&=&203a // "›" single right-pointing angle quotation mark
  RETURN $9b
ELSEIF aUnicodeChar&=&20ac // "€" euro
  RETURN $80
ELSEIF aUnicodeChar&=&2122 // "™" trade mark sign
  RETURN $99
ELSE
  RETURN KCvAsciiCharNotAvailable%
ENDIF
ENDP

PROC CvCp1252ToPsion:(apText&,aTextSize&)
// used to convert a standard plain text as from MS WordPad to a Psion
// formatted plain text buffer
LOCAL pCurrent&,pEnd&,Char8%,NextChar8%
// initialise start values
pCurrent&=apText&
pEnd&=apText&+aTextSize&
// convert
WHILE pCurrent&<pEnd&
  Char8%=PEEKB(pCurrent&)
  IF Char8%>=$20 AND Char8%<=$7f
    GOTO LBL_Continue::
  ENDIF
  IF pCurrent&<(pEnd&-&1)
    NextChar8%=PEEKB(pCurrent&+&1)
  ELSE
    NextChar8%=KCarriageReturnER5%
  ENDIF
  IF (Char8%=KLineFeedER5%) AND (NextChar8%=KLineFeedER5%)
    POKEB pCurrent&,KParagraphEndER5%
    pCurrent&=pCurrent&+&1
    POKEB pCurrent&,KParagraphEndER5%
  ELSEIF (Char8%=KLineFeedER5%) AND (NextChar8%=KCarriageReturnER5%)
    POKEB pCurrent&,KParagraphEndER5%
    pCurrent&=pCurrent&+&1
    POKEB pCurrent&,KParagraphEndER5%
  ELSEIF (Char8%=KCarriageReturnER5%) AND (NextChar8%=KLineFeedER5%)
    POKEB pCurrent&,KParagraphEndER5%
    pCurrent&=pCurrent&+&1
    POKEB pCurrent&,KParagraphEndER5%
  ELSEIF Char8%=KCarriageReturnER5%
    POKEB pCurrent&,KLineBreakER5%
  ELSEIF Char8%=KLineFeedER5%
    POKEB pCurrent&,KParagraphEndER5%
  ELSEIF Char8%=KFormFeed%
    POKEB pCurrent&,KPageBreakER5%
  ELSEIF Char8%=KPotentialHyphen&
    POKEB pCurrent&,KPotentialHyphenER5%
  ELSEIF Char8%=KNonBreakingSpace&
    POKEB pCurrent&,KNonBreakingSpaceER5%
  ELSEIF Char8%=KVisibleSpaceCharacter&
    POKEB pCurrent&,$20 rem KVisibleSpaceCharacterER5%
  ELSE
    // do nothing
  ENDIF
  LBL_Continue::
  pCurrent&=pCurrent&+&1
ENDWH
ENDP

PROC CvPsionToCp1252:(apText&,aTextSize&)
// used to convert a Psion formatted plain text buffer to standard plain text
// which can be stored in a file and opened with MS WordPad or similar
LOCAL pCurrent&,pEnd&,Char8%,NextChar8%
// convert
pCurrent&=apText&
pEnd&=apText&+aTextSize&
NextChar8%=KCarriageReturnER5%
WHILE pCurrent&<pEnd&
  Char8%=PEEKB(pCurrent&)
  IF Char8%>=$20 AND Char8%<=$7f
    GOTO LBL_Continue::
  ENDIF
  IF pCurrent&<(pEnd&-&1)
    NextChar8%=PEEKB(pCurrent&+&1)
  ELSE
    NextChar8%=KCarriageReturnER5%
  ENDIF
  IF (Char8%=KParagraphEndER5%) AND (NextChar8%=KParagraphEndER5%)
    POKEB pCurrent&,KLineFeedER5%
    pCurrent&=pCurrent&+&1
    POKEB pCurrent&,KCarriageReturnER5%
  ELSEIF Char8%=KParagraphEndER5%
    POKEB pCurrent&,KLineFeedER5%
  ELSEIF Char8%=KLineBreakER5%
    POKEB pCurrent&,KCarriageReturnER5%
  ELSEIF Char8%=KPageBreakER5%
    POKEB pCurrent&,KFormFeed%
  ELSEIF Char8%=KNonBreakingTabER5%
    POKEB pCurrent&,KTabCharacterER5%
  ELSEIF Char8%=KNonBreakingHyphenER5%
    POKEB pCurrent&,$2d // minus sign
  ELSEIF Char8%=KPotentialHyphenER5%
    POKEB pCurrent&,KPotentialHyphen&
  ELSEIF Char8%=KNonBreakingSpaceER5%
    POKEB pCurrent&,KNonBreakingSpace&
  ELSEIF Char8%=KVisibleSpaceCharacterER5%
    POKEB pCurrent&,KVisibleSpaceCharacter&
  ELSEIF Char8%=KPictureCharacterER5%
    POKEB pCurrent&,$87 // double cross ‡
  ELSE
    // do nothing
  ENDIF
  LBL_Continue::
  pCurrent&=pCurrent&+&1
ENDWH
ENDP
dpNote 0022

8 April 2006

All OPL versions

Converting between Unicode and SCSU

You often read in Symbian documentation that from ER6 onwards (strictly speaking from ER5.1 or ER5u
onwards) text is stored in Unicode format. More precisely, you often see references to UTF-16, which is a Unicode representation where every code point is 2 byte, i.e. characters are represented by two bytes instead of one byte enabling native representation of non-ASCII languages such as Greek, Russian, Thai, Chinese and Arabic as well as a number of special characters.

But then when you wish to do some programming you realise that this is actually not the case!

From the outset, I suspected something to be amiss when some programmers reported that text copied into the Clipboard file on an ER6 or ER7 device appears to be in single byte ASCII format. But this could not be the case, since it is not possible to represent Unicode characters with ASCII.

A simple test can be done by opening Symbian Word in a Nokia 9210 or 9500 and copy a 2 byte Unicode character (i.e. "€" which in Unicode is represented by the 0x20AC code point) and then pasting it into another document. It is obvious that the clipboard can handle two byte characters. Hence the claim that the clipboard file stores text in ASCII format must simply be wrong, or at least not the whole story.

The following characters are included in Code Page 1252 on an ER5 device but have two byte representation in Unicode:

- The ellipsis "…" is stored as 0x85 in Code Page 1252, but as 0x2026 in Unicode.
- The Euro sign "€" is stored as 0x80 in Code Page 1252, but as 0x20AC in Unicode.
- The trademark sign "™" is stored as 0x99 in Code Page 1252, but as 0x2122 in Unicode.

Assume we copy the string "aaaa€aaaa" into a Sony Ericsson P900 clipboard. Then let's examine the clipboard file using a hex editor. If the string had been stored as pure UTF-16LE Unicode (i.e. 16 bit little endian representation) we would have expected:

0x61 00 61 00 61 00 61 00 AC 20 61 00 61 00 61 00 61 00.

If it had been stored as UTF-16BE (big endian) we would have expected:

0x00 61 00 61 00 61 00 61 20 AC 00 61 00 61 00 61 00 61.

But instead we get:

0x61 61 61 61 06 2C 61 61 61 61.

And for the string "€€€€€€€€
"

we get:

0x1C 41 AC AC AC AC AC AC AC AC AC

It appears that in isolation Euro sign is represented by 2 bytes, but the a:s are represented by 1 byte, thus saving space.

For a UFT-16 representation, we had expected Length&=9 and Size&=18. The size of a UTF-16 string should always be twice the length. Hence, for instance the new OPL keyword SIZE(aString$) will give twice the value of LEN(aString$). But in the second case, Length&=9 and Size&=10. In other words it's a quite significant memory saving.

When the Euro sign was repeated, there is another representation of the Euro sign allowing a Unicode character string of Length&=9 to be represented by a buffer of Size&=11.

Doing some further tests, it appears that ASCII characters, i.e. characters between 0x20 (space) and 0x7F (delete) are stored without modification as single byte characters (hence giving rise to the widely spread but erroneous assumption that Symbian clipboard file stores text in ASCII format). But strange things happen to all other characters.

The answer is the following: most native Symbian text stores makes use of something called Standard Compression Scheme for Unicode (SCSU). The SCSU is described in the Unicode technical standard #6. In fact, contrary to popular belief, Symbian does not store text in UTF-16 format, but in the SCSU format.

This means that if we are to faithfully handle text in OPL we will need an SCSU converter. Else, for instance, a clipboard handler in ER6 or ER7 will not work properly for non-ASCII characters. Studying Convert.opx in ER6 doesn't help, since it doesn't offer an SCSU converter.

One additional complication is that whereas Length& obviously doesn't change, the Size& of any text segment is entirely depending on what characters there are in the segment. If we look at the example above, if the string had been "aaaaaaaaa", the Length& and Size& after SCSU conversion should both be 9. When one double byte character was introduced, the Size&, predictably, increased by one. But when all a:s were replaced by double byte characters, the Size& only increased to 11, not to 18 as might have been predicted. In all cases the Length&, i.e. the actual number of characers in the string, remained the same.

After much studying of the SCSU standard and how to encode and decode SCSU, I came up with the following quite fast routines for handling SCSU in OPL. The two main procedures here are
CvUnicodeToScsu: and
CvScsuToUnicode:. Take note that Length& always has to be passed. Otherwise it is not known, since, as per the above, it cannot be calculated from Size& nor vice verse.

// SCSU constants
CONST KScsu_SQ0%=$01 // Quote Static Window 0 (non-Locking)
CONST KScsu_SQ1%=$02 // Quote Static Window 1 (non-Locking)
CONST KScsu_SQ2%=$03 // Quote Static Window 2 (non-Locking)
CONST KScsu_SQ3%=$04 // Quote Static Window 3 (non-Locking)
CONST KScsu_SQ4%=$05 // Quote Static Window 4 (non-Locking)
CONST KScsu_SQ5%=$06 // Quote Static Window 5 (non-Locking)
CONST KScsu_SQ6%=$07 // Quote Static Window 6 (non-Locking)
CONST KScsu_SQ7%=$08 // Quote Static Window 7 (non-Locking)
CONST KScsu_SDX%=$0b // Define Extended Window
CONST KScsu_SR%=$0c // Reserved for future use
CONST KScsu_SQU%=$0e // Quote Unicode (non-Locking)
CONST KScsu_SCU%=$0f // Change to Unicode (Locking)
CONST KScsu_SC0%=$10 // Shift to Dynamic Window 0 (Locking)
CONST KScsu_SC1%=$11 // Shift to Dynamic Window 1 (Locking)
CONST KScsu_SC2%=$12 // Shift to Dynamic Window 2 (Locking)
CONST KScsu_SC3%=$13 // Shift to Dynamic Window 3 (Locking)
CONST KScsu_SC4%=$14 // Shift to Dynamic Window 4 (Locking)
CONST KScsu_SC5%=$15 // Shift to Dynamic Window 5 (Locking)
CONST KScsu_SC6%=$16 // Shift to Dynamic Window 6 (Locking)
CONST KScsu_SC7%=$17 // Shift to Dynamic Window 7 (Locking)
CONST KScsu_SD0%=$18 // Define Dynamic Window 0 (Locking)
CONST KScsu_SD1%=$19 // Define Dynamic Window 1 (Locking)
CONST KScsu_SD2%=$1a // Define Dynamic Window 2 (Locking)
CONST KScsu_SD3%=$1b // Define Dynamic Window 3 (Locking)
CONST KScsu_SD4%=$1c // Define Dynamic Window 4 (Locking)
CONST KScsu_SD5%=$1d // Define Dynamic Window 5 (Locking)
CONST KScsu_SD6%=$1e // Define Dynamic Window 6 (Locking)
CONST KScsu_SD7%=$1f // Define Dynamic Window 7 (Locking)
CONST KScsu_UC0&=&e000 // Shift to Dynamic Window 0 (Locking)
CONST KScsu_UC1&=&e100 // Shift to Dynamic Window 1 (Locking)
CONST KScsu_UC2&=&e200 // Shift to Dynamic Window 2 (Locking)
CONST KScsu_UC3&=&e300 // Shift to Dynamic Window 3 (Locking)
CONST KScsu_UC4&=&e400 // Shift to Dynamic Window 4 (Locking)
CONST KScsu_UC5&=&e500 // Shift to Dynamic Window 5 (Locking)
CONST KScsu_UC6&=&e600 // Shift to Dynamic Window 6 (Locking)
CONST KScsu_UC7&=&e700 // Shift to Dynamic Window 7 (Locking)
CONST KScsu_UD0&=&e800 // Define & Change to Dynamic Window 0 (Locking)
CONST KScsu_UD1&=&e900 // Define & Change to Dynamic Window 1 (Locking)
CONST KScsu_UD2&=&ea00 // Define & Change to Dynamic Window 2 (Locking)
CONST KScsu_UD3&=&eb00 // Define & Change to Dynamic Window 3 (Locking)
CONST KScsu_UD4&=&ec00 // Define & Change to Dynamic Window 4 (Locking)
CONST KScsu_UD5&=&ed00 // Define & Change to Dynamic Window 5 (Locking)
CONST KScsu_UD6&=&ee00 // Define & Change to Dynamic Window 6 (Locking)
CONST KScsu_UD7&=&ef00 // Define & Change to Dynamic Window 7 (Locking)
CONST KScsu_UQU&=&f000 // Quote Unicode character (non-locking)
CONST KScsu_UDX&=&f100 // Define extended window
CONST KScsu_UR&=&f200 // Reserved for future use
// static window offsets
CONST KScsuStaticWindow0&=&0000 // For quoting of tags used in single-byte mode
CONST KScsuStaticWindow1&=&0080 // Latin-1 Supplement
CONST KScsuStaticWindow2&=&0200 // Latin Extended-A
CONST KScsuStaticWindow3&=&0300 // Combining Diacritical Marks
CONST KScsuStaticWindow4&=&2000 // General Punctuation
CONST KScsuStaticWindow5&=&2080 // Currency Symbols
CONST KScsuStaticWindow6&=&2100 // Letterlike Symbols and Number Forms
CONST KScsuStaticWindow7&=&3000 // CJK Symbols and Punctuation
// dynamic window default offsets
CONST KScsuDynamicWindow0&=&0080 // Latin-1 Supplement
CONST KScsuDynamicWindow1&=&00c0 // Combined partial Latin-1 Supplement/LatinExtended-A
CONST KScsuDynamicWindow2&=&0400 // Cyrillic
CONST KScsuDynamicWindow3&=&0600 // Arabic
CONST KScsuDynamicWindow4&=&0900 // Devanagari
CONST KScsuDynamicWindow5&=&3040 // Hiragana
CONST KScsuDynamicWindow6&=&30a0 // Katakana
CONST KScsuDynamicWindow7&=&ff00 // Fullwidth Ascii
// dynamic window alternative offsets Set by SDn
CONST KScsuDynamicWindowLatin1x&=&00c0 // $f9
CONST KScsuDynamicWindowIpaExt&=&0250 // $fa
CONST KScsuDynamicWindowGreek&=&0370 // $fb
CONST KScsuDynamicWindowArmenian&=&0530 // $fc
CONST KScsuDynamicWindowHiragana&=&3040 // $fd
CONST KScsuDynamicWindowKatakana&=&30a0 // $fe
CONST KScsuDynamicWindowHalfKatakana&=&ff60 // $ff
CONST KScsuDynamicWindowLowOffset&=&0000 // used for $00..$67 (< &3400)
CONST KScsuDynamicWindowHighOffset&=&ac00 // used for $68..$A7 (>= &e000)

PROC CvUnicodeToScsu:(_pText&,aTextLen&,_OutSize&)
// encodes SCSU from Unicode
// Usage: CvUnicodeToScsu:(ADDR(pText&),TextLen&,ADDR(TextSize&))
LOCAL pInStart&,pIn&,pInEnd&,pOutStart&,pOut&,pOutEnd&,OutSize&
LOCAL Char8%,Char16&,NextChar16&,WindowLower&,NextNextChar16&
LOCAL StaticWindowOffset&(8),DynamicWindowOffset&(8),Youth&(8)
LOCAL SingleQuoteWindowN%,DynamicWindowN%,UnicodeModeB%
LOCAL WindowFittedN%,IndexByte%
// Initialise default states
UnicodeModeB%=KFalse%
DynamicWindowN%=0
SingleQuoteWindowN%=0
// set the initially oldest window to Devanagari
Youth&(0+1)=3 // Latin-1 Supplement
Youth&(1+1)=2 // Combined partial Latin-1 Supplement/Latin Extended-A
Youth&(2+1)=1 // Cyrillic
Youth&(3+1)=1 // Arabic
Youth&(4+1)=0 // Devanagari
Youth&(5+1)=1 // Hiragana
Youth&(6+1)=1 // Katakana
Youth&(7+1)=2 // Fullwidth Ascii
// Initialise static window offsets (will never be changed)
CvScsuStaticWindowInitialise:(ADDR(StaticWindowOffset&()))
// Initialise default dynamic window offsets
CvScsuDynamicWindowInitialise:(ADDR(DynamicWindowOffset&()))
// in this operation the OutSize& will normally be smaller than 2*TextLen&
// but it's not absolutely certain.
OutSize&=aTextLen&*KUnicodeFactor%
pOut&=ALLOC(OutSize&*3/2) // give a little more just in case
IF pOut&=0 :RAISE KErrNoMemory% :ENDIF
// set up the pointers we need
// pInStart& points to the start of the text before encoding
// pIn& points to the current position in the text read from
// pInEnd& points to the first byte after the text before encoding
// pOutStart& points to the start of the encoded text
// pOut& points to the current position in the text to write to
pInStart&=PEEKL(_pText&)
pIn&=pInStart&
pInEnd&=pInStart&+aTextLen&*KUnicodeFactor%
pOutStart&=pOut&
// go char for char
WHILE pIn&<pInEnd&
  // read Unicode little endian
  Char16&=PeekWordLE&:(pIn&) :pIn&=pIn&+&2
  IF pIn&<(pInEnd&-&1)
    NextChar16&=PeekWordLE&:(pIn&)
  ELSE
    NextChar16&=&0000
  ENDIF
  IF UnicodeModeB%
    GOTO LBL_UnicodeMode::
  ENDIF
  //
  // single mode
  //
  // if Char is part of static window 0 output StaticByte
  IF (Char16&>=&0020 AND Char16&<=&007f)
    // Ascii codes
    // store directly in outbuffer
    Char8%=Char16&
    POKEB pOut&,Char8% :pOut&=pOut&+&1
    // ---- 2 inbytes, 1 outbyte
    OutSize&=OutSize&-&1
    CONTINUE
  ENDIF
  // if Char is any of the common Ascii control characters output StaticByte
  IF Char16&=&0000 OR Char16&=&0009 OR Char16&=&000a OR Char16&=&000d
    // Ascii ctrl codes
    // store directly in outbuffer
    Char8%=Char16&
    POKEB pOut&,Char8% :pOut&=pOut&+&1
    // ---- 2 inbytes, 1 outbyte
    OutSize&=OutSize&-&1
    CONTINUE
  ENDIF
  // if Char is another Ascii control character output SQ0 then StaticByte
  // this is when Char conflicts with SCSU commands
  IF Char16&<=&001f
    Char8%=Char16&
    POKEB pOut&,KScsu_SQ0% :pOut&=pOut&+&1
    POKEB pOut&,Char8% :pOut&=pOut&+&1
    // ---- 2 inbytes, 2 outbytes
    rem OutSize&=OutSize&
    CONTINUE
  ENDIF
  // if Char is compressible
  IF CvScsuCompressibleB%:(Char16&)
    // if Char fits into the active dynamic window, output DynamicByte
    WindowLower&=DynamicWindowOffset&(DynamicWindowN%+1)
    IF (Char16&>=WindowLower&) AND (Char16&<(WindowLower&+&80))
      Youth&(DynamicWindowN%+1)=Youth&(DynamicWindowN%+1)+&1
      Char8%=Char16&-WindowLower&+&80
      POKEB pOut&,Char8% :pOut&=pOut&+&1
      // ---- 2 inbytes, 1 outbyte
      OutSize&=OutSize&-&1
      CONTINUE
    ENDIF
    // if Char fits into any currently defined dynamic window check the next
    // character NextChar
    WindowFittedN%=CvScsuWindowFitN%:(ADDR(DynamicWindowOffset&()),Char16&)
    IF WindowFittedN%<>$ff
      // if NextChar fits the active dynamic window, output SQn tag for the
      // window that Char fits into followed by DynamicByte
      IF NOT CvScsuCompressibleB%:(NextChar16&)
        GOTO LBL_NoNextChar::
      ENDIF
      IF (NextChar16&>=WindowLower&) AND (NextChar16&<(WindowLower&+&80))
        WindowLower&=DynamicWindowOffset&(WindowFittedN%+1)
        POKEB pOut&,(KScsu_SQ0%+WindowFittedN%): pOut&=pOut&+&1
        POKEB pOut&,(Char16&-WindowLower&+&80) :pOut&=pOut&+&1
        // ---- 2 inbytes, 2 outbytes
        rem OutSize&=OutSize&
        CONTINUE
      // change window with SCn, update window offset lower and
      // change the dynamic window accordingly, then output DynamicByte
      ELSE
        LBL_NoNextChar::
        DynamicWindowN%=WindowFittedN%
        WindowLower&=DynamicWindowOffset&(WindowFittedN%+1)
        Youth&(DynamicWindowN%+1)=Youth&(DynamicWindowN%+1)+&1
        POKEB pOut&,(KScsu_SC0%+WindowFittedN%): pOut&=pOut&+&1
        POKEB pOut&,(Char16&-WindowLower&+&80) :pOut&=pOut&+&1
        // ---- 2 inbytes, 2 outbytes
        rem OutSize&=OutSize&
        CONTINUE
      ENDIF
    ENDIF
    // if Char is in the BMP (basic multilingual plane)
    IF CvScsuBasicMultilingualPlaneB%:(Char16&)
      // if Char fits into a static window, output SQn for that window followed
      // by StaticByte, however if NextChar fits into same static window
      // create a dynamic window based on this static window and change to this
      // dynamic window - this has been added for the purpose of handling several
      // consecutive page & line breaks $2028, $2029
      WindowFittedN%=CvScsuWindowFitN%:(ADDR(StaticWindowOffset&()),Char16&)
      IF WindowFittedN%<>$ff
        // check if NextChar is in the same window
        IF (Char16& AND &0000ff80)=(NextChar16& AND &0000ff80)
          // check if NextNextChar18& is in the same window
          IF (pIn&+&2)<(pInEnd&-&1)
            NextNextChar16&=PeekWordLE&:(pIn&+&2)
          ELSE
            NextNextChar16&=&0000
          ENDIF
          IF (NextNextChar16& AND &0000ff80)=(NextChar16& AND &0000ff80)
            // select the oldest dynamic window as new window
            DynamicWindowN%=CvScsuWindowOldestN%:(ADDR(Youth&()))
            Youth&(DynamicWindowN%+1)=2
            DynamicWindowOffset&(DynamicWindowN%+1)=StaticWindowOffset&(WindowFittedN%+1)
            WindowLower&=DynamicWindowOffset&(DynamicWindowN%+1)
            // calculate the index
            IF Char16&<&3400
              IndexByte%=Char16&/&80
            ELSE rem Char16&>=&e000
              IndexByte%=(Char16&-&ac00)/&80
            ENDIF
            Char8%=Char16&-WindowLower&+&80
            // set this dynamic window as the active window
            POKEB pOut&,(KScsu_SD0%+DynamicWindowN%) :pOut&=pOut&+&1
            POKEB pOut&,IndexByte% :pOut&=pOut&+&1
            POKEB pOut&,Char8% :pOut&=pOut&+&1
            // ---- 2 inbytes, 3 outbytes
            OutSize&=OutSize&+1
            CONTINUE
          ELSE
            GOTO LBL_NoSDRequired::
          ENDIF
        ELSE
          LBL_NoSDRequired::
          POKEB pOut&,(KScsu_SQ0%+WindowFittedN%) :pOut&=pOut&+&1
          POKEB pOut&,(Char16&-StaticWindowOffset&(WindowFittedN%+1)) :pOut&=pOut&+&1
          // ---- 2 inbytes, 2 outbytes
          rem OutSize&=OutSize&
          CONTINUE
        ENDIF
        // otherwise output an SDn tag for a new dynamic window in the BMP
        // followed by DynamicByte
      ELSE
        IF Char16&<&3400
          IndexByte%=Char16&/&80
          WindowLower&=IndexByte%*&80
        ELSE rem Char16&>=&e000
          IndexByte%=(Char16&-&ac00)/&80
          WindowLower&=IndexByte%*&80+&ac00
        ENDIF
        Char8%=Char16&-WindowLower&+&80
        // select the oldest dynamic window as new window
        DynamicWindowN%=CvScsuWindowOldestN%:(ADDR(Youth&()))
        Youth&(DynamicWindowN%+1)=2
        // define the selected window as a new active window
        DynamicWindowOffset&(DynamicWindowN%+1)=WindowLower&
        POKEB pOut&,(KScsu_SD0%+DynamicWindowN%) :pOut&=pOut&+&1
        POKEB pOut&,IndexByte% :pOut&=pOut&+&1
        POKEB pOut&,Char8% :pOut&=pOut&+&1
        // ---- 2 inbytes, 3 outbytes
        OutSize&=OutSize&+1
        CONTINUE
      ENDIF
    // otherwise, if Char is not in BMP, output an SDX for a new dynamic
    // window in the supplimentary code space
    ELSE
      IF Char16&>&0010ffff
        RAISE KErrOverflow%
      ENDIF
      // calculate window
      IndexByte%=(Char16&-&00010000)/&80
      WindowLower&=IndexByte%*&80+&00010000
      Char8%=Char16&-WindowLower&+&80
      // select the oldest dynamic window as new window. since
      DynamicWindowN%=CvScsuWindowOldestN%:(ADDR(Youth&()))
      Youth&(DynamicWindowN%+1)=2
      // define the window selected
      DynamicWindowOffset&(DynamicWindowN%+1)=WindowLower&
      // format is 'nnnb bbbb bbbb bbbb' in bits
      Char16&=DynamicWindowN%*&2000+IndexByte%
      // pokes
      POKEB pOut&,KScsu_SDX% :pOut&=pOut&+&1
      PokeWordBE:(pOut&,Char16&) :pOut&=pOut&+&2
      POKEB pOut&,Char8% :pOut&=pOut&+&1
      // ---- 2 inbytes, 4 outbyte
      OutSize&=OutSize&+&2
      CONTINUE
    ENDIF
  // these are cases when Char is not compressible
  ELSE
    // if Char is in BMP and NextChar is compressible, output an SQU tag
    // followed by Char16
    IF CvScsuBasicMultilingualPlaneB%:(Char16&) AND CvScsuCompressibleB%:(NextChar16&)
      POKEB pOut&,KScsu_SQU% :pOut&=pOut&+&1
      PokeWordBE:(pOut&,Char16&) :pOut&=pOut&+&2
      // ---- 2 inbytes, 3 outbytes
      OutSize&=OutSize&+&1
      CONTINUE
      // otherwise output an SCU tag (switching to Unicode) followed by Char16
    ELSE
      UnicodeModeB%=KTrue%
      POKEB pOut&,KScsu_SCU% :pOut&=pOut&+&1
      PokeWordBE:(pOut&,Char16&) :pOut&=pOut&+2
      // ---- 2 inbytes, 3 outbytes
      OutSize&=OutSize&+&1
      CONTINUE
    ENDIF
  ENDIF
  //
  // Unicode mode
  //
  LBL_UnicodeMode::
  // if Char is compressible and NextChar is also compressible
  IF CvScsuCompressibleB%:(Char16&) AND CvScsuCompressibleB%:(NextChar16&)
    // handle the case when Char is in Ascii range
    IF (Char16&>=&0020) AND (Char16&<=&007f)
      Char8%=Char16&
      POKEB pOut&,(KScsu_UC0&/&0100+DynamicWindowN%) :pOut&=pOut&+&1
      POKEB pOut&,Char8% :pOut&=pOut&+&1
      // leave Unicode mode
      UnicodeModeB%=KFalse%
      // ---- 2 inbytes, 2 outbytes
      rem OutSize&=OutSize&
      CONTINUE
    ENDIF
    IF Char16&=&0000 OR Char16&=&000a OR Char16&=&000d OR Char16&=&0009
      Char8%=Char16&
      POKEB pOut&,(KScsu_UC0&/&0100+DynamicWindowN%) :pOut&=pOut&+&1
      POKEB pOut&,Char8% :pOut&=pOut&+&1
      // leave Unicode mode
      UnicodeModeB%=KFalse%
      // ---- 2 inbytes, 2 outbytes
      rem OutSize&=OutSize&
      CONTINUE
    ENDIF
    IF Char16&<&0020
      // these are possible conflict characters, let's use UQU
      Char8%=Char16&
      POKEB pOut&,KScsu_UQU&/&0100 :pOut&=pOut&+&1
      POKEB pOut&,$00 :pOut&=pOut&+&1
      POKEB pOut&,Char8% :pOut&=pOut&+&1
      // ---- 2 inbytes, 3 outbytes
      OutSize&=OutSize&+&1
      CONTINUE
    ENDIF
    // if Char fits in any currenty defined dynamic window, output UCn tag for
    // that window followed by DynamicByte
    WindowFittedN%=CvScsuWindowFitN%:(ADDR(DynamicWindowOffset&()),Char16&)
    IF WindowFittedN%<>$ff
      DynamicWindowN%=WindowFittedN%
      WindowLower&=DynamicWindowOffset&(DynamicWindowN%+1)
      Youth&(DynamicWindowN%+1)=Youth&(DynamicWindowN%+1)+1
      POKEB pOut&,(KScsu_UC0&/&0100+DynamicWindowN%) :pOut&=pOut&+&1
      POKEB pOut&,(Char16&-WindowLower&+&80) :pOut&=pOut&+&1
      // leave Unicode mode
      UnicodeModeB%=KFalse%
      // ---- 2 inbytes, 2 outbytes
      rem OutSize&=OutSize&
      CONTINUE
    ENDIF
    // otherwise, if Char is in the BMP, output UDn tag (with parameter) for
    // a new dynamic window in the BMP followed by DynamicBute
    IF CvScsuBasicMultilingualPlaneB%:(Char16&)
      IF Char16&<&3400
        IndexByte%=Char16&/&80
        WindowLower&=IndexByte%*&80
      ELSE rem Char16&>=&e000
        IndexByte%=(Char16&-&ac00)/&80
        WindowLower&=IndexByte%*&80+&ac00
      ENDIF
      // select the oldest dynamic window for redefinition
      DynamicWindowN%=CvScsuWindowOldestN%:(ADDR(Youth&()))
      Youth&(DynamicWindowN%+1)=2
      DynamicWindowOffset&(DynamicWindowN%+1)=WindowLower&
      POKEB pOut&,(KScsu_UD0&/&0100+DynamicWindowN%) :pOut&=pOut&+&1
      POKEB pOut&,IndexByte% :pOut&=pOut&+&1
      POKEB pOut&,(Char16&-WindowLower&+&80) :pOut&=pOut&+&1
      // leave Unicode mode
      UnicodeModeB%=KFalse%
      // ---- 2 inbytes, 3 outbytes
      OutSize&=OutSize&+1
      CONTINUE
    // otherwise, output a UDX tag (with parameter) for a new dynamic window
    // in supplementary code space followed by DynamicByte
    ELSE
      IF Char16&>&0010ffff
        RAISE KErrOverflow%
      ENDIF
      // calculate window
      IndexByte%=(Char16&-&00010000)/&80
      WindowLower&=IndexByte%*&80+&00010000
      Char8%=Char16&-WindowLower&+&80
      // select the oldest dynamic window for redefinition
      DynamicWindowN%=CvScsuWindowOldestN%:(ADDR(Youth&()))
      Youth&(DynamicWindowN%+1)=2
      DynamicWindowOffset&(DynamicWindowN%+1)=WindowLower&
      // format is 'nnnb bbbb bbbb bbbb' in bits
      Char16&=DynamicWindowN%*&2000+IndexByte%
      // pokes
      POKEB pOut&,KScsu_UDX&/&0100 :pOut&=pOut&+&1
      PokeWordLE:(pOut&,Char16&) :pOut&=pOut&+&2
      POKEB pOut&,Char8% :pOut&=pOut&+&1
      // leave Unicode mode
      UnicodeModeB%=KFalse%
      // ---- 2 inbytes, 4 outbyte
      OutSize&=OutSize&+&2
      CONTINUE
    ENDIF
  // Char and NextChar are not both compressibles
  ELSE
    // if the most signficant 8 bits of Char conflict with a tag or reserved
    // value in Scsu Unicode mode, output a UQU tag
    IF CvScsuUnicodeTagConflictB%:(Char16&)
      POKEB:(pOut&,KScsu_UQU&/&0100) :pOut&=pOut&+1
      PokeWordBE:(pOut&,Char16&) :pOut&=pOut&+2
      // ---- 2 inbytes, 3 outbyte
      OutSize&=OutSize&+&1
    // else output Char in UTF-16BE and stay in Unicode mode
    ELSE
      PokeWordBE:(pOut&,Char16&) :pOut&=pOut&+2
      // ---- 2 inbytes, 2 outbyte
      rem OutSize&=OutSize&
    ENDIF
  ENDIF
ENDWH
// adjust size of outbuffer, since it may have been reduced
pOutStart&=REALLOC(pOutStart&,OutSize&)
// the outbuffer has now replaced the inbuffer
FREEALLOC(pInStart&)
// return BYREF values
POKEL _pText&,pOutStart&
POKEL _OutSize&,OutSize&
ENDP

PROC CvScsuUnicodeTagConflictB%:(aChar16&)
IF ((aChar16& AND &ff00)>=(KScsu_UC0& AND &ff00))
  IF ((aChar16& AND &ff00)<=(KScsu_UR& AND &ff00))
    RETURN KTrue%
  ENDIF
ENDIF
RETURN KFalse%
ENDP

PROC CvScsuBasicMultilingualPlaneB%:(aChar&)
  RETURN ((aChar&>=&0000) AND (aChar&<=&ffff))
ENDP

PROC CvScsuWindowOldestN%:(_Youth&)
// returns the oldest dynamic window
// Usage:
// OldestDynamicWindowN%=CvScsuWindowOldestN%:(ADDR(Youth&()))
LOCAL OldestN%,n%,OldestAge&,Youth&
OldestN%=7
n%=OldestN%
OldestAge&=KMaxLong&
WHILE n%>=0
  Youth&=PEEKL(_Youth&+n%*KLongSize&)
  IF Youth&<OldestAge&
    OldestN%=n%
    OldestAge&=Youth&
  ENDIF
  n%=n%-1
ENDWH
RETURN OldestN%
ENDP

PROC CvScsuWindowFitB%:(_WindowOffset&,aChar16&)
// checks if aChar16& is in any of the currenly active windows
RETURN (CvScsuWindowFitN%:(_WindowOffset&,aChar16&)<>$ff)
ENDP

PROC CvScsuWindowFitN%:(_WindowOffset&,aChar16&)
// returns the number of the active window which aChar16& fits into and
// returns $ff if it doesn't fit into any active window
// usage:
// WindowN%=CvScsuWindowFitN%:(ADDR(ActiveWindowOffset&()),Char16&)
LOCAL i%,Lower&,Upper&
// returned value between $00..$07 or $ff for not found
i%=$00
WHILE i%<=$07
  Lower&=PEEKL(_WindowOffset&+i%*KLongSize&)
  Upper&=Lower&+&80
  IF aChar16&>=Lower& AND aChar16&<Upper&
    RETURN i%
  ENDIF
  i%=i%+1
ENDWH
RETURN $ff
ENDP

PROC CvScsuCompressibleB%:(aChar16&)
RETURN ((aChar16&<&3400) OR (aChar16&>=&e000))
ENDP

PROC CvScsuToUnicode:(_pText&,aTextLen&,_TextSize&)
// decodes SCSU (Standard Compression Scheme for Unicode) format to Unicode
//
// Usage: CvScsuToUnicode:(ADDR(pText&),TextLen&,ADDR(TextSize&))
// pText& pointer to text buffer
// TextLen& length of text in actual characters, e.g. XList
// TextSize& size of text, can be undefined when passed, but will be set
//
LOCAL pInStart&,pIn&,pOutStart&,pOut&,TextSize&
LOCAL Char8%,Char16&
LOCAL StaticWindowOffset&(8),DynamicWindowOffset&(8)
LOCAL SingleQuoteWindowN%,DynamicWindowN%,UnicodeModeB%
// Initialise default states
UnicodeModeB%=KFalse%
DynamicWindowN%=0
SingleQuoteWindowN%=0
// Initialise static window offsets (will never be changed)
CvScsuStaticWindowInitialise:(ADDR(StaticWindowOffset&()))
// Initialise default dynamic window offsets
CvScsuDynamicWindowInitialise:(ADDR(DynamicWindowOffset&()))
// this the actual XList length which should be multiplied by 2 to get the
// final outsize for UTF-16 characters. #### HOWEVER #### if we later support
// Extended Plane Unicode, the OutSize needs to be adjusted everytime we
// encounter such character
TextSize&=aTextLen&*KUnicodeFactor%
// allocate buffer with some extra space
pOut&=ALLOC(TextSize&*2)
IF pOut&=0 :RAISE KErrNoMemory% :ENDIF
// set up the pointers we need
// pInStart& points to the start of the text before conversion
// pIn& points to the current position in the text read from
// pOutStart& points to the start of the converted text
// pOut& points to the current position in the text to write to
pInStart&=PEEKL(_pText&)
pIn&=pInStart&
pOutStart&=pOut&
// go byte by byte
WHILE (pOut&-pOutStart&)<TextSize&
  IF UnicodeModeB%
    GOTO LBL_UnicodeMode::
  ENDIF
  //
  // single mode
  //
  Char8%=PEEKB(pIn&) :pIn&=pIn&+&1
  IF Char8%>=$20 AND Char8%<=$7f
    // Ascii codes, belong to Static Window 0
    // store directly in outbuffer
    POKEB pOut&,Char8% :pOut&=pOut&+&1
    POKEB pOut&,$00 :pOut&=pOut&+&1
    // ---- 1 inbyte, 2 outbytes
  ELSEIF Char8%>=$80
    // use the current dynamic window
    Char16&=DynamicWindowOffset&(DynamicWindowN%+1)+(Char8%-$80)
    // store in outbuffer
    PokeWordLE:(pOut&,Char16&) :pOut&=pOut&+&2
    // ---- 1 inbyte, 2 outbytes
  ELSEIF Char8%=KKeyTab% OR Char8%=KCarriageReturnER5% OR Char8%=KLineFeedER5%
    // store directly in outbuffer
    POKEB pOut&,Char8% :pOut&=pOut&+&1
    POKEB pOut&,$00 :pOut&=pOut&+&1
    // ---- 1 inbyte, 2 outbytes
  // SQU is used for isolated characters which do not fit into any of the current
  // windows
  ELSEIF Char8%=KScsu_SQU% // $0e - Single Quote Unicode
    // unicode character as *big* endian
    Char16&=PEEKB(pIn&)*&0100+PEEKB(pIn&+1) :pIn&=pIn&+&2
    // store in outbuffer
    PokeWordLE:(pOut&,Char16&) :pOut&=pOut&+&2
    // ---- 3 inbytes used, 2 outbytes
  // SQ0 does a single quote from window 0
  ELSEIF Char8%=KScsu_SQ0% // Window 0 non-Locking
    Char8%=PEEKB(pIn&) :pIn&=pIn&+&1
    // should only be used for control characters which would otherwise collide
    // with tag bytes.
    IF Char8%<$20
      Char16&=Char8% // Since StaticWindowOffset&(0+1)=&00000000
    ELSEIF Char8%>=$80
      Char16&=DynamicWindowOffset&(1)+(Char8%-$80)
    // check for ER5 specific characters and convert to ascii
    ELSE
      // characters after SQ0 between $20 and $7f are actually illegal but
      // according to SCSU they should not be reported as errors
      // no conversion needed
      Char16&=Char8%
    ENDIF
    // store in outbuffer
    PokeWordLE:(pOut&,Char16&) :pOut&=pOut&+&2
    // ---- 2 inbytes used, 2 outbytes
  // SQn does a single quote from window n
  ELSEIF Char8%>=KScsu_SQ1% AND Char8%<=KScsu_SQ7% // SQ1-SQ7 non-Locking
    SingleQuoteWindowN%=Char8%-KScsu_SQ0%
    Char8%=PEEKB(pIn&) :pIn&=pIn&+&1
    // choose between static and dynamic half-block
    IF Char8%<$80
      Char16&=StaticWindowOffset&(SingleQuoteWindowN%+1)+Char8%
    ELSE
      Char16&=DynamicWindowOffset&(SingleQuoteWindowN%+1)+(Char8%-$80)
    ENDIF
    // store in outbuffer
    PokeWordLE:(pOut&,Char16&) :pOut&=pOut&+&2
    // ---- 2 inbytes used, 2 outbytes
  // SCn changes to window N
  ELSEIF Char8%>=KScsu_SC0% AND Char8%<=KScsu_SC7% // SCn
    // set window locking
    DynamicWindowN%=Char8%-KScsu_SC0%
    // ---- 1 inbyte used, 0 outbyte
  // SDn defines a dynamic window N and changes to window N
  ELSEIF Char8%>=KScsu_SD0% AND Char8%<=KScsu_SD7% // SDn
    // set window locking
    DynamicWindowN%=Char8%-KScsu_SD0%
    // read in second byte
    Char8%=PEEKB(pIn&) :pIn&=pIn&+&1
    // change offset of dynamic window according to second byte
    DynamicWindowOffset&(DynamicWindowN%+1)=CvScsuDynamicWindow&:(Char8%)
    // ---- 2 inbytes used, 0 outbytes
  // SCU changes to Unicode Mode
  ELSEIF Char8%=KScsu_SCU%
    UnicodeModeB%=KTrue%
    // ---- 1 inbytes used, 0 outbytes
  // defines window in expansion space and sets to it
  ELSEIF Char8%=KScsu_SDX%
    Char16&=PeekWordBE&:(pIn&) :pIn&=pIn&+&2
    // set window based on the top three bits
    DynamicWindowN%=(Char16& AND &e000)/&2000
    // calculate the new offset in expansion space based on remaining bits
    DynamicWindowOffset&(DynamicWindowN%+1)=&10000+(&80*(Char16& AND &1fff))
    // the character will be interpreted in the next round so no
    // outbyte here
    // ---- 3 inbytes used, 0 outbytes
  ELSEIF Char8%=KScsu_SR%
    Message:("S Reserved")
    // ---- 1 inbyte used, 0 outbytes
  ELSE rem Char8%<=$ff AND Char8%>=$a0
    Message:("bad S character: "+HEX$(Char8%))
    // ---- 1 inbyte used, 0 outbytes
  ENDIF
  CONTINUE
  //
  // handle Unicode Mode
  //
  LBL_UnicodeMode::
  Char16&=PeekWordBE&:(pIn&) :pIn&=pIn&+2
  IF Char16&<KScsu_UC0& // &e000
    // store in outbuffer
    PokeWordLE:(pOut&,Char16&) :pOut&=pOut&+&2
    // ---- 2 inbytes used, 2 outbyte
  ELSEIF Char16&>=&f300 AND Char16&<=&ffff
    // store in outbuffer
    PokeWordLE:(pOut&,Char16&) :pOut&=pOut&+&2
    // ---- 2 inbytes used, 2 outbyte
  ELSEIF Char16&>=KScsu_UC0& AND Char16&<=(KScsu_UC7&+&ff)
    DynamicWindowN%=((Char16& AND &ff00)-KScsu_UC0&)/&0100
    UnicodeModeB%=KFalse%
    // go one byte back
    pIn&=pIn&-&1
    // ---- 1 inbytes used, 0 outbyte
  ELSEIF Char16&>=KScsu_UD0& AND Char16&<=(KScsu_UD7&+&ff)
    // set window locking
    DynamicWindowN%=((Char16& AND &ff00)-KScsu_UD0&)/&0100
    // leave unicodemode
    UnicodeModeB%=KFalse%
    // go back one byte
    pIn&=pIn&-&1
    // change offset of dynamic window according to second byte
    Char8%=PEEKB(pIn&) :pIn&=pIn&+&1
    DynamicWindowOffset&(DynamicWindowN%+1)=CvScsuDynamicWindow&:(Char8%)
    // ---- 3 inbytes used, 0 outbytes
  ELSEIF (Char16& AND &ff00)=KScsu_UQU&
    // go back one byte
    pIn&=pIn&-&1
    Char16&=PeekWordBE&:(pIn&) :pIn&=pIn&+2
    // store in outbuffer
    PokeWordLE:(pOut&,Char16&) :pOut&=pOut&+&2
    // ---- 3 inbytes used, 2 outbyte
  ELSEIF (Char16& AND &ff00)=KScsu_UDX&
    // go back one byte
    pIn&=pIn&-&1
    Char16&=PeekWordBE&:(pIn&) :pIn&=pIn&+2
    // set window based on the top three bits
    DynamicWindowN%=(Char16& AND &e000)/&2000
    // calculate the new offset in expansion space based on remaining bits
    DynamicWindowOffset&(DynamicWindowN%+1)=&10000+(&80*(Char16& AND &1fff))
    // the character will be interpreted in the next round so no
    // outbyte here
    // ---- 3 inbytes used, 0 outbytes
    // leave unicodemode
    UnicodeModeB%=KFalse%
  ELSEIF (Char16& AND &ff00)=KScsu_UR&
    Message:("U Reserved")
    // ---- 2 inbyte used, 0 outbytes
  ELSE
    Message:("bad U character: "+HEX$(Char16&))
    // ---- 2 inbyte used, 0 outbytes
  ENDIF
ENDWH
// adjust size of outbuffer, since it may have been reduced or increased
pOutStart&=REALLOC(pOutStart&,TextSize&)
// cleanup and set return BYREF values
FREEALLOC(pInStart&)
POKEL _pText&,pOutStart&
POKEL _TextSize&,TextSize&
ENDP

PROC CvScsuDynamicWindow&:(aByte%)
// returns new dynamic window offset for the SDn commands
IF aByte%>=$01 AND aByte%<=$67
  RETURN (aByte%*$80+KScsuDynamicWindowLowOffset&)
ELSEIF aByte%>=$68 AND aByte%<=$a7
  RETURN (aByte%*$80+KScsuDynamicWindowHighOffset&)
ELSEIF aByte%=$f9
  RETURN KScsuDynamicWindowLatin1x&
ELSEIF aByte%=$fa
  RETURN KScsuDynamicWindowIpaExt&
ELSEIF aByte%=$fb
  RETURN KScsuDynamicWindowGreek&
ELSEIF aByte%=$fc
  RETURN KScsuDynamicWindowArmenian&
ELSEIF aByte%=$fd
  RETURN KScsuDynamicWindowHiragana&
ELSEIF aByte%=$fe
  RETURN KScsuDynamicWindowKatakana&
ELSEIF aByte%=$ff
  RETURN KScsuDynamicWindowHalfKatakana&
ELSE
  // $A8..$F8 are reserved
  // $00 is reserved
  RETURN &00000000
ENDIF
ENDP

PROC CvScsuStaticWindowInitialise:(_StaticWindowArray&)
// Initialises StaticWindow offset array to default values
// Usage: CvScsuStaticWindowInitialise:(ADDR(WindowArray()))
POKEL _StaticWindowArray&+&0000,KScsuStaticWindow0& // SW0
POKEL _StaticWindowArray&+&0004,KScsuStaticWindow1& // SW1
POKEL _StaticWindowArray&+&0008,KScsuStaticWindow2& // SW2
POKEL _StaticWindowArray&+&000c,KScsuStaticWindow3& // SW3
POKEL _StaticWindowArray&+&0010,KScsuStaticWindow4& // SW4
POKEL _StaticWindowArray&+&0014,KScsuStaticWindow5& // SW5
POKEL _StaticWindowArray&+&0018,KScsuStaticWindow6& // SW6
POKEL _StaticWindowArray&+&001c,KScsuStaticWindow7& // SW7
ENDP

PROC CvScsuDynamicWindowInitialise:(_DynamicWindowArray&)
// initialises DynamicWindow offset array to default values
// Usage: CvScsuDynamicWindowInitialise:(ADDR(WindowArray()))
POKEL _DynamicWindowArray&+&0000,KScsuDynamicWindow0& // DW0
POKEL _DynamicWindowArray&+&0004,KScsuDynamicWindow1& // DW1
POKEL _DynamicWindowArray&+&0008,KScsuDynamicWindow2& // DW2
POKEL _DynamicWindowArray&+&000c,KScsuDynamicWindow3& // DW3
POKEL _DynamicWindowArray&+&0010,KScsuDynamicWindow4& // DW4
POKEL _DynamicWindowArray&+&0014,KScsuDynamicWindow5& // DW5
POKEL _DynamicWindowArray&+&0018,KScsuDynamicWindow6& // DW6
POKEL _DynamicWindowArray&+&001c,KScsuDynamicWindow7& // DW7
ENDP


dpNote 0023

8 April 2006

All OPL versions

Clipboard - accurate copying and pasting of text in ER6 and ER7

The clipboard in ER6 and later uses essentially the same format as the clipboard in ER5 and earlier. They key difference is that text is stored in SCSU format in ER6 and ER7 (Note: not Unicode UTF-16, see dpNote 0022 about this) rather than ASCII as was the case with ER5.

To date I have not found any need to develop clipboard routines for anything else than plain text. Perhaps in the future I will. However, contrary to most other OPL routies for clipboard handling that I've seen, I found it important to support texts with length far longer than 255. Hence the clipboard routines presented here use buffers, not strings.


// these are constants for ER6/S80 (ER5 constants in brackets)
// it has been verified that the clipboard format is the same in
// S80 R1, S80 R2 and S90 as well as UIQ2
CONST KCbClipboardFile$="C:\System\Data\Clpboard.cbd"
CONST KCbUid1&=&10000037 // UID1 - file header structure (ER5 same)
CONST KCbUid2&=&10003a10 // UID2 - file type (ER5 &1000003b)
CONST KCbUid3&=&00000000 // UID3 - application identifier (ER5 same)
CONST KCbUid4&=&037bfc6a // UID4 - checksum (ER5 &4739d53b)
CONST KCbOffsetOfContentsTableOffset&=&00000010 // (ER5 same)
CONST KCbTextLenOffset&=&00000014 // (ER5 same)
CONST KCbContentsTableOffset&=&00000019 // (ER5 same)
CONST KCbNulByte%=$00 // (ER5 same)
CONST KCbNoOfContentsTableEntries%=$02 // (ER5 same)
CONST KCbObjectUidText&=&10003a1d // UID for SCSU text (ER5 &10000033)

PROC CbCopyTo:(apSource&,aSourceLength&,aSourceSize&)
// writes the content of a UTF-16LE buffer to the clipboard's text segment
// converts the text to SCSU
LOCAL hClipboard%,IoMode%,IoRtn%,pPos&,pContentTableOffset&
LOCAL pText&,TextLength&,TextSize&
// Values
pText&=apSource&
TextLength&=aSourceLength&
TextSize&=aSourceSize&
IF TextLength&<>TextSize&/2
  RAISE KErrInvalidFormat%
  RETURN
ENDIF
// Open the clipboard file for writing to
IoMode%=KIoAccessUpdate% OR KIoAccessRandom% OR KIoModeReplace% OR KIoFormatBinary%
IoRtn%=IOOPEN(hClipboard%,KCbClipboardFile$,IoMode%)
IF IoRtn%<0
  RAISE KErrInUse%
  RETURN
ENDIF
// Write the clipboard header
IoWriteLong:(hClipboard%,KCbUid1&)
IoWriteLong:(hClipboard%,KCbUid2&)
IoWriteLong:(hClipboard%,KCbUid3&)
IoWriteLong:(hClipboard%,KCbUid4&)
// Write dummy table offset for now, fill in later
IoWriteLong:(hClipboard%,&00000000)
// Store the buffer Length&
IoWriteLong:(hClipboard%,TextLength&)
// Encode into SCSU
CvUnicodeToScsu:((ADDR(pText&),TextLength&,ADDR(TextSize&))
// Actually store the text
IF TextSize&>KIoReadWriteChunk&
  IoWriteBuffer:(hClipboard%,pText&,TextSize&)
ELSE
  IOWRITE(hClipboard%,pText&,TextSize&)
ENDIF
// Store a nul byte
IoWriteByte:(hClipboard%,KCbNulByte%)
// Remember table offset
// pPos& will take the value of the current position
pPos&=0
IOSEEK(hClipboard%,KIoPosRelative%,pPos&)
// write the contents table
IoWriteByte:(hClipboard%,KCbNoOfContentsTableEntries%) // two entries
IoWriteLong:(hClipboard%,KCbObjectUidText&) // text UID
IoWriteLong:(hClipboard%,KCbTextLenOffset&) // file offset
// seek back to the contents table offset position
pContentTableOffset&=KCbOffsetOfContentsTableOffset&
IOSEEK(hClipboard%,KIoPosAbsolute%,pContentTableOffset&)
// write the content table offset
IoWriteLong:(hClipboard%,pPos&)
// complete
IOCLOSE(hClipboard%)
ENDP

PROC CbPasteFrom:(_pText&,_TextLength&,_TextSize&)
// pastes clipboard text as UTF-16LE into a buffer pText&,TextLength&,TextSize&
// Usage: CbPasteFrom:(ADDR(pText&),ADDR(TextLength&),ADDR(TextSize&))
// Note: if reading successful the procedure will allocate a buffer
// pText&. If the buffer is not allocated pText&=0
LOCAL hClipboard%,IoMode%,Offset&,NoOfEntries%,ObjectUid&,ObjectOffset&
LOCAL i%,TextLength&,TextSize&,pText&,TableOffset&
// open the clipboard file
IF NOT EXIST(KCbClipboardFile$)
  TextSize&=0
  pText&=0
  GOTO LBL_CleanupAndReturn::
ENDIF
IoMode%=KIoAccessRandom% OR KIoModeOpen% OR KIoFormatBinary%
IOOPEN(hClipboard%,KCbClipboardFile$,IoMode%)
// obtain the offset to the contents table
Offset&=KCbOffsetOfContentsTableOffset&
IOSEEK(hClipboard%,KIoPosAbsolute%,Offset&)
IOREAD(hClipboard%,ADDR(TableOffset&),KLongSize&)
// move pointer to the contents table
IOSEEK(hClipboard%,KIoPosAbsolute%,TableOffset&)
// read number of entries in clipboard and exit if empty
IOREAD(hClipboard%,ADDR(NoOfEntries%),KByteSize&)
IF NoOfEntries%=0
  TextSize&=0
  pText&=0
  GOTO LBL_CleanupAndReturn::
ENDIF
// read onwards until a text object is found
i%=0
DO
  IOREAD(hClipboard%,ADDR(ObjectUid&),KLongSize&)
  IOREAD(hClipboard%,ADDR(ObjectOffset&),KLongSize&)
  i%=i%+2
UNTIL (i%>NoOfEntries%) OR (ObjectUid&=KCbObjectUidText&)
// exit with zero size if no text found
IF i%>NoOfEntries%
  pText&=0
  TextSize&=0
  GOTO LBL_CleanupAndReturn::
ENDIF
// set pointer to the start of the text object
IOSEEK(hClipboard%,KIoPosAbsolute%,ObjectOffset&)
// determine the length of the text to be copied
IOREAD(hClipboard%,ADDR(TextLength&),KLongSize&)
// set a trial TextSize& to cover worst case SCSU, and check so that
// the trial text does not overlap the table. the &0004 is for the
// length field
TextSize&=TextLength&*3
IF (ObjectOffset&+TextSize&+&4)>TableOffset&
  TextSize&=TableOffset&-ObjectOffset&-&0004
ENDIF
// read text into buffer
pText&=ALLOC(TextSize&)
IF TextSize&>KIoReadWriteChunk&
  IoReadBuffer:(hClipboard%,pText&,TextSize&)
ELSE
  IOREAD(hClipboard%,pText&,TextSize&)
ENDIF
// convert to SCSU imposing actual length
CvScsuToUnicode:(ADDR(pText&),TextLength&,ADDR(TextSize&))
//
LBL_CleanupAndReturn::
// close file
IOCLOSE(hClipboard%)
// return BYREF values
POKEL _pText&,pText&
POKEL _TextLength&,TextLength&
POKEL _TextSize&,TextSize&
ENDP

dpNote 0024

31 Dec 2005

All OPL versions
Adding a bitmap to an MBM file

This procedure adds a bitmap to an existing MBM file. It makes use of several procedures in dpNote0001 and dpNote0008.


PROC MbmFileAdd%:(aFileName$,aId%)
// Adds a bitmap with the ID aId% into an MBM file aFileName$. If the MBM file
// does not exist, a new MBM file is created.
LOCAL IsValidMbmFileB%,hMbm%,Uid&(4)
LOCAL TempFile$(KMaxFileNameLen%),hTemp%,pTempBuffer&,TempSize&
LOCAL Offset&,oJumpTable&,NoOfBitmaps&,Index&,pJumpTableStack&,oNewBitmap&
// check the Mbm file that it is valid and contains at least one bitmap
IF NOT EXIST(aFileName$)
  IsValidMbmFileB%=KFalse%
  GOTO LBL_Save::
ENDIF
hMbm%=IoOpenForRead%:(aFileName$)
// verify that the header is an Mbm file header
IOREAD(hMbm%,ADDR(Uid&(1)),KLongSize&)
IOREAD(hMbm%,ADDR(Uid&(2)),KLongSize&)
IOREAD(hMbm%,ADDR(Uid&(3)),KLongSize&)
IOREAD(hMbm%,ADDR(Uid&(4)),KLongSize&)
IOCLOSE(hMbm%)
IF Uid&(1)<>KUidLayoutPermanentFile&
  IsValidMbmFileB%=KFalse%
ELSEIF Uid&(2)<>KUidFileTypeMbmER5&
  IsValidMbmFileB%=KFalse%
// Also verify that the mbm file has at least one bitmap
ELSEIF MbmFileNoOfImages%:(aFileName$)<1
  IsValidMbmFileB%=KFalse%
ELSE
  IsValidMbmFileB%=KTrue%
ENDIF
LBL_Save::
IF NOT IsValidMbmFileB%
  // Save file as single Mbm
  IF EXIST(aFileName$)
    DELETE(aFileName$)
  ENDIF
  gUSE aId%
  gSAVEBIT aFileName$
  // Ensure the file has the correct UID. This is necessary since gSAVEBIT will
  // set UID2 to KUidFileTypeSavedFromOplER5&
  hMbm%=IoOpenForUpdate%:(aFileName$)
  Uid&(1)=KUidLayoutPermanentFile&
  Uid&(2)=KUidFileTypeMbmER5&
  Uid&(3)=&00000000
  Uid&(4)=UidCheckSum&:(Uid&(1),Uid&(2),Uid&(3))
  IoWriteLong:(hMbm%,Uid&(1))
  IoWriteLong:(hMbm%,Uid&(2))
  IoWriteLong:(hMbm%,Uid&(3))
  IoWriteLong:(hMbm%,Uid&(4))
  IOCLOSE(hMbm%)
ELSE // add the single Mbm onto the multi Mbm
  // first store as temporary bitmap
  TempFile$=IoCreateTemporaryFileName$:
  gUSE aId%
  gSAVEBIT TempFile$
  // read in size of saved bitmap
  hTemp%=IoOpenForRead%:(TempFile$)
  Offset&=&00000010
  IOSEEK(hTemp%,KIoPosAbsolute%,Offset&)
  IOREAD(hTemp%,ADDR(oJumpTable&),KLongSize&)
  TempSize&=oJumpTable&-&00000014
  // allocate temporary buffer and read in the bitmap
  pTempBuffer&=ALLOC(TempSize&)
  IoPositionSet:(hTemp%,&00000014)
  IoReadBuffer:(hTemp%,pTempBuffer&,TempSize&)
  // open the Mbmfile and read in data subject to updates
  hMbm%=IoOpenForUpdate%:(aFileName$)
  Offset&=&00000010
  IOSEEK(hMbm%,KIoPosAbsolute%,Offset&)
  IOREAD(hMbm%,ADDR(oJumpTable&),KLongSize&)
  IOSEEK(hMbm%,KIoPosAbsolute%,oJumpTable&)
  IOREAD(hMbm%,ADDR(NoOfBitmaps&),KLongSize&)
  Index&=&1
  pJumpTableStack&=StackLongCreate&:
  WHILE Index&<=NoOfBitmaps&
    IOREAD(hMbm%,ADDR(Offset&),KLongSize&)     pJumpTableStack&=StackLongPush&:(pJumpTableStack&,Offset&)
    Index&=Index&+&1
  ENDWH
  // Append the temp file to the Mbmfile
  // The offset of the added bitmap takes the offset of the old jumptable
  oNewBitmap&=oJumpTable&
  IoPositionSet:(hMbm%,oNewBitmap&)
  IoWriteBuffer:(hMbm%,pTempBuffer&,TempSize&)
  // update jumptable offsets and no of bitmaps
  oJumpTable&=IoPosition&:(hMbm%)
  NoOfBitmaps&=NoOfBitmaps&+&1
  // write the new jumptable
  IoWriteLong:(hMbm%,NoOfBitmaps&)
  StackLongMirror:(pJumpTableStack&)
  WHILE (NOT StackLongEmptyB%:(pJumpTableStack&))
    Offset&=StackLongPop&:(pJumpTableStack&)
    IoWriteLong:(hMbm%,Offset&)
  ENDWH
  IoWriteLong:(hMbm%,oNewBitmap&)
  // write the new jumptable offset
  IoPositionSet:(hMbm%,&00000010)
  IoWriteLong:(hMbm%,oJumpTable&)
  // cleanup
  StackLongDestroy:(pJumpTableStack&)
  IoCloseTemporary:(TempFile$,hTemp%)
  IOCLOSE(hMbm%)
  FREEALLOC(pTempBuffer&)
ENDIF
// return the number of Mbms in the file
RETURN MbmFileNoOfImages%:(aFileName$) // from dpNote 0001
ENDP
dpNote 0025

20 July 2005

All OPL versions

Useful IO functions and wrappers

These IO functions and wrappers are used by many other dpNote program examples.

PROC IoOpenForRead%:(aFileName$)
// opens a file for reading
LOCAL IoMode%,IoRtn%,hFile%
IoMode%=KIoModeOpen% OR KIoFormatBinary% OR KIoAccessRandom% OR KIoAccessShare%
IoRtn%=IOOPEN(hFile%,aFileName$,IoMode%)
IF IoRtn%<0
  RAISE IoRtn%
  RETURN 0
ENDIF
RETURN hFile%
ENDP

PROC IoOpenForUpdate%:(aFileName$)
// opens a file for editing
LOCAL IoMode%,IoRtn%,hFile%
IoMode%=KIoModeOpen% OR KIoFormatBinary% OR KIoAccessUpdate% OR KIoAccessRandom%
IoRtn%=IOOPEN(hFile%,aFileName$,IoMode%)
IF IoRtn%<0
  RAISE IoRtn%
  RETURN 0
ENDIF
RETURN hFile%
ENDP

PROC IoOpenForWrite%:(aFileName$)
// opens a file for replacing
LOCAL IoMode%,IoRtn%,hFile%
IoMode%=KIoModeReplace% OR KIoFormatBinary% OR KIoAccessRandom% OR KIoAccessUpdate%
IoRtn%=IOOPEN(hFile%,aFileName$,IoMode%)
IF IoRtn%<0
  RAISE IoRtn%
RETURN 0
ENDIF
RETURN hFile%
ENDP

PROC IoOpenTemporary$:(_hFile&)
// Returns a generated temporary filename
// Opens the temporary file for writing and returns the handle as hFile%
// Usage: TempFile$=IoOpenTemporary$:(ADDR(hFile%))
LOCAL IoMode%,IoRtn%,hFile%,FilePath$(KMaxFileNameLen%)
FilePath$="C:\System\Temp\"
IF NOT EXIST(FilePath$)
  MKDIR(FilePath$)
ENDIF
IoMode%=KIoAccessUpdate% OR KIoAccessRandom% OR KIoModeUnique% OR KIoFormatBinary%
IoRtn%=IOOPEN(hFile%,ADDR(FilePath$),IoMode%)
IF IoRtn%<0
  POKEL _hFile&,$0000
  RAISE IoRtn%
  RETURN ""
ENDIF
// return BYREF value
POKEL _hFile&,hFile%
// return the temporary filename
RETURN FilePath$
ENDP

PROC IoCloseTemporary:(aFileName$,aHandle%)
// closes and deletes a temporary file opened with IoOpenTemporary$:(_hFile&)
IOCLOSE(aHandle%)
IF EXIST(aFileName$)
  TRAP DELETE aFileName$
ENDIF
ENDP

PROC IoCreateTemporaryFileName$:
// Returns a generated temporary filename
// Usage: TempFile$=IoCreateTemporaryFileName$:
LOCAL IoMode%,IoRtn%,hFile%,FilePath$(KMaxFileNameLen%)
FilePath$="C:\System\Temp\"
IF NOT EXIST(FilePath$)
  MKDIR(FilePath$)
ENDIF
IoMode%=KIoAccessUpdate% OR KIoAccessRandom% OR KIoModeUnique% OR KIoFormatBinary%
IoRtn%=IOOPEN(hFile%,ADDR(FilePath$),IoMode%)
IF IoRtn%<0
  RAISE IoRtn%
  RETURN ""
ENDIF
IOCLOSE(hFile%)
RETURN FilePath$
ENDP

PROC IoEofB%:(aHandle%)
// returns KTrue% if the reading of file has reached the last byte, else KFalse%
LOCAL EndOffset&,PreviousOffset&
// get current position
PreviousOffset&=&00000000
IOSEEK(aHandle%,KIoPosRelative%,PreviousOffset&)
// get end position
EndOffset&=&00000000
IOSEEK(aHandle%,KIoPosFromEnd%,EndOffset&)
// if current and end positions are the same, it means we're at the
// end of file
IF PreviousOffset&>=EndOffset&
  RETURN KTrue%
ELSE
  // set position back to current
  IOSEEK(aHandle%,KIoPosAbsolute%,PreviousOffset&)
  RETURN KFalse%
ENDIF
ENDP

PROC IoPosition&:(aHandle%)
// returns the current read-pointer to the opened IO file
LOCAL Offset&
// setting the offset to zero means that the pointer will not move in
// any direction
Offset&=&00000000
IOSEEK(aHandle%,KIoPosRelative%,Offset&)
RETURN Offset&
ENDP

PROC IoPositionSet:(aHandle%,aPosition&)
// sets absolute position
LOCAL Offset&
Offset&=aPosition&
IOSEEK(aHandle%,KIoPosAbsolute%,Offset&)
ENDP

PROC IoPositionStart:(aHandle%)
// sets pointer to start of the file
LOCAL Offset&
Offset&=&00000000 // first byte
IOSEEK(aHandle%,KIoPosAbsolute%,Offset&)
ENDP

PROC IoReverse:(aHandle%,aBytes&)
// moves backwards a given number of bytes
LOCAL Offset&
Offset&=-ABS(aBytes&)
IOSEEK(aHandle%,KIoPosRelative%,Offset&)
ENDP

One major issue in OPL text handing is that IOREAD and IOWRITE cannot handle large buffers. Instead they have to be read and written in chunks of 2000 bytes.

CONST KIoReadWriteChunk&=2000

PROC IoWriteBuffer:(aHandle%,apBuffer&,aBufferSize&)
// IO-writes long buffers. Assumes that the file has already been opened with
// IOOPEN. Arguments are identical to IOWRITE
LOCAL pCurrent&,pEnd&
pCurrent&=apBuffer&
pEnd&=apBuffer&+aBufferSize&
WHILE (pEnd&-pCurrent&)>=KIoReadWriteChunk&
  IOWRITE(aHandle%,pCurrent&,KIoReadWriteChunk&)
  pCurrent&=pCurrent&+KIoReadWriteChunk&
ENDWH
IF pCurrent&<pEnd&
  IOWRITE(aHandle%,pCurrent&,pEnd&-pCurrent&)
ENDIF
ENDP

PROC IoReadBuffer:(aHandle%,apBuffer&,aBufferSize&)
// IO-reads long buffers. Assumes that the file has already been opened with
// IOOPEN. Arguments are identical to IOREAD
LOCAL pCurrent&,pEnd&
pCurrent&=apBuffer&
pEnd&=apBuffer&+aBufferSize&
WHILE (pEnd&-pCurrent&)>=KIoReadWriteChunk&
  IOREAD(aHandle%,pCurrent&,KIoReadWriteChunk&)
  pCurrent&=pCurrent&+KIoReadWriteChunk&
ENDWH
IF pCurrent&<pEnd&
  IOREAD(aHandle%,pCurrent&,pEnd&-pCurrent&)
ENDIF
ENDP

PROC IoFileToBuffer:(aFileName$,_pBuffer&,_Size&)
// loads a binary file into a buffer and returns the pointer to the buffer
LOCAL pIn&,FileSize&
LOCAL hFile%,IoMode%,r&,return&
// allocate buffer according to file size
FileSize&=GetFileSize&:(aFileName$)
pIn&=ALLOC(FileSize&+KIoReadWriteChunk&)
// open file
IoMode%=KIoModeOpen% OR KIoFormatBinary% OR KIoAccessRandom%
IOOPEN(hFile%,aFileName$,IoMode%)
// load data chunkwise
r&=0
DO
  return&=IOREAD(hFile%,pIn&+r&*KIoReadWriteChunk&,KIoReadWriteChunk&)
  r&=r&+&1
// the return value is equal to the number of bytes read-in
// when reaching end of file, return will be less than the chunk
UNTIL return&<>KIoReadWriteChunk&
// close file
IOCLOSE(hFile%)
// return BYREF values
POKEL _pBuffer&,pIn&
POKEL _Size&,FileSize&
ENDP

PROC IoLengthSListRead%:(aHandle%)
// the SList length is used in Symbian Word formats and probably many other
// Symbian/Psion formats. It allows lengths of:
// 00000000 - 0000007F and
// 00000080 - 00001FFF
LOCAL Byte%
IOREAD(aHandle%,ADDR(Byte%),KByteSize&)
IF (Byte% AND $03)=$02
  RETURN (Byte%-$02)/$0004
ELSEIF (Byte% AND $07)=$05
  IoReverse:(aHandle%,KByteSize&)
  IOREAD(aHandle%,ADDR(Byte%),KWordSize&)
  RETURN (Byte%-$05)/$0008
ELSE
  RAISE KErrOutOfRange%
  RETURN $0000
ENDIF
ENDP

PROC IoLengthSListWrite:(aHandle%,aLength%)
// see IoLengthSListRead%:
LOCAL Length%
Length%=aLength%
IF Length%<=$003f
  Length%=Length%*4+$02
  IOWRITE(aHandle%,ADDR(Length%),KByteSize&)
ELSEIF Length%<=$1fff
  Length%=Length%*8+$05
  IOWRITE(aHandle%,ADDR(Length%),KWordSize&)
ELSE
  RAISE KErrOutOfRange%
ENDIF
ENDP

PROC IoLengthXListRead&:(aHandle%)
// the XList length is used in Symbian Word formats and probably many other
// Symbian/Psion formats. One example is the length indicator before the plain
// text field in Psion Word. The Xlist length can be 1 to 3 bytes long,
// depending on the value of the first byte. It allows lengths of:
// 00000000 - 0000007F one byte
// 00000080 - 00003FFF two bytes
// 00004000 - 1FFFFFFF four bytes
// it could be assumed that even longer lengths could be represented using
// five bytes or more, but this is not covered here.
LOCAL Byte%,Long&
IOREAD(aHandle%,ADDR(Byte%),KByteSize&)
IF (Byte% AND $01)=$00
  RETURN (Byte%/&00000002)
ELSEIF (Byte% AND $03)=$01
  IoReverse:(aHandle%,KByteSize&)
  IOREAD(aHandle%,ADDR(Long&),KWordSize&)
  RETURN (Long&-$01)/4
ELSEIF (Byte% AND $07)=$03
  IoReverse:(aHandle%,KByteSize&)
  IOREAD(aHandle%,ADDR(Long&),KLongSize&)
  RETURN (Long&-$03)/8
ELSE
  RAISE KErrOutOfRange%
  RETURN &00000000
ENDIF
ENDP

PROC IoLengthXListWrite:(aHandle%,aLength&)
// writes a XList length in 1 to 3 bytes, see IoLengthXListRead&:
LOCAL Length&
Length&=aLength&
IF Length&<=&0000007f
  Length&=Length&*2
  IOWRITE(aHandle%,ADDR(Length&),KByteSize&)
ELSEIF Length&<=&00003fff
  Length&=Length&*4+$01
  IOWRITE(aHandle%,ADDR(Length&),KWordSize&)
ELSEIF Length&<=&1fffffff
  Length&=Length&*8+$03
  IOWRITE(aHandle%,ADDR(Length&),KLongSize&)
ELSE
  RAISE KErrOutOfRange%
ENDIF
ENDP

PROC IoWriteByte:(aHandle%,aByte%)
LOCAL LocalByte%
LocalByte%=aByte% AND $00ff
IOWRITE(aHandle%,ADDR(LocalByte%),KByteSize&)
ENDP

PROC IoWriteShort:(aHandle%,aShort%)
LOCAL LocalShort%
LocalShort%=aShort%
IOWRITE(aHandle%,ADDR(LocalShort%),KShortSize&)
ENDP

PROC IoWriteLong:(aHandle%,aLong&)
LOCAL LocalLong&
LocalLong&=aLong&
IOWRITE(aHandle%,ADDR(LocalLong&),KLongSize&)
ENDP

PROC IoWriteString:(aHandle%,aString$)
// note: only writes the character codes, length/size has to be written
// separately
LOCAL String$(KMaxStringLen%)
String$=aString$
IOWRITE(aHandle%,ADDR(String$)+KTextHeader%,LEN(String$))
ENDP

dpNote 0026

1 March 2007

All OPL versions
Predictable PAUSE function

OPL's PAUSE command seems to have a few drawbacks. First it, can cause unpredictable behaviour when used within an asynchronous loop. Second, it appears to give different delays on different devices. Using the Date.opx, the following function solves both issues.


PROC WaitMilliseconds:(aMilliSecond&)
LOCAL hTime1&,hTime2&,WaitTime&
WaitTime&=aMilliSecond&*1000
hTime1&=DtNow&:
WHILE KTrue%
  hTime2&=DtNow&:
  IF DtMicrosDiff&:(hTime1&,hTime2&)>WaitTime&
    BREAK
  ENDIF
ENDWH
DtDeleteDateTime:(hTime1&)
DtDeleteDateTime:(hTime2&)
ENDP
dpNote 0027

21 June 2001

All OPL versions

Launching an application from OPL and wait until it finishes before returning

The following demonstrates how to launch a Word file then 'log on' to the returned thread and wait until it has been ended by the user before continuing. The code makes use of asynchronous event handling.

INCLUDE "System.oxh"
INCLUDE "Const.oph"

PROC Main:
RunEndReturn:("C:\Documents\CloseMe")
ENDP

PROC RunEndReturn:(aFilename$)
LOCAL File$(KMaxStringLen%),Ev&(16),EventStatus%
LOCAL ThreadID&,ThreadStatus& // For our Word thread

IF EXIST(aFilename$)
  TRAP DELETE aFilename$
ENDIF
// Start Word and create the file.
// The OPL application is pushed to the background...
ThreadID&=RunApp&:("Word",aFilename$,"",1)
// ...but we keep running, so keep an eye on the thread.
LogOnToThread:(ThreadID&,ThreadStatus&)
WHILE KTrue%
  // Queue an async event read.
  GETEVENTA32 EventStatus%,Ev&()
  PRINT "IOWAITing..."
  IOWAIT
  // Check for thread completion
  IF ThreadStatus&<>KStatusPending32&
    // We may still be in background,
    // so let someone know what's happened.
    BEEP 3,300
    PRINT "Word has finished."
    BREAK
  // Check for other events
  ELSEIF EventStatus%<>KErrFilePending%
    // Look at the event type...
    IF Ev&(KEvType%)=KEvFocusGained& // foreground
      PRINT "We're in the foreground."
      BREAK
    ELSE
      PRINT "Other event",HEX$(Ev&(KEvType%)),"ignored."
    ENDIF
  ENDIF
ENDWH
PRINT "Done."
GET
ENDP

From Symbian Knowledgebase FAQ-0412

dpNote 0028

1 June 2003
(updated with comments on 1 Oct 2003)

v5 Eikon
v6 Series 80 R1

Asynchronous event loop with inactivity timer

The following is an application template which works both for v5/Eikon (in which we have used this structure in several applications) and v6/S80 (in which we have used it for one application). It has been tested on:

- Psion netBook (v5/Eikon)
- WINS for v5/Eikon
- WINS for v6/S80 R1
- Nokia 9210 (v6/S80 R1)

When running in v5/Eikon, it works as expected and no stray signals are ever generated.

When running in v6/S80 R1, lots of stray signals are generated. Furthermore, if not two
IOSIGNAL are added to the stray signal handling, the application will hang after a while. Therefore, we had to add a KAddSomeExtraIoSignalB% which should be set to KFalse% in v5/Eikon and to KTrue% in v6/S80 R1.

We have not tried this in v6/S60, v7/S60, v7/UIQ, v7/S80 R2, nor v7/S90 yet.

We think that asynchronous event handling is a very important part of OPL. It has been indicated before that v6/S80 is quite flaky in this area but we hope to be able to identify where the problems are in order to make it better going forward. In particular, there is reportedly a buggy timer.

// Asynchronous Event Handling
// Getevent loop with inactivity timer
// - can be used for 'screensavers' etc
// 19/6/2003 Free2move Asia S/B
// www.f2m.com.my

INCLUDE "Const.oph"
INCLUDE "System.oxh"

// select platform before compilation
rem CONST KSymbianOsVersion$="v5/Eikon"
rem CONST KSymbianOsVersion$="v6/S60"
CONST KSymbianOsVersion$="v6/S80"
rem CONST KSymbianOsVersion$="v7/UIQ"
rem CONST KSymbianOsVersion$="v7/S60"
rem CONST KSymbianOsVersion$="v7/S80"
rem CONST KSymbianOsVersion$="v7/S90"

CONST KTimeOut%=5 // seconds
CONST KTimerStart&=0 // reset timer

// needs to be set KTrue% for v6/S80 and to KFalse% for v5/Eikon
// otherwise application will hang
// but should not be needed were OPL for v6/S80 bugfree
CONST KAddSomeExtraIoSignalB%=KTrue%

PROC Main:
LOCAL t$(KMaxStringLen%),a$(KMaxStringLen%),b$(KMaxStringLen%)
t$="Eventloop with non-activity timer"
a$="This is a template for application"+NewLine$:+"development"
b$=NewLine$:+"This machine is: "+GetMachineName$:
InfoDialogue:(t$,a$,b$)
EventLoopA:
ENDP

PROC EventLoopA:
LOCAL ev&(16),EventStatus%
LOCAL TimeOut&,hTimer%,TimerStatus%,TimerReturn%
LOCAL StraySignalCount%
LOCAL ForeGroundB%
// program starts in foreground
ForeGroundB%=KTrue%
// reset stray signal counter
StraySignalCount%=0
// create a timer
IOOPEN(hTimer%,KIoTimer$,KIoModeDeviceOnly%)
// ensure at least one loop
ev&(1)=0
// start getevent loop
WHILE ev&(1)<>KKeyEsc%
  // set async
  GETEVENTA32 EventStatus%,ev&()
  // set timer only if in foreground
  IF ForeGroundB%
    TimeOut&=KTimeOut%*10
    TimerReturn%=IOC(hTimer%,1,TimerStatus%,TimeOut&,#KTimerStart&)
  ENDIF
  // wait for something to happen
  IOWAIT
  IF EventStatus%<>KStatusPending% // event
    // cancel timer only if in foreground, i.e. if it has been
    // initialised earlier
    IF ForeGroundB%
      IOCANCEL(hTimer%)
      IOWAITSTAT hTimer%
    ENDIF
    // handle input events
    IF ev&(KEvType%)=KEvFocusLost& // program moved to background
      Message:("Disappearing...")
      // option to have a HotKeyHandler: procedure here
      ForeGroundB%=KFalse%
    ELSEIF ev&(KEvType%)=KEvFocusGained& // program moved to foreground
      Message:("Reappearing...")
      ForeGroundB%=KTrue%
    ELSEIF ev&(KEvType%)=KEvDateChanged&
      Message:("Tempus fugit...")
    ELSE // data input event
      IF (ev&(KEvType%)<>KEvKeyDown& AND ev&(KEvType%)<>KEvKeyUp&)
        IF (ev&(KEvType%)<>KEvPtr&) AND (ev&(KEvType%)<>KEvPtrEnter&) AND (ev&(KEvType%)<>KEvPtrExit&)
          // replaces (ev&(KEvType%) AND KEvNotKeyMask&)=0
          EventKeyProcess:(ev&(KEvType%),ev&(KEvMod%),ev&(KEvScan%))
        ELSE
          EventPenProcess:(ev&(KEvWinID%),ev&(KEvPtrType%),ev&(KEvPtrX%),ev&(KEvPtrY%))
        ENDIF
      ENDIF
    ENDIF
  ELSEIF TimerStatus%<>KStatusPending% // time out
    GETEVENTC(EventStatus%)
    TimeOutProcess:
  ELSE // stray signal
    Message:("Stray signal count = "+GEN$(StraySignalCount%,5))
    StraySignalCount%=StraySignalCount%+1
    GETEVENTC(EventStatus%)
    IF ForeGroundB%
      IOCANCEL(hTimer%)
      IOWAITSTAT hTimer%
    ENDIF
    IF KAddSomeExtraIoSignalB%
      IOSIGNAL :IOSIGNAL // this one is crazee!!!
    ENDIF
  ENDIF // end of async status checks
ENDWH
// put stray signals back again
WHILE StraySignalCount%>0
  IOSIGNAL
  StraySignalCount%=StraySignalCount%-1
ENDWH
Info:("Finished")
ENDP

PROC EventKeyProcess:(aKeyType&,aKeyMod&,aKeyScan&)
Message:("Key "+HEX$(aKeyType&)+" "+HEX$(aKeyMod&))
ENDP

PROC EventPenProcess:(aPtrWID&,aPtrType&,aPtrX&,aPtrY&)
Message:("Pen "+GEN$(aPtrWID&,2)+" "+GEN$(aPtrX&,3)+" "+GEN$(aPtrY&,3))
ENDP

PROC TimeOutProcess:
Message:("Time out!")
ENDP

PROC ___standard_stuff: :ENDP

PROC Info:(aText$)
InfoDialogue:(aText$,"","")
ENDP

PROC InfoDialogue:(aTitle$,aLine1$,aLine2$)
LOCAL Title$(KMaxStringLen%),Text$(KMaxStringLen%)
LOCAL choice%
IF aTitle$="Error"
  dINIT "Error"
  dTEXT "",ERRX$,KdTextCentre%
  dTEXT "",ERR$(ERR),KdTextCentre%
  GOTO LBL_Dialog::
ELSEIF aTitle$=""
  Title$="Note"
ELSE
  Title$=aTitle$
ENDIF
Text$=aLine1$
IF aLine2$<>""
  Text$=Text$+NewLine$:+aLine2$
ENDIF
dINIT Title$
IF Text$<>""
  dTEXT "",Text$
ENDIF
LBL_Dialog::
dBUTTONS "Close",KKeyEnter%
LOCK ON :choice%=DIALOG :LOCK OFF
ENDP

PROC NewLine$:
IF KSymbianOsVersion$="v5/Eikon"
  RETURN CHR$($0a) // ASCII
ELSE
  RETURN CHR$(KLineFeed&) // Unicode
ENDIF
ENDP

PROC GetMachineType&:
LOCAL value&,return&
value&=0
return&=SyGetHAL&:(KSyMachineUID&,value&)
RETURN value&
ENDP

PROC GetMachineName$:
LOCAL value&
IF KSymbianOsVersion$="v5/Eikon"
  RETURN MachineName$:
ENDIF
value&=GetMachineType&:
IF value&=&10005f62 // KSyMachineUid_Win32Emulator&
  RETURN "Win32 ER6 Emulator"
ELSEIF value&=&10005e33 // KSyMachineUid_Linda&
  RETURN "Nokia 9200 Series"
ELSEIF value&=&1000118a // KSyMachineUid_Series5mx&
  RETURN "Psion Series 5mx"
ELSE
  RETURN "unknown"
ENDIF
ENDP

dpNote 0029

1 June 2003

v6 Series 60
v6 Series 80 R1

Key event codes for Series 60 phones

Compared to OPL for v6.0 Series 80, your Const.oph for Series 60 development will need some additional key event codes. A few existing ones also deserve some additional comments.

// Key constants (for 32-bit keywords like GETEVENT32)
CONST K32BitKeywordLimit&=&f000

CONST KKeyPageLeft&=&f802     // WINS only
CONST KKeyPageRight&=&f803    // WINS only
CONST KKeyPageUp&=&f804       // WINS only
CONST KKeyPageDown&=&f805     // WINS only
CONST KKeyEdit&=&f806         // Series 60 only
CONST KKeyLeftArrow&=&f807    // Series 80 and 60
CONST KKeyRightArrow&=&f808   // Series 80 and 60
CONST KKeyUpArrow&=&f809      // Series 80 and 60
CONST KKeyDownArrow&=&f80a    // Series 80 and 60
// For the command button array
CONST KKeyCBA1&=&f842         // Series 80 and 60 (Left CBA)
CONST KKeyCBA2&=&f843         // Series 80 and 60 (Right CBA)
CONST KKeyCBA3&=&f844         // Series 80 and WINS
CONST KKeyCBA4&=&f845         // Series 80 and 60 (Select CBA)
// Special keys
CONST KKeySidebarMenu&=&f700  // WINS configured as in dpNote 0010 only
CONST KKeyZoomIn&=&f703       // WINS only
CONST KKeyZoomOut&=&f704      // WINS only
CONST KKeyMenu&=&f836         // Series 80 and WINS
CONST KKeyHelp&=&f83a         // Series 80 and WINS
CONST KKeyApplications&=&f852 // Series 60 only
CONST KKeySend&=&f862         // Series 60 only
CONST KKeyEndSend&=&f863      // Series 60 only
CONST KKeyBrightness&=&f864   // Series 80 only

// the Clear-key or [C]-key is actually Unicode Backspace
CONST KKeyBackspace&=&0008    // Series 80 and 60 (Clear)
CONST KKeyClear&=KKeyBackspace&

// The numeric keys including '*' and '#' follow Unicode values just like
// in Series 80 phones
CONST KKeyHash&=&0023
CONST KKeyNumberSign&=KKeyHash&
CONST KKeyStar&=&002a
CONST KKeyAsterisk&=KKeyStar&
CONST KKey_0&=&0030
CONST KKey_1&=&0031

CONST KKey_2&=&0032
CONST KKey_3&=&0033
CONST KKey_4&=&0034
CONST KKey_5&=&0035
CONST KKey_6&=&0036
CONST KKey_7&=&0037
CONST KKey_8&=&0038
CONST KKey_9&=&0039

Take note of the consistent use of KKeyCBA4& as the Select-key for both Series 60 and Series 80 usage and style guide.

Disclaimer: At the time of writing, OPL for Series 60 has reached v0.25 Alpha. With the continued development of OPL for Series 60 phones additions and amendments will likely be made to this dpNote. Most likely, for instance, in the future a Series 60 WINS console will be able to simulate additional Series 60 keypresses.

dpNote 0030

14 May 2007

All OPL versions

Returning more than one value

Yes, it is possible to return more than one value from a procedure. The technique is used in numerous places in dpNotes. Let's summarise it here.

1. When calling a procedure, pass all values by reference, i.e. pass their pointers, instead of by value.
2. The called procedure should be programmed to receive values passed by reference and convert them into values.
3. Before leaving the procedure, the values passed by reference need to be stored back to their original pointers.

As noted in dpNote 0012, we use the "_'" to denote a pointer to a value passed by reference.

PROC ProcedureWithSeveralReturnValues:(_Byte&,_Short&,_Long&,_Float&,_String&)
LOCAL Byte%,Short%,Long&,FloatF,String$(KMaxStringLen%)
// load in BYREF values
Byte%=PEEKB(_Byte&)
Short%=PEEKW(_Short&)
Long&+PEEKL(_Long&)
FloatF=PEEKF(_Float&)

String$=PEEK$(_String&)
// do something with these values
Byte%=Byte%*2
Short%=Short%/2+Byte%
Long&=Long&/2+Short%
FloatF=FloatF+Long&/1.5
String$=String$+GEN$(Float,6)
// return BYREF values
POKEB _Byte&,Byte%
POKEW _Short&,Short%
POKEL _Long&,Long&
POKEF _Float&,FloatF
POKE$ _String&,String$
RETURN

PROC CallingProcedure:
LOCAL Byte%,Short%,Long&,FloatF,String$(KMaxStringLen%)
Byte%=$04
Short%=$0100
Long&=&00100000
FloatF=100.45
String$="Result: "
ProcedureWithSeveralReturnValues:(ADDR(Byte%),ADDR(Short%),ADDR(Long&),ADDR(FloatF),ADDR(String$))
PRINT Byte%
PRINT Short%
PRINT Long&
PRINT FloatF
PRINT String$
ENDP

Having now shown how this works, it would have been much nicer if it had been possible to use the '@' character for obtaining pointers rather than ADDR(). Then we could have written:

ProcedureWithSeveralReturnValues:(@Byte%,@Short%,@Long&,@FloatF,@String$)

Links to other OPL developer resources http://www.opl32.com/Menu_Fiches.htm - even if you cannot read French, this site offers a number of very good OPL for Symbian OS v5 related notes. It is not updated very often though.
http://www.allaboutopl.com/wiki/OPLWikiHome - this site has the purpose of being the central Documents and Reference site for OPL, in particular for Symbian OS v6.0 and later. It is a Wiki site, meaning that anyone can register and contribute to the OPL projects.