-lh0-ҙ4Src\Rkrm\Console\AskKeymap.e<-> AskKeymap.e ->>> Header (globals) MODULE 'devices/console', 'devices/conunit', 'devices/keymap', 'exec/io', 'exec/memory', 'exec/ports' ENUM ERR_NONE, ERR_DEV, ERR_IO, ERR_PORT RAISE ERR_DEV IF OpenDevice()<>0, ERR_IO IF CreateIORequest()=NIL, ERR_PORT IF CreateMsgPort()=NIL ->>> ->>> PROC main() PROC main() HANDLE DEF consoleMP:PTR TO mp, consoleIO:PTR TO iostd, keymap:PTR TO keymap, i, j, prt, dev_open=FALSE -> Release 2 (V36) or a later version of the OS is required KickVersion(36) -> Create the message port consoleMP:=CreateMsgPort() -> Create the IORequest consoleIO:=CreateIORequest(consoleMP, SIZEOF iostd) -> Open Console device OpenDevice('console.device', CONU_LIBRARY, consoleIO, 0) dev_open:=TRUE -> Allocate memory for the keymap keymap:=NewM(SIZEOF keymap, MEMF_PUBLIC OR MEMF_CLEAR) -> Device opened, send query command to it consoleIO.length:=SIZEOF keymap -> Where to put it consoleIO.data:=keymap consoleIO.command:=CD_ASKKEYMAP IF DoIO(consoleIO) -> Inform user that CD_ASKKEYMAP failed WriteF('CD_ASKKEYMAP failed. Error - \d\n', consoleIO.error) ELSE -> Print values for top row of keyboard prt:=keymap.lokeymap WriteF('Result of CD_ASKKEYMAP for top row of keyboard\n\n' + '\tShift\n' + '\tAlt\tAlt\tShift\tNo Qualifier\n') FOR j:=0 TO 13 FOR i:=0 TO 3 DO WriteF('\t\c', prt[]++) WriteF('\n') ENDFOR ENDIF EXCEPT DO IF keymap THEN Dispose(keymap) IF dev_open THEN CloseDevice(consoleIO) IF consoleIO THEN DeleteIORequest(consoleIO) IF consoleMP THEN DeleteMsgPort(consoleMP) SELECT exception CASE ERR_DEV; WriteF('Error: could not open console device\n') CASE ERR_IO; WriteF('Error: could not create I/O\n') CASE ERR_PORT; WriteF('Error: could not create port\n') CASE "MEM"; WriteF('Error: ran out of memory\n') ENDSELECT ENDPROC ->>> .-lh0-ҙ4Src\Rkrm\Console\consoled,x*H. <'"<$N:JfpNu,ЂN|/NTNv)FN&@JfA\NA\N)@A)H` M )HNqNqNq)NA)HCXp!N)@gCXp!N)@gC(p!N)@g,@N)@N)@)O`0dos.libraryintuition.librarygraphics.libraryNN .lJg,l",(tvN"N,x$l g"J *$RN. f"lNb"lNb"lNb&,g N|"CN$,N\ <'"_ON. NuNUH m (.,G"mNpLN]NuNU/-Hx0aON]NuNU/-aON]NuNUHp+@/,/,/,)OAf)H)M - JgD/-/<N"O+@p mAA@ - mA1@ - mA!@)_)_)_B -LN]NuNU -Jg2p mAA p mA!@p m!@/-NOpN]NuNUHp+@p+@/,/,/,)OA)H)Mp,lN+@Hx"/<N"O+@ - mA!@ - mA@ p mA@p m@ - m@2|,lN m!@ - Jg"m,lN` mA /NbO -)_)_)_`J)_)_)_`8 -g/-NO - g -,lNp`pLN]NuNU mA ( Jg"m,lNp m!@p mA O mp(/@,lLN/-NOpN]NuNU -X m p m!@ - m!@pN]Nup)@p)@p)@p)@p)@p)@a &a)@NuNUHp+@p+@O4+OBW/<B/,/,/,)OA)H)Mp/A/HxaO)@" fHxa Op//,Hx0aO)@" fHxa Op/AQ/HxaNO)@" fHxa nOp//,Hx0aJO)@" fHxa @OOA `4 l d-/@,lLN4)@/,/,/,aNO p)@/,A_/a>O/-A /OA .A /@Hxa O/,/-aO/,A/aOr2,lN:/,A/aOr2,lN:/,A/aOr2,lN:/,AW/aOr2,lN:/,A /aO/,A/alO/,A/aZOHx lp(/aO+@Hx l hVp(/apO+@ -gO -䀭/@,lLN+@ -JgRp//,A /apfA1/HxaO`pfA/HxaOpLN]NuNUH - m!@( < m!@$Ap"mr,lNDJg /<aH. m ( m !@ m ( m !@ LN]NuNU"m,lN>N]NuNUp m 1@ -/A `"A m !@(p m !@$"m ,lN8pN]NuNUp m1@ - m!@( - m!@$"m,lN8pN]NuNUp m 1@ - m !@(p m !@$"m ,lN8pN]NuNUp m 1@ - m !@(p m !@$"m ,lN2pN]NuNUHp/ m ,lN." fp` mp,//-aO LN]Nuconsole.deviceError: could not create port Error: could not create I/O Error: could not open console device Received: hex $%02.2lx Received: hex $%02.2lx = %lc === Control Seq === Type some keys. Close window when done. Now reading console We will now delete this asterisk =*=%s%sHere's some text in color 3 and italics Here's some normal text Console TestRKM.console.readRKM.console.writetNuNuJgFC / wE2,x&l$ N", BJf&C&S,lN & NuNuA*"$<,lN)@)@Jfp)@ lNCON:0/11/640/80/Output / wCEB,x&l$ N"B / w $Hp0($SgQR@@5B"H NuNu /"/Nu /g QC"g$I"Af )$,xN.Nu)o ,g @.l*l)_)_)_N lN /"/P$,xN:Jg @ !B)@PNu)|MEM ,g @.l*l)_)_)_N lNNu T( 0-lh0-qqҙ4Src\Rkrm\Console\Console.e:-> Console.e -> -> Example of opening a window and using the console device to send text and -> control sequences to it. The example can be easily modified to do -> additional control sequences. ->>> Header (globals) OPT PREPROCESS MODULE 'devices/console', 'exec/io', 'exec/ports', 'intuition/intuition', 'intuition/screens', 'amigalib/io', 'amigalib/ports' ENUM ERR_NONE, ERR_DEV, ERR_IO, ERR_PORT RAISE ERR_DEV IF OpenDevice()<>0 -> Note - using two character ESC[. Hex 9B could be used instead #define RESETCON '\ec' #define CURSOFF '\e[0 p' #define CURSON '\e[ p' #define DELCHAR '\e[P' -> SGR (set graphic rendition) #define COLOR02 '\e[32m' #define COLOR03 '\e[33m' #define ITALICS '\e[3m' #define BOLD '\e[1m' #define UNDERLINE '\e[4m' #define NORMAL '\e[0m' DEF win=NIL:PTR TO window, writeReq=NIL:PTR TO iostd, writePort=NIL:PTR TO mp, readReq=NIL:PTR TO iostd, readPort=NIL:PTR TO mp, openedConsole=FALSE ->>> ->>> PROC main() PROC main() HANDLE DEF winmsg:PTR TO intuimessage, signals, conreadsig, windowsig, lch, inControl=0, going=TRUE, ch, ibuf, obuf[200]:STRING, error, class -> Create reply port and io block for writing to console IF NIL=(writePort:=createPort('RKM.console.write', 0)) THEN Raise(ERR_PORT) IF NIL=(writeReq:=createExtIO(writePort, SIZEOF iostd)) THEN Raise(ERR_IO) -> Create reply port and io block for reading from console IF NIL=(readPort:=createPort('RKM.console.read', 0)) THEN Raise(ERR_PORT) IF NIL=(readReq:=createExtIO(readPort, SIZEOF iostd)) THEN Raise(ERR_IO) -> Open a window win:=OpenWindow([10, 10, 620, 180, -1, -1, IDCMP_CLOSEWINDOW, WFLG_DEPTHGADGET OR WFLG_SIZEGADGET OR WFLG_DRAGBAR OR WFLG_CLOSEGADGET OR WFLG_SMART_REFRESH OR WFLG_ACTIVATE, NIL, NIL, 'Console Test', NIL, NIL, 100, 45, 640, 200, WBENCHSCREEN]:nw) -> Now, attach a console to the window openConsole(writeReq, readReq, win) openedConsole:=TRUE -> Demonstrate some console escape sequences conPuts(writeReq, 'Here''s some normal text\n') StringF(obuf, '\s\sHere''s some text in color 3 and italics\n', COLOR03, ITALICS) conPuts(writeReq, obuf) conPuts(writeReq, NORMAL) Delay(50) -> Delay for dramatic effect conPuts(writeReq, 'We will now delete this asterisk =*=') Delay(50) conPuts(writeReq, {bspace}) -> Backspace twice Delay(50) conPuts(writeReq, DELCHAR) -> Delete the character Delay(50) queueRead(readReq, {ibuf}) -> Send the first console read request conPuts(writeReq, '\n\nNow reading console\n') conPuts(writeReq, 'Type some keys. Close window when done.\n\n') conreadsig:=Shl(1, readPort.sigbit) windowsig:=Shl(1, win.userport.sigbit) WHILE going -> A character, or an IDCMP msg, or both could wake us up signals:=Wait(conreadsig OR windowsig) -> If a console signal was received, get the character IF signals AND conreadsig IF -1<>(lch:=conMayGetChar(readPort, {ibuf})) ch:=lch -> Show hex and ascii (if printable) for char we got. If you want to -> parse received control sequences, such as function or Help keys, -> you would buffer control sequences as you receive them, starting to -> buffer whenever you receive $9B (or $1B[ for user-typed sequences) -> and ending when you receive a valid terminating character for the -> type of control sequence you are receiving. For CSI sequences, -> valid terminating characters are generally $40 through $7E. In our -> example, InControl has the following values: 0 = no, 1 = have $1B, -> 2 = have $9B OR $1B and [, 3 = now inside control sequence, -> -1 = normal end esc, -2 = non-CSI(no [) $1B end esc -> NOTE - a more complex parser is required to recognize other types -> of control sequences. -> $1B ESC not followed by "[", is not CSI seq IF inControl=1 THEN (inControl:=IF ch="[" THEN 2 ELSE -2) IF (ch=$9B) OR (ch=$1B) -> Control seq starting inControl:=IF ch=$1B THEN 1 ELSE 2 conPuts(writeReq, '=== Control Seq ===\n') ENDIF -> We'll show the value of this char we received IF ((ch>=$1F) AND (ch<=$7E)) OR (ch>=$A0) StringF(obuf, 'Received: hex $\z\h[2] = \c\n', ch, ch) ELSE StringF(obuf, 'Received: hex $\z\h[2]\n', ch) ENDIF conPuts(writeReq, obuf) ENDIF ENDIF -> If IDCMP messages received, handle them IF signals AND windowsig -> We have to ReplyMsg these when done with them WHILE winmsg:=GetMsg(win.userport) class:=winmsg.class SELECT class CASE IDCMP_CLOSEWINDOW going:=FALSE ENDSELECT ReplyMsg(winmsg) ENDWHILE ENDIF ENDWHILE -> We always have an outstanding queued read request so we must abort it if -> it hasn't completed, and we must remove it. IF CheckIO(readReq)=FALSE THEN AbortIO(readReq) WaitIO(readReq) -> Clear it from our replyport EXCEPT DO IF openedConsole THEN closeConsole(writeReq) IF win THEN CloseWindow(win) IF readReq THEN deleteExtIO(readReq) IF readPort THEN deletePort(readPort) IF writeReq THEN deleteExtIO(writeReq) IF writePort THEN deletePort(writePort) SELECT exception CASE ERR_DEV; WriteF('Error: could not open console device\n') CASE ERR_IO; WriteF('Error: could not create I/O\n') CASE ERR_PORT; WriteF('Error: could not create port\n') ENDSELECT ENDPROC -> E-Note: simple way to get a string with two backspaces bspace: CHAR 8, 8, 0 ->>> ->>> PROC openConsole(writereq:PTR TO iostd, readReq:PTR TO iostd, window) -> Attach console device to an open Intuition window. -> E-Note: This function will raise an exception if the console device is not -> opened correctly. PROC openConsole(writereq:PTR TO iostd, readreq:PTR TO iostd, window) DEF error writereq.data:=window writereq.length:=SIZEOF window error:=OpenDevice('console.device', 0, writereq, 0) readreq.device:=writereq.device -> Clone required parts readreq.unit:=writereq.unit ENDPROC error ->>> ->>> PROC closeConsole(writereq) PROC closeConsole(writereq) IS CloseDevice(writereq) ->>> ->>> PROC conPutChar(writereq:PTR TO iostd, char) -> Output a single character to a specified console. PROC conPutChar(writereq:PTR TO iostd, char) writereq.command:=CMD_WRITE -> E-Note: use typed list to get address of the CHAR in the LONG 'char' writereq.data:=[char]:CHAR writereq.length:=1 DoIO(writereq) -> Command works because DoIO blocks until command is done (otherwise -> pointer to string could become invalid in the meantime). ENDPROC ->>> ->>> PROC conWrite(writereq:PTR TO iostd, string, length) -> Output a stream of known length to a console. PROC conWrite(writereq:PTR TO iostd, string, length) writereq.command:=CMD_WRITE writereq.data:=string writereq.length:=length DoIO(writereq) ENDPROC ->>> ->>> PROC conPuts(writereq:PTR TO iostd, string) -> Output a NIL-terminated string of characters to a console. PROC conPuts(writereq:PTR TO iostd, string) writereq.command:=CMD_WRITE writereq.data:=string writereq.length:=-1 -> This means print until terminating NIL DoIO(writereq) ENDPROC ->>> ->>> PROC queueRead(readreq:PTR TO iostd, whereto) -> Queue up a read request to console, passing it pointer to a buffer into -> which it can read the character PROC queueRead(readreq:PTR TO iostd, whereto) readreq.command:=CMD_READ readreq.data:=whereto readreq.length:=1 SendIO(readreq) ENDPROC ->>> ->>> PROC conMayGetChar(msgport, whereto) -> Check if a character has been received. If none, return -1 PROC conMayGetChar(msgport, whereto) DEF temp, readreq:PTR TO iostd IF NIL=(readreq:=GetMsg(msgport)) THEN RETURN -1 temp:=whereto[] -> Get the character... queueRead(readreq, whereto) -> ...then re-use the request block ENDPROC temp ->>> @-lh0-UU*Src\Rkrm\Exec_Library\DeviceIO\deviceuse.e-> DeviceUse.e - an example of using an Amiga device (here, serial device) -> - attempt to create a message port with createPort() (from amigalib) -> - attempt to create the I/O request with ereateExtIO() (from amigalib) -> - attempt to open the serial device with Exec OpenDevice() -> -> If successful, use the serial command SDCMD_QUERY, then reverse our steps. -> If we encounter an error at any time, we will gracefully exit. Note that -> applications which require at least V37 OS should use the Exec functions -> CreateMsgPort()/DeleteMsgPort() and CreateIORequest()/DeleteIORequest() -> instead of the similar amigalib functions which are used in this example. OPT PREPROCESS MODULE 'amigalib/io', 'amigalib/ports', 'devices/serial', 'exec/io', 'exec/ports' ENUM ERR_NONE, ERR_DEV, ERR_IO, ERR_PORT RAISE ERR_DEV IF OpenDevice()<>0 PROC main() HANDLE DEF serialMP=NIL:PTR TO mp, serialIO=NIL:PTR TO ioextser, reply:PTR TO ioextser -> Create the message port. IF NIL=(serialMP:=createPort(NIL,NIL)) THEN Raise(ERR_PORT) -> Create the I/O request. Note that 'devices/serial' defines the type of -> io required by the serial device--an ioextser. Many devices require -> specialised extended IO requests which start with an embedded io object. -> E-Note: ignore the rubbish about casting IF NIL=(serialIO:=createExtIO(serialMP, SIZEOF ioextser)) THEN Raise(ERR_IO) -> Open the serial device (non-zero return value means failure here). OpenDevice(SERIALNAME, 0, serialIO, 0) -> Device is open serialIO.iostd.command:=SDCMD_QUERY -> DoIO - demonstrates synchronous device use, returns error or 0. IF DoIO(serialIO) WriteF('Query failed. Error - \d\n', serialIO.iostd.error) ELSE -> Print serial device status - see include file for meaning. -> Note that with DoIO, the Wait and GetMsg are done by Exec. WriteF('Serial device status: $\h\n\n', serialIO.status) ENDIF serialIO.iostd.command:=SDCMD_QUERY -> SendIO - demonstrates asynchronous device use (returns immediately). SendIO(serialIO) -> We could do other things here while the query is being done. And to -> manage our asynchronous device IO: -> - we can CheckIO(serialIO) to check for completion -> - we can AbortIO(serialIO) to abort the command -> - we can WaitPort(serialMP) to wait for any serial port reply -> OR we can WaitIO(serialIO) to wait for this specific IO request -> OR we can Wait(Shl(1, serialMP.sigbit)) for reply port signal Wait(Shl(1, serialMP.sigbit)) WHILE reply:=GetMsg(serialMP) -> Since we sent out only one serialIO request the while loop is not -> really needed--we only expect one reply to our one query command, and -> the reply message pointer returned by GetMsg() will just be another -> pointer to our one serialIO request. With Wait() or WaitPort(), you -> must GetMsg() the message. IF reply.iostd.error WriteF('Query failed. Error - \d\n', reply.iostd.error) ELSE WriteF('Serial device status: $\h\n\n', reply.status) ENDIF ENDWHILE CloseDevice(serialIO) -> Close the serial device. EXCEPT DO IF serialIO THEN deleteExtIO(serialIO) -> Delete the I/O request. IF serialMP THEN deletePort(serialMP) -> Delete the message port. SELECT exception CASE ERR_DEV; WriteF('Error: \s did not open\n', SERIALNAME) -> Inform user that the I/O request could be created. CASE ERR_IO; WriteF('Error: Could not create I/O request\n') -> Inform user that the message port could not be created. CASE ERR_PORT; WriteF('Error: Could not create message port\n') ENDSELECT ENDPROC <-lh0-&Src\Rkrm\Exec_Library\Interrupts\rbf.e6-> rbf.e - Serial receive buffer full interrupt handler example. -> -> To receive characters, this example requires ASCII serial input at your -> Amiga's current serial hardware baud rate (i.e., 9600 after reboot, else -> last baud rate used). -> E-Note: E does not (as of v3.1a) support Resources in the conventional way MODULE 'other/ecode', 'other/misc', 'dos/dos', 'exec/execbase', 'exec/interrupts', 'exec/nodes', 'exec/memory', 'hardware/custom', 'hardware/intbits', 'resources/misc' ENUM ERR_NONE, ERR_BITS, ERR_ECODE, ERR_PORT, ERR_SIG RAISE ERR_SIG IF AllocSignal()=-1 CONST BUFFERSIZE=256, NAMESIZE=32 CONST ALLOCEDBUFFER=BUFFERSIZE+2 OBJECT rbfData task signal bufferCount -> E-Note: C version disagrees with Assembly handler! charBuffer[ALLOCEDBUFFER]:ARRAY flagBuffer[ALLOCEDBUFFER]:ARRAY name[NAMESIZE]:ARRAY ENDOBJECT -> E-Note: set-up "custom" DEF custom=CUSTOMADDR:PTR TO custom PROC main() HANDLE -> E-Note: to help with cleaning up, currentuser has been replaced by -> portuser and bitsuser, both initialised to non-zero DEF allocname, rbfdata=NIL:PTR TO rbfData, portuser=-1, bitsuser=-1, signr=-1, serdevice, rbfint=NIL:PTR TO is, priorint:PTR TO is, priorenable, signal, exec:PTR TO execbase -> E-Note: get the right type for execbase exec:=execbase allocname:='rbf-example' miscbase:=OpenResource('misc.resource') -> Allocate the serial port registers. IF portuser:=allocMiscResource(MR_SERIALPORT, allocname) -> Hey! Someone's got it! WriteF('serial hardware allocated by \s. Trying to remove it\n', portuser) Forbid() IF serdevice:=FindName(exec.devicelist, portuser) THEN RemDevice(serdevice) Permit() IF portuser:=allocMiscResource(MR_SERIALPORT, allocname) -> And try again -> E-Note: error if still allocated Raise(ERR_PORT) ENDIF ENDIF -> Get the serial control bits. (Give up if allocated.) IF bitsuser:=allocMiscResource(MR_SERIALBITS, allocname) THEN Raise(ERR_BITS) -> Got them both WriteF('serial hardware allocated\n') -> Allocate a signal bit for the interrupt handler to signal us. signr:=AllocSignal(-1) rbfint:=NewM(SIZEOF is, MEMF_PUBLIC OR MEMF_CLEAR) rbfdata:=NewM(SIZEOF rbfData, MEMF_PUBLIC OR MEMF_CLEAR) rbfdata.task:=FindTask(NIL) -> Init rbfdata object rbfdata.signal:=Shl(1, signr) rbfint.ln.type:=NT_INTERRUPT -> Init interrupt node. -> E-Note: copy *safely* to rbfdata.name AstrCopy(rbfdata.name, allocname, NAMESIZE) rbfint.ln.name:=rbfdata.name rbfint.data:=rbfdata rbfint.code:=eCodeIntHandler({rbfHandler}) IF rbfint.code=NIL THEN Raise(ERR_ECODE) -> Save state of RBF and interrupt disable it. priorenable:=custom.intenar AND INTF_RBF custom.intena:=INTF_RBF IF priorint:=SetIntVector(INTB_RBF, rbfint) WriteF('replaced the \s RBF interrupt handler\n', priorint.ln.name) ENDIF WriteF('enabling RBF interrupt\n') custom.intena:=INTF_SETCLR OR INTF_RBF WriteF('waiting for buffer to fill up. Use CTRL-C to break\n') signal:=Wait(Shl(1, signr) OR SIGBREAKF_CTRL_C) IF signal AND SIGBREAKF_CTRL_C THEN WriteF('>break<\n') WriteF('Character buffer contains:\n\s\n', rbfdata.charBuffer) custom.intena:=INTF_RBF -> Restore previous handler. SetIntVector(INTB_RBF, priorint) -> Enable it if it was enabled before. IF priorenable THEN custom.intena:=INTF_SETCLR OR INTF_RBF EXCEPT DO -> E-Note: these next two aren't really necessary IF rbfdata THEN Dispose(rbfdata) IF rbfint THEN Dispose(rbfint) IF signr<>-1 THEN FreeSignal(signr) -> Release serial hardware IF bitsuser=NIL THEN freeMiscResource(MR_SERIALBITS) IF portuser=NIL THEN freeMiscResource(MR_SERIALPORT) -> There is no 'CloseResource()' function SELECT exception CASE ERR_BITS; WriteF('Serial control already allocated by \s\n', bitsuser) CASE ERR_ECODE; WriteF('Ran out of memory in eCodeIntHandler()\n') CASE ERR_PORT; WriteF('Serial hardware already allocated by \s\n', portuser) CASE ERR_SIG; WriteF('Can''t allocate signal\n') CASE "MEM"; WriteF('Ran out of memory\n') ENDSELECT ENDPROC -> Note - This simple handler just receives one buffer full of serial -> input data, signals main, then ignores all subsequent serial data. -> E-Note: we could use Assembly, but we'll show how to use an E PROC -> E-Note: you get rbfint.data as first arg, interrupt flags as second PROC rbfHandler(data:PTR TO rbfData, intflags) DEF input IF data.bufferCount timersoftint.e - Timer device software interrupt message port example. -> E-Note: we need eCodeSoftInt() in order to execute E code as an interrupt MODULE 'amigalib/io', 'amigalib/lists', 'other/ecode', 'devices/timer', 'dos/dos', 'exec/interrupts', 'exec/io', 'exec/memory', 'exec/nodes', 'exec/ports' ENUM ERR_NONE, ERR_DEVICE, ERR_ECODE, ERR_TIMER RAISE ERR_DEVICE IF OpenDevice()<>0 CONST MICRO_DELAY=1000 ENUM OFF, ON, STOPPED OBJECT tsiData counter flag port:PTR TO mp ENDOBJECT DEF tsidata=NIL:PTR TO tsiData PROC main() HANDLE DEF port=NIL:PTR TO mp, softint=NIL:PTR TO is, tr:PTR TO timerequest, endcount, code -> Allocate message port, data and interrupt objects. Don't use createPort() -> or CreateMsgPort() since they allocate a signal (don't need that) for a -> PA_SIGNAL type port. We need PA_SOFTINT. tsidata:=NewM(SIZEOF tsiData, MEMF_PUBLIC OR MEMF_CLEAR) port:=NewM(SIZEOF mp, MEMF_PUBLIC OR MEMF_CLEAR) newList(port.msglist) -> Initialise message list softint:=NewM(SIZEOF is, MEMF_PUBLIC OR MEMF_CLEAR) -> Set up the (software) interrupt structure. Note that this task runs at -> priority 0. Software interrupts may only be priority -32, -16, 0, +16, -> +32. Also not that the correct node type for a software interrupt is -> NT_INTERRUPT. (NT_SOFTINT is an internal Exec flag). This is the same -> setup as that for a software interrupt which you Cause(). -> E-Note: We can initialise data here to contain a pointer to shared data -> structures. The interrupt routine will receive the data in A1. -> E-Note: eCodeSoftInt() protects an E function and preserves non-scratch -> registers so you can call it from, for instance, interrupts. IF NIL=(code:=eCodeSoftInt({tsoftcode})) THEN Raise(ERR_ECODE) softint.code:=code -> The software interrupt routine softint.data:=tsidata softint.ln.pri:=0 port.ln.type:=NT_MSGPORT -> Set up the PA_SOFTINT message port (no need to port.flags:=PA_SOFTINT -> make this port public). port.sigtask:=softint -> Pointer to interrupt object -> Allocate timerequest IF NIL=(tr:=createExtIO(port, SIZEOF timerequest)) THEN Raise(ERR_TIMER) -> Open timer.device. 0 is success OpenDevice('timer.device', UNIT_MICROHZ, tr, 0) tsidata.flag:=ON -> Init data structure to share globally. tsidata.port:=port -> Send of the first timerequest to start. IMPORTANT: Do NOT beginIO() to -> any device other than audio or timer from within a software or hardware -> interrupt. The beginIO() code may allocate memory, wait or perform other -> functions which are illegal or dangerous during interrupts. WriteF('starting softint. CTRL-C to break...\n') tr.io.command:=TR_ADDREQUEST -> Initial iorequest to start tr.time.micro:=MICRO_DELAY -> software interrupt beginIO(tr) Wait(SIGBREAKF_CTRL_C) endcount:=tsidata.counter WriteF('timer softint counted \d milliseconds.\n', endcount) WriteF('Stopping timer...\n') tsidata.flag:=OFF WHILE tsidata.flag<>STOPPED DO Delay(10) CloseDevice(tr) EXCEPT DO IF tr THEN deleteExtIO(tr) IF softint THEN Dispose(softint) IF port THEN Dispose(port) IF tsidata THEN Dispose(tsidata) SELECT exception CASE ERR_DEVICE; WriteF('Couldn''t open timer.device\n') CASE ERR_ECODE; WriteF('Ran out of memory in eCodeSoftInt()\n') CASE ERR_TIMER; WriteF('Couldn''t create timerequest\n') CASE "MEM"; WriteF('Ran out of memory\n') ENDSELECT ENDPROC PROC tsoftcode(data) DEF tr:PTR TO timerequest -> E-Note: thanks to eCodeSoftInt() we get the softint.data as an argument, -> so we could use that instead of the global tsidata. This means -> that tsidata could be made local to main()... -> Remove the message from the port. tr:=GetMsg(tsidata.port) -> Keep on going if main() hasn't set flag to OFF. IF tr AND (tsidata.flag=ON) -> Increment counter and re-send timerequest -- IMPORTANT: This -> self-perpetuating technique of calling beginIO() during a software -> interrupt may only be used with the audio and timer device. tsidata.counter:=tsidata.counter+1 tr.io.command:=TR_ADDREQUEST tr.time.micro:=MICRO_DELAY beginIO(tr) ELSE -> Tell main() we're out of here. tsidata.flag:=STOPPED ENDIF ENDPROC >Z-lh0-pp(Src\Rkrm\Exec_Library\Interrupts\vertb.e-> vertb.e - Vertical blank interrupt server example. -> E-Note: we need eCodeSoftInt() in order to execute E code as an interrupt -> (this wouldn't be needed if we just used Assembly, see below) MODULE 'other/ecode', 'dos/dos', 'exec/interrupts', 'exec/memory', 'exec/nodes', 'hardware/intbits' ENUM ERR_NONE, ERR_ECODE PROC main() HANDLE DEF vbint:PTR TO is, counter=0, endcount -> Allocate memory for interrupt node. vbint:=NewM(SIZEOF is, MEMF_PUBLIC OR MEMF_CLEAR) vbint.ln.type:=NT_INTERRUPT -> Initialise the node. vbint.ln.pri:=-60 vbint.ln.name:='VertB-Example' vbint.data:={counter} vbint.code:=eCodeIntServer({vertBServer}) IF vbint.code=NIL THEN Raise(ERR_ECODE) AddIntServer(INTB_VERTB, vbint) -> Kick this interrupt server into life. WriteF('VBlank server will increment a counter every frame.\n') WriteF('counter started at zero, CTRL-C to remove server\n') Wait(SIGBREAKF_CTRL_C) endcount:=counter WriteF('\d vertical blanks occurred\nRemoving server\n', endcount) RemIntServer(INTB_VERTB, vbint) EXCEPT DO -> E-Note: not really necessary... IF vbint THEN Dispose(vbint) SELECT exception CASE ERR_ECODE; WriteF('Error: Ran out of memory in eCodeIntServer()\n') CASE "MEM"; WriteF('Error: Ran out of memory\n') ENDSELECT ENDPROC -> Entered with: A0 == scratch (execpt for highest pri vertb server) -> D0 == scratch A1 == is_Data -> D1 == scratch A5 == vector to interrupt code (scratch) -> A6 == scratch -> -> E-Note: we could use this Assembly, but we'll show how to use a PROC instead -> (so we needed eCodeIntServer() above) -> -> vertBServer: -> ADDI.L #1, (A1) -> Increments counter is_Data points to -> MOVEQ.L #0, D0 -> Set Z flag to continue to process other vb-servers -> RTS -> Return to exec -> E-Note: we get vbint.data as an argument, and the PROC result should be -> zero to continue with other servers in this chain (the default), -> or non-zero (e.g., RETURN TRUE) to skip them PROC vertBServer(data:PTR TO LONG) data[]:=data[]+1 ENDPROC=-lh0- SW'Src\Rkrm\Exec_Library\Lists\buildlist.e-> buildlist.e - Example which uses an application-specific Exec list MODULE 'amigalib/lists', 'exec/lists', 'exec/nodes' CONST DATASIZE=62 OBJECT nameNode ln:ln -> System Node structure data[DATASIZE]:ARRAY -> Node-specific data ENDOBJECT CONST NAMENODE_ID=100 -> The type of 'nameNode' PROC main() HANDLE DEF nameList=NIL:PTR TO lh -> Note that a mlh would also work NEW nameList newList(nameList) -> Important: prepare header for use addName(nameList, 'Name7'); addName(nameList, 'Name6') addName(nameList, 'Name5'); addName(nameList, 'Name4') addName(nameList, 'Name2'); addName(nameList, 'Name0') addName(nameList, 'Name7'); addName(nameList, 'Name5') addName(nameList, 'Name3'); addName(nameList, 'Name1') displayName(nameList, 'Name5') displayNameList(nameList) EXCEPT DO IF nameList -> E-Note: none of this is necessary, since the program is terminating -> and the memory will be freed automatically freeNameNodes(nameList) END nameList -> Free list header ENDIF SELECT exception CASE "MEM"; WriteF('Error: Out of memory\n') ENDSELECT ENDPROC -> Allocate a NameNode structure, copy the given name into the structure, then -> add it the specified list. This example does not provide an error return -> for the out of memory condition. -> E-Note: ...instead it raises an exception which is handled by the caller PROC addName(list, name) DEF namenode:PTR TO nameNode NEW namenode -> E-Note: copy *safely* to namenode.data AstrCopy(namenode.data, name, DATASIZE) namenode.ln.name:=namenode.data namenode.ln.type:=NAMENODE_ID namenode.ln.pri:=0 AddHead(list, namenode) ENDPROC -> Free the entire list, including the header. The header is not updated as -> the list is freed. This function demonstrates how to avoid referencing -> freed memory when deallocating nodes. PROC freeNameNodes(list:PTR TO lh) DEF worknode:PTR TO nameNode, nextnode worknode:=list.head -> First node WHILE nextnode:=worknode.ln.succ END worknode worknode:=nextnode ENDWHILE ENDPROC -> Print the names of each node in a list. PROC displayNameList(list:PTR TO lh) DEF node:PTR TO ln IF list.tailpred=list WriteF('List is empty.\n') ELSE node:=list.head WHILE node.succ WriteF('$\h -> \s\n', node, node.name) node:=node.succ ENDWHILE ENDIF ENDPROC -> Print the location of all nodes with a specified name. PROC displayName(list, name) DEF node:PTR TO ln IF node:=FindName(list,name) WHILE node WriteF('Found a \s at location $\h\n', node.name, node) node:=FindName(node, name) ENDWHILE ELSE WriteF('No node with name \s found.\n', name) ENDIF ENDPROC =Q-lh0-'Src\Rkrm\Exec_Library\Memory\allocate.e-> allocate.e - Example of allocating and using a private memory pool. MODULE 'exec/memory', 'exec/nodes' CONST BLOCKSIZE=4000 -> Or whatever you need PROC main() HANDLE DEF mh=NIL:PTR TO mh, mc=NIL:PTR TO mc, block1, block2 -> Get the MemHeader needed to keep track of our new block. NEW mh -> Get the actual block the above MemHeader will manage. mc:=NewR(BLOCKSIZE) mh.ln.type:=NT_MEMORY mh.first:=mc mh.lower:=mc mh.upper:=mc+BLOCKSIZE mh.free:=BLOCKSIZE mc.next:=NIL -> Set up first chunk in the freelist mc.bytes:=BLOCKSIZE block1:=Allocate(mh, 20) block2:=Allocate(mh, 314) WriteF('Our mh object at $\h. Our block of memory at $\h\n', mh, mc) WriteF('Allocated from our pool: block1 at $\h, block2 at $\h\n', block1, block2) EXCEPT DO -> E-Note: the freeing is not necessary, since the program is terminating IF mc THEN Dispose(mc) IF mh THEN END mh SELECT exception CASE "MEM"; WriteF('Error: Ran out of memory\n') ENDSELECT ENDPROC ?-lh0-)Src\Rkrm\Exec_Library\Memory\allocentry.eR-> allocentry.e - Example of allocating several memory areas. MODULE 'exec/memory' CONST ALLOCERROR=$80000000 -> E-Note: like the Assembly version, a ml does not contain a me, so body[4] OBJECT memBlocks head:ml -> One entry in the header, additional entries follow body[4]:ARRAY OF me -> directly as part of the same data structure ENDOBJECT DEF memlist:PTR TO ml, -> Pointer to a ml object memblocks:memBlocks PROC main() memblocks.head.numentries:=4 -> E-Note: The ml does not contain another me! -> Describe the first piece of memory we want. -> E-Note: every me is in the body, unlike the C version memblocks.body[0].reqs:=MEMF_CLEAR memblocks.body[0].length:=4000 -> Describe the other pieces of memory we want. Additional me's are -> initialised this way. If we wanted even more entries, we would need to -> declare a larger me array in our memBlocks object. memblocks.body[1].reqs:=MEMF_CHIP OR MEMF_CLEAR memblocks.body[1].length:=100000 memblocks.body[2].reqs:=MEMF_PUBLIC OR MEMF_CLEAR memblocks.body[2].length:=200000 memblocks.body[3].reqs:=MEMF_PUBLIC memblocks.body[3].length:=25000 memlist:=AllocEntry(memblocks) IF memlist AND ALLOCERROR -> 'error' bit 31 is set (see below). WriteF('AllocEntry FAILED\n') ENDIF -> We got all memory we wanted. Use it and call FreeEntry() to free it WriteF('AllocEntry succeeded - now freeing all allocated blocks\n') FreeEntry(memlist) ENDPROC 9-lh0-__x~#Src\Rkrm\Exec_Library\Ports\port1.eͿ-> port1.e - Port and message example, run at the same time as port2.e MODULE 'amigalib/ports', 'dos/dos', 'exec/ports' ENUM ERR_NONE, ERR_PORT OBJECT xyMessage msg:mn x:INT y:INT ENDOBJECT PROC main() HANDLE DEF xyport=NIL:PTR TO mp, xymsg:PTR TO xyMessage, portsig, usersig, signal, abort=FALSE IF NIL=(xyport:=createPort('xyport', 0)) THEN Raise(ERR_PORT) portsig:=Shl(1, xyport.sigbit) usersig:=SIGBREAKF_CTRL_C -> Give user a 'break' signal. WriteF('Start port2 in another shell. CTRL-C here when done.\n') -> port1 will wait forever and reply to messages, until the user breaks REPEAT signal:=Wait(portsig OR usersig) -> Since we only have one port that might get messages we have to reply -> to, it is not really necessary to test for the portsignal. If there -> is not a message at the port, xymsg simply will be NIL. IF signal AND portsig WHILE xymsg:=GetMsg(xyport) WriteF('port1 received: x = \d y = \d\n', xymsg.x, xymsg.y) xymsg.x:=xymsg.x+50 -> Since we have not replied yet to the owner of xymsg.y:=xymsg.y+50 -> xymsg, we can change the data contents of xymsg. WriteF('port1 replying with: x = \d y = \d\n', xymsg.x, xymsg.y) ReplyMsg(xymsg) ENDWHILE ENDIF IF signal AND usersig -> The user wants to abort. abort:=TRUE ENDIF UNTIL abort EXCEPT DO IF xyport -> Make sure the port is empty. WHILE xymsg:=GetMsg(xyport) DO ReplyMsg(xymsg) deletePort(xyport) ENDIF SELECT exception CASE ERR_PORT; WriteF('Couldn''t create "xyport"\n') ENDSELECT ENDPROC 9-lh0-t t ~#Src\Rkrm\Exec_Library\Ports\port2.eS-> port2.e - Port and message example, run at the same time as port1.e MODULE 'amigalib/ports', 'dos/dos', 'exec/memory', 'exec/nodes', 'exec/ports' ENUM ERR_NONE, ERR_FINDPORT, ERR_CREATEPORT OBJECT xyMessage msg:mn x:INT y:INT ENDOBJECT PROC main() HANDLE DEF xyreplyport=NIL:PTR TO mp, xymsg=NIL:PTR TO xyMessage, reply:PTR TO xyMessage -> Using createPort() with no name because this port need not be public. IF NIL=(xyreplyport:=createPort(NIL, 0)) THEN Raise(ERR_CREATEPORT) xymsg:=NewM(SIZEOF xyMessage, MEMF_PUBLIC OR MEMF_CLEAR) xymsg.msg.ln.type:=NT_MESSAGE -> Make up a message, including the xymsg.msg.length:=SIZEOF xyMessage -> reply port. xymsg.msg.replyport:=xyreplyport xymsg.x:=10 -> Our special message information xymsg.y:=20 WriteF('Sending to port1: x = \d y = \d\n', xymsg.x, xymsg.y) -> port2 will simply try to put one message to port1, wait for the reply, -> and then exit IF FALSE=safePutToPort(xymsg, 'xyport') THEN Raise(ERR_FINDPORT) WaitPort(xyreplyport) IF reply:=GetMsg(xyreplyport) -> We don't ReplyMsg since WE initiated the message. WriteF('Reply contains: x = \d y = \d\n', xymsg.x, xymsg.y) ENDIF -> Since we only use this private port for receiving replies, and we sent -> only one and got one reply there is no need to cleanup. For a public port, -> or if you pass a pointer to the port to another process, it is a very -> good habit to always handle all messages at the port before you delete it. EXCEPT DO IF xymsg THEN Dispose(xymsg) -> E-Note: not really necessary IF xyreplyport THEN deletePort(xyreplyport) SELECT exception CASE ERR_CREATEPORT WriteF('Couldn''t create "xyreplyport"\n') CASE ERR_FINDPORT WriteF('Can''t find "xyport"; start port1 in a separate shell\n') CASE "MEM" WriteF('Couldn''t get memory\n') ENDSELECT ENDPROC PROC safePutToPort(message, portname) DEF port:PTR TO mp Forbid() port:=FindPort(portname) IF port THEN PutMsg(port, message) Permit() -> Once we've done a Permit(), the port might go away and leave us with an -> invalid port address. So we return just a boolean to indicate whether -> the message has been sent or not. -> E-Note: Be careful - if FindPort() automatically raised an exception -> you might forget to Permit()! ENDPROC port<>NIL -> FALSE if the port was not found B-lh0-"",Src\Rkrm\Exec_Library\Semaphores\semaphore.en-> semaphore.e - Exec semaphore example MODULE 'exec/semaphores' PROC main() DEF lockSemaphore:ss InitSemaphore(lockSemaphore) ObtainSemaphore(lockSemaphore) -> Task now owns the semaphore. -> ... ReleaseSemaphore(lockSemaphore) -> Task has released the semaphore. ENDPROC =6-lh0-- - kd'Src\Rkrm\Exec_Library\Signals\signals.e-> signals.e -> E-Note: eCodeTask() protects an E function so you can call it from other -> tasks and have access to the global variables of this program MODULE 'amigalib/tasks', 'other/ecode', 'dos/dos' ENUM ERR_NONE, ERR_ECODE, ERR_SIG, ERR_TASK RAISE ERR_SIG IF AllocSignal()=-1 DEF mainsignum=-1, mainsig, wakeupsigs, maintask=NIL, subtask=NIL PROC main() HANDLE DEF done=FALSE, waitingForSubtask=TRUE, ecode, subtaskname subtaskname:='RKM_signal_subtask' -> We must allocate any special signals we want to receive. mainsignum:=AllocSignal(-1) mainsig:=Shl(1, mainsignum) -> subtask can access this global maintask:=FindTask(NIL) -> subtask can access this global WriteF('We alloc a signal, create a task, wait for signals\n') IF NIL=(ecode:=eCodeTask({subtaskcode})) THEN Raise(ERR_ECODE) IF NIL=(subtask:=createTask(subtaskname, 0, ecode, 2000)) THEN Raise(ERR_TASK) WriteF('After subtask signals, press CTRL-C or CTRL-D to exit\n') REPEAT -> Wait on the combined mask for all of the signals we are interested in. -> All processes have the CTRL_C thru CTRL_F signals. We're also Waiting -> on the mainsig we allocated for our subtask to signal us with. We could -> also Wait on the signals of any ports/windows our main task created... wakeupsigs:=Wait(mainsig OR SIGBREAKF_CTRL_C OR SIGBREAKF_CTRL_D) -> Deal with all signals that woke us up - may be more than one IF wakeupsigs AND mainsig WriteF('Signalled by subtask\n') waitingForSubtask:=FALSE -> OK to kill subtask now ENDIF IF wakeupsigs AND SIGBREAKF_CTRL_C WriteF('Got CTRL-C signal\n') done:=TRUE ENDIF IF wakeupsigs AND SIGBREAKF_CTRL_D WriteF('Got CTRL-D signal\n') done:=TRUE ENDIF UNTIL done AND (waitingForSubtask=FALSE) EXCEPT DO IF subtask Forbid() deleteTask(subtask) Permit() ENDIF IF mainsignum<>-1 THEN FreeSignal(mainsignum) SELECT exception CASE ERR_SIG; WriteF('No signals available\n') CASE ERR_TASK; WriteF('Can''t create subtask\n') CASE ERR_ECODE; WriteF('Ran out of memory in eCodeTask()\n') ENDSELECT ENDPROC PROC subtaskcode() Signal(maintask, mainsig) Wait(NIL) -> Safe state in which this subtask can be deleted ENDPROC verstag: CHAR 0, '$VER: signals 37.1 (28.3.91)', 0 >X-lh0-Dd(Src\Rkrm\Exec_Library\Tasks\simpletask.e-> simpletask.e - Uses the amigalib function createTask() to create a simple -> subtask. See the Includes and Autodocs manual for createTask() source code. MODULE 'amigalib/tasks', 'other/ecode', 'dos/dos' ENUM ERR_NONE, ERR_ECODE, ERR_TASK CONST STACK_SIZE=1000 -> Task name, pointers for allocated task struct and stack DEF task=NIL, simpletaskname, sharedvar PROC main() HANDLE DEF taskcode simpletaskname:='SimpleTask' sharedvar:=0 -> E-Note: eCodeTask() protects an E function so you can call it from other -> tasks and have access to the global variables of this program IF NIL=(taskcode:=eCodeTask({simpletask})) THEN Raise(ERR_ECODE) IF NIL=(task:=createTask(simpletaskname, 0, taskcode, STACK_SIZE)) Raise(ERR_TASK) ENDIF WriteF('This program initialised a variable to zero, then started a\n') WriteF('separate task which is incrementing that variable right now,\n') WriteF('while this program waits for you to press RETURN.\n') WriteF('Press RETURN now: ') -> E-Note: WriteF() opens a window if necessary, so use stdout if no stdin Inp(IF stdin THEN stdin ELSE stdout) WriteF('The shared variable now equals \d\n', sharedvar) EXCEPT DO IF task -> We can simply remove the task we added because our simpletask does -> not make any system calls which could cause it to be awakened or -> signalled later. Forbid() deleteTask(task) Permit() ENDIF SELECT exception CASE ERR_ECODE; WriteF('Ran out of memory in eCodeTask()\n') CASE ERR_TASK; WriteF('Can''t create task\n') ENDSELECT ENDPROC IF exception<>ERR_NONE THEN RETURN_FAIL ELSE RETURN_OK PROC simpletask() WHILE sharedvar<$8000000 DO sharedvar++ -> Wait forever because main() is going to RemTask() us Wait(NIL) ENDPROC <-lh0-g g aW&Src\Rkrm\Exec_Library\Tasks\tasklist.eo-> tasklist.e - Snapshots and prints the ExecBase task list MODULE 'amigalib/lists', 'exec/execbase', 'exec/lists', 'exec/nodes', 'exec/tasks' CONST NAMELEN=32 -> Use extended structure to hold task information OBJECT taskNode ln:ln taskaddress sigalloc sigwait name[NAMELEN]:ARRAY ENDOBJECT PROC main() HANDLE DEF ourtasklist:PTR TO lh, task:PTR TO tc, node:PTR TO taskNode, tnode:PTR TO taskNode, rnode, exec:PTR TO execbase -> E-Note: get the right type for execbase exec:=execbase -> Allocate memory for out list NEW ourtasklist -> Initialise list structure (ala newList()) -> E-Note: so why not use newList()!?! newList(ourtasklist) -> Make sure tasks won't switch lists or go away Disable() -> Snapshot task WAIT list snapshot(exec.taskwait, ourtasklist) -> Snapshot task READY list -> E-Note: rnode will be first READY task rnode:=snapshot(exec.taskready, ourtasklist) -> Re-enable interrupts and taskswitching Enable() -> Print now (printing above would have defeated a Forbid or Disable) WriteF('Pri Address SigAlloc SigWait Taskname\n') node:=ourtasklist.head WriteF('\nWAITING:\n') WHILE tnode:=node.ln.succ IF tnode=rnode THEN WriteF('\nREADY:\n') -> We set rnode above WriteF('\z\d[2] \z$\h[8] \z$\h[8] \z$\h[8] \s\n', node.ln.pri, node.taskaddress, node.sigalloc, node.sigwait, node.name) -> E-Note: ignore the messy clean up - see exception handler node:=tnode ENDWHILE -> Say who we are WriteF('\nTHIS TASK:\n') task:=FindTask(NIL) WriteF('\z\d[2] \z$\h[8] \z$\h[8] \z$\h[8] \s\n', task.ln.pri, task, task.sigalloc, task.sigwait, task.ln.name) EXCEPT DO IF ourtasklist -> E-Note: none of this is necessary, since the program is terminating node:=ourtasklist.head WHILE tnode:=node.ln.succ END node node:=tnode ENDWHILE END ourtasklist ENDIF SELECT exception CASE "MEM"; WriteF('Error: Ran out of memory\n') ENDSELECT ENDPROC -> E-Note: having a separate procedure avoids repeating all this code as well -> as localising any exception from NEW PROC snapshot(from:PTR TO lh, to:PTR TO lh) HANDLE -> E-Note: we are really dealing with "tc" (task) nodes not "ln" nodes DEF exectask:PTR TO tc, tnode:PTR TO taskNode, first=NIL exectask:=from.head WHILE exectask.ln.succ NEW tnode -> Save task information we want to print -> E-Note: copy *safely* to tnode.name AstrCopy(tnode.name, exectask.ln.name, NAMELEN) tnode.ln.pri:=exectask.ln.pri tnode.taskaddress:=exectask tnode.sigalloc:=exectask.sigalloc tnode.sigwait:=exectask.sigwait AddTail(to, tnode) IF first=NIL THEN first:=tnode -> E-Note: first task copied exectask:=exectask.ln.succ ENDWHILE EXCEPT DO ENDPROC first versTag: CHAR 0, '$VER: tasklist 37.2 (31.3.92)', 0 8-lh0-YYI"Src\Rkrm\Exec_Library\Tasks\trap.e<-> trap.e - E example of sample integer divide-by-zero trap MODULE 'exec/tasks' DEF oldTrapCode, countdiv0 PROC main() DEF thistask:PTR TO tc, k, j, z thistask:=FindTask(NIL) -> Save our task's current trap code pointer oldTrapCode:=thistask.trapcode -> Point task to our assembler trap handler code. Ours will just count -> divide-by-zero traps, and pass other traps on to the normal TrapCode. thistask.trapcode:={trapa} countdiv0:=0 z:=0 -> E-Note: the E compiler will not allow an explicit "k/0"! FOR k:=0 TO 3 -> Let's divide by zero a few times WriteF('dividing \d by zero... ', k) j:=k/z WriteF('did it\n') ENDFOR WriteF('\nDivide by zero happened \d times\n', countdiv0) thistask.trapcode:=oldTrapCode -> Restore old trap code ENDPROC trapa: -> Our trap handler entry CMPI.L #5, (A7) -> Is this a divide by zero ? BNE.S notdiv0 -> No ADD.L #1, countdiv0 -> Yes, increment our div0 count endtrap: ADDQ #4, A7 -> Remove exception number from SSP RTE -> Return from exception notdiv0: TST.L oldTrapCode -> Is there another trap handler ? BEQ.S endtrap -> No, so we'll exit MOVE.L oldTrapCode, -(A7) -> Yes, go on to old TrapCode RTS -> Jumps to old TrapCode 5-lh0-I I ҙ4Src\Rkrm\Expansion\findboards.e-> findboards.e ->>> Header (globals) OPT PREPROCESS MODULE 'expansion', 'libraries/configregs', 'libraries/configvars' ENUM ERR_NONE, ERR_LIB RAISE ERR_LIB IF OpenLibrary()=NIL -> E-Note: used to convert an INT to unsigned #define UNSIGNED(x) ((x) AND $FFFF) -> E-Note: used to convert a LONG to unsigned CHAR #define UNSIGNEDCHAR(x) ((x) AND $FF) ->>> ->>> PROC main() PROC main() HANDLE DEF myCD:PTR TO configdev, m, i, p, f, t expansionbase:=OpenLibrary('expansion.library', 0) -> FindConfigDev(oldConfigDev,manufacturer,product) -> oldConfigDev = NIL for the top of the list -> manufacturer = -1 for any manufacturer -> product = -1 for any product myCD:=NIL WHILE myCD:=FindConfigDev(myCD, -1, -1) -> Search for all ConfigDevs WriteF('\n---ConfigDev structure found at location $\h---\n', myCD) -> These values were read directly from the board at expansion time WriteF('Board ID (ExpansionRom) information:\n') t:=myCD.rom.type m:=UNSIGNED(myCD.rom.manufacturer) p:=myCD.rom.product f:=myCD.rom.flags i:=UNSIGNED(myCD.rom.initdiagvec) WriteF('er_Manufacturer =\d=$\z\h[4]=(~$\h[4])\n', m, m, UNSIGNED(Not(m))) WriteF('er_Product =\d=$\z\h[2]=(~$\h[2])\n', p, p, UNSIGNEDCHAR(Not(p))) WriteF('er_Type =$\z\h[2]', myCD.rom.type) IF myCD.rom.type AND ERTF_MEMLIST WriteF(' (Adds memory to free list)\n') ELSE WriteF('\n') ENDIF WriteF('er_Flags =$\z\h[2]=(~$\h[2])\n', f, UNSIGNEDCHAR(Not(f))) WriteF('er_InitDiagVec =$\z\h[4]=(~$\h[4])\n', i, UNSIGNED(Not(i))) -> These values are generated when the AUTOCONFIG(tm) software relocates -> the board WriteF('Configuration (ConfigDev) information:\n') WriteF('cd_BoardAddr =$\h\n', myCD.boardaddr) WriteF('cd_BoardSize =$\h (\dK)\n', myCD.boardsize, myCD.boardsize/1024) WriteF('cd_Flags =$\h', myCD.flags) IF myCD.flags AND CDF_CONFIGME WriteF('\n') ELSE WriteF(' (driver clears CONFIGME bit)\n') ENDIF ENDWHILE EXCEPT DO IF expansionbase THEN CloseLibrary(expansionbase) SELECT exception CASE ERR_LIB; WriteF('Error: could not open expansion library\n') ENDSELECT ENDPROC ->>> 9X-lh0-++`#Src\Rkrm\GadTools\gadtoolsgadgets.e-> gadtoolsgadgets.e -> Simple example of using a number of gadtools gadgets. MODULE 'gadtools', 'exec/ports', 'graphics/text', 'intuition/intuition', 'intuition/screens', 'libraries/gadtools' ENUM ERR_NONE, ERR_FONT, ERR_GAD, ERR_KICK, ERR_LIB, ERR_PUB, ERR_VIS, ERR_WIN RAISE ERR_FONT IF OpenFont()=NIL, ERR_GAD IF CreateGadgetA()=NIL, ERR_KICK IF KickVersion()=FALSE, ERR_LIB IF OpenLibrary()=NIL, ERR_PUB IF LockPubScreen()=NIL, ERR_VIS IF GetVisualInfoA()=NIL, ERR_WIN IF OpenWindowTagList()=NIL -> Gadget ENUM to be used as GadgetIDs and also as the indexes into the -> gadget array my_gads[]. ENUM MYGAD_SLIDER, MYGAD_STRING1, MYGAD_STRING2, MYGAD_STRING3, MYGAD_BUTTON -> Range for the slider: CONST SLIDER_MIN=1, SLIDER_MAX=20 DEF topaz80 -> Function to handle a GADGETUP or GADGETDOWN event. For GadTools gadgets, -> it is possible to use this function to handle MOUSEMOVEs as well, with -> little or no work. -> E-Note: slider_level is not a 'PTR TO INT', but 'PTR TO LONG' PROC handleGadgetEvent(win, gad:PTR TO gadget, code, slider_level:PTR TO LONG, my_gads:PTR TO LONG) DEF id id:=gad.gadgetid SELECT id CASE MYGAD_SLIDER -> Sliders report their level in the IntuiMessage Code field: WriteF('Slider at level \d\n', code) slider_level[]:=code CASE MYGAD_STRING1 -> String gadgets report GADGETUP's WriteF('String gadget 1: "\s".\n', gad.specialinfo::stringinfo.buffer) CASE MYGAD_STRING2 -> String gadgets report GADGETUP's WriteF('String gadget 2: "\s".\n', gad.specialinfo::stringinfo.buffer) CASE MYGAD_STRING3 -> String gadgets report GADGETUP's WriteF('String gadget 3: "\s".\n', gad.specialinfo::stringinfo.buffer) CASE MYGAD_BUTTON -> Buttons report GADGETUP's (button resets slider to 10) WriteF('Button was pressed, slider reset to 10.\n') slider_level[]:=10 Gt_SetGadgetAttrsA(my_gads[MYGAD_SLIDER], win, NIL, [GTSL_LEVEL, slider_level[], NIL]) ENDSELECT ENDPROC -> Function to handle vanilla keys. -> E-Note: slider_level is not a 'PTR TO INT', but 'PTR TO LONG' PROC handleVanillaKey(win, code, slider_level:PTR TO LONG, my_gads:PTR TO LONG) SELECT "w" OF code CASE "v" -> Increase slider level, but not past maximum slider_level[]:=Min(slider_level[]+1, SLIDER_MAX) Gt_SetGadgetAttrsA(my_gads[MYGAD_SLIDER], win, NIL, [GTSL_LEVEL, slider_level[], NIL]) CASE "V" -> Decrease slider level, but not past maximum slider_level[]:=Max(slider_level[]-1, SLIDER_MIN) Gt_SetGadgetAttrsA(my_gads[MYGAD_SLIDER], win, NIL, [GTSL_LEVEL, slider_level[], NIL]) CASE "c", "C" -> Button resets slider to 10 slider_level[]:=10 Gt_SetGadgetAttrsA(my_gads[MYGAD_SLIDER], win, NIL, [GTSL_LEVEL, slider_level[], NIL]) CASE "f", "F" ActivateGadget(my_gads[MYGAD_STRING1], win, NIL) CASE "s", "S" ActivateGadget(my_gads[MYGAD_STRING2], win, NIL) CASE "t", "T" ActivateGadget(my_gads[MYGAD_STRING3], win, NIL) ENDSELECT ENDPROC -> Here is where all the initialisation and creation of GadTools gadgets take -> place. This function requires a pointer to a NIL-initialised gadget list -> pointer. It returns a pointer to the last created gadget. -> E-Note: exceptions raised by CreateGadgetA() will be handled by caller PROC createAllGadgets(glistptr:PTR TO LONG, vi, topborder, slider_level, my_gads:PTR TO LONG) DEF gad, ng:PTR TO newgadget -> All the gadget creation calls accept a pointer to the previous gadget, and -> link the new gadget to that gadget's NextGadget field. Also, they exit -> gracefully, returning NIL, if any previous gadget was NIL. This limits -> the amount of checking for failure that is needed. You only need to check -> before you tweak any gadget structure or use any of its fields, and -> finally once at the end, before you add the gadgets. -> The following operation is required of any program that uses GadTools. -> It gives the toolkit a place to stuff context data. gad:=CreateContext(glistptr) -> Since the NewGadget structure is unmodified by any of the CreateGadgetA() -> calls, we need only change those fields which are different. ng:=[140, (20+topborder), 200, 12, '_Volume: ', topaz80, MYGAD_SLIDER, NG_HIGHLABEL, vi, 0]:newgadget my_gads[MYGAD_SLIDER]:=(gad:=CreateGadgetA(SLIDER_KIND, gad, ng, [GTSL_MIN, SLIDER_MIN, GTSL_MAX, SLIDER_MAX, GTSL_LEVEL, slider_level, GTSL_LEVELFORMAT, '\d[2]', GTSL_MAXLEVELLEN, 2, GT_UNDERSCORE, "_", NIL])) ng.topedge := ng.topedge+20 ng.height := 14 ng.gadgettext := '_First:' ng.gadgetid := MYGAD_STRING1 my_gads[MYGAD_STRING1]:=(gad:=CreateGadgetA(STRING_KIND, gad, ng, [GTST_STRING, 'Try pressing', GTST_MAXCHARS, 50, GT_UNDERSCORE, "_", NIL])) ng.topedge := ng.topedge+20 ng.gadgettext := '_Second:' ng.gadgetid := MYGAD_STRING2 my_gads[MYGAD_STRING2]:=(gad:=CreateGadgetA(STRING_KIND, gad, ng, [GTST_STRING, 'TAB or Shift-TAB', GTST_MAXCHARS, 50, GT_UNDERSCORE, "_", NIL])) ng.topedge := ng.topedge+20 ng.gadgettext := '_Third:' ng.gadgetid := MYGAD_STRING3 my_gads[MYGAD_STRING3]:=(gad:=CreateGadgetA(STRING_KIND, gad, ng, [GTST_STRING, 'To see what happens!', GTST_MAXCHARS, 50, GT_UNDERSCORE, "_", NIL])) ng.leftedge := 50 ng.topedge := 20 ng.width := 100 ng.height := 12 ng.gadgettext := '_Click Here' ng.gadgetid := MYGAD_BUTTON ng.flags := 0 gad:=CreateGadgetA(BUTTON_KIND, gad, ng, [GT_UNDERSCORE, "_", NIL]) ENDPROC gad -> Standard message handling loop with GadTools message handling functions -> used (Gt_GetIMsg() and Gt_ReplyIMsg()). -> E-Note: slider_level is not a 'PTR TO INT', but 'PTR TO LONG' PROC process_window_events(mywin:PTR TO window, slider_level:PTR TO LONG, my_gads:PTR TO LONG) DEF imsg:PTR TO intuimessage, imsgClass, imsgCode, gad, terminated=FALSE REPEAT Wait(Shl(1, mywin.userport.sigbit)) -> Gt_GetIMsg() returns an IntuiMessage with more friendly information for -> complex gadget classes. Use it wherever you get IntuiMessages where -> using GadTools gadgets. WHILE (terminated=FALSE) AND (imsg:=Gt_GetIMsg(mywin.userport)) -> Presuming a gadget, of course, but no harm... Only dereference this -> value (gad) where the Class specifies that it is a gadget event. gad:=imsg.iaddress imsgClass:=imsg.class imsgCode:=imsg.code -> Use the toolkit message-replying function here... Gt_ReplyIMsg(imsg) SELECT imsgClass -> --- WARNING --- WARNING --- WARNING --- WARNING --- WARNING --- -> GadTools puts the gadget address into IAddress of IDCMP_MOUSEMOVE -> messages. This is NOT true for standard Intuition messages, -> but is an added feature of GadTools. CASE IDCMP_GADGETDOWN handleGadgetEvent(mywin, gad, imsgCode, slider_level, my_gads) CASE IDCMP_MOUSEMOVE handleGadgetEvent(mywin, gad, imsgCode, slider_level, my_gads) CASE IDCMP_GADGETUP handleGadgetEvent(mywin, gad, imsgCode, slider_level, my_gads) CASE IDCMP_VANILLAKEY handleVanillaKey(mywin, imsgCode, slider_level, my_gads) CASE IDCMP_CLOSEWINDOW terminated:=TRUE CASE IDCMP_REFRESHWINDOW -> With GadTools, the application must use Gt_BeginRefresh() -> where it would normally have used BeginRefresh() Gt_BeginRefresh(mywin) Gt_EndRefresh(mywin, TRUE) ENDSELECT ENDWHILE UNTIL terminated ENDPROC -> Prepare for using GadTools, set up gadgets and open window. -> Clean up and when done or on error. PROC gadtoolsWindow() HANDLE DEF font=NIL, mysc=NIL:PTR TO screen, mywin=NIL, glist=NIL, my_gads[4]:ARRAY OF LONG, vi, slider_level=5, topborder -> Open topaz 8 font, so we can be sure it's openable when we later -> set ng.textattr to Topaz80: topaz80:=['topaz.font', 8, 0, 0]:textattr font:=OpenFont(topaz80) mysc:=LockPubScreen(NIL) vi:=GetVisualInfoA(mysc, [NIL]) -> Here is how we can figure out ahead of time how tall the window's -> title bar will be: topborder:=mysc.wbortop+mysc.font.ysize+1 createAllGadgets({glist}, vi, topborder, slider_level, my_gads) mywin:=OpenWindowTagList(NIL, [WA_TITLE, 'GadTools Gadget Demo', WA_GADGETS, glist, WA_AUTOADJUST, TRUE, WA_WIDTH, 400, WA_MINWIDTH, 50, WA_INNERHEIGHT, 140, WA_MINHEIGHT, 50, WA_DRAGBAR, TRUE, WA_DEPTHGADGET, TRUE, WA_ACTIVATE, TRUE, WA_CLOSEGADGET, TRUE, WA_SIZEGADGET, TRUE, WA_SIMPLEREFRESH, TRUE, WA_IDCMP, IDCMP_CLOSEWINDOW OR IDCMP_REFRESHWINDOW OR IDCMP_VANILLAKEY OR SLIDERIDCMP OR STRINGIDCMP OR BUTTONIDCMP, WA_PUBSCREEN, mysc, NIL]) -> After window is open, gadgets must be refreshed with a call to the -> GadTools refresh window function. Gt_RefreshWindow(mywin, NIL) process_window_events(mywin, {slider_level}, my_gads) EXCEPT DO IF mywin THEN CloseWindow(mywin) -> FreeGadgets() even if createAllGadgets() fails, as some of the gadgets may -> have been created... If glist is NIL then FreeGadgets() will do nothing. FreeGadgets(glist) IF vi THEN FreeVisualInfo(vi) IF mysc THEN UnlockPubScreen(mysc, NIL) IF font THEN CloseFont(font) ReThrow() -> E-Note: pass on exception if it was an error ENDPROC -> Open all libraries and run. Clean up when finished or on error.. PROC main() HANDLE KickVersion(37) gadtoolsbase:=OpenLibrary('gadtools.library', 37) gadtoolsWindow() EXCEPT DO IF gadtoolsbase THEN CloseLibrary(gadtoolsbase) SELECT exception CASE ERR_FONT; WriteF('Error: Failed to open Topaz 80\n') CASE ERR_GAD; WriteF('Error: createAllGadgets() failed\n') CASE ERR_KICK; WriteF('Error: Requires V37\n') CASE ERR_LIB; WriteF('Error: Requires V37 gadtools.library\n') CASE ERR_PUB; WriteF('Error: Couldn''t lock default public screen\n') CASE ERR_VIS; WriteF('Error: GetVisualInfoA() failed\n') CASE ERR_WIN; WriteF('Error: OpenWindow() failed\n') ENDSELECT ENDPROC 6-lh0-  z Src\Rkrm\GadTools\gadtoolsmenu.eF-> gadtoolsmenu.e -> Example showing the basic usage of the menu system with a window. -> Menu layout is done with GadTools, as is recommended for applications. OPT PREPROCESS MODULE 'gadtools', 'intuition/intuition', 'libraries/gadtools' ENUM ERR_NONE, ERR_LIB, ERR_MENU, ERR_VIS, ERR_WIN RAISE ERR_LIB IF OpenLibrary()=NIL, ERR_MENU IF CreateMenusA()=NIL, ERR_VIS IF GetVisualInfoA()=NIL, ERR_WIN IF OpenWindowTagList()=NIL -> E-Note: used to convert an INT to unsigned #define UNSIGNED(x) ((x) AND $FFFF) -> Watch the menus and wait for the user to select the close gadget or quit -> from the menus. PROC handle_window_events(win, menuStrip) DEF done=FALSE, menuNumber, menuNum, itemNum, subNum, item:PTR TO menuitem, class REPEAT -> E-Note: we can use WaitIMessage in this example class:=WaitIMessage(win) SELECT class CASE IDCMP_CLOSEWINDOW done:=TRUE CASE IDCMP_MENUPICK -> E-Note: convert message code to an unsigned INT menuNumber:=UNSIGNED(MsgCode()) WHILE (menuNumber<>MENUNULL) AND (done=FALSE) item:=ItemAddress(menuStrip, menuNumber) -> Process the item here! menuNum:=MENUNUM(menuNumber) itemNum:=ITEMNUM(menuNumber) subNum:=SUBNUM(menuNumber) -> Stop if quit is selected IF (menuNum=0) AND (itemNum=5) THEN done:=TRUE -> E-Note: convert item.nextselect to an unsigned INT menuNumber:=UNSIGNED(item.nextselect) ENDWHILE ENDSELECT UNTIL done ENDPROC -> Open all of the required libraries and set-up the menus PROC main() HANDLE DEF win=NIL:PTR TO window, my_VisualInfo=NIL, menuStrip=NIL gadtoolsbase:=OpenLibrary('gadtools.library', 37) win:=OpenWindowTagList(NIL, [WA_WIDTH, 400, WA_ACTIVATE, TRUE, WA_HEIGHT, 100, WA_CLOSEGADGET, TRUE, WA_TITLE, 'Menu Test Window', WA_IDCMP, IDCMP_CLOSEWINDOW OR IDCMP_MENUPICK, NIL]) my_VisualInfo:=GetVisualInfoA(win.wscreen, [NIL]) menuStrip:=CreateMenusA([NM_TITLE, 0, 'Project', 0, 0, 0, 0, NM_ITEM, 0, 'Open...', 'O', 0, 0, 0, NM_ITEM, 0, 'Save', 'S', 0, 0, 0, NM_ITEM, 0, NM_BARLABEL, 0, 0, 0, 0, NM_ITEM, 0, 'Print', 0, 0, 0, 0, NM_SUB, 0, 'Draft', 0, 0, 0, 0, NM_SUB, 0, 'NLQ', 0, 0, 0, 0, NM_ITEM, 0, NM_BARLABEL, 0, 0, 0, 0, NM_ITEM, 0, 'Quit...', 'Q', 0, 0, 0, NM_TITLE, 0, 'Edit', 0, 0, 0, 0, NM_ITEM, 0, 'Cut', 'X', 0, 0, 0, NM_ITEM, 0, 'Copy', 'C', 0, 0, 0, NM_ITEM, 0, 'Paste', 'V', 0, 0, 0, NM_ITEM, 0, NM_BARLABEL, 0, 0, 0, 0, NM_ITEM, 0, 'Undo', 'Z', 0, 0, 0, NM_END, 0, NIL, 0, 0, 0, 0]:newmenu, [NIL]) IF LayoutMenusA(menuStrip, my_VisualInfo, [NIL]) IF SetMenuStrip(win, menuStrip) handle_window_events(win, menuStrip) ClearMenuStrip(win) ENDIF FreeMenus(menuStrip) ENDIF EXCEPT DO IF my_VisualInfo THEN FreeVisualInfo(my_VisualInfo) IF win THEN CloseWindow(win) IF gadtoolsbase THEN CloseLibrary(gadtoolsbase) SELECT exception CASE ERR_LIB; WriteF('Error: Could not open gadtools.library\n') CASE ERR_MENU; WriteF('Error: Could not create menu\n') CASE ERR_VIS; WriteF('Error: Could not get visual info\n') CASE ERR_WIN; WriteF('Error: Could not open window\n') ENDSELECT ENDPROC8-lh0-z"Src\Rkrm\GadTools\simplegtgadget.e-> simplegtgadget.e - Simple example of a GadTools gadget. OPT OSVERSION=37 MODULE 'gadtools', 'exec/ports', 'graphics/text', 'intuition/intuition', 'intuition/screens', 'libraries/gadtools' ENUM ERR_NONE, ERR_GAD, ERR_LIB, ERR_PUB, ERR_VIS, ERR_WIN RAISE ERR_GAD IF CreateGadgetA()=NIL, ERR_LIB IF OpenLibrary()=NIL, ERR_PUB IF LockPubScreen()=NIL, ERR_VIS IF GetVisualInfoA()=NIL, ERR_WIN IF OpenWindowTagList()=NIL CONST MYGAD_BUTTON=4 -> Open all libraries and run. Clean up when finished or on error.. PROC main() HANDLE gadtoolsbase:=OpenLibrary('gadtools.library', 37) gadtoolsWindow() EXCEPT DO IF gadtoolsbase THEN CloseLibrary(gadtoolsbase) SELECT exception CASE ERR_GAD; WriteF('Error: Could not create gadget\n') CASE ERR_LIB; WriteF('Error: Could not open gadtools.library\n') CASE ERR_PUB; WriteF('Error: Could not lock public screen\n') CASE ERR_VIS; WriteF('Error: Could not get visual info\n') CASE ERR_WIN; WriteF('Error: Could not open window\n') ENDSELECT ENDPROC -> Prepare for using GadTools, set up gadgets and open window. -> Clean up and when done or on error. PROC gadtoolsWindow() HANDLE DEF mysc=NIL:PTR TO screen, mywin=NIL, glist=NIL, gad, vi=NIL mysc:=LockPubScreen(NIL) vi:=GetVisualInfoA(mysc, [NIL]) -> GadTools gadgets require this step to be taken gad:=CreateContext({glist}) -> Create a button gadget centered below the window title gad:=CreateGadgetA(BUTTON_KIND, gad, [150, (20+mysc.wbortop+mysc.font.ysize+1), 100, 12, 'Click Here', ['topaz.font', 8, 0, 0]:textattr, MYGAD_BUTTON, 0, vi, NIL]:newgadget, [NIL]) mywin:=OpenWindowTagList(NIL, [WA_TITLE, 'GadTools Gadget Demo', WA_GADGETS, glist, WA_AUTOADJUST, TRUE, WA_WIDTH, 400, WA_INNERHEIGHT, 100, WA_DRAGBAR, TRUE, WA_DEPTHGADGET, TRUE, WA_ACTIVATE, TRUE, WA_CLOSEGADGET, TRUE, WA_IDCMP, IDCMP_CLOSEWINDOW OR IDCMP_REFRESHWINDOW OR BUTTONIDCMP, WA_PUBSCREEN, mysc, NIL]) Gt_RefreshWindow(mywin, NIL) process_window_events(mywin) EXCEPT DO IF mywin THEN CloseWindow(mywin) -> FreeGadgets() must be called after the context has been created. -> It does nothing if glist is NIL FreeGadgets(glist) IF vi THEN FreeVisualInfo(vi) IF mysc THEN UnlockPubScreen(NIL, mysc) ReThrow() -> E-Note: pass on exception if it is an error ENDPROC -> Standard message handling loop with GadTools message handling functions -> used (Gt_GetIMsg() and Gt_ReplyIMsg()). PROC process_window_events(mywin:PTR TO window) DEF imsg:PTR TO intuimessage, gad:PTR TO gadget, terminated=FALSE, class REPEAT Wait(Shl(1, mywin.userport.sigbit)) -> Use Gt_GetIMsg() and Gt_ReplyIMsg() for handling IntuiMessages -> with GadTools gadgets. WHILE (terminated=FALSE) AND (imsg:=Gt_GetIMsg(mywin.userport)) -> Gt_ReplyIMsg() at end of loop class:=imsg.class SELECT class CASE IDCMP_GADGETUP -> Buttons only report GADGETUP gad:=imsg.iaddress IF gad.gadgetid=MYGAD_BUTTON THEN WriteF('Button was pressed\n') CASE IDCMP_CLOSEWINDOW terminated:=TRUE CASE IDCMP_REFRESHWINDOW -> This handling is REQUIRED with GadTools. Gt_BeginRefresh(mywin) Gt_EndRefresh(mywin, TRUE) ENDSELECT -> Use the toolkit message-replying function here... Gt_ReplyIMsg(imsg) ENDWHILE UNTIL terminated ENDPROC ;-lh0-""ҙ4%Src\Rkrm\Gameport\Absolute_Joystick.eЋ-> Absolute_Joystick.e - Gameport device absolute joystick example ->>> Header (globals) MODULE 'amigalib/ports', 'amigalib/io', 'devices/gameport', 'devices/inputevent', 'devices/timer', 'exec/execbase', 'exec/io', 'exec/nodes', 'exec/ports' ENUM ERR_NONE, ERR_DEV, ERR_IO, ERR_PORT RAISE ERR_DEV IF OpenDevice()<>0 CONST JOY_X_DELTA=1, JOY_Y_DELTA=1, TIMEOUT_SECONDS=10 DEF exec:PTR TO execbase ->>> ->>> PROC printInstructions() -> Routine to print out some information for the user. PROC printInstructions() WriteF('\n >>> gameport.device Absolute Joystick Demo <<<\n\n') IF exec.vblankfrequency=60 WriteF(' Running on NTSC system (60 Hz).\n') ELSEIF exec.vblankfrequency=50 WriteF(' Running on PAL system (50 Hz).\n') ENDIF WriteF(' Attach joystick to rear connector (A3000) and (A1000).\n' + ' Attach joystick to right connector (A2000).\n' + ' Attach joystick to left connector (A500).\n' + ' Then move joystick and click its button(s).\n\n' + ' To EXIT program press and release fire button 3 consecutive ' + 'times.\n' + ' The program also exits if no activity occurs for 1 minute.\n\n') ENDPROC ->>> ->>> PROC check_move(game_event:PTR TO inputevent) -> Print out information on the event received. PROC check_move(game_event:PTR TO inputevent) DEF xmove, ymove, timeout=FALSE xmove:=game_event.x ymove:=game_event.y IF xmove=1 IF ymove=1 WriteF('RIGHT DOWN\n') ELSEIF ymove=0 WriteF('RIGHT\n') ELSEIF ymove=-1 WriteF('RIGHT UP\n') ELSE WriteF('UNKNOWN Y\n') ENDIF ELSEIF xmove=-1 IF ymove=1 WriteF('LEFT DOWN\n') ELSEIF ymove=0 WriteF('LEFT\n') ELSEIF ymove=-1 WriteF('LEFT UP\n') ELSE WriteF('UNKNOWN Y\n') ENDIF ELSEIF xmove=0 IF ymove=1 WriteF('DOWN\n') ELSEIF ymove=0 -> Note that 0,0 can be a timeout, or a direction release. IF game_event.timestamp.secs >= (exec.vblankfrequency*TIMEOUT_SECONDS) -> Under 1.3 (V34) and earlier versions of the Amiga OS, the -> timestamp.secs field used in the IF statement above is not -> correctly filled in. Therefore, this program cannot tell the -> difference between a release event and a timeout under 1.3 (release -> events will be reported as timeouts). WriteF('TIMEOUT\n') timeout:=TRUE ELSE WriteF('RELEASE\n') ENDIF ELSEIF ymove=-1 WriteF('UP\n') ELSE WriteF('UNKNOWN Y\n') ENDIF ELSE WriteF('UNKNOWN X ') IF ymove=1 WriteF('unknown action\n') ELSEIF ymove=0 WriteF('unknown action\n') ELSEIF ymove=-1 WriteF('unknown action\n') ELSE WriteF('UNKNOWN Y\n') ENDIF ENDIF ENDPROC timeout ->>> ->>> PROC send_read_request(game_event, game_io_msg:PTR TO iostd) -> Send a request to the gameport to read an event. PROC send_read_request(game_event, game_io_msg:PTR TO iostd) game_io_msg.command:=GPD_READEVENT game_io_msg.flags:=0 game_io_msg.data:=game_event game_io_msg.length:=SIZEOF inputevent SendIO(game_io_msg) -> Asynchronous - message will return later ENDPROC ->>> ->>> PROC processEvents(game_io_msg:PTR TO iostd, game_msg_port:PTR TO mp) -> Simple loop to process gameport events. PROC processEvents(game_io_msg:PTR TO iostd, game_msg_port:PTR TO mp) DEF timeout, timeouts, button_count, not_finished, code, game_event:inputevent -> Where input event will be stored -> From now on, just read input events into the event buffer, -> one at a time. READEVENT waits for the preset conditions. timeouts:=0 button_count:=0 not_finished:=TRUE WHILE (timeouts<6) AND not_finished -> Send the read request send_read_request(game_event, game_io_msg) -> Wait for joystick action Wait(Shl(1, game_msg_port.sigbit)) WHILE NIL<>GetMsg(game_msg_port) timeout:=FALSE code:=game_event.code SELECT code CASE IECODE_LBUTTON WriteF(' FIRE BUTTON PRESSED \n') CASE IECODE_LBUTTON OR IECODE_UP_PREFIX WriteF(' FIRE BUTTON RELEASED \n') button_count++ IF 3=button_count THEN not_finished:=FALSE CASE IECODE_RBUTTON WriteF(' ALT BUTTON PRESSED \n') button_count:=0 CASE IECODE_RBUTTON OR IECODE_UP_PREFIX WriteF(' ALT BUTTON RELEASED \n') button_count:=0 CASE IECODE_NOBUTTON -> Check for change in position timeout:=check_move(game_event) button_count:=0 DEFAULT ENDSELECT IF timeout INC timeouts ELSE timeouts:=0 ENDIF ENDWHILE ENDWHILE ENDPROC ->>> ->>> PROC set_controller_type(type, game_io_msg:PTR TO iostd) -> Allocate the controller if it is available. You allocate the controller by -> setting its type to something other than GPCT_NOCONTROLLER. Before you -> allocate the thing you need to check if anyone else is using it (it is free -> if it is set to GPCT_NOCONTROLLER). PROC set_controller_type(type, game_io_msg:PTR TO iostd) DEF success=FALSE, controller_type_addr controller_type_addr:=[0]:CHAR -> Begin critical section. -> We need to be sure that between the time we check that the controller is -> available and the time we allocate it, no one else steals it. Forbid() game_io_msg.command:=GPD_ASKCTYPE -> Enquire current status game_io_msg.flags:=IOF_QUICK game_io_msg.data:=controller_type_addr -> Put answer in here game_io_msg.length:=1 DoIO(game_io_msg) -> No one is using this device unit, let's claim it IF controller_type_addr[]=GPCT_NOCONTROLLER game_io_msg.command:=GPD_SETCTYPE game_io_msg.flags:=IOF_QUICK game_io_msg.data:=[type]:CHAR game_io_msg.length:=1 DoIO( game_io_msg) success:=TRUE ENDIF Permit() -> Critical section end ENDPROC success ->>> ->>> PROC set_trigger_conditions(gpt:PTR TO gameporttrigger, game_io_msg:...) -> Tell the gameport when to trigger. PROC set_trigger_conditions(gpt:PTR TO gameporttrigger, game_io_msg:PTR TO iostd) -> Trigger on all joystick key transitions gpt.keys:=GPTF_UPKEYS OR GPTF_DOWNKEYS gpt.xdelta:=JOY_X_DELTA gpt.ydelta:=JOY_Y_DELTA -> Timeout trigger every TIMEOUT_SECONDS second(s) gpt.timeout:=exec.vblankfrequency*TIMEOUT_SECONDS game_io_msg.command:=GPD_SETTRIGGER game_io_msg.flags:=IOF_QUICK game_io_msg.data:=gpt game_io_msg.length:=SIZEOF gameporttrigger DoIO(game_io_msg) ENDPROC ->>> ->>> PROC flush_buffer(game_io_msg:PTR TO iostd) -> Clear the buffer. Do this before you begin to be sure you start in a known -> state. PROC flush_buffer(game_io_msg:PTR TO iostd) game_io_msg.command:=CMD_CLEAR game_io_msg.flags:=IOF_QUICK game_io_msg.data:=NIL game_io_msg.length:=0 DoIO(game_io_msg) ENDPROC ->>> ->>> PROC free_gp_unit(game_io_msg:PTR TO iostd) -> Free the unit by setting its type back to GPCT_NOCONTROLLER. PROC free_gp_unit(game_io_msg:PTR TO iostd) DEF type=GPCT_NOCONTROLLER game_io_msg.command:=GPD_SETCTYPE game_io_msg.flags:=IOF_QUICK game_io_msg.data:=[type]:CHAR game_io_msg.length:=1; DoIO(game_io_msg) ENDPROC ->>> ->>> PROC main() -> Allocate everything and go. On failure, free any resources that have been -> allocated. PROC main() HANDLE DEF joytrigger:gameporttrigger, game_io_msg=NIL:PTR TO iostd, game_msg_port=NIL, open_dev=FALSE -> E-Note: get the right type for exec exec:=execbase -> Create port for gameport device communications IF NIL=(game_msg_port:=createPort('RKM_game_port', 0)) Raise(ERR_PORT) ENDIF -> Create message block for device IO IF NIL=(game_io_msg:=createExtIO(game_msg_port, SIZEOF iostd)) Raise(ERR_IO) ENDIF game_io_msg.mn.ln.type:=NT_UNKNOWN -> Open the right/back (unit 1, number 2) gameport.device unit OpenDevice('gameport.device', 1, game_io_msg, 0) open_dev:=TRUE -> Set controller type to joystick IF set_controller_type(GPCT_ABSJOYSTICK, game_io_msg) -> Specify the trigger conditions set_trigger_conditions(joytrigger, game_io_msg) printInstructions() -> Clear device buffer to start from a known state. -> There might still be events left. flush_buffer(game_io_msg) processEvents(game_io_msg, game_msg_port) -> Free gameport unit so other applications can use it! free_gp_unit(game_io_msg) ENDIF EXCEPT DO IF open_dev THEN CloseDevice(game_io_msg) IF game_io_msg THEN deleteExtIO(game_io_msg) IF game_msg_port THEN deletePort(game_msg_port) SELECT exception CASE ERR_DEV; WriteF('Error: could not open gameport device\n') CASE ERR_IO; WriteF('Error: could not create I/O\n') CASE ERR_PORT; WriteF('Error: could not create port\n') ENDSELECT ENDPROC ->>> C-lh0-ҙ4-Src\Rkrm\Graphics_Libraries\Layers\clipping.e-> clipping.e ->>> Header (globals) MODULE 'layers', 'graphics/gfx', 'intuition/intuition' ENUM ERR_NONE, ERR_LIB, ERR_WIN RAISE ERR_LIB IF OpenLibrary()=NIL, ERR_WIN IF OpenWindowTagList()=NIL CONST MY_WIN_WIDTH=300, MY_WIN_HEIGHT=100 ->>> ->>> PROC unclipWindow(win:PTR TO window) -> Used to remove a clipping region installed by clipWindow() or -> clipWindowToBorders(), disposing of the installed region and reinstalling -> the region removed. PROC unclipWindow(win:PTR TO window) DEF old_region -> Remove any old region by installing a NIL region, then dispose of the old -> region if one was installed. IF old_region:=InstallClipRegion(win.wlayer, NIL) DisposeRegion(old_region) ENDIF ENDPROC ->>> ->>> PROC clipWindow(win:PTR TO window, minX, minY, maxX, maxY) -> Clip a window to a specified rectangle (given by upper left and lower right -> corner). The removed region is returned so that it may be reinstalled -> later. PROC clipWindow(win:PTR TO window, minX, minY, maxX, maxY) DEF new_region, my_rectangle -> Set up the limits for the clip. my_rectangle:=[minX, minY, maxX, maxY]:rectangle -> Get a new region and OR in the limits. IF new_region:=NewRegion() IF OrRectRegion(new_region, my_rectangle)=FALSE DisposeRegion(new_region) new_region:=NIL ENDIF ENDIF -> Install the new region, and return any existing region. If the above -> allocation and region processing failed, then new_region will be NIL and -> no clip region will be installed. ENDPROC InstallClipRegion(win.wlayer, new_region) ->>> ->>> PROC clipWindowToBorders(win:PTR TO window) -> Clip a window to its borders. -> The removed region is returned so that it may be re-installed later. PROC clipWindowToBorders(win:PTR TO window) ENDPROC clipWindow(win, win.borderleft, win.bordertop, win.width-win.borderright-1, win.height-win.borderbottom-1) ->>> ->>> PROC wait_for_close(win) -> Wait for the user to select the close gadget. PROC wait_for_close(win) REPEAT -> E-Note: use built-in WaitIMessage() UNTIL WaitIMessage(win)=IDCMP_CLOSEWINDOW ENDPROC ->>> ->>> PROC draw_in_window(win:PTR TO window, message) -> Simple routine to blast all bits in a window with color three to show where -> the window is clipped. After a delay, flush back to color zero and refresh -> the window borders. PROC draw_in_window(win:PTR TO window, message) WriteF('\s...', message) SetRast(win.rport, 3) Delay(200) SetRast(win.rport, 0) RefreshWindowFrame(win) WriteF('...done\n') ENDPROC ->>> ->>> PROC clip_test(win:PTR TO window) -> Show drawing into an unclipped window, a window clipped to the borders and -> a window clipped to a random rectangle. It is possible to clip more -> complex shapes by AND'ing, OR'ing and exclusive-OR'ing regions and -> rectangles to build a user clip region. -> -> This example assumes that old regions are not going to be re-used, so it -> simply throws them away. PROC clip_test(win) DEF old_region draw_in_window(win, 'Window with no clipping') -> If the application has never installed a user clip region, then -> old_region will be NIL here. Otherwise, delete the old region (you -> could save it and re-install it later...) IF old_region:=clipWindowToBorders(win) DisposeRegion(old_region) ENDIF draw_in_window(win, 'Window clipped to window borders') unclipWindow(win) -> Here we know old_region will be NIL, as that is what we installed with -> unclipWindow()... IF old_region:=clipWindow(win, 20, 20, 100, 50) DisposeRegion(old_region) ENDIF draw_in_window(win, 'Window clipped from (20,20) to (100,50)') unclipWindow(win) wait_for_close(win) ENDPROC ->>> ->>> PROC main() -> Open and close resources, call the test routine when ready. PROC main() HANDLE DEF win=NIL KickVersion(37) layersbase:=OpenLibrary('layers.library', 37) win:=OpenWindowTagList(NIL, [WA_WIDTH, MY_WIN_WIDTH, WA_HEIGHT, MY_WIN_HEIGHT, WA_IDCMP, IDCMP_CLOSEWINDOW, WA_CLOSEGADGET, TRUE, WA_DRAGBAR, TRUE, WA_ACTIVATE, TRUE, NIL]) clip_test(win) EXCEPT DO IF win THEN CloseWindow(win) IF layersbase THEN CloseLibrary(layersbase) SELECT exception CASE ERR_LIB; WriteF('Error: could not open layers.library V37+\n') CASE ERR_WIN; WriteF('Error: could not open window\n') ENDSELECT ENDPROC ->>> A-lh0-++ҙ4+Src\Rkrm\Graphics_Libraries\Layers\layers.e-> Layers.e ->>> Header (globals) OPT PREPROCESS MODULE 'layers', 'graphics/clip', 'graphics/layers', 'graphics/gfx', 'graphics/gfxbase', 'graphics/rastport', 'graphics/view' ENUM ERR_NONE, ERR_BLYR, ERR_CMAP, ERR_LIB, ERR_LYR RAISE ERR_BLYR IF CreateBehindLayer()=NIL, ERR_CMAP IF GetColorMap()=NIL, ERR_LIB IF OpenLibrary()=NIL, ERR_LYR IF NewLayerInfo()=NIL CONST L_DELAY=100, S_DELAY=50, DUMMY=0 ENUM RED_PEN=1, GREEN_PEN, BLUE_PEN CONST SCREEN_D=2, SCREEN_W=320, SCREEN_H=200 -> The starting size of example layers, offsets are used for placement. CONST W_H=50, W_T=5, W_W=80 CONST W_B=W_T+W_H-1 CONST SWH=SCREEN_W/2, WWH=W_W/2 CONST W_L=SWH-WWH CONST W_R=W_L+W_W-1 -> Size of the superbitmap. CONST SUPER_H=SCREEN_H, SUPER_W=SCREEN_W -> Starting size of the message layer. CONST M_H=10, M_W=SCREEN_W, M_L=0 CONST M_T=SCREEN_H-M_H CONST M_B=M_T+M_H-1 CONST M_R=M_L+M_W-1 DEF theLayerFlags:PTR TO LONG, colourtable:PTR TO INT ->>> ->>> PROC myLabelLayer(layer:PTR TO layer, colour, string) -> Clear the layer THEN draw in a text string. PROC myLabelLayer(layer:PTR TO layer, colour, string) -> Fill layer with colour SetRast(layer.rp, colour) -> Set up for writing text into layer SetDrMd(layer.rp, RP_JAM1) SetAPen(layer.rp, 0) Move(layer.rp, 5, 7) -> Write into layer Text(layer.rp, string, StrLen(string)) ENDPROC ->>> ->>> PROC pMessage(layer, string) -> Write a message into a layer with a delay. PROC pMessage(layer, string) Delay(S_DELAY) myLabelLayer(layer, GREEN_PEN, string) ENDPROC ->>> ->>> PROC error(layer, string) -> Write an error message into a layer with a delay. PROC error(layer, string) myLabelLayer(layer, RED_PEN, string) Delay(L_DELAY) ENDPROC ->>> ->>> PROC doLayers(msgLayer, layer_array:PTR TO LONG) -> Do some layers manipulations to demonstrate their abilities. PROC doLayers(msgLayer, layer_array:PTR TO LONG) DEF ktr, ktr_2, tlayer:PTR TO layer pMessage(msgLayer, 'Label all Layers') myLabelLayer(layer_array[0], RED_PEN, 'SUPER') myLabelLayer(layer_array[1], GREEN_PEN, 'Smart') myLabelLayer(layer_array[2], BLUE_PEN, 'Simple') pMessage(msgLayer, 'MoveLayer 1 InFrontOf 0') IF FALSE=MoveLayerInFrontOf(layer_array[1], layer_array[0]) error(msgLayer, 'MoveLayerInFrontOf() failed.') ENDIF pMessage(msgLayer, 'MoveLayer 2 InFrontOf 1') IF FALSE=MoveLayerInFrontOf(layer_array[2], layer_array[1]) error(msgLayer, 'MoveLayerInFrontOf() failed.') ENDIF pMessage(msgLayer, 'Refresh Simple Refresh Layer') myLabelLayer(layer_array[2], BLUE_PEN, 'Simple') pMessage(msgLayer, 'Incrementally MoveLayers...') FOR ktr:=0 TO 29 IF FALSE=MoveLayer(DUMMY, layer_array[1], -1, 0) error(msgLayer, 'MoveLayer() failed.') ENDIF IF FALSE=MoveLayer(DUMMY, layer_array[2], -2, 0) error(msgLayer, 'MoveLayer() failed.') ENDIF ENDFOR pMessage(msgLayer, 'Refresh Simple Refresh Layer') myLabelLayer(layer_array[2], BLUE_PEN, 'Simple') pMessage(msgLayer, 'Make Layer 0 the UpfrontLayer') IF FALSE=UpfrontLayer(DUMMY, layer_array[0]) error(msgLayer, 'UpfrontLayer() failed.') ENDIF pMessage(msgLayer, 'Make Layer 2 the BehindLayer') IF FALSE=BehindLayer(DUMMY, layer_array[2]) error(msgLayer, 'BehindLayer() failed.') ENDIF pMessage(msgLayer, 'Incrementally MoveLayers again...') FOR ktr:=0 TO 29 IF FALSE=MoveLayer(DUMMY, layer_array[1], 0, 1) error(msgLayer, 'MoveLayer() failed.') ENDIF IF FALSE=MoveLayer(DUMMY, layer_array[2], 0, 2) error(msgLayer, 'MoveLayer() failed.') ENDIF ENDFOR pMessage(msgLayer, 'Refresh Simple Refresh Layer') myLabelLayer(layer_array[2], BLUE_PEN, 'Simple') pMessage(msgLayer, 'Big MoveLayer') FOR ktr:=0 TO 2 tlayer:=layer_array[ktr] IF FALSE=MoveLayer(DUMMY, tlayer, -tlayer.minx, 0) error(msgLayer, 'MoveLayer() failed.') ENDIF ENDFOR pMessage(msgLayer, 'Incrementally increase size') FOR ktr:=0 TO 4 FOR ktr_2:=0 TO 2 IF FALSE=SizeLayer(DUMMY, layer_array[ktr_2], 1, 1) error(msgLayer, 'SizeLayer() failed.') ENDIF ENDFOR ENDFOR pMessage(msgLayer, 'Refresh Smart Refresh Layer') myLabelLayer(layer_array[1], GREEN_PEN, 'Smart') pMessage(msgLayer, 'Refresh Simple Refresh Layer') myLabelLayer(layer_array[2], BLUE_PEN, 'Simple') pMessage(msgLayer, 'Big SizeLayer') FOR ktr:=0 TO 2 tlayer:=layer_array[ktr] IF FALSE=SizeLayer(DUMMY, tlayer, SCREEN_W-tlayer.maxx-1, 0) error(msgLayer, 'SizeLayer() failed.') ENDIF ENDFOR pMessage(msgLayer, 'Refresh Smart Refresh Layer') myLabelLayer(layer_array[1], GREEN_PEN, 'Smart') pMessage(msgLayer, 'Refresh Simple Refresh Layer') myLabelLayer(layer_array[2], BLUE_PEN, 'Simple') pMessage(msgLayer, 'ScrollLayer down') FOR ktr:=0 TO 29 FOR ktr_2:=0 TO 2 ScrollLayer(DUMMY, layer_array[ktr_2], 0, -1) ENDFOR ENDFOR pMessage(msgLayer, 'Refresh Smart Refresh Layer') myLabelLayer(layer_array[1], GREEN_PEN, 'Smart') pMessage(msgLayer, 'Refresh Simple Refresh Layer') myLabelLayer(layer_array[2], BLUE_PEN, 'Simple') pMessage(msgLayer, 'ScrollLayer up') FOR ktr:=0 TO 29 FOR ktr_2:=0 TO 2 ScrollLayer(DUMMY, layer_array[ktr_2], 0, 1) ENDFOR ENDFOR pMessage(msgLayer, 'Refresh Smart Refresh Layer') myLabelLayer(layer_array[1], GREEN_PEN, 'Smart') pMessage(msgLayer, 'Refresh Simple Refresh Layer') myLabelLayer(layer_array[2], BLUE_PEN, 'Simple') Delay(L_DELAY) ENDPROC ->>> ->>> PROC disposeLayers(msgLayer, layer_array:PTR TO LONG) -> Delete the layer array created by allocLayers(). PROC disposeLayers(msgLayer, layer_array:PTR TO LONG) DEF ktr FOR ktr:=0 TO 2 IF layer_array[ktr] IF FALSE=DeleteLayer(DUMMY, layer_array[ktr]) error(msgLayer, 'Error deleting layer') ENDIF ENDIF ENDFOR ENDPROC ->>> ->>> PROC allocLayers(msgLayer,layer_array,super_bitmap,theLayerInfo,theBitMap) -> Create some hard-coded layers. The first must be SUPER-bitmap, with the -> bitmap passed as an argument. The others must not be super-bitmap. The -> pointers to the created layers are returned in layer_array. -> -> Return FALSE on failure. On a FALSE return, the layers are properly -> cleaned up. PROC allocLayers(msgLayer, layer_array:PTR TO LONG, super_bitmap, theLayerInfo, theBitMap) HANDLE DEF ktr, tlayer:PTR TO layer FOR ktr:=0 TO 2 pMessage(msgLayer, 'Create BehindLayer') IF ktr=0 tlayer:=CreateBehindLayer(theLayerInfo, theBitMap, W_L+(ktr*30), W_T+(ktr*30), W_R+(ktr*30), W_B+(ktr*30), theLayerFlags[ktr], super_bitmap) ELSE tlayer:=CreateBehindLayer(theLayerInfo, theBitMap, W_L+(ktr*30), W_T+(ktr*30), W_R+(ktr*30), W_B+(ktr*30), theLayerFlags[ktr], NIL) ENDIF pMessage(msgLayer, 'Fill the RastPort') SetRast(tlayer.rp, ktr+1) layer_array[ktr]:=tlayer ENDFOR EXCEPT disposeLayers(msgLayer, layer_array) ReThrow() ENDPROC ->>> ->>> PROC disposeBitMap(bitmap:PTR TO bitmap, depth, width, height) -> Free the bitmap and all bitplanes created by allocBitMap(). PROC disposeBitMap(bitmap:PTR TO bitmap, depth, width, height) DEF ktr IF bitmap FOR ktr:=0 TO depth-1 IF bitmap.planes[ktr] THEN FreeRaster(bitmap.planes[ktr], width, height) ENDFOR Dispose(bitmap) ENDIF ENDPROC ->>> ->>> PROC allocBitMap(depth, width, height) -> Allocate and initialize a bitmap structure. PROC allocBitMap(depth, width, height) HANDLE DEF ktr, bitmap=NIL:PTR TO bitmap NEW bitmap InitBitMap(bitmap, depth, width, height) FOR ktr:=0 TO depth-1 bitmap.planes[ktr]:=AllocRaster(width, height) BltClear(bitmap.planes[ktr], RASSIZE(width, height), 1) ENDFOR EXCEPT disposeBitMap(bitmap, depth, width, height) ReThrow() ENDPROC bitmap ->>> ->>> PROC startLayers(theLayerInfo, theBitMap) -> Set up to run the layers example, doLayers(). Clean up when done. PROC startLayers(theLayerInfo, theBitMap) HANDLE DEF msgLayer=NIL, theSuperBitMap=NIL, theLayers=NIL theLayers:=[NIL, NIL, NIL]:LONG IF msgLayer:=CreateUpfrontLayer(theLayerInfo, theBitMap, M_L, M_T, M_R, M_B, LAYERSMART, NIL) pMessage(msgLayer, 'Setting up Layers') theSuperBitMap:=allocBitMap(SCREEN_D, SUPER_W, SUPER_H) allocLayers(msgLayer, theLayers, theSuperBitMap, theLayerInfo, theBitMap) doLayers(msgLayer, theLayers) ENDIF EXCEPT DO disposeLayers(msgLayer, theLayers) disposeBitMap(theSuperBitMap, SCREEN_D, SUPER_W, SUPER_H) IF msgLayer IF FALSE=DeleteLayer(DUMMY, msgLayer) error(msgLayer, 'Error deleting layer') ENDIF ENDIF ENDPROC ->>> ->>> PROC runNewView() -> Set up a low-level graphics display for layers to work on. Layers should -> not be built directly on Intuition screens, use a low-level graphics view. -> If you need mouse or other events for the layers display, you have to get -> them directly from the input device. The only supported method of using -> layers library calls with Intuition (other than the InstallClipRegion() -> call) is through Intuition windows. -> -> See graphics primitives chapter for details on creating and using the -> low-level graphics calls. PROC runNewView() HANDLE DEF theView:view, oldview:PTR TO view, theViewPort:viewport, theRasInfo, theColourMap=NIL:PTR TO colormap, theLayerInfo=NIL:PTR TO layer_info, theBitMap=NIL:PTR TO bitmap, colourpalette:PTR TO INT, ktr, gfx:PTR TO gfxbase -> E-Note: get the right type... gfx:=gfxbase -> Save current view, to be restored when done IF oldview:=gfx.actiview -> Get a LayerInfo structure theLayerInfo:=NewLayerInfo() theColourMap:=GetColorMap(4) colourpalette:=theColourMap.colortable; FOR ktr:=0 TO 3 DO colourpalette[]++:=colourtable[ktr] theBitMap:=allocBitMap(SCREEN_D, SCREEN_W, SCREEN_H) InitView(theView) InitVPort(theViewPort) theView.viewport:=theViewPort theRasInfo:=[NIL, theBitMap, 0, 0]:rasinfo theViewPort.dwidth:=SCREEN_W; theViewPort.dheight:=SCREEN_H theViewPort.rasinfo:=theRasInfo; theViewPort.colormap:=theColourMap MakeVPort(theView, theViewPort); MrgCop(theView); LoadView(theView) WaitTOF() startLayers(theLayerInfo, theBitMap) -> Put back the old view, wait for it to become active before freeing any -> of our display LoadView(oldview) WaitTOF() -> Free dynamically created structures FreeVPortCopLists(theViewPort) FreeCprList(theView.lofcprlist) ENDIF EXCEPT DO IF theBitMap THEN disposeBitMap(theBitMap, SCREEN_D, SCREEN_W, SCREEN_H) IF theColourMap THEN FreeColorMap(theColourMap) IF theLayerInfo THEN DisposeLayerInfo(theLayerInfo) ReThrow() ENDPROC ->>> ->>> PROC main() -> Open the libraries used by the example. Clean up when done. PROC main() HANDLE -> Global constant data for initialising the layers. theLayerFlags:=[LAYERSUPER, LAYERSMART, LAYERSIMPLE]:LONG colourtable:=[$000, $F44, $4F4, $44F]:INT layersbase:=OpenLibrary('layers.library', 33) runNewView() EXCEPT DO IF layersbase THEN CloseLibrary(layersbase) ENDPROC ->>> J-lh0-99ә44Src\Rkrm\Graphics_Libraries\Primitives\genlockdemo.e-> genlockdemo.e - Genlock VideoControl example. ->>> Header (globals) OPT PREPROCESS MODULE 'gadtools', 'exec/libraries', 'graphics/displayinfo', 'graphics/gfxbase', 'graphics/modeid', 'graphics/text', 'graphics/videocontrol', 'graphics/view', 'intuition/intuition', 'intuition/screens', 'libraries/gadtools', 'utility/tagitem' ENUM ERR_NONE, ERR_CTXT, ERR_ECS, ERR_GAD, ERR_KICK, ERR_LIB, ERR_SCRN, ERR_VIS, ERR_WIN RAISE ERR_CTXT IF CreateContext()=NIL, ERR_GAD IF CreateGadgetA()=NIL, ERR_KICK IF KickVersion()=FALSE, ERR_LIB IF OpenLibrary()=NIL, ERR_SCRN IF OpenScreenTagList()=NIL, ERR_VIS IF GetVisualInfoA()=NIL, ERR_WIN IF OpenWindowTagList()=NIL, "MEM" IF String()=NIL -> 'libraries/gadtools' does not define a library name. #define GADTOOLSNAME 'gadtools.library' -> Some gadget ID's ENUM BORDERBLANK_ID=16, BORDERNOTRANS_ID, BITPLANEKEY_ID, CHROMAPLANE_ID, CHROMAKEY_ID -> E-Note: get the right type to use gfxbase DEF gfx:PTR TO gfxbase ->>> ->>> PROC main() PROC main() HANDLE DEF genscreen=NIL:PTR TO screen, controlwindow=NIL:PTR TO window, glist=NIL, gadget:PTR TO gadget, hitgadget:PTR TO gadget, vp:PTR TO viewport, viewlord:PTR TO view, vi=NIL, ng:PTR TO newgadget, -> E-Note: C version is over-cautious about the size of vtags imsg:PTR TO intuimessage, vtags[22]:ARRAY OF tagitem, gadgetPtrs[21]:ARRAY OF LONG, iclass, icode, i, j, abort=FALSE, isPAL, gfx:PTR TO gfxbase gfx:=gfxbase -> E-Note: set-up correct typed gfxbase KickVersion(37) gadtoolsbase:=OpenLibrary(GADTOOLSNAME, 37) IF 0=(gfx.chiprevbits0 AND GFXF_HR_DENISE) THEN Raise(ERR_ECS) -> Check if the user happens to prefer PAL or if this is a true PAL system. isPAL:=checkPAL('Workbench') -> Open a 'standard' HIRES screen. genscreen:=OpenScreenTagList(NIL, -> Give me 3D look window (I'll use a quiet screen). [SA_PENS, [0, 1, 1, 2, 1, 3, 1, 0, 3, -1]:INT, SA_DISPLAYID, HIRES_KEY, SA_DEPTH, 4, -> Give me a lot of border. SA_WIDTH, 640, SA_HEIGHT, IF isPAL THEN 256 ELSE 200, SA_OVERSCAN, 0, -> Hold the titlebar, please. SA_QUIET, TRUE, -> Give me a sysfont 1 as default rastport font. SA_SYSFONT, 1, NIL]) -> Blast some colourbars in screen's rastport, leave some colour 0 gaps. j:=0 FOR i:=0 TO 15 SetAPen(genscreen.rastport, i) RectFill(genscreen.rastport, j+1, 0, j+30, IF isPAL THEN 255 ELSE 199) j:=j+40 ENDFOR -> A line to show where borders start. SetAPen(genscreen.rastport, 5) Move(genscreen.rastport, 0, 0) Draw(genscreen.rastport, genscreen.width-1, 0) Draw(genscreen.rastport, genscreen.width-1, genscreen.height-1) Draw(genscreen.rastport, 0, genscreen.height-1) Draw(genscreen.rastport, 0, 0) -> Open a restricted window, no dragging or sizing, just closing (don't -> want to refresh screen). controlwindow:=OpenWindowTagList(NIL, [WA_TITLE, 'VideoControl', WA_LEFT, 210, WA_TOP, 20, WA_WIDTH, 220, WA_HEIGHT, 150, WA_CUSTOMSCREEN, genscreen, WA_FLAGS, WFLG_CLOSEGADGET OR WFLG_ACTIVATE OR WFLG_NOCAREREFRESH, WA_IDCMP, IDCMP_CLOSEWINDOW OR IDCMP_GADGETUP, NIL]) -> OK, got a window, lets make some gadgets. vi:=GetVisualInfoA(genscreen, [NIL]) gadget:=CreateContext({glist}) ng:=[controlwindow.borderleft+120, controlwindow.bordertop+2, 12, 12, -> Just a demo, set everything to topaz 80. 'BORDERBLANK', ['topaz.font', 8, 0, 0]:textattr, BORDERBLANK_ID, PLACETEXT_LEFT OR NG_HIGHLABEL, vi, NIL]:newgadget -> E-Note: the C version fails to check the return value of every single one -> of the calls to CreateGadgetA(), which is fatal since "gadget" is -> dereferenced as "gadget.height" (we are using automatic exceptions) gadget:=CreateGadgetA(CHECKBOX_KIND, gadget, ng, [NIL]) gadgetPtrs[BORDERBLANK_ID]:=gadget ng.topedge:=ng.topedge+gadget.height+2 ng.gadgettext:='BORDERNOTRANS' ng.gadgetid:=BORDERNOTRANS_ID gadget:=CreateGadgetA(CHECKBOX_KIND, gadget, ng, [NIL]) gadgetPtrs[BORDERNOTRANS_ID]:=gadget ng.topedge:=ng.topedge+gadget.height+2 ng.gadgettext:='CHROMAKEY' ng.gadgetid:=CHROMAKEY_ID gadget:=CreateGadgetA(CHECKBOX_KIND, gadget, ng, [NIL]) gadgetPtrs[CHROMAKEY_ID]:=gadget ng.topedge:=ng.topedge+gadget.height+2 ng.gadgettext:='BITPLANEKEY' ng.gadgetid:=BITPLANEKEY_ID gadget:=CreateGadgetA(CHECKBOX_KIND, gadget, ng, [NIL]) gadgetPtrs[BITPLANEKEY_ID]:=gadget ng.topedge:=ng.topedge+gadget.height+2 ng.width:=90 ng.gadgettext:='CHROMAPLANE' ng.gadgetid:=CHROMAPLANE_ID gadget:=CreateGadgetA(CYCLE_KIND, gadget, ng, [GTCY_LABELS, ['Plane 0', 'Plane 1', 'Plane 2', 'Plane 3', NIL], NIL]) gadgetPtrs[CHROMAPLANE_ID]:=gadget ng.topedge:=ng.topedge+gadget.height+20 ng.width:=12 ng.flags:=PLACETEXT_ABOVE OR NG_HIGHLABEL FOR j:=0 TO 1 FOR i:=0 TO 7 ng.leftedge:=controlwindow.borderleft+2+(i*gadget.width) -> E-Note: we can let E clear up all the E-strings we make ng.gadgettext:=StringF(String(3), '\d', i+(j*8)) ng.gadgetid:=i+(j*8) gadget:=CreateGadgetA(CHECKBOX_KIND, gadget, ng, [NIL]) -> E-Note: C version gets the index wrong gadgetPtrs[i+(j*8)]:=gadget ENDFOR ng.topedge:=ng.topedge+gadget.height ng.flags:=PLACETEXT_BELOW OR NG_HIGHLABEL ENDFOR AddGList(controlwindow, glist, -1, -1, NIL) RefreshGList(glist, controlwindow, NIL, -1) Gt_RefreshWindow(controlwindow, NIL) -> Finally, a window with some gadgets... -> -> Get the current genlock state. Obviously I already know what the settings -> will be (all off), since I opened the screen myself. Do it just to show -> how to get them. vp:=genscreen.viewport -> Is borderblanking on? vtags[0].tag:=VTAG_BORDERBLANK_GET vtags[0].data:=NIL -> Is bordertransparent set? vtags[1].tag:=VTAG_BORDERNOTRANS_GET vtags[1].data:=NIL -> Key on bitplane? vtags[2].tag:=VTAG_BITPLANEKEY_GET vtags[2].data:=NIL -> Get plane which is used to key on vtags[3].tag:=VTAG_CHROMA_PLANE_GET vtags[3].data:=NIL -> Chromakey overlay on? vtags[4].tag:=VTAG_CHROMAKEY_GET vtags[4].data:=NIL FOR i:=0 TO 15 -> Find out which colours overlay vtags[i+5].tag:=VTAG_CHROMA_PEN_GET vtags[i+5].data:=i ENDFOR -> Indicate end of tag array vtags[21].tag:=VTAG_END_CM vtags[21].data:=NIL -> And send the commands. On return the Tags themselves will indicate the -> genlock settings for this ViewPort's ColorMap. VideoControl(vp.colormap, vtags) -> And initialise the gadgets, according to genlock settings. IF vtags[0].tag=VTAG_BORDERBLANK_SET Gt_SetGadgetAttrsA(gadgetPtrs[BORDERBLANK_ID], controlwindow, NIL, [GTCB_CHECKED, TRUE, NIL]) ENDIF IF vtags[1].tag=VTAG_BORDERNOTRANS_SET Gt_SetGadgetAttrsA(gadgetPtrs[BORDERNOTRANS_ID], controlwindow, NIL, [GTCB_CHECKED, TRUE, NIL]) ENDIF IF vtags[2].tag=VTAG_BITPLANEKEY_SET Gt_SetGadgetAttrsA(gadgetPtrs[BITPLANEKEY_ID], controlwindow, NIL, [GTCB_CHECKED, TRUE, NIL]) ENDIF IF vtags[3].tag=VTAG_CHROMA_PLANE_SET Gt_SetGadgetAttrsA(gadgetPtrs[CHROMAPLANE_ID], controlwindow, NIL, [GTCY_ACTIVE, vtags[3].data, NIL]) ENDIF IF vtags[4].tag=VTAG_CHROMAKEY_SET Gt_SetGadgetAttrsA(gadgetPtrs[CHROMAKEY_ID], controlwindow, NIL, [GTCB_CHECKED, TRUE, NIL]) ENDIF FOR i:=0 TO 15 IF vtags[i+5].tag=VTAG_CHROMA_PEN_SET -> E-Note: C version fails to terminate the tag list! Gt_SetGadgetAttrsA(gadgetPtrs[i], controlwindow, NIL, [GTCB_CHECKED, TRUE, NIL]) ENDIF ENDFOR -> Will only send single commands from here on. vtags[1].tag:=VTAG_END_CM -> Get user input. REPEAT WaitPort(controlwindow.userport) WHILE imsg:=Gt_GetIMsg(controlwindow.userport) iclass:=imsg.class icode:=imsg.code hitgadget:=imsg.iaddress Gt_ReplyIMsg(imsg) -> E-Note: C version uses obsolete tags SELECT iclass CASE IDCMP_GADGETUP IF hitgadget.gadgetid < 16 IF hitgadget.flags AND GFLG_SELECTED -> Set colour key vtags[0].tag:=VTAG_CHROMA_PEN_SET ELSE -> Clear colour key vtags[0].tag:=VTAG_CHROMA_PEN_CLR ENDIF ELSE i:=hitgadget.gadgetid SELECT i CASE BORDERBLANK_ID IF hitgadget.flags AND GFLG_SELECTED -> Set border blanking on vtags[0].tag:=VTAG_BORDERBLANK_SET ELSE -> Turn border blanking off vtags[0].tag:=VTAG_BORDERBLANK_CLR ENDIF CASE BORDERNOTRANS_ID IF hitgadget.flags AND GFLG_SELECTED -> Set border transparency on vtags[0].tag:=VTAG_BORDERNOTRANS_SET ELSE -> Turn border transparency off vtags[0].tag:=VTAG_BORDERNOTRANS_CLR ENDIF CASE BITPLANEKEY_ID IF hitgadget.flags AND GFLG_SELECTED -> Key on current selected bitplane (chromaplane) vtags[0].tag:=VTAG_BITPLANEKEY_SET ELSE -> Turn bitplane keying off vtags[0].tag:=VTAG_BITPLANEKEY_CLR ENDIF CASE BITPLANEKEY_ID IF hitgadget.flags AND GFLG_SELECTED -> Key on current selected bitplane (chromaplane) vtags[0].tag:=VTAG_BITPLANEKEY_SET ELSE -> Turn bitplane keying off vtags[0].tag:=VTAG_BITPLANEKEY_CLR ENDIF CASE CHROMAPLANE_ID -> Set plane to key on vtags[0].tag:=VTAG_CHROMA_PLANE_SET vtags[0].data:=icode CASE BITPLANEKEY_ID IF hitgadget.flags AND GFLG_SELECTED -> Key on current selected bitplane (chromaplane) vtags[0].tag:=VTAG_BITPLANEKEY_SET ELSE -> Turn bitplane keying off vtags[0].tag:=VTAG_BITPLANEKEY_CLR ENDIF CASE CHROMAKEY_ID IF hitgadget.flags AND GFLG_SELECTED -> Set chromakey overlay on vtags[0].tag:=VTAG_CHROMAKEY_SET ELSE -> Turn chromakey overlay off vtags[0].tag:=VTAG_CHROMAKEY_CLR ENDIF ENDSELECT ENDIF -> Send video command. VideoControl(vp.colormap, vtags) -> Get the View for this genlock screen. viewlord:=ViewAddress() -> And remake the ViewPort. MakeVPort(viewlord, vp) MrgCop(viewlord) LoadView(viewlord) CASE IDCMP_CLOSEWINDOW -> Get out of here. abort:=TRUE ENDSELECT ENDWHILE UNTIL abort RemoveGList(controlwindow, glist, -1) EXCEPT DO -> E-Note: works even if glist=NIL FreeGadgets(glist) IF vi THEN FreeVisualInfo(vi) IF controlwindow THEN CloseWindow(controlwindow) IF genscreen THEN CloseScreen(genscreen) -> E-Note: the E-strings used for gadget text will be freed automatically IF gadtoolsbase THEN CloseLibrary(gadtoolsbase) imsg:=NIL -> E-Note: get ready to receive a possible error message SELECT exception CASE ERR_CTXT; imsg:='Can''t create gadget context' CASE ERR_ECS; imsg:='Requires ECS' CASE ERR_GAD; imsg:='Can''t create gadget' CASE ERR_KICK; imsg:='Requires V37' CASE ERR_LIB; imsg:='Unable to open gadtools.library' CASE ERR_SCRN; imsg:='Can''t open screen' CASE ERR_VIS; imsg:='Can''t get visual info' CASE ERR_WIN; imsg:='Can''t open window' CASE "MEM"; imsg:='Out of memory' ENDSELECT IF imsg THEN EasyRequestArgs(NIL, [SIZEOF easystruct, 0, 'GenlockDemo', '\s', 'Continue']:easystruct, NIL, [imsg]) ENDPROC ->>> ->>> PROC checkPAL(screenname) -> Generic routine to check for a PAL System. CheckPAL returns TRUE, if the -> videomode of the specified public screen (or default videmode) is PAL. If -> the screenname is NIL, the default public screen will be used. PROC checkPAL(screenname) DEF screen:PTR TO screen, modeID=LORES_KEY, displayinfo:displayinfo, isPAL IF gfx.lib.version>=36 -> We got V36, so lets use the new calls to find out what kind of videomode -> the user (hopefully) prefers. IF screen:=LockPubScreen(screenname) -> Use graphics.library/GetVPModeID() to get the ModeID of the specified -> screen. Will use the default public screen (Workbench most of the -> time) if NIL. It is _very_ unlikely that this would be invalid, heck -> it's impossible. IF INVALID_ID<>(modeID:=GetVPModeID(screen.viewport)) -> If the screen is in VGA mode, we can't tell whether the system is PAL -> or NTSC. So to be foolproof we fall back to the displayinfo of the -> default.monitor by inquiring about just the LORES_KEY displaymode if -> we don't know. The default.monitor reflects the initial video setup -> of the system, thus is an alias for either ntsc.monitor or -> pal.monitor. We only use the displaymode of the specified public -> screen if it's display mode is PAL or NTSC and NOT the default. IF ((modeID AND MONITOR_ID_MASK)<>NTSC_MONITOR_ID) AND ((modeID AND MONITOR_ID_MASK)<>PAL_MONITOR_ID) modeID:=LORES_KEY ENDIF ENDIF UnlockPubScreen(NIL, screen) ENDIF -> If fails modeID=LORES_KEY. Can't lock screen, so fall back on -> default monitor. IF GetDisplayInfoData(NIL, displayinfo, SIZEOF displayinfo, DTAG_DISP, modeID) -> Currently the default monitor is always either PAL or NTSC. isPAL:=displayinfo.propertyflags AND DIPF_IS_PAL ENDIF ELSE -> < V36. The enhancements to the videosystem in V36 cannot be better -> expressed than with the simple way to determine PAL in V34. isPAL:=gfx.displayflags AND PAL ENDIF ENDPROC isPAL ->>> Gk-lh0-BBә41Src\Rkrm\Graphics_Libraries\Primitives\RGBBoxes.en-> RGBBoxes.e - Simple ViewPort example -- works with 1.3 and Release 2 ->>> Header (globals) MODULE 'dos/dos', 'exec/libraries', 'graphics/displayinfo', 'graphics/gfx', 'graphics/gfxbase', 'graphics/gfxnodes', 'graphics/modeid', 'graphics/videocontrol', 'graphics/view' ENUM ERR_NONE, ERR_COLMAP, ERR_FINDDISP, ERR_GETDISP, ERR_GFXNEW, ERR_MONI, ERR_RAST, ERR_VIDEO RAISE ERR_COLMAP IF GetColorMap()=NIL, ERR_FINDDISP IF FindDisplayInfo()=NIL, ERR_GETDISP IF GetDisplayInfoData()=0, ERR_GFXNEW IF GfxNew()=NIL, ERR_MONI IF OpenMonitor()=NIL, ERR_RAST IF AllocRaster()=NIL, ERR_VIDEO IF VideoControl()<>NIL -> The number of bitplanes, and the nominal width and height used in 1.3. CONST DEPTH=2, WIDTH=640, HEIGHT=400 -> RGB values for the four colours used CONST BLACK=$000, RED=$f00, GREEN=$0f0, BLUE=$00f DEF bitMap:bitmap, displaymem=NIL -> Pointer for writing to BitMap memory ->>> ->>> PROC main() PROC main() HANDLE -> E-Note: a lot of the globals are really local to main() DEF view:view, oldview=NIL, viewPort:viewport, cm=NIL:PTR TO colormap, vextra=NIL:PTR TO viewextra, vpextra=NIL:PTR TO viewportextra, monspec=NIL, dimquery:dimensioninfo, depth, box, rasInfo:rasinfo, modeID, colortable, boxoffsets:PTR TO INT, gfx:PTR TO gfxbase gfx:=gfxbase -> E-Note: get the right type for gfxbase -> Set the plane pointers to NIL so the handler will know if they are used. -> E-Note: this needs to be done *before* anything that may go wrong FOR depth:=0 TO DEPTH-1 DO bitMap.planes[depth]:=NIL -> Example steals the screen from Intuition if Intuition is around. oldview:=gfx.actiview -> Save current View to restore later. InitView(view) -> Initialise the View and set view.modes. -> This is the old 1.3 way (only V_LACE counts). view.modes:=view.modes OR V_LACE IF gfx.lib.version>=36 -> Form the ModeID from values in 'graphics/displayinfo' modeID:=DEFAULT_MONITOR_ID OR HIRESLACE_KEY -> Make the viewextra object vextra:=GfxNew(VIEW_EXTRA_TYPE) -> Attach the ViewExtra to the View GfxAssociate(view, vextra) view.modes:=view.modes OR EXTEND_VSTRUCT -> Create and attach a MonitorSpec to the ViewExtra monspec:=OpenMonitor(NIL, modeID) vextra.monitor:=monspec ENDIF -> Initialise the BitMap for RasInfo. InitBitMap(bitMap, DEPTH, WIDTH, HEIGHT) -> Allocate space for BitMap FOR depth:=0 TO DEPTH-1 DO bitMap.planes[depth]:=AllocRaster(WIDTH, HEIGHT) -> Initialise the RasInfo. rasInfo:=[NIL, bitMap, 0, 0]:rasinfo InitVPort(viewPort) -> Initialise the ViewPort. view.viewport:=viewPort -> Link the ViewPort into the View. viewPort.rasinfo:=rasInfo viewPort.dwidth:=WIDTH viewPort.dheight:=HEIGHT -> Set the display mode the old-fashioned way viewPort.modes:=V_HIRES OR V_LACE IF gfx.lib.version>=36 -> Make a ViewPortExtra and get ready to attach it vpextra:=GfxNew(VIEWPORT_EXTRA_TYPE) -> Initialise the DisplayClip field of the ViewPortExtra GetDisplayInfoData(NIL, dimquery, SIZEOF dimensioninfo, DTAG_DIMS, modeID) CopyMem(dimquery.nominal, vpextra.displayclip, SIZEOF rectangle) -> E-Note: FindDisplayInfo in a the tag-list later -> This is for backwards compatibility with, for example, a 1.3 screen -> saver utility that looks at the Modes field. viewPort.modes:=modeID AND $0000FFFF ENDIF -> Initialize the ColorMap. -> 2 planes deep, so 4 entries (2 raised to the #_planes power). cm:=GetColorMap(4) IF gfx.lib.version>=36 -> Attach the color map and Release 2 extended structures VideoControl(cm, [VTAG_ATTACH_CM_SET, viewPort, VTAG_VIEWPORTEXTRA_SET, vpextra, VTAG_NORMAL_DISP_SET, FindDisplayInfo(modeID), NIL]) ELSE -> Attach the ColorMap, old 1.3-style viewPort.colormap:=cm ENDIF colortable:=[BLACK, RED, GREEN, BLUE]:INT -> Change colors to those in colortable. LoadRGB4(viewPort, colortable, 4) MakeVPort(view, viewPort) -> Construct preliminary Copper instruction list. -> Merge preliminary lists into a real Copper list in the view object MrgCop(view) -> Clear the ViewPort FOR depth:=0 TO DEPTH-1 displaymem:=bitMap.planes[depth] BltClear(displaymem, bitMap.bytesperrow*bitMap.rows, 1) ENDFOR LoadView(view) boxoffsets:=[802, 2010, 3218]:INT -> Now fill some boxes so that user can see something. -> Always draw into both planes to assure true colors. FOR box:=1 TO 3 -> Three boxes; red, green and blue. FOR depth:=0 TO DEPTH-1 -> Two planes displaymem:=bitMap.planes[depth]+boxoffsets[box-1] drawFilledBox(box, depth) ENDFOR ENDFOR Delay(10*TICKS_PER_SECOND) -> Pause for 10 seconds. LoadView(oldview) -> Put back the old View. WaitTOF() -> Wait until the View is being rendered to free memory. -> Deallocate the hardware Copper list created by MrgCopy(). Since this is -> interlace, also check for a short frame copper list to free. FreeCprList(view.lofcprlist) IF view.shfcprlist THEN FreeCprList(view.shfcprlist) -> Free all intermediate Copper lists created by MakeVPort(). FreeVPortCopLists(viewPort) EXCEPT DO -> Free the color map created by GetColorMap() IF cm THEN FreeColorMap(cm) -> Free the ViewPortExtra created by GfxNew() IF vpextra THEN GfxFree(vpextra) -> Free the BitPlanes drawing area. FOR depth:=0 TO DEPTH-1 IF bitMap.planes[depth] THEN FreeRaster(bitMap.planes[depth], WIDTH, HEIGHT) ENDFOR -> Free the MonitorSpec created with OpenMonitor(). IF monspec THEN CloseMonitor(monspec) -> Free the ViewExtra created with GfxNew(). IF vextra THEN GfxFree(vextra) SELECT exception CASE ERR_COLMAP; WriteF('Could not get ColorMap\n') CASE ERR_FINDDISP; WriteF('Could not get DisplayInfo\n') CASE ERR_GETDISP; WriteF('Could not get DimensionInfo\n') CASE ERR_GFXNEW; WriteF('Could not get ViewExtra/ViewPortExtra\n') CASE ERR_MONI; WriteF('Could not get MonitorSpec\n') CASE ERR_RAST; WriteF('Could not get BitPlanes\n') CASE ERR_VIDEO; WriteF('Could not attach extended structures\n') ENDSELECT ENDPROC IF exception<>ERR_NONE THEN RETURN_FAIL ELSE RETURN_OK ->>> ->>> PROC drawFilledBox(fillcolor, plane) -> Create a WIDTH/2 by HEIGHT/2 box of color "fillcolor" into the given plane PROC drawFilledBox(fillcolor, plane) DEF value, boxHeight, boxWidth, width -> Divide (WIDTH/2) by eight because each CHAR that is written stuffs eight -> bits into the BitMap. boxWidth:=(WIDTH/2)/8 value:=IF fillcolor AND Shl(1, plane) THEN $FF ELSE 0 -> E-Note: slightly re-expressed to read a lot better... FOR boxHeight:=1 TO HEIGHT/2 FOR width:=1 TO boxWidth DO displaymem[]++:=value displaymem:=displaymem+(bitMap.bytesperrow-boxWidth) ENDFOR ENDPROC ->>> P-lh0-yyә4:Src\Rkrm\Graphics_Libraries\Primitives\usercopperexample.e(-> UserCopperExample.e - User Copper List Example ->>> Header (globals) OPT PREPROCESS MODULE 'dos/dos', 'exec/memory', 'graphics/copper', 'graphics/gfxmacros', 'graphics/text', 'graphics/videocontrol', 'graphics/view', 'hardware/custom', 'intuition/intuition', 'intuition/preferences', 'intuition/screens' ENUM ERR_NONE, ERR_KICK, ERR_SCRN, ERR_WIN RAISE ERR_KICK IF KickVersion()=FALSE, ERR_SCRN IF OpenScreenTagList()=NIL, ERR_WIN IF OpenWindowTagList()=NIL, "MEM" IF AllocMem()=NIL DEF screen=NIL:PTR TO screen, window=NIL:PTR TO window, -> E-Note: set-up custom custom=CUSTOMADDR:PTR TO custom ->>> ->>> PROC main() PROC main() HANDLE DEF ret_val=RETURN_OK, viewPort:PTR TO viewport -> Open a screen and a window openAll() -> Create and attach the user Copper list. loadCopper() -> Wait until the user clicks in the close gadget. REPEAT UNTIL WaitIMessage(window)=IDCMP_CLOSEWINDOW EXCEPT DO IF window viewPort:=ViewPortAddress(window) IF viewPort.ucopins -> Free the memory allocated for the Copper list. FreeVPortCopLists(viewPort) RemakeDisplay() ENDIF CloseWindow(window) ENDIF IF screen THEN CloseScreen(screen) SELECT exception CASE ERR_KICK; WriteF('Error: requires V37\n') ret_val:=ERROR_INVALID_RESIDENT_LIBRARY CASE ERR_SCRN; WriteF('Error: failed to open screen\n') ret_val:=ERROR_NO_FREE_STORE CASE ERR_WIN; WriteF('Error: failed to open window\n') ret_val:=ERROR_NO_FREE_STORE CASE "MEM"; WriteF('Error: ran out of memory\n') ret_val:=ERROR_NO_FREE_STORE ENDSELECT ENDPROC ret_val ->>> ->>> PROC openAll() CONST MY_WA_WIDTH=270 -> Width of window. -> Opens screen and window -> E-Note: any exception raised here will be handled by the caller PROC openAll() KickVersion(37) screen:=OpenScreenTagList(NIL, [SA_OVERSCAN, OSCAN_STANDARD, SA_TITLE, 'User Copper List Example', SA_FONT, ['topaz.font', TOPAZ_SIXTY, 0, 0]:textattr, NIL]) -> E-Note: C version uses obsolete tags, and in fact used an IDCMP flag, -> INACTIVEWINDOW, with WA_FLAGS (I guess they meant WFLG_ACTIVATE) window:=OpenWindowTagList(NIL, [WA_CUSTOMSCREEN, screen, WA_TITLE, '<- Click here to quit.', WA_IDCMP, IDCMP_CLOSEWINDOW, WA_FLAGS, WFLG_DRAGBAR OR WFLG_CLOSEGADGET OR WFLG_ACTIVATE, WA_LEFT, (screen.width-MY_WA_WIDTH)/2, WA_TOP, screen.height/2, WA_HEIGHT, screen.font.ysize+3, WA_WIDTH, MY_WA_WIDTH, NIL]) ENDPROC ->>> ->>> PROC loadCopper() CONST NUMCOLORS=32 -> Creates a Copper list program and adds it to the system -> E-Note: again, any exception raised here will be handled by the caller PROC loadCopper() DEF i, scanlines_per_color, viewPort:PTR TO viewport, uCopList, spectrum:PTR TO INT -> Allocate memory for the Copper list. -> Make certain that the initial memory is cleared. -> E-Note: we *have* to use AllocMem() since FreeVPortCopLists() is used uCopList:=AllocMem(SIZEOF ucoplist, MEMF_PUBLIC OR MEMF_CLEAR) -> Initialise the Copper list buffer. CINIT(uCopList, NUMCOLORS) scanlines_per_color:=screen.height/NUMCOLORS spectrum:=[$0604, $0605, $0606, $0607, $0617, $0618, $0619, $0629, $072a, $073b, $074b, $074c, $075d, $076e, $077e, $088f, $07af, $06cf, $05ff, $04fb, $04f7, $03f3, $07f2, $0bf1, $0ff0, $0fc0, $0ea0, $0e80, $0e60, $0d40, $0d20, $0d00]:INT -> Load in each color. FOR i:=0 TO NUMCOLORS-1 CWAIT(uCopList, i*scanlines_per_color, 0) -> E-Note: hard to use CMOVE() due to use of {}, which CMOVEA() eliminates -> E-Note: use the offset constant COLOR plus n*SIZEOF INT for n-th color CMOVEA(uCopList, CUSTOMADDR+COLOR+0, spectrum[i]) ENDFOR CEND(uCopList) -> End the Copper list. viewPort:=ViewPortAddress(window) -> Get a pointer to the ViewPort. Forbid() -> Forbid task switching while changing the Copper list. viewPort.ucopins:=uCopList Permit() -> Permit task switching again. -> Enable user Copper list clipping this ViewPort. VideoControl(viewPort.colormap, [VTAG_USERCLIP_SET, NIL, NIL]) RethinkDisplay() -> Display the new Copper list. ENDPROC ->>> F-lh0-0%0%ә40Src\Rkrm\Graphics_Libraries\Primitives\WBClone.eY-> WBClone.e - Clone the Workbench using graphics calls ->>> Header (globals) OPT PREPROCESS MODULE 'exec/memory', 'graphics/displayinfo', 'graphics/gfx', 'graphics/gfxnodes', 'graphics/monitor', 'graphics/rastport', 'graphics/view', 'graphics/videocontrol', 'intuition/intuitionbase', 'intuition/screens' ENUM ERR_NONE, ERR_CMAP, ERR_DINFO, ERR_GFXNEW, ERR_KICK, ERR_MONI RAISE ERR_CMAP IF GetColorMap()=NIL, ERR_DINFO IF GetDisplayInfoData()=NIL, ERR_GFXNEW IF GfxNew()=NIL, ERR_KICK IF KickVersion()=FALSE, ERR_MONI IF OpenMonitor()=NIL #define INTUITIONNAME 'intuition.library' ->>> ->>> PROC destroyView(view:PTR TO view) -> Close and free everything to do with the View PROC destroyView(view:PTR TO view) DEF ve:PTR TO viewextra IF view IF ve:=GfxLookUp(view) IF ve.monitor THEN CloseMonitor(ve.monitor) GfxFree(ve) ENDIF -> Free up the copper lists IF view.lofcprlist THEN FreeCprList(view.lofcprlist) IF view.shfcprlist THEN FreeCprList(view.shfcprlist) Dispose(view) ENDIF ENDPROC ->>> ->>> PROC dupView(v:PTR TO view, modeID) -> Duplicate the View PROC dupView(v:PTR TO view, modeID) HANDLE -> Allocate and init a view OBJECT. Also, get a viewextra OBJECT and -> attach the monitor type to the View. DEF view=NIL:PTR TO view, ve=NIL:PTR TO viewextra, mspc=NIL:PTR TO monitorspec view:=NewM(SIZEOF view, MEMF_CLEAR OR MEMF_PUBLIC) ve:=GfxNew(VIEW_EXTRA_TYPE) mspc:=OpenMonitor(NIL, modeID) InitView(view) view.dyoffset:=v.dyoffset view.dxoffset:=v.dxoffset view.modes:=v.modes GfxAssociate(view, ve) ve.monitor:=mspc RETURN view EXCEPT -> E-Note: C version is wrong; failure may happen before attaching to view IF mspc THEN CloseMonitor(mspc) IF ve THEN GfxFree(ve) IF view THEN Dispose(view) ReThrow() -> E-Note: pass on exception if it was an error ENDPROC ->>> ->>> PROC destroyViewPort(vp:PTR TO viewport) -> Close and free everything to do with the viewport PROC destroyViewPort(vp:PTR TO viewport) DEF cm:PTR TO colormap, ti:PTR TO LONG IF vp -> Find the ViewPort's ColorMap. From that use VideoControl to get the -> ViewPortExtra, and free it. -> Then free the ColorMap, and finally the ViewPort itself. IF cm:=vp.colormap -> E-Note: ti[1] will be filled in by the call to VideoControl IF VideoControl(cm, ti:=[VTAG_VIEWPORTEXTRA_GET, NIL, NIL])=NIL GfxFree(ti[1]) ELSE WriteF('VideoControl error in destroyViewPort()\n') ENDIF FreeColorMap(cm) ELSE WriteF('Could not free the ColorMap\n') ENDIF FreeVPortCopLists(vp) Dispose(vp) ENDIF ENDPROC ->>> ->>> PROC dupViewPort(vp:PTR TO viewport, modeID) CONST COLOURS=32 -> E-Note: this is a bit out of date... -> Duplicate the ViewPort PROC dupViewPort(vp:PTR TO viewport, modeID) HANDLE -> Allocate and initialise a ViewPort. Copy the ViewPort width and heights, -> offsets, and modes values. Allocate and initialise a ColorMap. -> -> Also, allocate a ViewPortExtra, and copy the TextOScan values of the -> ModeID from the database into the ViewPortExtra. DEF myvp=NIL:PTR TO viewport, vpe=NIL:PTR TO viewportextra, cm=NIL:PTR TO colormap, query:dimensioninfo, colour, c myvp:=NewM(SIZEOF viewport, MEMF_CLEAR OR MEMF_PUBLIC) vpe:=GfxNew(VIEWPORT_EXTRA_TYPE) cm:=GetColorMap(COLOURS) -> E-Note: use the constant that's been defined! GetDisplayInfoData(NIL, query, SIZEOF dimensioninfo, DTAG_DIMS, modeID) InitVPort(myvp) -> Duplicate the viewport object myvp.dwidth:=vp.dwidth myvp.dheight:=vp.dheight myvp.dxoffset:=vp.dxoffset myvp.dyoffset:=vp.dyoffset myvp.modes:=vp.modes myvp.spritepriorities:=vp.spritepriorities myvp.extendedmodes:=vp.extendedmodes -> Duplicate the Overscan values CopyMem(query.txtoscan, vpe.displayclip, SIZEOF rectangle) -> Attach everything together IF VideoControl(cm, [VTAG_ATTACH_CM_SET, myvp, VTAG_VIEWPORTEXTRA_SET, vpe, VTAG_NORMAL_DISP_SET, FindDisplayInfo(modeID), NIL]) WriteF('VideoControl error in duplicateViewPort()\n') ENDIF -> Copy the colours from the Workbench FOR c:=0 TO COLOURS-1 IF -1<>(colour:=GetRGB4(vp.colormap, c)) SetRGB4CM(cm, c, Shr(colour, 8), Shr(colour, 4) AND $F, colour AND $F) ENDIF ENDFOR RETURN myvp EXCEPT -> E-Note: C version is wrong; failure may happen before attaching to myvp IF cm THEN FreeColorMap(cm) IF vpe THEN GfxFree(vpe) IF myvp THEN Dispose(myvp) ReThrow() -> E-Note: pass on exception if an error ENDPROC ->>> ->>> PROC destroyBitMap(mybm:PTR TO bitmap, width, height, depth) -> Close and free everything to do with the BitMap PROC destroyBitMap(mybm:PTR TO bitmap, width, height, depth) DEF i IF mybm FOR i:=0 TO depth-1 IF mybm.planes[i] THEN FreeRaster(mybm.planes[i], width, height) ENDFOR Dispose(mybm) ENDIF ENDPROC ->>> ->>> PROC createBitMap(width, height, depth) -> Create the BitMap PROC createBitMap(width, height, depth) HANDLE -> Allocate a bitmap OBJECT, initialise it and allocate each plane. DEF mybm:PTR TO bitmap, i mybm:=NewM(SIZEOF bitmap, MEMF_CLEAR OR MEMF_PUBLIC) InitBitMap(mybm, depth, width, height) FOR i:=0 TO depth-1 mybm.planes[i]:=AllocRaster(width, height) ENDFOR RETURN mybm EXCEPT -> E-Note: hey! the C version is OK this time! destroyBitMap(mybm, width, height, depth) ReThrow() -> E-Note: pass on exception if an error ENDPROC ->>> ->>> PROC showView(view, vp, bm, width, height) -> Assemble and display the View PROC showView(view:PTR TO view, vp:PTR TO viewport, bm:PTR TO bitmap, width, height) HANDLE -> Attach the BitMap to the ViewPort via a RasInfo. Attach the ViewPort to -> the View. Clear the BitMap, and draw into it by attaching the BitMap to -> a RastPort. Then MakeVPort(), MrgCop() and LoadView(). -> Just wait for the user to press before returning. DEF rp=NIL:PTR TO rastport, ri=NIL:PTR TO rasinfo rp:=NewM(SIZEOF rastport, MEMF_CLEAR OR MEMF_PUBLIC) ri:=NewM(SIZEOF rasinfo, MEMF_CLEAR OR MEMF_PUBLIC) InitRastPort(rp) rp.bitmap:=bm ri.bitmap:=bm vp.rasinfo:=ri view.viewport:=vp -> Render SetRast(rp, 0) -> Clear the background SetAPen(rp, Shl(1, bm.depth)-1) -> Use the last pen Move(rp, 0, 0) Draw(rp, width, 0) Draw(rp, width, height) Draw(rp, 0, height) Draw(rp, 0, 0) -> Display it MakeVPort(view, vp) MrgCop(view) LoadView(view) -> E-Note: make this work even under Workbench WriteF(''); Inp(IF stdin THEN stdin ELSE stdout) -> Bring back the system RethinkDisplay() EXCEPT DO IF ri THEN Dispose(ri) IF rp THEN Dispose(rp) ReThrow() -> E-Note: pass on exception if an error ENDPROC ->>> ->>> PROC main() -> Clone the Workbench View using Graphics Library calls. PROC main() HANDLE DEF wb=NIL:PTR TO screen, myview=NIL, myvp=NIL, mybm=NIL, modeID, ibaseLock=NIL, intuition:PTR TO intuitionbase KickVersion(37) -> E-Note: requires V37 -> To clone the Workbench using graphics calls involves duplicating the -> Workbench ViewPort, ViewPort mode, and Intuition's View. This also -> involves duplicating the DisplayClip for the overscan value, the colours, -> and the View position. -> -> When this is all done, the View, ViewPort, ColorMap and BitMap (and -> ViewPortExtra, ViewExtra and RasInfo) all have to be linked together, and -> the copperlists made to create the display. -> -> This is not as difficult as it sounds (trust me!) -> First, lock the Workbench screen, so no changes can be made to it while -> we are duplicating it. wb:=LockPubScreen('Workbench') -> Find the Workbench's ModeID. This is a 32-bit number that identifies the -> monitor type, and the display mode of that monitor. modeID:=GetVPModeID(wb.viewport) -> We need to duplicate Intuition's View structure, so lock IntuitionBase to -> prevent the View changing under our feet. ibaseLock:=LockIBase(0) intuition:=intuitionbase -> E-Note: get the right type for intuitionbase myview:=dupView(intuition.viewlord, modeID) -> The View has been cloned, so we don't need to keep it locked. UnlockIBase(ibaseLock) ibaseLock:=NIL -> E-Note: set to NIL so we don't Unlock it again -> Now duplicate the Workbench's ViewPort. Remember, we still have the -> Workbench locked. myvp:=dupViewPort(wb.viewport, modeID) -> Create a BitMap to render into. This will be of the same dimensions -> as the Workbench. mybm:=createBitMap(wb.width, wb.height, wb.bitmap.depth) -> Now we have everything copied, show something showView(myview, myvp, mybm, wb.width-1, wb.height-1) EXCEPT DO -> Free up everything we may have allocated or still have locked IF mybm THEN destroyBitMap(mybm, wb.width, wb.height, wb.bitmap.depth) IF myvp THEN destroyViewPort(myvp) IF myview THEN destroyView(myview) IF ibaseLock THEN UnlockIBase(ibaseLock) IF wb THEN UnlockPubScreen(NIL, wb) SELECT exception CASE ERR_CMAP; WriteF('Could not get ColorMap\n') CASE ERR_DINFO; WriteF('Display database error\n') CASE ERR_GFXNEW; WriteF('Could not get the View-/ViewPort- Extra\n') CASE ERR_KICK; WriteF('Requires at least V37\n') CASE ERR_MONI; WriteF('Could not open monitor\n') CASE "MEM"; WriteF('Ran out of memory\n') ENDSELECT ENDPROC ->>> J-lh0-'3'3ә44Src\Rkrm\Graphics_Libraries\Sprites_Bobs\animtools.e0)-> animtools.e -> -> This file is a collection of tools which are used with the VSprite, Bob and -> Animation system software. It is intended as a useful EXAMPLE, and while it -> shows what must be done, it is not the only way to do it. If Not Enough -> Memory, or error return, each cleans up after itself before returning. -> NOTE that these routines assume a very specific structure to the GEL lists. -> Make sure that you use the correct pairs together -> (i.e., makeOb()/freeOb()) ->>> Header (globals) OPT MODULE, PREPROCESS OPT EXPORT MODULE 'exec/memory', 'graphics/gels', 'graphics/gfx', 'graphics/rastport' -> 'intuition/intuitionbase' does not define a library name. #define INTUITIONNAME 'intuition.library' -> These objects are used by the functions below to allow for an easier -> interface to the animation system. ->>> ->>> OBJECT newVSprite -> Object to hold information for a new VSprite. OBJECT newVSprite image:PTR TO INT -> Image data for the VSprite colorSet:PTR TO INT -> Colour array for the VSprite wordWidth:INT -> Width in words lineHeight:INT -> Height in lines imageDepth:INT -> Depth of the image x:INT -> Initial x position y:INT -> Initial y position flags:INT -> VSprite flags hitMask:INT -> Hit mask meMask:INT -> Me mask ENDOBJECT ->>> ->>> OBJECT newBob -> Object to hold information for a new Bob. OBJECT newBob image:PTR TO INT -> Image data FOR the Bob wordWidth:INT -> Width in words lineHeight:INT -> Height in lines imageDepth:INT -> Depth of the image planePick:INT -> Planes that get image data planeOnOff:INT -> Unused planes to turn on bFlags:INT -> Bob flags dBuf:INT -> 1=double buf, 0=not rasDepth:INT -> Depth of the raster x:INT -> Initial x position y:INT -> Initial y position hitMask:INT -> Hit mask meMask:INT -> Me mask ENDOBJECT ->>> ->>> OBJECT newAnimComp -> Object to hold information for a new animation component. OBJECT newAnimComp routine:LONG -> Routine called when Comp IS displayed xt:INT -> Initial delta offset position yt:INT time:INT -> Initial timer value cFlags:INT -> Flags for the Comp ENDOBJECT ->>> ->>> OBJECT newAnimSeq -> Object to hold information for a new animation sequence. OBJECT newAnimSeq headOb:PTR TO ao -> Common head of object images:PTR TO INT -> Array of Comp image data xt:PTR TO INT -> Arrays of initial offsets yt:PTR TO INT times:PTR TO INT -> Array of initial timer values routines:PTR TO LONG -> Array of functions called when Comp is drawn cFlags:INT -> Flags for the Comp count:INT -> Number of Comps in sequence (= arrays size) singleImage:INT -> One (or count) images ENDOBJECT ->>> ->>> PROC setupGelSys(rPort:PTR TO rastport, reserved) HANDLE -> Setup the GELs system. After this call is made you can use VSprites, Bobs, -> AnimComps and AnimObs. Note that this links the GelsInfo structure into the -> RastPort, and calls InitGels(). It uses information in your rastport -> object to establish boundary collision defaults at the outer edges of the -> raster. This routine sets up for everything - collision detection and all. -> You must already have run LoadView before ReadyGelSys is called. PROC setupGelSys(rPort:PTR TO rastport, reserved) HANDLE DEF gInfo=NIL:PTR TO gelsinfo, vsHead=NIL:PTR TO vs, vsTail=NIL:PTR TO vs NEW gInfo, vsHead, vsTail NEW gInfo.nextline[8], gInfo.lastcolor[8], gInfo.collhandler gInfo.sprrsrvd:=reserved -> Set left- and top-most to 1 to better keep items inside the display -> boundaries. gInfo.leftmost:=1; gInfo.topmost:=1 gInfo.rightmost:=(rPort.bitmap.bytesperrow*8)-1 gInfo.bottommost:=rPort.bitmap.rows-1 rPort.gelsinfo:=gInfo InitGels(vsHead, vsTail, gInfo) EXCEPT IF gInfo THEN END gInfo.nextline[8], gInfo.lastcolor[8], gInfo.collhandler END gInfo, vsHead, vsTail ReThrow() ENDPROC gInfo ->>> ->>> PROC cleanupGelSys(gInfo:PTR TO gelsinfo, rPort:PTR TO rastport) -> Free all of the stuff allocated by setupGelSys(). Only call this routine if -> setupGelSys() returned successfully. The GelsInfo structure IS the one -> returned by setupGelSys(). It also unlinks the GelsInfo from the RastPort. PROC cleanupGelSys(gInfo:PTR TO gelsinfo, rPort:PTR TO rastport) rPort.gelsinfo:=NIL END gInfo.nextline[8], gInfo.lastcolor[8], gInfo.collhandler, gInfo.gelhead, gInfo.geltail END gInfo ENDPROC ->>> ->>> PROC makeVSprite(nVSprite:PTR TO newVSprite) HANDLE -> Create a VSprite from the information given in nVSprite. Use freeVSprite() -> to free this GEL. PROC makeVSprite(nVSprite:PTR TO newVSprite) HANDLE DEF vsprite=NIL:PTR TO vs, line_size, plane_size line_size:=SIZEOF INT * nVSprite.wordWidth plane_size:=line_size * nVSprite.lineHeight NEW vsprite vsprite.borderline := NewM(line_size, MEMF_CHIP) vsprite.collmask := NewM(plane_size, MEMF_CHIP) vsprite.y := nVSprite.y vsprite.x := nVSprite.x vsprite.vsflags := nVSprite.flags vsprite.width := nVSprite.wordWidth vsprite.depth := nVSprite.imageDepth vsprite.height := nVSprite.lineHeight vsprite.memask := nVSprite.meMask vsprite.hitmask := nVSprite.hitMask vsprite.imagedata := nVSprite.image vsprite.sprcolors := nVSprite.colorSet vsprite.planepick := 0 vsprite.planeonoff := 0 InitMasks(vsprite) EXCEPT IF vsprite Dispose(vsprite.borderline) Dispose(vsprite.collmask) ENDIF END vsprite ReThrow() ENDPROC vsprite ->>> ->>> PROC makeBob(nBob:PTR TO newBob) HANDLE -> Create a Bob from the information given in nBob. Use freeBob() to free this -> GEL. A VSprite is created for this bob. This routine properly allocates -> all double buffered information if it is required. PROC makeBob(nBob:PTR TO newBob) HANDLE DEF bob=NIL:PTR TO bob, vsprite=NIL:PTR TO vs, rassize rassize:=SIZEOF INT * nBob.wordWidth * nBob.lineHeight * nBob.rasDepth NEW bob bob.savebuffer:=NewM(rassize, MEMF_CHIP) vsprite:=makeVSprite([nBob.image, NIL, nBob.wordWidth, nBob.lineHeight, nBob.imageDepth, nBob.x, nBob.y, nBob.bFlags, nBob.hitMask, nBob.meMask]:newVSprite) vsprite.planepick:=nBob.planePick vsprite.planeonoff:=nBob.planeOnOff vsprite.vsbob:=bob bob.bobvsprite:=vsprite bob.imageshadow:=vsprite.collmask bob.bobflags:=0 bob.before:=NIL bob.after:=NIL bob.bobcomp:=NIL IF nBob.dBuf NEW bob.dbuffer bob.dbuffer.bufbuffer:=NewM(rassize, MEMF_CHIP) ELSE bob.dbuffer:=NIL ENDIF EXCEPT IF vsprite THEN freeVSprite(vsprite) IF bob IF bob.dbuffer THEN Dispose(bob.dbuffer.bufbuffer) END bob.dbuffer Dispose(bob.savebuffer) ENDIF END bob ReThrow() ENDPROC bob ->>> ->>> PROC makeComp(nBob:PTR TO newBob, nAnimComp:PTR TO newAnimComp) HANDLE -> Create a Animation Component from the information given in nAnimComp and -> nBob. Use freeComp() to free this GEL. makeComp() calls makeBob(), and -> links the Bob into an AnimComp. PROC makeComp(nBob:PTR TO newBob, nAnimComp:PTR TO newAnimComp) HANDLE DEF compBob=NIL:PTR TO bob, aComp=NIL:PTR TO ac NEW aComp compBob:=makeBob(nBob) compBob.before:=NIL compBob.after:=NIL compBob.bobcomp:=aComp -> Link 'em up aComp.animbob := compBob aComp.timeset := nAnimComp.time -> Number of ticks active aComp.ytrans := nAnimComp.yt -> Offset relative to HeadOb aComp.xtrans := nAnimComp.xt aComp.animcroutine := nAnimComp.routine aComp.compflags := nAnimComp.cFlags aComp.timer := 0 aComp.prevseq := NIL aComp.nextseq := NIL aComp.prevcomp := NIL aComp.nextcomp := NIL aComp.headob := NIL EXCEPT -> E-Note: Don't need to freeBob(compBob)... END aComp ReThrow() ENDPROC aComp ->>> ->>> PROC makeSeq(nBob:PTR TO newBob, nAnimSeq:PTR TO newAnimSeq) HANDLE -> Create an Animation Sequence from the information given in nAnimSeq and -> nBob. Use freeSeq() to free this GEL. This routine creates a linked list -> of animation components which make up the animation sequence. It links them -> all up, making a circular list of the prevseq and nextseq pointers. That is -> to say, the first component of the sequence's prevseq points to the last -> component; the last component of the sequence's nextseq points back to the -> first component. If dbuf is on, the underlying Bobs will be set up for -> double buffering. If singleImage is non-zero, the 'images' pointer is -> assumed to point to an array of only one image, instead of an array of -> 'count' images, and all Bobs will use the same image. PROC makeSeq(nBob:PTR TO newBob, nAnimSeq:PTR TO newAnimSeq) HANDLE DEF seq, firstCompInSeq=NIL:PTR TO ac, seqComp=NIL:PTR TO ac, lastCompMade=NIL:PTR TO ac, image_size, nAnimComp:newAnimComp -> Get the initial image. This is the only image that is used if -> nAnimSeq.singleImage is non-zero. nBob.image:=nAnimSeq.images image_size:=nBob.lineHeight * nBob.imageDepth * nBob.wordWidth -> For each comp in the sequence FOR seq:=0 TO nAnimSeq.count-1 nAnimComp.xt := nAnimSeq.xt[seq] nAnimComp.yt := nAnimSeq.yt[seq] nAnimComp.time := nAnimSeq.times[seq] nAnimComp.routine := nAnimSeq.routines[seq] nAnimComp.cFlags := nAnimSeq.cFlags seqComp:=makeComp(nBob, nAnimComp) seqComp.headob:=nAnimSeq.headOb -> Make a note of where the first component is. IF firstCompInSeq=NIL THEN firstCompInSeq:=seqComp -> Link the component into the list IF lastCompMade<>NIL THEN lastCompMade.nextseq:=seqComp seqComp.nextseq:=NIL seqComp.prevseq:=lastCompMade lastCompMade:=seqComp -> If nAnimSeq.singleImage is zero, the image array has nAnimSeq.count -> images. IF nAnimSeq.singleImage=0 -> E-Note: image_size is in INTs so multiply up first nBob.image:=nBob.image+(image_size*SIZEOF INT) ENDIF ENDFOR -> On the last component in the sequence, set Next/Prev to make the linked -> list a loop of components. lastCompMade.nextseq:=firstCompInSeq firstCompInSeq.prevseq:=lastCompMade EXCEPT IF firstCompInSeq THEN freeSeq(firstCompInSeq, nBob.rasDepth) ReThrow() ENDPROC firstCompInSeq ->>> ->>> PROC freeVSprite(vsprite:PTR TO vs) -> Free the data created by makeVSprite(). Assumes images deallocated -> elsewhere. PROC freeVSprite(vsprite:PTR TO vs) DEF line_size, plane_size line_size:=SIZEOF INT * vsprite.width plane_size:=line_size * vsprite.height Dispose(vsprite.borderline) Dispose(vsprite.collmask) END vsprite ENDPROC ->>> ->>> PROC freeBob(bob:PTR TO bob, rasdepth) -> Free the data created by makeBob(). It's important that rasdepth match the -> depth you passed to makeBob() when this GEL was made. Assumes images -> deallocated elsewhere. PROC freeBob(bob:PTR TO bob, rasdepth) DEF rassize rassize:=SIZEOF INT * bob.bobvsprite.width * bob.bobvsprite.height * rasdepth IF bob.dbuffer THEN Dispose(bob.dbuffer.bufbuffer) END bob.dbuffer Dispose(bob.savebuffer) freeVSprite(bob.bobvsprite) END bob ENDPROC ->>> ->>> PROC freeComp(myComp:PTR TO ac, rasdepth) -> Free the data created by makeComp(). It's important that rasdepth match -> the depth you passed to makeComp() when this GEL was made. Assumes images -> deallocated elsewhere. PROC freeComp(myComp:PTR TO ac, rasdepth) freeBob(myComp.animbob, rasdepth) END myComp ENDPROC ->>> ->>> PROC freeSeq(headComp:PTR TO ac, rasdepth) -> Free the data created by makeSeq(). Complementary to makeSeq(), this -> routine goes through the nextseq pointers and frees the Comps. This routine -> only goes forward through the list, and so it must be passed the first -> component in the sequence, or the sequence must be circular (which is -> guaranteed if you use makeSeq()). It's important that rasdepth match the -> depth you passed to makeSeq() when this GEL was made. Assumes images -> deallocated elsewhere! PROC freeSeq(headComp:PTR TO ac, rasdepth) DEF curComp:PTR TO ac, nextComp -> Break the nextseq loop, so we get a NIL at the end of the list. headComp.prevseq.nextseq:=NIL curComp:=headComp -> Get the start of the list WHILE curComp<>NIL nextComp:=curComp.nextseq freeComp(curComp, rasdepth) curComp:=nextComp ENDWHILE ENDPROC ->>> ->>> PROC freeOb(headOb:PTR TO ao, rasdepth) -> Free an animation object (list of sequences). freeOb() goes through the -> nextcomp pointers, starting at the AnimOb's headcomp, and frees every -> sequence. It only goes forward. It then frees the Object itself. Assumes -> images deallocated elsewhere! PROC freeOb(headOb:PTR TO ao, rasdepth) DEF curSeq:PTR TO ac, nextSeq curSeq:=headOb.headcomp -> Get the start of the list WHILE curSeq<>NIL nextSeq:=curSeq.nextcomp freeSeq(curSeq, rasdepth) curSeq:=nextSeq ENDWHILE END headOb ENDPROC ->>> J-lh0-  ә44Src\Rkrm\Graphics_Libraries\Sprites_Bobs\animtools.mĎEMOD 'NUHp+@p+@p+@/,/,/,)OA)H)MHx&NxX+@Hx>NxX+@Hx>NxX+@p/NxX m!@ p/NxX m!@Hx@NxX m!@ - mp m1@p m1@ m h0HS m1@ m h0(HS m1@ - m !@ m"m$m,lN)_)_)_` -gf m ( g/p/NwP mB m (g/p/NwP mB m (g/Hx@NwP mB -g/Hx&NwPB -g/Hx>NwPB -g/Hx>NwPBNe -LN]NuNUp m!@ m ( g/p/NwP m B m (g/p/NwP m B m (g/Hx@NwP m B m (g/Hx>NwP m B m (g/Hx>NwP m B - g/Hx&NwPB pN]NuNUHp+@/,/,/,)OAR)H)Mp m2(H+@ - m2( H+@Hx>NxX+@/-HxNhO m!@(/-HxNhO m!@, m0(H m1@ m0(H m1@ m0(H m1@ m0(H m1@ m0( H m1@ m0( H m1@ m0(H m1@ m0(H m1@" m  m!@$ m ( m!@0p m@8p m@9 m,lN)_)_)_`P -g* m ((/NMO m (,/NMO -g/Hx>NwPBNe -LN]NuNUHp+@p+@/,/,/,)OA)H)Mp m2(H m2(H m2(H+@Hx"NxX+@/-HxNhO m!@ m / m0(H/ m0(H/ m0(H/ m0(H/ m0(H/ m0(H/ m0(H/ m0(H/A ` "1A"1A"1A"1A"1A"1A "1A "1A!_/aO+@ m0( H m@8 m0( H m@9 - m!@4 - m!@ m (, m!@p m0p m!@ p m!@p m!@ m0(HJg8HxNxX m!@/-HxNhO m h!@` p m!@)_)_)_` -g/-aO -g\ m (Jg m h (/NMO m (g/HxNwP mB m (/NMO -g/Hx"NwPBNe -LN]NuNUHp+@p+@/,/,/,)OA)H)MHx&NxX+@/- aO+@p m!@ p m!@ - m!@ - m!@" m0(H m1@ m0(H m1@ m0(H m1@ m  m!@ m0( H m0p m1@p m!@p m!@p m!@ p m!@p m!@)_)_)_` -g/Hx&NwPBNe -LN]NuNUHp+@p+@p+@O+O/,/,/,)OA)H)M m ( m m 0(H m 2(H m 2(H+@p+@ m0(HSk m h$-00(H m1@ m h $-00(H m1@ m h$-00(H m1@ m h$- 0( m m0(H m1@ /- /-aO+@ m  m!@ -f+m -g - m!@p m!@ - m!@+m m0(HJf$ m / -/p" " Ё m R` - m!@ - m!@)_)_)_`( -g/- m 0(H/aONe - LN]NuNUHp m2(H,  m2(H. m ((/NMO m (,/NMO -g/Hx>NwPBpLN]NuNUHp m h2(H m h2(H . m (Jg m h (/NMO m (g/HxNwP m B m (/NMO m (/aO - g/Hx"NwPB pLN]NuNU m ("//-a.O - g/Hx&NwPB pN]NuNUHp m h!@,- g F (.//-aO,`pLN]NuNUH m ($, g F (.//-aO,` - g/Hx,NwPB pLN]Nu0 p V ހ ʀ v<0zbxlVB@&pP0܀ЀdBn\L< freeComp myComp,rasdepth makeCompLnBob,nAnimComp freeVSprite vsprite makeVSprite nVSpritecleanupGelSys gInfo,rPort setupGelSysrPort,reservedfreeBob bob,rasdepthmakeBobnBobfreeOb DheadOb,rasdepthfreeSeq headComp,rasdepthmakeSeqnBob,nAnimSeq newAnimSeqheadObaoimagesxt yttimes routinescFlagscount singleImage newAnimComproutinextyttime cFlags newBobimage wordWidth lineHeight imageDepth  planePick  planeOnOffbFlagsdBuf rasDepthxyhitMaskmeMask newVSpriteimage colorSet wordWidth  lineHeight  imageDepthxyflagshitMaskmeMask INTUITIONNAME'intuition.library'D6-lh0-ә4.Src\Rkrm\Graphics_Libraries\Sprites_Bobs\bob.e0}-> bob.e - Simple Bob example ->>> Header (globals) OPT PREPROCESS MODULE 'dos/dos', 'exec/memory', 'exec/ports', 'graphics/gels', 'intuition/intuition', 'intuition/screens', '*animtools' ENUM ERR_NONE, ERR_KICK, ERR_WIN RAISE ERR_KICK IF KickVersion()=FALSE, ERR_WIN IF OpenWindow()=NIL CONST GEL_SIZE=4 DEF bob_data1, bob_data2, myNewBob:PTR TO newBob ->>> ->>> PROC bobDrawGList(rport, vport) -> Draw the Bobs into the RastPort. PROC bobDrawGList(rport, vport) SortGList(rport) DrawGList(rport, vport) -> If the GelsList includes true VSprites, MrgCop() and LoadView() here WaitTOF() ENDPROC ->>> ->>> PROC process_window(win:PTR TO window, myBob:PTR TO bob) -> Process window and dynamically change bob: Get messages. Go away on -> IDCMP_CLOSEWINDOW. Update and redisplay bob on IDCMP_INTUITICKS. Wait for -> more messages. PROC process_window(win:PTR TO window, myBob:PTR TO bob) DEF msg:PTR TO intuimessage LOOP Wait(Shl(1, win.userport.sigbit)) WHILE msg:=GetMsg(win.userport) -> Only IDCMP_CLOSEWINDOW AND IDCMP_INTUITICKS are active IF msg.class=IDCMP_CLOSEWINDOW ReplyMsg(msg) RETURN ENDIF -> Must be IDCMP_INTUITICKS: change x and y values on the fly. Note: do -> not have to add window offset, Bob is relative to the window (sprite -> relative to screen). myBob.bobvsprite.x:=msg.mousex+20 myBob.bobvsprite.y:=msg.mousey+1 ReplyMsg(msg) ENDWHILE -> After getting a message, change image data on the fly myBob.bobvsprite.imagedata:=IF myBob.bobvsprite.imagedata=bob_data1 THEN bob_data2 ELSE bob_data1 InitMasks(myBob.bobvsprite) -> Set up masks for new image bobDrawGList(win.rport, ViewPortAddress(win)) ENDLOOP ENDPROC ->>> ->>> PROC do_Bob(win:PTR TO window) -> Working with the Bob: setup the GEL system, and get a new Bob (makeBob()). -> Add the bob to the system and display. Use the Bob. When done, remove the -> Bob and update the display without the bob. Cleanup everything. PROC do_Bob(win:PTR TO window) HANDLE DEF myBob=NIL, my_ginfo=NIL my_ginfo:=setupGelSys(win.rport, $03) myBob:=makeBob(myNewBob) AddBob(myBob, win.rport) bobDrawGList(win.rport, ViewPortAddress(win)) process_window(win, myBob) RemBob(myBob) bobDrawGList(win.rport, ViewPortAddress(win)) EXCEPT DO IF myBob THEN freeBob(myBob, myNewBob.rasDepth) IF my_ginfo THEN cleanupGelSys(my_ginfo, win.rport) ReThrow() ENDPROC ->>> ->>> PROC main() PROC main() HANDLE DEF win=NIL KickVersion(37) -> E-Note: set-up global data -> Bob data - two sets that are alternated between. Note that this data is -> at the resolution of the screen. bob_data1:=copyListToChip([$FFFF0003, $FFF00003, $FFF00003, $FFFF0003, $3FFFFFFC, $3FF00FFC, $3FF00FFC, $3FFFFFFC]) bob_data2:=copyListToChip([$C000FFFF, $C0000FFF, $C0000FFF, $C000FFFF, $3FFFFFFC, $3FF00FFC, $3FF00FFC, $3FFFFFFC]) -> Data for the new Bob object defined in animtools.m myNewBob:=[bob_data2, 2, GEL_SIZE, 2, 3, 0, VSF_SAVEBACK OR VSF_OVERLAY, 0, 8, 160, 100, 0, 0]:newBob win:=OpenWindow([80, 20, 400, 150, -1, -1, IDCMP_CLOSEWINDOW OR IDCMP_INTUITICKS, WFLG_ACTIVATE OR WFLG_CLOSEGADGET OR WFLG_DEPTHGADGET OR WFLG_RMBTRAP, NIL, NIL, 'Bob', NIL, NIL, 0, 0, 0, 0, WBENCHSCREEN]:nw) do_Bob(win) EXCEPT DO IF win THEN CloseWindow(win) SELECT exception CASE ERR_KICK; WriteF('Error: requires V37\n') CASE ERR_WIN; WriteF('Error: could not open window\n') CASE "MEM"; WriteF('Error: ran out of memory\n') ENDSELECT ENDPROC IF exception<>ERR_NONE THEN RETURN_FAIL ELSE RETURN_OK ->>> ->>> PROC copyListToChip(data) -> E-Note: get some Chip memory and copy list (quick, since LONG aligned) PROC copyListToChip(data) DEF size, mem size:=ListLen(data)*SIZEOF LONG mem:=NewM(size, MEMF_CHIP) CopyMemQuick(data, mem, size) ENDPROC mem ->>> H-lh0-&P&Pә42Src\Rkrm\Graphics_Libraries\Sprites_Bobs\collide.e^-> collide.e - An example of collision detection between objects and between -> the border. ->>> Header (globals) OPT PREPROCESS MODULE 'dos/dos', 'exec/memory', 'graphics/collide', 'graphics/gels', 'graphics/gfx', 'graphics/rastport', 'graphics/view', 'intuition/intuition', 'intuition/screens', 'other/ecode', '*animtools' ENUM ERR_NONE, ERR_RAST, ERR_SCRN, ERR_WIN RAISE ERR_RAST IF AllocRaster()=NIL, ERR_SCRN IF OpenScreen()=NIL, ERR_WIN IF OpenWindow()=NIL CONST RBMWIDTH=320, RBMHEIGHT=200, RBMDEPTH=4 -> These give the number of frames (COUNT), size (HEIGHT, WIDTH, DEPTH), and -> word width (WWIDTH) of the animated object. CONST BOING_COUNT=6, BOING_HEIGHT=25, BOING_WIDTH=32, BOING_DEPTH=1 CONST BOING_WWIDTH=BOING_WIDTH+15/16 -> These are the IDs for the system to use for the three objects. These -> numbers will be used for the collision detection system. -> -> Do not use zero (0), as it is reserved by the collision system for border -> hits (see 'graphics/collide', BORDERHIT). ENUM BOING_1=2, BOING_2, BOING_3 DEF ns:PTR TO ns, nw:PTR TO nw, boing3Times:PTR TO INT, boing3YTranses:PTR TO INT, boing3XTranses:PTR TO INT, boing3CRoutines:PTR TO LONG, boing3Image:PTR TO LONG, newBoingBob:PTR TO newBob, newBoingSeq:PTR TO newAnimSeq -> E-Note: this is the static variable from setupBitMaps(). DEF myBitMaps[2]:ARRAY OF LONG ->>> ->>> PROC setupGlobals() PROC setupGlobals() ns:=[0, 0, 320, 200, 2, 0, 1, NIL, CUSTOMSCREEN, NIL, 'Collision with AnimObs', NIL, NIL]:ns nw:=[50, 50, 220, 100, -1, -1, IDCMP_CLOSEWINDOW, WFLG_CLOSEGADGET OR WFLG_RMBTRAP, NIL, NIL, 'Close Window to Stop', NIL, NIL, 150, 100, 150, 100, CUSTOMSCREEN]:nw -> These are the number of counts that each frame is displayed. They are -> all one, so each frame is displayed once then the animation system will -> move on to the next in the sequence. boing3Times:=[1, 1, 1, 1, 1, 1]:INT -> These are all set to zero as we do not want anything added to the X and Y -> positions using ring motion control. All movement is done using the -> acceleration and velocity values. boing3YTranses:=[0, 0, 0, 0, 0, 0]:INT boing3XTranses:=[0, 0, 0, 0, 0, 0]:INT -> No special routines to call when each anim comp is displayed. boing3CRoutines:=[NIL, NIL, NIL, NIL, NIL, NIL]:LONG boing3Image:=copyListToChip( -> ----- bitmap Boing, frame 0: w = 32, h = 25 ------ [$00230000, $004E3000, $00E33A00, $03C3C900, $07878780, $108F8700, $31F78790, $61F04790, $63E0FB90, $43E0F848, $3BC0F870, $3801F870, $383DF070, $387E1070, $387C0EE0, $D87C1F10, $467C1E10, $479C1E30, $67873E20, $0787CC60, $0F0F8700, $048F0E00, $02771C00, $0161D800, $00272000, -> ----- bitmap Boing, frame 1: w = 32, h = 25 ------ $00318000, $01071800, $00F01900, $09E1EC80, $13C1E340, $1803E380, $387BC390, $30F801D0, $70F83DC0, $E1F03E08, $9DF07C30, $9E307C30, $9E1C7C30, $1C1F9C30, $1C1F0630, $7C1F0780, $623F0798, $63DE0F10, $23C10F20, $33C3EE20, $0BC3C380, $0647C700, $023F8E00, $0130F800, $00338000, -> ----- bitmap Boing, frame 2: w = 32, h = 25 ------ $0019C000, $01038800, $02788D00, $0CF0FE80, $11F0F140, $0E60F1E0, $1C39F0C0, $1C3E30C0, $387E0CE0, $F87C1F28, $8C7C1F18, $8F3C1F18, $8F061E18, $8F07DE18, $8F07C018, $6E0FC1C0, $300F83C8, $31EF8390, $31F08780, $11E0F720, $11E1F1C0, $0B61E300, $071BC600, $01386C00, $00318000, -> ----- bitmap Boing, frame 3: w = 32, h = 25 ------ $001CE000, $01B1CC00, $031CC500, $0C3C3680, $18787840, $2F7078E0, $0E087860, $1E0FB860, $1C1F0460, $BC1F07B0, $C43F0788, $C7FE0788, $C7C00F88, $C781EF88, $C783F118, $2783E0E8, $3983E1E0, $3863E1C0, $1878C1C0, $38783380, $10F078C0, $0B70F180, $0588E200, $009E2400, $0018C000, -> ----- bitmap Boing, frame 4: w = 32, h = 25 ------ $000E6000, $00F8E400, $030FE600, $061E1300, $0C3E1C80, $27FC1C60, $07843C60, $4F07FE20, $8F07C230, $1E0FC1F0, $620F83C8, $61CF83C8, $61E183C8, $63E063C8, $63E0F9C8, $03E0F878, $1DC0F860, $1C21F0E0, $5C3EF0C0, $0C3C11C0, $143C3C40, $09B83880, $05C07000, $00CF0400, $000C6000, -> ----- bitmap Boing, frame 5: w = 32, h = 25 ------ $00262000, $00FC7400, $01877200, $030F0100, $0E0F0E80, $319F0E00, $23C60F30, $63C1CF30, $4781F310, $0783E0D0, $7383E0E0, $70C3E0E0, $70F9E1E0, $70F821E0, $70F83FE0, $91F03E38, $4FF07C30, $4E107C60, $4E0F7860, $2E1F08C0, $0E1E0E00, $049E1C80, $00E43800, $00C79000, $000E6000]) -> These objects contain the initialisation data for the animation sequence. newBoingBob:=[NIL, BOING_WWIDTH, BOING_HEIGHT, BOING_DEPTH, $2, $0, VSF_SAVEBACK OR VSF_OVERLAY, 0, RBMDEPTH, 0, 0, 0, 0]:newBob newBoingSeq:=[NIL, boing3Image, boing3XTranses, boing3YTranses, boing3Times, boing3CRoutines, 0, BOING_COUNT, 0]:newAnimSeq ENDPROC ->>> ->>> PROC setupBoing(dbufing) -> Make a new animation object. Since all of the boing balls use the same -> underlying data, the initalisation structures are hard-coded into the -> routine (newBoingBob and newBoingSeq.) -> -> Return a pointer to the object if successful. PROC setupBoing(dbufing) HANDLE DEF bngOb=NIL:PTR TO ao, bngComp:PTR TO ac NEW bngOb newBoingBob.dBuf:=dbufing -> Double-buffer status newBoingSeq.headOb:=bngOb -> Pass down head object bngComp:=makeSeq(newBoingBob, newBoingSeq) -> The head comp is the one that is returned by makeSeq() bngOb.headcomp:=bngComp EXCEPT IF bngOb THEN END bngOb ReThrow() ENDPROC bngOb ->>> ->>> PROC runAnimation(win:PTR TO window, dbufing, animKey, myBitMaps) -> A simple message handling LOOP that also draws the successive frames. PROC runAnimation(win:PTR TO window, dbufing, animKey, myBitMaps) DEF intuiMsg:PTR TO intuimessage, toggleFrame -> toggleFrame is used to keep track of which frame of the double buffered -> screen we are currently displaying. The variable must exist for the life -> of the displayed objects, so it is defined here. toggleFrame:=0 -> End the loop on a IDCMP_CLOSEWINDOW event. LOOP -> Draw the gels, then check for messages. Check the messages after each -> display so we get a quick response. drawGels(win, animKey, dbufing, {toggleFrame}, myBitMaps) -> Quit on a Control-C -> E-Note: use built-in check IF CtrlC() THEN RETURN -> Check for a IDCMP_CLOSEWINDOW event, die if found WHILE intuiMsg:=GetMsg(win.userport) IF intuiMsg.class=IDCMP_CLOSEWINDOW ReplyMsg(intuiMsg) RETURN ENDIF ReplyMsg(intuiMsg) ENDWHILE ENDLOOP ENDPROC ->>> ->>> PROC setupPlanes(bitMap:PTR TO bitmap, depth, width, height) -> Called only for double-buffered displays. Allocate and clear each -> bit-plane in a bitmap structure. Clean-up on failure. PROC setupPlanes(bitMap:PTR TO bitmap, depth, width, height) HANDLE DEF plane_num FOR plane_num:=0 TO depth-1 bitMap.planes[plane_num]:=AllocRaster(width, height) BltClear(bitMap.planes[plane_num], (width/8)*height, 1) ENDFOR EXCEPT freePlanes(bitMap, depth, width, height) ReThrow() ENDPROC ->>> ->>> PROC setupBitMaps(depth, width, height) -> Allocate the two bitmaps for a double-buffered display. Routine only -> called when the display is double-buffered. PROC setupBitMaps(depth, width, height) HANDLE DEF p=NIL:PTR TO bitmap, q=NIL:PTR TO bitmap -> Allocate the two bitmap objects. These do not have to be in CHIP. -> E-Note: use p and q to get correct type. myBitMaps[0]:=NEW p myBitMaps[1]:=NEW q -> Initialise the bitmaps to the correct size. InitBitMap(p, depth, width, height) InitBitMap(q, depth, width, height) -> Allocate and initialise the bit-planes for the bitmaps. setupPlanes(p, depth, width, height) setupPlanes(q, depth, width, height) EXCEPT IF p freePlanes(p, depth, width, height) END p ENDIF IF q freePlanes(q, depth, width, height) END q ENDIF ReThrow() ENDPROC myBitMaps ->>> ->>> PROC freePlanes(bitMap:PTR TO bitmap, depth, width, height) -> Free all of the bit-planes in a bitmap structure. PROC freePlanes(bitMap:PTR TO bitmap, depth, width, height) DEF plane_num FOR plane_num:=0 TO depth-1 IF bitMap.planes[plane_num] FreeRaster(bitMap.planes[plane_num], width, height) ENDIF ENDFOR ENDPROC ->>> ->>> PROC freeBitMaps(myBitMaps:PTR TO LONG, depth, width, height) -> Free the two bitmaps from the double buffered display. The bit-planes are -> freed first, then the bitmap objects. PROC freeBitMaps(myBitMaps:PTR TO LONG, depth, width, height) freePlanes(myBitMaps[0], depth, width, height) freePlanes(myBitMaps[1], depth, width, height) END myBitMaps[2] ENDPROC ->>> ->>> PROC setupDisplay(win:PTR TO LONG, dbufing, myBitMaps:PTR TO LONG) -> Open the screen and the window for the display. -> -> If using double buffered display, assume the bitmaps have been opened and -> correctly set-up. PROC setupDisplay(win:PTR TO LONG, dbufing, myBitMaps:PTR TO LONG) HANDLE DEF gInfo, screen=NIL, wp=NIL:PTR TO window -> If double-buffered, set-up the new screen structure for custom bitmap. IF dbufing ns.type:=ns.type OR CUSTOMBITMAP ns.custombitmap:=myBitMaps[0] ENDIF -> Open everything. Check for failure. screen:=OpenScreen(ns) nw.screen:=screen -> E-Note: use wp to get the right type win[]:=(wp:=OpenWindow(nw)) IF dbufing -> We are double buffered. Set the rastport for it. wp.wscreen.rastport.flags:=RPF_DBUFFER -> This copies the Intuition display (close gadget) to the second bitmap -> so the display does not flash when we change between them. wp.wscreen.rastport.bitmap:=myBitMaps[1] BltBitMapRastPort(myBitMaps[0], 0, 0, wp.wscreen.rastport, 0, 0, RBMWIDTH, RBMHEIGHT, $C0) wp.wscreen.rastport.bitmap:=myBitMaps[0] ENDIF -> Ready the gel system for accepting objects. This is only done once for -> each rastport in use. gInfo:=setupGelSys(wp.wscreen.rastport, $03) EXCEPT IF wp THEN CloseWindow(wp) IF screen THEN CloseScreen(screen) ReThrow() ENDPROC gInfo ->>> ->>> PROC drawGels(win:..., animKey, dbufing, toggleFrame:..., myBitMaps:...) -> Handle the update of the display. Animate the simulation and check for -> collisions. If the screen is double buffered, swap the bit map as -> required. -> E-Note: toggleFrame is PTR TO LONG since '{toggle}' was used. PROC drawGels(win:PTR TO window, animKey, dbufing, toggleFrame:PTR TO LONG, myBitMaps:PTR TO LONG) -> Do the required animation stuff. You must sort both after the animate -> call and after the collision call. Animate(animKey, win.wscreen.rastport) SortGList(win.wscreen.rastport) DoCollision(win.wscreen.rastport) SortGList(win.wscreen.rastport) -> Toggle if double buffered IF dbufing win.wscreen.viewport.rasinfo.bitmap:=myBitMaps[toggleFrame[]] ENDIF -> Draw the new position of the gels into the screen. DrawGList(win.wscreen.rastport, win.wscreen.viewport) -> If using a double buffered display, you have a more complicated update -> procedure. If not then simply use WaitTOF(). IF dbufing MakeScreen(win.wscreen) RethinkDisplay() toggleFrame[]:=1-toggleFrame[] win.wscreen.rastport.bitmap:=myBitMaps[toggleFrame[]] ELSE WaitTOF() ENDIF ENDPROC ->>> ->>> PROC bounceWall(vs1:PTR TO vs, borderflags) -> Handle bouncing the animation objects off the walls. PROC bounceWall(vs1:PTR TO vs, borderflags) DEF ob:PTR TO ao -> Get a pointer to the object from the sprite pointer. ob:=vs1.vsbob.bobcomp.headob -> Check for hits and act appropriately. For right and left, reverse the x -> velocity if the object is moving towards the wall (it may have already -> reversed but still be in contact with the wall). For the bottom and top -> you also have to subtract out the velocity. IF ((borderflags AND RIGHTHIT) AND (ob.xvel>0)) OR ((borderflags AND LEFTHIT) AND (ob.xvel<0)) ob.xvel:=-ob.xvel ELSEIF ((borderflags AND TOPHIT) AND (ob.yvel<0)) OR ((borderflags AND BOTTOMHIT) AND (ob.yvel>0)) ob.yvel:=ob.yvel-ob.yaccel ob.yvel:=-ob.yvel ENDIF ENDPROC ->>> ->>> PROC hit_routine(vs1:PTR TO vs, vs2:PTR TO vs) -> Handle the collision between two animation objects. This routine simulates -> objects bouncing off of each other. This does not do a very good job of -> it, it does not take into account the angle of the collision or real -> physics. If anyone wants to fix it, please feel free. -> -> The call to DoCollision() causes a call back to this routine when two -> animation objects overlap. PROC hit_routine(vs1:PTR TO vs, vs2:PTR TO vs) DEF vel1, vel2, ob1:PTR TO ao, ob2:PTR TO ao -> Get pointers to the objects from the sprite pointers. ob1:=vs1.vsbob.bobcomp.headob ob2:=vs2.vsbob.bobcomp.headob -> Check that the bob is not being removed! This is due to a 1.3 bug where -> all bobs are tested for collision, even the ones that are in the process -> of being removed. See text for more information. -> -> Bobs are moved to a very large negative position as they are being -> removed. If the BOBSAWAY flag is set, then both bobs in the collision -> are in the process of being removed--don't do anything in the collision -> routine. IF 0=(vs1.vsbob.bobflags AND BF_BOBSAWAY) -> Cache the velocity values. -> Do the X values first (order is not important). vel1:=ob1.xvel vel2:=ob2.xvel -> If the two objects are moving in the opposite direction (X component) -> then negate the velocities, else swap the velocities. IF ((vel1>0) AND (vel2<0)) OR ((vel1<0) AND (vel2>0)) ob1.xvel:=-vel1 ob2.xvel:=-vel2 ELSE ob1.xvel:=vel2 ob2.xvel:=vel1 ENDIF -> Cache the velocity values. -> Do the Y values second (order is not important). vel1:=ob1.yvel vel2:=ob2.yvel -> If the two objects are moving in the opposite direction (Y component) -> then negate the velocities, else swap the velocities. IF ((vel1>0) AND (vel2<0)) OR ((vel1<0) AND (vel2>0)) ob1.yvel:=-vel1 ob2.yvel:=-vel2 ELSE ob1.yvel:=vel2 ob2.yvel:=vel1 ENDIF ENDIF ENDPROC ->>> ->>> PROC main() -> Run a double buffered display if the user puts any arguments on the command -> line. -> -> Set-up the display, set-up the animation system and the objects, set-up -> collisions between objects and against walls, and run the thing. -> -> Clean-up and close resources when done. PROC main() HANDLE DEF myBitMaps:PTR TO LONG, boingOb=NIL:PTR TO ao, boing2Ob=NIL:PTR TO ao, boing3Ob=NIL:PTR TO ao, win=NIL:PTR TO window, gInfo=NIL, animKey, dbufing=0, hitcode -> E-Note: set-up global data setupGlobals() -> If any arguments, use double-buffering IF arg THEN IF arg[] THEN dbufing:=1 WriteF(IF dbufing THEN 'Double buffering - no args means single buffered\n' ELSE 'Single buffering - supply any arguments to do double buffering\n') -> Note that setupBitMaps() will only be called if we are double buffering. IF dbufing THEN myBitMaps:=setupBitMaps(RBMDEPTH, RBMWIDTH, RBMHEIGHT) gInfo:=setupDisplay({win}, dbufing, myBitMaps) -> You have to initialise the animation key before you use it. InitAnimate({animKey}) -> Set-up the first boing ball. All of these use the same data, hard coded -> into setupBoing(). Change the colour by changing planePick. Set the ID -> of the ball (meMask) to BOING_1. hitMask = $FF means that it will -> collide with everything. newBoingBob.planePick:=$2 newBoingBob.meMask:=Shl(1, BOING_1) newBoingBob.hitMask:=$FF boingOb:=setupBoing(dbufing) -> Pick an initial position, velocity and acceleration and add the OBJECT to -> the system. NOTE that the Y-velocity and X-acceleration are not set -> (they default to zero.) This means that the objects will maintain a -> constant movement to the left or right, and will rely on the Y -> accelleration for the downward movement. The collision routines change -> these values, producing bouncing off of walls and other objects. -> -> NOTE: ANFRACSIZE is a value that shifts animation constants past an -> internal decimal point. If you do not do this, then the values will only -> be some fraction of what you expect. See the text of the Animation -> chapter. boingOb.any:=Shl(10, ANFRACSIZE) boingOb.anx:=Shl(250, ANFRACSIZE) boingOb.xvel:=-Shl(3, ANFRACSIZE) boingOb.yaccel:=35 AddAnimOb(boingOb, {animKey}, win.wscreen.rastport) -> Do the second object--see above comments. newBoingBob.planePick:=$1 newBoingBob.meMask:=Shl(1, BOING_2) newBoingBob.hitMask:=$FF boing2Ob:=setupBoing(dbufing) boing2Ob.any:=Shl(50, ANFRACSIZE) boing2Ob.anx:=Shl(50, ANFRACSIZE) boing2Ob.xvel:=Shl(2, ANFRACSIZE) boing2Ob.yaccel:=35 AddAnimOb(boing2Ob, {animKey}, win.wscreen.rastport) -> Do the third object--see above comments. -> Here we also use planeOnOff to change the colour. newBoingBob.planePick:=$1 newBoingBob.planeOnOff:=$2 newBoingBob.meMask:=Shl(1, BOING_3) newBoingBob.hitMask:=$FF boing3Ob:=setupBoing(dbufing) boing3Ob.any:=Shl(80, ANFRACSIZE) boing3Ob.anx:=Shl(150, ANFRACSIZE) boing3Ob.xvel:=Shl(1, ANFRACSIZE) boing3Ob.yaccel:=35 AddAnimOb(boing3Ob, {animKey}, win.wscreen.rastport) -> Set up the collisions between boing balls. -> NOTE that they all call the same routine. -> E-Note: wrap hit_routine() so it can be used as a collision function (the -> function is simple enough not to need the full register -> preservation of eCodeCollision(), so eCodeSwapArgs() is used). hitcode:=eCodeSwapArgs({hit_routine}) SetCollision(BOING_1, hitcode, gInfo) SetCollision(BOING_2, hitcode, gInfo) SetCollision(BOING_3, hitcode, gInfo) -> Set the collisions with the walls. -> E-Note: see above comment about eCodeXXX(). SetCollision(BORDERHIT, eCodeSwapArgs({bounceWall}), gInfo) -> Everything set-up... Run the animation. runAnimation(win, dbufing, {animKey}, myBitMaps) -> Done.. Free-up everything and clean up the mess. EXCEPT DO IF boing3Ob THEN freeOb(boing3Ob, RBMDEPTH) IF boing2Ob THEN freeOb(boing2Ob, RBMDEPTH) IF boingOb THEN freeOb(boingOb, RBMDEPTH) IF gInfo THEN cleanupGelSys(gInfo, win.wscreen.rastport) IF win THEN CloseWindow(win) -> E-Note: C version does not do this safely... IF nw.screen THEN CloseScreen(nw.screen) IF dbufing THEN freeBitMaps(myBitMaps, RBMDEPTH, RBMWIDTH, RBMHEIGHT) SELECT exception CASE ERR_RAST; WriteF('Error: could not allocate raster\n') CASE ERR_SCRN; WriteF('Error: could not open screen\n') CASE ERR_WIN; WriteF('Error: could not open window\n') CASE "MEM"; WriteF('Error: ran out of memory\n') ENDSELECT ENDPROC IF exception<>ERR_NONE THEN RETURN_FAIL ELSE RETURN_OK ->>> ->>> PROC copyListToChip(data) -> E-Note: get some Chip memory and copy list (quick, since LONG aligned) PROC copyListToChip(data) DEF size, mem size:=ListLen(data)*SIZEOF LONG mem:=NewM(size, MEMF_CHIP) CopyMemQuick(data, mem, size) ENDPROC mem ->>> Hf-lh0-  ә42Src\Rkrm\Graphics_Libraries\Sprites_Bobs\ssprite.e/-> ssprite.e - Simple Sprite example ->>> Header (globals) OPT PREPROCESS MODULE 'dos/dos', 'exec/memory', 'graphics/gfx', 'graphics/gfxmacros', 'graphics/sprite', 'graphics/view', 'hardware/custom', 'hardware/dmabits', 'intuition/screens' ENUM ERR_NONE, ERR_KICK, ERR_SCRN, ERR_SPRT RAISE ERR_KICK IF KickVersion()=FALSE, ERR_SCRN IF OpenScreenTagList()=NIL, ERR_SPRT IF GetSprite()=-1 DEF sprite_data ->>> ->>> PROC main() PROC main() HANDLE DEF sprite:simplesprite, viewport, sprite_num=-1, delta_move, ktr1, ktr2, colour_reg, screen=NIL:PTR TO screen KickVersion(37) screen:=OpenScreenTagList(NIL, NIL) viewport:=screen.viewport sprite_num:=GetSprite(sprite, 2) -> Calculate the correct base colour register number, -> set up the colour registers. colour_reg:=16+((sprite_num AND $06)*2) WriteF('colour_reg=\d\n', colour_reg) SetRGB4(viewport, colour_reg+1, 12, 3, 8) SetRGB4(viewport, colour_reg+2, 13, 13, 13) SetRGB4(viewport, colour_reg+3, 4, 4, 15) sprite.x:=0 -> Initialise position and size info to match that shown in sprite.y:=0 -> sprite_data so system knows layout of data later. sprite.height:=9 -> E-Note: data is really a lot of LONGs sprite_data:=copyListToChip([0, -> Position control $ffff0000, -> Image data line 1, color 1 $ffff0000, -> Image data line 2, color 1 $0000ffff, -> Image data line 3, color 2 $0000ffff, -> Image data line 4, color 2 $00000000, -> Image data line 5, transparent $0000ffff, -> Image data line 6, color 2 $0000ffff, -> Image data line 7, color 2 $ffffffff, -> Image data line 8, color 3 $ffffffff, -> Image data line 9, color 3 0]) -> Reserved, must init to 0 -> Install sprite data and move sprite to start position. ChangeSprite(viewport, sprite, sprite_data) MoveSprite(viewport, sprite, 30, 0) -> Move the sprite back and forth. delta_move:=1 FOR ktr1:=0 TO 5 FOR ktr2:=0 TO 99 MoveSprite(viewport, sprite, sprite.x+delta_move, sprite.y+delta_move) WaitTOF() -> One move per video frame. -> Show the effect of turning off sprite DMA. IF ktr2=40 THEN OFF_SPRITE IF ktr2=60 THEN ON_SPRITE ENDFOR delta_move:=-delta_move ENDFOR -> Note: if you turn off the sprite at the wrong time (when it is being -> displayed), the sprite will appear as a vertical bar on the screen. -> To really get rid of the sprite, you must OFF_SPRITE while it is not -> displayed. This is hard in a multi-tasking system (the solution is not -> addressed in this program). ON_SPRITE -> Just to be sure EXCEPT DO IF sprite_num<>-1 THEN FreeSprite(sprite_num) IF screen THEN CloseScreen(screen) SELECT exception CASE ERR_KICK; WriteF('Error: requires V37\n') CASE ERR_SCRN; WriteF('Error: could not open screen\n') CASE ERR_SPRT; WriteF('Error: could not allocate a new sprite\n') ENDSELECT ENDPROC IF exception<>ERR_NONE THEN RETURN_FAIL ELSE RETURN_OK ->>> ->>> PROC copyListToChip(data) -> E-Note: get some Chip memory and copy list (quick, since LONG aligned) PROC copyListToChip(data) DEF size, mem size:=ListLen(data)*SIZEOF LONG mem:=NewM(size, MEMF_CHIP) CopyMemQuick(data, mem, size) ENDPROC mem ->>> H-lh0-ә42Src\Rkrm\Graphics_Libraries\Sprites_Bobs\vsprite.eTR-> vsprite.e - Virtual Sprite example ->>> Header (globals) MODULE 'dos/dos', 'exec/memory', 'exec/ports', 'graphics/collide', 'graphics/gels', 'graphics/rastport', 'intuition/intuition', 'intuition/screens', 'other/ecode', '*animtools' ENUM ERR_NONE, ERR_KICK, ERR_WIN RAISE ERR_KICK IF KickVersion()=FALSE, ERR_WIN IF OpenWindow()=NIL CONST GEL_SIZE=4 -> VSprite data - there are two sets that are alternated between. Note that -> this data is always displayed as low resolution. DEF vsprite_data1, vsprite_data2, mySpriteColours, mySpriteAltColours ->>> ->>> PROC vspriteDrawGList(win, myRPort) -> Basic VSprite display subroutine PROC vspriteDrawGList(win, myRPort) SortGList(myRPort) DrawGList(myRPort, ViewPortAddress(win)) RethinkDisplay() ENDPROC ->>> ->>> PROC borderCheck(hitVSprite:PTR TO vs, borderflags) -> Collision routine for vsprite hitting border. Note that when the collision -> is VSprite to VSprite (or Bob to Bob, Bob to AnimOb, etc.), then the -> parameters are both pointers to a VSprite. PROC borderCheck(hitVSprite:PTR TO vs, borderflags) IF borderflags AND RIGHTHIT hitVSprite.sprcolors:=mySpriteAltColours hitVSprite.vuserext:=-40 ENDIF IF borderflags AND LEFTHIT hitVSprite.sprcolors:=mySpriteColours hitVSprite.vuserext:=20 ENDIF ENDPROC ->>> ->>> PROC process_window(win:PTR TO window, myRPort, myVSprite:PTR TO vs) -> Process window and dynamically change vsprite. Get messages. Go away on -> CLOSEWINDOW. Update and redisplay vsprite on INTUITICKS. Wait for more -> messages. PROC process_window(win:PTR TO window, myRPort, myVSprite:PTR TO vs) DEF msg:PTR TO intuimessage LOOP Wait(Shl(1, win.userport.sigbit)) WHILE NIL<>(msg:=GetMsg(win.userport)) -> Only IDCMP_CLOSEWINDOW and IDCMP_INTUITICKS are active IF msg.class=IDCMP_CLOSEWINDOW ReplyMsg(msg) RETURN ENDIF -> Must be an INTUITICKS: change x and y values on the fly. Note offset -> by window left and top edge--sprite is relative to the screen, not -> window. Divide the MouseY in half to adjust for Lores movement -> increments on a Hires screen. myVSprite.x:=win.leftedge+msg.mousex+myVSprite.vuserext myVSprite.y:=win.topedge+(msg.mousey/2)+1 ReplyMsg(msg) ENDWHILE -> Got a message, change image data on the fly myVSprite.imagedata:=IF myVSprite.imagedata=vsprite_data1 THEN vsprite_data2 ELSE vsprite_data1 SortGList(myRPort) DoCollision(myRPort) vspriteDrawGList(win, myRPort) ENDLOOP ENDPROC ->>> ->>> PROC do_VSprite(win, myRPort:PTR TO rastport) HANDLE -> Working with the VSprite. Setup the GEL system and get a new VSprite -> (makeVSprite()). Add VSprite to the system and display. Use the vsprite. -> When done, remove VSprite and update the display without the VSprite. -> Cleanup everything. PROC do_VSprite(win, myRPort:PTR TO rastport) HANDLE DEF myVSprite=NIL:PTR TO vs, my_ginfo=NIL my_ginfo:=setupGelSys(myRPort, $FC) myVSprite:=makeVSprite( -> Image data, sprite colour array, word width (1 for true VSprite) [vsprite_data1, mySpriteColours, 1, -> Line height, image depth (2 for true VSprite), x, y position GEL_SIZE, 2, 160, 100, -> Flags (VSF_VSPRITE for true VSprite), hit mask and me mask VSF_VSPRITE, Shl(1, BORDERHIT), 0]:newVSprite) AddVSprite(myVSprite, myRPort) vspriteDrawGList(win, myRPort) myVSprite.vuserext:=20 -> E-Note: wrap borderCheck function for use as collision routine SetCollision(BORDERHIT, eCodeCollision({borderCheck}), myRPort.gelsinfo) process_window(win, myRPort, myVSprite) RemVSprite(myVSprite) EXCEPT DO IF myVSprite THEN freeVSprite(myVSprite) IF my_ginfo vspriteDrawGList(win, myRPort) cleanupGelSys(my_ginfo, myRPort) ENDIF ReThrow() ENDPROC ->>> ->>> PROC main() HANDLE -> Example VSprite program. First open a window. PROC main() HANDLE DEF win=NIL:PTR TO window, myRPort=NIL:PTR TO rastport KickVersion(37) NEW myRPort -> E-Note: allocate a zeroed rastport -> E-Note: set-up global data vsprite_data1:=copyListToChip([$7FFE80FF, $7C3E803F, $7C3E803F, $7FFE80FF, 0]) vsprite_data2:=copyListToChip([$7FFEFF01, $7C3EFC01, $7C3EFC01, $7FFEFF01, 0]) mySpriteColours:=[$0000, $00F0, $0F00]:INT mySpriteAltColours:=[$000F, $0F00, $0FF0]:INT win:=OpenWindow([80, 20, 400, 150, -1, -1, IDCMP_CLOSEWINDOW OR IDCMP_INTUITICKS, WFLG_ACTIVATE OR WFLG_CLOSEGADGET OR WFLG_DEPTHGADGET OR WFLG_RMBTRAP OR WFLG_DRAGBAR, NIL, NIL, 'VSprite', NIL, NIL, 0, 0, 0, 0, WBENCHSCREEN]:nw) InitRastPort(myRPort) -> Copy the window rastport CopyMem(win.wscreen.rastport, myRPort, SIZEOF rastport) do_VSprite(win, myRPort) EXCEPT DO IF win THEN CloseWindow(win) END myRPort SELECT exception CASE ERR_KICK; WriteF('Error: requires V37\n') CASE ERR_WIN; WriteF('Error: could not open window\n') CASE "MEM"; WriteF('Error: ran out of memory\n') ENDSELECT ENDPROC IF exception<>ERR_NONE THEN RETURN_FAIL ELSE RETURN_OK ->>> ->>> PROC copyListToChip(data) -> E-Note: get some Chip memory and copy list (quick, since LONG aligned) PROC copyListToChip(data) DEF size, mem size:=ListLen(data)*SIZEOF LONG mem:=NewM(size, MEMF_CHIP) CopyMemQuick(data, mem, size) ENDPROC mem ->>> C-lh0-%%ԙ4-Src\Rkrm\Graphics_Libraries\Text\availfonts.enQ-> AvailFonts.e ->>> Header (globals) MODULE 'diskfont', 'layers', 'utility', 'exec/nodes', 'exec/ports', 'graphics/rastport', 'graphics/gfx', 'graphics/text', 'intuition/intuition', 'intuition/screens', 'libraries/diskfont' ENUM ERR_NONE, ERR_DRAW, ERR_LIB, ERR_REGN, ERR_WIN RAISE ERR_DRAW IF GetScreenDrawInfo()=NIL, ERR_LIB IF OpenLibrary()=NIL, ERR_REGN IF NewRegion()=NIL, ERR_WIN IF OpenWindowTagList()=NIL OBJECT stringobj string charcount stringwidth ENDOBJECT DEF alphabetstring, fname:stringobj, fheight:stringobj, xDPI:stringobj, yDPI:stringobj, entrynum:stringobj DEF mywin=NIL:PTR TO window, mycliprp, myrp:rastport DEF myrect:rectangle, new_region=NIL, old_region DEF mydrawinfo=NIL:PTR TO drawinfo, afh=NIL:PTR TO afh, fontheight, alphabetcharcount, stringwidth ->>> ->>> PROC main() PROC main() HANDLE DEF defaultfont=NIL, defaultfontattr, afsize, afshortage, cliprectside -> E-Note: use the STRLEN short-cut to get string lengths. alphabetstring:='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz' alphabetcharcount:=STRLEN defaultfontattr:=['topaz.font', 9, 0, 0]:textattr fname.string:='Font Name: '; fname.charcount:=STRLEN fheight.string:='Font Height: '; fheight.charcount:=STRLEN xDPI.string:='X DPI: '; xDPI.charcount:=STRLEN yDPI.string:='Y DPI: '; yDPI.charcount:=STRLEN entrynum.string:='Entry #: '; entrynum.charcount:=STRLEN KickVersion(37) diskfontbase:=OpenLibrary('diskfont.library', 37) layersbase:=OpenLibrary('layers.library', 37) utilitybase:=OpenLibrary('utility.library', 37) mywin:=OpenWindowTagList(NIL, [WA_SMARTREFRESH, TRUE, -> Open that window. WA_SIZEGADGET, FALSE, WA_CLOSEGADGET, TRUE, WA_IDCMP, IDCMP_CLOSEWINDOW, WA_DRAGBAR, TRUE, WA_DEPTHGADGET, TRUE, WA_TITLE, 'AvailFonts() example', NIL]) -> An object copy: clone my window's rastport. This rastport will be used -> to render the font specs, not the actual font sample. CopyMem(mywin.rport, myrp, SIZEOF rastport) mydrawinfo:=GetScreenDrawInfo(mywin.wscreen) SetFont(myrp, mydrawinfo.font) myrect.minx:=mywin.borderleft -> LAYOUT THE WINDOW myrect.miny:=mywin.bordertop myrect.maxx:=mywin.width-(mywin.borderright+1) myrect.maxy:=mywin.height-(mywin.borderbottom+1) cliprectside:=(myrect.maxx-myrect.minx)/20 fontheight:=myrp.font.ysize+2 -> If the default screen font is more than one-sixth the size of the window, -> use topaz-9. IF fontheight>((myrect.maxy-myrect.miny)/6) defaultfont:=OpenFont(defaultfontattr) SetFont(myrp, defaultfont) fontheight:=myrp.font.ysize+2 ENDIF fname.stringwidth:=TextLength(myrp, fname.string, fname.charcount) fheight.stringwidth:=TextLength(myrp, fheight.string, fheight.charcount) xDPI.stringwidth:=TextLength(myrp, xDPI.string, xDPI.charcount) yDPI.stringwidth:=TextLength(myrp, yDPI.string, yDPI.charcount) entrynum.stringwidth:=TextLength(myrp, entrynum.string, entrynum.charcount) -> What is the largest string length? stringwidth:=Max(Max(Max(Max(fname.stringwidth, fheight.stringwidth), xDPI.stringwidth), yDPI.stringwidth), entrynum.stringwidth) stringwidth:=stringwidth+mywin.borderleft -> If the stringwidth is more than half the viewing area, quit because the -> font is just too big. IF stringwidth<((myrect.maxx-myrect.minx)/2) SetAPen(myrp, mydrawinfo.pens[TEXTPEN]) SetDrMd(myrp, RP_JAM2) Move(myrp, myrect.minx+8+stringwidth-fname.stringwidth, myrect.miny+4+myrp.font.baseline) Text(myrp, fname.string, fname.charcount) Move(myrp, myrect.minx+8+stringwidth-fheight.stringwidth, myrp.cp_y+fontheight) Text(myrp, fheight.string, fheight.charcount) Move(myrp, myrect.minx+8+stringwidth-xDPI.stringwidth, myrp.cp_y+fontheight) Text(myrp, xDPI.string, xDPI.charcount) Move(myrp, myrect.minx+8+stringwidth-yDPI.stringwidth, myrp.cp_y+fontheight) Text(myrp, yDPI.string, yDPI.charcount) Move(myrp, myrect.minx+8+stringwidth-entrynum.stringwidth, myrp.cp_y+fontheight) Text(myrp, entrynum.string, entrynum.charcount) myrect.minx:=myrect.minx+cliprectside myrect.maxx:=myrect.maxx-cliprectside myrect.miny:=myrect.miny+(5*fontheight)+8 myrect.maxy:=myrect.maxy-8 -> Draw a box around the cliprect SetAPen(myrp, mydrawinfo.pens[SHINEPEN]) Move(myrp, myrect.minx-1, myrect.maxy+1) Draw(myrp, myrect.maxx+1, myrect.maxy+1) Draw(myrp, myrect.maxx+1, myrect.miny-1) SetAPen(myrp, mydrawinfo.pens[SHADOWPEN]) Draw(myrp, myrect.minx-1, myrect.miny-1) Draw(myrp, myrect.minx-1, myrect.maxy) SetAPen(myrp, mydrawinfo.pens[TEXTPEN]) -> Fill up a buffer with a LIST of the available fonts. afsize:=AvailFonts(afh, 0, AFF_MEMORY OR AFF_DISK OR AFF_SCALED OR AFF_TAGGED) REPEAT afh:=NewR(afsize) afshortage:=AvailFonts(afh, afsize, AFF_MEMORY OR AFF_DISK OR AFF_SCALED OR AFF_TAGGED) IF afshortage Dispose(afh) afsize:=afsize+afshortage afh:=-1 ENDIF UNTIL afshortage=0 -> This is for the layers.library clipping region that gets attached to -> the window. This prevents the application from unnecessarily rendering -> beyond the bounds of the inner part of the window. For more information -> on clipping, see the Layers chapter of the RKRM. new_region:=NewRegion() -> More layers stuff IF OrRectRegion(new_region, myrect) -> Even more layers stuff -> Obtain a pointer to the window's rastport and set up some of the -> rastport attributes. This example obtains the text pen for the -> window's screen using the GetScreenDrawInfo() function. mycliprp:=mywin.rport SetAPen(mycliprp, mydrawinfo.pens[TEXTPEN]) mainLoop() ENDIF ENDIF EXCEPT DO IF new_region THEN DisposeRegion(new_region) IF afh THEN Dispose(afh) -> E-Note: C version forgets to CloseFont() IF defaultfont THEN CloseFont(defaultfont) IF mydrawinfo THEN FreeScreenDrawInfo(mywin.wscreen, mydrawinfo) IF mywin THEN CloseWindow(mywin) IF utilitybase THEN CloseLibrary(utilitybase) IF layersbase THEN CloseLibrary(layersbase) IF diskfontbase THEN CloseLibrary(diskfontbase) SELECT exception CASE ERR_DRAW; WriteF('Error: could not get drawinfo from screen\n') CASE ERR_LIB; WriteF('Error: could not open required library\n') CASE ERR_REGN; WriteF('Error: could not allocate new region\n') CASE ERR_WIN; WriteF('Error: could not open window\n') CASE "MEM"; WriteF('Error: ran out of memory\n') ENDSELECT ENDPROC ->>> ->>> PROC mainLoop() PROC mainLoop() DEF x, mymsg:PTR TO intuimessage, aok=TRUE, afont:PTR TO taf, myfont:PTR TO textfont, buf[8]:STRING, dpi -> E-Note: task data not needed since we can use CtrlC() afont:=afh+SIZEOF afh FOR x:=0 TO afh.numentries-1 IF aok IF myfont:=OpenDiskFont(afont.attr) -> Print the TextFont attributes. SetAPen(myrp, mydrawinfo.pens[BACKGROUNDPEN]) RectFill(myrp, stringwidth, mywin.bordertop+4, mywin.width-(mywin.borderright+1), myrect.miny-2) SetAPen(myrp, mydrawinfo.pens[TEXTPEN]) Move(myrp, stringwidth+mywin.borderleft, mywin.bordertop+4+myrp.font.baseline) Text(myrp, myfont.mn.ln.name, StrLen(myfont.mn.ln.name)) -> Print the font's Y Size. Move(myrp, stringwidth+mywin.borderleft, myrp.cp_y+fontheight) StringF(buf, '\d', myfont.ysize) Text(myrp, buf, StrLen(buf)) -> Print the X DPI Move(myrp, stringwidth+mywin.borderleft, myrp.cp_y+fontheight) dpi:=GetTagData(TA_DEVICEDPI, 0, myfont.mn.replyport::textfontextension.tags) IF dpi StringF(buf, '\d', Shr(dpi AND $FFFF0000, 16)) Text(myrp, buf, StrLen(buf)) ELSE Text(myrp, 'NIL', 3) ENDIF -> Print the Y DPI Move(myrp, stringwidth+mywin.borderleft, myrp.cp_y+fontheight) IF dpi StringF(buf, '\d', dpi AND $0000FFFF) Text(myrp, buf, StrLen(buf)) ELSE Text(myrp, 'NIL', 3) ENDIF -> Print the entrynum Move(myrp, stringwidth+mywin.borderleft, myrp.cp_y+fontheight) StringF(buf, '\d', x) Text(myrp, buf, StrLen(buf)) SetFont(mycliprp, myfont) -> Install clipping rectangle old_region:=InstallClipRegion(mywin.wlayer, new_region) SetRast(mycliprp, mydrawinfo.pens[BACKGROUNDPEN]) Move(mycliprp, myrect.minx, myrect.maxy-(myfont.ysize-myfont.baseline)) Text(mycliprp, alphabetstring, alphabetcharcount) Delay(100) -> Remove clipping rectangle new_region:=InstallClipRegion(mywin.wlayer, old_region) WHILE mymsg:=GetMsg(mywin.userport) aok:=FALSE x:=afh.numentries ReplyMsg(mymsg) ENDWHILE -> Did the user hit Ctrl-C? IF CtrlC() aok:=FALSE x:=afh.numentries WriteF('Ctrl-C Break\n') ENDIF CloseFont(myfont) ENDIF ENDIF afont++ ENDFOR ENDPROC ->>> ->>> Version string vers: CHAR 0, '$VER: AvailFonts 36.3', 0 ->>> A/-lh0-**ә4+Src\Rkrm\Graphics_Libraries\Text\cliptext.e-> cliptext.e ->>> Header (globals) MODULE 'diskfont', 'layers', 'diskfont/diskfonttag', 'dos/rdargs', 'graphics/displayinfo', 'graphics/gfx', 'graphics/rastport', 'graphics/text', 'intuition/intuition', 'intuition/screens', 'utility/tagitem' ENUM ERR_NONE, ERR_ARGS, ERR_FONT, ERR_KICK, ERR_LIB, ERR_OPEN, ERR_READ, ERR_REGN, ERR_WIN RAISE ERR_ARGS IF ReadArgs()=NIL, ERR_FONT IF OpenDiskFont()=NIL, ERR_KICK IF KickVersion()=FALSE, ERR_LIB IF OpenLibrary()=NIL, ERR_OPEN IF Open()=NIL, ERR_READ IF Read()<0, ERR_REGN IF NewRegion()=NIL, ERR_WIN IF OpenWindowTagList()=NIL CONST BUFSIZE=4096 ENUM FONT_NAME, FONT_SIZE, FILE_NAME, JAM_MODE, XASP, YASP, NUM_ARGS CONST DEFAULTFONTSIZE=11, DEFAULTJAMMODE=0, DEFAULTXASP=0, DEFAULTYASP=0 DEF args:PTR TO LONG, tagitem[2]:ARRAY OF tagitem, buffer[BUFSIZE]:ARRAY, myfile=NIL, mymsg:PTR TO intuimessage, mydrawinfo:PTR TO drawinfo, mywin=NIL:PTR TO window, myrp:PTR TO rastport, myfont=NIL:PTR TO textfont, myrectangle:rectangle, new_region=NIL ->>> ->>> PROC main() PROC main() HANDLE DEF myrda=NIL:PTR TO rdargs, mydi:displayinfo, mymodeid, mydefaultfontsize=DEFAULTFONTSIZE, mydefaultJAMMode=DEFAULTJAMMODE, mydefaultXASP=DEFAULTXASP, -> E-Note: C version fails to use these! mydefaultYASP=DEFAULTYASP args:=['topaz.font', {mydefaultfontsize}, 's:startup-sequence', {mydefaultJAMMode}, {mydefaultXASP}, {mydefaultYASP}] -> Run only on 2.0 machines KickVersion(36) -> dos.library standard command line parsing. See the dos.library Autodoc myrda:=ReadArgs('FontName,FontSize/N,FileName,Jam/N,XASP/N,YASP/N\n', args, NIL) myfile:=Open(args[FILE_NAME], OLDFILE) -> Open the file to display. diskfontbase:=OpenLibrary('diskfont.library', 36) -> Open the libraries. layersbase:=OpenLibrary('layers.library', 36) -> This application wants to hear about three things: 1) When the user -> clicks the window's close gadget, 2) when the user starts to resize the -> window, 3) and when the user has finished resizing the window. mywin:=OpenWindowTagList(NIL, -> Open that window. [WA_MINWIDTH, 100, WA_MINHEIGHT, 100, WA_SMARTREFRESH, TRUE, WA_SIZEGADGET, TRUE, WA_CLOSEGADGET, TRUE, WA_IDCMP, IDCMP_CLOSEWINDOW OR IDCMP_NEWSIZE OR IDCMP_SIZEVERIFY, WA_DRAGBAR, TRUE, WA_DEPTHGADGET, TRUE, WA_TITLE, args[FILE_NAME], TAG_END]) tagitem[0].tag:=OT_DEVICEDPI -> See if there is a non-zero value in the XASP or YASP fields. -> Diskfont.library will get a divide by zero GURU if you give it a zero -> XDPI or YDPI value. -> If there is a zero value in one of them... IF (Long(args[XASP])=0) OR (Long(args[YASP])=0) -> ...use the aspect ratio of the current display as a default... mymodeid:=GetVPModeID(mywin.wscreen.viewport) IF GetDisplayInfoData(NIL, mydi, SIZEOF displayinfo, DTAG_DISP, mymodeid) mydefaultXASP:=mydi.resolution.x mydefaultYASP:=mydi.resolution.y WriteF('XASP = \d YAsp = \d\n', mydefaultXASP, mydefaultYASP) -> Notice that the X and Y get _swapped_ to keep the look of the font -> glyphs the same using screens with different aspect ratios. args[YASP]:={mydefaultXASP} args[XASP]:={mydefaultYASP} ELSE -> ...unless something is preventing us from getting the screens -> resolution. In that case, forget about the DPI tag. tagitem[0].tag:=TAG_END ENDIF ENDIF -> Here we have to put the X and Y DPI into the OT_DEVICEDPI tags data -> field. THESE ARE NOT REAL X AND Y DPI VALUES FOR THIS FONT OR THE -> DISPLAY. They only serve to supply the diskfont.library with values to -> calculate the aspect ratio. The X value gets stored in the upper word of -> the tag value and the Y DPI gets stored in the lower word. Because -> ReadArgs() stores the _address_ of integers it gets from the command -> line, you have to dereference the pointer it puts into the argument -> array. tagitem.data:=Shl(Long(args[XASP]), 16) OR Long(args[YASP]) tagitem.tag:=TAG_END -> Set up myfont to match the font the user requested. myfont:=OpenDiskFont([args[FONT_NAME], Long(args[FONT_SIZE]), FSF_TAGGED, 0, tagitem]:ttextattr) -> Open that font. -> This is for the layers.library clipping region that gets attached to the -> window. This prevents the application from unnecessarily rendering -> beyond the bounds of the inner part of the window. For now, you can -> ignore the layers stuff if you are just interested in learning about -> using text. For more information on clipping regions and layers, see the -> Layers chapter of this manual. myrectangle.minx:=mywin.borderleft myrectangle.miny:=mywin.bordertop myrectangle.maxx:=mywin.width-(mywin.borderright+1) myrectangle.maxy:=mywin.height-(mywin.borderbottom+1) new_region:=NewRegion() IF OrRectRegion(new_region, myrectangle) InstallClipRegion(mywin.wlayer, new_region) -> Obtain a pointer to the window's rastport and set up some of the -> rastport attributes. This example obtains the text pen for the -> window's screen using GetScreenDrawInfo(). myrp:=mywin.rport SetFont(myrp, myfont) IF mydrawinfo:=GetScreenDrawInfo(mywin.wscreen) SetAPen(myrp, mydrawinfo.pens[TEXTPEN]) FreeScreenDrawInfo(mywin.wscreen, mydrawinfo) ENDIF SetDrMd(myrp, Long(args[JAM_MODE])) mainLoop() ENDIF EXCEPT DO IF new_region THEN DisposeRegion(new_region) IF myfont THEN CloseFont(myfont) IF mywin THEN CloseWindow(mywin) IF layersbase THEN CloseLibrary(layersbase) IF diskfontbase THEN CloseLibrary(diskfontbase) IF myfile THEN Close(myfile) IF myrda THEN FreeArgs(myrda) SELECT exception CASE ERR_ARGS; WriteF('Error: ReadArgs() failed\n') CASE ERR_FONT; WriteF('Error: could not open font\n') CASE ERR_KICK; WriteF('Error: requires V36+\n') CASE ERR_LIB; WriteF('Error: could not open required library\n') CASE ERR_OPEN; WriteF('Error: could not open file\n') CASE ERR_READ; WriteF('Error: Read() on the file failed\n') CASE ERR_REGN; WriteF('Error: could not allocate region\n') CASE ERR_WIN; WriteF('Error: could not open window\n') ENDSELECT ENDPROC ->>> ->>> PROC mainLoop() PROC mainLoop() DEF count, actual, position, aok=TRUE, waitfornewsize=FALSE -> E-Note: we don't need to find the task since we can use CtrlC() Move(myrp, mywin.borderleft+1, mywin.bordertop+myfont.ysize+1) -> While there's something to read, fill the buffer WHILE ((actual:=Read(myfile, buffer, BUFSIZE)) > 0) AND aok position:=0 count:=0 WHILE position<=actual -> E-Note: logic swapped here... IF waitfornewsize WaitPort(mywin.userport) ELSE WHILE (buffer[count]>=myfont.lochar) AND (buffer[count]<=myfont.hichar) AND (count<=actual) DO INC count Text(myrp, buffer+position, count-position) WHILE ((buffer[count]myfont.hichar)) AND (count<=actual) IF buffer[count]=$0A Move(myrp, mywin.borderleft, myrp.cp_y+myfont.ysize+1) ENDIF INC count ENDWHILE position:=count ENDIF WHILE mymsg:=GetMsg(mywin.userport) -> The user clicked the close gadget. IF mymsg.class=IDCMP_CLOSEWINDOW aok:=FALSE position:=actual+1 ReplyMsg(mymsg) -> The user picked up the window's sizing gagdet. ELSEIF mymsg.class=IDCMP_SIZEVERIFY -> When the user has picked up the window's sizing gadget when the -> IDCMP_SIZEVERIFY flag is set, the application has to reply to -> this message to tell Intuition to allow the user to move the -> sizing gadget and resize the window. The reason for using this -> here is because the user can resize the window while cliptext.e -> is rendering text to the window. Cliptext.e has to stop -> rendering text when it receives an IDCMP_SIZEVERIFY message. -> -> If this example had instead asked to hear about IDCMP events that -> could take place between SIZEVERIFY and NEWSIZE events -> (especially INTUITICKS), it should turn off those events here -> using ModifyIDCMP(). -> -> After we allow the user to resize the window, we cannot write -> into the window until the user has finished resizing it because -> we need the window's new size to adjust the clipping area. -> Specifically, we have to wait for an IDCMP_NEWSIZE message which -> Intuition will send when the user lets go of the resize gadget. -> For now, we set the waitfornewsize flag to stop rendering until -> we get that NEWSIZE message. waitfornewsize:=TRUE WaitBlit() -> The blitter is done, let the user resize the window ReplyMsg(mymsg) ELSE ReplyMsg(mymsg) waitfornewsize:=FALSE -> The user has resized the window, so get the new window dimensions -> and readjust the layers clipping region accordingly. myrectangle.minx:=mywin.borderleft myrectangle.miny:=mywin.bordertop myrectangle.maxx:=mywin.width-(mywin.borderright+1) myrectangle.maxy:=mywin.height-(mywin.borderbottom+1) InstallClipRegion(mywin.wlayer, NIL) ClearRegion(new_region) IF OrRectRegion(new_region, myrectangle) InstallClipRegion(mywin.wlayer, new_region) ELSE aok:=FALSE position:=actual+1 ENDIF ENDIF ENDWHILE IF CtrlC() -> Check for user break. aok:=FALSE position:=actual+1 ENDIF -> If we reached the bottom of the page, clear the rastport and move -> back to the top. IF myrp.cp_y>(mywin.height-(mywin.borderbottom+2)) Delay(25) -> Set the entire rastport to colour zero. This will not include the -> window borders because of the layers clipping. SetRast(myrp, 0) Move(myrp, mywin.borderleft+1, mywin.bordertop+myfont.ysize+1) ENDIF ENDWHILE ENDWHILE ENDPROC ->>> ->>> Version string vers: CHAR 0, '$VER: cliptext 37.2', 0 ->>> D-lh0-ooә4.Src\Rkrm\Graphics_Libraries\Text\MeasureText.ey-> MeasureText.e ->>> Header (globals) MODULE 'asl', 'diskfont', 'graphics/rastport', 'graphics/text', 'intuition/intuition', 'intuition/screens', 'libraries/asl', 'other/split' ENUM ERR_NONE, ERR_ARGS, ERR_ASL, ERR_FONT, ERR_KICK, ERR_LIB, ERR_OPEN, ERR_READ, ERR_WIN RAISE ERR_ASL IF AllocAslRequest()=NIL, ERR_FONT IF OpenDiskFont()=NIL, ERR_KICK IF KickVersion()=FALSE, ERR_LIB IF OpenLibrary()=NIL, ERR_OPEN IF Open()=NIL, ERR_READ IF Read()<0, ERR_WIN IF OpenWindowTagList()=NIL CONST BUFSIZE=32000 -> E-Note: 32768 is too big for a static ARRAY DEF buffer[BUFSIZE]:ARRAY, myfile=NIL, wtbarheight, fr=NIL:PTR TO fontrequester, myfont=NIL:PTR TO textfont, w=NIL:PTR TO window, myrp:PTR TO rastport ->>> ->>> PROC main() PROC main() HANDLE DEF arglist:PTR TO LONG KickVersion(37) -> Run only on 2.0 machines -> E-Note: use argSplit() to get argv-like list (minus command name) IF NIL=(arglist:=argSplit()) THEN Raise(ERR_ARGS) IF ListLen(arglist)=1 -> E-Note: replaces 'argc==2' myfile:=Open(arglist[0], OLDFILE) -> Open the file to print out. diskfontbase:=OpenLibrary('diskfont.library', 37) aslbase:=OpenLibrary('asl.library', 37) fr:=AllocAslRequest(ASL_FONTREQUEST, -> Open an ASL font requester. -> Supply initial values for requester [ASL_FONTNAME, 'topaz.font', ASL_FONTHEIGHT, 11, ASL_FONTSTYLES, FSF_BOLD OR FSF_ITALIC, ASL_FRONTPEN, 1, ASL_BACKPEN, 0, -> Give us all the gadgetry ASL_FUNCFLAGS, FONF_FRONTCOLOR OR FONF_BACKCOLOR OR FONF_DRAWMODE OR FONF_STYLES, NIL]) -> Pop up the requester IF AslRequest(fr, NIL) -> Extract the font and display attributes from the fontrequest. myfont:=OpenDiskFont([fr.attr.name, fr.attr.ysize, fr.attr.style, fr.attr.flags]:textattr) w:=OpenWindowTagList(NIL, [WA_SIZEGADGET, TRUE, WA_MINWIDTH, 200, WA_MINHEIGHT, 200, WA_DRAGBAR, TRUE, WA_DEPTHGADGET, TRUE, WA_TITLE, arglist[0], NIL]) myrp:=w.rport -> Figure out where the baseline of the uppermost line should be. wtbarheight:=w.wscreen.barheight+myfont.baseline+2 -> Set the font and add software styling to the text if I asked for it -> in OpenFont() and didn't get it. Because most Amiga fonts do not -> have styling built into them (with the exception of the CG outline -> fonts), if the user selected some kind of styling for the text, it -> will to be added algorithmically by calling SetSoftStyle(). SetFont(myrp, myfont) SetSoftStyle(myrp, Eor(fr.attr.style, myfont.style), FSF_BOLD OR FSF_UNDERLINED OR FSF_ITALIC) SetDrMd(myrp, fr.drawmode) SetAPen(myrp, fr.frontpen) SetBPen(myrp, fr.backpen) Move(myrp, w.wscreen.wborleft, wtbarheight) mainLoop() -> Short delay to allow user to see the text before it goes away. Delay(25) ELSE WriteF('Request Cancelled\n') ENDIF ELSE WriteF('Template: MeasureText \n') ENDIF EXCEPT DO IF w THEN CloseWindow(w) IF myfont THEN CloseFont(myfont) IF fr THEN FreeAslRequest(fr) IF aslbase THEN CloseLibrary(aslbase) IF diskfontbase THEN CloseLibrary(diskfontbase) IF myfile THEN Close(myfile) SELECT exception CASE ERR_ARGS; WriteF('Error: ran out of memory splitting arguments\n') CASE ERR_ASL; WriteF('Error: could not allocate ASL request\n') CASE ERR_FONT; WriteF('Error: could not open font\n') CASE ERR_KICK; WriteF('Error: requires V37+\n') CASE ERR_LIB; WriteF('Error: could not open required library\n') CASE ERR_OPEN; WriteF('Error: could not open file\n') CASE ERR_READ; WriteF('Error: Read() failed on file\n') CASE ERR_WIN; WriteF('Error: could not open window\n') ENDSELECT ENDPROC ->>> ->>> PROC mainLoop() PROC mainLoop() DEF resulttextent:textextent, fit, actual, count, printable, crrts, aok=TRUE -> While there's something to read, fill the buffer. WHILE (actual:=Read(myfile, buffer, BUFSIZE)) AND aok count:=0 WHILE count Skip non-printable characters, but account for newline characters. WHILE ((buffer[count] < myfont.lochar) OR (buffer[count] > myfont.hichar)) AND (count < actual) -> Is this character a newline? If it is, bump up the newline count. IF buffer[count]=$0A THEN INC crrts INC count ENDWHILE IF crrts>0 -> If there were any newlines, be sure to display them. Move(myrp, w.borderleft, myrp.cp_y+(crrts*(myfont.ysize+1))) eop() -> Did we go past the end of the page? ENDIF printable:=count -> Find the next non-printables. WHILE (buffer[printable] >= myfont.lochar) AND (buffer[printable] <= myfont.hichar) AND (printable < actual) INC printable ENDWHILE -> Print the string of printable characters wrapping lines to the -> beginning of the next line as needed. WHILE count How many characters in the current string of printable characters -> will fit between the rastport's current X position and the edge of -> the window? fit:=TextFit(myrp, buffer+count, printable-count, resulttextent, NIL, 1, w.width-(myrp.cp_x+w.borderleft+w.borderright), myfont.ysize+1) IF fit=0 -> Nothing else fits on this line, need to wrap to the next line Move(myrp, w.borderleft, myrp.cp_y+myfont.ysize+1) ELSE Text(myrp, buffer+count, fit) count:=count+fit ENDIF eop() ENDWHILE IF CtrlC() -> Did the user hit Ctrl-C? aok:=FALSE WriteF('Ctrl-C Break\n') count:=BUFSIZE+1 ENDIF ENDWHILE ENDWHILE ENDPROC ->>> ->>> PROC eop() PROC eop() -> If we reached the page bottom, clear the rastport and move to the top. IF myrp.cp_y > (w.height-(w.borderbottom+2)) Delay(25) SetAPen(myrp, 0) RectFill(myrp, w.borderleft, w.bordertop, w.width-(w.borderright+1), w.height-(w.borderbottom+1)) SetAPen(myrp, 1) Move(myrp, w.borderleft+1, wtbarheight) SetAPen(myrp, fr.frontpen) ENDIF ENDPROC ->>> ->>> Version string vers: CHAR 0, '$VER: MeasureText 37.1', 0 ->>> 2I-lh0-zzԙ4Src\Rkrm\IFFParse\clipftxt.e-> clipftxt.e - Writes ASCII text to clipboard unit as FTXT -> (All clipboard data must be IFF) -> -> Usage: clipftxt unitnumber -> -> To convert to an example of reading only, comment out #define WRITEREAD ->>> Header (globals) OPT PREPROCESS MODULE 'iffparse', 'libraries/iffparse', 'other/split' ENUM ERR_NONE, ERR_ARGS, ERR_CLIP, ERR_IFF, ERR_LIB, ERR_OIFF, ERR_STOP, ERR_USE, ERR_WRIT RAISE ERR_CLIP IF OpenClipboard()=NIL, ERR_IFF IF AllocIFF()=NIL, ERR_LIB IF OpenLibrary()=NIL, ERR_OIFF IF OpenIFF()<>0, ERR_STOP IF StopChunk()<>FALSE -> Causes example to write FTXT first, then read it back. -> Comment out to create a reader only #define WRITEREAD -> E-Note: using argSplit() so one arg count is one less than C's argv CONST MINARGS=1, RBUFSZ=512, ID_FTXT="FTXT", ID_CHRS="CHRS" DEF usage, errormsgs:PTR TO LONG, mytext ->>> ->>> PROC main() PROC main() HANDLE DEF iff=NIL:PTR TO iffhandle, cn:PTR TO contextnode, error=0, unitnumber=0, rlen, textlen, readbuf[RBUFSZ]:ARRAY, arglist:PTR TO LONG, going=TRUE -> E-Note: set-up globals usage:='Usage: clipftxt unitnumber (use zero for primary unit)\n' -> Text error messages for possible IFFERR_#? returns from various IFF -> routines. To get the index into this array, take your IFFERR code, -> negate it, and subtract one. -> idx = -error - 1; errormsgs:=['End of file (not an error).', 'End of context (not an error).', 'No lexical scope.', 'Insufficient memory.', 'Stream read error.', 'Stream write error.', 'Stream seek error.', 'File is corrupt.', 'IFF syntax error.', 'Not an IFF file.', 'Required call-back hook missing.', 'Return to client. You should never see this.']:LONG mytext:='This FTXT written to clipboard by clipftxt example.\n' textlen:=STRLEN IF NIL=(arglist:=argSplit()) THEN Raise(ERR_ARGS) -> If not enough args or "?", print usage IF ListLen(arglist)<>MINARGS THEN Raise(ERR_USE) IF arglist[][]="?" THEN Raise(ERR_USE) unitnumber:=Val(arglist[]) iffparsebase:=OpenLibrary('iffparse.library', 0) -> Allocate IFF_File OBJECT iff:=AllocIFF() -> Set up IFF_File for Clipboard I/O. iff.stream:=OpenClipboard(unitnumber) InitIFFasClip(iff) WriteF('Opened clipboard unit \d\n', unitnumber) InitIFFasClip(iff) #ifdef WRITEREAD -> Start the IFF transaction. OpenIFF(iff, IFFF_WRITE) -> Write our text to the clipboard as CHRS chunk in FORM FTXT -> -> First, write the FORM ID (FTXT) IF FALSE=(error:=PushChunk(iff, ID_FTXT, ID_FORM, IFFSIZE_UNKNOWN)) -> Now the CHRS chunk ID followed by the chunk data. We'll just write one -> CHRS chunk. You could write more chunks. IF FALSE=(error:=PushChunk(iff, 0, ID_CHRS, IFFSIZE_UNKNOWN)) -> Now the actual data (the text) IF WriteChunkBytes(iff, mytext, textlen)<>textlen WriteF('Error writing CHRS data.\n') error:=IFFERR_WRITE ENDIF ENDIF IF FALSE=error THEN error:=PopChunk(iff) ENDIF IF FALSE=error THEN error:=PopChunk(iff) IF error THEN Raise(ERR_WRIT) WriteF('Wrote text to clipboard as FTXT\n') -> Now let's close it, then read it back. First close the write handle, then -> close the clipboard. CloseIFF(iff) IF iff.stream THEN CloseClipboard(iff.stream) iff.stream:=NIL -> E-Note: reinitialise it to NIL to help error trapping iff.stream:=OpenClipboard(unitnumber) WriteF('Reopened clipboard unit \d\n', unitnumber) #endif -> WRITEREAD OpenIFF(iff, IFFF_READ) -> Tell iffparse we want to stop on FTXT CHRS chunks StopChunk(iff, ID_FTXT, ID_CHRS) -> Find all of the FTXT CHRS chunks -> E-Note: the going flag makes this easier to understand WHILE going error:=ParseIFF(iff, IFFPARSE_SCAN) IF error=IFFERR_EOC -> Enter next context ELSEIF error going:=FALSE ELSE -> We only asked to stop at FTXT CHRS chunks. If no error we've hit a -> stop chunk. Read the CHRS chunk data cn:=CurrentChunk(iff) IF cn IF (cn.type=ID_FTXT) AND (cn.id=ID_CHRS) WriteF('CHRS chunk contains:\n') WHILE (rlen:=ReadChunkBytes(iff, readbuf, RBUFSZ)) > 0 -> E-Note: stdout is safe since WriteF() has been used above Write(stdout, readbuf, rlen) ENDWHILE IF rlen<0 THEN error:=rlen ENDIF ENDIF ENDIF ENDWHILE IF error AND (error<>IFFERR_EOF) WriteF('IFF read failed, error \d: \s\n', error, errormsgs[-error-1]) ENDIF EXCEPT DO IF iff -> Terminate the IFF transaction with the stream. Free all associated -> structures. CloseIFF(iff) -> Close the clipboard stream IF iff.stream THEN CloseClipboard(iff.stream) -> Free the IFF_File structure itself. FreeIFF(iff) ENDIF IF iffparsebase THEN CloseLibrary(iffparsebase) SELECT exception CASE ERR_CLIP; WriteF('Error: could not open clipboard\n') CASE ERR_IFF; WriteF('Error: could not allocate IFF handle\n') CASE ERR_LIB; WriteF('Error: could not open iffparse.library\n') CASE ERR_OIFF; WriteF('Error: could not open IFF handle\n') CASE ERR_USE; WriteF(usage) CASE ERR_WRIT; WriteF('IFF write failed, error \d: \s\n', error, errormsgs[-error-1]) ENDSELECT ENDPROC ->>> ->>> Version string -> 2.0 Version string for c:Version to find vers: CHAR 0, '$VER: clipftxt 37.2', 0 ->>> ."-lh0-ԙ4Src\Rkrm\IFFParse\sift.e-> sift.e - Takes any IFF file and tells you what's in it. Verifies syntax -> and all that cool stuff. -> -> Usage: sift -c ; For clipboard scanning -> or sift ; For DOS file scanning -> -> Reads the specified stream and prints an IFFCheck-like listing of the -> contents of the IFF file, if any. Stream is a DOS file for -> argument, or is the clipboard's primary clip for -c. This program must be -> run from a CLI. ->>> Header (globals) MODULE 'iffparse', 'devices/clipboard', 'libraries/iffparse', 'other/split' ENUM ERR_NONE, ERR_ARGS, ERR_CLIP, ERR_IFF, ERR_LIB, ERR_OIFF, ERR_OPEN, ERR_USE RAISE ERR_CLIP IF OpenClipboard()=NIL, ERR_IFF IF AllocIFF()=NIL, ERR_LIB IF OpenLibrary()=NIL, ERR_OIFF IF OpenIFF()<>0, ERR_OPEN IF Open()=NIL -> E-Note: using argSplit() so one less argument than argv (no command name) CONST MINARGS=1 DEF usage, errormsgs:PTR TO LONG ->>> ->>> PROC main() PROC main() HANDLE DEF iff=NIL:PTR TO iffhandle, error, cbio, arglist:PTR TO LONG, going=TRUE -> E-Note: set-up globals usage:='Usage: sift IFFfilename (or -c for clipboard)\n' -> Text error messages for possible IFFERR_#? returns from various IFF -> routines. To get the index into this array, take your IFFERR code, -> negate it, and subtract one. -> idx = -error - 1; errormsgs:=['End of file (not an error).', 'End of context (not an error).', 'No lexical scope.', 'Insufficient memory.', 'Stream read error.', 'Stream write error.', 'Stream seek error.', 'File is corrupt.', 'IFF syntax error.', 'Not an IFF file.', 'Required call-back hook missing.', 'Return to client. You should never see this.']:LONG IF NIL=(arglist:=argSplit()) THEN Raise(ERR_ARGS) -> If not enough args or "?", print usage IF ListLen(arglist)<>MINARGS THEN Raise(ERR_USE) IF arglist[][]="?" THEN Raise(ERR_USE) -> Check to see if we are doing I/O to the Clipboard. cbio:=(arglist[][]="-") AND (arglist[][1]="c") iffparsebase:=OpenLibrary('iffparse.library', 0) -> Allocate IFF_File OBJECT iff:=AllocIFF() -> Internal support is provided for both AmigaDOS files, and the -> clipboard.device. This bizarre 'IF' statement performs the appropriate -> machinations for each case. IF cbio -> Set up IFF_File for Clipboard I/O. iff.stream:=OpenClipboard(PRIMARY_CLIP) InitIFFasClip(iff) ELSE -> Set up IFF_File for AmigaDOS I/O. iff.stream:=Open(arglist[], OLDFILE) InitIFFasDOS(iff) ENDIF -> Start the IFF transaction. OpenIFF(iff, IFFF_READ) -> E-Note: the going flag makes this easier to understand WHILE going -> The interesting bit. IFFPARSE_RAWSTEP permits us to have precision -> monitoring of the parsing process, which is necessary if we wish to -> print the structure of an IFF file. ParseIFF() with _RAWSTEP will -> return the following things for the following reasons: -> -> Return code: Reason: -> 0 Entered new context. -> IFFERR_EOC About to leave a context. -> IFFERR_EOF Encountered end-of-file. -> A parsing error. error:=ParseIFF(iff, IFFPARSE_RAWSTEP) -> Since we're only interested in when we enter a context, we 'discard' -> end-of-context (_EOC) events. IF error=IFFERR_EOC ELSEIF error -> Leave the loop if there is any other error. going:=FALSE ELSE -> If we get here, error was zero. Print out the current state of -> affairs. printTopChunk(iff) ENDIF ENDWHILE -> If error was IFFERR_EOF, then the parser encountered the end of the file -> without problems. Otherwise, we print a diagnostic. IF error=IFFERR_EOF WriteF('File scan complete.\n') ELSE WriteF('File scan aborted, error \d: \s\n', error, errormsgs[-error-1]) ENDIF EXCEPT DO IF iff -> Terminate the IFF transaction with the stream. CloseIFF(iff) -> Close the stream itself. IF iff.stream IF cbio THEN CloseClipboard(iff.stream) ELSE Close(iff.stream) ENDIF -> Free the IFF_File object itself. FreeIFF(iff) ENDIF IF iffparsebase THEN CloseLibrary(iffparsebase) SELECT exception CASE ERR_CLIP; WriteF('Error: could not open clipboard\n') CASE ERR_IFF; WriteF('Error: could not allocate IFF handle\n') CASE ERR_LIB; WriteF('Error: could not open iffparse.library\n') CASE ERR_OIFF; WriteF('Error: could not open IFF handle\n') CASE ERR_OPEN; WriteF('Error: could not open file\n') CASE ERR_USE; WriteF(usage) ENDSELECT ENDPROC ->>> ->>> PROC printTopChunk(iff:PTR TO iffhandle) PROC printTopChunk(iff:PTR TO iffhandle) DEF top:PTR TO contextnode, i, idbuf[5]:ARRAY -> Get a pointer to the context node describing the current context. IF NIL=(top:=CurrentChunk(iff)) THEN RETURN -> Print a series of dots equivalent to the current nesting depth of chunks -> processed so far. This will cause nested chunks to be printed out -> indented. FOR i:=iff.depth TO 1 STEP -1 DO WriteF('. ') -> Print out the current chunk's ID and size. WriteF('\s \d ', IdtoStr(top.id, idbuf), top.size) -> Print the current chunk's type, with a newline. WriteF('\s\n', IdtoStr(top.type, idbuf)) ENDPROC ->>> ->>> Version string -> 2.0 Version string for c:Version to find vers: CHAR 0, '$VER: sift 37.1', 0 ->>> =-lh0-%.%.7'Src\Rkrm\Intuition\Boopsi\rkmbutclass.eE-> RKMButClass.e - Example Boopsi gadget for RKRM:Libraries OPT PREPROCESS MODULE 'utility', 'amigalib/boopsi', 'tools/installhook', 'devices/inputevent', 'graphics/rastport', 'intuition/cghooks', 'intuition/classes', 'intuition/classusr', 'intuition/gadgetclass', 'intuition/icclass', 'intuition/imageclass', 'intuition/intuition', 'intuition/screens', 'utility/tagitem' ENUM ERR_NONE, ERR_LIB, ERR_WIN RAISE ERR_LIB IF OpenLibrary()=NIL, ERR_WIN IF OpenWindowTagList()=NIL OBJECT butINST midX, midY -> Coordinates of middle of gadget ENDOBJECT CONST RKMBUT_PULSE=TAG_USER+1, -> butINST has one flag: ERASE_ONLY=1, -> Tells rendering routine to only erase the gadget, not -> rerender a new one. This lets the gadget erase itself -> before it rescales. INTWIDTH=40, INTHEIGHT=20 DEF w=NIL:PTR TO window, rkmbutcl=NIL, integer=NIL:PTR TO gadget, but=NIL:PTR TO gadget -> The main() function connects an rkmButClass object to a Boopsi integer -> gadget, which displays the rkmButClass gadget's RKMBUT_PULSE value. The -> code scales and move the gadget while it is in place. PROC main() HANDLE utilitybase:=OpenLibrary('utility.library', 37) w:=OpenWindowTagList(NIL, [WA_FLAGS, WFLG_DEPTHGADGET OR WFLG_DRAGBAR OR WFLG_CLOSEGADGET OR WFLG_SIZEGADGET, WA_IDCMP, IDCMP_CLOSEWINDOW, WA_WIDTH, 640, WA_HEIGHT, 200, NIL]) WindowLimits(w, 450, 200, 640, 200) IF rkmbutcl:=initRKMButGadClass() integer:=NewObjectA(NIL, 'strgclass', [GA_ID, 1, GA_TOP, w.bordertop+5, GA_LEFT, w.borderleft+5, GA_WIDTH, INTWIDTH, GA_HEIGHT, INTHEIGHT, STRINGA_LONGVAL, 0, STRINGA_MAXCHARS, 5, NIL]) but:=NewObjectA(rkmbutcl, NIL, [GA_ID, 2, GA_TOP, w.bordertop+5, GA_LEFT, integer.leftedge+integer.width+5, GA_WIDTH, INTWIDTH, GA_HEIGHT, INTHEIGHT, GA_PREVIOUS, integer, ICA_MAP, [RKMBUT_PULSE, STRINGA_LONGVAL, NIL], ICA_TARGET, integer, NIL]) AddGList(w, integer, -1, -1, NIL) RefreshGList(integer, w, NIL, -1) SetWindowTitles(w, '<-- Click to resize gadget Height', NIL) mainLoop(NIL, 0) SetWindowTitles(w, '<-- Click to resize gadget Width', NIL) mainLoop(GA_HEIGHT, 100) SetWindowTitles(w, '<-- Click to resize gadget Y position', NIL) mainLoop(GA_WIDTH, 100) SetWindowTitles(w, '<-- Click to resize gadget X position', NIL) mainLoop(GA_TOP, but.topedge+20) SetWindowTitles(w, '<-- Click to quit', NIL) mainLoop(GA_LEFT, but.leftedge+20) RemoveGList(w, integer, -1) ENDIF EXCEPT DO IF but THEN DisposeObject(but) IF integer THEN DisposeObject(integer) IF rkmbutcl THEN freeRKMButGadClass(rkmbutcl) IF w THEN CloseWindow(w) IF utilitybase THEN CloseLibrary(utilitybase) SELECT exception CASE ERR_LIB; WriteF('Error: Could not open utility.library\n') CASE ERR_WIN; WriteF('Error: Could not open window\n') ENDSELECT ENDPROC PROC mainLoop(attr, value) SetGadgetAttrsA(but, w, NIL, [attr, value, NIL]) REPEAT UNTIL WaitIMessage(w)=IDCMP_CLOSEWINDOW ENDPROC -> Make the class and set up the dispatcher's hook PROC initRKMButGadClass() DEF cl:PTR TO iclass IF cl:=MakeClass(NIL, 'gadgetclass', NIL, SIZEOF butINST, 0) -> Initialise the dispatcher Hook. -> E-Note: use installhook to set up the hook installhook(cl.dispatcher, {dispatchRKMButGad}) ENDIF ENDPROC cl -> Free the class PROC freeRKMButGadClass(cl) IS FreeClass(cl) -> The RKMBut class dispatcher PROC dispatchRKMButGad(cl:PTR TO iclass, o, msg:PTR TO msg) DEF inst:PTR TO butINST, retval=FALSE, g:PTR TO gadget, gpi:PTR TO gpinput, ie:PTR TO inputevent, rp, x, y, w, h, tmp, gpmsg:gprender -> E-Note: installhook makes sure A4 is set-up properly tmp:=msg.methodid SELECT tmp CASE OM_NEW -> First, pass up to superclass IF g:=doSuperMethodA(cl, o, msg) -> Initialise local instance data inst:=INST_DATA(cl, g) inst.midX:=g.leftedge+(g.width/2) inst.midY:=g.topedge+(g.height/2) retval:=g ENDIF CASE GM_HITTEST -> Since this is a rectangular gadget this -> method always returns GMR_GADGETHIT. retval:=GMR_GADGETHIT CASE GM_GOACTIVE inst:=INST_DATA(cl, o) -> Only become active if the GM_GOACTIVE was triggered by direct user input. IF msg::gpinput.ievent -> This gadget is now active, change visual state to selected and render. g:=o g.flags:=g.flags OR GFLG_SELECTED renderRKMBut(cl, o, msg) retval:=GMR_MEACTIVE ELSE -> The GM_GOACTIVE was not triggered by direct user input. retval:=GMR_NOREUSE ENDIF CASE GM_RENDER retval:=renderRKMBut(cl, o, msg) CASE GM_HANDLEINPUT -> While it is active, this gadget sends its superclass an OM_NOTIFY pulse -> for every IECLASS_TIMER event that goes by (about one every 10th of a -> second). Any object that is connected to this gadget will get A LOT of -> OM_UPDATE messages. g:=o gpi:=msg ie:=gpi.ievent inst:=INST_DATA(cl, o) retval:=GMR_MEACTIVE IF ie.class=IECLASS_RAWMOUSE tmp:=ie.code SELECT tmp CASE SELECTUP -> The user let go of the gadget so return GMR_NOREUSE to deactivate -> and to tell Intuition not to reuse this Input Event as we have -> already processed it. If the user let go of the gadget while the -> mouse was over it, mask GMR_VERIFY into the return value so Intuition -> will send a Release Verify (GADGETUP). IF (gpi.mousex < g.leftedge) OR (gpi.mousex > (g.leftedge+g.width)) OR (gpi.mousey < g.topedge) OR (gpi.mousey > (g.topedge+g.height)) retval:=GMR_NOREUSE OR GMR_VERIFY ELSE retval:=GMR_NOREUSE ENDIF -> Since the gadget is going inactive, send a final notification to -> the ICA_TARGET. notifyPulse(cl, o, 0, inst.midX, msg) CASE MENUDOWN -> The user hit the menu button. Go inactive and let Intuition reuse -> the menu button event so Intuition can pop up the menu bar. retval:=GMR_REUSE -> Since the gadget is going inactive, send a final notification to -> the ICA_TARGET. notifyPulse(cl, o, 0, inst.midX, msg) DEFAULT retval:=GMR_MEACTIVE ENDSELECT ELSEIF ie.class=IECLASS_TIMER -> If the gadget gets a timer event, it sends an interim OM_NOTIFY to -> its superclass. notifyPulse(cl, o, OPUF_INTERIM, inst.midX, gpi) ENDIF CASE GM_GOINACTIVE -> Intuition said to go inactive. Clear the GFLG_SELECTED bit and render -> using unselected imagery. g:=o g.flags:=g.flags AND Not(GFLG_SELECTED) renderRKMBut(cl, o, msg) CASE OM_SET -> Although this class doesn't have settable attributes, this gadget class -> does have scaleable imagery, so it needs to find out when its size and/or -> position has changed so it can erase itself, THEN scale, and rerender. IF FindTagItem(GA_WIDTH, msg::opset.attrlist) OR FindTagItem(GA_HEIGHT, msg::opset.attrlist) OR FindTagItem(GA_TOP, msg::opset.attrlist) OR FindTagItem(GA_LEFT, msg::opset.attrlist) g:=o x:=g.leftedge y:=g.topedge w:=g.width h:=g.height inst:=INST_DATA(cl, o) retval:=doSuperMethodA(cl, o, msg) -> Get pointer to RastPort for gadget. IF rp:=ObtainGIRPort(msg::opset.ginfo) SetAPen(rp, msg::opset.ginfo.drinfo.pens[BACKGROUNDPEN]) SetDrMd(rp, RP_JAM1) -> Erase the old gadget. RectFill(rp, x, y, x+w, y+h) inst.midX:=g.leftedge+(g.width/2) -> Recalculate where the inst.midY:=g.topedge+(g.height/2) -> center of the gadget is. -> Rerender the gadget. -> E-Note: Intuition may alter the message, so don't use a static list gpmsg.methodid:=GM_RENDER gpmsg.ginfo:=msg::opset.ginfo gpmsg.rport:=rp gpmsg.redraw:=GREDRAW_REDRAW doMethodA(o, gpmsg) ReleaseGIRPort(rp) ENDIF ELSE retval:=doSuperMethodA(cl, o, msg) ENDIF DEFAULT -> rkmmodelclass does not recognise the methodID, let the superclass's -> dispatcher take a look at it. retval:=doSuperMethodA(cl, o, msg) ENDSELECT ENDPROC retval -> Build an OM_NOTIFY message for RKMBUT_PULSE and send it to the superclass. PROC notifyPulse(cl, o:PTR TO gadget, flags, mid, gpi:PTR TO gpinput) DEF msg:PTR TO opnotify -> E-Note: "opnotify" is really "opupdate" -> If this is an OM_UPDATE method, make sure the part the OM_UPDATE message -> adds to the OM_SET message gets added. That lets the dispatcher handle -> OM_UPDATE and OM_SET in the same case. msg:=[OM_NOTIFY, [RKMBUT_PULSE, mid-(gpi.mousex+o.leftedge), GA_ID, o.gadgetid, NIL], gpi.ginfo, flags]:opnotify -> E-Note: A bug (?) in Intuition means that the methodid of an OM_NOTIFY -> message may be altered, so you can't get away with just using a -> constant value in the above static list... msg.methodid:=OM_NOTIFY doSuperMethodA(cl, o, msg) ENDPROC -> Erase and rerender the gadget. PROC renderRKMBut(cl:PTR TO iclass, g:PTR TO gadget, msg:PTR TO gprender) DEF inst:PTR TO butINST, rp, retval=TRUE, pens:PTR TO INT, back, shine, shadow, w, h, x, y inst:=INST_DATA(cl, g) pens:=msg.ginfo.drinfo.pens IF msg.methodid=GM_RENDER -> If msg is truly a GM_RENDER message (not a gpinput that looks like a -> gprender), use the rastport within it... rp:=msg.rport ELSE -> ...Otherwise, get a rastport using ObtainGIRPort(). rp:=ObtainGIRPort(msg.ginfo) ENDIF IF rp IF g.flags AND GFLG_SELECTED -> If the gadget is selected, reverse the meanings of the pens. back:=pens[FILLPEN] shine:=pens[SHADOWPEN] shadow:=pens[SHINEPEN] ELSE back:=pens[BACKGROUNDPEN] shine:=pens[SHINEPEN] shadow:=pens[SHADOWPEN] ENDIF SetDrMd(rp, RP_JAM1) SetAPen(rp, back) -> Erase the old gadget. RectFill(rp, g.leftedge, g.topedge, g.leftedge+g.width, g.topedge+g.height) SetAPen(rp, shadow) -> Draw shadow edge. Move(rp, g.leftedge+1, g.topedge+g.height) Draw(rp, g.leftedge+g.width, g.topedge+g.height) Draw(rp, g.leftedge+g.width, g.topedge+1) w:=g.width/4 -> Draw Arrows - Sorry, no frills imagery h:=g.height/2 x:=g.leftedge+(w/2) y:=g.topedge+(h/2) Move(rp, x, inst.midY) Draw(rp, x+w, y) Draw(rp, x+w, y+g.height-h) Draw(rp, x, inst.midY) x:=g.leftedge+(w/2)+(g.width/2) Move(rp, x+w, inst.midY) Draw(rp, x, y) Draw(rp, x, y+g.height-h) Draw(rp, x+w, inst.midY) SetAPen(rp, shine) -> Draw shine edge. Move(rp, g.leftedge, g.topedge+g.height-1) Draw(rp, g.leftedge, g.topedge) Draw(rp, g.leftedge+g.width-1, g.topedge) IF msg.methodid<>GM_RENDER -> If we allocated a rastport, give it back. ReleaseGIRPort(rp) ENDIF ELSE retval:=FALSE ENDIF ENDPROC retval vers: CHAR 0, '$VER: TestBut 37.1', 0 :-lh0-$Src\Rkrm\Intuition\Boopsi\rkmmodel.en-> RKMModel.e - A simple custom modelclass subclass. OPT MODULE OPT PREPROCESS OPT OSVERSION=37 MODULE 'utility', 'amigalib/boopsi', 'tools/installhook', 'intuition/classes', 'intuition/classusr', 'utility/hooks', 'utility/tagitem' -> The attributes defined by this class EXPORT ENUM RKMMOD_DUMMY=TAG_USER, RKMMOD_CURRVAL, -> This attribute is the current value of the model. RKMMOD_UP, -> These two are fake attributes that rkmmodelclass RKMMOD_DOWN, -> uses as pulse values to increment/decrement the -> rkmmodel's RKMMOD_CURRVAL attribute. RKMMOD_LIMIT -> This attribute contains the upper bound of the -> rkmmodel's RKMMOD_CURRVAL. The rkmmodel has a -> static lower bound of zero. -> If the programmer doesn't set RKMMOD_LIMIT, it defaults to this. CONST DEFAULTVALLIMIT=100 OBJECT rkmModData currval, vallimit -> The instance data for this class ENDOBJECT -> Initialise the class EXPORT PROC initRKMModClass() -> Make the class and set up the dispatcher's hook DEF cl:PTR TO iclass IF cl:=MakeClass(NIL, 'modelclass', NIL, SIZEOF rkmModData, 0) -> E-Note: use installhook to set up the hook installhook(cl.dispatcher, {dispatchRKMModel}) -> Initialise the Hook ENDIF ENDPROC cl -> Free the class EXPORT PROC freeRKMModClass(cl) IS FreeClass(cl) -> The class Dispatcher PROC dispatchRKMModel(cl:PTR TO iclass, o, msg:PTR TO msg) DEF mmd:PTR TO rkmModData, id, ti:PTR TO tagitem, tstate, tag, retval=NIL -> A generic return value used by this class's methods. The -> meaning of this field depends on the method. For example, -> OM_GET uses this as a boolean return value, while OM_NEW -> uses it as a pointer to the new object. -> E-Note: installhook makes sure A4 is set-up properly id:=msg.methodid IF id=OM_SET THEN id:=OM_UPDATE -> E-Note: handled the same in this class SELECT id CASE OM_NEW -> Pass message onto superclass first so it can set aside memory -> for the object and take care of superclass instance data. IF retval:=doSuperMethodA(cl, o, msg) -> For the OM_NEW method, the object pointer passed to the dispatcher -> does not point to an object (how could it? The object doesn't exist -> yet.). doSuperMethodA() returns a pointer to a newly created object. -> INST_DATA() is a macro defined in 'intuition/classes' that returns a -> pointer to the object's instance data that is local to this class. For -> example, the instance data local to this class is the rkmModData -> structure defined above. mmd:=INST_DATA(cl, retval) -> Initialise object's attributes -> E-Note: "opnew" is really "opset" mmd.currval:=GetTagData(RKMMOD_CURRVAL, 0, msg::opnew.attrlist) mmd.vallimit:=GetTagData(RKMMOD_LIMIT,DEFAULTVALLIMIT,msg::opnew.attrlist) ENDIF CASE OM_UPDATE -> E-Note: includes OM_SET (see "IF id=.." above) mmd:=INST_DATA(cl, o) doSuperMethodA(cl,o,msg) -> Let the superclasses set their attributes first tstate:=msg::opset.attrlist -> Step through all of the attribute/value pairs in the list. Use the -> utility.library tag functions to do this so they can properly process -> special tag IDs like TAG_SKIP, TAG_IGNORE, etc. WHILE ti:=NextTagItem({tstate}) tag:=ti.tag SELECT tag CASE RKMMOD_CURRVAL IF ti.data>mmd.vallimit THEN ti.data:=mmd.vallimit mmd.currval:=ti.data notifyCurrVal(cl, o, msg, mmd) retval:=1 -> Changing RKMMOD_CURRVAL can cause a visual change to the -> gadgets in the rkmmodel's broadcast list. The rkmmodel has -> to tell the application by returning a value besides zero. CASE RKMMOD_UP mmd.currval:=mmd.currval+1 -> Make sure the current value is not greater than value limit. IF mmd.currval>mmd.vallimit THEN mmd.currval:=mmd.vallimit notifyCurrVal(cl, o, msg, mmd) retval:=1 -> Changing RKMMOD_UP can cause a visual change to the gadgets -> in the rkmmodel's broadcast list. The rkmmodel has to tell -> the application by returning a value besides zero. CASE RKMMOD_DOWN mmd.currval:=mmd.currval-1 -> Make sure the currval didn't go negative IF mmd.currval<0 THEN mmd.currval:=0 notifyCurrVal(cl, o, msg, mmd) retval:=1 -> Changing RKMMOD_DOWN can cause a visual change to gadgets -> in the rkmmodel's broadcast list. The rkmmodel has to tell -> the application by returning a value besides zero. CASE RKMMOD_LIMIT mmd.vallimit:=ti.data -> Set the limit. Note that this does not do -> bounds checking on the current -> rkmModData.currval value. ENDSELECT ENDWHILE CASE OM_GET -> The only attribute that is "gettable" in this class mmd:=INST_DATA(cl, o) -> or its superclasses is RKMMOD_CURRVAL. IF msg::opget.attrid=RKMMOD_CURRVAL msg::opget.storage[]:=mmd.currval retval:=TRUE ELSE retval:=doSuperMethodA(cl, o, msg) ENDIF DEFAULT -> rkmmodelclass does not recognise the methodID, so let the -> superclass's dispatcher take a look at it. retval:=doSuperMethodA(cl, o, msg) ENDSELECT ENDPROC retval PROC notifyCurrVal(cl, o, msg:PTR TO opupdate, mmd:PTR TO rkmModData) DEF notifymsg:PTR TO opnotify -> E-Note: "opnotify" is really "opupdate" -> If this is an OM_UPDATE method, make sure the part the OM_UPDATE message -> adds to the OM_SET message gets added. That lets the dispatcher handle -> OM_UPDATE and OM_SET in the same case. notifymsg:=[OM_NOTIFY, [RKMMOD_CURRVAL, mmd.currval, NIL], msg.ginfo, IF msg.methodid=OM_UPDATE THEN msg.flags ELSE 0]:opnotify -> E-Note: A bug (?) in Intuition means that the methodid of an OM_NOTIFY -> message may be altered, so you can't get away with just using a -> constant value in the above static list... notifymsg.methodid:=OM_NOTIFY -> If the RKMMOD_CurrVal changes, we want everyone to know about it. -> Theoretically, the class is supposed to send itself a OM_NOTIFY message. -> Because this class lets its superclass handle the OM_NOTIFY message, it -> skips the middleman and sends the OM_NOTIFY directly to its superclass. doSuperMethodA(cl, o, notifymsg) ENDPROC :--lh0-j$Src\Rkrm\Intuition\Boopsi\rkmmodel.mEMOD% NUOp/@AD /@ p/@p/@p/@,lLNZ+@Jg mA /A*/NO -N]NuNU m,lN6N]NuNUp+@ m +@ - f +| <f/-/- /-NO +@Jg -/ m0( H" Ё+@O </@p/@ m (/@,lLN m O </@pd/@ m (/@,lLN m!@`N <f - / m0( H" Ё+@/-/- /-NO m (+@OA /@,lLN+@JgD m +@ <fX m ( m"(o m ( m!@ m ( m /-/- /-/-aOp+@` <fT m R m m  m"(o m ( m /-/- /-/-a"Op+@`r <fF m S m m Jl p m /-/- /-/-aOp+@` <f m ( m!@`` <fl - / m0( H" Ё+@ m ( f m  m h p+@`/-/- /-NO +@`/-/- /-NO +@ -N]NuNU m /A `!_/ m (/ m  f m ( `p/A `!_ !_!_+@ < m /-/-/-NO pN]NumodelclassfreeRKMModClassbclinitRKMModClass utilitybaseBb RKMMOD_DOWNRKMMOD_DUMMY RKMMOD_UPRKMMOD_CURRVALRKMMOD_LIMIT emodules:tools/installhook.m installhookRemodules:amigalib/boopsi.mdoSuperMethodAFz=-lh0-__'Src\Rkrm\Intuition\Boopsi\talk2boopsi.e-> This example creates a Boopsi prop gadget and integer string gadget, -> connecting them so they update each other when the user changes their value. -> The example program only initialises the gadgets and puts them on the window; -> it doesn't have to interact with them to make them talk to each other. OPT OSVERSION=37 MODULE 'intuition/gadgetclass', 'intuition/icclass', 'intuition/intuition' ENUM ERR_NONE, ERR_OBJ, ERR_WIN RAISE ERR_OBJ IF NewObjectA()=NIL, ERR_WIN IF OpenWindowTagList()=NIL CONST PROPGADGET_ID=1, INTGADGET_ID=2, PROPGADGETWIDTH=10, PROPGADGETHEIGHT=80, INTGADGETHEIGHT=18, VISIBLE=10, TOTAL=100, INITIALVAL=25, MINWINDOWWIDTH=80 CONST MINWINDOWHEIGHT=PROPGADGETHEIGHT+70, MAXCHARS=3 PROC main() HANDLE DEF w=NIL:PTR TO window, prop=NIL, integer=NIL -> Open the window--notice that the window's IDCMP port -> does not listen for GADGETUP messages. w:=OpenWindowTagList(NIL, [WA_FLAGS, WFLG_DEPTHGADGET OR WFLG_DRAGBAR OR WFLG_CLOSEGADGET OR WFLG_SIZEGADGET, WA_IDCMP, IDCMP_CLOSEWINDOW, WA_MINWIDTH, MINWINDOWWIDTH, WA_MINHEIGHT, MINWINDOWHEIGHT, NIL]) -> Create a new propgclass object prop:=NewObjectA(NIL, 'propgclass', [GA_ID, PROPGADGET_ID, -> These are defined by gadgetclass and GA_TOP, w.bordertop+5, -> correspond to similarly named fields GA_LEFT, w.borderleft+5, -> in the Gadget structure. GA_WIDTH, PROPGADGETWIDTH, GA_HEIGHT, PROPGADGETHEIGHT, -> This tells the prop gadget to map its PGA_Top attribute to -> STRINGA_LONGVAL when it issues an update about the change to -> its PGA_Top value. ICA_MAP, [PGA_TOP, STRINGA_LONGVAL, NIL], -> The rest of this gadget's attributes are defined by propgclass. PGA_TOTAL, TOTAL, -> The integer range of the prop gadget. PGA_TOP, INITIALVAL, -> The initial value of the prop gadget. PGA_VISIBLE, VISIBLE, -> This determines how much of the prop gadget -> area is covered by the prop gadget's knob, -> or how much of the gadget's TOTAL range is -> taken up by the prop gadget's knob. PGA_NEWLOOK, TRUE, -> Use new-look prop gadget imagery NIL]) -> Create the integer string gadget integer:=NewObjectA(NIL, 'strgclass', [GA_ID, INTGADGET_ID, -> Parameters for the Gadget structure GA_TOP, w.bordertop+5, GA_LEFT, w.borderleft+PROPGADGETWIDTH+10, GA_WIDTH, (MINWINDOWWIDTH- (w.borderleft+w.borderright+PROPGADGETWIDTH+15)), GA_HEIGHT, INTGADGETHEIGHT, -> This tells the string gadget to map its STRINGA_LONGVAL -> attribute to PGA_TOP when it issues an update. ICA_MAP, [STRINGA_LONGVAL, PGA_TOP, NIL], ICA_TARGET, prop, -> The GA_PREVIOUS attribute is defined by gadgetclass and is used -> to wedge a new gadget into a list of gadget's linked by their -> gadget.nextgadget field. When NewObject() creates this gadget, -> it inserts the new gadget into this list behind the GA_PREVIOUS -> gadget. This attribute is a pointer to the previous gadget. -> This attribute cannot be used to link new gadgets into the -> gadget list of an open window or requester, use -> AddGList() instead. GA_PREVIOUS, prop, -> These attributes are defined by strgclass. The first contains -> the value of the integer string gadget. The second is the -> maximum number of characters the user is allowed to type into -> the gadget. STRINGA_LONGVAL, INITIALVAL, STRINGA_MAXCHARS, MAXCHARS, NIL]) -> Because the integer string gadget did not exist when this example created -> the prop gadget, it had to wait to set the ICA_Target of the prop gadget. SetGadgetAttrsA(prop, w, NIL, [ICA_TARGET, integer, NIL]) AddGList(w,prop,-1,-1,NIL) -> Add the gadgets to the window and display them. RefreshGList(prop, w, NIL, -1) REPEAT -> Wait for the user to click the window close gadget. UNTIL WaitIMessage(w)=IDCMP_CLOSEWINDOW RemoveGList(w, prop, -1) EXCEPT DO IF integer THEN DisposeObject(integer) IF prop THEN DisposeObject(prop) IF w THEN CloseWindow(w) SELECT exception CASE ERR_OBJ; WriteF('Error: Failed to create new Object\n') CASE ERR_WIN; WriteF('Error: Failed to open window\n') ENDSELECT ENDPROC vers: CHAR 0, '$VER: Talk2boopsi 37.1', 0=4-lh0-¦z'Src\Rkrm\Intuition\Boopsi\userkmmodel.eOPT OSVERSION=37 MODULE '*rkmmodel', 'amigalib/boopsi', 'utility', 'intuition/classusr', 'intuition/gadgetclass', 'intuition/icclass', 'intuition/imageclass', 'intuition/intuition' ENUM ERR_NONE, ERR_DRAW, ERR_LIB, ERR_OBJ, ERR_WIN RAISE ERR_DRAW IF GetScreenDrawInfo()=NIL, ERR_LIB IF OpenLibrary()=NIL, ERR_OBJ IF NewObjectA()=NIL, ERR_WIN IF OpenWindowTagList()=NIL CONST PROPID=1, INTEGERID=2, RIGHTID=3, LEFTID=4, PROPWIDTH=80, PROPHEIGHT=10, INTWIDTH=50, INTHEIGHT=14, VISIBLE=10, TOTAL=100, INITIALVAL=25 CONST MINWINDOWWIDTH=80, MINWINDOWHEIGHT=PROPHEIGHT+70, MAXCHARS=4 DEF w=NIL:PTR TO window, mydrawinfo=NIL, rkmmodcl=NIL, rkmmodel=NIL, currval2int=NIL, currval2prop=NIL, prop=NIL:PTR TO gadget, integer=NIL:PTR TO gadget, leftbut=NIL:PTR TO gadget, rightbut=NIL:PTR TO gadget, rightimage=NIL, leftimage=NIL PROC main() HANDLE DEF qwe utilitybase:=OpenLibrary('utility.library', 37) w:=OpenWindowTagList(NIL, [WA_FLAGS, WFLG_DEPTHGADGET OR WFLG_DRAGBAR OR WFLG_CLOSEGADGET OR WFLG_SIZEGADGET, WA_IDCMP, IDCMP_CLOSEWINDOW, NIL]) -> E-Note: we could have made initRKMModClass raise an exception IF rkmmodcl:=initRKMModClass() mydrawinfo:=GetScreenDrawInfo(w.wscreen) makeGadgetsAndRKMModel() doMethodA(rkmmodel, [OM_ADDMEMBER, currval2prop]) currval2prop:=NIL -> E-Note: this is now part of the rkmmodel object doMethodA(rkmmodel, [OM_ADDMEMBER, currval2int]) currval2int:=NIL -> E-Note: again, now part of the rkmmodel object WindowLimits(w, w.borderleft+w.borderright+integer.leftedge+integer.width+10, w.bordertop+w.borderbottom+prop.height+10, w.maxwidth, w.maxheight) AddGList(w, prop, -1, -1, NIL) RefreshGadgets(prop, w, NIL) GetAttr(RKMMOD_CURRVAL, rkmmodel, {qwe}) WriteF('RKMMOD_CURRVAL = \d\n', qwe) Delay(200) IF SetAttrsA(rkmmodel, [RKMMOD_CURRVAL, 10, NIL]) RefreshGadgets(prop, w, NIL) ENDIF GetAttr(RKMMOD_CURRVAL, rkmmodel, {qwe}) WriteF('RKMMOD_CURRVAL = \d\n', qwe) Delay(200) IF SetAttrsA(rkmmodel, [RKMMOD_CURRVAL, 30, NIL]) RefreshGadgets(prop, w, NIL) ENDIF GetAttr(RKMMOD_CURRVAL, rkmmodel, {qwe}) WriteF('RKMMOD_CURRVAL = \d\n', qwe) Delay(200) IF SetAttrsA(rkmmodel, [RKMMOD_CURRVAL, 50, NIL]) RefreshGadgets(prop, w, NIL) ENDIF GetAttr(RKMMOD_CURRVAL, rkmmodel, {qwe}) WriteF('RKMMOD_CURRVAL = \d\n', qwe) Delay(200) IF SetAttrsA(rkmmodel, [RKMMOD_UP, 1, NIL]) RefreshGadgets(prop, w, NIL) ENDIF -> Wait for the user to click window close gadget REPEAT UNTIL WaitIMessage(w)=IDCMP_CLOSEWINDOW RemoveGList(w, prop, -1) ENDIF EXCEPT DO IF currval2int THEN DisposeObject(currval2int) IF currval2prop THEN DisposeObject(currval2prop) IF rightbut THEN DisposeObject(rightbut) IF leftbut THEN DisposeObject(leftbut) IF integer THEN DisposeObject(integer) IF prop THEN DisposeObject(prop) IF rkmmodel THEN DisposeObject(rkmmodel) IF leftimage THEN DisposeObject(leftimage) IF rightimage THEN DisposeObject(rightimage) IF mydrawinfo THEN FreeScreenDrawInfo(w.wscreen, mydrawinfo) IF rkmmodcl THEN freeRKMModClass(rkmmodcl) IF w THEN CloseWindow(w) IF utilitybase THEN CloseLibrary(utilitybase) SELECT exception CASE ERR_DRAW; WriteF('Error: Failed to get screen DrawInfo\n') CASE ERR_LIB; WriteF('Error: Failed to open utility library\n') CASE ERR_OBJ; WriteF('Error: Failed to make new Object\n') CASE ERR_WIN; WriteF('Error: Failed to open window\n') ENDSELECT ENDPROC PROC makeGadgetsAndRKMModel() HANDLE rightimage:=NewObjectA(NIL, 'sysiclass', [SYSIA_WHICH, RIGHTIMAGE, SYSIA_DRAWINFO, mydrawinfo, NIL]) leftimage:=NewObjectA(NIL, 'sysiclass', [SYSIA_WHICH, LEFTIMAGE, SYSIA_DRAWINFO, mydrawinfo, NIL]) rkmmodel:=NewObjectA(rkmmodcl, NIL, [RKMMOD_CURRVAL, INITIALVAL, RKMMOD_LIMIT, TOTAL-VISIBLE, NIL]) prop:=NewObjectA(NIL, 'propgclass', [GA_ID, PROPID, GA_TOP, w.bordertop+5, GA_LEFT, w.borderleft+5, GA_WIDTH, PROPWIDTH, GA_HEIGHT, PROPHEIGHT, ICA_MAP, [PGA_TOP, RKMMOD_CURRVAL, STRINGA_LONGVAL, RKMMOD_CURRVAL, NIL], ICA_TARGET, rkmmodel, PGA_FREEDOM, FREEHORIZ, PGA_TOTAL, TOTAL, PGA_TOP, INITIALVAL, PGA_VISIBLE, VISIBLE, PGA_NEWLOOK, TRUE, NIL]) integer:=NewObjectA(NIL, 'strgclass', [GA_ID, INTEGERID, GA_TOP, w.bordertop+5, GA_LEFT, prop.leftedge+prop.width+48, GA_WIDTH, INTWIDTH, GA_HEIGHT, INTHEIGHT, ICA_MAP, [PGA_TOP, RKMMOD_CURRVAL, STRINGA_LONGVAL, RKMMOD_CURRVAL, NIL], ICA_TARGET, rkmmodel, GA_PREVIOUS, prop, STRINGA_LONGVAL, INITIALVAL, STRINGA_MAXCHARS, MAXCHARS, NIL]) leftbut:=NewObjectA(NIL, 'buttongclass', [GA_ID, LEFTID, GA_IMAGE, leftimage, GA_TOP, w.bordertop+5, GA_LEFT, prop.leftedge+prop.width, ICA_MAP, [GA_ID, RKMMOD_DOWN, NIL], ICA_TARGET, rkmmodel, GA_PREVIOUS, integer, NIL]) rightbut:=NewObjectA(NIL, 'buttongclass', [GA_ID, RIGHTID, GA_IMAGE, rightimage, GA_TOP, w.bordertop+5, GA_LEFT, prop.leftedge+prop.width+leftbut.width, ICA_MAP, [GA_ID, RKMMOD_UP, NIL], ICA_TARGET, rkmmodel, GA_PREVIOUS, leftbut, NIL]) currval2prop:=NewObjectA(NIL, 'icclass', [ICA_MAP, [RKMMOD_CURRVAL, PGA_TOP, NIL], ICA_TARGET, prop, NIL]) currval2int:=NewObjectA(NIL, 'icclass', [ICA_MAP, [RKMMOD_CURRVAL, STRINGA_LONGVAL, NIL], ICA_TARGET, integer, NIL]) RETURN TRUE EXCEPT ReThrow() -> E-Note: pass on exception if it is an error ENDPROC vers: CHAR 0, '$VER: UseRKMModel 37.1', 0 <-lh0- {z&Src\Rkrm\Intuition\Gadgets\simplegad.e-> simplegad.e - show the use of a button gadget. MODULE 'graphics/rastport', -> RastPort and other structures 'intuition/intuition' -> Intuition data structures and tags CONST BUTTON_GAD_NUM=3, MYBUTTONGADWIDTH=100, MYBUTTONGADHEIGHT=50 -> NOTE that the use of constant size and positioning values are not -> recommended; it just makes it easy to show what is going on. The position -> of the gadget should be dynamically adjusted depending on the height of the -> font in the title bar of the window. ENUM ERR_NONE, ERR_WIN, ERR_KICK RAISE ERR_WIN IF OpenWindowTagList()=NIL -> Routine to show the use of a button (boolean) gadget. PROC main() HANDLE DEF win=NIL:PTR TO window, class, gad:PTR TO gadget -> Make sure to get version 37, for OpenWindowTags() */ IF KickVersion(37)=FALSE THEN Raise(ERR_KICK) -> E-Note: E automatically opens the Intuition library -> E-Note: automatically error-checked (automatic exception) win:=OpenWindowTagList(NIL, [WA_WIDTH, 400, WA_HEIGHT, 100, WA_GADGETS, -> E-Note: use typed lists for gadget [NIL, 20, 20, MYBUTTONGADWIDTH, MYBUTTONGADHEIGHT, GFLG_GADGHCOMP, GACT_RELVERIFY OR GACT_IMMEDIATE, GTYP_BOOLGADGET, [-1, -1, 1, 0, RP_JAM1, 5, -> E-Note: Border [0, 0, -> E-Note: 5 co-ords (INTs) MYBUTTONGADWIDTH+1, 0, MYBUTTONGADWIDTH+1, MYBUTTONGADHEIGHT+1, 0, MYBUTTONGADHEIGHT+1, 0,0]:INT, NIL]:border, NIL, NIL, 0, NIL, BUTTON_GAD_NUM, NIL]:gadget, WA_ACTIVATE, TRUE, WA_CLOSEGADGET, TRUE, WA_IDCMP, IDCMP_GADGETDOWN OR IDCMP_GADGETUP OR IDCMP_CLOSEWINDOW, NIL]) REPEAT class:=WaitIMessage(win) -> SELECT on the type of the event SELECT class CASE IDCMP_GADGETUP -> Caused by GACT_RELVERIFY gad:=MsgIaddr() WriteF('Received an IDCMP_GADGETUP , gadget number \d\n', gad.gadgetid) CASE IDCMP_GADGETDOWN -> Caused by GACT_IMMEDIATE gad:=MsgIaddr() WriteF('Received an IDCMP_GADGETDOWN , gadget number \d\n', gad.gadgetid) ENDSELECT UNTIL class=IDCMP_CLOSEWINDOW WriteF('Received an IDCMP_CLOSEWINDOW\n') -> E-Note: exit and clean up via handler EXCEPT DO IF win THEN CloseWindow(win) -> E-Note: we can print a minimal error message SELECT exception CASE ERR_WIN; WriteF('Error: Failed to open window\n') CASE ERR_KICK; WriteF('Error: Needs Kickstart V37+\n') CASE "MEM"; WriteF('Error: Ran out of memory\n') ENDSELECT ENDPROC;o-lh0-z%Src\Rkrm\Intuition\Gadgets\strhooks.e-> strhooks.e - string gadget hooks demo -> E-Note: this uses several of the 'tools' modules, notably 'installhook' MODULE 'utility', 'graphics/rastport', 'intuition/intuition', 'intuition/screens', 'intuition/sghooks', 'utility/hooks', 'tools/ctype', 'tools/installhook' ENUM ERR_NONE, ERR_DRAW, ERR_KICK, ERR_LIB, ERR_PUB, ERR_WIN RAISE ERR_DRAW IF GetScreenDrawInfo()=NIL, ERR_LIB IF OpenLibrary()=NIL, ERR_PUB IF LockPubScreen()=NIL, ERR_WIN IF OpenWindowTagList()=NIL CONST SG_STRLEN=44, MYSTRGADWIDTH=200 -> We'll dynamically allocate/clear most structures, buffers OBJECT vars sgg_Window:PTR TO window sgg_Gadget:gadget sgg_StrInfo:stringinfo sgg_Extend:stringextend sgg_Hook:hook sgg_Buff[SG_STRLEN]:ARRAY sgg_WBuff[SG_STRLEN]:ARRAY sgg_UBuff[SG_STRLEN]:ARRAY ENDOBJECT -> Open all required libraries, set-up the string gadget. -> Prepare the hook, open the sgg_Window and go... PROC main() HANDLE -> E-Note: subtle name changes needed... DEF vars=NIL:PTR TO vars, screen=NIL:PTR TO screen, drawinfo=NIL:PTR TO drawinfo IF KickVersion(37)=FALSE THEN Raise(ERR_KICK) utilitybase:=OpenLibrary('utility.library', 37) -> Get the correct pens for the screen screen:=LockPubScreen(NIL) drawinfo:=GetScreenDrawInfo(screen) NEW vars -> E-Note: raises an exception if it fails vars.sgg_Extend.pens[0]:=drawinfo.pens[FILLTEXTPEN] vars.sgg_Extend.pens[1]:=drawinfo.pens[FILLPEN] vars.sgg_Extend.activepens[0]:=drawinfo.pens[FILLTEXTPEN] vars.sgg_Extend.activepens[1]:=drawinfo.pens[FILLPEN] vars.sgg_Extend.edithook:=vars.sgg_Hook vars.sgg_Extend.workbuffer:=vars.sgg_WBuff vars.sgg_StrInfo.buffer:=vars.sgg_Buff vars.sgg_StrInfo.undobuffer:=vars.sgg_UBuff vars.sgg_StrInfo.maxchars:=SG_STRLEN vars.sgg_StrInfo.extension:=vars.sgg_Extend -> There should probably be a border around the string gadget. -> As is, it is hard to locate when disabled. vars.sgg_Gadget.leftedge:=20 vars.sgg_Gadget.topedge:=30 vars.sgg_Gadget.width:=MYSTRGADWIDTH vars.sgg_Gadget.height:=screen.rastport.txheight vars.sgg_Gadget.flags:=GFLG_GADGHCOMP OR GFLG_STRINGEXTEND vars.sgg_Gadget.activation:=GACT_RELVERIFY vars.sgg_Gadget.gadgettype:=GTYP_STRGADGET vars.sgg_Gadget.specialinfo:=vars.sgg_StrInfo -> E-Note: use typed lists for border and its data -> E-Note: because we're using E we don't need stupid INIT_LATER vars.sgg_Gadget.gadgetrender:=[-2,-2,1,0,RP_JAM1,5, [0, 0, MYSTRGADWIDTH+3, 0, MYSTRGADWIDTH+3, screen.rastport.txheight+3, 0, screen.rastport.txheight+3, 0, 0]:INT, NIL]:border -> E-Note: use Wouter's installhook installhook(vars.sgg_Hook, {str_hookRoutine}) vars.sgg_Window:=OpenWindowTagList(NIL, [WA_PUBSCREEN, screen, WA_LEFT, 21, WA_TOP, 20, WA_WIDTH, 500, WA_HEIGHT, 150, WA_MINWIDTH, 50, WA_MAXWIDTH, -1, WA_MINHEIGHT, 30, WA_MAXHEIGHT, -1, WA_SIMPLEREFRESH, TRUE, WA_NOCAREREFRESH, TRUE, WA_RMBTRAP, TRUE, WA_IDCMP, IDCMP_GADGETUP OR IDCMP_CLOSEWINDOW, WA_FLAGS, WFLG_CLOSEGADGET OR WFLG_NOCAREREFRESH OR WFLG_DRAGBAR OR WFLG_DEPTHGADGET OR WFLG_SIMPLE_REFRESH, WA_TITLE, 'String Hook Accepts HEX Digits Only', WA_GADGETS, vars.sgg_Gadget, NIL]) handleWindow(vars) -> E-Note: exit and clean up via handler EXCEPT DO IF (vars<>NIL) AND vars.sgg_Window THEN CloseWindow(vars.sgg_Window) -> E-Note: vars automatically freed IF drawinfo THEN FreeScreenDrawInfo(screen, drawinfo) IF screen THEN UnlockPubScreen(NIL, screen) IF utilitybase THEN CloseLibrary(utilitybase) -> E-Note: we can print a minimal error message SELECT exception CASE ERR_DRAW; WriteF('Error: Failed to get drawinfo from screen\n') CASE ERR_KICK; WriteF('Error: Needs Kickstart V37+\n') CASE ERR_LIB; WriteF('Error: Failed to open utility.library\n') CASE ERR_PUB; WriteF('Error: Failed to lock public screen\n') CASE ERR_WIN; WriteF('Error: Failed to open window\n') CASE "MEM"; WriteF('Error: Ran out of memory\n') ENDSELECT ENDPROC -> This is an example string editing hook, which shows the basics of creating -> a string editing function. This hook restricts entry to hexadecimal digits -> (0-9, A-F, a-f) and converts them to upper case. To demonstrate processing -> of mouse-clicks, this hook also detects clicking on a character, and -> converts it to a zero. -> -> NOTE String editing hooks are called on Intuition's task context, so the -> hook may not use DOS and may not cause Wait() to be called. PROC str_hookRoutine(hook, sgw:PTR TO sgwork, msg:PTR TO LONG) DEF work_ptr, return_code -> Hook must return non-zero if command is supported. -> This will be changed to zero if the command is unsupported. return_code:=-1 IF msg[]=SGH_KEY -> Key hit -- could be any key (Shift, repeat, character, etc.) -> Allow only upper case characters to be entered. -> Act only on modes that add or update characters in the buffer. IF (sgw.editop=EO_REPLACECHAR) OR (sgw.editop=EO_INSERTCHAR) -> Code contains the ASCII representation of the character entered, if -> it maps to a single byte. We could also look into the work buffer to -> find the new character. -> -> sgw.code = sgw.workbuffer[sgw.bufferpos-1] -> -> If the character is not a legal hex digit, don't use the work buffer -> and beep the screen. -> E-Note: use isxdigit from 'tools/ctype' IF isxdigit(sgw.code)=FALSE sgw.actions:=sgw.actions OR SGA_BEEP sgw.actions:=sgw.actions AND Not(SGA_USE) ELSE -> And make it upper-case, for nicety work_ptr:=sgw.workbuffer work_ptr[sgw.bufferpos-1]:=toupper(sgw.code) ENDIF ENDIF ELSEIF msg[]=SGH_CLICK -> Mouse click -> Zero the digit clicked on IF sgw.bufferpos < sgw.numchars work_ptr:=sgw.workbuffer+sgw.bufferpos work_ptr[]:="0" ENDIF ELSE -> UNKNOWN COMMAND -> Hook should return zero if the command is not supported return_code:=0 ENDIF ENDPROC return_code -> E-Note: we don't need the hookEntry stuff, installhook does it all -> Process messages received by the sgg_Window. Quit when the close gadget -> is selected. -> E-Note: E version is simpler, since we use WaitIMessage PROC handleWindow(vars:PTR TO vars) DEF class REPEAT class:=WaitIMessage(vars.sgg_Window) -> If a code is set in the hook after an SGH_KEY command, where SGA_END is -> set on return from the hook, the code will be returned in the Code field -> of the IDCMP_GADGETUP message. -> E-Note: ...so use MsgCode() to get at it UNTIL class=IDCMP_CLOSEWINDOW ENDPROC ?-lh0-22z)Src\Rkrm\Intuition\Gadgets\updatestrgad.eg_-> updatestrgad.e - Show the use of a string gadget. Shows both the use of -> ActivateGadget() and how to properly modify the contents of a string gadget. MODULE 'graphics/rastport', 'intuition/intuition' ENUM ERR_NONE, ERR_KICK, ERR_WIN RAISE ERR_WIN IF OpenWindowTagList()=NIL -> NOTE that the use of constant size and positioning values are not -> recommended; it just makes it easy to show what is going on. The position -> of the gadget should be dynamically adjusted depending on the height of the -> font in the title bar of the window. This example adapts the gadget height -> to the screen font. Alternatively, you could specify your font under V37 -> with the StringExtend structure. CONST BUFSIZE=100, MYSTRGADWIDTH=200, MYSTRGADHEIGHT=8 DEF strBuffer[BUFSIZE]:STRING, strUndoBuffer[BUFSIZE]:STRING, strGad:PTR TO gadget, ansnum=0, answers:PTR TO LONG -> Show the use of a string gadget. PROC main() HANDLE DEF win=NIL:PTR TO window -> Make sure to get version 37, for OpenWindowTags() IF KickVersion(37)=FALSE THEN Raise(ERR_KICK) -> Load a value into the string gadget buffer. -> This will be displayed when the gadget is first created. StrCopy(strBuffer, 'START') -> E-Note: set-up the two globals... answers:=['Try Again','Sorry','Perhaps','A Winner'] strGad:=[NIL, 20, 20, MYSTRGADWIDTH, MYSTRGADHEIGHT, GFLG_GADGHCOMP, GACT_RELVERIFY OR GACT_STRINGCENTER, GTYP_STRGADGET, [-2, -2, 1, 0, RP_JAM1, 5, [0, 0, MYSTRGADWIDTH + 3, 0, MYSTRGADWIDTH + 3, MYSTRGADHEIGHT + 3, 0, MYSTRGADHEIGHT + 3, 0, 0]:INT, NIL]:border, NIL, NIL, 0, -> E-Note: use NEW so remaining fields are allocated (and set to 0) NEW [strBuffer, strUndoBuffer, 0, BUFSIZE]:stringinfo, 0, NIL]:gadget win:=OpenWindowTagList(NIL, [WA_WIDTH, 400, WA_HEIGHT, 100, WA_TITLE, 'Activate Window, Enter Text', WA_GADGETS, strGad, WA_CLOSEGADGET, TRUE, WA_IDCMP, IDCMP_ACTIVEWINDOW OR IDCMP_CLOSEWINDOW OR IDCMP_GADGETUP, NIL]) handleWindow(win, strGad) -> E-Note: exit and clean up via handler EXCEPT DO IF win THEN CloseWindow(win) -> E-Note: we can print a minimal error message SELECT exception CASE ERR_KICK; WriteF('Error: Needs Kickstart V37+\n') CASE ERR_WIN; WriteF('Error: Failed to open window\n') CASE "MEM"; WriteF('Error: Ran out of memory\n') ENDSELECT ENDPROC -> Process messages received by the window. Quit when the close gadget -> is selected, activate the gadget when the window becomes active. -> E-Note: E version is simpler, since we use WaitIMessage PROC handleWindow(win, gad) DEF class REPEAT class:=WaitIMessage(win) SELECT class CASE IDCMP_ACTIVEWINDOW -> Activate the string gadget. This is how to activate a string gadget -> in a new window--wait for the window to become active by waiting for -> the IDCMP_ACTIVEWINDOW event, then activate the gadget. Here we -> report on the success or failure. IF ActivateGadget(gad, win, NIL) updateStrGad(win, gad, 'Activated') ENDIF CASE IDCMP_GADGETUP -> If it's a gadget message, IAddress points to Gadget. If user hit -> RETURN in our string gadget for demonstration, we will change what he -> entered. We only have 1 gadget, so we don't have to check which one. updateStrGad(win, strGad, answers[ansnum]) INC ansnum -> Point to next answer -> E-Note: we know the lengths of lists, so no need for ANSCNT IF ansnum>=ListLen(answers) THEN ansnum:=0 ENDSELECT UNTIL class=IDCMP_CLOSEWINDOW ENDPROC -> Routine to update the value in the string gadget's buffer, then activate -> the gadget. PROC updateStrGad(win, gad:PTR TO gadget, newstr) -> First, remove the gadget from the window. This must be done before -> modifying any part of the gadget!!! RemoveGList(win, gad, 1) -> For fun, change the value in the buffer, as well as the cursor and initial -> display position. StrCopy(gad.specialinfo::stringinfo.buffer, newstr) gad.specialinfo::stringinfo.bufferpos:=0 gad.specialinfo::stringinfo.disppos:=0 -> Add the gadget back, placing it at the end of the list (-1) and refresh -> its imagery. AddGList(win, gad, -1, 1, NIL) RefreshGList(gad, win, NIL, 1) -> Activate the string gadget ActivateGadget(gad, win, NIL) ENDPROCC-lh0- z-Src\Rkrm\Intuition\Images_Text\compleximage.eK-> compleximage.e - Program to show the use of a complex Intuition Image. OPT OSVERSION=37 -> E-Note: silently require V37 MODULE 'exec/memory', 'intuition/intuition', 'intuition/screens' ENUM ERR_NONE, ERR_SCRN, ERR_WIN RAISE ERR_SCRN IF OpenScreenTagList()=NIL, ERR_WIN IF OpenWindowTagList()=NIL CONST MYIMAGE_LEFT=0, MYIMAGE_TOP=0, MYIMAGE_WIDTH=24, MYIMAGE_HEIGHT=10, MYIMAGE_DEPTH=2 -> E-Note: get some Chip memory and copy list (quick, since LONG aligned) PROC copyListToChip(data) DEF size, mem size:=ListLen(data)*SIZEOF LONG mem:=NewM(size, MEMF_CHIP) CopyMemQuick(data, mem, size) ENDPROC mem -> Main routine. Open required window and draw the images. This routine opens -> a very simple window with no IDCMP. See the chapters on "Windows" and -> "Input and Output Methods" for more info. Free all resources when done. PROC main() HANDLE DEF scr=NIL, win=NIL:PTR TO window, myImage:image scr:=OpenScreenTagList(NIL, [SA_DEPTH, 4, SA_PENS, [-1]:INT, NIL]) win:=OpenWindowTagList(NIL, [WA_RMBTRAP, TRUE, WA_CUSTOMSCREEN, scr, NIL]) -> This contains the image data. It is a two bit-plane open rectangle which -> is 24 pixels wide and 10 high. Make sure it's in CHIP memory by allocating -> a block of chip memory with a call like this: NewM(data_size,MEMF_CHIP), -> and then copy the data to that block. myImage:=[MYIMAGE_LEFT, MYIMAGE_TOP, MYIMAGE_WIDTH, MYIMAGE_HEIGHT, MYIMAGE_DEPTH, copyListToChip([ -> First bit-plane of data, open rectangle $FFFFFF00, $C0000300, $C0000300, $C0000300, $C0000300, $C0000300, $C0000300, $C0000300, $C0000300, $FFFFFF00, -> Second bit-plane of data, filled rectangle $00000000, $00000000, $00000000, $00FF0000, $00FF0000, $00FF0000, $00FF0000, $00000000, $00000000, $00000000]), 3, 0, NIL]:image -> Use first two bit-planes, clear unused planes -> Draw the 1 bit-plane image into the first two bit-planes DrawImage(win.rport, myImage, 10, 10) -> Draw the same image at a new location DrawImage(win.rport, myImage, 100, 10) -> Change the image to use the second and fourth bitplanes, PlanePick is 1010 -> binary or $0A, and draw it again at a different location myImage.planepick:=$0A DrawImage(win.rport, myImage, 10, 50) -> Now set all the bits in the first bitplane with PlaneOnOff. This will -> make all the bits set in the second bitplane appear as color 3 (0011 -> binary), all the bits set in the fourth bitplane appear as color 9 (1001 -> binary) and all other pixels will be color 1 (0001 binary. If there were -> any points in the image where both bits were set, they would appear as -> color 11 (1011 binary). Draw the image at a different location. myImage.planeonoff:=$01 DrawImage(win.rport, myImage, 100, 50) -> Wait a bit, then quit. -> In a real application, this would be an event loop, like the one described -> in the Intuition Input and Output Methods chapter. Delay(200) EXCEPT DO IF win THEN CloseWindow(win) IF scr THEN CloseScreen(scr) SELECT exception CASE ERR_SCRN; WriteF('Error: Failed to open custom screen.\n') CASE ERR_WIN; WriteF('Error: Failed to open window.\n') CASE "MEM"; WriteF('Error: Ran out of (chip) memory.\n') ENDSELECT ENDPROC @-lh0- z*Src\Rkrm\Intuition\Images_Text\intuitext.e-> intuitext.e - Program to show the use of an Intuition IntuiText object. OPT OSVERSION=37 -> E-Note: silently require V37 MODULE 'exec/ports', 'exec/nodes', 'graphics/rastport', 'graphics/text', 'intuition/intuition', 'intuition/screens' ENUM ERR_NONE, ERR_DRAW, ERR_PUB, ERR_WIN RAISE ERR_DRAW IF GetScreenDrawInfo()=NIL, ERR_PUB IF LockPubScreen()=NIL, ERR_WIN IF OpenWindowTagList()=NIL CONST MYTEXT_LEFT=0, MYTEXT_TOP=0 -> Main routine. Open required window and draw the images. This routine opens -> a very simple window with no IDCMP. See the chapters on "Windows" and -> "Input and Output Methods" for more info. Free all resources when done. PROC main() HANDLE DEF screen=NIL, drawinfo=NIL:PTR TO drawinfo, win=NIL:PTR TO window, myTEXTPEN, myBACKGROUNDPEN screen:=LockPubScreen(NIL) drawinfo:=GetScreenDrawInfo(screen) -> Get a copy of the correct pens for the screen. This is very important in -> case the user or the application has the pens set in a unusual way. myTEXTPEN:=drawinfo.pens[TEXTPEN] myBACKGROUNDPEN:=drawinfo.pens[BACKGROUNDPEN] -> Open a simple window on the workbench screen for displaying a text string. -> An application would probably never use such a window, but it is useful -> for demonstrating graphics... win:=OpenWindowTagList(NIL, [WA_PUBSCREEN, screen, WA_RMBTRAP, TRUE, NIL]) -> Draw the text string at 10, 10 PrintIText(win.rport, [myTEXTPEN, myBACKGROUNDPEN, RP_JAM2, MYTEXT_LEFT, MYTEXT_TOP, [drawinfo.font.mn.ln.name, drawinfo.font.ysize, drawinfo.font.style, drawinfo.font.flags]:textattr, 'Hello, World. ;-)', NIL]:intuitext, 10, 10) -> Wait a bit, then quit. -> In a real application, this would be an event loop, like the one described -> in the Intuition Input and Output Methods chapter. Delay(200) EXCEPT DO IF win THEN CloseWindow(win) IF drawinfo THEN FreeScreenDrawInfo(screen, drawinfo) IF screen THEN UnlockPubScreen(NIL, screen) SELECT exception CASE ERR_DRAW; WriteF('Error: Failed to get DrawInfo for screen\n') CASE ERR_PUB; WriteF('Error: Failed to lock public screen\n') CASE ERR_WIN; WriteF('Error: Failed to open window\n') ENDSELECT ENDPROC C-lh0- z-Src\Rkrm\Intuition\Images_Text\shadowborder.e#*-> shadowborder.e - Program to show the use of an Intuition Border. OPT OSVERSION=37 -> E-Note: silently require V37 MODULE 'graphics/rastport', 'intuition/intuition', 'intuition/screens' ENUM ERR_NONE, ERR_DRAW, ERR_PUB, ERR_WIN RAISE ERR_DRAW IF GetScreenDrawInfo()=NIL, ERR_PUB IF LockPubScreen()=NIL, ERR_WIN IF OpenWindowTagList()=NIL CONST MYBORDER_LEFT=0, MYBORDER_TOP=0 -> Main routine. Open required window and draw the images. This routine opens -> a very simple window with no IDCMP. See the chapters on "Windows" and -> "Input and Output Methods" for more info. Free all resources when done. PROC main() HANDLE DEF screen=NIL, win=NIL:PTR TO window, drawinfo=NIL:PTR TO drawinfo, shineBorder, shadowBorder, mySHADOWPEN=1, mySHINEPEN=2 -> E-Note: C version doesn't think these should cause fatal errors... screen:=LockPubScreen(NIL) drawinfo:=GetScreenDrawInfo(screen) -> Get a copy of the correct pens for the screen. This is very important in -> case the user or the application has the pens set in a unusual way. mySHADOWPEN:=drawinfo.pens[SHADOWPEN] mySHINEPEN:=drawinfo.pens[SHINEPEN] -> Open a simple window on the workbench screen for displaying a border. An -> application would probably never use such a window, but it is useful for -> demonstrating graphics... -> E-Note: C version uses "screen" after unlocking it! win:=OpenWindowTagList(NIL, [WA_PUBSCREEN, screen, WA_RMBTRAP, TRUE, NIL]) shineBorder:=[MYBORDER_LEFT, MYBORDER_TOP, mySHINEPEN, 0, RP_JAM1, 5, [0,0, 50,0, 50,30, 0,30, 0,0]:INT, NIL]:border shadowBorder:=[MYBORDER_LEFT+1, MYBORDER_TOP+1, mySHADOWPEN, 0, RP_JAM1, 5, [0,0, 50,0, 50,30, 0,30, 0,0]:INT, shineBorder]:border -> Draw the border at 10, 10 DrawBorder(win.rport, shadowBorder, 10, 10) -> Draw the border again at 100, 10 DrawBorder(win.rport, shadowBorder, 100, 10) -> Wait a bit, then quit. -> In a real application, this would be an event loop, like the one described -> in the Intuition Input and Output Methods chapter. Delay(200) EXCEPT DO IF win THEN CloseWindow(win) IF drawinfo THEN FreeScreenDrawInfo(screen, drawinfo) IF screen THEN UnlockPubScreen(NIL, screen) SELECT exception CASE ERR_DRAW; WriteF('Error: Failed to get DrawInfo for screen\n') CASE ERR_PUB; WriteF('Error: Failed to lock public screen\n') CASE ERR_WIN; WriteF('Error: Failed to open window\n') ENDSELECT ENDPROCB -lh0-z,Src\Rkrm\Intuition\Images_Text\simpleimage.e>-> simpleimage.e - Program to show the use of a simple Intuition Image. OPT OSVERSION=37 -> E-Note: silently require V37 MODULE 'exec/memory', 'intuition/intuition' ENUM ERR_NONE, ERR_WIN RAISE ERR_WIN IF OpenWindowTagList()=NIL CONST MYIMAGE_LEFT=0, MYIMAGE_TOP=0, MYIMAGE_WIDTH=24, MYIMAGE_HEIGHT=10, MYIMAGE_DEPTH=1 -> E-Note: get some Chip memory and copy list (quick, since LONG aligned) PROC copyListToChip(data) DEF size, mem size:=ListLen(data)*SIZEOF LONG mem:=NewM(size, MEMF_CHIP) CopyMemQuick(data, mem, size) ENDPROC mem -> Main routine. Open required window and draw the images. This routine opens -> a very simple window with no IDCMP. See the chapters on "Windows" and -> "Input and Output Methods" for more info. Free all resources when done. PROC main() HANDLE DEF win=NIL:PTR TO window, myImage:image win:=OpenWindowTagList(NIL, [WA_WIDTH, 200, WA_HEIGHT, 100, WA_RMBTRAP, TRUE, NIL]) -> This contains the image data. It is a one bit-plane open rectangle which -> is 24 pixels wide and 10 high. Make sure it's in CHIP memory by allocating -> a block of chip memory with a call like this: NewM(data_size,MEMF_CHIP), -> and then copy the data to that block. myImage:=[MYIMAGE_LEFT, MYIMAGE_TOP, MYIMAGE_WIDTH, MYIMAGE_HEIGHT, MYIMAGE_DEPTH, copyListToChip([$FFFFFF00, $C0000300, $C0000300, $C0000300, $C0000300, $C0000300, $C0000300, $C0000300, $C0000300, $FFFFFF00]), 1, 0, NIL]:image -> Use first bit-plane, clear unused planes -> Draw the 1 bit-plane image into the first bit-plane (colour 1) DrawImage(win.rport, myImage, 10, 10) -> Draw the same image at a new location DrawImage(win.rport, myImage, 100, 10) -> Wait a bit, then quit. -> In a real application, this would be an event loop, like the one described -> in the Intuition Input and Output Methods chapter. Delay(200) EXCEPT DO IF win THEN CloseWindow(win) SELECT exception CASE ERR_WIN; WriteF('Error: Failed to open window.\n') CASE "MEM"; WriteF('Error: Ran out of (chip) memory.\n') ENDSELECT ENDPROC F-lh0-#z0Src\Rkrm\Intuition\Intuition_GUI\easyintuition.e9-> easyintuition.e Simple backward-compatible V37 Intuition example -> -> This example uses extended structures with the pre-V37 OpenScreen() and -> OpenWindow() functions to compatibly open an Intuition display. Enhanced -> V37 options specified via tags are ignored on 1.3 systems. -> E-Note: you need to be more specific about modules than C does about includes MODULE 'intuition/intuition', -> Intuition and window data structures and tags 'intuition/screens', -> Screen data structures and tags 'graphics/view', -> Screen resolutions 'dos/dos' -> Official return codes defined here -> Position and sizes for our window CONST WIN_LEFTEDGE=20, WIN_TOPEDGE=20, WIN_WIDTH=400, WIN_MINWIDTH=80, WIN_HEIGHT=150, WIN_MINHEIGHT=20 -> Exception values -> E-Note: exceptions are a much better way of handling errors ENUM ERR_NONE, ERR_SCRN, ERR_WIN -> Automatically raise exceptions -> E-Note: these take care of a lot of error cases RAISE ERR_SCRN IF OpenS()=NIL, ERR_WIN IF OpenW()=NIL PROC main() HANDLE -> Declare variables here -> E-Note: the signals stuff is handled directly by WaitIMessage DEF screen1=NIL:PTR TO screen, window1=NIL:PTR TO window -> E-Note: E automatically opens the Intuition library -> Open the screen -> E-Note: automatically error-checked (automatic exception) -> E-Note: simplified using OpenS screen1:=OpenS(640, -> Width (high-resolution) STDSCREENHEIGHT, -> Height (non-interlace) 2, -> Depth (4 colours will be available) V_HIRES, -> The high-resolution display mode 'Our Screen', -> The screen title -> We can specify that we want the V37-compatible 3D look when running under -> V37 by adding an SA_PENS tag. [SA_PENS, [-1]:INT, -> Tags for additional V37 features -> E-Note: these tags replace the missing OpenS parameters SA_DETAILPEN, 0, SA_BLOCKPEN, 1, NIL]) -> E-Note: we attach the window to the open screen directly, below -> ... and open the window -> E-Note: automatically error-checked (automatic exception) window1:=OpenW(WIN_LEFTEDGE, WIN_TOPEDGE, WIN_WIDTH, WIN_HEIGHT, -> This field specifies the events we want to get IDCMP_CLOSEWINDOW, -> These flags specify system gadgets and other attributes WFLG_CLOSEGADGET OR WFLG_SMART_REFRESH OR WFLG_ACTIVATE OR WFLG_DRAGBAR OR WFLG_DEPTHGADGET OR WFLG_SIZEGADGET OR WFLG_NOCAREREFRESH, 'EasyWindow', -> Window title screen1, -> Attach to screen1... CUSTOMSCREEN, -> ... a custom screen NIL, -> Pointer to first gadget -> Under V37, we'll get a special screen title when our window is active -> Tags for additional V37 features [WA_SCREENTITLE, 'Our Screen - EasyWindow is Active', -> E-Note: these tags replace the missing OpenW parameters WA_MINWIDTH, WIN_MINWIDTH, WA_MINHEIGHT, WIN_MINHEIGHT, WA_MAXWIDTH, -1, WA_MAXHEIGHT, -1, NIL]) -> Here's the main input event loop -> E-Note: the signals and stuff is handled by WaitIMessage REPEAT UNTIL handleIDCMP(window1) -> E-Note: exit and clean up via handler EXCEPT DO IF window1 THEN CloseW(window1) IF screen1 THEN CloseS(screen1) -> E-Note: we can print a minimal error message SELECT exception CASE ERR_SCRN; WriteF('Error: Failed to open custom screen\n') CASE ERR_WIN; WriteF('Error: Failed to open window\n') ENDSELECT -> E-Note: select return code according to exception ENDPROC IF exception THEN RETURN_WARN ELSE RETURN_OK PROC handleIDCMP(win:PTR TO window) DEF class, done=FALSE -> E-Note: WaitIMessage replaces a lot of C code concerned with signals class:=WaitIMessage(win) -> E-Note: other parts of the message are available via MsgXXX() functions -> See what events occurred SELECT class CASE IDCMP_CLOSEWINDOW done:=TRUE ENDSELECT ENDPROC done H6-lh0-+z2Src\Rkrm\Intuition\Intuition_GUI\easyintuition37.eI-> easyintuition37.e -- Simple Intuition program for V37 (Release 2) and later -> versions of the operating system -> Use lowest non-obsolete version that supplies the functions needed OPT OSVERSION=37 -> E-Note: you need to be more specific about modules than C does about includes MODULE 'intuition/intuition', -> Intuition and window data structures and tags 'intuition/screens', -> Screen data structures and tags 'graphics/modeid', -> Release 2 Amiga display mode ID's 'dos/dos' -> Official return codes defined here -> Position and sizes for our window CONST WIN_LEFTEDGE=20, WIN_TOPEDGE=20, WIN_WIDTH=400, WIN_MINWIDTH=80, WIN_HEIGHT=150, WIN_MINHEIGHT=20 -> Exception values -> E-Note: exceptions are a much better way of handling errors ENUM ERR_NONE, ERR_SCRN, ERR_WIN -> Automatically raise exceptions -> E-Note: these take care of a lot of error cases RAISE ERR_SCRN IF OpenScreenTagList()=NIL, ERR_WIN IF OpenWindowTagList()=NIL PROC main() HANDLE -> Declare variables here -> E-Note: the signals stuff is handled directly by WaitIMessage DEF screen1=NIL:PTR TO screen, window1=NIL:PTR TO window -> E-Note: E automatically opens the Intuition library -> Open the screen -> E-Note: automatically error-checked (automatic exception) -> E-Note: pens is just a INT-typed list screen1:=OpenScreenTagList(NIL, [SA_PENS, [-1]:INT, SA_DISPLAYID, HIRES_KEY, SA_DEPTH, 2, SA_TITLE, 'Our Screen', NIL]) -> ... and open the window -> E-Note: automatically error-checked (automatic exception) window1:=OpenWindowTagList(NIL, -> Specify window dimensions and limits [WA_LEFT, WIN_LEFTEDGE, WA_TOP, WIN_TOPEDGE, WA_WIDTH, WIN_WIDTH, WA_HEIGHT, WIN_HEIGHT, WA_MINWIDTH, WIN_MINWIDTH, WA_MINHEIGHT, WIN_MINHEIGHT, WA_MAXWIDTH, -1, WA_MAXHEIGHT, -1, -> Specify the system gadgets we want WA_CLOSEGADGET, TRUE, WA_SIZEGADGET, TRUE, WA_DEPTHGADGET, TRUE, WA_DRAGBAR, TRUE, -> Specify other attributes WA_ACTIVATE, TRUE, WA_NOCAREREFRESH, TRUE, -> Specify the events we want to know about WA_IDCMP, IDCMP_CLOSEWINDOW, -> Attach the window to the open screen ... WA_CUSTOMSCREEN, screen1, WA_TITLE, 'EasyWindow', WA_SCREENTITLE,'Our Screen - EasyWindow is Active', NIL]) -> Here's the main input event loop -> E-Note: the signals and stuff is handled by WaitIMessage REPEAT UNTIL handleIDCMP(window1) -> E-Note: exit and clean up via handler EXCEPT DO IF window1 THEN CloseWindow(window1) IF screen1 THEN CloseScreen(screen1) -> E-Note: we can print a minimal error message SELECT exception CASE ERR_SCRN; WriteF('Error: Failed to open custom screen\n') CASE ERR_WIN; WriteF('Error: Failed to open window\n') ENDSELECT -> E-Note: select return code according to exception ENDPROC IF exception THEN RETURN_WARN ELSE RETURN_OK PROC handleIDCMP(win:PTR TO window) DEF class, done=FALSE -> E-Note: WaitIMessage replaces a lot of C code concerned with signals class:=WaitIMessage(win) -> E-Note: other parts of the message are available via MsgXXX() functions -> See what events occurred SELECT class CASE IDCMP_CLOSEWINDOW done:=TRUE ENDSELECT ENDPROC done G-lh0-kk+h1Src\Rkrm\Intuition\IO_Methods\closewindowsafely.ee-> closeWindowSafely -> -> These functions close an Intuition window that shares a port with other -> Intuition windows. -> -> We are careful to set the UserPort to NIL before closing, and to free any -> messages that it might have been sent. OPT MODULE -> E-Note: create a module for re-use MODULE 'exec/lists', 'exec/nodes', 'exec/ports', 'intuition/intuition' -> Function to remove and reply all IntuiMessages on a port that have been -> sent to a particular window (note that we don't rely on the succ pointer -> of a message after we have replied it) PROC stripIntuiMessages(mp:PTR TO mp, win) DEF msg:PTR TO intuimessage, succ msg:=mp.msglist.head WHILE succ:=msg.execmessage.ln.succ IF msg.idcmpwindow=win -> Intuition is about to free this message. -> Make sure that we have politely sent it back. Remove(msg) ReplyMsg(msg) ENDIF msg:=succ ENDWHILE ENDPROC -> Entry point to closeWindowSafely(). -> Strip all IntuiMessages from an IDCMP which are waiting for a specific -> window. When the messages are gone, set the UserPort of the window to NIL -> and call ModifyIDCMP(win,0). This will free the Intuition parts of the IDCMP -> and turn off messages to this port without changing the original UserPort -> (which may be in use by other windows). -> E-Note: this is the function we want to export from the module EXPORT PROC closeWindowSafely(win:PTR TO window) -> We forbid here to keep out of race conditions with Intuition Forbid() -> Send back any messages for this window that have not yet been processed stripIntuiMessages(win.userport, win) -> Clear UserPort so Intuition will not free it win.userport:=NIL -> Tell Intuition to stop sending more messages ModifyIDCMP(win, 0) -> Turn multitasking back on Permit() -> Now it's safe to really close the window CloseWindow(win) ENDPROC G-lh0-j1Src\Rkrm\Intuition\IO_Methods\closewindowsafely.muEMOD -NU m A +@ mAA +@Jg4 m (,f"m,lN"m,lN+m`pN]NuNU,lN| m (V//-aOp m!@V mp,lNj,lNv m,lNpN]NucloseWindowSafely^win?'-lh0-z)Src\Rkrm\Intuition\IO_Methods\eventloop.e6-> eventloop.e - standard technique to handle IntuiMessages from an IDCMP. MODULE 'exec/ports', 'intuition/intuition' ENUM ERR_NONE, ERR_WIN RAISE ERR_WIN IF OpenWindowTagList()=NIL PROC main() HANDLE DEF signals, done, win=NIL:PTR TO window win:=OpenWindowTagList(NIL, [WA_TITLE, 'Press Keys and Mouse in this Window', WA_WIDTH, 500, WA_HEIGHT, 50, WA_ACTIVATE, TRUE, WA_CLOSEGADGET, TRUE, WA_RMBTRAP, TRUE, WA_IDCMP, IDCMP_CLOSEWINDOW OR IDCMP_VANILLAKEY OR IDCMP_RAWKEY OR IDCMP_DISKINSERTED OR IDCMP_DISKREMOVED OR IDCMP_MOUSEBUTTONS, NIL]) -> Perform this loop until the message handling routine signals that we -> are done. -> -> When the Wait() returns, check which signal hit and process the correct -> port. There is only one port here, so the test could be eliminated. If -> multiple ports were being watched, the test would become: -> -> signals:=Wait(Shl(1, win1.userport.sigbit) OR -> Shl(1, win2.userport.sigbit) OR -> Shl(1, win3.userport.sigbit)) -> IF signals AND Shl(1, win1.userport.sigbit) -> done:=handleWin1IDCMP(win1, done) -> ELSEIF signals AND Shl(1, win2.userport.sigbit) -> done:=handleWin2IDCMP(win2, done) -> ELSEIF signals AND Shl(1, win3.userport.sigbit) -> done:=handleWin3IDCMP(win3, done) -> ENDIF -> -> Note that these could all call the same routine with different window -> pointers (if the handling was identical). -> -> handleIDCMP() should remove all of the messages from the port. -> E-Note: since this example should be generalisable to more than one -> window, WaitIMessage is not used (for a change!) done:=FALSE REPEAT signals:=Wait(Shl(1, win.userport.sigbit)) IF signals AND Shl(1, win.userport.sigbit) done:=handleIDCMP(win, done) ENDIF UNTIL done EXCEPT DO IF win THEN CloseWindow(win) SELECT exception CASE ERR_WIN; WriteF('Error: Failed to open window.\n') ENDSELECT ENDPROC -> handleIDCMP() - Handle all of the messages from an IDCMP. PROC handleIDCMP(win:PTR TO window, done) DEF message:PTR TO intuimessage, code, mousex, mousey, class -> Remove all of the messages from the port by calling GetMsg() until -> it returns NULL. -> -> The code should be able to handle three cases: -> -> 1. No messages waiting at the port, and the first call to GetMsg() -> returns NULL. In this case the code should do nothing. -> -> 2. A single message waiting. The code should remove the message, -> processes it, and finish. -> -> 3. Multiple messages waiting. The code should process each waiting -> message, and finish. WHILE message:=GetMsg(win.userport) -> It is often convenient to copy the data out of the message. In many -> cases, this lets the application reply to the message quickly. Copying -> the data is not required, if the code does not reply to the message -> until the end of the loop, then it may directly reference the message -> information anywhere before the reply. class:=message.class code:=message.code mousex:=message.mousex mousey:=message.mousey -> The loop should reply as soon as possible. Note that the code may not -> reference data in the message after replying to the message. Thus, the -> application should not reply to the message until it is done referencing -> information in it. -> -> Be sure to reply to every message received with GetMsg(). ReplyMsg(message) -> The class contains the IDCMP type of the message. SELECT class CASE IDCMP_CLOSEWINDOW done:=TRUE CASE IDCMP_VANILLAKEY WriteF('IDCMP_VANILLAKEY (\c)\n', code) CASE IDCMP_RAWKEY WriteF('IDCMP_RAWKEY\n') CASE IDCMP_DISKINSERTED WriteF('IDCMP_DISKINSERTED\n') CASE IDCMP_DISKREMOVED WriteF('IDCMP_DISKREMOVED\n') CASE IDCMP_MOUSEBUTTONS -> The code often contains useful data, such as the ASCII value (for -> IDCMP_VANILLAKEY), or the type of button event here. SELECT code CASE SELECTUP WriteF('SELECTUP at \d,\d\n', mousex, mousey) CASE SELECTDOWN WriteF('SELECTDOWN at \d,\d\n', mousex, mousey) CASE MENUUP WriteF('MENUUP\n') CASE MENUDOWN WriteF('MENUDOWN\n') DEFAULT WriteF('UNKNOWN CODE\n') ENDSELECT DEFAULT WriteF('Unknown IDCMP message\n') ENDSELECT ENDWHILE ENDPROC done ;-lh0-wDwDBz%Src\Rkrm\Intuition\Menus\menulayout.e-> menulayout.e - Example showing how to do menu layout in general. This -> example also illustrates handling menu events, including IDCMP_MENUHELP -> events. -> -> Note that handling arbitrary fonts is fairly complex. Applications that -> require V37 should use the simpler menu layout routines found in the -> GadTools library. OPT PREPROCESS MODULE 'dos/dos', 'graphics/rastport', 'graphics/text', 'intuition/intuition', 'intuition/screens' ENUM ERR_NONE, ERR_DRAW, ERR_FONT, ERR_KICK, ERR_MENU, ERR_PUB, ERR_WIN RAISE ERR_DRAW IF GetScreenDrawInfo()=NIL, ERR_FONT IF OpenFont()=NIL, ERR_MENU IF SetMenuStrip()=FALSE, ERR_PUB IF LockPubScreen()=NIL, ERR_WIN IF OpenWindowTagList()=NIL DEF firstMenu -> Open all of the required libraries. Note that we require V37, as the -> routine uses OpenWindowTags(). PROC main() HANDLE IF KickVersion(37)=FALSE THEN Raise(ERR_KICK) doWindow() EXCEPT DO -> E-Note: we can print a minimal error message SELECT exception CASE ERR_DRAW; WriteF('Error: Failed to get screen DrawInfo\n') CASE ERR_KICK; WriteF('Error: Needs Kickstart V37+\n') CASE ERR_MENU; WriteF('Error: Failed to attach menu\n') CASE ERR_PUB; WriteF('Error: Failed to lock public screen\n') CASE ERR_WIN; WriteF('Error: Failed to open window\n') ENDSELECT RETURN IF exception=ERR_NONE THEN RETURN_FAIL ELSE RETURN_OK ENDPROC -> Open a window with some properly positioned text. Layout and set the menus, -> then process any events received. Cleanup when done. PROC doWindow() HANDLE -> E-Note: some of these are global arrays in the C version DEF settItem, editItem, prtItem, projItem, menus, winText0:PTR TO intuitext, winText1:PTR TO intuitext, window=NIL:PTR TO window, screen=NIL:PTR TO screen, drawinfo=NIL:PTR TO drawinfo, win_width, alt_width, win_height screen:=LockPubScreen(NIL) drawinfo:=GetScreenDrawInfo(screen) -> Window Text for Explanation of Program -> Get the colors for the window text -> Use the screen's font for the text -> E-Note: link directly without an array winText0:=[drawinfo.pens[TEXTPEN], drawinfo.pens[BACKGROUNDPEN], RP_JAM2, 0, 0, screen.font, 'How to do a Menu', NIL]:intuitext winText1:=[drawinfo.pens[TEXTPEN], drawinfo.pens[BACKGROUNDPEN], RP_JAM2, 0, 0, screen.font, '(with Style)', winText0]:intuitext -> Calculate window size win_width:=100+IntuiTextLength(winText0) alt_width:=100+IntuiTextLength(winText1) IF win_width Calculate the correct positions for the text in the window winText0.leftedge:=Shr(win_width-IntuiTextLength(winText0), 1) winText0.topedge:=1+screen.wbortop+(2*screen.font.ysize) winText1.leftedge:=Shr(win_width-IntuiTextLength(winText1), 1) winText1.topedge:=winText0.topedge+screen.font.ysize -> Open the window window:=OpenWindowTagList(NIL, [WA_PUBSCREEN, screen, WA_IDCMP, IDCMP_MENUPICK OR IDCMP_CLOSEWINDOW OR IDCMP_MENUHELP, WA_FLAGS, WFLG_DRAGBAR OR WFLG_DEPTHGADGET OR WFLG_CLOSEGADGET OR WFLG_ACTIVATE OR WFLG_NOCAREREFRESH, WA_LEFT, 10, WA_TOP, screen.barheight+1, WA_WIDTH, win_width, WA_HEIGHT, win_height, WA_TITLE, 'Menu Example', WA_MENUHELP, TRUE, NIL]) -> Give a brief explanation of the program PrintIText(window.rport, winText1, 0, 0) -> E-Note: define the menus using (local) typed lists rather than arrays -> E-Note: link menu items in reverse order to layout -> Settings Items -> 'Eat It Too' (excludes 'Have Your Cake') settItem:=[NIL, 0, 0, 0, 0, ITEMTEXT OR ITEMENABLED OR HIGHCOMP OR CHECKIT, 4, [0, 1, RP_JAM2, CHECKWIDTH, 1, NIL, ' Eat It Too', NIL]:intuitext, NIL, NIL, NIL, MENUNULL]:menuitem -> 'Have Your Cake' (initially selected, excludes 'Eat It Too') settItem:=[settItem, 0, 0, 0, 0, ITEMTEXT OR ITEMENABLED OR HIGHCOMP OR CHECKIT OR CHECKED, 8, [0, 1, RP_JAM2, CHECKWIDTH, 1, NIL, ' Have Your Cake', NIL]:intuitext, NIL, NIL, NIL, MENUNULL]:menuitem -> 'Auto Save' (toggle-select, initially selected) settItem:=[settItem, 0, 0, 0, 0, ITEMTEXT OR ITEMENABLED OR HIGHCOMP OR CHECKIT OR MENUTOGGLE OR CHECKED, 0, [0, 1, RP_JAM2, CHECKWIDTH, 1, NIL, ' Auto Save', NIL]:intuitext, NIL, NIL, NIL, MENUNULL]:menuitem -> 'Sound...' settItem:=[settItem, 0, 0, 0, 0, ITEMTEXT OR ITEMENABLED OR HIGHCOMP, 0, [0, 1, RP_JAM2, 2, 1, NIL, 'Sound...', NIL]:intuitext, NIL, NIL, NIL, MENUNULL]:menuitem -> Edit Menu Items -> 'Undo' (key-equivalent: "Z") editItem:=[NIL, 0, 0, 0, 0, ITEMTEXT OR COMMSEQ OR ITEMENABLED OR HIGHCOMP, 0, [0, 1, RP_JAM2, 2, 1, NIL, 'Undo', NIL]:intuitext, NIL, "Z", NIL, MENUNULL]:menuitem -> 'Erase' (disabled) editItem:=[editItem, 0, 0, 0, 0, ITEMTEXT OR HIGHCOMP, 0, [0, 1, RP_JAM2, 2, 1, NIL, 'Erase', NIL]:intuitext, NIL, NIL, NIL, MENUNULL]:menuitem -> 'Paste' (key-equivalent: "V") editItem:=[editItem, 0, 0, 0, 0, ITEMTEXT OR COMMSEQ OR ITEMENABLED OR HIGHCOMP, 0, [0, 1, RP_JAM2, 2, 1, NIL, 'Paste', NIL]:intuitext, NIL, "V", NIL, MENUNULL]:menuitem -> 'Copy' (key-equivalent: "C") editItem:=[editItem, 0, 0, 0, 0, ITEMTEXT OR COMMSEQ OR ITEMENABLED OR HIGHCOMP, 0, [0, 1, RP_JAM2, 2, 1, NIL, 'Copy', NIL]:intuitext, NIL, "C", NIL, MENUNULL]:menuitem -> 'Cut' (key-equivalent: "X") editItem:=[editItem, 0, 0, 0, 0, ITEMTEXT OR COMMSEQ OR ITEMENABLED OR HIGHCOMP, 0, [0, 1, RP_JAM2, 2, 1, NIL, 'Cut', NIL]:intuitext, NIL, "X", NIL, MENUNULL]:menuitem -> Print Sub-Items -> 'Draft' prtItem:=[NIL, 0, 0, 0, 0, ITEMTEXT OR ITEMENABLED OR HIGHCOMP, 0, [0, 1, RP_JAM2, 2, 1, NIL, 'Draft', NIL]:intuitext, NIL, NIL, NIL, MENUNULL]:menuitem -> 'NLQ' prtItem:=[prtItem, 0, 0, 0, 0, ITEMTEXT OR ITEMENABLED OR HIGHCOMP, 0, [0, 1, RP_JAM2, 2, 1, NIL, 'NLQ', NIL]:intuitext, NIL, NIL, NIL, MENUNULL]:menuitem -> Uses the >> character to indicate a sub-menu item. -> This is \273 Octal, 0xBB Hex or Alt-0 from the Keyboard. -> -> NOTE that standard menus place this character at the right margin of the -> menu box. This may be done by using a second IntuiText structure for the -> single character, linking this IntuiText to the first one, and positioning -> the IntuiText so that the character appears at the right margin. -> GadTools library will provide the correct behavior. -> Project Menu Items -> 'Quit' (key-equivalent: "Q") projItem:=[NIL, 0, 0, 0, 0, ITEMTEXT OR COMMSEQ OR ITEMENABLED OR HIGHCOMP, 0, [0, 1, RP_JAM2, 2, 1, NIL, 'Quit', NIL]:intuitext, NIL, "Q", NIL, MENUNULL]:menuitem -> 'About...' projItem:=[projItem, 0, 0, 0, 0, ITEMTEXT OR ITEMENABLED OR HIGHCOMP, 0, [0, 1, RP_JAM2, 2, 1, NIL, 'About...', NIL]:intuitext, NIL, NIL, NIL, MENUNULL]:menuitem -> 'Print' (has sub-menu) projItem:=[projItem, 0, 0, 0, 0, ITEMTEXT OR ITEMENABLED OR HIGHCOMP, 0, [0, 1, RP_JAM2, 2, 1, NIL, 'Print ', NIL]:intuitext, NIL, NIL, prtItem, MENUNULL]:menuitem -> 'Save As...' (key-equivalent: "A") projItem:=[projItem, 0, 0, 0, 0, ITEMTEXT OR COMMSEQ OR ITEMENABLED OR HIGHCOMP, 0, [0, 1, RP_JAM2, 2, 1, NIL, 'Save As...', NIL]:intuitext, NIL, "A", NIL, MENUNULL]:menuitem -> 'Save' (key-equivalent: "S") projItem:=[projItem, 0, 0, 0, 0, ITEMTEXT OR COMMSEQ OR ITEMENABLED OR HIGHCOMP, 0, [0, 1, RP_JAM2, 2, 1, NIL, 'Save', NIL]:intuitext, NIL, "S", NIL, MENUNULL]:menuitem -> 'Open...' (key-equivalent: "O") projItem:=[projItem, 0, 0, 0, 0, ITEMTEXT OR COMMSEQ OR ITEMENABLED OR HIGHCOMP, 0, [0, 1, RP_JAM2, 2, 1, NIL, 'Open...', NIL]:intuitext, NIL, "O", NIL, MENUNULL]:menuitem -> 'New' (key-equivalent: "N") projItem:=[projItem, 0, 0, 0, 0, ITEMTEXT OR COMMSEQ OR ITEMENABLED OR HIGHCOMP, 0, [0, 1, RP_JAM2, 2, 1, NIL, 'New', NIL]:intuitext, NIL, "N", NIL, MENUNULL]:menuitem -> Menu Titles -> E-Note: link in reverse order to layout -> E-Note: use NEW to zero trailing fields menus:=NEW [NIL, 120, 0, 88, 0, MENUENABLED, 'Settings', settItem]:menu menus:=NEW [menus, 70, 0, 39, 0, MENUENABLED, 'Edit', editItem]:menu menus:=NEW [menus, 0, 0, 63, 0, MENUENABLED, 'Project', projItem]:menu -> A pointer to the first menu for easy reference firstMenu:=menus -> Adjust the menu to conform to the font (TextAttr) adjustMenus(menus, window.wscreen.font) -> Attach the menu to the window SetMenuStrip(window, menus) REPEAT UNTIL handleIDCMP(window) -> Clean up everything used here ClearMenuStrip(window) -> E-Note: exit and clean up via handler EXCEPT DO IF window THEN CloseWindow(window) IF drawinfo THEN FreeScreenDrawInfo(screen, drawinfo) IF screen THEN UnlockPubScreen(NIL, screen) -> E-Note: pass on error, or else RETURN_OK if no error ReThrow() ENDPROC RETURN_OK -> Print out what menu was selected. Properly handle the IDCMP_MENUHELP -> events. Set done to TRUE if quit is selected. PROC processMenus(selection, done) DEF menuNum, itemNum, subNum, item:PTR TO menuitem menuNum:=MENUNUM(selection) itemNum:=ITEMNUM(selection) subNum:=SUBNUM(selection) -> When processing IDCMP_MENUHELP, you are not guaranteed to get a menu item. IF itemNum<>NOITEM item:=ItemAddress(firstMenu, selection) IF item.flags AND CHECKED THEN WriteF('(Checked) ') ENDIF SELECT menuNum CASE 0 -> Project Menu SELECT itemNum CASE NOITEM; WriteF('Project Menu\n') CASE 0; WriteF('New\n') CASE 1; WriteF('Open\n') CASE 2; WriteF('Save\n') CASE 3; WriteF('Save As\n') CASE 4; WriteF('Print ') SELECT subNum CASE NOSUB; WriteF('Item\n') CASE 0; WriteF('NLQ\n') CASE 1; WriteF('Draft\n') ENDSELECT CASE 5; WriteF('About\n') CASE 6; WriteF('Quit\n'); done:=TRUE ENDSELECT CASE 1 -> Edit Menu SELECT itemNum CASE NOITEM; WriteF('Edit Menu\n') CASE 0; WriteF('Cut\n') CASE 1; WriteF('Copy\n') CASE 2; WriteF('Paste\n') CASE 3; WriteF('Erase\n') CASE 4; WriteF('Undo\n') ENDSELECT CASE 2 -> Settings Menu SELECT itemNum CASE NOITEM; WriteF('Settings Menu\n') CASE 0; WriteF('Sound\n') CASE 1; WriteF('Auto Save\n') CASE 2; WriteF('Have Your Cake\n') CASE 3; WriteF('Eat It Too\n') ENDSELECT CASE NOMENU -> No menu selected, can happen with IDCMP_MENUHELP WriteF('no menu\n') ENDSELECT ENDPROC done -> E-Note: used to convert an INT to unsigned #define UNSIGNED(x) ((x) AND $FFFF) -> Handle the IDCMP messages. Set done to TRUE if quit or closewindow is -> selected. PROC handleIDCMP(win) DEF done=FALSE, selection, class, item:PTR TO menuitem class:=WaitIMessage(win) SELECT class CASE IDCMP_CLOSEWINDOW done:=TRUE CASE IDCMP_MENUHELP -> The routine that handles the menus for IDCMP_MENUHELP must be very -> careful it can receive menu information that is impossible under -> IDCMP_MENUPICK. For instance, the code value on a IDCMP_MENUHELP may -> have a valid number for the menu, then NOITEM and NOSUB. IDCMP_MENUPICK -> would get MENUNULL in this case. IDCMP_MENUHELP never come as -> multi-select items, and the event terminates the menu processing session. -> -> Note that the return value from the processMenus() routine is ignored: -> the application should not quit if the user selects "help" over the quit -> menu item. WriteF('IDCMP_MENUHELP: Help on ') processMenus(MsgCode(), done) CASE IDCMP_MENUPICK -> E-Note: convert message code to an unsigned INT selection:=UNSIGNED(MsgCode()) WHILE selection<>MENUNULL WriteF('IDCMP_MENUPICK: Selected ') done:=processMenus(selection, done) item:=ItemAddress(firstMenu, selection) -> E-Note: convert item.nextselect to an unsigned INT selection:=UNSIGNED(item.nextselect) ENDWHILE ENDSELECT ENDPROC done -> Steps through each item to determine the maximum width of the strip PROC maxLength(textRPort, first_item, char_size) DEF maxLength, total_textlen, cur_item:PTR TO menuitem, itext:PTR TO intuitext, extra_width, maxCommCharWidth, commCharWidth extra_width:=char_size -> Used as padding for each item -> Find the maximum length of a command character, if any. -> If found, it will be added to the extra_width field. maxCommCharWidth:=0 cur_item:=first_item WHILE cur_item IF cur_item.flags AND COMMSEQ -> E-Note: requires address of the command character commCharWidth:=TextLength(textRPort, [cur_item.command]:CHAR, 1) IF commCharWidth>maxCommCharWidth THEN maxCommCharWidth:=commCharWidth ENDIF cur_item:=cur_item.nextitem ENDWHILE -> If we found a command sequence, add it to the extra required space. Add -> space for the Amiga key glyph plus space for the command character. Note -> this only works for HIRES screens, for LORES, use LOWCOMMWIDTH. IF maxCommCharWidth>0 THEN extra_width:=extra_width+maxCommCharWidth+COMMWIDTH -> Find the maximum length of the menu items, given the extra width -> calculated above. maxLength:=0 cur_item:=first_item WHILE cur_item itext:=cur_item.itemfill total_textlen:=extra_width+itext.leftedge+ TextLength(textRPort, itext.itext, StrLen(itext.itext)) -> Returns the greater of the two IF total_textlen>maxLength THEN maxLength:=total_textlen cur_item:=cur_item.nextitem ENDWHILE ENDPROC maxLength -> Set all IntuiText in a chain (they are linked through the nexttext field) -> to the same font. PROC setITextAttr(first_IText, textAttr) DEF cur_IText:PTR TO intuitext cur_IText:=first_IText WHILE cur_IText cur_IText.itextfont:=textAttr cur_IText:=cur_IText.nexttext ENDWHILE ENDPROC -> Adjust the MenuItems and SubItems PROC adjustItems(textRPort, first_item, textAttr, char_size, height, level, left_edge) DEF item_num, cur_item:PTR TO menuitem, strip_width, subitem_edge IF first_item=NIL THEN RETURN -> The width of this strip is the maximum length of its members. strip_width:=maxLength(textRPort, first_item, char_size) -> Position the items. cur_item:=first_item item_num:=0 WHILE cur_item cur_item.topedge:=(item_num*height)-level cur_item.leftedge:=left_edge cur_item.width:=strip_width cur_item.height:=height -> Place the sub_item 3/4 of the way over on the item subitem_edge:=strip_width-(strip_width/4) setITextAttr(cur_item.itemfill, textAttr) adjustItems(textRPort, cur_item.subitem, textAttr, char_size, height, 1, subitem_edge) cur_item:=cur_item.nextitem INC item_num ENDWHILE ENDPROC -> The following routines adjust an entire menu system to conform to the -> specified font's width and height. Allows for Proportional Fonts. This is -> necessary for a clean look regardless of what the users preference in Fonts -> may be. Using these routines, you don't need to specify TopEdge, LeftEdge, -> Width or Height in the MenuItem structures. -> -> NOTE that this routine does not work for menus with images, but assumes that -> all menu items are rendered with IntuiText. -> -> This set of routines does NOT check/correct if the menu runs off the screen -> due to large fonts, too many items, lo-res screen. PROC adjustMenus(first_menu, textAttr) HANDLE DEF textrp:PTR TO rastport, cur_menu:PTR TO menu, font=NIL:PTR TO textfont, start, char_size, height -> E-Note: dynamically allocate a zeroed rastport (might raise exception) NEW textrp -> Open the font font:=OpenFont(textAttr) SetFont(textrp, font) -> Put font in to temporary RastPort char_size:=TextLength(textrp, 'n', 1) -> Get the width of the font -> To prevent crowding of the Amiga key when using COMMSEQ, don't allow the -> items to be less than 8 pixels high. Also, add an extra pixel for -> inter-line spacing. height:=1+(IF font.ysize>8 THEN font.ysize ELSE 8) start:=2 -> Set Starting Pixel -> Step thru the menu structure and adjust it cur_menu:=first_menu WHILE cur_menu cur_menu.leftedge:=start cur_menu.width:=char_size+ TextLength(textrp, cur_menu.menuname, StrLen(cur_menu.menuname)) adjustItems(textrp, cur_menu.firstitem, textAttr, char_size, height, 0, 0) start:=start+cur_menu.width+(char_size*2) cur_menu:=cur_menu.nextmenu ENDWHILE EXCEPT DO IF font THEN CloseFont(font) -> Close the Font -> E-Note: as C version ignores font error we'll ignore any NEW error... RETURN exception=ERR_NONE ENDPROC ;s-lh0-ssLz%Src\Rkrm\Intuition\Menus\simplemenu.e-> simplemenu.e: How to use the menu system with a window under all OS versions. OPT PREPROCESS MODULE 'graphics/rastport', 'graphics/text', 'intuition/intuition', 'intuition/screens' -> These values are based on the ROM font Topaz8. Adjust these values to -> correctly handle the screen's current font. CONST MENWIDTH=56+8, -> Longest menu item name * font width + 8 pixels for trim MENHEIGHT=10 -> Font height + 2 pixels -> We only use a single menu, but the code is generalisable to more than -> one menu. CONST NUM_MENUS=1 ENUM ERR_NONE, ERR_WIN, ERR_MENU RAISE ERR_WIN IF OpenWindow()=NIL, ERR_MENU IF SetMenuStrip()=FALSE -> E-Note: not really necessary... PROC main() HANDLE -> E-Note: some of these are global arrays in the C version DEF topaz80, submenu1, menu1, menutitle, menustrip:PTR TO menu, win=NIL:PTR TO window, left=2 win:=OpenWindow([40, 40, 300, 100, 0, 1, IDCMP_CLOSEWINDOW OR IDCMP_MENUPICK, WFLG_DRAGBAR OR WFLG_ACTIVATE OR WFLG_CLOSEGADGET, NIL, NIL, 'Menu Test Window', NIL, NIL, 0, 0, 0, 0, WBENCHSCREEN]:nw) -> To keep this example simple, we'll hard-code the font used for menu items. -> Algorithmic layout can be used to handle arbitrary fonts. Under Release 2, -> GadTools provides font-sensitive menu layout. Note that we still must -> handle fonts for the menu headers. topaz80:=['topaz.font', 8, 0, 0]:textattr -> E-Note: linking needs to be done in reverse order to layout -> Sub-item 1, NLQ submenu1:=[NIL, MENWIDTH-2, MENHEIGHT-2, MENWIDTH, MENHEIGHT, ITEMTEXT OR MENUTOGGLE OR ITEMENABLED OR HIGHCOMP, 0, [0, 1, RP_JAM2, 0, 1, topaz80, 'NLQ', NIL]:intuitext, NIL, NIL, NIL, NIL]:menuitem -> Sub-item 0, Draft submenu1:=[submenu1, MENWIDTH-2, -2, MENWIDTH, MENHEIGHT, ITEMTEXT OR MENUTOGGLE OR ITEMENABLED OR HIGHCOMP, 0, [0, 1, RP_JAM2, 0, 1, topaz80, 'Draft', NIL]:intuitext, NIL, NIL, NIL, NIL]:menuitem -> E-Note: linking needs to be done in reverse order to layout -> Item 3, Quit menu1:=[NIL, 0, 3*MENHEIGHT, MENWIDTH, MENHEIGHT, ITEMTEXT OR MENUTOGGLE OR ITEMENABLED OR HIGHCOMP, 0, [0, 1, RP_JAM2, 0, 1, topaz80, 'Quit', NIL]:intuitext, NIL, NIL, NIL, NIL]:menuitem -> Item 2, Print menu1:=[menu1, 0, 2*MENHEIGHT, MENWIDTH, MENHEIGHT, ITEMTEXT OR MENUTOGGLE OR ITEMENABLED OR HIGHCOMP, 0, [0, 1, RP_JAM2, 0, 1, topaz80, 'Print ', NIL]:intuitext, NIL, NIL, submenu1, NIL]:menuitem -> Item 1, Save menu1:=[menu1, 0, MENHEIGHT, MENWIDTH, MENHEIGHT, ITEMTEXT OR MENUTOGGLE OR ITEMENABLED OR HIGHCOMP, 0, [0, 1, RP_JAM2, 0, 1, topaz80, 'Save', NIL]:intuitext, NIL, NIL, NIL, NIL]:menuitem -> Item 0, Open... menu1:=[menu1, 0, 0, MENWIDTH, MENHEIGHT, ITEMTEXT OR MENUTOGGLE OR ITEMENABLED OR HIGHCOMP, 0, [0, 1, RP_JAM2, 0, 1, topaz80, 'Open...', NIL]:intuitext, NIL, NIL, NIL, NIL]:menuitem menutitle:='Project' -> E-Note: use NEW, or remember to initialise last elements to 0 menustrip:=[NIL, left, 0, TextLength(win.wscreen.rastport, menutitle, StrLen(menutitle))+8, MENHEIGHT, MENUENABLED, menutitle, menu1, 0, 0, 0, 0]:menu left:=left+menustrip.width SetMenuStrip(win, menustrip) handleWindow(win, menustrip) ClearMenuStrip(win) -> E-Note: exit and clean up via handler EXCEPT DO IF win THEN CloseWindow(win) -> E-Note: we can print a minimal error message SELECT exception CASE ERR_WIN; WriteF('Error: Failed to open window\n') CASE ERR_MENU; WriteF('Error: Failed to attach menu\n') ENDSELECT ENDPROC -> E-Note: used to convert an INT to unsigned #define UNSIGNED(x) ((x) AND $FFFF) -> Wait for the user to select the close gadget. -> E-Note: E version is simpler, since we use WaitIMessage PROC handleWindow(win, menuStrip) DEF done=FALSE, class, menuNumber, menuNum, itemNum, subNum, item:PTR TO menuitem REPEAT class:=WaitIMessage(win) SELECT class CASE IDCMP_CLOSEWINDOW done:=TRUE CASE IDCMP_MENUPICK -> E-Note: menuNumber is an unsigned INT menuNumber:=UNSIGNED(MsgCode()) WHILE (menuNumber<>MENUNULL) AND (done=FALSE) item:=ItemAddress(menuStrip, menuNumber) -> Process this item -> If there were no sub-items attached to that item, -> SubNumber will equal NOSUB. menuNum:=MENUNUM(menuNumber) itemNum:=ITEMNUM(menuNumber) subNum:=SUBNUM(menuNumber) -> Note that we are printing all values, even things like NOMENU, -> NOITEM and NOSUB. An application should check for these cases. WriteF('IDCMP_MENUPICK: menu \d, item \d, sub \d\n', menuNum, itemNum, subNum) -> This one is the quit menu selection... -> stop if we get it, and don't process any more. -> E-Note: the C version is wrong! QUIT is itemNum = 3 IF (menuNum=0) AND (itemNum=3) THEN done:=TRUE -> E-Note: menuNumber is an unsigned INT menuNumber:=UNSIGNED(item.nextselect) ENDWHILE ENDSELECT UNTIL done ENDPROC G-lh0-Xz1Src\Rkrm\Intuition\Mouse_Keyboard\custompointer.eJ-> custompointer.c - Show the use of a custom busy pointer, as well as using a -> requester to block input to a window. OPT OSVERSION=37 -> E-Note: silently require V37 MODULE 'exec/memory', 'intuition/intuition' ENUM ERR_NONE, ERR_WIN RAISE ERR_WIN IF OpenWindowTagList()=NIL PROC main() HANDLE DEF win=NIL, null_request:requester, waitPointer -> The window is opened as active (WA_ACTIVATE) so that the busy pointer will -> be visible. If the window was not active, the user would have to activate -> it to see the change in the pointer. win:=OpenWindowTagList(NIL, [WA_ACTIVATE, TRUE, NIL]) -> E-Note: the data is really a lot of LONGs (and in Chip memory!) waitPointer:=copyListToChip([$00000000, -> Reserved, must be NIL $040007C0, $000007C0, $01000380, $000007E0, $07C01FF8, $1FF03FEC, $3FF87FDE, $3FF87FBE, $7FFCFF7F, $7EFCFFFF, $7FFCFFFF, $3FF87FFE, $3FF87FFE, $1FF03FFC, $07C01FF8, $000007E0, $00000000 -> Reserved, must be NIL ]) -> A NULL requester can be used to block input in a window without any -> imagery provided. InitRequester(null_request) Delay(50) -> Simulate activity in the program -> Put up the requester to block user input in the window, and set the -> pointer to the busy pointer. IF Request(null_request, win) SetPointer(win, waitPointer, 16, 16, -6, 0) Delay(100) -> Simulate activity in the program -> Clear the pointer (which resets the window to the default pointer) and -> remove the requester. ClearPointer(win) EndRequest(null_request, win) ENDIF Delay(100) -> Simulate activity in the program EXCEPT DO IF win THEN CloseWindow(win) -> E-Note: we can print a minimal error message SELECT exception CASE ERR_WIN; WriteF('Error: Failed to open window\n') CASE "MEM"; WriteF('Error: Ran out of (chip) memory\n') ENDSELECT ENDPROC -> E-Note: get some Chip memory and copy list (quick, since LONG aligned) PROC copyListToChip(data) DEF size, mem size:=ListLen(data)*SIZEOF LONG mem:=NewM(size, MEMF_CHIP) CopyMemQuick(data, mem, size) ENDPROC mem C-lh0-cz-Src\Rkrm\Intuition\Mouse_Keyboard\mousetest.eR-> mousetest.e - Read position and button events from the mouse. OPT OSVERSION=37 MODULE 'devices/inputevent', 'exec/ports', 'graphics/gfxbase', 'graphics/rastport', 'graphics/text', 'intuition/intuition', 'intuition/screens' ENUM ERR_NONE, ERR_DRAW, ERR_PUB, ERR_WIN RAISE ERR_DRAW IF GetScreenDrawInfo()=NIL, ERR_PUB IF LockPubScreen()=NIL, ERR_WIN IF OpenWindowTagList()=NIL -> E-Note: C version should use this for a string... CONST BUFSIZE=15 -> Something to use to track the time between messages to test for -> double-clicks. OBJECT myTimeVal leftSeconds, leftMicros rightSeconds, rightMicros ENDOBJECT PROC main() HANDLE DEF win=NIL:PTR TO window, scr=NIL:PTR TO screen, dr_info=NIL:PTR TO drawinfo, width, gfx:PTR TO gfxbase -> Lock the default public screen in order to read its DrawInfo data scr:=LockPubScreen(NIL) dr_info:=GetScreenDrawInfo(scr) -> Use wider of space needed for output (18 chars and spaces) or titlebar -> text plus room for titlebar gads (approx 18 each) -> E-Note: get the right type for gfxbase gfx:=gfxbase width:=Max(gfx.defaultfont.xsize * 18, (18*2)+TextLength(scr.rastport, 'MouseTest', STRLEN)) win:=OpenWindowTagList(NIL, [WA_TOP, 20, WA_LEFT, 100, WA_INNERWIDTH, width, WA_HEIGHT, (2*gfx.defaultfont.ysize)+ scr.wbortop+scr.font.ysize+1+scr.wborbottom, WA_FLAGS, WFLG_DEPTHGADGET OR WFLG_CLOSEGADGET OR WFLG_ACTIVATE OR WFLG_REPORTMOUSE OR WFLG_RMBTRAP OR WFLG_DRAGBAR, WA_IDCMP, IDCMP_CLOSEWINDOW OR IDCMP_RAWKEY OR IDCMP_MOUSEMOVE OR IDCMP_MOUSEBUTTONS, WA_TITLE, 'MouseTest', WA_PUBSCREEN, scr, NIL]) WriteF('Monitors the Mouse:\n') WriteF(' Move Mouse, Click and DoubleClick in Windows\n') SetAPen(win.rport, dr_info.pens[TEXTPEN]) SetBPen(win.rport, dr_info.pens[BACKGROUNDPEN]) SetDrMd(win.rport, RP_JAM2) process_window(win) EXCEPT DO IF win THEN CloseWindow(win) IF dr_info THEN FreeScreenDrawInfo(scr, dr_info) IF scr THEN UnlockPubScreen(NIL, scr) SELECT exception CASE ERR_DRAW; WriteF('Error: Failed to get DrawInfo for screen\n') CASE ERR_PUB; WriteF('Error: Failed to lock public screen\n') CASE ERR_WIN; WriteF('Error: Failed to open window\n') ENDSELECT ENDPROC -> process_window() - Simple message loop for processing IntuiMessages PROC process_window(win:PTR TO window) -> E-Note: C version failed to use BUFSIZE! DEF going, msg:PTR TO intuimessage, class, tv, prt_buff[BUFSIZE]:STRING, xText, yText -> Places to position text in window -> E-Note: going rather than done saves a lot of Not()-ing going:=TRUE tv:=[0, 0, 0, 0]:myTimeVal xText:=win.borderleft+(win.ifont.xsize*2) yText:=win.bordertop+3+win.ifont.baseline -> E-Note: we can't use WaitIMessage() because we want mousex, mousey WHILE going Wait(Shl(1, win.userport.sigbit)) WHILE going AND (msg:=GetMsg(win.userport)) class:=msg.class SELECT class CASE IDCMP_CLOSEWINDOW going:=FALSE -> NOTE NOTE NOTE: If the mouse queue backs up a lot, Intuition will -> start dropping MOUSEMOVE messages off the end until the queue is -> serviced. This may cause the program to lose some of the MOUSEMOVE -> events at the end of the stream. -> -> Look in the window structure if you need the true position of the -> mouse pointer at any given time. Look in the MOUSEBUTTONS message if -> you need position when it clicked. An alternate to this processing -> would be to set a flag that a mousemove event arrived, then print the -> position of the mouse outside of a "WHILE GetMsg()" loop. This allows -> a single processing call for many mouse events, which speeds up -> processing A LOT! Something like: -> -> WHILE GetMsg() -> IF class=IDCMP_MOUSEMOVE THEN mouse_flag:= TRUE -> ReplyMsg() -> NOTE: copy out all needed fields first ! -> ENDWHILE -> IF mouse_flag -> process_mouse_event() -> mouse_flag:=FALSE -> ENDIF -> -> You can also use IDCMP_INTUITICKS for slower paced messages (all -> messages have mouse coordinates.) CASE IDCMP_MOUSEMOVE -> Show the current position of the mouse relative to the upper left -> hand corner of our window Move(win.rport, xText, yText) StringF(prt_buff, 'X=\d[5] Y=\d[5]', msg.mousex, msg.mousey) Text(win.rport, prt_buff, BUFSIZE) CASE IDCMP_MOUSEBUTTONS doButtons(msg, tv) ENDSELECT ReplyMsg(msg) ENDWHILE ENDWHILE ENDPROC -> Show what mouse buttons where pushed PROC doButtons(msg:PTR TO intuimessage, tv:PTR TO myTimeVal) DEF code IF msg.qualifier AND (IEQUALIFIER_LSHIFT OR IEQUALIFIER_RSHIFT) WriteF('Shift ') ENDIF code:=msg.code SELECT code CASE SELECTDOWN WriteF('Left Button Down at X=\d Y=\d', msg.mousex, msg.mousey) IF DoubleClick(tv.leftSeconds, tv.leftMicros, msg.seconds, msg.micros) WriteF(' DoubleClick!') ELSE tv.leftSeconds:=msg.seconds tv.leftMicros:=msg.micros tv.rightSeconds:=0 tv.rightMicros:=0 ENDIF CASE SELECTUP WriteF('Left Button Up at X=\d Y=\d', msg.mousex, msg.mousey) CASE MENUDOWN WriteF('Right Button Down at X=\d Y=\d', msg.mousex, msg.mousey) IF DoubleClick(tv.rightSeconds, tv.rightMicros, msg.seconds, msg.micros) WriteF(' DoubleClick!') ELSE tv.leftSeconds:=0 tv.leftMicros:=0 tv.rightSeconds:=msg.seconds tv.rightMicros:=msg.micros ENDIF CASE MENUUP WriteF('Right Button Up at X=\d Y=\d', msg.mousex, msg.mousey) ENDSELECT WriteF('\n') ENDPROC @;-lh0-$$jz*Src\Rkrm\Intuition\Mouse_Keyboard\rawkey.e>-> rawkey.e - How to correctly convert from RAWKEY to keymapped ASCII MODULE 'console', 'devices/inputevent', 'devices/timer', 'exec/io', 'intuition/intuition' ENUM ERR_NONE, ERR_DEV, ERR_WIN RAISE ERR_DEV IF OpenDevice()<>0, ERR_WIN IF OpenWindowTagList()=NIL -> A buffer is created for RawKeyConvert() to put its output. BUFSIZE is the -> size of the buffer in bytes. NOTE that this program starts out with a -> buffer size of 2. This is only to show how the buffer is automatically -> increased in size by this example! In an application, start with a much -> larger buffer and you will probably never have to increase its size. 128 -> bytes or so should do the trick, but always be able to change the size if -> required. CONST BUFSIZE=2 PROC main() HANDLE DEF win=NIL, ioreq:iostd, ievent=NIL:PTR TO inputevent, buffer=NIL, bufsize=BUFSIZE -> Open the console device just to do keymapping. (unit -1 means any unit) OpenDevice('console.device', -1, ioreq, 0) consoledevice:=ioreq.device -> Allocate the initial character buffer used by deadKeyConvert() and -> RawKeyConvert() for returning translated characters. If the characters -> generated by these routines cannot fit into the buffer, the application -> must pass a larger buffer. This is done in this code by freeing the old -> buffer and allocating a new one. buffer:=NewR(bufsize) NEW ievent win:=OpenWindowTagList(NIL, [WA_WIDTH, 300, WA_HEIGHT, 50, WA_FLAGS, WFLG_DEPTHGADGET OR WFLG_CLOSEGADGET OR WFLG_ACTIVATE, WA_IDCMP, IDCMP_CLOSEWINDOW OR IDCMP_RAWKEY, WA_TITLE, 'Raw Key Example', NIL]) WriteF('Press keyboard keys to see ASCII conversion from rawkey\n') WriteF('Unprintable characters will be shown as \c\n\n', $7F) process_window(win, ievent, {buffer}, {bufsize}) EXCEPT DO IF win THEN CloseWindow(win) -> E-Note: don't need to free any memory -- automatically done IF consoledevice THEN CloseDevice(ioreq) SELECT exception CASE ERR_DEV; WriteF('Error: Failed to open console device.\n') CASE ERR_WIN; WriteF('Error: Failed to open window.\n') CASE "MEM"; WriteF('Error: Ran out of memory.\n') ENDSELECT ENDPROC -> Convert RAWKEYs into VANILLAKEYs, also shows special keys like HELP, Cursor -> Keys, FKeys, etc. It returns: -> -1 if not enough room in the buffer, try again with a bigger buffer. -> otherwise, returns the number of characters placed in the buffer. PROC deadKeyConvert(kbuffer, kbsize, kmap, ievent:PTR TO inputevent) ievent.class:=IECLASS_RAWKEY ievent.code:=MsgCode() ievent.qualifier:=MsgQualifier() ievent.eventaddress:=MsgIaddr() RETURN RawKeyConvert(ievent, kbuffer, kbsize, kmap) ENDPROC -> print_qualifiers() - Print out the values found in the qualifier bits of -> the message. This will print out all of the qualifier bits set. PROC print_qualifiers(qual) WriteF('Qual: ') IF qual AND IEQUALIFIER_LSHIFT THEN WriteF('LShft, ') IF qual AND IEQUALIFIER_RSHIFT THEN WriteF('RShft, ') IF qual AND IEQUALIFIER_CAPSLOCK THEN WriteF('CapLok, ') IF qual AND IEQUALIFIER_CONTROL THEN WriteF('Ctrl, ') IF qual AND IEQUALIFIER_LALT THEN WriteF('LAlt, ') IF qual AND IEQUALIFIER_RALT THEN WriteF('RAlt, ') IF qual AND IEQUALIFIER_LCOMMAND THEN WriteF('LCmd, ') IF qual AND IEQUALIFIER_RCOMMAND THEN WriteF('RCmd, ') IF qual AND IEQUALIFIER_NUMERICPAD THEN WriteF('NumPad, ') IF qual AND IEQUALIFIER_REPEAT THEN WriteF('Rpt, ') IF qual AND IEQUALIFIER_INTERRUPT THEN WriteF('Intrpt, ') IF qual AND IEQUALIFIER_MULTIBROADCAST THEN WriteF('Multi Broadcast, ') IF qual AND IEQUALIFIER_MIDBUTTON THEN WriteF('MidBtn, ') IF qual AND IEQUALIFIER_RBUTTON THEN WriteF('RBtn, ') IF qual AND IEQUALIFIER_LEFTBUTTON THEN WriteF('LBtn, ') IF qual AND IEQUALIFIER_RELATIVEMOUSE THEN WriteF('RelMouse, ') ENDPROC -> doKeys() - Show what keys were pressed. PROC doKeys(ievent, buffer:PTR TO LONG, bufsize:PTR TO LONG) HANDLE DEF char_pos, numchars, realc, c -> deadKeyConvert() returns -1 if there was not enough space in the buffer to -> convert the string. Here, the routine increases the size of the buffer on -> the fly... Set the return code to FALSE on failure. numchars:=deadKeyConvert(buffer[], bufsize[]-1, NIL, ievent) WHILE (numchars=-1) AND buffer[] -> Conversion failed, buffer too small. Try to double the size of the buffer. Dispose(buffer[]) bufsize[]:=bufsize[]*2 WriteF('Increasing buffer size to \d\n', bufsize[]) buffer[]:=NewR(bufsize[]) numchars:=deadKeyConvert(buffer[], bufsize[]-1, NIL, ievent) ENDWHILE -> numchars contains the number of characters placed within the buffer. Key -> up events and key sequences that do not generate any data for the program -> (like deadkeys) will return zero. Special keys (like HELP, the cursor -> keys, FKeys, etc.) return multiple characters that have to then be parsed -> by the application. -> If high bit set, then this is a key up otherwise this is a key down IF MsgCode() AND $80 WriteF('Key Up: ') ELSE WriteF('Key Down: ') ENDIF print_qualifiers(MsgQualifier()) WriteF(' rawkey #\d maps to \d ASCII character\s\n', $7F AND MsgCode(), numchars, IF numchars<>1 THEN 's' ELSE '') FOR char_pos:=0 TO numchars-1 realc:=(c:=buffer[][char_pos]) IF (c<=$1F) OR ((c>=$80) AND (c<$A0)) THEN c:=$7F WriteF(' \d[3] ($\z\h[2]) = \c\n', realc, realc, c) ENDFOR EXCEPT DO RETURN exception=ERR_NONE ENDPROC -> process_window() - Simple event loop. Note that the message is not replied -> to until the end of the loop so that it may be used in the doKeys() call. -> E-Note: we use WaitIMessage() so a lot of this and above is simplified PROC process_window(win, ievent, buffer, bufsize) DEF going=TRUE, class WHILE going class:=WaitIMessage(win) SELECT class CASE IDCMP_CLOSEWINDOW going:=FALSE CASE IDCMP_RAWKEY going:=doKeys(ievent, buffer, bufsize) ENDSELECT ENDWHILE ENDPROC G-lh0-8z1Src\Rkrm\Intuition\Requesters_Alerts\blockinput.eږ-> blockinput.e -- Program to demonstrate how to block the input from a window -> using a minimal requester, and how to put up a busy pointer. OPT OSVERSION=37 -> E-Note: silently require V37 MODULE 'exec/memory', 'intuition/intuition' ENUM ERR_NONE, ERR_WIN RAISE ERR_WIN IF OpenWindowTagList()=NIL -> Open a window and display a busy-pointer for a short time then wait for the -> user to hit the close gadget (in processIDCMP()). Normally, the application -> would bracket sections of code where it wishes to block window input with -> the beginWait() and endWait() functions. PROC main() HANDLE DEF win=NIL win:=OpenWindowTagList(NIL, [WA_IDCMP, IDCMP_CLOSEWINDOW OR IDCMP_INTUITICKS, WA_ACTIVATE, TRUE, WA_WIDTH, 320, WA_HEIGHT, 100, WA_CLOSEGADGET, TRUE, WA_DRAGBAR, TRUE, WA_DEPTHGADGET, TRUE, WA_SIZEGADGET, TRUE, WA_MAXWIDTH, -1, WA_MAXHEIGHT, -1, NIL]) processIDCMP(win) EXCEPT DO IF win THEN CloseWindow(win) -> E-Note: we can print a minimal error message SELECT exception CASE ERR_WIN; WriteF('Error: Failed to open window\n') CASE "MEM"; WriteF('Error: Ran out of (chip) memory\n') ENDSELECT ENDPROC -> E-Note: get some Chip memory and copy list (quick, since LONG aligned) PROC copyListToChip(data) DEF size, mem size:=ListLen(data)*SIZEOF LONG mem:=NewM(size, MEMF_CHIP) CopyMemQuick(data, mem, size) ENDPROC mem -> Clear the requester with InitRequester. This makes a requester of -> width = 0, height = 0, left = 0, top = 0; in fact, everything is zero. This -> requester will simply block input to the window until EndRequest is called. -> -> The pointer is set to a reasonable 4-color busy pointer, with proper offsets. PROC beginWait(win, waitRequest) DEF waitPointer -> Data for a busy pointer. -> This data must be in chip memory!!! -> E-Note: the data is really a lot of LONGs waitPointer:=copyListToChip([$00000000, -> Reserved, must be NIL $040007C0, $000007C0, $01000380, $000007E0, $07C01FF8, $1FF03FEC, $3FF87FDE, $3FF87FBE, $7FFCFF7F, $7EFCFFFF, $7FFCFFFF, $3FF87FFE, $3FF87FFE, $1FF03FFC, $07C01FF8, $000007E0, $00000000 -> Reserved, must be NIL ]) InitRequester(waitRequest) IF Request(waitRequest, win) SetPointer(win, waitPointer, 16, 16, -6, 0) SetWindowTitles(win, 'Busy - Input Blocked', -1) RETURN TRUE ELSE RETURN FALSE ENDIF ENDPROC -> Routine to reset the pointer to the system default, and remove the requester -> installed with beginWait(). PROC endWait(win, waitRequest) ClearPointer(win) EndRequest(waitRequest, win) SetWindowTitles(win, 'Not Busy', -1) ENDPROC -> Wait for the user to close the window. PROC processIDCMP(win) DEF class, myreq:requester, tick_count -> Put up a requester with no imagery (size zero). IF beginWait(win, myreq) -> Insert code here for a window to act as the requester. -> We'll count down INTUITICKS, which come about ten times a second. We'll -> keep the busy state for about three seconds. tick_count:=30 ENDIF REPEAT class:=WaitIMessage(win) SELECT class CASE IDCMP_INTUITICKS IF tick_count>0 DEC tick_count IF tick_count=0 THEN endWait(win, myreq) ENDIF ENDSELECT UNTIL class=IDCMP_CLOSEWINDOW ENDPROC Iv-lh0-00"h3Src\Rkrm\Intuition\Requesters_Alerts\displayalert.e!-> displayalert.e - This program implements a recoverable alert MODULE 'intuition/intuition' PROC main() IF DisplayAlert(RECOVERY_ALERT, {alertMsg}, 52) WriteF('Alert returned TRUE\n') ELSE WriteF('Alert returned FALSE\n') ENDIF ENDPROC -> Each string requires its own positioning information, as explained in the -> manual. Hex notation has been used to specify the positions of the text. -> Hex numbers start with a "$" and the characters that make up the number. -> -> Each line needs 2 bytes of x position, and 1 byte of y position. -> in our 1st line: x = 0 $f0 (2 bytes) and y = $14 (1 byte) -> In our 2nd line: x = 0 $80 (2 bytes) and y = $24 (1 byte) -> Each line is NIL terminated plus a continuation character (0=done). The -> entire alert must end in TWO NILs, one for the end of the string, and one -> for the 0 continuation character. -> E-Note: using static data is just one way of doing this neatly alertMsg: CHAR 0, $f0, $14, 'OH NO, NOT AGAIN!', NIL, 1, 0, $80, $24, 'PRESS MOUSEBUTTON: LEFT=TRUE RIGHT=FALSE', NIL, 0 Ho-lh0-z2Src\Rkrm\Intuition\Requesters_Alerts\easyrequest.edT-> easyrequest.e - Show the use of an easy requester. OPT OSVERSION=37 -> Note: silently require V37 MODULE 'intuition/intuition' -> Main routine to show the use of EasyRequestArgs() PROC main() DEF answer, number, text number:=3125794 -> For use in the middle button -> The easy request strucutre uses many features of EasyRequestArgs(), -> including: -> multiple lines of body text separated by '\n'. -> variable substitution of a string (%s) in the body text. -> multiple button gadgets separated by '|'. -> variable substitution in a gadget (long decimal '%ld'). -> NOTE in the variable substitution: -> the string goes in the first open variable (in body text). -> the number goes in the second open (gadget text). text:='Text for the request\n'+ 'Second line of %s text\n'+ 'Third line of text for the request' answer:=EasyRequestArgs(NIL, [SIZEOF easystruct, 0, 'Request Window Name', text, 'Yes|%ld|No']:easystruct, NIL, ['(Variable)', number]) -> Process the answer. Note that the buttons are numbered in a strange -> order. This is because the rightmost button is always a negative reply. -> The code can use this if it chooses, with a construct like: -> -> IF EasyRequestArgs() THEN positive_response() SELECT answer CASE 1; WriteF('Selected "Yes"\n') CASE 2; WriteF('Selected "\d"\n', number) CASE 0; WriteF('Selected "No"\n') ENDSELECT ENDPROC >>-lh0-z(Src\Rkrm\Intuition\Screens\clonescreen.e-> clonescreen.e - clone an existing public screen MODULE 'intuition/screens', -> Screen data structures and tags 'graphics/text', -> Text font structure 'graphics/modeid', -> Release 2 Amiga display mode ID's 'exec/nodes', -> Nodes -- get font name 'exec/ports' -> Ports -- get font name ENUM ERR_NONE, ERR_SCRN, ERR_LOCKPUB, ERR_GETDRAW, ERR_MODEID, ERR_FONT RAISE ERR_SCRN IF OpenScreenTagList()=NIL, ERR_LOCKPUB IF LockPubScreen()=NIL, ERR_GETDRAW IF GetScreenDrawInfo()=NIL, ERR_MODEID IF GetVPModeID()=INVALID_ID, ERR_FONT IF OpenFont()=NIL, "MEM" IF String()=NIL PROC main() DEF pub_screen_name pub_screen_name:='Workbench' IF KickVersion(37) -> Require version 37 -> E-Note: E automatically opens the Intuition and Graphics libraries cloneScreen(pub_screen_name) ENDIF ENDPROC -> Clone a public screen whose name is passed to the routine. Width, Height, -> Depth, Pens, Font and DisplayID attributes are all copied from the screen. -> Overscan is assumed to be OSCAN_TEXT, as there is no easy way to find the -> overscan type of an existing screen. AutoScroll is turned on, as it does -> not hurt. Screens that are smaller than the display clip will not scroll. PROC cloneScreen(pub_screen_name) HANDLE DEF my_screen=NIL:PTR TO screen, screen_modeID, pub_scr_font_name, font_name, pub_screen_font:PTR TO textattr, opened_font, pub_screen=NIL:PTR TO screen, screen_drawinfo=NIL:PTR TO drawinfo -> pub_screen_name is a pointer to the name of the public screen to clone -> E-Note: automatically error-checked (automatic exception) pub_screen:=LockPubScreen(pub_screen_name) -> Get the DrawInfo structure from the locked screen -> E-Note: automatically error-checked (automatic exception) screen_drawinfo:=GetScreenDrawInfo(pub_screen) -> E-Note: pub_screen.viewport is a structure in C and (as usual) a pointer -> to the structure in E -> E-Note: automatically error-checked (automatic exception) screen_modeID:=GetVPModeID(pub_screen.viewport) -> Get a copy of the font -> The name of the font must be copied as the public screen may go away at -> any time after we unlock it. Allocate enough memory to copy the font -> name, create a TextAttr that matches the font, and open the font. -> E-Note: pointer typing needed to multiply select from system objects pub_scr_font_name:=screen_drawinfo.font.mn.ln.name -> E-Note: allocate and copy all in one go -> E-Note: automatically error-checked (automatic exception) font_name:=StrCopy(String(StrLen(pub_scr_font_name)), pub_scr_font_name) -> E-Note: use a typed list for initialised object pub_screen_font:=[font_name, screen_drawinfo.font.ysize, screen_drawinfo.font.style, screen_drawinfo.font.flags]:textattr -> E-Note: pub_screen_font is a structure in C and (as usual) a pointer to -> the structure in E -> E-Note: automatically error-checked (automatic exception) opened_font:=OpenFont(pub_screen_font) -> screen_modeID may now be used in a call to OpenScreenTagList() with the -> tag SA_DISPLAYID -> E-Note: automatically error-checked (automatic exception) my_screen:=OpenScreenTagList(NIL, [SA_WIDTH, pub_screen.width, SA_HEIGHT, pub_screen.height, SA_DEPTH, screen_drawinfo.depth, SA_OVERSCAN, OSCAN_TEXT, SA_AUTOSCROLL, TRUE, SA_PENS, screen_drawinfo.pens, SA_FONT, pub_screen_font, SA_DISPLAYID, screen_modeID, SA_TITLE, 'Cloned Screen', NIL]) -> Free the drawinfo and public screen as we don't need them any more. -> We now have our own screen. FreeScreenDrawInfo(pub_screen, screen_drawinfo) screen_drawinfo:=NIL UnlockPubScreen(pub_screen_name, pub_screen) pub_screen:=NIL Delay(300) -> Should be the rest of the program -> E-Note: exit and clean up via handler EXCEPT DO -> The first two are freed in the main code if OpenScreenTagList() does not -> fail. If something goes wrong, free them here. IF screen_drawinfo THEN FreeScreenDrawInfo(pub_screen, screen_drawinfo) IF pub_screen THEN UnlockPubScreen(pub_screen_name, pub_screen) IF my_screen THEN CloseScreen(my_screen) IF opened_font THEN CloseFont(opened_font) -> E-Note: it is not strictly necessary, but tidy, to free the font_name IF font_name THEN DisposeLink(font_name) -> E-Note: we can print a minimal error message SELECT exception CASE ERR_FONT -> E-Note: it's helpful to say which font went wrong WriteF('Error: Failed to open font "\s"\n', font_name) CASE ERR_GETDRAW; WriteF('Error: Failed to get DrawInfo of screen\n') CASE ERR_LOCKPUB; WriteF('Error: Failed to locked public screen\n') CASE ERR_MODEID; WriteF('Error: Public screen has invalid mode ID\n') CASE ERR_SCRN; WriteF('Error: Failed to open custom screen\n') CASE "MEM"; WriteF('Error: Ran out of memory\n') ENDSELECT ENDPROC ?J-lh0-AAӅz)Src\Rkrm\Intuition\Screens\doublebuffer.e,-> doublebuffer.e - Show the use of a double-buffered screen MODULE 'intuition/screens', -> Screen data structures 'graphics/rastport', -> RastPort and other structures 'graphics/view', -> ViewPort and other structures 'graphics/gfx' -> BitMap and other structures -> Characteristics of the screen CONST SCR_WIDTH=320, SCR_HEIGHT=200, SCR_DEPTH=2 -> Exception values -> E-Note: exceptions are a much better way of handling errors ENUM ERR_NONE, ERR_SCRN, ERR_RAST -> Automatically raise exceptions -> E-Note: these take care of a lot of error cases RAISE ERR_SCRN IF OpenScreen()=NIL, ERR_RAST IF AllocRaster()=NIL -> Main routine. Setup for using the double buffered screen. Clean up all -> resources when done or on any error. PROC main() HANDLE DEF myBitMaps=NIL:PTR TO LONG, screen=NIL:PTR TO screen -> E-Note: E automatically opens the Intuition and Graphics libraries myBitMaps:=setupBitMaps(SCR_DEPTH, SCR_WIDTH, SCR_HEIGHT) -> Open a simple quiet screen that is using the first of the two bitmaps. -> E-Note: use a typed list to get an initialised object -> E-Note: automatically error-checked (automatic exception) screen:=OpenScreen([0, -> LeftEdge 0, -> TopEdge SCR_WIDTH, -> Width SCR_HEIGHT, -> Height SCR_DEPTH, -> Depth 0, -> DetailPen 1, -> BlockPen V_HIRES, -> ViewModes CUSTOMSCREEN OR CUSTOMBITMAP OR SCREENQUIET, -> Type NIL, -> Font NIL, -> DefaultTitle NIL, -> Gadgets myBitMaps[0] -> CustomBitMap ]:ns) -> Indicate that the rastport is double buffered. screen.rastport.flags:=RPF_DBUFFER runDBuff(screen, myBitMaps) -> E-Note: exit and clean up via handler EXCEPT DO IF screen THEN CloseScreen(screen) IF myBitMaps THEN freeBitMaps(myBitMaps, SCR_DEPTH, SCR_WIDTH, SCR_HEIGHT) -> E-Note: we can print a minimal error message SELECT exception CASE ERR_SCRN; WriteF('Error: Failed to open custom screen\n') CASE ERR_RAST; WriteF('Error: Ran out of memory in AllocRaster()\n') CASE "MEM"; WriteF('Error: Ran out of memory\n') ENDSELECT ENDPROC -> setupBitMaps(): allocate the bit maps for a double buffered screen. PROC setupBitMaps(depth, width, height) HANDLE DEF myBitMaps:PTR TO LONG -> E-Note: an immediate list in E takes the place of the static in C -> E-Note: initialise the two bitmaps to NIL pointers myBitMaps:=[NIL,NIL] -> E-Note: NewR raises an exception if it fails myBitMaps[0]:=NewR(SIZEOF bitmap) myBitMaps[1]:=NewR(SIZEOF bitmap) InitBitMap(myBitMaps[0], depth, width, height) InitBitMap(myBitMaps[1], depth, width, height) setupPlanes(myBitMaps[0], depth, width, height) setupPlanes(myBitMaps[1], depth, width, height) EXCEPT freeBitMaps(myBitMaps, depth, width, height) -> E-Note: exception must be passed on to caller ReThrow() ENDPROC myBitMaps -> runDBuff(): loop through a number of iterations of drawing into alternate -> frames of the double-buffered screen. Note that the object is drawn in -> colour 1. PROC runDBuff(screen:PTR TO screen, myBitMaps:PTR TO LONG) DEF ktr, xpos, ypos, toggleFrame=0 SetAPen(screen.rastport, 1) FOR ktr:=1 TO 199 -> Calculate a position to place the object, these calculations ensure the -> object will stay on the screen given the range of ktr and the size of -> the object. xpos:=ktr ypos:=IF Mod(ktr,100)>=50 THEN 50-Mod(ktr,50) ELSE Mod(ktr,50) -> Switch the bitmap so that we are drawing into the correct place screen.rastport.bitmap:=myBitMaps[toggleFrame] screen.viewport.rasinfo.bitmap:=myBitMaps[toggleFrame] -> Draw the object -> Here we clear the old frame and draw a simple filled rectangle SetRast(screen.rastport, 0) RectFill(screen.rastport, xpos, ypos, xpos+100, ypos+100) -> Update the physical display to match the newly drawn bitmap MakeScreen(screen) -> Tell Intuition to do its stuff RethinkDisplay() -> Intuition compatible MrgCop() & LoadView() -> It also does a WaitTOF() -> Switch the frame number for the next time through -> E-Note: this is exactly what the C version does... toggleFrame:=Eor(toggleFrame, 1) ENDFOR ENDPROC -> freeBitMaps(): free up the memory allocated by setupBitMaps() PROC freeBitMaps(myBitMaps:PTR TO LONG, depth, width, height) -> E-Note: freeBitMaps() can be safely if written carefully IF myBitMaps[0] freePlanes(myBitMaps[0], depth, width, height) Dispose(myBitMaps[0]) ENDIF IF myBitMaps[1] freePlanes(myBitMaps[1], depth, width, height) Dispose(myBitMaps[1]) ENDIF ENDPROC -> setupPlanes(): allocate the bit planes for a screen bit map PROC setupPlanes(bitMap:PTR TO bitmap, depth, width, height) DEF plane_num, planes:PTR TO LONG planes:=bitMap.planes FOR plane_num:=0 TO depth-1 -> E-Note: automatically error-checked (automatic exception) planes[plane_num]:=AllocRaster(width, height) BltClear(planes[plane_num], (width/8)*height, 1) ENDFOR -> E-Note: exceptions handled in caller, which frees memory ENDPROC -> freePlanes(): free up the memory allocated by setupPlanes() PROC freePlanes(bitMap:PTR TO bitmap, depth, width, height) DEF plane_num, planes:PTR TO LONG planes:=bitMap.planes FOR plane_num:=0 TO depth-1 IF planes[plane_num] THEN FreeRaster(planes[plane_num], width, height) ENDFOR ENDPROC @-lh0-CCz*Src\Rkrm\Intuition\Screens\dualplayfield.e'-> dualplayfield.e - Shows how to turn on dual-playfield mode in a screen. MODULE 'intuition/intuition', -> Intuition data structures and tags 'intuition/screens', -> Screen data structures and tags 'graphics/modeid', -> Release 2 Amiga display mode ID's 'exec/memory', -> Memory flags 'graphics/gfx', -> Bitmap and other structures 'graphics/rastport', -> RastPort and other structures 'graphics/view' -> ViewPort and other structures ENUM ERR_NONE, ERR_SCRN, ERR_WIN, ERR_RAST, ERR_MODEID RAISE ERR_SCRN IF OpenScreenTagList()=NIL, ERR_WIN IF OpenWindowTagList()=NIL, ERR_RAST IF AllocRaster()=NIL, ERR_MODEID IF GetVPModeID()=INVALID_ID PROC main() HANDLE DEF win=NIL, scr=NIL -> E-Note: E automatically opens the Intuition and Graphics libraries scr:=OpenScreenTagList(NIL, [SA_DEPTH, 2, SA_DISPLAYID, HIRES_KEY, SA_TITLE, 'Dual Playfield Test Screen', NIL]) win:=OpenWindowTagList(NIL, [WA_TITLE, 'Dual Playfield Mode', WA_IDCMP, IDCMP_CLOSEWINDOW, WA_WIDTH, 200, WA_HEIGHT, 100, WA_DRAGBAR, TRUE, WA_CLOSEGADGET, TRUE, WA_CUSTOMSCREEN, scr, NIL]) doDualPF(win) -> E-Note: exit and clean up via handler EXCEPT DO IF win THEN CloseWindow(win) IF scr THEN CloseScreen(scr) -> E-Note: we can print a minimal error message SELECT exception CASE ERR_SCRN; WriteF('Error: Failed to open custom screen\n') CASE ERR_WIN; WriteF('Error: Failed to open window\n') CASE ERR_RAST; WriteF('Error: Ran out of memory in AllocRaster\n') CASE ERR_MODEID; WriteF('Error: Bad/invalid mode ID for viewport\n') CASE "MEM"; WriteF('Error: Ran out of memory\n') ENDSELECT ENDPROC -> Allocate all of the stuff required to add dual playfield to a screen. PROC doDualPF(win:PTR TO window) HANDLE DEF myscreen:PTR TO screen, rinfo2=NIL:PTR TO rasinfo, bmap2=NIL:PTR TO bitmap, rport2=NIL:PTR TO rastport myscreen:=win.wscreen -> Find the window's screen -> Allocate the second playfield's rasinfo, bitmap, and bitplane -> E-Note: NewM raises an exception if it fails rinfo2:=NewM(SIZEOF rasinfo, MEMF_PUBLIC OR MEMF_CLEAR) -> Get a rastport, and set it up for rendering into bmap2 rport2:=NewM(SIZEOF rastport, MEMF_PUBLIC) bmap2:=NewM(SIZEOF bitmap, MEMF_PUBLIC OR MEMF_CLEAR) InitBitMap(bmap2, 1, myscreen.width, myscreen.height) -> Extra playfield will only use one bitplane here. -> E-Note: automatically error checked (automatic exception) bmap2.planes[0]:=AllocRaster(myscreen.width, myscreen.height) InitRastPort(rport2) rinfo2.bitmap:=bmap2 rport2.bitmap:=bmap2 SetRast(rport2, 0) -> E-Note: an exception will be raised if installDualPF fails installDualPF(myscreen, rinfo2) SetRGB4(myscreen.viewport, 9, 0, $F, 0) drawSomething(rport2) handleIDCMP(win) removeDualPF(myscreen) -> E-Note: exit and clean up via handler EXCEPT DO IF bmap2 IF bmap2.planes[0] -> E-Note: NewM makes this zero when bmap2 allocated FreeRaster(bmap2.planes[0], myscreen.width, myscreen.height) ENDIF Dispose(bmap2) ENDIF IF rport2 THEN Dispose(rport2) IF rinfo2 THEN Dispose(rinfo2) -> E-Note: pass exception on if it was an error ReThrow() ENDPROC -> Manhandle the viewport: install second playfield and change modes PROC installDualPF(scrn:PTR TO screen, rinfo2) -> You can only play with the bits in the Modes field if the upper half of -> the screen mode ID is zero!!! -> E-Note: automatic and explicit exceptions raised here IF GetVPModeID(scrn.viewport) AND $FFFF0000 THEN Raise(ERR_MODEID) Forbid() -> Install rinfo2 for viewport's second playfield scrn.viewport.rasinfo.next:=rinfo2 scrn.viewport.modes:=scrn.viewport.modes OR V_DUALPF Permit() -> Put viewport change into effect MakeScreen(scrn) RethinkDisplay() ENDPROC -> Draw some lines in a rast port... This is used to get some data into the -> second playfield. The windows on the screen will move underneath these -> graphics without disturbing them. PROC drawSomething(rp:PTR TO rastport) DEF width, height, r, c width:=rp.bitmap.bytesperrow * 8 height:=rp.bitmap.rows SetAPen(rp, 1) FOR r:=0 TO height-1 STEP 40 FOR c:=0 TO width-1 STEP 40 -> E-Note: we could use E's graphics functions Move(rp, 0, r) Draw(rp, c, 0) ENDFOR ENDFOR ENDPROC -> Simple event loop to wait for the user to hit the close gadget on the window. PROC handleIDCMP(win) WHILE WaitIMessage(win)<>IDCMP_CLOSEWINDOW ENDWHILE ENDPROC -> Remove the effects of installDualPF(). -> Only call if installDualPF() succeeded. PROC removeDualPF(scrn:PTR TO screen) Forbid() scrn.viewport.rasinfo.next:=NIL scrn.viewport.modes:=scrn.viewport.modes AND Not(V_DUALPF) Permit() MakeScreen(scrn) RethinkDisplay() ENDPROC @T-lh0-z*Src\Rkrm\Intuition\Screens\newlookscreen.em-> newlookscreen.e - open a screen with the "new look" -> E-Note: you need to be more specific about modules than C does about includes MODULE 'intuition/screens' -> Screen data structures and tags -> Exception values -> E-Note: exceptions are a much better way of handling errors ENUM ERR_NONE, ERR_SCRN, ERR_KICK -> Automatically raise exceptions -> E-Note: these take care of a lot of error cases RAISE ERR_SCRN IF OpenScreenTagList()=NIL -> Simple routine to demonstrate opening a screen with the new look. Simply -> supply the tag SA_PENS along with a minimal pen specification, Intuition -> will fill in all unspecified values with defaults. Since we are not -> supplying values, all are Intuition defaults. PROC main() HANDLE DEF my_screen=NIL:PTR TO screen -> E-Note: E automatically opens the Intuition library -> E-Note: use KickVersion rather than checking library version -> E-Note: Raise() exception rather than nesting conditionals IF KickVersion(37)=FALSE THEN Raise(ERR_KICK) -> The screen is opened two bitplanes deep so that the new look will show -> up better. -> E-Note: automatically error-checked (automatic exception) -> E-Note: pens is just a INT-typed list my_screen:=OpenScreenTagList(NIL, [SA_PENS, [-1]:INT, SA_DEPTH, 2, NIL]) -> Screen successfully opened Delay(30) -> Normally the program would be here -> E-Note: exit and clean up via handler EXCEPT DO IF my_screen THEN CloseScreen(my_screen) -> E-Note: we can print a minimal error message SELECT exception CASE ERR_SCRN; WriteF('Error: Failed to open custom screen\n') CASE ERR_KICK; WriteF('Error: Needs Kickstart V37+\n') ENDSELECT ENDPROC ?e-lh0-& & z)Src\Rkrm\Intuition\Screens\publicscreen.e4-> publicscreen.e - open a screen with the pens from a public screen MODULE 'intuition/screens' ENUM ERR_NONE, ERR_SCRN, ERR_LOCKPUB, ERR_GETDRAW RAISE ERR_SCRN IF OpenScreenTagList()=NIL, ERR_LOCKPUB IF LockPubScreen()=NIL, ERR_GETDRAW IF GetScreenDrawInfo()=NIL PROC main() IF KickVersion(37) -> Check the version. Release 2 is required for public screen functions -> E-Note: E automatically opens the Intuition library usePubScreenPens() ENDIF ENDPROC -> Open a screen that uses the pens of an existing public screen (the Workbench -> screen in this case). PROC usePubScreenPens() HANDLE DEF my_screen=NIL:PTR TO screen, pubScreenName, pub_screen=NIL:PTR TO screen, screen_drawinfo=NIL:PTR TO drawinfo pubScreenName:='Workbench' -> Get a lock on the Workbench screen -> E-Note: automatically error-checked (automatic exception) pub_screen:=LockPubScreen(pubScreenName) -> Get the DrawInfo structure from the locked screen -> E-Note: automatically error-checked (automatic exception) screen_drawinfo:=GetScreenDrawInfo(pub_screen) -> The pens are copied in the OpenScreenTagList() call, so we can simply use -> a pointer to the pens in the tag list. -> -> This works better if the depth and colors of the new screen matches that -> of the public screen. Here we are forcing the Workbench screen pens on a -> monochrome screen (which may not be a good idea). You could add the tag: -> (SA_DEPTH, screen_drawinfo.depth) -> E-Note: automatically error-checked (automatic exception) my_screen:=OpenScreenTagList(NIL, [SA_PENS, screen_drawinfo.pens, -> E-Note: try uncommenting next line (see above) -> SA_DEPTH, screen_drawinfo.depth, NIL]) -> We no longer need to hold the lock on the public screen or a copy of its -> DrawInfo structure as we now have our own screen. Release the screen. FreeScreenDrawInfo(pub_screen, screen_drawinfo) screen_drawinfo:=NIL UnlockPubScreen(pubScreenName, pub_screen) pub_screen:=NIL Delay(90) -> Should be the rest of the program -> E-Note: exit and clean up via handler EXCEPT DO -> The first two are freed in the main code if OpenScreenTagList() does not -> fail. If something goes wrong, free them here. IF screen_drawinfo THEN FreeScreenDrawInfo(pub_screen, screen_drawinfo) IF pub_screen THEN UnlockPubScreen(pubScreenName, pub_screen) IF my_screen THEN CloseScreen(my_screen) -> E-Note: we can print a minimal error message SELECT exception CASE ERR_SCRN; WriteF('Error: Failed to open custom screen\n') CASE ERR_LOCKPUB; WriteF('Error: Failed to locked public screen\n') CASE ERR_GETDRAW; WriteF('Error: Failed to get DrawInfo of screen\n') ENDSELECT ENDPROC @-lh0-uh*Src\Rkrm\Intuition\Screens\pubscreenbeep.e-> pubscreenbeep.e -> -> Simple example of how to find a public screen to work with in Release 2. -> E-Note: no need for modules, since we don't use anything that isn't built-in, -> but module 'intuition/screens' would be needed if we actually needed to know -> that "my_wbscreen_ptr" was a "PTR TO screen" rather than just a pointer... PROC main() DEF my_wbscreen_ptr -> Pointer to the Workbench screen IF KickVersion(36) -> OK, we have the right version of the OS so we can use the new public -> screen functions of Release 2 (V36) IF my_wbscreen_ptr:=LockPubScreen('Workbench') -> OK found the Workbench screen. Normally the program would be here. -> A window could be opened or the attributes of the screen copied DisplayBeep(my_wbscreen_ptr) UnlockPubScreen(NIL, my_wbscreen_ptr) ENDIF ELSE -> Prior to Release 2 (V36), there were no public screens, just Workbench. -> In those older systems, windows can be opened on Workbench without -> locking or a pointer by setting the Type=WBENCHSCREEN in object "nw". -> Attributes can be obtained by setting the Type argument to WBENCHSCREEN -> in the call to GetScreenData(). ENDIF ENDPROC ?]-lh0-~~z)Src\Rkrm\Intuition\Screens\screen34to37.e -> screen34to37.e -> -> Simple example to show how to open a custom screen that gives the new look -> under V37, yet still works with older version of the operating system. -> Attach the tag SA_PENS and a minimal pen specification to ExtNewScreen, and -> call the old OpenScreen() function. The tags will be ignored by V34 and -> earlier versions of the OS. In V36 and later the tags are accepted by -> Intuition. -> E-Note: you need to be more specific about modules than C does about includes MODULE 'intuition/screens', -> Screen data structures and tags 'graphics/view' -> Screen resolutions -> Exception values -> E-Note: exceptions are a much better way of handling errors ENUM ERR_NONE, ERR_SCRN -> Automatically raise exceptions -> E-Note: these take care of a lot of error cases RAISE ERR_SCRN IF OpenS()=NIL PROC main() HANDLE -> Pointer to our new, custom screen DEF my_screen=NIL:PTR TO screen -> E-Note: E automatically opens the Intuition library -> The screen is opened two bitplanes deep so that the new look will show -> up better. -> E-Note: automatically error-checked (automatic exception) -> E-Note: simplified using OpenS my_screen:=OpenS(640, -> Smaller values here reduce the STDSCREENHEIGHT, -> drawing area and save memory. 2, -> Two planes means 4 colours. V_HIRES, 'My Screen', -> Attach the pen specification tags -> E-Note: the tag list can be supplied directly -> E-Note: pens is just an INT-typed list [SA_PENS, [-1]:INT, -> E-Note: these tags replace the missing OpenS parameters SA_DETAILPEN, 0, SA_BLOCKPEN, 1, NIL]) -> Screen successfully opened Delay(200) -> Normally the program would be here -> E-Note: exit and clean up via handler EXCEPT DO IF my_screen THEN CloseS(my_screen) -> E-Note: we can print a minimal error message SELECT exception CASE ERR_SCRN; WriteF('Error: Failed to open custom screen\n') ENDSELECT ENDPROC ?-lh0- h)Src\Rkrm\Intuition\Special\remembertest.e-> RememberTest - Illustrates the use of AllocRemember() and FreeRemember(). -> E-Note: E's New() family of memory allocators are usually adequate... MODULE 'dos/dos', 'exec/memory' RAISE "MEM" IF AllocRemember()=NIL -> Random sizes to demonstrate the Remember functions. */ CONST SIZE_A=100, SIZE_B=200 PROC main() methodOne() methodTwo() ENDPROC RETURN_OK -> MethodOne -> Illustrates using AllocRemember() to allocate all memory and FreeRemember() -> to free it all. PROC methodOne() HANDLE DEF memBlockA=NIL, memBlockB=NIL, rememberKey=NIL memBlockA:=AllocRemember({rememberKey}, SIZE_A, MEMF_CLEAR OR MEMF_PUBLIC) memBlockB:=AllocRemember({rememberKey}, SIZE_B, MEMF_CLEAR OR MEMF_PUBLIC) -> Both memory allocations succeeded. -> The program may now use this memory. EXCEPT DO -> It is not necessary to keep track of the status of each allocation. -> Intuition has kept track of all successful allocations by updating its -> linked list of Remember nodes. The following call to FreeRemember() will -> deallocate any and all of the memory that was successfully allocated. -> The memory blocks as well as the link nodes will be deallocated because -> the "ReallyForget" parameter is TRUE. -> -> It is possible to have reached the call to FreeRemember() in one of three -> states. Here they are, along with their results. -> -> 1. Both memory allocations failed. -> RememberKey is still NIL. FreeRemember() will do nothing. -> 2. The memBlockA allocation succeeded but the memBlockB allocation failed. -> FreeRemember() will free the memory block pointed to by memBlockA. -> 3. Both memory allocations were successful. -> FreeRemember() will free the memory blocks pointed to by -> memBlockA and memBlockB. FreeRemember({rememberKey}, TRUE) ReThrow() -> E-Note: pass on exception if an error ENDPROC -> MethodTwo -> Illustrates using AllocRemember() to allocate all memory, FreeRemember() to -> free the link nodes, and FreeMem() to free the actual memory blocks. PROC methodTwo() HANDLE DEF memBlockA=NIL, memBlockB=NIL, rememberKey=NIL memBlockA:=AllocRemember({rememberKey}, SIZE_A, MEMF_CLEAR OR MEMF_PUBLIC) memBlockB:=AllocRemember({rememberKey}, SIZE_B, MEMF_CLEAR OR MEMF_PUBLIC) -> Both memory allocations succeeded. -> For the purpose of illustration, FreeRemember() is called at this point, -> but only to free the link nodes. The memory pointed to by memBlockA and -> memBlockB is retained. FreeRemember({rememberKey}, FALSE) -> Individually free the two memory blocks. The Exec FreeMem() call must be -> used, as the link nodes are no longer available. FreeMem(memBlockA, SIZE_A) FreeMem(memBlockB, SIZE_B) EXCEPT DO -> It is possible to have reached the call to FreeRemember() in one of three -> states. Here they are, along with their results. -> -> 1. Both memory allocations failed. -> RememberKey is still NIL. FreeRemember() will do nothing. -> 2. The memBlockA allocation succeeded but the memBlockB allocation failed. -> FreeRemember() will free the memory block pointed to by memBlockA. -> 3. Both memory allocations were successful. -> If this is the case, the program has already freed the link nodes with -> FreeRemember() and the memory blocks with FreeMem(). When -> FreeRemember() freed the link nodes, it reset RememberKey to NIL. -> This (second) call to FreeRemember() will do nothing. FreeRemember({rememberKey}, TRUE) ENDPROC 8K-lh0-f*f*"Src\Rkrm\Intuition\Windows\lines.e O-> lines.e -- implements a superbitmap with scroll gadgets -> This program requires V37, as it uses calls to OpenWindowTags(), -> LockPubScreen(). OPT PREPROCESS -> E-Note: enable use of macros MODULE 'layers', -> We are going to use the Layers library 'intuition/intuition', -> Intuition data structures and tags 'intuition/screens', -> Screen data structures and tags 'graphics/rastport', -> RastPort and other structures 'graphics/clip', -> Layer and other structures 'graphics/gfx', -> BitMap and other structures 'graphics/text', -> TextFont and other structures 'exec/memory' -> Memory flags ENUM ERR_NONE, ERR_LIB, ERR_KICK, ERR_PUB, ERR_RAST, ERR_WIN RAISE ERR_LIB IF OpenLibrary()=NIL, ERR_PUB IF LockPubScreen()=NIL, ERR_RAST IF AllocRaster()=NIL, ERR_WIN IF OpenWindowTagList()=NIL CONST WIDTH_SUPER=800, HEIGHT_SUPER=600, UP_DOWN_GADGET=0, LEFT_RIGHT_GADGET=1, NO_GADGET=2 -> E-Note: MAXPOT and MAXBODY should be used instead of MAXPROPVAL #define LAYERXOFFSET(x) (x.rport.layer.scroll_x) #define LAYERYOFFSET(x) (x.rport.layer.scroll_y) -> E-Note: need objects like botGad to be zeroed, so use pointers here DEF win=NIL:PTR TO window, botGadInfo=NIL:PTR TO propinfo, botGadImage=NIL:PTR TO image, botGad=NIL:PTR TO gadget, sideGadInfo=NIL:PTR TO propinfo, sideGadImage=NIL:PTR TO image, sideGad=NIL:PTR TO gadget PROC main() HANDLE DEF myscreen=NIL IF KickVersion(37)=FALSE THEN Raise(ERR_KICK) -> E-Note: E automatically opens the Intuition and Graphics libraries -> Open the Layers library for the program. -> E-Note: automatically error-checked (automatic exception) layersbase:=OpenLibrary('layers.library', 33) -> LockPubScreen()/UnlockPubScreen is only available under V36 and later. Use -> GetScreenData() under V34 systems to get a copy of the screen structure... -> E-Note: automatically error-checked (automatic exception) myscreen:=LockPubScreen(NIL) superWindow(myscreen) -> E-Note: exit and clean up via handler EXCEPT DO IF myscreen THEN UnlockPubScreen(NIL, myscreen) IF layersbase THEN CloseLibrary(layersbase) -> E-Note: we can print a minimal error message SELECT exception CASE ERR_KICK; WriteF('Error: Needs Kickstart V37+\n') CASE ERR_LIB; WriteF('Error: Could not open layers.library\n') CASE ERR_PUB; WriteF('Error: Could not lock public screen\n') CASE ERR_RAST; WriteF('Error: Ran out of memory in AllocRaster\n') CASE ERR_WIN; WriteF('Error: Failed to open window\n') CASE "MEM"; WriteF('Error: Ran out of memory\n') ENDSELECT ENDPROC -> A string with this format will be found by the version command supplied by -> Commodore. This will allow users to give version numbers with error reports. -> E-Note: labels can only be used after the first PROC line... vers: CHAR '$VER: lines 37.2',0 -> Create, initialise and process the super bitmap window. Cleanup if any error. PROC superWindow(myscreen:PTR TO screen) HANDLE DEF bigBitMap=NIL:PTR TO bitmap, planeNum, mydepth -> Set-up the border prop gadgets for the OpenWindow() call. initBorderProps(myscreen) -> The code relies on the allocation of the BitMap structure with the -> MEMF_CLEAR flag. This allows the assumption that all of the bitmap -> pointers are NIL, except those successfully allocated by the program. -> E-Note: NewM raises an exception if it fails bigBitMap:=NewM(SIZEOF bitmap, MEMF_PUBLIC OR MEMF_CLEAR) mydepth:=myscreen.bitmap.depth InitBitMap(bigBitMap, mydepth, WIDTH_SUPER, HEIGHT_SUPER) -> E-Note: we handle errors with exceptions FOR planeNum:=0 TO mydepth-1 bigBitMap.planes[planeNum]:=AllocRaster(WIDTH_SUPER, HEIGHT_SUPER) ENDFOR -> Only open the window if the bitplanes were successfully allocated. Fail -> via exception if they were not. -> OpenWindowTags() and OpenWindowTagList() are only available when the -> library version is at least V36. Under earlier versions of Intuition, use -> OpenWindow() with a NewWindow structure. win:=OpenWindowTagList(NIL, [WA_WIDTH, 150, WA_HEIGHT, (4*(myscreen.wbortop+myscreen.font.ysize+1)), WA_MAXWIDTH, WIDTH_SUPER, WA_MAXHEIGHT, HEIGHT_SUPER, WA_IDCMP, IDCMP_GADGETUP OR IDCMP_GADGETDOWN OR IDCMP_NEWSIZE OR IDCMP_INTUITICKS OR IDCMP_CLOSEWINDOW, WA_FLAGS, WFLG_SIZEGADGET OR WFLG_SIZEBRIGHT OR WFLG_SIZEBBOTTOM OR WFLG_DRAGBAR OR WFLG_DEPTHGADGET OR WFLG_CLOSEGADGET OR WFLG_SUPER_BITMAP OR WFLG_GIMMEZEROZERO OR WFLG_NOCAREREFRESH, WA_GADGETS, sideGad, WA_TITLE, {vers}+6, -> Take title from version string WA_PUBSCREEN, myscreen, WA_SUPERBITMAP, bigBitMap, NIL]) -> Set-up the window display SetRast(win.rport, 0) -> Clear the bitplanes SetDrMd(win.rport, RP_JAM1) doNewSize() -> Adjust props to represent portion visible doDrawStuff() -> Process the window, return on IDCMP_CLOSEWINDOW doMsgLoop() -> E-Note: exit and clean up via handler EXCEPT DO IF win THEN CloseWindow(win) IF bigBitMap FOR planeNum:=0 TO mydepth-1 -> Free only the bitplanes actually allocated... IF bigBitMap.planes[planeNum] FreeRaster(bigBitMap.planes[planeNum], WIDTH_SUPER, HEIGHT_SUPER) ENDIF ENDFOR Dispose(bigBitMap) ENDIF ReThrow() -> E-Note: pass exception on if it was an error ENDPROC -> Set-up the prop gadgets -- initialise them to values that fit into the -> window border. The height of the prop gadget on the side of the window -> takes the height of the title bar into account in its set-up. Note the -> initialisation assumes a fixed size "sizing" gadget. -> -> Note also, that the size of the sizing gadget is dependent on the screen -> resolution. The numbers given here are only valid if the screen is NOT -> lo-res. These values must be re-worked slightly for lo-res screens. -> -> The PROPNEWLOOK flag is ignored by 1.3. PROC initBorderProps(myscreen:PTR TO screen) DEF top -> E-Note: temp variable for top calc -> Initialises the two prop gadgets. -> -> Note where the PROPNEWLOOK flag goes. Adding this flag requires no extra -> storage, but tells the system that our program is expecting the new-look -> prop gadgets under 2.0. -> E-Note: we initialise using typed lists and NEW, so that we do not need -> to fill in every field (NEW will zero the trailing ones). -> Without NEW only a partial structure would be allocated... -> E-Note: allocate zeroed images NEW botGadImage, sideGadImage botGadInfo:=NEW [AUTOKNOB OR FREEHORIZ OR PROPNEWLOOK, 0, 0, -1, -1]:propinfo botGad:=NEW [NIL, 3, -7, -23, 6, GFLG_RELBOTTOM OR GFLG_RELWIDTH, GACT_RELVERIFY OR GACT_IMMEDIATE OR GACT_BOTTOMBORDER, GTYP_PROPGADGET OR GTYP_GZZGADGET, botGadImage, NIL, NIL, NIL, botGadInfo, LEFT_RIGHT_GADGET]:gadget sideGadInfo:=NEW [AUTOKNOB OR FREEVERT OR PROPNEWLOOK, 0, 0, -1, -1]:propinfo -> NOTE the TopEdge adjustment for the border and the font for V36. top:=myscreen.wbortop+myscreen.font.ysize+2 sideGad:=NEW [botGad, -14, top, 12, -top-11, GFLG_RELRIGHT OR GFLG_RELHEIGHT, GACT_RELVERIFY OR GACT_IMMEDIATE OR GACT_RIGHTBORDER, GTYP_PROPGADGET OR GTYP_GZZGADGET, sideGadImage, NIL, NIL, NIL, sideGadInfo, UP_DOWN_GADGET]:gadget ENDPROC -> This function does all the work of drawing the lines PROC doDrawStuff() DEF x1, y1, x2, y2, pen, ncolors, deltx, delty ncolors:=Shl(1, win.wscreen.bitmap.depth) -> E-Note: Rnd could be seeded using VbeamPos... deltx:=Rnd(6)+2 delty:=Rnd(6)+2 pen:=Rnd(ncolors-1)+1 SetAPen(win.rport, pen) x1:=0; y1:=0; x2:=WIDTH_SUPER-1; y2:=HEIGHT_SUPER-1 WHILE x1 < WIDTH_SUPER Move(win.rport, x1, y1) Draw(win.rport, x2, y2) x1:=x1+deltx x2:=x2-deltx ENDWHILE pen:=Rnd(ncolors-1)+1 SetAPen(win.rport, pen) x1:=0; y1:=0; x2:=WIDTH_SUPER-1; y2:=HEIGHT_SUPER-1 WHILE y1 < HEIGHT_SUPER Move(win.rport, x1, y1) Draw(win.rport, x2, y2) y1:=y1+delty y2:=y2-delty ENDWHILE ENDPROC -> This function provides a simple interface to ScrollLayer PROC slideBitMap(dx, dy) ScrollLayer(0, win.rport.layer, dx, dy) ENDPROC -> E-Note: define macros to compute fraction of Pot and Body -> E-Note: use Mul() and Div() since definitely over 16-bits #define FRACTIONPOT(n,d) (Div(Mul(n, MAXPOT), d)) #define FRACTIONBODY(n,d) (Div(Mul(n, MAXBODY), d)) -> Update the prop gadgets and bitmap positioning when the size changes. PROC doNewSize() DEF tmp tmp:=LAYERXOFFSET(win) + win.gzzwidth IF tmp>=WIDTH_SUPER THEN slideBitMap(WIDTH_SUPER-tmp, 0) NewModifyProp(botGad, win, NIL, AUTOKNOB OR FREEHORIZ, FRACTIONPOT(LAYERXOFFSET(win), WIDTH_SUPER - win.gzzwidth), NIL, FRACTIONBODY(win.gzzwidth, WIDTH_SUPER), MAXBODY, 1) tmp:=LAYERYOFFSET(win) + win.gzzheight IF tmp>=HEIGHT_SUPER THEN slideBitMap(0, HEIGHT_SUPER-tmp) NewModifyProp(sideGad, win, NIL, AUTOKNOB OR FREEVERT, NIL, FRACTIONPOT(LAYERYOFFSET(win), HEIGHT_SUPER - win.gzzheight), MAXBODY, FRACTIONBODY(win.gzzheight, HEIGHT_SUPER), 1) ENDPROC -> E-Note: convert signed INT from a Pot to unsigned for calculations #define UNSIGNED(x) (x AND $FFFF) -> E-Note: define macro to compute layer offset from Pot value -> E-Note: use Mul() and Div() since definitely over 16-bits #define CALCOFFSET(size, pot) (Div(Mul(size, UNSIGNED(pot)), MAXPOT)) -> Process the currently selected gadget. This is called from IDCMP_INTUITICKS -> and when the gadget is released IDCMP_GADGETUP. PROC checkGadget(gadgetID) DEF tmp, dx=0, dy=0 SELECT gadgetID CASE UP_DOWN_GADGET tmp:=CALCOFFSET(HEIGHT_SUPER-win.gzzheight, sideGadInfo.vertpot) dy:=tmp - LAYERYOFFSET(win) CASE LEFT_RIGHT_GADGET tmp:=CALCOFFSET(WIDTH_SUPER-win.gzzwidth, botGadInfo.horizpot) dx:=tmp - LAYERXOFFSET(win) ENDSELECT IF dx OR dy THEN slideBitMap(dx, dy) ENDPROC -> Main message loop for the window. -> E-Note: E version is simpler, since we use WaitIMessage PROC doMsgLoop() DEF class, currentGadget=NO_GADGET, g:PTR TO gadget -> E-Note: g is used to cast the type of MsgIaddr() REPEAT class:=WaitIMessage(win) SELECT class CASE IDCMP_NEWSIZE doNewSize() doDrawStuff() CASE IDCMP_GADGETDOWN g:=MsgIaddr() currentGadget:=g.gadgetid CASE IDCMP_GADGETUP checkGadget(currentGadget) currentGadget:=NO_GADGET CASE IDCMP_INTUITICKS checkGadget(currentGadget) ENDSELECT UNTIL class=IDCMP_CLOSEWINDOW ENDPROC A-lh0-3z+Src\Rkrm\Intuition\Windows\openwindowtags.e$"-> openwindowtags.e - open a window using tags MODULE 'intuition/intuition' -> Intuition data structures and tags CONST MY_WIN_LEFT=20, MY_WIN_TOP=10, MY_WIN_WIDTH=300, MY_WIN_HEIGHT=110 ENUM ERR_NONE, ERR_WIN, ERR_KICK RAISE ERR_WIN IF OpenWindowTagList()=NIL -> Open a simple window using OpenWindowTagList() PROC main() HANDLE DEF win=NIL -> These calls are only valid if we have Intuition version 37 or greater IF KickVersion(37)=FALSE THEN Raise(ERR_KICK) win:=OpenWindowTagList(NIL, [WA_LEFT, MY_WIN_LEFT, WA_TOP, MY_WIN_TOP, WA_WIDTH, MY_WIN_WIDTH, WA_HEIGHT, MY_WIN_HEIGHT, WA_CLOSEGADGET, TRUE, WA_IDCMP, IDCMP_CLOSEWINDOW, NIL]) -> Window successfully opened here handle_window_events(win) -> E-Note: exit and clean up via handler EXCEPT DO IF win THEN CloseWindow(win) -> E-Note: we can print a minimal error message SELECT exception CASE ERR_WIN; WriteF('Error: Failed to open window\n') CASE ERR_KICK; WriteF('Error: Needs Kickstart V37+\n') ENDSELECT ENDPROC -> Normally this routine would contain an event loop like the one given in the -> chapter "Intuition Input and Output Methods". Here we just wait for any -> messages we requested to appear at the Window's port. PROC handle_window_events(win) -> E-Note: we can use E's special message poller WaitIMessage(win) ENDPROC @-lh0-Az*Src\Rkrm\Intuition\Windows\visiblewindow.eŁ-> visiblewindow.e -> Open a window on the visible part of a screen, with the window as large as -> the visible part of the screen. It is assumed that the visible part of the -> screen is OSCAN_TEXT, which how the user has set their preferences. MODULE 'intuition/intuition', -> Intuition data structures and tags 'intuition/screens', -> Screen data structures and tags 'graphics/gfx', -> Graphics structures 'graphics/modeid' -> Release 2 Amiga display mode ID's ENUM ERR_NONE, ERR_WIN, ERR_PUB RAISE ERR_WIN IF OpenWindowTagList()=NIL, ERR_PUB IF LockPubScreen()=NIL -> Minimum window width and height: These values should really be calculated -> dynamically given the size of the font and the window borders. Here, to -> keep the example simple they are hard-coded values. CONST MIN_WINDOW_WIDTH=100, MIN_WINDOW_HEIGHT=50 -> E-Note: minimum and maximum are built-in PROC main() -> These calls are only valid if we have version 37 or greater -> E-Note: E automatically opens the Intuition and Graphics libraries IF KickVersion(37) fullScreen() ELSE -> E-Note: we can print a minimal error WriteF('Error: Needs Kickstart V37+\n') ENDIF ENDPROC -> Open a window on the default public screen, then leave it open until the -> user selects the close gadget. The window is full-sized, positioned in the -> currently visible OSCAN_TEXT area. PROC fullScreen() HANDLE DEF test_window=NIL:PTR TO window, pub_screen=NIL:PTR TO screen, rect:rectangle, screen_modeID, -> Set some reasonable defaults for left, top, width and height -> We'll pick up the real values with the call to QueryOverscan() left=0, top=0, width=640, height=200 -> Get a lock on the default public screen -> E-Note: automatically error-checked (automatic exception) pub_screen:=LockPubScreen(NIL) -> This technique returns the text overscan rectangle of the screen that we -> are opening on. If you really need the actual value set into the display -> clip of the screen, use the VideoControl() command of the graphics library -> to return a copy of the ViewPortExtra structure. See the Graphics library -> chapter and Autodocs for more details. -> -> GetVPModeID() is a graphics call... IF (screen_modeID:=GetVPModeID(pub_screen.viewport))<>INVALID_ID IF QueryOverscan(screen_modeID, rect, OSCAN_TEXT) -> Make sure window coordinates are positive or zero left := Max(0, -pub_screen.leftedge) top := Max(0, -pub_screen.topedge) -> Get width and height from size of display clip width:=rect.maxx-rect.minx+1 height:=rect.maxy-rect.miny+1 -> Adjust height for pulled-down screen (only show visible part) IF pub_screen.topedge > 0 height:=height-pub_screen.topedge ENDIF -> Ensure that window fits on screen height:=Min(height,pub_screen.height) width:=Min(width,pub_screen.width) -> Make sure window is at least minimum size width:=Max(width, MIN_WINDOW_WIDTH) height:=Max(height, MIN_WINDOW_HEIGHT) ENDIF ENDIF -> Open the window on the public screen -> E-Note: automatically error-checked (automatic exception) test_window:=OpenWindowTagList(NIL, [WA_LEFT, left, WA_WIDTH, width, WA_TOP, top, WA_HEIGHT, height, WA_CLOSEGADGET, TRUE, WA_IDCMP, IDCMP_CLOSEWINDOW, WA_PUBSCREEN, pub_screen, NIL]) -> Unlock the screen. The window now acts as a lock on the screen, and we do -> not need the screen after the window has been closed. UnlockPubScreen(NIL, pub_screen) -> E-Note: set it to NIL to help deal with errors pub_screen:=NIL -> If we have a valid window open, run the rest of the program, then clean -> up when done. handle_window_events(test_window) -> E-Note: exit and clean up via handler EXCEPT DO IF test_window THEN CloseWindow(test_window) IF pub_screen THEN UnlockPubScreen(NIL, pub_screen) -> E-Note: we can print a minimal error message SELECT exception CASE ERR_PUB; WriteF('Error: Could not lock public screen\n') CASE ERR_WIN; WriteF('Error: Failed to open window\n') ENDSELECT ENDPROC -> Wait for the user to select the close gadget. PROC handle_window_events(win) -> E-Note: we can use E's special message poller REPEAT UNTIL WaitIMessage(win)=IDCMP_CLOSEWINDOW ENDPROC ?T-lh0-Nz)Src\Rkrm\Intuition\Windows\winpubscreen.eH-> winpubscreen.e -> Open a window on the default public screen (usually the Workbench screen) MODULE 'intuition/intuition' -> Intuition data structures and tags ENUM ERR_NONE, ERR_WIN, ERR_KICK, ERR_PUB RAISE ERR_WIN IF OpenWindowTagList()=NIL, ERR_PUB IF LockPubScreen()=NIL -> Open a simple window on the default public screen, then leave it open until -> the user selects the close gadget. PROC main() HANDLE DEF test_window=NIL, test_screen=NIL IF KickVersion(37)=FALSE THEN Raise(ERR_KICK) -> Get a lock on the default public screen test_screen:=LockPubScreen(NIL) -> Open the window on the public screen test_window:=OpenWindowTagList(NIL, [WA_LEFT, 10, WA_TOP, 20, WA_WIDTH, 300, WA_HEIGHT, 100, WA_DRAGBAR, TRUE, WA_CLOSEGADGET, TRUE, WA_SMARTREFRESH, TRUE, WA_NOCAREREFRESH, TRUE, WA_IDCMP, IDCMP_CLOSEWINDOW, WA_TITLE, 'Window Title', WA_PUBSCREEN, test_screen, NIL]) -> Unlock the screen. The window now acts as a lock on the screen, and we do -> not need the screen after the window has been closed. UnlockPubScreen(NIL, test_screen) -> Note: set it to NIL to help deal with errors test_screen:=NIL -> If we have a valid window open, run the rest of the program, then clean up -> when done. handle_window_events(test_window) -> Note: exit and clean up via handler EXCEPT DO IF test_window THEN CloseWindow(test_window) IF test_screen THEN UnlockPubScreen(NIL, test_screen) -> Note: we can print a minimal error message SELECT exception CASE ERR_KICK; WriteF('Error: Needs Kickstart V37+\n') CASE ERR_PUB; WriteF('Error: Could not lock public screen\n') CASE ERR_WIN; WriteF('Error: Failed to open window\n') ENDSELECT ENDPROC -> Wait for the user to select the close gadget. PROC handle_window_events(win) -> Note: we can use E's special message poller REPEAT UNTIL WaitIMessage(win)=IDCMP_CLOSEWINDOW ENDPROC 1Y-lh0-ԙ4Src\Rkrm\Keymap\appkeymap.e-> appkeymap.e - Subroutines to copy the default keymap, modify the copy -> -> Usage: (PTR TO keymap) appkeymap:=createAppKeyMap() -> PROC deleteAppKeyMap(appkeymap:PTR TO keymap) -> -> This example modifies the copied keymap by unmapping all of the numeric -> keypad keys. This creates a good keymap for use with either keymap.library -> MapANSI() or commodities InvertString(). If you used a default keymap with -> the above functions, numeric keypad raw key values would be returned for -> keys which are available with fewer keypresses on numeric pad than on the -> normal keyboard. It is generally preferable to have the normal keyboard -> raw values since many applications attach special meanings to numeric pad -> keys. The AlterAppKeyMap() routine in this module could easilty be -> modified to instead set new values for numeric pad or function keys. -> -> IMPORTANT: Do Not Use SetKeyMapDefault() unless you are a system -> preferences editor OR an application that takes over the machine. If you -> want to use a customized keymap such as this in your application, open your -> own Intuition window, attach a console device to it, and then use the -> console device SETKEYMAP command to set your console device unit to your -> custom keymap. ->>> Header (globals) OPT MODULE MODULE 'keymap', 'devices/keymap' ENUM ERR_NONE, ERR_ASK, ERR_LIB RAISE ERR_ASK IF AskKeyMapDefault()=NIL, ERR_LIB IF OpenLibrary()=NIL -> Raw keys we might want to remap which are the same on all keyboards EXPORT ENUM UP_KEY=$4C, DOWN_KEY, RIGHT_KEY, LEFT_KEY, F1_KEY, F2_KEY, F3_KEY, F4_KEY, F5_KEY, F6_KEY, F7_KEY, F8_KEY, F9_KEY, F10_KEY EXPORT CONST N0_KEY=$0F, N1_KEY=$1D, N2_KEY=$1E, N3_KEY=$1F, N4_KEY=$2D, N5_KEY=$2E, N6_KEY=$2F, N7_KEY=$3D, N8_KEY=$3E, N9_KEY=$3F EXPORT CONST NPERIOD_KEY=$3C, NOPAREN_KEY=$5A, NCPAREN_KEY=$5B, NSLASH_KEY=$5C, NASTER_KEY=$5D, NMINUS_KEY=$4A, NPLUS_KEY=$5E, NENTER_KEY=$43 EXPORT CONST RETURN_KEY=$44, HELP_KEY=$5F -> Count of elements in keymap arrays EXPORT CONST MAP_SIZE=64, TYPE_SIZE=64, CAPS_SIZE=8, REPS_SIZE=8 EXPORT CONST MAP_SIZE_P=MAP_SIZE*2, TYPE_SIZE_P=TYPE_SIZE*2, CAPS_SIZE_P=CAPS_SIZE*2, REPS_SIZE_P=REPS_SIZE*2 -> We allocate our Lo and Hi array pairs each as a single array EXPORT OBJECT keyMapArrays lhKeyMap[MAP_SIZE_P]:ARRAY OF LONG lhKeyMapTypes[TYPE_SIZE_P]:ARRAY lhCapsable[CAPS_SIZE_P]:ARRAY lhRepeatable[REPS_SIZE_P]:ARRAY ENDOBJECT DEF karrays:PTR TO keyMapArrays, defkeymap:PTR TO keymap, appkeymap:PTR TO keymap, mapsize ->>> ->>> EXPORT PROC createAppKeyMap() EXPORT PROC createAppKeyMap() HANDLE keymapbase:=OpenLibrary('keymap.library', 37) defkeymap:=NIL -> E-Note: help with error trapping -> Get a pointer to the keymap which is set as the system default defkeymap:=AskKeyMapDefault() -> Allocate our KeyMap structures and arrays mapsize:=SIZEOF keymap+SIZEOF keyMapArrays appkeymap:=NIL appkeymap:=NewR(mapsize) -> Init our appkeymap fields to point to our allocated arrays. -> Each LH array contains a Lo and a Hi array. -> E-Note: the +1 in the C version means +SIZEOF keymap karrays:=appkeymap+SIZEOF keymap appkeymap.lokeymap:=karrays.lhKeyMap appkeymap.hikeymap:=karrays.lhKeyMap+(MAP_SIZE*(SIZEOF LONG)) appkeymap.lokeymaptypes:=karrays.lhKeyMapTypes appkeymap.hikeymaptypes:=karrays.lhKeyMapTypes+TYPE_SIZE appkeymap.locapsable:=karrays.lhCapsable appkeymap.hicapsable:=karrays.lhCapsable+CAPS_SIZE appkeymap.lorepeatable:=karrays.lhRepeatable appkeymap.hirepeatable:=karrays.lhRepeatable+REPS_SIZE -> Copy the user's default system keymap arrays to our appkeymap arrays to -> get the proper keymappings for the user's keyboard. copyKeyMap(defkeymap, appkeymap) -> Now make our changes to our appkeymap alterAppKeyMap(appkeymap) EXCEPT DO IF keymapbase THEN CloseLibrary(keymapbase) ENDPROC appkeymap ->>> ->>> EXPORT PROC deleteAppKeyMap(appkeymap:PTR TO keymap) EXPORT PROC deleteAppKeyMap(appkeymap:PTR TO keymap) IF appkeymap THEN Dispose(appkeymap) ENDPROC ->>> ->>> PROC alterAppKeyMap(appkeymap:PTR TO keymap) PROC alterAppKeyMap(appkeymap:PTR TO keymap) DEF nullkeys, keymappings:PTR TO LONG, keymaptypes, rawkeynum, i -> NIL terminated ARRAY of keys our application wants to remap or disable nullkeys:=[N0_KEY, N1_KEY, N2_KEY, N3_KEY, N4_KEY, N5_KEY, N6_KEY, N7_KEY, N8_KEY, N9_KEY, NPERIOD_KEY, NOPAREN_KEY, NCPAREN_KEY, NSLASH_KEY, NASTER_KEY, NMINUS_KEY, NPLUS_KEY, NENTER_KEY, NIL]:CHAR -> Our application wants numeric pad keys remapped to nothing so that we can -> use this keymap with MapANSI and NOT get back raw codes for numeric -> keypad. Alternatively (for example) you could set the types to -> KCF_STRING and set the mappings to point to NIL terminated strings. keymappings:=appkeymap.lokeymap keymaptypes:=appkeymap.lokeymaptypes i:=0 WHILE rawkeynum:=nullkeys[i] -> Because we allocated each of our Lo and Hi ARRAY pairs as sequential -> memory, we can use the RAWKEY values directly to index into our -> sequential Lo/Hi ARRAY keymaptypes[rawkeynum]:=KCF_NOP INC i ENDWHILE ENDPROC ->>> ->>> PROC copyKeyMap(s:PTR TO keymap, d:PTR TO keymap) PROC copyKeyMap(s:PTR TO keymap, d:PTR TO keymap) DEF bb, ll:PTR TO LONG, i -> Copy keymap s (source) to keymap d (dest) ll:=s.lokeymap FOR i:=0 TO MAP_SIZE-1 DO d.lokeymap[i]:=ll[]++ ll:=s.hikeymap FOR i:=0 TO MAP_SIZE-1 DO d.hikeymap[i]:=ll[]++ bb:=s.lokeymaptypes FOR i:=0 TO TYPE_SIZE-1 DO d.lokeymaptypes[i]:=bb[]++ bb:=s.hikeymaptypes FOR i:=0 TO TYPE_SIZE-1 DO d.hikeymaptypes[i]:=bb[]++ bb:=s.locapsable FOR i:=0 TO CAPS_SIZE-1 DO d.locapsable[i]:=bb[]++ bb:=s.hicapsable FOR i:=0 TO CAPS_SIZE-1 DO d.hicapsable[i]:=bb[]++ bb:=s.lorepeatable FOR i:=0 TO REPS_SIZE-1 DO d.lorepeatable[i]:=bb[]++ bb:=s.hirepeatable FOR i:=0 TO REPS_SIZE-1 DO d.hirepeatable[i]:=bb[]++ ENDPROC ->>> 1-lh0-PPԙ4Src\Rkrm\Keymap\appkeymap.mEMOD NUH/,/,/,)OAP)H)MCp%,lNJf /<N\)@p)@,lNJf /<N\)@)|p)@/,N^O)@ , )@ lA  l!@ lA /p@/p" " Ё l!@ lA  l lA @ l!@ lA  l!@ lA P l!@ lA  l!@ lA P l!@/,/,aO/,aXO)_)_)_B ,g"l,lNb ,LN]NuNU -Jg/-NMOpN]NuNUHA `-./=>?deleteAppKeyMap appkeymapcreateAppKeyMap,PD8$t@fJ keymapbasetlNDxnlkeyMapArrays lhKeyMaplhKeyMapTypes lhCapsablelhRepeatable REPS_SIZE_P CAPS_SIZE_P TYPE_SIZE_P MAP_SIZE_P _HELP_KEY DRETURN_KEY CNENTER_KEY ^NPLUS_KEY JNMINUS_KEY ]NASTER_KEY \NSLASH_KEY [NCPAREN_KEY ZNOPAREN_KEY N8_KEY=N7_KEY/N6_KEY.N5_KEY-N4_KEYN3_KEYN2_KEYN1_KEYN0_KEYYF10_KEYXF9_KEYWF8_KEYVF7_KEYUF6_KEYTF5_KEYSF4_KEYRF3_KEYQF2_KEYPF1_KEY OLEFT_KEY NRIGHT_KEY MDOWN_KEYLUP_KEY REPS_SIZE CAPS_SIZE @TYPE_SIZE @MAP_SIZE/5-lh0- ԙ4Src\Rkrm\Keymap\mapansi.e-> mapansi.e - Converts a string to input events using MapANSI() function. -> -> This example will also take the created input events and add them to the -> input stream using the simple commodities.library function AddIEvents(). -> Alternately, you could open the input.device and use the input device -> command IND_WRITEEVENT to add events to the input stream. ->>> Header (globals) MODULE 'commodities', 'keymap', 'devices/inputevent' ENUM ERR_NONE, ERR_INT, ERR_LIB, ERR_OVER RAISE ERR_LIB IF OpenLibrary()=NIL DEF inputEvent=NIL:PTR TO inputevent ->>> ->>> PROC main() PROC main() HANDLE DEF string, tmp1, tmp2, i, iebuffer[6]:ARRAY -> Space for two dead keys + 1 key + qualifiers openall() string:=';String converted to input events and sent to input device\n' inputEvent.class:=IECLASS_RAWKEY -> Turn each character into an inputevent tmp1:=string WHILE tmp1[] -> Convert one character, use default key map i:=MapANSI(tmp1, 1, iebuffer, 3, NIL) -> Make sure we start without deadkeys inputEvent.prev1downcode:=0 inputEvent.prev1downqual:=0 inputEvent.prev2downcode:=0 inputEvent.prev2downqual:=0 tmp2:=iebuffer SELECT i CASE -2 WriteF('Internal error\n') Raise(ERR_INT) CASE -1 WriteF('Overflow\n') Raise(ERR_OVER) CASE 0 WriteF('Can''t generate code\n') CASE 3 inputEvent.prev2downcode:=tmp2[]++ inputEvent.prev2downqual:=tmp2[]++ inputEvent.prev1downcode:=tmp2[]++ inputEvent.prev1downqual:=tmp2[]++ inputEvent.code:=tmp2[]++ inputEvent.qualifier:=tmp2[] CASE 2 inputEvent.prev1downcode:=tmp2[]++ inputEvent.prev1downqual:=tmp2[]++ inputEvent.code:=tmp2[]++ inputEvent.qualifier:=tmp2[] CASE 1 inputEvent.code:=tmp2[]++ inputEvent.qualifier:=tmp2[] ENDSELECT -> Send the key down event AddIEvents(inputEvent) -> Create a key up event inputEvent.code:=inputEvent.code OR IECODE_UP_PREFIX -> Send the key up event AddIEvents(inputEvent) tmp1++ ENDWHILE EXCEPT DO closeall() SELECT exception CASE ERR_INT; WriteF('Error: MapANSI() internal error\n') CASE ERR_LIB; WriteF('Error: could not open required library\n') CASE ERR_OVER; WriteF('Error: MapANSI() overflow error\n') CASE "MEM"; WriteF('Error: ran out of memory\n') ENDSELECT ENDPROC ->>> ->>> PROC openall() PROC openall() keymapbase:=OpenLibrary('keymap.library', 37) cxbase:=OpenLibrary('commodities.library', 37) NEW inputEvent ENDPROC ->>> ->>> PROC closeall() PROC closeall() IF inputEvent THEN END inputEvent IF cxbase THEN CloseLibrary(cxbase) IF keymapbase THEN CloseLibrary(keymapbase) ENDPROC ->>> 1-lh0-  ԙ4Src\Rkrm\Keymap\maprawkey.e#a-> maprawkey.e - Map Intuition RAWKEY events to ANSI with MapRawKey() ->>> Header (globals) OPT PREPROCESS MODULE 'keymap', 'devices/inputevent', 'exec/ports', 'intuition/intuition' ENUM ERR_NONE, ERR_LIB, ERR_WIN RAISE ERR_LIB IF OpenLibrary()=NIL, ERR_WIN IF OpenWindowTagList()=NIL -> E-Note: used to convert an INT to unsigned #define UNSIGNED(x) ((x) AND $FFFF) DEF window=NIL:PTR TO window ->>> ->>> PROC main() PROC main() HANDLE DEF imsg:PTR TO intuimessage, eventptr:PTR TO LONG, windowsignal, inputevent:PTR TO inputevent, buffer[8]:ARRAY, i, going=TRUE, class openall() window:=OpenWindowTagList(NIL, [WA_WIDTH, 500, WA_HEIGHT, 60, WA_TITLE, 'MapRawKey - Press Keys', WA_FLAGS, WFLG_CLOSEGADGET OR WFLG_ACTIVATE, WA_IDCMP, IDCMP_RAWKEY OR IDCMP_CLOSEWINDOW, NIL]) windowsignal:=Shl(1, window.userport.sigbit) -> Initialise inputevent object -> E-Note: first allocate it cleared using NEW NEW inputevent inputevent.class:=IECLASS_RAWKEY WHILE going Wait(windowsignal) WHILE imsg:=GetMsg(window.userport) class:=imsg.class SELECT class CASE IDCMP_CLOSEWINDOW going:=FALSE CASE IDCMP_RAWKEY inputevent.code:=imsg.code inputevent.qualifier:=UNSIGNED(imsg.qualifier) WriteF('RAWKEY: Code=$\z\h[4] Qualifier=$\z\h[4]\n', imsg.code, UNSIGNED(imsg.qualifier)) -> Make sure deadkeys and qualifiers are taken into account. eventptr:=imsg.iaddress inputevent.eventaddress:=eventptr[] -> Map RAWKEY to ANSI i:=MapRawKey(inputevent, buffer, 8, NIL) IF i=-1 WriteF('*Overflow*') ELSEIF i -> This key or key combination mapped to something WriteF('MAPS TO: ') Write(stdout, buffer, i) WriteF('\n') ENDIF ENDSELECT ReplyMsg(imsg) ENDWHILE ENDWHILE EXCEPT DO IF window THEN CloseWindow(window) closeall() SELECT exception CASE ERR_LIB; WriteF('Error: could not open keymap library\n') CASE ERR_WIN; WriteF('Error: could not open window\n') CASE "MEM"; WriteF('Error: ran out of memory\n') ENDSELECT ENDPROC ->>> ->>> PROC openall() PROC openall() keymapbase:=OpenLibrary('keymap.library', 37) ENDPROC ->>> ->>> PROC closeall() PROC closeall() IF keymapbase THEN CloseLibrary(keymapbase) ENDPROC ->>> ,-lh0-ՙ4Src\Rkrm\Math\dpieee.e7-> dpieee.e - Math DP IEEE example of dTst(). ->>> Header (globals) MODULE 'tools/longreal' CONST STRSIZE=20 CONST FRACTSIZE=STRSIZE-8 ->>> ->>> PROC main() PROC main() HANDLE -> E-Note: use the longreals from 'tools/longreal' for double precision IEEE DEF num1:longreal, result, six:longreal, s[STRSIZE]:STRING dInit(FALSE) -> E-Note: only use mathieeedoubbas library dDiv(dPi(num1), dFloat(-6,six), num1) -> -30 degrees in radians -> E-Note: or alternatively use dInit(TRUE) and dRad(dFloat(-30,num1), num1) result:=dTst(num1) WriteF('Num1 = \s and result = \d\n', dFormat(s, num1, FRACTSIZE), result) EXCEPT DO dCleanup() SELECT exception CASE "DLIB"; WriteF('Error: could not open mathieeedoubbas library\n') ENDSELECT ENDPROC ->>> --lh0-ՙ4Src\Rkrm\Math\dptrans.e'-> dptrans.e - Math Double-Precision Transcendental example of dSin(). ->>> Header (globals) MODULE 'tools/longreal' CONST STRSIZE=20 CONST FRACTSIZE=STRSIZE-8 ->>> ->>> PROC main() PROC main() HANDLE -> E-Note: use the longreals from 'tools/longreal' for double precision IEEE DEF num1:longreal, result:longreal, four:longreal, s[STRSIZE]:STRING dInit() dDiv(dPi(num1), dFloat(4, four), num1) -> E-Note: or alternatively use dRad(dFloat(45, num1), num1) dSin(num1, result) WriteF('The double precision sine of 45 degrees is \s\n', dFormat(s, result, FRACTSIZE)) EXCEPT DO dCleanup() SELECT exception CASE "DLIB"; WriteF('Error: could not open mathieeedoubbas library\n') ENDSELECT ENDPROC ->>> ,-lh0-ddԙ4Src\Rkrm\Math\spieee.eº-> spieee.e - Math SP IEEE example of SPMul(). ->>> Header (globals) MODULE 'mathieeesingbas' ENUM ERR_NONE, ERR_LIB RAISE ERR_LIB IF OpenLibrary()=NIL CONST STRSIZE=10, ACC=5 ->>> ->>> PROC main() PROC main() HANDLE -> E-Note: IEEE single is the format used for reals in E DEF mul1=-3.6, mul2=18.7 -> 3.6 multiplied by 18.7 DEF result, s[STRSIZE]:STRING mathieeesingbasbase:=OpenLibrary('mathieeesingbas.library', 34) result:=IeeeSPMul(mul1, mul2) -> E-Note: alternatively, no need to open library, use: result:=!mul1*mul2 WriteF(RealF(s, mul1, ACC)) WriteF(' multiplied by ') WriteF(RealF(s, mul2, ACC)) WriteF(' = \s\n', RealF(s, result, ACC)) EXCEPT DO IF mathieeesingbasbase THEN CloseLibrary(mathieeesingbasbase) SELECT exception CASE ERR_LIB; WriteF('Error: could not open mathieeesingbas library\n') ENDSELECT ENDPROC ->>> ---lh0-ԙ4Src\Rkrm\Math\sptrans.eT-> sptrans.e - Math SP IEEE Transcendental example of SPCos(). ->>> Header (globals) MODULE 'mathieeesingtrans' ENUM ERR_NONE, ERR_LIB RAISE ERR_LIB IF OpenLibrary()=NIL CONST STRSIZE=10, ACC=5 ->>> ->>> PROC main() PROC main() HANDLE -> E-Note: IEEE single is the format used for reals in E -> E-Note: C version gets it wrong: 30 degrees in radians is PI/6=0.52359878 DEF num1=0.52359878, result, s[STRSIZE]:STRING mathieeesingtransbase:=OpenLibrary('mathieeesingtrans.library', 34) result:=IeeeSPCos(num1) -> E-Note: alternatively, no need to open library, use: result:=Fcos(num1) WriteF('The single precision cosine of 30 degrees is \s\n', RealF(s, result, ACC)) EXCEPT DO IF mathieeesingtransbase THEN CloseLibrary(mathieeesingtransbase) SELECT exception CASE ERR_LIB; WriteF('Error: could not open mathieeesingtrans library\n') ENDSELECT ENDPROC ->>> 7-lh0-hz!Src\Rkrm\Preferences\prefnotify.e-> prefnotify.e - Notified if serial prefs change OPT PREPROCESS MODULE 'dos/dos', 'dos/notify' ENUM ERR_NONE, ERR_KICK, ERR_NOTIFY, ERR_SIGNAL RAISE ERR_NOTIFY IF StartNotify()<>DOSTRUE, ERR_SIGNAL IF AllocSignal()=255 #define PREFSFILENAME 'ENV:sys/serial.prefs' PROC main() HANDLE DEF done=FALSE, notifyrequest=NIL:PTR TO notifyrequest, signum=255, signals -> We need at least V37 for notification IF KickVersion(37)=FALSE THEN Raise(ERR_KICK) -> Allocate a NotifyRequest structure NEW notifyrequest -> And allocate signalsbit signum:=AllocSignal(-1) -> Initialise notification request notifyrequest.name:=PREFSFILENAME notifyrequest.flags:=NRF_SEND_SIGNAL -> Signal this task... notifyrequest.task:=FindTask(NIL) -> ... with this signals bit notifyrequest.signalnum:=signum StartNotify(notifyrequest) WriteF('Select Serial Prefs SAVE or USE to notify this program\n') WriteF('CTRL-C to exit\n\n') -> Loop until Ctrl-C to exit REPEAT signals:=Wait(Shl(1, signum) OR SIGBREAKF_CTRL_C) IF signals AND Shl(1, signum) WriteF('Notification signal received.\n') ENDIF IF signals AND SIGBREAKF_CTRL_C EndNotify(notifyrequest) done:=TRUE ENDIF UNTIL done EXCEPT DO IF signum<>255 THEN FreeSignal(signum) IF notifyrequest THEN END notifyrequest -> E-Note: not really necessary... SELECT exception CASE ERR_KICK; WriteF('Requires at least V37\n') CASE ERR_NOTIFY; WriteF('Can''t start notification\n') CASE ERR_SIGNAL; WriteF('No signals available\n') CASE "MEM"; WriteF('Not enough memory for NotifyRequest.\n') ENDSELECT ENDPROC verstag: CHAR 0, '$VER: prefnot 37.1 (09.07.91)', 06e-lh0-}z Src\Rkrm\Preferences\showprefs.e$V-> showprefs.e - Parse and show some info from an IFF Preferences file -> E-Note: ignore the rubbish (in the C version) about startup code MODULE 'iffparse', 'devices/timer', 'dos/dos', 'graphics/text', 'libraries/iffparse', 'prefs/font', 'prefs/icontrol', 'prefs/input', 'prefs/overscan', 'prefs/printergfx', 'prefs/printertxt', 'prefs/prefhdr', 'prefs/screenmode', 'prefs/serial' ENUM ERR_NONE, ERR_IFF, ERR_LIB, ERR_OPEN, ERR_RDARGS, TOTAL_ERRS -> E-Note: the use of exceptions is carefully balanced RAISE ERR_IFF IF AllocIFF()=NIL, ERR_LIB IF OpenLibrary()=NIL, ERR_OPEN IF Open()=NIL, ERR_RDARGS IF ReadArgs()=NIL PROC main() HANDLE DEF readargs=NIL, rargs[2]:ARRAY OF LONG, iffhandle=NIL:PTR TO iffhandle, filename=NIL, error, rc=RETURN_OK, iffErrTxt:PTR TO LONG iffparsebase:=OpenLibrary('iffparse.library', 37) readargs:=ReadArgs('FILE/A', rargs, NIL) IF filename:=rargs[0] -> Allocate an IFF handle iffhandle:=AllocIFF() -> Open the file for reading iffhandle.stream:=Open(filename, OLDFILE) -> Initialise the iff handle InitIFFasDOS(iffhandle) IF (error:=OpenIFF(iffhandle, IFFF_READ))=0 PropChunk(iffhandle, ID_PREF, ID_PRHD) PropChunk(iffhandle, ID_PREF, ID_FONT) PropChunk(iffhandle, ID_PREF, ID_ICTL) PropChunk(iffhandle, ID_PREF, ID_INPT) PropChunk(iffhandle, ID_PREF, ID_OSCN) PropChunk(iffhandle, ID_PREF, ID_PGFX) PropChunk(iffhandle, ID_PREF, ID_PTXT) PropChunk(iffhandle, ID_PREF, ID_SCRM) PropChunk(iffhandle, ID_PREF, ID_SERL) -> E-Note: handle the funny loop more cleanly using a separate procedure REPEAT UNTIL error:=parse(iffhandle) ENDIF CloseIFF(iffhandle) IF error<>IFFERR_EOF iffErrTxt:=['EOF', 'EOC', 'no lexical scope', 'insufficient memory', 'stream read error','stream write error','stream seek error', 'file corrupt', 'IFF syntax error', 'not an IFF file', 'required call-back hook missing', NIL] WriteF('\s: \s\n', rargs[], iffErrTxt[-error-1]) rc:=RETURN_FAIL ENDIF ENDIF EXCEPT DO SELECT TOTAL_ERRS OF exception CASE ERR_OPEN, ERR_RDARGS error:=IoErr() SetIoErr(error) IF error rc:=RETURN_FAIL PrintFault(error, IF filename THEN filename ELSE '') ENDIF CASE ERR_IFF; WriteF('Can''t allocate IFF handle\n') CASE ERR_LIB; WriteF('Can''t open iffparse.library\n') ENDSELECT IF iffhandle THEN FreeIFF(iffhandle) IF readargs THEN FreeArgs(readargs) IF iffparsebase THEN CloseLibrary(iffparsebase) ENDPROC rc -> E-Note: handle the funny loop more cleanly using a separate procedure PROC parse(iffhandle) DEF ifferror, sp:PTR TO storedproperty, hdrsp, cnode:PTR TO contextnode IF ifferror:=ParseIFF(iffhandle, IFFPARSE_STEP) RETURN IF ifferror=IFFERR_EOC THEN 0 ELSE ifferror ENDIF -> Do nothing if this is a PrefHeader chunk; we'll pop it later when there -> is a pref chunk. IF cnode:=CurrentChunk(iffhandle) IF (cnode.id=ID_PRHD) OR (cnode.id=ID_FORM) THEN RETURN 0 ENDIF -> Get the preferences header, stored previously hdrsp:=FindProp(iffhandle, ID_PREF, ID_PRHD) IF sp:=FindProp(iffhandle, ID_PREF, ID_FONT) WriteF('FrontPen: \d\n', sp.data::fontprefs.frontpen) WriteF('BackPen: \d\n', sp.data::fontprefs.backpen) WriteF('Font: \s\n', sp.data::fontprefs.name) WriteF('YSize: \d\n', sp.data::fontprefs.textattr.ysize) WriteF('Style: \d\n', sp.data::fontprefs.textattr.style) WriteF('Flags: \d\n', sp.data::fontprefs.textattr.flags) ELSEIF sp:=FindProp(iffhandle, ID_PREF, ID_ICTL) WriteF('TimeOut: \d\n', sp.data::icontrolprefs.timeout) WriteF('MetaDrag: \d\n', sp.data::icontrolprefs.metadrag) WriteF('WBtoFront: \d\n', sp.data::icontrolprefs.wbtofront) WriteF('FrontToBack: \d\n', sp.data::icontrolprefs.fronttoback) WriteF('ReqTrue: \d\n', sp.data::icontrolprefs.reqtrue) WriteF('ReqFalse: \d\n', sp.data::icontrolprefs.reqfalse) -> Etc. ELSEIF sp:=FindProp(iffhandle, ID_PREF, ID_INPT) WriteF('PointerTicks: \d\n', sp.data::inputprefs.pointerticks) WriteF('DoubleClick/Secs: \d\n', sp.data::inputprefs.doubleclick.secs) WriteF('DoubleClick/Micro: \d\n', sp.data::inputprefs.doubleclick.micro) -> Etc. ELSEIF sp:=FindProp(iffhandle, ID_PREF, ID_OSCN) WriteF('DisplayID: $\h\n', sp.data::overscanprefs.displayid) -> Etc. ELSEIF sp:=FindProp(iffhandle, ID_PREF, ID_PGFX) WriteF('Aspect: \d\n', sp.data::printergfxprefs.aspect) -> Etc. ELSEIF sp:=FindProp(iffhandle, ID_PREF, ID_PTXT) WriteF('Driver: \s\n', sp.data::printertxtprefs.driver) -> Etc. ELSEIF sp:=FindProp(iffhandle, ID_PREF, ID_SCRM) WriteF('DisplayID: $\h\n', sp.data::screenmodeprefs.displayid) -> Etc. ELSEIF sp:=FindProp(iffhandle, ID_PREF, ID_SERL) WriteF('BaudRate: \d\n', sp.data::serialprefs.baudrate) -> Etc. ENDIF RETURN 0 ENDPROC %q-lh0- Z#Src\Rkrm\README;5Short: E versions of RKRM examples (Part One and Two) Author: m88jrh@ecs.ox.ac.uk (Jason R. Hulance) JRH's RKRM Examples (Part One and Two) ====================================== This archive contains translations of all the examples from the following chapters of the RKRM (Libraries): ASL, Commodities, Exec, GadTools, Intuition, Preferences, Workbench, Expansion, Graphics (all the corresponding chapters), IFFParse, Keymap, Math (minus the FFP examples) and Utility. Also included are translations of all the Resource, Clipboard and Console examples from the RKRM (Devices). The examples retain most of the original comments, with comments specific to these E versions beginning "-> E-Note:". A lot of effort has been put into showing how to effectively use E features such as exceptions and lists. A number of bugs in the original examples have also been eliminated. If you are new to E you should pay special attention to the effect of using exceptions: error handling is and clean-up is neatly separated from the main code, and the code is generally much less indented. You should also notice the special care taken to initialise variables appropriately so that clean-up is made much more simple in the handlers. If you wish to recompile the sources (I expect you might...), you will need my Typed Modules (V40), my AmigaLib modules and my Useful modules. These archives should all be available where you found this archive (Aminet? In 'dev/e'?). [note: these are all included in the 'Modules' directory of this distribution -wouter] These executables, E sources and E modules are all Copyright (C) 1995, Jason R. Hulance. The original RKRM examples are Copyright (C) 1992, Commodore-Amiga Inc. You are free to use the files in this archive to help create your own programs (whether they are freeware or commercial), but if you wish to distribute any part of this archive you must include it all, unmodified, and with this file. (Hopefully, there will be a Part Three which will contain the remainder of the RKRM examples.) 8-lh0-"Src\Rkrm\Resources\Allocate_Misc.eT-> Allocate_Misc.e -> -> Example of allocating a miscellaneous resource. We will allocate the serial -> resource and wait until CTRL-C is pressed. While we are waiting, the -> Query_Serial program should be run. It will try to open the serial device -> and if unsuccessful, will return the name of the owner. It will be us! -> E-Note: E does not (as of v3.1a) support Resources in the conventional way MODULE 'other/misc', 'dos/dos', 'resources/misc' ENUM ERR_NONE, ERR_BITS, ERR_PORT PROC main() HANDLE -> E-Note: to help with cleaning up "owner" has been split into "portowner" -> and "bitsowner" which are initialised to non-NIL values DEF portowner=-1, bitsowner=-1 -> Owner of misc resource miscbase:=OpenResource('misc.resource') -> Allocate both pieces of the serial hardware IF portowner:=allocMiscResource(MR_SERIALPORT, 'Serial Port Hog') Raise(ERR_PORT) ENDIF IF bitsowner:=allocMiscResource(MR_SERIALBITS, 'Serial Port Hog') Raise(ERR_BITS) ENDIF -> Wait for CTRL-C to be pressed WriteF('\nWaiting for CTRL-C...\n') Wait(SIGBREAKF_CTRL_C) -> We're back EXCEPT DO -> Deallocate the serial port register IF bitsowner=NIL THEN freeMiscResource(MR_SERIALBITS) -> Deallocate the serial port IF portowner=NIL THEN freeMiscResource(MR_SERIALPORT) SELECT exception CASE ERR_BITS WriteF('Unable to allocate MR_SERIALBITS because \s owns it\n', bitsowner) CASE ERR_PORT WriteF('Unable to allocate MR_SERIALPORT because \s owns it\n', portowner) ENDSELECT ENDPROC 7-lh0-c"c"!Src\Rkrm\Resources\CIA_interval.eѢ-> Cia_Interval.e - Demonstrate allocation and use of a cia interval timer OPT PREPROCESS -> E-Note: we need eCodeIntServer() in order to use an E PROC as a CIA interrupt MODULE 'other/cia', 'other/ecode', 'exec/interrupts', 'exec/libraries', 'exec/nodes', 'exec/tasks', 'hardware/cia', 'resources/cia' ENUM ERR_NONE, ERR_ECODE, ERR_SIG, ERR_TIMER CONST COUNTDOWN=20, HICOUNT=$FF, LOCOUNT=$FF CONST STOPA_AND=CIACRAF_TODIN OR CIACRAF_PBON OR CIACRAF_OUTMODE OR CIACRAF_SPMODE -> -> AND mask for use with control register A -> (interval timer A on either CIA) -> -> STOP - -> START bit 0 == 0 (STOP IMMEDIATELY) -> PBON bit 1 == same -> OUT bit 2 == same -> RUN bit 3 == 0 (SET CONTINUOUS MODE) -> LOAD bit 4 == 0 (NO FORCE LOAD) -> IN bit 5 == 0 (COUNTS 02 PULSES) -> SP bit 6 == same -> TODIN bit 7 == same (unused on ciacra) CONST STOPB_AND=CIACRBF_ALARM OR CIACRBF_PBON OR CIACRBF_OUTMODE -> -> AND mask for use with control register B -> (interval timer B on either CIA) -> -> STOP - -> START bit 0 == 0 (STOP IMMEDIATELY) -> PBON bit 1 == same -> OUT bit 2 == same -> RUN bit 3 == 0 (SET CONTINUOUS MODE) -> LOAD bit 4 == 0 (NO FORCE LOAD) -> IN0 bit 5 == 0 (COUNTS 02 PULSES) -> IN1 bit 6 == 0 (COUNTS 02 PULSES) -> ALARM bit 7 == same (TOD alarm control bit) CONST STARTA_OR=CIACRAF_START -> -> OR mask for use with control register A -> (interval timer A on either CIA) -> -> START - -> -> START bit 0 == 1 (START TIMER) -> -> All other bits unaffected. CONST STARTB_OR=CIACRBF_START -> -> OR mask for use with control register B -> (interval timer A on either CIA) -> -> START - -> -> START bit 0 == 1 (START TIMER) -> -> All other bits unaffected. -> Structure which will be used to hold all relevant information about cia -> timer we manage to allocate. OBJECT freetimer ciabase -> CIA Library Base timerbit -> Timer bit allocated cia -> Pointer to hardware ciacr:PTR TO CHAR -> Pointer to control register cialo:PTR TO CHAR -> Pointer to low byte of timer ciahi:PTR TO CHAR -> Pointer to high byte of timer timerint:is -> Interrupt structure stopmask:CHAR -> Stop/set-up timer startmask:CHAR -> Start timer ENDOBJECT -> Structure which will be used by the interrupt routine called when our -> cia interval timer generates an interrupt. OBJECT exampledata task -> Task to signal signal -> Signal bit to use counter ENDOBJECT DEF ciaa=CIAA_ADDR:PTR TO cia, ciab=CIAB_ADDR:PTR TO cia -> This is the interrupt routine which will be called when our CIA interval -> timer counts down. -> -> This example decrements a counter each time the interrupt routine is called -> until the counter reaches 0, at which time it signals our main task. -> -> Note that interrupt handling code should be efficient, and will generally be -> written in assembly code. Signaling another task such as this example does -> is also a useful way of handling interrupts in an expedient manner. -> E-Note: thanks to eCodeIntServer() we get ft.timerint.data as an argument PROC exampleInterrupt(ed:PTR TO exampledata) IF ed.counter ed.counter:=ed.counter-1 -> Decrement counter ELSE ed.counter:=COUNTDOWN -> Reset counter Signal(ed.task, Shl(1, ed.signal)) ENDIF ENDPROC PROC main() HANDLE DEF ft:freetimer, ed:exampledata -> Set up data which will be passed to interrupt ed.task:=FindTask(NIL) -> E-Note: C version doesn't check the return value properly ed.signal:=AllocSignal(-1) IF ed.signal=-1 THEN Raise(ERR_SIG) -> Prepare freetimer object: set-up interrupt ft.timerint.ln.type:=NT_INTERRUPT ft.timerint.ln.pri:=0 ft.timerint.ln.name:='cia_example' ft.timerint.data:=ed -> E-Note: eCodeIntServer() wraps an E PROC for use as a CIA interrupt ft.timerint.code:=eCodeIntServer({exampleInterrupt}) IF ft.timerint.code=NIL THEN Raise(ERR_ECODE) -> Call function to find a free CIA interval timer with flag indicating -> that we prefer a CIA-A timer. WriteF('Attempting to allocate a free timer\n') findFreeTimer(ft, TRUE) WriteF('CIA-\c timer ', IF ft.cia=ciaa THEN "A" ELSE "B") WriteF('\c allocated\n', IF ft.timerbit=CIAICRB_TA THEN "A" ELSE "B") -> We found a free interval timer. Let's start it running. startTimer(ft, ed) -> Wait for a signal WriteF('Waiting for signal bit \d\n', ed.signal) Wait(Shl(1, ed.signal)) WriteF('We woke up!\n') -> Release the interval timer remICRVector(ft.ciabase, ft.timerbit, ft.timerint) EXCEPT DO IF ed.signal<>-1 THEN FreeSignal(ed.signal) SELECT exception CASE ERR_ECODE; WriteF('Ran out of memory in eCodeIntServer()\n') CASE ERR_SIG; WriteF('Could not allocate signal\n') CASE ERR_TIMER; WriteF('No CIA interval timer available\n') ENDSELECT ENDPROC -> This routine sets up the interval timer we allocated with addICRVector(). -> Note that we may have already received one, or more interrupts from our -> timer. Make no assumptions about the initial state of any of the hardware -> registers we will be using. PROC startTimer(ft:PTR TO freetimer, ed:PTR TO exampledata) DEF cia:PTR TO cia cia:=ft.cia -> Note that there are differences between control register A, and B on -> each CIA (e.g., the TOD alarm bit, and INMODE bits). IF ft.timerbit=CIAICRB_TA -> E-Note: use offsets to get addresses of the CIA bytes ft.ciacr:=cia+CIACRA -> Control register A ft.cialo:=cia+CIATALO -> Low byte counter ft.ciahi:=cia+CIATAHI -> High byte counter ft.stopmask:=STOPA_AND -> Set-up mask values ft.startmask:=STARTA_OR ELSE ft.ciacr:=cia+CIACRB -> Control register B ft.cialo:=cia+CIATBLO -> Low byte counter ft.ciahi:=cia+CIATBHI -> High byte counter ft.stopmask:=STOPB_AND -> Set-up mask values ft.startmask:=STARTB_OR ENDIF -> Modify control register within Disable(). This is done to avoid race -> conditions since code like this will be generated: -> -> value = Read hardware byte -> AND value with MASK -> Write value to hardware byte -> -> If we take a task switch in the middle of this sequence, two tasks trying -> to modify the same register could trash each others' bits. -> -> Normally this code would be written in Assembly language using atomic -> instructions so that the Disable() would not be needed. Disable() -> STOP timer, set 02 pulse count-down mode, set continuous mode ft.ciacr[]:=ft.ciacr[] AND ft.stopmask Enable() -> Clear signal bit - interrupt will signal us later SetSignal(NIL, Shl(1, ed.signal)) -> Count-down X number of times ed.counter:=COUNTDOWN -> Start the interval timer - we will start the counter after writing the -> low, and high byte counter values. ft.cialo[]:=LOCOUNT ft.ciahi[]:=HICOUNT -> Turn on start bit - same bit for both A, and B control regs Disable() ft.ciacr[]:=ft.ciacr[] OR ft.startmask Enable() ENDPROC -> A routine to find a free interval timer. -> -> This routine makes no assumptions about which interval timers (if any) are -> available for use. Currently there are two interval timers per CIA chip. -> -> Because CIA usage may change in the future, your code should use a routine -> like this to find a free interval timer. -> -> Note that the routine takes a preference flag (which is used to indicate -> that you would prefer an interval timer on CIA-A). If the flag is FALSE, -> it means that you would prefer an interval timer on CIA-B. PROC findFreeTimer(ft:PTR TO freetimer, preferA) DEF ciaabase, ciabbase -> Get pointers to both Resource bases ciaabase:=OpenResource(CIAANAME) ciabbase:=OpenResource(CIABNAME) -> Try for a CIA-A timer first? ft.ciabase:=IF preferA THEN ciaabase ELSE ciabbase -> Library address ft.cia:=IF preferA THEN ciaa ELSE ciab -> Hardware address IF tryTimer(ft) THEN RETURN -> Try for an interval timer on the other cia ft.ciabase:=IF preferA THEN ciabbase ELSE ciaabase -> Library address ft.cia:=IF preferA THEN ciab ELSE ciaa -> Hardware address IF tryTimer(ft)=FALSE THEN Raise(ERR_TIMER) ENDPROC -> Try to obtain a free interval timer on a CIA. PROC tryTimer(ft:PTR TO freetimer) IF NIL=addICRVector(ft.ciabase, CIAICRB_TA, ft.timerint) ft.timerbit:=CIAICRB_TA RETURN TRUE ENDIF IF NIL=addICRVector(ft.ciabase, CIAICRB_TB, ft.timerint) ft.timerbit:=CIAICRB_TB RETURN TRUE ENDIF ENDPROC FALSE ;-lh0-%Src\Rkrm\Resources\Get_Disk_Unit_ID.eC-> Get_Disk_Unit_ID.e - Example of getting the UnitID of a disk OPT PREPROCESS -> E-Note: E does not (as of v3.1a) support Resources in the conventional way MODULE 'other/disk', 'resources/disk' PROC main() DEF ids, type IF NIL=(diskbase:=OpenResource(DISKNAME)) WriteF('Cannot open \s\n', DISKNAME) -> E-Note: big typo in C version ELSE WriteF('Defined drive types are:\n') WriteF(' AMIGA $00000000\n') WriteF(' 5.25" $55555555\n') WriteF(' AMIGA $00000000 (high density)\n') -> Commodore-only product WriteF(' None $FFFFFFFF\n\n') -> What are the UnitIDs? FOR ids:=0 TO 3 type:=getUnitID(ids) WriteF('The UnitID for unit \d is $\z\h[8]\n', ids, type) ENDFOR ENDIF ENDPROC 6-lh0-QQd Src\Rkrm\Resources\Get_Filesys.eI-> Get_Filesys.e - Example of examining the FileSysRes list OPT PREPROCESS MODULE 'exec/lists', 'exec/nodes', 'resources/filesysres' DEF filesysresbase:PTR TO filesysresource PROC main() DEF fse:PTR TO filesysentry, x -> NOTE - you should actually be in a Forbid while accessing any system list -> for which no other method of arbitration is available. However, for this -> example we will be printing the information (which would break a Forbid -> anyway) so we won't Forbid. In real life, you should Forbid, copy the -> information you need, Permit, then print the info. IF NIL=(filesysresbase:=OpenResource(FSRNAME)) WriteF('Cannot open \s\n', FSRNAME) ELSE fse:=filesysresbase.filesysentries.head WHILE fse.ln.succ -> An A3000 running V34 does not have the name field filled in. -> An A2000 running V34 with an A590/2091 controller also does not have -> the name field filled in. IF fse.ln.name THEN WriteF('Found filesystem creator: \s\n', fse.ln.name) WriteF(' DosType: ') FOR x:=24 TO 8 STEP -8 DO Out(stdout, Shr(fse.dostype,x) AND $FF) Out(stdout, (fse.dostype AND $FF)+$30) WriteF('\n Version: \d', Shr(fse.version, 16)) WriteF('.\d\n\n', fse.version AND $FFFF) fse:=fse.ln.succ ENDWHILE ENDIF ENDPROC 7-lh0-[s!Src\Rkrm\Resources\Query_Serial.eZ-> Query_Serial.e - Try to open the serial device and if unsuccessful, -> return the name of the owner. OPT PREPROCESS -> E-Note: we are using the NAME macros -> E-Note: E does not (as of v3.1a) support Resources in the conventional way MODULE 'amigalib/io', 'amigalib/ports', 'other/misc', 'devices/serial', 'dos/dos', 'exec/io', 'resources/misc' ENUM ERR_NONE, ERR_CRIO, ERR_PORT CONST UNIT_NUMBER=0 DEF serialMP=NIL, serialIO=NIL:PTR TO ioextser PROC main() HANDLE DEF status, -> Return value of SDCMD_QUERY user -> Name of serial port owner if not us IF NIL=(serialMP:=createPort(NIL, NIL)) THEN Raise(ERR_PORT) IF NIL=(serialIO:=createExtIO(serialMP, SIZEOF ioextser)) THEN Raise(ERR_CRIO) IF OpenDevice(SERIALNAME, UNIT_NUMBER, serialIO, 0) WriteF('\n\s did not open', SERIALNAME) miscbase:=OpenResource(MISCNAME) -> Find out who has the serial device IF NIL=(user:=allocMiscResource(MR_SERIALPORT, 'Us')) WriteF('\n') freeMiscResource(MR_SERIALPORT) ELSE WriteF(' because \s owns it\n\n', user) ENDIF ELSE serialIO.iostd.command:=SDCMD_QUERY SendIO(serialIO) -> Execute query status:=serialIO.status -> Store returned status WriteF('\t The serial port status is \h\n', status) AbortIO(serialIO) WaitIO(serialIO) CloseDevice(serialIO) ENDIF EXCEPT DO IF serialIO THEN deleteExtIO(serialIO) IF serialMP THEN deletePort(serialMP) SELECT exception CASE ERR_CRIO; WriteF('Can''t create IO request\n') CASE ERR_PORT; WriteF('Can''t create message port\n') ENDSELECT ENDPROC IF exception<>ERR_NONE THEN RETURN_FAIL ELSE RETURN_OK 9-lh0-e~#Src\Rkrm\Resources\Read_BattClock.eJ-> Read_BattClock.e -> -> Example of reading the BattClock and converting its output to a useful -> measure of time by calling the Amiga2Date() utility function. OPT PREPROCESS -> E-Note: E does not (as of v3.1a) support Resources in the conventional way MODULE 'other/battclock', -> E-Note: swapping these two trips a bug in EC v3.1a 'utility', 'resources/battclock', 'utility/date' ENUM ERR_NONE, ERR_LIB, ERR_RES RAISE ERR_LIB IF OpenLibrary()=NIL, ERR_RES IF OpenResource()=NIL PROC main() HANDLE DEF days:PTR TO LONG, months:PTR TO LONG, ampm, amigaTime, myClock:clockdata days:=['Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday'] months:=['January', 'February', 'March', 'April', 'May', 'June', 'July', 'August', 'September', 'October', 'November', 'December'] utilitybase:=OpenLibrary('utility.library', 33) battclockbase:=OpenResource(BATTCLOCKNAME) -> Get number of seconds till now amigaTime:=readBattClock() -> Convert to a ClockData structure Amiga2Date(amigaTime, myClock) WriteF('\nRobin, tell everyone the BatDate and BatTime') -> Print the Date WriteF('\n\nOkay Batman, the BatDate is ') WriteF('\s, \s \d, \d', days[myClock.wday], months[myClock.month-1], myClock.mday, myClock.year) -> Convert military time to normal time and set AM/PM IF myClock.hour<12 ampm:='AM' -> hour less than 12, must be morning ELSE ampm:='PM' -> hour greater than 12,must be night myClock.hour:=myClock.hour-12 -> Subtract the extra 12 of military ENDIF IF myClock.hour=0 THEN myClock.hour:=12 -> Don't forget the 12s -> Print the time WriteF('\n the BatTime is ') WriteF('\d:\z\d[2]:\z\d[2] \s\n\n', myClock.hour, myClock.min, myClock.sec, ampm) EXCEPT DO IF utilitybase THEN CloseLibrary(utilitybase) SELECT exception CASE ERR_LIB; WriteF('Error: Could not open utility.library\n') CASE ERR_RES; WriteF('Error: Unable to open the \s\n', BATTCLOCKNAME) ENDSELECT ENDPROC 6-lh0-y Src\Rkrm\Resources\Read_Potinp.eR$-> Read_Potinp.e -> -> An example of using the potgo.resource to read pins 9 and 5 of port 1 -> (the non-mouse port). This bypasses the gameport.device. When the right -> or middle button on a mouse plugged into port 1 is pressed, the read value -> will change. -> -> Use of port 0 (mouse) is unaffected. -> E-Note: E does not (as of v3.1a) support Resources in the conventional way MODULE 'other/potgo', 'dos/dos', 'hardware/custom' ENUM ERR_NONE, ERR_POT, ERR_RES RAISE ERR_RES IF OpenResource()=NIL CONST OUTRY=$8000, DATRY=$4000, OUTRX=$2000, DATRX=$1000 DEF potbits, value PROC main() HANDLE -> E-Note: set-up "custom" DEF custom=CUSTOMADDR:PTR TO custom potgobase:=OpenResource('potgo.resource') -> Get the bits for the right and middle mouse buttons on the alternate -> mouse port. potbits:=allocPotBits(OUTRY OR DATRY OR OUTRX OR DATRX) IF potbits<>(OUTRY OR DATRY OR OUTRX OR DATRX) freePotBits(potbits) Raise(ERR_POT) ENDIF -> Set all ones in the register (masked by potbits) writePotgo($FFFFFFFF, potbits) WriteF('\n'+ 'Plug a mouse into the second port. This program will indicate when\n'+ 'the right or middle button (if the mouse is so equipped) is pressed.\n'+ 'Stop the program with Control-C. Press return now to begin.\n') -> E-Note: stdout is valid (we've used WriteF()), so try that if no stdin Inp(IF stdin THEN stdin ELSE stdout) REPEAT -> Read word at $DFF016 value:=custom.potinp -> Show what was read (restricted to our allocated bits) -> E-Note: use "\b" to prevent a linefeed, giving single line, fast update WriteF('POTINP = $\h\b', value AND potbits) UNTIL SIGBREAKF_CTRL_C AND SetSignal(0, 0) -> Until CTRL-C is pressed WriteF('\n') freePotBits(potbits) EXCEPT DO SELECT exception CASE ERR_POT; WriteF('Pot bits are already allocated! \h\n', potbits) CASE ERR_RES; WriteF('Could not open potgo.resource\n') ENDSELECT ENDPROC ,-lh0-rrՙ4Src\Rkrm\Utility\a2d.e'-> a2d.e ->>> Header (globals) MODULE 'timer', 'utility', 'devices/timer', 'exec/io', 'utility/date' ENUM ERR_NONE, ERR_DEV, ERR_LIB RAISE ERR_DEV IF OpenDevice()<>0, ERR_LIB IF OpenLibrary()=NIL ->>> ->>> PROC main() PROC main() HANDLE DEF clockdata:PTR TO clockdata, tr:PTR TO timerequest, tv:PTR TO timeval, seconds, open_dev=FALSE utilitybase:=OpenLibrary('utility.library', 37) NEW tr, tv, clockdata OpenDevice('timer.device', UNIT_VBLANK, tr, 0) open_dev:=TRUE timerbase:=tr.io.device GetSysTime(tv) WriteF('GetSysTime():\t\d \d\n', tv.secs, tv.micro) Amiga2Date(tv.secs, clockdata) WriteF('Amiga2Date(): sec \d min \d hour \d\n', clockdata.sec, clockdata.min, clockdata.hour) WriteF(' mday \d month \d year \d wday \d\n', clockdata.mday, clockdata.month, clockdata.year, clockdata.wday) seconds:=CheckDate(clockdata) WriteF('CheckDate():\t\d\n', seconds) seconds:=Date2Amiga(clockdata) WriteF('Date2Amiga():\t\d\n', seconds) EXCEPT DO IF open_dev THEN CloseDevice(tr) END clockdata, tv, tr IF utilitybase THEN CloseLibrary(utilitybase) SELECT exception CASE ERR_DEV; WriteF('Error: could not open timer device\n') CASE ERR_LIB; WriteF('Error: could not open utility library\n') CASE "MEM"; WriteF('Error: ran out of memory\n') ENDSELECT ENDPROC ->>> /-lh0-ՙ4Src\Rkrm\Utility\hooks1.eN-> hooks1.e ->>> Header (globals) MODULE 'utility', 'utility/hooks', 'tools/installhook' ENUM ERR_NONE, ERR_LIB RAISE ERR_LIB IF OpenLibrary()=NIL ->>> ->>> PROC myFunction(h:PTR TO hook, o, msg) -> This function only prints out a message indicating that we are inside the -> callback function. PROC myFunction(h:PTR TO hook, o, msg) -> E-Note: installhook has set-up access to data segment WriteF('Inside myFunction()\n') ENDPROC 1 ->>> ->>> PROC main() PROC main() HANDLE DEF h:hook -> Open the utility library utilitybase:=OpenLibrary('utility.library', 36) -> Initialise the callback hook -> E-Note: use installhook to do the main stuff (so h.data cannot be used) installhook(h, {myFunction}) -> Use the utility library function to invoke the hook CallHookPkt(h, NIL, NIL) EXCEPT DO IF utilitybase THEN CloseLibrary(utilitybase) SELECT exception CASE ERR_LIB; WriteF('Error: could not open utility library\n') ENDSELECT ENDPROC ->>> --lh0-ՙ4Src\Rkrm\Utility\istr.e\-> istr.e ->>> Header (globals) MODULE 'utility' ENUM ERR_NONE, ERR_LIB RAISE ERR_LIB IF OpenLibrary()=NIL ->>> ->>> PROC main() PROC main() HANDLE DEF butter, bread, ch1, ch2, result butter:='Btervlt' bread:='Knckerbrt' utilitybase:=OpenLibrary('utility.library', 37) result:=Stricmp(butter, bread) WriteF('Comparing \s with \s yields \d\n', butter, bread, result) result:=Strnicmp(bread, butter, StrLen(bread)) WriteF('Comparing (with length) \s with \s yields \d\n', bread, butter, result) ch1:=ToUpper($E6) -> ASCII character 230 ae ligature ch2:=ToLower($D0) -> ASCII character 208 Icelandic Eth WriteF('Chars \c \c\n', ch1, ch2) EXCEPT DO -> E-Note: C version forgets to close the library! IF utilitybase THEN CloseLibrary(utilitybase) SELECT exception CASE ERR_LIB; WriteF('Error: could not open utility library\n') ENDSELECT ENDPROC ->>> --lh0-nnՙ4Src\Rkrm\Utility\tag1.e1-> tag1.e ->>> Header (globals) MODULE 'utility', 'intuition/intuition', 'utility/tagitem' ENUM ERR_NONE, ERR_LIB, ERR_TAG, ERR_WIN RAISE ERR_LIB IF OpenLibrary()=NIL, ERR_TAG IF AllocateTagItems()=NIL, ERR_WIN IF OpenWindowTagList()=NIL ->>> ->>> PROC main() PROC main() HANDLE DEF tags=NIL:PTR TO tagitem, win=NIL KickVersion(37) -> We need the utility library for this example utilitybase:=OpenLibrary('utility.library', 37) -> ********************************************************************* -> This section allocates a tag array, fills it in with values, and then -> uses it. -> ********************************************************************* -> Allocate a tag array tags:=AllocateTagItems(7) -> Fill in our tag array tags[0].tag:=WA_WIDTH tags[0].data:=320 tags[1].tag:=WA_HEIGHT tags[1].data:=50 tags[2].tag:=WA_TITLE tags[2].data:='RKM Tag Example 1' tags[3].tag:=WA_IDCMP tags[3].data:=IDCMP_CLOSEWINDOW tags[4].tag:=WA_CLOSEGADGET tags[4].data:=TRUE tags[5].tag:=WA_DRAGBAR tags[5].data:=TRUE tags[6].tag:=TAG_DONE -> Open the window, using the tag attributes as the only description. win:=OpenWindowTagList(NIL, tags) -> Wait for an event to occur WaitIMessage(win) -> Close the window now that we're done with it CloseWindow(win) win:=NIL -> E-Note: help with error trapping -> ********************************************************************* -> This section builds a static tag list, and passes it to the function. -> ********************************************************************* win:=OpenWindowTagList(NIL, [WA_WIDTH, 320, WA_HEIGHT, 50, WA_TITLE, 'RKM Tag Example 1', WA_IDCMP, IDCMP_CLOSEWINDOW, WA_CLOSEGADGET, TRUE, WA_DRAGBAR, TRUE, TAG_DONE]) -> Wait for an event to occur WaitIMessage(win) EXCEPT DO IF win THEN CloseWindow(win) IF tags THEN FreeTagItems(tags) IF utilitybase THEN CloseLibrary(utilitybase) ENDPROC ->>> /-lh0-ՙ4Src\Rkrm\Utility\uptime.e-> uptime.e ->>> Header (globals) OPT PREPROCESS MODULE 'utility', 'dos/dos', 'dos/dosextens', 'utility/date' ENUM ERR_NONE, ERR_INFO, ERR_LIB, ERR_LOCK RAISE ERR_INFO IF Info()<>DOSTRUE, ERR_LIB IF OpenLibrary()=NIL, ERR_LOCK IF Lock()=NIL ->>> ->>> PROC main() PROC main() HANDLE DEF infodata=NIL:PTR TO infodata, ramdevice:PTR TO devlist, now=NIL:PTR TO datestamp, currenttime, boottime, lock=NIL, d, h, m utilitybase:=OpenLibrary('utility.library', 37) NEW infodata, now lock:=Lock('RAM:', SHARED_LOCK) Info(lock, infodata) -> E-Note: convert BCPL pointer ramdevice:=BADDR(infodata.volumenode) boottime:=Smult32(ramdevice.volumedate.days, 86400) + Smult32(ramdevice.volumedate.minute, 60) + SdivMod32(ramdevice.volumedate.tick, TICKS_PER_SECOND) DateStamp(now) currenttime:=Smult32(now.days, 86400) + Smult32(now.minute, 60) + SdivMod32(now.tick, TICKS_PER_SECOND) currenttime:=currenttime-boottime IF currenttime > 0 -> E-Note: a multiple assignment gets the two UdivMod32() results d,h:=UdivMod32(currenttime, 86400) h,m:=UdivMod32(h, 3600) m:=UdivMod32(m, 60) WriteF('Up for \d days, \d hours, \d minutes\n', d, h, m) ENDIF EXCEPT DO IF lock THEN UnLock(lock) END now, infodata IF utilitybase THEN CloseLibrary(utilitybase) SELECT exception CASE ERR_INFO; WriteF('Error: could not get info on lock\n') CASE ERR_LIB; WriteF('Error: could not open utility library\n') CASE ERR_LOCK; WriteF('Error: could not lock RAM:\n') CASE "MEM"; WriteF('Error: ran out of memory\n') ENDSELECT ENDPROC ->>> 2-lh0-6 6 zSrc\Rkrm\Workbench\appicon.e-> appicon.e -- Show use of an AppIcon OPT OSVERSION=37 MODULE 'icon', 'wb', 'workbench/startup', 'workbench/workbench' ENUM ERR_NONE, ERR_APPICON, ERR_DOBJ, ERR_LIB, ERR_PORT RAISE ERR_APPICON IF AddAppIconA()=NIL, ERR_DOBJ IF GetDefDiskObject()=NIL, ERR_LIB IF OpenLibrary()=NIL, ERR_PORT IF CreateMsgPort()=NIL PROC main() HANDLE DEF dobj=NIL:PTR TO diskobject, myport=NIL, appicon=NIL, appmsg:PTR TO appmessage, dropcount=0, x -> Get the the right version of the Icon Library, initialise iconbase iconbase:=OpenLibrary('icon.library', 37) -> Get the the right version of the Workbench Library workbenchbase:=OpenLibrary('workbench.library', 37) -> This is the easy way to get some icon imagery -> Real applications should use custom imagery dobj:=GetDefDiskObject(WBDISK) -> The type must be set to NIL for a WBAPPICON dobj.type:=NIL -> The CreateMsgPort() function is in Exec version 37 and later only myport:=CreateMsgPort() -> Put the AppIcon up on the Workbench window appicon:=AddAppIconA(0, 0, 'TestAppIcon', myport, NIL, dobj, NIL) -> For the sake of this example, we allow the AppIcon to be activated -> only five times. WriteF('Drop files on the Workbench AppIcon\n') WriteF('Example exits after 5 drops\n') WHILE dropcount<5 -> Here's the main event loop where we wait for messages to show up -> from the AppIcon WaitPort(myport) -> Might be more than one message at the port... WHILE appmsg:=GetMsg(myport) IF appmsg.numargs=0 -> If numargs is 0 the AppIcon was activated directly WriteF('User activated the AppIcon.\n') WriteF('A Help window for the user would be good here\n') ELSEIF appmsg.numargs>0 -> If numargs is >0 the AppIcon was activated by having one or more -> icons dropped on top of it WriteF('User dropped \d icons on the AppIcon\n', appmsg.numargs) FOR x:=0 TO appmsg.numargs-1 WriteF('#\d name="\s"\n', x+1, appmsg.arglist[x].name) ENDFOR ENDIF -> Let Workbench know we're done with the message ReplyMsg(appmsg) ENDWHILE INC dropcount ENDWHILE EXCEPT DO IF appicon THEN RemoveAppIcon(appicon) IF myport -> Clear away any messages that arrived at the last moment WHILE appmsg:=GetMsg(myport) DO ReplyMsg(appmsg) DeleteMsgPort(myport) ENDIF IF dobj THEN FreeDiskObject(dobj) IF workbenchbase THEN CloseLibrary(workbenchbase) IF iconbase THEN CloseLibrary(iconbase) SELECT exception CASE ERR_APPICON; WriteF('Error: Could not attach AppIcon to Workbench\n') CASE ERR_DOBJ; WriteF('Error: Could not get default icon\n') CASE ERR_LIB; WriteF('Error: Could not open required library\n') CASE ERR_PORT; WriteF('Error: Could not create port\n') ENDSELECT ENDPROC6-lh0-G G z Src\Rkrm\Workbench\appmenuitem.e1-> appmenuitem.e -- Show use of an AppMenuItem OPT OSVERSION=37 MODULE 'wb', 'dos/dostags', 'workbench/startup', 'workbench/workbench' ENUM ERR_NONE, ERR_APPMENU, ERR_LIB, ERR_PORT RAISE ERR_APPMENU IF AddAppMenuItemA()=NIL, ERR_LIB IF OpenLibrary()=NIL, ERR_PORT IF CreateMsgPort()=NIL PROC main() HANDLE DEF myport=NIL, appitem=NIL, appmsg=NIL:PTR TO appmessage, result, x, count=0, file workbenchbase:=OpenLibrary('workbench.library', 37) -> The CreateMsgPort() function is in Exec version 37 and later only myport:=CreateMsgPort() -> Add our own AppMenuItem to the Workbench Tools Menu appitem:=AddAppMenuItemA(0, -> Our ID# for item 'SYS:Utilities/More', -> Our UserData 'Browse Files', -> MenuItem Text myport, NIL) -> MsgPort, no tags WriteF('Select Workbench Tools demo menuitem "Browse Files"\n') -> For this example, we allow the AppMenuItem to be selected only once, -> then we remove it and exit WaitPort(myport) WHILE (appmsg:=GetMsg(myport)) AND (count<1) -> Handle messages from the AppMenuItem - we have only one item so we don't -> have to check its appmsg.id number. We'll System() the command string -> that we passed as userdata when we added the menu item. We find our -> userdata pointer in appmsg.userdata WriteF('User picked AppMenuItem with \d icons selected\n', appmsg.numargs) FOR x:=0 TO appmsg.numargs-1 WriteF(' #\d name="\s"\n', x+1, appmsg.arglist[x].name) ENDFOR INC count IF file:=Open('CON:0/40/640/150/AppMenu Example/auto/close/wait', OLDFILE) result:=SystemTagList(appmsg.userdata, [SYS_INPUT, file, SYS_OUTPUT, NIL, SYS_ASYNCH, TRUE, NIL]) -> If Asynch System() itself fails, we must close file IF result=-1 THEN Close(file) ENDIF ReplyMsg(appmsg) ENDWHILE EXCEPT DO IF appitem THEN RemoveAppMenuItem(appitem) IF myport -> Clear away any messages that arrived at the last moment -> and let Workbench know we're done with the messages WHILE appmsg:=GetMsg(myport) DO ReplyMsg(appmsg) DeleteMsgPort(myport) ENDIF IF workbenchbase THEN CloseLibrary(workbenchbase) SELECT exception CASE ERR_APPMENU; WriteF('Error: Could not attach AppMenuItem to Workbench\n') CASE ERR_LIB; WriteF('Error: Could not open workbench.library\n') CASE ERR_PORT; WriteF('Error: Could not create port\n') ENDSELECT ENDPROC4V-lh0- zSrc\Rkrm\Workbench\appwindow.e~-> appwindow.e -- Show use of an AppWindow OPT OSVERSION=37 MODULE 'wb', 'exec/ports', 'intuition/intuition', 'workbench/startup', 'workbench/workbench' ENUM ERR_NONE, ERR_APPWIN, ERR_LIB, ERR_PORT, ERR_WIN RAISE ERR_APPWIN IF AddAppWindowA()=NIL, ERR_LIB IF OpenLibrary()=NIL, ERR_PORT IF CreateMsgPort()=NIL, ERR_WIN IF OpenWindowTagList()=NIL PROC main() HANDLE DEF awport=NIL:PTR TO mp, win=NIL:PTR TO window, appwin=NIL, imsg:PTR TO intuimessage, amsg:PTR TO appmessage, argptr:PTR TO wbarg, winsig, appwinsig, signals, id=1, userdata=0, done=FALSE, i workbenchbase:=OpenLibrary('workbench.library', 37) -> The CreateMsgPort() function is in Exec version 37 and later only awport:=CreateMsgPort() win:=OpenWindowTagList(NIL, [WA_WIDTH, 200, WA_HEIGHT, 50, -> E-Note: C version uses obsolete flags WA_IDCMP, IDCMP_CLOSEWINDOW, WA_FLAGS, WFLG_CLOSEGADGET OR WFLG_DRAGBAR, WA_TITLE, 'AppWindow', NIL]) appwin:=AddAppWindowA(id, userdata, win, awport, NIL) WriteF('AppWindow added... Drag files into AppWindow\n') winsig:=Shl(1, win.userport.sigbit) appwinsig:=Shl(1, awport.sigbit) REPEAT -> Wait for IDCMP messages and AppMessages signals:=Wait(winsig OR appwinsig) IF signals AND winsig -> Got an IDCMP message WHILE imsg:=GetMsg(win.userport) -> E-Note: C version uses obsolete flags IF imsg.class=IDCMP_CLOSEWINDOW THEN done:=TRUE ReplyMsg(imsg) ENDWHILE ENDIF IF signals AND appwinsig -> Got an AppMessage WHILE amsg:=GetMsg(awport) WriteF('AppMsg: Type=\d, ID=\d, NumArgs=\d\n', amsg.type, amsg.id, amsg.numargs) argptr:=amsg.arglist FOR i:=0 TO amsg.numargs-1 WriteF(' arg(\d): Name="\s", Lock=\h\n', i, argptr.name, argptr.lock) argptr++ ENDFOR ReplyMsg(amsg) ENDWHILE ENDIF UNTIL done EXCEPT DO IF appwin THEN RemoveAppWindow(appwin) IF win THEN CloseWindow(win) IF awport -> Make sure there are no more outstanding messages WHILE amsg:=GetMsg(awport) DO ReplyMsg(amsg) DeleteMsgPort(awport) ENDIF IF workbenchbase THEN CloseLibrary(workbenchbase) SELECT exception CASE ERR_APPWIN; WriteF('Error: Could not create AppWindow\n') CASE ERR_LIB; WriteF('Error: Could not open required library\n') CASE ERR_PORT; WriteF('Error: Could not create port\n') CASE ERR_WIN; WriteF('Error: Could not open window\n') ENDSELECT ENDPROC6\-lh0-Æz Src\Rkrm\Workbench\iconexample.e8-> iconexample.e - Workbench icon startup, creation, and parsing example MODULE 'icon', 'dos/dos', 'intuition/intuition', 'workbench/startup', 'workbench/workbench' ENUM ERR_NONE, ERR_LIB, ERR_OPEN, ERR_WRITE, ERR_MAKE RAISE ERR_LIB IF OpenLibrary()=NIL, ERR_OPEN IF Open()=NIL, ERR_WRITE IF Write()=-1 DEF projIcon:diskobject PROC main() HANDLE DEF wbenchMsg:PTR TO wbstartup, wbarg:PTR TO wbarg, file=NIL, i, olddir, projname, deftoolname, iconImageData, iconGadget, toolTypes projname:='RAM:Example_Project' deftoolname:='iconexample' toolTypes:=['FILETYPE=text', 'FLAGS=BOLD|ITALICS', NIL] -> Plane 0 iconImageData:=[$0000,$0000,$0000,$1000,$0000,$0000,$0000,$3000, $0FFF,$FFFC,$0000,$3000,$0800,$0004,$0000,$3000, $0800,$07FF,$FFC0,$3000,$08A8,$A400,$00A0,$3000, $0800,$0400,$0090,$3000,$08AA,$A400,$0088,$3000, $0800,$042A,$A0FC,$3000,$082A,$A400,$0002,$3000, $0800,$0400,$0002,$3000,$0800,$A42A,$A0A2,$3000, $0800,$0400,$0002,$3000,$0950,$A42A,$8AA2,$3000, $0800,$0400,$0002,$3000,$082A,$A400,$0002,$3000, $0800,$042A,$2AA2,$3000,$0FFF,$FC00,$0002,$3000, $0000,$0400,$0002,$3000,$0000,$07FF,$FFFE,$3000, $0000,$0000,$0000,$3000,$7FFF,$FFFF,$FFFF,$F000, -> Plane 1 $FFFF,$FFFF,$FFFF,$E000,$D555,$5555,$5555,$4000, $D000,$0001,$5555,$4000,$D7FF,$FFF9,$5555,$4000, $D7FF,$F800,$0015,$4000,$D757,$5BFF,$FF55,$4000, $D7FF,$FBFF,$FF65,$4000,$D755,$5BFF,$FF75,$4000, $D7FF,$FBD5,$5F01,$4000,$D7D5,$5BFF,$FFFD,$4000, $D7FF,$FBFF,$FFFD,$4000,$D7FF,$5BD5,$5F5D,$4000, $D7FF,$FBFF,$FFFD,$4000,$D6AF,$5BD5,$755D,$4000, $D7FF,$FBFF,$FFFD,$4000,$D7D5,$5BFF,$FFFD,$4000, $D7FF,$FBD5,$D55D,$4000,$D000,$03FF,$FFFD,$4000, $D555,$53FF,$FFFD,$4000,$D555,$5000,$0001,$4000, $D555,$5555,$5555,$4000,$8000,$0000,$0000,$0000]:INT -> E-Note: C version uses obsolete gadget flags iconGadget:=[NIL, -> Next Gadget Pointer 97, 12, 52, 23, -> Left, Top, Width, Height GFLG_GADGIMAGE OR GFLG_GADGHBOX, -> Flags GACT_IMMEDIATE OR GACT_RELVERIFY, -> Activation Flags GTYP_BOOLGADGET, -> Gadget Type [0, 0, -> Top Corner 52, 22, 2, -> Width, Height, Depth iconImageData, -> Image Data 3, 0, -> PlanePick, PlaneOnOff NIL]:image, -> Next Image NIL, -> Select Image NIL, -> Gadget Text NIL, -> Mutual Exclude NIL, -> Special Info 0, -> Gadget ID NIL]:gadget -> User Data -> E-Note: a list can't be used for a diskobject because of the nested gadget projIcon.magic:=WB_DISKMAGIC projIcon.version:=WB_DISKVERSION CopyMem(iconGadget, projIcon.gadget, SIZEOF gadget) projIcon.type:=WBPROJECT projIcon.defaulttool:=deftoolname projIcon.tooltypes:=toolTypes projIcon.currentx:=NO_ICON_POSITION projIcon.currenty:=NO_ICON_POSITION projIcon.drawerdata:=NIL projIcon.toolwindow:=NIL projIcon.stacksize:=4000 -> Open icon.library iconbase:=OpenLibrary('icon.library',33) -> If started from CLI, this example will create a small text file -> RAM:Example_Project, and create an icon for the file which points -> to this program as its default tool. IF wbmessage=NIL -> Make a sample project (data) file file:=Open(projname, NEWFILE) Write(file, 'Have a nice day\n', STRLEN) -> Now save/update icon for this data file makeIcon(projname, toolTypes, deftoolname) WriteF('\s data file and icon saved.\n', projname) WriteF('Use Workbench menu Icon Information to examine the icon.\n') WriteF('Then copy this example (iconexample) to RAM:\n') WriteF('and double-click the \s project icon\n', projname) ELSE -> Else we are from WB - ie. we were either started by a tool icon, -> or as in this case, by being the default tool of a project icon. -> E-Note: WriteF opens its own window if necessary wbenchMsg:=wbmessage -> First arg is our executable (tool). Any additional args are projects -> or icons passed to us via either extend select or default tool method. wbarg:=wbenchMsg.arglist FOR i:=0 TO wbenchMsg.numargs-1 -> If there's a directory lock for this wbarg, CD there olddir:=-1 IF wbarg.lock AND (wbarg.name[]<>0) THEN olddir:=CurrentDir(wbarg.lock) showToolTypes(wbarg) IF (i>0) AND (wbarg.name[]<>0) WriteF('In Main. We could open the \s file here\n', wbarg.name) ENDIF IF olddir<>-1 THEN CurrentDir(olddir) -> CD back where we were wbarg++ ENDFOR Delay(500) WriteF('\nPress RETURN to close window\n') ENDIF EXCEPT DO IF file THEN Close(file) SELECT exception CASE ERR_LIB; WriteF('Can''t open icon.library\n') CASE ERR_OPEN; WriteF('Can''t open file "\s"\n', projname) CASE ERR_WRITE; WriteF('Error writing data file\n') CASE ERR_MAKE; WriteF('Error writing icon\n') ENDSELECT RETURN IF exception=ERR_NONE THEN RETURN_OK ELSE RETURN_FAIL ENDPROC PROC makeIcon(name, newtooltypes, newdeftool) DEF dobj:PTR TO diskobject, oldtooltypes, olddeftool, success=FALSE IF dobj:=GetDiskObject(name) -> If file already has an icon, we will save off any fields we need to -> update, update those fields, put the object, restore the old field -> pointers and then free the object. This will preserve any custom -> imagery the user has, and the user's current placement of the icon. -> If your application does not know where the user currently keeps your -> application, you should not update his dobj.defaulttool. oldtooltypes:=dobj.tooltypes olddeftool:=dobj.defaulttool dobj.tooltypes:=newtooltypes dobj.defaulttool:=newdeftool success:=PutDiskObject(name, dobj) -> We must restore the original pointers before freeing dobj.tooltypes:=oldtooltypes dobj.defaulttool:=olddeftool FreeDiskObject(dobj) ENDIF -> Else, put our default icon IF success=FALSE THEN success:=PutDiskObject(name, projIcon) IF success=FALSE THEN Raise(ERR_MAKE) ENDPROC PROC showToolTypes(wbarg:PTR TO wbarg) DEF dobj:PTR TO diskobject, toolarray, s, success=FALSE WriteF('\nWBArg Lock=$\h, Name=\s ($\h)\n', wbarg.lock, wbarg.name, wbarg.name[]) IF (wbarg.name[]<>0) AND (dobj:=GetDiskObject(wbarg.name)) WriteF(' We have read the DiskObject (icon) for this arg\n') toolarray:=dobj.tooltypes IF s:=FindToolType(toolarray, 'FILETYPE') WriteF(' Found tooltype FILETYPE with value \s\n', s) ENDIF IF s:=FindToolType(toolarray, 'FLAGS') WriteF(' Found tooltype FLAGS with value \s\n', s) IF MatchToolValue(s, 'BOLD') WriteF(' BOLD flag requested\n') ENDIF IF MatchToolValue(s, 'ITALICS') WriteF(' ITALICS flag requested\n') ENDIF ENDIF -> Free the diskobject we got FreeDiskObject(dobj) success:=TRUE ELSEIF wbarg.name[]=0 WriteF(' Must be a disk or drawer icon\n') ELSE WriteF(' Can''t find any DiskObject (icon) for this WBArg\n') ENDIF ENDPROC success 1-lh0-[[E~Src\Rkrm\Workbench\prargs.e-> PrArgs.e - This program prints all Workbench or Shell (CLI) arguments. -> E-Note: ignore all the rubbish (in the C version) about start-ups MODULE 'other/split', 'workbench/startup' PROC main() DEF argmsg:PTR TO wbstartup, wb_arg:PTR TO wbarg, ktr, olddir, argv:PTR TO LONG -> wbmessage is non-NIL when run from the Workbench, NIL when run from the CLI IF wbmessage -> E-Note: WriteF opens its own output window, if necessary -> wbmessage contains a pointer to the WBStartup message argmsg:=wbmessage wb_arg:=argmsg.arglist -> Head of the arg list WriteF('Run from the Workbench, \d args.\n', argmsg.numargs) FOR ktr:=0 TO argmsg.numargs-1 IF wb_arg.lock<>NIL -> Locks supported, change to the proper directory olddir:=CurrentDir(wb_arg.lock) -> Process the file. -> If you have done the CurrentDir() above, then you can access the file -> by its name. Otherwise, you have to examine the lock to get a -> complete path to the file. WriteF('\tArg \d[2] (w/ lock): "\s".\n', ktr, wb_arg.name) -> Change back to the original directory when done. Be sure to change -> back before you exit. CurrentDir(olddir) ELSE -> Something that does not support locks WriteF('\tArg \d[2] (no lock): "\s".\n', ktr, wb_arg.name) ENDIF wb_arg++ ENDFOR -> E-Note: no need to wait: output window closes after a RETURN press ELSE -> E-Note: WriteF opens its own output window, if necessary -> E-Note: argSplit() splits arg into a NIL-terminated E-list, which can be -> used like C's argv (except that the first element of the list is -> the first argument, not the program name...) IF argv:=argSplit() WriteF('Run from the CLI, \d args.\n', ListLen(argv)) FOR ktr:=0 TO ListLen(argv)-1 -> Print an arg, and its number WriteF('\tArg \d[2]: "\s".\n', ktr+1, argv[ktr]) ENDFOR ELSE -> E-Note: argSplit() ran out of memory... WriteF('Run from the CLI, arg is "\s".\n', arg) ENDIF ENDIF ENDPROC 5E-lh0- mSrc\Tools\AmigaLib\AmigaLib.docRAShort: amiga.lib as E modules Type: dev/e Author: m88jrh@ecs.ox.ac.uk (Jason R. Hulance) Uploader: m88jrh@ecs.ox.ac.uk (Jason R. Hulance) AmigaLib ======== Amiga E modules of many of the amiga.lib functions. These translations are Copyright (C) 1995, Jason R. Hulance. The original amiga.lib is Copyright (C) 1985-1992, Commodore-Amiga Inc. You are free to use these modules in your programs, whether they are freeware or commercial. However, if you want to distribute any of this archive you must include it all, unmodified, together with this file. Contents -------- argarray.m: PROC argArrayInit(str=0) PROC argArrayDone() PROC argInt(tt,entry,defaultval) PROC argString(tt,entry,defaultstring) boopsi.m: PROC callHookA(h,obj,msg) PROC coerceMethodA(cl,obj,msg) PROC doMethodA(obj,msg) PROC doSuperMethodA(cl,obj,msg) PROC setSuperAttrsA(cl,obj,msg) cx.m: PROC freeIEvents(events) PROC hotKey(description,port,id) PROC invertString(str,km) PROC invertStringRev(str,km) PROC userFilter(tt,action_name,default_descr) interrupts.m: PROC addTOF(i,p,a) PROC remTOF(i) PROC waitbeam(pos) io.m: PROC beginIO(ioreq) PROC createExtIO(port,ioSize) PROC deleteExtIO(ioReq) PROC createStdIO(port) PROC deleteStdIO(ioReq) lists.m: PROC newList(mlh) ports.m: PROC createPort(name,pri) PROC deletePort(port) random.m: PROC fastRand(num) PROC rangeRand(num) tasks.m: PROC createTask(name,pri,initPC,stackSize) PROC deleteTask(tc) time.m: PROC timeDelay(unit,seconds,micros) There are also a number of test programs, which show how to use many of the functions. Documentation ------------- The documentation on amiga.lib serves as adequate documentation of these functions, with the following observations: argarray.m: o argArrayInit() takes only an optional string. This can be a string of arguments like the E global "arg" (which is the default). This string is only used if "wbmessage" is NIL, and is *altered* if used (i.e., the result is a manipulation of the string, and so by default "arg" will be affected). If you don't like this, pass this function a copy of your arguments string (and be careful not to free it until you've finished with the result of this function). boopsi.m: o callHookA() is like CallHookPkt() from utility.library except it does not require the utility.library to be open! o setSuperAttrsA() replaces the stack-based (varargs) function SetSuperAttrs(). setSuperAttrsA() takes a pointer to a Boopsi message as its third argument (so you would usually use a typed list). cx.m: o invertStringRev() is like InvertString() except it does not require you to reverse the string to be inverted. See testcx.e. o userFilter(tt, action_name, default_descr) creates a CxFilter object with a description string taken from the tooltype defined by "action_name" in the tooltypes array "tt" (which is usually the result of a call to argArrayInit()). If the tooltype is not found then the "default_descr" is used instead. interrupts.m: o waitbeam(pos) waits until the VBeam position is at least "pos". tasks.m: o createTask() can has slightly enhanced error checking if you are running V37+. The main reason for the creation of these modules was my translations of the RKRM examples. These should provide even more useful documentation. 3-lh0-II~Src\Tools\AmigaLib\argarray.eOPT MODULE MODULE 'icon', 'other/split', 'workbench/startup', 'workbench/workbench' DEF cxlib_arg, cxlib_dobj:PTR TO diskobject EXPORT PROC argArrayInit(str=NIL) DEF argmsg:PTR TO wbstartup, lock=NIL IF iconbase=NIL RETURN NIL ELSEIF argmsg:=wbmessage IF argmsg.arglist.lock THEN lock:=CurrentDir(argmsg.arglist.lock) cxlib_dobj:=GetDiskObject(argmsg.arglist.name) IF lock THEN CurrentDir(lock) RETURN IF cxlib_dobj THEN cxlib_dobj.tooltypes ELSE NIL ELSE RETURN cxlib_arg:=argSplit(str) ENDIF ENDPROC EXPORT PROC argArrayDone() IF iconbase IF wbmessage FreeDiskObject(cxlib_dobj) ELSE DisposeLink(cxlib_arg) ENDIF ENDIF ENDPROC EXPORT PROC argString(tt:PTR TO LONG, entry, defaultstring) DEF res=NIL IF tt AND (iconbase<>NIL) res:=FindToolType(tt, entry) ENDIF ENDPROC IF res THEN res ELSE defaultstring EXPORT PROC argInt(tt:PTR TO LONG, entry, defaultval) DEF res=NIL IF tt AND (iconbase<>NIL) IF res:=FindToolType(tt, entry) THEN StrToLong(res, {defaultval}) ENDIF ENDPROC defaultval 1s-lh0-\Src\Tools\AmigaLib\boopsi.exOPT MODULE OPT PREPROCESS MODULE 'intuition/classes', 'intuition/classusr', 'utility/hooks' EXPORT PROC callHookA(h:PTR TO hook, obj, msg) -> CallHookPkt would require that caller has the utility library open DEF entry entry:=h.entry MOVE.L h, A0 MOVE.L msg, A1 MOVE.L obj, A2 MOVE.L entry, A3 JSR (A3) MOVE.L D0, entry ENDPROC entry EXPORT PROC setSuperAttrsA(cl:PTR TO iclass, obj, msg) ENDPROC doSuperMethodA(cl, obj, [OM_SET, msg, NIL]) EXPORT PROC coerceMethodA(cl:PTR TO iclass, obj, msg) IF obj AND (cl<>NIL) RETURN callHookA(cl.dispatcher, obj, msg) ENDIF ENDPROC NIL EXPORT PROC doSuperMethodA(cl:PTR TO iclass, obj, msg) IF obj AND (cl<>NIL) RETURN callHookA(cl.super.dispatcher, obj, msg) ENDIF ENDPROC NIL EXPORT PROC doMethodA(obj, msg) DEF o:PTR TO object_ IF obj o:=OBJECT_(obj) -> Get real object RETURN callHookA(o.class.dispatcher, obj, msg) ENDIF ENDPROC NIL -c-lh0- tSrc\Tools\AmigaLib\cx.eOPT MODULE OPT PREPROCESS MODULE 'commodities', 'icon', 'devices/inputevent', 'libraries/commodities' EXPORT PROC userFilter(tt, action_name, default_descr) DEF desc=NIL IF (iconbase=NIL) OR (cxbase=NIL) THEN RETURN NIL IF tt THEN desc:=FindToolType(tt, action_name) ENDPROC CxFilter(IF desc THEN desc ELSE default_descr) EXPORT PROC hotKey(description, port, id) DEF filter IF cxbase=NIL THEN RETURN NIL IF filter:=CxFilter(description) AttachCxObj(filter, CxSender(port, id)) AttachCxObj(filter, CxTranslate(NIL)) IF CxObjError(filter) DeleteCxObjAll(filter) filter:=NIL ENDIF ENDIF ENDPROC filter EXPORT PROC freeIEvents(events:PTR TO inputevent) DEF next WHILE events next:=events.nextevent END events events:=next ENDWHILE ENDPROC ENUM ERR_NONE, ERR_ESC, ERR_ANGLE EXPORT PROC invertStringRev(str, km) HANDLE DEF events=NIL, c, curr:PTR TO inputevent, ie:PTR TO inputevent IF cxbase=NIL THEN RETURN NIL IF str IF str[] curr:=(events:=NEW ie) c:=str[]++ REPEAT IF c="<" str:=doangle(str, curr) ELSE IF c="\\" THEN c:=doesc(str[]++) InvertKeyMap(c, curr, km) ENDIF IF c:=str[]++ curr.nextevent:=NEW ie curr:=ie ENDIF UNTIL c=NIL ENDIF ENDIF RETURN events EXCEPT freeIEvents(events) RETURN NIL ENDPROC EXPORT PROC invertString(str, km) HANDLE DEF events=NIL:PTR TO inputevent, c, prev:PTR TO inputevent IF cxbase=NIL THEN RETURN NIL IF str IF str[] WHILE c:=str[]++ prev:=events NEW events events.nextevent:=prev IF c="<" str:=doangle(str, events) ELSE IF c="\\" THEN c:=doesc(str[]++) InvertKeyMap(c, events, km) ENDIF ENDWHILE ENDIF ENDIF RETURN events EXCEPT freeIEvents(events) RETURN NIL ENDPROC PROC doesc(c) SELECT "u" OF c CASE "\q", "'", "<", "\\" RETURN c CASE "0" RETURN 0 CASE "n", "r" RETURN "\b" CASE "t" RETURN "\t" DEFAULT Raise(ERR_ESC) ENDSELECT ENDPROC PROC doangle(str, events:PTR TO inputevent) DEF s, c, ix:inputxpression s:=str WHILE s[] AND (s[]<>">") DO s++ IF c:=s[] THEN s[]:=NIL IF ParseIX(str, ix)<>0 THEN Raise(ERR_ANGLE) events.class:=ix.class events.code:=ix.code events.qualifier:=ix.qualifier s[]++:=c ENDPROC s 5-lh0-USrc\Tools\AmigaLib\interrupts.eOPT MODULE MODULE 'graphics/graphint', 'hardware/intbits' EXPORT PROC addTOF(i:PTR TO isrvstr, p, a) i.code:={ttskasm} i.iptr:=i i.ccode:=p i.carg:=a AddIntServer(INTB_VERTB, i) ENDPROC EXPORT PROC remTOF(i:PTR TO isrvstr) RemIntServer(INTB_VERTB, i) ENDPROC EXPORT PROC waitbeam(pos) WHILE pos>VbeamPos() DO NOP ENDPROC ttskasm: MOVE.L $1A(A1), -(A7) MOVEA.L $16(A1), A0 JSR (A0) ADDQ.L #4, A7 MOVEQ.L #0, D0 RTS --lh0-444wSrc\Tools\AmigaLib\io.e~OPT MODULE MODULE 'exec/io', 'exec/memory', 'exec/nodes', 'exec/ports' ENUM ERR_NONE, ERR_SIG RAISE ERR_SIG IF AllocSignal()=-1 EXPORT PROC beginIO(ioreq:PTR TO io) DEF base base:=ioreq.device MOVEA.L base, A6 MOVEA.L ioreq, A1 JSR -30(A6) ENDPROC EXPORT PROC createStdIO(port) IS createExtIO(port, SIZEOF iostd) EXPORT PROC deleteStdIO(ioReq) IS deleteExtIO(ioReq) EXPORT PROC createExtIO(port, ioSize) HANDLE DEF ioReq=NIL:PTR TO io IF port ioReq:=NewM(ioSize, MEMF_CLEAR OR MEMF_PUBLIC) ioReq.mn.ln.type:=NT_REPLYMSG ioReq.mn.length:=ioSize ioReq.mn.replyport:=port ENDIF EXCEPT DO ENDPROC ioReq EXPORT PROC deleteExtIO(ioReq:PTR TO io) IF ioReq ioReq.mn.ln.succ:=-1 ioReq.mn.replyport:=-1 ioReq.device:=-1 Dispose(ioReq) ENDIF ENDPROC 0-lh0-є~Src\Tools\AmigaLib\lists.e OPT MODULE MODULE 'exec/lists' EXPORT PROC newList(mlh:PTR TO mlh) mlh.head:=mlh+4 -> Point to tail mlh.tail:=NIL mlh.tailpred:=mlh -> Point to head ENDPROC 0-lh0-۔~Src\Tools\AmigaLib\ports.eOPT MODULE MODULE 'amigalib/lists', 'exec/lists', 'exec/memory', 'exec/nodes', 'exec/ports' EXPORT PROC createPort(name, pri) HANDLE DEF sigBit=-1, port=NIL:PTR TO mp sigBit:=AllocSignal(-1) port:=NewM(SIZEOF mp, MEMF_CLEAR OR MEMF_PUBLIC) port.ln.name:=name port.ln.pri:=pri port.ln.type:=NT_MSGPORT port.flags:=PA_SIGNAL port.sigbit:=sigBit port.sigtask:=FindTask(NIL) IF name AddPort(port) ELSE newList(port.msglist) ENDIF RETURN port EXCEPT IF port THEN Dispose(port) IF sigBit<>-1 THEN FreeSignal(sigBit) RETURN NIL ENDPROC EXPORT PROC deletePort(port:PTR TO mp) IF port.ln.name THEN RemPort(port) port.sigtask:=-1 port.msglist.head:=-1 FreeSignal(port.sigbit) Dispose(port) ENDPROC 1S-lh0-~Src\Tools\AmigaLib\random.ePOPT MODULE OPT PREPROCESS DEF rangeSeed EXPORT PROC fastRand(num) IS IF num>0 THEN num*2 ELSE Eor(num*2, $1d872b41) #define UNSIGNED(x) (x AND $FFFF) EXPORT PROC rangeRand(num) DEF max max:=UNSIGNED(num-1) REPEAT max:=Shr(max,1) rangeSeed:=fastRand(rangeSeed) UNTIL (max<=0) IF num RETURN UNSIGNED(Shr(Mul(UNSIGNED(num), UNSIGNED(rangeSeed)), 16)) ELSE RETURN UNSIGNED(rangeSeed) ENDIF ENDPROC 0-lh0-ffkZL"Src\Tools\AmigaLib\tasks.eOPT MODULE MODULE 'amigalib/lists', 'exec/memory', 'exec/nodes', 'exec/tasks' OBJECT fakememlist ln_succ:LONG ln_pred:LONG ln_type:CHAR ln_pri:CHAR ln_name:LONG numentries:INT tsk_reqs:LONG tsk_length:LONG stk_reqs:LONG stk_length:LONG ENDOBJECT EXPORT PROC createTask(name, pri, initPC, stackSize, data=NIL) DEF ml:fakememlist, newTask=NIL:PTR TO tc stackSize:=(stackSize+3) AND -4 -> Not(3) is -4 (honest!) CopyMem([0, 0, 0, 0, 0, 2, MEMF_PUBLIC OR MEMF_CLEAR, SIZEOF tc, MEMF_CLEAR, stackSize]:fakememlist, ml, SIZEOF fakememlist) IF ml:=AllocEntry(ml) newTask:=ml.tsk_reqs newTask.splower:=ml.stk_reqs newTask.spupper:=newTask.splower+stackSize newTask.spreg:=newTask.spupper newTask.userdata:=data newTask.ln.type:=NT_TASK newTask.ln.pri:=pri newTask.ln.name:=name newList(newTask.mementry) AddHead(newTask.mementry, ml) IF (AddTask(newTask, initPC, 0)=NIL) AND KickVersion(37) FreeEntry(ml) RETURN NIL ENDIF ENDIF ENDPROC newTask EXPORT PROC deleteTask(tc) IS RemTask(tc) 7-lh0-,s!Src\Tools\AmigaLib\testargarray.eC3MODULE 'icon', 'amigalib/argarray' ENUM ERR_NONE, ERR_LIB RAISE ERR_LIB IF OpenLibrary()=NIL PROC main() HANDLE DEF p:PTR TO LONG, i=0 iconbase:=OpenLibrary('icon.library', 33) IF p:=argArrayInit() -> Result is a NIL-terminated list of strings WriteF('Integer value of "ARG_ONE" is \d (default is 2)\n', argInt(p, 'ARG_ONE', 2)) WriteF('String value of "OTHER" is "\s" (default is "fred")\n', argString(p, 'OTHER', 'fred')) WriteF('\nActual arguments are:\n') WHILE p[] DO WriteF('\d[2]: "\s"\n', i++, p[]++) WriteF('Total: \d arguments\n', i) argArrayDone() ENDIF EXCEPT DO IF iconbase THEN CloseLibrary(iconbase) ENDPROC1-lh0-n n Src\Tools\AmigaLib\testcx.e:OPT PREPROCESS MODULE 'commodities', 'amigalib/cx', 'devices/timer', 'devices/inputevent', 'dos/dos', 'exec/ports', 'libraries/commodities' ENUM ERR_NONE, ERR_BRKR, ERR_CRCX, ERR_CXERR, ERR_HOT, ERR_LIB, ERR_PORT RAISE ERR_BRKR IF CxBroker()=NIL, ERR_CRCX IF CreateCxObj()=NIL, ERR_LIB IF OpenLibrary()=NIL, ERR_PORT IF CreateMsgPort()=NIL CONST EVT_HOTKEY=1 DEF broker_mp=NIL:PTR TO mp, broker=NIL, cxsigflag, ie:PTR TO inputevent PROC main() HANDLE DEF hotkey, msg, newshell newshell:='newshell\b' cxbase:=OpenLibrary('commodities.library', 37) broker_mp:=CreateMsgPort() cxsigflag:=Shl(1, broker_mp.sigbit) broker:=CxBroker([NB_VERSION, 0, 'HotKey', 'Little Hotkey', 'A little hot key commodity', NBU_UNIQUE OR NBU_NOTIFY, 0, 0, 0, broker_mp, 0]:newbroker, NIL) IF hotkey:=hotKey('rawkey control f1', broker_mp, EVT_HOTKEY) AttachCxObj(broker, hotkey) IF CxObjError(hotkey)<>FALSE Raise(ERR_CXERR) ELSE IF ie:=invertStringRev(newshell, NIL) ActivateCxObj(broker, TRUE) processMsg() freeIEvents(ie) ENDIF ENDIF ELSE Raise(ERR_HOT) ENDIF EXCEPT DO IF broker THEN DeleteCxObjAll(broker) IF broker_mp WHILE msg:=GetMsg(broker_mp) DO ReplyMsg(msg) DeleteMsgPort(broker_mp) ENDIF IF cxbase THEN CloseLibrary(cxbase) SELECT exception CASE ERR_BRKR; WriteF('Error: Could not create broker\n') CASE ERR_CRCX; WriteF('Error: Could not create CX object\n') CASE ERR_CXERR; WriteF('Error: Could not activate broker\n') CASE ERR_HOT; WriteF('Error: Could not create hot key\n') CASE ERR_LIB; WriteF('Error: Could not open required library\n') CASE ERR_PORT; WriteF('Error: Could not create message port\n') ENDSELECT ENDPROC PROC processMsg() DEF msg, sigrcvd, msgid, msgtype, going=TRUE WHILE going sigrcvd:=Wait(SIGBREAKF_CTRL_C OR cxsigflag) WHILE msg:=GetMsg(broker_mp) msgid:=CxMsgID(msg) msgtype:=CxMsgType(msg) ReplyMsg(msg) SELECT msgtype CASE CXM_IEVENT IF msgid=EVT_HOTKEY WriteF('You hit the HotKey -- adding input events\n') AddIEvents(ie) ENDIF CASE CXM_COMMAND SELECT msgid CASE CXCMD_DISABLE ActivateCxObj(broker, FALSE) CASE CXCMD_ENABLE ActivateCxObj(broker, TRUE) CASE CXCMD_KILL going:=FALSE CASE CXCMD_UNIQUE going:=FALSE ENDSELECT ENDSELECT ENDWHILE IF sigrcvd AND SIGBREAKF_CTRL_C THEN going:=FALSE ENDWHILE ENDPROC 9s-lh0-VVU#Src\Tools\AmigaLib\testinterrupts.eMODULE 'amigalib/interrupts', 'dos/dos', 'graphics/graphint' DEF var PROC main() DEF i:isrvstr var:=0 WriteF('var = \d\n', var) addTOF(i, {test_int}, {var}) WriteF('var = \d\n', var) Wait(SIGBREAKF_CTRL_C) WriteF('var = \d\n', var) remTOF(i) ENDPROC PROC test_int(addr:PTR TO LONG) addr[]:=addr[]+1 ENDPROC :-lh0-9$Src\Tools\AmigaLib\testinterrupts2.e(MODULE 'amigalib/interrupts', 'dos/dos', 'graphics/graphint' DEF var -> This example using an interrupt to toggle which string to print. -> Try running it in a Shell, then try redirecting output to a file. -> Look at the difference in the number of times it prints the same -> string (i.e., how many times it gets to complete a WriteF before -> the interrupt occurs), PROC main() DEF i:isrvstr, strs:PTR TO LONG, x, y, z strs:=['hello\n', 'goodbye\n'] var:=0 x:=0; y:=0 WriteF('var = \d\n', var) addTOF(i, {test_int}, {var}) WriteF('var = \d\n', var) REPEAT z:=var IF z<>y x:=0; y:=z ENDIF WriteF('\d \s', x++, strs[z]) UNTIL CtrlC() WriteF('var = \d\n', var) remTOF(i) ENDPROC PROC test_int(addr:PTR TO LONG) addr[]:=1-addr[] ENDPROC 3-lh0-{Src\Tools\AmigaLib\testtime.e>'MODULE 'amigalib/time' PROC main() DEF error WriteF('Just going to delay for 20 secs...\n') error:=timeDelay(0, 20, 0) WriteF(IF error THEN 'Ack! Something went wrong.\n' ELSE 'Done!\n') ENDPROC /l-lh0-88~Src\Tools\AmigaLib\time.eOPT MODULE MODULE 'amigalib/io', 'amigalib/ports', 'devices/timer', 'exec/io' EXPORT PROC timeDelay(unit, seconds, micros) DEF port, tr:PTR TO timerequest, error=TRUE IF port:=createPort(NIL, 0) IF tr:=createExtIO(port, SIZEOF timerequest) IF OpenDevice('timer.device', unit, tr, 0)=0 tr.time.secs:=seconds tr.time.micro:=micros tr.io.command:=TR_ADDREQUEST DoIO(tr) CloseDevice(tr) error:=FALSE ENDIF deleteExtIO(tr) ENDIF deletePort(port) ENDIF ENDPROC error /-lh0-,h"Src\Tools\Arexx\arexx.docarexx.m: simple routines for adding an arexx-port to your program. port:=rx_OpenPort(portname) Creates an arexx-port. macro programs may now reach you by saying 'ADDRESS portname'. May raise: "MEM", "SIG", "DOUB". the last two are 'could not allocate signal' and 'port with same name already exists'. rx_ClosePort(port) Frees up the port and all associated resources. May safely be called with NIL. mes,string:=rx_GetMsg(port) Just about the same as exec's GetMsg, only now rexx-specific. extracts the string send from the macro program. If mes=NIL then there was no message. rx_ReplyMsg(mes,rc=0,resultstring=NIL) reply the message you got from rx_GetMsg(). pass rc=0 for no error, and a string if you think the command send requires a result. rc>0 signals an error (no result is returned). rx_HandleAll(interpret_proc,portname) The first four functions supply you with all the machinery needed for adding an arexxport to your programs. However, if all your program does is wait for and process messages from arexx anyway, you can use this function which encapsulates the other four. All it needs is a PROC to process the messages and again a portname. Alternatively, the source of this function is a usefull example of how to call the other four functions, just incase you want to call them yourself: PROC rx_HandleAll(interpret_proc,portname) HANDLE DEF port=NIL,sig,quit=FALSE,mes,s,rc,rs port,sig:=rx_OpenPort(portname) REPEAT Wait(sig) REPEAT mes,s:=rx_GetMsg(port) IF mes quit,rc,rs:=interpret_proc(s) rx_ReplyMsg(mes,rc,rs) ENDIF UNTIL (mes=NIL) OR (quit=TRUE) UNTIL quit Raise() EXCEPT rx_ClosePort(port) ReThrow() ENDPROC From the code we can see that the proc given as an argument to rx_HandleAll() gets as argument a string he may want to process, and returns a flag wether to quit or not, and the rc and result as mentioned in the rx_Reply() function. see arexxsimple.e how to make an arexxhost with this function with just a few lines of code. -g-lh0-l"Src\Tools\Arexx\arexx.e|OPT MODULE MODULE 'exec/ports', 'exec/nodes', 'rexx/storage', 'rexxsyslib' RAISE "MEM" IF CreateArgstring()=NIL DEF rexxsysbase EXPORT PROC rx_OpenPort(portname) DEF port:PTR TO mp,sig,exc=0 NEW port Forbid() IF FindPort(portname) exc:="DOUB" ELSE port.sigtask:=FindTask(0) port.flags:=PA_SIGNAL port::ln.name:=portname port::ln.type:=NT_MSGPORT IF (sig:=AllocSignal(-1))=NIL exc:="SIG" ELSE port.sigbit:=sig AddPort(port) ENDIF ENDIF Permit() IF exc THEN Raise(exc) ENDPROC port,Shl(1,sig) EXPORT PROC rx_ClosePort(port:PTR TO mp) IF port FreeSignal(port.sigbit) RemPort(port) Dispose(port) ENDIF ENDPROC EXPORT PROC rx_GetMsg(port) DEF mes:PTR TO rexxmsg IF mes:=GetMsg(port) rexxsysbase:=mes.libbase RETURN mes,Long(mes.args) ENDIF ENDPROC NIL,NIL EXPORT PROC rx_ReplyMsg(mes:PTR TO rexxmsg,rc=0,resultstring=NIL) mes.result1:=rc mes.result2:=NIL IF mes.action AND RXFF_RESULT AND (rc=0) AND (resultstring<>NIL) mes.result2:=CreateArgstring(resultstring,StrLen(resultstring)) ENDIF ReplyMsg(mes) ENDPROC EXPORT PROC rx_HandleAll(interpret_proc,portname) HANDLE DEF port=NIL,sig,quit=FALSE,mes,s,rc,rs port,sig:=rx_OpenPort(portname) REPEAT Wait(sig) REPEAT mes,s:=rx_GetMsg(port) IF mes quit,rc,rs:=interpret_proc(s) rx_ReplyMsg(mes,rc,rs) ENDIF UNTIL (mes=NIL) OR (quit=TRUE) UNTIL quit Raise() EXCEPT rx_ClosePort(port) IF exception THEN ReThrow() ENDPROC 1-lh0-e"Src\Tools\Arexx\arexxtest.e$-> test arexx module, the easy way out MODULE 'tools/arexx' PROC main() rx_HandleAll({process},'AREXXTESTPORT') ENDPROC PROC process(s) WriteF('Received message "\s" from Arexx!\n',s) ENDPROC StrCmp(s,'quit'),0,'result!' 4-lh0-2s"Src\Tools\Arexx\arexxtest.rexx/* rx module test */ address AREXXTESTPORT OPTIONS RESULTS say 'testing....' 'bla' say 'result='result 'quit' say 'result='result say 'done.' 1-lh0-))i"Src\Tools\Async\async.guide@database Async.guide @$VER: Async.Guide 1.0 (06.11.93). @toc async.m/main @author Michael Zucchi @(c) 1993 Michael Zucchi, All right reserved @node Main "Async.guide" @next "Commands" Aynschronous file reading module for AmigaE2.5+ 1993 @{"Michael Zucchi" Link "Author"} All Rights Reserved This document describes the usage of a suite of asynchronous file reading routines designed for the AmigaE language. The interface is designed to follow the V36 dos.library calls as closely as possible. The following sections are available: @{" OverView " Link "OverView"} some of the ideas behind the module @{u}General functions@{uu} @{"as_Open() " Link "as_Open"} to open a file @{"as_Close() " Link "as_Close"} to close a file @{"as_Read() " Link "as_Read"} reading from the file @{u}High level functions@{uu} @{"as_FGetS() " Link "as_FGetS"} reading text lines @{"as_FGetC() " Link "as_FGetC"} reading character by character @{u}Low level functions@{uu} @{"as_NextBuffer()" Link "as_NextBuffer"} accessing input buffers direct @{" Examples " Link Examples} @{b}NOTE: This module @{i}requires @{ui}Workbench 2.0 (V36) or higher! Please make sure that this version of the system libraries is present before using these functions.@{ub} @endnode @node OverView "Module overview" Just what is meant by 'asynchronous i/o'? When most programs use dos.library to read/write files, they simply call Read() or Write(). What happens then is that these functions examine the filehandle passed to them for information about the handler that handles the file, and creates a dos 'packet' out of this information (see dos/dosextens.m to see what a packet looks like). This packet is then sent via the standard message passing system to the handler handling the file. The dos function calls then wait for a reply to the request via the process's message port pr_MessagePort - i.e. they @{u}wait@{uu} until the filesystem and handler have retrieved the information before returning (incidentally, the fact that the replies come in through pr_MessagePort is the reason dos cannot be called from a standard 'task'). With a slow i.o device (e.g. floppy disk) all of this waiting can mean the cpu is sitting idle a lot of the time waiting for data to come in. How do you fix this less than ideal situation? Its quite simple. You can create your @{u}own@{uu} packets and send these packets direct to dos. This way, a custom reply port can be set up for the packets, and requests for reads (or writes) can be sent out immediately, and the data read when the packets are returned. If something needs to be done while the filesystem is fetching this data, then your program can get it done - without having to wait. This is basically what async.m does. Currently only reading is supported, but writing will be added in the future, along with utilitiy functions like Seek() etc. I got the idea from some code i got off the local BBS, something from one of the cool guys at Commodore i think. @endnode @node "Author" "The guy who wrote it" I wrote this code some time ago, mainly for a multi-threaded directory utility i've been working on from time to time. I found it so handy for adding just that extra bit of performance to just about everything i wrote that i thought other people might find it useful too. Presently, i study `from time to time' (:-) in order to obtain a Computer Systems Engineering degree from the Univerity Of South Australia. I'm `Zed' of FRONTIER in my anti-os hours. I can be contacted in the following ways: Internet email: 9107047w@lux.levels.unisa.edu.au till the end of '94 at least - reliable `Real Mode' (tm) mail: Michael Zucchi PO BOX 824 Waikerie South Australia 5330 slow, but very reliable - till mum sells the house :) Michael Zucchi 110 Dunrobin Rd Warradale South Australia 5046 to my door - till i move (?) @endnode @node as_Open async.m/as_Open async.m/as_Open SYNTAX file := as_Open( name:PTR TO CHAR, mode:LONG, count:LONG, size:LONG ); PURPOSE Opens an asynchronous file, and returns a pointer to a (private) file handle. When called, packets will be sent to the appropriate handler to fill all buffers, and the return will call immediately. INPUTS name A string, describing the name of the file to open mode Same as mode in dos.library/Open. @{u}Must@{uu} be MODE_OLDFILE for now. count Number of buffers to allocate. 3 works very well. size The size of each buffer to allocate. Above 5000 works well, must be a multiple of 4. OUTPUTS file A pointer to a filehandle that may be passed to the other async functions. NOTES No sanity checking is done on any of the input values. Use reasonable values for everything. The filehandle returned by as_Open() is NOT compatible with normal dos filehandles, and system calls! SEE ALSO @{"as_Close()" Link "as_Close"}, @{"as_NextBuffer()" Link "as_NextBuffer"}, @{"as_Read()" Link "as_Read"}, @{"as_FGetS()" Link "as_FGetS"}, @{"as_FGetC()" Link "as_FGetC"} @endnode @node as_Close async.m/as_Close async.m/as_Close SYNTAX as_Close( file:LONG ); PURPOSE Closes the file, free's all memory buffers and cleans up all outstanding packets. This call may be made as any time on a valid async filehandle. INPUTS file valid filehandle from as_Open(), or NIL in which case nothing happens. OUTPUTS NOTES SEE ALSO @{"as_Open()" Link "as_Open"} @endnode @node as_Read async.m/as_Read async.m/as_Read SYNTAX bytes := as_Read( file:LONG, buffer:PTR TO CHAR, number:LONG ); PURPOSE as_Read reads a number of bytes ('number') into the buffer specified by 'buffer', from the async file 'file'. The number of bytes actually read in is indicated by the return value. A return of zero indicates end of file, and errors are flagged by a return value of -1. INPUTS file Only a valid filehandle from as_Open() is allowed. buffer A pointer to at least 'number' bytes of memory to store the data. May be arbitrarily aligned. number Specifies the number of bytes to read. number=0 is ignored. OUTPUTS bytes The number of bytes actually stored in 'buffer'. A value of zero indicates end of file, and -1 that a file error has occurred, check IoErr() for detail. NOTES SEE ALSO @{"as_Open()" Link "as_Open"}, @{"as_Close()" Link "as_Close"}, @{"as_NextBuffer()" Link "as_NextBuffer"}, @{"as_FGetS()" Link "as_FGetS"}, @{"as_FGetC()" Link "as_FGetC"} @endnode @node as_FGetS async.m/as_FGetS async.m/as_FGetS SYNTAX buffer := as_FGetS( file:LONG, buffer:PTR TO CHAR, number:LONG ); PURPOSE Reads upto 'size' bytes from the file 'file' into the buffer pointed to by the buffer parameter. Stops reading at end of file or once a NEWLINE ($0a) character is encountered. Returns a pointer to that buffer or NIL on end of file or error. The string stored in the buffer is NULL terminated. INPUTS file A valid filehandle from @{"as_Open()" Link "as_Open"}. buffer A pointer to at least 'number' bytes of memory to store the data. May be arbitrarily aligned. number Specifies the number of bytes to read, at maximum. This @{b}MUST be >2@{ub}. OUTPUTS buffer Same as 'buffer' passed as an input, or NIL on end of file or file error. NOTES If the line is too long to fit, the input stream is not skipped till the next linefeed. SEE ALSO @{"as_Open()" Link "as_Open"}, @{"as_Close()" Link "as_Close"}, @{"as_Read()" Link "as_Read"}, @{"as_NextBuffer()" Link "as_NextBuffer"}, @{"as_FGetC()" Link "as_FGetC"} @endnode @node as_FGetC async.m/as_FGetC async.m/as_FGetC SYNTAX char := as_FGetC( file:LONG ); PURPOSE Reads the next character from the input file. Returns -1 on error or end of file. The character is an unsigned 32 bit quantity. INPUTS file A valid filehandle from @{"as_Open()" Link "as_Open"}. OUTPUTS char The next available byte from the input stream, or -1 on error. NOTES This call is about as efficient as possible. SEE ALSO @{"as_Open()" Link "as_Open"}, @{"as_Close()" Link "as_Close"}, @{"as_Read()" Link "as_Read"}, @{"as_NextBuffer()" Link "as_NextBuffer"}, @{"as_FGetS()" Link "as_FGetS"} @endnode @node as_NextBuffer async.m/as_NextBuffer async.m/as_NextBuffer SYNTAX buffer,valid := as_NextBuffer( file:LONG ); PURPOSE Returns the next available data buffer in the file. If end of file has not yet been reached, and a buffer has now been made free, then another read request is sent to the filesystem, in an asynchronous manner. INPUTS file A valid filehandle from @{"as_Open()" Link "as_Open"}. OUTPUTS buffer The address of the internal data buffer, 0 for end of file, or -1 on a file error. valid Number of valid bytes in the buffer. This will be the same as the size of each buffer as specified when the file was opened, unless it is the last buffer being read. NOTES @{b}The call is NOT compatible with any of the other reading functions.@{ub} If you call those functions, you must NOT call this function, and visa-versa. It is a low level function which both of the other read functions make use of directly, and should only be used (esclusively) where extra performance/lower memory use is required. SEE ALSO @{"as_Open()" Link "as_Open"}, @{"as_Close()" Link "as_Close"}, @{"as_Read()" Link "as_Read"}, @{"as_FGetS()" Link "as_FGetS"}, @{"as_FGetC()" Link "as_FGetC"} @endnode @node Examples "Information about the examples" Included with this package are a few examples of using this module. @{u}typef@{uu} This is a simple example demonstrating the use of the as_FGetS() call. It simply types a specified file to the current shell - quite a bit faster than c:type does. usage: @{"typef" Link typef.e/main} [Name] @{u}PlaySamp@{uu} This is a non-trivial example of the as_Read() function. It is a complete 'raw sample' player that can be used to play ANY sized sample from disk. usage: @{"PlaySamp" Link playsamp.e/main} [Name] [ ... ] RATE @{u}histogram@{uu} A simple example of using the as_NextBuffer() command. It counts the occurrannces of each byte in a file, and produces a report when done. usage: @{"histogram" Link histogram.e/main} [Name] Coding a more useful example for as_NextBuffer() requires a bit more work than i have time for :) @endnode 1/-lh0-uf"Src\Tools\Async\histogram.e_/* histogram.e Michael Zucchi 1993 Gives a population count for each byte in a file. */ MODULE 'tools/async', 'dos/dos' DEF counts[300]:ARRAY OF LONG; PROC main() DEF in,args:PTR TO LONG,rdargs,start:PTR TO CHAR,size,i; args:=[0]; IF rdargs:=ReadArgs('Name/A', args, 0) IF (in:=as_Open(args[0],MODE_OLDFILE,3,5120)) REPEAT start,size := as_NextBuffer(in); IF start>0 FOR i:=0 TO size-1 counts[start[i]]:=counts[start[i]]+1; ENDFOR ENDIF UNTIL start<=0 as_Close(in) FOR i:=0 TO 255 WriteF('$\h[02]: \d\n', i, counts[i]); ENDFOR ENDIF FreeArgs(rdargs) ENDIF ENDPROC 0-lh0-f"Src\Tools\Async\playsamp.e/* PlaySamp.e Michael Zucchi 1993 A disk based raw sample player, written in AmigaE. */ MODULE 'tools/async', 'dos/dos', 'exec/io', 'exec/memory', 'exec/ports', 'devices/audio' CONST BUFFSIZE = 5120, BUFFCOUNT = 3 PROC main() DEF args:PTR TO LONG,rdargs,rate,names:PTR TO LONG args:=[0,0] IF rdargs:=ReadArgs('Name/A/M,Rate/N',args,0) -> is there an easier way to do this crap? MOVE.L args,A0 MOVE.L 4(A0),D0 BEQ.S rate_def MOVE.L D0,A0 MOVE.L (A0),D0 CMP.L #999,D0 BLT.S rate_def CMP.L #60001,D0 BLT.S rate_ok rate_def: MOVE.L #10000,D0 rate_ok: MOVE.L D0,rate names:=args[0]; WHILE (names[0]) play(names[]++,rate) ENDWHILE FreeArgs(rdargs) ENDIF ENDPROC PROC play(filename,rate) DEF arequest1:PTR TO ioaudio, arequest2:ioaudio, reply1,reply2, ior:PTR TO io, ioa:PTR TO ioaudio, mnode:PTR TO mn, buffer1,buffer2, file, len, go WriteF('playing "\s"\n',filename) IF file:=as_Open(filename,MODE_OLDFILE,BUFFCOUNT,BUFFSIZE) IF buffer1:=AllocVec(BUFFSIZE,MEMF_CHIP) IF buffer2:=AllocVec(BUFFSIZE,MEMF_CHIP) IF reply1:=CreateMsgPort() IF reply2:=CreateMsgPort() IF arequest1:=CreateIORequest(reply1, SIZEOF ioaudio) /* want to allocate and use any channel with OpenDev() */ arequest1.data:=[1,2,4,8]:CHAR arequest1.length:=4; ior:=arequest1 ior.command:=ADCMD_ALLOCATE IF (0=OpenDevice('audio.device', 0, arequest1, 0)) /* copy iorequest for double buffered operation */ ior.flags:=ADIOF_PERVOL arequest1.volume:=64 /* volume = MAX */ arequest1.period:=Div(3546895,rate)/* set frequency */ arequest1.cycles:=1 /* 1 cycle only */ ior.command:=CMD_WRITE CopyMem(arequest1,arequest2,SIZEOF ioaudio) mnode:=arequest2 mnode.replyport:=reply2 /* send first two buffer's full to device */ len:=as_Read(file,buffer1,BUFFSIZE) arequest1.data:=buffer1 arequest1.length:=len beginio(arequest1) len:=as_Read(file,buffer2,BUFFSIZE) arequest2.data:=buffer2 arequest2.length:=len beginio(arequest2) /* wait on request1 first time around */ mnode:=arequest1 go:=1 /* until done, keep feeding data to device */ WHILE (go) WaitPort(mnode.replyport) VOID GetMsg(mnode.replyport) ioa:=mnode IF ioa=arequest1 mnode:=arequest2 ELSE mnode:=arequest1 ENDIF IF ((len:=as_Read(file, ioa.data, BUFFSIZE))>0) AND (CheckSignal(SIGBREAKF_CTRL_C)=0) ioa.length:=len beginio(ioa) ELSE go:=0 ENDIF ENDWHILE /* clean up */ WaitPort(mnode.replyport) GetMsg(mnode.replyport) CloseDevice(arequest1) ENDIF DeleteIORequest(arequest1) ENDIF DeleteMsgPort(reply2) ENDIF DeleteMsgPort(reply1) ENDIF FreeVec(buffer2) ENDIF FreeVec(buffer1) ENDIF as_Close(file) ENDIF ENDPROC /* from amiga.lib */ PROC beginio(arequest) MOVE.L arequest,A1 MOVE.L A6,-(A7) MOVE.L $14(A1),A6 JSR -$1E(A6) MOVE.L (A7)+,A6 ENDPROC -'-lh0-`f"Src\Tools\Async\typef.eUh/* typef.e Michael Zucchi 1993 A simple, quick 'type' command, using async.m */ MODULE 'tools/async', 'dos/dos' PROC main() DEF in,args:PTR TO LONG,rdargs,line[1024]:ARRAY OF CHAR args:=[0]; IF rdargs:=ReadArgs('Name/A', args, 0) IF (in:=as_Open(args[0],MODE_OLDFILE,3,5120)) WHILE (as_FGetS(in, line, 1024)) AND (CheckSignal(SIGBREAKF_CTRL_C)=0) PutStr(line) ENDWHILE as_Close(in) ENDIF FreeArgs(rdargs) ENDIF ENDPROC /J-lh0-d"Src\Tools\Boopsi\Boopsi.ePOPT MODULE MODULE 'intuition/classes', 'utility/hooks', 'intuition/classusr' /* example call: domethod(myobj,[METHODID,...]) */ EXPORT PROC domethod(obj:PTR TO object,msg:PTR TO msg) DEF h:PTR TO hook,o:PTR TO object,dispatcher IF obj o:=obj-SIZEOF object /* instance data is to negative offset */ h:=o.class dispatcher:=h.entry /* get dispatcher from hook in iclass */ MOVE.L h,A0 MOVE.L msg,A1 MOVE.L obj,A2 /* probably should use CallHookPkt, but the */ MOVE.L dispatcher,A3 /* original code (DoMethodA()) doesn't. */ JSR (A3) /* call classDispatcher() */ MOVE.L D0,o RETURN o ENDIF ENDPROC NIL 9-lh0- oh"#Src\Tools\CloneScreen\clonescreen.e:-> clonescreen.c, from RKRM libs. OPT MODULE, OSVERSION=37 MODULE 'intuition/intuition', 'intuition/screens', 'graphics/text', 'graphics/modeid' EXPORT PROC openclonescreen(pub_screen_name,clone_title,depth=0,clone_pub_name=NIL) DEF my_screen=NIL:PTR TO screen, screen_modeID, pub_scr_font_name, font_name, font_name_size, pub_screen_font:PTR TO textattr, opened_font=NIL:PTR TO textfont, pub_screen:PTR TO screen, screen_drawinfo=NIL:PTR TO drawinfo, di_font:PTR TO textfont IF pub_screen:=LockPubScreen(pub_screen_name) IF screen_drawinfo:=GetScreenDrawInfo(pub_screen) di_font:=screen_drawinfo.font IF (screen_modeID:=GetVPModeID(pub_screen.viewport))<>INVALID_ID pub_scr_font_name:=Long(di_font+10) -> node.name font_name_size:=1+StrLen(pub_scr_font_name) IF font_name:=String(font_name_size) StrCopy(font_name,pub_scr_font_name) pub_screen_font:=[font_name,di_font.ysize,di_font.style,di_font.flags]:textattr IF opened_font:=OpenFont(pub_screen_font) IF my_screen:=OpenScreenTagList(NIL, [SA_WIDTH, pub_screen.width, SA_HEIGHT, pub_screen.height, SA_DEPTH, IF depth THEN depth ELSE screen_drawinfo.depth, SA_TYPE, IF clone_pub_name THEN PUBLICSCREEN ELSE CUSTOMSCREEN, SA_OVERSCAN, OSCAN_TEXT, SA_AUTOSCROLL, TRUE, SA_FONT, pub_screen_font, SA_PENS, screen_drawinfo.pens, SA_DISPLAYID, screen_modeID, SA_TITLE, clone_title, SA_PUBNAME, clone_pub_name, NIL]) ENDIF ENDIF ENDIF ENDIF FreeScreenDrawInfo(pub_screen,screen_drawinfo) ENDIF UnlockPubScreen(pub_screen_name,pub_screen) ENDIF IF my_screen=NIL THEN Raise("SCR") ENDPROC my_screen,opened_font EXPORT PROC closeclonescreen(screen,font,window=NIL) DEF r IF window THEN CloseWindow(window) IF screen THEN r:=CloseScreen(screen) IF r THEN IF font THEN CloseFont(font) ENDPROC r EXPORT PROC getcloneinfo(screen:PTR TO screen) DEF di:PTR TO drawinfo, depth=0 IF di:=GetScreenDrawInfo(screen) depth:=di.depth FreeScreenDrawInfo(screen,di) ENDIF ENDPROC depth,screen.width,screen.height EXPORT PROC backdropwindow(screen:PTR TO screen,idcmp=0,flags=0) DEF wnd=NIL:PTR TO window IF (wnd:=OpenWindowTagList(NIL, [WA_LEFT,0, WA_TOP,0, WA_WIDTH,screen.width, WA_HEIGHT,screen.height, WA_IDCMP,idcmp, WA_FLAGS,flags OR $1900, WA_TITLE,'', WA_CUSTOMSCREEN,screen, NIL]))=NIL THEN Raise("WIN") stdrast:=wnd.rport ENDPROC wnd 7,-lh0-zzh"!Src\Tools\CloneScreen\testclone.em -> test screen cloning OPT OSVERSION=37 MODULE 'tools/clonescreen' PROC main() HANDLE DEF screen=NIL,font=NIL,win=NIL,xsize,ysize,depth screen,font:=openclonescreen('Workbench','My Cloned Workbench') win:=backdropwindow(screen) depth,xsize,ysize:=getcloneinfo(screen) EasyRequestArgs(win,[20,0,'On My Own Screen + Backdrop Window!', 'Screen Dimensions Are \dx\dx\d', 'Continue'],0,[xsize,ysize,depth]) EXCEPT DO closeclonescreen(screen,font,win) SELECT exception CASE "SCR"; WriteF('no screen!\n') CASE "WIN"; WriteF('no window!\n') ENDSELECT ENDPROC =-lh0-}k"'Src\Tools\Constructors\constructors.docAconstructors.m This module conatins various constructor functions for common data structures. lh:=newlist(lh=NIL:PTR TO lh,type=0) initialises a an exec list header for you. if lh=NIL, it will allocate a the header for you, otherwise it will use the pointer. raises: "MEM" (only if lh=NIL) example: mylist:=newlist() ln:=newnode(ln=NIL:PTR TO ln,name=NIL,type=0,pri=0) like newlist, newnode will allocate a node for you if ln=NIL. raises: "MEM" (only if ln=NIL) example: newnode(n,'bla') ;:-lh0-zz}l"%Src\Tools\Constructors\constructors.es-> various constructors module OPT MODULE OPT EXPORT MODULE 'exec/lists', 'exec/nodes' PROC newlist(lh=NIL:PTR TO lh,type=0) IF lh=NIL THEN lh:=NEW lh lh.head:=lh+4 lh.tailpred:=lh lh.tail:=0 lh.type:=0 lh.pad:=0 ENDPROC lh PROC newnode(ln=NIL:PTR TO ln,name=NIL,type=0,pri=0) IF ln=NIL THEN ln:=NEW ln ln.name:=name ln.pri:=pri ln.type:=type ENDPROC ln ?w-lh0-l")Src\Tools\Constructors\constructorstest.e0-> constructortest.e MODULE 'tools/constructors' PROC main() HANDLE DEF list,a list:=newlist() FOR a:=1 TO 10 DO Enqueue(list,newnode(NIL,'silly_nodes_test'+a,0,Rnd(100))) EXCEPT WriteF('no mem!\n') ENDPROC 9)-lh0-EEjD#Src\Tools\CookRawKey\cookRawkey.docCcookRawkey.m - Module of functions designed to process a raw input event, translating it into its corresponding Vanilla keycode as defined by the current keymap. Uses the console.device. warmupRawkeyCooker() Initializes the module to enable processing of raw input events. Should be called once prior to invoking any of the other functions in the module. May raise any of the following exceptions: "MEM", ER_CREATEPORT, ER_CREATEIO, ER_OPENDEVICE, ER_ASKKEYMAP. ascii_keycode:=cookRawkey(message.code, message.qualifier, message.iaddress) ascii_keycode gets the Vanilla ASCII value if one exists, else 0. message is here a PTR TO intuimessage, which contains the address of an IDCMP_RAWKEY message. Vanilla ASCII codes may be manufactured by passing in a valid raw code and a valid raw qualifier, and a valid PTR TO LONG which points to deadkey prefixes (or zeroized memory if deadkeys aren't desired, i.e., [0]:LONG) for the iaddress. shutdownRawkeyCooker() Cleans up the module. Should be called once when the module's functions are no longer needed. Raises no exceptions. Performs complete sanity checks, and may therefore be safely called multiple times. NOTES: It is entirely possible that this module will successfully translate any kind of raw input event properly, although this has not been tested. :-) You may repeatedly warmup and shutdown the rawkey cooker module, but you must be careful to call shutdownRawkeyCooker() before calling warmupRawkeyCooker() a subsequent time. Otherwise, the allocated resources will be irreclaimable and your system will degrade. 7-lh0-jD!Src\Tools\CookRawKey\cookRawkey.e/*---------------------------------------------------------------------------* cookRawkey.e - Use console.device to convert rawkeys to asciikeys. Modifications: Rev 1, 4 Oct 94, Barry Wills cookRawkey() modified to correctly process deadkeys; 1) changed parameter 'iAddress' to 'iAddress:PTR TO LONG'; 2) changed statement 'PutLong(ie+10, iAddress)' to 'PutLong(ie+10, iAddress[])' *---------------------------------------------------------------------------*/ OPT MODULE MODULE 'console', 'devices/console', 'devices/conunit', 'devices/inputevent', 'devices/keymap', 'exec/io', 'exec/ports' EXPORT CONST ER_NONE = 0, ER_CREATEPORT = "PORT", ER_CREATEIO = "IO", ER_OPENDEVICE = "DEV", ER_ASKKEYMAP = "KMAP" DEF consoleMessagePort:PTR TO mp, consoleIO:PTR TO iostd EXPORT PROC warmupRawkeyCooker() IF (consoleMessagePort:=CreateMsgPort())=NIL THEN RETURN ER_CREATEPORT IF (consoleIO:=CreateIORequest(consoleMessagePort, SIZEOF iostd))= NIL THEN RETURN ER_CREATEIO IF OpenDevice('console.device', CONU_LIBRARY, consoleIO, CONFLAG_DEFAULT) THEN RETURN ER_OPENDEVICE consoleIO.command:=CD_ASKKEYMAP consoleIO.length:=SIZEOF keymap consoleIO.data:=NewR(SIZEOF keymap) IF DoIO(consoleIO) THEN RETURN ER_ASKKEYMAP IF (consoleIO.flags AND IOF_QUICK)=0 THEN WaitIO(consoleIO) consoledevice:=consoleIO.device ENDPROC ER_NONE /* warmupRawkeyCooker */ EXPORT PROC shutdownRawkeyCooker() IF consoleIO IF consoleIO.data THEN Dispose(consoleIO.data) IF consoleIO.device AbortIO(consoleIO) CloseDevice(consoleIO) ENDIF DeleteIORequest(consoleIO) ENDIF IF consoleMessagePort THEN DeleteMsgPort(consoleMessagePort) ENDPROC /* shutdownRawkeyCooker */ EXPORT PROC cookRawkey(idcmpCode, idcmpQualifier, iAddress:PTR TO LONG) DEF asciiChar=0, ie:inputevent, buffer[1]:STRING, actual ie.nextevent:=NIL ie.class:=IECLASS_RAWKEY ie.subclass:=0 ie.code:=idcmpCode ie.qualifier:=idcmpQualifier PutLong(ie+10, iAddress[]) actual:=RawKeyConvert(ie, buffer, 1, consoleIO.data) IF actual=1 THEN asciiChar:=buffer[0] ENDPROC asciiChar /* cookRawkey */ ;-lh0-jD%Src\Tools\CookRawKey\cookRawkeyTest.e/*------------------------------------------------------------------------* cookRawkeyTest.e - test and demonstrate usage of module cookRawkey.m See function winDim() for a neato (although somewhat messy) example of font- and os-sensitivity. Note: if your using custom fonts, you must have all characters defined in order to see them. If any show up blank (except for, like, Space), chances are that character isn't defined in your font. *------------------------------------------------------------------------*/ MODULE 'devices/inputevent', 'graphics/gfxbase', 'graphics/rastport', 'graphics/text', 'intuition/intuition', 'intuition/screens', 'tools/cookRawkey', 'tools/ctype' CONST ESCAPE_KEY=27 CONST TEXT_MAXLENGTH=23, TITLE_MAXLENGTH=20 DEF wborleft, wborbottom, fontBelowBase PROC max(a, b) IS IF a>b THEN a ELSE b PROC winDim(gfxBase:PTR TO gfxbase, windowTitle) /* determine the dimensions necessary to display our text. */ DEF scr:PTR TO screen, xsize=0, ysize=0 IF KickVersion(36) IF scr:=LockPubScreen('Workbench') xsize:=max(gfxBase.defaultfont::textfont.xsize*TEXT_MAXLENGTH, IntuiTextLength([0,1,RP_JAM1,0,0, scr.font, windowTitle,NIL]:intuitext)+1)+ (wborleft:=scr.wborleft)+scr.wborright ysize:=gfxBase.defaultfont::textfont.ysize+ scr.rastport::rastport.font::textfont.ysize+ scr.wbortop+1+ (wborbottom:=scr.wborbottom) UnlockPubScreen(NIL, scr) ENDIF ELSE wborleft:=4 wborbottom:=4 xsize:=8*TEXT_MAXLENGTH+(wborleft*2) ysize:=8*2+(wborbottom*2+1) ENDIF ENDPROC xsize,ysize PROC format(s, format, n) /*---------------------------------------------------------* format string 's' with number 'n', according to format string 'format'. pads leading spaces in 's' with zeroes. *---------------------------------------------------------*/ DEF i, strLast StringF(s, format, n) strLast:=StrLen(s)-1 FOR i:=0 TO strLast DO IF s[i]=" " THEN s[i]:="0" ENDPROC s PROC main() HANDLE DEF win=NIL:PTR TO window, winTitle, winHeight, winWidth, idcmpMessage:PTR TO intuimessage, idcmpCode, idcmpQualifier, iAddress, error, errorMessage, asciiChar, hexStr[3]:STRING, decStr[3]:STRING /*------------------------------* Init rawkey conversion module. *------------------------------*/ IF error:=warmupRawkeyCooker() THEN Raise(error) winWidth,winHeight:=winDim(gfxbase, winTitle:='Press Escape to Quit') /*-- Convert rawkeys until ESC key is pressed. --*/ IF win:=OpenW(20, 20, winWidth, winHeight, IDCMP_RAWKEY, WFLG_ACTIVATE, winTitle, NIL, WBENCHSCREEN, NIL) IF FALSE=KickVersion(36) THEN SetTopaz(win) fontBelowBase:=win.rport::rastport.txheight- win.rport::rastport.font::textfont.baseline REPEAT /*-- Wait on rawkey. --*/ WHILE (idcmpMessage:=GetMsg(win.userport))=NIL DO WaitPort(win.userport) /*-- Copy intuimessage info, then reply. --*/ idcmpCode:=idcmpMessage.code idcmpQualifier:=idcmpMessage.qualifier iAddress:=idcmpMessage.iaddress ReplyMsg(idcmpMessage) /*------------------------* Convert rawkey to ascii. *------------------------*/ IF asciiChar:=cookRawkey(idcmpCode, idcmpQualifier, iAddress) TextF(wborleft, win.height-wborbottom-fontBelowBase, 'Char=\c Hex=$\s Dec=\s', IF isprint(asciiChar) THEN asciiChar ELSE $7f, format(hexStr, '\h[3]', asciiChar), format(decStr, '\d[3]', asciiChar)) ENDIF UNTIL asciiChar=ESCAPE_KEY CloseW(win) ELSE WriteF('Can''t open window\n') ENDIF /*---------------------------------* Cleanup rawkey conversion module. *---------------------------------*/ shutdownRawkeyCooker() EXCEPT errorMessage:='figger it out' /*--------------------------------------* Handle exceptions raised by conversion *--------------------------------------*/ SELECT exception CASE "MEM"; errorMessage:='get memory' CASE ER_CREATEPORT; errorMessage:='create message port' CASE ER_CREATEIO; errorMessage:='create IO request' CASE ER_OPENDEVICE; errorMessage:='open console.device' CASE ER_ASKKEYMAP; errorMessage:='ask keymap' ENDSELECT WriteF('Could not \s!\n', errorMessage) /*---------------------------------* Cleanup rawkey conversion module. *---------------------------------*/ shutdownRawkeyCooker() ENDPROC - -lh0-zzq"Src\Tools\Ctype\ctest.e5MODULE 'tools/ctype' PROC main() WriteF('\d \d \d\n',islower(tolower("A")),islower(toupper("a")),isalnum("+")) ENDPROC / -lh0-r"Src\Tools\Ctype\ctype.docctype.m: functions usually found in ctype.h tolower(c) converts any char to lowercase toupper(c) converts any char to uppercase isspace(a) " " isupper(a) "A" .. "Z" islower(a) "a" .. "z" isalpha(a) "a" .. "z", "A" .. "Z" isalnum(a) "a" .. "z", "A" .. "Z", "0" .. "9" isxdigit(a) "0" .. "9", "a" .. "f", "A" .. "Z" isdigit(a) "0" .. "9" iscntrl(a) 0 .. 31, 128 .. 159 isprint(a) 32 .. 127, 160 .. 255 isgraph(a) isprint - isspace ispunct(a) isgraph - isalnum E-lh0-!/Src\Tools\EasyGUI\Classes\Gadgets\button.gadgetzGpNuJ* ,Dbutton.gadgetbutton 42.2 (7.3.94) NT` VH*@+N*+H:;|.<Cha@+@6.<Cia0+@2.< Cka +@."@CvA>p ]Q L!Nup%N _JgNaގNL!pNugraphics.libraryintuition.libraryutility.libraryJn f aJ@fpNuRn  NuSn fa.fpNuJn g pNuJn gJ$g pNuH *N$-:"M Y"Q"!I,m*a"Mp0-mN. L`NupNu"m6Nb"m2Nb"m.NbHL` NL`NuH6*NALCV,m2p`rNZ$@Jg AG&A &&%[$ J,m2NT+J$VDHHLlNubutton.gadgetgadgetclassH*N m$,m2N6>gB$0L`NuH9.&I*H m2 h'dp0"K,m6N"KpN`p0r2"K,m6tN o K0HT2HR4H6HւW4(H8(H؂U$&"KNLhNuH9.&I*H m2 h'dp0"K,m6N"KpN`p0r2"K,m6tN o K0HR2HR4H6HւU4(H8(H؂U$&"KNLhNuYOH2.$I"h$ o,i2N&@Jg// // Hx/ a(O KNLLXONuH6"*H&o8,m$p0- /H($I k/H j8) |/H$/I,/N JAg r Jp!@0RXp e o, `/ //0/ a"O ,/o0*o &o,`*(*o gfSgbSgfSgbSgSgYg[g|rgNSgJg"SgSg"UgBSgBSgBSgBSg`>7E`67E `. *g "@,m6N E,m6N%@)`Jg 5|.` Bj.`Jg  ` ` E%H%H 05E*)`25E.`,Jg)` )`%E8`%ED` %EH`%EL|A0,m.N @Jf:Jj*g0*.H j "p%I o$g)k g|*)g| LlpNuH4$o&I*H/ paVXOJg/* M"KpaXOpL,NuH 6&I,h$/I$/N,o,"n/I"Kp0( $IC// //H,/I(a O A"J"" o+ g0(2+@5A+ g 0(2+@4+ g 0(k5@+ g 0(k 5@ n,o,n2N*@&oJg *g @"M,o,n6N *f BkBk`D*)g" @"M *$,o,n6N7@0-:7@`*)g @2(7A4(7B0+H2*H60+H2*H7A M,o,n2N0S0*kpLlNu8H?6,h$p0( /HH I&HA/H4/N0,od n,h/H(/IL"od i$n:<"oLi/H,/N8,o0 n2 h'd o(K0)2@f&4)6+Bf6)2+Cf2) 6+AgAMT,,) g2-4)A?BV) g0-2)@?AT) g 0-i?@X) g 0-i ?@Z0/TSf0/Vkf0/Xkf 0/Zkg)*I+)gB oh/(Hx/ a~O) +g @"o,,o0,n6N +Lrft4* @$B\- f+)g^4*6*BZCS+)VtpH K (0fpHЀv62 @&CR +Hft4* @$(`:4*6*BZCSft4* @$BR$+8fp0* @ (C\ oL( g0*@\@Z@S*o0JEg,od"n,i.g +Dft4* `$` +Lft4* @$BR( g +Hfr2* @"(`8*p/Zr/S$o, K"J,Map/ M"Ja`*p/Zr/S$o, K"J,Map/R/ M"JahXOJgN+)g4(H҂"JN"J k +$N` +)g$kp"o,,m6N0*HrЁЀ(p2*H,m.Np.*j z`tJEop/\"o,,o0,n6Np o42H4(H6*H/C@6*H/A8H "/CL& M"o4$/@,o8,n6p(/H*/LNL0REǺjm`B+)g: o4>H<(H oL( Vr/ J$"k ",m2$oC h`*/ L g( g$C`/ L g g"oHz /(Nup$_Nu/ $o g"o j`/ L g g"o h`/ L g g h/<Ho/<CHz/(NuO $_Nu HP jDDDDG-lh0-!1Src\Tools\EasyGUI\Classes\Gadgets\calendar.gadgetw pNuJ$* .Hcalendar.gadgetcalendar 42.1 (11.3.94) BXd^H*@+N*+H>;|.<Cda<+@:.<C`a,+@6.<Caa+@2.< Cca +@. L!Nup%N _JgNaꎼNL!pNudos.librarygraphics.libraryintuition.libraryutility.libraryJn f aJ@fpNuRn  NuSn fa.fpNuJn g pNuJn gJ$g pNuH *N$->"M Y"Q"!I,m*a"Mp0-mN. L`NupNu"m:Nb"m6Nb"m2Nb"m.NbHL` NL`NuH6*NAPC\,m2 <rNZ$@Jg AG&A&&%[$ J,m2NT+J$VDHHLlNucalendar.gadgetgadgetclassH*N m$,m2N6>gB$0L`NuNq / o///HoHx/aONutopaz.fontSunMonTueWedThuFriSat%ldH8"&Ip0,h6N oK0HT2HR4H6HւW4(H8(H؂U$&"KNLhNuH8"&Ip0,h6N oK0HR2HR4H6HւS4(H8(H؂S$&"KNLhNuYOH2.$I"h$ o,i2N&@Jg// // Hx/ aO KNLLXONuH&I*HBoBoBopC2?@2,2.A,m.NAN7oLhNuH.*HBoBoBopC2?@22A,m.N*Ro o c p?@RoAN"<QaL`NuYOH+,.p0( JGk0)H"灒4H´m~`r20Hap.JFk0)H"偒ҁ4H´m|`r20HaD,0)2)$@@d^BJFf JGkBl~xcJGkJFk @FGB8RDicxc0LXONuH 6"*H&m$p0- $I o8,h0) Bo*|?@/I$/NJAgA,k6N$rxA%HHRXpmp%@Bj5|5|cA0C,,k2NA$ /0,k.Np0*,r2*. Ka65@ K"Ja?|* o$ `//8//(/ aO ,/o0`^(- g:rgSgJgSgSgSgSgBSgSgP` o$Jg  ` `Jg ``Jg ``Jg`` R g "H,k6N D,k6N$`A$"D 0p0*,r2*. Ka5@ K"Ja|`V5D*|`N5D`Br Dx%HHRXpm`$?|*JgBo*A2"H D,k* <lNA0,k.N*@JfJo*g |r JpM6<<<6(HւS"J$/>N o0(g"o4 ip0("JNzp o00(r2Ёra D(*pH"o,8)j>"MJfS "J M,k6NHEBEHE"ҁHt o04(&jRp00Ѓr2p0/@: "J"/:N MJfS "J MNREp@e\x*o00-2-$@?Bl@d^olz`8H Ѕ MKB/e oL( gp@e`-g|e0-rAf"o4 it4(`H$B/0-Af"o4 iv6(`H&C)0-Af"o4 it4( `H$B.0- Af"o4 ir2( `H"0/lH@B@H@Ѐ o000HDBDHD$Ԃ?@, 00BoRzx?@*A(Jg?|R(g84/Ph*gJgp-gt `R$Sgzt "J,k6N`F*H4/Pmf;|ct "J,k6Nz0/Pm*f/(r "J,k6Nxz*o0JEgT?|R0/,r2T4/*v6Rt4-A> v6ւWp0-t4/* &րU "J"/>$,k6N0/,MT<0/*<0-<0-<:/PJoRgJDg:p/(HoT K"J,o`Np/gr/hAX"J,K$/xN(XO/.`</)rHoT  K"J,o`Np/hr/gAX"J,K$/xN(XO//r "J,k6Np0/HzHopaO p/br2/,Ҁp0*>t4/*RԀ ""JNAh"HJfS "JNJ/eg,%||p/8HoT K"J,o`NXOBB*Rol8/p olcBolRDRE?EP?DpmcpLlPNuH)6*I&H"k$$Mp0+ /H( o0,h~/I$p.frpinf8*`0(H2(jH K"Ma:8pc@gH"҄21g8@g*g.rhnf.5@*H"҄21g``2**5A2**Dg5D**g5@pH"҄ Jr¨.gJg1`1&o0/+ o,"MpazXOt4-&r2*gp`p@刂p///<//<//+/ //DaFO$` o0/( K"Mpa XO0. @f~ "o0 i 2C h`*/ L g( g$C`/ L g g"oHz /(Nup$_Nu/ $o g"o j`/ L g g"o h`/ L g g h/<Ho/<CHz/(NuO $_NuJjDJj Da DNuaDDNuJj DaDNu/HA4f"H@HAHB4g0H@40HB2$Nu/v AdQC AdYC A dUCJAkSC4HBBBHC604HAdSCЁr2HCH@A&$NuH0$&HBHCCHBBBЂL Nu LT2zf DDDD($ C(-lh0-xx!-Src\Tools\EasyGUI\Classes\Gadgets\tabs.gadgetupNuJ4* *@tabs.gadgettabs 42.3 (23.2.94) NP\ VH*@+N*+H:;|.<Cha@+@6.<Cia0+@2.< Cka +@."@CvA>p ]Q L!Nup%N _JgNaގNL!pNugraphics.libraryintuition.libraryutility.libraryJn f aJ@fpNuRn  NuSn fa.fpNuJn g pNuJn gJ$g pNuH *N$-:"M Y"Q"!I,m*a"Mp0-mN. L`NupNu"m6Nb"m2Nb"m.NbHL` NL`NuH6*NALCT,m2prNZ$@Jg AG&A~&&%[$ J,m2NT+J$VDHHLlNutabs.gadgetgadgetclassH*N m$,m2N6>gB$0L`NuNqH9.&I*H m2 h'dp0"K,m6N"KpN`p0r2"K,m6tN o K0HT2HR4H6HւW4(H8(H؂U$&"KNLhNuYOH2.$I"h$ o,i2N&@Jg// // Hx/ a O KNLLXONuH6"*H&o4,m$p0- /H$$I k|8) /H/I(/N JAg `/ / / a6O ,/o,`*-"o( g.Sg*Sg.Sg*r g,gg4-HԁT""JN o(0(H"J PNRF?FN o4hm^0m&p o00("J,k6N0H*o42-H4-HԁY""JN0-H2HҀY0-H4-HԀY ""JN 0H2-H4-HԁU""JN0-H2HҀU0-H4-HԀU ""JN p o00("JN0H2-H4-HԁW""JN0-H2HҀW0-H4-HԀW ""JN 0H2-H4-HԁS""JN0-H2HҀS0-H4-HԀS ""JN oH( g,%||p o00(/ K"JaXOBB*pLl0NuQOH+p0( /I*I;|0"o$2)@.2-4) A,@m4-HHЂS4H´nxAmt0-HHҀS0Hn`t8-`TH ЀЂ m G 0@m82+HHЁS2Hn$0+@m2+HHЁS2Hn;Bp`RBDmpL(PONuH4&I*H$Kp0- "o i~0*5@ g4p(f,phhf$0*k2*@g5@~ /) M"KpaXO"o i 0*H L,NuYOH4&o*H/ / / /IaO $@ g/ M"JpaXO L,XONuYOH2$h$p0( &I +g "@,j6N"k ,j*NNLLXONuH&I*H glSgZSgrYgDgSgpSgSg"Yg`n/ M"JaRXO`n/ M"JaZXO``/ M"Ja XO`R/ M"JapXO`D/ M"Ja@XO`6/ M"JaXO`(/ M"JaXO`/ M"Ja,XO/ / / aO L(Nu/ $o gXC j`D/ L gB g>C h`*/ L g( g$C`/ L g g"oHz /(Nup$_Nu/ $o g"o j`/ L g g"o h`/ L g g h/<Ho/<CHz/(NuO $_Nu DLDDDDG:-lh0-!1Src\Tools\EasyGUI\Classes\Gadgets\tapedeck.gadgett@'pNuJ8( .Htapedeck.gadgettapedeck 40.3 (22.9.93) LXd VH*@+N$+H4;|.<Cha@+@0.<Cia0+@,.< Cka +@("@CvA8p ]Q L!Nup'N _JgNaގNL!pNugraphics.libraryintuition.libraryutility.libraryJn f aJ@fpNuRn  NuSn fa.fpNuJn g pNuJn gJHg pNuH *N$-4"M Y"Q"!I,m$a"Mp0-mN. L`NupNu"m0Nb"m,Nb"m(NbHL` NL`NuH2/ARC^pfr,n,NZ,_&@ g"A'HA8'H 'N/ K,n,NT,_-KH" VDHHLLNutapedeck.gadgetgadgetclass// nH,n,N6,_J@gBH,_NuNUH&m / KC,n,Nx,_LHN]Nugi=%08lx propgclassNUH2&m /"KE,n,N,_LLN]NuNUH:&I.+H Kp"m0) $H(m l|/HJGgZp %@X7|7|  p5@@5@B$5|F/ <r,n(N,_Jg$$ E5|F`/ / / NO ,+o` K*(&m gSgJr gSgZ`pepb j@gR 5@@`pf|0*D @@5@DR`hJgE`EER`L *PgB//< // a`O *TgR%ET` *PgB//<// a4O%EX/A,n(N,_&@ f L\N]NuNUH2&I$m+H/ p m"KaPXOJgJ/ j,n,N,_/@ Jg2r+A+j+@r+AHm/ N\PO/ o,n,N,_pLLN]NuNUH0&mH mp"m0) $H +gSgr g0Sg"`4 kp0*@ `6 kp0*Dr `$ k T` k X`/ /-/-N `pL N]NuNUH1:&I$m+H j"Kp(m0, $ICI((+ g 0(k;@+ g 0(k;@0-;|ACI/H,A ?@0/H *Eg;|/Ap,n$N,_B,0-2-@;A;|0/A"o$p,n$N,_p%@00-2-@;A;|/"LAp,n$N,_p%@40-2-@;A;|0/A"o0p,n$N,_p%@80-V@2-@;AA$/"HAp,n$N,_p%@<`L2+$d "<N 0?@ riN "2/tBoH`r.rAoH`p?@ kPl~;G/Ap,n$N,_B,0-2-@;A;o/A"o$p,n$N,_p%@00-2-@;A;G/"LAp,n$N,_p%@40-2-$@;B0/0@0+BR@;@/A"o0p,n$N,_p%@8 *Pg@2-HX4-HT6-HQB//<//<//<//-aPO$pL\N]NuH92&H$I.p0/"K,n0N,_0HT2*HR4*H6HւW4*H8*H؂U/$&"K,n0N,_LLNuNUH=2&H$I. m02(t4?@ ?A"/ "K,n0N,_0/ HrЁЀ2/ H4*H”JjR2H҂4/"H6*HÖJjR4*Hԃ6/ H8/"H/A(/"/C4&* m hp"K$/,(/4,n0N,_LLN]NuNUH?0&H+I mp0+ $H&mpd g k g&h f&m/+HzNp`"m i"kx/H,/I(`XBmp fp;@~|z|p0&J +,rf$*Egt;B*Egb~|ztB`Tt4*@f:v;C m( f*EgrAf SBf&*Ef~|z|`t4*Bfp;@Jmgp0 JGH$Jkgr$HԂr o(20(t&Hփt408/// //8Np"Hҁp o800 o<"Ka\O /$ RJg$p-"Hҁp"o(01/ o0"KaXORD&mjFe5j@BEJPgpd fp'@ / /*PNPOpL N]NuNUH#2&H$m+I mp0+ &H j<+@p(fVphhfN0+j~?@`8p0 KC0/2Am4)HH҂SHn p0,3,`RGkFe0+@FgfrAfkEE<+@7F@/ j,n,N,_/@Jg4r+A+j+@r+AHm/-NPO/ o,n,N,_$j +Egp@`pr2$+Egp@`pr2 m!A"p LLN]NuNUH'2H mp"m0) &H K"m$i~ |z;|0+i2+iBm?@?A/H `hp0- KG0/2AmF4+HH҂SHn40/2+Am(4+HH҂SHn&o p0-"3,;A`Rm&o 0-kFep*fJphjfBA\/"H < kP,n,Nr,_7k@` m 0-7@b]@f |z;|p*f4pijf,B/+\/< /+P/-aO|;k`~z`:pkbfjJPgZ0+kX@ mhUh//+PNPO.AT/"H < kP,n,Nr,_ +T@ m!@""m i 'kPL`~p*U@f0*@hg@g`f0-k`f~ |z;|`p~ |0-2+b@f2k`fr;A0-J@gS@g S@gS@g`;|`;|`;|z`$$m0-kbg ;|` z"m i p0- r2 m!A"7m@JEgJ$m/ j,n,N,_&@ g0p+@+j+K+FHm/-NPO/ K,n,N,_ LLN]NuNUH 0&H$m+I/ /-/ NO /@Jgr2+ / /A"@p KaXO o / 0Efjr///< t//</0X/<//</0T/< Hx/<Hx /<HxY/<Hz/ aOL o"/ !P /L N]NuNUH2H Jp"m0) &H m JgSg|SgSgSgUgTgSgSgSg,Yg`/- m"Ja`/- m"Ja`/- m"Ja`/- m"Ja`/- m"JaV`rp`n K&m(Eg/- K"Ja:`R/- K"Jad`D JLg/-/+LNPOBL`$JPg/ kP,n,N~,_/-/ /-NLLN]Nu"o o / "/H?"$I$,n0xz|~LDESFSG?SF?????SG?RD?"JN "RA"JNp O"JNORGRF??????RE?SF? "JN "SA"JNp O"JNOLDNu/.@Nu/.DNu/.8Nu/.C h`*/ L g( g$C`/ L g g"oHz /(Nup$_Nu/ $o g"o j`/ L g g"o h`/ L g g h/<Ho/<CHz/(NuO $_Nu LTP,@'??`x~~x`qqqqqqq* * F TD<4,$ ;-lh0-[[!%Src\Tools\EasyGUI\Classes\GI1.Licensel Gadget & Image Collection #1 COPYRIGHT and TRADEMARKS Gadget & Image Collection #1 (c) Copyright 1992-94 Commodore-Amiga, Inc. All Rights Reserved FILES classes (dir) gadgets (dir) button.gadget calendar.gadget tabs.gadget images (dir) led.image DISCLAIMER These FILES are provided "AS-IS" and subject to change without notice; no warranties are made. All use is at your own risk. No liability or responsibility is assumed. DISTRIBUTION The FILES may be reproduced and distributed subject to agreement with the following terms and conditions: 1. The FILES may be reproduced but may not be modified in any way with the exception of unarchiving for unarchived distribution. 2. The FILES may only be distributed as an integral part of a software product solely for Commodore Amiga computers. 3. Commodore shall be held harmless from any and all claims, damages and liabilities resulting from or arising out of the use or distribution of the FILES. 4. The copyright, trademarks, and disclaimer shown above must be distributed with all copies of the FILES. 5. The FILES may not be installed on a user's system or Workbench unless the installation procedure has determined that the user's system or Workbench does not contain a more recent version of the FILES. 7. Such technical information as is contained in the FILES (and any product thereof) or in the related documentation, utilities, and examples may not be exported in contravention of the laws and regulations of the United States. 8. Commodore may terminate permission to distribute the FILES at any time, with or without cause. This permission will automatically terminate upon any breach of these terms and conditions. :-lh0-!$Src\Tools\EasyGUI\Classes\GI1.ReadmeEGI1 42.1 - Copyright (c) 1994 Commodore-Amiga, Inc. All Rights Reserved. Written by David N. Junod This is a collection of BOOPSI gadgets and images. Includes a sophisticated button gadget, calendar gadget, LED image and a page selection gadget. These classes work with all Amigas and require a minimum of 2.04 (V37). See GI1.License for distribution information. An Installer installation script is included to ease installation of the classes, Autodocs, header files and examples. @R-lh0-h h l!*Src\Tools\EasyGUI\Classes\Images\led.imagepNuJ X* (LXBH*@+N*+H:;|.<CTa,+@6.<CUa+@2.< CWa +@. L!Nup%N _JgNaގNL!pNugraphics.libraryintuition.libraryutility.libraryJn f aJ@fpNuRn  NuSn fa$.fpNuJn g pNuJn gJ$g pNuH *N$-:"M Y"Q"!I,m*a"Mp0-mN. L`NupNu"m6Nb"m2Nb"m.NbHL` NL`NuH6*NAZC`,m2puЀrNZ$@Jg"AG&A&&%[$ J,m2NT` Hz0aXO+J$VDHHLlNuled.imageimageclasscouldn't MakeClass H*N m$,m2N6>gB$0L`NuNq4H?6*H&o`,m$r2- /HL$I k?@J/H(/IPJ@gp(3@3@~|z5|`|z/ / / aO ./o(X&N`(-"oP gSgSgSgrggSgSg6SgFSgX`5D~|`K0*HЀ"M D,k*N~|``Jg`T`LJg`~`6Jg`&`$`%D~`%D~`3D`3D~zAX,k.N*@Jfpf R"hr2)%Af R"hp0)%@Jg0*"SA$BA"A@AB?AV*gZoV oP0(H 5@2(HV5A4(M*H<H*@(/I*-g^-g"J -`r "J,k6NA0HЇ2H҆4H&ւ4-H/C6&ւ"J$/6N0-H"Ҁށz0-@(?@.`nxH 瀐J5@"g "J o* (`p/("J,k6NH  o*"20H҇$40(HԆ&608H/B8$ԃ&608H Ѓ/@0 "J"/8&/0NRDp@mp*o*0-HЀ2-H$ԁԀ.8/.g0HS2Hl-g"J -`p/("J,k6NA0HЇ2H҆4H&ւ4-H/C8&ւ"J$/8NA0HЇ2H҆4H&ւ4-H/C8&ւ"J$/8NM0H2H4HނށހREDmpLlNuYOH4&o*H/ / / /IarO $@ g/ M"JpatXO L,XONu gUg[gg`$/ "JaXONu/ "Jpa8XONu/ "Ja\XONu/ / /aO NuNq //,yN,_Nu oga`NuaJkNu/,yN,_Nu o"o` oCH EaLNu/,yN,_NuH0L aL Nu/ $o gXC j`D/ L gB g>C h`*/ L g( g$C`/ L g g"oHz /(Nup$_Nu/ $o g"o j`/ L g g"o h`/ L g g h/<Ho/<CHz/(NuO $_Nu @HX<-lh0-EE!&Src\Tools\EasyGUI\Docs\animcontrol.doczAnimControl PLUGIN ------------------ Consists of play, rewind, fast forward, stop and frame number gadgets. Uses the 'tapedeck.gadget' which needs to be in the normal place of libs:gadgets/ (usually libs: is also assigned to sys:classes/, and .gadget files should be stored in the sys:classes/gadgets/ directory). Constructors: animcontrol(frame=0,frames=8,play=FALSE,disabled=FALSE) frame -> The first frame (=position of slider) frames -> The number of frames (=extent of slider) play -> Whether the play button is pressed initially disabled -> Whether this gadget is disabled Destructor: END *must* be called for each NEWed object. Data (should be considered read-only): OBJECT animcontrol OF plugin frame -> Current frame number mode -> Current mode disabled -> Disabled or enabled PRIVATE ... ENDOBJECT The mode is taken from 'gadgets/tapedeck'. It will be: o BUT_PLAY if playing o BUT_STOP if stopped o BUT_FORWARD if fast forward is being held o BUT_REWIND if rewind is being held New methods: setframe(n) -> Set the current frame number setplay(play=TRUE) -> Set play/stop mode setdisabled(disabled=TRUE) -> Disable/enable the gadget Action functions: Your action function will be called (or your action value returned by easygui()) in the following circumstances: o The rewind or fast forward button has been pressed (mode will be BUT_FORWARD or BUT_REWIND) o The rewind or fast forward button has been released (mode will be BUT_STOP) o The play button has been pressed (and released) (mode will be BUT_PLAY) o The stop button has been pressed (and released) (mode will be BUT_STOP) o The frame slider has been moved (mode will be BUT_STOP, frame may have changed) Exceptions: "anim" will be raised by the constructor if the .gadget file can't be opened. "anim" will be raised by the render() method if the gadget can't be created. 7-lh0-  !!Src\Tools\EasyGUI\Docs\button.doc?Button PLUGIN ------------- A flexible button gadget in three flavours: normal (momentary), toggle and push (sticky). Uses the 'button.gadget' which needs to be in the normal place of libs:gadgets/ (usually libs: is also assigned to sys:classes/, and .gadget files should be stored in the sys:classes/gadgets/ directory). Constructors: button(text,resizex=FALSE,resizey=FALSE,disabled=FALSE) text -> The button's label resizex -> Whether this button can resize in width resizey -> Whether this button can resize in height disabled -> Whether this gadget is disabled togglebutton(text,selected=FALSE,resizex=FALSE,resizey=FALSE, disabled=FALSE) text -> The button's label selected -> Whether this button is selected (on) initially resizex -> Whether this button can resize in width resizey -> Whether this button can resize in height disabled -> Whether this gadget is disabled pushbutton(text,selected=FALSE,resizex=FALSE,resizey=FALSE, disabled=FALSE) text -> The button's label selected -> Whether this button is selected (on) initially resizex -> Whether this button can resize in width resizey -> Whether this button can resize in height disabled -> Whether this gadget is disabled Destructor: END *must* be called for each NEWed object. Data (should be considered read-only): OBJECT button OF plugin selected -> Current state of the button (=0 is off, <>0 is on) disabled -> Disabled or enabled PRIVATE ... ENDOBJECT The selected element is useful only for toggle and push buttons. New methods: setselected(selected=TRUE) -> Set the button on or off settext(text) -> Change the button label setdisabled(disabled=TRUE) -> Disable/enable the gadget Note: setselected() is ignored for normal buttons. Note: push buttons cannot be deselected by the user (they're sticky), so use setselected() to deselect them when necessary. Note: settext() does not check that the new label is not too wide... Action functions: Your action function will be called (or your action value returned by easygui()) in the following circumstances: o When the button is pressed to select or deselect it. Exceptions: "butt" will be raised by the constructor if the .gadget file can't be opened. "butt" will be raised by the render() method if the gadget can't be created. 9-lh0-!#Src\Tools\EasyGUI\Docs\calendar.doc[Calendar PLUGIN --------------- Draws a calendar of a month and allows a day to be selected. Uses the 'calendar.gadget' which needs to be in the normal place of libs:gadgets/ (usually libs: is also assigned to sys:classes/, and .gadget files should be stored in the sys:classes/gadgets/ directory). Constructors: calendar(date:PTR TO clockdata,resizex=FALSE,resizey=FALSE, disabled=FALSE) date -> The initial date selected resizex -> Whether this gadget can resize in width resizey -> Whether this gadget can resize in height disabled -> Whether this gadget is disabled Destructor: END *must* be called for each NEWed object. Data (should be considered read-only, except as mentioned below): OBJECT calendar OF plugin date:PTR TO clockdata -> Current date disabled -> Disabled or enabled PRIVATE ... ENDOBJECT New methods: setdate(date=NIL:PTR TO clockdata) -> Set the current date setdisabled(disabled=TRUE) -> Disable/enable the gadget Note: if NIL if specified for setdate() then the current date will be used (in which case it's OK to edit the data in self.date just before calling setdate()). Note: it's up to you to make sure the dates you supply are sensible. Action functions: Your action function will be called (or your action value returned by easygui()) in the following circumstances: o When one of the day buttons is pressed (the date will reflect the current state) Exceptions: "cal" will be raised by the constructor if the .gadget file can't be opened. "cal" will be raised by the render() method if the gadget can't be created. ;-lh0-O O !%Src\Tools\EasyGUI\Docs\colorwheel.docxColorWheel PLUGIN ----------------- The famous colorwheel from the Palette prefs program. Uses the 'colorwheel.gadget' which needs to be in the normal place of libs:gadgets/ (usually libs: is also assigned to sys:classes/, and .gadget files should be stored in the sys:classes/gadgets/ directory). Constructors: colorwheel(rgb:PTR TO colorwheelrgb,hsb=NIL:PTR TO colorwheelhsb, box=FALSE,disabled=FALSE) rgb -> The initial value as RGB hsb -> The initial value as HSB box -> Whether to put a bevel box around the wheel disabled -> Whether this gadget is disabled Destructor: END *must* be called for each NEWed object. Data (should be considered read-only, except as mentioned below): OBJECT colorwheel OF plugin rgb:PTR TO colorwheelrgb -> Current RGB value hsb:PTR TO colorwheelhsb -> Current HSB value disabled -> Disabled or enabled PRIVATE ... ENDOBJECT Only one of rgb and hsb will be valid at any time (the invalid one will be NIL), depending on which system you used when you last set the current value. New methods: setrgb(rgb=NIL) -> Set the current value using RGB sethsb(hsb=NIL) -> Set the current value using HSB getrgb(rgb) -> Get the current RGB value gethsb(hsb) -> Get the current HSB value setdisabled(disabled=TRUE) -> Disable/enable the gadget Note: using setrgb()/sethsb() changes the system that the colorwheel uses, so after a setrgb() the hsb element will be invalid (NIL). Note: if NIL is specified for setrgb() or sethsb() then the current one will be used (in which case it's OK to edit the data in self.rgb or self.hsb just before calling setXXX()). Note: getrgb()/gethsb() fill in the colorwheelrgb/hsb that you supply with the current colorwheel value, but do not change the system that's being used. Action functions: Your action function will be called (or your action value returned by easygui()) in the following circumstances: o When the pointer is moved. Exceptions: "colw" will be raised by the constructor if the .gadget file can't be opened. "colw" will be raised by the render() method if the gadget can't be created. 8b-lh0-Z#"Src\Tools\EasyGUI\Docs\EasyGUI.doc& Introducing: E A S Y G U I v3.3b4 An interface builder for E, with the following highlights: - It's totally Font-Sensitive - It's Resizable - It's Self-Organising, i.e. it arranges gadgets - It's more StyleGuide compliant than your granny - It's Fast and Flexible - It's relatively small, needs no extra external libraries - The layout-engine is user-extendable with PLUGINs - And above all: It's extremely easy to use!!! +---------------------------------------------------------------+ | 0. History | +---------------------------------------------------------------+ As of v3.3a, maintained by Jason R. Hulance, who you can contact at the addresses given in the Beginner's Guide to Amiga E. (Email: jason@fsel.com) [v3.3b4:] - Fixed changegui() window resizing to move window as well, if necessary. [v3.3b3 is a minor update that fixes a bug with AppWindow messages that crept in under the guise of a safety feature in v3.3b...] Changes from the v3.3b version: - Fixed bug: STR, INTEGER and CHECK gadgets' action functions were not getting passed the correct new value parameter. - Fixed bug: LISTV wasn't always wide enough for label. - Added EG_HIDE tag to enable the GUI to be created with a hidden (closed) window. - Changed blockwin()/unblockwin() so they now nest properly. Changes from the v3.3a version: - MAJOR CHANGE: made the main functions use a taglist for their optional arguments (it was getting a bit ridiculous...). This gives a bit more flexibility for the programmer and makes for much more readable code, so I'm afraid it was inevitable. To ease the change-over a bit there is an example module which gives the old style versions of the functions (just for EasyGUI.m; you can do your own for EasyGUI_lite.m). - MAJOR ADDITION: support for multi-window GUIs. This is via the multiinit(), addmultiA(), multimessage(), cleanmulti() and checkmulti() functions. The new scheme shares message ports, and efficiently dispatches on the message data. This is *massively* more efficient than using the old scheme (OR-ing the signal masks of each window), and effectively removes the limit of windows that a GUI can use. - Changed 'info' default to -1, which now gets translated to the guihandle. This helps a lot with multi-window GUIs. - Changed 'data' default to -1, which now gets translated to the gadget (not the *real* gadget, but the one that can be used with the setXXX() functions). - Changed the default screen to be the *default* public screen (rather than specifically Workbench). - Changed AppWindow gadget location code to make it more robust, and now includes the gadget label as "hittable". - Added a short description of the examples to this doc. - Added a reference to the guihandle to each PLUGIN so they can more easily access the GUI window and use the GUI manipulation functions. - Added closewin()/openwin() to enable the window to be temporarily closed and opened. These are most useful for iconification (see the iconify and toolify PLUGINs). Note that this new feature may break old PLUGINs that assume the GUI window will never change. - Added extra 'maxw' and 'maxh' parameters to make window open with maximum width/height (taking into account position, too). - Added extra 'wintype' parameter to give control over window borders. - Added some more changeXXX() functions, and changed (sorry!) the other changeXXX() functions to make them more uniform. - Added extra checking in message loop to ignore stray IDCMP_MOUSEMOVE messages. This is needed because GadTools doesn't identify the gadget if you use GACT_FOLLOWMOUSE, so your PLUGIN finds it hard to trap this message properly. [Problem reported by Ralph Wermke ] - Fixed bug in key handling code for the SLIDER gadget. [Bug reported first by Fred van der Zee ] - Fixed an old bug: guihandles weren't deallocated by cleangui(). - Fixed an old bug: some messages weren't getting replied. - Fixed an old bug: window wasn't being centred on screen if smaller than display (and may not have been openable). - Minor changes to the layout of a couple of gadgets. - Made gadtoolsbase and workbenchbase public, mainly so that PLUGINs can use them (if you have a GUI open then they must be valid). - Made things more friendly for multi-tasking: gh.wnd is NIL when the GUI is in an unmodifiable state. - Made awprocs use a copy of the appmessage, mainly so that they can do things like manipulate the GUI without problems. - Made a third version of EasyGUI. This is EasyGUI_debug.m, which is the same as EasyGUI.m except that it will print a short diagnostic message before raising an exception. This should be used when developing your program to help track down the actual reason for a fault. Changes from the v3.2e version: - Lots of minor fixes to most gadgets. - Added conditional resizing. - Added (optional) data field for all gadgets. - Added Style Guide compliant keyboard shortcuts. - Added extra arguments to some PLUGIN methods. - Added simple mechanism for PLUGINs to use GadTools gadgets (gtrender()). - Added AppWindow support for main window, *BUTTON, LISTV, STR and PLUGINs. - Added a lot of GUI manipulation functions. - Made an EasyGUI_lite version without a lot of features. changes from the v3.2a version: - now supports PLUGINs for unlimited complex gui's!!! (check section 5) - added settext() and setnum() - fixed NUM gadget - added topaz-fallback version - bug: rendered into the border when used with sysihack - bug: could cause enforcer hits when some strings were NIL - bug: dealocation of resources in wrong order caused problems changes from the v3.1a version: - new functions to access/modify gadgets while GUI is active - easily add gadtools menus - more complete docs - works better with multiple simultanuous EasyGUIs - LISTV, MX and CYCLE have an extra "current" parameter now - STR now takes an _estring_ as value (change this in old sources!) - bug: current gadget values would reset upon resize - bug: would open in middle of screen instead of visible part - many tiny bugs removed +---------------------------------------------------------------+ | 1. EasyGUI Intro | +---------------------------------------------------------------+ EasyGUI takes the form a module file that needs to be included into your E source (needless to say, it needs v2.04/v37 of the OS). The most simple form of constructing a GUI consist of calling the function easyguiA() with a (possibly nested) E list which describes your GUI. just to show how Easy, try this source: MODULE 'tools/EasyGUI' PROC main() IS easyguiA('um,...',[BUTTON,0,'Ok!']) This'll open a window with just one gadget in it, and wait for the user to push it. If easyguiA() can't get what it wants, it'll start throwing around exceptions, so we'll probably need an exception handler to be able to inform the user properly (see below). The first arg of easyguiA() is the window title, the second one is the GUI description. The form of these desciptions is quite simple: It's a list with as first element the type of gadget, the second is called an action value (more later), and the rest is gadget-specific. To be able to build GUI's outof more components than just one gadget, one can group gadgets with a ROW and a COL list: [COLS, [BUTTON,1,'Ok'], [BUTTON,0,'Cancel'] ] This'll create a new group, consisting of two gadgets next to each other. COLS and ROWS groups are like a single gadget, i.e. you can easily put them into other groups, to create GUI's of infinite complexity. Other Grouping functions are EQCOLS and EQCOLS, which try to align gadgets in a group. IF you get strange layouts using these, you should try grouping subgroups before putting them in a larger group. [BEVEL,a] will put a bevel box around a, whatever it is (a gadget, a group...), and BEVELR is the recessed version. Other elements of groups are mostly gadgets, which have a specific #of arguments. [If the number of arguments is incorrect, EasyGUI will raise the "Egui" exception.] The first element is always the type of gadget to create (see below). The second element is always something called an "actionvalue", which tells EasyGUI what needs to be done when the user interacts with the gadget. All elements after that are gadget specific. An action value may be: - a small positive integer (0-1000). If the user selects this gadget, EasyGUI will close the window, and return that value as returnvalue from the easyguiA() call. This is meant for "Ok" / "Cancel" type buttons. - a pointer to an "action function". If the user selects this gadget, EasyGUI will call the function with as arguments depending on the type of gadget (for example a slider will get it's current value). After the actionfunction returns, EasyGUI continues processing messages from the GUI. example: ...[BUTTON,{load},'Load'],... PROC load(info) IS WriteF('You pushed the "Load" button!\n') the value of `info' is explained below. Or: DEF s[100]:STRING ...[STR,{str},'input:',s,50,4], [CYCLE,{cycle},'choose:',['Yep','Nope',NIL],1],... PROC str(info,news) IS WriteF('the new string is: \s\n',news) PROC cycle(info,newc) IS WriteF('the new choice is: \d\n',newc) In the action function, you can store the new value, however EasyGUI keeps track of it itself too: In the case of the STR above it will StrCopy() new values into your estring, so it automatically has the correct value after closing. In the case of all other gadgets it stores the new (integer) value in the list (so that `1' in `CYCLE' may become `0'). This has the added benefit that windows that are opened and then closed again will automatically start with the current values. If you want to close the GUI from an action function then you can call the quitgui() function, which raises a "QUIT" exception (be careful to not handle this exception in your code -- just ReThrow() it if your action function has an exception handler). The single argument to quitgui() (which defaults to 0) will be returned from the easyguiA() call, in the same way that action values are. The definition of quitgui() is: PROC quitgui(ret=0) IS Throw("QUIT",ret) There are two new, optional arguments to action functions: `qual' and `data'. If you wish to use these arguments your action function must include them at the beginning (and you must have a `data' argument if you want to use the `qual' argument). For instance, a button action function can be defined in any of these three ways: PROC action(info) IS WriteF('info=$\h\n', info) PROC action(data,info) IS WriteF('info=$\h,data=$\h\n', info,data) PROC action(qual,data,info) IS WriteF('info=$\h,data=$\h,qual=$\h\n', info,data,qual) (This scheme gives *full* compatibility with the old EasyGUI action functions, whilst still allowing the new features to be used.) The `data' argument is the optional data field specified in the gadget. If it is not specified or it's -1 then the actual data value that is used is the gadget list pointer (for use with the setXXX() functions). You could use it, instead, to pass a pointer to an object specific to the gadget. The action function can then just call a method of that object. This allows the same action function to be used by a number of different gadgets, with the specific action being carried out via the data element (since the data can be different for each gadget). The `qual' is basically the qualifier part of the intuimessage used to indicate gadget clicks. Use the IEQUALIFIER_XXX constants from the module 'devices/inputevent' to see which qualifiers were pressed when the gadget was clicked. For example: PROC buttonaction(qual,data,info) IF qual AND (IEQUALIFIER_LSHIFT OR IEQUALIFIER_RSHIFT) PrintF('You were pressing a shift key when you clicked on me!\n') ENDIF ENDPROC The easyguiA() function: easyguiA(windowtitle,gui,tags=NIL) `tags' is a taglist which can use the following tags: EG_INFO the data may be ANY value, and is passed as an arg to the action functions. For example if you write a prefsrequester, this may be the the prefs OBJECT. Your actionfunctions then have a simple task changing the value of the element in question. (If this is -1 or not present, then it the info used will be the 'guihandle' value for this GUI. See Chapter 4.) EG_SCRN the data is an optional screen ptr to open on. if NIL or not present EasyGUI opens on the default public screen (usually Workbench). EG_FONT the data is a fontdescription (i.e., a `textattr'). If NIL or not present, EasyGUI will use the same font as the screen (for Workbench this is the font the user selected as "screenfont" in fontprefs). EG_MENU the data is a newmenus structure (as in gadtools.library). EasyGUI will then automatically attach it to the window and arrange any messages. You can give the same actionvalues as gadgets in the newmenu.userdata, and the actionfunction can be the same as for a `BUTTON', i.e.: [...,NM_ITEM,0,'Load','l',0,0,{load},...]:newmenu can use the same load() as in the example further above (the optional `qual' and `data' arguments [see below] will always be NIL). [The constants NM_ITEM, etc., are from the module 'libraries/gadtools'.] EG_GHVAR the data is the address of a LONG variable which gets a copy of the guihandle (see Multiple Windows, below). You just specify something like {gh} instead of having to use guiinitA(), etc. Note that you can also get the guihandle by using the new default for the `info' of a GUI (as described above). EG_AWPROC the data is a function to be called when the user drops icons on the window (and no gadget handles the drop). By default, this is NIL and this means that the window will not to be made into an AppWindow. If it's *not* NIL then the window *will* be an AppWindow, and the *BUTTON, LISTV and STR gadgets will get their awprocs called if icons are dropped directly on them (PLUGIN gadgets can also react to AppWindow messages). If the drop does not land on a gadget with an awproc then this awproc (for the whole window) will be called. (See the examples.) awprocs are like action functions and can be defined in one of two ways: PROC awproc(info,awmsg:PTR TO appmessage) PROC awproc(data,info,awmsg:PTR TO appmessage) `info' is the GUI info, `awmsg' is a *copy* of the appmessage and `data' is the optional data field for the gadget (or the `plugin_object' for PLUGINs, and NIL for the window one). EG_TOP, EG_LEFT the data define the top-left coordinate of the window. If either of them is -1 (the default), then the window will be centred on that axis (in the visible part of the screen). EG_MAXW, EG_MAXH the (boolean) data specify whether to try make the window size maximal in width or height (based on screen size), rather than the default of minimal (based on the GUI). If you specify a position then the maximal size of that axis will be the remaining part of the screen. So, on a screen of width 640, if you specify EG_LEFT of 100 then the maximum width the window can be is 540. EG_WTYPE the data is a constant to dictate the window decoration (i.e., what happens with the borders). The choices are: WTYPE_SIZE the default, which gives you all the standard gadgets and a size gadget at the bottom. WTYPE_NOSIZE omits the size gadget. WTYPE_BASIC just has a simple border around the window. WTYPE_NOBORDER has (suprisingly) no border. Be careful with these last two options as there is no close gadget for the user to click -- you must provide them with your own method of closing the GUI (a menu item?). (Note: the window title is ignored with the last two types, since there's no title bar.) EG_CLOSE the data is an action value/function used when the user clicks the close gadget on the GUI window. This is most useful for multi-window GUIs (see Multiple Windows), but it can be useful to prompt the user to confirm before quitting the GUI. The action value will be returned from easyguiA()/guimessage()/multiloop()/multimessage(), as usual. The action function can be defined in one of two ways: PROC closeproc(info) PROC closeproc(mh:PTR TO multihandle,info) `info' is the GUI's info parameter (see above), and `mh' is the multi-window handle (see Multiple Windows) or NIL if it's a single window GUI. EG_CLEAN the data is a function to be called when the GUI is destroyed (e.g., by calling cleangui()). This is most useful for multi-window GUIs (see Multiple Windows), but it can generally be useful for cleaning up the GUI's PLUGINs (see Chapter 5). The function will be called *after* the window and the GUI has been closed and deallocated, so, for example, the PLUGINs will no longer be on screen. It should be defined like this: PROC cleanproc(info) `info' is the GUI's info parameter (see above). Note: if guiinitA() or addmultiA() cause an exception then this function will *not* be called. This makes it easier to setup a GUI (see the examples). EG_HIDE the (boolean) data specifies whether the GUI window is initially hidden (closed). The default is FALSE; if you specify TRUE then you can use openwin() to show the window when you want it to be seen. Note: this tag is a bit useless for a normal call to easyguiA() as there's little chance of it receiving any GUI messages if the window is closed (so the Wait() will never return). +---------------------------------------------------------------+ | 2. Gadgets | +---------------------------------------------------------------+ general format: [NAME,action,text,...] in {}: which direction it may resize. + = a value that can be affected lateron with the set#? functions * = optional value (can be omitted) Each gadget shows the gadget template, explanation, the form of the actionfunction, and a typical example. The optional arguments to action functions (qual and data) are described in the above chapter. [BUTTON,action,intext,data*,key*,awproc*,disabled+*] data = user data value passed to action function key = keyboard shortcut (presses button) awproc(data*,info,awmsg) = AppWindow proc (see above) disabled = whether this gadget is disabled or not buttonaction(qual*,data*,info) example: [BUTTON,0,'Cancel'] [CHECK,action,righttext,checkedbool+,lefttextbool,data*,key*,disabled+*] checkedbool = whether gadget should initially be check-marked key = keyboard shortcut (toggles check) disabled = whether this gadget is disabled or not checkaction(qual*,data*,info,checkedbool) example: [CHECK,{case},'Ignore case',TRUE,FALSE] [INTEGER,action,lefttext,num+,relsize,data*,key*,disabled+*] num = initial value key = keyboard shortcut (activates gadget) disabled = whether this gadget is disabled or not integeraction(qual*,data*,info,newnum) {x} example: [INTEGER,{v},'int:',5,3] (Note: see discussion of getinteger() in chapter 4 below.) [LISTV,action,textabove,relx,rely,execlist+,readbool,selected,current+, data*,key*,awproc*,disabled+*] execlist = ptr to an execlist. (see tools/constructors.m) readbool = whether listview is read-only (action is ignored if it is!) selected = 0=none, 1=highlight/show selected key = keyboard shortcut (unshifted->select next, shifted->prev) awproc(data*,info,awmsg) = AppWindow proc (see above) disabled = whether this gadget is disabled or not listviewaction(qual*,data*,info,num_selected) {x,y} example: [LISTV,0,NIL,5,5,filenamelist,0,NIL,0] (Note: disabling doesn't work under V37.) [MX,action,righttext,nil_term_elist,lefttextbool,current, data*,key*,disabled+*] (Note: under v37 the righttext is spaced correctly but not rendered.) key = keyboard shortcut (unshifted->next choice, shifted->prev, wraps) disabled = whether this gadget is disabled or not mxaction(qual*,data*,info,num_selected) example: [MX,{v},NIL,['One','Two','Three',NIL],FALSE,1] (Note: disabling doesn't work under V37.) [CYCLE,action,lefttext,nil_term_elist,current,data*,key*,disabled+*] key = keyboard shortcut (unshifted->next choice, shifted->prev, wraps) disabled = whether this gadget is disabled or not cycleaction(qual*,data*,info,num_selected) example: [CYCLE,{v},'choose:',['Yep','Nope',NIL],1] [PALETTE,action,lefttext,depth,relx,rely,current+,data*,key*,disabled+*] (Note: the current field is new to v3.3a and is _not_ optional, so any existing v3.2e sources using a PALETTE gadget will need a small edit.) depth = 1..8, number of bitplanes this color is for key = keyboard shortcut (unshifted->next pen, shifted->prev, wraps) disabled = whether this gadget is disabled or not paletteaction(qual*,data*,info,colour) {x,y} example: [PALETTE,{v},'color:',3,5,2] [SCROLL,action,isvert,total+,top+,visible+,relsize,data*,key*,disabled+*] total = resolution of scroller top = current top represented visible = current key = keyboard shortcut (unshifted->increment, shifted->decrement) disabled = whether this gadget is disabled or not scolleraction(qual*,data*,info,curtop) {x|y} example: [SCROLL,{v},FALSE,10,0,2,2] [SLIDE,action,lefttext,isvert,min,max,cur+,relsize,levelformat, data*,key*,disabled+*] min,max = value range of slider cur = current value levelformat = string that shows levelformat, example '%2ld'. leave a large amount of spaces left in lefttext for this. key = keyboard shortcut (unshifted->increment, shifted->decrement) disabled = whether this gadget is disabled or not slideraction(qual*,data*,info,cur) {x|y} example: [SLIDE,0,'Colors:',FALSE,1,8,3,5,''] [STR,action,lefttext,initial+,maxchars,relsize, over*,data*,key*,awproc*,disabled+*] initial = initial string contents: NOTE: HAS TO BE AN ESTRING! maxchars = max #of chars for string over = overwrite mode boolean (default is FALSE, i.e., insert mode) key = keyboard shortcut (activates gadget) awproc(data*,info,awmsg) = AppWindow proc (see above) disabled = whether this gadget is disabled or not stringaction(qual*,data*,info,string) {x} (Note: action function is passed the E-string, not the gadget's buffer.) example: [STR,0,'Pattern',s,100,5] (DEF s[100]:STRING) (Note: see discussion of getstr() in chapter 4 below.) [TEXT,text,lefttext,borderbool,relsize] {x} borderbool = whether or not a recessed bevelbox is placed around 'text' example: [TEXT,'Selected Fonts',NIL,FALSE,3] [NUM,int,lefttext,borderbool,relsize] {x} borderbool: as TEXT example: [NUM,123,'num:',TRUE,5] [SBUTTON,action,intext,data*,key*,awproc*,disabled+*] {x} same as button, only now resizes horizontally. [PLUGIN,action,plugin_object,isgt*,awproc*] isgt = whether this PLUGIN is made from GadTools gadgets (see chapter 5) awproc(plugin_object*,info,awmsg) = AppWindow proc (see above) pluginaction(info,plugin_object) (see separate chapter 5 on using/implementing these). [BAR], [SPACE] {x,y}, [SPACEH] {x}, [SPACEV] {y} BAR places a nice divider-bar between gadgets/groups. Whether it's horizontal or vertical depends on which group it is in. SPACE/SPACEH/SPACEV do nothing, they only eat up space. This can be very handy in GUI design, they act like a spring between elements (do not use them on the borders of a GUI, only in the middle). #?text: (where #? is left/right etc.): a text to place next to the gadget. Often is allowed to be NIL. relsize,relx,rely: Generally gadgets will automatically get a size depending on a number of factors, but relsize allows the programmer to give a minimum size for certain gadgets, thereby sizing a whole group. If other gadgets already account for the minimum size, this one can safely be set to a low value such as 2. All these sizes are calculated in terms of the _height_ of the font. Always try out your GUI with different fonts. For example if you design a gui that only just fits horizontally with an 8 point font on 640x200, when run on with a 13 point font on 640x512, the gui will be quite a bit bigger horizontally, but the screen isn't, so it won't fit. (see also: the "bigg" exception below). nil_term_elist: a nil-terminated E list, such as ['One','Two','Three',NIL] isvert: TRUE if gadget needs to be vertical, horizontal by default. key: All keyboard shortcuts are optional (so marked with a * in the following descriptions). If specified then they must be lowercase letters ("a" to "z"). However, the shifted and unshifted keystrokes are *both* handled, in the way described by the Style Guide (and this is briefly outlined for each gadget). Also, if a key is specified then an "_" in the gadget label text indicates the character in the label which is to be underscored (and this ought to be the same letter as the key). If a key is not specified then any "_"s in the label are not special. (If an action function is invoked as a result of a key press then the `qual' will always be 0.) disabled: If this optional field is specified then the gadget can be disabled and enabled using the setdisabled() function (see below, chapter 4), and the current status of the gadget will be recorded in this field, too. The following constants/enumerations are defined in order to make referencing/creating the lists for each gadget a bit more readable. EXPORT ENUM BEV_GUI=1, BUT_ACT=1, BUT_TXT, BUT_DATA, BUT_KEY, BUT_APPW, BUT_DIS, CHK_ACT=1, CHK_TXT, CHK_VAL, CHK_LEFT, CHK_DATA, CHK_KEY, CHK_DIS, INT_ACT=1, INT_TXT, INT_VAL, INT_REL, INT_DATA, INT_KEY, INT_DIS, LST_ACT=1, LST_TXT, LST_RELX, LST_RELY, LST_LIST, LST_RO, LST_SHOW, LST_CURR, LST_DATA, LST_KEY, LST_APPW, LST_DIS, MX_ACT=1, MX_TXT, MX_LIST, MX_LEFT, MX_CURR, MX_DATA, MX_KEY, MX_DIS, CYC_ACT=1, CYC_TXT, CYC_LIST, CYC_CURR, CYC_DATA, CYC_KEY, CYC_DIS, PAL_ACT=1, PAL_TXT, PAL_DEP, PAL_RELX, PAL_RELY, PAL_CURR, PAL_DATA, PAL_KEY, PAL_DIS, SCR_ACT=1, SCR_VERT, SCR_TOTL, SCR_TOP, SCR_VIS, SCR_REL, SCR_DATA, SCR_KEY, SCR_DIS, SLI_ACT=1, SLI_TXT, SLI_VERT, SLI_MIN, SLI_MAX, SLI_CURR, SLI_REL, SLI_FMT, SLI_DATA, SLI_KEY, SLI_DIS, STR_ACT=1, STR_TXT, STR_STR, STR_MAX, STR_REL, STR_OVR, STR_DATA, STR_KEY, STR_APPW, STR_DIS, TXT_VAL=1, TXT_TXT, TXT_BORD, TXT_REL, NUM_VAL=1, NUM_TXT, NUM_BORD, NUM_REL, PLG_ACT=1, PLG_OBJ, PLG_GT, PLG_APPW +---------------------------------------------------------------+ | 3. How Layout Works | +---------------------------------------------------------------+ EasyGUI works by automatically layouting the gadgets on the screen. In a first pass, it will compute the minimum size for each element: for gadgets this involves the size of fonts and various other things. For a ROWS list, for example, it will take the width of the biggest gadget as its width, and computes its height by adding the heights of all other gadgets. For EQROWS this is slightly more complicated: EasyGUI also computes a "middle" for various gadgets, often between the text that denotes what a gadget is about and the gadget itself. It then tries to align all of these. for EQCOLS it simply tries to make all columns equal width. In a second pass, EasyGUI assigns the final coordinates to all gadgets. Important to notice is that in a GUI often there is more space available than is required for a gadget, for example the gadget above it in a ROWS environment is much wider. Also, the user may have resized the window. To do something useful with this space, EasyGUI looks at which gadgets can do something useful with extra space, such as LISTV, or STR, SCROLL etc. This process of granting extra space propagates through ROWS/COLS, which act as gadgets themselves. Gadgets like BUTTON don't benefit from more space, so they give that away to their neighbours. +---------------------------------------------------------------+ | 4. Advanced features | +---------------------------------------------------------------+ Different versions of EasyGUI ----------------------------- For those who care more about saving a few KB than the extra functionality, there are two different versions: 1) EasyGUI_lite.m This does not have multi-window support, keyboard support for gadgets, AppWindow support or GUI manipulation functions (i.e., dynamically changing a GUI, window blocking and gadget disabling). Current code size: 17324 bytes. 2) EasyGUI.m The full version, with nothing taken out. Current code size: 23968 bytes. There's also a third version of EasyGUI which is just a variant of EasyGUI.m: this is a debug version, EasyGUI_debug.m, which gives some more information about an error before raising an exception (so you shouldn't really distribute programs compiled with this module -- it's just for development purposes). Throwing exceptions from actionfunctions ---------------------------------------- is allowed: EasyGUI will catch it, close the window properly, and then ReThrow() if it wasn't a "QUIT" exception. If it was "QUIT" then the exceptioninfo value will be the return value of the easyguiA()/guimessage() or multiloop()/multimessage() functions, just like the way actionvalues work (except for the slight difference in a multi-window GUI, as noted below). Exceptions raised by EasyGUI itself: "MEM" -- no mem "GUI" -- for things like CreateGadgetA, OpenWindowTagList etc. "GT" -- couldn't open gadtools.library "bigg" -- for "BIG Gui": interface is calculated to be bigger than the screen. Generally you should keep gui's small, so that they still fit on 640x200 topaz screens. If the user runs Times/30 on a screen this size, he probably knows he has a problem. "Egui" -- a design error: most probably handed over a list to dogui() that was either to long or too short -- Raise()ed by own function Multiple Windows ---------------- There are two ways of handling multiple windows in EasyGUI. The first has really been superseded by the second, though. 1) The simplest use of EasyGUI is just by calling easyguiA(). You can however open any number of windows, and check messages for all of them. guiinitA(windowtitle,gui,tags=NIL) guimessage(guihandle) cleangui(guihandle) Call guiinitA() for each window (exactly the same arguments as easyguiA(). Then, keep calling guimessage() for each of them, when messages arive. you can close them again with cleangui(), for example when a gui returns a positive integer (the actioncode). Negative integers signal that it simply finished processing all messages, but no need to close the window yet. Note: it is *not* safe to call cleangui() from *any* action function (except as noted below, in the description of cleanmulti()). (If you want to close the GUI prematurely, you can use the closewin() function.) example of usage of these three function (= definition easyguiA()) EXPORT PROC easyguiA(windowtitle,gui,tags=NIL) HANDLE DEF gh=NIL:PTR TO guihandle,res=-1 gh:=guiinitA(windowtitle,gui,tags) WHILE res<0 Wait(gh.sig) res:=guimessage(gh) ENDWHILE EXCEPT DO cleangui(gh) ReThrow() ENDPROC res the object you get has some handy fields in there: the window in question `wnd' (or NIL if it's currently closed), the sigmask `sig' (i.e., _not_ the signal bits) if you want to do a proper Wait() (OR them), the GUI's info and the handle for the multi-window group `mh' (or NIL if this is a single GUI) [see below for more details on this]. OBJECT guihandle /* Public (read-only) parts: */ wnd:PTR TO window sig:LONG info mh:PTR TO multihandle -> See below... ENDOBJECT The GUI's info is provided to make retrieving the info from the guihandle easier (in an EG_CLEAN proc, for instance). If you want to draw into `wnd': stdrast is automatically set to the last EasyGUI opened. `wnd' can also be used a flag to indicate when it is safe to manipulate the GUI (to help with multi-tasking): when it's NIL it's not safe to modify the GUI directly, unless you've been passed the window pointer (e.g., render() and clear_render()). The setXXX() functions are always safe. Note: `wnd' can change due to closewin()/openwin() calls which mean that the GUI may be in different windows during its life. 2) But starting in v3.3b, there's a much more efficient (and simpler) way of handling multiple-window GUIs. This uses the functions multiinit(), addmultiA(), multiloop() (which uses multimessage()) and cleanmulti(), in roughly the same way as the single window versions. It's all based around a `multihandle': OBJECT multihandle /* Public (read-only) parts: */ sig:LONG opencount:LONG ENDOBJECT multiinit() addmultiA(multihandle,windowtitle,gui,tags=NIL) multiloop(multihandle) multimessage(multihandle) cleanmulti(multihandle) multiinit() is used to initialise a new group of GUIs and produce a new `multihandle'. It takes no arguments. You must call this function first and use the multihandle with the other functions to refer to your group of GUIs. You can still refer to each individual GUI using a guihandle (see below). A quick example to show how simple the new multi-window scheme is: PROC multiplewindows() HANDLE DEF mh=NIL, gh1:PTR TO guihandle, gh2:PTR TO guihandle,res mh:=multiinit() gh1:=addmultiA(mh,'GUI One',[BUTTON,{but1},'Press Me']) gh2:=addmultiA(mh,'GUI Two',[BUTTON,{but2},'Press Me']) -> Could add more GUIs... res:=multiloop(mh) EXCEPT DO cleanmulti(mh) ENDPROC addmultiA() is very much like guiinitA(). It creates a new window with your specified GUI and returns the guihandle. You can call this function even from action functions, when the GUI group is active. addmultiA(mh:PTR TO multihandle,windowtitle,gui,tags=NIL) The extra parameter is `mh' to indicate the group to which this window will be added. If the tag EG_CLOSE is not specified or the data is an action value (between 0 and 1000) then the GUI will be destroyed and removed from the group (the guihandle will now be invalid) and the action value will be returned (from multimessage()) -- just like a normal action value. If it is an action function then the window is *not* closed and the action function is called. As stated above, you define such an action function in one of two ways: PROC closeproc(info) PROC closeproc(mh:PTR TO multihandle,info) `info' is the GUI's info parameter and `mh' is the multihandle for this group. Use `mh' to find the `opencount' -- the number of GUIs with open windows. This count will include this GUI so if it's equal to one then you know this is the last open window in the group. Your action function may want to prompt the user and then close the window (using closewin()), destroy the GUI and remove it from the group (using cleangui()), or leave the window open. multiloop() is defined in terms of multimessage() and opencount, and is similar to the definition of easyguiA(). EXPORT PROC multiloop(mh:PTR TO multihandle) DEF res=-1 WHILE res<0 EXIT mh.opencount=0 Wait(mh.sig) res:=multimessage(mh) ENDWHILE ENDPROC res The signal mask for waiting for messages is `sig' in the multihandle. You can use this for more complex Wait()s, and then call multimessage() to handle any messages that may have arrived for any of the GUIs. Any action values generated by a GUI (or via quitgui()) are returned by multimessage() and hence terminate multiloop(). The above example calls multiloop() only once, so an action value will eventually destroy the whole group (by calling cleanmulti()). Note: a real action value will cause the GUI that produced it to be closed via cleangui(), but a value returned through use of quitgui() will not -- this is because if you've called quitgui() then you can just as easily write code to close the window (or whatever) in the same action function. By using the `opencount', the loop will be terminated when there are no more open GUI windows. Alternatively, if you are using your own Wait() you might want to check that there are no GUIs left (even ones with closed windows). To this end there's the function multiempty() which returns TRUE if and only if there are no GUIs in the group. (Note: if there are only GUIs left with no window then the simple Wait() will never return!) cleanmulti() destroys all GUIs in the group (whether they have an open or closed window) and deallocates the multihandle. It is *not* safe to use the multihandle or any of the guihandles after this. So, in particular, it is *not* safe to call cleanmulti() from *any* action function. It is, however, safe to call cleangui() on GUIs in the group, if you are using cleanmulti() to do the final cleanup (rather than calling cleangui() on remembered guihandles). To help with manipulating a group there are the multiexists() and multiforall() functions, which work in a very similar way to ForAll() and Exists(). multiforall(varaddr,mh:PTR TO multihandle,expr) multiexists(varaddr,mh:PTR TO multihandle,expr) `varaddr' is the address of a (global) guihandle variable, `mh' identifies the GUI group and `expr' is a quoted expression to be evaluated. multiforall() will evaluate the expression for every GUI in the group (whether its window is open or closed) and return TRUE if the expression is TRUE (non-zero) for all GUIs, else it will return FALSE. multiexists() will stop at the first GUI for which the expression is TRUE, and return the value of the expression. Unlike Exists(), you are guaranteed that the variable pointed to by `varaddr' will contain the guihandle of the corresponding GUI (or NIL if none were found). So, you can use multiexists() to find GUIs. Note: be careful what the expression does with the guihandle and the GUI group; it is quite safe to cleangui() on the supplied guihandle, but it is not safe to affect any other GUI in this way. Any GUIs added to the group by the expression will not be part of the forall or exists (for those who can't live without knowing: the list is explored from head to tail, and new GUIs are added to the head; so the last GUI considered will be the oldest GUI). For example, you can print the title of each GUI with an open window: multiforall({gh},mh,`IF gh.wnd THEN WriteF('\s\n',gh.wnd.title) ELSE 0) A final reminder: `varaddr' must be the *address* of a *global* variable (and so must all the variables used in the quoted expression). Useful note: as long as a guihandle is valid (i.e., as long as cleangui() has not been called on it), the normal GUI functions checkgui() and guimessage() will actually work on the whole group that a GUI is in. (Note: the proper, safe functions to use for multi-window GUIs are checkmulti() and multimessage(), respectively.) Multiple copies of a GUI ------------------------ If your app allows to have multiple copies of the _same_ gui open at the same time (for example if you open windows recursively, or you use the multiple window technique described above to open more instances of one GUI), you might need to dynamically allocate the GUI description, because of the way dynamically computed values are put into static E lists. A GUI desciption with [] lists is static, i.e. only allocated once. Adding NEW to all of them is hard to deallocate, and this is where disposegui() comes in. To safely use this feature, allocate ALL lists belonging to the GUI desciption dynamically with NEW [...] (this does not include lists such as the one used for the various labels in CYCLE-gadgets). easyguiA('Bla', gui:=NEW [ROWS, NEW [STR,{str},'input:',s,50,4], NEW [CYCLE,{cycle},'choose:',['Yep','Nope',NIL],1]]) disposegui(gui) Call disposegui() with the top-level list. On each gadget-list (i.e., NEW [CYCLE,...]) it will simply call FastDisposeList(), on COLS and ROWS etc. it will first deallocate each element recursively. Manipulating Gadgets -------------------- [This assumes you've got the guihandle by using the ghaddr argument of easyguiA(), the DIY version of EasyGUI (as described under 'Multiple Windows'), or you're using the new default for the 'info' of a GUI.] You might need to modify gadgets while a GUI is active, for example to set a slider when a corresponding integer gadget is modified by the user, or to change the contents of a listview. You can denote gadgets to change by simply storing their addresses, i.e.: [COLS, mygad:=[CHECK,....], ... ] Now you can use `mygad' with some of the functions below. Note that, of course `mygad' isn't a gadget, but it helps EasyGUI to find the real gadget. setcheck(gh,gad,bool) setinteger(gh,gad,new) setlistvlabels(gh,gad,labs) setlistvselected(gh,gad,active) setlistvvisible(gh,gad,vis) setmx(gh,gad,active) setcycle(gh,gad,active) setpalette(gh,gad,colour) setscrolltop(gh,gad,top) setscrolltotal(gh,gad,total) setscrollvisible(gh,gad,visible) setslide(gh,gad,new) setstr(gh,gad,new) settext(gh,gad,newtext) setnum(gh,gad,newnum) for all these: `gh' is the gui you're talking about (as returned from guiinitA()/addmultiA(), or via the `ghaddr' argument of easyguiA() or the new default for the 'info' of a GUI), `gad' is a value that denotes the gadget as described above. the third value is whatever you're changing about the gadget. Note that in doing so, you need to respect usual restrictions on gadtools gadgets, for example setlistvlabels() requires that you first set it to -1, then modify the list, and put it back. setlistvvisible() will try to make the indicated item in the LISTV visible. setlistvselected() will make a new selection and try to make it visible (and -1 turns off the selection). setdisabled(gh,gad,disabled=TRUE) This applies to all gadgets, but works only if you've actually specified a value (TRUE or FALSE) for the optional `disabled' field for the gadget. realgadget:=findgadget(gh,list) allows you to find the gadget address, for all those modifications that aren't possible with the above set#? functions. It returns an intuition gadget structure. Note that preferably you will want to use the set#? functions, as these cooperate with EasyGUI very well (in keeping track of the current value, for example: setstr() also copies the new value to the estring you attached to the gadget). While there is at least one GUI still allocated the `gadtoolsbase' and `workbenchbase' are valid, so you can quite easily manipulate gadgets in action functions using GadTools functions. (If you do open either of these libraries, be careful not to overwrite these variables with NIL! That is, use an automatic exception on OpenLibrary() or otherwise check the return value before assigning it.) getstr(gh,gad) getinteger(gh,gad) These return and store the current value of a STR or INTEGER gadget (where gh and gad are as described above for the setxxx() functions). They are useful because Intuition only sends a message (and so causes the current values to be stored) when the user hits the return or tab key in these gadgets. So, if you really want to know a STR or INTEGER gadget's current value use getstr() or getinteger(). Topaz Fallback -------------- the function `easygui_fallbackA()' is equivalent to `easyguiA()' apart from the fact that when EasyGUI fails with the "bigg" exception, it will try again with topaz-8. Note that you should never want to rely on topaz, this function was only added for emergency situations. If your GUI is too big on some systems, you should redesign your GUI to fit comfortably instead. (see other parts of this doc that talk about GUI-size and testing). GUI Manipulation ---------------- closewin(gh) Temporarily closes the GUI window. Use openwin() to reinstate the GUI. This function is useful for iconifying a GUI (see the iconify and toolify PLUGINs). You can test whether a GUI's window is closed (or otherwise unmodifiable) by checking if the `wnd' element of the guihandle is NIL. Note that if your GUI is on the default public screen then it will no longer be a visitor (i.e., you can then use changescreen() to move it to a new screen). (A blocked window is unblocked before it is closed.) openwin(gh) Reopens a closed GUI window: it will reopen in the same position and size as it was when it closed. Note that the window is not guaranteed to open correctly again (someone may have grabbed your memory, for example). The window will always open unblocked. Once open again, gh.wnd will be non-NIL (i.e., the address of the window). changegui(gh,gui) Changes the GUI in a window (fairly) seamlessly. The old GUI is removed and the new GUI tries to take its place, resizing if necessary (a NIL `gui' is just ignored). The window will be resized if the new GUI's minimum size is bigger than the current size, or if the new GUI does not allow resizing. A side-effect of this new, dynamic ability to change GUIs is that the default window type is to have a size gadget, even the GUI can't be resized. You can change this by specifying a different EG_WTYPE, or use changewindowtype(). changemenus(gh,newmenus=NIL) Changes the GUI's menus. If `newmenus' is NIL or not present then the current menus are removed and the window is left with no menus. changeinfo(gh,info=-1) Changes the GUI's info. If `info' is -1 or not present then the GUI's info is changed to be the guihandle for the window. (Remember: the info is passed to the GUI's action functions.) changetitle(gh,windowtitle=NIL) Changes the title of the GUI's window. (But remember that the title is ignored for window type WTYPE_BASIC and WTYPE_NOBORDER.) changescreen(gh,scr=NIL) If the GUI window is closed (gh.wnd=NIL) then this will alter the GUI's screen (if it's open then this function does nothing). If `scr' is NIL then the default public screen will be used. If the font was linked to the screen then it will be updated, too. changefont(gh,tattr=NIL) Again, this works only if the GUI window is closed. If `tattr' is NIL then the font of the screen is used. changewintype(gh,wintype=WTYPE_SIZE) Another one that works only if the GUI window is closed. This sets the window border type. You can use one of WTYPE_NOBORDER, WTYPE_BASIC, WTYPE_NOSIZE and WTYPE_SIZE, as described above. movewin(gh,x=-1,y=-1) Moves the window of the GUI referenced by gh to the new (top-left) coordinate. If x or y is -1 (the default) then that coordinate is not changed. (Note: the change is delayed until the next INTUITICK.) sizewin(gh,xs=-1,ys=-1) Attempts to resize the window of the GUI referenced by gh. If xs or ys is -1 (the default) then that dimension is not changed. The resizing is not guaranteed to be carried out since the size may be smaller than the GUI's minimum or the GUI may not be sizable. (Note: the change is delayed until the next INTUITICK.) Simple window blocking to prevent the user using a GUI: blockwin(gh) This puts up an invisible requester over the window of the GUI referenced by gh, and disables window sizing. If you're running v39+ then the busy pointer will be set on this window. You would use this to block a GUI before you put up another one. Note: the window can still be moved and depth arranged. (This works only if the GUI's window is open.) unblockwin(gh) Reinstates the GUI, allowing the user to interact with it again. The blockwin() and unblockwin() calls nest, so you need an equal number of unblockwin() calls to blockwin() calls before the window is actually unblocked. Note: a GUI window is implicitly unblocked (forcefully!) when it is closed. In general: try to design your GUIs such that the user can use them all simultaneously, this is much friendlier (i.e., make use of the multi-window support given by addmultiA()...). checkgui(gh) Checks for any GUI messages and processes them, invoking actionfunctions if necessary. If this causes the GUI to want to be closed (e.g., the user has pressed the close gadget), then a "QUIT" exception is thrown and the exceptioninfo is the value that would have been returned by the easyguiA() call (so, as with quitgui(), your exception handlers might like to make "QUIT" a special case and just ReThrow() it). This function is useful, for example, when you're in an action function that's performing a long calculation. By polling the GUI at convenient points using this function you will make the GUI more responsive. However, you are responsible for coping with the possibility that the user may cause, for instance, the same action function to be called again. A simple solution is use some kind of semaphore (a global boolean variable, for example) to mark whether you are currently in an action function and busy. See the led_test.e examples and the old CU Amiga tutorials on Amiga E. checkmulti(mh) This is checkgui() for multi-window GUIs. As mentioned above (in 'Multiple Windows') you can use checkgui() to check and act on messages for *all* the GUIs in the same group as the one identified by the guihandle, but the guihandle must be valid. This function uses the multihandle so is always safe as long as the group exists. +---------------------------------------------------------------+ | 5. PLUGINs | +---------------------------------------------------------------+ PLUGINs allow the programmer to extend EasyGUI with new functionality, i.e., to add any kind of rendering/gadgets to the GUI, while cooperating automatically with EasyGUI's layout/resizing. You can use plugins to add rendering areas in the midst of EasyGUI gadgetry (e.g., for graphics programs), add BOOPSI gadgets to a GUIs etc. You can supply ready-made plugins for other programmers to use. OBJECT plugin /* Public (read-only) parts: */ -> Position and size. x:INT,y:INT,xs:INT,ys:INT -> guihandle for the GUI the PLUGIN is on. gh:PTR TO guihandle ENDOBJECT Any PLUGIN is an object inherited from the 'plugin' object found in easygui.m. To implement a new plugin all that needs to be done is redefine a few methods. Then, this PLUGIN can be plugged in to any EasyGUI with for example: [PLUGIN,{plugaction},NEW mp.myplugin()] in your GUI-spec. Whether the action-value is used depends on the PLUGIN, as we'll see below. If it is called it will be passed the PLUGIN object as well as the GUI info: PROC pluginaction(info,plugin_object:PTR TO plugin) Have a quick look at the plugin example sources, or keep them handy while reading the bit below. Creating the object ------------------- create your new object as a 'plugin'-subtype. You may add constructors/ destructors if you wish. following methods implement the plugins behaviour, and may be redefined: will_resize() is called once just before the window is opened. You should return a flag-set telling in which ways your object can resize, making use of the constants RESIZEX and RESIZEY, 0 of course meaning your object is fixed in size (default method returns RESIZEX OR RESIZEY, i.e., resize in both directions). New to v3.3a is COND_RESIZEX and COND_RESIZEY, which allow your PLUGIN to resize in the corresponding direction only if something else in its gadget group is unconditionally resizable. (For example, a BAR is conditionally resizable, so that it does not force a group of BUTTONs to be resizable.) min_size(ta:PTR TO textattr,fontheight) is called once just before the window is opened. ta is the font used in the GUI. you should return the _minimum_ x and y sizes of your PLUGIN as _two_ returnvalues, making use of `fontheight' if you wish. Note that EasyGUI may actually grant you a lot more space than just the minimum space you ask for, depending on the other gadgets and user-resizing. If your object can have al sorts of sizes, pick a relatively small one as minimum. The default method just returns (fontheight,fontheight) render(ta:PTR TO textattr,x,y,xs,ys,win:PTR TO window) Here you should render your object to the window. In the case of a gadget this means creating the gadget and attaching it to the window (AddGList(), RefreshGList(), make sure you render only your own gadget(s)). ta is the font used in the GUI. (xs,ys) is always at least the minimum size you asked for. (x,y,xs,ys) is also copied to your object before this method is called, for use in other methods). The default method paints a nice black box :-) You shouldn't take too long in this method as it will make window redraw look slow. (It is safe to use existing v3.2e PLUGIN modules, but to recompile under v3.3a you will need to add the `ta' argument to your PLUGIN render() method.) gtrender(gl,vis,ta:PTR TO textattr,x,y,xs,ys,win:PTR TO window) New to v3.3a: a replacement for render() which enables simple addition of GadTools gadgets to the standard EasyGUI gadgets. If you want to use this method instead of the normal render() then: 1) the PLUGIN must support it, and 2) you must specify TRUE for the `isgt' field of the PLUGIN gadget. gtrender() should simply create its gadgets by linking into the current list (given by `gl') and using the visual info `vis'. It should then return the new gadget list (i.e., the last GadTools gadget linked in). And then that's it: your GadTools gadgets will be freed automatically, so if your PLUGIN is just GadTools gadgets you don't need to override the normal (empty) definition clear_render(). If you use gtrender() then you need not override render(): this will help indicate a problem if users forget to specify `isgt' with your PLUGIN. See the password PLUGIN example. clear_render(win:PTR TO window) mainly useful for gadgets to remove the gadget from the window and free it (RemoveGList(), remove only your own gadget(s)!). Normally render() is called when the window opens, and clear_render() when the window closes, when the user resizes, however, clear_render() and render() are called one after another, in that order, to account for the changed window layout. The default method does nothing. message_test(imsg:PTR TO intuimessage,win:PTR TO window) is phase-1 of the message handling, splitted in two to not block intuition too much. In message_test() the only thing you should do is return TRUE _if_ and _only_if_ the intuimessage is meant for your object, otherwise FALSE. (The only exceptions to this are IDCMP_MOUSEMOVE messages from a GACT_FOLLOWMOUSE or WFLG_REPORTMOUSE, which can be ignored safely [i.e., you may return FALSE] as they cannot easily be attributed to an originating gadget). For a mouse-click, test if it was in your area (the current dimensions of your object in the GUI are present in the `plugin' object), for gadgets, make sure it is really your gadget causing the message (check .iaddress). If you reply TRUE to messages that are potentially meant for other objects, you might choke them. Do not engage in other actions in this method, such as rendering; do these things in the message_action() method. The default method returns FALSE. The GUI window uses the following IDCMP flags: IDCMP_ACTIVEWINDOW IDCMP_INACTIVEWINDOW IDCMP_GADGETDOWN IDCMP_GADGETUP IDCMP_INTUITICKS IDCMP_MOUSEBUTTONS IDCMP_MOUSEMOVE IDCMP_NEWSIZE IDCMP_RAWKEY IDCMP_VANILLAKEY You may get your PLUGIN objects to generate these messages (via gadgets) and then trap them (via message_test()), or you can just snoop on them in message_test(). message_action(class,qual,code,win:PTR TO window) is the second part, and will only be called if you returned TRUE in the previous method. here you may do any action needed (additional rendering based on the user action). class, qual and code are copies of the class, qualifier and code part of the intuimessage, so you don't need to remember them in message_test(). You should return TRUE if you want the action the user of the PLUGIN has written in his GUI-spec to be executed upon termination of this method (do this if your object clearly can be "hit", such as a gadget. If you just do some rendering you might want to ignore the actionvalue). The default method returns FALSE. (As noted above, the action function is passed the PLUGIN object as well as the GUI info.) Note: do not confuse message_action() with action values: the former is for implementing the plugin's behaviour generally, while the latter is for specific behaviour in a specific GUI, attached by the user of your plugin (which could be you again :-). appmessage(amsg:PTR TO appmessage,win:PTR TO window) Like the testing for window IDCMP, but for AppWindow message testing. Return TRUE _only_if_ the message is meant for this PLUGIN. The PLUGINs (optional) awproc will then be called (as normal, with the optional data field being the `plugin_object'). Note: for compatibility, the appmessage() method is called only for PLUGINs that specify a non-NIL `awproc' field. Just be careful to *not* specify a non-NIL `awproc' field with old PLUGIN modules. If you supply a plugin as module for others, you'll have to state what constructor(s) they may use, wether or not they have to supply a sensible action-value. END will almost always have to be called. +---------------------------------------------------------------+ | 6. guide to the examples | +---------------------------------------------------------------+ There are numerous examples to show the various features of EasyGUI. Here's a small guide to help you find the ones that might be interesting: alldist.e - The original example. alldist2.e - The original example, using multi-windows and blocking. You can have all the example GUIs open at once! testaw.e - AppWindow example. testchange.e - changegui() example. testchange2.e - changeXXX() and multi-window example. testkey.e - Keyboard shortcuts example, with window blocking and gadget disabling. testmulti.e - Multi-window example (recursive!). testmulti2.e - Multi-window and multiforall() example. testqual.e - Qualifier example. animcontrol_test.e - Tests animcontrol PLUGIN. button_test.e - Tests flavours of button PLUGIN. calendar_test.e - Tests calender PLUGIN. colorwheel_test.e - Tests colorwheel PLUGIN. gradient_test.e - Tests gradient (slider) PLUGIN. imagebutton_test.e - Tests flavours of imagebutton PLUGIN. led_test.e - Tests led PLUGIN, with pseudo-async activity. led_test2.e - Tests led PLUGIN, with multi-windows and pseudo-async activities. led_test3.e - Tests led PLUGIN, with multi-windows and *real* async activities. led_test4.e - Tests led and ticker PLUGINs, with multi-windows and pseudo-async activities. password_test.e - Tests password PLUGIN. tabs_test.e - Tests tabs PLUGIN. tabs_test2.e - Tests tabs PLUGIN and changegui() example. tapedeck_test.e - Tests tapedeck PLUGIN. ticker_test.e - Tests ticker PLUGIN. These can be found in Src/EasyGUI. The sources for the example PLUGINs are in Src/Plugins. +---------------------------------------------------------------+ | 7. bugs/future | +---------------------------------------------------------------+ bugs: - method of displaying slider values not bulletproof - GadTools sends two messages if your slider value is changed to a negative value, so your action function can get called twice. [the planned render spaces can now be done much better by using PLUGINs] ---------------------------------------------------------------- General advice: try out and modify the examples. Sometimes something won't work, but EasyGUI is flexible enough that at least one way of arranging groups etc. will give you a nice GUI :-). If you need more power than EasyGUI currently gives, you'll have to use MUI/BGUI/WhatEver instead. Wouter (and Jason!) 9[-lh0-VV!#Src\Tools\EasyGUI\Docs\gradient.docGradientSlider PLUGIN --------------------- The silder that goes with the colorwheel from the Palette prefs program. Uses the 'gradientslider.gadget' which needs to be in the normal place of libs:gadgets/ (usually libs: is also assigned to sys:classes/, and .gadget files should be stored in the sys:classes/gadgets/ directory). Constructors: gradient(vert=FALSE,curval=0,rel=5,pens=NIL:PTR TO INT,disabled=FALSE) vert -> Whether this gadget is vertical or horizontal curval -> The current value of the slider rel -> The relative size (height if vert, width if not) pens -> The pen array used in the gradient (ends with -1) disabled -> Whether this gadget is disabled Destructor: END *must* be called for each NEWed object. Data (should be considered read-only, except as mentioned below): OBJECT button OF plugin curval -> The current value of the slider (0 to $FFFF) pens:PTR TO INT -> The current pen array for the gradient disabled -> Disabled or enabled PRIVATE ... ENDOBJECT New methods: setcurval(x) -> Set the current value of the slider setpens(pens=NIL:PTR TO INT) -> Change the pen array setdisabled(disabled=TRUE) -> Disable/enable the gadget Note: if NIL is specified for setpens() then the current pen array will be used (in which case it's OK to edit the data in self.pens just before calling setpens()). Action functions: Your action function will be called (or your action value returned by easygui()) in the following circumstances: o When the slider is moved or released. Exceptions: "grad" will be raised by the constructor if the .gadget file can't be opened. "grad" will be raised by the render() method if the gadget can't be created. <-lh0- !&Src\Tools\EasyGUI\Docs\imagebutton.docLImageButton PLUGIN ------------------ A flexible image button gadget in three flavours: normal (momentary), toggle and push (sticky). Uses the 'button.gadget' which needs to be in the normal place of libs:gadgets/ (usually libs: is also assigned to sys:classes/, and .gadget files should be stored in the sys:classes/gadgets/ directory). Constructors: imagebutton(image:PTR TO image,width=0,height=0, resizex=FALSE,resizey=FALSE,disabled=FALSE) image -> The button's image width -> The nominal width of the gadget height -> The nominal height of the gadget resizex -> Whether this button can resize in width resizey -> Whether this button can resize in height disabled -> Whether this gadget is disabled toggleimagebutton(image:PTR TO image,width=0,height=0,selected=FALSE, resizex=FALSE,resizey=FALSE,disabled=FALSE) image -> The button's image width -> The nominal width of the gadget height -> The nominal height of the gadget selected -> Whether this button is selected (on) initially resizex -> Whether this button can resize in width resizey -> Whether this button can resize in height disabled -> Whether this gadget is disabled pushimagebutton(image:PTR TO image,width=0,height=0,selected=FALSE, resizex=FALSE,resizey=FALSE,disabled=FALSE) image -> The button's image width -> The nominal width of the gadget height -> The nominal height of the gadget selected -> Whether this button is selected (on) initially resizex -> Whether this button can resize in width resizey -> Whether this button can resize in height disabled -> Whether this gadget is disabled Note: the width and height of the gadget will be at least as big as that needed to fit the image (so it's safe to specify them as 0). Destructor: END *must* be called for each NEWed object. Data (should be considered read-only): OBJECT imagebutton OF plugin selected -> Current state of the button (=0 is off, <>0 is on) disabled -> Disabled or enabled PRIVATE ... ENDOBJECT The selected element is useful only for toggle and push buttons. New methods: setselected(selected=TRUE) -> Set the button on or off setimage(image:PTR TO image) -> Change the button's image setdisabled(disabled=TRUE) -> Disable/enable the gadget Note: setselected() is ignored for normal buttons. Note: push buttons cannot be deselected by the user (they're sticky), so use setselected() to deselect them when necessary. Note: setimage() will work only if the image fits in the button's minimum size (so, you should specify the maximum width and height of the images you will use in the constructor...) Action functions: Your action function will be called (or your action value returned by easygui()) in the following circumstances: o When the button is pressed to select or deselect it. Exceptions: "butt" will be raised by the constructor if the .gadget file can't be opened. "butt" will be raised by the render() method if the gadget can't be created. 4`-lh0-#!Src\Tools\EasyGUI\Docs\led.doc*LED PLUGIN ---------- Draws pairs of digits to look like LED displays (such as clocks). Uses the 'led.image' which needs to be in the normal place of libs:images/ (usually libs: is also assigned to sys:classes/, and .image files should be stored in the sys:classes/images/ directory). Constructors: led(pairs=2,values=NIL,colon=FALSE,signed=FALSE,negative=FALSE,pen=1) pairs -> The number of pairs of digits values -> The values (one value per pair of digits) colon -> Whether the colon between pairs is displayed signed -> Whether use will be made of the leading minus sign negative -> Whether the leading minus sign is on or off pen -> The pen (colour) of the LED Destructor: END *must* be called for each NEWed object. Data (should be considered read-only, except as mentioned below): OBJECT led OF plugin pairs values:PTR TO INT colon signed negative pen PRIVATE ... ENDOBJECT New methods: redisplay() -> Redraw according to new values Note: it is OK to change the public data just before calling redisplay() (and this is the only real use for redisplay()). Action functions: Ignored. Exceptions: "led" will be raised by the constructor if the .image file can't be opened. "led" will be raised by the render()/redisplay() methods if the image can't be created. 9-lh0-  !#Src\Tools\EasyGUI\Docs\password.docPassword PLUGIN --------------- Makes a rudimentary password entry gadget. Uses a standard GadTools string gadget so you need to specify TRUE for the optional `isgt' field of the PLUGIN gadget to use it (otherwise you get a black rectangle!). Constructors: password(estr,label=NIL,over=FALSE,relx=0,disabled=FALSE) estr -> The initial password (must be an E-string) label -> The label for the gadget over -> Whether the string gadget is in overwrite mode relx -> Relative width (default is 5) disabled -> Whether this gadget is disabled Destructor: END *must* be called for each NEWed object. Data (should be considered read-only): OBJECT password OF plugin estr -> Current password disabled -> Disabled or enabled PRIVATE ... ENDOBJECT New methods: setpass(str) -> Set the password to str (copied) setdisabled(disabled=TRUE) -> Disable/enable the gadget Action functions: Your action function will be called (or your action value returned by easygui()) in the following circumstances: o When the return or tab is pressed in the gadget Note: unlike normal STR gadgets, the estr is *always* up-to-date. Exceptions: "pass" will be raised by the constructor if the gadtools.library can't be opened. "pass" will be raised by the render() method if the gadget can't be created. "MEM" will be raised by the constructor or setpass() method if the temporary string can't be created. 5=-lh0-.!Src\Tools\EasyGUI\Docs\tabs.doc"Tabs PLUGIN ----------- Makes a set of tabs for page selection (most useful with changegui()). Uses the 'tabs.gadget' which needs to be in the normal place of libs:gadgets/ (usually libs: is also assigned to sys:classes/, and .gadget files should be stored in the sys:classes/gadgets/ directory). Constructors: tabs(tabslist:PTR TO tablabel,current=0,max=TRUE,disabled=FALSE) tabslist -> The list of labels to use current -> The initial tab selected max -> Whether each tab has the width of the widest tab disabled -> Whether this gadget is disabled Note: the gadget will *conditionally* resize in width. Destructor: END *must* be called for each NEWed object. Data (should be considered read-only): OBJECT tabs OF plugin current -> Currently selected tab disabled -> Disabled or enabled PRIVATE ... ENDOBJECT New methods: setcurrent(x) -> Set the current selected tab setdisabled(disabled=TRUE) -> Disable/enable the gadget Action functions: Your action function will be called (or your action value returned by easygui()) in the following circumstances: o When one of the tabs is pressed (current will indicate the selected tab) Exceptions: "tabs" will be raised by the constructor if the .gadget file can't be opened. "tabs" will be raised by the render() method if the gadget can't be created. 9T-lh0-VV1!#Src\Tools\EasyGUI\Docs\tapedeck.docTapeDeck PLUGIN --------------- Consists of play, rewind, fast forward, stop and pause gadgets. Uses the 'tapedeck.gadget' which needs to be in the normal place of libs:gadgets/ (usually libs: is also assigned to sys:classes/, and .gadget files should be stored in the sys:classes/gadgets/ directory). Constructors: tapedeck(mode=BUT_STOP,paused=FALSE,disabled=FALSE) mode -> The current mode (see below) paused -> Whether the pause button is pressed initially disabled -> Whether this gadget is disabled Destructor: END *must* be called for each NEWed object. Data (should be considered read-only): OBJECT tapedeck OF plugin mode -> Current mode paused -> Paused or not disabled -> Disabled or enabled PRIVATE ... ENDOBJECT The mode is taken from 'gadgets/tapedeck'. It will be: o BUT_PLAY if playing o BUT_STOP if stopped o BUT_FORWARD if fast forwarding o BUT_REWIND if rewinding New methods: setmode(mode=BUT_STOP) -> Set the current mode setpaused(paused=TRUE) -> Set paused on or off setdisabled(disabled=TRUE) -> Disable/enable the gadget Action functions: Your action function will be called (or your action value returned by easygui()) in the following circumstances: o When one of the buttons is pressed (mode and paused will reflect the current state) Exceptions: "tape" will be raised by the constructor if the .gadget file can't be opened. "tape" will be raised by the render() method if the gadget can't be created. 7-lh0-M"!Src\Tools\EasyGUI\Docs\ticker.docbTicker PLUGIN ------------- A simple PLUGIN that absorbs all the IDCMP_INTUITICKS and calls its action function on each tick. Constructors: None, just create the object. Destructor: None, you needn't call END, but it doesn't hurt. Action functions: Your action function will be called (or your action value returned by easygui()) in the following circumstances: o When an IDCMP_INTUITICK occurs. Note: IDCMP_INTUITICKS only happen to the active window! Exceptions: None. 6-lh0-&& L" Src\Tools\EasyGUI\Examples\all.ed-> Test GUI's gathered in one program. OPT OSVERSION=37 MODULE 'tools/EasyGUI', 'tools/exceptions', 'libraries/gadtools' DEF gh DEF havefonts=FALSE, havescreenmode=FALSE, havefile=FALSE, havesearch=FALSE, havesearch2=FALSE, haveamosaic=FALSE, havedb=FALSE, havedm=FALSE, havetiny=FALSE, havemessy=FALSE DEF s[50]:STRING PROC main() HANDLE DEF mh=NIL:PTR TO multihandle StrCopy(s,'bla') mh:=multiinit() addmultiA(mh,'EasyGUI Tests', [EQROWS, [BUTTON,{fonts},'Fonts'], [BUTTON,{screenmode},'ScreenMode'], [BUTTON,{file},'File Requester'], [BUTTON,{search},'Search Requester'], [BUTTON,{search2},'Search Requester 2'], [BUTTON,{amosaic},'Amosaic'], [BUTTON,{db},'DataBase'], [BUTTON,{dm},'DiskMaster'], [BUTTON,{tiny},'Tiny Test'], [BUTTON,{messy},'Messy Test'] ], [EG_CLOSE,{quit}, NIL] ) REPEAT WriteF('result=\d\n',multiloop(mh)) UNTIL mh.opencount=0 EXCEPT DO cleanmulti(mh) report_exception() ENDPROC PROC quit(mh,info) IS multiforall({gh},mh,`cleangui(gh)) PROC havenot(var:PTR TO LONG) var[]:=FALSE ENDPROC PROC fonts(x:PTR TO guihandle) IF havefonts=FALSE havefonts:=TRUE addmultiA(x.mh, 'Font Preferences', [EQROWS, [TEXT,'Selected Fonts',NIL,FALSE,3], [BEVELR, [EQROWS, [TEXT,'xentiny 8','Workbench Icon Text:',FALSE,3], [TEXT,'end 10','System Default Text:',FALSE,3], [TEXT,'except 12','Screen text:',FALSE,3] ] ], [SBUTTON,0,'Select Workbench Icon Text...'], [SBUTTON,0,'Select System Default Text...'], [SBUTTON,0,'Select Screen text...'], [BAR], [COLS, [BUTTON,0,'Save'], [SPACEH], [BUTTON,0,'Use'], [SPACEH], [BUTTON,0,'Cancel'] ] ], [EG_CLEAN,{havenot}, EG_INFO,{havefonts}, NIL] ) ENDIF ENDPROC PROC screenmode(x:PTR TO guihandle) IF havescreenmode=FALSE havescreenmode:=TRUE addmultiA(x.mh,'ScreenMode Preferences', [EQROWS, [COLS, [EQROWS, [LISTV,0,'Display Mode',10,4,NIL,TRUE,0,0], [COLS, [EQROWS,[INTEGER,0,'Width:',640,5],[INTEGER,0,'Height:',512,5]], [ROWS,[CHECK,0,'Default',TRUE,FALSE],[CHECK,0,'Default',TRUE,FALSE]] ], [SLIDE,0,'Colors:',FALSE,1,8,3,5,''], [CHECK,0,'AutoScroll:',TRUE,TRUE] ], ->[BAR], [BEVELR, [EQROWS, [TEXT,'688x539','Visible Size:',FALSE,3], [TEXT,'640x200','Minimum Size:',FALSE,3], [TEXT,'16368x16384','Maximum Size:',FALSE,3], [TEXT,'256','Maximum Colors:',FALSE,3], [SPACE] ] ] ], [BAR], [COLS, [BUTTON,0,'Save'], [SPACEH], [BUTTON,0,'Use'], [SPACEH], [BUTTON,0,'Cancel'] ] ], [EG_CLEAN,{havenot}, EG_INFO,{havescreenmode}, NIL] ) ENDIF ENDPROC PROC file(x:PTR TO guihandle) IF havefile=FALSE havefile:=TRUE addmultiA(x.mh,'Select a file:', [EQROWS, [LISTV,0,NIL,1,5,NIL,0,NIL,0], [STR,{fr},'Pattern',s,200,5], [STR,{fr},'Drawer',s,200,5], [STR,{fr},'File',s,200,5], [COLS, [BUTTON,1,'Ok'], [SPACEH], [BUTTON,2,'Disks'], [SPACEH], [BUTTON,3,'Parent'], [SPACEH], [BUTTON,0,'Cancel'] ] ], [EG_CLEAN,{havenot}, EG_INFO,{havefile}, NIL] ) ENDIF ENDPROC PROC fr(a,b) IS WriteF('fr: \s\n',b) PROC search(x:PTR TO guihandle) IF havesearch=FALSE havesearch:=TRUE addmultiA(x.mh,'Enter Search/Replace text:', [ROWS, [ROWS, -> ROWS [EQROWS, [STR,{find},'Locate',s,10,10], [STR,{repl},'Replace',s,10,10] ], [COLS, -> COLS [CHECK,{case},'Ignore case',TRUE,FALSE], [CHECK,{word},'Whole words only',FALSE,FALSE], [CHECK,{forw},'Search forward',TRUE,FALSE] ] ], [BAR], [EQCOLS, [BUTTON,1,'Search'], [SPACEH], [BUTTON,2,'Replace'], [SPACEH], [BUTTON,0,'Cancel'] ] ], [EG_CLEAN,{havenot}, EG_INFO,{havesearch}, NIL] ) ENDIF ENDPROC PROC find(x,y) IS WriteF('Find="\s"!\n',y) PROC repl(x,y) IS WriteF('Repl="\s"!\n',y) PROC case(x,y) IS WriteF('Case=\d!\n',y) PROC word(x,y) IS WriteF('Word=\d!\n',y) PROC forw(x,y) IS WriteF('Forw=\d!\n',y) PROC search2(x:PTR TO guihandle) IF havesearch2=FALSE havesearch2:=TRUE addmultiA(x.mh,'Enter Search/Replace text:', [ROWS, [COLS, -> ROWS [EQROWS, [STR,{find},'Locate',s,10,10], [STR,{repl},'Replace',s,10,10] ], [EQROWS, -> COLS [CHECK,{case},'Ignore case',TRUE,FALSE], [CHECK,{word},'Whole words only',FALSE,FALSE], [CHECK,{forw},'Search forward',TRUE,FALSE] ] ], [BAR], [EQCOLS, [BUTTON,1,'Search'], [SPACEH], [BUTTON,2,'Replace'], [SPACEH], [BUTTON,0,'Cancel'] ] ], [EG_CLEAN,{havenot}, EG_INFO,{havesearch2}, NIL] ) ENDIF ENDPROC PROC amosaic(x:PTR TO guihandle) IF haveamosaic=FALSE haveamosaic:=TRUE addmultiA(x.mh,'AMosaic', [EQROWS, [TEXT,'Wouter''s WWW page','Title:',TRUE,3], [TEXT,'file://localhost/...','URL:',TRUE,3], [COLS, [SBUTTON,0,'Back'], [SBUTTON,0,'Forward'], [SBUTTON,0,'Home'], [SBUTTON,0,'Open'], [SBUTTON,0,'Reload'], [SBUTTON,0,'Quit'] ], [COLS, [BEVELR, [SPACE] ], [SCROLL,0,TRUE,10,0,2,10] ], [TEXT,'file://localhost/...',NIL,FALSE,3] ], [EG_CLEAN,{havenot}, EG_INFO,{haveamosaic}, NIL] ) ENDIF ENDPROC PROC db(x:PTR TO guihandle) IF havedb=FALSE havedb:=TRUE addmultiA(x.mh,'EasyBase v0.1', [ROWS, [LISTV,0,NIL,5,4,NIL,0,NIL,0], [COLS, [BUTTON,0,'New'], [BUTTON,{fields},'Fields',x.mh], [BUTTON,0,'Load'], [BUTTON,0,'Save']]], [EG_CLEAN,{havenot}, EG_INFO,{havedb}, NIL]) ENDIF ENDPROC PROC fields(mh,i) HANDLE multiforall({gh},mh,`blockwin(gh)) easyguiA('Edit Fields', [ROWS, [LISTV,0,NIL,5,3,NIL,0,NIL,0], [COLS, [BUTTON,{addfield},'Add'], [BUTTON,0,'Delete'], [BUTTON,0,'Change']]]) EXCEPT DO multiforall({gh},mh,`unblockwin(gh)) ReThrow() ENDPROC PROC editfield(gh) HANDLE blockwin(gh) easyguiA('Field Characteristics', [ROWS, [EQROWS, [STR,0,'fieldname',s,200,10], [INTEGER,0,'fieldlength',40,10]], [BUTTON,0,'Ok']]) EXCEPT DO unblockwin(gh) ReThrow() ENDPROC PROC addfield(i) IS editfield(i) PROC dm(x:PTR TO guihandle) IF havedm=FALSE havedm:=TRUE addmultiA(x.mh,'E FileManager v0.1', [ROWS, [COLS, [ROWS, [LISTV,0,NIL,1,10,NIL,0,NIL,0], [STR,0,'',s,200,5] ], [EQROWS, [BUTTON,1,'DF0:'], [BUTTON,1,'DF1:'], [BUTTON,1,'Ram:'], [BUTTON,1,'System:'], [BUTTON,1,'Work:'], [BUTTON,1,'E:'], [SPACEV] ], [ROWS, [LISTV,0,NIL,1,5,NIL,0,NIL,0], [STR,0,'',s,200,5] ] ], [COLS, [EQROWS,[SBUTTON,1,'Parent'],[SBUTTON,1,'All']], [EQROWS,[SBUTTON,1,'Copy'],[SBUTTON,1,'Clear']], [EQROWS,[SBUTTON,1,'Move'],[SBUTTON,1,'Toggle']], [EQROWS,[SBUTTON,1,'Rename'],[SBUTTON,1,'Size']], [EQROWS,[SBUTTON,1,'Delete'],[SBUTTON,1,'View']], [EQROWS,[SBUTTON,1,'MakeDir'],[SBUTTON,0,'Config']] ] ], [EG_CLEAN,{havenot}, EG_INFO,{havedm}, NIL] ) ENDIF ENDPROC PROC tiny(x:PTR TO guihandle) IF havetiny=FALSE havetiny:=TRUE addmultiA(x.mh,'um..',[SBUTTON,0,'blerk'], [EG_CLEAN,{havenot}, EG_INFO,{havetiny}, NIL]) ENDIF ENDPROC PROC messy(x:PTR TO guihandle) IF havemessy=FALSE havemessy:=TRUE addmultiA(x.mh,'test-gui', [ROWS, [COLS, [BEVEL, [ROWS, [BUTTON,{um},'Um,...'], [MX,{v},NIL,['One','Two','Three',NIL],FALSE,1], [BUTTON,{pom},'PomPomPom'], [CHECK,{v},'check this out!',TRUE,FALSE], [STR,{v},'input',s,50,3], [LISTV,{v},NIL,2,5,NIL,FALSE,0,0] ] ], [BEVEL, [EQROWS, [STR,{v},'input',s,50,4], [INTEGER,{v},'int:',5,3], [SLIDE,{v},'tata: ',FALSE,0,999,20,2,'%3ld'], [TEXT,'bla','text:',FALSE,5], [NUM,123,'num:',TRUE,5], [PALETTE,{v},'kleur:',3,5,2,0], [CYCLE,{v},'choose:',['Yep','Nope',NIL],1], [SCROLL,{v},FALSE,10,0,2,2] ] ] ], [BAR], [EQCOLS, [BUTTON,1,'Save'], [BUTTON,2,'Use'], [BUTTON,0,'Cancel'] ] ], [EG_CLEAN,{havenot}, EG_INFO,{havemessy}, EG_MENU,[NM_TITLE,0,'Project',0, 0,0,0, NM_ITEM,0,'Load', 'l',0,0,{um}, NM_ITEM,0,'Save', 's',0,0,{um}, NM_ITEM,0,'Bla ->', 0, 0,0,0, NM_SUB,0,'aaargh', 'a',0,0,1, NM_SUB,0,'hmmm', 'h',0,0,2, NM_ITEM,0,'Quit', 'q',0,0,0, 0,0,0,0,0,0,0]:newmenu, NIL] ) ENDIF ENDPROC PROC um(x) IS WriteF('um!\n') PROC pom(x) IS WriteF('pom!\n') PROC v(x,y) IS WriteF('v=\d!\n',y) C-lh0-qJ"-Src\Tools\EasyGUI\Examples\animcontrol_test.e˛MODULE 'tools/easygui', 'tools/exceptions', 'plugins/animcontrol' PROC main() HANDLE DEF a=NIL:PTR TO animcontrol NEW a.animcontrol(10,20) easyguiA('BOOPSI in EasyGUI!', [ROWS, [TEXT,'AnimControl test...',NIL,TRUE,1], [PLUGIN,{animcontrolaction},a], [EQCOLS, [BUTTON,{reset},'Reset',a], [BUTTON,{toggle_enabled},'Toggle Enabled',a] ] ]) EXCEPT DO END a report_exception() ENDPROC PROC animcontrolaction(i,a:PTR TO animcontrol) PrintF('Action: mode=\d frame=\d\n', a.mode, a.frame) ENDPROC PROC reset(a:PTR TO animcontrol,i) a.setframe(10) a.setplay(FALSE) ENDPROC PROC toggle_enabled(a:PTR TO animcontrol,i) a.setdisabled(a.disabled=FALSE) ENDPROC >-lh0-HHxJ"(Src\Tools\EasyGUI\Examples\button_test.eMODULE 'tools/easygui', 'tools/exceptions', 'plugins/button' DEF b2=NIL:PTR TO button PROC main() HANDLE DEF b1=NIL:PTR TO button, b3=NIL:PTR TO button, bp=NIL:PTR TO button NEW bp.togglebutton('Paused') easyguiA('BOOPSI in EasyGUI!', [ROWS, [TEXT,'Button test...',NIL,TRUE,5], [COLS, [PLUGIN,{buttonaction1},NEW b1.togglebutton('New')], [PLUGIN,{buttonaction1},NEW b2.pushbutton('Open')], [PLUGIN,{buttonaction2},NEW b3.button('Save')], [PLUGIN,{buttonaction3},bp] ], [SBUTTON,{toggle_enabled},'Toggle Enabled',bp] ]) EXCEPT DO END b1,b2,b3,bp report_exception() ENDPROC PROC buttonaction1(i,b:PTR TO button) WriteF('button selected=\d\n', b.selected) ENDPROC PROC buttonaction2(i,b:PTR TO button) WriteF('button selected=\d\n', b.selected) b2.setselected(FALSE) ENDPROC PROC buttonaction3(i,b:PTR TO button) WriteF('button selected=\d\n', b.selected) b.settext(IF b.selected THEN 'Play' ELSE 'Paused') ENDPROC PROC toggle_enabled(b:PTR TO button,i) b.setdisabled(b.disabled=FALSE) ENDPROC @$-lh0-UU J"*Src\Tools\EasyGUI\Examples\calendar_test.eMODULE 'tools/EasyGUI', 'tools/exceptions', 'utility/date', 'plugins/calendar' DEF title PROC main() HANDLE DEF c=NIL:PTR TO calendar NEW c.calendar([0,0,0,25,12,1996,0]:clockdata,TRUE) easyguiA('BOOPSI in EasyGUI!', [ROWS, title:=[TEXT,'Calendar: December 1996',NIL,TRUE,5], [PLUGIN,{calendaraction},c], [EQCOLS, [BUTTON,{reset},'Set to October',c], [BUTTON,{toggle_enabled},'Toggle Enabled',c] ] ]) EXCEPT DO END c report_exception() ENDPROC PROC calendaraction(i,c:PTR TO calendar) WriteF('You picked day \d\n', c.date.mday) ENDPROC PROC reset(c:PTR TO calendar,gh) IF c.date.month<>10 c.date.month:=10 c.setdate() settext(gh,title,'Calendar: October 1996') ENDIF ENDPROC PROC toggle_enabled(c:PTR TO calendar,i) c.setdisabled(c.disabled=FALSE) ENDPROC B-lh0-%J",Src\Tools\EasyGUI\Examples\colorwheel_test.eIMODULE 'tools/easygui', 'tools/exceptions', 'gadgets/colorwheel', 'plugins/colorwheel' DEF rgb:colorwheelrgb, hsb:colorwheelhsb, title PROC init(rgb:PTR TO colorwheelrgb) rgb.red:=-1; rgb.blue:=0; rgb.green:=0 ENDPROC PROC main() HANDLE DEF c=NIL:PTR TO colorwheel init(rgb) NEW c.colorwheel(rgb,NIL,TRUE) easyguiA('BOOPSI in EasyGUI!', [ROWS, title:=[TEXT,'Colorwheel test (using RGB)...',NIL,TRUE,1], [COLS, [PLUGIN,{colorwheelaction},c], [EQROWS, [BUTTON,{reset},'Reset',c], [BUTTON,{swap},'RGB/HSB',c], [BUTTON,{toggle_enabled},'Toggle Enabled',c] ] ] ]) EXCEPT DO END c report_exception() ENDPROC PROC colorwheelaction(i,c:PTR TO colorwheel) IF c.rgb PrintF('RGB r=$\h, g=$\h, b=$\h\n', c.rgb.red, c.rgb.green, c.rgb.blue) ELSE PrintF('HSB h=$\h, s=$\h, b=$\h\n', c.hsb.hue, c.hsb.saturation, c.hsb.brightness) ENDIF ENDPROC PROC reset(c:PTR TO colorwheel,gh) init(rgb) c.setrgb(rgb) settext(gh,title,'Reset Colorwheel to RGB...') ENDPROC PROC swap(c:PTR TO colorwheel,gh) IF c.rgb settext(gh,title,'Now Colorwheel is HSB...') c.gethsb(hsb) c.sethsb(hsb) ELSE settext(gh,title,'Colorwheel using RGB...') c.getrgb(rgb) c.setrgb(rgb) ENDIF ENDPROC PROC toggle_enabled(c:PTR TO colorwheel,i) c.setdisabled(c.disabled=FALSE) ENDPROC @-lh0-.J"*Src\Tools\EasyGUI\Examples\gradient_test.eMODULE 'tools/EasyGUI', 'tools/exceptions', 'plugins/gradient' DEF disabled=FALSE, pens1, pens2 PROC main() HANDLE DEF g=NIL:PTR TO gradient pens1:=[2,0,1,-1]:INT pens2:=[1,0,2,-1]:INT NEW g.gradient(FALSE,$4444,6,pens1) easyguiA('BOOPSI in EasyGUI!', [ROWS, [TEXT,'GradientSlider test...',NIL,TRUE,15], [PLUGIN,{gradaction},g], [COLS, [BUTTON,{reset},'Reset',g], [BUTTON,{swap_pens},'Swap Pens',g], [BUTTON,{toggle_enabled},'Toggle Enabled',g] ] ]) EXCEPT DO report_exception() ENDPROC PROC gradaction(i,g:PTR TO gradient) WriteF('gradient value = \z$\h[4]\n', g.curval) ENDPROC PROC reset(g:PTR TO gradient,i) g.setcurval($4444) g.setpens(pens1) ENDPROC PROC swap_pens(g:PTR TO gradient,i) g.setpens(IF g.pens=pens1 THEN pens2 ELSE pens1) ENDPROC PROC toggle_enabled(g:PTR TO gradient,i) g.setdisabled(g.disabled=FALSE) ENDPROC ?*-lh0-##!G#)Src\Tools\EasyGUI\Examples\iconify_test.ecMODULE 'tools/exceptions', 'tools/easygui', 'other/split', 'plugins/iconify' PROC main() HANDLE DEF args:PTR TO LONG, p=NIL:PTR TO iconify IF args:=argSplit() IF args[] PrintF('Using the icon for "\s"\n',args[]) ELSE PrintF('Using default icon (try "sys:tools/CMD" as an argument)\n') ENDIF NEW p.iconify('Iconify',args[],'Hello',TRUE) easyguiA('GadTools in EasyGUI!', [ROWS, [TEXT,'Iconify test...',NIL,TRUE,1], [SPACE], [PLUGIN,0,p,TRUE], [SPACE], [BUTTON,{toggle_enabled},'Toggle Enabled',p] ]) ELSE PrintF('Bad arguments: specify a filename\n') ENDIF EXCEPT DO END p report_exception() ENDPROC PROC toggle_enabled(p:PTR TO iconify,i) p.setdisabled(p.disabled=FALSE) ENDPROC Ci-lh0-6J"-Src\Tools\EasyGUI\Examples\imagebutton_test.e"MODULE 'tools/easygui', 'tools/exceptions', 'tools/copylist', 'intuition/intuition', 'plugins/imagebutton' DEF pp1, pp2, b2=NIL:PTR TO imagebutton PROC main() HANDLE DEF b1=NIL:PTR TO imagebutton, b3=NIL:PTR TO imagebutton, bp=NIL:PTR TO imagebutton, img1, img2, img3, d1=NIL, d2=NIL, d3=NIL, d4=NIL, d5=NIL img1:=[0,0,22,22,3, d1:=copyListToChip([ /* Plane 0 */ $00000000,$00000000,$00000000,$00000000, $00FC0000,$00060000,$00058000,$0404C000, $0407E000,$04006000,$04006000,$04006000, $04006000,$04006000,$04006000,$04006000, $04006000,$04006000,$04006000,$07FFE000, $01FFE000,$00000000, /* Plane 1 */ $00000000,$02000000,$0A800000,$07000000, $38C00000,$07F80000,$0BFA8000,$07FB4000, $07F82000,$07FFA000,$07FFA000,$07FFA000, $03FFA000,$03FFA000,$03FFA000,$03FFA000, $03FFA000,$03FFA000,$03FFA000,$00002000, $01FFE000,$00000000, /* Plane 2 */ $00000000,$00000000,$00000000,$00000000, $00C00000,$00000000,$00008000,$04004000, $04002000,$04002000,$04002000,$04002000, $00002000,$00002000,$00002000,$00002000, $00002000,$00002000,$00002000,$00002000, $01FFE000,$00000000]), $0007,0,NIL]:image img2:=[0,0,22,22,3, d2:=copyListToChip([ /* Plane 0 */ $00000000,$00007000,$0003F000,$000FF000, $001FF800,$000FF800,$0007F800,$1E0FF000, $21DFF000,$40FFF000,$407FF000,$40FB2000, $5FFF8000,$50008000,$7000E000,$6000C000, $60018000,$60018000,$40010000,$7FFE0000, $00000000,$00000000, /* Plane 1 */ $00000000,$00004000,$00022000,$0001E000, $0017E800,$000BE800,$0003D800,$0007D000, $1ECE5000,$3F1DB000,$3FB9F000,$3F752000, $20000000,$2FFF0000,$3FFF6000,$1FFF4000, $1FFF8000,$3FFE8000,$3FFE0000,$00000000, $00000000,$00000000, /* Plane 2 */ $00000000,$00004000,$00020000,$00000000, $00100800,$00080800,$00001800,$00001000, $1EC01000,$3F01B000,$3F81F000,$3F052000, $20000000,$25550000,$3AAA6000,$15554000, $0AAB8000,$35548000,$2AAA0000,$00000000, $00000000,$00000000]), $0007,0,NIL]:image img3:=[0,0,22,22,3, d3:=copyListToChip([ /* Plane 0 */ $00000000,$10000000,$3C000000,$7E000000, $3F000000,$1FB00000,$0FF00000,$07FC0000, $07FC0000,$0BFC0000,$17FF8000,$17F8C000, $11F8C000,$17FFE000,$14002000,$1C003800, $18003000,$18006000,$18006000,$10004000, $1FFF8000,$00000000, /* Plane 1 */ $00000000,$00000000,$14000000,$3A000000, $1D000000,$0E900000,$07200000,$03EC0000, $01EC0000,$05F40000,$0BF00000,$08F74000, $0F374000,$08000000,$0BFFC000,$0FFFD800, $07FFD000,$07FFE000,$0FFFA000,$0FFF8000, $00000000,$00000000, /* Plane 2 */ $00000000,$00000000,$04000000,$02000000, $01000000,$00900000,$00000000,$000C0000, $000C0000,$04040000,$08000000,$08074000, $0F274000,$08000000,$09554000,$0EAA9800, $05555000,$02AAE000,$0D552000,$0AAA8000, $00000000,$00000000]), $0007,0,NIL]:image pp1:=[0,0,22,7,2, d4:=copyListToChip([$00030000, $0003C000, $0003F000, $0003FC00, $0003F000, $0003C000, $00030000, $E3800000, $E3800000, $E3800000, $E3800000, $E3800000, $E3800000, $E3800000]), $0003, 0, NIL]:image pp2:=[0,0,22,7,2, d5:=copyListToChip([$E3800000, $E3800000, $E3800000, $E3800000, $E3800000, $E3800000, $E3800000, $00030000, $0003C000, $0003F000, $0003FC00, $0003F000, $0003C000, $00030000]), $0003, 0, NIL]:image NEW bp.toggleimagebutton(pp1,30,22) easyguiA('BOOPSI in EasyGUI!', [ROWS, [TEXT,'ImageButton test...',NIL,TRUE,5], [COLS, [PLUGIN,{buttonaction1},NEW b1.toggleimagebutton(img1)], [PLUGIN,{buttonaction1},NEW b2.pushimagebutton(img2)], [PLUGIN,{buttonaction2},NEW b3.imagebutton(img3)], [PLUGIN,{buttonaction3},bp] ], [SBUTTON,{toggle_enabled},'Toggle Enabled',bp] ]) EXCEPT DO END b1,b2,b3,bp Dispose(d1); Dispose(d2); Dispose(d3); Dispose(d4); Dispose(d5) report_exception() ENDPROC PROC buttonaction1(i,b:PTR TO imagebutton) WriteF('button selected=\d\n', b.selected) ENDPROC PROC buttonaction2(i,b:PTR TO imagebutton) WriteF('button selected=\d\n', b.selected) b2.setselected(FALSE) ENDPROC PROC buttonaction3(i,b:PTR TO imagebutton) WriteF('button selected=\d\n', b.selected) b.setimage(IF b.selected THEN pp2 ELSE pp1) ENDPROC PROC toggle_enabled(b:PTR TO imagebutton,i) b.setdisabled(b.disabled=FALSE) ENDPROC ;-lh0-nnJ"%Src\Tools\EasyGUI\Examples\led_test.eKMODULE 'tools/easygui', 'tools/exceptions', 'graphics/text', 'plugins/led' DEF going=FALSE, title PROC main() HANDLE DEF l=NIL:PTR TO led NEW l.led(2,[0,0]:INT,TRUE) easyguiA('BOOPSI in EasyGUI!', [ROWS, title:=[TEXT,'LED Boopsi image tester...',NIL,TRUE,1], [COLS, [EQROWS, [BUTTON,{runaction},'Run',l], [BUTTON,{stopaction},'Stop'] ], [PLUGIN,0,l] ] ]) EXCEPT DO END l report_exception() ENDPROC PROC runaction(l:PTR TO led,gh) HANDLE DEF h,m IF going settext(gh,title,'I''m busy counting!') ELSE going:=TRUE settext(gh,title,'Started counting...') Delay(10) FOR h:=0 TO 12 FOR m:=0 TO 59 l.values:=[h,m]:INT l.redisplay() l.colon:=(l.colon=FALSE) checkgui(gh) Delay(10) settext(gh,title,'Counting...') ENDFOR ENDFOR settext(gh,title,'Finished!') going:=FALSE ENDIF EXCEPT going:=FALSE settext(gh,title,'You stopped me!') IF exception<>"STOP" THEN ReThrow() ENDPROC PROC stopaction(i) IF going THEN Raise("STOP") ENDPROC This one shows the use of multi-window GUIs with PLUGINs, and multiple, -> pseudo-asynchronous activities. MODULE 'tools/easygui', 'tools/exceptions', 'graphics/text', 'intuition/intuition', 'plugins/led' -> Global for multiforall(). DEF gh:PTR TO guihandle -> Number of GUIs counting. DEF counting=0 CONST NUM_VALUES=2 -> Store all the GUI data in one place. OBJECT mygui -> In particular, keep PLUGIN references here. ledplug:PTR TO led gh:PTR TO guihandle gui title going values[NUM_VALUES]:ARRAY OF INT ENDOBJECT -> The main loop: create one window to start with. PROC main() HANDLE DEF mh=NIL mh:=multiinit() create(mh) multiloop(mh) EXCEPT DO cleanmulti(mh) report_exception() ENDPROC -> Create a new GUI. PROC create(mh) HANDLE DEF t, g, gui=NIL:PTR TO mygui NEW gui -> Allocate all PLUGINs for the GUI like this. NEW gui.ledplug.led(NUM_VALUES,gui.values,TRUE) -> Now we can try opening a GUI. gui.gh:=addmultiA(mh,'BOOPSI in EasyGUI!', g:=NEW [ROWS, t:=NEW [TEXT,'LED Boopsi image tester...',NIL,TRUE,16], NEW [COLS, NEW [EQROWS, NEW [BUTTON,{runaction},'Run/Stop'], NEW [BUTTON,{spawn},'Spawn'], NEW [BUTTON,0,'Quit'] ], NEW [PLUGIN,0,gui.ledplug] ] ], [EG_INFO,gui, EG_LEFT,Rnd(400), EG_TOP,Rnd(400), -> The cleanup routine will deallocate the PLUGINs used. EG_CLEAN,{cleanmygui}, EG_CLOSE,{close}, NIL]) gui.gui:=g gui.title:=t EXCEPT -> If there was any problem then it may have been the creation of PLUGINs -> or addmultiA(). Luckily, addmultiA() (and guiinitA()) will *not* call -> the EG_CLEAN function if they caused the problem, so we can (safely). cleanmygui(gui) ReThrow() ENDPROC -> The custom clean up code for each GUI. PROC cleanmygui(gui:PTR TO mygui) IF gui disposegui(gui.gui) END gui.ledplug END gui ENDIF ENDPROC -> The action function creates a new GUI in the group. PROC spawn(info:PTR TO mygui) IS create(info.gh.mh) -> The run/stop action. PROC runaction(info:PTR TO mygui) IF info.going settext(info.gh,info.title,'You stopped me!') stop(info) ELSE settext(info.gh,info.title,'Started counting...') Delay(10) settext(info.gh,info.title,'Counting...') run(info) ENDIF ENDPROC PROC stop(info:PTR TO mygui) -> Going, so stop. info.going:=FALSE -> One less is counting. DEC counting ENDPROC PROC run(info:PTR TO mygui) DEF mh -> Stopped, so go. info.going:=TRUE -> One more counting. INC counting -> We're the first so we're the loop. IF counting=1 mh:=info.gh.mh -> While there is someone counting WHILE counting -> Tick each GUI that's going. multiforall({gh},mh,`next(gh.info)) checkmulti(mh) Delay(10) ENDWHILE ENDIF ENDPROC -> Next count. PROC next(info:PTR TO mygui) DEF l:PTR TO led,h,m IF info.going l:=info.ledplug l.colon:=(l.colon=FALSE) m:=info.values[1]+1 IF m=60 m:=0 h:=info.values[]+1 IF h=13 h:=0 info.going:=FALSE DEC counting settext(info.gh,info.title,'Finished!') ENDIF l.values[]:=h ENDIF l.values[1]:=m l.redisplay() ENDIF ENDPROC -> Close function. PROC close(info:PTR TO mygui) -> Stop if running. IF info.going THEN stop(info) -> Destroy window. cleangui(info.gh) ENDPROC <-lh0-M"&Src\Tools\EasyGUI\Examples\led_test3.er-> This one shows the use of multi-window GUIs with PLUGINs, and multiple, -> real asynchronous activities (by creating tasks). MODULE 'tools/easygui', 'tools/exceptions', 'graphics/text', 'intuition/intuition', 'plugins/led', 'amigalib/tasks', 'amigalib/time', 'other/ecode', 'devices/timer', 'exec/tasks' -> Global for multiexists(). DEF gh:PTR TO guihandle CONST NUM_VALUES=2 -> Store all the GUI data in one place. OBJECT mygui -> In particular, keep PLUGIN references here. ledplug:PTR TO led gh:PTR TO guihandle gui title going values[NUM_VALUES]:ARRAY OF INT task ENDOBJECT -> The main loop: create one window to start with. PROC main() HANDLE DEF mh=NIL mh:=multiinit() create(mh) multiloop(mh) EXCEPT DO cleanmulti(mh) report_exception() ENDPROC -> Create a new GUI. PROC create(mh) HANDLE DEF t, g, gui=NIL:PTR TO mygui NEW gui -> Allocate all PLUGINs for the GUI like this. NEW gui.ledplug.led(NUM_VALUES,gui.values,TRUE) -> Now we can try opening a GUI. gui.gh:=addmultiA(mh,'BOOPSI in EasyGUI!', g:=NEW [ROWS, t:=NEW [TEXT,'LED Boopsi image tester...',NIL,TRUE,16], NEW [COLS, NEW [EQROWS, NEW [BUTTON,{runaction},'Run/Stop'], NEW [BUTTON,{spawn},'Spawn'], NEW [BUTTON,{quit},'Quit'] ], NEW [PLUGIN,0,gui.ledplug] ] ], [EG_INFO,gui, EG_LEFT,Rnd(400), EG_TOP,Rnd(400), -> The cleanup routine will deallocate the PLUGINs used. EG_CLEAN,{cleanmygui}, EG_CLOSE,{close}, NIL]) gui.gui:=g gui.title:=t EXCEPT -> If there was any problem then it may have been the creation of PLUGINs -> or addmultiA(). Luckily, addmultiA() (and guiinitA()) will *not* call -> the EG_CLEAN function if they caused the problem, so we can (safely). cleanmygui(gui) ReThrow() ENDPROC PROC quit(info) IS quitgui(0) -> The custom clean up code for each GUI. PROC cleanmygui(gui:PTR TO mygui) IF gui -> Stop and destroy task, if necessary. stop(gui) disposegui(gui.gui) END gui.ledplug END gui ENDIF ENDPROC -> The action function creates a new GUI in the group. PROC spawn(info:PTR TO mygui) IS create(info.gh.mh) -> The run/stop action. PROC runaction(info:PTR TO mygui) IF info.going settext(info.gh,info.title,'You stopped me!') stop(info) ELSE settext(info.gh,info.title,'Started counting...') Delay(10) settext(info.gh,info.title,'Counting...') run(info) ENDIF ENDPROC PROC stop(info:PTR TO mygui) -> Going, so stop. info.going:=FALSE -> Temporarily make it high priority to die quicker. Forbid() IF info.task THEN SetTaskPri(info.task,5) Permit() -> Wait for task to die. WHILE info.task DO Delay(1) ENDPROC PROC run(info:PTR TO mygui) DEF taskcode IF info.task=NIL IF taskcode:=eCodeTask({taskloop}) -> Make new Counter task, low priority. info.task:=createTask('Counter',-5,taskcode,1000,info) ENDIF ENDIF ENDPROC -> The loop the task will execute. PROC taskloop() DEF task:PTR TO tc, info:PTR TO mygui, error=FALSE task:=FindTask(NIL) info:=task.userdata info.going:=TRUE -> While there is something to do. WHILE next(info) -> Cannot Delay() since this code is run by a Task (not a Process). -> (200000 is a fifth of a second, or 10 ticks) EXIT error:=timeDelay(UNIT_MICROHZ,0,200000) ENDWHILE -> Kill ourself safely. Forbid() -> This GUI update is safe, since within Forbid()/Permit(). IF error THEN settext(info.gh,info.title,'Timer error!') info.task:=NIL deleteTask(task) Permit() ENDPROC -> Next count. PROC next(info:PTR TO mygui) DEF l:PTR TO led,h,m IF info.going l:=info.ledplug l.colon:=(l.colon=FALSE) m:=info.values[1]+1 IF m=60 m:=0 h:=info.values[]+1 IF h=13 h:=0 info.going:=FALSE -> Must Forbid()/Permit() since we're a different task to the GUI. Forbid() settext(info.gh,info.title,'Finished!') Permit() RETURN FALSE ENDIF l.values[]:=h ENDIF l.values[1]:=m -> Must Forbid()/Permit() since we're a different task to the GUI. Forbid() l.redisplay() Permit() RETURN TRUE ENDIF ENDPROC FALSE -> Close function. PROC close(info:PTR TO mygui) IS cleangui(info.gh) <-lh0-* * VM"&Src\Tools\EasyGUI\Examples\led_test4.e--> This one shows the use of multi-window GUIs with PLUGINs. A ticker is -> used, so the counting stops when none of the windows in the group is -> active! MODULE 'tools/easygui', 'tools/exceptions', 'graphics/text', 'intuition/intuition', 'plugins/led', 'plugins/ticker' -> Global for multiforall(). DEF gh:PTR TO guihandle CONST NUM_VALUES=2 -> Store all the GUI data in one place. OBJECT mygui -> In particular, keep PLUGIN references here. ledplug:PTR TO led ticker:PTR TO ticker gh:PTR TO guihandle gui title going values[NUM_VALUES]:ARRAY OF INT ENDOBJECT -> The main loop: create one window to start with. PROC main() HANDLE DEF mh=NIL mh:=multiinit() create(mh) multiloop(mh) EXCEPT DO cleanmulti(mh) report_exception() ENDPROC -> Create a new GUI. PROC create(mh) HANDLE DEF t, g, gui=NIL:PTR TO mygui NEW gui -> Allocate all PLUGINs for the GUI like this. NEW gui.ledplug.led(NUM_VALUES,gui.values,TRUE) NEW gui.ticker -> Now we can try opening a GUI. gui.gh:=addmultiA(mh,'BOOPSI in EasyGUI!', g:=NEW [ROWS, t:=NEW [TEXT,'LED Boopsi image tester...',NIL,TRUE,16], NEW [PLUGIN,{tick},gui.ticker], NEW [COLS, NEW [EQROWS, NEW [BUTTON,{runaction},'Run/Stop'], NEW [BUTTON,{spawn},'Spawn'], NEW [BUTTON,0,'Quit'] ], NEW [PLUGIN,0,gui.ledplug] ] ], [EG_INFO,gui, EG_LEFT,Rnd(400), EG_TOP,Rnd(400), -> The cleanup routine will deallocate the PLUGINs used. EG_CLEAN,{cleanmygui}, EG_CLOSE,{close}, NIL]) gui.gui:=g gui.title:=t EXCEPT -> If there was any problem then it may have been the creation of PLUGINs -> or addmultiA(). Luckily, addmultiA() (and guiinitA()) will *not* call -> the EG_CLEAN function if they caused the problem, so we can (safely). cleanmygui(gui) ReThrow() ENDPROC -> The custom clean up code for each GUI. PROC cleanmygui(gui:PTR TO mygui) IF gui disposegui(gui.gui) END gui.ticker END gui.ledplug END gui ENDIF ENDPROC -> The action function creates a new GUI in the group. PROC spawn(info:PTR TO mygui) IS create(info.gh.mh) -> The run/stop action. PROC runaction(info:PTR TO mygui) IF info.going -> Going, so stop. info.going:=FALSE settext(info.gh,info.title,'You stopped me!') ELSE -> Stopped, so go. info.going:=TRUE settext(info.gh,info.title,'Started counting...') Delay(10) settext(info.gh,info.title,'Counting...') ENDIF ENDPROC -> Tick! PROC tick(info:PTR TO mygui,t) -> Go to next count for all open windows. multiforall({gh},info.gh.mh,`IF gh.wnd THEN next(gh.info) ELSE 0) ENDPROC -> Next count. PROC next(info:PTR TO mygui) DEF l:PTR TO led,h,m IF info.going l:=info.ledplug l.colon:=(l.colon=FALSE) m:=info.values[1]+1 IF m=60 m:=0 h:=info.values[]+1 IF h=13 h:=0 info.going:=FALSE settext(info.gh,info.title,'Finished!') ENDIF l.values[]:=h ENDIF l.values[1]:=m l.redisplay() ENDIF ENDPROC -> Close function. PROC close(info:PTR TO mygui) IS cleangui(info.gh) @,-lh0-^^NJ"*Src\Tools\EasyGUI\Examples\password_test.e+MODULE 'tools/exceptions', 'tools/easygui', 'plugins/password' DEF default PROC main() HANDLE DEF p=NIL:PTR TO password, s[20]:STRING default:='My Password!' StrCopy(s,default) NEW p.password(s,'Password:',TRUE,10) easyguiA('GadTools in EasyGUI!', [ROWS, [TEXT,'Password test...',NIL,TRUE,1], [PLUGIN,{passaction},p,TRUE], [COLS, [BUTTON,{show},'Show',p], [BUTTON,{reset},'Reset',p], [BUTTON,{toggle_enabled},'Toggle Enabled',p] ] ]) EXCEPT DO END p report_exception() ENDPROC PROC passaction(i,p:PTR TO password) PrintF('Action: "\s"\n',p.estr) ENDPROC PROC show(p:PTR TO password,i) PrintF('Show: "\s"\n', p.estr) ENDPROC PROC reset(p:PTR TO password,i) p.setpass(default) ENDPROC PROC toggle_enabled(p:PTR TO password,i) p.setdisabled(p.disabled=FALSE) ENDPROC <-lh0-++UJ"&Src\Tools\EasyGUI\Examples\tabs_test.eX\MODULE 'tools/easygui', 'tools/exceptions', 'gadgets/tabs', 'plugins/tabs' PROC main() HANDLE DEF t=NIL:PTR TO tabs NEW t.tabs(['Display', -1,-1,-1,-1, NIL, 'Edit', -1,-1,-1,-1, NIL, 'File', -1,-1,-1,-1, NIL, NIL]:tablabel, 0,FALSE) easyguiA('BOOPSI in EasyGUI!', [ROWS, [TEXT,'Tabs test...',NIL,TRUE,5], [PLUGIN,{tabsaction},t], [EQCOLS, [BUTTON,{reset},'Reset',t], [BUTTON,{toggle_enabled},'Toggle Enabled',t] ] ]) EXCEPT DO END t report_exception() ENDPROC PROC tabsaction(i,t:PTR TO tabs) WriteF('tabs value = \d\n',t.current) ENDPROC PROC reset(t:PTR TO tabs,i) t.setcurrent(0) ENDPROC PROC toggle_enabled(t:PTR TO tabs,i) t.setdisabled(t.disabled=FALSE) ENDPROC =-lh0-J"'Src\Tools\EasyGUI\Examples\tabs_test2.evMODULE 'tools/easygui', 'tools/exceptions', 'gadgets/tabs', 'plugins/tabs' DEF labels:PTR TO tablabel, gui:PTR TO LONG PROC main() DEF top, t=NIL:PTR TO tabs labels:=['Slide', -1,-1,-1,-1, NIL, 'Check', -1,-1,-1,-1, NIL, 'Palette', -1,-1,-1,-1, NIL, NIL]:tablabel NEW t.tabs(labels) top:=[PLUGIN,{tabsaction},t] gui:=[ [ROWS,top,[SPACE],[SLIDE,{ignore},'Colors:',FALSE,1,8,3,5,'']], [ROWS,top,[SPACE],[CHECK,{ignore},'Ignore case',TRUE,FALSE]], [ROWS,top,[SPACE],[PALETTE,{ignore},'Palette:',3,5,2,0]] ] easyguiA('Tabs Test 2', gui[]) ENDPROC PROC ignore(i,x) IS EMPTY PROC tabsaction(gh,t:PTR TO tabs) changegui(gh,gui[t.current]) changetitle(gh,labels[t.current].label) ENDPROC @-lh0-jJ"*Src\Tools\EasyGUI\Examples\tapedeck_test.eMODULE 'tools/easygui', 'tools/exceptions', 'plugins/tapedeck' PROC main() HANDLE DEF t=NIL:PTR TO tapedeck NEW t.tapedeck() easyguiA('BOOPSI in EasyGUI!', [ROWS, [TEXT,'Tapedeck test...',NIL,TRUE,1], [PLUGIN,{tapedeckaction},t], [EQCOLS, [BUTTON,{reset},'Reset',t], [BUTTON,{toggle_enabled},'Toggle Enabled',t] ] ]) EXCEPT DO END t report_exception() ENDPROC PROC tapedeckaction(i,t:PTR TO tapedeck) PrintF('Action: mode=\d\s\n', t.mode, IF t.paused THEN ' (paused)' ELSE '') ENDPROC PROC reset(t:PTR TO tapedeck,i) t.setmode() t.setpaused(FALSE) ENDPROC PROC toggle_enabled(t:PTR TO tapedeck,i) t.setdisabled(t.disabled=FALSE) ENDPROC 9k-lh0-LLВ"#Src\Tools\EasyGUI\Examples\testaw.e-> testaw.e - shows use of AppWindow handling and changing GUIs MODULE 'tools/easygui', 'workbench/startup', 'workbench/workbench' CONST MAXLEN=20 DEF current=0, gui:PTR TO LONG PROC main() DEF s[MAXLEN]:STRING -> Have a list of three different GUIs gui:=[ [LISTV,{ignore},'Drop Icons on Me!',15,7,NIL,0,1,0,0,0,{gadappw}], [ROWS,[STR,{ignore},'Drop Icons on Me:',s,MAXLEN,5,0,0,0,{gadappw}], [SPACEV],[BUTTON,{ignore},'But Not on Me']], [ROWS,[BUTTON,{ignore},'Drop Icons on Me:',0,0,{gadappw}], [SPACEV],[STR,{ignore},'Not on Me:',s,MAXLEN,5]] ] easyguiA('Test App Window', gui[current], [EG_AWPROC,{winappw}, NIL]) ENDPROC -> Ignore button presses etc. PROC ignore(info,num) IS EMPTY -> Show next GUI in list PROC nextgui(gh) current++ IF current>=ListLen(gui) THEN current:=0 changegui(gh, gui[current]) ENDPROC -> Default (window) App message handler PROC winappw(info,awmsg) PrintF('You missed the gadget... try again!\n') ENDPROC -> App message handler for a gadget PROC gadappw(info,awmsg) PrintF('You hit the gadget! ') showappmsg(awmsg) nextgui(info) ENDPROC CONST NAMELEN=256 -> Show the contents of the App message PROC showappmsg(amsg:PTR TO appmessage) DEF i, args:PTR TO wbarg, name[NAMELEN]:ARRAY PrintF('Hit at (\d,\d)\n', amsg.mousex, amsg.mousey) args:=amsg.arglist FOR i:=1 TO amsg.numargs NameFromLock(args.lock,name,NAMELEN) PrintF(' arg(\d): Name="\s", Lock=$\h ("\s")\n', i, args.name, args.lock, name) args++ ENDFOR PrintF('\n') ENDPROC =-lh0-hhiTK"'Src\Tools\EasyGUI\Examples\testchange.eX-> testchange.e - show use of changegui() and BUTTON data field MODULE 'tools/easygui' DEF gui:PTR TO LONG, titles:PTR TO LONG PROC main() DEF top top:=[COLS, [SPACEH], -> Use generic action function, with BUTTON data 0, 1 or 2. [BUTTON,{change},'GUI _A',0,"a"], [SPACEH], [BUTTON,{change},'GUI _B',1,"b"], [SPACEH], [BUTTON,{change},'GUI _C',2,"c"], [SPACEH] ] titles:=['GUI A','GUI B','GUI C'] gui:=[ [ROWS,top,[SPACE],[SLIDE,{ignore},'Colors:',FALSE,1,8,3,5,'']], [ROWS,top,[SPACE],[CHECK,{ignore},'Ignore case',TRUE,FALSE]], [ROWS,top,[SPACE],[PALETTE,{ignore},'Palette:',3,5,2,0]] ] easyguiA('Change Test', gui[]) ENDPROC PROC ignore(info,x) IS EMPTY PROC change(index,gh) changegui(gh,gui[index]) changetitle(gh,titles[index]) ENDPROC >A-lh0-ssuL"(Src\Tools\EasyGUI\Examples\testchange2.e-> testchange2.e - shows use of some changeXXX() functions MODULE 'tools/exceptions', 'exec/lists', 'exec/nodes', 'graphics/text', 'graphics/view', 'libraries/gadtools', 'amigalib/lists', 'tools/easygui' RAISE "SCRN" IF OpenS()=NIL -> Index of the sub-GUI in the main GUI list. CONST SUB_POS=3 -> The custom screen. DEF scr=NIL -> The main GUI, the list of sub-GUIs, the titles and the menus. DEF gui:PTR TO LONG, subguis:PTR TO LONG, titles:PTR TO LONG, menus -> The connected window, the main window, a gh for multiforall() and a tmp. DEF ghconn=NIL, ghmain, forall, tmp -> The slider in the connected and main windows, and the check in main. DEF connsl=NIL, mainsl=NIL:PTR TO LONG, mainchk=NIL PROC main() HANDLE DEF mh=NIL -> The list of GUIs we'll use (and change) as sub-GUIs in the main GUI. subguis:=[ [COLS, [TEXT,'Try the menus!',NIL,TRUE,1], [SLIDE,{ignore},'Colors:',FALSE,1,8,3,5,''] ], [COLS, [SLIDE,{ignore},'Colors:',FALSE,1,8,3,5,''], [CHECK,{ignore},'Ignore case',TRUE,FALSE] ], [COLS, [CHECK,{ignore},'Ignore case',TRUE,TRUE], [PALETTE,{ignore},'Palette:',3,5,2,0] ] ] -> The main GUI. gui:=[ROWS, [COLS, [SPACEH], -> Use generic action function, with BUTTON data 0, 1 or 2. [BUTTON,{change_gui},'GUI _X',0,"x"], [SPACEH], [BUTTON,{change_gui},'GUI _Y',1,"y"], [SPACEH], [BUTTON,{change_gui},'GUI _Z',2,"z"], [SPACEH] ], [SPACE], 0, -> The sub-GUI, initialise this below... [SPACE], [COLS, [SBUTTON,{block_all},'_Block All',0,"b"], [SBUTTON,{close_all},'_Close All',0,"c"] ], [BAR], mainchk:=[CHECK,{connected_win},'Create/Destroy Connected Window', FALSE,FALSE], mainsl:=[SLIDE,{main_sl_fun},'Connected: ',FALSE,1,20,3,5,'\d[2]'] ] -> Initially, use the first sub-GUI. gui[SUB_POS]:=subguis[] titles:=['GUI X','GUI Y','GUI Z'] -> We're going to share the menus between our two windows. menus:=[NM_TITLE,0,'Project', NIL,0,0,0, NM_ITEM,0,'Quit', 'Q',0,0,0, NM_TITLE,0,'Screen', NIL,0,0,0, NM_ITEM,0,'Default', 'D',0,0,{default}, NM_ITEM,0,'Custom', 'C',0,0,{custom}, NM_TITLE,0,'Window Type', NIL,0,0,0, NM_ITEM,0,'No Border', 'N',0,0,{noborder}, NM_ITEM,0,'Basic', 'B',0,0,{basic}, NM_ITEM,0,'No Size', 'O',0,0,{nosize}, NM_ITEM,0,'Size', 'S',0,0,{size}, NM_TITLE,0,'GUI', NIL,0,0,0, NM_ITEM,0,'X', 'X',0,0,{x}, NM_ITEM,0,'Y', 'Y',0,0,{y}, NM_ITEM,0,'Z', 'Z',0,0,{z}, NM_TITLE,0,'Font', NIL,0,0,0, NM_ITEM,0,'Screen', 'F',0,0,{font}, NM_ITEM,0,'Topaz', 'T',0,0,{topaz}, NM_END, 0,NIL, NIL,0,0,0]:newmenu -> Start a multi-window group. mh:=multiinit() -> Open the main GUI. ghmain:=addmultiA(mh, 'Check out the menus...', gui, [EG_MENU,menus, EG_CLOSE,{closemain}, NIL]) -> Process messages. multiloop(mh) EXCEPT DO cleanmulti(mh) -> If we opened the screen, close it. IF scr THEN CloseS(scr) report_exception() ENDPROC ->>> Main GUI/shared action functions <<<- -> Close all windows, prompt then reopen. PROC close_all(gh) HANDLE allclose(gh) easyguiA('New GUI', [ROWS, [TEXT,'Old GUIs closed',NIL,TRUE,15], [TEXT,'Close me to reopen!',NIL,TRUE,15] ]) EXCEPT DO allopen(gh) ReThrow() ENDPROC -> Block all windows, prompt then unblock. PROC block_all(gh:PTR TO guihandle) HANDLE multiforall({forall},gh.mh,`blockwin(forall)) easyguiA('New GUI', [ROWS, [TEXT,'Old GUIs blocked',NIL,TRUE,15], [TEXT,'Close me to unblock!',NIL,TRUE,15] ]) EXCEPT DO multiforall({forall},gh.mh,`unblockwin(forall)) ReThrow() ENDPROC -> Change the font to default (screen) or Topaz. PROC font(info) IS change_font(info,NIL) PROC topaz(info) IS change_font(info,['topaz.font',8,0,0]:textattr) -> Change to the default public screen. PROC default(gh:PTR TO guihandle) HANDLE allclose(gh) IF scr CloseS(scr) -> The screen is now invalid. scr:=NIL ENDIF multiforall({forall},gh.mh,`changescreen(forall,NIL)) EXCEPT DO allopen(gh) ReThrow() ENDPROC -> Change to a custom screen. PROC custom(gh:PTR TO guihandle) HANDLE allclose(gh) IF scr=NIL THEN scr:=OpenS(640,400,4,V_HIRES OR V_LACE,'Custom Screen') tmp:=scr multiforall({forall},gh.mh,`changescreen(forall,tmp)) EXCEPT DO allopen(gh) ReThrow() ENDPROC -> Change the window type. PROC noborder(info) IS change_type(info,WTYPE_NOBORDER) PROC basic(info) IS change_type(info,WTYPE_BASIC) PROC nosize(info) IS change_type(info,WTYPE_NOSIZE) PROC size(info) IS change_type(info,WTYPE_SIZE) -> Change the main GUI. PROC x(info) IS change_gui(0,ghmain) PROC y(info) IS change_gui(1,ghmain) PROC z(info) IS change_gui(2,ghmain) PROC change_gui(index,gh) changetitle(gh,titles[index]) gui[SUB_POS]:=subguis[index] changegui(gh,gui) ENDPROC PROC ignore(info,x) IS EMPTY ->>> Connection code <<<- -> Connected slider on main GUI. PROC main_sl_fun(info,cur) IF ghconn THEN setslide(ghconn,connsl,cur) ENDPROC -> Connected slider on the other GUI. PROC conn_sl_fun(info,cur) IF ghmain THEN setslide(ghmain,mainsl,cur) ENDPROC ->>> Closing code <<<- -> Closing the main GUI quits. PROC closemain(mh,gh) IS quitgui(0) -> Closing the other GUI destroys it. PROC closeconn(mh,info) cleangui(ghconn) -> The guihandle is now invalid. ghconn:=NIL -> Uncheck the check in the main GUI. IF mainchk THEN setcheck(ghmain,mainchk,FALSE) ENDPROC ->>> Other GUI functions <<<- -> React to check changes on main GUI. PROC connected_win(gh:PTR TO guihandle,bool) IF bool -> If it's been created reopen it, else create and add it to the group. IF ghconn openwin(ghconn) ELSE ghconn:=addmultiA(gh.mh, 'Connected Window', [ROWS, connsl:=[SLIDE,{conn_sl_fun},'Connected: ',FALSE,1,20, IF mainsl THEN mainsl[SLI_CURR] ELSE 3,10,'\d[2]'], [COLS, [SBUTTON,{block_all},'_Block All',0,"b"], [SBUTTON,{close_all},'_Close All',0,"c"] ], [SBUTTON,{clean_gui},'cl_eangui()',0,"e"] ], [EG_TOP,0, EG_LEFT,0, EG_MENU,menus, EG_SCRN,scr, EG_CLOSE,{closeconn}, NIL]) ENDIF ELSEIF ghconn -> If it's been created, destroy it. cleangui(ghconn) -> The guihandle is now invalid. ghconn:=NIL ENDIF ENDPROC -> Action function for cleangui() button (reuse closeconn()). PROC clean_gui(info) IS closeconn(0,0) ->>> Auxiliary functions <<<- -> Close all GUIs (and update check on main GUI) PROC allclose(gh:PTR TO guihandle) multiforall({forall},gh.mh,`closewin(forall)) -> Make check false only if the other window exists IF ghconn THEN setcheck(ghmain,mainchk,FALSE) ENDPROC -> Open all GUIs (and update check on main GUI) PROC allopen(gh:PTR TO guihandle) multiforall({forall},gh.mh,`openwin(forall)) -> Make check true only if the other window exists IF ghconn THEN setcheck(ghmain,mainchk,TRUE) ENDPROC -> Change the window type. PROC change_type(gh:PTR TO guihandle,t) HANDLE allclose(gh) tmp:=t multiforall({forall},gh.mh,`changewintype(forall,tmp)) EXCEPT DO allopen(gh) ReThrow() ENDPROC -> Change the window font. PROC change_font(gh:PTR TO guihandle,tattr) HANDLE allclose(gh) tmp:=tattr multiforall({forall},gh.mh,`changefont(forall,tmp)) EXCEPT DO allopen(gh) ReThrow() ENDPROC :-lh0- L"$Src\Tools\EasyGUI\Examples\testkey.e-> testkey.e - shows use of keyboard short-cuts MODULE 'tools/easygui', 'exec/lists', 'exec/nodes', 'graphics/text', 'amigalib/lists' CONST MAXLEN=20 DEF gad, disabled=TRUE PROC main() DEF s[MAXLEN]:STRING, list:lh, choices newList(list) AddTail(list, [0,0,0,0,'Item']:ln) AddTail(list, [0,0,0,0,'Item-2']:ln) AddTail(list, [0,0,0,0,'Item-3']:ln) AddTail(list, [0,0,0,0,'Item-4']:ln) AddTail(list, [0,0,0,0,'Item-5']:ln) AddTail(list, [0,0,0,0,'Item-6']:ln) choices:=['Zero','One','Two',NIL] StrCopy(s,'Hello') easyguiA('Press Some Keys!', [COLS, [EQROWS, [CYCLE,{cycle},'_Cycle:',choices,1,0,"c"], [STR,{password},'S_tring:',s,MAXLEN,5,FALSE,0,"t"], [BAR], -> Show new CHECK and MX alignments [CHECK,{check},'C_heck:',TRUE,TRUE,0,"h"], [MX,{mx},'_MX:',choices,TRUE,0,0,"m"], [BAR], -> Show new CHECK and MX right text [CHECK,{check2},'Ch_eck2 (Right)',TRUE,FALSE,0,"e"], [MX,{mx2},'M_X2 (Right)',choices,FALSE,0,0,"x"] ], [BAR], [ROWS, -> Show new LISTV label and show selected [LISTV,{listv},'_List:',8,5,list,FALSE,1,0,0,"l",0], [SLIDE,{slide},'_Slide:',FALSE,1,8,3,3,'',0,"s"], -> [SCROLL,{slide},FALSE,80,10,3,3,0,"i"], -> Show new PALETTE current field, min size and show selected [PALETTE,{palette},'_Palette:',3,5,2,2,0,"p"], gad:=[SBUTTON,{button},'_blockwin()',0,"b",0,disabled], [SBUTTON,{disable},'_disable()',0,"d"] ] ]) ENDPROC PROC button(gh) HANDLE blockwin(gh) easyguiA('New GUI', [ROWS, [TEXT,'Old GUI blocked',NIL,TRUE,15], [BUTTON,0,'_Unblock',0,"u"] ]) EXCEPT DO unblockwin(gh) ReThrow() ENDPROC PROC disable(gh) disabled:=disabled=FALSE setdisabled(gh,gad,disabled) ENDPROC PROC slide(info,val) IS PrintF('Slide has moved to \d\n', val) PROC cycle(info,val) IS PrintF('Cycle choice is now \d\n', val) PROC check(info,val) IS PrintF('Check is now \s\n', IF val THEN 'TRUE' ELSE 'FALSE') PROC check2(info,val) IS PrintF('Check2 is now \s\n', IF val THEN 'TRUE' ELSE 'FALSE') PROC mx(info,val) IS PrintF('MX choice is now \d\n', val) PROC mx2(info,val) IS PrintF('MX2 choice is now \d\n', val) PROC password(info,val) IS PrintF('Password is now "\s"\n', val) PROC palette(info,val) IS PrintF('Palette pen is now \d\n', val) PROC listv(info,val) IS PrintF('List selection moved to \d\n', val) <-lh0-ooM"&Src\Tools\EasyGUI\Examples\testmulti.e-> testmulti.e - Simple (recursive) use of multi-window GUI support. -> (Note: Intuition gets a bit weird with lots of windows -- lockups or -> crashes with huge numbers of windows are not EasyGUI's fault...) MODULE 'tools/easygui', 'tools/exceptions' RAISE "MEM" IF String()=NIL DEF guis=1 PROC main() HANDLE DEF mh=NIL mh:=multiinit() -> Start at level 0. create(mh,0) multiloop(mh) EXCEPT DO cleanmulti(mh) report_exception() ENDPROC -> Add a new window to the group mh at level i. PROC add(level,gh:PTR TO guihandle) IS create(gh.mh,level) -> Add a new window to the group mh at level i. PROC create(mh,level) DEF s -> Next level. INC level s:=StringF(String(10),'GUI \d',guis) -> Got to NEW the gui since the same one is being used multiple times. addmultiA(mh, s, NEW [ROWS, NEW [TEXT,'Multi GUI Test',NIL,TRUE,10], NEW [COLS, NEW [NUM,level,'Level:',0,1], NEW [NUM,guis,'GUI:',0,1] ], NEW [COLS, -> Recursive call to create() via add()! NEW [BUTTON,{add},'_Add',level,"a"], NEW [SPACE], -> Pressing the Quit button quits multiloop() and so -> then all windows are closed. NEW [BUTTON,0,'_Quit',0,"q"] ] ], -> Open at a random position, with level as info. [EG_LEFT,Rnd(400), EG_TOP,Rnd(400), EG_CLOSE,{close}, NIL]) -> Now another GUI. INC guis ENDPROC -> This function is called when the GUI close gadget is hit. -> (Hitting the close gadget closes only that window, unless it is the last.) PROC close(mh:PTR TO multihandle,info) WriteF('GUIs left with open windows = \d\n',mh.opencount) -> Is this the last open window? IF mh.opencount=1 THEN quitgui(0) ELSE closewin(info) ENDPROC =-lh0-V"'Src\Tools\EasyGUI\Examples\testmulti2.e -> testmulti2.e - Another very simple use of multi-window GUI support. MODULE 'tools/easygui', 'tools/exceptions', 'intuition/intuition' -> The global for use with multiforall(). DEF gh:PTR TO guihandle PROC main() HANDLE DEF mh=NIL, gh1:PTR TO guihandle,res mh:=multiinit() gh1:=addmultiA(mh,'GUI One', [ROWS, [TEXT,'The first GUI.',NIL,TRUE,13], [SBUTTON,{but1},'Press Me'] ], [EG_LEFT,10, EG_TOP,20, NIL]) addmultiA(mh,'GUI Two', [ROWS, [TEXT,'And the second GUI.',NIL,TRUE,13], [SBUTTON,{but2},'Press Me'] ], -> Put the second window below the first, but hidden. [EG_LEFT,10, EG_TOP,gh1.wnd.topedge+gh1.wnd.height, EG_HIDE,TRUE, NIL]) -> Could add more... res:=multiloop(mh) EXCEPT DO cleanmulti(mh) report_exception() ENDPROC -> Button on GUI one does something special. PROC but1(info:PTR TO guihandle) WriteF('Hit button on GUI One. Closing then opening.\n') multiforall({gh},info.mh, `IF gh.wnd THEN WriteF('Title="\s"\n',gh.wnd.title) BUT closewin(gh) ELSE 0) WriteF('Sleeping a bit...\n') Delay(100) WriteF('Awake!\n') -> This shows that gh.wnd is NIL when the window is closed. multiforall({gh},info.mh, `WriteF('Win=$\h\n',gh.wnd) BUT openwin(gh)) ENDPROC PROC but2(i) IS WriteF('Hit button on GUI Two\n') ;-lh0-\M"%Src\Tools\EasyGUI\Examples\testqual.e?MODULE 'tools/easygui', 'devices/inputevent' PROC main() easyguiA('Qualifier Test', [SBUTTON,{buttonaction},'Press Me! (With/Without Shift)']) ENDPROC PROC buttonaction(qual,data,info) IF qual AND (IEQUALIFIER_LSHIFT OR IEQUALIFIER_RSHIFT) PrintF('You were pressing a shift key when you clicked on me!\n') ELSE PrintF('Nope, no shift key this time...\n') ENDIF ENDPROC >U-lh0-JJUM"(Src\Tools\EasyGUI\Examples\ticker_test.enMODULE 'tools/easygui', 'tools/exceptions', 'plugins/ticker' PROC main() HANDLE DEF t=NIL:PTR TO ticker NEW t easyguiA('Ticker!', [ROWS, [TEXT,'Ticker test:',NIL,TRUE,10], [PLUGIN,{tickaction},t] ]) EXCEPT DO END t report_exception() ENDPROC PROC tickaction(i,t) WriteF('Tick!\n') ENDPROC ?-lh0-(G#)Src\Tools\EasyGUI\Examples\toolify_test.eMODULE 'tools/exceptions', 'tools/easygui', 'plugins/toolify' PROC main() HANDLE DEF p=NIL:PTR TO toolify NEW p.toolify('Toolify','Hello from Toolify',TRUE) easyguiA('GadTools in EasyGUI!', [ROWS, [TEXT,'Toolify test...',NIL,TRUE,1], [SPACE], [PLUGIN,0,p,TRUE], [SPACE], [BUTTON,{toggle_enabled},'Toggle Enabled',p] ]) EXCEPT DO END p report_exception() ENDPROC PROC toggle_enabled(p:PTR TO toolify,i) p.setdisabled(p.disabled=FALSE) ENDPROC =(-lh0-" " ȐB"'Src\Tools\EasyGUI\Plugins\animcontrol.eljOPT MODULE, PREPROCESS MODULE 'tools/EasyGUI', 'tools/ghost', 'intuition/intuition', 'intuition/gadgetclass', 'gadgets/tapedeck' EXPORT OBJECT animcontrol OF plugin frame mode disabled PRIVATE animcontrol:PTR TO gadget animcontrolbase frames downmode ENDOBJECT PROC animcontrol(frame=0,frames=8,play=FALSE,disabled=FALSE) OF animcontrol self.animcontrolbase:=OpenLibrary('gadgets/tapedeck.gadget',39) IF self.animcontrolbase=NIL THEN Raise("anim") self.frame:=frame self.frames:=frames self.mode:=IF play THEN BUT_PLAY ELSE BUT_STOP self.disabled:=disabled ENDPROC PROC end() OF animcontrol IF self.animcontrolbase THEN CloseLibrary(self.animcontrolbase) ENDPROC PROC min_size(ta,fh) OF animcontrol ENDPROC 203,15 PROC will_resize() OF animcontrol IS 0 PROC render(ta,x,y,xs,ys,w) OF animcontrol self.animcontrol:=NewObjectA(NIL,'tapedeck.gadget', [GA_TOP,y, GA_LEFT,x, GA_WIDTH,xs, GA_HEIGHT,ys, TDECK_MODE,self.mode, TDECK_FRAMES,self.frames, TDECK_CURRENTFRAME,self.frame, TDECK_TAPE,FALSE, GA_DISABLED,self.disabled, GA_RELVERIFY,TRUE, GA_IMMEDIATE,TRUE, NIL]) IF self.animcontrol=NIL THEN Raise("anim") AddGList(w,self.animcontrol,-1,1,NIL) RefreshGList(self.animcontrol,w,NIL,1) IF self.disabled THEN ghost(w,self.x,self.y,self.xs,self.ys) ENDPROC PROC clear_render(win:PTR TO window) OF animcontrol IF self.animcontrol RemoveGList(win,self.animcontrol,1) DisposeObject(self.animcontrol) ENDIF ENDPROC PROC message_test(imsg:PTR TO intuimessage,win:PTR TO window) OF animcontrol IF imsg.class=IDCMP_GADGETUP THEN RETURN imsg.iaddress=self.animcontrol IF imsg.class=IDCMP_GADGETDOWN THEN RETURN imsg.iaddress=self.animcontrol ENDPROC FALSE PROC message_action(class,qual,code,win:PTR TO window) OF animcontrol DEF mode, frame GetAttr(TDECK_MODE,self.animcontrol,{mode}) GetAttr(TDECK_CURRENTFRAME,self.animcontrol,{frame}) IF class=IDCMP_GADGETDOWN self.downmode:=mode IF mode=BUT_FRAME THEN mode:=BUT_STOP self.mode:=mode IF (mode<>BUT_REWIND) AND (mode<>BUT_FORWARD) THEN RETURN FALSE ELSE IF self.downmode=BUT_FRAME mode:=BUT_STOP self.downmode:=BUT_STOP ENDIF self.mode:=mode ENDIF self.frame:=frame ENDPROC TRUE PROC setframe(n) OF animcontrol self.frame:=n SetGadgetAttrsA(self.animcontrol,self.gh.wnd,NIL,[TDECK_CURRENTFRAME,n,NIL]) IF self.disabled THEN ghost(self.gh.wnd,self.x,self.y,self.xs,self.ys) ENDPROC PROC setplay(play=TRUE) OF animcontrol self.mode:=IF play THEN BUT_PLAY ELSE BUT_STOP SetGadgetAttrsA(self.animcontrol,self.gh.wnd,NIL,[TDECK_MODE,self.mode,NIL]) IF self.disabled THEN ghost(self.gh.wnd,self.x,self.y,self.xs,self.ys) ENDPROC PROC setdisabled(disabled=TRUE) OF animcontrol SetGadgetAttrsA(self.animcontrol,self.gh.wnd,NIL,[GA_DISABLED,disabled,NIL]) IF disabled ghost(self.gh.wnd,self.x,self.y,self.xs,self.ys) ELSE unghost(self.animcontrol,self.gh.wnd) ENDIF self.disabled:=disabled ENDPROC 8-lh0-W W ڐB""Src\Tools\EasyGUI\Plugins\button.eOPT MODULE MODULE 'tools/EasyGUI', 'tools/textlen', 'intuition/intuition', 'intuition/gadgetclass', 'gadgets/button' EXPORT OBJECT button OF plugin selected disabled PRIVATE button:PTR TO gadget buttonbase text toggle, push, resize ENDOBJECT PROC button(text,resizex=FALSE,resizey=FALSE,disabled=FALSE) OF button self.buttonbase:=OpenLibrary('gadgets/button.gadget',37) IF self.buttonbase=NIL THEN Raise("butt") self.text:=text self.toggle:=FALSE self.push:=FALSE self.selected:=FALSE self.resize:=(IF resizex THEN RESIZEX ELSE 0) OR (IF resizey THEN RESIZEY ELSE 0) self.disabled:=disabled ENDPROC PROC togglebutton(text,selected=FALSE,resizex=FALSE,resizey=FALSE,disabled=FALSE) OF button self.button(text,resizex,resizey) self.toggle:=TRUE self.selected:=selected ENDPROC PROC pushbutton(text,selected=FALSE,resizex=FALSE,resizey=FALSE,disabled=FALSE) OF button self.button(text,resizex,resizey) self.push:=TRUE self.selected:=selected ENDPROC PROC end() OF button IF self.buttonbase THEN CloseLibrary(self.buttonbase) ENDPROC PROC min_size(ta,fh) OF button ENDPROC textlen(self.text,ta)+16,fh+6 PROC will_resize() OF button IS self.resize PROC render(ta,x,y,xs,ys,w) OF button self.button:=NewObjectA(NIL,'button.gadget', [GA_TOP,y, GA_LEFT,x, GA_WIDTH,xs, GA_HEIGHT,ys, GA_TEXT,self.text, GA_TOGGLESELECT,self.toggle, BUTTON_PUSHBUTTON,self.push, GA_TEXTATTR,ta, GA_DISABLED,self.disabled, GA_SELECTED,self.selected, GA_RELVERIFY,TRUE, NIL]) IF self.button=NIL THEN Raise("butt") AddGList(w,self.button,-1,1,NIL) RefreshGList(self.button,w,NIL,1) ENDPROC PROC clear_render(win:PTR TO window) OF button IF self.button RemoveGList(win,self.button,1) DisposeObject(self.button) ENDIF ENDPROC PROC message_test(imsg:PTR TO intuimessage,win:PTR TO window) OF button IF imsg.class=IDCMP_GADGETUP THEN RETURN imsg.iaddress=self.button ENDPROC FALSE PROC message_action(class,qual,code,win:PTR TO window) OF button self.selected:=code ENDPROC TRUE PROC setselected(selected=TRUE) OF button IF self.toggle OR self.push SetGadgetAttrsA(self.button,self.gh.wnd,NIL,[GA_SELECTED,selected,NIL]) self.selected:=selected ENDIF ENDPROC PROC settext(text) OF button SetGadgetAttrsA(self.button,self.gh.wnd,NIL,[GA_TEXT,text,NIL]) self.text:=text ENDPROC PROC setdisabled(disabled=TRUE) OF button SetGadgetAttrsA(self.button,self.gh.wnd,NIL,[GA_DISABLED,disabled,NIL]) self.disabled:=disabled ENDPROC :l-lh0-  B"$Src\Tools\EasyGUI\Plugins\calendar.eOPT MODULE MODULE 'tools/EasyGUI', 'tools/textlen', 'intuition/intuition', 'intuition/gadgetclass', 'gadgets/calendar', 'graphics/text', 'utility/date' EXPORT OBJECT calendar OF plugin date:PTR TO clockdata disabled PRIVATE calendar:PTR TO gadget calendarbase resize ENDOBJECT PROC calendar(date,resizex=FALSE,resizey=FALSE,disabled=FALSE) OF calendar self.calendarbase:=OpenLibrary('gadgets/calendar.gadget',37) IF self.calendarbase=NIL THEN Raise("cal") self.date:=date self.resize:=(IF resizex THEN RESIZEX ELSE 0) OR (IF resizey THEN RESIZEY ELSE 0) self.disabled:=disabled ENDPROC PROC end() OF calendar IF self.calendarbase THEN CloseLibrary(self.calendarbase) ENDPROC PROC min_size(ta,fh) OF calendar IS textlen('Wed',ta)+2*7,fh*7+13 PROC will_resize() OF calendar IS self.resize PROC render(ta,x,y,xs,ys,w) OF calendar self.calendar:=NewObjectA(NIL,'calendar.gadget', [GA_TOP,y, GA_LEFT,x, GA_WIDTH,xs, GA_HEIGHT,ys, GA_TEXTATTR,ta, GA_RELVERIFY,TRUE, GA_DISABLED,self.disabled, CALENDAR_CLOCKDATA,self.date, NIL]) IF self.calendar=NIL THEN Raise("cal") AddGList(w,self.calendar,-1,1,NIL) RefreshGList(self.calendar,w,NIL,1) ENDPROC PROC clear_render(win:PTR TO window) OF calendar IF self.calendar RemoveGList(win,self.calendar,1) DisposeObject(self.calendar) ENDIF ENDPROC PROC message_test(imsg:PTR TO intuimessage,win:PTR TO window) OF calendar IF imsg.class=IDCMP_GADGETUP THEN RETURN imsg.iaddress=self.calendar ENDPROC FALSE PROC message_action(class,qual,code,win:PTR TO window) OF calendar self.date.mday:=code ENDPROC TRUE PROC setdate(date=NIL) OF calendar IF date THEN self.date:=date SetGadgetAttrsA(self.calendar,self.gh.wnd,NIL,[CALENDAR_CLOCKDATA,self.date,NIL]) ENDPROC PROC setdisabled(disabled=TRUE) OF calendar SetGadgetAttrsA(self.calendar,self.gh.wnd,NIL,[GA_DISABLED,disabled,NIL]) self.disabled:=disabled ENDPROC <-lh0- B"&Src\Tools\EasyGUI\Plugins\colorwheel.eOPT MODULE MODULE 'tools/EasyGUI', 'tools/ghost', 'intuition/intuition', 'intuition/gadgetclass', 'intuition/screens', 'gadgets/colorwheel' EXPORT OBJECT colorwheel OF plugin rgb:PTR TO colorwheelrgb hsb:PTR TO colorwheelhsb disabled PRIVATE colorwheel:PTR TO gadget colorwheelbase box ENDOBJECT PROC colorwheel(rgb,hsb=NIL,box=FALSE,disabled=FALSE) OF colorwheel self.colorwheelbase:=OpenLibrary('gadgets/colorwheel.gadget',39) IF self.colorwheelbase=NIL THEN Raise("colw") IF rgb self.rgb:=rgb self.hsb:=NIL ELSE self.rgb:=NIL self.hsb:=hsb ENDIF self.box:=box self.disabled:=disabled ENDPROC PROC end() OF colorwheel IF self.colorwheelbase THEN CloseLibrary(self.colorwheelbase) ENDPROC PROC min_size(ta,fh) OF colorwheel ENDPROC 50,50 PROC will_resize() OF colorwheel IS RESIZEX OR RESIZEY PROC render(ta,x,y,xs,ys,w:PTR TO window) OF colorwheel self.colorwheel:=NewObjectA(NIL,'colorwheel.gadget', [GA_TOP,y+IF self.box THEN 0 ELSE 2, GA_LEFT,x+IF self.box THEN 0 ELSE 2, GA_WIDTH,xs-IF self.box THEN 0 ELSE 4, GA_HEIGHT,ys-IF self.box THEN 0 ELSE 4, IF self.hsb THEN WHEEL_HSB ELSE WHEEL_RGB, IF self.hsb THEN self.hsb ELSE self.rgb, GA_RELVERIFY,TRUE, WHEEL_SCREEN,w.wscreen, WHEEL_BEVELBOX,self.box, GA_DISABLED,self.disabled, NIL]) IF self.colorwheel=NIL THEN Raise("colw") AddGList(w,self.colorwheel,-1,1,NIL) RefreshGList(self.colorwheel,w,NIL,1) IF self.disabled THEN IF self.box=FALSE THEN ghost(w,self.x,self.y,self.xs,self.ys) ENDPROC PROC clear_render(win:PTR TO window) OF colorwheel IF self.colorwheel RemoveGList(win,self.colorwheel,1) DisposeObject(self.colorwheel) ENDIF ENDPROC PROC message_test(imsg:PTR TO intuimessage,win:PTR TO window) OF colorwheel IF imsg.class=IDCMP_GADGETUP THEN RETURN imsg.iaddress=self.colorwheel ENDPROC FALSE PROC message_action(class,qual,code,win:PTR TO window) OF colorwheel IF self.rgb GetAttr(WHEEL_RGB,self.colorwheel,self.rgb) ELSE GetAttr(WHEEL_HSB,self.colorwheel,self.hsb) ENDIF ENDPROC TRUE PROC getrgb(rgb) OF colorwheel GetAttr(WHEEL_RGB,self.colorwheel,rgb) ENDPROC rgb PROC gethsb(hsb) OF colorwheel GetAttr(WHEEL_HSB,self.colorwheel,hsb) ENDPROC hsb PROC setrgb(rgb=NIL) OF colorwheel IF rgb self.rgb:=rgb self.hsb:=NIL ENDIF IF self.rgb THEN SetGadgetAttrsA(self.colorwheel,self.gh.wnd,NIL, [WHEEL_RGB,self.rgb,NIL]) ENDPROC PROC sethsb(hsb) OF colorwheel IF hsb self.rgb:=NIL self.hsb:=hsb ENDIF IF self.hsb THEN SetGadgetAttrsA(self.colorwheel,self.gh.wnd,NIL, [WHEEL_HSB,self.hsb,NIL]) ENDPROC PROC setdisabled(disabled=TRUE) OF colorwheel SetGadgetAttrsA(self.colorwheel,self.gh.wnd,NIL,[GA_DISABLED,disabled,NIL]) IF disabled IF self.box=FALSE ghost(self.gh.wnd,self.x,self.y,self.xs,self.ys) ELSE unghost(self.colorwheel,self.gh.wnd) ENDIF ELSE unghost_clear(self.colorwheel,self.gh.wnd,self.x,self.y,self.xs,self.ys) ENDIF self.disabled:=disabled ENDPROC :-lh0- B"$Src\Tools\EasyGUI\Plugins\gradient.e}OPT MODULE MODULE 'tools/EasyGUI', 'tools/ghost', 'intuition/gadgetclass', 'intuition/intuition', 'gadgets/gradientslider' EXPORT OBJECT gradient OF plugin curval pens:PTR TO INT disabled PRIVATE grad:PTR TO gadget gradbase vert rel ENDOBJECT PROC gradient(vert=FALSE,curval=0,rel=5,pens=NIL,disabled=FALSE) OF gradient self.gradbase:=OpenLibrary('gadgets/gradientslider.gadget',39) IF self.gradbase=NIL THEN Raise("grad") self.curval:=curval self.vert:=vert self.rel:=rel self.pens:=pens self.disabled:=disabled ENDPROC PROC end() OF gradient IF self.gradbase THEN CloseLibrary(self.gradbase) ENDPROC PROC min_size(ta,fh) OF gradient IS IF self.vert THEN (fh+6) ELSE (fh*self.rel), IF self.vert THEN (fh*self.rel) ELSE (fh+6) PROC will_resize() OF gradient IS IF self.vert THEN RESIZEY ELSE RESIZEX PROC render(ta,x,y,xs,ys,w) OF gradient self.grad:=NewObjectA(NIL,'gradientslider.gadget', [GA_TOP,y, GA_LEFT,x, GA_WIDTH,xs, GA_HEIGHT,ys, GRAD_CURVAL,self.curval, GRAD_PENARRAY,self.pens, PGA_FREEDOM,IF self.vert THEN LORIENT_VERT ELSE LORIENT_HORIZ, GA_RELVERIFY,TRUE, GA_DISABLED,self.disabled, NIL]) IF self.grad=NIL THEN Raise("grad") AddGList(w,self.grad,-1,1,NIL) RefreshGList(self.grad,w,NIL,1) IF self.disabled THEN ghost(w,self.x,self.y,self.xs,self.ys) ENDPROC PROC clear_render(win:PTR TO window) OF gradient IF self.grad RemoveGList(win,self.grad,1) DisposeObject(self.grad) ENDIF ENDPROC PROC message_test(imsg:PTR TO intuimessage,win:PTR TO window) OF gradient IF imsg.class=IDCMP_GADGETUP THEN RETURN imsg.iaddress=self.grad ENDPROC FALSE PROC message_action(class,qual,code,win:PTR TO window) OF gradient DEF val=0 GetAttr(GRAD_CURVAL,self.grad,{val}) self.curval:=val ENDPROC TRUE PROC setcurval(x) OF gradient self.curval:=x SetGadgetAttrsA(self.grad,self.gh.wnd,NIL,[GRAD_CURVAL,x,NIL]) ENDPROC PROC setpens(pens=NIL) OF gradient IF pens THEN self.pens:=pens self.clear_render(self.gh.wnd) self.render(NIL,self.x,self.y,self.xs,self.ys,self.gh.wnd) ENDPROC PROC setdisabled(disabled=TRUE) OF gradient SetGadgetAttrsA(self.grad,self.gh.wnd,NIL,[GA_DISABLED,disabled,NIL]) IF disabled ghost(self.gh.wnd,self.x,self.y,self.xs,self.ys) ELSE unghost(self.grad,self.gh.wnd) ENDIF self.disabled:=disabled ENDPROC 9-lh0-  3"#Src\Tools\EasyGUI\Plugins\iconify.e OPT MODULE, PREPROCESS MODULE 'intuition/intuition', 'intuition/gadgetclass', 'libraries/gadtools', 'tools/textlen', 'tools/EasyGUI', 'workbench/startup', 'workbench/workbench', 'gadtools', 'icon', 'wb' RAISE "icfy" IF AddAppIconA()=NIL, "icfy" IF OpenLibrary()=NIL, "icfy" IF CreateMsgPort()=NIL DEF iconbase -> Redefine for privateness -> Share gadtoolbase and workbenchbase with EasyGUI... #define DEFICON 'env:sys/def_tool' EXPORT OBJECT iconify OF plugin disabled PRIVATE iconify:PTR TO gadget iconopen label, icon, iconlabel resize ENDOBJECT PROC iconify(label,icon=NIL,iconlabel=NIL, resizex=FALSE,resizey=FALSE,disabled=FALSE) OF iconify iconbase:=OpenLibrary('icon.library',37) self.iconopen:=TRUE self.label:=IF label THEN label ELSE '' self.icon:=IF icon THEN icon ELSE DEFICON self.iconlabel:=IF iconlabel THEN iconlabel ELSE self.label self.disabled:=disabled self.resize:=(IF resizex THEN RESIZEX ELSE 0) OR (IF resizey THEN RESIZEY ELSE 0) ENDPROC PROC end() OF iconify IF self.iconopen CloseLibrary(iconbase) self.iconopen:=FALSE ENDIF ENDPROC PROC min_size(ta,fh) OF iconify IS textlen(self.label,ta)+16,fh+6 PROC will_resize() OF iconify IS self.resize -> Don't need to define this: ->PROC render(ta,x,y,xs,ys,w) OF iconify IS EMPTY PROC gtrender(gl,vis,ta,x,y,xs,ys,w) OF iconify -> Or, a gadget in the title bar would have also been nice... self.iconify:=CreateGadgetA(BUTTON_KIND,gl, [x,y,xs,ys,self.label,ta,0, PLACETEXT_IN,vis,NIL]:newgadget, [NIL]) IF self.iconify=NIL THEN Raise("icfy") ENDPROC self.iconify -> Don't need to define this: -> PROC clear_render(win:PTR TO window) OF iconify IS EMPTY PROC message_test(imsg:PTR TO intuimessage,win:PTR TO window) OF iconify IF imsg.class=IDCMP_GADGETUP THEN RETURN imsg.iaddress=self.iconify ENDPROC FALSE PROC message_action(class,qual,code,win:PTR TO window) OF iconify HANDLE DEF dobj=NIL:PTR TO diskobject, myport=NIL, appicon=NIL, appmsg:PTR TO appmessage closewin(self.gh) -> Fallback to using a default icon if not found... IF NIL=(dobj:=GetDiskObjectNew(self.icon)) THEN dobj:=GetDiskObjectNew(DEFICON) dobj.type:=NIL myport:=CreateMsgPort() appicon:=AddAppIconA(0,0,self.iconlabel,myport,NIL,dobj,NIL) WaitPort(myport) EXCEPT DO IF appicon THEN RemoveAppIcon(appicon) IF myport -> Clear away any messages that arrived at the last moment WHILE appmsg:=GetMsg(myport) DO ReplyMsg(appmsg) DeleteMsgPort(myport) ENDIF IF dobj THEN FreeDiskObject(dobj) openwin(self.gh) ENDPROC FALSE PROC setdisabled(disabled=TRUE) OF iconify Gt_SetGadgetAttrsA(self.iconify,self.gh.wnd,NIL,[GA_DISABLED,disabled,NIL]) self.disabled:=disabled ENDPROC =-lh0-+ + &B"'Src\Tools\EasyGUI\Plugins\imagebutton.eOPT MODULE MODULE 'tools/EasyGUI', 'graphics/rastport', 'intuition/intuition', 'intuition/gadgetclass', 'gadgets/button' EXPORT OBJECT imagebutton OF plugin selected disabled PRIVATE button:PTR TO gadget buttonbase image:PTR TO image toggle, push, resize width, height ENDOBJECT PROC imagebutton(image:PTR TO image,width=0,height=0,resizex=FALSE, resizey=FALSE,disabled=FALSE) OF imagebutton self.buttonbase:=OpenLibrary('gadgets/button.gadget',37) IF self.buttonbase=NIL THEN Raise("butt") self.image:=image self.toggle:=FALSE self.push:=FALSE self.selected:=FALSE self.resize:=(IF resizex THEN RESIZEX ELSE 0) OR (IF resizey THEN RESIZEY ELSE 0) self.disabled:=disabled self.width:=Max(width,image.width) self.height:=Max(height,image.height) ENDPROC PROC toggleimagebutton(image,width=0,height=0,selected=FALSE,resizex=FALSE, resizey=FALSE,disabled=FALSE) OF imagebutton self.imagebutton(image,width,height,resizex,resizey) self.toggle:=TRUE self.selected:=selected ENDPROC PROC pushimagebutton(image,width=0,height=0,selected=FALSE,resizex=FALSE, resizey=FALSE,disabled=FALSE) OF imagebutton self.imagebutton(image,width,height,resizex,resizey) self.push:=TRUE self.selected:=selected ENDPROC PROC end() OF imagebutton IF self.buttonbase THEN CloseLibrary(self.buttonbase) ENDPROC PROC min_size(ta,fh) OF imagebutton ENDPROC self.width+4, self.height+2 PROC will_resize() OF imagebutton IS self.resize PROC render(ta,x,y,xs,ys,w:PTR TO window) OF imagebutton self.button:=NewObjectA(NIL,'button.gadget', [GA_TOP,y, GA_LEFT,x, GA_WIDTH,xs, GA_HEIGHT,ys, GA_IMAGE,self.image, GA_TOGGLESELECT,self.toggle, BUTTON_PUSHBUTTON,self.push, GA_DISABLED,self.disabled, GA_SELECTED,self.selected, GA_RELVERIFY,TRUE, BUTTON_FILLPEN,w.rport.bgpen, NIL]) IF self.button=NIL THEN Raise("butt") AddGList(w,self.button,-1,1,NIL) RefreshGList(self.button,w,NIL,1) ENDPROC PROC clear_render(win:PTR TO window) OF imagebutton IF self.button RemoveGList(win,self.button,1) DisposeObject(self.button) ENDIF ENDPROC PROC message_test(imsg:PTR TO intuimessage,win) OF imagebutton IF imsg.class=IDCMP_GADGETUP THEN RETURN imsg.iaddress=self.button ENDPROC FALSE PROC message_action(class,qual,code,win) OF imagebutton self.selected:=code ENDPROC TRUE PROC setselected(selected=TRUE) OF imagebutton IF self.toggle OR self.push SetGadgetAttrsA(self.button,self.gh.wnd,NIL,[GA_SELECTED,selected,NIL]) self.selected:=selected ENDIF ENDPROC PROC setimage(image:PTR TO image) OF imagebutton IF (image.width<=self.width) AND (image.height<=self.height) SetGadgetAttrsA(self.button,self.gh.wnd,NIL,[GA_IMAGE,image,NIL]) self.image:=image ENDIF ENDPROC PROC setdisabled(disabled=TRUE) OF imagebutton SetGadgetAttrsA(self.button,self.gh.wnd,NIL,[GA_DISABLED,disabled,NIL]) self.disabled:=disabled ENDPROC 5-lh0-FFAM"Src\Tools\EasyGUI\Plugins\led.eOPT MODULE MODULE 'tools/EasyGUI', 'graphics/rastport', 'intuition/intuition', 'intuition/imageclass', 'images/led', 'utility/tagitem' EXPORT OBJECT led OF plugin pairs values:PTR TO INT colon signed negative pen PRIVATE ledbase ENDOBJECT PROC led(pairs=2,values=NIL,colon=FALSE,signed=FALSE,negative=FALSE,pen=1) OF led self.ledbase:=OpenLibrary('images/led.image',37) IF self.ledbase=NIL THEN Raise("led") self.pairs:=pairs self.values:=values self.colon:=colon self.signed:=signed self.negative:=negative self.pen:=pen ENDPROC PROC end() OF led IF self.ledbase THEN CloseLibrary(self.ledbase) ENDPROC PROC min_size(ta,fh) OF led ENDPROC self.pairs*19-IF self.signed THEN 0 ELSE 5,12 PROC will_resize() OF led IS RESIZEX OR RESIZEY PROC render(ta,x,y,xs,ys,w:PTR TO window) OF led DEF led IF (led:=NewObjectA(NIL,'led.image', [IA_FGPEN,self.pen, IA_WIDTH,xs-1, IA_HEIGHT,ys, IF self.values THEN LED_VALUES ELSE TAG_IGNORE,self.values, LED_PAIRS,self.pairs, LED_COLON,self.colon, LED_SIGNED,self.signed, LED_NEGATIVE,self.negative, NIL]))=NIL THEN Raise("led") DrawImage(w.rport,led,x,y) DisposeObject(led) ENDPROC PROC redisplay() OF led IF self.gh.wnd THEN self.render(NIL,self.x,self.y,self.xs,self.ys,self.gh.wnd) ENDPROC :M-lh0- SB"$Src\Tools\EasyGUI\Plugins\password.e OPT MODULE, PREPROCESS MODULE 'intuition/intuition', 'intuition/sghooks', 'intuition/gadgetclass', 'gadtools', 'libraries/gadtools', 'tools/textlen', 'tools/inithook', 'utility/hooks', 'tools/EasyGUI' RAISE "MEM" IF String()=NIL CONST NUM_EOS=EO_SPECIAL+1 -> Share gadtoolsbase with EasyGUI EXPORT OBJECT password OF plugin estr disabled PRIVATE password:PTR TO gadget label over relx mid hook:hook ENDOBJECT PROC password(estr,label=NIL,over=FALSE,relx=0,disabled=FALSE) OF password self.estr:=estr self.label:=IF label THEN label ELSE '' self.over:=over self.relx:=IF relx THEN relx ELSE 5 self.disabled:=disabled inithook(self.hook,{passHookCode},estr) ENDPROC PROC end() OF password IS EMPTY PROC min_size(ta,fh) OF password self.mid:=textlen(self.label,ta)+8 ENDPROC self.relx*fh+self.mid, fh+6 PROC will_resize() OF password IS RESIZEX -> Don't need to define this: ->PROC render(ta,x,y,xs,ys,w) OF password IS EMPTY PROC gtrender(gl,vis,ta,x,y,xs,ys,w) OF password HANDLE DEF len, pass=NIL pass:=makePass(self.estr) len:=textlen(self.label,ta) self.password:=CreateGadgetA(STRING_KIND,gl, [x+self.mid,y,xs-self.mid,ys,self.label,ta,0, PLACETEXT_LEFT,vis,NIL]:newgadget, [GTST_STRING,pass, GTST_EDITHOOK,self.hook, GTST_MAXCHARS,StrMax(self.estr), GA_DISABLED,self.disabled, STRINGA_REPLACEMODE,self.over, NIL]) IF self.password=NIL THEN Raise("pass") EXCEPT DO DisposeLink(pass) ReThrow() ENDPROC self.password -> Don't need to define this: -> PROC clear_render(win:PTR TO window) OF password IS EMPTY PROC message_test(imsg:PTR TO intuimessage,win:PTR TO window) OF password IF imsg.class=IDCMP_GADGETUP THEN RETURN imsg.iaddress=self.password ENDPROC FALSE PROC message_action(class,qual,code,win:PTR TO window) OF password ENDPROC TRUE PROC setpass(str) OF password HANDLE DEF pass=NIL pass:=makePass(str) Gt_SetGadgetAttrsA(self.password,self.gh.wnd,NIL,[GTST_STRING,pass,NIL]) StrCopy(self.estr,str) EXCEPT DO DisposeLink(pass) ENDPROC PROC setdisabled(disabled=TRUE) OF password Gt_SetGadgetAttrsA(self.password,self.gh.wnd,NIL,[GA_DISABLED,disabled,NIL]) self.disabled:=disabled ENDPROC PROC makePass(s) DEF len, p=NIL IF s IF len:=StrLen(s) SetStr(p:=String(len),len) WHILE len DO p[len--]:="*" ENDIF ENDIF ENDPROC p PROC passHookCode(hook:PTR TO hook, sgw:PTR TO sgwork, msg:PTR TO LONG) DEF realBuff:PTR TO CHAR, bp IF msg[]=SGH_KEY realBuff:=hook.data bp:=sgw.bufferpos SELECT NUM_EOS OF sgw.editop CASE EO_DELBACKWARD IF bp<>sgw.numchars sgw.actions:=(sgw.actions OR SGA_BEEP) AND Not(SGA_USE) ELSE SetStr(realBuff, bp) ENDIF CASE EO_REPLACECHAR realBuff[bp--]:=sgw.code sgw.workbuffer[bp]:="*" CASE EO_INSERTCHAR IF bp<>sgw.numchars sgw.actions:=(sgw.actions OR SGA_BEEP) AND Not(SGA_USE) ELSE SetStr(realBuff, bp) realBuff[bp--]:=sgw.code sgw.workbuffer[bp]:="*" ENDIF CASE EO_NOOP, EO_MOVECURSOR, EO_ENTER, EO_BADFORMAT -> Safely ignore DEFAULT -> EO_DELFORWARD, EO_BIGCHANGE, EO_RESET, EO_UNDO, EO_CLEAR, EO_SPECIAL -> Disallow sgw.actions:=(sgw.actions OR SGA_BEEP) AND Not(SGA_USE) ENDSELECT RETURN -1 ENDIF -> UNKNOWN COMMAND -> Hook should return zero if the command is not supported ENDPROC 0 6(-lh0-dB" Src\Tools\EasyGUI\Plugins\tabs.eOPT MODULE MODULE 'tools/EasyGUI', 'tools/ghost', 'tools/textlen', 'intuition/intuition', 'intuition/gadgetclass', 'gadgets/tabs' EXPORT OBJECT tabs OF plugin current disabled PRIVATE tabs:PTR TO gadget tabsbase tabslist max ENDOBJECT PROC tabs(tabslist,current=0,max=TRUE,disabled=FALSE) OF tabs self.tabsbase:=OpenLibrary('gadgets/tabs.gadget',37) IF self.tabsbase=NIL THEN Raise("tabs") self.tabslist:=tabslist self.current:=current self.max:=max self.disabled:=disabled ENDPROC PROC end() OF tabs IF self.tabsbase THEN CloseLibrary(self.tabsbase) ENDPROC PROC min_size(ta,fh) OF tabs DEF p:PTR TO tablabel, w=0, n=0 p:=self.tabslist IF self.max WHILE p.label w:=Max(w,textlen(p.label,ta)) n++ p++ ENDWHILE w:=w*n ELSE WHILE p.label w:=w+textlen(p.label,ta) n++ p++ ENDWHILE ENDIF ENDPROC n*20+w+7,fh+5 PROC will_resize() OF tabs IS COND_RESIZEX PROC render(ta,x,y,xs,ys,w) OF tabs self.tabs:=NewObjectA(NIL,'tabs.gadget', [GA_TOP,y, GA_LEFT,x, GA_WIDTH,xs-1, GA_HEIGHT,ys, GA_TEXTATTR,ta, GA_RELVERIFY,TRUE, TABS_CURRENT,self.current, TABS_LABELS,self.tabslist, LAYOUTA_CHILDMAXWIDTH,self.max, GA_DISABLED,self.disabled, NIL]) IF self.tabs=NIL THEN Raise("tabs") AddGList(w,self.tabs,-1,1,NIL) RefreshGList(self.tabs,w,NIL,1) ENDPROC PROC clear_render(win:PTR TO window) OF tabs IF self.tabs RemoveGList(win,self.tabs,1) DisposeObject(self.tabs) ENDIF ENDPROC PROC message_test(imsg:PTR TO intuimessage,win:PTR TO window) OF tabs IF imsg.class=IDCMP_GADGETUP THEN RETURN imsg.iaddress=self.tabs ENDPROC FALSE PROC message_action(class,qual,code,win:PTR TO window) OF tabs self.current:=code ENDPROC TRUE PROC setcurrent(x) OF tabs self.current:=x SetGadgetAttrsA(self.tabs,self.gh.wnd,NIL,[TABS_CURRENT,x,NIL]) ENDPROC PROC setdisabled(disabled=TRUE) OF tabs SetGadgetAttrsA(self.tabs,self.gh.wnd,NIL,[GA_DISABLED,disabled,NIL]) self.disabled:=disabled IF disabled=FALSE unghost_clear(self.tabs,self.gh.wnd,self.x,self.y,self.xs,self.ys) ENDIF ENDPROC :{-lh0-! ! yB"$Src\Tools\EasyGUI\Plugins\tapedeck.ezOPT MODULE MODULE 'tools/EasyGUI', 'tools/ghost', 'intuition/intuition', 'intuition/gadgetclass', 'gadgets/tapedeck' EXPORT OBJECT tapedeck OF plugin mode paused disabled PRIVATE tapedeck:PTR TO gadget tapedeckbase ENDOBJECT PROC tapedeck(mode=BUT_STOP,paused=FALSE,disabled=FALSE) OF tapedeck self.tapedeckbase:=OpenLibrary('gadgets/tapedeck.gadget',39) IF self.tapedeckbase=NIL THEN Raise("tape") self.mode:=mode self.paused:=paused self.disabled:=disabled ENDPROC PROC end() OF tapedeck IF self.tapedeckbase THEN CloseLibrary(self.tapedeckbase) ENDPROC PROC min_size(ta,fh) OF tapedeck ENDPROC 201,15 PROC will_resize() OF tapedeck IS 0 PROC render(ta,x,y,xs,ys,w) OF tapedeck self.tapedeck:=NewObjectA(NIL,'tapedeck.gadget', [GA_TOP,y, GA_LEFT,x, GA_WIDTH,xs, GA_HEIGHT,ys, TDECK_MODE,self.mode, TDECK_PAUSED,self.paused, TDECK_TAPE,TRUE, GA_DISABLED,self.disabled, GA_RELVERIFY,TRUE, NIL]) IF self.tapedeck=NIL THEN Raise("tape") AddGList(w,self.tapedeck,-1,1,NIL) RefreshGList(self.tapedeck,w,NIL,1) IF self.disabled THEN ghost(w,self.x,self.y,self.xs,self.ys) ENDPROC PROC clear_render(win:PTR TO window) OF tapedeck IF self.tapedeck RemoveGList(win,self.tapedeck,1) DisposeObject(self.tapedeck) ENDIF ENDPROC PROC message_test(imsg:PTR TO intuimessage,win:PTR TO window) OF tapedeck IF imsg.class=IDCMP_GADGETUP THEN RETURN imsg.iaddress=self.tapedeck ENDPROC FALSE PROC message_action(class,qual,code,win:PTR TO window) OF tapedeck DEF x GetAttr(TDECK_MODE,self.tapedeck,{x}) self.mode:=x GetAttr(TDECK_PAUSED,self.tapedeck,{x}) self.paused:=IF x THEN TRUE ELSE FALSE ENDPROC TRUE PROC setmode(mode=BUT_STOP) OF tapedeck self.mode:=mode IF mode=BUT_PAUSE THEN self.paused:=self.paused=FALSE SetGadgetAttrsA(self.tapedeck,self.gh.wnd,NIL,[TDECK_MODE,mode,NIL]) IF self.disabled THEN ghost(self.gh.wnd,self.x,self.y,self.xs,self.ys) ENDPROC PROC setpaused(paused=TRUE) OF tapedeck IF self.paused<>paused SetGadgetAttrsA(self.tapedeck,self.gh.wnd,NIL,[TDECK_MODE,BUT_PAUSE,NIL]) IF self.disabled THEN ghost(self.gh.wnd,self.x,self.y,self.xs,self.ys) ENDIF self.paused:=paused ENDPROC PROC setdisabled(disabled=TRUE) OF tapedeck SetGadgetAttrsA(self.tapedeck,self.gh.wnd,NIL,[GA_DISABLED,disabled,NIL]) IF disabled ghost(self.gh.wnd,self.x,self.y,self.xs,self.ys) ELSE unghost_clear(self.tapedeck,self.gh.wnd,self.x,self.y,self.xs,self.ys) ENDIF self.disabled:=disabled ENDPROC 8-lh0-,M""Src\Tools\EasyGUI\Plugins\ticker.eOPT MODULE MODULE 'tools/EasyGUI', 'intuition/intuition' EXPORT OBJECT ticker OF plugin ENDOBJECT PROC min_size(ta,fh) OF ticker IS 0,0 PROC will_resize() OF ticker IS FALSE PROC render(ta,x,y,xs,ys,w:PTR TO window) OF ticker IS EMPTY PROC message_test(imsg:PTR TO intuimessage,win:PTR TO window) OF ticker ENDPROC imsg.class=IDCMP_INTUITICKS PROC message_action(class,qual,code,win) OF ticker IS TRUE 9-lh0-w>"#Src\Tools\EasyGUI\Plugins\toolify.ekOPT MODULE, PREPROCESS MODULE 'intuition/intuition', 'intuition/gadgetclass', 'libraries/gadtools', 'tools/textlen', 'tools/EasyGUI', 'workbench/startup', 'workbench/workbench', 'gadtools', 'wb' RAISE "tlfy" IF AddAppMenuItemA()=NIL, "tlfy" IF CreateMsgPort()=NIL -> Share gadtoolsbase and workbenchbase with EasyGUI EXPORT OBJECT toolify OF plugin disabled PRIVATE toolify:PTR TO gadget label, toollabel resize ENDOBJECT PROC toolify(label,toollabel=NIL, resizex=FALSE,resizey=FALSE,disabled=FALSE) OF toolify self.label:=IF label THEN label ELSE '' self.toollabel:=IF toollabel THEN toollabel ELSE self.label self.disabled:=disabled self.resize:=(IF resizex THEN RESIZEX ELSE 0) OR (IF resizey THEN RESIZEY ELSE 0) ENDPROC PROC end() OF toolify IS EMPTY PROC min_size(ta,fh) OF toolify IS textlen(self.label,ta)+16,fh+6 PROC will_resize() OF toolify IS self.resize -> Don't need to define this: ->PROC render(ta,x,y,xs,ys,w) OF toolify IS EMPTY PROC gtrender(gl,vis,ta,x,y,xs,ys,w) OF toolify -> Or, a gadget in the title bar would have also been nice... self.toolify:=CreateGadgetA(BUTTON_KIND,gl, [x,y,xs,ys,self.label,ta,0, PLACETEXT_IN,vis,NIL]:newgadget, [NIL]) IF self.toolify=NIL THEN Raise("tlfy") ENDPROC self.toolify -> Don't need to define this: -> PROC clear_render(win:PTR TO window) OF toolify IS EMPTY PROC message_test(imsg:PTR TO intuimessage,win:PTR TO window) OF toolify IF imsg.class=IDCMP_GADGETUP THEN RETURN imsg.iaddress=self.toolify ENDPROC FALSE PROC message_action(class,qual,code,win:PTR TO window) OF toolify HANDLE DEF myport=NIL, appitem=NIL, appmsg:PTR TO appmessage closewin(self.gh) myport:=CreateMsgPort() appitem:=AddAppMenuItemA(0,0,self.toollabel,myport,NIL) WaitPort(myport) EXCEPT DO IF appitem THEN RemoveAppMenuItem(appitem) IF myport -> Clear away any messages that arrived at the last moment WHILE appmsg:=GetMsg(myport) DO ReplyMsg(appmsg) DeleteMsgPort(myport) ENDIF openwin(self.gh) ENDPROC FALSE PROC setdisabled(disabled=TRUE) OF toolify Gt_SetGadgetAttrsA(self.toolify,self.gh.wnd,NIL,[GA_DISABLED,disabled,NIL]) self.disabled:=disabled ENDPROC .2-lh0-  Ƒ"Src\Tools\EasyGUI\READMEShort: EasyGUI v3.3b.3 (multiple windows!) Type: dev/e Author: jason@fsel.com (Jason R. Hulance) New v3.3b.3 EasyGUI package =========================== (v3.3b.3 is a minor update that fixes a bug with AppWindow messages that crept in under the guise of a safety feature in v3.3b...) Re-read Docs/EasyGUI.doc! For the impatient, here is the big news: - MAJOR CHANGE: made the main functions use a taglist for their optional arguments (it was getting a bit ridiculous...). This gives a bit more flexibility for the programmer and makes for much more readable code, so I'm afraid it was inevitable. To ease the change-over a bit there is an example module which gives the old style versions of the functions (just for EasyGUI.m; you can do your own for EasyGUI_lite.m). - MAJOR ADDITION: support for multi-window GUIs. This is via the multiinit(), addmultiA(), multimessage(), cleanmulti() and checkmulti() functions. The new scheme shares message ports, and efficiently dispatches on the message data. This is *massively* more efficient than using the old scheme (OR-ing the signal masks of each window), and effectively removes the limit of windows that a GUI can use. Installing the modules ---------------------- Copy the files from the sub-directories of the Modules directory to the same place in your emodules: directory. Note: there are some updates to the typed modules of the v3.2a distribution included. Installing the .gadget and .image files --------------------------------------- Copy the .gadget and .image files from the sub-directories of the Classes directory to the same place in your sys:classes directory (or at least, somewhere so that libs:gadgets/x.gadget and libs:images/x.image find the appropriate files). PLUGINS ------- There are now lots of examples of PLUGINs with full source code and some documentation. Hopefully this will provoke some more interest in this area... Also, there is a simplified way of using GadTools gadgets as PLUGINs, via gtrender(). Test files ---------- There are several test files showing how to use the new features and new PLUGINs (in Src/EasyGUI/). Feedback -------- Please let me have some... Copyright --------- The .gadget and .image files are: Copyright (c) 1994 Commodore-Amiga, Inc. and discussed further in Classes/GI1.Readme and Classes/GI1.License. EasyGUI.m, EasyGUI_lite.m and alldist.e are: Copyright (c) 1994-6, Wouter van Oortmerssen and Jason R. Hulance. All other files in this archive are: Copyright (c) 1996, Jason R. Hulance. You are free to use these files in your own programs, and you may modify the souces supplied for your own purposes. But it would be nice if you mention the wonderful Wouter and his amazing Amiga E every now and then... Well, have fun! Jason (jason@fsel.com) 8-lh0-I#"Src\Tools\EasyGUI\Source\EasyGUI.e -> EasyGui.m, constructs fast nononsense font sensitive resizable gui's. OPT MODULE, OSVERSION=37, PREPROCESS -> Let only one of the following be defined: ->#define EASYGUI_LITE #define EASYGUI_FULL ->#define EASYGUI_DEBUG -> This selects various components based on above choice. #ifndef EASYGUI_LITE #define EASY_KEYBOARD #ifdef EASYGUI_DEBUG #ifndef EASYGUI_FULL #define EASYGUI_FULL #endif #endif #ifdef EASYGUI_FULL #define EASY_APPWINDOW #define EASY_EXTRAS #endif #endif -> This enables a descriptive message before an exception is raised. #ifdef EASYGUI_DEBUG #define RaiseX(x,l,s) myraise(x,l,s) MODULE 'tools/exceptions' #endif #ifndef EASYGUI_DEBUG #define RaiseX(x,l,s) Raise(x) #endif MODULE 'gadtools', 'exec/libraries', 'exec/lists', 'exec/nodes', 'exec/ports', 'graphics/rastport', 'graphics/text', 'graphics/gfx', 'graphics/videocontrol', 'graphics/view', 'intuition/gadgetclass', 'intuition/imageclass', 'intuition/intuition', 'intuition/screens', 'libraries/gadtools', 'tools/textlen', 'amigalib/lists', 'utility/tagitem', 'utility' #ifdef EASY_APPWINDOW MODULE 'wb', 'workbench/workbench' #endif #ifdef EASY_KEYBOARD MODULE 'tools/ctype' #endif DEF utilitybase -> Redefine for privateness #ifdef EASY_EXTRAS /************ multihandle ************/ EXPORT OBJECT multihandle sig opencount PRIVATE #ifdef EASY_APPWINDOW awport:PTR TO mp #endif wndport:PTR TO mp guis:lh ENDOBJECT #endif -> The offset of the `link' node in a guihandle. Used for getting -> back to the guihandle from the node in the list. CONST GH_LINK_OFFSET=16 /************ guihandle ************/ EXPORT OBJECT guihandle -> Window, Signal Mask (not Bit), Info wnd:PTR TO window,sig,info #ifdef EASY_EXTRAS -> Multi-Window Handle mh:PTR TO multihandle #endif PRIVATE #ifdef EASY_EXTRAS -> Node for Linking GUIs in Multi-Window GUIs link:ln #endif -> Private Window Pointer (so that wnd is a flag for GUI validity, too) pwnd:PTR TO window -> Last Gadget, VisualInfo, Font, Font_uses_screen, GT_lib_is_open gl:PTR TO gadget,visual,tattr:PTR TO textattr,ta_scr,gt_isopen -> Gadget desc, Gadget list, Screen, Screen_is_WB base:PTR TO g,glist,scr:PTR TO screen,is_wb -> Min Width and Height, X and Y Offset Past Window Borders xsize,ysize,xoff,yoff -> Menus, Plugins menus, plugins:PTR TO plugin #ifndef EASY_KEYBOARD -> First String Gadget firststr #endif #ifdef EASY_KEYBOARD -> Map of Key to Gadget keys[26]:ARRAY OF LONG #endif #ifdef EASY_APPWINDOW -> AppWindow Port, AppWindow, WB_lib_is_open awport:PTR TO mp,appwin,wb_isopen #endif #ifdef EASY_EXTRAS -> Requester used for Blocking req:PTR TO requester #endif -> GUI X and Y, GUI Desc, Window Title, Menu Desc x,y,gui,wtitle,awproc,newmenus -> Window Port, OnClose Proc, Window Type, OnClean Proc wndport:PTR TO mp,onclose,wtype,onclean -> Hack to make menu selections safe menuitem:PTR TO LONG #ifdef EASY_EXTRAS -> Count of blockwin() calls blockcnt #endif ENDOBJECT -> Flag set for resizing constants. SET CRSZ_X, CRSZ_Y, UNCOND_X, UNCOND_Y EXPORT CONST COND_RESIZEX=CRSZ_X, COND_RESIZEY=CRSZ_Y EXPORT CONST RESIZEX=COND_RESIZEX OR UNCOND_X, RESIZEY=COND_RESIZEY OR UNCOND_Y CONST RESIZEXANDY=RESIZEX OR RESIZEY -> Resize testing macros. #define DoesXResize(flag) ((flag) AND COND_RESIZEX) #define DoesYResize(flag) ((flag) AND COND_RESIZEY) #define DoesXUncond(flag) ((flag) AND RESIZEX=RESIZEX) #define DoesYUncond(flag) ((flag) AND RESIZEY=RESIZEY) -> Gadget type constants. -> 0 1 2 3 4 5 EXPORT ENUM ROWS,EQROWS,COLS,EQCOLS,BEVEL,BEVELR, -> 6 7 8 9 10 11 12 13 14 15 16 17 BUTTON,CHECK,INTEGER,LISTV,MX,CYCLE,PALETTE,SCROLL,SLIDE,STR,TEXT,NUM, -> 18 19 20 21 22 23 24 25 SBUTTON,PLUGIN,BAR,SPACEH,SPACE,SPACEV,RBUTTON,MAXGUI -> ROWS... BUTTON... PALETTE... SBUTTON... RBUTTON... -> Mapping of gadget type to GT KIND. #define KINDTAB \ [0,0,0,0,0,0, 1,2,3,4,5,7,8,9,11,12,13,6, 1, 0, 0,0,0,0, 1,12]:CHAR -> Mapping of gadget type to number of required arguments. #define MINARGS \ [2,2,2,2,2,2, 3,5,5,9,6,4,7,7, 9, 6, 5,5, 3, 3, 1,1,1,1, 3,6]:CHAR -> Constants to index gadget desc lists. EXPORT ENUM BEV_GUI=1, BUT_ACT=1, BUT_TXT, BUT_DATA, BUT_KEY, BUT_APPW, BUT_DIS, CHK_ACT=1, CHK_TXT, CHK_VAL, CHK_LEFT, CHK_DATA, CHK_KEY, CHK_DIS, INT_ACT=1, INT_TXT, INT_VAL, INT_REL, INT_DATA, INT_KEY, INT_DIS, LST_ACT=1, LST_TXT, LST_RELX, LST_RELY, LST_LIST, LST_RO, LST_SHOW, LST_CURR, LST_DATA, LST_KEY, LST_APPW, LST_DIS, MX_ACT=1, MX_TXT, MX_LIST, MX_LEFT, MX_CURR, MX_DATA, MX_KEY, MX_DIS, CYC_ACT=1, CYC_TXT, CYC_LIST, CYC_CURR, CYC_DATA, CYC_KEY, CYC_DIS, PAL_ACT=1, PAL_TXT, PAL_DEP, PAL_RELX, PAL_RELY, PAL_CURR, PAL_DATA, PAL_KEY, PAL_DIS, SCR_ACT=1, SCR_VERT, SCR_TOTL, SCR_TOP, SCR_VIS, SCR_REL, SCR_DATA, SCR_KEY, SCR_DIS, SLI_ACT=1, SLI_TXT, SLI_VERT, SLI_MIN, SLI_MAX, SLI_CURR, SLI_REL, SLI_FMT, SLI_DATA, SLI_KEY, SLI_DIS, STR_ACT=1, STR_TXT, STR_STR, STR_MAX, STR_REL, STR_OVR, STR_DATA, STR_KEY, STR_APPW, STR_DIS, TXT_VAL=1, TXT_TXT, TXT_BORD, TXT_REL, NUM_VAL=1, NUM_TXT, NUM_BORD, NUM_REL, PLG_ACT=1, PLG_OBJ, PLG_GT, PLG_APPW ENUM EG_TYPE=0, EG_ACT, EG_TXT -> Test group type macros. #define IsRow(type) ((type)<=EQROWS) #define IsCol(type) ((type)>EQROWS) #define IsRowOrCol(type) ((type) Test space sizing macros. #define HasHSpace(type) ((type)<=SPACE) #define HasVSpace(type) ((type)>=SPACE) #define HSpace(type) (IF HasHSpace(type) THEN RESIZEX ELSE 0) #define VSpace(type) (IF HasVSpace(type) THEN RESIZEY ELSE 0) #define SpaceFlags(type) (HSpace(type) OR VSpace(type)) -> Test button sizing macros. #define HasHButtSp(type) ((type)>=SBUTTON) #define HasVButtSp(type) ((type)=RBUTTON) #define HButtSp(type) (IF HasHButtSp(type) THEN RESIZEX ELSE 0) #define VButtSp(type) (IF HasVButtSp(type) THEN RESIZEY ELSE 0) #define ButtSpFlags(type) (HButtSp(type) OR VButtSp(type)) CONST SP=2,YSP=3 -> very basic spacing (Y=nonsense!?!) CONST XSPACING=YSP,YSPACING=SP, -> basic spacing between gadgets SIDESPACE=YSP,TOPSPACE=SP, -> spacing to window border BUTXSPACE=16,BUTYSPACE=6, -> space around text in button (min) BEVELXSPACE=4,BEVELYSPACE=3, -> between bevelbox and inner gadgets MXSPACE=2,CHECKSPACE=2 -> between two mx and check gads EXPORT ENUM WTYPE_NOBORDER, WTYPE_BASIC, WTYPE_NOSIZE, WTYPE_SIZE -> Window flags. CONST WIN_FBASIC=WFLG_ACTIVATE OR WFLG_NEWLOOKMENUS CONST WIN_FNOBORD=WFLG_BORDERLESS OR WIN_FBASIC CONST WIN_FNOSIZE=WIN_FBASIC OR WFLG_DRAGBAR OR WFLG_DEPTHGADGET OR WFLG_CLOSEGADGET CONST WIN_FSIZE=WIN_FNOSIZE OR WFLG_SIZEBBOTTOM OR WFLG_SIZEGADGET -> Gadget click IDCMP. CONST GAD_IDCMP=IDCMP_GADGETDOWN OR IDCMP_GADGETUP OR IDCMP_MOUSEMOVE -> Window IDMCP (without NEWSIZE). CONST WIN_IDCMP_NS=GAD_IDCMP OR IDCMP_REFRESHWINDOW OR IDCMP_MOUSEBUTTONS OR IDCMP_MENUPICK OR IDCMP_CLOSEWINDOW OR IDCMP_RAWKEY OR IDCMP_ACTIVEWINDOW OR IDCMP_INACTIVEWINDOW OR IDCMP_INTUITICKS OR IDCMP_CHANGEWINDOW OR IDCMP_VANILLAKEY -> Window IDMCP (with NEWSIZE). CONST WIN_IDCMP=IDCMP_NEWSIZE OR WIN_IDCMP_NS -> Message loop constants. CONST GUI_CONT=-1, GUI_QUIT=0 -> Action function test macro. #define IsActionFun(ret) (((ret)<0) OR ((ret)>1000)) -> Convert to unsigned INT. #define Unsigned(x) ((x) AND $FFFF) -> System gadget aspect ratio macro. #define SysISize(flags) \ (IF (flags) AND SCREENHIRES THEN SYSISIZE_MEDRES ELSE SYSISIZE_LOWRES) -> Gadget information extraction macros. #define GadLongInt(gad) (gad.specialinfo::stringinfo.longint) #define GadString(gad) (gad.specialinfo::stringinfo.buffer) #define IsChecked(gad) ((gad.flags AND GFLG_SELECTED)<>0) -> Constant to mark gadget has no mid-point. CONST NO_MID=-1 -> Gadget data (intermediate level). OBJECT g -> Link, X, Y, Width, Height next,x,y,xs,ys -> Gadget Type, Gadget Desc, Flags, Mid-Point type,list:PTR TO LONG,flags,mid ENDOBJECT /************ plugin ************/ EXPORT OBJECT plugin PRIVATE -> Gadget Data, Link base:PTR TO g, next:PTR TO plugin PUBLIC -> X, Y, Width, Height x:INT,y:INT,xs:INT,ys:INT -> guihandle gh:PTR TO guihandle ENDOBJECT PROC min_size(ta,fontheight) OF plugin IS fontheight,fontheight PROC will_resize() OF plugin IS RESIZEXANDY PROC message_test(imsg:PTR TO intuimessage,win:PTR TO window) OF plugin IS FALSE PROC message_action(class,qual,code,win:PTR TO window) OF plugin IS FALSE PROC clear_render(win:PTR TO window) OF plugin IS EMPTY PROC render(ta:PTR TO textattr,x,y,xs,ys,win:PTR TO window) OF plugin fillbox(win.rport,1,x,y,x+xs-1,y+ys-1) ENDPROC PROC appmessage(amsg,win:PTR TO window) OF plugin IS FALSE PROC gtrender(gl,vis,ta,x,y,xs,ys,win) OF plugin IS gl /************ plugin end ************/ -> Magic idenitifier for AppWindow gadgets. CONST EG_MAGIC=$EA51EA51 -> Tag list constants CONST EG_TAGBASE=TAG_USER+$4000 EXPORT ENUM EG_TITLE=EG_TAGBASE, EG_GUI, EG_INFO, EG_SCRN, EG_FONT, EG_MENU, EG_GHVAR, EG_AWPROC, EG_LEFT, EG_TOP, EG_MAXW, EG_MAXH, EG_WTYPE, EG_CLOSE, EG_CLEAN, EG_HIDE -> Gadget list attribute selection. #define ATTR(gui,n) gui[(n)] #define HasATTR(list,n) (ListLen((list))>n) #define OptATTR(list,n) optattr(list,n) #define OptDefATTR(list,n) optdefattr(list,n) PROC optattr(list:PTR TO LONG,n) IS IF HasATTR(list,n) THEN ATTR(list,n) ELSE 0 PROC optdefattr(list:PTR TO LONG,n) DEF res=-1 IF HasATTR(list,n) THEN res:=ATTR(list,n) ENDPROC IF res<>-1 THEN res ELSE list PROC indexdata(type) DEF index, but=FALSE, val=0 SELECT MAXGUI OF type CASE BUTTON,SBUTTON,RBUTTON; index:=BUT_DATA; but:=TRUE CASE CHECK; index:=CHK_DATA; val:=CHK_VAL CASE LISTV; index:=LST_DATA CASE MX; index:= MX_DATA CASE STR; index:=STR_DATA; val:=STR_STR CASE INTEGER; index:=INT_DATA; val:=INT_VAL CASE CYCLE; index:=CYC_DATA CASE PALETTE; index:=PAL_DATA CASE SCROLL; index:=SCR_DATA CASE SLIDE; index:=SLI_DATA ENDSELECT ENDPROC index, but, val #ifndef EASY_KEYBOARD #ifndef EASY_EXTRAS #define EASY_NOKEYBEXTRA #endif #endif #ifndef EASY_NOKEYBEXTRA -> Optional value based on index. PROC optindex(i:PTR TO LONG,index) IS IF index THEN OptATTR(i,index) ELSE 0 #endif #ifdef EASY_KEYBOARD #define optkey(t,i) optindex(i,indexkey(t)) PROC indexkey(type) DEF index SELECT MAXGUI OF type CASE BUTTON,SBUTTON,RBUTTON; index:=BUT_KEY CASE CHECK; index:=CHK_KEY CASE LISTV; index:=LST_KEY CASE MX; index:= MX_KEY CASE STR; index:=STR_KEY CASE INTEGER; index:=INT_KEY CASE CYCLE; index:=CYC_KEY CASE PALETTE; index:=PAL_KEY CASE SCROLL; index:=SCR_KEY CASE SLIDE; index:=SLI_KEY ENDSELECT ENDPROC index #endif #ifndef EASY_EXTRAS #define optdis(t,i) 0 #endif #ifdef EASY_EXTRAS #define optdis(t,i) optindex(i,indexdis(t)) PROC indexdis(type) DEF index=0 SELECT MAXGUI OF type CASE BUTTON,SBUTTON,RBUTTON; index:=BUT_DIS CASE CHECK; index:=CHK_DIS CASE LISTV; index:=LST_DIS CASE MX; index:= MX_DIS CASE STR; index:=STR_DIS CASE INTEGER; index:=INT_DIS CASE CYCLE; index:=CYC_DIS CASE PALETTE; index:=PAL_DIS CASE SCROLL; index:=SCR_DIS CASE SLIDE; index:=SLI_DIS ENDSELECT ENDPROC index /********** setdisabled **********/ EXPORT PROC setdisabled(gh,gad:PTR TO LONG,disabled=TRUE) DEF index index:=indexdis(ATTR(gad,EG_TYPE)) IF HasATTR(gad,index) THEN setattr(gh,gad,disabled,GA_DISABLED,index) ENDPROC #endif -> Clear window contents and redraw frame. PROC clearwindow(w:PTR TO window) fillbox(w.rport,0,w.borderleft,w.bordertop, w.width-w.borderright-1, w.height-w.borderbottom-1) RefreshWindowFrame(w) ENDPROC PROC fillbox(rport,pen,x,y,x2,y2) SetAPen(rport,pen) RectFill(rport,x,y,x2,y2) ENDPROC -> Create new gadget data. PROC newg(xs,ys,type,list,flags=0,mid=NO_MID) IS NEW [0,0,0,xs,ys,type,list,flags,mid]:g -> Access functions for gadget type mapping lists. PROC minARGS() IS MINARGS PROC kindTAB() IS KINDTAB #ifdef EASYGUI_DEBUG -> In debug version this will be called instead of raising an exception. PROC myraise(x,l,s) exception:=x; exceptioninfo:=0 WriteF('Just about to raise exception:\n') report_exception() IF (l>0) AND (l<2000) WriteF(' Error ref \d: \s\n',l,s) ELSE WriteF(' \s (Gadget list $\h)\n',s,l) ENDIF Raise(x) ENDPROC #endif /********** easyguiA() **********/ EXPORT PROC easyguiA(title,gui,tags=NIL) HANDLE DEF gh=NIL:PTR TO guihandle,res=-1 gh:=guiinitA(title,gui,tags) WHILE res<0 Wait(gh.sig) res:=guimessage(gh) ENDWHILE EXCEPT DO cleangui(gh) ReThrow() ENDPROC res /********** easygui_fallbackA() **********/ EXPORT PROC easygui_fallbackA(title,gui,tags=NIL) HANDLE RETURN easyguiA(title,gui,tags) EXCEPT IF exception="bigg" RETURN easyguiA(title,gui,[EG_FONT,['topaz.font',8,0,0]:textattr, TAG_MORE,tags]) ENDIF ReThrow() ENDPROC -> Init font. PROC initfont(gh:PTR TO guihandle,tattr) gh.tattr:=tattr gh.ta_scr:=(tattr=NIL) ENDPROC -> Init screen. PROC initscr(gh:PTR TO guihandle,scr) gh.scr:=scr gh.is_wb:=(scr=NIL) ENDPROC -> Set up menus. PROC setmenus(gh:PTR TO guihandle) -> setup menus IF gh.newmenus gh.menus:=CreateMenusA(gh.newmenus,NIL) IF gh.menus=NIL THEN RaiseX("GUI",431,'Could not create menus. Bad menu description? Or out of memory?') IF LayoutMenusA(gh.menus,gh.visual,[GTMN_NEWLOOKMENUS,TRUE,NIL])=FALSE THEN RaiseX("GUI",432,'Could not layout menus. Out of memory?') IF SetMenuStrip(gh.pwnd,gh.menus)=FALSE THEN RaiseX("GUI",433,'Could not set menu strip. Should never happen!') ENDIF ENDPROC PROC win_off(n,s:PTR TO screen) DEF y IF n=WTYPE_NOBORDER THEN RETURN 1,1 y:=s.wbortop+TOPSPACE IF n>WTYPE_BASIC THEN y:=y+s.rastport.txheight+1 ENDPROC s.wborleft+SIDESPACE,y PROC win_pad(n,s:PTR TO screen) DEF y=TOPSPACE IF n=WTYPE_NOBORDER THEN RETURN 1,1 y:=y+IF n=WTYPE_SIZE THEN getrealbot(s) ELSE s.wborbottom ENDPROC s.wborright+SIDESPACE,y -> Set up GUI. PROC setgui(gh:PTR TO guihandle) DEF base:PTR TO g,s:PTR TO screen,w:PTR TO window,xsize,ysize, cm,h=NIL:PTR TO LONG,vpe=NIL:PTR TO viewportextra,x,y s:=gh.scr w:=gh.pwnd -> Get gadget data and calculate minimum GUI size. gh.base:=base:=minsize(gh.gui,gh) IF w=NIL -> Calculate offset of borders in window. x,y:=win_off(gh.wtype,s) gh.xoff:=x gh.yoff:=y ENDIF -> Calculate minimum width and height of window. x,y:=win_pad(gh.wtype,s) xsize:=x+gh.xoff+base.xs ysize:=y+gh.yoff+base.ys IF (xsize>s.width) OR (ysize>s.height) THEN RaiseX("bigg",455,'Size is too big for the screen.') #ifdef EASY_EXTRAS -> If window open then adjust sizing. IF w -> Calculate X size and pos delta if needed. cm:=IF (w.width>=xsize) AND DoesXResize(base.flags) THEN w.width ELSE xsize x:=IF cm+w.leftedge>s.width THEN s.width-cm ELSE w.leftedge -> Calculate Y size and pos delta if needed. h:=IF (w.height>=ysize) AND DoesYResize(base.flags) THEN w.height ELSE ysize y:=IF h+w.topedge>s.height THEN s.height-h ELSE w.topedge -> Disallow window sizing. ModifyIDCMP(w, WIN_IDCMP_NS) -> Temporarily allow window to grow as large and small as possible. WindowLimits(w,8,8,-1,-1) -> Move and size window. ChangeWindowBox(w,x,y,cm,h) -> Set window to proper limits. setwinlimits(w,xsize,ysize, IF DoesXResize(base.flags) THEN -1 ELSE xsize, IF DoesYResize(base.flags) THEN -1 ELSE ysize) -> Remove mess. clearwindow(w) -> Allow resizing (maybe) again. ModifyIDCMP(w, WIN_IDCMP) ELSE #endif -> Window not open so create it. -> get visual infos gh.visual:=GetVisualInfoA(gh.scr,NIL) IF gh.visual=NIL THEN RaiseX("GUI",482,'Could not get visual info. Out of memory?') -> calc window position (centre of visible part of screen) h:=VTAG_VIEWPORTEXTRA_GET -> Ack! VideoControl changes tag! IF IF cm:=s.viewport.colormap THEN VideoControl(cm, h:=[h,NIL,NIL]) BUT vpe:=h[1] ELSE vpe:=NIL x:=Min(vpe.displayclip.maxx-vpe.displayclip.minx+1,s.width)-xsize/2-s.viewport.dxoffset y:=Min(vpe.displayclip.maxy-vpe.displayclip.miny+1,s.height)-ysize/2-s.viewport.dyoffset ELSE x:=s.width-xsize/2 y:=s.height-ysize/2 ENDIF w:=s.width h:=s.height -> If position stored use that, else centred. And adjust max size. IF gh.x<>-1 x:=gh.x -> Offset the maximum w:=Bounds(w-x,xsize,w) ENDIF IF gh.y<>-1 y:=gh.y h:=Bounds(h-y,ysize,h) ENDIF -> Use minimum or stored size (default is maximum). IF gh.xsize=0 w:=xsize ELSEIF DoesXResize(base.flags)=FALSE w:=xsize ELSEIF gh.xsize<>-1 w:=Bounds(gh.xsize,xsize,s.width) ENDIF IF gh.ysize=0 h:=ysize ELSEIF DoesYResize(base.flags)=FALSE h:=ysize ELSEIF gh.ysize<>-1 h:=Bounds(gh.ysize,ysize,s.height) ENDIF -> open the window gh.pwnd:=w:=OpenWindowTagList(NIL, [WA_LEFT, Bounds(x,0,s.width-w), WA_TOP, Bounds(y,0,s.height-h), WA_WIDTH, w, WA_HEIGHT, h, WA_IDCMP, 0, -> Was WIN_IDCMP: now ports are shared. WA_FLAGS, ListItem([WIN_FNOBORD,WIN_FBASIC, WIN_FNOSIZE,WIN_FSIZE], gh.wtype), WA_TITLE, IF gh.wtype>WTYPE_BASIC THEN gh.wtitle ELSE NIL, WA_CUSTOMSCREEN, gh.scr, WA_MINWIDTH, xsize, WA_MINHEIGHT, ysize, WA_MAXWIDTH, IF DoesXResize(base.flags) THEN -1 ELSE xsize, WA_MAXHEIGHT, IF DoesYResize(base.flags) THEN -1 ELSE ysize, ->WA_AUTOADJUST,1, NIL]) IF w=NIL THEN RaiseX("GUI",537,'Could not open window. Too many layers?') w.userdata:=gh -> Set up window IDCMP port. w.userport:=gh.wndport ModifyIDCMP(w,WIN_IDCMP) #ifdef EASY_APPWINDOW IF gh.awproc THEN gh.appwin:=AddAppWindowA(gh,gh.awproc,gh.pwnd,gh.awport,NIL) #endif stdrast:=w.rport #ifdef EASY_EXTRAS ENDIF #endif -> Remember minimum window size. gh.xsize:=xsize gh.ysize:=ysize -> Now render the gadgets. gh.glist:=rendergui(gh) ENDPROC /********** guiinitA() **********/ #ifdef EASY_EXTRAS EXPORT PROC guiinitA(title,gui,tags=NIL) IS addmultiA(NIL,title,gui,tags) #endif #ifndef EASY_EXTRAS EXPORT PROC guiinitA(title,gui,tags=NIL) HANDLE DEF gh=NIL:PTR TO guihandle gh:=makehandle(title,gui,NIL,tags) EXCEPT -> Stop the user cleanup in this case. gh.onclean:=NIL cleangui(gh) ReThrow() ENDPROC gh #endif PROC openlibrary(s) DEF lib IF (lib:=OpenLibrary(s,37))=NIL THEN RaiseX("LIB",613,s) ENDPROC lib -> Make a handle and initialise from the tags. PROC makehandle(title,gui,mh,tags) HANDLE DEF gh=NIL:PTR TO guihandle, temp:PTR TO LONG, isopen=FALSE NEW gh utilitybase:=openlibrary('utility.library') isopen:=TRUE IF temp:=GetTagData(EG_GHVAR,NIL,tags) THEN temp[]:=gh gh.wtype:=GetTagData(EG_WTYPE,WTYPE_SIZE,tags) gh.wtitle:=title gh.gui:=gui gh.info:=IF -1<>(temp:=GetTagData(EG_INFO,-1,tags)) THEN temp ELSE gh initscr(gh,GetTagData(EG_SCRN,NIL,tags)) initfont(gh,GetTagData(EG_FONT,NIL,tags)) gh.newmenus:=GetTagData(EG_MENU,NIL,tags) gh.awproc:=GetTagData(EG_AWPROC,NIL,tags) gh.x:=GetTagData(EG_LEFT,-1,tags) gh.y:=GetTagData(EG_TOP,-1,tags) gh.onclose:=GetTagData(EG_CLOSE,NIL,tags) gh.onclean:=GetTagData(EG_CLEAN,NIL,tags) IF GetTagData(EG_MAXW,FALSE,tags) THEN gh.xsize:=-1 IF GetTagData(EG_MAXH,FALSE,tags) THEN gh.ysize:=-1 #ifdef EASY_EXTRAS gh.mh:=mh #endif setinit(gh) EXCEPT DO IF exception END gh ReThrow() ELSE IF GetTagData(EG_HIDE,FALSE,tags)=FALSE THEN openwin(gh) ENDIF IF isopen THEN CloseLibrary(utilitybase) ENDPROC gh -> Initialisation stuff. PROC setinit(gh:PTR TO guihandle) HANDLE -> Open library safely. gadtoolsbase:=openlibrary('gadtools.library') gh.gt_isopen:=TRUE #ifdef EASY_EXTRAS -> Window IDCMP port. IF gh.mh -> If multi-window then share port. gh.wndport:=gh.mh.wndport -> Also, share the *complete* signal mask. -> (This ensures that guimessage() works...) gh.sig:=gh.mh.sig ELSE #endif gh.wndport:=makeport() gh.sig:=Shl(1,gh.wndport.sigbit) #ifdef EASY_EXTRAS ENDIF #endif #ifdef EASY_APPWINDOW -> Open library safely. workbenchbase:=openlibrary('workbench.library') gh.wb_isopen:=TRUE #ifdef EASY_EXTRAS -> AppWindow port IF gh.mh -> If multi-window then share port (even if no awproc) -> (This ensures that guimessage() works...) gh.awport:=gh.mh.awport ELSEIF gh.awproc #endif #ifndef EASY_EXTRAS IF gh.awproc #endif gh.awport:=makeport() gh.sig:=gh.sig OR Shl(1,gh.awport.sigbit) ELSE gh.awport:=NIL ENDIF #endif EXCEPT cleaninit(gh) ReThrow() ENDPROC /********** openwin() **********/ EXPORT PROC openwin(gh:PTR TO guihandle) IF gh.pwnd=NIL -> Set up screen. IF gh.is_wb IF gh.scr=NIL THEN gh.scr:=LockPubScreen(NIL) IF gh.scr=NIL THEN RaiseX("GUI",417,'Could not lock default public screen (Workbench?). Is it open?') ENDIF -> Set up font. IF gh.ta_scr THEN gh.tattr:=gh.scr.font -> Set up window and GUI. setgui(gh) -> Set up menus. setmenus(gh) #ifdef EASY_EXTRAS -> If multi then bump count of open windows. IF gh.mh THEN gh.mh.opencount:=gh.mh.opencount+1 #endif ENDIF ENDPROC gh #ifdef EASY_EXTRAS /********** changescreen() **********/ EXPORT PROC changescreen(gh:PTR TO guihandle,scr=NIL) IF gh.wnd=NIL THEN initscr(gh,scr) ENDPROC /********** changefont() **********/ EXPORT PROC changefont(gh:PTR TO guihandle,tattr=NIL) IF gh.wnd=NIL THEN initfont(gh,tattr) ENDPROC /********** changewintype() **********/ EXPORT PROC changewintype(gh:PTR TO guihandle,wintype=WTYPE_SIZE) IF gh.wnd=NIL THEN gh.wtype:=wintype ENDPROC /********** changeinfo() **********/ EXPORT PROC changeinfo(gh:PTR TO guihandle,info=-1) gh.info:=IF info<>-1 THEN info ELSE gh ENDPROC /********** changetitle() **********/ EXPORT PROC changetitle(gh:PTR TO guihandle,windowtitle=NIL) IF gh.wnd IF (windowtitle=NIL) OR (gh.wtype>WTYPE_BASIC) SetWindowTitles(gh.wnd, windowtitle, -1) ENDIF ENDIF gh.wtitle:=windowtitle ENDPROC /********** changemenus() **********/ EXPORT PROC changemenus(gh:PTR TO guihandle,newmenus=NIL) HANDLE IF gh.wnd THEN removemenus(gh) gh.newmenus:=newmenus IF gh.wnd THEN setmenus(gh) EXCEPT removemenus(gh) ReThrow() ENDPROC /********** changegui() **********/ EXPORT PROC changegui(gh:PTR TO guihandle,gui) IF gui IF gh.pwnd THEN removegui(gh) gh.gui:=gui IF gh.pwnd THEN setgui(gh) ENDIF ENDPROC /********** movewin() **********/ EXPORT PROC movewin(gh:PTR TO guihandle,x=-1,y=-1) DEF w:PTR TO window IF w:=gh.wnd MoveWindow(w, IF x=-1 THEN 0 ELSE (x-w.leftedge), IF y=-1 THEN 0 ELSE (y-w.topedge)) ENDIF ENDPROC /********** sizewin() **********/ EXPORT PROC sizewin(gh:PTR TO guihandle,xs=-1,ys=-1) DEF w:PTR TO window IF w:=gh.wnd SizeWindow(w, IF xs=-1 THEN 0 ELSE (xs-w.width), IF ys=-1 THEN 0 ELSE (ys-w.height)) ENDIF ENDPROC -> Try setting window limits a few times. PROC setwinlimits(w,minx,miny,maxx,maxy) DEF i FOR i:=0 TO 3 EXIT WindowLimits(w,minx,miny,maxx,maxy) Delay(1) ENDFOR ENDPROC /********** blockwin() **********/ EXPORT PROC blockwin(gh:PTR TO guihandle) DEF lib:PTR TO lib,c,w:PTR TO window gh.blockcnt:=(c:=gh.blockcnt)+1 IF c=0 -> Only works if window open and not already blocked. IF (w:=gh.wnd) AND (gh.req=NIL) -> Only allow window refresh messages. ModifyIDCMP(w, IDCMP_REFRESHWINDOW) -> Stop window sizing. setwinlimits(w,w.width,w.height,w.width,w.height) NEW gh.req -> Block window with requester. InitRequester(gh.req) Request(gh.req, w) lib:=intuitionbase IF lib.version>=39 THEN SetWindowPointerA(w,[WA_BUSYPOINTER,TRUE, WA_POINTERDELAY,TRUE,NIL]) ENDIF ENDIF ENDPROC /********** unblockwin() **********/ EXPORT PROC unblockwin(gh:PTR TO guihandle) DEF lib:PTR TO lib,c,w:PTR TO window IF (c:=gh.blockcnt)>0 gh.blockcnt:=c-1 IF c=1 -> Only works if window open and blocked. IF (w:=gh.wnd) AND (gh.req<>NIL) -> Remove requester. EndRequest(gh.req, w) -> Reset window limits. setwinlimits(w,gh.xsize,gh.ysize, IF DoesXResize(gh.base.flags) THEN -1 ELSE gh.xsize, IF DoesYResize(gh.base.flags) THEN -1 ELSE gh.ysize) -> Reset IDCMP. ModifyIDCMP(w, WIN_IDCMP) END gh.req lib:=intuitionbase IF lib.version>=39 THEN SetWindowPointerA(w,[WA_BUSYPOINTER,FALSE,NIL]) ENDIF ENDIF ENDIF ENDPROC #endif #ifdef EASY_APPWINDOW -> Handle AppWindow messages. PROC appwmessage(port) HANDLE DEF ret,data,list:PTR TO LONG,amsg=NIL:PTR TO appmessage,gh:PTR TO guihandle, pl:PTR TO plugin IF port WHILE amsg:=GetMsg(port) -> Get guihandle from message ID. gh:=amsg.id -> See if any PLUGIN wants it. pl:=gh.plugins WHILE pl IF OptATTR(pl.base.list,PLG_APPW)=NIL THEN JUMP plugin_appw_skip EXIT pl.appmessage(amsg,gh.pwnd) plugin_appw_skip: pl:=pl.next ENDWHILE ret:=NIL data:=NIL -> Get awproc (in ret) and data. IF pl ret:=OptATTR(pl.base.list,PLG_APPW) data:=pl ELSE IF list:=findxy(gh,amsg.mousex,amsg.mousey) SELECT MAXGUI OF ATTR(list,EG_TYPE) CASE BUTTON, SBUTTON, RBUTTON ret:=OptATTR(list,BUT_APPW) data:=OptDefATTR(list,BUT_DATA) CASE LISTV ret:=OptATTR(list,LST_APPW) data:=OptDefATTR(list,LST_DATA) CASE STR ret:=OptATTR(list,STR_APPW) data:=OptDefATTR(list,STR_DATA) ENDSELECT ENDIF ENDIF -> If no gadget awproc then use window one. IF ret=NIL ret:=amsg.userdata data:=NIL ENDIF -> Call the awproc. IF ret THEN ret(data,gh.info,amsg) -> Now we can reply to the message. ReplyMsg(amsg) amsg:=NIL ENDWHILE ENDIF EXCEPT -> Still need to reply if exception happened at a bad point IF amsg THEN ReplyMsg(amsg) ReThrow() ENDPROC #endif -> Handle menu messages. PROC menumessage(gh:PTR TO guihandle,code) HANDLE DEF ret=GUI_CONT,menunum,item:PTR TO menuitem menunum:=Unsigned(code) -> Stop if the window's gone away. WHILE (menunum<>MENUNULL) AND gh.pwnd item:=ItemAddress(gh.menus,menunum) -> Get action value/function. ret:=GTMENUITEM_USERDATA(item) -> Stop if action value. EXIT IsActionFun(ret)=FALSE gh.menuitem:={item} -> Call action function. ret(NIL,NIL,gh.info) ret:=GUI_CONT EXIT item=NIL menunum:=Unsigned(item.nextselect) ENDWHILE EXCEPT DO gh.menuitem:=NIL ReThrow() ENDPROC ret -> Handle GadTools/window messages. PROC gtmessage(port) HANDLE DEF ret=GUI_CONT,mes=NIL:PTR TO intuimessage,type,gh:PTR TO guihandle, gs:PTR TO gadget,list:PTR TO LONG,code,pl:PTR TO plugin,qual WHILE mes:=Gt_GetIMsg(port) -> Get guihandle from window userdata. gh:=mes.idcmpwindow.userdata -> See if any PLUGIN wants it. pl:=gh.plugins WHILE pl EXIT pl.message_test(mes,gh.pwnd) pl:=pl.next ENDWHILE -> Copy important bits of the message. type:=mes.class code:=mes.code gs:=mes.iaddress qual:=Unsigned(mes.qualifier) -> Now we can reply to the message. Gt_ReplyIMsg(mes) mes:=NIL IF pl -> Call the PLUGIN's action function if necessary. IF pl.message_action(type,qual,code,gh.pwnd) ret:=ATTR(pl.base.list,PLG_ACT) IF IsActionFun(ret) ret(gh.info,pl) ret:=GUI_CONT ENDIF ENDIF ELSE -> Gadget click. IF type AND GAD_IDCMP ->WriteF('type=$\h, code=$\h, gad=$\h\n', type, code, gs) -> Protect from stray IDCMP_MOUSEMOVE. IF gs AND (gs<>gh.pwnd) -> Get gadget description list. list:=gs.userdata -> Set new attribute. performset(gs,code,list) -> Get action value/function. ret:=ATTR(list,EG_ACT) IF IsActionFun(ret) performaction(ret,gs,gh.info,code,list,qual) ret:=GUI_CONT ENDIF ENDIF #ifdef EASY_KEYBOARD -> Key press. ELSEIF type=IDCMP_VANILLAKEY ret:=performkey(gh,code) #endif -> Window refresh. ELSEIF type=IDCMP_REFRESHWINDOW Gt_BeginRefresh(gh.pwnd) Gt_EndRefresh(gh.pwnd,TRUE) -> Window size change. ELSEIF type=IDCMP_NEWSIZE -> Remove the gadgets, clear and recreate. removegads(gh) clearwindow(gh.pwnd) gh.glist:=rendergui(gh) -> Close gadget click. ELSEIF type=IDCMP_CLOSEWINDOW -> Find action value/function. ret:=gh.onclose IF IsActionFun(ret) #ifdef EASY_EXTRAS ret(gh.mh,gh.info) #endif #ifndef EASY_EXTRAS ret(NIL,gh.info) #endif ret:=GUI_CONT ENDIF -> Menu choice(s). ELSEIF type=IDCMP_MENUPICK ret:=menumessage(gh,code) ENDIF ENDIF EXIT ret<>GUI_CONT ENDWHILE #ifdef EASY_EXTRAS IF ret<>GUI_CONT THEN IF gh.mh THEN cleangui(gh) #endif EXCEPT -> Still need to reply if exception happened in PLUGIN message_test(). IF mes THEN Gt_ReplyIMsg(mes) ReThrow() ENDPROC ret #ifdef EASY_EXTRAS /********** multiinit() **********/ EXPORT PROC multiinit() HANDLE DEF mh=NIL:PTR TO multihandle NEW mh newList(mh.guis) mh.wndport:=makeport() mh.sig:=Shl(1,mh.wndport.sigbit) #ifdef EASY_APPWINDOW mh.awport:=makeport() mh.sig:=mh.sig OR Shl(1,mh.awport.sigbit) #endif EXCEPT cleanmulti(mh) ReThrow() ENDPROC mh /********** addmultiA() **********/ EXPORT PROC addmultiA(mh:PTR TO multihandle,title,gui,tags=NIL) HANDLE DEF gh=NIL:PTR TO guihandle gh:=makehandle(title,gui,mh,tags) IF mh THEN AddHead(mh.guis,gh.link) EXCEPT -> Stop the user cleanup in this case. gh.onclean:=NIL cleangui(gh) ReThrow() ENDPROC gh /********** multiforall() **********/ EXPORT PROC multiforall(varaddr:PTR TO LONG,mh:PTR TO multihandle,expr) IS multieval(varaddr,mh,expr,FALSE) /********** multiexists() **********/ EXPORT PROC multiexists(varaddr:PTR TO LONG,mh:PTR TO multihandle,expr) IS multieval(varaddr,mh,expr,TRUE) -> Evaluate and maybe stop... PROC multieval(varaddr:PTR TO LONG,mh:PTR TO multihandle,expr,exists) DEF node:PTR TO ln, next, this, res -> If empty then TRUE for forall, but FALSE for exists res:=(exists=FALSE) IF mh node:=mh.guis.head WHILE next:=node.succ varaddr[]:=node-GH_LINK_OFFSET IF this:=Eval(expr) -> If exists then we've found a match. IF exists THEN RETURN this ELSE -> Forall is FALSE. Exists is still FALSE. res:=FALSE ENDIF node:=next ENDWHILE ENDIF -> Invalidate for case where exists fails. varaddr[]:=NIL ENDPROC res /********** multiempty() **********/ EXPORT PROC multiempty(mh:PTR TO multihandle) IS mh.guis.tailpred=mh.guis /********** multiloop() **********/ EXPORT PROC multiloop(mh:PTR TO multihandle) DEF res=-1 WHILE res<0 EXIT mh.opencount=0 Wait(mh.sig) res:=multimessage(mh) ENDWHILE ENDPROC res /********** cleanmulti() **********/ EXPORT PROC cleanmulti(mh:PTR TO multihandle) IF mh -> Clean up any remaining guihandles. WHILE multiempty(mh)=FALSE DO cleangui(mh.guis.head-GH_LINK_OFFSET) #ifdef EASY_APPWINDOW IF mh.awport DeleteMsgPort(mh.awport) mh.awport:=NIL ENDIF #endif IF mh.wndport DeleteMsgPort(mh.wndport) mh.wndport:=NIL ENDIF END mh ENDIF ENDPROC /********** checkmulti() **********/ EXPORT PROC checkmulti(mh:PTR TO multihandle) DEF ret -> Check if there a message waiting on our ports. IF SetSignal(0,0) AND mh.sig IF (ret:=multimessage(mh))>=0 THEN quitgui(ret) ENDIF ENDPROC #endif -> Note: as long as gh is valid, guimessage() can be used in place of -> multimessage() for multi-window GUIs. But remember that gh could -> be invalidated by an action function when guimessage() is called. /********** guimessage() **********/ /********** multimessage() **********/ #ifdef EASY_APPWINDOW EXPORT PROC guimessage(gh:PTR TO guihandle) IS message(gh.wndport,gh.awport) #ifdef EASY_EXTRAS EXPORT PROC multimessage(mh:PTR TO multihandle) IS message(mh.wndport,mh.awport) #endif #endif #ifndef EASY_APPWINDOW EXPORT PROC guimessage(gh:PTR TO guihandle) IS message(gh.wndport,NIL) #ifdef EASY_EXTRAS EXPORT PROC multimessage(mh:PTR TO multihandle) IS message(mh.wndport,NIL) #endif #endif -> Handle messages from the ports. PROC message(wndport,awport) HANDLE DEF ret=-1 #ifdef EASY_APPWINDOW appwmessage(awport) #endif ret:=gtmessage(wndport) EXCEPT -> If we got "QUIT" then return value is in exceptioninfo. IF exception="QUIT" ret:=exceptioninfo ELSE ReThrow() ENDIF ENDPROC ret /********** quitgui() **********/ EXPORT PROC quitgui(ret=0) IS Throw("QUIT",ret) -> Note: as above, checkgui() is safe for multi-window GUIs as long as -> gh is valid. /********** checkgui() **********/ EXPORT PROC checkgui(gh:PTR TO guihandle) DEF ret -> Check if there a message waiting on our ports. IF SetSignal(0,0) AND gh.sig IF (ret:=guimessage(gh))>=0 THEN quitgui(ret) ENDIF ENDPROC -> Remove menus and reset handle. PROC removemenus(gh:PTR TO guihandle) IF gh.menus -> Hack to prevent the item.nextselect if closed from menu action function. IF gh.menuitem THEN gh.menuitem[]:=NIL IF gh.pwnd THEN ClearMenuStrip(gh.pwnd) FreeMenus(gh.menus) gh.menus:=NIL ENDIF ENDPROC -> Remove GUI and reset handle. PROC removegui(gh:PTR TO guihandle) clean(gh.base) gh.base:=NIL removegads(gh) gh.glist:=NIL gh.plugins:=NIL ENDPROC -> Check if is this an IDCMP message for the window. PROC testintuimsg(msg:PTR TO intuimessage,data) IS msg.idcmpwindow=data #ifdef EASY_APPWINDOW -> Check if is this an appmessage for the AppWindow. PROC testappwmsg(msg:PTR TO appmessage,data) IS msg.id=data #endif -> Selectively remove messages from the port. PROC clearmsgs(mp:PTR TO mp,f,data) DEF msg:PTR TO mn, succ -> Must be in Forbid()/Permit() brackets... Forbid() msg:=mp.msglist.head WHILE succ:=msg.ln.succ IF f(msg,data) Remove(msg) ReplyMsg(msg) ENDIF msg:=succ ENDWHILE Permit() ENDPROC -> Create a new message port. PROC makeport() DEF port:PTR TO mp IF (port:=CreateMsgPort())=NIL THEN RaiseX("GUI",1065,'Could not create message port. Run out of signal bits?') ENDPROC port -> Clean initialisation stuff and reset handle. PROC cleaninit(gh:PTR TO guihandle) -> Clean ports. #ifdef EASY_APPWINDOW #ifdef EASY_EXTRAS IF (gh.mh=NIL) AND gh.awport THEN DeleteMsgPort(gh.awport) #endif #ifndef EASY_EXTRAS IF gh.awport THEN DeleteMsgPort(gh.awport) #endif gh.awport:=NIL IF gh.wb_isopen CloseLibrary(workbenchbase) gh.wb_isopen:=FALSE ENDIF #endif #ifdef EASY_EXTRAS IF (gh.mh=NIL) AND gh.wndport THEN DeleteMsgPort(gh.wndport) #endif #ifndef EASY_EXTRAS IF gh.wndport THEN DeleteMsgPort(gh.wndport) #endif gh.wndport:=NIL IF gh.gt_isopen CloseLibrary(gadtoolsbase) gh.gt_isopen:=FALSE ENDIF ENDPROC /********** cleangui() **********/ EXPORT PROC cleangui(gh:PTR TO guihandle) DEF f IF gh -> Close window if necessary. closewin(gh) IF f:=gh.onclean THEN f(gh.info) cleaninit(gh) #ifdef EASY_EXTRAS IF gh.mh -> Unlink from multi-window list. Remove(gh.link) gh.mh:=NIL ENDIF #endif END gh ENDIF ENDPROC /********** closewin() **********/ EXPORT PROC closewin(gh:PTR TO guihandle) DEF w:PTR TO window IF w:=gh.wnd -> Remember window size and position. gh.x:=w.leftedge gh.y:=w.topedge gh.xsize:=w.width gh.ysize:=w.height #ifdef EASY_EXTRAS gh.blockcnt:=1 -> Force unblock, if necessary. unblockwin(gh) -> Just in case! #endif removegui(gh) removemenus(gh) #ifdef EASY_APPWINDOW IF gh.appwin RemoveAppWindow(gh.appwin) gh.appwin:=NIL ENDIF -> Remove any last minute messages safely. IF gh.awport THEN clearmsgs(gh.awport,{testappwmsg},gh) #endif IF w -> Must be in Forbid()/Permit() brackets. Forbid() -> Remove any last minute messages safely. clearmsgs(gh.wndport,{testintuimsg},w) -> Make sure no more messages get sent. w.userport:=NIL ModifyIDCMP(w,0) Permit() -> Now the window can be closed safely. CloseWindow(w) gh.pwnd:=NIL ENDIF stdrast:=NIL IF gh.visual FreeVisualInfo(gh.visual) gh.visual:=NIL ENDIF #ifdef EASY_EXTRAS -> If multi then decrement count of open windows. IF gh.mh THEN gh.mh.opencount:=gh.mh.opencount-1 #endif IF gh.is_wb IF gh.scr THEN UnlockPubScreen(NIL,gh.scr) gh.scr:=NIL ENDIF -> If the font is linked to the screen, it's no longer valid. IF gh.ta_scr THEN gh.tattr:=NIL ENDIF ENDPROC -> Render the gadgets on the window. PROC rendergui(gh:PTR TO guihandle) DEF glist=0,w:PTR TO window,base:PTR TO g w:=gh.pwnd base:=gh.base gh.gl:=CreateContext({glist}) IF gh.gl=NIL THEN RaiseX("GUI",1183,'Could not create gadget context. Out of memory?') stdrast:=w.rport -> Adjust intermediate gadgets to be real gadgets fitting in window. adjust(base, gh.xoff,gh.yoff, w.width-gh.xsize+base.xs,w.height-gh.ysize+base.ys, gh) AddGList(w,glist,-1,-1,NIL) #ifndef EASY_KEYBOARD -> If no keyboard support, activate first sting gadget. IF gh.firststr THEN ActivateGadget(gh.firststr,w,NIL) #endif RefreshGList(glist,w,NIL,-1) Gt_RefreshWindow(w,NIL) -> Set public pointer, as a flag to say it's OK to play with the GUI, now. gh.wnd:=w ENDPROC glist -> Remove PLUGINs and gadgets from window. PROC removegads(gh:PTR TO guihandle) DEF pl:PTR TO plugin -> Set public pointer to NIL, to say it's no longer safe to play with the GUI. gh.wnd:=NIL pl:=gh.plugins WHILE pl pl.clear_render(gh.pwnd) pl:=pl.next ENDWHILE IF gh.glist RemoveGList(gh.pwnd,gh.glist,-1) FreeGadgets(gh.glist) ENDIF ENDPROC -> Decide what the real screen bottom is by getting size gadget height. PROC getrealbot(s:PTR TO screen) DEF dri,bot,im:PTR TO image bot:=s.wborbottom IF dri:=GetScreenDrawInfo(s) IF im:=NewObjectA(NIL,'sysiclass', [SYSIA_DRAWINFO,dri, SYSIA_WHICH,SIZEIMAGE, SYSIA_SIZE,SysISize(s.flags), NIL]) bot:=im.height DisposeObject(im) ENDIF FreeScreenDrawInfo(s,dri) ENDIF ENDPROC bot #ifdef EASY_KEYBOARD -> Fiddled so actually one less than length... PROC execlistlen(list:PTR TO mlh) DEF len=-1, node:PTR TO mln -> Catch the case where the LISTV is being cleanly updated. IF list<>-1 IF list node:=list.head WHILE node:=node.succ DO len++ ENDIF ENDIF ENDPROC len -> Do action appropriate to key press. PROC performkey(gh:PTR TO guihandle,code) DEF list:PTR TO LONG,ret,val,tag,index,data,gad=NIL:PTR TO gadget,inc -> Look up gadget in key index. IF islower(code) -> Positive action gad:=gh.keys[code-"a"] inc:=TRUE ELSEIF isupper(code) -> Negative action gad:=gh.keys[code-"A"] inc:=FALSE ENDIF IF gad=NIL THEN RETURN GUI_CONT /* Ack! Doesn't work under OS2.0... #ifdef EASY_EXTRAS Gt_GetGadgetAttrsA(gad,gh.pwnd,NIL,[GA_DISABLED,{ret},NIL]) IF ret THEN RETURN GUI_CONT #endif */ list:=gad.userdata ret:=ATTR(list,EG_ACT) #ifdef EASY_EXTRAS -> If disabled then don't react. IF optdis(gad.gadgetid,list) THEN RETURN GUI_CONT #endif -> Tag is TRUE if a button. data,tag:=indexdata(gad.gadgetid) data:=OptDefATTR(list,data) SELECT MAXGUI OF gad.gadgetid -> Just press button. -> CASE BUTTON,SBUTTON,RBUTTON CASE STR,INTEGER -> Activate string and integer gadgets. ActivateGadget(gad,gh.pwnd,NIL) CASE CHECK -> Toggle check gadgets. tag:=GTCB_CHECKED index:=CHK_VAL val:=(IsChecked(gad)=FALSE) CASE MX -> Next/prev item, wrapping. tag:=GTMX_ACTIVE index:=ListLen(ATTR(list,MX_LIST))-2 val:=ATTR(list,MX_CURR) IF inc IF val++>=index THEN val:=0 ELSE IF val--<0 THEN val:=index ENDIF index:=MX_CURR CASE CYCLE -> Next/prev item, wrapping. tag:=GTCY_ACTIVE index:=ListLen(ATTR(list,CYC_LIST))-2 val:=ATTR(list,CYC_CURR) IF inc IF val++>=index THEN val:=0 ELSE IF val--<0 THEN val:=index ENDIF index:=CYC_CURR CASE SCROLL -> Inc/dec, stopping at ends. tag:=GTSC_TOP val:=ATTR(list,SCR_TOP) IF inc IF val++>=(ATTR(list,SCR_TOTL)-ATTR(list,SCR_VIS)) THEN tag:=0 ELSE IF val--<0 THEN tag:=0 ENDIF index:=SCR_TOP CASE SLIDE -> Inc/dec, stopping at ends. tag:=GTSL_LEVEL val:=ATTR(list,SLI_CURR) IF inc IF val++>=ATTR(list,SLI_MAX) THEN tag:=0 ELSE IF val-- Next/prev, stopping at ends. tag:=GTLV_SELECTED val:=ATTR(list,LST_CURR) IF inc IF val++>=execlistlen(ATTR(list,LST_LIST)) THEN tag:=0 ELSE IF val--<0 THEN tag:=0 ENDIF index:=LST_CURR CASE PALETTE -> Next/prev, wrapping. tag:=GTPA_COLOR val:=ATTR(list,PAL_CURR) index:=Shl(1,ATTR(list,PAL_DEP))-1 IF inc IF val++>=index THEN val:=0 ELSE IF val--<0 THEN val:=index ENDIF index:=PAL_CURR ENDSELECT -> Perform change if required. IF tag IF tag<>TRUE -> If not a button (non-zero is tag value). setgadattr(gad,gh.pwnd,list,val,tag,index) IF gad.gadgetid=LISTV THEN setgadattr(gad,gh.pwnd,list,val,GTLV_MAKEVISIBLE) ENDIF -> Do action. IF IsActionFun(ret) -> If button (non-zero is tag value). IF tag=TRUE THEN ret(0,data,gh.info) ELSE ret(0,data,gh.info,val) ret:=GUI_CONT ENDIF ELSE ret:=GUI_CONT ENDIF ENDPROC ret #endif -> Call action function based on new code. PROC performaction(fun,gad:PTR TO gadget,info,code,l:PTR TO LONG,qual) DEF data,but,val data,but,val:=indexdata(gad.gadgetid) data:=OptDefATTR(l,data) ENDPROC (IF but THEN fun(qual,data,info) ELSE fun(qual,data,info,IF val THEN ATTR(l,val) ELSE code)) /********** getstr **********/ EXPORT PROC getstr(gh,g) IS gadstr(g,findgadget(gh,g)) /********** getinteger **********/ EXPORT PROC getinteger(gh,g) IS gadinteger(g,findgadget(gh,g)) -> Copy buffer string to gadget E-string. PROC gadstr(l:PTR TO LONG, gad:PTR TO gadget) IS IF gad THEN StrCopy(ATTR(l,STR_STR),GadString(gad)) ELSE 0 -> Copy buffer integer to gadget integer. PROC gadinteger(l:PTR TO LONG, gad:PTR TO gadget) DEF x=0 IF gad THEN ATTR(l,INT_VAL):=x:=GadLongInt(gad) ENDPROC x -> Record new gadget value. PROC performset(gad:PTR TO gadget,code,l:PTR TO LONG) SELECT MAXGUI OF gad.gadgetid CASE STR; gadstr(l,gad) CASE INTEGER; gadinteger(l,gad) CASE CHECK; ATTR(l,CHK_VAL):=IsChecked(gad) CASE MX; ATTR(l,MX_CURR):=code CASE CYCLE; ATTR(l,CYC_CURR):=code CASE SCROLL; ATTR(l,SCR_TOP):=code CASE SLIDE; ATTR(l,SLI_CURR):=code CASE LISTV; ATTR(l,LST_CURR):=code CASE PALETTE; ATTR(l,PAL_CURR):=code ENDSELECT ENDPROC ->